diff --git a/smalltalksrc/Melchor/VMObjectIndices.class.st b/smalltalksrc/Melchor/VMObjectIndices.class.st index c4f99caefa..d133f13768 100644 --- a/smalltalksrc/Melchor/VMObjectIndices.class.st +++ b/smalltalksrc/Melchor/VMObjectIndices.class.st @@ -91,6 +91,7 @@ Class { 'TheLowSpaceSemaphore', 'TheTimerSemaphore', 'TrueObject', + 'VTableIndex', 'ValueIndex', 'XIndex', 'YIndex' diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index 02ce203b2a..60ed7dbedd 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -1685,6 +1685,18 @@ CoInterpreter >> ceSendFromInLineCacheMiss: cogMethodOrPIC [ self unreachable ] +{ #category : 'trampolines' } +CoInterpreter >> ceSendFromVTableInterpreted: aMethod [ + + + instructionPointer := self popStack. + newMethod := aMethod. + primitiveFunctionPointer := 0. + + self executeNewMethod: false. + self returnToExecutive: false +] + { #category : 'trampolines' } CoInterpreter >> ceSendMustBeBoolean: anObject [ diff --git a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st index 2636c19329..648a733006 100644 --- a/smalltalksrc/VMMaker/CogARMv8Compiler.class.st +++ b/smalltalksrc/VMMaker/CogARMv8Compiler.class.st @@ -999,6 +999,7 @@ CogARMv8Compiler >> computeMaximumSize [ [Nop] -> [^4]. "Control" [Call] -> [^4]. + [CallR] -> [^4]. [CallFull] -> [^self literalLoadInstructionBytes + 4]. [JumpR] -> [^4]. [Jump] -> [^4]. @@ -1590,6 +1591,20 @@ CogARMv8Compiler >> concretizeCallFull [ ^ machineCodeSize := instrOffset + 4 ] +{ #category : 'generate machine code' } +CogARMv8Compiler >> concretizeCallR [ + + "C5.6.27 BLR +Branch with link to register, calls a subroutine at an address in a register, setting register X30 to PC + 4" + + | reg op | + self assert: (operands at: 0) ~= 0. + op := 2r1101011000111111000000 << 10. + reg := (operands at: 0) signedIntFromLong << 5. + self machineCodeAt: 0 put: op + reg. + ^ machineCodeSize := 4 +] + { #category : 'generate machine code' } CogARMv8Compiler >> concretizeCmpC32R [ @@ -3413,6 +3428,7 @@ CogARMv8Compiler >> dispatchConcretize [ [Nop] -> [^self concretizeNop]. "Control" [Call] -> [^self concretizeCall]. "call code within code space" + [CallR] -> [^self concretizeCallR]. "call to a Register" [CallFull] -> [^self concretizeCallFull]. "call code anywhere in address space" [JumpR] -> [^self concretizeJumpR]. [JumpFull] -> [^self concretizeJumpFull]."jump within address space" diff --git a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st index 16c1bba7cd..894dffaf07 100644 --- a/smalltalksrc/VMMaker/CogAbstractInstruction.class.st +++ b/smalltalksrc/VMMaker/CogAbstractInstruction.class.st @@ -1057,7 +1057,7 @@ CogAbstractInstruction >> getOperandsWithFormat: format [ ifTrue: [ (operand > 16 and: [ opcode ~= Label ]) ifTrue: [ (operand allMask: 16r80000000) - ifTrue: [ strOperands add: operand, '/', operand signedIntFromLong ]. + ifTrue: [ strOperands add: operand asString, '/', operand signedIntFromLong asString ]. strOperands add: operand asString, '/', (operand hex)] ifFalse: [ strOperands add: operand. diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index 2328a265dc..578604c7ab 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -257,7 +257,8 @@ Class { 'statCompileMethodUsecs', 'jitCodeZoneWriteEnabled', 'cePrimReturnEnterCogCode', - 'cePrimReturnEnterCogCodeProfiling' + 'cePrimReturnEnterCogCodeProfiling', + 'vTableSend' ], #classVars : [ 'AnnotationConstantNames', @@ -1340,7 +1341,7 @@ Cogit class >> notesAndQueries [ { #category : 'accessing' } Cogit class >> numTrampolines [ - ^39 "31 + 4 each for self and super sends" + ^40 "31 + 4 * 2 each for self and super sends + 1 for vTable" "self withAllSubclasses collect: [:c| {c. (c instVarNames select: [:ea| ea beginsWith: 'ce']) size}]" ] @@ -7995,6 +7996,7 @@ Cogit >> generateRunTimeTrampolines [ { #category : 'initialization' } Cogit >> generateSendTrampolines [ + 0 to: NumSendTrampolines - 1 do: [:numArgs| ordinarySendTrampolines diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index c406c444b0..82c2b73f43 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -740,7 +740,9 @@ StackInterpreter class >> initializeBytecodeTableForSistaV1 [ (244 extStoreLiteralVariableBytecode) (245 longStoreTemporaryVariableBytecode) - (246 247 unknownBytecode) + (246 sendVTableMessage) + + (247 unknownBytecode) "3 byte bytecodes" (248 callPrimitiveBytecode) @@ -798,6 +800,7 @@ StackInterpreter class >> initializeClassIndices [ SuperclassIndex := 0. MethodDictionaryIndex := 1. InstanceSpecificationIndex := 2. + VTableIndex := 5. "Fields of a message dictionary" MethodArrayIndex := 1. SelectorStart := 2. @@ -7622,6 +7625,7 @@ StackInterpreter >> initialize [ statProcessSwitch := statStackPageDivorce := statIdleUsecs := 0. imageVersionNumber := 0. + desiredStackPageBytes := 256 * objectMemory wordSize. ] { #category : 'initialization' } @@ -13624,6 +13628,30 @@ StackInterpreter >> sendLiteralSelector2ArgsBytecode [ self commonSendOrdinary ] +{ #category : 'bytecodes' } +StackInterpreter >> sendVTableMessage [ + + | byte methodIndex rcvr classTag class vTable | + byte := self fetchByte. + methodIndex := (byte >> 3) + (extA << 5). + extA := 0. + argumentCount := (byte bitAnd: 7) + (extB << 3). + extB := 0. + numExtB := 0. + + rcvr := self stackValue: argumentCount. + classTag := objectMemory fetchClassTagOf: rcvr. + + class := objectMemory classForClassTag: classTag. + vTable := objectMemory fetchPointer: VTableIndex ofObject: class. + + newMethod := objectMemory fetchPointer: methodIndex ofObject: vTable. + primitiveFunctionPointer := 0. + + self executeNewMethod: false. + self fetchNextBytecode +] + { #category : 'debug support' } StackInterpreter >> setBreakMNUSelector: aString [ diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index f0c8997f9c..832fff897e 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -373,7 +373,8 @@ StackToRegisterMappingCogit class >> initializeBytecodeTableForSistaV1 [ (2 244 244 genExtStoreLiteralVariableBytecode isMappedIfImmutability) (2 245 245 genLongStoreTemporaryVariableBytecode) - (2 246 247 unknownBytecode) + (2 246 246 genSendVTableMessage) + (2 247 247 unknownBytecode) "3 byte bytecodes" (3 248 248 genCallPrimitiveBytecode hasUnsafeJump) @@ -2501,6 +2502,46 @@ StackToRegisterMappingCogit >> genSendTrampolineFor: aRoutine numArgs: numArgs c ^startAddress ] +{ #category : 'bytecode generator support' } +StackToRegisterMappingCogit >> genSendVTableMessage [ + + | methodIndex argumentCount jumpInterpret mergeJump | + methodIndex := (byte1 >> 3) + (extA << 5). + extA := 0. + argumentCount := (byte1 bitAnd: 7) + (extB << 3). + extB := 0. + numExtB := 0. + + "Allocate registers" + self marshallSendArguments: argumentCount. + + "Fetch the method from the VTable" + objectRepresentation genGetClassObjectOf: ReceiverResultReg into: ClassReg scratchReg: TempReg instRegIsReceiver: true. + self MoveMw: (VTableIndex + 1) * objectMemory wordSize r: ClassReg R: TempReg. + self MoveMw: (methodIndex + 1) * objectMemory wordSize r: TempReg R: TempReg. + + "If the method is compiled, we jump to it, if not we jump to the interpret." + objectRepresentation genLoadSlot: HeaderIndex sourceReg: TempReg destReg: ClassReg. + jumpInterpret := objectRepresentation genJumpImmediate: ClassReg. + + "Jump to the method's unchecked entry-point." + self AddCq: cmNoCheckEntryOffset R: ClassReg. + self CallR: ClassReg. "Receiver and Args travel in registers" + mergeJump := self Jump: 0. + + "Call the trampoline to continue execution in the interpreter" + jumpInterpret jmpTarget: self Label. + self PushR: ReceiverResultReg. + self CallRT: vTableSend. "Receiver and Args travel in the stack" + + mergeJump jmpTarget: self Label. + self annotateBytecode: self Label. + + self voidReceiverOptStatus. + self ssPushRegister: ReceiverResultReg. + ^0 +] + { #category : 'bytecode generators' } StackToRegisterMappingCogit >> genSistaExtStoreAndPopReceiverVariableBytecodePopBoolean: popBoolean [ @@ -3204,6 +3245,11 @@ StackToRegisterMappingCogit >> generateMissAbortTrampolines [ { #category : 'initialization' } StackToRegisterMappingCogit >> generateSendTrampolines [ "Override to generate code to push the register arg(s) for <= numRegArg arity sends." + + vTableSend := self genTrampolineFor: #ceSendFromVTableInterpreted: + called: 'VTableSend' + arg: TempReg. + 0 to: NumSendTrampolines - 1 do: [:numArgs| ordinarySendTrampolines diff --git a/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st b/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st index 459f61526b..66f3e9d109 100644 --- a/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st +++ b/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st @@ -745,3 +745,28 @@ VMByteCodesTest >> testSubVectorBytecode [ self assert: (memory fetchFloat64: 1 ofObject: result) equals: 2.0. ] + +{ #category : 'tests-send' } +VMByteCodesTest >> testVTableCall [ + + | aMethod receiver | + aMethod := methodBuilder + bytecodes: #[ 246 0 ]; + buildMethod. "send VTable" "index" + + receiver := self configVTable . + + stackBuilder addNewFrame + method: aMethod; + stack: { receiver }. + stackBuilder buildStack. + + interpreter setBreakSelector: nil. + interpreter method: aMethod. + interpreter currentBytecode: 246. + + interpreter fetchByte. + self interpret: [ interpreter sendVTableMessage ]. + + self assert: interpreter stackTop equals: receiver +] diff --git a/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st b/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st index eff8c524da..38f7c47212 100644 --- a/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSpurMemoryManagerTest.class.st @@ -50,6 +50,22 @@ VMSpurMemoryManagerTest class >> wordSizeParameters [ yourself ] +{ #category : 'tests-send' } +VMSpurMemoryManagerTest >> configVTable [ + | aMethodToActivate receiver receiverClass vTable | + aMethodToActivate := methodBuilder newMethod + numberOfArguments: 0; + buildMethod. + receiver := memory integerObjectOf: 41. + receiverClass := self setSmallIntegerClassIntoClassTable. + + vTable := self setUpVTableIn: receiverClass. + + memory storePointer: 0 ofObject: vTable withValue: aMethodToActivate. + + ^ receiver +] + { #category : 'configuring' } VMSpurMemoryManagerTest >> configureEnvironmentBuilder [ @@ -462,7 +478,7 @@ VMSpurMemoryManagerTest >> newClassInOldSpaceWithSlots: numberOfSlots instSpec: | newClass formatWithSlots | newClass := memory - allocateSlotsInOldSpace: 3 + allocateSlotsInOldSpace: 6 format: memory nonIndexablePointerFormat classIndex: memory arrayClassIndexPun. @@ -876,6 +892,16 @@ VMSpurMemoryManagerTest >> setUpUsingImage [ ] +{ #category : 'initialization' } +VMSpurMemoryManagerTest >> setUpVTableIn: aClass [ + "The VTable is an array in the 4th entry of the class" + + | array | + array := self newArrayWithSlots: 10. + memory storePointer: VTableIndex ofObject: aClass withValue: array. + ^ array +] + { #category : 'accessing' } VMSpurMemoryManagerTest >> sizeOfObjectWithSlots: slots [