[Vm-dev] VM Maker: VMMaker.oscog-eem.1465.mcz

Eliot Miranda eliot.miranda at gmail.com
Fri Sep 25 04:11:12 UTC 2015


Hi Ryan,

    great question.  The answer is here:

Name: VMMaker.oscog-eem.1466
...
Revise upwards the max machine code size (for MoveRAw/AwR).
Implement some of the calling convention machinery.
Hence hit the first problem (in genPassReg:asArgument:).  The Cogit assumes the C argument registers are distinct from the other abstract registers, but on x64 these are rdi, rsi, rdx & rcx, all of which we like to use (for Arg1Reg, Arg0Reg, ReceiverResultReg & ClassReg respectively).  So it's probably time to revise the abstract to concrete register mapping to avoid the conflict.  But I want to sleep on it first.


So I have yet to dedicate the needle four argument registers to calls from machine code into the runtime.  Once this happens x64 should be down to 2 scratch registers :-(.  I would love to be able to overlap the argument regs with allocate able registers but I've not written the necessary management code to flush allocated registers when runtime calls are made.  I'm very open to suggestions here as losing those registers to runtime calls is a big hit.

_,,,^..^,,,_ (phone)

> On Sep 24, 2015, at 7:34 PM, Ryan Macnak <rmacnak at gmail.com> wrote:
> 
> Why does ARM get so many fewer scratch registers than X64? I would expect them only to differ by two (LR and PC).
> 
>> On Wed, Sep 23, 2015 at 11:08 AM, <commits at source.squeak.org> wrote:
>> 
>> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
>> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1465.mcz
>> 
>> ==================== Summary ====================
>> 
>> Name: VMMaker.oscog-eem.1465
>> Author: eem
>> Time: 23 September 2015, 11:07:41.674 am
>> UUID: abda63f2-d72f-486d-8163-d23e6a7ebaeb
>> Ancestors: VMMaker.oscog-eem.1464
>> 
>> Cogit:
>> Extend the abstract register scheme to include 8 scratch registers.  Allow ARMv6 use one, and x64 use 6.  Hence nuke the ill-thought-out GPRegMax GPRegMin, and coincidentally, the unused MulCqR MulCwR MulRR.
>> 
>> Add in-image compilation support for x64.
>> 
>> =============== Diff against VMMaker.oscog-eem.1464 ===============
>> 
>> Item was changed:
>>   ----- Method: CogARMCompiler>>abstractRegisterForConcreteRegister: (in category 'private') -----
>>   abstractRegisterForConcreteRegister: reg
>>         (self concreteRegister: TempReg) = reg ifTrue: [^TempReg].
>>         (self concreteRegister: ReceiverResultReg) = reg ifTrue: [^ReceiverResultReg].
>>         (self concreteRegister: ClassReg) = reg ifTrue: [^ClassReg].
>>         (self concreteRegister: SendNumArgsReg) = reg ifTrue: [^SendNumArgsReg].
>>         (self concreteRegister: Arg0Reg) = reg ifTrue: [^Arg0Reg].
>>         (self concreteRegister: Arg1Reg) = reg ifTrue: [^Arg1Reg].
>>         (self concreteRegister: FPReg) = reg ifTrue: [^FPReg].
>>         (self concreteRegister: SPReg) = reg ifTrue: [^SPReg].
>>         (self concreteRegister: LinkReg) = reg ifTrue: [^LinkReg].
>>         (self concreteRegister: RISCTempReg) = reg ifTrue: [^RISCTempReg].
>>         (self concreteRegister: PCReg) = reg ifTrue: [^PCReg].
>>         (self concreteRegister: VarBaseReg) = reg ifTrue: [^VarBaseReg].
>> +       (self concreteRegister: Scratch0Reg) = reg ifTrue: [^Scratch0Reg].
>>         self error: 'could not find abstract register'.
>>         ^0
>> 
>>         "({     TempReg. ReceiverResultReg. ClassReg. SendNumArgsReg. Arg0Reg. Arg1Reg.
>>                 FPReg. SPReg.
>> +               LinkReg. RISCTempReg. PCReg. VarBaseReg.
>> +               Scratch0Reg } collect: [:i| self basicNew concreteRegister: i]) sort"
>> -               LinkReg. RISCTempReg. PCReg. VarBaseReg} collect: [:i| self basicNew concreteRegister: i]) sort"
>> 
>>         "While the below works fine in Smalltalk it of course doesn't work in C ;)"
>> 
>>         "^reg caseOf: {
>>                 [self concreteRegister: TempReg] -> [TempReg].
>>                 [self concreteRegister: ReceiverResultReg] -> [ReceiverResultReg].
>>                 [self concreteRegister: ClassReg] -> [ClassReg].
>>                 [self concreteRegister: SendNumArgsReg] -> [SendNumArgsReg].
>>                 [self concreteRegister: Arg0Reg] -> [Arg0Reg].
>>                 [self concreteRegister: Arg1Reg] -> [Arg1Reg].
>>                 [self concreteRegister: FPReg] -> [FPReg].
>>                 [self concreteRegister: SPReg] -> [SPReg] }"!
>> 
>> Item was changed:
>>   ----- Method: CogARMCompiler>>concreteRegister: (in category 'encoding') -----
>>   concreteRegister: registerIndex
>>          "Map a possibly abstract register into a concrete one.  Abstract registers
>>           (defined in CogAbstractOpcodes) are all negative.  If registerIndex is
>>           negative assume it is an abstract register."
>> 
>>         "N.B. According to BSABI, R0-R3 are caller-save, R4-R12 are callee save.
>>          Note that R9 might be a special register for the implementation. In some slides
>>          it is refered to as sb. R10 can contain the stack limit (sl), R11 the fp. R12 is an
>>          intra-procedure scratch instruction pointer for link purposes. It can also be used.
>>          R10 is used as temporary inside a single abstract opcode implementation"
>>         "R0-R3 are used when calling back to the interpreter. Using them would require
>>          saving and restoring their values, so they are omitted so far. R12 is the only
>> +        scratch register at the moment.."
>> -        unused register at the moment.."
>>         ^registerIndex
>>                 caseOf: {
>>                         [TempReg]                               -> [R0].
>>                         [ClassReg]                              -> [R8].
>>                         [ReceiverResultReg]     -> [R7].
>>                         [SendNumArgsReg]                -> [R6].
>>                         [SPReg]                                 -> [SP]. "R13"
>>                         [FPReg]                                 -> [R11].
>>                         [Arg0Reg]                               -> [R4].
>>                         [Arg1Reg]                               -> [R5].
>>                         [VarBaseReg]                    -> [ConcreteVarBaseReg]. "Must be callee saved"
>>                         [RISCTempReg]                   -> [ConcreteIPReg]. "a.k.a. IP"
>> +                       [Scratch0Reg]                   -> [R12].
>>                         [LinkReg]                               -> [LR]. "R14"
>>                         [PCReg]                                 -> [PC] "R15" }
>>                 otherwise:
>>                         [self assert: (registerIndex between: R0 and: PC).
>>                          registerIndex]!
>> 
>> Item was added:
>> + ----- Method: CogARMCompiler>>minAbstractGeneralPurposeReg (in category 'accessing') -----
>> + minAbstractGeneralPurposeReg
>> +       "Answer the smallest index of an abstract general-purpose register used by this compiler.
>> +        N.B.  Abstract registers are negative numbers."
>> +       <inline: true>
>> +       ^Scratch0Reg!
>> 
>> Item was added:
>> + ----- Method: CogAbstractInstruction>>maxAbstractGeneralPurposeReg (in category 'accessing') -----
>> + maxAbstractGeneralPurposeReg
>> +       "Answer the largest index of an abstract general-purpose register used by this compiler.
>> +        N.B.  Abstract registers are negative numbers."
>> +       <inline: true>
>> +       ^ReceiverResultReg!
>> 
>> Item was added:
>> + ----- Method: CogAbstractInstruction>>minAbstractGeneralPurposeReg (in category 'accessing') -----
>> + minAbstractGeneralPurposeReg
>> +       "Answer the smallest index of an abstract general-purpose register used by this compiler.
>> +        N.B.  Abstract registers are negative numbers."
>> +       <inline: true>
>> +       ^self subclassResponsibility!
>> 
>> Item was changed:
>>   ----- Method: CogIA32Compiler>>concreteRegister: (in category 'encoding') -----
>>   concreteRegister: registerIndex
>>          "Map a possibly abstract register into a concrete one.  Abstract registers
>>           (defined in CogAbstractOpcodes) are all negative.  If registerIndex is
>>          negative assume it is an abstract register.
>> 
>>         [1] IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M
>> 
>> 
>> +       N.B. EAX ECX & EDX are caller-save (scratch) registers.  Hence we use ECX for class and EDX for
>> -       N.B. EAX ECX & EDX are caller-save (scratch) registers.  Hence we use ECX for class and EDC for
>>                 receiver/result since these are written in all normal sends.  EBX ESI & EDI are callee-save."
>> 
>>         ^registerIndex
>>                 caseOf: {
>>                         [TempReg]                               -> [EAX].
>>                         [ClassReg]                              -> [ECX].
>>                         [ReceiverResultReg]     -> [EDX].
>>                         [SendNumArgsReg]                -> [EBX].
>>                         [SPReg]                                 -> [ESP].
>>                         [FPReg]                                 -> [EBP].
>>                         [Arg0Reg]                               -> [ESI].
>>                         [Arg1Reg]                               -> [EDI] }
>>                 otherwise:
>>                         [self assert: (registerIndex between: EAX and: EDI).
>>                          registerIndex]!
>> 
>> Item was added:
>> + ----- Method: CogIA32Compiler>>minAbstractGeneralPurposeReg (in category 'accessing') -----
>> + minAbstractGeneralPurposeReg
>> +       "Answer the smallest index of an abstract general-purpose register used by this compiler.
>> +        N.B.  Abstract registers are negative numbers."
>> +       <inline: true>
>> +       ^Arg1Reg!
>> 
>> Item was added:
>> + ----- Method: CogInLineLiteralsX64Compiler>>abstractRegisterForConcreteRegister: (in category 'private') -----
>> + abstractRegisterForConcreteRegister: reg
>> +       (self concreteRegister: TempReg) = reg ifTrue: [^TempReg].
>> +       (self concreteRegister: ReceiverResultReg) = reg ifTrue: [^ReceiverResultReg].
>> +       (self concreteRegister: ClassReg) = reg ifTrue: [^ClassReg].
>> +       (self concreteRegister: SendNumArgsReg) = reg ifTrue: [^SendNumArgsReg].
>> +       (self concreteRegister: Arg0Reg) = reg ifTrue: [^Arg0Reg].
>> +       (self concreteRegister: Arg1Reg) = reg ifTrue: [^Arg1Reg].
>> +       (self concreteRegister: FPReg) = reg ifTrue: [^FPReg].
>> +       (self concreteRegister: SPReg) = reg ifTrue: [^SPReg].
>> +       (self concreteRegister: RISCTempReg) = reg ifTrue: [^RISCTempReg].
>> +       (self concreteRegister: VarBaseReg) = reg ifTrue: [^VarBaseReg].
>> +       (self concreteRegister: Scratch0Reg) = reg ifTrue: [^Scratch0Reg].
>> +       (self concreteRegister: Scratch1Reg) = reg ifTrue: [^Scratch1Reg].
>> +       (self concreteRegister: Scratch2Reg) = reg ifTrue: [^Scratch2Reg].
>> +       (self concreteRegister: Scratch3Reg) = reg ifTrue: [^Scratch3Reg].
>> +       (self concreteRegister: Scratch4Reg) = reg ifTrue: [^Scratch4Reg].
>> +       (self concreteRegister: Scratch5Reg) = reg ifTrue: [^Scratch5Reg].
>> +       self error: 'could not find abstract register'.
>> +       ^0
>> +
>> +       "({     TempReg. ReceiverResultReg. ClassReg. SendNumArgsReg. Arg0Reg. Arg1Reg.
>> +               FPReg. SPReg.
>> +               RISCTempReg. VarBaseReg.
>> +               Scratch0Reg. Scratch1Reg. Scratch2Reg. Scratch3Reg. Scratch4Reg. Scratch5Reg. } collect: [:i| self basicNew concreteRegister: i]) sort"
>> +
>> +       "While the below works fine in Smalltalk it of course doesn't work in C ;)"
>> +
>> +       "^reg caseOf: {
>> +               [self concreteRegister: TempReg] -> [TempReg].
>> +               [self concreteRegister: ReceiverResultReg] -> [ReceiverResultReg].
>> +               [self concreteRegister: ClassReg] -> [ClassReg].
>> +               [self concreteRegister: SendNumArgsReg] -> [SendNumArgsReg].
>> +               [self concreteRegister: Arg0Reg] -> [Arg0Reg].
>> +               [self concreteRegister: Arg1Reg] -> [Arg1Reg].
>> +               [self concreteRegister: FPReg] -> [FPReg].
>> +               [self concreteRegister: SPReg] -> [SPReg] }"!
>> 
>> Item was added:
>> + ----- Method: CogInLineLiteralsX64Compiler>>concreteRegister: (in category 'encoding') -----
>> + concreteRegister: registerIndex
>> +        "Map a possibly abstract register into a concrete one.  Abstract registers
>> +         (defined in CogAbstractOpcodes) are all negative.  If registerIndex is
>> +        negative assume it is an abstract register.
>> +
>> +       [1] Figure 3.4 Register Usage in
>> +               System V Application Binary Interface
>> +               AMD64 Architecture Processor Supplement
>> +
>> +
>> +       N.B. RAX RCX & RDX are caller-save (scratch) registers.  Hence we use RCX for class and RDX for
>> +               receiver/result since these are written in all normal sends."
>> +
>> +       ^registerIndex
>> +               caseOf: {
>> +                       [TempReg]                               -> [RAX].
>> +                       [ClassReg]                              -> [RCX].
>> +                       [ReceiverResultReg]     -> [RDX].
>> +                       [SendNumArgsReg]                -> [R9].
>> +                       [SPReg]                                 -> [RSP].
>> +                       [FPReg]                                 -> [RBP].
>> +                       [Arg0Reg]                               -> [RSI].
>> +                       [Arg1Reg]                               -> [RDI].
>> +                       [VarBaseReg]                    -> [RBX]. "Must be callee saved"
>> +                       [RISCTempReg]                   -> [R8].
>> +                       [Scratch0Reg]                   -> [R10].
>> +                       [Scratch1Reg]                   -> [R11].
>> +                       [Scratch2Reg]                   -> [R12].
>> +                       [Scratch3Reg]                   -> [R13].
>> +                       [Scratch4Reg]                   -> [R14].
>> +                       [Scratch5Reg]                   -> [R15] }
>> +               otherwise:
>> +                       [self assert: (registerIndex between: RAX and: R15).
>> +                        registerIndex]!
>> 
>> Item was changed:
>>   SharedPool subclass: #CogRTLOpcodes
>>         instanceVariableNames: ''
>> +       classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AlignmentNops AndCqR AndCqRR AndCwR AndRR Arg0Reg Arg1Reg ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull ClassReg CmpCqR CmpCwR CmpRR CmpRdRd ConvertRRd DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16 Fill32 Fill8 FillBytesFrom FillFromWord FirstJump FirstShortJump Jump JumpAbove JumpAboveOrEqual JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual JumpFPGreater JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual JumpFPNotEqual JumpFPOrdered JumpFPUnordered JumpFull JumpGreater JumpGreaterOrEqual JumpLess JumpLessOrEqual JumpLong JumpLongNonZero JumpLongZero JumpNegative JumpNoCarry JumpNoOverflow JumpNonNegative JumpNonZero JumpOverflow JumpR JumpZero Label LastJump LastRTLCode LinkReg Literal LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightRR MoveAbR MoveAwR MoveC32R MoveC64R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM64rRd MoveMbrR MoveMwrR MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRMbr MoveRMwr MoveRR MoveRX16rR MoveRX32rR MoveRXbrR MoveRXowr MoveRXwrR MoveRdM64r MoveRdRd MoveX16rRR MoveX32rRR MoveXbrRR MoveXowrR MoveXwrRR MulRdRd NegateR Nop OrCqR OrCwR OrRR PCReg PopR PrefetchAw PushCq PushCw PushR RISCTempReg ReceiverResultReg RetN SPReg Scratch0Reg Scratch1Reg Scratch2Reg Scratch3Reg Scratch4Reg Scratch5Reg Scratch6Reg Scratch7Reg SendNumArgsReg SqrtRd Stop SubCqR SubCwR SubRR SubRdRd TempReg TstCqR VarBaseReg XorCqR XorCwR XorRR'
>> -       classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AlignmentNops AndCqR AndCqRR AndCwR AndRR Arg0Reg Arg1Reg ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull ClassReg CmpCqR CmpCwR CmpRR CmpRdRd ConvertRRd DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16 Fill32 Fill8 FillBytesFrom FillFromWord FirstJump FirstShortJump GPRegMax GPRegMin Jump JumpAbove JumpAboveOrEqual JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual JumpFPGreater JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual JumpFPNotEqual JumpFPOrdered JumpFPUnordered JumpFull JumpGreater JumpGreaterOrEqual JumpLess JumpLessOrEqual JumpLong JumpLongNonZero JumpLongZero JumpNegative JumpNoCarry JumpNoOverflow JumpNonNegative JumpNonZero JumpOverflow JumpR JumpZero Label LastJump LastRTLCode LinkReg Literal LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightRR MoveAbR MoveAwR MoveC32R MoveC64R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM64rRd MoveMbrR MoveMwrR MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRMbr MoveRMwr MoveRR MoveRX16rR MoveRX32rR MoveRXbrR MoveRXowr MoveRXwrR MoveRdM64r MoveRdRd MoveX16rRR MoveX32rRR MoveXbrRR MoveXowrR MoveXwrRR MulCqR MulCwR MulRR MulRdRd NegateR Nop OrCqR OrCwR OrRR PCReg PopR PrefetchAw PushCq PushCw PushR RISCTempReg ReceiverResultReg RetN SPReg SendNumArgsReg SqrtRd Stop SubCqR SubCwR SubRR SubRdRd TempReg TstCqR VarBaseReg XorCqR XorCwR XorRR'
>>         poolDictionaries: ''
>>         category: 'VMMaker-JIT'!
>> 
>>   !CogRTLOpcodes commentStamp: '<historical>' prior: 0!
>>   I am a pool for the Register-Transfer-Language to which Cog compiles.  I define unique integer values for all RTL opcodes and abstract registers.  See CogAbstractInstruction for instances of instructions with the opcodes that I define.!
>> 
>> Item was changed:
>>   ----- Method: CogRTLOpcodes class>>initialize (in category 'class initialization') -----
>>   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)."
>> 
>>         | opcodeNames refs |
>> -       self flag: 'GPRegMin and GPRegMax are poorly thought-out and should instead defer to the backEnd for allocateable registers.'.
>>         "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"
>> -       ReceiverResultReg := GPRegMax := -3. "The receiver at point of send, and return value from 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.
>> -       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 := GPRegMin := -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.
>> -       "Floating-point registers"
>> -       DPFPReg0 := -9.
>> -       DPFPReg1 := -10.
>> -       DPFPReg2 := -11.
>> -       DPFPReg3 := -12.
>> -       DPFPReg4 := -13.
>> -       DPFPReg5 := -14.
>> -       DPFPReg6 := -15.
>> -       DPFPReg7 := -16.
>> 
>> +       "RISC-specific registers"
>> -       "RISC-specific"
>>         LinkReg := -17.
>> +       RISCTempReg := -18.     "Used to synthesize CISC instructions from multiple RISC instructions."
>> -       RISCTempReg := -18.
>>         PCReg := -19.
>> +       VarBaseReg := -20.              "If useful, points to base of interpreter variables."
>> -       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 AddCwR SubCwR AndCwR OrCwR XorCwR
>> -                                               CmpRR AddRR SubRR AndRR OrRR XorRR MulRR
>> -                                               CmpCqR AddCqR SubCqR AndCqR OrCqR TstCqR XorCqR MulCqR
>> -                                               CmpCwR AddCwR SubCwR AndCwR OrCwR XorCwR MulCwR
>> 
>>                                                 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 added:
>> + ----- Method: CogX64Compiler>>callerSavedRegisterMask (in category 'accessing') -----
>> + callerSavedRegisterMask
>> +       "See e.g. Figure 3.4 Register Usage in
>> +               System V Application Binary Interface
>> +               AMD64 Architecture Processor Supplement
>> +        N.B.  We are playing fast and loose here being processor-specific.
>> +        Soon enough this needs to be OS-specific."
>> +       ^cogit
>> +               registerMaskFor: (self abstractRegisterForConcreteRegister: RAX)
>> +               and: (self abstractRegisterForConcreteRegister: RCX)
>> +               and: (self abstractRegisterForConcreteRegister: RDX)
>> +               and: (self abstractRegisterForConcreteRegister: RSI)
>> +               and: (self abstractRegisterForConcreteRegister: RDI)
>> +               and: (self abstractRegisterForConcreteRegister: R8)
>> +               and: (self abstractRegisterForConcreteRegister: R9)
>> +               and: (self abstractRegisterForConcreteRegister: R10)
>> +               and: (self abstractRegisterForConcreteRegister: R11)!
>> 
>> Item was changed:
>>   ----- Method: Cogit class>>initializeMiscConstants (in category 'class initialization') -----
>>   initializeMiscConstants
>>         super initializeMiscConstants.
>>         Debug := initializationOptions at: #Debug ifAbsent: [false].
>>         (initializationOptions includesKey: #EagerInstructionDecoration)
>>                 ifTrue:
>>                         [EagerInstructionDecoration := initializationOptions at: #EagerInstructionDecoration]
>>                 ifFalse:
>>                         [EagerInstructionDecoration ifNil:
>>                                 [EagerInstructionDecoration := false]]. "speeds up single stepping but could lose fidelity"
>> 
>>         ProcessorClass := (initializationOptions at: #ISA ifAbsentPut: [#IA32]) caseOf: {
>> +                                                       [#X64]          ->      [BochsX64Alien].
>>                                                         [#IA32]         ->      [BochsIA32Alien].
>>                                                         [#ARMv5]        ->      [GdbARMAlien]. }.
>>         CogCompilerClass := self activeCompilerClass.
>>         "Our criterion for which methods to JIT is literal count.  The default value is 60 literals or less."
>>         MaxLiteralCountForCompile := initializationOptions at: #MaxLiteralCountForCompile ifAbsent: [60].
>>         "we special-case 0, 1 & 2 argument sends, N is numArgs >= 3"
>>         NumSendTrampolines := 4.
>>         "Currently not even the ceImplicitReceiverTrampoline contains object references."
>>         NumObjRefsInRuntime := 0.
>> 
>>         NSCSelectorIndex := (NSSendCache instVarNames indexOf: #selector) - 1.
>>         NSCNumArgsIndex := (NSSendCache instVarNames indexOf: #numArgs) - 1.
>>         NSCClassTagIndex := (NSSendCache instVarNames indexOf: #classTag) - 1.
>>         NSCEnclosingObjectIndex := (NSSendCache instVarNames indexOf: #enclosingObject) - 1.
>>         NSCTargetIndex := (NSSendCache instVarNames indexOf: #target) - 1.
>>         NumOopsPerNSC := NSSendCache instVarNames size.
>> 
>>         "Max size to alloca when compiling.
>>          Mac OS X 10.6.8 segfaults approaching 8Mb.
>>          Linux 2.6.9 segfaults above 11Mb.
>>          WIndows XP segfaults approaching 2Mb."
>>         MaxStackAllocSize := 1024 * 1024 * 3 / 2 !
>> 
>> Item was changed:
>>   ----- Method: Cogit>>CallRT:registersToBeSavedMask: (in category 'compile abstract instructions') -----
>>   CallRT: callTarget registersToBeSavedMask: registersToBeSaved
>>         <returnTypeC: #'AbstractInstruction *'>
>>         | callerSavedRegsToBeSaved lastInst |
>>         <var: 'lastInst' type: #'AbstractInstruction *'>
>>         callerSavedRegsToBeSaved := callerSavedRegMask bitAnd: registersToBeSaved.
>> 
>> +       backEnd maxAbstractGeneralPurposeReg to: backEnd minAbstractGeneralPurposeReg by: -1 do:
>> -       GPRegMax to: GPRegMin by: -1 do:
>>                 [:reg|
>>                 (reg ~= TempReg
>>                  and: [callerSavedRegsToBeSaved anyMask: (self registerMaskFor: reg)]) ifTrue:
>>                         [self PushR: reg]].
>> 
>>         lastInst := self CallRT: callTarget.
>> 
>> +       backEnd minAbstractGeneralPurposeReg to: backEnd maxAbstractGeneralPurposeReg do:
>> -       GPRegMin to: GPRegMax do:
>>                 [:reg|
>>                 (reg ~= TempReg
>>                  and: [callerSavedRegsToBeSaved anyMask: (self registerMaskFor: reg)]) ifTrue:
>>                         [lastInst := self PopR: reg]].
>> 
>>         ^lastInst!
>> 
>> Item was added:
>> + ----- Method: Cogit>>registerMaskFor:and:and:and:and:and:and: (in category 'register management') -----
>> + registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7
>> +       "Answer a bit mask identifying the symbolic registers.
>> +        Registers are negative numbers."
>> +       ^(((((1 << (1 - reg1) bitOr: 1 << (1 - reg2)) bitOr: 1 << (1 - reg3)) bitOr: 1 << (1 - reg4)) bitOr: 1 << (1 - reg5)) bitOr: 1 << (1 - reg6)) bitOr: 1 << (1 - reg7)!
>> 
>> Item was added:
>> + ----- Method: Cogit>>registerMaskFor:and:and:and:and:and:and:and: (in category 'register management') -----
>> + registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7 and: reg8
>> +       "Answer a bit mask identifying the symbolic registers.
>> +        Registers are negative numbers."
>> +       ^((((((1 << (1 - reg1) bitOr: 1 << (1 - reg2)) bitOr: 1 << (1 - reg3)) bitOr: 1 << (1 - reg4)) bitOr: 1 << (1 - reg5)) bitOr: 1 << (1 - reg6)) bitOr: 1 << (1 - reg7)) bitOr: 1 << (1 - reg8)!
>> 
>> Item was added:
>> + ----- Method: Cogit>>registerMaskFor:and:and:and:and:and:and:and:and: (in category 'register management') -----
>> + registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7 and: reg8 and: reg9
>> +       "Answer a bit mask identifying the symbolic registers.
>> +        Registers are negative numbers."
>> +       ^(((((((1 << (1 - reg1) bitOr: 1 << (1 - reg2)) bitOr: 1 << (1 - reg3)) bitOr: 1 << (1 - reg4)) bitOr: 1 << (1 - reg5)) bitOr: 1 << (1 - reg6)) bitOr: 1 << (1 - reg7)) bitOr: 1 << (1 - reg8)) bitOr: 1 << (1 - reg9)!
>> 
>> Item was changed:
>>   ----- Method: CurrentImageCoInterpreterFacade>>addLabel: (in category 'labels') -----
>>   addLabel: l
>>         (variables includesKey: l) ifFalse:
>> +               [variables at: l put: variables size * objectMemory wordSize + 65536]!
>> -               [variables at: l put: variables size * 4 + 65536]!
>> 
>> Item was changed:
>>   ----- Method: CurrentImageCoInterpreterFacade>>addressForLabel: (in category 'labels') -----
>>   addressForLabel: l
>> +       ^variables at: l ifAbsentPut: [variables size * objectMemory wordSize + self variablesBase]!
>> -       ^variables at: l ifAbsentPut: [variables size * 4 + self variablesBase]!
>> 
>> Item was added:
>> + CurrentImageCoInterpreterFacadeForSpurObjectRepresentation subclass: #CurrentImageCoInterpreterFacadeFor64BitSpurObjectRepresentation
>> +       instanceVariableNames: ''
>> +       classVariableNames: ''
>> +       poolDictionaries: ''
>> +       category: 'VMMaker-Support'!
>> 
>> Item was added:
>> + ----- Method: CurrentImageCoInterpreterFacadeFor64BitSpurObjectRepresentation class>>objectMemoryClass (in category 'accessing class hierarchy') -----
>> + objectMemoryClass
>> +       ^Spur64BitCoMemoryManager!
>> 
>> Item was added:
>> + ----- Method: CurrentImageCoInterpreterFacadeFor64BitSpurObjectRepresentation class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
>> + objectRepresentationClass
>> +       ^CogObjectRepresentationFor64BitSpur!
>> 
>> Item was added:
>> + Spur64BitCoMemoryManager subclass: #Spur64BitMMLECoSimulator
>> +       instanceVariableNames: 'parent bootstrapping'
>> +       classVariableNames: ''
>> +       poolDictionaries: ''
>> +       category: 'VMMaker-SpurMemoryManagerSimulation'!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>bootstrapping (in category 'accessing') -----
>> + bootstrapping
>> +       ^bootstrapping!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>bootstrapping: (in category 'accessing') -----
>> + bootstrapping: aBoolean
>> +       bootstrapping := aBoolean.
>> +       segmentManager initForBootstrap!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>byteAt: (in category 'memory access') -----
>> + byteAt: byteAddress
>> +       | lowBits long32 |
>> +       lowBits := byteAddress bitAnd: 3.
>> +       long32 := self long32At: byteAddress - lowBits.
>> +       ^(lowBits caseOf: {
>> +               [0] -> [ long32 ].
>> +               [1] -> [ long32 bitShift: -8  ].
>> +               [2] -> [ long32 bitShift: -16 ].
>> +               [3] -> [ long32 bitShift: -24 ].
>> +       }) bitAnd: 16rFF!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>byteAt:put: (in category 'memory access') -----
>> + byteAt: byteAddress put: byte
>> +       | lowBits long32 longAddress |
>> +       lowBits := byteAddress bitAnd: 3.
>> +       longAddress := byteAddress - lowBits.
>> +       long32 := self long32At: longAddress.
>> +       long32 := (lowBits caseOf: {
>> +               [0] -> [ (long32 bitAnd: 16rFFFFFF00) bitOr: byte ].
>> +               [1] -> [ (long32 bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
>> +               [2] -> [ (long32 bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
>> +               [3] -> [ (long32 bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ].
>> +       }).
>> +       self long32At: longAddress put: long32.
>> +       ^byte!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>byteAtPointer: (in category 'memory access') -----
>> + byteAtPointer: pointer
>> +       "This gets implemented by Macros in C, where its types will also be checked.
>> +        pointer is a raw address."
>> +
>> +       ^self byteAt: pointer!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>classTableFirstPage (in category 'debug support') -----
>> + classTableFirstPage
>> +       ^classTableFirstPage!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>coInterpreter:cogit: (in category 'initialization') -----
>> + coInterpreter: aCoInterpreter cogit: aCogit
>> +       coInterpreter := aCoInterpreter.
>> +       cogit := aCogit.
>> +       scavenger coInterpreter: aCoInterpreter!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>cogCodeBase (in category 'simulation only') -----
>> + cogCodeBase
>> +       ^Cogit guardPageSize!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>eek (in category 'debug support') -----
>> + eek
>> +       self halt!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>endianness (in category 'memory access') -----
>> + endianness
>> +       ^#little!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>fetchFloatAt:into: (in category 'float primitives') -----
>> + fetchFloatAt: floatBitsAddress into: aFloat
>> +       aFloat at: 2 put: (self long32At: floatBitsAddress).
>> +       aFloat at: 1 put: (self long32At: floatBitsAddress+4)!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') -----
>> + fetchPointer: fieldIndex ofObject: objOop
>> +       self assert: (self isForwarded: objOop) not.
>> +       self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)
>> +                               or: [fieldIndex = 0 "forwarders and free objs"]]).
>> +       ^super fetchPointer: fieldIndex ofObject: objOop!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>firstIndexableField: (in category 'object format') -----
>> + firstIndexableField: objOop
>> +       "NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
>> +        There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
>> +        The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
>> +        of the object).  For 3 we must go to the class."
>> +       | fmt classFormat |
>> +       <returnTypeC: #'void *'>
>> +       fmt := self formatOf: objOop.
>> +       fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
>> +               [(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
>> +                       [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
>> +                        ^self cCoerce: (self pointerForOop: objOop
>> +                                                                                               + self baseHeaderSize
>> +                                                                                               + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
>> +                                       to: #'oop *'].
>> +               ^self cCoerce: (self pointerForOop: objOop
>> +                                                                                       + self baseHeaderSize
>> +                                                                                       + ((self numSlotsOf: objOop) << self shiftForWord))
>> +                               to: #'oop *'].
>> +       "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
>> +       self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
>> +       ^self
>> +               cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
>> +               to: (fmt < self firstByteFormat
>> +                               ifTrue:
>> +                                       [fmt = self sixtyFourBitIndexableFormat
>> +                                               ifTrue: ["64 bit field objects" #'long long *']
>> +                                               ifFalse:
>> +                                                       [fmt < self firstShortFormat
>> +                                                               ifTrue: ["32 bit field objects" #'int *']
>> +                                                               ifFalse: ["16-bit field objects" #'short *']]]
>> +                               ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>freeStart (in category 'accessing') -----
>> + freeStart
>> +       "freeStart = 16r1163E0 ifTrue: [self halt]."
>> +       ^super freeStart!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>globalGarbageCollect (in category 'gc - global') -----
>> + globalGarbageCollect
>> +       "If we're /not/ a clone, clone the VM and push it over the cliff.
>> +        If it survives, destroy the clone and continue.  We should be OK until next time."
>> +       parent ifNil:
>> +               [coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush.
>> +                coInterpreter cloneSimulation objectMemory globalGarbageCollect.
>> +                Smalltalk garbageCollect].
>> +       ^super globalGarbageCollect!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') -----
>> + growOldSpaceByAtLeast: minAmmount
>> +       "Attempt to grow memory by at least minAmmount.
>> +        Answer the size of the new segment, or nil if the attempt failed.
>> +        Override to not grow during the Spur image bootstrap."
>> +       ^bootstrapping ifFalse:
>> +               [super growOldSpaceByAtLeast: minAmmount]!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>halfWordHighInLong32: (in category 'memory access') -----
>> + halfWordHighInLong32: long32
>> +       "Used by Balloon"
>> +
>> +       ^long32 bitAnd: 16rFFFF!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>halfWordLowInLong32: (in category 'memory access') -----
>> + halfWordLowInLong32: long32
>> +       "Used by Balloon"
>> +
>> +       ^long32 bitShift: -16!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>headerForSlots:format:classIndex: (in category 'header format') -----
>> + headerForSlots: numSlots format: formatField classIndex: classIndex
>> +       "The header format in LSB is
>> +        MSB:   | 2 bits                                |
>> +                       | 22: identityHash      |
>> +                       | 8: slotSize                   |
>> +                       | 3 bits                                |
>> +                       | 5: format                     |
>> +                       | 2 bits                                |
>> +                       | 22: classIndex                | : LSB"
>> +       self assert: (numSlots bitAnd: self numSlotsMask) = numSlots.
>> +       self assert: (formatField bitAnd: self formatMask) = formatField.
>> +       self assert: (classIndex bitAnd: self classIndexMask) = classIndex.
>> +       ^super headerForSlots: numSlots format: formatField classIndex: classIndex!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>heapMapAtWord: (in category 'debug support') -----
>> + heapMapAtWord: address
>> +       ^heapMap heapMapAtWord: address asInteger!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>initialize (in category 'initialization') -----
>> + initialize
>> +       super initialize.
>> +       bootstrapping := false!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>intAt:put: (in category 'memory access') -----
>> + intAt: byteAddress put: a64BitValue
>> +       ^self long32At: byteAddress put: (a64BitValue bitAnd: 16rFFFFFFFF)!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') -----
>> + loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray
>> +       self leakCheckImageSegments ifTrue:
>> +               [self halt].
>> +       ^super loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>long32At: (in category 'memory access') -----
>> + long32At: byteAddress
>> +       "Note: Adjusted for Smalltalk's 1-based array indexing."
>> +       byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
>> +       ^memory at: byteAddress // 4 + 1!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>long32At:put: (in category 'memory access') -----
>> + long32At: byteAddress put: a32BitValue
>> +       "Note: Adjusted for Smalltalk's 1-based array indexing."
>> +       "(byteAddress = 16r183FB00 and: [a32BitValue = 16r3FFFFC]) ifTrue:
>> +               [self halt]."
>> +       "(byteAddress between: 16r33FBB8 and: 16r33FBCF) ifTrue:
>> +               [self halt]."
>> +       byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
>> +       ^memory at: byteAddress // 4 + 1 put: a32BitValue!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>long64At: (in category 'memory access') -----
>> + long64At: byteAddress
>> +       "memory is a Bitmap, a 32-bit indexable array of bits"
>> +       | hiWord loWord |
>> +       byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
>> +       loWord := memory at: byteAddress // 4 + 1.
>> +       hiWord := memory at: byteAddress // 4 + 2.
>> +       ^hiWord = 0
>> +               ifTrue: [loWord]
>> +               ifFalse: [(hiWord bitShift: 32) + loWord]!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>long64At:put: (in category 'memory access') -----
>> + long64At: byteAddress put: a64BitValue
>> +       byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
>> +       self
>> +               long32At: byteAddress put: (a64BitValue bitAnd: 16rffffffff);
>> +               long32At: byteAddress + 4 put: a64BitValue >> 32.
>> +       ^a64BitValue!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>longAt: (in category 'memory access') -----
>> + longAt: byteAddress
>> +       "Answer the 64-bit word at byteAddress which must be 0 mod 4."
>> +
>> +       ^self long64At: byteAddress!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>longAt:put: (in category 'memory access') -----
>> + longAt: byteAddress put: a64BitValue
>> +       "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: Spur64BitMMLECoSimulator>>markAndTrace: (in category 'gc - global') -----
>> + markAndTrace: objOop
>> +       "objOop = 16rB26020 ifTrue: [self halt].
>> +       objOop = 16rB25FD8 ifTrue: [self halt].
>> +       objOop = 16rB26010 ifTrue: [self halt]."
>> +       ^super markAndTrace: objOop!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>memoryBaseForImageRead (in category 'snapshot') -----
>> + memoryBaseForImageRead
>> +       "Answer the address to read the image into.  Override so that when bootstrapping,
>> +        the segmentManager's segments are undisturbed in adjustSegmentSwizzlesBy:"
>> +       ^bootstrapping
>> +               ifTrue: [0]
>> +               ifFalse: [super memoryBaseForImageRead]!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>nextLongFrom: (in category 'initialization') -----
>> + nextLongFrom: aStream
>> +       "Read a 32- or 64-bit quantity from the given (binary) stream."
>> +
>> +       ^aStream nextLittleEndianNumber: self wordSize!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>nextWord32From: (in category 'initialization') -----
>> + nextWord32From: aStream
>> +       "Read a 32-bit quantity from the given (binary) stream."
>> +
>> +       ^aStream nextLittleEndianNumber: 4!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>parent (in category 'accessing') -----
>> + parent
>> +
>> +       ^ parent!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>parent: (in category 'accessing') -----
>> + parent: anObject
>> +
>> +       parent := anObject!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>return:restoringObjectsIn:savedHashes:and:savedHashes: (in category 'image segment in/out') -----
>> + return: errCode restoringObjectsIn: firstArray savedHashes: firstSavedHashes and: secondArray savedHashes: secondSavedHashes
>> +       self leakCheckImageSegments ifTrue:
>> +               [self halt: errCode printString].
>> +       ^super return: errCode restoringObjectsIn: firstArray savedHashes: firstSavedHashes and: secondArray savedHashes: secondSavedHashes!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>runLeakCheckerFor:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
>> + runLeakCheckerFor: gcModes excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
>> +       (coInterpreter displayView isNil
>> +        and: [gcModes anyMask: checkForLeaks]) ifTrue:
>> +               [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
>> +       ^super
>> +               runLeakCheckerFor: gcModes
>> +               excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
>> +               classIndicesShouldBeValid: classIndicesShouldBeValid!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>scavengingGCTenuringIf: (in category 'generation scavenging') -----
>> + scavengingGCTenuringIf: tenuringCriterion
>> +       "Run the scavenger."
>> +       "self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
>> +                                                                                                       ifTrue: ['th']
>> +                                                                                                       ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'."
>> +       ^super scavengingGCTenuringIf: tenuringCriterion!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>setFree: (in category 'free space') -----
>> + setFree: o
>> +       "o = 16rB34D40 ifTrue: [self halt]."
>> +       super setFree: o!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>setIsMarkedOf:to: (in category 'header access') -----
>> + setIsMarkedOf: objOop to: aBoolean
>> +       "objOop = 16rB26020 ifTrue: [self halt]."
>> +       super setIsMarkedOf: objOop to: aBoolean.
>> +       "(aBoolean
>> +        and: [(self isContextNonImm: objOop)
>> +        and: [(coInterpreter
>> +                       checkIsStillMarriedContext: objOop
>> +                       currentFP: coInterpreter framePointer)
>> +        and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue:
>> +               [self halt]"!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>shortAt: (in category 'memory access') -----
>> + shortAt: byteAddress
>> +     "Return the half-word at byteAddress which must be even."
>> +       | lowBits long |
>> +       lowBits := byteAddress bitAnd: 2.
>> +       long := self long32At: byteAddress - lowBits.
>> +       ^ lowBits = 2
>> +               ifTrue: [ long bitShift: -16 ]
>> +               ifFalse: [ long bitAnd: 16rFFFF ]!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>shortAt:put: (in category 'memory access') -----
>> + shortAt: byteAddress put: a16BitValue
>> +     "Return the half-word at byteAddress which must be even."
>> +       | lowBits long longAddress |
>> +       lowBits := byteAddress bitAnd: 2.
>> +       lowBits = 0
>> +               ifTrue: "storing into LS word"
>> +                       [long := self long32At: byteAddress.
>> +                        self long32At: byteAddress
>> +                               put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)]
>> +               ifFalse: "storing into MS word"
>> +                       [longAddress := byteAddress - 2.
>> +                       long := self long32At: longAddress.
>> +                       self long32At: longAddress
>> +                               put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))].
>> +       ^a16BitValue!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>storeFloatAt:from: (in category 'float primitives') -----
>> + storeFloatAt: floatBitsAddress from: aFloat
>> +       self long32At: floatBitsAddress put: (aFloat at: 2).
>> +       self long32At: floatBitsAddress+4 put: (aFloat at: 1)!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') -----
>> + storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots
>> +       self leakCheckImageSegments ifTrue:
>> +               [self halt].
>> +       ^super storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>testObjStackDo (in category 'ad-hoc tests') -----
>> + testObjStackDo
>> +       | size them seqA seqB seqC rs |
>> +       ExpensiveAsserts := true.
>> +       self initializeWeaklingStack; emptyObjStack: weaklingStack.
>> +       self assert: (self topOfObjStack: weaklingStack) isNil.
>> +       self assert: (self capacityOfObjStack: weaklingStack) >= ObjStackLimit.
>> +       seqA := (1 to: ObjStackLimit * 5 // 2) collect: [:i| self integerObjectOf: i].
>> +       seqA do: [:it| self noCheckPush: it onObjStack: weaklingStack].
>> +       them := Set new.
>> +       size := self objStack: weaklingStack from: 0 do: [:it| them add: it].
>> +       self assert: size = seqA size.
>> +       self assert: (them asSortedCollection asArray = seqA).
>> +       self assert: (self isValidObjStack: weaklingStack).
>> +       seqB := (ObjStackLimit * 5 // 2 + 1 to: ObjStackLimit * 10 // 2) collect: [:i| self integerObjectOf: i].
>> +       self assert: seqA size = seqB size.
>> +       rs := seqB readStream.
>> +       them := Set new.
>> +       size := self objStack: weaklingStack from: 0 do:
>> +                               [:it|
>> +                               them add: it.
>> +                               self noCheckPush: rs next onObjStack: weaklingStack].
>> +       self assert: size = seqA size.
>> +       self assert: rs atEnd.
>> +       self objStack: weaklingStack from: size do:
>> +               [:it| them add: it].
>> +       seqC := (seqA, seqB) sort.
>> +       self assert: them asSortedCollection asArray = seqC!
>> 
>> Item was added:
>> + ----- Method: Spur64BitMMLECoSimulator>>vmEndianness (in category 'memory access') -----
>> + vmEndianness
>> +       "1 = big, 0 = little"
>> +       ^0!
>> 
>> Item was changed:
>>   ----- Method: Spur64BitMMLESimulator>>intAt:put: (in category 'memory access') -----
>> + intAt: byteAddress put: a64BitValue
>> +       ^self long32At: byteAddress put: (a64BitValue bitAnd: 16rFFFFFFFF)!
>> - intAt: byteAddress put: a32BitValue
>> -       ^self longAt: byteAddress put: (a32BitValue bitAnd: 16rFFFFFFFF)!
> 
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20150924/9cb97f9c/attachment-0001.htm


More information about the Vm-dev mailing list