[squeak-dev] The Trunk: Compiler-eem.372.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jan 11 17:30:56 UTC 2018


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

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

Name: Compiler-eem.372
Author: eem
Time: 11 January 2018, 9:30:54.229387 am
UUID: 692e5c85-e068-42df-9404-266f9bd3c93f
Ancestors: Compiler-eem.371

Move BlockLocalTempCounter to Kernel.  It is used to implement BlockClosure>>numTemps, which is used more broadly than simply the decompiler and debugger.

=============== Diff against Compiler-eem.371 ===============

Item was removed:
- InstructionClient subclass: #BlockLocalTempCounter
- 	instanceVariableNames: 'stackPointer scanner blockEnd joinOffsets'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Compiler-Support'!
- 
- !BlockLocalTempCounter commentStamp: 'eem 1/11/2018 08:30' prior: 0!
- I am a support class for the decompiler that is used to find the number of local temps in a block by finding out what the stack offset is at the end of a block.  I am necessary because in the EncoderForV3PlusClosures bytecode set the only way to initialize block-local temporaries is with pushConstant: nil bytecodes, but such bytecodes are ambiguous with a pushConstant: nil used to pass nil as a parameter or answer it as a result.  By scanning through to the end of the block these can be disambiguated by tracking the stack depth.!

Item was removed:
- ----- Method: BlockLocalTempCounter class>>tempCountForBlockAt:in: (in category 'instance creation') -----
- tempCountForBlockAt: pc in: method
- 	^self new tempCountForBlockAt: pc in: method!

Item was removed:
- ----- Method: BlockLocalTempCounter class>>tempCountForBlockStartingAt:in: (in category 'instance creation') -----
- tempCountForBlockStartingAt: startpc in: method
- 	^self new
- 		tempCountForBlockAt: (method encoderClass pcOfBlockCreationBytecodeForBlockStartingAt: startpc in: method)
- 		in: method!

Item was removed:
- ----- Method: BlockLocalTempCounter>>blockReturnConstant: (in category 'instruction decoding') -----
- blockReturnConstant: value
- 	"Return Constant From Block bytecode."
- 	scanner pc < blockEnd ifTrue:
- 		[self doJoin]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>blockReturnTop (in category 'instruction decoding') -----
- blockReturnTop
- 	"Return Top Of Stack bytecode."
- 	stackPointer := stackPointer - 1.
- 	scanner pc < blockEnd ifTrue:
- 		[self doJoin]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>directedSuperSend:numArgs: (in category 'instruction decoding') -----
- directedSuperSend: selector numArgs: numArgs
- 	"Send Message Above Specific Class With Selector, selector, bytecode.
- 	 Start the lookup above the class that is the value of the association on
- 	 top of stack. The arguments  of the message are found in the top numArgs
- 	 stack locations beneath the association, and the receiver just below them."
- 
- 	stackPointer := stackPointer - (numArgs + 1)!

Item was removed:
- ----- Method: BlockLocalTempCounter>>doDup (in category 'instruction decoding') -----
- doDup
- 	"Duplicate Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>doJoin (in category 'private') -----
- doJoin
- 	scanner pc < blockEnd ifTrue:
- 		[stackPointer := joinOffsets at: scanner pc ifAbsent: [scanner followingPc]]
- 
- 	"the ifAbsent: handles a caseOf:otherwise: where all cases return, which results
- 	 in the branch around the otherwise being unreached.  e.g. in the following
- 		jumpTo: L2
- 	 is unreached.
- 
- 		| t |
- 		t caseOf: { [nil] -> [^thisContext method abstractSymbolic] }
- 		  otherwise: ['Oh no Mr Bill!!']
- 
- 		pushTemp: 0
- 		pushConstant: nil
- 		send: #= (1 arg)
- 		jumpFalseTo: L1
- 		pushThisContext: 
- 		send: #method (0 args)
- 		send: #abstractSymbolic (0 args)
- 		returnTop
- 		jumpTo: L2
- 	L1:
- 		pushConstant: 'Oh no Mr Bill!!'
- 	L2:
- 		returnTop"!

Item was removed:
- ----- Method: BlockLocalTempCounter>>doPop (in category 'instruction decoding') -----
- doPop
- 	"Remove Top Of Stack bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>jump: (in category 'instruction decoding') -----
- jump: offset
- 	"Unconditional Jump bytecode."
- 	offset > 0 ifTrue:
- 		[joinOffsets at: scanner pc + offset put: stackPointer.
- 		 self doJoin]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>jump:if: (in category 'instruction decoding') -----
- jump: offset if: condition 
- 	"Conditional Jump bytecode."
- 	stackPointer := stackPointer - 1.
- 	offset > 0 ifTrue:
- 		[joinOffsets at: scanner pc + offset put: stackPointer]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>methodReturnConstant: (in category 'instruction decoding') -----
- methodReturnConstant: value 
- 	"Return Constant bytecode."
- 	self doJoin!

Item was removed:
- ----- Method: BlockLocalTempCounter>>methodReturnReceiver (in category 'instruction decoding') -----
- methodReturnReceiver
- 	"Return Self bytecode."
- 	self doJoin!

Item was removed:
- ----- Method: BlockLocalTempCounter>>methodReturnTop (in category 'instruction decoding') -----
- methodReturnTop
- 	"Return Top Of Stack bytecode."
- 	stackPointer := stackPointer - 1.
- 	self doJoin!

Item was removed:
- ----- Method: BlockLocalTempCounter>>popIntoLiteralVariable: (in category 'instruction decoding') -----
- popIntoLiteralVariable: anAssociation 
- 	"Remove Top Of Stack And Store Into Literal Variable bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>popIntoReceiverVariable: (in category 'instruction decoding') -----
- popIntoReceiverVariable: offset 
- 	"Remove Top Of Stack And Store Into Instance Variable bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Remove Top Of Stack And Store Into Offset of Temp Vector bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>popIntoTemporaryVariable: (in category 'instruction decoding') -----
- popIntoTemporaryVariable: offset 
- 	"Remove Top Of Stack And Store Into Temporary Variable bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushActiveContext (in category 'instruction decoding') -----
- pushActiveContext
- 	"Push Active Context On Top Of Its Own Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
- pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
- 	"Push Closure bytecode.  Either compute the end of the block if this is
- 	 the block we're analysing, or skip it, adjusting the stack as appropriate."
- 	blockEnd
- 		ifNil: [blockEnd := scanner pc + blockSize]
- 		ifNotNil:
- 			[stackPointer := stackPointer - numCopied + 1.
- 			 scanner pc: scanner pc + blockSize]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushConsArrayWithElements: (in category 'instruction decoding') -----
- pushConsArrayWithElements: numElements
- 	"Push Cons Array of size numElements popping numElements items from the stack into the array bytecode."
- 	stackPointer := stackPointer - numElements + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushConstant: (in category 'instruction decoding') -----
- pushConstant: value
- 	"Push Constant, value, on Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushLiteralVariable: (in category 'instruction decoding') -----
- pushLiteralVariable: anAssociation
- 	"Push Contents Of anAssociation On Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushNewArrayOfSize: (in category 'instruction decoding') -----
- pushNewArrayOfSize: numElements 
- 	"Push New Array of size numElements bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushReceiver (in category 'instruction decoding') -----
- pushReceiver
- 	"Push Active Context's Receiver on Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushReceiverVariable: (in category 'instruction decoding') -----
- pushReceiverVariable: offset
- 	"Push Contents Of the Receiver's Instance Variable Whose Index 
- 	is the argument, offset, On Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Push Contents at Offset in Temp Vector bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushTemporaryVariable: (in category 'instruction decoding') -----
- pushTemporaryVariable: offset
- 	"Push Contents Of Temporary Variable Whose Index Is the 
- 	argument, offset, On Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>send:super:numArgs: (in category 'instruction decoding') -----
- send: selector super: supered numArgs: numberArguments
- 	"Send Message With Selector, selector, bytecode. The argument, 
- 	supered, indicates whether the receiver of the message is specified with 
- 	'super' in the source method. The arguments of the message are found in 
- 	the top numArguments locations on the stack and the receiver just 
- 	below them."
- 
- 	stackPointer := stackPointer - numberArguments!

Item was removed:
- ----- Method: BlockLocalTempCounter>>tempCountForBlockAt:in: (in category 'initialize-release') -----
- tempCountForBlockAt: pc in: method
- 	"Compute the number of local temporaries in a block.
- 	 If the block begins with a sequence of push: nil bytecodes then some of
- 	 These could be initializing local temps.  We can only reliably disambuguate
- 	 them from other uses of nil by parsing the stack and seeing what the offset
- 	 of the stack pointer is at the end of the block.
- 
- 	 There are short-cuts.  The ones we take here are
- 		- if there is no sequence of push nils there can be no local temps
- 		- we follow forward jumps to shorten the amount of scanning"
- 	stackPointer := 0.
- 	scanner := InstructionStream new method: method pc: pc.
- 	scanner interpretNextInstructionFor: self.
- 	blockEnd ifNil:
- 		[self error: 'pc is not that of a block'].
- 	scanner nextByte = method encoderClass pushNilCode ifTrue:
- 		[joinOffsets := Dictionary new.
- 		 [scanner pc < blockEnd] whileTrue:
- 			[scanner interpretNextInstructionFor: self]].
- 	^stackPointer!

Item was removed:
- ----- Method: BlockLocalTempCounter>>testTempCountForBlockAt:in: (in category 'initialize-release') -----
- testTempCountForBlockAt: startPc in: method
- 	"Compute the number of local temporaries in a block.
- 	 If the block begins with a sequence of push: nil bytecodes then some of
- 	 These could be initializing local temps.  We can only reliably disambuguate
- 	 them from other uses of nil by parsing the stack and seeing what the offset
- 	 of the stack pointer is at the end of the block.There are short-cuts.  The only
- 	 one we take here is
- 		- if there is no sequence of push nils there can be no local temps"
- 
- 	| symbolicLines line prior thePc |
- 	symbolicLines := Dictionary new.
- 	method symbolicLinesDo:
- 		[:pc :lineForPC| symbolicLines at: pc put: lineForPC].
- 	stackPointer := 0.
- 	scanner := InstructionStream new method: method pc: startPc.
- 	scanner interpretNextInstructionFor: self.
- 	blockEnd ifNil:
- 		[self error: 'pc is not that of a block'].
- 	scanner nextByte = method encoderClass pushNilCode ifTrue:
- 		[joinOffsets := Dictionary new.
- 		 [scanner pc < blockEnd] whileTrue:
- 			[line := symbolicLines at: scanner pc.
- 			 prior := stackPointer.
- 			 thePc := scanner pc.
- 			 scanner interpretNextInstructionFor: self.
- 			 Transcript cr; print: prior; nextPutAll: '->'; print: stackPointer;  tab; print: thePc; tab; nextPutAll: line; flush]].
- 	^stackPointer!

Item was removed:
- ----- Method: CompiledBlock>>startpcsToBlockExtents (in category '*Compiler-support') -----
- startpcsToBlockExtents
- 	^self outerCode startpcsToBlockExtents!

Item was removed:
- ----- Method: CompiledMethod>>blockExtentsInto:from:to:scanner:numberer: (in category '*Compiler-support') -----
- blockExtentsInto: aDictionary from: initialPC to: endPC scanner: scanner numberer: numbererBlock
- 	"Support routine for startpcsToBlockExtents"
- 	| extentStart blockSizeOrLocator |
- 	extentStart := numbererBlock value.
- 	[scanner pc <= endPC] whileTrue:
- 		[blockSizeOrLocator := scanner interpretNextInstructionFor: BlockStartLocator new.
- 		 blockSizeOrLocator isInteger ifTrue:
- 			[self
- 				blockExtentsInto: aDictionary
- 				from: scanner pc
- 				to: scanner pc + blockSizeOrLocator - 1
- 				scanner: scanner
- 				numberer: numbererBlock]].
- 	aDictionary at: initialPC put: (extentStart to: numbererBlock value).
- 	^aDictionary!

Item was removed:
- ----- Method: CompiledMethod>>startpcsToBlockExtents (in category '*Compiler-support') -----
- startpcsToBlockExtents
- 	"Answer a Dictionary of startpc to Interval of blockExtent, using the
- 	 identical numbering scheme described in and orchestrated by
- 	 BlockNode>>analyseArguments:temporaries:rootNode:.  This is used
- 	 to find the temp names for any block in a method, as needed by the
- 	 decompiler and debugger.  By indirecting through the blockExtent
- 	 instead of using the startpc directly we decouple access to temp
- 	 names from the exact bytecode; insulating the decompiler and
- 	 debugger from minor changes in the compiler's output.  If the
- 	 recompilation doesn't produce exactly the same bytecode at exactly
- 	 the same offset no matter; the blockExtents will be the same."
- 	| index |
- 	index := 0.
- 	^self
- 		blockExtentsInto: Dictionary new
- 		from: self initialPC
- 		to: self endPC
- 		scanner: (InstructionStream on: self)
- 		numberer: [| value | value := index. index := index + 2. value]!



More information about the Squeak-dev mailing list