From 9f90f8d5d6bb878ab004f7e035c93ead1c10ee0a Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Mon, 13 Jan 2025 15:18:11 +0100 Subject: [PATCH 01/19] - Adding primitive that extracts the pointer to the content of the object. It pins the object if it is not pinned. - Adding JIT version of this primitive - Adding tests --- .../CogObjectRepresentationForSpur.class.st | 24 ++++++++ smalltalksrc/VMMaker/Cogit.class.st | 5 +- .../VMMaker/SpurMemoryManager.class.st | 1 + .../VMMaker/StackInterpreter.class.st | 5 +- .../StackInterpreterPrimitives.class.st | 31 ++++++++++ .../VMJittedGeneralPrimitiveTest.class.st | 56 +++++++++++++++++++ .../VMMakerTests/VMPrimitiveTest.class.st | 48 ++++++++++++++++ 7 files changed, 167 insertions(+), 3 deletions(-) diff --git a/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st b/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st index 27f3b7464e..23f496e2ff 100644 --- a/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st +++ b/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st @@ -1256,6 +1256,30 @@ CogObjectRepresentationForSpur >> genPrimitiveAtPut [ ^self genPrimitiveAtPutSigned: false ] +{ #category : 'primitive generators' } +CogObjectRepresentationForSpur >> genPrimitiveGetAddressOfOOPPinningIfNeeded [ + + | jumpImmediate jumpNonPinned jumpFailAlloc | + jumpImmediate := self genJumpImmediate: ReceiverResultReg. + + cogit MoveMw: 0 r: ReceiverResultReg R: ClassReg. + + cogit TstCq: (1 << objectMemory pinnedBitShift) R: ClassReg. + jumpNonPinned := cogit JumpZero: 0. + + cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: ClassReg. + + jumpFailAlloc := self genAllocExternalAddressValue: ClassReg into: ReceiverResultReg scratchReg: SendNumArgsReg scratchReg: TempReg. + + cogit genPrimReturn. + + jumpImmediate jmpTarget: + (jumpNonPinned jmpTarget: + (jumpFailAlloc jmpTarget: cogit Label)). + + ^ 0 +] + { #category : 'primitive generators' } CogObjectRepresentationForSpur >> genPrimitiveIdenticalOrNotIf: orNot [ | jumpCmp comp | diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index 10973486a5..894755e581 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -853,7 +853,7 @@ Cogit class >> initializePrimitiveTable [ N.B. primitives that don't have an explicit arg count (the integer following the generator) may be variadic." "SimpleStackBasedCogit initializePrimitiveTable" MaxCompiledPrimitiveIndex := self objectRepresentationClass wordSize = 8 - ifTrue: [659] + ifTrue: [660] ifFalse: [222]. primitiveTable := CArrayAccessor on: (Array new: MaxCompiledPrimitiveIndex + 1). self table: primitiveTable from: @@ -1142,6 +1142,9 @@ Cogit class >> initializePrimitiveTable [ (657 genPrimitiveStoreChar32IntoExternalAddress) (658 genPrimitiveStoreFloat32IntoExternalAddress) (659 genPrimitiveStoreFloat64IntoExternalAddress) + + (660 genPrimitiveGetAddressOfOOPPinningIfNeeded) + ) ] diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index fe0cf98fca..c756733b05 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -10516,6 +10516,7 @@ SpurMemoryManager >> pinObject: objOop [ { #category : 'header format' } SpurMemoryManager >> pinnedBitShift [ + "bit 1 of 3-bit field above format (little endian)" ^30 diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index 5e787455cc..9c3805f1b2 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -1001,7 +1001,7 @@ StackInterpreter class >> initializePrimitiveTable [ "self initializePrimitiveTable" "NOTE: The real limit here is 2047 because of the old method header layout but there is no point in going over the needed size" - MaxPrimitiveIndex := 660. + MaxPrimitiveIndex := 661. MaxQuickPrimitiveIndex := 519. PrimNumberExternalCall := 117. PrimNumberDoPrimitive := 118. @@ -1398,7 +1398,8 @@ StackInterpreter class >> initializePrimitiveTable [ (658 primitiveStoreFloat32IntoExternalAddress) (659 primitiveStoreFloat64IntoExternalAddress) - (660 primitiveFail) + (660 primitiveGetAddressOfOOPPinningIfNeeded) + (661 primitiveFail) ) ] diff --git a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st index b3d2ca8f70..2ffe3d63e4 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -1431,6 +1431,37 @@ StackInterpreterPrimitives >> primitiveFullGC [ super primitiveFullGC ] +{ #category : 'ffi' } +StackInterpreterPrimitives >> primitiveGetAddressOfOOPPinningIfNeeded [ + + "This primitive returns the address of an image object. + If the object is not pinned it will pin it. + Receives an OOP as parameter and returns an ExternalAddress" + + | externalAddress oop | + + + + argumentCount = 0 ifFalse: [ self primitiveFail. ^ self ]. + + oop := self stackObjectValue: 0. + self failed ifTrue: [ ^ self]. + + (objectMemory isPinned: oop) + ifFalse: [ + (oop := objectMemory pinObject: oop) = 0 ifTrue: [ self primitiveFail. ^ self ]]. + + externalAddress := objectMemory + instantiateClass: objectMemory classExternalAddress + indexableSize: BytesPerWord. + + externalAddress = nil ifTrue: [ self primitiveFail. ^ self ]. + + objectMemory storePointer: 0 ofObject: externalAddress withValue: (self cCoerce: (oop + BaseHeaderSize) to: #sqInt). + + ^ self methodReturnValue: externalAddress +] + { #category : 'I/O primitives' } StackInterpreterPrimitives >> primitiveGetCurrentWorkingDirectory [ diff --git a/smalltalksrc/VMMakerTests/VMJittedGeneralPrimitiveTest.class.st b/smalltalksrc/VMMakerTests/VMJittedGeneralPrimitiveTest.class.st index d647fb061c..e5c149677c 100644 --- a/smalltalksrc/VMMakerTests/VMJittedGeneralPrimitiveTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJittedGeneralPrimitiveTest.class.st @@ -1391,6 +1391,62 @@ VMJittedGeneralPrimitiveTest >> testPrimitiveFormatTrueObject [ self assert: self machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 0). "According to SpurMemomyManager >> formatOfHeader:, the format of the True object is 0." ] +{ #category : 'tests - primitiveGetAddressOfOOPPinningIfNeeded' } +VMJittedGeneralPrimitiveTest >> testPrimitiveGetAddressOfOOPPinningIfNeededFailsIfObjectIsNotPinned [ + + | endInstruction primitiveAddress oop | + + primitiveAddress := self compile: [ + cogit objectRepresentation genPrimitiveGetAddressOfOOPPinningIfNeeded. + "If the primitive fails it continues, so we need to have an instruction to detect the end" + endInstruction := cogit Stop ]. + + oop := self newObjectWithSlots: 2. + + self prepareStackForSendReceiver: oop arguments: {}. + + self runFrom: primitiveAddress until: endInstruction address. +] + +{ #category : 'tests - primitiveGetAddressOfOOPPinningIfNeeded' } +VMJittedGeneralPrimitiveTest >> testPrimitiveGetAddressOfOOPPinningIfNeededFailsWithImmediate [ + + | endInstruction primitiveAddress | + + primitiveAddress := self compile: [ + cogit objectRepresentation genPrimitiveGetAddressOfOOPPinningIfNeeded. + "If the primitive fails it continues, so we need to have an instruction to detect the end" + endInstruction := cogit Stop ]. + + self prepareStackForSendReceiver: (memory integerObjectOf: 7) arguments: {}. + + self runFrom: primitiveAddress until: endInstruction address. +] + +{ #category : 'tests - primitiveGetAddressOfOOPPinningIfNeeded' } +VMJittedGeneralPrimitiveTest >> testPrimitiveGetAddressOfOOPPinningIfNeededReturnsTheContentsAddress [ + + | endInstruction primitiveAddress oop externalAddressClass | + + externalAddressClass := self newClassInOldSpaceWithSlots: 0 instSpec: (memory byteFormatForNumBytes: 0). + memory classExternalAddress: externalAddressClass. + + primitiveAddress := self compile: [ + cogit objectRepresentation genPrimitiveGetAddressOfOOPPinningIfNeeded. + "If the primitive fails it continues, so we need to have an instruction to detect the end" + endInstruction := cogit Stop ]. + + oop := self newOldSpaceObjectWithSlots: 2. + memory setIsPinnedOf: oop to: true. + + self prepareStackForSendReceiver: oop arguments: {}. + + self runFrom: primitiveAddress until: callerAddress. + + self assert: (memory fetchClassOf: self machineSimulator receiverRegisterValue) equals: externalAddressClass. + self assert: (interpreter readAddress: self machineSimulator receiverRegisterValue) equals: oop + memory baseHeaderSize. +] + { #category : 'tests - primitiveGreaterOrEqual' } VMJittedGeneralPrimitiveTest >> testPrimitiveGreaterOrEqualDoesNotCompileIfReceiverTagIsNotSmallInteger [ diff --git a/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st b/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st index 009a19163e..44bd99dc44 100644 --- a/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st +++ b/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st @@ -1959,6 +1959,54 @@ VMPrimitiveTest >> testPrimitiveFormatWithWeakArray [ equals: (memory integerObjectOf: memory weakArrayFormat) ] +{ #category : 'tests - primitiveGetAddressOfOOPPinningIfNeeded' } +VMPrimitiveTest >> testPrimitiveGetAddressOfOOPPinningIfNeededFailsOnImmediate [ + + interpreter push: (memory integerObjectOf: 2). + + interpreter primitiveGetAddressOfOOPPinningIfNeeded. + + self assert: interpreter failed. + + +] + +{ #category : 'tests - primitiveGetAddressOfOOPPinningIfNeeded' } +VMPrimitiveTest >> testPrimitiveGetAddressOfOOPPinningIfNeededReturnsAddressAndPinsIfObjectIsNotPinned [ + + | oop externalAddressClass | + oop := self newObjectWithSlots: 2. + externalAddressClass := self newClassInOldSpaceWithSlots: 0 instSpec: (memory byteFormatForNumBytes: 0). + memory classExternalAddress: externalAddressClass. + + interpreter push: oop. + interpreter primitiveGetAddressOfOOPPinningIfNeeded. + + self assert: (memory isForwarded: oop). + + self assert: (memory fetchClassOf: interpreter stackTop) equals: externalAddressClass. + self assert: (interpreter readAddress: interpreter stackTop) equals: (memory followForwarded: oop) + memory baseHeaderSize. +] + +{ #category : 'tests - primitiveGetAddressOfOOPPinningIfNeeded' } +VMPrimitiveTest >> testPrimitiveGetAddressOfOOPPinningIfNeededReturnsAddressIfObjectIsPinned [ + + | oop externalAddressClass | + oop := self newObjectWithSlots: 2. + oop := memory pinObject: oop. + + externalAddressClass := self newClassInOldSpaceWithSlots: 0 instSpec: (memory byteFormatForNumBytes: 0). + memory classExternalAddress: externalAddressClass. + + interpreter push: oop. + interpreter primitiveGetAddressOfOOPPinningIfNeeded. + + self deny: (memory isForwarded: oop). + + self assert: (memory fetchClassOf: interpreter stackTop) equals: externalAddressClass. + self assert: (interpreter readAddress: interpreter stackTop) equals: oop + memory baseHeaderSize. +] + { #category : 'tests - primitiveImmutability' } VMPrimitiveTest >> testPrimitiveGetImmutabilityOfImmediateReturnsTrue [ From bd814d4e64f59c0384a4b425800b31e672d4c6fe Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 23 Jan 2025 14:02:02 +0100 Subject: [PATCH 02/19] Co-authored-by: doste - Adding a new bytecode for SameThreadCallout - Adding general JIT implementation using a trampoline - Adding Tests Based in the work and experiments of Juan Ignacio Bianchi --- smalltalksrc/Melchor/VMObjectIndices.class.st | 1 + smalltalksrc/Slang/CCodeGenerator.class.st | 4 +- smalltalksrc/VMMaker/CoInterpreter.class.st | 50 ++++ smalltalksrc/VMMaker/CogVMSimulator.class.st | 1 + smalltalksrc/VMMaker/LibFFICIF.class.st | 7 + .../VMMaker/SimpleStackBasedCogit.class.st | 46 +++- .../VMMaker/SpurMemoryManager.class.st | 2 + .../VMMaker/StackDepthFinder.class.st | 21 ++ .../VMMaker/StackInterpreter.class.st | 136 ++++++++++- .../StackInterpreterPrimitives.class.st | 169 +++++++------ .../StackToRegisterMappingCogit.class.st | 29 ++- .../UnicornARMv8Simulator.class.st | 6 + .../VMMakerTests/VMAbstractFFITest.class.st | 37 --- .../VMAbstractPrimitiveTest.class.st | 22 +- ...adBytecodeArgumentMarshallingTest.class.st | 112 +++++++++ ...readBytecodeReturnMarshallingTest.class.st | 42 ++++ .../VMMakerTests/VMInterpreterTests.class.st | 42 ---- .../VMJitFFISameThreadCalloutTest.class.st | 222 ++++++++++++++++++ .../VMPrimitiveCallAbstractTest.class.st | 23 -- .../VMPushThisContextRoutineTest.class.st | 1 + ...SimpleStackBasedCogitAbstractTest.class.st | 23 ++ .../VMSpurMemoryManagerTest.class.st | 87 +++++++ 22 files changed, 901 insertions(+), 182 deletions(-) create mode 100644 smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeArgumentMarshallingTest.class.st create mode 100644 smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeReturnMarshallingTest.class.st create mode 100644 smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st diff --git a/smalltalksrc/Melchor/VMObjectIndices.class.st b/smalltalksrc/Melchor/VMObjectIndices.class.st index c4f99caefa..98c1d1ddd5 100644 --- a/smalltalksrc/Melchor/VMObjectIndices.class.st +++ b/smalltalksrc/Melchor/VMObjectIndices.class.st @@ -74,6 +74,7 @@ Class { 'SelectorCannotReturn', 'SelectorCounterTripped', 'SelectorDoesNotUnderstand', + 'SelectorInvalidFFICall', 'SelectorMustBeBoolean', 'SelectorRunWithIn', 'SelectorSistaTrap', diff --git a/smalltalksrc/Slang/CCodeGenerator.class.st b/smalltalksrc/Slang/CCodeGenerator.class.st index 8154d7f840..2fab900891 100644 --- a/smalltalksrc/Slang/CCodeGenerator.class.st +++ b/smalltalksrc/Slang/CCodeGenerator.class.st @@ -5272,7 +5272,9 @@ CCodeGenerator >> validateLocalizationOfGlobals: varList exceptMethod: methodNam methodFreeVariables := meth freeVariableReferences asSet. localizationCandidates do: [ :candidate | (methodFreeVariables includes: candidate) - ifTrue: [ variablesInConflict add: candidate ] ] ] ]. + ifTrue: [ + 1halt. + variablesInConflict add: candidate ] ] ] ]. variablesInConflict ifNotEmpty: [ | errorMessage | errorMessage := String streamContents: [ :stream | diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index e8040e5fe9..b8c0f39487 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -1181,6 +1181,20 @@ CoInterpreter >> ceCounterTripped: condition [ ^true ] +{ #category : 'trampolines' } +CoInterpreter >> ceFallbackInvalidFFICall: savedInstructionPointer [ + + | ourContext | + ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer. + self push: ourContext. + + self push: savedInstructionPointer. + ^self + ceSendAbort: (objectMemory splObj: SelectorInvalidFFICall) + to: ourContext + numArgs: 2 +] + { #category : 'trampolines' } CoInterpreter >> ceInterpretMethodFromPIC: aMethodObj receiver: rcvr [ @@ -1408,6 +1422,42 @@ CoInterpreter >> ceReturnToInterpreter: anOop [ self unreachable ] +{ #category : 'trampolines' } +CoInterpreter >> ceSameThreadCalloutWithLiteralIndex: functionDefinitionIndex [ + + + + + | savedInstructionPointer cogMethod functionDefinition externalFunction cif returnValue | + + "saving instruction pointer in a temporary, as the FFI call can reenter in the interpreter and affect the instance variable" + savedInstructionPointer := instructionPointer := self popStack. + + cogMethod := self mframeCogMethod: framePointer . + functionDefinition := self literal: functionDefinitionIndex ofMethod: cogMethod methodObject. + + externalFunction := self getHandler: functionDefinition. + externalFunction ifNil: [ + self logDebug: 'Invalid External Function Argument'. + ^ self ceFallbackInvalidFFICall: savedInstructionPointer ]. + + cif := self getHandlerAsCif: (objectMemory fetchPointer: 1 ofObject: functionDefinition). + + cif ifNil: [ + self logDebug: 'Invalid CIF in ExternalFunction'. + ^ self ceFallbackInvalidFFICall: savedInstructionPointer ] . + + self doSameThreadCalloutBytecodeFor: externalFunction andCif: cif. + self failed + ifTrue: [ ^ self ceFallbackInvalidFFICall: savedInstructionPointer ]. + + returnValue := cif returnType type = FFI_TYPE_VOID ifTrue: [ 0 ] ifFalse: [ self stackTop ]. + + self push: savedInstructionPointer. + + ^ returnValue +] + { #category : 'trampolines' } CoInterpreter >> ceSend: maybeForwardedSelector above: methodClass to: receiver numArgs: numArgs [ "Entry-point for an unlinked directed super send in a CogMethod. diff --git a/smalltalksrc/VMMaker/CogVMSimulator.class.st b/smalltalksrc/VMMaker/CogVMSimulator.class.st index 817db6e8eb..b8c620b037 100644 --- a/smalltalksrc/VMMaker/CogVMSimulator.class.st +++ b/smalltalksrc/VMMaker/CogVMSimulator.class.st @@ -460,6 +460,7 @@ CogVMSimulator >> cr [ { #category : 'debug support' } CogVMSimulator >> debugStackPointersFor: aMethod [ + ^CArrayAccessor on: (StackDepthFinder on: (VMCompiledMethodProxy new for: aMethod diff --git a/smalltalksrc/VMMaker/LibFFICIF.class.st b/smalltalksrc/VMMaker/LibFFICIF.class.st index e8019e18b0..3cd49b14c8 100644 --- a/smalltalksrc/VMMaker/LibFFICIF.class.st +++ b/smalltalksrc/VMMaker/LibFFICIF.class.st @@ -89,6 +89,13 @@ LibFFICIF >> interpreter [ ^ libFFI interpreter ] +{ #category : 'accessing' } +LibFFICIF >> libFFI [ + + + ^ libFFI +] + { #category : 'accessing' } LibFFICIF >> libFFI: aLibFFI [ diff --git a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st index da727114fd..32de4e9dec 100644 --- a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st +++ b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st @@ -12,7 +12,8 @@ Class { 'externalPrimJumpOffsets', 'externalSetPrimOffsets', 'introspectionDataIndex', - 'introspectionData' + 'introspectionData', + 'ceSameThreadCalloutTrampoline' ], #pools : [ 'VMClassIndices', @@ -28,7 +29,9 @@ Class { { #category : 'translation' } SimpleStackBasedCogit class >> ancilliaryClasses [ "Answer any extra classes to be included in the translation." - ^super ancilliaryClasses, (self objectRepresentationClass withAllSuperclasses copyUpThrough: CogObjectRepresentation) reverse + ^super ancilliaryClasses, + {LibFFI}, + (self objectRepresentationClass withAllSuperclasses copyUpThrough: CogObjectRepresentation) reverse ] { #category : 'documentation' } @@ -67,7 +70,11 @@ SimpleStackBasedCogit class >> declareCVarsIn: aCCodeGenerator [ var: #externalSetPrimOffsets declareC: 'sqInt externalSetPrimOffsets[MaxNumArgs + 1]'; var: #primSetFunctionLabel type: #'AbstractInstruction *'; - var: #primInvokeInstruction type: #'AbstractInstruction *' + var: #primInvokeInstruction type: #'AbstractInstruction *'; + addHeaderFile: '#if FEATURE_FFI +#include +#endif //FEATURE_FFI'. + ] { #category : 'class initialization' } @@ -274,6 +281,20 @@ SimpleStackBasedCogit >> ceCPICMissTrampoline: anAddress [ ceCPICMissTrampoline := anAddress ] +{ #category : 'accessing' } +SimpleStackBasedCogit >> ceSameThreadCalloutTrampoline [ + + + ^ ceSameThreadCalloutTrampoline +] + +{ #category : 'accessing' } +SimpleStackBasedCogit >> ceSameThreadCalloutTrampoline: anAddress [ + + + ceSameThreadCalloutTrampoline := anAddress +] + { #category : 'simulation only' } SimpleStackBasedCogit >> ceShortCutTraceBlockActivation: aProcessorSimulationTrap [ self shortcutTrampoline: aProcessorSimulationTrap @@ -2799,6 +2820,25 @@ SimpleStackBasedCogit >> generateMissAbortTrampolines [ arg: ClassReg ] +{ #category : 'initialization' } +SimpleStackBasedCogit >> generateRunTimeTrampolines [ + + super generateRunTimeTrampolines. + self generateSameThreadCalloutTrampolines +] + +{ #category : 'initialization' } +SimpleStackBasedCogit >> generateSameThreadCalloutTrampolines [ + + ceSameThreadCalloutTrampoline := self + genTrampolineFor: + #ceSameThreadCalloutWithLiteralIndex: + called: + 'ceSameThreadCalloutTrampoline' + arg: SendNumArgsReg + result: ReceiverResultReg +] + { #category : 'initialization' } SimpleStackBasedCogit >> generateTracingTrampolines [ "Generate trampolines for tracing. In the simulator we can save a lot of time diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index c756733b05..33e2898632 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -879,6 +879,8 @@ SpurMemoryManager class >> initializeSpecialObjectIndices [ ClassExternalAddress := 43. + SelectorInvalidFFICall := 44. + SelectorAboutToReturn := 48. SelectorRunWithIn := 49. diff --git a/smalltalksrc/VMMaker/StackDepthFinder.class.st b/smalltalksrc/VMMaker/StackDepthFinder.class.st index 1cb801fb62..1ea665af63 100644 --- a/smalltalksrc/VMMaker/StackDepthFinder.class.st +++ b/smalltalksrc/VMMaker/StackDepthFinder.class.st @@ -348,6 +348,27 @@ StackDepthFinder >> resetStackAfterBranchOrReturn [ stackp := joins at: self pc] ] +{ #category : 'instruction decoding' } +StackDepthFinder >> sameThreadCallout: literalIndex [ + + | objectMemory functionDefintionOop cif | + objectMemory := instructionStream compiledCode objectMemory. + functionDefintionOop := (instructionStream compiledCode literalAt: literalIndex + 1) oop. + + functionDefintionOop = objectMemory nilObject + ifTrue: [ self error ]. + + cif := objectMemory coInterpreter getHandlerAsCif:(objectMemory + fetchPointer: 1 + ofObject: functionDefintionOop). + + self drop: cif nargs. + + "If it returns void, it does not push nothing in the stack" + cif returnType type = cif libFFI void type + ifFalse: [ self push. ] +] + { #category : 'instruction decoding' } StackDepthFinder >> send: selector super: supered numArgs: numArgs [ "Send Message With Selector, selector, bytecode. The argument, diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index 9c3805f1b2..3f145151d9 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -733,7 +733,7 @@ StackInterpreter class >> initializeBytecodeTableForSistaV1 [ (227 extPushLiteralVariableBytecode) (228 extPushLiteralBytecode) (229 longPushTemporaryVariableBytecode) - (230 unknownBytecode) + (230 sameThreadCalloutBytecode) (231 pushNewArrayBytecode) (232 extPushIntegerBytecode) (233 extPushCharacterBytecode) @@ -5067,6 +5067,67 @@ StackInterpreter >> doRecordSendTrace [ cr ] ] +{ #category : 'FFI bytecode' } +StackInterpreter >> doSameThreadCalloutBytecodeFor: externalFunction andCif: cif [ + + + + + + + + + | argumentSize parameters returnHolder | + + argumentSize := cif numberArguments. + + " 1. Prepare Arguments: + - Allocate space for all the arguments in the stack and a holder for the return, and the parameters' pointer C array + - Marshall arguments and store in the parameter array." + + parameters := self allocateParameters: argumentSize + using: [:aSize | self alloca: (self sizeof: #'void*') * aSize ]. + + 0 to: argumentSize - 1 do: [ :i | + | argType argHolder argOop | + argType := cif argTypeAt: i. + + argHolder := self alloca: argType size. + parameters at: i put: argHolder. + + argOop := objectMemory followMaybeForwarded: (self stackValue: (argumentSize - i - 1)). + + self + marshallArgument: argOop + into: argHolder + ofType: argType type + withSize: argType size + handleOopAsPointer: true. + + self failed + ifTrue: [ + self logDebug: 'Could not convert argument index: %d' _: i + 1. + ^ self ]]. + + returnHolder := self alloca: cif returnType size. + + " 2. Call and then return + - Call + - Marshall Argument and push it to the stack + - Return" + self + ffi_call: cif + _: externalFunction + _: returnHolder + _: parameters. + + self + marshallAndPushReturnValueFrom: returnHolder + ofType: cif returnType + poping: argumentSize + leaveReceiverOnVoid: false +] + { #category : 'process primitive support' } StackInterpreter >> doSignalSemaphoreWithIndex: index [ "Signal the external semaphore with the given index. Answer if a context switch @@ -5675,6 +5736,19 @@ StackInterpreter >> failUnbalancedPrimitive [ self primitiveFailFor: PrimErrBadNumArgs ] +{ #category : 'FFI bytecode' } +StackInterpreter >> fallbackInvalidFFICall [ + "We have an invalid FFI call: either the function or the cif are not valid. We cannot proceed. + Instead, send a message #invalidFFICall to the Context object" + + | ourContext | + ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer. + self push: ourContext. + messageSelector := objectMemory splObj: SelectorInvalidFFICall. + argumentCount := 0. + self normalSend +] + { #category : 'utilities' } StackInterpreter >> fetchArray: fieldIndex ofObject: objectPointer [ "Fetch the instance variable at the given index of the given object. Return the address of first indexable field of resulting array object, or fail if the instance variable does not contain an indexable bytes or words object." @@ -7014,6 +7088,29 @@ StackInterpreter >> getGCMode [ ^0 ] +{ #category : 'ffi - helpers' } +StackInterpreter >> getHandler: anOop [ + + + + + ((objectMemory isPointers: anOop) not or: [ (objectMemory slotSizeOf: anOop) < 1 ]) + ifTrue: [ self primitiveFail. ^ nil ]. + + ^ self readAddress: (objectMemory fetchPointer: 0 ofObject: anOop) + +] + +{ #category : 'ffi - helpers' } +StackInterpreter >> getHandlerAsCif: anOop [ + + + + ^ self + cCode: [ self cCoerce: (self getHandler: anOop) to: 'ffi_cif *' ] + inSmalltalk: [ libFFI cifAtAddress: (self getHandler: anOop)] +] + { #category : 'image save/restore' } StackInterpreter >> getImageHeaderFlags [ "Answer the flags that are contained in the 7th long of the image header." @@ -13357,6 +13454,43 @@ StackInterpreter >> safeMethodClassOf: methodPointer [ ^maybeClass ] +{ #category : 'FFI bytecode' } +StackInterpreter >> sameThreadCalloutBytecode [ + + | functionDefinitionLiteralIndex functionDefinition externalFunction cif | + + self + cppIf: FEATURE_FFI + ifTrue: [ + functionDefinitionLiteralIndex := self fetchByte. + self fetchNextBytecode. + + functionDefinition := self literal: functionDefinitionLiteralIndex. + functionDefinition := objectMemory followMaybeForwarded: functionDefinition. + + externalFunction := self getHandler: functionDefinition. + externalFunction ifNil: [ + self logDebug: 'Invalid External Function Argument'. + primFailCode := 0. + ^ self fallbackInvalidFFICall ]. + + cif := self getHandlerAsCif:(objectMemory + fetchPointer: 1 + ofObject: functionDefinition). + + cif ifNil: [ + self logDebug: 'Invalid CIF in ExternalFunction'. + primFailCode := 0. + ^ self fallbackInvalidFFICall ]. + + self doSameThreadCalloutBytecodeFor: externalFunction andCif: cif. + self failed + ifTrue: [ + primFailCode := 0. + ^ self fallbackInvalidFFICall ] ] + ifFalse: [ self unknownBytecode ] +] + { #category : 'primitive support' } StackInterpreter >> saneFunctionPointerForFailureOfPrimIndex: primIndex [ | basePrimitive | diff --git a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st index 2ffe3d63e4..660202be0d 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -122,8 +122,12 @@ StackInterpreterPrimitives >> doPrimitiveSameThreadCallout [ argHolder := self alloca: argType size. parameters at: i put: argHolder. - - self marshallArgumentFrom: argumentsArrayOop atIndex: i into: argHolder ofType: argType type withSize: argType size. + + self + marshallArgument: (objectMemory fetchPointer: i ofObject: argumentsArrayOop) + into: argHolder + ofType: argType type + withSize: argType size. self failed ifTrue: [ @@ -214,7 +218,11 @@ StackInterpreterPrimitives >> doPrimitiveWorkerCallout [ argHolder := self malloc: argType size. parameters at: i put: argHolder. - self marshallArgumentFrom: argumentsArrayOop atIndex: i into: argHolder ofType: argType type withSize: argType size. + self + marshallArgument: (objectMemory fetchPointer: i ofObject: argumentsArrayOop) + into: argHolder + ofType: argType type + withSize: argType size. self failed ifTrue: [ @@ -294,27 +302,6 @@ StackInterpreterPrimitives >> freeArgumentsArray: arguments count: count [ ] -{ #category : 'ffi - helpers' } -StackInterpreterPrimitives >> getHandler: anOop [ - - - - - ((objectMemory isPointers: anOop) not or: [ (objectMemory slotSizeOf: anOop) < 1 ]) - ifTrue: [ self primitiveFail. ^ nil ]. - - ^ self readAddress: (objectMemory fetchPointer: 0 ofObject: anOop) - -] - -{ #category : 'ffi - helpers' } -StackInterpreterPrimitives >> getHandlerAsCif: anOop [ - - ^ self - cCode: [ self cCoerce: (self getHandler: anOop) to: 'ffi_cif *' ] - inSmalltalk: [ libFFI cifAtAddress: (self getHandler: anOop)] -] - { #category : 'ffi - helpers' } StackInterpreterPrimitives >> getTaskFromAddress: anInteger [ @@ -377,6 +364,18 @@ StackInterpreterPrimitives >> loadModuleByName: moduleNameOop [ { #category : 'ffi - helpers' } StackInterpreterPrimitives >> marshallAndPushReturnValueFrom: returnHolder ofType: ffiType poping: argumentsAndReceiverCount [ + + + ^ self + marshallAndPushReturnValueFrom: returnHolder + ofType: ffiType + poping: argumentsAndReceiverCount + leaveReceiverOnVoid: true +] + +{ #category : 'ffi - helpers' } +StackInterpreterPrimitives >> marshallAndPushReturnValueFrom: returnHolder ofType: ffiType poping: argumentsAndReceiverCount leaveReceiverOnVoid: leaveReceiverOnVoid [ + @@ -406,80 +405,109 @@ StackInterpreterPrimitives >> marshallAndPushReturnValueFrom: returnHolder ofTyp [ FFI_TYPE_FLOAT ] -> [ self pop: argumentsAndReceiverCount thenPushFloat: (objectMemory readFloat32AtPointer: returnHolder) ]. [ FFI_TYPE_DOUBLE ] -> [ self pop: argumentsAndReceiverCount thenPushFloat: (objectMemory readFloat64AtPointer: returnHolder) ]. - [ FFI_TYPE_VOID ] -> [ self pop: argumentsAndReceiverCount - 1 "Pop the arguments leaving the receiver" ]} + [ FFI_TYPE_VOID ] -> [ + self pop: argumentsAndReceiverCount - (leaveReceiverOnVoid ifTrue: [1] ifFalse: [0]) + "Pop the arguments leaving the receiver" ]} otherwise: [ self primitiveFailFor: PrimErrBadArgument ] ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallArgumentFrom: argumentsArrayOop atIndex: i into: argHolder ofType: argType withSize: argTypeSize [ +StackInterpreterPrimitives >> marshallArgument: oop into: argHolder ofType: argType withSize: argTypeSize [ + + ^ self + marshallArgument: oop + into: argHolder + ofType: argType + withSize: argTypeSize + handleOopAsPointer: false +] + +{ #category : 'ffi - helpers' } +StackInterpreterPrimitives >> marshallArgument: oop into: argHolder ofType: argType withSize: argTypeSize handleOopAsPointer: handleOopAsPointer [ + + + [ argType ] caseOf: {([ FFI_TYPE_POINTER ] - -> [ self marshallPointerFrom: argumentsArrayOop at: i into: argHolder ]). + -> [ + handleOopAsPointer + ifFalse: [self marshallPointer: oop into: argHolder] + ifTrue: [ self marshallPointerOrOop: oop into: argHolder ]]). ([ FFI_TYPE_STRUCT ] - -> [ self marshallStructFrom: argumentsArrayOop at: i into: argHolder withSize: argTypeSize ]). + -> [ self marshallStruct: oop into: argHolder withSize: argTypeSize ]). ([ FFI_TYPE_FLOAT ] - -> [ self marshallFloatFrom: argumentsArrayOop at: i into: argHolder ]). + -> [ self marshallFloatOop: oop into: argHolder ]). ([ FFI_TYPE_DOUBLE ] - -> [ self marshallDoubleFrom: argumentsArrayOop at: i into: argHolder ]). + -> [ self marshallDoubleOop: oop into: argHolder ]). ([ FFI_TYPE_SINT8 ] - -> [ self marshallSInt8From: argumentsArrayOop at: i into: argHolder ]). + -> [ self marshallSInt8: oop into: argHolder ]). ([ FFI_TYPE_UINT8 ] - -> [ self marshallUInt8From: argumentsArrayOop at: i into: argHolder ]). + -> [ self marshallUInt8: oop into: argHolder ]). ([ FFI_TYPE_SINT16 ] - -> [ self marshallSInt16From: argumentsArrayOop at: i into: argHolder ]). + -> [ self marshallSInt16: oop into: argHolder ]). ([ FFI_TYPE_UINT16 ] - -> [ self marshallUInt16From: argumentsArrayOop at: i into: argHolder ]). + -> [ self marshallUInt16: oop into: argHolder ]). ([ FFI_TYPE_SINT32 ] - -> [ self marshallSInt32From: argumentsArrayOop at: i into: argHolder ]). + -> [ self marshallSInt32: oop into: argHolder ]). ([ FFI_TYPE_UINT32 ] - -> [ self marshallUInt32From: argumentsArrayOop at: i into: argHolder ]). + -> [ self marshallUInt32: oop into: argHolder ]). ([ FFI_TYPE_SINT64 ] - -> [ self marshallSInt64From: argumentsArrayOop at: i into: argHolder ]). + -> [ self marshallSInt64: oop into: argHolder ]). ([ FFI_TYPE_UINT64 ] - -> [ self marshallUInt64From: argumentsArrayOop at: i into: argHolder ])} + -> [ self marshallUInt64: oop into: argHolder ])} otherwise: [ self primitiveFailFor: PrimErrBadArgument ] ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallDoubleFrom: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallDoubleOop: oop into: holder [ | doubleHolder | doubleHolder := self cCoerce: holder to: #'double *'. - doubleHolder at: 0 put: (self fetchFloat: index ofObject: argumentArrayOop ). + doubleHolder at: 0 put: (objectMemory floatValueOf: oop). ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallFloatFrom: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallFloatOop: oop into: holder [ | floatHolder | - floatHolder := self cCoerce: holder to: #'float *'. - - floatHolder at: 0 put: (self fetchFloat: index ofObject: argumentArrayOop ). + floatHolder := self cCoerce: holder to: #'float *'. + floatHolder at: 0 put: (objectMemory floatValueOf: oop) ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallPointerFrom: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallPointer: externalAddress into: holder [ - | pointerHolder externalAddress | + | pointerHolder | pointerHolder := self cCoerce: holder to: #'void **'. - externalAddress := objectMemory fetchPointer: index ofObject: argumentArrayOop. pointerHolder at: 0 put: (self readAddress: externalAddress). ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallSInt16From: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallPointerOrOop: externalAddressOrOop into: holder [ + + | pointerHolder | + + pointerHolder := self cCoerce: holder to: #'void **'. + + ((objectMemory classIndexOf: externalAddressOrOop) = objectMemory classExternalAddressIndex) + ifTrue: [ pointerHolder at: 0 put: (objectMemory fetchPointer: 0 ofObject: externalAddressOrOop) ] + ifFalse: [ pointerHolder at: 0 put: (self cCoerce: (externalAddressOrOop + BaseHeaderSize) to: #sqInt) ] +] + +{ #category : 'ffi - helpers' } +StackInterpreterPrimitives >> marshallSInt16: oop into: holder [ | intHolder value | - value := self fetchInteger: index ofObject: argumentArrayOop. + value := self checkedIntegerValueOf: oop. value > INT16_MAX ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ]. value < INT16_MIN ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ]. @@ -489,11 +517,11 @@ StackInterpreterPrimitives >> marshallSInt16From: argumentArrayOop at: index int ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallSInt32From: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallSInt32: oop into: holder [ | intHolder value | - value := self signed32BitValueOf: (objectMemory fetchPointer: index ofObject: argumentArrayOop). + value := self signed32BitValueOf: oop. self failed ifTrue: [ ^self primitiveFailFor: PrimErrBadArgument ]. @@ -503,11 +531,11 @@ StackInterpreterPrimitives >> marshallSInt32From: argumentArrayOop at: index int ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallSInt64From: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallSInt64: oop into: holder [ | intHolder value | - value := self signed64BitValueOf: (objectMemory fetchPointer: index ofObject: argumentArrayOop). + value := self signed64BitValueOf: oop. self failed ifTrue: [ ^ self ]. @@ -517,26 +545,25 @@ StackInterpreterPrimitives >> marshallSInt64From: argumentArrayOop at: index int ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallSInt8From: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallSInt8: intOop into: holder [ | intHolder value | - value := self fetchInteger: index ofObject: argumentArrayOop. + value := self checkedIntegerValueOf: intOop. + value > INT8_MAX ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ]. value < INT8_MIN ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ]. intHolder := self cCoerce: holder to: #'int8_t *'. - intHolder at: 0 put: (self fetchInteger: index ofObject: argumentArrayOop ). + intHolder at: 0 put: value. ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallStructFrom: argumentsArrayOop at: index into: holder withSize: typeSize [ - +StackInterpreterPrimitives >> marshallStruct: oop into: holder withSize: typeSize [ - | address srcPtr oop | - oop := objectMemory fetchPointer: index ofObject: argumentsArrayOop. + | address srcPtr | (objectMemory fetchClassOf: oop) = objectMemory classExternalAddress ifTrue: [ @@ -558,11 +585,11 @@ StackInterpreterPrimitives >> marshallStructFrom: argumentsArrayOop at: index in ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallUInt16From: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallUInt16: oop into: holder [ | intHolder value | - value := self fetchInteger: index ofObject: argumentArrayOop. + value := self checkedIntegerValueOf: oop. value < 0 ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ]. value > UINT16_MAX ifTrue: [ ^ self primitiveFailFor: PrimErrBadArgument ]. @@ -572,11 +599,11 @@ StackInterpreterPrimitives >> marshallUInt16From: argumentArrayOop at: index int ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallUInt32From: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallUInt32: oop into: holder [ | intHolder value | - value := self positive32BitValueOf: (objectMemory fetchPointer: index ofObject: argumentArrayOop). + value := self positive32BitValueOf: oop. self failed ifTrue: [ ^self primitiveFailFor: PrimErrBadArgument ]. @@ -586,11 +613,11 @@ StackInterpreterPrimitives >> marshallUInt32From: argumentArrayOop at: index int ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallUInt64From: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallUInt64: oop into: holder [ | intHolder value | - value := self positive64BitValueOf:( objectMemory fetchPointer: index ofObject: argumentArrayOop ). + value := self positive64BitValueOf: oop. self failed ifTrue: [ ^ self ]. @@ -601,11 +628,10 @@ StackInterpreterPrimitives >> marshallUInt64From: argumentArrayOop at: index int ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> marshallUInt8From: argumentArrayOop at: index into: holder [ +StackInterpreterPrimitives >> marshallUInt8: oop into: holder [ - | intHolder value oop | + | intHolder value | - oop := objectMemory fetchPointer: index ofObject: argumentArrayOop. value := (objectMemory isCharacterObject: oop) ifTrue: [ objectMemory characterValueOf: oop ] ifFalse: [ objectMemory integerValueOf: oop ]. @@ -4021,11 +4047,14 @@ StackInterpreterPrimitives >> pushSameThreadCalloutSuspendedProcess: aSuspendedP ] { #category : 'ffi - helpers' } -StackInterpreterPrimitives >> readAddress: anOop [ +StackInterpreterPrimitives >> readAddress: maybeForwarder [ + | anOop | + anOop := objectMemory followMaybeForwarded: maybeForwarder. + (objectMemory is: anOop KindOfClass: objectMemory classExternalAddress) ifFalse: [ self primitiveFail. ^ nil ]. diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index d1b816d0d2..76725b2738 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -141,6 +141,7 @@ Class { ], #pools : [ 'CogCompilationConstants', + 'LibFFIConstants', 'VMMethodCacheConstants', 'VMObjectIndices', 'VMStackFrameOffsets' @@ -347,7 +348,7 @@ StackToRegisterMappingCogit class >> initializeBytecodeTableForSistaV1 [ (2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1) (2 228 228 genExtPushLiteralBytecode needsFrameNever: 1) (2 229 229 genLongPushTemporaryVariableBytecode) - (2 230 230 unknownBytecode) + (2 230 230 genSameThreadCalloutBytecode) (2 231 231 genPushNewArrayBytecode) (2 232 232 genExtPushIntegerBytecode needsFrameNever: 1) (2 233 233 genExtPushCharacterBytecode needsFrameNever: 1) @@ -2439,6 +2440,32 @@ StackToRegisterMappingCogit >> genReturnTopFromMethod [ ^self genUpArrowReturn ] +{ #category : 'bytecode generators' } +StackToRegisterMappingCogit >> genSameThreadCalloutBytecode [ + + | literalIndex functionDefinition cif | + + self ssAllocateCallReg: SendNumArgsReg. + self ssFlushStack. + + literalIndex := byte1. + + "The index of the literal with the function definition is passed as parameter of the trampoline" + self MoveCq: literalIndex R: SendNumArgsReg. + self CallRT: ceSameThreadCalloutTrampoline. + + functionDefinition := self getLiteral: literalIndex. + cif := coInterpreter getHandlerAsCif: (objectMemory fetchPointer: 1 ofObject: functionDefinition). + + cif ifNil: [ ^ ShouldNotJIT ]. + + self ssPop: cif numberArguments. + + cif returnType type = FFI_TYPE_VOID + ifTrue: [ ^ 0 ] + ifFalse: [ ^ self ssPushRegister: ReceiverResultReg ] +] + { #category : 'bytecode generator support' } StackToRegisterMappingCogit >> genSend: selectorIndex numArgs: numArgs [ self marshallSendArguments: numArgs. diff --git a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st index 50b83cf1f2..5c779a30cf 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st @@ -170,6 +170,12 @@ UnicornARMv8Simulator >> instructionPointerRegister [ ^ UcARM64Registers pc ] +{ #category : 'as yet unclassified' } +UnicornARMv8Simulator >> instructionPointerValue [ + + ^ self instructionPointerRegister value +] + { #category : 'accessing-registers-abstract' } UnicornARMv8Simulator >> linkRegister [ diff --git a/smalltalksrc/VMMakerTests/VMAbstractFFITest.class.st b/smalltalksrc/VMMakerTests/VMAbstractFFITest.class.st index afe2f98aa3..aab30f8506 100644 --- a/smalltalksrc/VMMakerTests/VMAbstractFFITest.class.st +++ b/smalltalksrc/VMMakerTests/VMAbstractFFITest.class.st @@ -8,30 +8,6 @@ Class { #package : 'VMMakerTests' } -{ #category : 'helpers' } -VMAbstractFFITest >> createExternalFunctionFor: aBlock withArgumentTypes: argumentTypes withReturnType: returnType [ - - | functionAddress tfExternalFunction functionExternalAddress tfFunctionDefinition cif cifExternalAddress | - - functionAddress := interpreter libFFI registerFunction: aBlock. - - tfExternalFunction := self newObjectWithSlots: 2. - functionExternalAddress := self newExternalAddress: functionAddress. - tfFunctionDefinition := self newObjectWithSlots: 1. - - cif := interpreter libFFI newCif. - cif argumentTypes: argumentTypes. - cif returnType: returnType. - - cifExternalAddress := self newExternalAddress: (cif address). - - memory storePointer: 0 ofObject: tfExternalFunction withValue: functionExternalAddress. - memory storePointer: 1 ofObject: tfExternalFunction withValue: tfFunctionDefinition. - memory storePointer: 0 ofObject: tfFunctionDefinition withValue: cifExternalAddress. - - ^ tfExternalFunction -] - { #category : 'helpers' } VMAbstractFFITest >> createReturnFloatExternalFunctionFor: aBlock [ @@ -63,19 +39,6 @@ VMAbstractFFITest >> interpreterClass [ ^ VMTestMockInterpreter ] -{ #category : 'helpers' } -VMAbstractFFITest >> newExternalAddress: anInteger [ - - | anExternalAddress | - anExternalAddress := self - newObjectWithSlots: (memory numSlotsForBytes: self wordSize) - format: (memory byteFormatForNumBytes: self wordSize) - classIndex: memory classExternalAddressIndex. - - memory storePointer: 0 ofObject: anExternalAddress withValue: anInteger. - ^ anExternalAddress -] - { #category : 'helpers' } VMAbstractFFITest >> readyProcesses [ diff --git a/smalltalksrc/VMMakerTests/VMAbstractPrimitiveTest.class.st b/smalltalksrc/VMMakerTests/VMAbstractPrimitiveTest.class.st index 9657b0b0bd..cd4e703266 100644 --- a/smalltalksrc/VMMakerTests/VMAbstractPrimitiveTest.class.st +++ b/smalltalksrc/VMMakerTests/VMAbstractPrimitiveTest.class.st @@ -11,6 +11,12 @@ Class { #package : 'VMMakerTests' } +{ #category : 'running' } +VMAbstractPrimitiveTest >> createMethod [ + + ^ self newMethodWithBytecodes: #[ 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 ]. +] + { #category : 'running' } VMAbstractPrimitiveTest >> createProcessFor: newMethod priority: aPriority [ @@ -46,6 +52,13 @@ VMAbstractPrimitiveTest >> createSuspendedProcessFor: newMethod priority: aPrior ^ aProcess ] +{ #category : 'running' } +VMAbstractPrimitiveTest >> initialIP [ + + "The IP of the method is the header of the method + 1" + ^ self wordSize + 1 +] + { #category : 'as yet unclassified' } VMAbstractPrimitiveTest >> newArrayWith: aCollection [ | array | @@ -137,10 +150,10 @@ VMAbstractPrimitiveTest >> setUp [ "Create the root context with a valid method" "Let's create a method with enough size. It should have at least a literal (4 or 8 bytes depending the word size) and some bytecodes, so we can put the IP inside the method" - newMethod := self newMethodWithBytecodes: #[ 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 ]. + newMethod := self createMethod. "The context has 5 (in 32 bits) or 9 (in 64 bits) as initial IP, as method has at least one literal" - ctx := self newSmallContextReceiver: memory nilObject method: newMethod arguments: #() temporaries: #() ip: self wordSize + 1. + ctx := self newSmallContextReceiver: memory nilObject method: newMethod arguments: #() temporaries: #() ip: self initialIP. page := interpreter makeBaseFrameFor: ctx. interpreter setStackPageAndLimit: page. @@ -149,7 +162,7 @@ VMAbstractPrimitiveTest >> setUp [ self createActiveProcess. "The current instruction pointer is an absolute address pointing to the current bytecode inside the method" - interpreter instructionPointer: newMethod + memory baseHeaderSize + memory wordSize + 1. + interpreter instructionPointer: newMethod + memory baseHeaderSize + self initialIP. interpreter method: newMethod. memory flushNewSpace. @@ -157,7 +170,8 @@ VMAbstractPrimitiveTest >> setUp [ self createProcessFor: newMethod priority: 1. self createProcessFor: newMethod priority: 1. - memory classExternalAddress: (self newClassInOldSpaceWithSlots: 0 instSpec: (memory byteFormatForNumBytes: 0) ). + self createExternalAddressClass. + memory classArray: (self newClassInOldSpaceWithSlots: 0 instSpec: memory arrayFormat ). memory classByteArray: (self newClassInOldSpaceWithSlots: 0 instSpec: (memory byteFormatForNumBytes: 0) ). diff --git a/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeArgumentMarshallingTest.class.st b/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeArgumentMarshallingTest.class.st new file mode 100644 index 0000000000..fe2ee16cc0 --- /dev/null +++ b/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeArgumentMarshallingTest.class.st @@ -0,0 +1,112 @@ +Class { + #name : 'VMFFISameThreadBytecodeArgumentMarshallingTest', + #superclass : 'VMFFIArgumentMarshallingTest', + #instVars : [ + 'contextClass', + 'ffiFallbackSelector', + 'ffiFallbackMethod' + ], + #category : 'VMMakerTests', + #package : 'VMMakerTests' +} + +{ #category : 'running' } +VMFFISameThreadBytecodeArgumentMarshallingTest >> createMethod [ + + ^ methodBuilder + newMethod; + literalAt: 0 put: memory nilObject; + bytecodes: #[0 230 0 92]; + buildMethod +] + +{ #category : 'implementation' } +VMFFISameThreadBytecodeArgumentMarshallingTest >> doTestFuntionWithArgumentType: argumentType smalltalkValue: smalltalkValue expectedValue: expectedValue [ + + | tfExternalFunction savedValue previousStackTop | + + tfExternalFunction := self + createExternalFunctionFor: [ :anArgument | savedValue := anArgument ] + withArgumentTypes: { argumentType } + withReturnType: interpreter libFFI void. + + memory storePointer: 1 ofObject: interpreter method withValue: tfExternalFunction. + + previousStackTop := interpreter stackTop. + + interpreter push: smalltalkValue. + interpreter sameThreadCalloutBytecode. + + self deny: interpreter failed. + self assert: interpreter stackTop equals: previousStackTop. + self assert: savedValue equals: expectedValue. +] + +{ #category : 'implementation' } +VMFFISameThreadBytecodeArgumentMarshallingTest >> doTestFuntionWithArgumentType: argumentType smalltalkValue: smalltalkValue failsWith: expectedErrorCode [ + + | tfExternalFunction savedValue | + + self installContextClass. + self installFFIFallbackMethod. + interpreter methodDictLinearSearchLimit: 3. + interpreter setBreakSelector: nil. + interpreter currentBytecode: 200. + + tfExternalFunction := self + createExternalFunctionFor: [ :anArgument | savedValue := anArgument ] + withArgumentTypes: { argumentType } + withReturnType: interpreter libFFI void. + + memory storePointer: 1 ofObject: interpreter method withValue: tfExternalFunction. + + interpreter push: smalltalkValue. + interpreter sameThreadCalloutBytecode. + + self assert: interpreter method equals: ffiFallbackMethod. +] + +{ #category : 'running' } +VMFFISameThreadBytecodeArgumentMarshallingTest >> initialIP [ + + ^ (self wordSize * 2) + 1 +] + +{ #category : 'as yet unclassified' } +VMFFISameThreadBytecodeArgumentMarshallingTest >> installContextClass [ + + contextClass := self + newClassInOldSpaceWithSlots: 0 + instSpec: memory sixtyFourBitIndexableFormat. + + memory setHashBitsOf: contextClass to: ClassMethodContextCompactIndex. + + memory + storePointer: ClassMethodContextCompactIndex + ofObject: memory classTableFirstPage + withValue: contextClass. + +] + +{ #category : 'as yet unclassified' } +VMFFISameThreadBytecodeArgumentMarshallingTest >> installFFIFallbackMethod [ + + | aMethodDictionary | + + ffiFallbackSelector := self newZeroSizedObject. + ffiFallbackMethod := self newMethodWithBytecodes: #[1 2 3 4 5 6 7 8]. + + memory splObj: SelectorInvalidFFICall put: ffiFallbackSelector. + + self setUpMethodDictionaryIn: contextClass. + + aMethodDictionary := memory + fetchPointer: MethodDictionaryIndex + ofObject: contextClass. + + self + installSelector: ffiFallbackSelector + method: ffiFallbackMethod + inMethodDictionary: aMethodDictionary. + +] diff --git a/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeReturnMarshallingTest.class.st b/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeReturnMarshallingTest.class.st new file mode 100644 index 0000000000..5cdcde198d --- /dev/null +++ b/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeReturnMarshallingTest.class.st @@ -0,0 +1,42 @@ +Class { + #name : 'VMFFISameThreadBytecodeReturnMarshallingTest', + #superclass : 'VMFFIReturnMarshallingTest', + #category : 'VMMakerTests', + #package : 'VMMakerTests' +} + +{ #category : 'running' } +VMFFISameThreadBytecodeReturnMarshallingTest >> createMethod [ + + ^ methodBuilder + newMethod; + literalAt: 0 put: memory nilObject; + bytecodes: #[0 230 0 92]; + buildMethod +] + +{ #category : 'tests - marshalling return' } +VMFFISameThreadBytecodeReturnMarshallingTest >> doTestCalloutWithReturnType: aLibFFIType returnValue: valueToReturn asserting: aBlock [ + + | tfExternalFunction previousStackTop | + + tfExternalFunction := self + createExternalFunctionFor: [ valueToReturn ] + withArgumentTypes: #() + withReturnType: aLibFFIType. + + memory storePointer: 1 ofObject: interpreter method withValue: tfExternalFunction. + + previousStackTop := interpreter stackTop. + + interpreter sameThreadCalloutBytecode. + + self assert: (interpreter stackValue: 1) equals: previousStackTop. + aBlock value +] + +{ #category : 'running' } +VMFFISameThreadBytecodeReturnMarshallingTest >> initialIP [ + + ^ (self wordSize * 2) + 1 +] diff --git a/smalltalksrc/VMMakerTests/VMInterpreterTests.class.st b/smalltalksrc/VMMakerTests/VMInterpreterTests.class.st index 9ead2ebb76..d426acd799 100644 --- a/smalltalksrc/VMMakerTests/VMInterpreterTests.class.st +++ b/smalltalksrc/VMMakerTests/VMInterpreterTests.class.st @@ -10,21 +10,6 @@ Class { #tag : 'InterpreterTests' } -{ #category : 'tests' } -VMInterpreterTests >> installSelector: aSelectorOop method: aMethodOop inMethodDictionary: aMethodDictionary [ - - | anArrayOfMethods | - anArrayOfMethods := memory fetchPointer: MethodArrayIndex ofObject: aMethodDictionary. - memory - storePointer: (memory methodDictionaryHash: aSelectorOop mask: 11) + 2 - ofObject: aMethodDictionary - withValue: aSelectorOop. - memory - storePointer: (memory methodDictionaryHash: aSelectorOop mask: 11) - ofObject: anArrayOfMethods - withValue: aMethodOop -] - { #category : 'running' } VMInterpreterTests >> setUp [ @@ -41,31 +26,4 @@ VMInterpreterTests >> setUp [ self initializeOldSpaceForScavenger. -] - -{ #category : 'tests' } -VMInterpreterTests >> setUpMethodDictionaryIn: aClass [ - "2 instances variables the array of methods and the tally - and 12 entries to put elemetns of the collection" - - | aMethodDictionary anArrayOfMethods | - aMethodDictionary := self - newObjectWithSlots: 2 + 12 - format: MethodDictionary instSpec - classIndex: memory arrayClassIndexPun. - anArrayOfMethods := self - newObjectWithSlots: 12 - format: Array instSpec - classIndex: memory arrayClassIndexPun. - memory - storePointer: MethodDictionaryIndex - ofObject: aClass - withValue: aMethodDictionary. - memory - storePointer: MethodArrayIndex - ofObject: aMethodDictionary - withValue: anArrayOfMethods. - - - ] diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st new file mode 100644 index 0000000000..4e79dff724 --- /dev/null +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -0,0 +1,222 @@ +Class { + #name : 'VMJitFFISameThreadCalloutTest', + #superclass : 'VMStackToRegisterMappingCogitTest', + #instVars : [ + 'jitCompilerClass' + ], + #category : 'VMMakerTests-JitTests', + #package : 'VMMakerTests', + #tag : 'JitTests' +} + +{ #category : 'running' } +VMJitFFISameThreadCalloutTest >> jitCompilerClass [ + + ^ jitCompilerClass ifNil: [ jitCompilerClass := super jitCompilerClass ] +] + +{ #category : 'running' } +VMJitFFISameThreadCalloutTest >> jitCompilerClass: aValue [ + + jitCompilerClass := aValue +] + +{ #category : 'running' } +VMJitFFISameThreadCalloutTest >> setUp [ + + super setUp. + + self setUpTrampolines. + self setUpCogMethodEntry. + self createBaseFrame. + + interpreter libFFI: LibFFI new. + interpreter libFFI interpreter: interpreter. + + self createExternalAddressClass. + + +] + +{ #category : 'running' } +VMJitFFISameThreadCalloutTest >> setUpTrampolines [ + + super setUpTrampolines. + + cogit methodAbortTrampolines at: 0 put: cogit ceMethodAbortTrampoline. + cogit methodAbortTrampolines at: 1 put: cogit ceMethodAbortTrampoline. + cogit methodAbortTrampolines at: 2 put: cogit ceMethodAbortTrampoline. + cogit methodAbortTrampolines at: 3 put: cogit ceMethodAbortTrampoline. + + cogit picMissTrampolines at: 0 put: cogit ceCPICMissTrampoline. + cogit picMissTrampolines at: 1 put: cogit ceCPICMissTrampoline. + cogit picMissTrampolines at: 2 put: cogit ceCPICMissTrampoline. + cogit picMissTrampolines at: 3 put: cogit ceCPICMissTrampoline. + + cogit picAbortTrampolines at: 0 put: cogit cePICAbortTrampoline. + cogit picAbortTrampolines at: 1 put: cogit cePICAbortTrampoline. + cogit picAbortTrampolines at: 2 put: cogit cePICAbortTrampoline. + cogit picAbortTrampolines at: 3 put: cogit cePICAbortTrampoline. + + cogit ceStoreCheckTrampoline: (self compileTrampoline: [ cogit RetN: 0 ] named:#ceStoreCheckTrampoline). + cogit objectRepresentation setAllStoreTrampolinesWith: (self compileTrampoline: [ cogit RetN: 0 ] named: #ceStoreTrampoline). + + cogit generateSameThreadCalloutTrampolines +] + +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testExecutingFunctionCallsExternalFunction [ + + | compiledMethod cogMethod externalFunction tfExternalFunction called | + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ called := true ] + withArgumentTypes: {} + withReturnType: interpreter libFFI void. + + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: memory nilObject; + bytecodes: #[ + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + externalFunction := self compile: [ cogit Stop ]. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: {} + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called +] + +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testExecutingFunctionPopsCorrectlyAndReturnsTheResult [ + + | compiledMethod cogMethod externalFunction tfExternalFunction called | + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ :a :b | a + b ] + withArgumentTypes: {interpreter libFFI sint64. interpreter libFFI sint64} + withReturnType: interpreter libFFI sint64. + + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: (memory integerObjectOf: 13); + literalAt: 2 put: (memory integerObjectOf: 4); + literalAt: 3 put: memory nilObject; "Class binding" + bytecodes: #[ + 33 "Push literal 1" + 34 "Push literal 2" + 230 0 "SameThreadCallout Literal0" + 92 "ReturnTop"]; + buildMethod. + + externalFunction := self compile: [ cogit Stop ]. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: {} + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 17). + +] + +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testExecutingFunctionReturnsCorrectValue [ + + | compiledMethod cogMethod externalFunction tfExternalFunction called | + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ 17 ] + withArgumentTypes: {} + withReturnType: interpreter libFFI sint64. + + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: memory nilObject; + bytecodes: #[ + 230 0 "SameThreadCallout Literal0" + 92 "ReturnTop"]; + buildMethod. + + externalFunction := self compile: [ cogit Stop ]. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: {} + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 17). + +] + +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testJITCompilesCallToTrampolineByDefault [ + + | compiledMethod cogMethod tfExternalFunction | + tfExternalFunction := self + createExternalFunctionFor: [ ] + withArgumentTypes: { } + withReturnType: interpreter libFFI void. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: memory nilObject; "Class Binding" + bytecodes: #[ + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: memory nilObject + arguments: { } + returnAddress: cogit ceSameThreadCalloutTrampoline. + + self + assert: machineSimulator pc + equals: cogit ceSameThreadCalloutTrampoline. + self + assert: machineSimulator sendNumberOfArgumentsRegisterValue + equals: 0 +] diff --git a/smalltalksrc/VMMakerTests/VMPrimitiveCallAbstractTest.class.st b/smalltalksrc/VMMakerTests/VMPrimitiveCallAbstractTest.class.st index 87474aad24..1f1a0cb49a 100644 --- a/smalltalksrc/VMMakerTests/VMPrimitiveCallAbstractTest.class.st +++ b/smalltalksrc/VMMakerTests/VMPrimitiveCallAbstractTest.class.st @@ -11,29 +11,6 @@ Class { #tag : 'JitTests' } -{ #category : 'helpers' } -VMPrimitiveCallAbstractTest >> callCogMethod: callingMethod receiver: receiver arguments: arguments returnAddress: returnAddress [ - - machineSimulator receiverRegisterValue: receiver. - self pushAddress: receiver. - - arguments do: [ :e | self pushAddress: e ]. - - arguments size = 1 - ifTrue: [ machineSimulator arg0RegisterValue: (arguments at: 1) ]. - - arguments size = 2 - ifTrue: [ - machineSimulator arg0RegisterValue: (arguments at: 1). - machineSimulator arg1RegisterValue: (arguments at: 2). ]. - - self prepareCall. - machineSimulator instructionPointerRegisterValue: callingMethod address + cogit noCheckEntryOffset. - - self runFrom: callingMethod address + cogit noCheckEntryOffset until: returnAddress. - -] - { #category : 'helpers' } VMPrimitiveCallAbstractTest >> findMethod: aSelector [ diff --git a/smalltalksrc/VMMakerTests/VMPushThisContextRoutineTest.class.st b/smalltalksrc/VMMakerTests/VMPushThisContextRoutineTest.class.st index 895ba3b5f2..972ccbbafe 100644 --- a/smalltalksrc/VMMakerTests/VMPushThisContextRoutineTest.class.st +++ b/smalltalksrc/VMMakerTests/VMPushThisContextRoutineTest.class.st @@ -33,6 +33,7 @@ VMPushThisContextRoutineTest >> setUp [ VMPushThisContextRoutineTest >> testMarriedContextReturnsSpouseObject [ | isLargeContext isInBlock routine numberOfArguments methodObject contextOop | + isLargeContext := false. isInBlock := 0. "non-block, i.e., a normal method" cogit objectRepresentation ceScheduleScavengeTrampoline: diff --git a/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st b/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st index 62f82ef61d..8f7dc8ceed 100644 --- a/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st @@ -103,6 +103,29 @@ VMSimpleStackBasedCogitAbstractTest >> assertStackRemainsUnchangedDuring: aBlock equals: before ] +{ #category : 'helpers' } +VMSimpleStackBasedCogitAbstractTest >> callCogMethod: callingMethod receiver: receiver arguments: arguments returnAddress: returnAddress [ + + machineSimulator receiverRegisterValue: receiver. + self pushAddress: receiver. + + arguments do: [ :e | self pushAddress: e ]. + + arguments size = 1 + ifTrue: [ machineSimulator arg0RegisterValue: (arguments at: 1) ]. + + arguments size = 2 + ifTrue: [ + machineSimulator arg0RegisterValue: (arguments at: 1). + machineSimulator arg1RegisterValue: (arguments at: 2). ]. + + self prepareCall. + machineSimulator instructionPointerRegisterValue: callingMethod address + cogit noCheckEntryOffset. + + self runFrom: callingMethod address + cogit noCheckEntryOffset until: returnAddress. + +] + { #category : 'accessing' } VMSimpleStackBasedCogitAbstractTest >> callerAddress [ ^ callerAddress diff --git a/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st b/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st index eff8c524da..3b5bbe5fb6 100644 --- a/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st @@ -113,6 +113,38 @@ VMSpurMemoryManagerTest >> createEphemeronClass [ memory ensureBehaviorHash: ourEphemeronClass. ] +{ #category : 'utils' } +VMSpurMemoryManagerTest >> createExternalAddressClass [ + + memory classExternalAddress: (self + newClassInOldSpaceWithSlots: 0 + instSpec: (memory byteFormatForNumBytes: 0)) +] + +{ #category : 'helpers' } +VMSpurMemoryManagerTest >> createExternalFunctionFor: aBlock withArgumentTypes: argumentTypes withReturnType: returnType [ + + | functionAddress tfExternalFunction functionExternalAddress tfFunctionDefinition cif cifExternalAddress | + + functionAddress := interpreter libFFI registerFunction: aBlock. + + tfExternalFunction := self newObjectWithSlots: 2. + functionExternalAddress := self newExternalAddress: functionAddress. + tfFunctionDefinition := self newObjectWithSlots: 1. + + cif := interpreter libFFI newCif. + cif argumentTypes: argumentTypes. + cif returnType: returnType. + + cifExternalAddress := self newExternalAddress: (cif address). + + memory storePointer: 0 ofObject: tfExternalFunction withValue: functionExternalAddress. + memory storePointer: 1 ofObject: tfExternalFunction withValue: tfFunctionDefinition. + memory storePointer: 0 ofObject: tfFunctionDefinition withValue: cifExternalAddress. + + ^ tfExternalFunction +] + { #category : 'utils' } VMSpurMemoryManagerTest >> createLargeIntegerClasses [ @@ -314,6 +346,21 @@ VMSpurMemoryManagerTest >> installFloatClass [ "This simulated classFloat class is necessary because the 32bits VM cannot instanciate boxed floats by itself" ] +{ #category : 'tests' } +VMSpurMemoryManagerTest >> installSelector: aSelectorOop method: aMethodOop inMethodDictionary: aMethodDictionary [ + + | anArrayOfMethods | + anArrayOfMethods := memory fetchPointer: MethodArrayIndex ofObject: aMethodDictionary. + memory + storePointer: (memory methodDictionaryHash: aSelectorOop mask: 11) + 2 + ofObject: aMethodDictionary + withValue: aSelectorOop. + memory + storePointer: (memory methodDictionaryHash: aSelectorOop mask: 11) + ofObject: anArrayOfMethods + withValue: aMethodOop +] + { #category : 'accessor' } VMSpurMemoryManagerTest >> interpreter [ ^ interpreter @@ -486,6 +533,19 @@ VMSpurMemoryManagerTest >> newEphemeronObject [ classIndex: (memory ensureBehaviorHash: ourEphemeronClass) ] +{ #category : 'helpers' } +VMSpurMemoryManagerTest >> newExternalAddress: anInteger [ + + | anExternalAddress | + anExternalAddress := self + newObjectWithSlots: (memory numSlotsForBytes: self wordSize) + format: (memory byteFormatForNumBytes: self wordSize) + classIndex: memory classExternalAddressIndex. + + memory storePointer: 0 ofObject: anExternalAddress withValue: anInteger. + ^ anExternalAddress +] + { #category : 'helpers - methods' } VMSpurMemoryManagerTest >> newMethodWithSmallContext: isSmall WithArguments: arguments [ @@ -815,6 +875,33 @@ VMSpurMemoryManagerTest >> setUp [ memory lastHash: 1. ] +{ #category : 'tests' } +VMSpurMemoryManagerTest >> setUpMethodDictionaryIn: aClass [ + "2 instances variables the array of methods and the tally + and 12 entries to put elemetns of the collection" + + | aMethodDictionary anArrayOfMethods | + aMethodDictionary := self + newObjectWithSlots: 2 + 12 + format: MethodDictionary instSpec + classIndex: memory arrayClassIndexPun. + anArrayOfMethods := self + newObjectWithSlots: 12 + format: Array instSpec + classIndex: memory arrayClassIndexPun. + memory + storePointer: MethodDictionaryIndex + ofObject: aClass + withValue: aMethodDictionary. + memory + storePointer: MethodArrayIndex + ofObject: aMethodDictionary + withValue: anArrayOfMethods. + + + +] + { #category : 'running' } VMSpurMemoryManagerTest >> setUpScheduler [ From 81fcdbf8e002874a8e3dfb65f840bbabe2822437 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Mon, 3 Feb 2025 12:28:53 +0100 Subject: [PATCH 03/19] - Adding tests for the FFI calls - Fixing issues with callbacks - Annotating the bytecode correctly - Starting to add support for optimizations --- smalltalksrc/Melchor/VMClass.class.st | 8 ++ smalltalksrc/VMMaker/CoInterpreter.class.st | 14 +- .../VMMaker/CogARMv8Compiler.class.st | 42 ++++++ .../VMMaker/CogAbstractInstruction.class.st | 29 +++- smalltalksrc/VMMaker/LibFFI.class.st | 18 ++- smalltalksrc/VMMaker/LibFFIType.class.st | 7 + .../VMMaker/StackInterpreter.class.st | 8 +- .../StackInterpreterPrimitives.class.st | 25 +++- .../StackToRegisterMappingCogit.class.st | 47 ++++-- ...adBytecodeArgumentMarshallingTest.class.st | 31 ++++ .../VMJitFFISameThreadCalloutTest.class.st | 136 ++++++++++++++++++ .../VMSpurMemoryManagerTest.class.st | 2 +- 12 files changed, 331 insertions(+), 36 deletions(-) diff --git a/smalltalksrc/Melchor/VMClass.class.st b/smalltalksrc/Melchor/VMClass.class.st index 96d756bd69..3dff4a49d7 100644 --- a/smalltalksrc/Melchor/VMClass.class.st +++ b/smalltalksrc/Melchor/VMClass.class.st @@ -702,6 +702,14 @@ VMClass >> logDebug: aFormat _: aParameter [ (aFormat printf: { aParameter }) traceCr ] +{ #category : 'logging' } +VMClass >> logDebug: aFormat _: aParameter _:anotherParam [ + + + + (aFormat printf: { aParameter. anotherParam }) traceCr +] + { #category : 'debug support' } VMClass >> logError: aMessage [ diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index b8c0f39487..2909c6e69a 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -1428,10 +1428,9 @@ CoInterpreter >> ceSameThreadCalloutWithLiteralIndex: functionDefinitionIndex [ - | savedInstructionPointer cogMethod functionDefinition externalFunction cif returnValue | + | cogMethod functionDefinition externalFunction cif returnValue | - "saving instruction pointer in a temporary, as the FFI call can reenter in the interpreter and affect the instance variable" - savedInstructionPointer := instructionPointer := self popStack. + instructionPointer := self popStack. cogMethod := self mframeCogMethod: framePointer . functionDefinition := self literal: functionDefinitionIndex ofMethod: cogMethod methodObject. @@ -1439,21 +1438,22 @@ CoInterpreter >> ceSameThreadCalloutWithLiteralIndex: functionDefinitionIndex [ externalFunction := self getHandler: functionDefinition. externalFunction ifNil: [ self logDebug: 'Invalid External Function Argument'. - ^ self ceFallbackInvalidFFICall: savedInstructionPointer ]. + ^ self ceFallbackInvalidFFICall: instructionPointer ]. cif := self getHandlerAsCif: (objectMemory fetchPointer: 1 ofObject: functionDefinition). cif ifNil: [ self logDebug: 'Invalid CIF in ExternalFunction'. - ^ self ceFallbackInvalidFFICall: savedInstructionPointer ] . + ^ self ceFallbackInvalidFFICall: instructionPointer ] . self doSameThreadCalloutBytecodeFor: externalFunction andCif: cif. + self failed - ifTrue: [ ^ self ceFallbackInvalidFFICall: savedInstructionPointer ]. + ifTrue: [ ^ self ceFallbackInvalidFFICall: instructionPointer ]. returnValue := cif returnType type = FFI_TYPE_VOID ifTrue: [ 0 ] ifFalse: [ self stackTop ]. - self push: savedInstructionPointer. + self push: instructionPointer. ^ returnValue ] diff --git a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st index df6fb2c7c0..0d53711d90 100644 --- a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st +++ b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st @@ -4120,6 +4120,48 @@ CogARMv8Compiler >> genMulR: regSource R: regDest [ ^ first ] +{ #category : 'sameThread callout - optimizations' } +CogARMv8Compiler >> genOptimizedSameThreadCalloutFor: cif andFunctionAddress: externalFunctionAddress [ + + + + self if: cif hasArgType: FFI_TYPE_POINTER returnType: FFI_TYPE_VOID + do: [ ^ self genOptimizedSameThreadCalloutPointerVoidFor: externalFunctionAddress ]. + + ^ super genOptimizedSameThreadCalloutFor: cif andFunctionAddress: externalFunctionAddress +] + +{ #category : 'sameThread callout - optimizations' } +CogARMv8Compiler >> genOptimizedSameThreadCalloutPointerVoidFor: anExternalFunctionAddress [ + + | isOop isOtherImmediate performCallWithSmallInteger jumpExternalAddress performCallWithOop | + cogit ssFlushStack. + cogit ssPopTopToReg: CArg0Reg. + + isOop := objectRepresentation genJumpNotImmediate: CArg0Reg. + isOtherImmediate := objectRepresentation genJumpNotSmallInteger: CArg0Reg. + + objectRepresentation genConvertSmallIntegerToIntegerInReg: CArg0Reg. + performCallWithSmallInteger := cogit Jump: 0. + + isOop jmpTarget: cogit Label. + objectRepresentation genGetCompactClassIndexNonImmOf: CArg0Reg into: TempReg. + cogit CmpCq: objectMemory classExternalAddressIndex R: TempReg. + jumpExternalAddress := cogit JumpZero: 0. + + cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: CArg0Reg R: CArg0Reg. + performCallWithOop := cogit Jump: 0. + + jumpExternalAddress jmpTarget: cogit Label. + cogit MoveMw: objectMemory baseHeaderSize r: CArg0Reg R: CArg0Reg. + + performCallWithOop jmpTarget: (performCallWithSmallInteger jmpTarget: cogit Label). + cogit CallFullRT: anExternalFunctionAddress. + + isOtherImmediate jmpTarget: cogit Label. + ^ true. +] + { #category : 'smalltalk calling convention' } CogARMv8Compiler >> genPushRegisterArgsForAbortMissNumArgs: numArgs [ "Ensure that the register args are pushed before the outer and diff --git a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st index b1bfe6bea4..2d1fc45299 100644 --- a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st +++ b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st @@ -57,7 +57,8 @@ Class { 'dependent', 'cogit', 'objectMemory', - 'bcpc' + 'bcpc', + 'objectRepresentation' ], #classVars : [ 'NumOperands' @@ -65,7 +66,8 @@ Class { #pools : [ 'CogAbstractRegisters', 'CogCompilationConstants', - 'CogRTLOpcodes' + 'CogRTLOpcodes', + 'LibFFIConstants' ], #category : 'VMMaker-JIT', #package : 'VMMaker', @@ -617,7 +619,8 @@ CogAbstractInstruction >> codeGranularity [ CogAbstractInstruction >> cogit: aCogit [ cogit := aCogit. - objectMemory := aCogit objectMemory + objectMemory := aCogit objectMemory. + objectRepresentation := aCogit objectRepresentation. ] { #category : 'generate machine code' } @@ -873,6 +876,15 @@ CogAbstractInstruction >> genMulR: regSource R: regDest [ self subclassResponsibility ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutFor: cif andFunctionAddress: externalFunctionAddress [ + + + + + ^ false +] + { #category : 'smalltalk calling convention' } CogAbstractInstruction >> genPushRegisterArgsForAbortMissNumArgs: numArgs [ "Ensure that the register args are pushed before the outer and @@ -1074,6 +1086,17 @@ CogAbstractInstruction >> hasVarBaseRegister [ ^false ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> if: cif hasArgType: arg0Type returnType: returnType do: aBlock [ + + + + + (cif nargs = 1 and: [ + (cif arg_types at: 0) type = arg0Type and: [ + cif returnType type = returnType ] ]) ifTrue: [ aBlock value ] +] + { #category : 'generate machine code' } CogAbstractInstruction >> inCurrentCompilation: operand [ "Answer if operand is in the current compilation; and henced could be a candidate for pc-relative addressing." diff --git a/smalltalksrc/VMMaker/LibFFI.class.st b/smalltalksrc/VMMaker/LibFFI.class.st index dc891a932a..bc8a831a07 100644 --- a/smalltalksrc/VMMaker/LibFFI.class.st +++ b/smalltalksrc/VMMaker/LibFFI.class.st @@ -2,11 +2,11 @@ Class { #name : 'LibFFI', #superclass : 'VMClass', #instVars : [ - 'nextAddress', 'cifs', 'functions', 'interpreter', - 'testWorker' + 'testWorker', + 'nextAddress' ], #pools : [ 'LibFFIConstants' @@ -110,11 +110,15 @@ LibFFI >> registerFunction: aBlockClosure [ | functionAddress | - - functionAddress := nextAddress. - functions at: nextAddress put: aBlockClosure. - nextAddress := nextAddress + 1. - + + (interpreter cogit isKindOf: Cogit) + ifTrue: [ + functionAddress := interpreter cogit simulatedAddressFor: aBlockClosure. + interpreter cogit simulatedTrampolines at: functionAddress put: aBlockClosure ] + ifFalse: [ functionAddress := nextAddress. + nextAddress := nextAddress + 1]. + + functions at: functionAddress put: aBlockClosure. ^ functionAddress ] diff --git a/smalltalksrc/VMMaker/LibFFIType.class.st b/smalltalksrc/VMMaker/LibFFIType.class.st index e77a9d5d13..6a91074cc8 100644 --- a/smalltalksrc/VMMaker/LibFFIType.class.st +++ b/smalltalksrc/VMMaker/LibFFIType.class.st @@ -59,6 +59,13 @@ LibFFIType class >> type: aType size: aSize on: aLibFFI [ yourself ] +{ #category : 'comparing' } +LibFFIType >> = another [ + + (another isKindOf: self class) ifFalse: [ ^ self ]. + ^ another type = self type +] + { #category : 'accessing' } LibFFIType >> elements: aCollection [ elements := aCollection diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index 3f145151d9..ec744c0648 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -5078,7 +5078,9 @@ StackInterpreter >> doSameThreadCalloutBytecodeFor: externalFunction andCif: cif | argumentSize parameters returnHolder | - + + self initPrimCall. + argumentSize := cif numberArguments. " 1. Prepare Arguments: @@ -5106,7 +5108,9 @@ StackInterpreter >> doSameThreadCalloutBytecodeFor: externalFunction andCif: cif self failed ifTrue: [ - self logDebug: 'Could not convert argument index: %d' _: i + 1. + self logDebug: 'Could not convert argument index: %d value: %p' _: i + 1 _: (self cCoerce: argOop to: #'void*'). + self logDebug: 'Could not convert argument type: %d size: %ld' _: argType type _: argType size. + ^ self ]]. returnHolder := self alloca: cif returnType size. diff --git a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st index 660202be0d..d6f82a7582 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -497,6 +497,22 @@ StackInterpreterPrimitives >> marshallPointerOrOop: externalAddressOrOop into: h pointerHolder := self cCoerce: holder to: #'void **'. + externalAddressOrOop = objectMemory nilObject + ifTrue: [ + pointerHolder at: 0 put: nil. + ^ self ]. + + (objectMemory isIntegerObject: externalAddressOrOop) + ifTrue: [ + pointerHolder at: 0 put: (objectMemory integerValueOf: externalAddressOrOop). + ^ self ]. + + (objectMemory isImmediate: externalAddressOrOop) + ifTrue: [ + self logDebug: 'Error Marshalling Pointer: %p (invalidImmediate)' _: externalAddressOrOop. + self primitiveFail. ^ self ]. + + ((objectMemory classIndexOf: externalAddressOrOop) = objectMemory classExternalAddressIndex) ifTrue: [ pointerHolder at: 0 put: (objectMemory fetchPointer: 0 ofObject: externalAddressOrOop) ] ifFalse: [ pointerHolder at: 0 put: (self cCoerce: (externalAddressOrOop + BaseHeaderSize) to: #sqInt) ] @@ -4013,13 +4029,18 @@ StackInterpreterPrimitives >> ptExitInterpreterToCallback: aPointer [ - | vmCallbackContext suspendedProcess | - + | vmCallbackContext suspendedProcess suspendedContext | + vmCallbackContext := self cCode: [self cCoerce: aPointer to: #'VMCallbackContext *'] inSmalltalk: [ aPointer ]. suspendedProcess := self popSameThreadCalloutSuspendedProcess. + suspendedContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: suspendedProcess. + +" (self isStillMarriedContext: suspendedContext) + ifFalse: [ self logDebug: 'The context is not married' ]. +" self putToSleep: self activeProcess yieldingIf: preemptionYields. self transferTo: suspendedProcess from: CSCallbackLeave. diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index 76725b2738..40fcbbab70 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -348,7 +348,7 @@ StackToRegisterMappingCogit class >> initializeBytecodeTableForSistaV1 [ (2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1) (2 228 228 genExtPushLiteralBytecode needsFrameNever: 1) (2 229 229 genLongPushTemporaryVariableBytecode) - (2 230 230 genSameThreadCalloutBytecode) + (2 230 230 genSameThreadCalloutBytecode isMapped) (2 231 231 genPushNewArrayBytecode) (2 232 232 genExtPushIntegerBytecode needsFrameNever: 1) (2 233 233 genExtPushCharacterBytecode needsFrameNever: 1) @@ -2443,27 +2443,46 @@ StackToRegisterMappingCogit >> genReturnTopFromMethod [ { #category : 'bytecode generators' } StackToRegisterMappingCogit >> genSameThreadCalloutBytecode [ - | literalIndex functionDefinition cif | + | literalIndex functionDefinition cif externalFunction | + literalIndex := byte1. - self ssAllocateCallReg: SendNumArgsReg. - self ssFlushStack. + functionDefinition := self getLiteral: literalIndex. - literalIndex := byte1. + externalFunction := coInterpreter getHandler: functionDefinition. + externalFunction ifNil: [ ^ ShouldNotJIT ]. + + cif := coInterpreter getHandlerAsCif: + (objectMemory fetchPointer: 1 ofObject: functionDefinition). + cif ifNil: [ ^ ShouldNotJIT ]. + +" (backEnd + genOptimizedSameThreadCalloutFor: cif + andFunctionAddress: externalFunction) ifTrue: [ ^ 0 ]. +" + self ssFlushStack. + self ssAllocateCallReg: SendNumArgsReg. "The index of the literal with the function definition is passed as parameter of the trampoline" self MoveCq: literalIndex R: SendNumArgsReg. self CallRT: ceSameThreadCalloutTrampoline. + "We need to annotate the bytecode as there might be a message send in the function call through a Callback" + self annotateBytecode: self Label. - functionDefinition := self getLiteral: literalIndex. - cif := coInterpreter getHandlerAsCif: (objectMemory fetchPointer: 1 ofObject: functionDefinition). - - cif ifNil: [ ^ ShouldNotJIT ]. - - self ssPop: cif numberArguments. + "The trampoline has already poped the values. We need to update the stack count, but not generate pops." + self ssPop: cif numberArguments popSpilled: false. - cif returnType type = FFI_TYPE_VOID - ifTrue: [ ^ 0 ] - ifFalse: [ ^ self ssPushRegister: ReceiverResultReg ] + cif returnType type = FFI_TYPE_VOID + ifFalse: [ + self ssPush: 1. + self ssTop + type: SSRegister; + spilled: true; + registerr: ReceiverResultReg ; + bcptr: bytecodePC. + simSpillBase := simSpillBase + 1. + self updateSimSpillBase]. + + ^ 0 ] { #category : 'bytecode generator support' } diff --git a/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeArgumentMarshallingTest.class.st b/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeArgumentMarshallingTest.class.st index fe2ee16cc0..74ddf70753 100644 --- a/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeArgumentMarshallingTest.class.st +++ b/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeArgumentMarshallingTest.class.st @@ -110,3 +110,34 @@ VMFFISameThreadBytecodeArgumentMarshallingTest >> installFFIFallbackMethod [ inMethodDictionary: aMethodDictionary. ] + +{ #category : 'tests' } +VMFFISameThreadBytecodeArgumentMarshallingTest >> testCalloutWithPointerArgumentWithIntObjectIsMarshalledCorrectly [ + + self + doTestFuntionWithArgumentType: interpreter libFFI pointer + smalltalkValue: (memory integerObjectOf: 8) + expectedValue: 8 +] + +{ #category : 'tests' } +VMFFISameThreadBytecodeArgumentMarshallingTest >> testCalloutWithPointerArgumentWithOopObjectIsMarshalledCorrectly [ + + | anObject | + anObject := self newZeroSizedObject. + + self + doTestFuntionWithArgumentType: interpreter libFFI pointer + smalltalkValue: anObject + expectedValue: anObject + BaseHeaderSize +] + +{ #category : 'tests' } +VMFFISameThreadBytecodeArgumentMarshallingTest >> testCalloutWithPointerPassingCharacterProducesBadArgument [ + + self + doTestFuntionWithArgumentType: interpreter libFFI pointer + smalltalkValue: (memory characterObjectOf: 17) + failsWith: PrimErrBadArgument + +] diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st index 4e79dff724..32f4e5397b 100644 --- a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -220,3 +220,139 @@ VMJitFFISameThreadCalloutTest >> testJITCompilesCallToTrampolineByDefault [ assert: machineSimulator sendNumberOfArgumentsRegisterValue equals: 0 ] + +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithExternalAddressAsParameter [ + + | compiledMethod cogMethod tfExternalFunction called receivedArgument anExternalAddress | + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + called := true. + receivedArgument := arg. + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument equals: 17 +] + +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithOopAsParameter [ + + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + called := true. + receivedArgument := arg. + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void. + + aByteArray := self newByteArrayWithContent: #[1 2 3 4 0 0 0 0]. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: aByteArray; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument equals: aByteArray + BaseHeaderSize +] + +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithSmallIntegerAsParameter [ + + | compiledMethod cogMethod tfExternalFunction called receivedArgument | + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + called := true. + receivedArgument := arg. + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: (memory integerObjectOf: 17); + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument equals: 17 +] diff --git a/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st b/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st index 3b5bbe5fb6..46c71b39c4 100644 --- a/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st @@ -125,7 +125,7 @@ VMSpurMemoryManagerTest >> createExternalAddressClass [ VMSpurMemoryManagerTest >> createExternalFunctionFor: aBlock withArgumentTypes: argumentTypes withReturnType: returnType [ | functionAddress tfExternalFunction functionExternalAddress tfFunctionDefinition cif cifExternalAddress | - + functionAddress := interpreter libFFI registerFunction: aBlock. tfExternalFunction := self newObjectWithSlots: 2. From f374b68b85876d99a5588d668f6c0b93d693d10a Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Wed, 5 Feb 2025 20:35:12 +0100 Subject: [PATCH 04/19] Adding pragma to mark functions that need all localized variables to be externalized before --- .../Melchor/MLLocalizationTestCase.class.st | 89 ++++++++++++++----- .../MockLocalizationInterpreterMock.class.st | 23 +++++ 2 files changed, 89 insertions(+), 23 deletions(-) diff --git a/smalltalksrc/Melchor/MLLocalizationTestCase.class.st b/smalltalksrc/Melchor/MLLocalizationTestCase.class.st index a6ed303235..9946952d44 100644 --- a/smalltalksrc/Melchor/MLLocalizationTestCase.class.st +++ b/smalltalksrc/Melchor/MLLocalizationTestCase.class.st @@ -158,7 +158,7 @@ MLLocalizationTestCase >> testAutoLocalizeVariableDoesNotLineariseUnnecessarySta printedString := String streamContents: [ :str | (block asCASTIn: ccg) prettyPrintOn: str ]. - self assert: printedString equals: '{ + self assert: printedString trimBoth equals: '{ nonInlinedMethodNotUsingAutolocalizedVariables(nonInlinedMethodNotUsingAutolocalizedVariables()); }' ] @@ -184,7 +184,7 @@ MLLocalizationTestCase >> testAutoLocalizeVariableExternalizesBeforeReturnRefere printedString := String streamContents: [ :str | ((TStatementListNode statements: (interpretMethod statements last: 2)) asCASTIn: ccg) prettyPrintOn: str ]. - self assert: printedString equals: '{ + self assert: printedString trimBoth equals: '{ local_autoLocalizedVariable += 1; { autoLocalizedVariable = local_autoLocalizedVariable; @@ -240,14 +240,50 @@ MLLocalizationTestCase >> testAutoLocalizeVariableReplacesByLocalOnInline [ self assert: (variableNode isVariable and: [ variableNode name = #local_autoLocalizedVariable ]). ] +{ #category : 'tests - localisation' } +MLLocalizationTestCase >> testBytecodeUsingExternalizeAllVariables [ + + | interpretMethod cast printedString linearizedBlock | + + MockLocalizationInterpreterMock initializeWithBytecodeUsingExternalizeAllVariables. + + interpretMethod := self applyLocalizationTo: #interpretWithSeveralVariablesToLocalize. + + "Assert that the send node is preceded by variable externalization" + linearizedBlock := self linearizedBlockOfCaseMethod: interpretMethod. + cast := linearizedBlock asCASTIn: ccg. + + printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. + + "The if statement should not be wrapped. Only the inner statements" + self assert: printedString trimBoth equals: +'{ + { + autoLocalizedVariable = local_autoLocalizedVariable; + autoLocalizedVariable1 = local_autoLocalizedVariable1; + autoLocalizedVariable2 = local_autoLocalizedVariable2; + autoLocalizedVariable3 = local_autoLocalizedVariable3; + autoLocalizedVariable4 = local_autoLocalizedVariable4; + aMethodHavingExternalizeAllVariables(); + local_autoLocalizedVariable = autoLocalizedVariable; + local_autoLocalizedVariable1 = autoLocalizedVariable1; + local_autoLocalizedVariable2 = autoLocalizedVariable2; + local_autoLocalizedVariable3 = autoLocalizedVariable3; + local_autoLocalizedVariable4 = autoLocalizedVariable4; + } +} +' trimBoth +] + { #category : 'tests - free variables' } MLLocalizationTestCase >> testCollectFreeVariablesOfMethodWithManyCallers [ | collector | collector := SLCallGraphFreeVariableCollector codeGenerator: ccg. + ccg addClass: MockLocalizationInterpreterMock. ccg prepareMethods. - + " variableToLocalize should be considered free in the entire transitive call graph. @@ -259,10 +295,17 @@ MLLocalizationTestCase >> testCollectFreeVariablesOfMethodWithManyCallers [ " collector startFromSelector: #methodWithDiamond. - self assert: ((collector freeVariablesUsedByMethodNamed: #bytecodeUsingLocalizedVariable) includes: #variableToLocalize). - self assert: ((collector freeVariablesUsedByMethodNamed: #methodCallingBytecodeUsingLocalizedVariable) includes: #variableToLocalize). - self assert: ((collector freeVariablesUsedByMethodNamed: #methodCallingBytecodeUsingLocalizedVariable2) includes: #variableToLocalize). - self assert: ((collector freeVariablesUsedByMethodNamed: #methodWithDiamond) includes: #variableToLocalize). + self assert: ((collector freeVariablesUsedByMethodNamed: + #bytecodeUsingLocalizedVariable) includes: #variableToLocalize). + self assert: ((collector freeVariablesUsedByMethodNamed: + #methodCallingBytecodeUsingLocalizedVariable) includes: + #variableToLocalize). + self assert: ((collector freeVariablesUsedByMethodNamed: + #methodCallingBytecodeUsingLocalizedVariable2) includes: + #variableToLocalize). + self assert: + ((collector freeVariablesUsedByMethodNamed: #methodWithDiamond) + includes: #variableToLocalize) ] { #category : 'tests - localisation' } @@ -277,7 +320,7 @@ MLLocalizationTestCase >> testExternalEscapingAsArgument [ printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. - self assert: printedString equals: + self assert: printedString trimBoth equals: '{ sqInt t0; @@ -303,7 +346,7 @@ MLLocalizationTestCase >> testExternalEscapingAsArgumentOfExternalCall [ printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. - self assert: printedString equals: '{ + self assert: printedString trimBoth equals: '{ sqInt t0; { @@ -335,7 +378,7 @@ MLLocalizationTestCase >> testExternalEscapingSendNodeInInlinedMethod [ printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. - self assert: printedString equals: '{ + self assert: printedString trimBoth equals: '{ autoLocalizedVariable = local_autoLocalizedVariable; autoLocalizedVariable1 = local_autoLocalizedVariable1; foo2(); @@ -357,7 +400,7 @@ MLLocalizationTestCase >> testExternalEscapingSendNodeShouldBeTranslatedWithExte printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. - self assert: printedString equals: '{ + self assert: printedString trimBoth equals: '{ local_autoLocalizedVariable += 1; { autoLocalizedVariable = local_autoLocalizedVariable; @@ -380,7 +423,7 @@ MLLocalizationTestCase >> testExternalEscapingStatementInConditionalBody [ printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. "The if statement should not be wrapped. Only the inner statements" - self assert: printedString equals: + self assert: printedString trimBoth equals: '{ if (1) { sqInt t0; @@ -411,7 +454,7 @@ MLLocalizationTestCase >> testExternalPerform [ printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. - self assert: printedString equals: + self assert: printedString trimBoth trimBoth equals: '{ { autoLocalizedVariable = local_autoLocalizedVariable; @@ -433,7 +476,7 @@ MLLocalizationTestCase >> testExternalSendNodeExternalizeAndInternalizeOnlyNeede cast := linearizedBlock asCASTIn: ccg. printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. - self assert: printedString equals: '{ + self assert: printedString trimBoth equals: '{ local_autoLocalizedVariable += 1; { autoLocalizedVariable = local_autoLocalizedVariable; @@ -460,7 +503,7 @@ MLLocalizationTestCase >> testExternalSendNodeShouldBeTranslatedWithExternalizat cast := linearizedBlock asCASTIn: ccg. printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. - self assert: printedString equals: '{ + self assert: printedString trimBoth equals: '{ sqInt t0; { @@ -499,8 +542,8 @@ MLLocalizationTestCase >> testLinearizeAndInsideValueIf [ t0 ifTrue: [ t0 := self condition ] ifFalse: [ t0 := t0 ] ]. - overflow := t0. - ^ overflow'. + _overflow := t0. + ^ _overflow'. ] { #category : 'tests - linearization' } @@ -532,8 +575,8 @@ MLLocalizationTestCase >> testLinearizeAndInsideValueIfNestedTwice [ t0 ifTrue: [ t0 := self condition ] ifFalse: [ t0 := t0 ] ] ]. - overflow := t0. - ^ overflow'. + _overflow := t0. + ^ _overflow'. ] { #category : 'tests - linearization' } @@ -640,7 +683,7 @@ MLLocalizationTestCase >> testLinearizeNestedCallsWithAssignment [ arguments: { TVariableNode named: 't0' }))). self assert: (replacementBlock statements third isSameAs: (TAssignmentNode - variableNamed: 'foo' + variableNamed: '_foo' expression: (TVariableNode named: 't1'))) ] @@ -728,8 +771,8 @@ MLLocalizationTestCase >> testLinearizeReceiverOfConditionalAndAssigned [ self assert: replacementBlock isRewrittenAs: ' t0 := self nonInlinedMethodUsingAutolocalizedVariable. t0 ifTrue: [ t1 := self nonInlinedMethodUsingAutolocalizedVariable ] ifFalse: [ t1 := t0 ]. - var := t1. - var ifTrue: [nil]'. + _var := t1. + _var ifTrue: [nil]'. ] { #category : 'tests - linearization' } @@ -883,7 +926,7 @@ MLLocalizationTestCase >> testNoExternalSendNodeOnSafeExternalCall [ printedString := String streamContents: [ :str | cast prettyPrintOn: str ]. - self assert: printedString equals: '{ + self assert: printedString trimBoth equals: '{ nonInlinedMethodNotUsingAutolocalizedVariables((local_autoLocalizedVariable += 1)); }' ] diff --git a/smalltalksrc/Melchor/MockLocalizationInterpreterMock.class.st b/smalltalksrc/Melchor/MockLocalizationInterpreterMock.class.st index 6927c5f3d5..91668033a9 100644 --- a/smalltalksrc/Melchor/MockLocalizationInterpreterMock.class.st +++ b/smalltalksrc/Melchor/MockLocalizationInterpreterMock.class.st @@ -42,6 +42,16 @@ MockLocalizationInterpreterMock class >> initializeWithAutoLocalizedVariableOnly ) ] +{ #category : 'initialization' } +MockLocalizationInterpreterMock class >> initializeWithBytecodeUsingExternalizeAllVariables [ + + BytecodeTable := Array new: 1. + self table: BytecodeTable from: + #( + ( 0 bytecodeUsingExternalizeAllVariables) + ) +] + { #category : 'initialization' } MockLocalizationInterpreterMock class >> initializeWithEscapingCall [ @@ -152,6 +162,13 @@ MockLocalizationInterpreterMock class >> initializeWithoutAutoLocalizedVariable ) ] +{ #category : 'interpreter shell' } +MockLocalizationInterpreterMock >> aMethodHavingExternalizeAllVariables [ + + + +] + { #category : 'interpreter shell' } MockLocalizationInterpreterMock >> bytecodeInliningSharedMethod [ @@ -183,6 +200,12 @@ MockLocalizationInterpreterMock >> bytecodeUsingComplexAssert [ self assert: (self foo or: [ self bar and: [ self fum ] ]) ] +{ #category : 'interpreter shell' } +MockLocalizationInterpreterMock >> bytecodeUsingExternalizeAllVariables [ + + self aMethodHavingExternalizeAllVariables +] + { #category : 'interpreter shell' } MockLocalizationInterpreterMock >> bytecodeUsingExternalizedAutoLocalizedVariable [ From dbfb5fa2b0de75e7869b07bb1674a6d653fd3d48 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Wed, 5 Feb 2025 20:36:25 +0100 Subject: [PATCH 05/19] Adding externenalization for supporting functions that require all localized variables (they leave the interpreter) --- smalltalksrc/Slang/CCodeGenerator.class.st | 1 - smalltalksrc/Slang/SLAutomaticLocalization.class.st | 6 +++++- .../Slang/SLCallGraphFreeVariableCollector.class.st | 13 ++++++++++++- smalltalksrc/Slang/SLCallGraphVisitor.class.st | 4 ++-- smalltalksrc/Slang/SLLinearisationVisitor.class.st | 3 ++- .../Slang/SLLocalizableVariableCollector.class.st | 3 ++- 6 files changed, 23 insertions(+), 7 deletions(-) diff --git a/smalltalksrc/Slang/CCodeGenerator.class.st b/smalltalksrc/Slang/CCodeGenerator.class.st index 2fab900891..8b73498be1 100644 --- a/smalltalksrc/Slang/CCodeGenerator.class.st +++ b/smalltalksrc/Slang/CCodeGenerator.class.st @@ -5273,7 +5273,6 @@ CCodeGenerator >> validateLocalizationOfGlobals: varList exceptMethod: methodNam localizationCandidates do: [ :candidate | (methodFreeVariables includes: candidate) ifTrue: [ - 1halt. variablesInConflict add: candidate ] ] ] ]. variablesInConflict ifNotEmpty: [ | errorMessage | diff --git a/smalltalksrc/Slang/SLAutomaticLocalization.class.st b/smalltalksrc/Slang/SLAutomaticLocalization.class.st index 7b374486b4..1709b9572c 100644 --- a/smalltalksrc/Slang/SLAutomaticLocalization.class.st +++ b/smalltalksrc/Slang/SLAutomaticLocalization.class.st @@ -76,9 +76,12 @@ SLAutomaticLocalization >> autoLocalizationOfVariablesIn: aSelector withVariable (replacementList isNil or: [ replacementList isEmpty ]) ifTrue: [ ^ self ]. codeGenerator currentMethod: m. - + replacementDict := (replacementList collect: [ :asso | asso key -> (TVariableNode named: asso value) ]) asDictionary. + + callgraphVariableCollector candidateVariables: replacementDict keys. + "Replace all localized variables by their localized versions" m parseTree bindVariablesIn: replacementDict. @@ -107,6 +110,7 @@ SLAutomaticLocalization >> codeGenerator: anObject [ codeGenerator := anObject. callgraphVariableCollector := SLCallGraphFreeVariableCollector codeGenerator: codeGenerator + ] { #category : 'applying' } diff --git a/smalltalksrc/Slang/SLCallGraphFreeVariableCollector.class.st b/smalltalksrc/Slang/SLCallGraphFreeVariableCollector.class.st index 1a826b081a..85e48e14ad 100644 --- a/smalltalksrc/Slang/SLCallGraphFreeVariableCollector.class.st +++ b/smalltalksrc/Slang/SLCallGraphFreeVariableCollector.class.st @@ -9,13 +9,21 @@ Class { #superclass : 'SLCallGraphVisitor', #instVars : [ 'accumulatedFreeVariables', - 'freeVariablesPerMethod' + 'freeVariablesPerMethod', + 'candidateVariables' ], #category : 'Slang-Optimizations', #package : 'Slang', #tag : 'Optimizations' } +{ #category : 'as yet unclassified' } +SLCallGraphFreeVariableCollector >> candidateVariables: aCollection [ + + candidateVariables := aCollection + +] + { #category : 'accessing' } SLCallGraphFreeVariableCollector >> freeVariablesUsedByMethodNamed: aSelector [ @@ -52,6 +60,9 @@ SLCallGraphFreeVariableCollector >> postVisitMethod: aMethod [ myVariables := accumulatedFreeVariables removeLast. myVariables value addAll: aMethod freeVariableReferences. + (aMethod hasProperty: #externalizeAllVariables) + ifTrue: [ myVariables value addAll: candidateVariables ]. + freeVariablesPerMethod at: aMethod selector put: myVariables value. "Now accumulate my variables in my parent one's, if I'm not the top one" diff --git a/smalltalksrc/Slang/SLCallGraphVisitor.class.st b/smalltalksrc/Slang/SLCallGraphVisitor.class.st index d2c403ab86..f7144aa03d 100644 --- a/smalltalksrc/Slang/SLCallGraphVisitor.class.st +++ b/smalltalksrc/Slang/SLCallGraphVisitor.class.st @@ -35,9 +35,9 @@ Class { { #category : 'instance creation' } SLCallGraphVisitor class >> codeGenerator: aCodeGenerator [ - + ^ self new - codeGenerator: aCodeGenerator; + codeGenerator: aCodeGenerator yourself ] diff --git a/smalltalksrc/Slang/SLLinearisationVisitor.class.st b/smalltalksrc/Slang/SLLinearisationVisitor.class.st index 7e8ca2b9ba..ce82a79e8f 100644 --- a/smalltalksrc/Slang/SLLinearisationVisitor.class.st +++ b/smalltalksrc/Slang/SLLinearisationVisitor.class.st @@ -68,7 +68,8 @@ SLLinearisationVisitor >> codeGenerator: anObject [ { #category : 'accessing' } SLLinearisationVisitor >> localizedVariables: anObject [ - localizedVariables := anObject + localizedVariables := anObject. + callgraphVariableCollector candidateVariables: localizedVariables ] { #category : 'visiting' } diff --git a/smalltalksrc/Slang/SLLocalizableVariableCollector.class.st b/smalltalksrc/Slang/SLLocalizableVariableCollector.class.st index f8f85c24c6..57c5cfb043 100644 --- a/smalltalksrc/Slang/SLLocalizableVariableCollector.class.st +++ b/smalltalksrc/Slang/SLLocalizableVariableCollector.class.st @@ -83,7 +83,8 @@ SLLocalizableVariableCollector >> localizableCandidateVariables [ { #category : 'accessing' } SLLocalizableVariableCollector >> localizableCandidateVariables: anObject [ - localizableCandidateVariables := anObject + localizableCandidateVariables := anObject. + ] { #category : 'accessing' } From 4a7246fe4f67d8af9b740491c9b150dc4b3f3c9d Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Wed, 5 Feb 2025 20:40:23 +0100 Subject: [PATCH 06/19] - Fixing problems with localized variables - Improving optimized code - Adding tests - Fixing types --- smalltalksrc/VMMaker/CoInterpreter.class.st | 4 +- .../VMMaker/CogARMv8Compiler.class.st | 47 ++++- .../VMMaker/StackInterpreter.class.st | 6 +- .../StackToRegisterMappingCogit.class.st | 10 +- .../VMJitFFISameThreadCalloutTest.class.st | 185 ++++++++++++++++++ 5 files changed, 236 insertions(+), 16 deletions(-) diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index 2909c6e69a..2439d374d4 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -1432,6 +1432,8 @@ CoInterpreter >> ceSameThreadCalloutWithLiteralIndex: functionDefinitionIndex [ instructionPointer := self popStack. + self assert: stackPointer < framePointer. + cogMethod := self mframeCogMethod: framePointer . functionDefinition := self literal: functionDefinitionIndex ofMethod: cogMethod methodObject. @@ -1451,7 +1453,7 @@ CoInterpreter >> ceSameThreadCalloutWithLiteralIndex: functionDefinitionIndex [ self failed ifTrue: [ ^ self ceFallbackInvalidFFICall: instructionPointer ]. - returnValue := cif returnType type = FFI_TYPE_VOID ifTrue: [ 0 ] ifFalse: [ self stackTop ]. + returnValue := cif returnType type = FFI_TYPE_VOID ifTrue: [ 0 ] ifFalse: [ self popStack ]. self push: instructionPointer. diff --git a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st index 0d53711d90..a7bce12732 100644 --- a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st +++ b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st @@ -4134,31 +4134,68 @@ CogARMv8Compiler >> genOptimizedSameThreadCalloutFor: cif andFunctionAddress: ex { #category : 'sameThread callout - optimizations' } CogARMv8Compiler >> genOptimizedSameThreadCalloutPointerVoidFor: anExternalFunctionAddress [ - | isOop isOtherImmediate performCallWithSmallInteger jumpExternalAddress performCallWithOop | + | isOop isOtherImmediate performCallWithSmallInteger jumpExternalAddress performCallWithOop skipErrorRoutine errorRoutine jumpIsNil performCallWithNil | cogit ssFlushStack. + + "Generate error routine + ======================" + skipErrorRoutine := cogit Jump: 0. + errorRoutine := cogit Label. + cogit Stop. + + skipErrorRoutine jmpTarget: cogit Label. + + "1. Pop Into First Argument Registry" cogit ssPopTopToReg: CArg0Reg. + "2. Check Types: if is an SMI or an OOP handle it, if other immediate error" isOop := objectRepresentation genJumpNotImmediate: CArg0Reg. isOtherImmediate := objectRepresentation genJumpNotSmallInteger: CArg0Reg. - + isOtherImmediate jmpTarget: errorRoutine. + + "3. If a SMI, convert it and jump to call" objectRepresentation genConvertSmallIntegerToIntegerInReg: CArg0Reg. performCallWithSmallInteger := cogit Jump: 0. + "4. If OOP, ensure is not a forwarder." isOop jmpTarget: cogit Label. + objectRepresentation genEnsureObjInRegNotForwarded: CArg0Reg scratchReg: TempReg. + + "If it is nil move 0 to register" + cogit CmpCq: objectMemory nilObject R: CArg0Reg. + jumpIsNil := cogit JumpZero: 0. + + "If it is an external address handle it different" objectRepresentation genGetCompactClassIndexNonImmOf: CArg0Reg into: TempReg. cogit CmpCq: objectMemory classExternalAddressIndex R: TempReg. jumpExternalAddress := cogit JumpZero: 0. + "5. Obtain address of first pointer " cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: CArg0Reg R: CArg0Reg. performCallWithOop := cogit Jump: 0. + "6. Handle Nil" + jumpIsNil jmpTarget: cogit Label. + cogit MoveCq: 0 R: CArg0Reg. + performCallWithNil := cogit Jump: 0. + + "7. Handle External Address" jumpExternalAddress jmpTarget: cogit Label. cogit MoveMw: objectMemory baseHeaderSize r: CArg0Reg R: CArg0Reg. - performCallWithOop jmpTarget: (performCallWithSmallInteger jmpTarget: cogit Label). + performCallWithOop jmpTarget: (performCallWithNil jmpTarget: (performCallWithSmallInteger jmpTarget: cogit Label)). + + "8. Change to C Stack, pushing LinkRegistry if needed" + cogit genSmalltalkToCStackSwitch: true. + + "9. Perform Call" cogit CallFullRT: anExternalFunctionAddress. - - isOtherImmediate jmpTarget: cogit Label. + + "10. Change to Smalltalk Stack recovering LinkReg" + self genLoadStackPointers. + self hasLinkRegister + ifTrue: [cogit PopR: LinkReg]. + ^ true. ] diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index ec744c0648..d08fea1ad2 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -5070,6 +5070,7 @@ StackInterpreter >> doRecordSendTrace [ { #category : 'FFI bytecode' } StackInterpreter >> doSameThreadCalloutBytecodeFor: externalFunction andCif: cif [ + @@ -5078,7 +5079,7 @@ StackInterpreter >> doSameThreadCalloutBytecodeFor: externalFunction andCif: cif | argumentSize parameters returnHolder | - + self initPrimCall. argumentSize := cif numberArguments. @@ -9811,6 +9812,7 @@ StackInterpreter >> marryFrame: theFP SP: theSP copyTemps: copyTemps [ + | theContext methodHeader closureOrNil numSlots numArgs numStack numTemps | self assert: (self frameHasContext: theFP) not. @@ -14951,6 +14953,8 @@ StackInterpreter >> stackPointerIndexForFrame: theFP WithSP: theSP [ "In the StackInterpreter stacks grow down." + + ^ (self frameReceiverLocation: theFP) - theSP >> objectMemory shiftForWord + (self frameNumArgs: theFP) ] diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index 40fcbbab70..f9efed39bd 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -2472,15 +2472,7 @@ StackToRegisterMappingCogit >> genSameThreadCalloutBytecode [ self ssPop: cif numberArguments popSpilled: false. cif returnType type = FFI_TYPE_VOID - ifFalse: [ - self ssPush: 1. - self ssTop - type: SSRegister; - spilled: true; - registerr: ReceiverResultReg ; - bcptr: bytecodePC. - simSpillBase := simSpillBase + 1. - self updateSimSpillBase]. + ifFalse: [ self ssPushRegister: ReceiverResultReg]. ^ 0 ] diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st index 32f4e5397b..4520e2c6f3 100644 --- a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -9,6 +9,15 @@ Class { #tag : 'JitTests' } +{ #category : 'helpers' } +VMJitFFISameThreadCalloutTest >> callCogMethod: callingMethod receiver: receiver arguments: args returnAddress: returnAddress [ + + cogit processor setFramePointer: interpreter framePointer stackPointer: interpreter stackPointer. + + ^ super callCogMethod: callingMethod receiver: receiver arguments: args returnAddress: returnAddress + +] + { #category : 'running' } VMJitFFISameThreadCalloutTest >> jitCompilerClass [ @@ -103,6 +112,49 @@ VMJitFFISameThreadCalloutTest >> testExecutingFunctionCallsExternalFunction [ self assert: called ] +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testExecutingFunctionChangesStack [ + + | compiledMethod cogMethod tfExternalFunction changedStack anExternalAddress | + + changedStack := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [ + changedStack := (machineSimulator stackPointerRegisterValue bitAnd: 16rFFFFFF00) = (cogit getCStackPointer bitAnd: 16rFFFFFF00). + 0 ] + withArgumentTypes: { } + withReturnType: interpreter libFFI void. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: changedStack. + +] + { #category : 'tests' } VMJitFFISameThreadCalloutTest >> testExecutingFunctionPopsCorrectlyAndReturnsTheResult [ @@ -221,6 +273,49 @@ VMJitFFISameThreadCalloutTest >> testJITCompilesCallToTrampolineByDefault [ equals: 0 ] +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidChangesStack [ + + | compiledMethod cogMethod tfExternalFunction changedStack anExternalAddress | + + changedStack := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + changedStack := (machineSimulator stackPointerRegisterValue bitAnd: 16rFFFFFF00) = (cogit getCStackPointer bitAnd: 16rFFFFFF00). + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: changedStack. + +] + { #category : 'tests' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithExternalAddressAsParameter [ @@ -267,6 +362,52 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithExternalA self assert: receivedArgument equals: 17 ] +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithNilAsParameter [ + + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + called := true. + receivedArgument := arg. + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void. + + aByteArray := self newByteArrayWithContent: #[1 2 3 4 0 0 0 0]. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: memory nilObject; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument equals: 0 +] + { #category : 'tests' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithOopAsParameter [ @@ -356,3 +497,47 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithSmallInte self assert: called. self assert: receivedArgument equals: 17 ] + +{ #category : 'tests' } +VMJitFFISameThreadCalloutTest >> testPopingIntoTemporaryReturnValueWorkCorrectly [ + + | compiledMethod cogMethod tfExternalFunction called anExternalAddress | + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [ called:= true. 32 ] + withArgumentTypes: { } + withReturnType: interpreter libFFI sint64. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + numberOfTemporaries: 1; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: memory nilObject; "Class Binding" + bytecodes: #[ + 230 0 "SameThreadCallout Literal0" + 208 "PopInto Temp 0" + 64 "Push Temp 0" + 92 "ReturnTop"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 32). + self assert: called. + +] From 3d1fb90b7409c2e96389a7bfc66db9966345798d Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Sat, 1 Mar 2025 13:42:08 +0100 Subject: [PATCH 07/19] - Adding tests - Implementing some optimizations - Implementing it for ARM32 / ARM64 / X64 (SysV & WIN) - Supporting flags to optimize the code --- smalltalksrc/VMMaker/CoInterpreter.class.st | 8 + smalltalksrc/VMMaker/CogARMCompiler.class.st | 7 + .../VMMaker/CogARMv8Compiler.class.st | 86 +- .../VMMaker/CogAbstractInstruction.class.st | 348 ++++++- smalltalksrc/VMMaker/CogIA32Compiler.class.st | 9 + .../CogObjectRepresentationForSpur.class.st | 20 +- smalltalksrc/VMMaker/CogX64Compiler.class.st | 14 + smalltalksrc/VMMaker/LibFFIConstants.class.st | 8 +- .../VMMaker/SimpleStackBasedCogit.class.st | 23 +- .../StackInterpreterPrimitives.class.st | 2 +- .../StackToRegisterMappingCogit.class.st | 14 +- .../VMMakerTests/ProcessorSimulator.class.st | 12 + .../UnicornARMv5Simulator.class.st | 6 + .../UnicornARMv8Simulator.class.st | 14 +- .../VMMakerTests/UnicornProcessor.class.st | 6 + .../UnicornRISCVSimulator.class.st | 6 + .../VMMakerTests/UnicornX64Simulator.class.st | 6 + .../VMJitFFISameThreadCalloutTest.class.st | 919 +++++++++++++++++- .../VMSpurMemoryManagerTest.class.st | 14 +- 19 files changed, 1375 insertions(+), 147 deletions(-) diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index 2439d374d4..305b671fb0 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -1181,6 +1181,14 @@ CoInterpreter >> ceCounterTripped: condition [ ^true ] +{ #category : 'trampolines' } +CoInterpreter >> ceFallbackInvalidFFICall [ + + + instructionPointer := self popStack. + ^ self ceFallbackInvalidFFICall: instructionPointer +] + { #category : 'trampolines' } CoInterpreter >> ceFallbackInvalidFFICall: savedInstructionPointer [ diff --git a/smalltalksrc/VMMaker/CogARMCompiler.class.st b/smalltalksrc/VMMaker/CogARMCompiler.class.st index 1ca623e086..add98ada80 100644 --- a/smalltalksrc/VMMaker/CogARMCompiler.class.st +++ b/smalltalksrc/VMMaker/CogARMCompiler.class.st @@ -438,6 +438,13 @@ CogARMCompiler >> byteReadsZeroExtend [ ^true ] +{ #category : 'abi' } +CogARMCompiler >> cArg0Register [ + + + ^R0 +] + { #category : 'abi' } CogARMCompiler >> cResultRegister [ "Answer the register through which C funcitons return integral results." diff --git a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st index a7bce12732..03a11fc9a5 100644 --- a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st +++ b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st @@ -844,6 +844,13 @@ CogARMv8Compiler >> byteReadsZeroExtend [ ^true ] +{ #category : 'abi' } +CogARMv8Compiler >> cArg0Register [ + + + ^R0 +] + { #category : 'abi' } CogARMv8Compiler >> cResultRegister [ "Answer the register through which C funcitons return integral results." @@ -4120,85 +4127,6 @@ CogARMv8Compiler >> genMulR: regSource R: regDest [ ^ first ] -{ #category : 'sameThread callout - optimizations' } -CogARMv8Compiler >> genOptimizedSameThreadCalloutFor: cif andFunctionAddress: externalFunctionAddress [ - - - - self if: cif hasArgType: FFI_TYPE_POINTER returnType: FFI_TYPE_VOID - do: [ ^ self genOptimizedSameThreadCalloutPointerVoidFor: externalFunctionAddress ]. - - ^ super genOptimizedSameThreadCalloutFor: cif andFunctionAddress: externalFunctionAddress -] - -{ #category : 'sameThread callout - optimizations' } -CogARMv8Compiler >> genOptimizedSameThreadCalloutPointerVoidFor: anExternalFunctionAddress [ - - | isOop isOtherImmediate performCallWithSmallInteger jumpExternalAddress performCallWithOop skipErrorRoutine errorRoutine jumpIsNil performCallWithNil | - cogit ssFlushStack. - - "Generate error routine - ======================" - skipErrorRoutine := cogit Jump: 0. - errorRoutine := cogit Label. - cogit Stop. - - skipErrorRoutine jmpTarget: cogit Label. - - "1. Pop Into First Argument Registry" - cogit ssPopTopToReg: CArg0Reg. - - "2. Check Types: if is an SMI or an OOP handle it, if other immediate error" - isOop := objectRepresentation genJumpNotImmediate: CArg0Reg. - isOtherImmediate := objectRepresentation genJumpNotSmallInteger: CArg0Reg. - isOtherImmediate jmpTarget: errorRoutine. - - "3. If a SMI, convert it and jump to call" - objectRepresentation genConvertSmallIntegerToIntegerInReg: CArg0Reg. - performCallWithSmallInteger := cogit Jump: 0. - - "4. If OOP, ensure is not a forwarder." - isOop jmpTarget: cogit Label. - objectRepresentation genEnsureObjInRegNotForwarded: CArg0Reg scratchReg: TempReg. - - "If it is nil move 0 to register" - cogit CmpCq: objectMemory nilObject R: CArg0Reg. - jumpIsNil := cogit JumpZero: 0. - - "If it is an external address handle it different" - objectRepresentation genGetCompactClassIndexNonImmOf: CArg0Reg into: TempReg. - cogit CmpCq: objectMemory classExternalAddressIndex R: TempReg. - jumpExternalAddress := cogit JumpZero: 0. - - "5. Obtain address of first pointer " - cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: CArg0Reg R: CArg0Reg. - performCallWithOop := cogit Jump: 0. - - "6. Handle Nil" - jumpIsNil jmpTarget: cogit Label. - cogit MoveCq: 0 R: CArg0Reg. - performCallWithNil := cogit Jump: 0. - - "7. Handle External Address" - jumpExternalAddress jmpTarget: cogit Label. - cogit MoveMw: objectMemory baseHeaderSize r: CArg0Reg R: CArg0Reg. - - performCallWithOop jmpTarget: (performCallWithNil jmpTarget: (performCallWithSmallInteger jmpTarget: cogit Label)). - - "8. Change to C Stack, pushing LinkRegistry if needed" - cogit genSmalltalkToCStackSwitch: true. - - "9. Perform Call" - cogit CallFullRT: anExternalFunctionAddress. - - "10. Change to Smalltalk Stack recovering LinkReg" - self genLoadStackPointers. - self hasLinkRegister - ifTrue: [cogit PopR: LinkReg]. - - ^ true. -] - { #category : 'smalltalk calling convention' } CogARMv8Compiler >> genPushRegisterArgsForAbortMissNumArgs: numArgs [ "Ensure that the register args are pushed before the outer and diff --git a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st index 2d1fc45299..d7a3754ab0 100644 --- a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st +++ b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st @@ -535,6 +535,13 @@ CogAbstractInstruction >> byteReadsZeroExtend [ ^false ] +{ #category : 'accessing' } +CogAbstractInstruction >> cArg0Register [ + + + ^ self subclassResponsibility +] + { #category : 'accessing' } CogAbstractInstruction >> cResultRegister [ "Answer the register through which C funcitons return integral results." @@ -755,6 +762,34 @@ CogAbstractInstruction >> genCaptureCStackPointers: captureFramePointer [ cogit RetN: 0. ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genFFIFallbackCall [ + + | skipErrorRoutine errorRoutine | + + skipErrorRoutine := cogit Jump: 0. + errorRoutine := cogit Label. + cogit CallFullRT: cogit getFallbackInvalidFFICallTrampoline. + + skipErrorRoutine jmpTarget: cogit Label. + ^ errorRoutine +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genFFISameThreadCall: anExternalFunctionAddress [. + + "Change to C Stack, pushing LinkRegistry if needed" + cogit genSmalltalkToCStackSwitch: true. + + self prepareStackForFFICall. + + cogit CallFullRT: anExternalFunctionAddress. + + self genLoadStackPointers. + self hasLinkRegister + ifTrue: [cogit PopR: LinkReg]. +] + { #category : 'abstract instructions' } CogAbstractInstruction >> genJumpFPEqual: jumpTarget [ @@ -834,6 +869,19 @@ CogAbstractInstruction >> genLoadStackPointers [ self subclassResponsibility ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genMarshallDoubleArgumentInReg: reg errorRoutineLabel: errorRoutine withFlags: flags [ + + | mightBeOOp mightBeExternalAddress jumpIfNotFloat | + + mightBeOOp := (flags bitAnd: FFI_FLAG_POINTERS_MIGHT_BE_OBJECTS) ~= 0. + mightBeExternalAddress := (flags bitAnd: FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES) ~= 0. + + cogit ssPopTopToReg: Extra0Reg. + jumpIfNotFloat := objectRepresentation genBoxedOrSmallFloat: Extra0Reg scratchReg: Extra1Reg into: reg. + jumpIfNotFloat jmpTarget: errorRoutine +] + { #category : 'abi' } CogAbstractInstruction >> genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 [ "Generate the code to pass up to four arguments in a C run-time call. Hack: each argument is @@ -868,6 +916,74 @@ CogAbstractInstruction >> genMarshallNArgs: numArgs floatArg: regOrConst0 floatA ^self subclassResponsibility ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genMarshallPointerArgumentInReg: reg errorRoutineLabel: errorRoutine withFlags: flags [ + + | mightBeOOp mightBeExternalAddress isNotOop isExternalAddress performCallWithOop | + + mightBeOOp := (flags bitAnd: FFI_FLAG_POINTERS_MIGHT_BE_OBJECTS) ~= 0. + mightBeExternalAddress := (flags bitAnd: FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES) ~= 0. + + cogit ssPopTopToReg: reg. + + "If it is an immediate we just cancel" + isNotOop := objectRepresentation genJumpImmediate: reg. + isNotOop jmpTarget: errorRoutine. + + "We need to ensure if it is not a forwarder in all cases" + objectRepresentation genEnsureObjInRegNotForwarded: reg scratchReg: Extra0Reg. + + (mightBeExternalAddress and: [ mightBeOOp not ]) + ifTrue: [ + objectRepresentation genGetCompactClassIndexNonImmOf: reg into: Extra0Reg. + cogit CmpCq: objectMemory classExternalAddressIndex R: Extra0Reg. + cogit JumpNonZero: errorRoutine. + cogit MoveMw: objectMemory baseHeaderSize r: reg R: reg. + ^ self ]. + + (mightBeExternalAddress not and: [ mightBeOOp ]) + ifTrue: [ + cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: reg R: reg. + ^ self ]. + + self deny: (mightBeExternalAddress not and: [ mightBeOOp not]). + + "It might Be OOP or External Address" + + "If it is an external address handle it different" + objectRepresentation genGetCompactClassIndexNonImmOf: reg into: Extra0Reg. + cogit CmpCq: objectMemory classExternalAddressIndex R: Extra0Reg. + isExternalAddress := cogit JumpZero: 0. + + cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: reg R: reg. + performCallWithOop := cogit Jump: 0. + + isExternalAddress jmpTarget: cogit Label. + cogit MoveMw: objectMemory baseHeaderSize r: reg R: reg. + + performCallWithOop jmpTarget: cogit Label. + +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genMarshallReturnPointer: errorRoutineLabel [ + + | jumpFailAlloc | + + self assert: self cResultRegister ~= ReceiverResultReg. + self assert: self cResultRegister ~= Extra0Reg. + + jumpFailAlloc := objectRepresentation + genAllocExternalAddressValue: self cResultRegister + into: ReceiverResultReg + scratchReg: Extra0Reg. + + jumpFailAlloc jmpTarget: errorRoutineLabel. + + cogit ssPushRegister: ReceiverResultReg. + +] + { #category : 'abstract instructions' } CogAbstractInstruction >> genMulR: regSource R: regDest [ "Generate whatever code necessary to do a bytesPerOop x bytesPerOop multiplication, @@ -877,14 +993,159 @@ CogAbstractInstruction >> genMulR: regSource R: regDest [ ] { #category : 'sameThread callout - optimizations' } -CogAbstractInstruction >> genOptimizedSameThreadCalloutFor: cif andFunctionAddress: externalFunctionAddress [ +CogAbstractInstruction >> genOptimizedSameThreadCalloutDoubleVoidFor: anExternalFunctionAddress withFlags: flags [ - + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallDoubleArgumentInReg: DPFPReg0 errorRoutineLabel: errorRoutine withFlags: flags. + + self genFFISameThreadCall: anExternalFunctionAddress. + + ^ true. +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutFor: cif flags: flags andFunctionAddress: externalFunctionAddress [ + + - + + (flags bitAnd: FFI_FLAG_USE_OPTIMIZED_VERSION) = 0 + ifTrue: [ ^ false ]. + + self if: cif returnType: FFI_TYPE_POINTER do: [ ^ self genOptimizedSameThreadCalloutVoidPointerFor: externalFunctionAddress withFlags: flags ]. + self if: cif hasArgType: FFI_TYPE_DOUBLE returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutDoubleVoidFor: externalFunctionAddress withFlags: flags ]. + self if: cif hasArgType: FFI_TYPE_POINTER returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutPointerVoidFor: externalFunctionAddress withFlags: flags ]. + self if: cif hasArgType: FFI_TYPE_POINTER returnType: FFI_TYPE_POINTER do: [ ^ self genOptimizedSameThreadCalloutPointerPointerFor: externalFunctionAddress withFlags: flags ]. + + self if: cif + hasArgType: FFI_TYPE_POINTER + and: FFI_TYPE_DOUBLE + and: FFI_TYPE_DOUBLE + returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutPointerDoubleDoubleVoidFor: externalFunctionAddress withFlags: flags ]. + + self if: cif + hasArgType: FFI_TYPE_POINTER + and: FFI_TYPE_DOUBLE + and: FFI_TYPE_DOUBLE + and: FFI_TYPE_DOUBLE + returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutPointerDoubleDoubleDoubleVoidFor: externalFunctionAddress withFlags: flags ]. + + self if: cif + hasArgType: FFI_TYPE_POINTER + and: FFI_TYPE_DOUBLE + and: FFI_TYPE_DOUBLE + and: FFI_TYPE_DOUBLE + and: FFI_TYPE_DOUBLE + returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutPointerDoubleDoubleDoubleDoubleVoidFor: externalFunctionAddress withFlags: flags ]. + ^ false ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerDoubleDoubleDoubleDoubleVoidFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallDoubleArgumentInReg: DPFPReg3 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentInReg: DPFPReg2 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentInReg: DPFPReg1 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentInReg: DPFPReg0 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + + self genFFISameThreadCall: anExternalFunctionAddress. + + ^ true +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerDoubleDoubleDoubleVoidFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallDoubleArgumentInReg: DPFPReg2 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentInReg: DPFPReg1 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentInReg: DPFPReg0 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + + self genFFISameThreadCall: anExternalFunctionAddress. + + ^ true +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerDoubleDoubleVoidFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallDoubleArgumentInReg: DPFPReg1 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentInReg: DPFPReg0 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + + self genFFISameThreadCall: anExternalFunctionAddress. + + ^ true +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerPointerFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + + self genFFISameThreadCall: anExternalFunctionAddress. + + self genMarshallReturnPointer: errorRoutine. + + ^ true. +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerVoidFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + + self genFFISameThreadCall: anExternalFunctionAddress. + + ^ true. +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutVoidPointerFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genFFISameThreadCall: anExternalFunctionAddress. + + self genMarshallReturnPointer: errorRoutine. + + ^ true +] + { #category : 'smalltalk calling convention' } CogAbstractInstruction >> genPushRegisterArgsForAbortMissNumArgs: numArgs [ "Ensure that the register args are pushed before the outer and @@ -1086,6 +1347,72 @@ CogAbstractInstruction >> hasVarBaseRegister [ ^false ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> if: cif +hasArgType: arg0Type +and: arg1Type +and: arg2Type +and: arg3Type +and: arg4Type +returnType: returnType do: aBlock [ + + + + + + cif nargs = 5 ifFalse: [ ^ self ]. + cif returnType type = returnType ifFalse: [ ^ self ]. + + (cif arg_types at: 0) type = arg0Type ifFalse: [ ^ self ]. + (cif arg_types at: 1) type = arg1Type ifFalse: [ ^ self ]. + (cif arg_types at: 2) type = arg2Type ifFalse: [ ^ self ]. + (cif arg_types at: 3) type = arg3Type ifFalse: [ ^ self ]. + (cif arg_types at: 4) type = arg4Type ifFalse: [ ^ self ]. + + aBlock value. +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> if: cif +hasArgType: arg0Type +and: arg1Type +and: arg2Type +and: arg3Type +returnType: returnType do: aBlock [ + + + + + + cif nargs = 4 ifFalse: [ ^ self ]. + cif returnType type = returnType ifFalse: [ ^ self ]. + + (cif arg_types at: 0) type = arg0Type ifFalse: [ ^ self ]. + (cif arg_types at: 1) type = arg1Type ifFalse: [ ^ self ]. + (cif arg_types at: 2) type = arg2Type ifFalse: [ ^ self ]. + (cif arg_types at: 3) type = arg3Type ifFalse: [ ^ self ]. + + aBlock value. +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> if: cif +hasArgType: arg0Type +and: arg1Type +and: arg2Type +returnType: returnType do: aBlock [ + + + + + + (cif nargs = 3 and: [ + (cif arg_types at: 0) type = arg0Type and: [ + (cif arg_types at: 1) type = arg1Type and: [ + (cif arg_types at: 2) type = arg2Type and: [ + cif returnType type = returnType ] ]]]) ifTrue: [ aBlock value ] +] + { #category : 'sameThread callout - optimizations' } CogAbstractInstruction >> if: cif hasArgType: arg0Type returnType: returnType do: aBlock [ @@ -1097,6 +1424,15 @@ CogAbstractInstruction >> if: cif hasArgType: arg0Type returnType: returnType do cif returnType type = returnType ] ]) ifTrue: [ aBlock value ] ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> if: cif returnType: returnType do: aBlock [ + + + + + (cif nargs = 0 and: [ cif returnType type = returnType ]) ifTrue: [ aBlock value ] +] + { #category : 'generate machine code' } CogAbstractInstruction >> inCurrentCompilation: operand [ "Answer if operand is in the current compilation; and henced could be a candidate for pc-relative addressing." @@ -1466,6 +1802,12 @@ CogAbstractInstruction >> outputMachineCodeAt: targetAddress [ objectMemory byteAt: targetAddress + j put: (machineCode at: j)] ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> prepareStackForFFICall [ + + +] + { #category : 'calling C function in Smalltalk stack' } CogAbstractInstruction >> prepareStackToCallCFunctionInSmalltalkStack: anObject [ diff --git a/smalltalksrc/VMMaker/CogIA32Compiler.class.st b/smalltalksrc/VMMaker/CogIA32Compiler.class.st index 143a5bcd0d..c8d1a279a3 100644 --- a/smalltalksrc/VMMaker/CogIA32Compiler.class.st +++ b/smalltalksrc/VMMaker/CogIA32Compiler.class.st @@ -3356,6 +3356,15 @@ CogIA32Compiler >> genMulR: regSource R: regDest [ ^cogit gen: IMULRR operand: regSource operand: regDest ] +{ #category : 'sameThread callout - optimizations' } +CogIA32Compiler >> genOptimizedSameThreadCalloutFor: cif flags: flags andFunctionAddress: externalFunctionAddress [ + + + + + ^ false +] + { #category : 'abstract instructions' } CogIA32Compiler >> genPopRd: reg [ diff --git a/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st b/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st index 23f496e2ff..d17f965de2 100644 --- a/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st +++ b/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st @@ -365,7 +365,8 @@ CogObjectRepresentationForSpur >> genActiveContextTrampolineLarge: isLarge inBlo ] { #category : 'primitive generators' } -CogObjectRepresentationForSpur >> genAllocExternalAddressValue: valueReg into: resultReg scratchReg: scratch1 scratchReg: scratch2 [ +CogObjectRepresentationForSpur >> genAllocExternalAddressValue: valueReg into: resultReg scratchReg: scratch1 [ + | allocSize newExternalAddressHeader jumpFail | allocSize := objectMemory baseHeaderSize + objectMemory wordSize. @@ -1269,7 +1270,7 @@ CogObjectRepresentationForSpur >> genPrimitiveGetAddressOfOOPPinningIfNeeded [ cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: ClassReg. - jumpFailAlloc := self genAllocExternalAddressValue: ClassReg into: ReceiverResultReg scratchReg: SendNumArgsReg scratchReg: TempReg. + jumpFailAlloc := self genAllocExternalAddressValue: ClassReg into: ReceiverResultReg scratchReg: SendNumArgsReg. cogit genPrimReturn. @@ -1651,9 +1652,11 @@ CogObjectRepresentationForSpur >> genPrimitiveLoadPointerFromBytes [ ^ self genPrimitiveLoad: BytesPerWord fromBytesWith: [ :sourcePointer | | jumpFailAlloc | cogit MoveMw: 0 r: sourcePointer R: ClassReg. - jumpFailAlloc := self genAllocExternalAddressValue: ClassReg into: SendNumArgsReg scratchReg: Extra0Reg scratchReg: TempReg. - cogit MoveR: SendNumArgsReg R: ReceiverResultReg. - cogit genPrimReturn. + jumpFailAlloc := self genAllocExternalAddressValue: ClassReg into: SendNumArgsReg scratchReg: Extra0Reg. + + cogit MoveR: SendNumArgsReg R: ReceiverResultReg. + cogit genPrimReturn. + cogit MoveR: SendNumArgsReg R: ReceiverResultReg. cogit genPrimReturn. jumpFailAlloc jmpTarget: cogit Label @@ -1665,9 +1668,10 @@ CogObjectRepresentationForSpur >> genPrimitiveLoadPointerFromExternalAddress [ ^ self genPrimitiveLoadFromExternalAddressWith: [ :sourcePointer | | jumpFailAlloc | cogit MoveMw: 0 r: sourcePointer R: ClassReg. - jumpFailAlloc := self genAllocExternalAddressValue: ClassReg into: SendNumArgsReg scratchReg: Extra0Reg scratchReg: TempReg. - cogit MoveR: SendNumArgsReg R: ReceiverResultReg. - cogit genPrimReturn. + jumpFailAlloc := self genAllocExternalAddressValue: ClassReg into: SendNumArgsReg scratchReg: Extra0Reg. + + cogit MoveR: SendNumArgsReg R: ReceiverResultReg. + cogit genPrimReturn. cogit MoveR: SendNumArgsReg R: ReceiverResultReg. cogit genPrimReturn. jumpFailAlloc jmpTarget: cogit Label diff --git a/smalltalksrc/VMMaker/CogX64Compiler.class.st b/smalltalksrc/VMMaker/CogX64Compiler.class.st index d2064a2940..777494c99c 100644 --- a/smalltalksrc/VMMaker/CogX64Compiler.class.st +++ b/smalltalksrc/VMMaker/CogX64Compiler.class.st @@ -356,6 +356,13 @@ CogX64Compiler >> availableRegisterOrNoneFor: liveRegsMask [ ^super availableRegisterOrNoneFor: liveRegsMask ] +{ #category : 'accessing' } +CogX64Compiler >> cArg0Register [ + + + ^ Arg0Reg +] + { #category : 'abi' } CogX64Compiler >> cFloatResultToRd: reg [ XMM0L ~= reg ifTrue: [ @@ -4472,6 +4479,13 @@ CogX64Compiler >> padIfPossibleWithStopsFrom: startAddr to: endAddr [ self stopsFrom: startAddr to: endAddr ] +{ #category : 'sameThread callout - optimizations' } +CogX64Compiler >> prepareStackForFFICall [ + + "WIN64 ABI allways reserve shadow space on the stack for callee to save up to 4 register parameters" + SysV ifFalse: [ cogit SubCq: 32 R: RSP ] +] + { #category : 'calling C function in Smalltalk stack' } CogX64Compiler >> prepareStackToCallCFunctionInSmalltalkStack: anInteger [ diff --git a/smalltalksrc/VMMaker/LibFFIConstants.class.st b/smalltalksrc/VMMaker/LibFFIConstants.class.st index befaf55238..1b49aab4f8 100644 --- a/smalltalksrc/VMMaker/LibFFIConstants.class.st +++ b/smalltalksrc/VMMaker/LibFFIConstants.class.st @@ -2,6 +2,9 @@ Class { #name : 'LibFFIConstants', #superclass : 'SharedPool', #classVars : [ + 'FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES', + 'FFI_FLAG_POINTERS_MIGHT_BE_OBJECTS', + 'FFI_FLAG_USE_OPTIMIZED_VERSION', 'FFI_TYPE_DOUBLE', 'FFI_TYPE_FLOAT', 'FFI_TYPE_INT', @@ -58,8 +61,11 @@ LibFFIConstants class >> initialize [ FFI_TYPE_STRUCT := 13. FFI_TYPE_POINTER := 14. - + FFI_FLAG_USE_OPTIMIZED_VERSION := 1 << 0. + FFI_FLAG_POINTERS_MIGHT_BE_OBJECTS := 1 << 1. + FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES := 1 << 2. + "Max ranges as defined in stdint.h" INT8_MAX := 2**( 8 - 1) - 1. INT8_MIN := (2**( 8 - 1)) negated. diff --git a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st index 32de4e9dec..4e99ba0f3c 100644 --- a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st +++ b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st @@ -13,7 +13,8 @@ Class { 'externalSetPrimOffsets', 'introspectionDataIndex', 'introspectionData', - 'ceSameThreadCalloutTrampoline' + 'ceSameThreadCalloutTrampoline', + 'ceFallbackInvalidFFICallTrampoline' ], #pools : [ 'VMClassIndices', @@ -281,6 +282,12 @@ SimpleStackBasedCogit >> ceCPICMissTrampoline: anAddress [ ceCPICMissTrampoline := anAddress ] +{ #category : 'accessing' } +SimpleStackBasedCogit >> ceFallbackInvalidFFICallTrampoline [ + + ^ ceFallbackInvalidFFICallTrampoline +] + { #category : 'accessing' } SimpleStackBasedCogit >> ceSameThreadCalloutTrampoline [ @@ -2836,7 +2843,13 @@ SimpleStackBasedCogit >> generateSameThreadCalloutTrampolines [ called: 'ceSameThreadCalloutTrampoline' arg: SendNumArgsReg - result: ReceiverResultReg + result: ReceiverResultReg. + + ceFallbackInvalidFFICallTrampoline := self + genTrampolineFor: + #ceFallbackInvalidFFICall + called: + 'ceFallbackInvalidFFICallTrampoline' ] { #category : 'initialization' } @@ -2865,6 +2878,12 @@ SimpleStackBasedCogit >> generateTracingTrampolines [ ceTraceStoreTrampoline := self simulatedTrampolineFor: #ceShortCutTraceStore:] ] +{ #category : 'accessing' } +SimpleStackBasedCogit >> getFallbackInvalidFFICallTrampoline [ + + ^ ceFallbackInvalidFFICallTrampoline +] + { #category : 'register management' } SimpleStackBasedCogit >> isCallerSavedReg: reg [ diff --git a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st index d6f82a7582..c49ec0d892 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -499,7 +499,7 @@ StackInterpreterPrimitives >> marshallPointerOrOop: externalAddressOrOop into: h externalAddressOrOop = objectMemory nilObject ifTrue: [ - pointerHolder at: 0 put: nil. + pointerHolder at: 0 put: 0. ^ self ]. (objectMemory isIntegerObject: externalAddressOrOop) diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index f9efed39bd..5fc59e425b 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -2443,22 +2443,24 @@ StackToRegisterMappingCogit >> genReturnTopFromMethod [ { #category : 'bytecode generators' } StackToRegisterMappingCogit >> genSameThreadCalloutBytecode [ - | literalIndex functionDefinition cif externalFunction | + | literalIndex functionDefinition cif externalFunction flags | literalIndex := byte1. functionDefinition := self getLiteral: literalIndex. externalFunction := coInterpreter getHandler: functionDefinition. externalFunction ifNil: [ ^ ShouldNotJIT ]. + flags := objectMemory fetchInteger: 2 ofObject: functionDefinition. cif := coInterpreter getHandlerAsCif: (objectMemory fetchPointer: 1 ofObject: functionDefinition). cif ifNil: [ ^ ShouldNotJIT ]. -" (backEnd + (backEnd genOptimizedSameThreadCalloutFor: cif + flags: flags andFunctionAddress: externalFunction) ifTrue: [ ^ 0 ]. -" + self ssFlushStack. self ssAllocateCallReg: SendNumArgsReg. @@ -2471,9 +2473,9 @@ StackToRegisterMappingCogit >> genSameThreadCalloutBytecode [ "The trampoline has already poped the values. We need to update the stack count, but not generate pops." self ssPop: cif numberArguments popSpilled: false. - cif returnType type = FFI_TYPE_VOID - ifFalse: [ self ssPushRegister: ReceiverResultReg]. - + cif returnType type = FFI_TYPE_VOID ifFalse: [ + self ssPushRegister: ReceiverResultReg ]. + ^ 0 ] diff --git a/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st b/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st index ee5577e653..547fe54f32 100644 --- a/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st +++ b/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st @@ -327,6 +327,18 @@ ProcessorSimulator >> doublePrecisionFloatingPointRegister2Value: aValue [ ^ self writeFloat64Register: self doublePrecisionFloatingPointRegister2 value: aValue ] +{ #category : 'accessing-registers-abstract' } +ProcessorSimulator >> doublePrecisionFloatingPointRegister3 [ + + self subclassResponsibility +] + +{ #category : 'accessing-registers-abstract' } +ProcessorSimulator >> doublePrecisionFloatingPointRegister3Value [ + + ^ self readFloat64Register: self doublePrecisionFloatingPointRegister3 +] + { #category : 'disassembling' } ProcessorSimulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction [ diff --git a/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st index 386b5360a0..8058fafc97 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st @@ -194,6 +194,12 @@ UnicornARMv5Simulator >> doublePrecisionFloatingPointRegister2 [ ^ UcARMRegisters d2 ] +{ #category : 'as yet unclassified' } +UnicornARMv5Simulator >> doublePrecisionFloatingPointRegister3 [ + + ^ UcARMRegisters d3 +] + { #category : 'as yet unclassified' } UnicornARMv5Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction [ diff --git a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st index 5c779a30cf..83c7491e4a 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st @@ -123,6 +123,12 @@ UnicornARMv8Simulator >> doublePrecisionFloatingPointRegister2 [ ^ UcARM64Registers d2 ] +{ #category : 'accessing-registers-abstract' } +UnicornARMv8Simulator >> doublePrecisionFloatingPointRegister3 [ + + ^ UcARM64Registers d3 +] + { #category : 'disassembling' } UnicornARMv8Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction [ @@ -492,10 +498,16 @@ UnicornARMv8Simulator >> x20 [ { #category : 'accessing-registers-physical' } UnicornARMv8Simulator >> x22 [ - + ^ self readRegister: UcARM64Registers x22 ] +{ #category : 'accessing-registers-physical' } +UnicornARMv8Simulator >> x22: anInteger [ + + self writeRegister: UcARM64Registers x22 value: anInteger +] + { #category : 'accessing-registers-physical' } UnicornARMv8Simulator >> x23 [ diff --git a/smalltalksrc/VMMakerTests/UnicornProcessor.class.st b/smalltalksrc/VMMakerTests/UnicornProcessor.class.st index 43e7716bc9..545765e291 100644 --- a/smalltalksrc/VMMakerTests/UnicornProcessor.class.st +++ b/smalltalksrc/VMMakerTests/UnicornProcessor.class.st @@ -401,6 +401,12 @@ UnicornProcessor >> x1: anInteger [ machineSimulator x1: anInteger ] +{ #category : 'as yet unclassified' } +UnicornProcessor >> x22: anInteger [ + + machineSimulator x22: anInteger +] + { #category : 'accessing' } UnicornProcessor >> x23: anInteger [ diff --git a/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st index 2895ec60c8..8b04d10251 100644 --- a/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st @@ -93,6 +93,12 @@ UnicornRISCVSimulator >> doublePrecisionFloatingPointRegister2 [ ^ UcRISCVRegisters f2 ] +{ #category : 'as yet unclassified' } +UnicornRISCVSimulator >> doublePrecisionFloatingPointRegister3 [ + + ^ UcRISCVRegisters f3 +] + { #category : 'machine registers' } UnicornRISCVSimulator >> f0 [ diff --git a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st index 4dfd2f5b9d..ff7f91dd24 100644 --- a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st @@ -94,6 +94,12 @@ UnicornX64Simulator >> doublePrecisionFloatingPointRegister2 [ ^ UcX86Registers xmm2 ] +{ #category : 'registers' } +UnicornX64Simulator >> doublePrecisionFloatingPointRegister3 [ + + ^ UcX86Registers xmm3 +] + { #category : 'as yet unclassified' } UnicornX64Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction [ diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st index 4520e2c6f3..4e2ac8b903 100644 --- a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -4,11 +4,26 @@ Class { #instVars : [ 'jitCompilerClass' ], + #pools : [ + 'LibFFIConstants' + ], #category : 'VMMakerTests-JitTests', #package : 'VMMakerTests', #tag : 'JitTests' } +{ #category : 'helpers' } +VMJitFFISameThreadCalloutTest >> assertIsNonOptimizedCall: aTFFunctionDefinition [ + + self deny: machineSimulator pc equals: (interpreter getHandler: aTFFunctionDefinition) +] + +{ #category : 'helpers' } +VMJitFFISameThreadCalloutTest >> assertIsOptimizedCall: aTFFunctionDefinition [ + + self assert: machineSimulator pc equals: (interpreter getHandler: aTFFunctionDefinition) +] + { #category : 'helpers' } VMJitFFISameThreadCalloutTest >> callCogMethod: callingMethod receiver: receiver arguments: args returnAddress: returnAddress [ @@ -42,6 +57,7 @@ VMJitFFISameThreadCalloutTest >> setUp [ interpreter libFFI: LibFFI new. interpreter libFFI interpreter: interpreter. + self installFloatClass. self createExternalAddressClass. @@ -73,7 +89,7 @@ VMJitFFISameThreadCalloutTest >> setUpTrampolines [ cogit generateSameThreadCalloutTrampolines ] -{ #category : 'tests' } +{ #category : 'tests - general bytecode' } VMJitFFISameThreadCalloutTest >> testExecutingFunctionCallsExternalFunction [ | compiledMethod cogMethod externalFunction tfExternalFunction called | @@ -81,7 +97,9 @@ VMJitFFISameThreadCalloutTest >> testExecutingFunctionCallsExternalFunction [ called := false. tfExternalFunction := self - createExternalFunctionFor: [ called := true ] + createExternalFunctionFor: [ + self assertIsNonOptimizedCall: tfExternalFunction. + called := true ] withArgumentTypes: {} withReturnType: interpreter libFFI void. @@ -112,7 +130,7 @@ VMJitFFISameThreadCalloutTest >> testExecutingFunctionCallsExternalFunction [ self assert: called ] -{ #category : 'tests' } +{ #category : 'tests - general bytecode' } VMJitFFISameThreadCalloutTest >> testExecutingFunctionChangesStack [ | compiledMethod cogMethod tfExternalFunction changedStack anExternalAddress | @@ -123,6 +141,7 @@ VMJitFFISameThreadCalloutTest >> testExecutingFunctionChangesStack [ void returning function " tfExternalFunction := self createExternalFunctionFor: [ + self assertIsNonOptimizedCall: tfExternalFunction. changedStack := (machineSimulator stackPointerRegisterValue bitAnd: 16rFFFFFF00) = (cogit getCStackPointer bitAnd: 16rFFFFFF00). 0 ] withArgumentTypes: { } @@ -155,7 +174,7 @@ VMJitFFISameThreadCalloutTest >> testExecutingFunctionChangesStack [ ] -{ #category : 'tests' } +{ #category : 'tests - general bytecode' } VMJitFFISameThreadCalloutTest >> testExecutingFunctionPopsCorrectlyAndReturnsTheResult [ | compiledMethod cogMethod externalFunction tfExternalFunction called | @@ -163,7 +182,9 @@ VMJitFFISameThreadCalloutTest >> testExecutingFunctionPopsCorrectlyAndReturnsThe called := false. tfExternalFunction := self - createExternalFunctionFor: [ :a :b | a + b ] + createExternalFunctionFor: [ :a :b | + self assertIsNonOptimizedCall: tfExternalFunction. + a + b ] withArgumentTypes: {interpreter libFFI sint64. interpreter libFFI sint64} withReturnType: interpreter libFFI sint64. @@ -198,7 +219,7 @@ VMJitFFISameThreadCalloutTest >> testExecutingFunctionPopsCorrectlyAndReturnsThe ] -{ #category : 'tests' } +{ #category : 'tests - general bytecode' } VMJitFFISameThreadCalloutTest >> testExecutingFunctionReturnsCorrectValue [ | compiledMethod cogMethod externalFunction tfExternalFunction called | @@ -206,7 +227,9 @@ VMJitFFISameThreadCalloutTest >> testExecutingFunctionReturnsCorrectValue [ called := false. tfExternalFunction := self - createExternalFunctionFor: [ 17 ] + createExternalFunctionFor: [ + self assertIsNonOptimizedCall: tfExternalFunction. + 17 ] withArgumentTypes: {} withReturnType: interpreter libFFI sint64. @@ -237,12 +260,12 @@ VMJitFFISameThreadCalloutTest >> testExecutingFunctionReturnsCorrectValue [ ] -{ #category : 'tests' } +{ #category : 'tests - general bytecode' } VMJitFFISameThreadCalloutTest >> testJITCompilesCallToTrampolineByDefault [ | compiledMethod cogMethod tfExternalFunction | tfExternalFunction := self - createExternalFunctionFor: [ ] + createExternalFunctionFor: [ self assertIsNonOptimizedCall: tfExternalFunction ] withArgumentTypes: { } withReturnType: interpreter libFFI void. @@ -273,21 +296,74 @@ VMJitFFISameThreadCalloutTest >> testJITCompilesCallToTrampolineByDefault [ equals: 0 ] -{ #category : 'tests' } -VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidChangesStack [ +{ #category : 'tests - double to void' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionDoubleToVoid [ - | compiledMethod cogMethod tfExternalFunction changedStack anExternalAddress | + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | - changedStack := false. + called := false. "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " tfExternalFunction := self createExternalFunctionFor: [:arg | - changedStack := (machineSimulator stackPointerRegisterValue bitAnd: 16rFFFFFF00) = (cogit getCStackPointer bitAnd: 16rFFFFFF00). + self assertIsNonOptimizedCall: tfExternalFunction. + called := true. + receivedArgument := arg. 0 ] - withArgumentTypes: { interpreter libFFI pointer } - withReturnType: interpreter libFFI void. + withArgumentTypes: { interpreter libFFI double } + withReturnType: interpreter libFFI void. + + aByteArray := self newByteArrayWithContent: #[1 2 3 4 0 0 0 0]. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: (memory floatObjectOf: 23.5); + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument equals: 23.5 +] + +{ #category : 'tests - pointer double double double double void' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerDoubleDoubleDoubleDoubleToVoid [ + + | compiledMethod cogMethod tfExternalFunction called receivedArgument1 receivedArgument2 receivedArgument3 anExternalAddress receivedArgument4 receivedArgument5 | + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:ptr :dbl1 :dbl2 :dbl3 :dbl4 | + self assertIsNonOptimizedCall: tfExternalFunction. + called := true. + receivedArgument1 := ptr. + receivedArgument2 := dbl1. + receivedArgument3 := dbl2. + receivedArgument4 := dbl3. + receivedArgument5 := dbl4. + 0 ] + withArgumentTypes: { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double } + withReturnType: interpreter libFFI void. anExternalAddress := self newExternalAddress: 17. @@ -295,9 +371,17 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidChangesStack newMethod; literalAt: 0 put: tfExternalFunction; literalAt: 1 put: anExternalAddress; - literalAt: 2 put: memory nilObject; "Class Binding" + literalAt: 2 put: (memory floatObjectOf: 23.5); + literalAt: 3 put: (memory floatObjectOf: 42.0); + literalAt: 4 put: (memory floatObjectOf: 99.5); + literalAt: 5 put: (memory floatObjectOf: 55.0); + literalAt: 6 put: memory nilObject; "Class Binding" bytecodes: #[ 33 "PushLiteral 1" + 34 "PushLiteral 2" + 35 "PushLiteral 3" + 36 "PushLiteral 4" + 37 "PushLiteral 5" 230 0 "SameThreadCallout Literal0" 88 "ReturnReceiver"]; buildMethod. @@ -312,26 +396,95 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidChangesStack arguments: { } returnAddress: callerAddress. - self assert: changedStack. + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument1 equals: 17. + self assert: receivedArgument2 equals: 23.5. + self assert: receivedArgument3 equals: 42.0. + self assert: receivedArgument4 equals: 99.5. + self assert: receivedArgument5 equals: 55.0. +] + +{ #category : 'tests - pointer double double double void' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerDoubleDoubleDoubleToVoid [ + + | compiledMethod cogMethod tfExternalFunction called receivedArgument1 receivedArgument2 receivedArgument3 anExternalAddress receivedArgument4 | + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:ptr :dbl1 :dbl2 :dbl3 | + self assertIsNonOptimizedCall: tfExternalFunction. + called := true. + receivedArgument1 := ptr. + receivedArgument2 := dbl1. + receivedArgument3 := dbl2. + receivedArgument4 := dbl3. + 0 ] + withArgumentTypes: { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double } + withReturnType: interpreter libFFI void. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: (memory floatObjectOf: 23.5); + literalAt: 3 put: (memory floatObjectOf: 42.0); + literalAt: 4 put: (memory floatObjectOf: 99.5); + literalAt: 5 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 34 "PushLiteral 2" + 35 "PushLiteral 3" + 36 "PushLiteral 4" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument1 equals: 17. + self assert: receivedArgument2 equals: 23.5. + self assert: receivedArgument3 equals: 42.0. + self assert: receivedArgument4 equals: 99.5. ] -{ #category : 'tests' } -VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithExternalAddressAsParameter [ +{ #category : 'tests - pointer double double to void' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerDoubleDoubleToVoid [ - | compiledMethod cogMethod tfExternalFunction called receivedArgument anExternalAddress | + | compiledMethod cogMethod tfExternalFunction called receivedArgument1 receivedArgument2 receivedArgument3 anExternalAddress | called := false. "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " tfExternalFunction := self - createExternalFunctionFor: [:arg | + createExternalFunctionFor: [:ptr :dbl1 :dbl2 | + self assertIsNonOptimizedCall: tfExternalFunction. called := true. - receivedArgument := arg. + receivedArgument1 := ptr. + receivedArgument2 := dbl1. + receivedArgument3 := dbl2. 0 ] - withArgumentTypes: { interpreter libFFI pointer } - withReturnType: interpreter libFFI void. + withArgumentTypes: { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double } + withReturnType: interpreter libFFI void. anExternalAddress := self newExternalAddress: 17. @@ -339,9 +492,13 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithExternalA newMethod; literalAt: 0 put: tfExternalFunction; literalAt: 1 put: anExternalAddress; - literalAt: 2 put: memory nilObject; "Class Binding" + literalAt: 2 put: (memory floatObjectOf: 23.5); + literalAt: 3 put: (memory floatObjectOf: 42.0); + literalAt: 4 put: memory nilObject; "Class Binding" bytecodes: #[ 33 "PushLiteral 1" + 34 "PushLiteral 2" + 35 "PushLiteral 3" 230 0 "SameThreadCallout Literal0" 88 "ReturnReceiver"]; buildMethod. @@ -359,11 +516,58 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithExternalA self assert: machineSimulator pc equals: callerAddress. self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). self assert: called. - self assert: receivedArgument equals: 17 + self assert: receivedArgument1 equals: 17. + self assert: receivedArgument2 equals: 23.5. + self assert: receivedArgument3 equals: 42.0. +] + +{ #category : 'tests - pointer to pointer' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerToPointer [ + + | compiledMethod cogMethod tfExternalFunction called anExternalAddress | + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ :e | + self assertIsNonOptimizedCall: tfExternalFunction. + called := true. e + 23 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI pointer. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 92 "ReturnTop"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: {} + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: (memory fetchClassTagOf: machineSimulator receiverRegisterValue) equals: memory classExternalAddressIndex. + self assert: (interpreter readAddress: machineSimulator receiverRegisterValue) equals: 17 + 23. + + self assert: called. + ] -{ #category : 'tests' } -VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithNilAsParameter [ +{ #category : 'tests - pointer to void (NonOpt)' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerToVoidWithNilAsParameter [ | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | @@ -373,11 +577,12 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithNilAsPara void returning function " tfExternalFunction := self createExternalFunctionFor: [:arg | + self assertIsNonOptimizedCall: tfExternalFunction. called := true. receivedArgument := arg. 0 ] withArgumentTypes: { interpreter libFFI pointer } - withReturnType: interpreter libFFI void. + withReturnType: interpreter libFFI void. aByteArray := self newByteArrayWithContent: #[1 2 3 4 0 0 0 0]. @@ -408,8 +613,8 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithNilAsPara self assert: receivedArgument equals: 0 ] -{ #category : 'tests' } -VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithOopAsParameter [ +{ #category : 'tests - pointer to void (NonOpt)' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerToVoidWithOopAsParameter [ | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | @@ -419,11 +624,12 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithOopAsPara void returning function " tfExternalFunction := self createExternalFunctionFor: [:arg | + self assertIsNonOptimizedCall: tfExternalFunction. called := true. receivedArgument := arg. 0 ] withArgumentTypes: { interpreter libFFI pointer } - withReturnType: interpreter libFFI void. + withReturnType: interpreter libFFI void. aByteArray := self newByteArrayWithContent: #[1 2 3 4 0 0 0 0]. @@ -454,10 +660,54 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithOopAsPara self assert: receivedArgument equals: aByteArray + BaseHeaderSize ] -{ #category : 'tests' } -VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithSmallIntegerAsParameter [ +{ #category : 'tests - void to pointer' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionVoidToPointer [ - | compiledMethod cogMethod tfExternalFunction called receivedArgument | + | compiledMethod cogMethod tfExternalFunction called | + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ + self assertIsNonOptimizedCall: tfExternalFunction. + called := true. + 16rCAFEBABE ] + withArgumentTypes: { } + withReturnType: interpreter libFFI pointer. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: memory nilObject; "Class Binding" + bytecodes: #[ + 230 0 "SameThreadCallout Literal0" + 92 "ReturnTop"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: {} + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: (memory fetchClassTagOf: machineSimulator receiverRegisterValue) equals: memory classExternalAddressIndex. + self assert: (interpreter readAddress: machineSimulator receiverRegisterValue) equals: 16rCafeBabe. + + self assert: called. + +] + +{ #category : 'tests - double to void' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionDoubleToVoid [ + + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + + isa = #IA32 ifTrue: [ ^ self skip ]. called := false. @@ -465,16 +715,20 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithSmallInte void returning function " tfExternalFunction := self createExternalFunctionFor: [:arg | + self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument := arg. + receivedArgument := machineSimulator doublePrecisionFloatingPointRegister0Value. 0 ] - withArgumentTypes: { interpreter libFFI pointer } - withReturnType: interpreter libFFI void. + withArgumentTypes: { interpreter libFFI double } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION. + + aByteArray := self newByteArrayWithContent: #[1 2 3 4 0 0 0 0]. compiledMethod := methodBuilder newMethod; literalAt: 0 put: tfExternalFunction; - literalAt: 1 put: (memory integerObjectOf: 17); + literalAt: 1 put: (memory floatObjectOf: 23.5); literalAt: 2 put: memory nilObject; "Class Binding" bytecodes: #[ 33 "PushLiteral 1" @@ -495,20 +749,595 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithSmallInte self assert: machineSimulator pc equals: callerAddress. self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). self assert: called. - self assert: receivedArgument equals: 17 + self assert: receivedArgument equals: 23.5 ] -{ #category : 'tests' } -VMJitFFISameThreadCalloutTest >> testPopingIntoTemporaryReturnValueWorkCorrectly [ +{ #category : 'tests - pointer double double double double void' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleDoubleToVoid [ - | compiledMethod cogMethod tfExternalFunction called anExternalAddress | + | compiledMethod cogMethod tfExternalFunction called receivedArgument1 receivedArgument2 receivedArgument3 anExternalAddress receivedArgument4 receivedArgument5 | + + isa = #IA32 ifTrue: [ ^ self skip ]. called := false. "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " tfExternalFunction := self - createExternalFunctionFor: [ called:= true. 32 ] + createExternalFunctionFor: [:ptr ":dbl1 :dbl2 :dbl3 :dbl4 Double Parameters are not handled by our simulation" | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArgument1 := ptr. + receivedArgument2 := machineSimulator doublePrecisionFloatingPointRegister0Value. + receivedArgument3 := machineSimulator doublePrecisionFloatingPointRegister1Value. + receivedArgument4 := machineSimulator doublePrecisionFloatingPointRegister2Value. + receivedArgument5 := machineSimulator doublePrecisionFloatingPointRegister3Value. + 0 ] + withArgumentTypes: { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: (memory floatObjectOf: 23.5); + literalAt: 3 put: (memory floatObjectOf: 42.0); + literalAt: 4 put: (memory floatObjectOf: 99.5); + literalAt: 5 put: (memory floatObjectOf: 55.0); + literalAt: 6 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 34 "PushLiteral 2" + 35 "PushLiteral 3" + 36 "PushLiteral 4" + 37 "PushLiteral 5" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument1 equals: 17. + self assert: receivedArgument2 equals: 23.5. + self assert: receivedArgument3 equals: 42.0. + self assert: receivedArgument4 equals: 99.5. + self assert: receivedArgument5 equals: 55.0. +] + +{ #category : 'tests - pointer double double double void' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleToVoid [ + + | compiledMethod cogMethod tfExternalFunction called receivedArgument1 receivedArgument2 receivedArgument3 anExternalAddress receivedArgument4 | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:ptr :dbl1 :dbl2 :dbl3 | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArgument1 := ptr. + receivedArgument2 := machineSimulator doublePrecisionFloatingPointRegister0Value. + receivedArgument3 := machineSimulator doublePrecisionFloatingPointRegister1Value. + receivedArgument4 := machineSimulator doublePrecisionFloatingPointRegister2Value. + 0 ] + withArgumentTypes: { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: (memory floatObjectOf: 23.5); + literalAt: 3 put: (memory floatObjectOf: 42.0); + literalAt: 4 put: (memory floatObjectOf: 99.5); + literalAt: 5 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 34 "PushLiteral 2" + 35 "PushLiteral 3" + 36 "PushLiteral 4" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument1 equals: 17. + self assert: receivedArgument2 equals: 23.5. + self assert: receivedArgument3 equals: 42.0. + self assert: receivedArgument4 equals: 99.5. + +] + +{ #category : 'tests - pointer double double to void' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleToVoid [ + + | compiledMethod cogMethod tfExternalFunction called receivedArgument1 receivedArgument2 receivedArgument3 anExternalAddress | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:ptr :dbl1 :dbl2 | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArgument1 := ptr. + receivedArgument2 := machineSimulator doublePrecisionFloatingPointRegister0Value. + receivedArgument3 := machineSimulator doublePrecisionFloatingPointRegister1Value. + 0 ] + withArgumentTypes: { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: (memory floatObjectOf: 23.5); + literalAt: 3 put: (memory floatObjectOf: 42.0); + literalAt: 4 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 34 "PushLiteral 2" + 35 "PushLiteral 3" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument1 equals: 17. + self assert: receivedArgument2 equals: 23.5. + self assert: receivedArgument3 equals: 42.0. +] + +{ #category : 'tests - pointer to pointer' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToPointer [ + + | compiledMethod cogMethod tfExternalFunction called anExternalAddress | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ :e | + self assertIsOptimizedCall: tfExternalFunction. + called := true. e + 23 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI pointer + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 92 "ReturnTop"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: {} + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: (memory fetchClassTagOf: machineSimulator receiverRegisterValue) equals: memory classExternalAddressIndex. + self assert: (interpreter readAddress: machineSimulator receiverRegisterValue) equals: 17 + 23. + + self assert: called. + +] + +{ #category : 'tests - pointer to void (Opt)' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidAllowinOopsWithOopAsParameter [ + + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArgument := arg. + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_OBJECTS. + + aByteArray := self newByteArrayWithContent: #[1 2 3 4 0 0 0 0]. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: aByteArray; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument equals: aByteArray + BaseHeaderSize +] + +{ #category : 'tests - pointer to void (Opt)' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidChangesStack [ + + | compiledMethod cogMethod tfExternalFunction changedStack anExternalAddress | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + changedStack := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + self assertIsOptimizedCall: tfExternalFunction. + changedStack := (machineSimulator stackPointerRegisterValue bitAnd: 16rFFFFFF00) = (cogit getCStackPointer bitAnd: 16rFFFFFF00). + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: changedStack. + +] + +{ #category : 'tests - pointer to void (Opt)' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithExternalAddressAsParameter [ + + | compiledMethod cogMethod tfExternalFunction called receivedArgument anExternalAddress | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArgument := arg. + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArgument equals: 17 +] + +{ #category : 'tests - pointer to void (Opt)' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithNilAsParameterShouldFail [ + + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArgument := arg. + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + aByteArray := self newByteArrayWithContent: #[1 2 3 4 0 0 0 0]. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: memory nilObject; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: cogit ceFallbackInvalidFFICallTrampoline. + + self assert: machineSimulator pc equals: cogit ceFallbackInvalidFFICallTrampoline. + self deny: called. + +] + +{ #category : 'tests - pointer to void (Opt)' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithOopAsParameterShouldFail [ + + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArgument := arg. + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + aByteArray := self newByteArrayWithContent: #[1 2 3 4 0 0 0 0]. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: aByteArray; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: cogit ceFallbackInvalidFFICallTrampoline. + + self assert: machineSimulator pc equals: cogit ceFallbackInvalidFFICallTrampoline. + self deny: called. + +] + +{ #category : 'tests - pointer to void (Opt)' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithSmallIntegerAsParameterShouldFail [ + + | compiledMethod cogMethod tfExternalFunction called receivedArgument | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArgument := arg. + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES | FFI_FLAG_POINTERS_MIGHT_BE_OBJECTS . + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: (memory integerObjectOf: 17); + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: cogit ceFallbackInvalidFFICallTrampoline. + + self assert: machineSimulator pc equals: cogit ceFallbackInvalidFFICallTrampoline. + self deny: called. + +] + +{ #category : 'tests - void to pointer' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionVoidToPointer [ + + | compiledMethod cogMethod tfExternalFunction called | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ + self assertIsOptimizedCall: tfExternalFunction. + called := true. + 16rCafeBabe ] + withArgumentTypes: { } + withReturnType: interpreter libFFI pointer + flags: FFI_FLAG_USE_OPTIMIZED_VERSION. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: memory nilObject; "Class Binding" + bytecodes: #[ + 230 0 "SameThreadCallout Literal0" + 92 "ReturnTop"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: {} + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: (memory fetchClassTagOf: machineSimulator receiverRegisterValue) equals: memory classExternalAddressIndex. + self assert: (interpreter readAddress: machineSimulator receiverRegisterValue) equals: 16rCafeBabe. + + self assert: called. + +] + +{ #category : 'tests - general bytecode' } +VMJitFFISameThreadCalloutTest >> testPopingIntoTemporaryReturnValueWorkCorrectly [ + + | compiledMethod cogMethod tfExternalFunction called anExternalAddress | + + called := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [ + self assertIsNonOptimizedCall: tfExternalFunction. + called:= true. 32 ] withArgumentTypes: { } withReturnType: interpreter libFFI sint64. diff --git a/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st b/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st index 46c71b39c4..67abdb21b4 100644 --- a/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st @@ -124,11 +124,21 @@ VMSpurMemoryManagerTest >> createExternalAddressClass [ { #category : 'helpers' } VMSpurMemoryManagerTest >> createExternalFunctionFor: aBlock withArgumentTypes: argumentTypes withReturnType: returnType [ + ^ self + createExternalFunctionFor: aBlock + withArgumentTypes: argumentTypes + withReturnType: returnType + flags: 0 +] + +{ #category : 'helpers' } +VMSpurMemoryManagerTest >> createExternalFunctionFor: aBlock withArgumentTypes: argumentTypes withReturnType: returnType flags: flags [ + | functionAddress tfExternalFunction functionExternalAddress tfFunctionDefinition cif cifExternalAddress | functionAddress := interpreter libFFI registerFunction: aBlock. - tfExternalFunction := self newObjectWithSlots: 2. + tfExternalFunction := self newObjectWithSlots: 3. functionExternalAddress := self newExternalAddress: functionAddress. tfFunctionDefinition := self newObjectWithSlots: 1. @@ -140,6 +150,8 @@ VMSpurMemoryManagerTest >> createExternalFunctionFor: aBlock withArgumentTypes: memory storePointer: 0 ofObject: tfExternalFunction withValue: functionExternalAddress. memory storePointer: 1 ofObject: tfExternalFunction withValue: tfFunctionDefinition. + memory storeInteger: 2 ofObject: tfExternalFunction withValue: flags. + memory storePointer: 0 ofObject: tfFunctionDefinition withValue: cifExternalAddress. ^ tfExternalFunction From ee88308497eca7e837bf4690f2f2ea5a4523ea95 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Mon, 3 Mar 2025 10:55:22 +0100 Subject: [PATCH 08/19] Adding required extensions to the InstructionClient so the StackDepthFinder works correctly for the tests --- .../VMMaker/InstructionClient.extension.st | 7 ++ .../VMMaker/InstructionStream.extension.st | 69 +++++++++++++++++++ 2 files changed, 76 insertions(+) create mode 100644 smalltalksrc/VMMaker/InstructionClient.extension.st create mode 100644 smalltalksrc/VMMaker/InstructionStream.extension.st diff --git a/smalltalksrc/VMMaker/InstructionClient.extension.st b/smalltalksrc/VMMaker/InstructionClient.extension.st new file mode 100644 index 0000000000..4126056228 --- /dev/null +++ b/smalltalksrc/VMMaker/InstructionClient.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'InstructionClient' } + +{ #category : '*VMMaker' } +InstructionClient >> sameThreadCallout: literalIndex [ + + +] diff --git a/smalltalksrc/VMMaker/InstructionStream.extension.st b/smalltalksrc/VMMaker/InstructionStream.extension.st new file mode 100644 index 0000000000..4a53b2e84e --- /dev/null +++ b/smalltalksrc/VMMaker/InstructionStream.extension.st @@ -0,0 +1,69 @@ +Extension { #name : 'InstructionStream' } + +{ #category : '*VMMaker' } +InstructionStream >> interpretNext2ByteSistaV1Instruction: bytecode for: client extA: extA extB: extB startPC: startPC [ + "Send to the argument, client, a message that specifies the next instruction. + This method handles the two-byte codes. + For a table of the bytecode set, see EncoderForV1's class comment." + + | byte method | + method := self compiledCode. + byte := self compiledCode at: pc. + pc := pc + 1. + client pc: pc. + "We do an inline quasi-binary search on bytecode" + bytecode < 234 ifTrue: "pushes" + [bytecode < 231 ifTrue: + [bytecode < 229 ifTrue: + [| literal | + bytecode = 226 ifTrue: + [^client pushReceiverVariable: (extA bitShift: 8) + byte]. + literal := method literalAt: (extA bitShift: 8) + byte + 1. + bytecode = 227 ifTrue: + [^client pushLiteralVariable: literal]. + ^client pushConstant: literal]. + bytecode = 229 ifTrue: + [^client pushTemporaryVariable: byte]. + ^client sameThreadCallout: byte]. + bytecode = 231 ifTrue: + [^byte < 128 + ifTrue: [client pushNewArrayOfSize: byte] + ifFalse: [client pushConsArrayWithElements: byte - 128]]. + bytecode = 232 ifTrue: + [^client pushConstant: (extB bitShift: 8) + byte]. + ^client pushConstant: (Character value: (extB bitShift: 8) + byte)]. + bytecode < 240 ifTrue: "sends, trap and jump" + [bytecode < 236 "sends" + ifTrue: [ + "The 64 is used as a mark to tell if the send is a direct super send" + extB >= 64 + ifTrue: [ | fixedExtB | + fixedExtB := extB - 64. + ^ client + directedSuperSend: (method literalAt: (extA bitShift: 5) + (byte // 8) + 1) + numArgs: (fixedExtB bitShift: 3) + (byte \\ 8)]. + ^client + send: (method literalAt: (extA bitShift: 5) + (byte // 8) + 1) + super: bytecode = 235 + numArgs: (extB bitShift: 3) + (byte \\ 8)]. + + bytecode = 236 ifTrue: + [^client mappedInlinePrimitive: byte]. + bytecode = 237 ifTrue: + [^client jump: (extB bitShift: 8) + byte withInterpreter: self]. + ^client jump: (extB bitShift: 8) + byte if: bytecode = 238 withInterpreter: self]. + bytecode < 243 ifTrue: + [bytecode = 240 ifTrue: + [^client popIntoReceiverVariable: (extA bitShift: 8) + byte]. + bytecode = 241 ifTrue: + [^client popIntoLiteralVariable: (method literalAt: (extA bitShift: 8) + byte + 1)]. + ^client popIntoTemporaryVariable: byte]. + bytecode = 243 ifTrue: + [^client storeIntoReceiverVariable: (extA bitShift: 8) + byte]. + bytecode = 244 ifTrue: + [^client storeIntoLiteralVariable: (method literalAt: (extA bitShift: 8) + byte + 1)]. + bytecode = 245 ifTrue: + [^client storeIntoTemporaryVariable: byte]. + "246-247 1111011 i xxxxxxxx UNASSIGNED" + ^self interpretUnusedBytecode: client at: startPC +] From a81e552821640d127a9fa62959bbe6ddd4e4e40d Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Tue, 18 Mar 2025 20:20:58 +0100 Subject: [PATCH 09/19] Improving tests to handle correctly the arguments in a FFI test --- smalltalksrc/VMMaker/LibFFIType.class.st | 18 ++++++++ .../UnicornARMv5Simulator.class.st | 23 ++++++++++ .../UnicornARMv8Simulator.class.st | 23 ++++++++++ .../VMMakerTests/UnicornSimulator.class.st | 14 +++++++ .../VMMakerTests/UnicornX64Simulator.class.st | 15 +++++++ .../VMJitFFISameThreadCalloutTest.class.st | 9 ++-- .../VMMakerTests/VMJittedLookupTest.class.st | 42 ------------------- 7 files changed, 98 insertions(+), 46 deletions(-) diff --git a/smalltalksrc/VMMaker/LibFFIType.class.st b/smalltalksrc/VMMaker/LibFFIType.class.st index 6a91074cc8..5dfc046c9e 100644 --- a/smalltalksrc/VMMaker/LibFFIType.class.st +++ b/smalltalksrc/VMMaker/LibFFIType.class.st @@ -120,6 +120,12 @@ LibFFIType >> fromSmalltalk: aNumber putInto: aCArrayAccessor [ } otherwise: [ self halt ] ] +{ #category : 'testing' } +LibFFIType >> isFloatType [ + + ^ type = FFI_TYPE_FLOAT or: [type = FFI_TYPE_DOUBLE] +] + { #category : 'accessing' } LibFFIType >> libFFI: aLibFFI [ libFFI := aLibFFI @@ -150,6 +156,18 @@ LibFFIType >> marshallToSmalltalk: holder [ ] +{ #category : 'simulating' } +LibFFIType >> marshallToSmalltalkFromByteArray: aByteArray [ + + ^ [ type ] + caseOf: { + [ FFI_TYPE_DOUBLE ] -> [ aByteArray float64AtOffset: 0 ]. + [ FFI_TYPE_POINTER ] -> [ self halt ]. + } + otherwise: [ self halt ] + +] + { #category : 'accessing' } LibFFIType >> size [ ^ size diff --git a/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st index 8058fafc97..13e8f88097 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st @@ -211,6 +211,29 @@ UnicornARMv5Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstructio ^ (aLLVMInstruction assemblyCodeString substrings: String tab, ',') second trimBoth. ] +{ #category : 'simulating' } +UnicornARMv5Simulator >> fetchArgumentsOfTypes: argumentTypes [ + + | byteArray doubleIndex integerIndex | + + doubleIndex := integerIndex := 0. + + ^ argumentTypes collect: [ :type | + doubleIndex = 5 ifTrue: [ self halt ]. + integerIndex = 5 ifTrue: [ self halt ]. + + byteArray := type isFloatType + ifTrue: [ + doubleIndex := doubleIndex + 1. + self doublePrecisionFloatingPointRegisterRaw: doubleIndex ] + ifFalse: [ + integerIndex := integerIndex + 1. + self cArgRegisterRaw: integerIndex ]. + + type marshallToSmalltalkFromByteArray: byteArray + ] +] + { #category : 'registers' } UnicornARMv5Simulator >> framePointerRegister [ diff --git a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st index 83c7491e4a..040068321b 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st @@ -140,6 +140,29 @@ UnicornARMv8Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstructio ^ (aLLVMInstruction assemblyCodeString substrings: String tab, ',') second trimBoth. ] +{ #category : 'simulating' } +UnicornARMv8Simulator >> fetchArgumentsOfTypes: argumentTypes [ + + | byteArray doubleIndex integerIndex | + + doubleIndex := integerIndex := 0. + + ^ argumentTypes collect: [ :type | + doubleIndex = 5 ifTrue: [ self halt ]. + integerIndex = 5 ifTrue: [ self halt ]. + + byteArray := type isFloatType + ifTrue: [ + doubleIndex := doubleIndex + 1. + self doublePrecisionFloatingPointRegisterRaw: doubleIndex ] + ifFalse: [ + integerIndex := integerIndex + 1. + self cArgRegisterRaw: integerIndex ]. + + type marshallToSmalltalkFromByteArray: byteArray + ] +] + { #category : 'accessing-registers-abstract' } UnicornARMv8Simulator >> framePointerRegister [ diff --git a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st index fc5d4a2eff..0cb90bbc90 100644 --- a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st @@ -73,6 +73,20 @@ UnicornSimulator >> doStartAt: startAddress until: until timeout: timeout count: ifTrue: [ ^ result ]] ] +{ #category : 'as yet unclassified' } +UnicornSimulator >> doublePrecisionFloatingPointRegisterRaw: anInteger [ + + | reg | + anInteger = 1 ifTrue: [ reg := self doublePrecisionFloatingPointRegister0 ]. + anInteger = 2 ifTrue: [ reg := self doublePrecisionFloatingPointRegister1 ]. + anInteger = 3 ifTrue: [ reg := self doublePrecisionFloatingPointRegister2 ]. + anInteger = 4 ifTrue: [ reg := self doublePrecisionFloatingPointRegister3 ]. + + reg ifNil: [ self error: 'I can handle up to 4 registers' ]. + + ^ self readRawRegister: reg size: 8 +] + { #category : 'stack-access' } UnicornSimulator >> finishMappingMemory [ diff --git a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st index ff7f91dd24..df1f2d09b2 100644 --- a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st @@ -110,6 +110,21 @@ UnicornX64Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction ^ registerName ] +{ #category : 'as yet unclassified' } +UnicornX64Simulator >> fetchArgumentsOfTypes: argumentTypes [ + + | byteArray | + + ^ argumentTypes withIndexCollect: [ :type :index | + index = 5 ifTrue: [ self halt ]. + byteArray := type isFloatType + ifTrue: [ self doublePrecisionFloatingPointRegisterRaw: index ] + ifFalse: [ self cArgRegisterRaw: index ]. + + type marshallToSmalltalkFromByteArray: byteArray + ] +] + { #category : 'virtual-registers' } UnicornX64Simulator >> framePointerRegister [ diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st index 4e2ac8b903..1d120350a3 100644 --- a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -705,11 +705,12 @@ VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionVoidToPointer [ { #category : 'tests - double to void' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionDoubleToVoid [ - | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArguments argumentTypes | isa = #IA32 ifTrue: [ ^ self skip ]. called := false. + argumentTypes := { interpreter libFFI double }. "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " @@ -717,9 +718,9 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionDoubleToVoid [ createExternalFunctionFor: [:arg | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument := machineSimulator doublePrecisionFloatingPointRegister0Value. + receivedArguments := machineSimulator fetchArgumentsOfTypes: argumentTypes. 0 ] - withArgumentTypes: { interpreter libFFI double } + withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void flags: FFI_FLAG_USE_OPTIMIZED_VERSION. @@ -749,7 +750,7 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionDoubleToVoid [ self assert: machineSimulator pc equals: callerAddress. self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). self assert: called. - self assert: receivedArgument equals: 23.5 + self assert: receivedArguments first equals: 23.5 ] { #category : 'tests - pointer double double double double void' } diff --git a/smalltalksrc/VMMakerTests/VMJittedLookupTest.class.st b/smalltalksrc/VMMakerTests/VMJittedLookupTest.class.st index c78d8ff140..31ebfb0112 100644 --- a/smalltalksrc/VMMakerTests/VMJittedLookupTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJittedLookupTest.class.st @@ -12,21 +12,6 @@ Class { #tag : 'JitTests' } -{ #category : 'tests' } -VMJittedLookupTest >> installSelector: aSelectorOop method: aMethodOop inMethodDictionary: aMethodDictionary [ - - | anArrayOfMethods | - anArrayOfMethods := memory fetchPointer: MethodArrayIndex ofObject: aMethodDictionary. - memory - storePointer: (memory methodDictionaryHash: aSelectorOop mask: 11) + 2 - ofObject: aMethodDictionary - withValue: aSelectorOop. - memory - storePointer: (memory methodDictionaryHash: aSelectorOop mask: 11) - ofObject: anArrayOfMethods - withValue: aMethodOop -] - { #category : 'tests' } VMJittedLookupTest >> setArrayClassIntoClassTable [ | aClass | @@ -65,33 +50,6 @@ VMJittedLookupTest >> setUpClassAndMethod [ receiverClass := self setSmallIntegerClassIntoClassTable ] -{ #category : 'tests' } -VMJittedLookupTest >> setUpMethodDictionaryIn: aClass [ - "2 instances variables the array of methods and the tally - and 12 entries to put elemetns of the collection" - - | aMethodDictionary anArrayOfMethods | - aMethodDictionary := self - newObjectWithSlots: 2 + 12 - format: MethodDictionary instSpec - classIndex: memory arrayClassIndexPun. - anArrayOfMethods := self - newObjectWithSlots: 12 - format: Array instSpec - classIndex: memory arrayClassIndexPun. - memory - storePointer: MethodDictionaryIndex - ofObject: aClass - withValue: aMethodDictionary. - memory - storePointer: MethodArrayIndex - ofObject: aMethodDictionary - withValue: anArrayOfMethods. - - - -] - { #category : 'tests' } VMJittedLookupTest >> testLookUpMNUShouldJItCompile [ From 9212a6622d3835b42e9cb44b7d87a2bb482b7775 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Tue, 18 Mar 2025 20:38:04 +0100 Subject: [PATCH 10/19] Handling arguments for X64 SystemV --- smalltalksrc/VMMaker/LibFFIType.class.st | 2 +- .../VMMakerTests/UnicornSimulator.class.st | 15 +++++++++++++ .../VMMakerTests/UnicornX64Simulator.class.st | 13 ++++++----- .../VMJitFFISameThreadCalloutTest.class.st | 22 +++++++++---------- 4 files changed, 34 insertions(+), 18 deletions(-) diff --git a/smalltalksrc/VMMaker/LibFFIType.class.st b/smalltalksrc/VMMaker/LibFFIType.class.st index 5dfc046c9e..5c2ee791e6 100644 --- a/smalltalksrc/VMMaker/LibFFIType.class.st +++ b/smalltalksrc/VMMaker/LibFFIType.class.st @@ -162,7 +162,7 @@ LibFFIType >> marshallToSmalltalkFromByteArray: aByteArray [ ^ [ type ] caseOf: { [ FFI_TYPE_DOUBLE ] -> [ aByteArray float64AtOffset: 0 ]. - [ FFI_TYPE_POINTER ] -> [ self halt ]. + [ FFI_TYPE_POINTER ] -> [ aByteArray integerAt: 1 size: size signed: false ]. } otherwise: [ self halt ] diff --git a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st index 0cb90bbc90..d2926a75f8 100644 --- a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st @@ -16,6 +16,21 @@ UnicornSimulator class >> supportsISA: isa [ ^ #( #ARMv5 #ARMv8 #IA32 #X64 #aarch64 #riscv64 ) includes: isa ] +{ #category : 'accessing' } +UnicornSimulator >> cArgRegisterRaw: anInteger [ + + | reg | + + anInteger = 1 ifTrue: [ reg := self carg0Register ]. + anInteger = 2 ifTrue: [ reg := self carg1Register ]. + anInteger = 3 ifTrue: [ reg := self carg2Register ]. + anInteger = 4 ifTrue: [ reg := self carg3Register ]. + + reg ifNil: [ self error: 'I can handle up to 4 registers' ]. + + ^ self readRawRegister: reg size: self wordSize +] + { #category : 'initialization' } UnicornSimulator >> createUnicorn [ diff --git a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st index df1f2d09b2..4c1f8901e2 100644 --- a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st @@ -116,11 +116,14 @@ UnicornX64Simulator >> fetchArgumentsOfTypes: argumentTypes [ | byteArray | ^ argumentTypes withIndexCollect: [ :type :index | - index = 5 ifTrue: [ self halt ]. - byteArray := type isFloatType - ifTrue: [ self doublePrecisionFloatingPointRegisterRaw: index ] - ifFalse: [ self cArgRegisterRaw: index ]. - + index <= 4 ifTrue: [ + byteArray := type isFloatType + ifTrue: [ self doublePrecisionFloatingPointRegisterRaw: index ] + ifFalse: [ self cArgRegisterRaw: index ]] + ifFalse: [ + index = 6 ifTrue: [ self halt ]. + byteArray := self stackValueBytesAt: 0. + ]. type marshallToSmalltalkFromByteArray: byteArray ] ] diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st index 1d120350a3..1ce2dacf89 100644 --- a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -756,25 +756,23 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionDoubleToVoid [ { #category : 'tests - pointer double double double double void' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleDoubleToVoid [ - | compiledMethod cogMethod tfExternalFunction called receivedArgument1 receivedArgument2 receivedArgument3 anExternalAddress receivedArgument4 receivedArgument5 | + | compiledMethod cogMethod tfExternalFunction called receivedArguments argumentTypes anExternalAddress | isa = #IA32 ifTrue: [ ^ self skip ]. called := false. + argumentTypes := { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double }. + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " tfExternalFunction := self createExternalFunctionFor: [:ptr ":dbl1 :dbl2 :dbl3 :dbl4 Double Parameters are not handled by our simulation" | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument1 := ptr. - receivedArgument2 := machineSimulator doublePrecisionFloatingPointRegister0Value. - receivedArgument3 := machineSimulator doublePrecisionFloatingPointRegister1Value. - receivedArgument4 := machineSimulator doublePrecisionFloatingPointRegister2Value. - receivedArgument5 := machineSimulator doublePrecisionFloatingPointRegister3Value. + receivedArguments := machineSimulator fetchArgumentsOfTypes: argumentTypes. 0 ] - withArgumentTypes: { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double } + withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. @@ -813,11 +811,11 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleD self assert: machineSimulator pc equals: callerAddress. self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). self assert: called. - self assert: receivedArgument1 equals: 17. - self assert: receivedArgument2 equals: 23.5. - self assert: receivedArgument3 equals: 42.0. - self assert: receivedArgument4 equals: 99.5. - self assert: receivedArgument5 equals: 55.0. + self assert: receivedArguments first equals: 17. + self assert: receivedArguments second equals: 23.5. + self assert: receivedArguments third equals: 42.0. + self assert: receivedArguments fourth equals: 99.5. + self assert: receivedArguments fifth equals: 55.0. ] { #category : 'tests - pointer double double double void' } From e405146f73b87c3c2542a8bec8bb0b144800cbcc Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 20 Mar 2025 10:11:56 +0100 Subject: [PATCH 11/19] Implementing the fetch of arguments in the superclass --- .../UnicornARMv5Simulator.class.st | 23 ------------------- .../UnicornARMv8Simulator.class.st | 23 ------------------- .../VMMakerTests/UnicornSimulator.class.st | 23 +++++++++++++++++++ .../VMMakerTests/UnicornX64Simulator.class.st | 8 ++++--- 4 files changed, 28 insertions(+), 49 deletions(-) diff --git a/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st index 13e8f88097..8058fafc97 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st @@ -211,29 +211,6 @@ UnicornARMv5Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstructio ^ (aLLVMInstruction assemblyCodeString substrings: String tab, ',') second trimBoth. ] -{ #category : 'simulating' } -UnicornARMv5Simulator >> fetchArgumentsOfTypes: argumentTypes [ - - | byteArray doubleIndex integerIndex | - - doubleIndex := integerIndex := 0. - - ^ argumentTypes collect: [ :type | - doubleIndex = 5 ifTrue: [ self halt ]. - integerIndex = 5 ifTrue: [ self halt ]. - - byteArray := type isFloatType - ifTrue: [ - doubleIndex := doubleIndex + 1. - self doublePrecisionFloatingPointRegisterRaw: doubleIndex ] - ifFalse: [ - integerIndex := integerIndex + 1. - self cArgRegisterRaw: integerIndex ]. - - type marshallToSmalltalkFromByteArray: byteArray - ] -] - { #category : 'registers' } UnicornARMv5Simulator >> framePointerRegister [ diff --git a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st index 040068321b..83c7491e4a 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st @@ -140,29 +140,6 @@ UnicornARMv8Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstructio ^ (aLLVMInstruction assemblyCodeString substrings: String tab, ',') second trimBoth. ] -{ #category : 'simulating' } -UnicornARMv8Simulator >> fetchArgumentsOfTypes: argumentTypes [ - - | byteArray doubleIndex integerIndex | - - doubleIndex := integerIndex := 0. - - ^ argumentTypes collect: [ :type | - doubleIndex = 5 ifTrue: [ self halt ]. - integerIndex = 5 ifTrue: [ self halt ]. - - byteArray := type isFloatType - ifTrue: [ - doubleIndex := doubleIndex + 1. - self doublePrecisionFloatingPointRegisterRaw: doubleIndex ] - ifFalse: [ - integerIndex := integerIndex + 1. - self cArgRegisterRaw: integerIndex ]. - - type marshallToSmalltalkFromByteArray: byteArray - ] -] - { #category : 'accessing-registers-abstract' } UnicornARMv8Simulator >> framePointerRegister [ diff --git a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st index d2926a75f8..2f383ec2e8 100644 --- a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st @@ -102,6 +102,29 @@ UnicornSimulator >> doublePrecisionFloatingPointRegisterRaw: anInteger [ ^ self readRawRegister: reg size: 8 ] +{ #category : 'simulating' } +UnicornSimulator >> fetchArgumentsOfTypes: argumentTypes [ + + | byteArray doubleIndex integerIndex | + + doubleIndex := integerIndex := 0. + + ^ argumentTypes collect: [ :type | + doubleIndex = 5 ifTrue: [ self halt ]. + integerIndex = 5 ifTrue: [ self halt ]. + + byteArray := type isFloatType + ifTrue: [ + doubleIndex := doubleIndex + 1. + self doublePrecisionFloatingPointRegisterRaw: doubleIndex ] + ifFalse: [ + integerIndex := integerIndex + 1. + self cArgRegisterRaw: integerIndex ]. + + type marshallToSmalltalkFromByteArray: byteArray + ] +] + { #category : 'stack-access' } UnicornSimulator >> finishMappingMemory [ diff --git a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st index 4c1f8901e2..42d242bfae 100644 --- a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st @@ -111,11 +111,13 @@ UnicornX64Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction ] { #category : 'as yet unclassified' } -UnicornX64Simulator >> fetchArgumentsOfTypes: argumentTypes [ +UnicornX64Simulator >> fetchArgumentsOfTypes: argumentTypes [ | byteArray | - ^ argumentTypes withIndexCollect: [ :type :index | + ^ super fetchArgumentsOfTypes: argumentTypes + +" ^ argumentTypes withIndexCollect: [ :type :index | index <= 4 ifTrue: [ byteArray := type isFloatType ifTrue: [ self doublePrecisionFloatingPointRegisterRaw: index ] @@ -125,7 +127,7 @@ UnicornX64Simulator >> fetchArgumentsOfTypes: argumentTypes [ byteArray := self stackValueBytesAt: 0. ]. type marshallToSmalltalkFromByteArray: byteArray - ] + ]" ] { #category : 'virtual-registers' } From 42edeeeace4f597ad1ea7a1cfc877521ac0aa2a7 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 20 Mar 2025 14:50:23 +0100 Subject: [PATCH 12/19] Fixing accessing to floating point registers --- smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st | 6 +++--- smalltalksrc/VMMakerTests/UnicornSimulator.class.st | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st index 83c7491e4a..4af9df6980 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st @@ -320,19 +320,19 @@ UnicornARMv8Simulator >> temporaryRegister [ { #category : 'accessing-registers-physical' } UnicornARMv8Simulator >> v0 [ - ^ self readRawRegister: UcARM64Registers v0 size: 16 + ^ self readRawRegister: UcARM64Registers v0 size: 32 ] { #category : 'accessing-registers-physical' } UnicornARMv8Simulator >> v1 [ - ^ self readRawRegister: UcARM64Registers v1 size: 16 + ^ self readRawRegister: UcARM64Registers v1 size: 32 ] { #category : 'accessing-registers-physical' } UnicornARMv8Simulator >> v2 [ - ^ self readRawRegister: UcARM64Registers v2 size: 16 + ^ self readRawRegister: UcARM64Registers v2 size: 32 ] { #category : 'accessing-registers-abstract' } diff --git a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st index 2f383ec2e8..ef978f98f1 100644 --- a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st @@ -99,7 +99,7 @@ UnicornSimulator >> doublePrecisionFloatingPointRegisterRaw: anInteger [ reg ifNil: [ self error: 'I can handle up to 4 registers' ]. - ^ self readRawRegister: reg size: 8 + ^ self readRawRegister: reg size: 32 ] { #category : 'simulating' } From d397a363c5bf1663bacf55d4b140b1ec6b032c49 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 20 Mar 2025 17:47:54 +0100 Subject: [PATCH 13/19] Extending the unicorn simulator to handle the different ABIs of X64 --- .../VMMaker/CogAbstractInstruction.class.st | 6 ++ smalltalksrc/VMMaker/Cogit.class.st | 4 +- .../VMMakerTests/ProcessorSimulator.class.st | 49 +++----------- .../UnicornARMv5Simulator.class.st | 6 ++ .../UnicornARMv8Simulator.class.st | 6 ++ .../UnicornI386Simulator.class.st | 6 ++ .../VMMakerTests/UnicornProcessor.class.st | 6 +- .../UnicornRISCVSimulator.class.st | 6 ++ .../VMMakerTests/UnicornSimulator.class.st | 6 -- .../UnicornWinX64Simulator.class.st | 67 +++++++++++++++++++ .../VMMakerTests/UnicornX64Simulator.class.st | 28 ++------ .../VMJitFFISameThreadCalloutTest.class.st | 32 ++++++++- 12 files changed, 153 insertions(+), 69 deletions(-) create mode 100644 smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st diff --git a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st index d7a3754ab0..b5d75abb3d 100644 --- a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st +++ b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st @@ -74,6 +74,12 @@ Class { #tag : 'JIT' } +{ #category : 'accessing' } +CogAbstractInstruction class >> ABI [ + + ^ self initializationOptions at: #ABI ifAbsent: [ #default ] +] + { #category : 'translation' } CogAbstractInstruction class >> ISA [ "Answer the name of the ISA the receiver's subclass implements." diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index 894755e581..fa293ea3bc 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -8139,12 +8139,14 @@ Cogit >> handleCallOrJumpSimulationTrap: aProcessorSimulationTrap [ (function beginsWith: 'ceShort') ifTrue: [^self perform: function with: aProcessorSimulationTrap]. + memory := coInterpreter objectMemory. + aProcessorSimulationTrap type == #call ifTrue: [processor simulateCallOf: aProcessorSimulationTrap address nextpc: aProcessorSimulationTrap nextpc - memory: (memory := coInterpreter memory). + memory: memory. self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}] ifFalse: [processor diff --git a/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st b/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st index 547fe54f32..e359abaf5a 100644 --- a/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st +++ b/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st @@ -12,48 +12,19 @@ Class { #tag : 'Unicorn' } -{ #category : 'instance creation' } -ProcessorSimulator class >> ARMv5 [ +{ #category : 'as yet unclassified' } +ProcessorSimulator class >> simulatorForISA: isa andABI: abi [ - ^ UnicornARMv5Simulator new + ^ self allSubclasses + detect: [ :e | e supportISA: isa andAbi: abi ] + ifFound: [ :aSubclass | aSubclass new ] + ifNone: [ self error: ('Could not found simulator for ISA {1} and ABI {2}' format: { isa. abi }) ] ] -{ #category : 'instance creation' } -ProcessorSimulator class >> ARMv8 [ - - ^ UnicornARMv8Simulator new -] - -{ #category : 'instance creation' } -ProcessorSimulator class >> IA32 [ - - ^ UnicornI386Simulator new -] - -{ #category : 'instance creation' } -ProcessorSimulator class >> X64 [ - - ^ UnicornX64Simulator new -] - -{ #category : 'instance creation' } -ProcessorSimulator class >> aarch64 [ - - ^ UnicornARMv8Simulator new -] - -{ #category : 'instance creation' } -ProcessorSimulator class >> riscv64 [ - - "TODO: Add riscv32 and possibly two subclasses for the RISCV simulator" - ^ UnicornRISCVSimulator new - "^ SpikeRISCVSimulator new" -] - -{ #category : 'instance creation' } -ProcessorSimulator class >> simulatorFor: isa [ - - ^ (self subclasses detect: [ :each | each supportsISA: isa ]) perform: isa asSymbol +{ #category : 'as yet unclassified' } +ProcessorSimulator class >> supportISA: isa andAbi: abi [ + + ^ false ] { #category : 'accessing' } diff --git a/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st index 8058fafc97..eaeb1eb520 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv5Simulator.class.st @@ -6,6 +6,12 @@ Class { #tag : 'Unicorn' } +{ #category : 'as yet unclassified' } +UnicornARMv5Simulator class >> supportISA: isa andAbi: abi [ + + ^ isa = #ARMv5 +] + { #category : 'registers' } UnicornARMv5Simulator >> arg0Register [ diff --git a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st index 4af9df6980..01cd6680db 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st @@ -6,6 +6,12 @@ Class { #tag : 'Unicorn' } +{ #category : 'as yet unclassified' } +UnicornARMv8Simulator class >> supportISA: isa andAbi: abi [ + + ^ isa = #aarch64 +] + { #category : 'accessing-registers-abstract' } UnicornARMv8Simulator >> arg0Register [ diff --git a/smalltalksrc/VMMakerTests/UnicornI386Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornI386Simulator.class.st index 539e97b80e..7b58fe309e 100644 --- a/smalltalksrc/VMMakerTests/UnicornI386Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornI386Simulator.class.st @@ -6,6 +6,12 @@ Class { #tag : 'Unicorn' } +{ #category : 'as yet unclassified' } +UnicornI386Simulator class >> supportISA: isa andAbi: abi [ + + ^ isa = #IA32 +] + { #category : 'registers' } UnicornI386Simulator >> arg0Register [ diff --git a/smalltalksrc/VMMakerTests/UnicornProcessor.class.st b/smalltalksrc/VMMakerTests/UnicornProcessor.class.st index 545765e291..265228b1f9 100644 --- a/smalltalksrc/VMMakerTests/UnicornProcessor.class.st +++ b/smalltalksrc/VMMakerTests/UnicornProcessor.class.st @@ -104,7 +104,11 @@ UnicornProcessor >> hasLinkRegister [ UnicornProcessor >> initializeStackFor: aCompiler [ "Initialize the machine code simulator" - machineSimulator := UnicornSimulator perform: aCompiler backend class ISA asSymbol. + | isa abi | + isa := aCompiler backend class ISA asSymbol. + abi := aCompiler backend class ABI. + + machineSimulator := ProcessorSimulator simulatorForISA: isa andABI: abi. machineSimulator memory: aCompiler objectMemory. machineSimulator mapMemoryInManager: aCompiler objectMemory memoryManager. diff --git a/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st index 8b04d10251..53057f6fdb 100644 --- a/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st @@ -6,6 +6,12 @@ Class { #tag : 'Unicorn' } +{ #category : 'as yet unclassified' } +UnicornRISCVSimulator class >> supportISA: isa andAbi: abi [ + + ^ isa = #riscv64 +] + { #category : 'registers' } UnicornRISCVSimulator >> arg0Register [ diff --git a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st index ef978f98f1..bffac620fc 100644 --- a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st @@ -10,12 +10,6 @@ Class { #tag : 'Unicorn' } -{ #category : 'instance creation' } -UnicornSimulator class >> supportsISA: isa [ - - ^ #( #ARMv5 #ARMv8 #IA32 #X64 #aarch64 #riscv64 ) includes: isa -] - { #category : 'accessing' } UnicornSimulator >> cArgRegisterRaw: anInteger [ diff --git a/smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st new file mode 100644 index 0000000000..36ca1be8ab --- /dev/null +++ b/smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st @@ -0,0 +1,67 @@ +Class { + #name : 'UnicornWinX64Simulator', + #superclass : 'UnicornX64Simulator', + #category : 'VMMakerTests-Unicorn', + #package : 'VMMakerTests', + #tag : 'Unicorn' +} + +{ #category : 'as yet unclassified' } +UnicornWinX64Simulator class >> supportISA: isa andAbi: abi [ + + ^ isa = #X64 and: [ abi = #'_WIN64' ] +] + +{ #category : 'registers' } +UnicornWinX64Simulator >> carg0Register [ + + ^ UcX86Registers rcx +] + +{ #category : 'registers' } +UnicornWinX64Simulator >> carg1Register [ + + ^ UcX86Registers rdx +] + +{ #category : 'registers' } +UnicornWinX64Simulator >> carg2Register [ + + ^ UcX86Registers r8 +] + +{ #category : 'registers' } +UnicornWinX64Simulator >> carg3Register [ + + ^ UcX86Registers r9 +] + +{ #category : 'as yet unclassified' } +UnicornWinX64Simulator >> fetchArgumentsOfTypes: argumentTypes [ + + | byteArray | + + ^ argumentTypes withIndexCollect: [ :type :index | + index <= 4 ifTrue: [ + byteArray := type isFloatType + ifTrue: [ self doublePrecisionFloatingPointRegisterRaw: index ] + ifFalse: [ self cArgRegisterRaw: index ]] + ifFalse: [ + index = 6 ifTrue: [ self halt ]. + byteArray := self stackValueBytesAt: 0. + ]. + type marshallToSmalltalkFromByteArray: byteArray + ] +] + +{ #category : 'virtual-registers' } +UnicornWinX64Simulator >> receiverRegister [ + + ^ UcX86Registers r9 +] + +{ #category : 'virtual-registers' } +UnicornWinX64Simulator >> sendNumberOfArgumentsRegister [ + + ^ UcX86Registers r10 +] diff --git a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st index 42d242bfae..430223bdee 100644 --- a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st @@ -6,6 +6,12 @@ Class { #tag : 'Unicorn' } +{ #category : 'as yet unclassified' } +UnicornX64Simulator class >> supportISA: isa andAbi: abi [ + + ^ isa = #X64 and: [ abi = #default or: [ abi = #SysV ] ] +] + { #category : 'registers' } UnicornX64Simulator >> arg0Register [ @@ -110,26 +116,6 @@ UnicornX64Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction ^ registerName ] -{ #category : 'as yet unclassified' } -UnicornX64Simulator >> fetchArgumentsOfTypes: argumentTypes [ - - | byteArray | - - ^ super fetchArgumentsOfTypes: argumentTypes - -" ^ argumentTypes withIndexCollect: [ :type :index | - index <= 4 ifTrue: [ - byteArray := type isFloatType - ifTrue: [ self doublePrecisionFloatingPointRegisterRaw: index ] - ifFalse: [ self cArgRegisterRaw: index ]] - ifFalse: [ - index = 6 ifTrue: [ self halt ]. - byteArray := self stackValueBytesAt: 0. - ]. - type marshallToSmalltalkFromByteArray: byteArray - ]" -] - { #category : 'virtual-registers' } UnicornX64Simulator >> framePointerRegister [ @@ -490,7 +476,7 @@ UnicornX64Simulator >> smashCallerSavedRegistersWithValuesFrom: base by: step in #(rcx rdx r8 r9) withIndexDo: [:getter :index| aMemory - unsignedLong64At: self rbp + 9 + (index * 8) "skip saved fp and retpc; aMemory is 1-relative" + unsignedLong64At: self rbp + 8 + (index * 8) "skip saved fp and retpc" put: (self perform: getter)]]. volatileRegisters withIndexDo: [:setter :index| diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st index 1ce2dacf89..c98de1d1b9 100644 --- a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -2,7 +2,8 @@ Class { #name : 'VMJitFFISameThreadCalloutTest', #superclass : 'VMStackToRegisterMappingCogitTest', #instVars : [ - 'jitCompilerClass' + 'jitCompilerClass', + 'abi' ], #pools : [ 'LibFFIConstants' @@ -12,6 +13,22 @@ Class { #tag : 'JitTests' } +{ #category : 'building suites' } +VMJitFFISameThreadCalloutTest class >> wordSize64Parameters [ + + ^ ParametrizedTestMatrix new + addCase: { #ISA -> #'aarch64'. #wordSize -> 8}; + addCase: { #ISA -> #'X64'. #wordSize -> 8. #ABI -> #'_WIN64' }; + addCase: { #ISA -> #'X64'. #wordSize -> 8. #ABI -> #SysV }; + yourself +] + +{ #category : 'as yet unclassified' } +VMJitFFISameThreadCalloutTest >> ABI: anAbi [ + + abi := anAbi +] + { #category : 'helpers' } VMJitFFISameThreadCalloutTest >> assertIsNonOptimizedCall: aTFFunctionDefinition [ @@ -45,6 +62,19 @@ VMJitFFISameThreadCalloutTest >> jitCompilerClass: aValue [ jitCompilerClass := aValue ] +{ #category : 'running' } +VMJitFFISameThreadCalloutTest >> jitOptions [ + + | options | + + options := super jitOptions. + + ^ abi + ifNotNil: [ options at: #ABI put: abi; yourself ] + ifNil: [ options ] + +] + { #category : 'running' } VMJitFFISameThreadCalloutTest >> setUp [ From c12852d8ceb7c79b9bd5080538154387dfb5e449 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Fri, 21 Mar 2025 11:41:09 +0100 Subject: [PATCH 14/19] - Making it work in Windows ABI - Adding tests --- .../VMMaker/CogAbstractInstruction.class.st | 115 ++++++++++++++---- smalltalksrc/VMMaker/CogX64Compiler.class.st | 73 ++++++++++- .../UnicornWinX64Simulator.class.st | 3 +- .../VMMakerTests/UnicornX64Simulator.class.st | 6 + .../VMJitFFISameThreadCalloutTest.class.st | 87 +++++++------ 5 files changed, 221 insertions(+), 63 deletions(-) diff --git a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st index b5d75abb3d..6318a0197a 100644 --- a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st +++ b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st @@ -548,6 +548,27 @@ CogAbstractInstruction >> cArg0Register [ ^ self subclassResponsibility ] +{ #category : 'accessing' } +CogAbstractInstruction >> cArg1Register [ + + + ^ self subclassResponsibility +] + +{ #category : 'accessing' } +CogAbstractInstruction >> cArg2Register [ + + + ^ self subclassResponsibility +] + +{ #category : 'accessing' } +CogAbstractInstruction >> cArg3Register [ + + + ^ self subclassResponsibility +] + { #category : 'accessing' } CogAbstractInstruction >> cResultRegister [ "Answer the register through which C funcitons return integral results." @@ -782,12 +803,20 @@ CogAbstractInstruction >> genFFIFallbackCall [ ] { #category : 'sameThread callout - optimizations' } -CogAbstractInstruction >> genFFISameThreadCall: anExternalFunctionAddress [. +CogAbstractInstruction >> genFFISameThreadCall: anExternalFunctionAddress [ + + ^ self + genFFISameThreadCall: anExternalFunctionAddress + handlesExtraDoubleArgument: false +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genFFISameThreadCall: anExternalFunctionAddress handlesExtraDoubleArgument: handlesExtraDoubleArgument [ "Change to C Stack, pushing LinkRegistry if needed" cogit genSmalltalkToCStackSwitch: true. - self prepareStackForFFICall. + self prepareStackForFFICall: handlesExtraDoubleArgument. cogit CallFullRT: anExternalFunctionAddress. @@ -878,16 +907,30 @@ CogAbstractInstruction >> genLoadStackPointers [ { #category : 'sameThread callout - optimizations' } CogAbstractInstruction >> genMarshallDoubleArgumentInReg: reg errorRoutineLabel: errorRoutine withFlags: flags [ - | mightBeOOp mightBeExternalAddress jumpIfNotFloat | + | jumpIfNotFloat | - mightBeOOp := (flags bitAnd: FFI_FLAG_POINTERS_MIGHT_BE_OBJECTS) ~= 0. - mightBeExternalAddress := (flags bitAnd: FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES) ~= 0. - cogit ssPopTopToReg: Extra0Reg. jumpIfNotFloat := objectRepresentation genBoxedOrSmallFloat: Extra0Reg scratchReg: Extra1Reg into: reg. jumpIfNotFloat jmpTarget: errorRoutine ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genMarshallDoubleArgumentIndex: index fullIndex: total errorRoutineLabel: errorRoutine withFlags: flags [ + + "We marshall directly using the registers. In Windows X64 we are going to do it differently" + + | reg | + index = 1 ifTrue: [ reg := DPFPReg0 ]. + index = 2 ifTrue: [ reg := DPFPReg1 ]. + index = 3 ifTrue: [ reg := DPFPReg2 ]. + index = 4 ifTrue: [ reg := DPFPReg3 ]. + + ^ self + genMarshallDoubleArgumentInReg: reg + errorRoutineLabel: errorRoutine + withFlags: flags +] + { #category : 'abi' } CogAbstractInstruction >> genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 [ "Generate the code to pass up to four arguments in a C run-time call. Hack: each argument is @@ -971,6 +1014,22 @@ CogAbstractInstruction >> genMarshallPointerArgumentInReg: reg errorRoutineLabel ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genMarshallPointerArgumentIndex: typeIndex fullIndex: fullIndex errorRoutineLabel: errorRoutine withFlags: flags [ + + | reg | + + typeIndex = 1 ifTrue: [ reg := self cArg0Register ]. + typeIndex = 2 ifTrue: [ reg := self cArg1Register ]. + typeIndex = 3 ifTrue: [ reg := self cArg2Register ]. + typeIndex = 4 ifTrue: [ reg := self cArg3Register ]. + + ^ self + genMarshallPointerArgumentInReg: reg + errorRoutineLabel: errorRoutine + withFlags: flags +] + { #category : 'sameThread callout - optimizations' } CogAbstractInstruction >> genMarshallReturnPointer: errorRoutineLabel [ @@ -1006,7 +1065,7 @@ CogAbstractInstruction >> genOptimizedSameThreadCalloutDoubleVoidFor: anExternal errorRoutine := self genFFIFallbackCall. - self genMarshallDoubleArgumentInReg: DPFPReg0 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentIndex: 1 fullIndex: 1 errorRoutineLabel: errorRoutine withFlags: flags. self genFFISameThreadCall: anExternalFunctionAddress. @@ -1059,13 +1118,19 @@ CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerDoubleDoubleDouble errorRoutine := self genFFIFallbackCall. - self genMarshallDoubleArgumentInReg: DPFPReg3 errorRoutineLabel: errorRoutine withFlags: flags. - self genMarshallDoubleArgumentInReg: DPFPReg2 errorRoutineLabel: errorRoutine withFlags: flags. - self genMarshallDoubleArgumentInReg: DPFPReg1 errorRoutineLabel: errorRoutine withFlags: flags. - self genMarshallDoubleArgumentInReg: DPFPReg0 errorRoutineLabel: errorRoutine withFlags: flags. - self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentIndex: 4 fullIndex: 5 errorRoutineLabel: errorRoutine withFlags: flags. - self genFFISameThreadCall: anExternalFunctionAddress. + self genMarshallDoubleArgumentIndex: 3 fullIndex: 4 errorRoutineLabel: errorRoutine withFlags: flags. + + self genMarshallDoubleArgumentIndex: 2 fullIndex: 3 errorRoutineLabel: errorRoutine withFlags: flags. + + self genMarshallDoubleArgumentIndex: 1 fullIndex: 2 errorRoutineLabel: errorRoutine withFlags: flags. + + self genMarshallPointerArgumentIndex: 1 fullIndex: 1 errorRoutineLabel: errorRoutine withFlags: flags. + + self + genFFISameThreadCall: anExternalFunctionAddress + handlesExtraDoubleArgument: true. ^ true ] @@ -1077,11 +1142,11 @@ CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerDoubleDoubleDouble cogit ssFlushStack. errorRoutine := self genFFIFallbackCall. - - self genMarshallDoubleArgumentInReg: DPFPReg2 errorRoutineLabel: errorRoutine withFlags: flags. - self genMarshallDoubleArgumentInReg: DPFPReg1 errorRoutineLabel: errorRoutine withFlags: flags. - self genMarshallDoubleArgumentInReg: DPFPReg0 errorRoutineLabel: errorRoutine withFlags: flags. - self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + + self genMarshallDoubleArgumentIndex: 3 fullIndex: 4 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentIndex: 2 fullIndex: 3 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentIndex: 1 fullIndex: 2 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallPointerArgumentIndex: 1 fullIndex: 1 errorRoutineLabel: errorRoutine withFlags: flags. self genFFISameThreadCall: anExternalFunctionAddress. @@ -1096,9 +1161,11 @@ CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerDoubleDoubleVoidFo errorRoutine := self genFFIFallbackCall. - self genMarshallDoubleArgumentInReg: DPFPReg1 errorRoutineLabel: errorRoutine withFlags: flags. - self genMarshallDoubleArgumentInReg: DPFPReg0 errorRoutineLabel: errorRoutine withFlags: flags. - self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallDoubleArgumentIndex: 2 fullIndex: 3 errorRoutineLabel: errorRoutine withFlags: flags. + + self genMarshallDoubleArgumentIndex: 1 fullIndex: 2 errorRoutineLabel: errorRoutine withFlags: flags. + + self genMarshallPointerArgumentIndex: 1 fullIndex: 1 errorRoutineLabel: errorRoutine withFlags: flags. self genFFISameThreadCall: anExternalFunctionAddress. @@ -1113,7 +1180,7 @@ CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerPointerFor: anExte errorRoutine := self genFFIFallbackCall. - self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallPointerArgumentIndex: 1 fullIndex: 1 errorRoutineLabel: errorRoutine withFlags: flags. self genFFISameThreadCall: anExternalFunctionAddress. @@ -1130,7 +1197,7 @@ CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerVoidFor: anExterna errorRoutine := self genFFIFallbackCall. - self genMarshallPointerArgumentInReg: self cArg0Register errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallPointerArgumentIndex: 1 fullIndex: 1 errorRoutineLabel: errorRoutine withFlags: flags. self genFFISameThreadCall: anExternalFunctionAddress. @@ -1809,7 +1876,7 @@ CogAbstractInstruction >> outputMachineCodeAt: targetAddress [ ] { #category : 'sameThread callout - optimizations' } -CogAbstractInstruction >> prepareStackForFFICall [ +CogAbstractInstruction >> prepareStackForFFICall: handlesExtraDoubleArgument [ ] diff --git a/smalltalksrc/VMMaker/CogX64Compiler.class.st b/smalltalksrc/VMMaker/CogX64Compiler.class.st index 777494c99c..1dde284758 100644 --- a/smalltalksrc/VMMaker/CogX64Compiler.class.st +++ b/smalltalksrc/VMMaker/CogX64Compiler.class.st @@ -363,6 +363,13 @@ CogX64Compiler >> cArg0Register [ ^ Arg0Reg ] +{ #category : 'accessing' } +CogX64Compiler >> cArg1Register [ + + + ^ Arg1Reg +] + { #category : 'abi' } CogX64Compiler >> cFloatResultToRd: reg [ XMM0L ~= reg ifTrue: [ @@ -3747,6 +3754,37 @@ CogX64Compiler >> genLoadStackPointers [ ^0 ] +{ #category : 'sameThread callout - optimizations' } +CogX64Compiler >> genMarshallDoubleArgumentIndex: index fullIndex: fullIndex errorRoutineLabel: errorRoutine withFlags: flags [ + + | reg indexToUse jumpIfNotFloat | + + "In SysV, the register index used depends on the type, in Windows we need to use the full index". + + "In windows, if we are sending a four Double arguments, but the fourth is in the fifth position, we need to pass it in the stack. For doing so, we are going to use XMM0 to hold it, and then we will push it. This is a HACK, we need to improve this marshalling for more cases" + + (SysV not and: [ index = 4 and: [ fullIndex = 5 ] ]) + ifTrue: [ + cogit ssPopTopToReg: Extra0Reg. + jumpIfNotFloat := objectRepresentation + genBoxedOrSmallFloat: Extra0Reg + scratchReg: Extra1Reg into: DPFPReg0. + jumpIfNotFloat jmpTarget: errorRoutine. + ^ self ]. + + indexToUse := SysV ifTrue: [ index ] ifFalse: [ fullIndex ]. + + indexToUse = 1 ifTrue: [ reg := DPFPReg0 ]. + indexToUse = 2 ifTrue: [ reg := DPFPReg1 ]. + indexToUse = 3 ifTrue: [ reg := DPFPReg2 ]. + indexToUse = 4 ifTrue: [ reg := DPFPReg3 ]. + + ^ self + genMarshallDoubleArgumentInReg: reg + errorRoutineLabel: errorRoutine + withFlags: flags +] + { #category : 'abi' } CogX64Compiler >> genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 [ "Generate the code to pass up to four arguments in a C run-time call. Hack: each argument is @@ -3869,6 +3907,26 @@ CogX64Compiler >> genMarshallNArgs: numArgs floatArg: regOrConst0 floatArg: regO self assert: numArgs <= 4 ] +{ #category : 'sameThread callout - optimizations' } +CogX64Compiler >> genMarshallPointerArgumentIndex: typeIndex fullIndex: fullIndex errorRoutineLabel: errorRoutine withFlags: flags [ + + | reg indexToUse | + + "In SysV, the register index used depends on the type, in Windows we need to use the full index". + + indexToUse := SysV ifTrue: [ typeIndex ] ifFalse: [ fullIndex ]. + + indexToUse = 1 ifTrue: [ reg := self cArg0Register ]. + indexToUse = 2 ifTrue: [ reg := self cArg1Register ]. + indexToUse = 3 ifTrue: [ reg := self cArg2Register ]. + indexToUse = 4 ifTrue: [ reg := self cArg3Register ]. + + ^ self + genMarshallPointerArgumentInReg: reg + errorRoutineLabel: errorRoutine + withFlags: flags +] + { #category : 'abstract instructions' } CogX64Compiler >> genMemCopy: originalSourceReg to: originalDestReg constantSize: size [ | numbytes numwords sourceReg destReg countReg inst | @@ -4480,10 +4538,21 @@ CogX64Compiler >> padIfPossibleWithStopsFrom: startAddr to: endAddr [ ] { #category : 'sameThread callout - optimizations' } -CogX64Compiler >> prepareStackForFFICall [ +CogX64Compiler >> prepareStackForFFICall: handlesExtraDoubleArgument [ "WIN64 ABI allways reserve shadow space on the stack for callee to save up to 4 register parameters" - SysV ifFalse: [ cogit SubCq: 32 R: RSP ] + SysV ifTrue: [ ^ self ]. + + handlesExtraDoubleArgument ifFalse: [ + cogit SubCq: 32 R: RSP. + ^ self ]. + + "If we are handling an extra double argument, we need to push it in the stack. + We leave space in the stack for 16 bytes, as we are moving the XMM0 that is 16 bytes wide" + + cogit SubCq: 56 R: RSP. + cogit MoveRd: XMM0L M64: 32 r: RSP. + ] { #category : 'calling C function in Smalltalk stack' } diff --git a/smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st index 36ca1be8ab..e612bffbd4 100644 --- a/smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st @@ -48,7 +48,8 @@ UnicornWinX64Simulator >> fetchArgumentsOfTypes: argumentTypes [ ifFalse: [ self cArgRegisterRaw: index ]] ifFalse: [ index = 6 ifTrue: [ self halt ]. - byteArray := self stackValueBytesAt: 0. + "The fifth argument is in the 6th position, we have the return address, and the FP" + byteArray := self stackValueBytesAt: 6. ]. type marshallToSmalltalkFromByteArray: byteArray ] diff --git a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st index 430223bdee..4ceebd9948 100644 --- a/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornX64Simulator.class.st @@ -151,6 +151,12 @@ UnicornX64Simulator >> instructionPointerRegister [ ^ UcX86Registers rip ] +{ #category : 'as yet unclassified' } +UnicornX64Simulator >> instructionPointerValue [ + + ^ self instructionPointerRegister value +] + { #category : 'as yet unclassified' } UnicornX64Simulator >> integerRegisterState [ diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st index c98de1d1b9..e0baea003a 100644 --- a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -748,7 +748,8 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionDoubleToVoid [ createExternalFunctionFor: [:arg | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArguments := machineSimulator fetchArgumentsOfTypes: argumentTypes. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. 0 ] withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void @@ -800,7 +801,8 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleD createExternalFunctionFor: [:ptr ":dbl1 :dbl2 :dbl3 :dbl4 Double Parameters are not handled by our simulation" | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArguments := machineSimulator fetchArgumentsOfTypes: argumentTypes. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. 0 ] withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void @@ -851,24 +853,24 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleD { #category : 'tests - pointer double double double void' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleToVoid [ - | compiledMethod cogMethod tfExternalFunction called receivedArgument1 receivedArgument2 receivedArgument3 anExternalAddress receivedArgument4 | + | compiledMethod cogMethod tfExternalFunction called receivedArguments argumentTypes anExternalAddress | isa = #IA32 ifTrue: [ ^ self skip ]. called := false. + argumentTypes := { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double }. + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " tfExternalFunction := self createExternalFunctionFor: [:ptr :dbl1 :dbl2 :dbl3 | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument1 := ptr. - receivedArgument2 := machineSimulator doublePrecisionFloatingPointRegister0Value. - receivedArgument3 := machineSimulator doublePrecisionFloatingPointRegister1Value. - receivedArgument4 := machineSimulator doublePrecisionFloatingPointRegister2Value. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. 0 ] - withArgumentTypes: { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double } + withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. @@ -904,33 +906,35 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleT self assert: machineSimulator pc equals: callerAddress. self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). self assert: called. - self assert: receivedArgument1 equals: 17. - self assert: receivedArgument2 equals: 23.5. - self assert: receivedArgument3 equals: 42.0. - self assert: receivedArgument4 equals: 99.5. + self assert: receivedArguments first equals: 17. + self assert: receivedArguments second equals: 23.5. + self assert: receivedArguments third equals: 42.0. + self assert: receivedArguments fourth equals: 99.5. ] { #category : 'tests - pointer double double to void' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleToVoid [ - | compiledMethod cogMethod tfExternalFunction called receivedArgument1 receivedArgument2 receivedArgument3 anExternalAddress | + | compiledMethod cogMethod tfExternalFunction called receivedArguments anExternalAddress argumentTypes | isa = #IA32 ifTrue: [ ^ self skip ]. called := false. + argumentTypes :={ interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double }. + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " tfExternalFunction := self createExternalFunctionFor: [:ptr :dbl1 :dbl2 | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument1 := ptr. - receivedArgument2 := machineSimulator doublePrecisionFloatingPointRegister0Value. - receivedArgument3 := machineSimulator doublePrecisionFloatingPointRegister1Value. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. + 0 ] - withArgumentTypes: { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double } + withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. @@ -964,9 +968,9 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleToVoid self assert: machineSimulator pc equals: callerAddress. self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). self assert: called. - self assert: receivedArgument1 equals: 17. - self assert: receivedArgument2 equals: 23.5. - self assert: receivedArgument3 equals: 42.0. + self assert: receivedArguments first equals: 17. + self assert: receivedArguments second equals: 23.5. + self assert: receivedArguments third equals: 42.0. ] { #category : 'tests - pointer to pointer' } @@ -1020,21 +1024,25 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToPointer [ { #category : 'tests - pointer to void (Opt)' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidAllowinOopsWithOopAsParameter [ - | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArguments argumentTypes | isa = #IA32 ifTrue: [ ^ self skip ]. called := false. + argumentTypes := { interpreter libFFI pointer }. + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " tfExternalFunction := self createExternalFunctionFor: [:arg | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument := arg. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. + 0 ] - withArgumentTypes: { interpreter libFFI pointer } + withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_OBJECTS. @@ -1064,7 +1072,7 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidAllowinOopsWi self assert: machineSimulator pc equals: callerAddress. self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). self assert: called. - self assert: receivedArgument equals: aByteArray + BaseHeaderSize + self assert: receivedArguments first equals: aByteArray + BaseHeaderSize ] { #category : 'tests - pointer to void (Opt)' } @@ -1117,21 +1125,24 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidChangesStack { #category : 'tests - pointer to void (Opt)' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithExternalAddressAsParameter [ - | compiledMethod cogMethod tfExternalFunction called receivedArgument anExternalAddress | + | compiledMethod cogMethod tfExternalFunction called receivedArguments anExternalAddress argumentTypes | isa = #IA32 ifTrue: [ ^ self skip ]. called := false. + argumentTypes := { interpreter libFFI pointer }. + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " tfExternalFunction := self createExternalFunctionFor: [:arg | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument := arg. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. 0 ] - withArgumentTypes: { interpreter libFFI pointer } + withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. @@ -1161,17 +1172,18 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithExternalA self assert: machineSimulator pc equals: callerAddress. self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). self assert: called. - self assert: receivedArgument equals: 17 + self assert: receivedArguments first equals: 17 ] { #category : 'tests - pointer to void (Opt)' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithNilAsParameterShouldFail [ - | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArguments argumentTypes | isa = #IA32 ifTrue: [ ^ self skip ]. called := false. + argumentTypes := { interpreter libFFI pointer }. "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " @@ -1179,9 +1191,10 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithNilAsPara createExternalFunctionFor: [:arg | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument := arg. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. 0 ] - withArgumentTypes: { interpreter libFFI pointer } + withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. @@ -1216,11 +1229,12 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithNilAsPara { #category : 'tests - pointer to void (Opt)' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithOopAsParameterShouldFail [ - | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArgument | + | compiledMethod cogMethod tfExternalFunction aByteArray called receivedArguments argumentTypes | isa = #IA32 ifTrue: [ ^ self skip ]. called := false. + argumentTypes := { interpreter libFFI pointer }. "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a void returning function " @@ -1228,9 +1242,11 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithOopAsPara createExternalFunctionFor: [:arg | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument := arg. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. + 0 ] - withArgumentTypes: { interpreter libFFI pointer } + withArgumentTypes: argumentTypes withReturnType: interpreter libFFI void flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. @@ -1265,7 +1281,7 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithOopAsPara { #category : 'tests - pointer to void (Opt)' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithSmallIntegerAsParameterShouldFail [ - | compiledMethod cogMethod tfExternalFunction called receivedArgument | + | compiledMethod cogMethod tfExternalFunction called | isa = #IA32 ifTrue: [ ^ self skip ]. @@ -1277,7 +1293,6 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithSmallInte createExternalFunctionFor: [:arg | self assertIsOptimizedCall: tfExternalFunction. called := true. - receivedArgument := arg. 0 ] withArgumentTypes: { interpreter libFFI pointer } withReturnType: interpreter libFFI void From b2ead2bbecbcbbd9645f6e6bc0d8d1d7d17fa925 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Fri, 21 Mar 2025 11:55:47 +0100 Subject: [PATCH 15/19] Adding accessors for registers in calling convention --- smalltalksrc/VMMaker/CogARMCompiler.class.st | 21 +++++++++++++++++++ .../VMMaker/CogARMv8Compiler.class.st | 21 +++++++++++++++++++ 2 files changed, 42 insertions(+) diff --git a/smalltalksrc/VMMaker/CogARMCompiler.class.st b/smalltalksrc/VMMaker/CogARMCompiler.class.st index add98ada80..5d2da512de 100644 --- a/smalltalksrc/VMMaker/CogARMCompiler.class.st +++ b/smalltalksrc/VMMaker/CogARMCompiler.class.st @@ -445,6 +445,27 @@ CogARMCompiler >> cArg0Register [ ^R0 ] +{ #category : 'accessing' } +CogARMCompiler >> cArg1Register [ + + + ^R1 +] + +{ #category : 'accessing' } +CogARMCompiler >> cArg2Register [ + + + ^R2 +] + +{ #category : 'accessing' } +CogARMCompiler >> cArg3Register [ + + + ^R3 +] + { #category : 'abi' } CogARMCompiler >> cResultRegister [ "Answer the register through which C funcitons return integral results." diff --git a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st index 03a11fc9a5..e786f2b0a3 100644 --- a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st +++ b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st @@ -851,6 +851,27 @@ CogARMv8Compiler >> cArg0Register [ ^R0 ] +{ #category : 'accessing' } +CogARMv8Compiler >> cArg1Register [ + + + ^R1 +] + +{ #category : 'accessing' } +CogARMv8Compiler >> cArg2Register [ + + + ^R2 +] + +{ #category : 'accessing' } +CogARMv8Compiler >> cArg3Register [ + + + ^R3 +] + { #category : 'abi' } CogARMv8Compiler >> cResultRegister [ "Answer the register through which C funcitons return integral results." From 60dd0743fd1bd024a50e7064ddd0a2dcd0a21a2f Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Mon, 26 May 2025 17:53:08 +0200 Subject: [PATCH 16/19] Fixing merge --- smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st index 50cfd0c09f..bb57e33221 100644 --- a/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st @@ -164,12 +164,12 @@ UnicornRISCVSimulator >> doublePrecisionFloatingPointRegister2 [ UnicornRISCVSimulator >> doublePrecisionFloatingPointRegister3 [ ^ UcRISCVRegisters f3 -======= +] + { #category : 'disassembling' } UnicornRISCVSimulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction [ ^ (aLLVMInstruction assemblyCodeString substrings: String tab, ',') second trimBoth. ->>>>>>> pharo-12 ] { #category : 'machine registers' } From 0247d01898cefccb8cacb1ead437d7c716ddd59d Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Mon, 26 May 2025 17:54:30 +0200 Subject: [PATCH 17/19] Fixing merge --- smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st | 1 - 1 file changed, 1 deletion(-) diff --git a/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st index bb57e33221..f3a88dd0f3 100644 --- a/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornRISCVSimulator.class.st @@ -159,7 +159,6 @@ UnicornRISCVSimulator >> doublePrecisionFloatingPointRegister2 [ ^ UcRISCVRegisters f2 ] -<<<<<<< HEAD { #category : 'as yet unclassified' } UnicornRISCVSimulator >> doublePrecisionFloatingPointRegister3 [ From d110d3f1ff9fd5e58972022adfe9d47313725130 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Mon, 16 Jun 2025 12:16:37 +0200 Subject: [PATCH 18/19] Fixing the pointers marshalling for X64 --- .../VMMaker/CogAbstractInstruction.class.st | 57 +++++++- smalltalksrc/VMMaker/CogX64Compiler.class.st | 22 +++ .../VMJitFFISameThreadCalloutTest.class.st | 129 ++++++++++++++++++ 3 files changed, 201 insertions(+), 7 deletions(-) diff --git a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st index 0427171379..8678026688 100644 --- a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st +++ b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st @@ -1091,23 +1091,47 @@ CogAbstractInstruction >> genOptimizedSameThreadCalloutFor: cif flags: flags and (flags bitAnd: FFI_FLAG_USE_OPTIMIZED_VERSION) = 0 ifTrue: [ ^ false ]. - self if: cif returnType: FFI_TYPE_POINTER do: [ ^ self genOptimizedSameThreadCalloutVoidPointerFor: externalFunctionAddress withFlags: flags ]. - self if: cif hasArgType: FFI_TYPE_DOUBLE returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutDoubleVoidFor: externalFunctionAddress withFlags: flags ]. - self if: cif hasArgType: FFI_TYPE_POINTER returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutPointerVoidFor: externalFunctionAddress withFlags: flags ]. - self if: cif hasArgType: FFI_TYPE_POINTER returnType: FFI_TYPE_POINTER do: [ ^ self genOptimizedSameThreadCalloutPointerPointerFor: externalFunctionAddress withFlags: flags ]. + self if: cif + returnType: FFI_TYPE_POINTER + do: [ ^ self genOptimizedSameThreadCalloutVoidPointerFor: externalFunctionAddress withFlags: flags ]. + + self if: cif + hasArgType: FFI_TYPE_DOUBLE + returnType: FFI_TYPE_VOID + do: [ ^ self genOptimizedSameThreadCalloutDoubleVoidFor: externalFunctionAddress withFlags: flags ]. + + self if: cif + hasArgType: FFI_TYPE_POINTER + returnType: FFI_TYPE_VOID + do: [ ^ self genOptimizedSameThreadCalloutPointerVoidFor: externalFunctionAddress withFlags: flags ]. + + self if: cif + hasArgType: FFI_TYPE_POINTER + returnType: FFI_TYPE_POINTER + do: [ ^ self genOptimizedSameThreadCalloutPointerPointerFor: externalFunctionAddress withFlags: flags ]. self if: cif hasArgType: FFI_TYPE_POINTER and: FFI_TYPE_DOUBLE and: FFI_TYPE_DOUBLE - returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutPointerDoubleDoubleVoidFor: externalFunctionAddress withFlags: flags ]. + returnType: FFI_TYPE_VOID + do: [ ^ self genOptimizedSameThreadCalloutPointerDoubleDoubleVoidFor: externalFunctionAddress withFlags: flags ]. + + self if: cif + hasArgType: FFI_TYPE_POINTER + and: FFI_TYPE_POINTER + and: FFI_TYPE_POINTER + and: FFI_TYPE_POINTER + returnType: FFI_TYPE_VOID + do: [ ^ self genOptimizedSameThreadCalloutPointerPointerPointerPointerVoidFor: externalFunctionAddress withFlags: flags ]. self if: cif hasArgType: FFI_TYPE_POINTER and: FFI_TYPE_DOUBLE and: FFI_TYPE_DOUBLE and: FFI_TYPE_DOUBLE - returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutPointerDoubleDoubleDoubleVoidFor: externalFunctionAddress withFlags: flags ]. + returnType: FFI_TYPE_VOID + do: [ ^ self genOptimizedSameThreadCalloutPointerDoubleDoubleDoubleVoidFor: externalFunctionAddress withFlags: flags ]. self if: cif hasArgType: FFI_TYPE_POINTER @@ -1115,7 +1139,8 @@ CogAbstractInstruction >> genOptimizedSameThreadCalloutFor: cif flags: flags and and: FFI_TYPE_DOUBLE and: FFI_TYPE_DOUBLE and: FFI_TYPE_DOUBLE - returnType: FFI_TYPE_VOID do: [ ^ self genOptimizedSameThreadCalloutPointerDoubleDoubleDoubleDoubleVoidFor: externalFunctionAddress withFlags: flags ]. + returnType: FFI_TYPE_VOID + do: [ ^ self genOptimizedSameThreadCalloutPointerDoubleDoubleDoubleDoubleVoidFor: externalFunctionAddress withFlags: flags ]. ^ false ] @@ -1199,6 +1224,24 @@ CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerPointerFor: anExte ^ true. ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerPointerPointerPointerVoidFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallPointerArgumentIndex: 4 fullIndex: 4 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallPointerArgumentIndex: 3 fullIndex: 3 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallPointerArgumentIndex: 2 fullIndex: 2 errorRoutineLabel: errorRoutine withFlags: flags. + self genMarshallPointerArgumentIndex: 1 fullIndex: 1 errorRoutineLabel: errorRoutine withFlags: flags. + + self genFFISameThreadCall: anExternalFunctionAddress. + + ^ true +] + { #category : 'sameThread callout - optimizations' } CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerVoidFor: anExternalFunctionAddress withFlags: flags [ diff --git a/smalltalksrc/VMMaker/CogX64Compiler.class.st b/smalltalksrc/VMMaker/CogX64Compiler.class.st index 0a77467b8d..2dda77e41c 100644 --- a/smalltalksrc/VMMaker/CogX64Compiler.class.st +++ b/smalltalksrc/VMMaker/CogX64Compiler.class.st @@ -14,6 +14,8 @@ Class { #name : 'CogX64Compiler', #superclass : 'CogX86Compiler', #classVars : [ + 'Arg2Reg', + 'Arg3Reg', 'CDQ', 'CLD', 'CMPXCHGAwR', @@ -258,6 +260,9 @@ CogX64Compiler class >> initializeAbstractRegistersSysV [ FPReg := RBP. Arg0Reg := RDI. "So as to agree with C ABI arg 0" Arg1Reg := RSI. "So as to agree with C ABI arg 1" + Arg2Reg := RDX. "These registers are for using when marshalling to C function, they collide with the other usages" + Arg3Reg := RCX. "These registers are for using when marshalling to C function, they collide with the other usages" + VarBaseReg := RBX. "Must be callee saved" "R8 is either RISCTempReg or Extra6Reg depending on subclass." Extra0Reg := R10. @@ -296,6 +301,9 @@ CogX64Compiler class >> initializeAbstractRegistersWin64 [ FPReg := RBP. Arg0Reg := RCX. "So as to agree with C ABI arg 0" Arg1Reg := RDX. "So as to agree with C ABI arg 1" + Arg2Reg := R8. "These registers are for using when marshalling to C function, they collide with the other usages" + Arg3Reg := R9. "These registers are for using when marshalling to C function, they collide with the other usages" + VarBaseReg := RBX. "Must be callee saved" "R11 is either RISCTempReg or Extra6Reg depending on subclass." Extra0Reg := RDI. @@ -370,6 +378,20 @@ CogX64Compiler >> cArg1Register [ ^ Arg1Reg ] +{ #category : 'accessing' } +CogX64Compiler >> cArg2Register [ + + + ^ Arg2Reg +] + +{ #category : 'accessing' } +CogX64Compiler >> cArg3Register [ + + + ^ Arg3Reg +] + { #category : 'abi' } CogX64Compiler >> cFloatResultToRd: reg [ XMM0L ~= reg ifTrue: [ diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st index e0baea003a..15b5437043 100644 --- a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -373,6 +373,69 @@ VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionDoubleToVoid [ self assert: receivedArgument equals: 23.5 ] +{ #category : 'tests - pointer pointer pointer pointer to void' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionFunctionPointerPointerPointerPointerToVoid [ + + | compiledMethod cogMethod tfExternalFunction called receivedArguments anExternalAddress argumentTypes anotherExternalAddress anotherExternalAddress2 anotherExternalAddress3 | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + argumentTypes :={ interpreter libFFI pointer. interpreter libFFI pointer. interpreter libFFI pointer. interpreter libFFI pointer }. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:ptr :ptr2 :ptr3 :ptr4 | + self assertIsNonOptimizedCall: tfExternalFunction. + called := true. + receivedArguments := { ptr. ptr2. ptr3. ptr4 }. + 0 ] + withArgumentTypes: argumentTypes + withReturnType: interpreter libFFI void. + + anExternalAddress := self newExternalAddress: 17. + anotherExternalAddress := self newExternalAddress: 18. + anotherExternalAddress2 := self newExternalAddress: 19. + anotherExternalAddress3 := self newExternalAddress: 20. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: anotherExternalAddress; + literalAt: 3 put: anotherExternalAddress2; + literalAt: 4 put: anotherExternalAddress3; + literalAt: 5 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 34 "PushLiteral 2" + 35 "PushLiteral 3" + 36 "PushLiteral 4" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArguments first equals: 17. + self assert: receivedArguments second equals: 18. + self assert: receivedArguments third equals: 19. + self assert: receivedArguments fourth equals: 20. +] + { #category : 'tests - pointer double double double double void' } VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerDoubleDoubleDoubleDoubleToVoid [ @@ -973,6 +1036,72 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleToVoid self assert: receivedArguments third equals: 42.0. ] +{ #category : 'tests - pointer pointer pointer pointer to void' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerPointerPointerPointerToVoid [ + + | compiledMethod cogMethod tfExternalFunction called receivedArguments anExternalAddress argumentTypes anotherExternalAddress anotherExternalAddress2 anotherExternalAddress3 | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + argumentTypes :={ interpreter libFFI pointer. interpreter libFFI pointer. interpreter libFFI pointer. interpreter libFFI pointer }. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:ptr :ptr2 :ptr3 :ptr4 | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. + + 0 ] + withArgumentTypes: argumentTypes + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + anExternalAddress := self newExternalAddress: 17. + anotherExternalAddress := self newExternalAddress: 18. + anotherExternalAddress2 := self newExternalAddress: 19. + anotherExternalAddress3 := self newExternalAddress: 20. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: anotherExternalAddress; + literalAt: 3 put: anotherExternalAddress2; + literalAt: 4 put: anotherExternalAddress3; + literalAt: 5 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 34 "PushLiteral 2" + 35 "PushLiteral 3" + 36 "PushLiteral 4" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: callerAddress. + + self assert: machineSimulator pc equals: callerAddress. + self assert: machineSimulator receiverRegisterValue equals: (memory integerObjectOf: 23). + self assert: called. + self assert: receivedArguments first equals: 17. + self assert: receivedArguments second equals: 18. + self assert: receivedArguments third equals: 19. + self assert: receivedArguments fourth equals: 20. +] + { #category : 'tests - pointer to pointer' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToPointer [ From c610f3e79a57c0faea81ce6752cc3063d6a7c0bd Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Wed, 18 Jun 2025 18:29:48 +0200 Subject: [PATCH 19/19] Adding a trampoline in the middle of the FFI calls so we can handle the code compaction and the movements of machine code methods --- smalltalksrc/VMMaker/CogARMCompiler.class.st | 19 +++- .../VMMaker/CogARMv8Compiler.class.st | 17 +++ .../VMMaker/CogAbstractInstruction.class.st | 18 +-- smalltalksrc/VMMaker/CogIA32Compiler.class.st | 6 + smalltalksrc/VMMaker/CogX64Compiler.class.st | 6 + smalltalksrc/VMMaker/Cogit.class.st | 4 +- smalltalksrc/VMMaker/ManifestVMMaker.class.st | 11 +- .../VMMaker/SimpleStackBasedCogit.class.st | 94 +++++++++++++++- .../UnicornARMv8Simulator.class.st | 6 + .../VMMakerTests/UnicornProcessor.class.st | 12 ++ .../VMJitFFISameThreadCalloutTest.class.st | 106 ++++++++++++++++++ ...SimpleStackBasedCogitAbstractTest.class.st | 2 +- 12 files changed, 285 insertions(+), 16 deletions(-) diff --git a/smalltalksrc/VMMaker/CogARMCompiler.class.st b/smalltalksrc/VMMaker/CogARMCompiler.class.st index ce5dafe0a6..f27f0cbdc8 100644 --- a/smalltalksrc/VMMaker/CogARMCompiler.class.st +++ b/smalltalksrc/VMMaker/CogARMCompiler.class.st @@ -539,7 +539,8 @@ CogARMCompiler >> computeMaximumSize [ [Fill32] -> [^4]. [Nop] -> [^4]. "Control" - [Call] -> [^4]. + [Call] -> [^4]. + [CallR] -> [^4]. [CallFull] -> [^self literalLoadInstructionBytes + 4]. [JumpR] -> [^4]. [Jump] -> [^4]. @@ -890,6 +891,15 @@ CogARMCompiler >> concretizeCallFull [ ^machineCodeSize := instrOffset + 4 ] +{ #category : 'generate machine code - concretize' } +CogARMCompiler >> concretizeCallR [ + + + + self machineCodeAt: 0 put: (self blx: (operands at: 0)). + ^ machineCodeSize := 4 +] + { #category : 'generate machine code - concretize' } CogARMCompiler >> concretizeCmpRdRd [ "Will get inlined into concretizeAt: switch." @@ -1935,6 +1945,7 @@ CogARMCompiler >> dispatchConcretize [ "Control" [Call] -> [^self concretizeCall]. "call code within code space" [CallFull] -> [^self concretizeCallFull]. "call code anywhere in address space" + [CallR] -> [^self concretizeCallR]. [JumpR] -> [^self concretizeJumpR]. [JumpFull] -> [^self concretizeJumpFull]."jump within address space" [JumpLong] -> [^self concretizeConditionalJump: AL]."jumps witihn code space" @@ -3008,6 +3019,12 @@ CogARMCompiler >> nameForRegister: reg [ "" [default] ] +{ #category : 'testing' } +CogARMCompiler >> needsFFIFullCallInRegisterTrampoline [ + + ^ true +] + { #category : 'inline cacheing' } CogARMCompiler >> numICacheFlushOpcodes [ "ARM needs to do icache flushing when code is written" diff --git a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st index 5580af5ae3..1f6cf75f7b 100644 --- a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st +++ b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st @@ -1028,6 +1028,7 @@ CogARMv8Compiler >> computeMaximumSize [ "Control" [Call] -> [^4]. [CallFull] -> [^self literalLoadInstructionBytes + 4]. + [CallR] -> [^4]. [JumpR] -> [^4]. [Jump] -> [^4]. [JumpFull] -> [^self literalLoadInstructionBytes + 4]. @@ -1618,6 +1619,15 @@ CogARMv8Compiler >> concretizeCallFull [ ^ machineCodeSize := instrOffset + 4 ] +{ #category : 'generate machine code - concretize' } +CogARMv8Compiler >> concretizeCallR [ + + + + self machineCodeAt: 0 put: (self blr: (operands at: 0)). + ^ machineCodeSize := 4 +] + { #category : 'generate machine code' } CogARMv8Compiler >> concretizeCmpC32R [ @@ -3442,6 +3452,7 @@ CogARMv8Compiler >> dispatchConcretize [ "Control" [Call] -> [^self concretizeCall]. "call code within code space" [CallFull] -> [^self concretizeCallFull]. "call code anywhere in address space" + [CallR] -> [^self concretizeCallR]. [JumpR] -> [^self concretizeJumpR]. [JumpFull] -> [^self concretizeJumpFull]."jump within address space" [JumpLong] -> [^self concretizeJumpLong]."jumps witihn code space" @@ -5369,6 +5380,12 @@ CogARMv8Compiler >> nameForRegister: reg [ "" [default] ] +{ #category : 'testing' } +CogARMv8Compiler >> needsFFIFullCallInRegisterTrampoline [ + + ^ true +] + { #category : 'assembler' } CogARMv8Compiler >> negateSize: is64Bits sourceRegister: sourceRegister sourceRegisterShiftType: immediate2bitShiftType sourceRegisterShift: immediate6bitsShiftValue destinationRegister: destinationRegister [ diff --git a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st index 8678026688..527ab2141d 100644 --- a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st +++ b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st @@ -813,16 +813,18 @@ CogAbstractInstruction >> genFFISameThreadCall: anExternalFunctionAddress [ { #category : 'sameThread callout - optimizations' } CogAbstractInstruction >> genFFISameThreadCall: anExternalFunctionAddress handlesExtraDoubleArgument: handlesExtraDoubleArgument [ - "Change to C Stack, pushing LinkRegistry if needed" - cogit genSmalltalkToCStackSwitch: true. - - self prepareStackForFFICall: handlesExtraDoubleArgument. + "This trampoline is used to have a fixed point where all the calls to FFI methods can return. + This is needed because if we do a FFI call that is reentrant in the interpreter, the machine code method that has perform the call might move or disappear. + Producing a crash when returning from the FFI call. + As the affected return address is in the C stack, it will not be handled by the code compaction code. + So, we need a trampoline, so the return IP is in the top of a Machine Code Pharo Stack, and it is correctly patched." + + "Check SimpleStackBasedCogit>>#generateSameThreadCalloutTrampolines" + + cogit MoveCw: anExternalFunctionAddress R: Extra0Reg. + cogit CallFullRT: (cogit getFFIFullCallInRegisterTrampoline: handlesExtraDoubleArgument). - cogit CallFullRT: anExternalFunctionAddress. - self genLoadStackPointers. - self hasLinkRegister - ifTrue: [cogit PopR: LinkReg]. ] { #category : 'abstract instructions' } diff --git a/smalltalksrc/VMMaker/CogIA32Compiler.class.st b/smalltalksrc/VMMaker/CogIA32Compiler.class.st index c8d1a279a3..02a058342f 100644 --- a/smalltalksrc/VMMaker/CogIA32Compiler.class.st +++ b/smalltalksrc/VMMaker/CogIA32Compiler.class.st @@ -3804,6 +3804,12 @@ CogIA32Compiler >> mod: mod RM: regMode RO: regOpcode [ ^mod << 6 + (regOpcode << 3) + regMode ] +{ #category : 'testing' } +CogIA32Compiler >> needsFFIFullCallInRegisterTrampoline [ + + ^ false +] + { #category : 'feature detection' } CogIA32Compiler >> numCheckFeaturesOpcodes [ "Answer the number of opcodes required to compile the CPUID call to extract the extended features information." diff --git a/smalltalksrc/VMMaker/CogX64Compiler.class.st b/smalltalksrc/VMMaker/CogX64Compiler.class.st index 2dda77e41c..fbaf294e21 100644 --- a/smalltalksrc/VMMaker/CogX64Compiler.class.st +++ b/smalltalksrc/VMMaker/CogX64Compiler.class.st @@ -4553,6 +4553,12 @@ CogX64Compiler >> nameForRegister: reg [ "" ifFalse: [default] ] +{ #category : 'testing' } +CogX64Compiler >> needsFFIFullCallInRegisterTrampoline [ + + ^ true +] + { #category : 'accessing' } CogX64Compiler >> numIntRegArgs [ ^SysV ifTrue: [6] ifFalse: [4] diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index ced978a373..cdd747bf11 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -1236,8 +1236,8 @@ Cogit class >> notesAndQueries [ { #category : 'accessing' } Cogit class >> numTrampolines [ - ^39 "31 + 4 each for self and super sends" - + ^ 41 + "self withAllSubclasses collect: [:c| {c. (c instVarNames select: [:ea| ea beginsWith: 'ce']) size}]" ] diff --git a/smalltalksrc/VMMaker/ManifestVMMaker.class.st b/smalltalksrc/VMMaker/ManifestVMMaker.class.st index 97d3f353e1..6e98f4036b 100644 --- a/smalltalksrc/VMMaker/ManifestVMMaker.class.st +++ b/smalltalksrc/VMMaker/ManifestVMMaker.class.st @@ -6,6 +6,13 @@ Class { #tag : 'Manifest' } +{ #category : 'code-critics' } +ManifestVMMaker class >> ruleBadMessageRule2V1FalsePositive [ + + + ^ #(#(#(#RGClassDefinition #(#CogARMv8Compiler)) #'2025-06-18T18:28:03.188809+02:00') ) +] + { #category : 'code-critics' } ManifestVMMaker class >> ruleCodeCruftLeftInMethodsRuleV1FalsePositive [ @@ -24,7 +31,7 @@ ManifestVMMaker class >> ruleExcessiveArgumentsRuleV1FalsePositive [ ManifestVMMaker class >> ruleLongMethodsRuleV1FalsePositive [ - ^ #(#(#(#RGClassDefinition #(#DruidJIT)) #'2023-04-26T00:25:44.408297+02:00') #(#(#RGMethodDefinition #(#CogObjectRepresentationForSpur #genGetClassObjectOf:into:scratchReg:instRegIsReceiver: #false)) #'2024-03-20T14:24:36.77799+01:00') ) + ^ #(#(#(#RGClassDefinition #(#DruidJIT)) #'2023-04-26T00:25:44.408297+02:00') #(#(#RGMethodDefinition #(#CogObjectRepresentationForSpur #genGetClassObjectOf:into:scratchReg:instRegIsReceiver: #false)) #'2024-03-20T14:24:36.77799+01:00') #(#(#RGClassDefinition #(#SimpleStackBasedCogit)) #'2025-06-18T18:28:40.088111+02:00') ) ] { #category : 'code-critics' } @@ -38,5 +45,5 @@ ManifestVMMaker class >> ruleTempsReadBeforeWrittenRuleV1FalsePositive [ ManifestVMMaker class >> ruleUncommonMessageSendRuleV1FalsePositive [ - ^ #(#(#(#RGClassDefinition #(#DruidJIT)) #'2023-04-26T00:25:40.525381+02:00') #(#(#RGClassDefinition #(#Cogit)) #'2023-11-14T14:51:46.485495+01:00') #(#(#RGMethodDefinition #(#CogObjectRepresentationForSpur #genGetClassObjectOfClassIndex:into:scratchReg: #false)) #'2024-03-20T12:06:14.044383+01:00') #(#(#RGMethodDefinition #(#CogObjectRepresentationForSpur #genGetClassObjectOf:into:scratchReg:instRegIsReceiver: #false)) #'2024-03-20T12:09:37.299869+01:00') #(#(#RGMethodDefinition #(#CogObjectRepresentation #genPrimitiveFormat #false)) #'2024-03-21T10:01:25.937395+01:00') #(#(#RGClassDefinition #(#StackToRegisterMappingCogit)) #'2024-08-21T15:58:49.593558+02:00') ) + ^ #(#(#(#RGClassDefinition #(#DruidJIT)) #'2023-04-26T00:25:40.525381+02:00') #(#(#RGClassDefinition #(#Cogit)) #'2023-11-14T14:51:46.485495+01:00') #(#(#RGMethodDefinition #(#CogObjectRepresentationForSpur #genGetClassObjectOfClassIndex:into:scratchReg: #false)) #'2024-03-20T12:06:14.044383+01:00') #(#(#RGMethodDefinition #(#CogObjectRepresentationForSpur #genGetClassObjectOf:into:scratchReg:instRegIsReceiver: #false)) #'2024-03-20T12:09:37.299869+01:00') #(#(#RGMethodDefinition #(#CogObjectRepresentation #genPrimitiveFormat #false)) #'2024-03-21T10:01:25.937395+01:00') #(#(#RGClassDefinition #(#StackToRegisterMappingCogit)) #'2024-08-21T15:58:49.593558+02:00') #(#(#RGClassDefinition #(#SimpleStackBasedCogit)) #'2025-06-18T18:27:45.211828+02:00') #(#(#RGClassDefinition #(#CogAbstractInstruction)) #'2025-06-18T18:28:20.068642+02:00') ) ] diff --git a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st index de3253742f..61229eb0dd 100644 --- a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st +++ b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st @@ -14,7 +14,9 @@ Class { 'introspectionDataIndex', 'introspectionData', 'ceSameThreadCalloutTrampoline', - 'ceFallbackInvalidFFICallTrampoline' + 'ceFallbackInvalidFFICallTrampoline', + 'ceFFIFullCallInRegisterTrampoline', + 'ceFFIFullCallInRegisterTrampolineWithExtraArgument' ], #pools : [ 'VMClassIndices', @@ -2848,7 +2850,10 @@ SimpleStackBasedCogit >> generateSameThreadCalloutTrampolines [ genTrampolineFor: #ceFallbackInvalidFFICall called: - 'ceFallbackInvalidFFICallTrampoline' + 'ceFallbackInvalidFFICallTrampoline'. + + ceFFIFullCallInRegisterTrampoline := self maybeGenerateFFIFullCallInRegisterTrampoline: false. + ceFFIFullCallInRegisterTrampolineWithExtraArgument := self maybeGenerateFFIFullCallInRegisterTrampoline: true. ] { #category : 'initialization' } @@ -2873,6 +2878,14 @@ SimpleStackBasedCogit >> generateTracingTrampolines [ regsToSave: CallerSavedRegisterMask. ] +{ #category : 'accessing' } +SimpleStackBasedCogit >> getFFIFullCallInRegisterTrampoline: handlesExtraDoubleArgument [ + + ^ handlesExtraDoubleArgument + ifTrue: [ ceFFIFullCallInRegisterTrampolineWithExtraArgument ] + ifFalse: [ ceFFIFullCallInRegisterTrampoline ] +] + { #category : 'accessing' } SimpleStackBasedCogit >> getFallbackInvalidFFICallTrampoline [ @@ -2957,6 +2970,83 @@ SimpleStackBasedCogit >> maybeCompileAllocFillerCheck [ jmpOk jmpTarget: self Label] ] +{ #category : 'initialization' } +SimpleStackBasedCogit >> maybeGenerateFFIFullCallInRegisterTrampoline: handlesExtraDoubleArgument [ + + "This trampoline is used to have a fixed point where all the calls to FFI methods can return. + This is needed because if we do a FFI call that is reentrant in the interpreter, the machine code method that has perform the call might move or disappear. + Producing a crash when returning from the FFI call. + As the affected return address is in the C stack, it will not be handled by the code compaction code. + So, we need a trampoline, so the return IP is in the top of a Machine Code Pharo Stack, and it is correctly patched. + We need two flavors of this trampoline, as Win64 requires to handle the an extra double argument in the stack" + + | startAddress | + + + + backEnd needsFFIFullCallInRegisterTrampoline + ifFalse: [ ^ 0 ]. + + self allocateOpcodes: 15 bytecodes: 0. + + "We need to ensure that the Extra0Reg is not in conflict with the registers used for the calling convention" + backEnd cArg0Register = Extra0Reg ifTrue: [ self error: 'Cannot generate ceFFIFullCallInRegisterTrampoline. Extra0Reg collides with cArg0Register' ]. + backEnd cArg1Register = Extra0Reg ifTrue: [ self error: 'Cannot generate ceFFIFullCallInRegisterTrampoline. Extra0Reg collides with cArg1Register' ]. + backEnd cArg2Register = Extra0Reg ifTrue: [ self error: 'Cannot generate ceFFIFullCallInRegisterTrampoline. Extra0Reg collides with cArg2Register' ]. + backEnd cArg3Register = Extra0Reg ifTrue: [ self error: 'Cannot generate ceFFIFullCallInRegisterTrampoline. Extra0Reg collides with cArg3Register' ]. + + "If we don't have LinkRegister, we need an extra register, that should not conflict with the calling convetion" + (backEnd hasLinkRegister) ifFalse: [ + backEnd cArg0Register = Extra2Reg ifTrue: [ self error: 'Cannot generate ceFFIFullCallInRegisterTrampoline. Extra2Reg collides with cArg0Register' ]. + backEnd cArg1Register = Extra2Reg ifTrue: [ self error: 'Cannot generate ceFFIFullCallInRegisterTrampoline. Extra2Reg collides with cArg1Register' ]. + backEnd cArg2Register = Extra2Reg ifTrue: [ self error: 'Cannot generate ceFFIFullCallInRegisterTrampoline. Extra2Reg collides with cArg2Register' ]. + backEnd cArg3Register = Extra2Reg ifTrue: [ self error: 'Cannot generate ceFFIFullCallInRegisterTrampoline. Extra2Reg collides with cArg3Register' ] + ]. + + startAddress := methodZoneBase. + + "We are not pushing the return IP to the stack. + We need to store it in the instructionPointer variable. If we are coming back into the interpreter in a callback, the ptEnterInterpreterFromCallback + assumes that the return IP is in the variable, and will put it in the stack so it can be remapped. + + We need to use an extra register if we don't have LinkReg or PC register" + + backEnd hasLinkRegister + ifTrue: + [self MoveR: LinkReg Aw: coInterpreter instructionPointerAddress] + ifFalse: + [self PopR: Extra2Reg. "instruction pointer" + self MoveR: Extra2Reg Aw: coInterpreter instructionPointerAddress]. + + self genSmalltalkToCStackSwitch: false. + + backEnd prepareStackForFFICall: handlesExtraDoubleArgument. + + self CallR: Extra0Reg. + + backEnd genLoadStackPointers. + + (backEnd hasLinkRegister) + ifTrue: + [backEnd hasPCRegister + ifTrue: [self MoveAw: coInterpreter instructionPointerAddress R: PCReg] + ifFalse: [ + self MoveAw: coInterpreter instructionPointerAddress R: LinkReg. + self RetN: 0]] + ifFalse: [ + self MoveAw: coInterpreter instructionPointerAddress R: Extra2Reg. + self PushR: Extra2Reg. + self RetN: 0]. + + self outputInstructionsForGeneratedRuntimeAt: startAddress. + + self recordGeneratedRunTime: (handlesExtraDoubleArgument + ifTrue: [ 'ceFFIFullCallInRegisterTrampolineWithExtraArgument' ] + ifFalse: [ 'ceFFIFullCallInRegisterTrampoline' ]) address: startAddress. + + ^ startAddress. +] + { #category : 'trampolines' } SimpleStackBasedCogit >> methodAbortTrampolineFor: numArgs [ ^ceMethodAbortTrampoline diff --git a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st index 01cd6680db..d12fe64a9e 100644 --- a/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornARMv8Simulator.class.st @@ -502,6 +502,12 @@ UnicornARMv8Simulator >> x20 [ ^ self readRegister: UcARM64Registers x20 ] +{ #category : 'accessing' } +UnicornARMv8Simulator >> x21: anInteger [ + + ^ self writeRegister: UcARM64Registers x21 value: anInteger +] + { #category : 'accessing-registers-physical' } UnicornARMv8Simulator >> x22 [ diff --git a/smalltalksrc/VMMakerTests/UnicornProcessor.class.st b/smalltalksrc/VMMakerTests/UnicornProcessor.class.st index f4e64cefb3..f8b3336afc 100644 --- a/smalltalksrc/VMMakerTests/UnicornProcessor.class.st +++ b/smalltalksrc/VMMakerTests/UnicornProcessor.class.st @@ -198,6 +198,12 @@ UnicornProcessor >> r11: anInteger [ machineSimulator r11: anInteger ] +{ #category : 'registers' } +UnicornProcessor >> r12: anInteger [ + + machineSimulator r12: anInteger +] + { #category : 'registers' } UnicornProcessor >> r1: anInteger [ @@ -453,6 +459,12 @@ UnicornProcessor >> x1: anInteger [ machineSimulator x1: anInteger ] +{ #category : 'accessing' } +UnicornProcessor >> x21: anInteger [ + + machineSimulator x21: anInteger +] + { #category : 'as yet unclassified' } UnicornProcessor >> x22: anInteger [ diff --git a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st index 15b5437043..3ed675d350 100644 --- a/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -913,6 +913,65 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleD self assert: receivedArguments fifth equals: 55.0. ] +{ #category : 'tests - pointer double double double double void' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleDoubleToVoidGoesToExtraArgTrampoline [ + + | compiledMethod cogMethod tfExternalFunction called receivedArguments argumentTypes anExternalAddress | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + called := false. + + argumentTypes := { interpreter libFFI pointer. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double. interpreter libFFI double }. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:ptr ":dbl1 :dbl2 :dbl3 :dbl4 Double Parameters are not handled by our simulation" | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. + 0 ] + withArgumentTypes: argumentTypes + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: (memory floatObjectOf: 23.5); + literalAt: 3 put: (memory floatObjectOf: 42.0); + literalAt: 4 put: (memory floatObjectOf: 99.5); + literalAt: 5 put: (memory floatObjectOf: 55.0); + literalAt: 6 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 34 "PushLiteral 2" + 35 "PushLiteral 3" + 36 "PushLiteral 4" + 37 "PushLiteral 5" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: (cogit getFFIFullCallInRegisterTrampoline: true). + + self assert: machineSimulator pc equals: (cogit getFFIFullCallInRegisterTrampoline: true) +] + { #category : 'tests - pointer double double double void' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleToVoid [ @@ -1204,6 +1263,53 @@ VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidAllowinOopsWi self assert: receivedArguments first equals: aByteArray + BaseHeaderSize ] +{ #category : 'tests - pointer to void (Opt)' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidCallsThroughTrampoline [ + + | compiledMethod cogMethod tfExternalFunction changedStack anExternalAddress | + + isa = #IA32 ifTrue: [ ^ self skip ]. + + changedStack := false. + + "I need to return 0 in the function, even if it is void, as the simulation cannot identify when it is a + void returning function " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + self assertIsOptimizedCall: tfExternalFunction. + changedStack := (machineSimulator stackPointerRegisterValue bitAnd: 16rFFFFFF00) = (cogit getCStackPointer bitAnd: 16rFFFFFF00). + 0 ] + withArgumentTypes: { interpreter libFFI pointer } + withReturnType: interpreter libFFI void + flags: FFI_FLAG_USE_OPTIMIZED_VERSION | FFI_FLAG_POINTERS_MIGHT_BE_EXTERNAL_ADDRESSES. + + anExternalAddress := self newExternalAddress: 17. + + compiledMethod := methodBuilder + newMethod; + literalAt: 0 put: tfExternalFunction; + literalAt: 1 put: anExternalAddress; + literalAt: 2 put: memory nilObject; "Class Binding" + bytecodes: #[ + 33 "PushLiteral 1" + 230 0 "SameThreadCallout Literal0" + 88 "ReturnReceiver"]; + buildMethod. + + cogMethod := cogit cog: compiledMethod selector: memory nilObject. + + self deny: cogMethod isNil. + + self + callCogMethod: cogMethod + receiver: (memory integerObjectOf: 23) + arguments: { } + returnAddress: (cogit getFFIFullCallInRegisterTrampoline: false). + + self assert: machineSimulator instructionPointerRegisterValue equals: (cogit getFFIFullCallInRegisterTrampoline: false). + +] + { #category : 'tests - pointer to void (Opt)' } VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidChangesStack [ diff --git a/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st b/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st index 15809e206f..b240a7ffa1 100644 --- a/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st @@ -131,7 +131,7 @@ VMSimpleStackBasedCogitAbstractTest >> callCogMethod: callingMethod receiver: re self prepareCall. machineSimulator instructionPointerRegisterValue: callingMethod address + cogit noCheckEntryOffset. - + self runFrom: callingMethod address + cogit noCheckEntryOffset until: returnAddress. ]