[squeak-dev] FFI: FFI-Callbacks-mt.24.mcz

commits at source.squeak.org commits at source.squeak.org
Fri May 28 14:50:43 UTC 2021


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



More information about the Squeak-dev mailing list