From 40dc539da5ea9e18b41f6a01dae7750f93db3703 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Tue, 28 Jan 2025 14:00:19 +0100 Subject: [PATCH 1/6] Adding support for new bytecode to have same thread calls --- .../EncoderForSistaV1.class.st | 8 + src/Kernel-CodeModel/Context.class.st | 6 + .../InstructionStream.class.st | 2 +- src/Kernel/InstructionClient.class.st | 6 + src/OpalCompiler-Core/OCIRBuilder.class.st | 7 + .../OCIRBytecodeGenerator.class.st | 12 ++ .../OCIRInstruction.class.st | 8 + .../OCIRPrinterVisitor.class.st | 7 + .../OCIRSameThreadCallout.class.st | 30 ++++ .../OCIRTranslatorVisitor.class.st | 6 + src/OpalCompiler-Core/OCIRVisitor.class.st | 6 + .../SpRubFindReplaceDialog.class.st | 2 +- src/System-Support/SmalltalkImage.class.st | 2 +- src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st | 24 +++ .../BenchTFFISameThread.class.st | 47 ++++++ .../BenchTFFISameThreadUsingBytecode.class.st | 157 ++++++++++++++++++ .../TFCalloutMethodBuilder.class.st | 92 +++++++++- src/ThreadedFFI/TFAbstractType.class.st | 13 ++ src/ThreadedFFI/TFBasicType.class.st | 8 +- src/ThreadedFFI/TFDerivedType.class.st | 9 +- src/ThreadedFFI/TFStringType.class.st | 21 +-- src/ThreadedFFI/TFStructType.class.st | 2 +- .../FFIFunctionParserTest.class.st | 107 ++++++++++++ .../FFIClassVariableArgument.class.st | 6 + .../FFIFunctionArgumentLoader.class.st | 6 + src/UnifiedFFI/FFIInstVarArgument.class.st | 6 + src/UnifiedFFI/FFIMethodArgument.class.st | 6 + src/UnifiedFFI/FFISelfArgument.class.st | 6 + 28 files changed, 584 insertions(+), 28 deletions(-) create mode 100644 src/OpalCompiler-Core/OCIRSameThreadCallout.class.st create mode 100644 src/ThreadedFFI-UFFI-Tests/BenchTFFISameThreadUsingBytecode.class.st diff --git a/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st b/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st index 006c8cc0aa0..ac9f29a398f 100644 --- a/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st +++ b/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st @@ -1275,6 +1275,14 @@ EncoderForSistaV1 >> genReturnTopToCaller [ stream nextPut: 94 ] +{ #category : 'bytecode generation' } +EncoderForSistaV1 >> genSameThreadCallout: aLiteralIndex [ + + stream + nextPut: 230; + nextPut: aLiteralIndex +] + { #category : 'bytecode generation' } EncoderForSistaV1 >> genSend: selectorLiteralIndex numArgs: nArgs [ | extendedIndex extendedNArgs | diff --git a/src/Kernel-CodeModel/Context.class.st b/src/Kernel-CodeModel/Context.class.st index 18598f94065..dfb10cf7287 100644 --- a/src/Kernel-CodeModel/Context.class.st +++ b/src/Kernel-CodeModel/Context.class.st @@ -916,6 +916,12 @@ Context >> instVarAt: index put: value [ ^ super instVarAt: index put: value ] +{ #category : 'private - exceptions' } +Context >> invalidFFICall [ + + self error +] + { #category : 'testing' } Context >> isBlockContext [ "Is this executing a block versus a method? In the new closure diff --git a/src/Kernel-CodeModel/InstructionStream.class.st b/src/Kernel-CodeModel/InstructionStream.class.st index 5918a6d80bd..f5b5c1699aa 100644 --- a/src/Kernel-CodeModel/InstructionStream.class.st +++ b/src/Kernel-CodeModel/InstructionStream.class.st @@ -73,7 +73,7 @@ InstructionStream >> interpretNext2ByteSistaV1Instruction: bytecode for: client ^client pushConstant: literal]. bytecode = 229 ifTrue: [^client pushTemporaryVariable: byte]. - ^client pushClosureTemps: byte]. + ^client sameThreadCallout: byte]. bytecode = 231 ifTrue: [^byte < 128 ifTrue: [client pushNewArrayOfSize: byte] diff --git a/src/Kernel/InstructionClient.class.st b/src/Kernel/InstructionClient.class.st index e256feddbd1..980cd8d6e53 100644 --- a/src/Kernel/InstructionClient.class.st +++ b/src/Kernel/InstructionClient.class.st @@ -195,6 +195,12 @@ InstructionClient >> pushTemporaryVariable: offset [ argument, offset, On Top Of Stack bytecode." ] +{ #category : 'instruction decoding' } +InstructionClient >> sameThreadCallout: literalIndex [ + + +] + { #category : 'instruction decoding' } InstructionClient >> send: selector super: supered numArgs: numberArguments [ "Send Message With Selector, selector, bytecode. The argument, diff --git a/src/OpalCompiler-Core/OCIRBuilder.class.st b/src/OpalCompiler-Core/OCIRBuilder.class.st index 793f42bafa2..70601e24651 100644 --- a/src/OpalCompiler-Core/OCIRBuilder.class.st +++ b/src/OpalCompiler-Core/OCIRBuilder.class.st @@ -400,6 +400,13 @@ OCIRBuilder >> returnTop [ self startNewSequence ] +{ #category : 'instructions' } +OCIRBuilder >> sameThreadCallout: aTFExternalFunction [ + + ^ self add: (OCIRInstruction sameThreadCallout: aTFExternalFunction) + +] + { #category : 'instructions' } OCIRBuilder >> send: selector [ diff --git a/src/OpalCompiler-Core/OCIRBytecodeGenerator.class.st b/src/OpalCompiler-Core/OCIRBytecodeGenerator.class.st index 0fd7be88950..fe2db63d9bc 100644 --- a/src/OpalCompiler-Core/OCIRBytecodeGenerator.class.st +++ b/src/OpalCompiler-Core/OCIRBytecodeGenerator.class.st @@ -630,6 +630,18 @@ OCIRBytecodeGenerator >> returnTop [ encoder genReturnTop ] +{ #category : 'instructions' } +OCIRBytecodeGenerator >> sameThreadCallout: aTFExternalFunction [ + + | literalIndex | + literalIndex := self literalIndexOf: aTFExternalFunction. + + stack pop: aTFExternalFunction definition parameterTypes size. + aTFExternalFunction definition returnType isVoid ifFalse: [ stack push ]. + + ^ encoder genSameThreadCallout: literalIndex +] + { #category : 'private' } OCIRBytecodeGenerator >> saveLastJump: message [ jumps at: currentSeqId put: {bytes size. message} diff --git a/src/OpalCompiler-Core/OCIRInstruction.class.st b/src/OpalCompiler-Core/OCIRInstruction.class.st index d94fcc580e5..c3450a80428 100644 --- a/src/OpalCompiler-Core/OCIRInstruction.class.st +++ b/src/OpalCompiler-Core/OCIRInstruction.class.st @@ -152,6 +152,14 @@ OCIRInstruction class >> returnTop [ ^ OCIRReturn new ] +{ #category : 'instance creation' } +OCIRInstruction class >> sameThreadCallout: aTFExternalFunction [ + + ^ OCIRSameThreadCallout new + functionDefinition: aTFExternalFunction; + yourself +] + { #category : 'instance creation' } OCIRInstruction class >> send: selector [ diff --git a/src/OpalCompiler-Core/OCIRPrinterVisitor.class.st b/src/OpalCompiler-Core/OCIRPrinterVisitor.class.st index bb135104961..9561fa13d0e 100644 --- a/src/OpalCompiler-Core/OCIRPrinterVisitor.class.st +++ b/src/OpalCompiler-Core/OCIRPrinterVisitor.class.st @@ -213,6 +213,13 @@ OCIRPrinterVisitor >> visitReturnReceiver: receiver [ stream nextPutAll: 'returnReceiver' ] +{ #category : 'visiting' } +OCIRPrinterVisitor >> visitSameThreadCallout: anOCIRSameThreadCallout [ + + stream nextPutAll: 'sameThreadCallout: '. + anOCIRSameThreadCallout functionDefinition printOn: stream +] + { #category : 'visiting' } OCIRPrinterVisitor >> visitSend: send [ diff --git a/src/OpalCompiler-Core/OCIRSameThreadCallout.class.st b/src/OpalCompiler-Core/OCIRSameThreadCallout.class.st new file mode 100644 index 00000000000..a733e005362 --- /dev/null +++ b/src/OpalCompiler-Core/OCIRSameThreadCallout.class.st @@ -0,0 +1,30 @@ +Class { + #name : 'OCIRSameThreadCallout', + #superclass : 'OCIRInstruction', + #instVars : [ + 'functionDefinition' + ], + #category : 'OpalCompiler-Core-IR-Nodes', + #package : 'OpalCompiler-Core', + #tag : 'IR-Nodes' +} + +{ #category : 'visiting' } +OCIRSameThreadCallout >> accept: aVisitor [ + + ^ aVisitor visitSameThreadCallout: self +] + +{ #category : 'as yet unclassified' } +OCIRSameThreadCallout >> functionDefinition [ + + ^ functionDefinition + +] + +{ #category : 'as yet unclassified' } +OCIRSameThreadCallout >> functionDefinition: aTFExternalFunction [ + + functionDefinition := aTFExternalFunction + +] diff --git a/src/OpalCompiler-Core/OCIRTranslatorVisitor.class.st b/src/OpalCompiler-Core/OCIRTranslatorVisitor.class.st index e6acca3d260..c71cce46fc9 100644 --- a/src/OpalCompiler-Core/OCIRTranslatorVisitor.class.st +++ b/src/OpalCompiler-Core/OCIRTranslatorVisitor.class.st @@ -280,6 +280,12 @@ OCIRTranslatorVisitor >> visitReturnReceiver: rec [ gen returnReceiver ] +{ #category : 'visiting' } +OCIRTranslatorVisitor >> visitSameThreadCallout: anOCIRSameThreadCallout [ + + ^ gen sameThreadCallout: anOCIRSameThreadCallout functionDefinition +] + { #category : 'visiting' } OCIRTranslatorVisitor >> visitSend: send [ diff --git a/src/OpalCompiler-Core/OCIRVisitor.class.st b/src/OpalCompiler-Core/OCIRVisitor.class.st index e3c237463ef..dc5d8db479e 100644 --- a/src/OpalCompiler-Core/OCIRVisitor.class.st +++ b/src/OpalCompiler-Core/OCIRVisitor.class.st @@ -120,6 +120,12 @@ OCIRVisitor >> visitReturnLiteral: lit [ OCIRVisitor >> visitReturnReceiver: rec [ ] +{ #category : 'visiting' } +OCIRVisitor >> visitSameThreadCallout: anOCIRSameThreadCallout [ + + +] + { #category : 'visiting' } OCIRVisitor >> visitSend: send [ ] diff --git a/src/Rubric-SpecFindReplaceDialog/SpRubFindReplaceDialog.class.st b/src/Rubric-SpecFindReplaceDialog/SpRubFindReplaceDialog.class.st index 3495465476a..fd623ff8228 100644 --- a/src/Rubric-SpecFindReplaceDialog/SpRubFindReplaceDialog.class.st +++ b/src/Rubric-SpecFindReplaceDialog/SpRubFindReplaceDialog.class.st @@ -33,7 +33,7 @@ SpRubFindReplaceDialog class >> defaultLayout [ beColumnHomogeneous; beRowHomogeneous; add: #regExpCheckBox atPoint: 1 @ 1; - add: #backwardsCheckBox at: 2 @ 1; + add: #backwardsCheckBox atPoint: 2 @ 1; add: #caseCheckBox at: 1 @ 2; add: #wrapCheckBox at: 2 @ 2; add: #entireCheckBox at: 1 @ 3; diff --git a/src/System-Support/SmalltalkImage.class.st b/src/System-Support/SmalltalkImage.class.st index 74d2aad3aa2..c88f204c079 100644 --- a/src/System-Support/SmalltalkImage.class.st +++ b/src/System-Support/SmalltalkImage.class.st @@ -1212,7 +1212,7 @@ SmalltalkImage >> newSpecialObjectsArray [ "External objects for callout. Note: Written so that one can actually completely remove the FFI." newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []). - newArray at: 45 put: nil. "was ExternalStructure" + newArray at: 45 put: #invalidFFICall. newArray at: 46 put: nil. "was ExternalData" newArray at: 47 put: nil. newArray at: 48 put: nil. diff --git a/src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st b/src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st index bfbe0ba6776..624013c9918 100644 --- a/src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st +++ b/src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st @@ -42,3 +42,27 @@ BenchTFFI >> runCall [ ^ [ return := self doCallWith: 1.0 another: 2.0. self assert: return = 3.0 ] bench ] + +{ #category : 'running' } +BenchTFFI >> runCallWithByteArray [ + + ^ [ self doCallWithByteArray: (ByteArray new: 17) ] bench +] + +{ #category : 'running' } +BenchTFFI >> runCallWithExternalAddress [ + + ^ [ self doCallWithExternalAddress: ExternalAddress null ] bench +] + +{ #category : 'running' } +BenchTFFI >> runCallWithPointerVoid [ + + ^ [ self doPointerVoid: (ExternalAddress null) ] bench +] + +{ #category : 'running' } +BenchTFFI >> runCallWithPointerVoidWithByteArray [ + + ^ [ self doPointerVoid: (ByteArray new: 17) ] bench +] diff --git a/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThread.class.st b/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThread.class.st index fb1d4392a6e..3556f93cf0c 100644 --- a/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThread.class.st +++ b/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThread.class.st @@ -15,6 +15,24 @@ BenchTFFISameThread >> doCallWith: aFloat another: aDouble [ ^ self ffiCall: #(float sumAFloatAndADouble(float aFloat, double aDouble)) ] +{ #category : 'private' } +BenchTFFISameThread >> doCallWithByteArray: aByteArray [ + + self ffiCall: #(uint64 id_int(void* aByteArray)) +] + +{ #category : 'private' } +BenchTFFISameThread >> doCallWithExternalAddress: anExternalAddress [ + + self ffiCall: #(uint64 id_int(void* anExternalAddress)) +] + +{ #category : 'private' } +BenchTFFISameThread >> doPointerVoid: aPointer [ + + self ffiCall: #(void id_int(void* aPointer)) +] + { #category : 'private' } BenchTFFISameThread >> doSumWithConstants [ @@ -52,6 +70,20 @@ BenchTFFISameThread >> runCall [ ^ super runCall ] +{ #category : 'running' } +BenchTFFISameThread >> runCallWithByteArray [ + + + ^ super runCallWithByteArray +] + +{ #category : 'running' } +BenchTFFISameThread >> runCallWithExternalAddress [ + + + ^ super runCallWithExternalAddress +] + { #category : 'running' } BenchTFFISameThread >> runCallWithOptimizedIntegerConstants [ @@ -79,6 +111,21 @@ BenchTFFISameThread >> runCallWithOptimizedLiterals2 [ self assert: return = 1 ] bench ] +{ #category : 'running' } +BenchTFFISameThread >> runCallWithPointerVoid [ + + + ^ super runCallWithPointerVoid +] + +{ #category : 'running' } +BenchTFFISameThread >> runCallWithPointerVoidWithByteArray [ + + + ^ super runCallWithPointerVoidWithByteArray + +] + { #category : 'running' } BenchTFFISameThread >> runDoSumWithConstants [ diff --git a/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThreadUsingBytecode.class.st b/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThreadUsingBytecode.class.st new file mode 100644 index 00000000000..4d0a0cff732 --- /dev/null +++ b/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThreadUsingBytecode.class.st @@ -0,0 +1,157 @@ +Class { + #name : 'BenchTFFISameThreadUsingBytecode', + #superclass : 'BenchTFFI', + #category : 'ThreadedFFI-UFFI-Tests-Benchs', + #package : 'ThreadedFFI-UFFI-Tests', + #tag : 'Benchs' +} + +{ #category : 'private' } +BenchTFFISameThreadUsingBytecode >> doCallWith: aFloat another: aDouble [ + + | definition function | + + + + definition := TFFunctionDefinition + parameterTypes: { + TFBasicType float. + TFBasicType double } + returnType: TFBasicType float. + + function := TFExternalFunction + name: #sumAFloatAndADouble + moduleName: TFTestLibraryUsingSameThreadRunner uniqueInstance libraryName + definition: definition. + + ^ OCIRBuilder buildIR: [ :builder | + builder + numArgs: 2; + addTemps: #( #aFloat #aDouble ); + pushTemp: #aFloat; + send: #asFloat; + pushTemp: #aDouble; + send: #asFloat; + sameThreadCallout: function; + returnTop ] +] + +{ #category : 'private' } +BenchTFFISameThreadUsingBytecode >> doCallWithByteArray: aByteArray [ + + | definition function | + + + + definition := TFFunctionDefinition + parameterTypes: { + TFBasicType pointer } + returnType: TFBasicType uint64. + + function := TFExternalFunction + name: #id_int + moduleName: TFTestLibraryUsingSameThreadRunner uniqueInstance libraryName + definition: definition. + + ^ OCIRBuilder buildIR: [ :builder | + builder + numArgs: 1; + addTemps: #( #aByteArray ); + pushTemp: #aByteArray; +" send: #tfPointerAddress; +" sameThreadCallout: function; + returnTop ] +] + +{ #category : 'private' } +BenchTFFISameThreadUsingBytecode >> doCallWithExternalAddress: aExternalAddress [ + + | definition function | + + + + definition := TFFunctionDefinition + parameterTypes: { + TFBasicType pointer } + returnType: TFBasicType uint64. + + function := TFExternalFunction + name: #id_int + moduleName: TFTestLibraryUsingSameThreadRunner uniqueInstance libraryName + definition: definition. + + ^ OCIRBuilder buildIR: [ :builder | + builder + numArgs: 1; + addTemps: #( #aExternalAddress ); + pushTemp: #aExternalAddress; + send: #tfPointerAddress; + sameThreadCallout: function; + returnTop ] +] + +{ #category : 'private' } +BenchTFFISameThreadUsingBytecode >> doPointerVoid: aPointer [ + + | definition function | + + + + definition := TFFunctionDefinition + parameterTypes: { TFBasicType pointer } + returnType: TFBasicType void. + + function := TFExternalFunction + name: #id_int + moduleName: TFTestLibraryUsingSameThreadRunner uniqueInstance libraryName + definition: definition. + + ^ OCIRBuilder buildIR: [ :builder | + builder + numArgs: 1; + addTemps: #( #aPointer ); + pushTemp: #aPointer; +" send: #tfPointerAddress; +" sameThreadCallout: function; + returnTop ] +] + +{ #category : 'running' } +BenchTFFISameThreadUsingBytecode >> runCall [ + + + (self class >> #doCallWith:another: literalAt: 2) validate. + ^ super runCall +] + +{ #category : 'running' } +BenchTFFISameThreadUsingBytecode >> runCallWithByteArray [ + + + (self class>> #doCallWithByteArray:) literals select: [:e | e class = TFExternalFunction] thenDo: [:e | e validate]. + ^ super runCallWithByteArray +] + +{ #category : 'running' } +BenchTFFISameThreadUsingBytecode >> runCallWithExternalAddress [ + + + (self class>> #doCallWithExternalAddress:) literals select: [:e | e class = TFExternalFunction] thenDo: [:e | e validate]. + ^ super runCallWithExternalAddress +] + +{ #category : 'running' } +BenchTFFISameThreadUsingBytecode >> runCallWithPointerVoid [ + + + (self class>> #doPointerVoid: ) literals select: [:e | e class = TFExternalFunction] thenDo: [:e | e validate]. + ^ super runCallWithPointerVoid +] + +{ #category : 'running' } +BenchTFFISameThreadUsingBytecode >> runCallWithPointerVoidWithByteArray [ + + + (self class>> #doPointerVoid: ) literals select: [:e | e class = TFExternalFunction] thenDo: [:e | e validate]. + ^ super runCallWithPointerVoidWithByteArray +] diff --git a/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st b/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st index 00c3381e160..ade28048fd7 100644 --- a/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st +++ b/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st @@ -4,8 +4,12 @@ I override some methods to correctly generate TFFI methods when using UFFI. Class { #name : 'TFCalloutMethodBuilder', #superclass : 'FFICalloutMethodBuilder', + #instVars : [ + 'useBytecode' + ], #classVars : [ - 'ABI_MAPPING' + 'ABI_MAPPING', + 'UseBytecode' ], #pools : [ 'TFAbiTypes' @@ -75,12 +79,31 @@ TFCalloutMethodBuilder class >> initializeABIMapping [ } asDictionary ] +{ #category : 'accessing' } +TFCalloutMethodBuilder class >> useBytecode [ + + ^ UseBytecode ifNil: [ UseBytecode := false ] +] + +{ #category : 'accessing' } +TFCalloutMethodBuilder class >> useBytecode: aValue [ + + UseBytecode := aValue +] + { #category : 'calling convention' } TFCalloutMethodBuilder >> abiConstantFor: aSelector [ ^ self class abiConstantFor: aSelector ] +{ #category : 'private' } +TFCalloutMethodBuilder >> canUseBytecode: aRunner [ + + ^ aRunner = TFSameThreadRunner uniqueInstance and: useBytecode. + +] + { #category : 'private' } TFCalloutMethodBuilder >> createFFICalloutLiteralFromSpec: functionSpec [ @@ -108,12 +131,15 @@ TFCalloutMethodBuilder >> emitArgument: anFFIFunctionArgument optimizingIn: buil emitResolvedTypeArgument: builder context: sender inCallout: self requestor. - tfExternalTypeWithArity emitMarshallToPrimitive: builder ] + tfExternalTypeWithArity emitMarshallToPrimitive: builder argument: anFFIFunctionArgument resolvedType loader ] ] { #category : 'private' } TFCalloutMethodBuilder >> generateFFICallout: builder spec: functionSpec ffiLibrary: ffiLibrary [ + (self canUseBytecode: ffiLibrary uniqueInstance runner) + ifTrue: [ ^ self generateFFICalloutUsingBytecode: builder spec: functionSpec ffiLibrary: ffiLibrary]. + TFCalloutAPI isTracing ifTrue: [ TFCalloutAPI trace: sender. builder @@ -142,8 +168,48 @@ TFCalloutMethodBuilder >> generateFFICallout: builder spec: functionSpec ffiLibr functionSpec arguments withIndexDo: [ :each :index| each emitReturnArgument: builder context: sender. each resolvedType tfExternalTypeWithArity - emitFreeIfNeededOfIndex: index - argumentsArrayTempName: #argumentsArray + emitFreeIfNeededOfIndex: index + argument: each loader + 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 returnType + emitReturn: builder + resultTempVar: #result + context: sender + inCallout: self requestor +] + +{ #category : 'private' } +TFCalloutMethodBuilder >> generateFFICalloutUsingBytecode: builder spec: functionSpec ffiLibrary: ffiLibrary [ + + + | functionDefinition | + TFCalloutAPI isTracing ifTrue: [ + TFCalloutAPI trace: sender. + builder + pushLiteral: TFCalloutAPI; + pushLiteral: sender; + send: #trace: ]. + + functionDefinition := self createFFICalloutLiteralFromSpec: functionSpec. + functionDefinition validate. + + "iterate arguments in order (in the function) to create the function call" + functionSpec arguments + do: [ :each | self emitArgument: each optimizingIn:builder ]. + + builder sameThreadCallout: functionDefinition. + + functionSpec arguments withIndexDo: [ :each :index| + each emitReturnArgument: builder context: sender. + each resolvedType tfExternalTypeWithArity + emitFreeIfNeededOfIndex: index + argument: each loader withBuilder: builder ]. "Additional marshall in the case of TFFI" @@ -151,9 +217,27 @@ TFCalloutMethodBuilder >> generateFFICallout: builder spec: functionSpec ffiLibr "convert in case return type needs it. And return reseult" + functionSpec returnType resolvedType tfExternalTypeWithArity isVoid ifTrue: [ + ^ builder + pushReceiver; + returnTop ]. + ^ functionSpec returnType emitReturn: builder resultTempVar: #result context: sender inCallout: self requestor ] + +{ #category : 'private' } +TFCalloutMethodBuilder >> initialize [ + + super initialize. + useBytecode := self class useBytecode +] + +{ #category : 'private' } +TFCalloutMethodBuilder >> useBytecode: aValue [ + + useBytecode := aValue +] diff --git a/src/ThreadedFFI/TFAbstractType.class.st b/src/ThreadedFFI/TFAbstractType.class.st index 11f373bb48b..6de5fd633c4 100644 --- a/src/ThreadedFFI/TFAbstractType.class.st +++ b/src/ThreadedFFI/TFAbstractType.class.st @@ -28,6 +28,19 @@ TFAbstractType >> callbackWrite: aNumber into: anExternalAddress [ self write: aNumber into: anExternalAddress ] +{ #category : 'marshalling' } +TFAbstractType >> emitMarshallToPrimitive: builder [ + + "Nothing to do in this case" +] + +{ #category : 'marshalling' } +TFAbstractType >> emitMarshallToPrimitive: builder argument: anArg [ + + "Nothing to do in this case" + ^ self emitMarshallToPrimitive: builder +] + { #category : 'accessing' } TFAbstractType >> isValid [ diff --git a/src/ThreadedFFI/TFBasicType.class.st b/src/ThreadedFFI/TFBasicType.class.st index 7314c534b6f..e2dbaee7b77 100644 --- a/src/ThreadedFFI/TFBasicType.class.st +++ b/src/ThreadedFFI/TFBasicType.class.st @@ -298,19 +298,13 @@ TFBasicType >> byteSize [ ] { #category : 'marshalling' } -TFBasicType >> emitFreeIfNeededOfIndex: argIndex argumentsArrayTempName: argumentsArrayTempName withBuilder: anIRBuilder [ +TFBasicType >> emitFreeIfNeededOfIndex: argIndex argument: argument withBuilder: anIRBuilder [ ] { #category : 'marshalling' } TFBasicType >> emitMarshallFromPrimitive: aBuilder [ ] -{ #category : 'marshalling' } -TFBasicType >> emitMarshallToPrimitive: builder [ - - "Nothing to do in this case" -] - { #category : 'writing' } TFBasicType >> freeValueIfNeeded: aValue [ diff --git a/src/ThreadedFFI/TFDerivedType.class.st b/src/ThreadedFFI/TFDerivedType.class.st index 5875e75b61f..f8bad61c903 100644 --- a/src/ThreadedFFI/TFDerivedType.class.st +++ b/src/ThreadedFFI/TFDerivedType.class.st @@ -64,7 +64,14 @@ TFDerivedType >> callbackWrite: anObject into: anExternalAddress [ ] { #category : 'marshalling' } -TFDerivedType >> emitFreeIfNeededOfIndex: argIndex argumentsArrayTempName: argumentsArrayTempName withBuilder: anIRBuilder [ +TFDerivedType >> emitFreeIfNeededOfIndex: argIndex argument: argument withBuilder: anIRBuilder [ +] + +{ #category : 'marshalling' } +TFDerivedType >> emitMarshallToPrimitive: builder argument: anArg [ + + "Nothing to do in this case" + ^ self emitMarshallToPrimitive: builder ] { #category : 'freeing' } diff --git a/src/ThreadedFFI/TFStringType.class.st b/src/ThreadedFFI/TFStringType.class.st index 09374e0a202..3a06385dc7c 100644 --- a/src/ThreadedFFI/TFStringType.class.st +++ b/src/ThreadedFFI/TFStringType.class.st @@ -37,15 +37,10 @@ TFStringType >> callbackReadValue: anExternalAddress [ ] { #category : 'marshalling' } -TFStringType >> emitFreeIfNeededOfIndex: argIndex argumentsArrayTempName: argumentsArrayTempName withBuilder: anIRBuilder [ - - "I will send the message #freeValueIfNeeded: to myself with the argument from the argumentArray at the position passed as parameter. - It is important that I do not leave nothing in the stack" +TFStringType >> emitFreeIfNeededOfIndex: argIndex argument: argument withBuilder: anIRBuilder [ anIRBuilder pushLiteral: self. - anIRBuilder pushTemp: argumentsArrayTempName. - anIRBuilder pushLiteral: argIndex. - anIRBuilder send: #at:. + anIRBuilder pushTemp: argument tempName. anIRBuilder send: #freeValueIfNeeded:. anIRBuilder popTop ] @@ -57,14 +52,16 @@ TFStringType >> emitMarshallFromPrimitive: anIRBuilder [ ] { #category : 'marshalling' } -TFStringType >> emitMarshallToPrimitive: anIRBuilder [ +TFStringType >> emitMarshallToPrimitive: anIRBuilder argument: anArg [ - anIRBuilder addTemp: #__marshall_temp. - anIRBuilder storeTemp: #__marshall_temp. + anIRBuilder addTemp: anArg tempName. + anIRBuilder storeTemp: anArg tempName. anIRBuilder popTop. anIRBuilder pushLiteral: self. - anIRBuilder pushTemp: #__marshall_temp. - anIRBuilder send: #prepareStringForMarshalling: + anIRBuilder pushTemp: anArg tempName. + anIRBuilder send: #prepareStringForMarshalling:. + anIRBuilder storeTemp: anArg tempName. + ] { #category : 'freeing' } diff --git a/src/ThreadedFFI/TFStructType.class.st b/src/ThreadedFFI/TFStructType.class.st index d901c11247c..52afd316f89 100644 --- a/src/ThreadedFFI/TFStructType.class.st +++ b/src/ThreadedFFI/TFStructType.class.st @@ -70,7 +70,7 @@ TFStructType >> copyFrom: from to: to size: size [ ] { #category : 'marshalling' } -TFStructType >> emitFreeIfNeededOfIndex: anInteger argumentsArrayTempName: aString withBuilder: anIRBuilder [ +TFStructType >> emitFreeIfNeededOfIndex: argIndex argument: argument withBuilder: anIRBuilder [ ] { #category : 'marshalling' } diff --git a/src/UnifiedFFI-Tests/FFIFunctionParserTest.class.st b/src/UnifiedFFI-Tests/FFIFunctionParserTest.class.st index 63ea7072e88..6f05341cecb 100644 --- a/src/UnifiedFFI-Tests/FFIFunctionParserTest.class.st +++ b/src/UnifiedFFI-Tests/FFIFunctionParserTest.class.st @@ -222,6 +222,7 @@ FFIFunctionParserTest >> testParseFunction2 [ builder := (FFIBackend current calloutAPIClass inContext: nil) newBuilder sender: ctx; + useBytecode: false; yourself. "signature: functionSignature; sender: sender." @@ -231,6 +232,112 @@ FFIFunctionParserTest >> testParseFunction2 [ self assert: (method1 literals allButFirst: 2) equals: (method1 literals allButFirst: 2)] ] +{ #category : 'tests' } +FFIFunctionParserTest >> testParseFunction3 [ + + | functionSpec1 builder method1 | + functionSpec1 := self newParser parseNamedFunction: + #( int SDL_LockTexture ( self , void* 0 , void** _b , int * d_ ) ). + + functionSpec1 resolveUsing: resolver. + + builder := (FFIBackend current calloutAPIClass inContext: nil) + newBuilder + useBytecode: true; + sender: ctx; + yourself. + "signature: functionSignature; + sender: sender." + method1 := builder generateMethodFromSpec: functionSpec1. + +] + +{ #category : 'tests' } +FFIFunctionParserTest >> testParseFunction4 [ + + | functionSpec1 builder method1 | + functionSpec1 := self newParser parseNamedFunction: + #( int git_libgit2_init() ). + + functionSpec1 resolveUsing: resolver. + + + builder := (FFIBackend current calloutAPIClass inContext: nil) + newBuilder + useBytecode: true; + sender: ctx; + yourself. + "signature: functionSignature; + sender: sender." + method1 := builder generateMethodFromSpec: functionSpec1. + +] + +{ #category : 'tests' } +FFIFunctionParserTest >> testParseFunction5 [ + + | functionSpec1 builder method1 | + functionSpec1 := self newParser parseNamedFunction: + #( void objc_registerClassPair(void* _b) ). + + functionSpec1 resolveUsing: resolver. + + + builder := (FFIBackend current calloutAPIClass inContext: nil) + newBuilder + useBytecode: true; + sender: ctx; + yourself. + "signature: functionSignature; + sender: sender." + method1 := builder generateMethodFromSpec: functionSpec1. + +] + +{ #category : 'tests' } +FFIFunctionParserTest >> testParseFunction6 [ + + | functionSpec1 builder method1 | + functionSpec1 := self newParser parseNamedFunction: + #( void* objc_msgSend(void* d_, void* _b)). + + functionSpec1 resolveUsing: resolver. + + + builder := (FFIBackend current calloutAPIClass inContext: nil) + newBuilder + useBytecode: true; + sender: ctx; + yourself. + "signature: functionSignature; + sender: sender." + + method1 := builder generateMethodFromSpec: functionSpec1. + +] + +{ #category : 'tests' } +FFIFunctionParserTest >> testParseFunction7 [ + + | functionSpec1 builder method1 | + functionSpec1 := self newParser parseNamedFunction: + #( void* objc_msgSend(String d_, void* _b)). + + functionSpec1 resolveUsing: resolver. + + + builder := (FFIBackend current calloutAPIClass inContext: nil) + newBuilder + useBytecode: true; + sender: ctx; + yourself. + "signature: functionSignature; + sender: sender." + + method1 := builder generateMethodFromSpec: functionSpec1. + +] + { #category : 'tests' } FFIFunctionParserTest >> testParseFunctionArrayHasFunctionName [ diff --git a/src/UnifiedFFI/FFIClassVariableArgument.class.st b/src/UnifiedFFI/FFIClassVariableArgument.class.st index ee05e130f73..844e7a6d440 100644 --- a/src/UnifiedFFI/FFIClassVariableArgument.class.st +++ b/src/UnifiedFFI/FFIClassVariableArgument.class.st @@ -31,3 +31,9 @@ FFIClassVariableArgument >> emitArgument: aBuilder context: aContext [ FFIClassVariableArgument >> rolledPointerTempName [ ^ self rolledPointerTempNameFor: self argName ] + +{ #category : 'as yet unclassified' } +FFIClassVariableArgument >> tempName [ + + ^ #'_tmp_' , argName +] diff --git a/src/UnifiedFFI/FFIFunctionArgumentLoader.class.st b/src/UnifiedFFI/FFIFunctionArgumentLoader.class.st index 3dc7283a137..04c2e4ce341 100644 --- a/src/UnifiedFFI/FFIFunctionArgumentLoader.class.st +++ b/src/UnifiedFFI/FFIFunctionArgumentLoader.class.st @@ -130,3 +130,9 @@ FFIFunctionArgumentLoader >> rolledPointerTempName [ FFIFunctionArgumentLoader >> rolledPointerTempNameFor: aString [ ^ ('_ptr_', aString) asSymbol ] + +{ #category : 'as yet unclassified' } +FFIFunctionArgumentLoader >> tempName [ + + ^ self subclassResponsibility +] diff --git a/src/UnifiedFFI/FFIInstVarArgument.class.st b/src/UnifiedFFI/FFIInstVarArgument.class.st index faddf128c49..2b5d714fe53 100644 --- a/src/UnifiedFFI/FFIInstVarArgument.class.st +++ b/src/UnifiedFFI/FFIInstVarArgument.class.st @@ -51,3 +51,9 @@ FFIInstVarArgument >> emitArgumentVariableAccesingPart: aBuilder context: aConte FFIInstVarArgument >> rolledPointerTempName [ ^ self rolledPointerTempNameFor: self argName ] + +{ #category : 'as yet unclassified' } +FFIInstVarArgument >> tempName [ + + ^ #'_tmp_' , argName +] diff --git a/src/UnifiedFFI/FFIMethodArgument.class.st b/src/UnifiedFFI/FFIMethodArgument.class.st index 1ed26aebc95..bae77675a71 100644 --- a/src/UnifiedFFI/FFIMethodArgument.class.st +++ b/src/UnifiedFFI/FFIMethodArgument.class.st @@ -64,3 +64,9 @@ FFIMethodArgument >> index: anObject [ FFIMethodArgument >> rolledPointerTempName [ ^ self rolledPointerTempNameFor: self argName ] + +{ #category : 'as yet unclassified' } +FFIMethodArgument >> tempName [ + + ^ #'_tmp_' , argName +] diff --git a/src/UnifiedFFI/FFISelfArgument.class.st b/src/UnifiedFFI/FFISelfArgument.class.st index ece8ee65d3f..83096850ec2 100644 --- a/src/UnifiedFFI/FFISelfArgument.class.st +++ b/src/UnifiedFFI/FFISelfArgument.class.st @@ -44,3 +44,9 @@ FFISelfArgument >> emitArgumentVariableAccesingPart: aBuilder context: aContext FFISelfArgument >> rolledPointerTempName [ ^ self rolledPointerTempNameFor: #self ] + +{ #category : 'private' } +FFISelfArgument >> tempName [ + + ^ #'_tmp_self' +] From 383dc28846e0f33320336a624228b47e2bb5fb05 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Fri, 31 Jan 2025 11:21:43 +0100 Subject: [PATCH 2/6] - Adding tests for the callbacks. - Adding a symbol cache, because asking the same address many times the OS crashes. --- .../SymbolicBytecodeBuilder.class.st | 13 ++++--- .../FBIRBytecodeDecompiler.class.st | 6 ++++ .../TFCallbacksTest.class.st | 14 +++++--- .../TFCallbacksUsingBytecodeTest.class.st | 36 +++++++++++++++++++ src/ThreadedFFI-Tests/TFTestCase.class.st | 2 +- src/ThreadedFFI/TFFIBackend.class.st | 20 ++++++++--- 6 files changed, 75 insertions(+), 16 deletions(-) create mode 100644 src/ThreadedFFI-Tests/TFCallbacksUsingBytecodeTest.class.st diff --git a/src/Debugging-Core/SymbolicBytecodeBuilder.class.st b/src/Debugging-Core/SymbolicBytecodeBuilder.class.st index 8cde62c82ba..8975af1cf03 100644 --- a/src/Debugging-Core/SymbolicBytecodeBuilder.class.st +++ b/src/Debugging-Core/SymbolicBytecodeBuilder.class.st @@ -189,13 +189,6 @@ SymbolicBytecodeBuilder >> pushActiveProcess [ self addBytecode: 'pushThisProcess' ] -{ #category : 'instruction decoding' } -SymbolicBytecodeBuilder >> pushClosureTemps: numTemps [ - "Push on stack nil numTemps times for the closure temps." - - self addBytecode: 'pushClosureTemps:' , numTemps printString -] - { #category : 'instruction decoding' } SymbolicBytecodeBuilder >> pushConsArrayWithElements: numElements [ @@ -266,6 +259,12 @@ SymbolicBytecodeBuilder >> pushTemporaryVariable: offset [ self addBytecode: 'pushTemp: ', offset printString ] +{ #category : 'instruction decoding' } +SymbolicBytecodeBuilder >> sameThreadCallout: literalIndex [ + + self addBytecode: 'sameThreadCallout: literalIndex' +] + { #category : 'instruction decoding' } SymbolicBytecodeBuilder >> send: selector super: supered numArgs: numberArguments [ "Print the Send Message With Selector, selector, bytecode. The argument, diff --git a/src/Flashback-Decompiler/FBIRBytecodeDecompiler.class.st b/src/Flashback-Decompiler/FBIRBytecodeDecompiler.class.st index 7aa12a0403e..3a931098fb4 100644 --- a/src/Flashback-Decompiler/FBIRBytecodeDecompiler.class.st +++ b/src/Flashback-Decompiler/FBIRBytecodeDecompiler.class.st @@ -281,6 +281,12 @@ FBIRBytecodeDecompiler >> quickMethod [ self error: 'quick method inconsistency' ] +{ #category : 'instruction decoding' } +FBIRBytecodeDecompiler >> sameThreadCallout: literalIndex [ + + irBuilder sameThreadCallout: (instructionStream compiledCode literalAt: literalIndex + 1 ) +] + { #category : 'scope' } FBIRBytecodeDecompiler >> scope [ ^ scopeStack top diff --git a/src/ThreadedFFI-Tests/TFCallbacksTest.class.st b/src/ThreadedFFI-Tests/TFCallbacksTest.class.st index 713de221ac4..513a1a001d5 100644 --- a/src/ThreadedFFI-Tests/TFCallbacksTest.class.st +++ b/src/ThreadedFFI-Tests/TFCallbacksTest.class.st @@ -18,7 +18,13 @@ TFCallbacksTest >> callCallback: aCallback [ function := TFExternalFunction fromAddress: aCallback getHandle definition: functionDefinition. - runner invokeFunction: function withArguments: {} + self invokeFunction: function withArguments: {} +] + +{ #category : 'executing' } +TFCallbacksTest >> invokeFunction: fun withArguments: arguments [ + + ^ runner invokeFunction: fun withArguments: arguments ] { #category : 'instance creation' } @@ -129,7 +135,7 @@ TFCallbacksTest >> testReentrantCalloutsDuringCallback [ forCallback: [ :times | times = 7 ifTrue: [ times ] - ifFalse: [ runner invokeFunction: fun withArguments: {callback getHandle. times + 1} ] ] + ifFalse: [ self invokeFunction: fun withArguments: {callback getHandle. times + 1} ] ] parameters: { TFBasicType sint32. } returnType: TFBasicType sint32 runner: runner. @@ -155,7 +161,7 @@ TFCallbacksTest >> testReentrantCalloutsDuringCallbackUsingSameProcessForCallbac times = 7 ifTrue: [ times ] ifFalse: [ - runner invokeFunction: fun withArguments: { + self invokeFunction: fun withArguments: { callback getHandle. (times + 1) } ] ] parameters: { TFBasicType sint } @@ -189,6 +195,6 @@ TFCallbacksTest >> testSingleCalloutDuringCallback [ parameterTypes: {TFBasicType pointer. TFBasicType sint} returnType: TFBasicType sint). - returnValue := runner invokeFunction: fun withArguments: {callback getHandle. 3}. + returnValue := self invokeFunction: fun withArguments: {callback getHandle. 3}. self assert: returnValue equals: 42 ] diff --git a/src/ThreadedFFI-Tests/TFCallbacksUsingBytecodeTest.class.st b/src/ThreadedFFI-Tests/TFCallbacksUsingBytecodeTest.class.st new file mode 100644 index 00000000000..6a60b5e2c9e --- /dev/null +++ b/src/ThreadedFFI-Tests/TFCallbacksUsingBytecodeTest.class.st @@ -0,0 +1,36 @@ +Class { + #name : 'TFCallbacksUsingBytecodeTest', + #superclass : 'TFCallbacksTest', + #category : 'ThreadedFFI-Tests', + #package : 'ThreadedFFI-Tests' +} + +{ #category : 'building suites' } +TFCallbacksUsingBytecodeTest class >> testParameters [ + + ^ ParametrizedTestMatrix new + forSelector: #runner addOptions: { [ TFSameThreadRunner uniqueInstance ] } +] + +{ #category : 'executing' } +TFCallbacksUsingBytecodeTest >> invokeFunction: fun withArguments: arguments [ + + | argumentNames builder method | + argumentNames := arguments collectWithIndex: [ :e :i | #_arg_ , i printString ]. + + fun validate. + + builder := OCIRBuilder new + numArgs: arguments size; + addTemps: argumentNames. + + argumentNames do: [ :aName | builder pushTemp: aName ]. + builder sameThreadCallout: fun. + + fun definition returnType isVoid + ifTrue: [ builder pushReceiver; returnTop ] + ifFalse: [ builder returnTop ]. + + method := builder ir compiledMethod. + ^ method valueWithReceiver: nil arguments: arguments. +] diff --git a/src/ThreadedFFI-Tests/TFTestCase.class.st b/src/ThreadedFFI-Tests/TFTestCase.class.st index e470e7517f1..03371cb86d6 100644 --- a/src/ThreadedFFI-Tests/TFTestCase.class.st +++ b/src/ThreadedFFI-Tests/TFTestCase.class.st @@ -12,7 +12,7 @@ Class { TFTestCase class >> testParameters [ ^ ParametrizedTestMatrix new - forSelector: #runner addOptions: { [ TFSameThreadRunner uniqueInstance ]. [ TFWorker named: 'fortest' ]. } + forSelector: #runner addOptions: { [ TFSameThreadRunner uniqueInstance ]". [ TFWorker named: 'fortest' ]." } ] { #category : 'accessing' } diff --git a/src/ThreadedFFI/TFFIBackend.class.st b/src/ThreadedFFI/TFFIBackend.class.st index 3f7a5ab69fb..86c7806e294 100644 --- a/src/ThreadedFFI/TFFIBackend.class.st +++ b/src/ThreadedFFI/TFFIBackend.class.st @@ -4,6 +4,9 @@ I am the FFI backend implemented by using TFFI Class { #name : 'TFFIBackend', #superclass : 'FFIBackend', + #instVars : [ + 'symbolCache' + ], #category : 'ThreadedFFI-Base', #package : 'ThreadedFFI', #tag : 'Base' @@ -71,11 +74,14 @@ TFFIBackend >> isAvailable [ { #category : 'instance creation' } TFFIBackend >> loadSymbol: moduleSymbol module: module [ - | encodedString | - encodedString := module ifNotNil: [ module utf8Encoded asString ]. + | encodedModule key foundAddress | + encodedModule := module ifNotNil: [ module utf8Encoded asString ]. + key := module , '.' , moduleSymbol. + + ^ self symbolCache + at: key + ifAbsentPut: [ self primLoadSymbol: moduleSymbol module: encodedModule. ]. - "The primitive is expected the module to be a utf8Encoded String." - ^ self primLoadSymbol: moduleSymbol module: encodedString ] { #category : 'callbacks' } @@ -137,3 +143,9 @@ TFFIBackend >> primLoadSymbol: moduleSymbol module: module [ symbolName: moduleSymbol module: (module ifNotNil: [ :m | m asByteArray utf8Decoded ]) ] + +{ #category : 'accessing' } +TFFIBackend >> symbolCache [ + + ^ symbolCache ifNil: [ symbolCache := LRUCache new maximumWeight: 100; yourself ]. +] From 88b8cb172e7452edc3dd0e952364180fba9d63ee Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Fri, 31 Jan 2025 12:06:31 +0100 Subject: [PATCH 3/6] Fixing when module isNil --- src/ThreadedFFI/TFFIBackend.class.st | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ThreadedFFI/TFFIBackend.class.st b/src/ThreadedFFI/TFFIBackend.class.st index 86c7806e294..7abdefb43b4 100644 --- a/src/ThreadedFFI/TFFIBackend.class.st +++ b/src/ThreadedFFI/TFFIBackend.class.st @@ -74,9 +74,9 @@ TFFIBackend >> isAvailable [ { #category : 'instance creation' } TFFIBackend >> loadSymbol: moduleSymbol module: module [ - | encodedModule key foundAddress | + | encodedModule key | encodedModule := module ifNotNil: [ module utf8Encoded asString ]. - key := module , '.' , moduleSymbol. + key := module ifNil: [ moduleSymbol ] ifNotNil: [ module , '.' , moduleSymbol ]. ^ self symbolCache at: key From c93125cd4a6e2902b3f41e6398efad6fca6b8211 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Mon, 17 Feb 2025 18:37:40 +0100 Subject: [PATCH 4/6] Converting to float before the operation makes it 1.5 times faster, and does not allocate a fraction. --- src/Random-Core/Random.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Random-Core/Random.class.st b/src/Random-Core/Random.class.st index 51d2daa6caf..e2d05d1573e 100644 --- a/src/Random-Core/Random.class.st +++ b/src/Random-Core/Random.class.st @@ -142,7 +142,7 @@ Random >> maxValue [ Random >> next [ "Answer a random Float in the interval [0 to 1)." - ^ (self privateNextValue / (self maxValue + 1) ) asFloat + ^ (self privateNextValue asFloat / (self maxValue + 1) ) ] { #category : 'accessing' } From c0a54b4e8ca51ffe9270ffd9f5e243d105a74097 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Sat, 1 Mar 2025 13:15:04 +0100 Subject: [PATCH 5/6] Adding flags to ure or not the optimizations in the JIT of the FFI Calls --- ...sicTypeMarshallingInCallbacksTest.class.st | 2 +- .../TFBasicTypeMarshallingTest.class.st | 10 ++-- .../TFCallbacksTest.class.st | 10 +--- .../TFCallbacksUsingBytecodeTest.class.st | 36 ----------- .../TFFunctionCallTest.class.st | 14 ++--- src/ThreadedFFI-Tests/TFStructTest.class.st | 6 +- src/ThreadedFFI-Tests/TFTestCase.class.st | 60 ++++++++++++++++++- src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st | 2 +- .../BenchTFFISameThread.class.st | 6 ++ .../BenchTFFISameThreadUsingBytecode.class.st | 35 ++++++++++- .../TFCalloutMethodBuilder.class.st | 12 +++- src/ThreadedFFI/TFExternalFunction.class.st | 23 +++++++ .../TFExternalFunctionFlags.class.st | 39 ++++++++++++ 13 files changed, 189 insertions(+), 66 deletions(-) delete mode 100644 src/ThreadedFFI-Tests/TFCallbacksUsingBytecodeTest.class.st create mode 100644 src/ThreadedFFI/TFExternalFunctionFlags.class.st diff --git a/src/ThreadedFFI-Tests/TFBasicTypeMarshallingInCallbacksTest.class.st b/src/ThreadedFFI-Tests/TFBasicTypeMarshallingInCallbacksTest.class.st index 8332697bdfd..3313fbf4414 100644 --- a/src/ThreadedFFI-Tests/TFBasicTypeMarshallingInCallbacksTest.class.st +++ b/src/ThreadedFFI-Tests/TFBasicTypeMarshallingInCallbacksTest.class.st @@ -51,7 +51,7 @@ TFBasicTypeMarshallingInCallbacksTest >> call: typeName type: type value: aValue parameterTypes: { TFBasicType pointer. type } returnType: TFBasicType void). - runner invokeFunction: fun withArguments: { callback getHandle . aValue}. + self invokeFunction: fun withArguments: { callback getHandle . aValue}. ^ received ] diff --git a/src/ThreadedFFI-Tests/TFBasicTypeMarshallingTest.class.st b/src/ThreadedFFI-Tests/TFBasicTypeMarshallingTest.class.st index dbcae32f039..7458a4aae46 100644 --- a/src/ThreadedFFI-Tests/TFBasicTypeMarshallingTest.class.st +++ b/src/ThreadedFFI-Tests/TFBasicTypeMarshallingTest.class.st @@ -9,7 +9,7 @@ Class { TFBasicTypeMarshallingTest >> assertSignedIntsWithFunction: function [ | return | - return := runner invokeFunction: function withArguments: { -3 . 2 }. + return := self invokeFunction: function withArguments: { -3 . 2 }. self assert: return equals: -1 ] @@ -17,7 +17,7 @@ TFBasicTypeMarshallingTest >> assertSignedIntsWithFunction: function [ TFBasicTypeMarshallingTest >> assertUnsignedIntsWithFunction: function [ | return | - return := runner invokeFunction: function withArguments: { 3 . 2 }. + return := self invokeFunction: function withArguments: { 3 . 2 }. self assert: return equals: 5 ] @@ -46,7 +46,7 @@ TFBasicTypeMarshallingTest >> testSumDouble [ | function return | function := self externalFunction: 'sum_double' ofType: TFBasicType double. - return := runner invokeFunction: function withArguments: { 3.1 . 2.7 }. + return := self invokeFunction: function withArguments: { 3.1 . 2.7 }. self assert: (return between: 5.79999999 and: 5.80001) ] @@ -56,7 +56,7 @@ TFBasicTypeMarshallingTest >> testSumFloat [ | function return | function := self externalFunction: 'sum_float' ofType: TFBasicType float. - return := runner invokeFunction: function withArguments: { 3.1 . 2.7 }. + return := self invokeFunction: function withArguments: { 3.1 . 2.7 }. self assert: (return between: 5.79999999 and: 5.80001) ] @@ -221,7 +221,7 @@ TFBasicTypeMarshallingTest >> testUnrefPointer [ pointerToHolder := ExternalAddress allocate: TFBasicType pointer byteSize. TFBasicType pointer write: holder into: pointerToHolder. - return := runner invokeFunction: function withArguments: { pointerToHolder }. + return := self invokeFunction: function withArguments: { pointerToHolder }. self assert: return equals: holder. self assert: (TFBasicType sshort readValue: return) equals: 17 ] diff --git a/src/ThreadedFFI-Tests/TFCallbacksTest.class.st b/src/ThreadedFFI-Tests/TFCallbacksTest.class.st index 513a1a001d5..efc05756be6 100644 --- a/src/ThreadedFFI-Tests/TFCallbacksTest.class.st +++ b/src/ThreadedFFI-Tests/TFCallbacksTest.class.st @@ -21,12 +21,6 @@ TFCallbacksTest >> callCallback: aCallback [ self invokeFunction: function withArguments: {} ] -{ #category : 'executing' } -TFCallbacksTest >> invokeFunction: fun withArguments: arguments [ - - ^ runner invokeFunction: fun withArguments: arguments -] - { #category : 'instance creation' } TFCallbacksTest >> newTestCallbackDoing: aBlock [ @@ -140,7 +134,7 @@ TFCallbacksTest >> testReentrantCalloutsDuringCallback [ returnType: TFBasicType sint32 runner: runner. - returnValue := runner invokeFunction: fun withArguments: {callback getHandle. 0}. + returnValue := self invokeFunction: fun withArguments: {callback getHandle. 0}. self assert: returnValue equals: 7 ] @@ -171,7 +165,7 @@ TFCallbacksTest >> testReentrantCalloutsDuringCallbackUsingSameProcessForCallbac [ callback runStrategy: TFCallbackSameProcessRunStrategy uniqueInstance. - returnValue := runner invokeFunction: fun withArguments: { + returnValue := self invokeFunction: fun withArguments: { callback getHandle. 0 }. self assert: returnValue equals: 7 ] ensure: [ callback runStrategy callbackProcess terminate ] diff --git a/src/ThreadedFFI-Tests/TFCallbacksUsingBytecodeTest.class.st b/src/ThreadedFFI-Tests/TFCallbacksUsingBytecodeTest.class.st deleted file mode 100644 index 6a60b5e2c9e..00000000000 --- a/src/ThreadedFFI-Tests/TFCallbacksUsingBytecodeTest.class.st +++ /dev/null @@ -1,36 +0,0 @@ -Class { - #name : 'TFCallbacksUsingBytecodeTest', - #superclass : 'TFCallbacksTest', - #category : 'ThreadedFFI-Tests', - #package : 'ThreadedFFI-Tests' -} - -{ #category : 'building suites' } -TFCallbacksUsingBytecodeTest class >> testParameters [ - - ^ ParametrizedTestMatrix new - forSelector: #runner addOptions: { [ TFSameThreadRunner uniqueInstance ] } -] - -{ #category : 'executing' } -TFCallbacksUsingBytecodeTest >> invokeFunction: fun withArguments: arguments [ - - | argumentNames builder method | - argumentNames := arguments collectWithIndex: [ :e :i | #_arg_ , i printString ]. - - fun validate. - - builder := OCIRBuilder new - numArgs: arguments size; - addTemps: argumentNames. - - argumentNames do: [ :aName | builder pushTemp: aName ]. - builder sameThreadCallout: fun. - - fun definition returnType isVoid - ifTrue: [ builder pushReceiver; returnTop ] - ifFalse: [ builder returnTop ]. - - method := builder ir compiledMethod. - ^ method valueWithReceiver: nil arguments: arguments. -] diff --git a/src/ThreadedFFI-Tests/TFFunctionCallTest.class.st b/src/ThreadedFFI-Tests/TFFunctionCallTest.class.st index 10ce221a86c..9a062fb8a3f 100644 --- a/src/ThreadedFFI-Tests/TFFunctionCallTest.class.st +++ b/src/ThreadedFFI-Tests/TFFunctionCallTest.class.st @@ -27,7 +27,7 @@ TFFunctionCallTest >> testCallbackAsFunction [ fromAddress: callback getHandle definition: definition. - returnValue := runner invokeFunction: fun withArguments: {1. 2.0}. + returnValue := self invokeFunction: fun withArguments: {1. 2.0}. self assert: returnValue equals: 3.0 ] @@ -50,7 +50,7 @@ TFFunctionCallTest >> testCallbackInLoop [ parameterTypes: {TFBasicType pointer} returnType: TFBasicType sint). - returnValue := runner invokeFunction: fun withArguments: {callback getHandle}. + returnValue := self invokeFunction: fun withArguments: {callback getHandle}. self assert: returnValue equals: 42 ] @@ -73,7 +73,7 @@ TFFunctionCallTest >> testCallbackInSingleFunction [ parameterTypes: {TFBasicType pointer. TFBasicType sint} returnType: TFBasicType sint). - returnValue := runner invokeFunction: fun withArguments: {callback getHandle. 3}. + returnValue := self invokeFunction: fun withArguments: {callback getHandle. 3}. self assert: returnValue equals: 5 ] @@ -95,7 +95,7 @@ TFFunctionCallTest >> testCallingFunctionWithW64CallingConvention [ returnType: TFBasicType sint abi: DARWIN_X86_64_WIN64). - returnValue := runner invokeFunction: fun withArguments: (1 to: 10) asArray. + returnValue := self invokeFunction: fun withArguments: (1 to: 10) asArray. self assert: returnValue equals: 55 ] @@ -119,7 +119,7 @@ TFFunctionCallTest >> testVariadicFunctionWithOneFixedAndTwoOptional [ aString := '%d %d' utf8Encoded. aString pinInMemory. - return := runner invokeFunction: fun withArguments: {PointerUtils oopForObject: buffer. PointerUtils oopForObject: aString . 5 . 5}. + return := self invokeFunction: fun withArguments: {PointerUtils oopForObject: buffer. PointerUtils oopForObject: aString . 5 . 5}. self assert: return equals: 3 ] @@ -135,7 +135,7 @@ TFFunctionCallTest >> testWithFloatAndDouble [ parameterTypes: { TFBasicType float. TFBasicType double } returnType: TFBasicType float). - return := runner invokeFunction: fun withArguments: #(1.0 2.5). + return := self invokeFunction: fun withArguments: #(1.0 2.5). self assert: return equals: 3.5 ] @@ -152,7 +152,7 @@ TFFunctionCallTest >> testWithTwoInts [ parameterTypes: { TFBasicType sint. TFBasicType sint } returnType: TFBasicType sint). - return := runner invokeFunction: fun withArguments: {3. 2}. + return := self invokeFunction: fun withArguments: {3. 2}. self assert: return equals: 5 ] diff --git a/src/ThreadedFFI-Tests/TFStructTest.class.st b/src/ThreadedFFI-Tests/TFStructTest.class.st index 7762b61931e..98904856cfb 100644 --- a/src/ThreadedFFI-Tests/TFStructTest.class.st +++ b/src/ThreadedFFI-Tests/TFStructTest.class.st @@ -8,7 +8,7 @@ Class { { #category : 'tests' } TFStructTest >> longStructSize [ - ^ TFWorker default + ^ self invokeFunction: (TFExternalFunction name: 'sizeOfLongStruct' @@ -21,7 +21,7 @@ TFStructTest >> longStructSize [ { #category : 'tests' } TFStructTest >> pointSize [ - ^ self runner + ^ self invokeFunction: (TFExternalFunction name: 'sizeOfPoint' @@ -72,7 +72,7 @@ TFStructTest >> testReturnsAnStruct [ parameterTypes: {TFBasicType sint. TFBasicType sint} returnType: pointType. - aPoint := TFPointTestStruct fromHandle: (runner invokeFunction: fun withArguments: #(1 5)). + aPoint := TFPointTestStruct fromHandle: (self invokeFunction: fun withArguments: #(1 5)). self assert: aPoint x equals: 1. self assert: aPoint y equals: 5. diff --git a/src/ThreadedFFI-Tests/TFTestCase.class.st b/src/ThreadedFFI-Tests/TFTestCase.class.st index 03371cb86d6..5c1505e95c2 100644 --- a/src/ThreadedFFI-Tests/TFTestCase.class.st +++ b/src/ThreadedFFI-Tests/TFTestCase.class.st @@ -2,7 +2,8 @@ Class { #name : 'TFTestCase', #superclass : 'ParametrizedTestCase', #instVars : [ - 'runner' + 'runner', + 'useBytecode' ], #category : 'ThreadedFFI-Tests', #package : 'ThreadedFFI-Tests' @@ -12,7 +13,48 @@ Class { TFTestCase class >> testParameters [ ^ ParametrizedTestMatrix new - forSelector: #runner addOptions: { [ TFSameThreadRunner uniqueInstance ]". [ TFWorker named: 'fortest' ]." } + addCase: { #runner -> [ TFSameThreadRunner uniqueInstance ]. #useBytecode -> true}; + addCase: { #runner -> [ TFSameThreadRunner uniqueInstance ]. #useBytecode -> false}; + addCase: { #runner -> [ TFWorker named: 'fortest' ]. #useBytecode -> false }; + yourself + + +] + +{ #category : 'executing' } +TFTestCase >> invokeFunction: fun withArguments: arguments [ + + ^ useBytecode + ifTrue: [ self invokeFunctionUsingBytecode: fun withArguments: arguments ] + ifFalse: [ runner invokeFunction: fun withArguments: arguments ] + + +] + +{ #category : 'executing' } +TFTestCase >> invokeFunctionUsingBytecode: fun withArguments: arguments [ + + | argumentNames builder method | + + runner class = TFSameThreadRunner ifFalse: [ ^ self skip ]. + + argumentNames := arguments collectWithIndex: [ :e :i | #_arg_ , i printString ]. + + fun validate. + + builder := OCIRBuilder new + numArgs: arguments size; + addTemps: argumentNames. + + argumentNames do: [ :aName | builder pushTemp: aName ]. + builder sameThreadCallout: fun. + + fun definition returnType isVoid + ifTrue: [ builder pushReceiver; returnTop ] + ifFalse: [ builder returnTop ]. + + method := builder ir compiledMethod. + ^ method valueWithReceiver: nil arguments: arguments. ] { #category : 'accessing' } @@ -55,5 +97,17 @@ TFTestCase >> shortCallout [ parameterTypes: {} returnType: TFBasicType sint32). - ^ runner invokeFunction: fun + ^ self invokeFunction: fun withArguments: #(). +] + +{ #category : 'accessing' } +TFTestCase >> useBytecode [ + + ^ useBytecode +] + +{ #category : 'accessing' } +TFTestCase >> useBytecode: anObject [ + + useBytecode := anObject ] diff --git a/src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st b/src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st index 624013c9918..396ea57ec70 100644 --- a/src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st +++ b/src/ThreadedFFI-UFFI-Tests/BenchTFFI.class.st @@ -64,5 +64,5 @@ BenchTFFI >> runCallWithPointerVoid [ { #category : 'running' } BenchTFFI >> runCallWithPointerVoidWithByteArray [ - ^ [ self doPointerVoid: (ByteArray new: 17) ] bench + ^ [ self doPointerVoidForByteArray: (ByteArray new: 17) ] bench ] diff --git a/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThread.class.st b/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThread.class.st index 3556f93cf0c..5ca0e63bca5 100644 --- a/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThread.class.st +++ b/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThread.class.st @@ -33,6 +33,12 @@ BenchTFFISameThread >> doPointerVoid: aPointer [ self ffiCall: #(void id_int(void* aPointer)) ] +{ #category : 'private' } +BenchTFFISameThread >> doPointerVoidForByteArray: aPointer [ + + self ffiCall: #(void id_int(void* aPointer)) +] + { #category : 'private' } BenchTFFISameThread >> doSumWithConstants [ diff --git a/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThreadUsingBytecode.class.st b/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThreadUsingBytecode.class.st index 4d0a0cff732..6e9a7d7e7cf 100644 --- a/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThreadUsingBytecode.class.st +++ b/src/ThreadedFFI-UFFI-Tests/BenchTFFISameThreadUsingBytecode.class.st @@ -105,6 +105,38 @@ BenchTFFISameThreadUsingBytecode >> doPointerVoid: aPointer [ name: #id_int moduleName: TFTestLibraryUsingSameThreadRunner uniqueInstance libraryName definition: definition. + + function flags: TFExternalFunctionFlags useOptimizedVersion | TFExternalFunctionFlags pointersMightBeExternalAddresses. + + ^ OCIRBuilder buildIR: [ :builder | + builder + numArgs: 1; + addTemps: #( #aPointer ); + pushTemp: #aPointer; +" send: #tfPointerAddress; +" sameThreadCallout: function; + pushReceiver; + returnTop ] +] + +{ #category : 'private' } +BenchTFFISameThreadUsingBytecode >> doPointerVoidForByteArray: aPointer [ + + | definition function | + + + + definition := TFFunctionDefinition + parameterTypes: { TFBasicType pointer } + returnType: TFBasicType void. + + function := TFExternalFunction + name: #id_int + moduleName: TFTestLibraryUsingSameThreadRunner uniqueInstance libraryName + definition: definition. + + function flags: TFExternalFunctionFlags useOptimizedVersion | TFExternalFunctionFlags pointersMightBeObjects +| TFExternalFunctionFlags pointersMightBeExternalAddresses. ^ OCIRBuilder buildIR: [ :builder | builder @@ -113,6 +145,7 @@ BenchTFFISameThreadUsingBytecode >> doPointerVoid: aPointer [ pushTemp: #aPointer; " send: #tfPointerAddress; " sameThreadCallout: function; + pushReceiver; returnTop ] ] @@ -152,6 +185,6 @@ BenchTFFISameThreadUsingBytecode >> runCallWithPointerVoid [ BenchTFFISameThreadUsingBytecode >> runCallWithPointerVoidWithByteArray [ - (self class>> #doPointerVoid: ) literals select: [:e | e class = TFExternalFunction] thenDo: [:e | e validate]. + (self class>> #doPointerVoidForByteArray: ) literals select: [:e | e class = TFExternalFunction] thenDo: [:e | e validate]. ^ super runCallWithPointerVoidWithByteArray ] diff --git a/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st b/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st index ade28048fd7..2c5a6c98deb 100644 --- a/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st +++ b/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st @@ -188,7 +188,8 @@ TFCalloutMethodBuilder >> generateFFICallout: builder spec: functionSpec ffiLibr TFCalloutMethodBuilder >> generateFFICalloutUsingBytecode: builder spec: functionSpec ffiLibrary: ffiLibrary [ - | functionDefinition | + | functionDefinition flags | + TFCalloutAPI isTracing ifTrue: [ TFCalloutAPI trace: sender. builder @@ -196,8 +197,17 @@ TFCalloutMethodBuilder >> generateFFICalloutUsingBytecode: builder spec: functio pushLiteral: sender; send: #trace: ]. + flags := 0. + + (requestor options includesKey: #optUseOptimizedVersion) + ifTrue: [flags := flags | TFExternalFunctionFlags useOptimizedVersion ]. + + (requestor options includesKey: #optPointersMightBeExternalAddresses) + ifTrue: [flags := flags | TFExternalFunctionFlags pointersMightBeExternalAddresses ]. + functionDefinition := self createFFICalloutLiteralFromSpec: functionSpec. functionDefinition validate. + functionDefinition flags: flags. "iterate arguments in order (in the function) to create the function call" functionSpec arguments diff --git a/src/ThreadedFFI/TFExternalFunction.class.st b/src/ThreadedFFI/TFExternalFunction.class.st index ae7a431c95d..456cb3cdbd2 100644 --- a/src/ThreadedFFI/TFExternalFunction.class.st +++ b/src/ThreadedFFI/TFExternalFunction.class.st @@ -27,9 +27,13 @@ Class { #instVars : [ 'handle', 'definition', + 'flags', 'functionName', 'moduleName' ], + #pools : [ + 'TFExternalFunctionFlags' + ], #category : 'ThreadedFFI-Base', #package : 'ThreadedFFI', #tag : 'Base' @@ -119,6 +123,18 @@ TFExternalFunction >> definition: anObject [ definition := anObject ] +{ #category : 'accessing' } +TFExternalFunction >> flags [ + + ^ flags +] + +{ #category : 'accessing' } +TFExternalFunction >> flags: anObject [ + + flags := anObject +] + { #category : 'accessing' } TFExternalFunction >> functionName [ ^ functionName @@ -129,6 +145,13 @@ TFExternalFunction >> functionName: anObject [ functionName := anObject ] +{ #category : 'initialization' } +TFExternalFunction >> initialize [ + + super initialize. + flags := 0. +] + { #category : 'accessing' } TFExternalFunction >> moduleName [ ^ moduleName diff --git a/src/ThreadedFFI/TFExternalFunctionFlags.class.st b/src/ThreadedFFI/TFExternalFunctionFlags.class.st new file mode 100644 index 00000000000..8b4f87f4da5 --- /dev/null +++ b/src/ThreadedFFI/TFExternalFunctionFlags.class.st @@ -0,0 +1,39 @@ +Class { + #name : 'TFExternalFunctionFlags', + #superclass : 'SharedPool', + #classVars : [ + 'PointersMightBeExternalAddresses', + 'PointersMightBeObjects', + 'UseOptimizedVersion' + ], + #category : 'ThreadedFFI-Base', + #package : 'ThreadedFFI', + #tag : 'Base' +} + +{ #category : 'class initialization' } +TFExternalFunctionFlags class >> initialize [ + + UseOptimizedVersion := 1 << 0. + PointersMightBeObjects := 1 << 1. + PointersMightBeExternalAddresses := 1 << 2. + +] + +{ #category : 'class initialization' } +TFExternalFunctionFlags class >> pointersMightBeExternalAddresses [ + + ^ PointersMightBeExternalAddresses +] + +{ #category : 'class initialization' } +TFExternalFunctionFlags class >> pointersMightBeObjects [ + + ^ PointersMightBeObjects +] + +{ #category : 'class initialization' } +TFExternalFunctionFlags class >> useOptimizedVersion [ + + ^ UseOptimizedVersion +] From 87aeed06f4753d8ba3bc8307c4f598e0dd49411d Mon Sep 17 00:00:00 2001 From: tesonep Date: Tue, 4 Mar 2025 13:33:13 +0000 Subject: [PATCH 6/6] Adding tests for the optimized functions --- .../TFOptimizedCallsTests.class.st | 174 ++++++++++++++++++ src/ThreadedFFI-Tests/TFTestCase.class.st | 42 +++-- 2 files changed, 204 insertions(+), 12 deletions(-) create mode 100644 src/ThreadedFFI-Tests/TFOptimizedCallsTests.class.st diff --git a/src/ThreadedFFI-Tests/TFOptimizedCallsTests.class.st b/src/ThreadedFFI-Tests/TFOptimizedCallsTests.class.st new file mode 100644 index 00000000000..c1d379601ac --- /dev/null +++ b/src/ThreadedFFI-Tests/TFOptimizedCallsTests.class.st @@ -0,0 +1,174 @@ +Class { + #name : 'TFOptimizedCallsTests', + #superclass : 'TFTestCase', + #category : 'ThreadedFFI-Tests', + #package : 'ThreadedFFI-Tests' +} + +{ #category : 'building suites' } +TFOptimizedCallsTests class >> testParameters [ + + ^ ParametrizedTestMatrix new + addCase: { #runner -> [ TFSameThreadRunner uniqueInstance ]. #useBytecode -> true}; + yourself + + +] + +{ #category : 'tests' } +TFOptimizedCallsTests >> performTestOn: aBlock argumentTypes: argumentTypes returnType: returnType arguments: arguments validationBlock: validationBlock [ + + | callback definition function method | + + callback := TFCallback + forCallback: aBlock + parameters: argumentTypes + returnType: returnType + runner: runner. + + definition := TFFunctionDefinition + parameterTypes: argumentTypes + returnType: returnType. + + function := TFExternalFunction + fromAddress: callback getHandle + definition: definition. + + function flags: TFExternalFunctionFlags useOptimizedVersion | TFExternalFunctionFlags pointersMightBeExternalAddresses. + + method := self + prepareMethodUsingBytecodeFor: function + withArguments: arguments. + + + 10 timesRepeat: [ validationBlock value: method value: arguments ] +] + +{ #category : 'tests' } +TFOptimizedCallsTests >> testDoubleToVoid [ + + | arg0 | + + self + performTestOn: [ :dbl | arg0 := dbl ] + argumentTypes: {TFBasicType double} + returnType: TFBasicType void + arguments: { 17.5 } + validationBlock: [ :method :args | + arg0 := nil. + method valueWithReceiver: nil arguments: args. + self assert: arg0 equals: args first ] +] + +{ #category : 'tests' } +TFOptimizedCallsTests >> testPointerDoubleDoubleDoubleDoubleToVoid [ + + | arg0 arg1 arg2 arg3 arg4 | + + self + performTestOn: [ :ptr :dbl0 :dbl1 :dbl2 :dbl3 | arg0 := ptr. arg1 := dbl0. arg2 := dbl1. arg3 := dbl2. arg4 := dbl3 ] + argumentTypes: {TFBasicType pointer. TFBasicType double. TFBasicType double. TFBasicType double. TFBasicType double} + returnType: TFBasicType void + arguments: { 16r20340 tfPointerAddress. 16.7 . 43.23 . 0.123456789 . -1234.5513e10 } + validationBlock: [ :method :args | + arg0 := nil. + arg1 := nil. + arg2 := nil. + arg3 := nil. + method valueWithReceiver: nil arguments: args. + self assert: arg0 equals: args first. + self assert: arg1 equals: args second. + self assert: arg2 equals: args third. + self assert: arg3 equals: args fourth. + self assert: arg4 equals: args fifth] +] + +{ #category : 'tests' } +TFOptimizedCallsTests >> testPointerDoubleDoubleDoubleToVoid [ + + | arg0 arg1 arg2 arg3 | + + self + performTestOn: [ :ptr :dbl0 :dbl1 :dbl2 | arg0 := ptr. arg1 := dbl0. arg2 := dbl1. arg3 := dbl2 ] + argumentTypes: {TFBasicType pointer. TFBasicType double. TFBasicType double. TFBasicType double} + returnType: TFBasicType void + arguments: { 16r20340 tfPointerAddress. 16.7 . 43.23 . 0.123456789 } + validationBlock: [ :method :args | + arg0 := nil. + arg1 := nil. + arg2 := nil. + arg3 := nil. + method valueWithReceiver: nil arguments: args. + self assert: arg0 equals: args first. + self assert: arg1 equals: args second. + self assert: arg2 equals: args third. + self assert: arg3 equals: args fourth] +] + +{ #category : 'tests' } +TFOptimizedCallsTests >> testPointerDoubleDoubleToVoid [ + + | arg0 arg1 arg2 | + + self + performTestOn: [ :ptr :dbl0 :dbl1 | arg0 := ptr. arg1 := dbl0. arg2 := dbl1 ] + argumentTypes: {TFBasicType pointer. TFBasicType double. TFBasicType double} + returnType: TFBasicType void + arguments: { 16r20340 tfPointerAddress. 16.7 . 43.23 } + validationBlock: [ :method :args | + arg0 := nil. + arg1 := nil. + arg2 := nil. + method valueWithReceiver: nil arguments: args. + self assert: arg0 equals: args first. + self assert: arg1 equals: args second. + self assert: arg2 equals: args third] +] + +{ #category : 'tests' } +TFOptimizedCallsTests >> testPointerToPointer [ + + | arg0 | + + self + performTestOn: [ :ptr | arg0 := ptr. 16r170000 ] + argumentTypes: {TFBasicType pointer} + returnType: TFBasicType pointer + arguments: {16r89495 tfPointerAddress} + validationBlock: [ :method :args | + arg0 := nil. + self assert: (method valueWithReceiver: nil arguments: args) equals: 16r170000 tfPointerAddress. + self assert: arg0 equals: args first ] + + +] + +{ #category : 'tests' } +TFOptimizedCallsTests >> testPointerToVoid [ + + | arg0 | + + self + performTestOn: [ :ptr | arg0 := ptr ] + argumentTypes: {TFBasicType pointer} + returnType: TFBasicType void + arguments: { 16r20340 tfPointerAddress } + validationBlock: [ :method :args | + arg0 := nil. + method valueWithReceiver: nil arguments: args. + self assert: arg0 equals: args first ] +] + +{ #category : 'tests' } +TFOptimizedCallsTests >> testVoidToPointer [ + + self + performTestOn: [ 16r170000 ] + argumentTypes: {} + returnType: TFBasicType pointer + arguments: {} + validationBlock: [ :method :args | + self assert: (method valueWithReceiver: nil arguments: args) equals: (ExternalAddress fromAddress: 16r170000) ] + + +] diff --git a/src/ThreadedFFI-Tests/TFTestCase.class.st b/src/ThreadedFFI-Tests/TFTestCase.class.st index 5c1505e95c2..0babc880e41 100644 --- a/src/ThreadedFFI-Tests/TFTestCase.class.st +++ b/src/ThreadedFFI-Tests/TFTestCase.class.st @@ -34,7 +34,35 @@ TFTestCase >> invokeFunction: fun withArguments: arguments [ { #category : 'executing' } TFTestCase >> invokeFunctionUsingBytecode: fun withArguments: arguments [ - | argumentNames builder method | + | method | + method := self prepareMethodUsingBytecodeFor: fun withArguments: arguments. + ^ method valueWithReceiver: nil arguments: arguments. +] + +{ #category : 'accessing' } +TFTestCase >> libraryPath [ + + Smalltalk os isUnix ifTrue: [ ^ 'libTestLibrary.so' ]. + Smalltalk os isMacOS ifTrue: [ ^ 'libTestLibrary.dylib' ]. + Smalltalk os isWindows ifTrue: [ ^ 'TestLibrary.dll' ]. + + self error: 'Unsupported Platform' +] + +{ #category : 'instance creation' } +TFTestCase >> newTestCallbackDoing: aBlock [ + + ^ TFCallback + forCallback: aBlock + parameters: {} + returnType: TFBasicType void + runner: runner +] + +{ #category : 'executing' } +TFTestCase >> prepareMethodUsingBytecodeFor: fun withArguments: arguments [ + + | argumentNames builder | runner class = TFSameThreadRunner ifFalse: [ ^ self skip ]. @@ -53,18 +81,8 @@ TFTestCase >> invokeFunctionUsingBytecode: fun withArguments: arguments [ ifTrue: [ builder pushReceiver; returnTop ] ifFalse: [ builder returnTop ]. - method := builder ir compiledMethod. - ^ method valueWithReceiver: nil arguments: arguments. -] - -{ #category : 'accessing' } -TFTestCase >> libraryPath [ + ^ builder ir compiledMethod. - Smalltalk os isUnix ifTrue: [ ^ 'libTestLibrary.so' ]. - Smalltalk os isMacOS ifTrue: [ ^ 'libTestLibrary.dylib' ]. - Smalltalk os isWindows ifTrue: [ ^ 'TestLibrary.dll' ]. - - self error: 'Unsupported Platform' ] { #category : 'running' }