VM Maker: VMMaker.oscog-rsf.2093.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog-rsf.2093.mcz

commits-2
 
Ronie Salgado Faila uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-rsf.2093.mcz

==================== Summary ====================

Name: VMMaker.oscog-rsf.2093
Author: rsf
Time: 16 January 2017, 3:37:23.899908 am
UUID: 1a53bb71-ea7e-4ecc-b45b-43dfcd19dcc6
Ancestors: VMMaker.oscog-eem.2092

64 bits version of Lowcode. All of the tests for WodenMath are passing. Now I have to implement the image side ABI compiler for SysV and Win64.

=============== Diff against VMMaker.oscog-eem.2092 ===============

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genLcInt32ToOop: (in category 'inline primitive support') -----
+ genLcInt32ToOop: value
+ <option: #LowcodeVM>
+ self genConvertIntegerToSmallIntegerInReg: value.
+ cogit SignExtend32R: value R: value.
+ cogit ssPushRegister: value.
+ ^ 0!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genLcOopToInt32: (in category 'inline primitive support') -----
+ genLcOopToInt32: value
+ <option: #LowcodeVM>
+ self genConvertSmallIntegerToIntegerInReg: value.
+ cogit ssPushRegister: value.
+ ^ 0!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genLcOopToUInt32: (in category 'inline primitive support') -----
+ genLcOopToUInt32: value
+ <option: #LowcodeVM>
+ self genConvertSmallIntegerToIntegerInReg: value.
+ cogit ssPushRegister: value.
+ ^ 0!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genLcUInt32ToOop: (in category 'inline primitive support') -----
+ genLcUInt32ToOop: value
+ <option: #LowcodeVM>
+ self genConvertIntegerToSmallIntegerInReg: value.
+ cogit ZeroExtend32R: value R: value.
+ cogit ssPushRegister: value.
+ ^ 0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genLcIsWords:to: (in category 'inline primitive support') -----
  genLcIsWords: objectReg to: valueReg
  <option: #LowcodeVM>
 
  "Check for immediate"
  | isImmediate isNotWords cont falseTarget isBelowRange isAboveRange |
  cogit MoveR: objectReg R: valueReg.
  cogit AndCq: objectMemory tagMask R: valueReg.
  isImmediate := cogit JumpNonZero: 0.
 
  "Get the format"
  self genGetFormatOf: objectReg into: valueReg.
 
  "Hack: consider a compiled method as bytes too."
  BytesPerWord = 8 ifTrue: [
+ cogit CmpCq: objectMemory firstLongFormat R: valueReg.
- cogit CmpCq: objectMemory firstLongFormat firs R: valueReg.
  isBelowRange := cogit JumpLess: 0.
  cogit CmpCq: objectMemory firstShortFormat R: valueReg.
  isAboveRange := cogit JumpGreaterOrEqual: 0.
  ] ifFalse: [
  cogit CmpCq: objectMemory firstLongFormat R: valueReg.
  isNotWords := cogit JumpNonZero: 0.
  ].
 
  "True result"
  cogit MoveCq: 1 R: valueReg.
  cont := cogit Jump: 0.
 
  "False result"
  falseTarget := cogit Label.
  isImmediate jmpTarget: falseTarget.
  BytesPerWord = 4 ifTrue: [
  isNotWords jmpTarget: falseTarget.
  ] ifFalse: [
  isBelowRange jmpTarget: falseTarget.
  isAboveRange jmpTarget: falseTarget.
  ].
  cogit MoveCq: 0 R: valueReg.
 
  "Return"
  cont jmpTarget: cogit Label.
  cogit ssPushNativeRegister: valueReg.!

Item was changed:
  SharedPool subclass: #CogRTLOpcodes
  instanceVariableNames: ''
+ classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AddRsRs AddcCqR AddcRR AlignmentNops AndCqR AndCqRR AndCwR AndRR ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull CallR CmpC32R CmpCqR CmpCwR CmpRR CmpRdRd CmpRsRs ConvertRRd ConvertRRs ConvertRdR ConvertRdRs ConvertRsR ConvertRsRd DivRdRd DivRsRs Fill32 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 Literal LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightRR MoveA32R MoveAbR MoveAwR MoveC32R MoveC64R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM32rRs MoveM64rR
 d MoveM8rR MoveMbrR MoveMs8rR MoveMwrR MoveRA32 MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRM8r MoveRMbr MoveRMwr MoveRR MoveRRd MoveRX16rR MoveRX32rR MoveRXbrR MoveRXowr MoveRXwrR MoveRdM64r MoveRdR MoveRdRd MoveRsM32r MoveRsRs MoveX16rRR MoveX32rRR MoveXbrRR MoveXowrR MoveXwrRR MulRdRd MulRsRs NegateR Nop NotR OrCqR OrCwR OrRR PopR PrefetchAw PushCq PushCw PushR RetN RotateLeftCqR RotateRightCqR SignExtend16RR SignExtend32RR SignExtend8RR SqrtRd SqrtRs Stop SubCqR SubCwR SubRR SubRdRd SubRsRs SubbRR TstCqR XorCqR XorCwR XorRR XorRdRd XorRsRs ZeroExtend16RR ZeroExtend32RR ZeroExtend8RR'
- classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AddRsRs AddcCqR AddcRR AlignmentNops AndCqR AndCqRR AndCwR AndRR ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull CallR CmpC32R CmpCqR CmpCwR CmpRR CmpRdRd CmpRsRs ConvertRRd ConvertRRs ConvertRdR ConvertRdRs ConvertRsR ConvertRsRd DivRdRd DivRsRs Fill32 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 Literal LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightRR MoveA32R MoveAbR MoveAwR MoveC32R MoveC64R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM32rRs MoveM64rR
 d MoveM8rR MoveMbrR MoveMs8rR MoveMwrR MoveRA32 MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRM8r MoveRMbr MoveRMwr MoveRR MoveRRd MoveRX16rR MoveRX32rR MoveRXbrR MoveRXowr MoveRXwrR MoveRdM64r MoveRdR MoveRdRd MoveRsM32r MoveRsRs MoveX16rRR MoveX32rRR MoveXbrRR MoveXowrR MoveXwrRR MulRdRd MulRsRs NegateR Nop NotR OrCqR OrCwR OrRR PopR PrefetchAw PushCq PushCw PushR RetN RotateLeftCqR RotateRightCqR SignExtend16RR SignExtend8RR SqrtRd SqrtRs Stop SubCqR SubCwR SubRR SubRdRd SubRsRs SubbRR TstCqR XorCqR XorCwR XorRR XorRdRd XorRsRs ZeroExtend16RR ZeroExtend8RR'
  poolDictionaries: ''
  category: 'VMMaker-JIT'!
 
  !CogRTLOpcodes commentStamp: 'eem 12/26/2015 14:00' prior: 0!
  I am a pool for the Register-Transfer-Language to which Cog compiles.  I define unique integer values for all RTL opcodes.  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.
  The assembler is in Cogit protocol abstract instructions and uses `at&t' syntax, assigning to the register on the
  right. 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
  Rs - single-precision floating-point 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 (32-bits for a 32-bit VM, 64-bits for a 64-bit VM) at an absolute address
  Ab - memory byte at an absolute address
  A32 - memory 32-bit halfword 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
  Xbr - memory byte whose address is r * byte size away from an address in a register
  X16r - memory 16-bit halfword whose address is r * (2 bytes size) away from an address in a register
  X32r - memory 32-bit halfword whose address is r * (4 bytes size) away from an address in a register
  Xwr - memory word whose address is r * word size away from an address in a register
  Xowr - memory word whose address is o + (r * word size) 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.  On processors such as MIPS this distinction is invalid; there are no
  condition codes.  So the backend is allowed to collapse operation, branch pairs to internal instruciton definitions
  (see sender and implementors of noteFollowingConditionalBranch:).
 
  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.
 
  Not all instructions make sense on all architectures.  MoveRRd and MoveRdR aqre meaningful only on 64-bit machines.
 
  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.
 
  16-bit (and on 64-bits, 32-bit) reads.  These /are/ expected to always zero-extend."
 
  | opcodeNames refs |
  opcodeNames := #("Noops & Pseudo Ops"
  Label
  Literal "a word-sized literal"
  AlignmentNops
  Fill32 "output four byte's worth of bytes with operand 0"
  Nop
 
  "Control"
  Call "call within the code zone"
  CallFull "call anywhere within the full address space"
  CallR
  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 contiguous 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 MoveA32R
  MoveRAw MoveRA32
  MoveAbR
  MoveRAb
  MoveMwrR MoveRMwr MoveXwrRR MoveRXwrR MoveXowrR MoveRXowr
  MoveM8rR MoveMs8rR MoveRM8r
  MoveM16rR MoveRM16r MoveX16rRR MoveRX16rR
  MoveM32rR MoveRM32r MoveX32rRR MoveRX32rR
  MoveMbrR MoveRMbr MoveXbrRR MoveRXbrR
  MoveCqR MoveCwR MoveC32R MoveC64R
  MoveRRd MoveRdR MoveRdRd MoveM64rRd MoveRdM64r
  MoveRsRs MoveM32rRs MoveRsM32r
  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"
  NotR
  ArithmeticShiftRightCqR ArithmeticShiftRightRR
  LogicalShiftRightCqR LogicalShiftRightRR
  LogicalShiftLeftCqR LogicalShiftLeftRR
  RotateLeftCqR RotateRightCqR
 
  CmpRR AddRR SubRR AndRR OrRR XorRR
  CmpCqR AddCqR SubCqR AndCqR OrCqR TstCqR XorCqR
  CmpCwR CmpC32R AddCwR SubCwR AndCwR OrCwR XorCwR
  AddcRR AddcCqR SubbRR
 
  AndCqRR "Three address ops for RISCs; feel free to add and extend"
 
  CmpRdRd AddRdRd SubRdRd MulRdRd DivRdRd SqrtRd XorRdRd
  CmpRsRs AddRsRs SubRsRs MulRsRs DivRsRs SqrtRs XorRsRs
 
  "Conversion"
  ConvertRRd ConvertRdR
  ConvertRsRd ConvertRdRs ConvertRsR ConvertRRs
 
+ SignExtend8RR SignExtend16RR SignExtend32RR
+ ZeroExtend8RR ZeroExtend16RR ZeroExtend32RR
- SignExtend8RR SignExtend16RR
- ZeroExtend8RR ZeroExtend16RR
 
  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: CogSimStackNativeEntry>>nativePopToReg: (in category 'compile abstract instructions') -----
  nativePopToReg: reg
  spilled ifTrue: [
  cogit loadNativeFramePointerInto: TempReg.
 
  type caseOf: {
  [SSSpillNative] -> [cogit MoveMw: offset negated - 1 r: TempReg R: reg].
+ [SSSpillInt64] -> [self assert: BytesPerWord = 8.
+ cogit MoveMw: offset negated - 1 r: TempReg R: reg].
  [SSSpillFloat32] -> [cogit MoveM32: offset negated - 1 r: TempReg Rs: reg.].
  [SSSpillFloat64] -> [cogit MoveM64: offset negated - 1 r: TempReg Rd: reg.].}
  ] ifFalse: [
  type caseOf: {
  [SSNativeRegister] -> [reg ~= register
  ifTrue: [cogit MoveR: register R: reg]].
  [SSRegisterSingleFloat] -> [reg ~= register
  ifTrue: [cogit MoveRs: register Rs: reg]].
  [SSRegisterDoubleFloat] -> [reg ~= register
  ifTrue: [cogit MoveRd: register Rd: reg]].
 
  [SSConstantInt32] -> [cogit MoveCq: constantInt32 R: reg].
  [SSConstantNativePointer] -> [cogit MoveCw: constantNativePointer R: reg].
  [SSConstantFloat32] -> [ cogit MoveCf32: constantFloat32 Rs: reg. ].
  [SSConstantFloat64] -> [ cogit MoveCf64: constantFloat64 Rd: reg. ].
  }
  ].
  !

Item was changed:
  ----- Method: CogSimStackNativeEntry>>nativeStackPopToReg: (in category 'compile abstract instructions') -----
  nativeStackPopToReg: reg
  self assert: spilled.
 
  type caseOf: {
  [SSSpillNative] -> [cogit MoveMw: offset negated r: FPReg R: reg].
+ [SSSpillInt64] -> [self assert: BytesPerWord = 8.
+ cogit MoveMw: offset negated r: FPReg R: reg].
  [SSSpillFloat32] -> [cogit MoveM32: offset negated r: FPReg Rs: reg.].
  [SSSpillFloat64] -> [cogit MoveM64: offset negated r: FPReg Rd: reg.].
  }!

Item was changed:
  CogAbstractInstruction subclass: #CogX64Compiler
  instanceVariableNames: ''
+ classVariableNames: 'CDQ CLD CMPXCHGAwR CMPXCHGMwrR CPUID IDIVR IMULRR LFENCE LOCK MFENCE MOVSB MOVSQ ModReg ModRegInd ModRegIndDisp32 ModRegIndSIB ModRegRegDisp32 ModRegRegDisp8 R10 R11 R12 R13 R14 R15 R8 R9 RAX RBP RBX RCX RDI RDX REP RSI RSP SFENCE SIB1 SIB2 SIB4 SIB8 SysV XCHGAwR XCHGMwrR XCHGRR XMM0L XMM10L XMM11L XMM12L XMM13L XMM14L XMM15L XMM1L XMM2L XMM3L XMM4L XMM5L XMM6L XMM7L XMM8L XMM9L'
- classVariableNames: 'CDQ CMPXCHGAwR CMPXCHGMwrR CPUID IDIVR IMULRR LFENCE LOCK MFENCE ModReg ModRegInd ModRegIndDisp32 ModRegIndSIB ModRegRegDisp32 ModRegRegDisp8 R10 R11 R12 R13 R14 R15 R8 R9 RAX RBP RBX RCX RDI RDX RSI RSP SFENCE SIB1 SIB2 SIB4 SIB8 SysV XCHGAwR XCHGMwrR XCHGRR XMM0L XMM10L XMM11L XMM12L XMM13L XMM14L XMM15L XMM1L XMM2L XMM3L XMM4L XMM5L XMM6L XMM7L XMM8L XMM9L'
  poolDictionaries: ''
  category: 'VMMaker-JIT'!
 
  !CogX64Compiler commentStamp: 'eem 9/14/2015 17:12' prior: 0!
  I generate x64 (x86-64) instructions from CogAbstractInstructions.  For reference see
  1. IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M
  2. IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, N-Z
  http://www.intel.com/products/processor/manuals/
  or
  AMD64 Architecture Programmer's Manual Volume 3: General-Purpose and System Instructions
  AMD64 Architecture Programmer's Manual Volume 4: 128-bit Media Instructions
  AMD64 Architecture Programmer's Manual Volume 5: 64-bit Media and x87 Floating Point Instructions
  http://developer.amd.com/resources/documentation-articles/developer-guides-manuals/
  (® is supposed to be the Unicode "registered  sign").!

Item was changed:
  ----- Method: CogX64Compiler class>>initialize (in category 'class initialization') -----
  initialize
  "Initialize various x64 instruction-related constants.
  [1] IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M"
 
  "CogX64Compiler initialize"
 
  self ~~ CogX64Compiler ifTrue: [^self].
 
  initializationOptions ifNil: [ initializationOptions := Dictionary new ].
  initializationOptions
  at: #ABI
  ifPresent: [:abi| SysV := abi asUppercase ~= #WIN64]
  ifAbsent: [SysV := true]. "Default ABI; set to true for SysV, false for WIN64"
 
  RAX := 0.
  RCX := 1.  "Were they completely mad or simply sadistic?"
  RDX := 2.
  RBX := 3.
  RSP := 4.
  RBP := 5.
  RSI := 6.
  RDI := 7.
  R8 := 8.
  R9 := 9.
  R10 := 10.
  R11 := 11.
  R12 := 12.
  R13 := 13.
  R14 := 14.
  R15 := 15.
 
  XMM0L := 0.
  XMM1L := 1.
  XMM2L := 2.
  XMM3L := 3.
  XMM4L := 4.
  XMM5L := 5.
  XMM6L := 6.
  XMM7L := 7.
  XMM8L := 8.
  XMM9L := 9.
  XMM10L := 10.
  XMM11L := 11.
  XMM12L := 12.
  XMM13L := 13.
  XMM14L := 14.
  XMM15L := 15.
 
  "Mod R/M Mod fields.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-2"
  ModRegInd := 0.
  ModRegIndSIB := 4.
  ModRegIndDisp32 := 5.
  ModRegRegDisp8 := 1.
  ModRegRegDisp32 := 2.
  ModReg := 3.
 
  "SIB Scaled Index modes.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-3"
  SIB1 := 0.
  SIB2 := 1.
  SIB4 := 2.
  SIB8 := 3.
 
  "Specific instructions"
  self
+ initializeSpecificOpcodes: #(CDQ IDIVR IMULRR CPUID LFENCE MFENCE SFENCE LOCK CMPXCHGAwR CMPXCHGMwrR XCHGAwR XCHGMwrR XCHGRR CLD REP MOVSB MOVSQ)
- initializeSpecificOpcodes: #(CDQ IDIVR IMULRR CPUID LFENCE MFENCE SFENCE LOCK CMPXCHGAwR CMPXCHGMwrR XCHGAwR XCHGMwrR XCHGRR)
  in: thisContext method!

Item was added:
+ ----- Method: CogX64Compiler>>cFloatResultToRd: (in category 'abi') -----
+ cFloatResultToRd: reg
+ XMM0L ~= reg ifTrue: [
+ cogit MoveRd: XMM0L Rd: reg
+ ].!

Item was added:
+ ----- Method: CogX64Compiler>>cFloatResultToRs: (in category 'abi') -----
+ cFloatResultToRs: reg
+ XMM0L ~= reg ifTrue: [
+ cogit MoveRs: XMM0L Rs: reg
+ ].!

Item was changed:
  ----- Method: CogX64Compiler>>computeMaximumSize (in category 'generate machine code') -----
(excessive size, no diff calculated)

Item was added:
+ ----- Method: CogX64Compiler>>concretizeCLD (in category 'generate machine code') -----
+ concretizeCLD
+ <inline: true>
+ machineCode at: 0 put: 16rFC.
+ ^machineCodeSize := 1!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeCallR (in category 'generate machine code') -----
+ concretizeCallR
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | reg |
+ reg := operands at: 0.
+ machineCode
+ at: 1 put: (self rexR: 0 x: 0 b: reg);
+ at: 1 put: 16rFF;
+ at: 2 put: (self mod: ModReg RM: reg RO: 2).
+ ^machineCodeSize := 3!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeCmpRdRd (in category 'generate machine code') -----
  concretizeCmpRdRd
  "Will get inlined into concretizeAt: switch.
  We use UCOMISD (see p 4-260 [2])"
  <inline: true>
+ | regLHS regRHS skip |
- | regLHS regRHS |
  "CmpRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
  regRHS := operands at: 0.
  regLHS := operands at: 1.
+
  machineCode
+ at: 0 put: 16r66.
+ (regLHS <= 7 and: [regRHS <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
+
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r2E;
+ at: skip + 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
+ ^machineCodeSize := skip + 4!
- at: 0 put: 16r66;
- at: 1 put: 16r0F;
- at: 2 put: 16r2E;
- at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
- ^machineCodeSize := 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeCmpRsRs (in category 'generate machine code') -----
+ concretizeCmpRsRs
+ "Will get inlined into concretizeAt: switch.
+ We use UCOMISS"
+ <inline: true>
+ | regLHS regRHS skip |
+ "CmpRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
+ regRHS := operands at: 0.
+ regLHS := operands at: 1.
+
+ (regLHS <= 7 and: [regRHS <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
+
+ machineCode
+ at: skip + 0 put: 16r0F;
+ at: skip + 1 put: 16r2E;
+ at: skip + 2 put: (self mod: ModReg RM: regRHS RO: regLHS).
+ ^machineCodeSize := skip + 3!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeConvertRRd (in category 'generate machine code') -----
  concretizeConvertRRd
  "Will get inlined into concretizeAt: switch."
  <inline: true>
+ | srcReg destReg skip |
- | srcReg destReg |
  srcReg := operands at:0.
  destReg := operands at: 1.
  machineCode
+ at: 0 put: 16rF2.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
+
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r2A;
+ at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^machineCodeSize := skip + 4!
- at: 0 put: 16rF2;
- at: 1 put: (self rexR: destReg x: 0 b: srcReg);
- at: 2 put: 16r0F;
- at: 3 put: 16r2A;
- at: 4 put: (self mod: ModReg RM: srcReg RO: destReg).
- ^machineCodeSize := 5!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeConvertRRs (in category 'generate machine code') -----
+ concretizeConvertRRs
+ "Will get inlined into concretizeAt: switch."
+ "CVTSI2SS"
+ <inline: true>
+ | srcReg destReg skip |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: 16rF3.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
+
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r2A;
+ at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeConvertRdR (in category 'generate machine code') -----
+ concretizeConvertRdR
+ "Will get inlined into concretizeAt: switch."
+ "CVTSD2SI"
+ <inline: true>
+ | srcReg destReg skip |
+ srcReg := operands at:0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: 16rF2.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
+
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r2D;
+ at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeConvertRdRs (in category 'generate machine code') -----
+ concretizeConvertRdRs
+ "Will get inlined into concretizeAt: switch."
+ "CVTSD2SS"
+ <inline: true>
+ | srcReg destReg skip |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: 16rF2.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
+
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r5A;
+ at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeConvertRsR (in category 'generate machine code') -----
+ concretizeConvertRsR
+ "Will get inlined into concretizeAt: switch."
+ "CVTSS2SI"
+ <inline: true>
+ | srcReg destReg skip |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: 16rF3.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
+
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r2D;
+ at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeConvertRsRd (in category 'generate machine code') -----
+ concretizeConvertRsRd
+ "Will get inlined into concretizeAt: switch."
+ "CVTSS2SD"
+ <inline: true>
+ | srcReg destReg skip |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: 16rF3.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
+
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r5A;
+ at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMOVSB (in category 'generate machine code') -----
+ concretizeMOVSB
+ <inline: true>
+ machineCode at: 0 put: 16rA4.
+ ^machineCodeSize := 1!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMOVSQ (in category 'generate machine code') -----
+ concretizeMOVSQ
+ <inline: true>
+ machineCode
+ at: 0 put: (self rexw: true r: 0 x: 0 b: 0);
+ at: 1 put: 16rA5.
+ ^machineCodeSize := 2!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveM16rR (in category 'generate machine code') -----
  concretizeMoveM16rR
  "N.B. The Cogit compiler makes no assumption about the upper bits being set to zero.
  It will clear the register before hand if necessary."
  "Will get inlined into concretizeAt: switch."
  <inline: true>
  | srcReg offset destReg |
  offset := operands at: 0.
  srcReg := operands at: 1.
  destReg := operands at: 2.
  machineCode
  at: 0 put: (self rexR: destReg x: 0 b: srcReg);
  at: 1 put: 16r0f;
  at: 2 put: 16rb7.
  (srcReg ~= RSP and: [srcReg ~= R12]) ifTrue:
+ [(offset = 0 and: [srcReg ~= RBP and: [srcReg ~= R13]]) ifTrue:
- [(offset = 0 and: [destReg ~= RBP and: [destReg ~= R13]]) ifTrue:
  [machineCode
  at: 3 put: (self mod: ModRegInd RM: srcReg RO: destReg).
  ^machineCodeSize := 4].
  (self isQuick: offset) ifTrue:
  [machineCode
  at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  at: 4 put: (offset bitAnd: 16rFF).
  ^machineCodeSize := 5].
  machineCode
  at: 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  at: 4 put: (offset bitAnd: 16rFF);
  at: 5 put: (offset >> 8 bitAnd: 16rFF);
  at: 6 put: (offset >> 16 bitAnd: 16rFF);
  at: 7 put: (offset >> 24 bitAnd: 16rFF).
  ^machineCodeSize := 8].
  "RSP & R12:"
+ (offset = 0 and: [srcReg ~= RBP and: [srcReg ~= R13]]) ifTrue:
- (offset = 0 and: [destReg ~= RBP and: [destReg ~= R13]]) ifTrue:
  [machineCode
  at: 3 put: (self mod: ModRegInd RM: srcReg RO: destReg);
  at: 4 put: (self s: SIB1 i: 4 b: srcReg).
  ^machineCodeSize := 5].
  (self isQuick: offset) ifTrue:
  [machineCode
  at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  at: 4 put: (self s: SIB1 i: 4 b: srcReg);
  at: 5 put: (offset bitAnd: 16rFF).
  ^machineCodeSize := 6].
  machineCode
  at: 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  at: 4 put: (self s: SIB1 i: 4 b: srcReg);
  at: 5 put: (offset bitAnd: 16rFF);
  at: 6 put: (offset >> 8 bitAnd: 16rFF);
  at: 7 put: (offset >> 16 bitAnd: 16rFF);
  at: 8 put: (offset >> 24 bitAnd: 16rFF).
  ^machineCodeSize := 9!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveM32rR (in category 'generate machine code') -----
+ concretizeMoveM32rR
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | offset srcReg destReg skip |
+ offset := operands at: 0.
+ srcReg := operands at: 1.
+ destReg := operands at: 2.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
+ machineCode
+ at: skip + 0 put: 16r8b.
+ offset = 0 ifTrue:
+ [(srcReg bitAnd: 6) ~= RSP ifTrue:
+ [machineCode at: skip + 1 put: (self mod: ModRegInd RM: srcReg RO: destReg).
+ ^machineCodeSize := skip + 2].
+ (srcReg bitAnd: 7) = RSP ifTrue: "RBP & R13 fall through"
+ [machineCode
+ at: skip + 1 put: (self mod: ModRegInd RM: srcReg RO: destReg);
+ at: skip + 2 put: (self s: SIB1 i: 4 b: srcReg).
+ ^machineCodeSize := skip + 3]].
+ (self isQuick: offset) ifTrue:
+ [(srcReg bitAnd: 7) ~= RSP ifTrue:
+ [machineCode
+ at: skip + 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
+ at: skip + 2 put: (offset bitAnd: 16rFF).
+ ^machineCodeSize := skip + 3].
+ machineCode
+ at: skip + 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
+ at: skip + 2 put: (self s: SIB1 i: 4 b: srcReg);
+ at: skip + 3 put: (offset bitAnd: 16rFF).
+ ^machineCodeSize := skip + 4].
+ machineCode at: skip + 1 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg).
+ (srcReg bitAnd: 7) = RSP ifTrue:
+ [machineCode at: skip + 2 put: (self s: SIB1 i: 4 b: srcReg).
+ skip := skip + 1].
+ machineCode
+ at: skip + 2 put: (offset bitAnd: 16rFF);
+ at: skip + 3 put: (offset >> 8 bitAnd: 16rFF);
+ at: skip + 4 put: (offset >> 16 bitAnd: 16rFF);
+ at: skip + 5 put: (offset >> 24 bitAnd: 16rFF).
+ ^machineCodeSize := skip + 6!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveM32rRs (in category 'generate machine code') -----
+ concretizeMoveM32rRs
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | offset srcReg destReg skip |
+ offset := operands at: 0.
+ srcReg := operands at: 1.
+ destReg := operands at: 2.
+ machineCode at: 0 put: 16r66.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
+ machineCode
+ at: skip + 1 put: 16r0f;
+ at: skip + 2 put: 16r6e.
+ offset = 0 ifTrue:
+ [(srcReg bitAnd: 6) ~= RSP ifTrue:
+ [machineCode at: skip + 3 put: (self mod: ModRegInd RM: srcReg RO: destReg).
+ ^machineCodeSize := skip + 4].
+ (srcReg bitAnd: 7) = RSP ifTrue: "RBP & R13 fall through"
+ [machineCode
+ at: skip + 3 put: (self mod: ModRegInd RM: srcReg RO: destReg);
+ at: skip + 4 put: (self s: SIB1 i: 4 b: srcReg).
+ ^machineCodeSize := skip + 5]].
+ (self isQuick: offset) ifTrue:
+ [(srcReg bitAnd: 7) ~= RSP ifTrue:
+ [machineCode
+ at: skip + 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
+ at: skip + 4 put: (offset bitAnd: 16rFF).
+ ^machineCodeSize := skip + 5].
+ machineCode
+ at: skip + 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
+ at: skip + 4 put: (self s: SIB1 i: 4 b: srcReg);
+ at: skip + 5 put: (offset bitAnd: 16rFF).
+ ^machineCodeSize := skip + 6].
+ machineCode at: skip + 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg).
+ (srcReg bitAnd: 7) = RSP ifTrue:
+ [machineCode at: skip + 4 put: (self s: SIB1 i: 4 b: srcReg).
+ skip := skip + 1].
+ machineCode
+ at: skip + 4 put: (offset bitAnd: 16rFF);
+ at: skip + 5 put: (offset >> 8 bitAnd: 16rFF);
+ at: skip + 6 put: (offset >> 16 bitAnd: 16rFF);
+ at: skip + 7 put: (offset >> 24 bitAnd: 16rFF).
+ ^machineCodeSize := skip + 8!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveRM32r (in category 'generate machine code') -----
+ concretizeMoveRM32r
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | offset srcReg destReg skip |
+ offset := operands at: 0.
+ srcReg := operands at: 1.
+ destReg := operands at: 2.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: srcReg x: 0 b: destReg)].
+ machineCode
+ at: skip + 0 put: 16r89.
+ offset = 0 ifTrue:
+ [(destReg bitAnd: 6) ~= RSP ifTrue:
+ [machineCode at: skip + 1 put: (self mod: ModRegInd RM: destReg RO: srcReg).
+ ^machineCodeSize := skip + 2].
+ (destReg bitAnd: 7) = RSP ifTrue: "RBP & R13 fall through"
+ [machineCode
+ at: skip + 1 put: (self mod: ModRegInd RM: destReg RO: srcReg);
+ at: skip + 2 put: (self s: SIB1 i: 4 b: destReg).
+ ^machineCodeSize := skip + 3]].
+ (self isQuick: offset) ifTrue:
+ [(destReg bitAnd: 7) ~= RSP ifTrue:
+ [machineCode
+ at: skip + 1 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
+ at: skip + 2 put: (offset bitAnd: 16rFF).
+ ^machineCodeSize := skip + 3].
+ machineCode
+ at: skip + 1 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
+ at: skip + 2 put: (self s: SIB1 i: 4 b: destReg);
+ at: skip + 3 put: (offset bitAnd: 16rFF).
+ ^machineCodeSize := skip + 4].
+ machineCode at: skip + 1 put: (self mod: ModRegRegDisp32  RM: destReg RO: srcReg).
+ (destReg bitAnd: 7) = RSP ifTrue:
+ [machineCode at: skip + 2 put: (self s: SIB1 i: 4 b: destReg).
+ skip := skip + 1].
+ machineCode
+ at: skip + 2 put: (offset bitAnd: 16rFF);
+ at: skip + 3 put: (offset >> 8 bitAnd: 16rFF);
+ at: skip + 4 put: (offset >> 16 bitAnd: 16rFF);
+ at: skip + 5 put: (offset >> 24 bitAnd: 16rFF).
+ ^machineCodeSize := skip + 6!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveRdRd (in category 'generate machine code') -----
+ concretizeMoveRdRd
+ "Will get inlined into concretizeAt: switch."
+ "MOVSD"
+ <inline: true>
+ | srcReg destReg skip |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: 16rF2.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: srcReg x: 0 b: destReg)].
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r11;
+ at: skip + 3 put: (self mod: ModReg RM: destReg RO: srcReg).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveRsM32r (in category 'generate machine code') -----
+ concretizeMoveRsM32r
+ <inline: true>
+ | offset srcReg destReg skip |
+ srcReg := operands at: 0.
+ offset := operands at: 1.
+ destReg := operands at: 2.
+ machineCode at: 0 put: 16r66.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: srcReg x: 0 b: destReg)].
+ machineCode
+ at: skip + 1 put: 16r0f;
+ at: skip + 2 put: 16r7e.
+ offset = 0 ifTrue:
+ [(destReg bitAnd: 6) ~= RSP ifTrue:
+ [machineCode at: skip + 3 put: (self mod: ModRegInd RM: destReg RO: srcReg).
+ ^machineCodeSize := skip + 4].
+ (destReg bitAnd: 7) = RSP ifTrue: "RBP & R13 fall through"
+ [machineCode
+ at: skip + 3 put: (self mod: ModRegInd RM: destReg RO: srcReg);
+ at: skip + 4 put: (self s: SIB1 i: 4 b: destReg).
+ ^machineCodeSize := skip + 5]].
+ (self isQuick: offset) ifTrue:
+ [(destReg bitAnd: 7) ~= RSP ifTrue:
+ [machineCode
+ at: skip + 3 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
+ at: skip + 4 put: (offset bitAnd: 16rFF).
+ ^machineCodeSize := skip + 5].
+ machineCode
+ at: skip + 3 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
+ at: skip + 4 put: (self s: SIB1 i: 4 b: destReg);
+ at: skip + 5 put: (offset bitAnd: 16rFF).
+ ^machineCodeSize := skip + 6].
+ machineCode at: skip + 3 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg).
+ (destReg bitAnd: 7) = RSP ifTrue:
+ [machineCode at: skip + 4 put: (self s: SIB1 i: 4 b: destReg).
+ skip := skip + 1].
+ machineCode
+ at: skip + 4 put: (offset bitAnd: 16rFF);
+ at: skip + 5 put: (offset >> 8 bitAnd: 16rFF);
+ at: skip + 6 put: (offset >> 16 bitAnd: 16rFF);
+ at: skip + 7 put: (offset >> 24 bitAnd: 16rFF).
+ ^machineCodeSize := skip + 8!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveRsRs (in category 'generate machine code') -----
+ concretizeMoveRsRs
+ "Will get inlined into concretizeAt: switch."
+ "MOVSS"
+ <inline: true>
+ | srcReg destReg skip |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: 16rF3.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: srcReg x: 0 b: destReg)].
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r11;
+ at: skip + 3 put: (self mod: ModReg RM: destReg RO: srcReg).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeREP (in category 'generate machine code') -----
+ concretizeREP
+ <inline: true>
+ machineCode at: 0 put: 16rF3.
+ ^machineCodeSize := 1!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeSEE2OpRdRd: (in category 'generate machine code') -----
  concretizeSEE2OpRdRd: x64opcode
  "Will get inlined into concretizeAt: switch."
  <inline: true>
+ | regLHS regRHS skip |
- | regLHS regRHS |
  regRHS := operands at: 0.
  regLHS := operands at: 1.
  machineCode
+ at: 0 put: 16rF2.
+ (regLHS <= 7 and: [regRHS <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: x64opcode;
+ at: skip + 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
+ ^machineCodeSize := skip + 4!
- at: 0 put: 16rF2;
- at: 1 put: 16r0F;
- at: 2 put: x64opcode;
- at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
- ^machineCodeSize := 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeSEEOpRsRs: (in category 'generate machine code') -----
+ concretizeSEEOpRsRs: x64opcode
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | regLHS regRHS skip |
+ regRHS := operands at: 0.
+ regLHS := operands at: 1.
+ machineCode
+ at: 0 put: 16rF3.
+ (regLHS <= 7 and: [regRHS <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: x64opcode;
+ at: skip + 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeSignExtend16RR (in category 'generate machine code') -----
+ concretizeSignExtend16RR
+ "Will get inlined into concretizeAt: switch."
+ "movsxwq"
+ <inline: true>
+ | srcReg destReg |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
+ at: 1 put: 16r0F;
+ at: 2 put: 16rBF;
+ at: 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^ machineCodeSize := 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeSignExtend32RR (in category 'generate machine code') -----
+ concretizeSignExtend32RR
+ "Will get inlined into concretizeAt: switch."
+ "movsxdq"
+ <inline: true>
+ | srcReg destReg |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
+ at: 1 put: 16r63;
+ at: 2 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^ machineCodeSize := 3!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeSignExtend8RR (in category 'generate machine code') -----
+ concretizeSignExtend8RR
+ "Will get inlined into concretizeAt: switch."
+ "movsxbq"
+ <inline: true>
+ | srcReg destReg |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
+ at: 1 put: 16r0F;
+ at: 2 put: 16rBE;
+ at: 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^ machineCodeSize := 4!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeSqrtRd (in category 'generate machine code') -----
  concretizeSqrtRd
  "Will get inlined into concretizeAt: switch."
  <inline: true>
+ | reg skip |
- | reg |
  reg := operands at: 0.
  machineCode
+ at: 0 put: 16rF2.
+ (reg <= 7)
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: reg x: 0 b: reg)].
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r51;
+ at: skip + 3 put: (self mod: ModReg RM: reg RO: reg).
+ ^machineCodeSize := skip + 4!
- at: 0 put: 16rF2;
- at: 1 put: 16r0F;
- at: 2 put: 16r51;
- at: 3 put: (self mod: ModReg RM: reg RO: reg).
- ^machineCodeSize := 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeSqrtRs (in category 'generate machine code') -----
+ concretizeSqrtRs
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | reg skip |
+ reg := operands at: 0.
+ machineCode
+ at: 0 put: 16rF3.
+ (reg <= 7)
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: reg x: 0 b: reg)].
+ machineCode
+ at: skip + 1 put: 16r0F;
+ at: skip + 2 put: 16r51;
+ at: skip + 3 put: (self mod: ModReg RM: reg RO: reg).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeXorRdRd (in category 'generate machine code') -----
+ concretizeXorRdRd
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | regLHS regRHS skip |
+ regRHS := self operands at: 0.
+ regLHS := self operands at: 1.
+ machineCode
+ at: 0 put: 16r66.
+ (regLHS <= 7 and: [regRHS <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
+ machineCode
+ at: skip + 1 put: 16r0f;
+ at: skip + 2 put: 16r57;
+ at: skip + 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
+ ^machineCodeSize := skip + 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeXorRsRs (in category 'generate machine code') -----
+ concretizeXorRsRs
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | regLHS regRHS skip |
+ regRHS := self operands at: 0.
+ regLHS := self operands at: 1.
+ machineCode
+ at: 0 put: 16r0F.
+ (regLHS <= 7 and: [regRHS <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
+
+ machineCode
+ at: skip + 1 put: 16r57;
+ at: skip + 2 put: (self mod: ModReg RM: regRHS RO: regLHS).
+ ^machineCodeSize := skip + 3!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeZeroExtend16RR (in category 'generate machine code') -----
+ concretizeZeroExtend16RR
+ "Will get inlined into concretizeAt: switch."
+ "movzxwq"
+ <inline: true>
+ | srcReg destReg |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
+ at: 1 put: 16r0F;
+ at: 2 put: 16rB7;
+ at: 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^ machineCodeSize := 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeZeroExtend32RR (in category 'generate machine code') -----
+ concretizeZeroExtend32RR
+ "Will get inlined into concretizeAt: switch."
+ "movzxbq"
+ <inline: true>
+ | srcReg destReg skip |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ (srcReg <= 7 and: [destReg <= 7])
+ ifTrue: [skip := 0]
+ ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
+
+ machineCode
+ at: skip + 0 put: 16r8b;
+ at: skip + 1 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^ machineCodeSize := skip + 2!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeZeroExtend8RR (in category 'generate machine code') -----
+ concretizeZeroExtend8RR
+ "Will get inlined into concretizeAt: switch."
+ "movzxbq"
+ <inline: true>
+ | srcReg destReg |
+ srcReg := operands at: 0.
+ destReg := operands at: 1.
+ machineCode
+ at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
+ at: 1 put: 16r0F;
+ at: 2 put: 16rB6;
+ at: 3 put: (self mod: ModReg RM: srcReg RO: destReg).
+ ^ machineCodeSize := 4!

Item was changed:
  ----- Method: CogX64Compiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  "Attempt to generate concrete machine code for the instruction at address.
  This is the inner dispatch of concretizeAt: actualAddress which exists only
  to get around the branch size limits in the SqueakV3 (blue book derived)
  bytecode set."
  <returnTypeC: #void>
  opcode caseOf: {
  "Noops & Pseudo Ops"
  [Label] -> [^self concretizeLabel].
  [AlignmentNops] -> [^self concretizeAlignmentNops].
  [Fill32] -> [^self concretizeFill32].
  [Nop] -> [^self concretizeNop].
  "Specific Control/Data Movement"
  [CDQ] -> [^self concretizeCDQ].
  [IDIVR] -> [^self concretizeIDIVR].
  [IMULRR] -> [^self concretizeMulRR].
  "[CPUID] -> [^self concretizeCPUID]."
  "[CMPXCHGAwR] -> [^self concretizeCMPXCHGAwR]."
  "[CMPXCHGMwrR] -> [^self concretizeCMPXCHGMwrR]."
  "[LFENCE] -> [^self concretizeFENCE: 5]."
  "[MFENCE] -> [^self concretizeFENCE: 6].
  [SFENCE] -> [^self concretizeFENCE: 7]."
  "[LOCK] -> [^self concretizeLOCK]."
  "[XCHGAwR] -> [^self concretizeXCHGAwR]."
  "[XCHGMwrR] -> [^self concretizeXCHGMwrR]."
  [XCHGRR] -> [^self concretizeXCHGRR].
+ [REP] -> [^self concretizeREP].
+ [CLD] -> [^self concretizeCLD].
+ [MOVSB] -> [^self concretizeMOVSB].
+ [MOVSQ] -> [^self concretizeMOVSQ].
  "Control"
  [Call] -> [^self concretizeCall].
+ [CallR] -> [^self concretizeCallR].
  [CallFull] -> [^self concretizeCallFull].
  [JumpR] -> [^self concretizeJumpR].
  [JumpFull] -> [^self concretizeJumpFull].
  [JumpLong] -> [^self concretizeJumpLong].
  [JumpLongZero] -> [^self concretizeConditionalJump: 16r4].
  [JumpLongNonZero] -> [^self concretizeConditionalJump: 16r5].
  [Jump] -> [^self concretizeJump].
  "Table B-1 Intel¬Æ 64 and IA-32 Architectures Software Developer's Manual Volume 1: Basic Architecture"
  [JumpZero] -> [^self concretizeConditionalJump: 16r4].
  [JumpNonZero] -> [^self concretizeConditionalJump: 16r5].
  [JumpNegative] -> [^self concretizeConditionalJump: 16r8].
  [JumpNonNegative] -> [^self concretizeConditionalJump: 16r9].
  [JumpOverflow] -> [^self concretizeConditionalJump: 16r0].
  [JumpNoOverflow] -> [^self concretizeConditionalJump: 16r1].
  [JumpCarry] -> [^self concretizeConditionalJump: 16r2].
  [JumpNoCarry] -> [^self concretizeConditionalJump: 16r3].
  [JumpLess] -> [^self concretizeConditionalJump: 16rC].
  [JumpGreaterOrEqual] -> [^self concretizeConditionalJump: 16rD].
  [JumpGreater] -> [^self concretizeConditionalJump: 16rF].
  [JumpLessOrEqual] -> [^self concretizeConditionalJump: 16rE].
  [JumpBelow] -> [^self concretizeConditionalJump: 16r2].
  [JumpAboveOrEqual] -> [^self concretizeConditionalJump: 16r3].
  [JumpAbove] -> [^self concretizeConditionalJump: 16r7].
  [JumpBelowOrEqual] -> [^self concretizeConditionalJump: 16r6].
  [JumpFPEqual] -> [^self concretizeConditionalJump: 16r4].
  [JumpFPNotEqual] -> [^self concretizeConditionalJump: 16r5].
  [JumpFPLess] -> [^self concretizeConditionalJump: 16r2].
  [JumpFPGreaterOrEqual] -> [^self concretizeConditionalJump: 16r3].
  [JumpFPGreater] -> [^self concretizeConditionalJump: 16r7].
  [JumpFPLessOrEqual] -> [^self concretizeConditionalJump: 16r6].
  [JumpFPOrdered] -> [^self concretizeConditionalJump: 16rB].
  [JumpFPUnordered] -> [^self concretizeConditionalJump: 16rA].
  [RetN] -> [^self concretizeRetN].
  [Stop] -> [^self concretizeStop].
  "Arithmetic"
  [AddCqR] -> [^self concretizeArithCqRWithRO: 0 raxOpcode: 15r05].
  [AddCwR] -> [^self concretizeArithCwR: 16r03].
  [AddRR] -> [^self concretizeOpRR: 16r03].
+ [AddRsRs] -> [^self concretizeSEEOpRsRs: 16r58].
  [AddRdRd] -> [^self concretizeSEE2OpRdRd: 16r58].
  [AndCqR] -> [^self concretizeArithCqRWithRO: 4 raxOpcode: 16r25].
  [AndCwR] -> [^self concretizeArithCwR: 16r23].
  [AndRR] -> [^self concretizeOpRR: 16r23].
  [TstCqR] -> [^self concretizeTstCqR].
  [CmpCqR] -> [^self concretizeArithCqRWithRO: 7 raxOpcode: 16r3D].
  [CmpCwR] -> [^self concretizeArithCwR: 16r39].
  [CmpC32R] -> [^self concretizeCmpC32R].
  [CmpRR] -> [^self concretizeReverseOpRR: 16r39].
  [CmpRdRd] -> [^self concretizeCmpRdRd].
+ [CmpRsRs] -> [^self concretizeCmpRsRs].
  [DivRdRd] -> [^self concretizeSEE2OpRdRd: 16r5E].
+ [DivRsRs] -> [^self concretizeSEEOpRsRs: 16r5E].
  [MulRdRd] -> [^self concretizeSEE2OpRdRd: 16r59].
+ [MulRsRs] -> [^self concretizeSEEOpRsRs: 16r59].
  [OrCqR] -> [^self concretizeArithCqRWithRO: 1 raxOpcode: 16r0D].
  [OrCwR] -> [^self concretizeArithCwR: 16r0B].
  [OrRR] -> [^self concretizeOpRR: 16r0B].
  [SubCqR] -> [^self concretizeArithCqRWithRO: 5 raxOpcode: 16r2D].
  [SubCwR] -> [^self concretizeArithCwR: 16r2B].
  [SubRR] -> [^self concretizeOpRR: 16r2B].
  [SubRdRd] -> [^self concretizeSEE2OpRdRd: 16r5C].
+ [SubRsRs] -> [^self concretizeSEEOpRsRs: 16r5C].
  [SqrtRd] -> [^self concretizeSqrtRd].
+ [SqrtRs] -> [^self concretizeSqrtRs].
  [XorCwR] -> [^self concretizeArithCwR: 16r33].
  [XorRR] -> [^self concretizeOpRR: 16r33].
+ [XorRdRd] -> [^self concretizeXorRdRd].
+ [XorRsRs] -> [^self concretizeXorRsRs].
  [NegateR] -> [^self concretizeNegateR].
  [LoadEffectiveAddressMwrR] -> [^self concretizeLoadEffectiveAddressMwrR].
  [RotateLeftCqR] -> [^self concretizeShiftCqRegOpcode: 0].
  [RotateRightCqR] -> [^self concretizeShiftCqRegOpcode: 1].
  [ArithmeticShiftRightCqR] -> [^self concretizeShiftCqRegOpcode: 7].
  [LogicalShiftRightCqR] -> [^self concretizeShiftCqRegOpcode: 5].
  [LogicalShiftLeftCqR] -> [^self concretizeShiftCqRegOpcode: 4].
  [ArithmeticShiftRightRR] -> [^self concretizeShiftRegRegOpcode: 7].
  [LogicalShiftLeftRR] -> [^self concretizeShiftRegRegOpcode: 4].
  "Data Movement"
  [MoveCqR] -> [^self concretizeMoveCqR].
  [MoveCwR] -> [^self concretizeMoveCwR].
  [MoveC32R] -> [^self concretizeMoveC32R].
  [MoveRR] -> [^self concretizeReverseOpRR: 16r89].
  [MoveAwR] -> [^self concretizeMoveAwR].
  [MoveA32R] -> [^self concretizeMoveA32R].
  [MoveRAw] -> [^self concretizeMoveRAw].
  [MoveRA32] -> [^self concretizeMoveRA32].
  [MoveAbR] -> [^self concretizeMoveAbR].
  [MoveRAb] -> [^self concretizeMoveRAb].
  [MoveMbrR] -> [^self concretizeMoveMbrR].
  [MoveRMbr] -> [^self concretizeMoveRMbr].
  [MoveM16rR] -> [^self concretizeMoveM16rR].
  [MoveRM16r] -> [^self concretizeMoveRM16r].
+ [MoveM32rR] -> [^self concretizeMoveM32rR].
+ [MoveM32rRs] -> [^self concretizeMoveM32rRs].
  [MoveM64rRd] -> [^self concretizeMoveM64rRd].
  [MoveMwrR] -> [^self concretizeMoveMwrR].
  [MoveXbrRR] -> [^self concretizeMoveXbrRR].
  [MoveRXbrR] -> [^self concretizeMoveRXbrR].
  [MoveXwrRR] -> [^self concretizeMoveXwrRR].
  [MoveRXwrR] -> [^self concretizeMoveRXwrR].
  [MoveX32rRR] -> [^self concretizeMoveX32rRR].
  [MoveRX32rR] -> [^self concretizeMoveRX32rR].
  [MoveRMwr] -> [^self concretizeMoveRMwr].
+ [MoveRM32r] -> [^self concretizeMoveRM32r].
+ [MoveRsM32r] -> [^self concretizeMoveRsM32r].
  [MoveRdM64r] -> [^self concretizeMoveRdM64r].
  [MoveRdR] -> [^self concretizeMoveRdR].
  [MoveRRd] -> [^self concretizeMoveRRd].
+ [MoveRdRd] -> [^self concretizeMoveRdRd].
+ [MoveRsRs] -> [^self concretizeMoveRsRs].
  [PopR] -> [^self concretizePopR].
  [PushR] -> [^self concretizePushR].
  [PushCq] -> [^self concretizePushCq].
  [PushCw] -> [^self concretizePushCw].
  [PrefetchAw] -> [^self concretizePrefetchAw].
  "Conversion"
+ [ConvertRRd] -> [^self concretizeConvertRRd].
+ [ConvertRdR] -> [^self concretizeConvertRdR].
+ [ConvertRRs] -> [^self concretizeConvertRRs].
+ [ConvertRsR] -> [^self concretizeConvertRsR].
+ [ConvertRsRd] -> [^self concretizeConvertRsRd].
+ [ConvertRdRs] -> [^self concretizeConvertRdRs].
+
+ [SignExtend8RR] -> [^self concretizeSignExtend8RR].
+ [SignExtend16RR] -> [^self concretizeSignExtend16RR].
+ [SignExtend32RR] -> [^self concretizeSignExtend32RR].
+
+ [ZeroExtend8RR] -> [^self concretizeZeroExtend8RR].
+ [ZeroExtend16RR] -> [^self concretizeZeroExtend16RR].
+ [ZeroExtend32RR] -> [^self concretizeZeroExtend32RR].
+ }!
- [ConvertRRd] -> [^self concretizeConvertRRd] }!

Item was added:
+ ----- Method: CogX64Compiler>>genMarshallNArgs:floatArg:floatArg:floatArg:floatArg: (in category 'abi') -----
+ genMarshallNArgs: numArgs floatArg: regOrConst0 floatArg: regOrConst1 floatArg: regOrConst2 floatArg: regOrConst3
+ "Generate the code to pass up to four float arguments in a C run-time call.  Hack: each argument is
+ either a negative number, which encodes a constant, or a non-negative number, that of a register.
+
+ Run-time calls have no more than four arguments, so chosen so that on ARM, where in its C ABI the
+ first four integer arguments are passed in registers, all arguments can be passed in registers.  We
+ defer to the back end to generate this code not so much that the back end knows whether it uses
+ the stack or registers to pass arguments (it does, but...). In fact we defer for an extremely evil reason.
+ Doing so allows the x64 (where up to 6 args are passed) to assign the register arguments in an order
+ that allows some of the argument registers to be used for specific abstract  registers, specifically
+ ReceiverResultReg and ClassReg.  This is evil, evil, evil, but also it's really nice to keep using the old
+ register assignments the original author has grown accustomed to."
+ <inline: true>
+ SysV ifFalse: "WIN64 ABI allways reserve shadow space on the stack for callee to save up to 4 register parameters"
+ [cogit SubCq: 32 R: RSP].
+ numArgs = 0 ifTrue: [^self].
+
+ (cogit isTrampolineArgConstant: regOrConst0)
+ ifTrue: [cogit MoveCf64: (cogit trampolineArgValue: regOrConst0) Rd: XMM0L] "a.k.a. DPFPReg0"
+ ifFalse: [regOrConst0 ~= XMM0L ifTrue:
+ [cogit MoveR: regOrConst0 R: XMM0L]].
+ numArgs = 1 ifTrue: [^self].
+
+ (cogit isTrampolineArgConstant: regOrConst1)
+ ifTrue: [cogit MoveCf64: (cogit trampolineArgValue: regOrConst1) Rd: XMM1L] "a.k.a. DPFPReg1"
+ ifFalse: [regOrConst1 ~= XMM1L ifTrue:
+ [cogit MoveR: regOrConst1 R: XMM1L]].
+ numArgs = 2 ifTrue: [^self].
+
+ (cogit isTrampolineArgConstant: regOrConst2)
+ ifTrue: [cogit MoveCf64: (cogit trampolineArgValue: regOrConst2) Rd: XMM2L] "a.k.a. DPFPReg0"
+ ifFalse: [regOrConst2 ~= XMM2L ifTrue:
+ [cogit MoveR: regOrConst2 R: XMM2L]].
+ numArgs = 3 ifTrue: [^self].
+
+ (cogit isTrampolineArgConstant: regOrConst3)
+ ifTrue: [cogit MoveCf64: (cogit trampolineArgValue: regOrConst3) Rd: XMM3L] "a.k.a. DPFPReg3"
+ ifFalse: [regOrConst3 ~= XMM3L ifTrue:
+ [cogit MoveR: regOrConst3 R: XMM3L]].
+
+ self assert: numArgs <= 4!

Item was added:
+ ----- Method: CogX64Compiler>>genMemCopy:to:constantSize: (in category 'abstract instructions') -----
+ genMemCopy: originalSourceReg to: originalDestReg constantSize: size
+ | numbytes numwords sourceReg destReg countReg inst |
+
+ "Get the abstract registers for ECX, EDI and ESI"
+ sourceReg := RSI.
+ destReg := RDI.
+ countReg := RCX.
+
+ "Put the source in ESI and the dest in EDI"
+ inst := cogit Label.
+ originalSourceReg ~= sourceReg ifTrue: [
+ originalDestReg = sourceReg ifTrue: [
+ cogit MoveR: originalDestReg R: TempReg.
+ ].
+ cogit MoveR: originalSourceReg R: sourceReg.
+ ].
+
+ originalDestReg ~= destReg ifTrue: [
+ originalDestReg = sourceReg ifTrue: [
+ cogit MoveR: TempReg R: destReg.
+ ] ifFalse: [
+ cogit MoveR: originalDestReg R: destReg.
+ ]
+ ].
+
+ "Store the count and clear the direction"
+ cogit gen: CLD.
+
+ "First copy the bytes"
+ numbytes := size bitAnd: 16r07.
+ numbytes > 0 ifTrue: [
+ cogit MoveCq: numbytes R: countReg.
+ cogit gen: REP.
+ cogit gen: MOVSB.
+ ].
+
+ "Now copy the qwords"
+ numwords := size // 8.
+ cogit MoveCq:  numwords R: countReg.
+ cogit gen: REP.
+ cogit gen: MOVSQ.
+
+ !

Item was added:
+ ----- Method: CogX64Compiler>>genMemCopy:to:size: (in category 'abstract instructions') -----
+ genMemCopy: originalSourceReg to: originalDestReg size: originalSize
+ | spilledSize size sourceReg destReg countReg inst |
+
+ "Get the abstract registers for ECX, EDI and ESI"
+ sourceReg := RSI.
+ destReg := RDI.
+ countReg := RCX.
+
+ "TODO: Avoid spilling"
+ spilledSize := false.
+ (originalSize = sourceReg or: [originalSize = destReg]) ifTrue: [
+ cogit PushR: originalSize.
+ spilledSize := true.
+ ].
+
+ "Put the source in ESI and the dest in EDI"
+ inst := cogit Label.
+ originalSourceReg ~= sourceReg ifTrue: [
+ originalDestReg = sourceReg ifTrue: [
+ cogit MoveR: originalDestReg R: TempReg.
+ ].
+ cogit MoveR: originalSourceReg R: sourceReg.
+ ].
+
+ originalDestReg ~= destReg ifTrue: [
+ originalDestReg = sourceReg ifTrue: [
+ cogit MoveR: TempReg R: destReg.
+ ] ifFalse: [
+ cogit MoveR: originalDestReg R: destReg.
+ ]
+ ].
+
+ "Put the original size register in somewhere different than ECX"
+ spilledSize ifTrue: [
+ cogit PopR: TempReg.
+ size := TempReg.
+ ] ifFalse: [
+ originalSize = countReg ifTrue: [
+ cogit MoveR: originalSize R: TempReg.
+ size := TempReg.
+ ] ifFalse: [
+ size := originalSize.
+ ]
+ ].
+
+ cogit gen: CLD.
+
+ "First copy the bytes"
+ cogit MoveR: size R: countReg.
+ cogit AndCq: 16r07 R: countReg.
+ cogit gen: REP.
+ cogit gen: MOVSB.
+
+ "Now copy the words"
+ cogit MoveR: size R: countReg.
+ cogit LogicalShiftRightCq: 3 R: countReg.
+ cogit gen: REP.
+ cogit gen: MOVSQ.
+ !

Item was added:
+ ----- Method: CogX64Compiler>>genMoveCf32:Rs: (in category 'abstract instructions') -----
+ genMoveCf32: constantFloat32 Rs: register
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ <var: #constantFloat32 type: #float>
+ | inst |
+ inst := cogit PushCw: constantFloat32 asIEEE32BitWord.
+ cogit PopRs: register.
+ ^ inst!

Item was added:
+ ----- Method: CogX64Compiler>>genMoveCf64:Rd: (in category 'abstract instructions') -----
+ genMoveCf64: constantFloat64 Rd: register
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ <var: #constantFloat64 type: #double>
+ | inst |
+ inst := cogit PushCw: constantFloat64 asIEEE64BitWord.
+ cogit PopRd: register.
+ ^ inst!

Item was added:
+ ----- Method: CogX64Compiler>>genPopRd: (in category 'abstract instructions') -----
+ genPopRd: reg
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ | inst |
+ inst := cogit MoveM64: 0 r: SPReg Rd: reg .
+ cogit AddCq: 8 R: SPReg.
+ ^ inst!

Item was added:
+ ----- Method: CogX64Compiler>>genPopRs: (in category 'abstract instructions') -----
+ genPopRs: reg
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ | inst |
+ inst := cogit MoveM32: 0 r: SPReg Rs: reg .
+ cogit AddCq: 8 R: SPReg.
+ ^ inst!

Item was added:
+ ----- Method: CogX64Compiler>>genPushRd: (in category 'abstract instructions') -----
+ genPushRd: reg
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ | inst |
+ inst := cogit MoveRd: reg M64: -8 r: SPReg.
+ cogit SubCq: 8 R: SPReg.
+ ^ inst!

Item was added:
+ ----- Method: CogX64Compiler>>genPushRs: (in category 'abstract instructions') -----
+ genPushRs: reg
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ | inst |
+ inst := cogit MoveRs: reg M32: -8 r: SPReg.
+ cogit SubCq: 8 R: SPReg.
+ ^ inst!

Item was added:
+ ----- Method: CogX64Compiler>>genRemoveNFloatArgsFromStack: (in category 'abi') -----
+ genRemoveNFloatArgsFromStack: n
+ "This is a no-op on x64 SysV since the ABI passes up to 6 args in registers and trampolines currently observe a limit of 4.
+ But the WIN64 ABI allways reserve shadow space for saving up to 4 parameter registers (even if less than 4 args)."
+ self assert: n <= 4.
+ SysV ifFalse: [cogit AddCq: 32 R: RSP].
+ ^0!

Item was added:
+ ----- Method: Cogit>>MoveM64:r:R: (in category 'abstract instructions') -----
+ MoveM64: offset r: baseReg R: destReg
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ self assert: BytesPerWord = 8.
+ ^self MoveMw: offset r: baseReg R: destReg
+ !

Item was added:
+ ----- Method: Cogit>>MoveR:M64:r: (in category 'abstract instructions') -----
+ MoveR: sourceReg M64: offset r: baseReg
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ self assert: BytesPerWord = 8.
+ ^self MoveR: sourceReg Mw: offset r: baseReg !

Item was added:
+ ----- Method: Cogit>>SignExtend32R:R: (in category 'abstract instructions') -----
+ SignExtend32R: reg1 R: reg2
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ ^self gen: SignExtend32RR operand: reg1 operand: reg2!

Item was added:
+ ----- Method: Cogit>>ZeroExtend32R:R: (in category 'abstract instructions') -----
+ ZeroExtend32R: reg1 R: reg2
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ ^self gen: ZeroExtend32RR operand: reg1 operand: reg2!

Item was changed:
  ----- Method: StackInterpreter>>internalPopStackFloat32 (in category 'internal interpreter access') -----
  internalPopStackFloat32
  <option: #LowcodeVM>
  <returnTypeC: #float>
  <var: #topSingle type: #float>
  "In the StackInterpreter stacks grow down."
  | topSingle  |
  nativeSP := self nativeStackPointerIn: localFP.
  topSingle := stackPages singleFloatAtPointer: nativeSP - 1.
+ nativeSP := self nativeStackPointerIn: localFP put: nativeSP + objectMemory bytesPerOop.
- nativeSP := self nativeStackPointerIn: localFP put: nativeSP + 4.
  ^topSingle!

Item was changed:
  ----- Method: StackInterpreter>>internalPopStackInt32 (in category 'internal interpreter access') -----
  internalPopStackInt32
  <option: #LowcodeVM>
  "In the StackInterpreter stacks grow down."
  | topInt32 |
  nativeSP := self nativeStackPointerIn: localFP.
  topInt32 := stackPages int32AtPointer: nativeSP - 1.
+ nativeSP := self nativeStackPointerIn: localFP put: nativeSP + objectMemory bytesPerOop.
- nativeSP := self nativeStackPointerIn: localFP put: nativeSP + BytesPerOop.
  ^topInt32!

Item was changed:
  ----- Method: StackInterpreter>>internalPopStackPointer (in category 'internal interpreter access') -----
  internalPopStackPointer
  <option: #LowcodeVM>
  <returnTypeC: #'char*'>
  <var: #topPointer type: #'char*'>
  "In the StackInterpreter stacks grow down."
  | topPointer |
  nativeSP := self nativeStackPointerIn: localFP.
  topPointer := stackPages pointerAtPointer: nativeSP - 1.
+ nativeSP := self nativeStackPointerIn: localFP put: nativeSP + objectMemory bytesPerOop.
- nativeSP := self nativeStackPointerIn: localFP put: nativeSP + BytesPerOop.
  ^topPointer!

Item was changed:
  ----- Method: StackInterpreter>>internalPushFloat32: (in category 'internal interpreter access') -----
  internalPushFloat32: singleFloatValue
  <option: #LowcodeVM>
  <var: #singleFloatValue type: #float >
  "In the StackInterpreter stacks grow down."
+ nativeSP := (self nativeStackPointerIn: localFP) - objectMemory bytesPerOop.
- nativeSP := (self nativeStackPointerIn: localFP) - 4.
  self nativeStackPointerIn: localFP put: nativeSP.
 
  "In the StackInterpreter stacks grow down."
  stackPages singleFloatAtPointer: (nativeSP - 1) put: singleFloatValue!

Item was changed:
  ----- Method: StackInterpreter>>internalPushInt32: (in category 'internal interpreter access') -----
  internalPushInt32: int32Value
  <option: #LowcodeVM>
  "In the StackInterpreter stacks grow down."
+ nativeSP := (self nativeStackPointerIn: localFP) - objectMemory bytesPerOop.
- nativeSP := (self nativeStackPointerIn: localFP) - 4.
  self nativeStackPointerIn: localFP put: nativeSP.
 
  "In the StackInterpreter stacks grow down."
  stackPages int32AtPointer: (nativeSP - 1) put: int32Value
  !

Item was changed:
  ----- Method: StackInterpreter>>internalPushPointer: (in category 'internal interpreter access') -----
  internalPushPointer: pointerValue
  <option: #LowcodeVM>
  <var: #pointerValue type: #'char*' >
  "In the StackInterpreter stacks grow down."
+ nativeSP := (self nativeStackPointerIn: localFP) - objectMemory bytesPerOop.
- nativeSP := (self nativeStackPointerIn: localFP) - BytesPerOop.
  self nativeStackPointerIn: localFP put: nativeSP.
 
  "In the StackInterpreter stacks grow down."
  stackPages pointerAtPointer: (nativeSP - 1) put: pointerValue
  !

Item was changed:
  ----- Method: StackInterpreter>>internalPushShadowCallStackFloat32: (in category 'internal interpreter access') -----
  internalPushShadowCallStackFloat32: singleFloatValue
  <option: #LowcodeVM>
  <var: #singleFloatValue type: #float >
  "In the StackInterpreter stacks grow down."
+ shadowCallStackPointer := shadowCallStackPointer - objectMemory bytesPerOop.
- shadowCallStackPointer := shadowCallStackPointer - 4.
 
  "In the StackInterpreter stacks grow down."
  stackPages singleFloatAtPointer: shadowCallStackPointer put: singleFloatValue!

Item was changed:
  ----- Method: StackInterpreter>>internalPushShadowCallStackInt32: (in category 'internal interpreter access') -----
  internalPushShadowCallStackInt32: int32Value
  <option: #LowcodeVM>
  "In the StackInterpreter stacks grow down."
+ shadowCallStackPointer := shadowCallStackPointer - objectMemory bytesPerOop.
- shadowCallStackPointer := shadowCallStackPointer - 4.
 
  "In the StackInterpreter stacks grow down."
  stackPages int32AtPointer: shadowCallStackPointer put: int32Value!

Item was changed:
  ----- Method: StackInterpreter>>lowcodePrimitiveLocalFrameSize (in category 'inline primitive generated code') -----
  lowcodePrimitiveLocalFrameSize
  <option: #LowcodeVM> "Lowcode instruction generator"
+ | alignedSize size |
- | size |
  size := extA.
 
+ "Align the size to 16 bytes."
+ alignedSize := size + 15 bitAnd: -16.
  "Mark the frame"
  self setFrameHasNativeFrame: localFP.
  "Store the previous stack pointer"
  self nativePreviousStackPointerIn: localFP put: nativeStackPointer + 1.
  "Make the frame pointer"
+ nativeStackPointer := nativeStackPointer - alignedSize.
- nativeStackPointer := nativeStackPointer - size.
  self nativeFramePointerIn: localFP put: nativeStackPointer + 1.
  "Set the stack pointer"
  nativeSP := nativeStackPointer + 1.
  self nativeStackPointerIn: localFP put: nativeStackPointer + 1.
  "Reserve space for the native stack"
  nativeStackPointer := nativeStackPointer - self defaultNativeStackFrameSize.
 
  extA := 0.
 
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCodeGen
  aCodeGen
  var: #methodAbortTrampolines
  declareC: 'sqInt methodAbortTrampolines[4]';
  var: #picAbortTrampolines
  declareC: 'sqInt picAbortTrampolines[4]';
  var: #picMissTrampolines
  declareC: 'sqInt picMissTrampolines[4]';
  var: 'ceCall0ArgsPIC'
  declareC: 'void (*ceCall0ArgsPIC)(void)';
  var: 'ceCall1ArgsPIC'
  declareC: 'void (*ceCall1ArgsPIC)(void)';
  var: 'ceCall2ArgsPIC'
  declareC: 'void (*ceCall2ArgsPIC)(void)';
  var: #ceCallCogCodePopReceiverArg0Regs
  declareC: 'void (*ceCallCogCodePopReceiverArg0Regs)(void)';
  var: #realCECallCogCodePopReceiverArg0Regs
  declareC: 'void (*realCECallCogCodePopReceiverArg0Regs)(void)';
  var: #ceCallCogCodePopReceiverArg1Arg0Regs
  declareC: 'void (*ceCallCogCodePopReceiverArg1Arg0Regs)(void)';
  var: #realCECallCogCodePopReceiverArg1Arg0Regs
  declareC: 'void (*realCECallCogCodePopReceiverArg1Arg0Regs)(void)';
  var: 'simStack'
  declareC: 'SimStackEntry simStack[', self simStackSlots asString, ']';
  var: 'simSelf'
  type: #CogSimStackEntry;
  var: #optStatus
  type: #CogSSOptStatus;
  var: 'prevBCDescriptor'
  type: #'BytecodeDescriptor *'.
  LowcodeVM ifTrue: [
  aCodeGen var: 'simNativeStack'
+ declareC: 'CogSimStackNativeEntry simNativeStack[', self simNativeStackSlots asString, ']'
- declareC: 'CogSimStackNativeEntry simNativeStack[', ((CoInterpreter bindingOf: #LargeContextSlots) value * 5 / 4 // BytesPerWord) asString, ']'
  ].
 
  self numPushNilsFunction ifNotNil:
  [aCodeGen
  var: 'numPushNilsFunction'
  declareC: 'sqInt (* const numPushNilsFunction)(struct _BytecodeDescriptor *,sqInt,sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self numPushNilsFunction);
  var: 'pushNilSizeFunction'
  declareC: 'sqInt (* const pushNilSizeFunction)(sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self pushNilSizeFunction)].
 
  aCodeGen
  addSelectorTranslation: #register to: (aCodeGen cFunctionNameFor: 'registerr');
  addSelectorTranslation: #register: to: (aCodeGen cFunctionNameFor: 'registerr:')!

Item was added:
+ ----- Method: StackToRegisterMappingCogit class>>simNativeStackSlots (in category 'translation') -----
+ simNativeStackSlots
+ ^ self basicNew simNativeStackSlots!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodeInt64NotEqual (in category 'inline primitive generators generated code') -----
  genLowcodeInt64NotEqual
  <option: #LowcodeVM> "Lowcode instruction generator"
  | falseLabel first contJump falseJump secondLow secondHigh second falseJump2 firstHigh firstLow |
  BytesPerWord = 4 ifTrue: [
 
  (secondLow := backEnd availableRegisterOrNoneFor: self liveRegisters) = NoReg ifTrue:
  [self ssAllocateRequiredReg:
  (secondLow := optStatus isReceiverResultRegLive
  ifTrue: [Arg0Reg]
  ifFalse: [ReceiverResultReg])].
 
  (secondHigh := backEnd availableRegisterOrNoneFor: (self liveRegisters bitOr: (self registerMaskFor: secondLow))) = NoReg ifTrue:
  [self ssAllocateRequiredReg: (secondHigh := Arg1Reg)].
 
  (firstLow := backEnd availableRegisterOrNoneFor: ((self liveRegisters bitOr: (self registerMaskFor: secondLow)) bitOr: (self registerMaskFor: secondHigh))) = NoReg ifTrue:
  [self ssAllocateRequiredReg: (firstLow := SendNumArgsReg)].
 
  (firstHigh := backEnd availableRegisterOrNoneFor: (((self liveRegisters bitOr: (self registerMaskFor: secondLow)) bitOr: (self registerMaskFor: secondHigh)) bitOr: (self registerMaskFor: firstLow))) = NoReg ifTrue:
  [self ssAllocateRequiredReg: (firstHigh := ClassReg)].
  (((secondLow = ReceiverResultReg or: [secondHigh = ReceiverResultReg]) or: [firstLow = ReceiverResultReg]) or: [firstHigh = ReceiverResultReg]) ifTrue:
  [ optStatus isReceiverResultRegLive: false ].
  self ssNativeTop nativePopToReg: secondLow secondReg: secondHigh.
  self ssNativePop: 1.
  self ssNativeTop nativePopToReg: firstLow secondReg: firstHigh.
  self ssNativePop: 1.
 
  self CmpR: secondHigh R: firstHigh.
  falseJump := self JumpNonZero: 0.
  self CmpR: secondLow R: firstLow.
  falseJump2 := self JumpNonZero: 0.
  "False result"
  self MoveCq: 0 R: firstLow.
  contJump := self Jump: 0.
  "True result"
  falseLabel := self MoveCq: 1 R: firstLow.
  falseJump jmpTarget: falseLabel.
  falseJump2 jmpTarget: falseLabel.
  contJump jmpTarget: self Label.
  self ssPushNativeRegister: firstLow.
 
  ] ifFalse: [
 
  (second := backEnd availableRegisterOrNoneFor: self liveRegisters) = NoReg ifTrue:
  [self ssAllocateRequiredReg:
  (second := optStatus isReceiverResultRegLive
  ifTrue: [Arg0Reg]
  ifFalse: [ReceiverResultReg])].
 
  (first := backEnd availableRegisterOrNoneFor: (self liveRegisters bitOr: (self registerMaskFor: second))) = NoReg ifTrue:
  [self ssAllocateRequiredReg: (first := Arg1Reg)].
  (second = ReceiverResultReg or: [first = ReceiverResultReg]) ifTrue:
  [ optStatus isReceiverResultRegLive: false ].
  self ssNativeTop nativePopToReg: second.
  self ssNativePop: 1.
  self ssNativeTop nativePopToReg: first.
  self ssNativePop: 1.
 
  self CmpR: second R: first.
+ falseJump := self JumpZero: 0.
- falseJump := self JumpNonZero: 0.
  "True result"
  self MoveCq: 1 R: first.
  contJump := self Jump: 0.
  "False result"
+ falseJump jmpTarget: self Label.
+ self MoveCq: 0 R: first.
- falseJump jmpTarget: self self MoveCq: 0 R: first.
  contJump jmpTarget: self Label.
  self ssPushNativeRegister: first.
 
  ].
  ^ 0
 
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodeLocalFrameSize (in category 'inline primitive generators generated code') -----
  genLowcodeLocalFrameSize
  <option: #LowcodeVM> "Lowcode instruction generator"
+ | size alignedSize |
- | size |
  size := extA.
 
  self assert: needsFrame.
  hasNativeFrame := true.
+ "Align the size to 16 bytes."
+ alignedSize := size + 15 bitAnd: -16.
  "Mark the stack frame"
  self annotate: (self MoveCw: (objectMemory splObj: LowcodeContextMark) R: TempReg) objRef: (objectMemory splObj: LowcodeContextMark).
  self MoveR: TempReg Mw: self frameOffsetOfNativeFrameMark r: FPReg.
  "Fetch the stack"
  self MoveAw: coInterpreter nativeStackPointerAddress R: TempReg.
  self AddCq: 1 R: TempReg.
  self MoveR: TempReg Mw: self frameOffsetOfPreviousNativeStackPointer r: FPReg.
  "Store the frame pointer"
+ self SubCq: alignedSize R: TempReg.
- self SubCq: size R: TempReg.
  self MoveR: TempReg Mw: self frameOffsetOfNativeFramePointer r: FPReg.
  "Store the new stack pointer"
  self MoveR: TempReg Mw: self frameOffsetOfNativeStackPointer r: FPReg.
  "Allocate space for the locals"
  self SubCq: 1 + coInterpreter defaultNativeStackFrameSize R: TempReg.
  self MoveR: TempReg Aw: coInterpreter nativeStackPointerAddress.
 
  extA := 0.
  ^ 0
 
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodeSmallInt32ToOop (in category 'inline primitive generators generated code') -----
  genLowcodeSmallInt32ToOop
  <option: #LowcodeVM> "Lowcode instruction generator"
  | value |
 
  (value := backEnd availableRegisterOrNoneFor: self liveRegisters) = NoReg ifTrue:
  [self ssAllocateRequiredReg:
  (value := optStatus isReceiverResultRegLive
  ifTrue: [Arg0Reg]
  ifFalse: [ReceiverResultReg])].
  value = ReceiverResultReg ifTrue:
  [ optStatus isReceiverResultRegLive: false ].
  self ssNativeTop nativePopToReg: value.
  self ssNativePop: 1.
 
+ objectRepresentation genConvertIntegerToSmallIntegerInReg: value.
- self LogicalShiftLeftCq: 1 R: value.
- self OrCq: 1 R: value.
  self ssPushRegister: value.
 
  ^ 0
 
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>setInterpreter: (in category 'initialization') -----
  setInterpreter: aCoInterpreter
  "Initialization of the code generator in the simulator.
  These objects already exist in the generated C VM
  or are used only in the simulation."
  <doNotGenerate>
  super setInterpreter: aCoInterpreter.
 
  methodAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  picAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  picMissTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
 
  simStack := CArrayAccessor on: ((1 to: self class simStackSlots) collect: [:i| self simStackEntryClass new cogit: self]).
+ simNativeStack := CArrayAccessor on: ((1 to: self class simNativeStackSlots) collect: [:i| self simStackNativeEntryClass new cogit: self]).
- simNativeStack := CArrayAccessor on: ((1 to: self class simStackSlots) collect: [:i| self simStackNativeEntryClass new cogit: self]).
  simSelf := self simStackEntryClass new cogit: self.
  optStatus := CogSSOptStatus new.
 
  debugFixupBreaks := self class initializationOptions at: #debugFixupBreaks ifAbsent: [Set new].
 
  numPushNilsFunction := self class numPushNilsFunction.
  pushNilSizeFunction := self class pushNilSizeFunction!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>simNativeStackSlots (in category 'simulation stack') -----
+ simNativeStackSlots
+ "Answer the number of slots toinclude in a simulated stack.
+ This needs to be big enough to include all slots in a context
+ plus some overflow for safety."
+ <inline: true>
+ ^((LargeContextSlots - CtxtTempFrameStart max: 64) * 11 // 10)!