[squeak-dev] The Trunk: Tools-eem.992.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Oct 2 19:19:06 UTC 2020


Eliot Miranda uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-eem.992.mcz

==================== Summary ====================

Name: Tools-eem.992
Author: eem
Time: 2 October 2020, 12:19:00.336286 pm
UUID: 20c2a45a-e258-4a02-9e37-10ffc085290b
Ancestors: Tools-eem.991

Go some way to speed up stepping in the debugger.  Two of the identified costs are 
- scanning the method to produce its method/block start keys to block extents map
- translating the 'all temp vars' and 'stack top' label
With these two cached streaming and emphasizing the temp vars in a ContextInspector is now really fast (less than a millisecond).  But stepping is still not fast enlough; one can easily click the mouse faster than step can keep up.  So we have more analysis to do.

Do futher clean up of DebuggerMethodMap in having it cache its startKeysToBlockExtents.  Delete the obsolete privateTempAt:... methods that expect startpcsToBlockExtents:.Move all the scanning machinery from CompiledMethod into DebuggerMethodMap.

=============== Diff against Tools-eem.991 ===============

Item was changed:
  Inspector subclass: #ContextInspector
  	instanceVariableNames: ''
+ 	classVariableNames: 'CachedStackTopLabel CachedTempVarsLabel CurrentLocale'
- 	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Tools-Inspector'!
  
  !ContextInspector commentStamp: 'ct 1/12/2020 15:26' prior: 0!
  I am an Inspector that is specialized for inspecting Contexts.!

Item was added:
+ ----- Method: ContextInspector>>allTempVarsTranslated (in category 'private') -----
+ allTempVarsTranslated
+ 	"Alas translation is slow enough that we notice the slow down in trying to step in the debugger..."
+ 	(CurrentLocale ~= Locale current
+ 	 or: [CachedTempVarsLabel isNil]) ifTrue:
+ 		[CurrentLocale := Locale current.
+ 		 CachedTempVarsLabel :=  'all temp vars' translated].
+ 	^CachedTempVarsLabel!

Item was added:
+ ----- Method: ContextInspector>>stackTopTranslated (in category 'private') -----
+ stackTopTranslated
+ 	"Alas translation is slow enough that we notice the slow down in trying to step in the debugger..."
+ 	(CurrentLocale ~= Locale current
+ 	 or: [CachedTempVarsLabel isNil]) ifTrue:
+ 		[CurrentLocale := Locale current.
+ 		 CachedStackTopLabel :=  'stack top' translated].
+ 	^CachedStackTopLabel!

Item was changed:
  ----- Method: ContextVariablesInspector>>fieldAllTempVars (in category 'fields') -----
  fieldAllTempVars
  
  	^ (self newFieldForType: #all key: #allTempVars)
+ 		name: self allTempVarsTranslated; emphasizeName;
- 		name: 'all temp vars' translated; emphasizeName;
  		valueGetter: [:object | object tempsAndValues]; printValueAsIs;
  		yourself!

Item was changed:
  ----- Method: ContextVariablesInspector>>fieldStackTop (in category 'fields') -----
  fieldStackTop
  	
  	^ (self newFieldForType: #stackTop key: #stackTop)
+ 		name: self stackTopTranslated; emphasizeName;
- 		name: 'stack top' translated; emphasizeName;
  		valueGetter: [:context | context top];
  		valueGetterExpression: 'ThisContext top';
  		yourself!

Item was changed:
  Object subclass: #DebuggerMethodMap
+ 	instanceVariableNames: 'timestamp methodReference methodNode startKeysToBlockExtents abstractSourceRanges sortedSourceMap'
- 	instanceVariableNames: 'timestamp methodReference methodNode abstractSourceRanges sortedSourceMap'
  	classVariableNames: 'AccessLock MapCache MapCacheEntries'
  	poolDictionaries: ''
  	category: 'Tools-Debugger'!
  
  !DebuggerMethodMap commentStamp: 'eem 10/1/2020 19:08' 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 concrete subclasses, one for methods where block bytecodes are embedded in the home method and one for methods where blocks are separate objects (CompiledBlock).  These classes deal with temporary variable access. My function is to abstract the source map away from actual bytecode pcs to abstract bytecode pcs.  I used to have a subclass for "BlueBook" compiled methods, with non-closure blocks, but this was removed in October 2020 for simplicity's sake.
  
  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.!

Item was added:
+ ----- Method: DebuggerMethodMap>>blockExtentsInto:from:to:method:numberer: (in category 'private') -----
+ blockExtentsInto: aDictionary from: initialPC to: endPC method: method numberer: numbererBlock
+ 	"Support routine for startpcsToBlockExtents"
+ 	| pcs extentStart locator scanner blockSizeOrMethodOrLocator |
+ 	extentStart := numbererBlock value.
+ 	locator := BlockStartLocator new.
+ 	scanner := InstructionStream new method: method pc: initialPC.
+ 	pcs := OrderedCollection new.
+ 	[pcs addLast: scanner pc.
+ 	 scanner pc <= endPC] whileTrue:
+ 		[blockSizeOrMethodOrLocator := scanner interpretNextInstructionFor: locator.
+ 		 blockSizeOrMethodOrLocator ~~ locator ifTrue:
+ 			 [blockSizeOrMethodOrLocator isInteger
+ 				ifTrue:
+ 					[self
+ 						blockExtentsInto: aDictionary
+ 						from: scanner pc
+ 						to: scanner pc + blockSizeOrMethodOrLocator - 1
+ 						method: method
+ 						numberer: numbererBlock.
+ 					 scanner pc: scanner pc + blockSizeOrMethodOrLocator]
+ 				ifFalse:
+ 					[self assert: blockSizeOrMethodOrLocator isCompiledBlock.
+ 					 self
+ 						blockExtentsInto: aDictionary
+ 						from: blockSizeOrMethodOrLocator initialPC
+ 						to: blockSizeOrMethodOrLocator endPC
+ 						method: blockSizeOrMethodOrLocator
+ 						numberer: numbererBlock]]].
+ 	aDictionary
+ 		at: (method isCompiledBlock
+ 				ifTrue: [method]
+ 				ifFalse: [initialPC])
+ 		put: (extentStart to: numbererBlock value).
+ 	^aDictionary!

Item was changed:
  ----- Method: DebuggerMethodMap>>namedTempAt:in: (in category 'accessing') -----
  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 assert: aContext method homeMethod == self method.
  	^self
  		privateTempAt: index
  		in: aContext
+ 		startKeysToBlockExtents: self startKeysToBlockExtents!
- 		startKeysToBlockExtents: aContext method startKeysToBlockExtents!

Item was changed:
  ----- Method: DebuggerMethodMap>>namedTempAt:put:in: (in category 'accessing') -----
  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 assert: aContext method homeMethod == self method.
  	^self
  		privateTempAt: index
  		in: aContext
  		put: aValue
+ 		startKeysToBlockExtents: self startKeysToBlockExtents!
- 		startKeysToBlockExtents: aContext method startKeysToBlockExtents!

Item was changed:
  ----- Method: DebuggerMethodMap>>rangeForPC:in:contextIsActiveContext: (in category 'source mapping') -----
  rangeForPC: contextsConcretePC in: method 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 abstractMap i end |
- 	| pc i end |
  	pc := method abstractPCForConcretePC: (contextIsActiveContext
  													ifTrue: [contextsConcretePC]
  													ifFalse: [(method pcPreviousTo: contextsConcretePC)
  																ifNotNil: [:prevpc| prevpc]
  																ifNil: [contextsConcretePC]]).
+ 	abstractMap := self abstractSourceMapForMethod: method.
+ 	(abstractMap includesKey: pc) ifTrue:
+ 		[^abstractMap at: pc].
- 	(self abstractSourceMap includesKey: pc) ifTrue:
- 		[^self abstractSourceMap at: pc].
  	sortedSourceMap ifNil:
+ 		[sortedSourceMap := abstractMap associations
- 		[sortedSourceMap := self abstractSourceMap associations
  			replace: [ :each | each copy ];
  			sort].
  	sortedSourceMap isEmpty ifTrue: [^1 to: 0].
  	i := sortedSourceMap findNearbyBinaryIndex: [:assoc| pc - assoc key].
  	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:in:contextIsActiveContext:.
  	 source := method getSourceFromFile asString.
  	 scanner := InstructionStream on: method.
  	 map := method debuggerMap.
  	 Array streamContents:
  		[:ranges|
  		[scanner atEnd] whileFalse:
  			[| range |
  			 range := map rangeForPC: scanner pc in: method 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]]"!

Item was added:
+ ----- Method: DebuggerMethodMap>>startKeysToBlockExtents (in category 'private') -----
+ startKeysToBlockExtents
+ 	"Answer the map from start keys (either start pcs for embedded closures, or
+ 	 full block methods for full blocks) to the block extents in that method, where
+ 	 a block extent is an abstract representation of block nesting within a method."
+ 
+ 	startKeysToBlockExtents ifNil:
+ 		[| index method |
+ 		 index := 0.
+ 		 method := self method homeMethod.
+ 		 startKeysToBlockExtents := 
+ 			self
+ 				blockExtentsInto: self newBlockStartMap
+ 				from: method initialPC
+ 				to: method endPC
+ 				method: method
+ 				numberer: [| value | value := index. index := index + 2. value]].
+ 	^startKeysToBlockExtents!

Item was changed:
  ----- Method: DebuggerMethodMap>>tempNamesForContext: (in category 'accessing') -----
  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 assert: aContext method homeMethod == self method.
  	^(self
  		privateTempRefsForContext: aContext
+ 		startKeysToBlockExtents: self startKeysToBlockExtents) collect:
- 		startKeysToBlockExtents: aContext method startKeysToBlockExtents) collect:
  			[:pair| pair first]!

Item was changed:
  ----- Method: DebuggerMethodMap>>tempNamesForMethod: (in category 'accessing') -----
  tempNamesForMethod: aMethod
  	"Answer an Array of all the temp names in scope in aMethod starting with
  	 the home's first local (the first argument or first temporary if no arguments)."
+ 	self assert: aMethod homeMethod == self method.
  	^(self
  		privateTempRefsForMethod: aMethod
+ 		startKeysToBlockExtents: self startKeysToBlockExtents) collect:
- 		startKeysToBlockExtents: aMethod startKeysToBlockExtents) collect:
  			[:pair| pair first]!

Item was added:
+ ----- Method: DebuggerMethodMapForClosureCompiledMethods>>newBlockStartMap (in category 'private') -----
+ newBlockStartMap
+ 	"If blocks are embedded then keys in the map are simple integer pcs and a Dictionary can be used.
+ 	 If blocks are full (separate method objects) then keys in the map are CompiledBlocks and
+ 	 IdentityDictionary must be used to avoid confusing blocks with identical code."
+ 	^Dictionary new!

Item was removed:
- ----- Method: DebuggerMethodMapForClosureCompiledMethods>>privateTempAt:in:put:startpcsToBlockExtents: (in category 'private but obsolete') -----
- 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!

Item was removed:
- ----- Method: DebuggerMethodMapForClosureCompiledMethods>>privateTempAt:in:startpcsToBlockExtents: (in category 'private but obsolete') -----
- 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!

Item was changed:
  ----- Method: DebuggerMethodMapForClosureCompiledMethods>>privateTempRefsForContext:startKeysToBlockExtents: (in category 'private') -----
  privateTempRefsForContext: aContext startKeysToBlockExtents: theContextsStartKeysToBlockExtents
  	"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.
  		 blockExtentsToTempRefs
  			ifNil: ["an empty method.  shouldn't be able to step into here but it
  				  can happen in weird circumstances (i.e. with MethodWrapper)."
  				blockExtentsToTempRefs := Dictionary new.
  				blockExtentsToTempRefs
  					at: (theContextsStartKeysToBlockExtents at: aContext startKey)
  					put: {}]
  			ifNotNil:
  				[(blockExtentsToTempRefs isKindOf: IdentityDictionary) ifTrue:
  					[blockExtentsToTempRefs := Dictionary withAll: blockExtentsToTempRefs associations]].
+ 		 startKeysToTempRefs := self newBlockStartMap].
- 		 startKeysToTempRefs := aContext home method newBlockStartMap].
  	^startKeysToTempRefs
  		at: aContext startKey
  		ifAbsentPut:
  			[| localRefs |
  			 localRefs := blockExtentsToTempRefs at: (theContextsStartKeysToBlockExtents at: aContext startKey) ifAbsent: [#()].
  			 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
  										startKeysToBlockExtents: theContextsStartKeysToBlockExtents) 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]])]]!

Item was removed:
- ----- Method: DebuggerMethodMapForClosureCompiledMethods>>privateTempRefsForContext:startpcsToBlockExtents: (in category 'private but obsolete') -----
- 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.
- 		 blockExtentsToTempRefs ifNil:
- 			["an empty method.  shouldn't be able to step into here but it
- 			  can happen in weird circumstances (i.e. with MethodWrapper)."
- 			blockExtentsToTempRefs := Dictionary new.
- 			blockExtentsToTempRefs
- 				at: (theContextsStartpcsToBlockExtents at: aContext startpc)
- 				put: {}].
- 		 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]])]]!

Item was removed:
- ----- Method: DebuggerMethodMapForClosureCompiledMethods>>privateTempRefsForMethod:startpcsToBlockExtents: (in category 'private but obsolete') -----
- privateTempRefsForMethod: method startpcsToBlockExtents: startpcsToBlockExtents
- 	"Answer the sequence of temps in scope in method 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 := (method holdsTempNames
- 										ifTrue: [method]
- 										ifFalse: [methodNode]) blockExtentsToTempsMap.
- 		 blockExtentsToTempRefs ifNil:
- 			["an empty method.  shouldn't be able to step into here but it
- 			  can happen in weird circumstances (i.e. with MethodWrapper)."
- 			blockExtentsToTempRefs := Dictionary new.
- 			blockExtentsToTempRefs
- 				at: (startpcsToBlockExtents at: method initialPC)
- 				put: {}].
- 		 startpcsToTempRefs := Dictionary new].
- 	^startpcsToTempRefs
- 		at: method initialPC
- 		ifAbsentPut:
- 			[blockExtentsToTempRefs at: (startpcsToBlockExtents at: method initialPC)]!

Item was added:
+ ----- Method: DebuggerMethodMapForFullBlockCompiledMethods>>newBlockStartMap (in category 'private') -----
+ newBlockStartMap
+ 	"If blocks are embedded then keys in the map are simple integer pcs and a Dictionary can be used.
+ 	 If blocks are full (separate method objects) then keys in the map are CompiledBlocks and
+ 	 IdentityDictionary must be used to avoid confusing blocks with identical code."
+ 	^WeakIdentityKeyDictionary new!



More information about the Squeak-dev mailing list