[Vm-dev] VM Maker: VMMaker.oscog-eem.2420.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jul 4 16:49:12 UTC 2018
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2420.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2420
Author: eem
Time: 4 July 2018, 9:48:30.144323 am
UUID: f303796f-283f-4d4c-a910-bf205a0b4600
Ancestors: VMMaker.oscog-cb.2419
Spur:
Extend semantics of primitives 165 & 166 (integerAt:[put:], signed indexing of 32-bit word classes) to byte, short and double word classes; actually, all classes; this is a signedversion of 60 & 61 basicAt:[put:].
Refactor CogObjectRepresentationFor32|64BitSpur genPrimitiveAt[Put] into genPrimitiveAt[Put]Signed:.
Extend Ronie's support for sign extension to all processors, generating the simple move,signed shift sequence on processors without native sign extension (i.e. ARM).
Slang:
Extend constant elimination/analysis for generate[Signed]BitShift:on:indent: so that isSignedInteger:inRangeForBits: generates a simple one-way shift for integer signedBitShift: 1 - nBits when inlined and nBits is a constant (see primitiveSpurIntegerAtPut).
Simulator:
Nuke some obsolete primitive exoeriemnts.
=============== Diff against VMMaker.oscog-cb.2419 ===============
Item was changed:
----- Method: CCodeGenerator>>generateBitShift:on:indent: (in category 'C translation') -----
generateBitShift: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ | arg rcvr shift |
- | arg rcvr |
arg := msgNode args first.
rcvr := msgNode receiver.
+ (self isConstantNode: arg valueInto: [:shiftValue| shift := shiftValue])
- arg isConstant
ifTrue: "bit shift amount is a constant"
[aStream nextPutAll: '((usqInt) '.
self emitCExpression: rcvr on: aStream.
+ shift < 0
+ ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
+ ifFalse: [aStream nextPutAll: ' << '; print: shift].
+ aStream nextPut: $)]
- arg value < 0
- ifTrue: [aStream nextPutAll: ' >> ', arg value negated printString]
- ifFalse: [aStream nextPutAll: ' << ', arg value printString].
- aStream nextPutAll: ')']
ifFalse: "bit shift amount is an expression"
[aStream nextPutAll: '(('.
self emitCExpression: arg on: aStream indent: level.
aStream nextPutAll: ' < 0) ? ((usqInt) '.
self emitCExpression: rcvr on: aStream indent: level.
aStream nextPutAll: ' >> -'.
self emitCExpression: arg on: aStream indent: level.
aStream nextPutAll: ') : ((usqInt) '.
self emitCExpression: rcvr on: aStream indent: level.
aStream nextPutAll: ' << '.
self emitCExpression: arg on: aStream indent: level.
aStream nextPutAll: '))']!
Item was changed:
----- Method: CCodeGenerator>>generateSignedBitShift:on:indent: (in category 'C translation') -----
generateSignedBitShift: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ | cast type arg shift |
- | cast type arg |
"since ``signed'' is a synonym for ``signed int'' do not cast 64-bit values to signed if at all possible."
cast := (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
ifTrue: ['(', (type first = $u ifTrue: [type allButFirst: (type second = $n ifTrue: [2] ifFalse: [1])] ifFalse: [type]), ')']
ifFalse: ['(signed)'].
+ (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
- (arg := msgNode args first) isConstant
ifTrue: "bit shift amount is a constant"
[aStream nextPut: $(; nextPutAll: cast.
self emitCExpression: msgNode receiver on: aStream.
+ shift < 0
+ ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
+ ifFalse: [aStream nextPutAll: ' << '; print: shift].
- arg value < 0
- ifTrue: [aStream nextPutAll: ' >> '; print: arg value negated]
- ifFalse: [aStream nextPutAll: ' << '; print: arg value].
aStream nextPut: $)]
ifFalse: "bit shift amount is an expression"
[aStream nextPutAll: '(('.
self emitCExpression: arg on: aStream.
aStream nextPutAll: ' < 0) ? ('; nextPutAll: cast.
self emitCExpression: msgNode receiver on: aStream.
aStream nextPutAll: ' >> -'.
self emitCExpression: arg on: aStream.
aStream nextPutAll: ') : ('; nextPutAll: cast.
self emitCExpression: msgNode receiver on: aStream.
aStream nextPutAll: ' << '.
self emitCExpression: arg on: aStream.
aStream nextPutAll: '))']!
Item was changed:
----- Method: CCodeGenerator>>isConstantNode:valueInto: (in category 'utilities') -----
isConstantNode: aNode valueInto: aBlock
"Answer if aNode evaluates to a constant, and if so, evaluate aBlock with the value of that constant."
aNode isConstant ifTrue:
[(aNode isDefine
and: [(vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: aNode name]) ifTrue:
[^false].
aBlock value: aNode value.
^true].
(aNode isVariable
and: [aNode name = #nil]) ifTrue:
[aBlock value: nil.
^true].
+ aNode isSend ifTrue:
+ [(self anyMethodNamed: aNode selector)
+ ifNil:
+ [(VMBasicConstants valueOfBasicSelector: aNode selector) ifNotNil:
+ [:value|
+ aBlock value: value.
+ ^true].
+ aNode constantNumbericValueOrNil ifNotNil:
+ [:value|
+ aBlock value: value.
+ ^true]]
+ ifNotNil:
+ [:m|
+ (m statements size = 1
+ and: [m statements last isReturn]) ifTrue:
+ [^self isConstantNode: m statements last expression valueInto: aBlock]]].
- aNode isSend ifFalse:
- [^false].
- (self anyMethodNamed: aNode selector)
- ifNil:
- [(VMBasicConstants valueOfBasicSelector: aNode selector) ifNotNil:
- [:value|
- aBlock value: value.
- ^true]]
- ifNotNil:
- [:m|
- (m statements size = 1
- and: [m statements last isReturn]) ifTrue:
- [^self isConstantNode: m statements last expression valueInto: aBlock]].
^false!
Item was added:
+ ----- Method: CogAbstractInstruction>>canSignExtend (in category 'testing') -----
+ canSignExtend
+ "Answer if the processor provides native sign extension instructions. If it does it must be able to generate
+ SignExtend8RR SignExtend16RR
+ and if 64-bits, SignExtend32RR."
+ <inline: true>
+ ^false!
Item was added:
+ ----- Method: CogAbstractInstruction>>canZeroExtend (in category 'testing') -----
+ canZeroExtend
+ "Answer if the processor provides native zero extension instructions. If it does it must be able to generate
+ ZeroExtend8RR ZeroExtend16RR
+ and if 64-bits, ZeroExtend32RR."
+ <inline: true>
+ ^false!
Item was added:
+ ----- Method: CogIA32Compiler>>canSignExtend (in category 'testing') -----
+ canSignExtend
+ "IA32 has native SignExtend8RR & SignExtend16RR."
+ <inline: true>
+ ^true!
Item was added:
+ ----- Method: CogIA32Compiler>>canZeroExtend (in category 'testing') -----
+ canZeroExtend
+ "IA32 has native ZeroExtend8RR & ZeroExtend16RR."
+ <inline: true>
+ ^true!
Item was added:
+ ----- Method: CogObjectRepresentation>>genPrimitiveIntegerAt (in category 'primitive generators') -----
+ genPrimitiveIntegerAt
+ "subclasses override if they can"
+ ^UnimplementedPrimitive!
Item was added:
+ ----- Method: CogObjectRepresentation>>genPrimitiveIntegerAtPut (in category 'primitive generators') -----
+ genPrimitiveIntegerAtPut
+ "subclasses override if they can"
+ self break.
+ ^UnimplementedPrimitive!
Item was removed:
- ----- Method: CogObjectRepresentationFor32BitSpur>>genPrimitiveAt (in category 'primitive generators') -----
- genPrimitiveAt
- | formatReg nSlotsOrBytesReg convertToIntAndReturn methodInBounds
- jumpNotIndexable jumpImmediate jumpBadIndex
- jumpIsBytes jumpIsShorts jumpIsWords jumpIsMethod
- jumpWordTooBig jumpIsArray jumpHasFixedFields jumpIsContext
- jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds
- jumpMethodOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
- "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
- <var: #jumpIsBytes type: #'AbstractInstruction *'>
- <var: #jumpIsShorts type: #'AbstractInstruction *'>
- <var: #jumpIsMethod type: #'AbstractInstruction *'>
- <var: #jumpBadIndex type: #'AbstractInstruction *'>
- <var: #jumpIsContext type: #'AbstractInstruction *'>
- <var: #jumpImmediate type: #'AbstractInstruction *'>
- <var: #methodInBounds type: #'AbstractInstruction *'>
- <var: #jumpWordTooBig type: #'AbstractInstruction *'>
- <var: #jumpNotIndexable type: #'AbstractInstruction *'>
- <var: #jumpHasFixedFields type: #'AbstractInstruction *'>
- <var: #convertToIntAndReturn type: #'AbstractInstruction *'>
- <var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpMethodOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
-
- nSlotsOrBytesReg := ClassReg.
-
- cogit genLoadArgAtDepth: 0 into: Arg0Reg.
- jumpImmediate := self genJumpImmediate: ReceiverResultReg.
- cogit MoveR: Arg0Reg R: Arg1Reg.
- jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
- cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
-
- "formatReg := self formatOf: ReceiverResultReg"
- self genGetFormatOf: ReceiverResultReg
- into: (formatReg := SendNumArgsReg)
- leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
-
- self genGetNumSlotsOf: ReceiverResultReg into: nSlotsOrBytesReg.
-
- "dispatch on format in a combination of highest dynamic frequency order first and convenience.
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 unused, reserved for exotic pointer objects?
- 7 Forwarded Object, 1st field is pointer, rest of fields are ignored
- 8 unused, reserved for exotic non-pointer objects?
- 9 64-bit indexable
- 10 - 11 32-bit indexable
- 12 - 15 16-bit indexable
- 16 - 23 byte indexable
- 24 - 31 compiled method"
- cogit CmpCq: objectMemory firstByteFormat R: formatReg.
- jumpIsBytes := cogit JumpAboveOrEqual: 0.
- cogit CmpCq: objectMemory arrayFormat R: formatReg.
- jumpIsArray := cogit JumpZero: 0.
- jumpNotIndexable := cogit JumpBelow: 0.
- cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
- jumpHasFixedFields := cogit JumpBelowOrEqual: 0.
- cogit CmpCq: objectMemory firstShortFormat R: formatReg.
- jumpIsShorts := cogit JumpAboveOrEqual: 0.
- cogit CmpCq: objectMemory firstLongFormat R: formatReg.
- jumpIsWords := cogit JumpAboveOrEqual: 0.
- "For now ignore 64-bit indexability."
- jumpNotIndexable jmpTarget: cogit Label.
- jumpNotIndexable := cogit Jump: 0.
-
- jumpIsArray jmpTarget:
- (cogit CmpR: Arg1Reg R: nSlotsOrBytesReg).
- jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpIsBytes jmpTarget:
- (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: nSlotsOrBytesReg).
- cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
- cogit SubR: TempReg R: nSlotsOrBytesReg;
- CmpR: Arg1Reg R: nSlotsOrBytesReg.
- jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
- jumpIsMethod := cogit JumpAboveOrEqual: 0.
- methodInBounds :=
- (cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg).
- cogit backEnd byteReadsZeroExtend
- ifTrue:
- [cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg]
- ifFalse:
- [cogit "formatReg already contains a value <= 16r1f, so no need to zero it"
- MoveXbr: Arg1Reg R: ReceiverResultReg R: formatReg;
- MoveR: formatReg R: ReceiverResultReg].
- convertToIntAndReturn := cogit Label.
- self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpIsShorts jmpTarget:
- (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: nSlotsOrBytesReg).
- cogit AndCq: 1 R: formatReg.
- cogit SubR: formatReg R: nSlotsOrBytesReg;
- CmpR: Arg1Reg R: nSlotsOrBytesReg.
- jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit AddR: Arg1Reg R: ReceiverResultReg.
- cogit AddR: Arg1Reg R: ReceiverResultReg.
- cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
- cogit Jump: convertToIntAndReturn.
-
- jumpIsWords jmpTarget:
- (cogit CmpR: Arg1Reg R: nSlotsOrBytesReg).
- jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: TempReg.
- jumpWordTooBig := self jumpNotSmallIntegerUnsignedValueInRegister: TempReg.
- cogit MoveR: TempReg R: ReceiverResultReg.
- cogit Jump: convertToIntAndReturn.
-
- jumpHasFixedFields jmpTarget:
- (cogit AndCq: objectMemory classIndexMask R: TempReg).
- cogit MoveR: TempReg R: formatReg.
- cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
- jumpIsContext := cogit JumpZero: 0.
- cogit PushR: nSlotsOrBytesReg.
- self genGetClassObjectOfClassIndex: formatReg into: nSlotsOrBytesReg scratchReg: TempReg.
- self genLoadSlot: InstanceSpecificationIndex sourceReg: nSlotsOrBytesReg destReg: formatReg.
- cogit PopR: nSlotsOrBytesReg.
- self genConvertSmallIntegerToIntegerInReg: formatReg.
- cogit
- AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
- SubR: formatReg R: nSlotsOrBytesReg;
- CmpR: Arg1Reg R: nSlotsOrBytesReg.
- jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
- "index is (formatReg (fixed fields) + Arg1Reg (0-rel index)) * wordSize + baseHeaderSize"
- cogit AddR: formatReg R: Arg1Reg.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpIsMethod jmpTarget: cogit Label.
- "Now check that the index is beyond the method's literals..."
- self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: nSlotsOrBytesReg scratch: TempReg.
- cogit CmpR: Arg1Reg R: nSlotsOrBytesReg.
- cogit JumpBelow: methodInBounds.
- jumpMethodOutOfBounds := cogit Jump: 0.
-
- jumpWordTooBig jmpTarget:
- (jumpFixedFieldsOutOfBounds jmpTarget:
- (jumpArrayOutOfBounds jmpTarget:
- (jumpBytesOutOfBounds jmpTarget:
- (jumpMethodOutOfBounds jmpTarget:
- (jumpShortsOutOfBounds jmpTarget:
- (jumpWordsOutOfBounds jmpTarget:
- (jumpNotIndexable jmpTarget:
- (jumpIsContext jmpTarget:
- (jumpBadIndex jmpTarget:
- (jumpImmediate jmpTarget: cogit Label)))))))))).
-
- ^0 "Can't be complete because of contexts."!
Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genPrimitiveAtPutSigned: (in category 'primitive generators') -----
+ genPrimitiveAtPutSigned: signedVersion
+ "Generate the code for primitives 61 & 165, at:put:/basicAt:put: & integerAt:put:. If signedVersion is true
+ then generate signed accesses to the bits classes (a la 164 & 165). If signedVersion is false,
+ generate unsigned accesses (a la 60, 61, 63 & 64)."
+ | formatReg nSlotsOrBytesReg methodInBounds
+ jumpImmediate jumpBadIndex jumpImmutable jumpNotIndexablePointers jumpNotIndexableBits
+ jumpIsContext jumpIsCompiledMethod jumpIsBytes jumpIsShorts jumpHasFixedFields
+ jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
+ jumpWordsOutOfBounds jumpShortsOutOfBounds jumpBytesOutOfBounds
+ jumpShortsOutOfRange jumpWordsOutOfRange jumpBytesOutOfRange
+ jumpNonSmallIntegerValue jumpNotPointers
+ |
+ "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
+
+ nSlotsOrBytesReg := ClassReg.
+
+ cogit genLoadArgAtDepth: 1 into: Arg0Reg.
+ cogit genLoadArgAtDepth: 0 into: Arg1Reg.
+ 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 genGetNumSlotsOf: ReceiverResultReg into: nSlotsOrBytesReg.
+
+ "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: nSlotsOrBytesReg.
+ 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 genPrimReturn.
+
+ 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: nSlotsOrBytesReg.
+ self genGetClassObjectOfClassIndex: formatReg into: nSlotsOrBytesReg scratchReg: TempReg.
+ self genLoadSlot: InstanceSpecificationIndex sourceReg: nSlotsOrBytesReg destReg: formatReg.
+ cogit PopR: nSlotsOrBytesReg.
+ self genConvertSmallIntegerToIntegerInReg: formatReg.
+ cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg.
+ cogit SubR: formatReg R: nSlotsOrBytesReg.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: formatReg.
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddR: formatReg R: Arg0Reg.
+ cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
+ cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ jumpNotPointers jmpTarget: cogit Label.
+ jumpNonSmallIntegerValue := self genJumpNotSmallInteger: Arg1Reg scratchReg: TempReg.
+ cogit CmpCq: objectMemory firstByteFormat R: formatReg.
+ jumpIsBytes := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory firstShortFormat R: formatReg.
+ jumpIsShorts := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory firstLongFormat R: formatReg.
+ "For now ignore 64-bit indexability."
+ jumpNotIndexableBits := cogit JumpBelow: 0.
+
+ "fall through to words"
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit MoveR: Arg1Reg R: TempReg.
+ self genConvertSmallIntegerToIntegerInReg: TempReg.
+ signedVersion ifFalse:
+ [(cogit lastOpcode setsConditionCodesFor: JumpLess) ifFalse:
+ [cogit CmpCq: 0 R: TempReg]. "N.B. FLAGS := TempReg - 0"
+ jumpWordsOutOfRange := cogit JumpLess: 0].
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
+ cogit MoveR: TempReg Xwr: Arg0Reg R: ReceiverResultReg.
+ cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ signedVersion
+ ifTrue:
+ [jumpIsBytes jmpTarget:
+ (cogit MoveR: SendNumArgsReg R: TempReg).
+ cogit ArithmeticShiftRightCq: 7 R: TempReg. "Maps in range to -1,0".
+ cogit AddCq: 1 R: TempReg. "Maps in range to 0,1"
+ cogit CmpCq: 1 R: TempReg]
+ ifFalse:
+ [jumpIsBytes jmpTarget:
+ (cogit CmpCq: (objectMemory integerObjectOf: 255) R: Arg1Reg)].
+ jumpBytesOutOfRange := cogit JumpAbove: 0.
+ cogit LogicalShiftLeftCq: objectMemory shiftForWord R: nSlotsOrBytesReg.
+ cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
+ cogit SubR: TempReg R: nSlotsOrBytesReg.
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
+ jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
+ methodInBounds :=
+ 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 genPrimReturn.
+
+ signedVersion
+ ifTrue:
+ [jumpIsShorts jmpTarget:
+ (cogit MoveR: SendNumArgsReg R: TempReg).
+ cogit ArithmeticShiftRightCq: 15 R: TempReg. "Maps in range to -1,0".
+ cogit AddCq: 1 R: TempReg. "Maps in range to 0,1"
+ cogit CmpCq: 1 R: TempReg]
+ ifFalse:
+ [jumpIsShorts jmpTarget:
+ (cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg)].
+ jumpShortsOutOfRange := cogit JumpAbove: 0.
+ cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: nSlotsOrBytesReg.
+ cogit AndCq: objectMemory wordSize / 2 - 1 R: formatReg.
+ cogit SubR: formatReg R: nSlotsOrBytesReg.
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit MoveR: Arg1Reg R: TempReg.
+ self genConvertSmallIntegerToIntegerInReg: TempReg.
+ cogit AddR: Arg0Reg R: ReceiverResultReg.
+ cogit AddR: Arg0Reg R: ReceiverResultReg.
+ cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
+ cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ "Now check that the index is beyond the method's literals..."
+ jumpIsCompiledMethod jmpTarget: cogit Label.
+ self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: nSlotsOrBytesReg scratch: TempReg.
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ cogit JumpBelow: methodInBounds.
+
+ jumpIsContext jmpTarget:
+ (jumpNotIndexableBits jmpTarget:
+ (jumpBytesOutOfRange jmpTarget:
+ (jumpShortsOutOfRange jmpTarget:
+ (jumpIsCompiledMethod jmpTarget:
+ (jumpArrayOutOfBounds jmpTarget:
+ (jumpBytesOutOfBounds jmpTarget:
+ (jumpShortsOutOfBounds jmpTarget:
+ (jumpWordsOutOfBounds jmpTarget:
+ (jumpNotIndexablePointers jmpTarget:
+ (jumpNonSmallIntegerValue jmpTarget:
+ (jumpFixedFieldsOutOfBounds jmpTarget: cogit Label))))))))))).
+
+ signedVersion ifFalse:
+ [jumpWordsOutOfRange jmpTarget: jumpIsContext getJmpTarget].
+ self cppIf: IMMUTABILITY
+ ifTrue: [jumpImmutable jmpTarget: jumpIsContext getJmpTarget].
+
+ cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
+ self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
+
+ jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
+
+ ^0 "Can't be complete because of contexts."!
Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genPrimitiveAtSigned: (in category 'primitive generators') -----
+ genPrimitiveAtSigned: signedVersion
+ "Generate the code for primitives 60 & 164, at:/basicAt: & integerAt:. If signedVersion is true
+ then generate signed accesses to the bits classes (a la 164 & 165). If signedVersion is false,
+ generate unsigned accesses (a la 60, 61, 63 & 64)."
+ | formatReg nSlotsOrBytesReg convertToIntAndReturn methodInBounds
+ jumpNotIndexable jumpImmediate jumpBadIndex
+ jumpIsBytes jumpIsShorts jumpIsWords jumpIsMethod
+ jumpWordTooBig jumpIsArray jumpHasFixedFields jumpIsContext
+ jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds
+ jumpMethodOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
+ "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
+
+ nSlotsOrBytesReg := ClassReg.
+
+ cogit genLoadArgAtDepth: 0 into: Arg0Reg.
+ jumpImmediate := self genJumpImmediate: ReceiverResultReg.
+ cogit MoveR: Arg0Reg R: Arg1Reg.
+ jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
+ self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
+ cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
+
+ "formatReg := self formatOf: ReceiverResultReg"
+ self genGetFormatOf: ReceiverResultReg
+ into: (formatReg := SendNumArgsReg)
+ leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
+
+ self genGetNumSlotsOf: ReceiverResultReg into: nSlotsOrBytesReg.
+
+ "dispatch on format in a combination of highest dynamic frequency order first and convenience.
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 unused, reserved for exotic pointer objects?
+ 7 Forwarded Object, 1st field is pointer, rest of fields are ignored
+ 8 unused, reserved for exotic non-pointer objects?
+ 9 64-bit indexable
+ 10 - 11 32-bit indexable
+ 12 - 15 16-bit indexable
+ 16 - 23 byte indexable
+ 24 - 31 compiled method"
+ cogit CmpCq: objectMemory firstByteFormat R: formatReg.
+ jumpIsBytes := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory arrayFormat R: formatReg.
+ jumpIsArray := cogit JumpZero: 0.
+ jumpNotIndexable := cogit JumpBelow: 0.
+ cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
+ jumpHasFixedFields := cogit JumpBelowOrEqual: 0.
+ cogit CmpCq: objectMemory firstShortFormat R: formatReg.
+ jumpIsShorts := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory firstLongFormat R: formatReg.
+ jumpIsWords := cogit JumpAboveOrEqual: 0.
+ "For now ignore 64-bit indexability."
+ jumpNotIndexable jmpTarget: cogit Label.
+ jumpNotIndexable := cogit Jump: 0.
+
+ jumpIsArray jmpTarget:
+ (cogit CmpR: Arg1Reg R: nSlotsOrBytesReg).
+ jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ jumpIsBytes jmpTarget:
+ (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: nSlotsOrBytesReg).
+ cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
+ cogit SubR: TempReg R: nSlotsOrBytesReg;
+ CmpR: Arg1Reg R: nSlotsOrBytesReg.
+ jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
+ jumpIsMethod := cogit JumpAboveOrEqual: 0.
+ methodInBounds :=
+ cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg.
+ (cogit backEnd byteReadsZeroExtend
+ or: [signedVersion])
+ ifTrue:
+ [cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg]
+ ifFalse:
+ [cogit "formatReg already contains a value <= 16r1f, so no need to zero it"
+ MoveXbr: Arg1Reg R: ReceiverResultReg R: formatReg;
+ MoveR: formatReg R: ReceiverResultReg].
+ signedVersion ifTrue:
+ [cogit SignExtend8R: ReceiverResultReg R: ReceiverResultReg].
+ convertToIntAndReturn := cogit Label.
+ self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ jumpIsShorts jmpTarget:
+ (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: nSlotsOrBytesReg).
+ cogit AndCq: 1 R: formatReg.
+ cogit SubR: formatReg R: nSlotsOrBytesReg;
+ CmpR: Arg1Reg R: nSlotsOrBytesReg.
+ jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddR: Arg1Reg R: ReceiverResultReg.
+ cogit AddR: Arg1Reg R: ReceiverResultReg.
+ cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
+ signedVersion ifTrue:
+ [cogit SignExtend16R: ReceiverResultReg R: ReceiverResultReg].
+ cogit Jump: convertToIntAndReturn.
+
+ jumpIsWords jmpTarget:
+ (cogit CmpR: Arg1Reg R: nSlotsOrBytesReg).
+ jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: TempReg.
+ jumpWordTooBig := self jumpNotSmallIntegerUnsignedValueInRegister: TempReg.
+ cogit MoveR: TempReg R: ReceiverResultReg.
+ cogit Jump: convertToIntAndReturn.
+
+ jumpHasFixedFields jmpTarget:
+ (cogit AndCq: objectMemory classIndexMask R: TempReg).
+ cogit MoveR: TempReg R: formatReg.
+ cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
+ jumpIsContext := cogit JumpZero: 0.
+ cogit PushR: nSlotsOrBytesReg.
+ self genGetClassObjectOfClassIndex: formatReg into: nSlotsOrBytesReg scratchReg: TempReg.
+ self genLoadSlot: InstanceSpecificationIndex sourceReg: nSlotsOrBytesReg destReg: formatReg.
+ cogit PopR: nSlotsOrBytesReg.
+ self genConvertSmallIntegerToIntegerInReg: formatReg.
+ cogit
+ AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
+ SubR: formatReg R: nSlotsOrBytesReg;
+ CmpR: Arg1Reg R: nSlotsOrBytesReg.
+ jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ "index is (formatReg (fixed fields) + Arg1Reg (0-rel index)) * wordSize + baseHeaderSize"
+ cogit AddR: formatReg R: Arg1Reg.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ jumpIsMethod jmpTarget: cogit Label.
+ "Now check that the index is beyond the method's literals..."
+ self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: nSlotsOrBytesReg scratch: TempReg.
+ cogit CmpR: Arg1Reg R: nSlotsOrBytesReg.
+ cogit JumpBelow: methodInBounds.
+ jumpMethodOutOfBounds := cogit Jump: 0.
+
+ jumpWordTooBig jmpTarget:
+ (jumpFixedFieldsOutOfBounds jmpTarget:
+ (jumpArrayOutOfBounds jmpTarget:
+ (jumpBytesOutOfBounds jmpTarget:
+ (jumpMethodOutOfBounds jmpTarget:
+ (jumpShortsOutOfBounds jmpTarget:
+ (jumpWordsOutOfBounds jmpTarget:
+ (jumpNotIndexable jmpTarget:
+ (jumpIsContext jmpTarget:
+ (jumpBadIndex jmpTarget:
+ (jumpImmediate jmpTarget: cogit Label)))))))))).
+
+ ^0 "Can't be complete because of contexts."!
Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genAlloc64BitIntegerValue:into:scratchReg:scratchReg: (in category 'primitive generators') -----
- genAlloc64BitIntegerValue: valueReg into: resultReg scratchReg: scratch1 scratchReg: scratch2
- <returnTypeC: #'AbstractInstruction *'>
- | allocSize newLPIHeader jumpFail |
- <var: #jumpFail type: #'AbstractInstruction *'>
- allocSize := objectMemory baseHeaderSize + objectMemory wordSize.
- newLPIHeader := objectMemory
- headerForSlots: 1
- format: objectMemory firstByteFormat
- classIndex: ClassLargePositiveIntegerCompactIndex.
- cogit MoveAw: objectMemory freeStartAddress R: resultReg.
- cogit LoadEffectiveAddressMw: allocSize r: resultReg R: scratch1.
- cogit CmpCq: objectMemory getScavengeThreshold R: scratch1.
- jumpFail := cogit JumpAboveOrEqual: 0.
- cogit MoveR: scratch1 Aw: objectMemory freeStartAddress.
- self genStoreHeader: newLPIHeader intoNewInstance: resultReg using: scratch1.
- cogit MoveR: valueReg Mw: objectMemory baseHeaderSize r: resultReg.
- ^jumpFail!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genAlloc64BitPositiveIntegerValue:into:scratchReg:scratchReg: (in category 'primitive generators') -----
+ genAlloc64BitPositiveIntegerValue: valueReg into: resultReg scratchReg: scratch1 scratchReg: scratch2
+ <returnTypeC: #'AbstractInstruction *'>
+ | allocSize newLPIHeader jumpFail |
+ allocSize := objectMemory baseHeaderSize + objectMemory wordSize.
+ newLPIHeader := objectMemory
+ headerForSlots: 1
+ format: objectMemory firstByteFormat
+ classIndex: ClassLargePositiveIntegerCompactIndex.
+ cogit MoveAw: objectMemory freeStartAddress R: resultReg.
+ cogit LoadEffectiveAddressMw: allocSize r: resultReg R: scratch1.
+ cogit CmpCq: objectMemory getScavengeThreshold R: scratch1.
+ jumpFail := cogit JumpAboveOrEqual: 0.
+ cogit MoveR: scratch1 Aw: objectMemory freeStartAddress.
+ self genStoreHeader: newLPIHeader intoNewInstance: resultReg using: scratch1.
+ cogit MoveR: valueReg Mw: objectMemory baseHeaderSize r: resultReg.
+ ^jumpFail!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genAlloc64BitSignedIntegerValue:into:scratchReg:scratchReg: (in category 'primitive generators') -----
+ genAlloc64BitSignedIntegerValue: valueReg into: resultReg scratchReg: scratch1 scratchReg: scratch2
+ <returnTypeC: #'AbstractInstruction *'>
+ | allocSize newLNIHeader jumpFail jumpNeg |
+ allocSize := objectMemory baseHeaderSize + objectMemory wordSize.
+ newLNIHeader := objectMemory
+ headerForSlots: 1
+ format: objectMemory firstByteFormat
+ classIndex: ClassLargeNegativeIntegerCompactIndex.
+ cogit MoveAw: objectMemory freeStartAddress R: resultReg.
+ cogit LoadEffectiveAddressMw: allocSize r: resultReg R: scratch1.
+ cogit CmpCq: objectMemory getScavengeThreshold R: scratch1.
+ jumpFail := cogit JumpAboveOrEqual: 0.
+ cogit MoveR: scratch1 Aw: objectMemory freeStartAddress.
+ cogit MoveCq: newLNIHeader R: scratch1.
+ cogit CmpCq: 0 R: valueReg.
+ jumpNeg := cogit JumpLess: 0.
+ "We can avoid duplicating the large constant and a jump choosing between
+ the alternatives by incrementing the single constant if positive. The assert
+ checks that the hack works. Compact code is to be preferred because it is
+ an uncommon case; usually the value will fit in a SmallInteger."
+ self assert: (objectMemory headerForSlots: 0 format: 0 classIndex: 1) = 1.
+ cogit AddCq: ClassLargePositiveIntegerCompactIndex - ClassLargeNegativeIntegerCompactIndex R: scratch1.
+ jumpNeg jmpTarget:
+ (cogit MoveR: scratch1 Mw: 0 r: resultReg).
+ "The old less compact code was
+ cogit CmpCq: 0 R: valueReg.
+ jumpNeg := cogit JumpLess: 0.
+ cogit MoveCq: newLPIHeader R: scratch1.
+ jumpJoin := cogit Jump: 0.
+ jumpNeg jmpTarget:
+ (cogit MoveCq: newLNIHeader R: scratch1).
+ jumpJoin jmpTarget:
+ (cogit MoveR: scratch1 Mw: 0 r: resultReg)."
+ cogit MoveR: valueReg Mw: objectMemory baseHeaderSize r: resultReg.
+ ^jumpFail!
Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveAt (in category 'primitive generators') -----
- genPrimitiveAt
- | formatReg nSlotsOrElementsReg convertToIntAndReturn methodInBounds
- jumpNotIndexable jumpImmediate jumpBadIndex
- jumpIsBytes jumpIsShorts jumpIsWords jumpIsLongs jumpIsMethod jumpIsArray jumpIsContext
- jumpHasFixedFields jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
- jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpLongsOutOfBounds
- jumpFailAlloc jumpNotSmallInteger |
- "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
- <var: #jumpIsBytes type: #'AbstractInstruction *'>
- <var: #jumpIsLongs type: #'AbstractInstruction *'>
- <var: #jumpFailAlloc type: #'AbstractInstruction *'>
- <var: #jumpIsShorts type: #'AbstractInstruction *'>
- <var: #jumpIsMethod type: #'AbstractInstruction *'>
- <var: #jumpBadIndex type: #'AbstractInstruction *'>
- <var: #jumpIsContext type: #'AbstractInstruction *'>
- <var: #jumpImmediate type: #'AbstractInstruction *'>
- <var: #methodInBounds type: #'AbstractInstruction *'>
- <var: #jumpNotIndexable type: #'AbstractInstruction *'>
- <var: #jumpHasFixedFields type: #'AbstractInstruction *'>
- <var: #jumpNotSmallInteger type: #'AbstractInstruction *'>
- <var: #convertToIntAndReturn type: #'AbstractInstruction *'>
- <var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpLongsOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
-
- nSlotsOrElementsReg := ClassReg.
-
- cogit genLoadArgAtDepth: 0 into: Arg0Reg.
- jumpImmediate := self genJumpImmediate: ReceiverResultReg.
- cogit MoveR: Arg0Reg R: Arg1Reg.
- jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
- cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
-
- "formatReg := self formatOf: ReceiverResultReg"
- self genGetFormatOf: ReceiverResultReg
- into: (formatReg := SendNumArgsReg)
- leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
-
- self genGetNumSlotsOf: ReceiverResultReg into: nSlotsOrElementsReg.
-
- "dispatch on format in a combination of highest dynamic frequency order first and convenience.
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 unused, reserved for exotic pointer objects?
- 7 Forwarded Object, 1st field is pointer, rest of fields are ignored
- 8 unused, reserved for exotic non-pointer objects?
- 9 64-bit indexable
- 10 - 11 32-bit indexable
- 12 - 15 16-bit indexable
- 16 - 23 byte indexable
- 24 - 31 compiled method"
- cogit CmpCq: objectMemory firstByteFormat R: formatReg.
- jumpIsBytes := cogit JumpAboveOrEqual: 0.
- cogit CmpCq: objectMemory arrayFormat R: formatReg.
- jumpIsArray := cogit JumpZero: 0.
- jumpNotIndexable := cogit JumpBelow: 0.
- cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
- jumpHasFixedFields := cogit JumpBelowOrEqual: 0.
- cogit CmpCq: objectMemory firstShortFormat R: formatReg.
- jumpIsShorts := cogit JumpAboveOrEqual: 0.
- cogit CmpCq: objectMemory firstLongFormat R: formatReg.
- jumpIsWords := cogit JumpAboveOrEqual: 0.
- cogit CmpCq: objectMemory sixtyFourBitIndexableFormat R: formatReg.
- jumpIsLongs := cogit JumpZero: 0.
- jumpNotIndexable jmpTarget: cogit Label.
- jumpNotIndexable := cogit Jump: 0.
-
- jumpIsArray jmpTarget:
- (cogit CmpR: Arg1Reg R: nSlotsOrElementsReg).
- jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpIsBytes jmpTarget:
- (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: nSlotsOrElementsReg).
- cogit AndCq: 7 R: formatReg R: TempReg.
- cogit SubR: TempReg R: nSlotsOrElementsReg;
- CmpR: Arg1Reg R: nSlotsOrElementsReg.
- jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
- jumpIsMethod := cogit JumpAboveOrEqual: 0.
- methodInBounds :=
- (cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg).
- cogit backEnd byteReadsZeroExtend
- ifTrue:
- [cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg]
- ifFalse:
- [cogit "formatReg already contains a value <= 16r1f, so no need to zero it"
- MoveXbr: Arg1Reg R: ReceiverResultReg R: formatReg;
- MoveR: formatReg R: ReceiverResultReg].
- convertToIntAndReturn := cogit Label.
- self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpIsShorts jmpTarget:
- (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: nSlotsOrElementsReg).
- cogit AndCq: 3 R: formatReg.
- cogit SubR: formatReg R: nSlotsOrElementsReg;
- CmpR: Arg1Reg R: nSlotsOrElementsReg.
- jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit AddR: Arg1Reg R: ReceiverResultReg.
- cogit AddR: Arg1Reg R: ReceiverResultReg.
- cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
- cogit Jump: convertToIntAndReturn.
-
- jumpIsWords jmpTarget:
- (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 2 R: nSlotsOrElementsReg).
- cogit AndCq: 1 R: formatReg.
- cogit SubR: formatReg R: nSlotsOrElementsReg;
- CmpR: Arg1Reg R: nSlotsOrElementsReg.
- jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit AddCq: objectMemory baseHeaderSize >> (objectMemory shiftForWord - 1) R: Arg1Reg.
- cogit MoveX32r: Arg1Reg R: ReceiverResultReg R: TempReg.
- cogit MoveR: TempReg R: ReceiverResultReg.
- cogit Jump: convertToIntAndReturn.
-
- jumpHasFixedFields jmpTarget:
- (cogit AndCq: objectMemory classIndexMask R: TempReg).
- cogit MoveR: TempReg R: formatReg.
- cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
- jumpIsContext := cogit JumpZero: 0.
- self genGetClassObjectOfClassIndex: formatReg into: Extra0Reg scratchReg: TempReg.
- self genLoadSlot: InstanceSpecificationIndex sourceReg: Extra0Reg destReg: formatReg.
- self genConvertSmallIntegerToIntegerInReg: formatReg.
- cogit
- AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
- SubR: formatReg R: nSlotsOrElementsReg;
- CmpR: Arg1Reg R: nSlotsOrElementsReg.
- jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
- "index is (formatReg (fixed fields) + Arg1Reg (0-rel index)) * wordSize + baseHeaderSize"
- cogit AddR: formatReg R: Arg1Reg.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpIsLongs jmpTarget:
- (cogit CmpR: Arg1Reg R: nSlotsOrElementsReg).
- jumpLongsOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ClassReg.
- cogit MoveR: ClassReg R: TempReg.
- cogit LogicalShiftRightCq: self numSmallIntegerBits - 1 R: TempReg. "If in range this is now 0"
- (cogit lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
- [cogit CmpCq: 0 R: TempReg]. "N.B. FLAGS := ClassReg - 0"
- jumpNotSmallInteger := cogit JumpNonZero: 0.
- cogit MoveR: ClassReg R: ReceiverResultReg.
- cogit Jump: convertToIntAndReturn.
- jumpNotSmallInteger jmpTarget: cogit Label.
- jumpFailAlloc := self genAlloc64BitIntegerValue: ClassReg into: SendNumArgsReg scratchReg: Extra0Reg scratchReg: TempReg.
- cogit MoveR: SendNumArgsReg R: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpIsMethod jmpTarget: cogit Label.
- "Now check that the index is beyond the method's literals..."
- self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: nSlotsOrElementsReg scratch: TempReg.
- cogit CmpR: Arg1Reg R: nSlotsOrElementsReg.
- cogit JumpBelow: methodInBounds.
-
- jumpFailAlloc jmpTarget:
- (jumpLongsOutOfBounds jmpTarget:
- (jumpFixedFieldsOutOfBounds jmpTarget:
- (jumpArrayOutOfBounds jmpTarget:
- (jumpBytesOutOfBounds jmpTarget:
- (jumpShortsOutOfBounds jmpTarget:
- (jumpWordsOutOfBounds jmpTarget:
- (jumpNotIndexable jmpTarget:
- (jumpIsContext jmpTarget:
- (jumpBadIndex jmpTarget:
- (jumpImmediate jmpTarget: cogit Label)))))))))).
-
- ^0 "Can't be complete because of contexts."!
Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveAtPut (in category 'primitive generators') -----
- genPrimitiveAtPut
- | formatReg nSlotsOrBytesReg methodInBounds
- jumpImmediate jumpBadIndex jumpImmutable jumpNotIndexablePointers jumpNotIndexableBits
- jumpIsContext jumpIsCompiledMethod jumpIsBytes jumpIsShorts jumpIsWords jumpHasFixedFields
- jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
- jumpWordsOutOfBounds jumpShortsOutOfBounds jumpBytesOutOfBounds
- jumpShortsOutOfRange jumpWordsOutOfRange jumpBytesOutOfRange
- jumpNonSmallIntegerValue jumpNotPointers
- rejoin jumpNegative jump64BitsOutOfBounds jumpNot64BitIndexable jump64BitArgIsImmediate jumpNot8ByteInteger
- |
- "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
- <var: #jumpIsBytes type: #'AbstractInstruction *'>
- <var: #jumpIsWords type: #'AbstractInstruction *'>
- <var: #jumpIsShorts type: #'AbstractInstruction *'>
- <var: #jumpBadIndex type: #'AbstractInstruction *'>
- <var: #jumpIsContext type: #'AbstractInstruction *'>
- <var: #jumpImmediate type: #'AbstractInstruction *'>
- <var: #methodInBounds type: #'AbstractInstruction *'>
- <var: #jumpHasFixedFields type: #'AbstractInstruction *'>
- <var: #jumpNotIndexableBits type: #'AbstractInstruction *'>
- <var: #jumpBytesOutOfRange type: #'AbstractInstruction *'>
- <var: #jumpWordsOutOfRange type: #'AbstractInstruction *'>
- <var: #jumpShortsOutOfRange type: #'AbstractInstruction *'>
- <var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
- <var: #jumpNotIndexablePointers type: #'AbstractInstruction *'>
- <var: #rejoin type: #'AbstractInstruction *'>
- <var: #jumpNegative type: #'AbstractInstruction *'>
- <var: #jumpNot8ByteInteger type: #'AbstractInstruction *'>
- <var: #jumpNot64BitIndexable type: #'AbstractInstruction *'>
- <var: #jump64BitsOutOfBounds type: #'AbstractInstruction *'>
- <var: #jump64BitArgIsImmediate type: #'AbstractInstruction *'>
- nSlotsOrBytesReg := ClassReg.
-
- cogit genLoadArgAtDepth: 1 into: Arg0Reg.
- cogit genLoadArgAtDepth: 0 into: Arg1Reg.
- 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 genGetNumSlotsOf: ReceiverResultReg into: nSlotsOrBytesReg.
-
- "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: nSlotsOrBytesReg.
- 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 genPrimReturn.
-
- jumpHasFixedFields jmpTarget: cogit Label.
- self genGetClassIndexOfNonImm: ReceiverResultReg into: formatReg.
- cogit CmpCq: ClassMethodContextCompactIndex R: formatReg.
- jumpIsContext := cogit JumpZero: 0.
- "get # fixed fields in formatReg"
- self genGetClassObjectOfClassIndex: formatReg into: Extra0Reg scratchReg: TempReg.
- self genLoadSlot: InstanceSpecificationIndex sourceReg: Extra0Reg destReg: formatReg.
- self genConvertSmallIntegerToIntegerInReg: formatReg.
- cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg.
- cogit SubR: formatReg R: nSlotsOrBytesReg.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: formatReg.
- cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
- jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit AddR: formatReg R: Arg0Reg.
- cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
- cogit MoveR: Arg1Reg R: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpNotPointers jmpTarget: cogit Label.
- jumpNonSmallIntegerValue := self genJumpNotSmallInteger: Arg1Reg scratchReg: TempReg.
- cogit CmpCq: objectMemory firstByteFormat R: formatReg.
- jumpIsBytes := cogit JumpAboveOrEqual: 0.
- cogit CmpCq: objectMemory firstShortFormat R: formatReg.
- jumpIsShorts := cogit JumpAboveOrEqual: 0.
- cogit CmpCq: objectMemory firstLongFormat R: formatReg.
- jumpIsWords := cogit JumpAboveOrEqual: 0.
- cogit CmpCq: objectMemory sixtyFourBitIndexableFormat R: formatReg.
- jumpNotIndexableBits := cogit JumpNonZero: 0.
- "fall through to 64-bit words"
- cogit MoveR: Arg1Reg R: SendNumArgsReg.
- self genConvertSmallIntegerToIntegerInReg: SendNumArgsReg.
- cogit CmpCq: 0 R: SendNumArgsReg.
- jumpNegative := cogit JumpLess: 0.
- rejoin :=
- cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
- jump64BitsOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
- cogit MoveR: SendNumArgsReg Xwr: Arg0Reg R: ReceiverResultReg.
- cogit MoveR: Arg1Reg R: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpNonSmallIntegerValue jmpTarget:
- (cogit CmpCq: objectMemory sixtyFourBitIndexableFormat R: formatReg).
- jumpNot64BitIndexable := cogit JumpNonZero: 0.
- jump64BitArgIsImmediate := self genJumpImmediate: Arg1Reg.
- "Now check if the header is that of an 8 byte LargePositiveInteger"
- cogit MoveMw: 0 r: Arg1Reg R: SendNumArgsReg.
- cogit AndCq: (objectMemory
- headerForSlots: objectMemory numSlotsMask
- format: objectMemory formatMask
- classIndex: objectMemory classIndexMask)
- R: SendNumArgsReg.
- cogit CmpCq: (objectMemory
- headerForSlots: 1
- format: objectMemory firstByteFormat
- classIndex: ClassLargePositiveIntegerCompactIndex)
- R: SendNumArgsReg.
- jumpNot8ByteInteger := cogit JumpNonZero: 0.
- cogit MoveMw: objectMemory baseHeaderSize r: Arg1Reg R: SendNumArgsReg.
- cogit Jump: rejoin.
-
- jumpIsWords jmpTarget:
- (cogit CmpCq: (objectMemory integerObjectOf: 16rFFFFFFFF) R: Arg1Reg).
- jumpWordsOutOfRange := cogit JumpAbove: 0.
- cogit LogicalShiftLeftCq: objectMemory shiftForWord - 2 R: nSlotsOrBytesReg.
- cogit AndCq: objectMemory wordSize / 4 - 1 R: formatReg.
- cogit SubR: formatReg R: nSlotsOrBytesReg.
- cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
- jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit MoveR: Arg1Reg R: TempReg.
- self genConvertSmallIntegerToIntegerInReg: TempReg.
- cogit AddCq: objectMemory baseHeaderSize >> (objectMemory shiftForWord - 1) R: Arg0Reg.
- cogit MoveR: TempReg X32r: Arg0Reg R: ReceiverResultReg.
- cogit MoveR: Arg1Reg R: ReceiverResultReg.
- cogit genPrimReturn.
-
- jumpIsBytes jmpTarget:
- (cogit CmpCq: (objectMemory integerObjectOf: 255) R: Arg1Reg).
- jumpBytesOutOfRange := cogit JumpAbove: 0.
- cogit LogicalShiftLeftCq: objectMemory shiftForWord R: nSlotsOrBytesReg.
- cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
- cogit SubR: TempReg R: nSlotsOrBytesReg.
- cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
- jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
- jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
- methodInBounds :=
- 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 genPrimReturn.
-
- jumpIsShorts jmpTarget:
- (cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg).
- jumpShortsOutOfRange := cogit JumpAbove: 0.
- cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: nSlotsOrBytesReg.
- cogit AndCq: objectMemory wordSize / 2 - 1 R: formatReg.
- cogit SubR: formatReg R: nSlotsOrBytesReg.
- cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
- jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
- cogit MoveR: Arg1Reg R: TempReg.
- self genConvertSmallIntegerToIntegerInReg: TempReg.
- cogit AddR: Arg0Reg R: ReceiverResultReg.
- cogit AddR: Arg0Reg R: ReceiverResultReg.
- cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
- cogit MoveR: Arg1Reg R: ReceiverResultReg.
- cogit genPrimReturn.
-
- "Now check that the index is beyond the method's literals..."
- jumpIsCompiledMethod jmpTarget: cogit Label.
- self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: nSlotsOrBytesReg scratch: TempReg.
- cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
- cogit JumpBelow: methodInBounds.
-
- jumpNegative jmpTarget:
- (jumpNot8ByteInteger jmpTarget:
- (jump64BitArgIsImmediate jmpTarget:
- (jumpNot64BitIndexable jmpTarget:
- (jumpIsContext jmpTarget:
- (jumpNotIndexableBits jmpTarget:
- (jumpBytesOutOfRange jmpTarget:
- (jumpShortsOutOfRange jmpTarget:
- (jumpWordsOutOfRange jmpTarget:
- (jumpIsCompiledMethod jmpTarget:
- (jumpArrayOutOfBounds jmpTarget:
- (jumpBytesOutOfBounds jmpTarget:
- (jumpShortsOutOfBounds jmpTarget:
- (jumpWordsOutOfBounds jmpTarget:
- (jump64BitsOutOfBounds jmpTarget:
- (jumpNotIndexablePointers jmpTarget:
- (jumpFixedFieldsOutOfBounds jmpTarget: cogit Label)))))))))))))))).
-
- self cppIf: IMMUTABILITY
- ifTrue: [jumpImmutable jmpTarget: jumpIsContext getJmpTarget].
-
- cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
- self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
-
- jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
-
- ^0 "Can't be complete because of contexts."!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveAtPutSigned: (in category 'primitive generators') -----
+ genPrimitiveAtPutSigned: signedVersion
+ "Generate the code for primitives 61 & 165, at:put:/basicAt:put: & integerAt:put:. If signedVersion is true
+ then generate signed accesses to the bits classes (a la 164 & 165). If signedVersion is false,
+ generate unsigned accesses (a la 60, 61, 63 & 64)."
+ | formatReg nSlotsOrBytesReg methodInBounds
+ jumpImmediate jumpBadIndex jumpImmutable jumpNotIndexablePointers jumpNotIndexableBits
+ jumpIsContext jumpIsCompiledMethod jumpIsBytes jumpIsShorts jumpIsWords jumpHasFixedFields
+ jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
+ jumpWordsOutOfBounds jumpShortsOutOfBounds jumpBytesOutOfBounds
+ jumpShortsOutOfRange jumpWordsOutOfRange jumpBytesOutOfRange jumpDoubleWordsOutOfRange
+ jumpNonSmallIntegerValue jumpNotPointers
+ rejoin jumpNegative jump64BitsOutOfBounds jumpNot64BitIndexable jump64BitArgIsImmediate jumpNot8ByteInteger
+ |
+ "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
+ nSlotsOrBytesReg := ClassReg.
+
+ cogit genLoadArgAtDepth: 1 into: Arg0Reg.
+ cogit genLoadArgAtDepth: 0 into: Arg1Reg.
+ 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 genGetNumSlotsOf: ReceiverResultReg into: nSlotsOrBytesReg.
+
+ "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: nSlotsOrBytesReg.
+ 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 genPrimReturn.
+
+ jumpHasFixedFields jmpTarget: cogit Label.
+ self genGetClassIndexOfNonImm: ReceiverResultReg into: formatReg.
+ cogit CmpCq: ClassMethodContextCompactIndex R: formatReg.
+ jumpIsContext := cogit JumpZero: 0.
+ "get # fixed fields in formatReg"
+ self genGetClassObjectOfClassIndex: formatReg into: Extra0Reg scratchReg: TempReg.
+ self genLoadSlot: InstanceSpecificationIndex sourceReg: Extra0Reg destReg: formatReg.
+ self genConvertSmallIntegerToIntegerInReg: formatReg.
+ cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg.
+ cogit SubR: formatReg R: nSlotsOrBytesReg.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: formatReg.
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddR: formatReg R: Arg0Reg.
+ cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
+ cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ jumpNotPointers jmpTarget: cogit Label.
+ jumpNonSmallIntegerValue := self genJumpNotSmallInteger: Arg1Reg scratchReg: TempReg.
+ cogit CmpCq: objectMemory firstByteFormat R: formatReg.
+ jumpIsBytes := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory firstShortFormat R: formatReg.
+ jumpIsShorts := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory firstLongFormat R: formatReg.
+ jumpIsWords := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory sixtyFourBitIndexableFormat R: formatReg.
+ jumpNotIndexableBits := cogit JumpNonZero: 0.
+ "fall through to 64-bit words"
+ cogit MoveR: Arg1Reg R: SendNumArgsReg.
+ self genConvertSmallIntegerToIntegerInReg: SendNumArgsReg.
+ signedVersion ifFalse:
+ [cogit CmpCq: 0 R: SendNumArgsReg.
+ jumpNegative := cogit JumpLess: 0].
+ rejoin :=
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ jump64BitsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
+ cogit MoveR: SendNumArgsReg Xwr: Arg0Reg R: ReceiverResultReg.
+ cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ "Handle LargePositiveInteger (unsigned) or LargePositiveInteger and LargeNegativeInteger (signed)
+ for sixtyFourBitIndexableFormat"
+ jumpNonSmallIntegerValue jmpTarget:
+ (cogit CmpCq: objectMemory sixtyFourBitIndexableFormat R: formatReg).
+ jumpNot64BitIndexable := cogit JumpNonZero: 0.
+ jump64BitArgIsImmediate := self genJumpImmediate: Arg1Reg.
+ signedVersion ifTrue: "Test top bit of 64-bit word in large integer for range check."
+ [cogit MoveMw: objectMemory baseHeaderSize r: Arg1Reg R: TempReg.
+ cogit CmpCq: 0 R: TempReg.
+ jumpDoubleWordsOutOfRange := cogit JumpLess: 0].
+ "Now check if the header is that of an 8 byte LargePositiveInteger"
+ cogit MoveMw: 0 r: Arg1Reg R: SendNumArgsReg.
+ cogit AndCq: (objectMemory
+ headerForSlots: objectMemory numSlotsMask
+ format: objectMemory formatMask
+ classIndex: objectMemory classIndexMask)
+ R: SendNumArgsReg.
+ cogit CmpCq: (objectMemory
+ headerForSlots: 1
+ format: objectMemory firstByteFormat
+ classIndex: ClassLargePositiveIntegerCompactIndex)
+ R: SendNumArgsReg.
+ jumpNot8ByteInteger := cogit JumpNonZero: 0.
+ cogit MoveMw: objectMemory baseHeaderSize r: Arg1Reg R: SendNumArgsReg.
+ cogit Jump: rejoin.
+ signedVersion ifTrue:
+ ["Now check if the header is that of an 8 byte LargeNegativeInteger"
+ jumpNot8ByteInteger jmpTarget:
+ (cogit CmpCq: (objectMemory
+ headerForSlots: 1
+ format: objectMemory firstByteFormat
+ classIndex: ClassLargeNegativeIntegerCompactIndex)
+ R: SendNumArgsReg).
+ jumpNot8ByteInteger := cogit JumpNonZero: 0.
+ cogit MoveMw: objectMemory baseHeaderSize r: Arg1Reg R: TempReg.
+ cogit MoveCq: 0 R: SendNumArgsReg.
+ cogit SubR: TempReg R: SendNumArgsReg.
+ cogit Jump: rejoin].
+
+ signedVersion
+ ifTrue:
+ [jumpIsWords jmpTarget:
+ (cogit MoveR: SendNumArgsReg R: TempReg).
+ cogit ArithmeticShiftRightCq: 31 R: TempReg. "Maps in range to -1,0".
+ cogit AddCq: 1 R: TempReg. "Maps in range to 0,1"
+ cogit CmpCq: 1 R: TempReg]
+ ifFalse:
+ [jumpIsWords jmpTarget:
+ (cogit CmpCq: (objectMemory integerObjectOf: 16rFFFFFFFF) R: Arg1Reg)].
+ jumpWordsOutOfRange := cogit JumpAbove: 0.
+ cogit LogicalShiftLeftCq: objectMemory shiftForWord - 2 R: nSlotsOrBytesReg.
+ cogit AndCq: objectMemory wordSize / 4 - 1 R: formatReg.
+ cogit SubR: formatReg R: nSlotsOrBytesReg.
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit MoveR: Arg1Reg R: TempReg.
+ self genConvertSmallIntegerToIntegerInReg: TempReg.
+ cogit AddCq: objectMemory baseHeaderSize >> (objectMemory shiftForWord - 1) R: Arg0Reg.
+ cogit MoveR: TempReg X32r: Arg0Reg R: ReceiverResultReg.
+ cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ signedVersion
+ ifTrue:
+ [jumpIsBytes jmpTarget:
+ (cogit MoveR: SendNumArgsReg R: TempReg).
+ cogit ArithmeticShiftRightCq: 7 R: TempReg. "Maps in range to -1,0".
+ cogit AddCq: 1 R: TempReg. "Maps in range to 0,1"
+ cogit CmpCq: 1 R: TempReg]
+ ifFalse:
+ [jumpIsBytes jmpTarget:
+ (cogit CmpCq: (objectMemory integerObjectOf: 255) R: Arg1Reg)].
+ jumpBytesOutOfRange := cogit JumpAbove: 0.
+ cogit LogicalShiftLeftCq: objectMemory shiftForWord R: nSlotsOrBytesReg.
+ cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
+ cogit SubR: TempReg R: nSlotsOrBytesReg.
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
+ jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
+ methodInBounds :=
+ 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 genPrimReturn.
+
+ signedVersion
+ ifTrue:
+ [jumpIsShorts jmpTarget:
+ (cogit MoveR: SendNumArgsReg R: TempReg).
+ cogit ArithmeticShiftRightCq: 15 R: TempReg. "Maps in range to -1,0".
+ cogit AddCq: 1 R: TempReg. "Maps in range to 0,1"
+ cogit CmpCq: 1 R: TempReg]
+ ifFalse:
+ [jumpIsShorts jmpTarget:
+ (cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg)].
+ jumpShortsOutOfRange := cogit JumpAbove: 0.
+ cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: nSlotsOrBytesReg.
+ cogit AndCq: objectMemory wordSize / 2 - 1 R: formatReg.
+ cogit SubR: formatReg R: nSlotsOrBytesReg.
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit MoveR: Arg1Reg R: TempReg.
+ self genConvertSmallIntegerToIntegerInReg: TempReg.
+ cogit AddR: Arg0Reg R: ReceiverResultReg.
+ cogit AddR: Arg0Reg R: ReceiverResultReg.
+ cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
+ cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ "Now check that the index is beyond the method's literals..."
+ jumpIsCompiledMethod jmpTarget: cogit Label.
+ self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: nSlotsOrBytesReg scratch: TempReg.
+ cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
+ cogit JumpBelow: methodInBounds.
+
+
+ jumpNot8ByteInteger jmpTarget:
+ (jump64BitArgIsImmediate jmpTarget:
+ (jumpNot64BitIndexable jmpTarget:
+ (jumpIsContext jmpTarget:
+ (jumpNotIndexableBits jmpTarget:
+ (jumpBytesOutOfRange jmpTarget:
+ (jumpShortsOutOfRange jmpTarget:
+ (jumpWordsOutOfRange jmpTarget:
+ (jumpIsCompiledMethod jmpTarget:
+ (jumpArrayOutOfBounds jmpTarget:
+ (jumpBytesOutOfBounds jmpTarget:
+ (jumpShortsOutOfBounds jmpTarget:
+ (jumpWordsOutOfBounds jmpTarget:
+ (jump64BitsOutOfBounds jmpTarget:
+ (jumpNotIndexablePointers jmpTarget:
+ (jumpFixedFieldsOutOfBounds jmpTarget: cogit Label))))))))))))))).
+ signedVersion
+ ifTrue: [jumpDoubleWordsOutOfRange jmpTarget: jumpIsContext getJmpTarget]
+ ifFalse: [jumpNegative jmpTarget: jumpIsContext getJmpTarget].
+ self cppIf: IMMUTABILITY
+ ifTrue: [jumpImmutable jmpTarget: jumpIsContext getJmpTarget].
+
+ cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
+ self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
+
+ jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
+
+ ^0 "Can't be complete because of contexts."!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveAtSigned: (in category 'primitive generators') -----
+ genPrimitiveAtSigned: signedVersion
+ "Generate the code for primitives 60 & 164, at:/basicAt: & integerAt:. If signedVersion is true
+ then generate signed accesses to the bits classes (a la 164 & 165). If signedVersion is false,
+ generate unsigned accesses (a la 60, 61, 63 & 64)."
+ | formatReg nSlotsOrElementsReg convertToIntAndReturn methodInBounds
+ jumpNotIndexable jumpImmediate jumpBadIndex
+ jumpIsBytes jumpIsShorts jumpIsWords jumpIsLongs jumpIsMethod jumpIsArray jumpIsContext
+ jumpHasFixedFields jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
+ jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpLongsOutOfBounds
+ jumpFailAlloc jumpNotSmallInteger |
+ "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
+
+ nSlotsOrElementsReg := ClassReg.
+
+ cogit genLoadArgAtDepth: 0 into: Arg0Reg.
+ jumpImmediate := self genJumpImmediate: ReceiverResultReg.
+ cogit MoveR: Arg0Reg R: Arg1Reg.
+ jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
+ self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
+ cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
+
+ "formatReg := self formatOf: ReceiverResultReg"
+ self genGetFormatOf: ReceiverResultReg
+ into: (formatReg := SendNumArgsReg)
+ leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
+
+ self genGetNumSlotsOf: ReceiverResultReg into: nSlotsOrElementsReg.
+
+ "dispatch on format in a combination of highest dynamic frequency order first and convenience.
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 unused, reserved for exotic pointer objects?
+ 7 Forwarded Object, 1st field is pointer, rest of fields are ignored
+ 8 unused, reserved for exotic non-pointer objects?
+ 9 64-bit indexable
+ 10 - 11 32-bit indexable
+ 12 - 15 16-bit indexable
+ 16 - 23 byte indexable
+ 24 - 31 compiled method"
+ cogit CmpCq: objectMemory firstByteFormat R: formatReg.
+ jumpIsBytes := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory arrayFormat R: formatReg.
+ jumpIsArray := cogit JumpZero: 0.
+ jumpNotIndexable := cogit JumpBelow: 0.
+ cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
+ jumpHasFixedFields := cogit JumpBelowOrEqual: 0.
+ cogit CmpCq: objectMemory firstShortFormat R: formatReg.
+ jumpIsShorts := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory firstLongFormat R: formatReg.
+ jumpIsWords := cogit JumpAboveOrEqual: 0.
+ cogit CmpCq: objectMemory sixtyFourBitIndexableFormat R: formatReg.
+ jumpIsLongs := cogit JumpZero: 0.
+ jumpNotIndexable jmpTarget: cogit Label.
+ jumpNotIndexable := cogit Jump: 0.
+
+ jumpIsArray jmpTarget:
+ (cogit CmpR: Arg1Reg R: nSlotsOrElementsReg).
+ jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ jumpIsBytes jmpTarget:
+ (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: nSlotsOrElementsReg).
+ cogit AndCq: 7 R: formatReg R: TempReg.
+ cogit SubR: TempReg R: nSlotsOrElementsReg;
+ CmpR: Arg1Reg R: nSlotsOrElementsReg.
+ jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
+ jumpIsMethod := cogit JumpAboveOrEqual: 0.
+ methodInBounds :=
+ cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg.
+ (cogit backEnd byteReadsZeroExtend
+ or: [signedVersion])
+ ifTrue:
+ [cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg]
+ ifFalse:
+ [cogit "formatReg already contains a value <= 16r1f, so no need to zero it"
+ MoveXbr: Arg1Reg R: ReceiverResultReg R: formatReg;
+ MoveR: formatReg R: ReceiverResultReg].
+ signedVersion ifTrue:
+ [cogit SignExtend8R: ReceiverResultReg R: ReceiverResultReg].
+ convertToIntAndReturn := cogit Label.
+ self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ jumpIsShorts jmpTarget:
+ (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: nSlotsOrElementsReg).
+ cogit AndCq: 3 R: formatReg.
+ cogit SubR: formatReg R: nSlotsOrElementsReg;
+ CmpR: Arg1Reg R: nSlotsOrElementsReg.
+ jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddR: Arg1Reg R: ReceiverResultReg.
+ cogit AddR: Arg1Reg R: ReceiverResultReg.
+ cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
+ signedVersion ifTrue:
+ [cogit SignExtend16R: ReceiverResultReg R: ReceiverResultReg].
+ cogit Jump: convertToIntAndReturn.
+
+ jumpIsWords jmpTarget:
+ (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 2 R: nSlotsOrElementsReg).
+ cogit AndCq: 1 R: formatReg.
+ cogit SubR: formatReg R: nSlotsOrElementsReg;
+ CmpR: Arg1Reg R: nSlotsOrElementsReg.
+ jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize >> (objectMemory shiftForWord - 1) R: Arg1Reg.
+ cogit MoveX32r: Arg1Reg R: ReceiverResultReg R: TempReg.
+ cogit MoveR: TempReg R: ReceiverResultReg.
+ signedVersion ifTrue:
+ [cogit SignExtend32R: ReceiverResultReg R: ReceiverResultReg].
+ cogit Jump: convertToIntAndReturn.
+
+ jumpHasFixedFields jmpTarget:
+ (cogit AndCq: objectMemory classIndexMask R: TempReg).
+ cogit MoveR: TempReg R: formatReg.
+ cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
+ jumpIsContext := cogit JumpZero: 0.
+ self genGetClassObjectOfClassIndex: formatReg into: Extra0Reg scratchReg: TempReg.
+ self genLoadSlot: InstanceSpecificationIndex sourceReg: Extra0Reg destReg: formatReg.
+ self genConvertSmallIntegerToIntegerInReg: formatReg.
+ cogit
+ AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
+ SubR: formatReg R: nSlotsOrElementsReg;
+ CmpR: Arg1Reg R: nSlotsOrElementsReg.
+ jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ "index is (formatReg (fixed fields) + Arg1Reg (0-rel index)) * wordSize + baseHeaderSize"
+ cogit AddR: formatReg R: Arg1Reg.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
+ cogit genPrimReturn.
+
+ jumpIsLongs jmpTarget:
+ (cogit CmpR: Arg1Reg R: nSlotsOrElementsReg).
+ jumpLongsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ClassReg.
+ cogit MoveR: ClassReg R: TempReg.
+ signedVersion
+ ifTrue: "c.f. Spur64BitMemoryManager>>#isIntegerValue:"
+ [cogit ArithmeticShiftRightCq: self numSmallIntegerBits R: TempReg. "If in range this is now 0 or -1"
+ cogit AndCq: 16rF R: TempReg.
+ cogit CmpCq: 1 R: TempReg.
+ jumpNotSmallInteger := cogit JumpAbove: 0.
+ cogit MoveR: ClassReg R: ReceiverResultReg.
+ cogit Jump: convertToIntAndReturn.
+ jumpNotSmallInteger jmpTarget: cogit Label.
+ jumpFailAlloc := self genAlloc64BitSignedIntegerValue: ClassReg into: SendNumArgsReg scratchReg: Extra0Reg scratchReg: TempReg.
+ cogit MoveR: SendNumArgsReg R: ReceiverResultReg.
+ cogit genPrimReturn]
+ ifFalse:
+ [cogit LogicalShiftRightCq: self numSmallIntegerBits - 1 R: TempReg. "If in range this is now 0"
+ (cogit lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
+ [cogit CmpCq: 0 R: TempReg]. "N.B. FLAGS := ClassReg - 0"
+ jumpNotSmallInteger := cogit JumpNonZero: 0.
+ cogit MoveR: ClassReg R: ReceiverResultReg.
+ cogit Jump: convertToIntAndReturn.
+ jumpNotSmallInteger jmpTarget: cogit Label.
+ jumpFailAlloc := self genAlloc64BitPositiveIntegerValue: ClassReg into: SendNumArgsReg scratchReg: Extra0Reg scratchReg: TempReg.
+ cogit MoveR: SendNumArgsReg R: ReceiverResultReg.
+ cogit genPrimReturn].
+
+ jumpIsMethod jmpTarget: cogit Label.
+ "Now check that the index is beyond the method's literals..."
+ self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: nSlotsOrElementsReg scratch: TempReg.
+ cogit CmpR: Arg1Reg R: nSlotsOrElementsReg.
+ cogit JumpBelow: methodInBounds.
+
+ jumpFailAlloc jmpTarget:
+ (jumpLongsOutOfBounds jmpTarget:
+ (jumpFixedFieldsOutOfBounds jmpTarget:
+ (jumpArrayOutOfBounds jmpTarget:
+ (jumpBytesOutOfBounds jmpTarget:
+ (jumpShortsOutOfBounds jmpTarget:
+ (jumpWordsOutOfBounds jmpTarget:
+ (jumpNotIndexable jmpTarget:
+ (jumpIsContext jmpTarget:
+ (jumpBadIndex jmpTarget:
+ (jumpImmediate jmpTarget: cogit Label)))))))))).
+
+ ^0 "Can't be complete because of contexts."!
Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genPrimitiveAt (in category 'primitive generators') -----
+ genPrimitiveAt
+ "Generate primitive 60, at: with unsigned access for pure bits classes."
+ ^self genPrimitiveAtSigned: false!
Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genPrimitiveAtPut (in category 'primitive generators') -----
+ genPrimitiveAtPut
+ "Generate primitive 61, at:put: with unsigned access for pure bits classes."
+ ^self genPrimitiveAtPutSigned: false!
Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genPrimitiveIntegerAt (in category 'primitive generators') -----
+ genPrimitiveIntegerAt
+ "Generate primitive 164, at: with signed access for pure bits classes."
+ ^self genPrimitiveAtSigned: true!
Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genPrimitiveIntegerAtPut (in category 'primitive generators') -----
+ genPrimitiveIntegerAtPut
+ "Generate primitive 165, at:put: with signed access for pure bits classes."
+ ^self genPrimitiveAtPutSigned: true!
Item was removed:
- ----- Method: CogVMSimulator>>primBitmapcompresstoByteArray (in category 'other primitives') -----
- primBitmapcompresstoByteArray
- ^ self primitiveFail!
Item was removed:
- ----- Method: CogVMSimulator>>primBitmapdecompressfromByteArrayat (in category 'other primitives') -----
- primBitmapdecompressfromByteArrayat
- | indexInt index baOop bmOop baSize bmSize ba bm |
- indexInt := self stackTop.
- (objectMemory isIntegerValue: indexInt) ifFalse: [^ self primitiveFail].
- index := objectMemory integerValueOf: indexInt.
- baOop := self stackValue: 1.
- bmOop := self stackValue: 2.
- baSize := self stSizeOf: baOop.
- bmSize := self stSizeOf: bmOop.
- ba := ByteArray new: baSize.
- bm := Bitmap new: bmSize.
-
- "Copy the byteArray into ba"
- 1 to: baSize do: [:i | ba at: i put: (objectMemory fetchByte: i-1 ofObject: baOop)].
-
- "Decompress ba into bm"
- bm decompress: bm fromByteArray: ba at: index.
-
- "Then copy bm into the Bitmap"
- 1 to: bmSize do: [:i | objectMemory storeLong32: i-1 ofObject: bmOop withValue: (bm at: i)].
- self pop: 3!
Item was added:
+ ----- Method: CogX64Compiler>>canSignExtend (in category 'testing') -----
+ canSignExtend
+ "x64 has native SignExtend8RR, SignExtend16RR, & SignExtend32RR."
+ <inline: true>
+ ^true!
Item was added:
+ ----- Method: CogX64Compiler>>canZeroExtend (in category 'testing') -----
+ canZeroExtend
+ "x64 has native ZeroExtend8RR, ZeroExtend16RR, & ZeroExtend32RR."
+ <inline: true>
+ ^true!
Item was changed:
----- Method: Cogit>>SignExtend16R:R: (in category 'abstract instructions') -----
SignExtend16R: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
+ backEnd canSignExtend
+ ifTrue: [^self gen: SignExtend16RR operand: reg1 operand: reg2]
+ ifFalse:
+ [| first |
+ reg1 = reg2
+ ifTrue:
+ [first := self LogicalShiftLeftCq: BytesPerWord * 8 - 16 R: reg1]
+ ifFalse:
+ [first := self MoveR: reg1 R: reg2.
+ self LogicalShiftLeftCq: BytesPerWord * 8 - 16 R: reg1].
+ self ArithmeticShiftRightCq: BytesPerWord * 8 - 16 R: reg2.
+ ^first]!
- ^self gen: SignExtend16RR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>SignExtend32R:R: (in category 'abstract instructions') -----
SignExtend32R: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
+ backEnd canSignExtend
+ ifTrue: [^self gen: SignExtend32RR operand: reg1 operand: reg2]
+ ifFalse:
+ [| first |
+ reg1 = reg2
+ ifTrue:
+ [first := self LogicalShiftLeftCq: 32 R: reg1]
+ ifFalse:
+ [first := self MoveR: reg1 R: reg2.
+ self LogicalShiftLeftCq: 32 R: reg1].
+ self ArithmeticShiftRightCq: 32 R: reg2.
+ ^first]!
- ^self gen: SignExtend32RR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>SignExtend8R:R: (in category 'abstract instructions') -----
SignExtend8R: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
+ backEnd canSignExtend
+ ifTrue: [^self gen: SignExtend8RR operand: reg1 operand: reg2]
+ ifFalse:
+ [| first |
+ reg1 = reg2
+ ifTrue:
+ [first := self LogicalShiftLeftCq: BytesPerWord * 8 - 8 R: reg1]
+ ifFalse:
+ [first := self MoveR: reg1 R: reg2.
+ self LogicalShiftLeftCq: BytesPerWord * 8 - 8 R: reg1].
+ self ArithmeticShiftRightCq: BytesPerWord * 8 - 8 R: reg2.
+ ^first]!
- ^self gen: SignExtend8RR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>ZeroExtend16R:R: (in category 'abstract instructions') -----
ZeroExtend16R: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
+ backEnd canZeroExtend
+ ifTrue: [^self gen: ZeroExtend16RR operand: reg1 operand: reg2]
+ ifFalse:
+ [| first |
+ reg1 = reg2
+ ifTrue:
+ [first := self LogicalShiftLeftCq: BytesPerWord * 8 - 16 R: reg1]
+ ifFalse:
+ [first := self MoveR: reg1 R: reg2.
+ self LogicalShiftLeftCq: BytesPerWord * 8 - 16 R: reg1].
+ self LogicalShiftRightCq: BytesPerWord * 8 - 16 R: reg2.
+ ^first]!
- ^self gen: ZeroExtend16RR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>ZeroExtend32R:R: (in category 'abstract instructions') -----
ZeroExtend32R: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
+ backEnd canZeroExtend
+ ifTrue: [^self gen: ZeroExtend32RR operand: reg1 operand: reg2]
+ ifFalse:
+ [| first |
+ reg1 = reg2
+ ifTrue:
+ [first := self LogicalShiftLeftCq: 32 R: reg1]
+ ifFalse:
+ [first := self MoveR: reg1 R: reg2.
+ self LogicalShiftLeftCq: 32 R: reg1].
+ self LogicalShiftRightCq: 32 R: reg2.
+ ^first]!
- ^self gen: ZeroExtend32RR operand: reg1 operand: reg2!
Item was changed:
----- Method: Cogit>>ZeroExtend8R:R: (in category 'abstract instructions') -----
ZeroExtend8R: reg1 R: reg2
<inline: true>
<returnTypeC: #'AbstractInstruction *'>
+ backEnd canZeroExtend
+ ifTrue: [^self gen: ZeroExtend8RR operand: reg1 operand: reg2]
+ ifFalse:
+ [| first |
+ reg1 = reg2
+ ifTrue:
+ [first := self LogicalShiftLeftCq: BytesPerWord * 8 - 8 R: reg1]
+ ifFalse:
+ [first := self MoveR: reg1 R: reg2.
+ self LogicalShiftLeftCq: BytesPerWord * 8 - 8 R: reg1].
+ self LogicalShiftRightCq: BytesPerWord * 8 - 8 R: reg2.
+ ^first]!
- ^self gen: ZeroExtend8RR operand: reg1 operand: reg2!
Item was added:
+ ----- Method: InterpreterPrimitives>>isSignedInteger:inRangeForBits: (in category 'primitive support') -----
+ isSignedInteger: integer inRangeForBits: nBits
+ "Answer if integer will fit within a variable of nBits, where nBits is 8, 16, 32 or 64.
+ Signed shift right by nBits - 1 to map in-range values to either 0 or -1.
+ Add one to map in-range values to 0 or 1.
+ Perform an unsigned comparison for greater than 1 to eliminate values out of range."
+ <inline: true>
+ ^self cCode: [(self asUnsigned: (integer signedBitShift: 1 - nBits) + 1) <= 1]
+ inSmalltalk: [((integer bitShift: 1 - nBits) + 1 bitAnd: objectMemory maxCInteger) <= 1]!
Item was changed:
+ ----- Method: InterpreterPrimitives>>primitiveIntegerAt (in category 'indexing primitives') -----
- ----- Method: InterpreterPrimitives>>primitiveIntegerAt (in category 'sound primitives') -----
primitiveIntegerAt
+ SPURVM
+ ifTrue: [self primitiveSpurIntegerAt] "Answer the signed integer element of a pure bits receiver"
+ ifFalse: [self primitiveV3IntegerAt] "Answer the 32 bit signed integer contents of a words receiver"!
- "Return the 32bit signed integer contents of a words receiver"
-
- | index rcvr sz addr intValue result |
- <var: #intValue type: #int>
- index := self stackValue: 0.
- (objectMemory isIntegerObject: index) ifFalse:
- [^self primitiveFailFor: PrimErrBadArgument].
- rcvr := self stackValue: 1.
- (objectMemory isWords: rcvr) ifFalse:
- [^self primitiveFailFor: PrimErrInappropriate].
- index := objectMemory integerValueOf: index.
- 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"
- intValue := objectMemory intAt: addr.
- result := self signed32BitIntegerFor: intValue.
- self pop: 2 thenPush: result!
Item was changed:
+ ----- Method: InterpreterPrimitives>>primitiveIntegerAtPut (in category 'indexing primitives') -----
- ----- Method: InterpreterPrimitives>>primitiveIntegerAtPut (in category 'sound primitives') -----
primitiveIntegerAtPut
+ SPURVM
+ ifTrue: [self primitiveSpurIntegerAtPut] "Assign an indexable variable of a pure bits receiver with a signed integer."
+ ifFalse: [self primitiveV3IntegerAtPut] "Assign an indexable variable of a words receiver with a 32 bit signed integer."!
- "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].
- (objectMemory isObjImmutable: rcvr) ifTrue:
- [^self primitiveFailFor: PrimErrNoModification].
- 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 added:
+ ----- Method: InterpreterPrimitives>>primitiveSpurIntegerAt (in category 'indexing primitives') -----
+ primitiveSpurIntegerAt
+ "Answer the signed integer element of a pure bits receiver.
+ If the receiver is indexable pointers simply function like at:.
+ Favour bits access over pointer access (normal at: being available)."
+
+ <inline: true>
+ | index rcvr fmt numSlots value |
+ index := self stackTop.
+ rcvr := self stackValue: 1.
+ (objectMemory isIntegerObject: index) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ (objectMemory isImmediate: rcvr) ifTrue:
+ [^self primitiveFailFor: PrimErrBadReceiver].
+ fmt := objectMemory formatOf: rcvr.
+ index := (objectMemory integerValueOf: index) - 1.
+
+ fmt >= objectMemory firstByteFormat ifTrue:
+ [fmt >= objectMemory firstCompiledMethodFormat ifTrue:
+ [^self primitiveFailFor: PrimErrUnsupported].
+ numSlots := objectMemory numBytesOfBytes: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [value := objectMemory fetchByte: index ofObject: rcvr.
+ value > 127 ifTrue: [value := value - 256].
+ self methodReturnInteger: value.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt >= objectMemory firstShortFormat ifTrue:
+ [numSlots := objectMemory num16BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [value := objectMemory fetchShort16: index ofObject: rcvr.
+ value > 32767 ifTrue: [value := value - 65536].
+ self methodReturnInteger: value.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
+ [numSlots := objectMemory num64BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [self
+ cCode:
+ [self methodReturnValue: (self signed64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr))]
+ inSmalltalk:
+ [value := objectMemory fetchLong64: index ofObject: rcvr.
+ value > ((2 raisedTo: 63) - 1) ifTrue:
+ [value := value - (2 raisedTo: 64)].
+ self methodReturnValue: (self signed64BitIntegerFor: value)].
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt >= objectMemory firstLongFormat ifTrue:
+ [numSlots := objectMemory num32BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [objectMemory bytesPerOop = 8
+ ifTrue:
+ [value := objectMemory fetchLong32: index ofObject: rcvr.
+ value > 2147483647 ifTrue: [value := value - 4294967296].
+ self methodReturnInteger: value]
+ ifFalse: [self methodReturnValue: (self signed32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr))].
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ (fmt <= objectMemory lastPointerFormat
+ and: [objectMemory isIndexableFormat: fmt]) ifTrue:
+ [| numFixed |
+ numSlots := objectMemory numSlotsOf: rcvr.
+ fmt = objectMemory arrayFormat ifTrue:
+ [(self asUnsigned: index) < numSlots ifTrue:
+ [self methodReturnValue: (objectMemory fetchPointer: index ofObject: rcvr).
+ ^0]].
+ numFixed := self numFixedSlotsOf: rcvr.
+ (index + 1 between: numFixed and: numSlots) ifTrue:
+ [self methodReturnValue: (objectMemory fetchPointer: index + numFixed ofObject: rcvr).
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ ^self primitiveFailFor: PrimErrBadReceiver!
Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveSpurIntegerAtPut (in category 'indexing primitives') -----
+ primitiveSpurIntegerAtPut
+ "Assign an indexable variable of a pure bits receiver with a signed integer.
+ If the receiver is indexable pointers simply function like at:put: primitive 61.
+ Favour bits access over pointer access (normal at:put: being available)."
+
+ <inline: true>
+ | index rcvr value valueOop fmt numSlots |
+ valueOop := self stackValue: 0.
+ index := self stackValue: 1.
+ rcvr := self stackValue: 2.
+ value := self signed64BitValueOf: valueOop.
+ (self successful
+ and: [objectMemory isIntegerObject: index]) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ (objectMemory isImmediate: rcvr) ifTrue:
+ [^self primitiveFailFor: PrimErrBadReceiver].
+ (objectMemory isObjImmutable: rcvr) ifTrue:
+ [^self primitiveFailFor: PrimErrNoModification].
+ fmt := objectMemory formatOf: rcvr.
+ index := (objectMemory integerValueOf: index) - 1.
+
+ fmt >= objectMemory firstByteFormat ifTrue:
+ [fmt >= objectMemory firstCompiledMethodFormat ifTrue:
+ [^self primitiveFailFor: PrimErrUnsupported].
+ (self isSignedInteger: value inRangeForBits: 8) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ numSlots := objectMemory numBytesOfBytes: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [objectMemory storeByte: index ofObject: rcvr withValue: (self cCode: [value] inSmalltalk: [value bitAnd: 16rFF]).
+ self methodReturnValue: valueOop.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt >= objectMemory firstShortFormat ifTrue:
+ [(self isSignedInteger: value inRangeForBits: 16) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ numSlots := objectMemory num16BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [objectMemory storeShort16: index ofObject: rcvr withValue: (self cCode: [value] inSmalltalk: [value bitAnd: 16rFFFF]).
+ self methodReturnValue: valueOop.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
+ ["No range check on value in this case because signed64BitValueOf: performed it above."
+ numSlots := objectMemory num64BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [objectMemory storeLong64: index ofObject: rcvr withValue: (self cCode: [value] inSmalltalk: [value bitAnd: 16rFFFFFFFFFFFFFFFF]).
+ self methodReturnValue: valueOop.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ fmt >= objectMemory firstLongFormat ifTrue:
+ [(self isSignedInteger: value inRangeForBits: 32) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ numSlots := objectMemory num32BitUnitsOf: rcvr.
+ (self asUnsigned: index) < numSlots ifTrue:
+ [objectMemory storeLong32: index ofObject: rcvr withValue: (self cCode: [value] inSmalltalk: [value bitAnd: 16rFFFFFFFF]).
+ self methodReturnValue: valueOop.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ (fmt <= objectMemory lastPointerFormat
+ and: [objectMemory isIndexableFormat: fmt]) ifTrue:
+ [| numFixed |
+ numSlots := objectMemory numSlotsOf: rcvr.
+ fmt = objectMemory arrayFormat ifTrue:
+ [(self asUnsigned: index) < numSlots ifTrue:
+ [self storePointer: index ofObject: rcvr withValue: valueOop.
+ self methodReturnValue: valueOop.
+ ^0]].
+ numFixed := self numFixedSlotsOf: rcvr.
+ (index + 1 between: numFixed and: numSlots) ifTrue:
+ [self storePointer: index + numFixed ofObject: rcvr withValue: valueOop.
+ self methodReturnValue: valueOop.
+ ^0].
+ ^self primitiveFailFor: PrimErrBadIndex].
+
+ ^self primitiveFailFor: PrimErrBadReceiver!
Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveV3IntegerAt (in category 'indexing primitives') -----
+ primitiveV3IntegerAt
+ "Answer the 32bit signed integer contents of a words receiver"
+ <inline: true>
+ | index rcvr sz addr intValue result |
+ <var: #intValue type: #int>
+ index := self stackValue: 0.
+ (objectMemory isIntegerObject: index) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ rcvr := self stackValue: 1.
+ (objectMemory isWords: rcvr) ifFalse:
+ [^self primitiveFailFor: PrimErrInappropriate].
+ index := objectMemory integerValueOf: index.
+ 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"
+ intValue := objectMemory intAt: addr.
+ result := self signed32BitIntegerFor: intValue.
+ self pop: 2 thenPush: result!
Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveV3IntegerAtPut (in category 'indexing primitives') -----
+ primitiveV3IntegerAtPut
+ "Assign an indexable variable of a words receiver with a 32 bit signed integer."
+ | 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].
+ (objectMemory isObjImmutable: rcvr) ifTrue:
+ [^self primitiveFailFor: PrimErrNoModification].
+ 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 removed:
- ----- Method: InterpreterSimulator>>primBitmapcompresstoByteArray (in category 'other primitives') -----
- primBitmapcompresstoByteArray
- ^ self primitiveFail!
Item was removed:
- ----- Method: InterpreterSimulator>>primBitmapdecompressfromByteArrayat (in category 'other primitives') -----
- primBitmapdecompressfromByteArrayat
- | indexInt index baOop bmOop baSize bmSize ba bm |
- indexInt := self stackTop.
- (self isIntegerValue: indexInt) ifFalse: [^ self primitiveFail].
- index := self integerValueOf: indexInt.
- baOop := self stackValue: 1.
- bmOop := self stackValue: 2.
- baSize := self stSizeOf: baOop.
- bmSize := self stSizeOf: bmOop.
- ba := ByteArray new: baSize.
- bm := Bitmap new: bmSize.
-
- "Copy the byteArray into ba"
- 1 to: baSize do: [:i | ba at: i put: (self fetchByte: i-1 ofObject: baOop)].
-
- "Decompress ba into bm"
- bm decompress: bm fromByteArray: ba at: index.
-
- "Then copy bm into the Bitmap"
- 1 to: bmSize do: [:i | self storeLong32: i-1 ofObject: bmOop withValue: (bm at: i)].
- self pop: 3!
Item was changed:
----- Method: SimpleStackBasedCogit class>>initializePrimitiveTableForNewsqueak (in category 'class initialization') -----
initializePrimitiveTableForNewsqueak
"Initialize the table of primitive generators. This does not include normal primitives implemented in the coInterpreter.
N.B. primitives that don't have an explicit arg count (the integer following the generator) may be variadic."
"SimpleStackBasedCogit initializePrimitiveTableForNewsqueak"
MaxCompiledPrimitiveIndex := self objectRepresentationClass wordSize = 8
ifTrue: [555]
ifFalse: [222].
primitiveTable := CArrayAccessor on: (Array new: MaxCompiledPrimitiveIndex + 1).
self table: primitiveTable from:
#( "Integer Primitives (0-19)"
(1 genPrimitiveAdd 1)
(2 genPrimitiveSubtract 1)
(3 genPrimitiveLessThan 1)
(4 genPrimitiveGreaterThan 1)
(5 genPrimitiveLessOrEqual 1)
(6 genPrimitiveGreaterOrEqual 1)
(7 genPrimitiveEqual 1)
(8 genPrimitiveNotEqual 1)
(9 genPrimitiveMultiply 1)
(10 genPrimitiveDivide 1)
(11 genPrimitiveMod 1)
(12 genPrimitiveDiv 1)
(13 genPrimitiveQuo 1)
(14 genPrimitiveBitAnd 1)
(15 genPrimitiveBitOr 1)
(16 genPrimitiveBitXor 1)
(17 genPrimitiveBitShift 1)
"(18 primitiveMakePoint)"
"(19 primitiveFail)" "Guard primitive for simulation -- *must* fail"
"LargeInteger Primitives (20-39)"
"(20 primitiveFail)"
"(21 primitiveAddLargeIntegers)"
"(22 primitiveSubtractLargeIntegers)"
"(23 primitiveLessThanLargeIntegers)"
"(24 primitiveGreaterThanLargeIntegers)"
"(25 primitiveLessOrEqualLargeIntegers)"
"(26 primitiveGreaterOrEqualLargeIntegers)"
"(27 primitiveEqualLargeIntegers)"
"(28 primitiveNotEqualLargeIntegers)"
"(29 primitiveMultiplyLargeIntegers)"
"(30 primitiveDivideLargeIntegers)"
"(31 primitiveModLargeIntegers)"
"(32 primitiveDivLargeIntegers)"
"(33 primitiveQuoLargeIntegers)"
"(34 primitiveBitAndLargeIntegers)"
"(35 primitiveBitOrLargeIntegers)"
"(36 primitiveBitXorLargeIntegers)"
"(37 primitiveBitShiftLargeIntegers)"
"Float Primitives (38-59)"
"(38 genPrimitiveFloatAt)"
"(39 genPrimitiveFloatAtPut)"
(40 genPrimitiveAsFloat 0)
(41 genPrimitiveFloatAdd 1)
(42 genPrimitiveFloatSubtract 1)
(43 genPrimitiveFloatLessThan 1)
(44 genPrimitiveFloatGreaterThan 1)
(45 genPrimitiveFloatLessOrEqual 1)
(46 genPrimitiveFloatGreaterOrEqual 1)
(47 genPrimitiveFloatEqual 1)
(48 genPrimitiveFloatNotEqual 1)
(49 genPrimitiveFloatMultiply 1)
(50 genPrimitiveFloatDivide 1)
"(51 genPrimitiveTruncated)"
"(52 genPrimitiveFractionalPart)"
"(53 genPrimitiveExponent)"
"(54 genPrimitiveTimesTwoPower)"
(55 genPrimitiveFloatSquareRoot 0)
"(56 genPrimitiveSine)"
"(57 genPrimitiveArctan)"
"(58 genPrimitiveLogN)"
"(59 genPrimitiveExp)"
"Subscript and Stream Primitives (60-67)"
(60 genPrimitiveAt 1)
(61 genPrimitiveAtPut 2)
(62 genPrimitiveSize 0)
(63 genPrimitiveStringAt 1)
(64 genPrimitiveStringAtPut 2)
"The stream primitives no longer pay their way; normal Smalltalk code is faster."
(65 genFastPrimFail)"was primitiveNext"
(66 genFastPrimFail) "was primitiveNextPut"
(67 genFastPrimFail) "was primitiveAtEnd"
"StorageManagement Primitives (68-79)"
(68 genPrimitiveObjectAt 1) "Good for debugger/InstructionStream performance"
"(69 primitiveObjectAtPut)"
(70 genPrimitiveNew) "For VMMirror support 1 argument instantiateFixedClass: as well as baiscNew"
(71 genPrimitiveNewWithArg) "For VMMirror support 2 argument instantiateVariableClass:withSize: as well as baiscNew:"
"(72 primitiveArrayBecomeOneWay)" "Blue Book: primitiveBecome"
"(73 primitiveInstVarAt)"
"(74 primitiveInstVarAtPut)"
(75 genPrimitiveIdentityHash 0)
"(76 primitiveStoreStackp)" "Blue Book: primitiveAsObject"
"(77 primitiveSomeInstance)"
"(78 primitiveNextInstance)"
(79 genPrimitiveNewMethod 2)
"Control Primitives (80-89)"
"(80 primitiveFail)" "Blue Book: primitiveBlockCopy"
"(81 primitiveFail)" "Blue Book: primitiveValue"
"(82 primitiveFail)" "Blue Book: primitiveValueWithArgs"
(83 genPrimitivePerform)
"(84 primitivePerformWithArgs)"
"(85 primitiveSignal)"
"(86 primitiveWait)"
"(87 primitiveResume)"
"(88 primitiveSuspend)"
"(89 primitiveFlushCache)"
"System Primitives (110-119)"
(110 genPrimitiveIdentical 1)
(111 genPrimitiveClass) "For objectClass: and VMMirror support 1 argument classOf: as well as class"
"(112 primitiveBytesLeft)"
"(113 primitiveQuit)"
"(114 primitiveExitToDebugger)"
"(115 primitiveChangeClass)" "Blue Book: primitiveOopsLeft"
"(116 primitiveFlushCacheByMethod)"
"(117 primitiveExternalCall)"
"(118 primitiveDoPrimitiveWithArgs)"
"(119 primitiveFlushCacheSelective)"
(148 genPrimitiveShallowCopy 0) "a.k.a. clone"
+ (165 genPrimitiveIntegerAt 1) "Signed version of genPrimitiveAt"
+ (166 genPrimitiveIntegerAtPut 2) "Signed version of genPrimitiveAtPut"
+
(169 genPrimitiveNotIdentical 1)
(170 genPrimitiveAsCharacter) "SmallInteger>>asCharacter, Character class>>value:"
(171 genPrimitiveImmediateAsInteger 0) "Character>>value SmallFloat64>>asInteger"
"(173 primitiveSlotAt 1)"
"(174 primitiveSlotAtPut 2)"
(175 genPrimitiveIdentityHash 0) "Behavior>>identityHash"
"Old closure primitives"
"(186 primitiveFail)" "was primitiveClosureValue"
"(187 primitiveFail)" "was primitiveClosureValueWithArgs"
"Perform method directly"
"(188 primitiveExecuteMethodArgsArray)"
"(189 primitiveExecuteMethod)"
"Unwind primitives"
"(195 primitiveFindNextUnwindContext)"
"(196 primitiveTerminateTo)"
"(197 primitiveFindHandlerContext)"
(198 genFastPrimFail "primitiveMarkUnwindMethod")
(199 genFastPrimFail "primitiveMarkHandlerMethod")
"new closure primitives"
"(200 primitiveClosureCopyWithCopiedValues)"
(201 genPrimitiveClosureValue 0) "value"
(202 genPrimitiveClosureValue 1) "value:"
(203 genPrimitiveClosureValue 2) "value:value:"
(204 genPrimitiveClosureValue 3) "value:value:value:"
(205 genPrimitiveClosureValue 4) "value:value:value:value:"
"(206 genPrimitiveClosureValueWithArgs)" "valueWithArguments:"
"(210 primitiveContextAt)"
"(211 primitiveContextAtPut)"
"(212 primitiveContextSize)"
"(218 primitiveDoNamedPrimitiveWithArgs)"
"(219 primitiveFail)" "reserved for Cog primitives"
"(220 primitiveFail)" "reserved for Cog primitives"
(221 genPrimitiveClosureValue 0) "valueNoContextSwitch"
(222 genPrimitiveClosureValue 1) "valueNoContextSwitch:"
"SmallFloat primitives (540-559)"
(541 genPrimitiveSmallFloatAdd 1)
(542 genPrimitiveSmallFloatSubtract 1)
(543 genPrimitiveSmallFloatLessThan 1)
(544 genPrimitiveSmallFloatGreaterThan 1)
(545 genPrimitiveSmallFloatLessOrEqual 1)
(546 genPrimitiveSmallFloatGreaterOrEqual 1)
(547 genPrimitiveSmallFloatEqual 1)
(548 genPrimitiveSmallFloatNotEqual 1)
(549 genPrimitiveSmallFloatMultiply 1)
(550 genPrimitiveSmallFloatDivide 1)
"(551 genPrimitiveSmallFloatTruncated 0)"
"(552 genPrimitiveSmallFloatFractionalPart 0)"
"(553 genPrimitiveSmallFloatExponent 0)"
"(554 genPrimitiveSmallFloatTimesTwoPower 1)"
(555 genPrimitiveSmallFloatSquareRoot 0)
"(556 genPrimitiveSmallFloatSine 0)"
"(557 genPrimitiveSmallFloatArctan 0)"
"(558 genPrimitiveSmallFloatLogN 0)"
"(559 genPrimitiveSmallFloatExp 0)"
)!
Item was changed:
----- Method: SimpleStackBasedCogit class>>initializePrimitiveTableForSqueak (in category 'class initialization') -----
initializePrimitiveTableForSqueak
"Initialize the table of primitive generators. This does not include normal primitives implemented in the coInterpreter.
N.B. primitives that don't have an explicit arg count (the integer following the generator) may be variadic."
"SimpleStackBasedCogit initializePrimitiveTableForSqueak"
MaxCompiledPrimitiveIndex := self objectRepresentationClass wordSize = 8
ifTrue: [555]
ifFalse: [222].
primitiveTable := CArrayAccessor on: (Array new: MaxCompiledPrimitiveIndex + 1).
self table: primitiveTable from:
#( "Integer Primitives (0-19)"
(1 genPrimitiveAdd 1)
(2 genPrimitiveSubtract 1)
(3 genPrimitiveLessThan 1)
(4 genPrimitiveGreaterThan 1)
(5 genPrimitiveLessOrEqual 1)
(6 genPrimitiveGreaterOrEqual 1)
(7 genPrimitiveEqual 1)
(8 genPrimitiveNotEqual 1)
(9 genPrimitiveMultiply 1)
(10 genPrimitiveDivide 1)
(11 genPrimitiveMod 1)
(12 genPrimitiveDiv 1)
(13 genPrimitiveQuo 1)
(14 genPrimitiveBitAnd 1)
(15 genPrimitiveBitOr 1)
(16 genPrimitiveBitXor 1)
(17 genPrimitiveBitShift 1)
"(18 primitiveMakePoint)"
"(19 primitiveFail)" "Guard primitive for simulation -- *must* fail"
"LargeInteger Primitives (20-39)"
"(20 primitiveFail)"
"(21 primitiveAddLargeIntegers)"
"(22 primitiveSubtractLargeIntegers)"
"(23 primitiveLessThanLargeIntegers)"
"(24 primitiveGreaterThanLargeIntegers)"
"(25 primitiveLessOrEqualLargeIntegers)"
"(26 primitiveGreaterOrEqualLargeIntegers)"
"(27 primitiveEqualLargeIntegers)"
"(28 primitiveNotEqualLargeIntegers)"
"(29 primitiveMultiplyLargeIntegers)"
"(30 primitiveDivideLargeIntegers)"
"(31 primitiveModLargeIntegers)"
"(32 primitiveDivLargeIntegers)"
"(33 primitiveQuoLargeIntegers)"
"(34 primitiveBitAndLargeIntegers)"
"(35 primitiveBitOrLargeIntegers)"
"(36 primitiveBitXorLargeIntegers)"
"(37 primitiveBitShiftLargeIntegers)"
"Float Primitives (38-59)"
"(38 genPrimitiveFloatAt)"
"(39 genPrimitiveFloatAtPut)"
(40 genPrimitiveAsFloat 0)
(41 genPrimitiveFloatAdd 1)
(42 genPrimitiveFloatSubtract 1)
(43 genPrimitiveFloatLessThan 1)
(44 genPrimitiveFloatGreaterThan 1)
(45 genPrimitiveFloatLessOrEqual 1)
(46 genPrimitiveFloatGreaterOrEqual 1)
(47 genPrimitiveFloatEqual 1)
(48 genPrimitiveFloatNotEqual 1)
(49 genPrimitiveFloatMultiply 1)
(50 genPrimitiveFloatDivide 1)
"(51 genPrimitiveTruncated)"
"(52 genPrimitiveFractionalPart)"
"(53 genPrimitiveExponent)"
"(54 genPrimitiveTimesTwoPower)"
(55 genPrimitiveFloatSquareRoot 0)
"(56 genPrimitiveSine)"
"(57 genPrimitiveArctan)"
"(58 genPrimitiveLogN)"
"(59 genPrimitiveExp)"
"Subscript and Stream Primitives (60-67)"
(60 genPrimitiveAt 1)
(61 genPrimitiveAtPut 2)
(62 genPrimitiveSize 0)
(63 genPrimitiveStringAt 1)
(64 genPrimitiveStringAtPut 2)
"The stream primitives no longer pay their way; normal Smalltalk code is faster."
(65 genFastPrimFail)"was primitiveNext"
(66 genFastPrimFail) "was primitiveNextPut"
(67 genFastPrimFail) "was primitiveAtEnd"
"StorageManagement Primitives (68-79)"
(68 genPrimitiveObjectAt 1) "Good for debugger/InstructionStream performance"
"(69 primitiveObjectAtPut)"
(70 genPrimitiveNew 0)
(71 genPrimitiveNewWithArg 1)
"(72 primitiveArrayBecomeOneWay)" "Blue Book: primitiveBecome"
"(73 primitiveInstVarAt)"
"(74 primitiveInstVarAtPut)"
(75 genPrimitiveIdentityHash 0)
"(76 primitiveStoreStackp)" "Blue Book: primitiveAsObject"
"(77 primitiveSomeInstance)"
"(78 primitiveNextInstance)"
(79 genPrimitiveNewMethod 2)
"Control Primitives (80-89)"
"(80 primitiveFail)" "Blue Book: primitiveBlockCopy"
"(81 primitiveFail)" "Blue Book: primitiveValue"
"(82 primitiveFail)" "Blue Book: primitiveValueWithArgs"
(83 genPrimitivePerform)
"(84 primitivePerformWithArgs)"
"(85 primitiveSignal)"
"(86 primitiveWait)"
"(87 primitiveResume)"
"(88 primitiveSuspend)"
"(89 primitiveFlushCache)"
"(90 primitiveMousePoint)"
"(91 primitiveTestDisplayDepth)" "Blue Book: primitiveCursorLocPut"
"(92 primitiveSetDisplayMode)" "Blue Book: primitiveCursorLink"
"(93 primitiveInputSemaphore)"
"(94 primitiveGetNextEvent)" "Blue Book: primitiveSampleInterval"
"(95 primitiveInputWord)"
"(96 primitiveFail)" "primitiveCopyBits"
"(97 primitiveSnapshot)"
"(98 primitiveStoreImageSegment)"
"(99 primitiveLoadImageSegment)"
"(100 primitivePerformInSuperclass)" "Blue Book: primitiveSignalAtTick"
"(101 primitiveBeCursor)"
"(102 primitiveBeDisplay)"
"(103 primitiveScanCharacters)"
"(104 primitiveFail)" "primitiveDrawLoop"
(105 genPrimitiveStringReplace)
"(106 primitiveScreenSize)"
"(107 primitiveMouseButtons)"
"(108 primitiveKbdNext)"
"(109 primitiveKbdPeek)"
"System Primitives (110-119)"
(110 genPrimitiveIdentical 1)
(111 genPrimitiveClass) "Support both class and Context>>objectClass:"
"(112 primitiveBytesLeft)"
"(113 primitiveQuit)"
"(114 primitiveExitToDebugger)"
"(115 primitiveChangeClass)" "Blue Book: primitiveOopsLeft"
"(116 primitiveFlushCacheByMethod)"
"(117 primitiveExternalCall)"
"(118 primitiveDoPrimitiveWithArgs)"
"(119 primitiveFlushCacheSelective)"
(148 genPrimitiveShallowCopy 0) "a.k.a. clone"
(158 genPrimitiveStringCompareWith 1)
(159 genPrimitiveHashMultiply 0)
+ (165 genPrimitiveIntegerAt 1) "Signed version of genPrimitiveAt"
+ (166 genPrimitiveIntegerAtPut 2) "Signed version of genPrimitiveAtPut"
+
(169 genPrimitiveNotIdentical 1)
(170 genPrimitiveAsCharacter) "SmallInteger>>asCharacter, Character class>>value:"
(171 genPrimitiveImmediateAsInteger 0) "Character>>value SmallFloat64>>asInteger"
"(173 primitiveSlotAt 1)"
"(174 primitiveSlotAtPut 2)"
(175 genPrimitiveIdentityHash 0) "Behavior>>identityHash"
"Old closure primitives"
"(186 primitiveFail)" "was primitiveClosureValue"
"(187 primitiveFail)" "was primitiveClosureValueWithArgs"
"Perform method directly"
"(188 primitiveExecuteMethodArgsArray)"
"(189 primitiveExecuteMethod)"
"Unwind primitives"
"(195 primitiveFindNextUnwindContext)"
"(196 primitiveTerminateTo)"
"(197 primitiveFindHandlerContext)"
(198 genFastPrimFail "primitiveMarkUnwindMethod")
(199 genFastPrimFail "primitiveMarkHandlerMethod")
"new closure primitives"
"(200 primitiveClosureCopyWithCopiedValues)"
(201 genPrimitiveClosureValue 0) "value"
(202 genPrimitiveClosureValue 1) "value:"
(203 genPrimitiveClosureValue 2) "value:value:"
(204 genPrimitiveClosureValue 3) "value:value:value:"
(205 genPrimitiveClosureValue 4) "value:value:value:value:"
"(206 genPrimitiveClosureValueWithArgs)" "valueWithArguments:"
(207 genPrimitiveFullClosureValue) "value[:value:value:value:] et al"
"(208 genPrimitiveFullClosureValueWithArgs)" "valueWithArguments:"
(209 genPrimitiveFullClosureValue) "valueNoContextSwitch[:value:] et al"
"(210 primitiveContextAt)"
"(211 primitiveContextAtPut)"
"(212 primitiveContextSize)"
"(218 primitiveDoNamedPrimitiveWithArgs)"
"(219 primitiveFail)" "reserved for Cog primitives"
"(220 primitiveFail)" "reserved for Cog primitives"
(221 genPrimitiveClosureValue 0) "valueNoContextSwitch"
(222 genPrimitiveClosureValue 1) "valueNoContextSwitch:"
"SmallFloat primitives (540-559)"
(541 genPrimitiveSmallFloatAdd 1)
(542 genPrimitiveSmallFloatSubtract 1)
(543 genPrimitiveSmallFloatLessThan 1)
(544 genPrimitiveSmallFloatGreaterThan 1)
(545 genPrimitiveSmallFloatLessOrEqual 1)
(546 genPrimitiveSmallFloatGreaterOrEqual 1)
(547 genPrimitiveSmallFloatEqual 1)
(548 genPrimitiveSmallFloatNotEqual 1)
(549 genPrimitiveSmallFloatMultiply 1)
(550 genPrimitiveSmallFloatDivide 1)
"(551 genPrimitiveSmallFloatTruncated 0)"
"(552 genPrimitiveSmallFloatFractionalPart 0)"
"(553 genPrimitiveSmallFloatExponent 0)"
"(554 genPrimitiveSmallFloatTimesTwoPower 1)"
(555 genPrimitiveSmallFloatSquareRoot 0)
"(556 genPrimitiveSmallFloatSine 0)"
"(557 genPrimitiveSmallFloatArctan 0)"
"(558 genPrimitiveSmallFloatLogN 0)"
"(559 genPrimitiveSmallFloatExp 0)"
)!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>generateFromStack:on:indent: (in category 'translating builtins') -----
generateFromStack: aNode on: aStream indent: anInteger
| idList |
aNode args first isConstant ifFalse: [^self error: 'arg must be constant'].
pluginFunctionsUsed add: #stackValue:.
idList := aNode args first value.
(1 to: idList size)
do: [:i |
aStream
nextPutAll: (idList at: i);
nextPutAll: ' = stackValue(';
+ print: idList size - i;
- nextPutAll: (idList size - i) asString;
nextPut: $)]
separatedBy: [aStream nextPut: $;; crtab: anInteger].
!
Item was changed:
----- Method: SpurMemoryManager>>swizzleFieldsOfFreeChunk: (in category 'snapshot') -----
swizzleFieldsOfFreeChunk: chunk
<inline: true>
| field chunkBytes |
field := self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk.
field ~= 0 ifTrue:
[self storePointerNoAssert: self freeChunkNextIndex
ofFreeChunk: chunk
withValue: (segmentManager swizzleObj: field)].
+ chunkBytes := self bytesInObject: chunk.
+ false ifTrue: "The prevPointer is not guaranteed to be valid in older images.
+ updateListStartingAt: via updateFreeLists does restore the prev pointer
+ in all small free lists, so simply avoid swizzling it now."
+ [(self bytesBigEnoughForPrevPointer: chunkBytes) ifTrue:
+ [field := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk.
+ field ~= 0 ifTrue:
+ [self storePointerNoAssert: self freeChunkPrevIndex
+ ofFreeChunk: chunk
+ withValue: (segmentManager swizzleObj: field)]]].
- (self bytesBigEnoughForPrevPointer: (chunkBytes := self bytesInObject: chunk)) ifTrue:
- [field := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk.
- field ~= 0 ifTrue:
- [self storePointerNoAssert: self freeChunkPrevIndex
- ofFreeChunk: chunk
- withValue: (segmentManager swizzleObj: field)]].
chunkBytes >= (self numFreeLists * self allocationUnit) ifTrue:
[self freeChunkParentIndex to: self freeChunkLargerIndex do:
[:index|
field := self fetchPointer: index ofFreeChunk: chunk.
field ~= 0 ifTrue:
[self storePointerNoAssert: index
ofFreeChunk: chunk
withValue: (segmentManager swizzleObj: field)]]]!
Item was removed:
- ----- Method: StackInterpreterSimulator>>primBitmapcompresstoByteArray (in category 'other primitives') -----
- primBitmapcompresstoByteArray
- ^ self primitiveFail!
Item was removed:
- ----- Method: StackInterpreterSimulator>>primBitmapdecompressfromByteArrayat (in category 'other primitives') -----
- primBitmapdecompressfromByteArrayat
- | indexInt index baOop bmOop baSize bmSize ba bm |
- indexInt := self stackTop.
- (objectMemory isIntegerValue: indexInt) ifFalse: [^ self primitiveFail].
- index := objectMemory integerValueOf: indexInt.
- baOop := self stackValue: 1.
- bmOop := self stackValue: 2.
- baSize := self stSizeOf: baOop.
- bmSize := self stSizeOf: bmOop.
- ba := ByteArray new: baSize.
- bm := Bitmap new: bmSize.
-
- "Copy the byteArray into ba"
- 1 to: baSize do: [:i | ba at: i put: (objectMemory fetchByte: i-1 ofObject: baOop)].
-
- "Decompress ba into bm"
- bm decompress: bm fromByteArray: ba at: index.
-
- "Then copy bm into the Bitmap"
- 1 to: bmSize do: [:i | objectMemory storeLong32: i-1 ofObject: bmOop withValue: (bm at: i)].
- self pop: 3!
More information about the Vm-dev
mailing list