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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 16 07:40:34 UTC 2013


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

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

Name: VMMaker.oscog-eem.381
Author: eem
Time: 16 September 2013, 12:35:23.439 am
UUID: 5428e835-7d04-4336-a9d0-3e7fe0de090e
Ancestors: VMMaker.oscog-eem.380

Fix bugs in SMemMgr bytesInObject: and startOfObject: that
mishandled objs with overflow sizes.

Mate scavenger to mapInterpreterOops by implementing
SMemMgr>>shouldRemapOop:/Obj: & remapObj:, marking remap:
as shouldNotImplement for debugging.

Remove memory inst var and add futureSurvivorStart to SGenScav.

Implement copyToFutureSpace:.

Add protocol that gets past first scavenge.

Reorder SGenScav>>scavenge to get tenuring threshold computed
before spaces are exchanged.

Send mapInterpreterOops in 1st iteration of  scavengeLoop.

Add following of oldSpace forwarded objects to scavengeReferentsOf:.

Hack addressCouldBeObj: until scavenger is solid.  Don't exclude
futureSpace objs for now.

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

Item was changed:
  ----- Method: CogClass>>cCoerceSimple:to: (in category 'translation support') -----
  cCoerceSimple: value to: cTypeString
  	"Type coercion for translation and simulation.
  	 For simulation answer a suitable surrogate for the struct types"
  	^cTypeString caseOf:
  	   {	[#'unsigned long']							->	[value].
  		[#sqInt]										->	[value].
  		[#usqInt]									->	[value].
  		[#'AbstractInstruction *']					->	[value].
  		[#'BytecodeFixup *']						->	[value].
  		[#'CogMethod *']							->	[value].
  		[#'char *']									->	[value].
  		[#'sqInt *']									->	[value].
  		[#'void *']									->	[value].
+ 		[#void]										->	[value].
  		[#'void (*)()']								->	[value].
  		[#'void (*)(void)']							->	[value].
  		[#'unsigned long (*)(void)']					->	[value].
  		[#'void (*)(unsigned long,unsigned long)']	->	[value] }!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>bytesInObject: (in category 'object enumeration') -----
  bytesInObject: objOop
  	"Answer the total number of bytes in an object including header and possible overflow size header."
  	| halfHeader headerNumSlots numSlots |
  	self flag: #endianness.
  	halfHeader := self longAt: objOop + 4.
  	headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask.
  	numSlots := headerNumSlots = self numSlotsMask
  					ifTrue: [self longAt: objOop - self baseHeaderSize]
+ 					ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]].
- 					ifFalse: [numSlots = 0 ifTrue: [1] ifFalse: [numSlots]].
  	^numSlots + (numSlots bitAnd: 1) << self shiftForWord
  	+ (headerNumSlots = self numSlotsMask
  		ifTrue: [self baseHeaderSize + self baseHeaderSize]
  		ifFalse: [self baseHeaderSize])!

Item was changed:
+ CogClass subclass: #SpurGenerationScavenger
+ 	instanceVariableNames: 'coInterpreter manager eden futureSpace pastSpace futureSurvivorStart rememberedSet rememberedSetSize tenuringThreshold tenuringProportion'
- VMClass subclass: #SpurGenerationScavenger
- 	instanceVariableNames: 'coInterpreter manager memory eden futureSpace pastSpace rememberedSet rememberedSetSize tenuringThreshold tenuringProportion'
  	classVariableNames: 'RememberedSetLimit RememberedSetRedZone'
  	poolDictionaries: ''
  	category: 'VMMaker-SpurMemoryManager'!

Item was added:
+ ----- Method: SpurGenerationScavenger>>computeTenuringThreshold (in category 'scavenger') -----
+ computeTenuringThreshold
+ 	| fractionSurvived |
+ 	<var: 'fractionSurvived' type: #float>
+ 	fractionSurvived := (futureSurvivorStart - futureSpace start) asFloat
+ 						/ (futureSpace limit - futureSpace start).
+ 	tenuringThreshold := fractionSurvived > 0.9
+ 							ifTrue: [((pastSpace limit - pastSpace start) * tenuringProportion) rounded + pastSpace start]
+ 							ifFalse: [0]!

Item was changed:
  ----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'scavenger') -----
  copyAndForward: survivor
  	"copyAndForward: survivor copies a survivor object either to
  	 futureSurvivorSpace or, if it is to be promoted, to oldSpace.
  	 It leaves a forwarding pointer behind."
+ 	<inline: true>
+ 	| bytesInObject newLocation |
+ 	bytesInObject := manager bytesInObject: survivor.
+ 	newLocation := ((self shouldBeTenured: survivor)
+ 					  or: [futureSurvivorStart + bytesInObject > futureSpace limit])
+ 						ifTrue: [self copyToOldSpace: survivor bytes: bytesInObject]
+ 						ifFalse: [self copyToFutureSpace: survivor bytes: bytesInObject].
+ 	manager forward: survivor to: newLocation.
+ 	^newLocation!
- 	| newLocation |
- 	newLocation := (self shouldBeTenured: survivor)
- 						ifTrue: [self copyToOldSpace: survivor]
- 						ifFalse: [self copyToFutureSpace: survivor].
- 	manager forward: survivor to: newLocation!

Item was added:
+ ----- Method: SpurGenerationScavenger>>copyToFutureSpace:bytes: (in category 'scavenger') -----
+ copyToFutureSpace: survivor bytes: bytesInObject
+ 	"Copy survivor to futureSpace.  Assume it will fit (checked by sender).
+ 	 Answer the new oop of the object (it may have an overflow size field)."
+ 	<inline: true>
+ 	| startOfSurvivor newStart |
+ 	self assert: futureSurvivorStart + bytesInObject <= futureSpace limit.
+ 	startOfSurvivor := manager startOfObject: survivor.
+ 	newStart := futureSurvivorStart.
+ 	futureSurvivorStart := futureSurvivorStart + bytesInObject.
+ 	manager mem: newStart cp: startOfSurvivor y: bytesInObject.
+ 	^newStart + (survivor - startOfSurvivor)!

Item was added:
+ ----- Method: SpurGenerationScavenger>>exchangeSurvivorSpaces (in category 'scavenger') -----
+ exchangeSurvivorSpaces
+ 	| temp |
+ 	temp := pastSpace.
+ 	pastSpace := futureSpace.
+ 	futureSpace := temp!

Item was added:
+ ----- Method: SpurGenerationScavenger>>initFutureSpaceStart (in category 'initialization') -----
+ initFutureSpaceStart
+ 	futureSurvivorStart := futureSpace start!

Item was changed:
  ----- Method: SpurGenerationScavenger>>initialize (in category 'initialization') -----
  initialize
  	rememberedSet := CArrayAccessor on: (Array new: RememberedSetLimit).
  	rememberedSetSize := 0.
+ 	tenuringThreshold := 0.
+ 	tenuringProportion := 0.9!
- 	tenuringThreshold := 0!

Item was removed:
- ----- Method: SpurGenerationScavenger>>manager:memory:newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
- manager: aSpurMemoryManager memory: memoryArray newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes 
- 	| edenBytes survivorBytes |
- 	manager := aSpurMemoryManager.
- 	memory := memoryArray.
- 	edenBytes := requestedEdenBytes.
- 	survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit.
- 	edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
- 	self assert: totalBytes - edenBytes - survivorBytes - survivorBytes < manager allocationUnit.
- 	"for tenuring we require older objects below younger objects.  since allocation
- 	 grows up this means that the survivor spaces must preceed eden."
- 	pastSpace := SpurNewSpaceSpace new.
- 	futureSpace := SpurNewSpaceSpace new.
- 	eden := SpurNewSpaceSpace new.
- 	pastSpace start: startAddress limit: startAddress + survivorBytes.
- 	futureSpace start: pastSpace limit limit: pastSpace limit + survivorBytes.
- 	eden start: futureSpace limit limit: futureSpace limit + edenBytes.
- 	self assert: futureSpace limit <= (startAddress + totalBytes).
- 	self assert: eden start \\ manager allocationUnit
- 				+ (eden limit \\ manager allocationUnit) = 0.
- 	self assert: pastSpace start \\ manager allocationUnit
- 				+ (pastSpace limit \\ manager allocationUnit) = 0.
- 	self assert: futureSpace start \\ manager allocationUnit
- 				+ (futureSpace limit \\ manager allocationUnit) = 0.
- 	self initPastSpaceForObjectEnumeration.
- 	manager initSpaceForAllocationCheck: eden!

Item was added:
+ ----- Method: SpurGenerationScavenger>>manager:newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
+ manager: aSpurMemoryManager newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes 
+ 	| edenBytes survivorBytes |
+ 	manager := aSpurMemoryManager.
+ 
+ 	edenBytes := requestedEdenBytes.
+ 	survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit.
+ 	edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
+ 	self assert: totalBytes - edenBytes - survivorBytes - survivorBytes < manager allocationUnit.
+ 
+ 	"for tenuring we require older objects below younger objects.  since allocation
+ 	 grows up this means that the survivor spaces must preceed eden."
+ 	pastSpace := SpurNewSpaceSpace new.
+ 	futureSpace := SpurNewSpaceSpace new.
+ 	eden := SpurNewSpaceSpace new.
+ 
+ 	pastSpace start: startAddress limit: startAddress + survivorBytes.
+ 	futureSpace start: pastSpace limit limit: pastSpace limit + survivorBytes.
+ 	eden start: futureSpace limit limit: futureSpace limit + edenBytes.
+ 
+ 	self assert: futureSpace limit <= (startAddress + totalBytes).
+ 	self assert: eden start \\ manager allocationUnit
+ 				+ (eden limit \\ manager allocationUnit) = 0.
+ 	self assert: pastSpace start \\ manager allocationUnit
+ 				+ (pastSpace limit \\ manager allocationUnit) = 0.
+ 	self assert: futureSpace start \\ manager allocationUnit
+ 				+ (futureSpace limit \\ manager allocationUnit) = 0.
+ 
+ 	self initFutureSpaceStart.
+ 	self initPastSpaceForObjectEnumeration.
+ 	manager initSpaceForAllocationCheck: eden!

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."
  
  	self scavengeLoop.
+ 	self computeTenuringThreshold.
+ 	self exchangeSurvivorSpaces.
+ 	self initFutureSpaceStart!
- 	self exchange: pastSpace with: futureSpace.
- 	self computeTenuringThreshold!

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 obj |
- 	| ptr |
  	ptr := initialAddress.
+ 	[ptr < futureSurvivorStart] whileTrue:
+ 		[obj := manager objectStartingAt: ptr.
- 	[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>>scavengeLoop (in category 'scavenger') -----
  scavengeLoop
  	"This is the inner loop of the main routine, scavenge.  It first scavenges the new objects immediately
  	 reachable from old ones. 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 previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as
  	 detecting closure.  If this were not true, some pointers might get forwarded twice."
  
+ 	| firstTime previousRememberedSetSize previousFutureSurvivorStart |
+ 	self assert: futureSurvivorStart = futureSpace start. "future space should be empty at the start"
+ 	firstTime := true.
- 	| firstTime previousRememberedSetSize previousFutureSurvivorSpaceLimit |
- 	self assert: futureSpace limit = futureSpace start. "future space should be empty at the start"
  	previousRememberedSetSize := 0.
+ 	previousFutureSurvivorStart := futureSurvivorStart.
- 	previousFutureSurvivorSpaceLimit := futureSpace limit.
  	[self scavengeRememberedSetStartingAt: previousRememberedSetSize.
+ 	 previousFutureSurvivorStart = futureSurvivorStart ifTrue:
- 	 previousFutureSurvivorSpaceLimit = futureSpace limit ifTrue:
  		[^self].
+ 	 previousRememberedSetSize := rememberedSetSize.
  
  	firstTime ifTrue:
  		[coInterpreter mapInterpreterOops.
  		 firstTime := false].
+ 	 self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorStart.
+ 	 previousFutureSurvivorStart = rememberedSetSize ifTrue:
- 
- 	 previousRememberedSetSize := rememberedSetSize.
- 	 self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorSpaceLimit.
- 	 previousFutureSurvivorSpaceLimit = rememberedSetSize ifTrue:
  		[^self].
  
+ 	 previousFutureSurvivorStart := futureSurvivorStart] repeat!
- 	 previousFutureSurvivorSpaceLimit := futureSpace size] repeat!

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."
- 	 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) - 1 do:
+ 		[:i| | referent newLocation |
- 	0 to: (manager numPointerSlotsOf: referrer) do:
- 		[:i| | referent |
  		referent := manager fetchPointer: i ofObject: referrer.
+ 		(manager isNonImmediate: referent) ifTrue:
+ 			[(manager isYoung: referent)
+ 				ifTrue:
+ 					[foundNewReferent := true.
+ 					 (manager isForwarded: referent)
+ 						ifTrue: [newLocation := manager followForwarded: referent]
+ 						ifFalse: [newLocation := self copyAndForward: referent].
+ 					 manager storePointerUnchecked: i ofObject: referrer withValue: newLocation]
+ 				ifFalse:
+ 					[(manager isForwarded: referent) ifTrue:
+ 						[newLocation := manager followForwarded: referent.
+ 						 manager storePointerUnchecked: i ofObject: referrer withValue: newLocation]]]].
- 		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: SpurMemoryManager>>addressCouldBeObj: (in category 'debug support') -----
+ addressCouldBeObj: address
+ 	self flag: #temporary. "include futureSpace for now (while debugging the scavenger)"
- addressCouldBeObj: address 
  	^(address bitAnd: self baseHeaderSize - 1) = 0
  	  and: [(self isInOldSpace: address)
+ 		or: [(address between: startOfMemory and: newSpaceLimit)
+ 		or: (self isInEden: address)
- 		or: [(self isInEden: address)
  		or: [self isInSurvivorSpace: address]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:codeSize: (in category 'simulation') -----
  allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes codeSize: codeBytes
  	"Intialize the receiver for bootsraping an image.
  	 Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold
  	 to allocate in oldSpace.  Later on (in initializePostBootstrap) freeStart and scavengeThreshold
  	 will be set to sane values."
  	<doNotGenerate>
  	self assert: (memoryBytes \\ self allocationUnit = 0
  				and: [newSpaceBytes \\ self allocationUnit = 0
  				and: [codeBytes \\ self allocationUnit = 0]]).
  	memory := (self endianness == #little
  					ifTrue: [LittleEndianBitmap]
  					ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes) // 4.
  	startOfMemory := codeBytes.
  	endOfMemory := memoryBytes + newSpaceBytes + codeBytes.
  	"leave newSpace empty for the bootstrap"
  	freeStart := newSpaceBytes + startOfMemory.
  	newSpaceLimit := newSpaceBytes + startOfMemory.
  	scavengeThreshold := memory size * 4. "Bitmap is a 4-byte per word array"
  	scavenger := SpurGenerationScavenger new
  					manager: self
- 					memory: memory
  					newSpaceStart: startOfMemory
  					newSpaceBytes: newSpaceBytes
  					edenBytes: newSpaceBytes * 5 // 7 "David's paper uses 140Kb eden + 2 x 28kb survivor spaces :-)"!

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

Item was added:
+ ----- Method: SpurMemoryManager>>mem:cp:y: (in category 'simulation') -----
+ mem: destAddress cp: sourceAddress y: bytes
+ 	"For SpurGenerationScavenger>>copyToFutureSpace:bytes:"
+ 	<doNotGenerate>
+ 	^self mem: destAddress mo: sourceAddress ve: bytes!

Item was added:
+ ----- Method: SpurMemoryManager>>oopOfObjectStartingAt: (in category 'object enumeration') -----
+ oopOfObjectStartingAt: address
+ 	"Answer the oop of the memory chunk starting at address, which is either the address
+ 	 of the overflow size word, or objOop itself, depending on the size of the object."
+ 	self flag: #endianness.
+ 	^(self longAt: address) >> self numSlotsHalfShift = self numSlotsMask
+ 		ifTrue: [address + self baseHeaderSize]
+ 		ifFalse: [address]!

Item was added:
+ ----- Method: SpurMemoryManager>>remap: (in category 'garbage collection') -----
+ remap: oop
+ 	self shouldNotImplement!

Item was changed:
  ----- Method: SpurMemoryManager>>remapObj: (in category 'generation scavenging') -----
  remapObj: objOop
+ 	"Scavenge objOop.  Answer the new location of objOop.  Call should have been guarded by
+ 	 a send of shouldRemapOop: or shouldScavengeObj:.. The method is called remapObj: for
+ 	 compatibility with ObjectMemory."
  	<inline: false>
+ 	(self isForwarded: objOop) ifTrue:
+ 		[^self followForwarded: objOop].
+ 	^scavenger copyAndForward: objOop!
- 	^self followForwarded: objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>shouldRemapObj: (in category 'generation scavenging') -----
  shouldRemapObj: objOop
+ 	"Answer if the obj should be scavenged. The method is called
+ 	 shouldRemapObj: for compatibility with ObjectMemory."
+ 	^self isYoung: objOop!
- 	^self isForwarded: objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>shouldRemapOop: (in category 'generation scavenging') -----
  shouldRemapOop: oop
  	<api>
+ 	"Answer if the oop should be scavenged.. The method is called
+ 	 shouldRemapOop: for compatibility with ObjectMemory."
- 	"Answer if the oop should be remapped"
  	<inline: true>
  	^(self isNonImmediate: oop)
+ 	   and: [self shouldRemapObj: oop]!
- 	   and: [self isForwarded: oop]!

Item was added:
+ ----- Method: SpurMemoryManager>>startOfObject: (in category 'object enumeration') -----
+ startOfObject: objOop
+ 	"Answer the start of objOop, which is either the address of the overflow size word,
+ 	 or objOop itself, depending on the size of the object."
+ 	^(self numSlotsOf: objOop) >= self numSlotsMask
+ 		ifTrue: [objOop - self baseHeaderSize]
+ 		ifFalse: [objOop]!

Item was changed:
  ----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'generation scavenging') -----
  sufficientSpaceAfterGC: numBytes
+ 	"This is ObjectMemory's funky entry-point into its incremental GC,
- 	"This is ObjectMemoiry'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.
+ 	needGCFlag := false.
+ 	scavenger scavenge.
+ 	freeStart := scavenger eden start.
+ 	self initSpaceForAllocationCheck: scavenger eden.
+ 	^true!
- 	scavenger scavenge!

Item was changed:
  ----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
  mapInterpreterOops
  	"Map all oops in the interpreter's state to their new values 
  	 during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
  	self mapStackPages.
  	self mapMachineCode.
  	self mapTraceLogs.
  	self mapVMRegisters.
  	self mapProfileState.
  	self remapCallbackState.
+ 	(tempOop ~= 0
+ 	 and: [objectMemory shouldRemapOop: tempOop]) ifTrue:
+ 		[tempOop := objectMemory remapObj: tempOop]!
- 	tempOop = 0 ifFalse: [tempOop := objectMemory remap: tempOop]!



More information about the Vm-dev mailing list