[Vm-dev] VM Maker: VMMaker.oscogSPC-eem.2116.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Jan 28 18:34:28 UTC 2017
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2116.mcz
==================== Summary ====================
Name: VMMaker.oscogSPC-eem.2116
Author: eem
Time: 28 January 2017, 10:33:34.120249 am
UUID: 6132d23c-9bc3-4756-8352-16b127d1c7cd
Ancestors: VMMaker.oscog-eem.2116, VMMaker.oscogSPC-eem.2114
Temporary branch for SpurPlanningCompactor as default compactor.
Merge VMMaker.oscog-eem.2116 & VMMaker.oscogSPC-eem.2114
=============== Diff against VMMaker.oscog-eem.2116 ===============
Item was changed:
----- Method: SpurMemoryManager class>>compactorClass (in category 'accessing class hierarchy') -----
compactorClass
"Answer the compaction algorithm to use."
+ ^Smalltalk classNamed: (initializationOptions at: #compactorClass ifAbsent: [#SpurPlanningCompactor])!
- ^Smalltalk classNamed: (initializationOptions at: #compactorClass ifAbsent: [#SpurPigCompactor])!
Item was added:
+ ----- Method: SpurMemoryManager>>unlinkFreeChunk: (in category 'free space') -----
+ unlinkFreeChunk: freeChunk
+ "Unlink a free object from the free lists. Do not alter totalFreeOldSpace. Used for coalescing."
+ | chunkBytes index node next prev child childBytes |
+ index := (chunkBytes := self bytesInObject: freeChunk) / self allocationUnit.
+ (index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue:
+ [self assert: ((freeListsMask anyMask: 1 << index) and: [(freeLists at: index) ~= 0]).
+ node := freeLists at: index.
+ 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].
+ ^self].
+ prev := node.
+ node := next].
+ self error: 'freeChunk not found in free lists'].
+
+ "Large chunk. Search the large chunk tree."
+ child := freeLists at: 0.
+ node := 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:
+ [node = freeChunk ifTrue:
+ [self assert: (self isValidFreeObject: node).
+ self storePointer: self freeChunkNextIndex
+ ofFreeChunk: prev
+ withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
+ ^self]].
+ child = freeChunk 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]].
+ child ~= 0 ifTrue:
+ [childBytes < chunkBytes
+ ifTrue: "node too small; walk down the larger size of the tree"
+ [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
+ ifFalse:
+ [node := child.
+ child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node]]].
+
+ self error: 'freeChunk not found in free tree'
+ !
Item was added:
+ ----- Method: SpurPlanningCompactor>>coalesceFrom: (in category 'private') -----
+ coalesceFrom: maybeFirstFree
+ "manager printOopsFrom: maybeFirstFree to: manager endOfMemory"
+ <var: 'maybeFirstFree' type: #usqInt>
+ | obj next |
+ <var: 'obj' type: #usqInt>
+ <var: 'next' type: #usqInt>
+ maybeFirstFree >= manager endOfMemory ifTrue:
+ [^self].
+ obj := maybeFirstFree.
+ [next := manager oldSpaceObjectAfter: obj.
+ next < manager endOfMemory] whileTrue:
+ [((manager isFreeObject: obj) and: [manager isFreeObject: next])
+ ifTrue:
+ [manager
+ unlinkFreeChunk: obj;
+ unlinkFreeChunk: next;
+ freeChunkWithBytes: (manager bytesInObject: obj) + (manager bytesInObject: next) at: (manager startOfObject: obj)]
+ ifFalse:
+ [obj := next]]!
Item was changed:
----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') -----
compact
"Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects.
Let the segmentManager mark which segments contain pinned objects via notePinned:."
| onePass firstPass |
<inline: #never> "for profiling"
self initializeScanCheckingForFullyCompactedHeap ifTrue:
[^self unmarkObjectsInFullyCompactedHeap].
self initializeCompaction.
firstPass := true.
[onePass := self planCompactSavingForwarders.
self assert: (self validRelocationPlanInPass: onePass) = 0.
objectAfterLastMobileObject := manager oldSpaceObjectAfter: lastMobileObject.
self updatePointers.
self copyAndUnmark: firstPass.
manager checkFreeSpace: GCModeFull.
onePass or: [biasForGC]] whileFalse:
[firstPass := false.
+ self reinitializeScanFrom: objectAfterLastMobileObject;
- self reinitializeScan;
updateSavedFirstFieldsSpaceIfNecessary].
self endCompaction!
Item was changed:
----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjects (in category 'compaction') -----
copyAndUnmarkMobileObjects
"Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits.
Remember to update the savedFirstFields of pointer objects, as these have been forwarded.
Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed).
The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects
match. We could implement them as a single enumeration method taking several block arguments, but arguably that
would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage
the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)."
<inline: #never>
| toFinger top previousPin |
<var: 'o' type: #usqInt>
<var: 'top' type: #usqInt>
<var: 'toFinger' type: #usqInt>
<var: 'previousPin' type: #usqInt>
self deny: (manager isMarked: firstFreeObject).
toFinger := manager startOfObject: firstFreeObject.
top := savedFirstFieldsSpace start.
manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do:
+ [:o :n| | done |
- [:o :n|
self check: o.
self assert: (previousPin
ifNil: [toFinger <= (manager startOfObject: o)]
ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]).
self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]).
(manager isMarked: o) ifTrue:
[o > lastMobileObject ifTrue:
+ ["If this is onePass (noMobileObjectsFrom: objectAfterLastMobileObject) free up to end of memory.
+ A bug in this approach is that it may create two free objects at the end of memory. Work around
+ this with the coalesce pass below.
+ If this is multi-pass, free up to startOfObject: objectAfterLastMobileObject."
+ | maybeStartOfFree |
+ self assert: (self oop: o isGreaterThanOrEqualTo: objectAfterLastMobileObject).
+ self freeFrom: toFinger upTo: (manager startOfObject: objectAfterLastMobileObject) previousPin: previousPin.
+ maybeStartOfFree := toFinger < (manager startOfObject: objectAfterLastMobileObject)
+ ifTrue: [manager objectStartingAt: toFinger]
+ ifFalse: [objectAfterLastMobileObject].
+ done := self noMobileObjectsFrom: objectAfterLastMobileObject.
+ done ifTrue:
+ [toFinger := manager startOfObject: objectAfterLastMobileObject.
+ previousPin := (manager isPinned: objectAfterLastMobileObject) ifTrue: [objectAfterLastMobileObject].
+ self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin.
+ self coalesceFrom: maybeStartOfFree].
+ ^done].
- [self assert: ((manager isPinned: o) not or: [previousPin isNil]).
- self freeFrom: toFinger upTo: manager endOfMemory previousPin: ((manager isPinned: o) ifTrue: [o] ifFalse: [previousPin]).
- ^true].
(manager isPinned: o)
ifTrue:
[previousPin ifNil:
[previousPin := o]]
ifFalse:
[| availableSpace bytes |
bytes := manager bytesInObject: o.
[previousPin notNil
and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
bytes ~= availableSpace
and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
["The object does not fit in the space between toFinger and previousPin.
Move toFinger up to point at the first unmarked or mobile object after
previousPin, or, if previousPin is contiguous with o, to the start of this
object. Update previousPin to be the next pinned object above toFInger
and below this object, or nil if no such pinned object exists.
Any unfillable gaps between adjacent pinned objects will be freed."
availableSpace > 0 ifTrue:
[manager addFreeChunkWithBytes: availableSpace at: toFinger].
[self assert: ((manager isMarked: previousPin) and: [manager isPinned: previousPin]).
self unmarkPinned: previousPin.
toFinger := manager addressAfter: previousPin.
previousPin := manager objectStartingAt: toFinger.
(manager isMarked: previousPin)
and: [(manager isPinned: previousPin)
and: [previousPin < o]]]
whileTrue.
"Now previousPin is either equal to o or mobile.
Move it to the next pinned object below o"
[previousPin >= o
or: [(manager isMarked: previousPin)
and: [manager isPinned: previousPin]]] whileFalse:
[previousPin := manager oldSpaceObjectAfter: previousPin].
previousPin >= o ifTrue:
[previousPin := nil]].
self copyAndUnmarkObject: o to: toFinger bytes: bytes firstField: (manager longAt: top).
toFinger := toFinger + bytes.
(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
+ [self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
+ done := self noMobileObjectsFrom: n.
- [| done |
- self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
- done := self noMobileObjectsAfter: n.
done
ifTrue: [self freeAllUnpinnedObjectsFromObject: (previousPin ifNil: [n]) toFinger: toFinger]
ifFalse: [self freeFrom: toFinger upTo: (manager startOfObject: n) previousPin: previousPin].
^done]]]].
self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin.
+ self coalesceFrom: (manager objectStartingAt: toFinger).
^true!
Item was changed:
----- Method: SpurPlanningCompactor>>initializeScanCheckingForFullyCompactedHeap (in category 'compaction') -----
initializeScanCheckingForFullyCompactedHeap
+ "Scan for firstFreeObject and firstMobileObject from the start of memory.
+ Answer if the heap is already fully compacted."
+ self reinitializeScanFrom: manager hiddenRootsObject.
+ firstFreeObject ifNil:
+ [self error: 'uncompactable heap; no unmarked objects found'].
- "Scan for firstFreeObject and firstMobileObject from the start of memory (actually
- from lastMobileObject so that reInitializeScan can work on subsequent passes).
- Answer if the heap is already fully compacted. Set "
- firstFreeObject := lastMobileObject := manager hiddenRootsObject.
- self reinitializeScan.
^firstMobileObject >= manager endOfMemory!
Item was added:
+ ----- Method: SpurPlanningCompactor>>noMobileObjectsFrom: (in category 'private') -----
+ noMobileObjectsFrom: mobileObj
+ manager allOldSpaceEntitiesFrom: mobileObj do:
+ [:o|
+ ((manager isMarked: o) and: [(manager isPinned: o) not]) ifTrue:
+ [^false]].
+ ^true!
Item was removed:
- ----- Method: SpurPlanningCompactor>>reinitializeScan (in category 'compaction') -----
- reinitializeScan
- "Search for firstFreeObject and firstMobileObject from lastMobileObject (which is
- set to the hiddenRootsObject on the first pass)."
- firstMobileObject := manager endOfMemory.
- firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: lastMobileObject.
- firstFreeObject ifNil:
- [self error: 'uncompactable heap; no unmarked objects found'].
- mobileStart := manager startOfObject: firstFreeObject!
Item was added:
+ ----- Method: SpurPlanningCompactor>>reinitializeScanFrom: (in category 'compaction') -----
+ reinitializeScanFrom: initialObject
+ "Search for firstFreeObject and firstMobileObject from initialObject, which is the
+ hiddenRootsObject on the first pass, and the objectAfterLastMobileObject on
+ subsequent passes)."
+ firstMobileObject := manager endOfMemory.
+ firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: initialObject.
+ firstFreeObject ifNotNil:
+ [mobileStart := manager startOfObject: firstFreeObject]!
Item was added:
+ ----- Method: SpurPlanningCompactor>>unmarkAndScanForFirstUnpinnedObjectFrom: (in category 'compaction') -----
+ unmarkAndScanForFirstUnpinnedObjectFrom: initialObject
+ "Scan from initialObject, unmarking any marked pinned objects, and answering the first mobile or freeable object found, or nil if none."
+ manager allOldSpaceEntitiesFrom: initialObject do:
+ [:o|
+ ((manager isMarked: o) and: [manager isPinned: o]) ifFalse:
+ [^o].
+ self unmarkPinned: o].
+ ^nil!
Item was changed:
----- Method: SpurPlanningCompactor>>updatePointersInMobileObjects (in category 'compaction') -----
updatePointersInMobileObjects
"Sweep the mobile portion of the heap, updating all references to objects to their eventual locations.
Remember to update the savedFirstFields of pointer objects, as these have been forwarded.
Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed).
The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects
match. We could implement them as a single enumeration method taking several block arguments, but arguably that
would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage
the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)."
| toFinger top previousPin |
<var: 'o' type: #usqInt>
<var: 'top' type: #usqInt>
<var: 'toFinger' type: #usqInt>
<var: 'previousPin' type: #usqInt>
self deny: (manager isMarked: firstFreeObject).
toFinger := manager startOfObject: firstFreeObject.
top := savedFirstFieldsSpace start.
manager allOldSpaceEntitiesFrom: firstFreeObject do:
[:o|
self check: o.
self assert: (previousPin
ifNil: [toFinger <= (manager startOfObject: o)]
ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]).
(manager isMarked: o) ifTrue:
[(manager isPinned: o)
ifTrue:
[previousPin ifNil:
[previousPin := o].
self updatePointersIn: o]
ifFalse:
[| availableSpace bytes |
bytes := manager bytesInObject: o.
[previousPin notNil
and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
bytes ~= availableSpace
and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
["The object does not fit in the space between toFinger and previousPin.
Move toFinger up to point at the first unmarked or mobile object after
previousPin, or, if previousPin is contiguous with o, to the start of this
object. Update previousPin to be the next pinned object above toFInger
and below this object, or nil if no such pinned object exists.
Any unfillable gaps between adjacent pinned objects will be freed."
[toFinger := manager addressAfter: previousPin.
previousPin := manager objectStartingAt: toFinger.
(manager isMarked: previousPin)
and: [(manager isPinned: previousPin)
and: [previousPin < o]]]
whileTrue.
"Now previousPin is either equal to o or mobile.
Move it to the next pinned object below o"
[previousPin >= o
or: [(manager isMarked: previousPin)
and: [manager isPinned: previousPin]]] whileFalse:
[previousPin := manager oldSpaceObjectAfter: previousPin].
previousPin >= o ifTrue:
[previousPin := nil]].
self updatePointersIn: o savedFirstFieldPointer: top.
toFinger := toFinger + bytes.
(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
[self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
+ ^self noMobileObjectsFrom: o]]]].
- ^self noMobileObjectsAfter: o]]]].
self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
^true!
More information about the Vm-dev
mailing list