'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 12 November 2008 at 2:55:26 pm'!
Inspector subclass: #ContextVariablesInspector
	instanceVariableNames: 'fieldList'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-Debugger'!
CodeHolder subclass: #Debugger
	instanceVariableNames: 'interruptedProcess interruptedController contextStack contextStackTop contextStackIndex contextStackList receiverInspector contextVariablesInspector externalInterrupt proceedValue selectingPC debuggerMap savedCursor isolationHead failedProject errorWasInUIProcess labelString'
	classVariableNames: 'ContextStackKeystrokes ErrorRecursion'
	poolDictionaries: ''
	category: 'Tools-Debugger'!
Object subclass: #DebuggerMethodMap
	instanceVariableNames: 'timestamp methodReference methodNode abstractSourceRanges sortedSourceMap'
	classVariableNames: 'MapCache MapCacheEntries'
	poolDictionaries: ''
	category: 'Tools-Debugger'!

!DebuggerMethodMap commentStamp: '<historical>' prior: 0!
I am a place-holder for information needed by the Debugger to inspect method activations.  I insulate the debugger from details of code generation such as exact bytecode offsets and temporary variable locations.  I have two concreate subclasses, one for methods compiled using BlueBook blocks and one for methods compiled using Closures.  These classes deal with temporary variable access. My function is to abstract the source map away from actual bytecode pcs to abstract bytecode pcs.

To reduce compilation time I try and defer as much computation to access time as possible as instances of me will be created after each compilation.

I maintain a WeakIdentityDictionary of method to DebuggerMethodMap to cache maps.  I refer to my method through a WeakArray to keep the map cache functional. If the reference from a DebuggerMethodMap to its method were strong then the method would never be dropped from the cache because the reference from its map would keep it alive.!

DebuggerMethodMap subclass: #DebuggerMethodMapForBlueBookMethods
	instanceVariableNames: 'tempNames'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-Debugger'!

!DebuggerMethodMapForBlueBookMethods commentStamp: '<historical>' prior: 0!
I am a place-holder for information needed by the Debugger to inspect method activations.  See my superclass's comment. I map methods compiled using Closures.!

DebuggerMethodMap subclass: #DebuggerMethodMapForClosureCompiledMethods
	instanceVariableNames: 'blockExtentsToTempRefs startpcsToTempRefs'
	classVariableNames: 'FirstTime'
	poolDictionaries: ''
	category: 'Tools-Debugger'!

!DebuggerMethodMapForClosureCompiledMethods commentStamp: '<historical>' prior: 0!
I am a place-holder for information needed by the Debugger to inspect method activations.  See my superclass's comment. I map methods compiled using BlueBook blocks.

Instance variables
	blockExtentsToTempsRefs <Dictionary of: Interval -> Array of: (Array with: String with: (Integer | (Array with: Integer with: Integer)))>
		maps a block extent to an Array of temp references for that block/method.
		Each reference is a pair of temp name and index, where the index can itself be a pair for a remote temp.
	startpcsToTempRefs <Dictionary of: Integer -> Array of: (Array with: String with: temp reference)> where
		temp reference ::= Integer
						| (Array with: Integer with: Integer)
						| (Array with: #outer with: temp reference)!


!DebuggerMethodMap methodsFor: 'initialize-release' stamp: 'eem 6/5/2008 09:21'!
forMethod: aMethod "<CompiledMethod>" methodNode: theMethodNode "<MethodNode>"
	methodReference := WeakArray with: aMethod.
	methodNode := theMethodNode.
	self markRecentlyUsed! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'eem 6/3/2008 12:21'!
markRecentlyUsed
	timestamp := Time totalSeconds! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'eem 6/5/2008 09:21'!
method
	^methodReference at: 1! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'eem 6/10/2008 09:44'!
namedTempAt: index in: aContext
	"Answer the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:"
	self subclassResponsibility! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'eem 6/10/2008 09:44'!
namedTempAt: index put: aValue in: aContext
	"Assign the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:"
	self subclassResponsibility! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'eem 6/10/2008 09:45'!
tempNamesForContext: aContext
	"Answer an Array of all the temp names in scope in aContext starting with
	 the home's first local (the first argument or first temporary if no arguments)."
	self subclassResponsibility! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'eem 6/10/2008 09:47'!
tempsAndValuesForContext: aContext
	"Return a string of the temporary variabls and their current values"
	| aStream |
	aStream := WriteStream on: (String new: 100).
	(self tempNamesForContext: aContext) doWithIndex:
		[:title :index |
		 aStream nextPutAll: title; nextPut: $:; space; tab.
		 aContext print: (self namedTempAt: index in: aContext) on: aStream.
		 aStream cr].
	^aStream contents! !

!DebuggerMethodMap methodsFor: 'accessing' stamp: 'eem 6/2/2008 18:32'!
timestamp
	^timestamp! !

!DebuggerMethodMap methodsFor: 'source mapping' stamp: 'eem 7/29/2008 17:12'!
abstractSourceMap
	"Answer with a Dictionary of abstractPC <Integer> to sourceRange <Interval>."
	| theMethodToScan rawSourceRanges concreteSourceRanges abstractPC scanner client |
	abstractSourceRanges ifNotNil:
		[^abstractSourceRanges].
	"If the methodNode hasn't had a method generated it doesn't have pcs set in its
	 nodes so we must generate a new method and might as well use it for scanning."
	methodNode rawSourceRangesAndMethodDo:
		[:ranges :method|
		 rawSourceRanges := ranges.
		 theMethodToScan := method].
	concreteSourceRanges := Dictionary new.
	rawSourceRanges keysAndValuesDo:
		[:node :range|
		node pc ~= 0 ifTrue:
			[concreteSourceRanges at: node pc put: range]].
	abstractPC := 1.
	abstractSourceRanges := Dictionary new.
	scanner := InstructionStream on: theMethodToScan.
	client := InstructionClient new.
	[(concreteSourceRanges includesKey: scanner pc) ifTrue:
		[abstractSourceRanges at: abstractPC put: (concreteSourceRanges at: scanner pc)].
	 abstractPC := abstractPC + 1.
	 scanner interpretNextInstructionFor: client.
	 scanner atEnd] whileFalse.
	^abstractSourceRanges! !

!DebuggerMethodMap methodsFor: 'source mapping' stamp: 'eem 6/5/2008 16:43'!
rangeForPC: contextsConcretePC contextIsActiveContext: contextIsActiveContext
	"Answer the indices in the source code for the supplied pc.
	 If the context is the actve context (is at the hot end of the stack)
	 then its pc is the current pc.  But if the context isn't, because it is
	 suspended sending a message, then its current pc is the previous pc."

	| pc i end |
	pc := self method abstractPCForConcretePC: (contextIsActiveContext
													ifTrue: [contextsConcretePC]
													ifFalse: [(self method pcPreviousTo: contextsConcretePC)
																ifNotNil: [:prevpc| prevpc]
																ifNil: [contextsConcretePC]]).
	(self abstractSourceMap includesKey: pc) ifTrue:
		[^self abstractSourceMap at: pc].
	sortedSourceMap ifNil:
		[sortedSourceMap := self abstractSourceMap.
		 sortedSourceMap := (sortedSourceMap keys collect: 
								[:key| key -> (sortedSourceMap at: key)]) asSortedCollection].
	(sortedSourceMap isNil or: [sortedSourceMap isEmpty]) ifTrue: [^1 to: 0].
	i := sortedSourceMap indexForInserting: (pc -> nil).
	i < 1 ifTrue: [^1 to: 0].
	i > sortedSourceMap size ifTrue:
		[end := sortedSourceMap inject: 0 into:
			[:prev :this | prev max: this value last].
		^end+1 to: end].
	^(sortedSourceMap at: i) value

	"| method source scanner map |
	 method := DebuggerMethodMap compiledMethodAt: #rangeForPC:contextIsActiveContext:.
	 source := method getSourceFromFile asString.
	 scanner := InstructionStream on: method.
	 map := method debuggerMap.
	 Array streamContents:
		[:ranges|
		[scanner atEnd] whileFalse:
			[| range |
			 range := map rangeForPC: scanner pc contextIsActiveContext: true.
			 ((map abstractSourceMap includesKey: scanner abstractPC)
			  and: [range first ~= 0]) ifTrue:
				[ranges nextPut: (source copyFrom: range first to: range last)].
			scanner interpretNextInstructionFor: InstructionClient new]]"! !

!DebuggerMethodMap methodsFor: 'source mapping' stamp: 'eem 6/5/2008 10:50'!
sourceText
	^methodNode sourceText! !


!DebuggerMethodMapForBlueBookMethods methodsFor: 'initialize-release' stamp: 'eem 6/5/2008 10:34'!
forMethod: aMethod "<CompiledMethod>" methodNode: aMethodNode "<MethodNode>"
	super forMethod: aMethod methodNode: aMethodNode.
	tempNames := methodNode encoder tempNames! !

!DebuggerMethodMapForBlueBookMethods methodsFor: 'accessing' stamp: 'eem 6/3/2008 11:43'!
namedTempAt: index in: aContext
	"Answer the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:"
	^aContext tempAt: index! !

!DebuggerMethodMapForBlueBookMethods methodsFor: 'accessing' stamp: 'eem 6/3/2008 11:43'!
namedTempAt: index put: aValue in: aContext
	"Assign the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:"
	^aContext tempAt: index put: aValue! !

!DebuggerMethodMapForBlueBookMethods methodsFor: 'accessing' stamp: 'eem 6/3/2008 11:42'!
tempNamesForContext: aContext
	"Answer an Array of all the temp names in scope in aContext starting with
	 the home's first local (the first argument or first temporary if no arguments)."
	^tempNames! !


!DebuggerMethodMapForClosureCompiledMethods methodsFor: 'accessing' stamp: 'eem 7/29/2008 19:28'!
namedTempAt: index in: aContext
	"Answer the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:"
	^self
		privateTempAt: index
		in: aContext
		startpcsToBlockExtents: aContext method startpcsToBlockExtents! !

!DebuggerMethodMapForClosureCompiledMethods methodsFor: 'accessing' stamp: 'eem 7/29/2008 19:33'!
namedTempAt: index put: aValue in: aContext
	"Assign the value of the temp at index in aContext where index is relative
	 to the array of temp names answered by tempNamesForContext:.
	 If the value is a copied value we also need to set it along the lexical chain."
	^self
		privateTempAt: index
		in: aContext
		put: aValue
		startpcsToBlockExtents: aContext method startpcsToBlockExtents! !

!DebuggerMethodMapForClosureCompiledMethods methodsFor: 'accessing' stamp: 'eem 7/29/2008 18:26'!
tempNamesForContext: aContext
	"Answer an Array of all the temp names in scope in aContext starting with
	 the home's first local (the first argument or first temporary if no arguments)."
	^(self
		privateTempRefsForContext: aContext
		startpcsToBlockExtents: aContext method startpcsToBlockExtents) collect:
			[:pair| pair first]! !

!DebuggerMethodMapForClosureCompiledMethods methodsFor: 'private' stamp: 'eem 7/29/2008 20:09'!
ensureExtentsMapsInitialized
	| encoderTempRefs "<Dictionary of: Interval -> <Array of: <String | <Array of: String>>>>" |
	blockExtentsToTempRefs ifNotNil: [^self].
	blockExtentsToTempRefs := Dictionary new.
	startpcsToTempRefs := Dictionary new.
	encoderTempRefs := methodNode blockExtentsToTempRefs.
	encoderTempRefs keysAndValuesDo:
		[:blockExtent :tempVector|
		blockExtentsToTempRefs
			at: blockExtent
			put: (Array streamContents:
					[:stream|
					tempVector withIndexDo:
						[:nameOrSequence :index|
						nameOrSequence isString
							ifTrue:
								[stream nextPut: {nameOrSequence. index}]
							ifFalse:
								[nameOrSequence withIndexDo:
									[:name :indirectIndex|
									stream nextPut: { name. { index. indirectIndex }}]]]])]! !

!DebuggerMethodMapForClosureCompiledMethods methodsFor: 'private' stamp: 'eem 7/29/2008 19:26'!
privateDereference: tempReference in: aContext
	"Fetch the temporary with reference tempReference in aContext.
	 tempReference can be
		integer - direct temp reference
		#( indirectionVectorIndex tempIndex ) - remote temp in indirectionVector at index
		#( outer. temp reference ) - a temp reference in an outer context."
	^tempReference isInteger
		ifTrue: [aContext tempAt: tempReference]
		ifFalse:
			[tempReference first == #outer
				ifTrue: [self privateDereference: tempReference last
							in: aContext outerContext]
				ifFalse: [(aContext tempAt: tempReference first)
							at: tempReference second]]! !

!DebuggerMethodMapForClosureCompiledMethods methodsFor: 'private' stamp: 'eem 7/29/2008 19:26'!
privateDereference: tempReference in: aContext put: aValue
	"Assign the temporary with reference tempReference in aContext.
	 tempReference can be
		integer - direct temp reference
		#( indirectionVectorIndex tempIndex ) - remote temp in indirectionVector at index
		#( outer. temp reference ) - a temp reference in an outer context."
	^tempReference isInteger
		ifTrue: [aContext tempAt: tempReference put: aValue]
		ifFalse:
			[tempReference first == #outer
				ifTrue: [self privateDereference: tempReference last
							in: aContext outerContext
							put: aValue]
				ifFalse: [(aContext tempAt: tempReference first)
							at: tempReference second
							put: aValue]]! !

!DebuggerMethodMapForClosureCompiledMethods methodsFor: 'private' stamp: 'eem 7/29/2008 20:03'!
privateTempAt: index in: aContext put: aValue startpcsToBlockExtents: theContextsStartpcsToBlockExtents
	| nameRefPair |
	nameRefPair := (self privateTempRefsForContext: aContext
						 startpcsToBlockExtents: theContextsStartpcsToBlockExtents)
						at: index
						ifAbsent: [aContext errorSubscriptBounds: index].
	^self privateDereference: nameRefPair last in: aContext put: aValue! !

!DebuggerMethodMapForClosureCompiledMethods methodsFor: 'private' stamp: 'eem 7/29/2008 20:02'!
privateTempAt: index in: aContext startpcsToBlockExtents: theContextsStartpcsToBlockExtents
	| nameRefPair |
	nameRefPair := (self privateTempRefsForContext: aContext
						 startpcsToBlockExtents: theContextsStartpcsToBlockExtents)
						at: index
						ifAbsent: [aContext errorSubscriptBounds: index].
	^self privateDereference: nameRefPair last in: aContext! !

!DebuggerMethodMapForClosureCompiledMethods methodsFor: 'private' stamp: 'eem 7/29/2008 20:07'!
privateTempRefsForContext: aContext startpcsToBlockExtents: theContextsStartpcsToBlockExtents
	"Answer the sequence of temps in scope in aContext in the natural order,
	 outermost arguments and temporaries first, innermost last.  Each temp is
	 a pair of the temp's name followed by a reference.  The reference can be
		integer - index of temp in aContext
		#( indirectionVectorIndex tempIndex ) - remote temp in indirectionVector at index in aContext
		#( outer. temp reference ) - a temp reference in an outer context."
	self ensureExtentsMapsInitialized.
	^startpcsToTempRefs
		at: aContext startpc
		ifAbsentPut:
			[| localRefs |
			 localRefs := blockExtentsToTempRefs at: (theContextsStartpcsToBlockExtents at: aContext startpc).
			 aContext outerContext
				ifNil: [localRefs]
				ifNotNil:
					[:outer| | outerTemps |
					"Present temps in the order outermost to innermost left-to-right, but replace
					 copied outermost temps with their innermost copies"
					 outerTemps := (self
										privateTempRefsForContext: outer
										startpcsToBlockExtents: theContextsStartpcsToBlockExtents) collect:
						[:outerPair|
						localRefs
							detect: [:localPair| outerPair first = localPair first]
							ifNone: [{ outerPair first. { #outer. outerPair last } }]].
					outerTemps,
					 (localRefs reject: [:localPair| outerTemps anySatisfy: [:outerPair| localPair first = outerPair first]])]]! !


!CompiledMethod methodsFor: 'testing' stamp: 'eem 6/4/2008 16:19'!
usesClosureBytecodes
	"Answer whether the receiver was compiled using the closure compiler.
	 This is used to help DebuggerMethodMap choose which mechanisms to
	 use to inspect activations of the receiver.
	 This method answers false negatives in that it only identifies methods
	 that use the new BlockClosure bytecodes.
	 But since methods that don't create blocks have essentially the same
	 code when compiled with either compiler this makes little difference."

	^(InstructionStream on: self) scanFor: [:instr | instr >= 138 and: [instr <= 143]]! !


!ContextVariablesInspector methodsFor: 'accessing' stamp: 'eem 5/21/2008 12:31'!
fieldList 
	"Refer to the comment in Inspector|fieldList."

	object == nil ifTrue: [^Array with: 'thisContext'].
	^fieldList ifNil:[fieldList := (Array with: 'thisContext' with: 'stack top' with: 'all temp vars') , object tempNames]! !


!InstructionStream methodsFor: 'debugger access' stamp: 'eem 6/5/2008 10:45'!
debuggerMap
	^self method debuggerMap! !


!ContextPart methodsFor: 'debugger access' stamp: 'ar 7/13/2007 16:52'!
print: anObject on: aStream
	"Safely print anObject in the face of direct ProtoObject subclasses"
	| title |
	(anObject class canUnderstand: #printOn:)
		ifTrue:[^anObject printOn: aStream].
	title := anObject class name.
	aStream
		nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']);
		nextPutAll: title! !


!MethodNode methodsFor: 'converting' stamp: 'eem 6/20/2008 14:50'!
prepareForRegeneration
	"Nothing to do for vanilla nodes."! !


!CompiledMethod methodsFor: 'testing' stamp: 'eem 6/3/2008 13:30'!
isClosureCompiled
	"Answer whether the receiver was compiled using the closure compiler.
	 This is used to help DebuggerMethodMap choose which mechanisms to
	 use to inspect activations of the receiver.
	 This method answers false negatives in that it only identifies methods
	 that create new BlockClosures or use the new BlockClosure bytecodes.
	 But since methods that don't create blocks have essentially the same
	 code when compiled with either compiler this makes little difference."

	^((InstructionStream on: self) scanFor: [:instr | instr >= 138 and: [instr <= 143]])
	   or: [(self hasLiteral: #closureCopy:copiedValues:)
		   and: [self messages includes: #closureCopy:copiedValues:]]! !

!CompiledMethod methodsFor: 'debugger support' stamp: 'eem 6/5/2008 10:32'!
abstractPCForConcretePC: concretePC
	"Answer the abstractPC matching concretePC."

	| abstractPC scanner client |
	self flag: 'belongs in DebuggerMethodMap?'.
	abstractPC := 1.
	scanner := InstructionStream on: self.
	client := InstructionClient new.
	[(scanner atEnd
	  or: [scanner pc >= concretePC]) ifTrue:
		[^abstractPC].
	 abstractPC := abstractPC + 1.
	 scanner interpretNextInstructionFor: client.
	 true] whileTrue! !

!CompiledMethod methodsFor: 'debugger support' stamp: 'eem 6/5/2008 09:10'!
debuggerMap
	^DebuggerMethodMap forMethod: self! !

!CompiledMethod methodsFor: 'debugger support' stamp: 'eem 6/14/2008 18:58'!
pcPreviousTo: pc
	| scanner client prevPc |
	self flag: 'belongs in DebuggerMethodMap?'.
	pc > self endPC ifTrue: [^self endPC].
	scanner := InstructionStream on: self.
	client := InstructionClient new.
	[scanner pc < pc] whileTrue:
		[prevPc := scanner pc.
		 scanner interpretNextInstructionFor: client].
	^prevPc! !


!ContextVariablesInspector methodsFor: 'selecting' stamp: 'eem 7/18/2008 11:18'!
replaceSelectionValue: anObject 
	"Refer to the comment in Inspector|replaceSelectionValue:."

	^selectionIndex = 1
		ifTrue: [object]
		ifFalse: [object namedTempAt: selectionIndex - 3 put: anObject]! !

!ContextVariablesInspector methodsFor: 'selecting' stamp: 'eem 6/10/2008 09:37'!
selection 
	"Refer to the comment in Inspector|selection."
	selectionIndex = 0 ifTrue:[^''].
	selectionIndex = 1 ifTrue: [^object].
	selectionIndex = 2 ifTrue: [^object stackPtr > 0 ifTrue: [object top]].
	selectionIndex = 3 ifTrue: [^object tempsAndValues].
	^object debuggerMap namedTempAt: selectionIndex - 3 in: object! !


!Debugger methodsFor: 'accessing' stamp: 'eem 6/24/2008 09:53'!
contents: aText notifying: aController
	"The retrieved information has changed and its source must now be updated.
	 In this case, the retrieved information is the method of the selected context."
	| result selector classOfMethod category h ctxt newMethod |
	contextStackIndex = 0 ifTrue:
		[^false].
	self selectedContext isExecutingBlock ifTrue:
		[h := self selectedContext activeHome.
		 h ifNil:
			[self inform: 'Method for block not found on stack, can''t edit and continue'.
			 ^false].
		 (self confirm: 'I will have to revert to the method from\which this block originated.  Is that OK?' withCRs) ifFalse:
			[^false].
		self resetContext: h.
		result := self contents: aText notifying: aController.
		self contentsChanged.
		^result].

	classOfMethod := self selectedClass.
	category := self selectedMessageCategoryName.
	selector := self selectedClass parserClass new parseSelector: aText.
	(selector == self selectedMessageName
	 or: [(self selectedMessageName beginsWith: 'DoIt')
		and: [selector numArgs = self selectedMessageName numArgs]]) ifFalse:
		[self inform: 'can''t change selector'.
		 ^false].
	selector := classOfMethod
				compile: aText
				classified: category
				notifying: aController.
	selector ifNil: [^false]. "compile cancelled"
	contents := aText.
	newMethod := classOfMethod compiledMethodAt: selector.
	newMethod isQuick ifTrue:
		[self down.
		 self selectedContext jump: (self selectedContext previousPc - self selectedContext pc)].
	ctxt := interruptedProcess popTo: self selectedContext.
	ctxt == self selectedContext
		ifFalse:
			[self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs]
		ifTrue:
			[newMethod isQuick ifFalse:
				[interruptedProcess
					restartTopWith: newMethod;
				 	stepToSendOrReturn].
			contextVariablesInspector object: nil.
			debuggerMap := nil].
	self resetContext: ctxt.
	Smalltalk isMorphic ifTrue:
		[World
			addAlarm: #changed:
			withArguments: #(contentsSelection)
			for: self
			at: (Time millisecondClockValue + 200)].
	^true! !

!Debugger methodsFor: 'context stack (message list)' stamp: 'eem 6/5/2008 11:27'!
selectedMessage
	"Answer the source code of the currently selected context."
	debuggerMap isNil ifTrue:
		[debuggerMap := self selectedContext debuggerMap].
	^contents := debuggerMap sourceText asText makeSelectorBold! !

!Debugger methodsFor: 'code pane' stamp: 'eem 6/5/2008 10:54'!
pcRange
	"Answer the indices in the source code for the method corresponding to 
	the selected context's program counter value."

	(selectingPC and: [contextStackIndex ~= 0]) ifFalse:
		[^1 to: 0].
	self selectedContext isDead ifTrue:
		[^1 to: 0].
	debuggerMap ifNil:
		[debuggerMap := self selectedContext debuggerMap].
	^debuggerMap
		rangeForPC: self selectedContext pc
		contextIsActiveContext: contextStackIndex = 1! !

!Debugger methodsFor: 'private' stamp: 'eem 6/5/2008 16:31'!
contextStackIndex: anInteger oldContextWas: oldContext 
	"Change the context stack index to anInteger, perhaps in response to user selection."

	| isNewMethod selectedContextSlotName index |
	contextStackIndex := anInteger.
	anInteger = 0 ifTrue:
		[currentCompiledMethod := debuggerMap := contents := nil.
		 self changed: #contextStackIndex.
		 self decorateButtons.
		 self contentsChanged.
		 contextVariablesInspector object: nil.
		 receiverInspector object: self receiver.
		 ^self].
	selectedContextSlotName := contextVariablesInspector selectedSlotName.
	isNewMethod := oldContext == nil
					or: [oldContext method ~~ (currentCompiledMethod := self selectedContext method)].
	isNewMethod ifTrue:
		[debuggerMap := nil.
		 contents := self selectedMessage.
		 self contentsChanged.
		 self pcRange].
	self changed: #contextStackIndex.
	self decorateButtons.
	contextVariablesInspector object: self selectedContext.
	((index := contextVariablesInspector fieldList indexOf: selectedContextSlotName) ~= 0
	 and: [index ~= contextVariablesInspector selectionIndex]) ifTrue:
		[contextVariablesInspector toggleIndex: index].
	receiverInspector object: self receiver.
	isNewMethod ifFalse:
		[self changed: #contentsSelection]! !


!DebuggerMethodMap class methodsFor: 'instance creation' stamp: 'eem 6/5/2008 09:19'!
forMethod: aMethod "<CompiledMethod>"
	"Answer a DebuggerMethodMap suitable for debugging activations of aMethod.
	 Answer an existing instance from the cache if it exists, cacheing a new one if required."
	^MapCache
		at: aMethod
		ifAbsent: [self
					cacheDebugMap:
						(self
							forMethod: aMethod
							methodNode: aMethod methodNode)
					forMethod: aMethod]! !

!DebuggerMethodMap class methodsFor: 'instance creation' stamp: 'eem 7/29/2008 16:54'!
forMethod: aMethod "<CompiledMethod>" methodNode: methodNode "<MethodNode>"
	"Uncached instance creation method for private use or for tests.
	 Please consider using forMethod: instead."
	^(aMethod isBlueBookCompiled
			ifTrue: [DebuggerMethodMapForBlueBookMethods]
			ifFalse: [DebuggerMethodMapForClosureCompiledMethods]) new
		forMethod: aMethod
		methodNode: methodNode! !

!DebuggerMethodMap class methodsFor: 'class initialization' stamp: 'eem 6/5/2008 09:14'!
initialize
	"DebuggerMethodMap initialize"

	self voidMapCache! !

!DebuggerMethodMap class methodsFor: 'class initialization' stamp: 'eem 6/5/2008 09:14'!
voidMapCache
	MapCache := WeakIdentityKeyDictionary new.
	MapCacheEntries := 16! !

!DebuggerMethodMap class methodsFor: 'debugger support' stamp: 'eem 6/26/2008 22:59'!
cacheDebugMap: aDebuggerMethodMap forMethod: aCompiledMethod
	MapCache finalizeValues.
	[MapCache size >= MapCacheEntries] whileTrue:
		[| mapsByAge |
		 mapsByAge := MapCache keys asSortedCollection:
							[:m1 :m2|
							(MapCache at: m1) timestamp
							< (MapCache at: m2) timestamp].
		mapsByAge notEmpty ifTrue: "There be race conditions and reentrancy issues here"
			[MapCache removeKey: mapsByAge last]].

	^MapCache
		at: aCompiledMethod
		put: aDebuggerMethodMap! !


!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/5/2008 10:07'!
previousPc

	^self method pcPreviousTo: pc! !


!ContextPart methodsFor: 'debugger access' stamp: 'eem 7/17/2008 14:49'!
namedTempAt: index
	"Answer the value of the temp at index in the receiver's sequence of tempNames."
	^self debuggerMap namedTempAt: index in: self! !

!ContextPart methodsFor: 'debugger access' stamp: 'eem 6/24/2008 12:24'!
namedTempAt: index put: aValue
	"Set the value of the temp at index in the receiver's sequence of tempNames.
	 (Note that if the value is a copied value it is also set out along the lexical chain,
	  but alas not in along the lexical chain.)."
	^self debuggerMap namedTempAt: index put: aValue in: self! !

DebuggerMethodMapForClosureCompiledMethods removeSelector: #ensureExtentsMapInitialized!
DebuggerMethodMapForClosureCompiledMethods removeSelector: #forMethod:methodNode:!
DebuggerMethodMapForClosureCompiledMethods removeSelector: #privateLocalNamesForContext:startpcsToBlockExtents:!
DebuggerMethodMapForClosureCompiledMethods removeSelector: #privateLocalRefsForContext:startpcsToBlockExtents:!
DebuggerMethodMapForClosureCompiledMethods removeSelector: #privateTempNamed:index:in:startpcsToBlockExtents:!
DebuggerMethodMapForClosureCompiledMethods removeSelector: #privateTempNamed:index:put:in:startpcsToBlockExtents:!
DebuggerMethodMapForClosureCompiledMethods removeSelector: #privateTempNamed:in:startpcsToBlockExtents:!
DebuggerMethodMapForClosureCompiledMethods removeSelector: #privateTempNamed:put:in:startpcsToBlockExtents:!
DebuggerMethodMapForClosureCompiledMethods removeSelector: #privateTempNamesForContext:startpcsToBlockExtents:!
DebuggerMethodMapForClosureCompiledMethods removeSelector: #tempAt:in:!

!DebuggerMethodMapForClosureCompiledMethods reorganize!
('accessing' namedTempAt:in: namedTempAt:put:in: tempNamesForContext:)
('private' ensureExtentsMapsInitialized privateDereference:in: privateDereference:in:put: privateTempAt:in:put:startpcsToBlockExtents: privateTempAt:in:startpcsToBlockExtents: privateTempRefsForContext:startpcsToBlockExtents:)
!


!DebuggerMethodMapForBlueBookMethods class reorganize!
('as yet unclassified')
!

DebuggerMethodMap initialize!

!DebuggerMethodMap class reorganize!
('instance creation' forMethod: forMethod:methodNode:)
('class initialization' initialize voidMapCache)
('cache management')
('debugger support' cacheDebugMap:forMethod:)
!

DebuggerMethodMap removeSelector: #abstractSourceMapForMethod:!
DebuggerMethodMap removeSelector: #forMethodNode:!
DebuggerMethodMap removeSelector: #forMethod:blockExtentsToTempNames:!
DebuggerMethodMap removeSelector: #forMethod:blockExtentsToTempRefs:!
DebuggerMethodMap removeSelector: #namedTempAt:in:tempNames:!
DebuggerMethodMap removeSelector: #privateComputeTempNamesForContext:!

!Debugger reorganize!
('initialize' buildMVCDebuggerViewLabel:minSize: buildMVCNotifierButtonView buildMVCNotifierViewLabel:message:minSize: buildMVCOptionalButtonsButtonsView buttonRowForPreDebugWindow: customButtonRow customButtonSpecs debugAt: errorWasInUIProcess: initialExtent notifierButtonHeight openFullMorphicLabel: openFullNoSuspendLabel: openNotifierContents:label: optionalAnnotationHeight optionalButtonHeight optionalButtonPairs optionalButtonRow preDebugButtonQuads preDebugNotifierContentsFrom: release wantsOptionalButtons windowIsClosing)
('accessing' contents contents:notifying: contextVariablesInspector doNothing: interruptedContext interruptedProcess isNotifier labelString labelString: proceedValue proceedValue: receiver receiverInspector)
('notifier menu' debug storeLog)
('context stack (message list)' contextStackIndex contextStackList expandStack fullyExpandStack messageListIndex selectedMessage selectedMessageName toggleContextStackIndex:)
('context stack menu' abandon abandon: askForCategoryIn:default: browseMessages browseSendersOfMessages browseVersions buildMessageBrowser buildMorphicNotifierLabelled:message: close: contextStackKey:from: contextStackMenu:shifted: debugProceedMenu: doStep down fullStack implement:inClass: mailOutBugReport messageListMenu:shifted: peelToFirst populateImplementInMenu: proceed proceed: restart returnValue selectPC send stepIntoBlock up where)
('code pane' contentsSelection createSyntaxMorph doItContext doItReceiver pc pcRange toggleSyntaxMorph)
('code pane menu' codePaneMenu:shifted: perform:orSendTo: runToSelection:)
('message category list' selectedMessageCategoryName)
('class list' selectedClass selectedClassOrMetaClass)
('dependents access' step updateInspectors wantsSteps)
('private' askForSuperclassOf:toImplement:ifCancel: checkContextSelection contextStackIndex:oldContextWas: createMethod externalInterrupt: isolationRecoveryAdvice lowSpaceChoices newStack: process:controller:context: process:controller:context:isolationHead: resetContext: resumeProcess: selectedContext)
('controls' addOptionalButtonsTo:at:plus:)
('breakpoints' toggleBreakOnEntry)
('*Shout-Styling' shoutAboutToStyle:)
!

