[Vm-dev] VM Maker: VMMaker.oscog-eem.472.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Oct 21 20:22:48 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.472.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.472
Author: eem
Time: 21 October 2013, 1:19:49.652 pm
UUID: 88a5a8b4-a29f-43fd-9a4e-ff5319cf5c4d
Ancestors: VMMaker.oscog-eem.471
Make rebuildFreeTreeFromSortedFreeChunks sort the lists off each
tree node in the free tree for compaction, highest address for the
node, followed by a list from low to high.
Requires freeTreeNodesDo: to update its notion of the node from
its block. This in turn requires Slang to handle outputting
an assignment whose value is a value expansion correctly, moving
the assignment to the last statement of the value expansion.
speeling errars, coallesce => coalesce, detatch => detach.
Now ready to implement bestBitCompact & exactFitCompact properly.
=============== Diff against VMMaker.oscog-eem.471 ===============
Item was added:
+ ----- Method: Spur32BitMemoryManager>>coalesce:and: (in category 'gc - global') -----
+ coalesce: obj1 and: obj2
+ | header1NumSlots header2NumSlots obj2slots newNumSlots |
+ header1NumSlots := self rawNumSlotsOf: obj1.
+ header2NumSlots := self rawNumSlotsOf: obj2.
+
+ "compute total number of slots in obj2, including header"
+ obj2slots := header2NumSlots = self numSlotsMask
+ ifTrue: [(self longAt: obj2 - self baseHeaderSize) + (2 * self baseHeaderSize / self wordSize)]
+ ifFalse: [(header2NumSlots = 0 ifTrue: [1] ifFalse: [header2NumSlots]) + (self baseHeaderSize / self wordSize)].
+ obj2slots := obj2slots + (obj2slots bitAnd: 1).
+ self assert: obj2slots * self wordSize = (self bytesInObject: obj2).
+
+ "if obj1 already has a double header things are simple..."
+ header1NumSlots = self numSlotsMask ifTrue:
+ [self longAt: obj1 - self baseHeaderSize put: obj2slots + (self longAt: obj1 - self baseHeaderSize).
+ ^obj1].
+
+ "compute total number of slots in obj1, excluding header"
+ header1NumSlots := header1NumSlots = 0
+ ifTrue: [2]
+ ifFalse: [header1NumSlots + (header1NumSlots bitAnd: 1)].
+ self assert: header1NumSlots * self wordSize + self baseHeaderSize = (self bytesInObject: obj1).
+ newNumSlots := obj2slots + header1NumSlots.
+
+ "if obj1 still only requires a single header things are simple..."
+ newNumSlots < self numSlotsMask ifTrue:
+ [self byteAt: obj1 + (self numSlotsFullShift / BitsPerByte)
+ put: newNumSlots.
+ ^obj1].
+
+ "convert from single to double header..."
+ newNumSlots := newNumSlots - (self baseHeaderSize / self wordSize).
+ self longAt: obj1 + self baseHeaderSize
+ put: (self longAt: obj1);
+ longAt: obj1 + 4 + self baseHeaderSize
+ put: ((self longAt: obj1 + 4) bitOr: self numSlotsMask << self numSlotsHalfShift).
+ self longAt: obj1
+ put: newNumSlots.
+ self longAt: obj1 + 4
+ put: self numSlotsMask << self numSlotsHalfShift.
+ ^obj1 + self baseHeaderSize!
Item was removed:
- ----- Method: Spur32BitMemoryManager>>coallesce:and: (in category 'gc - global') -----
- coallesce: obj1 and: obj2
- | header1NumSlots header2NumSlots obj2slots newNumSlots |
- header1NumSlots := self rawNumSlotsOf: obj1.
- header2NumSlots := self rawNumSlotsOf: obj2.
-
- "compute total number of slots in obj2, including header"
- obj2slots := header2NumSlots = self numSlotsMask
- ifTrue: [(self longAt: obj2 - self baseHeaderSize) + (2 * self baseHeaderSize / self wordSize)]
- ifFalse: [(header2NumSlots = 0 ifTrue: [1] ifFalse: [header2NumSlots]) + (self baseHeaderSize / self wordSize)].
- obj2slots := obj2slots + (obj2slots bitAnd: 1).
- self assert: obj2slots * self wordSize = (self bytesInObject: obj2).
-
- "if obj1 already has a double header things are simple..."
- header1NumSlots = self numSlotsMask ifTrue:
- [self longAt: obj1 - self baseHeaderSize put: obj2slots + (self longAt: obj1 - self baseHeaderSize).
- ^obj1].
-
- "compute total number of slots in obj1, excluding header"
- header1NumSlots := header1NumSlots = 0
- ifTrue: [2]
- ifFalse: [header1NumSlots + (header1NumSlots bitAnd: 1)].
- self assert: header1NumSlots * self wordSize + self baseHeaderSize = (self bytesInObject: obj1).
- newNumSlots := obj2slots + header1NumSlots.
-
- "if obj1 still only requires a single header things are simple..."
- newNumSlots < self numSlotsMask ifTrue:
- [self byteAt: obj1 + (self numSlotsFullShift / BitsPerByte)
- put: newNumSlots.
- ^obj1].
-
- "convert from single to double header..."
- newNumSlots := newNumSlots - (self baseHeaderSize / self wordSize).
- self longAt: obj1 + self baseHeaderSize
- put: (self longAt: obj1);
- longAt: obj1 + 4 + self baseHeaderSize
- put: ((self longAt: obj1 + 4) bitOr: self numSlotsMask << self numSlotsHalfShift).
- self longAt: obj1
- put: newNumSlots.
- self longAt: obj1 + 4
- put: self numSlotsMask << self numSlotsHalfShift.
- ^obj1 + self baseHeaderSize!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'snapshot') -----
adjustAllOopsBy: bytesToShift
"Adjust all oop references by the given number of bytes. This is
done just after reading in an image when the new base address
of the object heap is different from the base address in the image,
+ or when loading multiple segments that have been coalesced. Also
- or when loading multiple segments that have been coallesced. Also
set bits in the classTableBitmap corresponding to used classes."
| obj |
self countNumClassPagesPreSwizzle: bytesToShift;
ensureAdequateClassTableBitmap.
(bytesToShift ~= 0
or: [segmentManager numSegments > 1])
ifTrue:
[self assert: self newSpaceIsEmpty.
obj := self objectStartingAt: newSpaceLimit.
[self oop: obj isLessThan: freeOldSpaceStart] whileTrue:
[(self isFreeObject: obj)
ifTrue: [self swizzleFieldsOfFreeChunk: obj]
ifFalse:
[self inClassTableBitmapSet: (self classIndexOf: obj).
self swizzleFieldsOfObject: obj].
obj := self objectAfter: obj]]
ifFalse:
[self assert: self newSpaceIsEmpty.
obj := self objectStartingAt: newSpaceLimit.
[self oop: obj isLessThan: freeOldSpaceStart] whileTrue:
[(self isFreeObject: obj) ifFalse:
[self inClassTableBitmapSet: (self classIndexOf: obj)].
obj := self objectAfter: obj]]!
Item was changed:
----- Method: SpurMemoryManager>>allObjectsInFreeTreeDo: (in category 'free space') -----
allObjectsInFreeTreeDo: aBlock
"Enumerate all objects in the free tree (in order, smaller to larger).
This is an iterative version so that the block argument can be
inlined by Slang. The trick to an iterative binary tree application is
to apply the function on the way back up when returning from a
particular direction, in this case up from the larger child."
<inline: true>
self freeTreeNodesDo:
[:freeTreeNode| | next |
next := freeTreeNode.
[aBlock value: next.
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next.
+ next ~= 0] whileTrue.
+ freeTreeNode]!
- next ~= 0] whileTrue]!
Item was added:
+ ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCoalescingDo: (in category 'object enumeration') -----
+ allOldSpaceEntitiesForCoalescingDo: aBlock
+ <inline: true>
+ | prevObj prevPrevObj objOop rawNumSlots rawNumSlotsAfter |
+ prevPrevObj := prevObj := nil.
+ objOop := self firstObject.
+ [self assert: objOop \\ self allocationUnit = 0.
+ objOop < freeOldSpaceStart] whileTrue:
+ [rawNumSlots := self rawNumSlotsOf: objOop.
+ aBlock value: objOop.
+ "If the number of slot changes coalescing changed an object from a single to a double header."
+ rawNumSlotsAfter := self rawNumSlotsOf: objOop.
+ (rawNumSlotsAfter ~= rawNumSlots
+ and: [rawNumSlotsAfter = self numSlotsMask]) ifTrue:
+ [objOop := objOop + self baseHeaderSize.
+ self assert: (self objectAfter: prevObj limit: freeOldSpaceStart) = objOop].
+ prevPrevObj := prevObj.
+ prevObj := objOop.
+ objOop := self objectAfter: objOop limit: freeOldSpaceStart].
+ self touch: prevPrevObj.
+ self touch: prevObj!
Item was removed:
- ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCoallescingDo: (in category 'object enumeration') -----
- allOldSpaceEntitiesForCoallescingDo: aBlock
- <inline: true>
- | prevObj prevPrevObj objOop rawNumSlots rawNumSlotsAfter |
- prevPrevObj := prevObj := nil.
- objOop := self firstObject.
- [self assert: objOop \\ self allocationUnit = 0.
- objOop < freeOldSpaceStart] whileTrue:
- [rawNumSlots := self rawNumSlotsOf: objOop.
- aBlock value: objOop.
- "If the number of slot changes coallescing changed an object from a single to a double header."
- rawNumSlotsAfter := self rawNumSlotsOf: objOop.
- (rawNumSlotsAfter ~= rawNumSlots
- and: [rawNumSlotsAfter = self numSlotsMask]) ifTrue:
- [objOop := objOop + self baseHeaderSize.
- self assert: (self objectAfter: prevObj limit: freeOldSpaceStart) = objOop].
- prevPrevObj := prevObj.
- prevObj := objOop.
- objOop := self objectAfter: objOop limit: freeOldSpaceStart].
- self touch: prevPrevObj.
- self touch: prevObj!
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."
- "Compact all of memory using best-fit.
- Sort free space, find the first free chunk. Scan objects following
- the first free chunk and for each, look for a free chunk of the exact
- size, copy the object's contents into the free chunk, and forward
- the object to its new, lower location. If any didn't fit exactly do a
- second pass using best fit."
| firstFailedFit |
firstFailedFit := self exactFitCompact.
firstFailedFit = 0 ifTrue:
[^self]. "either no free space, no high objects, or no misfits."
self allOldSpaceObjectsFrom: firstFailedFit
do: [:o| | b |
((self isForwarded: o)
or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
+ (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil:
- (self allocateOldSpaceChunkOfBytes: b) 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 checkFreeSpace!
Item was removed:
- ----- Method: SpurMemoryManager>>buildPrevLinksForLargeFreeChunks (in category 'free space') -----
- buildPrevLinksForLargeFreeChunks
- | prevTreeNode |
- prevTreeNode := 0.
- self freeTreeNodesDo:
- [:freeTreeNode| | next prev |
- "freeTreeNodesDo: is supposed to be an in-order traversal from smaller to larger..."
- self assert: (prevTreeNode = 0 or: [(self numSlotsOfAny: prevTreeNode) < (self numSlotsOfAny: freeTreeNode)]).
- self storePointer: self freeChunkPrevIndex ofFreeChunk: freeTreeNode withValue: 0.
- prev := freeTreeNode.
- [(next := self fetchPointer: self freeChunkNextIndex ofObject: prev) ~= 0] whileTrue:
- [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: prev.
- prev := next]]!
Item was added:
+ ----- Method: SpurMemoryManager>>coalesce:and: (in category 'gc - global') -----
+ coalesce: obj1 and: obj2
+ self subclassResponsibility!
Item was removed:
- ----- Method: SpurMemoryManager>>coallesce:and: (in category 'gc - global') -----
- coallesce: obj1 and: obj2
- self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>detachLargeFreeObject: (in category 'free space') -----
+ detachLargeFreeObject: freeChunk
+ | prev next |
+ prev := self fetchPointer: self freeChunkPrevIndex ofObject: freeChunk.
+ next := self fetchPointer: self freeChunkNextIndex ofObject: freeChunk.
+ prev = 0
+ ifTrue: "freeChunk is a treeNode"
+ [next = 0
+ ifTrue: "remove it from the tree"
+ [self unlinkSolitaryFreeTreeNode: freeChunk]
+ ifFalse: "replace freeChunk by its next node."
+ [self unlinkFreeTreeNode: freeChunk withSiblings: next]]
+ ifFalse: "freeChunk is a list node; simple"
+ [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next.
+ next ~= 0 ifTrue:
+ [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: prev]]!
Item was removed:
- ----- Method: SpurMemoryManager>>detatchLargeFreeObject: (in category 'free space') -----
- detatchLargeFreeObject: freeChunk
- | prev next |
- prev := self fetchPointer: self freeChunkPrevIndex ofObject: freeChunk.
- next := self fetchPointer: self freeChunkNextIndex ofObject: freeChunk.
- prev = 0
- ifTrue: "freeChunk is a treeNode"
- [next = 0
- ifTrue: "remove it from the tree"
- [self unlinkSolitaryFreeTreeNode: freeChunk]
- ifFalse: "replace freeChunk by its next node."
- [self unlinkFreeTreeNode: freeChunk withSiblings: next]]
- ifFalse: "freeChunk is a list node; simple"
- [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next.
- next ~= 0 ifTrue:
- [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: prev]]!
Item was changed:
----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') -----
exactFitCompact
+ "Compact all of memory using exact-fit, assuming free space is sorted
+ and that the highest objects are recorded in highestObjects."
- "Compact all of memory using exact-fit.
- Sort free space, find the first free chunk. Scan objects following
- the first free chunk and for each, look for a free chunk of the right
- size, copy the object's contents into the free chunk, and forward
- the object to its new, lower location. Answer the first object that
- failed to fit (for bestFitCompacts convenience), if there's free space."
| firstFailedFit |
- self sortFreeSpace.
firstFailedFit := 0.
totalFreeOldSpace = 0 ifTrue: [^0].
self allOldSpaceObjectsFrom: self lowestFreeChunkAssumingSortedFreeSpace
do: [:o| | b |
((self isForwarded: o)
or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
+ (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
- (self allocateOldSpaceChunkOfExactlyBytes: b)
ifNil: [firstFailedFit = 0 ifTrue: [firstFailedFit := 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.
^firstFailedFit!
Item was changed:
----- Method: SpurMemoryManager>>freeTreeNodesDo: (in category 'free space') -----
freeTreeNodesDo: aBlock
"Enumerate all nodes in the free tree (in order, smaller to larger),
+ but *not* including the next nodes of the same size off each tree node.
- bit *not* including the next nodes of the same size off each tree node.
This is an iterative version so that the block argument can be
inlined by Slang. The trick to an iterative binary tree application is
to apply the function on the way back up when returning from a
+ particular direction, in this case up from the larger child.
+
+ N.B For the convenience of rebuildFreeTreeFromSortedFreeChunks
+ aBlock *MUST* answer the freeTreeNode it was invoked with, or
+ its replacement if it was replaced by aBlock."
- particular direction, in this case up from the larger child."
<inline: true>
| treeNode cameFrom |
treeNode := freeLists at: 0.
treeNode = 0 ifTrue:
[^self].
cameFrom := -1.
[| smallChild largeChild |
smallChild := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode.
largeChild := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
"apply if the node has no children, or it has no large children and we're
returning from the small child, or we're returning from the large child."
((smallChild = 0 and: [largeChild = 0])
or: [largeChild = 0
ifTrue: [cameFrom = smallChild]
ifFalse: [cameFrom = largeChild]])
ifTrue:
+ [treeNode := aBlock value: treeNode.
- [aBlock value: treeNode.
"and since we've applied we must move on up"
cameFrom := treeNode.
treeNode := self fetchPointer: self freeChunkParentIndex ofFreeChunk: treeNode]
ifFalse:
[(smallChild ~= 0 and: [cameFrom ~= smallChild])
ifTrue:
[treeNode := smallChild]
ifFalse:
[self assert: largeChild ~= 0.
treeNode := largeChild].
cameFrom := -1].
treeNode ~= 0] whileTrue!
Item was added:
+ ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
+ freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace
+ "Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings,
+ coalescing free chunks, and sorting free space. Small free chunks are sorted in address
+ order on each small list head. Large free chunks are sorted on the sortedFreeChunks list.
+ Record the highest N objects in highestObjects, for the first cycle of exactFitCompact.
+ Let the segmentManager mark which segments contain pinned objects via notePinned:"
+ | lastLargeFree highestObjectsWraps |
+ self checkFreeSpace.
+ scavenger forgetUnmarkedRememberedObjects.
+ segmentManager prepareForGlobalSweep."for notePinned:"
+ "for sorting free space throw away the list heads, rebuilding them for small free chunks below."
+ self resetFreeListHeads.
+ highestObjects
+ top: freeStart;
+ start: freeStart;
+ limit: scavenger eden limit.
+ highestObjectsWraps := 0.
+ self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
+ sortedFreeChunks := lastLargeFree := 0.
+ self allOldSpaceEntitiesForCoalescingDo:
+ [:o|
+ (self isMarked: o)
+ ifTrue:
+ [self setIsMarkedOf: o to: false.
+ ((self isWeakNonImm: o)
+ and: [self nilUnmarkedWeaklingSlots: o]) ifTrue:
+ [coInterpreter signalFinalization: o].
+ (self isPinned: o) ifTrue:
+ [segmentManager notePinned: o].
+ lastLargeFree ~= 0 ifTrue:
+ [self longAt: highestObjects top put: o.
+ (highestObjects top: (highestObjects top + self wordSize)) >= highestObjects limit ifTrue:
+ [highestObjects top: highestObjects start.
+ highestObjectsWraps := highestObjectsWraps + 1]]]
+ ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
+ [| here next |
+ self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
+ here := o.
+ next := self objectAfter: here limit: endOfMemory.
+ (self isMarked: next) ifFalse: "coalescing; rare case"
+ [self assert: (self isRemembered: o) not.
+ [statCoalesces := statCoalesces + 1.
+ here := self coalesce: here and: next.
+ next := self objectAfter: here limit: endOfMemory.
+ next = endOfMemory or: [self isMarked: next]] whileFalse].
+ (self isLargeFreeObject: here)
+ ifTrue:
+ [lastLargeFree = 0
+ ifTrue: [sortedFreeChunks := here]
+ ifFalse:
+ [self setFree: here.
+ self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here].
+ lastLargeFree := here]
+ ifFalse:
+ [self freeSmallObject: here]]].
+ lastLargeFree ~= 0 ifTrue:
+ [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
+ totalFreeOldSpace := self reverseSmallListHeads.
+ totalFreeOldSpace := totalFreeOldSpace + self rebuildFreeTreeFromSortedFreeChunks.
+ self checkFreeSpace.
+ self touch: highestObjectsWraps!
Item was removed:
- ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace (in category 'gc - global') -----
- freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace
- "Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings,
- coallescing free chunks, and sorting free space. Small free chunks are sorted in address
- order on each small list head. Large free chunks are sorted on the sortedFreeChunks list.
- Record the highest N objects in highestObjects, for the first cycle of exactFitCompact.
- Let the segmentManager mark which segments contain pinned objects via notePinned:"
- | lastLargeFree highestObjectsWraps |
- self checkFreeSpace.
- scavenger forgetUnmarkedRememberedObjects.
- segmentManager prepareForGlobalSweep."for notePinned:"
- "for sorting free space throw away the list heads, rebuilding them for small free chunks below."
- self resetFreeListHeads.
- highestObjects
- top: freeStart;
- start: freeStart;
- limit: scavenger eden limit.
- highestObjectsWraps := 0.
- self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
- sortedFreeChunks := lastLargeFree := 0.
- self allOldSpaceEntitiesForCoallescingDo:
- [:o|
- (self isMarked: o)
- ifTrue:
- [self setIsMarkedOf: o to: false.
- ((self isWeakNonImm: o)
- and: [self nilUnmarkedWeaklingSlots: o]) ifTrue:
- [coInterpreter signalFinalization: o].
- (self isPinned: o) ifTrue:
- [segmentManager notePinned: o].
- lastLargeFree ~= 0 ifTrue:
- [self longAt: highestObjects top put: o.
- (highestObjects top: (highestObjects top + self wordSize)) >= highestObjects limit ifTrue:
- [highestObjects top: highestObjects start.
- highestObjectsWraps := highestObjectsWraps + 1]]]
- ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
- [| here next |
- self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
- here := o.
- next := self objectAfter: here limit: endOfMemory.
- (self isMarked: next) ifFalse: "coallescing; rare case"
- [self assert: (self isRemembered: o) not.
- [statCoallesces := statCoallesces + 1.
- here := self coallesce: here and: next.
- next := self objectAfter: here limit: endOfMemory.
- next = endOfMemory or: [self isMarked: next]] whileFalse].
- (self isLargeFreeObject: here)
- ifTrue:
- [lastLargeFree = 0
- ifTrue: [sortedFreeChunks := here]
- ifFalse:
- [self setFree: here.
- self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here].
- lastLargeFree := here]
- ifFalse:
- [self freeSmallObject: here]]].
- lastLargeFree ~= 0 ifTrue:
- [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
- totalFreeOldSpace := self reverseSmallListHeads.
- totalFreeOldSpace := totalFreeOldSpace + self rebuildFreeTreeFromSortedFreeChunks.
- self checkFreeSpace.
- self touch: highestObjectsWraps!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
self markObjects.
+ self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace.
+ self bestFitCompact!
- self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace.
- self exactFitCompact!
Item was added:
+ ----- Method: SpurMemoryManager>>inFreeTreeReplace:with: (in category 'free space') -----
+ inFreeTreeReplace: treeNode with: newNode
+ | relative |
+ "copy parent, smaller, larger"
+ self freeChunkParentIndex to: self freeChunkLargerIndex do:
+ [:i|
+ self storePointer: i ofFreeChunk: newNode withValue: (self fetchPointer: i ofObject: treeNode)].
+ "replace link from parent to treeNode with link to newNode."
+ relative := self fetchPointer: self freeChunkParentIndex ofObject: treeNode.
+ relative = 0
+ ifTrue:
+ [freeLists at: 0 put: newNode]
+ ifFalse:
+ [self storePointer: (treeNode = (self fetchPointer: self freeChunkSmallerIndex ofObject: relative)
+ ifTrue: [self freeChunkSmallerIndex]
+ ifFalse: [self freeChunkLargerIndex])
+ ofFreeChunk: relative
+ withValue: newNode].
+ "replace parent links in children"
+ self freeChunkSmallerIndex to: self freeChunkLargerIndex do:
+ [:i|
+ relative := self fetchPointer: i ofObject: treeNode.
+ relative ~= 0 ifTrue:
+ [self storePointer: self freeChunkParentIndex ofFreeChunk: relative withValue: newNode]]!
Item was changed:
----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
initialize
"We can put all initializations that set something to 0 or to false here.
In C all global variables are initialized to 0, and 0 is false."
remapBuffer := Array new: RemapBufferSize.
remapBufferCount := extraRootCount := 0. "see below"
freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
checkForLeaks := 0.
needGCFlag := signalLowSpace := scavengeInProgress := marking := false.
becomeEffectsFlags := 0.
statScavenges := statIncrGCs := statFullGCs := 0.
statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0.
statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0.
+ statCoalesces := 0.
- statCoallesces := 0.
"We can initialize things that are allocated but are lazily initialized."
unscannedEphemerons := SpurContiguousObjStack new.
highestObjects := SpurContiguousObjStack new.
"we can initialize things that are virtual in C."
scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
segmentManager := SpurSegmentManager new manager: self; yourself.
"We can also initialize here anything that is only for simulation."
heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
"N.B. We *don't* initialize extraRoots because we don't simulate it."!
Item was changed:
----- Method: SpurMemoryManager>>rebuildFreeTreeFromSortedFreeChunks (in category 'free space') -----
rebuildFreeTreeFromSortedFreeChunks
+ "post sweep and pre compact, rebuild the large free chunk tree from the
+ sortedFreeChunks list, such that the lists are ordered from low to high address."
- "post sweep and pre compact, rebuild the large
- free chunk tree from the sortedFreeChunks list."
| freeChunk bytes totalBytes |
+ "first add all the chunks to the tree. This will result in almost address-sorted lists.
+ We will need to reorder the lists."
freeChunk := sortedFreeChunks.
totalBytes := 0.
[freeChunk ~= 0] whileTrue:
[bytes := self bytesInObject: freeChunk.
totalBytes := totalBytes + bytes.
self addToFreeTree: freeChunk bytes: bytes.
freeChunk := self fetchPointer: self freeChunkNextAddressIndex
ofObject: freeChunk].
+ "now reorder the lists to ensure they're in address order, apart from the list head, which should be highest."
+ self freeTreeNodesDo:
+ [:treeNode| | newTreeNode |
+ newTreeNode := self reorderReversedTreeList: treeNode.
+ newTreeNode].
^totalBytes!
Item was added:
+ ----- Method: SpurMemoryManager>>reorderReversedTreeList: (in category 'free space') -----
+ reorderReversedTreeList: treeNode
+ "Once the freeTree has been rebuilt from the sortedFreeChunks list
+ each list will be in a weird order, the list in reverse order, high to low,
+ but the tree node, because it is inserted first, will be the lowest address.
+ Reverse the list so it is sorted low to high, but make the highest address
+ node the first, as this will be allocated from last."
+ | first next node prev |
+ "first becomes the new head, as this is the last one we want to allocate and we allocate from the list first."
+ first := self fetchPointer: self freeChunkNextIndex ofObject: treeNode.
+ "no next node, so no change"
+ first = 0 ifTrue:
+ [^treeNode].
+ node := self fetchPointer: self freeChunkNextIndex ofObject: first.
+ self storePointer: self freeChunkNextIndex ofFreeChunk: first withValue: treeNode.
+ self inFreeTreeReplace: treeNode with: first.
+ prev := 0.
+ [node ~= 0] whileTrue:
+ [next := self fetchPointer: self freeChunkNextIndex ofObject: node.
+ self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev.
+ prev := node.
+ node := next].
+ self storePointer: self freeChunkNextIndex ofFreeChunk: treeNode withValue: prev.
+ ^first!
Item was changed:
----- Method: SpurMemoryManager>>reverseSmallListHeads (in category 'free space') -----
reverseSmallListHeads
+ "After freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace
- "After freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace
all small free chunks will be on the free lists in reverse address order. Reverse each list,
summing the ammount of space. Answer the sum of bytes of free space on these small lists."
| total |
total := 0.
freeListsMask := 0.
1 to: self numFreeLists - 1 do:
[:i| | bytes node prev next |
bytes := i * self allocationUnit.
node := freeLists at: i.
node ~= 0 ifTrue:
[self assert: (self bytesInObject: node) = bytes.
freeListsMask := freeListsMask + (1 << i).
prev := 0.
[node ~= 0] whileTrue:
[next := self fetchPointer: self freeChunkNextIndex ofObject: node.
self storePointer: self freeChunkNextIndex ofFreeChunk: node withValue: prev.
prev := node.
node := next.
total := total + bytes].
freeLists at: i put: prev]].
^total!
Item was changed:
----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
totalFreeListBytes
| totalFreeBytes bytesInChunk listNode |
totalFreeBytes := 0.
1 to: self numFreeLists - 1 do:
[:i|
bytesInChunk := i * self allocationUnit.
listNode := freeLists at: i.
[listNode ~= 0] whileTrue:
[totalFreeBytes := totalFreeBytes + bytesInChunk.
self assert: (self isValidFreeObject: listNode).
self assert: bytesInChunk = (self bytesInObject: listNode).
listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]].
self freeTreeNodesDo:
[:treeNode|
bytesInChunk := self bytesInObject: treeNode.
self assert: bytesInChunk / self allocationUnit >= self numFreeLists.
listNode := treeNode.
[listNode ~= 0] whileTrue:
["self printFreeChunk: listNode"
self assert: (self isValidFreeObject: listNode).
totalFreeBytes := totalFreeBytes + bytesInChunk.
self assert: bytesInChunk = (self bytesInObject: listNode).
+ listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode].
+ treeNode].
- listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]].
^totalFreeBytes!
Item was changed:
CogClass subclass: #SpurSegmentManager
instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle sweepIndex preferredPinningSegment'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-SpurMemoryManager'!
+ !SpurSegmentManager commentStamp: 'eem 10/21/2013 13:14' prior: 0!
- !SpurSegmentManager commentStamp: 'eem 10/6/2013 10:32' prior: 0!
Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments. Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required. Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments. A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment. So when the memory manager enumerates objects it skips over these bridges and memory appears linear. The constraint is that segments obtained from the operating system must be at a higher address than the first segment. The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots. In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice.
When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored. Hence the length of each segment is derived from the bridge at the end of the preceeding segment. The length of the first segment is stored in the image header as firstSegmentBytes. The start of each segment is also derived from the bridge as a delta from the start of the previous segment. The start of The first segment is stored in the image header as startOfMemory.
+ On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coalesced segment ends up on load. Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment.
- On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coallesced segment ends up on load. Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment.
Instance Variables
numSegments: <Integer>
segments: <Array of SpurSegmentInfo>
manager: <SpurMemoryManager>
numSegments
- the number of segments
segments
- the start addresses, lengths and offsets to adjust oops on image load, for each segment
manager
- the SpurMemoryManager whose oldSpace is managed (simulation only).!
Item was changed:
----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') -----
collapseSegmentsPostSwizzle
"The image has been loaded, old segments reconstructed, and the
loaded image swizzled into a single contiguous segment. Collapse
the segments intio one."
| bridge |
canSwizzle := false.
firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image"
[^self].
numSegments := 1.
(segments at: 0)
segStart: manager newSpaceLimit;
segSize: manager endOfMemory - manager newSpaceLimit.
+ "finally plant a bridge at the end of the coalesced segment and cut back the
- "finally plant a bridge at the end of the coallesced segment and cut back the
manager's notion of the end of memory to immediately before the bridge."
bridge := manager endOfMemory - manager bridgeSize.
self assert: bridge = ((segments at: 0) segStart
+ (segments at: 0) segSize
- (manager bridgeSize)).
manager
initSegmentBridgeWithBytes: manager bridgeSize at: bridge;
setEndOfMemory: bridge!
Item was changed:
----- Method: TAssignmentNode>>emitCCodeOn:level:generator: (in category 'C code generation') -----
emitCCodeOn: aStream level: level generator: aCodeGen
expression isSwitch ifTrue:
[^expression emitCCodeOn: aStream addToEndOfCases: self level: level generator: aCodeGen].
expression isLiteralArrayDeclaration ifTrue:
[^self emitLiteralArrayDeclarationOn: aStream level: level generator: aCodeGen].
+ (expression isSend and: [expression isValueExpansion]) ifTrue:
+ [^self emitValueExpansionOn: aStream level: level generator: aCodeGen].
variable emitCCodeOn: aStream level: level generator: aCodeGen.
self isVariableUpdatingAssignment
ifTrue:
[aStream
space;
nextPutAll: expression selector; "+ or -"
nextPut: $=;
space.
expression args first emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen]
ifFalse:
[aStream space; nextPut: $=; space.
expression emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen]!
Item was added:
+ ----- Method: TAssignmentNode>>emitValueExpansionOn:level:generator: (in category 'C code generation') -----
+ emitValueExpansionOn: aStream level: level generator: aCodeGen
+ | stmtList lastStmt copy |
+ self assert: (expression isSend and: [expression isValueExpansion]).
+ stmtList := expression receiver.
+ lastStmt := stmtList statements last.
+ lastStmt = variable ifTrue:
+ [^expression emitCCodeOn: aStream level: level generator: aCodeGen].
+ copy := stmtList copy.
+ copy statements
+ at: stmtList statements size
+ put: (TAssignmentNode new
+ setVariable: variable
+ expression: lastStmt).
+ (TSendNode new
+ setSelector: expression selector
+ receiver: copy
+ arguments: expression args)
+ emitCCodeOn: aStream level: level generator: aCodeGen.!
More information about the Vm-dev
mailing list