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

[commits at source.squeak.org]

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: $)]!