[Vm-dev] VM Maker: VMMaker.oscog-eem.1914.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Aug 4 21:40:14 UTC 2016


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1914.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.1914
Author: eem
Time: 4 August 2016, 2:38:32.219752 pm
UUID: aebe2acd-39a2-49da-a2b8-c1ba08392137
Ancestors: VMMaker.oscog-nice.1913

Fix bad performance regression with open PICs and fix slip in generated perform primitive.  The regression, when the open PIC compilation code was refactored to eliminate duplication of the probe generation, was to misorder the probes, so that when a new method was entered into the cache at a clashing line, which zeros the two entries following the first, the open PIC would search for the last entry, hence always missing.

The perform code had two copies of the second probe and no third probe.

Improve method cache locality in Spur, which uses class indices and tag patterns as class tags.  Shift up the class tag by 2 bits so that the least significant two bits are included in the hash.

Remember to nil out the last uncoggable method variables on code compaction, become, GC

JIT blocks more agressively in the value primitive; always try and JIT (unless noted in lastUncoggableInterpretedBlockMethod) if reached from the machine code primitive.

Make sure retryPrimitiveOnFailure is option: #SpurObjectMemory.

Improve method cache printing to include hex hashes and totals of printed items.

Change traceFlags so that traceFlag 2 prints only interpreted sends, and trace flags 258 print both interpreted and machine code sends.

Correct, but not fix, ceTraceStoreOf:into: for Spur (use isImmediate:, but not fixed cuz stores may not be into ReceiverResultReg any more).

Simulator:
Set simulator window colour in a more direct way.

=============== Diff against VMMaker.oscog-nice.1913 ===============

Item was changed:
  ----- Method: CoInterpreter>>activateNewClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
  activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
  	"Similar to activateNewMethod but for Closure and newMethod.
  	 Override to handle the various interpreter/machine code transitions
  	 and to create an appropriate frame layout."
  	| numCopied outerContext theMethod methodHeader inInterpreter closureIP switched |
  	<inline: true>
  	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
  	self assert: (objectMemory isContext: outerContext).
  	self assert: outerContext ~= blockClosure.
  	numCopied := self copiedValueCountOfClosure: blockClosure.
  	theMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
  	self assert: (objectMemory isOopCompiledMethod: theMethod).
  	methodHeader := self rawHeaderOf: theMethod.
  	(self isCogMethodReference: methodHeader) ifTrue:
  		[^self executeCogBlock: (self cogMethodOf: theMethod)
  			closure: blockClosure
  			mayContextSwitch: mayContextSwitch].
  	"How do we know when to compile a block method?
  	 One simple criterion is to check if the block is running within its inner context,
  	 i.e. if the outerContext is married.
  	 Even simpler is to remember the previous block entered via the interpreter and
  	 compile if this is the same one.  But we can thrash trying to compile an uncoggable
  	 method unless we try and remember which ones can't be cogged.  So also record
  	 the last block method we failed to compile and avoid recompiling it."
  	(self methodWithHeaderShouldBeCogged: methodHeader)
  		ifTrue:
+ 			[(instructionPointer < objectMemory startOfMemory "If from machine code (via value primitive) attempt jitting"
+ 			  or: [theMethod = lastCoggableInterpretedBlockMethod]) "If from interpreter and repeat block, attempt jitting"
- 			[theMethod = lastCoggableInterpretedBlockMethod
  				ifTrue:
  					[theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue:
  						[cogit cog: theMethod selector: objectMemory nilObject.
  						 (self methodHasCogMethod: theMethod) ifTrue:
  							[^self executeCogBlock: (self cogMethodOf: theMethod)
  								closure: blockClosure
  								mayContextSwitch: mayContextSwitch].
  						 cogCompiledCodeCompactionCalledFor ifFalse:
  							[lastUncoggableInterpretedBlockMethod := theMethod]]]
  				ifFalse:
  					[lastCoggableInterpretedBlockMethod := theMethod]]
  		ifFalse:
  			[self maybeFlagMethodAsInterpreted: theMethod].
  
  	self assert: (self methodHasCogMethod: theMethod) not.
  	"Because this is an uncogged method we need to continue via the interpreter.
  	 We could have been reached either from the interpreter, in which case we
  	 should simply return, or from a machine code frame or from a compiled
  	 primitive.  In these latter two cases we must longjmp back to the interpreter.
  	 The instructionPointer tells us which path we took.
  	 If the sender was an interpreter frame but called through a (failing) primitive
  	 then make sure we restore the saved instruction pointer and avoid pushing
  	 ceReturnToInterpreterPC which is only valid between an interpreter caller
  	 frame and a machine code callee frame."
  	(inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse:
  		[instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
  			[instructionPointer := self iframeSavedIP: framePointer]].
  	self push: instructionPointer.
  	self push: framePointer.
  	framePointer := stackPointer.
  	self push: theMethod.
  	self push: objectMemory nilObject. "FxThisContext field"
  	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
  	self push: 0. "FoxIFSavedIP"
  	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
  	self push: (objectMemory followField: ReceiverIndex ofObject: outerContext).
  
  	"Copy the copied values..."
  	0 to: numCopied - 1 do:
  		[:i|
  		self push: (objectMemory
  					fetchPointer: i + ClosureFirstCopiedValueIndex
  					ofObject: blockClosure)].
  
  	self assert: (self frameIsBlockActivation: framePointer).
  	self assert: (self frameHasContext: framePointer) not.
  
  	"The initial instructions in the block nil-out remaining temps."
  
  	"the instruction pointer is a pointer variable equal to 
  	method oop + ip + BaseHeaderSize 
  	-1 for 0-based addressing of fetchByte 
  	-1 because it gets incremented BEFORE fetching currentByte"
  	closureIP := self quickFetchInteger: ClosureStartPCIndex ofObject: blockClosure.
  	instructionPointer := theMethod + closureIP + objectMemory baseHeaderSize - 2.
  	self setMethod: theMethod methodHeader: methodHeader.
  
  	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
  	switched := false.
  	stackPointer < stackLimit ifTrue:
  		[switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch].
  	self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was changed:
  ----- Method: CoInterpreter>>ceSendFromInLineCacheMiss: (in category 'trampolines') -----
  ceSendFromInLineCacheMiss: cogMethodOrPIC
  	"Send from an Open PIC when the first-level method lookup probe has failed,
  	 or to continue when PIC creation has failed (e.g. because we're out of code space),
  	 or when a send has failed due to a forwarded receiver."
  	<api>
  	<var: #cogMethodOrPIC type: #'CogMethod *'>
  	| numArgs rcvr classTag classObj errSelIdx |
  	"self printFrame: stackPage headFP WithSP: stackPage headSP"
  	"self printStringOf: selector"
  	numArgs := cogMethodOrPIC cmNumArgs.
  	rcvr := self stackValue: numArgs + 1. "skip return pc"
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	classTag := objectMemory fetchClassTagOf: rcvr.
  	argumentCount := numArgs.
+ 	false ifTrue: "would like to assert this but must also allow for an interpretable method in the cache."
+ 		[self deny: (cogMethodOrPIC cmType = CMOpenPIC
+ 					and: [self newMethodInLookupCacheAt: cogMethodOrPIC selector and: classTag])].
  	(self lookupInMethodCacheSel: cogMethodOrPIC selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: cogMethodOrPIC selector]
  		ifFalse:
  			[(objectMemory isOopForwarded: cogMethodOrPIC selector) ifTrue:
  				[self handleForwardedSelectorFaultFor: cogMethodOrPIC selector.
  				 ^self ceSendFromInLineCacheMiss: cogMethodOrPIC].
  			 (objectMemory isForwardedClassTag: classTag) ifTrue:
  				[self handleForwardedSendFaultForReceiver: rcvr stackDelta: 1 "skip return pc".
  				 ^self ceSendFromInLineCacheMiss: cogMethodOrPIC].
  			 messageSelector := cogMethodOrPIC selector.
  			 classObj := objectMemory classForClassTag: classTag.
  			 (errSelIdx := self lookupOrdinaryNoMNUEtcInClass: classObj) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: classObj.
  				"NOTREACHED"
  				self assert: false].
  			 self addNewMethodToCache: classObj].
  	instructionPointer := self popStack.
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceTraceStoreOf:into: (in category 'trampolines') -----
  ceTraceStoreOf: aValue into: anObject
  	<api>
  	"For assertion checking."
+ 	self assert: ((objectMemory isImmediate: aValue) or: [objectMemory addressCouldBeObj: aValue]).
- 	self assert: ((objectMemory isIntegerObject: aValue) or: [objectMemory addressCouldBeObj: aValue]).
  	self assert: (objectMemory addressCouldBeObj: anObject)!

Item was changed:
+ ----- Method: CoInterpreter>>commenceCogCompiledCodeCompaction (in category 'cog jit support') -----
- ----- Method: CoInterpreter>>commenceCogCompiledCodeCompaction (in category 'process primitive support') -----
  commenceCogCompiledCodeCompaction
  	| startTime |
  	<var: #startTime type: #usqLong>
  	cogCompiledCodeCompactionCalledFor := false.
  	cogit recordEventTrace ifTrue:
  		[self recordTrace: TraceCodeCompaction thing: TraceCodeCompaction source: 0].
  	cogit recordPrimTrace ifTrue:
  		[self fastLogPrim: TraceCodeCompaction].
  	startTime := self ioUTCMicrosecondsNow.
  
  	"This can be called in a number of circumstances.  The instructionPointer
  	 may contain a native pc that must be relocated.  There may already be a
  	 pushed instructionPointer on stack.  Clients ensure that instructionPointer
  	 is 0 if it should not be pushed and/or relocated.  Pushing twice is a mistake
  	 because only the top one will be relocated."
  	instructionPointer ~= 0 ifTrue:
  		["better not have already been pushed"
  		 self assert: self stackTop asUnsignedInteger ~= instructionPointer.
  		 self push: instructionPointer.
  		 self externalWriteBackHeadStackPointer].
  	self assertValidStackedInstructionPointers: #'__LINE__'.
  	cogit compactCogCompiledCode.
+ 	self nilUncoggableMethods.
  	instructionPointer ~= 0 ifTrue:
  		[instructionPointer := self popStack.
  		 self externalWriteBackHeadStackPointer].
  	self assertValidStackedInstructionPointers: #'__LINE__'.
  
  	statCodeCompactionCount := statCodeCompactionCount + 1.
  	statCodeCompactionUsecs := statCodeCompactionUsecs + (self ioUTCMicrosecondsNow - startTime).
  
  	objectMemory checkForLeaks ~= 0 ifTrue:
  		[objectMemory clearLeakMapAndMapAccessibleObjects.
  		 self asserta: (self checkCodeIntegrity: false)]!

Item was added:
+ ----- Method: CoInterpreter>>newMethodInLookupCacheAt:and: (in category 'method lookup cache') -----
+ newMethodInLookupCacheAt: selector and: classTag
+ 	"Answer if classTag x messageSelector => newMethod is in the lookup cache.
+ 	 This is for assert checking to check that open PICs find entries."
+ 	| probe hash |
+ 	<inline: false>
+ 	hash := objectMemory methodCacheHashOf: selector with: classTag.
+ 
+ 	0 to: CacheProbeMax-1 do:
+ 		[:p |
+ 		probe := (hash >> p) bitAnd: MethodCacheMask.
+ 		((methodCache at: probe + MethodCacheSelector) = selector
+ 		 and: [(methodCache at: probe + MethodCacheClass) = classTag
+ 		 and: [(methodCache at: probe + MethodCacheMethod) = newMethod]]) ifTrue:
+ 			[^true]].
+ 
+ 	^false!

Item was added:
+ ----- Method: CoInterpreter>>nilUncoggableMethods (in category 'cog jit support') -----
+ nilUncoggableMethods
+ 	<inline: true>
+ 	lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil!

Item was changed:
  ----- Method: CoInterpreter>>postBecomeAction: (in category 'object memory support') -----
  postBecomeAction: theBecomeEffectsFlags
  	"Clear the gcMode var and let the Cogit do its post GC checks."
  	super postBecomeAction: theBecomeEffectsFlags.
  
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [theBecomeEffectsFlags anyMask: OldBecameNewFlag]) ifTrue:
  		[cogit addAllToYoungReferrers].
  	cogit cogitPostGCAction: gcMode.
+ 	self nilUncoggableMethods.
- 
- 	lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil.
- 
  	gcMode := 0!

Item was changed:
  ----- Method: CoInterpreter>>postGCAction: (in category 'object memory support') -----
  postGCAction: gcModeArg
  	"Attempt to shrink free memory, signal the gc semaphore and let the Cogit do its post GC thang"
  	<inline: false>
  	self assert: gcModeArg = gcMode.
  	super postGCAction: gcModeArg.
  	cogit cogitPostGCAction: gcModeArg.
+ 	self nilUncoggableMethods.
- 	lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil.
  	gcMode := 0!

Item was changed:
  ----- Method: CoInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
  printMethodCacheFor: thing
  	<api>
+ 	| n |
+ 	n := 0.
  	0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
  		[:i | | s c m p |
  		s := methodCache at: i + MethodCacheSelector.
  		c := methodCache at: i + MethodCacheClass.
  		m := methodCache at: i + MethodCacheMethod.
  		p := methodCache at: i + MethodCachePrimFunction.
  		((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing
  			or: [(objectMemory addressCouldBeObj: m)
  				and: [(self maybeMethodHasCogMethod: m)
  				and: [(self cogMethodOf: m) asInteger = thing]]]]]]])
  		 and: [(objectMemory addressCouldBeOop: s)
  		 and: [c ~= 0
  		 and: [(self addressCouldBeClassObj: c)
  			or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
+ 			[n := n + 1.
+ 			 self cCode: [] inSmalltalk: [self transcript ensureCr].
+ 			 self printNum: i; space; printHexnp: i; cr; tab.
- 			[self cCode: [] inSmalltalk: [self transcript ensureCr].
- 			 self printNum: i; cr; tab.
  			 (objectMemory isBytesNonImm: s)
  				ifTrue: [self cCode: 'printf("%lx %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))'
  						inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
  				ifFalse: [self shortPrintOop: s].
  			 self tab.
  			 (self addressCouldBeClassObj: c)
  				ifTrue: [self shortPrintOop: c]
+ 				ifFalse: [self printNum: c; space; printHexnp: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
- 				ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
  			self tab; shortPrintOop: m; tab.
  			self cCode:
  					[p > 1024
  						ifTrue: [self printHexnp: p]
  						ifFalse: [self printNum: p]]
  				inSmalltalk:
  					[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
+ 			self cr]].
+ 	n > 1 ifTrue:
+ 		[self printNum: n; cr]!
- 			self cr]]!

Item was added:
+ ----- Method: CogObjectRepresentation>>maybeShiftClassTagRegisterForMethodCacheProbe: (in category 'method cacheing') -----
+ maybeShiftClassTagRegisterForMethodCacheProbe: classTagReg
+ 	"If required, generate a shift of the register containing the class tag in a method cache probe.
+ 	 By default this is a no-op.  Subclasses redefine as required."
+ 
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>maybeShiftClassTagRegisterForMethodCacheProbe: (in category 'method cacheing') -----
+ maybeShiftClassTagRegisterForMethodCacheProbe: classTagReg
+ 	"Generate a shift of the register containing the class tag in a method cache probe.
+ 	 c.f. SpurMemoryManager>>methodCacheHashOf:with:"
+ 
+ 	cogit LogicalShiftLeftCq: 2 R: classTagReg.
+ 	^0!

Item was changed:
+ ----- Method: CogVMSimulator>>commenceCogCompiledCodeCompaction (in category 'cog jit support') -----
- ----- Method: CogVMSimulator>>commenceCogCompiledCodeCompaction (in category 'process primitive support') -----
  commenceCogCompiledCodeCompaction
  	self halt.
  	^super commenceCogCompiledCodeCompaction!

Item was changed:
  ----- Method: CogVMSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
  	| localImageName borderWidth window |
  	localImageName := imageName
  							ifNotNil: [FileDirectory default localNameFor: imageName]
  							ifNil: [' synthetic image'].
  	window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
+ 	window paneColor: Color lightBlue.
- 
  	window addMorph: (displayView := SimulatorImageMorph new image: displayForm)
  			frame: (0 at 0 corner: 1 at 0.8).
  	displayView activeHand addEventListener: self.
  	eventTransformer := SimulatorEventTransformer new.
  
  	transcript := TranscriptStream on: (String new: 10000).
  	window addMorph: (PluggableTextMorph
  							on: transcript text: nil accept: nil
  							readSelection: nil menu: #codePaneMenu:shifted:)
  			frame: (0 at 0.8 corner: 0.7 at 1).
  	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil
  						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  			frame: (0.7 at 0.8 corner: 1 at 1).
  
  	borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
  						on: MessageNotUnderstood
  						do: [:ex| 0]. "3.8"
  	borderWidth := borderWidth + window borderWidth.
  	window openInWorldExtent: (self desiredDisplayExtent
  								+ (2 * borderWidth)
  								+ (0 at window labelHeight)
  								* (1@(1/0.8))) rounded.
  	^window!

Item was changed:
  ----- Method: CogVMSimulator>>primitivePerform (in category 'debugging traps') -----
  primitivePerform
  	| selector |
+ 	"If called from the machine code perform primitive, it should not have been found."
  	selector := self stackValue: argumentCount - 1.
+ 	(self methodHasCogMethod: newMethod) ifTrue:
+ 		[self deny: (self newMethodInLookupCacheAt: selector and: (objectMemory fetchClassTagOf: (self stackValue: argumentCount)))].
  	self sendBreakpoint: selector receiver: (self stackValue: argumentCount).
  	(self filterPerformOf: selector to: (self stackValue: argumentCount)) ifTrue:
  		[^self pop: argumentCount].
  	^super primitivePerform!

Item was added:
+ ----- Method: CogVMSimulator>>printActivationNameForSelector:startClass: (in category 'debug printing') -----
+ printActivationNameForSelector: aSelector startClass: startClass
+ 	super printActivationNameForSelector: aSelector startClass: startClass.
+ 	"(self transcript dependents detect: [:d| d isTextView] ifNone: []) ifNotNil:
+ 		[:textView| | text size |
+ 		text := textView text asString.
+ 		((size := text size) >= 30
+ 		and: [(text copyFrom: size - 29 to: size) = 'Object(ProtoObject)>initialize']) ifTrue:
+ 			[self doOrDefer: [self changed: #byteCountText; changed: #composeAll].
+ 			 self halt]"!

Item was changed:
  ----- Method: Cogit>>compileSendTrace (in category 'debugging') -----
  compileSendTrace
+ 	"2 is trace sends; 256+2 is traceLinkedSends, so one can trace just unlinked sends using 2"
+ 	<cmacro: '() ((traceFlags & 258) == 258)'>
+ 	^traceFlags allMask: 256 + 2!
- 	<api>
- 	<cmacro: '() (traceFlags & 2)'>
- 	"256 = count sends, which is simulation only"
- 	^(traceFlags bitAnd: 256 + 2) ~= 0!

Item was changed:
  ----- Method: Cogit>>printMethodHeader:on: (in category 'disassembly') -----
  printMethodHeader: cogMethod on: aStream
  	<doNotGenerate>
  	self cCode: ''
  		inSmalltalk:
  			[cogMethod isInteger ifTrue:
  				[^self printMethodHeader: (self cogMethodOrBlockSurrogateAt: cogMethod) on: aStream]].
  	aStream ensureCr.
  	cogMethod asInteger printOn: aStream base: 16.
  	cogMethod cmType = CMMethod ifTrue:
  		[aStream crtab; nextPutAll: 'objhdr: '.
  		cogMethod objectHeader printOn: aStream base: 16].
  	cogMethod cmType = CMBlock ifTrue:
  		[aStream crtab; nextPutAll: 'homemth: '.
  		cogMethod cmHomeMethod asUnsignedInteger printOn: aStream base: 16.
  		aStream
  			nextPutAll: ' (offset '; print: cogMethod homeOffset; nextPut: $);
  			crtab; nextPutAll: 'startpc: '; print: cogMethod startpc].
  	aStream
  		crtab; nextPutAll: 'nArgs: ';	print: cogMethod cmNumArgs;
  		tab;    nextPutAll: 'type: ';	print: cogMethod cmType.
  	(cogMethod cmType ~= 0 and: [cogMethod cmType ~= CMBlock]) ifTrue:
  		[aStream crtab; nextPutAll: 'blksiz: '.
  		cogMethod blockSize printOn: aStream base: 16.
  		cogMethod cmType = CMMethod ifTrue:
  			[aStream crtab; nextPutAll: 'method: '.
  			 cogMethod methodObject printOn: aStream base: 16.
  			 aStream crtab; nextPutAll: 'mthhdr: '.
  			 cogMethod methodHeader printOn: aStream base: 16].
  		aStream crtab; nextPutAll: 'selctr: '.
  		cogMethod selector printOn: aStream base: 16.
  		(coInterpreter lookupAddress: cogMethod selector) ifNotNil:
  			[:string| aStream nextPut: $=; nextPutAll: string].
  		cogMethod cmType = CMMethod ifTrue:
  			[aStream crtab; nextPutAll: 'blkentry: '.
  			 cogMethod blockEntryOffset printOn: aStream base: 16.
  			 cogMethod blockEntryOffset ~= 0 ifTrue:
  				[aStream nextPutAll: ' => '.
  				 cogMethod asInteger + cogMethod blockEntryOffset printOn: aStream base: 16]]].
  	cogMethod cmType = CMClosedPIC
  		ifTrue:
  			[aStream crtab; nextPutAll: 'cPICNumCases: '.
+ 			 cogMethod cPICNumCases printOn: aStream base: 16.
+ 			 aStream tab; nextPutAll: 'cpicHasMNUCase: ';
- 			 cogMethod cPICNumCases printOn: aStream base: 16;
- 			 tab; nextPutAll: 'cpicHasMNUCase: ';
  			 nextPutAll: (cogMethod cpicHasMNUCase ifTrue: ['yes'] ifFalse: ['no'])]
  		ifFalse:
  			[aStream crtab; nextPutAll: 'stackCheckOffset: '.
  			 cogMethod stackCheckOffset printOn: aStream base: 16.
  			 cogMethod stackCheckOffset > 0 ifTrue:
  				[aStream nextPut: $/.
  				 cogMethod asInteger + cogMethod stackCheckOffset printOn: aStream base: 16].
  			cogMethod cmType = CMBlock
  				ifTrue:
  					[aStream
  						crtab;
  						nextPutAll: 'cbUsesInstVars ';
  						nextPutAll: (cogMethod cbUsesInstVars ifTrue: ['yes'] ifFalse: ['no'])]
  				ifFalse:
  					[aStream
  						crtab;
  						nextPutAll: 'cmRefersToYoung: ';
  						nextPutAll: (cogMethod cmRefersToYoung ifTrue: ['yes'] ifFalse: ['no']);
  						tab;
  						nextPutAll: 'cmIsFullBlock: ';
  						nextPutAll: (cogMethod cmIsFullBlock ifTrue: ['yes'] ifFalse: ['no'])].
  			cogMethod cmType = CMMethod ifTrue:
  				[([cogMethod nextMethodOrIRCs] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
  					[:nmoircs| aStream crtab; nextPutAll: 'nextMethodOrIRCs: '.
  						nmoircs = 0 ifTrue: [aStream print: nmoircs] ifFalse: [coInterpreter printHex: nmoircs]].
  				 ([cogMethod counters] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
  					[:cntrs| aStream crtab; nextPutAll: 'counters: '.
  						cntrs = 0 ifTrue: [aStream print: cntrs] ifFalse: [coInterpreter printHex: cntrs]]]].
  	aStream cr; flush!

Item was added:
+ ----- Method: NewObjectMemory>>methodCacheHashOf:with: (in category 'interpreter access') -----
+ methodCacheHashOf: selector with: classTag
+ 	"Since class tags are class objects, and classes are aligned on a 4 byte boundary there
+ 	 is no need to shift the class to include the least significant bits of the class in the hash."
+ 	<inline: true>
+ 	^selector bitXor: classTag!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
  compileOpenPIC: selector numArgs: numArgs
  	"Compile the code for an open PIC.  Perform a probe of the first-level method
  	 lookup cache followed by a call of ceSendFromInLineCacheMiss: if the probe fails."
  	| cacheBaseReg jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod |
  	<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
  	<var: #jumpClassMiss type: #'AbstractInstruction *'>
  	<var: #itsAHit type: #'AbstractInstruction *'>
  	<var: #jumpBCMethod type: #'AbstractInstruction *'>
  	self preenMethodLabel.
  	self compilePICAbort: numArgs.
+ 	entry := objectRepresentation genGetClassTagOf: ReceiverResultReg into: SendNumArgsReg scratchReg: TempReg.
- 	entry := objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
- 	self MoveR: ClassReg R: SendNumArgsReg.
  
  	self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
  
  	cacheBaseReg := NoReg.
  	(backEnd isWithinMwOffsetRange: coInterpreter methodCacheAddress) ifFalse:
  		[self MoveCq: coInterpreter methodCacheAddress R: (cacheBaseReg := Extra0Reg)].
  
  	"Do first of three probes.  See CoInterpreter>>lookupInMethodCacheSel:classTag:"
  	jumpSelectorMiss := self compileOpenPICMethodCacheProbeFor: selector withShift: 0 baseRegOrNone: cacheBaseReg.
  	jumpClassMiss := self JumpNonZero: 0.
  
  	"Fetch the method.  The interpret trampoline requires the bytecoded method in SendNumArgsReg"
  	itsAHit := self MoveMw: (cacheBaseReg = NoReg
  								ifTrue: [coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << objectMemory shiftForWord)]
  								ifFalse: [MethodCacheMethod << objectMemory shiftForWord])
  					r: ClassReg
  					R: SendNumArgsReg.
  			.
  	"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
  	objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
  	jumpBCMethod := objectRepresentation genJumpImmediate: ClassReg.
  	jumpBCMethod jmpTarget: picInterpretAbort.
  	self AddCq: cmNoCheckEntryOffset R: ClassReg.
  	self JumpR: ClassReg.
  
  	"First probe missed.  Do second of three probes.  Shift hash right one and retry."
  	jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
  	jumpSelectorMiss := self compileOpenPICMethodCacheProbeFor: selector withShift: 1 baseRegOrNone: cacheBaseReg.
  	self JumpZero: itsAHit.
  
  	"Second probe missed.  Do last probe.  Shift hash right two and retry."
  	jumpSelectorMiss jmpTarget: self Label.
  	jumpSelectorMiss := self compileOpenPICMethodCacheProbeFor: selector withShift: 2 baseRegOrNone: cacheBaseReg.
  	self JumpZero: itsAHit.
  
  	"Last probe missed.  Call ceSendFromInLineCacheMiss: to do the full lookup."
  	jumpSelectorMiss jmpTarget: self Label.
  	self numRegArgs > 0 ifTrue:
  		[backEnd genPushRegisterArgsForNumArgs: numArgs scratchReg: SendNumArgsReg].
  	self genSmalltalkToCStackSwitch: true.
  	methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
  	self 
  		compileCallFor: #ceSendFromInLineCacheMiss:
  		numArgs: 1
  		arg: SendNumArgsReg
  		arg: nil
  		arg: nil
  		arg: nil
  		resultReg: NoReg
  		regsToSave: self emptyRegisterMask
  	"Note that this call does not return."!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileOpenPICMethodCacheProbeFor:withShift:baseRegOrNone: (in category 'in-line cacheing') -----
  compileOpenPICMethodCacheProbeFor: selector withShift: shift baseRegOrNone: baseRegOrNone
  	"Compile one method cache probe in an OpenPIC's lookup of selector.
+ 	 Answer the jump taken if the selector probe fails.
+ 	 The class tag of the receiver must be in SendNumArgsReg.  ClassReg and TempReg are used as scratch registers.
+ 	 On a hit, the offset of the entry is in ClassReg."
- 	 Answer the jump taken if the selector probe fails."
  	<returnTypeC: #'AbstractInstruction *'>
  	<inline: false>
  	| jumpSelectorMiss |
  	<var: 'jumpSelectorMiss' type: #'AbstractInstruction *'>
  	self MoveR: SendNumArgsReg R: ClassReg.
+ 	objectRepresentation maybeShiftClassTagRegisterForMethodCacheProbe: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
+ 	self assert: shift <= objectMemory shiftForWord.
+ 	"Need to shift the hash right by shift to form the probe, and then shift the probe left by shiftForWord to form the index.
+ 	 So shift left by shiftForWord - shift and and with the shifted mask."
+ 	shift < objectMemory shiftForWord ifTrue:
- 	objectMemory shiftForWord > shift ifTrue:
  		[self LogicalShiftLeftCq: objectMemory shiftForWord - shift R: ClassReg].
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	baseRegOrNone = NoReg
  		ifTrue:
  			[self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  				r: ClassReg
  				R: TempReg]
  		ifFalse:
  			[self AddR: baseRegOrNone R: ClassReg;
  				MoveMw: MethodCacheSelector << objectMemory shiftForWord r: ClassReg R: TempReg].
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	baseRegOrNone = NoReg
  		ifTrue:
  			[self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  				r: ClassReg
  				R: TempReg]
  		ifFalse:
  			[self MoveMw: MethodCacheClass << objectMemory shiftForWord r: ClassReg R: TempReg].
  	self CmpR: SendNumArgsReg R: TempReg.
  	^jumpSelectorMiss!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compilePerformMethodCacheProbeFor:withShift:baseRegOrNone: (in category 'in-line cacheing') -----
  compilePerformMethodCacheProbeFor: selectorReg withShift: shift baseRegOrNone: baseRegOrNone
  	"Compile one method cache probe in a perform: primitive's lookup of selector.
  	 Answer the jump taken if the selector probe fails."
  	<returnTypeC: #'AbstractInstruction *'>
  	<inline: false>
  	| jumpSelectorMiss |
  	<var: 'jumpSelectorMiss' type: #'AbstractInstruction *'>
  	self MoveR: SendNumArgsReg R: ClassReg.
+ 	objectRepresentation maybeShiftClassTagRegisterForMethodCacheProbe: ClassReg.
  	self XorR: selectorReg R: ClassReg.
+ 	self assert: shift <= objectMemory shiftForWord.
+ 	"Need to shift the hash right by shift to form the probe, and then shift the probe left by shiftForWord to form the index.
+ 	 So shift left by shiftForWord - shift and and with the shifted mask."
+ 	shift < objectMemory shiftForWord ifTrue:
- 	objectMemory shiftForWord > shift ifTrue:
  		[self LogicalShiftLeftCq: objectMemory shiftForWord - shift R: ClassReg].
  	self AndCq: MethodCacheMask << objectMemory shiftForWord R: ClassReg.
  	baseRegOrNone = NoReg
  		ifTrue:
  			[self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << objectMemory shiftForWord)
  				r: ClassReg
  				R: TempReg]
  		ifFalse:
  			[self AddR: baseRegOrNone R: ClassReg;
  				MoveMw: MethodCacheSelector << objectMemory shiftForWord r: ClassReg R: TempReg].
  	self CmpR: selectorReg R: TempReg.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	baseRegOrNone = NoReg
  		ifTrue:
  			[self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << objectMemory shiftForWord)
  				r: ClassReg
  				R: TempReg]
  		ifFalse:
  			[self MoveMw: MethodCacheClass << objectMemory shiftForWord r: ClassReg R: TempReg].
  	self CmpR: SendNumArgsReg R: TempReg.
  	^jumpSelectorMiss!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genLookupForPerformNumArgs: (in category 'primitive generators') -----
  genLookupForPerformNumArgs: numArgs
  	"Compile the code for a probe of the first-level method cache for a perform primtiive.
  	 The selector is assumed to be in Arg0Reg.  Defer to adjustArgumentsForPerform: to
  	 adjust the arguments before the jump to the method."
  	| jumpSelectorMiss jumpClassMiss jumpInterpret itsAHit cacheBaseReg |
  	<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
  	<var: #jumpClassMiss type: #'AbstractInstruction *'>
  	<var: #jumpInterpret type: #'AbstractInstruction *'>
  	<var: #itsAHit type: #'AbstractInstruction *'>
  
  	"N.B.  Can't assume TempReg already contains the tag because a method can
  	 of course be invoked via the unchecked entry-point, e.g. as does perform:."
  	objectRepresentation genGetInlineCacheClassTagFrom: ReceiverResultReg into: SendNumArgsReg forEntry: false.
  
  	self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
  
  	cacheBaseReg := NoReg.
  	(backEnd isWithinMwOffsetRange: coInterpreter methodCacheAddress) ifFalse:
  		[self MoveCq: coInterpreter methodCacheAddress R: (cacheBaseReg := Extra0Reg)].
  
  	"Do first of three probes.  See CoInterpreter>>lookupInMethodCacheSel:classTag:"
  	jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 0 baseRegOrNone: cacheBaseReg.
  	jumpClassMiss := self JumpNonZero: 0.
  
  	"Fetch the method, and check if it is cogged."
  	itsAHit := self MoveMw: (cacheBaseReg = NoReg
  								ifTrue: [coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << objectMemory shiftForWord)]
  								ifFalse: [MethodCacheMethod << objectMemory shiftForWord])
  					r: ClassReg
  					R: SendNumArgsReg.
  	"If the method is not compiled fall back on the interpreter primitive."
  	objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
  	jumpInterpret := objectRepresentation genJumpImmediate: ClassReg.
  	"Adjust arguments and jump to the method's unchecked entry-point."
  	self AddCq: cmNoCheckEntryOffset R: ClassReg.
  	self adjustArgumentsForPerform: numArgs.
  	self JumpR: ClassReg.
  
  	"First probe missed.  Do second of three probes.  Shift hash right one and retry."
  	jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
  	jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 1 baseRegOrNone: cacheBaseReg.
  	self JumpZero: itsAHit.
  
  	"Second probe missed.  Do last probe.  Shift hash right two and retry."
  	jumpSelectorMiss jmpTarget: self Label.
+ 	jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 2 baseRegOrNone: cacheBaseReg.
- 	jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 1 baseRegOrNone: cacheBaseReg.
  	self JumpZero: itsAHit.
  
  	"Last probe missed.  Caller will generate the call to fall back on the interpreter primitive."
  	jumpSelectorMiss jmpTarget:
  	(jumpInterpret jmpTarget: self Label).
  	^0!

Item was added:
+ ----- Method: SpurMemoryManager>>methodCacheHashOf:with: (in category 'interpreter access') -----
+ methodCacheHashOf: selector with: classTag
+ 	"Sicne class tags are indices or immediate tags, it is necessary to shift the class
+ 	 tag w.r.t. the selector to include the full class index/immediate tags in the hash."
+ 	<inline: true>
+ 	^selector bitXor: classTag << 2 "num cache probes - 1"!

Item was changed:
  ----- Method: StackInterpreter>>addNewMethodToCache: (in category 'method lookup cache') -----
  addNewMethodToCache: classObj
  	"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 primitiveIndex |
  	<inline: false>
+ 	hash := objectMemory methodCacheHashOf: messageSelector with: (objectMemory classTagForClass: classObj).  "shift drops low-order zeros from addresses"
- 	hash := messageSelector bitXor: (objectMemory classTagForClass: classObj).  "drop low-order zeros from addresses (if classObj not classTag)"
  	(objectMemory isOopCompiledMethod: newMethod)
  		ifTrue:
  			[primitiveIndex := self primitiveIndexOf: newMethod.
  			 primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: classObj]
  		ifFalse:
  			[self assert: ((objectMemory isNonImmediate: newMethod)
  						  and: [objectMemory isForwarded: newMethod]) not.
  			 primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
  
  	0 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
  		(methodCache at: probe + MethodCacheSelector) = 0 ifTrue:
  			["Found an empty entry -- use it"
  			methodCache at: probe + MethodCacheSelector put: messageSelector.
  			methodCache at: probe + MethodCacheClass put: (objectMemory classTagForClass: classObj).
  			methodCache at: probe + MethodCacheMethod put: newMethod.
  			methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
  			lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
  			^self]].
  
  	"OK, we failed to find an entry -- install at the first slot..."
  	probe := hash bitAnd: MethodCacheMask.  "first probe"
  	methodCache at: probe + MethodCacheSelector put: messageSelector.
  	methodCache at: probe + MethodCacheClass put: (objectMemory classTagForClass: classObj).
  	methodCache at: probe + MethodCacheMethod put: newMethod.
  	methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
  	lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
  
  	"...and zap the following entries"
  	1 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
  		methodCache at: probe + MethodCacheSelector put: 0]!

Item was changed:
  ----- Method: StackInterpreter>>addNewMethodToNSCache: (in category 'method lookup cache') -----
  addNewMethodToNSCache: rule
  	<option: #NewspeakVM>
  	<inline: false>
  	| classObj probe hash primitiveIndex |
  	classObj := lkupClass.
+ 	hash := (objectMemory methodCacheHashOf: messageSelector with: lkupClassTag) bitXor: (method bitXor: rule).
- 	hash := (messageSelector bitXor: lkupClassTag) bitXor: (method bitXor: rule).
  	self deny: rule = LookupRuleOrdinary.
  
  	(objectMemory isOopCompiledMethod: newMethod)
  		ifTrue:
  			[primitiveIndex := self primitiveIndexOf: newMethod.
  			 primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: classObj]
  		ifFalse:
  			[self assert: ((objectMemory isNonImmediate: newMethod)
  						  and: [objectMemory isForwarded: newMethod]) not.
  			 primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
  
  	0 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: NSMethodCacheMask.
  		(nsMethodCache at: probe + NSMethodCacheSelector) = 0 ifTrue:
  			["Found an empty entry -- use it"
  			nsMethodCache at: probe + NSMethodCacheSelector put: messageSelector.
  			nsMethodCache at: probe + NSMethodCacheClassTag put: lkupClassTag. "(objectMemory classTagForClass: classObj)."
  			nsMethodCache at: probe + NSMethodCacheCallingMethod put: method.
  			nsMethodCache at: probe + NSMethodCacheDepthOrLookupRule put: rule.
  			nsMethodCache at: probe + NSMethodCacheTargetMethod put: newMethod.
  			nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
  			nsMethodCache at: probe + NSMethodCacheActualReceiver put: localAbsentReceiverOrZero.
  			"lastMethodCacheProbeWrite := probe." "this for primitiveExternalMethod"
  			^self]].
  
  	"OK, we failed to find an entry -- install at the first slot..."
  	probe := hash bitAnd: NSMethodCacheMask.  "first probe"
  	nsMethodCache at: probe + NSMethodCacheSelector put: messageSelector.
  	nsMethodCache at: probe + NSMethodCacheClassTag put: lkupClassTag. "(objectMemory classTagForClass: classObj)."
  	nsMethodCache at: probe + NSMethodCacheCallingMethod put: method.
  	nsMethodCache at: probe + NSMethodCacheDepthOrLookupRule put: rule.
  	nsMethodCache at: probe + NSMethodCacheTargetMethod put: newMethod.
  	nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
  	nsMethodCache at: probe + NSMethodCacheActualReceiver put: localAbsentReceiverOrZero.
  	"lastMethodCacheProbeWrite := probe. ""this for primitiveExternalMethod"
  
  	"...and zap the following entries"
  	1 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: NSMethodCacheMask.
  		nsMethodCache at: probe + NSMethodCacheSelector put: 0]!

Item was changed:
  ----- Method: StackInterpreter>>inlineLookupInMethodCacheSel:classTag: (in category 'method lookup cache') -----
  inlineLookupInMethodCacheSel: selector classTag: classTag
  	"This method implements a simple method lookup cache.  If an entry for the given selector and classTag is
  	 found in the cache, set the values of 'newMethod' and 'primitiveFunctionPointer' and answer true. Otherwise,
  	 answer 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."
  	"classTag is either a class object, if using NewObjectMemory, or a classIndex, if using SpurMemoryManager."
  
  	| hash probe |
  	<inline: true>
+ 	hash := objectMemory methodCacheHashOf: selector with: classTag.  "shift drops two low-order zeros from addresses"
- 	hash := selector bitXor: classTag.  "shift drops two low-order zeros from addresses"
  
  	probe := hash bitAnd: MethodCacheMask.  "first probe"
  	(((methodCache at: probe + MethodCacheSelector) = selector) and:
  		 [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
  			[newMethod := methodCache at: probe + MethodCacheMethod.
  			primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
  											to: #'void (*)()'.
  			^true	"found entry in cache; done"].
  
  	probe := (hash >> 1) bitAnd: MethodCacheMask.  "second probe"
  	(((methodCache at: probe + MethodCacheSelector) = selector) and:
  		 [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
  			[newMethod := methodCache at: probe + MethodCacheMethod.
  			primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
  											to: #'void (*)()'.
  			^true	"found entry in cache; done"].
  
  	probe := (hash >> 2) bitAnd: MethodCacheMask.
  	(((methodCache at: probe + MethodCacheSelector) = selector) and:
  		 [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
  			[newMethod := methodCache at: probe + MethodCacheMethod.
  			primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
  											to: #'void (*)()'.
  			^true	"found entry in cache; done"].
  
  	^false!

Item was changed:
  ----- Method: StackInterpreter>>inlineLookupInNSMethodCacheSel:classTag:method:lookupRule: (in category 'method lookup cache') -----
  inlineLookupInNSMethodCacheSel: selector classTag: classTag method: callingMethod lookupRule: lookupRule
  	"Like inlineLookupInMethodCacheSel:classTag:, but the cache is additionally key'd by the calling method and lookupRule/depth and additionally answers localAbsentReceiverOrZero."
  
  	| hash probe |
  	<inline: true>
+ 	hash := (objectMemory methodCacheHashOf: selector with: classTag) bitXor: (callingMethod bitXor: lookupRule).
- 	hash := (selector bitXor: classTag) bitXor: (callingMethod bitXor: lookupRule).
  
  	probe := hash bitAnd: NSMethodCacheMask.  "first probe"
  	(((((nsMethodCache at: probe + NSMethodCacheSelector) = selector) and:
  		[(nsMethodCache at: probe + NSMethodCacheClassTag) = classTag]) and:
  		[(nsMethodCache at: probe + NSMethodCacheCallingMethod) = callingMethod]) and:
  		[(nsMethodCache at: probe + NSMethodCacheDepthOrLookupRule) = lookupRule]) ifTrue:
  			[newMethod := nsMethodCache at: probe + NSMethodCacheTargetMethod.
  			primitiveFunctionPointer := self cCoerceSimple: (nsMethodCache at: probe + NSMethodCachePrimFunction)
  											to: #'void (*)()'.
  			localAbsentReceiverOrZero := nsMethodCache at: probe + NSMethodCacheActualReceiver.
  			^true	"found entry in cache; done"].
  
  	probe := (hash >> 1) bitAnd: NSMethodCacheMask.  "second probe"
  	(((((nsMethodCache at: probe + NSMethodCacheSelector) = selector) and:
  		[(nsMethodCache at: probe + NSMethodCacheClassTag) = classTag]) and:
  		[(nsMethodCache at: probe + NSMethodCacheCallingMethod) = callingMethod]) and:
  		[(nsMethodCache at: probe + NSMethodCacheDepthOrLookupRule) = lookupRule]) ifTrue:
  			[newMethod := nsMethodCache at: probe + NSMethodCacheTargetMethod.
  			primitiveFunctionPointer := self cCoerceSimple: (nsMethodCache at: probe + NSMethodCachePrimFunction)
  											to: #'void (*)()'.
  			localAbsentReceiverOrZero := nsMethodCache at: probe + NSMethodCacheActualReceiver.
  			^true	"found entry in cache; done"].
  
  	probe := (hash >> 2) bitAnd: NSMethodCacheMask.
  	(((((nsMethodCache at: probe + NSMethodCacheSelector) = selector) and:
  		[(nsMethodCache at: probe + NSMethodCacheClassTag) = classTag]) and:
  		[(nsMethodCache at: probe + NSMethodCacheCallingMethod) = callingMethod]) and:
  		[(nsMethodCache at: probe + NSMethodCacheDepthOrLookupRule) = lookupRule]) ifTrue:
  			[newMethod := nsMethodCache at: probe + NSMethodCacheTargetMethod.
  			primitiveFunctionPointer := self cCoerceSimple: (nsMethodCache at: probe + NSMethodCachePrimFunction)
  											to: #'void (*)()'.
  			localAbsentReceiverOrZero := nsMethodCache at: probe + NSMethodCacheActualReceiver.
  			^true	"found entry in cache; done"].
  
  	^false!

Item was changed:
  ----- Method: StackInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
  printMethodCacheFor: thing
  	<api>
+ 	| n |
+ 	n := 0.
  	0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
  		[:i | | s c m p |
  		s := methodCache at: i + MethodCacheSelector.
  		c := methodCache at: i + MethodCacheClass.
  		m := methodCache at: i + MethodCacheMethod.
  		p := methodCache at: i + MethodCachePrimFunction.
  		((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing]]]])
  		 and: [(objectMemory addressCouldBeOop: s)
  		 and: [c ~= 0
  		 and: [(self addressCouldBeClassObj: c)
  			or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
  			[self cCode: [] inSmalltalk: [self transcript ensureCr].
+ 			 self printNum: i; space; printHexnp: i; cr; tab.
- 			 self printNum: i; cr; tab.
  			 (objectMemory isBytesNonImm: s)
  				ifTrue: [self cCode: 'printf("%lx %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))'
  						inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
  				ifFalse: [self shortPrintOop: s].
  			 self tab.
  			 (self addressCouldBeClassObj: c)
  				ifTrue: [self shortPrintOop: c]
  				ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
  			self tab; shortPrintOop: m; tab.
  			self cCode:
  					[p > 1024
  						ifTrue: [self printHexnp: p]
  						ifFalse: [self printNum: p]]
  				inSmalltalk:
  					[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
+ 			self cr]].
+ 	n > 1 ifTrue:
+ 		[self printNum: n; cr]!
- 			self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>retryPrimitiveOnFailure (in category 'primitive support') -----
  retryPrimitiveOnFailure
  	"In Spur two cases of primitive failure are handled specially.  A primitive may fail due to validation
  	 encountering a forwarder. On failure, check the accessorDepth for the primitive and if non-negative
  	 scan the args to the depth, following any forwarders.  Retry the primitive if any are found.  Hence
  	 lazily and transparently following forwarders on primtiive failure.  Additionally a prmitive might fail
  	 due to an allocation failing.  Retry if external primitives have failed with PrimErrNoMemory after running
  	 first the scavenger and then on a subsequent failure, the global mark-sweep collector.  Hence lazily
  	 and transparently GC on memory exhaustion."
+ 	<option: #SpurObjectMemory>
  	<inline: false>
  	| gcDone followDone canRetry retry retried |
  	gcDone := 0.
  	followDone := canRetry := retried := false.
  	[retry := false.
  	 primFailCode = PrimErrNoMemory
  		ifTrue:
  			[(gcDone := gcDone + 1) = 1 ifTrue:
  				[canRetry := self isExternalPrimitiveCall: newMethod].
  			 canRetry ifTrue:
  				 [gcDone = 1 ifTrue:
  					[objectMemory scavengingGC].
  				 gcDone = 2 ifTrue:
  					[objectMemory fullGC].
  				 retry := gcDone <= 2]]
  		 ifFalse:
  			[followDone ifFalse:
  				[followDone := true.
  				 retry := self checkForAndFollowForwardedPrimitiveState]].
  	 retry] whileTrue:
  		[self assert: primFailCode ~= 0.
  		 retried := true.
  		 self initPrimCall.
  		 self cCode: [] inSmalltalk:
  			[self maybeMapPrimitiveFunctionPointerBackToSomethingEvaluable].
  		 self dispatchFunctionPointer: primitiveFunctionPointer].
  	^retried!

Item was changed:
  ----- Method: StackInterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
  	| localImageName borderWidth window |
  	localImageName := imageName
  							ifNotNil: [FileDirectory default localNameFor: imageName]
  							ifNil: [' synthetic image'].
  	window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
+ 	window paneColor: Color lightBlue.
- 
  	window addMorph: (displayView := SimulatorImageMorph new image: displayForm)
  			frame: (0 at 0 corner: 1 at 0.8).
  	displayView activeHand addEventListener: self.
  	eventTransformer := SimulatorEventTransformer new.
  
  	transcript := TranscriptStream on: (String new: 10000).
  	window addMorph: (PluggableTextMorph
  							on: transcript text: nil accept: nil
  							readSelection: nil menu: #codePaneMenu:shifted:)
  			frame: (0 at 0.8 corner: 0.7 at 1).
  	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil
  						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  			frame: (0.7 at 0.8 corner: 1 at 1).
  
  	borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
  						on: MessageNotUnderstood
  						do: [:ex| 0]. "3.8"
  	borderWidth := borderWidth + window borderWidth.
  	window openInWorldExtent: (self desiredDisplayExtent
  								+ (2 * borderWidth)
  								+ (0 at window labelHeight)
  								* (1@(1/0.8))) rounded.
  	^window!



More information about the Vm-dev mailing list