[Vm-dev] VM Maker: VMMaker.oscog-eem.524.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Nov 26 20:47:26 UTC 2013
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]!
More information about the Vm-dev
mailing list