VM Maker: VMMaker.oscog-eem.2517.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog-eem.2517.mcz

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

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

Name: VMMaker.oscog-eem.2517
Author: eem
Time: 28 January 2019, 11:48:59.270874 am
UUID: b95a872b-52c8-405d-b493-6914df320090
Ancestors: VMMaker.oscog-eem.2511, VMMaker.oscog-KenD.2516

Merge with VMMaker.oscog-KenD.2516
ThreadedARMFFIPlugin:

Renamed ThreadedARMFFIPlugin to ThreadedARM32FFIPlugin to accord with ThreadedARM64FFIPlugin (more descriptive)

Reversed the way single and double floats were handled in callOutState floatRegisters to simplify the  logic a bit.

Updated struct size rounding for aarch64.

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

Item was changed:
  ----- Method: RiscOSVMMaker class>>generateSqueakStackVM (in category 'configurations') -----
  generateSqueakStackVM
  "RISC OS version; build needed plugins, make sure filename tweaking is used"
  "RiscOSVMMaker generateSqueakStackVM"
  ^self
  generate: StackInterpreter
  to: (FileDirectory default directoryNamed: 'stacksrc') fullName
  platformDir: (FileDirectory default directoryNamed: 'platforms') fullName
+ excluding: #(AsynchFilePlugin BrokenPlugin CroquetPlugin FFIPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin JoystickTabletPlugin MIDIPlugin MacMenubarPlugin Mpeg3Plugin NewsqueakIA32ABIPlugin QuicktimePlugin SerialPlugin  TestOSAPlugin ThreadedARM32FFIPlugin ThreadedARMFFI64Plugin ThreadedFFIPlugin ThreadedIA32FFIPlugin ThreadedPPCBEFFIPlugin UUIDPlugin VMProfileMacSupportPlugin)!
- excluding: #(AsynchFilePlugin BrokenPlugin CroquetPlugin FFIPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin JoystickTabletPlugin MIDIPlugin MacMenubarPlugin Mpeg3Plugin NewsqueakIA32ABIPlugin QuicktimePlugin SerialPlugin  TestOSAPlugin ThreadedARMFFIPlugin ThreadedARMFFI64Plugin ThreadedFFIPlugin ThreadedIA32FFIPlugin ThreadedPPCBEFFIPlugin UUIDPlugin VMProfileMacSupportPlugin)!

Item was added:
+ ThreadedFFIPlugin subclass: #ThreadedARM32FFIPlugin
+ instanceVariableNames: ''
+ classVariableNames: 'NumFloatRegArgs NumIntRegArgs'
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins-FFI'!
+
+ !ThreadedARM32FFIPlugin commentStamp: '<historical>' prior: 0!
+ This subclass is for the 32-bit ARM ABI.  It typically has 4 integer registers.!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin class>>calloutStateClass (in category 'translation') -----
+ calloutStateClass
+ ^ThreadedFFICalloutStateForARM32!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin class>>identifyingPredefinedMacros (in category 'translation') -----
+ identifyingPredefinedMacros
+ ^#('__ARM_ARCH__' '__arm__' '__arm32__' 'ARM32')!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin class>>initialize (in category 'class initialization') -----
+ initialize
+ super initialize.
+ NumIntRegArgs := 4.
+ NumFloatRegArgs := 16!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin class>>moduleName (in category 'translation') -----
+ moduleName
+ ^'ARM32FFIPlugin'!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin class>>numFloatRegArgs (in category 'accessing') -----
+ numFloatRegArgs
+ ^NumFloatRegArgs!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin class>>numIntRegArgs (in category 'accessing') -----
+ numIntRegArgs
+ ^NumIntRegArgs!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>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 |
+ <var: #floatRet type: #double>
+ <var: #intRet type: #usqLong>
+ <inline: true>
+ 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!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
+ ffiPushDoubleFloat: value in: calloutState
+ <var: #value type: #double>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: #always>
+
+ 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!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushPointer:in: (in category 'marshalling') -----
+ ffiPushPointer: pointer in: calloutState
+ <var: #pointer type: #'void *'>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters at: calloutState integerRegisterIndex put: pointer asInteger.
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: pointer.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') -----
+ ffiPushSignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char').
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') -----
+ ffiPushSignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char').
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') -----
+ ffiPushSignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters at: calloutState integerRegisterIndex put: value.
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: value.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0
+ !

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') -----
+ ffiPushSignedLongLong: value in: calloutState
+ <var: #value type: #sqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ 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 + self wordSize put: (self cCoerceSimple: value >> 32 to: #usqInt).
+ calloutState currentArg: calloutState currentArg + 8].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') -----
+ ffiPushSignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed short').
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short').
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
+ ffiPushSingleFloat: value in: calloutState
+ <var: #value type: #float>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: #always>
+ 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 + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
+ ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
+ <var: #pointer type: #'void *'>
+ <var: #argSpec type: #'sqInt *'>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ | 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!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') -----
+ ffiPushUnsignedByte: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char').
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0
+ !

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') -----
+ ffiPushUnsignedChar: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char').
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') -----
+ ffiPushUnsignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters at: calloutState integerRegisterIndex put: value.
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: value.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0
+
+ !

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') -----
+ ffiPushUnsignedLongLong: value in: calloutState
+ <var: #value type: #usqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ 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 + self wordSize put: (self cCoerceSimple: value >> 32 to: #usqInt).
+ calloutState currentArg: calloutState currentArg + 8].
+ ^0
+ !

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') -----
+ ffiPushUnsignedShort: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned short').
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short').
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
+ ffiReturnStruct: longLongRet ofType: ffiRetType in: calloutState
+ <var: #longLongRet type: #usqLong>
+ <var: #calloutState type: #'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 |
+ <inline: true>
+ 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!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
+ returnStructInRegisters: returnStructSize
+ "Answer if a struct result of a given size is returned in memory or not."
+ ^returnStructSize <= self wordSize!

Item was added:
+ ----- Method: ThreadedARM32FFIPlugin>>wordSize (in category 'simulation support') -----
+ wordSize
+
+ ^ 4  "arm32"!

Item was changed:
+ ThreadedARM32FFIPlugin subclass: #ThreadedARM64FFIPlugin
- ThreadedARMFFIPlugin subclass: #ThreadedARM64FFIPlugin
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'VMMaker-Plugins-FFI'!
 
  !ThreadedARM64FFIPlugin commentStamp: 'KenD 12/17/2018 14:38' prior: 0!
  A ThreadedARM64FFIPlugin is for the 64-bit ARM ABI.  It typically has 8 integer registers
 
  Instance Variables
  !

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin class>>initialize (in category 'class initialization') -----
  initialize
  super initialize.
+ NumIntRegArgs    := 8.
+ NumFloatRegArgs := 8!
- NumIntRegArgs     := 8.
- NumFloatRegArgs := 16!

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 |
  <var: #floatRet type: #double>
  <var: #intRet type: #usqLong>
  <inline: true>
  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 cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 0)) to: #'double *') at: 0)
- _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 2)) to: #'double *') at: 0)
- _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 4)) to: #'double *') at: 0)
- _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 6)) to: #'double *') at: 0)
- _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 8)) to: #'double *') at: 0)
- _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 10)) to: #'double *') at: 0)
- _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 12)) to: #'double *') at: 0)
- _: ((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, 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)]
  ifFalse: "atomicType = FFITypeDoubleFloat"
  [floatRet := 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: floatRet].
 
  intRet := self
  dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_t (*)(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.
 
  (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!

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
  ffiPushDoubleFloat: value in: calloutState
  <var: #value type: #double>
  <var: #calloutState type: #'CalloutState *'>
  <inline: #always>
 
+ calloutState floatRegisterIndex < NumFloatRegArgs
- calloutState floatRegisterIndex < (NumFloatRegArgs - 1)
  ifTrue:
+ [calloutState floatRegisters
+ at: calloutState floatRegisterIndex
- [(self cCoerceSimple:
- (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex))
- to: 'double*')
- at: 0
  put: value.
+ calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1]
- calloutState floatRegisterIndex: calloutState floatRegisterIndex + 2]
  ifFalse:
  [calloutState currentArg + self wordSize > calloutState limit ifTrue:
  [^FFIErrorCallFrameTooBig].
  calloutState floatRegisterIndex: NumFloatRegArgs.
  interpreterProxy storeFloatAtPointer: calloutState currentArg from: value.
  calloutState currentArg: calloutState currentArg + self wordSize].
  ^0!

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
  ffiPushSingleFloat: value in: calloutState
  <var: #value type: #float>
  <var: #calloutState type: #'CalloutState *'>
  <inline: #always>
  calloutState floatRegisterIndex < NumFloatRegArgs
+ ifTrue: "Note: this is a 'memcopy', so size is preserved. Casting to #double changes the size"
+ [(self cCoerceSimple:
+ (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex))
+ to: 'float*')
+ at: 0
+ put: value.
+ calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1]
- ifTrue:
- [calloutState floatRegisters
- at: calloutState floatRegisterIndex
- put: (self cCoerceSimple: value to: #double).
- calloutState floatRegisterIndex: calloutState floatRegisterIndex + 2]
  ifFalse:
  [calloutState currentArg + self wordSize > calloutState limit ifTrue:
  [^FFIErrorCallFrameTooBig].
  interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value.
  calloutState currentArg: calloutState currentArg + self wordSize].
  ^0!

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
  ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
  <var: #pointer type: #'void *'>
  <var: #argSpec type: #'sqInt *'>
  <var: #calloutState type: #'CalloutState *'>
  <inline: true>
  | availableRegisterSpace stackPartSize roundedSize |
 
  availableRegisterSpace := (NumIntRegArgs - calloutState integerRegisterIndex) * self wordSize.
  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.
+ "Round structSize up and divide by 8 ( NB: _not_ 4 !!)"
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + (structSize + 3 bitShift: -3) ]
- 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!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>nonRegisterStructReturnIsViaImplicitFirstArgument (in category 'marshalling') -----
+ nonRegisterStructReturnIsViaImplicitFirstArgument
+ "Answer if a struct returned in memory is returned to the
+ referent of a pointer passed as an implciit first argument.
+ It almost always is.  Subclasses can override if not."
+ ^false!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
+ returnStructInRegisters: returnStructSize
+ "Answer if a struct result of a given size is returned in memory or not."
+ ^returnStructSize <= (2 * self wordSize) "??numIntRegs--> 8 * wordsize??"!

Item was removed:
- ThreadedFFIPlugin subclass: #ThreadedARMFFIPlugin
- instanceVariableNames: ''
- classVariableNames: 'NumFloatRegArgs NumIntRegArgs'
- poolDictionaries: ''
- category: 'VMMaker-Plugins-FFI'!
-
- !ThreadedARMFFIPlugin commentStamp: '<historical>' prior: 0!
- This subclass is for the 32-bit ARM ABI.  It typically has 4 integer registers.!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin class>>calloutStateClass (in category 'translation') -----
- calloutStateClass
- ^ThreadedFFICalloutStateForARM32!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin class>>identifyingPredefinedMacros (in category 'translation') -----
- identifyingPredefinedMacros
- ^#('__ARM_ARCH__' '__arm__' '__arm32__' 'ARM32')!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin class>>initialize (in category 'class initialization') -----
- initialize
- super initialize.
- NumIntRegArgs := 4.
- NumFloatRegArgs := 16!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin class>>moduleName (in category 'translation') -----
- moduleName
- ^'ARM32FFIPlugin'!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin class>>numFloatRegArgs (in category 'accessing') -----
- numFloatRegArgs
- ^NumFloatRegArgs!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin class>>numIntRegArgs (in category 'accessing') -----
- numIntRegArgs
- ^NumIntRegArgs!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>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 |
- <var: #floatRet type: #double>
- <var: #intRet type: #usqLong>
- <inline: true>
- 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!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
- ffiPushDoubleFloat: value in: calloutState
- <var: #value type: #double>
- <var: #calloutState type: #'CalloutState *'>
- <inline: #always>
-
- 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!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushPointer:in: (in category 'marshalling') -----
- ffiPushPointer: pointer in: calloutState
- <var: #pointer type: #'void *'>
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- calloutState integerRegisterIndex < NumIntRegArgs
- ifTrue:
- [calloutState integerRegisters at: calloutState integerRegisterIndex put: pointer asInteger.
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
- ifFalse:
- [calloutState currentArg + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy longAt: calloutState currentArg put: pointer.
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushSignedByte:in: (in category 'marshalling') -----
- ffiPushSignedByte: value in: calloutState
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- calloutState integerRegisterIndex < NumIntRegArgs
- ifTrue:
- [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char').
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
- ifFalse:
- [calloutState currentArg + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushSignedChar:in: (in category 'marshalling') -----
- ffiPushSignedChar: value in: calloutState
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- calloutState integerRegisterIndex < NumIntRegArgs
- ifTrue:
- [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed char').
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
- ifFalse:
- [calloutState currentArg + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed char').
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') -----
- ffiPushSignedInt: value in: calloutState
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- calloutState integerRegisterIndex < NumIntRegArgs
- ifTrue:
- [calloutState integerRegisters at: calloutState integerRegisterIndex put: value.
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
- ifFalse:
- [calloutState currentArg + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy longAt: calloutState currentArg put: value.
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0
- !

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') -----
- ffiPushSignedLongLong: value in: calloutState
- <var: #value type: #sqLong>
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- 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 + self wordSize put: (self cCoerceSimple: value >> 32 to: #usqInt).
- calloutState currentArg: calloutState currentArg + 8].
- ^0!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushSignedShort:in: (in category 'marshalling') -----
- ffiPushSignedShort: value in: calloutState
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- calloutState integerRegisterIndex < NumIntRegArgs
- ifTrue:
- [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'signed short').
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
- ifFalse:
- [calloutState currentArg + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'signed short').
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
- ffiPushSingleFloat: value in: calloutState
- <var: #value type: #float>
- <var: #calloutState type: #'CalloutState *'>
- <inline: #always>
- 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 + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value.
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
- ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
- <var: #pointer type: #'void *'>
- <var: #argSpec type: #'sqInt *'>
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- | 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!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushUnsignedByte:in: (in category 'marshalling') -----
- ffiPushUnsignedByte: value in: calloutState
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- calloutState integerRegisterIndex < NumIntRegArgs
- ifTrue:
- [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char').
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
- ifFalse:
- [calloutState currentArg + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0
- !

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushUnsignedChar:in: (in category 'marshalling') -----
- ffiPushUnsignedChar: value in: calloutState
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- calloutState integerRegisterIndex < NumIntRegArgs
- ifTrue:
- [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned char').
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
- ifFalse:
- [calloutState currentArg + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned char').
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') -----
- ffiPushUnsignedInt: value in: calloutState
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- calloutState integerRegisterIndex < NumIntRegArgs
- ifTrue:
- [calloutState integerRegisters at: calloutState integerRegisterIndex put: value.
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
- ifFalse:
- [calloutState currentArg + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy longAt: calloutState currentArg put: value.
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0
-
- !

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') -----
- ffiPushUnsignedLongLong: value in: calloutState
- <var: #value type: #usqLong>
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- 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 + self wordSize put: (self cCoerceSimple: value >> 32 to: #usqInt).
- calloutState currentArg: calloutState currentArg + 8].
- ^0
- !

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiPushUnsignedShort:in: (in category 'marshalling') -----
- ffiPushUnsignedShort: value in: calloutState
- <var: #calloutState type: #'CalloutState *'>
- <inline: true>
- calloutState integerRegisterIndex < NumIntRegArgs
- ifTrue:
- [calloutState integerRegisters at: calloutState integerRegisterIndex put: (self cCoerceSimple: value to: #'unsigned short').
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
- ifFalse:
- [calloutState currentArg + self wordSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- interpreterProxy longAt: calloutState currentArg put: (self cCoerceSimple: value to: #'unsigned short').
- calloutState currentArg: calloutState currentArg + self wordSize].
- ^0!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
- ffiReturnStruct: longLongRet ofType: ffiRetType in: calloutState
- <var: #longLongRet type: #usqLong>
- <var: #calloutState type: #'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 |
- <inline: true>
- 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!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>returnStructInRegisters: (in category 'marshalling') -----
- returnStructInRegisters: returnStructSize
- "Answer if a struct result of a given size is returned in memory or not."
- ^returnStructSize <= self wordSize!

Item was removed:
- ----- Method: ThreadedARMFFIPlugin>>wordSize (in category 'simulation support') -----
- wordSize
-
- ^ 4  "arm32"!

Item was changed:
  ----- Method: ThreadedFFICalloutStateForARM32>>initialize (in category 'initialize-release') -----
  initialize
  super initialize.
  integerRegisterIndex := 0.
  floatRegisterIndex := 0.
  backfillFloatRegisterIndex := 0.
+ integerRegisters := CArrayAccessor on: (Array new: ThreadedARM32FFIPlugin numIntRegArgs).
+ floatRegisters := CArrayAccessor on: (Array new: ThreadedARM32FFIPlugin numFloatRegArgs)!
- integerRegisters := CArrayAccessor on: (Array new: ThreadedARMFFIPlugin numIntRegArgs).
- floatRegisters := CArrayAccessor on: (Array new: ThreadedARMFFIPlugin numFloatRegArgs)!

Item was changed:
  ----- Method: ThreadedFFICalloutStateForARM64 class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
  "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ThreadedFFICalloutState struct."
 
  superclass instVarNamesAndTypesForTranslationDo: aBinaryBlock.
  self instVarNames do:
  [:ivn|
  aBinaryBlock
  value: ivn
  value: (ivn caseOf: {
+ ['integerRegisters'] -> [{#sqInt.   '[NumIntRegArgs]'   }].
- ['integerRegisters'] -> [{#sqInt. '[NumIntRegArgs]'}].
  ['floatRegisters'] -> [{#double. '[NumFloatRegArgs]'}] }
  otherwise:
  [#sqInt])]!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>morphIntoConcreteSubclass: (in category 'simulation') -----
  morphIntoConcreteSubclass: aCoInterpreter
  <doNotGenerate>
  | concreteClass |
  concreteClass :=
  aCoInterpreter ISA caseOf: {
  [#X64] -> [(Smalltalk platformName beginsWith: 'Win')
  ifTrue: [ThreadedX64Win64FFIPlugin]
  ifFalse: [ThreadedX64SysVFFIPlugin]].
  [#IA32] -> [ThreadedIA32FFIPlugin].
+ [#ARMv5] -> [ThreadedARM32FFIPlugin] }
- [#ARMv5] -> [ThreadedARMFFIPlugin] }
  otherwise: [self error: 'simulation not set up for this ISA'].
  "If the concreteClass has an initialize method, other than ThreadedFFIPlugin class>>initialize
  then it needs to be run."
  ((concreteClass class whichClassIncludesSelector: #initialize) inheritsFrom: self class class) ifTrue:
  [concreteClass initialize].
  concreteClass adoptInstance: self!

Item was changed:
  ----- Method: VMMaker class>>generateVMPlugins (in category 'configurations') -----
  generateVMPlugins
  ^VMMaker
  generatePluginsTo: self sourceTree, '/src'
  options: #()
  platformDir: self sourceTree, '/platforms'
  including:#( ADPCMCodecPlugin AsynchFilePlugin
  BalloonEnginePlugin B3DAcceleratorPlugin B3DEnginePlugin BMPReadWriterPlugin BitBltSimulation
  BochsIA32Plugin BochsX64Plugin
  CameraPlugin CroquetPlugin DeflatePlugin DropPlugin
  "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin SHA256Plugin
  "FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FileAttributesPlugin FloatArrayPlugin FloatMathPlugin
  GeniePlugin GdbARMPlugin HostWindowPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin
  JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin
  LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin
  MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin
  ScratchPlugin SecurityPlugin SerialPlugin SocketPlugin
  SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin
+ ThreadedFFIPlugin ThreadedARM32FFIPlugin ThreadedARM64FFIPlugin ThreadedIA32FFIPlugin
- ThreadedFFIPlugin ThreadedARMFFIPlugin ThreadedARM64FFIPlugin ThreadedIA32FFIPlugin
  ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin
  UnicodePlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin
  Win32OSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin WeDoPlugin
  XDisplayControlPlugin)!