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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 17 00:07:21 UTC 2013


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

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

Name: VMMaker.oscog-eem.383
Author: eem
Time: 16 September 2013, 5:04:45.384 pm
UUID: 09738444-85f0-4b23-bf27-4253c31df086
Ancestors: VMMaker.oscog-eem.382

Implement the heap leak check for SpurMemoryManager.
Requires e.g. ennumeration of the remembered set.
Recategorise a few leak map methods to debug support.
Make sure leak map methods are sent to the right receiver.

Fix scavenging of the rememered set in the presence of forwarders.
These are roots referred to from oldSpace objects and can't be
eliminated.

Fill-out sufficientSpaceAfterGC: with stats gathering and interpreter
interaction.

Refactor post-become class scanning and use the method when
entering a class into the class table (to ensure nothing along the
lookup chain is forwarded).

Get rid of the unused twoWay: keyword in the inner become loops.

Make the tests for objects in newSpace more accurate (using e.g. pastSpaceStart instead of pastSpace limit.

Support one-field forwarders in numPointerSlotsOf:.

Have the VM follow the methodClassAssociations of methods to avoid forwarders in the super-send path.

Summat still wrong wit' treadle tho, as first send after t' scavenge falls flat on 't' face, like.

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

Item was changed:
  ----- Method: CoInterpreter>>mapStackPages (in category 'object memory support') -----
  mapStackPages
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #frameRcvrOffset type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
- 	"Need to write back the frame pointers unless all pages are free (as in snapshot)"
- 	stackPage ~= 0 ifTrue:
- 		[self externalWriteBackHeadFramePointers].
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP frameRcvrOffset callerFP theIPPtr 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 := ((self isMachineCodeFrame: theFP)
  									or: [(self iframeSavedIP: theFP) = 0])
  										ifTrue: [0]
  										ifFalse: [theFP + FoxIFSavedIP]]
  				ifFalse:
  					[theIPPtr := theSP.
  					 theSP := theSP + BytesPerWord].
  			[self assert: (thePage addressIsInPage: theFP).
  			 self assert: (thePage addressIsInPage: theSP).
  			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
  			 frameRcvrOffset := self frameReceiverOffset: theFP.
  	 		  [theSP <= frameRcvrOffset] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + BytesPerWord].
  			 ((self frameHasContext: theFP)
  			  and: [objectMemory shouldRemapObj: (self frameContext: theFP)]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory remapObj: (self frameContext: theFP))].
  			(self isMachineCodeFrame: theFP) ifFalse:
  				[(objectMemory shouldRemapObj: (self iframeMethod: theFP)) ifTrue:
  					[theIPPtr ~= 0 ifTrue:
  						[theIP := stackPages longAt: theIPPtr.
  						 theIP = cogit ceReturnToInterpreterPC
  							ifTrue:
  								[self assert: (self iframeSavedIP: theFP) > (self iframeMethod: theFP).
  								 theIPPtr := theFP + FoxIFSavedIP.
  								 theIP := stackPages longAt: theIPPtr]
  							ifFalse:
  								[self assert: theIP > (self iframeMethod: theFP)].
  						 theIP := theIP - (self iframeMethod: theFP)].
  					 stackPages
  						longAt: theFP + FoxMethod
  						put: (objectMemory remapObj: (self iframeMethod: theFP)).
  					 theIPPtr ~= 0 ifTrue:
  						[stackPages longAt: theIPPtr put: theIP + (self iframeMethod: theFP)]]].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + BytesPerWord.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerSavedIP + BytesPerWord.
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + BytesPerWord]]]!

Item was changed:
+ ----- Method: NewCoObjectMemory>>clearLeakMapAndMapAccessibleObjects (in category 'debug support') -----
- ----- Method: NewCoObjectMemory>>clearLeakMapAndMapAccessibleObjects (in category 'object enumeration') -----
  clearLeakMapAndMapAccessibleObjects
  	"Perform an integrity/leak check using the heapMap.  Set a bit at each object's header.
  	 Override to set a bit at each Cog method"
  	super clearLeakMapAndMapAccessibleObjects.
  	cogit addCogMethodsToHeapMap!

Item was changed:
+ ----- Method: NewObjectMemory>>clearLeakMapAndMapAccessibleObjects (in category 'debug support') -----
- ----- Method: NewObjectMemory>>clearLeakMapAndMapAccessibleObjects (in category 'object enumeration') -----
  clearLeakMapAndMapAccessibleObjects
  	"Perform an integrity/leak check using the heapMap.  Set a bit at each object's header."
  	| obj sz nextHeader |
  	<inline: false>
  	<var: #obj type: #usqInt>
  	<var: #sz type: #usqInt>
  	<var: #nextHeader type: #usqInt>
  	heapMap clearHeapMap.
  	obj := self firstObject.
  	[self oop: obj isLessThan: freeStart] whileTrue:
  		[(self isFreeObject: obj)
  			ifTrue:
  				[sz := self sizeOfFree: obj]
  			ifFalse:
  				[heapMap heapMapAtWord: (self pointerForOop: obj) Put: 1.
  				 sz := self sizeBitsOf: obj].
  		nextHeader := obj + sz.
  		obj := self oopFromChunk: nextHeader].!

Item was changed:
  ----- Method: NewObjectMemory>>incrementalGC (in category 'garbage collection') -----
  incrementalGC
  	"Do a mark/sweep garbage collection of just the young object
  	area of object memory (i.e., objects above youngStart), using
  	the root table to identify objects containing pointers to
  	young objects from the old object area."
  	| survivorCount weDidGrow |
  	<inline: false>
  
  	rootTableOverflowed ifTrue:
  		["root table overflow; cannot do an incremental GC because some roots are missing.
  		 (this should be very rare)"
  		 statRootTableOverflows := statRootTableOverflows + 1.
  		 ^self fullGC].
  	self runLeakCheckerForFullGC: false.
+ 	coInterpreter preGCAction: GCModeIncr.
- 	self preGCAction: GCModeIncr.
  	needGCFlag := false.
  	gcStartUsecs := self ioUTCMicrosecondsNow.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self initWeakTableForIncrementalGC: true.
  	"implicitly process memory from youngStart to freeStart"
  	self markPhase: false.
  	self assert: weakRootCount <= WeakRootTableSize.
  	1 to: weakRootCount do:
  		[:i| self finalizeReference: (weakRoots at: i)].
  	survivorCount := self sweepPhase.
  	self runLeakCheckerForFullGC: false.
  	self incrementalCompaction.
  	statIncrGCs := statIncrGCs + 1.
  	statGCEndUsecs := self ioUTCMicrosecondsNow.
  	statIGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
  	statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
  	self capturePendingFinalizationSignals.
  	
  	statRootTableCount  := rootTableCount.
  	statSurvivorCount := survivorCount.
  	weDidGrow := false.
  	(((survivorCount > tenuringThreshold)
  	 or: [rootTableCount >= RootTableRedZone])
  	 or: [forceTenureFlag == true]) ifTrue:
  		["move up the young space boundary if
  		  * there are too many survivors:
  			this limits the number of objects that must be
  			processed on future incremental GC's
  		  * we're about to overflow the roots table:
  			this limits the number of full GCs that may be caused
  			by root table overflows in the near future"
  		forceTenureFlag := false.
  		statTenures := statTenures + 1.
  		self clearRootsTable.
  		((self freeSize < growHeadroom)
  		 and: [gcBiasToGrow > 0]) ifTrue:
  			[self biasToGrow.
  			 weDidGrow := true].
  		youngStart := freeStart].
+ 	coInterpreter postGCAction.
- 	self postGCAction.
  	
  	self runLeakCheckerForFullGC: false.
  	weDidGrow ifTrue:
  		[self biasToGrowCheckGCLimit]!

Item was changed:
+ ----- Method: NewObjectMemory>>runLeakCheckerForFullGC: (in category 'debug support') -----
- ----- Method: NewObjectMemory>>runLeakCheckerForFullGC: (in category 'garbage collection') -----
  runLeakCheckerForFullGC: fullGCFlag
  	<inline: false>
  	(fullGCFlag
  			ifTrue: [self leakCheckFullGC]
  			ifFalse: [self leakCheckIncrementalGC]) ifTrue:
  		[fullGCFlag
+ 			ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
+ 			ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
- 			ifTrue: [self reverseDisplayFrom: 0 to: 7]
- 			ifFalse: [self reverseDisplayFrom: 8 to: 15].
  		 self clearLeakMapAndMapAccessibleObjects.
  		 self assert: self checkHeapIntegrity.
+ 		 self assert: coInterpreter checkInterpreterIntegrity.
+ 		 self assert: coInterpreter checkStackIntegrity.
+ 		 self assert: (coInterpreter checkCodeIntegrity: fullGCFlag).
- 		 self assert: self checkInterpreterIntegrity.
- 		 self assert: self checkStackIntegrity.
- 		 self assert: (self checkCodeIntegrity: fullGCFlag).
  		 self validate "simulation only"]!

Item was changed:
+ ----- Method: ObjectMemory>>checkOopIntegrity:named: (in category 'debug support') -----
- ----- Method: ObjectMemory>>checkOopIntegrity:named: (in category 'memory access') -----
  checkOopIntegrity: obj named: name
  	<inline: false>
  	<var: #name type: #'char *'>
  	(self heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
  		[^true].
  	self print: name; print: ' leak '; printHex: obj; cr.
  	^false!

Item was changed:
+ ----- Method: ObjectMemory>>checkOopIntegrity:named:index: (in category 'debug support') -----
- ----- Method: ObjectMemory>>checkOopIntegrity:named:index: (in category 'memory access') -----
  checkOopIntegrity: obj named: name index: i
  	<inline: false>
  	<var: #name type: #'char *'>
  	(self heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
  		[^true].
  	self print: name; print: ' leak @ '; printNum: i; print: ' = '; printHex: obj; cr.
  	^false!

Item was changed:
+ ----- Method: ObjectMemory>>clearLeakMapAndMapAccessibleObjects (in category 'debug support') -----
- ----- Method: ObjectMemory>>clearLeakMapAndMapAccessibleObjects (in category 'memory access') -----
  clearLeakMapAndMapAccessibleObjects
  	"Perform an integrity/leak check using the heapMap.  Set a bit at each object's header."
  	| oop |
  	<inline: false>
  	self clearHeapMap.
  	oop := self firstObject.
  	[oop = nil] whileFalse:
  		[self heapMapAtWord: (self pointerForOop: oop) Put: 1.
  		 oop := self accessibleObjectAfter: oop]!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>become:with:twoWay:copyHash: (in category 'become api') -----
+ become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
+ 
+ 	"(thisContext findContextSuchThat: [:c| c selector == #rehashImage]) ifNotNil:
+ 		[:ctxt|
+ 		(((ctxt tempAt: 4) at: 1) = 108
+ 		 and: [(ctxt tempAt: 2) byteCount = 553985]) ifTrue: [self halt]]."
+ 	^super become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>eek (in category 'debug support') -----
+ eek
+ 	self halt!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>checkHeapIntegrity (in category 'debug support') -----
+ checkHeapIntegrity
+ 	"Perform an integrity/leak check using the heapMap.  Assume
+ 	 clearLeakMapAndMapAccessibleObjects has set a bit at each
+ 	 object's header.  Scan all objects in the heap checking that every
+ 	 pointer points to a header.  Scan the rootTable, remapBuffer and
+ 	 extraRootTable checking that every entry is a pointer to a header.
+ 	 Check that the number of roots is correct and that all rootTable
+ 	 entries have their rootBit set. Answer if all checks pass."
+ 	| ok numRememberedRootsInHeap |
+ 	<inline: false>
+ 	ok := true.
+ 	numRememberedRootsInHeap := 0.
+ 	self allObjectsDo:
+ 		[:obj| | fieldOop classIndex classOop |
+ 		(self isFreeObject: obj) ifFalse:
+ 			[(self isRemembered: obj) ifTrue:
+ 				[numRememberedRootsInHeap := numRememberedRootsInHeap + 1].
+ 			 (self isForwarded: obj)
+ 				ifTrue:
+ 					[fieldOop := self fetchPointer: 0 ofForwardedOrFreeObject: obj.
+ 					 (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ 						[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
+ 						 self eek.
+ 						 ok := false]]
+ 				ifFalse:
+ 					[classOop := self classAtIndex: (classIndex := self classIndexOf: obj).
+ 					 (classOop isNil or: [classOop = nilObj]) ifTrue:
+ 						[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; printHex: classOop; cr.
+ 						 self eek.
+ 						 ok := false].
+ 					 0 to: (self lastPointerOf: obj) by: BytesPerOop do:
+ 						[:ptr|
+ 						 fieldOop := self longAt: ptr.
+ 						 (self isNonImmediate: fieldOop) ifTrue:
+ 							[| fi |
+ 							 fi := ptr - (obj + self baseHeaderSize).
+ 							 (fieldOop bitAnd: self wordSize - 1) ~= 0
+ 								ifTrue:
+ 									[coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ 									 self eek.
+ 									 ok := false]
+ 								ifFalse:
+ 									[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ 										[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ 										 self eek.
+ 										 ok := false]]]]]]].
+ 	numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
+ 		[coInterpreter
+ 			print: 'root count mismatch. #heap roots ';
+ 			printNum: numRememberedRootsInHeap;
+ 			print: '; #roots ';
+ 			printNum: scavenger rememberedSetSize;
+ 			cr.
+ 		"But the system copes with overflow..."
+ 		self flag: 'no support for remembered set overflow yet'.
+ 		"ok := rootTableOverflowed and: [needGCFlag]"].
+ 	scavenger rememberedSetWithIndexDo:
+ 		[:obj :i|
+ 		(obj bitAnd: self wordSize - 1) ~= 0
+ 			ifTrue:
+ 				[coInterpreter print: 'misaligned oop in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ 				 self eek.
+ 				 ok := false]
+ 			ifFalse:
+ 				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
+ 					ifTrue:
+ 						[coInterpreter print: 'object leak in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ 						 self eek.
+ 						 ok := false]
+ 					ifFalse:
+ 						[(self isYoung: obj) ifTrue:
+ 							[coInterpreter print: 'non-root in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ 							 self eek.
+ 							 ok := false]]]].
+ 	self flag: 'no support for remap buffer yet'.
+ 	"1 to: remapBufferCount do:
+ 		[:ri|
+ 		obj := remapBuffer at: ri.
+ 		(obj bitAnd: self wordSize - 1) ~= 0
+ 			ifTrue:
+ 				[coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
+ 				 self eek.
+ 				 ok := false]
+ 			ifFalse:
+ 				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
+ 					ifTrue:
+ 						[coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
+ 						 self eek.
+ 						 ok := false]]]."
+ 	self flag: 'no support for extraRoots yet'.
+ 	"1 to: extraRootCount do:
+ 		[:ri|
+ 		obj := (extraRoots at: ri) at: 0.
+ 		(obj bitAnd: self wordSize - 1) ~= 0
+ 			ifTrue:
+ 				[coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
+ 				 self eek.
+ 				 ok := false]
+ 			ifFalse:
+ 				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
+ 					ifTrue:
+ 						[coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
+ 						 self eek.
+ 						 ok := false]]]."
+ 	^ok!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>fetchPointer:ofMaybeForwardedObject: (in category 'heap management') -----
+ fetchPointer: fieldIndex ofMaybeForwardedObject: objOop
+ 	^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>printMemoryFrom:to: (in category 'debug printing') -----
+ printMemoryFrom: start to: end
+ 	<doNotGenerate>
+ 	| address |
+ 	address := start bitAnd: (BytesPerWord - 1) bitInvert.
+ 	[address < end] whileTrue:
+ 		[coInterpreter printHex: address; printChar: $:; space; printHex: (self longAt: address); cr.
+ 		 address := address + BytesPerWord]!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>storePointer:ofForwardedOrFreeObject:withValue: (in category 'heap management') -----
  storePointer: fieldIndex ofForwardedOrFreeObject: objOop withValue: valuePointer
  
+ 	(self isForwarded: objOop) ifTrue:
+ 		[(self isYoung: objOop) ifFalse: "most stores into young objects"
+ 			[((self isNonImmediate: valuePointer) and: [self isYoung: valuePointer]) ifTrue:
+ 				[self possibleRootStoreInto: objOop value: valuePointer]]].
+ 
  	^self
  		longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
  		put: valuePointer!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>storePointerUnchecked:ofMaybeForwardedObject:withValue: (in category 'object access') -----
+ storePointerUnchecked: fieldIndex ofMaybeForwardedObject: objOop withValue: valuePointer
+ 	^self
+ 		longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ 		put: valuePointer!

Item was added:
+ ----- Method: SpurGenerationScavenger>>futureSurvivorStart (in category 'accessing') -----
+ futureSurvivorStart
+ 	^futureSurvivorStart!

Item was changed:
  ----- Method: SpurGenerationScavenger>>initFutureSpaceStart (in category 'initialization') -----
  initFutureSpaceStart
+ 	| oldStart |
+ 	oldStart := futureSurvivorStart.
+ 	futureSurvivorStart := futureSpace start.
+ 	^oldStart!
- 	futureSurvivorStart := futureSpace start!

Item was added:
+ ----- Method: SpurGenerationScavenger>>rememberedSetSize (in category 'accessing') -----
+ rememberedSetSize
+ 	^rememberedSetSize!

Item was added:
+ ----- Method: SpurGenerationScavenger>>rememberedSetWithIndexDo: (in category 'debug support') -----
+ rememberedSetWithIndexDo: aBlock
+ 	0 to: rememberedSetSize - 1 do:
+ 		[:i| aBlock value: (rememberedSet at: i) value: i]!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavenge (in category 'scavenger') -----
  scavenge
  	"The main routine, scavenge, scavenges young objects reachable from the roots (the stack zone
  	 and the rememberedTable).  It first scavenges the new objects immediately reachable from the
  	 stack zone, then those directly from old ones (all in the remembered table).  Then it scavenges
  	 those that are transitively reachable.  If this results in a promotion, the promotee gets remembered,
  	 and it first scavenges objects adjacent to the promotee, then scavenges the ones reachable from
  	 the promoted.  This loop continues until no more reachable objects are left.  At that point,
  	 pastSurvivorSpace is exchanged with futureSurvivorSpace.
  
  	 Notice that each pointer in a live object is inspected once and only once.  The previousRememberedSetSize
  	 and previousFutureSurvivorSpaceSize variables ensure that no object is scanned twice, as well as
+ 	 detecting closure.  If this were not true, some pointers might get forwarded twice.
- 	 detecting closure.  If this were not true, some pointers might get forwarded twice."
  
+ 	 Answer the limit of pastSpace, to allow the memory manager to bounds check survivors."
+ 
  	self scavengeLoop.
  	self computeTenuringThreshold.
  	self exchangeSurvivorSpaces.
+ 	^self initFutureSpaceStart!
- 	self initFutureSpaceStart!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeReferentsOf: (in category 'scavenger') -----
  scavengeReferentsOf: referrer
  	"scavengeReferentsOf: referrer inspects all the pointers in referrer.
  	 If any are new objects, it has them moved to FutureSurvivorSpace,
  	 and answers truth. If there are no new referents, it answers falsity."
  	| foundNewReferent |
+ 	"forwarding objects should be followed by callers,
+ 	 unless the forwarder is a root in the remembered table."
+ 	self assert: ((manager isForwarded: referrer) not
+ 				or: [manager isRemembered: referrer]).
- 	"callers follow forwarding pointers from become:"
- 	self assert: (manager isForwarded: referrer) not.
- 	"manager isPointersNonImm: referrer) ifFalse:
- 		[^false]."
  	foundNewReferent := false.
  	0 to: (manager numPointerSlotsOf: referrer) - 1 do:
  		[:i| | referent newLocation |
+ 		referent := manager fetchPointer: i ofMaybeForwardedObject: referrer.
- 		referent := manager fetchPointer: i ofObject: referrer.
  		(manager isNonImmediate: referent) ifTrue:
+ 			["a forwarding pointer could be because of become: or scavenging."
+ 			 referent := (manager isForwarded: referent)
+ 								ifTrue: [manager followForwarded: referent]
+ 								ifFalse: [referent].
+ 			 (manager isYoung: referent)
- 			[(manager isYoung: referent)
  				ifTrue:
  					[foundNewReferent := true.
+ 					 "if target is already in future space forwarding pointer was due to a become:."
+ 					 (manager isInFutureSpace: referent)
+ 						ifTrue: [newLocation := referent]
+ 						ifFalse:
+ 							[(manager isForwarded: referent)
+ 								ifTrue: [self halt. "can this even happen?"
+ 									newLocation := manager followForwarded: referent]
+ 								ifFalse: [newLocation := self copyAndForward: referent]].
+ 					 manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: newLocation]
- 					 (manager isForwarded: referent)
- 						ifTrue: [newLocation := manager followForwarded: referent]
- 						ifFalse: [newLocation := self copyAndForward: referent].
- 					 manager storePointerUnchecked: i ofObject: referrer withValue: newLocation]
  				ifFalse:
+ 					[manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: referent]]].
- 					[(manager isForwarded: referent) ifTrue:
- 						[newLocation := manager followForwarded: referent.
- 						 manager storePointerUnchecked: i ofObject: referrer withValue: newLocation]]]].
  	^foundNewReferent!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeRememberedSetStartingAt: (in category 'scavenger') -----
  scavengeRememberedSetStartingAt: n
  	"scavengeRememberedSetStartingAt: n traverses objects in the remembered
  	 set starting at the nth one.  If the object does not refer to any new objects, it
  	 is removed from the set. Otherwise, its new referents are scavenged."
  	| destIndex sourceIndex |
  	sourceIndex := destIndex := n.
  	[sourceIndex < rememberedSetSize] whileTrue:
  		[| referree |
+ 		"*Don't* follow forwarding pointers here. oldSpace objects may refer
+ 		 to these roots, and so they can't be removed in the scavenge."
  		referree := rememberedSet at: sourceIndex.
- 		(manager isForwarded: referree) ifTrue:
- 			[referree := manager followForwarded: referree.
- 			 rememberedSet at: destIndex put: referree].
  		(self scavengeReferentsOf: referree)
  			ifTrue:
  				[rememberedSet at: destIndex put: referree.
  				 destIndex := destIndex + 1]
  			ifFalse:
  				[manager setIsRememberedOf: referree to: false].
  		 sourceIndex := sourceIndex + 1].
  	rememberedSetSize := destIndex!

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

Item was changed:
+ ----- Method: SpurMemoryManager>>addToFreeList: (in category 'free space') -----
- ----- Method: SpurMemoryManager>>addToFreeList: (in category 'garbage collection') -----
  addToFreeList: freeChunk
  	| chunkBytes childBytes parent child index |
  	chunkBytes := self bytesInObject: freeChunk.
  	index := chunkBytes / self wordSize.
  	index < NumFreeLists ifTrue:
  		[self storePointer: 0 ofForwardedOrFreeObject: freeChunk withValue: (freeLists at: index).
  		 freeLists at: index put: freeChunk.
  		 ^self].
  	self
  		storePointer: self freeChunkNextIndex ofForwardedOrFreeObject: freeChunk withValue: 0;
  		storePointer: self freeChunkParentIndex ofForwardedOrFreeObject: freeChunk withValue: 0;
  		storePointer: self freeChunkSmallerIndex ofForwardedOrFreeObject: freeChunk withValue: 0;
  		storePointer: self freeChunkLargerIndex ofForwardedOrFreeObject: freeChunk withValue: 0.
  	"Large chunk list organized as a tree, each node of which is a list of chunks of the same size.
  	 Beneath the node are smaller and larger blocks."
  	parent := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes ifTrue: "size match; add to list at node."
  			[self storePointerUnchecked: self freeChunkNextIndex
  					ofObject: freeChunk
  						withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
  				storePointerUnchecked: self freeChunkNextIndex
  					ofObject: child
  						withValue: freeChunk.
  			 ^self].
  		 "walk down the tree"
  		 parent := child.
  		 child := self fetchPointer: (childBytes > chunkBytes
  										ifTrue: [self freeChunkSmallerIndex]
  										ifFalse: [self freeChunkLargerIndex])
  					ofObject: child].
  	parent = 0 ifTrue:
  		[self assert: (freeLists at: 0) = 0.
  		 freeLists at: 0 put: freeChunk.
  		 ^self].
  	"insert in tree"
  	self storePointerUnchecked: self freeChunkParentIndex
  			ofObject: freeChunk
  				withValue: parent.
  	 self storePointerUnchecked: (childBytes > chunkBytes
  									ifTrue: [self freeChunkSmallerIndex]
  									ifFalse: [self freeChunkLargerIndex])
  			ofObject: parent
  				withValue: freeChunk!

Item was changed:
  ----- Method: SpurMemoryManager>>addressCouldBeObj: (in category 'debug support') -----
  addressCouldBeObj: address
  	self flag: #temporary. "include futureSpace for now (while debugging the scavenger)"
  	^(address bitAnd: self baseHeaderSize - 1) = 0
  	  and: [(self isInOldSpace: address)
- 		or: [(address between: startOfMemory and: newSpaceLimit)
  		or: (self isInEden: address)
+ 		or: [(self isInSurvivorSpace: address)
+ 		or: [scavengeInProgress and: [self isInFutureSpace: address]]]]!
- 		or: [self isInSurvivorSpace: address]]]!

Item was changed:
+ ----- Method: SpurMemoryManager>>addressCouldBeOop: (in category 'debug support') -----
- ----- Method: SpurMemoryManager>>addressCouldBeOop: (in category 'object testing') -----
  addressCouldBeOop: address 
  	^(self isImmediate: address)
  	  or: [self addressCouldBeObj: address]!

Item was changed:
  ----- Method: SpurMemoryManager>>allExistingNewSpaceObjectsDo: (in category 'object enumeration') -----
  allExistingNewSpaceObjectsDo: aBlock
  	<inline: true>
  	| prevObj prevPrevObj objOop limit |
  	prevPrevObj := prevObj := nil.
  	"After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are
  	  in pastSpace.  Objects are allocated in eden.  So enumerate only eden and pastSpace."
  	objOop := self objectStartingAt: scavenger eden start.
  	limit := freeStart.
  	[objOop < limit] whileTrue:
  		[(self isFreeObject: objOop) ifFalse:
  			[aBlock value: objOop].
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: freeStart].
  	objOop := self objectStartingAt: scavenger pastSpace start.
+ 	limit := pastSpaceStart.
- 	limit := scavenger pastSpace limit.
  	[objOop < limit] whileTrue:
  		[(self isFreeObject: objOop) ifFalse:
  			[aBlock value: objOop].
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: limit].
  	prevPrevObj class.
  	prevObj class!

Item was changed:
  ----- Method: SpurMemoryManager>>allNewSpaceObjectsDo: (in category 'object enumeration') -----
  allNewSpaceObjectsDo: aBlock
  	"Enumerate all new space objects, excluding any objects created
  	 during the execution of allNewSpaceObjectsDo:."
  	<inline: true>
  	| prevObj prevPrevObj objOop limit |
  	prevPrevObj := prevObj := nil.
  	"After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are
  	  in pastSpace.  Objects are allocated in eden.  So enumerate only eden and pastSpace."
  	objOop := self objectStartingAt: scavenger eden start.
  	[objOop < freeStart] whileTrue:
  		[(self isFreeObject: objOop) ifFalse:
  			[aBlock value: objOop].
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: freeStart].
  	objOop := self objectStartingAt: scavenger pastSpace start.
+ 	limit := pastSpaceStart.
- 	limit := scavenger pastSpace limit.
  	[objOop < limit] whileTrue:
  		[(self isFreeObject: objOop) ifFalse:
  			[aBlock value: objOop].
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: limit].
  	prevPrevObj class.
  	prevObj class!

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."
  
  	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: [(self containOnlyOops: array1 and: array2) ifFalse: [^PrimErrInappropriate]]
+ 		ifFalse:
+ 			[(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate].
+ 			 self followForwardedObjectFields: array2 toDepth: 0].
- 		ifFalse: [(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate]].
  
  	coInterpreter preBecomeAction.
  	twoWayFlag
  		ifTrue:
+ 			[self innerBecomeObjectsIn: array1 with: array2 copyHash: copyHashFlag]
- 			[self innerBecomeObjectsIn: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag]
  		ifFalse:
+ 			[self innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag].
- 			[self innerBecomeObjectsIn: array1 to: array2 twoWay: twoWayFlag copyHash: copyHashFlag].
  	self postBecomeScanClassTable.
  	coInterpreter postBecomeAction: becomeEffectsFlags.
  	becomeEffectsFlags := 0.
  
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
  
  	^PrimNoErr "success"!

Item was added:
+ ----- Method: SpurMemoryManager>>checkHeapIntegrity (in category 'debug support') -----
+ checkHeapIntegrity
+ 	"Perform an integrity/leak check using the heapMap.  Assume
+ 	 clearLeakMapAndMapAccessibleObjects has set a bit at each
+ 	 object's header.  Scan all objects in the heap checking that every
+ 	 pointer points to a header.  Scan the rootTable, remapBuffer and
+ 	 extraRootTable checking that every entry is a pointer to a header.
+ 	 Check that the number of roots is correct and that all rootTable
+ 	 entries have their rootBit set. Answer if all checks pass."
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>checkOopIntegrity:named: (in category 'debug support') -----
+ checkOopIntegrity: obj named: name
+ 	<inline: false>
+ 	<var: #name type: #'char *'>
+ 	(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
+ 		[^true].
+ 	coInterpreter print: name; print: ' leak '; printHex: obj; cr.
+ 	^false!

Item was added:
+ ----- Method: SpurMemoryManager>>checkOopIntegrity:named:index: (in category 'debug support') -----
+ checkOopIntegrity: obj named: name index: i
+ 	<inline: false>
+ 	<var: #name type: #'char *'>
+ 	(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
+ 		[^true].
+ 	coInterpreter print: name; print: ' leak @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ 	^false!

Item was added:
+ ----- Method: SpurMemoryManager>>clearLeakMapAndMapAccessibleObjects (in category 'debug support') -----
+ clearLeakMapAndMapAccessibleObjects
+ 	"Perform an integrity/leak check using the heapMap.  Set a bit at each object's header."
+ 	<inline: false>
+ 	heapMap clearHeapMap.
+ 	self allObjectsDo:
+ 		[:oop| heapMap heapMapAtWord: (self pointerForOop: oop) Put: 1]!

Item was changed:
  ----- Method: SpurMemoryManager>>clone: (in category 'allocation') -----
  clone: objOop
  	| numSlots newObj |
  	numSlots := self numSlotsOf: objOop.
  	newObj := self allocateSlots: (self numSlotsOf: objOop)
  					format: (self formatOf: objOop)
  					classIndex: (self classIndexOf: objOop).
  	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].
- 		[:i|
  		self storePointerUnchecked: i
  			ofObject: newObj
  			withValue: (self fetchPointer: i ofObject: objOop)].
  	(self isRemembered: objOop) ifTrue:
  		[scavenger remember: objOop.
  		 self setIsRememberedOf: objOop to: true].
  	^newObj!

Item was added:
+ ----- Method: SpurMemoryManager>>eek (in category 'debug support') -----
+ eek
+ 	<inline: true>!

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."
  	| 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: classTableRootObj.
  	 page = nilObj ifTrue:
  		[page := self allocateSlots: self classTablePageSize
  					format: self arrayFormat
  					classIndex: self arrayClassIndexPun.
  		 page ifNil:
  			[^PrimErrNoMemory].
  		 self storePointer: majorIndex
  			ofObject: classTableRootObj
  			withValue: page.
  		 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.
  			 ^0]].
  	 majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1.
  	 majorIndex = initialMajorIndex ifTrue: "wrapped; table full"
  		[^PrimErrLimitExceeded]] repeat!

Item was changed:
  ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'become api') -----
  followForwardedObjectFields: objOop toDepth: depth
  	"follow pointers in the object to depth.
  	 How to avoid cyclic structures?? A temproary mark bit?"
  	| oop |
- 	depth < 0 ifTrue:
- 		[^self].
  	self assert: (self isPointers: objOop).
  	0 to: (self numSlotsOf: objOop) - 1 do:
  		[:i|
  		oop := self fetchPointer: i ofObject: objOop.
  		((self isNonImmediate: oop)
  		 and: [self isForwarded: oop]) ifTrue:
  			[oop := self followForwarded: oop.
  			self storePointer: i ofObject: objOop withValue: oop].
+ 		depth > 0 ifTrue:
+ 			[self followForwardedObjectFields: objOop toDepth: depth - 1]]!
- 		self followForwardedObjectFields: objOop toDepth: depth - 1]!

Item was changed:
+ ----- Method: SpurMemoryManager>>freeChunkLargerIndex (in category 'free space') -----
- ----- Method: SpurMemoryManager>>freeChunkLargerIndex (in category 'garbage collection') -----
  freeChunkLargerIndex
  	"for organizing the tree of large free chunks."
  	^4!

Item was changed:
+ ----- Method: SpurMemoryManager>>freeChunkNextAddressIndex (in category 'free space') -----
- ----- Method: SpurMemoryManager>>freeChunkNextAddressIndex (in category 'garbage collection') -----
  freeChunkNextAddressIndex
  	"for sorting free chunks in memory order"
  	^1!

Item was changed:
+ ----- Method: SpurMemoryManager>>freeChunkNextIndex (in category 'free space') -----
- ----- Method: SpurMemoryManager>>freeChunkNextIndex (in category 'garbage collection') -----
  freeChunkNextIndex
  	"for linking objecs on each free list"
  	^0!

Item was changed:
+ ----- Method: SpurMemoryManager>>freeChunkParentIndex (in category 'free space') -----
- ----- Method: SpurMemoryManager>>freeChunkParentIndex (in category 'garbage collection') -----
  freeChunkParentIndex
  	"for organizing the tree of large free chunks."
  	^2!

Item was changed:
+ ----- Method: SpurMemoryManager>>freeChunkSmallerIndex (in category 'free space') -----
- ----- Method: SpurMemoryManager>>freeChunkSmallerIndex (in category 'garbage collection') -----
  freeChunkSmallerIndex
  	"for organizing the tree of large free chunks."
  	^3!

Item was added:
+ ----- Method: SpurMemoryManager>>freeSize (in category 'free space') -----
+ freeSize
+ 	self flag: #temporary.
+ 	^0!

Item was added:
+ ----- Method: SpurMemoryManager>>heapMap (in category 'debug support') -----
+ heapMap
+ 	^heapMap!

Item was changed:
+ ----- Method: SpurMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') -----
- ----- Method: SpurMemoryManager>>initFreeChunkWithBytes:at: (in category 'garbage collection') -----
  initFreeChunkWithBytes: numBytes at: address
  	| numSlots |
  	self assert: numBytes \\ self allocationUnit = 0.
  	numSlots := numBytes >> self shiftForWord
  				- (numBytes >= (self numSlotsMask << self shiftForWord)
  					ifTrue: [self baseHeaderSize + self baseHeaderSize / self wordSize]
  					ifFalse: [self baseHeaderSize / self wordSize]).
  	^self initFreeChunkWithSlots: numSlots at: address!

Item was changed:
+ ----- Method: SpurMemoryManager>>initFreeChunkWithSlots:at: (in category 'free space') -----
- ----- Method: SpurMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') -----
  initFreeChunkWithSlots: numSlots at: address 
  	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0).
  	checkForLeaks := 0.
+ 	needGCFlag := signalLowSpace := scavengeInProgress := false.
- 	needGCFlag := signalLowSpace := false.
  	becomeEffectsFlags := 0.
+ 	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
+ 	statScavenges := 0.
+ 	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0.
+ 	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0!
- 	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]!

Item was changed:
+ ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') -----
- ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'garbage collection') -----
  initializeOldSpaceFirstFree: startOfFreeOldSpace
  	<var: 'startOfFreeOldSpace' type: #usqLong>
  	| freeOldStart freeChunk |
  	<var: 'freeOldStart' type: #usqLong>
  	0 to: NumFreeLists - 1 do:
  		[:i| freeLists at: i put: 0].
  	freeOldStart := startOfFreeOldSpace.
  	[endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue:
  		[freeChunk := self initFreeChunkWithSlots: (2 raisedTo: 32) / self wordSize at: freeOldStart.
  		self addToFreeList: freeChunk.
  		freeOldStart := self addressAfter: freeChunk].
  	freeChunk := self initFreeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart.
  	self addToFreeList: freeChunk.
  	self assert: (self addressAfter: freeChunk) = endOfMemory!

Item was changed:
  ----- Method: SpurMemoryManager>>initializePostBootstrap (in category 'simulation') -----
  initializePostBootstrap
  	"The heap has just been bootstrapped into a modified newSpace occupying all of memory above newSPace (and the codeZone).
  	 Put things back to some kind of normalicy."
  	freeOldSpaceStart := freeStart.
  	freeStart := scavenger eden start.
+ 	pastSpaceStart := scavenger pastSpace start.
  	scavengeThreshold := scavenger eden limit - (scavenger edenBytes / 64)!

Item was added:
+ ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:to:copyHash: (in category 'become implementation') -----
+ innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag
+ 	"Inner loop of one-way become."
+ 	0 to: (self numSlotsOf: array1) - 1 do:
+ 		[:i| | obj1 obj2 |
+ 		obj1 := self fetchPointer: i ofObject: array1.
+ 		obj2 := self fetchPointer: i ofObject: array2.
+ 		self doBecome: obj1 with: obj2 copyHash: copyHashFlag.
+ 		(self isForwarded: obj1) ifTrue:
+ 			[obj1 := self followForwarded: obj1.
+ 			 self storePointer: i ofObject: array1 withValue: obj1].
+ 		self assert: (self isForwarded: obj2) not]!

Item was removed:
- ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:to:twoWay:copyHash: (in category 'become implementation') -----
- innerBecomeObjectsIn: array1 to: array2 twoWay: twoWayFlag copyHash: copyHashFlag
- 	| fieldOffset |
- 	fieldOffset := self lastPointerOf: array1.
- 	[fieldOffset >= self baseHeaderSize] whileTrue:
- 		[self doBecome: (self longAt: array1 + fieldOffset)
- 			to: (self longAt: array2 + fieldOffset)
- 			copyHash: copyHashFlag.
- 		fieldOffset := fieldOffset - BytesPerOop]!

Item was added:
+ ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:with:copyHash: (in category 'become implementation') -----
+ innerBecomeObjectsIn: array1 with: array2 copyHash: copyHashFlag
+ 	"Inner loop of two-way become."
+ 	0 to: (self numSlotsOf: array1) - 1 do:
+ 		[:i| | obj1 obj2 |
+ 		obj1 := self fetchPointer: i ofObject: array1.
+ 		obj2 := self fetchPointer: i ofObject: array2.
+ 		self doBecome: obj1 with: obj2 copyHash: copyHashFlag.
+ 		(self isForwarded: obj1) ifTrue:
+ 			[obj1 := self followForwarded: obj1.
+ 			 self storePointer: i ofObject: array1 withValue: obj1].
+ 		(self isForwarded: obj2) ifTrue:
+ 			[obj2 := self followForwarded: obj2.
+ 			 self storePointer: i ofObject: array2 withValue: obj2]]!

Item was removed:
- ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:with:twoWay:copyHash: (in category 'become implementation') -----
- innerBecomeObjectsIn: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
- 	| fieldOffset |
- 	fieldOffset := self lastPointerOf: array1.
- 	[fieldOffset >= self baseHeaderSize] whileTrue:
- 		[self doBecome: (self longAt: array1 + fieldOffset)
- 			with: (self longAt: array2 + fieldOffset)
- 			copyHash: copyHashFlag.
- 		fieldOffset := fieldOffset - BytesPerOop]!

Item was changed:
  ----- Method: SpurMemoryManager>>isInEden: (in category 'object testing') -----
  isInEden: objOop
  	^objOop >= scavenger eden start
+ 	  and: [objOop < freeStart]!
- 	  and: [objOop < scavenger eden limit]!

Item was changed:
  ----- Method: SpurMemoryManager>>isInFutureSpace: (in category 'object testing') -----
  isInFutureSpace: objOop
  	^objOop >= scavenger futureSpace start
+ 	  and: [objOop < scavenger futureSurvivorStart]!
- 	  and: [objOop < scavenger futureSpace limit]!

Item was changed:
  ----- Method: SpurMemoryManager>>isInSurvivorSpace: (in category 'object testing') -----
  isInSurvivorSpace: objOop
  	^objOop >= scavenger pastSpace start
+ 	  and: [objOop < pastSpaceStart]!
- 	  and: [objOop < scavenger pastSpace limit]!

Item was changed:
  ----- Method: SpurMemoryManager>>isNonIntegerObject: (in category 'object testing') -----
  isNonIntegerObject: oop
  	"This list records the valid senders of isNonIntegerObject: as we replace uses of
  	  isNonIntegerObject: by isNonImmediate: where appropriate."
+ 	(#(reverseDisplayFrom:to:) includes: thisContext sender method selector) ifFalse:
- 	(#() includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) = 0!

Item was changed:
  ----- Method: SpurMemoryManager>>lastPointerOf: (in category 'object enumeration') -----
  lastPointerOf: objOop 
  	"Answer the byte offset of the last pointer field of the given object.
  	 Works with CompiledMethods, as well as ordinary objects."
  	<api>
  	<inline: true>
  	<asmLabel: false>
  	| fmt contextSize numLiterals |
  	fmt := self formatOf: objOop.
+ 	self assert: fmt ~= self forwardedFormat.
  	fmt <= self lastPointerFormat ifTrue:
  		[(fmt = self indexablePointersFormat
  		  and: [self isContextNonImm: objOop]) ifTrue:
  			["contexts end at the stack pointer"
  			contextSize := coInterpreter fetchStackPointerOf: objOop.
  			^CtxtTempFrameStart + contextSize * BytesPerOop].
  		^(self numSlotsOf: objOop) - 1 * BytesPerOop + self baseHeaderSize  "all pointers"].
  	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes"
  	numLiterals := coInterpreter literalCountOf: objOop.
  	^numLiterals + LiteralStart - 1 * BytesPerOop + self baseHeaderSize!

Item was added:
+ ----- Method: SpurMemoryManager>>leakCheckIncrementalGC (in category 'debug support') -----
+ leakCheckIncrementalGC
+ 	<api>
+ 	^(checkForLeaks bitAnd: 8) ~= 0!

Item was added:
+ ----- Method: SpurMemoryManager>>leakCheckScavenge (in category 'debug support') -----
+ leakCheckScavenge
+ 	<api>
+ 	^(checkForLeaks bitAnd: 2) ~= 0!

Item was changed:
  ----- Method: SpurMemoryManager>>numPointerSlotsOf: (in category 'object enumeration') -----
  numPointerSlotsOf: objOop
  	"Answer the number of pointer fields in the given object.
  	 Works with CompiledMethods, as well as ordinary objects."
  	<api>
  	<inline: true>
  	<asmLabel: false>
  	| fmt contextSize numLiterals |
  	fmt := self formatOf: objOop.
  	fmt <= self lastPointerFormat ifTrue:
  		[(fmt = self indexablePointersFormat
  		  and: [self isContextNonImm: objOop]) ifTrue:
  			["contexts end at the stack pointer"
  			contextSize := coInterpreter fetchStackPointerOf: objOop.
  			^CtxtTempFrameStart + contextSize].
  		^self numSlotsOf: objOop  "all pointers"].
+ 	fmt = self forwardedFormat ifTrue: [^1].
  	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes"
  	numLiterals := coInterpreter literalCountOf: objOop.
  	^numLiterals + LiteralStart!

Item was changed:
  ----- Method: SpurMemoryManager>>possibleRootStoreInto:value: (in category 'store check') -----
  possibleRootStoreInto: destObj value: valueOop
+ 	(#(	storePointer:ofObject:withValue:
+ 		storePointer:ofForwardedOrFreeObject:withValue:) includes: thisContext sender method selector) ifFalse:
- 	(#(	storePointer:ofObject:withValue:) includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	(self isRemembered: destObj) ifFalse:
  		[scavenger remember: destObj.
  		 self setIsRememberedOf: destObj to: true]!

Item was changed:
  ----- Method: SpurMemoryManager>>postBecomeScanClassTable (in category 'become implementation') -----
  postBecomeScanClassTable
+ 	"Scan the class table post-become (iff a pointer object or compiled method was becommed)"
+ 	(becomeEffectsFlags anyMask: BecamePointerObjectFlag+BecameCompiledMethodFlag) ifFalse: [^self].
- 	"Scan the class table post-become (iff a pointer object was becommed)"
- 	(becomeEffectsFlags anyMask: BecamePointerObjectFlag) ifFalse: [^self].
  	
  	0 to: (self numSlotsOf: classTableRootObj) - 1 do:
  		[:i| | page |
  		page := self fetchPointer: i ofObject: classTableRootObj.
  		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 scanClassPostBecome: classOrNil effects: becomeEffectsFlags]]]!
- 				 self scanClassPostBecome: classOrNil]]]!

Item was added:
+ ----- Method: SpurMemoryManager>>printMemoryFrom:to: (in category 'debug printing') -----
+ printMemoryFrom: start to: end
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>printReferencesTo: (in category 'debug printing') -----
+ printReferencesTo: anOop
+ 	"Scan the heap printing the oops of any and all objects that refer to anOop"
+ 	<api>
+ 	self allObjectsDo:
+ 		[:obj| | i |
+ 		((self isPointersNonImm: obj) or: [self isCompiledMethod: obj])
+ 			ifTrue:
+ 				[(self isCompiledMethod: obj)
+ 					ifTrue:
+ 						[i := (coInterpreter literalCountOf: obj) + LiteralStart]
+ 					ifFalse:
+ 						[(self isContextNonImm: obj)
+ 							ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj)]
+ 							ifFalse: [i := self lengthOf: obj]].
+ 				[(i := i - 1) >= 0] whileTrue:
+ 					[anOop = (self fetchPointer: i ofObject: obj) ifTrue:
+ 						[coInterpreter printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj; cr.
+ 						 i := 0]]]
+ 			ifFalse:
+ 				[((self isForwarded: obj)
+ 				 and: [(self fetchPointer: 0 ofForwardedOrFreeObject: obj) = anOop]) ifTrue:
+ 					[coInterpreter printHex: obj; print: ' => '; printHex: anOop; cr]]]!

Item was added:
+ ----- Method: SpurMemoryManager>>runLeakCheckerForFullGC: (in category 'debug support') -----
+ runLeakCheckerForFullGC: fullGCFlag
+ 	<inline: false>
+ 	(fullGCFlag
+ 			ifTrue: [self leakCheckFullGC]
+ 			ifFalse: [self leakCheckScavenge]) ifTrue:
+ 		[fullGCFlag
+ 			ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
+ 			ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
+ 		 self clearLeakMapAndMapAccessibleObjects.
+ 		 self assert: self checkHeapIntegrity.
+ 		 self assert: coInterpreter checkInterpreterIntegrity.
+ 		 self assert: coInterpreter checkStackIntegrity.
+ 		 self assert: (coInterpreter checkCodeIntegrity: fullGCFlag)]!

Item was removed:
- ----- Method: SpurMemoryManager>>scanClassPostBecome: (in category 'become implementation') -----
- scanClassPostBecome: classObj
- 	"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."
- 
- 	| obj |
- 	self assert: (self rawHashBitsOf: nilObj) ~= 0.
- 
- 	obj := self fetchPointer: MethodDictionaryIndex ofObject: classObj.
- 	self assert: (self isNonImmediate: obj).
- 	(self isForwarded: obj) ifTrue:
- 		[obj := self followForwarded: obj.
- 		 self storePointer: MethodDictionaryIndex ofObject: classObj withValue: obj].
- 
- 	obj := self fetchPointer: SuperclassIndex ofObject: classObj.
- 	self assert: (self isNonImmediate: obj).
- 	(self isForwarded: obj) ifTrue:
- 		[obj := self followForwarded: obj.
- 		 self storePointer: SuperclassIndex ofObject: classObj withValue: obj].
- 
- 	"If the superclass has an identityHash then either it is nil, or is in the class table.
- 	 Tail recurse."
- 	(self rawHashBitsOf: obj) = 0 ifTrue:
- 		[self scanClassPostBecome: obj]!

Item was added:
+ ----- 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, and that methoidClassAssociations in methods
+ 	 are not followed either."
+ 
+ 	| classObj obj obj2 |
+ 	"Algorithm depend on this to terminate loop at root of superclass chain."
+ 	self assert: (self rawHashBitsOf: nilObj) ~= 0.
+ 	self assert: (becomeEffects anyMask: BecamePointerObjectFlag+BecameCompiledMethodFlag). "otherwise why bother?"
+ 	classObj := startClassObj.
+ 
+ 	[obj := self fetchPointer: MethodDictionaryIndex ofObject: classObj.
+ 	 self assert: (self isNonImmediate: obj).
+ 	 (self isForwarded: obj) ifTrue:
+ 		[obj := self followForwarded: obj.
+ 		 self storePointer: MethodDictionaryIndex ofObject: classObj withValue: obj].
+ 	 obj2 := self fetchPointer: MethodArrayIndex ofObject: obj.
+ 	 self assert: (self isNonImmediate: obj2).
+ 	 (self isForwarded: obj2) ifTrue:
+ 		[obj2 := self followForwarded: obj2.
+ 		 self storePointer: MethodArrayIndex ofObject: obj withValue: obj2].
+ 	 "Only need to follow pointers in MethodArray if we've became any compiled methods..."
+ 	 (becomeEffects anyMask: BecameCompiledMethodFlag) ifTrue:
+ 		[self followForwardedObjectFields: obj2 toDepth: 0].
+ 	 "But the methodClassAssociations there-in need to be followed if we've done any pointer becomes."
+ 	 (becomeEffects anyMask: BecamePointerObjectFlag) ifTrue:
+ 		[0 to: (self numSlotsOf: obj2) - 1 do:
+ 			[:i|
+ 			obj := self fetchPointer: i ofObject: obj2.
+ 			(self isOopCompiledMethod: obj2) ifTrue:
+ 				[coInterpreter followNecessaryForwardingInMethod: obj2]]].
+ 
+ 	 obj := self fetchPointer: SuperclassIndex ofObject: classObj.
+ 	 self assert: (self isNonImmediate: obj).
+ 	 (self isForwarded: obj) ifTrue:
+ 		[obj := self followForwarded: obj.
+ 		 self storePointer: SuperclassIndex ofObject: classObj withValue: obj].
+ 
+ 	"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 added:
+ ----- Method: SpurMemoryManager>>setCheckForLeaks: (in category 'debug support') -----
+ setCheckForLeaks: anInteger
+ 	" 0 = do nothing.
+ 	  1 = check for leaks on fullGC.
+ 	  2 = check for leaks on scavenger.
+ 	  4 = check for leaks on become
+ 	  8 = check for leaks on truly incremental.
+ 	15 = check for leaks on all four."
+ 	checkForLeaks := anInteger!

Item was added:
+ ----- Method: SpurMemoryManager>>shrinkThreshold (in category 'free space') -----
+ shrinkThreshold
+ 	self flag: #temporary.
+ 	^SmallInteger maxVal!

Item was changed:
  ----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'generation scavenging') -----
  sufficientSpaceAfterGC: numBytes
  	"This is ObjectMemory's funky entry-point into its incremental GC,
  	 which is a stop-the-world a young generation reclaimer.  In Spur
  	 we run the scavenger."
  	self halt.
  	self assert: numBytes = 0.
+ 
+ 	self runLeakCheckerForFullGC: false.
+ 	coInterpreter preGCAction: GCModeIncr.
  	needGCFlag := false.
+ 
+ 
+ 	gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
+ 
+ 	scavengeInProgress := true.
+ 	pastSpaceStart := scavenger scavenge.
+ 	self assert: (self
+ 					oop: pastSpaceStart
+ 					isGreaterThanOrEqualTo: scavenger pastSpace start
+ 					andLessThan: scavenger pastSpace limit).
- 	scavenger scavenge.
  	freeStart := scavenger eden start.
  	self initSpaceForAllocationCheck: scavenger eden.
+ 	scavengeInProgress := false.
+ 
+ 	statScavenges := statScavenges + 1.
+ 	statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
+ 	statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
+ 	statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
+ 
+ 	coInterpreter postGCAction.
+ 	self runLeakCheckerForFullGC: false.
+ 
  	^true!

Item was added:
+ ----- Method: SpurNewSpaceSpace>>printOn: (in category 'printing') -----
+ printOn: aStream.
+ 	super printOn: aStream.
+ 	(start notNil and: [limit notNil]) ifTrue:
+ 		[aStream nextPutAll: ' start: '; nextPutAll: start hex; nextPutAll: ' limit: '; nextPutAll: limit hex]!

Item was changed:
  ----- Method: StackInterpreter>>checkInterpreterIntegrity (in category 'object memory support') -----
  checkInterpreterIntegrity
  	"Perform an integrity/leak check using the heapMap.  Assume
  	 clearLeakMapAndMapAccessibleObjects has set a bit at each
  	 object's header.  Check that all oops in the interpreter's state
  	 points to a header.  Answer if all checks pass."
  	| ok |
  	ok := true.
  	(objectMemory checkOopIntegrity: objectMemory specialObjectsOop named: 'specialObjectsOop')ifFalse:
  		[ok := false].
+ 	(objectMemory isNonImmediate: messageSelector) ifTrue:
- 	(objectMemory isIntegerObject: messageSelector) ifFalse:
  		[(objectMemory checkOopIntegrity: messageSelector named: 'messageSelector')ifFalse:
  			[ok := false]].
  	(objectMemory checkOopIntegrity: newMethod named: 'newMethod')ifFalse:
  		[ok := false].
  	(objectMemory checkOopIntegrity: lkupClass named: 'lkupClass')ifFalse:
  		[ok := false].
  	(objectMemory checkOopIntegrity: profileProcess named: 'profileProcess')ifFalse:
  		[ok := false].
  	(objectMemory checkOopIntegrity: profileMethod named: 'profileMethod')ifFalse:
  		[ok := false].
  	(objectMemory checkOopIntegrity: profileSemaphore named: 'profileSemaphore')ifFalse:
  		[ok := false].
  	tempOop = 0 ifFalse:
  		[(objectMemory checkOopIntegrity: tempOop named: 'tempOop')ifFalse:
  			[ok := false]].
  
  	"Callback support - check suspended callback list"
  	1 to: jmpDepth do:
  		[:i|
  		(objectMemory checkOopIntegrity: (suspendedCallbacks at: i) named: 'suspendedCallbacks' index: i) ifFalse:
  			[ok := false].
  		(objectMemory checkOopIntegrity: (suspendedMethods at: i) named: 'suspendedMethods' index: i) ifFalse:
  			[ok := false]].
  
  	self checkLogIntegrity ifFalse:
  		[ok := false].
  
  	^ok!

Item was changed:
  ----- Method: StackInterpreter>>checkStackIntegrity (in category 'object memory support') -----
  checkStackIntegrity
  	"Perform an integrity/leak check using the heapMap.  Assume
  	 clearLeakMapAndMapAccesibleObjects has set a bit at each
  	 object's header.  Scan all objects accessible from the stack
  	 checking that every pointer points to a header.  Answer if no
  	 dangling pointers were detected."
  	| ok |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	ok := true.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP oop |
  		thePage := stackPages stackPageAt: i.
  		(stackPages isFree: thePage) ifFalse:
  			[thePage = stackPage
  				ifTrue:
  					[theSP := stackPointer.
  					 theFP := framePointer]
  				ifFalse:
  					[theSP := thePage headSP.
  					 theFP := thePage  headFP].
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage ifFalse:
  				[theSP := theSP + BytesPerWord].
  			 [[theSP <= (theFP + FoxReceiver)] whileTrue:
  				[oop := stackPages longAt: theSP.
+ 				 ((objectMemory isNonImmediate: oop) 
- 				 ((objectMemory isNonIntegerObject: oop) 
  				   and: [(self heapMapAtWord: (self pointerForOop: oop)) = 0]) ifTrue:
  					[self printFrameThing: 'object leak in frame temp' at: theSP; cr.
  					 ok := false].
  				 theSP := theSP + BytesPerWord].
  			 (self frameHasContext: theFP) ifTrue:
  				[oop := self frameContext: theFP.
+ 				 ((objectMemory isImmediate: oop) 
- 				 ((objectMemory isIntegerObject: oop) 
  				   or: [(self heapMapAtWord: (self pointerForOop: oop)) = 0]) ifTrue:
  					[self printFrameThing: 'object leak in frame ctxt' at: theFP + FoxThisContext; cr.
  					 ok := false].
  				 (objectMemory isContext: oop) ifFalse:
  					[self printFrameThing: 'frame ctxt should be context' at: theFP + FoxThisContext; cr.
  					 ok := false]].
  			 oop := self frameMethod: theFP.
+ 			 ((objectMemory isImmediate: oop) 
- 			 ((objectMemory isIntegerObject: oop) 
  			   or: [(self heapMapAtWord: (self pointerForOop: oop)) = 0]) ifTrue:
  				[self printFrameThing: 'object leak in frame mthd' at: theFP + FoxMethod; cr.
  				 ok := false].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theSP := theFP + FoxCallerSavedIP + BytesPerWord.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerContext "a.k.a. FoxCallerSavedIP".
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
+ 				 ((objectMemory isNonImmediate: oop) 
- 				 ((objectMemory isNonIntegerObject: oop) 
  				   and: [(self heapMapAtWord: (self pointerForOop: oop)) = 0]) ifTrue:
  					[self printFrameThing: 'object leak in frame arg' at: theSP; cr.
  					 ok := false].
  				 theSP := theSP + BytesPerWord]]].
  	^ok!

Item was changed:
  ----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: becomeEffectsFlags
  	"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: #'char *'>
  
- 	"NEEDS MORE THOUGHT!!  WHAT ABOUT methodClassAssociation etc
- 	 examine becomeEffectsFlags"
  	(becomeEffectsFlags 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]].
  
- 	"Need to write back the frame pointers unless all pages are free (as in snapshot)"
  	self assert: stackPage ~= 0.
- 	self externalWriteBackHeadFramePointers.
  	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.
  					 theSP := theSP + BytesPerWord].
  			 [self assert: (thePage addressIsInPage: theFP).
  			  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
  			  oop := stackPages longAt: theFP + FoxReceiver.
  			  ((objectMemory isNonImmediate: oop)
  			   and: [(objectMemory isForwarded: oop)]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxReceiver
  					put: (objectMemory followForwarded: oop)].
  			  theIP := theFP + (self frameStackedReceiverOffset: theFP). "reuse theIP; its just an offset here"
  			  oop := stackPages longAt: theIP.
  			  ((objectMemory isNonImmediate: oop)
  			   and: [(objectMemory isForwarded: 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))].
  			  (objectMemory isForwarded: (self frameMethod: theFP)) ifTrue:
  				[theIPPtr ~= 0 ifTrue:
  					[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  					 theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
  				stackPages
  					longAt: theFP + FoxMethod
  					put: (objectMemory followForwarded: (self frameMethod: theFP)).
  			 	 theIPPtr ~= 0 ifTrue:
  					[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)]].
+ 			  self followNecessaryForwardingInMethod: (self frameMethod: theFP).
  			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theIPPtr := theFP + FoxCallerSavedIP.
  				 theFP := callerFP]]]!

Item was added:
+ ----- 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."
+ 	| assoc classObj |
+ 	assoc := self methodClassAssociationOf: methodObj.
+ 	(objectMemory isForwarded: assoc) ifTrue:
+ 		[assoc := objectMemory followForwarded: assoc.
+ 		 self setMethodClassAssociationOf: methodObj to: assoc].
+ 	classObj := objectMemory fetchPointer: ValueIndex ofObject: assoc.
+ 	(objectMemory isForwarded: classObj) ifTrue:
+ 		[classObj := objectMemory followForwarded: assoc.
+ 		 objectMemory storePointer: ValueIndex ofObject: assoc withValue: classObj]!

Item was changed:
  ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
  longPrintOop: oop
  	<api>
  	| class fmt lastIndex startIP bytecodesPerLine column |
  	((objectMemory isImmediate: oop)
  	 or: [(objectMemory addressCouldBeObj: oop) not
  	 or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  	 or: [(objectMemory isFreeObject: oop)
  	 or: [objectMemory isForwarded: oop]]]]) ifTrue:
  		[^self printOop: oop].
  	class := objectMemory fetchClassOfNonImm: oop.
  	self printHex: oop;
  		print: ': a(n) '; printNameOfClass: class count: 5;
  		print: ' ('; printHex: class; print: ')'.
  	fmt := objectMemory formatOf: oop.
  	fmt > objectMemory lastPointerFormat ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
  	objectMemory printHeaderTypeOf: oop.
+ 	self print: ', hash '; printHex: (objectMemory rawHashBitsOf: oop).
- 	self print: ' hash '; printHex: (objectMemory rawHashBitsOf: oop).
  	self cr.
  	(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  		[^self].
  	"this is nonsense.  apologies."
  	startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
  	lastIndex := 256 min: startIP.
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:i| | fieldOop |
  			fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
  			self space; printNum: i - 1; space; printHex: fieldOop; space.
  			(i = 1 and: [objectMemory isCompiledMethod: oop])
  				ifTrue: [self printMethodHeaderOop: fieldOop]
  				ifFalse: [self printOopShort: fieldOop].
  			self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * BytesPerWord + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
  					[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
  						inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", byte,byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>mapStackPages (in category 'object memory support') -----
  mapStackPages
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
- 	"Need to write back the frame pointers unless all pages are free (as in snapshot)"
- 	stackPage ~= 0 ifTrue:
- 		[self externalWriteBackHeadFramePointers].
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP theIPPtr 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.
  					 theSP := theSP + BytesPerWord].
  			[self assert: (thePage addressIsInPage: theFP).
  			 self assert: (thePage addressIsInPage: theSP).
  			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
  			 [theSP <= (theFP + FoxReceiver)] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + BytesPerWord].
  			 ((self frameHasContext: theFP)
  			  and: [objectMemory shouldRemapObj: (self frameContext: theFP)]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory remapObj: (self frameContext: theFP))].
  			 (objectMemory shouldRemapObj: (self frameMethod: theFP)) ifTrue:
  				[theIPPtr ~= 0 ifTrue:
  					[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  					 theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
  				 stackPages
  					longAt: theFP + FoxMethod
  					put: (objectMemory remapObj: (self frameMethod: theFP)).
  				 theIPPtr ~= 0 ifTrue:
  					[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)]].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + BytesPerWord.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP"
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + BytesPerWord]]]!

Item was changed:
  ----- Method: StackInterpreter>>reverseDisplayFrom:to: (in category 'I/O primitive support') -----
  reverseDisplayFrom: startIndex to: endIndex 
  	"Reverse the given range of Display words (at different bit 
  	depths, this will reverse different numbers of pixels). Used to 
  	give feedback during VM activities such as garbage 
  	collection when debugging. It is assumed that the given 
  	word range falls entirely within the first line of the Display."
  	| displayObj displayBits w wordStartIndex wordEndIndex primFailCodeValue |
  	displayObj := objectMemory splObj: TheDisplay.
  	((objectMemory isPointers: displayObj) and: [(objectMemory lengthOf: displayObj) >= 4]) ifFalse: [^ nil].
  	w := objectMemory fetchPointer: 1 ofObject: displayObj.
  	displayBits := objectMemory fetchPointer: 0 ofObject: displayObj.
+ 	((objectMemory isImmediate: displayBits)
- 	((objectMemory isIntegerObject: displayBits)
  	or: [(objectMemory isNonIntegerObject: w)
+ 	or: [objectMemory isPointersNonImm: displayBits]]) ifTrue: [^ nil].
- 	or: [objectMemory isPointersNonInt: displayBits]]) ifTrue: [^ nil].
  	wordStartIndex := startIndex * 4.
  	wordEndIndex := endIndex * 4 min: (objectMemory sizeBitsOf: displayBits).
  	displayBits := displayBits + BaseHeaderSize.
  	displayBits + wordStartIndex to: displayBits + wordEndIndex by: 4 do:
  		[:ptr | | reversed  |
  		reversed := (objectMemory long32At: ptr) bitXor: 4294967295.
  		objectMemory longAt: ptr put: reversed].
  	primFailCodeValue := primFailCode.
  	self initPrimCall.
  	self displayBitsOf: displayObj Left: 0 Top: 0 Right: (objectMemory integerValueOf: w) Bottom: 1.
  	self ioForceDisplayUpdate.
  	primFailCode := primFailCodeValue!

Item was added:
+ ----- Method: StackInterpreter>>setMethodClassAssociationOf:to: (in category 'compiled methods') -----
+ setMethodClassAssociationOf: methodPointer to: anObject
+ 	objectMemory
+ 		storePointer: (self literalCountOf: methodPointer) + LiteralStart - 1
+ 		ofObject: methodPointer
+ 		withValue: anObject!

Item was added:
+ ----- Method: StackInterpreterSimulator>>heapMapAtWord: (in category 'debug support') -----
+ heapMapAtWord: address
+ 	^objectMemory heapMap heapMapAtWord: address!

Item was added:
+ ----- Method: VMClass>>oop:isGreaterThanOrEqualTo:andLessThan: (in category 'oop comparison') -----
+ oop: anOop isGreaterThanOrEqualTo: baseOop andLessThan: limitOop
+ 	"Compare two oop values, treating them as object memory locations.
+ 	Use #cCoerce:to: to ensure comparison of unsigned magnitudes. This
+ 	method will be inlined during C translation."
+ 	<inline: true>
+ 	^(self cCoerce: anOop to: #usqInt) >= (self cCoerce: baseOop to: #usqInt)
+ 	  and: [(self cCoerce: anOop to: #usqInt) < (self cCoerce: limitOop to: #usqInt)]!



More information about the Vm-dev mailing list