FFI: FFI-Callbacks-mt.15.mcz

Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI:
http://source.squeak.org/FFI/FFI-Callbacks-mt.15.mcz

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

Name: FFI-Callbacks-mt.15
Author: mt
Time: 16 May 2021, 2:32:14.911808 pm
UUID: 97d29055-72c1-8f47-b15f-1584f2f776d0
Ancestors: FFI-Callbacks-mt.14

Fixes regression in callbacks on 64-bit platforms.

=============== Diff against FFI-Callbacks-mt.14 ===============

Item was changed:
  ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') -----
  evaluateDynamic: callbackContext
  "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments."
 
  | byteOffset args intArgs intPos floatArgs floatPos |
 
  handle := callbackContext stackPtr getHandle.
  type := callbackContext stackPtr contentType.
  byteOffset := 1.
 
  intArgs := callbackContext integerArguments.
  intPos := 0.
  floatArgs := callbackContext floatArguments.
  floatPos := 0.
 
  args := Array new: argumentTypes size.
  1 to: args size do: [:argIndex |
  | argType data isPointer |
  argType := argumentTypes at: argIndex.
 
  "1) Try to read arguments from registers."
  data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]])
+ ifTrue: [intPos := intPos + 1. intArgs at: intPos]
- ifTrue: [intPos := intPos + 1. intArgs setContentType: argType. (intArgs at: intPos) value]
  ifFalse: [(floatPos < floatArgs size and: [argType isFloatType])
  ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]].
 
  data
+ ifNotNil: [ "1b) Read pointers from register value."
+ isPointer ifFalse: ["data is already an integer"] ifTrue: [
+ data := (ExternalData
+ fromHandle: (ExternalAddress fromInteger: data)
+ type: argType asNonPointerType "contentType" size: 1) value]]
  ifNil: [ "2) If nothing was read, read the argument from the stack."
  data := (argType handle: handle at: byteOffset) value.
  byteOffset := byteOffset
  + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)].
 
  args at: argIndex put: data].
 
  ^ self
  setResult: (evaluableObject valueWithArguments: args)
  inContext: callbackContext!

Item was changed:
  ----- Method: FFICallbackContext class>>fields (in category 'field definition') -----
  fields
  "
  self defineFields.
  "
  ^ #(
  (thunkp 'void*')
+ (stackPtr 'byte*') "was: char*"
- (stackPtr 'intptr_t*') "was: char*"
  (intRegArgs 'intptr_t*') "was: long* or int*"
  (floatRegArgs 'double*')
  (nil 'void*') "was: savedCStackPointer"
  (nil 'void*') "was: savedCFramePointer"
  (rvs 'FFICallbackResult')
  (nil 'void*') "was: savedPrimFunctionPointer"
  (outerContext 'FFICallbackContext*') "jmp_buf trampoline --- for debugging only?"
  )
 
  "
  typedef struct {
      void *thunkp;
      char *stackptr;
      long *intRegArgs;
      double *floatRegArgs;
      void *savedCStackPointer;
      void *savedCFramePointer;
      union {
                              intptr_t vallong;
                              struct { int low, high; } valleint64;
                              struct { int high, low; } valbeint64;
                              double valflt64;
                              struct { void *addr; intptr_t size; } valstruct;
                          }   rvs;
  void *savedPrimFunctionPointer;
  jmp_buf trampoline;
  jmp_buf savedReenterInterpreter;
   } VMCallbackContext;
  "!