[Vm-dev] VM Maker: VMMaker.oscog-eem.440.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Oct 8 17:39:59 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.440.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.440
Author: eem
Time: 8 October 2013, 10:36:50.516 am
UUID: 6c650edc-83c9-42c3-bd6f-f22edc1304ed
Ancestors: VMMaker.oscog-eem.439
Move freeLists to heap, immediately following trueObj.
Make freeLists size of a machibe word. 98.8% of objects are <= 31
allocationUnits in size in the 32-bit VM. So making freeListsMask
64-bits doesn't make sense. Best keep it in 32-bits and have it fit
in a register.
=============== Diff against VMMaker.oscog-eem.439 ===============
Item was added:
+ ----- Method: Spur32BitMemoryManager>>numFreeLists (in category 'free space') -----
+ numFreeLists
+ "Answer the number of free lists. We use freeListsMask, a bitmap, to avoid
+ reading empty list heads. This hsould fit in a machine word to end up in a
+ register during free chunk allocation."
+ ^32!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>numFreeLists (in category 'free space') -----
+ numFreeLists
+ "Answer the number of free lists. We use freeListsMask, a bitmap, to avoid
+ reading empty list heads. This hsould fit in a machine word to end up in a
+ register during free chunk allocation."
+ ^64!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
initialize
"CogObjectMemory initialize"
- NumFreeLists := 65. "One for each size up to and including 64 slots. One for sizes > 64 slots."
CheckObjectOverwrite := true.
"The remap buffer support is for compatibility; Spur doesn't GC during allocation.
Eventually this should die."
RemapBufferSize := 25!
Item was changed:
----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') -----
addToFreeList: freeChunk bytes: chunkBytes
| 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:
- index < NumFreeLists ifTrue:
[self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index).
freeLists at: index put: freeChunk.
freeListsMask := freeListsMask bitOr: 1 << index.
^self].
freeListsMask := freeListsMask bitOr: 1.
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.
^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.
^self].
"insert in tree"
self storePointer: self freeChunkParentIndex
ofFreeChunk: freeChunk
withValue: parent.
self storePointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>allFreeObjectsDo: (in category 'free space') -----
allFreeObjectsDo: aBlock
| obj |
+ 1 to: self numFreeLists - 1 do:
- 1 to: NumFreeLists - 1 do:
[:i|
obj := freeLists at: i.
[obj ~= 0] whileTrue:
[aBlock value: obj.
obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]].
self allObjectsInFreeTree: (freeLists at: 0) do: aBlock!
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 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:
- (initialIndex < 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
- [(index := index + index) < 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
- [(index := index + 1) < 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"
self halt.
^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 ~= 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 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.
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.
self storePointer: self freeChunkParentIndex
ofObject: 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
ofObject: 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 chunk nodeBytes parent child smaller larger |
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
initialIndex := chunkBytes / self allocationUnit.
+ initialIndex < self numFreeLists ifTrue:
- initialIndex < NumFreeLists ifTrue:
[(1 << initialIndex <= freeListsMask
and: [(chunk := freeLists at: initialIndex) ~= 0]) ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self assert: (self isValidFreeObject: chunk).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self unlinkFreeChunk: chunk 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."
parent := chunk := 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).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: chunk].
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:
[parent := child.
nodeBytes := childBytes.
child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
"if no chunk, there was no exact fit"
chunk = 0 ifTrue:
[^nil].
"self printFreeChunk: parent"
self assert: nodeBytes = chunkBytes.
self assert: (self bytesInObject: parent) = chunkBytes.
"can't be a list; would have removed and returned it above."
self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent) = 0.
"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.
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.
self storePointer: self freeChunkParentIndex
ofObject: 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
ofObject: smaller
withValue: parent.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]]].
^self startOfObject: chunk!
Item was changed:
----- Method: SpurMemoryManager>>bitsSetInFreeSpaceMaskForAllFreeLists (in category 'debug support') -----
bitsSetInFreeSpaceMaskForAllFreeLists
+ 0 to: self numFreeLists - 1 do:
- 0 to: NumFreeLists - 1 do:
[:i|
((freeLists at: i) ~= 0
and: [1 << i noMask: freeListsMask]) ifTrue:
[^false]].
^true!
Item was changed:
----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') -----
bytesInFreeTree: freeNode
| freeBytes bytesInObject listNode |
freeNode = 0 ifTrue: [^0].
freeBytes := 0.
bytesInObject := self bytesInObject: freeNode.
+ self assert: bytesInObject / self allocationUnit >= self numFreeLists.
- self assert: bytesInObject / self allocationUnit >= NumFreeLists.
listNode := freeNode.
[listNode ~= 0] whileTrue:
["self printFreeChunk: listNode"
self assert: (self isValidFreeObject: listNode).
freeBytes := freeBytes + bytesInObject.
self assert: bytesInObject = (self bytesInObject: listNode).
listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode].
^freeBytes
+ (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeNode))
+ (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeNode))!
Item was changed:
----- Method: SpurMemoryManager>>checkHeapIntegrity (in category 'debug support') -----
checkHeapIntegrity
"Perform an integrity/leak check using the heapMap. Assume
clearLeakMapAndMapAccessibleObjects has set a bit at each
object's header. Scan all objects in the heap checking that every
pointer points to a header. Scan the rootTable, remapBuffer and
extraRootTable checking that every entry is a pointer to a header.
Check that the number of roots is correct and that all rootTable
entries have their rootBit set. Answer if all checks pass."
| prevObj prevPrevObj ok numRememberedRootsInHeap |
<inline: false>
ok := true.
numRememberedRootsInHeap := 0.
self allHeapEntitiesDo:
[:obj| | containsYoung fieldOop classIndex classOop |
(self isFreeObject: obj) ifFalse:
[containsYoung := false.
(self isRemembered: obj) ifTrue:
[numRememberedRootsInHeap := numRememberedRootsInHeap + 1.
(scavenger isInRememberedTable: obj) ifFalse:
[coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
self eek.
ok := false]].
(self isForwarded: obj)
ifTrue:
[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
self eek.
ok := false].
(self isYoung: fieldOop) ifTrue:
[containsYoung := true]]
ifFalse:
[classOop := self classAtIndex: (classIndex := self classIndexOf: obj).
+ ((classOop isNil or: [classOop = nilObj])
+ and: [obj ~= self freeListsObject]) ifTrue:
- (classOop isNil or: [classOop = nilObj]) ifTrue:
[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
self eek.
ok := false].
self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do:
[:ptr|
fieldOop := self longAt: obj + ptr.
(self isNonImmediate: fieldOop) ifTrue:
[| fi |
fi := ptr - self baseHeaderSize / self wordSize.
(fieldOop bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
self eek.
ok := false].
"don't be misled by CogMethods; they appear to be young, but they're not"
((self isYoung: fieldOop) and: [fieldOop >= startOfMemory]) ifTrue:
[containsYoung := true]]]]].
(containsYoung and: [(self isYoung: obj) not]) ifTrue:
[(self isRemembered: obj) ifFalse:
[coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
self eek.
ok := false]]].
prevPrevObj := prevObj.
prevObj := obj].
numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
[coInterpreter
print: 'root count mismatch. #heap roots ';
printNum: numRememberedRootsInHeap;
print: '; #roots ';
printNum: scavenger rememberedSetSize;
cr.
self eek.
"But the system copes with overflow..."
self flag: 'no support for remembered set overflow yet'.
"ok := rootTableOverflowed and: [needGCFlag]"].
scavenger rememberedSetWithIndexDo:
[:obj :i|
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned oop in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(self isYoung: obj) ifTrue:
[coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]]]].
self flag: 'no support for remap buffer yet'.
"1 to: remapBufferCount do:
[:ri|
obj := remapBuffer at: ri.
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]]]."
self flag: 'no support for extraRoots yet'.
"1 to: extraRootCount do:
[:ri|
obj := (extraRoots at: ri) at: 0.
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
self eek.
ok := false]]]."
^ok!
Item was added:
+ ----- Method: SpurMemoryManager>>classIndexFieldWidth (in category 'header format') -----
+ classIndexFieldWidth
+ "22-bit class mask => ~ 4M classes"
+ ^22!
Item was changed:
----- Method: SpurMemoryManager>>classTableRootObj: (in category 'accessing') -----
classTableRootObj: anOop
"For mapInterpreterOops"
classTableRootObj := anOop.
+ classTableFirstPage := self fetchPointer: 0 ofObject: classTableRootObj.
+ self assert: (self numSlotsOf: classTableRootObj) = (1 << (self classIndexFieldWidth - self classTableMajorIndexShift)).
+ self assert: (self numSlotsOf: classTableFirstPage) - 1 = self classTableMinorIndexMask!
- classTableFirstPage := self fetchPointer: 0 ofObject: classTableRootObj!
Item was added:
+ ----- Method: SpurMemoryManager>>freeListsObject (in category 'free space') -----
+ freeListsObject
+ ^self objectAfter: trueObj!
Item was changed:
----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
initialize
"We can put all initializatins that set something to 0 or to false here.
In C all global variables are initialized to 0, and 0 is false."
- freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0).
remapBuffer := Array new: RemapBufferSize.
remapBufferCount := 0.
freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
checkForLeaks := 0.
needGCFlag := signalLowSpace := scavengeInProgress := false.
becomeEffectsFlags := 0.
statScavenges := statIncrGCs := statFullGCs := 0.
statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0.
statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
"We can also initialize here anything that is only for simulation."
heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]!
Item was changed:
----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
initializeObjectMemory: bytesToShift
"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
"Assume: image reader initializes the following variables:
memory
memoryLimit
specialObjectsOop
lastHash
"
<inline: false>
+ | freeListObj |
"image may be at a different address; adjust oops for new location"
self adjustAllOopsBy: bytesToShift.
- self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
-
specialObjectsOop := specialObjectsOop + bytesToShift.
"heavily used special objects"
nilObj := self splObj: NilObject.
falseObj := self splObj: FalseObject.
trueObj := self splObj: TrueObject.
+ "In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
+ conditional branch code as a result). In addition, Spur places the free lists and
+ class table root page immediately following them."
+ self assert: nilObj = newSpaceLimit.
+ self assert: falseObj = (self objectAfter: nilObj).
+ self assert: trueObj = (self objectAfter: falseObj).
+ freeListObj := self objectAfter: trueObj.
+ self assert: (self numSlotsOf: freeListObj) = self numFreeLists.
+ self assert: (self formatOf: freeListObj) = (self wordSize = 4
+ ifTrue: [self firstLongFormat]
+ ifFalse: [self sixtyFourBitIndexableFormat]).
+ freeLists := self firstIndexableField: freeListObj.
+ self classTableRootObj: (self objectAfter: freeListObj).
+
+ self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
+
+ "lowSpaceThreshold := 0.
- "rootTableCount := 0.
- rootTableOverflowed := false.
- lowSpaceThreshold := 0.
signalLowSpace := false.
- compStart := 0.
- compEnd := 0.
- fwdTableNext := 0.
- fwdTableLast := 0.
remapBufferCount := 0.
tenuringThreshold := 2000. ""tenure all suriving objects if survivor count is over this threshold""
growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing""
shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking""
""garbage collection statistics""
statFullGCs := 0.
statFullGCUsecs := 0.
statIncrGCs := 0.
statIncrGCUsecs := 0.
statTenures := 0.
statRootTableOverflows := 0.
statGrowMemory := 0.
statShrinkMemory := 0.
forceTenureFlag := 0.
gcBiasToGrow := 0.
gcBiasToGrowGCLimit := 0.
extraRootCount := 0."!
Item was changed:
----- Method: SpurMemoryManager>>isValidFreeObject: (in category 'free space') -----
isValidFreeObject: objOop
| chunk |
^(self isFreeObject: objOop)
and: [((chunk := (self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop)) = 0
or: [self isFreeObject: chunk])
+ and: [(self bytesInObject: objOop) / self allocationUnit < self numFreeLists
- and: [(self bytesInObject: objOop) / self allocationUnit < NumFreeLists
or: [((chunk := (self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop)) = 0
or: [self isFreeObject: chunk])
and: [((chunk := (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop)) = 0
or: [self isFreeObject: chunk])
and: [(chunk := (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop)) = 0
or: [self isFreeObject: chunk]]]]]]!
Item was changed:
----- Method: SpurMemoryManager>>lowestFreeChunkAssumingSortedFreeSpace (in category 'free space') -----
lowestFreeChunkAssumingSortedFreeSpace
| lowest |
lowest := sortedFreeChunks = 0
ifTrue: [endOfMemory]
ifFalse: [sortedFreeChunks].
+ 1 to: self numFreeLists - 1 do:
- 1 to: NumFreeLists - 1 do:
[:i| | chunk |
chunk := freeLists at: i.
(chunk ~= 0 and: [chunk < lowest]) ifTrue:
[lowest := chunk]].
^lowest!
Item was added:
+ ----- Method: SpurMemoryManager>>numFreeLists (in category 'free space') -----
+ numFreeLists
+ "Answer the number of free lists. We use freeListsMask, a bitmap, to avoid
+ reading empty list heads. This hsould fit in a machine word to end up in a
+ register during free chunk allocation."
+ ^self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') -----
printFreeChunk: freeChunk
<doNotGenerate>
| numBytes |
numBytes := self bytesInObject: freeChunk.
coInterpreter
print: 'freeChunk '; printHexPtrnp: freeChunk;
print: ' bytes '; printNum: numBytes;
print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: freeChunk).
+ numBytes / self allocationUnit > self numFreeLists ifTrue:
- numBytes / self allocationUnit > NumFreeLists ifTrue:
[coInterpreter
print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex
ofFreeChunk: freeChunk);
print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex
ofFreeChunk: freeChunk);
print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex
ofFreeChunk: freeChunk)].
coInterpreter cr!
Item was added:
+ ----- Method: SpurMemoryManager>>sixtyFourBitLongsClassIndexPun (in category 'class table') -----
+ sixtyFourBitLongsClassIndexPun
+ "Class puns are class indices not used by any class. There may be
+ an entry for the pun that refers to the notional class of objects with
+ this class index. But because the index doesn't match the class it
+ won't show up in allInstances, hence hiding the object with a pun as
+ its class index. The puns occupy indices 16 through 31."
+ ^19!
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:
- 1 to: NumFreeLists - 1 do:
[:i| self sortFreeListAt: i].
sortedFreeChunks := 0.
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>>thirtyTwoBitLongsClassIndexPun (in category 'class table') -----
+ thirtyTwoBitLongsClassIndexPun
+ "Class puns are class indices not used by any class. There may be
+ an entry for the pun that refers to the notional class of objects with
+ this class index. But because the index doesn't match the class it
+ won't show up in allInstances, hence hiding the object with a pun as
+ its class index. The puns occupy indices 16 through 31."
+ ^18!
Item was changed:
----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
totalFreeListBytes
| freeBytes bytesInObject obj |
freeBytes := 0.
+ 1 to: self numFreeLists - 1 do:
- 1 to: NumFreeLists - 1 do:
[:i|
bytesInObject := i * self allocationUnit.
obj := freeLists at: i.
[obj ~= 0] whileTrue:
[freeBytes := freeBytes + bytesInObject.
self assert: bytesInObject = (self bytesInObject: obj).
self assert: (self isValidFreeObject: obj).
obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]].
^freeBytes + (self bytesInFreeTree: (freeLists at: 0))!
More information about the Vm-dev
mailing list