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

commits at source.squeak.org commits at source.squeak.org
Fri May 9 20:51:32 UTC 2014


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

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

Name: VMMaker.oscog-eem.710
Author: eem
Time: 9 May 2014, 1:48:04.592 pm
UUID: 4941dccb-3db2-4b61-ab4e-55a912e9093b
Ancestors: VMMaker.oscog-eem.709

Spur:
Move running of leak checker (which computes the leak map)
to markObjects from clients and hence cure assert failures
during GC in the Cogit.

Revise unmarking and mapping during
eliminateAndFreeForwardersForPigCompact.  Instead of
a scavenge merely mapInterpreterOops and explicitly
(via added) unmarkSurvivingObjectsForPigCompact.

Fix slip in fUOASACFSFPC.

Fix remapObj: to not copyAndForward: unless a scavenge
is in progress.

With these changes the Newspeak bootstrap runs to
completion on the NS Spur Cog VM.

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

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
+ 	self halt: 'GC number ', statFullGCs printString.
- 	self halt.
  	^super globalGarbageCollect!

Item was changed:
  ----- Method: SpurMemoryManager>>allInstancesOf: (in category 'primitive support') -----
  allInstancesOf: aClass
  	"Attempt to answer an array of all objects, excluding those that may
  	 be garbage collected as a side effect of allocating the result array.
  	 If no memory is available answer the number of instances as a SmallInteger.
  	 Since objects are at least 16 bytes big, and the largest SmallInteger covers
  	 1/4 of the address space, the count can never overflow."
  	| classIndex freeChunk ptr start limit count bytes |
  	classIndex := self rawHashBitsOf: aClass.
  	(classIndex = 0
  	 or: [aClass ~~ (self classOrNilAtIndex: classIndex)]) ifTrue:
  		[freeChunk := self allocateSlots: 0 format: self arrayFormat classIndex: ClassArrayCompactIndex.
  		 ^freeChunk].
- 	self runLeakCheckerForFullGC: false.
  	self markObjects. "don't want to revive objects unnecessarily."
  	freeChunk := self allocateLargestFreeChunk.
  	ptr := start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	count := 0.
  	self allHeapEntitiesDo:
  		[:obj| "continue enumerating even if no room so as to unmark all objects."
  		 (self isMarked: obj) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
  					[self setIsMarkedOf: obj to: false.
  					 (self classIndexOf: obj) = classIndex ifTrue:
  					 	[count := count + 1.
  						 ptr < limit ifTrue:
  							[self longAt: ptr put: obj.
  							 ptr := ptr + self bytesPerSlot]]]
  				ifFalse:
  					[(self isSegmentBridge: obj) ifFalse:
  						[self setIsMarkedOf: obj to: false]]]].
  	self assert: self allObjectsUnmarked.
  	self assert: (self isEmptyObjStack: markStack).
  	self emptyObjStack: weaklingStack.
  	(count > (ptr - start / self bytesPerSlot) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeObject: freeChunk.
  		 ^self integerObjectOf: count].
  	count < self numSlotsMask ifTrue:
  		[| smallObj |
  		 smallObj := self allocateSlots: count format: self arrayFormat classIndex: ClassArrayCompactIndex.
  		 0 to: count - 1 do:
  			[:i|
  			self storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofObject: freeChunk)].
  		 self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
  		 self beRootIfOld: smallObj.
  		 self checkFreeSpace.
  		 ^smallObj].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
  	self setOverflowNumSlotsOf: freeChunk to: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	self possibleRootStoreInto: freeChunk.
  	self checkFreeSpace.
  	self runLeakCheckerForFullGC: false.
  	^freeChunk
  	
  	!

Item was changed:
  ----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') -----
  allObjects
  	"Attempt to answer an array of all objects, excluding those that may
  	 be garbage collected as a side effect of allocating the result array.
  	 If no memory is available answer the number of objects as a SmallInteger.
  	 Since objects are at least 16 bytes big, and the largest SmallInteger covers
  	 1/4 of the address space, the count can never overflow."
  	| freeChunk ptr start limit count bytes |
- 	self runLeakCheckerForFullGC: false.
  	self markObjects. "don't want to revive objects unnecessarily."
  	freeChunk := self allocateLargestFreeChunk.
  	ptr := start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	count := 0.
  	self allHeapEntitiesDo:
  		[:obj| "continue enumerating even if no room so as to unmark all objects."
  		 (self isMarked: obj) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
  					[self setIsMarkedOf: obj to: false.
  					 count := count + 1.
  					 ptr < limit ifTrue:
  						[self longAt: ptr put: obj.
  						 ptr := ptr + self bytesPerSlot]]
  				ifFalse:
  					[(self isSegmentBridge: obj) ifFalse:
  						[self setIsMarkedOf: obj to: false]]]].
  	self assert: self allObjectsUnmarked.
  	self assert: (self isEmptyObjStack: markStack).
  	self emptyObjStack: weaklingStack.
  	self assert: count >= self numSlotsMask.
  	(count > (ptr - start / self bytesPerSlot) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
  		 self checkFreeSpace.
  		 ^self integerObjectOf: count].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
  	self setOverflowNumSlotsOf: freeChunk to: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	self possibleRootStoreInto: freeChunk.
  	self checkFreeSpace.
  	self runLeakCheckerForFullGC: false.
  	^freeChunk
  	
  	!

Item was changed:
  ----- Method: SpurMemoryManager>>eliminateAndFreeForwardersForPigCompact (in category 'gc - global') -----
  eliminateAndFreeForwardersForPigCompact
  	"As the final phase of global garbage collect, sweep the heap to follow
  	 forwarders, then free forwarders, coalescing with free space as we go."
  	<inline: false>
  	| lowestForwarder |
  	self assert: (self isForwarded: nilObj) not.
  	self assert: (self isForwarded: falseObj) not.
  	self assert: (self isForwarded: trueObj) not.
  	self assert: (self isForwarded: self freeListsObj) not.
  	self assert: (self isForwarded: hiddenRootsObj) not.
  	self assert: (self isForwarded: classTableFirstPage) not.
  	self followSpecialObjectsOop.
- 	"N.B. we don't have to explicitly do mapInterpreterOops since the scavenge below
- 	 will do it, except that scavenging maps only young references in machine code."
  	self followForwardedObjStacks.
+ 	coInterpreter mapInterpreterOops.
  	scavenger followRememberedForwardersAndForgetFreeObjectsForPigCompact.
+ 	self unmarkSurvivingObjectsForPigCompact.
- 	"Because of the flushEden before markObjects the scavenge /should not/
- 	 tenure. In fact it must not because the free list has not been rebuilt, so
- 	 there is no space, and any attempt to tenure will allocate a new segment."
- 	totalFreeOldSpace := 0.
- 	self doScavenge: DontTenureButDoUnmark.
- 	self assert: totalFreeOldSpace = 0.
- 	coInterpreter mapMachineCode: GCModeFull.
  	lowestForwarder := self sweepToFollowForwardersForPigCompact.
  	self sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompactFrom: lowestForwarder.
  	self checkFreeSpace.
  	self assert: self numberOfForwarders = 0!

Item was changed:
  ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact (in category 'gc - global') -----
  freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact
  	"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
  
  	 Doubly-link the free chunks in address order through the freeChunkNextIndex field using the
  	 xor trick to use only one field, see e.g.
  		The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18
  		http://en.wikipedia.org/wiki/XOR_linked_list.
  	 Record the lowest free object in firstFreeChunk and the highest in lastFreeChunk.
  
  	 Let the segmentManager mark which segments contain pinned objects via notePinned:."
  
  	| prevPrevFree prevFree |
  	<inline: false>
  	self checkFreeSpace.
- 	"Using pigCompact we scavenge to unmark objects before the free list has been
- 	 rebuilt, and that scavenge must not tenure.  So get tenuring out of the way now."
  	scavenger forgetUnmarkedRememberedObjects.
+ 	self doScavenge: MarkOnTenure.
- 	self self doScavenge: MarkOnTenure.
  	segmentManager prepareForGlobalSweep."for notePinned:"
  	"throw away the list heads, including the tree."
  	self resetFreeListHeads.
  	firstFreeChunk := prevPrevFree := prevFree := 0.
  	self allOldSpaceEntitiesForCoalescingDo:
  		[:o|
  		 self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
  		 (self isMarked: o)
  			ifTrue: "forwarders should have been followed in markAndTrace:"
  				[self assert: (self isForwarded: o) not.
  				 self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
  				 (self isPinned: o) ifTrue:
  					[segmentManager notePinned: o]]
  			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
  				[| here |
  				 self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
  				 here := self coallesceFreeChunk: o.
  				 self setObjectFree: here.
  				 self inSortedFreeListLink: prevFree to: here given: prevPrevFree.
  				 prevPrevFree := prevFree.
  				 prevFree := here]].
  	prevFree ~= firstFreeChunk ifTrue:
  		[self storePointer: self freeChunkNextIndex
  			ofFreeChunk: prevFree
  			withValue: prevPrevFree].
  	lastFreeChunk := prevFree.
  	self cCode: [] inSmalltalk: [self checkTraversableSortedFreeList]!

Item was changed:
  ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
- 	self runLeakCheckerForFullGC: true.
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  
  	self markObjects.
  	self expungeDuplicateAndUnmarkedClasses: true.
  	self nilUnmarkedWeaklingSlots.
  	self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace.
  
  	"Mid-way the leak check must be more lenient.  Unmarked classes will have been
  	 expunged from the table, but unmarked instances will not yet have been reclaimed."
  	self runLeakCheckerForFullGC: true
  		excludeUnmarkedNewSpaceObjs: true
  		classIndicesShouldBeValid: true.
  
  	"At least for pigCompact it is worth repeating these two phases to get better compaction,
  	 for example during snapshot.  In which case the code needs to be reorganized to not
  	 rebuild the free list after compact, but instead just coallesce, and maintain the sorted free
  	 list until compaction has been repeated sufficiently (an experiment showed no improvement
  	 after 3 repetitions, but a useful gain of ~ 200k in a small image on the third iteration."
  	self flag: 'future work'.
  	self compact.
  	self eliminateAndFreeForwarders.
  
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  	self assert: self allObjectsUnmarked.
  	self runLeakCheckerForFullGC: true!

Item was changed:
  ----- Method: SpurMemoryManager>>markObjects (in category 'gc - global') -----
  markObjects
  	<inline: false>
  	"Mark all accessible objects."
  	"If the incremental collector is running mark bits may be set; stop it and clear them if necessary."
  	self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'marking...'; flush].
+ 	self runLeakCheckerForFullGC: true.
+ 
  	self ensureAllMarkBitsAreZero.
  	self ensureAdequateClassTableBitmap.
  	self initializeUnscannedEphemerons.
  	self initializeMarkStack.
  	self initializeWeaklingStack.
  	self markAccessibleObjects!

Item was changed:
  ----- Method: SpurMemoryManager>>remapObj: (in category 'gc - scavenging') -----
  remapObj: objOop
+ 	"Scavenge or simply follow objOop.  Answer the new location of objOop.
+ 	 The send should have been guarded by a send of shouldRemapOop:.
- 	"Scavenge or simply follow objOop.  Answer the new location of objOop.  The
- 	 send should have been guarded by a send of shouldRemapOop: or shouldScavengeObj:.
  	 The method is called remapObj: for compatibility with ObjectMemory."
  	<api>
  	<inline: false>
  	| resolvedObj |
  	self assert: (self shouldRemapOop: objOop).
  	(self isForwarded: objOop)
  		ifTrue:
  			[resolvedObj := self followForwarded: objOop.
  			(self isInFutureSpace: resolvedObj) ifTrue: "already scavenged"
  				[^resolvedObj]]
  		ifFalse:
  			[resolvedObj := objOop].
+ 	(scavengeInProgress
+ 	 and: [self isReallyYoung: resolvedObj]) ifFalse: "a becommed or compacted object whose target is in old space, or a CogMethod."
- 	(self isReallyYoung: resolvedObj) ifFalse: "a becommed or compacted object whose target is in old space, or a CogMethod."
  		[^resolvedObj].
  	^scavenger copyAndForward: resolvedObj!

Item was added:
+ ----- Method: SpurMemoryManager>>unmarkSurvivingObjectsForPigCompact (in category 'gc - global') -----
+ unmarkSurvivingObjectsForPigCompact
+ 	self allPastSpaceObjectsDo:
+ 		[:objOop|
+ 		(self isMarked: objOop) ifTrue:
+ 			[self setIsMarkedOf: objOop to: false]]!



More information about the Vm-dev mailing list