'From Cuis 1.0 of 28 November 2009 [latest update: #337] on 7 December 2009 at 10:15:15 pm'!
!classDefinition: #DebuggerMethodMap 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.!

!classDefinition: #DebuggerMethodMapForBlueBookMethods category: #'Tools-Debugger'!
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.!

!classDefinition: #DebuggerMethodMapForClosureCompiledMethods category: #'Tools-Debugger'!
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: '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 7/6/2009 10:13'!
sourceText
	self method ifNotNil:
		[:method|
		method holdsTempNames ifTrue:
			[^method
				getSourceFor: (method selector ifNil: [method defaultSelector])
				in: method methodClass]].
	^methodNode sourceText! !

!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 class methodsFor: 'debugger support' stamp: 'nice 10/21/2009 00:04'!
cacheDebugMap: aDebuggerMethodMap forMethod: aCompiledMethod
	MapCache finalizeValues.
	[MapCache size >= MapCacheEntries] whileTrue:
		[| mapsByAge |
		 mapsByAge := MapCache keys asArray sort:
							[: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! !

!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! !


!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: '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/6/2009 10:14'!
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."
	blockExtentsToTempRefs ifNil:
		[blockExtentsToTempRefs := (aContext method holdsTempNames
										ifTrue: [aContext method]
										ifFalse: [methodNode]) blockExtentsToTempsMap.
		 startpcsToTempRefs := Dictionary new].
	^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]])]]! !

!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]! !

DebuggerMethodMap initialize!
