FFI: FFI-Callbacks-mt.21.mcz

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

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

Name: FFI-Callbacks-mt.21
Author: mt
Time: 27 May 2021, 5:04:20.592121 pm
UUID: 43e1fa9c-eeb3-d84b-880d-09025f299cff
Ancestors: FFI-Callbacks-mt.20

Adds manual and automatic GC support for callbacks. Manual via #free is the default; see #qsort and #bsearch as examples. Use #newGC to automatically free the callback thunks once the evaluableObject (i.e. message send or block) got gc'ed.

Also lifts FFICallback to be an actual type alias for byte[40], i.e. the thunk.

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

Item was changed:
  ----- Method: CStandardLibrary>>bsearch:in:compare: (in category '*FFI-Callbacks') -----
  bsearch: key in: array compare: block
 
+ | result callback |
+ [result := self
- | result |
- result := self
  bsearch: key
  with: array
  with: array size
  with: array contentType byteSize
+ with: (callback := self compare: array contentType through: block).
+ ] ensure: [callback free].
- with: (self compare: array contentType through: block) thunk.
  result
  setContentType: array contentType;
  setSize: 1.
  ^ result!

Item was changed:
  ----- Method: CStandardLibrary>>qsort:compare: (in category '*FFI-Callbacks') -----
  qsort: array compare: block
+
+ | callback result |
+ [result := self
-
- ^ self
  qsort: array
  with: array size
  with: array contentType byteSize
+ with: (callback := self compare: array contentType through: block).
+ ] ensure: [callback free].
+ ^ result!
- with: (self compare: array contentType through: block) thunk!

Item was removed:
- ----- Method: ExternalData>>blockAt:byteSize: (in category '*FFI-Callbacks') -----
- blockAt: byteIndex byteSize: numBytes
- "Given that the receiver manages a page of memory, answer a block of that memory to use."
- ^ ExternalData
- fromHandle: handle + (byteIndex - 1)
- byteSize: numBytes!

Item was changed:
+ ExternalTypeAlias subclass: #FFICallback
+ instanceVariableNames: 'evaluableObject evaluator argumentTypes resultType'
+ classVariableNames: 'EvaluableToCallbackMap ThunkToCallbackMap'
+ poolDictionaries: 'FFICallbackConstants'
- ExternalObject subclass: #FFICallback
- instanceVariableNames: 'abi evaluableObject evaluator thunk argumentTypes resultType'
- classVariableNames: 'ThunkToCallbackMap'
- poolDictionaries: ''
  category: 'FFI-Callbacks'!

Item was changed:
  ----- Method: FFICallback class>>evaluateCallbackForContext: (in category 'instance lookup') -----
+ evaluateCallbackForContext: callbackContext "<FFICallbackContext> ^<Integer> typeCode"
- evaluateCallbackForContext: callbackContext "<FFIallbackContext> ^<Integer> typeCode"
 
+ ^ ThunkToCallbackMap
- (ThunkToCallbackMap
  at: callbackContext thunkp getHandle
+ ifPresent: [:callback | callback valueInContext: callbackContext]
+ ifAbsent: [self error: 'could not locate Callback instance corresponding to thunk address']
+ !
- ifAbsent: [^self error: 'could not locate Callback instance corresponding to thunk address'])
- ifNil: [self error: 'Callback instance for this thunk address has been garbage collected']
- ifNotNil:
- [:callback|
- ^callback valueInContext: callbackContext]!

Item was changed:
  ----- Method: FFICallback class>>initialize (in category 'class initialization') -----
  initialize
 
  Smalltalk addToStartUpList: self after: FFIPlatformDescription.
+ self initializeCallbacks.!
- ThunkToCallbackMap := WeakValueDictionary new.!

Item was added:
+ ----- Method: FFICallback class>>initializeCallbacks (in category 'class initialization') -----
+ initializeCallbacks
+
+ ThunkToCallbackMap := Dictionary new.
+ EvaluableToCallbackMap := WeakIdentityKeyDictionary new.
+ EvaluableToCallbackMap finalizer: [:callback | callback free].
+ WeakArray addWeakDependent: EvaluableToCallbackMap.!

Item was added:
+ ----- Method: FFICallback class>>newGC (in category 'instance creation') -----
+ newGC
+
+ ^ self new beManaged; yourself!

Item was added:
+ ----- Method: FFICallback class>>originalTypeName (in category 'field definition') -----
+ originalTypeName
+ "
+ self defineFields.
+ "
+ ^ 'byte[{1}]' format: {MaxThunkSize}!

Item was changed:
  ----- Method: FFICallback class>>startUp: (in category 'system startup') -----
  startUp: resuming
  "Any thunks in the finalization registry at the time the image comes up in a new session MUST NOT be finalized and should  immediately be discarded. Their thunk pointers are no longer valid."
 
+ resuming ifTrue: [self initializeCallbacks].!
- resuming ifTrue:
- [ThunkToCallbackMap := WeakValueDictionary new]!

Item was added:
+ ----- Method: FFICallback>>beManaged (in category 'initialization') -----
+ beManaged
+ "Mark the receiver to be free'd automatically when the #evaluableObject is gc'ed."
+
+ self assert: [evaluableObject isNil].
+ evaluableObject := WeakArray new: 1.!

Item was added:
+ ----- Method: FFICallback>>evaluableObject (in category 'accessing') -----
+ evaluableObject
+
+ ^ self isManaged
+ ifTrue: [evaluableObject at: 1]
+ ifFalse: [evaluableObject]!

Item was added:
+ ----- Method: FFICallback>>evaluableObject: (in category 'accessing') -----
+ evaluableObject: anObject
+
+ self isManaged
+ ifTrue: [
+ self evaluableObject ifNotNil: [:o | EvaluableToCallbackMap removeKey: o].
+ evaluableObject at: 1 put: anObject.
+ EvaluableToCallbackMap at: anObject put: self]
+ ifFalse: [
+ evaluableObject := anObject].!

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."
 
+ | arguments stack stackType stackByteOffset intArgs intPos floatArgs floatPos |
- | byteOffset args intArgs intPos floatArgs floatPos type |
 
+ stack := callbackContext stackPtr getHandle.
+ stackType := callbackContext stackPtr contentType.
+ stackByteOffset := 1.
- handle := callbackContext stackPtr getHandle.
- type := callbackContext stackPtr contentType.
- byteOffset := 1.
 
  intArgs := callbackContext intRegArgs.
  intPos := 0.
  floatArgs := callbackContext floatRegArgs.
  floatPos := 0.
 
+ arguments := Array new: argumentTypes size.
+ 1 to: arguments size do: [:argIndex |
- 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") value]]
  ifNil: [ "2) If nothing was read, read the argument from the stack."
+ data := (argType handle: stack at: stackByteOffset) value.
+ stackByteOffset := stackByteOffset
+ + ((stackType byteSize max: argType byteSize) roundUpTo: stackType byteAlignment)].
- data := (argType handle: handle at: byteOffset) value.
- byteOffset := byteOffset
- + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)].
 
+ arguments at: argIndex put: data].
- args at: argIndex put: data].
 
  ^ self
+ setResult: (self evaluableObject valueWithArguments: arguments)
- setResult: (evaluableObject valueWithArguments: args)
  inContext: callbackContext!

Item was added:
+ ----- Method: FFICallback>>free (in category 'initialization') -----
+ free
+
+ handle ifNil: [^ self].
+
+ ThunkToCallbackMap removeKey: handle.
+ self zeroMemory.
+ handle := nil.
+ !

Item was changed:
  ----- Method: FFICallback>>init__ccall_ARM32 (in category 'initialization - thunk prepare') -----
  init__ccall_ARM32
  <abi: #ARM32> <init_ccall>
  "Initialize the receiver with a __ccall thunk.  The thunk calls thunkEntry in the IA32ABI plugin,
  whose source is in platforms/Cross/plugins/IA32ABI/arm32abicc.c.  thunkEntry is the entry point
  for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the
  thunk (registers and stack) as well as a pointer to the thunk itself.  thunkEntry is as follows:
 
  long long
  thunkEntry(long r0, long r1, long r2, long r3,
             double d0, double d1, double d2, double d3,
             double d4, double d5, double d6, double d7,
             void *thunkpPlus16, sqIntptr_t *stackp)
 
  thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point
  register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:."
 
  "0x0 <thunk+0>: mov     r12, sp ; 0xe1a0c00d
    0x4 <thunk+4>: sub     sp, sp, #16 ; 0xe24dd010
    0x8 <thunk+8>: str     pc, [sp, #0] ; 0xe58df000 N.B. passes thunk+16; thunkEntry compensates
    0xc <thunk+12>: str     r12, [sp,#4] ; 0xe58dc004
    0x10 <thunk+16>: str     lr, [sp, #12] ; 0xe58de00c
    0x14 <thunk+20>: ldr     r12, [pc, #8] ; 0xe59fc008
    0x18 <thunk+24>: blx     r12 ; 0xe12fff3c
    0x1c <thunk+28>: add     sp, sp, #12 ; 0xe28dd00c
    0x20 <thunk+32>: ldr     pc, [sp], #4!! ; 0xe49df004 ; pop     {pc}
    0x24 <thunk+36>:     .word thunkEntry"
+
+ handle "thunk"
+ type: #uint32_t at:   1 put: 16re1a0c00d;
+ type: #uint32_t at:   5 put: 16re24dd010;
+ type: #uint32_t at:   9 put: 16re58df000; "thunk+16; see above"
+ type: #uint32_t at: 13 put: 16re58dc004;
+ type: #uint32_t at: 17 put: 16re58de00c;
+ type: #uint32_t at: 21 put: 16re59fc008;
+ type: #uint32_t at: 25 put: 16re12fff3c;
+ type: #uint32_t at: 29 put: 16re28dd00c;
+ type: #uint32_t at: 33 put: 16re49df004;
+ type: #pointer at: 37 put: self thunkEntryAddress.!
- self flag: #hidden. "mt: How is the thunk's handle stored to lookup this instance upon callback later?"
- thunk getHandle
- unsignedLongAt:   1 put: 16re1a0c00d;
- unsignedLongAt:   5 put: 16re24dd010;
- unsignedLongAt:   9 put: 16re58df000;
- unsignedLongAt: 13 put: 16re58dc004;
- unsignedLongAt: 17 put: 16re58de00c;
- unsignedLongAt: 21 put: 16re59fc008;
- unsignedLongAt: 25 put: 16re12fff3c;
- unsignedLongAt: 29 put: 16re28dd00c;
- unsignedLongAt: 33 put: 16re49df004;
- pointerAt: 37 put: self thunkEntryAddress length: 4.!

Item was changed:
  ----- Method: FFICallback>>init__ccall_IA32 (in category 'initialization - thunk prepare') -----
  init__ccall_IA32
  <abi: #IA32> <init_ccall>
  "Initialize the receiver with a __ccall thunk.  The thunk calls thunkEntry in the IA32ABI plugin,
  whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c.  thunkEntry is the entry point
  for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the
  thunk (registers and stack) as well as a pointer to the thunk itself.  thunkEntry is as follows:
 
  long
  thunkEntry(void *thunkp, sqIntptr_t *stackp)
 
  thunkEntry then collects the various arguments (thunk, stack pointer) in a VMCallbackContext and
  invokes the callback via invokeCallbackContext:."
 
  "thunk: push   %esp 0x54 0xa1905454
  thunk+01: push   %esp 0x54
  thunk+02: nop   0x90
  thunk+03: mov    $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry
  thunk+08: nop   0x90 0x68909090
  thunk+09: nop   0x90
  thunk+10: nop   0x90
  thunk+11: push   $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk
  thunk+16: call   *%eax 0xff 0xd0 0xc483d0ff
  thunk+18: add    $0xC,%esp 0x83 0xc4 0x0C 0x9090c30C
  thunk+21: ret 0xc3
  thunk+22: nop 0x90
  thunk+23: nop 0x90"
+ handle "thunk"
+ type: #uint32_t at:  1 put: 16rB8905454;
+ type: #pointer at: 5 put: self thunkEntryAddress;
+ type: #uint32_t at:  9 put: 16r68909090;
+ type: #pointer at: 13 put: handle;
+ type: #uint32_t at: 17 put: 16rC483D0FF;
+ type: #uint32_t at: 21 put: 16r9090C30C!
- thunk getHandle
- unsignedLongAt:  1 put: 16rB8905454;
- pointerAt: 5 put: self thunkEntryAddress length: 4;
- unsignedLongAt:  9 put: 16r68909090;
- pointerAt: 13 put: thunk getHandle length: 4;
- unsignedLongAt: 17 put: 16rC483D0FF;
- unsignedLongAt: 21 put: 16r9090C30C!

Item was changed:
  ----- Method: FFICallback>>init__ccall_X64 (in category 'initialization - thunk prepare') -----
  init__ccall_X64
  <abi: #X64> <init_ccall>
  "Initialize the receiver with a __ccall thunk.  The thunk calls thunkEntry in the IA32ABI plugin,
  whose source is in platforms/Cross/plugins/IA32ABI/x64sysvabicc.c.  thunkEntry is the entry point
  for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the
  thunk (registers and stack) as well as a pointer to the thunk itself.  thunkEntry is as follows:
 
  long
  thunkEntry(long a0, long a1, long a2, long a3, long a4, long a5,
             double d0, double d1, double d2, double d3,
             double d4, double d5, double d6, double d7,
             void *thunkp, sqIntptr_t *stackp)
 
  thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point
  register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:."
 
  "thunk+0x0: pushq  %rsp 54
  thunk+0x1: pushq  %rsp 54
  thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. handle
  thunk+0xc: pushq  %rax 50
  thunk+0xd: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address
  thunk+0x17: callq  *%rax ff d0
  thunk+0x19: addq   $0x18, %rsp 48 83 c4 18
  thunk+0x1d: retq c3
  thunk+0x1e: nop 90
  thunk+0x1f: nop 90"
+ handle "thunk"
+ type: #uint32_t at: 1 put: 16rb8485454;
+ type: #pointer at:  5 put: handle;
+ type: #uint32_t at: 13 put: 16r00b84850; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves"
+ type: #pointer at: 16 put: self thunkEntryAddress;
+ type: #uint8_t at: 24 put: 16rff; "alignment"
+ type: #uint32_t at: 25 put: 16rc48348d0;
+ type: #uint32_t at: 29 put: 16r9090c318.!
- thunk getHandle
- unsignedLongAt:  1 put: 16rb8485454;
- pointerAt:  5 put: thunk getHandle length: 8;
- unsignedLongAt: 13 put: 16r00b84850; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves"
- pointerAt: 16 put: self thunkEntryAddress length: 8;
- unsignedByteAt: 24 put: 16rff;
- unsignedLongAt: 25 put: 16rc48348d0;
- unsignedLongAt: 29 put: 16r9090c318.!

Item was changed:
  ----- Method: FFICallback>>init__ccall_X64Win64 (in category 'initialization - thunk prepare') -----
  init__ccall_X64Win64
  <abi: #X64Win64> <init_ccall>
  "Initialize the receiver with a __ccall thunk.  The thunk calls thunkEntry in the IA32ABI plugin,
  whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c.  thunkEntry is the entry point
  for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the
  thunk (registers and stack) as well as a pointer to the thunk itself.  thunkEntry is as follows:
 
  long long
  thunkEntry(long long rcx, long long rdx,
        long long r8, long long r9,
  void *thunkp, sqIntptr_t *stackp)
 
  thunkEntry then collects the various arguments (thunk, integer register arguments, stack pointer)
  in a VMCallbackContext and invokes the callback via invokeCallbackContext:."
 
  "thunk+0x0: pushq  %rsp 54
  thunk+0x1: pushq  %rsp 54
  thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. addressField
  thunk+0xc: pushq  %rax 50
  thunk+0xd: subq   $0x20, %rsp 48 83 c4 e0 (this is addq -20 since the immediate is signed extended)
  thunk+0x11: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address
  thunk+0x1b: callq  *%rax ff d0
  thunk+0x1d: addq   $0x38, %rsp 48 83 c4 38
  thunk+0x21: retq c3
  thunk+0x22: nop 90
  thunk+0x23: nop 90"
+ handle "thunk"
+ type: #uint32_t at:  1 put: 16rb8485454;
+ type: #pointer at:  5 put: handle;
+ type: #uint32_t at: 13 put: 16rc4834850;
+ type: #uint32_t at: 17 put: 16r00b848e0; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves"
+ type: #pointer at: 20 put: self thunkEntryAddress;
+ type: #uint8_t at: 28 put: 16rff; "alignment"
+ type: #uint32_t at: 29 put: 16rc48348d0;
+ type: #uint32_t at: 33 put: 16r9090c338.!
- thunk getHandle
- unsignedLongAt:  1 put: 16rb8485454;
- pointerAt:  5 put: thunk getHandle length: 8;
- unsignedLongAt: 13 put: 16rc4834850;
- unsignedLongAt: 17 put: 16r00b848e0; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves"
- pointerAt: 20 put: self thunkEntryAddress length: 8;
- unsignedByteAt: 28 put: 16rff;
- unsignedLongAt: 29 put: 16rc48348d0;
- unsignedLongAt: 33 put: 16r9090c338.!

Item was changed:
  ----- Method: FFICallback>>init__stdcall_IA32: (in category 'initialization - thunk prepare') -----
  init__stdcall_IA32: numBytes
  <abi: #IA32> <init_stdcall>
  "Initialize the receiver with a __stdcall thunk with numBytes argument bytes. (See #init__ccall_IA32 for more info)"
  "thunk: push   %esp 0x54 0xa1905454
  thunk+01: push   %esp 0x54
  thunk+02: nop   0x90
  thunk+03: mov    $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry
  thunk+08: nop   0x90 0x68909090
  thunk+09: nop   0x90
  thunk+10: nop   0x90
  thunk+11: push   $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk
  thunk+16: call   *%eax 0xff 0xd0 0xc483d0ff
  thunk+18: add    $0xC,%esp 0x83 0xc4 0x0C 0xBYTSc20C
  thunk+21: ret    $bytes 0xc2 0xBY 0xTS"
 
+ handle "thunk"
+ type: #uint32_t at: 1 put: 16rB8905454;
+ type: #pointer at: 5 put: self thunkEntryAddress;
+ type: #uint32_t at: 9 put: 16r68909090;
+ type: #pointer at: 13 put: handle;
+ type: #uint32_t at: 17 put: 16rC483D0FF;
+ type: #uint16_t at: 21 put: 16rC20C;
+ type: #uint16_t at: 23 put: numBytes.!
- thunk getHandle
- unsignedLongAt:  1 put: 16rB8905454;
- pointerAt: 5 put: self thunkEntryAddress length: 4;
- unsignedLongAt:  9 put: 16r68909090;
- pointerAt: 13 put: thunk getHandle length: 4;
- unsignedLongAt:  17 put: 16rC483D0FF;
- unsignedShortAt: 21 put: 16rC20C;
- unsignedShortAt: 23 put: numBytes.!

Item was added:
+ ----- Method: FFICallback>>isManaged (in category 'initialization') -----
+ isManaged
+ "Answer whether the receiver will be free'd automatically when the #evaluableObject is gc'ed."
+
+ ^ evaluableObject class isWeak
+ !

Item was added:
+ ----- Method: FFICallback>>printOn: (in category 'printing') -----
+ printOn: stream
+
+ stream nextPutAll: 'Thunk '.
+ handle printOn: stream.!

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: [FFIPlatformDescription current abi = #IA32])
- ^ (anObject isLarge and: [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>>setResultType:argumentTypes:evaluableObject: (in category 'initialization') -----
  setResultType: anExternalType argumentTypes: moreExternalTypes evaluableObject: blockOrMessage
 
 
+ self evaluableObject: blockOrMessage.
- abi := FFIPlatformDescription current abi.
-
- evaluableObject := blockOrMessage.
  argumentTypes := moreExternalTypes.
  resultType := anExternalType.
 
 
 
 
  "Support for callee pop callbacks (Pascal calling convention such as the Win32 stdcall: convention) are supported using the <calleepops: N> pragma which specifies how many bytes to pop. See http://forum.world.st/Pharo-FFI-on-aarch64-arm64-td5096777.html#a5096786."
+ handle := FFICallbackMemory allocateExecutableBlock getHandle.
+
- thunk := FFICallbackMemory allocateExecutableBlock.
  self init__ccall.
  "self init__stdcall: 0."
  "(method pragmaAt: #calleepops:)
  ifNil: [self init__ccall]
  ifNotNil: [:pragma | self init__stdcall: (pragma argumentAt: 1)]."
 
  "numEvaluatorArgs := (evaluator := method selector) numArgs.
  self addToThunkTable"
+ ThunkToCallbackMap at: handle put: self!
- ThunkToCallbackMap at: thunk getHandle put: self!

Item was changed:
  ----- Method: FFICallback>>thunk (in category 'accessing') -----
  thunk
 
+ ^ self value!
- " self flag: #debugging.
- ^ FFICallbackMemory new
- externalPointer: thunk getHandle;
- yourself"
- ^ thunk!

Item was changed:
  ----- Method: FFICallbackMemory class>>allocateExecutableBlock (in category 'executable pages') -----
  allocateExecutableBlock
 
  | blockSize |
  blockSize := MaxThunkSize.
  AccessProtect critical:
  [ExecutablePages do:
  [:page |
  1 to: page size - blockSize by: blockSize do:
  [:i|
  (page at: i) = 0 ifTrue:
  [page at: i put: 1.
+ ^ page from: i to: i + blockSize - 1]]]].
- ^ page blockAt: i byteSize: blockSize]]]].
  AccessProtect critical: [
  | newPage |
  newPage := ExecutablePages add: self allocateExecutablePage.
+ ^ (newPage from: 1 to: blockSize)
- ^ (newPage blockAt: 1 byteSize: blockSize)
  at: 1 put: 1;
  yourself]!