[WIP] Extending ffi to use bytecode

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, 

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

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 |

src/Kernel-CodeModel/Context.class.st

@@ -929,6 +929,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

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]

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,

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 [
 

src/OpalCompiler-Core/OCIRBytecodeGenerator.class.st

@@ -625,6 +625,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}

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 [
 

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 [
 

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

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 [
 

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

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.

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
 ]
 

src/ThreadedFFI-Tests/TFBasicTypeMarshallingTest.class.st

@@ -9,15 +9,15 @@ Class {
 TFBasicTypeMarshallingTest >> assertSignedIntsWithFunction: function [
 
 	| return |
-	return := runner invokeFunction: function withArguments: { -3 . 2 }.
+	return := self invokeFunction: function withArguments: { -3 . 2 }.
 	self assert: return equals: -1
 ]
 
 { #category : 'accessing' }
 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
 ]

src/ThreadedFFI-Tests/TFCallbacksTest.class.st

@@ -18,7 +18,7 @@ TFCallbacksTest >> callCallback: aCallback [
 	function := TFExternalFunction fromAddress: aCallback getHandle
 		definition: functionDefinition.
 
-	runner invokeFunction: function withArguments: {}
+	self invokeFunction: function withArguments: {}
 ]
 
 { #category : 'instance creation' }
@@ -129,12 +129,12 @@ 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.
 
-	returnValue := runner invokeFunction: fun withArguments: {callback getHandle. 0}.
+	returnValue := self invokeFunction: fun withArguments: {callback getHandle. 0}.
 	self assert: returnValue equals: 7
 ]
 
@@ -155,7 +155,7 @@ TFCallbacksTest >> testReentrantCalloutsDuringCallbackUsingSameProcessForCallbac
 			            times = 7
 				            ifTrue: [ times ]
 				            ifFalse: [
-					            runner invokeFunction: fun withArguments: {
+					            self invokeFunction: fun withArguments: {
 							            callback getHandle.
 							            (times + 1) } ] ]
 		            parameters: { TFBasicType sint }
@@ -165,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 ]
@@ -189,6 +189,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
 ]

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
 ]