[squeak-dev] The Inbox: Kernel-fm.867.mcz

Florin Mateoc florin.mateoc at gmail.com
Sat Aug 9 15:51:13 UTC 2014


forgot to mention, this also fixes a bug in abstractSymbolic : if a label was for the first instruction (e.g. in
whileFalse), it would not get printed.

Florin

On 8/9/2014 6:17 AM, commits at source.squeak.org wrote:
> A new version of Kernel was added to project The Inbox:
> http://source.squeak.org/inbox/Kernel-fm.867.mcz
>
> ==================== Summary ====================
>
> Name: Kernel-fm.867
> Author: fm
> Time: 9 August 2014, 2:17:44.186 am
> UUID: 87deb8dd-221f-d84d-acfe-17f9fb6ed689
> Ancestors: Kernel-eem.866
>
> various fixes and cleanups in RelativeInstructionPrinter
>
> pushConstant: , by being inherited, indirectly called InstructionPrinter instead of its Relative relative
>
> temp indexes are meaningless, they cause spurious differences (thus making abstractSymbolic less than abstract and symbolic), use the labelling pass to replace  them with their ordinals
>
> make clear that the labelling pass does not (need to) write anything
>
> =============== Diff against Kernel-eem.866 ===============
>
> Item was changed:
>   InstructionPrinter subclass: #RelativeInstructionPrinter
> + 	instanceVariableNames: 'printCode labels labelling temps vectors'
> - 	instanceVariableNames: 'printCode labels labelling'
>   	classVariableNames: ''
>   	poolDictionaries: ''
>   	category: 'Kernel-Methods'!
>
> Item was changed:
>   ----- Method: RelativeInstructionPrinter>>jump: (in category 'instruction decoding') -----
>   jump: offset
>   	"Print the Unconditional Jump bytecode."
>   
>   	labelling
>   		ifTrue:
> + 			[labels at: scanner pc + offset + 1 put: true]
> - 			[labels at: scanner pc + offset + 1 put: true.
> - 			 self print: 'jumpBy: ', offset printString,
> - 				' to: ', (scanner pc + offset - method initialPC) printString]
>   		ifFalse:
>   			[self print: 'jumpTo: ', (labels at: scanner pc + offset + 1)]!
>
> Item was changed:
>   ----- Method: RelativeInstructionPrinter>>jump:if: (in category 'instruction decoding') -----
>   jump: offset if: condition 
>   	"Print the Conditional Jump bytecode."
>   
>   	labelling
>   		ifTrue:
> + 			[labels at: scanner pc + offset + 1 put: true]
> - 			[labels at: scanner pc + offset + 1 put: true.
> - 			 self print: 
> - 				(condition ifTrue: ['jumpTrueBy: '] ifFalse: ['jumpFalseBy: ']), offset printString,
> - 				' to: ', (labelling
> - 							ifTrue: [(scanner pc + offset - method initialPC) printString]
> - 							ifFalse: [labels at: scanner pc + offset])]
>   		ifFalse:
>   			[self print: 
>   				(condition ifTrue: ['jumpTrueTo: '] ifFalse: ['jumpFalseTo: ']), (labels at: scanner pc + offset + 1)]!
>
> Item was added:
> + ----- Method: RelativeInstructionPrinter>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
> + popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
> + 
> + 	| remoteTemps |
> + 
> + 	labelling
> + 		ifTrue:
> + 			[remoteTemps := vectors at: tempVectorIndex ifAbsentPut: ['v', vectors size printString -> Dictionary new].
> + 			remoteTemps value at: remoteTempIndex ifAbsentPut: ['rt', remoteTemps value size printString]]
> + 		ifFalse:
> + 			[remoteTemps := vectors at: tempVectorIndex.
> + 			self print: 'popIntoTemp: ', (remoteTemps value at: remoteTempIndex), ' inVector: ', remoteTemps key]!
>
> Item was added:
> + ----- Method: RelativeInstructionPrinter>>popIntoTemporaryVariable: (in category 'instruction decoding') -----
> + popIntoTemporaryVariable: offset 
> + 	"Print the Remove Top Of Stack And Store Into Temporary Variable 
> + 	bytecode."
> + 
> + 	labelling
> + 		ifTrue:
> + 			[temps at: offset ifAbsentPut: ['t', temps size printString]]
> + 		ifFalse:
> + 			[self print: 'popIntoTemp: ' , (temps at: offset)]
> + !
>
> Item was changed:
>   ----- Method: RelativeInstructionPrinter>>print: (in category 'printing') -----
>   print: instruction 
>   	"Append to the receiver a description of the bytecode, instruction." 
>   
> + 	labelling ifTrue: 
> + 		[^self].
>   	stream tab: self indent.
> + 	(labels at: scanner pc) ~~ false ifTrue:
> + 		[stream nextPutAll: (labels at: scanner pc); nextPut: $:; cr].
> + 	stream tab.
> - 	labelling
> - 		ifTrue: [stream print: oldPC - method initialPC; space]
> - 		ifFalse: [stream tab].
>   	stream tab: (innerIndents at: oldPC).
>   	self printCode ifTrue:
>   		[stream nextPut: $<.
>   		 oldPC to: scanner pc - 1 do: 
>   			[:i | | code |
>   			code := (method at: i) radix: 16.
>   			stream
>   				nextPut: (code size < 2 ifTrue: [$0] ifFalse: [code at: 1]);
>   				nextPut: code last;
>   				space].
>   		 stream skip: -1; nextPut: $>; space].
>   	stream nextPutAll: instruction.
>   	stream cr.
> - 	labelling ifFalse:
> - 		[(labels at: scanner pc + 1) ~~ false ifTrue:
> - 			[stream nextPutAll: (labels at: scanner pc + 1); nextPut: $:; cr]].
>   	oldPC := scanner pc!
>
> Item was changed:
>   ----- Method: RelativeInstructionPrinter>>printInstructionsOn: (in category 'printing') -----
>   printInstructionsOn: aStream
>   	"Append to the stream, aStream, a description of each bytecode in the instruction stream."
>   	
>   	| label |
>   	labelling := true.
>   	labels := Array new: method size + 1 withAll: false.
> + 	temps := Dictionary new.
> + 	vectors := Dictionary new.
> + 	super printInstructionsOn: nil.
> - 	super printInstructionsOn: (String new: 1024) writeStream.
>   	label := 0.
>   	labels withIndexDo:
>   		[:bool :index|
>   		bool ifTrue: [labels at: index put: 'L', (label := label + 1) printString]].
>   	labelling := false.
>   	super printInstructionsOn: aStream!
>
> Item was changed:
>   ----- Method: RelativeInstructionPrinter>>printInstructionsOn:do: (in category 'printing') -----
>   printInstructionsOn: aStream do: aBlock
>   	"Append to the stream, aStream, a description of each bytecode in the instruction stream.
>   	  Evaluate aBlock with the receiver, the scanner and the stream after each instruction."
>   	
>   	| label |
>   	labelling := true.
>   	labels := Array new: method size withAll: false.
> + 	temps := Dictionary new.
> + 	vectors := Dictionary new.
> + 	super printInstructionsOn: nil do: [:ig :no :re|].
> - 	super printInstructionsOn: (String new: 1024) writeStream do: [:ig :no :re|].
>   	label := 0.
>   	labels withIndexDo:
>   		[:bool :index|
>   		bool ifTrue: [labels at: index put: 'L', (label := label + 1) printString]].
>   	labelling := false.
>   	super printInstructionsOn: aStream do: aBlock!
>
> Item was added:
> + ----- Method: RelativeInstructionPrinter>>pushConstant: (in category 'instruction decoding') -----
> + pushConstant: obj
> + 	"Print the Push Constant, obj, on Top Of Stack bytecode."
> + 
> + 	self print: (String streamContents:
> + 				[:s |
> + 				s nextPutAll: 'pushConstant: '.
> + 				(obj isKindOf: LookupKey)
> + 					ifFalse: [obj printOn: s]
> + 					ifTrue: [obj key
> + 						ifNotNil: [s nextPutAll: '##'; nextPutAll: obj key]
> + 						ifNil: [s nextPutAll: '###'; nextPutAll: obj value soleInstance name]]]).
> + 
> + 	(obj isKindOf: CompiledMethod) ifTrue:
> + 		[obj longPrintRelativeOn: stream indent: self indent + 2.
> + 		^self].!
>
> Item was added:
> + ----- Method: RelativeInstructionPrinter>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
> + pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex 
> + 	| remoteTemps |
> + 
> + 	labelling
> + 		ifTrue:
> + 			[remoteTemps := vectors at: tempVectorIndex ifAbsentPut: ['v', vectors size printString -> Dictionary new].
> + 			remoteTemps value at: remoteTempIndex ifAbsentPut: ['rt', remoteTemps value size printString]]
> + 		ifFalse:
> + 			[remoteTemps := vectors at: tempVectorIndex.
> + 			self print: 'pushTemp: ', (remoteTemps value at: remoteTempIndex), ' inVector: ', remoteTemps key]
> + !
>
> Item was added:
> + ----- Method: RelativeInstructionPrinter>>pushTemporaryVariable: (in category 'instruction decoding') -----
> + pushTemporaryVariable: offset
> + 	"Print the Push Contents Of Temporary Variable Whose Index Is the 
> + 	argument, offset, On Top Of Stack bytecode."
> + 
> + 	labelling
> + 		ifTrue:
> + 			[temps at: offset ifAbsentPut: ['t', temps size printString]]
> + 		ifFalse:
> + 			[self print: 'pushTemp: ' , (temps at: offset)]
> + !
>
> Item was added:
> + ----- Method: RelativeInstructionPrinter>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
> + storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex 
> + 	| remoteTemps |
> + 
> + 	labelling
> + 		ifTrue:
> + 			[remoteTemps := vectors at: tempVectorIndex ifAbsentPut: ['v', vectors size printString -> Dictionary new].
> + 			remoteTemps value at: remoteTempIndex ifAbsentPut: ['rt', remoteTemps value size printString]]
> + 		ifFalse:
> + 			[remoteTemps := vectors at: tempVectorIndex.
> + 			self print: 'storeIntoTemp: ', (remoteTemps value at: remoteTempIndex), ' inVector: ', remoteTemps key]
> + !
>
> Item was added:
> + ----- Method: RelativeInstructionPrinter>>storeIntoTemporaryVariable: (in category 'instruction decoding') -----
> + storeIntoTemporaryVariable: offset 
> + 	"Print the Store Top Of Stack Into Temporary Variable Of Method 
> + 	bytecode."
> + 
> + 	labelling
> + 		ifTrue:
> + 			[temps at: offset ifAbsentPut: ['t', temps size printString]]
> + 		ifFalse:
> + 			[self print: 'storeIntoTemp: ' , (temps at: offset)]
> + !
>
>
>



More information about the Squeak-dev mailing list