[Vm-dev] VM Maker: VMMaker.oscog-eem.480.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Oct 29 19:36:02 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.480.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.480
Author: eem
Time: 29 October 2013, 12:32:54.235 pm
UUID: 4266bc01-d2d8-498a-875f-cb14d99cf5c1
Ancestors: VMMaker.oscog-eem.479
Fix freeListsMask maintennance in
allocateOldSpaceChunkOfExactlyBytes:[suchThat:].
Fix determining new object address when copying and forwarding
in exact/bestFitCompact.
Refactor postBecomeScanClassTable so it can be used by the
compaction phase if required.
=============== Diff against VMMaker.oscog-eem.479 ===============
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>globalGarbageCollect (in category 'gc - global') -----
+ globalGarbageCollect
+ self halt.
+ ^super globalGarbageCollect!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes: (in category 'free space') -----
allocateOldSpaceChunkOfExactlyBytes: chunkBytes
"Answer a chunk of oldSpace from the free lists, if one of this size
is available, otherwise answer nil. N.B. the chunk is simply a pointer,
it has no valid header. The caller *must* fill in the header correctly."
+ | index node nodeBytes child |
- | initialIndex node nodeBytes child |
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
+ index := chunkBytes / self allocationUnit.
+ index < self numFreeLists ifTrue:
+ [(freeListsMask anyMask: 1 << index) ifTrue:
+ [(node := freeLists at: index) ~= 0 ifTrue:
- initialIndex := chunkBytes / self allocationUnit.
- initialIndex < self numFreeLists ifTrue:
- [1 << initialIndex <= freeListsMask ifTrue:
- [(node := freeLists at: initialIndex) ~= 0 ifTrue:
[self assert: node = (self startOfObject: node).
self assert: (self isValidFreeObject: node).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
+ ^self unlinkFreeChunk: node atIndex: index].
+ freeListsMask := freeListsMask - (1 << index)].
- ^self unlinkFreeChunk: node atIndex: initialIndex].
- freeListsMask := freeListsMask - (1 << initialIndex)].
^nil].
"Large chunk. 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 first chunk of
the same size as chunkBytes, or 0 if none."
node := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[| childBytes |
self assert: (self isValidFreeObject: child).
childBytes := self bytesInObject: child.
childBytes = chunkBytes
ifTrue: "size match; try to remove from list at node."
[node := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: child.
node ~= 0 ifTrue:
[self assert: (self isValidFreeObject: node).
self storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: node).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: node].
node := child.
nodeBytes := childBytes.
child := 0] "break out of loop to remove interior node"
ifFalse:
[childBytes < chunkBytes
ifTrue: "walk down the tree"
[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
ifFalse:
[nodeBytes := childBytes.
child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
"if no chunk, there was no exact fit"
node = 0 ifTrue:
[^nil].
"self printFreeChunk: parent"
self assert: nodeBytes = chunkBytes.
self assert: (self bytesInObject: node) = chunkBytes.
"can't be a list; would have removed and returned it above."
self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) = 0.
"no list; remove the interior node"
self unlinkSolitaryFreeTreeNode: node.
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: node!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes:suchThat: (in category 'free space') -----
allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: acceptanceBlock
"Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
if one of this size is available, otherwise answer nil. N.B. the chunk is simply a
pointer, it has no valid header. The caller *must* fill in the header correctly."
| index node next prev child childBytes |
<inline: true> "must inline for acceptanceBlock"
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
index := chunkBytes / self allocationUnit.
index < self numFreeLists ifTrue:
+ [(freeListsMask anyMask: 1 << index) ifTrue:
- [1 << index <= freeListsMask 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].
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^node].
node := next]]].
^nil].
"Large chunk. 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 first chunk of
the same size as chunkBytes, or 0 if none."
node := 0.
child := freeLists at: 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 first."
[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).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: node]].
node := child.
child := 0] "break out of loop to remove interior node"
ifFalse: "no size match; walk down the tree"
[child := self fetchPointer: (childBytes < chunkBytes
ifTrue: [self freeChunkLargerIndex]
ifFalse: [self freeChunkSmallerIndex])
ofFreeChunk: child]].
"if no chunk, there was no exact fit"
(node ~= 0 and: [acceptanceBlock value: node]) ifFalse:
[^nil].
"self printFreeChunk: parent"
self assert: (self bytesInObject: node) = chunkBytes.
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
next = 0
ifTrue: "no list; remove the interior node"
[self unlinkSolitaryFreeTreeNode: node]
ifFalse: "list; replace node with it"
[self inFreeTreeReplace: node with: next].
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: node!
Item was changed:
----- Method: SpurMemoryManager>>bestFitCompact (in category 'compaction') -----
bestFitCompact
"Compact all of memory using best-fit, assuming free space is sorted
and that the highest objects are recorded in highestObjects."
<returnTypeC: #void>
<inline: false>
| freePriorToExactFit |
self checkFreeSpace.
freePriorToExactFit := totalFreeOldSpace.
self exactFitCompact.
self checkFreeSpace.
highestObjects isEmpty ifTrue:
[^self]. "either no high objects, or no misfits."
statCompactPassCount := statCompactPassCount + 1.
highestObjects reverseDo:
[:o| | b |
self assert: ((self isForwarded: o) or: [self isPinned: o]) not.
b := self bytesInObject: o.
+ (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil:
+ [:f| self copyAndForward: o withBytes: b toFreeChunk: f]].
- (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil:
- [:f|
- self mem: f
- cp: o
- y: ((self hasOverflowHeader: o)
- ifTrue: [b - self baseHeaderSize]
- ifFalse: [b]).
- (self isRemembered: o) ifTrue:
- [scavenger remember: f].
- self forward: o to: f]].
self checkFreeSpace.
+ self flag: 'this should perhaps be a loop, recharging highestObjects as per exactFitCompact, but for now we assume the number of misfits not in highestObjects is very small'.
self allOldSpaceObjectsFrom: firstFreeChunk
do: [:o| | b |
((self isForwarded: o)
or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
+ (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil:
+ [:f| self copyAndForward: o withBytes: b toFreeChunk: f]]].
- (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil:
- [:f|
- self mem: f
- cp: o
- y: ((self hasOverflowHeader: o)
- ifTrue: [b - self baseHeaderSize]
- ifFalse: [b]).
- (self isRemembered: o) ifTrue:
- [scavenger remember: f].
- self forward: o to: f]]].
self checkFreeSpace.
self touch: freePriorToExactFit!
Item was added:
+ ----- Method: SpurMemoryManager>>copyAndForward:withBytes:toFreeChunk: (in category 'compaction') -----
+ copyAndForward: objOop withBytes: bytes toFreeChunk: freeChunk
+ "Copy and forward objOop to freeChunk, the inner operation in
+ exact and best fit compact."
+
+ <inline: true>
+ | startOfObj freeObj |
+ startOfObj := self startOfObject: objOop.
+ self mem: freeChunk cp: startOfObj y: bytes.
+ freeObj := freeChunk + (objOop - startOfObj).
+ "wait until the next scavenge to unremember o"
+ (self isRemembered: objOop) ifTrue:
+ [scavenger remember: freeObj].
+ self forward: objOop to: freeObj!
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 the highest objects are recorded in highestObjects.
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, and hence aren't moved, in highestObjects."
<returnTypeC: #void>
<inline: false>
| failures first |
<var: #failures type: #usqInt>
totalFreeOldSpace = 0 ifTrue: [^0].
failures := highestObjects last + self wordSize.
[statCompactPassCount := statCompactPassCount + 1.
highestObjects from: failures - self wordSize reverseDo:
[:o| | b |
o < firstFreeChunk ifTrue:
[failures = (highestObjects last + self wordSize)
ifTrue: [highestObjects resetAsEmpty]
ifFalse: [highestObjects first: failures].
^self].
((self isForwarded: o) or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
(self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
ifNil:
[failures := failures - self wordSize.
failures < highestObjects start ifTrue:
[failures := highestObjects limit].
self longAt: failures put: o]
ifNotNil:
+ [:f| self copyAndForward: o withBytes: b toFreeChunk: f]]].
- [:f|
- self mem: f
- cp: o
- y: ((self hasOverflowHeader: o)
- ifTrue: [b - self baseHeaderSize]
- ifFalse: [b]).
- "wait until the next scavenge to unremember o"
- (self isRemembered: o) ifTrue:
- [scavenger remember: f].
- self forward: o to: f]]].
"now highestObjects contains only failures, if any, from failures to last.
set first to first failure and refill buffer. next cycle will add more failures.
give up on exact-fit when half of the highest objects fail to fit."
first := self longAt: highestObjects first.
first > firstFreeChunk ifTrue:
[| highestObjBytes failureBytes savedLimit |
highestObjBytes := highestObjects limit - highestObjects start.
failureBytes := highestObjects last >= failures
ifTrue: [highestObjects last - failures]
ifFalse: [highestObjBytes - (failures - highestObjects last)].
failureBytes >= (highestObjBytes // 2) ifTrue:
[highestObjects first: failures.
^self].
savedLimit := self moveFailuresToTopOfHighestObjects: failures.
self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first.
failures := self moveFailuresInHighestObjectsBack: savedLimit]] repeat!
Item was added:
+ ----- Method: SpurMemoryManager>>postBecomeOrCompactScanClassTable: (in category 'become implementation') -----
+ postBecomeOrCompactScanClassTable: effectsFlags
+ "Scan the class table post-become (iff a pointer object or compiled method was becommed),
+ or post-compact.
+ Note that one-way become can cause duplications in the class table.
+ When can these be eliminated? We use the classTableBitmap to mark classTable entries
+ (not the classes themselves, since marking a class doesn't help in knowing if its index is used).
+ On image load, and during incrememtal scan-mark and full GC, classIndices are marked.
+ We can somehow avoid following classes from the classTable until after this mark phase."
+
+ self assert: self validClassTableRootPages.
+
+ (effectsFlags anyMask: BecamePointerObjectFlag+BecameCompiledMethodFlag) ifFalse: [^self].
+
+ 0 to: numClassTablePages - 1 do:
+ [:i| | page |
+ page := self fetchPointer: i ofObject: hiddenRootsObj.
+ 0 to: (self numSlotsOf: page) - 1 do:
+ [:j| | classOrNil |
+ classOrNil := self fetchPointer: j ofObject: page.
+ classOrNil ~= nilObj ifTrue:
+ [(self isForwarded: classOrNil) ifTrue:
+ [classOrNil := self followForwarded: classOrNil.
+ self storePointer: j ofObject: page withValue: classOrNil].
+ self scanClassPostBecome: classOrNil effects: effectsFlags]]]!
Item was changed:
----- Method: SpurMemoryManager>>postBecomeScanClassTable (in category 'become implementation') -----
postBecomeScanClassTable
"Scan the class table post-become (iff a pointer object or compiled method was becommed).
Note that one-way become can cause duplications in the class table.
When can these be eliminated? We use the classtableBitmap to mark classTable entries
(not the classes themselves, since marking a class doesn't help in knowing if its index is used).
On image load, and during incrememtal scan-mark and full GC, classIndices are marked.
We can somehow avoid following classes from the classTable until after this mark phase."
self assert: self validClassTableRootPages.
(becomeEffectsFlags anyMask: BecamePointerObjectFlag+BecameCompiledMethodFlag) ifFalse: [^self].
+ self postBecomeOrCompactScanClassTable: becomeEffectsFlags!
- 0 to: numClassTablePages - 1 do:
- [:i| | page |
- page := self fetchPointer: i ofObject: hiddenRootsObj.
- 0 to: (self numSlotsOf: page) - 1 do:
- [:j| | classOrNil |
- classOrNil := self fetchPointer: j ofObject: page.
- classOrNil ~= nilObj ifTrue:
- [(self isForwarded: classOrNil) ifTrue:
- [classOrNil := self followForwarded: classOrNil.
- self storePointer: j ofObject: page withValue: classOrNil].
- self scanClassPostBecome: classOrNil effects: becomeEffectsFlags]]]!
Item was added:
+ ----- Method: SpurMemoryManager>>postCompactScanClassTable (in category 'become implementation') -----
+ postCompactScanClassTable
+ "Scan the class table post-compact. Ensure all pages and
+ all classes are not forwarded."
+
+ 0 to: numClassTablePages - 1 do:
+ [:i| | page |
+ page := self fetchPointer: i ofObject: hiddenRootsObj.
+ (self isForwarded: page) ifTrue: "this check is for eliminateAndFreeForwarders"
+ [page := self followForwarded: page.
+ self storePointer: i ofObject: hiddenRootsObj withValue: page]].
+ self assert: self validClassTableRootPages.
+ self postBecomeOrCompactScanClassTable: BecamePointerObjectFlag!
More information about the Vm-dev
mailing list