Adding usage of the new primitives that are faster.

src/ThreadedFFI-Tests/TFBasicTypeMarshallingInCallbacksTest.class.st

@@ -30,7 +30,7 @@ TFBasicTypeMarshallingInCallbacksTest >> call: typeName type: type value: aValue
 	| callback fun received |
 
 	callback := TFCallback 
-		forCallback: [ :a | received := a ] 
+		forCallback: [ :a | received := a. ] 
 		parameters: { type } 
 		returnType: TFBasicType void
 		runner: runner.

src/ThreadedFFI-Tests/TFBasicTypeSizeTest.class.st

@@ -20,7 +20,7 @@ TFBasicTypeSizeTest >> externalFunction: name [
 		moduleName: self libraryPath
 		definition: (TFFunctionDefinition
 			parameterTypes: {}
-			returnType: TFBasicType uint)
+			returnType: TFBasicType sizeT)
 
 ]
 

src/ThreadedFFI-Tests/TFCallbacksTest.class.st

@@ -107,16 +107,16 @@ TFCallbacksTest >> testReentrantCalloutsDuringCallback [
 		name: 'singleCallToCallback'
 		moduleName: self libraryPath
 		definition: (TFFunctionDefinition
-			parameterTypes: {TFBasicType pointer. TFBasicType sint}
-			returnType: TFBasicType sint).
+			parameterTypes: {TFBasicType pointer. TFBasicType sint32}
+			returnType: TFBasicType sint32).
 
 	callback := TFCallback 
 		forCallback: [ :times | 
 			times = 7
 				ifTrue: [ times ]
 				ifFalse: [ runner invokeFunction: fun withArguments: {callback getHandle. times + 1} ] ] 
-		parameters: { TFBasicType sint. } 
-		returnType: TFBasicType sint
+		parameters: { TFBasicType sint32. } 
+		returnType: TFBasicType sint32
 		runner: runner.
 
 	returnValue := runner invokeFunction: fun withArguments: {callback getHandle. 0}.

src/ThreadedFFI-Tests/TFStructTest.class.st

@@ -73,7 +73,7 @@ TFStructTest >> testReturnsAnStruct [
 		parameterTypes:	{TFBasicType sint. TFBasicType sint}
 		returnType: pointType.
 
-	aPoint := runner invokeFunction: fun withArguments: #(1 5).
+	aPoint := TFPointTestStruct fromHandle: (runner invokeFunction: fun withArguments: #(1 5)).
 
 	self assert: aPoint x equals: 1.
 	self assert: aPoint y equals: 5.	

src/ThreadedFFI-Tests/TFTestCase.class.st

@@ -11,7 +11,7 @@ Class {
 TFTestCase class >> testParameters [ 
 
 	^ ParametrizedTestMatrix new
-		forSelector: #runner addOptions: { [ TFWorker named: 'fortest' ]. [ TFSameThreadRunner uniqueInstance ] }
+		forSelector: #runner addOptions: { [ TFSameThreadRunner uniqueInstance ]. [ TFWorker named: 'fortest' ]. }
 ]
 
 { #category : #accessing }

src/ThreadedFFI-UFFI-Tests/TFUFFIStructuresTest.class.st

@@ -31,7 +31,7 @@ TFUFFIStructuresTest >> passingLongStructByReference: st b: b c: c d: d [
 { #category : #'as yet unclassified' }
 TFUFFIStructuresTest >> passingNestedStructByCopy: st a: a y: y [
 
-	^ self ffiCall: #(int passingNestedStruct(TFNestedTestStruct st, uint8 a, double y))
+	^ self ffiCall: #(int passingNestedStruct(TFNestedTestStruct st, char a, double y))
 ]
 
 { #category : #'as yet unclassified' }

src/ThreadedFFI-UFFI/Behavior.extension.st

@@ -14,12 +14,10 @@ Behavior >> basicNewPinned [
 Behavior >> basicNewPinned: requestedSize [
 
 	<primitive: 599 error: ec>
-
-	self primitiveFailed.
-
-"	^ (self basicNew: requestedSize)
-			pinInMemory;
-			yourself"
+
+	^ (self basicNew: requestedSize)
+		pinInMemory;
+		yourself
 ]
 
 { #category : #'*ThreadedFFI-UFFI' }

src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st

@@ -22,6 +22,7 @@ TFCalloutMethodBuilder >> generateFFICallout: builder spec: functionSpec [
 	| properties |
 
 	"Copy the properties of the old method"
+
 	sender methodProperties ifNotNil: [ 
 		properties := sender methodProperties copy.
 		properties method: nil.
@@ -40,24 +41,37 @@ TFCalloutMethodBuilder >> generateFFICallout: builder spec: functionSpec [
 
 	"Obtain the library to use"
 	builder 
-		pushReceiver;
-		send: #ffiLibrary;
-		send: #uniqueInstance.
-
-	"Obtain the runner to use."
-	builder send: #runner.
-
+		pushLiteral: (sender receiver ffiLibrary uniqueInstance runner).
+
 	"save ffi call as literal"
 	builder pushLiteral: (self createFFICalloutLiteralFromSpec: functionSpec).
 	"iterate arguments in order (in the function) to create the function call"
-	functionSpec arguments do: [ :each | each emitArgument: builder context: sender inCallout: self requestor ].
+
+	functionSpec arguments 
+		do: [ :each | 
+			each emitArgument: builder context: sender inCallout: self requestor.
+			each resolvedType tfExternalTypeWithArity emitMarshallToPrimitive: builder ].
+
 	"create the array"
 	builder pushConsArray: functionSpec arguments size.
+	builder addTemp: #argumentsArray.
+	builder storeTemp: #argumentsArray.
+
 	"send call and store into result"
 	builder send: #invokeFunction:withArguments:.
+
+	functionSpec arguments withIndexDo: [ :each :index| 
+		each emitReturnArgument: builder context: sender.
+		each resolvedType tfExternalTypeWithArity 
+			emitFreeIfNeededOfIndex: index
+			argumentsArrayTempName: #argumentsArray
+			withBuilder: builder  ].
+
+	"Additional marshall in the case of TFFI"	
+	functionSpec returnType resolvedType tfExternalTypeWithArity emitMarshallFromPrimitive: builder.
+
+	"convert in case return type needs it. And return reseult"	
 
-	functionSpec arguments do: [ :each | each emitReturnArgument: builder context: sender ].
-	"convert in case return type needs it. And return reseult"
 	^ functionSpec returnType
 		emitReturn: builder
 		resultTempVar: #result

src/ThreadedFFI/PointerUtils.class.st

@@ -7,7 +7,7 @@ Class {
 { #category : #private }
 PointerUtils class >> objectForOop: anAddressAsInteger [
 
-	^ self primObjectForOop: anAddressAsInteger
+	^ self primObjectForOop: anAddressAsInteger asInteger
 ]
 
 { #category : #private }

src/ThreadedFFI/TFAbstractType.class.st

@@ -10,6 +10,18 @@ TFAbstractType >> byteSize [
 	^ self subclassResponsibility
 ]
 
+{ #category : #reading }
+TFAbstractType >> callbackReadValue: anExternalAddress [
+
+	^ self readValue: anExternalAddress offset: 1
+]
+
+{ #category : #writing }
+TFAbstractType >> callbackWrite: aNumber into: anExternalAddress [
+
+	self write: aNumber into: anExternalAddress
+]
+
 { #category : #accessing }
 TFAbstractType >> isValid [ 
 

src/ThreadedFFI/TFBasicType.class.st

@@ -87,8 +87,8 @@ TFBasicType class >> createBasicTypes [
 			"Aliased types, these depends of the architecture"
 			POINTER := self newPointerTypeName: #pointer code: 12.
 
-			UCHAR := self newIntTypeName: #uchar code: 13 signed: false.
-			SCHAR := self newIntTypeName: #schar code: 14 signed: true.
+			UCHAR := self newCharTypeName: #uchar code: 13 signed: false.
+			SCHAR := self newCharTypeName: #schar code: 14 signed: true.
 
 			USHORT := self newIntTypeName: #ushort code: 15 signed: false.
 			SSHORT := self newIntTypeName: #sshort code: 16 signed: true.
@@ -118,6 +118,16 @@ TFBasicType class >> initialize [
 	TypeMap := (Types collect: [ :t | t typeName -> t ]) asDictionary.
 ]
 
+{ #category : #'instance creation' }
+TFBasicType class >> newCharTypeName: aName code: aCode signed: signed [
+
+	^ TFCharType new 
+		typeName: aName;
+		typeCode: aCode;
+		signed: signed;
+		yourself
+]
+
 { #category : #'instance creation' }
 TFBasicType class >> newDoubleName: aName code: aCode [
 
@@ -199,6 +209,14 @@ TFBasicType class >> sint8 [
 	^ SINT8
 ]
 
+{ #category : #accessing }
+TFBasicType class >> sizeT [
+
+	^ Smalltalk wordSize = 8
+		ifTrue: [ self uint64 ]
+		ifFalse: [ self uint32 ]
+]
+
 { #category : #accessing }
 TFBasicType class >> slong [
 	^SLONG
@@ -277,6 +295,22 @@ TFBasicType >> byteSize [
 	^ byteSize ifNil: [ self primitiveByteSize ]
 ]
 
+{ #category : #marshalling }
+TFBasicType >> emitFreeIfNeededOfIndex: argIndex argumentsArrayTempName: argumentsArrayTempName withBuilder: anIRBuilder [ 	
+]
+
+{ #category : #marshalling }
+TFBasicType >> emitMarshallFromPrimitive: aBuilder [
+
+
+]
+
+{ #category : #marshalling }
+TFBasicType >> emitMarshallToPrimitive: builder [
+
+	"Nothing to do in this case"
+]
+
 { #category : #writing }
 TFBasicType >> freeValueIfNeeded: aValue [ 
 

src/ThreadedFFI/TFBooleanType.class.st

@@ -10,17 +10,41 @@ TFBooleanType >> basicType [
 	^ TFBasicType uint8
 ]
 
+{ #category : #'reading-writing' }
+TFBooleanType >> callbackReadValue: anExternalAddress [
+
+	^ (self readValue: anExternalAddress) ~= 0
+]
+
+{ #category : #marshalling }
+TFBooleanType >> emitMarshallFromPrimitive: anIRBuilder [ 
+
+	anIRBuilder pushLiteral: 0.
+	anIRBuilder send: #~=.
+]
+
+{ #category : #marshalling }
+TFBooleanType >> emitMarshallToPrimitive: builder [ 
+
+	builder pushLiteral: true.
+	builder send: #==.
+	builder jumpAheadTo: #falseLabel if: false.
+	builder pushLiteral: 1.
+	builder jumpAheadTo: #endLabel.	
+	builder jumpAheadTarget: #falseLabel.
+	builder pushLiteral: 0.
+	builder jumpAheadTarget: #endLabel.
+
+]
+
 { #category : #'reading-writing' }
 TFBooleanType >> readValue: anExternalAddress [
-	"
-	  0 = false
-	~~0 = true
-	"
-	^ (self basicType readValue: anExternalAddress) ~~ 0
+	" Returns 0 or 1, the conversion to false or true is done in the generated method"
+	^ self basicType readValue: anExternalAddress
 ]
 
 { #category : #'reading-writing' }
-TFBooleanType >> write: aBoolean into: aCollection [ 
+TFBooleanType >> write: aSmallInteger into: aCollection [ 
 
-	self basicType write: aBoolean asBit into: aCollection
+	self basicType write: aSmallInteger into: aCollection
 ]

src/ThreadedFFI/TFCallbackInvocation.class.st

@@ -15,7 +15,7 @@ TFCallbackInvocation >> arguments [
 	argumentsAddress := self argumentsAddress.
 
 	^ parameterTypes withIndexCollect: [ :type :idx |
-		type readValue: (argumentsAddress pointerAt: 1 + ((idx - 1) * Smalltalk wordSize)) ]
+		type callbackReadValue: (argumentsAddress pointerAt: 1 + ((idx - 1) * Smalltalk wordSize)) ]
 ]
 
 { #category : #accessing }
@@ -40,7 +40,7 @@ TFCallbackInvocation >> callback: aTFCallback [
 { #category : #accessing }
 TFCallbackInvocation >> callbackData [
 
-	^ TFBasicType pointer readValue: handle
+	^ TFBasicType pointer callbackReadValue: handle
 ]
 
 { #category : #operations }
@@ -95,6 +95,6 @@ TFCallbackInvocation >> runner [
 TFCallbackInvocation >> writeReturnValue: aValue [
 
 	self callback returnType 
-		write: aValue 
+		callbackWrite: aValue 
 		into: self returnHolder
 ]

src/ThreadedFFI/TFCallbackSameProcessRunStrategy.class.st

@@ -1,6 +1,6 @@
 Class {
 	#name : #TFCallbackSameProcessRunStrategy,
-	#superclass : #Object,
+	#superclass : #TFCallbackForkRunStrategy,
 	#instVars : [
 		'callbackProcess'
 	],
@@ -22,31 +22,36 @@ TFCallbackSameProcessRunStrategy class >> uniqueInstance [
 	^ Instance ifNil: [ Instance := self basicNew initialize; yourself]
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #private }
 TFCallbackSameProcessRunStrategy >> callbackProcess [
 
 	(callbackProcess isNotNil and: [ callbackProcess isTerminated not ])
 		ifTrue: [ ^ callbackProcess ].
 
 	callbackProcess := [ self waitForever ] newProcess.
 	callbackProcess priority: Processor highIOPriority - 1.
+	callbackProcess resume.
 	^ callbackProcess.
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #private }
 TFCallbackSameProcessRunStrategy >> doExecuteCallback: aCallbackInvocation on: aTFRunner [
 
 	aTFRunner handleExceptionDuring: [ aCallbackInvocation execute ]
 ]
 
-{ #category : #'callback execution' }
+{ #category : #executing }
 TFCallbackSameProcessRunStrategy >> executeCallback: aCallbackInvocation on: aTFRunner [
 
 	| process newContext methodToUse |
 	process := self callbackProcess.
+
+	"I will reuse the same process if it is not used already. Reentrant callbacks should fork a new process"
+	(process isSuspended and: [ process suspendedContext compiledCode method = (self class >> #waitForever) ])
+		ifFalse: [ ^ super executeCallback: aCallbackInvocation on: aTFRunner ].	
+
 	methodToUse := self class >> #doExecuteCallback:on:.
 
-	process suspend.
 	newContext := Context 
 		sender: process suspendedContext 
 		receiver: self 
@@ -57,8 +62,8 @@ TFCallbackSameProcessRunStrategy >> executeCallback: aCallbackInvocation on: aTF
 	process resume
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #private }
 TFCallbackSameProcessRunStrategy >> waitForever [
 
-	[ true ] whileTrue: [ 10 seconds wait ]
+	[ true ] whileTrue: [ Processor activeProcess suspend ]
 ]

src/ThreadedFFI/TFCharType.class.st

@@ -0,0 +1,11 @@
+Class {
+	#name : #TFCharType,
+	#superclass : #TFIntType,
+	#category : #'ThreadedFFI-Types'
+}
+
+{ #category : #marshalling }
+TFCharType >> emitMarshallToPrimitive: builder [
+
+	builder send: #asInteger
+]