Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.524.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.524 Author: eem Time: 26 November 2013, 12:44:23.505 pm UUID: 8795596f-5c5e-44de-9a9f-926f991d208b Ancestors: VMMaker.oscog-eem.523
Modify eliminateAndFreeForwarders to coalesce forwarders with free space. Fix bugs in unlinkFreeTreeNode:withSiblings: & addToFreeTree:bytes: (failure to clear prev and set parent).
Add some analysis/debugging routines to print uncoalesced free chunks and potentially compactible objects.
=============== Diff against VMMaker.oscog-eem.523 ===============
Item was added: + ----- Method: Spur32BitMMLECoSimulator>>setFree: (in category 'free space') ----- + setFree: o + "o = 16r113E7A8 ifTrue: [self halt]." + super setFree: o!
Item was changed: ----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') ----- addToFreeTree: freeChunk bytes: chunkBytes "Add freeChunk to the large free chunk tree. For the benefit of sortedFreeObject:, answer the treeNode it is added to, if it is added to the next list of a freeTreeNode, otherwise answer 0." | childBytes parent child | self assert: (self isFreeObject: freeChunk). self assert: chunkBytes = (self bytesInObject: freeChunk). self assert: chunkBytes / self allocationUnit >= self numFreeLists.
self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0; storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0; storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkPrevIndex ofFreeChunk: freeChunk withValue: 0. - storePointer: self freeChunkLargerIndex ofFreeChunk: 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 storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: freeChunk. ^child]. "walk down the tree" parent := child. child := self fetchPointer: (childBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: child]. parent = 0 ifTrue: [self assert: (freeLists at: 0) = 0. freeLists at: 0 put: freeChunk. freeListsMask := freeListsMask bitOr: 1. ^0]. self assert: (freeListsMask anyMask: 1). "insert in tree" self storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: parent. self storePointer: (childBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent withValue: freeChunk. ^0!
Item was added: + ----- Method: SpurMemoryManager>>checkForCompactableObjects (in category 'debug support') ----- + checkForCompactableObjects + "self checkForCompactableObjects" + <doNotGenerate> + | firstFree them sizes | + firstFree := 0. + self allOldSpaceEntitiesDo: [:o| (firstFree = 0 and: [self isFreeObject: o]) ifTrue: [firstFree := o]]. + firstFree = 0 ifTrue: [^nil]. + sizes := Bag new. + self allFreeObjectsDo: + [:f| sizes add: (self bytesInObject: f)]. + them := OrderedCollection new. + self allOldSpaceObjectsFrom: firstFree do: + [:o| | b | + b := self bytesInObject: o. + (sizes includes: b) ifTrue: + [them add: o. + sizes remove: b]]. + ^them isEmpty ifFalse: + [{them size. them first. them last}]!
Item was added: + ----- Method: SpurMemoryManager>>detachFreeObject: (in category 'free space') ----- + detachFreeObject: freeChunk + <inline: false> + | chunkBytes index node prev next | + chunkBytes := self bytesInObject: freeChunk. + totalFreeOldSpace := totalFreeOldSpace - chunkBytes. + index := chunkBytes / self allocationUnit. + index >= self numFreeLists ifTrue: + [^self detachLargeFreeObject: freeChunk]. + node := freeLists at: index. + freeChunk = node + ifTrue: + [(freeLists at: index put: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node)) = 0 ifTrue: + [self assert: (freeListsMask anyMask: 1 << index). + freeListsMask := freeListsMask - (1 << index)]] + ifFalse: + [prev := 0. + [node ~= 0] whileTrue: + [self assert: node = (self startOfObject: node). + self assert: (self isValidFreeObject: node). + next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. + node = freeChunk ifTrue: + [prev = 0 + ifTrue: [freeLists at: index put: next] + ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. + ^node]. + node := next]]!
Item was changed: ----- Method: SpurMemoryManager>>eliminateAndFreeForwarders (in category 'gc - global') ----- eliminateAndFreeForwarders + "As the final phase of global garbage collect, sweep the heap to follow + forwarders, then free forwarders, coalescing with free space as we go." + | lowestFree firstFree lastFree | - "As the final phase of global garbage collect, sweep - the heap to follow forwarders, then free forwarders" - | lowestForwarded firstForwarded lastForwarded | <inline: false> + self flag: 'this might be unnecessary. if we were to track firstFreeChunk we might be able to repeat the freeUnmarkedObjectsAndSortAndCoalesceFreeSpace; compact cycle until firstFreeChunk reaches a fixed point'. 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 isForwarded: specialObjectsOop) ifTrue: [specialObjectsOop := self followForwarded: specialObjectsOop]. + "N.B. we don't have to explicitly do mapInterpreterOops - "N.B. we don't have to explcitly do mapInterpreterOops since the scavenge below will do it." self followForwardedObjStacks. scavenger followRememberedForwardersAndForgetFreeObjects. self doScavenge: DontTenureButDoUnmark. self checkFreeSpace. + lowestFree := 0. - lowestForwarded := 0. "sweep, following forwarders in all live objects, and finding the first forwarder." + self allOldSpaceEntitiesDo: - self allOldSpaceObjectsDo: [:o| + ((self isFreeObject: o) or: [self isForwarded: o]) - (self isForwarded: o) ifTrue: + [lowestFree = 0 ifTrue: + [lowestFree := o]] - [lowestForwarded = 0 ifTrue: - [lowestForwarded := o]] ifFalse: [0 to: (self numPointerSlotsOf: o) - 1 do: [:i| | f | f := self fetchPointer: i ofObject: o. (self isOopForwarded: f) ifTrue: [f := self followForwarded: f. self assert: (self isYoung: f) not. self storePointerUnchecked: i ofObject: o withValue: f]]]]. self checkFreeSpace. + lowestFree = 0 ifTrue: "yeah, right..." + [^self]. + firstFree := lastFree := 0. + "Sweep from lowest forwarder, coalescing runs of forwarders and free objects." + self allOldSpaceEntitiesFrom: lowestFree do: - firstForwarded := lastForwarded := 0. - "sweep from lowest forwarder, coalescing runs of forwarders. perhaps this should - coalewsce free space and forwarders. the previous loop could reprise the discarding - of free space in freeUnmarkedObjectsAndSortAndCoalesceFreeSpace." - self allOldSpaceEntitiesFrom: lowestForwarded do: [:o| + (self isFreeObject: o) + ifTrue: "two cases, isolated, in which case leave alone, or adjacent, + in which case, remove from free set prior to coalesce." + [| next | + next := self objectAfter: o limit: endOfMemory. + self assert: (next = endOfMemory or: [(self isFreeObject: next) not]). "free chunks have already been coalesced" + (firstFree ~= 0 + or: [next ~= endOfMemory and: [self isForwarded: next]]) ifTrue: + [firstFree = 0 ifTrue: + [firstFree := o]. + lastFree := o. + self detachFreeObject: o. + self checkFreeSpace]] - (self isForwarded: o) - ifTrue: - [firstForwarded = 0 ifTrue: - [firstForwarded := o]. - lastForwarded := o] ifFalse: + [(self isForwarded: o) + ifTrue: + [firstFree = 0 ifTrue: + [firstFree := o]. + lastFree := o] + ifFalse: + [firstFree ~= 0 ifTrue: + [| start bytes | + start := self startOfObject: firstFree. + bytes := (self addressAfter: lastFree) - start. + self addFreeChunkWithBytes: bytes at: start. + self checkFreeSpace]. + firstFree := 0]]]. + firstFree ~= 0 ifTrue: - [firstForwarded ~= 0 ifTrue: - [| start bytes | - start := self startOfObject: firstForwarded. - bytes := (self addressAfter: lastForwarded) - start. - self addFreeChunkWithBytes: bytes at: start]. - firstForwarded := 0]]. - firstForwarded ~= 0 ifTrue: [| start bytes | + start := self startOfObject: firstFree. + bytes := (self addressAfter: lastFree) - start. - start := self startOfObject: firstForwarded. - bytes := (self addressAfter: lastForwarded) - start. self addFreeChunkWithBytes: bytes at: start]. self checkFreeSpace!
Item was added: + ----- Method: SpurMemoryManager>>printAdjacentFreeChunks (in category 'debug support') ----- + printAdjacentFreeChunks + "self printAdjacentFreeChunks" + <doNotGenerate> + | uncoalesced | + uncoalesced := OrderedCollection new. + self allOldSpaceEntitiesDo: + [:e| | s | + ((self isFreeObject: e) + and: [(s := self objectAfter: e limit: endOfMemory) < endOfMemory + and: [self isFreeObject: s]]) ifTrue: + [uncoalesced addLast: e]]. + uncoalesced do: + [:f| + self printFreeChunk: f. coInterpreter printHexnp: (self objectAfter: f limit: endOfMemory); cr] + !
Item was changed: ----- Method: SpurMemoryManager>>unlinkFreeTreeNode:withSiblings: (in category 'free space') ----- unlinkFreeTreeNode: freeTreeNode withSiblings: next "Unlink a freeTreeNode. Assumes the node has a list (non-null next link)." | parent smaller larger | parent := self fetchPointer: self freeChunkParentIndex ofObject: freeTreeNode. smaller := self fetchPointer: self freeChunkSmallerIndex ofObject: freeTreeNode. larger := self fetchPointer: self freeChunkLargerIndex ofObject: freeTreeNode. self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: 0. parent = 0 ifTrue: [freeLists at: 0 put: next] ifFalse: [self storePointer: (freeTreeNode = (self fetchPointer: self freeChunkSmallerIndex ofObject: parent) ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent + withValue: next. + self storePointer: self freeChunkParentIndex ofFreeChunk: next withValue: parent]. - withValue: next]. self storePointer: self freeChunkSmallerIndex ofFreeChunk: next withValue: smaller. smaller ~= 0 ifTrue: [self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: next]. self storePointer: self freeChunkLargerIndex ofFreeChunk: next withValue: larger. larger ~= 0 ifTrue: [self storePointer: self freeChunkParentIndex ofFreeChunk: larger withValue: next]!
vm-dev@lists.squeakfoundation.org