add tracing api (to trace executed callouts)

src/ThreadedFFI-UFFI/TFCalloutAPI.class.st

@@ -1,9 +1,31 @@
 Class {
 	#name : #TFCalloutAPI,
 	#superclass : #FFICalloutAPI,
+	#classVars : [
+		'TraceBlock'
+	],
 	#category : #'ThreadedFFI-UFFI'
 }
 
+{ #category : #tracing }
+TFCalloutAPI class >> activateTrace [
+
+	self activateTraceWith: [ :sender | sender crTrace ]
+]
+
+{ #category : #tracing }
+TFCalloutAPI class >> activateTraceWith: aBlock [
+
+	TraceBlock := aBlock.
+	FFIMethodRegistry resetAll
+]
+
+{ #category : #tracing }
+TFCalloutAPI class >> isTracing [
+
+	^ TraceBlock notNil
+]
+
 { #category : #'instance creation' }
 TFCalloutAPI class >> newCallbackBackendFor: aCallback [
 
@@ -14,6 +36,21 @@ TFCalloutAPI class >> newCallbackBackendFor: aCallback [
 		runner: aCallback ffiLibrary runner
 ]
 
+{ #category : #tracing }
+TFCalloutAPI class >> resetTrace [
+
+	TraceBlock := nil.
+	FFIMethodRegistry resetAll
+]
+
+{ #category : #tracing }
+TFCalloutAPI class >> trace: sender [
+	"This method is not to be used directly, it is called by TFFI when #activateTrace was called."
+
+	TraceBlock ifNil: [ ^ self ].
+	TraceBlock value: sender
+]
+
 { #category : #action }
 TFCalloutAPI >> newBuilder [
 

src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st

@@ -20,17 +20,24 @@ TFCalloutMethodBuilder >> createFFICalloutLiteralFromSpec: functionSpec [
 { #category : #private }
 TFCalloutMethodBuilder >> generateFFICallout: builder spec: functionSpec [
 	| properties |
+
 	"Copy the properties of the old method"
-	sender methodProperties
-		ifNotNil: [ properties := sender methodProperties copy.
-			properties method: nil.
-			builder properties: properties ].
+	sender methodProperties ifNotNil: [ 
+		properties := sender methodProperties copy.
+		properties method: nil.
+		builder properties: properties ].
+
 	builder
 		numArgs: self method argumentNames size;
 		addTemps: (self method argumentNames copyWith: #result).
 
-	"Builds a method call"
-
+	TFCalloutAPI isTracing ifTrue: [ 
+		TFCalloutAPI trace: sender. 
+		builder 
+			pushLiteral: TFCalloutAPI;
+			pushLiteral: sender;
+			send: #trace: ].
+
 	"Obtain the library to use"
 	builder 
 		pushReceiver;