VM Maker: Cog-eem.422.mcz

 
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.422.mcz

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

Name: Cog-eem.422
Author: eem
Time: 29 October 2020, 6:07:26.875213 pm
UUID: 85b1cd7f-c753-4a65-9100-9f2408ba0f5c
Ancestors: Cog-eem.421

Compare-and-swap support for BochsX64Alien

=============== Diff against Cog-eem.421 ===============

Item was added:
+ ----- Method: BochsIA32Alien>>abiMarshallArg0: (in category 'accessing-abstract') -----
+ abiMarshallArg0: arg0
+ "Marshall one integral argument according to the ABI.
+ Currently used in the COGMTVM to tryLockVMOwner:"
+ self push: arg0!

Item was changed:
  ----- Method: BochsX64Alien class>>initialize (in category 'class initialization') -----
  initialize
  "BochsX64Alien initialize"
  | it |
  it := self basicNew.
  OpcodeExceptionMap := Array new: 256 withAll: #handleExecutionPrimitiveFailureAt:in:rex:.
  OpcodeExceptionMap
  at: 1 + it twoByteEscape put: #handleTwoByteEscapeFailureAt:in:rex:;
  at: 1 + it operandSizeOverridePrefix put: #handleOperandSizeOverridePrefixFailureAt:in:rex:;
  at: 1 + it callOpcode put: #handleCallFailureAt:in:rex:;
  at: 1 + it jmpOpcode put: #handleJmpFailureAt:in:rex:;
  at: 1 + it retOpcode put: #handleRetFailureAt:in:rex:;
  at: 1 + it movALObOpcode put: #handleMovALObFailureAt:in:rex:;
  at: 1 + it movAXOvOpcode put: #handleMovAXOvFailureAt:in:rex:;
  at: 1 + it movObALOpcode put: #handleMovObALFailureAt:in:rex:;
  at: 1 + it movOvAXOpcode put: #handleMovOvAXFailureAt:in:rex:;
  at: 1 + it movGvEvOpcode put: #handleMovGvEvFailureAt:in:rex:;
  at: 1 + it movEvGvOpcode put: #handleMovEvGvFailureAt:in:rex:;
  at: 1 + it movGbEbOpcode put: #handleMovGbEbFailureAt:in:rex:;
  at: 1 + it movEbGbOpcode put: #handleMovEbGbFailureAt:in:rex:;
+ at: 1 + 16rF0 put: #handleGroup6through10FailureAt:in:rex:; "Table A6 One-Byte and Two-Byte Opcode ModRM Extensions"
  at: 1 + 16rFE put: #handleGroup4FailureAt:in:rex:; "Table A6 One-Byte and Two-Byte Opcode ModRM Extensions"
  at: 1 + 16rFF put: #handleGroup5FailureAt:in:rex:. "Table A6 One-Byte and Two-Byte Opcode ModRM Extensions"
  ExtendedOpcodeExceptionMap := Array new: 256 withAll: #handleExecutionPrimitiveFailureAt:in:rex:.
  ExtendedOpcodeExceptionMap
  at: 1 + it movGvEbOpcode put: #handleMovGvEbFailureAt:in:rex:!

Item was added:
+ ----- Method: BochsX64Alien>>abiMarshallArg0: (in category 'accessing-abstract') -----
+ abiMarshallArg0: arg0
+ "Marshall one integral argument according to the ABI.
+ Currently used in the COGMTVM to tryLockVMOwner:"
+ (CogX64Compiler classPool at: #CArg0Reg) = 1
+ ifTrue: [self rcx: arg0] "Hack; Win64"
+ ifFalse: [self rdi: arg0] "Hack; SysV"!

Item was changed:
  ----- Method: BochsX64Alien>>decorateDisassembly:for:fromAddress: (in category 'disassembly') -----
  decorateDisassembly: anInstructionString for: aSymbolManager "<Cogit>" fromAddress: address
  | string i1 i2 v o extra |
  string := PrintCodeBytes
  ifTrue: [anInstructionString]
  ifFalse: [anInstructionString copyFrom: 1 to: (anInstructionString lastIndexOf: $:) - 1]. "trailing space useful for parsing numbers"
  aSymbolManager relativeBaseForDisassemblyInto:
  [:baseAddress :baseName|
  string := baseName, '+', (address - baseAddress printStringBase: 16 length: 4 padded: true), (string copyFrom: (string indexOf: $:) + 1 to: string size)].
  ((i1 := string indexOfSubCollection: '%ds:(') > 0
  or: [(i1 := string indexOfSubCollection: '%ss:(') > 0]) ifTrue:
+ [string := string copyReplaceFrom: i1
+ to: i1 + 3
+ with: ((string copyFrom: i1 to: i1 + 9) = '%ds:(%rbx)'
+ ifTrue: ['%ds:0x0']"So the next clause finds it..."
+ ifFalse: [''])].
- [string := string copyReplaceFrom: i1 to: i1 + 3 with: ''].
  (i1 := string indexOfSubCollection: '%ds:0x') > 0 ifTrue:
  [i2 := i1 + 6.
  ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1].
  (v := string copyFrom: i2 to: (i2 + 5 min: string size)) = '(%rbx)' ifTrue:
+ [| i3 |
+ o := Integer readFrom: (ReadStream on: string from: i1 + 6 to: i2 - 1) base: 16.
- [o := Integer readFrom: (ReadStream on: string from: i1 + 6 to: i2 - 1) base: 16.
  (aSymbolManager lookupAddress: aSymbolManager varBaseAddress + o) ifNotNil:
+ [:varName| extra := ' = ', varName].
+ (i3 := string indexOfSubCollection: '%ds:0x0(%rbx)' startingAt: i1) > 0 ifTrue:
+ [string := string copyReplaceFrom: i3 to: i3 + 6 with: ''.
+ i2 := 0]].
- [:varName| extra := ' = ', varName]].
  v = '(%rip)' ifTrue:
  [o := anInstructionString size - (anInstructionString lastIndexOf: $:) - 1 / 3. "Count number of instruction bytes to find size of instruction"
  o := o + address. "Add address of instruction"
  o := o + (Integer readFrom: (ReadStream on: string from: i1 + 6 to: i2 - 1) base: 16) signedIntFromLong64. "Add offset to yield pc-relative address"
  (aSymbolManager lookupAddress: o) ifNotNil:
  [:methodName| extra := ' = ', methodName]].
  v = ReceiverResultRegDereference ifTrue:
  [o := Integer readFrom: (ReadStream on: string from: i1 + 6 to: i2 - 1) base: 16.
  (aSymbolManager lookupInstVarOffset: o) ifNotNil:
  [:varName| string := string copyReplaceFrom: i1 to: i2 - 1 with: varName,'@',o printString. i2 := 0]].
  i2 ~= 0 ifTrue:
  [string := string
  copyReplaceFrom: i1
  to: i2 - 1
  with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 4 to: i2 - 1))]].
  (i1 := string indexOfSubCollection: '%ss:0x') > 0 ifTrue:
  [i2 := i1 + 6.
  ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1].
  ((string at: i2) = $(
   and: [(string at: i2 + 1) = $%]) ifTrue:
  [o := Integer readFrom: (ReadStream on: string from: i1 + 6 to: i2 - 1) base: 16.
  o := (o bitAnd: (1 bitShift: 31) - 1) - (o bitAnd: (1 bitShift: 31)).
  ((string copyFrom: i2 to: (i2 + 5 min: string size)) = '(%rbp)' and: [PrintTempNames]) ifTrue:
  [(aSymbolManager lookupFrameOffset: o) ifNotNil:
  [:varName| string := string copyReplaceFrom: i1 to: i2 - 1 with: varName,'@',o printString. i2 := 0]].
  i2 ~= 0 ifTrue: [string := string copyReplaceFrom: i1 to: i2 - 1 with: o printString]]].
  (i1 := string indexOfSubCollection: '$0x') > 0 ifTrue:
  [i2 := i1 + 3.
  ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1].
  string := string
  copyReplaceFrom: i1 + 1
  to: i2 - 1
  with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 1 to: i2 - 1))].
  ((i1 := string indexOf: $() > 1
  and: [(string at: i1 + 1) isDigit
  and: [i1 < (i2 := string indexOf: $))]]) ifTrue:
  [string := string
  copyReplaceFrom: i1 + 1
  to: i2 - 1
  with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 1 to: i2 - 1)).
  i1 := string indexOfSubCollection: '+0x'. "calls & jumps"
  i1 > 0 ifTrue:
  [o := Integer readFrom: (i2 := ReadStream on: string from: i1 + 3 to: string size) base: 16.
  o := ((o bitAnd: (1 bitShift: 63) - 1) - (o bitAnd: (1 bitShift: 63))) printStringRadix: 16.
  o := o first = $1
  ifTrue: [o copyReplaceFrom: 1 to: 3 with: '+0x']
  ifFalse: [o copyReplaceFrom: 2 to: 4 with: '0x'].
  string := string copyReplaceFrom: i1 to: i2 position with: o]].
  ^extra
  ifNil: [string]
  ifNotNil:
  [PrintCodeBytes
  ifTrue: [i1 := string lastIndexOf: $:.
  string copyReplaceFrom: i1 - 1 to: i1 - 2 with: extra]
  ifFalse: [string, ';', extra]]!

Item was added:
+ ----- Method: BochsX64Alien>>handleGroup6through10FailureAt:in:rex: (in category 'error handling') -----
+ handleGroup6through10FailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
+ "Convert an execution primitive failure for a group 5 instruction into the relevant ProcessorSimulationTrap signal."
+ | rexByte modrmByte baseReg srcReg |
+ (((rexByte := memoryArray byteAt: pc + 2) bitAnd: 16rF8) = self rexPrefix
+ and: [(memoryArray byteAt: pc + 3) = 16r0F
+ and: [(memoryArray byteAt: pc + 4) = 16rB1]]) ifTrue:
+ [modrmByte := memoryArray byteAt: pc + 5.
+ modrmByte >> 6 = 0 ifTrue: "ModRegInd"
+ [srcReg := (modrmByte >> 3 bitAnd: 7) + ((rexByte bitAnd: 4) bitShift: 1).
+ baseReg := (modrmByte bitAnd: 7) + ((rexByte bitAnd: 1) bitShift: 3).
+ ^(CompareAndSwapSimulationTrap
+ pc: pc
+ nextpc: pc + 5
+ address: (self perform: (self registerStateGetters at: baseReg + 1))
+ type: #write
+ accessor: (self registerStateSetters at: srcReg + 1))
+ expectedValue: self rax;
+ storedValue: (self perform: (self registerStateGetters at: srcReg + 1));
+ signal]]!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovEvGvFailureAt:in:rex: (in category 'error handling') -----
  handleMovEvGvFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  "Convert an execution primitive failure for a register write into a ProcessorSimulationTrap signal."
  | modrmByte getter base offset |
  self assert: rexByteOrNil notNil.
  modrmByte := memoryArray byteAt: pc + 3.
+ getter := self registerStateGetters at: (modrmByte >> 3 bitAnd: 7) + ((rexByteOrNil bitAnd: 4) << 1) + 1.
- getter := self registerStateGetters at: ((modrmByte >> 3 bitAnd: 7) + ((rexByteOrNil bitAnd: 4) << 1) + 1).
  (modrmByte bitAnd: 16rC7) = 16r5 ifTrue: "ModRegInd & disp32"
  [^(ProcessorSimulationTrap
  pc: pc
  nextpc: pc + 7
  address: (memoryArray unsignedLongAt: pc + 4 bigEndian: false)
  type: #write
  accessor: getter)
  signal].
+ (modrmByte bitAnd: 16rC0) = 0 ifTrue: "ModRegInd"
+ [base := self registerStateGetters at: (modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) << 3) + 1.
+ ^(ProcessorSimulationTrap
+ pc: pc
+ nextpc: pc + 3
+ address: (self perform: base)
+ type: #write
+ accessor: getter)
+ signal].
  (modrmByte bitAnd: 16rC0) = 16r80 ifTrue: "ModRegRegDisp32"
  [offset := memoryArray longAt: pc + 4 bigEndian: false.
+ base := self registerStateGetters at: (modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) << 3) + 1.
- base := self registerStateGetters at: ((modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) << 3) + 1).
  ^(ProcessorSimulationTrap
  pc: pc
  nextpc: pc + 7
  address: (self perform: base) + offset
  type: #write
  accessor: getter)
  signal].
  (modrmByte bitAnd: 16rC0) = 16r40 ifTrue: "ModRegRegDisp8"
  [offset := memoryArray unsignedByteAt: pc + 4.
  offset > 127 ifTrue: [offset := offset - 256].
+ base := self registerStateGetters at: (modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) << 3) + 1.
- base := self registerStateGetters at: ((modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) << 3) + 1).
  ^(ProcessorSimulationTrap
  pc: pc
  nextpc: pc + 4
  address: (self perform: base) + offset
  type: #write
  accessor: getter)
  signal].
  ^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsX64Alien>>printFields:inRegisterState:on: (in category 'printing') -----
  printFields: fields inRegisterState: registerStateVector on: aStream
  | rsvs |
  aStream ensureCr.
  rsvs := registerStateVector readStream.
  fields withIndexDo:
  [:sym :index| | val |
  sym = #cr
  ifTrue: [aStream cr]
  ifFalse:
  [(val := rsvs next) isNil ifTrue: [^self].
  (sym beginsWith: 'xmm')
  ifTrue:
  [aStream nextPutAll: sym; nextPut: $:; space.
  val printOn: aStream base: 16 length: 16 padded: true.
  aStream space; nextPut: $(.
  "At the image level Float is apparently in big-endian format"
  ((Float basicNew: 2)
  at: 2 put: (val bitAnd: 16rFFFFFFFF);
  at: 1 put: (val bitShift: -32);
  yourself)
  printOn: aStream.
  aStream nextPut: $)]
  ifFalse:
  [aStream nextPutAll: sym; nextPut: $:; space.
  val printOn: aStream base: 16 length: 8 padded: true.
+ #rflags == sym
- #eflags == sym
  ifTrue:
  [aStream space.
  'C-P-A-ZS---O' withIndexDo:
  [:flag :bitIndex|
  flag ~= $- ifTrue:
  [aStream nextPut: flag; nextPutAll: 'F='; print: (val bitAnd: 1 << (bitIndex - 1)) >> (bitIndex - 1); space]]]
  ifFalse:
  [val > 16 ifTrue:
  [aStream space; nextPut: $(.
  val printOn: aStream base: 10 length: 1 padded: false.
  aStream nextPut: $)]]].
  (fields at: index + 1) ~~ #cr ifTrue:
  [aStream tab]]]!

Item was changed:
  ----- Method: BochsX64Alien>>rflags (in category 'accessing') -----
  rflags
+ ^self unsignedLongAt: 621!
- ^self unsignedLongLongAt: 621!

Item was changed:
  ----- Method: BochsX64Alien>>rflags: (in category 'accessing') -----
  rflags: anUnsignedInteger
+ ^self unsignedLongAt: 621 put: anUnsignedInteger!
- ^self unsignedLongLongAt: 621 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>setFlagsForCompareAndSwap: (in category 'execution') -----
+ setFlagsForCompareAndSwap: aBoolean
+ "Set ZF to aBoolean"
+ | flags |
+ flags := self rflags bitClear: 64.
+ self rflags: (aBoolean ifTrue: [flags + 64] ifFalse: [flags])!

Item was added:
+ ----- Method: BochsX64Alien64>>prevRip (in category 'accessing') -----
+ prevRip
+ ^self unsignedLongLongAt: 673!

Item was added:
+ ----- Method: BochsX64Alien64>>prevRip: (in category 'accessing') -----
+ prevRip: anUnsignedInteger
+ ^self unsignedLongLongAt: 673 put: anUnsignedInteger!

Item was changed:
  ----- Method: BochsX64Alien64>>rflags (in category 'accessing') -----
  rflags
+ ^self unsignedLongAt: 633!
- ^self unsignedLongLongAt: 633!

Item was added:
+ ----- Method: BochsX64Alien64>>rflags: (in category 'accessing') -----
+ rflags: anUnsignedInteger
+ ^self unsignedLongAt: 633 put: anUnsignedInteger!

Item was added:
+ ----- Method: CogProcessorAlien>>setFlagsForCompareAndSwap: (in category 'execution') -----
+ setFlagsForCompareAndSwap: aBoolean
+ "If the processor sets flags in a compare-and-swap instruction, set its flags
+ according to aBoolean which is true if the compare-and-swap succeeded."
+ self subclassResponsibility!