VM Maker: VMMaker.oscog-cb.2406.mcz

 
ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2406.mcz

==================== Summary ====================

Name: VMMaker.oscog-cb.2406
Author: cb
Time: 7 June 2018, 8:02:40.687927 pm
UUID: f05a0c4e-15d4-44ab-8ac2-333a6ac1577c
Ancestors: VMMaker.oscog-cb.2405

Added bytesBigEnoughForPrevPointer: abstraction and patch all callers to use that.

32 bits works, now fixing 64 bits.

=============== Diff against VMMaker.oscog-cb.2405 ===============

Item was added:
+ ----- Method: Spur32BitMemoryManager>>bytesBigEnoughForPrevPointer: (in category 'free space') -----
+ bytesBigEnoughForPrevPointer: chunkBytes
+ "Allocation unit, the minimum size, is enough for 2 pointers"
+ ^ true!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>bytesBigEnoughForPrevPointer: (in category 'free space') -----
+ bytesBigEnoughForPrevPointer: chunkBytes
+ ^ chunkBytes ~= (self baseHeaderSize + self allocationUnit)!

Item was changed:
  ----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') -----
  addToFreeTree: freeChunk bytes: chunkBytes
  "Add freeChunk to the large free chunk tree.
  For the benefit of sortedFreeObject:, answer the treeNode it is added
  to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
  | childBytes parent child |
  self assert: (self isFreeObject: freeChunk).
  self assert: chunkBytes = (self bytesInObject: freeChunk).
  self assert: chunkBytes >= (self numFreeLists * self allocationUnit).
  self
  storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
  storePointer: self freeChunkPrevIndex ofFreeChunk: freeChunk withValue: 0;
  storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
  storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
  storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
  "Large chunk list organized as a tree, each node of which is a list of chunks of the same size.
  Beneath the node are smaller and larger blocks."
  parent := 0.
  child := freeLists at: 0.
  [child ~= 0] whileTrue:
  [childBytes := self bytesInObject: child.
  "check for overlap; could write this as self oop: (self objectAfter: freeChunk) isLessThanOrEqualTo: child...
   but that relies on headers being correct, etc.  So keep it clumsy..."
  self assert: ((self oop: freeChunk + chunkBytes - self baseHeaderSize isLessThanOrEqualTo: child)
  or: [self oop: freeChunk isGreaterThanOrEqualTo: child + childBytes - self baseHeaderSize]).
  childBytes = chunkBytes ifTrue: "size match; add to list at node."
+ [self setNextFreeChunkOf: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: child) bytesBigEnoughForPrevPointer: true.
+ self setNextFreeChunkOf: child withValue: freeChunk bytesBigEnoughForPrevPointer: true.
- [self setNextFreeChunkOf: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: child) sizeIsOne: false.
- self setNextFreeChunkOf: child withValue: freeChunk sizeIsOne: false.
  ^child].
  "walk down the tree"
  parent := child.
  child := self fetchPointer: (childBytes > chunkBytes
  ifTrue: [self freeChunkSmallerIndex]
  ifFalse: [self freeChunkLargerIndex])
  ofFreeChunk: child].
  parent = 0 ifTrue:
  [self assert: (freeLists at: 0) = 0.
  freeLists at: 0 put: freeChunk.
  freeListsMask := freeListsMask bitOr: 1.
  ^0].
  self assert: (freeListsMask anyMask: 1).
  "insert in tree"
  self storePointer: self freeChunkParentIndex
  ofFreeChunk: freeChunk
  withValue: parent.
  self storePointer: (childBytes > chunkBytes
  ifTrue: [self freeChunkSmallerIndex]
  ifFalse: [self freeChunkLargerIndex])
  ofFreeChunk: parent
  withValue: freeChunk.
  ^0!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateLargestFreeChunk (in category 'free space') -----
  allocateLargestFreeChunk
  "Answer the largest free chunk in the free lists."
  <inline: false>
  | freeChunk next |
  "would like to use ifNotNil: but the ^next inside the ^blah ifNotNil: confused Slang"
  freeChunk := self findLargestFreeChunk.
  freeChunk ifNil: [^nil].
  "This will be the node, not a list element.  Answer a list element in preference."
  next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk.
  next ~= 0 ifTrue:
  [self assert: (self bytesInObject: freeChunk) >= self numFreeLists. "findLargestFreeChunk searches only the tree"
  self
  setNextFreeChunkOf: freeChunk
  withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: next)
+ bytesBigEnoughForPrevPointer: true.
- sizeIsOne: false.
  ^next].
  self unlinkSolitaryFreeTreeNode: freeChunk.
  ^freeChunk!

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].
  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
  setNextFreeChunkOf: child
  withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)
+ bytesBigEnoughForPrevPointer: true.
- sizeIsOne: false.
  ^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.
- sizeIsOne: false.
  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: [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: [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: [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 setNextFreeChunkOf: prev withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) sizeIsOne: false.
  ^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.
- sizeIsOne: false.
  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].
  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.
- sizeIsOne: false.
  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 changed:
  ----- 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.
- sizeIsOne: false.
  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>>assertValidFreeObject: (in category 'free space') -----
  assertValidFreeObject: 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:
- (self bytesInObject: objOop) / self wordSize = 1 ifFalse:
  ["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 added:
+ ----- Method: SpurMemoryManager>>bytesBigEnoughForPrevPointer: (in category 'free space') -----
+ bytesBigEnoughForPrevPointer: chunkBytes
+ self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>checkHeapFreeSpaceIntegrity (in category 'debug support') -----
  checkHeapFreeSpaceIntegrity
  "Perform an integrity/leak check using the heapMap.  Assume clearLeakMapAndMapAccessibleFreeSpace
  has set a bit at each free chunk's header.  Scan all objects in the heap checking that no pointer points
  to a free chunk and that all free chunks that refer to others refer to marked chunks.  Answer if all checks pass."
  | ok total |
  <inline: false>
  <var: 'total' type: #usqInt>
  ok := true.
  total := 0.
  0 to: self numFreeLists - 1 do:
  [:i|
  (freeLists at: i) ~= 0 ifTrue:
  [(heapMap heapMapAtWord: (self pointerForOop: (freeLists at: i))) = 0 ifTrue:
  [coInterpreter print: 'leak in free list '; printNum: i; print: ' to non-free '; printHex: (freeLists at: i); cr.
  self eek.
  ok := false]]].
 
  "Excuse the duplication but performance is at a premium and we avoid
  some tests by splitting the newSpace and oldSpace enumerations."
  self allNewSpaceEntitiesDo:
  [:obj| | fieldOop |
  (self isFreeObject: obj)
  ifTrue:
  [coInterpreter print: 'young object '; printHex: obj; print: ' is free'; cr.
  self eek.
  ok := false]
  ifFalse:
  [0 to: (self numPointerSlotsOf: obj) - 1 do:
  [:fi|
  fieldOop := self fetchPointer: fi ofObject: obj.
  (self isNonImmediate: fieldOop) ifTrue:
  [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue:
  [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; cr.
  self eek.
  ok := false]]]]].
  self allOldSpaceEntitiesDo:
  [:obj| | fieldOop |
  (self isFreeObject: obj)
  ifTrue:
  [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
  [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is unmapped?!! '; cr.
  self eek.
  ok := false].
  fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj.
  (fieldOop ~= 0
  and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
  [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; cr.
  self eek.
  ok := false].
+ (self bytesBigEnoughForPrevPointer: (self bytesInObject: obj)) ifTrue:
- (self bytesInObject: obj) / self wordSize = 1 ifFalse:
  [fieldOop := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: obj.
  (fieldOop ~= 0
  and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
  [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; cr.
  self eek.
  ok := false]].
  (self isLargeFreeObject: obj) ifTrue:
  [self freeChunkParentIndex to: self freeChunkLargerIndex do:
  [:fi|
  fieldOop := self fetchPointer: fi ofFreeChunk: obj.
  (fieldOop ~= 0
  and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
  [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is unmapped'; cr.
  self eek.
  ok := false]]].
  total := total + (self bytesInObject: obj)]
  ifFalse:
  [0 to: (self numPointerSlotsOf: obj) - 1 do:
  [:fi|
  (self isForwarded: obj)
  ifTrue:
  [self assert: fi = 0. "I'm now trying to use forwarders in GC algorithms..."
  fieldOop := self fetchPointer: fi ofMaybeForwardedObject: obj]
  ifFalse: "We keep #fetchPointer:ofObject: API here for assertions"
  [fieldOop := self fetchPointer: fi ofObject: obj].
  (self isNonImmediate: fieldOop) ifTrue:
  [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue:
  [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; cr.
  self eek.
  ok := false]]]]].
  total ~= totalFreeOldSpace ifTrue:
  [coInterpreter print: 'incorrect totalFreeOldSpace; expected '; printNum: totalFreeOldSpace; print: ' found '; printNum: total; cr.
  self eek.
  ok := false].
  ^ok!

Item was changed:
  ----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
  checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
  "Perform an integrity/leak check using the heapMap.  Assume clearLeakMapAndMapAccessibleObjects
  has set a bit at each (non-free) object's header.  Scan all objects in the heap checking that every
  pointer points to a header.  Scan the rememberedSet, remapBuffer and extraRootTable checking
  that every entry is a pointer to a header. Check that the number of roots is correct and that all
  rememberedSet entries have their isRemembered: flag set.  Answer if all checks pass."
  | ok numRememberedObjectsInHeap |
  <inline: false>
  self cCode: []
  inSmalltalk:
  ["Almost all of the time spent here used to go into the asserts in fetchPointer:ofObject: in the
   simulator class overrides. Since we know here the indices used are valid we temporarily
   remove them to claw back that performance."
  (self class whichClassIncludesSelector: #fetchPointer:ofObject:) ~= SpurMemoryManager ifTrue:
  [^self withSimulatorFetchPointerMovedAsideDo:
  [self checkHeapIntegrity: excludeUnmarkedObjs
  classIndicesShouldBeValid: classIndicesShouldBeValid]]].
  ok := true.
  numRememberedObjectsInHeap := 0.
  0 to: self numFreeLists - 1 do:
  [:i|
  (freeLists at: i) ~= 0 ifTrue:
  [(heapMap heapMapAtWord: (self pointerForOop: (freeLists at: i))) ~= 0 ifTrue:
  [coInterpreter print: 'leak in free list '; printNum: i; print: ' to non-free '; printHex: (freeLists at: i); cr.
  self eek.
  ok := false]]].
 
  "Excuse the duplication but performance is at a premium and we avoid
  some tests by splitting the newSpace and oldSpace enumerations."
  self allNewSpaceEntitiesDo:
  [:obj| | fieldOop classIndex classOop |
  (self isFreeObject: obj)
  ifTrue:
  [coInterpreter print: 'young object '; printHex: obj; print: ' is free'; cr.
  self eek.
  ok := false]
  ifFalse:
  [((self isMarked: obj) not and: [excludeUnmarkedObjs]) ifFalse:
  [(self isRemembered: obj) ifTrue:
  [coInterpreter print: 'young object '; printHex: obj; print: ' is remembered'; cr.
  self eek.
  ok := false]].
  (self isForwarded: obj)
  ifTrue:
  [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
  (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
  [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
  self eek.
  ok := false]]
  ifFalse:
  [classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
  (classIndicesShouldBeValid
   and: [classOop = nilObj
   and: [(self isHiddenObj: obj) not]]) ifTrue:
  [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
  self eek.
  ok := false].
  0 to: (self numPointerSlotsOf: obj) - 1 do:
  [:fi|
  fieldOop := self fetchPointer: fi ofObject: obj.
  (self isNonImmediate: fieldOop) ifTrue:
  [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
  [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
  self eek.
  ok := false]]]]]].
  self allOldSpaceEntitiesDo:
  [:obj| | containsYoung fieldOop classIndex classOop |
  (self isFreeObject: obj)
  ifTrue:
  [(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
  [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is mapped?!! '; cr.
  self eek.
  ok := false].
  fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj.
  (fieldOop ~= 0
  and: [(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0]) ifTrue:
  [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is mapped'; cr.
  self eek.
  ok := false].
+ (self bytesBigEnoughForPrevPointer: (self bytesInObject: obj)) ifTrue:
- (self bytesInObject: obj) / self wordSize = 1 ifFalse:
  [fieldOop := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: obj.
  (fieldOop ~= 0
  and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
  [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; cr.
  self eek.
  ok := false]].
  (self isLargeFreeObject: obj) ifTrue:
  [self freeChunkParentIndex to: self freeChunkLargerIndex do:
  [:fi|
  fieldOop := self fetchPointer: fi ofFreeChunk: obj.
  (fieldOop ~= 0
  and: [(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0]) ifTrue:
  [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is mapped'; cr.
  self eek.
  ok := false].]]]
  ifFalse:
  [(excludeUnmarkedObjs and: [(self isMarked: obj)not]) ifTrue: [] ifFalse: [
  containsYoung := false.
  (self isRemembered: obj) ifTrue:
  [numRememberedObjectsInHeap := numRememberedObjectsInHeap + 1.
  (scavenger isInRememberedSet: obj) ifFalse:
  [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
  self eek.
  ok := false]].
  (self isForwarded: obj)
  ifTrue:
  [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
  (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
  [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
  self eek.
  ok := false].
  (self isReallyYoung: fieldOop) ifTrue:
  [containsYoung := true]]
  ifFalse:
  [classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
  (classIndicesShouldBeValid
   and: [classOop = nilObj
   and: [classIndex > self lastClassIndexPun]]) ifTrue:
  [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
  self eek.
  ok := false].
  0 to: (self numPointerSlotsOf: obj) - 1 do:
  [:fi|
  fieldOop := self fetchPointer: fi ofObject: obj.
  (self isNonImmediate: fieldOop) ifTrue:
  [(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
  [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
  self eek.
  ok := false].
  "don't be misled by CogMethods; they appear to be young, but they're not"
  (self isReallyYoung: fieldOop) ifTrue:
  [containsYoung := true]]]].
  containsYoung ifTrue:
  [(self isRemembered: obj) ifFalse:
  [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
  self eek.
  ok := false]]]]].
  numRememberedObjectsInHeap ~= scavenger rememberedSetSize ifTrue:
  [coInterpreter
  print: 'root count mismatch. #heap roots ';
  printNum: numRememberedObjectsInHeap;
  print: '; #roots ';
  printNum: scavenger rememberedSetSize;
  cr.
  self eek.
  "But the system copes with overflow..."
  self flag: 'no support for remembered set overflow yet'.
  "ok := rootTableOverflowed and: [needGCFlag]"].
  scavenger rememberedSetWithIndexDo:
  [:obj :i|
  (obj bitAnd: self wordSize - 1) ~= 0
  ifTrue:
  [coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
  self eek.
  ok := false]
  ifFalse:
  [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
  ifTrue:
  [coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
  self eek.
  ok := false]
  ifFalse:
  [(self isYoung: obj) ifTrue:
  [coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
  self eek.
  ok := false]]]].
  self objStack: mournQueue do:
  [:i :page| | obj |
  obj := self fetchPointer: i ofObject: page.
  (obj bitAnd: self wordSize - 1) ~= 0
  ifTrue:
  [coInterpreter print: 'misaligned oop in mournQueue @ '; printNum: i; print: ' in '; printHex: page; print: ' = '; printHex: obj; cr.
  self eek.
  ok := false]
  ifFalse:
  [(excludeUnmarkedObjs and: [(self isMarked: obj) not]) ifFalse:
  [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
  [coInterpreter print: 'object leak in mournQueue @ '; printNum: i; print: ' in '; printHex: page; print: ' = '; printHex: obj; cr.
  self eek.
  ok := false]]]].
  1 to: remapBufferCount do:
  [:ri| | obj |
  obj := remapBuffer at: ri.
  (obj bitAnd: self wordSize - 1) ~= 0
  ifTrue:
  [coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  self eek.
  ok := false]
  ifFalse:
  [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
  [coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  self eek.
  ok := false]]].
  1 to: extraRootCount do:
  [:ri| | obj |
  obj := (extraRoots at: ri) at: 0.
  (obj bitAnd: self wordSize - 1) ~= 0
  ifTrue:
  [coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  self eek.
  ok := false]
  ifFalse:
  [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
  [coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  self eek.
  ok := false]]].
  ^ok!

Item was added:
+ ----- Method: SpurMemoryManager>>setNextFreeChunkOf:withValue:bytesBigEnoughForPrevPointer: (in category 'free space') -----
+ setNextFreeChunkOf: freeChunk withValue: nextFreeChunk bytesBigEnoughForPrevPointer: bytesBigEnoughForPrevPointer
+ <inline: true> "Inlining is quite important since bytesBigEnoughForPrevPointer is often true"
+ self
+ storePointer: self freeChunkNextIndex
+ ofFreeChunk: freeChunk
+ withValue: nextFreeChunk.
+ (nextFreeChunk ~= 0 and: [bytesBigEnoughForPrevPointer]) ifTrue:
+ [self
+ storePointer: self freeChunkPrevIndex
+ ofFreeChunk: nextFreeChunk
+ withValue: freeChunk]
+
+ !

Item was changed:
  ----- Method: SpurMemoryManager>>setNextFreeChunkOf:withValue:chunkBytes: (in category 'free space') -----
  setNextFreeChunkOf: freeChunk withValue: nextFreeChunk chunkBytes: chunkBytes
- <inline: true>
  self
  setNextFreeChunkOf: freeChunk
  withValue: nextFreeChunk
+ bytesBigEnoughForPrevPointer: (self bytesBigEnoughForPrevPointer: chunkBytes)
- sizeIsOne: chunkBytes / self wordSize = 1
 
  !

Item was removed:
- ----- Method: SpurMemoryManager>>setNextFreeChunkOf:withValue:sizeIsOne: (in category 'free space') -----
- setNextFreeChunkOf: freeChunk withValue: nextFreeChunk sizeIsOne: sizeIsOne
- <inline: true> "Inlining is quite important since sizeIsOne is often false"
- self
- storePointer: self freeChunkNextIndex
- ofFreeChunk: freeChunk
- withValue: nextFreeChunk.
- "In 32 bits, there's always enough room,
- in 64 bits, size 1 is special."
- (nextFreeChunk = 0 or: [sizeIsOne]) ifFalse:
- [self
- storePointer: self freeChunkPrevIndex
- ofFreeChunk: nextFreeChunk
- withValue: freeChunk]
-
- !

Item was changed:
  ----- Method: SpurMemoryManager>>swizzleFieldsOfFreeChunk: (in category 'snapshot') -----
  swizzleFieldsOfFreeChunk: chunk
  <inline: true>
  | field chunkBytes |
  field := self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk.
  field ~= 0 ifTrue:
  [self storePointerNoAssert: self freeChunkNextIndex
  ofFreeChunk: chunk
  withValue: (segmentManager swizzleObj: field)].
+ (self bytesBigEnoughForPrevPointer: (chunkBytes := self bytesInObject: chunk)) ifTrue:
- (chunkBytes := self bytesInObject: chunk) / self wordSize = 1 ifFalse:
  [field := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: chunk.
  field ~= 0 ifTrue:
  [self storePointerNoAssert: self freeChunkPrevIndex
  ofFreeChunk: chunk
  withValue: (segmentManager swizzleObj: field)]].
  chunkBytes >= (self numFreeLists * self allocationUnit) ifTrue:
  [self freeChunkParentIndex to: self freeChunkLargerIndex do:
  [:index|
  field := self fetchPointer: index ofFreeChunk: chunk.
  field ~= 0 ifTrue:
  [self storePointerNoAssert: index
  ofFreeChunk: chunk
  withValue: (segmentManager swizzleObj: field)]]]!

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:
- chunkBytes / self wordSize = 1 ifTrue:
  [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: [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].
  "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>>updateFreeLists (in category 'initialization') -----
  updateFreeLists
  "Snapshot did not guarantee the state of the freelist prevLink, so we need to update it.
  Effectively transforms the freechunk single linked list in double linked list."
  |min|
  "Small chunks"
  "Skip in 64 bits size 1 which is single linked list - pathological case"
+ self wordSize = 8 ifTrue: [min := 2] ifFalse: [min := 1].
- self allocationUnit / self wordSize = 1 ifTrue: [min := 2] ifFalse: [min := 1].
  min to: self numFreeLists - 1 do:
  [:i| self updateListStartingAt: (freeLists at: i)].
  "Large chunks"
  self freeTreeNodesDo: [:freeNode |
  self updateListStartingAt: freeNode.
  freeNode]!