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

commits at source.squeak.org commits at source.squeak.org
Fri Jan 26 19:30:19 UTC 2018


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

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

Name: VMMaker.oscog-eem.2326
Author: eem
Time: 26 January 2018, 11:29:37.088038 am
UUID: 242c8fcc-b332-4a77-b9f1-9cc0f69c6db3
Ancestors: VMMaker.oscog-eem.2325

StackToRegisterMappingCogit:
For simplicity, especially in the RegisterAllocatingCogit subclass, eliminate simSelf and optStatus and include the receiver's simStackEntry as the 0'th element of the simStack.  optStatus is therefore whether simSelf's liveRegister is ReceiverResultReg.  hence loops from 0 to: methodOrBlockNumTemps - 1 become loops from 1 to: methodOrBlockNumTemps.  Teh simSelf variable is replaced by self simSelf, which is short-hand for self simStackAt: 0.

Consequently move te liveRegister accessors up from CogRegisterAllocatingSimStackEntry to CogSimStackEntry.

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

Item was changed:
  CogSSBytecodeFixup subclass: #CogRASSBytecodeFixup
+ 	instanceVariableNames: 'cogit mergeSimStack'
- 	instanceVariableNames: 'cogit mergeSimStack isReceiverResultRegSelf'
  	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: CogRASSBytecodeFixup>>cogit: (in category 'initialize-release') -----
  cogit: aCogit
  	cogit := aCogit.
- 	isReceiverResultRegSelf := false.
  	^self!

Item was removed:
- ----- Method: CogRASSBytecodeFixup>>isReceiverResultRegSelf (in category 'accessing') -----
- isReceiverResultRegSelf
- 
- 	^ isReceiverResultRegSelf!

Item was removed:
- ----- Method: CogRASSBytecodeFixup>>isReceiverResultRegSelf: (in category 'accessing') -----
- isReceiverResultRegSelf: anObject
- 
- 	^isReceiverResultRegSelf := anObject!

Item was changed:
  ----- Method: CogRASSBytecodeFixup>>reinitialize (in category 'accessing') -----
  reinitialize
  	<inline: true>
  	super reinitialize.
+ 	mergeSimStack := nil!
- 	mergeSimStack := nil.
- 	isReceiverResultRegSelf := false!

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

Item was removed:
- ----- Method: CogRegisterAllocatingSimStackEntry>>liveRegister: (in category 'accessing') -----
- liveRegister: anObject
- 
- 	^liveRegister := anObject!

Item was changed:
  ----- Method: CogSimStackEntry>>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]) or: [cogit violatesEnsureSpilledSpillAssert]).
- 			[self assert: (offset = baseOffset and: [register = baseRegister]).
  			 ^self]].
  	self assert: type ~= SSSpill.
  	cogit traceSpill: self.
  	type = SSConstant
  		ifTrue:
  			[inst := cogit genPushConstant: constant]
  		ifFalse:
  			[type = SSBaseOffset
  				ifTrue:
  					[cogit MoveMw: offset r: register R: TempReg.
  					 inst := cogit PushR: TempReg]
  				ifFalse:
  					[self assert: type = SSRegister.
  					 inst := cogit PushR: register].
  			 type := SSSpill.
  			 offset := baseOffset.
  			 register := baseRegister].
  	spilled := true.!

Item was added:
+ ----- Method: CogSimStackEntry>>liveRegister (in category 'accessing') -----
+ liveRegister
+ 
+ 	^ liveRegister!

Item was added:
+ ----- Method: CogSimStackEntry>>liveRegister: (in category 'accessing') -----
+ liveRegister: anObject
+ 
+ 	^liveRegister := anObject!

Item was changed:
  StackToRegisterMappingCogit subclass: #RegisterAllocatingCogit
+ 	instanceVariableNames: 'numFixups mergeSimStacksBase nextFixup scratchSimStack scratchSpillBase ceSendMustBeBooleanAddTrueLongTrampoline ceSendMustBeBooleanAddFalseLongTrampoline recompileForLoopRegisterAssignments scratchBytecodePC'
- 	instanceVariableNames: 'numFixups mergeSimStacksBase nextFixup scratchSimStack scratchSpillBase scratchSimSelf ceSendMustBeBooleanAddTrueLongTrampoline ceSendMustBeBooleanAddFalseLongTrampoline recompileForLoopRegisterAssignments scratchBytecodePC'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !RegisterAllocatingCogit commentStamp: 'eem 2/9/2017 10:40' prior: 0!
  RegisterAllocatingCogit is an optimizing code generator that is specialized for 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.
  
  Instance Variables
  	ceSendMustBeBooleanAddFalseLongTrampoline:		<Integer>
  	ceSendMustBeBooleanAddTrueLongTrampoline:		<Integer>
  	mergeSimStacksBase:									<Integer>
  	nextFixup:												<Integer>
  	numFixups:												<Integer>
  	scratchOptStatus:										<CogSSOptStatus>
  	scratchSimStack:										<Array of CogRegisterAllocatingSimStackEntry>
  	scratchSpillBase:										<Integer>
  
  ceSendMustBeBooleanAddFalseLongTrampoline
  	- the must-be-boolean trampoline for long jump false bytecodes (the existing ceSendMustBeBooleanAddFalseTrampoline is used for short branches)
  
  ceSendMustBeBooleanAddTrueLongTrampoline
  	- the must-be-boolean trampoline for long jump true bytecodes (the existing ceSendMustBeBooleanAddTrueTrampoline is used for short branches)
  
  mergeSimStacksBase
  	- the base address of the alloca'ed memory for merge fixups
  
  nextFixup
  	- the index into mergeSimStacksBase from which the next needed mergeSimStack will be allocated
  
  numFixups
  	- a conservative (over) estimate of the number of merge fixups needed in a method
  
  scratchOptStatus
  	- a scratch variable to hold the state of optStatus while merge code is generated
  
  scratchSimStack
  	- a scratch variable to hold the state of simStack while merge code is generated
  
  scratchSpillBase
  	- a scratch variable to hold the state of spillBase while merge code is generated!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>copySimStackToScratch: (in category 'bytecode generator support') -----
  copySimStackToScratch: spillBase
  	<inline: true>
  	scratchBytecodePC = bytecodePC ifTrue:
  		[^self].
  	scratchBytecodePC := bytecodePC.
  	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!
- 	scratchSpillBase := spillBase.
- 	scratchSimSelf := self cCode: [simSelf] inSmalltalk: [simSelf copy]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>deassignRegisterForTempVar:in: (in category 'bytecode generator support') -----
  deassignRegisterForTempVar: targetEntry in: mergeSimStack
  	"If merging a non-temp with a temp that has a live register we can assign
  	 to the register, but must unassign the register from the temp, otherwise
  	 the temp will acquire the merged value without an assignment.  The targetEntry
  	 must also be transmogrified into an SSRegister entry, which is done in the caller."
  	<var: #targetEntry type: #'SimStackEntry *'>
  	<var: #duplicateEntry type: #'SimStackEntry *'>
  	<var: #mergeSimStack type: #'SimStackEntry *'>
  	<inline: true>
  	| reg |
  	self halt.  "Clément and I hope this shouldn't happen as of the new merge code in reconcileRegistersInTempVarsInCurrentSimStackWithThoseIn:"
  	reg := targetEntry liveRegister.
  	self assert: (reg ~= NoReg and: [targetEntry type = SSConstant or: [targetEntry isFrameTempVar]]).
  	targetEntry type = SSConstant
  		ifTrue:
+ 			[simStackPtr to: 1 by: -1 do:
- 			[simStackPtr to: 0 by: -1 do:
  				[:j| | duplicateEntry |
  				 duplicateEntry := self simStack: mergeSimStack at: j.
  				 (duplicateEntry registerOrNone = reg
  				  and: [duplicateEntry type = SSBaseOffset or: [duplicateEntry type = SSSpill]]) ifTrue:
  					[duplicateEntry liveRegister: NoReg]]]
  		ifFalse:
+ 			[simStackPtr to: 1 by: -1 do:
- 			[simStackPtr to: 0 by: -1 do:
  				[:j| | duplicateEntry |
  				 duplicateEntry := self simStack: mergeSimStack at: j.
  				 (targetEntry isSameEntryAs: duplicateEntry) ifTrue:
+ 					[j <= methodOrBlockNumTemps
- 					[j < methodOrBlockNumTemps
  						ifTrue: [duplicateEntry liveRegister: NoReg]
  						ifFalse: [duplicateEntry type: SSRegister; register: reg]]]]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>duplicateRegisterAssignmentsInTemporaries (in category 'debugging') -----
  duplicateRegisterAssignmentsInTemporaries
  	| liveRegisters |
  	liveRegisters := 0.
+ 	0 to: methodOrBlockNumTemps do:
- 	0 to: methodOrBlockNumTemps - 1 do:
  		[:i| | liveRegister |
  		liveRegister := (self simStackAt: i) liveRegister.
  		liveRegister ~= NoReg ifTrue:
  			[(self register: liveRegister isInMask: liveRegisters) ifTrue:
  				[^true].
  			 liveRegisters := liveRegisters bitOr: 1 << liveRegister]].
  	^false!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>ensureNonMergeFixupAt: (in category 'compile abstract instructions') -----
  ensureNonMergeFixupAt: targetPC
  	"Make sure there's a flagged fixup at the target pc in fixups.
  	 Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction.
  	 Override to remember the simStack state at the target, if not already there."
  	"self printSimStack; printSimStack: fixup mergeSimStack"
  	true
  		ifTrue: [self shouldNotImplement]
  		ifFalse:
  			[| fixup |
  			fixup := super ensureNonMergeFixupAt: targetPC.
  			fixup mergeSimStack
  				ifNil: [self setMergeSimStackOf: fixup]
+ 				ifNotNil:
+ 					[self assert: simStackPtr = fixup simStackPtr.
+ 					 self deny: (self mergeRequiredToTarget: fixup mergeSimStack)].
- 				ifNotNil: [self assert: simStackPtr = fixup simStackPtr.
- 						self deny: (self mergeRequiredToTarget: fixup mergeSimStack)].
- 			self receiverIsInReceiverResultReg ifFalse:
- 				[fixup isReceiverResultRegSelf: false].
  			^fixup]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>ensureReceiverResultRegContainsSelf (in category 'bytecode generator support') -----
  ensureReceiverResultRegContainsSelf
+ 	methodOrBlockNumTemps + 1 to: simStackPtr do:
- 	methodOrBlockNumTemps to: simStackPtr do:
  		[:i|
+ 		(self simSelf isSameEntryAs: (self simStackAt: i))
- 		((self addressOf: simSelf) isSameEntryAs: (self simStackAt: i))
  			ifTrue: [(self simStackAt: i) liveRegister: ReceiverResultReg]
  			ifFalse:
  				[(self simStackAt: i) liveRegister = ReceiverResultReg ifTrue:
  					[(self simStackAt: i) liveRegister: NoReg]]].
+ 	super ensureReceiverResultRegContainsSelf.
- 	needsFrame
- 		ifTrue:
- 			[self receiverIsInReceiverResultReg ifFalse:
- 				[self ssAllocateRequiredReg: ReceiverResultReg.
- 				 self putSelfInReceiverResultReg]]
- 		ifFalse:
- 			[self assert: (simSelf type = SSRegister
- 						  and: [simSelf liveRegister = ReceiverResultReg])].
  	self assert: self receiverIsInReceiverResultReg!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>ensureRegisterAssignmentsAreAtHeadOfLoop: (in category 'bytecode generator support') -----
  ensureRegisterAssignmentsAreAtHeadOfLoop: target
  	"Compiling a loop body will compute a set of live registers.  The backward branch must merge
  	 with the head of the loop.  So it is preferrable to make the register assignments at the end of
  	 the loop available at the head.  To do this, simply copy the register assignments to the loop
  	 head's fixup in the first compilation pass and schedule a second compilation pass.  On the
  	 second pass the merge will occur when encountering the fixup for the loop head, using
  	 exactly the same code as for a merge at the end of an if."
  	| conflictingRegsMask |
  	compilationPass > 1 ifTrue:
  		["self deny: (self mergeRequiredToTarget: target mergeSimStack)."
  		 self assert: (target mergeSimStack isNil or: [self simStack: simStack isIdenticalTo: target mergeSimStack]).
  		 ^self].
  	(self mergeRequiredToTarget: target mergeSimStack) ifFalse:
  		[^self].
  	"Schedule a recompile and merge the end-of-loop assignments into the head of the loop,
  	 replacing any and all register assignments with the state as of the back jump.  Because
  	 typically the back jump will be taken much more often than the loop entered, favouring
  	 the assignments here is more efficient than trying to merge."
  	recompileForLoopRegisterAssignments := true.
  	conflictingRegsMask := self conflictingRegistersBetweenSimStackAnd: target mergeSimStack.
  	self deny: (self register: FPReg isInMask: conflictingRegsMask).
  	0 to: simStackPtr do:
  		[:i| | currentEntry targetEntry |
  		 currentEntry := self simStack: simStack at: i.
  		 targetEntry := self simStack: target mergeSimStack at: i.
+ 		 targetEntry liveRegister: currentEntry liveRegister]!
- 		 targetEntry liveRegister: currentEntry liveRegister].
- 	self receiverIsInReceiverResultReg ifTrue:
- 		[target isReceiverResultRegSelf: true]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>flushLiveRegistersForCRunTimeCall (in category 'bytecode generator support') -----
  flushLiveRegistersForCRunTimeCall
  	"Flush any live registers for a C call, i.e. don't flush caller-saved registers.
  	 Answer if any registers were flushed."
  	<inline: true>
  	| flushed reg |
  	flushed := false.
- 	self assert: simSelf type = SSBaseOffset.
- 	reg := simSelf liveRegister.
- 	(reg ~= NoReg and: [(self isCallerSavedReg: reg)]) ifTrue:
- 		[simSelf liveRegister: NoReg.
- 		 flushed := true].
  	0 to: simStackPtr do:
  		[:i|
+ 		 self assert: (self simStackAt: i) type = (i <= methodOrBlockNumTemps
- 		 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.
  			 flushed := true]].
  	^flushed!

Item was changed:
  ----- 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 = SSConstant
  						or: [((self simStackAt: i) type = SSBaseOffset
+ 							or: [i > methodOrBlockNumTemps
- 							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 changed:
  ----- Method: RegisterAllocatingCogit>>flushLiveRegistersForSuspensionPoint (in category 'bytecode generator support') -----
  flushLiveRegistersForSuspensionPoint
  	"Flush any live registers for a C call at a suspension/resumption point, i.e.flush all registers.
  	 Answer if any registers were flushed."
  	<inline: true>
  	| flushed |
  	flushed := false.
- 	self assert: simSelf type = SSBaseOffset.
- 	simSelf liveRegister ~= NoReg ifTrue:
- 		[simSelf liveRegister: NoReg.
- 		 flushed := true].
  	0 to: simStackPtr do:
  		[:i|
+ 		 self assert: (i <= methodOrBlockNumTemps
- 		 self assert: (i < methodOrBlockNumTemps
  						ifTrue: [(self simStackAt: i) type = SSBaseOffset]
  						ifFalse: [(self simStackAt: i)  spilled]).
  		 (self simStackAt: i) liveRegister ~= NoReg ifTrue:
  			[(self simStackAt: i) liveRegister: NoReg.
  			 flushed := true]].
  	^flushed!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>freeAnyRegNotConflictingWith: (in category 'simulation stack') -----
  freeAnyRegNotConflictingWith: regMask
  	"Spill the closest register on stack not conflicting with regMask. 
  	 Override to unassign assigned temp regs if necessary."
  	<var: #desc type: #'CogSimStackEntry *'>
  	| index desc |
  	self assert: needsFrame.
  	index := simSpillBase max: 0.
  	[index < simStackPtr] whileTrue: 
  		[desc := self simStackAt: index.
  		 desc type = SSRegister ifTrue:
  			[(regMask anyMask: (self registerMaskFor: desc register)) ifFalse: 
  				[self ssAllocateRequiredReg: desc register.
  				 ^desc register]].
  		 index := index + 1].
+ 	1 to: methodOrBlockNumTemps do:
- 	0 to: methodOrBlockNumTemps - 1 do:
  		[:i|
  		 desc := self simStackAt: i.
  		 (desc liveRegister = NoReg
+ 		  or: [self register: desc liveRegister isInMask: regMask]) ifFalse:
- 		 or: [self register: desc liveRegister isInMask: regMask]) ifFalse:
  			[self ssAllocateRequiredReg: desc liveRegister.
  			 ^desc liveRegister]].
+ 	(self simSelf liveRegister = NoReg
+ 	 or: [self register: self simSelf liveRegister isInMask: regMask]) ifFalse:
+ 		[self ssAllocateRequiredReg: self simSelf liveRegister.
+ 		 ^self simSelf liveRegister].
  	^NoReg!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genJumpBackTo: (in category 'bytecode generator support') -----
  genJumpBackTo: targetPC
  	| target |
  	"On first pass install register allocations (if any) as of the end of the loop and back up to recompile.
  	 One the second pass generate
  				(any merge other than self elided because register assignments copied to loop head in first pass)
  				cmp stackLimit
  				maybe reload self
  				jumpAboveOrEqual target
  				flush
  				checkForInterrupts
  				merge from flushed (N.B. If stack was flushed before loop we could conceivably jump to the pre-loop merge code)
  				jmp target
  	 self printSimStack; printSimStack: target mergeSimStack"
  	self assert: targetPC < bytecodePC.
  	target := self fixupAt: targetPC.
  	self ensureRegisterAssignmentsAreAtHeadOfLoop: target.
  	self MoveAw: coInterpreter stackLimitAddress R: TempReg.
- 	(target isReceiverResultRegSelf
- 	 and: [simSelf liveRegister = NoReg]) ifTrue:
- 		[(self addressOf: simSelf) storeToReg: ReceiverResultReg].
  	self CmpR: TempReg R: SPReg. "N.B. FLAGS := SPReg - TempReg"
  	self JumpAboveOrEqual: target.
  
  	self ssFlushTo: simStackPtr.
  	self CallRT: ceCheckForInterruptTrampoline.
  	self annotateBytecode: self Label.
  	self flushLiveRegistersForSuspensionPoint.
  	self mergeCurrentSimStackWith: target forwards: false.
  	self Jump: target.
  	deadCode := true. "can't fall through"
  	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genSpecialSelectorArithmetic (in category 'bytecode generators') -----
  genSpecialSelectorArithmetic
  	| primDescriptor rcvrIsConst argIsConst rcvrIsInt argIsInt rcvrInt argInt destReg
  	 jumpNotSmallInts jumpContinue jumpOverflow index rcvrReg argReg regMask |
  	<var: #jumpOverflow type: #'AbstractInstruction *'>
  	<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)])
+ 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: self simSelf]].
- 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: (self addressOf: simSelf)]].
  
  	(argIsInt and: [rcvrIsInt and: [rcvrIsConst]]) ifTrue:
  		[| result |
  		 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].
  
  	"Since one or other of the arguments is an integer we can very likely profit from inlining.
  	 But if the other type is not SmallInteger or if the operation overflows then we will need
  	 to do a send.  Since we're allocating values in registers we would like to keep those
  	 registers live on the inlined path and reload registers along the non-inlined send path.
  	 See reconcileRegisterStateForJoinAfterSpecialSelectorSend below."
  	argIsInt
  		ifTrue:
  			[rcvrReg := self allocateRegForStackEntryAt: 1.
  			 (self ssValue: 1) popToReg: rcvrReg.
  			 regMask := self registerMaskFor: rcvrReg]
  		ifFalse:
  			[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
  			 self ssTop popToReg: argReg.
  			 (self ssValue: 1) popToReg: rcvrReg.
  			 regMask := self registerMaskFor: rcvrReg and: argReg].
  
  	"rcvrReg can be reused for the result iff the receiver is a constant or is an SSRegister that is not used elsewhere."
  	destReg := ((rcvrIsInt and: [rcvrIsConst])
  				 or: [(self ssValue: 1) type = SSRegister
  					 and: [(self anyReferencesToRegister: rcvrReg inAllButTopNItems: 2) not]])
  					ifTrue: [rcvrReg]
  					ifFalse: [self allocateRegNotConflictingWith: regMask].
  	self ssPop: 2.
  	jumpNotSmallInts := (rcvrIsInt and: [argIsInt]) ifFalse:
  							[argIsInt
  								ifTrue: [objectRepresentation genJumpNotSmallInteger: rcvrReg]
  								ifFalse:
  									[rcvrIsInt
  										ifTrue: [objectRepresentation genJumpNotSmallInteger: argReg]
  										ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: rcvrReg and: argReg scratch: TempReg]]].
  	rcvrReg ~= destReg ifTrue:
  		[self MoveR: rcvrReg R: destReg].
  	primDescriptor opcode caseOf: {
  		[AddRR] -> [argIsInt
  						ifTrue:
  							[self AddCq: argInt - ConstZero R: destReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before doing send"
  							 rcvrReg = destReg ifTrue:
  								[self SubbCq: argInt - ConstZero R: rcvrReg]]
  						ifFalse:
  							[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: destReg.
  							 self AddR: argReg R: destReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							"overflow; must undo the damage before doing send"
  							 destReg = rcvrReg ifTrue:
  								[(rcvrIsInt and: [rcvrIsConst])
  									ifTrue: [self MoveCq: rcvrInt R: rcvrReg]
  									ifFalse:
  										[self SubbR: argReg R: rcvrReg.
  										 objectRepresentation genSetSmallIntegerTagsIn: rcvrReg]]]].
  		[SubRR] -> [argIsInt
  						ifTrue:
  							[self SubCq: argInt - ConstZero R: destReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before doing send"
  							 rcvrReg = destReg ifTrue:
  								[self AddcCq: argInt - ConstZero R: rcvrReg]]
  						ifFalse:
  							[(self anyReferencesToRegister: argReg inAllButTopNItems: 0)
  								ifTrue: "argReg is live; cannot strip tags and continue on no overflow without restoring tags"
  									[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: argReg.
  									 self SubR: argReg R: destReg.
  									 jumpOverflow := self JumpOverflow: 0.
  									 "no overflow; must undo the damage before continuing"
  									 objectRepresentation genSetSmallIntegerTagsIn: argReg.
  									 jumpContinue := self Jump: 0.
  									 jumpOverflow jmpTarget: self Label.
  									 "overflow; must undo the damage before doing send"
  									 ((rcvrIsInt and: [rcvrIsConst]) or: [destReg ~= rcvrReg]) ifFalse:
  										[self AddcR: argReg R: destReg].
  									 objectRepresentation genSetSmallIntegerTagsIn: argReg]
  								ifFalse:
  									[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: argReg.
  									 self SubR: argReg R: destReg.
  									 jumpContinue := self JumpNoOverflow: 0.
  									 "overflow; must undo the damage before doing send"
  									 ((rcvrIsInt and: [rcvrIsConst]) or: [destReg ~= rcvrReg]) ifFalse:
  										[self AddcR: argReg R: rcvrReg].
  									 objectRepresentation genSetSmallIntegerTagsIn: argReg]]].
  		[AndRR] -> [argIsInt
  						ifTrue: [self AndCq: argInt R: destReg]
  						ifFalse: [self AndR: argReg R: destReg].
  					jumpContinue := jumpNotSmallInts ifNotNil: [self Jump: 0]].
  		[OrRR]	-> [argIsInt
  						ifTrue: [self OrCq: argInt R: destReg]
  						ifFalse: [self OrR: argReg R: destReg].
  					jumpContinue := jumpNotSmallInts ifNotNil: [self Jump: 0]] }.
  	jumpNotSmallInts
  		ifNil: [jumpContinue ifNil: "overflow cannot happen"
  				[self annotateInstructionForBytecode.
  				 self ssPushRegister: destReg.
  				 ^0]]
  		ifNotNil:
  			[jumpNotSmallInts jmpTarget: self Label].
  	self ssPushRegister: destReg.
  	self copySimStackToScratch: (simSpillBase min: simStackPtr - 1).
  	self ssPop: 1.
  	self ssFlushTo: simStackPtr.
  	rcvrReg = Arg0Reg
  		ifTrue:
  			[argReg = ReceiverResultReg
  				ifTrue: [self SwapR: Arg0Reg R: Arg0Reg Scratch: TempReg. argReg := Arg0Reg]
  				ifFalse: [self MoveR: rcvrReg R: ReceiverResultReg].
  			 rcvrReg := ReceiverResultReg].
  	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>>genSpecialSelectorComparison (in category 'bytecode generators') -----
  genSpecialSelectorComparison
  	| nextPC postBranchPC targetPC primDescriptor branchDescriptor
  	  rcvrIsInt rcvrIsConst argIsIntConst argInt jumpNotSmallInts inlineCAB index rcvrReg argReg branchToTarget needMergeToContinue needMergeToTarget |
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	primDescriptor := self generatorAt: byte0.
  	argIsIntConst := self ssTop type = SSConstant
  				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
  	rcvrIsInt := ((rcvrIsConst := (self ssValue: 1) type = SSConstant)
  				  and: [objectMemory isIntegerObject: (self ssValue: 1) constant])
+ 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: self simSelf]].
- 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: (self addressOf: simSelf)]].
  
  	(argIsIntConst and: [rcvrIsInt and: [rcvrIsConst]]) ifTrue:
  		[^self genStaticallyResolvedSpecialSelectorComparison].
  
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetPC := target ].
  
  	"Only interested in inlining if followed by a conditional branch."
  	inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
  	"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
  	 The relational operators successfully statically predict SmallIntegers; the equality operators do not."
  	(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
  		[inlineCAB := argIsIntConst or: [rcvrIsInt]].
  	inlineCAB ifFalse:
  		[^self genSpecialSelectorSend].
  
  	"In-line the comparison and the jump, but if the types are not SmallInteger then we will need
  	 to do a send and fall through to the following conditional branch.  Since we're allocating values
  	 in registers we would like to keep those registers live on the inlined path and reload registers
  	 along the non-inlined send path.  The merge logic at the branch destinations handles this."
  	argIsIntConst
  		ifTrue:
  			[rcvrReg := self allocateRegForStackEntryAt: 1.
  			 (self ssValue: 1) popToReg: rcvrReg.
  			 argReg := NoReg]
  		ifFalse:
  			[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
  			 self ssTop popToReg: argReg.
  			 (self ssValue: 1) popToReg: rcvrReg].
  	self ssPop: 2.
  	jumpNotSmallInts := (rcvrIsInt and: [argIsIntConst]) ifFalse:
  							[argIsIntConst
  								ifTrue: [objectRepresentation genJumpNotSmallInteger: rcvrReg]
  								ifFalse:
  									[rcvrIsInt
  										ifTrue: [objectRepresentation genJumpNotSmallInteger: argReg]
  										ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: rcvrReg and: argReg scratch: TempReg]]].
  	argIsIntConst
  		ifTrue: [self CmpCq: argInt R: rcvrReg]
  		ifFalse: [self CmpR: argReg R: rcvrReg].
  
  	"self printSimStack; printSimStack: (self fixupAt: postBranchPC) mergeSimStack; printSimStack: (self fixupAt: targetPC) mergeSimStack"
  	"If there are merges to be performed on the forward branches we have to execute
  	 the merge code only along the path requiring that merge, and exactly once."
  	needMergeToTarget := self mergeRequiredForJumpTo: targetPC.
  	needMergeToContinue := self mergeRequiredForJumpTo: postBranchPC.
  	"Cmp is weird/backwards so invert the comparison."
  	(needMergeToTarget and: [needMergeToContinue]) ifTrue:
  		[branchToTarget := self genConditionalBranch: (branchDescriptor isBranchTrue
  										ifTrue: [primDescriptor opcode]
  										ifFalse: [self inverseBranchFor: primDescriptor opcode])
  								operand: 0.
  		 self Jump: (self ensureFixupAt: postBranchPC).
  		 branchToTarget jmpTarget: self Label.
  		 self Jump: (self ensureFixupAt: targetPC)].
  	(needMergeToTarget and: [needMergeToContinue not]) ifTrue:
  		[self genConditionalBranch: (branchDescriptor isBranchFalse
  										ifTrue: [primDescriptor opcode]
  										ifFalse: [self inverseBranchFor: primDescriptor opcode])
  			operand: (self ensureFixupAt: postBranchPC) asUnsignedInteger.
  		 self Jump: (self ensureFixupAt: targetPC)].
  	(needMergeToTarget not and: [needMergeToContinue]) ifTrue:
  		[self genConditionalBranch: (branchDescriptor isBranchTrue
  										ifTrue: [primDescriptor opcode]
  										ifFalse: [self inverseBranchFor: primDescriptor opcode])
  			operand: (self ensureFixupAt: targetPC) asUnsignedInteger.
  		 self Jump: (self ensureFixupAt: postBranchPC)].
  	(needMergeToTarget or: [needMergeToContinue]) ifFalse:
  		[self genConditionalBranch: (branchDescriptor isBranchTrue
  										ifTrue: [primDescriptor opcode]
  										ifFalse: [self inverseBranchFor: primDescriptor opcode])
  			operand: (self ensureFixupAt: targetPC) asUnsignedInteger.
  		 self Jump: (self ensureFixupAt: postBranchPC)].
  	jumpNotSmallInts ifNil:
  		[self annotateInstructionForBytecode.
  		 deadCode := true.
  		 ^0].
  	jumpNotSmallInts jmpTarget: self Label.
  	self ssFlushTo: simStackPtr.
  	rcvrReg = Arg0Reg
  		ifTrue:
  			[argReg = ReceiverResultReg
  				ifTrue: [self SwapR: Arg0Reg R: Arg0Reg Scratch: TempReg. argReg := Arg0Reg]
  				ifFalse: [self MoveR: rcvrReg R: ReceiverResultReg].
  			 rcvrReg := ReceiverResultReg].
  	argIsIntConst
  		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!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>initSimStackForFramefulMethod: (in category 'simulation stack') -----
  initSimStackForFramefulMethod: startpc
  	super initSimStackForFramefulMethod: startpc.
- 	simSelf liveRegister: NoReg.
  	0 to: simStackPtr do:
  		[:i| (self simStackAt: i) liveRegister: NoReg]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>initSimStackForFramelessBlock: (in category 'simulation stack') -----
  initSimStackForFramelessBlock: startpc
  	super initSimStackForFramelessBlock: startpc.
+ 	self simSelf liveRegister: ReceiverResultReg.
+ 	1 to: simStackPtr do:
- 	simSelf liveRegister: ReceiverResultReg.
- 	0 to: simStackPtr do:
  		[:i| (self simStackAt: i) liveRegister: NoReg]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>initSimStackForFramelessMethod: (in category 'simulation stack') -----
  initSimStackForFramelessMethod: startpc
  	super initSimStackForFramelessMethod: startpc.
- 	simSelf liveRegister: ReceiverResultReg.
  	0 to: simStackPtr do:
  		[:i| | desc |
  		desc := self simStackAt: i.
  		desc liveRegister: (desc type = SSRegister ifTrue: [desc register] ifFalse: [NoReg])]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>mergeCurrentSimStackWith:forwards: (in category 'bytecode generator support') -----
  mergeCurrentSimStackWith: fixup forwards: forwards
  	"At a merge point the cogit expects the stack to be in the same state as mergeSimStack.
  	 mergeSimStack is the state as of some jump forward or backward to this point.  So make
  	 simStack agree with mergeSimStack (it is, um, problematic to plant code at the jump).
  	 Values may have to be assigned to registers.  Registers may have to be swapped.
  	 The state of optStatus must agree.
  	 Generate code to merge the current simStack with that of the target fixup,
  	 the goal being to keep as many registers live as possible.  If the merge is forwards
  	 registers can be deassigned (since registers are always written to temp vars).
  	 But if backwards, nothing can be deassigned, and the state /must/ reflect the target."
  	"self printSimStack; printSimStack: fixup mergeSimStack"
  	"abstractOpcodes object copyFrom: startIndex to: opcodeIndex"
  	<var: #fixup type: #'BytecodeFixup *'>
  	| startIndex mergeSimStack |
  	<var: #mergeSimStack type: #'SimStackEntry *'>
  	<var: #targetEntry type: #'SimStackEntry *'>
  	<var: #currentEntry type: #'SimStackEntry *'>
  	(mergeSimStack := fixup mergeSimStack) ifNil: [^self].
  	startIndex := opcodeIndex. "for debugging"
  	"Assignments amongst the registers must be made in order to avoid overwriting.
  	 If necessary exchange registers amongst simStack's entries to resolve any conflicts."
  	self reconcileRegistersInTempVarsInCurrentSimStackWithThoseIn: mergeSimStack.
  	(self asserta: (self conflictsResolvedBetweenSimStackAnd: mergeSimStack)) ifFalse:
  		[Notification new tag: #failedMerge; signal].
  	(self pushForMergeWith: mergeSimStack)
  		ifTrue:
+ 			[methodOrBlockNumTemps + 1 to: simStackPtr do:
- 			[methodOrBlockNumTemps to: simStackPtr do:
  				[:i| self mergePushingWithEntryInTargetSimStack: mergeSimStack at: i]]
  		ifFalse:
+ 			[simStackPtr to: methodOrBlockNumTemps + 1 by: -1 do:
- 			[simStackPtr to: methodOrBlockNumTemps by: -1 do:
  				[:i| self mergePoppingWithEntryInTargetSimStack: mergeSimStack at: i]].
  	"Still haven't handled simSpillBase."
  	self assert: (simSpillBase > simStackPtr
+ 				or: [simSpillBase > methodOrBlockNumTemps
+ 					and: [(self simStack: mergeSimStack at: simSpillBase) spilled]])!
- 				or: [simSpillBase < (methodOrBlockNumTemps max: 1)
- 				or: [(self simStack: mergeSimStack at: simSpillBase - 1) spilled]]).
- 	fixup isReceiverResultRegSelf ifTrue:
- 		[self receiverIsInReceiverResultReg ifFalse:
- 			[self putSelfInReceiverResultReg]]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>mergePushingWithEntryInTargetSimStack:at: (in category 'bytecode generator support') -----
  mergePushingWithEntryInTargetSimStack: mergeSimStack at: i
  	"Merge an intermediate result on currentSimStack with the corresponding one in target's mergeSimStack.
  	 Depending on spilledness, the stack may need to be pushed or popped, or simply a register assignment made."
  	| currentEntry targetEntry |
  	<inline: true>
  	currentEntry := self simStack: simStack at: i.
  	targetEntry := self simStack: mergeSimStack at: i.
  	(currentEntry reconcilePushingWith: targetEntry) ifTrue:
+ 		[self assert: i > methodOrBlockNumTemps.
- 		[self assert: i >= methodOrBlockNumTemps.
  		 self deassignRegisterForTempVar: targetEntry in: mergeSimStack.
  		 targetEntry
  			type: SSRegister;
  			register: targetEntry liveRegister].
  	 "Note, we could update the simStack and spillBase here but that is done in restoreSimStackAtMergePoint:
  	 spilled ifFalse:
  		[simSpillBase := i - 1].
  	 simStack
  		at: i
  		put: (self
  				cCode: [mergeSimStack at: i]
  				inSmalltalk: [(mergeSimStack at: i) copy])"!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>pushForMergeWith: (in category 'bytecode generator support') -----
  pushForMergeWith: mergeSimStack
  	"Answer if values must be pushed from simStack to merge with mergeSimStack, otherwise < 0 (the default)."
  	<var: #mergeSimStack type: #'SimStackEntry *'>
  	<inline: true>
+ 	simStackPtr to: methodOrBlockNumTemps + 1 by: -1 do:
- 	simStackPtr to: methodOrBlockNumTemps by: -1 do:
  		[:i|
  		 (self simStack: mergeSimStack at: i) spilled ~= (self simStack: simStack at: i) spilled ifTrue:
  			[^(self simStack: mergeSimStack at: i) spilled]].
  	^false!

Item was removed:
- ----- Method: RegisterAllocatingCogit>>receiverIsInReceiverResultReg (in category 'bytecode generator support') -----
- receiverIsInReceiverResultReg
- 	"Used to mark ReceiverResultReg as dead or not containing simSelf.
- 	 Used when the simStack has already been flushed, e.g. for sends."
- 	<inline: true>
- 	^simSelf liveRegister = ReceiverResultReg!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>reconcileRegisterStateForJoinAfterSpecialSelectorSend (in category 'bytecode generator support') -----
  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."
- 	scratchSimSelf liveRegister = ReceiverResultReg ifTrue:
- 		[(self existsInstVarRefBeforeSendOrReturn
- 		  or: [self receiverRefOnScratchSimStack])
- 			ifTrue:
- 				[simSelf liveRegister: ReceiverResultReg.
- 				 self putSelfInReceiverResultReg]
- 			ifFalse: [self voidReceiverOptStatus]].
- 
  	"Restore the simStack to that in scratchSimStack,
  	 popping any spilled state back into allocated registers."
  	simSpillBase := scratchSpillBase.
  	simStackPtr to: 0 by: -1 do:
  		[:i|
  		 self assert: (i = simStackPtr
  						ifTrue: [(self simStackAt: i) type = SSRegister]
  						ifFalse: [(self simStackAt: i) spilled]).
  		 (self simStackAt: i) reconcilePoppingWith: (self simStack: scratchSimStack at: i).
  		 simStack
  			at: i
  			put: (self
  					cCode: [scratchSimStack at: i]
  					inSmalltalk: [(scratchSimStack at: i) copy])]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>reconcileRegistersInTempVarsInCurrentSimStackWithThoseIn: (in category 'bytecode generator support') -----
  reconcileRegistersInTempVarsInCurrentSimStackWithThoseIn: mergeSimStack
  	<var: #mergeSimStack type: #'SimStackEntry *'>
+ 	0 to: methodOrBlockNumTemps do: 
- 	0 to: methodOrBlockNumTemps - 1 do: 
  		[ :i | | current target |
  		current := self simStack: simStack at: i.
  		target := self simStack: mergeSimStack at: i.
  		target registerMaskOrNone ~= 0 
  			ifTrue:
  				[ target registerMaskOrNone ~= current registerMaskOrNone ifTrue:
  					[ self swap: target with: current at: i]]
  			ifFalse: [current liveRegister: NoReg]].
  	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>resetSimStack: (in category 'bytecode generator support') -----
  resetSimStack: startPC
  	<inline: true>
+ 	simSpillBase := methodOrBlockNumTemps + 1.
+ 	simStackPtr := methodOrBlockNumTemps.
- 	simSpillBase := methodOrBlockNumTemps.
- 	simStackPtr := methodOrBlockNumTemps - 1.
  	self flushLiveRegistersForSend.
  	self cCode: '' inSmalltalk:
+ 		[0 to: methodOrBlockNumTemps do:
- 		[0 to: methodOrBlockNumTemps - 1 do:
  			[:i|
  			(self simStackAt: i) bcptr: startPC]]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>restoreSimStackAtMergePoint: (in category 'simulation stack') -----
  restoreSimStackAtMergePoint: fixup
  	<inline: true>
  	"All the execution paths reaching a merge point expect everything to be spilled
  	 on stack and the optStatus is unknown.  If the merge point follows a return, it
  	 isn't a merge, but a skip past a return.  If it is a real merge point then throw
  	 away all simStack and optStatus optimization state."
+ 
- 	simSelf liveRegister: (fixup isReceiverResultRegSelf
- 							ifTrue: [ReceiverResultReg]
- 							ifFalse: [NoReg]).
  	fixup mergeSimStack ifNotNil:
+ 		[simSpillBase := methodOrBlockNumTemps + 1.
- 		[simSpillBase := methodOrBlockNumTemps.
  		 0 to: simStackPtr do:
  			[:i|
  			self cCode: [simStack at: i put: (fixup mergeSimStack at: i)]
  				inSmalltalk: [(simStack at: i) copyFrom: (fixup mergeSimStack at: i)]]].
  	^0!

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

Item was removed:
- ----- Method: RegisterAllocatingCogit>>setInterpreter: (in category 'initialization') -----
- setInterpreter: aCoInterpreter
- 	"Override to elide optStatus which shoudl be unused since simSelf has a liveRegister
- 	 and hence more elegantly accomplishes the same purpose."
- 	<doNotGenerate>
- 	super setInterpreter: aCoInterpreter.
- 	optStatus := nil!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>setMergeSimStackOf: (in category 'bytecode generator support') -----
  setMergeSimStackOf: fixup
  	<var: #fixup type: #'BytecodeFixup *'>
  	self moveVolatileSimStackEntriesToRegisters.
  	fixup mergeSimStack
  		ifNil:
  			[self assert: nextFixup <= numFixups.
  			 self cCode: [fixup mergeSimStack: mergeSimStacksBase + (nextFixup * self simStackSlots * (self sizeof: CogSimStackEntry))].
  			 nextFixup := nextFixup + 1]
  		ifNotNil:
  			[self assert: fixup simStackPtr = simStackPtr.
  			 0 to: simStackPtr do:
  				[:i|
  				self assert: ((self simStackAt: i) isSameEntryAs: (self addressOf: (fixup mergeSimStack at: i))).
  				(self simStackAt: i) liveRegister ~= (self addressOf: (fixup mergeSimStack at: i)) liveRegister ifTrue:
  					[(self simStackAt: i) liveRegister: NoReg]]].
+ 	fixup simStackPtr: simStackPtr.
- 	fixup
- 		simStackPtr: simStackPtr;
- 		isReceiverResultRegSelf: self receiverIsInReceiverResultReg.
  	self cCode: [self mem: fixup mergeSimStack cp: simStack y: self simStackSlots * (self sizeof: CogSimStackEntry)]
  		inSmalltalk: [fixup mergeSimStack: self copySimStack]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>simSelfOnStackInReceiverResultReg (in category 'bytecode generator support') -----
  simSelfOnStackInReceiverResultReg
  	"For assert checking only."
+ 	methodOrBlockNumTemps + 1 to: simStackPtr do:
- 	methodOrBlockNumTemps to: simStackPtr do:
  		[:i|
+ 		 ((self simSelf isSameEntryAs: (self simStackAt: i))
- 		 (((self addressOf: simSelf) isSameEntryAs: (self simStackAt: i))
  		  and: [(self simStackAt: i) registerOrNone = ReceiverResultReg]) ifTrue:
  			[^true]].
  	^false!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>ssAllocateRequiredRegMask:upThrough:upThroughNative: (in category 'simulation stack') -----
  ssAllocateRequiredRegMask: requiredRegsMask upThrough: stackPtr upThroughNative: nativeStackPtr
  	"Override to void any required registers in temp vars."
+ 	0 to: methodOrBlockNumTemps do:
- 	(requiredRegsMask anyMask: (self registerMaskFor: ReceiverResultReg)) ifTrue:
- 		[self voidReceiverOptStatus].
- 	0 to: methodOrBlockNumTemps - 1 do:
  		[:i|
  		((self simStackAt: i) registerMask anyMask: requiredRegsMask) ifTrue:
  			[(self simStackAt: i) liveRegister: NoReg]].
  	super ssAllocateRequiredRegMask: requiredRegsMask upThrough: stackPtr upThroughNative: nativeStackPtr!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>swap:with:at: (in category 'bytecode generator support') -----
  swap: target with: current at: index
  	"Swaps the registers between target and current.
  	 target is guaranteed to be in a register. Current is not.
  	 If current is in a register, just perform a register swap and update the simStack.
  	 If current is not in a register, free the target register and use it.
  	 Invariant:
  		items in current's simStack up to index have been resolved with target because we are visiting the stack in order 0 to siumStackPtr.
  	 Strategy:
  		since the target simStack is valid (it has a unique disposition of temps) we can
  		spill to obtain registers (since once an entry is written to ther stack its register, if any, can be freed)
  		pop to assign after fully spilling (if necessary)"
  	| currentLiveRegisters |
  	self assert: target registerMaskOrNone ~= 0.
  	current registerMaskOrNone ~= 0 ifTrue: 
  		[ self SwapR: target liveRegister R: current liveRegister Scratch: RISCTempReg.
+ 		  methodOrBlockNumTemps + 1 to: simStackPtr do: 
- 		  methodOrBlockNumTemps to: simStackPtr do: 
  			[:i| | localCurrent |
  			localCurrent := self simStack: simStack at: i.
  			localCurrent liveRegister = current liveRegister 
  				ifTrue: [ localCurrent liveRegister: target liveRegister ]
  				ifFalse: [ localCurrent liveRegister = target liveRegister
  						ifTrue: [ localCurrent liveRegister: current liveRegister ] ] ].
  		current liveRegister: target liveRegister.
  		 ^ 0 ].
+ 	0 to: index - 1 do: [:j | self assert: (self simStack: simStack at: j) liveRegister ~= target liveRegister].
- 	0 to: index -1 do: [:j | self assert: (self simStack: simStack at: j) liveRegister ~= target liveRegister].
  	
  	currentLiveRegisters := self liveRegistersExceptingTopNItems: 0 in: simStack.
  	(self register: target liveRegister isInMask: currentLiveRegisters) ifTrue:
  		[self ssAllocateRequiredReg: target liveRegister].
  	"Now target liveRegister is available. we set it."
  	current storeToReg: target liveRegister.
  	^0!

Item was removed:
- ----- Method: RegisterAllocatingCogit>>voidReceiverOptStatus (in category 'bytecode generator support') -----
- voidReceiverOptStatus
- 	"Used to mark ReceiverResultReg as dead or not containing simSelf.
- 	 Used when the simStack has already been flushed, e.g. for sends."
- 	<inline: true>
- 	simSelf liveRegister: NoReg!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>voidReceiverResultRegContainsSelf (in category 'bytecode generator support') -----
  voidReceiverResultRegContainsSelf
  	"Used when ReceiverResultReg is allocated for other than simSelf, and
  	 there may be references to ReceiverResultReg which need to be spilled."
  	self receiverIsInReceiverResultReg ifFalse:
  		[self deny: self simSelfOnStackInReceiverResultReg.
  		 ^self].
+ 	1 to: methodOrBlockNumTemps do:
- 	methodOrBlockNumTemps to: simStackPtr do:
  		[:i|
+ 		self deny: (self simStackAt: i) liveRegister = ReceiverResultReg].
+ 	methodOrBlockNumTemps + 1 to: simStackPtr do:
+ 		[:i|
+ 		(self simSelf isSameEntryAs: (self simStackAt: i)) ifTrue:
- 		((self addressOf: simSelf) isSameEntryAs: (self simStackAt: i)) ifTrue:
  			[(self simStackAt: i) liveRegister: NoReg]].
+ 	self simSelf liveRegister: NoReg!
- 	simSelf liveRegister: NoReg!

Item was changed:
  ----- Method: SistaCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
  genSpecialSelectorComparison
  	"Override to count inlined branches if followed by a conditional branch.
  	 We borrow the following conditional branch's counter and when about to
  	 inline the comparison we decrement the counter (without writing it back)
  	 and if it trips simply abort the inlining, falling back to the normal send which
  	 will then continue to the conditional branch which will trip and enter the abort."
  	| nextPC postBranchPC targetPC primDescriptor branchDescriptor
  	  rcvrIsInt rcvrIsConst argIsIntConst argInt jumpNotSmallInts inlineCAB
  	  counterAddress countTripped counterReg index |
  	<var: #countTripped type: #'AbstractInstruction *'>
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  
  	(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ self genSpecialSelectorComparisonWithoutCounters ].
  
  	self ssFlushTo: simStackPtr - 2.
  	primDescriptor := self generatorAt: byte0.
  	argIsIntConst := self ssTop type = SSConstant
  				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
  	rcvrIsInt := ((rcvrIsConst := (self ssValue: 1) type = SSConstant)
  				  and: [objectMemory isIntegerObject:(self ssValue: 1) constant])
+ 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: self simSelf]].
- 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: (self addressOf: simSelf)]].
  
  	"short-cut the jump if operands are SmallInteger constants."
  	(argIsIntConst and: [rcvrIsInt and: [rcvrIsConst]]) ifTrue:
  		[^ self genStaticallyResolvedSpecialSelectorComparison].
  
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetPC := target ].
  	
  	"Only interested in inlining if followed by a conditional branch."
  	inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
  	"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
  	 The relational operators successfully statically predict SmallIntegers; the equality operators do not."
  	(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
  		[inlineCAB := argIsIntConst or: [rcvrIsInt]].
  	inlineCAB ifFalse:
  		[^self genSpecialSelectorSend].
  
  	argIsIntConst
  		ifTrue:
  			[(self ssValue: 1) popToReg: ReceiverResultReg.
  			 self ssPop: 2]
  		ifFalse:
  			[self marshallSendArguments: 1].
  	jumpNotSmallInts := (rcvrIsInt and: [argIsIntConst]) ifFalse:
  							[argIsIntConst
  								ifTrue: [objectRepresentation genJumpNotSmallInteger: ReceiverResultReg]
  								ifFalse:
  									[rcvrIsInt
  										ifTrue: [objectRepresentation genJumpNotSmallInteger: Arg0Reg]
  										ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg and: Arg0Reg scratch: TempReg]]].
  
  	counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: ReceiverResultReg and: Arg0Reg).
  	self 
  		genExecutionCountLogicInto: [ :cAddress :countTripBranch | 
  			counterAddress := cAddress. 
  			countTripped := countTripBranch ] 
  		counterReg: counterReg.
  
  	argIsIntConst
  		ifTrue: [self CmpCq: argInt R: ReceiverResultReg]
  		ifFalse: [self CmpR: Arg0Reg R: ReceiverResultReg].
  	"Cmp is weird/backwards so invert the comparison.  Further since there is a following conditional
  	 jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
  	self genConditionalBranch: (branchDescriptor isBranchTrue
  				ifTrue: [primDescriptor opcode]
  				ifFalse: [self inverseBranchFor: primDescriptor opcode])
  		operand: (self ensureNonMergeFixupAt: targetPC) asUnsignedInteger.
  		
  	self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
  	
  	self Jump: (self ensureNonMergeFixupAt: postBranchPC).
  	countTripped jmpTarget: self Label.
  	jumpNotSmallInts
  		ifNil: [(self fixupAt: nextPC) notAFixup ifTrue:
  				[branchReachedOnlyForCounterTrip := true]]
  		ifNotNil: [jumpNotSmallInts jmpTarget: countTripped getJmpTarget].
  	
  	argIsIntConst ifTrue:
  		[self MoveCq: argInt R: Arg0Reg].
  	index := byte0 - self firstSpecialSelectorBytecodeOffset.
  	^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!

Item was changed:
  ----- Method: SistaRegisterAllocatingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
  genSpecialSelectorComparison
  	"Override to count inlined branches if followed by a conditional branch.
  	 We borrow the following conditional branch's counter and when about to
  	 inline the comparison we decrement the counter (without writing it back)
  	 and if it trips simply abort the inlining, falling back to the normal send which
  	 will then continue to the conditional branch which will trip and enter the abort."
  	| nextPC postBranchPC targetPC primDescriptor branchDescriptor
  	  rcvrIsInt rcvrIsConst argIsIntConst argInt jumpNotSmallInts inlineCAB
  	  counterAddress countTripped counterReg index rcvrReg argReg
  	   branchToTarget needMergeToContinue needMergeToTarget |
  	<var: #countTripped type: #'AbstractInstruction *'>
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  
  	(coInterpreter isOptimizedMethod: methodObj) ifTrue:
  		[^self genSpecialSelectorComparisonWithoutCounters].
  
  	primDescriptor := self generatorAt: byte0.
  	argIsIntConst := self ssTop type = SSConstant
  				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
  	rcvrIsInt := ((rcvrIsConst := (self ssValue: 1) type = SSConstant)
  				  and: [objectMemory isIntegerObject: (self ssValue: 1) constant])
+ 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: self simSelf]].
- 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: (self addressOf: simSelf)]].
  
  	"short-cut the jump if operands are SmallInteger constants."
  	(argIsIntConst and: [rcvrIsInt and: [rcvrIsConst]]) ifTrue:
  		[^ self genStaticallyResolvedSpecialSelectorComparison].
  
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetPC := target ].
  
  	"Only interested in inlining if followed by a conditional branch."
  	inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
  	"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
  	 The relational operators successfully statically predict SmallIntegers; the equality operators do not."
  	(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
  		[inlineCAB := argIsIntConst or: [rcvrIsInt]].
  	inlineCAB ifFalse:
  		[^self genSpecialSelectorSend].
  
  	"In-line the comparison and the jump, but if the types are not SmallInteger then we will need
  	 to do a send and fall through to the following conditional branch.  Since we're allocating values
  	 in registers we would like to keep those registers live on the inlined path and reload registers
  	 along the non-inlined send path.  The merge logic at the branch destinations handles this."
  	argIsIntConst
  		ifTrue:
  			[rcvrReg := self allocateRegForStackEntryAt: 1.
  			 (self ssValue: 1) popToReg: rcvrReg.
  			 counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg).
  			 argReg := NoReg]
  		ifFalse:
  			[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
  			 self ssTop popToReg: argReg.
  			 (self ssValue: 1) popToReg: rcvrReg.
  			 counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg and: argReg)].
  	self ssPop: 2.
  	jumpNotSmallInts := (rcvrIsInt and: [argIsIntConst]) ifFalse:
  							[argIsIntConst
  								ifTrue: [objectRepresentation genJumpNotSmallInteger: rcvrReg]
  								ifFalse:
  									[rcvrIsInt
  										ifTrue: [objectRepresentation genJumpNotSmallInteger: argReg]
  										ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: rcvrReg and: argReg scratch: TempReg]]].
  
  	self
  		genExecutionCountLogicInto: [ :cAddress :countTripBranch | 
  			counterAddress := cAddress. 
  			countTripped := countTripBranch ] 
  		counterReg: counterReg.
  
  	argIsIntConst
  		ifTrue: [self CmpCq: argInt R: rcvrReg]
  		ifFalse: [self CmpR: argReg R: rcvrReg].
  	"self printSimStack; printSimStack: (self fixupAt: postBranchPC) mergeSimStack; printSimStack: (self fixupAt: targetPC) mergeSimStack"
  	"If there are merges to be performed on the forward branches we have to execute
  	 the merge code only along the path requiring that merge, and exactly once."
  	needMergeToTarget := self mergeRequiredForJumpTo: targetPC.
  	needMergeToContinue := self mergeRequiredForJumpTo: postBranchPC.
  	"Cmp is weird/backwards so invert the comparison."
  	(needMergeToTarget and: [needMergeToContinue]) ifTrue:
  		[branchToTarget := self genConditionalBranch: (branchDescriptor isBranchTrue
  										ifTrue: [primDescriptor opcode]
  										ifFalse: [self inverseBranchFor: primDescriptor opcode])
  								operand: 0.
  		 self Jump: (self ensureFixupAt: postBranchPC).
  		 branchToTarget jmpTarget: self Label.
  		 self Jump: (self ensureFixupAt: targetPC)].
  	(needMergeToTarget and: [needMergeToContinue not]) ifTrue:
  		[self genConditionalBranch: (branchDescriptor isBranchFalse
  										ifTrue: [primDescriptor opcode]
  										ifFalse: [self inverseBranchFor: primDescriptor opcode])
  			operand: (self ensureFixupAt: postBranchPC) asUnsignedInteger.
  		 self Jump: (self ensureFixupAt: targetPC)].
  	(needMergeToTarget not and: [needMergeToContinue]) ifTrue:
  		[self genConditionalBranch: (branchDescriptor isBranchTrue
  										ifTrue: [primDescriptor opcode]
  										ifFalse: [self inverseBranchFor: primDescriptor opcode])
  			operand: (self ensureFixupAt: targetPC) asUnsignedInteger.
  		 self Jump: (self ensureFixupAt: postBranchPC)].
  	(needMergeToTarget or: [needMergeToContinue]) ifFalse:
  		[self genConditionalBranch: (branchDescriptor isBranchTrue
  										ifTrue: [primDescriptor opcode]
  										ifFalse: [self inverseBranchFor: primDescriptor opcode])
  			operand: (self ensureFixupAt: targetPC) asUnsignedInteger.
  		 self Jump: (self ensureFixupAt: postBranchPC)].
  
  	countTripped jmpTarget: self Label.
  	jumpNotSmallInts ifNil:
  		[self annotateInstructionForBytecode.
  		 deadCode := true.
  		 ^0].
  	jumpNotSmallInts jmpTarget: countTripped getJmpTarget.
  	
  	self ssFlushTo: simStackPtr.
  	rcvrReg = Arg0Reg
  		ifTrue:
  			[argReg = ReceiverResultReg
  				ifTrue: [self SwapR: Arg0Reg R: Arg0Reg Scratch: TempReg. argReg := Arg0Reg]
  				ifFalse: [self MoveR: rcvrReg R: ReceiverResultReg].
  			 rcvrReg := ReceiverResultReg].
  	argIsIntConst
  		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!

Item was changed:
  SimpleStackBasedCogit subclass: #StackToRegisterMappingCogit
+ 	instanceVariableNames: 'prevBCDescriptor numPushNilsFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simStack simStackPtr simSpillBase ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode useTwoPaths currentCallCleanUpSize simNativeStack simNativeStackPtr simNativeSpillBase simNativeStackSize hasNativeFrame compilationPass'
- 	instanceVariableNames: 'prevBCDescriptor numPushNilsFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simSelf simStack simStackPtr simSpillBase optStatus ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode useTwoPaths currentCallCleanUpSize simNativeStack simNativeStackPtr simNativeSpillBase simNativeStackSize hasNativeFrame compilationPass'
  	classVariableNames: 'NeedsMergeFixupFlag NeedsNonMergeFixupFlag'
  	poolDictionaries: 'CogCompilationConstants VMMethodCacheConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  StackToRegisterMappingCogit class
  	instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!
  
+ !StackToRegisterMappingCogit commentStamp: 'eem 1/26/2018 11:21' prior: 0!
+ StackToRegisterMappingCogit is an optimizing code generator that eliminates a lot of stack operations and inlines some special selector arithmetic.  It does so by a simple stack-to-register mapping scheme based on deferring the generation of code to produce operands until operand-consuming operations.  The operations that consume operands are sends, stores and returns.  This scheme was first conceived by L. Peter Deutch in the HPS Smalltalk VM (the VisualWorks VM).  Thank you, Peter.
- !StackToRegisterMappingCogit commentStamp: 'eem 3/3/2017 10:29' prior: 0!
- StackToRegisterMappingCogit is an optimizing code generator that eliminates a lot of stack operations and inlines some special selector arithmetic.  It does so by a simple stack-to-register mapping scheme based on deferring the generation of code to produce operands until operand-consuming operations.  The operations that consume operands are sends, stores and returns.
  
  See methods in the class-side documentation protocol for more detail.
  
  Instance Variables
  	compilationPass:								<Integer>
  	currentCallCleanUpSize:						<Integer>
  	ceCall0ArgsPIC:									<Integer>
  	ceCall1ArgsPIC:									<Integer>
  	ceCall2ArgsPIC:									<Integer>
  	ceCallCogCodePopReceiverArg0Regs:			<Integer>
  	ceCallCogCodePopReceiverArg1Arg0Regs:		<Integer>
  	deadCode										<Boolean>
  	debugBytecodePointers:						<Set of Integer>
  	debugFixupBreaks:								<Set of Integer>
  	debugStackPointers:							<CArrayAccessor of (Integer|nil)>
  	hasNativeFrame								<Boolean>
  	methodAbortTrampolines:						<CArrayAccessor of Integer>
  	methodOrBlockNumTemps:						<Integer>
  	numPushNilsFunction:							<Symbol>
- 	optStatus:										<Integer>
  	picAbortTrampolines:							<CArrayAccessor of Integer>
  	picMissTrampolines:							<CArrayAccessor of Integer>
  	pushNilSizeFunction:							<Symbol>
  	realCECallCogCodePopReceiverArg0Regs:		<Integer>
  	realCECallCogCodePopReceiverArg1Arg0Regs:	<Integer>
  	regArgsHaveBeenPushed:						<Boolean>
  	simNativeSpillBase:								<Integer>
  	simNativeStack:								<CArrayAccessor of CogSimStackNativeEntry>
  	simNativeStackPtr:								<Integer>
  	simNativeStackSize:							<Integer>
- 	simSelf:											<CogSimStackEntry>
  	simSpillBase:									<Integer>
  	simStack:										<CArrayAccessor of CogSimStackEntry>
  	simStackPtr:									<Integer>
  	traceSimStack:									<Integer>
  	useTwoPaths									<Boolean>
  
  compilationPass
  	- counter indicating whether on the first pass through bytecodes in a V3-style embedded block or not.  The V3 closure implementation uses pushNil to initialize temporary variables and this makes an initial pushNil ambiguous.  With the V3 bytecode set, the JIT must compile to the end of the block to discover if a pushNil is for initializing a temp or to produce an operand.
  
  currentCallCleanUpSize
  	- the number of bytes to remove from the stack in a Lowcode call.
  
  ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC
  	- the trampoline for entering an N-arg PIC
  
  ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs
  	- the trampoline for invokinging a method with N register args
  	
  debugBytecodePointers
  	- a Set of bytecode pcs for setting breakpoints (simulation only)
  
  deadCode
  	- set to true to indicate that the next bytecode (up to the next fixup) is not reachable.  Used to avoid generating dead code.
  
  debugFixupBreaks
  	- a Set of fixup indices for setting breakpoints (simulation only)
  
  debugStackPointers
+ 	- an Array of stack depths for each bytecode for code verification (simulation only)
- 	- an Array of stack depths for each bytecode for code verification
  
  hasNativeFrame
  	- set to true when Lowcode creates a native stack frame for Lowcode callouts.
  
  methodAbortTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  methodOrBlockNumTemps
  	- the number of method or block temps (including args) in the current compilation unit (method or block)
  
- optStatus
- 	- the variable used to track the status of ReceiverResultReg for avoiding reloading that register with self between adjacent inst var accesses
- 
  numPushNilsFunction
  	- the function used to determine the number of push nils at the beginning of a block.  This abstracts away from the specific bytecode set(s).
  
  picAbortTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  picMissTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  pushNilSizeFunction
  	- the function used to determine the number of bytes in the push nils bytecode(s) at the beginning of a block.  This abstracts away from the specific bytecode set(s).
  
  realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs
  	- the real trampolines for invoking machine code with N reg args when in the Debug regime
  
  regArgsHaveBeenPushed
  	- whether the register args have been pushed before frame build (e.g. when an interpreter primitive is called)
  
  simNativeSpillBase
  	- the variable tracking how much of the Lowcode simulation stack has been spilled to the real stack
  
  simNativeStack
  	- the Lowcode simulation stack itself
  
  simNativeStackPtr
  	- the pointer to the top of the Lowcode simulation stack
  
  simNativeStackSize
  	- the size of the Lowcode stack so far
  
- simSelf
- 	- the simulation stack entry representing self in the current compilation unit
- 
  simSpillBase
  	- the variable tracking how much of the simulation stack has been spilled to the real stack
  
  simStack
+ 	- the simulation stack itself, comprising the receiver, arguments, temporaries, and volatile stack contents.  The receiver is the 0'th entry, and the 1st is that of the first argument, etc.
- 	- the simulation stack itself
  
  simStackPtr
  	- the pointer to the top of the simulation stack
  
  useTwoPaths
  	- a variable controlling whether to create two paths through a method based on the existence of inst var stores.  With immutability this causes a frameless path to be generated if an otherwise frameless method is frameful simply because of inst var stores.  In this case the test to take the first frameless path is if the receiver is not immutable.  Without immutability, if a frameless method contains two or more inst var stores, the first path will be code with no store check, chosen by a single check for the receiver being in new space.
  !
  StackToRegisterMappingCogit class
  	instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>assertCorrectSimStackPtr (in category 'compile abstract instructions') -----
  assertCorrectSimStackPtr
+ 	<inline: true>
+ 	"Would like to assert simply simSpillBase > methodOrBlockNumTemps but can't because
+ 	 of the initialNils hack for nested blocks in SqueakV3PlusClosures"
+ 	self assert: (simSpillBase >= methodOrBlockNumTemps
+ 				or: [inBlock = InVanillaBlock]).
+  	 self cCode: '' inSmalltalk:
- 	<inline: true> "generates nothing anyway"
- 	 self cCode: '' inSmalltalk:
  		[deadCode ifFalse:
  			[self assert: simStackPtr + (needsFrame ifTrue: [0] ifFalse: [1])
  						= (self debugStackPointerFor: bytecodePC)]].
  	!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileAbstractInstructionsFrom:through: (in category 'compile abstract instructions') -----
  compileAbstractInstructionsFrom: start through: end
  	"Loop over bytecodes, dispatching to the generator for each bytecode, handling fixups in due course."
  	| nextOpcodeIndex descriptor nExts fixup result |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	self traceSimStack.
  	bytecodePC := start.
  	nExts := result := 0.
  	descriptor := nil.
  	deadCode := false.
  	[self maybeHaltIfDebugPC.
+ 	 self mergeWithFixupIfRequired: (fixup := self fixupAt: bytecodePC).
- 	 fixup := self fixupAt: bytecodePC.
- 	 self mergeWithFixupIfRequired: fixup.
- 	 self assertCorrectSimStackPtr.
  	 descriptor := self loadBytesAndGetDescriptor.
  	 nextOpcodeIndex := opcodeIndex.
  	 result := deadCode
  				ifTrue: [self mapDeadDescriptorIfNeeded: descriptor]
  				ifFalse: [self perform: descriptor generator].
  	 result = 0 ifTrue: [self assertExtsAreConsumed: descriptor].
  	 self traceDescriptor: descriptor; traceSimStack.
  	 self patchFixupTargetIfNeeded: fixup nextOpcodeIndex: nextOpcodeIndex.
  	 self maybeDumpLiterals: descriptor.
  	 bytecodePC := self nextBytecodePCFor: descriptor exts: nExts.
  	 result = 0 and: [bytecodePC <= end]] whileTrue:
  		[nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  	self checkEnoughOpcodes.
  	^result!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>debugStackPointerFor: (in category 'simulation only') -----
  debugStackPointerFor: bcpc
  	<doNotGenerate>
+ 	^(debugStackPointers at: bcpc) + (needsFrame ifTrue: [0] ifFalse: [1])!
- 	^(debugStackPointers at: bcpc) - (needsFrame ifTrue: [1] ifFalse: [0])!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ensureReceiverResultRegContainsSelf (in category 'bytecode generator support') -----
  ensureReceiverResultRegContainsSelf
  	needsFrame
  		ifTrue:
  			[self receiverIsInReceiverResultReg ifFalse:
  				[self ssAllocateRequiredReg: ReceiverResultReg.
+ 				 self putSelfInReceiverResultReg.
+ 				 self simSelf liveRegister: ReceiverResultReg]]
- 				self putSelfInReceiverResultReg ].
- 			optStatus isReceiverResultRegLive: true]
  		ifFalse:
+ 			[self assert: (self simSelf type = SSRegister
+ 						  and: [self simSelf register = ReceiverResultReg
+ 						  and: [self receiverIsInReceiverResultReg]])]!
- 			[self assert: (simSelf type = SSRegister
- 						  and: [simSelf register = ReceiverResultReg]).
- 			self assert: (optStatus isReceiverResultRegLive
- 						  and: [optStatus ssEntry = (self addressOf: simSelf)])]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genExtPushFullClosureBytecode (in category 'bytecode generators') -----
  genExtPushFullClosureBytecode
  	"Full Block creation compilation. The block's actual code will be compiled separatedly."
  	"*	255		11111111	xxxxxxxx	siyyyyyy	push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1"
  	| numCopied ignoreContext receiverIsOnStack compiledBlock reg |
  	self assert: needsFrame.
  	compiledBlock := self getLiteral: byte1 + (extA << 8).
  	extA := 0.
  	numCopied := byte2 bitAnd: 1<< 6 - 1.
  	receiverIsOnStack := byte2 anyMask: 1 << 7.
  	ignoreContext := byte2 anyMask: 1 << 6.
  	self voidReceiverResultRegContainsSelf.
  	self ssAllocateCallReg: ReceiverResultReg
  		and: SendNumArgsReg
  		and: ClassReg.
  	objectRepresentation
  		genCreateFullClosure: compiledBlock
  		numArgs: (coInterpreter argumentCountOf: compiledBlock)
  		numCopied: numCopied
  		ignoreContext: ignoreContext
  		contextNumArgs: methodOrBlockNumArgs
  		large: (coInterpreter methodNeedsLargeContext: methodObj)
  		inBlock: inBlock.
  	"Closure in ReceiverResultReg"
  	1 to: numCopied do:
  		[:i| 
  		reg := self ssStorePop: true toPreferredReg: TempReg.
  		 objectRepresentation
  			genStoreSourceReg: reg
  			slotIndex: FullClosureFirstCopiedValueIndex + numCopied - i
  			intoNewObjectInDestReg: ReceiverResultReg].
  	receiverIsOnStack
  		ifTrue: [reg := self ssStorePop: true toPreferredReg: TempReg]
+ 		ifFalse: [self simSelf storeToReg: (reg := TempReg)].
- 		ifFalse: [(self addressOf: simSelf) storeToReg: (reg := TempReg)].
  	objectRepresentation
  			genStoreSourceReg: reg
  			slotIndex: FullClosureReceiverIndex
  			intoNewObjectInDestReg: ReceiverResultReg.
  	self ssPushRegister: ReceiverResultReg.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushReceiverBytecode (in category 'bytecode generators') -----
  genPushReceiverBytecode
  	self receiverIsInReceiverResultReg ifTrue:
  		[^self ssPushRegister: ReceiverResultReg].
+ 	^self ssPushDesc: self simSelf!
- 	self assert: simSelf registerOrNone = NoReg.
- 	^self ssPushDesc: simSelf!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushTemporaryVariable: (in category 'bytecode generator support') -----
  genPushTemporaryVariable: index
  	"If a frameless method (not a block), only argument temps can be accessed.
  	 This is assured by the use of needsFrameIfMod16GENumArgs: in pushTemp."
  	self assert: (inBlock > 0 or: [needsFrame or: [index < methodOrBlockNumArgs]]).
+ 	^self ssPushDesc: (simStack at: index + 1)!
- 	^self ssPushDesc: (simStack at: index)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSpecialSelectorArithmetic (in category 'bytecode generators') -----
  genSpecialSelectorArithmetic
  	| primDescriptor rcvrIsConst argIsConst rcvrIsInt argIsInt rcvrInt argInt result
  	 jumpNotSmallInts jumpContinue index |
  	<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)])
+ 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: self simSelf]].
- 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: (self addressOf: simSelf)]].
  
  	(argIsInt and: [rcvrIsInt and: [rcvrIsConst]]) 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:
  			[self ssFlushTo: simStackPtr - 2.
  			 (self ssValue: 1) popToReg: ReceiverResultReg.
  			 self ssPop: 2]
  		ifFalse:
  			[self marshallSendArguments: 1].
  	jumpNotSmallInts := (rcvrIsInt and: [argIsInt]) ifFalse:
  							[argIsInt
  								ifTrue: [objectRepresentation genJumpNotSmallInteger: ReceiverResultReg]
  								ifFalse:
  									[rcvrIsInt
  										ifTrue: [objectRepresentation genJumpNotSmallInteger: Arg0Reg]
  										ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg and: Arg0Reg scratch: TempReg]]].
  	primDescriptor opcode caseOf: {
  		[AddRR] -> [argIsInt
  						ifTrue:
  							[self AddCq: argInt - ConstZero R: ReceiverResultReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before continuing"
  							 self SubCq: argInt - ConstZero R: ReceiverResultReg]
  						ifFalse:
  							[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ReceiverResultReg.
  							 self AddR: Arg0Reg R: ReceiverResultReg.
  							jumpContinue := self JumpNoOverflow: 0.
  							"overflow; must undo the damage before continuing"
  							 (rcvrIsInt and: [rcvrIsConst])
  								ifTrue: [self MoveCq: rcvrInt R: ReceiverResultReg]
  								ifFalse:
  									[self SubR: Arg0Reg R: ReceiverResultReg.
  									 objectRepresentation genSetSmallIntegerTagsIn: ReceiverResultReg]]].
  		[SubRR] -> [argIsInt
  						ifTrue:
  							[self SubCq: argInt - ConstZero R: ReceiverResultReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before continuing"
  							 self AddCq: argInt - ConstZero R: ReceiverResultReg]
  						ifFalse:
  							[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: Arg0Reg.
  							 self SubR: Arg0Reg R: ReceiverResultReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before continuing"
  							 self AddR: Arg0Reg R: ReceiverResultReg.
  							 objectRepresentation genSetSmallIntegerTagsIn: Arg0Reg]].
  		[AndRR] -> [argIsInt
  						ifTrue: [self AndCq: argInt R: ReceiverResultReg]
  						ifFalse: [self AndR: Arg0Reg R: ReceiverResultReg].
  					jumpContinue := jumpNotSmallInts ifNotNil: [self Jump: 0]].
  		[OrRR]	-> [argIsInt
  						ifTrue: [self OrCq: argInt R: ReceiverResultReg]
  						ifFalse: [self OrR: Arg0Reg R: ReceiverResultReg].
  					jumpContinue := jumpNotSmallInts ifNotNil: [self Jump: 0]] }.
  	jumpNotSmallInts
  		ifNil: [jumpContinue ifNil: "overflow cannot happen"
  				[self annotateInstructionForBytecode.
  				 self ssPushRegister: ReceiverResultReg.
  				 ^0]]
  		ifNotNil:
  			[jumpNotSmallInts jmpTarget: self Label].
  	argIsInt ifTrue:
  		[self MoveCq: argInt R: Arg0Reg].
  	index := byte0 - self firstSpecialSelectorBytecodeOffset.
  	self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines.
  	jumpContinue jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
  genSpecialSelectorComparison
  	| nextPC postBranchPC targetPC primDescriptor branchDescriptor
  	  rcvrIsInt rcvrIsConst argIsIntConst argInt jumpNotSmallInts inlineCAB index |
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	self ssFlushTo: simStackPtr - 2.
  	primDescriptor := self generatorAt: byte0.
  	argIsIntConst := self ssTop type = SSConstant
  				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
  	rcvrIsInt := ((rcvrIsConst := (self ssValue: 1) type = SSConstant)
  				  and: [objectMemory isIntegerObject: (self ssValue: 1) constant])
+ 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: self simSelf]].
- 				or: [self mclassIsSmallInteger and: [(self ssValue: 1) isSameEntryAs: (self addressOf: simSelf)]].
  
  	(argIsIntConst and: [rcvrIsInt and: [rcvrIsConst]]) ifTrue:
  		[^ self genStaticallyResolvedSpecialSelectorComparison].
  
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetPC := target ].
  
  	"Only interested in inlining if followed by a conditional branch."
  	inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
  	"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
  	 The relational operators successfully statically predict SmallIntegers; the equality operators do not."
  	(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
  		[inlineCAB := argIsIntConst or: [rcvrIsInt]].
  	inlineCAB ifFalse:
  		[^self genSpecialSelectorSend].
  
  	argIsIntConst
  		ifTrue:
  			[(self ssValue: 1) popToReg: ReceiverResultReg.
  			 self ssPop: 2]
  		ifFalse:
  			[self marshallSendArguments: 1].
  	jumpNotSmallInts := (rcvrIsInt and: [argIsIntConst]) ifFalse:
  							[argIsIntConst
  								ifTrue: [objectRepresentation genJumpNotSmallInteger: ReceiverResultReg]
  								ifFalse:
  									[rcvrIsInt
  										ifTrue: [objectRepresentation genJumpNotSmallInteger: Arg0Reg]
  										ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg and: Arg0Reg scratch: TempReg]]].
  	argIsIntConst
  		ifTrue: [self CmpCq: argInt R: ReceiverResultReg]
  		ifFalse: [self CmpR: Arg0Reg R: ReceiverResultReg].
  	"Cmp is weird/backwards so invert the comparison.  Further since there is a following conditional
  	 jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
  	self genConditionalBranch: (branchDescriptor isBranchTrue
  				ifTrue: [primDescriptor opcode]
  				ifFalse: [self inverseBranchFor: primDescriptor opcode])
  		operand: (self ensureNonMergeFixupAt: targetPC) asUnsignedInteger.
  	self Jump: (self ensureNonMergeFixupAt: postBranchPC).
  	jumpNotSmallInts ifNil:
  		[self annotateInstructionForBytecode.
  		 self ensureFixupAt: postBranchPC.
  		 self ensureFixupAt: targetPC.
  		 deadCode := true.
  		 ^0].
  	jumpNotSmallInts jmpTarget: self Label.
  	argIsIntConst ifTrue:
  		[self MoveCq: argInt R: Arg0Reg].
  	index := byte0 - self firstSpecialSelectorBytecodeOffset.
  	^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genStorePop:TemporaryVariable: (in category 'bytecode generator stores') -----
  genStorePop: popBoolean TemporaryVariable: tempIndex
  	<inline: false>
  	| reg |
  	self ssFlushUpThroughTemporaryVariable: tempIndex.
  	reg := self ssStorePop: popBoolean toPreferredReg: TempReg.
  	self MoveR: reg
  		Mw: (self frameOffsetOfTemporary: tempIndex)
  		r: FPReg.
+ 	(self simStackAt: tempIndex + 1) bcptr: bytecodePC. "for debugging"
- 	(self simStackAt: tempIndex) bcptr: bytecodePC. "for debugging"
  	^0!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>initOptStatus: (in category 'simulation stack') -----
- initOptStatus: receiverResultRegLive
- 	<inline: true>
- 	optStatus 
- 		isReceiverResultRegLive: receiverResultRegLive;
- 		ssEntry: (self addressOf: simSelf)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initSimStackForFramefulMethod: (in category 'simulation stack') -----
  initSimStackForFramefulMethod: startpc
  	<var: #desc type: #'CogSimStackEntry *'>
+ 	simStackPtr := methodOrBlockNumTemps. "N.B. Includes num args"
+ 	simSpillBase := methodOrBlockNumTemps + 1.
+ 	LowcodeVM ifTrue:
+ 		[simNativeSpillBase := simNativeStackPtr := -1.
+ 		 simNativeStackSize := 0].
+ 	self simSelf
- 	simSelf
  		type: SSBaseOffset;
  		spilled: true;
  		register: FPReg;
+ 		offset: FoxMFReceiver;
+ 		liveRegister: NoReg.
- 		offset: FoxMFReceiver.
- 	self initOptStatus: false.
- 	simSpillBase := methodOrBlockNumTemps. "N.B. Includes num args"
- 	simStackPtr := simSpillBase - 1.
- 	LowcodeVM ifTrue: [
- 		simNativeSpillBase := simNativeStackPtr := -1.
- 		simNativeStackSize := 0.
- 	].
  	"args"
+ 	1 to: methodOrBlockNumArgs do:
- 	0 to: methodOrBlockNumArgs - 1 do:
  		[:i| | desc |
  		desc := self simStackAt: i.
  		desc
  			type: SSBaseOffset;
  			spilled: true;
  			register: FPReg;
+ 			offset: FoxCallerSavedIP + ((methodOrBlockNumArgs - i + 1) * objectMemory wordSize);
- 			offset: FoxCallerSavedIP + ((methodOrBlockNumArgs - i) * objectMemory wordSize);
  			bcptr: startpc].
  	"temps"
+ 	methodOrBlockNumArgs + 1 to: simStackPtr do:
- 	methodOrBlockNumArgs to: simStackPtr do:
  		[:i| | desc |
  		desc := self simStackAt: i.
  		desc
  			type: SSBaseOffset;
  			spilled: true;
  			register: FPReg;
+ 			offset: FoxMFReceiver - (i - methodOrBlockNumArgs * objectMemory wordSize);
- 			offset: FoxMFReceiver - (i - methodOrBlockNumArgs + 1 * objectMemory wordSize);
  			bcptr: startpc]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initSimStackForFramelessBlock: (in category 'simulation stack') -----
  initSimStackForFramelessBlock: startpc
  	"The register receiver (the closure itself) and args are pushed by the closure value primitive(s)
  	 and hence a frameless block has all arguments and copied values pushed to the stack.  However,
+ 	 the method receiver (self) is put in the ReceiverResultReg by the block entry."
- 	 the method receiver (self) is put in the ReceiverResultRegister by the block entry."
- 	| desc |
  	<var: #desc type: #'CogSimStackEntry *'>
+ 	self simSelf
- 	simSelf
  		type: SSRegister;
  		spilled: false;
+ 		register: ReceiverResultReg;
+ 		liveRegister: ReceiverResultReg.
- 		register: ReceiverResultReg.
- 	self initOptStatus: true.
  	self assert: methodOrBlockNumTemps >= methodOrBlockNumArgs.
+ 	1 to: methodOrBlockNumTemps do:
+ 		[:i| | desc |
- 	0 to: methodOrBlockNumTemps - 1 do:
- 		[:i|
  		desc := self simStackAt: i.
  		desc
  			type: SSBaseOffset;
  			spilled: true;
  			register: SPReg;
  			offset: ((backEnd hasLinkRegister
+ 								ifTrue: [methodOrBlockNumArgs - i]
+ 								ifFalse: [methodOrBlockNumArgs + 1 - i]) * objectMemory wordSize);
- 								ifTrue: [methodOrBlockNumArgs - 1- i]
- 								ifFalse: [methodOrBlockNumArgs - i]) * objectMemory wordSize);
  			bcptr: startpc].
+ 	simStackPtr := methodOrBlockNumTemps. "N.B. Includes num args"
+ 	simSpillBase := methodOrBlockNumTemps + 1.
+ 	LowcodeVM ifTrue:
+ 		[simNativeSpillBase := simNativeStackPtr := -1.
+ 		 simNativeStackSize := 0]!
- 	simSpillBase := simStackPtr := methodOrBlockNumTemps - 1.
- 	LowcodeVM ifTrue: [
- 		simNativeSpillBase := simNativeStackPtr := -1.
- 		simNativeStackSize := 0.
- 	].!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initSimStackForFramelessMethod: (in category 'simulation stack') -----
  initSimStackForFramelessMethod: startpc
  	| desc |
  	<var: #desc type: #'CogSimStackEntry *'>
+ 	self simSelf
- 	simSelf
  		type: SSRegister;
  		spilled: false;
+ 		register: ReceiverResultReg;
+ 		liveRegister: ReceiverResultReg.
- 		register: ReceiverResultReg.
- 	self initOptStatus: true.
  	self assert: methodOrBlockNumTemps = methodOrBlockNumArgs.
  	self assert: self numRegArgs <= 2.
  	(methodOrBlockNumArgs between: 1 and: self numRegArgs)
  		ifTrue:
+ 			[desc := self simStackAt: 1.
- 			[desc := self simStackAt: 0.
  			 desc
  				type: SSRegister;
  				spilled: false;
  				register: Arg0Reg;
  				bcptr: startpc.
  			 methodOrBlockNumArgs > 1 ifTrue:
+ 				[desc := self simStackAt: 2.
- 				[desc := self simStackAt: 1.
  				 desc
  					type: SSRegister;
  					spilled: false;
  					register: Arg1Reg;
  					bcptr: startpc]]
  		ifFalse:
+ 			[1 to: methodOrBlockNumArgs do:
- 			[0 to: methodOrBlockNumArgs - 1 do:
  				[:i|
  				desc := self simStackAt: i.
  				desc
  					type: SSBaseOffset;
  					register: SPReg;
  					spilled: true;
  					offset: ((backEnd hasLinkRegister
+ 								ifTrue: [methodOrBlockNumArgs - i]
+ 								ifFalse: [methodOrBlockNumArgs + 1 - i]) * objectMemory wordSize);
- 								ifTrue: [methodOrBlockNumArgs - 1- i]
- 								ifFalse: [methodOrBlockNumArgs - i]) * objectMemory wordSize);
  					bcptr: startpc]].
+ 	simStackPtr := methodOrBlockNumArgs.
+ 	simSpillBase := methodOrBlockNumArgs + 1.
+ 	LowcodeVM ifTrue:
+ 		[simNativeSpillBase := simNativeStackPtr := -1.
+ 		 simNativeStackSize := 0]!
- 	simSpillBase := simStackPtr := methodOrBlockNumArgs - 1.
- 	LowcodeVM ifTrue: [
- 		simNativeSpillBase := simNativeStackPtr := -1.
- 		simNativeStackSize := 0.
- 	].!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>mergeWithFixupIfRequired: (in category 'simulation stack') -----
  mergeWithFixupIfRequired: fixup
  	"If this bytecode has a fixup, some kind of merge needs to be done. There are 4 cases:
  		1) the bytecode has no fixup (fixup isNotAFixup)
  			do nothing
  		2) the bytecode has a non merge fixup
  			the fixup has needsNonMergeFixup.
  			The code generating non merge fixup (currently only special selector code) is responsible
  				for the merge so no need to do it.
  			We set deadCode to false as the instruction can be reached from jumps.
  		3) the bytecode has a merge fixup, but execution flow *cannot* fall through to the merge point.
  			the fixup has needsMergeFixup and deadCode = true.
  			ignores the current simStack as it does not mean anything 
  			restores the simStack to the state the jumps to the merge point expects it to be.
  		4) the bytecode has a merge fixup and execution flow *can* fall through to the merge point.
  			the fixup has needsMergeFixup and deadCode = false.
  			flushes the stack to the stack pointer so the fall through execution path simStack is 
  				in the state the merge point expects it to be. 
  			restores the simStack to the state the jumps to the merge point expects it to be.
  			
  	In addition, if this is a backjump merge point, we patch the fixup to hold the current simStackPtr 
  	for later assertions."
- 	
  	<var: #fixup type: #'BytecodeFixup *'>
+ 
+ 	self assertCorrectSimStackPtr.
+ 
  	"case 1"
  	fixup notAFixup ifTrue:
  		[^0].
  
  	"case 2"
  	fixup isNonMergeFixup ifTrue:
  		[deadCode := false. ^0].
  
  	"cases 3 and 4"
  	self assert: fixup isMergeFixup.
  	self traceMerge: fixup.
  	deadCode
  		ifTrue: "case 3"
+ 			["Would like to assert fixup simStackPtr >= methodOrBlockNumTemps but can't because
- 			["Would like to assert fixup simStackPtr >= (methodOrBlockNumTemps - 1) but can't because
  			   a) the initialNils hack, b) deadCode removal allows arriving at an isBackwardBranchFixup."
+ 			 self assert: (fixup simStackPtr >= methodOrBlockNumTemps
+ 						or: [inBlock = InVanillaBlock
+ 						or: [fixup isBackwardBranchFixup]]).
- 			 self assert: (fixup simStackPtr >= (methodOrBlockNumTemps - 1) or: [inBlock = InVanillaBlock or: [fixup isBackwardBranchFixup]]).
  			 fixup isBackwardBranchFixup ifFalse:
  				[simStackPtr := fixup simStackPtr].
  			 LowcodeVM ifTrue:
  				[simNativeStackPtr := fixup simNativeStackPtr.
  				simNativeStackSize := fixup simNativeStackSize]]
  		ifFalse: "case 4"
  			[self ssFlushTo: simStackPtr].
  
  	"cases 3 and 4"
  	deadCode := false.
  	fixup isBackwardBranchFixup ifTrue:
  		[fixup simStackPtr: simStackPtr.
  		LowcodeVM ifTrue:
  			[fixup simNativeStackPtr: simNativeStackPtr.
  			 fixup simNativeStackSize: simNativeStackSize]].
  	fixup targetInstruction: self Label.
  	self assert: simStackPtr = fixup simStackPtr.
  	LowcodeVM ifTrue:
  		[self assert: simNativeStackPtr = fixup simNativeStackPtr.
  		 self assert: simNativeStackSize = fixup simNativeStackSize].
  
  	self cCode: '' inSmalltalk:
  		[self assert: fixup simStackPtr = (self debugStackPointerFor: bytecodePC)].
  	self restoreSimStackAtMergePoint: fixup.
  
  	^0!

Item was removed:
- ----- 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 removed:
- ----- Method: StackToRegisterMappingCogit>>printSimSelf (in category 'simulation only') -----
- printSimSelf
- 	<doNotGenerate>
- 	coInterpreter transcript ensureCr; nextPutAll: 'self: '.
- 	simSelf printStateOn: coInterpreter transcript.
- 	coInterpreter transcript cr; flush!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>printSimStack:toDepth:spillBase:on: (in category 'simulation only') -----
  printSimStack: aSimStack toDepth: limit spillBase: spillBase on: aStream
  	<doNotGenerate>
  	| tempNames width tabWidth |
  	aStream ensureCr.
  	limit < 0 ifTrue:
  		[^aStream nextPutAll: 'simStackEmpty'; cr; flush].
  	aSimStack ifNil:
  		[^aStream nextPutAll: 'nil simStack'; cr; flush].
  	(self class initializationOptions at: #tempNames ifAbsent: nil) ifNotNil:
  		[:tempNamesDictOrNil |	 | tab longest |
  		 tempNames := tempNamesDictOrNil at: (self class initializationOptions at: #startpc ifAbsent: [initialPC]) + 1.
  		 longest := tempNames inject: '' into: [:m :t| m size >= t size ifTrue: [m] ifFalse: [t]].
  		 tabWidth := self widthInDefaultFontOf: (tab := String with: Character tab).
  		 width := self widthInDefaultFontOf: longest, tab.
  		 width <= ((self widthInDefaultFontOf: longest, (String with: Character space)) + 4) ifTrue:
  			[width := width + tabWidth]].
  	0 to: limit do:
  		[:i|
  		width ifNotNil:
+ 			[self put: (tempNames at: i ifAbsent: [i = 0 ifTrue: ['self'] ifFalse: ['']]) paddedTo: width tabWidth: tabWidth on: aStream].
- 			[self put: (tempNames at: i + 1 ifAbsent: ['']) paddedTo: width tabWidth: tabWidth on: aStream].
  		aStream print: i.
  		i = simStackPtr ifTrue:
  			[aStream nextPutAll: '<-' ].
  		i = spillBase ifTrue:
  			[aStream nextPutAll: '(sb)'].
  		aStream tab: (i = spillBase ifTrue: [1] ifFalse: [2]).
  		(aSimStack at: i) printStateOn: aStream.
+ 		aStream cr; flush].
+ 	simSpillBase > limit ifTrue:
+ 		[aStream nextPutAll: '(sb: '; print: simSpillBase; nextPut: $); cr; flush]!
- 		aStream cr; flush]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>putSelfInReceiverResultReg (in category 'bytecode generator support') -----
  putSelfInReceiverResultReg
  	<inline: true>
+ 	 self simSelf storeToReg: ReceiverResultReg!
- 	 (self addressOf: simSelf) storeToReg: ReceiverResultReg
- 		!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>receiverIsInReceiverResultReg (in category 'bytecode generator support') -----
  receiverIsInReceiverResultReg
  	"Used to mark ReceiverResultReg as dead or not containing simSelf.
  	 Used when the simStack has already been flushed, e.g. for sends."
  	<inline: true>
+ 	^self simSelf liveRegister = ReceiverResultReg!
- 	^optStatus isReceiverResultRegLive!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>restoreSimStackAtMergePoint: (in category 'simulation stack') -----
  restoreSimStackAtMergePoint: fixup
  	<inline: true>
  	"All the execution paths reaching a merge point expect everything to be
+ 	 spilled on stack and the optStatus is unknown. Throw away all simStack and 
+ 	 optStatus optimization state."
+ 	simSpillBase := methodOrBlockNumTemps + 1.
- 	spilled on stack and the optStatus is unknown. Throw away all simStack and 
- 	optStatus optimization state."
- 	simSpillBase := methodOrBlockNumTemps.
  	self voidReceiverOptStatus.
+ 	methodOrBlockNumTemps + 1 to: simStackPtr do:
- 	methodOrBlockNumTemps to: simStackPtr do:
  		[:i|
  		 (self simStackAt: i)
  			type: SSSpill;
+ 			offset: FoxMFReceiver - (i - methodOrBlockNumArgs * objectMemory bytesPerOop);
- 			offset: FoxMFReceiver - (i - methodOrBlockNumArgs + 1 * objectMemory bytesPerOop);
  			register: FPReg;
  			spilled: true].
  	LowcodeVM ifTrue:
  		[0 to: simNativeStackPtr do:
  			[ :i |
  			(self simNativeStackAt: i)
  				ensureIsMarkedAsSpilled].
  		simNativeSpillBase := simNativeStackPtr + 1].
  	^ 0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>setInterpreter: (in category 'initialization') -----
  setInterpreter: aCoInterpreter
  	"Initialization of the code generator in the simulator.
  	 These objects already exist in the generated C VM
  	 or are used only in the simulation."
  	<doNotGenerate>
  	super setInterpreter: aCoInterpreter.
  
  	methodAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  	picAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  	picMissTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  
  	simStack := CArrayAccessor on: ((1 to: self class simStackSlots) collect: [:i| self simStackEntryClass new cogit: self]).
  	simNativeStack := CArrayAccessor on: ((1 to: self class simNativeStackSlots) collect: [:i| self simStackNativeEntryClass new cogit: self]).
- 	simSelf := self simStackEntryClass new cogit: self.
- 	optStatus := CogSSOptStatus new.
  
  	debugFixupBreaks := self class initializationOptions at: #debugFixupBreaks ifAbsent: [Set new].
  
  	numPushNilsFunction := self class numPushNilsFunction.
  	pushNilSizeFunction := self class pushNilSizeFunction!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>simSelf (in category 'accessing') -----
  simSelf
+ 	<cmacro: ' simStack'>
+ 	<returnTypeC: #'CogSimStackEntry *'>
+ 	^self simStackAt: 0!
- 	^simSelf!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>simStackPrintString (in category 'simulation only') -----
  simStackPrintString
  	<doNotGenerate>
+ 	^String streamContents: [:s| self printSimStack: simStack toDepth: simStackPtr spillBase: simSpillBase on: s]!
- 	^String streamContents:
- 		[:s|
- 		 optStatus printStateOn: s.
- 		self printSimStack: simStack toDepth: simStackPtr spillBase: simSpillBase on: s]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>simStackSlots (in category 'simulation stack') -----
  simStackSlots
+ 	"Answer the number of slots to include in a simulated stack.
+ 	 This needs to be big enough to include all stack slots in a context
+ 	 plus a slot for the receiver and some overflow for safety."
- 	"Answer the number of slots toinclude in a simulated stack.
- 	 This needs to be big enough to include all slots in a context
- 	 plus some overflow for safety."
  	<inline: true>
+ 	^((LargeContextSlots - CtxtTempFrameStart + 1 max: 64) * 11 // 10)!
- 	^((LargeContextSlots - CtxtTempFrameStart max: 64) * 11 // 10)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssAllocateRequiredFloatRegMask:upThrough:upThroughNative: (in category 'simulation stack') -----
  ssAllocateRequiredFloatRegMask: requiredRegsMask upThrough: stackPtr upThroughNative: nativeStackPtr
  	| lastRequired lastRequiredNative liveRegs |
  	lastRequired := -1.
  	lastRequiredNative := -1.
  	"compute live regs while noting the last occurrence of required regs.
  	 If these are not free we must spill from simSpillBase to last occurrence.
  	 Note we are conservative here; we could allocate FPReg in frameless methods."
  	liveRegs := NoReg.
  	(simSpillBase max: 0) to: stackPtr do:
  		[:i|
  		liveRegs := liveRegs bitOr: (self simStackAt: i) registerMask.
  		((self simStackAt: i) floatRegisterMask bitAnd: requiredRegsMask) ~= 0 ifTrue:
  			[lastRequired := i]].
+ 	self assert: lastRequiredNative = simNativeStackPtr.
+ 	(simNativeSpillBase max: 0) to: nativeStackPtr do:
+ 		[:i|
+ 		liveRegs := liveRegs bitOr: (self simNativeStackAt: i) nativeRegisterMask.
+ 		((self simNativeStackAt: i) floatRegisterMask bitAnd: requiredRegsMask) ~= 0 ifTrue:
+ 			[lastRequiredNative := i]].
- 	LowcodeVM ifTrue: [ 
- 		(simNativeSpillBase max: 0) to: nativeStackPtr do:
- 			[:i|
- 			liveRegs := liveRegs bitOr: (self simNativeStackAt: i) nativeRegisterMask.
- 			((self simNativeStackAt: i) floatRegisterMask bitAnd: requiredRegsMask) ~= 0 ifTrue:
- 				[lastRequiredNative := i]].
- 	].
  
  	"If any of requiredRegsMask are live we must spill."
  	(liveRegs bitAnd: requiredRegsMask) = 0 ifFalse:
  		["Some live, must spill"
+ 		self ssFlushTo: lastRequired.
- 		self ssFlushTo: lastRequired nativeFlushTo: lastRequiredNative.
  		self assert: (self liveFloatRegisters bitAnd: requiredRegsMask) = 0]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssAllocateRequiredRegMask:upThrough:upThroughNative: (in category 'simulation stack') -----
  ssAllocateRequiredRegMask: requiredRegsMask upThrough: stackPtr upThroughNative: nativeStackPtr
  	| lastRequired lastRequiredNative liveRegs |
  	lastRequired := -1.
  	lastRequiredNative := -1.
  	"compute live regs while noting the last occurrence of required regs.
  	 If these are not free we must spill from simSpillBase to last occurrence.
  	 Note we are conservative here; we could allocate FPReg in frameless methods."
  	liveRegs := self registerMaskFor: FPReg and: SPReg.
  	(simSpillBase max: 0) to: stackPtr do:
  		[:i|
  		liveRegs := liveRegs bitOr: (self simStackAt: i) registerMask.
  		((self simStackAt: i) registerMask bitAnd: requiredRegsMask) ~= 0 ifTrue:
  			[lastRequired := i]].
  	LowcodeVM ifTrue:
+ 		[self assert: nativeStackPtr = simNativeStackPtr.
+ 		 (simNativeSpillBase max: 0) to: nativeStackPtr do:
- 		[(simNativeSpillBase max: 0) to: nativeStackPtr do:
  			[:i|
  			liveRegs := liveRegs bitOr: (self simNativeStackAt: i) nativeRegisterMask.
  			((self simNativeStackAt: i) nativeRegisterMask anyMask: requiredRegsMask) ifTrue:
  				[lastRequiredNative := i]]].
  	"If any of requiredRegsMask are live we must spill."
  	(liveRegs anyMask: requiredRegsMask) ifTrue:
+ 		[self ssFlushTo: lastRequired.
- 		[self ssFlushTo: lastRequired nativeFlushTo: lastRequiredNative.
  		 self deny: (self liveRegisters anyMask: requiredRegsMask)]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssFlushAll (in category 'simulation stack') -----
  ssFlushAll
  	<inline: true>
+ 	self ssFlushTo: simStackPtr.
- 	self ssFlushTo: simStackPtr nativeFlushTo: simNativeStackPtr.
  	self voidReceiverResultRegContainsSelf.!

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

Item was removed:
- ----- 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
- 						or: [self maybeCompilingFirstPassOfBlockWithInitialPushNil])].
- 	methodOrBlockNumTemps to: simSpillBase - 1 do: "simSpillBase and simStackPtr are 0-relative"
- 		[:i| self assert: (self simStackAt: i) spilled].
- 	simSpillBase <= index ifTrue:
- 		[(simSpillBase max: methodOrBlockNumTemps) to: index do:
- 			[:i|
- 			self assert: needsFrame.
- 			(self simStackAt: i)
- 				ensureSpilledAt: (self frameOffsetOfTemporary: i)
- 				from: FPReg].
- 		 simSpillBase := index + 1]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssPop: (in category 'simulation stack') -----
  ssPop: n
+ 	self assert: (simStackPtr - n >= methodOrBlockNumTemps
+ 				or: [(needsFrame not and: [simStackPtr - n >= 0])
- 	self assert: (simStackPtr - n >= (methodOrBlockNumTemps - 1)
- 				or: [(needsFrame not and: [simStackPtr - n >= -1])
  				or: [self maybeCompilingFirstPassOfBlockWithInitialPushNil]]).
  	simStackPtr := simStackPtr - n!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>tempsValidAndVolatileEntriesSpilled (in category 'debugging') -----
+ tempsValidAndVolatileEntriesSpilled
+ 	"Answer if the stack is valid up to, but not including, simSpillBase."
+ 	| culprit |
+ 	1 to: methodOrBlockNumTemps do:
+ 		[:i|
+ 		 ((self simStackAt: i) type = SSBaseOffset
+ 		   or: [self maybeCompilingFirstPassOfBlockWithInitialPushNil]) ifFalse:
+ 			[culprit ifNil: [culprit := i].
+ 			 ^false]].
+ 	methodOrBlockNumTemps + 1 to: simSpillBase - 1 do:
+ 		[:i|
+ 		 (self simStackAt: i) spilled ifFalse:
+ 			[culprit ifNil: [culprit := i].
+ 			 ^false]].
+ 	^true!

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

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>updateSimSpillBase (in category 'simulation stack') -----
  updateSimSpillBase
  	<inline: true>
+ 	self assert: (simSpillBase > methodOrBlockNumTemps
+ 				or: [inBlock = InVanillaBlock]).
  	simSpillBase > simStackPtr ifTrue:
+ 		[simSpillBase := simStackPtr max: methodOrBlockNumTemps].!
- 		[simSpillBase := simStackPtr max: 0].!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>violatesEnsureSpilledSpillAssert (in category 'testing') -----
+ violatesEnsureSpilledSpillAssert
+ 	^true!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>voidReceiverOptStatus (in category 'bytecode generator support') -----
  voidReceiverOptStatus
  	"Used to mark ReceiverResultReg as dead or not containing simSelf.
  	 Used when the simStack has already been flushed, e.g. for sends."
  	<inline: true>
+ 	self simSelf liveRegister: NoReg!
- 	optStatus isReceiverResultRegLive: false!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>voidReceiverResultRegContainsSelf (in category 'bytecode generator support') -----
  voidReceiverResultRegContainsSelf
  	"Used when ReceiverResultReg is allocated for other than simSelf, and
  	 there may be references to ReceiverResultReg which need to be spilled."
  	| spillIndex |
  	self voidReceiverOptStatus.
+ 	spillIndex := 0.
+ 	(methodOrBlockNumTemps + 1 max: simSpillBase) to: simStackPtr do:
- 	spillIndex := -1.
- 	(methodOrBlockNumTemps max: simSpillBase) to: simStackPtr do:
  		[:i|
  		(self simStackAt: i) registerOrNone = ReceiverResultReg ifTrue:
  			[spillIndex := i]].
  	spillIndex > 0 ifTrue:
  		[self ssFlushTo: spillIndex]!



More information about the Vm-dev mailing list