[Vm-dev] VM Maker: VMMaker.oscog-eem.2002.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Nov 24 01:46:05 UTC 2016


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2002.mcz

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

Name: VMMaker.oscog-eem.2002
Author: eem
Time: 23 November 2016, 5:45:22.404678 pm
UUID: 326c4e54-4578-420d-948e-e5e58a1fa993
Ancestors: VMMaker.oscog-eem.2001

RegisterAllocatingCogit
Get the 64-bit system as far as the second \\ send in IdentityDictionary>>#scanFor:.

Set a simStackEntry's liveRegister in popToReg: and storeToReg: in addition to in genStorePop:TemporaryVariable:.  When setting liveRegister: in this way, look through the simStack for any and all copies of the entry having its liveRegister set, and set their liveRegister to match.

When ensuring that ensureReceiverResultRegContainsSelf, nuke any liveRegister in non-self stack entries that is equal ReceiverResultReg.
 
Make inlined genSpecialSelectorArithmetic keep register values live around the uncommon send by cloning the simStack after generating inline code and reconciling the register state after the send.

liveRegister must be taken into account when asking for a simStackEntry's registerMask to arrange that flushing/spilling occurs.

Print the optStatus as well as the simStack when tracing the simStack.

=============== Diff against VMMaker.oscog-eem.2001 ===============

Item was changed:
  CogSSBytecodeFixup subclass: #CogRASSBytecodeFixup
  	instanceVariableNames: 'cogit mergeSimStack'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
+ 
+ !CogRASSBytecodeFixup commentStamp: 'eem 11/22/2016 08:44' prior: 0!
+ A CogRASSBytecodeFixup extends CogSSBytecodeFixup with state to merge the stack at control-flow joins, preserving register contents.  By holding onto the entire stack state a CogRASSBytecodeFixup allows RegisterAllocatingCogit to merge individual stack entries, instead of merely spilling to the same height.
+ 
+ Instance Variables
+ 	cogit:					<RegisterAllocatingCogit>
+ 	mergeSimStack:		<Array of: CogRegisterAllocatingSimStackEntry>
+ 
+ cogit
+ 	- the JIT compiler
+ 
+ mergeSimStack
+ 	- the state of the stack at the jump to this fixup!

Item was changed:
  ----- Method: CogRegisterAllocatingSimStackEntry>>ensureSpilledAt:from: (in category 'compile abstract instructions') -----
  ensureSpilledAt: baseOffset from: baseRegister
- 	| inst |
- 	<var: #inst type: #'AbstractInstruction *'>
  	spilled ifTrue:
  		[type = SSSpill ifTrue:
  			[self assert: (offset = baseOffset and: [register = baseRegister]).
+ 			 liveRegister := NoReg.
  			 ^self]].
  	self assert: type ~= SSSpill.
  	cogit traceSpill: self.
  	type = SSConstant
  		ifTrue:
+ 			[cogit genPushConstant: constant]
- 			[inst := cogit genPushConstant: constant]
  		ifFalse:
  			[type = SSBaseOffset
  				ifTrue:
+ 					[liveRegister = NoReg
- 					[ liveRegister = NoReg
  						ifTrue: 
  							[cogit MoveMw: offset r: register R: TempReg.
+ 					 		 cogit PushR: TempReg]
+ 						ifFalse: [cogit PushR: liveRegister]]
- 					 		 inst := cogit PushR: TempReg ]
- 						ifFalse: [ inst := cogit PushR: liveRegister]]
  				ifFalse:
  					[self assert: type = SSRegister.
+ 					 cogit PushR: register].
- 					 inst := cogit PushR: register].
  			 type := SSSpill.
  			 offset := baseOffset.
  			 register := baseRegister].
+ 	liveRegister := NoReg.
+ 	spilled := true!
- 	spilled := true.!

Item was added:
+ ----- Method: CogRegisterAllocatingSimStackEntry>>isSameEntryAs: (in category 'comparing') -----
+ isSameEntryAs: ssEntry
+ 	^type = ssEntry type
+ 	  and: [((type = SSBaseOffset or: [type == SSSpill]) and: [offset = ssEntry offset and: [register = ssEntry register]])
+ 		or: [(type = SSRegister and: [register = ssEntry register])
+ 		or: [(type = SSConstant and: [constant = ssEntry constant])]]]!

Item was added:
+ ----- Method: CogRegisterAllocatingSimStackEntry>>noteLiveRegisterIn: (in category 'compile abstract instructions') -----
+ noteLiveRegisterIn: simStackEntry
+ 	"Copy the liveRegister state in simStackEntry into the receiver if it is the same value at a different location on the stack."
+ 	<inline: true>
+ 	self flag: 'should this also apply to SSConstant entries assigned to registers?'.
+ 	(self ~~ simStackEntry
+ 	 and: [type = simStackEntry type
+ 	 and: [type = SSBaseOffset
+ 	 and: [register = simStackEntry register and: [offset = simStackEntry offset]]]]) ifTrue:
+ 		[liveRegister := simStackEntry liveRegister]!

Item was added:
+ ----- Method: CogRegisterAllocatingSimStackEntry>>offset (in category 'accessing') -----
+ offset
+ 	"Answer the value of offset"
+ 	self assert: (type = SSBaseOffset or: [type = SSSpill]).
+ 	^offset!

Item was changed:
  ----- Method: CogRegisterAllocatingSimStackEntry>>popToReg: (in category 'compile abstract instructions') -----
  popToReg: reg
  	| inst |
  	<var: #inst type: #'AbstractInstruction *'>
  	liveRegister ~= NoReg
  		ifTrue: 
  			[inst := reg ~= liveRegister
  				ifTrue: [cogit MoveR: liveRegister R: reg]
  				ifFalse: [cogit Label] ]
  		ifFalse: 
  			[spilled
  				ifTrue:
  					[inst := cogit PopR: reg]
  				ifFalse:
  					[type caseOf: {
  						[SSBaseOffset]	-> [inst := cogit MoveMw: offset r: register R: reg].
  						[SSConstant]	-> [inst := cogit genMoveConstant: constant R: reg].
  						[SSRegister]	-> [inst := reg ~= register
  														ifTrue: [cogit MoveR: register R: reg]
  														ifFalse: [cogit Label]] }]].
+ 	reg ~= TempReg ifTrue:
+ 		[liveRegister := reg.
+ 		 cogit observeLiveRegisterIn: self]!
- 	reg ~= TempReg ifTrue: [ liveRegister := reg ]!

Item was added:
+ ----- Method: CogRegisterAllocatingSimStackEntry>>reconcileWith: (in category 'compile abstract instructions') -----
+ reconcileWith: simStackEntry
+ 	<var: #simStackEntry type: #'SimStackEntry *'>
+ 	type = SSConstant ifTrue:
+ 		[cogit AddCw: BytesPerWord R: SPReg.
+ 		 ^self].
+ 	liveRegister ~= NoReg ifTrue:
+ 		[simStackEntry popToReg: liveRegister.
+ 		 ^self].
+ 	type = SSRegister ifTrue:
+ 		[simStackEntry popToReg: register.
+ 		 ^self].
+ 	self halt!

Item was added:
+ ----- Method: CogRegisterAllocatingSimStackEntry>>register (in category 'accessing') -----
+ register
+ 	"Answer the value of register"
+ 	self assert: (type = SSBaseOffset or: [type = SSRegister or: [type = SSSpill]]).
+ 	^register!

Item was added:
+ ----- Method: CogRegisterAllocatingSimStackEntry>>registerMask (in category 'accessing') -----
+ registerMask
+ 	"Answer a bit mask for the receiver's register, if any."
+ 	liveRegister ~= NoReg ifTrue:
+ 		[^cogit registerMaskFor: liveRegister].
+ 	^super registerMask!

Item was added:
+ ----- Method: CogRegisterAllocatingSimStackEntry>>registerOrNone (in category 'accessing') -----
+ registerOrNone
+ 	liveRegister ~= NoReg ifTrue:
+ 		[^liveRegister].
+ 	^super registerOrNone!

Item was changed:
  ----- Method: CogRegisterAllocatingSimStackEntry>>storeToReg: (in category 'compile abstract instructions') -----
  storeToReg: reg
  	| inst |
  	<var: #inst type: #'AbstractInstruction *'>
  	liveRegister ~= NoReg
  		ifTrue:
  			[inst := reg ~= liveRegister
  							ifTrue: [cogit MoveR: liveRegister R: reg]
  							ifFalse: [cogit Label]]
  		ifFalse:
  			[type caseOf: {
  				[SSBaseOffset]	-> [inst := cogit MoveMw: offset r: register R: reg].
  				[SSSpill]		-> [inst := cogit MoveMw: offset r: register R: reg].
  				[SSConstant]	-> [inst := cogit genMoveConstant: constant R: reg].
  				[SSRegister]	-> [inst := reg ~= register
  												ifTrue: [cogit MoveR: register R: reg]
  												ifFalse: [cogit Label]] }].
+ 	reg ~= TempReg ifTrue:
+ 		[liveRegister := reg.
+ 		 cogit observeLiveRegisterIn: self]!
- 	reg ~= TempReg ifTrue: [ liveRegister := reg ]!

Item was changed:
  CogBytecodeFixup subclass: #CogSSBytecodeFixup
  	instanceVariableNames: 'simStackPtr simNativeStackPtr simNativeStackSize'
  	classVariableNames: 'NeedsMergeFixupFlag NeedsNonMergeFixupFlag UnknownSimStackPtrFlag'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
+ !CogSSBytecodeFixup commentStamp: 'eem 11/22/2016 08:39' prior: 0!
- !CogSSBytecodeFixup commentStamp: 'eem 1/20/2011 13:03' prior: 0!
  A CogSSBytecodeFixup extends CogBytecodeFixup with state to merge the stack at control-flow joins.  At a join the code generator must ensure that the stack is spilled to the same point along both branches and that the simStackPtr is correct.
  
  Instance Variables
  	simStackPtr:		<Integer>
  
  simStackPtr
+ 	- the simStackPtr at the jump to this fixup.  It should either agree with the incoming fixup if control continues, or replace the simStackPtr if control doesn't continue (the incomming control flow ended with a return)!
- 	- the simStackPtr at the jump to this fixup.  It should either agree with the incoming fixup if control continues, or replace the simStackPtr if contrl doesn't continue (the incomming control flow ended with a return)!

Item was changed:
  ----- Method: Cogit>>compilationTrace: (in category 'simulation only') -----
  compilationTrace: anInteger
+ 	"  1 = method/block compilation
+ 	   2 = bytecode descriptor.
+ 	   4 = simStack & optStatus
+ 	   8 = spill
- 	"1 = compilation
- 	 2 = bytecode descriptor.
- 	 4 = simStack.
- 	 8 = spill
  	 16 = merge
+ 	 32 = fixup"
- 	32 = fixup"
  	compilationTrace := anInteger!

Item was changed:
  ----- Method: Cogit>>exclude: (in category 'simulation only') -----
  exclude: aMethodObj
  	"For debugging, allow excluding methods based on selector or methodClass.  Answer if the mehtod should be excluded."
  	<inline: true>
  	self cCode: [] inSmalltalk: "for debugging, allow excluding methods based on selector or methodClass"
  		[self class initializationOptions
  			at: #DoNotJIT
  			ifPresent:
  				[:excluded| 
  				(excluded anySatisfy: [:exclude| aMethodObj = exclude]) ifTrue:
+ 					[coInterpreter transcript
+ 						ensureCr; nextPutAll: 'EXCLUDING ';
+ 						nextPutAll: aMethodObj; nextPutAll: ' (compiled block)';
+ 						cr; flush.
- 					[coInterpreter transcript nextPutAll: 'EXCLUDING '; nextPutAll: aMethodObj; nextPutAll: ' (compiled block)'; cr; flush.
  					 ^true]].
  		 (compilationTrace anyMask: 1) ifTrue:
  			[| methodClass |
  			 methodClass := coInterpreter nameOfClass: (coInterpreter methodClassOf: aMethodObj).
  			 coInterpreter transcript
+ 				ensureCr;
  				nextPutAll: 'compiling compiled block in ';
  				nextPutAll: methodClass;
  				cr; flush]].
  	^false!

Item was changed:
  ----- Method: Cogit>>exclude:selector: (in category 'simulation only') -----
  exclude: aMethodObj selector: aSelectorOop
  	"For debugging, allow excluding methods based on selector or methodClass.  Answer if the mehtod should be excluded."
  	<inline: true>
  	self cCode: [] inSmalltalk:
  		[| methodClass selector |
  		 self class initializationOptions
  			at: #DoNotJIT
  			ifPresent:
  				[:excluded|
  				methodClass := coInterpreter nameOfClass: (coInterpreter methodClassOf: aMethodObj).
  				selector := coInterpreter stringOf: aSelectorOop.
  				(excluded anySatisfy: [:exclude| selector = exclude or: [methodClass = exclude]]) ifTrue:
  					[coInterpreter transcript
+ 						ensureCr; nextPutAll: 'EXCLUDING ';
+ 						nextPutAll: methodClass; nextPutAll: '>>#'; nextPutAll: selector;
- 						nextPutAll: 'EXCLUDING ';
- 						nextPutAll: methodClass;
- 						nextPutAll: '>>#';
- 						nextPutAll: selector;
  						cr; flush.
  					 ^true]].
  		 (compilationTrace anyMask: 1) ifTrue:
  			[methodClass := coInterpreter nameOfClass: (coInterpreter methodClassOf: aMethodObj).
  			 selector := coInterpreter stringOf: aSelectorOop.
  			 selector isEmpty ifTrue:
  				[selector := coInterpreter stringOf: (coInterpreter maybeSelectorOfMethod: aMethodObj)].
  			 coInterpreter transcript
+ 				ensureCr; nextPutAll: 'compiling ';
+ 				nextPutAll: methodClass; nextPutAll: '>>#'; nextPutAll: selector;
- 				nextPutAll: 'compiling ';
- 				nextPutAll: methodClass;
- 				nextPutAll: '>>#';
- 				nextPutAll: selector;
  				cr; flush]].
  	^false!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>stringOf: (in category 'accessing') -----
  stringOf: anOop
+ 	^(self lookupAddress: anOop) asString!
- 	^self lookupAddress: anOop!

Item was changed:
  StackToRegisterMappingCogit subclass: #RegisterAllocatingCogit
+ 	instanceVariableNames: 'numFixups mergeSimStacksBase nextFixup scratchSimStack scratchSpillBase'
- 	instanceVariableNames: 'numFixups mergeSimStacksBase nextFixup'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !RegisterAllocatingCogit commentStamp: 'cb 4/15/2016 14:58' prior: 0!
  RegisterAllocatingCogit is an optimizing code generator that is specialized in register allocation..
  
  On the contrary to StackToRegisterMappingCogit, RegisterAllocatingCogit keeps at each control flow merge point the state of the simulated stack to merge into and not only an integer fixup. Each branch and jump record the current state of the simulated stack, and each fixup is responsible for merging this state into the saved simulated stack.
  !

Item was added:
+ ----- Method: RegisterAllocatingCogit class>>declareCVarsIn: (in category 'C translation') -----
+ declareCVarsIn: aCodeGen
+ 	aCodeGen var: #scratchSimStack type: #'CogSimStackEntry *'!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>copySimStackToScratch: (in category 'bytecode generator support') -----
+ copySimStackToScratch: spillBase
+ 	<inline: true>
+ 	self cCode: [self mem: scratchSimStack cp: simStack y: self simStackSlots * (self sizeof: CogSimStackEntry)]
+ 		inSmalltalk: [0 to: simStackPtr do:
+ 						[:i|
+ 						scratchSimStack at: i put: (simStack at: i) copy]].
+ 	scratchSpillBase := spillBase!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>ensureReceiverResultRegContainsSelf (in category 'bytecode generator support') -----
+ ensureReceiverResultRegContainsSelf
+ 	super ensureReceiverResultRegContainsSelf.
+ 	0 to: simStackPtr do:
+ 		[:i|
+ 		(simSelf isSameEntryAs: (self simStackAt: i))
+ 			ifTrue: [(self simStackAt: i) liveRegister: ReceiverResultReg]
+ 			ifFalse:
+ 				[(self simStackAt: i) liveRegister = ReceiverResultReg ifTrue:
+ 					[(self simStackAt: i) liveRegister: NoReg]]].
+ 	simSelf liveRegister: ReceiverResultReg!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>existsInstVarRefBeforeSendOrReturn (in category 'bytecode generator support') -----
+ existsInstVarRefBeforeSendOrReturn
+ 	"Answer if the current bytecode is followed by an inst var ref before the next full send."
+ 	| pc nExts descriptor |
+ 	pc := bytecodePC.
+ 	nExts := 0.
+ 	[pc <= endPC] whileTrue:
+ 		[descriptor := self generatorAt: pc.
+ 		 (descriptor isMapped
+ 		  or: [descriptor isBranchTrue
+ 		  or: [descriptor isBranchFalse
+ 		  or: [descriptor spanFunction notNil]]]) ifTrue:
+ 			[^false].
+ 		 descriptor isInstVarRef ifTrue:
+ 			[^true].
+ 		 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
+ 		 pc := self nextBytecodePCFor: descriptor at: pc exts: nExts in: methodObj].
+ 	^false!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>flushLiveRegistersForCRunTimeCall (in category 'bytecode generator support') -----
  flushLiveRegistersForCRunTimeCall
  	<inline: true>
+ 	| reg |
+ 	self assert: simSelf type = SSBaseOffset.
+ 	reg := simSelf liveRegister.
+ 	(reg ~= NoReg and: [(self isCallerSavedReg: reg)]) ifTrue:
+ 		[simSelf liveRegister: NoReg].
  	0 to: simStackPtr do:
+ 		[:i|
- 		[:i| | reg |
  		 self assert: (self simStackAt: i) type = (i <= methodOrBlockNumTemps
  													ifTrue: [SSBaseOffset]
  													ifFalse: [SSSpill]).
  		 reg := (self simStackAt: i) liveRegister.
  		 (reg ~= NoReg and: [(self isCallerSavedReg: reg)]) ifTrue:
  			[(self simStackAt: i) liveRegister: NoReg]]!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>flushLiveRegistersForSend (in category 'bytecode generator support') -----
+ flushLiveRegistersForSend
+ 	<inline: true>
+ 	self assert: simSelf type = SSBaseOffset.
+ 	simSelf liveRegister: NoReg.
+ 	0 to: simStackPtr do:
+ 		[:i|
+ 		 self assert: ((self simStackAt: i) spilled
+ 					 and: [((self simStackAt: i) type = SSBaseOffset
+ 							or: [i >= methodOrBlockNumTemps
+ 								and: (self simStackAt: i) type = SSSpill])
+ 					 and: [(self simStackAt: i) register = FPReg
+ 					 and: [(self simStackAt: i) offset = (self frameOffsetOfTemporary: i)]]]).
+ 		 (self simStackAt: i) liveRegister: NoReg]!

Item was removed:
- ----- Method: RegisterAllocatingCogit>>flushLiveRegistersForSend: (in category 'bytecode generator support') -----
- flushLiveRegistersForSend: numArgs
- 	<inline: true>
- 	simSelf liveRegister: NoReg.
- 	0 to: simStackPtr - numArgs - 1 do:
- 		[:i|
- 		 self assert: (self simStackAt: i) type = (i < methodOrBlockNumTemps
- 													ifTrue: [SSBaseOffset]
- 													ifFalse: [SSSpill]).
- 		 (self simStackAt: i) liveRegister: NoReg]!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>frameOffsetOfLastTemp (in category 'bytecode generator support') -----
+ frameOffsetOfLastTemp
+ 	^self frameOffsetOfTemporary: methodOrBlockNumTemps!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genMarshalledSend:numArgs:sendTable: (in category 'bytecode generator support') -----
  genMarshalledSend: selectorIndex numArgs: numArgs sendTable: sendTable
+ 	self flushLiveRegistersForSend.
- 	self flushLiveRegistersForSend: numArgs.
  	^super genMarshalledSend: selectorIndex numArgs: numArgs sendTable: sendTable!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>genSpecialSelectorArithmetic (in category 'bytecode generators') -----
+ genSpecialSelectorArithmetic
+ 	| primDescriptor rcvrIsConst argIsConst rcvrIsInt argIsInt rcvrInt argInt result
+ 	 jumpNotSmallInts jumpContinue index rcvrReg argReg |
+ 	<var: #jumpContinue type: #'AbstractInstruction *'>
+ 	<var: #primDescriptor type: #'BytecodeDescriptor *'>
+ 	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
+ 	primDescriptor := self generatorAt: byte0.
+ 	argIsInt := (argIsConst := self ssTop type = SSConstant)
+ 				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
+ 	rcvrIsInt := (rcvrIsConst := (self ssValue: 1) type = SSConstant)
+ 				 and: [objectMemory isIntegerObject: (rcvrInt := (self ssValue: 1) constant)].
+ 
+ 	(argIsInt and: [rcvrIsInt]) ifTrue:
+ 		[rcvrInt := objectMemory integerValueOf: rcvrInt.
+ 		 argInt := objectMemory integerValueOf: argInt.
+ 		 primDescriptor opcode caseOf: {
+ 			[AddRR]	-> [result := rcvrInt + argInt].
+ 			[SubRR]	-> [result := rcvrInt - argInt].
+ 			[AndRR]	-> [result := rcvrInt bitAnd: argInt].
+ 			[OrRR]	-> [result := rcvrInt bitOr: argInt] }.
+ 		(objectMemory isIntegerValue: result) ifTrue:
+ 			["Must annotate the bytecode for correct pc mapping."
+ 			^self ssPop: 2; ssPushAnnotatedConstant: (objectMemory integerObjectOf: result)].
+ 		^self genSpecialSelectorSend].
+ 
+ 	"If there's any constant involved other than a SmallInteger don't attempt to inline."
+ 	((rcvrIsConst and: [rcvrIsInt not])
+ 	 or: [argIsConst and: [argIsInt not]]) ifTrue:
+ 		[^self genSpecialSelectorSend].
+ 
+ 	"If we know nothing about the types then better not to inline as the inline cache and
+ 	 primitive code is not terribly slow so wasting time on duplicating tag tests is pointless."
+ 	(argIsInt or: [rcvrIsInt]) ifFalse:
+ 		[^self genSpecialSelectorSend].
+ 
+ 	argIsInt
+ 		ifTrue:
+ 			[rcvrReg := self allocateRegForStackEntryAt: 1.
+ 			 (self ssValue: 1) popToReg: rcvrReg.
+ 			 self MoveR: rcvrReg R: TempReg]
+ 		ifFalse:
+ 			[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
+ 			 self ssTop popToReg: argReg.
+ 			 (self ssValue: 1) popToReg: rcvrReg.
+ 			 self MoveR: argReg R: TempReg].
+ 	self ssPop: 2.
+ 	jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
+ 							ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
+ 							ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: rcvrReg andScratch: TempReg scratch: ClassReg].
+ 	primDescriptor opcode caseOf: {
+ 		[AddRR] -> [argIsInt
+ 						ifTrue:
+ 							[self AddCq: argInt - ConstZero R: rcvrReg.
+ 							 jumpContinue := self JumpNoOverflow: 0.
+ 							 "overflow; must undo the damage before continuing"
+ 							 self SubCq: argInt - ConstZero R: rcvrReg]
+ 						ifFalse:
+ 							[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: rcvrReg.
+ 							 self AddR: argReg R: rcvrReg.
+ 							jumpContinue := self JumpNoOverflow: 0.
+ 							"overflow; must undo the damage before continuing"
+ 							 rcvrIsInt
+ 								ifTrue: [self MoveCq: rcvrInt R: rcvrReg]
+ 								ifFalse:
+ 									[self SubR: argReg R: rcvrReg.
+ 									 objectRepresentation genSetSmallIntegerTagsIn: rcvrReg]]].
+ 		[SubRR] -> [argIsInt
+ 						ifTrue:
+ 							[self SubCq: argInt - ConstZero R: rcvrReg.
+ 							 jumpContinue := self JumpNoOverflow: 0.
+ 							 "overflow; must undo the damage before continuing"
+ 							 self AddCq: argInt - ConstZero R: rcvrReg]
+ 						ifFalse:
+ 							[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: argReg.
+ 							 self SubR: argReg R: rcvrReg.
+ 							 jumpContinue := self JumpNoOverflow: 0.
+ 							 "overflow; must undo the damage before continuing"
+ 							 self AddR: argReg R: rcvrReg.
+ 							 objectRepresentation genSetSmallIntegerTagsIn: argReg]].
+ 		[AndRR] -> [argIsInt
+ 						ifTrue: [self AndCq: argInt R: rcvrReg]
+ 						ifFalse: [self AndR: argReg R: rcvrReg].
+ 					jumpContinue := self Jump: 0].
+ 		[OrRR]	-> [argIsInt
+ 						ifTrue: [self OrCq: argInt R: rcvrReg]
+ 						ifFalse: [self OrR: argReg R: rcvrReg].
+ 					jumpContinue := self Jump: 0] }.
+ 	jumpNotSmallInts jmpTarget: self Label.
+ 	self ssPushRegister: rcvrReg.
+ 	self copySimStackToScratch: (simSpillBase min: simStackPtr - 1).
+ 	self ssPop: 1.
+ 	self ssFlushTo: simStackPtr.
+ 	self deny: rcvrReg = Arg0Reg.
+ 	argIsInt
+ 		ifTrue: [self MoveCq: argInt R: Arg0Reg]
+ 		ifFalse: [argReg ~= Arg0Reg ifTrue: [self MoveR: argReg R: Arg0Reg]].
+ 	rcvrReg ~= ReceiverResultReg ifTrue: [self MoveR: rcvrReg R: ReceiverResultReg].
+ 	index := byte0 - self firstSpecialSelectorBytecodeOffset.
+ 	self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines.
+ 	self reconcileRegisterStateForJoinAfterSpecialSelectorSend.
+ 	jumpContinue jmpTarget: self Label.
+ 	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genStorePop:TemporaryVariable: (in category 'bytecode generator support') -----
  genStorePop: popBoolean TemporaryVariable: tempIndex
  	"Override so that if a register other than TempReg is allocated, the temp is marked as being live in that register."
  	| reg |
  	self ssFlushUpThroughTemporaryVariable: tempIndex.
  	reg := self ssStorePop: popBoolean toPreferredReg: TempReg.
  	self MoveR: reg
  		Mw: (self frameOffsetOfTemporary: tempIndex)
  		r: FPReg.
  	reg ~= TempReg ifTrue:
+ 		[(self simStackAt: tempIndex) liveRegister: reg.
+ 		 self observeLiveRegisterIn: (self simStackAt: tempIndex)].
- 		[(self simStackAt: tempIndex) liveRegister: reg].
  	^0!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>initializeCodeZoneFrom:upTo: (in category 'initialization') -----
+ initializeCodeZoneFrom: startAddress upTo: endAddress
+ 	scratchSimStack := self cCode: [self malloc: self simStackSlots * (self sizeof: CogSimStackEntry)]
+ 							inSmalltalk: [CArrayAccessor on: ((1 to: self simStackSlots) collect: [:ign| CogRegisterAllocatingSimStackEntry new])].
+ 	super initializeCodeZoneFrom: startAddress upTo: endAddress!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>observeLiveRegisterIn: (in category 'bytecode generator support') -----
+ observeLiveRegisterIn: simStackEntry
+ 	"Copy the liveRegister in simStackEntry into all corresponding stack entries."
+ 	<var: #simStackEntry type: #'SimStackEntry *'>
+ 	simStackPtr to: 0 by: -1 do:
+ 		[:i|
+ 		(self simStackAt: i) noteLiveRegisterIn: simStackEntry]!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>reconcileRegisterStateForJoinAfterSpecialSelectorSend (in category 'bytecode generators') -----
+ reconcileRegisterStateForJoinAfterSpecialSelectorSend
+ 	"When the control flow from the inlined special selector code (e.g. add or comparison)
+ 	 joins the control flow from the send, taken when the inlined code fails, we should decide
+ 	 whether to reload any registers known to contain useful values or mark them as dead."
+ 	 
+ 	"If ReceiverResultReg is live along the inlined path, and is used before the next full send,
+ 	 reload it on the uncommon path."
+ 	optStatus isReceiverResultRegLive ifTrue:
+ 		[self existsInstVarRefBeforeSendOrReturn
+ 			ifTrue: [optStatus ssEntry storeToReg: ReceiverResultReg]
+ 			ifFalse: [optStatus isReceiverResultRegLive: false]].
+ 
+ 	"Restore the simStack to that in scratchSimStack,
+ 	 popping any spilled state back into allocated registers."
+ 	simSpillBase := scratchSpillBase.
+ 	simStackPtr to: simSpillBase + 1 by: -1 do:
+ 		[:i|
+ 		 self assert: (i = simStackPtr
+ 						ifTrue: [(self simStackAt: i) type = SSRegister]
+ 						ifFalse: [(self simStackAt: i) spilled]).
+ 		 (self addressOf: (scratchSimStack at: i)) reconcileWith: (self simStackAt: i).
+ 		 simStack
+ 			at: i
+ 			put: (self
+ 					cCode: [scratchSimStack at: i]
+ 					inSmalltalk: [(scratchSimStack at: i) copy])]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>simStack:at: (in category 'simulation stack') -----
  simStack: stack at: index
  	<cmacro: '(stack,index) ((stack) + (index))'>
+ 	<returnTypeC: #'SimStackEntry *'>
- 	<returnTypeC: #'CogSimStackEntry *'>
  	^self addressOf: (stack at: index)!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>ssFlushFrom:upThroughRegister: (in category 'simulation stack') -----
  ssFlushFrom: start upThroughRegister: reg
  	"Any occurrences on the stack of the register must be
  	 flushed, and hence any values colder than them stack."
+ 	<var: #desc type: #'SimStackEntry *'>
- 	<var: #desc type: #'CogSimStackEntry *'>
  	self ssFlushFrom: start upThrough: [ :desc | desc type = SSRegister and: [ desc register = reg ] ]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>ssStorePop:toPreferredReg: (in category 'simulation stack') -----
  ssStorePop: popBoolean toPreferredReg: preferredReg
  	"Store or pop the top simulated stack entry to a register.
  	 Use preferredReg if the entry is not itself a register.
  	 Answer the actual register the result ends up in."
  	| actualReg |
  	actualReg := preferredReg.
  	self ssTop type = SSRegister ifTrue: 
  		[self assert: (self ssTop liveRegister = NoReg
  					  or: [self ssTop liveRegister = self ssTop register]).
+ 		self assert: self ssTop spilled not.
+ 		actualReg := self ssTop register].
- 		self assert: self ssTop spilled not].
  	self ssTop liveRegister ~= NoReg ifTrue:
  		[actualReg := self ssTop liveRegister].
  	self ssStorePop: popBoolean toReg: actualReg. "generates nothing if ssTop is already in actualReg"
  	^ actualReg!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>printOptStatus (in category 'simulation only') -----
+ printOptStatus
+ 	<doNotGenerate>
+ 	coInterpreter transcript ensureCr; nextPutAll: 'opt: '.
+ 	(optStatus isReceiverResultRegLive ~~ true
+ 	 and: [optStatus ssEntry isNil]) ifTrue:
+ 		[coInterpreter transcript nextPutAll: 'none'].
+ 	optStatus printStateOn: coInterpreter transcript.
+ 	coInterpreter transcript cr; flush!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssFlushTo:nativeFlushTo: (in category 'simulation stack') -----
  ssFlushTo: index nativeFlushTo: nativeIndex
+ 	LowcodeVM ifTrue:
+ 		[self ssNativeFlushTo: nativeIndex].
+ 	0 to: methodOrBlockNumTemps - 1 do:
+ 		[:i| self assert: (self simStackAt: i) type = SSBaseOffset].
- 	LowcodeVM ifTrue: [ 
- 		self ssNativeFlushTo: nativeIndex.
- 	].
  	methodOrBlockNumTemps to: simSpillBase - 1 do:
  		[:i| self assert: (self simStackAt: i) spilled].
  	simSpillBase <= index ifTrue:
+ 		[(simSpillBase max: methodOrBlockNumTemps) to: index do:
- 		[(simSpillBase max: 0) to: index do:
  			[:i|
  			self assert: needsFrame.
  			(self simStackAt: i)
  				ensureSpilledAt: (self frameOffsetOfTemporary: i)
  				from: FPReg].
  		 simSpillBase := index + 1]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>traceSimStack (in category 'simulation only') -----
  traceSimStack
  	<cmacro: '() 0'>
  	(compilationTrace anyMask: 4) ifTrue:
+ 		[self printOptStatus; printSimStack]!
- 		[self printSimStack]!



More information about the Vm-dev mailing list