[Vm-dev] VM Maker: VMMaker.oscog-eem.1721.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Mar 10 22:13:18 UTC 2016
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1721.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1721
Author: eem
Time: 10 March 2016, 2:10:47.278868 pm
UUID: 0ff03e4d-2931-478e-93cc-4893234d94c0
Ancestors: VMMaker.oscog-tfel.1720
V3:
Fix simulation of fetchLong64:ofObject: and hence in signed64BitValueOf: et al.
Spur:
resolve the conflict between 32-bit and 64-bit tag assignments. In 32-bits we have 1=even SmallIntegers, 2=Characters, 3=odd SmallIntegers, and in 64-bits we had 1=SmallIntegers, 2=Characters, 3=SmallFloats. hence we would want SmallFloat64's identityHash to be 3, which conflicts with 32 bits' odd SmallIntegers. Change is for 64-bits to use 1=SmallIntegers, 2=Characters, 4=SmallFloats. This also means single-bit tests in the Cogit, which produces better code, and no scratch registers to hold masked tags.
Hence roll the 64-bit Spur image format version number from 68019 to 68021. Delegate to the object memories to determine the image format version number.
Add noInlineObjectAfter:limit: for a slighly less verbose initializeObjectMemory:
Turn the various class pun constants into macros for mor readable C.
Slang:
Allow super expansion to deal with methods with inner returns.
Timestamp plugin generation start.
Simulator:
Add missing facade methods.
Use the Squeak convention for window colours to eliminae the drab grey CoInterpreter simulation win dow (thanks Marcel!).
=============== Diff against VMMaker.oscog-tfel.1720 ===============
Item was changed:
----- Method: CoInterpreter>>setUpForUseByFacade: (in category 'debug support') -----
setUpForUseByFacade: aCurrentImageCoInterpreterFacade
"Set up variables with default values so that other initializations work.
numStackPages needs to be initialized so that interpreterAllocationReserveBytes
can be computed."
+ <doNotGenerate>
numStackPages := 0!
Item was changed:
----- Method: CogObjectRepresentation>>genJumpSmallInteger:scratchReg: (in category 'compile abstract instructions') -----
genJumpSmallInteger: aRegister scratchReg: scratch
"Generate a compare and branch to test if aRegister contains a SmallInteger.
Answer the jump. Use scratch if required. Subclasses will override if scratch is needed."
+ <inline: true>
^self genJumpSmallInteger: aRegister!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genConvertSmallFloatToSmallFloatHashAsIntegerInReg:scratch: (in category 'compile abstract instructions') -----
genConvertSmallFloatToSmallFloatHashAsIntegerInReg: reg scratch: scratch
"Convert the SmallFloat in reg to its identityHash as a SmallInteger.
+ Rotate the sign bit from bit 3 (zero-relative) to the sign bit.
+ c.f. Spur64BitMemoryManager>>rotatedFloatBitsOf:"
+ self assert: objectMemory smallFloatTag >> 1 - objectMemory smallIntegerTag = objectMemory smallIntegerTag.
- Rotate the sign bit from bit 3 (zero-relative) the sign bit. This implicitly sets
- SmallInteger tags (3 >> 1 = 1). c.f. Spur64BitMemoryManager>>rotatedFloatBitsOf:"
- self assert: objectMemory smallFloatTag >> 1 = objectMemory smallIntegerTag.
cogit
LogicalShiftRightCq: 1 R: reg;
AndCq: 1 << (objectMemory numTagBits - 1) R: reg R: scratch;
SubR: scratch R: reg;
+ SubCq: objectMemory smallFloatTag >> 1 - objectMemory smallIntegerTag R: reg;
LogicalShiftLeftCq: 63 - (objectMemory numTagBits - 1) R: scratch;
OrR: scratch R: reg.
^0!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genFloatArithmetic:preOpCheck:boxed: (in category 'primitive generators') -----
genFloatArithmetic: arithmeticOperator preOpCheck: preOpCheckOrNil boxed: rcvrBoxed
<var: #preOpCheckOrNil declareC: 'AbstractInstruction *(*preOpCheckOrNil)(int rcvrReg, int argReg)'>
<inline: false>
| jumpFailAlloc jumpFailCheck jumpImmediate jumpNotSmallFloat jumpNotSmallInteger jumpNotBoxedFloat doOp |
<var: #jumpNotSmallInteger type: #'AbstractInstruction *'>
<var: #jumpNotBoxedFloat type: #'AbstractInstruction *'>
<var: #jumpNotSmallFloat type: #'AbstractInstruction *'>
<var: #jumpImmediate type: #'AbstractInstruction *'>
<var: #jumpFailCheck type: #'AbstractInstruction *'>
<var: #jumpFailAlloc type: #'AbstractInstruction *'>
<var: #doOp type: #'AbstractInstruction *'>
cogit genLoadArgAtDepth: 0 into: Arg0Reg.
rcvrBoxed
ifTrue: [self genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0]
ifFalse: [self genGetSmallFloatValueOf: ReceiverResultReg scratch: TempReg into: DPFPReg0].
+ jumpNotSmallFloat := self genJumpNotSmallFloat: Arg0Reg.
- cogit
- MoveR: Arg0Reg R: ClassReg;
- AndCq: objectMemory tagMask R: ClassReg;
- CmpCq: objectMemory smallFloatTag R: ClassReg.
- jumpNotSmallFloat := cogit JumpNonZero: 0.
self genGetSmallFloatValueOf: Arg0Reg scratch: TempReg into: DPFPReg1.
doOp := cogit Label.
preOpCheckOrNil ifNotNil:
[jumpFailCheck := cogit perform: preOpCheckOrNil with: DPFPReg0 with: DPFPReg1].
cogit gen: arithmeticOperator operand: DPFPReg1 operand: DPFPReg0.
jumpFailAlloc := self genAllocFloatValue: DPFPReg0 into: SendNumArgsReg scratchReg: ClassReg scratchReg: TempReg.
cogit MoveR: SendNumArgsReg R: ReceiverResultReg.
cogit genPrimReturn.
+ jumpNotSmallFloat jmpTarget: cogit Label.
+ jumpNotSmallInteger := self genJumpNotSmallInteger: Arg0Reg.
- jumpNotSmallFloat jmpTarget:
- (cogit CmpCq: objectMemory smallIntegerTag R: ClassReg).
- jumpNotSmallInteger := cogit JumpNonZero: 0.
cogit MoveR: Arg0Reg R: Arg1Reg.
self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
cogit ConvertR: Arg1Reg Rd: DPFPReg1.
cogit Jump: doOp.
+ jumpNotSmallInteger jmpTarget: cogit Label.
+ jumpImmediate := self genJumpImmediate: Arg0Reg.
- jumpNotSmallInteger jmpTarget: (cogit CmpCq: 0 R: ClassReg).
- jumpImmediate := cogit JumpNonZero: 0.
self genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
self genCmpClassFloatCompactIndexR: SendNumArgsReg.
jumpNotBoxedFloat := cogit JumpNonZero: 0.
self genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
cogit Jump: doOp.
jumpImmediate jmpTarget:
(jumpNotBoxedFloat jmpTarget:
(jumpNotSmallInteger jmpTarget:
(jumpFailAlloc jmpTarget: cogit Label))).
preOpCheckOrNil ifNotNil:
[jumpFailCheck jmpTarget: jumpFailAlloc getJmpTarget].
^0!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genFloatComparison:invert:boxed: (in category 'primitive generators') -----
genFloatComparison: jumpOpcodeGenerator invert: invertComparison boxed: rcvrBoxed
<var: #jumpOpcodeGenerator declareC: 'AbstractInstruction *(*jumpOpcodeGenerator)(void *)'>
<inline: false>
| jumpImmediate jumpNotSmallFloat jumpNotSmallInteger jumpNotBoxedFloat jumpCond compare |
<var: #jumpNotSmallInteger type: #'AbstractInstruction *'>
<var: #jumpNotBoxedFloat type: #'AbstractInstruction *'>
<var: #jumpNotSmallFloat type: #'AbstractInstruction *'>
<var: #jumpImmediate type: #'AbstractInstruction *'>
<var: #jumpCond type: #'AbstractInstruction *'>
cogit genLoadArgAtDepth: 0 into: Arg0Reg.
rcvrBoxed
ifTrue: [self genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0]
ifFalse: [self genGetSmallFloatValueOf: ReceiverResultReg scratch: TempReg into: DPFPReg0].
+ jumpNotSmallFloat := self genJumpNotSmallFloat: Arg0Reg.
- cogit
- MoveR: Arg0Reg R: ClassReg;
- AndCq: objectMemory tagMask R: ClassReg;
- CmpCq: objectMemory smallFloatTag R: ClassReg.
- jumpNotSmallFloat := cogit JumpNonZero: 0.
self genGetSmallFloatValueOf: Arg0Reg scratch: TempReg into: DPFPReg1.
compare := invertComparison "May need to invert for NaNs"
ifTrue: [cogit CmpRd: DPFPReg0 Rd: DPFPReg1]
ifFalse: [cogit CmpRd: DPFPReg1 Rd: DPFPReg0].
jumpCond := cogit perform: jumpOpcodeGenerator with: 0. "FP jumps are a little weird"
cogit genMoveFalseR: ReceiverResultReg.
cogit genPrimReturn.
jumpCond jmpTarget: (cogit genMoveTrueR: ReceiverResultReg).
cogit genPrimReturn.
+ jumpNotSmallFloat jmpTarget: cogit Label.
+ jumpNotSmallInteger := self genJumpNotSmallInteger: Arg0Reg.
- jumpNotSmallFloat jmpTarget:
- (cogit CmpCq: objectMemory smallIntegerTag R: ClassReg).
- jumpNotSmallInteger := cogit JumpNonZero: 0.
self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
cogit ConvertR: Arg0Reg Rd: DPFPReg1.
cogit Jump: compare.
+ jumpNotSmallInteger jmpTarget: cogit Label.
+ jumpImmediate := self genJumpImmediate: Arg0Reg.
- jumpNotSmallInteger jmpTarget: (cogit CmpCq: 0 R: ClassReg).
- jumpImmediate := cogit JumpNonZero: 0.
self genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
self genCmpClassFloatCompactIndexR: SendNumArgsReg.
jumpNotBoxedFloat := cogit JumpNonZero: 0.
self genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
cogit Jump: compare.
jumpImmediate jmpTarget:
(jumpNotBoxedFloat jmpTarget: cogit Label).
^CompletePrimitive!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpCharacter: (in category 'compile abstract instructions') -----
+ genJumpCharacter: reg
+ "Generate a compare and branch to test if aRegister contains a Character."
+ ^cogit
+ TstCq: objectMemory characterTag R: reg;
+ JumpNonZero: 0!
Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpCharacter:scratchReg: (in category 'compile abstract instructions') -----
- genJumpCharacter: reg scratchReg: scratch
- "Generate a compare and branch to test if aRegister contains a Character.
- Answer the jump. Override since scratch is needed."
- <returnTypeC: #'AbstractInstruction *'>
- ^cogit
- AndCq: objectMemory tagMask R: reg R: scratch;
- CmpCq: objectMemory characterTag R: scratch;
- JumpZero: 0!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpCharacterInScratchReg: (in category 'compile abstract instructions') -----
+ genJumpCharacterInScratchReg: aRegister
+ ^self genJumpCharacter: aRegister!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotCharacter: (in category 'compile abstract instructions') -----
+ genJumpNotCharacter: reg
+ "Generate a compare and branch to test if aRegister contains other than a Character."
+ ^cogit
+ TstCq: objectMemory characterTag R: reg;
+ JumpZero: 0!
Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotCharacter:scratchReg: (in category 'compile abstract instructions') -----
- genJumpNotCharacter: reg scratchReg: scratch
- "Generate a compare and branch to test if aRegister contains other than a Character.
- Answer the jump. Override since scratch is needed."
- ^cogit
- AndCq: objectMemory tagMask R: reg R: scratch;
- CmpCq: objectMemory characterTag R: scratch;
- JumpNonZero: 0!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotCharacterInScratchReg: (in category 'compile abstract instructions') -----
+ genJumpNotCharacterInScratchReg: reg
+ <inline: true>
+ ^self genJumpNotCharacter: reg!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallFloat: (in category 'compile abstract instructions') -----
+ genJumpNotSmallFloat: reg
+ "Generate a compare and branch to test if aRegister contains other than a SmallFloat.
+ Answer the jump."
+ ^cogit
+ TstCq: objectMemory smallFloatTag R: reg;
+ JumpZero: 0!
Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallFloat:scratchReg: (in category 'compile abstract instructions') -----
- genJumpNotSmallFloat: reg scratchReg: scratch
- "Generate a compare and branch to test if aRegister contains other than a SmallFloat.
- Answer the jump."
- ^cogit
- AndCq: objectMemory tagMask R: reg R: scratch;
- CmpCq: objectMemory smallFloatTag R: scratch;
- JumpNonZero: 0!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallFloatInScratchReg: (in category 'compile abstract instructions') -----
genJumpNotSmallFloatInScratchReg: aRegister
<inline: true>
+ ^self genJumpNotSmallFloat: aRegister!
- ^self genJumpNotSmallFloat: aRegister scratchReg: aRegister!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallInteger: (in category 'compile abstract instructions') -----
+ genJumpNotSmallInteger: reg
+ "Generate a compare and branch to test if aRegister contains other than a SmallInteger."
+ ^cogit
+ TstCq: objectMemory smallIntegerTag R: reg;
+ JumpZero: 0!
Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallInteger:scratchReg: (in category 'compile abstract instructions') -----
- genJumpNotSmallInteger: reg scratchReg: scratch
- "Generate a compare and branch to test if aRegister contains other than a SmallInteger.
- Answer the jump. Override since scratch is needed."
- ^cogit
- AndCq: objectMemory tagMask R: reg R: scratch;
- CmpCq: objectMemory smallIntegerTag R: scratch;
- JumpNonZero: 0!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallIntegerInScratchReg: (in category 'compile abstract instructions') -----
genJumpNotSmallIntegerInScratchReg: aRegister
<inline: true>
+ ^self genJumpNotSmallInteger: aRegister!
- ^self genJumpNotSmallInteger: aRegister scratchReg: aRegister!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallIntegersIn:andScratch:scratch: (in category 'compile abstract instructions') -----
genJumpNotSmallIntegersIn: aRegister andScratch: scratchA scratch: scratchB
"Generate a compare and branch to test if aRegister and scratchA contains other than SmallIntegers,
i.e. don't branch if both aRegister and scratchA contain SmallIntegers.
Answer the jump. Destroy scratchA and scratchB if required."
<returnTypeC: #'AbstractInstruction *'>
+ <inline: true>
+ cogit AndR: aRegister R: scratchA.
+ ^self genJumpNotSmallIntegerInScratchReg: scratchA!
- "Straight-forward approach. Map SmallIntegers to 0 in scratchA & scratchB, add and jump non-zero."
- cogit backEnd hasThreeAddressArithmetic
- ifFalse:
- [^cogit
- MoveR: aRegister R: scratchB;
- SubCq: objectMemory smallIntegerTag R: scratchA;
- SubCq: objectMemory smallIntegerTag R: scratchB;
- AndCq: objectMemory tagMask R: scratchA;
- AndCq: objectMemory tagMask R: scratchB;
- AddR: scratchA R: scratchB;
- JumpNonZero: 0]
- "Better approach; iff 3 address arithmetic. Because tag pattern 7 is unused the following selects only two SmallIntegers
- | pairs |
- pairs := OrderedCollection new.
- 0 to: 7 do: [:r| 0 to: 7 do: [:a| pairs addLast: {r. a}]].
- pairs select: [:p| ([:r :a| (a - r bitAnd: 7) + a] valueWithArguments: p) = 1]
- => an OrderedCollection(#(1 1) #(7 0))
- But if there is no three address arithmetic this also generates 7 instructions."
- ifTrue:
- [^cogit
- AndCq: objectMemory tagMask R: scratchA R: scratchB;
- SubR: aRegister R: scratchA;
- AndCq: objectMemory tagMask R: scratchA;
- AddCq: objectMemory smallIntegerTag negated R: scratchB R: scratchA;
- JumpNonZero: 0]!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genJumpSmallFloat: (in category 'compile abstract instructions') -----
genJumpSmallFloat: aRegister
"Generate a compare and branch to test if aRegister contains a SmallFloat.
Answer the jump, or UnimplementedOperation if this cannot be done with
a single register."
+ ^cogit
+ TstCq: objectMemory smallFloatTag R: aRegister;
+ JumpNonZero: 0!
- <returnTypeC: #'AbstractInstruction *'>
- <inline: true>
- ^cogit cCoerceSimple: UnimplementedOperation to: #'AbstractInstruction *'!
Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpSmallFloat:scratchReg: (in category 'compile abstract instructions') -----
- genJumpSmallFloat: reg scratchReg: scratch
- "Generate a compare and branch to test if aRegister contains a SmallFloat.
- Answer the jump. Override since scratch is needed."
- cogit AndCq: objectMemory tagMask R: reg R: scratch.
- cogit CmpCq: objectMemory smallFloatTag R: scratch.
- ^cogit JumpZero: 0!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genJumpSmallFloatInScratchReg: (in category 'compile abstract instructions') -----
genJumpSmallFloatInScratchReg: aRegister
+ ^self genJumpSmallFloat: aRegister!
- ^self genJumpSmallFloat: aRegister scratchReg: TempReg!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpSmallInteger: (in category 'compile abstract instructions') -----
+ genJumpSmallInteger: aRegister
+ "Generate a compare and branch to test if aRegister contains a SmallInteger.
+ Answer the jump, or UnimplementedOperation if this cannot be done with
+ a single register."
+ ^cogit
+ TstCq: objectMemory smallIntegerTag R: aRegister;
+ JumpNonZero: 0!
Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpSmallInteger:scratchReg: (in category 'compile abstract instructions') -----
- genJumpSmallInteger: reg scratchReg: scratch
- "Generate a compare and branch to test if aRegister contains a SmallInteger.
- Answer the jump. Override since scratch is needed."
- <returnTypeC: #'AbstractInstruction *'>
- ^cogit
- AndCq: objectMemory tagMask R: reg R: scratch;
- CmpCq: objectMemory smallIntegerTag R: scratch;
- JumpZero: 0!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genJumpSmallIntegerInScratchReg: (in category 'compile abstract instructions') -----
genJumpSmallIntegerInScratchReg: aRegister
+ ^self genJumpSmallInteger: aRegister!
- ^self genJumpSmallInteger: aRegister scratchReg: TempReg!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveStringAtPut (in category 'primitive generators') -----
genPrimitiveStringAtPut
| formatReg jumpBadIndex jumpBadArg jumpImmutable
jumpIsBytes jumpIsShorts jumpNotString jumpIsCompiledMethod
jumpBytesOutOfRange jumpShortsOutOfRange jumpWordsOutOfRange
jumpBytesOutOfBounds jumpWordsOutOfBounds jumpShortsOutOfBounds |
"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
<var: #jumpBadArg type: #'AbstractInstruction *'>
<var: #jumpIsBytes type: #'AbstractInstruction *'>
<var: #jumpIsShorts type: #'AbstractInstruction *'>
<var: #jumpBadIndex type: #'AbstractInstruction *'>
<var: #jumpBytesOutOfRange type: #'AbstractInstruction *'>
<var: #jumpShortsOutOfRange type: #'AbstractInstruction *'>
<var: #jumpWordsOutOfRange type: #'AbstractInstruction *'>
<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
cogit genLoadArgAtDepth: 1 into: Arg0Reg.
cogit genLoadArgAtDepth: 0 into: Arg1Reg.
+ jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg.
+ jumpBadArg := self genJumpNotCharacter: Arg1Reg.
- jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
- jumpBadArg := self genJumpNotCharacter: Arg1Reg 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: ClassReg.
"dispatch on format; words and/or bytes.
0 to 8 = pointer objects, forwarders, reserved.
9 (?) 64-bit indexable
10 - 11 32-bit indexable
12 - 15 16-bit indexable
16 - 23 byte indexable
24 - 31 compiled method"
cogit CmpCq: objectMemory firstLongFormat R: formatReg.
jumpNotString := cogit JumpBelow: 0.
cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
cogit CmpCq: objectMemory firstByteFormat R: formatReg.
jumpIsBytes := cogit JumpAboveOrEqual: 0.
cogit CmpCq: objectMemory firstShortFormat R: formatReg.
jumpIsShorts := cogit JumpAboveOrEqual: 0.
"fall through to double words"
cogit CmpCq: (objectMemory characterObjectOf: 1 << self numCharacterBits - 1) R: Arg1Reg.
jumpWordsOutOfRange := cogit JumpAbove: 0.
cogit LogicalShiftLeftCq: objectMemory shiftForWord - 2 R: ClassReg.
cogit AndCq: objectMemory wordSize / 4 - 1 R: formatReg.
cogit SubR: formatReg R: ClassReg.
cogit CmpR: Arg0Reg R: ClassReg.
jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
cogit MoveR: Arg1Reg R: TempReg.
self genConvertCharacterToCodeInReg: TempReg.
cogit AddCq: objectMemory baseHeaderSize >> (objectMemory shiftForWord - 1) R: Arg0Reg.
cogit MoveR: TempReg X32r: Arg0Reg R: ReceiverResultReg.
cogit MoveR: Arg1Reg R: ReceiverResultReg.
cogit genPrimReturn.
jumpIsShorts jmpTarget:
(cogit CmpCq: (objectMemory characterObjectOf: 65535) R: Arg1Reg).
jumpShortsOutOfRange := cogit JumpAbove: 0.
cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
cogit AndCq: objectMemory wordSize / 2 - 1 R: formatReg.
cogit SubR: formatReg R: ClassReg.
cogit CmpR: Arg0Reg R: ClassReg.
jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
cogit MoveR: Arg1Reg R: TempReg.
self genConvertCharacterToCodeInReg: TempReg.
cogit AddR: Arg0Reg R: ReceiverResultReg.
cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
cogit MoveR: Arg1Reg R: ReceiverResultReg.
cogit genPrimReturn.
jumpIsBytes jmpTarget:
(cogit CmpCq: (objectMemory characterObjectOf: 255) R: Arg1Reg).
jumpBytesOutOfRange := cogit JumpAbove: 0.
cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
cogit AndCq: objectMemory wordSize - 1 R: formatReg.
cogit SubR: formatReg R: ClassReg.
cogit CmpR: Arg0Reg R: ClassReg.
jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
cogit MoveR: Arg1Reg R: TempReg.
self genConvertCharacterToCodeInReg: TempReg.
cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
cogit MoveR: TempReg Xbr: Arg0Reg R: ReceiverResultReg.
cogit MoveR: Arg1Reg R: ReceiverResultReg.
cogit genPrimReturn.
jumpNotString jmpTarget:
(jumpBytesOutOfRange jmpTarget:
(jumpShortsOutOfRange jmpTarget:
(jumpWordsOutOfRange jmpTarget:
(jumpIsCompiledMethod jmpTarget:
(jumpBytesOutOfBounds jmpTarget:
(jumpShortsOutOfBounds jmpTarget:
(jumpWordsOutOfBounds jmpTarget: cogit Label))))))).
self cppIf: IMMUTABILITY
ifTrue: [jumpImmutable jmpTarget: jumpNotString getJmpTarget].
cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
jumpBadArg jmpTarget:
(jumpBadIndex jmpTarget: cogit Label).
^CompletePrimitive!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>maybeGenConvertIfSmallFloatIn:scratchReg:into:andJumpTo: (in category 'primitive generators') -----
maybeGenConvertIfSmallFloatIn: oopReg scratchReg: scratch into: dpReg andJumpTo: targetInst
"Generate a test for a smallFloat in oopReg, converting it to the float value in dpReg
and jumping to targetInst. If oopReg does not contain a SmallFloat, fall through."
<var: 'targetInst' type: #'AbstractInstruction *'>
| jumpNotSF |
<var: 'jumpNotSF' type: #'AbstractInstruction *'>
+ jumpNotSF := self genJumpNotSmallFloat: oopReg.
- jumpNotSF := self genJumpNotSmallFloat: oopReg scratchReg: scratch.
self genGetSmallFloatValueOf: oopReg scratch: scratch into: dpReg.
cogit Jump: targetInst.
jumpNotSF jmpTarget: cogit Label.
^0!
Item was added:
+ ----- Method: InterpreterPrimitives class>>initialize (in category 'class initialization') -----
+ initialize
+ "Initialize the window color. This is probably Squeak-specific, so..."
+ [Preferences
+ setWindowColorFor: #cogVirtualMachineSimulatorWindowColor
+ to: (Color colorFrom: InterpreterPrimitives windowColorSpecification brightColor)]
+ on: Error
+ do: [:ex| Transcript show: 'Failed to set window color preference in ', thisContext method methodReference asString]!
Item was added:
+ ----- Method: InterpreterPrimitives class>>windowColorSpecification (in category 'window color') -----
+ windowColorSpecification
+ "Answer a WindowColorSpec object that declares my preference"
+ "Preferences
+ setWindowColorFor: #cogVirtualMachineSimulatorWindowColor
+ to: (Color colorFrom: InterpreterPrimitives windowColorSpecification brightColor)"
+ ^WindowColorSpec
+ classSymbol: self name wording: 'Cog Virtual Machine Simulator'
+ brightColor: #(0.645 1.0 1.0) pastelColor: #(0.886 1.0 1.0)
+ helpMessage: 'A tool for simulating a virtual machine in the Cog family.'!
Item was changed:
----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
asTranslatorNodeIn: aTMethod
"make a CCodeGenerator equivalent of me"
"selector is sometimes a Symbol, sometimes a SelectorNode!!
On top of this, numArgs is needed due to the (truly grody) use of
arguments as a place to store the extra expressions needed to generate
code for in-line to:by:do:, etc. see below, where it is used."
+ | lastExpression rcvrOrNil sel args ifNotNilBlock |
- | rcvrOrNil sel args ifNotNilBlock |
rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
(rcvrOrNil notNil
and: [rcvrOrNil isVariable
and: [rcvrOrNil name = 'super']]) ifTrue:
+ [lastExpression := aTMethod parseTree statements last.
+ ^aTMethod
+ superExpansionNodeFor: selector key
+ args: arguments
+ isResult: (lastExpression isReturn and: [lastExpression expr == self])].
- [^aTMethod superExpansionNodeFor: selector key args: arguments].
sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key].
((sel == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
or: [sel == #cCode:])
and: [arguments first isBlockNode]) ifTrue:
[| block |
^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
ifTrue: [block statements first]
ifFalse: [block]].
args := arguments
select: [:arg| arg notNil]
thenCollect: [:arg| arg asTranslatorNodeIn: aTMethod].
(sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue:
["Restore limit expr that got moved by transformToDo:"
args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod.
args second.
args third. "add the limit var as a hidden extra argument; we may need it later"
TVariableNode new setName: arguments first key}].
(sel == #ifTrue:ifFalse: and: [arguments first isJust: NodeNil]) ifTrue:
[sel := #ifFalse:. args := {args last}].
(sel == #ifTrue:ifFalse: and: [arguments last isJust: NodeNil]) ifTrue:
[sel := #ifTrue:. args := {args first}].
(sel == #ifFalse:ifTrue: and: [arguments first isJust: NodeNil]) ifTrue:
[sel := #ifTrue:. args := {args last}].
(sel == #ifFalse:ifTrue: and: [arguments last isJust: NodeNil]) ifTrue:
[sel := #ifTrue:. args := {args first}].
((sel == #ifFalse: or: [sel == #or:])
and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue:
["Restore argument block that got moved by transformOr: or transformIfFalse:"
args := {(arguments at: 2) asTranslatorNodeIn: aTMethod}].
(args size > sel numArgs and: [sel ~~ #to:by:do:]) ifTrue: "to:by:do: has iLimiT hidden in last arg"
["prune the extra blocks left by ifTrue:, ifFalse:, and: & or:"
self assert: args size - sel numArgs = 1.
self assert: (args last isStmtList
and: [args last statements size = 1
and: [(args last statements first isVariable
or: [args last statements first isConstant])
and: [#('nil' true false) includes: args last statements first nameOrValue]]]).
args := args first: sel numArgs].
"For the benefit of later passes, e.g. value: inlining,
transform e ifNotNil: [:v| ...] into v := e. v ifNotNil: [...],
which in fact means transforming (v := e) ifTrue: [:v|...] into v := e. v ifTrue: [...]."
((sel == #ifTrue: or: [sel == #ifFalse: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]]])
and: [receiver notNil
and: [receiver isAssignmentEqualsEqualsNil
and: [(ifNotNilBlock := args detect: [:arg| arg isStmtList and: [arg args size = 1]] ifNone: []) notNil]]]) ifTrue:
[ifNotNilBlock setArguments: #().
^TStmtListNode new
setArguments: #()
statements:
{ receiver receiver asTranslatorNodeIn: aTMethod.
TSendNode new
setSelector: sel
receiver: (TSendNode new
setSelector: #==
receiver: (receiver receiver variable asTranslatorNodeIn: aTMethod)
arguments: {receiver arguments first asTranslatorNodeIn: aTMethod})
arguments: args }].
^TSendNode new
setSelector: sel
receiver: rcvrOrNil
arguments: args!
Item was changed:
----- Method: NewCoObjectMemorySimulator>>setUpForUseByFacade: (in category 'debug support') -----
setUpForUseByFacade: aCurrentImageCoInterpreterFacade
+ "This is a noop"
+ <doNotGenerate>!
- "This is a noop"!
Item was changed:
----- Method: ObjectMemory>>fetchLong64:ofObject: (in category 'object access') -----
fetchLong64: longIndex ofObject: oop
<returnTypeC: #sqLong>
+ ^self cppIf: BytesPerWord = 8
+ ifTrue: [self long64At: oop + self baseHeaderSize + (longIndex << 3)]
+ ifFalse:
+ [self cppIf: VMBIGENDIAN
+ ifTrue: [((self long32At: oop + self baseHeaderSize + (longIndex << 3)) asUnsignedLongLong << 32)
+ + (self long32At: oop + self baseHeaderSize + (longIndex << 3 + 4))]
+ ifFalse: [(self long32At: oop + self baseHeaderSize + (longIndex << 3))
+ + ((self long32At: oop + self baseHeaderSize + (longIndex << 3 + 4)) asUnsignedLongLong << 32)]]!
- ^self long64At: oop + self baseHeaderSize + (longIndex << 3)!
Item was added:
+ ----- Method: ObjectMemory>>imageFormatVersion (in category 'image save/restore') -----
+ imageFormatVersion
+ "Return a magic constant that changes when the image format changes.
+ Since the image reading code uses this to detect byte ordering, one
+ must avoid version numbers that are invariant under byte reversal."
+ ^self wordSize = 4 ifTrue: [6505] ifFalse: [68003]!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>setUpForUseByFacade: (in category 'debug support') -----
setUpForUseByFacade: aCurrentImageCoInterpreterFacade
"Make sure that eden etc are initialized, so that methods can be printed.
This is really to make addressCouldBeObj: et al work."
+ <doNotGenerate>
self edenBytes: 0.
self setHeapBase: self freeStart
memoryLimit: self endOfMemory
endOfMemory: self endOfMemory!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>imageFormatVersion (in category 'immediates') -----
+ imageFormatVersion
+ "Return a magic constant that changes when the image format changes.
+ Since the image reading code uses this to detect byte ordering, one
+ must avoid version numbers that are invariant under byte reversal.
+ N.B. Bit 4 (=16) is the isSpur bit"
+ ^6521!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>isImmediateCharacter: (in category 'object testing') -----
+ isImmediateCharacter: oop
+ <inline: true>
+ ^(oop bitAnd: self tagMask) = self characterTag!
Item was changed:
----- Method: Spur32BitMemoryManager>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
+ ^(oop bitAnd: self smallIntegerTag) ~= 0!
- ^(oop bitAnd: 1) ~= 0!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>smallIntegerTag (in category 'cog jit support') -----
+ smallIntegerTag
+ "Beware, SmallInteger tags are 1 or 3. But SmallInteger's identityHash is 1."
+ <cmacro>
+ ^1!
Item was added:
+ ----- Method: Spur64BitCoMemoryManager>>setUpForUseByFacade: (in category 'debug support') -----
+ setUpForUseByFacade: aCurrentImageCoInterpreterFacade
+ "Make sure that eden etc are initialized, so that methods can be printed.
+ This is really to make addressCouldBeObj: et al work."
+ <doNotGenerate>
+ self edenBytes: 0.
+ self setHeapBase: self freeStart
+ memoryLimit: self endOfMemory
+ endOfMemory: self endOfMemory!
Item was changed:
----- Method: Spur64BitMMLECoSimulator>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a64BitValue
+ "Store the 64-bit value at byteAddress which must be 0 mod 8."
- "Store the 64-bit value at byteAddress which must be 0 mod 4."
"byteAddress = 16r1F5AE8 ifTrue: [self halt]."
^self long64At: byteAddress put: a64BitValue!
Item was changed:
----- Method: Spur64BitMMLESimulator>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a64BitValue
+ "Store the 64-bit value at byteAddress which must be 0 mod 8."
+ "byteAddress = 16r43C790 ifTrue: [self halt]."
- "Store the 64-bit value at byteAddress which must be 0 mod 4."
- "byteAddress = 16r1F5AE8 ifTrue: [self halt]."
^self long64At: byteAddress put: a64BitValue!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>imageFormatVersion (in category 'immediates') -----
+ imageFormatVersion
+ "Return a magic constant that changes when the image format changes.
+ Since the image reading code uses this to detect byte ordering, one
+ must avoid version numbers that are invariant under byte reversal.
+ N.B. Bit 4 (=16) is the isSpur bit"
+
+ "^68019" "The first 64-bit Spur format, which unfortunately chose SmallFloat64's tag to be 3."
+ ^68021!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>isImmediateCharacter: (in category 'object testing') -----
+ isImmediateCharacter: oop
+ <inline: true>
+ ^oop anyMask: self characterTag!
Item was changed:
+ ----- Method: Spur64BitMemoryManager>>isImmediateFloat: (in category 'object testing') -----
- ----- Method: Spur64BitMemoryManager>>isImmediateFloat: (in category 'interpreter access') -----
isImmediateFloat: oop
<inline: true>
+ ^oop anyMask: self smallFloatTag!
- ^(oop bitAnd: self tagMask) = self smallFloatTag!
Item was changed:
----- Method: Spur64BitMemoryManager>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
+ ^oop anyMask: self smallIntegerTag!
- ^(oop bitAnd: self tagMask) = 1!
Item was changed:
----- Method: Spur64BitMemoryManager>>isNonIntegerObject: (in category 'object testing') -----
isNonIntegerObject: oop
+ ^oop noMask: self smallIntegerTag!
- ^(oop bitAnd: self tagMask) ~= 1!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>oldSmallFloatTag (in category 'cog jit support') -----
+ oldSmallFloatTag
+ ^3!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>setHiddenRootsObj: (in category 'class table') -----
+ setHiddenRootsObj: anOop
+ "Override to check for and abort old format 64-bit Spur images in which the smallFloatTag is 3."
+ super setHiddenRootsObj: anOop.
+ (self bootstrapping not
+ and: [self smallFloatTag ~= (self rawHashBitsOf: (self fetchPointer: self smallFloatTag
+ ofObject: classTableFirstPage))]) ifTrue:
+ [self error: 'This is an old-format 64-bit Spur image with smallFloatTag = 3. Aborting.']!
Item was changed:
----- Method: Spur64BitMemoryManager>>smallFloatTag (in category 'cog jit support') -----
smallFloatTag
<api>
<cmacro>
+ ^4!
- ^3!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>smallIntegerTag (in category 'cog jit support') -----
+ smallIntegerTag
+ <cmacro>
+ ^1!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager>>arrayClassIndexPun (in category 'class table puns') -----
arrayClassIndexPun
"Class puns are class indices not used by any class. There is an entry
for the pun that refers to the notional class of objects with this class
index. But because the index doesn't match the class it won't show up
in allInstances, hence hiding the object with a pun as its class index.
The puns occupy indices 16 through 31."
+ <cmacro>
^16!
Item was changed:
----- Method: SpurMemoryManager>>bootstrapping (in category 'accessing') -----
bootstrapping
+ <inline: true>
^false!
Item was changed:
----- Method: SpurMemoryManager>>classIsItselfClassIndexPun (in category 'class table puns') -----
classIsItselfClassIndexPun
"Class puns are class indices not used by any class. There is an entry
for the pun that refers to the notional class of objects with this class
index. But because the index doesn't match the class it won't show up
in allInstances, hence hiding the object with a pun as its class index.
The puns occupy indices 16 through 31."
+ <cmacro>
^31!
Item was changed:
----- Method: SpurMemoryManager>>countNumClassPagesPreSwizzle: (in category 'class table') -----
countNumClassPagesPreSwizzle: bytesToShift
"Compute the used size of the class table before swizzling. Needed to
initialize the classTableBitmap which is populated during adjustAllOopsBy:"
| firstObj classTableRoot nilObjPreSwizzle |
firstObj := self objectStartingAt: oldSpaceStart. "a.k.a. nilObj"
"first five objects are nilObj, falseObj, trueObj, freeListsObj, classTableRootObj"
+ classTableRoot := self noInlineObjectAfter:
+ (self noInlineObjectAfter:
+ (self noInlineObjectAfter:
+ (self noInlineObjectAfter: firstObj
- classTableRoot := self objectAfter:
- (self objectAfter:
- (self objectAfter:
- (self objectAfter: firstObj
limit: endOfMemory)
limit: endOfMemory)
limit: endOfMemory)
limit: endOfMemory.
nilObjPreSwizzle := oldSpaceStart - bytesToShift.
numClassTablePages := self numSlotsOf: classTableRoot.
self assert: numClassTablePages = (self classTableRootSlots + self hiddenRootSlots).
2 to: numClassTablePages - 1 do:
[:i|
(self fetchPointer: i ofObject: classTableRoot) = nilObjPreSwizzle ifTrue:
[numClassTablePages := i.
^self]]
!
Item was changed:
----- Method: SpurMemoryManager>>firstClassIndexPun (in category 'class table puns') -----
firstClassIndexPun
"Class puns are class indices not used by any class. There is an entry
for the pun that refers to the notional class of objects with this class
index. But because the index doesn't match the class it won't show up
in allInstances, hence hiding the object with a pun as its class index.
The puns occupy indices 16 through 31."
+ <cmacro>
^16!
Item was added:
+ ----- Method: SpurMemoryManager>>imageFormatVersion (in category 'image segment in/out') -----
+ imageFormatVersion
+ "Return a magic constant that changes when the image format changes.
+ Since the image reading code uses this to detect byte ordering, one
+ must avoid version numbers that are invariant under byte reversal."
+ ^self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>isFreeObjectClassIndexPun (in category 'class table puns') -----
isFreeObjectClassIndexPun
+ <cmacro>
^0!
Item was changed:
----- Method: SpurMemoryManager>>isImmediate: (in category 'object testing') -----
isImmediate: oop
<api>
+ ^oop anyMask: self tagMask!
- ^(oop bitAnd: self tagMask) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>isImmediateCharacter: (in category 'object testing') -----
isImmediateCharacter: oop
+ ^self subclassResponsibility!
- ^(oop bitAnd: self tagMask) = 2!
Item was changed:
----- Method: SpurMemoryManager>>isNonImmediate: (in category 'object testing') -----
isNonImmediate: oop
<api>
+ ^oop noMask: self tagMask!
- ^(oop bitAnd: self tagMask) = 0!
Item was changed:
----- Method: SpurMemoryManager>>lastClassIndexPun (in category 'class table puns') -----
lastClassIndexPun
"Class puns are class indices not used by any class. There is an entry
for the pun that refers to the notional class of objects with this class
index. But because the index doesn't match the class it won't show up
in allInstances, hence hiding the object with a pun as its class index.
The puns occupy indices 16 through 31."
+ <cmacro>
^31!
Item was changed:
----- Method: SpurMemoryManager>>markAndTraceClassOf: (in category 'gc - global') -----
markAndTraceClassOf: objOop
"Ensure the class of the argument is marked, pushing it on the markStack if not already marked.
And for one-way become, which can create duplicate entries in the class table, make sure
objOop's classIndex refers to the classObj's actual classIndex.
Note that this is recursive, but the metaclass chain should terminate quickly."
<inline: false>
| classIndex classObj realClassIndex |
classIndex := self classIndexOf: objOop.
classObj := self classOrNilAtIndex: classIndex.
self assert: (coInterpreter objCouldBeClassObj: classObj).
realClassIndex := self rawHashBitsOf: classObj.
(classIndex ~= realClassIndex
+ and: [classIndex > self lastClassIndexPun]) ifTrue:
- and: [realClassIndex > self lastClassIndexPun]) ifTrue:
[self setClassIndexOf: objOop to: realClassIndex].
(self isMarked: classObj) ifFalse:
[self setIsMarkedOf: classObj to: true.
self markAndTraceClassOf: classObj.
self push: classObj onObjStack: markStack]!
Item was added:
+ ----- Method: SpurMemoryManager>>noInlineObjectAfter:limit: (in category 'object enumeration') -----
+ noInlineObjectAfter: objOop limit: limit
+ "Object parsing.
+ 1. all objects have at least a word following the header, for a forwarding pointer.
+ 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word
+ following an object doesn't have a saturated numSlots field it must be a single-header object.
+ If the word following does have a saturated numSlots it must be the overflow size word."
+ <inline: false>
+ ^self objectAfter: objOop limit: limit!
Item was changed:
----- Method: SpurMemoryManager>>segmentBridgePun (in category 'class table puns') -----
segmentBridgePun
+ <cmacro>
^3!
Item was changed:
----- Method: SpurMemoryManager>>sixtyFourBitLongsClassIndexPun (in category 'class table puns') -----
sixtyFourBitLongsClassIndexPun
"Class puns are class indices not used by any class. There may be
an entry for the pun that refers to the notional class of objects with
this class index. But because the index doesn't match the class it
won't show up in allInstances, hence hiding the object with a pun as
its class index. The puns occupy indices 16 through 31."
+ <cmacro>
^19!
Item was changed:
----- Method: SpurMemoryManager>>smallIntegerTag (in category 'cog jit support') -----
smallIntegerTag
+ ^self subclassResponsibility!
- ^1!
Item was changed:
----- Method: SpurMemoryManager>>thirtyTwoBitLongsClassIndexPun (in category 'class table puns') -----
thirtyTwoBitLongsClassIndexPun
"Class puns are class indices not used by any class. There may be
an entry for the pun that refers to the notional class of objects with
this class index. But because the index doesn't match the class it
won't show up in allInstances, hence hiding the object with a pun as
its class index. The puns occupy indices 16 through 31."
+ <cmacro>
^18!
Item was changed:
----- Method: SpurMemoryManager>>weakArrayClassIndexPun (in category 'class table puns') -----
weakArrayClassIndexPun
"Class puns are class indices not used by any class. There is an entry
for the pun that refers to the notional class of objects with this class
index. But because the index doesn't match the class it won't show up
in allInstances, hence hiding the object with a pun as its class index.
The puns occupy indices 16 through 31."
+ <cmacro>
^17!
Item was changed:
----- Method: StackInterpreter>>imageFormatVersion (in category 'image save/restore') -----
imageFormatVersion
"Return a magic constant that changes when the image format changes.
Since the image reading code uses this to detect byte ordering, one
must avoid version numbers that are invariant under byte reversal."
+ <doNotGenerate>
+ self assert: (objectMemory imageFormatVersion anyMask: 16) = objectMemory hasSpurMemoryManagerAPI.
+ ^objectMemory imageFormatVersion!
- | isSpurFlag |
- isSpurFlag := objectMemory hasSpurMemoryManagerAPI ifTrue: [2r10000] ifFalse: [0].
- ^(objectMemory wordSize = 4 ifTrue: [6505] ifFalse: [68003])
- + isSpurFlag!
Item was added:
+ ----- Method: TMethod>>mapReturnsToGotos (in category 'transformations') -----
+ mapReturnsToGotos
+ "For super expansions inner returns must be mapped to gotos to prevent premature exit.
+ But this only works if no value is being returned.
+ Anything meaningful in the returned expression must be retained."
+
+ | map label |
+ map := Dictionary new.
+ parseTree nodesDo:
+ [:node|
+ node isReturn ifTrue:
+ [(node expression isVariable and: [#('self' 'nil') includes: node expression name])
+ ifTrue:
+ [map at: node put: (TGoToNode new
+ setLabel: (label ifNil: [label := self unusedLabelForInlining: self]);
+ yourself)]
+ ifFalse: [self error: 'Cannot expand super node with inner return that answers a value!!']]].
+ label ifNotNil:
+ [parseTree := parseTree replaceNodesIn: map.
+ parseTree setStatements: (parseTree statements asOrderedCollection
+ addLast: (TLabeledCommentNode new
+ setLabel: label;
+ yourself);
+ yourself)]!
Item was changed:
----- Method: TMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initialization') -----
setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment
"Initialize this method using the given information."
selector := sel.
definingClass := class.
args := argList asOrderedCollection collect: [:arg | arg key].
locals := (localList collect: [:arg | arg key]) asSet.
declarations := Dictionary new.
self addTypeForSelf.
primitive := aNumber.
properties := methodProperties.
comment := aComment.
+ labels := Set new.
parseTree := aBlockNode. "hack; allows nodes to find their parent, etc"
parseTree := aBlockNode asTranslatorNodeIn: self.
- labels := Set new.
complete := false. "set to true when all possible inlining has been done"
export := self extractExportDirective.
static := self extractStaticDirective.
self extractSharedCase.
globalStructureBuildMethodHasFoo := false!
Item was removed:
- ----- Method: TMethod>>superExpansionNodeFor:args: (in category 'inlining') -----
- superExpansionNodeFor: aSelector args: argumentNodes
- "Answer the expansion of a super send. Merge the super expansion's
- locals, properties and comment into this method's properties."
- (definingClass superclass lookupSelector: aSelector)
- ifNil: [self error: 'superclass does not define super method']
- ifNotNil:
- [:superMethod| | superTMethod commonVars varMap |
- superTMethod := superMethod methodNode asTranslationMethodOfClass: self class.
- ((argumentNodes allSatisfy: [:parseNode| parseNode isVariableNode])
- and: [(argumentNodes asOrderedCollection collect: [:parseNode| parseNode key]) = superTMethod args]) ifFalse:
- [self error: definingClass name, '>>',selector, ' args ~= ',
- superTMethod definingClass name, '>>', aSelector,
- (String with: $. with: Character cr),
- 'For super expansions to be translated correctly each argument must be a variable with the same name as the corresponding argument in the super method.'].
- (commonVars := superTMethod locals intersection: self locals) notEmpty ifTrue:
- [varMap := Dictionary new.
- commonVars do:
- [:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)].
- superTMethod renameVariablesUsing: varMap].
- self mergePropertiesOfSuperMethod: superTMethod.
- self assert: (superTMethod locals allSatisfy: [:var| (self locals includes: var) not]).
- locals addAll: superTMethod locals.
- superTMethod declarations keysAndValuesDo:
- [:var :decl|
- self declarationAt: var put: decl].
- superTMethod comment ifNotNil:
- [:superComment|
- comment := comment
- ifNil: [superComment]
- ifNotNil: [superComment, comment]].
- superTMethod extraVariableNumber ifNotNil:
- [:scvn|
- extraVariableNumber := extraVariableNumber ifNil: [scvn] ifNotNil: [:cvn| cvn + scvn]].
- superTMethod elideAnyFinalReturn.
- ^superTMethod parseTree]!
Item was added:
+ ----- Method: TMethod>>superExpansionNodeFor:args:isResult: (in category 'inlining') -----
+ superExpansionNodeFor: aSelector args: argumentNodes isResult: superExpansionIsResult
+ "Answer the expansion of a super send. Merge the super expansion's
+ locals, properties and comment into this method's properties."
+ (definingClass superclass lookupSelector: aSelector)
+ ifNil: [self error: 'superclass does not define super method']
+ ifNotNil:
+ [:superMethod| | superTMethod commonVars varMap |
+ superTMethod := superMethod methodNode asTranslationMethodOfClass: self class.
+ ((argumentNodes allSatisfy: [:parseNode| parseNode isVariableNode])
+ and: [(argumentNodes asOrderedCollection collect: [:parseNode| parseNode key]) = superTMethod args]) ifFalse:
+ [self error: definingClass name, '>>',selector, ' args ~= ',
+ superTMethod definingClass name, '>>', aSelector,
+ (String with: $. with: Character cr),
+ 'For super expansions to be translated correctly each argument must be a variable with the same name as the corresponding argument in the super method.'].
+ (commonVars := superTMethod locals intersection: self locals) notEmpty ifTrue:
+ [varMap := Dictionary new.
+ commonVars do:
+ [:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)].
+ superTMethod renameVariablesUsing: varMap].
+ self mergePropertiesOfSuperMethod: superTMethod.
+ self assert: (superTMethod locals allSatisfy: [:var| (self locals includes: var) not]).
+ locals addAll: superTMethod locals.
+ superTMethod declarations keysAndValuesDo:
+ [:var :decl|
+ self declarationAt: var put: decl].
+ superTMethod comment ifNotNil:
+ [:superComment|
+ comment := comment
+ ifNil: [superComment]
+ ifNotNil: [superComment, comment]].
+ superTMethod extraVariableNumber ifNotNil:
+ [:scvn|
+ extraVariableNumber := extraVariableNumber ifNil: [scvn] ifNotNil: [:cvn| cvn + scvn]].
+ superTMethod elideAnyFinalReturn.
+ superExpansionIsResult ifFalse:
+ [superTMethod mapReturnsToGotos.
+ labels addAll: superTMethod labels].
+ ^superTMethod parseTree]!
Item was changed:
----- Method: TMethod>>unusedLabelForInliningInto: (in category 'inlining') -----
unusedLabelForInliningInto: targetMethod
+ ^self unusedNamePrefixedBy: 'l' avoiding: (targetMethod == self
+ ifTrue: [labels]
+ ifFalse: [labels copy
+ addAll: targetMethod labels;
+ yourself])!
-
- | usedLabels |
- usedLabels := labels copy.
- usedLabels addAll: targetMethod labels.
- ^self unusedNamePrefixedBy: 'l' avoiding: usedLabels!
Item was changed:
----- Method: TMethod>>unusedNamePrefixedBy:avoiding: (in category 'inlining support') -----
unusedNamePrefixedBy: aString avoiding: usedNames
+ "Choose a unique variable or label name with the given string as a prefix, avoiding
+ the names in the given collection. The selected name is added to usedNames."
- "Choose a unique variable or label name with the given string as a prefix, avoiding the names in the given collection. The selected name is added to usedNames."
| n newVarName |
n := 1.
+ [newVarName := aString, n printString.
+ usedNames includes: newVarName] whileTrue:
+ [n := n + 1].
+ ^usedNames add: newVarName!
- newVarName := aString, n printString.
- [usedNames includes: newVarName] whileTrue: [
- n := n + 1.
- newVarName := aString, n printString.
- ].
- usedNames add: newVarName.
- ^ newVarName!
Item was changed:
----- Method: VMMaker>>generateExternalPlugins (in category 'generate sources') -----
generateExternalPlugins
"generate the external plugins"
+ self logDateAndTime.
self deleteUnwantedExternalPluginDirectories.
InterpreterPlugin initialize.
self externalPluginsDo: [:plugin |
self generateExternalPlugin: plugin].
self storeExternalPluginList.
self logDateAndTime!
More information about the Vm-dev
mailing list