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

commits at source.squeak.org commits at source.squeak.org
Tue Jul 15 18:17:54 UTC 2014


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

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

Name: VMMaker.oscog-eem.820
Author: eem
Time: 15 July 2014, 11:13:41.986 am
UUID: 783c4789-0cac-41f9-9b01-d1930e0fe4d7
Ancestors: VMMaker.oscog-eem.819

Rip out the forwardingCount: measurement code.  It causes
bad performance regressions (due to failing inlines?)

Put the handling of the cloning of cogged methods in the
clone: implementations, removing it from the primitive.
Add it to the pinning clone too.

Add SpurGenerationScavenger's api methods to Spur32BitCoMemoryManager's.  Hence search for option:
variables in the class pools of the interpreterClass and
objectMemoryClass

Specialize the store check trampoline generation.
Move it down to the relevant object representations.

Move setting of isRemembered flag to true into
SpurGenerationScavenger>>remember:.  Inline
possibleRootStoreInto: (given that remember: is /not/
inlined.  Call remember directly from the
ceStoreCheckTrampoline, and hence have
remember: answer its argument.

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

Item was changed:
  ----- Method: CoInterpreter>>followForwardedFieldsInCurrentMethod (in category 'message sending') -----
  followForwardedFieldsInCurrentMethod
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	<inline: false>
- 	objectMemory forwardingCount: [statFollowCurrentMethod := statFollowCurrentMethod + 1].
  	(self isMachineCodeFrame: framePointer)
  		ifTrue:
  			[cogMethod := self mframeHomeMethod: framePointer.
  			 objectMemory
  				followForwardedObjectFields: cogMethod methodObject
  				toDepth: 0.
  			 cogit followForwardedLiteralsIn: cogMethod]
  		ifFalse:
  			[objectMemory
  				followForwardedObjectFields: method
  				toDepth: 0]!

Item was changed:
  ----- Method: CoInterpreter>>handleForwardedSendFaultForReceiver:stackDelta: (in category 'message sending') -----
  handleForwardedSendFaultForReceiver: forwardedReceiver stackDelta: stackDelta
  	"Handle a send fault that may be due to a send to a forwarded object.
  	 Unforward the receiver on the stack and answer it."
  	<option: #SpurObjectMemory>
  	| rcvrStackIndex rcvr |
  	<inline: false>
  	"should *not* be a super send, so the receiver should be forwarded."
  	self assert: (objectMemory isOopForwarded: forwardedReceiver).
  	rcvrStackIndex := argumentCount + stackDelta.
  	self assert: (self stackValue: rcvrStackIndex) = forwardedReceiver.
  	rcvr := objectMemory followForwarded: forwardedReceiver.
  	self stackValue: rcvrStackIndex put: rcvr.
  	self followForwardedFrameContents: framePointer
  		stackPointer: stackPointer + (rcvrStackIndex + 1 * BytesPerWord). "don't repeat effort"
  	(objectMemory isPointers: (self frameReceiver: framePointer)) ifTrue:
+ 		[objectMemory
- 		[objectMemory forwardingCount: [statFollowForSendFault := statFollowForSendFault + 1].
- 		 objectMemory
  			followForwardedObjectFields: (self frameReceiver: framePointer)
  			toDepth: 0].
  	self followForwardedFieldsInCurrentMethod.
  	^rcvr!

Item was added:
+ ----- Method: CoInterpreter>>maybeFixClonedCompiledMethod: (in category 'cog jit support') -----
+ maybeFixClonedCompiledMethod: objOop
+ 	"Make sure a cloned method doesn't reference its originals Cog method, if any."
+ 	| rawHeader |
+ 	self assert: (objectMemory isOopCompiledMethod: objOop).
+ 	rawHeader := self rawHeaderOf: objOop.
+ 	(self isCogMethodReference: rawHeader) ifTrue:
+ 		[self
+ 			rawHeaderOf: objOop
+ 			put: (self cCoerceSimple: rawHeader to: #'CogMethod *') methodHeader]!

Item was changed:
  ----- Method: CoInterpreter>>synchronousSignal: (in category 'process primitive support') -----
  synchronousSignal: aSemaphore 
  	"Signal the given semaphore from within the interpreter.
  	 Answer if the current process was preempted.
  	 Override to add tracing info."
  	| excessSignals |
  	<inline: false>
  	(self isEmptyList: aSemaphore) ifTrue:
  		["no process is waiting on this semaphore"
  		 excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: aSemaphore.
  		 self storeInteger: ExcessSignalsIndex
  			ofObject: aSemaphore
  			withValue: excessSignals + 1.
  		 ^false].
  
  	objectMemory hasSpurMemoryManagerAPI ifTrue:
  		[| firstLink |
  		 firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aSemaphore.
  		 (objectMemory isForwarded: firstLink) ifTrue:
  			["0 = aSemaphore, 1 = aProcess. Hence reference to suspendedContext will /not/ be forwarded."
- 			 objectMemory forwardingCount: [statFollowForSignal := statFollowForSignal + 1].
  			 objectMemory followForwardedObjectFields: aSemaphore toDepth: 1].
  		 self assert: (objectMemory isForwarded: (objectMemory fetchPointer: SuspendedContextIndex ofObject: firstLink)) not].
  
  	^self resume: (self removeFirstLinkOfList: aSemaphore)
  		preemptedYieldingIf: preemptionYields
  		from: CSSignal!

Item was removed:
- ----- Method: CoInterpreterPrimitives>>primitiveClone (in category 'object access primitives') -----
- primitiveClone
- 	"Return a shallow copy of the receiver.
- 	 Special-case non-single contexts (because of context-to-stack mapping).
- 	 Can't fail for contexts cuz of image context instantiation code (sigh).
- 	 Special case CompiledMerhods since the copy mustn't refer to CogMethod
- 	 if receiver has been cogged."
- 
- 	| rcvr newCopy objHeader |
- 	rcvr := self stackTop.
- 	(objectMemory isImmediate: rcvr)
- 		ifTrue: [newCopy := rcvr]
- 		ifFalse:
- 			[objHeader := objectMemory baseHeader: rcvr.
- 			(objectMemory isContextHeader: objHeader)
- 				ifTrue: [newCopy := self cloneContext: rcvr]
- 				ifFalse: [newCopy := objectMemory clone: rcvr].
- 			newCopy = 0 ifTrue:
- 				[^self primitiveFailFor: PrimErrNoMemory].
- 			(objectMemory isCompiledMethodHeader: objHeader) ifTrue:
- 				["use stackTop since GC may have moved rcvr"
- 				 self rawHeaderOf: newCopy put: (self headerOf: self stackTop)]].
- 	self pop: argumentCount + 1 thenPush: newCopy!

Item was changed:
  ----- Method: CogObjectRepresentation>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
+ 	"Do the store check.  Answer the argument for the benefit of the code generator;
+ 	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
+ 	 it allows the code generator to reload ReceiverResultReg cheaply."
+ 	self subclassResponsibility!
- 	ceStoreCheckTrampoline := cogit
- 									genTrampolineFor: #ceStoreCheck:
- 									called: 'ceStoreCheckTrampoline'
- 									arg: ReceiverResultReg
- 									result: cogit returnRegForStoreCheck!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
+ 	"Do the store check.  Answer the argument for the benefit of the code generator;
+ 	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
+ 	 it allows the code generator to reload ReceiverResultReg cheaply.
+ 	 In Spur the only thing we leave to the run-time is adding the receiver to the
+ 	 remembered set and setting its isRemembered bit."
+ 	ceStoreCheckTrampoline := cogit
+ 									genTrampolineFor: #remember:
+ 									called: 'ceStoreCheckTrampoline'
+ 									arg: ReceiverResultReg
+ 									result: cogit returnRegForStoreCheck.
- 	super generateObjectRepresentationTrampolines.
  	ceSheduleScavengeTrampoline := cogit
  											genSafeTrampolineFor: #ceSheduleScavenge
  											called: 'ceSheduleScavengeTrampoline'.
  	ceSmallActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: false inBlock: false called: 'ceSmallMethodContext'.
  	ceSmallActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: true called: 'ceSmallBlockContext'.
  	ceLargeActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: true inBlock: false called: 'ceLargeMethodContext'.
  	ceLargeActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: true called: 'ceLargeBlockContext'!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
+ 	"Do the store check.  Answer the argument for the benefit of the code generator;
+ 	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
+ 	 it allows the code generator to reload ReceiverResultReg cheaply."
+ 	ceStoreCheckTrampoline := cogit
+ 									genTrampolineFor: #ceStoreCheck:
+ 									called: 'ceStoreCheckTrampoline'
+ 									arg: ReceiverResultReg
+ 									result: cogit returnRegForStoreCheck.
- 	super generateObjectRepresentationTrampolines.
  	ceCreateNewArrayTrampoline := cogit genTrampolineFor: #ceNewArraySlotSize:
  											called: 'ceCreateNewArrayTrampoline'
  											arg: SendNumArgsReg
  											result: ReceiverResultReg.
  	cePositive32BitIntegerTrampoline := cogit genTrampolineFor: #positive32BitIntegerFor:
  												called: 'cePositive32BitIntegerTrampoline'
  												arg: ReceiverResultReg
  												result: TempReg.
  	ceActiveContextTrampoline := self genActiveContextTrampoline.
  	ceClosureCopyTrampoline := cogit genTrampolineFor: #ceClosureCopyDescriptor:
  										called: 'ceClosureCopyTrampoline'
  										arg: SendNumArgsReg
  										result: ReceiverResultReg!

Item was changed:
  ----- Method: NewObjectMemory>>clone: (in category 'allocation') -----
  clone: obj
+ 	"Return a shallow copy of the given object. May cause GC.
+ 	 Assume: Oop is a real object, not a small integer.
+ 	 Override to assert it's not a married context and maybe fix cloned methods."
+ 	| extraHdrBytes bytes newChunk remappedOop fromIndex toIndex lastFrom newOop header hash |
+ 	<inline: false>
+ 	<var: #lastFrom type: #usqInt>
+ 	<var: #fromIndex type: #usqInt>
- 	"Return a shallow copy of the given object. May cause GC"
- 	"Assume: Oop is a real object, not a small integer.
- 	 Override to assert it's not a married context"
  	self assert: ((self isContext: obj) not
  				or: [(coInterpreter isMarriedOrWidowedContext: obj) not]). 
+ 
+ 	self assert: (self isNonIntegerObject: obj).
+ 	extraHdrBytes := self extraHeaderBytes: obj.
+ 	bytes := self sizeBitsOf: obj.
+ 	bytes := bytes + extraHdrBytes.
+ 
+ 	"allocate space for the copy, remapping obj in case of a GC"
+ 	self pushRemappableOop: obj.
+ 	"check it is safe to allocate this much memory. Return 0 if not"
+ 	(self sufficientSpaceToAllocate: 2500 + bytes) ifFalse:[^0].
+ 	newChunk := self allocateChunk: bytes.
+ 	remappedOop := self popRemappableOop.
+ 
+ 	"copy old to new including all header words"
+ 	toIndex := newChunk - BytesPerWord.  "loop below uses pre-increment"
+ 	fromIndex := (remappedOop - extraHdrBytes) - BytesPerWord.
+ 	lastFrom := fromIndex + bytes.
+ 	[fromIndex < lastFrom] whileTrue:
+ 		[self longAt: (toIndex := toIndex + BytesPerWord)
+ 			put: (self longAt: (fromIndex := fromIndex + BytesPerWord))].
+ 	newOop := newChunk + extraHdrBytes.  "convert from chunk to oop"
+ 
+ 	"fix base header: compute new hash and clear Mark and Root bits"
+ 	hash := self newObjectHash.
+ 	header := (self longAt: newOop) bitAnd: 16r1FFFF.
+ 	"use old ccIndex, format, size, and header-type fields"
+ 	header := header bitOr: ((hash << HashBitsOffset) bitAnd: HashBits).
+ 	self longAt: newOop put: header.
+ 	(self isCompiledMethodHeader: header) ifTrue:
+ 		[coInterpreter maybeFixClonedCompiledMethod: newOop].
+ 	^newOop
+ !
- 	^super clone: obj!

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

Item was removed:
- ----- Method: ObjectMemory>>forwardingCount: (in category 'spur compatibility') -----
- forwardingCount: aBlock
- 	"Hook for turning on and off statistics gathering on forwarding.  Off here-in."
- 	<inline: true>!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager class>>exportAPISelectors: (in category 'translation') -----
+ exportAPISelectors: options
+ 	^(Set withAll: (self exportAPISelectorsFor: self))
+ 		addAll: (SpurGenerationScavenger exportAPISelectors: options);
+ 		yourself!

Item was removed:
- ----- Method: Spur32BitCoMemoryManager>>ceStoreCheck: (in category 'trampolines') -----
- ceStoreCheck: anOop
- 	<api>
- 	"Do the store check.  Answer the argument for the benefit of the code generator;
- 	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
- 	 it allows the code generator to reload ReceiverResultReg cheaply."
- 	self assert: (self isNonImmediate: anOop).
- 	self assert: (self oop: anOop isGreaterThanOrEqualTo: oldSpaceStart).
- 	self assert: (self isRemembered: anOop) not.
- 	scavenger remember: anOop.
- 	self setIsRememberedOf: anOop to: true.
- 	^anOop!

Item was changed:
  ----- Method: SpurGenerationScavenger>>copyToOldSpace: (in category 'scavenger') -----
  copyToOldSpace: survivor
  	"Copy survivor to oldSpace.  Answer the new oop of the object."
  	<inline: true>
  	| nTenures numSlots hash newOop |
  	nTenures := statTenures.
  	self flag: 'why not just pass header??'.
  	numSlots := manager numSlotsOf: survivor.
  	hash := manager rawHashBitsOf: survivor.
  	newOop := manager
  					allocateSlotsInOldSpace: numSlots
  					format: (manager formatOf: survivor)
  					classIndex: (manager classIndexOf: survivor).
  	newOop ifNil:
  		[manager growOldSpaceByAtLeast: 0. "grow by growHeadroom"
  		 newOop := manager
  					allocateSlotsInOldSpace: numSlots
  					format: (manager formatOf: survivor)
  					classIndex: (manager classIndexOf: survivor).
  		 newOop ifNil:
  			[self error: 'out of memory']].
  	manager
  		mem: (newOop + manager baseHeaderSize) asVoidPointer
  		cp: (survivor + manager baseHeaderSize) asVoidPointer
  		y: numSlots * manager wordSize.
  	(manager hasPointerFields: survivor) ifTrue:
+ 		[self remember: newOop].
- 		[self remember: newOop.
- 		 manager setIsRememberedOf: newOop to: true].
  	hash ~= 0 ifTrue:
  		[manager setHashBitsOf: newOop to: hash].
  	statTenures := nTenures + 1.
  	^newOop!

Item was changed:
  ----- Method: SpurGenerationScavenger>>copyToOldSpace:bytes: (in category 'scavenger') -----
  copyToOldSpace: survivor bytes: bytesInObject
  	"Copy survivor to oldSpace.  Answer the new oop of the object."
  	<inline: true>
  	| nTenures startOfSurvivor newStart newOop |
  	nTenures := statTenures.
  	startOfSurvivor := manager startOfObject: survivor.
  	newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
  	newStart ifNil:
  		[manager growOldSpaceByAtLeast: 0. "grow by growHeadroom"
  		 newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
  		 newStart ifNil:
  			[self error: 'out of memory']].
  	manager checkFreeSpace.
  	manager mem: newStart asVoidPointer cp: startOfSurvivor asVoidPointer y: bytesInObject.
  	newOop := newStart + (survivor - startOfSurvivor).
  	(manager hasPointerFields: survivor) ifTrue:
+ 		[self remember: newOop].
- 		[self remember: newOop.
- 		 manager setIsRememberedOf: newOop to: true].
  	statTenures := nTenures + 1.
  	^newOop!

Item was changed:
  ----- Method: SpurGenerationScavenger>>copyToOldSpace:bytes:format: (in category 'scavenger') -----
  copyToOldSpace: survivor bytes: bytesInObject format: formatOfSurvivor
  	"Copy survivor to oldSpace.  Answer the new oop of the object."
  	<inline: true>
  	| nTenures startOfSurvivor newStart newOop |
  	self assert: (formatOfSurvivor = (manager formatOf: survivor)
  				and: [((manager isMarked: survivor) not or: [tenureCriterion = MarkOnTenure])
  				and: [(manager isPinned: survivor) not
  				and: [(manager isRemembered: survivor) not]]]).
  	nTenures := statTenures.
  	startOfSurvivor := manager startOfObject: survivor.
  	newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
  	newStart ifNil:
  		[manager growOldSpaceByAtLeast: 0. "grow by growHeadroom"
  		 newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
  		 newStart ifNil:
  			[self error: 'out of memory']].
  	"manager checkFreeSpace."
  	manager mem: newStart asVoidPointer cp: startOfSurvivor asVoidPointer y: bytesInObject.
  	newOop := newStart + (survivor - startOfSurvivor).
  	(manager isAnyPointerFormat: formatOfSurvivor) ifTrue:
+ 		[self remember: newOop].
- 		[self remember: newOop.
- 		 manager setIsRememberedOf: newOop to: true].
  	tenureCriterion = MarkOnTenure ifTrue:
  		[manager setIsMarkedOf: newOop to: true].
  	statTenures := nTenures + 1.
  	^newOop!

Item was changed:
  ----- Method: SpurGenerationScavenger>>processWeaklings (in category 'weakness and ephemerality') -----
  processWeaklings
  	"Go through the remembered set and the weak list, nilling references to
  	 any objects that didn't survive the scavenge. Read the class comment
  	 for a more in-depth description of the algorithm."
  	<inline: false>
  	| i rootObj weakCorpse weakObj |
  	self assert: self allWeakSurvivorsOnWeakList.
  	i := 0.
  	[i < rememberedSetSize] whileTrue:
  		[rootObj := rememberedSet at: i.
  		(manager isWeakNonImm: rootObj)
  			ifTrue:
  				["If no more referents, remove by overwriting with the last element in the set."
  				 (self processWeakSurvivor: rootObj)
  					ifFalse:
  						[manager setIsRememberedOf: rootObj to: false.
  						 i + 1 < rememberedSetSize ifTrue:
  							[rememberedSet at: i put: (rememberedSet at: rememberedSetSize - 1)].
  						 rememberedSetSize := rememberedSetSize - 1]
  					ifTrue: [i := i + 1]]
  			ifFalse: [i := i + 1]].
  	weakList ifNotNil:
  		[weakCorpse := self firstCorpse: weakList.
  		 [weakCorpse notNil] whileTrue:
  			[self assert: (manager isForwarded: weakCorpse).
  			 weakObj := manager followForwarded: weakCorpse.
  			 "weakObj may have been tenured..."
  			 ((self processWeakSurvivor: weakObj)
  			  and: [manager isOldObject: weakObj]) ifTrue:
+ 				[self remember: weakObj].
- 				[self remember: weakObj.
- 				 manager setIsRememberedOf: weakObj to: true].
  			 weakCorpse := self nextCorpseOrNil: weakCorpse].
  		weakList := nil]!

Item was changed:
  ----- Method: SpurGenerationScavenger>>remember: (in category 'store check') -----
  remember: objOop
+ 	"Add the argument to the remembered set and set its isRemembered bit to true.
+ 	 Answer the argument for the benefit of the Cogit."
+ 	<api>
  	<inline: false>
+ 	self assert: (manager isNonImmediate: objOop).
+ 	self assert: (manager isYoungObject: objOop) not.
+ 	self assert: (manager isRemembered: objOop) not.
+ 	manager setIsRememberedOf: objOop to: true.
- 	self assert: (manager isYoung: objOop) not.
  	rememberedSetSize < RememberedSetLimit
  		ifTrue:
  			[rememberedSet at: rememberedSetSize put: objOop.
  			 (rememberedSetSize := rememberedSetSize + 1) >= RememberedSetRedZone ifTrue:
  				[manager scheduleScavenge]]
  		ifFalse:
+ 			[self error: 'remembered set overflow' "for now"].
+ 	^objOop!
- 			[self error: 'remembered set overflow' "for now"]!

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was changed:
  ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	self declareCAsOop: #(	memory freeStart scavengeThreshold newSpaceStart newSpaceLimit pastSpaceStart
  							lowSpaceThreshold freeOldSpaceStart oldSpaceStart endOfMemory firstFreeChunk lastFreeChunk)
  		in: aCCodeGenerator.
  	self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #freeListsMask type: #usqInt;
  		var: #freeLists type: #'sqInt *';
  		var: #classTableBitmap type: #'unsigned char *';
  		var: #objStackInvalidBecause type: #'char *';
  		var: #highestObjects type: #SpurCircularBuffer;
  		var: #unscannedEphemerons type: #SpurContiguousObjStack;
  		var: #heapGrowthToSizeGCRatio type: #float;
  		var: #heapSizeAtPreviousGC type: #usqInt;
  		var: #totalFreeOldSpace type: #usqInt.
  	aCCodeGenerator
  		var: #remapBuffer
  		declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #extraRoots
+ 		declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'!
- 		declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.
- 	GatherForwardingStatistics ifFalse:
- 		[self instVarNames do: [:iv| (iv beginsWith: 'statFollow') ifTrue: [aCCodeGenerator removeVariable: iv]]]!

Item was changed:
  ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
  initialize
  	"SpurMemoryManager initialize"
  	BitsPerByte := 8.
  
- 	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 followForwardedObjectFields: array2 toDepth: 0.
- 			[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 followSpecialObjectsOop.
+ 	self postBecomeOrCompactScanClassTable: becomeEffectsFlags.
  	coInterpreter postBecomeAction: becomeEffectsFlags.
  	becomeEffectsFlags := 0.
  
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
  
  	^PrimNoErr "success"!

Item was changed:
  ----- Method: SpurMemoryManager>>clone: (in category 'allocation') -----
  clone: objOop
  	| numSlots fmt newObj |
  	numSlots := self numSlotsOf: objOop.
  	fmt := self formatOf: objOop.
  	numSlots > self maxSlotsForNewSpaceAlloc
  		ifTrue:
  			[newObj := self allocateSlotsInOldSpace: numSlots
  							format: fmt
  							classIndex: (self classIndexOf: objOop)]
  		ifFalse:
  			[newObj := self allocateSlots: numSlots
  							format: fmt
  							classIndex: (self classIndexOf: objOop)].
  	newObj ifNil:
  		[^0].
  	(self isPointersFormat: fmt)
  		ifTrue:
  			[| hasYoung |
  			 hasYoung := false.
  			 0 to: numSlots - 1 do:
  				[:i| | oop |
  				oop := self fetchPointer: i ofObject: objOop.
  				(self isNonImmediate: oop) ifTrue:
  					[(self isForwarded: oop) ifTrue:
  						[oop := self followForwarded: oop].
  					((self isNonImmediate: oop)
  					 and: [self isYoungObject: oop]) ifTrue:
  						[hasYoung := true]].
  				self storePointerUnchecked: i
  					ofObject: newObj
  					withValue: oop].
  			(hasYoung
  			 and: [(self isYoungObject: newObj) not]) ifTrue:
+ 				[scavenger remember: newObj]]
- 				[scavenger remember: newObj.
- 				 self setIsRememberedOf: newObj to: true]]
  		ifFalse:
  			[0 to: numSlots - 1 do:
  				[:i|
  				self storePointerUnchecked: i
  					ofObject: newObj
  					withValue: (self fetchPointer: i ofObject: objOop)].
+ 			 fmt >= self firstCompiledMethodFormat ifTrue:
+ 				[coInterpreter maybeFixClonedCompiledMethod: newObj.
+ 				 ((self isOldObject: newObj)
+ 				  and: [(self isYoungObject: objOop) or: [self isRemembered: objOop]]) ifTrue:
+ 					[scavenger remember: newObj]]].
- 			"N.B. primitiveClone takes care of making sure the method's header is correct"
- 			 (fmt >= self firstCompiledMethodFormat
- 			  and: [(self isOldObject: newObj)
- 			  and: [(self isYoungObject: objOop) or: [self isRemembered: objOop]]]) ifTrue:
- 				[scavenger remember: newObj.
- 				 self setIsRememberedOf: newObj to: true]].
  	^newObj!

Item was changed:
  ----- Method: SpurMemoryManager>>cloneInOldSpaceForPinning: (in category 'allocation') -----
  cloneInOldSpaceForPinning: objOop
+ 	| numSlots fmt newObj |
- 	| numSlots newObj |
  	numSlots := self numSlotsOf: objOop.
+ 	fmt := self formatOf: objOop.
  	
  	newObj := self allocateSlotsForPinningInOldSpace: numSlots
  					bytes: (self objectBytesForSlots: numSlots)
+ 					format: fmt
- 					format: (self formatOf: objOop)
  					classIndex: (self classIndexOf: objOop).
+ 	(self isPointersFormat: fmt)
- 	(self isPointersNonImm: objOop)
  		ifTrue:
  			[| hasYoung |
  			 hasYoung := false.
  			 0 to: numSlots - 1 do:
  				[:i| | oop |
  				oop := self fetchPointer: i ofObject: objOop.
  				((self isNonImmediate: oop)
  				 and: [self isForwarded: oop]) ifTrue:
  					[oop := self followForwarded: oop].
  				((self isNonImmediate: oop)
  				 and: [self isYoungObject: oop]) ifTrue:
  					[hasYoung := true].
  				self storePointerUnchecked: i
  					ofObject: newObj
  					withValue: oop].
  			(hasYoung
  			 and: [(self isYoungObject: newObj) not]) ifTrue:
+ 				[scavenger remember: newObj]]
- 				[scavenger remember: newObj.
- 				 self setIsRememberedOf: newObj to: true]]
  		ifFalse:
  			[0 to: numSlots - 1 do:
  				[:i|
  				self storePointerUnchecked: i
  					ofObject: newObj
+ 					withValue: (self fetchPointer: i ofObject: objOop)].
+ 			 fmt >= self firstCompiledMethodFormat ifTrue:
+ 				[coInterpreter maybeFixClonedCompiledMethod: newObj.
+ 				 ((self isOldObject: newObj)
+ 				  and: [(self isYoungObject: objOop) or: [self isRemembered: objOop]]) ifTrue:
+ 					[scavenger remember: newObj]]].
- 					withValue: (self fetchPointer: i ofObject: objOop)]].
  	^newObj!

Item was changed:
  ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
  followForwardedObjectFields: objOop toDepth: depth
  	"Follow pointers in the object to depth.
  	 Answer if any forwarders were found.
  	 How to avoid cyclic structures?? A temproary mark bit?"
  	<api>
+ 	<inline: false>
  	| oop found |
  	found := false.
  	self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
  	0 to: (self numPointerSlotsOf: objOop) - 1 do:
  		[:i|
  		 oop := self fetchPointer: i ofObject: objOop.
  		 (self isNonImmediate: oop) ifTrue:
  			[(self isForwarded: oop) ifTrue:
  				[found := true.
  				 oop := self followForwarded: oop.
  				 self storePointer: i ofObject: objOop withValue: oop].
  			(depth > 0
  			 and: [(self hasPointerFields: oop)
  			 and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
  				[found := true]]].
  	^found!

Item was changed:
  ----- Method: SpurMemoryManager>>followSpecialObjectsOop (in category 'become implementation') -----
  followSpecialObjectsOop
- 	self forwardingCount: [statFollowSpecialObjects := statFollowSpecialObjects + 1].
  	(self isForwarded: specialObjectsOop) ifTrue:
  		[specialObjectsOop := self followForwarded: specialObjectsOop].
  	self followForwardedObjectFields: specialObjectsOop toDepth: 0.!

Item was removed:
- ----- Method: SpurMemoryManager>>forwardingCount: (in category 'forwarding') -----
- forwardingCount: aBlock
- 	"Hook for turning on and off statistics gathering on forwarding"
- 	<inline: true>
- 	GatherForwardingStatistics ifTrue: [aBlock value]!

Item was removed:
- ----- Method: SpurMemoryManager>>forwardingStatsWith:with:with:with:with:with: (in category 'primitive support') -----
- forwardingStatsWith: statFollowCurrentMethodArg with: statFollowForPrimFailArg with: statFollowForSelectorFaultArg with: statFollowForSendFaultArg with: statFollowForSignalArg with: statFollowForSpecialSelectorArg
- 	<option: #GatherForwardingStatistics>
- 	| stats name |
- 	stats := self allocateSlots: 20 format: self arrayFormat classIndex: ClassArrayCompactIndex.
- 	stats ifNil: [^nil].
- 	name := self stringForCString: 'statFollowCurrentMethod'.
- 	name ifNil: [^nil].
- 	self storePointer: 0 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 1 ofObject: stats withValue: (self integerObjectOf: statFollowCurrentMethodArg).
- 	name := self stringForCString: 'statFollowForBecome'.
- 	name ifNil: [^nil].
- 	self storePointer: 2 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 3 ofObject: stats withValue: (self integerObjectOf: statFollowForBecome).
- 	name := self stringForCString: 'statFollowForClassTable'.
- 	name ifNil: [^nil].
- 	self storePointer: 4 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 5 ofObject: stats withValue: (self integerObjectOf: statFollowForClassTable).
- 	name := self stringForCString: 'statFollowForJIT'.
- 	name ifNil: [^nil].
- 	self storePointer: 6 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 7 ofObject: stats withValue: (self integerObjectOf: statFollowForJIT).
- 	name := self stringForCString: 'statFollowForPrimFail'.
- 	name ifNil: [^nil].
- 	self storePointer: 8 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 9 ofObject: stats withValue: (self integerObjectOf: statFollowForPrimFailArg).
- 	name := self stringForCString: 'statFollowForSelectorFault'.
- 	name ifNil: [^nil].
- 	self storePointer: 10 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 11 ofObject: stats withValue: (self integerObjectOf: statFollowForSelectorFaultArg).
- 	name := self stringForCString: 'statFollowForSendFault'.
- 	name ifNil: [^nil].
- 	self storePointer: 12 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 13 ofObject: stats withValue: (self integerObjectOf: statFollowForSendFaultArg).
- 	name := self stringForCString: 'statFollowForSignal'.
- 	name ifNil: [^nil].
- 	self storePointer: 14 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 15 ofObject: stats withValue: (self integerObjectOf: statFollowForSignalArg).
- 	name := self stringForCString: 'statFollowForSpecialSelector'.
- 	name ifNil: [^nil].
- 	self storePointer: 16 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 17 ofObject: stats withValue: (self integerObjectOf: statFollowForSpecialSelectorArg).
- 	name := self stringForCString: 'statFollowSpecialObjects'.
- 	name ifNil: [^nil].
- 	self storePointer: 18 ofObject: stats withValue: name.
- 	self storePointerUnchecked: 19 ofObject: stats withValue: (self integerObjectOf: statFollowSpecialObjects).
- 	^stats!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	"We can put all initializations that set something to 0 or to false here.
  	 In C all global variables are initialized to 0, and 0 is false."
  	remapBuffer := Array new: RemapBufferSize.
  	remapBufferCount := extraRootCount := 0. "see below"
  	freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
  	checkForLeaks := 0.
  	needGCFlag := signalLowSpace := scavengeInProgress := marking := false.
  	becomeEffectsFlags := 0.
  	statScavenges := statIncrGCs := statFullGCs := 0.
  	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
  	statGrowMemory := statShrinkMemory := statRootTableCount := statSurvivorCount := 0.
  	statRootTableOverflows := statMarkCount := statSpecialMarkCount := statCompactPassCount := statCoalesces := 0.
- 	statFollowForJIT := statFollowForBecome := statFollowForClassTable := statFollowSpecialObjects := 0.
  
  	"We can initialize things that are allocated but are lazily initialized."
  	unscannedEphemerons := SpurContiguousObjStack new.
  
  	"we can initialize things that are virtual in C."
  	scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
  	segmentManager := SpurSegmentManager new manager: self; yourself.
  
  	"We can also initialize here anything that is only for simulation."
  	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
  
  	"N.B. We *don't* initialize extraRoots because we don't simulate it."!

Item was changed:
  ----- Method: SpurMemoryManager>>possibleRootStoreInto: (in category 'store check') -----
  possibleRootStoreInto: destObj
+ 	<inline: true>
- 	<inline: false>
  	(self isRemembered: destObj) ifFalse:
+ 		[scavenger remember: destObj]!
- 		[scavenger remember: destObj.
- 		 self setIsRememberedOf: destObj to: true]!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
+ 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals'
- 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals statFollowCurrentMethod statFollowForSendFault statFollowForSignal statFollowForPrimFail statFollowForSelectorFault statFollowForSpecialSelector'
  	classVariableNames: 'AltBytecodeEncoderClassName AltLongStoreBytecode AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached'
  	poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter commentStamp: 'eem 9/11/2013 18:30' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.  This VM supports Closures but *not* old-style BlockContexts.
  
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
  
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
  
  In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
  
  NOTE:  Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
  
  1.  There are a number of things that should be done the next time we plan to release a completely incompatible image format.  These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:.  Also, contexts should be given a special format code (see next item).
  
  2.  There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change.  This is necessary because the oops may change during a compaction when the oops are being adjusted.  It's important to be aware of this when writing a new image using the SystemTracer.  A better solution would be to reserve one of the format codes for Contexts only.  An even better solution is to eliminate compact classes altogether (see 6.).
  
  3.  We have made normal files tolerant to size and positions up to 32 bits.  This has not been done for async files, since they are still experimental.  The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. [Late news, the support has been extended to 64-bit file sizes].
  
  4.  Note that 0 is used in a couple of places as an impossible oop.  This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment).  The places include the method cache and the at cache.
  
  5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT.  We can still have 31-bit SmallIntegers by allowing two tag patterns for SmallInteger.
  
  6.  If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images.  [Late breaking news, the 2-word header scheme is more compact, by over 2%].  See SpurMemorymanager's class comment.!

Item was changed:
  ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h> /* for e.g. alloca */';
  		addHeaderFile:'<setjmp.h>';
  		addHeaderFile:'"vmCallback.h"';
  		addHeaderFile:'"sqMemoryFence.h"';
  		addHeaderFile:'"dispdbg.h"'.
  	self declareInterpreterVersionIn: aCCodeGenerator
  		defaultName: 'Stack'.
  	aCCodeGenerator
  		var: #interpreterProxy  type: #'struct VirtualMachine*'.
  	aCCodeGenerator
  		declareVar: #sendTrace type: 'volatile int';
  		declareVar: #byteCount type: 'unsigned long'.
  	"These need to be pointers or unsigned."
  	self declareC: #(instructionPointer method newMethod)
  		as: #usqInt
  		in: aCCodeGenerator.
  	"These are all pointers; char * because Slang has no support for C pointer arithmetic."
  	self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit stackMemory)
  		as: #'char *'
  		in: aCCodeGenerator.
  	self declareC: #(stackPage overflowedPage)
  		as: #'StackPage *'
  		in: aCCodeGenerator.
  	aCCodeGenerator removeVariable: 'stackPages'.  "this is an implicit receiver in the translated code."
  	"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
  	 is not defined, for the benefit of the interpreter on slow machines."
  	aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
  	MULTIPLEBYTECODESETS == false ifTrue:
  		[aCCodeGenerator
  			removeVariable: 'extA';
  			removeVariable: 'extB';
  			removeVariable: 'bytecodeSetSelector'].
- 	(self objectMemoryClass classPool at: #GatherForwardingStatistics ifAbsent: [false]) ifFalse:
- 		[self instVarNames do: [:iv| (iv beginsWith: 'statFollow') ifTrue: [aCCodeGenerator removeVariable: iv]]].
  	aCCodeGenerator
  		var: #methodCache
  		declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #atCache
  		declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #primitiveTable
  		declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', self primitiveTableString.
  	self primitiveTable do:
  		[:symbolOrNot|
  		(symbolOrNot isSymbol
  		 and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
  			[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
  				[:tMethod| tMethod returnType: #void]]].
  	self objectMemoryClass hasSpurMemoryManagerAPI
  		ifTrue:
  			[aCCodeGenerator
  				var: #primitiveAccessorDepthTable
  				type: 'signed char'
  				sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
  				array: self primitiveAccessorDepthTable]
  		ifFalse:
  			[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
  	aCCodeGenerator
  		var: #primitiveFunctionPointer
  		declareC: 'void (*primitiveFunctionPointer)()'.
  	aCCodeGenerator
  		var: #externalPrimitiveTable
  		declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
  	aCCodeGenerator var: #showSurfaceFn type: #'void *'.
  	aCCodeGenerator
  		var: #jmpBuf
  		declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedCallbacks
  		declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedMethods
  		declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #interruptCheckChain
  		declareC: 'void (*interruptCheckChain)(void) = 0'.
  	aCCodeGenerator
  		var: #breakSelector type: #'char *';
  		var: #breakSelectorLength
  		declareC: 'sqInt breakSelectorLength = -1'.
  
  	self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
  								longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
  								"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
  								statProcessSwitch statIOProcessEvents statForceInterruptCheck
  								statCheckForEvents statStackOverflow statStackPageDivorce)
  		in: aCCodeGenerator.
  	aCCodeGenerator var: #nextProfileTick type: #sqLong!

Item was changed:
  ----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveStateFor: (in category 'primitive support') -----
  checkForAndFollowForwardedPrimitiveStateFor: primIndex
  	"In Spur a primitive may fail due to encountering a forwarder.
  	 On failure check the accessorDepth for the primitive and
  	 if non-negative scan the args to the depth, following any
  	 forwarders.  Answer if any are found so the prim can be retried."
  	<option: #SpurObjectMemory>
  	| accessorDepth found |
  	self assert: self successful not.
  	found := false.
  	accessorDepth := primitiveAccessorDepthTable at: primIndex.
  	"For the method-executing primitives, failure could have been in those primitives or the
  	 primitives of the methods they execute.  find out which failed by seeing what is in effect."
  	primIndex caseOf: {
  		[117] -> 
  			[primitiveFunctionPointer ~~ #primitiveExternalCall ifTrue:
  				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
  			 self assert: argumentCount = (self argumentCountOf: newMethod)].
  		[118] -> "with tryPrimitive:withArgs: the argument count has nothing to do with newMethod's, so no arg count assert."
  			[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject)].
  		[218] ->
  			[primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs ifTrue:
  				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
  			 self assert: argumentCount = (self argumentCountOf: newMethod)]. }
  		otherwise:
  			["functionPointer should have been set, unless we're in machine code"
  			 instructionPointer > objectMemory nilObject ifTrue:
  				[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject).
  				 self assert: argumentCount = (self argumentCountOf: newMethod)]].
  	accessorDepth >= 0 ifTrue:
  		[0 to: argumentCount do:
  			[:index| | oop |
  			oop := self stackValue: index.
  			(objectMemory isNonImmediate: oop) ifTrue:
  				[(objectMemory isForwarded: oop) ifTrue:
  					[self assert: index < argumentCount. "receiver should have been caught at send time."
  					 found := true.
  					 oop := objectMemory followForwarded: oop.
  					 self stackValue: index put: oop].
  				((objectMemory hasPointerFields: oop)
  				 and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]) ifTrue:
+ 					[found := true]]]].
- 					[objectMemory forwardingCount: [statFollowForPrimFail := statFollowForPrimFail + 1].
- 					 found := true]]]].
  	^found!

Item was changed:
  ----- Method: StackInterpreter>>followForwardedFieldsInCurrentMethod (in category 'message sending') -----
  followForwardedFieldsInCurrentMethod
+ 	<inline: true>
- 	objectMemory forwardingCount: [statFollowCurrentMethod := statFollowCurrentMethod + 1].
  	objectMemory
  		followForwardedObjectFields: method
  		toDepth: 0!

Item was changed:
  ----- Method: StackInterpreter>>handleForwardedSelectorFaultFor: (in category 'message sending') -----
  handleForwardedSelectorFaultFor: selectorOop
  	"Handle a send fault that is due to a send using a forwarded selector.
  	 Unforward the selector and follow the current method and special
  	 selectors array to unforward the source of the forwarded selector."
  	<option: #SpurObjectMemory>
  	<inline: false>
  	self assert: (objectMemory isOopForwarded: selectorOop).
  	self followForwardedFieldsInCurrentMethod.
- 	objectMemory forwardingCount: [statFollowForSelectorFault := statFollowForSelectorFault + 1].
  	objectMemory
  		followForwardedObjectFields: (objectMemory splObj: SpecialSelectors)
  		toDepth: 0.
  	^objectMemory followForwarded: selectorOop!

Item was changed:
  ----- Method: StackInterpreter>>handleForwardedSendFaultForTag: (in category 'message sending') -----
  handleForwardedSendFaultForTag: classTag
  	"Handle a send fault that may be due to a send to a forwarded object.
  	 Unforward the receiver on the stack and answer its actual class."
  	<option: #SpurObjectMemory>
  	| rcvr |
  	<inline: false>
  	self assert: (objectMemory isForwardedClassTag: classTag).
  
  	rcvr := self stackValue: argumentCount.
  	"should *not* be a super send, so the receiver should be forwarded."
  	self assert: (objectMemory isOopForwarded: rcvr).
  	rcvr := objectMemory followForwarded: rcvr.
  	self stackValue: argumentCount put: rcvr.
  	self followForwardedFrameContents: framePointer
  		stackPointer: stackPointer + (argumentCount + 1 * BytesPerWord). "don't repeat effort"
  	(objectMemory isPointers: (self frameReceiver: framePointer)) ifTrue:
+ 		[objectMemory
- 		[objectMemory forwardingCount: [statFollowForSendFault := statFollowForSendFault + 1].
- 		 objectMemory
  			followForwardedObjectFields: (self frameReceiver: framePointer)
  			toDepth: 0].
  	^objectMemory fetchClassTagOf: rcvr!

Item was changed:
  ----- Method: StackInterpreter>>handleSpecialSelectorSendFaultFor:fp:sp: (in category 'message sending') -----
  handleSpecialSelectorSendFaultFor: obj fp: theFP sp: theSP
  	"Handle a special send fault that may be due to a special selector
  	 send accessing a forwarded object.
  	 Unforward the object on the stack and in inst vars and answer its target."
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	self assert: (objectMemory isOopForwarded: obj).
  
  	self followForwardedFrameContents: theFP stackPointer: theSP.
  	(objectMemory isPointers: (self frameReceiver: theFP)) ifTrue:
+ 		[objectMemory
- 		[objectMemory forwardingCount: [statFollowForSpecialSelector := statFollowForSpecialSelector + 1].
- 		 objectMemory
  			followForwardedObjectFields: (self frameReceiver: theFP)
  			toDepth: 0].
  	^objectMemory followForwarded: obj!

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!
- 	statProcessSwitch := statIOProcessEvents := statStackPageDivorce := 0.
- 	statFollowCurrentMethod := statFollowForSendFault := statFollowForSignal :=
- 	statFollowForPrimFail := statFollowForSelectorFault := statFollowForSpecialSelector := 0
- !

Item was added:
+ ----- Method: StackInterpreter>>maybeFixClonedCompiledMethod: (in category 'cog jit support') -----
+ maybeFixClonedCompiledMethod: objOop
+ 	"This is a noop in the Stack VM"
+ 	<inline: true>!

Item was changed:
  ----- Method: StackInterpreter>>synchronousSignal: (in category 'process primitive support') -----
  synchronousSignal: aSemaphore 
  	"Signal the given semaphore from within the interpreter.
  	 Answer if the current process was preempted."
  	| excessSignals |
  	<inline: false>
  	(self isEmptyList: aSemaphore) ifTrue:
  		["no process is waiting on this semaphore"
  		 excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: aSemaphore.
  		 self storeInteger: ExcessSignalsIndex
  			ofObject: aSemaphore
  			withValue: excessSignals + 1.
  		 ^false].
  
  	objectMemory hasSpurMemoryManagerAPI ifTrue:
  		[| firstLink |
  		 firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aSemaphore.
  		 (objectMemory isForwarded: firstLink) ifTrue:
  			["0 = aSemaphore, 1 = aProcess. Hence reference to suspendedContext will /not/ be forwarded."
- 			 objectMemory forwardingCount: [statFollowForSignal := statFollowForSignal + 1].
  			 objectMemory followForwardedObjectFields: aSemaphore toDepth: 1].
  		 self assert: (objectMemory isForwarded: (objectMemory fetchPointer: SuspendedContextIndex ofObject: firstLink)) not].
  
  	^self resume: (self removeFirstLinkOfList: aSemaphore)
  		preemptedYieldingIf: preemptionYields!

Item was removed:
- ----- Method: StackInterpreterPrimitives>>primitiveForwardingStats (in category 'system control primitives') -----
- primitiveForwardingStats
- 	<export: true>
- 	<option: #GatherForwardingStatistics>
- 	| stats |
- 	stats := objectMemory
- 				forwardingStatsWith: statFollowCurrentMethod
- 				with: statFollowForPrimFail
- 				with: statFollowForSelectorFault
- 				with: statFollowForSendFault
- 				with: statFollowForSignal
- 				with: statFollowForSpecialSelector.
- 	stats ifNil:
- 		[^self primitiveFailFor: PrimErrNoMemory].
- 	self methodReturnValue: stats!



More information about the Vm-dev mailing list