FFI: FFI-Callbacks-mt.17.mcz

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

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

Name: FFI-Callbacks-mt.17
Author: mt
Time: 22 May 2021, 8:23:46.263398 am
UUID: b3ac5bb7-3823-d04c-bcc9-7409126840dd
Ancestors: FFI-Callbacks-mt.16

Minor improvement for callbacks. Decide on abi-specific register size during field definition in FFICallbackContext already. Not at callback time.

Please re-define fields: "FFICallbackContext defineFields."

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

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 intRegArgs.
- intArgs := callbackContext integerArguments.
  intPos := 0.
+ floatArgs := callbackContext floatRegArgs.
- 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]
  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 removed:
- ----- Method: FFICallback>>evaluateDynamic_ARM32: (in category 'callback - evaluators') -----
- evaluateDynamic_ARM32: callbackContext
- "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register."
- <abi: #ARM32> <evaluator>
-
- callbackContext integerArguments setSize: 4.
- callbackContext floatArguments setSize: 8.
- ^ self evaluateDynamic: callbackContext!

Item was removed:
- ----- Method: FFICallback>>evaluateDynamic_ARM64: (in category 'callback - evaluators') -----
- evaluateDynamic_ARM64: callbackContext
- "Set handle to access arguments as most appropriate for the ABI. ARMv8 with AArch64."
- <abi: #ARM64> <evaluator>
-
- callbackContext integerArguments setSize: 8.
- callbackContext floatArguments setSize: 8.
- ^ self evaluateDynamic: callbackContext!

Item was removed:
- ----- Method: FFICallback>>evaluateDynamic_IA32: (in category 'callback - evaluators') -----
- evaluateDynamic_IA32: callbackContext
- "Set handle to access arguments as most appropriate for the ABI. For x86 (i.e. IA32) it is the stack pointer."
- <abi: #IA32> <evaluator>
-
- callbackContext integerArguments setSize: 0.
- callbackContext floatArguments setSize: 0.
- ^ self evaluateDynamic: callbackContext!

Item was removed:
- ----- Method: FFICallback>>evaluateDynamic_X64: (in category 'callback - evaluators') -----
- evaluateDynamic_X64: callbackContext
- "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register."
- <abi: #X64> <evaluator>
-
- callbackContext integerArguments setSize: 6.
- callbackContext floatArguments setSize: 8.
- ^ self evaluateDynamic: callbackContext!

Item was removed:
- ----- Method: FFICallback>>evaluateDynamic_X64Win64: (in category 'callback - evaluators') -----
- evaluateDynamic_X64Win64: callbackContext
- "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register."
- <abi: #X64Win64> <evaluator>
-
- callbackContext integerArguments setSize: 4.
- callbackContext floatArguments setSize: 4.
- ^ self evaluateDynamic: callbackContext!

Item was changed:
  ----- Method: FFICallback>>setResult:inContext: (in category 'callback') -----
  setResult: anObject inContext: aCallbackContext
  "Set the result in the callback context. Add some fast checks to detect errors."
 
  resultType isPointerType
  ifTrue: [
  "an ExternalStructure, an ExternalUnion, an ExternalData, ..."
  ^ aCallbackContext externalObjectResult: anObject].
 
  resultType atomicType = 0 "void"
  ifTrue: ["Quick exit for void return type."
  ^ aCallbackContext voidResult].
 
  anObject isInteger
  ifTrue: [
  self assert: [resultType isIntegerType].
  self flag: #todo. "mt: ABI #X64Win64 has special treatment for word64, too. But maybe it is not needed."
+ ^ (anObject isLarge and: [abi = #IA32])
- ^ (anObject isLarge and: [FFIPlatformDescription current abi = #IA32])
  ifTrue: [aCallbackContext word64Result: anObject]
  ifFalse: [aCallbackContext wordResult: anObject]].
 
  anObject isBoolean
  ifTrue: [
  self assert: [resultType atomicType = 1 "bool"].
  ^ aCallbackContext wordResult: anObject].
 
  anObject isFloat
  ifTrue: [
  self assert: [resultType atomicType >= 12 "float/double"].
  ^ aCallbackContext floatResult: anObject].
 
  self notify: 'Unkown result type.'.
  ^ aCallbackContext errorResult!

Item was changed:
  ----- Method: FFICallback>>valueInContext: (in category 'callback') -----
  valueInContext: callbackContext "<FFICallbackContext> ^<Integer>"
+
+ ^ self evaluateDynamic: callbackContext!
-
- FFICallback methodsDo: [:method |
- (method hasPragma: #evaluator) ifTrue: [
- (method pragmaAt: #abi:)
- ifNotNil: [:pragma | (pragma argumentAt: 1) = abi
- ifTrue: [^ self with: callbackContext executeMethod: method]]]].
-
- self error: 'Could find evaluator for current ABI: ', abi.!

Item was changed:
  ExternalStructure subclass: #FFICallbackContext
+ instanceVariableNames: ''
- instanceVariableNames: 'floatArguments integerArguments'
  classVariableNames: ''
  poolDictionaries: 'FFICallbackConstants'
  category: 'FFI-Callbacks'!
 
  !FFICallbackContext commentStamp: 'mt 4/30/2021 11:32' prior: 0!
  A callback context is a data structure prepared from the VM for accessing the callback's arguments. See FFICallback >> #thunkEntryAddress.
 
  !!!!!! BE AWARE that the actual location of argument values in this structure depend on the current ABI (i.e. 'Application Binary Interface'). See FFIPlatformDescription to access the current ABI.!

Item was changed:
  ----- Method: FFICallbackContext class>>fields (in category 'field definition') -----
  fields
  "
  self defineFields.
  "
+
  ^ #(
  (thunkp 'void*')
  (stackPtr 'byte*') "was: char*"
+ ),
+ (FFIPlatformDescription current abiSend: #fields to: self),
+ #(
- (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;
  "!

Item was added:
+ ----- Method: FFICallbackContext class>>fields_ARM32 (in category 'field definition') -----
+ fields_ARM32
+ <abi: #ARM32> <fields>
+
+ ^ #(
+ (intRegArgs '(intptr_t[4])*')
+ (floatRegArgs '(double[8])*')
+ )!

Item was added:
+ ----- Method: FFICallbackContext class>>fields_ARM64 (in category 'field definition') -----
+ fields_ARM64
+ <abi: #ARM64> <fields>
+
+ ^ #(
+ (intRegArgs '(intptr_t[8])*')
+ (floatRegArgs '(double[8])*')
+ )!

Item was added:
+ ----- Method: FFICallbackContext class>>fields_IA32 (in category 'field definition') -----
+ fields_IA32
+ <abi: #IA32> <fields>
+
+ ^ #(
+ (intRegArgs '(intptr_t[0])*')
+ (floatRegArgs '(double[0])*')
+ )!

Item was added:
+ ----- Method: FFICallbackContext class>>fields_X64 (in category 'field definition') -----
+ fields_X64
+ <abi: #X64> <fields>
+
+ ^ #(
+ (intRegArgs '(intptr_t[6])*')
+ (floatRegArgs '(double[8])*')
+ )!

Item was added:
+ ----- Method: FFICallbackContext class>>fields_X64Win64 (in category 'field definition') -----
+ fields_X64Win64
+ <abi: #X64Win64> <fields>
+
+ ^ #(
+ (intRegArgs '(intptr_t[4])*')
+ (floatRegArgs '(double[4])*')
+ )!

Item was removed:
- ----- Method: FFICallbackContext>>floatArguments (in category 'callback arguments') -----
- floatArguments
- "Cache proxy to the list of float arguments (i.e. an ExternalData) to attach ABI-specific properties such as #size."
-
- ^ floatArguments ifNil: [
- floatArguments := self floatRegArgs]!

Item was removed:
- ----- Method: FFICallbackContext>>integerArguments (in category 'callback arguments') -----
- integerArguments
- "Cache proxy to the list of integer arguments (i.e. an ExternalData) to attach ABI-specific properties such as #size."
-
- ^ integerArguments ifNil: [
- integerArguments := self intRegArgs]!

Item was added:
+ ----- Method: FFIPlatformDescription>>abiSend:to: (in category '*FFI-Callbacks') -----
+ abiSend: selector to: receiver
+
+ receiver class methodsDo: [:method |
+ (method hasPragma: selector) ifTrue: [
+ (method pragmaAt: #abi:)
+ ifNotNil: [:pragma | (pragma argumentAt: 1) = self abi
+ ifTrue: [^ receiver executeMethod: method]]]].
+
+ self error: 'Could find method for current ABI: ', self abi.!

Item was added:
+ ----- Method: FFIPlatformDescription>>abiSend:to:with: (in category '*FFI-Callbacks') -----
+ abiSend: selector to: receiver with: argument
+
+ receiver class methodsDo: [:method |
+ (method hasPragma: selector) ifTrue: [
+ (method pragmaAt: #abi:)
+ ifNotNil: [:pragma | (pragma argumentAt: 1) = self abi
+ ifTrue: [^ receiver with: argument executeMethod: method]]]].
+
+ self error: 'Could find method for current ABI: ', self abi.!