[Vm-dev] VM Maker: VMMaker.oscog-cb.1615.mcz

Eliot Miranda eliot.miranda at gmail.com
Wed Jan 6 08:25:14 UTC 2016


Hi Clément,

    also, before I forget, the primitive failure code for immutability
violations should be PrimErrNoModification, not PrimErrInappropriate.

On Wed, Jan 6, 2016 at 12:00 AM, Eliot Miranda <eliot.miranda at gmail.com>
wrote:

> Hi Clément,
>
> On Tue, Dec 29, 2015 at 1:31 AM, <commits at source.squeak.org> wrote:
>
>>
>> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
>> http://source.squeak.org/VMMaker/VMMaker.oscog-cb.1615.mcz
>>
>> ==================== Summary ====================
>>
>> Name: VMMaker.oscog-cb.1615
>> Author: cb
>> Time: 29 December 2015, 10:30:37.779 am
>> UUID: 712a0115-a780-4d2c-b4f8-c0bc78031889
>> Ancestors: VMMaker.oscog-eem.1614, VMMaker.oscog-cb.1579
>>
>> Made a new version of immutability with Eliot's remarks:
>> - control flow maintained for the simulator
>> - option pragma everywhere needed
>> - removed duplication in extStore bytecodes
>> - removed useless instruction in primitiveClone.
>>
>> I tried to use it, it does not work, but it seems the bleeding edge is
>> not stable.
>>
>
> I see one reason why it doesn't work.  Let me take you
> through storeAndPopReceiverVariableBytecode
>
>
>> The only thing I noticed is that some assertion may fail in
>> #maybeCheckStackDepth:sp:pc: .
>>
>> =============== Diff against VMMaker.oscog-eem.1614 ===============
>>
>> Item was added:
>> + ----- Method: CoInterpreter>>ceCannotAssignTo:withIndex:valueToAssign:
>> (in category 'trampolines') -----
>> + ceCannotAssignTo: immutableObject withIndex: index valueToAssign:
>> valueToAssign
>> +       "index is unboxed."
>> +       <api>
>> +       <option: #IMMUTABILITY>
>> +       instructionPointer := self popStack.
>> +       self push: immutableObject.
>> +       self push: valueToAssign.
>> +       self push: (objectMemory integerObjectOf: index).
>> +       self push: instructionPointer.
>> +       ^ self
>> +               ceSendAbort: (objectMemory splObj:
>> SelectorAttemptToAssign)
>> +               to: immutableObject
>> +               numArgs: 2!
>>
>> Item was removed:
>> - ----- Method: CoInterpreter>>extendedStoreBytecode (in category 'stack
>> bytecodes') -----
>> - extendedStoreBytecode
>> -       "Override to use itemporary:in:put:"
>> -       | descriptor variableType variableIndex |
>> -       <inline: true>
>> -       descriptor := self fetchByte.
>> -       self fetchNextBytecode.
>> -       variableType := descriptor >> 6 bitAnd: 3.
>> -       variableIndex := descriptor bitAnd: 63.
>> -       variableType = 0 ifTrue:
>> -               [^objectMemory storePointer: variableIndex ofObject: self
>> receiver withValue: self internalStackTop].
>> -       variableType = 1 ifTrue:
>> -               [^self itemporary: variableIndex in: localFP put: self
>> internalStackTop].
>> -       variableType = 3 ifTrue:
>> -               [^self storeLiteralVariable: variableIndex withValue:
>> self internalStackTop].
>> -       self error: 'illegal store'!
>>
>> Item was added:
>> + ----- Method: CoInterpreter>>extendedStoreBytecodePop: (in category
>> 'stack bytecodes') -----
>> + extendedStoreBytecodePop: popBoolean
>> +       "Override to use itemporary:in:put:"
>> +       | descriptor variableType variableIndex value |
>> +       <inline: true>
>> +       descriptor := self fetchByte.
>> +       self fetchNextBytecode.
>> +       variableType := descriptor >> 6 bitAnd: 3.
>> +       variableIndex := descriptor bitAnd: 63.
>> +       value := self internalStackTop.
>> +       popBoolean ifTrue: [ self internalPop: 1 ].
>> +       variableType = 0 ifTrue:
>> +               [^objectMemory storePointerImmutabilityCheck:
>> variableIndex ofObject: self receiver withValue: value].
>> +       variableType = 1 ifTrue:
>> +               [^self itemporary: variableIndex in: localFP put: value].
>> +       variableType = 3 ifTrue:
>> +               [^self storeLiteralVariable: variableIndex withValue:
>> value].
>> +       self error: 'illegal store'!
>>
>> Item was changed:
>>   ----- Method: CoInterpreterPrimitives>>primitiveObjectAtPut (in
>> category 'object access primitives') -----
>>   primitiveObjectAtPut
>>         "Store a literal into a CompiledMethod at the given index.
>> Defined for CompiledMethods only."
>>         | thisReceiver rawHeader realHeader index newValue |
>>         newValue := self stackValue: 0.
>>         index := self stackValue: 1.
>>         (objectMemory isNonIntegerObject: index) ifTrue:
>>                 [^self primitiveFailFor: PrimErrBadArgument].
>>         index := objectMemory integerValueOf: index.
>>         thisReceiver := self stackValue: 2.
>> +       self cppIf: IMMUTABILITY
>> +               ifTrue: [ (objectMemory isImmutable: thisReceiver)
>> ifTrue: [ ^self primitiveFailFor: PrimErrInappropriate ] ].
>>         rawHeader := self rawHeaderOf: thisReceiver.
>>         realHeader := (self isCogMethodReference: rawHeader)
>>                                         ifTrue: [(self cCoerceSimple:
>> rawHeader to: #'CogMethod *') methodHeader]
>>                                         ifFalse: [rawHeader].
>>         (index > 0
>>          and: [index <= ((objectMemory literalCountOfMethodHeader:
>> realHeader) + LiteralStart)]) ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadIndex].
>>         index = 1
>>                 ifTrue:
>>                         [((objectMemory isNonIntegerObject: newValue)
>>                          or: [(objectMemory literalCountOfMethodHeader:
>> newValue) ~= (objectMemory literalCountOfMethodHeader: realHeader)]) ifTrue:
>>                                 [^self primitiveFailFor:
>> PrimErrBadArgument].
>>                          (self isCogMethodReference: rawHeader)
>>                                 ifTrue: [(self cCoerceSimple: rawHeader
>> to: #'CogMethod *') methodHeader: newValue]
>>                                 ifFalse: [objectMemory
>> storePointerUnchecked: 0 ofObject: thisReceiver withValue: newValue]]
>>                 ifFalse:
>>                         [objectMemory storePointer: index - 1 ofObject:
>> thisReceiver withValue: newValue].
>>         self pop: 3 thenPush: newValue!
>>
>> Item was added:
>> + ----- Method:
>> CogObjectRepresentation>>genStoreSourceReg:slotIndex:destReg:scratchReg:inFrame:
>> (in category 'compile abstract instructions') -----
>> + genStoreSourceReg: sourceReg slotIndex: index destReg: destReg
>> scratchReg: scratchReg inFrame: inFrame
>> +       ^ self
>> +               genStoreSourceReg: sourceReg
>> +               slotIndex: index
>> +               destReg: destReg
>> +               scratchReg: scratchReg
>> +               inFrame: inFrame
>> +               needsStoreCheck: true!
>>
>> Item was changed:
>>   ----- Method:
>> CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAtPut: (in category
>> 'primitive generators') -----
>>   genInnerPrimitiveAtPut: retNoffset
>>         "Implement the guts of primitiveAtPut"
>> +       | formatReg jumpImmediate jumpBadIndex jumpImmutable
>> -       | 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 cppIf: IMMUTABILITY
>> +               ifTrue:
>> +               [ self genGetFormatOf: ReceiverResultReg
>> +                       into: (formatReg := SendNumArgsReg)
>> +                       leastSignificantHalfOfBaseHeaderIntoScratch:
>> TempReg.
>> +               jumpImmutable := self genJumpBaseHeaderImmutable: TempReg
>> ]
>> +               ifFalse:
>> +               [ self genGetFormatOf: ReceiverResultReg
>> +                       into: (formatReg := SendNumArgsReg)
>> +                       leastSignificantHalfOfBaseHeaderIntoScratch:
>> NoReg ].
>> -       self genGetFormatOf: ReceiverResultReg
>> -               into: (formatReg := SendNumArgsReg)
>> -               leastSignificantHalfOfBaseHeaderIntoScratch: NoReg.
>>
>>         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))))))))))).
>> +
>> +       self cppIf: IMMUTABILITY ifTrue: [ jumpImmutable 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>>genInnerPrimitiveStringAtPut: (in
>> category 'primitive generators') -----
>>   genInnerPrimitiveStringAtPut: retNoffset
>>         "Implement the guts of primitiveStringAtPut"
>>         | formatReg jumpBadIndex jumpBadArg jumpWordsDone
>> jumpBytesOutOfRange
>> +         jumpIsBytes jumpNotString jumpIsCompiledMethod jumpImmutable
>> -         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 cppIf: IMMUTABILITY
>> +               ifTrue:
>> +               [ self genGetFormatOf: ReceiverResultReg
>> +                       into: (formatReg := SendNumArgsReg)
>> +                       leastSignificantHalfOfBaseHeaderIntoScratch:
>> TempReg.
>> +               jumpImmutable := self genJumpBaseHeaderImmutable: TempReg
>> ]
>> +               ifFalse:
>> +               [ self genGetFormatOf: ReceiverResultReg
>> +                       into: (formatReg := SendNumArgsReg)
>> +                       leastSignificantHalfOfBaseHeaderIntoScratch:
>> NoReg ].
>> -       self genGetFormatOf: ReceiverResultReg
>> -               into: (formatReg := SendNumArgsReg)
>> -               leastSignificantHalfOfBaseHeaderIntoScratch: NoReg.
>>
>>         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)))))).
>>
>> +       self cppIf: IMMUTABILITY ifTrue: [ jumpImmutable jmpTarget: cogit
>> Label ].
>> +
>>         cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
>>         self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
>>
>>         jumpBadIndex jmpTarget: cogit Label.
>>
>>         ^0!
>>
>> Item was changed:
>>   CogObjectRepresentation subclass: #CogObjectRepresentationForSpur
>> +       instanceVariableNames: 'ceScheduleScavengeTrampoline
>> ceSmallActiveContextInMethodTrampoline
>> ceSmallActiveContextInBlockTrampoline
>> ceLargeActiveContextInMethodTrampoline
>> ceLargeActiveContextInBlockTrampoline ceStoreCheckContextReceiverTrampoline
>> ceCannotAssignToWithIndexTrampoline'
>> -       instanceVariableNames: 'ceScheduleScavengeTrampoline
>> ceSmallActiveContextInMethodTrampoline
>> ceSmallActiveContextInBlockTrampoline
>> ceLargeActiveContextInMethodTrampoline
>> ceLargeActiveContextInBlockTrampoline ceStoreCheckContextReceiverTrampoline'
>>         classVariableNames: ''
>>         poolDictionaries: 'VMBytecodeConstants VMSqueakClassIndices'
>>         category: 'VMMaker-JIT'!
>>
>> Item was changed:
>>   ----- Method: CogObjectRepresentationForSpur class>>numTrampolines (in
>> category 'accessing') -----
>>   numTrampolines
>> +       (initializationOptions at: #IMMUTABILITY ifAbsent: [false])
>> +               ifTrue: [ ^ super numTrampolines + 7 ]
>> +               ifFalse: [ ^ super numTrampolines + 6 ]!
>> -       ^super numTrampolines + 6!
>>
>> Item was added:
>> + ----- Method:
>> CogObjectRepresentationForSpur>>genImmutableCheck:slotIndex:sourceReg:scratchReg:popBoolean:needRestoreRcvr:
>> (in category 'compile abstract instructions') -----
>> + genImmutableCheck: regHoldingObjectMutated slotIndex: index sourceReg:
>> regHoldingValueToStore scratchReg: scratchReg popBoolean: popBoolean
>> needRestoreRcvr: needRestoreRcvr
>> +       | mutableJump fail |
>> +       <var: #mutableJump type: #'AbstractInstruction *'>
>> +       <var: #fail type: #'AbstractInstruction *'>
>> +       <inline: true>
>> +       <option: #IMMUTABILITY>
>> +       "Trampoline convention:
>> +       - objectMutated passed in RcvrResultReg
>> +       - index (unboxed) passed in TempReg
>> +       - valueToStore passed in Arg1Reg.
>> +       Simulated stack is flushed until simulatedStackPointer - 1, which
>> implies full flush
>> +       if popBoolean is true, else top value may not be flushed.
>> +       We spill the top value (the value to store) for the trampoline if
>> needed."
>> +       self assert: regHoldingObjectMutated == ReceiverResultReg.
>> +       self assert: scratchReg == TempReg.
>> +       self assert: regHoldingValueToStore == ClassReg.
>> +       mutableJump := self genJumpMutable: ClassReg scratchReg: TempReg.
>> +
>> +       "We reach this code if the object mutated is immutable."
>> +       "simulatedStack state altered for the trampoline, spill top value
>> if needed"
>> +       (popBoolean or: [ cogit ssTop spilled ]) ifFalse:
>> +               [ self assert: (cogit ssTop type = SSRegister and: [cogit
>> ssTop register = ClassReg]).
>> +                 cogit PushR: ClassReg ].
>> +       "pass the unboxed index using TempReg"
>> +       cogit MoveCq: index R: TempReg.
>> +       "trampoline call and mcpc to bcpc annotation."
>> +       cogit CallRT: ceCannotAssignToWithIndexTrampoline.
>> +       cogit annotateBytecode: cogit Label.
>> +       "Top of stack is consumed by the trampoline. In case of store
>> with non spilled value,
>> +       restore ClassReg to match simulated stack state"
>> +       (popBoolean or: [ cogit ssTop spilled ]) ifFalse:
>> +               [cogit popR: ClassReg].
>> +       "restore ReceiverResultReg state if needed"
>> +       needRestoreRcvr ifTrue: [ self putSelfInReceiverResultReg ].
>> +       fail := cogit Jump: 0.
>> +
>> +       "We reach this code is the object mutated is mutable"
>> +       mutableJump jmpTarget: cogit Label.
>> +
>> +       ^ fail!
>>
>> Item was added:
>> + ----- Method:
>> CogObjectRepresentationForSpur>>genJumpBaseHeaderImmutable: (in category
>> 'compile abstract instructions') -----
>> + genJumpBaseHeaderImmutable: baseHeaderReg
>> +       "baseHeader holds at least the least significant 32 bits of the
>> object"
>> +       <returnTypeC: #'AbstractInstruction *'>
>> +       <option: #IMMUTABILITY>
>> +       cogit TstCq: objectMemory immutableBitMask R: baseHeaderReg.
>> +       ^ cogit JumpNonZero: 0!
>>
>> Item was added:
>> + ----- Method: CogObjectRepresentationForSpur>>genJumpBaseHeaderMutable:
>> (in category 'compile abstract instructions') -----
>> + genJumpBaseHeaderMutable: baseHeaderReg
>> +       "baseHeader holds at least the least significant 32 bits of the
>> object"
>> +       <returnTypeC: #'AbstractInstruction *'>
>> +       <option: #IMMUTABILITY>
>> +       cogit TstCq: objectMemory immutableBitMask R: baseHeaderReg.
>> +       ^ cogit JumpZero: 0!
>>
>> Item was added:
>> + ----- Method:
>> CogObjectRepresentationForSpur>>genJumpImmutable:scratchReg: (in category
>> 'compile abstract instructions') -----
>> + genJumpImmutable: sourceReg scratchReg: scratchReg
>> +       <returnTypeC: #'AbstractInstruction *'>
>> +       <option: #IMMUTABILITY>
>> +       cogit MoveMw: 0 r: sourceReg R: scratchReg.
>> +       ^ self genJumpBaseHeaderImmutable: scratchReg!
>>
>> Item was added:
>> + ----- Method:
>> CogObjectRepresentationForSpur>>genJumpMutable:scratchReg: (in category
>> 'compile abstract instructions') -----
>> + genJumpMutable: sourceReg scratchReg: scratchReg
>> +       <returnTypeC: #'AbstractInstruction *'>
>> +       <option: #IMMUTABILITY>
>> +       cogit MoveMw: 0 r: sourceReg R: scratchReg.
>> +       ^ self genJumpBaseHeaderMutable: scratchReg!
>>
>> Item was changed:
>>   ----- Method:
>> CogObjectRepresentationForSpur>>genStoreCheckReceiverReg:valueReg:scratchReg:inFrame:
>> (in category 'compile abstract instructions') -----
>>   genStoreCheckReceiverReg: destReg valueReg: valueReg scratchReg:
>> scratchReg inFrame: inFrame
>>         "Generate the code for a store check of valueReg into destReg."
>>         | jmpImmediate jmpDestYoung jmpSourceOld jmpAlreadyRemembered
>> mask rememberedBitByteOffset |
>>         <var: #jmpImmediate type: #'AbstractInstruction *'>
>>         <var: #jmpDestYoung type: #'AbstractInstruction *'>
>>         <var: #jmpSourceOld type: #'AbstractInstruction *'>
>>         <var: #jmpAlreadyRemembered type: #'AbstractInstruction *'>
>>         "Is value stored an integer?  If so we're done"
>>         cogit MoveR: valueReg R: scratchReg.
>>         cogit AndCq: objectMemory tagMask R: scratchReg.
>>         jmpImmediate := cogit JumpNonZero: 0.
>>         "Get the old/new boundary in scratchReg"
>>         cogit MoveCw: objectMemory storeCheckBoundary R: scratchReg.
>>         "Is target young?  If so we're done"
>>         cogit CmpR: scratchReg R: destReg. "N.B. FLAGS := destReg -
>> scratchReg"
>>         jmpDestYoung := cogit JumpBelow: 0.
>>         "Is value stored old?  If so we're done."
>>         cogit CmpR: scratchReg R: valueReg. "N.B. FLAGS := valueReg -
>> scratchReg"
>>         jmpSourceOld := cogit JumpAboveOrEqual: 0.
>>         "value is young and target is old.
>>          Need to remember this only if the remembered bit is not already
>> set.
>>          Test the remembered bit.  Only need to fetch the byte containing
>> it,
>>          which reduces the size of the mask constant."
>>         rememberedBitByteOffset := jmpSourceOld isBigEndian
>>
>> ifTrue: [objectMemory baseHeaderSize - 1 - (objectMemory rememberedBitShift
>> // 8)]
>>
>> ifFalse:[objectMemory rememberedBitShift // 8].
>>         mask := 1 << (objectMemory rememberedBitShift \\ 8).
>>         cogit MoveMb: rememberedBitByteOffset r: destReg R: scratchReg.
>>         cogit AndCq: mask R: scratchReg.
>>         jmpAlreadyRemembered := cogit JumpNonZero: 0.
>>         "Remembered bit is not set.  Call store check to insert dest into
>> remembered table."
>>         self assert: destReg == ReceiverResultReg.
>> +       cogit
>> +               evaluateTrampolineCallBlock:
>> -       inFrame
>> -               ifTrue:
>>                         [cogit
>>                                 CallRT: ceStoreCheckTrampoline
>>                                 registersToBeSavedMask: (((cogit
>> registerMaskFor: valueReg)
>>
>>                       bitOr: cogit callerSavedRegMask)
>>
>>                       bitClear: (cogit registerMaskFor: ReceiverResultReg))]
>> +               protectLinkRegIfNot: inFrame.
>> -               ifFalse:
>> -                       [cogit backEnd saveAndRestoreLinkRegAround:
>> -                               [cogit
>> -                                       CallRT: ceStoreCheckTrampoline
>> -                                       registersToBeSavedMask: (((cogit
>> registerMaskFor: valueReg)
>> -
>>                                bitOr: cogit callerSavedRegMask)
>> -
>>                                bitClear: (cogit registerMaskFor:
>> ReceiverResultReg))]].
>>         jmpImmediate jmpTarget:
>>         (jmpDestYoung jmpTarget:
>>         (jmpSourceOld jmpTarget:
>>         (jmpAlreadyRemembered jmpTarget:
>>                 cogit Label))).
>>         ^0!
>>
>> Item was removed:
>> - ----- Method:
>> CogObjectRepresentationForSpur>>genStoreImmediateInSourceReg:slotIndex:destReg:
>> (in category 'compile abstract instructions') -----
>> - genStoreImmediateInSourceReg: sourceReg slotIndex: index destReg:
>> destReg
>> -       cogit MoveR: sourceReg
>> -                  Mw: index * objectMemory wordSize + objectMemory
>> baseHeaderSize
>> -                  r: destReg.
>> -       ^0!
>>
>> Item was removed:
>> - ----- Method:
>> CogObjectRepresentationForSpur>>genStoreSourceReg:slotIndex:destReg:scratchReg:
>> (in category 'compile abstract instructions') -----
>> - genStoreSourceReg: sourceReg slotIndex: index destReg: destReg
>> scratchReg: scratchReg
>> -       "do the store"
>> -       cogit MoveR: sourceReg
>> -                  Mw: index * objectMemory wordSize + objectMemory
>> baseHeaderSize
>> -                  r: destReg.
>> -       "now the check"
>> -       ^self genStoreCheckReceiverReg: destReg valueReg: sourceReg
>> scratchReg: scratchReg inFrame: true!
>>
>> Item was removed:
>> - ----- Method:
>> CogObjectRepresentationForSpur>>genStoreSourceReg:slotIndex:destReg:scratchReg:inFrame:
>> (in category 'compile abstract instructions') -----
>> - genStoreSourceReg: sourceReg slotIndex: index destReg: destReg
>> scratchReg: scratchReg inFrame: inFrame
>> -       "do the store"
>> -       cogit MoveR: sourceReg
>> -                  Mw: index * objectMemory wordSize + objectMemory
>> baseHeaderSize
>> -                  r: destReg.
>> -       "now the check"
>> -       ^self genStoreCheckReceiverReg: destReg valueReg: sourceReg
>> scratchReg: scratchReg inFrame: inFrame!
>>
>> Item was added:
>> + ----- Method:
>> CogObjectRepresentationForSpur>>genStoreSourceReg:slotIndex:destReg:scratchReg:inFrame:needsStoreCheck:
>> (in category 'compile abstract instructions') -----
>> + genStoreSourceReg: sourceReg slotIndex: index destReg: destReg
>> scratchReg: scratchReg inFrame: inFrame needsStoreCheck: needsStoreCheck
>> +       "do the store"
>> +       cogit MoveR: sourceReg
>> +                  Mw: index * objectMemory wordSize + objectMemory
>> baseHeaderSize
>> +                  r: destReg.
>> +       "now the check. needStoreCheck is false if the JIT has figured
>> out that the value stored does not need the check (immediate, nil, true,
>> false)"
>> +       needsStoreCheck ifTrue:
>> +               [ ^ self
>> +                       genStoreCheckReceiverReg: destReg
>> +                       valueReg: sourceReg
>> +                       scratchReg: scratchReg
>> +                       inFrame: inFrame ].
>> +       ^ 0!
>>
>> Item was changed:
>>   ----- Method:
>> CogObjectRepresentationForSpur>>genStoreSourceReg:slotIndex:intoNewObjectInDestReg:
>> (in category 'compile abstract instructions') -----
>>   genStoreSourceReg: sourceReg slotIndex: index intoNewObjectInDestReg:
>> destReg
>> +       "This method is used for unchecked stores in objects after their
>> creation (typically, inlined creation of Array, closures and some temp
>> vectors).
>> +       Currently there is no need to do the immutability check here"
>>         cogit MoveR: sourceReg
>>                    Mw: index * objectMemory wordSize + objectMemory
>> baseHeaderSize
>>                    r: destReg.
>>         ^0!
>>
>> Item was changed:
>>   ----- Method:
>> CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in
>> category 'initialization') -----
>>   generateObjectRepresentationTrampolines
>>         "Do the store check.  Answer the argument for the benefit of the
>> code generator;
>>          ReceiverResultReg may be caller-saved and hence smashed by this
>> call.  Answering
>>          it allows the code generator to reload ReceiverResultReg cheaply.
>>          In Spur the only thing we leave to the run-time is adding the
>> receiver to the
>>          remembered set and setting its isRemembered bit."
>> +       self
>> +               cppIf: IMMUTABILITY
>> +               ifTrue:
>> +                       [ "Arg1Reg is used as resultReg because cogit
>> needs to restore the valueToStore
>> +                       in the reg expected. The reg for the valueToStore
>> is dynamically allocated, but
>> +                       in most case, in the non-sista VM, it ends up
>> being Arg1Reg."
>> +                         ceCannotAssignToWithIndexTrampoline := cogit
>> +
>>  genTrampolineFor: #ceCannotAssignTo:withIndex:valueToAssign:
>> +
>>  called: 'ceCannotAssignToWithIndexTrampoline'
>> +
>>  arg: ReceiverResultReg
>> +
>>  arg: TempReg
>> +
>>  arg: ClassReg ].
>>         ceStoreCheckTrampoline := cogit
>>
>> genTrampolineFor: #remember:
>>
>> called: 'ceStoreCheckTrampoline'
>>
>> arg: ReceiverResultReg
>>
>> result: cogit returnRegForStoreCheck.
>>         ceStoreCheckContextReceiverTrampoline := self
>> genStoreCheckContextReceiverTrampoline.
>>         ceScheduleScavengeTrampoline := cogit
>>
>>               genSafeTrampolineFor: #ceScheduleScavenge
>>
>>               called: 'ceScheduleScavengeTrampoline'.
>>         ceSmallActiveContextInMethodTrampoline := self
>> genActiveContextTrampolineLarge: false inBlock: false called:
>> 'ceSmallMethodContext'.
>>         ceSmallActiveContextInBlockTrampoline := self
>> genActiveContextTrampolineLarge: false inBlock: true called:
>> 'ceSmallBlockContext'.
>>         ceLargeActiveContextInMethodTrampoline := self
>> genActiveContextTrampolineLarge: true inBlock: false called:
>> 'ceLargeMethodContext'.
>>         ceLargeActiveContextInBlockTrampoline := self
>> genActiveContextTrampolineLarge: true inBlock: true called:
>> 'ceLargeBlockContext'!
>>
>> Item was removed:
>> - ----- Method:
>> CogObjectRepresentationForSqueakV3>>genStoreImmediateInSourceReg:slotIndex:destReg:
>> (in category 'compile abstract instructions') -----
>> - genStoreImmediateInSourceReg: sourceReg slotIndex: index destReg:
>> destReg
>> -       cogit MoveR: sourceReg Mw: index * objectMemory wordSize +
>> objectMemory baseHeaderSize r: destReg.
>> -       ^0!
>>
>> Item was removed:
>> - ----- Method:
>> CogObjectRepresentationForSqueakV3>>genStoreSourceReg:slotIndex:destReg:scratchReg:inFrame:
>> (in category 'compile abstract instructions') -----
>> - genStoreSourceReg: sourceReg slotIndex: index destReg: destReg
>> scratchReg: scratchReg inFrame: inFrame
>> -       | jmpImmediate jmpDestYoung jmpSourceOld jmpAlreadyRoot mask
>> rootBitByteOffset |
>> -       <var: #jmpImmediate type: #'AbstractInstruction *'>
>> -       <var: #jmpDestYoung type: #'AbstractInstruction *'>
>> -       <var: #jmpSourceOld type: #'AbstractInstruction *'>
>> -       <var: #jmpAlreadyRoot type: #'AbstractInstruction *'>
>> -       "do the store"
>> -       cogit MoveR: sourceReg Mw: index * objectMemory wordSize +
>> objectMemory baseHeaderSize r: destReg.
>> -       "now the check.  Is value stored an integer?  If so we're done"
>> -       cogit MoveR: sourceReg R: scratchReg.
>> -       cogit AndCq: 1 R: scratchReg.
>> -       jmpImmediate := cogit JumpNonZero: 0.
>> -       "Get the old/new boundary in scratchReg"
>> -       cogit MoveAw: objectMemory youngStartAddress R: scratchReg.
>> -       "Is target young?  If so we're done"
>> -       cogit CmpR: scratchReg R: destReg. "N.B. FLAGS := destReg -
>> scratchReg"
>> -       jmpDestYoung := cogit JumpAboveOrEqual: 0.
>> -       "Is value stored old?  If so we're done."
>> -       cogit CmpR: scratchReg R: sourceReg. "N.B. FLAGS := sourceReg -
>> scratchReg"
>> -       jmpSourceOld := cogit JumpBelow: 0.
>> -       "value is young and target is old.
>> -        Need to make this a root if the root bit is not already set.
>> -        Test the root bit.  Only need to fetch the byte containing it,
>> -        which reduces the size of the mask constant."
>> -       rootBitByteOffset := jmpSourceOld isBigEndian
>> -                                                       ifTrue:
>> [objectMemory wordSize - RootBitDigitLength]
>> -
>>  ifFalse:[RootBitDigitLength - 1].
>> -       mask := RootBitDigitLength > 1
>> -                               ifTrue: [RootBit >> (RootBitDigitLength -
>> 1 * 8)]
>> -                               ifFalse: [RootBit].
>> -       cogit MoveMb: rootBitByteOffset r: destReg R: scratchReg.
>> -       cogit AndCq: mask R: scratchReg.
>> -       jmpAlreadyRoot := cogit JumpNonZero: 0.
>> -       "Root bit is not set.  Call store check to insert dest into root
>> table."
>> -       self assert: destReg == ReceiverResultReg.
>> -       inFrame
>> -               ifTrue:
>> -                       [cogit
>> -                               CallRT: ceStoreCheckTrampoline
>> -                               registersToBeSavedMask: (((cogit
>> registerMaskFor: sourceReg)
>> -
>>                        bitOr: cogit callerSavedRegMask)
>> -
>>                        bitClear: (cogit registerMaskFor:
>> ReceiverResultReg))]
>> -               ifFalse:
>> -                       [cogit backEnd saveAndRestoreLinkRegAround:
>> -                               [cogit
>> -                                       CallRT: ceStoreCheckTrampoline
>> -                                       registersToBeSavedMask: (((cogit
>> registerMaskFor: sourceReg)
>> -
>>                                bitOr: cogit callerSavedRegMask)
>> -
>>                                bitClear: (cogit registerMaskFor:
>> ReceiverResultReg))]].
>> -       jmpImmediate jmpTarget:
>> -       (jmpDestYoung jmpTarget:
>> -       (jmpSourceOld jmpTarget:
>> -       (jmpAlreadyRoot jmpTarget:
>> -               cogit Label))).
>> -       ^0!
>>
>> Item was added:
>> + ----- Method:
>> CogObjectRepresentationForSqueakV3>>genStoreSourceReg:slotIndex:destReg:scratchReg:inFrame:needsStoreCheck:
>> (in category 'compile abstract instructions') -----
>> + genStoreSourceReg: sourceReg slotIndex: index destReg: destReg
>> scratchReg: scratchReg inFrame: inFrame needsStoreCheck: needsStoreCheck
>> +       | jmpImmediate jmpDestYoung jmpSourceOld jmpAlreadyRoot mask
>> rootBitByteOffset |
>> +       <var: #jmpImmediate type: #'AbstractInstruction *'>
>> +       <var: #jmpDestYoung type: #'AbstractInstruction *'>
>> +       <var: #jmpSourceOld type: #'AbstractInstruction *'>
>> +       <var: #jmpAlreadyRoot type: #'AbstractInstruction *'>
>> +       "do the store"
>> +       cogit MoveR: sourceReg Mw: index * objectMemory wordSize +
>> objectMemory baseHeaderSize r: destReg.
>> +       "if no need for the store check then returns"
>> +       needsStoreCheck ifFalse: [ ^ 0 ].
>> +       "now the check.  Is value stored an integer?  If so we're done"
>> +       cogit MoveR: sourceReg R: scratchReg.
>> +       cogit AndCq: 1 R: scratchReg.
>> +       jmpImmediate := cogit JumpNonZero: 0.
>> +       "Get the old/new boundary in scratchReg"
>> +       cogit MoveAw: objectMemory youngStartAddress R: scratchReg.
>> +       "Is target young?  If so we're done"
>> +       cogit CmpR: scratchReg R: destReg. "N.B. FLAGS := destReg -
>> scratchReg"
>> +       jmpDestYoung := cogit JumpAboveOrEqual: 0.
>> +       "Is value stored old?  If so we're done."
>> +       cogit CmpR: scratchReg R: sourceReg. "N.B. FLAGS := sourceReg -
>> scratchReg"
>> +       jmpSourceOld := cogit JumpBelow: 0.
>> +       "value is young and target is old.
>> +        Need to make this a root if the root bit is not already set.
>> +        Test the root bit.  Only need to fetch the byte containing it,
>> +        which reduces the size of the mask constant."
>> +       rootBitByteOffset := jmpSourceOld isBigEndian
>> +                                                       ifTrue:
>> [objectMemory wordSize - RootBitDigitLength]
>> +
>>  ifFalse:[RootBitDigitLength - 1].
>> +       mask := RootBitDigitLength > 1
>> +                               ifTrue: [RootBit >> (RootBitDigitLength -
>> 1 * 8)]
>> +                               ifFalse: [RootBit].
>> +       cogit MoveMb: rootBitByteOffset r: destReg R: scratchReg.
>> +       cogit AndCq: mask R: scratchReg.
>> +       jmpAlreadyRoot := cogit JumpNonZero: 0.
>> +       "Root bit is not set.  Call store check to insert dest into root
>> table."
>> +       self assert: destReg == ReceiverResultReg.
>> +       cogit
>> +               evaluateTrampolineCallBlock:
>> +                       [cogit
>> +                               CallRT: ceStoreCheckTrampoline
>> +                               registersToBeSavedMask: (((cogit
>> registerMaskFor: sourceReg)
>> +
>>                        bitOr: cogit callerSavedRegMask)
>> +
>>                        bitClear: (cogit registerMaskFor:
>> ReceiverResultReg))]
>> +               protectLinkRegIfNot: inFrame.
>> +       jmpImmediate jmpTarget:
>> +       (jmpDestYoung jmpTarget:
>> +       (jmpSourceOld jmpTarget:
>> +       (jmpAlreadyRoot jmpTarget:
>> +               cogit Label))).
>> +       ^0!
>>
>> Item was changed:
>>   ----- Method: CogVMSimulator>>maybeCheckStackDepth:sp:pc: (in category
>> 'debug support') -----
>>   maybeCheckStackDepth: delta sp: sp pc: mcpc
>>         | asp bcpc startbcpc cogHomeMethod cogBlockMethod csp
>> debugStackPointers |
>>         debugStackDepthDictionary ifNil: [^self].
>>         (self isMachineCodeFrame: framePointer) ifFalse: [^self].
>>         cogBlockMethod := self mframeCogMethod: framePointer.
>>         cogHomeMethod := self asCogHomeMethod: cogBlockMethod.
>>         debugStackPointers := debugStackDepthDictionary
>>                                                                 at:
>> cogHomeMethod methodObject
>>
>> ifAbsentPut: [self debugStackPointersFor: cogHomeMethod methodObject].
>>         startbcpc := cogHomeMethod = cogBlockMethod
>>                                         ifTrue: [self startPCOfMethod:
>> cogHomeMethod methodObject]
>>                                         ifFalse: [self startPCOfClosure:
>> (self pushedReceiverOrClosureOfFrame: framePointer)].
>>         bcpc := cogit bytecodePCFor: mcpc startBcpc: startbcpc in:
>> cogBlockMethod.
>>         self assert: bcpc ~= 0.
>>         cogBlockMethod ~= cogHomeMethod ifTrue:
>>                 [| lastbcpc |
>>                  lastbcpc := cogit lastBytecodePCForBlockAt: startbcpc
>> in: cogHomeMethod methodObject.
>>                  bcpc > lastbcpc ifTrue:
>>                         [bcpc := lastbcpc]].
>>         asp := self stackPointerIndexForFrame: framePointer WithSP: sp +
>> objectMemory wordSize.
>>         csp := debugStackPointers at: bcpc.
>>         "Compensate lazily for absent receiver sends."
>>         (NewspeakVM
>>          and: [asp - delta = csp
>>          and: [cogit isAbsentReceiverSendAt: mcpc in: cogHomeMethod]])
>> ifTrue:
>>                 [csp := debugStackPointers at: bcpc put: csp + 1].
>>         self assert: asp - delta + 1 = csp!
>>
>> Item was added:
>> + ----- Method:
>> CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>immutableBitMask
>> (in category 'accessing') -----
>> + immutableBitMask
>> +       ^objectMemory immutableBitMask!
>>
>> Item was added:
>> + ----- Method: InterpreterPrimitives>>canBeImmutable: (in category
>> 'object access primitives') -----
>> + canBeImmutable: oop
>> +       <option: #IMMUTABILITY>
>> +       | scheduler processLists |
>> +
>> +       self assert: (objectMemory isNonImmediate: oop).
>> +
>> +       "For now we fail the primitive for contexts to we ensure there
>> are no immutable contexts.
>> +       Later we can consider having immutable contexts and send
>> cannotReturn callback
>> +       when returning to an immutable context. That would mean that
>> setting a context
>> +       to immutable would require a divorce and returns to immutable
>> context are
>> +       necessarily across stack pages"
>> +       (objectMemory isContext: oop) ifTrue: [ ^ false ].
>> +
>> +       "I don't get it for semaphores so they can't be immutable"
>> +       (objectMemory isSemaphoreObj: oop) ifTrue: [^ false].
>> +
>> +       "simple version of process management: we forbid Process and
>> LinkedList instances to be immutable
>> +       as well as the Processor and the array of activeProcess"
>> +       scheduler := self fetchPointer: ValueIndex ofObject: (self
>> splObj: SchedulerAssociation).
>> +       processLists := objectMemory fetchPointer: ProcessListsIndex
>> ofObject: scheduler.
>> +       oop = scheduler ifTrue: [ ^ false ].
>> +       oop = processLists ifTrue: [ ^ false ].
>> +       "Is it a linkedList ?"
>> +       (objectMemory classIndexOf: (processLists at: 1)) = (objectMemory
>> classIndexOf: oop) ifTrue: [ ^ false ].
>> +       "is it a Process ?"
>> +       (objectMemory classIndexOf: (objectMemory fetchPointer:
>> ActiveProcessIndex ofObject: scheduler)) =  (objectMemory classIndexOf:
>> oop) ifTrue: [ ^ false ].
>> +
>> +       "The rest of the code is relative to process management: the
>> Processor (the active
>> +       process scheduler) can't be immutable, as well as all the objects
>> relative to Process management "
>> +       "scheduler := self fetchPointer: ValueIndex ofObject: (self
>> splObj: SchedulerAssociation).
>> +       processLists := objectMemory fetchPointer: ProcessListsIndex
>> ofObject: scheduler.
>> +       ((objectMemory formatOf: oop) = objectMemory
>> nonIndexablePointerFormat)
>> +               ifFalse:
>> +                       [ (objectMemory isArrayNonImm: oop) ifFalse: [ ^
>> true ].
>> +                         ^ (oop = processLists) not ].
>> +       (objectMemory numSlotsOf: oop) >= 2 ifFalse: [ ^ true ].
>> +       ""is the oop the scheduler itself ?""
>> +       oop = scheduler ifTrue: [ ^ false ].
>> +       1 to: (objectMemory numSlotsOf: processLists) do: [ :i |
>> +               ""is the oop one of the linked lists ?""
>> +               (list := processLists at: i) = oop ifTrue: [^ false].
>> +               ""is the oop one of the runnable process ?""
>> +               first := objectMemory fetchPointer: FirstLinkIndex
>> ofObject: list.
>> +               first = objectMemory nilObject ifFalse:
>> +                       [ last := objectMemory fetchPointer:
>> LastLinkIndex ofObject: list.
>> +                         link := first.
>> +                         [ link = last ] whileFalse:
>> +                               [ link = oop ifTrue: [ ^ false ].
>> +                                 link := objectMemory fetchPointer:
>> NextLinkIndex ofObject: link. ] ] ]."
>> +       ^ true!
>>
>> Item was changed:
>>   ----- Method: InterpreterPrimitives>>primitiveFloatAtPut (in category
>> 'indexing primitives') -----
>>   primitiveFloatAtPut
>>         "Provide platform-independent access to 32-bit words comprising
>>          a Float.  Map index 1 onto the most significant word and index 2
>>          onto the least significant word."
>>         | rcvr index oopToStore valueToStore |
>>         <var: #valueToStore type: #usqInt>
>>         oopToStore := self stackTop.
>>         valueToStore := self positive32BitValueOf: oopToStore.
>>         self successful ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadArgument].
>>         rcvr := self stackValue: 2.
>>         index := self stackValue: 1.
>>         (objectMemory isImmediateFloat: rcvr) ifTrue:
>>                 [^self primitiveFailFor: PrimErrBadReceiver].
>> +       self cppIf: IMMUTABILITY
>> +               ifTrue: [ (objectMemory isImmutable: rcvr) ifTrue: [^self
>> primitiveFailFor: PrimErrBadReceiver] ].
>>         index = ConstOne ifTrue:
>>                 [objectMemory storeLong32: (VMBIGENDIAN ifTrue: [0]
>> ifFalse: [1])
>>                         ofObject: rcvr
>>                         withValue: valueToStore.
>>                 ^self pop: 3 thenPush: oopToStore].
>>         index = ConstTwo ifTrue:
>>                 [objectMemory storeLong32: (VMBIGENDIAN ifTrue: [1]
>> ifFalse: [0])
>>                         ofObject: rcvr
>>                         withValue: valueToStore.
>>                 ^self pop: 3 thenPush: oopToStore].
>>         self primitiveFailFor: ((objectMemory isIntegerObject: index)
>>                                                         ifTrue:
>> [PrimErrBadIndex]
>>                                                         ifFalse:
>> [PrimErrBadArgument])!
>>
>> Item was added:
>> + ----- Method: InterpreterPrimitives>>primitiveGetImmutability (in
>> category 'object access primitives') -----
>> + primitiveGetImmutability
>> +       <option: #IMMUTABILITY>
>> +       | rcvr bool |
>> +       rcvr := self stackValue: 0.
>> +       bool := (objectMemory isOopImmutable: rcvr)
>> +               ifTrue: [ TrueObject ]
>> +               ifFalse: [ FalseObject ].
>> +       self pop: argumentCount thenPush: (self splObj: bool)!
>>
>> Item was changed:
>>   ----- Method: InterpreterPrimitives>>primitiveIntegerAtPut (in category
>> 'sound primitives') -----
>>   primitiveIntegerAtPut
>>         "Return the 32bit signed integer contents of a words receiver"
>>         | index rcvr sz addr value valueOop |
>>         <var: 'value' type: 'int'>
>>         valueOop := self stackValue: 0.
>>         index := self stackIntegerValue: 1.
>>         value := self signed32BitValueOf: valueOop.
>>         self successful ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadArgument].
>>         rcvr := self stackValue: 2.
>>         (objectMemory isWords: rcvr) ifFalse:
>>                 [^self primitiveFailFor: PrimErrInappropriate].
>> +       self cppIf: IMMUTABILITY "isWords: ensure non immediate"
>> +               ifTrue: [ (objectMemory isImmutable: rcvr) ifTrue: [
>> ^self primitiveFailFor: PrimErrInappropriate ] ].
>>         sz := objectMemory lengthOf: rcvr.  "number of fields"
>>         (index >= 1 and: [index <= sz]) ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadIndex].
>>         "4 = 32 bits / 8"
>>         addr := rcvr + objectMemory baseHeaderSize + (index - 1 * 4).
>> "for zero indexing"
>>         value := objectMemory intAt: addr put: value.
>>         self pop: 3 thenPush: valueOop "pop all; return value"
>>   !
>>
>> Item was changed:
>>   ----- Method: InterpreterPrimitives>>primitiveObjectAtPut (in category
>> 'object access primitives') -----
>>   primitiveObjectAtPut
>>         "Store a literal into a CompiledMethod at the given index.
>> Defined for CompiledMethods only."
>>         | thisReceiver index newValue |
>>         newValue := self stackValue: 0.
>>         index := self stackValue: 1.
>>         ((objectMemory isNonIntegerObject: index)
>>          or: [index = ConstOne and: [(objectMemory isNonIntegerObject:
>> newValue)]]) ifTrue:
>>                 [^self primitiveFailFor: PrimErrBadArgument].
>>         index := objectMemory integerValueOf: index.
>>         thisReceiver := self stackValue: 2.
>> +       self cppIf: IMMUTABILITY
>> +               ifTrue: [ (objectMemory isImmutable: thisReceiver)
>> ifTrue: [ ^self primitiveFailFor: PrimErrInappropriate ] ].
>>         (index > 0 and: [index <= ((objectMemory literalCountOf:
>> thisReceiver) + LiteralStart)]) ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadIndex].
>>         objectMemory storePointer: index - 1 ofObject: thisReceiver
>> withValue: newValue.
>>         self pop: 3 thenPush: newValue!
>>
>> Item was added:
>> + ----- Method: InterpreterPrimitives>>primitiveSetImmutability (in
>> category 'object access primitives') -----
>> + primitiveSetImmutability
>> +       <option: #IMMUTABILITY>
>> +       | rcvr boolean wasImmutable |
>> +       rcvr := self stackValue: 1.
>> +       (objectMemory isImmediate: rcvr) ifTrue: [ ^ self
>> primitiveFailFor: PrimErrInappropriate ].
>> +       boolean := self booleanValueOf: self stackTop.
>> +       self successful ifFalse:
>> +               [^self primitiveFailFor: PrimErrBadArgument].
>> +       boolean ifTrue:
>> +               [ (self canBeImmutable: rcvr) ifFalse: [ ^ self
>> primitiveFailFor: PrimErrInappropriate ] ].
>> +       wasImmutable := (objectMemory isOopImmutable: rcvr)
>> +               ifTrue: [ TrueObject ]
>> +               ifFalse: [ FalseObject ].
>> +       objectMemory setIsImmutableOf: rcvr to: boolean.
>> +       self pop: argumentCount thenPush: (self splObj: wasImmutable)!
>>
>> Item was changed:
>>   ----- Method: InterpreterPrimitives>>primitiveShortAtPut (in category
>> 'sound primitives') -----
>>   primitiveShortAtPut
>>         "Treat the receiver, which can be indexible by either bytes or
>> words, as an array
>>          of signed 16-bit values. Set the contents of the given index to
>> the given value.
>>          Note that the index specifies the i-th 16-bit entry, not the
>> i-th byte or word."
>>
>>         | index rcvr value |
>>         value := self stackTop.
>>         index := self stackValue: 1.
>>         ((objectMemory isIntegerObject: value)
>>          and: [(objectMemory isIntegerObject: index)
>>          and: [value := objectMemory integerValueOf: value.
>>                   (value >= -32768) and: [value <= 32767]]]) ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadArgument].
>>         rcvr := self stackValue: 2.
>>         (objectMemory isWordsOrBytes: rcvr) ifFalse:
>>                 [^self primitiveFailFor: PrimErrInappropriate].
>> +       self cppIf: IMMUTABILITY "isWordsOrBytes ensure non immediate"
>> +               ifTrue: [ (objectMemory isImmutable: rcvr) ifTrue: [
>> ^self primitiveFailFor: PrimErrInappropriate ] ].
>>         index := objectMemory integerValueOf: index.
>>         (index >= 1 and: [index <= (objectMemory num16BitUnitsOf: rcvr)])
>> ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadIndex].
>>         objectMemory storeShort16: index - 1 ofObject: rcvr withValue:
>> value.
>>         self pop: 3 thenPush: (objectMemory integerObjectOf: value)!
>>
>> Item was added:
>> + ----- Method:
>> ObjectMemory>>storePointerImmutabilityCheck:ofObject:withValue: (in
>> category 'object access') -----
>> + storePointerImmutabilityCheck: index ofObject: rcvr withValue: top
>> +       <inline: true>
>> +       ^ self storePointer: index ofObject: rcvr withValue: top!
>>
>> Item was changed:
>>   ----- Method: SpurMemoryManager>>clone: (in category 'allocation') -----
>>   clone: objOop
>>         | numSlots fmt newObj |
>>         numSlots := self numSlotsOf: objOop.
>>         fmt := self formatOf: objOop.
>>         numSlots > self maxSlotsForNewSpaceAlloc
>>                 ifTrue:
>>                         [newObj := self allocateSlotsInOldSpace: numSlots
>>                                                         format: fmt
>>                                                         classIndex: (self
>> classIndexOf: objOop)]
>>                 ifFalse:
>>                         [newObj := self allocateSlots: numSlots
>>                                                         format: fmt
>>                                                         classIndex: (self
>> classIndexOf: objOop)].
>>         newObj ifNil:
>>                 [^0].
>>         (self isPointersFormat: fmt)
>>                 ifTrue:
>>                         [| hasYoung |
>>                          hasYoung := false.
>>                          0 to: numSlots - 1 do:
>>                                 [:i| | oop |
>>                                 oop := self fetchPointer: i ofObject:
>> objOop.
>>                                 (self isNonImmediate: oop) ifTrue:
>>                                         [(self isForwarded: oop) ifTrue:
>>                                                 [oop := self
>> followForwarded: oop].
>>                                         ((self isNonImmediate: oop)
>>                                          and: [self isYoungObject: oop])
>> ifTrue:
>>                                                 [hasYoung := true]].
>>                                 self storePointerUnchecked: i
>>                                         ofObject: newObj
>>                                         withValue: oop].
>>                         (hasYoung
>>                          and: [(self isYoungObject: newObj) not]) ifTrue:
>>                                 [scavenger remember: newObj]]
>>                 ifFalse:
>>                         [0 to: numSlots - 1 do:
>>                                 [:i|
>>                                 self storePointerUnchecked: i
>>                                         ofObject: newObj
>>                                         withValue: (self fetchPointer: i
>> ofObject: objOop)].
>>                          fmt >= self firstCompiledMethodFormat ifTrue:
>>                                 [coInterpreter
>> maybeFixClonedCompiledMethod: newObj.
>>                                  ((self isOldObject: newObj)
>>                                   and: [(self isYoungObject: objOop) or:
>> [self isRemembered: objOop]]) ifTrue:
>>                                         [scavenger remember: newObj]]].
>>         ^newObj!
>>
>> Item was changed:
>>   ----- Method: SpurMemoryManager>>containsOnlyValidBecomeObjects: (in
>> category 'become implementation') -----
>>   containsOnlyValidBecomeObjects: array
>>         "Answer 0 if the array contains only unpinned non-immediates.
>>          Otherwise answer an informative error code.
>>          Can't become: immediates!!  Shouldn't become pinned objects."
>> +       | fieldOffset effectsFlags oop errCode |
>> -       | fieldOffset effectsFlags oop |
>>         fieldOffset := self lastPointerOfArray: array.
>>         effectsFlags := 0.
>>         "same size as array2"
>>         [fieldOffset >= self baseHeaderSize] whileTrue:
>>                 [oop := self longAt: array + fieldOffset.
>>                  (self isOopForwarded: oop) ifTrue:
>>                         [oop := self followForwarded: oop.
>>                          self longAt: array + fieldOffset put: oop].
>> +                (errCode := self isOopValidBecome: oop) = 0 ifFalse: [^
>> errCode].
>> -                (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
>> -                (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
>>                  effectsFlags := effectsFlags bitOr: (self
>> becomeEffectFlagsFor: oop).
>>                  fieldOffset := fieldOffset - self bytesPerOop].
>>         "only set flags after checking all args."
>>         becomeEffectsFlags := effectsFlags.
>>         ^0!
>>
>> Item was changed:
>>   ----- Method: SpurMemoryManager>>forward:to: (in category 'become
>> implementation') -----
>>   forward: obj1 to: obj2
>>         self set: obj1 classIndexTo: self isForwardedObjectClassIndexPun
>> formatTo: self forwardedFormat.
>> +       self cppIf: IMMUTABILITY ifTrue: [ self setIsImmutableOf: obj1
>> to: false ].
>>         self storePointer: 0 ofForwarder: obj1 withValue: obj2.
>>         "For safety make sure the forwarder has a slot count that
>> includes its contents."
>>         (self rawNumSlotsOf: obj1) = 0 ifTrue:
>>                 [self rawNumSlotsOf: obj1 put: 1]!
>>
>> Item was added:
>> + ----- Method: SpurMemoryManager>>immutableBitMask (in category 'header
>> format') -----
>> + immutableBitMask
>> +       "mask the immutable bit in the base header word"
>> +       <option: #IMMUTABILITY>
>> +       ^ 1 << self immutableBitShift!
>>
>> Item was added:
>> + ----- Method: SpurMemoryManager>>isOopValidBecome: (in category 'become
>> implementation') -----
>> + isOopValidBecome: oop
>> +       "Answers 0 if the oop can be become.
>> +       Answers an error code in the other case"
>> +       (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
>> +       (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
>> +       self
>> +               cppIf: IMMUTABILITY
>> +               ifTrue: [ (self isImmutable: oop) ifTrue:
>> [^PrimErrInappropriate] ].
>> +       ^ 0!
>>
>> Item was added:
>> + ----- Method:
>> SpurMemoryManager>>storePointerImmutabilityCheck:ofObject:withValue: (in
>> category 'object access') -----
>> + storePointerImmutabilityCheck: fieldIndex ofObject: objOop withValue:
>> valuePointer
>> +       "Note must check here for stores of young objects into old ones."
>> +       <inline: true> "normal send in cannotAssign"
>> +
>> +       self cppIf: IMMUTABILITY ifTrue:
>> +               [ self assert: (self isImmediate: objOop) not.
>> +               (self isImmutable: objOop) ifTrue:
>> +                       [ ^ coInterpreter cannotAssign: valuePointer to:
>> objOop withIndex: fieldIndex ] ].
>> +
>> +       ^ self storePointer: fieldIndex ofObject: objOop withValue:
>> valuePointer!
>>
>> Item was changed:
>>   ----- Method: StackInterpreter class>>initializePrimitiveTable (in
>> category 'initialization') -----
>> (excessive size, no diff calculated)
>>
>> Item was changed:
>>   ----- Method: StackInterpreter>>bytecodePrimAtPut (in category 'common
>> selector sends') -----
>>   bytecodePrimAtPut
>>         "BytecodePrimAtPut will only succeed if the receiver is in the
>> atCache.
>>         Otherwise it will fail so that the more general primitiveAtPut
>> will put it in the
>>         cache after validating that message lookup results in a primitive
>> response.
>>          Override to insert in the atCache here.  This is necessary since
>> once there
>>          is a compiled at:[put:] primitive method (which doesn't use the
>> at: cache) the
>>          only way something can get installed in the atCache is here."
>> +       | index rcvr atIx value correctRcvr |
>> -       | index rcvr atIx value |
>>         value := self internalStackTop.
>>         index := self internalStackValue: 1.
>>         rcvr := self internalStackValue: 2.
>> +       self cppIf: IMMUTABILITY
>> +               ifTrue: [ correctRcvr := objectMemory isOopMutable: rcvr ]
>> +               ifFalse: [ correctRcvr := objectMemory isNonImmediate:
>> rcvr ].
>> +       (correctRcvr
>> -       ((objectMemory isNonImmediate: rcvr)
>>          and: [objectMemory isIntegerObject: index]) ifTrue:
>>                 [atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase.  "Index
>> into atPutCache"
>>                  (atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
>>                         [lkupClassTag := objectMemory
>> fetchClassTagOfNonImm: rcvr.
>>                          messageSelector := self specialSelector: 17.
>>                          (self lookupInMethodCacheSel: messageSelector
>> classTag: lkupClassTag) ifFalse:
>>                                 [argumentCount := 2.
>>                                  ^self commonSendOrdinary].
>>                          primitiveFunctionPointer == #primitiveAtPut
>>                                 ifTrue: [self install: rcvr inAtCache:
>> atCache at: atIx string: false]
>>                                 ifFalse:
>>                                         [primitiveFunctionPointer ==
>> #primitiveStringAtPut
>>                                                 ifTrue: [self install:
>> rcvr inAtCache: atCache at: atIx string: true]
>>                                                 ifFalse:
>>                                                         [argumentCount :=
>> 2.
>>                                                          ^self
>> commonSendOrdinary]]].
>>                  self successful ifTrue:
>>                         [self commonVariable: rcvr at: (objectMemory
>> integerValueOf: index) put: value cacheIndex: atIx].
>>                  self successful ifTrue:
>>                         [self fetchNextBytecode.
>>                          ^self internalPop: 3 thenPush: value].
>>                  self initPrimCall].
>>
>>         messageSelector := self specialSelector: 17.
>>         argumentCount := 2.
>>         self normalSend!
>>
>> Item was added:
>> + ----- Method: StackInterpreter>>cannotAssign:to:withIndex: (in category
>> 'stack bytecodes') -----
>> + cannotAssign: resultObj to: targetObj withIndex: index
>> +       <option: #IMMUTABILITY>
>> +       <inline: true> "because of use of normalSend..."
>> +       self internalPush: targetObj.
>> +       self internalPush: resultObj.
>> +       self internalPush: (self integerObjectOf: index + 1).
>> +       messageSelector := self splObj: SelectorAttemptToAssign.
>> +       argumentCount := 2.
>> +       ^ self normalSend!
>>
>> Item was changed:
>>   ----- Method: StackInterpreter>>commonAtPut: (in category 'indexing
>> primitive support') -----
>>   commonAtPut: stringy
>>         "This code is called if the receiver responds primitively to
>> at:Put:.
>>          N.B. this does *not* use the at cache, instead inlining
>> stObject:at:put:.
>>          Using the at cache here would require that callers set
>> messageSelector
>>          and lkupClass and that is onerous and error-prone, and in any
>> case,
>>          inlining produces much better performance than using the at
>> cache here."
>> +       | value index rcvr badRcvr |
>> -       | value index rcvr |
>>         <inline: true> "to get it inlined in primitiveAtPut and
>> primitiveStringAtPut"
>>         self initPrimCall.
>>         rcvr := self stackValue: 2.
>>         index := self stackValue: 1.
>>         value := self stackTop.
>> +       self cppIf: IMMUTABILITY
>> +               ifTrue: [ badRcvr := objectMemory isOopImmutable: rcvr ]
>> +               ifFalse: [ badRcvr := objectMemory isImmediate: rcvr ].
>> +       badRcvr ifTrue:
>> -       (objectMemory isImmediate: rcvr) ifTrue:
>>                 [^self primitiveFailFor: PrimErrInappropriate].
>>         "No need to test for large positive integers here.  No object has
>> 1g elements"
>>         ((objectMemory isNonIntegerObject: index)
>>          or: [argumentCount > 2 "e.g. object:basicAt:put:"
>>                  and: [objectMemory isForwarded: rcvr]]) ifTrue:
>>                 [^self primitiveFailFor: PrimErrBadArgument].
>>         index := objectMemory integerValueOf: index.
>>         stringy
>>                 ifTrue: [self stObject: rcvr at: index put: (self
>> asciiOfCharacter: value)]
>>                 ifFalse: [self stObject: rcvr at: index put: value].
>>         self successful ifTrue:
>>                 [self pop: argumentCount+1 thenPush: value]!
>>
>> Item was changed:
>>   ----- Method: StackInterpreter>>extStoreAndPopLiteralVariableBytecode
>> (in category 'stack bytecodes') -----
>>   extStoreAndPopLiteralVariableBytecode
>>         "236            11101100        i i i i i i i i Pop and Store
>> Literal Variable #iiiiiiii (+ Extend A * 256)"
>> +       | variableIndex value |
>> +       variableIndex := self fetchByte + (extA << 8).
>> +       self fetchNextBytecode.
>> +       value := self internalStackTop.
>> +       self internalPop: 1.
>> +       extA := 0.
>> +       self storeLiteralVariable: variableIndex withValue: value!
>> -       self extStoreLiteralVariableBytecode.
>> -       self internalPop: 1!
>>
>> Item was changed:
>>   ----- Method: StackInterpreter>>extStoreAndPopReceiverVariableBytecode
>> (in category 'stack bytecodes') -----
>>   extStoreAndPopReceiverVariableBytecode
>>         "235            11101011        i i i i i i i i Pop and Store
>> Receiver Variable #iiiiiii (+ Extend A * 256)"
>> +       | variableIndex value |
>> +       variableIndex := self fetchByte + (extA << 8).
>> +       self fetchNextBytecode.
>> +       extA := 0.
>> +       value := self internalStackTop.
>> +       self internalPop: 1.
>> +       self storeMaybeContextReceiverVariable: variableIndex withValue:
>> value!
>> -       self extStoreReceiverVariableBytecode.
>> -       self internalPop: 1!
>>
>
>
> This used to read
>
> storeAndPopReceiverVariableBytecode
> | rcvr top |
> rcvr := self receiver.
> top := self internalStackTop.
> objectMemory storePointer: (currentBytecode bitAnd: 7) ofObject: rcvr
> withValue: top.
> self fetchNextBytecode.
> self internalPop: 1
>
> Note how currentBytecode is used before fetchNextBytecode.
>  fetchNextBytecode assigns currentBytecode:
>
> fetchNextBytecode
> "This method fetches the next instruction (bytecode). Each bytecode method
> is responsible for fetching the next bytecode, preferably as early as
> possible to allow the memory system time to process the request before the
> next dispatch."
>
> self cppIf: MULTIPLEBYTECODESETS
> ifTrue: [currentBytecode := self fetchByte + bytecodeSetSelector]
> ifFalse: [currentBytecode := self fetchByte]
>
> So your rewrite to
>
> storeAndPopReceiverVariableBytecode
> | rcvr top |
> rcvr := self receiver.
> top := self internalStackTop.
> self internalPop: 1.
> self fetchNextBytecode.
> objectMemory storePointerImmutabilityCheck: (currentBytecode bitAnd: 7)
> ofObject: rcvr withValue: top
>
> breaks things since currentBytecode is now that of the next bytecode and
> the wrong inst var will probably be assigned.  So you need to rewrite, e.g.
> like this:
>
> storeAndPopReceiverVariableBytecode
> | rcvr top |
> rcvr := self receiver.
> top := self internalStackTop.
> self internalPop: 1.
> self
> cCode: "Slang will inline currentBytecode to a constant so this will work
> in C"
> [self fetchNextBytecode.
> objectMemory
> storePointerImmutabilityCheck: (currentBytecode bitAnd: 7)
> ofObject: rcvr
> withValue: top]
> inSmalltalk: "But in Smalltalk we must use the currentBytecode's value,
> not the next"
> [| instVarIndex |
> instVarIndex := currentBytecode bitAnd: 7.
> self fetchNextBytecode.
> objectMemory
> storePointerImmutabilityCheck: instVarIndex
> ofObject: rcvr
> withValue: top]
>
> This needs to happen anywhere you use currentBytecode in the new
> immutability code.  We /don't/ want to use a variable to hold
> currentBytecode because that won't get inlined quite as nicely by Slang.
>
> Item was changed:
>>   ----- Method: StackInterpreter>>extendedStoreAndPopBytecode (in
>> category 'stack bytecodes') -----
>>   extendedStoreAndPopBytecode
>> +       <inline: true>
>> +       self extendedStoreBytecodePop: true
>> -
>> -       self extendedStoreBytecode.
>> -       self internalPop: 1.
>>   !
>>
>> Item was changed:
>>   ----- Method: StackInterpreter>>extendedStoreBytecode (in category
>> 'stack bytecodes') -----
>>   extendedStoreBytecode
>> -       | descriptor variableType variableIndex |
>>         <inline: true>
>> +       self extendedStoreBytecodePop: false!
>> -       descriptor := self fetchByte.
>> -       self fetchNextBytecode.
>> -       variableType := descriptor >> 6 bitAnd: 3.
>> -       variableIndex := descriptor bitAnd: 63.
>> -       variableType = 0 ifTrue:
>> -               [^objectMemory storePointer: variableIndex ofObject: self
>> receiver withValue: self internalStackTop].
>> -       variableType = 1 ifTrue:
>> -               [^self temporary: variableIndex in: localFP put: self
>> internalStackTop].
>> -       variableType = 3 ifTrue:
>> -               [^self storeLiteralVariable: variableIndex withValue:
>> self internalStackTop].
>> -       self error: 'illegal store'!
>>
>> Item was added:
>> + ----- Method: StackInterpreter>>extendedStoreBytecodePop: (in category
>> 'stack bytecodes') -----
>> + extendedStoreBytecodePop: popBoolean
>> +       | descriptor variableType variableIndex value |
>> +       <inline: true>
>> +       descriptor := self fetchByte.
>> +       self fetchNextBytecode.
>> +       variableType := descriptor >> 6 bitAnd: 3.
>> +       variableIndex := descriptor bitAnd: 63.
>> +       value := self internalStackTop.
>> +       popBoolean ifTrue: [ self internalPop: 1 ].
>> +       variableType = 0 ifTrue:
>> +               [^objectMemory storePointerImmutabilityCheck:
>> variableIndex ofObject: self receiver withValue: value].
>> +       variableType = 1 ifTrue:
>> +               [^self temporary: variableIndex in: localFP put: value].
>> +       variableType = 3 ifTrue:
>> +               [^self storeLiteralVariable: variableIndex withValue:
>> value].
>> +       self error: 'illegal store'
>> + !
>>
>> Item was changed:
>>   ----- Method: StackInterpreter>>storeAndPopReceiverVariableBytecode (in
>> category 'stack bytecodes') -----
>>   storeAndPopReceiverVariableBytecode
>>         "Note: This code uses
>>         storePointerUnchecked:ofObject:withValue: and does the
>>         store check explicitely in order to help the translator
>>         produce better code."
>>         | rcvr top |
>>         rcvr := self receiver.
>>         top := self internalStackTop.
>> +       self internalPop: 1.
>> -       objectMemory storePointer: (currentBytecode bitAnd: 7) ofObject:
>> rcvr withValue: top.
>>         self fetchNextBytecode.
>> +       objectMemory storePointerImmutabilityCheck: (currentBytecode
>> bitAnd: 7) ofObject: rcvr withValue: top.!
>> -       self internalPop: 1!
>>
>> Item was changed:
>>   ----- Method: StackInterpreter>>storeLiteralVariable:withValue: (in
>> category 'stack bytecodes') -----
>>   storeLiteralVariable: literalIndex withValue: anObject
>>         | litVar |
>>         litVar := self literal: literalIndex.
>>         "push/store/popLiteralVariable all fetch a literal, and either
>> read or write the literal's value field.
>>          The fetch of the literal needs an explicit check (otherwise we
>> would have to scan all literals in
>>          all methods in the stack zone, and the entire method on return,
>> and global variables are relatively
>>          rare; in my work image 8.7% of literals are globals)."
>>
>>         (objectMemory isForwarded: litVar) ifTrue:
>>                 [litVar := objectMemory followForwarded: litVar].
>> +       ^objectMemory storePointerImmutabilityCheck: ValueIndex ofObject:
>> litVar withValue: anObject!
>> -       ^objectMemory storePointer: ValueIndex ofObject: litVar
>> withValue: anObject!
>>
>> Item was changed:
>>   ----- Method:
>> StackInterpreter>>storeMaybeContextReceiverVariable:withValue: (in category
>> 'stack bytecodes') -----
>>   storeMaybeContextReceiverVariable: fieldIndex withValue: anObject
>>         "Must trap accesses to married and widowed contexts.
>>          But don't want to check on all inst var accesses.  This
>>          method is only used by the long-form bytecodes, evading the
>> cost."
>>         | rcvr |
>>         rcvr := self receiver.
>>         ((self isWriteMediatedContextInstVarIndex: fieldIndex)
>>         and: [(objectMemory isContextNonImm: rcvr)
>>         and: [self isMarriedOrWidowedContext: rcvr]])
>>                 ifTrue:
>>                         [self instVar: fieldIndex ofContext: rcvr put:
>> anObject]
>>                 ifFalse:
>> +                       [objectMemory storePointerImmutabilityCheck:
>> fieldIndex ofObject: rcvr withValue: anObject]
>> -                       [objectMemory storePointer: fieldIndex ofObject:
>> rcvr withValue: anObject]
>>   !
>>
>> Item was changed:
>>   ----- Method: StackInterpreter>>trinaryInlinePrimitive: (in category
>> 'miscellaneous bytecodes') -----
>>   trinaryInlinePrimitive: primIndex
>>         "SistaV1:       248             11111000        iiiiiiii
>>       mjjjjjjj                Call Primitive #iiiiiiii + (jjjjjjj * 256)
>> m=1 means inlined primitive, no hard return after execution."
>>         <option: #SistaVM>
>>         | result |
>>         primIndex caseOf: {
>>
>>                 "3000   unchecked Pointer Object>>at:put:.
>>       The receiver is guaranteed to be a pointer object.  The 0-relative
>> (1-relative?) index is an in-range SmallInteger"
>>                 [0]     ->      [result := self internalStackTop.
>>                                  objectMemory
>>                                         storePointer: (objectMemory
>> integerValueOf: (self internalStackValue: 1)) - 1
>>                                         ofObject: (self
>> internalStackValue: 2)
>>                                         withValue: result.
>>                                  self internalPop: 2;
>> internalStackTopPut: result].
>>                 "3001   unchecked Byte Object>>at:put:.
>>  The receiver is guaranteed to be a non-pointer object.  The 0-relative
>> (1-relative?) index is an in-range SmallInteger.  The argument is a
>> SmallInteger.  The primitive stores the least significant 8 bits."
>>                 [1]     ->      [result := self internalStackTop.
>>                                  objectMemory
>>                                         storeByte: (objectMemory
>> integerValueOf: (self internalStackValue: 1)) - 1
>>                                         ofObject: (self
>> internalStackValue: 2)
>>                                         withValue: (objectMemory
>> integerValueOf: result).
>>                                  self internalPop: 2;
>> internalStackTopPut: result].
>>                 "3002   unchecked Word Object>>at:put:.
>>  The receiver is guaranteed to be a non-pointer object.  The 0-relative
>> (1-relative?) index is an in-range SmallInteger.  The argument is a
>> SmallInteger.  The primitive stores the least significant 16 bits."
>>                 [2]     ->      [result := self internalStackTop.
>>                                  objectMemory
>>                                         storeShort16: (objectMemory
>> integerValueOf: (self internalStackValue: 1)) - 1
>>                                         ofObject: (self
>> internalStackValue: 2)
>>                                         withValue: (objectMemory
>> integerValueOf: result).
>>                                  self internalPop: 2;
>> internalStackTopPut: result].
>>                 "3003   unchecked DoubleWord Object>>at:put:.   The
>> receiver is guaranteed to be a non-pointer object.  The 0-relative
>> (1-relative?) index is an in-range SmallInteger.  The argument is a
>> SmallInteger.  The primitive stores the least significant 32 bits."
>>                 [3]     ->      [result := self internalStackTop.
>>                                  objectMemory
>>                                         storeLong32: (objectMemory
>> integerValueOf: (self internalStackValue: 1)) - 1
>>                                         ofObject: (self
>> internalStackValue: 2)
>>                                         withValue: (objectMemory
>> integerValueOf: result).
>>                                  self internalPop: 2;
>> internalStackTopPut: result].
>>                 "3004   unchecked QuadWord Object>>at:put:.
>>  The receiver is guaranteed to be a non-pointer object.  The 0-relative
>> (1-relative?) index is an in-range SmallInteger.  The argument is a
>> SmallInteger.  The primitive stores the least significant 64 bits."
>>                 [4]     ->      [result := self internalStackTop.
>>                                  objectMemory
>>                                         storeLong64: (objectMemory
>> integerValueOf: (self internalStackValue: 1)) - 1
>>                                         ofObject: (self
>> internalStackValue: 2)
>>                                         withValue: (objectMemory
>> integerValueOf: result).
>>                                  self internalPop: 2;
>> internalStackTopPut: result] }
>>         otherwise:
>>                 [localIP := localIP - 3.
>>                  self respondToUnknownBytecode]!
>>
>> Item was changed:
>>   ----- Method: StackInterpreterPrimitives>>primitiveInstVarAt (in
>> category 'object access primitives') -----
>>   primitiveInstVarAt
>>         | index rcvr hdr fmt totalLength fixedFields value |
>>         index := self stackTop.
>>         rcvr := self stackValue: 1.
>>         ((objectMemory isNonIntegerObject: index)
>>          or: [argumentCount > 1 "e.g. object:instVarAt:"
>>                 and: [objectMemory isOopForwarded: rcvr]]) ifTrue:
>>                 [^self primitiveFailFor: PrimErrBadArgument].
>> +       (objectMemory isImmediate: rcvr) ifTrue: [^self primitiveFailFor:
>> PrimErrInappropriate].
>>         index := objectMemory integerValueOf: index.
>>         hdr := objectMemory baseHeader: rcvr.
>>         fmt := objectMemory formatOfHeader: hdr.
>>         totalLength := objectMemory lengthOf: rcvr baseHeader: hdr
>> format: fmt.
>>         fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt
>> length: totalLength.
>>         (index >= 1 and: [index <= fixedFields]) ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadIndex].
>>         (fmt = objectMemory indexablePointersFormat
>>          and: [objectMemory isContextHeader: hdr])
>>                 ifTrue: [value := self externalInstVar: index - 1
>> ofContext: rcvr]
>>                 ifFalse: [value := self subscript: rcvr with: index
>> format: fmt].
>>         self pop: argumentCount + 1 thenPush: value!
>>
>> Item was changed:
>>   ----- Method: StackInterpreterPrimitives>>primitiveInstVarAtPut (in
>> category 'object access primitives') -----
>>   primitiveInstVarAtPut
>>         | newValue index rcvr hdr fmt totalLength fixedFields |
>>         newValue := self stackTop.
>>         index := self stackValue: 1.
>>         rcvr := self stackValue: 2.
>>         ((objectMemory isNonIntegerObject: index)
>>          or: [argumentCount > 2 "e.g. object:instVarAt:put:"
>>                 and: [objectMemory isOopForwarded: rcvr]]) ifTrue:
>>                 [^self primitiveFailFor: PrimErrBadArgument].
>> +       self cppIf: IMMUTABILITY
>> +               ifTrue: [ (objectMemory isOopImmutable: rcvr) ifTrue:
>> [^self primitiveFailFor: PrimErrInappropriate] ]
>> +               ifFalse: [ (objectMemory isImmediate: rcvr) ifTrue:
>> [^self primitiveFailFor: PrimErrInappropriate] ].
>>         index := objectMemory integerValueOf: index.
>>         hdr := objectMemory baseHeader: rcvr.
>>         fmt := objectMemory formatOfHeader: hdr.
>>         totalLength := objectMemory lengthOf: rcvr baseHeader: hdr
>> format: fmt.
>>         fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt
>> length: totalLength.
>>         (index >= 1 and: [index <= fixedFields]) ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadIndex].
>>         (fmt = objectMemory indexablePointersFormat
>>          and: [objectMemory isContextHeader: hdr])
>>                 ifTrue: [self externalInstVar: index - 1 ofContext: rcvr
>> put: newValue]
>>                 ifFalse: [self subscript: rcvr with: index storing:
>> newValue format: fmt].
>>         self pop: argumentCount + 1 thenPush: newValue!
>>
>> Item was changed:
>>   ----- Method: StackInterpreterPrimitives>>primitiveSlotAtPut (in
>> category 'object access primitives') -----
>>   primitiveSlotAtPut
>>         "Assign a slot in an object.  This numbers all slots from 1,
>> ignoring the distinction between
>>          named and indexed inst vars.  In objects with both named and
>> indexed inst vars, the named
>>          inst vars precede the indexed ones.  In non-object indexed
>> objects (objects that contain
>>          bits, not object references) this primitive assigns a raw
>> integral value at each slot."
>> +       | newValue index rcvr fmt numSlots value badRcvr |
>> -       | newValue index rcvr fmt numSlots value |
>>         newValue := self stackTop.
>>         index := self stackValue: 1.
>>         rcvr := self stackValue: 2.
>>         (objectMemory isIntegerObject: index) ifFalse:
>>                 [^self primitiveFailFor: PrimErrBadArgument].
>> +       self cppIf: IMMUTABILITY
>> +               ifTrue: [ badRcvr := objectMemory isOopImmutable: rcvr ]
>> +               ifFalse: [ badRcvr := objectMemory isImmediate: rcvr ].
>> +       badRcvr ifTrue:
>> -       (objectMemory isImmediate: rcvr) ifTrue:
>>                 [^self primitiveFailFor: PrimErrBadReceiver].
>>         fmt := objectMemory formatOf: rcvr.
>>         index := (objectMemory integerValueOf: index) - 1.
>>
>>         fmt <= objectMemory lastPointerFormat ifTrue:
>>                 [numSlots := objectMemory numSlotsOf: rcvr.
>>                  (self asUnsigned: index) < numSlots ifTrue:
>>                         [(objectMemory isContextNonImm: rcvr)
>>                                 ifTrue: [self externalInstVar: index
>> ofContext: rcvr put: newValue]
>>                                 ifFalse: [objectMemory storePointer:
>> index ofObject: rcvr withValue: newValue].
>>                          self pop: argumentCount + 1 thenPush: newValue.
>>                          ^0].
>>                  ^self primitiveFailFor: PrimErrBadIndex].
>>
>>         value := self positiveMachineIntegerValueOf: newValue.
>>         self failed ifTrue:
>>                 [primFailCode := PrimErrBadArgument.
>>                 ^0].
>>
>>         fmt >= objectMemory firstByteFormat ifTrue:
>>                 [fmt >= objectMemory firstCompiledMethodFormat ifTrue:
>>                         [^self primitiveFailFor: PrimErrUnsupported].
>>                  (self asUnsigned: value) > 16rFF ifTrue:
>>                         [^self primitiveFailFor: PrimErrBadArgument].
>>                  numSlots := objectMemory numBytesOfBytes: rcvr.
>>                  (self asUnsigned: index) < numSlots ifTrue:
>>                         [objectMemory storeByte: index ofObject: rcvr
>> withValue: value.
>>                          self pop: argumentCount + 1 thenPush: newValue.
>>                          ^0].
>>                  ^self primitiveFailFor: PrimErrBadIndex].
>>
>>         (objectMemory hasSpurMemoryManagerAPI
>>          and: [fmt >= objectMemory firstShortFormat]) ifTrue:
>>                 [(self asUnsigned: value) > 16rFFFF ifTrue:
>>                         [^self primitiveFailFor: PrimErrBadArgument].
>>                  numSlots := objectMemory num16BitUnitsOf: rcvr.
>>                  (self asUnsigned: index) < numSlots ifTrue:
>>                         [objectMemory storeShort16: index ofObject: rcvr
>> withValue: value.
>>                          self pop: argumentCount + 1 thenPush: newValue.
>>                          ^0].
>>                  ^self primitiveFailFor: PrimErrBadIndex].
>>
>>         (objectMemory bytesPerOop = 8
>>          and: [fmt = objectMemory sixtyFourBitIndexableFormat]) ifTrue:
>>                 [numSlots := objectMemory num64BitUnitsOf: rcvr.
>>                  (self asUnsigned: index) < numSlots ifTrue:
>>                         [objectMemory storeLong64: index ofObject: rcvr
>> withValue: value.
>>                          self pop: argumentCount + 1 thenPush: newValue.
>>                          ^0].
>>                  ^self primitiveFailFor: PrimErrBadIndex].
>>
>>         fmt >= objectMemory firstLongFormat ifTrue:
>>                 [(objectMemory wordSize > 4
>>                   and: [(self asUnsigned: value) > 16rFFFFFFFF]) ifTrue:
>>                         [^self primitiveFailFor: PrimErrBadArgument].
>>                  numSlots := objectMemory num32BitUnitsOf: rcvr.
>>                  (self asUnsigned: index) < numSlots ifTrue:
>>                         [objectMemory storeLong32: index ofObject: rcvr
>> withValue: value.
>>                          self pop: argumentCount + 1 thenPush: newValue.
>>                          ^0].
>>                  ^self primitiveFailFor: PrimErrBadIndex].
>>
>>         ^self primitiveFailFor: PrimErrBadReceiver!
>>
>> Item was changed:
>>   ----- Method: StackToRegisterMappingCogit
>> class>>initializeBytecodeTableForNewspeakV4 (in category 'class
>> initialization') -----
>>   initializeBytecodeTableForNewspeakV4
>>         "StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV4"
>>
>>         numPushNilsFunction := #v4:Num:Push:Nils:.
>>         pushNilSizeFunction := #v4PushNilSize:numInitialNils:.
>>         NSSendIsPCAnnotated := true. "IsNSSendCall used by
>> SendAbsentImplicit"
>>         FirstSpecialSelector := 80.
>>         NumSpecialSelectors := 32.
>>         self flag:
>>   'Special selector send class must be inlined to agree with the
>> interpreter, which
>>    inlines class.  If class is sent to e.g. a general instance of
>> ProtoObject then unless
>>    class is inlined there will be an MNU.  It must be that the
>> Cointerpreter and Cogit
>>    have identical semantics.  We get away with not hardwiring the other
>> special
>>    selectors either because in the Cointerpreter they are not inlined or
>> because they
>>    are inlined only to instances of classes for which there will always
>> be a method.'.
>>         self generatorTableFrom: #(
>>                 "1 byte bytecodes"
>>                 (1    0   15 genPushReceiverVariableBytecode isInstVarRef
>> needsFrameNever: 1)
>>                 (1  16   31 genPushLiteralVariable16CasesBytecode
>> needsFrameNever: 1)
>>                 (1  32   63 genPushLiteralConstantBytecode
>> needsFrameNever: 1)
>>                 (1  64   75 genPushTemporaryVariableBytecode
>> needsFrameIfMod16GENumArgs: 1)
>>                 (1  76   76 genPushReceiverBytecode needsFrameNever: 1)
>>                 (1  77   77 genExtPushPseudoVariableOrOuterBytecode
>> needsFrameIfExtBGT2: 1)
>>                 (1  78   78 genPushConstantZeroBytecode needsFrameNever:
>> 1)
>>                 (1  79   79 genPushConstantOneBytecode needsFrameNever: 1)
>>
>>                 (1   80   80 genSpecialSelectorArithmetic isMapped AddRR)
>>                 (1   81   81 genSpecialSelectorArithmetic isMapped SubRR)
>>                 (1   82   82 genSpecialSelectorComparison isMapped
>> JumpLess)
>>                 (1   83   83 genSpecialSelectorComparison isMapped
>> JumpGreater)
>>                 (1   84   84 genSpecialSelectorComparison isMapped
>> JumpLessOrEqual)
>>                 (1   85   85 genSpecialSelectorComparison isMapped
>> JumpGreaterOrEqual)
>>                 (1   86   86 genSpecialSelectorComparison isMapped
>> JumpZero)
>>                 (1   87   87 genSpecialSelectorComparison isMapped
>> JumpNonZero)
>>                 (1   88   93 genSpecialSelectorSend isMapped)    " #* #/
>> #\\ #@ #bitShift: //"
>>                 (1   94   94 genSpecialSelectorArithmetic isMapped AndRR)
>>                 (1   95   95 genSpecialSelectorArithmetic isMapped OrRR)
>>                 (1   96 101 genSpecialSelectorSend isMapped) "#at:
>> #at:put: #size #next #nextPut: #atEnd"
>>                 (1 102 102 genSpecialSelectorEqualsEquals
>> needsFrameNever: notMapped -1) "not mapped because it is directly inlined
>> (for now)"
>>                 (1 103 103 genSpecialSelectorClass
>> needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is
>> directly inlined (for now)"
>>                 (1 104 111 genSpecialSelectorSend isMapped) "#blockCopy:
>> #value #value: #do: #new #new: #x #y"
>>
>>                 (1 112 127 genSendLiteralSelector0ArgsBytecode isMapped)
>>                 (1 128 143 genSendLiteralSelector1ArgBytecode isMapped)
>>                 (1 144 159 genSendLiteralSelector2ArgsBytecode isMapped)
>> +               (1 160 175      genSendAbsentImplicit0ArgsBytecode
>> isMapped hasIRC)),
>> +
>> +               "N.B. not frameless if immutability"
>> +               ((initializationOptions at: #IMMUTABILITY ifAbsent:
>> [false])
>> +                       ifTrue: [#((1 176 183
>> genStoreAndPopReceiverVariableBytecode isMapped isInstVarRef -1))]
>> +                       ifFalse: [#((1 176 183
>> genStoreAndPopReceiverVariableBytecode isInstVarRef needsFrameNever: -1))
>> ]),
>> +
>> +               #((1 184 191 genStoreAndPopTemporaryVariableBytecode)
>> -               (1 160 175      genSendAbsentImplicit0ArgsBytecode
>> isMapped hasIRC)
>>
>> -               (1 176 183 genStoreAndPopReceiverVariableBytecode
>> isInstVarRef needsFrameNever: -1) "N.B. not frameless if immutability"
>> -               (1 184 191 genStoreAndPopTemporaryVariableBytecode)
>> -
>>                 (1 192 199 genShortUnconditionalJump    branch
>> v3:ShortForward:Branch:Distance:)
>>                 (1 200 207 genShortJumpIfTrue                   branch
>> isBranchTrue isMapped "because of mustBeBoolean"
>>
>>                               v3:ShortForward:Branch:Distance:)
>>                 (1 208 215 genShortJumpIfFalse                  branch
>> isBranchFalse isMapped "because of mustBeBoolean"
>>
>>                               v3:ShortForward:Branch:Distance:)
>>
>>                 (1 216 216 genReturnReceiver
>> return needsFrameIfInBlock: isMappedInBlock 0)
>>                 (1 217 217 genReturnTopFromMethod               return
>> needsFrameIfInBlock: isMappedInBlock -1)
>>                 (1 218 218 genExtReturnTopFromBlock     return
>> needsFrameNever: -1)
>>
>>                 (1 219 219 duplicateTopBytecode
>>  needsFrameNever: 1)
>>                 (1 220 220 genPopStackBytecode
>> needsFrameNever: -1)
>>                 (1 221 221 genExtNopBytecode
>> needsFrameNever: 0)
>>                 (1 222 223      unknownBytecode)
>>
>>                 "2 byte bytecodes"
>>                 (2 224 224 extABytecode extension
>>                needsFrameNever: 0)
>>                 (2 225 225 extBBytecode extension
>>                needsFrameNever: 0)
>>                 (2 226 226 genExtPushReceiverVariableBytecode
>> isInstVarRef)
>>                 (2 227 227 genExtPushLiteralVariableBytecode
>> needsFrameNever: 1)
>>                 (2 228 228 genExtPushLiteralBytecode
>>               needsFrameNever: 1)
>>                 (2 229 229 genExtPushIntegerBytecode
>>       needsFrameNever: 1)
>>                 (2 230 230 genLongPushTemporaryVariableBytecode)
>>                 (2 231 231 genPushNewArrayBytecode)
>>                 (2 232 232 genExtStoreReceiverVariableBytecode
>> isInstVarRef)
>>                 (2 233 233 genExtStoreLiteralVariableBytecode)
>>                 (2 234 234 genLongStoreTemporaryVariableBytecode)
>>                 (2 235 235 genExtStoreAndPopReceiverVariableBytecode
>> isInstVarRef)
>>                 (2 236 236 genExtStoreAndPopLiteralVariableBytecode)
>>                 (2 237 237 genLongStoreAndPopTemporaryVariableBytecode)
>>
>>                 (2 238 238 genExtSendBytecode isMapped)
>>                 (2 239 239 genExtSendSuperBytecode isMapped)
>>                 (2 240 240 genExtSendAbsentImplicitBytecode isMapped
>> hasIRC)
>>                 (2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped
>> hasIRC)
>>
>>                 (2 242 242 genExtUnconditionalJump      branch isMapped
>> "because of interrupt check" v4:Long:Branch:Distance:)
>>                 (2 243 243 genExtJumpIfTrue                     branch
>> isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
>>                 (2 244 244 genExtJumpIfFalse                    branch
>> isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
>>
>>                 (2 245 245      genExtSendAbsentSelfBytecode isMapped
>> hasIRC)
>>
>>                 (2 246 248      unknownBytecode)
>>
>>                 "3 byte bytecodes"
>>                 (3 249 249 genCallPrimitiveBytecode)
>>                 (3 250 250 genPushRemoteTempLongBytecode)
>>                 (3 251 251 genStoreRemoteTempLongBytecode)
>>                 (3 252 252 genStoreAndPopRemoteTempLongBytecode)
>>                 (3 253 253 genExtPushClosureBytecode block
>> v4:Block:Code:Size:)
>>                 (3 254 254      genExtSendAbsentOuterBytecode isMapped
>> hasIRC)
>>
>>                 (3 255 255      unknownBytecode))!
>>
>> Item was changed:
>>   ----- Method: StackToRegisterMappingCogit
>> class>>initializeBytecodeTableForSistaV1 (in category 'class
>> initialization') -----
>>   initializeBytecodeTableForSistaV1
>>         "StackToRegisterMappingCogit initializeBytecodeTableForSistaV1"
>>
>>         numPushNilsFunction := #sistaV1:Num:Push:Nils:.
>>         pushNilSizeFunction := #sistaV1PushNilSize:numInitialNils:.
>>         BytecodeSetHasDirectedSuperSend := true.
>>         FirstSpecialSelector := 96.
>>         NumSpecialSelectors := 32.
>>         self flag:
>>   'Special selector send class must be inlined to agree with the
>> interpreter, which
>>    inlines class.  If class is sent to e.g. a general instance of
>> ProtoObject then unless
>>    class is inlined there will be an MNU.  It must be that the
>> Cointerpreter and Cogit
>>    have identical semantics.  We get away with not hardwiring the other
>> special
>>    selectors either because in the Cointerpreter they are not inlined or
>> because they
>>    are inlined only to instances of classes for which there will always
>> be a method.'.
>>         self generatorTableFrom: #(
>>                 "1 byte bytecodes"
>>                 "pushes"
>>                 (1    0   15 genPushReceiverVariableBytecode
>> isInstVarRef               needsFrameNever: 1)
>>                 (1  16   31 genPushLitVarDirSup16CasesBytecode
>>               needsFrameNever: 1)
>>                 (1  32   63 genPushLiteralConstantBytecode
>>                       needsFrameNever: 1)
>>                 (1  64   75 genPushTemporaryVariableBytecode
>>               needsFrameIfMod16GENumArgs: 1)
>>                 (1  76   76 genPushReceiverBytecode
>>                                needsFrameNever: 1)
>>                 (1  77   77 genPushConstantTrueBytecode
>>                        needsFrameNever: 1)
>>                 (1  78   78 genPushConstantFalseBytecode
>>                       needsFrameNever: 1)
>>                 (1  79   79 genPushConstantNilBytecode
>>                       needsFrameNever: 1)
>>                 (1  80   80 genPushConstantZeroBytecode
>>                        needsFrameNever: 1)
>>                 (1  81   81 genPushConstantOneBytecode
>>                       needsFrameNever: 1)
>>                 (1  82   82 genExtPushPseudoVariable)
>>                 (1  83   83 duplicateTopBytecode
>>                                       needsFrameNever: 1)
>>
>>                 (1  84   87 unknownBytecode)
>>
>>                 "returns"
>>                 (1  88   88 genReturnReceiver
>>  return needsFrameIfInBlock: isMappedInBlock 0)
>>                 (1  89   89 genReturnTrue
>>        return needsFrameIfInBlock: isMappedInBlock 0)
>>                 (1  90   90 genReturnFalse
>>       return needsFrameIfInBlock: isMappedInBlock 0)
>>                 (1  91   91 genReturnNil
>>       return needsFrameIfInBlock: isMappedInBlock 0)
>>                 (1  92   92 genReturnTopFromMethod              return
>> needsFrameIfInBlock: isMappedInBlock -1)
>>                 (1  93   93 genReturnNilFromBlock
>>  return needsFrameNever: -1)
>>                 (1  94   94 genReturnTopFromBlock               return
>> needsFrameNever: -1)
>>                 (1  95   95 genExtNopBytecode
>>  needsFrameNever: 0)
>>
>>                 "sends"
>>                 (1  96   96 genSpecialSelectorArithmetic isMapped AddRR)
>>                 (1  97   97 genSpecialSelectorArithmetic isMapped SubRR)
>>                 (1  98   98 genSpecialSelectorComparison isMapped
>> JumpLess)
>>                 (1  99   99 genSpecialSelectorComparison isMapped
>> JumpGreater)
>>                 (1 100 100 genSpecialSelectorComparison isMapped
>> JumpLessOrEqual)
>>                 (1 101 101 genSpecialSelectorComparison isMapped
>> JumpGreaterOrEqual)
>>                 (1 102 102 genSpecialSelectorComparison isMapped JumpZero)
>>                 (1 103 103 genSpecialSelectorComparison isMapped
>> JumpNonZero)
>>                 (1 104 109 genSpecialSelectorSend isMapped)      " #* #/
>> #\\ #@ #bitShift: //"
>>                 (1 110 110 genSpecialSelectorArithmetic isMapped AndRR)
>>                 (1 111 111 genSpecialSelectorArithmetic isMapped OrRR)
>>                 (1 112 117 genSpecialSelectorSend isMapped) "#at:
>> #at:put: #size #next #nextPut: #atEnd"
>>                 (1 118 118 genSpecialSelectorEqualsEquals
>> needsFrameNever: notMapped -1) "not mapped because it is directly inlined
>> (for now)"
>>                 (1 119 119 genSpecialSelectorClass
>> needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is
>> directly inlined (for now)"
>>                 (1 120 127 genSpecialSelectorSend isMapped) "#blockCopy:
>> #value #value: #do: #new #new: #x #y"
>>
>>                 (1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
>>                 (1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
>>                 (1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
>>
>>                 "jumps"
>>                 (1 176 183 genShortUnconditionalJump    branch
>> v3:ShortForward:Branch:Distance:)
>>                 (1 184 191 genShortJumpIfTrue                   branch
>> isBranchTrue isMapped "because of mustBeBoolean"
>>
>>                               v3:ShortForward:Branch:Distance:)
>>                 (1 192 199 genShortJumpIfFalse                  branch
>> isBranchFalse isMapped "because of mustBeBoolean"
>> +
>>                                v3:ShortForward:Branch:Distance:)),
>> -
>>                                v3:ShortForward:Branch:Distance:)
>>
>>                 "stores"
>> +               ((initializationOptions at: #IMMUTABILITY ifAbsent:
>> [false])
>> +                       ifTrue: [#((1 200 207
>> genStoreAndPopReceiverVariableBytecode isInstVarRef isMapped -1))]
>> +                       ifFalse: [#((1 200 207
>> genStoreAndPopReceiverVariableBytecode isInstVarRef needsFrameNever: -1))
>> ]),
>> +
>> +               #((1 208 215 genStoreAndPopTemporaryVariableBytecode)
>> -               (1 200 207 genStoreAndPopReceiverVariableBytecode
>> isInstVarRef needsFrameNever: -1) "N.B. not frameless if immutability"
>> -               (1 208 215 genStoreAndPopTemporaryVariableBytecode)
>>
>>                 (1 216 216 genPopStackBytecode needsFrameNever: -1)
>>
>>                 (1 217 217 genUnconditionalTrapBytecode isMapped)
>>
>>                 (1 218 223 unknownBytecode)
>>
>>                 "2 byte bytecodes"
>>                 (2 224 224 extABytecode extension)
>>                 (2 225 225 extBBytecode extension)
>>
>>                 "pushes"
>>                 (2 226 226 genExtPushReceiverVariableBytecode
>> isInstVarRef)             "Needs a frame for context inst var access"
>>                 (2 227 227 genExtPushLitVarDirSupBytecode
>>        needsFrameNever: 1)
>>                 (2 228 228 genExtPushLiteralBytecode
>>               needsFrameNever: 1)
>>                 (2 229 229 genLongPushTemporaryVariableBytecode)
>>                 (2 230 230 genPushClosureTempsBytecode)
>>                 (2 231 231 genPushNewArrayBytecode)
>>                 (2 232 232 genExtPushIntegerBytecode
>>       needsFrameNever: 1)
>>                 (2 233 233 genExtPushCharacterBytecode
>>       needsFrameNever: 1)
>>
>>                 "returns"
>>                 "sends"
>>                 (2 234 234 genExtSendBytecode isMapped)
>>                 (2 235 235 genExtSendSuperBytecode isMapped)
>>
>>                 "sista bytecodes"
>>                 (2 236 236 unknownBytecode)
>>
>>                 "jumps"
>>                 (2 237 237 genExtUnconditionalJump      branch isMapped
>> "because of interrupt check" v4:Long:Branch:Distance:)
>>                 (2 238 238 genExtJumpIfTrue                     branch
>> isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
>>                 (2 239 239 genExtJumpIfFalse                    branch
>> isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
>>
>>                 "stores"
>>                 (2 240 240 genExtStoreAndPopReceiverVariableBytecode
>> isInstVarRef)
>>                 (2 241 241 genExtStoreAndPopLiteralVariableBytecode)
>>                 (2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
>>                 (2 243 243 genExtStoreReceiverVariableBytecode
>> isInstVarRef)
>>                 (2 244 244 genExtStoreLiteralVariableBytecode)
>>                 (2 245 245 genLongStoreTemporaryVariableBytecode)
>>
>>                 (2 246 247      unknownBytecode)
>>
>>                 "3 byte bytecodes"
>>                 (3 248 248 genCallPrimitiveBytecode)
>>                 (3 249 249 unknownBytecode) "reserved for Push Float"
>>                 (3 250 250 genExtPushClosureBytecode block
>> v4:Block:Code:Size:)
>>                 (3 251 251 genPushRemoteTempLongBytecode)
>>                 (3 252 252 genStoreRemoteTempLongBytecode)
>>                 (3 253 253 genStoreAndPopRemoteTempLongBytecode)
>>
>>                 (3 254 254
>> genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode branch
>> v4:Long:BranchIfNotInstanceOf:Distance:)
>>
>>                 (3 255 255      unknownBytecode))!
>>
>> Item was changed:
>>   ----- Method: StackToRegisterMappingCogit
>> class>>initializeBytecodeTableForSqueakV3PlusClosures (in category 'class
>> initialization') -----
>>   initializeBytecodeTableForSqueakV3PlusClosures
>>         "StackToRegisterMappingCogit
>> initializeBytecodeTableForSqueakV3PlusClosures"
>>
>>         numPushNilsFunction := #v3:Num:Push:Nils:.
>>         pushNilSizeFunction := #v3PushNilSize:numInitialNils:.
>>         FirstSpecialSelector := 176.
>>         NumSpecialSelectors := 32.
>>         self flag:
>>   'Special selector send class must be inlined to agree with the
>> interpreter, which
>>    inlines class.  If class is sent to e.g. a general instance of
>> ProtoObject then unless
>>    class is inlined there will be an MNU.  It must be that the
>> Cointerpreter and Cogit
>>    have identical semantics.  We get away with not hardwiring the other
>> special
>>    selectors either because in the Cointerpreter they are not inlined or
>> because they
>>    are inlined only to instances of classes for which there will always
>> be a method.'.
>>         self generatorTableFrom: #(
>>                 (1    0   15 genPushReceiverVariableBytecode isInstVarRef
>> needsFrameNever: 1)
>>                 (1  16   31 genPushTemporaryVariableBytecode
>> needsFrameIfMod16GENumArgs: 1)
>>                 (1  32   63 genPushLiteralConstantBytecode
>> needsFrameNever: 1)
>> +               (1  64   95 genPushLiteralVariableBytecode
>> needsFrameNever: 1)) ,
>> +
>> +               "N.B. not frameless if immutability"
>> +               ((initializationOptions at: #IMMUTABILITY ifAbsent:
>> [false])
>> +                       ifTrue: [#((1  96 103
>> genStoreAndPopReceiverVariableBytecode isInstVarRef isMapped -1))]
>> +                       ifFalse: [#((1  96 103
>> genStoreAndPopReceiverVariableBytecode isInstVarRef needsFrameNever: -1))
>> ]),
>> +
>> +               #((1 104 111 genStoreAndPopTemporaryVariableBytecode)
>> -               (1  64   95 genPushLiteralVariableBytecode
>> needsFrameNever: 1)
>> -               (1  96 103 genStoreAndPopReceiverVariableBytecode
>> isInstVarRef needsFrameNever: -1) "N.B. not frameless if immutability"
>> -               (1 104 111 genStoreAndPopTemporaryVariableBytecode)
>>                 (1 112 112 genPushReceiverBytecode needsFrameNever: 1)
>>                 (1 113 113 genPushConstantTrueBytecode needsFrameNever: 1)
>>                 (1 114 114 genPushConstantFalseBytecode needsFrameNever:
>> 1)
>>                 (1 115 115 genPushConstantNilBytecode needsFrameNever: 1)
>>                 (1 116 119 genPushQuickIntegerConstantBytecode
>> needsFrameNever: 1)
>>                 "method returns in blocks need a frame because of
>> nonlocalReturn:through:"
>>                 (1 120 120 genReturnReceiver
>> return needsFrameIfInBlock: isMappedInBlock 0)
>>                 (1 121 121 genReturnTrue
>>       return needsFrameIfInBlock: isMappedInBlock 0)
>>                 (1 122 122 genReturnFalse
>>        return needsFrameIfInBlock: isMappedInBlock 0)
>>                 (1 123 123 genReturnNil
>>  return needsFrameIfInBlock: isMappedInBlock 0)
>>                 (1 124 124 genReturnTopFromMethod               return
>> needsFrameIfInBlock: isMappedInBlock -1)
>>                 (1 125 125 genReturnTopFromBlock                return
>> needsFrameNever: -1)
>>
>>                 (1 126 127 unknownBytecode)
>>
>>                 (2 128 128 extendedPushBytecode isInstVarRef) "well,
>> maybe inst var ref"
>>                 (2 129 129 extendedStoreBytecode isInstVarRef) "well,
>> maybe inst var ref"
>>                 (2 130 130 extendedStoreAndPopBytecode isInstVarRef)
>> "well, maybe inst var ref"
>>                 (2 131 131 genExtendedSendBytecode isMapped)
>>                 (3 132 132 doubleExtendedDoAnythingBytecode isMapped)
>> "well, maybe inst var ref"
>>                 (2 133 133 genExtendedSuperBytecode isInstVarRef isMapped)
>>                 (2 134 134 genSecondExtendedSendBytecode isMapped)
>>                 (1 135 135 genPopStackBytecode needsFrameNever: -1)
>>                 (1 136 136 duplicateTopBytecode needsFrameNever: 1)
>>
>>                 (1 137 137 genPushActiveContextBytecode)
>>                 (2 138 138 genPushNewArrayBytecode)),
>>
>>                 ((initializationOptions at: #SpurObjectMemory ifAbsent:
>> [false])
>>                         ifTrue: [#((3 139 139 genCallPrimitiveBytecode))]
>>                         ifFalse: [#((1 139 139 unknownBytecode))]),
>>
>>            #(
>>                 (3 140 140 genPushRemoteTempLongBytecode)
>>                 (3 141 141 genStoreRemoteTempLongBytecode)
>>                 (3 142 142 genStoreAndPopRemoteTempLongBytecode)
>>                 (4 143 143 genPushClosureCopyCopiedValuesBytecode block
>> v3:Block:Code:Size:)
>>
>>                 (1 144 151 genShortUnconditionalJump
>> branch v3:ShortForward:Branch:Distance:)
>>                 (1 152 159 genShortJumpIfFalse
>>       branch isBranchFalse isMapped "because of mustBeBoolean"
>>
>>
>> v3:ShortForward:Branch:Distance:)
>>                 (2 160 163 genLongUnconditionalBackwardJump     branch
>> isMapped "because of interrupt check"
>>
>>                                               v3:Long:Branch:Distance:)
>>                 (2 164 167 genLongUnconditionalForwardJump
>> branch v3:Long:Branch:Distance:)
>>                 (2 168 171 genLongJumpIfTrue
>>       branch isBranchTrue isMapped "because of mustBeBoolean"
>>
>>
>> v3:LongForward:Branch:Distance:)
>>                 (2 172 175 genLongJumpIfFalse
>>        branch isBranchFalse isMapped "because of mustBeBoolean"
>>
>>
>> v3:LongForward:Branch:Distance:)
>>
>>                 (1 176 176 genSpecialSelectorArithmetic isMapped AddRR)
>>                 (1 177 177 genSpecialSelectorArithmetic isMapped SubRR)
>>                 (1 178 178 genSpecialSelectorComparison isMapped JumpLess)
>>                 (1 179 179 genSpecialSelectorComparison isMapped
>> JumpGreater)
>>                 (1 180 180 genSpecialSelectorComparison isMapped
>> JumpLessOrEqual)
>>                 (1 181 181 genSpecialSelectorComparison isMapped
>> JumpGreaterOrEqual)
>>                 (1 182 182 genSpecialSelectorComparison isMapped JumpZero)
>>                 (1 183 183 genSpecialSelectorComparison isMapped
>> JumpNonZero)
>>                 (1 184 189 genSpecialSelectorSend isMapped)      " #* #/
>> #\\ #@ #bitShift: //"
>>                 (1 190 190 genSpecialSelectorArithmetic isMapped AndRR)
>>                 (1 191 191 genSpecialSelectorArithmetic isMapped OrRR)
>>                 (1 192 197 genSpecialSelectorSend isMapped) "#at:
>> #at:put: #size #next #nextPut: #atEnd"
>>                 (1 198 198 genSpecialSelectorEqualsEquals
>> needsFrameNever: notMapped -1) "not mapped because it is directly inlined
>> (for now)"
>>                 (1 199 199 genSpecialSelectorClass
>> needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is
>> directly inlined (for now)"
>>                 (1 200 207 genSpecialSelectorSend isMapped) "#blockCopy:
>> #value #value: #do: #new #new: #x #y"
>>                 (1 208 223 genSendLiteralSelector0ArgsBytecode isMapped)
>>                 (1 224 239 genSendLiteralSelector1ArgBytecode isMapped)
>>                 (1 240 255 genSendLiteralSelector2ArgsBytecode isMapped))!
>>
>> Item was changed:
>>   ----- Method:
>> StackToRegisterMappingCogit>>ensureReceiverResultRegContainsSelf (in
>> category 'bytecode generator support') -----
>>   ensureReceiverResultRegContainsSelf
>>         needsFrame
>>                 ifTrue:
>>                         [optStatus isReceiverResultRegLive ifFalse:
>>                                 [self ssAllocateRequiredReg:
>> ReceiverResultReg.
>> +                               self putSelfInReceiverResultReg ].
>> -                                (self addressOf: simSelf) storeToReg:
>> ReceiverResultReg].
>>                         optStatus isReceiverResultRegLive: true]
>>                 ifFalse:
>>                         [self assert: (simSelf type = SSRegister
>>                                                   and: [simSelf register
>> = ReceiverResultReg]).
>>                         self assert: (optStatus isReceiverResultRegLive
>>                                                   and: [optStatus ssEntry
>> = (self addressOf: simSelf)])]!
>>
>> Item was added:
>> + ----- Method:
>> StackToRegisterMappingCogit>>evaluateTrampolineCallBlock:protectLinkRegIfNot:
>> (in category 'trampoline support') -----
>> + evaluateTrampolineCallBlock: block protectLinkRegIfNot: inFrame
>> +       <inline: true>
>> +       inFrame
>> +               ifFalse:
>> +                       [ backEnd saveAndRestoreLinkRegAround: [ block
>> value ] ]
>> +               ifTrue:
>> +                       [ block value ].!
>>
>> Item was changed:
>>   ----- Method: StackToRegisterMappingCogit>>genReturnReceiver (in
>> category 'bytecode generators') -----
>>   genReturnReceiver
>>         "In a frameless method ReceiverResultReg already contains self.
>>          In a frameful method, ReceiverResultReg /may/ contain self."
>>         needsFrame ifTrue:
>>                 [ optStatus isReceiverResultRegLive ifFalse:
>> +                       [self putSelfInReceiverResultReg]].
>> -                       [ (self addressOf: simSelf) storeToReg:
>> ReceiverResultReg]].
>>         ^self genUpArrowReturn!
>>
>> Item was changed:
>>   ----- Method: StackToRegisterMappingCogit>>genStorePop:LiteralVariable:
>> (in category 'bytecode generator support') -----
>>   genStorePop: popBoolean LiteralVariable: litVarIndex
>>         <inline: false>
>> +       | topReg association needStoreCheck immutabilityFailure |
>> -       | topReg assocReg association |
>>         "The only reason we assert needsFrame here is that in a frameless
>> method
>>          ReceiverResultReg must and does contain only self, but the
>> ceStoreCheck
>>          trampoline expects the target of the store to be in
>> ReceiverResultReg.  So
>>          in a frameless method we would have a conflict between the
>> receiver and
>>          the literal store, unless we we smart enough to realise that
>> ReceiverResultReg
>>          was unused after the literal variable store, unlikely given that
>> methods
>>          return self by default."
>>         self assert: needsFrame.
>> +       self cppIf: IMMUTABILITY ifTrue: [ self ssFlushTo: simStackPtr -
>> 1 ].
>>         "N.B.  No need to check the stack for references because we
>> generate code for
>>          literal variable loads that stores the result in a register,
>> deferring only the register push."
>> +       needStoreCheck := (objectRepresentation isUnannotatableConstant:
>> self ssTop) not.
>>         association := self getLiteral: litVarIndex.
>> -
>> -       "Avoid store check for immediate values"
>> -       (objectRepresentation isUnannotatableConstant: self ssTop) ifTrue:
>> -                       [ assocReg := self allocateRegNotConflictingWith:
>> 0.
>> -                       self genMoveConstant: association R: assocReg.
>> -                        objectRepresentation
>> -                               genEnsureObjInRegNotForwarded: assocReg
>> -                               scratchReg: TempReg.
>> -                       self ssStorePop: popBoolean toReg: TempReg.
>> -                        traceStores > 0 ifTrue:
>> -                               [ assocReg = ReceiverResultReg ifFalse:
>> -                                       [ self ssAllocateRequiredReg:
>> ReceiverResultReg.
>> -                                       optStatus
>> isReceiverResultRegLive: false.
>> -                                       self MoveR: assocReg R:
>> ReceiverResultReg ].
>> -                               self CallRT: ceTraceStoreTrampoline].
>> -                        ^objectRepresentation
>> -                               genStoreImmediateInSourceReg: TempReg
>> -                               slotIndex: ValueIndex
>> -                               destReg: assocReg ].
>> -
>> -       topReg := self allocateRegForStackEntryAt: 0 notConflictingWith:
>> (self registerMaskFor: ReceiverResultReg).
>> -       self ssStorePop: popBoolean toReg: topReg.
>>         optStatus isReceiverResultRegLive: false.
>>         self ssAllocateRequiredReg: ReceiverResultReg. "for ceStoreCheck
>> call in genStoreSourceReg: has to be ReceiverResultReg"
>>         self genMoveConstant: association R: ReceiverResultReg.
>>         objectRepresentation genEnsureObjInRegNotForwarded:
>> ReceiverResultReg scratchReg: TempReg.
>> +       self
>> +               cppIf: IMMUTABILITY
>> +               ifTrue:
>> +                       [ self ssAllocateRequiredReg: ClassReg.
>> +                         topReg := ClassReg.
>> +                         self ssStoreAndReplacePop: popBoolean toReg:
>> ClassReg.
>> +                         immutabilityFailure := objectRepresentation
>> +                               genImmutableCheck: ReceiverResultReg
>> +                               slotIndex: ValueIndex
>> +                               sourceReg: ClassReg
>> +                               scratchReg: TempReg
>> +                               popBoolean: popBoolean
>> +                               needRestoreRcvr: false ]
>> +               ifFalse:
>> +                       [ topReg := self allocateRegForStackEntryAt: 0
>> notConflictingWith: (self registerMaskFor: ReceiverResultReg).
>> +                         self ssStorePop: popBoolean toReg: topReg ].
>>         traceStores > 0 ifTrue:
>>                 [self MoveR: topReg R: TempReg.
>>                  self CallRT: ceTraceStoreTrampoline].
>> +       objectRepresentation
>> -       ^objectRepresentation
>>                 genStoreSourceReg: topReg
>>                 slotIndex: ValueIndex
>>                 destReg: ReceiverResultReg
>>                 scratchReg: TempReg
>> +               inFrame: needsFrame
>> +               needsStoreCheck: needStoreCheck.
>> +       self cppIf: IMMUTABILITY ifTrue: [ immutabilityFailure jmpTarget:
>> self Label ].
>> +       ^ 0!
>> -               inFrame: needsFrame!
>>
>> Item was changed:
>>   ----- Method:
>> StackToRegisterMappingCogit>>genStorePop:MaybeContextReceiverVariable: (in
>> category 'bytecode generator support') -----
>>   genStorePop: popBoolean MaybeContextReceiverVariable: slotIndex
>>         <inline: false>
>> +       | jmpSingle jmpDone needStoreCheck immutabilityFailure |
>> -       | jmpSingle jmpDone valueReg |
>>         <var: #jmpSingle type: #'AbstractInstruction *'>
>>         <var: #jmpDone type: #'AbstractInstruction *'>
>>         "The reason we need a frame here is that assigning to an inst var
>> of a context may
>>          involve wholesale reorganization of stack pages, and the only
>> way to preserve the
>>          execution state of an activation in that case is if it has a
>> frame."
>>         self assert: needsFrame.
>> +       self cppIf: IMMUTABILITY ifTrue: [ self ssFlushTo: simStackPtr -
>> 1 ].
>>         self ssFlushUpThroughReceiverVariable: slotIndex.
>> +       needStoreCheck := (objectRepresentation isUnannotatableConstant:
>> self ssTop) not.
>>         "Note that ReceiverResultReg remains live after both
>>          ceStoreContextInstVarTrampoline and ceStoreCheckTrampoline."
>>         self ensureReceiverResultRegContainsSelf.
>>         self ssPop: 1.
>>         self ssAllocateCallReg: ClassReg and: SendNumArgsReg. "for
>> ceStoreContextInstVarTrampoline"
>>         self ssPush: 1.
>>         objectRepresentation
>>                 genLoadSlot: SenderIndex
>>                 sourceReg: ReceiverResultReg
>>                 destReg: TempReg.
>> +       self
>> +               cppIf: IMMUTABILITY
>> +               ifTrue: [ self ssStoreAndReplacePop: popBoolean toReg:
>> ClassReg. ]
>> +               ifFalse: [ self ssStorePop: popBoolean toReg: ClassReg ].
>> -       valueReg := self ssStorePop: popBoolean toPreferredReg: ClassReg.
>> -       valueReg ~= ClassReg ifTrue:
>> -               [self MoveR: valueReg R: ClassReg].
>>         jmpSingle := objectRepresentation
>> genJumpNotSmallIntegerInScratchReg: TempReg.
>>         self MoveCq: slotIndex R: SendNumArgsReg.
>>         self CallRT: ceStoreContextInstVarTrampoline.
>>         jmpDone := self Jump: 0.
>>         jmpSingle jmpTarget: self Label.
>>         traceStores > 0 ifTrue:
>>                 [self MoveR: ClassReg R: TempReg.
>>                  self CallRT: ceTraceStoreTrampoline].
>> +       self
>> +               cppIf: IMMUTABILITY
>> +               ifTrue:
>> +                       [ immutabilityFailure := objectRepresentation
>> +                               genImmutableCheck: ReceiverResultReg
>> +                               slotIndex: ValueIndex
>> +                               sourceReg: ClassReg
>> +                               scratchReg: TempReg
>> +                               popBoolean: popBoolean
>> +                               needRestoreRcvr: true ].
>>         objectRepresentation
>>                 genStoreSourceReg: ClassReg
>>                 slotIndex: slotIndex
>>                 destReg: ReceiverResultReg
>>                 scratchReg: TempReg
>> +               inFrame: true
>> +               needsStoreCheck: needStoreCheck.
>> -               inFrame: true.
>>         jmpDone jmpTarget: self Label.
>> +       self cppIf: IMMUTABILITY ifTrue: [ immutabilityFailure jmpTarget:
>> self Label ].
>>         ^0!
>>
>> Item was changed:
>>   ----- Method:
>> StackToRegisterMappingCogit>>genStorePop:ReceiverVariable: (in category
>> 'bytecode generator support') -----
>>   genStorePop: popBoolean ReceiverVariable: slotIndex
>>         <inline: false>
>> +       | topReg needStoreCheck immutabilityFailure |
>> +       self cppIf: IMMUTABILITY ifTrue: [ self assert: needsFrame. self
>> ssFlushTo: simStackPtr - 1 ].
>> +       self ssFlushUpThroughReceiverVariable: slotIndex.
>> +       needStoreCheck := (objectRepresentation isUnannotatableConstant:
>> self ssTop) not.
>> +       "Note that ReceiverResultReg remains live after
>> ceStoreCheckTrampoline."
>> +       self ensureReceiverResultRegContainsSelf.
>> +       self
>> +               cppIf: IMMUTABILITY
>> -       ^ needsFrame
>> -               ifFalse:
>> -                       [ self
>> -                               genStorePop: popBoolean
>> -                               ReceiverVariable: slotIndex
>> -                               traceBlock: [ backEnd
>> saveAndRestoreLinkRegAround: [self CallRT: ceTraceStoreTrampoline] ]
>> -                               inFrame: needsFrame ]
>>                 ifTrue:
>> +                       [ self ssAllocateRequiredReg: ClassReg.
>> +                         topReg := ClassReg.
>> +                         self ssStoreAndReplacePop: popBoolean toReg:
>> topReg.
>> +                         immutabilityFailure := objectRepresentation
>> +                               genImmutableCheck: ReceiverResultReg
>> +                               slotIndex: slotIndex
>> +                               sourceReg: ClassReg
>> +                               scratchReg: TempReg
>> +                               popBoolean: popBoolean
>> +                               needRestoreRcvr: true ]
>> +               ifFalse:
>> +                       [ topReg := self allocateRegForStackEntryAt: 0
>> notConflictingWith: (self registerMaskFor: ReceiverResultReg).
>> +                         self ssStorePop: popBoolean toReg: topReg ].
>> +       traceStores > 0 ifTrue:
>> +               [ self MoveR: topReg R: TempReg.
>> +               self evaluateTrampolineCallBlock: [ self CallRT:
>> ceTraceStoreTrampoline ] protectLinkRegIfNot: needsFrame ].
>> +       objectRepresentation
>> +               genStoreSourceReg: topReg
>> +               slotIndex: slotIndex
>> +               destReg: ReceiverResultReg
>> +               scratchReg: TempReg
>> +               inFrame: needsFrame
>> +               needsStoreCheck: needStoreCheck.
>> +       self cppIf: IMMUTABILITY ifTrue: [ immutabilityFailure jmpTarget:
>> self Label ].
>> +       ^ 0!
>> -                       [ self
>> -                               genStorePop: popBoolean
>> -                               ReceiverVariable: slotIndex
>> -                               traceBlock: [ self CallRT:
>> ceTraceStoreTrampoline ]
>> -                               inFrame: needsFrame ]!
>>
>> Item was removed:
>> - ----- Method:
>> StackToRegisterMappingCogit>>genStorePop:ReceiverVariable:traceBlock:inFrame:
>> (in category 'bytecode generator support') -----
>> - genStorePop: popBoolean ReceiverVariable: slotIndex traceBlock: block
>> inFrame: inFrame
>> -       <inline: true>
>> -       | topReg |
>> -       self ssFlushUpThroughReceiverVariable: slotIndex.
>> -       "Avoid store check for immediate values"
>> -       ^ (objectRepresentation isUnannotatableConstant: self ssTop)
>> -               ifTrue:
>> -                       [self ensureReceiverResultRegContainsSelf.
>> -                        self ssStorePop: popBoolean toReg: TempReg.
>> -                        traceStores > 0 ifTrue: [block value].
>> -                        objectRepresentation
>> -                               genStoreImmediateInSourceReg: TempReg
>> -                               slotIndex: slotIndex
>> -                               destReg: ReceiverResultReg]
>> -               ifFalse:
>> -                       [topReg := self allocateRegForStackEntryAt: 0
>> notConflictingWith: (self registerMaskFor: ReceiverResultReg).
>> -                       self ssStorePop: popBoolean toReg: topReg.
>> -                       "Note that ReceiverResultReg remains live after
>> ceStoreCheckTrampoline."
>> -                       self ensureReceiverResultRegContainsSelf.
>> -                       traceStores > 0 ifTrue: [self MoveR: topReg R:
>> TempReg. block value].
>> -                       objectRepresentation
>> -                               genStoreSourceReg: topReg
>> -                               slotIndex: slotIndex
>> -                               destReg: ReceiverResultReg
>> -                               scratchReg: TempReg
>> -                               inFrame: inFrame ]!
>>
>> Item was changed:
>>   ----- Method: StackToRegisterMappingCogit>>genStorePop:RemoteTemp:At:
>> (in category 'bytecode generator support') -----
>>   genStorePop: popBoolean RemoteTemp: slotIndex At: remoteTempIndex
>>         <inline: false>
>> +       | topReg needStoreCheck |
>> -       | topReg topSpilled tempVectReg |
>>         "The only reason we assert needsFrame here is that in a frameless
>> method
>>          ReceiverResultReg must and does contain only self, but the
>> ceStoreCheck
>>          trampoline expects the target of the store to be in
>> ReceiverResultReg.  So
>>          in a frameless method we would have a conflict between the
>> receiver and
>>          the temote temp store, unless we we smart enough to realise that
>>          ReceiverResultReg was unused after the literal variable store,
>> unlikely given
>>          that methods return self by default."
>>         self assert: needsFrame.
>>         "N.B.  No need to check the stack for references because we
>> generate code for
>>          remote temp loads that stores the result in a register,
>> deferring only the register push."
>> +       needStoreCheck := (objectRepresentation isUnannotatableConstant:
>> self ssTop) not.
>> -       "Avoid store check for immediate values"
>> -       (objectRepresentation isUnannotatableConstant: self ssTop) ifTrue:
>> -               [ tempVectReg := self allocateRegNotConflictingWith: 0.
>> -                self MoveMw: (self frameOffsetOfTemporary:
>> remoteTempIndex) r: FPReg R: tempVectReg.
>> -                self ssStorePop: popBoolean toReg: TempReg.
>> -                traceStores > 0 ifTrue:
>> -                       [ tempVectReg = ReceiverResultReg ifFalse:
>> -                                       [ self ssAllocateRequiredReg:
>> ReceiverResultReg.
>> -                                       optStatus
>> isReceiverResultRegLive: false.
>> -                                       self MoveR: tempVectReg R:
>> ReceiverResultReg ].
>> -                       self CallRT: ceTraceStoreTrampoline].
>> -                ^objectRepresentation
>> -                       genStoreImmediateInSourceReg: TempReg
>> -                       slotIndex: slotIndex
>> -                       destReg: tempVectReg].
>>         topReg := self allocateRegForStackEntryAt: 0 notConflictingWith:
>> (self registerMaskFor: ReceiverResultReg).
>> +       self ssAllocateRequiredReg: ReceiverResultReg.
>> -       topSpilled := self ssTop spilled.
>> -       self ssStorePop: (popBoolean or: [topSpilled]) toReg: topReg.
>> -       popBoolean ifFalse:
>> -               [topSpilled ifFalse: [self ssPop: 1].
>> -                self ssPushRegister: topReg].
>> -       self ssAllocateRequiredReg: ReceiverResultReg.
>>         optStatus isReceiverResultRegLive: false.
>> +       self ssStoreAndReplacePop: popBoolean toReg: topReg.
>>         self MoveMw: (self frameOffsetOfTemporary: remoteTempIndex) r:
>> FPReg R: ReceiverResultReg.
>>          traceStores > 0 ifTrue:
>> +                       [ self MoveR: topReg R: TempReg.
>> +                       self CallRT: ceTraceStoreTrampoline. ].
>> -               [self MoveR: topReg R: TempReg.
>> -                self CallRT: ceTraceStoreTrampoline].
>>         ^objectRepresentation
>>                 genStoreSourceReg: topReg
>>                 slotIndex: slotIndex
>>                 destReg: ReceiverResultReg
>>                 scratchReg: TempReg
>> +               inFrame: needsFrame
>> +               needsStoreCheck: needStoreCheck!
>> -               inFrame: needsFrame!
>>
>> Item was added:
>> + ----- Method: StackToRegisterMappingCogit>>putSelfInReceiverResultReg
>> (in category 'bytecode generator support') -----
>> + putSelfInReceiverResultReg
>> +       <inline: true>
>> +        (self addressOf: simSelf) storeToReg: ReceiverResultReg
>> +               !
>>
>> Item was added:
>> + ----- Method: StackToRegisterMappingCogit>>ssStoreAndReplacePop:toReg:
>> (in category 'simulation stack') -----
>> + ssStoreAndReplacePop: popBoolean toReg: reg
>> +       "In addition to ssStorePop:toReg:, if this is a store and not
>> +       a popInto and the top of the simulated stack is not spilled,
>> +       I change the simulated stack to use the register for the value"
>> +       | topSpilled |
>> +       topSpilled := self ssTop spilled.
>> +       self ssStorePop: (popBoolean or: [topSpilled]) toReg: reg.
>> +       popBoolean ifFalse:
>> +               [ topSpilled ifFalse: [self ssPop: 1].
>> +               self ssPushRegister: reg ].!
>>
>>
>
>
> --
> _,,,^..^,,,_
> best, Eliot
>



-- 
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20160106/7164b5ad/attachment-0001.htm


More information about the Vm-dev mailing list