VM Maker: Cog-eem.432.mcz

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

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

Name: Cog-eem.432
Author: eem
Time: 7 January 2021, 2:01:12.601696 pm
UUID: 4e880215-47ef-4bce-9d52-afa37179c2ec
Ancestors: Cog-eem.431

MTVM:
Extend CompareAndSwapSimulationTrap with the failedComparisonRegisterAccessor to to CMPXCHG correctly on x86/x86_64.

Print the direction flag on x86/x86_64.

Apply the clone: => cloneObject: refactoring.

=============== Diff against Cog-eem.431 ===============

Item was changed:
  ----- Method: BochsIA32Alien>>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.
  #eflags == sym
  ifTrue:
  [aStream space.
+ 'C-P-A-ZS--DO' withIndexDo:
- '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>>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))
+ failedComparisonRegisterAccessor: #rax:;
  expectedValue: self rax;
  storedValue: (self perform: (self registerStateGetters at: srcReg + 1));
  signal]]!

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
  ifTrue:
  [aStream space.
+ 'C-P-A-ZS--DO' withIndexDo:
- '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>>printRegisterStateExceptPC:on: (in category 'printing') -----
  printRegisterStateExceptPC: registerStateVector on: aStream
  self printFields:
  ((registerStateVector size < 34
   or: [(19 to: 34) allSatisfy: [:i| (registerStateVector at: i) isZero]])
  ifTrue:
  [#( rax rbx rcx rdx cr
  rsp rbp rsi rdi cr
  r8 r9 r10 r11 cr
+ r12 r13 r14 r15 cr
+ rflags cr)]
- r12 r13 r14 r15 cr)]
  ifFalse:
  [#( rax rbx rcx rdx cr
  rsp rbp rsi rdi cr
  r8 r9 r10 r11 cr
  r12 r13 r14 r15 cr
+ rflags cr
  xmm0low xmm1low cr
  xmm2low xmm3low cr
  xmm4low xmm5low cr
  xmm6low xmm7low cr )])
  inRegisterState: registerStateVector
  on: aStream!

Item was changed:
  ProcessorSimulationTrap subclass: #CompareAndSwapSimulationTrap
+ instanceVariableNames: 'expectedValue storedValue failedComparisonRegisterAccessor'
- instanceVariableNames: 'expectedValue storedValue'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Cog-Processors'!

Item was added:
+ ----- Method: CompareAndSwapSimulationTrap>>failedComparisonRegisterAccessor (in category 'accessing') -----
+ failedComparisonRegisterAccessor
+ "Some compare-and-swaps (ARM) always set a given register with the value compared against.
+ Others (x86/x86-64) set a different register if the comparison fails. On these processors
+ failedComparisonRegisterAccessor can be supplied to specify that register."
+ ^failedComparisonRegisterAccessor ifNil: [registerAccessor]!

Item was added:
+ ----- Method: CompareAndSwapSimulationTrap>>failedComparisonRegisterAccessor: (in category 'accessing') -----
+ failedComparisonRegisterAccessor: aRegisterSetter
+ "Some compare-and-swaps (ARM) always set a given register with the value compared against.
+ Others (x86/x86-64) set a different register if the comparison fails. On these processors
+ failedComparisonRegisterAccessor can be supplied to specify that register."
+ failedComparisonRegisterAccessor := aRegisterSetter!

Item was added:
+ ----- Method: CompareAndSwapSimulationTrap>>printAnyExtrasOn: (in category 'printing') -----
+ printAnyExtrasOn: aStream
+ failedComparisonRegisterAccessor ifNotNil:
+ [aStream nextPutAll: ' failAccessor: '; print: failedComparisonRegisterAccessor].
+ aStream
+ nextPutAll: ' expectedValue: '; print: expectedValue;
+ nextPutAll: ' storedValue: '; print: storedValue; cr!

Item was added:
+ ----- Method: ProcessorSimulationTrap>>printAnyExtrasOn: (in category 'printing') -----
+ printAnyExtrasOn: aStream!

Item was changed:
  ----- Method: ProcessorSimulationTrap>>printOn: (in category 'printing') -----
  printOn: aStream
  super printOn: aStream.
  aStream nextPutAll: ' (pc: '; print: pc; nextPut: $/. pc printOn: aStream base: 16.
  aStream nextPutAll: ' nextpc: '; print: nextpc; nextPut: $/. nextpc printOn: aStream base: 16.
  aStream nextPutAll: ' address: '; print: address; nextPut: $/. address printOn: aStream base: 16.
  aStream nextPutAll: ' type: '; print: type.
+ aStream nextPutAll: ' accessor: '; print: registerAccessor.
+ self printAnyExtrasOn: aStream.
+ aStream nextPut: $)!
- aStream nextPutAll: ' accessor: '; print: registerAccessor; nextPut: $)!

Item was removed:
- ----- Method: Spur32BitPreen>>clone: (in category 'bootstrap image') -----
- clone: oldObj
- | newObj hash |
- newObj := newHeap
- allocateSlots: (oldHeap numSlotsOf: oldObj)
- format: (oldHeap formatOf: oldObj)
- classIndex: (oldHeap classIndexOf: oldObj).
- (hash := oldHeap rawHashBitsOf: oldObj) ~= 0 ifTrue:
- [newHeap setHashBitsOf: newObj to: hash].
- (oldHeap isImmutable: oldObj) ifTrue:
- [newHeap setIsImmutableOf: newObj to: true].
- (oldHeap isPinned: oldObj) ifTrue:
- [newHeap setIsPinnedOf: newObj to: true].
- self deny: (oldHeap isRemembered: oldObj).
- self deny: (oldHeap isMarked: oldObj).
- self deny: (oldHeap isGrey: oldObj).
- reverseMap at: newObj put: oldObj.
- ^map at: oldObj put: newObj!

Item was added:
+ ----- Method: Spur32BitPreen>>cloneObject: (in category 'bootstrap image') -----
+ cloneObject: oldObj
+ | newObj hash |
+ newObj := newHeap
+ allocateSlots: (oldHeap numSlotsOf: oldObj)
+ format: (oldHeap formatOf: oldObj)
+ classIndex: (oldHeap classIndexOf: oldObj).
+ (hash := oldHeap rawHashBitsOf: oldObj) ~= 0 ifTrue:
+ [newHeap setHashBitsOf: newObj to: hash].
+ (oldHeap isImmutable: oldObj) ifTrue:
+ [newHeap setIsImmutableOf: newObj to: true].
+ (oldHeap isPinned: oldObj) ifTrue:
+ [newHeap setIsPinnedOf: newObj to: true].
+ self deny: (oldHeap isRemembered: oldObj).
+ self deny: (oldHeap isMarked: oldObj).
+ self deny: (oldHeap isGrey: oldObj).
+ reverseMap at: newObj put: oldObj.
+ ^map at: oldObj put: newObj!

Item was changed:
  ----- Method: Spur32BitPreen>>cloneObjects (in category 'bootstrap image') -----
  cloneObjects
  "Clone all normal objects.  Of hidden objects only clone the freeLists object and
  the classTableRoot and class table pages. In particular, dont clone objStacks.
  The refs to the objStacks are nilled out in fillInHeap."
  | i freeListsObject |
  i := 0.
  freeListsObject := oldHeap freeListsObject.
  oldHeap allOldSpaceObjectsDo:
  [:obj32|
  (i := i + 1) >= 100000 ifTrue:
  [Transcript nextPut: $:; flush. i := 0].
  obj32 = freeListsObject
  ifTrue:
  [self cloneFreeLists: obj32]
  ifFalse:
+ [(self shouldcloneObject: obj32) ifTrue:
+ [self cloneObject: obj32]]]!
- [(self shouldClone: obj32) ifTrue:
- [self clone: obj32]]]!

Item was removed:
- ----- Method: Spur32to64BitImageConverter>>clone: (in category 'bootstrap image') -----
- clone: sourceObj
- | targetObj format numSlots numBytes hash |
- format := sourceHeap formatOf: sourceObj.
- numSlots := sourceHeap numSlotsOf: sourceObj.
- format > sourceHeap lastPointerFormat ifTrue:
- [format < sourceHeap firstByteFormat
- ifTrue:
- [format = sourceHeap firstLongFormat
- ifTrue:
- [numSlots := sourceHeap numSlotsOf: sourceObj.
- numSlots odd ifTrue:
- [format := format + 1].
- numSlots := numSlots + 1 // 2]
- ifFalse: [self error: 'bad format']]
- ifFalse:
- [numBytes := sourceHeap numBytesOf: sourceObj.
- format < sourceHeap firstCompiledMethodFormat
- ifTrue:
- [format := targetHeap byteFormatForNumBytes: numBytes.
- numSlots := numSlots + 1 // 2]
- ifFalse:
- [numSlots := sourceHeap numPointerSlotsOf: sourceObj.
- numBytes := numBytes - (numSlots * sourceHeap bytesPerOop).
- format := (targetHeap byteFormatForNumBytes: numBytes) + sourceHeap firstCompiledMethodFormat - sourceHeap firstByteFormat.
- numSlots := numSlots + (targetHeap numSlotsForBytes: numBytes)]]].
- targetObj := targetHeap
- allocateSlots: numSlots
- format: format
- classIndex: (sourceHeap classIndexOf: sourceObj).
- (hash := sourceHeap rawHashBitsOf: sourceObj) ~= 0 ifTrue:
- [targetHeap setHashBitsOf: targetObj to: hash].
- (sourceHeap isImmutable: sourceObj) ifTrue:
- [targetHeap setIsImmutableOf: targetObj to: true].
- (sourceHeap isPinned: sourceObj) ifTrue:
- [targetHeap setIsPinnedOf: targetObj to: true].
- self deny: (sourceHeap isRemembered: sourceObj).
- self deny: (sourceHeap isMarked: sourceObj).
- self deny: (sourceHeap isGrey: sourceObj).
- reverseMap at: targetObj put: sourceObj.
- ^map at: sourceObj put: targetObj!

Item was added:
+ ----- Method: Spur32to64BitImageConverter>>cloneObject: (in category 'bootstrap image') -----
+ cloneObject: sourceObj
+ | targetObj format numSlots numBytes hash |
+ format := sourceHeap formatOf: sourceObj.
+ numSlots := sourceHeap numSlotsOf: sourceObj.
+ format > sourceHeap lastPointerFormat ifTrue:
+ [format < sourceHeap firstByteFormat
+ ifTrue:
+ [format = sourceHeap firstLongFormat
+ ifTrue:
+ [numSlots := sourceHeap numSlotsOf: sourceObj.
+ numSlots odd ifTrue:
+ [format := format + 1].
+ numSlots := numSlots + 1 // 2]
+ ifFalse: [self error: 'bad format']]
+ ifFalse:
+ [numBytes := sourceHeap numBytesOf: sourceObj.
+ format < sourceHeap firstCompiledMethodFormat
+ ifTrue:
+ [format := targetHeap byteFormatForNumBytes: numBytes.
+ numSlots := numSlots + 1 // 2]
+ ifFalse:
+ [numSlots := sourceHeap numPointerSlotsOf: sourceObj.
+ numBytes := numBytes - (numSlots * sourceHeap bytesPerOop).
+ format := (targetHeap byteFormatForNumBytes: numBytes) + sourceHeap firstCompiledMethodFormat - sourceHeap firstByteFormat.
+ numSlots := numSlots + (targetHeap numSlotsForBytes: numBytes)]]].
+ targetObj := targetHeap
+ allocateSlots: numSlots
+ format: format
+ classIndex: (sourceHeap classIndexOf: sourceObj).
+ (hash := sourceHeap rawHashBitsOf: sourceObj) ~= 0 ifTrue:
+ [targetHeap setHashBitsOf: targetObj to: hash].
+ (sourceHeap isImmutable: sourceObj) ifTrue:
+ [targetHeap setIsImmutableOf: targetObj to: true].
+ (sourceHeap isPinned: sourceObj) ifTrue:
+ [targetHeap setIsPinnedOf: targetObj to: true].
+ self deny: (sourceHeap isRemembered: sourceObj).
+ self deny: (sourceHeap isMarked: sourceObj).
+ self deny: (sourceHeap isGrey: sourceObj).
+ reverseMap at: targetObj put: sourceObj.
+ ^map at: sourceObj put: targetObj!

Item was removed:
- ----- Method: Spur64to32BitImageConverter>>clone: (in category 'bootstrap image') -----
- clone: sourceObj
- | targetObj format numSlots numBytes hash |
- format := sourceHeap formatOf: sourceObj.
- numSlots := sourceHeap numSlotsOf: sourceObj.
- format > sourceHeap lastPointerFormat ifTrue:
- [format < sourceHeap firstByteFormat
- ifTrue:
- [format = sourceHeap sixtyFourBitIndexableFormat
- ifTrue:
- [numSlots := (sourceHeap numSlotsOf: sourceObj) * 2]
- ifFalse:
- [(format between: sourceHeap firstLongFormat and: sourceHeap firstLongFormat + 1)
- ifTrue:
- [numSlots := (sourceHeap numSlotsOf: sourceObj) * 2 - (format bitAnd: 1).
- format := format bitClear: 1]
- ifFalse: [self error: 'bad format']]]
- ifFalse:
- [numBytes := sourceHeap numBytesOf: sourceObj.
- format < sourceHeap firstCompiledMethodFormat
- ifTrue:
- [numCompiledCode := numCompiledCode + 1.
- numSlots := numBytes + 3 // 4.
- format := targetHeap byteFormatForNumBytes: numBytes]
- ifFalse:
- [numSlots := sourceHeap numPointerSlotsOf: sourceObj.
- numBytes := numBytes - (numSlots * sourceHeap bytesPerOop).
- format := (targetHeap byteFormatForNumBytes: numBytes) + sourceHeap firstCompiledMethodFormat - sourceHeap firstByteFormat.
- numSlots := numSlots + (targetHeap numSlotsForBytes: numBytes)]]].
- targetObj := targetHeap
- allocateSlots: numSlots
- format: format
- classIndex: (sourceHeap classIndexOf: sourceObj).
- (hash := sourceHeap rawHashBitsOf: sourceObj) ~= 0 ifTrue:
- [targetHeap setHashBitsOf: targetObj to: hash].
- (sourceHeap isImmutable: sourceObj) ifTrue:
- [numReadOnly := numReadOnly + 1.
- targetHeap setIsImmutableOf: targetObj to: true].
- (sourceHeap isPinned: sourceObj) ifTrue:
- [targetHeap setIsPinnedOf: targetObj to: true].
- self deny: (sourceHeap isRemembered: sourceObj).
- self deny: (sourceHeap isMarked: sourceObj).
- self deny: (sourceHeap isGrey: sourceObj).
- reverseMap at: targetObj put: sourceObj.
- ^map at: sourceObj put: targetObj!

Item was added:
+ ----- Method: Spur64to32BitImageConverter>>cloneObject: (in category 'bootstrap image') -----
+ cloneObject: sourceObj
+ | targetObj format numSlots numBytes hash |
+ format := sourceHeap formatOf: sourceObj.
+ numSlots := sourceHeap numSlotsOf: sourceObj.
+ format > sourceHeap lastPointerFormat ifTrue:
+ [format < sourceHeap firstByteFormat
+ ifTrue:
+ [format = sourceHeap sixtyFourBitIndexableFormat
+ ifTrue:
+ [numSlots := (sourceHeap numSlotsOf: sourceObj) * 2]
+ ifFalse:
+ [(format between: sourceHeap firstLongFormat and: sourceHeap firstLongFormat + 1)
+ ifTrue:
+ [numSlots := (sourceHeap numSlotsOf: sourceObj) * 2 - (format bitAnd: 1).
+ format := format bitClear: 1]
+ ifFalse: [self error: 'bad format']]]
+ ifFalse:
+ [numBytes := sourceHeap numBytesOf: sourceObj.
+ format < sourceHeap firstCompiledMethodFormat
+ ifTrue:
+ [numCompiledCode := numCompiledCode + 1.
+ numSlots := numBytes + 3 // 4.
+ format := targetHeap byteFormatForNumBytes: numBytes]
+ ifFalse:
+ [numSlots := sourceHeap numPointerSlotsOf: sourceObj.
+ numBytes := numBytes - (numSlots * sourceHeap bytesPerOop).
+ format := (targetHeap byteFormatForNumBytes: numBytes) + sourceHeap firstCompiledMethodFormat - sourceHeap firstByteFormat.
+ numSlots := numSlots + (targetHeap numSlotsForBytes: numBytes)]]].
+ targetObj := targetHeap
+ allocateSlots: numSlots
+ format: format
+ classIndex: (sourceHeap classIndexOf: sourceObj).
+ (hash := sourceHeap rawHashBitsOf: sourceObj) ~= 0 ifTrue:
+ [targetHeap setHashBitsOf: targetObj to: hash].
+ (sourceHeap isImmutable: sourceObj) ifTrue:
+ [numReadOnly := numReadOnly + 1.
+ targetHeap setIsImmutableOf: targetObj to: true].
+ (sourceHeap isPinned: sourceObj) ifTrue:
+ [targetHeap setIsPinnedOf: targetObj to: true].
+ self deny: (sourceHeap isRemembered: sourceObj).
+ self deny: (sourceHeap isMarked: sourceObj).
+ self deny: (sourceHeap isGrey: sourceObj).
+ reverseMap at: targetObj put: sourceObj.
+ ^map at: sourceObj put: targetObj!

Item was removed:
- ----- Method: SpurMtoNBitImageConverter>>clone: (in category 'bootstrap image') -----
- clone: sourceObj
- self subclassResponsibility!

Item was added:
+ ----- Method: SpurMtoNBitImageConverter>>cloneObject: (in category 'bootstrap image') -----
+ cloneObject: sourceObj
+ self subclassResponsibility!

Item was changed:
  ----- Method: SpurMtoNBitImageConverter>>cloneObjects (in category 'bootstrap image') -----
  cloneObjects
  "Clone all normal objects.  Of hidden objects only clone the freeLists object and
  the classTableRoot and class table pages. In particular, dont clone objStacks.
  The refs to the objStacks are nilled out in fillInHeap."
  | i freeListsObject |
  i := 0.
  freeListsObject := sourceHeap freeListsObject.
  sourceHeap allOldSpaceObjectsDo:
  [:sourceObj|
  (i := i + 1) >= 100000 ifTrue:
  [Transcript nextPut: $:; flush. i := 0].
  sourceObj = freeListsObject
  ifTrue:
  [self cloneFreeLists: sourceObj]
  ifFalse:
+ [(self shouldcloneObject: sourceObj) ifTrue:
+ [self cloneObject: sourceObj]]]!
- [(self shouldClone: sourceObj) ifTrue:
- [self clone: sourceObj]]]!