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

commits at source.squeak.org commits at source.squeak.org
Wed Sep 11 21:07:39 UTC 2013


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

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

Name: VMMaker.oscog-eem.371
Author: eem
Time: 11 September 2013, 2:04:37.26 pm
UUID: 4f274df7-d2dc-44e7-baba-9421d3fdbbd6
Ancestors: VMMaker.oscog-eem.370

More become support for Spur.
- Forwarding objects in scavenger and stackZone.
- in-place and out-of-place two-way become.
- checking for not being forwarded in storePointer:/fetchPointer:.
- reserve a format for forwarded objects so become: does not have
  to nil the body of an object, and the GC will only follow the 1st ptr.

Fix SpurMemoryManager>>lastPointerOf: and its usage in become.
Fix the validInstructionPointer:inMethod:framePointer: assert.
Fix use of BytesPerWord in ObjectMemory>>containOnlyOops:[and:].
Fix StackInterpreter>>printOop: et al for forwarded objects and
compiled methods.
Fix assert in mapStackPages.

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

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]).
- 			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theFP]).
  			 frameRcvrOffset := self frameReceiverOffset: theFP.
  	 		  [theSP <= frameRcvrOffset] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory isIntegerObject: oop) ifFalse:
  					[stackPages longAt: theSP put: (objectMemory remap: oop)].
  				 theSP := theSP + BytesPerWord].
  			 (self frameHasContext: theFP) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory remap: (self frameContext: theFP))].
  			(self isMachineCodeFrame: theFP) ifFalse:
  				[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 remap: (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 isIntegerObject: oop) ifFalse:
  					[stackPages longAt: theSP put: (objectMemory remap: oop)].
  				 theSP := theSP + BytesPerWord]]]!

Item was removed:
- ----- Method: CoInterpreter>>postBecomeAction (in category 'object memory support') -----
- postBecomeAction
- 	"Clear the gcMode var and let the Cogit do its post GC checks."
- 	cogit cogitPostGCAction: gcMode.
- 
- 	lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil.
- 
- 	gcMode := 0!

Item was added:
+ ----- Method: CoInterpreter>>postBecomeAction: (in category 'object memory support') -----
+ postBecomeAction: updateReceiversInStackZone
+ 	"Clear the gcMode var and let the Cogit do its post GC checks."
+ 	super postBecomeAction: updateReceiversInStackZone.
+ 
+ 	cogit cogitPostGCAction: gcMode.
+ 
+ 	lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil.
+ 
+ 	gcMode := 0!

Item was changed:
  ----- Method: NewObjectMemory>>become:with:twoWay:copyHash: (in category 'become') -----
  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. 
  	Returns PrimNoErr if the primitive succeeds."
  	"Implementation: Uses forwarding blocks to update references as done in compaction."
  	| start |
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
  	(self isArray: array1) ifFalse:
  		[^PrimErrBadReceiver].
  	((self isArray: array2)
  	 and: [(self lastPointerOf: array1) = (self lastPointerOf: array2)]) ifFalse:
  		[^PrimErrBadArgument].
  	(twoWayFlag or: [copyHashFlag])
  		ifTrue: [(self containOnlyOops: array1 and: array2) ifFalse: [^PrimErrInappropriate]]
  		ifFalse: [(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate]].
  
  	(self prepareForwardingTableForBecoming: array1 with: array2 twoWay: twoWayFlag) ifFalse:
  		[^PrimErrNoMemory]. "fail; not enough space for forwarding table"
  
  	(self allYoung: array1 and: array2)
  		ifTrue: [start := youngStart"sweep only the young objects plus the roots"]
  		ifFalse: [start := self startOfMemory"sweep all objects"].
  	coInterpreter preBecomeAction.
  	self mapPointersInObjectsFrom: start to: freeStart.
  	twoWayFlag
  		ifTrue: [self restoreHeadersAfterBecoming: array1 with: array2]
  		ifFalse: [self restoreHeadersAfterForwardBecome: copyHashFlag].
+ 	coInterpreter postBecomeAction: false.
- 	coInterpreter postBecomeAction.
  
  	self initializeMemoryFirstFree: freeStart. "re-initialize memory used for forwarding table"
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
  
  	^PrimNoErr "success"!

Item was changed:
  ----- Method: ObjectMemory>>containOnlyOops: (in category 'become') -----
  containOnlyOops: array
+ 	"Answer if the array does not contain a small integer. You 
- 	"Return true if the array contains a small integer. You 
  	  can't become: SmallIntegers!!"
  	| fieldOffset |
  	fieldOffset := self lastPointerOf: array.
  	"same size as array2"
  	[fieldOffset >= BaseHeaderSize] whileTrue:
  		[(self isIntegerObject: (self longAt: array + fieldOffset)) ifTrue: [^ false].
+ 		 fieldOffset := fieldOffset - BytesPerOop].
- 		 fieldOffset := fieldOffset - BytesPerWord].
  	^true!

Item was changed:
  ----- Method: ObjectMemory>>containOnlyOops:and: (in category 'become') -----
  containOnlyOops: array1 and: array2 
+ 	"Answer if neither array contains a small integer. You 
- 	"Return true if neither array contains a small integer. You 
  	can't become: integers!!"
  	| fieldOffset |
  	fieldOffset := self lastPointerOf: array1.
  	"same size as array2"
  	[fieldOffset >= BaseHeaderSize]
  		whileTrue: [(self isIntegerObject: (self longAt: array1 + fieldOffset)) ifTrue: [^ false].
  			(self isIntegerObject: (self longAt: array2 + fieldOffset)) ifTrue: [^ false].
+ 			fieldOffset := fieldOffset - BytesPerOop].
- 			fieldOffset := fieldOffset - BytesPerWord].
  	^ true!

Item was added:
+ ----- Method: ObjectMemory>>isForwarded: (in category 'interpreter access') -----
+ isForwarded: oop
+ 	"Compatibility wth SpurMemoryManager.  In ObjectMemory, no forwarding pointers
+ 	 are visible to the VM."
+ 	<inline: true>
+ 	^false!

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

Item was changed:
  ----- Method: Spur32BitMemoryManager>>fetchPointer:ofObject: (in category 'object access') -----
  fetchPointer: fieldIndex ofObject: objOop
+ 	self assert: (self isForwarded: objOop) not.
  	^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>formatOf: (in category 'object access') -----
  formatOf: objOop
  	"0 = 0 sized objects (UndefinedObject True False et al)
  	 1 = non-indexable objects with inst vars (Point et al)
  	 2 = indexable objects with no inst vars (Array et al)
  	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  	 4 = weak indexable objects with inst vars (WeakArray et al)
  	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 	 6 unused, reserved for exotic pointer objects?
+ 	 7 Forwarded Object, 1st field is pointer, rest of fields are ignored
+ 	 8 unused, reserved for exotic non-pointer objects?
- 	 6,7,8 unused
  	 9 (?) 64-bit indexable
  	 10 - 11 32-bit indexable
  	 12 - 15 16-bit indexable
  	 16 - 23 byte indexable
  	 24 - 31 compiled method"
  	self flag: #endianness.
  	^(self longAt: objOop) >> self formatShift bitAnd: self formatMask!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>storePointer:ofForwardedOrFreeObject:withValue: (in category 'heap management') -----
+ storePointer: fieldIndex ofForwardedOrFreeObject: objOop withValue: valuePointer
+ 
+ 	^self
+ 		longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ 		put: valuePointer!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') -----
  storePointer: fieldIndex ofObject: objOop withValue: valuePointer
  	"Note must check here for stores of young objects into old ones."
+ 	self assert: (self isForwarded: objOop) not.
  
  	(self isYoung: objOop) ifFalse: "most stores into young objects"
  		[(self isImmediate: valuePointer) ifFalse:
  			[(self isYoung: valuePointer) ifTrue:
  				[self possibleRootStoreInto: objOop value: valuePointer]]].
  
  	^self
  		longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
  		put: valuePointer!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') -----
+ storePointerUnchecked: fieldIndex ofObject: objOop withValue: valuePointer
+ 	self assert: (self isForwarded: objOop) not.
- storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
  	^self
+ 		longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
- 		longAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord)
  		put: valuePointer!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>fetchPointer:ofObject: (in category 'object access') -----
  fetchPointer: fieldIndex ofObject: objOop
+ 	self assert: (self isForwarded: objOop) not.
  	^self longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>formatOf: (in category 'object access') -----
  formatOf: objOop
  	"0 = 0 sized objects (UndefinedObject True False et al)
  	 1 = non-indexable objects with inst vars (Point et al)
  	 2 = indexable objects with no inst vars (Array et al)
  	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  	 4 = weak indexable objects with inst vars (WeakArray et al)
  	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 	 6 unused, reserved for exotic pointer objects?
+ 	 7 Forwarded Object, 1st field is pointer, rest of fields are ignored
+ 	 8 unused, reserved for exotic non-pointer objects?
- 	 6,7,8 unused
  	 9 (?) 64-bit indexable
  	 10 - 11 32-bit indexable
  	 12 - 15 16-bit indexable
  	 16 - 23 byte indexable
  	 24 - 31 compiled method"
  	^(self longLongAt: objOop) >> self formatShift bitAnd: self formatMask!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') -----
  storePointer: fieldIndex ofObject: objOop withValue: valuePointer
  	"Note must check here for stores of young objects into old ones."
+ 	self assert: (self isForwarded: objOop) not.
  
  	(self isYoung: objOop) ifFalse: "most stores into young objects"
  		[(self isImmediate: valuePointer) ifFalse:
  			[(self isYoung: valuePointer) ifTrue:
  				[self possibleRootStoreInto: objOop value: valuePointer]]].
  
  	^self
  		longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
  		put: valuePointer!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') -----
+ storePointerUnchecked: fieldIndex ofObject: objOop withValue: valuePointer
+ 	self assert: (self isForwarded: objOop) not.
- storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
  	^self
+ 		longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
- 		longLongAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord)
  		put: valuePointer!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeFutureSurvivorSpaceStartingAt: (in category 'scavenger') -----
  scavengeFutureSurvivorSpaceStartingAt: initialAddress
  	"scavengeFutureSurvivorSpaceStartingAt: does a depth-first traversal of the
  	 new objects starting at the one at initialAddress in futureSurvivorSpace."
  	| ptr |
  	ptr := initialAddress.
  	[ptr < futureSpace limit] whileTrue:
  		[| obj |
  		 obj := manager objectStartingAt: ptr.
  		 ptr := manager addressAfter: obj.
+ 		 (manager isForwarded: obj) ifTrue:
+ 			[obj := manager followForwarded: obj].
  		 self cCoerceSimple: (self scavengeReferentsOf: obj) to: #void]!

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 returns truth. If there are no new referents, it returns falsity."
  	| foundNewReferent |
+ 	"callers follow forwarding pointers from become:"
+ 	self assert: (manager isForwarded: referrer) not.
  	"manager isPointersNonImm: referrer) ifFalse:
  		[^false]."
  	foundNewReferent := false.
  	0 to: (manager numPointerSlotsOf: referrer) do:
  		[:i| | referent |
  		referent := manager fetchPointer: i ofObject: referrer.
+ 		self flag: 'should we follow forwarded objects in oldSpace?'.
  		((manager isNonImmediate: referent)
  		 and: [manager isYoung: referent]) ifTrue:
  			[foundNewReferent := true.
  			 (manager isForwarded: referent) ifFalse:
  				[self copyAndForward: referent].
  			 manager
  				storePointerUnchecked: i
  				ofObject: referrer
  				withValue: (manager forwardingPointerOf: referent)]].
  	^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 |
  		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 '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).
- 		[self storePointerUnchecked: 0 ofObject: 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.
- 		storePointerUnchecked: self freeChunkNextIndex ofObject: freeChunk withValue: 0;
- 		storePointerUnchecked: self freeChunkParentIndex ofObject: freeChunk withValue: 0;
- 		storePointerUnchecked: self freeChunkSmallerIndex ofObject: freeChunk withValue: 0;
- 		storePointerUnchecked: self freeChunkLargerIndex ofObject: 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 added:
+ ----- Method: SpurMemoryManager>>become:with:twoWay:copyHash: (in category 'become') -----
+ 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 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]].
+ 
+ 	coInterpreter preBecomeAction.
+ 	twoWayFlag
+ 		ifTrue:
+ 			[self innerBecomeObjectsIn: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag]
+ 		ifFalse:
+ 			[self innerBecomeObjectsIn: array1 to: array2 twoWay: twoWayFlag copyHash: copyHashFlag].
+ 	coInterpreter postBecomeAction: becommedPointerObjects.
+ 	becommedPointerObjects := false.
+ 
+ 	self leakCheckBecome ifTrue:
+ 		[self runLeakCheckerForFullGC: true].
+ 
+ 	^PrimNoErr "success"!

Item was changed:
  ----- Method: SpurMemoryManager>>classAtIndex: (in category 'class table') -----
  classAtIndex: classIndex
  	| classTablePage |
  	classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift
  							ofObject: classTableRootObj.
+ 	classTablePage = nilObj ifTrue:
+ 		[^nil].
  	^self
  		fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask)
  		ofObject: classTablePage!

Item was added:
+ ----- 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|
+ 		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>>containOnlyOops: (in category 'become') -----
+ containOnlyOops: array
+ 	"Answer if the array contains only non-immediates. You can't become: immediates!!"
+ 	| fieldOffset containsPointerObjs oop |
+ 	fieldOffset := self lastPointerOf: array.
+ 	containsPointerObjs := false.
+ 	"same size as array2"
+ 	[fieldOffset >= self baseHeaderSize] whileTrue:
+ 		[oop := self longAt: array + fieldOffset.
+ 		 (self isImmediate: oop) ifTrue: [^false].
+ 		 (self isForwarded: oop) ifTrue:
+ 			[oop := self followForwarded: oop.
+ 			 self longAt: array + fieldOffset put: oop].
+ 		 (self isPointersNonImm: oop) ifTrue:
+ 			[containsPointerObjs := true].
+ 		 fieldOffset := fieldOffset - BytesPerOop].
+ 	"only set becommedPointerObjects after checking all args."
+ 	containsPointerObjs ifTrue:
+ 		[becommedPointerObjects := true].
+ 	^true!

Item was added:
+ ----- Method: SpurMemoryManager>>containOnlyOops:and: (in category 'become') -----
+ containOnlyOops: array1 and: array2
+ 	"Answer if neither array contains only non-immediates. You can't become: immediates!!"
+ 	| fieldOffset containsPointerObjs oop |
+ 	fieldOffset := self lastPointerOf: array1.
+ 	containsPointerObjs := false.
+ 	"same size as array2"
+ 	[fieldOffset >= self baseHeaderSize] whileTrue:
+ 		[oop := self longAt: array1 + fieldOffset.
+ 		 (self isImmediate: oop) ifTrue: [^false].
+ 		 (self isForwarded: oop) ifTrue:
+ 			[oop := self followForwarded: oop.
+ 			 self longAt: array1 + fieldOffset put: oop].
+ 		 (self isPointersNonImm: oop) ifTrue:
+ 			[containsPointerObjs := true].
+ 		 oop := self longAt: array2 + fieldOffset.
+ 		 (self isImmediate: oop) ifTrue: [^false].
+ 		 (self isForwarded: oop) ifTrue:
+ 			[oop := self followForwarded: oop.
+ 			 self longAt: array2 + fieldOffset put: oop].
+ 		 (self isPointersNonImm: oop) ifTrue:
+ 			[containsPointerObjs := true].
+ 		 fieldOffset := fieldOffset - BytesPerOop].
+ 	"only set becommedPointerObjects after checking all args."
+ 	containsPointerObjs ifTrue:
+ 		[becommedPointerObjects := true].
+ 	^true!

Item was added:
+ ----- Method: SpurMemoryManager>>doBecome:with:copyHash: (in category 'become') -----
+ doBecome: obj1 with: obj2 copyHash: copyHashFlag
+ 	((self isClassInClassTable: obj1)
+ 	 or: [self isClassInClassTable: obj1]) ifTrue:
+ 		[self halt].
+ 	(self numSlotsOf: obj1) = (self numSlotsOf: obj2)
+ 		ifTrue:
+ 			[self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag]
+ 		ifFalse:
+ 			[self outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag]!

Item was added:
+ ----- Method: SpurMemoryManager>>followForwarded: (in category 'become') -----
+ followForwarded: objOop
+ 	| referent |
+ 	self assert: (self isForwarded: objOop).
+ 	referent := self fetchPointer: 0 ofForwardedOrFreeObject: objOop.
+ 	self assert: (self isForwarded: referent) not.
+ 	^referent!

Item was added:
+ ----- Method: SpurMemoryManager>>followMaybeForwarded: (in category 'become') -----
+ followMaybeForwarded: objOop
+ 	^(self isForwarded: objOop)
+ 		ifTrue: [self followForwarded: objOop]
+ 		ifFalse: [objOop]!

Item was changed:
  ----- Method: SpurMemoryManager>>formatOf: (in category 'object access') -----
  formatOf: objOop
  	"0 = 0 sized objects (UndefinedObject True False et al)
  	 1 = non-indexable objects with inst vars (Point et al)
  	 2 = indexable objects with no inst vars (Array et al)
  	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  	 4 = weak indexable objects with inst vars (WeakArray et al)
  	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 	 6 unused, reserved for exotic pointer objects?
+ 	 7 Forwarded Object, 1st field is pointer, rest of fields are ignored
+ 	 8 unused, reserved for exotic non-pointer objects?
- 	 6,7,8 unused
  	 9 (?) 64-bit indexable
  	 10 - 11 32-bit indexable
  	 12 - 15 16-bit indexable
  	 16 - 23 byte indexable
  	 24 - 31 compiled method"
  	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>forward:to: (in category 'become') -----
+ forward: obj1 to: obj2
+ 	self setFormatOf: obj1 to: self forwardedFormat.
+ 	self setClassIndexOf: obj1 to: self isForwardedObjectClassIndexPun.
+ 	self storePointer: 0 ofForwardedOrFreeObject: obj1 withValue: obj2!

Item was added:
+ ----- Method: SpurMemoryManager>>forwardedFormat (in category 'header format') -----
+ forwardedFormat
+ 	"A special format used by the GC to follow only the first pointer."
+ 	^7!

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

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

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

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

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

Item was added:
+ ----- Method: SpurMemoryManager>>inPlaceBecome:and:copyHashFlag: (in category 'become') -----
+ inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag
+ 	| headerTemp temp |
+ 	<var: 'headerTemp' type: #usqLong>
+ 	self assert: (self numSlotsOf: obj1) = (self numSlotsOf: obj2).
+ 	(self isRemembered: obj1)
+ 		ifTrue:
+ 			[(self isRemembered: obj1) ifFalse:
+ 				[scavenger
+ 					replace: obj1
+ 					inRememberedTableWith: obj2]]
+ 		ifFalse:
+ 			[(self isRemembered: obj2) ifTrue:
+ 				[scavenger
+ 					replace: obj2
+ 					inRememberedTableWith: obj1]].
+ 	headerTemp := self longLongAt: obj1.
+ 	self longLongAt: obj1 put: (self longLongAt: obj2).
+ 	self longLongAt: obj2 put: headerTemp.
+ 	copyHashFlag ifFalse: "undo hash copy"
+ 		[temp := self rawHashBitsOf: obj1.
+ 		 self setHashBitsOf: obj1 to: (self rawHashBitsOf: obj2).
+ 		 self setHashBitsOf: obj2 to: temp].
+ 	0 to: (self numSlotsOf: obj1) - 1 do:
+ 		[:i|
+ 		temp := self fetchPointer: i ofObject: obj1.
+ 		self storePointerUnchecked: i
+ 			ofObject: obj1
+ 			withValue: (self fetchPointer: i ofObject: obj2).
+ 		self storePointerUnchecked: i
+ 			ofObject: obj2
+ 			withValue: temp]!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0).
  	checkForLeaks := 0.
+ 	needGCFlag := signalLowSpace := becommedPointerObjects := false.
- 	needGCFlag := signalLowSpace := false.
  	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]!

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

Item was added:
+ ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:with:twoWay:copyHash: (in category 'become') -----
+ 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 added:
+ ----- Method: SpurMemoryManager>>isClassInClassTable: (in category 'become') -----
+ isClassInClassTable: objOop
+ 	| hash |
+ 	hash := self rawHashBitsOf: objOop.
+ 	hash = 0 ifTrue:
+ 		[false].
+ 	^(self classAtIndex: hash) = objOop!

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.
  	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"].
- 		^(self numSlotsOf: objOop) * BytesPerOop  "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!
- 	^numLiterals + LiteralStart * BytesPerOop!

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

Item was added:
+ ----- Method: SpurMemoryManager>>outOfPlaceBecome:and:copyHashFlag: (in category 'become') -----
+ outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag
+ 	"Allocate two new objects, n1 & n2.  Copy the contents appropriately. Convert
+ 	 obj1 and obj2 into forwarding objects pointing to n2 and n1 respectively"
+ 	| clone1 clone2 |
+ 	clone1 := (self isContextNonImm: obj1)
+ 				ifTrue: [coInterpreter cloneContext: obj1]
+ 				ifFalse: [self clone: obj1].
+ 	clone2 := (self isContextNonImm: obj2)
+ 				ifTrue: [coInterpreter cloneContext: obj2]
+ 				ifFalse: [self clone: obj2].
+ 	copyHashFlag
+ 		ifTrue:
+ 			[self setHashBitsOf: clone1 to: (self rawHashBitsOf: obj2).
+ 			 self setHashBitsOf: clone2 to: (self rawHashBitsOf: obj1)]
+ 		ifFalse:
+ 			[self setHashBitsOf: clone1 to: (self rawHashBitsOf: obj1).
+ 			 self setHashBitsOf: clone2 to: (self rawHashBitsOf: obj2)].
+ 	self
+ 		forward: obj1 to: clone2;
+ 		forward: obj2 to: clone1!

Item was added:
+ ----- Method: SpurMemoryManager>>setClassIndexOf:to: (in category 'header access') -----
+ setClassIndexOf: objOop to: classIndex
+ 	self flag: #endianness.
+ 	self longAt: objOop
+ 		put: ((self longAt: objOop) bitAnd: self classIndexMask bitInvert32)
+ 			+ classIndex!

Item was added:
+ ----- Method: SpurMemoryManager>>setFormatOf:to: (in category 'header access') -----
+ setFormatOf: objOop to: format
+ 	"0 = 0 sized objects (UndefinedObject True False et al)
+ 	 1 = non-indexable objects with inst vars (Point et al)
+ 	 2 = indexable objects with no inst vars (Array et al)
+ 	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 	 4 = weak indexable objects with inst vars (WeakArray et al)
+ 	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 	 6 unused, reserved for exotic pointer objects?
+ 	 7 Forwarded Object, 1st field is pointer, rest of fields are ignored
+ 	 8 unused, reserved for exotic non-pointer objects?
+ 	 9 (?) 64-bit indexable
+ 	 10 - 11 32-bit indexable
+ 	 12 - 15 16-bit indexable
+ 	 16 - 23 byte indexable
+ 	 24 - 31 compiled method"
+ 	self flag: #endianness.
+ 	self longAt: objOop
+ 		put: ((self longAt: objOop) bitAnd: (self formatMask << self formatShift) bitInvert32)
+ 			+ (format << self formatShift)!

Item was changed:
  ----- Method: SpurMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') -----
+ storePointerUnchecked: fieldIndex ofObject: objOop withValue: valuePointer
- storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
  	^self subclassResponsibility!

Item was added:
+ ----- Method: StackInterpreter>>followForwardingPointersInStackZone (in category 'object memory support') -----
+ followForwardingPointersInStackZone
+ 	"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 *'>
+ 
+ 	(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)]].
+ 			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ 				[theIPPtr := theFP + FoxCallerSavedIP.
+ 				 theFP := callerFP]]]!

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:
- 	 or: [(objectMemory isFreeObject: 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:
- 	fmt > 4 ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
  	objectMemory printHeaderTypeOf: oop.
  	self cr.
+ 	(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
- 	(fmt between: 5 and: 11) ifTrue:
  		[^self].
+ 	"this is nonsense.  apologies."
+ 	startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
+ 	lastIndex := 256 min: startIP.
- 	lastIndex := 256 min: (startIP := (objectMemory lastPointerOf: oop) / BytesPerWord).
  	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]).
- 			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theFP]).
  			 [theSP <= (theFP + FoxReceiver)] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory isIntegerObject: oop) ifFalse:
  					[stackPages longAt: theSP put: (objectMemory remap: oop)].
  				 theSP := theSP + BytesPerWord].
  			 (self frameHasContext: theFP) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory remap: (self frameContext: theFP))].
  			 theIPPtr ~= 0 ifTrue:
  				[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  				 theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
  			 stackPages
  				longAt: theFP + FoxMethod
  				put: (objectMemory remap: (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 isIntegerObject: oop) ifFalse:
  					[stackPages longAt: theSP put: (objectMemory remap: oop)].
  				 theSP := theSP + BytesPerWord]]]!

Item was removed:
- ----- Method: StackInterpreter>>postBecomeAction (in category 'object memory support') -----
- postBecomeAction
- 	"This is a noop in the StackInterpreter"!

Item was added:
+ ----- Method: StackInterpreter>>postBecomeAction: (in category 'object memory support') -----
+ postBecomeAction: updateReceiversInStackZone
+ 	updateReceiversInStackZone ifTrue:
+ 		[self followForwardingPointersInStackZone]!

Item was changed:
  ----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
  printOop: oop
  	| cls fmt lastIndex startIP bytecodesPerLine column |
  	<inline: false>
  	(objectMemory isImmediate: oop) ifTrue:
  		[^self shortPrintOop: oop].
  	self printHex: oop.
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  						ifTrue: [' is misaligned']
  						ifFalse: [' is not on the heap']); cr.
  		 ^nil].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr.
  		 ^nil].
+ 	(objectMemory isForwarded: oop) ifTrue:
+ 		[self
+ 			print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
+ 			print: ' of slot size '; printNum: (objectMemory numSlotsOf: oop); cr.
+ 		 ^nil].
  	self print: ': a(n) '.
  	self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
  	cls = (objectMemory splObj: ClassFloat) ifTrue:
  		[self cr; printFloat: (self dbgFloatValueOf: oop); cr.
  		 ^nil].
  	fmt := objectMemory formatOf: oop.
+ 	fmt > objectMemory lastPointerFormat ifTrue:
- 	fmt > 4 ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
  	self cr.
+ 	(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
- 	(fmt > 4 and: [fmt < 12]) ifTrue:
  		["This will answer false if splObj: ClassAlien is nilObject"
  		 (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
  			[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
  			self print: ((self isIndirectAlien: oop)
  							ifTrue: [' indirect @ ']
  							ifFalse:
  								[(self isPointerAlien: oop)
  									ifTrue: [' pointer @ ']
  									ifFalse: [' direct @ ']]).
  			 self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr.
  			 ^nil].
  		 (objectMemory isWords: oop) ifTrue:
  			[lastIndex := 64 min: ((objectMemory byteLengthOf: oop) / BytesPerWord).
  			 lastIndex > 0 ifTrue:
  				[1 to: lastIndex do:
  					[:index|
  					self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
  					(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  						[self cr]].
  				(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  					[self cr]].
  			^nil].
  		^self printStringOf: oop; cr].
+ 	"this is nonsense.  apologies."
+ 	startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
+ 	lastIndex := 256 min: startIP.
- 	lastIndex := 64 min: (startIP := (objectMemory lastPointerOf: oop) / BytesPerWord).
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:index|
  			self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
  				inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
  							 self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
  			(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  				[self cr]].
  		(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  			[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>>shortPrintOop: (in category 'debug printing') -----
  shortPrintOop: oop
  	<inline: false>
  	self printHex: oop.
  	(objectMemory isImmediate: oop) ifTrue:
  		[(objectMemory isImmediateCharacter: oop) ifTrue:
  			[^self
  				cCode: 'printf("=$%ld ($%c)\n", (long)characterValueOf(oop), (long)characterValueOf(oop))'
  				inSmalltalk: [self print: (self shortPrint: oop); cr]].
  		 ^self
  			cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
  			inSmalltalk: [self print: (self shortPrint: oop); cr]].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  						ifTrue: [' is misaligned']
  						ifFalse: [' is not on the heap']); cr.
  		 ^nil].
+ 	((objectMemory isFreeObject: oop)
+ 	 or: [objectMemory isForwarded: oop]) ifTrue:
+ 		[^self printOop: oop].
  	self print: ': a(n) '.
  	self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5.
  	self cr!

Item was changed:
  ----- Method: StackInterpreter>>validInstructionPointer:inMethod:framePointer: (in category 'debug support') -----
  validInstructionPointer: theInstrPointer inMethod: aMethod framePointer: fp
  	<var: #theInstrPointer type: #usqInt>
  	<var: #aMethod type: #usqInt>
  	<var: #fp type: #'char *'>
  	^self
  		cppIf: MULTIPLEBYTECODESETS
  		ifTrue:
  			[| methodHeader |
  			 methodHeader := self noAssertHeaderOf: aMethod. "-1 for pre-increment in fetchNextBytecode"
  			 theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + BaseHeaderSize - 1)
  			 and: [theInstrPointer < (aMethod + (objectMemory byteLengthOf: aMethod) + BaseHeaderSize - 1)
  			 and: ["If the method starts with a CallPrimitive opcode the instruction pointer should be past it."
  				((self headerIndicatesAlternateBytecodeSet: methodHeader)
  				and: [(self alternateHeaderHasPrimitiveFlag: methodHeader)
  				and: [theInstrPointer < (aMethod
  										+ BaseHeaderSize - 1
  										+ (objectMemory lastPointerOf: aMethod)
  										+ (self sizeOfCallPrimitiveBytecode: methodHeader) - 1)]])
  					not]]]
  		ifFalse: "-1 for pre-increment in fetchNextBytecode"
+ 			[theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod))
+ 			 and: [theInstrPointer < (aMethod + (objectMemory byteLengthOf: aMethod) + objectMemory baseHeaderSize - 1)]]!
- 			[theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + BaseHeaderSize - 1)
- 			 and: [theInstrPointer < (aMethod + (objectMemory byteLengthOf: aMethod) + BaseHeaderSize - 1)]]!

Item was added:
+ ----- Method: StackInterpreterSimulator>>primitiveNewWithArg (in category 'debugging traps') -----
+ primitiveNewWithArg
+ 	"(objectMemory hasSpurMemoryManagerAPI
+ 	 and: [self classNameOf: (self stackValue: 1) Is: 'MethodDictionary']) ifTrue:
+ 		[self halt]."
+ 	^super primitiveNewWithArg!



More information about the Vm-dev mailing list