[Vm-dev] VM Maker: VMMaker.oscog-eem.618.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Feb 18 22:32:46 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.618.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.618
Author: eem
Time: 18 February 2014, 2:28:48.587 pm
UUID: db6b9128-3c54-41b7-b3d9-0063d6001b70
Ancestors: VMMaker.oscog-eem.617
Spur: Update firstFreeChunk correctly when it is allocated in the
compaction routines.
Break out of the search loop sooner in
allocateOldSpaceChunkOfBytes:suchThat:.
Make the halt in globalGarbageCollect informative.
=============== Diff against VMMaker.oscog-eem.617 ===============
Item was changed:
----- Method: Spur32BitMMLESimulator>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
+ self halt: 'GC number ', statFullGCs printString.
- self halt.
^super globalGarbageCollect!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes:suchThat: (in category 'free space') -----
allocateOldSpaceChunkOfBytes: chunkBytes suchThat: acceptanceBlock
"Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
if available, otherwise answer nil. Break up a larger chunk if one of the exact
size cannot be found. N.B. the chunk is simply a pointer, it has no valid header.
The caller *must* fill in the header correctly."
| initialIndex node next prev index child childBytes acceptedChunk acceptedNode |
<inline: true> "must inline for acceptanceBlock"
self assert: (lastSubdividedFreeChunk := 0) = 0.
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
initialIndex := chunkBytes / self allocationUnit.
(initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
[(freeListsMask anyMask: 1 << initialIndex) ifTrue:
[(node := freeLists at: initialIndex) = 0
ifTrue: [freeListsMask := freeListsMask - (1 << initialIndex)]
ifFalse:
[prev := 0.
[node ~= 0] whileTrue:
[self assert: node = (self startOfObject: node).
self assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
ifTrue: [freeLists at: initialIndex put: next]
ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
^node].
prev := node.
node := next]]].
"first search for free chunks of a multiple of chunkBytes in size"
index := initialIndex.
[(index := index + initialIndex) < self numFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(node := freeLists at: index) = 0
ifTrue: [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.
(acceptanceBlock value: node) ifTrue:
[prev = 0
ifTrue: [freeLists at: index put: next]
ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: node) + chunkBytes.
^node].
prev := node.
node := next]]]].
"now get desperate and use the first that'll fit.
Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
leave room for the forwarding pointer/next free link, we can only break chunks
that are at least 16 bytes larger, hence start at initialIndex + 2."
index := initialIndex + 1.
[(index := index + 1) < self numFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(node := freeLists at: index) = 0
ifTrue: [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.
(acceptanceBlock value: node) ifTrue:
[prev = 0
ifTrue: [freeLists at: index put: next]
ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: node) + chunkBytes.
^node].
prev := node.
node := next]]]]].
"Large chunk, or no space on small free lists. Search the large chunk list.
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.
When the search ends parent should hold the smallest chunk at least as
large as chunkBytes, or 0 if none. acceptedChunk and acceptedNode save
us from having to back-up when the acceptanceBlock filters-out all nodes
of the right size, but there are nodes of the wrong size it does accept."
child := freeLists at: 0.
node := acceptedChunk := acceptedNode := 0.
[child ~= 0] whileTrue:
[self assert: (self isValidFreeObject: child).
childBytes := self bytesInObject: child.
childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
[node := child.
[prev := node.
node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
node ~= 0] whileTrue:
[(acceptanceBlock value: node) ifTrue:
[self assert: (self isValidFreeObject: node).
self storePointer: self freeChunkNextIndex
ofFreeChunk: prev
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
^self startOfObject: node]].
(acceptanceBlock value: child) ifTrue:
[next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child.
next = 0
ifTrue: "no list; remove the interior node"
[self unlinkSolitaryFreeTreeNode: child]
ifFalse: "list; replace node with it"
[self inFreeTreeReplace: child with: next].
^self startOfObject: child]].
child ~= 0 ifTrue:
["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
leave room for the forwarding pointer/next free link, we can only break chunks
that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger."
childBytes <= (chunkBytes + self allocationUnit)
ifTrue: "node too small; walk down the larger size of the tree"
[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
ifFalse:
[self flag: 'we can do better here; preferentially choosing the lowest node. That would be a form of best-fit since we are trying to compact down'.
+ node := child.
+ child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node.
acceptedNode = 0 ifTrue:
+ [acceptedChunk := node.
- [acceptedChunk := child.
"first search the list."
[acceptedChunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: acceptedChunk.
(acceptedChunk ~= 0 and: [acceptanceBlock value: acceptedChunk]) ifTrue:
+ [acceptedNode := node].
- [acceptedNode := child].
acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue.
"nothing on the list; will the node do? This prefers
acceptable nodes higher up the tree over acceptable
list elements further down, but we haven't got all day..."
(acceptedNode = 0
+ and: [acceptanceBlock value: node]) ifTrue:
+ [acceptedNode := node.
+ child := 0 "break out of loop now we have an acceptedNode"]]]]].
- and: [acceptanceBlock value: child]) ifTrue:
- [acceptedNode := child]].
- child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
acceptedNode ~= 0 ifTrue:
[acceptedChunk ~= 0 ifTrue:
[self assert: (self bytesInObject: acceptedChunk) >= (chunkBytes + self allocationUnit).
[next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
next ~= acceptedChunk] whileTrue:
[acceptedNode := next].
self storePointer: self freeChunkNextIndex
ofFreeChunk: acceptedNode
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk).
self freeChunkWithBytes: (self bytesInObject: acceptedChunk) - chunkBytes
at: (self startOfObject: acceptedChunk) + chunkBytes.
^self startOfObject: acceptedChunk].
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
next = 0
ifTrue: "no list; remove the interior node"
[self unlinkSolitaryFreeTreeNode: acceptedNode]
ifFalse: "list; replace node with it"
[self inFreeTreeReplace: acceptedNode with: next].
self assert: (self bytesInObject: acceptedNode) >= (chunkBytes + self allocationUnit).
self freeChunkWithBytes: (self bytesInObject: acceptedNode) - chunkBytes
at: (self startOfObject: acceptedNode) + chunkBytes.
^self startOfObject: acceptedNode].
totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
^nil!
Item was changed:
----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') -----
exactFitCompact
"Compact all of memory above firstFreeChunk using exact-fit, assuming free
space is sorted and that as many of the the highest objects as will fit are
recorded in highestObjects. Don't move pinned objects.
Note that we don't actually move; we merely copy and forward. Eliminating
forwarders will be done in a final pass. Leave the objects that don't fit
exactly (the misfits), and hence aren't moved, in highestObjects."
<inline: false>
| misfits first nfits nmiss nHighest nMisses savedLimit |
<var: #misfits type: #usqInt>
self checkFreeSpace.
totalFreeOldSpace = 0 ifTrue: [^self].
highestObjects isEmpty ifTrue:
[^self].
nfits := nmiss := 0.
misfits := highestObjects last + self wordSize.
[statCompactPassCount := statCompactPassCount + 1.
highestObjects from: misfits - self wordSize reverseDo:
[:o| | b |
(self oop: o isGreaterThan: firstFreeChunk) ifFalse:
[highestObjects first: misfits.
coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr.
^self].
((self isForwarded: o) or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
(self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
ifNil:
[nmiss := nmiss + 1.
misfits := misfits - self wordSize.
misfits < highestObjects start ifTrue:
[misfits := highestObjects limit - self wordSize].
self longAt: misfits put: o]
ifNotNil:
+ [:f| | fo |
- [:f|
nfits := nfits + 1.
- self copyAndForward: o withBytes: b toFreeChunk: f.
"here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
is a large chunk then firstFreeChunk will no longer point to an object header. So check and
adjust firstFreeChunk if it is assigned to."
+ fo := self objectStartingAt: f.
+ fo = firstFreeChunk ifTrue:
+ [firstFreeChunk := self objectAfter: fo].
+ self copyAndForward: o withBytes: b toFreeChunk: f]]].
- f = firstFreeChunk ifTrue:
- [firstFreeChunk := self objectStartingAt: f]]]].
self checkFreeSpace.
"now highestObjects contains only misfits, if any, from misfits to last.
set first to first failure and refill buffer. next cycle will add more misfits.
give up on exact-fit when half of the highest objects fail to fit."
first := self longAt: highestObjects first.
self assert: (self oop: first isGreaterThan: firstFreeChunk).
nHighest := highestObjects usedSize.
highestObjects first: misfits.
nMisses := highestObjects usedSize.
nMisses > (nHighest // 2) ifTrue:
[coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr.
^self].
savedLimit := self moveMisfitsToTopOfHighestObjects: misfits.
self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first.
misfits := self moveMisfitsInHighestObjectsBack: savedLimit.
highestObjects usedSize > 0] whileTrue!
Item was changed:
----- Method: SpurMemoryManager>>firstFitCompact (in category 'compaction') -----
firstFitCompact
"Compact all of memory above firstFreeChunk using first-fit, assuming free
space is sorted and that as many of the the highest objects as will fit are
recorded in highestObjects. Don't move pinned objects.
Note that we don't actually move; we merely copy and forward. Eliminating
forwarders will be done in a final pass."
<inline: false>
| first nhits nmisses |
self checkFreeSpace.
totalFreeOldSpace = 0 ifTrue: [^self].
highestObjects isEmpty ifTrue:
[^self].
nhits := nmisses := 0.
[statCompactPassCount := statCompactPassCount + 1.
highestObjects reverseDo:
[:o| | b |
+ self assert: (firstFreeChunk = 0
+ or: [(self isFreeObject: firstFreeChunk)
+ or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]).
(self oop: o isLessThanOrEqualTo: firstFreeChunk) ifTrue:
[coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr.
^self].
((self isForwarded: o) or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
(self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o])
ifNil:
[nmisses := nmisses + 1]
ifNotNil:
+ [:f| | fo |
- [:f|
nhits := nhits + 1.
- self copyAndForward: o withBytes: b toFreeChunk: f.
"here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
is a large chunk then firstFreeChunk will no longer point to an object header. So check and
adjust firstFreeChunk if it is assigned to."
+ fo := self objectStartingAt: f.
+ fo = firstFreeChunk ifTrue:
+ [firstFreeChunk := lastSubdividedFreeChunk = 0
+ ifTrue: [self objectAfter: fo]
+ ifFalse: [self objectStartingAt: lastSubdividedFreeChunk]].
+ self copyAndForward: o withBytes: b toFreeChunk: f.
- f = firstFreeChunk ifTrue:
- [firstFreeChunk := self objectStartingAt: f].
self assert: (lastSubdividedFreeChunk = 0
or: [(self addressAfter: (self objectStartingAt: f)) = lastSubdividedFreeChunk])]]].
self checkFreeSpace.
first := self longAt: highestObjects first.
self assert: (self oop: first isGreaterThan: firstFreeChunk).
self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first.
highestObjects usedSize > 0] whileTrue.
coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr!
More information about the Vm-dev
mailing list