Packages May 2021

packages@lists.squeakfoundation.org

1 participants
169 discussions

FFI: FFI-CallbacksTests-mt.4.mcz
by commits＠source.squeak.org 28 May '21

28 May '21

Marcel Taeumel uploaded a new version of FFI-CallbacksTests to project FFI: http://source.squeak.org/FFI/FFI-CallbacksTests-mt.4.mcz ==================== Summary ==================== Name: FFI-CallbacksTests-mt.4 Author: mt Time: 28 May 2021, 4:52:03.114735 pm UUID: ae1966df-d4d7-4464-947d-d1e4618d5e7d Ancestors: FFI-CallbacksTests-mt.3 Complements FFI-Callbacks-mt.24 =============== Diff against FFI-CallbacksTests-mt.3 =============== Item was changed: ----- Method: FFICallbackTests>>test08ManagedCallback (in category 'tests') ----- test08ManagedCallback | array unsorted sorted compare callback | unsorted := #(71 66 33 77 16 63 91 54 48 52). sorted := #(16 33 48 52 54 63 66 71 77 91). array := ExternalType int32_t allocate: 10. 1 to: array size do: [:index | array at: index put: (unsorted at: index)]. compare := [:a :b | (a - b) sign]. callback := compare gcSignature: #(int32_t 'int32_t*' 'int32_t*'). lib qsort: array with: array size with: array contentType byteSize with: callback. self assert: (sorted hasEqualElements: array). "Callback no longer needed but still there." Smalltalk garbageCollect. self deny: callback isNull. "Callback depends on the existence of the compare block." self assert: callback + identical: (FFICallback fromEvaluable: compare). - identical: (FFICallback lookupCallbackForEvaluable: compare). compare := nil. Smalltalk garbageCollect. self assert: callback isNull.! Item was changed: ----- Method: FFICallbackTests>>test09UnmanagedCallback (in category 'tests') ----- test09UnmanagedCallback | array unsorted sorted compare callback | unsorted := #(71 66 33 77 16 63 91 54 48 52). sorted := #(16 33 48 52 54 63 66 71 77 91). array := ExternalType int32_t allocate: 10. 1 to: array size do: [:index | array at: index put: (unsorted at: index)]. compare := [:a :b | (a - b) sign]. callback := compare signature: #(int32_t 'int32_t*' 'int32_t*'). lib qsort: array with: array size with: array contentType byteSize with: callback. self assert: (sorted hasEqualElements: array). "Callback no longer needed but still there." Smalltalk garbageCollect. self deny: callback isNull. "Callback independent from the compare block." + self assert: (FFICallback fromEvaluable: compare) isNil. - self assert: (FFICallback lookupCallbackForEvaluable: compare) isNil. compare := nil. Smalltalk garbageCollect. self deny: callback isNull. "Callback needs to be free'd manually." callback free. self assert: callback isNull.!

1 0

FFI: FFI-Kernel-mt.180.mcz
by commits＠source.squeak.org 28 May '21

28 May '21

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.180.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.180 Author: mt Time: 28 May 2021, 4:51:31.579735 pm UUID: 62c92222-8259-4c75-8071-df970bef7363 Ancestors: FFI-Kernel-mt.179 Small bugfix. =============== Diff against FFI-Kernel-mt.179 =============== Item was changed: ----- Method: ExternalStructure>>writer (in category 'accessing') ----- writer + ^ (handle isExternalAddress or: [self isNull]) - ^ handle isExternalAddress ifTrue: [self] ifFalse: [self class fromHandle: (ByteArrayReadWriter on: handle)]!

1 0

FFI: FFI-Callbacks-mt.24.mcz
by commits＠source.squeak.org 28 May '21

28 May '21

Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.24.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.24 Author: mt Time: 28 May 2021, 4:50:42.325735 pm UUID: 306ff3db-86cb-4c2b-8bc2-30505f1b8fda Ancestors: FFI-Callbacks-mt.23 Some clean up and minor refactoring. Since FFICallback is an alias for byte[40], should directly overwrite #fromHandle: to lookup the callback instance from our ThunkToCallbackMap. Deprecations: - FFICallback >> #thunk (obsolete, use FFICallback* type, not void*) - FFICallbackContext >> #thunkp (renamed to #callback) =============== Diff against FFI-Callbacks-mt.23 =============== Item was removed: - ----- Method: FFICallback class>>evaluateCallbackForContext: (in category 'instance lookup') ----- - evaluateCallbackForContext: callbackContext "<FFICallbackContext> ^<Integer> typeCode" - - ^ ThunkToCallbackMap - at: callbackContext thunkp_address - ifPresent: [:callback | callback valueInContext: callbackContext] - ifAbsent: [self error: 'could not locate Callback instance corresponding to thunk address'] - ! Item was added: + ----- Method: FFICallback class>>fromEvaluable: (in category 'instance lookup') ----- + fromEvaluable: evaluable + "For managed callbacks, you can lookup the callback instance through the evaluable object you take care of." + + ^ EvaluableToCallbackMap at: evaluable ifAbsent: [nil]! Item was added: + ----- Method: FFICallback class>>fromHandle: (in category 'instance lookup') ----- + fromHandle: thunkAddress + + ^ ThunkToCallbackMap + at: thunkAddress + ifAbsent: [self error: 'could not locate Callback instance corresponding to thunk address'] + ! Item was removed: - ----- Method: FFICallback class>>getIntWithData:withData: (in category 'examples - signatures') ----- - getIntWithData: anExternalData1 withData: anExternalData2 - " - (FFICallback class >> #getIntWithData:withData:) pragmaAt: #callback: - " - "<callback: int (*)(void* void*)>" - - self shouldNotImplement.! Item was removed: - ----- Method: FFICallback class>>getIntWithData:withData:withInt:withInt: (in category 'examples - signatures') ----- - getIntWithData: anExternalData1 withData: anExternalData2 withInt: anInteger1 withInt: anInteger2 - " - (FFICallback class >> #getIntWithData:withData:withInt:withInt:) pragmaAt: #callback: - " - "<callback: int (*)(void* void* uint32_t intptr_t)>" - - self shouldNotImplement. - - - self flag: #todo: "Ignore macros, const, and '*,' comma" - "<signature: #(int CALLBACK (*)(const LOGFONT *, const TEXTMETRIC *, DWORD, LPARAM))>" - ! Item was removed: - ----- Method: FFICallback class>>getIntWithInt:withString: (in category 'examples - signatures') ----- - getIntWithInt: anInteger withString: aString - " - (FFICallback class >> #getIntWithInt:withString:) pragmaAt: #callback: - " - "<callback: int (*)(int char *)>" - - self shouldNotImplement.! Item was removed: - ----- Method: FFICallback class>>getVoidWithData:withDouble:withDouble: (in category 'examples - signatures') ----- - getVoidWithData: anExternalData withDouble: aFloat withDouble: anotherFloat - " - (FFICallback class >> #getVoidWithData:withDouble:withDouble:) pragmaAt: #callback: - " - "<callback: void (*)(void* double double)>" - - self shouldNotImplement.! Item was removed: - ----- Method: FFICallback class>>lookupCallbackForEvaluable: (in category 'instance lookup') ----- - lookupCallbackForEvaluable: evaluable - "For managed callbacks, you can lookup the callback instance through the evaluable object you take care of." - - ^ EvaluableToCallbackMap at: evaluable ifAbsent: [nil]! Item was added: + ----- Method: FFICallback class>>new (in category 'instance creation') ----- + new + + ^ self basicNew! Item was changed: ----- Method: FFICallback class>>newGC (in category 'instance creation - managed') ----- newGC + ^ self basicNew + beManaged; + yourself! - ^ self new beManaged; yourself! Item was changed: + ----- Method: FFICallback>>beManaged (in category 'initialize-release') ----- - ----- 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 changed: + ----- Method: FFICallback>>evaluateDynamic: (in category 'evaluating') ----- - ----- 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 | stack := callbackContext stackPtr getHandle. stackType := callbackContext stackPtr contentType. stackByteOffset := 1. intArgs := callbackContext intRegArgs. intPos := 0. floatArgs := callbackContext floatRegArgs. floatPos := 0. arguments := Array new: argumentTypes size. 1 to: arguments 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)]. arguments at: argIndex put: data]. ^ self setResult: (self evaluableObject valueWithArguments: arguments) inContext: callbackContext! Item was added: + ----- Method: FFICallback>>evaluator (in category 'accessing') ----- + evaluator + "Answers the one-argument selector that will be performed on the receiver on callback evaluation using a callback context." + + ^ evaluator! Item was added: + ----- Method: FFICallback>>evaluator: (in category 'accessing') ----- + evaluator: aSymbol + "Set the one-argument selector that will be performed on the receiver on callback evaluation using a callback context. Use it to call a custom evaluator added via method extension on the receiver's class." + + self assert: [aSymbol numArgs = 1]. + evaluator := aSymbol.! Item was changed: + ----- Method: FFICallback>>free (in category 'initialize-release') ----- - ----- Method: FFICallback>>free (in category 'initialization') ----- free handle ifNil: [^ self]. ThunkToCallbackMap removeKey: handle. self zeroMemory. handle := nil. ! Item was changed: + ----- Method: FFICallback>>init__ccall (in category 'private') ----- - ----- Method: FFICallback>>init__ccall (in category 'initialization - thunk prepare') ----- init__ccall "Initialize the receiver with a __ccall thunk." FFIPlatformDescription current abiSend: #'init_ccall' to: self.! Item was changed: + ----- Method: FFICallback>>init__ccall_ARM32 (in category 'private') ----- - ----- 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.! Item was changed: + ----- Method: FFICallback>>init__ccall_ARM64 (in category 'private') ----- - ----- Method: FFICallback>>init__ccall_ARM64 (in category 'initialization - thunk prepare') ----- init__ccall_ARM64 <abi: #ARM64> <init_ccall> "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the Alien/IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/arm64abicc.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 x0, long x1, long x2, long x3, long x4, long x5, long x6, long x7, 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:." self shouldBeImplemented "self newCCall"! Item was changed: + ----- Method: FFICallback>>init__ccall_IA32 (in category 'private') ----- - ----- 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! Item was changed: + ----- Method: FFICallback>>init__ccall_X64 (in category 'private') ----- - ----- 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.! Item was changed: + ----- Method: FFICallback>>init__ccall_X64Win64 (in category 'private') ----- - ----- 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.! Item was changed: + ----- Method: FFICallback>>init__stdcall: (in category 'private') ----- - ----- Method: FFICallback>>init__stdcall: (in category 'initialization - thunk prepare') ----- init__stdcall: numBytes "Initialize the receiver with a __stdcall thunk with numBytes argument bytes." FFIPlatformDescription current abiSend: #'init_stdcall' to: self with: numBytes.! Item was changed: + ----- Method: FFICallback>>init__stdcall_IA32: (in category 'private') ----- - ----- 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.! Item was changed: + ----- Method: FFICallback>>isManaged (in category 'testing') ----- - ----- 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 changed: + ----- Method: FFICallback>>primThunkEntryAddress (in category 'private') ----- - ----- Method: FFICallback>>primThunkEntryAddress (in category 'initialization - thunk prepare') ----- primThunkEntryAddress "^<Integer>" "Answer the address of the entry-point for thunk callbacks: IA32: long thunkEntry(void *thunkp, long *stackp); X64: 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); X64Win64 long long thunkEntry(long long rcx, long long rdx, long long r8, long long r9, void *thunkp, sqIntptr_t *stackp); ARM32: 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); ARM64: long long thunkEntry(long x0, long x1, long x2, long x3, long x4, long x5, long x6, long x7, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkpPlus16, sqIntptr_t *stackp); etc. This is the function a callback thunk/trampoline should call to initiate a callback." <primitive: 'primThunkEntryAddress' module: 'IA32ABI' error: errorCode> ^self primitiveFailed! Item was changed: + ----- Method: FFICallback>>setBlock: (in category 'initialize-release') ----- - ----- Method: FFICallback>>setBlock: (in category 'initialization') ----- setBlock: aBlock "We cannot know the signature for an arbitrary block." self shouldNotImplement.! Item was changed: + ----- Method: FFICallback>>setBlock:signature: (in category 'initialize-release') ----- - ----- Method: FFICallback>>setBlock:signature: (in category 'initialization') ----- setBlock: aBlock "<BlockClosure>" signature: signature "<String>" self setTypes: (ExternalType lookupTypes: signature) evaluableObject: aBlock.! Item was changed: + ----- Method: FFICallback>>setMessage: (in category 'initialize-release') ----- - ----- Method: FFICallback>>setMessage: (in category 'initialization') ----- setMessage: aMessageSend "Fetch the argTypes from <callback: ...> pragma in method." | method | self assert: [aMessageSend receiver notNil]. method := aMessageSend receiver class lookupSelector: aMessageSend selector. self setTypes: ((method pragmaAt: #callback:) argumentAt: 1) evaluableObject: aMessageSend.! Item was changed: + ----- Method: FFICallback>>setMessage:signature: (in category 'initialize-release') ----- - ----- Method: FFICallback>>setMessage:signature: (in category 'initialization') ----- setMessage: aMessageSend signature: signature "Override the argTypes from <callback: ...> pragma in method." self assert: [aMessageSend receiver notNil]. self setTypes: (ExternalType lookupTypes: signature) evaluableObject: aMessageSend.! Item was changed: + ----- Method: FFICallback>>setResult:inContext: (in category 'evaluating') ----- - ----- 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]) 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 'private') ----- - ----- Method: FFICallback>>setResultType:argumentTypes:evaluableObject: (in category 'initialization') ----- setResultType: anExternalType argumentTypes: moreExternalTypes evaluableObject: blockOrMessage self 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. 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! Item was changed: + ----- Method: FFICallback>>setTypes:evaluableObject: (in category 'private') ----- - ----- Method: FFICallback>>setTypes:evaluableObject: (in category 'initialization') ----- setTypes: externalTypes evaluableObject: blockOrMessage self setResultType: externalTypes first argumentTypes: externalTypes allButFirst evaluableObject: blockOrMessage.! Item was changed: ----- Method: FFICallback>>thunk (in category 'accessing') ----- thunk + self deprecated: 'Type your callbacks as FFICallback* and use instances of FFICallback directly.'. ^ self value! Item was changed: + ----- Method: FFICallback>>thunkEntryAddress (in category 'private') ----- - ----- Method: FFICallback>>thunkEntryAddress (in category 'initialization - thunk prepare') ----- thunkEntryAddress ^ ExternalAddress fromInteger: self primThunkEntryAddress! Item was changed: + ----- Method: FFICallback>>valueInContext: (in category 'evaluating') ----- - ----- Method: FFICallback>>valueInContext: (in category 'callback') ----- valueInContext: callbackContext "<FFICallbackContext> ^<Integer>" ^ evaluator ifNil: [self evaluateDynamic: callbackContext] ifNotNil: [evaluator perform: callbackContext]! Item was changed: ----- Method: FFICallbackContext class>>fields (in category 'field definition') ----- fields " self defineFields. " ^ #( + (callback 'FFICallback*') "was: thunkp void*" - (thunkp 'FFICallback*') (stackPtr 'byte*') "was: char*" ), (FFIPlatformDescription current abiSend: #fields to: self), #( (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 removed: - ----- Method: FFICallbackContext class>>generateStructureFieldAccessorsFor:startingAt:type: (in category 'field definition - support') ----- - generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset type: type - "Overwritten to also generate a shortcut for thunkp - self defineFields. - " - super - generateStructureFieldAccessorsFor: fieldName - startingAt: byteOffset - type: type. - - fieldName = 'thunkp' ifTrue: [ - | shortcutCode shortcutSelector | - shortcutSelector := fieldName, '_address'. - shortcutCode := '{1}\ ^ handle pointerAt: {2} length: {3}' withCRs - format: { shortcutSelector . byteOffset . type byteSize }. - self maybeCompileAccessor: shortcutCode withSelector: shortcutSelector asSymbol].! Item was added: + ----- Method: FFICallbackContext>>thunkp (in category 'accessing') ----- + thunkp + + self deprecated: 'Use #callback directly'. + ^ self callback! Item was changed: ----- Method: FFICallbackMemory class>>invokeCallbackContext: (in category 'callbacks') ----- invokeCallbackContext: vmCallbackContextAddress "<Integer>" "The low-level entry-point for callbacks sent from the VM/IA32ABI plugin. Evaluate the callback corresponding to the thunk referenced by vmCallbackContextAddress, a pointer to a VMCallbackContext32 or VMCallbackContext64, set up by the VM's thunkEntry routine. Return from the Callback via primSignal:andReturnAs:fromContext:. thisContext's sender is typically an FFI call-out context and is restored as the Process's top context on return. Therefore callbacks run on the process that did the call-out in which the callback occurred." | callbackContext typeCode helper | callbackContext := FFICallbackContext fromHandle: vmCallbackContextAddress. helper := self fromInteger: vmCallbackContextAddress. + [typeCode := callbackContext callback valueInContext: callbackContext] - [typeCode := FFICallback evaluateCallbackForContext: callbackContext] ifCurtailed: [self error: 'attempt to non-local return across a callback']. typeCode ifNil: [typeCode := callbackContext errorResult]. "Now attempt to return from a Callback. This must be done in LIFO order. The IA32ABI plugin maintains a linked list of vmCallbackContextAddresses to record this order. If vmCallbackContextAddress *is* that of the most recent Callback then the return will occur and the primitive will not return here. If vmCallbackContextAddress *is not* that of the most recent Callback the primitive will answer false, in which case this process waits on the lifoCallbackSemaphore which will be signalled by some other attempted Callback return. In any case (successful return from callback or answering false here), the primtive signals the first process waiting on the semaphore (which is after this one if this one was waiting), allowing the next process to attempt to return, and so on. Hence all nested callbacks should eventually return, and in the right order." [helper primSignal: LifoCallbackSemaphore andReturnAs: typeCode fromContext: thisContext] whileFalse: [LifoCallbackSemaphore wait]!

1 0

FFI: FFI-Callbacks-mt.23.mcz
by commits＠source.squeak.org 28 May '21

28 May '21

Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.23.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.23 Author: mt Time: 28 May 2021, 12:54:05.2767 pm UUID: 5829377d-876a-5747-a754-3d4c5f9f3257 Ancestors: FFI-Callbacks-mt.22 Minor speed-up for callback evaluation. =============== Diff against FFI-Callbacks-mt.22 =============== Item was changed: ----- Method: FFICallback class>>evaluateCallbackForContext: (in category 'instance lookup') ----- evaluateCallbackForContext: callbackContext "<FFICallbackContext> ^<Integer> typeCode" ^ ThunkToCallbackMap + at: callbackContext thunkp_address - at: callbackContext thunkp getHandle ifPresent: [:callback | callback valueInContext: callbackContext] ifAbsent: [self error: 'could not locate Callback instance corresponding to thunk address'] ! Item was changed: ----- Method: FFICallbackContext class>>fields (in category 'field definition') ----- fields " self defineFields. " ^ #( + (thunkp 'FFICallback*') - (thunkp 'void*') (stackPtr 'byte*') "was: char*" ), (FFIPlatformDescription current abiSend: #fields to: self), #( (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>>generateStructureFieldAccessorsFor:startingAt:type: (in category 'field definition - support') ----- + generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset type: type + "Overwritten to also generate a shortcut for thunkp + self defineFields. + " + super + generateStructureFieldAccessorsFor: fieldName + startingAt: byteOffset + type: type. + + fieldName = 'thunkp' ifTrue: [ + | shortcutCode shortcutSelector | + shortcutSelector := fieldName, '_address'. + shortcutCode := '{1}\ ^ handle pointerAt: {2} length: {3}' withCRs + format: { shortcutSelector . byteOffset . type byteSize }. + self maybeCompileAccessor: shortcutCode withSelector: shortcutSelector asSymbol].!

1 0

FFI: FFI-Kernel-mt.179.mcz
by commits＠source.squeak.org 28 May '21

28 May '21

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.179.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.179 Author: mt Time: 28 May 2021, 12:52:03.4977 pm UUID: c02c8260-e6ed-4845-a202-ddf2cd193be0 Ancestors: FFI-Kernel-mt.178 Adds #isStringType check to speed up ExternalData. Fixes access and code generation for array types and pointer-to-array types. =============== Diff against FFI-Kernel-mt.178 =============== Item was changed: ----- Method: ExternalArrayType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset + | resultHandle | + resultHandle := handle structAt: byteOffset length: self byteSize. + ^ self isTypeAlias + ifTrue: [referentClass fromHandle: resultHandle] + ifFalse: [ExternalData fromHandle: resultHandle type: self]! - ^ ExternalData - fromHandle: (handle structAt: byteOffset length: self byteSize) - type: self! Item was added: + ----- Method: ExternalArrayType>>isStringType (in category 'testing - special') ----- + isStringType + + ^ false! Item was changed: ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset + ^ self isTypeAlias + ifTrue: [ + '^ {1} fromHandle: (handle structAt: {1} length: {2})' + format: { + referentClass name. + byteOffset. + self byteSize}] + ifFalse: [ + '^ ExternalData fromHandle: (handle structAt: {1} length: {2}) type: {3}' + format: { + byteOffset. + self byteSize. + self storeStringForField}]! - ^ '^ ExternalData fromHandle: (handle structAt: {1} length: {2}) type: {3}' - format: { - byteOffset. - self byteSize. - self storeStringForField}! Item was added: + ----- Method: ExternalAtomicType>>isStringType (in category 'testing - special') ----- + isStringType + + ^ false! Item was changed: ----- Method: ExternalData>>setContentType: (in category 'initialize-release') ----- setContentType: externalType + | newContentType | + (newContentType := externalType) isStringType ifTrue: [ + newContentType := newContentType asNonPointerType]. - externalType = ExternalType string ifTrue: [ - ^ self setContentType: externalType asNonPointerType]. + self setType: (newContentType isVoid + ifTrue: [newContentType "Size gets lost for void."] + ifFalse: [newContentType asArrayType: self size]).! - self setType: (externalType isVoid - ifTrue: [externalType "Size gets lost for void."] - ifFalse: [externalType asArrayType: self size]).! Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- setType: externalType "Private. Set the type used to derive content and container types. If you want to change the content type later, use #setContentType:." + | newType isVoid | + (newType := externalType) isStringType ifTrue: [ + newType := newType asNonPointerType]. - externalType = ExternalType string ifTrue: [ - ^ self setType: externalType asNonPointerType]. + (isVoid := newType isVoid) ifTrue: [ + newType := newType asPointerType]. - externalType isVoid ifTrue: [ - ^ self setType: externalType asPointerType]. + (newType isArrayType or: [isVoid or: [newType asNonPointerType isVoid]]) + ifTrue: [type := newType "array type or void*"] + ifFalse: [type := (newType asArrayType: nil)]. - (externalType isArrayType or: [externalType asNonPointerType isVoid]) - ifTrue: [type := externalType "array type or void*"] - ifFalse: [type := (externalType asArrayType: nil)]. contentType := nil.! Item was changed: ----- Method: ExternalPointerType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset + | referentClassToUse | + referentClassToUse := self isPointerTypeForArray + ifFalse: [referentClass] + ifTrue: [self asNonPointerType isTypeAlias + ifTrue: [self asNonPointerType referentClass] ifFalse: [nil]]. + ^ referentClassToUse - ^ referentClass ifNotNil: [ + referentClassToUse fromHandle: (handle pointerAt: byteOffset length: self byteSize)] - referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)] ifNil: [ ExternalData fromHandle: (handle pointerAt: byteOffset length: self byteSize) type: self asNonPointerType "content type"]! Item was changed: ----- Method: ExternalPointerType>>isPointerTypeForArray (in category 'testing') ----- isPointerTypeForArray + "referentClass is currently nil for pointer-to-array types. All operations on referentClass should check this to then use the referentClass from the non-pointer type. Might be changed once array information are encoded in the headerWord." + - ^ self asNonPointerType isArrayType! Item was added: + ----- Method: ExternalPointerType>>isStringType (in category 'testing - special') ----- + isStringType + "If pointer to atomic, the atomic type is encoded directly in the headerWord. Might change in the future; use #asNonPointerType in that case." + + ^ self atomicType = FFITypeUnsignedChar! Item was changed: ----- Method: ExternalPointerType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset + + | referentClassToUse | + referentClassToUse := self isPointerTypeForArray + ifFalse: [referentClass] + ifTrue: [self asNonPointerType isTypeAlias + ifTrue: [self asNonPointerType referentClass] ifFalse: [nil]]. - " - ExternalStructure defineAllFields. - " ^ '^ {1} fromHandle: (handle pointerAt: {2} length: {3}){4}' format: { + (referentClassToUse ifNil: [ExternalData]) name. - (referentClass ifNil: [ExternalData]) name. byteOffset. self byteSize. + referentClassToUse ifNotNil: [''] ifNil: [ - referentClass ifNotNil: [''] ifNil: [ ' type: ', self asNonPointerType "content type" storeStringForField]}! Item was added: + ----- Method: ExternalStructureType>>isStringType (in category 'testing - special') ----- + isStringType + + ^ false! Item was added: + ----- Method: ExternalType>>isStringType (in category 'testing - special') ----- + isStringType + + | type | + type := self atomicType. + ^ type = FFITypeUnsignedChar and: [self isPointerType]!

1 0

FFI: FFI-CallbacksTests-mt.3.mcz
by commits＠source.squeak.org 28 May '21

28 May '21

Marcel Taeumel uploaded a new version of FFI-CallbacksTests to project FFI: http://source.squeak.org/FFI/FFI-CallbacksTests-mt.3.mcz ==================== Summary ==================== Name: FFI-CallbacksTests-mt.3 Author: mt Time: 28 May 2021, 11:16:30.0737 am UUID: c7b02b69-cc7d-5148-af00-423356b5bd8c Ancestors: FFI-CallbacksTests-mt.2 Complements FFI-Callbacks-mt.22 =============== Diff against FFI-CallbacksTests-mt.2 =============== Item was changed: ----- Method: FFICallbackTests>>expectedFailures (in category 'failures') ----- expectedFailures ^ #( + test02SortArrayOfDoublesRaw "Coercing checks are too aggressive or just wrong." - test02SortArrayOfDoublesRaw "Checked on 32-bit. Coercing checks are too aggressive or just wrong." test04SortArrayOfIntegersRaw "See above." )! Item was changed: ----- Method: FFICallbackTests>>test08ManagedCallback (in category 'tests') ----- test08ManagedCallback | array unsorted sorted compare callback | unsorted := #(71 66 33 77 16 63 91 54 48 52). sorted := #(16 33 48 52 54 63 66 71 77 91). array := ExternalType int32_t allocate: 10. 1 to: array size do: [:index | array at: index put: (unsorted at: index)]. compare := [:a :b | (a - b) sign]. + callback := compare gcSignature: #(int32_t 'int32_t*' 'int32_t*'). - callback := FFICallback newGC. - callback - setBlock: compare - signature: #(int32_t 'int32_t*' 'int32_t*'). lib qsort: array with: array size with: array contentType byteSize with: callback. self assert: (sorted hasEqualElements: array). + "Callback no longer needed but still there." Smalltalk garbageCollect. self deny: callback isNull. + + "Callback depends on the existence of the compare block." + self + assert: callback + identical: (FFICallback lookupCallbackForEvaluable: compare). compare := nil. Smalltalk garbageCollect. self assert: callback isNull.! Item was added: + ----- Method: FFICallbackTests>>test09UnmanagedCallback (in category 'tests') ----- + test09UnmanagedCallback + + | array unsorted sorted compare callback | + unsorted := #(71 66 33 77 16 63 91 54 48 52). + sorted := #(16 33 48 52 54 63 66 71 77 91). + + array := ExternalType int32_t allocate: 10. + 1 to: array size do: [:index | + array at: index put: (unsorted at: index)]. + + compare := [:a :b | (a - b) sign]. + callback := compare signature: #(int32_t 'int32_t*' 'int32_t*'). + + lib + qsort: array + with: array size + with: array contentType byteSize + with: callback. + self assert: (sorted hasEqualElements: array). + + "Callback no longer needed but still there." + Smalltalk garbageCollect. + self deny: callback isNull. + + "Callback independent from the compare block." + self assert: (FFICallback lookupCallbackForEvaluable: compare) isNil. + compare := nil. + Smalltalk garbageCollect. + self deny: callback isNull. + + "Callback needs to be free'd manually." + callback free. + self assert: callback isNull.!

1 0

FFI: FFI-Callbacks-mt.22.mcz
by commits＠source.squeak.org 28 May '21

28 May '21

Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.22.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.22 Author: mt Time: 28 May 2021, 11:15:38.8907 am UUID: ed814637-f5b8-294e-8838-559202cd3716 Ancestors: FFI-Callbacks-mt.21 Clean up and document GC interface for FFI callbacks. Use the managed version for bsearch and qsort because both are short-living. =============== Diff against FFI-Callbacks-mt.21 =============== Item was added: + ----- Method: BlockClosure>>gcSignature: (in category '*FFI-Callbacks') ----- + gcSignature: signature + + ^ FFICallback + gcSignature: signature + block: self! Item was changed: ----- Method: CStandardLibrary>>bsearch:in:compare: (in category '*FFI-Callbacks') ----- bsearch: key in: array compare: block + | result | + result := self - | result callback | - [result := self bsearch: key with: array with: array size with: array contentType byteSize + with: (self compare: array contentType through: block). - with: (callback := self compare: array contentType through: block). - ] ensure: [callback free]. result setContentType: array contentType; setSize: 1. ^ result! Item was changed: ----- Method: CStandardLibrary>>compare:through: (in category '*FFI-Callbacks') ----- compare: contentType through: evaluable "Answers a callback for comparing the given contentType through the given evaluable, i.e., messages sends or blocks. Supports pointer types as contentType." <callback: int32_t (*)(const void*, const void*)> | argType signature | self assert: [evaluable numArgs = 2]. argType := contentType isPointerType ifTrue: [(contentType asArrayType: nil)] ifFalse: [contentType]. signature := ((thisContext method pragmaAt: #callback:) argumentAt: 1) copy. signature at: 2 put: argType asPointerType. signature at: 3 put: argType asPointerType. + ^ evaluable gcSignature: signature! - ^ evaluable signature: signature! Item was changed: ----- Method: CStandardLibrary>>qsort:compare: (in category '*FFI-Callbacks') ----- qsort: array compare: block + + ^ self - - | callback result | - [result := self qsort: array with: array size with: array contentType byteSize + with: (self compare: array contentType through: block)! - with: (callback := self compare: array contentType through: block). - ] ensure: [callback free]. - ^ result! Item was added: + ----- Method: FFICallback class>>gcMessage: (in category 'instance creation - managed') ----- + gcMessage: message + "Like #message: but automatically free'd when message gets garbage collected. Thus, the callback holds only weakly to the message and the sender MUST take care of not loosing the reference as long as needed. BEWARE that any external library using a free'd NULL callback will most likely SEGFAULT." + + ^ self newGC + setMessage: message; + yourself + ! Item was added: + ----- Method: FFICallback class>>gcSignature:block: (in category 'instance creation - managed') ----- + gcSignature: signature "<String>" block: aBlock "<BlockClosure> ^<FFICallback>" + "Like #signature:block: but automatically free'd when aBlock gets garbage collected. Thus, the callback holds only weakly to aBlock and the sender MUST take care of not loosing the reference as long as needed. BEWARE that any external library using a free'd NULL callback will most likely SEGFAULT." + + ^ self newGC + setBlock: aBlock + signature: signature; + yourself! Item was added: + ----- Method: FFICallback class>>gcSignature:message: (in category 'instance creation - managed') ----- + gcSignature: signature "<String>" message: message "<MessageSend> ^<FFICallback>" + "Like #signature:message: but automatically free'd when message gets garbage collected. Thus, the callback holds only weakly to the message and the sender MUST take care of not loosing the reference as long as needed. BEWARE that any external library using a free'd NULL callback will most likely SEGFAULT." + + ^ self newGC + setMessage: message + signature: signature; + yourself! Item was added: + ----- Method: FFICallback class>>lookupCallbackForEvaluable: (in category 'instance lookup') ----- + lookupCallbackForEvaluable: evaluable + "For managed callbacks, you can lookup the callback instance through the evaluable object you take care of." + + ^ EvaluableToCallbackMap at: evaluable ifAbsent: [nil]! Item was changed: ----- Method: FFICallback class>>message: (in category 'instance creation') ----- message: message "<MessageSend> ^<FFICallback>" + "Answers a new FFI callback for the given message (send). The callback signature will be looked up in the actual method's callback pragma." + ^ self new + setMessage: message; + yourself - setMessage: message ! Item was changed: + ----- Method: FFICallback class>>newGC (in category 'instance creation - managed') ----- - ----- Method: FFICallback class>>newGC (in category 'instance creation') ----- newGC ^ self new beManaged; yourself! Item was changed: ----- Method: FFICallback class>>signature:block: (in category 'instance creation') ----- + signature: signature "<String | Array>" block: aBlock "<BlockClosure> ^<FFICallback>" + "Answers a new FFI callback for the given signature and block. The signature can have the form of a callback pragma, a list of type names, or a list of actual types. The first type is always the return type." + - signature: signature "<String>" block: aBlock "<BlockClosure> ^<FFICallback>" ^ self new setBlock: aBlock + signature: signature; + yourself! - signature: signature! Item was changed: ----- Method: FFICallback class>>signature:message: (in category 'instance creation') ----- + signature: signature "<String | Array>" message: message "<MessageSend> ^<FFICallback>" + "Answers a new FFI callback for the given signature and message (send). The signature can have the form of a callback pragma, a list of type names, or a list of actual types. The first type is always the return type." + - signature: signature "<String>" message: message "<MessageSend> ^<FFICallback>" ^ self new setMessage: message + signature: signature; + yourself! - signature: signature!

1 0

FFI: FFI-CallbacksTests-mt.2.mcz
by commits＠source.squeak.org 27 May '21

27 May '21

Marcel Taeumel uploaded a new version of FFI-CallbacksTests to project FFI: http://source.squeak.org/FFI/FFI-CallbacksTests-mt.2.mcz ==================== Summary ==================== Name: FFI-CallbacksTests-mt.2 Author: mt Time: 27 May 2021, 5:04:41.572121 pm UUID: 0dd9372f-59fc-bd4e-8fd7-9836d999426e Ancestors: FFI-CallbacksTests-mt.1 Complements FFI-Callbacks-mt.21 =============== Diff against FFI-CallbacksTests-mt.1 =============== Item was added: + ----- Method: FFICallbackTests>>test08ManagedCallback (in category 'tests') ----- + test08ManagedCallback + + | array unsorted sorted compare callback | + unsorted := #(71 66 33 77 16 63 91 54 48 52). + sorted := #(16 33 48 52 54 63 66 71 77 91). + + array := ExternalType int32_t allocate: 10. + 1 to: array size do: [:index | + array at: index put: (unsorted at: index)]. + + compare := [:a :b | (a - b) sign]. + callback := FFICallback newGC. + callback + setBlock: compare + signature: #(int32_t 'int32_t*' 'int32_t*'). + + lib + qsort: array + with: array size + with: array contentType byteSize + with: callback. + self assert: (sorted hasEqualElements: array). + + Smalltalk garbageCollect. + self deny: callback isNull. + compare := nil. + Smalltalk garbageCollect. + self assert: callback isNull.!

1 0

FFI: FFI-Callbacks-mt.21.mcz
by commits＠source.squeak.org 27 May '21

27 May '21

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]!

1 0

FFI: FFI-Pools-mt.31.mcz
by commits＠source.squeak.org 27 May '21

27 May '21

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.31.mcz ==================== Summary ==================== Name: FFI-Pools-mt.31 Author: mt Time: 27 May 2021, 5:00:18.391121 pm UUID: d8a5ee3f-5f1e-4849-adfe-f13c2af13d19 Ancestors: FFI-Pools-mt.30 Remove instVar shadow. =============== Diff against FFI-Pools-mt.30 =============== Item was changed: ----- Method: ExternalTypePool class>>assuredPoolVarNameFor: (in category 'housekeeping') ----- assuredPoolVarNameFor: type + | poolVarName | + poolVarName := (self poolVarNameFor: type) asSymbol. + (self classPool includesKey: poolVarName) + ifFalse: [self addClassVarName: poolVarName]. + self classPool at: poolVarName put: type. + ^ poolVarName! - | name | - name := (self poolVarNameFor: type) asSymbol. - (self classPool includesKey: name) - ifFalse: [self addClassVarName: name]. - self classPool at: name put: type. - ^ name!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages May 2021