VM Maker Inbox: VMMaker.oscog-nice.2678.mcz

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

VM Maker Inbox: VMMaker.oscog-nice.2678.mcz

commits-2
 
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker Inbox:
http://source.squeak.org/VMMakerInbox/VMMaker.oscog-nice.2678.mcz

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

Name: VMMaker.oscog-nice.2678
Author: nice
Time: 27 January 2020, 12:09:34.980629 am
UUID: 966e4aa2-188d-4ac0-8c9d-89877d032300
Ancestors: VMMaker.oscog-nice.2677

1) WIP: try to solve passing/returning struct by value on X64
2) restore the faculty to use BSR if there is no CLZ

See https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/443

On X64/SysV struct up to 16 byte long can be passed by value into a pair of 8-byte registers.
The problem is to know whether these are int (RAX RDX) or float (XMM0 XMM1) registers or eventually a mix of...

For each 8-byte, we must know if it contains at least an int (in which case we have to use an int register), or exclusively floating points (a pair of float or a double).
Previous algorithm did check first two fields, or last two fields which does not correctly cover all cases...
For example int-int-float has last two fields int-float, though it will use RAX XMM0.

So we have to know about struct layout... Unfortunately, this information is not included into the compiledSpec.
The idea here is to reconstruct the information.
See #registerTypeForStructSpecs:OfLength:

This can be tricky since I also introduced union in FFI.
The version above does not handle union.
However, I have prepared a recursive version to be connected later
#registerType:ForStructSpecs:OfLength:StartingAt:ByteOffset:EightbyteOffset:IsUnion:

It's also impossible to cover the exotic alignments like packed structure cases... But if we really want to pass that, this will mean passing the alignment information, a more involved change of #compiledSpec (we need up to 16 bits by field to handle that information since our FFI struct are limited to 65535 bytes anyway).

For returning a struct, that's the same problem.
We have four possible combinations of int-float registers.
Consequently, the idea is to analyze #registerType: and switch to appropriate case.
I found convenient to pass the ffiRetSpec compiledSpec object thru CalloutState (it's the Smalltalk WordArray object, not a pointer to its firstIndexableField) for performing this analysis... Not sure if the best choice.

Since we have 4 different SixteenByte types, I have changed #ffiReturnStruct:ffiRetType: to take a (void*) pointer to the returned struct value, since it's what will be used to memcpy to allocated ByteArray handle.

For now, I have the fast VM mostly working on OSX (passing all tests but 1).
Unfortunately the debug and assert VM crash when passing the tests!
It seems related to (allocaLies or mustAlignStack) stack manipulation hack that setsp.
When we call a function after setting stack pointer, the callee does not receive the correct caller variable.
If I comment out setsp, then fast VM still works, while debug and assert don't crash (at least not immediately), but fail some FFI tests.
This might be related to inlining performed by compiler...

For these reasons, as well for reviewing purpose, this is a WIP in inbox.
I don't know when my next time slot will be, week-end was too short.

=============== Diff against VMMaker.oscog-nice.2677 ===============

Item was added:
+ ----- Method: CogAbstractInstruction>>genHighBitAlternativeIn:ofSmallIntegerOopWithSingleTagBit: (in category 'abstract instructions') -----
+ genHighBitAlternativeIn: destReg ofSmallIntegerOopWithSingleTagBit: srcReg
+ "Use an alternative - if any for generating highBit of SmallInteger oop.
+ Default implementation is no-op - there is no universal alternative to CLZ.
+ Some target architecture might offer more...
+ For example, IA32 can use the BSR instruction."
+ <inline: true>
+ <returnTypeC: #'AbstractInstruction *'>
+ ^0!

Item was changed:
  ----- Method: CogAbstractInstruction>>genHighBitIn:ofSmallIntegerOopWithSingleTagBit: (in category 'abstract instructions') -----
  genHighBitIn: destReg ofSmallIntegerOopWithSingleTagBit: srcReg
  "Generate code for storing in destReg the 1-based highBit of srcReg.
  Assume that srcReg contains a SmallInteger Oop with a single tag bit set to 1.
  Sender should preprocess Oop when cog representation use numSmallIntegerTagBits > 1.
  Return the jump instruction necessary for handling case of negative integer value.
  Return null pointer if the abstract highBit operation is not implemented."
  <inline: true>
+ self hasLZCNTInstructions
+ ifTrue: [^self genHighBitClzIn: destReg ofSmallIntegerOopWithSingleTagBit: srcReg]
+ ifFalse: [^self genHighBitAlternativeIn: destReg ofSmallIntegerOopWithSingleTagBit: srcReg]!
- self hasLZCNTInstructions ifTrue:
- [^self genHighBitClzIn: destReg ofSmallIntegerOopWithSingleTagBit: srcReg].
- ^0!

Item was changed:
  ----- 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: (self addressOf: 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: ThreadedARM32FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
+ ffiReturnStruct: longLongRetPtr ofType: ffiRetType in: calloutState
+ <var: #longLongRetPtr type: #'void *'>
- 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 passed by pointer."
- 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: [longLongRetPtr]
- ifTrue: [self addressOf: longLongRet]
  ifFalse: [calloutState limit])
  _: calloutState structReturnSize.
  interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  ^retOop!

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 x1Ret |
  <var: #floatRet type: #double>
  <var: #intRet type: #usqLong>
  <var: #x1Ret 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 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].
 
  "If struct address used for return value, call is special"
  (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: [
  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).
 
  x1Ret := self getX1register. "Capture x1 immediately. No problem if unused"
  ].
  "If struct returned in registers,
  place register values into calloutState integerRegisters"
  (calloutState structReturnSize > 0
  and: [self returnStructInRegisters: calloutState structReturnSize]) ifTrue:
  ["Only 2 regs used in ARMv8/Aarch64 current"
  calloutState integerRegisters at: 0 put: intRet. "X0"
  calloutState integerRegisters at: 1 put: x1Ret]. "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 addressOf: 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>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
+ ffiReturnStruct: longLongRetPtr ofType: ffiRetType in: calloutState
+ <var: #longLongRetPtr type: #'void *'>
- 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 integer registers."
- 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: calloutState integerRegisters]
  ifFalse: [calloutState limit])
  _: calloutState structReturnSize.
  interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  ^retOop!

Item was changed:
  VMStructType subclass: #ThreadedFFICalloutState
+ instanceVariableNames: 'argVector currentArg limit structReturnSize callFlags ffiArgSpec ffiArgSpecSize ffiArgHeader ffiRetHeader ffiRetSpec stringArgIndex stringArgs'
- instanceVariableNames: 'argVector currentArg limit structReturnSize callFlags ffiArgSpec ffiArgSpecSize ffiArgHeader ffiRetHeader stringArgIndex stringArgs'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'VMMaker-Plugins-FFI'!
 
  !ThreadedFFICalloutState commentStamp: '<historical>' prior: 0!
  Instances of the receiver hold the per-thread state of a call-out.
 
  long *argVector pointer to the start of the alloca'ed argument marshalling area
  long *currentArg pointer to the position in argVector to write the current argument
  long *limit the limit of the argument marshalling area (for bounds checking)
  structReturnSize the size of the space allocated for the structure return, if any
  callFlags the value of the ExternalFunctionFlagsIndex field in the ExternalFunction being called
  ffiArgSpec et al type information for the current argument being marshalled
  stringArgIndex the count of temporary strings used for marshalling Smalltalk strings to character strings.
  stringArgs pointers to the temporary strings used for marshalling Smalltalk strings to character strings.!

Item was added:
+ ----- Method: ThreadedFFICalloutState>>ffiRetSpec (in category 'accessing') -----
+ ffiRetSpec
+ "Answer the value of ffiRetSpec"
+
+ ^ ffiRetSpec!

Item was added:
+ ----- Method: ThreadedFFICalloutState>>ffiRetSpec: (in category 'accessing') -----
+ ffiRetSpec: anObject
+ "Set the value of ffiRetSpec"
+
+ ^ffiRetSpec := anObject!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>alignmentOfStructSpec:OfLength:StartingAt: (in category 'marshalling-struct') -----
+ alignmentOfStructSpec: specs OfLength: specSize StartingAt: indexPtr
+ "Answer with the alignment requirement for a structure/union.
+ Note that indexPtr is a pointer so as to be changed on return.
+ On input, the index points to the structure header (the one with FFIFlagStructure + structSize)
+ On output, the index points the the structure trailer (the FFIFlagStructure)."
+ | spec byteAlignment thisAlignment |
+ <var: #specs type: #'unsigned int*'>
+ <var: #indexPtr type: #'unsigned int*'>
+ spec := specs at: (indexPtr at: 0).
+ self assert: (spec bitAnd: FFIFlagPointer + FFIFlagAtomic + FFIFlagStructure) = FFIFlagStructure.
+ byteAlignment := 1.
+ [indexPtr at: 0 put: (indexPtr at: 0) + 1.
+ (indexPtr at: 0) < specSize]
+ whileTrue:
+ [spec := specs at: (indexPtr at: 0).
+ spec = FFIFlagStructure
+ ifTrue: [^byteAlignment].
+ thisAlignment := (spec anyMask: FFIFlagPointer)
+ ifTrue: [BytesPerWord]
+ ifFalse: [(spec anyMask: FFIFlagStructure)
+ ifTrue: [self alignmentOfStructSpec: specs OfLength: specSize StartingAt: indexPtr]
+ ifFalse: [spec bitAnd: FFIStructSizeMask]].
+ byteAlignment := byteAlignment max: thisAlignment].
+ self assert: false. "should not reach here"
+ ^-1!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiCheckReturn:With:in: (in category 'callout support') -----
  ffiCheckReturn: retSpec With: retClass in: calloutState
  <var: #calloutState type: #'CalloutState *'>
  "Make sure we can return an object of the given type"
  <inline: true>
  retClass = interpreterProxy nilObject ifFalse:
  [(interpreterProxy
  includesBehavior: retClass
  ThatOf: interpreterProxy classExternalStructure) ifFalse:
  [^FFIErrorBadReturn]].
 
  ((interpreterProxy isWords: retSpec)
  and: [(interpreterProxy slotSizeOf: retSpec) > 0]) ifFalse:
  [^FFIErrorWrongType].
 
+ calloutState ffiRetSpec: retSpec.
  calloutState ffiRetHeader: (interpreterProxy fetchLong32: 0 ofObject: retSpec).
  (self isAtomicType: calloutState ffiRetHeader) ifFalse:
  [retClass = interpreterProxy nilObject ifTrue:
  [^FFIErrorBadReturn]].
  (calloutState ffiRetHeader bitAnd: (FFIFlagPointer bitOr: FFIFlagStructure)) = FFIFlagStructure ifTrue:
  [calloutState structReturnSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask)].
  ^0!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
+ ffiReturnStruct: longLongRetPtr ofType: ffiRetClass in: calloutState
+ <var: #longLongRetPtr type: #'void *'>
- ffiReturnStruct: longLongRet ofType: ffiRetClass in: calloutState
- <var: #longLongRet type: #usqLong>
  <var: #calloutState type: #'CalloutState *'>
  "Create a structure return value from an external function call.  The value as been stored in
  alloca'ed space pointed to by the calloutState."
  <inline: true>
  self subclassResponsibility!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>isUnionSpec:OfLength:StartingAt: (in category 'marshalling-struct') -----
+ isUnionSpec: specs OfLength: specSize StartingAt: startIndex
+ "We can't easily distinguish union from structures with available flags.
+ But we have a trick: a union should have one field size equal to its own size."
+ | index spec unionSize thisSize |
+ <var: #specs type: #'unsigned int*'>
+ index := startIndex.
+ spec := specs at: index.
+ self assert: (spec bitAnd: FFIFlagPointer + FFIFlagAtomic + FFIFlagStructure) = FFIFlagStructure.
+ unionSize := spec bitAnd: FFIStructSizeMask.
+ [index := index + 1.
+ index < specSize]
+ whileTrue:
+ [spec := specs at: index.
+ spec = FFIFlagStructure
+ ifTrue: [^false].
+ thisSize := spec bitAnd: FFIStructSizeMask.
+ thisSize = unionSize ifTrue: [^true].
+ ((spec bitAnd: FFIFlagPointer + FFIFlagStructure) = FFIFlagStructure)
+ ifTrue:
+ ["Asking for alignment is a trick for skipping this sub structure/union"
+ self alignmentOfStructSpec: specs OfLength: specSize StartingAt: (self addressOf: index)]].
+ self assert: false. "should not reach here"
+ ^false!

Item was removed:
- VMStructType subclass: #ThreadedFFIX64SixteenByteReturn
- instanceVariableNames: 'a b'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'VMMaker-Plugins-FFI'!

Item was removed:
- ----- Method: ThreadedFFIX64SixteenByteReturn 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."
-
- self instVarNames do:
- [:ivn|
- aBinaryBlock value: ivn value: #sqInt]!

Item was removed:
- ----- Method: ThreadedFFIX64SixteenByteReturn class>>structTypeName (in category 'translation') -----
- structTypeName
- ^'SixteenByteReturn'!

Item was removed:
- ----- Method: ThreadedFFIX64SixteenByteReturn>>a (in category 'accessing') -----
- a
-
- ^ a!

Item was removed:
- ----- Method: ThreadedFFIX64SixteenByteReturn>>a: (in category 'accessing') -----
- a: anObject
-
- ^a := anObject!

Item was removed:
- ----- Method: ThreadedFFIX64SixteenByteReturn>>b (in category 'accessing') -----
- b
-
- ^ b!

Item was removed:
- ----- Method: ThreadedFFIX64SixteenByteReturn>>b: (in category 'accessing') -----
- b: anObject
-
- ^b := anObject!

Item was added:
+ VMStructType subclass: #ThreadedFFIX64SixteenByteReturnDD
+ instanceVariableNames: 'a b'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins-FFI'!
+
+ !ThreadedFFIX64SixteenByteReturnDD commentStamp: 'nice 1/25/2020 17:43' prior: 0!
+ A ThreadedFFIX64SixteenByteReturnDD is a stub for returning a struct by value through 2 eight-byte float registers
+ That is (XMM0 XMM1) on X64.
+
+ Instance Variables
+ a: <Object>
+ b: <Object>
+
+ a
+ - stub for first eighbyte
+
+ b
+ - stub for second eighbyte
+ !

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDD 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: 'a' value: #double.
+ aBinaryBlock value: 'b' value: #double.!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDD class>>structTypeName (in category 'translation') -----
+ structTypeName
+ ^'SixteenByteReturnDD'!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDD>>a (in category 'accessing') -----
+ a
+
+ ^ a!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDD>>a: (in category 'accessing') -----
+ a: anObject
+
+ ^a := anObject!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDD>>b (in category 'accessing') -----
+ b
+
+ ^ b!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDD>>b: (in category 'accessing') -----
+ b: anObject
+
+ ^b := anObject!

Item was added:
+ VMStructType subclass: #ThreadedFFIX64SixteenByteReturnDI
+ instanceVariableNames: 'a b'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins-FFI'!
+
+ !ThreadedFFIX64SixteenByteReturnDI commentStamp: 'nice 1/25/2020 17:44' prior: 0!
+ A ThreadedFFIX64SixteenByteReturnDI is a stub for returning a struct by value through 1 eight-byte float register and 1 eight-byte int register
+ That is (XMM0 RAX) on X64.
+
+ Instance Variables
+ a: <Object>
+ b: <Object>
+
+ a
+ - stub for first eighbyte
+
+ b
+ - stub for second eighbyte
+ !

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDI 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: 'a' value: #double.
+ aBinaryBlock value: 'b' value: #sqInt.!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDI class>>structTypeName (in category 'translation') -----
+ structTypeName
+ ^'SixteenByteReturnDI'!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDI>>a (in category 'accessing') -----
+ a
+
+ ^ a!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDI>>a: (in category 'accessing') -----
+ a: anObject
+
+ ^a := anObject!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDI>>b (in category 'accessing') -----
+ b
+
+ ^ b!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnDI>>b: (in category 'accessing') -----
+ b: anObject
+
+ ^b := anObject!

Item was added:
+ VMStructType subclass: #ThreadedFFIX64SixteenByteReturnID
+ instanceVariableNames: 'a b'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins-FFI'!
+
+ !ThreadedFFIX64SixteenByteReturnID commentStamp: 'nice 1/25/2020 17:45' prior: 0!
+ A ThreadedFFIX64SixteenByteReturnID is a stub for returning a struct by value through 1 eight-byte int register and 1 eight-byte float register
+ That is (RAX XMM0) on X64.
+
+ Instance Variables
+ a: <Object>
+ b: <Object>
+
+ a
+ - stub for first eighbyte
+
+ b
+ - stub for second eighbyte
+ !

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnID 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: 'a' value: #sqInt.
+ aBinaryBlock value: 'b' value: #double.!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnID class>>structTypeName (in category 'translation') -----
+ structTypeName
+ ^'SixteenByteReturnID'!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnID>>a (in category 'accessing') -----
+ a
+
+ ^ a!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnID>>a: (in category 'accessing') -----
+ a: anObject
+
+ ^a := anObject!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnID>>b (in category 'accessing') -----
+ b
+
+ ^ b!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnID>>b: (in category 'accessing') -----
+ b: anObject
+
+ ^b := anObject!

Item was added:
+ VMStructType subclass: #ThreadedFFIX64SixteenByteReturnII
+ instanceVariableNames: 'a b'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins-FFI'!
+
+ !ThreadedFFIX64SixteenByteReturnII commentStamp: 'nice 1/25/2020 17:44' prior: 0!
+ A ThreadedFFIX64SixteenByteReturnII is a stub for returning a struct by value through 2 eight-byte int registers
+ That is (RAX RDX) on X64.
+
+ Instance Variables
+ a: <Object>
+ b: <Object>
+
+ a
+ - stub for first eighbyte
+
+ b
+ - stub for second eighbyte
+ !

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnII 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: 'a' value: #sqInt.
+ aBinaryBlock value: 'b' value: #sqInt.!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnII class>>structTypeName (in category 'translation') -----
+ structTypeName
+ ^'SixteenByteReturnII'!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnII>>a (in category 'accessing') -----
+ a
+
+ ^ a!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnII>>a: (in category 'accessing') -----
+ a: anObject
+
+ ^a := anObject!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnII>>b (in category 'accessing') -----
+ b
+
+ ^ b!

Item was added:
+ ----- Method: ThreadedFFIX64SixteenByteReturnII>>b: (in category 'accessing') -----
+ b: anObject
+
+ ^b := anObject!

Item was changed:
  ----- Method: ThreadedIA32FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
  ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
  <var: #procAddr type: #'void *'>
  <var: #calloutState type: #'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 |
  <var: #floatRet type: #double>
  <var: #intRet type: #usqLong>
  <inline: true>
  myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
 
  (self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
  [self setsp: calloutState argVector].
 
  atomicType := self atomicTypeOf: calloutState ffiRetHeader.
  (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue:
  [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)()').
 
  "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: 'usqLong (*)()').
 
  "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 addressOf: 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: ThreadedIA32FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
+ ffiReturnStruct: longLongRetPtr ofType: ffiRetType in: calloutState
+ <var: #longLongRetPtr type: #'void *'>
- 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 as been stored in
+ alloca'ed space pointed to by the calloutState or in the return value passed by pointer."
- alloca'ed space pointed to by the calloutState."
  | 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: [longLongRetPtr]
- ifTrue: [(self addressOf: longLongRet) asVoidPointer]
  ifFalse: [calloutState limit])
  _: calloutState structReturnSize.
  interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  ^retOop!

Item was changed:
  ----- Method: ThreadedX64SysVFFIPlugin class>>ancilliaryClasses (in category 'translation') -----
  ancilliaryClasses
+ ^{ self calloutStateClass.
+ ThreadedFFIX64SixteenByteReturnDD.
+ ThreadedFFIX64SixteenByteReturnDI.
+ ThreadedFFIX64SixteenByteReturnID.
+ ThreadedFFIX64SixteenByteReturnII }!
- ^{ self calloutStateClass. ThreadedFFIX64SixteenByteReturn }!

Item was changed:
  ----- Method: ThreadedX64SysVFFIPlugin>>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 sddRet sdiRet sidRet siiRet returnStructByValue registerType sRetPtr |
- | myThreadIndex atomicType floatRet intRet |
  <var: #floatRet type: #double>
+ <var: #intRet type: #sqInt>
+ <var: #siiRet type: #SixteenByteReturnII>
+ <var: #sidRet type: #SixteenByteReturnID>
+ <var: #sdiRet type: #SixteenByteReturnDI>
+ <var: #sddRet type: #SixteenByteReturnDD>
+ <var: #sRetPtr type: #'void *'>
- <var: #intRet type: #SixteenByteReturn>
  <inline: true>
+
+ returnStructByValue := (calloutState ffiRetHeader bitAnd: FFIFlagStructure + FFIFlagPointer + FFIFlagAtomic) = FFIFlagStructure.
+ returnStructByValue
+ ifTrue:
+ [(self returnStructInRegisters: calloutState structReturnSize)
+ ifTrue: [registerType := self registerTypeForStructSpecs: (interpreterProxy firstIndexableField: calloutState ffiRetSpec) OfLength: (interpreterProxy slotSizeOf: calloutState ffiRetSpec)]
+ ifFalse: [registerType := 2r101 "encodes a single sqInt"]].
+
  myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
 
  calloutState floatRegisterIndex > 0 ifTrue:
  [self
  load: (calloutState floatRegisters at: 0)
  Flo: (calloutState floatRegisters at: 1)
  a: (calloutState floatRegisters at: 2)
  t: (calloutState floatRegisters at: 3)
  R: (calloutState floatRegisters at: 4)
  e: (calloutState floatRegisters at: 5)
  g: (calloutState floatRegisters at: 6)
  s: (calloutState floatRegisters at: 7)].
 
  (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)')
  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)]
  ifFalse: "atomicType = FFITypeDoubleFloat"
  [floatRet := self
  dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(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)].
 
  interpreterProxy ownVM: myThreadIndex.
 
  ^interpreterProxy floatObjectOf: floatRet].
 
+ returnStructByValue  ifFalse:
+ [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(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).
+ interpreterProxy ownVM: myThreadIndex.
+ (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
+ [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
+ ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState].
- intRet := self
- dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturn (*)(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).
 
+ registerType
+ caseOf:
+ {[2r00] ->
+ [sddRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnDD (*)(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).
+ sRetPtr := (self addressOf: sddRet) asVoidPointer].
+ [2r01] ->
+ [sidRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnID (*)(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).
+ sRetPtr := (self addressOf: sidRet) asVoidPointer].
+ [2r10] ->
+ [sdiRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnDI (*)(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).
+ sRetPtr := (self addressOf: sdiRet) asVoidPointer].
+ [2r11] ->
+ [siiRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnII (*)(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).
+ sRetPtr := (self addressOf: siiRet) asVoidPointer].
+ [2r100] ->
+ [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(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).
+ sRetPtr := (self addressOf: floatRet) asVoidPointer].
+ [2r101] ->
+ [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(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).
+ sRetPtr := (self addressOf: intRet) asVoidPointer]}
+ otherwise:
+ [interpreterProxy ownVM: myThreadIndex.
+ self ffiFail: FFIErrorWrongType. ^nil].
- interpreterProxy ownVM: myThreadIndex.
 
+ interpreterProxy ownVM: myThreadIndex.
+ ^self ffiReturnStruct: sRetPtr ofType: (self ffiReturnType: specOnStack) in: calloutState!
- (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 a ofType: (self ffiReturnType: specOnStack) in: calloutState].
- ^self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
-
- ^self ffiCreateIntegralResultOop: intRet a ofAtomicType: atomicType in: calloutState!

Item was changed:
  ----- Method: ThreadedX64SysVFFIPlugin>>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>
+ | roundedSize registerType numDoubleRegisters numIntegerRegisters passField0InXmmReg passField1InXmmReg |
- | roundedSize doubleType floatType numDoubleRegisters numIntegerRegisters passField0InXmmReg passField1InXmmReg |
  structSize <= 16 ifTrue:
  ["See sec 3.2.3 of http://people.freebsd.org/~obrien/amd64-elf-abi.pdf. (dravft version 0.90).
   All of the folowing are passed in registers:
  typedef struct { long a; } s0;
  typedef struct { double a; } s1;
  typedef struct { long a; double b; } s2;
  typedef struct { int a; int b; double c; } s2a;
  typedef struct { short a; short b; short c; short d; double e; } s2b;
  typedef struct { long a; float b; } s2f;
  typedef struct { long a; float b; float c; } s2g;
-  but not ones like this:
  typedef struct { int a; float b; int c; float d; } s2h;"
+ registerType := self registerTypeForStructSpecs: (self cCoerce: argSpec to: #'unsigned int *') OfLength: argSpecSize.
+ passField0InXmmReg := (registerType bitAnd: 1) = 0.
- doubleType := FFITypeDoubleFloat << FFIAtomicTypeShift + FFIFlagAtomic + 8.
- floatType := FFITypeSingleFloat << FFIAtomicTypeShift + FFIFlagAtomic + 4.
- passField0InXmmReg := doubleType = ((self cCoerce: argSpec to: #'int *') at: 1) "0th field is struct type and size"
- or: [floatType = ((self cCoerce: argSpec to: #'int *') at: 1)
- and: [floatType = ((self cCoerce: argSpec to: #'int *') at: 2)]].
  structSize <= 8
  ifTrue:
+ [numIntegerRegisters := registerType bitAnd: 1.
+ numDoubleRegisters := 1 - numIntegerRegisters]
- [numDoubleRegisters := passField0InXmmReg ifTrue: [1] ifFalse: [0].
- numIntegerRegisters := 1 - numDoubleRegisters]
  ifFalse:
+ [passField1InXmmReg := (registerType bitAnd: 2) = 0.
+ numIntegerRegisters := (registerType bitAnd: 2) >> 1 + (registerType bitAnd: 1).
+ numDoubleRegisters := 1 - numIntegerRegisters].
+ (calloutState floatRegisterIndex + numDoubleRegisters <= NumFloatRegArgs
- [passField1InXmmReg := doubleType = ((self cCoerce: argSpec to: #'int *') at: argSpecSize - 1) "Nth field is last field of struct"
- or: [floatType = ((self cCoerce: argSpec to: #'int *') at: argSpecSize - 2)
- and: [floatType = ((self cCoerce: argSpec to: #'int *') at: argSpecSize - 1)]].
- numDoubleRegisters := (passField0InXmmReg ifTrue: [1] ifFalse: [0]) + (passField1InXmmReg ifTrue: [1] ifFalse: [0]).
- numIntegerRegisters := 2 - numDoubleRegisters].
- (calloutState floatRegisterIndex + numDoubleRegisters <= NumFloatRegArgs
   and: [calloutState integerRegisterIndex + numIntegerRegisters <= NumIntRegArgs]) ifTrue:
  [passField0InXmmReg
  ifTrue: [self ffiPushDoubleFloat: ((self cCoerceSimple: pointer to: #'double *') at: 0) in: calloutState]
  ifFalse: [self ffiPushSignedLongLong: ((self cCoerceSimple: pointer to: #'long long *') at: 0) in: calloutState].
  structSize > 8 ifTrue:
  [passField1InXmmReg
  ifTrue: [self ffiPushDoubleFloat: ((self cCoerceSimple: pointer to: #'double *') at: 1) in: calloutState]
  ifFalse: [self ffiPushSignedLongLong: ((self cCoerceSimple: pointer to: #'long long *') at: 1) in: calloutState]].
  ^0]].
 
  roundedSize := structSize + 7 bitClear: 7.
  calloutState currentArg + roundedSize > calloutState limit ifTrue:
  [^FFIErrorCallFrameTooBig].
  self memcpy: calloutState currentArg _: (self cCoerceSimple: pointer to: 'char *') _: structSize.
  calloutState currentArg: calloutState currentArg + roundedSize.
  ^0!

Item was changed:
  ----- Method: ThreadedX64SysVFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
+ ffiReturnStruct: sixteenByteRetPtr ofType: ffiRetType in: calloutState
+ <var: #sixteenByteRetPtr type: #'void *'>
- ffiReturnStruct: sixteenByteRet ofType: ffiRetType in: calloutState
- <var: #sixteenByteRet type: #SixteenByteReturn>
  <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 passed by pointer."
- 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: [sixteenByteRetPtr]
- ifTrue: [(self addressOf: sixteenByteRet) asVoidPointer]
  ifFalse: [calloutState limit])
  _: calloutState structReturnSize.
  interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  ^retOop!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin>>registerType:ForStructSpecs:OfLength:StartingAt:ByteOffset:EightbyteOffset:IsUnion: (in category 'marshalling') -----
+ registerType: initialRegisterType ForStructSpecs: specs OfLength: specSize StartingAt: indexPtr ByteOffset: initialByteOffset EightbyteOffset: initialEightbyteOffset IsUnion: isUnion
+ "Answer with a number characterizing the register type for passing a struct/union of size <= 16 bytes.
+ The bit at offset i of registerType is set to 1 if eight-byte at offset i is a int register (RAX ...)
+ The bit at offset 2 indicates if there is a single eightbyte (struct size <= 8)
+ * 2r00 for float float (XMM0 XMM1)
+ * 2r01 for int float (RAX XMM0)
+ * 2r10 for float int (XMM0 RAX)
+ * 2r11 for int int (RAX RDX)
+ * 2r100 for float (XMM0)
+ * 2r101 for int (RAX)
+ Beware, the bits must be read from right to left for decoding register type.
+ Note: this method reconstructs the struct layout according to X64 alignment rules.
+ Therefore, it will not work for packed struct or other exotic alignment.
+ Note that indexPtr is a pointer so as to be changed on return.
+ On input, the index points to the structure header (the one with FFIFlagStructure + structSize)
+ On output, the index points to the structure trailer (the FFIFlagStructure)."
+
+ <var: #specs type: #'unsigned int*'>
+ <var: #indexPtr type: #'unsigned int*'>
+ <var: #subIndex type: #'unsigned int'>
+ | registerType eightbyteOffset byteOffset spec fieldSize alignment atomic subIndex isInt recurse subLevel |
+ registerType := initialRegisterType.
+ byteOffset := initialByteOffset.
+ eightbyteOffset := initialEightbyteOffset.
+ [indexPtr at: 0 put: (indexPtr at: 0) + 1.
+ subLevel := 0.
+ (indexPtr at: 0) < specSize]
+ whileTrue:
+ [spec := specs at: (indexPtr at: 0).
+ isInt := false.
+ recurse := false.
+ spec = FFIFlagStructure "this marks end of structure/union"
+ ifTrue:
+ [subLevel = 0 ifTrue: [^registerType].
+ subLevel := subLevel - 1]
+ ifFalse:
+ [(spec anyMask: FFIFlagPointer)
+ ifTrue:
+ [fieldSize := BytesPerWord.
+ alignment := fieldSize.
+ isInt := true]
+ ifFalse:
+ [(spec bitAnd: FFIFlagStructure + FFIFlagAtomic)
+ caseOf:
+ {[FFIFlagStructure] ->
+ [fieldSize := 0.
+ subIndex := indexPtr at: 0.
+ alignment := self alignmentOfStructSpec: specs OfLength: specSize StartingAt: (self addressOf: subIndex).
+ recurse := (self isUnionSpec: specs OfLength: specSize StartingAt: (indexPtr at: 0)) ~= isUnion.
+ recurse ifFalse: [subLevel := subLevel + 1]].
+ [FFIFlagAtomic] ->
+ [fieldSize := spec bitAnd: FFIStructSizeMask.
+ alignment := fieldSize.
+ atomic := self atomicTypeOf: spec.
+ isInt := (atomic >> 1) ~= (FFITypeSingleFloat >> 1)]}
+ otherwise: ["invalid spec" ^-1]].
+ (byteOffset bitAnd: alignment - 1) = 0
+ ifFalse:
+ ["this field requires alignment"
+ self assert: isUnion not.
+ byteOffset := (byteOffset bitClear: alignment - 1) + alignment].
+ byteOffset + fieldSize > 8
+ ifTrue:
+ ["Not enough room on current Eightbyte for this field, skip to next one"
+ self assert: isUnion not.
+ eightbyteOffset := eightbyteOffset + 1.
+ byteOffset := 0].
+ isInt
+ ifTrue:
+ ["If this eightbyte contains an int field, then we must use an int register"
+ registerType := registerType bitOr: 1 << eightbyteOffset].
+ recurse ifTrue:
+ ["struct in union and union in structs require a recursive form, because we handle byteOffset/eightbyteOffset differently"
+ registerType := self
+ registerType: registerType
+ ForStructSpecs: specs
+ OfLength: specSize
+ StartingAt: indexPtr
+ ByteOffset: byteOffset
+ EightbyteOffset: eightbyteOffset
+ IsUnion: isUnion not].
+ isUnion
+ ifFalse:
+ ["where to put the next field?"
+ byteOffset := byteOffset + fieldSize.
+ byteOffset >= 8
+ ifTrue:
+ ["This eightbyte is full, skip to next one"
+ eightbyteOffset := eightbyteOffset + 1.
+ byteOffset := 0]]]].
+ self assert: false. "should not reach here"
+ ^-1!

Item was added:
+ ----- Method: ThreadedX64SysVFFIPlugin>>registerTypeForStructSpecs:OfLength: (in category 'marshalling') -----
+ registerTypeForStructSpecs: specs OfLength: specSize
+ "Answer with a number characterizing the register type for passing a struct of size <= 16 bytes.
+ The bit at offset i of registerType is set to 1 if eightbyte at offset i is a int register (RAX ...)
+ The bit at offset 2 indicates if there is a single eightbyte (struct size <= 8)
+ * 2r00 for float float (XMM0 XMM1)
+ * 2r01 for int float (RAX XMM0)
+ * 2r10 for float int (XMM0 RAX)
+ * 2r11 for int int (RAX RDX)
+ * 2r100 for float (XMM0)
+ * 2r101 for int (RAX)
+ Beware, the bits must be read from right to left for decoding register type.
+ Note: this method reconstructs the struct layout according to X64 alignment rules.
+ Therefore, it will not work for packed struct or other exotic alignment."
+
+ <var: #specs type: #'unsigned int*'>
+ <var: #subIndex type: #'unsigned int'>
+ | eightByteOffset byteOffset index registerType spec fieldSize alignment atomic subIndex isInt |
+ eightByteOffset := 0.
+ byteOffset := 0.
+ index := 0.
+ registerType := ((specs at: index) bitAnd: FFIStructSizeMask) <= 8 ifTrue: [2r100] ifFalse: [0].
+ [(index := index + 1) < specSize]
+ whileTrue:
+ [spec := specs at: index.
+ isInt := false.
+ spec = FFIFlagStructure "this marks end of structure and should be ignored"
+ ifFalse:
+ [(spec anyMask: FFIFlagPointer)
+ ifTrue:
+ [fieldSize := BytesPerWord.
+ alignment := fieldSize.
+ isInt := true]
+ ifFalse:
+ [(spec bitAnd: FFIFlagStructure + FFIFlagAtomic)
+ caseOf:
+ {[FFIFlagStructure] ->
+ [fieldSize := 0.
+ subIndex := index.
+ alignment := self alignmentOfStructSpec: specs OfLength: specSize StartingAt: (self addressOf: subIndex)].
+ [FFIFlagAtomic] ->
+ [fieldSize := spec bitAnd: FFIStructSizeMask.
+ alignment := fieldSize.
+ atomic := self atomicTypeOf: spec.
+ isInt := (atomic >> 1) ~= (FFITypeSingleFloat >> 1)]}
+ otherwise: ["invalid spec" ^-1]].
+ (byteOffset bitAnd: alignment - 1) = 0
+ ifFalse:
+ ["this field requires alignment"
+ byteOffset := (byteOffset bitClear: alignment - 1) + alignment].
+ byteOffset + fieldSize > 8
+ ifTrue:
+ ["Not enough room on current eightbyte for this field, skip to next one"
+ eightByteOffset := eightByteOffset + 1.
+ byteOffset := 0].
+ isInt
+ ifTrue:
+ ["If this eightbyte contains an int field, then we must use an int register"
+ registerType := registerType bitOr: 1 << eightByteOffset].
+ "where to put the next field?"
+ byteOffset := byteOffset + fieldSize.
+ byteOffset >= 8
+ ifTrue:
+ ["This eightbyte is full, skip to next one"
+ eightByteOffset := eightByteOffset + 1.
+ byteOffset := 0]]].
+ ^registerType!

Item was changed:
  ----- Method: ThreadedX64Win64FFIPlugin>>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)'>
  "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 floatRegisterSignature > 0 ifTrue:
  [self
  load: (calloutState floatRegisters at: 0)
  Flo: (calloutState floatRegisters at: 1)
  atR: (calloutState floatRegisters at: 2)
  egs: (calloutState floatRegisters at: 3)].
 
  (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: (self addressOf: 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: ThreadedX64Win64FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
+ ffiReturnStruct: intRetPtr ofType: ffiRetType in: calloutState
+ <var: #intRetPtr type: #'void *'>
- ffiReturnStruct: intRet ofType: ffiRetType in: calloutState
- <var: #intRet 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 passed by pointer."
- 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: [intRetPtr]
- ifTrue: [self addressOf: intRet]
  ifFalse: [calloutState limit])
  _: calloutState structReturnSize.
  interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  ^retOop!