[Vm-dev] VM Maker: VMMaker.oscog-cb.2407.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Jun 7 19:17:30 UTC 2018
ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2407.mcz
==================== Summary ====================
Name: VMMaker.oscog-cb.2407
Author: cb
Time: 7 June 2018, 9:17:01.910973 pm
UUID: f5b4c84b-f7cf-4c4e-bee3-5ee2feee88d7
Ancestors: VMMaker.oscog-cb.2406
Fixing cases where double linked list prev pointer was not correctly updated.
Still have a bug where the first free chunk of a linked list has a prev pointer instead of 0.
=============== Diff against VMMaker.oscog-cb.2406 ===============
Item was changed:
----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') -----
addToFreeList: freeChunk bytes: chunkBytes
"Add freeChunk to the relevant freeList.
For the benefit of sortedFreeObject:, if freeChunk is large, answer the treeNode it
is added to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
| index |
"coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk."
self assert: (self isFreeObject: freeChunk).
self assert: chunkBytes = (self bytesInObject: freeChunk).
index := chunkBytes / self allocationUnit.
index < self numFreeLists ifTrue:
[self setNextFreeChunkOf: freeChunk withValue: (freeLists at: index) chunkBytes: chunkBytes.
+ (self bytesBigEnoughForPrevPointer: chunkBytes) ifTrue:
+ [self storePointer: self freeChunkPrevIndex ofFreeChunk: freeChunk withValue: 0].
- self storePointer: self freeChunkPrevIndex ofFreeChunk: freeChunk withValue: 0.
freeLists at: index put: freeChunk.
freeListsMask := freeListsMask bitOr: 1 << index.
^0].
^self addToFreeTree: freeChunk bytes: chunkBytes!
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 assert: (self isValidFreeObject: chunk).
+ ^self unlinkFreeChunk: chunk atIndex: initialIndex chunkBytes: chunkBytes].
- ^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 chunkBytes: chunkBytes.
- 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 chunkBytes: chunkBytes.
- 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
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 assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes]
- ifTrue: [freeLists at: initialIndex put: next]
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 assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes]
- ifTrue: [freeLists at: index put: next]
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 assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: node atIndex: index chunkBytes: chunkBytes]
- ifTrue: [freeLists at: index put: next]
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 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
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 changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes: (in category 'free space') -----
allocateOldSpaceChunkOfExactlyBytes: chunkBytes
"Answer a chunk of oldSpace from the free lists, if one of this size
is available, otherwise answer nil. N.B. the chunk is simply a pointer,
it has no valid header. The caller *must* fill in the header correctly."
<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].
- ^self unlinkFreeChunk: node atIndex: index].
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 removed:
- ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes:suchThat: (in category 'free space') -----
- allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: acceptanceBlock
- "Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
- 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 next prev child childBytes |
- <inline: true> "must inline for acceptanceBlock"
- "for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
-
- index := chunkBytes / self allocationUnit.
- index < self numFreeLists ifTrue:
- [(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 setNextFreeChunkOf: prev withValue: next chunkBytes: chunkBytes].
- totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
- ^node].
- prev := node.
- node := next]]].
- ^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:
- [self "Sorry stepping over isValidFreeObject all the time was killing me"
- cCode: [self assert: (self isValidFreeObject: child)]
- inSmalltalk: [self assertValidFreeObject: child].
- childBytes := self bytesInObject: child.
- childBytes = chunkBytes
- ifTrue: "size match; try to remove from list at node first."
- [node := child.
- [prev := node.
- node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
- node ~= 0] whileTrue:
- [(acceptanceBlock value: node) ifTrue:
- [self assert: (self isValidFreeObject: node).
- self
- setNextFreeChunkOf: prev
- withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node)
- bytesBigEnoughForPrevPointer: true.
- totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
- ^self startOfObject: node]].
- (acceptanceBlock value: child) ifFalse:
- [^nil]. "node was right size but unaceptable."
- 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].
- totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
- ^self startOfObject: child]
- ifFalse: "no size match; walk down the tree"
- [child := self fetchPointer: (childBytes < chunkBytes
- ifTrue: [self freeChunkLargerIndex]
- ifFalse: [self freeChunkSmallerIndex])
- ofFreeChunk: child]].
- ^nil!
Item was changed:
----- 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: [((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]]]]]]]]]]]!
- or: [(self isFreeOop: chunk) and: [self isLargeFreeObject: chunk]]]]]]]]]]!
Item was removed:
- ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex: (in category 'free space') -----
- unlinkFreeChunk: chunk atIndex: index
- "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).
- next = 0 ifFalse: [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: 0].
- ^chunk!
Item was added:
+ ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex:chunkBytes: (in category 'free space') -----
+ unlinkFreeChunk: chunk atIndex: index chunkBytes: 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 assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
node = freeChunk ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: freeChunk atIndex: index chunkBytes: chunkBytes]
- ifTrue: [freeLists at: index put: next]
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 chunkBytes: chunkBytes].
- ^self unlinkFreeChunk: freeChunk atIndex: index].
"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: SpurMemoryManager>>updateListStartingAt: (in category 'initialization') -----
updateListStartingAt: freeNode
|prev obj|
+ freeNode = 0 ifTrue: [^self].
+ self assert: (self bytesBigEnoughForPrevPointer: (self bytesInObject: freeNode)).
prev := freeNode.
self storePointer: self freeChunkPrevIndex ofFreeChunk: prev withValue: 0.
[obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: prev.
obj ~= 0] whileTrue:
[self storePointer: self freeChunkPrevIndex ofFreeChunk: obj withValue: prev.
prev := obj]!
More information about the Vm-dev
mailing list