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

commits at source.squeak.org commits at source.squeak.org
Thu Jun 4 00:10:07 UTC 2015


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

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

Name: VMMaker.oscog-eem.1334
Author: eem
Time: 3 June 2015, 5:08:13.124 pm
UUID: 1d933034-0724-4da9-82e4-f79648b6dc8b
Ancestors: VMMaker.oscog-eem.1333

Spur:
Since the invariant is that the receiver is never
forwarded, Spur must check for forwarding on
block activation.  A become between closure
creation and closure evaluation can forward the
receiver, and it must be unforwarded.  Here we do
so by checking for a forwarded receiver in the
value[:] primitives. This is a major blow to block
performance; e.g. the nfib block
	b := [:n| n <= 1
				ifTrue: [1]
				ifFalse: [1 + (b value: n - 1) + (b value: n - 2)]].
slows down by 11%.  So we can and will do better.
We should scan for receiver usage in the JIT and
optionally compile unforwarding code in the prolog
depending on whether self is used or not.

Cogit:
Use the Tst-based generators for immediate and
SmallInteger tests more widely to save a few more
instructions.

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

Item was changed:
  ----- Method: CoInterpreter>>activateNewClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
  activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
  	"Similar to activateNewMethod but for Closure and newMethod.
  	 Override to handle the various interpreter/machine code transitions
  	 and to create an appropriate frame layout."
  	| numCopied outerContext theMethod methodHeader inInterpreter closureIP switched |
  	<inline: true>
+ 	outerContext := objectMemory followField: ClosureOuterContextIndex ofObject: blockClosure.
- 	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
  	self assert: outerContext ~= blockClosure.
  	numCopied := self copiedValueCountOfClosure: blockClosure.
+ 	theMethod := objectMemory followField: MethodIndex ofObject: outerContext.
- 	theMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
  	methodHeader := self rawHeaderOf: theMethod.
  	(self isCogMethodReference: methodHeader) ifTrue:
  		[^self executeCogBlock: (self cogMethodOf: theMethod)
  			closure: blockClosure
  			mayContextSwitch: mayContextSwitch].
  	"How do we know when to compile a block method?
  	 One simple criterion is to check if the block is running within its inner context,
  	 i.e. if the outerContext is married.
  	 Even simpler is to remember the previous block entered via the interpreter and
  	 compile if this is the same one.  But we can thrash trying to compile an uncoggable
  	 method unless we try and remember which ones can't be cogged.  So also record
  	 the last block method we failed to compile and avoid recompiling it."
  	(self methodWithHeaderShouldBeCogged: methodHeader)
  		ifTrue:
  			[theMethod = lastCoggableInterpretedBlockMethod
  				ifTrue:
  					[theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue:
  						[cogit cog: theMethod selector: objectMemory nilObject.
  						 (self methodHasCogMethod: theMethod) ifTrue:
  							[^self executeCogBlock: (self cogMethodOf: theMethod)
  								closure: blockClosure
  								mayContextSwitch: mayContextSwitch].
  						 cogCompiledCodeCompactionCalledFor ifFalse:
  							[lastUncoggableInterpretedBlockMethod := theMethod]]]
  				ifFalse:
  					[lastCoggableInterpretedBlockMethod := theMethod]]
  		ifFalse:
  			[self maybeFlagMethodAsInterpreted: theMethod].
  
  	self assert: (self methodHasCogMethod: theMethod) not.
  	"Because this is an uncogged method we need to continue via the interpreter.
  	 We could have been reached either from the interpreter, in which case we
  	 should simply return, or from a machine code frame or from a compiled
  	 primitive.  In these latter two cases we must longjmp back to the interpreter.
  	 The instructionPointer tells us which path we took.
  	 If the sender was an interpreter frame but called through a (failing) primitive
  	 then make sure we restore the saved instruction pointer and avoid pushing
  	 ceReturnToInterpreterPC which is only valid between an interpreter caller
  	 frame and a machine code callee frame."
  	(inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse:
  		[instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
  			[instructionPointer := self iframeSavedIP: framePointer]].
  	self push: instructionPointer.
  	self push: framePointer.
  	framePointer := stackPointer.
  	self push: theMethod.
  	self push: objectMemory nilObject. "FxThisContext field"
  	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
  	self push: 0. "FoxIFSavedIP"
+ 	self push: (objectMemory followField: ReceiverIndex ofObject: outerContext).
- 	self push: (objectMemory fetchPointer: ReceiverIndex ofObject: outerContext).
  
  	"Copy the copied values..."
  	0 to: numCopied - 1 do:
  		[:i|
  		self push: (objectMemory
  					fetchPointer: i + ClosureFirstCopiedValueIndex
  					ofObject: blockClosure)].
  
  	self assert: (self frameIsBlockActivation: framePointer).
  	self assert: (self frameHasContext: framePointer) not.
  
  	"The initial instructions in the block nil-out remaining temps."
  
  	"the instruction pointer is a pointer variable equal to 
  	method oop + ip + BaseHeaderSize 
  	-1 for 0-based addressing of fetchByte 
  	-1 because it gets incremented BEFORE fetching currentByte"
  	closureIP := self quickFetchInteger: ClosureStartPCIndex ofObject: blockClosure.
  	instructionPointer := theMethod + closureIP + objectMemory baseHeaderSize - 2.
  	self setMethod: theMethod methodHeader: methodHeader.
  
  	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
  	switched := false.
  	stackPointer < stackLimit ifTrue:
  		[switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch].
  	self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was removed:
- ----- Method: CogObjectRepresentation>>genEnsureObjInRegNotForwarded:scratchReg:updatingMw:r: (in category 'compile abstract instructions') -----
- genEnsureObjInRegNotForwarded: reg scratchReg: scratch updatingMw: offset r: baseReg
- 	"Make sure that the non-immediate oop in reg is not forwarded, updating the field
- 	 at offset from baseReg.  By default there is nothing to do.  Subclasses for memory
- 	 managers that forward will override."
- 	<inline: true>
- 	^0!

Item was added:
+ ----- Method: CogObjectRepresentation>>genEnsureOopInRegNotForwarded:scratchReg:updatingMw:r: (in category 'compile abstract instructions') -----
+ genEnsureOopInRegNotForwarded: reg scratchReg: scratch updatingMw: offset r: baseReg
+ 	"Make sure that the oop in reg is not forwarded, updating the field at offset from baseReg.
+ 	 By default there is nothing to do.  Subclasses for memory managers that forward will override."
+ 	<inline: true>
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentation>>genEnsureOopInRegNotForwarded:scratchReg:updatingSlot:in: (in category 'compile abstract instructions') -----
+ genEnsureOopInRegNotForwarded: reg scratchReg: scratch updatingSlot: index in: objReg
+ 	"Make sure that the oop in reg is not forwarded, updating the slot in objReg with the value."
+ 	<inline: true>
+ 	^self genEnsureOopInRegNotForwarded: reg
+ 		scratchReg: scratch
+ 		updatingMw: index * objectMemory wordSize + objectMemory baseHeaderSize
+ 		r: objReg!

Item was added:
+ ----- Method: CogObjectRepresentation>>genJumpNotSmallInteger:scratchReg: (in category 'compile abstract instructions') -----
+ genJumpNotSmallInteger: aRegister scratchReg: scratch
+ 	"Generate a compare and branch to test if aRegister contains other than a SmallInteger.
+ 	 Answer the jump.  Use scratch if required.  Subclasses will override if scratch is needed."
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	^self genJumpNotSmallInteger: aRegister!

Item was added:
+ ----- Method: CogObjectRepresentation>>genJumpSmallInteger:scratchReg: (in category 'compile abstract instructions') -----
+ genJumpSmallInteger: aRegister scratchReg: scratch
+ 	"Generate a compare and branch to test if aRegister contains a SmallInteger.
+ 	 Answer the jump.  Use scratch if required.  Subclasses will override if scratch is needed."
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	^self genJumpSmallInteger: aRegister!

Item was added:
+ ----- Method: CogObjectRepresentation>>genLoadSlot:sourceReg:destReg: (in category 'compile abstract instructions') -----
+ genLoadSlot: index sourceReg: sourceReg destReg: destReg
+ 	cogit
+ 		MoveMw: index * objectMemory wordSize + objectMemory baseHeaderSize
+ 		r: sourceReg
+ 		R: destReg.
+ 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>allImmediate:branchIf:notInstanceOfBehaviors:target: (in category 'sista support') -----
  allImmediate: immediateMask branchIf: reg notInstanceOfBehaviors: arrayObj target: targetFixUp
  	| jmpImmediate |
  	< inline: true>	
  	<var: #targetFixUp type: #'AbstractInstruction *'>
  	self assert: immediateMask = objectMemory tagMask.
+ 	jmpImmediate := self genJumpNotImmediate: reg.
- 	cogit MoveR: reg R: TempReg.
- 	jmpImmediate := self genJumpNotImmediateInScratchReg: TempReg.
  	jmpImmediate jmpTarget: targetFixUp.
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAtPut: (in category 'primitive generators') -----
  genInnerPrimitiveAtPut: retNoffset
  	"Implement the guts of primitiveAtPut"
  	| formatReg jumpImmediate jumpBadIndex
  	  jumpNotIndexablePointers jumpNotIndexableBits
  	  jumpIsContext jumpIsCompiledMethod jumpIsBytes jumpHasFixedFields
  	  jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
  	  jumpWordsOutOfBounds jumpBytesOutOfBounds jumpBytesOutOfRange
  	  jumpNonSmallIntegerValue jumpShortsUnsupported jumpNotPointers
  	  |
  	<inline: true>
  	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  	<var: #jumpIsBytes type: #'AbstractInstruction *'>
  	<var: #jumpBadIndex type: #'AbstractInstruction *'>
  	<var: #jumpIsContext type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexableBits type: #'AbstractInstruction *'>
  	<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpShortsUnsupported type: #'AbstractInstruction *'>
  	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexablePointers type: #'AbstractInstruction *'>
  
  	jumpImmediate := self genJumpImmediate: ReceiverResultReg.
+ 	jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg.
  	self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  	cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
  
  	"formatReg := self formatOf: ReceiverResultReg"
  	self genGetFormatOf: ReceiverResultReg
  		into: (formatReg := SendNumArgsReg)
  		leastSignificantHalfOfBaseHeaderIntoScratch: nil.
  
  	self genGetNumSlotsOf: ReceiverResultReg into: ClassReg.
  
  	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
  		  0 = 0 sized objects (UndefinedObject True False et al)
  		  1 = non-indexable objects with inst vars (Point et al)
  		  2 = indexable objects with no inst vars (Array et al)
  		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  		  4 = weak indexable objects with inst vars (WeakArray et al)
  		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  		  6 unused, reserved for exotic pointer objects?
  		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
  		  8 unused, reserved for exotic non-pointer objects?
  		  9 (?) 64-bit indexable
  		10 - 11 32-bit indexable
  		12 - 15 16-bit indexable
  		16 - 23 byte indexable
  		24 - 31 compiled method"
  	cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
  	jumpNotPointers := cogit JumpAbove: 0.
  	"optimistic store check; assume index in range (almost always is)."
  	self genStoreCheckReceiverReg: ReceiverResultReg
  		valueReg: Arg1Reg
  		scratchReg: TempReg
  		inFrame: false.
  
  	cogit CmpCq: objectMemory arrayFormat R: formatReg.
  	jumpNotIndexablePointers := cogit JumpBelow: 0.
  	jumpHasFixedFields := cogit JumpNonZero: 0.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
  	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit RetN: retNoffset.
  
  	jumpHasFixedFields jmpTarget: cogit Label.
  	self genGetClassIndexOfNonImm: ReceiverResultReg into: formatReg.
  	cogit CmpCq: ClassMethodContextCompactIndex R: formatReg.
  	jumpIsContext := cogit JumpZero: 0.
  	"get # fixed fields in formatReg"
  	cogit PushR: ClassReg.
  	self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg.
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg.
  	cogit PopR: ClassReg.
  	self genConvertSmallIntegerToIntegerInReg: formatReg.
  	cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg.
  	cogit SubR: formatReg R: ClassReg.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: formatReg.
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddR: formatReg R: Arg0Reg.
  	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit RetN: retNoffset.
  
  	jumpNotPointers jmpTarget:
  		(cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg).
  	jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
+ 	jumpNonSmallIntegerValue := self genJumpNotSmallInteger: Arg1Reg scratchReg: TempReg.
- 	cogit MoveR: Arg1Reg R: TempReg.
- 	jumpNonSmallIntegerValue := self genJumpNotSmallIntegerInScratchReg: TempReg.
  					cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  	jumpIsBytes := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  	jumpShortsUnsupported := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  	"For now ignore 64-bit indexability."
  	jumpNotIndexableBits := cogit JumpBelow: 0.
  
  	cogit CmpR: Arg0Reg R: ClassReg.
  	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
  	cogit MoveR: TempReg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit RetN: retNoffset.
  
  	jumpIsBytes jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: 255) R: Arg1Reg).
  	jumpBytesOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
  	cogit AndCq: objectMemory wordSize - 1 R: formatReg.
  	cogit SubR: formatReg R: ClassReg;
  	CmpR: Arg0Reg R: ClassReg.
  	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
  	cogit MoveR: TempReg Xbr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit RetN: retNoffset.
  
  	"there are no shorts as yet.  so this is dead code:
  	jumpIsShorts jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg).
  	jumpShortsOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
  	cogit AndCq: 1 R: formatReg.
  	cogit SubR: formatReg R: ClassReg;
  	CmpR: Arg0Reg R: ClassReg.
  	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	cogit genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddR: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	jumpShortsDone := cogit Jump: 0."
  
  	jumpIsContext jmpTarget: 
  	(jumpNotIndexableBits jmpTarget:
  	(jumpBytesOutOfRange jmpTarget:
  	(jumpIsCompiledMethod jmpTarget:
  	(jumpArrayOutOfBounds jmpTarget:
  	(jumpBytesOutOfBounds jmpTarget:
  	(jumpShortsUnsupported jmpTarget:
  	(jumpWordsOutOfBounds jmpTarget:
  	(jumpNotIndexablePointers jmpTarget:
  	(jumpNonSmallIntegerValue jmpTarget:
  	(jumpFixedFieldsOutOfBounds jmpTarget: cogit Label)))))))))).
  
  	cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
  	self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
  
  	jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
  
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveMirrorNew: (in category 'primitive generators') -----
  genInnerPrimitiveMirrorNew: retNoffset
  	"Implement 1-arg (instantiateFixedClass:) primitiveNew for convenient cases:
  	- the class argument has a hash
  	- the class argument is fixed size (excluding ephemerons to save instructions & miniscule time)
  	- single word header/num slots < numSlotsMask
  	- the result fits in eden (actually below scavengeThreshold)"
  
  	<option: #NewspeakVM>
  	| halfHeaderReg fillReg instSpecReg byteSizeReg
  	  jumpImmediate jumpUnhashed jumpNotFixedPointers jumpTooSmall jumpBadFormat
  	  jumpNoSpace jumpTooBig jumpHasSlots jumpVariableOrEphemeron
  	  fillLoop skip |
  	<var: 'skip' type: #'AbstractInstruction *'>
  	<var: 'fillLoop' type: #'AbstractInstruction *'>
  	<var: 'jumpTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpHasSlots' type: #'AbstractInstruction *'>
  	<var: 'jumpNoSpace' type: #'AbstractInstruction *'>
  	<var: 'jumpTooSmall' type: #'AbstractInstruction *'>
  	<var: 'jumpUnhashed' type: #'AbstractInstruction *'>
  	<var: 'jumpImmediate' type: #'AbstractInstruction *'>
  	<var: 'jumpBadFormat' type: #'AbstractInstruction *'>
  	<var: 'jumpNotFixedPointers' type: #'AbstractInstruction *'>
  	<var: 'jumpVariableOrEphemeron' type: #'AbstractInstruction *'>
  
  	"half header will contain 1st half of header (classIndex/class's hash & format),
  	 then 2nd half of header (numSlots/fixed size) and finally fill value (nilObject)."
  	halfHeaderReg := fillReg := SendNumArgsReg.
  	"inst spec will hold class's instance specification, then byte size and finally end of new object."
  	instSpecReg := byteSizeReg := ClassReg.
  
  	"get freeStart as early as possible so as not to wait later..."
  	cogit MoveAw: objectMemory freeStartAddress R: Arg1Reg.
  
  	"validate class arg; sigh, this mirror crap hobbles unfairly; there is a better way with selector namespaces..."
+ 	jumpImmediate := self genJumpImmediate: Arg0Reg.
- 	cogit MoveR: Arg0Reg R: TempReg.
- 	jumpImmediate := self genJumpImmediateInScratchReg: TempReg.
  
  	"Is the class arg pointers with at least 3 fields?"
  	self genGetFormatOf: Arg0Reg
  		into: TempReg
  		leastSignificantHalfOfBaseHeaderIntoScratch: nil.
  	cogit CmpCq: objectMemory nonIndexablePointerFormat R: TempReg.
  	jumpNotFixedPointers := cogit JumpNonZero: 0.
  	
  	self genGetRawSlotSizeOfNonImm: Arg0Reg into: TempReg.
  	cogit CmpCq: InstanceSpecificationIndex + 1 R: TempReg.
  	jumpTooSmall := cogit JumpLess: 0.
  
  	"get class's hash & fail if 0"
  	self genGetHashFieldNonImmOf: Arg0Reg into: halfHeaderReg.
  	jumpUnhashed := cogit JumpZero: 0.
  
  	"get class's format inst var for both inst spec (format field) and num fixed fields"
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: Arg0Reg destReg: instSpecReg.
+ 	jumpBadFormat := self genJumpNotSmallInteger: instSpecReg scratchReg: TempReg.
- 	cogit MoveR: instSpecReg R: TempReg.
- 	jumpBadFormat := self genJumpNotSmallIntegerInScratchReg: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: instSpecReg.
+ 	cogit MoveR: instSpecReg R: TempReg.
  	cogit LogicalShiftRightCq: objectMemory fixedFieldsFieldWidth R: TempReg.
  	cogit AndCq: objectMemory formatMask R: TempReg.
  	cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: instSpecReg.
  	"fail if not fixed or if ephemeron (rare beasts so save the cycles)"
  	cogit CmpCq: objectMemory nonIndexablePointerFormat R: TempReg.
  	jumpVariableOrEphemeron := cogit JumpAbove: 0.
  	cogit CmpCq: objectMemory numSlotsMask R: instSpecReg.
  	jumpTooBig := cogit JumpAboveOrEqual: 0.
  	"Add format to classIndex/format half header; other word contains numSlots"
  	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
  	cogit AddR: TempReg R: halfHeaderReg.
  	"write half header now; it frees halfHeaderReg"
  	cogit MoveR: halfHeaderReg Mw: 0 r: Arg1Reg.
  	"save unrounded numSlots for header"
  	cogit MoveR: instSpecReg R: halfHeaderReg.
  	"compute byte size; remember 0-sized objects still need 1 slot & allocation is
  	 rounded up to 8 bytes."
  	cogit CmpCq: 0 R: byteSizeReg. "a.k.a. instSpecReg"
  	jumpHasSlots := cogit JumpNonZero: 0.
  	cogit MoveCq: objectMemory baseHeaderSize * 2 R: byteSizeReg.
  	skip := cogit Jump: 0.
  	"round up to allocationUnit"
  	jumpHasSlots jmpTarget:
  	(cogit MoveR: byteSizeReg R: TempReg).
  	cogit AndCq: 1 R: TempReg.
  	cogit AddR: TempReg R: byteSizeReg.
  	cogit AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: byteSizeReg.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: byteSizeReg.
  	skip jmpTarget:
  	"shift halfHeaderReg to put numSlots in correct place"
  	(cogit LogicalShiftLeftCq: objectMemory numSlotsHalfShift R: halfHeaderReg).
  	"check if allocation fits (freeSize + byteSize < scavengeThreshold); scavengeThreshold is constant."
  	cogit AddR: Arg1Reg R: byteSizeReg.
  	cogit CmpCq: objectMemory getScavengeThreshold R: byteSizeReg.
  	jumpNoSpace := cogit JumpAboveOrEqual: 0.
  	"write back new freeStart; get result. byteSizeReg holds new freeStart, the limit of the object"
  	cogit MoveR: byteSizeReg Aw: objectMemory freeStartAddress.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	"write other half of header (numSlots/identityHash)"
  	cogit MoveR: halfHeaderReg Mw: 4 r: Arg1Reg.
  	"now fill"
  	cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: Arg1Reg.
  	cogit MoveCq: objectMemory nilObject R: fillReg.
  	"at least two words; so can make this a [fill 2 words. reached limit?] whileFalse"
  	fillLoop := 
  	cogit MoveR: fillReg Mw: 0 r: Arg1Reg.
  	cogit MoveR: fillReg Mw: 4 r: Arg1Reg.
  	cogit AddCq: 8 R: Arg1Reg.
  	cogit CmpR: Arg1Reg R: byteSizeReg.
  	cogit JumpAbove: fillLoop.
  	cogit RetN: retNoffset.
  
  	jumpNotFixedPointers jmpTarget:
  	(jumpBadFormat jmpTarget:
  	(jumpTooSmall jmpTarget:
  	(jumpImmediate jmpTarget:
  	(jumpUnhashed jmpTarget:
  	(jumpVariableOrEphemeron jmpTarget:
  	(jumpTooBig jmpTarget:
  	(jumpNoSpace jmpTarget: cogit Label))))))).
  
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveMirrorNewWithArg: (in category 'primitive generators') -----
  genInnerPrimitiveMirrorNewWithArg: retNoffset
  	"Implement instantiateVariableClass:withSize: for convenient cases:
  	- the class argument has a hash
  	- the class argument is variable and not compiled method
  	- single word header/num slots < numSlotsMask
  	- the result fits in eden
  	See superclass method for dynamic frequencies of formats.
  	For the moment we implement only arrayFormat, firstByteFormat & firstLongFormat"
  
  	<option: #NewspeakVM>
  	| halfHeaderReg fillReg instSpecReg byteSizeReg maxSlots
  	  jumpArrayTooBig jumpByteTooBig jumpLongTooBig
  	  jumpArrayFormat jumpByteFormat jumpBytePrepDone jumpLongPrepDone
  	  jumpUnhashed jumpTooSmall jumpImmediate jumpNotFixedPointers
  	  jumpNElementsNonInt jumpFailCuzFixed jumpNoSpace jumpHasSlots fillLoop skip |
  	<var: 'skip' type: #'AbstractInstruction *'>
  	<var: 'fillLoop' type: #'AbstractInstruction *'>	
  	<var: 'jumpHasSlots' type: #'AbstractInstruction *'>
  	<var: 'jumpNoSpace' type: #'AbstractInstruction *'>
  	<var: 'jumpTooSmall' type: #'AbstractInstruction *'>
  	<var: 'jumpUnhashed' type: #'AbstractInstruction *'>
  	<var: 'jumpImmediate' type: #'AbstractInstruction *'>
  	<var: 'jumpByteFormat' type: #'AbstractInstruction *'>
  	<var: 'jumpByteTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpLongTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpArrayFormat' type: #'AbstractInstruction *'>
  	<var: 'jumpArrayTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpFailCuzFixed' type: #'AbstractInstruction *'>
  	<var: 'jumpBytePrepDone' type: #'AbstractInstruction *'>
  	<var: 'jumpLongPrepDone' type: #'AbstractInstruction *'>
  	<var: 'jumpNElementsNonInt' type: #'AbstractInstruction *'>
  	<var: 'jumpNotFixedPointers' type: #'AbstractInstruction *'>
  
  	"half header will contain 1st half of header (classIndex/class's hash & format),
  	 then 2nd half of header (numSlots) and finally fill value (nilObject)."
  	halfHeaderReg := fillReg := SendNumArgsReg.
  	"inst spec will hold class's instance specification and then byte size and finally numSlots half of header"
  	instSpecReg := byteSizeReg := ClassReg.
  	"The max slots we'll allocate here are those for a single header"
  	maxSlots := objectMemory numSlotsMask - 1.
  
  	"check size and fail if not a +ve integer"
+ 	jumpNElementsNonInt := self genJumpNotSmallInteger: Arg1Reg scratchReg: TempReg.
- 	cogit MoveR: Arg1Reg R: TempReg.
- 	jumpNElementsNonInt := self genJumpNotSmallIntegerInScratchReg: TempReg.
  
  	"Is the class arg pointers with at least 3 fields?"
+ 	jumpImmediate := self genJumpImmediate: Arg0Reg.
- 	cogit MoveR: Arg0Reg R: TempReg.
- 	jumpImmediate := self genJumpImmediateInScratchReg: TempReg.
  
  	self genGetFormatOf: Arg0Reg
  		into: TempReg
  		leastSignificantHalfOfBaseHeaderIntoScratch: nil.
  	cogit CmpCq: objectMemory nonIndexablePointerFormat R: TempReg.
  	jumpNotFixedPointers := cogit JumpNonZero: 0.
  	
  	self genGetRawSlotSizeOfNonImm: Arg0Reg into: TempReg.
  	cogit CmpCq: InstanceSpecificationIndex + 1 R: TempReg.
  	jumpTooSmall := cogit JumpLess: 0.
  
  	"get class's hash & fail if 0"
  	self genGetHashFieldNonImmOf: Arg0Reg into: halfHeaderReg.
  	jumpUnhashed := cogit JumpZero: 0.
  
  	"The basicNew: code below (copied from genInnerPrimitiveNewWithArg:) expects class
  	 in ReceiverResultReg and size in Arg0Reg.  Shuffle args to match, undoing on failure."
  	cogit
  		PushR: ReceiverResultReg;
  		MoveR: Arg0Reg R: ReceiverResultReg;
  		MoveR: Arg1Reg R: Arg0Reg.
  
  	"get freeStart as early as possible so as not to wait later..."
  	cogit MoveAw: objectMemory freeStartAddress R: Arg1Reg.
  	"get class's format inst var for inst spec (format field)"
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: ReceiverResultReg destReg: instSpecReg.
  	cogit LogicalShiftRightCq: objectMemory fixedFieldsFieldWidth + self numSmallIntegerTagBits R: instSpecReg.
  	cogit AndCq: objectMemory formatMask R: instSpecReg.
  	"Add format to classIndex/format half header now"
  	cogit MoveR: instSpecReg R: TempReg.
  	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
  	cogit AddR: TempReg R: halfHeaderReg.
  	"get integer value of num fields in TempReg now"
  	cogit MoveR: Arg0Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	"dispatch on format, failing if not variable or if compiled method"
  	cogit CmpCq: objectMemory arrayFormat R: instSpecReg.
  	jumpArrayFormat := cogit JumpZero: 0.
  	cogit CmpCq: objectMemory firstByteFormat R: instSpecReg.
  	jumpByteFormat := cogit JumpZero: 0.
  	cogit CmpCq: objectMemory firstLongFormat R: instSpecReg.
  	jumpFailCuzFixed := cogit JumpNonZero: 0.
  
  	cogit CmpCq: (objectMemory integerObjectOf: maxSlots) R: Arg0Reg.
  	jumpLongTooBig := cogit JumpAbove: 0.
  	"save num elements/slot size to instSpecReg"
  	cogit MoveR: TempReg R: instSpecReg.
  	"push fill value"
  	cogit PushCq: 0.
  	jumpLongPrepDone := cogit Jump: 0. "go allocate"
  
  	jumpByteFormat jmpTarget:
  	(cogit CmpCq: (objectMemory integerObjectOf: maxSlots * objectMemory wordSize) R: Arg0Reg).
  	jumpByteTooBig := cogit JumpAbove: 0.
  	"save num elements to instSpecReg"
  	cogit MoveR: TempReg R: instSpecReg.
  	"compute odd bits and add into halfHeaderReg; oddBits := 4 - nElements bitAnd: 3"
  	cogit MoveCq: objectMemory wordSize R: TempReg.
  	cogit SubR: instSpecReg R: TempReg.
  	cogit AndCq: objectMemory wordSize - 1 R: TempReg.
  	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
  	cogit AddR: TempReg R: halfHeaderReg.
  	"round up num elements to numSlots in instSpecReg"
  	cogit AddCq: objectMemory wordSize - 1 R: instSpecReg.
  	cogit LogicalShiftRightCq: objectMemory shiftForWord R: instSpecReg.
  	"push fill value"
  	cogit PushCq: 0.
  	jumpBytePrepDone := cogit Jump: 0. "go allocate"
  
  	jumpArrayFormat jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: maxSlots) R: Arg0Reg).
  	jumpArrayTooBig := cogit JumpAbove: 0.
  	"save num elements/slot size to instSpecReg"
  	cogit MoveR: TempReg R: instSpecReg.
  	"push fill value"
  	cogit PushCw: objectMemory nilObject.
  	"fall through to allocate"
  
  	jumpBytePrepDone jmpTarget:
  	(jumpLongPrepDone jmpTarget: cogit Label).
  
  	"write half header now; it frees halfHeaderReg"
  	cogit MoveR: halfHeaderReg Mw: 0 r: Arg1Reg.
  	"save numSlots to halfHeaderReg"
  	cogit MoveR: instSpecReg R: halfHeaderReg.
  	"compute byte size; remember 0-sized objects still need 1 slot & allocation is
  	 rounded up to 8 bytes."
  	cogit CmpCq: 0 R: byteSizeReg. "a.k.a. instSpecReg"
  	jumpHasSlots := cogit JumpNonZero: 0.
  	cogit MoveCq: objectMemory baseHeaderSize * 2 R: byteSizeReg.
  	skip := cogit Jump: 0.
  	"round up to allocationUnit"
  	jumpHasSlots jmpTarget:
  	(cogit MoveR: byteSizeReg R: TempReg).
  	cogit AndCq: 1 R: TempReg.
  	cogit AddR: TempReg R: byteSizeReg.
  	cogit AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: byteSizeReg.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: byteSizeReg.
  	skip jmpTarget:
  	"shift halfHeaderReg to put numSlots in correct place"
  	(cogit LogicalShiftLeftCq: objectMemory numSlotsHalfShift R: halfHeaderReg).
  	"check if allocation fits"
  	cogit AddR: Arg1Reg R: byteSizeReg.
  	cogit CmpCq: objectMemory getScavengeThreshold R: byteSizeReg.
  	jumpNoSpace := cogit JumpAboveOrEqual: 0.
  	"get result, increment freeStart and write it back. Arg1Reg holds new freeStart, the limit of the object"
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit MoveR: byteSizeReg Aw: objectMemory freeStartAddress.
  	"write other half of header (numSlots/0 identityHash)"
  	cogit MoveR: halfHeaderReg Mw: 4 r: ReceiverResultReg.
  	"now fill"
  	cogit PopR: fillReg.
  	cogit PopR: TempReg. "discard pushed receiver"
  	cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: Arg1Reg.
  	"at least two words; so can make this a [fill 2 words. reached limit?] whileFalse"
  	fillLoop := 
  	cogit MoveR: fillReg Mw: 0 r: Arg1Reg.
  	cogit MoveR: fillReg Mw: 4 r: Arg1Reg.
  	cogit AddCq: 8 R: Arg1Reg.
  	cogit CmpR: Arg1Reg R: byteSizeReg.
  	cogit JumpAbove: fillLoop.
  	cogit RetN: retNoffset.
  
  	"pop discarded fill value & fall through to failure"
  	jumpNoSpace jmpTarget: (cogit PopR: TempReg).
  
  	jumpFailCuzFixed jmpTarget:
  	(jumpArrayTooBig jmpTarget:
  	(jumpByteTooBig jmpTarget:
  	(jumpLongTooBig jmpTarget: cogit Label))).
  
  	"unshuffle arguments"
  	cogit
  		MoveR: Arg0Reg R: Arg1Reg;
  		MoveR: ReceiverResultReg R: Arg0Reg;
  		PopR: ReceiverResultReg.
  
  	jumpUnhashed jmpTarget:
  	(jumpImmediate jmpTarget:
  	(jumpNotFixedPointers jmpTarget:
  	(jumpTooSmall jmpTarget:
  	(jumpNElementsNonInt jmpTarget: cogit Label)))).
  
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>allImmediate:branchIf:notInstanceOfBehaviors:target: (in category 'sista support') -----
  allImmediate: immediateMask branchIf: reg notInstanceOfBehaviors: arrayObj target: targetFixUp
  	| incorrectTag tag1 tag2 |
  	<var: #targetFixUp type: #'AbstractInstruction *'>
+ 	(self genJumpNotImmediate: reg) jmpTarget: targetFixUp. 
- 	cogit MoveR: reg R: TempReg.
- 	(self genJumpNotImmediateInScratchReg: TempReg) jmpTarget: targetFixUp. 
  	immediateMask = objectMemory tagMask ifFalse: 
  		[ "TempReg holds the rcvr tag"
  		"In this case one immediate tag out of the three is not present in arrayObj. 
  		We look for it, and generate a jump to the fixup if the rcvr tag matches"
  		tag1 := objectMemory classTagForClass: (objectMemory fetchPointer: 0 ofObject: arrayObj).
  		tag2 := objectMemory classTagForClass: (objectMemory fetchPointer: 1 ofObject: arrayObj).
  		incorrectTag :=  self fetchImmediateTagOtherThanTag1: tag1 tag2: tag2.
  		cogit CmpCq: incorrectTag R: TempReg.
  		cogit JumpZero: targetFixUp ].!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallInteger:scratchReg: (in category 'compile abstract instructions') -----
+ genJumpNotSmallInteger: reg scratchReg: scratch
+ 	"Generate a compare and branch to test if aRegister contains other than a SmallInteger.
+ 	 Answer the jump.  Override since scratch is needed."
+ 	cogit AndCq: objectMemory tagMask R: reg R: scratch.
+ 	cogit CmpCq: objectMemory smallIntegerTag R: scratch.
+ 	^cogit JumpNonZero: 0!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpSmallInteger:scratchReg: (in category 'compile abstract instructions') -----
+ genJumpSmallInteger: reg scratchReg: scratch
+ 	"Generate a compare and branch to test if aRegister contains a SmallInteger.
+ 	 Answer the jump.  Override since scratch is needed."
+ 	cogit AndCq: objectMemory tagMask R: reg R: scratch.
+ 	cogit CmpCq: objectMemory smallIntegerTag R: scratch.
+ 	^cogit JumpZero: 0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>branchIf:notInstanceOfBehavior:target: (in category 'sista support') -----
  branchIf: reg notInstanceOfBehavior: classObj target: targetFixUp
  	"Generate a branch if reg is an instance of classObj, otherwise fall-
  	 through. Cannot change the value of reg (may be used afterwards)."
  	| classIndex |
  	<inline: true>
  	<var: #targetFixUp type: #'AbstractInstruction *'>
  	classIndex := objectMemory classTagForClass: classObj.
  	(objectMemory isImmediateClass: classObj)
  		ifTrue:
  			[self branchIf: reg hasNotImmediateTag: classIndex target: targetFixUp ]
  		ifFalse:
+ 			[(self genJumpImmediate: reg) jmpTarget: targetFixUp.
- 			[cogit MoveR: reg R: TempReg.
- 			(self genJumpImmediateInScratchReg: TempReg) jmpTarget: targetFixUp.
  			 self genGetClassIndexOfNonImm: reg into: TempReg.
  			 self genCmpClassIndex: classIndex R: TempReg.
  			 cogit JumpNonZero: targetFixUp ].
  	^0!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>genEnsureObjInRegNotForwarded:scratchReg:updatingMw:r: (in category 'compile abstract instructions') -----
- genEnsureObjInRegNotForwarded: reg scratchReg: scratch updatingMw: offset r: baseReg
- 	"Make sure that the object in reg is not forwarded, and the field reg[offset] is updated
- 	 if the object in reg is forwarded. Use the fact that isForwardedObjectClassIndexPun is
- 	 a power of two to save an instruction."
- 	| loop imm ok |
- 	<var: #ok type: #'AbstractInstruction *'>
- 	<var: #imm type: #'AbstractInstruction *'>
- 	<var: #loop type: #'AbstractInstruction *'>
- 	self assert: reg ~= scratch.
- 	loop := cogit Label.
- 	cogit MoveR: reg R: scratch.
- 	imm := self genJumpImmediateInScratchReg: scratch.
- 	"notionally
- 		self genGetClassIndexOfNonImm: reg into: scratch.
- 		cogit CmpCq: objectMemory isForwardedObjectClassIndexPun R: TempReg.
- 	 but the following is an instruction shorter:"
- 	cogit MoveMw: 0 r: reg R: scratch.
- 	cogit
- 		AndCq: objectMemory classIndexMask - objectMemory isForwardedObjectClassIndexPun
- 		R: scratch.
- 	ok := cogit JumpNonZero:  0.
- 	self genLoadSlot: 0 sourceReg: reg destReg: reg.
- 	cogit MoveR: reg Mw: offset r: baseReg.
- 	cogit Jump: loop.
- 	ok jmpTarget: (imm jmpTarget: cogit Label).
- 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genEnsureOopInRegNotForwarded:scratchReg:ifForwarder:ifNotForwarder: (in category 'compile abstract instructions') -----
  genEnsureOopInRegNotForwarded: reg scratchReg: scratch ifForwarder: fwdJumpTarget ifNotForwarder: nonFwdJumpTargetOrZero
  	"Make sure that the oop in reg is not forwarded.  
  	 Use the fact that isForwardedObjectClassIndexPun is a power of two to save an instruction."
+ 	| imm ok finished |
- 	| skip ok finished |
  	<inline: true>
  	<var: #ok type: #'AbstractInstruction *'>
+ 	<var: #imm type: #'AbstractInstruction *'>
- 	<var: #skip type: #'AbstractInstruction *'>
  	<var: #finished type: #'AbstractInstruction *'>
  	self assert: reg ~= scratch.
+ 	imm := self genJumpImmediate: reg.
- 	cogit MoveR: reg R: scratch.
- 	skip := self genJumpImmediateInScratchReg: scratch.
  	"notionally
  		self genGetClassIndexOfNonImm: reg into: scratch.
  		cogit CmpCq: objectMemory isForwardedObjectClassIndexPun R: TempReg.
  	 but the following is an instruction shorter:"
  	cogit MoveMw: 0 r: reg R: scratch.
  	cogit
  		AndCq: objectMemory classIndexMask - objectMemory isForwardedObjectClassIndexPun
  		R: scratch.
  	ok := cogit JumpNonZero: 0.
  	self genLoadSlot: 0 sourceReg: reg destReg: reg.
  	cogit Jump: fwdJumpTarget.
  	finished := nonFwdJumpTargetOrZero = 0
  		ifTrue: [ cogit Label ]
  		ifFalse: [ self cCoerceSimple: nonFwdJumpTargetOrZero to: #'AbstractInstruction *' ].
+ 	imm jmpTarget: (ok jmpTarget: finished).
- 	skip jmpTarget: (ok jmpTarget: finished).
  	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genEnsureOopInRegNotForwarded:scratchReg:updatingMw:r: (in category 'compile abstract instructions') -----
+ genEnsureOopInRegNotForwarded: reg scratchReg: scratch updatingMw: offset r: baseReg
+ 	"Make sure that the oop in reg is not forwarded, and the field reg[offset] is updated
+ 	 if the object in reg is forwarded.  Use the fact that isForwardedObjectClassIndexPun is
+ 	 a power of two to save an instruction."
+ 	| loop imm ok |
+ 	<var: #ok type: #'AbstractInstruction *'>
+ 	<var: #imm type: #'AbstractInstruction *'>
+ 	<var: #loop type: #'AbstractInstruction *'>
+ 	self assert: reg ~= scratch.
+ 	loop := cogit Label.
+ 	imm := self genJumpImmediate: reg.
+ 	"notionally
+ 		self genGetClassIndexOfNonImm: reg into: scratch.
+ 		cogit CmpCq: objectMemory isForwardedObjectClassIndexPun R: TempReg.
+ 	 but the following is an instruction shorter:"
+ 	cogit MoveMw: 0 r: reg R: scratch.
+ 	cogit
+ 		AndCq: objectMemory classIndexMask - objectMemory isForwardedObjectClassIndexPun
+ 		R: scratch.
+ 	ok := cogit JumpNonZero:  0.
+ 	self genLoadSlot: 0 sourceReg: reg destReg: reg.
+ 	cogit MoveR: reg Mw: offset r: baseReg.
+ 	cogit Jump: loop.
+ 	ok jmpTarget: (imm jmpTarget: cogit Label).
+ 	^0!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>genLoadSlot:sourceReg:destReg: (in category 'compile abstract instructions') -----
- genLoadSlot: index sourceReg: sourceReg destReg: destReg
- 	cogit
- 		MoveMw: index * objectMemory wordSize + objectMemory baseHeaderSize
- 		r: sourceReg
- 		R: destReg.
- 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>mixed:branchIf:notInstanceOfBehaviors:target: (in category 'sista support') -----
  mixed: numNonImmediates branchIf: reg notInstanceOfBehaviors: arrayObj target: targetFixUp
  	| jmpImmediate jumps label numCases classObj index |
  	<var: #label type: #'AbstractInstruction *'>
  	<var: #jmpImmediate type: #'AbstractInstruction *'>
  	<var: #jumps type: #'AbstractInstruction **'>
  	<var: #targetFixUp type: #'AbstractInstruction *'>
  	numCases := objectMemory numSlotsOf: arrayObj.
+ 	jmpImmediate := self genJumpImmediate: reg.
- 	cogit MoveR: reg R: TempReg.
- 	jmpImmediate := self genJumpImmediateInScratchReg: TempReg.
  	
  	"Rcvr is non immediate"
  	jumps := self alloca: numNonImmediates type: (self cCode: [#'AbstractInstruction *'] inSmalltalk: [cogit backEnd class]).
  	self genGetClassIndexOfNonImm: reg into: TempReg.
  	index := 0.
  	0 to: numCases - 1 do:
  		[:i|
  			classObj := objectMemory fetchPointer: i ofObject: arrayObj.
  			(objectMemory isImmediateClass: classObj) ifFalse: [
  				self genCmpClassIndex: (objectMemory classTagForClass: classObj) R: TempReg.
  				jumps at: index put: (cogit JumpZero: 0).
  				index := index + 1 ] ].
  	cogit Jump: targetFixUp.
  	
  	"Rcvr is immediate"
  	jmpImmediate jmpTarget: cogit Label.
  	numCases - numNonImmediates "num Immediates allowed"
  		caseOf:
  		{[ 1 ] -> [ "1 immediate allowed. jump to targetFixUp if the rcvr is not this immediate"
  			0 to: numCases - 1 do:
  				[ :j |
  				classObj := objectMemory fetchPointer: j ofObject: arrayObj.
  				(objectMemory isImmediateClass: classObj) ifTrue: [
  					self branchIf: reg hasNotImmediateTag: (objectMemory classTagForClass: classObj) target: targetFixUp ] ] ] .
  		[ 2 ] -> [ "2 immediates allowed. On 32 bits nothing to do, all immediate are allowed, on 64 bits generates the jump to fixup for the third tag"
  				self branch2CasesIf: reg notInstanceOfBehaviors: arrayObj target: targetFixUp ] .
  		[ 3 ] -> [ "nothing to do, all immediates are allowed." ] }.
  	
  	label := self Label.
  	0 to: numNonImmediates - 1 do: [:i |
  		(jumps at: i) jmpTarget: label ].
  	
  	^ 0
  		!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>noneImmediateBranchIf:notInstanceOfBehaviors:target: (in category 'sista support') -----
  noneImmediateBranchIf: reg notInstanceOfBehaviors: arrayObj target: targetFixUp
  	"All classes in arrayObj are not immediate"
  	| label numJumps jumps classObj |
  	<var: #targetFixUp type: #'AbstractInstruction *'>
  	<var: #label type: #'AbstractInstruction *'>
  	<var: #jumps type: #'AbstractInstruction **'>
- 	cogit MoveR: reg R: TempReg.
  	jumps := self alloca: (objectMemory numSlotsOf: arrayObj) type: (self cCode: [#'AbstractInstruction *'] inSmalltalk: [cogit backEnd class]).
+ 	(self genJumpImmediate: reg) jmpTarget: targetFixUp.
- 	(self genJumpImmediateInScratchReg: TempReg) jmpTarget: targetFixUp.
  	self genGetClassIndexOfNonImm: reg into: TempReg.
  	0 to: (numJumps := objectMemory numSlotsOf: arrayObj) - 1 do:
  		[:i|
  		 classObj := objectMemory fetchPointer: i ofObject: arrayObj.
  		 self genCmpClassIndex: (objectMemory classTagForClass: classObj) R: TempReg.
  		jumps at: i put: (cogit JumpZero: 0) ].
  	cogit Jump: targetFixUp.
  	label := self Label.
  	0 to: numJumps - 1 do: [:i |
  		(jumps at: i) jmpTarget: label ].
  	^0!

Item was removed:
- ----- Method: CogObjectRepresentationForSqueakV3>>genLoadSlot:sourceReg:destReg: (in category 'compile abstract instructions') -----
- genLoadSlot: index sourceReg: sourceReg destReg: destReg
- 	cogit MoveMw: index * objectMemory wordSize + objectMemory baseHeaderSize r: sourceReg R: destReg.
- 	^0!

Item was changed:
  ----- Method: Cogit>>genNSSendTrampolineFor:numArgs:called: (in category 'initialization') -----
  genNSSendTrampolineFor: aRoutine numArgs: numArgs called: aString
  	"ReceiverResultReg: method receiver
  	SendNumArgsReg: the NSSendCache cache"
  	<option: #NewspeakVM>
  	<var: #aRoutine type: #'void *'>
  	<var: #aString type: #'char *'>
  	| jumpMiss jumpItsTheReceiverStupid |
  	<var: #jumpMiss type: #'AbstractInstruction *'>
  	<var: #jumpItsTheReceiverStupid type: #'AbstractInstruction *'>
  	opcodeIndex := 0.
  	objectRepresentation
  		genGetInlineCacheClassTagFrom: ReceiverResultReg
  		into: ClassReg
  		forEntry: false.
  	self MoveMw: NSCClassTagIndex * objectMemory wordSize r: SendNumArgsReg R: TempReg.
  	self CmpR: ClassReg R: TempReg.
  	jumpMiss := self JumpNonZero: 0.
  	self MoveMw: NSCEnclosingObjectIndex * objectMemory wordSize r: SendNumArgsReg R: TempReg.
  	self CmpCq: 0 R: TempReg.
  	jumpItsTheReceiverStupid := self JumpZero: 0.
  	self MoveR: TempReg R: ReceiverResultReg.
  	"Now set the stacked receiver, if needed.  If there are reg args this is
  	 not required; see genPushRegisterArgsForNumArgs:numArgs: below."
  	(self numRegArgs = 0 or: [numArgs > self numRegArgs]) ifTrue:
  		[numArgs >= (NumSendTrampolines - 1)
  			ifTrue: "arbitrary argument count"
  				[self MoveMw: NSCNumArgsIndex * objectMemory wordSize r: SendNumArgsReg R: TempReg.
  				 backEnd hasLinkRegister ifFalse:
  					[self AddCq: 1 R: TempReg]..
  				 self MoveR: ReceiverResultReg Xwr: TempReg R: SPReg]
  			ifFalse: "Known argument count"
  				[self MoveR: TempReg Mw: (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1]) + numArgs * objectMemory wordSize r: SPReg]].
  	jumpItsTheReceiverStupid jmpTarget: self Label.
  	self MoveMw: NSCTargetIndex * objectMemory wordSize r: SendNumArgsReg R: TempReg.
  	self JumpR: TempReg.
  
  	jumpMiss jmpTarget: self Label.
  	objectRepresentation
+ 		genEnsureOopInRegNotForwarded: ReceiverResultReg
- 		genEnsureObjInRegNotForwarded: ReceiverResultReg
  		scratchReg: TempReg
  		updatingMw: FoxMFReceiver
  		r: FPReg.
  	self numRegArgs > 0 ifTrue:
  		[backEnd genPushRegisterArgsForNumArgs: numArgs scratchReg: TempReg].
  	^self
  		genTrampolineFor: aRoutine
  		called: aString
  		numArgs: 2
  		arg: SendNumArgsReg "The NSSendCache"
  		arg: ReceiverResultReg
  		arg: nil
  		arg: nil
  		saveRegs: false
  		pushLinkReg: true
  		resultReg: ReceiverResultReg  "Never happens?"
  		appendOpcodes: true!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
  compileOpenPIC: selector numArgs: numArgs
  	"Compile the code for an open PIC.  Perform a probe of the first-level method
  	 lookup cache followed by a call of ceSendFromInLineCacheMiss: if the probe fails."
  	| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod |
  	<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
  	<var: #jumpClassMiss type: #'AbstractInstruction *'>
  	<var: #itsAHit type: #'AbstractInstruction *'>
  	<var: #jumpBCMethod type: #'AbstractInstruction *'>
  	self compilePICAbort: numArgs.
  	entry := objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
  
  	"Do first of three probes.  See CoInterpreter>>lookupInMethodCacheSel:classTag:"
  	self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
  	self MoveR: ClassReg R: SendNumArgsReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	jumpClassMiss := self JumpNonZero: 0.
  
  	itsAHit := self Label.
  	"Fetch the method.  The interpret trampoline requires the bytecoded method in SendNumArgsReg"
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << objectMemory shiftForWord)
  		r: ClassReg
  		R: SendNumArgsReg.
  	"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
+ 	objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
+ 	jumpBCMethod := objectRepresentation genJumpImmediate: ClassReg.
- 	objectRepresentation
- 		genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: TempReg.
- 	self MoveR: TempReg R: ClassReg.
- 	jumpBCMethod := objectRepresentation genJumpSmallIntegerInScratchReg: TempReg.
  	jumpBCMethod jmpTarget: picInterpretAbort.
  	self AddCq: cmNoCheckEntryOffset R: ClassReg.
  	self JumpR: ClassReg.
  
  	"First probe missed.  Do second of three probes.  Shift hash right one and retry."
  	jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Second probe missed.  Do last probe.  Shift hash right two and retry."
  	jumpSelectorMiss jmpTarget: self Label.
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	objectMemory shiftForWord > 2 ifTrue:
  		[self LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg].
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Last probe missed.  Call ceSendFromInLineCacheMiss: to do the full lookup."
  	jumpSelectorMiss jmpTarget: self Label.
  	self genSmalltalkToCStackSwitch: true.
  	methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
  	self 
  		compileCallFor: #ceSendFromInLineCacheMiss:
  		numArgs: 1
  		arg: SendNumArgsReg
  		arg: nil
  		arg: nil
  		arg: nil
  		resultReg: nil
  		saveRegs: false
  	"Note that this call does not return."!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genDoubleArithmetic:preOpCheck: (in category 'primitive generators') -----
  genDoubleArithmetic: arithmeticOperator preOpCheck: preOpCheckOrNil
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
  	<var: #preOpCheckOrNil declareC: 'AbstractInstruction *(*preOpCheckOrNil)(int rcvrReg, int argReg)'>
  	| jumpFailClass jumpFailAlloc jumpFailCheck jumpImmediate jumpNonInt doOp fail |
  	<var: #jumpFailClass type: #'AbstractInstruction *'>
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpFailCheck type: #'AbstractInstruction *'>
  	<var: #doOp type: #'AbstractInstruction *'>
  	<var: #fail type: #'AbstractInstruction *'>
+ 	self genLoadArgAtDepth: 0 into: ClassReg.
- 	self genLoadArgAtDepth: 0 into: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
+ 	jumpImmediate := objectRepresentation genJumpImmediate: ClassReg.
- 	self MoveR: TempReg R: ClassReg.
- 	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: SendNumArgsReg.
  	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
  	jumpFailClass := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: ClassReg into: DPFPReg1.
  	doOp := self Label.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck := self perform: preOpCheckOrNil with: DPFPReg0 with: DPFPReg1].
  	self gen: arithmeticOperator operand: DPFPReg1 operand: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  					genAllocFloatValue: DPFPReg0
  					into: SendNumArgsReg
  					scratchReg: ClassReg
  					scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self RetN: (self primRetNOffsetFor: 1).
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
+ 		[jumpNonInt := objectRepresentation genJumpNotSmallInteger: ClassReg scratchReg: TempReg].
- 		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ClassReg.
  	self ConvertR: ClassReg Rd: DPFPReg1.
  	self Jump: doOp.
  	jumpFailAlloc jmpTarget: self Label.
  	self compileFallbackToInterpreterPrimitive.
  	fail := self Label.
  	jumpFailClass jmpTarget: fail.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck jmpTarget: fail].
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: fail].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genDoubleComparison:invert: (in category 'primitive generators') -----
  genDoubleComparison: jumpOpcodeGenerator invert: invertComparison
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
  	<var: #jumpOpcodeGenerator declareC: 'AbstractInstruction *(*jumpOpcodeGenerator)(void *)'>
  	| jumpFail jumpImmediate jumpNonInt jumpCond compare |
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpCond type: #'AbstractInstruction *'>
  	<var: #compare type: #'AbstractInstruction *'>
  	<var: #jumpFail type: #'AbstractInstruction *'>
  
+ 	self genLoadArgAtDepth: 0 into: ClassReg.
- 	self genLoadArgAtDepth: 0 into: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
+ 	jumpImmediate := objectRepresentation genJumpImmediate: ClassReg.
- 	self MoveR: TempReg R: ClassReg.
- 	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: SendNumArgsReg.
  	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
  	jumpFail := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: ClassReg into: DPFPReg1.
  	invertComparison "May need to invert for NaNs"
  		ifTrue: [compare := self CmpRd: DPFPReg0 Rd: DPFPReg1]
  		ifFalse: [compare := self CmpRd: DPFPReg1 Rd: DPFPReg0].
  	jumpCond := self perform: jumpOpcodeGenerator with: 0. "FP jumps are a little weird"
  	self genMoveFalseR: ReceiverResultReg.
  	self RetN: (self primRetNOffsetFor: 1).
  	jumpCond jmpTarget: (self genMoveTrueR: ReceiverResultReg).
  	self RetN: (self primRetNOffsetFor: 1).
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
+ 		[jumpNonInt := objectRepresentation genJumpNotSmallInteger: ClassReg scratchReg: TempReg].
- 		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ClassReg.
  	self ConvertR: ClassReg Rd: DPFPReg1.
  	self Jump: compare.
  	jumpFail jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: jumpFail getJmpTarget].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveClosureValue (in category 'primitive generators') -----
  genPrimitiveClosureValue
  	"Check the argument count.  Fail if wrong.
  	 Get the method from the outerContext and see if it is cogged.  If so, jump to the
  	 block entry or the no-context-switch entry, as appropriate, and we're done.  If not,
  	 invoke the interpreter primitive."
  	| jumpFailNArgs jumpFail1 jumpFail2 jumpFail3 jumpFail4 jumpBCMethod primitiveRoutine result |
  	<var: #jumpFail5 type: #'AbstractInstruction *'>
  	<var: #jumpFail2 type: #'AbstractInstruction *'>
  	<var: #jumpFail3 type: #'AbstractInstruction *'>
  	<var: #jumpFail4 type: #'AbstractInstruction *'>
  	<var: #jumpFailNArgs type: #'AbstractInstruction *'>
  	<var: #jumpBCMethod type: #'AbstractInstruction *'>
  	<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)()'>
  	objectRepresentation genLoadSlot: ClosureNumArgsIndex sourceReg: ReceiverResultReg destReg: TempReg.
  	self CmpCq: (objectMemory integerObjectOf: methodOrBlockNumArgs) R: TempReg.
  	jumpFailNArgs := self JumpNonZero: 0.
  	objectRepresentation genLoadSlot: ClosureOuterContextIndex sourceReg: ReceiverResultReg destReg: ClassReg.
  	jumpFail1 := objectRepresentation genJumpImmediate: ClassReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: TempReg.
  	objectRepresentation genCmpClassMethodContextCompactIndexR: TempReg.
  	jumpFail2 := self JumpNonZero: 0.
+ 	"This could be deferred to the prologue (compileBlockFrameBuild:) if blocks were
+ 	 scanned to see if they referred to the receiver.  But for now this is safe if slow."
+ 	objectRepresentation hasSpurMemoryManagerAPI ifTrue:
+ 		[objectRepresentation
+ 			genLoadSlot: ReceiverIndex sourceReg: ClassReg destReg: SendNumArgsReg;
+ 			genEnsureOopInRegNotForwarded: SendNumArgsReg
+ 			scratchReg: TempReg
+ 			updatingSlot: ReceiverIndex
+ 			in: ClassReg].
  	objectRepresentation genLoadSlot: MethodIndex sourceReg: ClassReg destReg: SendNumArgsReg.
  	jumpFail3 := objectRepresentation genJumpImmediate: SendNumArgsReg.
  	objectRepresentation genGetFormatOf: SendNumArgsReg into: TempReg.
  	self CmpCq: objectMemory firstCompiledMethodFormat R: TempReg.
  	jumpFail4 := self JumpLess: 0.
  	objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
  	jumpBCMethod := objectRepresentation genJumpSmallInteger: ClassReg.
  	self MoveM16: (self offset: CogMethod of: #blockEntryOffset) r: ClassReg R: TempReg.
  	self AddR: ClassReg R: TempReg.
  	primitiveRoutine := coInterpreter
  							functionPointerForCompiledMethod: methodObj
  							primitiveIndex: primitiveIndex.
  	primitiveRoutine = #primitiveClosureValueNoContextSwitch ifTrue:
  		[blockNoContextSwitchOffset = nil ifTrue:
  			[^NotFullyInitialized].
  		 self SubCq: blockNoContextSwitchOffset R: TempReg].
  	self JumpR: TempReg.
  	jumpBCMethod jmpTarget: (jumpFail1 jmpTarget: (jumpFail2 jmpTarget: (jumpFail3 jmpTarget: (jumpFail4 jmpTarget: self Label)))).
  	(result := self compileInterpreterPrimitive: primitiveRoutine) < 0 ifTrue:
  		[^result].
  	jumpFailNArgs jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genSmallIntegerComparison:orDoubleComparison: (in category 'primitive generators') -----
  genSmallIntegerComparison: jumpOpcode orDoubleComparison: jumpFPOpcodeGenerator
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
  	| jumpDouble jumpNonInt jumpFail jumpTrue jumpCond |
  	<var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction *(*jumpFPOpcodeGenerator)(void *)'>
  	<var: #jumpDouble type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpCond type: #'AbstractInstruction *'>
  	<var: #jumpTrue type: #'AbstractInstruction *'>
  	<var: #jumpFail type: #'AbstractInstruction *'>
  	backEnd hasDoublePrecisionFloatingPointSupport ifFalse:
  		[^self genSmallIntegerComparison: jumpOpcode].
+ 	self genLoadArgAtDepth: 0 into: ClassReg.
+ 	jumpDouble := objectRepresentation genJumpNotSmallInteger: ClassReg scratchReg: TempReg.
- 	self genLoadArgAtDepth: 0 into: TempReg.
- 	self MoveR: TempReg R: ClassReg.
- 	jumpDouble := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self CmpR: ClassReg R: ReceiverResultReg. "N.B. FLAGS := RRReg - ClassReg"
  	jumpTrue := self gen: jumpOpcode.
  	self genMoveFalseR: ReceiverResultReg.
  	self RetN: (self primRetNOffsetFor: 1).
  	jumpTrue jmpTarget: (self genMoveTrueR: ReceiverResultReg).
  	self RetN: (self primRetNOffsetFor: 1).
  	
  	"Argument may be a Float : let us check or fail"
  	jumpDouble jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
+ 		[jumpNonInt := objectRepresentation genJumpImmediate: ClassReg].
- 		[self MoveR: ClassReg R: TempReg.
- 		 jumpNonInt := objectRepresentation genJumpImmediateInScratchReg: TempReg].
  	objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: SendNumArgsReg.
  	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
  	jumpFail := self JumpNonZero: 0.
  
  	"It was a Float, so convert the receiver to double and perform the operation"
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: TempReg.
  	self ConvertR: TempReg Rd: DPFPReg0.
  	objectRepresentation genGetDoubleValueOf: ClassReg into: DPFPReg1.
  	self CmpRd: DPFPReg1 Rd: DPFPReg0.
  	jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP jumps are a little weird"
  	self genMoveFalseR: ReceiverResultReg.
  	self RetN: (self primRetNOffsetFor: 1).
  	jumpCond jmpTarget: (self genMoveTrueR: ReceiverResultReg).
  	self RetN: (self primRetNOffsetFor: 1).
  
  	objectRepresentation smallIntegerIsOnlyImmediateType
  		ifTrue: [jumpFail jmpTarget: self Label]
  		ifFalse: [jumpNonInt jmpTarget: (jumpFail jmpTarget: self Label)].
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>activateNewClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
  activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
  	"Similar to activateNewMethod but for Closure and newMethod."
  	| numCopied outerContext theMethod closureIP |
  	<inline: true>
+ 	outerContext := objectMemory followField: ClosureOuterContextIndex ofObject: blockClosure.
- 	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
  	numCopied := self copiedValueCountOfClosure: blockClosure.
  
+ 	theMethod := objectMemory followField: MethodIndex ofObject: outerContext.
- 	theMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
  	self push: instructionPointer.
  	self push: framePointer.
  	framePointer := stackPointer.
  	self push: theMethod.
  	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
  	self push: objectMemory nilObject. "FxThisContext field"
+ 	self push: (objectMemory followField: ReceiverIndex ofObject: outerContext).
- 	self push: (objectMemory fetchPointer: ReceiverIndex ofObject: outerContext).
  
  	"Copy the copied values..."
  	0 to: numCopied - 1 do:
  		[:i|
  		self push: (objectMemory
  					fetchPointer: i + ClosureFirstCopiedValueIndex
  					ofObject: blockClosure)].
  
  	self assert: (self frameIsBlockActivation: framePointer).
  	self assert: (self frameHasContext: framePointer) not.
  
  	"The initial instructions in the block nil-out remaining temps."
  
  	"the instruction pointer is a pointer variable equal to 
  	method oop + ip + BaseHeaderSize 
  	-1 for 0-based addressing of fetchByte 
  	-1 because it gets incremented BEFORE fetching currentByte"
  	closureIP := self quickFetchInteger: ClosureStartPCIndex ofObject: blockClosure.
  	instructionPointer := theMethod + closureIP + objectMemory baseHeaderSize - 2.
  	self setMethod: theMethod.
  
  	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
  	stackPointer < stackLimit ifTrue:
  		[self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
  compileOpenPIC: selector numArgs: numArgs
  	"Compile the code for an open PIC.  Perform a probe of the first-level method
  	 lookup cache followed by a call of ceSendFromInLineCacheMiss: if the probe fails.
  	 Override to push the register args when calling ceSendFromInLineCacheMiss:"
  	| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod |
  	<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
  	<var: #jumpClassMiss type: #'AbstractInstruction *'>
  	<var: #itsAHit type: #'AbstractInstruction *'>
  	<var: #jumpBCMethod type: #'AbstractInstruction *'>
  	self compilePICAbort: numArgs.
  	entry := objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
  
  	"Do first of three probes.  See CoInterpreter>>lookupInMethodCacheSel:classTag:"
  	self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
  	self MoveR: ClassReg R: SendNumArgsReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	jumpClassMiss := self JumpNonZero: 0.
  
  	itsAHit := self Label.
  	"Fetch the method.  The interpret trampoline requires the bytecoded method in SendNumArgsReg"
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << objectMemory shiftForWord)
  		r: ClassReg
  		R: SendNumArgsReg.
  	"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
+ 	objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
+ 	jumpBCMethod := objectRepresentation genJumpImmediate: ClassReg.
- 	objectRepresentation
- 		genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: TempReg.
- 	self MoveR: TempReg R: ClassReg.
- 	jumpBCMethod := objectRepresentation genJumpSmallIntegerInScratchReg: TempReg.
  	jumpBCMethod jmpTarget: picInterpretAbort.
  	self AddCq: cmNoCheckEntryOffset R: ClassReg.
  	self JumpR: ClassReg.
  
  	"First probe missed.  Do second of three probes.  Shift hash right one and retry."
  	jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Second probe missed.  Do last probe.  Shift hash right two and retry."
  	jumpSelectorMiss jmpTarget: self Label.
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	objectMemory shiftForWord > 2 ifTrue:
  		[self LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg].
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Last probe missed.  Call ceSendFromInLineCacheMiss: to do the full lookup."
  	jumpSelectorMiss jmpTarget: self Label.
  	backEnd genPushRegisterArgsForNumArgs: numArgs scratchReg: SendNumArgsReg.
  	self genSmalltalkToCStackSwitch: true.
  	methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
  	self 
  		compileCallFor: #ceSendFromInLineCacheMiss:
  		numArgs: 1
  		arg: SendNumArgsReg
  		arg: nil
  		arg: nil
  		arg: nil
  		resultReg: nil
  		saveRegs: false
  	"Note that this call does not return."!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genDoubleArithmetic:preOpCheck: (in category 'primitive generators') -----
  genDoubleArithmetic: arithmeticOperator preOpCheck: preOpCheckOrNil
  	"Receiver and arg in registers.
  	 Stack looks like
  		return address"
  	<var: #preOpCheckOrNil declareC: 'AbstractInstruction *(*preOpCheckOrNil)(int rcvrReg, int argReg)'>
  	| jumpFailClass jumpFailAlloc jumpFailCheck jumpImmediate jumpNonInt doOp |
  	<var: #jumpFailClass type: #'AbstractInstruction *'>
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpFailCheck type: #'AbstractInstruction *'>
  	<var: #doOp type: #'AbstractInstruction *'>
- 	self MoveR: Arg0Reg R: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
  	self MoveR: Arg0Reg R: ClassReg.
+ 	jumpImmediate := objectRepresentation genJumpImmediate: Arg0Reg.
- 	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
  	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
  	jumpFailClass := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
  	doOp := self Label.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck := self perform: preOpCheckOrNil with: DPFPReg0 with: DPFPReg1].
  	self gen: arithmeticOperator operand: DPFPReg1 operand: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  						genAllocFloatValue: DPFPReg0
  						into: SendNumArgsReg
  						scratchReg: ClassReg
  						scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self RetN: 0.
  	"We need to push the register args on two paths; this one and the interpreter primitive path.
  	But the interpreter primitive path won't unless regArgsHaveBeenPushed is false."
  	self assert: methodOrBlockNumArgs <= self numRegArgs.
  	jumpFailClass jmpTarget: self Label.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck jmpTarget: jumpFailClass getJmpTarget].
  	backEnd genPushRegisterArgsForNumArgs: methodOrBlockNumArgs scratchReg: SendNumArgsReg.
  	jumpFailClass := self Jump: 0.
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
+ 		[jumpNonInt := objectRepresentation genJumpNotSmallInteger: Arg0Reg].
- 		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ClassReg.
  	self ConvertR: ClassReg Rd: DPFPReg1.
  	self Jump: doOp.
  	jumpFailAlloc jmpTarget: self Label.
  	self compileFallbackToInterpreterPrimitive.
  	jumpFailClass jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: jumpFailClass getJmpTarget].
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genDoubleComparison:invert: (in category 'primitive generators') -----
  genDoubleComparison: jumpOpcodeGenerator invert: invertComparison
  	"Receiver and arg in registers.
  	 Stack looks like
  		return address"
  	<var: #jumpOpcodeGenerator declareC: 'AbstractInstruction *(*jumpOpcodeGenerator)(void *)'>
  	| jumpFail jumpImmediate jumpNonInt jumpCond compare |
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpCond type: #'AbstractInstruction *'>
  	<var: #compare type: #'AbstractInstruction *'>
  	<var: #jumpFail type: #'AbstractInstruction *'>
- 	self MoveR: Arg0Reg R: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
+ 	jumpImmediate := objectRepresentation genJumpImmediate: Arg0Reg.
- 	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
  	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
  	jumpFail := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
  	invertComparison "May need to invert for NaNs"
  		ifTrue: [compare := self CmpRd: DPFPReg0 Rd: DPFPReg1]
  		ifFalse: [compare := self CmpRd: DPFPReg1 Rd: DPFPReg0].
  	jumpCond := self perform: jumpOpcodeGenerator with: 0. "FP jumps are a little weird"
  	self genMoveFalseR: ReceiverResultReg.
  	self RetN: 0.
  	jumpCond jmpTarget: (self genMoveTrueR: ReceiverResultReg).
  	self RetN: 0.
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
+ 		[jumpNonInt := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg].
- 		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  	self ConvertR: Arg0Reg Rd: DPFPReg1.
  	self Jump: compare.
  	jumpFail jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: jumpFail getJmpTarget].
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveAdd (in category 'primitive generators') -----
  genPrimitiveAdd
  	| jumpNotSI jumpOvfl |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
- 	self MoveR: Arg0Reg R: TempReg.
  	self MoveR: Arg0Reg R: ClassReg.
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ClassReg.
  	self AddR: ReceiverResultReg R: ClassReg.
  	jumpOvfl := self JumpOverflow: 0.
  	self MoveR: ClassReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveBitAnd (in category 'primitive generators') -----
  genPrimitiveBitAnd
  	| jumpNotSI |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	self MoveR: Arg0Reg R: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"Whether the SmallInteger tags are zero or non-zero, oring them together will preserve them."
  	self AndR: Arg0Reg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpNotSI jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveBitOr (in category 'primitive generators') -----
  genPrimitiveBitOr
  	| jumpNotSI |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	self MoveR: Arg0Reg R: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"Whether the SmallInteger tags are zero or non-zero, oring them together will preserve them."
  	self OrR: Arg0Reg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpNotSI jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveBitShift (in category 'primitive generators') -----
  genPrimitiveBitShift
  	"Receiver and arg in registers.
  	 Stack looks like
  		return address
  
  	rTemp := rArg0
  	rClass := tTemp
  	rTemp := rTemp & 1
  	jz nonInt
  	rClass >>= 1
  	cmp 0,rClass
  	jge neg
  	cmp 31,rClass // numSmallIntegerBits, jge for sign
  	jge tooBig
  	rTemp := rReceiver
  	rTemp <<= rClass
  	rTemp >>= rClass (arithmetic)
  	cmp rTemp,rReceiver
  	jnz ovfl
  	rReceiver := rReceiver - 1
  	rReceiver := rReceiver <<= rClass
  	rReceiver := rReceiver + 1
  	ret
  neg:
  	rClass := 0 - rClass
  	cmp 31,rClass
  	jge inRange
  	rClass := 31
  inRange
  	rReceiver := rReceiver >>= rClass.
  	rReceiver := rReceiver | 1.
  	ret
  ovfl
  tooBig
  nonInt:
  	fail"
  	| jumpNotSI jumpOvfl jumpNegative jumpTooBig jumpInRange |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
  	<var: #jumpNegative type: #'AbstractInstruction *'>
  	<var: #jumpTooBig type: #'AbstractInstruction *'>
  	<var: #jumpInRange type: #'AbstractInstruction *'>
  	self assert: self numRegArgs >= 1.
- 	self MoveR: Arg0Reg R: TempReg.
  	self MoveR: Arg0Reg R: ClassReg.
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ClassReg.
  	(self lastOpcode setsConditionCodesFor: JumpNegative) ifFalse:
  		[self CmpCq: 0 R: ClassReg]. "N.B. FLAGS := ClassReg - 0"
  	jumpNegative := self JumpNegative: 0.
  	self CmpCq: objectRepresentation numSmallIntegerBits R: ClassReg. "N.B. FLAGS := ClassReg - 31"
  	jumpTooBig := self JumpGreaterOrEqual: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	self LogicalShiftLeftR: ClassReg R: TempReg.
  	self ArithmeticShiftRightR: ClassReg R: TempReg.
  	self CmpR: TempReg R: ReceiverResultReg. "N.B. FLAGS := RRReg - TempReg"
  	jumpOvfl := self JumpNonZero: 0.
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ReceiverResultReg.
  	self LogicalShiftLeftR: ClassReg R: ReceiverResultReg.
  	objectRepresentation genAddSmallIntegerTagsTo: ReceiverResultReg.
  	self RetN: 0.
  	jumpNegative jmpTarget: (self NegateR: ClassReg).
  	self CmpCq: objectRepresentation numSmallIntegerBits R: ClassReg. "N.B. FLAGS := ClassReg - 31"
  	jumpInRange := self JumpLessOrEqual: 0.
  	self MoveCq: objectRepresentation numSmallIntegerBits R: ClassReg.
  	jumpInRange jmpTarget: (self ArithmeticShiftRightR: ClassReg R: ReceiverResultReg).
  	objectRepresentation genSetSmallIntegerTagsIn: ReceiverResultReg.
  	self RetN: 0.
  	jumpNotSI jmpTarget: (jumpTooBig jmpTarget: (jumpOvfl jmpTarget: self Label)).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveBitXor (in category 'primitive generators') -----
  genPrimitiveBitXor
  	| jumpNotSI |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	self MoveR: Arg0Reg R: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"Clear one or the other tag so that xoring will preserve them."
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: Arg0Reg.
  	self XorR: Arg0Reg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpNotSI jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveDiv (in category 'primitive generators') -----
  genPrimitiveDiv
  	| jumpNotSI jumpZero jumpExact jumpSameSign convert |
  	<var: #convert type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpExact type: #'AbstractInstruction *'>
  	<var: #jumpSameSign type: #'AbstractInstruction *'>
- 	self MoveR: Arg0Reg R: TempReg.
  	self MoveR: Arg0Reg R: ClassReg.
  	self MoveR: Arg0Reg R: Arg1Reg.
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"We must shift away the tags, not just subtract them, so that the
  	 overflow case doesn't actually overflow the machine instruction."
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: ClassReg].
  	jumpZero := self JumpZero: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
  	"If remainder is zero we must check for overflow."
  	self CmpCq: 0 R: ClassReg.
  	jumpExact := self JumpZero: 0.
  	"If arg and remainder signs are different we must round down."
  	self XorR: ClassReg R: Arg1Reg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: Arg1Reg].
  	jumpSameSign := self JumpGreaterOrEqual: 0.
  	self SubCq: 1 R: TempReg.
  	jumpSameSign jmpTarget: (convert := self Label).
  	objectRepresentation genConvertIntegerToSmallIntegerInReg: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
  	"test for overflow; the only case is SmallInteger minVal // -1"
  	jumpExact jmpTarget:
  		(self CmpCq: (1 << (objectRepresentation numSmallIntegerBits - 1)) R: TempReg).
  	self JumpLess: convert.
  	jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveDivide (in category 'primitive generators') -----
  genPrimitiveDivide
  	| jumpNotSI jumpZero jumpInexact jumpOverflow |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
  	<var: #jumpInexact type: #'AbstractInstruction *'>
  	<var: #jumpOverflow type: #'AbstractInstruction *'>
- 	self MoveR: Arg0Reg R: TempReg.
  	self MoveR: Arg0Reg R: ClassReg.
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"We must shift away the tags, not just subtract them, so that the
  	 overflow case doesn't actually overflow the machine instruction."
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	jumpZero := self JumpZero: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
  	"If remainder is non-zero fail."
  	self CmpCq: 0 R: ClassReg.
  	jumpInexact := self JumpNonZero: 0.
  	"test for overflow; the only case is SmallInteger minVal / -1"
  	self CmpCq: (1 << (objectRepresentation numSmallIntegerBits - 1)) R: TempReg.
  	jumpOverflow := self JumpGreaterOrEqual: 0.
  	objectRepresentation genConvertIntegerToSmallIntegerInReg: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpOverflow jmpTarget: (jumpInexact jmpTarget: (jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label))).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveMod (in category 'primitive generators') -----
  genPrimitiveMod
  	| jumpNotSI jumpZero jumpExact jumpSameSign |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
  	<var: #jumpExact type: #'AbstractInstruction *'>
  	<var: #jumpSameSign type: #'AbstractInstruction *'>
- 	self MoveR: Arg0Reg R: TempReg.
  	self MoveR: Arg0Reg R: ClassReg.
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ClassReg.
  	jumpZero := self JumpZero: 0.
  	self MoveR: ClassReg R: Arg1Reg.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
  	"If remainder is zero we're done."
  	self CmpCq: 0 R: ClassReg.
  	jumpExact := self JumpZero: 0.
  	"If arg and remainder signs are different we must reflect around zero."
  	self XorR: ClassReg R: Arg1Reg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: Arg1Reg].
  	jumpSameSign := self JumpGreaterOrEqual: 0.
  	self XorR: ClassReg R: Arg1Reg.
  	self AddR: Arg1Reg R: ClassReg.
  	jumpSameSign jmpTarget: (jumpExact jmpTarget: self Label).
  	objectRepresentation genSetSmallIntegerTagsIn: ClassReg.
  	self MoveR: ClassReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveMultiply (in category 'primitive generators') -----
  genPrimitiveMultiply
  	| jumpNotSI jumpOvfl |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
- 	self MoveR: Arg0Reg R: TempReg.
  	self MoveR: Arg0Reg R: ClassReg.
  	self MoveR: ReceiverResultReg R: Arg1Reg.
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg..
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: Arg1Reg.
  	self MulR: Arg1Reg R: ClassReg.
  	jumpOvfl := self JumpOverflow: 0.
  	objectRepresentation genSetSmallIntegerTagsIn: ClassReg.
  	self MoveR: ClassReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveQuo (in category 'primitive generators') -----
  genPrimitiveQuo
  	| jumpNotSI jumpZero jumpOverflow |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
  	<var: #jumpOverflow type: #'AbstractInstruction *'>
- 	self MoveR: Arg0Reg R: TempReg.
  	self MoveR: Arg0Reg R: ClassReg.
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"We must shift away the tags, not just subtract them, so that the
  	 overflow case doesn't actually overflow the machine instruction."
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: ClassReg].
  	jumpZero := self JumpZero: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
  	"test for overflow; the only case is SmallInteger minVal quo: -1"
  	self CmpCq: (1 << (objectRepresentation numSmallIntegerBits - 1)) R: TempReg.
  	jumpOverflow := self JumpGreaterOrEqual: 0.
  	objectRepresentation genConvertIntegerToSmallIntegerInReg: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpOverflow jmpTarget: (jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label)).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveSubtract (in category 'primitive generators') -----
  genPrimitiveSubtract
  	| jumpNotSI jumpOvfl |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
+ 	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	self MoveR: Arg0Reg R: TempReg.
- 	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self MoveR: ReceiverResultReg R: TempReg.
  	self SubR: Arg0Reg R: TempReg.
  	jumpOvfl := self JumpOverflow: 0.
  	objectRepresentation genAddSmallIntegerTagsTo: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSmallIntegerComparison: (in category 'primitive generators') -----
  genSmallIntegerComparison: jumpOpcode
  	| jumpFail jumpTrue |
  	<var: #jumpFail type: #'AbstractInstruction *'>
  	<var: #jumpTrue type: #'AbstractInstruction *'>
+ 	jumpFail := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	self MoveR: Arg0Reg R: TempReg.
- 	jumpFail := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self CmpR: Arg0Reg R: ReceiverResultReg. "N.B. FLAGS := RRReg - Arg0Reg"
  	jumpTrue := self gen: jumpOpcode.
  	self genMoveFalseR: ReceiverResultReg.
  	self RetN: 0.
  	jumpTrue jmpTarget: (self genMoveTrueR: ReceiverResultReg).
  	self RetN: 0.
  	jumpFail jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSmallIntegerComparison:orDoubleComparison: (in category 'primitive generators') -----
  genSmallIntegerComparison: jumpOpcode orDoubleComparison: jumpFPOpcodeGenerator
  	"Stack looks like
  		return address"
  	| jumpDouble jumpNonInt jumpFail jumpTrue jumpCond |
  	<var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction *(*jumpFPOpcodeGenerator)(void *)'>
  	<var: #jumpDouble type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpCond type: #'AbstractInstruction *'>
  	<var: #jumpTrue type: #'AbstractInstruction *'>
  	<var: #jumpFail type: #'AbstractInstruction *'>
  	backEnd hasDoublePrecisionFloatingPointSupport ifFalse:
  		[^self genSmallIntegerComparison: jumpOpcode].
+ 	jumpDouble := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- 	self MoveR: Arg0Reg R: TempReg.
- 	jumpDouble := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self CmpR: Arg0Reg R: ReceiverResultReg. "N.B. FLAGS := RRReg - Arg0Reg"
  	jumpTrue := self gen: jumpOpcode.
  	self genMoveFalseR: ReceiverResultReg.
  	self RetN: 0.
  	jumpTrue jmpTarget: (self genMoveTrueR: ReceiverResultReg).
  	self RetN: 0.
  	
  	"Argument may be a Float : let us check or fail"
  	jumpDouble jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
+ 		[jumpNonInt := objectRepresentation genJumpImmediate: Arg0Reg].
- 		[self MoveR: ClassReg R: TempReg.
- 		 jumpNonInt := objectRepresentation genJumpImmediateInScratchReg: TempReg].
  	objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
  	objectRepresentation genCmpClassFloatCompactIndexR: SendNumArgsReg.
  	jumpFail := self JumpNonZero: 0.
  
  	"It was a Float, so convert the receiver to double and perform the operation"
  	objectRepresentation genConvertSmallIntegerToIntegerInReg: ReceiverResultReg.
  	self ConvertR: ReceiverResultReg Rd: DPFPReg0.
  	objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
  	self CmpRd: DPFPReg1 Rd: DPFPReg0.
  	jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP jumps are a little weird"
  	self genMoveFalseR: ReceiverResultReg.
  	self RetN: 0.
  	jumpCond jmpTarget: (self genMoveTrueR: ReceiverResultReg).
  	self RetN: 0.
  
  	objectRepresentation smallIntegerIsOnlyImmediateType
  		ifTrue: [jumpFail jmpTarget: self Label]
  		ifFalse: [jumpNonInt jmpTarget: (jumpFail jmpTarget: self Label)].
  	^0!



More information about the Vm-dev mailing list