[Vm-dev] VM Maker: VMMaker.oscog-cb.2410.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Jun 8 08:41:14 UTC 2018
ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2410.mcz
==================== Summary ====================
Name: VMMaker.oscog-cb.2410
Author: cb
Time: 8 June 2018, 10:40:45.005502 am
UUID: c739c9d4-b3eb-468f-9534-78221de8a653
Ancestors: VMMaker.oscog-eem.2409
- Added assertions for free chunks like crazy.
- Fixed the double linked list scheme (now everything resists the leak checker in stress GC benchs in 64 bits, previously it worked only in 32 bits)
=============== Diff against VMMaker.oscog-eem.2409 ===============
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') -----
fetchPointer: fieldIndex ofObject: objOop
self assert: (self isForwarded: objOop) not.
self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)
+ or: [fieldIndex = 0 "forwarders and free objs"
+ or: [fieldIndex = 1]]]).
- or: [fieldIndex = 0 "forwarders and free objs"]]).
^super fetchPointer: fieldIndex ofObject: objOop!
Item was changed:
----- Method: Spur32BitMMLESimulator>>fetchPointer:ofObject: (in category 'object access') -----
fetchPointer: fieldIndex ofObject: objOop
self assert: (self isForwarded: objOop) not.
self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)
+ or: [fieldIndex = 0 "forwarders and free objs"
+ or: [fieldIndex = 1]]]).
- or: [fieldIndex = 0 "forwarders and free objs"]]).
^super fetchPointer: fieldIndex ofObject: objOop!
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."
<var: #chunkBytes type: #usqInt>
| initialIndex chunk index nodeBytes parent child |
"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 assertValidFreeObject: chunk.
+ self unlinkFreeChunk: chunk atIndex: initialIndex chunkBytes: chunkBytes.
+ ^ chunk].
- self assert: (self isValidFreeObject: chunk).
- ^self unlinkFreeChunk: chunk atIndex: initialIndex chunkBytes: chunkBytes].
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 assertValidFreeObject: chunk.
+ self unlinkFreeChunk: chunk atIndex: index bytesBigEnoughForPrevPointer: true.
- self assert: (self isValidFreeObject: chunk).
- self unlinkFreeChunk: chunk atIndex: index chunkBytes: chunkBytes.
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 assertValidFreeObject: chunk.
+ self unlinkFreeChunk: chunk atIndex: index bytesBigEnoughForPrevPointer: true.
- self assert: (self isValidFreeObject: chunk).
- self unlinkFreeChunk: chunk atIndex: index chunkBytes: chunkBytes.
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 assertValidFreeObject: child.
- 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 assertValidFreeObject: chunk.
- [self assert: (self isValidFreeObject: chunk).
self
setNextFreeChunkOf: child
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)
bytesBigEnoughForPrevPointer: true.
^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
setNextFreeChunkOf: parent
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)
bytesBigEnoughForPrevPointer: true.
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 changed:
----- 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."
<var: #chunkBytes type: #usqInt>
| initialIndex node next prev index child childBytes acceptedChunk acceptedNode |
<inline: true> "must inline for acceptanceBlock"
"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 assertValidFreeObject: node.
- self assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: node atIndex: initialIndex chunkBytes: chunkBytes]
- ifTrue: [self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes]
ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes].
^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 assertValidFreeObject: node.
- self assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: node atIndex: index bytesBigEnoughForPrevPointer: true.]
+ ifFalse: [self setNextFreeChunkOf: prev withValue: next bytesBigEnoughForPrevPointer: true.].
- ifTrue: [self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes]
- ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes].
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 assertValidFreeObject: node.
- self assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: node atIndex: index bytesBigEnoughForPrevPointer: true.]
+ ifFalse: [self setNextFreeChunkOf: prev withValue: next bytesBigEnoughForPrevPointer: true.].
- ifTrue: [self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes]
- ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes].
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 assertValidFreeObject: child.
- [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 assertValidFreeObject: node.
- [self assert: (self isValidFreeObject: node).
self
setNextFreeChunkOf: prev
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node)
bytesBigEnoughForPrevPointer: true.
^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
setNextFreeChunkOf: acceptedNode
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk)
bytesBigEnoughForPrevPointer: true.
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 removed:
- ----- 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."
- <var: #chunkBytes type: #usqInt>
- | index node child |
- "for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
-
- index := chunkBytes / self allocationUnit.
- index < self numFreeLists ifTrue:
- [(freeListsMask anyMask: 1 << index) ifTrue:
- [(node := freeLists at: index) ~= 0 ifTrue:
- [self assert: node = (self startOfObject: node).
- self assert: (self isValidFreeObject: node).
- totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
- ^self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes].
- freeListsMask := freeListsMask - (1 << index)].
- ^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."
- child := freeLists at: 0.
- [child ~= 0] whileTrue:
- [| childBytes |
- self assert: (self isValidFreeObject: child).
- childBytes := self bytesInObject: child.
- childBytes = chunkBytes
- ifTrue: "size match; try to remove from list at node."
- [node := self fetchPointer: self freeChunkNextIndex
- ofFreeChunk: child.
- node ~= 0 ifTrue:
- [self assert: (self isValidFreeObject: node).
- self
- setNextFreeChunkOf: child
- withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node)
- bytesBigEnoughForPrevPointer: true.
- totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
- ^self startOfObject: node].
- "nothing acceptable on node's list; answer the node."
- self unlinkSolitaryFreeTreeNode: child.
- totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
- ^self startOfObject: child]
- ifFalse:
- [child := self fetchPointer: (childBytes < chunkBytes
- ifTrue: [self freeChunkLargerIndex]
- ifFalse: [self freeChunkSmallerIndex])
- ofFreeChunk: child]].
- ^nil!
Item was added:
+ ----- Method: SpurMemoryManager>>assertInnerValidFreeObject: (in category 'free space') -----
+ assertInnerValidFreeObject: objOop
+ <inline: #never> "we don't want to inline so we can nest that in an assertion with the return true so the production VM does not generate any code here, whil ein simulation, the code breaks on the assertion we want to."
+ | chunk index |
+ "duplicated assertions from isValidFreeObject: because I need to know what is wrong not only that it is not valid (I got bored of stepping inside isValidFreeObject:...)"
+ self assert: (self oop: (self addressAfter: objOop) isLessThanOrEqualTo: endOfMemory).
+ chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop.
+ self assert: (chunk = 0 or: [self isFreeOop: chunk]).
+ (self bytesBigEnoughForPrevPointer: (self bytesInObject: objOop)) ifTrue:
+ ["double linkedlist assertions"
+ chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop.
+ chunk = 0 ifFalse:
+ [self assert: (self isFreeOop: chunk).
+ self assert: objOop = (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk)].
+ chunk := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: objOop.
+ index := (self bytesInObject: objOop) / self allocationUnit.
+ (index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue:
+ [(freeLists at: index) = objOop ifTrue: [self assert: chunk = 0]].
+ chunk = 0 ifFalse:
+ [self assert: (self isFreeOop: chunk).
+ self assert: objOop = (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)]].
+ (self isLargeFreeObject: objOop) ifTrue:
+ ["Tree assertions"
+ chunk := self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop.
+ self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]).
+ chunk := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop.
+ self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]).
+ chunk := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop.
+ self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]])].
+ ^ true!
Item was changed:
----- Method: SpurMemoryManager>>assertValidFreeObject: (in category 'free space') -----
assertValidFreeObject: objOop
+ <inline: true>
+ "assertInnerValidFreeObject: is never inlined and always returns true.
+ For the production VM, this is entirely removed.
+ For the other VMs and in simulation, the code breaks at the first warning/assertion failure"
+ self assert: (self assertInnerValidFreeObject: objOop)!
- <doNotGenerate> "If you want to generate this you want to use 'self assert: (self isValidFreeObject: objOop)' instead not to generate code in assertion-free VMs"
- | chunk |
- "duplicated assertions from isValidFreeObject: because I need to know what is wrong not only that it is not valid (I got bored of stepping inside isValidFreeObject:...)"
- self assert: (self oop: (self addressAfter: objOop) isLessThanOrEqualTo: endOfMemory).
- chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop.
- self assert: (chunk = 0 or: [self isFreeOop: chunk]).
- (self bytesBigEnoughForPrevPointer: (self bytesInObject: objOop)) ifTrue:
- ["double linkedlist assertions"
- chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop.
- chunk = 0 ifFalse:
- [self assert: (self isFreeOop: chunk).
- self assert: objOop = (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk)].
- chunk := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: objOop.
- chunk = 0 ifFalse:
- [self assert: (self isFreeOop: chunk).
- self assert: objOop = (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)].].
- (self isLargeFreeObject: objOop) ifTrue:
- ["Tree assertions"
- chunk := self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop.
- self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]).
- chunk := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop.
- self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]).
- chunk := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop.
- self assert: (chunk = 0 or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]). ]!
Item was changed:
----- Method: SpurMemoryManager>>fetchPointer:ofFreeChunk: (in category 'heap management') -----
fetchPointer: fieldIndex ofFreeChunk: objOop
+ self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)
+ or: [fieldIndex = 0 "forwarders and free objs"
+ or: [fieldIndex = 1 and: [self wordSize = 4]]]]).
^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!
Item was changed:
----- Method: SpurMemoryManager>>findLargestFreeChunk (in category 'free space') -----
findLargestFreeChunk
"Answer, but do not remove, the largest free chunk in the free lists."
| treeNode childNode |
treeNode := freeLists at: 0.
treeNode = 0 ifTrue:
[^nil].
+ [self assertValidFreeObject: treeNode.
- [self assert: (self isValidFreeObject: treeNode).
self assert: (self bytesInObject: treeNode) >= (self numFreeLists * self allocationUnit).
childNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
childNode ~= 0] whileTrue:
[treeNode := childNode].
^treeNode!
Item was removed:
- ----- Method: SpurMemoryManager>>isValidFreeObject: (in category 'free space') -----
- isValidFreeObject: objOop
- | chunk |
- ^(self addressCouldBeOldObj: objOop)
- and: [(self isFreeObject: objOop)
- and: [(self oop: (self addressAfter: objOop) isLessThanOrEqualTo: endOfMemory)
- and: [((chunk := (self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop)) = 0
- or: [self isFreeOop: chunk])
- and: [
- (self bytesBigEnoughForPrevPointer: (self bytesInObject: objOop)) not
- or: [((chunk := (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: objOop)) = 0
- or: [self isFreeOop: chunk])
- and: [(self isLargeFreeObject: objOop) not
- or: [((chunk := (self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop)) = 0
- or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]])
- and: [((chunk := (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop)) = 0
- or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]])
- and: [(chunk := (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop)) = 0
- or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]]]]]]]]]]!
Item was changed:
----- Method: SpurMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') -----
storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer
self assert: (self isFreeObject: objOop).
self assert: (valuePointer = 0 or: [self isFreeObject: valuePointer]).
+ self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)
+ or: [fieldIndex = 0 "forwarders and free objs"]
+ or: [fieldIndex = 1 and: [self wordSize = 4]]]).
+
-
^self
longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
put: valuePointer!
Item was changed:
----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
totalFreeListBytes
"This method both computes the actual number of free bytes by traversing all free objects
on the free lists/tree, and checks that the tree is valid. It is used mainly by checkFreeSpace."
| totalFreeBytes bytesInChunk listNode nextNode |
totalFreeBytes := 0.
1 to: self numFreeLists - 1 do:
[:i|
bytesInChunk := i * self allocationUnit.
listNode := freeLists at: i.
[listNode ~= 0] whileTrue:
[totalFreeBytes := totalFreeBytes + bytesInChunk.
+ self assertValidFreeObject: listNode.
- self
- cCode: [self assert: (self isValidFreeObject: listNode)]
- inSmalltalk: [self assertValidFreeObject: listNode].
self assert: bytesInChunk = (self bytesInObject: listNode).
nextNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode.
self assert: nextNode ~= listNode.
listNode := nextNode]].
self freeTreeNodesDo:
[:treeNode|
bytesInChunk := self bytesInObject: treeNode.
self assert: bytesInChunk / self allocationUnit >= self numFreeLists.
listNode := treeNode.
[listNode ~= 0] whileTrue:
["self printFreeChunk: listNode"
+ self assertValidFreeObject: listNode.
- self assert: (self isValidFreeObject: listNode).
self assert: (listNode = treeNode
or: [(self fetchPointer: self freeChunkParentIndex ofFreeChunk: listNode) = 0]).
totalFreeBytes := totalFreeBytes + bytesInChunk.
self assert: bytesInChunk = (self bytesInObject: listNode).
nextNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode.
self assert: nextNode ~= listNode.
listNode := nextNode].
treeNode].
^totalFreeBytes!
Item was added:
+ ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex:bytesBigEnoughForPrevPointer: (in category 'free space') -----
+ unlinkFreeChunk: chunk atIndex: index bytesBigEnoughForPrevPointer: bytesBigEnoughForPrevPointer
+ "Unlink and answer a small chunk from one of the fixed size freeLists"
+ <inline: true> "inlining is important because bytesBigEnoughForPrevPointer is often true"
+ |next|
+ self assert: ((self bytesInObject: chunk) = (index * self allocationUnit)
+ and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit"
+ and: [(self startOfObject: chunk) = chunk]]).
+ self assert: (self bytesBigEnoughForPrevPointer:(self bytesInObject: chunk)) = bytesBigEnoughForPrevPointer.
+ freeLists
+ at: index
+ put: (next := self
+ fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: chunk).
+ (bytesBigEnoughForPrevPointer and: [next ~= 0]) ifTrue:
+ [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: 0].
+ ^chunk!
Item was changed:
----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex:chunkBytes: (in category 'free space') -----
unlinkFreeChunk: chunk atIndex: index chunkBytes: chunkBytes
+ ^self
+ unlinkFreeChunk: chunk
+ atIndex: index
+ bytesBigEnoughForPrevPointer: (self bytesBigEnoughForPrevPointer: chunkBytes) !
- "Unlink and answer a small chunk from one of the fixed size freeLists"
- <inline: true>
- |next|
- self assert: ((self bytesInObject: chunk) = (index * self allocationUnit)
- and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit"
- and: [(self startOfObject: chunk) = chunk]]).
- freeLists
- at: index
- put: (next := self
- fetchPointer: self freeChunkNextIndex
- ofFreeChunk: chunk).
- ((self bytesBigEnoughForPrevPointer: chunkBytes) and: [next ~= 0]) ifTrue:
- [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: 0].
- ^chunk!
Item was changed:
----- Method: SpurMemoryManager>>unlinkFreeChunk:chunkBytes: (in category 'free space') -----
unlinkFreeChunk: freeChunk chunkBytes: chunkBytes
"Unlink a free object from the free lists. Do not alter totalFreeOldSpace. Used for coalescing."
| index node next prev |
index := chunkBytes / self allocationUnit.
"Pathological 64 bits case - size 1 - single linked list"
-
(self bytesBigEnoughForPrevPointer: chunkBytes) ifFalse:
[node := freeLists at: index.
prev := 0.
[node ~= 0] whileTrue:
[self assert: node = (self startOfObject: node).
+ self assertValidFreeObject: node.
- self assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
node = freeChunk ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: freeChunk atIndex: index bytesBigEnoughForPrevPointer: false]
+ ifFalse: [self setNextFreeChunkOf: prev withValue: next bytesBigEnoughForPrevPointer: false].
- ifTrue: [self unlinkFreeChunk: freeChunk atIndex: index chunkBytes: chunkBytes]
- ifFalse: [self setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes].
^self].
prev := node.
node := next].
self error: 'freeChunk not found in free list of size 1'].
prev := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: freeChunk.
"Has prev element: update double linked list"
prev ~= 0 ifTrue:
[self
setNextFreeChunkOf: prev
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk)
chunkBytes: chunkBytes.
^self].
"Is the beginning of a list"
"Small chunk"
(index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue: [
+ ^self unlinkFreeChunk: freeChunk atIndex: index bytesBigEnoughForPrevPointer: true ].
- ^self unlinkFreeChunk: freeChunk atIndex: index chunkBytes: chunkBytes].
"Large chunk"
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk.
next = 0
ifTrue: "no list; remove the interior node"
[self unlinkSolitaryFreeTreeNode: freeChunk]
ifFalse: "list; replace node with it"
[self inFreeTreeReplace: freeChunk with: next]
!
Item was changed:
----- Method: SpurSelectiveCompactorSimulator>>checkSegmentToFillLooksAllRight (in category 'debugging') -----
checkSegmentToFillLooksAllRight
"Check only 1 free object at the end or none.
Check segment is iterable until bridge"
| currentEntity bridge |
self talk: 'Checking segment to fill iterable/last is free ' , (manager segmentManager indexOfSegment: segmentToFill) printString.
bridge := manager segmentManager bridgeFor: segmentToFill.
currentEntity := manager objectStartingAt: segmentToFill segStart.
[self oop: currentEntity isLessThan: bridge] whileTrue:
[(manager isFreeObject: currentEntity)
ifTrue: "should be last entity"
[self assert: (manager objectAfter: currentEntity limit: manager endOfMemory) = bridge.
+ self assertValidFreeObject: currentEntity].
- self assert: (manager isValidFreeObject: currentEntity)].
currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory].
"End of iteration should end on bridge"
self assert: currentEntity = bridge.
self talkNoCr: ' OK'.!
More information about the Vm-dev
mailing list