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

commits at source.squeak.org commits at source.squeak.org
Sun Nov 21 17:32:46 UTC 2021


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

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

Name: VMMaker.oscog-eem.3105
Author: eem
Time: 21 November 2021, 9:32:38.061647 am
UUID: bec73bb3-9a4f-4803-a56e-dcb349eb677b
Ancestors: VMMaker.oscog-eem.3104

Cog simulation:
No longer hack integral types to nil in the surrogate code generation methods.
Have VMStructType class>>#fieldAccessorSourceFor:bytesPerWord: maintain BytesPerWord, making checking easier.

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

Item was removed:
- ----- Method: CogBlockMethod class>>surrogateClass (in category 'accessing') -----
- surrogateClass
- 	self shouldNotImplement!

Item was removed:
- ----- Method: CogMethod class>>surrogateClass (in category 'accessing') -----
- surrogateClass
- 	self shouldNotImplement!

Item was changed:
  ----- Method: CogStackPageSurrogate class>>getter:offsetExpression:bitPosition:bitWidth:type: (in category 'code generation') -----
+ getter: getter offsetExpression: offsetExpr bitPosition: bitPosition bitWidth: bitWidth type: type
- getter: getter offsetExpression: offsetExpr bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
  	self assert: offsetExpr isNil.
  	^String streamContents:
  		[:s| | startByte endByte accessor |
  		startByte := bitPosition // 8.
  		endByte := bitPosition + bitWidth - 1 // 8.
  		self assert: bitPosition \\ 8 = 0.
  		self assert: startByte \\ (bitWidth // 8) = 0.
  		accessor := #(byteAt: shortAt: long32At: long64At:) at: (endByte - startByte) highBit + 1.
+ 		s nextPutAll: getter; crtab: 1; nextPut: $^.
+ 		('*StackPage*' match: type) ifTrue:
+ 			[s nextPutAll: 'stackPages '; nextPutAll: #surrogateAtAddress:; space; nextPut: $(].
+ 		type == #int ifTrue:
+ 			[s nextPut: $(].
- 		s	nextPutAll: getter; crtab: 1; nextPut: $^.
- 		typeOrNil ifNotNil:
- 			[('*StackPage*' match: typeOrNil) ifTrue:
- 				[s nextPutAll: 'stackPages surrogateAtAddress: ('].
- 			 typeOrNil == #int ifTrue:
- 				[s nextPut: $(]].
  		s nextPutAll: #objectMemory; space;
  		   nextPutAll: accessor;
  		   nextPutAll: ' address'.
  		startByte > 0 ifTrue:
  			[s nextPutAll: ' + '; print: startByte].
+ 		('*StackPage*' match: type) ifTrue:
+ 			[s nextPut: $)].
+ 		type == #int ifTrue:
+ 			[s nextPut: $); space; nextPutAll: #signedIntFromLong]]
- 		typeOrNil ifNotNil:
- 			[('*StackPage*' match: typeOrNil) ifTrue:
- 				[s nextPut: $)].
- 			 typeOrNil == #int ifTrue:
- 				[s nextPutAll: ') '; nextPutAll: #signedIntFromLong]]]
  
  	"| bitPosition |
  	bitPosition := 0.
  	(CogStackPage fieldAccessorsForBytesPerWord: BytesPerWord) collect:
  		[:spec|
  		bitPosition := bitPosition + spec second.
  		self getter: spec first
  			offsetExpression: nil
  			bitPosition: bitPosition - spec second
  			bitWidth: spec second
+ 			type: (spec at: 3)]"!
- 			type: (spec at: 3 ifAbsent: [])]"!

Item was changed:
  ----- Method: CogStackPageSurrogate class>>setter:offsetExpression:bitPosition:bitWidth:type: (in category 'code generation') -----
+ setter: getter offsetExpression: offsetExpr bitPosition: bitPosition bitWidth: bitWidth type: type
- setter: getter offsetExpression: offsetExpr bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
  	self assert: offsetExpr isNil.
  	^String streamContents:
  		[:s| | startByte endByte accessor |
  		startByte := bitPosition // 8.
  		endByte := bitPosition + bitWidth - 1 // 8.
  		self assert: bitPosition \\ 8 = 0.
  		self assert: startByte \\ (bitWidth // 8) = 0.
  		accessor := #(byteAt: shortAt: long32At: long64At:) at: (endByte - startByte) highBit + 1.
  		s	nextPutAll: getter; nextPutAll: ': aValue'; crtab: 1;
  			nextPutAll: 'self assert: (address'.
  		startByte > 0 ifTrue:
  			[s nextPutAll: ' + '; print: startByte].
  		s nextPutAll: ' >= zoneBase and: [address + '; print: endByte;
  		   nextPutAll: ' < zoneLimit]).'; crtab: 1.
+ 		(type == #int or: ['*StackPage*' match: type]) ifFalse:
+ 			[s nextPut: $^].
- 		typeOrNil ifNotNil:
- 			[(typeOrNil == #int or: ['*StackPage*' match: typeOrNil]) ifFalse:
- 				[s nextPut: $^]].
  		s nextPutAll: #objectMemory; space;
  		   nextPutAll: accessor;
  		   nextPutAll: ' address'.
  		startByte > 0 ifTrue:
  			[s nextPutAll: ' + '; print: startByte].
  		s nextPutAll: ' put: aValue'.
+ 		('*StackPage*' match: type) ifTrue:
+ 			[s nextPutAll: ' asInteger.'; crtab; nextPutAll: '^aValue'].
+ 		type == #int ifTrue:
+ 			[s space; nextPutAll: #signedIntToLong; nextPut: $.; crtab; nextPutAll: '^aValue']]
- 		typeOrNil ifNotNil:
- 			[('*StackPage*' match: typeOrNil) ifTrue:
- 				[s nextPutAll: ' asInteger.'; crtab; nextPutAll: '^aValue'].
- 			 typeOrNil == #int ifTrue:
- 				[s space; nextPutAll: #signedIntToLong; nextPut: $.; crtab; nextPutAll: '^aValue']]]
  
  	"| bitPosition |
  	bitPosition := 0.
  	(CogStackPage fieldAccessorsForBytesPerWord: BytesPerWord) collect:
  		[:spec|
  		bitPosition := bitPosition + spec second.
  		self setter: spec first
  			offsetExpression: nil
  			 bitPosition: bitPosition - spec second
  			 bitWidth: spec second
+ 			 type: (spec at: 3)]"!
- 			 type: (spec at: 3 ifAbsent: [])]"!

Item was changed:
  ----- Method: CogSurrogate class>>getter:offsetExpression:bitPosition:bitWidth:type: (in category 'code generation') -----
+ getter: getter offsetExpression: offsetExpression bitPosition: bitPosition bitWidth: bitWidth type: type
- getter: getter offsetExpression: offsetExpression bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
  	^String streamContents:
  		[:s| | startByte endByte alignedPowerOf2 shift |
  		startByte := bitPosition // 8.
  		endByte := bitPosition + bitWidth - 1 // 8.
  		shift := bitPosition \\ 8.
+ 		alignedPowerOf2 := shift = 0 and: [#(8 16 32 64) includes: bitWidth].
- 		alignedPowerOf2 := (#(8 16 32 64) includes: bitWidth) and: [shift = 0].
  		s nextPutAll: getter; crtab.
  		bitWidth < (BytesPerWord * 8) ifTrue:
  			[s nextPut: $<; print: (Message selector: #bitPosition:width: arguments: {bitPosition. bitWidth}); nextPut: $>; crtab].
+ 		type last = $* ifTrue:
- 		(typeOrNil notNil and: [typeOrNil last = $*]) ifTrue:
  			[s nextPutAll: '| v |'; crtab: 1].
  		s nextPut: $^.
+ 		type == #Boolean ifTrue: [s nextPut: $(].
+ 		type last = $* ifTrue:
+ 			[s nextPutAll: '(v := '].
- 		typeOrNil ifNotNil:
- 			[s nextPut: $(.
- 			 typeOrNil last = $* ifTrue:
- 				[s nextPutAll: 'v := ']].
  		alignedPowerOf2 ifFalse:
  			[s nextPut: $(].
  		shift ~= 0 ifTrue:
  			[s nextPut: $(].
  		s nextPutAll: #objectMemory; space;
  		   nextPutAll: (#(byteAt: shortAt: long32At: long64At:) at: (endByte - startByte) highBit + 1);
  		  nextPutAll: ' address'.
  		startByte > 0 ifTrue:
  			[s nextPutAll: ' + '; print: startByte].
  		offsetExpression ifNotNil:
  			[s nextPutAll: ' + '; nextPutAll: offsetExpression].
  		shift ~= 0 ifTrue:
  			[s nextPutAll: ') bitShift: -'; print: shift].
  		alignedPowerOf2 ifFalse:
  			[s nextPutAll: ') bitAnd: '; nextPutAll: ((1 << bitWidth) - 1) hex].
+ 		(type == #Boolean or: [type last = $*]) ifTrue:
- 		typeOrNil ifNotNil:
  			[s nextPutAll: ') ~= 0'.
+ 			 type last = $* ifTrue:
- 			typeOrNil last = $* ifTrue:
  				[s nextPutAll: ' ifTrue:';
  					crtab: 2;
  					nextPutAll: '[cogit cCoerceSimple: v to: ';
+ 					store: type;
- 					store: typeOrNil;
  					nextPut: $]]]]!

Item was changed:
  ----- Method: CogSurrogate class>>putAtPut:type:mask:shift:on:indent: (in category 'code generation') -----
  putAtPut: accessor type: typeOrNil mask: maskOrNil shift: shift on: s indent: indent
+ 	"This is the inner part of the at:put: in a setter, abstracted to eliminate duplication
- 	"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."
+ 	| isIntegralType |
  	s nextPutAll: #objectMemory;
  	  crtab: indent; nextPutAll: accessor;
  	  crtab: indent; nextPutAll: 'put: '.
+ 	(isIntegralType := CCodeGenerator basicNew isIntegralCType: typeOrNil) ifFalse:
- 	typeOrNil ifNotNil:
  		[s nextPut: $(].
  	maskOrNil ifNotNil:
  		[s nextPutAll: '((objectMemory '; nextPutAll: accessor;
  		    nextPutAll: ') bitAnd: '; nextPutAll: maskOrNil hex;
  		    nextPutAll: ') + '].
+ 	s nextPutAll: (isIntegralType
+ 					ifTrue: [shift = 0 ifTrue: ['aValue'] ifFalse: ['(aValue bitShift: ', shift printString, ')']]
+ 					ifFalse:
+ 						[typeOrNil == #Boolean
+ 							ifTrue: ['(aValue ifTrue: [', (1 << shift) printString, '] ifFalse: [0]))']
+ 							ifFalse:
+ 								['(aValue ifNotNil: [aValue asUnsignedInteger', (shift = 0 ifTrue: [''] ifFalse: [' bitShift: ', shift printString]), '] ifNil: [0]))']])!
- 	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])']).
- 	typeOrNil ifNotNil:
- 		[s nextPut: $)]!

Item was changed:
  ----- Method: CogSurrogate class>>setter:offsetExpression:bitPosition:bitWidth:type: (in category 'code generation') -----
+ setter: getter offsetExpression: offsetExpression bitPosition: bitPosition bitWidth: bitWidth type: type
- setter: getter offsetExpression: offsetExpression bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
  	^String streamContents:
  		[:s| | startByte endByte shift alignedPowerOf2 accessor mask |
  		startByte := bitPosition // 8.
  		endByte := bitPosition + bitWidth - 1 // 8.
  		shift := bitPosition \\ 8.
+ 		alignedPowerOf2 := shift = 0 and: [#(8 16 32 64) includes: bitWidth].
- 		alignedPowerOf2 := (#(8 16 32 64) includes: bitWidth) and: [shift = 0].
  		accessor := (#(byteAt: shortAt: long32At: long64At:) at: (endByte - startByte) highBit + 1),
  					' index'.
  		mask := (2 raisedTo: endByte - startByte + 1 * 8) - 1.
+ 		s nextPutAll: getter; nextPutAll: ': aValue'; crtab.
+ 		s crtab; nextPutAll: '| index delta |'; crtab.
- 		s nextPutAll: getter; nextPutAll: ': aValue'; crtab: 1.
- 		s crtab: 1; nextPutAll: '| index delta |'; crtab: 1.
  		s nextPutAll: 'index := address'.
  		startByte > 0 ifTrue:
  			[s nextPutAll: ' + '; print: startByte].
  		offsetExpression ifNotNil:
  			[s nextPutAll: ' + '; nextPutAll: offsetExpression].
+ 		s nextPut: $.; crtab.
+ 		alignedPowerOf2 ifFalse:
+ 			[s nextPutAll: 'self assert: (aValue between: 0 and: '; nextPutAll:  ((1 << bitWidth) - 1) hex; nextPutAll: ').'; crtab].
- 		s nextPut: $.; crtab: 1.
- 		(typeOrNil notNil or: [alignedPowerOf2]) ifFalse:
- 			[s nextPutAll: 'self assert: (aValue between: 0 and: '; nextPutAll:  ((1 << bitWidth) - 1) hex; nextPutAll: ').'; crtab: 1].
  		s nextPutAll: '(delta := cogit getCodeToDataDelta) > 0 ifTrue:'; crtab: 2.
  		s nextPutAll: '[self assert: (cogit addressIsInCodeZone: address - delta).'; crtab: 2; space.
  		self putAtPut: accessor, ' - delta'
+ 			type: type
- 			type: typeOrNil
  			mask: (alignedPowerOf2 ifFalse: [mask - ((1 << bitWidth - 1) << shift)])
  			shift: shift
  			on: s
  			indent: 3.
+ 		s nextPutAll: '].'; crtab.
- 		s nextPutAll: '].'; crtab: 1.
  		alignedPowerOf2 ifTrue:
  			[s nextPut: $^].
  		self putAtPut: accessor
+ 			type: type
- 			type: typeOrNil
  			mask: (alignedPowerOf2 ifFalse: [mask - ((1 << bitWidth - 1) << shift)])
  			shift: shift
  			on: s
  			indent: 2.
  		alignedPowerOf2 ifFalse:
+ 			[s nextPut: $.; crtab; nextPutAll: '^aValue']]!
- 			[s nextPut: $.; crtab: 1; nextPutAll: '^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 fieldAccessorSourceFor: CogBlockMethodSurrogate32 bytesPerWord: 4.
+ 	 CogMethod fieldAccessorSourceFor: CogMethodSurrogate32 bytesPerWord: 4.
+ 	 CogBlockMethod fieldAccessorSourceFor: CogBlockMethodSurrogate64 bytesPerWord: 8.
+ 	 CogMethod fieldAccessorSourceFor: CogMethodSurrogate64 bytesPerWord: 8.
+ 	 CogStackPage fieldAccessorSourceFor: CogStackPageSurrogate64 bytesPerWord: 8.
+ 	 CogStackPage fieldAccessorSourceFor: CogStackPageSurrogate32 bytesPerWord: 4}"
+ 	| accessors |
+ 	accessors := self fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord.
- 	"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].
  	
  	"All methods which are the same in 32 and 64 bit versions should be compiled in the superclass iff the superclass is not of a specific word size."
  	(self dualForSurrogateClass: surrogateClass) ifNotNil:
  		[:dual| | duals |
  		 surrogateClass superclass name last isDigit ifFalse:
+ 			[duals := self fieldAccessorSourceFor: dual bytesPerWord: (bytesPerWord = 4 ifTrue: [8] ifFalse: [4]).
- 			[duals := [self fieldAccessorSourceFor: dual bytesPerWord: (BytesPerWord := bytesPerWord = 4 ifTrue: [8] ifFalse: [4])]
- 						ensure: [BytesPerWord := oldBytesPerWord].
  
  			 (accessors keys select: [:key| (accessors at: key) = (duals at: {key first isMeta ifTrue: [dual class] ifFalse: [dual]. key last} ifAbsent: ['missing'])]) do:
  				[:key| | source class selector |
  				class := key first.
  				selector := key last.
  				source := accessors removeKey: key.
  				(class includesSelector: selector) ifTrue:
  					[class removeSelector: selector].
  				(class superclass sourceCodeAt: selector ifAbsent: ['']) asString ~= source ifTrue:
  					[class superclass compile: source classified: 'accessing generated']]]].
  		
  	accessors keysAndValuesDo:
  		[:key :source| | class selector ancestor |
  		class := key first.
  		selector := key last.
  		((ancestor := class superclass whichClassIncludesSelector: selector) notNil
  		 and: [source = (ancestor sourceCodeAt: selector ifAbsent: ['']) asString])
  			ifTrue: [class removeSelector: selector]
  			ifFalse:
  				[source ~= (class sourceCodeAt: selector ifAbsent: ['']) asString ifTrue:
  					[class compile: source classified: 'accessing generated']]]!

Item was added:
+ ----- Method: VMStructType class>>computeFieldAccessorSourceFor:bytesPerWord: (in category 'code generation') -----
+ computeFieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord
+ 	"Answer a Dictionary of MethodReference to source for the accessors of the inst vars of the
+ 	 receiver and the alignedByteSize class method in surrogateClass with the given word size."
+ 
+ 	| methods bitPosition alignedByteSize currentOffset |
+ 	methods := Dictionary new.
+ 	bitPosition := 0.
+ 	(self fieldAccessorsForBytesPerWord: bytesPerWord) do:
+ 		[:spec|
+ 		"reset the bitPosition if the offset expression changes."
+ 		currentOffset ~= (self offsetForInstVar: spec first) ifTrue:
+ 			[bitPosition := 0.
+ 			 currentOffset := self offsetForInstVar: spec first].
+ 		spec first ~= #unused ifTrue:
+ 			[methods
+ 				at: {surrogateClass. spec first asSymbol}
+ 					put: (surrogateClass
+ 							getter: spec first
+ 							offsetExpression: (self offsetForInstVar: spec first)
+ 							bitPosition: bitPosition
+ 							bitWidth: spec second
+ 							type: (spec at: 3));
+ 				at: {surrogateClass. (spec first, ':') asSymbol}
+ 					put: (surrogateClass
+ 							setter: spec first
+ 							offsetExpression: (self offsetForInstVar: spec first)
+ 							bitPosition: bitPosition
+ 							bitWidth: spec second
+ 							type: (spec at: 3))].
+ 		bitPosition := bitPosition + spec second].
+ 	alignedByteSize := (self roundUpBitPosition: bitPosition toWordBoundary: bytesPerWord) / 8.
+ 	self assert: alignedByteSize isInteger.
+ 	methods
+ 		at: {surrogateClass class. #alignedByteSize}
+ 		put: #alignedByteSize
+ 			, (String with: Character cr with: Character tab with: $^)
+ 			, alignedByteSize printString,
+ 			(currentOffset ifNil: [''] ifNotNil: [' + self ', currentOffset]).
+ 	^methods!

Item was changed:
  ----- Method: VMStructType class>>fieldAccessorSourceFor:bytesPerWord: (in category 'code generation') -----
  fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord
  	"Answer a Dictionary of MethodReference to source for the accessors of the inst vars of the
  	 receiver and the alignedByteSize class method in surrogateClass with the given word size."
  
  	"{CogBlockMethod fieldAccessorSourceFor: CogBlockMethodSurrogate32 bytesPerWord: 4.
  	 CogMethod fieldAccessorSourceFor: CogMethodSurrogate32 bytesPerWord: 4.
  	 CogBlockMethod fieldAccessorSourceFor: CogBlockMethodSurrogate64 bytesPerWord: 8.
+ 	 CogMethod fieldAccessorSourceFor: CogMethodSurrogate64 bytesPerWord: 8.
+ 	 CogStackPage fieldAccessorSourceFor: CogStackPageSurrogate64 bytesPerWord: 8.
+ 	 CogStackPage fieldAccessorSourceFor: CogStackPageSurrogate32 bytesPerWord: 4}"
+ 	| oldBytesPerWord |
+ 	oldBytesPerWord := BytesPerWord.
+ 	^[self computeFieldAccessorSourceFor: surrogateClass bytesPerWord: (BytesPerWord := bytesPerWord)]
+ 		ensure: [BytesPerWord := oldBytesPerWord]!
- 	 CogMethod fieldAccessorSourceFor: CogMethodSurrogate64 bytesPerWord: 8}"
- 	| methods bitPosition alignedByteSize currentOffset |
- 	methods := Dictionary new.
- 	bitPosition := 0.
- 	(self fieldAccessorsForBytesPerWord: bytesPerWord) do:
- 		[:spec|
- 		"reset the bitPosition if the offset expression changes."
- 		currentOffset ~= (self offsetForInstVar: spec first) ifTrue:
- 			[bitPosition := 0.
- 			 currentOffset := self offsetForInstVar: spec first].
- 		spec first ~= #unused ifTrue:
- 			[methods
- 				at: {surrogateClass. spec first asSymbol}
- 					put: (surrogateClass
- 							getter: spec first
- 							offsetExpression: (self offsetForInstVar: spec first)
- 							bitPosition: bitPosition
- 							bitWidth: spec second
- 							type: (spec at: 3 ifAbsent: []));
- 				at: {surrogateClass. (spec first, ':') asSymbol}
- 					put: (surrogateClass
- 							setter: spec first
- 							offsetExpression: (self offsetForInstVar: spec first)
- 							bitPosition: bitPosition
- 							bitWidth: spec second
- 							type: (spec at: 3 ifAbsent: []))].
- 		bitPosition := bitPosition + spec second].
- 	alignedByteSize := (self roundUpBitPosition: bitPosition toWordBoundary: bytesPerWord) / 8.
- 	self assert: alignedByteSize isInteger.
- 	methods
- 		at: {surrogateClass class. #alignedByteSize}
- 		put: #alignedByteSize
- 			, (String with: Character cr with: Character tab with: $^)
- 			, alignedByteSize printString,
- 			(currentOffset ifNil: [''] ifNotNil: [' + self ', currentOffset]).
- 	^methods!

Item was changed:
  ----- Method: VMStructType class>>fieldAccessorsForBytesPerWord: (in category 'code generation') -----
  fieldAccessorsForBytesPerWord: bytesPerWord
  	| fieldSpecs |
  	fieldSpecs := OrderedCollection new.
  	self instVarNamesAndTypesForTranslationDo:
  		[:ivn :typeTuple| | index replacement |
  		(index := typeTuple indexOf: #BytesPerWord ifAbsent: 0) > 0
  			ifTrue:
  				[(typeTuple at: index + 1) = bytesPerWord ifTrue:
  					[replacement := typeTuple copyReplaceFrom: index to: index + 1 with: #().
  					 replacement size = 1 ifTrue:
  						[replacement := replacement first].
  					fieldSpecs add: { ivn. replacement }]]
  			ifFalse:
  				[fieldSpecs add: { ivn. typeTuple }]].
  	^fieldSpecs collect:
  		[:tuple|
  			[:ivn :typeTuple|
  			{ ('*unused*' match: ivn) ifTrue: [#unused] ifFalse: [ivn].
  			  (typeTuple isArray and: ['unsigned' = typeTuple first])
  				ifTrue:
  					[Integer readFrom: (typeTuple last readStream skipTo: $:; skipSeparators)]
  				ifFalse:
  					[typeTuple
  						caseOf: {
  								[#char]				->	[8].
  								[#'unsigned char']	->	[8].
  								[#short]			->	[16].
  								[#'unsigned short']	->	[16].
  								[#int]				->	[32].
  								[#'unsigned int']	->	[32] }
  						otherwise: [bytesPerWord * 8]].
  			typeTuple isArray
+ 				ifTrue: "bitfields..."
+ 					[(typeTuple size >= 3 and: [typeTuple second = #Boolean])
+ 						ifTrue: [#Boolean]
+ 						ifFalse: [#unsigned]]
+ 				ifFalse: "niormal types..."
- 				ifTrue:
- 					[(typeTuple size >= 3 and: [typeTuple second = #Boolean]) ifTrue:
- 						[#Boolean]]
- 				ifFalse:
  					[(typeTuple last = $*
  					 and: [typeTuple beginsWith: 'struct _']) "remove struct tag if any"
  						ifTrue: [(typeTuple allButFirst: 8) asSymbol]
  						ifFalse: [typeTuple]] }] valueWithArguments: tuple]
  
  	"#(4 8) collect: [:bpw| (CogBlockMethod fieldAccessorsForBytesPerWord: bpw) asArray]"
  	"#(4 8) collect: [:bpw| (CogMethod fieldAccessorsForBytesPerWord: bpw) asArray]"!



More information about the Vm-dev mailing list