experimental: Inline caches for the interpreter

src/Collections-Strings/Symbol.class.st

@@ -374,6 +374,13 @@ Symbol >> cull: anObject [
 	^anObject perform: self
 ]
 
+{ #category : 'system primitives' }
+Symbol >> doFlushCache [
+	"Tell the virtual machine to remove all entries with this symbol as a selector from its method lookup caches, if it has any.  This 	must be done whenever a method is added, redefined or removed, so that message lookups reflect the revised organization.  c.f. 	Behavior>>flushCache & CompiledMethod>>flushCache.  Essential. See MethodDictionary class comment."
+
+	<primitive: 119>
+]
+
 { #category : 'private' }
 Symbol >> errorNoModification [
 
@@ -384,7 +391,8 @@ Symbol >> errorNoModification [
 Symbol >> flushCache [
 	"Tell the virtual machine to remove all entries with this symbol as a selector from its method lookup caches, if it has any.  This 	must be done whenever a method is added, redefined or removed, so that message lookups reflect the revised organization.  c.f. 	Behavior>>flushCache & CompiledMethod>>flushCache.  Essential. See MethodDictionary class comment."
 
-	<primitive: 119>
+	Smalltalk cleanAllICsForSelector: self.
+	self doFlushCache
 ]
 
 { #category : 'announcements' }

src/Debugging-Core/InstructionStream.extension.st

@@ -93,7 +93,7 @@ InstructionStream >> scanFor: scanBlock [
 	[pc <= end] whileTrue: 
 		[(scanBlock value: (byte := method at: pc)) ifTrue:
 			[^true].
-		 pc := pc + (encoderClass bytecodeSize: byte)].
+		 pc := pc + (encoderClass instructionSizeAt: pc of: method)].
 	^false
 ]
 

src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st

@@ -847,6 +847,50 @@ EncoderForSistaV1 class >> sendsToSuperFor: compiledMethod [
 	^ scanner scanFor: [:instr |  instr = 235 ]
 ]
 
+{ #category : 'bytecode decoding' }
+EncoderForSistaV1 class >> sendsiteIndexOrNilFor: anInstructionStream in: method at: pc [
+	"If anInstructionStream is at a send bytecode then answer the send's sendsite index (used for inline caches), otherwise answer nil.
+	 The complication is that for convenience we allow the pc to point to the
+	 raw send bytecode after its extension(s), or at the extension(s) preceeding it.
+	96-111		0110 iiii			Send Arithmetic Message #iiii (+ - < > <= >= = ~= * / \\ @ bitShift: // bitAnd: bitOr:)
+	112-119	01110 iii			Send Special Message #iii + 0 (at: at:put: size next nextPut: atEnd == class)
+	120-127	01111 iii			Send Special Message #iii + 8 (~~ value value: do: new new: x y)
+	^ Ignored since we don't yet create sendsites for these bytecodes ^
+
+	128-143	1000 iiii			Send Literal Selector #iiii With 0 Argument
+	144-159	1001 iiii			Send Literal Selector #iiii With 1 Arguments
+	160-175	1010 iiii			Send Literal Selector #iiii With 2 Arguments
+	*	224	11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
+	*	225	11100001	bbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
+	**	234	11101010	iiiiijjj		Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments
+	**	235	11101011	iiiiijjj	ExtendB < 64
+										ifTrue: [Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments]
+										ifFalse: [Send To Superclass of Stacked Class Literal Selector #iiiii (+ Extend A * 32) with jjj (+ (Extend B "
+
+	| byte |
+	byte := method at: pc.
+	"Send low-index literal selector"
+	(byte between: 128 and: 175)
+		ifTrue: [ ^ (byte bitAnd: 15) + 1 ].
+	"need to check for either extension cuz order of extensions is not restricted. so extB could preceed extA"
+	(#(224 225) includes: byte)
+		ifTrue: [
+			^ self extensionsAt: pc in: method into: [
+				:extA :extB :nExtBytes |
+				| byteAfter |
+				byteAfter := method at: pc + nExtBytes.
+				(#(234 235) includes: byteAfter)
+					ifTrue: [ ((method at: pc + nExtBytes + 1) bitShift: -3) + (extA bitShift: 5) + 1 ]
+					ifFalse: [ nil ] ] ].
+	(#(234 235) includes: byte)
+		ifTrue: [
+			^ self extensionsFor: pc in: method into: [
+				:extA :extB :nExtBytes |
+					((method at: pc + 1) bitShift: -3) + (extA bitShift: 5) + 1 ] ].
+	^ nil
+
+]
+
 { #category : 'bytecode decoding' }
 EncoderForSistaV1 class >> specialLiterals [
 	^ #(true false nil 0 1)

src/Kernel-CodeModel/Behavior.class.st

@@ -620,6 +620,14 @@ Behavior >> definedVariables [
 	^ self slots
 ]
 
+{ #category : 'private' }
+Behavior >> doFlushCache [
+	"Tell the virtual machine to remove the contents of its method lookup caches, if it has any.  This must be done when the system 	modifies the class hierarchy so that message lookups reflect the revised organization.  c.f. Symbol>>flushCache & 	CompiledMethod>>flushCache.  Essential. See MethodDictionary class comment."
+
+	<primitive: 89>
+	self primitiveFailed
+]
+
 { #category : 'accessing - instances and variables' }
 Behavior >> elementSize [
 	"Answer the size in bytes of an element in the receiver.  The formats are
@@ -687,8 +695,8 @@ Behavior >> findOriginMethodOf: aMethod [
 Behavior >> flushCache [
 	"Tell the virtual machine to remove the contents of its method lookup caches, if it has any.  This must be done when the system 	modifies the class hierarchy so that message lookups reflect the revised organization.  c.f. Symbol>>flushCache & 	CompiledMethod>>flushCache.  Essential. See MethodDictionary class comment."
 
-	<primitive: 89>
-	self primitiveFailed
+	Smalltalk cleanAllICs.
+	self doFlushCache
 ]
 
 { #category : 'accessing' }

src/Kernel-CodeModel/CompiledCode.class.st

@@ -290,6 +290,19 @@ CompiledCode >> definitionString [
 	^ self sourceCode
 ]
 
+{ #category : 'cleaning' }
+CompiledCode >> doVoidCogVMState [
+	"Tell the VM to remove all references to any machine code form of the method.
+	 This primitive must be called whenever a method is in use and modified.  This is
+	 more aggressive (and *much* more costly) than flushCache since it must search
+	 through all context objects, making sure that none have a (hidden) machine code pc
+	 in the receiver.  Since modifying a method will likely change the generated machine code,
+	 modifying a method (rather than redefining it) requires this more aggressive flush."
+
+	<primitive: 215>
+	^self flushCache
+]
+
 { #category : 'accessing' }
 CompiledCode >> encoderClass [
 	^ self signFlag
@@ -342,6 +355,11 @@ CompiledCode >> frameSize [
 		ifFalse: [LargeFrame]
 ]
 
+{ #category : 'accessing' }
+CompiledCode >> hasInlineCaches [
+	^ (self header bitAt: 29) = 1
+]
+
 { #category : 'literals' }
 CompiledCode >> hasLiteral: literal [
 	"Answer whether the receiver references the argument, literal."
@@ -670,6 +688,21 @@ CompiledCode >> localSendsToSuper [
 	^ self encoderClass sendsToSuperFor: self
 ]
 
+{ #category : 'scanning' }
+CompiledCode >> localSendsiteIndices [
+	"Answer a Set of all the message selectors sent by this method."
+	<reflection: 'Structural queries on methods - Method element references'>
+	| scanner indices |
+	indices := IdentitySet new.
+	scanner := InstructionStream on: self.
+	scanner scanFor: [:x |
+		| sendsiteIndex |
+		sendsiteIndex := self method encoderClass sendsiteIndexOrNilFor: scanner in: self at: scanner pc.
+		sendsiteIndex ifNotNil: [ indices add: sendsiteIndex ].
+		false	"keep scanning"].
+	^ indices
+]
+
 { #category : 'scanning' }
 CompiledCode >> localWritesRef: literalAssociation [
 	"Answer whether the receiver stores into the argument."
@@ -855,9 +888,14 @@ CompiledCode >> refersToLiteral: aLiteral [
 	even if embedded in array structure."
 
 	1 to: self numLiterals - self literalsToSkip do: [ :index |
+		| currentLiteral |
 		"exclude selector or additional method state (penultimate slot)
 		and methodClass or outerCode (last slot)"
-		((self literalAt: index) refersToLiteral: aLiteral)
+		currentLiteral := self literalAt: index.
+		(currentLiteral isCompiledMethod not and: [
+			currentLiteral isCompiledBlock not and: [
+				(currentLiteral class inheritsFrom: CompiledBlock) not and: [
+					currentLiteral refersToLiteral: aLiteral ] ] ])
 			ifTrue: [ ^ true ] ].
 
 	^ false
@@ -1039,8 +1077,9 @@ CompiledCode >> voidCogVMState [
 	 in the receiver.  Since modifying a method will likely change the generated machine code,
 	 modifying a method (rather than redefining it) requires this more aggressive flush."
 
-	<primitive: 215>
-	^self flushCache
+	"Q: Can we skip this for CompiledBlock-s?"
+	Smalltalk cleanAllICsForMethod: self.
+	self doVoidCogVMState
 ]
 
 { #category : 'accessing' }

src/Kernel-CodeModel/CompiledMethod.class.st

@@ -191,6 +191,13 @@ CompiledMethod >> displayStringOn: aStream [
 	aStream print: self methodClass; nextPutAll: '>>'; store: self selector
 ]
 
+{ #category : 'accessing' }
+CompiledMethod >> doFlushCache [
+	"Tell the virtual machine to remove all references to this method from its method lookup caches, and to discard any optimized version 	of the method, if it has any of these.  This must be done whenever a method is modified in place, such as modifying its literals or 	machine code, to reflect the revised code.  c.f. Behavior>>flushCache & Symbol>>flushCache.  Essential.	 See MethodDictionary class 	comment."
+
+	<primitive: 116>
+]
+
 { #category : 'accessing' }
 CompiledMethod >> endPC [
 	"Answer the index of the last bytecode"
@@ -201,7 +208,8 @@ CompiledMethod >> endPC [
 CompiledMethod >> flushCache [
 	"Tell the virtual machine to remove all references to this method from its method lookup caches, and to discard any optimized version 	of the method, if it has any of these.  This must be done whenever a method is modified in place, such as modifying its literals or 	machine code, to reflect the revised code.  c.f. Behavior>>flushCache & Symbol>>flushCache.  Essential.	 See MethodDictionary class 	comment."
 
-	<primitive: 116>
+	Smalltalk cleanAllICsForMethod: self.
+	self doFlushCache
 ]
 
 { #category : 'source code management' }

src/OpalCompiler-Core/IRBytecodeGenerator.class.st

@@ -282,6 +282,11 @@ IRBytecodeGenerator >> goto: seqId [
 	self from: currentSeqId goto: seqId
 ]
 
+{ #category : 'results' }
+IRBytecodeGenerator >> hasInlineCaches [
+	^ true
+]
+
 { #category : 'results' }
 IRBytecodeGenerator >> hasPrimitive [
 	"do I have a primitive? Both normal primitive and quick return"
@@ -429,6 +434,17 @@ IRBytecodeGenerator >> mapBytesTo: instr [
 	instrMap add: instr -> (bytes size + 1)
 ]
 
+{ #category : 'private' }
+IRBytecodeGenerator >> methodSelectorIndexOf: object [
+
+	| index |
+
+	index := literals addMessageSelector: object.
+
+	"conversion from 1 based to 0 based"
+	^ index - 1
+]
+
 { #category : 'private' }
 IRBytecodeGenerator >> newDummySeqId [
 
@@ -645,15 +661,15 @@ IRBytecodeGenerator >> send: selector [
 			  genSendSpecial:
 			  (self encoderClass specialSelectors indexOf: selector)
 			  numArgs: nArgs ].
-	encoder genSend: (self literalIndexOf: selector) numArgs: nArgs
+	encoder genSend: (self methodSelectorIndexOf: selector) numArgs: nArgs
 ]
 
 { #category : 'instructions' }
 IRBytecodeGenerator >> send: selector toSuperOf: behavior [
 	| index nArgs |
 	nArgs := selector numArgs.
 	stack pop: nArgs.
-	index := self literalIndexOf: selector.
+	index := self methodSelectorIndexOf: selector.
 
 	inBlock
 		ifTrue: [
@@ -668,8 +684,9 @@ IRBytecodeGenerator >> send: selector toSuperOf: behavior [
 { #category : 'results' }
 IRBytecodeGenerator >> spurVMHeader: literalsSize [
 	^ (CompiledMethod headerFlagForEncoder: self encoderClass) +
+		(self hasInlineCaches asBit bitShift: 28) +
 		(self numArgs bitShift: 24) +
-		( self numTemps bitShift: 18) +
+		(self numTemps bitShift: 18) +
 		literalsSize +
 		(self hasPrimitive asBit bitShift: 16)
 ]

src/OpalCompiler-Core/OCLiteralList.class.st

@@ -8,32 +8,55 @@ Class {
 	#superclass : 'Object',
 	#instVars : [
 		'literalsDict',
-		'first'
+		'first',
+		'messageSends'
 	],
 	#category : 'OpalCompiler-Core-Extras',
 	#package : 'OpalCompiler-Core',
 	#tag : 'Extras'
 }
 
 { #category : 'adding' }
-OCLiteralList >> addLiteral: anObject [
+OCLiteralList >> addIndexedElement: anObject to: aCollection [
+
+	| index |
+	index := self arraySize + 1.
 
 	"I keep the first element, so it can be easily returned"
-	literalsDict ifEmpty: [ first := anObject ].
+	index = 1 ifTrue: [ first := anObject ].
 
 	"The index of the last inserted element is the the size of the literalsDict,
 	as the elements are always added and never removed"
-	^ literalsDict at: anObject ifAbsentPut: [ literalsDict size + 1 ]
+	^ aCollection at: anObject ifAbsentPut: index.
+]
+
+{ #category : 'adding' }
+OCLiteralList >> addLiteral: anObject [
+
+	^ self addIndexedElement: anObject to: literalsDict
+]
+
+{ #category : 'adding' }
+OCLiteralList >> addMessageSelector: selector [
+
+	^ self addIndexedElement: selector to: messageSends
+]
+
+{ #category : 'converting' }
+OCLiteralList >> arraySize [
+	^ messageSends size * 3 + literalsDict size.
+
 ]
 
 { #category : 'converting' }
 OCLiteralList >> asArray [
 
 	| result |
 
-	result := Array new: literalsDict size.
+	result := Array new: self arraySize.
 
 	literalsDict associationsDo: [ :anAssoc | result at: anAssoc value put: anAssoc key ].
+	messageSends associationsDo: [ :anAssoc | result at: anAssoc value put: anAssoc key ].
 
 	^ result
 ]
@@ -48,7 +71,8 @@ OCLiteralList >> first [
 OCLiteralList >> initialize [
 
 	super initialize.
-	literalsDict := OCLiteralDictionary new
+	literalsDict := OCLiteralDictionary new.
+	messageSends := OCLiteralDictionary new.
 ]
 
 { #category : 'testing' }

src/Reflectivity/ReflectiveMethod.class.st

@@ -85,6 +85,12 @@ ReflectiveMethod >> destroyTwin [
 	SystemAnnouncer uniqueInstance unsubscribe: self
 ]
 
+{ #category : 'forwarding' }
+ReflectiveMethod >> doFlushCache [
+	"See MethodDictionary class comment."
+	<primitive: 116>
+]
+
 { #category : 'forwarding' }
 ReflectiveMethod >> doesNotUnderstand: aMessage [
 	^aMessage sendTo: compiledMethod
@@ -93,7 +99,9 @@ ReflectiveMethod >> doesNotUnderstand: aMessage [
 { #category : 'forwarding' }
 ReflectiveMethod >> flushCache [
 	"See MethodDictionary class comment."
-	<primitive: 116>
+	"Q: Is this correct?"
+	Smalltalk cleanAllICsForMethod: self.
+	self doFlushCache
 ]
 
 { #category : 'evaluation' }