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

commits at source.squeak.org commits at source.squeak.org
Thu Sep 12 18:05:32 UTC 2013


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

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

Name: VMMaker.oscog-eem.375
Author: eem
Time: 12 September 2013, 11:02:49.613 am
UUID: ea59eba6-47d1-41a9-bfd3-6e05deee8d05
Ancestors: VMMaker.oscog-eem.374

Restrict at-cache to bytecodePrimAt[Put], eliminating it from
primitive[String]At[Put].  Undoes need for fix in VMMaker-oscog.44
of 7 January 2011:
	"Fix leaking of objects into the atCache due to
	 ceSend:super:to:numArgs:'s use of executeNewMethod
	 without always setting messageSelector."
This renders messageSelector and lkupClass ephemeral, since they
are live only during message lookup and because
createActualMessageTo will not cause a GC these cannot change
during message lookup.
Hence eliminate them from markAndTraceInterpreterOops: &
mapVMRegisters.

Make stObject:at:[put:] cope with immediate characters.  In-line
commonAt:[put:], stObject:at:[put:].  Inline install:inAtCache:at:string:
into bytecodePrimAt[Put] for stringy optimization. and hence improve
StackInterpreter performance, e.g. on a 2.2GHz Intel Core i7 MacBook Pro
	StackVM as per VMMaker.oscog-eem.282 with at-cache in commonAt & commonAtPut

	ShootoutTests runAllToTranscript
	#(3173 3995 4521 4014) (times; smaller is better)
	#(3199 3976 4380 3979)
	#(3142 3981 4374 4033)
	1 tinyBenchmarks
	'303497332 bytecodes/sec; 25808732 sends/sec' (rates; bigger is better)
	'304761904 bytecodes/sec; 25786444 sends/sec'
	'304038004 bytecodes/sec; 25609522 sends/sec'
	[(PackageInfo named: #Compiler) methods do: [:mr| mr actualClass recompile: mr methodSymbol]] timeToRun!
	1636

	StackVM as per VMMaker.oscog-eem.374 with no at-cache in commonAt & commonAtPut
	but stObject:at:[put:] inlined into commonAt & commonAtPut & install:inAtCache:...
	inlined into bytecodePrimAt[Put].

	ShootoutTests runAllToTranscript
	#(2641 3775 3852 3618)
	#(2634 3745 3840 3610)
	#(2639 3755 3849 3713)
	'511488511 bytecodes/sec; 28038218 sends/sec'
	'512000000 bytecodes/sec; 28143923 sends/sec'
	'512256128 bytecodes/sec; 28143923 sends/sec'
	[(PackageInfo named: #Compiler) methods do: [:mr| mr actualClass recompile: mr methodSymbol]] timeToRun!
	1410

Add assert to adjustAllOopsBy: to check for forward progress and
eliminate bytesToShift = 0 guard in adjustFieldsAndClassOf:by:.

Fix assert in Spur32BitMMLESimulator>>byteAt:put:.

Fix bug in shortPrintFrameAndCallers: (filter-out base frames).

=============== Diff against VMMaker.oscog-eem.374 ===============

Item was removed:
- ----- Method: CoInterpreter>>bytecodePrimAt (in category 'common selector sends') -----
- bytecodePrimAt
- 	"BytecodePrimAt will only succeed if the receiver is in the atCache.
- 	 Otherwise it will fail so that the more general primitiveAt will put it in the
- 	 cache after validating that message lookup results in a primitive response.
- 	 Override to insert in the at: cache here.  This is necessary since once there
- 	 is a compiled at: primitive method (which doesn't use the at: cache) the only
- 	 way something can get installed in the atCache is here."
- 	| index rcvr result atIx |
- 	index := self internalStackTop.
- 	rcvr := self internalStackValue: 1.
- 	((objectMemory isIntegerObject: rcvr) not
- 	 and: [objectMemory isIntegerObject: index]) ifTrue:
- 		[atIx := rcvr bitAnd: AtCacheMask.  "Index into atCache = 4N, for N = 0 ... 7"
- 		(atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
- 			[lkupClassTag := objectMemory fetchClassTagOfNonImm: rcvr.
- 			 messageSelector := self specialSelector: 16.
- 			 (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
- 				[argumentCount := 1.
- 				 ^self commonSend].
- 			 primitiveFunctionPointer == #primitiveAt
- 				ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
- 				ifFalse:
- 					[primitiveFunctionPointer == #primitiveStringAt
- 						ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
- 						ifFalse:
- 							[argumentCount := 1.
- 							 ^self commonSend]]].
- 		 self successful ifTrue:
- 			[result := self commonVariable: rcvr at: (objectMemory integerValueOf: index) cacheIndex: atIx].
- 		 self successful ifTrue:
- 			[self fetchNextBytecode.
- 			 ^self internalPop: 2 thenPush: result].
- 		 self initPrimCall].
- 
- 	messageSelector := self specialSelector: 16.
- 	argumentCount := 1.
- 	self normalSend!

Item was removed:
- ----- Method: CoInterpreter>>bytecodePrimAtPut (in category 'common selector sends') -----
- bytecodePrimAtPut
- 	"BytecodePrimAtPut will only succeed if the receiver is in the atCache.
- 	Otherwise it will fail so that the more general primitiveAtPut will put it in the
- 	cache after validating that message lookup results in a primitive response.
- 	 Override to insert in the atCache here.  This is necessary since once there
- 	 is a compiled at:[put:] primitive method (which doesn't use the at: cache) the
- 	 only way something can get installed in the atCache is here."
- 	| index rcvr atIx value |
- 	value := self internalStackTop.
- 	index := self internalStackValue: 1.
- 	rcvr := self internalStackValue: 2.
- 	((objectMemory isIntegerObject: rcvr) not
- 	 and: [objectMemory isIntegerObject: index]) ifTrue:
- 		[atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase.  "Index into atPutCache"
- 		 (atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
- 			[lkupClassTag := objectMemory fetchClassTagOfNonImm: rcvr.
- 			 messageSelector := self specialSelector: 17.
- 			 (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
- 				[argumentCount := 2.
- 				 ^self commonSend].
- 			 primitiveFunctionPointer == #primitiveAtPut
- 				ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
- 				ifFalse:
- 					[primitiveFunctionPointer == #primitiveStringAtPut
- 						ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
- 						ifFalse:
- 							[argumentCount := 2.
- 							 ^self commonSend]]].
- 		 self successful ifTrue:
- 			[self commonVariable: rcvr at: (objectMemory integerValueOf: index) put: value cacheIndex: atIx].
- 		 self successful ifTrue:
- 			[self fetchNextBytecode.
- 			 ^self internalPop: 3 thenPush: value].
- 		 self initPrimCall].
- 
- 	messageSelector := self specialSelector: 17.
- 	argumentCount := 2.
- 	self normalSend!

Item was changed:
  ----- Method: CoInterpreter>>ceCounterTripped: (in category 'cog jit support') -----
  ceCounterTripped: condition
  	<api>
  	<option: #SistaStackToRegisterMappingCogit>
  	"Send e.g. thisContext conditionalBranchCounterTrippedOn: boolean."
+ 	| context counterTrippedSelector classTag |
- 	| context counterTrippedSelector |
  	counterTrippedSelector := objectMemory maybeSplObj: SelectorCounterTripped.
  	(counterTrippedSelector isNil
  	or: [counterTrippedSelector = objectMemory nilObject]) ifTrue:
  		[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
  		 ^condition].
  	
+ 	classTag := objectMemory
- 	lkupClassTag := objectMemory
  					classTagForSpecialObjectsIndex: ClassMethodContext
  					compactClassIndex: ClassMethodContextCompactIndex.
+ 	(self lookupInMethodCacheSel: counterTrippedSelector classTag: classTag) ifFalse:
- 	(self lookupInMethodCacheSel: counterTrippedSelector classTag: lkupClassTag) ifFalse:
  	 	[messageSelector := counterTrippedSelector.
+ 		 (self lookupMethodNoMNUEtcInClass: (objectMemory classTagForClass: classTag)) ~= 0 ifTrue:
- 		 lkupClass := objectMemory classTagForClass: lkupClassTag.
- 		 (self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
  			[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
  			 ^condition]].
  
  	(primitiveFunctionPointer ~= 0
  	or: [(self argumentCountOf: newMethod) ~= 1]) ifTrue:
  		[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
  		 ^condition].
  
  	instructionPointer := self popStack.
  	context := self ensureFrameIsMarried: framePointer SP: stackPointer.
  	self push: context.
  	self push: condition.
+ 	self ifAppropriateCompileToNativeCode: newMethod selector: counterTrippedSelector.
- 	self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
  	self activateNewMethod.
  	"not reached"
  	^true!

Item was changed:
  ----- Method: CoInterpreter>>ceDynamicSuperSend:to:numArgs: (in category 'trampolines') -----
  ceDynamicSuperSend: selector to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked dynamic super send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	<option: #NewspeakVM>
+ 	| class classTag canLinkCacheTag errSelIdx cogMethod mClassMixin mixinApplication |
- 	| class canLinkCacheTag errSelIdx cogMethod mClassMixin mixinApplication |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreak: selector + BaseHeaderSize
  		point: (objectMemory lengthOf: selector)
  		receiver: rcvr.
  	mClassMixin := self mMethodClass.
  	mixinApplication := self 
  							findApplicationOfTargetMixin: mClassMixin
  							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
  	self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1).
+ 	classTag := self classTagForClass: (self superclassOf: mixinApplication).
- 	lkupClass := self superclassOf: mixinApplication.
- 	lkupClassTag := self classTagForClass: lkupClass.
  	class := objectMemory fetchClassOf: rcvr. "what about the read barrier??"
  	canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
- 	"We set the messageSelector and lkupClass for executeMethod below since things
- 	 like the at cache read messageSelector and lkupClass and so they cannot be left stale."
- 	messageSelector := selector.
- 	lkupClass := self superclassOf: mixinApplication.
  	argumentCount := numArgs.
+ 	(self lookupInMethodCacheSel: selector classTag: classTag)
- 	(self lookupInMethodCacheSel: selector classTag: (objectMemory classTagForClass: lkupClass))
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
+ 			[messageSelector := selector.
+ 			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
+ 				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
- 			[(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
- 				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
  				self assert: false "NOTREACHED"]].
  	"Method found and has a cog method.  Attempt to link to it."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
  				  selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 (cogMethod selector = selector
  		 and: [canLinkCacheTag]) ifTrue:
  			[cogit
  				linkSendAt: (stackPages longAt: stackPointer)
  				in: (self mframeHomeMethod: framePointer)
  				to: cogMethod
  				offset: cogit dynSuperEntryOffset
  				receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceMNUFromPICMNUMethod:receiver: (in category 'trampolines') -----
  ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr
  	<api>
  	| cPIC primitiveIndex |
  	<var: #cPIC type: #'CogMethod *'>
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self assert: (aMethodObj = 0
  				or: [(objectMemory addressCouldBeObj: aMethodObj)
  					and: [objectMemory isOopCompiledMethod: aMethodObj]]).
  	cPIC := self cCoerceSimple: self popStack - cogit mnuOffset to: #'CogMethod *'.
  	self assert: cPIC cmType = CMClosedPIC.
  	argumentCount := cPIC cmNumArgs.
  	messageSelector := cPIC selector.
  	aMethodObj ~= 0 ifTrue:
  		[instructionPointer := self popStack.
  		self createActualMessageTo: (objectMemory fetchClassOf: rcvr).
  		(self maybeMethodHasCogMethod: aMethodObj) ifTrue:
  			[self push: instructionPointer.
  			 self executeCogMethodFromUnlinkedSend: (self cogMethodOf: aMethodObj)
  				 withReceiver: rcvr.
  			 "NOTREACHED"
  			 self assert: false].
  		newMethod := aMethodObj.
  		primitiveIndex := self primitiveIndexOf: aMethodObj.
  		primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: objectMemory nilObject.
  		^self interpretMethodFromMachineCode].
+ 	self handleMNU: SelectorDoesNotUnderstand
+ 		InMachineCodeTo: rcvr
+ 		classForMessage: (objectMemory fetchClassOf: rcvr).
- 	lkupClass := objectMemory fetchClassOf: rcvr.
- 	self handleMNU: SelectorDoesNotUnderstand InMachineCodeTo: rcvr classForMessage: lkupClass.
  	"NOTREACHED"
  	self assert: false!

Item was changed:
  ----- Method: CoInterpreter>>ceSend:super:to:numArgs: (in category 'trampolines') -----
  ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	| classTag canLinkCacheTag errSelIdx cogMethod |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreak: selector + BaseHeaderSize
  		point: (objectMemory lengthOf: selector)
  		receiver: rcvr.
  	superNormalBar = 0
  		ifTrue: [classTag := objectMemory fetchClassTagOf: rcvr]
  		ifFalse: [classTag := objectMemory classTagForClass: (self superclassOf: (self methodClassOf: (self frameMethodObject: framePointer)))].
  	canLinkCacheTag := objectMemory hasSpurMemoryManagerAPI
  						or: [(objectMemory isYoungObject: classTag) not or: [cogit canLinkToYoungClasses]].
- 	"We set the messageSelector and lkupClass for executeMethod below since things
- 	 like the at cache read messageSelector and lkupClass and so they cannot be left stale."
- 	messageSelector := selector.
- 	lkupClass := objectMemory classForClassTag: classTag.
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
+ 			[messageSelector := selector.
+ 			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
- 			[(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
  				[(canLinkCacheTag
  				  and: [errSelIdx = SelectorDoesNotUnderstand
  				  and: [(cogMethod := cogit cogMNUPICSelector: messageSelector
  											methodOperand: (self mnuMethodOrNilFor: rcvr)
  											numArgs: argumentCount) asUnsignedInteger
  						> cogit minCogMethodAddress]]) ifTrue:
  						[cogit
  							linkSendAt: (stackPages longAt: stackPointer)
  							in: (self mframeHomeMethod: framePointer)
  							to: cogMethod
  							offset: (superNormalBar = 0
  									ifTrue: [cogit entryOffset]
  									ifFalse: [cogit noCheckEntryOffset])
  							receiver: rcvr].
+ 				self handleMNU: errSelIdx
+ 					InMachineCodeTo: rcvr
+ 					classForMessage: (objectMemory classForClassTag: classTag).
- 				self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
  				self assert: false "NOTREACHED"]].
  	"Method found and has a cog method.  Attempt to link to it.  The receiver's class may be young.
  	 If the Cogit can't store young classes in inline caches we can link to an open PIC instead."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the
  				  correct selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 (cogMethod selector = selector
  		  and: [canLinkCacheTag])
  			ifTrue:
  				[cogit
  					linkSendAt: (stackPages longAt: stackPointer)
  					in: (self mframeHomeMethod: framePointer)
  					to: cogMethod
  					offset: (superNormalBar = 0
  								ifTrue: [cogit entryOffset]
  								ifFalse: [cogit noCheckEntryOffset])
  					receiver: rcvr]
  			ifFalse: "If patchToOpenPICFor:.. returns we're out of code memory"
  				[cogit
  					patchToOpenPICFor: selector
  					numArgs: numArgs
  					receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSendAbort:to:numArgs: (in category 'trampolines') -----
  ceSendAbort: selector to: rcvr numArgs: numArgs
  	"Entry-point for an abort send in a CogMethod (aboutToReturn:through:, cannotReturn: et al).
  	 Try and dispatch the send, but the send may turn into an MNU in which case defer to
  	 handleMNUInMachineCodeTo:... which will dispatch the MNU.
  
  	 Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	 depending on whether the target method is cogged or not."
  	<api>
  	| classTag errSelIdx |
  	<inline: false>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreak: selector + BaseHeaderSize
  		point: (objectMemory lengthOf: selector)
  		receiver: rcvr.
  	argumentCount := numArgs.
- 	"We set the messageSelector and lkupClass for executeMethod below since things
- 	 like the at cache read messageSelector and lkupClass and so they cannot be left stale."
- 	messageSelector := selector.
  	classTag := objectMemory fetchClassTagOf: rcvr.
- 	lkupClass := objectMemory classForClassTag: classTag.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
+ 			[messageSelector := selector.
+ 			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
+ 				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
- 			[(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
- 				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
  				"NOTREACHED"
  				self assert: false]].
  	instructionPointer := self popStack.
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSendFromInLineCacheMiss: (in category 'trampolines') -----
  ceSendFromInLineCacheMiss: oPIC
  	"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)."
  	<api>
  	<var: #oPIC type: #'CogMethod *'>
  	| numArgs rcvr classTag errSelIdx |
  	"self printFrame: stackPage headFP WithSP: stackPage headSP"
  	"self printStringOf: selector"
  	numArgs := oPIC cmNumArgs.
  	rcvr := self stackValue: numArgs + 1. "skip return pc"
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	classTag := objectMemory fetchClassTagOf: rcvr.
  	argumentCount := numArgs.
- 	"We set the messageSelector and lkupClass for executeMethod below since things
- 	 like the at cache read messageSelector and lkupClass and so they cannot be left stale."
- 	messageSelector := oPIC selector.
- 	lkupClass := objectMemory classForClassTag: classTag.
  	(self lookupInMethodCacheSel: oPIC selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: oPIC selector]
  		ifFalse:
+ 			[messageSelector := oPIC selector.
+ 			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
+ 				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
- 			[(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
- 				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
  				"NOTREACHED"
  				self assert: false]].
  	instructionPointer := self popStack.
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceStackOverflow: (in category 'trampolines') -----
  ceStackOverflow: contextSwitchIfNotNil
  	"If contextSwitchIfNotNil is nil we can't context switch.
  	 contextSwitchIfNotNil is set to nil by
  		- the special primitiveClosureValueNoContextSwitch entry-point in block dispatch
  		- the stack check in methods with primitive 198.
  	 In a normal method contextSwitchIfNotNil will be the method (see e.g.
  	 SimpleStackBasedCogit>>compileFrameBuild).  In a block it will be the
  	 closure (see e.g. SimpleStackBasedCogit>>compileMethodBody)."
  	<api>
  	| cogMethod switched cesoRetAddr |
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	cesoRetAddr := self popStack. "discard the ceStackOverflow call return address."
  	cogMethod := self mframeCogMethod: framePointer.
  	self assert: cesoRetAddr - cogit abortOffset = (self asCogHomeMethod: cogMethod) asInteger.
  	instructionPointer := cogMethod asInteger + cogMethod stackCheckOffset.
  	self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
+ 	method := newMethod := messageSelector := objectMemory nilObject.
- 	method := newMethod := messageSelector := lkupClass := objectMemory nilObject.
  	switched := self handleStackOverflowOrEventAllowContextSwitch: contextSwitchIfNotNil ~= 0.
  	self returnToExecutive: false postContextSwitch: switched.
  	self error: 'should not be reached'
  !

Item was changed:
  ----- Method: CoInterpreter>>handleMNU:InMachineCodeTo:classForMessage: (in category 'message sending') -----
  handleMNU: selectorIndex InMachineCodeTo: rcvr classForMessage: classForMessage
+ 	"A message send from either an open PIC or an unlinked send has not  been
+ 	 understood.  Create a message and execute the relevant resulting MNU method.
+ 	 messageSelector is an implicit argument (yuck)."
- 	"A message send from either an open PIC or an unlinked send has
- 	 not been understood.  Execute the relevant resulting MNU method."
  	| errSelIdx classForThisMessage |
  	<var: #cogMethod type: #'CogMethod *'>
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	instructionPointer := self popStack.
  	self createActualMessageTo: classForMessage.
  	messageSelector := objectMemory splObj: selectorIndex.
  	(self lookupInMethodCacheSel: messageSelector classTag: (objectMemory classTagForClass: lkupClass))
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: messageSelector]
  		ifFalse:
  			[errSelIdx := self lookupMethodNoMNUEtcInClass: (classForThisMessage := lkupClass).
  			 errSelIdx ~= 0 ifTrue:
  				[selectorIndex = SelectorDoesNotUnderstand ifTrue:
  					[self error: 'Recursive not understood error encountered'].
  				 self push: instructionPointer.
  				 ^self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: classForThisMessage]].
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self push: instructionPointer.
  		 self executeCogMethodFromUnlinkedSend: (self cogMethodOf: newMethod)
  			 withReceiver: rcvr.
  		 "NOTREACHED"
  		 self assert: false].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>mapVMRegisters (in category 'object memory support') -----
  mapVMRegisters
  	"Map the oops in the interpreter's vm ``registers'' to their new values 
  	 during garbage collection or a become: operation."
+ 	"Assume: All traced variables contain valid oops.
+ 	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
+ 	 only during message lookup and because createActualMessageTo will not
+ 	 cause a GC these cannot change during message lookup."
- 	"Assume: All traced variables contain valid oops."
  	| mapInstructionPointer |
  	"i.e. interpreter instructionPointer in method as opposed to machine code?"
  	(mapInstructionPointer := instructionPointer > method) ifTrue:
  		[instructionPointer := instructionPointer - method]. "*rel to method"
+ 	method := objectMemory remap: method.
- 	method := (objectMemory remap: method).
  	mapInstructionPointer ifTrue:
  		[instructionPointer := instructionPointer + method]. "*rel to method"
+ 	(objectMemory isImmediate: newMethod) ifFalse:
+ 		[newMethod := objectMemory remap: newMethod]!
- 	messageSelector := objectMemory remap: messageSelector.
- 	(objectMemory isIntegerObject: newMethod) ifFalse:
- 		[newMethod := objectMemory remap: newMethod].
- 	lkupClass := objectMemory remap: lkupClass!

Item was removed:
- ----- Method: CoInterpreter>>messageSelector: (in category 'cog jit support') -----
- messageSelector: oop
- 	<doNotGenerate>
- 	messageSelector := oop!

Item was changed:
  ----- Method: CoInterpreterMT>>markAndTraceInterpreterOops: (in category 'object memory support') -----
  markAndTraceInterpreterOops: fullGCFlag
  	"Mark and trace all oops in the interpreter's state."
+ 	"Assume: All traced variables contain valid oops.
+ 	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
+ 	 only during message lookup and because createActualMessageTo will not
+ 	 cause a GC these cannot change during message lookup."
- 	"Assume: All traced variables contain valid oops."
  	| oop |
  	<var: #vmThread type: #'CogVMThread *'>
  	"Must mark stack pages first to initialize the per-page trace
  	 flags for full garbage collect before any subsequent tracing."
  	self markAndTraceStackPages: fullGCFlag.
  	self markAndTraceTraceLog.
  	self markAndTracePrimTraceLog.
  	objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
+ 	(objectMemory isImmediate: newMethod) ifFalse:
- 	(objectMemory isIntegerObject: messageSelector) ifFalse:
- 		[objectMemory markAndTrace: messageSelector].
- 	(objectMemory isIntegerObject: newMethod) ifFalse:
  		[objectMemory markAndTrace: newMethod].
- 	objectMemory markAndTrace: lkupClass.
  	self traceProfileState.
  	tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
  
  	1 to: objectMemory remapBufferCount do:
  		[:i|
  		oop := objectMemory remapBuffer at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:
  			[objectMemory markAndTrace: oop]].
  
  	"Callback support - trace suspended callback list - will be made per-thread soon"
  	1 to: jmpDepth do:
  		[:i|
  		oop := suspendedCallbacks at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:
  			[objectMemory markAndTrace: oop].
  		oop := suspendedMethods at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:
  			[objectMemory markAndTrace: oop]].
  
  	"Per-thread state; trace each thread's own newMethod and stack of awol processes."
  	1 to: cogThreadManager getNumThreads do:
  		[:i| | vmThread |
  		vmThread := cogThreadManager vmThreadAt: i.
  		vmThread state notNil ifTrue:
  			[vmThread newMethodOrNull notNil ifTrue:
  				[objectMemory markAndTrace: vmThread newMethodOrNull].
  			 0 to: vmThread awolProcIndex - 1 do:
  				[:j|
  				objectMemory markAndTrace: (vmThread awolProcesses at: j)]]]!

Item was changed:
  ----- Method: NewObjectMemory>>adjustAllOopsBy: (in category 'initialization') -----
  adjustAllOopsBy: bytesToShift 
+ 	"Adjust all oop references by the given number of bytes. This is
+ 	 done just after reading in an image when the new base address
+ 	 of the object heap is different from the base address in the image."
- 	"Adjust all oop references by the given number of bytes. This 
- 	is done just after reading in an image when the new base 
- 	address of the object heap is different from the base address 
- 	in the image."
  	"di 11/18/2000 - return number of objects found"
  
+ 	| oop nextOop totalObjects |
- 	| oop totalObjects |
  	<inline: false>
  	bytesToShift = 0 ifTrue: [^300000].
+ 	"this is probably an improvement over the previous answer of nil,
+ 	 but maybe we should do the obejct counting loop and simply
+ 	 guard the adjustFieldsAndClass... with a bytesToShift = 0 ifFalse: ?"
- 	"this is probably an improvement over the previous answer of 
- 	nil, but maybe we should do the obejct counting loop and 
- 	simply guard the adjustFieldsAndClass... with a bytesToShift 
- 	= 0 ifFalse: ?"
  	totalObjects := 0.
  	oop := self firstObject.
+ 	[self oop: oop isLessThan: freeStart] whileTrue:
+ 		[(self isFreeObject: oop) ifFalse:
+ 			[totalObjects := totalObjects + 1.
+ 			 self adjustFieldsAndClassOf: oop by: bytesToShift].
+ 		 nextOop := self objectAfter: oop.
+ 		 self assert: (self oop: oop isLessThan: nextOop).
+ 		 oop := nextOop].
- 	[self oop: oop isLessThan: freeStart]
- 		whileTrue:
- 			[(self isFreeObject: oop)
- 				ifFalse:
- 					[totalObjects := totalObjects + 1.
- 					 self adjustFieldsAndClassOf: oop by: bytesToShift].
- 			 oop := self objectAfter: oop].
  	^totalObjects!

Item was changed:
  ----- Method: ObjectMemory>>adjustFieldsAndClassOf:by: (in category 'initialization') -----
  adjustFieldsAndClassOf: oop by: offsetBytes 
  	"Adjust all pointers in this object by the given offset."
  	| fieldAddr fieldOop classHeader newClassOop |
  	<inline: true>
  	<asmLabel: false>
- 	offsetBytes = 0 ifTrue: [^nil].
  	fieldAddr := oop + (self lastPointerOf: oop).
+ 	[self oop: fieldAddr isGreaterThan: oop] whileTrue:
+ 		[fieldOop := self longAt: fieldAddr.
+ 		 (self isIntegerObject: fieldOop) ifFalse:
+ 			[self longAt: fieldAddr put: fieldOop + offsetBytes].
+ 		 fieldAddr := fieldAddr - BytesPerOop].
+ 	(self headerType: oop) ~= HeaderTypeShort ifTrue:
+ 		["adjust class header if not a compact class"
+ 		 classHeader := self longAt: oop - BytesPerWord.
+ 		 newClassOop := (classHeader bitAnd: AllButTypeMask) + offsetBytes.
+ 		 self longAt: oop - BytesPerWord put: (newClassOop bitOr: (classHeader bitAnd: TypeMask))]!
- 	[self oop: fieldAddr isGreaterThan: oop]
- 		whileTrue: [fieldOop := self longAt: fieldAddr.
- 			(self isIntegerObject: fieldOop)
- 				ifFalse: [self longAt: fieldAddr put: fieldOop + offsetBytes].
- 			fieldAddr := fieldAddr - BytesPerOop].
- 	(self headerType: oop) ~= HeaderTypeShort
- 		ifTrue: ["adjust class header if not a compact class"
- 			classHeader := self longAt: oop - BytesPerWord.
- 			newClassOop := (classHeader bitAnd: AllButTypeMask) + offsetBytes.
- 			self longAt: oop - BytesPerWord put: (newClassOop bitOr: (classHeader bitAnd: TypeMask))]!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>byteAt:put: (in category 'memory access') -----
  byteAt: byteAddress put: byte
  	| lowBits long longAddress |
  	lowBits := byteAddress bitAnd: 3.
  	longAddress := byteAddress - lowBits.
  	long := self longAt: longAddress.
  	long := (lowBits caseOf: {
  		[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
  		[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
  		[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16)  ].
  		[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24)  ]
  	}).
+ 	self assert: (self cheapAddressCouldBeInHeap: longAddress).
- 	self assert: (self cheapAddressCouldBeObj: longAddress).
  	self longAt: longAddress put: long.
  	^byte!

Item was added:
+ ----- Method: SpurMemoryManager>>cheapAddressCouldBeInHeap: (in category 'debug support') -----
+ cheapAddressCouldBeInHeap: address 
+ 	^(address bitAnd: self wordSize - 1) = 0
+ 	  and: [address >= startOfMemory
+ 	  and: [address <= freeOldSpaceStart]]!

Item was changed:
  ----- Method: SpurMemoryManager>>cheapAddressCouldBeObj: (in category 'debug support') -----
  cheapAddressCouldBeObj: address 
  	^(address bitAnd: self baseHeaderSize - 1) = 0
+ 	  and: [address >= startOfMemory
- 	  and: [address >= scavenger eden start
  	  and: [address <= freeOldSpaceStart]]!

Item was added:
+ ----- Method: SpurMemoryManager>>integerObjectOfCharacterObject: (in category 'immediates') -----
+ integerObjectOfCharacterObject: oop
+ 	"Immediate characters are unsigned"
+ 	^(self cCoerceSimple: oop to: #'unsigned long') >> 1!

Item was added:
+ ----- Method: SpurMemoryManager>>isClassOfNonImm:equalTo: (in category 'object testing') -----
+ isClassOfNonImm: objOop equalTo: classOop
+ 	self shouldBeImplemented!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	"This list records the valid senders of isIntegerObject: as we replace uses of
  	  isIntegerObject: by isImmediate: where appropriate."
  	(#(	makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		addressCouldBeClassObj:
  		isMarriedOrWidowedContext:
  		shortPrint:
  		bytecodePrimAt
  		commonAt:
  		loadFloatOrIntFrom:
  		positive32BitValueOf:
  		primitiveExternalCall
  		checkedIntegerValueOf:
  		bytecodePrimAtPut
  		commonAtPut:
  		primitiveVMParameter
  		checkIsStillMarriedContext:currentFP:
  		displayBitsOf:Left:Top:Right:Bottom:
  		fetchStackPointerOf:
  		primitiveContextAt
+ 		primitiveContextAtPut
+ 		subscript:with:storing:format:) includes: thisContext sender method selector) ifFalse:
- 		primitiveContextAtPut) includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was changed:
  ----- Method: StackInterpreter>>asciiOfCharacter: (in category 'indexing primitive support') -----
  asciiOfCharacter: characterObj  "Returns an integer object"
  
  	<inline: false>
+ 	(objectMemory isCharacterObject: characterObj) ifTrue:
+ 		[^CharacterTable
+ 			ifNil: [objectMemory integerObjectOfCharacterObject: characterObj]
+ 			ifNotNil: [objectMemory fetchPointer: CharacterValueIndex ofObject: characterObj]].
+ 	self primitiveFailFor: PrimErrBadArgument.
+ 	^ConstZero  "in case some code needs an int"!
- 	self assertClassOf: characterObj is: (objectMemory splObj: ClassCharacter).
- 	self successful
- 		ifTrue: [^ objectMemory fetchPointer: CharacterValueIndex ofObject: characterObj]
- 		ifFalse: [^ ConstZero]  "in case some code needs an int"!

Item was changed:
  ----- Method: StackInterpreter>>bytecodePrimAt (in category 'common selector sends') -----
  bytecodePrimAt
  	"BytecodePrimAt will only succeed if the receiver is in the atCache.
+ 	 Otherwise it will fail so that the more general primitiveAt will put it in the
+ 	 cache after validating that message lookup results in a primitive response.
+ 	 Override to insert in the at: cache here.  This is necessary since once there
+ 	 is a compiled at: primitive method (which doesn't use the at: cache) the only
+ 	 way something can get installed in the atCache is here."
- 	Otherwise it will fail so that the more general primitiveAt will put it in the
- 	cache after validating that message lookup results in a primitive response."
  	| index rcvr result atIx |
  	index := self internalStackTop.
  	rcvr := self internalStackValue: 1.
+ 	((objectMemory isIntegerObject: rcvr) not
- 	((objectMemory isImmediate: rcvr) not
  	 and: [objectMemory isIntegerObject: index]) ifTrue:
  		[atIx := rcvr bitAnd: AtCacheMask.  "Index into atCache = 4N, for N = 0 ... 7"
+ 		(atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
+ 			[lkupClassTag := objectMemory fetchClassTagOfNonImm: rcvr.
+ 			 messageSelector := self specialSelector: 16.
+ 			 (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
+ 				[argumentCount := 1.
+ 				 ^self commonSend].
+ 			 primitiveFunctionPointer == #primitiveAt
+ 				ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
+ 				ifFalse:
+ 					[primitiveFunctionPointer == #primitiveStringAt
+ 						ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
+ 						ifFalse:
+ 							[argumentCount := 1.
+ 							 ^self commonSend]]].
+ 		 self successful ifTrue:
+ 			[result := self commonVariable: rcvr at: (objectMemory integerValueOf: index) cacheIndex: atIx].
+ 		 self successful ifTrue:
+ 			[self fetchNextBytecode.
+ 			 ^self internalPop: 2 thenPush: result].
+ 		 self initPrimCall].
- 		(atCache at: atIx+AtCacheOop) = rcvr ifTrue:
- 			[result := self commonVariable: rcvr at: (objectMemory integerValueOf: index) cacheIndex: atIx.
- 			 self successful ifTrue:
- 				[self fetchNextBytecode.
- 				^self internalPop: 2 thenPush: result].
- 			 self initPrimCall]].
  
  	messageSelector := self specialSelector: 16.
  	argumentCount := 1.
  	self normalSend!

Item was changed:
  ----- Method: StackInterpreter>>bytecodePrimAtPut (in category 'common selector sends') -----
  bytecodePrimAtPut
  	"BytecodePrimAtPut will only succeed if the receiver is in the atCache.
  	Otherwise it will fail so that the more general primitiveAtPut will put it in the
+ 	cache after validating that message lookup results in a primitive response.
+ 	 Override to insert in the atCache here.  This is necessary since once there
+ 	 is a compiled at:[put:] primitive method (which doesn't use the at: cache) the
+ 	 only way something can get installed in the atCache is here."
- 	cache after validating that message lookup results in a primitive response."
  	| index rcvr atIx value |
  	value := self internalStackTop.
  	index := self internalStackValue: 1.
  	rcvr := self internalStackValue: 2.
+ 	((objectMemory isIntegerObject: rcvr) not
- 	((objectMemory isImmediate: rcvr) not
  	 and: [objectMemory isIntegerObject: index]) ifTrue:
  		[atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase.  "Index into atPutCache"
+ 		 (atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
+ 			[lkupClassTag := objectMemory fetchClassTagOfNonImm: rcvr.
+ 			 messageSelector := self specialSelector: 17.
+ 			 (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
+ 				[argumentCount := 2.
+ 				 ^self commonSend].
+ 			 primitiveFunctionPointer == #primitiveAtPut
+ 				ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
+ 				ifFalse:
+ 					[primitiveFunctionPointer == #primitiveStringAtPut
+ 						ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
+ 						ifFalse:
+ 							[argumentCount := 2.
+ 							 ^self commonSend]]].
+ 		 self successful ifTrue:
+ 			[self commonVariable: rcvr at: (objectMemory integerValueOf: index) put: value cacheIndex: atIx].
+ 		 self successful ifTrue:
+ 			[self fetchNextBytecode.
+ 			 ^self internalPop: 3 thenPush: value].
+ 		 self initPrimCall].
- 		 (atCache at: atIx+AtCacheOop) = rcvr ifTrue:
- 			[self commonVariable: rcvr at: (objectMemory integerValueOf: index) put: value cacheIndex: atIx.
- 			 self successful ifTrue:
- 				[self fetchNextBytecode.
- 				 ^self internalPop: 3 thenPush: value].
- 			 self initPrimCall]].
  
  	messageSelector := self specialSelector: 17.
  	argumentCount := 2.
  	self normalSend!

Item was changed:
  ----- Method: StackInterpreter>>commonAt: (in category 'indexing primitive support') -----
  commonAt: stringy
  	"This code is called if the receiver responds primitively to at:.
+ 	 N.B. this does *not* use the at cache, instead inlining stObject:at:.
+ 	 Using the at cache here would require that callers set messageSelector
+ 	 and lkupClass and that is onerous and error-prone, and in any case,
+ 	 inlining produces much better performance than using the at cache here."
+ 	| index rcvr result |
+ 	<inline: true> "to get it inlined in primitiveAt and primitiveStringAt"
- 	 If this is so, it will be installed in the atCache so that subsequent calls of at:
- 	 or next may be handled immediately in bytecode primitive routines."
- 	| index rcvr atIx result |
  	self initPrimCall.
  	rcvr := self stackValue: 1.
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	index := self stackTop.
  	"No need to test for large positive integers here.  No object has 1g elements"
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	index := objectMemory integerValueOf: index.
- 
- 	"NOTE:  The at-cache, since it is specific to the non-super response to #at:.
- 	Therefore we must determine that the message is #at: (not, eg, #basicAt:),
- 	and that the send is not a super-send, before using the at-cache."
- 	(messageSelector = (self specialSelector: 16)
- 	 and: [lkupClass = (objectMemory fetchClassOfNonImm: rcvr)])
- 		ifTrue:
- 		["OK -- look in the at-cache"
- 		atIx := rcvr bitAnd: AtCacheMask.  "Index into atCache = 4N, for N = 0 ... 7"
- 		(atCache at: atIx+AtCacheOop) = rcvr ifFalse:
- 			["Rcvr not in cache.  Attempt to install it..."
- 			(self install: rcvr inAtCache: atCache at: atIx string: stringy) ifFalse:
- 				[self assert: (objectMemory isContextNonImm: rcvr).
- 				self initPrimCall.
- 				^self primitiveContextAt]].
- 		self successful ifTrue:
- 			[result := self commonVariable: rcvr at: index cacheIndex: atIx].
- 		self successful ifTrue:
- 			[^ self pop: argumentCount+1 thenPush: result]].
- 
- 	"The slow but sure way..."
- 	self initPrimCall.
  	result := self stObject: rcvr at: index.
  	self successful ifTrue:
  		[stringy ifTrue: [result := self characterForAscii: (objectMemory integerValueOf: result)].
+ 		^self pop: argumentCount+1 thenPush: result]!
- 		^ self pop: argumentCount+1 thenPush: result]!

Item was changed:
  ----- Method: StackInterpreter>>commonAtPut: (in category 'indexing primitive support') -----
  commonAtPut: stringy
  	"This code is called if the receiver responds primitively to at:Put:.
+ 	 N.B. this does *not* use the at cache, instead inlining stObject:at:put:.
+ 	 Using the at cache here would require that callers set messageSelector
+ 	 and lkupClass and that is onerous and error-prone, and in any case,
+ 	 inlining produces much better performance than using the at cache here."
+ 	| value index rcvr |
+ 	<inline: true> "to get it inlined in primitiveAtPut and primitiveStringAtPut"
- 	If this is so, it will be installed in the atPutCache so that subsequent calls of at:
- 	or  next may be handled immediately in bytecode primitive routines."
- 	| value index rcvr atIx |
  	value := self stackTop.
  	self initPrimCall.
  	rcvr := self stackValue: 2.
  	(objectMemory isNonImmediate: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	index := self stackValue: 1.
  	"No need to test for large positive integers here.  No object has 1g elements"
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	index := objectMemory integerValueOf: index.
- 
- 	"NOTE:  The atPut-cache, since it is specific to the non-super response to #at:Put:.
- 	Therefore we must determine that the message is #at:Put: (not, eg, #basicAt:Put:),
- 	and that the send is not a super-send, before using the at-cache."
- 	(messageSelector = (self specialSelector: 17)
- 		and: [lkupClass = (objectMemory fetchClassOfNonImm: rcvr)])
- 		ifTrue:
- 		["OK -- look in the at-cache"
- 		atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase.  "Index into atPutCache"
- 		(atCache at: atIx+AtCacheOop) = rcvr ifFalse:
- 			["Rcvr not in cache.  Attempt to install it..."
- 			(self install: rcvr inAtCache: atCache at: atIx string: stringy) ifFalse:
- 				[self assert: (objectMemory isContextNonImm: rcvr).
- 				self initPrimCall.
- 				^self primitiveContextAtPut]].
- 		self successful ifTrue:
- 			[self commonVariable: rcvr at: index put: value cacheIndex: atIx].
- 		self successful ifTrue:
- 			[^ self pop: argumentCount+1 thenPush: value]].
- 
- 	"The slow but sure way..."
- 	self initPrimCall.
  	stringy
  		ifTrue: [self stObject: rcvr at: index put: (self asciiOfCharacter: value)]
  		ifFalse: [self stObject: rcvr at: index put: value].
  	self successful ifTrue:
+ 		[^self pop: argumentCount+1 thenPush: value]!
- 		[^ self pop: argumentCount+1 thenPush: value]!

Item was changed:
  ----- Method: StackInterpreter>>initializeInterpreter: (in category 'initialization') -----
  initializeInterpreter: bytesToShift 
  	"Initialize Interpreter state before starting execution of a new image."
  	interpreterProxy := self sqGetInterpreterProxy.
  	self dummyReferToProxy.
  	objectMemory initializeObjectMemory: bytesToShift.
  	self checkAssumedCompactClasses.
  	primFailCode := 0.
  	self initializeExtraClassInstVarIndices.
  	stackLimit := 0. "This is also the initialization flag for the stack system."
  	stackPage := overflowedPage := 0.
  	extraFramesToMoveOnOverflow := 0.
+ 	method := newMethod := objectMemory nilObject.
- 	method := objectMemory nilObject.
  	self cCode: [self cppIf: MULTIPLEBYTECODESETS ifTrue: [bytecodeSetSelector := 0]]
  		inSmalltalk: [bytecodeSetSelector := 0].
- 	messageSelector := objectMemory nilObject.
- 	newMethod := objectMemory nilObject.
- 	lkupClass := objectMemory nilObject.
  	methodDictLinearSearchLimit := 8.
  	self flushMethodCache.
  	self flushAtCache.
  	self initialCleanup.
  	highestRunnableProcessPriority := 0.
  	nextProfileTick := 0.
  	profileSemaphore := objectMemory nilObject.
  	profileProcess := objectMemory nilObject.
  	profileMethod := objectMemory nilObject.
  	nextPollUsecs := 0.
  	nextWakeupUsecs := 0.
  	tempOop := 0.
  	interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
  	interruptPending := false.
  	inIOProcessEvents := 0.
  	deferDisplayUpdates := false.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	[globalSessionID = 0]
  		whileTrue: [globalSessionID := self
  						cCode: 'time(NULL) + ioMSecs()'
  						inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
  	jmpDepth := 0.
  	longRunningPrimitiveStartUsecs :=
  	longRunningPrimitiveStopUsecs := 0.
  	maxExtSemTabSizeSet := false.
  	statForceInterruptCheck := 0.
  	statStackOverflow := 0.
  	statCheckForEvents := 0.
  	statProcessSwitch := 0.
  	statIOProcessEvents := 0.
  	statStackPageDivorce := 0!

Item was changed:
  ----- Method: StackInterpreter>>install:inAtCache:at:string: (in category 'indexing primitive support') -----
  install: rcvr inAtCache: cache at: atIx string: stringy
  	"Attempt to install the oop of this object in the given cache (at or atPut),
  	 along with its size, format and fixedSize. Answer if this was successful."
  	| hdr fmt totalLength fixedFields |
+ 	<inline: true>
  	<var: #cache type: 'sqInt *'>
  
  	hdr := objectMemory baseHeader: rcvr.
  	fmt := objectMemory formatOfHeader: hdr.
+ 	stringy
+ 		ifTrue:
+ 			[totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
+ 			 fixedFields := 0.
+ 			 fmt := fmt + objectMemory firstStringyFakeFormat]  "special flag for strings"
+ 		ifFalse:
+ 			[(fmt = objectMemory indexablePointersFormat and: [objectMemory isContextHeader: hdr]) ifTrue:
+ 				["Contexts must not be put in the atCache, since their size is not constant"
+ 				self primitiveFailFor: PrimErrBadReceiver.
+ 				^false].
+ 			 totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
+ 			 fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength].
- 	(fmt = objectMemory indexablePointersFormat and: [objectMemory isContextHeader: hdr]) ifTrue:
- 		["Contexts must not be put in the atCache, since their size is not constant"
- 		self primitiveFailFor: PrimErrBadReceiver.
- 		^false].
- 	totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
- 	fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
  
  	cache at: atIx+AtCacheOop put: rcvr.
+ 	cache at: atIx+AtCacheFmt put: fmt.
- 	cache at: atIx+AtCacheFmt put: (stringy
- 										ifTrue: [fmt + objectMemory firstStringyFakeFormat]  "special flag for strings"
- 										ifFalse: [fmt]).
  	cache at: atIx+AtCacheFixedFields put: fixedFields.
  	cache at: atIx+AtCacheSize put: totalLength - fixedFields.
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>mapVMRegisters (in category 'object memory support') -----
  mapVMRegisters
  	"Map the oops in the interpreter's vm ``registers'' to their new values 
  	during garbage collection or a become: operation."
+ 	"Assume: All traced variables contain valid oops.
+ 	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
+ 	 only during message lookup and because createActualMessageTo will not
+ 	 cause a GC these cannot change during message lookup."
- 	"Assume: All traced variables contain valid oops."
  	instructionPointer := instructionPointer - method. "*rel to method"
+ 	method := objectMemory remap: method.
- 	method := (objectMemory remap: method).
  	instructionPointer := instructionPointer + method. "*rel to method"
+ 	(objectMemory isImmediate: newMethod) ifFalse:
+ 		[newMethod := objectMemory remap: newMethod]!
- 	(objectMemory isIntegerObject: messageSelector) ifFalse:
- 		[messageSelector := objectMemory remap: messageSelector].
- 	(objectMemory isIntegerObject: newMethod) ifFalse:
- 		[newMethod := objectMemory remap: newMethod].
- 	lkupClass := objectMemory remap: lkupClass!

Item was changed:
  ----- Method: StackInterpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
  markAndTraceInterpreterOops: fullGCFlag
  	"Mark and trace all oops in the interpreter's state."
+ 	"Assume: All traced variables contain valid oops.
+ 	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
+ 	 only during message lookup and because createActualMessageTo will not
+ 	 cause a GC these cannot change during message lookup."
- 	"Assume: All traced variables contain valid oops."
  	| oop |
  	"Must mark stack pages first to initialize the per-page trace
  	 flags for full garbage collect before any subsequent tracing."
  	self markAndTraceStackPages: fullGCFlag.
  	self markAndTraceTraceLog.
  	self markAndTracePrimTraceLog.
  	objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
+ 	(objectMemory isImmediate: newMethod) ifFalse:
+ 		[objectMemory markAndTrace: newMethod].
- 	(objectMemory isIntegerObject: messageSelector) ifFalse:
- 		[objectMemory markAndTrace: messageSelector].
- 	(objectMemory isIntegerObject: newMethod) ifFalse:
- 		[objectMemory markAndTrace: newMethod.
- 	objectMemory markAndTrace: lkupClass].
  	self traceProfileState.
  	tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
  
  	1 to: objectMemory remapBufferCount do: [:i | 
  			oop := objectMemory remapBuffer at: i.
  			(objectMemory isIntegerObject: oop) ifFalse: [objectMemory markAndTrace: oop]].
  
  	"Callback support - trace suspended callback list"
  	1 to: jmpDepth do:[:i|
  		oop := suspendedCallbacks at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
  		oop := suspendedMethods at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
  	]!

Item was changed:
  ----- Method: StackInterpreter>>printActivationNameFor:receiver:isBlock:firstTemporary: (in category 'debug printing') -----
  printActivationNameFor: aMethod receiver: anObject isBlock: isBlock firstTemporary: maybeMessage
  	| methClass methodSel classObj |
  	<inline: false>
  	isBlock ifTrue:
  		[self print: '[] in '].
  	methClass := self findClassOfMethod: aMethod forReceiver: anObject.
  	methodSel := self findSelectorOfMethod: aMethod.
  	((objectMemory addressCouldBeOop: anObject)
  	 and: [self addressCouldBeClassObj: (classObj := objectMemory fetchClassOf: anObject)])
  		ifTrue:
  			[classObj = methClass
  				ifTrue: [self printNameOfClass: methClass count: 5]
  				ifFalse:
  					[self printNameOfClass: classObj count: 5.
  					 self print: '('.
  					 self printNameOfClass: methClass count: 5.
  					 self print: ')']]
+ 		ifFalse:
+ 			[self cCode: '' inSmalltalk: [self halt].
+ 			 self print: 'INVALID RECEIVER'].
- 		ifFalse: [self print: 'INVALID RECEIVER'].
  	self print: '>'.
  	(objectMemory addressCouldBeOop: methodSel)
  		ifTrue:
  			[methodSel = objectMemory nilObject
  				ifTrue: [self print: '?']
  				ifFalse: [self printStringOf: methodSel]]
  		ifFalse: [self print: 'INVALID SELECTOR'].
  	(methodSel = (objectMemory splObj: SelectorDoesNotUnderstand)
  	and: [(objectMemory addressCouldBeObj: maybeMessage)
  	and: [(objectMemory fetchClassOf: maybeMessage) = (objectMemory splObj: ClassMessage)]]) ifTrue:
  		["print arg message selector"
  		methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: maybeMessage.
  		self print: ' '.
  		self printStringOf: methodSel]!

Item was changed:
  ----- Method: StackInterpreter>>sendInvokeCallback:Stack:Registers:Jmpbuf: (in category 'callback support') -----
  sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr
  	"Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf:
  	 to Alien class with the supplied args.  The arguments are raw C addresses
  	 and are converted to integer objects on the way."
  	<export: true>
+ 	| classTag |
+ 	classTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
- 	self flag: #obsolete.
- 	lkupClassTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
  	messageSelector := self splObj: SelectorInvokeCallback.
  	argumentCount := 4.
+ 	(self lookupInMethodCacheSel: messageSelector classTag: classTag) ifFalse:
+ 	 	[(self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
- 	(self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
- 	 	[lkupClass := objectMemory classForClassTag: lkupClassTag.
- 		(self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
  			[^false]].
  	((self argumentCountOf: newMethod) = 4
  	and: [primitiveFunctionPointer = 0]) ifFalse:
  		[^false].
  	self push: (self splObj: ClassAlien). "receiver"
  	self push: (self positive32BitIntegerFor: thunkPtr).
  	self push: (self positive32BitIntegerFor: stackPtr).
  	self push: (self positive32BitIntegerFor: regsPtr).
  	self push: (self positive32BitIntegerFor: jmpBufPtr).
  	self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
  	self justActivateNewMethod.
  	(self isMachineCodeFrame: framePointer) ifFalse:
  		[self maybeFlagMethodAsInterpreted: newMethod].
  	self externalWriteBackHeadFramePointers.
  	self handleStackOverflow.
  	self enterSmalltalkExecutiveFromCallback.
  	"not reached"
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>sendInvokeCallbackContext: (in category 'callback support') -----
  sendInvokeCallbackContext: vmCallbackContext
  	"Send the calllback message to Alien class with the supplied arg(s).  Use either the
  	 1 arg invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf:
  	 message, depending on what selector is installed in the specialObjectsArray.
  	 Note that if invoking the legacy invokeCallback:stack:registers:jmpbuf: we pass the
  	 vmCallbackContext as the jmpbuf argument (see reestablishContextPriorToCallback:).
  	 The arguments are raw C addresses and are converted to integer objects on the way."
  	<export: true>
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
+ 	| classTag |
+ 	classTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
- 	lkupClassTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
  	messageSelector := self splObj: SelectorInvokeCallback.
+ 	(self lookupInMethodCacheSel: messageSelector classTag: classTag) ifFalse:
+ 	 	[(self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
- 	(self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
- 	 	[lkupClass := objectMemory classForClassTag: lkupClassTag.
- 		(self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
  			[^false]].
  	primitiveFunctionPointer ~= 0 ifTrue:
  		[^false].
  	self saveCStackStateForCallbackContext: vmCallbackContext.
  	self push: (self splObj: ClassAlien). "receiver"
  	self cppIf: BytesPerWord = 8
  		ifTrue:
  			[(self argumentCountOf: newMethod) = 4 ifTrue:
  				[self push: (self positive64BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
  				 self push: (self positive64BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
  				 self push: (self positive64BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
  			 self push: (self positive64BitIntegerFor: vmCallbackContext asUnsignedInteger)]
  		ifFalse:
  			[(self argumentCountOf: newMethod) = 4 ifTrue:
  				[self push: (self positive32BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
  				 self push: (self positive32BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
  				 self push: (self positive32BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
  			 self push: (self positive32BitIntegerFor: vmCallbackContext asUnsignedInteger)].
  	self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
  	self justActivateNewMethod.
  	(self isMachineCodeFrame: framePointer) ifFalse:
  		[self maybeFlagMethodAsInterpreted: newMethod].
  	self externalWriteBackHeadFramePointers.
  	self handleStackOverflow.
  	self enterSmalltalkExecutiveFromCallback.
  	"not reached"
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintFrameAndCallers: (in category 'debug printing') -----
  shortPrintFrameAndCallers: theFP
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	(stackPages couldBeFramePointer: theFP) ifFalse: [^nil].
  	self shortPrintFrame: theFP.
+ 	(self isBaseFrame: theFP) ifFalse:
+ 		[self shortPrintFrameAndCallers: (self frameCallerFP: theFP)]!
- 	self shortPrintFrameAndCallers: (self frameCallerFP: theFP)!

Item was changed:
  ----- Method: StackInterpreter>>stObject:at: (in category 'indexing primitive support') -----
  stObject: array at: index
  	"Return what ST would return for <obj> at: index."
  
  	| hdr fmt totalLength fixedFields stSize |
+ 	<inline: true>
- 	<inline: false>
  	hdr := objectMemory baseHeader: array.
  	fmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength.
  	(fmt = objectMemory indexablePointersFormat
  	 and: [objectMemory isContextHeader: hdr])
  		ifTrue:
  			[stSize := self stackPointerForMaybeMarriedContext: array.
  			((self oop: index isGreaterThanOrEqualTo: 1)
  			 and: [(self oop: index isLessThanOrEqualTo: stSize)
  			 and: [self isStillMarriedContext: array]]) ifTrue:
  				[^self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array)]]
  		ifFalse: [stSize := totalLength - fixedFields].
  	((self oop: index isGreaterThanOrEqualTo: (objectMemory firstValidIndexOfIndexableObject: array withFormat: fmt))
  	 and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
  		[^self subscript: array with: (index + fixedFields) format: fmt].
  	self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex]).
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>stObject:at:put: (in category 'indexing primitive support') -----
  stObject: array at: index put: value
  	"Do what ST would return for <obj> at: index put: value."
  	| hdr fmt totalLength fixedFields stSize |
+ 	<inline: true>
- 	<inline: false>
  	hdr := objectMemory baseHeader: array.
  	fmt := objectMemory formatOfHeader: hdr.
  	totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength.
  	(fmt = objectMemory indexablePointersFormat
  	 and: [objectMemory isContextHeader: hdr])
  		ifTrue:
  			[stSize := self stackPointerForMaybeMarriedContext: array.
  			((self oop: index isGreaterThanOrEqualTo: 1)
  			 and: [(self oop: index isLessThanOrEqualTo: stSize)
  			 and: [self isStillMarriedContext: array]]) ifTrue:
  				[^self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array) put: value]]
  		ifFalse: [stSize := totalLength - fixedFields].
  	((self oop: index isGreaterThanOrEqualTo: (objectMemory firstValidIndexOfIndexableObject: array withFormat: fmt))
  	 and: [self oop: index isLessThanOrEqualTo: stSize])
  		ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
  		ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])].
  	^value!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
  primitiveDoNamedPrimitiveWithArgs
  	"Simulate an primitiveExternalCall invocation (e.g. for the Debugger).  Do not cache anything.
  	 e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
  	| argumentArray arraySize methodArg methodHeader
  	  moduleName functionName moduleLength functionLength
  	  spec addr primRcvr ctxtRcvr isArray |
  	<var: #addr declareC: 'void (*addr)()'>
  	argumentArray := self stackTop.
  	(objectMemory isArray: argumentArray) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  	arraySize := objectMemory fetchWordLengthOf: argumentArray.
  	self success: (self roomToPushNArgs: arraySize).
  
  	methodArg := self stackObjectValue: 2.
  	self successful ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
  	(objectMemory isOopCompiledMethod: methodArg) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
  	methodHeader := self headerOf: methodArg.
  
  	(self literalCountOfHeader: methodHeader) > 2 ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  	spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg.
  	isArray := self isInstanceOfClassArray: spec.
  	(isArray
  	and: [(objectMemory lengthOf: spec) = 4
  	and: [(self primitiveIndexOfMethod: methodArg header: methodHeader) = 117]]) ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: spec.
  	moduleName = objectMemory nilObject
  		ifTrue: [moduleLength := 0]
  		ifFalse: [self success: (objectMemory isBytes: moduleName).
  				moduleLength := objectMemory lengthOf: moduleName.
  				self cCode: '' inSmalltalk:
  					[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
  						ifTrue: [moduleLength := 0  "Cause all of these to fail"]]].
  	functionName := objectMemory fetchPointer: 1 ofObject: spec.
  	self success: (objectMemory isBytes: functionName).
  	functionLength := objectMemory lengthOf: functionName.
  	self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
  				OfLength: functionLength
  				FromModule: moduleName + BaseHeaderSize
  				OfLength: moduleLength.
  	addr = 0 ifTrue:
  		[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
  
  	"Cannot fail this primitive from now on.  Can only fail the external primitive."
  	objectMemory pushRemappableOop: (argumentArray := self popStack).
  	objectMemory pushRemappableOop: (primRcvr := self popStack).
  	objectMemory pushRemappableOop: self popStack. "the method"
  	objectMemory pushRemappableOop: self popStack. "the context receiver"
  	self push: primRcvr. "replace context receiver with actual receiver"
  	argumentCount := arraySize.
  	1 to: arraySize do:
  		[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
- 	"Run the primitive (sets primFailCode)"
- 	lkupClass := objectMemory nilObject.
  	self callExternalPrimitive: addr.
  	ctxtRcvr  := objectMemory popRemappableOop.
  	methodArg := objectMemory popRemappableOop.
  	primRcvr := objectMemory popRemappableOop.
  	argumentArray := objectMemory popRemappableOop.
  	self successful ifFalse: "If primitive failed, then restore state for failure code"
  		[self pop: arraySize + 1.
  		 self push: ctxtRcvr.
  		 self push: methodArg.
  		 self push: primRcvr.
  		 self push: argumentArray.
  		 argumentCount := 3.
  		 "Hack.  A nil prim error code (primErrorCode = 1) is interpreted by the image
  		  as meaning this primitive is not implemented.  So to pass back nil as an error
  		  code we use -1 to indicate generic failure."
  		 primFailCode = 1 ifTrue:
  			[primFailCode := -1]]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveDoPrimitiveWithArgs (in category 'control primitives') -----
  primitiveDoPrimitiveWithArgs
  	| argumentArray arraySize index primIdx |
  	argumentArray := self stackTop.
  	(objectMemory isArray: argumentArray) ifFalse: [^self primitiveFail].
  	arraySize := objectMemory fetchWordLengthOf: argumentArray.
  	self success: (self roomToPushNArgs: arraySize).
  
  	primIdx := self stackIntegerValue: 1.
  	self successful ifFalse: [^self primitiveFail]. "invalid args"
  
  	primitiveFunctionPointer := self functionPointerFor: primIdx inClass: nil.
  	primitiveFunctionPointer = 0 ifTrue:
  		[^self primitiveFail].
  
  	"Pop primIndex and argArray, then push args in place..."
  	self pop: 2.
  	argumentCount := arraySize.
  	index := 1.
  	[index <= argumentCount] whileTrue:
  		[self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
  		 index := index + 1].
  
  	self isPrimitiveFunctionPointerAnIndex ifTrue:
  		[self externalQuickPrimitiveResponse.
  		^nil].
  	"We use tempOop instead of pushRemappableOop:/popRemappableOop here because in
  	 the Cogit primitiveEnterCriticalSection, primitiveSignal, primitiveResume et al longjmp back
  	 to either the interpreter or machine code, depending on the process activated.  So if we're
  	 executing one of these primitives control won't actually return here and the matching
  	 popRemappableOop: wouldn't occur, potentially overflowing the remap buffer.  While recursion
  	 could occur (nil tryPrimitive: 118 withArgs: #(111 #())) it counts as shooting oneself in the foot."
  	tempOop := argumentArray. "prim might alloc/gc"
- 	lkupClass := objectMemory nilObject.
  	"Run the primitive (sets primFailCode)"
  	self slowPrimitiveResponse.
  	self successful ifFalse: "If primitive failed, then restore state for failure code"
  		[self pop: arraySize.
  		 self pushInteger: primIdx.
  		 self push: tempOop.
  		 argumentCount := 2].
  	tempOop := 0!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveExecuteMethod (in category 'control primitives') -----
  primitiveExecuteMethod
  	"receiver, args, then method are on top of stack. Execute method against receiver and args.
  	 Set primitiveFunctionPointer because no cache lookup has been done for the method, and
  	 hence primitiveFunctionPointer is stale."
  	| methodArgument primitiveIndex |
  	methodArgument := self stackTop.
  	(objectMemory isOopCompiledMethod: methodArgument) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	argumentCount - 1 = (self argumentCountOf: methodArgument) ifFalse:
  		[^self primitiveFailFor: PrimErrBadNumArgs].
  	newMethod := self popStack.
  	primitiveIndex := self primitiveIndexOf: newMethod.
  	primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: nil.
  	argumentCount := argumentCount - 1.
- 	"We set the messageSelector for executeMethod below since things
- 	 like the at cache read messageSelector and so it cannot be left stale."
- 	messageSelector := objectMemory nilObject.
  	self executeNewMethod.
  	"Recursive xeq affects primErrorCode"
  	self initPrimCall!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveExecuteMethodArgsArray (in category 'control primitives') -----
  primitiveExecuteMethodArgsArray
  	"receiver, argsArray, then method are on top of stack.  Execute method against
  	 receiver and args.  Allow for up to two extra arguments (e.g. for mirror primitives).
  	 Set primitiveFunctionPointer because no cache lookup has been done for the
  	 method, and hence primitiveFunctionPointer is stale."
  	| methodArgument argCnt argumentArray primitiveIndex |
  	methodArgument := self stackTop.
  	argumentArray := self stackValue: 1.
  	((objectMemory isOopCompiledMethod: methodArgument)
  	 and: [objectMemory isArray: argumentArray]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	argCnt := self argumentCountOf: methodArgument.
  	argCnt = (objectMemory fetchWordLengthOf: argumentArray) ifFalse:
  		[^self primitiveFailFor: PrimErrBadNumArgs].
  	argumentCount > 2 ifTrue: "CompiledMethod class>>receiver:withArguments:executeMethod:
  								SqueakObjectPrimitives class >> receiver:withArguments:apply:
  								VMMirror>>ifFail:object:with:executeMethod: et al"
  		[argumentCount > 4 ifTrue:
  			[^self primitiveFailFor: PrimErrUnsupported].
  		self stackValue: argumentCount put: (self stackValue: 2)]. "replace actual receiver with desired receiver"
  	"and push the actual arguments"
  	self pop: argumentCount.
  	0 to: argCnt - 1 do:
  		[:i|
  		self push: (objectMemory fetchPointer: i ofObject: argumentArray)].
  	newMethod := methodArgument.
  	primitiveIndex := self primitiveIndexOf: newMethod.
  	primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: nil.
  	argumentCount := argCnt.
- 	"We set the messageSelector for executeMethod below since things
- 	 like the at cache read messageSelector and so it cannot be left stale."
- 	messageSelector := objectMemory nilObject.
  	self executeNewMethod.
  	"Recursive xeq affects primErrorCode"
  	self initPrimCall!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitivePerform (in category 'control primitives') -----
  primitivePerform
  	<returnTypeC: #void>
+ 	| newReceiver lookupClassTag performMethod |
- 	| performSelector newReceiver lookupClassTag performMethod |
- 	performSelector := messageSelector.
  	performMethod := newMethod.
  	messageSelector := self stackValue: argumentCount - 1.
  	newReceiver := self stackValue: argumentCount.
  
  	"NOTE: the following lookup may fail and be converted to #doesNotUnderstand:,
  	 so we must adjust argumentCount and slide args now, so that will work."
  
  	"Slide arguments down over selector"
  	argumentCount := argumentCount - 1.
  	argumentCount to: 1 by: -1 do:
  		[:i|
  		stackPages
  			longAt: stackPointer + (i * BytesPerWord)
  			put: (stackPages longAt: stackPointer + ((i - 1) * BytesPerWord))].
  	self pop: 1.
  	lookupClassTag := objectMemory fetchClassTagOf: newReceiver.
  	self sendBreak: messageSelector + BaseHeaderSize
  		point: (objectMemory lengthOf: messageSelector)
  		receiver: newReceiver.
  	self printSends ifTrue:
  		[self printActivationNameForSelector: messageSelector
  			startClass: (objectMemory classForClassTag: lookupClassTag); cr].
  	self findNewMethodInClassTag: lookupClassTag.
  
  	"Only test CompiledMethods for argument count - other objects will have to take their chances"
  	((objectMemory isOopCompiledMethod: newMethod)
  	  and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse:
  		["Slide the args back up (sigh) and re-insert the selector."
  		self unPop: 1.
  		1 to: argumentCount by: 1 do:
  			[:i |
  			stackPages longAt: stackPointer + ((i - 1) * BytesPerWord)
  				put: (stackPages longAt: stackPointer + (i * BytesPerWord))].
  		stackPages longAt: stackPointer + (argumentCount * BytesPerWord) put: messageSelector.
  		argumentCount := argumentCount + 1.
  		newMethod := performMethod.
- 		messageSelector := performSelector.
  		^self primitiveFail].
  
  	self executeNewMethod.
  	"Recursive xeq affects primErrorCode"
  	self initPrimCall!

Item was changed:
  ----- Method: StackInterpreterSimulator>>messageSelector: (in category 'spur bootstrap') -----
  messageSelector: s
+ 	"For e.g. SpurBootstrap"
  	messageSelector := s!

Item was added:
+ ----- Method: StackInterpreterSimulator>>primitiveAtPut (in category 'indexing primitives') -----
+ primitiveAtPut
+ 	16r1510B8 = (self stackValue: 2) ifTrue:
+ 		[self halt].
+ 	^super primitiveAtPut!

Item was added:
+ ----- Method: StackInterpreterSimulator>>primitiveExecuteMethod (in category 'control primitives') -----
+ primitiveExecuteMethod
+ 	self halt.
+ 	^super primitiveExecuteMethod!

Item was added:
+ ----- Method: StackInterpreterSimulator>>primitiveExecuteMethodArgsArray (in category 'control primitives') -----
+ primitiveExecuteMethodArgsArray
+ 	self halt.
+ 	^super primitiveExecuteMethodArgsArray!



More information about the Vm-dev mailing list