Updating changes that have been done in the image.

src/ThreadedFFI-Tests/TFPoolTest.class.st

@@ -8,7 +8,7 @@ Class {
 TFPoolTest >> testGrowBy [
 	| pool |
 
-	pool := TFPool newProvider: [ 1 ] size: 5.
+	pool := TFPool newProvider: [ 1 ] size: 5 releaseBlock: [:x | ].
 
 	5 timesRepeat: [ pool takeOne ].
 	self assert: pool size equals: 5.
@@ -20,7 +20,7 @@ TFPoolTest >> testGrowBy [
 TFPoolTest >> testPopulate [
 	| pool |
 
-	pool := TFPool newProvider: [ 1 ] size: 5.
+	pool := TFPool newProvider: [ 1 ] size: 5 releaseBlock: [:x | ].
 
 	self assert: pool elements equals: #(1 1 1 1 1).
 	pool growBy: 5.
@@ -31,7 +31,7 @@ TFPoolTest >> testPopulate [
 TFPoolTest >> testReturnOne [
 	| pool |
 
-	pool := TFPool newProvider: [ 1 ] size: 2.
+	pool := TFPool newProvider: [ 1 ] size: 2 releaseBlock: [:x | ].
 
 	pool takeOne; takeOne.
 	self assert: pool isEmpty.
@@ -47,7 +47,7 @@ TFPoolTest >> testTakeOne [
 	| pool i |
 
 	i := 0.
-	pool := TFPool newProvider: [ i := i + 1 ] size: 2.
+	pool := TFPool newProvider: [ i := i + 1 ] size: 2 releaseBlock: [:x | ].
 
 	self assert: pool takeOne equals: 1.
 	self assert: pool takeOne equals: 2.

src/ThreadedFFI-Tests/TFStructTest.class.st

@@ -21,7 +21,7 @@ TFStructTest >> longStructSize [
 { #category : #tests }
 TFStructTest >> pointSize [
 
-	^ TFWorker default
+	^ self runner
 		invokeFunction:
 			(TFExternalFunction
 				name: 'sizeOfPoint'

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

@@ -138,12 +138,6 @@ TFUFFIBasicTypeMarshallingTest >> testSumFloat [
 	self assert: (return between: 5.79999999 and: 5.80001)
 ]
 
-{ #category : #tests }
-TFUFFIBasicTypeMarshallingTest >> testSumSignedChar [
-
-	self assertSignedIntsWithFunction: 'sum_char'
-]
-
 { #category : #tests }
 TFUFFIBasicTypeMarshallingTest >> testSumSignedInt [
 

src/ThreadedFFI/DoubleByteArray.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : #DoubleByteArray }
+
+{ #category : #'*ThreadedFFI' }
+DoubleByteArray >> tfPointerAddress [
+
+	self pinInMemory.
+	^ PointerUtils oopForObject: self
+
+]

src/ThreadedFFI/DoubleWordArray.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : #DoubleWordArray }
+
+{ #category : #'*ThreadedFFI' }
+DoubleWordArray >> tfPointerAddress [
+
+	self pinInMemory.
+	^ PointerUtils oopForObject: self
+
+]

src/ThreadedFFI/FloatArray.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : #FloatArray }
+
+{ #category : #'*ThreadedFFI' }
+FloatArray >> tfPointerAddress [
+
+	self pinInMemory.
+	^ PointerUtils oopForObject: self
+
+]

src/ThreadedFFI/IntegerArray.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : #IntegerArray }
+
+{ #category : #'*ThreadedFFI' }
+IntegerArray >> tfPointerAddress [
+
+	self pinInMemory.
+	^ PointerUtils oopForObject: self
+
+]

src/ThreadedFFI/TFCharType.class.st

@@ -7,6 +7,12 @@ Class {
 	#category : #'ThreadedFFI-Types'
 }
 
+{ #category : #marshalling }
+TFCharType >> emitMarshallFromPrimitive: builder [
+
+	builder send: #asCharacter
+]
+
 { #category : #marshalling }
 TFCharType >> marshallFromPrimitive: aValue [
 

src/ThreadedFFI/TFDoubleType.class.st

@@ -25,5 +25,5 @@ TFDoubleType >> readValue: anExternalAddress offset: offset [
 { #category : #writing }
 TFDoubleType >> write: aNumber into: anExternalAddress [ 
 
-	anExternalAddress doubleAt: 1 put: aNumber
+	anExternalAddress doubleAt: 1 put: aNumber asFloat
 ]

src/ThreadedFFI/TFExternalAsyncCall.class.st

@@ -13,10 +13,7 @@ Class {
 		'function',
 		'semaphore',
 		'arguments',
-		'returnHolder',
-		'returnAddress',
 		'parameterArray',
-		'parameterAddress',
 		'index'
 	],
 	#category : #'ThreadedFFI-Base'

src/ThreadedFFI/TFExternalSemaphore.class.st

@@ -33,6 +33,14 @@ TFExternalSemaphore >> initialize [
 	index := Smalltalk registerExternalObject: semaphore
 ]
 
+{ #category : #initialization }
+TFExternalSemaphore >> release [
+
+	super release.
+	Smalltalk unregisterExternalObject: semaphore.
+
+]
+
 { #category : #initialization }
 TFExternalSemaphore >> reset [
 

src/ThreadedFFI/TFFIBackend.class.st

@@ -84,6 +84,9 @@ TFFIBackend >> on: anObject float32At: offset [
 { #category : #accessing }
 TFFIBackend >> on: anObject float32At: offset put: value [
 
+	value isFloat ifFalse: [ 
+		^ anObject float32AtOffset: offset - 1 put: value asFloat ].
+
 	self isReadOnlyObject ifTrue: [ 
 		^ self
 			  modificationForbiddenFor: #on:float32At:put:
@@ -102,6 +105,9 @@ TFFIBackend >> on: anObject float64At: offset [
 { #category : #accessing }
 TFFIBackend >> on: anObject float64At: offset put: value [
 
+	value isFloat ifFalse: [ 
+		^ anObject float64AtOffset: offset - 1 put: value asFloat ].
+
 	self isReadOnlyObject ifTrue: [ 
 		^ self
 			  modificationForbiddenFor: #on:float64At:put:

src/ThreadedFFI/TFFloatType.class.st

@@ -25,5 +25,5 @@ TFFloatType >> readValue: anExternalAddress offset: offset [
 { #category : #writing }
 TFFloatType >> write: aNumber into: anExternalAddress [ 
 
-	anExternalAddress floatAt: 1 put: aNumber
+	anExternalAddress floatAt: 1 put: aNumber asFloat
 ]

src/ThreadedFFI/TFPool.class.st

@@ -10,17 +10,18 @@ Class {
 		'elements',
 		'provider',
 		'initialSize',
-		'pointer'
+		'pointer',
+		'releaseBlock'
 	],
 	#category : #'ThreadedFFI-Base'
 }
 
 { #category : #'instance creation' }
-TFPool class >> newProvider: aBlock size: aNumber [
+TFPool class >> newProvider: aBlock size: aNumber releaseBlock: aReleaseBlock [
 
 	^ self basicNew 
-	initializeProvider: aBlock size: aNumber;
-	yourself
+		initializeProvider: aBlock size: aNumber releaseBlock: aReleaseBlock;
+		yourself
 ]
 
 { #category : #accessing }
@@ -49,11 +50,12 @@ TFPool >> initialize [
 ]
 
 { #category : #initialization }
-TFPool >> initializeProvider: aBlock size: aNumber [
+TFPool >> initializeProvider: aBlock size: aNumber releaseBlock: aReleaseBlock [
 
 	self initialize.
 	provider := aBlock.
 	initialSize := aNumber.
+	releaseBlock := aReleaseBlock.
 	pointer := 1.
 	elements := self populate: (Array new: initialSize)
 ]
@@ -83,7 +85,20 @@ TFPool >> populate: anArray [
 TFPool >> printOn: stream [
 
 	super printOn: stream.
-	stream << '(' << self size printString << ' elements)'
+	stream 
+		nextPut: $( ; 
+		print: self size  ; 
+		nextPutAll: ' elements)'
+]
+
+{ #category : #initialization }
+TFPool >> release [
+
+	super release.
+
+	releaseBlock ifNotNil: [ elements do: releaseBlock ].
+	elements := nil.
+
 ]
 
 { #category : #accessing }
@@ -94,7 +109,8 @@ TFPool >> returnOne: anObject [
 		index := pointer - 1. 
 		index > 0 ifFalse: [ 
 			"This can happen if a new session starts in middle of a call."
-			'Returning an object but pool is full' crTrace. 
+			'Returning an object but pool is full' crTrace.
+			releaseBlock value:anObject. 
 			^ self  ]. 
 		elements at: index put: anObject.
 		pointer := index ]

src/ThreadedFFI/TFPooledExternalAsyncCall.class.st

@@ -29,8 +29,9 @@ TFPooledExternalAsyncCall >> executeOn: aRunner [
 			self doExecuteOn: aRunner ]
 		ensure: [
 			self cleanUp.
-			semaphore reset.
-			aRunner semaphorePool returnOne: semaphore ]
+			semaphore ifNotNil: [  
+				semaphore reset.
+				aRunner semaphorePool returnOne: semaphore] ]
 ]
 
 { #category : #initialization }

src/ThreadedFFI/TFRunner.class.st

@@ -38,6 +38,7 @@ TFRunner >> doInitialize [
 
 	callbackInvocationStack := Stack new.
 	stackProtect := Semaphore forMutualExclusion.
+	semaphorePool ifNotNil: [ semaphorePool release ].
 	semaphorePool := self newSemaphorePool
 ]
 
@@ -99,8 +100,9 @@ TFRunner >> invokeFunction: aTFExternalFunction withArguments: aCollection [
 TFRunner >> newSemaphorePool [
 
 	^ TFPool
-		newProvider: [ TFExternalSemaphore new ] 
+		newProvider: (MessageSend receiver: TFExternalSemaphore selector: #new) 
 		size: self semaphorePoolSize
+		releaseBlock: #release "This is ugly... but do not change it to a block, if you change it to a block it will have a reference to self. Creating a loop in the references and leaking memory"
 ]
 
 { #category : #private }
@@ -115,6 +117,10 @@ TFRunner >> primitivePerformWorkerCall: aTFExternalFunction
 { #category : #executing }
 TFRunner >> release [ 
 
+	semaphorePool ifNotNil: [ 
+		semaphorePool release.
+		semaphorePool := nil ].
+
 	handle beNull.
 	"If the stack is not initialized it means this worker was never used for callbacks"
 	stackProtect ifNil: [ ^ self ].

src/ThreadedFFI/TFWorker.class.st

@@ -13,7 +13,8 @@ Class {
 	#name : #TFWorker,
 	#superclass : #TFRunner,
 	#instVars : [
-		'name'
+		'name',
+		'semaphorePoolHolder'
 	],
 	#classVars : [
 		'Default'
@@ -28,11 +29,14 @@ TFWorker class >> default [
 ]
 
 { #category : #private }
-TFWorker class >> finalizeResourceData: handle [
+TFWorker class >> finalizeResourceData: anArray [
+
+	| handle semaphorePool |
+	handle := anArray first.
+	semaphorePool := anArray second first.
 
-	handle isNull ifTrue: [ ^ self ].
-
 	(self fromHandle: handle)
+		semaphorePool: semaphorePool;
 		release.
 
 	handle beNull.
@@ -62,6 +66,13 @@ TFWorker >> executeFunction: aTFExternalFunction withArguments: arguments usingS
 	self primitiveFailed 
 ]
 
+{ #category : #initialization }
+TFWorker >> initialize [
+
+	super initialize.
+	semaphorePoolHolder := Array new: 1
+]
+
 { #category : #accessing }
 TFWorker >> name [
 
@@ -74,6 +85,16 @@ TFWorker >> name: aName [
 	name := aName
 ]
 
+{ #category : #private }
+TFWorker >> newSemaphorePool [ 
+
+	"We need to keep a reference to the semaphorePool in an array. Because the array is passed to the finalization registry.
+	Like this the semaphorePool can be created lazy."
+	semaphorePoolHolder ifNil: [ semaphorePoolHolder := Array new: 1 ].
+	semaphorePoolHolder at: 1 put: super newSemaphorePool.
+	^ semaphorePoolHolder at: 1
+]
+
 { #category : #private }
 TFWorker >> primitiveCreateWorker [
 
@@ -98,11 +119,29 @@ TFWorker >> readReturnValueFromTask: anExternalAddress [
 	self primitiveFailed
 ]
 
-{ #category : #accessing }
+{ #category : #executing }
 TFWorker >> release [ 
 
+	"We need to ensure the semaphorePool is always released"
+	semaphorePool ifNotNil: [ 
+		semaphorePool release.
+		semaphorePoolHolder at: 1 put: nil.
+		semaphorePool := nil ].	
+
 	self isNull ifTrue: [ ^ self ].
 
 	self primitiveReleaseWorker.
 	super release.
 ]
+
+{ #category : #'external resource management' }
+TFWorker >> resourceData [
+
+	^ { handle. semaphorePoolHolder }
+]
+
+{ #category : #private }
+TFWorker >> semaphorePool: aValue [
+
+	semaphorePool := aValue
+]

src/ThreadedFFI/WordArray.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : #WordArray }
+
+{ #category : #'*ThreadedFFI' }
+WordArray >> tfPointerAddress [
+
+	self pinInMemory.
+	^ PointerUtils oopForObject: self
+
+]