VM Maker: VMMaker.oscog-eem.2682.mcz

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

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

Name: VMMaker.oscog-eem.2682
Author: eem
Time: 27 January 2020, 8:16:59.516873 pm
UUID: cae7eee0-8a2c-4881-b88f-d1827cb111c4
Ancestors: VMMaker.oscog-eem.2681

Cogit: Tweak surrogate setter generation to eliminate shifts when accessing single bits.

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

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cbUsesInstVars: (in category 'accessing') -----
  cbUsesInstVars: aValue
  | delta |
  (delta := cogit codeToDataDelta) > 0 ifTrue:
  [self assert: (cogit addressIsInCodeZone: address - delta).
  memory
  unsignedByteAt: address + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + (aValue ifTrue: [2] ifFalse: [0]))].
- put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1))].
  memory
  unsignedByteAt: address - delta + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 3) bitAnd: 16rFD) + (aValue ifTrue: [2] ifFalse: [0])).
- put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
  ^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmHasMovableLiteral: (in category 'accessing') -----
  cmHasMovableLiteral: aValue
  | delta |
  (delta := cogit codeToDataDelta) > 0 ifTrue:
  [self assert: (cogit addressIsInCodeZone: address - delta).
  memory
  unsignedByteAt: address + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFB) + (aValue ifTrue: [4] ifFalse: [0]))].
- put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFB) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 2))].
  memory
  unsignedByteAt: address - delta + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 3) bitAnd: 16rFB) + (aValue ifTrue: [4] ifFalse: [0])).
- put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 3) bitAnd: 16rFB) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 2)).
  ^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmRefersToYoung: (in category 'accessing') -----
  cmRefersToYoung: aValue
  | delta |
  (delta := cogit codeToDataDelta) > 0 ifTrue:
  [self assert: (cogit addressIsInCodeZone: address - delta).
  memory
  unsignedByteAt: address + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF7) + (aValue ifTrue: [8] ifFalse: [0]))].
- put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3))].
  memory
  unsignedByteAt: address - delta + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 2) bitAnd: 16rF7) + (aValue ifTrue: [8] ifFalse: [0])).
- put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 2) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)).
  ^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cpicHasMNUCaseOrCMIsFullBlock: (in category 'accessing') -----
  cpicHasMNUCaseOrCMIsFullBlock: aValue
  | delta |
  (delta := cogit codeToDataDelta) > 0 ifTrue:
  [self assert: (cogit addressIsInCodeZone: address - delta).
  memory
  unsignedByteAt: address + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rEF) + (aValue ifTrue: [16] ifFalse: [0]))].
- put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4))].
  memory
  unsignedByteAt: address - delta + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 2) bitAnd: 16rEF) + (aValue ifTrue: [16] ifFalse: [0])).
- put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 2) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)).
  ^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate64>>cbUsesInstVars: (in category 'accessing') -----
  cbUsesInstVars: aValue
  | delta |
  (delta := cogit codeToDataDelta) > 0 ifTrue:
  [self assert: (cogit addressIsInCodeZone: address - delta).
  memory
  unsignedByteAt: address + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + (aValue ifTrue: [2] ifFalse: [0]))].
- put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1))].
  memory
  unsignedByteAt: address - delta + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 3) bitAnd: 16rFD) + (aValue ifTrue: [2] ifFalse: [0])).
- put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
  ^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate64>>cmHasMovableLiteral: (in category 'accessing') -----
  cmHasMovableLiteral: aValue
  | delta |
  (delta := cogit codeToDataDelta) > 0 ifTrue:
  [self assert: (cogit addressIsInCodeZone: address - delta).
  memory
  unsignedByteAt: address + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFB) + (aValue ifTrue: [4] ifFalse: [0]))].
- put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFB) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 2))].
  memory
  unsignedByteAt: address - delta + baseHeaderSize + 3
+ put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 3) bitAnd: 16rFB) + (aValue ifTrue: [4] ifFalse: [0])).
- put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 3) bitAnd: 16rFB) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 2)).
  ^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate64>>cmRefersToYoung: (in category 'accessing') -----
  cmRefersToYoung: aValue
  | delta |
  (delta := cogit codeToDataDelta) > 0 ifTrue:
  [self assert: (cogit addressIsInCodeZone: address - delta).
  memory
  unsignedByteAt: address + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF7) + (aValue ifTrue: [8] ifFalse: [0]))].
- put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3))].
  memory
  unsignedByteAt: address - delta + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 2) bitAnd: 16rF7) + (aValue ifTrue: [8] ifFalse: [0])).
- put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 2) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)).
  ^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate64>>cpicHasMNUCaseOrCMIsFullBlock: (in category 'accessing') -----
  cpicHasMNUCaseOrCMIsFullBlock: aValue
  | delta |
  (delta := cogit codeToDataDelta) > 0 ifTrue:
  [self assert: (cogit addressIsInCodeZone: address - delta).
  memory
  unsignedByteAt: address + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rEF) + (aValue ifTrue: [16] ifFalse: [0]))].
- put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4))].
  memory
  unsignedByteAt: address - delta + baseHeaderSize + 2
+ put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 2) bitAnd: 16rEF) + (aValue ifTrue: [16] ifFalse: [0])).
- put: (((memory unsignedByteAt: address - delta + baseHeaderSize + 2) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)).
  ^aValue!

Item was changed:
  ----- Method: VMStructType class>>checkGenerateSurrogate:bytesPerWord: (in category 'code generation') -----
  checkGenerateSurrogate: surrogateClass bytesPerWord: bytesPerWord
  "Check the accessor methods for the fields of the receiver and if necessary install new
  or updated versions in the surrogate class alpng with the alignedByteSize class method."
 
+ "self withAllSubclasses do:
+ [:cogMethodClass| (cogMethodClass class includesSelector: #initialize) ifTrue: [cogMethodClass initialize]]"
+
  "CogBlockMethod checkGenerateSurrogate: CogBlockMethodSurrogate32 bytesPerWord: 4.
  CogMethod checkGenerateSurrogate: CogMethodSurrogate32 bytesPerWord: 4.
  CogBlockMethod checkGenerateSurrogate: CogBlockMethodSurrogate64 bytesPerWord: 8.
  CogMethod checkGenerateSurrogate: CogMethodSurrogate64 bytesPerWord: 8"
  | accessors oldBytesPerWord |
  oldBytesPerWord := BytesPerWord.
  accessors := [self fieldAccessorSourceFor: surrogateClass bytesPerWord: (BytesPerWord := bytesPerWord)]
  ensure: [BytesPerWord := oldBytesPerWord].
  accessors keysAndValuesDo:
  [:mr :source|
  source ~= mr sourceStringOrNil ifTrue:
  [mr actualClass compile: source classified: #accessing]]
 
  "Dictionary withAll: ((self fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord) associationsSelect:
  [:a| a value ~= a key sourceString])"!

Item was changed:
  ----- Method: VMStructType class>>putAtPut:type:mask:shift:at:on:indent: (in category 'code generation') -----
  putAtPut: accessor type: typeOrNil mask: maskOrNil shift: shift at: startByte on: s indent: indent
  "This is the inner part of the ap:put: in a setter, abstracted to eliminate duplication
  given the overrides in CogBlockMethod et al for dual zone write simulation."
- | expr |
  s nextPutAll: 'memory';
   crtab: indent; nextPutAll: accessor; print: startByte + 1.
  s crtab: indent; nextPutAll: 'put: '.
  typeOrNil ifNotNil:
  [s nextPut: $(].
  maskOrNil ifNotNil:
  [s nextPutAll: '((memory '; nextPutAll: accessor; print: startByte + 1;
     nextPutAll: ') bitAnd: '; nextPutAll: maskOrNil hex;
     nextPutAll: ') + '].
+ s nextPutAll: (typeOrNil
+ caseOf: {
+ [nil] -> [shift = 0 ifTrue: ['aValue'] ifFalse: ['(aValue bitShift: ', shift printString, ')']].
+ [#Boolean] -> ['(aValue ifTrue: [', (1 << shift) printString, '] ifFalse: [0])'] }
+ otherwise: ['(aValue ifNotNil: [aValue asUnsignedInteger', (shift = 0 ifTrue: [''] ifFalse: [' bitShift: ', shift printString]), '] ifNil: [0])']).
- expr := typeOrNil caseOf: {
- [nil] -> ['aValue'].
- [#Boolean] -> ['(aValue ifTrue: [1] ifFalse: [0])'] }
- otherwise: ['(aValue ifNotNil: [aValue asUnsignedInteger] ifNil: [0])'].
- shift = 0
- ifTrue: [s nextPutAll: expr]
- ifFalse: [s nextPut: $(; nextPutAll: expr; nextPutAll: ' bitShift: '; print: shift; nextPut: $)].
  typeOrNil ifNotNil:
  [s nextPut: $)]!