diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index 02ce203b2a..eae6bc835d 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -1196,7 +1196,7 @@ CoInterpreter >> ceInterpretMethodFromPIC: aMethodObj receiver: rcvr [ messageSelector := pic selector. newMethod := aMethodObj. primitiveIndex := self primitiveIndexOf: aMethodObj. - primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: objectMemory nilObject. + primitiveFunctionPointer := self functionPointerFor: primitiveIndex. argumentCount := pic cmNumArgs. instructionPointer := self popStack. self interpretMethodFromMachineCode. @@ -1226,7 +1226,7 @@ CoInterpreter >> ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr [ self unreachable]. newMethod := aMethodObj. primitiveIndex := self primitiveIndexOf: aMethodObj. - primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: objectMemory nilObject. + primitiveFunctionPointer := self functionPointerFor: primitiveIndex. ^self interpretMethodFromMachineCode]. "handleMNU:InMachineCodeTo:classForMessage: assumes lkupClass is set, since every other use is after a lookupMethodNoMNUEtcInClass: call, which sets lkupClass. Here we must set it manually. @@ -2790,7 +2790,7 @@ CoInterpreter >> functionPointerForCompiledMethod: methodObj primitiveIndex: pri | functionPointer | - functionPointer := self functionPointerFor: primIndex inClass: nil. + functionPointer := self functionPointerFor: primIndex. functionPointer == #primitiveCalloutToFFI ifTrue: [^self functionForPrimitiveCallout]. functionPointer == #primitiveExternalCall ifTrue: diff --git a/smalltalksrc/VMMaker/CogVMSimulator.class.st b/smalltalksrc/VMMaker/CogVMSimulator.class.st index 4f89ecf64c..700d917c26 100644 --- a/smalltalksrc/VMMaker/CogVMSimulator.class.st +++ b/smalltalksrc/VMMaker/CogVMSimulator.class.st @@ -607,7 +607,7 @@ CogVMSimulator >> functionForPrimitiveExternalCall: methodObj [ ] { #category : 'interpreter shell' } -CogVMSimulator >> functionPointerFor: primIndex inClass: lookupClass [ +CogVMSimulator >> functionPointerFor: primIndex [ "Override Interpreter to handle the external primitives caching. See also internalExecuteNewMethod." @@ -1327,7 +1327,7 @@ CogVMSimulator >> primitiveContextAtPut [ CogVMSimulator >> primitiveDoPrimitiveWithArgs [ | primIndex | primIndex := objectMemory integerValueOf: (self stackValue: 1). - transcript nextPutAll: 'DO PRIMITIVE: '; print: (self functionPointerFor: primIndex inClass: nil); cr; flush. + transcript nextPutAll: 'DO PRIMITIVE: '; print: (self functionPointerFor: primIndex); cr; flush. (#(76 "primitiveStoreStackp" 188 189 "eval method") includes: primIndex) ifTrue: [self halt]. ^super primitiveDoPrimitiveWithArgs @@ -1731,7 +1731,7 @@ CogVMSimulator >> saneFunctionPointerForFailureOfPrimIndex: primIndex [ and: [self isPrimitiveFunctionPointerAnIndex not and: [primIndex ~= PrimNumberExternalCall and: [(self isMetaPrimitiveIndex: primIndex) not]]]) ifTrue: - [basePrimitive := self functionPointerFor: primIndex inClass: objectMemory nilObject. + [basePrimitive := self functionPointerFor: primIndex. ^(cogit lookupAddress: primitiveFunctionPointer) endsWith: basePrimitive]. ^super saneFunctionPointerForFailureOfPrimIndex: primIndex diff --git a/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacade.class.st b/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacade.class.st index bdd6338c84..c09b6a9f9f 100644 --- a/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacade.class.st +++ b/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacade.class.st @@ -379,10 +379,10 @@ CurrentImageCoInterpreterFacade >> freeStartAddress [ ] { #category : 'accessing' } -CurrentImageCoInterpreterFacade >> functionPointerFor: primIndex inClass: lookupClass [ +CurrentImageCoInterpreterFacade >> functionPointerFor: primIndex [ ^primIndex = 0 ifTrue: [#primitiveFail] - ifFalse: [coInterpreter functionPointerFor: primIndex inClass: lookupClass] + ifFalse: [coInterpreter functionPointerFor: primIndex] ] { #category : 'accessing' } diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index c406c444b0..aca0c25f0f 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -392,7 +392,8 @@ Class { 'pendingFinalizationSignals', 'imageVersionNumber', 'desiredStackPageBytes', - 'imageReaderWriter' + 'imageReaderWriter', + 'inlineCacheStartIndex' ], #classVars : [ 'AlternateHeaderHasPrimFlag', @@ -1972,7 +1973,7 @@ StackInterpreter >> addNewMethodToCache: classObj [ (objectMemory isOopCompiledMethod: newMethod) ifTrue: [primitiveIndex := self primitiveIndexOf: newMethod. - primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: classObj] + primitiveFunctionPointer := self functionPointerFor: primitiveIndex] ifFalse: [self assert: ((objectMemory isNonImmediate: newMethod) and: [objectMemory isForwarded: newMethod]) not. @@ -5649,7 +5650,8 @@ StackInterpreter >> extSendBytecode [ "238 11101110 i i i i i j j j Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments" | byte | byte := self fetchByte. - messageSelector := self literal: (byte >> 3) + (extA << 5). + inlineCacheStartIndex := (byte >> 3) + (extA << 5). + messageSelector := self literal: inlineCacheStartIndex. extA := 0. argumentCount := (byte bitAnd: 7) + (extB << 3). extB := 0. @@ -5665,7 +5667,8 @@ StackInterpreter >> extSendSuperBytecode [ ifFalse: [Send To Superclass of Stacked Class Literal Selector #iiiii (+ Extend A * 32) with jjj (+ (Extend B bitAnd: 63) * 8) Arguments]" | byte | byte := self fetchByte. - messageSelector := self literal: (byte >> 3) + (extA << 5). + inlineCacheStartIndex := (byte >> 3) + (extA << 5). + messageSelector := self literal: inlineCacheStartIndex. extA := 0. BytecodeSetHasDirectedSuperSend ifTrue: [extB >= 64 ifTrue: @@ -6047,27 +6050,29 @@ StackInterpreter >> findNewMethodInClassTag: classTagArg ifFound: aBlock [ | classTag | classTag := classTagArg. + + (self tryToUseInlineCacheFor: classTag) ifTrue: [ ^ aBlock value ]. + + "Entry was not found in the local IC cache; perhaps something was forwarded. + Resolve forwarders and retry" + (objectMemory isOopForwarded: messageSelector) ifTrue: [ + messageSelector := self handleForwardedSelectorFaultFor: messageSelector ]. + (objectMemory isForwardedClassTag: classTag) ifTrue: [ + classTag := self handleForwardedSendFaultForTag: classTag ]. + + "ICs failed. Try the lookup cache" (self inlineLookupInMethodCacheSel: messageSelector classTag: classTag) + ifTrue: [ + self updateInlineCacheIfNeeded: classTag. + ^ aBlock value ] ifFalse: [ - "Entry was not found in the cache; perhaps something was forwarded. - Resolve forwarders and retry" - ((objectMemory isOopForwarded: messageSelector) or: [ - objectMemory isForwardedClassTag: classTag ]) ifTrue: [ - (objectMemory isOopForwarded: messageSelector) ifTrue: [ - messageSelector := self handleForwardedSelectorFaultFor: - messageSelector ]. - (objectMemory isForwardedClassTag: classTag) ifTrue: [ - classTag := self handleForwardedSendFaultForTag: classTag ]. - (self lookupInMethodCacheSel: messageSelector classTag: classTag) - ifTrue: [ ^ aBlock value ] ]. - - "Entry was not found in the cache; look it up the hard way " + "All caches failed. Do a proper lookup" lkupClass := objectMemory classForClassTag: classTag. (objectMemory isOopForwarded: lkupClass) ifTrue: [ lkupClass := objectMemory followForwarded: lkupClass ]. self lookupMethodInClass: lkupClass. - self addNewMethodToCache: lkupClass ] - ifTrue: [ aBlock value ] + self addNewMethodToCache: lkupClass. + self updateInlineCacheIfNeeded: classTag ] ] { #category : 'message sending' } @@ -6927,7 +6932,7 @@ StackInterpreter >> functionForPrimitiveCallout [ ] { #category : 'method lookup cache' } -StackInterpreter >> functionPointerFor: primIdx inClass: theClass [ +StackInterpreter >> functionPointerFor: primIdx [ "Find an actual function pointer for this primitiveIndex. This is an opportunity to specialise the prim for the relevant class (format for example). Default for now is simply the entry in the base primitiveTable." @@ -7676,6 +7681,7 @@ StackInterpreter >> initializeInterpreter: bytesToShift [ profileSemaphore := profileProcess := profileMethod := objectMemory nilObject. self initializeGlobalSessionID. metaAccessorDepth := -2. + inlineCacheStartIndex := -1 ] @@ -7703,6 +7709,18 @@ StackInterpreter >> initializePageTraceToInvalid: aPage [ aPage trace: StackPageTraceInvalid "for assert checking of the page tracing flags" ] +{ #category : 'accessing' } +StackInterpreter >> inlineCacheStartIndex [ + + ^ inlineCacheStartIndex +] + +{ #category : 'accessing' } +StackInterpreter >> inlineCacheStartIndex: anObject [ + + inlineCacheStartIndex := anObject +] + { #category : 'method lookup cache' } StackInterpreter >> inlineLookupInMethodCacheSel: selector classTag: classTag [ "This method implements a simple method lookup cache. If an entry for the given selector and classTag is @@ -8650,6 +8668,12 @@ StackInterpreter >> literal: offset ofMethod: methodPointer put: oop [ ] +{ #category : 'compiled methods' } +StackInterpreter >> literal: offset put: oop [ + self assert: method = (self iframeMethod: framePointer). + ^self literal: offset ofMethod: method put: oop +] + { #category : 'compiled methods' } StackInterpreter >> literalCountOfAlternateHeader: headerPointer [ @@ -9400,7 +9424,7 @@ StackInterpreter >> mappedDirectCall [ localPrimIndex := self primitiveIndexOfMethod: newMethod header: methodHeader. argumentCount := self argumentCountOfMethodHeader: methodHeader. "The primitive function pointer is not cached in the interpreter, but it's called quickly in the JIT" - primitiveFunctionPointer := self functionPointerFor: localPrimIndex inClass: objectMemory nilObject.. + primitiveFunctionPointer := self functionPointerFor: localPrimIndex. self activateNewMethod ] @@ -13492,7 +13516,7 @@ StackInterpreter >> safeMethodClassOf: methodPointer [ StackInterpreter >> saneFunctionPointerForFailureOfPrimIndex: primIndex [ | basePrimitive | - basePrimitive := self functionPointerFor: primIndex inClass: objectMemory nilObject. + basePrimitive := self functionPointerFor: primIndex. ^primitiveFunctionPointer = basePrimitive or: [(basePrimitive = #primitiveExternalCall and: [self isPrimitiveFunctionPointerAnIndex not]) or: [(self isMetaPrimitiveIndex: primIndex) and: [metaAccessorDepth > -2]]] @@ -13592,7 +13616,8 @@ StackInterpreter >> sendCannotReturn: resultOop [ StackInterpreter >> sendLiteralSelector0ArgsBytecode [ "Can use any of the first 16 literals for the selector." | rcvr | - messageSelector := self literal: (currentBytecode bitAnd: 16rF). + inlineCacheStartIndex := currentBytecode bitAnd: 16rF. + messageSelector := self literal: inlineCacheStartIndex. argumentCount := 0. rcvr := self stackValue: 0. lkupClassTag := objectMemory fetchClassTagOf: rcvr. @@ -13604,7 +13629,8 @@ StackInterpreter >> sendLiteralSelector0ArgsBytecode [ StackInterpreter >> sendLiteralSelector1ArgBytecode [ "Can use any of the first 16 literals for the selector." | rcvr | - messageSelector := self literal: (currentBytecode bitAnd: 16rF). + inlineCacheStartIndex := currentBytecode bitAnd: 16rF. + messageSelector := self literal: inlineCacheStartIndex. argumentCount := 1. rcvr := self stackValue: 1. lkupClassTag := objectMemory fetchClassTagOf: rcvr. @@ -13616,7 +13642,8 @@ StackInterpreter >> sendLiteralSelector1ArgBytecode [ StackInterpreter >> sendLiteralSelector2ArgsBytecode [ "Can use any of the first 16 literals for the selector." | rcvr | - messageSelector := self literal: (currentBytecode bitAnd: 16rF). + inlineCacheStartIndex := currentBytecode bitAnd: 16rF. + messageSelector := self literal: inlineCacheStartIndex. argumentCount := 2. rcvr := self stackValue: 2. lkupClassTag := objectMemory fetchClassTagOf: rcvr. @@ -15708,6 +15735,34 @@ StackInterpreter >> tryLoadNewPlugin: pluginString pluginEntries: pluginEntries ^ pluginString asString -> plugin ] +{ #category : 'interpreter inline caches' } +StackInterpreter >> tryToUseInlineCacheFor: classTag [ + | inlineCacheClassTag | + + "If there's no cache then return" + inlineCacheStartIndex = -1 ifTrue: [ ^ false ]. + + "If the cached tag is not the same one then return" + inlineCacheClassTag := objectMemory integerValueOf: (self literal: inlineCacheStartIndex + 1). + inlineCacheClassTag = classTag ifFalse: [ ^ false ]. + + "Otherwise let's get the method and primitive function pointer" + newMethod := self literal: inlineCacheStartIndex + 2. + (objectMemory isOopCompiledMethod: newMethod) + ifTrue: [ + | primitiveIndex | + primitiveIndex := self primitiveIndexOf: newMethod. + primitiveFunctionPointer := self functionPointerFor: primitiveIndex ] + ifFalse: [ + self assert: ( + (objectMemory isNonImmediate: newMethod) and: [objectMemory isForwarded: newMethod]) not. + primitiveFunctionPointer := #primitiveInvokeObjectAsMethod ]. + + "... and notify the caller that we were able to use the IC" + inlineCacheStartIndex := -1. + ^ true +] + { #category : 'debug printing' } StackInterpreter >> ultimateLiteralOf: aMethodOop [ @@ -16026,6 +16081,35 @@ StackInterpreter >> unknownShortOrCodeSizeInKs [ ^theUnknownShort ] +{ #category : 'interpreter inline caches' } +StackInterpreter >> updateInlineCacheIfNeeded: classTag [ + + | classTagObj | + "If there's no cache then return" + inlineCacheStartIndex = -1 ifTrue: [ ^ self ]. + "Don't cache doesNotUnderstand:" + messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [ + inlineCacheStartIndex := -1. + ^ self ]. + "Don't cache cannotInterpret:" + messageSelector = (objectMemory splObj: SelectorCannotInterpret) ifTrue: [ + inlineCacheStartIndex := -1. + ^ self ]. + "Don't cache external methods (we need a mechanism for quickening of external methods)" + primitiveFunctionPointer = #primitiveExternalCall ifTrue: [ + inlineCacheStartIndex := -1. + ^ self ]. + + classTagObj := objectMemory integerObjectOf: classTag. + + "... otherwise lets update the IC" + self literal: inlineCacheStartIndex + 1 put: classTagObj. + self literal: inlineCacheStartIndex + 2 put: newMethod. + + "... and now there's no inline cache to work with" + inlineCacheStartIndex := -1 +] + { #category : 'image save/restore' } StackInterpreter >> updateObjectsPostByteSwap [ diff --git a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st index b3d2ca8f70..08cbece26e 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -962,7 +962,7 @@ StackInterpreterPrimitives >> primitiveDoPrimitiveWithArgs [ [^self primitiveFailFor: PrimErrLimitExceeded negated]. primIdx := objectMemory integerValueOf: primIdx. - primitiveFunctionPointer := self functionPointerFor: primIdx inClass: nil. + primitiveFunctionPointer := self functionPointerFor: primIdx. primitiveFunctionPointer = 0 ifTrue: [primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs. ^self primitiveFailFor: PrimErrBadIndex negated]. @@ -1027,7 +1027,7 @@ StackInterpreterPrimitives >> primitiveExecuteMethod [ [^self primitiveFailFor: PrimErrBadNumArgs]. newMethod := self popStack. primitiveIndex := self primitiveIndexOf: newMethod. - primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: nil. + primitiveFunctionPointer := self functionPointerFor: primitiveIndex. argumentCount := argumentCount - 1. self executeNewMethod. "Recursive xeq affects primErrorCode" @@ -1064,7 +1064,7 @@ StackInterpreterPrimitives >> primitiveExecuteMethodArgsArray [ self push: (objectMemory fetchPointer: i ofObject: argumentArray)]. newMethod := methodArgument. primitiveIndex := self primitiveIndexOf: newMethod. - primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: nil. + primitiveFunctionPointer := self functionPointerFor: primitiveIndex. argumentCount := argCnt. self executeNewMethod. "Recursive xeq affects primErrorCode" diff --git a/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st b/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st index f9fe803902..47479d6d02 100644 --- a/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st @@ -552,7 +552,7 @@ StackInterpreterSimulator >> framePointer [ ] { #category : 'interpreter shell' } -StackInterpreterSimulator >> functionPointerFor: primIndex inClass: lookupClass [ +StackInterpreterSimulator >> functionPointerFor: primIndex [ "Override Interpreter to handle the external primitives caching. See also internalExecuteNewMethod." diff --git a/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st b/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st index 459f61526b..0c2fbc4362 100644 --- a/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st +++ b/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st @@ -605,7 +605,7 @@ VMByteCodesTest >> testSendMessageWithTwoArgumentsMakeAFrame [ | selectorOop aMethod aMethodToActivate receiver receiverClass aMethodDictionary arg1 arg2 | selectorOop := memory integerObjectOf: 42. - methodBuilder newMethod literals: { selectorOop }. + methodBuilder newMethod literals: { selectorOop. interpreter objectMemory nilObject. interpreter objectMemory nilObject. }. aMethod := methodBuilder buildMethod. aMethodToActivate := methodBuilder newMethod numberOfArguments: 2; diff --git a/smalltalksrc/VMMakerTests/VMLookUpTest.class.st b/smalltalksrc/VMMakerTests/VMLookUpTest.class.st index 48bc2548f9..6e3db5a5cc 100644 --- a/smalltalksrc/VMMakerTests/VMLookUpTest.class.st +++ b/smalltalksrc/VMMakerTests/VMLookUpTest.class.st @@ -130,6 +130,7 @@ VMLookUpTest >> setUp [ interpreter setBreakSelector: nil. interpreter methodDictLinearSearchLimit: linearSearchLimit. + interpreter inlineCacheStartIndex: -1. ] @@ -155,6 +156,40 @@ VMLookUpTest >> testInstallSmallIntegerClassIntoClassTable [ equals: receiverClass ] +{ #category : 'tests' } +VMLookUpTest >> testLookUpAlreadyUpdatedICGoesThroughFastPath [ + + | aMethodDictionary | + selectorOop := self + newClassInOldSpaceWithSlots: 0 + instSpec: memory nonIndexablePointerFormat. + + receiverClass := self setSmallIntegerClassIntoClassTable. + methodBuilder newMethod literals: { selectorOop. receiverClass. memory trueObject. }. + methodOop := methodBuilder buildMethod. + receiver := memory integerObjectOf: 56. + + self setUpMethodDictionaryIn: receiverClass. + aMethodDictionary := memory fetchPointer: MethodDictionaryIndex ofObject: receiverClass. + self installSelector: selectorOop method: methodOop inMethodDictionary: aMethodDictionary. + + stackBuilder addNewFrame method: methodOop. + stackBuilder buildStack. + interpreter + inlineCacheStartIndex: 0; + methodDictLinearSearchLimit: 3; + messageSelector: selectorOop; + findNewMethodInClassTag: memory smallIntegerTag. + interpreter lookupInMethodCacheSel: selectorOop classTag: memory smallIntegerTag. + + "The IC was not updated" + self assert: (interpreter literal: 1 ofMethod: methodOop) equals: receiverClass. + self assert: (interpreter literal: 2 ofMethod: methodOop) equals: memory trueObject. + + "The new method is the expected one" + self assert: interpreter newMethod equals: memory trueObject. +] + { #category : 'tests' } VMLookUpTest >> testLookUpFindsForwardedMethod [ @@ -243,6 +278,36 @@ VMLookUpTest >> testLookUpInDefiningClassCreatesANewEntryInCache [ self assert: (interpreter lookupInMethodCacheSel: selectorOop classTag:memory smallIntegerTag). ] +{ #category : 'tests' } +VMLookUpTest >> testLookUpInDefiningClassUpdatesAnIC [ + + | aMethodDictionary | + selectorOop := self + newClassInOldSpaceWithSlots: 0 + instSpec: memory nonIndexablePointerFormat. + + methodBuilder newMethod literals: { selectorOop. interpreter objectMemory nilObject. interpreter objectMemory nilObject. }. + methodOop := methodBuilder buildMethod. + receiver := memory integerObjectOf: 56. + receiverClass := self setSmallIntegerClassIntoClassTable. + + self setUpMethodDictionaryIn: receiverClass. + aMethodDictionary := memory fetchPointer: MethodDictionaryIndex ofObject: receiverClass. + self installSelector: selectorOop method: methodOop inMethodDictionary: aMethodDictionary. + + stackBuilder addNewFrame method: methodOop. + stackBuilder buildStack. + interpreter + inlineCacheStartIndex: 0; + methodDictLinearSearchLimit: 3; + messageSelector: selectorOop; + findNewMethodInClassTag: memory smallIntegerTag. + interpreter lookupInMethodCacheSel: selectorOop classTag: memory smallIntegerTag. + + self assert: (interpreter literal: 1 ofMethod: methodOop) equals: receiverClass. + self assert: (interpreter literal: 2 ofMethod: methodOop) equals: methodOop. +] + { #category : 'tests' } VMLookUpTest >> testLookUpInFindsCannotInterpretCreatesANewEntryInCache [