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 [ diff --git a/smalltalksrc/Melchor/VMClass.class.st b/smalltalksrc/Melchor/VMClass.class.st index 1dd12ee7a9..4d75e221c8 100644 --- a/smalltalksrc/Melchor/VMClass.class.st +++ b/smalltalksrc/Melchor/VMClass.class.st @@ -710,6 +710,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/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 72833e389c..7eef94b23e 100644 --- a/smalltalksrc/Slang/CCodeGenerator.class.st +++ b/smalltalksrc/Slang/CCodeGenerator.class.st @@ -5289,7 +5289,8 @@ CCodeGenerator >> validateLocalizationOfGlobals: varList exceptMethod: methodNam methodFreeVariables := meth freeVariableReferences asSet. localizationCandidates do: [ :candidate | (methodFreeVariables includes: candidate) - ifTrue: [ variablesInConflict add: candidate ] ] ] ]. + ifTrue: [ + variablesInConflict add: candidate ] ] ] ]. variablesInConflict ifNotEmpty: [ | errorMessage | errorMessage := String streamContents: [ :stream | 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' } diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index 0557825351..9ba0394394 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -1201,6 +1201,28 @@ CoInterpreter >> ceCounterTripped: condition [ ^true ] +{ #category : 'trampolines' } +CoInterpreter >> ceFallbackInvalidFFICall [ + + + instructionPointer := self popStack. + ^ self ceFallbackInvalidFFICall: instructionPointer +] + +{ #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 [ @@ -1428,6 +1450,44 @@ CoInterpreter >> ceReturnToInterpreter: anOop [ self unreachable ] +{ #category : 'trampolines' } +CoInterpreter >> ceSameThreadCalloutWithLiteralIndex: functionDefinitionIndex [ + + + + + | cogMethod functionDefinition externalFunction cif returnValue | + + instructionPointer := self popStack. + + self assert: stackPointer < framePointer. + + 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: instructionPointer ]. + + cif := self getHandlerAsCif: (objectMemory fetchPointer: 1 ofObject: functionDefinition). + + cif ifNil: [ + self logDebug: 'Invalid CIF in ExternalFunction'. + ^ self ceFallbackInvalidFFICall: instructionPointer ] . + + self doSameThreadCalloutBytecodeFor: externalFunction andCif: cif. + + self failed + ifTrue: [ ^ self ceFallbackInvalidFFICall: instructionPointer ]. + + returnValue := cif returnType type = FFI_TYPE_VOID ifTrue: [ 0 ] ifFalse: [ self popStack ]. + + self push: instructionPointer. + + ^ 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/CogARMCompiler.class.st b/smalltalksrc/VMMaker/CogARMCompiler.class.st index e40373fba4..f27f0cbdc8 100644 --- a/smalltalksrc/VMMaker/CogARMCompiler.class.st +++ b/smalltalksrc/VMMaker/CogARMCompiler.class.st @@ -438,6 +438,34 @@ CogARMCompiler >> byteReadsZeroExtend [ ^true ] +{ #category : 'abi' } +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." @@ -511,7 +539,8 @@ CogARMCompiler >> computeMaximumSize [ [Fill32] -> [^4]. [Nop] -> [^4]. "Control" - [Call] -> [^4]. + [Call] -> [^4]. + [CallR] -> [^4]. [CallFull] -> [^self literalLoadInstructionBytes + 4]. [JumpR] -> [^4]. [Jump] -> [^4]. @@ -862,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." @@ -1907,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" @@ -2980,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 755eb70b68..1f6cf75f7b 100644 --- a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st +++ b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st @@ -844,6 +844,34 @@ CogARMv8Compiler >> byteReadsZeroExtend [ ^true ] +{ #category : 'abi' } +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." @@ -1000,6 +1028,7 @@ CogARMv8Compiler >> computeMaximumSize [ "Control" [Call] -> [^4]. [CallFull] -> [^self literalLoadInstructionBytes + 4]. + [CallR] -> [^4]. [JumpR] -> [^4]. [Jump] -> [^4]. [JumpFull] -> [^self literalLoadInstructionBytes + 4]. @@ -1590,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 [ @@ -3414,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" @@ -5341,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 376c57c8d6..527ab2141d 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,13 +66,20 @@ Class { #pools : [ 'CogAbstractRegisters', 'CogCompilationConstants', - 'CogRTLOpcodes' + 'CogRTLOpcodes', + 'LibFFIConstants' ], #category : 'VMMaker-JIT', #package : 'VMMaker', #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." @@ -533,6 +541,34 @@ CogAbstractInstruction >> byteReadsZeroExtend [ ^false ] +{ #category : 'accessing' } +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." @@ -617,7 +653,8 @@ CogAbstractInstruction >> codeGranularity [ CogAbstractInstruction >> cogit: aCogit [ cogit := aCogit. - objectMemory := aCogit objectMemory + objectMemory := aCogit objectMemory. + objectRepresentation := aCogit objectRepresentation. ] { #category : 'generate machine code' } @@ -752,6 +789,44 @@ 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 [ + + ^ self + genFFISameThreadCall: anExternalFunctionAddress + handlesExtraDoubleArgument: false +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genFFISameThreadCall: anExternalFunctionAddress handlesExtraDoubleArgument: 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). + + +] + { #category : 'abstract instructions' } CogAbstractInstruction >> genJumpFPEqual: jumpTarget [ @@ -831,6 +906,33 @@ CogAbstractInstruction >> genLoadStackPointers [ self subclassResponsibility ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genMarshallDoubleArgumentInReg: reg errorRoutineLabel: errorRoutine withFlags: flags [ + + | jumpIfNotFloat | + + 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 @@ -865,6 +967,90 @@ 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 >> 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 [ + + | 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 >> genMoveM32: offset r: baseReg R: destReg [ @@ -883,6 +1069,211 @@ CogAbstractInstruction >> genMulR: regSource R: regDest [ self subclassResponsibility ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutDoubleVoidFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallDoubleArgumentIndex: 1 fullIndex: 1 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_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 ]. + + 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 genMarshallDoubleArgumentIndex: 4 fullIndex: 5 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 + handlesExtraDoubleArgument: true. + + ^ true +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerDoubleDoubleDoubleVoidFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + 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. + + ^ true +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerDoubleDoubleVoidFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + 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. + + ^ true +] + +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> genOptimizedSameThreadCalloutPointerPointerFor: anExternalFunctionAddress withFlags: flags [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallPointerArgumentIndex: 1 fullIndex: 1 errorRoutineLabel: errorRoutine withFlags: flags. + + self genFFISameThreadCall: anExternalFunctionAddress. + + self genMarshallReturnPointer: errorRoutine. + + ^ 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 [ + + | errorRoutine | + cogit ssFlushStack. + + errorRoutine := self genFFIFallbackCall. + + self genMarshallPointerArgumentIndex: 1 fullIndex: 1 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 @@ -1084,6 +1475,92 @@ 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 [ + + + + + (cif nargs = 1 and: [ + (cif arg_types at: 0) type = arg0Type and: [ + 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." @@ -1453,6 +1930,12 @@ CogAbstractInstruction >> outputMachineCodeAt: targetAddress [ objectMemory byteAt: targetAddress + j put: (machineCode at: j)] ] +{ #category : 'sameThread callout - optimizations' } +CogAbstractInstruction >> prepareStackForFFICall: handlesExtraDoubleArgument [ + + +] + { #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..02a058342f 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 [ @@ -3795,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/CogObjectRepresentationForSpur.class.st b/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st index e81ce2c68b..1275d3230e 100644 --- a/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st +++ b/smalltalksrc/VMMaker/CogObjectRepresentationForSpur.class.st @@ -362,7 +362,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. @@ -1254,6 +1255,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. + + cogit genPrimReturn. + + jumpImmediate jmpTarget: + (jumpNonPinned jmpTarget: + (jumpFailAlloc jmpTarget: cogit Label)). + + ^ 0 +] + { #category : 'primitive generators' } CogObjectRepresentationForSpur >> genPrimitiveIdenticalOrNotIf: orNot [ | jumpCmp comp | @@ -1625,9 +1650,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 @@ -1639,9 +1666,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/CogVMSimulator.class.st b/smalltalksrc/VMMaker/CogVMSimulator.class.st index f5ba6d5d78..7182b08a11 100644 --- a/smalltalksrc/VMMaker/CogVMSimulator.class.st +++ b/smalltalksrc/VMMaker/CogVMSimulator.class.st @@ -459,6 +459,7 @@ CogVMSimulator >> cr [ { #category : 'debug support' } CogVMSimulator >> debugStackPointersFor: aMethod [ + ^CArrayAccessor on: (StackDepthFinder on: (VMCompiledMethodProxy new for: aMethod diff --git a/smalltalksrc/VMMaker/CogX64Compiler.class.st b/smalltalksrc/VMMaker/CogX64Compiler.class.st index 24c964b20f..fbaf294e21 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. @@ -356,6 +364,34 @@ CogX64Compiler >> availableRegisterOrNoneFor: liveRegsMask [ ^super availableRegisterOrNoneFor: liveRegsMask ] +{ #category : 'accessing' } +CogX64Compiler >> cArg0Register [ + + + ^ Arg0Reg +] + +{ #category : 'accessing' } +CogX64Compiler >> cArg1Register [ + + + ^ Arg1Reg +] + +{ #category : 'accessing' } +CogX64Compiler >> cArg2Register [ + + + ^ Arg2Reg +] + +{ #category : 'accessing' } +CogX64Compiler >> cArg3Register [ + + + ^ Arg3Reg +] + { #category : 'abi' } CogX64Compiler >> cFloatResultToRd: reg [ XMM0L ~= reg ifTrue: [ @@ -3756,6 +3792,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 @@ -3878,6 +3945,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 | @@ -4466,6 +4553,12 @@ CogX64Compiler >> nameForRegister: reg [ "" ifFalse: [default] ] +{ #category : 'testing' } +CogX64Compiler >> needsFFIFullCallInRegisterTrampoline [ + + ^ true +] + { #category : 'accessing' } CogX64Compiler >> numIntRegArgs [ ^SysV ifTrue: [6] ifFalse: [4] @@ -4488,6 +4581,24 @@ CogX64Compiler >> padIfPossibleWithStopsFrom: startAddr to: endAddr [ self stopsFrom: startAddr to: endAddr ] +{ #category : 'sameThread callout - optimizations' } +CogX64Compiler >> prepareStackForFFICall: handlesExtraDoubleArgument [ + + "WIN64 ABI allways reserve shadow space on the stack for callee to save up to 4 register parameters" + 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' } CogX64Compiler >> prepareStackToCallCFunctionInSmalltalkStack: anInteger [ diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index 7f0e74b5fd..cdd747bf11 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -847,7 +847,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: @@ -1136,6 +1136,9 @@ Cogit class >> initializePrimitiveTable [ (657 genPrimitiveStoreChar32IntoExternalAddress) (658 genPrimitiveStoreFloat32IntoExternalAddress) (659 genPrimitiveStoreFloat64IntoExternalAddress) + + (660 genPrimitiveGetAddressOfOOPPinningIfNeeded) + ) ] @@ -1233,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}]" ] @@ -8066,12 +8069,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/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 +] 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/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/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/LibFFIType.class.st b/smalltalksrc/VMMaker/LibFFIType.class.st index e77a9d5d13..5c2ee791e6 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 @@ -113,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 @@ -143,6 +156,18 @@ LibFFIType >> marshallToSmalltalk: holder [ ] +{ #category : 'simulating' } +LibFFIType >> marshallToSmalltalkFromByteArray: aByteArray [ + + ^ [ type ] + caseOf: { + [ FFI_TYPE_DOUBLE ] -> [ aByteArray float64AtOffset: 0 ]. + [ FFI_TYPE_POINTER ] -> [ aByteArray integerAt: 1 size: size signed: false ]. + } + otherwise: [ self halt ] + +] + { #category : 'accessing' } LibFFIType >> size [ ^ 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 b1190d444b..61229eb0dd 100644 --- a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st +++ b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st @@ -12,7 +12,11 @@ Class { 'externalPrimJumpOffsets', 'externalSetPrimOffsets', 'introspectionDataIndex', - 'introspectionData' + 'introspectionData', + 'ceSameThreadCalloutTrampoline', + 'ceFallbackInvalidFFICallTrampoline', + 'ceFFIFullCallInRegisterTrampoline', + 'ceFFIFullCallInRegisterTrampolineWithExtraArgument' ], #pools : [ 'VMClassIndices', @@ -28,7 +32,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 +73,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 +284,26 @@ SimpleStackBasedCogit >> ceCPICMissTrampoline: anAddress [ ceCPICMissTrampoline := anAddress ] +{ #category : 'accessing' } +SimpleStackBasedCogit >> ceFallbackInvalidFFICallTrampoline [ + + ^ ceFallbackInvalidFFICallTrampoline +] + +{ #category : 'accessing' } +SimpleStackBasedCogit >> ceSameThreadCalloutTrampoline [ + + + ^ ceSameThreadCalloutTrampoline +] + +{ #category : 'accessing' } +SimpleStackBasedCogit >> ceSameThreadCalloutTrampoline: anAddress [ + + + ceSameThreadCalloutTrampoline := anAddress +] + { #category : 'simulation only' } SimpleStackBasedCogit >> ceShortCutTraceBlockActivation: aProcessorSimulationTrap [ self shortcutTrampoline: aProcessorSimulationTrap @@ -2798,6 +2828,34 @@ 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. + + ceFallbackInvalidFFICallTrampoline := self + genTrampolineFor: + #ceFallbackInvalidFFICall + called: + 'ceFallbackInvalidFFICallTrampoline'. + + ceFFIFullCallInRegisterTrampoline := self maybeGenerateFFIFullCallInRegisterTrampoline: false. + ceFFIFullCallInRegisterTrampolineWithExtraArgument := self maybeGenerateFFIFullCallInRegisterTrampoline: true. +] + { #category : 'initialization' } SimpleStackBasedCogit >> generateTracingTrampolines [ "Generate trampolines for tracing. In the simulator we can save a lot of time @@ -2820,6 +2878,20 @@ SimpleStackBasedCogit >> generateTracingTrampolines [ regsToSave: CallerSavedRegisterMask. ] +{ #category : 'accessing' } +SimpleStackBasedCogit >> getFFIFullCallInRegisterTrampoline: handlesExtraDoubleArgument [ + + ^ handlesExtraDoubleArgument + ifTrue: [ ceFFIFullCallInRegisterTrampolineWithExtraArgument ] + ifFalse: [ ceFFIFullCallInRegisterTrampoline ] +] + +{ #category : 'accessing' } +SimpleStackBasedCogit >> getFallbackInvalidFFICallTrampoline [ + + ^ ceFallbackInvalidFFICallTrampoline +] + { #category : 'register management' } SimpleStackBasedCogit >> isCallerSavedReg: reg [ @@ -2898,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/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index b6811c576d..e3fc565352 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -880,6 +880,8 @@ SpurMemoryManager class >> initializeSpecialObjectIndices [ ClassExternalAddress := 43. + SelectorInvalidFFICall := 44. + SelectorAboutToReturn := 48. SelectorRunWithIn := 49. @@ -10536,6 +10538,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/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 1d25da78b0..cb55e7b9e3 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -725,7 +725,7 @@ StackInterpreter class >> initializeBytecodeTableForSistaV1 [ (227 extPushLiteralVariableBytecode) (228 extPushLiteralBytecode) (229 longPushTemporaryVariableBytecode) - (230 unknownBytecode) + (230 sameThreadCalloutBytecode) (231 pushNewArrayBytecode) (232 extPushIntegerBytecode) (233 extPushCharacterBytecode) @@ -993,7 +993,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. @@ -1390,7 +1390,8 @@ StackInterpreter class >> initializePrimitiveTable [ (658 primitiveStoreFloat32IntoExternalAddress) (659 primitiveStoreFloat64IntoExternalAddress) - (660 primitiveFail) + (660 primitiveGetAddressOfOOPPinningIfNeeded) + (661 primitiveFail) ) ] @@ -5053,6 +5054,72 @@ StackInterpreter >> doRecordSendTrace [ cr ] ] +{ #category : 'FFI bytecode' } +StackInterpreter >> doSameThreadCalloutBytecodeFor: externalFunction andCif: cif [ + + + + + + + + + + | argumentSize parameters returnHolder | + + self initPrimCall. + + 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 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. + + " 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 @@ -5661,6 +5728,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." @@ -7000,6 +7080,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." @@ -9700,6 +9803,7 @@ StackInterpreter >> marryFrame: theFP SP: theSP copyTemps: copyTemps [ + | theContext methodHeader closureOrNil numSlots numArgs numStack numTemps | self assert: (self frameHasContext: theFP) not. @@ -13347,6 +13451,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 e61d041f2a..5a31bf7d49 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -128,8 +128,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: [ @@ -220,7 +224,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: [ @@ -300,27 +308,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 [ @@ -383,6 +370,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 [ + @@ -412,80 +411,125 @@ 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 **'. + + externalAddressOrOop = objectMemory nilObject + ifTrue: [ + pointerHolder at: 0 put: 0. + ^ 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) ] +] + +{ #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 ]. @@ -495,11 +539,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 ]. @@ -509,11 +553,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 ]. @@ -523,26 +567,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: [ @@ -564,11 +607,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 ]. @@ -578,11 +621,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 ]. @@ -592,11 +635,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 ]. @@ -607,11 +650,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 ]. @@ -1437,6 +1479,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 [ @@ -3965,13 +4038,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. @@ -3999,11 +4077,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 e188ade148..ec4044fc6e 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 isMapped) (2 231 231 genPushNewArrayBytecode) (2 232 232 genExtPushIntegerBytecode needsFrameNever: 1) (2 233 233 genExtPushCharacterBytecode needsFrameNever: 1) @@ -2433,6 +2434,45 @@ StackToRegisterMappingCogit >> genReturnTopFromMethod [ ^self genUpArrowReturn ] +{ #category : 'bytecode generators' } +StackToRegisterMappingCogit >> genSameThreadCalloutBytecode [ + + | 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 + genOptimizedSameThreadCalloutFor: cif + flags: flags + 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. + + "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 ]. + + ^ 0 +] + { #category : 'bytecode generator support' } StackToRegisterMappingCogit >> genSend: selectorIndex numArgs: numArgs [ self marshallSendArguments: numArgs. diff --git a/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st b/smalltalksrc/VMMakerTests/ProcessorSimulator.class.st index ee5577e653..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' } @@ -327,6 +298,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..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 [ @@ -194,6 +200,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 50b83cf1f2..d12fe64a9e 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 [ @@ -123,6 +129,12 @@ UnicornARMv8Simulator >> doublePrecisionFloatingPointRegister2 [ ^ UcARM64Registers d2 ] +{ #category : 'accessing-registers-abstract' } +UnicornARMv8Simulator >> doublePrecisionFloatingPointRegister3 [ + + ^ UcARM64Registers d3 +] + { #category : 'disassembling' } UnicornARMv8Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction [ @@ -170,6 +182,12 @@ UnicornARMv8Simulator >> instructionPointerRegister [ ^ UcARM64Registers pc ] +{ #category : 'as yet unclassified' } +UnicornARMv8Simulator >> instructionPointerValue [ + + ^ self instructionPointerRegister value +] + { #category : 'accessing-registers-abstract' } UnicornARMv8Simulator >> linkRegister [ @@ -308,19 +326,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' } @@ -484,12 +502,24 @@ UnicornARMv8Simulator >> x20 [ ^ self readRegister: UcARM64Registers x20 ] +{ #category : 'accessing' } +UnicornARMv8Simulator >> x21: anInteger [ + + ^ self writeRegister: UcARM64Registers x21 value: anInteger +] + { #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/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 68899c7571..f8b3336afc 100644 --- a/smalltalksrc/VMMakerTests/UnicornProcessor.class.st +++ b/smalltalksrc/VMMakerTests/UnicornProcessor.class.st @@ -110,7 +110,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. @@ -194,6 +198,12 @@ UnicornProcessor >> r11: anInteger [ machineSimulator r11: anInteger ] +{ #category : 'registers' } +UnicornProcessor >> r12: anInteger [ + + machineSimulator r12: anInteger +] + { #category : 'registers' } UnicornProcessor >> r1: anInteger [ @@ -449,6 +459,18 @@ UnicornProcessor >> x1: anInteger [ machineSimulator x1: anInteger ] +{ #category : 'accessing' } +UnicornProcessor >> x21: anInteger [ + + machineSimulator x21: 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 053710cf74..f3a88dd0f3 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 : 'machine registers' } UnicornRISCVSimulator >> a0 [ @@ -153,6 +159,12 @@ UnicornRISCVSimulator >> doublePrecisionFloatingPointRegister2 [ ^ UcRISCVRegisters f2 ] +{ #category : 'as yet unclassified' } +UnicornRISCVSimulator >> doublePrecisionFloatingPointRegister3 [ + + ^ UcRISCVRegisters f3 +] + { #category : 'disassembling' } UnicornRISCVSimulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction [ diff --git a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st index fc5d4a2eff..bffac620fc 100644 --- a/smalltalksrc/VMMakerTests/UnicornSimulator.class.st +++ b/smalltalksrc/VMMakerTests/UnicornSimulator.class.st @@ -10,10 +10,19 @@ Class { #tag : 'Unicorn' } -{ #category : 'instance creation' } -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' } @@ -73,6 +82,43 @@ 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: 32 +] + +{ #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/UnicornWinX64Simulator.class.st b/smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st new file mode 100644 index 0000000000..e612bffbd4 --- /dev/null +++ b/smalltalksrc/VMMakerTests/UnicornWinX64Simulator.class.st @@ -0,0 +1,68 @@ +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 ]. + "The fifth argument is in the 6th position, we have the return address, and the FP" + byteArray := self stackValueBytesAt: 6. + ]. + 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 4dfd2f5b9d..4ceebd9948 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 [ @@ -94,6 +100,12 @@ UnicornX64Simulator >> doublePrecisionFloatingPointRegister2 [ ^ UcX86Registers xmm2 ] +{ #category : 'registers' } +UnicornX64Simulator >> doublePrecisionFloatingPointRegister3 [ + + ^ UcX86Registers xmm3 +] + { #category : 'as yet unclassified' } UnicornX64Simulator >> extractDestinationRegisterFromAssembly: aLLVMInstruction [ @@ -139,6 +151,12 @@ UnicornX64Simulator >> instructionPointerRegister [ ^ UcX86Registers rip ] +{ #category : 'as yet unclassified' } +UnicornX64Simulator >> instructionPointerValue [ + + ^ self instructionPointerRegister value +] + { #category : 'as yet unclassified' } UnicornX64Simulator >> integerRegisterState [ @@ -464,7 +482,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/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..74ddf70753 --- /dev/null +++ b/smalltalksrc/VMMakerTests/VMFFISameThreadBytecodeArgumentMarshallingTest.class.st @@ -0,0 +1,143 @@ +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. + +] + +{ #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/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..3ed675d350 --- /dev/null +++ b/smalltalksrc/VMMakerTests/VMJitFFISameThreadCalloutTest.class.st @@ -0,0 +1,1651 @@ +Class { + #name : 'VMJitFFISameThreadCalloutTest', + #superclass : 'VMStackToRegisterMappingCogitTest', + #instVars : [ + 'jitCompilerClass', + 'abi' + ], + #pools : [ + 'LibFFIConstants' + ], + #category : 'VMMakerTests-JitTests', + #package : 'VMMakerTests', + #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 [ + + 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 [ + + cogit processor setFramePointer: interpreter framePointer stackPointer: interpreter stackPointer. + + ^ super callCogMethod: callingMethod receiver: receiver arguments: args returnAddress: returnAddress + +] + +{ #category : 'running' } +VMJitFFISameThreadCalloutTest >> jitCompilerClass [ + + ^ jitCompilerClass ifNil: [ jitCompilerClass := super jitCompilerClass ] +] + +{ #category : 'running' } +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 [ + + super setUp. + + self setUpTrampolines. + self setUpCogMethodEntry. + self createBaseFrame. + + interpreter libFFI: LibFFI new. + interpreter libFFI interpreter: interpreter. + + self installFloatClass. + 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 - general bytecode' } +VMJitFFISameThreadCalloutTest >> testExecutingFunctionCallsExternalFunction [ + + | compiledMethod cogMethod externalFunction tfExternalFunction called | + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ + self assertIsNonOptimizedCall: tfExternalFunction. + 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 - general bytecode' } +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: [ + self assertIsNonOptimizedCall: tfExternalFunction. + 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 - general bytecode' } +VMJitFFISameThreadCalloutTest >> testExecutingFunctionPopsCorrectlyAndReturnsTheResult [ + + | compiledMethod cogMethod externalFunction tfExternalFunction called | + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ :a :b | + self assertIsNonOptimizedCall: tfExternalFunction. + 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 - general bytecode' } +VMJitFFISameThreadCalloutTest >> testExecutingFunctionReturnsCorrectValue [ + + | compiledMethod cogMethod externalFunction tfExternalFunction called | + + called := false. + + tfExternalFunction := self + createExternalFunctionFor: [ + self assertIsNonOptimizedCall: tfExternalFunction. + 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 - general bytecode' } +VMJitFFISameThreadCalloutTest >> testJITCompilesCallToTrampolineByDefault [ + + | compiledMethod cogMethod tfExternalFunction | + tfExternalFunction := self + createExternalFunctionFor: [ self assertIsNonOptimizedCall: tfExternalFunction ] + 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 +] + +{ #category : 'tests - double to void' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionDoubleToVoid [ + + | 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 | + self assertIsNonOptimizedCall: tfExternalFunction. + called := true. + receivedArgument := arg. + 0 ] + 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 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 [ + + | 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. + + 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 >> 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 - pointer double double to void' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerDoubleDoubleToVoid [ + + | 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: [:ptr :dbl1 :dbl2 | + self assertIsNonOptimizedCall: tfExternalFunction. + called := true. + receivedArgument1 := ptr. + receivedArgument2 := dbl1. + receivedArgument3 := dbl2. + 0 ] + withArgumentTypes: { interpreter libFFI pointer. 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 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 >> 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 - pointer to void (NonOpt)' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerToVoidWithNilAsParameter [ + + | 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 | + self assertIsNonOptimizedCall: tfExternalFunction. + 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 - pointer to void (NonOpt)' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionPointerToVoidWithOopAsParameter [ + + | 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 | + self assertIsNonOptimizedCall: tfExternalFunction. + 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 - void to pointer' } +VMJitFFISameThreadCalloutTest >> testNonOptimizedFunctionVoidToPointer [ + + | 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 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 " + tfExternalFunction := self + createExternalFunctionFor: [:arg | + self assertIsOptimizedCall: tfExternalFunction. + called := true. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. + 0 ] + withArgumentTypes: argumentTypes + 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 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: receivedArguments first equals: 23.5 +] + +{ #category : 'tests - pointer double double double double void' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerDoubleDoubleDoubleDoubleToVoid [ + + | 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: 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: 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 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 [ + + | 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. + 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 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: 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 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. + 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 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: receivedArguments first equals: 17. + self assert: receivedArguments second equals: 23.5. + 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 [ + + | 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 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. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. + + 0 ] + withArgumentTypes: argumentTypes + 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: 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 [ + + | 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 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. + 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 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: receivedArguments first equals: 17 +] + +{ #category : 'tests - pointer to void (Opt)' } +VMJitFFISameThreadCalloutTest >> testOptimizedFunctionPointerToVoidWithNilAsParameterShouldFail [ + + | 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. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. + 0 ] + withArgumentTypes: argumentTypes + 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 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. + receivedArguments := machineSimulator + fetchArgumentsOfTypes: argumentTypes. + + 0 ] + withArgumentTypes: argumentTypes + 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 | + + 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. + 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. + + 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. + +] 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/VMJittedLookupTest.class.st b/smalltalksrc/VMMakerTests/VMJittedLookupTest.class.st index 214d3c3080..a345ed72a3 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 [ 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/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 [ 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 6e8a59a722..b240a7ffa1 100644 --- a/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitAbstractTest.class.st @@ -113,6 +113,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..67abdb21b4 100644 --- a/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st @@ -113,6 +113,50 @@ 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 [ + + ^ 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: 3. + 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 storeInteger: 2 ofObject: tfExternalFunction withValue: flags. + + memory storePointer: 0 ofObject: tfFunctionDefinition withValue: cifExternalAddress. + + ^ tfExternalFunction +] + { #category : 'utils' } VMSpurMemoryManagerTest >> createLargeIntegerClasses [ @@ -314,6 +358,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 +545,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 +887,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 [