[Vm-dev] VM Maker: VMMaker.oscog-eem.469.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Oct 21 00:18:43 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.469.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.469
Author: eem
Time: 20 October 2013, 5:15:49.893 pm
UUID: 9a1b817f-2cee-487a-8c07-6444e28a16aa
Ancestors: VMMaker.oscog-eem.468
Rethink the sorting of free space for exact-fit compact post global
GC. Since the sweep to free unmarked objects is linear through old
space it can also sort free space. So
freeUnmarkedObjectsAndNilUnmarkedWeaklingSlots =>
freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace (glup ;-) ).
Make sure that bridges are marked so they won't be freed in
fUONUWASACFS.
Add freeChunkPrevIndex to link next nodes to their precedessors
so that free chunks can be quickly removed during coallescing.
Implement an iterative freeTreeNodesDo: so that Slang can inline the
block arguments to it.
Refactor the code that removes a tree node in
allocateOldSpaceChunkOfBytes: et al, out into
unlinkSolitaryFreeTreeNode:
Still have to reverse small list heads post-sweep and account for free space properly.
=============== Diff against VMMaker.oscog-eem.468 ===============
Item was added:
+ ----- 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:
----- Method: Spur32BitMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'segments') -----
initSegmentBridgeWithBytes: numBytes at: address
<var: #numBytes type: #usqLong>
| numSlots |
"must have room for a double header"
self assert: (numBytes \\ self allocationUnit = 0
and: [numBytes >= (self baseHeaderSize + self baseHeaderSize)]).
self flag: #endianness.
numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
self longAt: address put: numSlots;
longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift;
longAt: address + 8 put: (1 << self pinnedBitShift)
+ (self wordIndexableFormat << self formatShift)
+ self segmentBridgePun;
+ longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift
+ + (1 << self markedBitHalfShift)!
- longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift!
Item was removed:
- ----- Method: Spur32BitMemoryManager>>reInitSegmentBridge: (in category 'segments') -----
- reInitSegmentBridge: bridgeOop
- "On image write the segment manager replaces the header of the bridge
- with the size of the following segment. This method restores that header."
- <var: #numBytes type: #usqLong>
- self longAt: bridgeOop put: (1 << self pinnedBitShift)
- + (self wordIndexableFormat << self formatShift)
- + self segmentBridgePun;
- longAt: bridgeOop + 4 put: self numSlotsMask << self numSlotsHalfShift!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>sortedFreeObject: (in category 'free space') -----
+ sortedFreeObject: objOop
+ "A variant of freeObject: that assumes objOop already has its valid number of slots, etc,
+ but makes sure the freeChunkPrevIndex is valid."
+ | bytes treeNode nextNode |
+ bytes := self bytesInObject: objOop.
+ totalFreeOldSpace := totalFreeOldSpace + bytes.
+ self longAt: objOop put: 0.
+ treeNode := self addToFreeList: objOop bytes: bytes.
+ treeNode ~= 0 ifTrue:
+ [self storePointer: self freeChunkPrevIndex ofFreeChunk: objOop withValue: treeNode].
+ nextNode := self fetchPointer: self freeChunkNextIndex ofObject: objOop.
+ nextNode ~= 0 ifTrue:
+ [self storePointer: self freeChunkPrevIndex ofFreeChunk: nextNode withValue: objOop]!
Item was changed:
----- Method: Spur64BitMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'segments') -----
initSegmentBridgeWithBytes: numBytes at: address
| numSlots |
<var: #numBytes type: #usqLong>
self assert: (numBytes >= (self baseHeaderSize + self baseHeaderSize)
and: [numBytes \\ self allocationUnit = 0]).
numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
self longAt: address
put: self numSlotsMask << self numSlotsFullShift + numSlots;
longAt: address + self baseHeaderSize
put: (self numSlotsMask << self numSlotsFullShift)
+ (1 << self pinnedBitShift)
+ + (1 << self markedBitFullShift)
+ (self wordIndexableFormat << self formatShift)
+ self segmentBridgePun!
Item was removed:
- ----- Method: Spur64BitMemoryManager>>reInitSegmentBridge: (in category 'segments') -----
- reInitSegmentBridge: bridgeOop
- "On image write the segment manager replaces the header of the bridge
- with the size of the following segment. This method restores that header."
- self longAt: bridgeOop
- put: (self numSlotsMask << self numSlotsFullShift)
- + (1 << self pinnedBitShift)
- + (self wordIndexableFormat << self formatShift)
- + self segmentBridgePun!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') -----
addToFreeList: freeChunk bytes: chunkBytes
+ "Add freeChunk to the relevant freeList.
+ For the benefit of sortedFreeObject:, if freeChunk is large, answer the treeNode it
+ is added to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
| childBytes parent child index |
"coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk."
self assert: (self isFreeObject: freeChunk).
self assert: chunkBytes = (self bytesInObject: freeChunk).
index := chunkBytes / self allocationUnit.
index < self numFreeLists ifTrue:
[self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index).
freeLists at: index put: freeChunk.
freeListsMask := freeListsMask bitOr: 1 << index.
+ ^0].
- ^self].
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.
"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].
- ^self].
"walk down the tree"
parent := child.
child := self fetchPointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofObject: child].
parent = 0 ifTrue:
[self assert: (freeLists at: 0) = 0.
freeLists at: 0 put: freeChunk.
freeListsMask := freeListsMask bitOr: 1.
+ ^0].
- ^self].
"insert in tree"
self storePointer: self freeChunkParentIndex
ofFreeChunk: freeChunk
withValue: parent.
+ self storePointer: (childBytes > chunkBytes
- self storePointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
+ withValue: freeChunk.
+ ^0!
- withValue: freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>allFreeObjectsDo: (in category 'free space') -----
allFreeObjectsDo: aBlock
| obj |
1 to: self numFreeLists - 1 do:
[:i|
obj := freeLists at: i.
[obj ~= 0] whileTrue:
[aBlock value: obj.
obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]].
+ self allObjectsInFreeTreeDo: aBlock!
- self allObjectsInFreeTree: (freeLists at: 0) do: aBlock!
Item was added:
+ ----- 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]!
Item was added:
+ ----- 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>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
allocateOldSpaceChunkOfBytes: chunkBytes
"Answer a chunk of oldSpace from the free lists, if available,
otherwise answer nil. Break up a larger chunk if one of the
exact size does not exist. N.B. the chunk is simply a pointer, it
has no valid header. The caller *must* fill in the header correctly."
+ | initialIndex chunk index nodeBytes parent child |
- | initialIndex chunk index nodeBytes parent child smaller larger |
"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:
[(chunk := freeLists at: initialIndex) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self assert: (self isValidFreeObject: chunk).
^self unlinkFreeChunk: chunk atIndex: initialIndex].
freeListsMask := freeListsMask - (1 << initialIndex)].
"first search for free chunks of a multiple of chunkBytes in size"
index := initialIndex.
[(index := index + index) < self numFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[((freeListsMask anyMask: 1 << index)
and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self assert: (self isValidFreeObject: chunk).
self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: chunk) + chunkBytes.
^chunk]].
"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:
[(chunk := freeLists at: index) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self assert: (self isValidFreeObject: chunk).
self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: chunk) + chunkBytes.
^chunk].
freeListsMask := freeListsMask - (1 << index)]]].
"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."
parent := 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."
[chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: child.
chunk ~= 0 ifTrue:
[self assert: (self isValidFreeObject: chunk).
self storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
^self startOfObject: chunk].
child := 0] "break out of loop to remove interior node"
ifFalse:
["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:
[parent := child. "parent will be smallest node >= chunkBytes + allocationUnit"
nodeBytes := childBytes.
child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
parent = 0 ifTrue:
[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
^nil].
"self printFreeChunk: parent"
self assert: (nodeBytes = chunkBytes or: [nodeBytes >= (chunkBytes + (2 * self allocationUnit))]).
self assert: (self bytesInObject: parent) = nodeBytes.
"attempt to remove from list"
+ chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent.
- chunk := self fetchPointer: self freeChunkNextIndex
- ofFreeChunk: parent.
chunk ~= 0 ifTrue:
[self assert: (chunkBytes = nodeBytes or: [chunkBytes + self allocationUnit < nodeBytes]).
self storePointer: self freeChunkNextIndex
ofFreeChunk: parent
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk].
+ "no list; remove the interior node"
- "no list; remove an interior node; reorder tree simply. two cases (which have mirrors, for four total):
- case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
- ___ ___
- | P | | P |
- _/_ _/_
- | N | => | S |
- _/_
- | S |
-
- case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
- add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
- ___ ___
- | P | | P |
- _/_ _/_
- | N | => | R |
- _/_ _\_ _/_
- | L | | R | | L |"
-
chunk := parent.
+ self unlinkSolitaryFreeTreeNode: chunk.
+
- smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
- larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
- parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
- parent = 0
- ifTrue: "no parent; stitch the subnodes back into the root"
- [smaller = 0
- ifTrue:
- [self storePointer: self freeChunkParentIndex ofFreeChunk: larger withValue: 0.
- freeLists at: 0 put: larger]
- ifFalse:
- [self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: 0.
- freeLists at: 0 put: smaller.
- larger ~= 0 ifTrue:
- [self addFreeSubTree: larger]]]
- ifFalse: "parent; stitch back into appropriate side of parent."
- [smaller = 0
- ifTrue:
- [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
- ifTrue: [self freeChunkSmallerIndex]
- ifFalse: [self freeChunkLargerIndex])
- ofFreeChunk: parent
- withValue: larger.
- larger ~= 0 ifTrue:
- [self storePointer: self freeChunkParentIndex
- ofFreeChunk: larger
- withValue: parent]]
- ifFalse:
- [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
- ifTrue: [self freeChunkSmallerIndex]
- ifFalse: [self freeChunkLargerIndex])
- ofFreeChunk: parent
- withValue: smaller.
- self storePointer: self freeChunkParentIndex
- ofFreeChunk: smaller
- withValue: parent.
- larger ~= 0 ifTrue:
- [self addFreeSubTree: larger]]].
"if there's space left over, add the fragment back."
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk!
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."
+ | initialIndex node nodeBytes child |
- | initialIndex node nodeBytes parent child smaller larger |
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
initialIndex := chunkBytes / self allocationUnit.
initialIndex < self numFreeLists ifTrue:
[(1 << initialIndex <= freeListsMask
and: [(node := freeLists at: initialIndex) ~= 0]) ifTrue:
[self assert: node = (self startOfObject: node).
self assert: (self isValidFreeObject: node).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self unlinkFreeChunk: node atIndex: 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.
- "no list; remove an interior node; reorder tree simply. two cases (which have mirrors, for four total):
- case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
- ___ ___
- | P | | P |
- _/_ _/_
- | N | => | S |
- _/_
- | S |
-
- case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
- add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
- ___ ___
- | P | | P |
- _/_ _/_
- | N | => | R |
- _/_ _\_ _/_
- | L | | R | | L |"
-
- smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node.
- larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: node.
- parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: node.
- parent = 0
- ifTrue: "no parent; stitch the subnodes back into the root"
- [smaller = 0
- ifTrue:
- [self storePointer: self freeChunkParentIndex ofFreeChunk: larger withValue: 0.
- freeLists at: 0 put: larger]
- ifFalse:
- [self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: 0.
- freeLists at: 0 put: smaller.
- larger ~= 0 ifTrue:
- [self addFreeSubTree: larger]]]
- ifFalse: "parent; stitch back into appropriate side of parent."
- [smaller = 0
- ifTrue: [self storePointer: (node = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
- ifTrue: [self freeChunkSmallerIndex]
- ifFalse: [self freeChunkLargerIndex])
- ofFreeChunk: parent
- withValue: larger.
- self storePointer: self freeChunkParentIndex
- ofObject: larger
- withValue: parent]
- ifFalse:
- [self storePointer: (node = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
- ifTrue: [self freeChunkSmallerIndex]
- ifFalse: [self freeChunkLargerIndex])
- ofFreeChunk: parent
- withValue: smaller.
- self storePointer: self freeChunkParentIndex
- ofObject: smaller
- withValue: parent.
- larger ~= 0 ifTrue:
- [self addFreeSubTree: larger]]].
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: node!
Item was added:
+ ----- 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>>coallesce:and: (in category 'gc - global') -----
+ coallesce: obj1 and: obj2
+ self subclassResponsibility!
Item was added:
+ ----- 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 added:
+ ----- Method: SpurMemoryManager>>freeChunkPrevIndex (in category 'free space') -----
+ freeChunkPrevIndex
+ "for quickly unlinking nodes in the tree of large free chunks."
+ ^5!
Item was added:
+ ----- Method: SpurMemoryManager>>freeTreeNodesDo: (in category 'free space') -----
+ freeTreeNodesDo: aBlock
+ "Enumerate all nodes in the free tree (in order, smaller to larger),
+ 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."
+ <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:
+ [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 removed:
- ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndNilUnmarkedWeaklingSlots (in category 'gc - global') -----
- freeUnmarkedObjectsAndNilUnmarkedWeaklingSlots
- self checkFreeSpace.
- scavenger forgetUnmarkedRememberedObjects.
- self allOldSpaceObjectsDo:
- [:o|
- (self isMarked: o)
- ifTrue:
- [self setIsMarkedOf: o to: false.
- ((self isWeakNonImm: o)
- and: [self nilUnmarkedWeaklingSlots: o]) ifTrue:
- [coInterpreter signalFinalization: o]]
- ifFalse:
- [self assert: (self isRemembered: o) not. "scavenger should have clearer this above"
- self freeObject: o]].
- self checkFreeSpace!
Item was added:
+ ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace (in category 'gc - global') -----
+ freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace
+ self checkFreeSpace.
+ scavenger forgetUnmarkedRememberedObjects.
+ "for coallescing, specifically detatchLargeFreeObject: below, link large chunks to their tree nodes."
+ self buildPrevLinksForLargeFreeChunks.
+ self checkFreeSpace.
+ "for sorting free space throw away the small list heads, rebuilding them below.".
+ self resetSmallFreeListHeads.
+ self allOldSpaceEntitiesForCoallescingDo:
+ [:o|
+ (self isMarked: o)
+ ifTrue:
+ [self setIsMarkedOf: o to: false.
+ ((self isWeakNonImm: o)
+ and: [self nilUnmarkedWeaklingSlots: o]) ifTrue:
+ [coInterpreter signalFinalization: o]]
+ 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)
+ ifTrue: "common case"
+ [(self isLargeFreeObject: o) ifFalse:
+ [self sortedFreeObject: o]]
+ ifFalse: "coallescing; rare case"
+ [self assert: (self isRemembered: o) not.
+ (self isLargeFreeObject: o) ifTrue:
+ [self detatchLargeFreeObject: o].
+ [statCoallesces := statCoallesces + 1.
+ here := self coallesce: here and: next.
+ next := self objectAfter: here limit: endOfMemory.
+ next = endOfMemory or: [self isMarked: next]] whileFalse.
+ self sortedFreeObject: here]]].
+ self checkFreeSpace!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
self markObjects.
+ self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoallesceFreeSpace.
- self freeUnmarkedObjectsAndNilUnmarkedWeaklingSlots.
self exactFitCompact!
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.
+ statCoallesces := 0.
"We can initialize things that are allocated but are lazily initialized."
unscannedEphemerons := 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 added:
+ ----- Method: SpurMemoryManager>>isLargeFreeObject: (in category 'free space') -----
+ isLargeFreeObject: objOop
+ ^(self isFreeObject: objOop)
+ and: [(self bytesInObject: objOop) / self allocationUnit >= self numFreeLists]!
Item was changed:
----- Method: SpurMemoryManager>>markAccessibleObjects (in category 'gc - global') -----
markAccessibleObjects
self assert: self validClassTableRootPages.
+ self assert: segmentManager allBridgesMarked.
marking := true.
self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord resetTo: 1]].
self markAndTraceObjStack: self markStack andContents: false.
self assert: self validClassTableRootPages.
self markAndTraceObjStack: self ephemeronQueue andContents: true.
self assert: self validClassTableRootPages.
self markAndTrace: self freeListsObj.
self markAndTrace: hiddenRootsObj.
self markAndTrace: self specialObjectsOop.
coInterpreter markAndTraceInterpreterOops: true.
self markAndFireEphemerons.
marking := false!
Item was removed:
- ----- Method: SpurMemoryManager>>reInitSegmentBridge: (in category 'segments') -----
- reInitSegmentBridge: bridgeOop
- "On image write the segment manager replaces the header of the bridge
- with the size of the following segment. This method restores that header."
- ^self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>resetSmallFreeListHeads (in category 'free space') -----
+ resetSmallFreeListHeads
+ 1 to: self numFreeLists - 1 do:
+ [:i| freeLists at: i put: 0]!
Item was changed:
----- Method: SpurMemoryManager>>sortFreeSpace (in category 'free space') -----
sortFreeSpace
"Sort free space for best-fit compaction. Sort the individual free lists so that
the lowest address is at the head of each list. Sort the large chunks through the
freeChunkNextAddressIndex from low to high, with the head in sortedFreeChunks."
self checkFreeSpace.
1 to: self numFreeLists - 1 do:
[:i| self sortFreeListAt: i].
sortedFreeChunks := 0.
+ self allObjectsInFreeTreeDo:
- self allObjectsInFreeTree: (freeLists at: 0) do:
[:f| | node prev |
node := sortedFreeChunks.
prev := 0.
[node ~= 0
and: [node < f]] whileTrue:
[prev := node.
node := self fetchPointer: self freeChunkNextAddressIndex ofObject: node].
"insert the node into the sorted list"
self assert: (node = 0 or: [node > f]).
prev = 0
ifTrue:
[sortedFreeChunks := f]
ifFalse:
[self storePointer: self freeChunkNextAddressIndex
ofFreeChunk: prev
withValue: f].
self storePointer: self freeChunkNextAddressIndex
ofFreeChunk: f
withValue: node].
self assert: self sortedFreeChunksAreSorted.
self checkFreeSpace!
Item was added:
+ ----- Method: SpurMemoryManager>>sortedFreeObject: (in category 'free space') -----
+ sortedFreeObject: objOop
+ self subclassResponsibility!
Item was added:
+ ----- 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 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]!
Item was added:
+ ----- Method: SpurMemoryManager>>unlinkSolitaryFreeTreeNode: (in category 'free space') -----
+ unlinkSolitaryFreeTreeNode: freeTreeNode
+ "Unlink a freeTreeNode. Assumes the node has no list (null next link)."
+ | parent smaller larger |
+
+ "case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
+ ___ ___
+ | P | | P |
+ _/_ _/_
+ | N | => | S |
+ _/_
+ | S |
+
+ case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
+ add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
+ ___ ___
+ | P | | P |
+ _/_ _/_
+ | N | => | R |
+ _/_ _\_ _/_
+ | L | | R | | L |"
+
+ smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeTreeNode.
+ larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeTreeNode.
+ parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: freeTreeNode.
+ parent = 0
+ ifTrue: "no parent; stitch the subnodes back into the root"
+ [smaller = 0
+ ifTrue:
+ [self storePointer: self freeChunkParentIndex ofFreeChunk: larger withValue: 0.
+ freeLists at: 0 put: larger]
+ ifFalse:
+ [self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: 0.
+ freeLists at: 0 put: smaller.
+ larger ~= 0 ifTrue:
+ [self addFreeSubTree: larger]]]
+ ifFalse: "parent; stitch back into appropriate side of parent."
+ [smaller = 0
+ ifTrue: [self storePointer: (freeTreeNode = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
+ ifTrue: [self freeChunkSmallerIndex]
+ ifFalse: [self freeChunkLargerIndex])
+ ofFreeChunk: parent
+ withValue: larger.
+ self storePointer: self freeChunkParentIndex
+ ofObject: larger
+ withValue: parent]
+ ifFalse:
+ [self storePointer: (freeTreeNode = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
+ ifTrue: [self freeChunkSmallerIndex]
+ ifFalse: [self freeChunkLargerIndex])
+ ofFreeChunk: parent
+ withValue: smaller.
+ self storePointer: self freeChunkParentIndex
+ ofObject: smaller
+ withValue: parent.
+ larger ~= 0 ifTrue:
+ [self addFreeSubTree: larger]]]!
Item was added:
+ ----- Method: SpurSegmentManager>>allBridgesMarked (in category 'debug support') -----
+ allBridgesMarked
+ 0 to: numSegments - 1 do:
+ [:i| | bridgeObj |
+ bridgeObj := (segments at: i) segStart
+ + (segments at: i) segSize
+ - manager baseHeaderSize.
+ self assert: (manager isSegmentBridge: bridgeObj).
+ (manager isMarked: bridgeObj) ifFalse:
+ [^false]].
+ ^true
+
+ "for debugging:"
+ "(0 to: numSegments - 1) select:
+ [:i| | bridgeObj |
+ bridgeObj := (segments at: i) segStart
+ + (segments at: i) segSize
+ - manager baseHeaderSize.
+ self assert: (manager isSegmentBridge: bridgeObj).
+ manager isMarked: bridgeObj]"!
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)
- (self addressOf: (segments at: 0))
segStart: manager newSpaceLimit;
segSize: manager endOfMemory - manager newSpaceLimit.
"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!
More information about the Vm-dev
mailing list