[Vm-dev] VM Maker: VMMaker.oscog-eem.1507.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Nov 4 03:21:36 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1507.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1507
Author: eem
Time: 3 November 2015, 7:19:44.589 pm
UUID: 89bfdb3d-78c9-442b-80d8-3be3b6577397
Ancestors: VMMaker.oscog-eem.1506
x64 Cogit:
Fix ceDereferenceSelectorIndex for blocks; must locate the homeMethod to fetch literals.
Implement Fill32 and fix compileBlockEntry:.
Fix JumpFull & NegateR.
Some way to implementing identity hash (still needs SmallFloat testing).
Comment assumption of sign-extension for 16-bit & 32-bit partial word reads.
Revise the generation of accessors for surrogates, so that one can look at the generated code without necessarily compiling it. Fix the failure to round up the bit position to derive the alignedByteSize. Fix alignedByteSize for CogBlockMethodSurrogate64.
Comment typos.
=============== Diff against VMMaker.oscog-eem.1506 ===============
Item was changed:
----- Method: CogBlockMethodSurrogate64 class>>alignedByteSize (in category 'accessing') -----
alignedByteSize
+ ^8 + self baseHeaderSize!
- ^4 + self baseHeaderSize!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genGetHashFieldNonImmOf:asSmallIntegerInto: (in category 'compile abstract instructions') -----
+ genGetHashFieldNonImmOf: instReg asSmallIntegerInto: destReg
+ "Fetch the instance's identity hash into destReg, encoded as a SmallInteger."
+ "Get header word in scratchReg"
+ cogit MoveMw: 0 r: instReg R: destReg.
+ "Shift and mask the field leaving room for the SmallInteger tag."
+ cogit LogicalShiftRightCq: objectMemory identityHashFullWordShift R: destReg.
+ cogit AndCq: objectMemory identityHashHalfWordMask R: destReg.
+ self genConvertIntegerToSmallIntegerInReg: destReg.
+ ^0!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genInnerPrimitiveIdentityHash: (in category 'primitive generators') -----
+ genInnerPrimitiveIdentityHash: retNoffset
+ | jumpImm jumpSI jumpSF jumpNotSet ret |
+ <var: #jumpSI type: #'AbstractInstruction *'>
+ <var: #jumpSF type: #'AbstractInstruction *'>
+ <var: #jumpImm type: #'AbstractInstruction *'>
+ <var: #jumpNotSet type: #'AbstractInstruction *'>
+ jumpImm := self genJumpImmediate: ReceiverResultReg.
+ self genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: TempReg.
+ cogit CmpCq: ConstZero R: TempReg.
+ jumpNotSet := cogit JumpZero: 0.
+ cogit MoveR: TempReg R: ReceiverResultReg.
+ ret := cogit RetN: retNoffset.
+ jumpImm jmpTarget: cogit Label.
+ jumpSI := self genJumpSmallInteger: ReceiverResultReg.
+ jumpSI asInteger = UnimplementedOperation ifTrue:
+ [cogit MoveR: ReceiverResultReg R: TempReg.
+ jumpSI := self genJumpSmallIntegerInScratchReg: TempReg].
+ jumpSI jmpTarget: ret.
+ "Fail SmallFloat because their hash uses rotatedFloatBitsOf: the oop"
+ jumpSF := self genJumpSmallFloat: ReceiverResultReg.
+ jumpSF asInteger = UnimplementedOperation ifTrue:
+ [cogit MoveR: ReceiverResultReg R: TempReg.
+ jumpSI := self genJumpSmallFloatInScratchReg: TempReg].
+ self genConvertCharacterToSmallIntegerInReg: ReceiverResultReg.
+ cogit Jump: ret.
+ jumpNotSet jmpTarget: (jumpSF jmpTarget: cogit Label).
+ ^0!
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>maybeGenerateSelectorIndexDereferenceRoutine (in category 'initialization') -----
maybeGenerateSelectorIndexDereferenceRoutine
"Generate the routine that converts selector indices into selector objects.
It is called from the send trampolines.
If the selector index is negative, convert it into a positive index into the
special selectors array and index that. Otherwise, index the current method."
+ | jumpNegative jumpNotBlock |
- | jumpNegative |
<var: 'jumpNegative' type: #'AbstractInstruction *'>
+ <var: 'jumpNotBlock' type: #'AbstractInstruction *'>
cogit zeroOpcodeIndex.
cogit CmpCq: 0 R: ClassReg.
jumpNegative := cogit JumpLess: 0.
cogit
MoveMw: FoxMethod r: FPReg R: Scratch0Reg;
AddCq: 2 R: ClassReg; "Change selector index to 1-relative, skipping the method header"
+ TstCq: MFMethodFlagIsBlockFlag R: Scratch0Reg.
+ jumpNotBlock := cogit JumpZero: 0.
+ cogit "If in a block, need to find the home method..."
AndCq: methodZone alignment negated R: Scratch0Reg;
+ MoveM16: 0 r: Scratch0Reg R: Scratch1Reg;
+ SubR: Scratch1Reg R: Scratch0Reg.
+ jumpNotBlock jmpTarget: cogit Label.
+ cogit "Now fetch the method object and index with the literal index to retrieve the selector"
+ AndCq: methodZone alignment negated R: Scratch0Reg;
MoveMw: (cogit offset: CogMethod of: #methodObject) r: Scratch0Reg R: Scratch1Reg;
MoveXwr: ClassReg R: Scratch1Reg R: ClassReg;
RetN: 0.
jumpNegative jmpTarget: cogit Label.
cogit
NegateR: ClassReg;
LogicalShiftLeftCq: 1 R: ClassReg;
MoveAw: objectMemory specialObjectsArrayAddress R: Scratch0Reg;
SubCq: 1 R: ClassReg;
MoveMw: SpecialSelectors + 1 * objectMemory wordSize r: Scratch0Reg R: Scratch1Reg; "Index, including header size"
MoveXwr: ClassReg R: Scratch1Reg R: ClassReg;
RetN: 0.
ceDereferenceSelectorIndex := cogit methodZoneBase.
cogit
outputInstructionsForGeneratedRuntimeAt: ceDereferenceSelectorIndex;
recordGeneratedRunTime: 'ceDereferenceSelectorIndex' address: ceDereferenceSelectorIndex;
recordRunTimeObjectReferences!
Item was changed:
----- Method: CogRTLOpcodes class>>initialize (in category 'class initialization') -----
initialize
"Abstract opcodes are a compound of a one word operation specifier and zero or more operand type specifiers.
e.g. MoveRR is the Move opcode with two register operand specifiers and defines a move register to
register instruction from operand 0 to operand 1. The word and register size is assumed to be either 32-bits on
a 32-bit architecture or 64-bits on a 64-bit architecture. The abstract machine is mostly a 2 address machine
with the odd three address instruction added to better exploit RISCs.
(self initialize)
The operand specifiers are
R - general purpose register
Rd - double-precision floating-point register
Cq - a `quick' constant that can be encoded in the minimum space possible.
Cw - a constant with word size where word is the default operand size for the Smalltalk VM, 32-bits
for a 32-bit VM, 64-bits for a 64-bit VM. The generated constant must occupy the default number
of bits. This allows e.g. a garbage collector to update the value without invalidating the code.
C32 - a constant with 32 bit size. The generated constant must occupy 32 bits.
C64 - a constant with 64 bit size. The generated constant must occupy 64 bits.
Aw - memory word at an absolute address
Ab - memory byte at an absolute address
Mwr - memory word whose address is at a constant offset from an address in a register
Mbr - memory byte whose address is at a constant offset from an address in a register (zero-extended on read)
M16r - memory 16-bit halfword whose address is at a constant offset from an address in a register
M32r - memory 32-bit halfword whose address is at a constant offset from an address in a register
M64r - memory 64-bit doubleword whose address is at a constant offset from an address in a register
XbrR - memory word whose address is r * byte size away from an address in a register
X16rR - memory word whose address is r * (2 bytes size) away from an address in a register
XwrR - memory word whose address is r * word size away from an address in a register
XowrR - memory word whose address is (r * word size) + o away from an address in a register (scaled indexed)
An alternative would be to decouple opcodes from operands, e.g.
Move := 1. Add := 2. Sub := 3...
RegisterOperand := 1. ConstantQuickOperand := 2. ConstantWordOperand := 3...
But not all combinations make sense and even fewer are used so we stick with the simple compound approach.
The assumption is that comparison and arithmetic instructions set condition codes and that move instructions
leave the condition codes unaffected. In particular LoadEffectiveAddressMwrR does not set condition codes
although it can be used to do arithmetic.
Not all of the definitions in opcodeDefinitions below are implemented. In particular we do not implement the
XowrR scaled index addressing mode since it requires 4 operands.
Note that there are no generic division instructions defined, but a processor may define some.
Branch/Call ranges. Jump[Cond] can be generated as short as possible. Call/Jump[Cond]Long must be generated
in the same number of bytes irrespective of displacement since their targets may be updated, but they need only
span 16Mb, the maximum size of the code zone. This allows e.g. ARM to use single-word call and jump instructions
for most calls and jumps. CallFull/JumpFull must also be generated in the same number of bytes irrespective of
displacement for the same reason, but they must be able to span the full (32-bit or 64-bit) address space because
they are used to call code in the C runtime, which may be distant from the code zone. CallFull/JumpFull are allowed
to use the cResultRegister as a scratch if required (e.g. on x64 where there is no direct 64-bit call or jump).
Byte reads. If the concrete compiler class answers true to byteReadsZeroExtend then byte reads must zero-extend
the byte read into the destination register. If not, the other bits of the register should be left undisturbed and the
+ Cogit will add an instruction to zero the register as required. Under no circumstances should byte reads sign-extend.
- Cogit will add an instruction to zero the register as required. Under no circumstances should byte reads sign-extend."
+ 16-bit (and on 64-bits, 32-bit) reads. These /are/ expected to always zero-extend."
+
| opcodeNames refs |
"A small fixed set of abstract registers are defined and used in code generation
for Smalltalk code, and executes on stack pages in the stack zone.
These are mapped to processor-specific registers by concreteRegister:"
FPReg := -1. "A frame pointer is used for Smalltalk frames."
SPReg := -2.
ReceiverResultReg := -3. "The receiver at point of send, and return value of a send"
TempReg := -4.
ClassReg := -5. "The inline send cache class tag is in this register, loaded at the send site"
SendNumArgsReg := -6. "Sends > 2 args set the arg count in this reg"
Arg0Reg := -7. "In the StackToRegisterMappingCogit 1 & 2 arg sends marshall into these registers."
Arg1Reg := -8.
"A small fixed set of abstract scratch registers for register-rich machines (ARM can use 1, x64 can use 6)."
Scratch0Reg := -9.
Scratch1Reg := -10.
Scratch2Reg := -11.
Scratch3Reg := -12.
Scratch4Reg := -13.
Scratch5Reg := -14.
Scratch6Reg := -15.
Scratch7Reg := -16.
"RISC-specific registers"
LinkReg := -17.
RISCTempReg := -18. "Used to synthesize CISC instructions from multiple RISC instructions."
PCReg := -19.
VarBaseReg := -20. "If useful, points to base of interpreter variables."
"Floating-point registers"
DPFPReg0 := -21.
DPFPReg1 := -22.
DPFPReg2 := -23.
DPFPReg3 := -24.
DPFPReg4 := -25.
DPFPReg5 := -26.
DPFPReg6 := -27.
DPFPReg7 := -28.
opcodeNames := #("Noops & Pseudo Ops"
Label
Literal "a word-sized literal"
AlignmentNops
FillBytesFrom "output operand 0's worth of bytes from the address in operand 1"
Fill8 "output a byte's worth of bytes with operand 0"
Fill16 "output two byte's worth of bytes with operand 0"
Fill32 "output four byte's worth of bytes with operand 0"
FillFromWord "output BytesPerWord's worth of bytes with operand 0 + operand 1"
Nop
"Control"
Call "call within the code zone"
CallFull "call anywhere within the full address space"
RetN
JumpR "Not a regular jump, i.e. not pc dependent."
Stop "Halt the processor"
"N.B. Jumps are contiguous. Long and Full jumps are contigiuous within them. See FirstJump et al below"
JumpFull "Jump anywhere within the address space"
JumpLong "Jump anywhere within the 16mb code zone."
JumpLongZero "a.k.a. JumpLongEqual"
JumpLongNonZero "a.k.a. JumpLongNotEqual"
Jump "short jumps; can be encoded in as few bytes as possible; will not be disturbed by GC or relocation."
JumpZero "a.k.a. JumpEqual"
JumpNonZero "a.k.a. JumpNotEqual"
JumpNegative
JumpNonNegative
JumpOverflow
JumpNoOverflow
JumpCarry
JumpNoCarry
JumpLess "signed"
JumpGreaterOrEqual
JumpGreater
JumpLessOrEqual
JumpBelow "unsigned"
JumpAboveOrEqual
JumpAbove
JumpBelowOrEqual
JumpFPEqual
JumpFPNotEqual
JumpFPLess
JumpFPLessOrEqual
JumpFPGreater
JumpFPGreaterOrEqual
JumpFPOrdered
JumpFPUnordered
"Data Movement; destination is always last operand"
MoveRR
MoveAwR
MoveRAw
MoveAbR
MoveRAb
MoveMwrR MoveRMwr MoveXwrRR MoveRXwrR MoveXowrR MoveRXowr
MoveM16rR MoveRM16r MoveX16rRR MoveRX16rR
MoveM32rR MoveRM32r MoveX32rRR MoveRX32rR
MoveMbrR MoveRMbr MoveXbrRR MoveRXbrR
MoveCqR MoveCwR MoveC32R MoveC64R
MoveRdRd MoveM64rRd MoveRdM64r
PopR PushR PushCq PushCw
PrefetchAw
"Arithmetic; destination is always last operand except Cmp; CmpXR is SubRX with no update of result"
LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR "Variants of add/multiply"
NegateR "2's complement negation"
ArithmeticShiftRightCqR ArithmeticShiftRightRR
LogicalShiftRightCqR LogicalShiftRightRR
LogicalShiftLeftCqR LogicalShiftLeftRR
CmpRR AddRR SubRR AndRR OrRR XorRR
CmpCqR AddCqR SubCqR AndCqR OrCqR TstCqR XorCqR
CmpCwR CmpC32R AddCwR SubCwR AndCwR OrCwR XorCwR
AndCqRR
CmpRdRd AddRdRd SubRdRd MulRdRd DivRdRd SqrtRd
"Conversion"
ConvertRRd
LastRTLCode).
"Magic auto declaration. Add to the classPool any new variables and nuke any obsolete ones, and assign values"
"Find the variables directly referenced by this method"
refs := (thisContext method literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect:
[:ea| ea key].
"Move to Undeclared any opcodes in classPool not in opcodes or this method."
(classPool keys reject: [:k| (opcodeNames includes: k) or: [refs includes: k]]) do:
[:k|
Undeclared declare: k from: classPool].
"Declare as class variables and number elements of opcodeArray above"
opcodeNames withIndexDo:
[:classVarName :value|
self classPool
declare: classVarName from: Undeclared;
at: classVarName put: value].
"For CogAbstractInstruction>>isJump etc..."
FirstJump := JumpFull.
LastJump := JumpFPUnordered.
FirstShortJump := Jump.
"And now initialize the backends; they add their own opcodes and hence these must be reinitialized."
(Smalltalk classNamed: #CogAbstractInstruction) ifNotNil:
[:cogAbstractInstruction| cogAbstractInstruction allSubclasses do: [:sc| sc initialize]]!
Item was changed:
----- Method: CogX64Compiler>>concretizeCallFull (in category 'generate machine code') -----
concretizeCallFull
"Since CallFull (and JumpFull) is used to invoke code in dynamically-loaded plugins it shouldn't
assume that code will be loaded within 2Gb of the code zone. Hence generate a full 64-bit call,
+ movabsq 0x123456789abcdef0, %rax; callq *%rax."
- movabsq 0x123456789abcdef0, %rax; callq %rax."
<inline: true>
| operand |
operand := operands at: 0.
machineCode
at: 0 put: 16r48;
at: 1 put: 16rA1;
at: 2 put: (operand bitAnd: 16rFF);
at: 3 put: (operand >> 8 bitAnd: 16rFF);
at: 4 put: (operand >> 16 bitAnd: 16rFF);
at: 5 put: (operand >> 24 bitAnd: 16rFF);
at: 6 put: (operand >> 32 bitAnd: 16rFF);
at: 7 put: (operand >> 40 bitAnd: 16rFF);
at: 8 put: (operand >> 48 bitAnd: 16rFF);
at: 9 put: (operand >> 56 bitAnd: 16rFF);
at: 10 put: 16rFF;
+ at: 11 put: (self mod: ModReg RM: RAX RO: 2).
- at: 11 put: (self mod: 3 RM: RAX RO: 2).
^machineCodeSize := 12!
Item was added:
+ ----- Method: CogX64Compiler>>concretizeFill32 (in category 'generate machine code') -----
+ concretizeFill32
+ <inline: true>
+ | word |
+ <var: #word type: #'unsigned long'>
+ word := operands at: 0.
+ machineCode at: 0 put: (word bitAnd: 16rFF).
+ machineCode at: 1 put: word >> 8.
+ machineCode at: 2 put: word >> 16.
+ machineCode at: 3 put: word >> 24.
+ ^machineCodeSize := 4!
Item was changed:
----- Method: CogX64Compiler>>concretizeJumpFull (in category 'generate machine code') -----
concretizeJumpFull
"Since JumpFull (and CallFull) is used to invoke code in dynamically-loaded plugins it shouldn't
assume that code will be loaded within 2Gb of the code zone. Hence generate a full 64-bit call,
+ movabsq 0x123456789abcdef0, %rax; jmpq *%rax."
- movabsq 0x123456789abcdef0, %rax; callq %rax."
<inline: true>
| operand |
operand := operands at: 0.
machineCode
at: 0 put: 16r48;
at: 1 put: 16rA1;
at: 2 put: (operand bitAnd: 16rFF);
at: 3 put: (operand >> 8 bitAnd: 16rFF);
at: 4 put: (operand >> 16 bitAnd: 16rFF);
at: 5 put: (operand >> 24 bitAnd: 16rFF);
at: 6 put: (operand >> 32 bitAnd: 16rFF);
at: 7 put: (operand >> 40 bitAnd: 16rFF);
at: 8 put: (operand >> 48 bitAnd: 16rFF);
at: 9 put: (operand >> 56 bitAnd: 16rFF);
at: 10 put: 16rFF;
+ at: 11 put: (self mod: ModReg RM: RAX RO: 4).
- at: 11 put: (self mod: 4 RM: RAX RO: 2).
^machineCodeSize := 12!
Item was changed:
----- Method: CogX64Compiler>>concretizeNegateR (in category 'generate machine code') -----
concretizeNegateR
"Will get inlined into concretizeAt: switch."
<inline: true>
| reg |
reg := self concreteRegister: (operands at: 0).
machineCode
+ at: 0 put: (self rexR: 0 x: 0 b: reg);
- at: 0 put: (self rexR: reg x: 0 b: reg);
at: 1 put: 16rF7;
at: 2 put: (self mod: ModReg RM: reg RO: 3).
^machineCodeSize := 3!
Item was added:
+ ----- Method: CogX64Compiler>>isJumpAt: (in category 'disassembly') -----
+ isJumpAt: pc
+ | op |
+ op := objectMemory byteAt: pc.
+ ^ (op between: 16r70 and: 16r7F) "short conditional jumps"
+ or: [op = 16rE9 "long unconditional jump"
+ or: [op = 16rEB "short unconditional jump"
+ or: [(op = 16r0F "long conditional jumps"
+ and: [(objectMemory byteAt: pc + 1) between: 16r80 and: 16r8F])
+ or: [op = 16r48 "full unconditional jumps"
+ and: [(objectMemory byteAt: pc + 1) = 16rA1
+ and: [(objectMemory byteAt: pc + 10) = 16rFF
+ and: [(objectMemory byteAt: pc + 11) = 16rE0]]]]]]]!
Item was changed:
----- Method: Cogit>>compileBlockEntry: (in category 'compile abstract instructions') -----
compileBlockEntry: blockStart
"Compile a block's entry. This looks like a dummy CogBlockMethod header (for frame parsing)
followed by either a frame build, if a frame is required, or nothing. The CogMethodHeader's
objectHeader field is a back pointer to the method, but this can't be filled in until code generation."
<var: #blockStart type: #'BlockStart *'>
self AlignmentNops: self blockAlignment.
blockStart fakeHeader: self Label.
(self sizeof: CogBlockMethod) caseOf:
+ { [8] "ObjectMemory"
- { [2 * objectMemory wordSize] "ObjectMemory"
-> [self Fill32: 0. "gets filled in later with the homeOffset and startpc"
self Fill32: 0]. "gets filled in later with numArgs et al"
+ [12] "Spur 32-bit"
- [3 * objectMemory wordSize] "Spur"
-> [self Fill32: 0. "gets filled in later with the homeOffset and startpc"
self Fill32: 0. "is left fallow"
self Fill32: 0]. "gets filled in later with numArgs et al"
+ [16] "Spur 64-bit"
+ -> [self Fill32: 0. "gets filled in later with the homeOffset and startpc"
+ self Fill32: 0. "is left fallow"
+ self Fill32: 0. "gets filled in later with numArgs et al"
+ self Fill32: 0].
}.
blockStart entryLabel: self Label.
needsFrame
ifTrue:
[self compileBlockFrameBuild: blockStart.
self recordBlockTrace ifTrue:
[self CallRT: ceTraceBlockActivationTrampoline]]
ifFalse:
[self compileBlockFramelessEntry: blockStart]!
Item was added:
+ ----- Method: VMStructType class>>changedAccesorsForSurrogate:bytesPerWord: (in category 'code generation') -----
+ changedAccesorsForSurrogate: surrogateClass bytesPerWord: bytesPerWord
+ "Answer the changed accessor methods for the fields of the receiver and the alignedByteSize class method."
+
+ "{CogBlockMethod changedAccesorsForSurrogate: CogBlockMethodSurrogate32 bytesPerWord: 4.
+ CogMethod changedAccesorsForSurrogate: CogMethodSurrogate32 bytesPerWord: 4.
+ CogBlockMethod changedAccesorsForSurrogate: CogBlockMethodSurrogate64 bytesPerWord: 8.
+ CogMethod changedAccesorsForSurrogate: CogMethodSurrogate64 bytesPerWord: 8}"
+
+ ^Dictionary withAll: ((self fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord) associationsSelect:
+ [:a| a value ~= a key sourceString])!
Item was removed:
- ----- Method: VMStructType class>>checkGenerateFieldAccessors:bitPosition:in: (in category 'code generation') -----
- checkGenerateFieldAccessors: fieldSpecs bitPosition: firstBitPosition in: surrogateClass
- | bitPosition alignedByteSize currentOffset code |
- bitPosition := firstBitPosition.
- fieldSpecs do:
- [:spec|
- "reset the bitPosition if the offset expression changes."
- currentOffset ~= (self offsetForInstVar: spec first) ifTrue:
- [bitPosition := firstBitPosition.
- currentOffset := self offsetForInstVar: spec first].
- "If the accessor is already defined in a superclass don't redefine it in the subclass.
- We assume it is correctly defined in the superclass."
- (spec first ~= #unused
- and: [(surrogateClass whichClassIncludesSelector: spec first asSymbol)
- ifNil: [true]
- ifNotNil: [:implementingClass|
- self assert: (implementingClass inheritsFrom: Object).
- implementingClass == surrogateClass]]) ifTrue:
- [code := self getter: spec first
- bitPosition: bitPosition
- bitWidth: spec second
- type: (spec at: 3 ifAbsent: []).
- code ~= (surrogateClass sourceCodeAt: spec first asSymbol ifAbsent: ['']) asString ifTrue:
- [surrogateClass compile: code classified: #accessing].
- code := self setter: spec first
- bitPosition: bitPosition
- bitWidth: spec second
- type: (spec at: 3 ifAbsent: []).
- code ~= (surrogateClass sourceCodeAt: (spec first, ':') asSymbol ifAbsent: ['']) asString ifTrue:
- [surrogateClass compile: code classified: #accessing]].
- bitPosition := bitPosition + spec second].
- alignedByteSize := bitPosition / 8.
- self assert: alignedByteSize isInteger.
- code := 'alignedByteSize'
- , (String with: Character cr with: Character tab with: $^)
- , alignedByteSize printString,
- (currentOffset ifNil: [''] ifNotNil: [' + self ', currentOffset]).
- code ~= (surrogateClass class sourceCodeAt: #alignedByteSize) asString ifTrue:
- [surrogateClass class compile: code classified: #accessing]!
Item was changed:
----- Method: VMStructType class>>checkGenerateSurrogate:bytesPerWord: (in category 'code generation') -----
+ checkGenerateSurrogate: surrogateClass bytesPerWord: bytesPerWord
+ "Check the accessor methods for the fields of the receiver and if necessary install new
+ or updated versions in the surrogate class alpng with the alignedByteSize class method."
- checkGenerateSurrogate: class bytesPerWord: bytesPerWord
- self checkGenerateFieldAccessors: (self fieldAccessorsForBytesPerWord: bytesPerWord)
- bitPosition: 0
- in: class
"CogBlockMethod checkGenerateSurrogate: CogBlockMethodSurrogate32 bytesPerWord: 4.
+ CogMethod checkGenerateSurrogate: CogMethodSurrogate32 bytesPerWord: 4.
+ CogBlockMethod checkGenerateSurrogate: CogBlockMethodSurrogate64 bytesPerWord: 8.
+ CogMethod checkGenerateSurrogate: CogMethodSurrogate64 bytesPerWord: 8"
+ | accessors |
+ accessors := self fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord.
+ accessors keysAndValuesDo:
+ [:mr :source|
+ source ~= mr sourceString ifTrue:
+ [mr actualClass compile: source classified: #accessing]]
+
+ "Dictionary withAll: ((self fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord) associationsSelect:
+ [:a| a value ~= a key sourceString])"!
- CogMethod checkGenerateSurrogate: CogMethodSurrogate32 bytesPerWord: 4"!
Item was added:
+ ----- Method: VMStructType class>>fieldAccessorSourceFor:bytesPerWord: (in category 'code generation') -----
+ fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord
+ "Answer a Dictionary of MethodReference to source for the accessors of the inst vars of the
+ receiver and the alignedByteSize class method in surrogateClass with the given word size."
+
+ "{CogBlockMethod fieldAccessorSourceFor: CogBlockMethodSurrogate32 bytesPerWord: 4.
+ CogMethod fieldAccessorSourceFor: CogMethodSurrogate32 bytesPerWord: 4.
+ CogBlockMethod fieldAccessorSourceFor: CogBlockMethodSurrogate64 bytesPerWord: 8.
+ CogMethod fieldAccessorSourceFor: CogMethodSurrogate64 bytesPerWord: 8}"
+ | methods bitPosition alignedByteSize currentOffset |
+ methods := Dictionary new.
+ bitPosition := 0.
+ (self fieldAccessorsForBytesPerWord: bytesPerWord) do:
+ [:spec|
+ "reset the bitPosition if the offset expression changes."
+ currentOffset ~= (self offsetForInstVar: spec first) ifTrue:
+ [bitPosition := 0.
+ currentOffset := self offsetForInstVar: spec first].
+ "If the accessor is already defined in a superclass don't redefine it in the subclass.
+ We assume it is correctly defined in the superclass."
+ (spec first ~= #unused
+ and: [(surrogateClass whichClassIncludesSelector: spec first asSymbol)
+ ifNil: [true]
+ ifNotNil: [:implementingClass|
+ self assert: (implementingClass inheritsFrom: Object).
+ implementingClass == surrogateClass]]) ifTrue:
+ [methods
+ at: (MethodReference class: surrogateClass selector: spec first asSymbol)
+ put: (self getter: spec first
+ bitPosition: bitPosition
+ bitWidth: spec second
+ type: (spec at: 3 ifAbsent: []));
+ at: (MethodReference class: surrogateClass selector: (spec first, ':') asSymbol)
+ put: (self setter: spec first
+ bitPosition: bitPosition
+ bitWidth: spec second
+ type: (spec at: 3 ifAbsent: []))].
+ bitPosition := bitPosition + spec second].
+ alignedByteSize := (self roundUpBitPosition: bitPosition toWordBoundary: bytesPerWord) / 8.
+ self assert: alignedByteSize isInteger.
+ methods
+ at: (MethodReference class: surrogateClass class selector: #alignedByteSize)
+ put: #alignedByteSize
+ , (String with: Character cr with: Character tab with: $^)
+ , alignedByteSize printString,
+ (currentOffset ifNil: [''] ifNotNil: [' + self ', currentOffset]).
+ ^methods!
Item was added:
+ ----- Method: VMStructType class>>roundUpBitPosition:toWordBoundary: (in category 'code generation') -----
+ roundUpBitPosition: bitPosition toWordBoundary: bytesPerWord
+ ^bitPosition + 7 // 8 + bytesPerWord - 1 // bytesPerWord * bytesPerWord * 8!
More information about the Vm-dev
mailing list