Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.697.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.697 Author: eem Time: 2 May 2014, 1:30:27.626 pm UUID: af7829f5-a388-4a1e-8c9b-5b78abd46b67 Ancestors: VMMaker.oscog-eem.696
Spur pig compact: Fix a bug in free list enumeration in pigCompact. sortedFreeListPairwiseReverseDo: must cope with the case where moving s run of objects alters the free list.
Fix a bug in moveARunOfObjectsStartingAt:upTo: which would not move the first object if it was the only object in a run.
Fix a bug in freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact which could leave a free object with a 0 slot count, which falls foul of the object enumeration invariant that a header word must be all zeros (for catching wild missteps).
Fix a bug in sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact which would cause it to miss lots of forwarders.
VMMaker: Update generateAllSpurConfigurations to include Spur Cog Sista.
=============== Diff against VMMaker.oscog-eem.696 ===============
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> 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." self followForwardedObjStacks. scavenger followRememberedForwardersAndForgetFreeObjectsForPigCompact. self doScavenge: DontTenureButDoUnmark. self sweepToFollowForwardersForPigCompact. self sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact. + self checkFreeSpace. + self assert: self numberOfForwarders = 0! - self checkFreeSpace!
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. scavenger forgetUnmarkedRememberedObjects. 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 setFree: 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>>isMobileObjectHeader: (in category 'object enumeration') ----- isMobileObjectHeader: objHeader "Answer if an object with header objHeader should be moved during compaction. Non-objects (free chunks & bridges), forwarders and pinned objects are excluded." <inline: true> + ^(objHeader >> self pinnedBitShift bitAnd: 1) = 0 + and: [(self classIndexOfHeader: objHeader) > self isForwardedObjectClassIndexPun]! - ^(objHeader >> self pinnedBitShift bitAnd: 1) ~= 0 - ifTrue: [false] - ifFalse: [(self classIndexOfHeader: objHeader) > self isForwardedObjectClassIndexPun]!
Item was changed: ----- Method: SpurMemoryManager>>moveARunOfObjectsStartingAt:upTo: (in category 'compaction') ----- moveARunOfObjectsStartingAt: startAddress upTo: limit "Move the sequence of movable objects starting at startAddress. Answer the start of the next sequence of movable objects after a possible run of unmovable objects, or the limit, if there are no more movable objects, or 0 if no more compaction can be done. Compaction is done when the search through the freeList has reached the address from which objects are being moved from.
There are two broad cases to be dealt with here. One is a run of smallish objects that can easily be moved into free chunks. The other is a large object that is unlikely to fit in the typical free chunk. This second pig needs careful handling; it needs to be moved to the lowest place it will fit and not cause the scan to skip lots of smaller free chunks looking in vain for somewhere to put it." + | here hereObj hereObjHeader prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk | - | here prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk | here := startAddress. + hereObj := self objectStartingAt: startAddress. + hereObjHeader := self atLeastClassIndexHalfHeader: hereObj. prevPrevFreeChunk := prevFreeChunk := 0. thisFreeChunk := maxFreeChunk := firstFreeChunk. [thisFreeChunk ~= 0] whileTrue: + [| freeBytes endOfFree nextFree destination there moved | - [| freeBytes endOfFree nextFree destination hereObj hereObjHeader there moved |
+ [(self isMobileObjectHeader: hereObjHeader)] whileFalse: - [hereObj := self objectStartingAt: here. - hereObjHeader := self atLeastClassIndexHalfHeader: hereObj. - (self isMobileObjectHeader: hereObjHeader)] whileFalse: [here := self addressAfter: hereObj. here >= limit ifTrue: + [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [limit]]. + hereObj := self objectStartingAt: here. + hereObjHeader := self atLeastClassIndexHalfHeader: hereObj]. - [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [limit]]].
freeBytes := self bytesInObject: thisFreeChunk. nextFree := self nextInSortedFreeListLink: thisFreeChunk given: prevFreeChunk. destination := self startOfObject: thisFreeChunk. endOfFree := destination + freeBytes. moved := false. maxFreeChunk := maxFreeChunk max: nextFree.
"move as many objects as will fit in freeBytes..." [there := self addressAfter: hereObj. (self isMobileObjectHeader: hereObjHeader) and: [there - here < (freeBytes - self allocationUnit) or: [there - here = freeBytes]]] whileTrue: [moved := true. self mem: destination cp: here y: there - here. self forward: hereObj to: destination + (hereObj - here). destination := destination + (there - here). freeBytes := freeBytes - (there - here). hereObj := self objectStartingAt: there. here := there. hereObjHeader := self atLeastClassIndexHalfHeader: hereObj].
moved ifTrue: "need to repair the free list" [| nextNextFree | nextFree ~= 0 ifTrue: [nextNextFree := self nextInSortedFreeListLink: nextFree given: thisFreeChunk]. (destination > thisFreeChunk "if false couldn't move anything" and: [destination < endOfFree]) "if false, filled entire free chunk" ifTrue: [thisFreeChunk := self initFreeChunkWithBytes: endOfFree - destination at: destination. self inSortedFreeListLink: prevFreeChunk to: thisFreeChunk given: prevPrevFreeChunk. self inSortedFreeListLink: thisFreeChunk to: nextFree given: prevFreeChunk. nextFree ~= 0 ifTrue: [self inSortedFreeListLink: nextFree to: nextNextFree given: thisFreeChunk]. prevPrevFreeChunk := prevFreeChunk. prevFreeChunk := thisFreeChunk. thisFreeChunk := nextFree] ifFalse: [self inSortedFreeListLink: prevFreeChunk to: nextFree given: prevPrevFreeChunk. nextFree ~= 0 ifTrue: [self inSortedFreeListLink: nextFree to: nextNextFree given: prevFreeChunk. thisFreeChunk := nextFree]]. "self checkTraversableSortedFreeList"] ifFalse: "out of space (or immobile object); move on up the free list..." [prevPrevFreeChunk := prevFreeChunk. prevFreeChunk := thisFreeChunk. thisFreeChunk := nextFree].
(self isMobileObjectHeader: hereObjHeader) ifFalse: [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]].
"Was the loop stopped by a pig? If so, try and find space for it" there - here >= (self averageObjectSizeInBytes * 8) ifTrue: "256b in 32 bit, 512b in 64 bit" [| usedChunk | usedChunk := self tryToMovePig: hereObj at: here end: there. "if it couldn't be moved we need to advance, so always set here to there whether the pig was moved or not." + hereObj := self objectStartingAt: there. here := there. + hereObjHeader := self atLeastClassIndexHalfHeader: hereObj. "In general it's a bad idea to reset the enumeration; it leads to N^2 behaviour when encountering pigs. But if the move affected the enumeration this is simpler than resetting the list pointers." (usedChunk = prevPrevFreeChunk or: [usedChunk = prevFreeChunk or: [usedChunk = thisFreeChunk]]) ifTrue: "a bad idea; leads to N^2 behaviour when encountering pigs" ["reset the scan for free space back to the start of the list" prevPrevFreeChunk := prevFreeChunk := 0. thisFreeChunk := firstFreeChunk]].
+ ((here > startAddress and: [there >= limit]) - (there >= limit or: [maxFreeChunk >= startAddress]) ifTrue: [^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]].!
Item was added: + ----- Method: SpurMemoryManager>>noForwardersBelowFirstFreeChunk (in category 'gc - global') ----- + noForwardersBelowFirstFreeChunk + self allOldSpaceEntitiesDo: + [:o| + o >= firstFreeChunk ifTrue: + [^true]. + (self isForwarded: o) ifTrue: + [^false]]. + ^true!
Item was added: + ----- Method: SpurMemoryManager>>numberOfForwarders (in category 'debug support') ----- + numberOfForwarders + | n | + n := 0. + self allHeapEntitiesDo: + [:o| + (self isForwarded: o) ifTrue: + [n := n + 1]]. + ^n!
Item was changed: ----- Method: SpurMemoryManager>>pigCompact (in category 'compaction') ----- pigCompact "Traverse the sorted free list, moving objects from the high-end of memory to the free objects in the low end of memory. Return when the address at which objects are being copiecd to meets the address from which objects are being copied from." self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'pig compacting...'; flush]. self sortedFreeListPairwiseReverseDo: [:low :high| | scanAddress | + self cCode: '' inSmalltalk: [coInterpreter transcript nextPut: $.; flush]. scanAddress := self addressAfter: low. [scanAddress < high] whileTrue: [scanAddress := self moveARunOfObjectsStartingAt: scanAddress upTo: high. scanAddress = 0 ifTrue: [^self]]]!
Item was added: + ----- Method: SpurMemoryManager>>printFreeTree (in category 'debug printing') ----- + printFreeTree + <api> + self printFreeTree: (freeLists at: 0)!
Item was added: + ----- Method: SpurMemoryManager>>printFreeTree: (in category 'debug printing') ----- + printFreeTree: chunkOrZero + chunkOrZero > 0 ifTrue: + [self printFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofObject: chunkOrZero). + self printFreeChunk: chunkOrZero. + self printFreeTree: (self fetchPointer: self freeChunkLargerIndex ofObject: chunkOrZero)]!
Item was added: + ----- Method: SpurMemoryManager>>setObjectFree: (in category 'free space') ----- + setObjectFree: objOop + "Mark an object free, but do not add it to the free lists. The wrinkle here + is that we don't tolerate a zero-slot count in a free object so that the + (self long64At: objOop) ~= 0 assert in isEnumerableObject: isn't triggered." + + (self rawNumSlotsOf: objOop) = 0 ifTrue: + [self setRawNumSlotsOf: objOop to: 1]. + self setFree: objOop!
Item was changed: ----- Method: SpurMemoryManager>>sortedFreeListPairwiseReverseDo: (in category 'compaction') ----- sortedFreeListPairwiseReverseDo: aBinaryBlock "Evaluate aBinaryBlock with adjacent entries in the free list, from high address to low address. The second argument is in fact the start of the next free chunk, not the free chunk itself. Use endOfMemory - bridgeSize as the second argument in the first evaluation." + | free nextFree prevFree prevPrevFree | - | free prevFree nextFree | free := lastFreeChunk. + prevPrevFree := prevFree := 0. - prevFree := 0. [free ~= 0] whileTrue: [nextFree := self nextInSortedFreeListLink: free given: prevFree. + self assert: (free = 0 or: [self isFreeObject: free]). - self assert: (nextFree = 0 or: [self isFreeObject: nextFree]). self assert: (prevFree = 0 or: [prevFree > free]). aBinaryBlock value: free value: (prevFree = 0 ifTrue: [endOfMemory - self bridgeSize] ifFalse: [self startOfObject: prevFree]). + self assert: (prevFree = 0 or: [self isFreeObject: prevFree]). + self assert: (prevPrevFree = 0 or: [self isFreeObject: prevPrevFree]). + (self isFreeObject: free) ifFalse: + [free := self nextInSortedFreeListLink: prevFree given: prevPrevFree]. + (self isFreeObject: nextFree) + ifTrue: + [prevPrevFree := prevFree. + prevFree := free. + free := nextFree] + ifFalse: + [free := lastFreeChunk. + prevPrevFree := prevFree := 0. + [free > nextFree] whileTrue: + [nextFree := self nextInSortedFreeListLink: free given: prevFree. + self assert: (self isFreeObject: nextFree). + prevPrevFree := prevFree. + prevFree := free. + free := nextFree]]]! - prevFree := free. - free := nextFree]!
Item was changed: ----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact (in category 'gc - global') ----- sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact "Coallesce free chunks and forwarders and rebuild the free list." | firstFree firstFreeStart lastFree | + self assert: (self noForwardersBelowFirstFreeChunk). - self checkNoForwardersBelowFirstFreeChunk. firstFree := totalFreeOldSpace := 0. self allOldSpaceEntitiesFrom: firstFreeChunk do: [:o| ((self isFreeObject: o) or: [self isForwarded: o]) ifTrue: [firstFree = 0 ifTrue: + [firstFree := o. + firstFreeStart := self startOfObject: o]. + lastFree := o] - [firstFree := o]. - lastFree := o. - firstFreeStart := self startOfObject: o] ifFalse: [firstFree ~= 0 ifTrue: [| bytes | bytes := (self addressAfter: lastFree) - firstFreeStart. self addFreeChunkWithBytes: bytes at: firstFreeStart]. firstFree := 0]]. firstFree ~= 0 ifTrue: [| bytes | bytes := (self addressAfter: lastFree) - firstFreeStart. self addFreeChunkWithBytes: bytes at: firstFreeStart]. firstFreeChunk := lastFreeChunk := 0!
Item was changed: ----- Method: VMMaker class>>generateAllSpurConfigurations (in category 'configurations') ----- generateAllSpurConfigurations self generateNewspeakSpurCogVM; generateNewspeakSpurStackVM; generateSqueakSpurCogVM; + generateSqueakSpurCogSistaVM; generateSqueakSpurStackVM!