VM Maker: VMMaker.oscog-eem.1574.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
3 messages Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog-eem.1574.mcz

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

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

Name: VMMaker.oscog-eem.1574
Author: eem
Time: 10 December 2015, 9:36:18.933 am
UUID: ce2daaa5-0130-4ed4-abdb-26b8b6c06c6e
Ancestors: VMMaker.oscog-eem.1573

Cogit:
Introduce the "abstract register" NoReg and use it everywhere we used nil before to indicate no register.  Rename selectors and temporaries of the form *registerOrNil*" to "*registerOrNone*".  Rewrite all uses of reg ifNil: to be reg = NoReg ifTrue:.


This is prior to the putsch to replace the use of -1 to -N for abstract registers, collapsing them down onto the same 0-N range used for concrete registers.

Ryan, Tim, Clément et al, perhaps you could review this carefully and check your own tests to ensure I've got this right.  At least the x64 and x86 Cogits look fine after this intermediate change.

BTW, I used this to identify potential methods to change:

self systemNavigation
        browseMessageList: (self systemNavigation allMethodsSelect: [:m| (m methodClass category beginsWith:  #'VMMaker-JIT') and: [(m literals includesAnyOf: #(isNil notNil ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil:)) and: [m methodNode tempNames anySatisfy: [:t| '*reg*' match: t]]]] localToPackage: #VMMaker)
        name: 'Uses of nil'
        autoSelect: 'Nil'

and message names with the pattern "*reg*ornil*" to find selectors.

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

Item was removed:
- ----- Method: CogAbstractInstruction>>availableRegisterOrNilFor: (in category 'register allocation') -----
- availableRegisterOrNilFor: liveRegsMask
- "Answer an unused abstract register in the liveRegMask.
- Subclasses with more registers can override to answer them."
- <returnTypeC: #sqInt>
- self flag: 'searching physical registers that are not assigned to abstract registers first will do a better job and allocate with fewer conflicts'.
- (cogit register: Arg1Reg isInMask: liveRegsMask) ifFalse:
- [^Arg1Reg].
- (cogit register: Arg0Reg isInMask: liveRegsMask) ifFalse:
- [^Arg0Reg].
- (cogit register: SendNumArgsReg isInMask: liveRegsMask) ifFalse:
- [^SendNumArgsReg].
- (cogit register: ClassReg isInMask: liveRegsMask) ifFalse:
- [^ClassReg].
- (cogit register: ReceiverResultReg isInMask: liveRegsMask) ifFalse:
- [^ReceiverResultReg].
- ^nil!

Item was added:
+ ----- Method: CogAbstractInstruction>>availableRegisterOrNoneFor: (in category 'register allocation') -----
+ availableRegisterOrNoneFor: liveRegsMask
+ "Answer an unused abstract register in the liveRegMask.
+ Subclasses with more registers can override to answer them."
+ <returnTypeC: #sqInt>
+ self flag: 'searching physical registers that are not assigned to abstract registers first will do a better job and allocate with fewer conflicts.  But this will be much easier if we use the same range for concrete and abstract registers (0-N) and simply number abstract registers the same as their corresponding concrete registers.'.
+ (cogit register: Arg1Reg isInMask: liveRegsMask) ifFalse:
+ [^Arg1Reg].
+ (cogit register: Arg0Reg isInMask: liveRegsMask) ifFalse:
+ [^Arg0Reg].
+ (cogit register: SendNumArgsReg isInMask: liveRegsMask) ifFalse:
+ [^SendNumArgsReg].
+ (cogit register: ClassReg isInMask: liveRegsMask) ifFalse:
+ [^ClassReg].
+ (cogit register: ReceiverResultReg isInMask: liveRegsMask) ifFalse:
+ [^ReceiverResultReg].
+ ^NoReg!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveRXbrR (in category 'generate machine code') -----
  concretizeMoveRXbrR
  "Will get inlined into concretizeAt: switch."
  <inline: true>
  | src index base swapreg mcIdx |
  src := self concreteRegister: (operands at: 0).
  index := self concreteRegister: (operands at: 1).
  base := self concreteRegister: (operands at: 2).
  mcIdx := 0.
+ swapreg := NoReg.
  src >= 4 ifTrue: "x86 allows movb %rl, mem only with %al, %bl, %cl, %dl, so swap with the first one that isn't used."
  [swapreg := src.
  index = EAX ifTrue: [index := swapreg].
  base = EAX ifTrue: [base := swapreg].
  src := EAX.
  mcIdx := 1.
  machineCode at: 0 put: 16r90 + swapreg].
  base ~= EBP ifTrue:
  [machineCode
  at: mcIdx + 0 put: 16r88;
  at: mcIdx + 1 put: (self mod: ModRegInd RM: 4 RO: src);
  at: mcIdx + 2 put: (self s: SIB1 i: index b: base).
+ swapreg ~= NoReg ifTrue:
- swapreg ifNotNil:
  [machineCode at: mcIdx + 3 put: 16r90 + swapreg].
  ^machineCodeSize := 3 + (2 * mcIdx)].
  machineCode
  at: mcIdx + 0 put: 16r88;
  at: mcIdx + 1 put: (self mod: ModRegRegDisp8 RM: 4 RO: src);
  at: mcIdx + 2 put: (self s: SIB1 i: index b: base);
  at: mcIdx + 3 put: 0.
+ swapreg ~= NoReg ifTrue:
- swapreg ifNotNil:
  [machineCode at: mcIdx + 4 put: 16r90 + swapreg].
  ^machineCodeSize := 4 + (2 * mcIdx)!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genGetNumBytesOf:into: (in category 'compile abstract instructions') -----
  genGetNumBytesOf: srcReg into: destReg
  "Get the size in byte-sized slots of the object in srcReg into destReg.
  srcReg may equal destReg.
  destReg <- numSlots << self shiftForWord - (fmt bitAnd: 3).
  Assumes the object in srcReg has a byte format, i.e. 16 to 23 or 24 to 31 "
  <var: #jmp type: #'AbstractInstruction *'>
  | jmp |
  self genGetRawSlotSizeOfNonImm: srcReg into: destReg.
  cogit CmpCq: objectMemory numSlotsMask R: destReg.
  jmp := cogit JumpLess: 0.
  self genGetOverflowSlotsOf: srcReg into: destReg.
  jmp jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: destReg).
+ self genGetBits: 3 ofFormatByteOf: srcReg into: TempReg.
- self genGetBits: 3 ofFormatByteOf: srcReg into: TempReg baseHeaderIntoScratch: nil.
  "Now: fmt bitAnd: 3 in TempReg"
  cogit SubR: TempReg R: destReg.
  ^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 jumpNegative jumpShortsUnsupported jumpNotPointers
   |
  <inline: true>
  "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  <var: #jumpIsBytes type: #'AbstractInstruction *'>
  <var: #jumpNegative 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.
  self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
 
  "formatReg := self formatOf: ReceiverResultReg"
  self genGetFormatOf: ReceiverResultReg
  into: (formatReg := SendNumArgsReg)
+ leastSignificantHalfOfBaseHeaderIntoScratch: NoReg.
- 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 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 lastOpcode setsConditionCodesFor: JumpNegative) ifFalse:
  [self CmpCq: 0 R: ClassReg]. "N.B. FLAGS := ClassReg - 0"
  jumpNegative := cogit JumpNegative: 0.
  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:
  (jumpNegative 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.
 
  "Is the class arg pointers with at least 3 fields?"
  self genGetFormatOf: Arg0Reg
  into: TempReg
+ leastSignificantHalfOfBaseHeaderIntoScratch: NoReg.
- 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.
  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.
 
  "Is the class arg pointers with at least 3 fields?"
  jumpImmediate := self genJumpImmediate: Arg0Reg.
 
  self genGetFormatOf: Arg0Reg
  into: TempReg
+ leastSignificantHalfOfBaseHeaderIntoScratch: NoReg.
- 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: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveStringAtPut: (in category 'primitive generators') -----
  genInnerPrimitiveStringAtPut: retNoffset
  "Implement the guts of primitiveStringAtPut"
  | formatReg jumpBadIndex jumpBadArg jumpWordsDone jumpBytesOutOfRange
   jumpIsBytes jumpNotString jumpIsCompiledMethod
   jumpBytesOutOfBounds jumpWordsOutOfBounds jumpShortsUnsupported |
  <inline: true>
  "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  <var: #jumpBadArg type: #'AbstractInstruction *'>
  <var: #jumpIsBytes type: #'AbstractInstruction *'>
  <var: #jumpBadIndex type: #'AbstractInstruction *'>
  <var: #jumpWordsDone type: #'AbstractInstruction *'>
  <var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  <var: #jumpShortsUnsupported type: #'AbstractInstruction *'>
  <var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
 
  jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg.
  cogit MoveR: Arg1Reg R: TempReg.
  jumpBadArg := self genJumpNotCharacterInScratchReg: TempReg.
  self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
 
  "formatReg := self formatOf: ReceiverResultReg"
  self genGetFormatOf: ReceiverResultReg
  into: (formatReg := SendNumArgsReg)
+ leastSignificantHalfOfBaseHeaderIntoScratch: NoReg.
- leastSignificantHalfOfBaseHeaderIntoScratch: nil.
 
  self genGetNumSlotsOf: ReceiverResultReg into: ClassReg.
 
  "dispatch on format; words and/or bytes.
   0 to 8 = pointer objects, forwarders, reserved.
   9 (?) 64-bit indexable
  10 - 11 32-bit indexable
  12 - 15 16-bit indexable (but unused)
  16 - 23 byte indexable
  24 - 31 compiled method"
  cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  jumpNotString := cogit JumpBelowOrEqual: 0.
  cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
  jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
  cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  jumpIsBytes := cogit JumpGreaterOrEqual: 0.
  cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  jumpShortsUnsupported := cogit JumpGreaterOrEqual: 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.
  jumpWordsDone := cogit Jump: 0.
 
  "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."
 
  jumpIsBytes jmpTarget:
  (cogit CmpCq: (objectMemory characterObjectOf: 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 genConvertCharacterToCodeInReg: TempReg.
  cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
  cogit MoveR: TempReg Xbr: Arg0Reg R: ReceiverResultReg.
  cogit MoveR: Arg1Reg R: ReceiverResultReg.
 
  jumpWordsDone jmpTarget:
  (cogit RetN: retNoffset).
 
  jumpBadArg jmpTarget:
  (jumpNotString jmpTarget:
  (jumpBytesOutOfRange jmpTarget:
  (jumpIsCompiledMethod jmpTarget:
  (jumpBytesOutOfBounds jmpTarget:
  (jumpShortsUnsupported jmpTarget:
  (jumpWordsOutOfBounds jmpTarget: cogit Label)))))).
 
  cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
  self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
 
  jumpBadIndex jmpTarget: cogit Label.
 
  ^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genGetBits:ofFormatByteOf:into: (in category 'compile abstract instructions') -----
+ genGetBits: mask ofFormatByteOf: sourceReg into: destReg
+ self flag: #endianness.
+ cogit MoveMb: 3 r: sourceReg R: destReg.
+ cogit AndCq: mask R: destReg. "formatReg := self formatOfHeader: destReg"
+ ^0!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>genGetBits:ofFormatByteOf:into:baseHeaderIntoScratch: (in category 'compile abstract instructions') -----
- genGetBits: mask ofFormatByteOf: sourceReg into: destReg baseHeaderIntoScratch: scratchReg
- scratchReg
- ifNil:
- [self flag: #endianness.
- cogit MoveMb: 3 r: sourceReg R: destReg]
- ifNotNil:
- [cogit MoveMw: 0 r: sourceReg R: destReg.
- cogit MoveR: destReg R: scratchReg. "destReg := (at least) least significant half of self baseHeader: receiver"
- cogit LogicalShiftRightCq: objectMemory formatShift R: destReg].
- cogit AndCq: mask R: destReg. "formatReg := self formatOfHeader: destReg"
- ^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genGetFormatOf:into: (in category 'compile abstract instructions') -----
  genGetFormatOf: srcReg into: destReg
  "Get the format field of the object in srcReg into destReg.
  srcReg may equal destReg."
+ ^self genGetBits: objectMemory formatMask ofFormatByteOf: srcReg into: destReg!
- ^self genGetBits: objectMemory formatMask ofFormatByteOf: srcReg into: destReg baseHeaderIntoScratch: nil!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genGetFormatOf:into:leastSignificantHalfOfBaseHeaderIntoScratch: (in category 'compile abstract instructions') -----
+ genGetFormatOf: sourceReg into: destReg leastSignificantHalfOfBaseHeaderIntoScratch: scratchRegOrNone
+ "Get the format of the object in sourceReg into destReg.  If scratchRegOrNone
+ is not NoReg, load at least the least significant 32-bits (64-bits in 64-bits) of the
+ header word, which contains the format, into scratchRegOrNone."
+ scratchRegOrNone = NoReg
+ ifTrue:
- genGetFormatOf: sourceReg into: destReg leastSignificantHalfOfBaseHeaderIntoScratch: scratchRegOrNil
- "Get the format of the object in sourceReg into destReg.  If scratchRegOrNil
- is not nil, load at least the least significant 32-bits (64-bits in 64-bits) of the
- header word, which contains the format, into scratchRegOrNil."
- scratchRegOrNil
- ifNil:
  [self flag: #endianness.
  cogit MoveMb: 3 r: sourceReg R: destReg]
+ ifFalse:
- ifNotNil:
  [cogit MoveMw: 0 r: sourceReg R: destReg.
+ cogit MoveR: destReg R: scratchRegOrNone. "destReg := (at least) least significant half of self baseHeader: receiver"
- cogit MoveR: destReg R: scratchRegOrNil. "destReg := (at least) least significant half of self baseHeader: receiver"
  cogit LogicalShiftRightCq: objectMemory formatShift R: destReg].
  cogit AndCq: objectMemory formatMask R: destReg. "formatReg := self formatOfHeader: destReg"
  ^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genInnerPrimitiveStringAt: (in category 'primitive generators') -----
  genInnerPrimitiveStringAt: retNoffset
  "Implement the guts of primitiveStringAt; dispatch on size"
  | formatReg jumpNotIndexable jumpBadIndex done
   jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig
   jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds |
  <inline: true>
  "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  <var: #done type: #'AbstractInstruction *'>
  <var: #jumpIsBytes type: #'AbstractInstruction *'>
  <var: #jumpIsShorts type: #'AbstractInstruction *'>
  <var: #jumpIsWords type: #'AbstractInstruction *'>
  <var: #jumpBadIndex type: #'AbstractInstruction *'>
  <var: #jumpWordTooBig type: #'AbstractInstruction *'>
  <var: #jumpNotIndexable type: #'AbstractInstruction *'>
  <var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
  <var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
  <var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
 
  cogit MoveR: Arg0Reg R: Arg1Reg.
  jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratch: TempReg.
  self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
  cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
 
  self genGetFormatOf: ReceiverResultReg
  into: (formatReg := SendNumArgsReg)
+ leastSignificantHalfOfBaseHeaderIntoScratch: NoReg.
- 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 firstByteFormat R: formatReg.
  jumpIsBytes := cogit JumpGreaterOrEqual: 0.
  cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  jumpIsShorts := cogit JumpGreaterOrEqual: 0.
  cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  jumpIsWords := cogit JumpGreaterOrEqual: 0.
  jumpNotIndexable := cogit Jump: 0.
 
  jumpIsBytes jmpTarget:
  (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
  cogit AndCq: objectMemory wordSize - 1 R: formatReg.
  cogit SubR: formatReg R: ClassReg;
  CmpR: Arg1Reg R: ClassReg.
  jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
  cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg.
  cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
  cogit backEnd byteReadsZeroExtend ifFalse:
  [cogit AndCq: 255 R: ReceiverResultReg].
  done := cogit Label.
  self genConvertIntegerToCharacterInReg: ReceiverResultReg.
  cogit RetN: retNoffset.
 
  jumpIsShorts jmpTarget:
  (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
  cogit AndCq: 1 R: formatReg.
  cogit SubR: formatReg R: ClassReg;
  CmpR: Arg1Reg R: ClassReg.
  jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  cogit AddR: Arg1Reg R: ReceiverResultReg.
  cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
  cogit Jump: done.
 
  jumpIsWords jmpTarget:
  (cogit CmpR: Arg1Reg R: ClassReg).
  jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
  cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
  cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: TempReg.
  cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
  jumpWordTooBig := self jumpNotCharacterUnsignedValueInRegister: TempReg.
  cogit MoveR: TempReg R: ReceiverResultReg.
  cogit Jump: done.
 
  jumpBytesOutOfBounds jmpTarget:
  (jumpShortsOutOfBounds jmpTarget:
  (jumpWordsOutOfBounds jmpTarget:
  (jumpWordTooBig jmpTarget:
  (jumpNotIndexable jmpTarget:
  (jumpBadIndex jmpTarget: cogit Label))))).
 
  ^0!

Item was changed:
  SharedPool subclass: #CogRTLOpcodes
  instanceVariableNames: ''
+ classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AlignmentNops AndCqR AndCqRR AndCwR AndRR Arg0Reg Arg1Reg ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull ClassReg CmpC32R CmpCqR CmpCwR CmpRR CmpRdRd ConvertRRd DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16 Fill32 Fill8 FillBytesFrom FillFromWord FirstJump FirstShortJump Jump JumpAbove JumpAboveOrEqual JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual JumpFPGreater JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual JumpFPNotEqual JumpFPOrdered JumpFPUnordered JumpFull JumpGreater JumpGreaterOrEqual JumpLess JumpLessOrEqual JumpLong JumpLongNonZero JumpLongZero JumpNegative JumpNoCarry JumpNoOverflow JumpNonNegative JumpNonZero JumpOverflow JumpR JumpZero Label LastJump LastRTLCode LinkReg Literal LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightRR MoveAbR MoveAwR MoveC32R MoveC64R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM64rRd MoveMbrR MoveMwrR MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRMbr MoveRMwr MoveRR MoveRRd MoveRX16rR MoveRX32rR MoveRXbrR MoveRXowr MoveRXwrR MoveRdM64r MoveRdR MoveRdRd MoveX16rRR MoveX32rRR MoveXbrRR MoveXowrR MoveXwrRR MulRdRd NegateR NoReg Nop OrCqR OrCwR OrRR PCReg PopR PrefetchAw PushCq PushCw PushR RISCTempReg ReceiverResultReg RetN RotateLeftCqR RotateRightCqR SPReg Scratch0Reg Scratch1Reg Scratch2Reg Scratch3Reg Scratch4Reg Scratch5Reg Scratch6Reg Scratch7Reg SendNumArgsReg SqrtRd Stop SubCqR SubCwR SubRR SubRdRd TempReg TstCqR VarBaseReg XorCqR XorCwR XorRR'
- classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AlignmentNops AndCqR AndCqRR AndCwR AndRR Arg0Reg Arg1Reg ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull ClassReg CmpC32R CmpCqR CmpCwR CmpRR CmpRdRd ConvertRRd DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16 Fill32 Fill8 FillBytesFrom FillFromWord FirstJump FirstShortJump Jump JumpAbove JumpAboveOrEqual JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual JumpFPGreater JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual JumpFPNotEqual JumpFPOrdered JumpFPUnordered JumpFull JumpGreater JumpGreaterOrEqual JumpLess JumpLessOrEqual JumpLong JumpLongNonZero JumpLongZero JumpNegative JumpNoCarry JumpNoOverflow JumpNonNegative JumpNonZero JumpOverflow JumpR JumpZero Label LastJump LastRTLCode LinkReg Literal LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightRR MoveAbR MoveAwR MoveC32R MoveC64R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM64rRd MoveMbrR MoveMwrR MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRMbr MoveRMwr MoveRR MoveRRd MoveRX16rR MoveRX32rR MoveRXbrR MoveRXowr MoveRXwrR MoveRdM64r MoveRdR MoveRdRd MoveX16rRR MoveX32rRR MoveXbrRR MoveXowrR MoveXwrRR MulRdRd NegateR Nop OrCqR OrCwR OrRR PCReg PopR PrefetchAw PushCq PushCw PushR RISCTempReg ReceiverResultReg RetN RotateLeftCqR RotateRightCqR SPReg Scratch0Reg Scratch1Reg Scratch2Reg Scratch3Reg Scratch4Reg Scratch5Reg Scratch6Reg Scratch7Reg SendNumArgsReg SqrtRd Stop SubCqR SubCwR SubRR SubRdRd TempReg TstCqR VarBaseReg XorCqR XorCwR XorRR'
  poolDictionaries: ''
  category: 'VMMaker-JIT'!
 
  !CogRTLOpcodes commentStamp: '<historical>' prior: 0!
  I am a pool for the Register-Transfer-Language to which Cog compiles.  I define unique integer values for all RTL opcodes and abstract registers.  See CogAbstractInstruction for instances of instructions with the opcodes that I define.!

Item was changed:
  ----- Method: CogRTLOpcodes class>>initialize (in category 'class initialization') -----
(excessive size, no diff calculated)

Item was removed:
- ----- Method: CogSimStackEntry>>registerOrNil (in category 'accessing') -----
- registerOrNil
- ^type = SSRegister ifTrue: [register]!

Item was added:
+ ----- Method: CogSimStackEntry>>registerOrNone (in category 'accessing') -----
+ registerOrNone
+ ^type = SSRegister ifTrue: [register] ifFalse: [NoReg]!

Item was changed:
  ----- Method: Cogit>>compileCallFor:numArgs:arg:arg:arg:arg:resultReg:saveRegs: (in category 'initialization') -----
+ compileCallFor: aRoutine numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 resultReg: resultRegOrNone saveRegs: saveRegs
+ "Generate a call to aRoutine with up to 4 arguments.  If resultRegOrNone is not
+ NoReg assign the C result to resultRegOrNone.  If saveRegs, save all registers.
- compileCallFor: aRoutine numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 resultReg: resultRegOrNil saveRegs: saveRegs
- "Generate a call to aRoutine with up to 4 arguments.  If resultRegOrNil is
- non-zero assign the C result to resultRegOrNil.  If saveRegs, save all registers.
  Hack: a negative arg value indicates an abstract register, a non-negative value
  indicates a constant."
  <var: #aRoutine type: #'void *'>
  <inline: false>
  cStackAlignment > objectMemory wordSize ifTrue:
  [backEnd
  genAlignCStackSavingRegisters: saveRegs
  numArgs: numArgs
  wordAlignment: cStackAlignment / objectMemory wordSize].
  saveRegs ifTrue:
  [backEnd genSaveRegisters].
  backEnd genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3.
  self CallFullRT: (self cCode: [aRoutine asUnsignedInteger]
    inSmalltalk: [self simulatedTrampolineFor: aRoutine]).
+ resultRegOrNone ~= NoReg ifTrue:
+ [backEnd genWriteCResultIntoReg: resultRegOrNone].
- resultRegOrNil ifNotNil:
- [backEnd genWriteCResultIntoReg: resultRegOrNil].
  saveRegs ifTrue:
  [numArgs > 0 ifTrue:
  [backEnd genRemoveNArgsFromStack: numArgs].
+ resultRegOrNone ~= NoReg
+ ifTrue: [backEnd genRestoreRegsExcept: resultRegOrNone]
+ ifFalse: [backEnd genRestoreRegs]]!
- resultRegOrNil
- ifNotNil: [backEnd genRestoreRegsExcept: resultRegOrNil]
- ifNil: [backEnd genRestoreRegs]]!

Item was changed:
  ----- Method: Cogit>>compileTrampolineFor:numArgs:arg:arg:arg:arg:saveRegs:pushLinkReg:resultReg: (in category 'initialization') -----
+ compileTrampolineFor: aRoutine numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 saveRegs: saveRegs pushLinkReg: pushLinkReg resultReg: resultRegOrNone
- compileTrampolineFor: aRoutine numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 saveRegs: saveRegs pushLinkReg: pushLinkReg resultReg: resultRegOrNil
  "Generate a trampoline with up to four arguments.  Generate either a call or a jump to aRoutine
+ as requested by callJumpBar.  If generating a call and resultRegOrNone is not NoReg pass the C
+ result back in resultRegOrNone.
- as requested by callJumpBar.  If generating a call and resultRegOrNil is non-zero pass the C result
- back in resultRegOrNil.
  Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
  <var: #aRoutine type: #'void *'>
  <inline: false>
  self genSmalltalkToCStackSwitch: pushLinkReg.
  self
  compileCallFor: aRoutine
  numArgs: numArgs
  arg: regOrConst0
  arg: regOrConst1
  arg: regOrConst2
  arg: regOrConst3
+ resultReg: resultRegOrNone
- resultReg: resultRegOrNil
  saveRegs: saveRegs.
  backEnd genLoadStackPointers.
  (pushLinkReg and: [backEnd hasLinkRegister])
+ ifTrue:
+ [backEnd hasPCRegister
- ifTrue: [
- backEnd hasPCRegister
  ifTrue: [self PopR: PCReg]
  ifFalse: [self PopR: LinkReg.
  self RetN: 0]]
  ifFalse: [self RetN: 0]!

Item was changed:
  ----- Method: Cogit>>genEnilopmartFor:and:and:forCall:called: (in category 'initialization') -----
+ genEnilopmartFor: regArg1 and: regArg2OrNone and: regArg3OrNone forCall: forCall called: trampolineName
- genEnilopmartFor: regArg1 and: regArg2 and: regArg3 forCall: forCall called: trampolineName
  "An enilopmart (the reverse of a trampoline) is a piece of code that makes
  the system-call-like transition from the C runtime into generated machine
  code.  The desired arguments and entry-point are pushed on a stackPage's
  stack.  The enilopmart pops off the values to be loaded into registers and
  then executes a return instruction to pop off the entry-point and jump to it.
 
  BEFORE AFTER (stacks grow down)
  whatever stackPointer -> whatever
  target address => reg1 = reg1val, etc
  reg1val pc = target address
  reg2val
  stackPointer -> reg3val"
 
  <var: #trampolineName type: #'char *'>
  <returnTypeC: #'void (*genEnilopmartForandandforCallcalled(sqInt regArg1, sqInt regArg2, sqInt regArg3, sqInt forCall, char *trampolineName))(void)'>
 
  | size endAddress enilopmart |
  self zeroOpcodeIndex.
  backEnd maybeEstablishVarBase. "Must happen first; value may be used in genLoadStackPointers"
  backEnd genLoadStackPointers.
+ regArg3OrNone ~= NoReg ifTrue: [self PopR: regArg3OrNone].
+ regArg2OrNone ~= NoReg ifTrue: [self PopR: regArg2OrNone].
- regArg3 ifNotNil: [self PopR: regArg3].
- regArg2 ifNotNil: [self PopR: regArg2].
  self PopR: regArg1.
  self genEnilopmartReturn: forCall.
  self computeMaximumSizes.
  size := self generateInstructionsAt: methodZoneBase.
  endAddress := self outputInstructionsAt: methodZoneBase.
  self assert: methodZoneBase + size = endAddress.
  enilopmart := methodZoneBase.
  methodZoneBase := self alignUptoRoutineBoundary: endAddress.
  backEnd stopsFrom: endAddress to: methodZoneBase - 1.
  self recordGeneratedRunTime: trampolineName address: enilopmart.
  ^self cCoerceSimple: enilopmart to: #'void (*)(void)'!

Item was changed:
  ----- Method: Cogit>>genEnilopmartFor:and:forCall:called: (in category 'initialization') -----
  genEnilopmartFor: regArg1 and: regArg2 forCall: forCall called: trampolineName
  <inline: true>
+ ^self genEnilopmartFor: regArg1 and: regArg2 and: NoReg forCall: forCall called: trampolineName!
- ^self genEnilopmartFor: regArg1 and: regArg2 and: nil forCall: forCall called: trampolineName!

Item was changed:
  ----- Method: Cogit>>genEnilopmartFor:forCall:called: (in category 'initialization') -----
  genEnilopmartFor: regArg1 forCall: forCall called: trampolineName
  <inline: true>
+ ^self genEnilopmartFor: regArg1 and: NoReg and: NoReg forCall: forCall called: trampolineName!
- ^self genEnilopmartFor: regArg1 and: nil and: nil forCall: forCall called: trampolineName!

Item was changed:
  ----- Method: Cogit>>genInnerPICAbortTrampoline: (in category 'initialization') -----
  genInnerPICAbortTrampoline: name
  "Generate the abort for a PIC.  This abort performs either a call of
  ceInterpretMethodFromPIC:receiver: to handle invoking an uncogged target
  or a call of ceMNUFromPICMNUMethod:receiver: to handle an MNU dispatch
  in a closed PIC.  It distinguishes the two by testing ClassReg.  If the register
  is zero then this is an MNU.
 
  This poses a problem in 32-bit Spur, where zero is the cache tag for immediate
  characters (tag pattern 2r10) because SmallIntegers have tag patterns 2r11
  and 2r01, so anding with 1 reduces these to 0 & 1.  We solve the ambiguity by
  patching send sites with a 0 cache tag to open PICs instead of closed PICs."
  <var: #name type: #'char *'>
  | jumpMNUCase |
  <var: #jumpMNUCase type: #'AbstractInstruction *'>
  self CmpCq: self picAbortDiscriminatorValue R: ClassReg.
  jumpMNUCase := self JumpZero: 0.
  self compileTrampolineFor: #ceInterpretMethodFromPIC:receiver:
  numArgs: 2
  arg: SendNumArgsReg
  arg: ReceiverResultReg
  arg: nil
  arg: nil
  saveRegs: false
  pushLinkReg: false
+ resultReg: NoReg.
- resultReg: nil.
  jumpMNUCase jmpTarget: self Label.
  ^self genTrampolineFor: #ceMNUFromPICMNUMethod:receiver:
  called: name
  numArgs: 2
  arg: SendNumArgsReg
  arg: ReceiverResultReg
  arg: nil
  arg: nil
  saveRegs: false
  pushLinkReg: false
+ resultReg: NoReg
- resultReg: nil
  appendOpcodes: true!

Item was changed:
  ----- Method: Cogit>>genMethodAbortTrampoline (in category 'initialization') -----
  genMethodAbortTrampoline
  "Generate the abort for a method.  This abort performs either a call of ceSICMiss:
  to handle a single-in-line cache miss or a call of ceStackOverflow: to handle a
  stack overflow.  It distinguishes the two by testing ResultReceiverReg.  If the
  register is zero then this is a stack-overflow because a) the receiver has already
  been pushed and so can be set to zero before calling the abort, and b) the
  receiver must always contain an object (and hence be non-zero) on SIC miss."
  | jumpSICMiss |
  <var: #jumpSICMiss type: #'AbstractInstruction *'>
  self zeroOpcodeIndex.
  self CmpCq: 0 R: ReceiverResultReg.
  jumpSICMiss := self JumpNonZero: 0.
 
  "The abort sequencer has pushed the LinkReg a second time.
  Overwrite it with the right one."
  backEnd hasLinkRegister ifTrue:
  [self MoveR: LinkReg Mw: 0 r: SPReg].
  self compileTrampolineFor: #ceStackOverflow:
  numArgs: 1
  arg: SendNumArgsReg
  arg: nil
  arg: nil
  arg: nil
  saveRegs: false
  pushLinkReg: false "The LinkReg has already been set above."
+ resultReg: NoReg.
- resultReg: nil.
  jumpSICMiss jmpTarget: self Label.
  ^self genTrampolineFor: #ceSICMiss:
  called: 'ceMethodAbort'
  numArgs: 1
  arg: ReceiverResultReg
  arg: nil
  arg: nil
  arg: nil
  saveRegs: false
  pushLinkReg: true "Push the LinkReg for the ceMethodAbort call."
+ resultReg: NoReg
- resultReg: nil
  appendOpcodes: true!

Item was changed:
  ----- Method: Cogit>>genTrampolineFor:called:numArgs:arg:arg:arg:arg:saveRegs:pushLinkReg:resultReg:appendOpcodes: (in category 'initialization') -----
+ genTrampolineFor: aRoutine called: trampolineName numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 saveRegs: saveRegs pushLinkReg: pushLinkReg resultReg: resultRegOrNone appendOpcodes: appendBoolean
- genTrampolineFor: aRoutine called: trampolineName numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 saveRegs: saveRegs pushLinkReg: pushLinkReg resultReg: resultRegOrNil appendOpcodes: appendBoolean
  "Generate a trampoline with up to four arguments.  Generate either a call or a jump to aRoutineOrNil
+ as requested by callJumpBar.  If generating a call and resultRegOrNone is not NoReg pass the C result
+ back in resultRegOrNone.
- as requested by callJumpBar.  If generating a call and resultRegOrNil is non-zero pass the C result
- back in resultRegOrNil.
  Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
  <var: #aRoutine type: #'void *'>
  <var: #trampolineName type: #'char *'>
  | startAddress |
  <inline: false>
  startAddress := methodZoneBase.
  appendBoolean ifFalse:
  [self zeroOpcodeIndex].
  self compileTrampolineFor: aRoutine
  numArgs: numArgs
  arg: regOrConst0
  arg: regOrConst1
  arg: regOrConst2
  arg: regOrConst3
  saveRegs: saveRegs
  pushLinkReg: pushLinkReg
+ resultReg: resultRegOrNone.
- resultReg: resultRegOrNil.
  self outputInstructionsForGeneratedRuntimeAt: startAddress.
  self recordGeneratedRunTime: trampolineName address: startAddress.
  self recordRunTimeObjectReferences.
  ^startAddress!

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.
  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 numRegArgs > 0 ifTrue:
  [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: NoReg
- resultReg: nil
  saveRegs: false
  "Note that this call does not return."!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimReturnEnterCogCodeEnilopmart: (in category 'initialization') -----
  genPrimReturnEnterCogCodeEnilopmart: profiling
  "Generate the substitute return code for an external or FFI primitive call.
  On success simply return, extracting numArgs from newMethod.
  On primitive failure call ceActivateFailingPrimitiveMethod: newMethod."
  | jmpSample continuePostSample jmpFail |
  <var: #jmpSample type: #'AbstractInstruction *'>
  <var: #continuePostSample type: #'AbstractInstruction *'>
  <var: #jmpFail type: #'AbstractInstruction *'>
  self zeroOpcodeIndex.
  backEnd maybeEstablishVarBase. "Must happen sometime"
 
  profiling ifTrue:
  ["Test nextProfileTick for being non-zero and call checkProfileTick: if so.
   N.B. nextProfileTick is 64-bits so 32-bit systems need to test both halves."
  objectMemory wordSize = 4
  ifTrue:
  [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  self OrR: TempReg R: ClassReg]
  ifFalse:
  [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  self CmpCq: 0 R: TempReg].
  "If set, jump to record sample call."
  jmpSample := self JumpNonZero: 0.
  continuePostSample := self Label].
 
  self maybeCompileAllocFillerCheck.
 
  "Test primitive failure"
  self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  self flag: 'ask concrete code gen if move sets condition codes?'.
  self CmpCq: 0 R: TempReg.
  jmpFail := self JumpNonZero: 0.
 
  "Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  success: stackPointer -> result (was receiver)
  arg1
  ...
  argN
  return pc
  failure: receiver
  arg1
  ...
  stackPointer -> argN
  return pc
  We push the instructionPointer to reestablish the return pc in the success case,
  but leave it to ceActivateFailingPrimitiveMethod: to do so in the failure case."
 
  backEnd hasLinkRegister
  ifTrue:
  [backEnd genLoadStackPointers. "Switch back to Smalltalk stack."
  backEnd hasPCRegister
  ifTrue:
  [self PopR: ReceiverResultReg. "Pop result from stack"
  self MoveAw: coInterpreter instructionPointerAddress R: PCReg] "Return"
  ifFalse:
  [self MoveMw: 0 r: SPReg R: ReceiverResultReg. "Fetch result from stack"
  self MoveAw: coInterpreter instructionPointerAddress R: LinkReg. "Get ret pc"
  self RetN: objectMemory wordSize]] "Return, popping result from stack"
  ifFalse:
  [self MoveAw: coInterpreter instructionPointerAddress R: ClassReg. "Get return pc"
  backEnd genLoadStackPointers. "Switch back to Smalltalk stack."
  self MoveMw: 0 r: SPReg R: ReceiverResultReg. "Fetch result from stack"
  self MoveR: ClassReg Mw: 0 r: SPReg. "Restore return pc"
  self RetN: 0]. "Return, popping result from stack"
 
  "Primitive failed.  Invoke C code to build the frame and continue."
  jmpFail jmpTarget: (self MoveAw: coInterpreter newMethodAddress R: SendNumArgsReg).
  "Reload sp with CStackPointer; easier than popping args of checkProfileTick."
  self MoveAw: self cStackPointerAddress R: SPReg.
  self
  compileCallFor: #ceActivateFailingPrimitiveMethod:
  numArgs: 1
  arg: SendNumArgsReg
  arg: nil
  arg: nil
  arg: nil
+ resultReg: NoReg
- resultReg: nil
  saveRegs: false.
 
  "On Spur ceActivateFailingPrimitiveMethod: may retry the primitive and return if successful.
  So continue by returning to the caller.
  Switch back to the Smalltalk stack.  Stack should be in this state:
  success: stackPointer -> result (was receiver)
  arg1
  ...
  argN
  return pc
  We can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
  self MoveAw: coInterpreter instructionPointerAddress
  R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
  backEnd genLoadStackPointers.
  backEnd hasLinkRegister
  ifTrue:
  [self MoveMw: 0 r: SPReg R: ReceiverResultReg] "Fetch result from stack"
  ifFalse:
  [self MoveMw: objectMemory wordSize r: SPReg R: ReceiverResultReg. "Fetch result from stack"
  self PushR: ClassReg]. "Restore return pc on CISCs"
  self RetN: objectMemory wordSize. "return to caller, popping receiver"
 
  profiling ifTrue:
  ["Call ceCheckProfileTick: to record sample and then continue.  newMethod
  should be up-to-date.  Need to save and restore the link reg around this call."
  jmpSample jmpTarget: self Label.
  backEnd saveAndRestoreLinkRegAround:
  [self CallFullRT: (self cCode: '(unsigned long)ceCheckProfileTick'
  inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick])].
  self Jump: continuePostSample]!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genMustBeBooleanTrampolineFor:called: (in category 'initialization') -----
  genMustBeBooleanTrampolineFor: boolean called: trampolineName
  "This can be entered in one of two states, depending on SendNumArgsReg. See
  e.g. genJumpIf:to:.  If SendNumArgsReg is non-zero then this has been entered via
  the initial test of the counter in the jump executed count (i.e. the counter has
  tripped).  In this case TempReg contains the boolean to be tested and should not
  be offset, and ceCounterTripped should be invoked with the unoffset TempReg.
  If SendNumArgsReg is zero then this has been entered for must-be-boolean
  processing. TempReg has been offset by boolean and must be corrected and
  ceSendMustBeBoolean: invoked with the corrected value."
  <var: #trampolineName type: #'char *'>
  | jumpMBB |
  <var: #jumpMBB type: #'AbstractInstruction *'>
  <inline: false>
  self zeroOpcodeIndex.
  self CmpCq: 0 R: SendNumArgsReg.
  jumpMBB := self JumpZero: 0.
  "Open-code self compileTrampolineFor: #ceCounterTripped: numArgs: 1 arg: TempReg ...
  so we can restore ResultReceiverReg."
  self genSmalltalkToCStackSwitch: true.
  self
  compileCallFor: #ceCounterTripped:
  numArgs: 1
  arg: TempReg
  arg: nil
  arg: nil
  arg: nil
  resultReg: TempReg "(*)"
  saveRegs: false.
  "(*) For the case where the ceCounterTripped: call returns (e.g. because there's no callback selector
  installed), the call to the ceSendMustBeBooleanAddTrue/FalseTrampoline is followed by a jump
  back to the start of the counter/condition test sequence.  For this case copy the C result to
  TempReg (the register that is tested), to reload it with the boolean to be tested."
  backEnd genLoadStackPointers.
  backEnd hasLinkRegister ifTrue:
  [self PopR: LinkReg].
  "To keep ResultReceiverReg live if optStatus thiught it was, simply reload it
  from the frame pointer.  This avoids having to reload it in the common case
  (counter does not trip) if it was live."
  self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  self RetN: 0.
  "If the objectRepresentation does want true & false to be mobile then we need to record these addresses."
  self assert: (objectRepresentation shouldAnnotateObjectReference: boolean) not.
  jumpMBB jmpTarget: (self AddCq: boolean R: TempReg).
  ^self genTrampolineFor: #ceSendMustBeBoolean:
  called: trampolineName
  numArgs: 1
  arg: TempReg
  arg: nil
  arg: nil
  arg: nil
  saveRegs: false
  pushLinkReg: true
+ resultReg: NoReg
- resultReg: nil
  appendOpcodes: true!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genSpecialSelectorEqualsEqualsWithForwarders (in category 'bytecode generators') -----
  genSpecialSelectorEqualsEqualsWithForwarders
  "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 targetBytecodePC branchDescriptor counterReg fixup jumpEqual jumpNotEqual
   counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |
  <var: #fixup type: #'BytecodeFixup *'>
  <var: #countTripped type: #'AbstractInstruction *'>
  <var: #label type: #'AbstractInstruction *'>
  <var: #branchDescriptor type: #'BytecodeDescriptor *'>
  <var: #jumpEqual type: #'AbstractInstruction *'>
  <var: #jumpNotEqual type: #'AbstractInstruction *'>
 
  ((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:
  [^super genSpecialSelectorEqualsEqualsWithForwarders].
 
  regMask := 0.
 
  self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
  branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
 
  unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
  unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
 
  "If an operand is an annotable constant, it may be forwarded, so we need to store it into a
  register so the forwarder check can jump back to the comparison after unforwarding the constant.
  However, if one of the operand is an unnanotable constant, does not allocate a register for it
  (machine code will use operations on constants)."
+ rcvrReg:= argReg := NoReg.
  self
  allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
  rcvrNeedsReg: unforwardRcvr
  into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
 
+ argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].
+ rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
- argReg ifNotNil: [ regMask := self registerMaskFor: argReg ].
- rcvrReg ifNotNil: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
 
  "Only interested in inlining if followed by a conditional branch."
  (branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
  [^ self genEqualsEqualsNoBranchArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg].
 
  "If branching the stack must be flushed for the merge"
  self ssFlushTo: simStackPtr - 2.
 
  unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
  unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
 
  counterReg := self allocateRegNotConflictingWith: regMask.
  self
  genExecutionCountLogicInto: [ :cAddress :countTripBranch |
  counterAddress := cAddress.
  countTripped := countTripBranch ]
  counterReg: counterReg.
 
  self assert: (unforwardArg or: [ unforwardRcvr ]).
 
  self genEqualsEqualsComparisonArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
 
  self ssPop: 2.
 
  branchDescriptor isBranchTrue
  ifTrue:
  [ fixup := self ensureNonMergeFixupAt: postBranchPC - initialPC.
  self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger. ]
  ifFalse:
  [ fixup := self ensureNonMergeFixupAt: targetBytecodePC - initialPC.
  self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger. ].
 
  self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
  self Jump: fixup.
 
  countTripped jmpTarget: self Label.
 
  "inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"
  self ssPop: -2.
  self genEqualsEqualsComparisonArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
  self ssPop: 2.
 
  "This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg.
  We therefore directly assign the result to TempReg to save one move instruction"
  jumpEqual := self JumpZero: 0.
  self genMoveFalseR: TempReg.
  jumpNotEqual := self Jump: 0.
  jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
  jumpNotEqual jmpTarget: self Label.
  self ssPushRegister: TempReg.
 
  (self fixupAt: nextPC - initialPC) targetInstruction = 0 ifTrue: [ branchReachedOnlyForCounterTrip := true ].
 
  ^ 0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>allocateEqualsEqualsRegistersArgNeedsReg:rcvrNeedsReg:into: (in category 'bytecode generator support') -----
  allocateEqualsEqualsRegistersArgNeedsReg: argNeedsReg rcvrNeedsReg: rcvrNeedsReg into: binaryBlock
  <inline: true>
  | argReg rcvrReg |
  self assert: (argNeedsReg or: [rcvrNeedsReg]).
+ argReg := rcvrReg := NoReg.
  argNeedsReg
  ifTrue:
  [rcvrNeedsReg
  ifTrue:
  [self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
  self ssTop popToReg: argReg.
  (self ssValue: 1) popToReg: rcvrReg]
  ifFalse:
  [argReg := self allocateRegForStackEntryAt: 0.
  self ssTop popToReg: argReg.
  "If the receiver is a spilled constant we need to pop it from the stack."
  (self ssValue: 1) spilled ifTrue:
  [self AddCq: objectMemory wordSize R: SPReg]]]
  ifFalse:
  [self assert: rcvrNeedsReg.
  self deny: self ssTop spilled.
  rcvrReg := self allocateRegForStackEntryAt: 1.
  (self ssValue: 1) popToReg: rcvrReg].
 
+ self deny: (argNeedsReg and: [argReg = NoReg]).
+ self deny: (rcvrNeedsReg and: [rcvrReg = NoReg]).
- self assert: (argNeedsReg not or: [argReg notNil]).
- self assert: (rcvrNeedsReg not or: [rcvrReg notNil]).
 
  binaryBlock value: rcvrReg value: argReg!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>allocateRegForStackTopThreeEntriesInto:thirdIsReceiver: (in category 'simulation stack') -----
  allocateRegForStackTopThreeEntriesInto: trinaryBlock thirdIsReceiver: thirdIsReceiver
  "Answers registers for the 3 top values on stack. If the values are already in registers, answers
  these registers, else allocate registers not conflicting with each others.
  If thirdIsReceiver is true, allocate ReceiverResultReg for stackTop - 2 (for ceStoreCheck)."
  <inline: true>
  | topRegistersMask rTop rNext rThird |
 
  topRegistersMask := 0.
+ rTop := rNext := rThird := NoReg.
 
  (self ssTop type = SSRegister and: [ thirdIsReceiver not or: [ self ssTop register ~= ReceiverResultReg ] ]) ifTrue:
  [ topRegistersMask := self registerMaskFor: (rTop := self ssTop register)].
  ((self ssValue: 1) type = SSRegister and: [ thirdIsReceiver not or: [ (self ssValue: 1) register ~= ReceiverResultReg ] ]) ifTrue:
  [ topRegistersMask := topRegistersMask bitOr: (self registerMaskFor: (rNext := (self ssValue: 1) register))].
  ((self ssValue: 2) type = SSRegister and: [thirdIsReceiver not or: [ (self ssValue: 2) register = ReceiverResultReg ] ]) ifTrue:
  [ topRegistersMask := topRegistersMask bitOr: (self registerMaskFor: (rThird := (self ssValue: 2) register))].
 
+ rThird = NoReg ifTrue:
- rThird ifNil:
  [ thirdIsReceiver
  ifTrue:
  [ rThird := ReceiverResultReg.  "Free ReceiverResultReg if it was not free"
  self ssAllocateRequiredReg: ReceiverResultReg.
  optStatus isReceiverResultRegLive: false ]
  ifFalse: [ rThird := self allocateRegNotConflictingWith: topRegistersMask ].
  topRegistersMask := topRegistersMask bitOr: (self registerMaskFor: rThird) ].
 
+ rTop = NoReg ifTrue:
+ [ rTop := self allocateRegNotConflictingWith: topRegistersMask.
+  topRegistersMask := topRegistersMask bitOr: (self registerMaskFor: rTop) ].
- rTop ifNil: [
- rTop := self allocateRegNotConflictingWith: topRegistersMask.
- topRegistersMask := topRegistersMask bitOr: (self registerMaskFor: rTop) ].
 
+ rNext = NoReg ifTrue:
+ [ rNext := self allocateRegNotConflictingWith: topRegistersMask ].
+
+ self deny: (rTop = NoReg or: [rNext = NoReg or: [rThird = NoReg]]).
+
+ ^ trinaryBlock value: rTop value: rNext value: rThird!
- rNext ifNil: [ rNext := self allocateRegNotConflictingWith: topRegistersMask ].
-
- ^ trinaryBlock value: rTop value: rNext value: rThird
-
- !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>allocateRegForStackTopTwoEntriesInto: (in category 'simulation stack') -----
  allocateRegForStackTopTwoEntriesInto: binaryBlock
  "Answers registers for the 2 top values on stack. If the values are already in registers, answers
  these registers, else allocate registers not conflicting with each others."
  <inline: true>
  | topRegistersMask rTop rNext |
 
  topRegistersMask := 0.
+ rTop := rNext := NoReg.
 
  self ssTop type = SSRegister ifTrue:
  [ rTop := self ssTop register].
  (self ssValue: 1) type = SSRegister ifTrue:
  [ topRegistersMask := self registerMaskFor: (rNext := (self ssValue: 1) register)].
 
+ rTop = NoReg ifTrue:
+ [ rTop := self allocateRegNotConflictingWith: topRegistersMask ].
- rTop ifNil: [ rTop := self allocateRegNotConflictingWith: topRegistersMask ].
 
+ rNext = NoReg ifTrue:
+ [ rNext := self allocateRegNotConflictingWith: (self registerMaskFor: rTop) ].
+
+ self deny: (rTop = NoReg or: [rNext = NoReg]).
+
+ ^ binaryBlock value: rTop value: rNext!
- rNext ifNil: [ rNext := self allocateRegNotConflictingWith: (self registerMaskFor: rTop) ].
-
- ^ binaryBlock value: rTop value: rNext
-
- !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>allocateRegNotConflictingWith: (in category 'simulation stack') -----
  allocateRegNotConflictingWith: regMask
  | reg |
  "if there's a free register, use it"
+ reg := backEnd availableRegisterOrNoneFor: (self liveRegisters bitOr: regMask).
+ reg = NoReg ifTrue: "No free register, choose one that does not conflict with regMask"
- reg := backEnd availableRegisterOrNilFor: (self liveRegisters bitOr: regMask).
- reg ifNil: "No free register, choose one that does not conflict with regMask"
  [reg := self freeAnyRegNotConflictingWith: regMask].
  reg = ReceiverResultReg ifTrue: "If we've allocated RcvrResultReg, it's not live anymore"
+ [optStatus isReceiverResultRegLive: false].
- [ optStatus isReceiverResultRegLive: false ].
  ^ reg!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>availableRegOrNilNotConflictingWith: (in category 'simulation stack') -----
- availableRegOrNilNotConflictingWith: regMask
- <inline: true>
- "If there's a free register, answer it, otherwise answer nil."
- ^backEnd availableRegisterOrNilFor: (self liveRegisters bitOr: regMask)!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>availableRegOrNoneNotConflictingWith: (in category 'simulation stack') -----
+ availableRegOrNoneNotConflictingWith: regMask
+ <inline: true>
+ "If there's a free register, answer it, otherwise answer NoReg."
+ ^backEnd availableRegisterOrNoneFor: (self liveRegisters bitOr: regMask)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>freeAnyRegNotConflictingWith: (in category 'simulation stack') -----
  freeAnyRegNotConflictingWith: regMask
  "Spill the closest register on stack not conflicting with regMask.
  Assertion Failure if regMask has already all the registers"
  <var: #desc type: #'CogSimStackEntry *'>
  | reg index |
  self assert: needsFrame.
+ reg := NoReg.
  index := simSpillBase max: 0.
+ [reg = NoReg and: [index < simStackPtr]] whileTrue:
- [reg isNil and: [index < simStackPtr] ] whileTrue:
  [ | desc |
  desc := self simStackAt: index.
  desc type = SSRegister ifTrue:
+ [(regMask anyMask: (self registerMaskFor: desc register)) ifFalse:
+ [reg := desc register]].
- [ (regMask anyMask: (self registerMaskFor: desc register)) ifFalse:
- [ reg := desc register ] ].
  index := index + 1].
+ self deny: reg = NoReg.
- self assert: reg notNil.
  self ssAllocateRequiredReg: reg.
  ^reg!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genEqualsEqualsNoBranchArgIsConstant:rcvrIsConstant:argReg:rcvrReg: (in category 'bytecode generator support') -----
+ genEqualsEqualsNoBranchArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrRegOrNone
- genEqualsEqualsNoBranchArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg
  "Generates the machine code for #== in the case where the instruction is not followed by a branch"
  | label jumpEqual jumpNotEqual resultReg |
  <var: #label type: #'AbstractInstruction *'>
  <var: #jumpEqual type: #'AbstractInstruction *'>
  <var: #jumpNotEqual type: #'AbstractInstruction *'>
  label := self Label.
+ self genEqualsEqualsComparisonArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrRegOrNone.
- self genEqualsEqualsComparisonArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
  self ssPop: 2.
+ resultReg := rcvrRegOrNone = NoReg ifTrue: [argReg] ifFalse: [rcvrRegOrNone].
- resultReg := rcvrReg ifNil: [argReg ].
  jumpEqual := self JumpZero: 0.
+ argIsConstant ifFalse:
+ [objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label].
+ rcvrIsConstant ifFalse:
+ [objectRepresentation genEnsureOopInRegNotForwarded: rcvrRegOrNone scratchReg: TempReg jumpBackTo: label].
- argIsConstant ifFalse: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ].
- rcvrIsConstant ifFalse: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg jumpBackTo: label ].
  self genMoveFalseR: resultReg.
  jumpNotEqual := self Jump: 0.
  jumpEqual jmpTarget: (self genMoveTrueR: resultReg).
  jumpNotEqual jmpTarget: self Label.
  self ssPushRegister: resultReg.
  ^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genMethodAbortTrampolineFor: (in category 'initialization') -----
  genMethodAbortTrampolineFor: numArgs
-
  "Generate the abort for a method.  This abort performs either a call of ceSICMiss:
  to handle a single-in-line cache miss or a call of ceStackOverflow: to handle a
  stack overflow.  It distinguishes the two by testing ResultReceiverReg.  If the
  register is zero then this is a stack-overflow because a) the receiver has already
  been pushed and so can be set to zero before calling the abort, and b) the
  receiver must always contain an object (and hence be non-zero) on SIC miss."
  | jumpSICMiss |
  <var: #jumpSICMiss type: #'AbstractInstruction *'>
  self zeroOpcodeIndex.
  self CmpCq: 0 R: ReceiverResultReg.
  jumpSICMiss := self JumpNonZero: 0.
 
  "The abort sequence has pushed the LinkReg a second time - because a stack
  overflow can only happen after building a frame, which pushes LinkReg anyway, and
  we still need to push LinkReg in case we get to this routine from a sendMissAbort.
  (On ARM there is a simpler way; use two separate abort calls since all instructions are 32-bits
   but on x86 the zero receiver reg, call methodAbort sequence is smaller; we may fix this one day).
  Overwrite that duplicate with the right one - the return address for the call to the abort trampoline.
  The only reason it matters is an assert in ceStackOverflow: uses it"
  backEnd hasLinkRegister ifTrue:
  [self MoveR: LinkReg Mw: 0 r: SPReg].
  self compileTrampolineFor: #ceStackOverflow:
  numArgs: 1
  arg: SendNumArgsReg
  arg: nil
  arg: nil
  arg: nil
  saveRegs: false
  pushLinkReg: false "The LinkReg has already been set above."
+ resultReg: NoReg.
- resultReg: nil.
  jumpSICMiss jmpTarget: self Label.
  backEnd genPushRegisterArgsForAbortMissNumArgs: numArgs.
  ^self genTrampolineFor: #ceSICMiss:
  called: (self trampolineName: 'ceMethodAbort' numRegArgs: numArgs)
  numArgs: 1
  arg: ReceiverResultReg
  arg: nil
  arg: nil
  arg: nil
  saveRegs: false
  pushLinkReg: false "The LinkReg will have been pushed in genPushRegisterArgsForAbortMissNumArgs: above."
+ resultReg: NoReg
- resultReg: nil
  appendOpcodes: true!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushRemoteTempLongBytecode (in category 'bytecode generators') -----
  genPushRemoteTempLongBytecode
  | tempVectReg remoteTempReg |
  tempVectReg := self allocateRegNotConflictingWith: 0.
  self MoveMw: (self frameOffsetOfTemporary: byte2) r: FPReg R: tempVectReg.
+ remoteTempReg := self availableRegOrNoneNotConflictingWith: (self registerMaskFor: tempVectReg).
+ remoteTempReg = NoReg ifTrue: [remoteTempReg := tempVectReg].
- remoteTempReg := self availableRegOrNilNotConflictingWith: (self registerMaskFor: tempVectReg).
- remoteTempReg ifNil: [ remoteTempReg := tempVectReg ].
  objectRepresentation
  genLoadSlot: byte1
  sourceReg: tempVectReg
  destReg: remoteTempReg.
  ^self ssPushRegister: remoteTempReg!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSendTrampolineFor:numArgs:called:arg:arg:arg:arg: (in category 'initialization') -----
  genSendTrampolineFor: aRoutine numArgs: numArgs called: aString arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3
  "Generate a trampoline with four arguments.
  Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
  <var: #aRoutine type: #'void *'>
  <var: #aString type: #'char *'>
  | startAddress |
  <inline: false>
  startAddress := methodZoneBase.
  self zeroOpcodeIndex.
  backEnd genPushRegisterArgsForNumArgs: numArgs scratchReg: SendNumArgsReg.
  objectRepresentation selectorIndexDereferenceRoutine ifNotNil:
  [:routine| self Call: routine].
  self genTrampolineFor: aRoutine
  called: aString
  numArgs: 4
  arg: regOrConst0
  arg: regOrConst1
  arg: regOrConst2
  arg: regOrConst3
  saveRegs: false
  pushLinkReg: true
+ resultReg: NoReg
- resultReg: nil
  appendOpcodes: true.
  ^startAddress!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSpecialSelectorClass (in category 'bytecode generators') -----
  genSpecialSelectorClass
  | topReg |
+ topReg := self ssTop registerOrNone.
- topReg := self ssTop registerOrNil.
  self ssPop: 1.
+ (topReg = NoReg or: [topReg = ClassReg])
- (topReg isNil or: [topReg = ClassReg])
  ifTrue: [self ssAllocateRequiredReg: (topReg := SendNumArgsReg) and: ClassReg]
  ifFalse: [self ssAllocateRequiredReg: ClassReg].
  self ssPush: 1.
  self ssTop popToReg: topReg.
  objectRepresentation
  genGetClassObjectOf: topReg
  into: ClassReg
  scratchReg: TempReg
  instRegIsReceiver: false.
  ^self ssPop: 1; ssPushRegister: ClassReg!

Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-eem.1574.mcz

Ryan Macnak
 
IA32 Cog has been broken since this commit.

/home/travis/build/newspeaklanguage/nsvm-linux-ci/oscogvm/nsspursrc/vm/cogitIA32.c: In function ‘genEnilopmartForandandforCallcalled’:
/home/travis/build/newspeaklanguage/nsvm-linux-ci/oscogvm/nsspursrc/vm/cogitIA32.c:9844:6: error: ‘regArg3OrNone’ undeclared (first use in this function)

On Thu, Dec 10, 2015 at 9:37 AM, <[hidden email]> wrote:

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

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

Name: VMMaker.oscog-eem.1574
Author: eem
Time: 10 December 2015, 9:36:18.933 am
UUID: ce2daaa5-0130-4ed4-abdb-26b8b6c06c6e
Ancestors: VMMaker.oscog-eem.1573

Cogit:
Introduce the "abstract register" NoReg and use it everywhere we used nil before to indicate no register.  Rename selectors and temporaries of the form *registerOrNil*" to "*registerOrNone*".  Rewrite all uses of reg ifNil: to be reg = NoReg ifTrue:.


This is prior to the putsch to replace the use of -1 to -N for abstract registers, collapsing them down onto the same 0-N range used for concrete registers.

Ryan, Tim, Clément et al, perhaps you could review this carefully and check your own tests to ensure I've got this right.  At least the x64 and x86 Cogits look fine after this intermediate change.

BTW, I used this to identify potential methods to change:

self systemNavigation
        browseMessageList: (self systemNavigation allMethodsSelect: [:m| (m methodClass category beginsWith:  #'VMMaker-JIT') and: [(m literals includesAnyOf: #(isNil notNil ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil:)) and: [m methodNode tempNames anySatisfy: [:t| '*reg*' match: t]]]] localToPackage: #VMMaker)
        name: 'Uses of nil'
        autoSelect: 'Nil'

and message names with the pattern "*reg*ornil*" to find selectors.
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-eem.1574.mcz

Eliot Miranda-2
 
Apologies, Ryan.  Fixed now.  That's an example of arg names hidden in a string providing the signature of a method that answers a function pointer.  Slang can't deal so it's hacked.

On Sat, Dec 12, 2015 at 10:54 AM, Ryan Macnak <[hidden email]> wrote:
 
IA32 Cog has been broken since this commit.

/home/travis/build/newspeaklanguage/nsvm-linux-ci/oscogvm/nsspursrc/vm/cogitIA32.c: In function ‘genEnilopmartForandandforCallcalled’:
/home/travis/build/newspeaklanguage/nsvm-linux-ci/oscogvm/nsspursrc/vm/cogitIA32.c:9844:6: error: ‘regArg3OrNone’ undeclared (first use in this function)

On Thu, Dec 10, 2015 at 9:37 AM, <[hidden email]> wrote:

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

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

Name: VMMaker.oscog-eem.1574
Author: eem
Time: 10 December 2015, 9:36:18.933 am
UUID: ce2daaa5-0130-4ed4-abdb-26b8b6c06c6e
Ancestors: VMMaker.oscog-eem.1573

Cogit:
Introduce the "abstract register" NoReg and use it everywhere we used nil before to indicate no register.  Rename selectors and temporaries of the form *registerOrNil*" to "*registerOrNone*".  Rewrite all uses of reg ifNil: to be reg = NoReg ifTrue:.


This is prior to the putsch to replace the use of -1 to -N for abstract registers, collapsing them down onto the same 0-N range used for concrete registers.

Ryan, Tim, Clément et al, perhaps you could review this carefully and check your own tests to ensure I've got this right.  At least the x64 and x86 Cogits look fine after this intermediate change.

BTW, I used this to identify potential methods to change:

self systemNavigation
        browseMessageList: (self systemNavigation allMethodsSelect: [:m| (m methodClass category beginsWith:  #'VMMaker-JIT') and: [(m literals includesAnyOf: #(isNil notNil ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil:)) and: [m methodNode tempNames anySatisfy: [:t| '*reg*' match: t]]]] localToPackage: #VMMaker)
        name: 'Uses of nil'
        autoSelect: 'Nil'

and message names with the pattern "*reg*ornil*" to find selectors.




--
_,,,^..^,,,_
best, Eliot