﻿'From Squeak6.0 of 18 July 2022 [latest update: #22106] on 24 July 2022 at 6:31:05 pm'!

!ThreadedARM64FFIPlugin methodsFor: 'callout support' stamp: 'KenD 7/24/2022 16:32'!
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: 'union { struct { float floats[8]; } f; struct dprr { double doubles[4]; } d; }'>
	<var: #someFloat type: #'float'>
	<var: #someDouble type: #'double'>
	<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 = FFITypeDoubleFloat ifTrue: [
		self storeFloatAtPointer: (self addressOf: #someDouble)
			       from: (self 
					dispatchFunctionPointer: (self 
						cCoerceSimple: procAddr 
						to: 'double (*)(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.		
		^interpreterProxy floatObjectOf: #someDouble
	].
	
	atomicType = FFITypeSingleFloat ifTrue: [
			self storeSingleFloatAtPointer: (self addressOf: #someFloat)
			       from: (self 
					dispatchFunctionPointer: (self 
						cCoerceSimple: procAddr 
						to: 'float (*)(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.		
		^interpreterProxy floatObjectOf: #someFloat
	].
	
	((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.

		"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:
		["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."
		 (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
			[^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
		 ^self ffiReturnStruct: (((self returnStructInRegisters: calloutState)
								ifTrue: [self cCoerceSimple: (self addressOf: structRet) to: #'char *']
								ifFalse: [calloutState limit]))
				ofType: (self ffiReturnType: specOnStack)
				in: calloutState].
	
	^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState! !
