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

commits at source.squeak.org commits at source.squeak.org
Fri Jul 11 20:45:37 UTC 2014


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

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

Name: VMMaker.oscog-eem.818
Author: eem
Time: 11 July 2014, 1:42:54.481 pm
UUID: f4250127-68cd-42d7-babb-66f56974a8c8
Ancestors: VMMaker.oscog-eem.817

Spur:
Fix bug in scanClassPostBecome:effects: with new lazy
selector following policy by... throwing it all away.

The read barriers on method lookup (of the methodClass
association in super sends, of the superclass link, of
method dictionaries, method dictionary arrays, selectors
and methods is cheap.  So replace scanning classes and
method dictionaries in te class table post become with
read marriewrs on methodClass, superclass and method
dictionary etc on lookup.

The read barrier on an object from which we are going to
fetch state (such as a class or method dictionary) is
essentially free on modern machines because the class
index and the state very likely share a cache line, and the
register code for testing is so cheap compared to memory
access.  Further the read barrier on selectors is cheap
because the method lookup cache is effective in reducing
the number of message lookups and because we don't
have to check for forwarding of nil entries.

So nuke all the followNecessaryForwardingInMethod:
machinery including the cmUsesMethodClass hack.
Nuke scanClassPostBecome:effects:.

Clean up, e.g. replace followNonImmediateField:ofObject:
uses with followObjField:ofObject:.

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

Item was removed:
- ----- Method: CoInterpreter>>actuallyFollowNecessaryForwardingInMethod: (in category 'lazy become') -----
- actuallyFollowNecessaryForwardingInMethod: methodObj
- 	"To avoid any chance of a forwarded object during super sends
- 	 we follow the methodClassAssociation.  The forwarded object
- 	 send fault only copes with normal sends to instances."
- 	| cogMethod header litCount |
- 	<var: #cogMethod type: #'CogMethod *'>
- 	header := self rawHeaderOf: methodObj.
- 	(self isCogMethodReference: header) ifTrue:
- 		[cogMethod := self cCoerceSimple: header to: #'CogMethod *'.
- 		 "If the method class is not used we can avoid the forwarding
- 		  check for both the cogMethod and the bytecoded method."
- 		 cogMethod cmUsesMethodClass ifFalse:
- 			[^self].
- 		 cogit followForwardedLiteralsIn: cogMethod.
- 		 header := cogMethod methodHeader].
- 	litCount := self literalCountOfHeader: header. "Slang super expansion limitation"
- 	super
- 		actuallyFollowNecessaryForwardingInMethod: methodObj
- 		literalCount: litCount!

Item was changed:
  ----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: theBecomeEffectsFlags
  	"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
  	 The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
  	 probe, since notionally objects' internals are accessed only via sending messages to them,
  	 the exception is primitives that access the internals of the non-receiver argument(s).
+ 	 To avoid a read barrier on inst var fetch we scan the receivers in the stack zone and follow
+ 	 any forwarded ones.  This is way cheaper than scanning all of memory as in the old become."
- 	 To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and
- 	 methods in the stack zone and follow any forwarded ones.  This is of course way cheaper
- 	 than scanning all of memory as in the old become."
  	| theIPPtr |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #usqInt>
  
  	(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  		[(objectMemory isForwarded: method) ifTrue:
  			[theIPPtr := instructionPointer - method.
  			 method := objectMemory followForwarded: method.
  			 instructionPointer := method + theIPPtr].
  		(objectMemory isForwarded: newMethod) ifTrue:
  			[newMethod := objectMemory followForwarded: newMethod]].
  
  	self assert: stackPage ~= 0.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP oop offset |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP asUnsignedInteger.
  					 theSP := theSP + BytesPerWord].
  			 [self assert: (thePage addressIsInPage: theFP).
  			  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
  			  offset := self frameStackedReceiverOffset: theFP.
  			  oop := stackPages longAt: theFP + offset.
  			  (objectMemory isOopForwarded: oop) ifTrue:
  				[stackPages
  					longAt: theFP + offset
  					put: (objectMemory followForwarded: oop)].
  			  ((self frameHasContext: theFP)
  			   and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory followForwarded: (self frameContext: theFP))].
  			 (self isMachineCodeFrame: theFP)
  				ifTrue:
  					[oop := stackPages longAt: theFP + FoxMFReceiver.
  					 (objectMemory isOopForwarded: oop) ifTrue:
  						[stackPages
  							longAt: theFP + FoxMFReceiver
  							put: (objectMemory followForwarded: oop)].
  					 oop := (self mframeHomeMethod: theFP) methodObject.
  					 self assert: (objectMemory isForwarded: oop) not]
  				ifFalse:
  					[oop := stackPages longAt: theFP + FoxIFReceiver.
  					 (objectMemory isOopForwarded: oop) ifTrue:
  						[stackPages
  							longAt: theFP + FoxIFReceiver
  							put: (objectMemory followForwarded: oop)].
  					 oop := self iframeMethod: theFP.
  					 (objectMemory isForwarded: oop) ifTrue:
  						[| newOop delta |
  						 newOop := objectMemory followForwarded: oop.
  						 delta := newOop - oop.
  						 (theIPPtr ~= 0
  						  and: [(stackPages longAt: theIPPtr) > oop]) ifTrue:
  							[stackPages
  								longAt: theIPPtr
  								put: (stackPages longAt: theIPPtr) + delta].
  						stackPages
  							longAt: theFP + FoxIFSavedIP
  							put: (stackPages longAt: theFP + FoxIFSavedIP) + delta.
  						stackPages
  							longAt: theFP + FoxMethod
  							put: (oop := newOop)]].
- 			  self followNecessaryForwardingInMethod: oop.
  			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
  				 theFP := callerFP]]]!

Item was changed:
  ----- Method: CoInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  	"Marry aContext with the base frame of a new stack page.  Build the base
  	 frame to reflect the context's state.  Answer the new page.  Override to
  	 hold the caller context in a different place,  In the StackInterpreter we use
  	 the caller saved ip, but in the Cog VM caller saved ip is the ceBaseReturn:
  	 trampoline.  Simply hold the caller context in the first word of the stack."
  	<returnTypeC: #'StackPage *'>
  	| page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
  	<inline: false>
  	<var: #page type: #'StackPage *'>
  	<var: #pointer type: #'char *'>
  	<var: #cogMethod type: #'CogMethod *'>
  	"theIP must be typed as signed because it is assigned ceCannotResumePC and so maybe implicitly typed as unsigned."
  	<var: #theIP type: #sqInt>
  	self assert: (self isSingleContext: aContext).
  	self assert: (objectMemory goodContextSize: aContext).
  	theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
  	self assert: HasBeenReturnedFromMCPC signedIntFromLong < 0.
  	theIP := (objectMemory isIntegerObject: theIP)
  				ifTrue: [objectMemory integerValueOf: theIP]
  				ifFalse: [HasBeenReturnedFromMCPC].
+ 	theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
- 	theMethod := objectMemory followNonImmediateField: MethodIndex ofObject: aContext.
- 	self followNecessaryForwardingInMethod: theMethod.
  	page := self newStackPage.
  	"first word on stack is caller context of base frame"
  	stackPages
  		longAt: (pointer := page baseAddress)
  		put: (objectMemory fetchPointer: SenderIndex ofObject: aContext).
  	"second word is the context itself; needed for cannotReturn processing; see ceBaseReturn:."
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: aContext.
  	rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
  	"If the frame is a closure activation then the closure should be on the stack in
  	 the pushed receiver position (closures receiver the value[:value:] messages).
  	 Otherwise it should be the receiver proper."
  	maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  	maybeClosure ~= objectMemory nilObject
  		ifTrue:
  			[numArgs := self argumentCountOfClosure: maybeClosure.
  			 stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: maybeClosure]
  		ifFalse:
  			[| header |
  			 header := self headerOf: theMethod.
  			 numArgs := self argumentCountOfMethodHeader: header.
  			 self cppIf: MULTIPLEBYTECODESETS
  				ifTrue: "If this is a synthetic context its IP could be pointing at the CallPrimitive opcode.  If so, skip it."
  					[(theIP signedIntFromLong > 0
  					  and: [(self methodHeaderHasPrimitive: header)
  					  and: [theIP = (1 + (objectMemory lastPointerOf: theMethod))]]) ifTrue:
  						[theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)]].
  			 stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: rcvr].
  	"Put the arguments on the stack"
  	1 to: numArgs do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - BytesPerWord)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"saved caller ip is base return trampoline"
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: cogit ceBaseFrameReturnPC.
  	"base frame's saved fp is null"
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: 0.
  	"N.B.  Don't set the baseFP, which marks the page as in use, until after
  	 ensureMethodIsCogged: and/or instructionPointer:forContext:frame:. These
  	 can cause a compiled code compaction which, if marked as in use, will
  	 examine this partially initialized page and crash."
  	page headFP: pointer.
  	"Create either a machine code frame or an interpreter frame based on the pc.  If the pc is -ve
  	 it is a machine code pc and so we produce a machine code frame.  If +ve an interpreter frame.
  	 N.B. Do *not* change this to try and map from a bytecode pc to a machine code frame under
  	 any circumstances.  See ensureContextIsExecutionSafeAfterAssignToStackPointer:"
  	theIP signedIntFromLong < 0
  		ifTrue:
  			[| cogMethod |
  			 "Since we would have to generate a machine-code method to be able to map
  			  the native pc anyway we should create a native method and native frame."
  			 cogMethod := self ensureMethodIsCogged: theMethod.
  			 theMethod := cogMethod asInteger.
  			 maybeClosure ~= objectMemory nilObject
  				ifTrue:
  					["If the pc is the special HasBeenReturnedFromMCPC pc set the pc
  					  appropriately so that the frame stays in the cannotReturn: state."
  					 theIP = HasBeenReturnedFromMCPC signedIntFromLong
  						ifTrue:
  							[theMethod := (cogit findMethodForStartBcpc: (self startPCOfClosure: maybeClosure)
  												inHomeMethod: (self cCoerceSimple: theMethod
  																	to: #'CogMethod *')) asInteger.
  							 theMethod = 0 ifTrue:
  								[self error: 'cannot find machine code block matching closure''s startpc'].
  							 theIP := cogit ceCannotResumePC]
  						ifFalse:
  							[self assert: (theIP signedBitShift: -16) < -1. "See contextInstructionPointer:frame:"
  							 theMethod := theMethod - ((theIP signedBitShift: -16) * cogit blockAlignment).
  							 theIP := theMethod - theIP signedIntFromShort].
  					 stackPages
  						longAt: (pointer := pointer - BytesPerWord)
  						put: theMethod + MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag]
  				ifFalse:
  					[self assert: (theIP signedBitShift: -16) >= -1.
  					 "If the pc is the special HasBeenReturnedFromMCPC pc set the pc
  					  appropriately so that the frame stays in the cannotReturn: state."
  					 theIP := theIP = HasBeenReturnedFromMCPC signedIntFromLong
  								ifTrue: [cogit ceCannotResumePC]
  								ifFalse: [theMethod asInteger - theIP].
  					 stackPages
  						longAt: (pointer := pointer - BytesPerWord)
  						put: theMethod + MFMethodFlagHasContextFlag].
  			 stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: aContext]
  		ifFalse:
  			[stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: theMethod.
  			stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: aContext.
  			stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  			stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: 0. "FoxIFSavedIP"
  			theIP := self iframeInstructionPointerForIndex: theIP method: theMethod].
  	page baseFP: page headFP.
  	self assert: (self frameHasContext: page baseFP).
  	self assert: (self frameNumArgs: page baseFP) == numArgs.
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: rcvr.
  	stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  	self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  	numArgs + 1 to: stackPtrIndex do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - BytesPerWord)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"top of stack is the instruction pointer"
  	stackPages longAt: (pointer := pointer - BytesPerWord) put: theIP.
  	page headSP: pointer.
  	self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
  
  	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
  	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
  	 w.r.t. the frame when we check for validity) plus SmallInteger tags."
  	objectMemory storePointerUnchecked: SenderIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: page baseFP).
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: 0).
  	self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  	self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  	self assert: (self validStackPageBaseFrame: page).
  	^page!

Item was changed:
  VMStructType subclass: #CogBlockMethod
+ 	instanceVariableNames: 'objectHeader homeOffset startpc padToWord cmNumArgs cmType cmRefersToYoung cpicHasMNUCase cmUsageCount cmUsesPenultimateLit cmUnusedFlags stackCheckOffset'
- 	instanceVariableNames: 'objectHeader homeOffset startpc padToWord cmNumArgs cmType cmRefersToYoung cpicHasMNUCase cmUsageCount cmUsesPenultimateLit cmUsesMethodClass cmUnusedFlags stackCheckOffset'
  	classVariableNames: ''
  	poolDictionaries: 'CogMethodConstants VMBasicConstants'
  	category: 'VMMaker-JIT'!
  
  !CogBlockMethod commentStamp: 'eem 1/9/2011 08:41' prior: 0!
  I am the rump method header for a block method embedded in a full CogMethod.  I am the superclass of CogMethod, which is a Cog method header proper.  Instances of both classes have the same second word.  The homeOffset abd startpc fields are overlaid on the objectHeader in a CogMethod.  In C I look like
  
  	typedef struct {
  		unsigned short	homeOffset;
  		unsigned short	startpc;
  
  		unsigned		cmNumArgs : 8;
  		unsigned		cmType : 3;
  		unsigned		cmRefersToYoung : 1;
  		unsigned		cmIsUnlinked : 1;
  		unsigned		cmUsageCount : 3;
  		unsigned		stackCheckOffset : 16;
  	} CogBlockMethod;
  
  My instances are not actually used.  The methods exist only as input to Slang.  The simulator uses my surrogates (CogBlockMethodSurrogate32 and CogBlockMethodSurrogate64.!

Item was changed:
  ----- Method: CogBlockMethod class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
  	"enumerate aBinaryBlock with the names and C type strings for the
  	 inst vars to include in a CogMethod or CogBlockMethod struct."
  
  	self allInstVarNames do:
  		[:ivn|
  		"Notionally objectHeader is in a union with homeOffset and startpc but
  		 we don't have any convenient support for unions.  So hack, hack, hack, hack."
  		((self == CogBlockMethod
  			ifTrue: [#('objectHeader')]
  			ifFalse: [#('homeOffset' 'startpc' 'padToWord')]) includes: ivn) ifFalse:
  				[aBinaryBlock
  					value: ivn
  					value: (ivn caseOf: {
  								['objectHeader']			-> [self objectMemoryClass baseHeaderSize = 8
  																ifTrue: [#sqLong]
  																ifFalse: [#sqInt]].
  								['cmNumArgs']				-> [#(unsigned ' : 8')].		"SqueakV3 needs only 5 bits"
  								['cmType']					-> [#(unsigned ' : 3')].
  								['cmRefersToYoung']		-> [#(unsigned #Boolean ' : 1')].
  								['cpicHasMNUCase']		-> [#(unsigned #Boolean ' : 1')].
  								['cmUsageCount']			-> [#(unsigned ' : 3')].		"See CMMaxUsageCount in initialize"
  								['cmUsesPenultimateLit']	-> [#(unsigned #Boolean ' : 1')].
+ 								['cmUnusedFlags']			-> [#(unsigned ' : 3')].
- 								['cmUsesMethodClass']		-> [#(unsigned #Boolean ' : 1')].
- 								['cmUnusedFlags']			-> [#(unsigned ' : 2')].
  								['stackCheckOffset']		-> [#(unsigned ' : 12')].		"See MaxStackCheckOffset in initialize. a.k.a. cPICNumCases"
  								['blockSize']				-> [#'unsigned short'].		"See MaxMethodSize in initialize"
  								['blockEntryOffset']			-> [#'unsigned short'].
  								['homeOffset']				-> [#'unsigned short'].
  								['startpc']					-> [#'unsigned short'].
  								['padToWord']				-> [#(#BaseHeaderSize 8 'unsigned int')].
  								['nextMethod']				-> ['struct _CogMethod *'].	"See NewspeakCogMethod"
  								['counters']					-> [#usqInt]}				"See SistaCogMethod"
  							otherwise:
  								[#sqInt])]]!

Item was removed:
- ----- Method: CogBlockMethod>>cmUsesMethodClass (in category 'accessing') -----
- cmUsesMethodClass
- 	"Answer the value of cmUsesMethodClass"
- 
- 	^cmUsesMethodClass!

Item was removed:
- ----- Method: CogBlockMethod>>cmUsesMethodClass: (in category 'accessing') -----
- cmUsesMethodClass: anObject
- 	"Set the value of cmUsesMethodClass"
- 
- 	^cmUsesMethodClass := anObject!

Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmUsesMethodClass (in category 'accessing') -----
- cmUsesMethodClass
- 	^(((memory unsignedByteAt: address + 3 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0!

Item was removed:
- ----- Method: CogBlockMethodSurrogate32>>cmUsesMethodClass: (in category 'accessing') -----
- cmUsesMethodClass: aValue
- 	memory
- 		unsignedByteAt: address + baseHeaderSize + 3
- 		put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
- 	^aValue!

Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>cmUsesMethodClass (in category 'accessing') -----
- cmUsesMethodClass
- 	^(((memory unsignedByteAt: address + 3 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0!

Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>cmUsesMethodClass: (in category 'accessing') -----
- cmUsesMethodClass: aValue
- 	memory
- 		unsignedByteAt: address + baseHeaderSize + 3
- 		put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
- 	^aValue!

Item was removed:
- ----- Method: CogMethodSurrogate32>>cmUsesMethodClass (in category 'accessing') -----
- cmUsesMethodClass
- 	^(((memory unsignedByteAt: address + 3 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0!

Item was removed:
- ----- Method: CogMethodSurrogate32>>cmUsesMethodClass: (in category 'accessing') -----
- cmUsesMethodClass: aValue
- 	memory
- 		unsignedByteAt: address + baseHeaderSize + 3
- 		put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
- 	^aValue!

Item was removed:
- ----- Method: CogMethodSurrogate64>>cmUsesMethodClass (in category 'accessing') -----
- cmUsesMethodClass
- 	^(((memory unsignedByteAt: address + 3 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0!

Item was removed:
- ----- Method: CogMethodSurrogate64>>cmUsesMethodClass: (in category 'accessing') -----
- cmUsesMethodClass: aValue
- 	memory
- 		unsignedByteAt: address + baseHeaderSize + 3
- 		put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)).
- 	^aValue!

Item was changed:
  ----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the CogVMSimulator when running the interpreter inside Smalltalk.  The
  	 primary responsibility of this method is to allocate Smalltalk Arrays for variables
  	 that will be declared as statically-allocated global arrays in the translated code."
+ 	super initialize.
  
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	cogit ifNil:
  		[cogit := self class cogitClass new setInterpreter: self].
  	objectMemory coInterpreter: self cogit: cogit.
  
  	cogit numRegArgs > 0 ifTrue:
  		[debugStackDepthDictionary := Dictionary new].
  
  	cogThreadManager ifNotNil:
  		[super initialize].
  
  	"Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently
  	 for simulation, due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := objectMemory integerObjectOf: -1.
  	HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1.
  	cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
  	enableCog := true.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	self flushAtCache.
  	cogCompiledCodeCompactionCalledFor := false.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	mappedPluginEntries := OrderedCollection new.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[primitiveAccessorDepthTable := Array new: primitiveTable size.
  			 pluginList := {}.
  			 self loadNewPlugin: '']
  		ifFalse:
  			[pluginList := {'' -> self }].
  	desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  	maxLiteralCountForCompile := MaxLiteralCountForCompile.
  	minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
  	flagInterpretedMethods := false.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := lastPollCount := sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	suppressHeartbeatFlag := deferSmash := deferredSmash := false.
  	systemAttributes := Dictionary new.
  	primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  	primTraceLogIndex := 0.
  	traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
  	traceLogIndex := 0.
  	traceSources := TraceSources.
  	statCodeCompactionCount := 0.
  	statCodeCompactionUsecs := 0.
  	extSemTabSize := 256!

Item was changed:
  CogClass subclass: #Cogit
+ 	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd callerSavedRegMask postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss sendMissCall missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall interpretLabel endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB numIRCs indexOfIRC theIRCs'
- 	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent usesMethodClass primitiveIndex backEnd callerSavedRegMask postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss sendMissCall missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall interpretLabel endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB numIRCs indexOfIRC theIRCs'
  	classVariableNames: 'AltBlockCreationBytecodeSize AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxStackAllocSize MaxUnitDisplacement MaxX2NDisplacement MethodTooBig NSSendIsPCAnnotated NotFullyInitialized NumObjRefsInRuntime NumOopsPerIRC NumSendTrampolines NumTrampolines ProcessorClass ShouldNotJIT UnimplementedPrimitive YoungSelectorInPIC'
  	poolDictionaries: 'CogCompilationConstants CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!
  
  !Cogit commentStamp: 'eem 2/13/2013 15:37' prior: 0!
  I am the code generator for the Cog VM.  My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance.  I can be tested in the current image using my class-side in-image compilation facilities.  e.g. try
  
  	StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
  
  I have concrete subclasses that implement different levels of optimization:
  	SimpleStackBasedCogit is the simplest code generator.
  
  	StackToRegisterMappingCogit is the current production code generator  It defers pushing operands
  	to the stack until necessary and implements a register-based calling convention for low-arity sends.
  
  	StackToRegisterMappingCogit is an experimental code generator with support for counting
  	conditional branches, intended to support adaptive optimization.
  
  coInterpreter <CoInterpreterSimulator>
  	the VM's interpreter with which I cooperate
  methodZoneManager <CogMethodZoneManager>
  	the manager of the machine code zone
  objectRepresentation <CogObjectRepresentation>
  	the object used to generate object accesses
  processor <BochsIA32Alien|?>
  	the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
  simulatedTrampolines <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
  simulatedVariableGetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
  simulatedVariableSetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
  printRegisters printInstructions clickConfirm <Boolean>
  	flags controlling debug printing and code simulation
  breakPC <Integer>
  	machine code pc breakpoint
  cFramePointer cStackPointer <Integer>
  	the variables representing the C stack & frame pointers, which must change on FFI callback and return
  selectorOop <sqInt>
  	the oop of the methodObj being compiled
  methodObj <sqInt>
  	the bytecode method being compiled
  initialPC endPC <Integer>
  	the start and end pcs of the methodObj being compiled
  methodOrBlockNumArgs <Integer>
  	argument count of current method or block being compiled
  needsFrame <Boolean>
  	whether methodObj or block needs a frame to execute
  primitiveIndex <Integer>
  	primitive index of current method being compiled
  methodLabel <CogAbstractOpcode>
  	label for the method header
  blockEntryLabel <CogAbstractOpcode>
  	label for the start of the block dispatch code
  stackOverflowCall <CogAbstractOpcode>
  	label for the call of ceStackOverflow in the method prolog
  sendMissCall <CogAbstractOpcode>
  	label for the call of ceSICMiss in the method prolog
  entryOffset <Integer>
  	offset of method entry code from start (header) of method
  entry <CogAbstractOpcode>
  	label for the first instruction of the method entry code
  noCheckEntryOffset <Integer>
  	offset of the start of a method proper (after the method entry code) from start (header) of method
  noCheckEntry <CogAbstractOpcode>
  	label for the first instruction of start of a method proper
  fixups <Array of <AbstractOpcode Label | nil>>
  	the labels for forward jumps that will be fixed up when reaching the relevant bytecode.  fixup shas one element per byte in methodObj's bytecode
  abstractOpcodes <Array of <AbstractOpcode>>
  	the code generated when compiling methodObj
  byte0 byte1 byte2 byte3 <Integer>
  	individual bytes of current bytecode being compiled in methodObj
  bytecodePointer <Integer>
  	bytecode pc (same as Smalltalk) of the current bytecode being compiled
  opcodeIndex <Integer>
  	the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
  numAbstractOpcodes <Integer>
  	the number of elements in abstractOpcocdes
  blockStarts <Array of <BlockStart>>
  	the starts of blocks in the current method
  blockCount
  	the index into blockStarts as they are being noted, and hence eventuakly teh total number of blocks in the current method
  labelCounter <Integer>
  	a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
  ceStackOverflowTrampoline <Integer>
  ceSend0ArgsTrampoline <Integer>
  ceSend1ArgsTrampoline <Integer>
  ceSend2ArgsTrampoline <Integer>
  ceSendNArgsTrampoline <Integer>
  ceSendSuper0ArgsTrampoline <Integer>
  ceSendSuper1ArgsTrampoline <Integer>
  ceSendSuper2ArgsTrampoline <Integer>
  ceSendSuperNArgsTrampoline <Integer>
  ceSICMissTrampoline <Integer>
  ceCPICMissTrampoline <Integer>
  ceStoreCheckTrampoline <Integer>
  ceReturnToInterpreterTrampoline <Integer>
  ceBaseFrameReturnTrampoline <Integer>
  ceSendMustBeBooleanTrampoline <Integer>
  ceClosureCopyTrampoline <Integer>
  	the various trampolines (system-call-like jumps from machine code to the run-time).
  	See Cogit>>generateTrampolines for the mapping from trampoline to run-time
  	routine and then read the run-time routine for a funcitonal description.
  ceEnterCogCodePopReceiverReg <Integer>
  	the enilopmart (jump from run-time to machine-code)
  methodZoneBase <Integer>
  !
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!

Item was changed:
  ----- Method: Cogit>>compileCogMethod: (in category 'compile abstract instructions') -----
  compileCogMethod: selector
  	<returnTypeC: #'CogMethod *'>
  	| numBytecodes numBlocks numCleanBlocks result extra |
  	hasYoungReferent := (objectMemory isYoungObject: methodObj)
  						  or: [objectMemory isYoung: selector].
  	methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
  	inBlock := false.
  	primInvokeLabel := nil.
  	postCompileHook := nil.
  	maxLitIndex := -1.
- 	usesMethodClass := false.
  	extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
  			and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
  				ifTrue: [30]
  				ifFalse: [10].
  	initialPC := coInterpreter startPCOfMethod: methodObj.
  	"initial estimate.  Actual endPC is determined in scanMethod."
  	endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
  					ifTrue: [initialPC - 1]
  					ifFalse: [objectMemory byteLengthOf: methodObj].
  	numBytecodes := endPC - initialPC + 1.
  	self allocateOpcodes: (numBytecodes + extra) * 10
  		bytecodes: numBytecodes
  		ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
  	(numBlocks := self scanMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
  	numCleanBlocks := self scanForCleanBlocks.
  	self allocateBlockStarts: numBlocks + numCleanBlocks.
  	blockCount := 0.
  	numCleanBlocks > 0 ifTrue:
  		[self addCleanBlockStarts].
  	(self maybeAllocAndInitCounters
  	 and: [self maybeAllocAndInitIRCs]) ifFalse: "Inaccurate error code, but it'll do.  This will likely never fail."
  		[^coInterpreter cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	
  	blockEntryLabel := nil.
  	methodLabel dependent: nil.
  	(result := self compileEntireMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
  	^self generateCogMethod: selector!

Item was changed:
  ----- Method: Cogit>>fillInMethodHeader:size:selector: (in category 'generate machine code') -----
  fillInMethodHeader: method size: size selector: selector
  	<returnTypeC: #'CogMethod *'>
  	<var: #method type: #'CogMethod *'>
  	<var: #originalMethod type: #'CogMethod *'>
  	| methodHeader originalMethod |
  	method cmType: CMMethod.
  	method objectHeader: objectMemory nullHeaderForMachineCodeMethod.
  	method blockSize: size.
  	method methodObject: methodObj.
  	methodHeader := coInterpreter rawHeaderOf: methodObj.
  	"If the method has already been cogged (e.g. Newspeak accessors) then
  	 leave the original method attached to its cog method, but get the right header."
  	(coInterpreter isCogMethodReference: methodHeader)
  		ifTrue:
  			[originalMethod := self cCoerceSimple: methodHeader to: #'CogMethod *'.
  			self assert: originalMethod blockSize = size.
  			methodHeader := originalMethod methodHeader.
  			self cppIf: NewspeakVM ifTrue:
  				[methodZone addToUnpairedMethodList: method]]
  		ifFalse:
  			[coInterpreter rawHeaderOf: methodObj put: method asInteger.
  			self cppIf: NewspeakVM ifTrue:
  				[method nextMethodOrIRCs: theIRCs]].
  	method methodHeader: methodHeader.
  	method selector: selector.
  	method cmNumArgs: (coInterpreter argumentCountOfMethodHeader: methodHeader).
  	(method cmRefersToYoung: hasYoungReferent) ifTrue:
  		[methodZone addToYoungReferrers: method].
  	method cmUsageCount: self initialMethodUsageCount.
  	method cpicHasMNUCase: false.
  	method cmUsesPenultimateLit: maxLitIndex >= ((coInterpreter literalCountOfHeader: methodHeader) - 2).
- 	method cmUsesMethodClass: usesMethodClass.
  	method blockEntryOffset: (blockEntryLabel notNil
  								ifTrue: [blockEntryLabel address - method asInteger]
  								ifFalse: [0]).
  	"This can be an error check since a large stackCheckOffset is caused by compiling
  	 a machine-code primitive, and hence depends on the Cogit, not the input method."
  	needsFrame ifTrue:
  		[stackCheckLabel address - method asInteger <= MaxStackCheckOffset ifFalse:
  			[self error: 'too much code for stack check offset']].
  	method stackCheckOffset: (needsFrame
  								ifTrue: [stackCheckLabel address - method asInteger]
  								ifFalse: [0]).
  	self assert: (backEnd callTargetFromReturnAddress: method asInteger + missOffset)
  				= (self methodAbortTrampolineFor: method cmNumArgs).
  	self assert: size = (methodZone roundUpLength: size).
  	^method!

Item was changed:
  ----- Method: ObjectMemory>>followField:ofObject: (in category 'forward compatibility') -----
  followField: fieldIndex ofObject: anObject
+ 	"Spur compatibility; in V3 this is a synonym for fetchPointer:ofObject:"
  	<inline: true>
  	^self fetchPointer: fieldIndex ofObject: anObject!

Item was removed:
- ----- Method: ObjectMemory>>followMaybeForwardedSelector:into: (in category 'interpreter access') -----
- followMaybeForwardedSelector: oop into: aBlock
- 	"Spur compatibility; in V3 this is just a noop"
- 	<inline: true>!

Item was removed:
- ----- Method: ObjectMemory>>followNonImmediateField:ofObject: (in category 'forward compatibility') -----
- followNonImmediateField: fieldIndex ofObject: anObject
- 	^self fetchPointer: fieldIndex ofObject: anObject!

Item was added:
+ ----- Method: ObjectMemory>>methodDictionaryHash:mask: (in category 'interpreter access') -----
+ methodDictionaryHash: oop mask: mask
+ 	<inline: true>
+ 	^mask bitAnd: ((self isImmediate: oop)
+ 						ifTrue: [self integerValueOf: oop]
+ 						ifFalse: [self hashBitsOf: oop])!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genSendDynamicSuper:numArgs: (in category 'bytecode generators') -----
  genSendDynamicSuper: selector numArgs: numArgs
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  	self assert: needsFrame.
  	self MoveMw: numArgs * BytesPerWord r: SPReg R: ReceiverResultReg.
  	numArgs > 2 ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	self MoveCw: selector R: ClassReg.
  	self CallSend: (dynamicSuperSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
- 	usesMethodClass := true.
  	self flag: 'currently caller pushes result'.
  	self PushR: ReceiverResultReg.
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genSendSuper:numArgs: (in category 'bytecode generators') -----
  genSendSuper: selector numArgs: numArgs
  	<inline: false>
  	self assert: needsFrame.
  	self assert: (numArgs between: 0 and: 256). "say"
  	self assert: (objectMemory addressCouldBeOop: selector).
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  	self MoveMw: numArgs * BytesPerWord r: SPReg R: ReceiverResultReg.
  	numArgs > 2 ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	self MoveCw: selector R: ClassReg.
  	self CallSend: (superSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
- 	usesMethodClass := true.
  	self flag: 'currently caller pushes result'.
  	self PushR: ReceiverResultReg.
  	^0!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>methodDictionaryHash:mask: (in category 'interpreter access') -----
+ methodDictionaryHash: oop mask: mask
+ 	<inline: true>
+ 	^mask bitAnd: ((self isImmediate: oop)
+ 						ifTrue: [(self isIntegerObject: oop)
+ 									ifTrue: [self integerValueOf: oop]
+ 									ifFalse: [self characterValueOf: oop]]
+ 						ifFalse: [self hashBitsOf: oop])!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>methodDictionaryHash:mask: (in category 'interpreter access') -----
+ methodDictionaryHash: oop mask: mask
+ 	<inline: true>
+ 	^mask bitAnd: ((self isImmediate: oop)
+ 						ifTrue: [self integerValueOf: oop] "this will fail for ShortFloat but we don't care"
+ 						ifFalse: [self hashBitsOf: oop])!

Item was changed:
  ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
  initialize
  	"SpurMemoryManager initialize"
  	BitsPerByte := 8.
  
- 	"A major policy issue for become is whether to follow selectors in method
- 	 dictionaries eagerly immediately post become, or whether to follow selectors
- 	 lazily during lookup."
- 	FollowMethodDictionariesOnBecome := false.
  	GatherForwardingStatistics := false.
  
  	"An obj stack is a stack of objects stored in a hidden root slot, such as
  	 the markStack or the ephemeronQueue.  It is a linked list of segments,
  	 with the hot end at the head of the list.  It is a word object.  The stack
  	 pointer is in ObjStackTopx and 0 means empty.  The list goes through
  	 ObjStackNextx. We don't want to shrink objStacks, since they're used
  	 in GC and its good to keep their memory around.  So unused pages
  	 created by popping emptying pages are kept on the ObjStackFreex list.
  	 ObjStackNextx must be the last field for swizzleObjStackAt:."
  	ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits"
  	ObjStackTopx := 0.
  	ObjStackMyx := 1.
  	ObjStackFreex := 2.
  	ObjStackNextx := 3.
  	ObjStackFixedSlots := 4.
  	ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots.
  	"There are currently three obj stacks, the mark stack, the weaklings and the ephemeron queue."
  	MarkStackRootIndex := self basicNew classTableRootSlots.
  	WeaklingStackRootIndex := MarkStackRootIndex + 1.
  	EphemeronQueueRootIndex := MarkStackRootIndex + 2.
  
  	MarkObjectsForEnumerationPrimitives := false.
  
  	"The remap buffer support is for compatibility; Spur doesn't GC during allocation.
  	 Eventually this should die."
  	RemapBufferSize := 25.
  
  	"Extra roots are for plugin support."
  	ExtraRootsSize := 2048 "max. # of external roots"!

Item was changed:
  ----- Method: SpurMemoryManager>>become:with:twoWay:copyHash: (in category 'become api') -----
  become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
  	"All references to each object in array1 are swapped with all references to the
  	 corresponding object in array2. That is, all pointers to one object are replaced
  	 with with pointers to the other. The arguments must be arrays of the same length. 
  	 Answers PrimNoErr if the primitive succeeds, otherwise a relevant error code."
  	"Implementation: Uses lazy forwarding to defer updating references until message send."
  	| ec |
  	self assert: becomeEffectsFlags = 0.
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
  	(self isArray: array1) ifFalse:
  		[^PrimErrBadReceiver].
  	((self isArray: array2)
  	 and: [(self numSlotsOf: array1) = (self numSlotsOf: array2)]) ifFalse:
  		[^PrimErrBadArgument].
  	(twoWayFlag or: [copyHashFlag])
  		ifTrue:
  			[ec := self containsOnlyValidBecomeObjects: array1 and: array2]
  		ifFalse:
  			[self forwardingCount: [statFollowForBecome := statFollowForBecome + 1].
  			 self followForwardedObjectFields: array2 toDepth: 0.
  			ec := self containsOnlyValidBecomeObjects: array1].
  	ec ~= 0 ifTrue: [^ec].
  
  	coInterpreter preBecomeAction.
  	twoWayFlag
  		ifTrue:
  			[self innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag]
  		ifFalse:
  			[self innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag].
+ 	self postBecomeOrCompactScanClassTable: becomeEffectsFlags.
- 	self postBecomeScanClassTable.
  	self followSpecialObjectsOop.
  	coInterpreter postBecomeAction: becomeEffectsFlags.
  	becomeEffectsFlags := 0.
  
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
  
  	^PrimNoErr "success"!

Item was changed:
  ----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') -----
  enterIntoClassTable: aBehavior
  	"Enter aBehavior into the class table and answer 0.  Otherwise answer a primitive failure code."
  	<inline: false>
  	| initialMajorIndex majorIndex minorIndex page |
  	majorIndex := classTableIndex >> self classTableMajorIndexShift.
  	initialMajorIndex := majorIndex.
  	"classTableIndex should never index the first page; it's reserved for known classes"
  	self assert: initialMajorIndex > 0.
  	minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask.
  
  	[page := self fetchPointer: majorIndex ofObject: hiddenRootsObj.
  	 page = nilObj ifTrue:
  		[page := self allocateSlotsInOldSpace: self classTablePageSize
  					format: self arrayFormat
  					classIndex: self arrayClassIndexPun.
  		 page ifNil:
  			[^PrimErrNoMemory].
  		 self fillObj: page numSlots: self classTablePageSize with: nilObj.
  		 self storePointer: majorIndex
  			ofObject: hiddenRootsObj
  			withValue: page.
  		 numClassTablePages := numClassTablePages + 1.
  		 minorIndex := 0].
  	 minorIndex to: self classTablePageSize - 1 do:
  		[:i|
  		(self fetchPointer: i ofObject: page) = nilObj ifTrue:
  			[classTableIndex := majorIndex << self classTableMajorIndexShift + i.
  			 self storePointer: i
  				ofObject: page
  				withValue: aBehavior.
  			 self setHashBitsOf: aBehavior to: classTableIndex.
  			 self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior.
- 			 "now fault-in method lookup chain."
- 			 self scanClassPostBecome: aBehavior
- 				effects: BecamePointerObjectFlag+BecameCompiledMethodFlag.
  			 self ensureAdequateClassTableBitmap.
  			 ^0]].
  	 majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1.
  	 majorIndex = initialMajorIndex ifTrue: "wrapped; table full"
  		[^PrimErrLimitExceeded]] repeat!

Item was removed:
- ----- Method: SpurMemoryManager>>followMaybeForwardedSelector:into: (in category 'object access') -----
- followMaybeForwardedSelector: oop into: aBlock
- 	"Policy switch for selector access in method dictionaries.
- 	 If FollowMethodDictionariesOnBecome then selectors have
- 	 already been followed. If not, follow lazily."
- 	<inline: true>
- 	FollowMethodDictionariesOnBecome ifFalse:
- 		[| field |
- 		 field := oop.
- 		 [self isOopForwarded: field] whileTrue:
- 			[field := self fetchPointer: 0 ofMaybeForwardedObject: field].
- 		 aBlock value: field]!

Item was removed:
- ----- Method: SpurMemoryManager>>followNonImmediateField:ofObject: (in category 'forwarding') -----
- followNonImmediateField: fieldIndex ofObject: anObject
- 	"Make sure the oop at fieldIndex in anObject is not forwarded (follow the
- 	 forwarder there-in if so).  Answer the (possibly followed) oop at fieldIndex.
- 	 N.B. the oop is assumed to be non-immediate."
- 	| objOop |
- 	objOop := self fetchPointer: fieldIndex ofObject: anObject.
- 	self assert: (self isNonImmediate: objOop).
- 	(self isForwarded: objOop) ifTrue:
- 		[objOop := self fixFollowedField: fieldIndex ofObject: anObject withInitialValue: objOop].
- 	^objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>postBecomeOrCompactScanClassTable: (in category 'become implementation') -----
  postBecomeOrCompactScanClassTable: effectsFlags
  	"Scan the class table post-become (iff a pointer object or compiled method was becommed),
  	 or post-compact.
  	 Note that one-way become can cause duplications in the class table.
  	 When can these be eliminated?  We use the classTableBitmap to mark classTable entries
  	 (not the classes themselves, since marking a class doesn't help in knowing if its index is used).
  	 On image load, and during incrememtal scan-mark and full GC, classIndices are marked.
  	 We can somehow avoid following classes from the classTable until after this mark phase."
  	self assert: self validClassTableRootPages.
  
+ 	(effectsFlags anyMask: BecamePointerObjectFlag) ifFalse: [^self].
+ 
- 	(effectsFlags anyMask: BecamePointerObjectFlag"+BecameCompiledMethodFlag") ifFalse: [^self].
- 	
  	0 to: numClassTablePages - 1 do:
  		[:i| | page |
  		page := self fetchPointer: i ofObject: hiddenRootsObj.
  		self assert: (self isForwarded: page) not.
  		0 to: (self numSlotsOf: page) - 1 do:
  			[:j| | classOrNil |
  			classOrNil := self fetchPointer: j ofObject: page.
  			classOrNil ~= nilObj ifTrue:
  				[(self isForwarded: classOrNil) ifTrue:
  					[classOrNil := self followForwarded: classOrNil.
+ 					 self storePointer: j ofObject: page withValue: classOrNil]]]]!
- 					 self storePointer: j ofObject: page withValue: classOrNil].
- 				 self scanClassPostBecome: classOrNil effects: effectsFlags]]]!

Item was removed:
- ----- Method: SpurMemoryManager>>postBecomeScanClassTable (in category 'become implementation') -----
- postBecomeScanClassTable
- 	"Scan the class table post-become (iff a pointer object or compiled method was becommed).
- 	 Note that one-way become can cause duplications in the class table.
- 	 When can these be eliminated?  We use the classtableBitmap to mark  classTable entries
- 	 (not the classes themselves, since marking a class doesn't help in knowing if its index is used).
- 	 On image load, and during incrememtal scan-mark and full GC, classIndices are marked.
- 	 We can somehow avoid following classes from the classTable until after this mark phase."
- 
- 	self assert: self validClassTableRootPages.
- 
- 	(becomeEffectsFlags anyMask: BecamePointerObjectFlag+BecameCompiledMethodFlag) ifFalse: [^self].
- 	
- 	self postBecomeOrCompactScanClassTable: becomeEffectsFlags!

Item was removed:
- ----- Method: SpurMemoryManager>>postCompactScanClassTable (in category 'become implementation') -----
- postCompactScanClassTable
- 	"Scan the class table post-compact.  Ensure all pages and
- 	 all classes are not forwarded."
- 
- 	0 to: numClassTablePages - 1 do:
- 		[:i| | page |
- 		page := self fetchPointer: i ofObject: hiddenRootsObj.
- 		(self isForwarded: page) ifTrue: "this check is for eliminateAndFreeForwarders"
- 			[page := self followForwarded: page.
- 			 self storePointer: i ofObject: hiddenRootsObj withValue: page]].
- 	self assert: self validClassTableRootPages.	
- 	self postBecomeOrCompactScanClassTable: BecamePointerObjectFlag+BecameCompiledMethodFlag!

Item was removed:
- ----- Method: SpurMemoryManager>>scanClassPostBecome:effects: (in category 'become implementation') -----
- scanClassPostBecome: startClassObj effects: becomeEffects
- 	"Scan a class in the class table post-become.  Make sure the superclass
- 	 chain contains no forwarding pointers, and that the method dictionaries
- 	 are not forwarded either.  N.B. we don't follow methods or their
- 	 methodClassAssociations since we can't guarantee that forwarders
- 	 to compiled methods are not stored in method dictionaries via at:put:
- 	 and so have to cope with forwarding pointers to compiled methods
- 	 in method dictionaries anyway.  Instead the [Co]Interpreter must
- 	 follow forwarders when fetching from method dictionaries and follow
- 	 forwarders on become in the method cache and method zone."
- 
- 	| classObj obj |
- 	"Algorithm depends on this to terminate loop at root of superclass chain."
- 	self assert: (self rawHashBitsOf: nilObj) ~= 0.
- 	self assert: (becomeEffects anyMask: BecamePointerObjectFlag). "otherwise why bother?"
- 	classObj := startClassObj.
- 
- 	["e.g. the Newspeak bootstrap creates fake classes that contain bogus superclasses.
- 	  Hence be cautious.  Also need to terminate at nilObject."
- 	 ((self isPointers: classObj)
- 	   and: [(self rawNumSlotsOf: classObj) > MethodDictionaryIndex]) ifFalse:
- 		[^self].
- 	 obj := self followObjField: MethodDictionaryIndex ofObject: classObj.
- 	 "Solving the becommed method stored into a method dictionary object issue is easy;
- 	  just have a read barrier on fetching the method.  But solving the read barrier for
- 	  selectors is more difficult (because selectors are currently not read, just their oops).
- 	  For now provide a policy switch that either follows on become or lazily on lookup."
- 	 self flag: 'need to fix the selector and methodDictionary issue'.
- 	 self forwardingCount: [statFollowForBecome := statFollowForBecome + 1].
- 	 FollowMethodDictionariesOnBecome
- 		ifTrue: [self followForwardedObjectFields: obj toDepth: 0]
- 		ifFalse:
- 			[(self rawNumSlotsOf: obj) > MethodArrayIndex ifTrue:
- 				[self followObjField: MethodArrayIndex ofObject: obj]].
- 	 obj := self followObjField: SuperclassIndex ofObject: classObj.
- 	 "If the superclass has an identityHash then either it is nil, or is in the class table.
- 	  Tail recurse."
- 	 (self rawHashBitsOf: obj) = 0] whileTrue:
- 		["effectively self scanClassPostBecome: obj"
- 		 classObj := obj]!

Item was removed:
- ----- Method: StackInterpreter>>actuallyFollowNecessaryForwardingInMethod: (in category 'lazy become') -----
- actuallyFollowNecessaryForwardingInMethod: methodObj
- 	"To avoid any chance of a forwarded object during super sends we follow the
- 	 methodClassAssociation.  The forwarded object send fault only copes with
- 	 normal sends to instances."
- 	<option: #SpurObjectMemory>
- 	<inline: true>
- 	self actuallyFollowNecessaryForwardingInMethod: methodObj
- 		literalCount: (self literalCountOf: methodObj)!

Item was removed:
- ----- Method: StackInterpreter>>actuallyFollowNecessaryForwardingInMethod:literalCount: (in category 'lazy become') -----
- actuallyFollowNecessaryForwardingInMethod: methodObj literalCount: litCount
- 	"To avoid any chance of a forwarded object during super sends we follow the
- 	 methodClassAssociation.  The forwarded object send fault only copes with
- 	 normal sends to instances.  Inline methodClassAssociation access for speed."
- 	| assoc classObj |
- 	<option: #SpurObjectMemory>
- 	<inline: true>
- 	assoc := self literal: litCount - 1 ofMethod: methodObj.
- 	(objectMemory isForwarded: assoc) ifTrue:
- 		[assoc := objectMemory followForwarded: assoc.
- 		 objectMemory
- 			storePointer: litCount + LiteralStart - 1
- 			ofObject: methodObj
- 			withValue: assoc].
- 	(objectMemory numSlotsOf: assoc) >= (ValueIndex + 1) ifTrue:
- 		[classObj := objectMemory fetchPointer: ValueIndex ofObject: assoc.
- 		 (objectMemory isForwarded: classObj) ifTrue:
- 			[classObj := objectMemory followForwarded: classObj.
- 			 objectMemory storePointer: ValueIndex ofObject: assoc withValue: classObj]]!

Item was changed:
  ----- Method: StackInterpreter>>followForwardingPointersInScheduler (in category 'object memory support') -----
  followForwardingPointersInScheduler
  	| schedAssoc sched procLists |
  	schedAssoc := objectMemory splObj: SchedulerAssociation.
  	"the GC follows pointers in the special objects array for us."
  	self assert: (objectMemory isForwarded: schedAssoc) not.
  
+ 	sched := objectMemory followObjField: ValueIndex ofObject: schedAssoc.
- 	sched := objectMemory followNonImmediateField: ValueIndex ofObject: schedAssoc.
  
+ 	procLists := objectMemory followObjField: ProcessListsIndex ofObject: sched.
- 	procLists := objectMemory followNonImmediateField: ProcessListsIndex ofObject: sched.
  
  	0 to: (objectMemory numSlotsOf: procLists) - 1 do:
  		[:i| | list first last next |
+ 		list := objectMemory followObjField: i ofObject: procLists.
+ 		first := objectMemory followObjField: FirstLinkIndex ofObject: list.
+ 		last := objectMemory followObjField: LastLinkIndex ofObject: list.
- 		list := objectMemory followNonImmediateField: i ofObject: procLists.
- 		first := objectMemory followNonImmediateField: FirstLinkIndex ofObject: list.
- 		last := objectMemory followNonImmediateField: LastLinkIndex ofObject: list.
  		[first ~= last] whileTrue:
+ 			[next := objectMemory followObjField: NextLinkIndex ofObject: first.
- 			[next := objectMemory followNonImmediateField: NextLinkIndex ofObject: first.
  			 first := next]]
  !

Item was changed:
  ----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: theBecomeEffectsFlags
  	"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
  	 The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
  	 probe, since notionally objects' internals are accessed only via sending messages to them,
  	 the exception is primitives that access the internals of the non-receiver argument(s).
  	 To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and
  	 methods in the stack zone and follow any forwarded ones.  This is of course way cheaper
  	 than scanning all of memory as in the old become."
  	| theIPPtr |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #usqInt>
  
  	(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  		[(objectMemory isForwarded: method) ifTrue:
  			[theIPPtr := instructionPointer - method.
  			 method := objectMemory followForwarded: method.
  			 instructionPointer := method + theIPPtr].
  		(objectMemory isForwarded: newMethod) ifTrue:
  			[newMethod := objectMemory followForwarded: newMethod]].
  
  	self assert: stackPage ~= 0.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP theIP oop |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP asUnsignedInteger.
  					 theSP := theSP + BytesPerWord].
  			 [self assert: (thePage addressIsInPage: theFP).
  			  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
  			  oop := stackPages longAt: theFP + FoxReceiver.
  			  (objectMemory isOopForwarded: oop) ifTrue:
  				[stackPages
  					longAt: theFP + FoxReceiver
  					put: (objectMemory followForwarded: oop)].
  			  theIP := (theFP + (self frameStackedReceiverOffset: theFP)) asUnsignedInteger. "reuse theIP; its just an offset here"
  			  oop := stackPages longAt: theIP.
  			  (objectMemory isOopForwarded: oop) ifTrue:
  				[stackPages
  					longAt: theIP
  					put: (objectMemory followForwarded: oop)].
  			  ((self frameHasContext: theFP)
  			   and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory followForwarded: (self frameContext: theFP))].
  			  oop := self frameMethod: theFP.
  			  (objectMemory isForwarded: oop) ifTrue:
  				[| newOop delta |
  				 newOop := objectMemory followForwarded: oop.
  				 theIPPtr ~= 0 ifTrue:
  					[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  					 delta := newOop - oop.
  					 stackPages
  						longAt: theIPPtr
  						put: (stackPages longAt: theIPPtr) + delta].
  				stackPages
  					longAt: theFP + FoxMethod
  					put: (oop := newOop)].
- 			  self followNecessaryForwardingInMethod: oop.
  			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
  				 theFP := callerFP]]]!

Item was added:
+ ----- Method: StackInterpreter>>followLiteral:ofMethod: (in category 'compiled methods') -----
+ followLiteral: offset ofMethod: methodPointer
+ 	<api>
+ 	^objectMemory followField: offset + LiteralStart ofObject: methodPointer
+ !

Item was removed:
- ----- Method: StackInterpreter>>followNecessaryForwardingInMethod: (in category 'lazy become') -----
- followNecessaryForwardingInMethod: methodObj
- 	"To avoid any chance of a forwarded object during super sends we follow the
- 	 methodClassAssociation.  The forwarded object send fault only copes with
- 	 normal sends to instances."
- 	<inline: false>
- 	objectMemory hasSpurMemoryManagerAPI ifTrue:
- 		[self actuallyFollowNecessaryForwardingInMethod: methodObj]!

Item was changed:
  ----- Method: StackInterpreter>>initialize (in category 'initialization') -----
  initialize
  	"Here we can initialize the variables C initializes to zero.  #initialize methods do /not/ get translated."
+ 	super initialize.
+ 
  	checkAllocFiller := false. "must preceed initializeObjectMemory:"
  	primFailCode := 0.
  	stackLimit := 0. "This is also the initialization flag for the stack system."
  	stackPage := overflowedPage := 0.
  	extraFramesToMoveOnOverflow := 0.
  	bytecodeSetSelector := 0.
  	highestRunnableProcessPriority := 0.
  	nextProfileTick := 0.
  	nextPollUsecs := 0.
  	nextWakeupUsecs := 0.
  	tempOop := theUnknownShort := 0.
  	interruptPending := false.
  	inIOProcessEvents := 0.
  	fullScreenFlag := 0.
  	deferDisplayUpdates := false.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	jmpDepth := 0.
  	longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
  	maxExtSemTabSizeSet := false.
  	statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
  	statProcessSwitch := statIOProcessEvents := statStackPageDivorce := 0.
  	statFollowCurrentMethod := statFollowForSendFault := statFollowForSignal :=
  	statFollowForPrimFail := statFollowForSelectorFault := statFollowForSpecialSelector := 0
  !

Item was changed:
  ----- Method: StackInterpreter>>lookupMethodFor:InDictionary: (in category 'message sending') -----
  lookupMethodFor: selector InDictionary: dictionary
  	"Lookup the argument selector in aDictionary and answer either the
  	 method or nil, if not found.
  	This method lookup tolerates integers as Dictionary keys to support
  	 execution of images in which Symbols have been compacted out."
  	| length index mask wrapAround nextSelector methodArray |
  	<inline: true>
  	<asmLabel: false>
  	length := objectMemory fetchWordLengthOf: dictionary.
  	mask := length - SelectorStart - 1.
+ 	index := SelectorStart + (objectMemory methodDictionaryHash: selector mask: mask).
- 	index := SelectorStart + (mask bitAnd: ((objectMemory isImmediate: selector)
- 												ifTrue: [objectMemory integerValueOf: selector]
- 												ifFalse: [objectMemory hashBitsOf: selector])).
  
  	"It is assumed that there are some nils in this dictionary, and search will 
  	 stop when one is encountered. However, if there are no nils, then wrapAround 
  	 will be detected the second time the loop gets to the end of the table."
  	wrapAround := false.
  	[true] whileTrue:
  		[nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
  		 nextSelector = objectMemory nilObject ifTrue:
  			[^nil].
+ 		 (objectMemory isOopForwarded: nextSelector) ifTrue:
+ 			[nextSelector := objectMemory
+ 								fixFollowedField: index + SelectorStart
+ 								ofObject: dictionary
+ 								withInitialValue: nextSelector].
- 		 objectMemory
- 			followMaybeForwardedSelector: nextSelector
- 			into: [:followed| nextSelector := followed].
  		 nextSelector = selector ifTrue:
+ 			[methodArray := objectMemory followObjField: MethodArrayIndex ofObject: dictionary.
+ 			 ^objectMemory followField: index - SelectorStart ofObject: methodArray].
- 			[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
- 			 ^objectMemory fetchPointer: index - SelectorStart ofObject: methodArray].
  		 index := index + 1.
  		 index = length ifTrue:
  			[wrapAround ifTrue: [^nil].
  			 wrapAround := true.
  			 index := SelectorStart]].
  	^nil "for Slang"!

Item was changed:
  ----- Method: StackInterpreter>>lookupMethodInDictionary: (in category 'message sending') -----
  lookupMethodInDictionary: dictionary 
  	"This method lookup tolerates integers as Dictionary keys to support
  	 execution of images in which Symbols have been compacted out."
  	| length index mask wrapAround nextSelector methodArray |
  	<inline: true>
  	<asmLabel: false>
  	length := objectMemory fetchWordLengthOf: dictionary.
  	mask := length - SelectorStart - 1.
  	"Use linear search on small dictionaries; its cheaper.
  	 Also the limit can be set to force linear search of all dictionaries, which supports the
  	 booting of images that need rehashing (e.g. because a tracer has generated an image
  	 with different hashes but hasn't rehashed it yet.)"
  	mask <= methodDictLinearSearchLimit ifTrue:
  		[index := 0.
  		 [index <= mask] whileTrue:
  			[nextSelector := objectMemory fetchPointer: index + SelectorStart ofObject: dictionary.
+ 			 (objectMemory isOopForwarded: nextSelector) ifTrue:
+ 				[nextSelector := objectMemory
+ 									fixFollowedField: index + SelectorStart
+ 									ofObject: dictionary
+ 									withInitialValue: nextSelector].
- 			 objectMemory
- 				followMaybeForwardedSelector: nextSelector
- 				into: [:followed| nextSelector := followed].
  			 nextSelector = messageSelector ifTrue:
+ 				[methodArray := objectMemory followObjField: MethodArrayIndex ofObject: dictionary.
- 				[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
  				 newMethod := objectMemory followField: index ofObject: methodArray.
  				^true].
  		 index := index + 1].
  		 ^false].
+ 	index := SelectorStart + (objectMemory methodDictionaryHash: messageSelector mask: mask).
- 	index := SelectorStart + (mask bitAnd: ((objectMemory isImmediate: messageSelector)
- 												ifTrue: [objectMemory integerValueOf: messageSelector]
- 												ifFalse: [objectMemory hashBitsOf: messageSelector])).
  
  	"It is assumed that there are some nils in this dictionary, and search will 
  	 stop when one is encountered. However, if there are no nils, then wrapAround 
  	 will be detected the second time the loop gets to the end of the table."
  	wrapAround := false.
  	[true] whileTrue:
  		[nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
  		 nextSelector = objectMemory nilObject ifTrue: [^false].
+ 		 (objectMemory isOopForwarded: nextSelector) ifTrue:
+ 			[nextSelector := objectMemory
+ 								fixFollowedField: index + SelectorStart
+ 								ofObject: dictionary
+ 								withInitialValue: nextSelector].
- 		 objectMemory
- 			followMaybeForwardedSelector: nextSelector
- 			into: [:followed| nextSelector := followed].
  		 nextSelector = messageSelector ifTrue:
+ 			[methodArray := objectMemory followObjField: MethodArrayIndex ofObject: dictionary.
- 			[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
  			 newMethod := objectMemory followField: index - SelectorStart ofObject: methodArray.
  			^true].
  		 index := index + 1.
  		 index = length ifTrue:
  			[wrapAround ifTrue: [^false].
  			 wrapAround := true.
  			 index := SelectorStart]].
  	
  	^false "for Slang"!

Item was changed:
  ----- Method: StackInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  	"Marry aContext with the base frame of a new stack page.  Build the base
  	 frame to reflect the context's state.  Answer the new page."
  	<returnTypeC: #'StackPage *'>
  	| page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
  	<inline: false>
  	<var: #page type: #'StackPage *'>
  	<var: #pointer type: #'char *'>
  	self assert: (self isSingleContext: aContext).
  	self assert: (objectMemory goodContextSize: aContext).
  	page := self newStackPage.
  	pointer := page baseAddress.
  	theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
+ 	theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
- 	theMethod := objectMemory followNonImmediateField: MethodIndex ofObject: aContext.
- 	self followNecessaryForwardingInMethod: theMethod.
  	(objectMemory isIntegerObject: theIP) ifFalse:
  		[self error: 'context is not resumable'].
  	theIP := objectMemory integerValueOf: theIP.
  	rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
  	"If the frame is a closure activation then the closure should be on the stack in
  	 the pushed receiver position (closures receiver the value[:value:] messages).
  	 Otherwise it should be the receiver proper."
  	maybeClosure := objectMemory followField: ClosureIndex ofObject: aContext.
  	maybeClosure ~= objectMemory nilObject
  		ifTrue:
  			[numArgs := self argumentCountOfClosure: maybeClosure.
  			 stackPages longAt: pointer put: maybeClosure]
  		ifFalse:
  			[| header |
  			 header := self headerOf: theMethod.
  			 numArgs := self argumentCountOfMethodHeader: header.
  			 self cppIf: MULTIPLEBYTECODESETS
  				ifTrue: "If this is a synthetic context its IP could be pointing at the CallPrimitive opcode.  If so, skip it."
  					[(theIP signedIntFromLong > 0
  					  and: [(self methodHeaderHasPrimitive: header)
  					  and: [theIP = (1 + (objectMemory lastPointerOf: theMethod))]]) ifTrue:
  						[theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)]].
  			 stackPages longAt: pointer put: rcvr].
  	"Put the arguments on the stack"
  	1 to: numArgs do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - BytesPerWord)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"saved caller ip is sender context in base frame"
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: (objectMemory fetchPointer: SenderIndex ofObject: aContext).
  	"base frame's saved fp is null"
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: 0.
  	page baseFP: pointer; headFP: pointer.
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: theMethod.
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  	self assert: (self frameHasContext: page baseFP).
  	self assert: (self frameNumArgs: page baseFP) == numArgs.
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: aContext.
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: rcvr.
  	stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  	self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  	numArgs + 1 to: stackPtrIndex do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - BytesPerWord)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"top of stack is the instruction pointer"
  	theIP := self iframeInstructionPointerForIndex: theIP method: theMethod.
  	stackPages longAt: (pointer := pointer - BytesPerWord) put: theIP.
  	page headSP: pointer.
  	self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
  
  	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
  	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
  	 w.r.t. the frame when we check for validity) plus SmallInteger tags."
  	objectMemory storePointerUnchecked: SenderIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: page baseFP).
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: 0).
  	self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  	self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  	self assert: (self validStackPageBaseFrame: page).
  	^page!

Item was changed:
  ----- Method: StackInterpreter>>methodClassOf: (in category 'compiled methods') -----
  methodClassOf: methodPointer
  	<api>
+ 	"Using a read barrier here simplifies the become implementation and costs very little
+ 	 because the class index and ValueIndex of the association almost certainly share a cache line."
  	^self cppIf: NewspeakVM
  		ifTrue:
  			[| literal |
+ 			 literal := self followLiteral: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
- 			 literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
- 			 self assert: (objectMemory isForwarded: literal) not.
  			 literal = objectMemory nilObject
  				ifTrue: [literal]
+ 				ifFalse: [objectMemory followField: ValueIndex ofObject: literal]]
- 				ifFalse: [objectMemory fetchPointer: ValueIndex ofObject: literal]]
  		ifFalse:
  			[| literal |
+ 			 literal := self followLiteral: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
+ 			 objectMemory followField: ValueIndex ofObject: literal]!
- 			 literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
- 			 self assert: (objectMemory isForwarded: literal) not.
- 			 objectMemory fetchPointer: ValueIndex ofObject: literal]!

Item was changed:
  ----- Method: StackInterpreter>>superclassOf: (in category 'message sending') -----
  superclassOf: classPointer
+ 	"Using a read barrier here simplifies the become implementation and costs very
+ 	 little because the class index and superclass almost certainly share a cache line."
  	<inline: true>
+ 	^objectMemory followField: SuperclassIndex ofObject: classPointer!
- 	^objectMemory fetchPointer: SuperclassIndex ofObject: classPointer!

Item was changed:
  ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the StackInterpreterSimulator when running the interpreter
  	 inside Smalltalk. The primary responsibility of this method is to allocate
  	 Smalltalk Arrays for variables that will be declared as statically-allocated
  	 global arrays in the translated code."
+ 	super initialize.
  
  	bootstrapping := false.
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	objectMemory coInterpreter: self.
  
  	"Note: we must initialize ConstMinusOne differently for simulation,
  		due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := objectMemory integerObjectOf: -1.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	mappedPluginEntries := OrderedCollection new.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[primitiveAccessorDepthTable := Array new: primitiveTable size.
  			 pluginList := {}.
  			 self loadNewPlugin: '']
  		ifFalse:
  			[pluginList := {'' -> self }].
  	desiredNumStackPages := desiredEdenBytes := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := 0.
  	sendCount := 0.
  	quitBlock := [^self].
  	traceOn := true.
  	printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	eventQueue := SharedQueue new.
  	suppressHeartbeatFlag := false.
  	systemAttributes := Dictionary new.
  	extSemTabSize := 256.
  	disableBooleanCheat := false.
  	assertVEPAES := true. "a flag so the assertValidExecutionPointers in run can be turned off for simulation speed"!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genMarshalledSendDynamicSuper:numArgs: (in category 'bytecode generators') -----
  genMarshalledSendDynamicSuper: selector numArgs: numArgs
  	<inline: false>
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  	self assert: needsFrame.
  	numArgs > 2 ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	self MoveCw: selector R: ClassReg.
  	self CallSend: (dynamicSuperSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
- 	usesMethodClass := true.
  	optStatus isReceiverResultRegLive: false.
  	^self ssPushRegister: ReceiverResultReg!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genMarshalledSendSuper:numArgs: (in category 'bytecode generators') -----
  genMarshalledSendSuper: selector numArgs: numArgs
  	<inline: false>
  	(objectMemory isYoung: selector) ifTrue:
  		[hasYoungReferent := true].
  	self assert: needsFrame.
  	numArgs > 2 ifTrue:
  		[self MoveCq: numArgs R: SendNumArgsReg].
  	self MoveCw: selector R: ClassReg.
  	self CallSend: (superSendTrampolines at: (numArgs min: NumSendTrampolines - 1)).
- 	usesMethodClass := true.
  	optStatus isReceiverResultRegLive: false.
  	^self ssPushRegister: ReceiverResultReg!



More information about the Vm-dev mailing list