'From Squeak5.3alpha of 14 December 2018 [latest update: #18322] on 23 December 2018 at 12:24:04 am'! ThreadedFFIPlugin subclass: #ThreadedARMFFIPlugin instanceVariableNames: '' classVariableNames: 'NumFloatRegArgs NumIntRegArgs WordSize' poolDictionaries: '' category: 'VMMaker-Plugins-FFI'! !ThreadedARMFFIPlugin commentStamp: '' prior: 0! This subclass is for the 32-bit ARM ABI. It typically has 4 integer registers.! !ThreadedARMFFIPlugin methodsFor: 'callout support' stamp: 'eem 8/23/2018 13:42'! ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState "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 | myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState). calloutState floatRegisterIndex > 0 ifTrue: [self load: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 0)) to: 'double *') at: 0) Flo: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 2)) to: 'double *') at: 0) a: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 4)) to: 'double *') at: 0) t: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 6)) to: 'double *') at: 0) R: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 8)) to: 'double *') at: 0) e: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 10)) to: 'double *') at: 0) g: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 12)) to: 'double *') at: 0) s: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 14)) to: 'double *') at: 0)]. (self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector]. atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [atomicType = FFITypeSingleFloat ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(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)] ifFalse: "atomicType = FFITypeDoubleFloat" [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(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)]. "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: floatRet]. intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_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). "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: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState! ! !ThreadedARMFFIPlugin methodsFor: 'callout support' stamp: 'eem 9/19/2018 17:31'! ffiReturnStruct: longLongRet ofType: ffiRetType in: calloutState "Create a structure return value from an external function call. The value has been stored in alloca'ed space pointed to by the calloutState or in the return value." | retOop retClass oop | retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType. retOop := interpreterProxy instantiateClass: retClass indexableSize: 0. self remapOop: retOop in: [oop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: calloutState structReturnSize]. self memcpy: (interpreterProxy firstIndexableField: oop) _: ((self returnStructInRegisters: calloutState structReturnSize) ifTrue: [self addressOf: longLongRet] ifFalse: [calloutState limit]) _: calloutState structReturnSize. interpreterProxy storePointer: 0 ofObject: retOop withValue: oop. ^retOop! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'eem 11/3/2018 13:21'! ffiPushDoubleFloat: value in: calloutState calloutState floatRegisterIndex < (NumFloatRegArgs - 1) ifTrue: [(calloutState floatRegisterIndex bitAnd: 1) = 1 ifTrue: [calloutState backfillFloatRegisterIndex: calloutState floatRegisterIndex. calloutState floatRegisterIndex: (calloutState floatRegisterIndex + 1)]. (self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) to: 'double*') at: 0 put: value. calloutState floatRegisterIndex: calloutState floatRegisterIndex + 2] ifFalse: [calloutState currentArg + 8 > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. calloutState floatRegisterIndex: NumFloatRegArgs. interpreterProxy storeFloatAtPointer: calloutState currentArg from: value. calloutState currentArg: calloutState currentArg + 8]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 14:57'! ffiPushPointer: pointer in: calloutState calloutState integerRegisterIndex < NumIntRegArgs ifTrue: [calloutState integerRegisters at: calloutState integerRegisterIndex put: pointer asInteger. calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy longAt: calloutState currentArg put: pointer. calloutState currentArg: calloutState currentArg + WordSize]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 14:59'! ffiPushSignedByte: value in: calloutState calloutState integerRegisterIndex < NumIntRegArgs ifTrue: [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char'). calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). calloutState currentArg: calloutState currentArg + WordSize]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:00'! ffiPushSignedChar: value in: calloutState calloutState integerRegisterIndex < NumIntRegArgs ifTrue: [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char'). calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char'). calloutState currentArg: calloutState currentArg + WordSize]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:01'! ffiPushSignedInt: value in: calloutState calloutState integerRegisterIndex < NumIntRegArgs ifTrue: [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy longAt: calloutState currentArg put: value. calloutState currentArg: calloutState currentArg + WordSize]. ^0 ! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:01'! ffiPushSignedLongLong: value in: calloutState calloutState integerRegisterIndex < (NumIntRegArgs - 1) ifTrue: [calloutState integerRegisterIndex: (calloutState integerRegisterIndex + 1 bitClear: 1). calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt). calloutState integerRegisters at: calloutState integerRegisterIndex + 1 put: (self cCoerceSimple: value >> 32 to: #usqInt). calloutState integerRegisterIndex: calloutState integerRegisterIndex + 2] ifFalse: [calloutState currentArg + 8 > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. calloutState integerRegisterIndex: NumIntRegArgs. interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); longAt: calloutState currentArg + WordSize put: (self cCoerceSimple: value >> 32 to: #usqInt). calloutState currentArg: calloutState currentArg + 8]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:01'! ffiPushSignedShort: value in: calloutState calloutState integerRegisterIndex < NumIntRegArgs ifTrue: [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed short'). calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short'). calloutState currentArg: calloutState currentArg + WordSize]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:02'! ffiPushSingleFloat: value in: calloutState calloutState floatRegisterIndex < NumFloatRegArgs ifTrue: [calloutState backfillFloatRegisterIndex > 0 ifTrue: [calloutState floatRegisters at: calloutState backfillFloatRegisterIndex put: value. calloutState backfillFloatRegisterIndex: 0] ifFalse: [calloutState floatRegisters at: calloutState floatRegisterIndex put: value. calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1]] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value. calloutState currentArg: calloutState currentArg + WordSize]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'eem 9/19/2018 17:31'! ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState | availableRegisterSpace stackPartSize roundedSize | availableRegisterSpace := (NumIntRegArgs - calloutState integerRegisterIndex) * 4. stackPartSize := structSize. availableRegisterSpace > 0 ifTrue: [structSize <= availableRegisterSpace ifTrue: ["all in registers" stackPartSize := 0. self memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *') _: pointer _: structSize. calloutState integerRegisterIndex: calloutState integerRegisterIndex + (structSize + 3 bitShift: -2) ] ifFalse: ["If no previous co-processor candidate arg has already been pushed on the stack, then split the struct between registers and stack. Otherwise push entire struct on stack." calloutState currentArg = calloutState argVector ifTrue: [stackPartSize := structSize - availableRegisterSpace. self memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *') _: pointer _: availableRegisterSpace] ifFalse: [availableRegisterSpace := 0]. calloutState integerRegisterIndex: NumIntRegArgs]]. stackPartSize > 0 ifTrue: [roundedSize := stackPartSize + 3 bitClear: 3. calloutState currentArg + roundedSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. self memcpy: calloutState currentArg _: (self addressOf: ((self cCoerceSimple: pointer to: 'char *') at: availableRegisterSpace)) _: stackPartSize. calloutState currentArg: calloutState currentArg + roundedSize]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:03'! ffiPushUnsignedByte: value in: calloutState calloutState integerRegisterIndex < NumIntRegArgs ifTrue: [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char'). calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). calloutState currentArg: calloutState currentArg + WordSize]. ^0 ! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:04'! ffiPushUnsignedChar: value in: calloutState calloutState integerRegisterIndex < NumIntRegArgs ifTrue: [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char'). calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char'). calloutState currentArg: calloutState currentArg + WordSize]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:04'! ffiPushUnsignedInt: value in: calloutState calloutState integerRegisterIndex < NumIntRegArgs ifTrue: [calloutState integerRegisters at: calloutState integerRegisterIndex put: value. calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy longAt: calloutState currentArg put: value. calloutState currentArg: calloutState currentArg + WordSize]. ^0 ! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:04'! ffiPushUnsignedLongLong: value in: calloutState calloutState integerRegisterIndex < (NumIntRegArgs - 1) ifTrue: [calloutState integerRegisterIndex: (calloutState integerRegisterIndex + 1 bitClear: 1). calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #usqInt). calloutState integerRegisters at: calloutState integerRegisterIndex + 1 put: (self cCoerceSimple: value >> 32 to: #usqInt). calloutState integerRegisterIndex: calloutState integerRegisterIndex + 2] ifFalse: [calloutState currentArg + 8 > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. calloutState integerRegisterIndex: NumIntRegArgs. interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #usqInt); longAt: calloutState currentArg + WordSize put: (self cCoerceSimple: value >> 32 to: #usqInt). calloutState currentArg: calloutState currentArg + 8]. ^0 ! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:05'! ffiPushUnsignedShort: value in: calloutState calloutState integerRegisterIndex < NumIntRegArgs ifTrue: [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned short'). calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1] ifFalse: [calloutState currentArg + WordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig]. interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short'). calloutState currentArg: calloutState currentArg + WordSize]. ^0! ! !ThreadedARMFFIPlugin methodsFor: 'marshalling' stamp: 'KenD 12/17/2018 15:05'! returnStructInRegisters: returnStructSize "Answer if a struct result of a given size is returned in memory or not." ^returnStructSize <= WordSize! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ThreadedARMFFIPlugin class instanceVariableNames: ''! !ThreadedARMFFIPlugin class methodsFor: 'accessing' stamp: 'djm 4/12/2014 19:13'! numFloatRegArgs ^NumFloatRegArgs! ! !ThreadedARMFFIPlugin class methodsFor: 'accessing' stamp: 'djm 4/12/2014 19:13'! numIntRegArgs ^NumIntRegArgs! ! !ThreadedARMFFIPlugin class methodsFor: 'class initialization' stamp: 'KenD 12/17/2018 14:55'! initialize super initialize. WordSize := Smalltalk wordSize. NumIntRegArgs := 4. NumFloatRegArgs := 16! ! !ThreadedARMFFIPlugin class methodsFor: 'translation' stamp: 'eem 11/7/2009 09:52'! calloutStateClass ^ThreadedFFICalloutStateForARM! ! !ThreadedARMFFIPlugin class methodsFor: 'translation' stamp: 'KenD 12/17/2018 14:42'! identifyingPredefinedMacros ^#('__ARM_ARCH__' " '__arm__' " '__arm32__' 'ARM32')! ! !ThreadedARMFFIPlugin class methodsFor: 'translation' stamp: 'eem 4/21/2014 11:04'! moduleName ^'ARM32FFIPlugin'! ! ThreadedARMFFIPlugin initialize!