[Vm-dev] VM Maker: VMMaker.oscog-eem.716.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue May 13 19:49:52 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.716.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.716
Author: eem
Time: 13 May 2014, 12:47:01.484 pm
UUID: c2b5105c-9b6f-48b2-9208-b5520d3b6a02
Ancestors: VMMaker.oscog-eem.715
Spur:
Nuke old fit compact code.
Nuke unused inst vars (lastSubdividedFreeChunk, highestObjects).
Update SpurMemoryManager class comment.
Make compact update statCompactPassCount.
Check free space after rebuildFreeListsForPigCompact.
A Spur CogTrunkVMMaker image got trashed on snapshot.
The system needs more checking before it is safe to use.
=============== Diff against VMMaker.oscog-eem.715 ===============
Item was changed:
----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
"Answer the oop of a chunk of space in oldSpace with numSlots slots. The header
will have been filled-in but not the contents."
<inline: false>
| chunk |
chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
self checkFreeSpace.
chunk ifNil:
[^nil].
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self flag: #endianness.
self longAt: chunk put: numSlots.
self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift.
self long64At: chunk + self baseHeaderSize
put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
- self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk + self baseHeaderSize) = lastSubdividedFreeChunk]).
^chunk + self baseHeaderSize].
self long64At: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
- self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk) = lastSubdividedFreeChunk]).
^chunk!
Item was changed:
----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
"Answer the oop of a chunk of space in oldSpace with numSlots slots. The header
will have been filled-in but not the contents."
<inline: false>
| chunk |
chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
self checkFreeSpace.
chunk ifNil:
[^nil].
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self longAt: chunk
put: numSlots + (self numSlotsMask << self numSlotsFullShift).
self longAt: chunk + self baseHeaderSize
put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
- self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk + self baseHeaderSize) = lastSubdividedFreeChunk]).
^chunk + self baseHeaderSize].
self longAt: chunk
put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
- self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk) = lastSubdividedFreeChunk]).
^chunk!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
initialize
"SpurMemoryManager initialize"
BitsPerByte := 8.
- UseFitCompact := false.
-
"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.
ObjStackNextx must be the last field for swizzleObjStackAt:."
ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits"
ObjStackTopx := 0.
ObjStackMyx := 1.
ObjStackFreex := 2.
ObjStackNextx := 3.
ObjStackFixedSlots := 4.
ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots.
"There are currently three obj stacks, the mark stack, the weaklings and the ephemeron queue."
MarkStackRootIndex := self basicNew classTableRootSlots.
WeaklingStackRootIndex := MarkStackRootIndex + 1.
EphemeronQueueRootIndex := MarkStackRootIndex + 2.
CheckObjectOverwrite := true.
"The remap buffer support is for compatibility; Spur doesn't GC during allocation.
Eventually this should die."
RemapBufferSize := 25.
"Extra roots are for plugin support."
ExtraRootsSize := 2048 "max. # of external roots"!
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 |
- self assert: (lastSubdividedFreeChunk := 0) = 0.
"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) 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)]].
"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].
nodeBytes := childBytes.
parent := child.
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 ~= 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"
chunk := parent.
self unlinkSolitaryFreeTreeNode: chunk.
"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 removed:
- ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes:suchThat: (in category 'free space') -----
- allocateOldSpaceChunkOfBytes: chunkBytes suchThat: acceptanceBlock
- "Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
- if available, otherwise answer nil. Break up a larger chunk if one of the exact
- size cannot be found. N.B. the chunk is simply a pointer, it has no valid header.
- The caller *must* fill in the header correctly."
- | initialIndex node next prev index child childBytes acceptedChunk acceptedNode |
- <inline: true> "must inline for acceptanceBlock"
- self assert: (lastSubdividedFreeChunk := 0) = 0.
- "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:
- [(node := freeLists at: initialIndex) = 0
- ifTrue: [freeListsMask := freeListsMask - (1 << initialIndex)]
- ifFalse:
- [prev := 0.
- [node ~= 0] whileTrue:
- [self assert: node = (self startOfObject: node).
- self assert: (self isValidFreeObject: node).
- next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
- (acceptanceBlock value: node) ifTrue:
- [prev = 0
- ifTrue: [freeLists at: initialIndex put: next]
- ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
- ^node].
- prev := node.
- node := next]]].
- "first search for free chunks of a multiple of chunkBytes in size"
- index := initialIndex.
- [(index := index + initialIndex) < self numFreeLists
- and: [1 << index <= freeListsMask]] whileTrue:
- [(freeListsMask anyMask: 1 << index) ifTrue:
- [(node := freeLists at: index) = 0
- ifTrue: [freeListsMask := freeListsMask - (1 << index)]
- ifFalse:
- [prev := 0.
- [node ~= 0] whileTrue:
- [self assert: node = (self startOfObject: node).
- self assert: (self isValidFreeObject: node).
- next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
- (acceptanceBlock value: node) ifTrue:
- [prev = 0
- ifTrue: [freeLists at: index put: next]
- ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
- self freeChunkWithBytes: index * self allocationUnit - chunkBytes
- at: (self startOfObject: node) + chunkBytes.
- ^node].
- prev := node.
- node := next]]]].
- "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:
- [(node := freeLists at: index) = 0
- ifTrue: [freeListsMask := freeListsMask - (1 << index)]
- ifFalse:
- [prev := 0.
- [node ~= 0] whileTrue:
- [self assert: node = (self startOfObject: node).
- self assert: (self isValidFreeObject: node).
- next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
- (acceptanceBlock value: node) ifTrue:
- [prev = 0
- ifTrue: [freeLists at: index put: next]
- ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
- self freeChunkWithBytes: index * self allocationUnit - chunkBytes
- at: (self startOfObject: node) + chunkBytes.
- ^node].
- prev := node.
- node := next]]]]].
-
- "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. acceptedChunk and acceptedNode save
- us from having to back-up when the acceptanceBlock filters-out all nodes
- of the right size, but there are nodes of the wrong size it does accept."
- child := freeLists at: 0.
- node := acceptedChunk := acceptedNode := 0.
- [child ~= 0] whileTrue:
- [self assert: (self isValidFreeObject: child).
- childBytes := self bytesInObject: child.
- childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
- [node := child.
- [prev := node.
- node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
- node ~= 0] whileTrue:
- [(acceptanceBlock value: node) ifTrue:
- [self assert: (self isValidFreeObject: node).
- self storePointer: self freeChunkNextIndex
- ofFreeChunk: prev
- withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
- ^self startOfObject: node]].
- (acceptanceBlock value: child) ifTrue:
- [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child.
- next = 0
- ifTrue: "no list; remove the interior node"
- [self unlinkSolitaryFreeTreeNode: child]
- ifFalse: "list; replace node with it"
- [self inFreeTreeReplace: child with: next].
- ^self startOfObject: child]].
- child ~= 0 ifTrue:
- ["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:
- [self flag: 'we can do better here; preferentially choosing the lowest node. That would be a form of best-fit since we are trying to compact down'.
- node := child.
- child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node.
- acceptedNode = 0 ifTrue:
- [acceptedChunk := node.
- "first search the list."
- [acceptedChunk := self fetchPointer: self freeChunkNextIndex
- ofFreeChunk: acceptedChunk.
- (acceptedChunk ~= 0 and: [acceptanceBlock value: acceptedChunk]) ifTrue:
- [acceptedNode := node].
- acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue.
- "nothing on the list; will the node do? This prefers
- acceptable nodes higher up the tree over acceptable
- list elements further down, but we haven't got all day..."
- (acceptedNode = 0
- and: [acceptanceBlock value: node]) ifTrue:
- [acceptedNode := node.
- child := 0 "break out of loop now we have an acceptedNode"]]]]].
-
- acceptedNode ~= 0 ifTrue:
- [acceptedChunk ~= 0 ifTrue:
- [self assert: (self bytesInObject: acceptedChunk) >= (chunkBytes + self allocationUnit).
- [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
- next ~= acceptedChunk] whileTrue:
- [acceptedNode := next].
- self storePointer: self freeChunkNextIndex
- ofFreeChunk: acceptedNode
- withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk).
- self freeChunkWithBytes: (self bytesInObject: acceptedChunk) - chunkBytes
- at: (self startOfObject: acceptedChunk) + chunkBytes.
- ^self startOfObject: acceptedChunk].
- next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
- next = 0
- ifTrue: "no list; remove the interior node"
- [self unlinkSolitaryFreeTreeNode: acceptedNode]
- ifFalse: "list; replace node with it"
- [self inFreeTreeReplace: acceptedNode with: next].
- self assert: (self bytesInObject: acceptedNode) >= (chunkBytes + self allocationUnit).
- self freeChunkWithBytes: (self bytesInObject: acceptedNode) - chunkBytes
- at: (self startOfObject: acceptedNode) + chunkBytes.
- ^self startOfObject: acceptedNode].
-
- totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
- ^nil!
Item was changed:
----- Method: SpurMemoryManager>>compact (in category 'compaction') -----
compact
"We'd like to use exact fit followed by best or first fit, but it doesn't work
well enough in practice. So use pig compact. Fill large free objects starting
from low memory with objects taken from the end of memory."
<inline: false>
+ statCompactPassCount := statCompactPassCount + 1.
self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
+ 1 to: 3 do:
+ [:i|
+ self pigCompact.
+ self eliminateAndFreeForwardersForPigCompact].
+ self rebuildFreeListsForPigCompact!
- UseFitCompact
- ifTrue:
- [self exactFitCompact.
- self assert: (firstFreeChunk = 0
- or: [(self isFreeObject: firstFreeChunk)
- or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]).
- highestObjects usedSize > 0 ifTrue:
- [self firstFitCompact]]
- ifFalse:
- [self pigCompact]!
Item was removed:
- ----- Method: SpurMemoryManager>>eliminateAndFreeForwarders (in category 'gc - global') -----
- eliminateAndFreeForwarders
- "As the final phase of global garbage collect, sweep the heap to follow
- forwarders, then free forwarders, coalescing with free space as we go."
- self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'eliminating forwarders...'; flush].
- UseFitCompact
- ifTrue: [self eliminateAndFreeForwardersForFitCompact]
- ifFalse: [self eliminateAndFreeForwardersForPigCompact]!
Item was removed:
- ----- Method: SpurMemoryManager>>eliminateAndFreeForwardersForFitCompact (in category 'gc - global') -----
- eliminateAndFreeForwardersForFitCompact
- "As the final phase of global garbage collect, sweep the heap to follow
- forwarders, then free forwarders, coalescing with free space as we go."
- | lowestFree |
- <inline: false>
- self flag: 'this might be unnecessary. if we were to track firstFreeChunk we might be able to repeat the freeUnmarkedObjectsAndSortAndCoalesceFreeSpace; compact cycle until firstFreeChunk reaches a fixed point'.
- self assert: (self isForwarded: nilObj) not.
- self assert: (self isForwarded: falseObj) not.
- self assert: (self isForwarded: trueObj) not.
- self assert: (self isForwarded: self freeListsObj) not.
- self assert: (self isForwarded: hiddenRootsObj) not.
- self assert: (self isForwarded: classTableFirstPage) not.
- self followSpecialObjectsOop.
- "N.B. we don't have to explicitly do mapInterpreterOops since the scavenge below
- will do it, except that scavenging maps only young references in machine code."
- self followForwardedObjStacks.
- scavenger followRememberedForwardersAndForgetFreeObjects.
- self doScavenge: DontTenureButDoUnmark.
- coInterpreter mapMachineCode: GCModeFull.
- self checkFreeSpace.
- lowestFree := self sweepToFollowForwardersForFitCompact.
- self checkFreeSpace.
- lowestFree = 0 ifTrue: "yeah, right..."
- [^self].
- self sweepToCoallesceFreeSpaceAndRebuildFreeListsForFitCompactFrom: lowestFree.
- self checkFreeSpace!
Item was removed:
- ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') -----
- exactFitCompact
- "Compact all of memory above firstFreeChunk using exact-fit, assuming free
- space is sorted and that as many of the the highest objects as will fit are
- recorded in highestObjects. Don't move pinned objects.
- Note that we don't actually move; we merely copy and forward. Eliminating
- forwarders will be done in a final pass. Leave the objects that don't fit
- exactly (the misfits), and hence aren't moved, in highestObjects."
-
- <inline: false>
- | misfits first nfits nmiss nHighest nMisses savedLimit |
- <var: #misfits type: #usqInt>
- self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'ef compacting...'; flush].
- self checkFreeSpace.
- totalFreeOldSpace = 0 ifTrue: [^self].
- highestObjects isEmpty ifTrue:
- [^self].
- nfits := nmiss := 0.
- misfits := highestObjects last + self wordSize.
- [statCompactPassCount := statCompactPassCount + 1.
- highestObjects from: misfits - self wordSize reverseDo:
- [:o| | b |
- (self oop: o isGreaterThan: firstFreeChunk) ifFalse:
- [highestObjects first: misfits.
- coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr.
- ^self].
- ((self isForwarded: o) or: [self isPinned: o]) ifFalse:
- [b := self bytesInObject: o.
- (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
- ifNil:
- [nmiss := nmiss + 1.
- misfits := misfits - self wordSize.
- misfits < highestObjects start ifTrue:
- [misfits := highestObjects limit - self wordSize].
- self longAt: misfits put: o]
- ifNotNil:
- [:f| | fo |
- nfits := nfits + 1.
- "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
- is a large chunk then firstFreeChunk will no longer point to an object header. So check and
- adjust firstFreeChunk if it is assigned to."
- fo := self objectStartingAt: f.
- fo = firstFreeChunk ifTrue:
- [firstFreeChunk := self objectAfter: fo].
- self copyAndForward: o withBytes: b toFreeChunk: f]]].
- self checkFreeSpace.
- "now highestObjects contains only misfits, if any, from misfits to last.
- set first to first failure and refill buffer. next cycle will add more misfits.
- give up on exact-fit when half of the highest objects fail to fit."
- first := self longAt: highestObjects first.
- self assert: (self oop: first isGreaterThan: firstFreeChunk).
- nHighest := highestObjects usedSize.
- highestObjects first: misfits.
- nMisses := highestObjects usedSize.
- nMisses > (nHighest // 2) ifTrue:
- [coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr.
- ^self].
- savedLimit := self moveMisfitsToTopOfHighestObjects: misfits.
- self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first.
- misfits := self moveMisfitsInHighestObjectsBack: savedLimit.
- highestObjects usedSize > 0] whileTrue!
Item was removed:
- ----- Method: SpurMemoryManager>>fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: (in category 'compaction') -----
- fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: limitObj
- "Refill highestObjects with movable objects up to, but not including limitObj.
- c.f. the loop in freeUnmarkedObjectsAndSortAndCoalesceFreeSpace."
- | lastHighest highestObjectsWraps firstFree |
- self assert: (firstFreeChunk = 0
- or: [(self isFreeObject: firstFreeChunk)
- or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]).
- highestObjects resetAsEmpty.
- lastHighest := highestObjects last.
- highestObjectsWraps := firstFree := 0.
- self allOldSpaceEntitiesFrom: firstFreeChunk do:
- [:o|
- (self oop: o isGreaterThanOrEqualTo: limitObj) ifTrue:
- [highestObjects last: lastHighest.
- (self isFreeObject: firstFreeChunk) ifFalse:
- [firstFreeChunk := firstFree = 0 ifTrue: [limitObj] ifFalse: [firstFree]].
- ^self].
- (self isFreeObject: o)
- ifTrue: [firstFree = 0 ifTrue:
- [firstFree := o]]
- ifFalse:
- [((self isForwarded: o) or: [self isPinned: o]) ifFalse:
- [false "conceptually...: "
- ifTrue: [highestObjects addLast: o]
- ifFalse: "but we inline so we can use the local lastHighest"
- [(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
- [highestObjectsWraps := highestObjectsWraps + 1.
- lastHighest := highestObjects start].
- self longAt: lastHighest put: o]]]].
- highestObjects last: lastHighest.
- (self isFreeObject: firstFreeChunk) ifFalse:
- [firstFreeChunk := firstFree = 0 ifTrue: [limitObj] ifFalse: [firstFree]].
- self assert: (firstFreeChunk = 0
- or: [(self isFreeObject: firstFreeChunk)
- or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]])!
Item was removed:
- ----- Method: SpurMemoryManager>>findFirstFreeChunkAfter: (in category 'compaction') -----
- findFirstFreeChunkAfter: start
- self allOldSpaceObjectsFrom: start do:
- [:o|
- (self isFreeObject: o) ifTrue:
- [^o]].
- ^endOfMemory!
Item was removed:
- ----- Method: SpurMemoryManager>>firstFitCompact (in category 'compaction') -----
- firstFitCompact
- "Compact all of memory above firstFreeChunk using first-fit, assuming free
- space is sorted and that as many of the the highest objects as will fit are
- recorded in highestObjects. Don't move pinned objects.
- Note that we don't actually move; we merely copy and forward. Eliminating
- forwarders will be done in a final pass."
-
- <inline: false>
- | first nhits nmisses |
- self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'ff compacting...'; flush].
- self checkFreeSpace.
- totalFreeOldSpace = 0 ifTrue: [^self].
- highestObjects isEmpty ifTrue:
- [^self].
- nhits := nmisses := 0.
- [statCompactPassCount := statCompactPassCount + 1.
- highestObjects reverseDo:
- [:o| | b |
- self assert: (firstFreeChunk = 0
- or: [(self isFreeObject: firstFreeChunk)
- or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]).
- (self oop: o isLessThanOrEqualTo: firstFreeChunk) ifTrue:
- [coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr.
- ^self].
- ((self isForwarded: o) or: [self isPinned: o]) ifFalse:
- [b := self bytesInObject: o.
- (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o])
- ifNil:
- [nmisses := nmisses + 1]
- ifNotNil:
- [:f| | fo |
- nhits := nhits + 1.
- "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
- is a large chunk then firstFreeChunk will no longer point to an object header. So check and
- adjust firstFreeChunk if it is assigned to."
- fo := self objectStartingAt: f.
- fo = firstFreeChunk ifTrue:
- [firstFreeChunk := lastSubdividedFreeChunk = 0
- ifTrue: [self objectAfter: fo]
- ifFalse: [self objectStartingAt: lastSubdividedFreeChunk]].
- self copyAndForward: o withBytes: b toFreeChunk: f.
- self assert: (lastSubdividedFreeChunk = 0
- or: [(self addressAfter: (self objectStartingAt: f)) = lastSubdividedFreeChunk])]]].
- self checkFreeSpace.
- first := self longAt: highestObjects first.
- self assert: (self oop: first isGreaterThan: firstFreeChunk).
- self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first.
- highestObjects usedSize > 0] whileTrue.
-
- coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr!
Item was changed:
----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') -----
freeChunkWithBytes: bytes at: address
<inline: false>
| freeChunk |
- self assert: (lastSubdividedFreeChunk := address) ~= 0.
self assert: (self isInOldSpace: address).
freeChunk := self initFreeChunkWithBytes: bytes at: address.
self assert: (self isInMemory: (self addressAfter: freeChunk)).
self addToFreeList: freeChunk bytes: bytes.
self assert: freeChunk = (self objectStartingAt: address).
^freeChunk!
Item was removed:
- ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
- freeUnmarkedObjectsAndSortAndCoalesceFreeSpace
- "Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
- Sort to suit the compaction algorithm being used."
- self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'sweeping...'; flush].
- UseFitCompact
- ifTrue: [self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForFitCompact]
- ifFalse: [self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact]!
Item was removed:
- ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForFitCompact (in category 'gc - global') -----
- freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForFitCompact
- "Sweep all of old space, freeing unmarked objects, 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 as many of the highest objects as there
- is room for in highestObjects, a circular buffer, for the use of exactFitCompact. Use
- unused eden space for highestObjects. If highestObjects does not wrap, store 0
- at highestObjects last. Record the lowest free object in firstFreeChunk. Let the
- segmentManager mark which segments contain pinned objects via notePinned:."
-
- | lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks |
- <inline: false>
- <var: #lastHighest type: #usqInt>
- 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 initializeStart: freeStart limit: scavenger eden limit.
- lastHighest := highestObjects start - self wordSize. "a.k.a. freeStart - wordSize"
- highestObjectsWraps := 0.
- self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
- firstFreeChunk := sortedFreeChunks := lastLargeFree := 0.
- "Note that if we were truly striving for performance we could split the scan into
- two phases, one up to the first free object and one after, which would remove
- the need to test firstFreeChunk when filling highestObjects."
- self allOldSpaceEntitiesForCoalescingFrom: self firstObject do:
- [:o|
- self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
- (self isMarked: o)
- ifTrue: "forwarders should have been followed in markAndTrace:"
- [self assert: (self isForwarded: o) not.
- self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
- (self isPinned: o) ifTrue:
- [segmentManager notePinned: o].
- firstFreeChunk ~= 0 ifTrue:
- [false "conceptually...: "
- ifTrue: [highestObjects addLast: o]
- ifFalse: "but we inline so we can use the local lastHighest"
- [(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
- [highestObjectsWraps := highestObjectsWraps + 1.
- lastHighest := highestObjects start].
- self longAt: lastHighest put: o]]]
- ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
- [| here |
- here := self coallesceFreeChunk: o.
- (self isLargeFreeObject: here)
- ifTrue:
- [self setFree: here.
- lastLargeFree = 0
- ifTrue: [sortedFreeChunks := lastLargeFree := here]
- ifFalse:
- [self storePointer: self freeChunkNextAddressIndex
- ofFreeChunk: lastLargeFree
- withValue: here].
- lastLargeFree := here]
- ifFalse:
- [self freeSmallObject: here].
- firstFreeChunk = 0 ifTrue:
- [self assert: (self isFreeObject: here).
- firstFreeChunk := here]]].
- highestObjects last: lastHighest.
- highestObjectsWraps ~= 0 ifTrue:
- [highestObjects first: (lastHighest + self wordSize >= highestObjects limit
- ifTrue: [highestObjects start]
- ifFalse: [lastHighest + self wordSize])].
- lastLargeFree ~= 0 ifTrue:
- [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
- totalFreeOldSpace := self reverseSmallListHeads.
- totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks).
- self checkFreeSpace.
- self touch: highestObjectsWraps!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self markObjects.
self expungeDuplicateAndUnmarkedClasses: true.
self nilUnmarkedWeaklingSlots.
+ self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact.
- self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace.
"Mid-way the leak check must be more lenient. Unmarked classes will have been
expunged from the table, but unmarked instances will not yet have been reclaimed."
self runLeakCheckerForFullGC: true
excludeUnmarkedNewSpaceObjs: true
classIndicesShouldBeValid: true.
+ self compact.
- UseFitCompact
- ifTrue:
- [self compact.
- self eliminateAndFreeForwarders]
- ifFalse:
- [1 to: 3 do:
- [:i|
- self pigCompact.
- self eliminateAndFreeForwardersForPigCompact].
- self rebuildFreeListsForPigCompact].
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self assert: self allObjectsUnmarked.
self runLeakCheckerForFullGC: true!
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 := statSurvivorCount := 0.
statRootTableOverflows := statMarkCount := statSpecialMarkCount := statCompactPassCount := statCoalesces := 0.
"We can initialize things that are allocated but are lazily initialized."
unscannedEphemerons := SpurContiguousObjStack new.
- highestObjects := SpurCircularBuffer new manager: self; yourself.
"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 removed:
- ----- Method: SpurMemoryManager>>moveMisfitsInHighestObjectsBack: (in category 'compaction') -----
- moveMisfitsInHighestObjectsBack: savedLimit
- "After refilling highestObjects move any misfits back to being
- adjacent with the new objects, reset the space's limit and
- answer the pointer to the lowest failure to resume the scan."
-
- | newMisfitsPosition |
- savedLimit = highestObjects limit ifTrue:
- [^highestObjects last].
- "simple; we didnt fill all the way; just move misfits down."
- (highestObjects first = highestObjects start
- and: [highestObjects last < highestObjects limit]) ifTrue:
- [newMisfitsPosition := highestObjects limit.
- self mem: newMisfitsPosition asVoidPointer
- mo: (highestObjects last + self wordSize) asVoidPointer
- ve: savedLimit - newMisfitsPosition.
- highestObjects limit: savedLimit.
- ^newMisfitsPosition].
- "tricky to do unless we have last - start's worth of free space.
- we *don't* want to rotate lots and lots of objects. We could push
- misfits onto the mark stack, if it is big enough.
- limit: | misfits hi <-> lo | lowest candidates | highest candidates | : start
- ^ last"
- self shouldBeImplemented.
- ^newMisfitsPosition!
Item was removed:
- ----- Method: SpurMemoryManager>>moveMisfitsToTopOfHighestObjects: (in category 'compaction') -----
- moveMisfitsToTopOfHighestObjects: misfits
- "After a cycle of exact-fit compaction highestObjects may contain some
- number of mobile objects that fail to fit, and more objects may exist to
- move. Move existing misfits to top of highestObjects and temporarily
- shrink highestObjects to refill it without overwriting misfits. Answer the
- old limit. moveMisfitsInHighestObjectsBack: will undo the change."
-
- | oldLimit bytesToMove |
- oldLimit := highestObjects limit.
- misfits = (highestObjects last + self wordSize) ifTrue:
- [^oldLimit].
- (self oop: misfits isLessThanOrEqualTo: highestObjects last) ifTrue:
- [bytesToMove := highestObjects last + self wordSize - misfits.
- self mem: (highestObjects limit - bytesToMove) asVoidPointer
- mo: misfits asVoidPointer
- ve: bytesToMove.
- highestObjects limit: misfits - self wordSize.
- ^oldLimit].
- "misfits wrapped; move in two stages to preserve ordering"
- bytesToMove := highestObjects last - highestObjects start.
- self mem: (misfits - bytesToMove) asVoidPointer
- mo: misfits asVoidPointer
- ve: oldLimit - misfits.
- highestObjects limit: misfits - bytesToMove.
- self mem: (oldLimit - bytesToMove) asVoidPointer
- mo: highestObjects start asVoidPointer
- ve: bytesToMove.
- ^oldLimit!
Item was changed:
----- Method: SpurMemoryManager>>rebuildFreeListsForPigCompact (in category 'compaction') -----
rebuildFreeListsForPigCompact
"Rebuild the free lists from the doubly-linked free list."
totalFreeOldSpace := 0.
self sortedFreeListDo:
[:freeObj| | start bytes |
bytes := (self bytesInObject: freeObj).
start := self startOfObject: freeObj.
+ self addFreeChunkWithBytes: bytes at: start].
+ self checkFreeSpace!
- self addFreeChunkWithBytes: bytes at: start]!
Item was removed:
- ----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceAndRebuildFreeListsForFitCompactFrom: (in category 'compaction') -----
- sweepToCoallesceFreeSpaceAndRebuildFreeListsForFitCompactFrom: lowestFree
- | firstFree lastFree |
- firstFree := lastFree := 0.
- "Sweep from lowest forwarder, coalescing runs of forwarders and free objects."
- self allOldSpaceEntitiesFrom: lowestFree do:
- [:o|
- (self isFreeObject: o)
- ifTrue: "two cases, isolated, in which case leave alone, or adjacent,
- in which case, remove from free set prior to coalesce."
- [| next |
- next := self objectAfter: o limit: endOfMemory.
- self assert: (next = endOfMemory or: [(self isFreeObject: next) not]). "free chunks have already been coalesced"
- (firstFree ~= 0
- or: [next ~= endOfMemory and: [self isForwarded: next]]) ifTrue:
- [firstFree = 0 ifTrue:
- [firstFree := o].
- lastFree := o.
- self detachFreeObject: o.
- self checkFreeSpace]]
- ifFalse:
- [(self isForwarded: o)
- ifTrue:
- [firstFree = 0 ifTrue:
- [firstFree := o].
- lastFree := o]
- ifFalse:
- [firstFree ~= 0 ifTrue:
- [| start bytes |
- start := self startOfObject: firstFree.
- bytes := (self addressAfter: lastFree) - start.
- self addFreeChunkWithBytes: bytes at: start.
- self checkFreeSpace].
- firstFree := 0]]].
- firstFree ~= 0 ifTrue:
- [| start bytes |
- start := self startOfObject: firstFree.
- bytes := (self addressAfter: lastFree) - start.
- self addFreeChunkWithBytes: bytes at: start].!
Item was removed:
- ----- Method: SpurMemoryManager>>sweepToFollowForwardersForFitCompact (in category 'compaction') -----
- sweepToFollowForwardersForFitCompact
- "sweep, following forwarders in all live objects, and finding the first forwarder."
- | lowestFree |
- lowestFree := 0.
- self allOldSpaceEntitiesDo:
- [:o|
- ((self isFreeObject: o) or: [self isForwarded: o])
- ifTrue:
- [lowestFree = 0 ifTrue:
- [lowestFree := o]]
- ifFalse:
- [0 to: (self numPointerSlotsOf: o) - 1 do:
- [:i| | f |
- f := self fetchPointer: i ofObject: o.
- (self isOopForwarded: f) ifTrue:
- [f := self followForwarded: f.
- self storePointer: i ofObject: o withValue: f]]]].
- ^lowestFree!
More information about the Vm-dev
mailing list