[Vm-dev] VM Maker: VMMaker.oscog-eem.473.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Oct 22 18:03:15 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.473.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.473
Author: eem
Time: 22 October 2013, 10:59:55.285 am
UUID: 309f7322-d09f-4c20-b826-b5b4c4a48529
Ancestors: VMMaker.oscog-eem.472
Make sortedFreeChunks a temp of fUONUWSASACFS. Hence
rebuildFreeTreeFromSortedFreeChunks =>
rebuildFreeTreeFrom:.
Fix basic operations and asserts and for obj stacks
(tested by making obj stacks small).
Fix addFreeSubTree: to update parent link.
Provide allocateOldSpaceChunkOfExactlyBytes:suchThat: for
exactFitCompact. Implement exactFitCOmpact in terms of
highestObjects.
Fix checkHeapIntegrity to cope with obj stacks.
Shrink inFreeTreeReplace:with: to do more in its loop.
Remove some obsolete compaction code.
PRovide VMClass>>str:cat:
=============== Diff against VMMaker.oscog-eem.472 ===============
Item was changed:
----- Method: Spur32BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') -----
setIsMarkedOf: objOop to: aBoolean
+ self assert: (self isFreeObject: objOop) not.
self flag: #endianness.
self longAt: objOop + 4
put: (aBoolean
ifTrue: [(self longAt: objOop + 4) bitOr: 1 << self markedBitHalfShift]
ifFalse: [(self longAt: objOop + 4) bitAnd: (1 << self markedBitHalfShift) bitInvert32])!
Item was changed:
----- Method: Spur64BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') -----
setIsMarkedOf: objOop to: aBoolean
+ self assert: (self isFreeObject: objOop) not.
self longAt: objOop
put: (aBoolean
ifTrue: [(self longAt: objOop) bitOr: 1 << self markedBitFullShift]
ifFalse: [(self longAt: objOop) bitAnd: (1 << self markedBitFullShift) bitInvert64])!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager>>addFreeSubTree: (in category 'free space') -----
addFreeSubTree: freeTree
"Add a freeChunk sub tree back into the large free chunk tree.
This is for allocateOldSpaceChunkOf[Exactly]Bytes:."
<returnTypeC: #void>
| slotsInArg treeNode slotsInNode subNode |
slotsInArg := self numSlotsOfAny: freeTree.
self assert: slotsInArg / (self allocationUnit / self wordSize) >= self numFreeLists.
treeNode := freeLists at: 0.
self assert: treeNode ~= 0.
[slotsInNode := self numSlotsOfAny: treeNode.
self assert: slotsInArg ~= slotsInNode.
slotsInNode > slotsInArg
ifTrue:
[subNode := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode.
subNode = 0 ifTrue:
[self storePointer: self freeChunkSmallerIndex ofFreeChunk: treeNode withValue: freeTree.
+ self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
^self]]
ifFalse:
[subNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
subNode = 0 ifTrue:
[self storePointer: self freeChunkLargerIndex ofFreeChunk: treeNode withValue: freeTree.
+ self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
^self]].
treeNode := subNode] repeat!
Item was added:
+ ----- Method: SpurMemoryManager>>allOldSpaceEntitiesFrom:do: (in category 'object enumeration') -----
+ allOldSpaceEntitiesFrom: initialObject do: aBlock
+ <inline: true>
+ | prevObj prevPrevObj objOop |
+ prevPrevObj := prevObj := nil.
+ objOop := initialObject.
+ [self assert: objOop \\ self allocationUnit = 0.
+ objOop < freeOldSpaceStart] whileTrue:
+ [aBlock value: objOop.
+ prevPrevObj := prevObj.
+ prevObj := objOop.
+ objOop := self objectAfter: objOop limit: freeOldSpaceStart].
+ self touch: prevPrevObj.
+ self touch: prevObj!
Item was added:
+ ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes:suchThat: (in category 'free space') -----
+ allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: acceptanceBlock
+ "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 |
+ "for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
+
+ initialIndex := chunkBytes / self allocationUnit.
+ initialIndex < self numFreeLists ifTrue:
+ [(1 << initialIndex <= freeListsMask
+ and: [(node := freeLists at: initialIndex) ~= 0
+ and: [acceptanceBlock value: node]]) 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 and: [acceptanceBlock value: node]) 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 and: [acceptanceBlock value: node]) ifFalse:
+ [^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"
+ "N.B. This will fail when we try to remove the head node and there are still next links,
+ which is possible given acceptanceBlock but does not occur in current use."
+ self unlinkSolitaryFreeTreeNode: node.
+ totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
+ ^self startOfObject: node!
Item was changed:
----- Method: SpurMemoryManager>>bestFitCompact (in category 'compaction') -----
bestFitCompact
"Compact all of memory using best-fit, assuming free space is sorted
and that the highest objects are recorded in highestObjects."
+ | freePriorToExactFit firstFailedFit |
+ freePriorToExactFit := totalFreeOldSpace.
- | 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:
[: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 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 isInRememberedSet: 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: [(self isHiddenObj: obj) not]) ifTrue:
- and: [obj ~= self freeListsObject]) 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 remembered set @ '; 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]]]].
1 to: remapBufferCount do:
[:ri| | obj |
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]]].
1 to: extraRootCount do:
[:ri| | obj |
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 changed:
----- Method: SpurMemoryManager>>ensureRoomOnObjStackAt: (in category 'obj stacks') -----
ensureRoomOnObjStackAt: objStackRootIndex
"An obj stack is a stack of objects stored in a hidden root slot, such as
the markStack or the ephemeronQueue. It is a linked list of segments,
with the hot end at the head of the list. It is a word object. The stack
pointer is in ObjStackTopx and 0 means empty. The list goes through
ObjStackNextx. We don't want to shrink objStacks, since they're used
in GC and its good to keep their memory around. So unused pages
created by popping emptying pages are kept on the ObjStackFreex list."
| stackOrNil freeOrNewPage |
stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
(stackOrNil = nilObj
or: [(self fetchPointer: ObjStackTopx ofObject: stackOrNil) >= ObjStackLimit]) ifTrue:
[freeOrNewPage := stackOrNil = nilObj
ifTrue: [0]
ifFalse: [self fetchPointer: ObjStackFreex ofObject: stackOrNil].
freeOrNewPage ~= 0
ifTrue: "the free page list is always on the new page."
[self storePointer: ObjStackFreex ofObjStack: stackOrNil withValue: 0]
ifFalse:
[freeOrNewPage := self allocateSlotsInOldSpace: ObjStackPageSlots
format: self wordIndexableFormat
classIndex: self wordSizeClassIndexPun.
freeOrNewPage ifNil: [self error: 'no memory to allocate or extend obj stack'].
self storePointer: ObjStackFreex ofObjStack: freeOrNewPage withValue: 0].
marking ifTrue: [self setIsMarkedOf: freeOrNewPage to: true].
self storePointer: ObjStackMyx ofObjStack: freeOrNewPage withValue: objStackRootIndex;
storePointer: ObjStackNextx ofObjStack: freeOrNewPage withValue: (stackOrNil = nilObj ifTrue: [0] ifFalse: [stackOrNil]);
storePointer: ObjStackTopx ofObjStack: freeOrNewPage withValue: 0;
storePointer: objStackRootIndex ofObject: hiddenRootsObj withValue: freeOrNewPage.
self assert: (self isValidObjStackAt: objStackRootIndex).
"Added a new page; now update and answer the relevant cached first page."
+ ^self updateRootOfObjStack: objStackRootIndex with: freeOrNewPage].
- ^self updateRootOfObjStack: objStackRootIndex with:freeOrNewPage].
self assert: (self isValidObjStackAt: objStackRootIndex).
^stackOrNil!
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."
+ | firstFailedFit top o |
+ <var: #top type: #unsigned>
- | firstFailedFit |
firstFailedFit := 0.
totalFreeOldSpace = 0 ifTrue: [^0].
+ top := highestObjects top.
+ [[top := top - self wordSize.
+ top < highestObjects start ifTrue:
+ [top := highestObjects limit].
+ top ~= highestObjects top and: [(o := self longAt: top) > firstFreeChunk]] whileTrue:
+ [| b |
+ ((self isForwarded: o)
+ or: [self isPinned: o]) ifFalse:
+ [b := self bytesInObject: o.
+ (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
+ ifNil: [firstFailedFit = 0 ifTrue: [firstFailedFit := o]]
+ ifNotNil:
+ [:f|
+ self mem: f
+ cp: o
+ y: ((self hasOverflowHeader: o)
+ ifTrue: [b - self baseHeaderSize]
+ ifFalse: [b]).
+ "wait until the next scavenge to unremember o"
+ (self isRemembered: o) ifTrue:
+ [scavenger remember: f].
+ self forward: o to: f]]].
+ top = highestObjects top and: [o > firstFreeChunk]] whileTrue:
+ [self fillHighestObjectsFrom: firstFreeChunk upTo: o].
- 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])
- 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>>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 sortedFreeChunks |
- | 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.
+ firstFreeChunk := sortedFreeChunks := lastLargeFree := 0.
- 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].
+ firstFreeChunk = 0 ifTrue:
+ [firstFreeChunk := here].
(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 rebuildFreeTreeFrom: sortedFreeChunks).
- totalFreeOldSpace := totalFreeOldSpace + self rebuildFreeTreeFromSortedFreeChunks.
self checkFreeSpace.
self touch: highestObjectsWraps!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
+ self runLeakCheckerForFullGC: true.
self markObjects.
+ self runLeakCheckerForFullGC: true.
self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace.
+ self runLeakCheckerForFullGC: true.
+ self bestFitCompact.
+ self runLeakCheckerForFullGC: true!
- self bestFitCompact!
Item was changed:
----- Method: SpurMemoryManager>>inFreeTreeReplace:with: (in category 'free space') -----
inFreeTreeReplace: treeNode with: newNode
+ "Part of reorderReversedTreeList:. Switch treeNode with newNode in
+ the tree, but do nothing to the list linked through freeChunkNextIndex."
| 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.
+ i = self freeChunkParentIndex
+ ifTrue:
+ [relative = 0
+ ifTrue: "update root to point to newNode"
+ [self assert: (freeLists at: 0) = treeNode.
+ freeLists at: 0 put: newNode]
+ ifFalse: "replace link from parent to treeNode with link to newNode."
+ [self storePointer: (treeNode = (self fetchPointer: self freeChunkSmallerIndex ofObject: relative)
+ ifTrue: [self freeChunkSmallerIndex]
+ ifFalse: [self freeChunkLargerIndex])
+ ofFreeChunk: relative
+ withValue: newNode]]
+ ifFalse:
+ [relative ~= 0 ifTrue:
+ [self assert: (self fetchPointer: self freeChunkParentIndex ofObject: relative) = treeNode.
+ self storePointer: self freeChunkParentIndex ofFreeChunk: relative withValue: newNode]].
+ self storePointer: i ofFreeChunk: newNode withValue: relative.
+ self storePointer: i ofFreeChunk: treeNode withValue: 0]!
- relative ~= 0 ifTrue:
- [self storePointer: self freeChunkParentIndex ofFreeChunk: relative withValue: newNode]]!
Item was added:
+ ----- Method: SpurMemoryManager>>isHiddenObj: (in category 'debug support') -----
+ isHiddenObj: objOop
+ ^objOop = self freeListsObject
+ or: [(self numSlotsOfAny: objOop) = ObjStackPageSlots
+ and: [self isValidObjStackPage: objOop myIndex: (self fetchPointer: ObjStackMyx ofObject: objOop)]]!
Item was added:
+ ----- Method: SpurMemoryManager>>isValidObjStackPage:myIndex: (in category 'obj stacks') -----
+ isValidObjStackPage: objStackPage myIndex: myx
+ "Just check the page itself."
+ <inline: false>
+ (self classIndexOf: objStackPage) = self wordSizeClassIndexPun ifFalse:
+ [objStackInvalidBecause := 'wong class index'.
+ ^false].
+ (self formatOf: objStackPage) = self wordIndexableFormat ifFalse:
+ [objStackInvalidBecause := 'wong format'.
+ ^false].
+ (self numSlotsOfAny: objStackPage) = ObjStackPageSlots ifFalse:
+ [objStackInvalidBecause := 'wong num slots'.
+ ^false].
+ myx = (self fetchPointer: ObjStackMyx ofObject: objStackPage) ifFalse:
+ [objStackInvalidBecause := 'wong myx'.
+ ^false].
+ ^true!
Item was changed:
----- Method: SpurMemoryManager>>isValidObjStackPage:myIndex:firstPage: (in category 'obj stacks') -----
isValidObjStackPage: objStackPage myIndex: myx firstPage: isFirstPage
"Answer if the obj stack at stackRootIndex is valid."
| freeOrNextPage index |
<inline: false>
+ (self isValidObjStackPage: objStackPage myIndex: myx) ifFalse:
+ [^false].
+ freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage.
+ [freeOrNextPage ~= 0] whileTrue:
+ [isFirstPage ifFalse:
+ [objStackInvalidBecause := 'free page on other than first page'.
+ ^false].
+ (self isValidObjStackPage: freeOrNextPage myIndex: myx) ifFalse:
+ [objStackInvalidBecause := self str: objStackInvalidBecause cat: ', on next page'.
+ ^false].
+ freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: freeOrNextPage].
- (self numSlotsOfAny: objStackPage) = ObjStackPageSlots ifFalse:
- [objStackInvalidBecause := 'wong num slots'.
- ^false].
isFirstPage ifTrue:
[(myx between: self classTableRootSlots and: self classTableRootSlots + self hiddenRootSlots - 1) ifFalse:
[objStackInvalidBecause := 'myx out of range'.
^false].
(self fetchPointer: myx ofObject: hiddenRootsObj) = objStackPage ifFalse:
[objStackInvalidBecause := 'firstPage is not root'.
^false]].
- myx = (self fetchPointer: ObjStackMyx ofObject: objStackPage) ifFalse:
- [objStackInvalidBecause := 'wong myx'.
- ^false].
- freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage.
- freeOrNextPage ~= 0 ifTrue:
- [isFirstPage ifFalse:
- [objStackInvalidBecause := 'free page on other than first page'.
- ^false].
- (self isValidObjStackPage: freeOrNextPage myIndex: myx firstPage: false) ifFalse:
- [objStackInvalidBecause := self str: objStackInvalidBecause cat: ' on next page'.
- ^false]].
index := self fetchPointer: ObjStackTopx ofObject: objStackPage.
(index between: 0 and: ObjStackLimit) ifFalse:
[objStackInvalidBecause := 'bad topx'.
^false].
freeOrNextPage := self fetchPointer: ObjStackNextx ofObject: objStackPage.
^freeOrNextPage = 0
or: [self isValidObjStackPage: freeOrNextPage myIndex: myx firstPage: false]!
Item was removed:
- ----- Method: SpurMemoryManager>>lowestFreeChunkAssumingSortedFreeSpace (in category 'free space') -----
- lowestFreeChunkAssumingSortedFreeSpace
- | lowest |
- lowest := sortedFreeChunks = 0
- ifTrue: [endOfMemory]
- ifFalse: [sortedFreeChunks].
- 1 to: self numFreeLists - 1 do:
- [:i| | chunk |
- chunk := freeLists at: i.
- (chunk ~= 0 and: [chunk < lowest]) ifTrue:
- [lowest := chunk]].
- ^lowest!
Item was changed:
----- Method: SpurMemoryManager>>markAndTraceObjStack:andContents: (in category 'obj stacks') -----
markAndTraceObjStack: stackOrNil andContents: markAndTraceContents
"An obj stack is a stack of objects stored in a hidden root slot, such
as the markStack or the ephemeronQueue. It is a linked list of
segments, with the hot end at the head of the list. It is a word object.
The stack pointer is in ObjStackTopx and 0 means empty."
<returnTypeC: #void>
+ <inline: false>
| index field |
stackOrNil = nilObj ifTrue:
[^self].
self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
field := self fetchPointer: ObjStackNextx ofObject: stackOrNil.
field ~= 0 ifTrue:
[self markAndTraceObjStack: field andContents: markAndTraceContents].
+ field := stackOrNil.
+ [field := self fetchPointer: ObjStackFreex ofObject: stackOrNil.
+ field ~= 0] whileTrue:
+ [self setIsMarkedOf: field to: true].
markAndTraceContents ifFalse:
[^self].
"There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
if there were 6 slots in an oop stack, full would be 2, and the last 0-rel index is 5."
index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
[index >= ObjStackFixedSlots] whileTrue:
[field := self fetchPointer: index ofObject: stackOrNil.
(self isImmediate: field) ifFalse:
[self markAndTrace: field].
index := index - 1]!
Item was changed:
----- Method: SpurMemoryManager>>popObjStack: (in category 'obj stacks') -----
popObjStack: objStack
| topx top nextPage myx |
self assert: (self isValidObjStack: objStack).
topx := self fetchPointer: ObjStackTopx ofObject: objStack.
topx = 0 ifTrue:
[self assert: (self fetchPointer: ObjStackNextx ofObject: objStack) = 0.
self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
inSmalltalk:
[MarkStackRecord ifNotNil:
[MarkStackRecord addLast: {#EMPTY. nil}]].
^nil].
topx := topx - 1.
top := self fetchPointer: topx + ObjStackFixedSlots ofObject: objStack.
self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
inSmalltalk:
[MarkStackRecord ifNotNil:
[(MarkStackRecord last first = #push and: [MarkStackRecord last last = top])
ifTrue: [MarkStackRecord removeLast]
ifFalse: [MarkStackRecord addLast: {#pop. top}]]].
self storePointer: ObjStackTopx ofObject: objStack withValue: topx.
(topx = 0
and: [(nextPage := self fetchPointer: ObjStackNextx ofObject: objStack) ~= 0]) ifTrue:
+ [self storePointer: ObjStackFreex ofObjStack: nextPage withValue: objStack.
+ self storePointer: ObjStackNextx ofObjStack: objStack withValue: 0.
- [self storePointer: ObjStackFreex ofObject: nextPage withValue: objStack.
myx := self fetchPointer: ObjStackMyx ofObject: objStack.
self updateRootOfObjStack: myx with: nextPage].
^top!
Item was changed:
----- Method: SpurMemoryManager>>push:onObjStack: (in category 'obj stacks') -----
push: objOop onObjStack: objStack
| topx |
self assert: (self addressCouldBeOop: objOop).
self assert: (self isValidObjStack: objStack).
(self isImmediate: objOop) ifTrue:
[self assert: objStack = markStack.
+ self assert: (self addressCouldBeObj: (self topOfObjStack:
+ (0 = (self fetchPointer: ObjStackTopx ofObject: objStack)
+ ifTrue: [self fetchPointer: ObjStackNextx ofObject: objStack]
+ ifFalse: [objStack])))].
- self assert: (self addressCouldBeObj: (self topOfObjStack: objStack))].
self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord addLast: {#push. objOop}]].
topx := self fetchPointer: ObjStackTopx ofObject: objStack.
topx >= ObjStackLimit
ifTrue:
[self push: objOop
onObjStack: (self ensureRoomOnObjStackAt: (self fetchPointer: ObjStackMyx ofObject: objStack))]
ifFalse:
+ [self storePointer: ObjStackFixedSlots + topx ofObjStack: objStack withValue: objOop.
+ self storePointer: ObjStackTopx ofObjStack: objStack withValue: topx + 1].
- [self storePointer: ObjStackFixedSlots + topx ofObject: objStack withValue: objOop.
- self storePointer: ObjStackTopx ofObject: objStack withValue: topx + 1].
^objOop!
Item was added:
+ ----- Method: SpurMemoryManager>>rebuildFreeTreeFrom: (in category 'free space') -----
+ rebuildFreeTreeFrom: sortedFreeChunks
+ "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."
+ | 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 removed:
- ----- 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."
- | 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 removed:
- ----- 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:
- [: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 removed:
- ----- Method: SpurMemoryManager>>sortedFreeChunksAreSorted (in category 'debug support') -----
- sortedFreeChunksAreSorted
- | chunk next |
- chunk := sortedFreeChunks.
- [chunk ~= 0] whileTrue:
- [next := self fetchPointer: self freeChunkNextAddressIndex ofObject: chunk.
- (next = 0 or: [next > chunk]) ifFalse:
- [^false].
- chunk := next].
- ^true!
Item was changed:
----- Method: SpurMemoryManager>>topOfObjStack: (in category 'obj stacks') -----
topOfObjStack: objStack
| topx |
+ "This assert is tricky. push:onObjStack: may call topOfObjStack: just after pushing an
+ empty page on the stack, and will ask if the second page is valid."
+ self assert: (self isValidObjStackPage: objStack
+ myIndex: (self fetchPointer: ObjStackMyx ofObject: objStack)
+ firstPage: (objStack = (self fetchPointer: (self fetchPointer: ObjStackMyx ofObject: objStack) ofObject: hiddenRootsObj))).
- self assert: (self isValidObjStack: objStack).
topx := self fetchPointer: ObjStackTopx ofObject: objStack.
topx = 0 ifTrue:
[self assert: (self fetchPointer: ObjStackNextx ofObject: objStack) = 0.
^nil].
^self fetchPointer: topx + ObjStackFixedSlots - 1 ofObject: objStack!
Item was changed:
----- Method: SpurMemoryManager>>unlinkSolitaryFreeTreeNode: (in category 'free space') -----
unlinkSolitaryFreeTreeNode: freeTreeNode
"Unlink a freeTreeNode. Assumes the node has no list (null next link)."
| parent smaller larger |
+ self assert: (self fetchPointer: self freeChunkNextIndex ofObject: freeTreeNode) = 0.
"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 changed:
----- Method: SpurMemoryManager>>updateRootOfObjStack:with: (in category 'obj stacks') -----
updateRootOfObjStack: objStackRootIndex with: newRootPage
+ self storePointer: objStackRootIndex
+ ofObject: hiddenRootsObj
+ withValue: newRootPage.
- self assert: (self isValidObjStack: newRootPage).
objStackRootIndex caseOf: {
[MarkStackRootIndex] -> [markStack := newRootPage].
[EphemeronQueueRootIndex] -> [ephemeronQueue := newRootPage] }.
+ self assert: (self isValidObjStack: newRootPage).
^newRootPage!
Item was added:
+ ----- Method: VMClass>>asString: (in category 'C library simulation') -----
+ asString: aStringOrStringIndex
+ "aStringOrStringIndex is either a string or an address in the heap.
+ Create a String of the requested length form the bytes in the
+ heap starting at stringIndex."
+ <doNotGenerate>
+ | sz |
+ aStringOrStringIndex isString ifTrue:
+ [^aStringOrStringIndex].
+ sz := self strlen: aStringOrStringIndex.
+ ^self st: (ByteString new: sz) rn: aStringOrStringIndex cpy: sz!
Item was added:
+ ----- Method: VMClass>>str:cat: (in category 'C library simulation') -----
+ str: aString cat: bString
+ <doNotGenerate>
+ "implementation of strcat(3)"
+ ^(self asString: aString), (self asString: bString)!
More information about the Vm-dev
mailing list