[VM] [ENH] [EXPERIMENTAL] New method cache results.

Scott A Crosby crosby at qwes.math.cmu.edu
Wed Oct 3 18:56:57 UTC 2001


Well, I did the new method cache. (The number after the name is the number
of slots it has)

It appears that I get about 4.5% on macroBenchmark1, by using a 8192
element cache.

Note that:
 1. new8192opt and old were compiled with full optimization;
 2. new512, new8192, and new32768 were compiled with different compiler options.
 3. The number after the new is the number of cache slots.


--- Results on millisecondsToRun: macroBenchmark1
new512 :83523
new8192 :82780
old :85525
new32768 :84554
new32768 :84629
new512opt :81889

--- Results on millisecondsToRun: macroBenchmark2

new8192 :53773
old :55276
new512 :53737
new512opt :53563

--

Here are rough miss rates, these different runs had different behaivor and
different use, so they cannot be compared except for generalities:

New cache results 32768 slots 4 probes:
  Overall miss rate: 0.0022517
  First probe miss rate: 0.062509


New cache results 8192 slots 4 probes:
  Overall miss rate: 0.0057631
  First probe miss rate: .10140


New cache results 512 slots 4 probes:
  Overall miss rate: .056431
  First probe miss rate: 0.64578


Old cache:
  Overall Miss rate: 0.044352
  First probe miss rate .66

--

It works for me; I'm building it into my new VM.


Scott



--
No DVD movie will ever enter the public domain, nor will any CD. The last CD
and the last DVD will have moldered away decades before they leave copyright.
This is not encouraging the creation of knowledge in the public domain.


-------------- next part --------------
'From Squeak3.1alpha of 7 March 2001 [latest update: #4164] on 3 October 2001 at 11:11:22 am'!
ObjectMemory subclass: #Interpreter
	instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext messageSelector argumentCount newMethod currentBytecode successFlag primitiveIndex methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptKeycode interruptPending semaphoresToSignalA semaphoresUseBufferA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks extraVMMemory newNativeMethod methodClass receiverClass interpreterVersion obsoleteIndexedPrimitiveTable obsoleteNamedPrimitiveTable interpreterProxy showSurfaceFn interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable cacheRandomState '
	classVariableNames: 'ActiveProcessIndex AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BytecodeTable CacheProbeMax CallerIndex CharacterValueIndex CompilerHooksSize CrossedX DirBadPath DirEntryFound DirNoMoreEntries EndOfRun ExcessSignalsIndex FirstLinkIndex GenerateBrowserPlugin HeaderIndex HomeIndex InitialIPIndex InstanceSpecificationIndex InstructionPointerIndex JitterTable LastLinkIndex LiteralStart MaxExternalPrimitiveTableSize MaxPrimitiveIndex MessageArgumentsIndex MessageDictionaryIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodCacheClass MethodCacheEntries MethodCacheEntrySize MethodCacheMask MethodCacheMethod MethodCacheNative MethodCachePrim MethodCacheSelector MethodCacheSize MethodIndex MillisecondClockMask MyListIndex NextLinkIndex PrimitiveExternalCallIndex PrimitiveTable PriorityIndex ProcessListsIndex ReceiverIndex SelectorStart SemaphoresToSignalSize SenderIndex StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TempFrameStart ValueIndex XIndex YIndex Must CacheProbeShift '
	poolDictionaries: ''
	category: 'VMConstruction-Interpreter'!

!Interpreter methodsFor: 'initialization' stamp: 'sac 10/3/2001 08:42'!
initializeInterpreter: bytesToShift 
	"Initialize Interpreter state before starting execution of a new image."
	interpreterProxy _ self sqGetInterpreterProxy.
	self initializeObjectMemory: bytesToShift.
	self initCompilerHooks.
	self flushExternalPrimitives.
	activeContext _ nilObj.
	theHomeContext _ nilObj.
	method _ nilObj.
	receiver _ nilObj.
	messageSelector _ nilObj.
	newMethod _ nilObj.
	methodClass _ nilObj.
	lkupClass _ nilObj.
	receiverClass _ nilObj.
	cacheRandomState _ 1.
	self flushMethodCache.
	self flushAtCache.
	self loadInitialContext.
	interruptCheckCounter _ 0.
	interruptCheckCounterFeedBackReset _ 1000.
	interruptChecksEveryNms _ 5.
	nextPollTick _ 0.
	nextWakeupTick _ 0.
	lastTick _ 0.
	interruptKeycode _ 2094.
	"cmd-."
	interruptPending _ false.
	semaphoresUseBufferA _ true.
	semaphoresToSignalCountA _ 0.
	semaphoresToSignalCountB _ 0.
	deferDisplayUpdates _ false.
	pendingFinalizationSignals _ 0.

	"Initialize these to numbers."
	primitiveIndex _ 0.
	newNativeMethod _ 0.! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/3/2001 09:50'!
addNewMethodToCache
	"Add the given entry to the method cache.  
	The policy is as follows:  
	Look for an empty entry anywhere in the reprobe chain.  
	If found, install the new entry there.  
	If not found, then install the new entry at the first probe position  
	and delete the entries in the rest of the reprobe chain.  
	This has two useful purposes:  
	If there is active contention over the first slot, the second  
	or third will likely be free for reentry after ejection.  
	Also, flushing is good when reprobe chains are getting full."
	| probe hash |
	self inline: false.
	self compilerTranslateMethodHook.
	"newMethod x lkupClass -> newNativeMethod (may cause GC !!)"
	hash _ self hashIndex: messageSelector with: lkupClass.

	"The cache is almost always going to be full, so don't bother to find an empty slot, just do random replacement."	

	probe _ hash + ((cacheRandomState bitAnd: CacheProbeMax - 1)
					* MethodCacheEntrySize).
	"Overwrite an entry."
	methodCache at: probe + MethodCacheSelector put: messageSelector.
	methodCache at: probe + MethodCacheClass put: lkupClass.
	methodCache at: probe + MethodCacheMethod put: newMethod.
	methodCache at: probe + MethodCachePrim put: primitiveIndex.
	methodCache at: probe + MethodCacheNative put: newNativeMethod.
	"Construct a new random seed."
	cacheRandomState _ cacheRandomState * 23 >> 4 + 1 bitAnd: 16777215! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 9/25/2001 03:25'!
flushAtCache
	self inline: false.
	1 to: AtCacheTotalSize do: [ :i | atCache at: i put: 0].! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 9/25/2001 03:25'!
flushMethodCache
	"Flush the method cache. The method cache is flushed on every programming change and garbage collect."
	self inline: false.
	1 to: MethodCacheSize do: [ :i | methodCache at: i put: 0 ].

! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/2/2001 20:02'!
hash: aSelector with: aClass
	"Compute the hash code for the selector and class."
	^(aSelector bitXor: aClass).
! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/3/2001 07:38'!
hashIndex: aSelector with: aClass 
	"Compute the slot index in the hash table for the given selector and  
	class."
	^ (self hash: aSelector with: aClass)
		bitAnd: ((MethodCacheMask << CacheProbeShift) bitAnd: MethodCacheMask).! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/2/2001 20:16'!
invalidateMethodCache

	| probe |
	"Invalidate the method cache. Don't remove unused entries. Just invalidate everything."
	"Flush the method cache. The method cache is flushed on every programming change and garbage collect."
	
	probe _ 0.
	1 to: MethodCacheEntries do: [ :i |
methodCache at: probe + MethodCacheSelector put: 0.
		probe _ probe + MethodCacheEntrySize].
! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/3/2001 09:14'!
lookupInMethodCacheSel: selector class: class 
	"This method implements a simple method lookup cache. If an entry for  
	the given selector and class is found in the cache, set the values of  
	'newMethod' and 'primitiveIndex' and return true. Otherwise, return  
	false."
	"About the re-probe scheme: The hash is the low bits of the XOR of two  
	large addresses, minus their useless lowest two bits. If a probe doesn't  
	get a hit, the hash is shifted right one bit to compute the next probe,  
	introducing a new randomish bit. The cache is probed CacheProbeMax  
	times before giving up."
	"WARNING: Since the hash computation is based on the object addresses of 
	the class and selector, we must rehash or flush when compacting  
	storage. We've chosen to flush, since that also saves the trouble of  
	updating the addresses of the objects in the cache."
	| hash probe |
	self inline: true.
	hash _ self hashIndex: selector with: class.
	"shift drops two low-order zeros from addresses"
	probe _ hash.
	"first probe"
	((methodCache at: probe + MethodCacheSelector)
				= selector
			and: [(methodCache at: probe + MethodCacheClass)
					= class])
		ifTrue: [newMethod _ methodCache at: probe + MethodCacheMethod.
			primitiveIndex _ methodCache at: probe + MethodCachePrim.
			newNativeMethod _ methodCache at: probe + MethodCacheNative.
			^ true].
	"Damn, didn't find it first, so we do the long search among the rest."
	1
		to: CacheProbeMax - 1
		do: [:i | 
			probe _ hash + (i * MethodCacheEntrySize).
			"All later probes."
			((methodCache at: probe + MethodCacheSelector)
						= selector
					and: [(methodCache at: probe + MethodCacheClass)
							= class])
				ifTrue: ["Get the feedback."
					newMethod _ methodCache at: probe + MethodCacheMethod.
					primitiveIndex _ methodCache at: probe + MethodCachePrim.
					newNativeMethod _ methodCache at: probe + MethodCacheNative.
					"And swap this entry with the last one."
					self swapCacheWithPrevEntry: probe.
					^ true]].
	^ false! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/3/2001 08:34'!
rewriteMethodCacheSel: selector class: class primIndex: localPrimIndex 
	"Rewrite an existing entry in the method cache with a new primitive  
	index."
	| probe hash |
	self inline: false.
	hash _ self hashIndex: selector with: class.
	0
		to: CacheProbeMax - 1
		do: [:p | 
			probe _ hash + (p * MethodCacheEntrySize).
			((methodCache at: probe + MethodCacheSelector)
						= selector
					and: [(methodCache at: probe + MethodCacheClass)
							= class])
				ifTrue: [methodCache at: probe + MethodCachePrim put: localPrimIndex.
					^ nil]]! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/2/2001 20:44'!
swapCacheWithPrevEntry: probe
	self inline: true.
	self swapFieldWithPrevEntry: probe offset: MethodCacheSelector.
	self swapFieldWithPrevEntry: probe offset: MethodCacheClass.
	self swapFieldWithPrevEntry: probe offset: MethodCacheMethod.
	self swapFieldWithPrevEntry: probe offset: MethodCachePrim.
	self swapFieldWithPrevEntry: probe offset: MethodCacheNative.
	! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/2/2001 20:44'!
swapFieldWithPrevEntry: probe offset: offset
	| t u |
	self inline: true.
	t _ methodCache at: probe + offset.
	u _ methodCache at: probe - MethodCacheEntrySize + offset.
	methodCache at: probe + offset put: u.
	methodCache at: probe - MethodCacheEntrySize + offset put: t.
	! !

!Interpreter methodsFor: 'object access primitives' stamp: 'sac 9/25/2001 03:24'!
primitiveChangeClass
	"Primitive. Change the class of the receiver into the class of the argument given that the format of the receiver matches the format of the argument's class. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have."
	| arg rcvr argClass classHdr sizeHiBits byteSize argFormat rcvrFormat ccIndex |
	arg _ self stackObjectValue: 0.
	rcvr _ self stackObjectValue: 1.
	successFlag ifFalse:[^nil].

	"Get the class we want to convert the receiver into"
	argClass _ self fetchClassOf: arg.

	"Check what the format of the class says"
	classHdr _ self formatOfClass: argClass. "Low 2 bits are 0"

	"Compute the size of instances of the class (used for fixed field classes only)"
	sizeHiBits _ (classHdr bitAnd: 16r60000) >> 9.
	classHdr _ classHdr bitAnd: 16r1FFFF.
	byteSize _ (classHdr bitAnd: SizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"

	"Check the receiver's format against that of the class"
	argFormat _ (classHdr >> 8) bitAnd: 16rF.
	rcvrFormat _ self formatOf: rcvr.
	argFormat = rcvrFormat ifFalse:[^self success: false]. "no way"

	"For fixed field classes, the sizes must match.
	Note: byteSize-4 because base header is included in class size."
	argFormat < 2 ifTrue:[(byteSize - 4) = (self byteSizeOf: rcvr) ifFalse:[^self success: false]].

	(self headerType: rcvr) = HeaderTypeShort ifTrue:[
		"Compact classes. Check if the arg's class is compact and exchange ccIndex"
		ccIndex _ classHdr bitAnd: CompactClassMask.
		ccIndex = 0 ifTrue:[^self success: false]. "class is not compact"
		self longAt: rcvr put:
			(((self longAt: rcvr) bitAnd: CompactClassMask bitInvert32)
				bitOr: ccIndex)
	] ifFalse:[
		"Exchange the class pointer, which could make rcvr a root for argClass"
		self longAt: rcvr-4 put: (argClass bitOr: (self headerType: rcvr)).
		(rcvr < youngStart) ifTrue: [
			self possibleRootStoreInto: rcvr value: argClass.
		].
	].
	"Flush cache because rcvr's class has changed"
	self flushMethodCache.
	self flushAtCache.

	successFlag ifTrue: [ self pop: 1 ].! !

!Interpreter methodsFor: 'other primitives' stamp: 'sac 10/2/2001 20:24'!
primitiveFlushCache
	"Clear the method lookup cache. This must be done after every 
	programming change."
	self invalidateMethodCache.
	self flushAtCache.
	self compilerFlushCacheHook: nil! !

!Interpreter methodsFor: 'plugin support' stamp: 'sac 9/25/2001 03:23'!
flushExternalPrimitives
	"Flush the references to external functions from plugin primitives.
	This will force a reload of those primitives when accessed next.
	Note: We must flush the method cache here so that any failed
	primitives are looked up again."
	| oop fmt primIdx |
	oop _ self firstObject.
	[oop < endOfMemory] whileTrue:[
		(self isFreeObject: oop) ifFalse: [
			fmt _ self formatOf: oop.
			fmt >= 12 ifTrue:["This is a compiled method"
				primIdx _ self primitiveIndexOf: oop.
				primIdx = PrimitiveExternalCallIndex ifTrue:["It's primitiveExternalCall"
					self flushExternalPrimitiveOf: oop.
				].
			].
		].
		oop _ self objectAfter: oop.
	].
	self flushMethodCache.
	self flushAtCache.
	self flushObsoleteIndexedPrimitives.
	self flushExternalPrimitiveTable.! !


!Interpreter class methodsFor: 'initialization' stamp: 'sac 10/3/2001 10:55'!
initializeCaches
	| atCacheEntrySize |
	MethodCacheEntries _ 8192.
	MethodCacheSelector _ 1.
	MethodCacheClass _ 2.
	MethodCacheMethod _ 3.
	MethodCachePrim _ 4.
	MethodCacheNative _ 5.
	MethodCacheEntrySize _ 8.
	"Must be power of two for masking scheme."
	MethodCacheMask _ MethodCacheEntries - 1 * MethodCacheEntrySize.
	MethodCacheSize _ MethodCacheEntries * MethodCacheEntrySize.
	CacheProbeShift _ 2.
	CacheProbeMax _ 1 << CacheProbeShift.
	AtCacheEntries _ 8.
	"Must be power of two"
	AtCacheOop _ 1.
	AtCacheSize _ 2.
	AtCacheFmt _ 3.
	AtCacheFixedFields _ 4.
	atCacheEntrySize _ 4.
	"Must be power of two for masking scheme."
	AtCacheMask _ AtCacheEntries - 1 * atCacheEntrySize.
	AtPutBase _ AtCacheEntries * atCacheEntrySize.
	AtCacheTotalSize _ AtCacheEntries * atCacheEntrySize * 2! !

ObjectMemory subclass: #Interpreter
	instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext messageSelector argumentCount newMethod currentBytecode successFlag primitiveIndex cacheRandomState methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptKeycode interruptPending semaphoresToSignalA semaphoresUseBufferA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks extraVMMemory newNativeMethod methodClass receiverClass interpreterVersion obsoleteIndexedPrimitiveTable obsoleteNamedPrimitiveTable interpreterProxy showSurfaceFn interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable '
	classVariableNames: 'ActiveProcessIndex AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BytecodeTable CacheProbeMax CacheProbeShift CallerIndex CharacterValueIndex CompilerHooksSize CrossedX DirBadPath DirEntryFound DirNoMoreEntries EndOfRun ExcessSignalsIndex FirstLinkIndex GenerateBrowserPlugin HeaderIndex HomeIndex InitialIPIndex InstanceSpecificationIndex InstructionPointerIndex JitterTable LastLinkIndex LiteralStart MaxExternalPrimitiveTableSize MaxPrimitiveIndex MessageArgumentsIndex MessageDictionaryIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodCacheClass MethodCacheEntries MethodCacheEntrySize MethodCacheMask MethodCacheMethod MethodCacheNative MethodCachePrim MethodCacheSelector MethodCacheSize MethodIndex MillisecondClockMask Must MyListIndex NextLinkIndex PrimitiveExternalCallIndex PrimitiveTable PriorityIndex ProcessListsIndex ReceiverIndex SelectorStart SemaphoresToSignalSize SenderIndex StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TempFrameStart ValueIndex XIndex YIndex '
	poolDictionaries: ''
	category: 'VMConstruction-Interpreter'!


More information about the Squeak-dev mailing list