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

commits at source.squeak.org commits at source.squeak.org
Tue Aug 2 20:56:32 UTC 2022 

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

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

Name: VMMaker.oscog-eem.3243
Author: eem
Time: 2 August 2022, 1:56:18.665698 pm
UUID: 76d0de99-00c5-4bd8-9a86-cf507c911b03
Ancestors: VMMaker.oscog-eem.3242

ThreadedARM64FFIPlugin:
Ugh; cuz of inlining ffiCalloutTo:SpecOnStack:in: twice into primitiveCallout[WithArgs] due to COGMTVM, the anonymous union used to process float and double vector returns causes the C compiler to barf.  So introduce a proper type for this (ThreadedFFI64Bit32ByteReturnDF) and extend Slang to identify anonymous struct and union types as structs, and allow printing of anonymous struct types in printTypedefOn: (by passing nil as the inst var name).

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

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin class>>ancilliaryClasses (in category 'translation') -----
  ancilliaryClasses
  	^super ancilliaryClasses,
+ 	  { ThreadedFFI64Bit16ByteReturnII. ThreadedFFI64Bit32ByteReturnDF }!
- 	  { ThreadedFFI64Bit16ByteReturnII }!

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin class>>isStructType: (in category 'translation') -----
  isStructType: typeName
+ 	^#(SixteenByteReturnDD ThirtyTwoByteReturnDF) includes: typeName!
- 	| space |
- 	^(space := typeName indexOf: Character space) > 0
- 	 and: [#(union struct) includes: (typeName copyFrom: 1 to: space - 1)]!

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
  ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
  	<var: #procAddr type: #'void *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'>
  	"Go out, call this guy and create the return value.  This *must* be inlined because of
  	 the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:"
  	| myThreadIndex atomicType floatRet intRet structRet specSize |
+ 	<var: #floatRet type: #ThirtyTwoByteReturnDF>
- 	<var: #floatRet type: 'union { struct { float floats[8]; } f; struct dprr { double doubles[4]; } d; }'>
  	<var: #structRet type: #SixteenByteReturnII>
  	<var: #intRet type: #usqLong>
  	<inline: #always>
  	self cCode: [] inSmalltalk: [floatRet := ByteArray new: 32]. "Just a hack to placate the Smalltalk compiler; these should be proper struct types..."
  	myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
  	
  	calloutState floatRegisterIndex > 0 ifTrue:
  		[self loadFloatRegs:
  			   (calloutState floatRegisters at: 0)
  			_: (calloutState floatRegisters at: 1)
  			_: (calloutState floatRegisters at: 2)
  			_: (calloutState floatRegisters at: 3)
  			_: (calloutState floatRegisters at: 4)
  			_: (calloutState floatRegisters at: 5)
  			_: (calloutState floatRegisters at: 6)
  			_: (calloutState floatRegisters at: 7)].
  
  	(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
  		[self setsp: calloutState argVector].
  
  	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
  	((atomicType >> 1) = (FFITypeSingleFloat >> 1)
  	or: [(calloutState ffiRetHeader bitAnd: FFIFlagPointer+FFIFlagStructure) = FFIFlagStructure
  		and: [self structIsHomogenousFloatArrayOfSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask)
  				typeSpec: (self cCoerce: (interpreterProxy firstIndexableField: calloutState ffiRetSpec) to: #'unsigned int *')
  				ofLength: (specSize := interpreterProxy byteSizeOf: calloutState ffiRetSpec) / (self sizeof: #'unsigned int')]]) ifTrue:
  		[floatRet d: (self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'struct dprr (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5)
  					with: (calloutState integerRegisters at: 6)
  					with: (calloutState integerRegisters at: 7)).
  
  		 "undo any callee argument pops because it may confuse stack management with the alloca."
  		 (self isCalleePopsConvention: calloutState callFlags) ifTrue:
  			[self setsp: calloutState argVector].
  		 interpreterProxy ownVM: myThreadIndex.
  
  		 atomicType = FFITypeDoubleFloat ifTrue:
  			[^interpreterProxy floatObjectOf: (floatRet d doubles at: 0)].
  		 atomicType = FFITypeSingleFloat ifTrue:
  			[^interpreterProxy floatObjectOf: (floatRet f floats at: 0)].
  		"If the struct is a vector of floats then move float[2] to float[1], float[4] to float[2] and float[6] to float[3],
  		 to pack the float data in the double fields.  We can tell if the struct is composed of floats if its size is less
  		 than the spec size, since the spec size is (1 + n fields) * 4 bytes, and the struct size is n fields * 4 bytes
  		 for floats and n fields * 8 bytes for doubles.  We can't access the spec post call because it may have moved."
  		specSize > calloutState structReturnSize ifTrue:
  			[floatRet f floats at: 1 put: (floatRet f floats at: 2).
  			 floatRet f floats at: 2 put: (floatRet f floats at: 4).
  			 floatRet f floats at: 3 put: (floatRet f floats at: 6)].
  		^self ffiReturnStruct: (self addressOf: floatRet) ofType: (self ffiReturnType: specOnStack) in: calloutState].
  
  	"Integer and Structure returns..."
  	"If struct address used for return value, call is special; struct return pointer must be in x8"
  	(self mustReturnStructOnStack: calloutState structReturnSize) 
  		ifTrue:
  			[intRet := 0.
  			self setReturnRegister: (self cCoerceSimple: calloutState limit to: #sqLong) "stack alloca'd struct"
  				 andCall: (self cCoerceSimple: procAddr to: #sqLong)
  				 withArgsArray: (self cCoerceSimple: (self addressOf: calloutState integerRegisters) to: #sqLong)]
  		ifFalse:
  			[structRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnII (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5)
  					with: (calloutState integerRegisters at: 6)
  					with: (calloutState integerRegisters at: 7).
  			intRet := structRet a]. "X1"
  
  	"undo any callee argument pops because it may confuse stack management with the alloca."
  	(self isCalleePopsConvention: calloutState callFlags) ifTrue:
  		[self setsp: calloutState argVector].
  	interpreterProxy ownVM: myThreadIndex.
  
  	(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue:
  		[| returnType |
  		 "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
  		 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct."
  		 returnType := self ffiReturnType: specOnStack.
  		 (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
  			[^self ffiReturnPointer: intRet ofType: returnType in: calloutState].
  		 ^self ffiReturnStruct: (((self returnStructInRegisters: calloutState)
  								ifTrue: [self cCoerceSimple: (self addressOf: structRet) to: #'char *']
  								ifFalse: [calloutState limit]))
  				ofType: returnType
  				in: calloutState].
  	
  	^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!

Item was added:
+ ThreadedFFIAbstractStructReturnStruct subclass: #ThreadedFFI64Bit32ByteReturnDF
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins-FFI'!
+ 
+ !ThreadedFFI64Bit32ByteReturnDF commentStamp: 'eem 8/2/2022 13:55' prior: 0!
+ A ThreadedFFI64Bit32ByteReturnDF is is a stub for returning an array of floats or an array of doubles in registers on ARM64 & RISCV64. It defines an anonymous union (see ThreadedFFI64Bit32ByteReturnDF typedef).
+ 
+ Instance Variables
+ !

Item was added:
+ ----- Method: ThreadedFFI64Bit32ByteReturnDF class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ 	"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a BlockStart struct."
+ 
+ 	aBinaryBlock value: nil value: 'union {\		struct { float floats[8]; } f;\		struct dprr { double doubles[4]; } d;\	}' withCRs
+ 
+ 	"self typedef"!

Item was changed:
  VMStructType subclass: #ThreadedFFIAbstractStructReturnStruct
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Plugins-FFI'!
+ 
+ !ThreadedFFIAbstractStructReturnStruct commentStamp: 'eem 8/2/2022 13:54' prior: 0!
+ ThreadedFFIAbstractStructReturnStruct is the abstract superclass of various structs used to collect struct and/or array types in registers.
+ 
+ Instance Variables
+ !

Item was changed:
  ----- Method: ThreadedFFIAbstractStructReturnStruct class>>structTypeName (in category 'translation') -----
  structTypeName
+ 	"Map e.g. ThreadedFFI64Bit16ByteReturnDD to  'SixteenByteReturnDD'"
+ 	| index |
+ 	index := name indexOfSubCollection: 'ByteReturn' startingAt: 12 ifAbsent: [^name].
+ 	^(((name copyFrom: index - 2 to: index - 1) asInteger asWords subStrings: '-') collect: #capitalized) join, (name copyFrom: index to: name size)
+ 	
+ 	"self withAllSubclasses collect: [:sc| sc structTypeName]"!
- 	^'SixteenByteReturn', (self name last: 2)!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>isFloatAtomicType: (in category 'primitive support') -----
  isFloatAtomicType: atomicTypeCode
+ 	<inline: true> "this is used in asserts; so not #always"
- 	<inline: #always>
  	"(atomicTypeCode >> 1) = (FFITypeSingleFloat >> 1)"
  	^atomicTypeCode >> 1 = 6 !

Item was changed:
  ----- Method: VMStructType class>>isTypeStruct: (in category 'translation') -----
  isTypeStruct: type
  	self ensureStructTypeCache.
  	^type notNil
+ 	  and: [(StructTypeNameCache anySatisfy:
- 	  and: [StructTypeNameCache anySatisfy:
  			[:structType|
+ 			type = structType])
+ 		or: [(type beginsWith: 'struct ')
+ 		or: [type beginsWith: 'union ']]]!
- 			type = structType]]!

Item was changed:
  ----- Method: VMStructType class>>printTypedefOn: (in category 'translation') -----
  printTypedefOn: aStream
  	aStream nextPutAll: 'typedef struct '.
  	self needsTypeTag ifTrue:
  		[aStream nextPutAll: self structTagName; space].
  	aStream nextPut: ${; cr.
  	self instVarNamesAndTypesForTranslationDo:
  		[:ivn :typeArg| | type |
+ 		(ivn notNil and: [ivn first == $#])
- 		ivn first == $#
  			ifTrue: [aStream nextPutAll: ivn]
  			ifFalse:
  				[type := typeArg.
  				 #(BytesPerWord BaseHeaderSize BytesPerOop) do:
  					[:sizeConstant| | index sizeConstantSize |
  					(type notNil
  					and: [(index := type indexOf: sizeConstant ifAbsent: 0) > 0]) ifTrue:
  						[sizeConstantSize  := VMBasicConstants classPool at: sizeConstant.
  						type := (type at: index + 1) = sizeConstantSize ifTrue:
  									[type := type copyReplaceFrom: index to: index + 1 with: #().
  									 type size = 1 ifTrue: [type first] ifFalse: [type]]]].
  				 type ifNotNil:
  					[type isArray
  						ifTrue:
  							[aStream tab: 1.
  							 aStream nextPutAll: type first.
  							 (type first last isSeparator or: [type first last = $*]) ifFalse:
  								[aStream tab: 2].
  							 aStream nextPutAll: ivn.
  							 type last first isAlphaNumeric ifTrue:
  								[aStream space].
  							 aStream nextPutAll: type last]
  						ifFalse:
  							[aStream tab: 1.
  							 aStream nextPutAll: type.
  							 type last isAlphaNumeric ifTrue:
  								[aStream tab: 1].
+ 							 ivn ifNotNil: [aStream nextPutAll: ivn]]].
- 							 aStream nextPutAll: ivn]].
  				 aStream nextPut: $;].
  		 aStream cr].
  	aStream
  		nextPutAll: ' } ';
  		nextPutAll: self structTypeName;
  		nextPut: $;;
  		cr.
  	self name ~= self structTypeName ifTrue:
  		[(self withAllSuperclasses copyUpThrough: (self class whichClassIncludesSelector: #structTypeName) theNonMetaClass) do:
  			[:structClass|
  			 aStream cr; nextPutAll: '#define '; nextPutAll: structClass name; space; nextPutAll: self structTypeName].
  		 aStream cr].
  	aStream flush!

More information about the Vm-dev mailing list