[Vm-dev] VM Maker: VMMaker.oscog-cb.2448.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Oct 5 11:20:02 UTC 2018
ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.2448.mcz
==================== Summary ====================
Name: VMMaker.oscog-cb.2448
Author: cb
Time: 5 October 2018, 1:19:31.815249 pm
UUID: 54116d70-25ba-4d92-a6a9-e9104e788aa2
Ancestors: VMMaker.oscog-cb.2447
Introduced the concept of lilliputian free chunks, which are free chunks not big enough to use the double linked list design. They do not exist in 32 bits but only in 64bits.
Rewrote bytesBigEnoughForPrevPointer: to not isLilliputianSize:
Fix SpurSelectiveCompactor to have a specific logic for lilliputian chunks: selective sweep phase now sort the lilliputian free chunk in ascending order without overhead by having an extra variable (O(1) memory complexity), that same variable is used so that the compaction algorithm now iterate over the lilliputian linked list as it compacts selected segments (compaction is in ascending addresses per segments and inside segments to compact), decreasing the worst complexity of lilliputian management from N^2 to N, which makes sense in large heaps (>2Gb) since that single linked list is millions of elements.
At 20Gb among 40 compaction pauses on a benchmark, I had 37 under 8ms and 3 >1 sec because of these lilliputian free chunks. Now rebenching but preliminary results show that everything should be below 10ms now :-)
The name lilliputian is chosen for multiple reasons:
- lilliputian people are very small, like these smallest free chunks
- complex logic specifically for these very small chunks looks complete non sense to me, like the recent British politic (see Brexit), and lilliputian people are in the book a parody of British politics.
=============== Diff against VMMaker.oscog-cb.2447 ===============
Item was removed:
- ----- Method: FilePluginSimulator>>dir_EntryLookup: (in category 'simulation') -----
- dir_EntryLookup: pathString _: pathStringLength _: entryNameString _: entryNameStringLength _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink
- "sqInt dir_EntryLookup(char *pathString, sqInt pathStringLength, char *nameString, sqInt nameStringLength,
- /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate,
- sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt *posixPermissions, sqInt *isSymlink)"
- | result pathName entryName |
- pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString.
- entryName := ((0 to: entryNameStringLength - 1) collect: [:i| (entryNameString at: i) asCharacter]) as: ByteString.
- result := self primLookupEntryIn: pathName name: entryName.
- result ifNil: [^DirNoMoreEntries].
- result isInteger ifTrue:
- [result > 1 ifTrue:
- [interpreterProxy primitiveFailFor: result].
- ^DirBadPath].
- name replaceFrom: 1 to: result first size with: result first startingAt: 1.
- nameLength at: 0 put: result first size.
- creationDate at: 0 put: (result at: 2).
- modificationDate at: 0 put: (result at: 3).
- isDirectory at: 0 put: (result at: 4).
- sizeIfFile at: 0 put: (result at: 5).
- posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]).
- isSymlink at: 0 put: (result at: 7 ifAbsent: [false]).
- ^DirEntryFound!
Item was added:
+ ----- Method: FilePluginSimulator>>dir_EntryLookup:_:_:_:_:_:_:_:_:_:_:_: (in category 'simulation') -----
+ dir_EntryLookup: pathString _: pathStringLength _: entryNameString _: entryNameStringLength _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink
+ "sqInt dir_EntryLookup(char *pathString, sqInt pathStringLength, char *nameString, sqInt nameStringLength,
+ /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate,
+ sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt *posixPermissions, sqInt *isSymlink)"
+ | result pathName entryName |
+ pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString.
+ entryName := ((0 to: entryNameStringLength - 1) collect: [:i| (entryNameString at: i) asCharacter]) as: ByteString.
+ result := self primLookupEntryIn: pathName name: entryName.
+ result ifNil: [^DirNoMoreEntries].
+ result isInteger ifTrue:
+ [result > 1 ifTrue:
+ [interpreterProxy primitiveFailFor: result].
+ ^DirBadPath].
+ name replaceFrom: 1 to: result first size with: result first startingAt: 1.
+ nameLength at: 0 put: result first size.
+ creationDate at: 0 put: (result at: 2).
+ modificationDate at: 0 put: (result at: 3).
+ isDirectory at: 0 put: (result at: 4).
+ sizeIfFile at: 0 put: (result at: 5).
+ posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]).
+ isSymlink at: 0 put: (result at: 7 ifAbsent: [false]).
+ ^DirEntryFound!
Item was removed:
- ----- Method: FilePluginSimulator>>dir_Lookup: (in category 'simulation') -----
- dir_Lookup: pathString _: pathStringLength _: index _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink
- "sqInt dir_Lookup( char *pathString, sqInt pathStringLength, sqInt index,
- /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate,
- sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt * posixPermissions, sqInt *isSymlink)"
- | result pathName |
- pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString.
- result := self primLookupEntryIn: pathName index: index.
- result ifNil: [^DirNoMoreEntries].
- result isInteger ifTrue:
- [result > 1 ifTrue:
- [interpreterProxy primitiveFailFor: result].
- ^DirBadPath].
- name replaceFrom: 1 to: result first size with: result first startingAt: 1.
- nameLength at: 0 put: result first size.
- creationDate at: 0 put: (result at: 2).
- modificationDate at: 0 put: (result at: 3).
- isDirectory at: 0 put: (result at: 4).
- sizeIfFile at: 0 put: (result at: 5).
- posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]).
- isSymlink at: 0 put: (result at: 7 ifAbsent: [false]).
- ^DirEntryFound!
Item was added:
+ ----- Method: FilePluginSimulator>>dir_Lookup:_:_:_:_:_:_:_:_:_:_: (in category 'simulation') -----
+ dir_Lookup: pathString _: pathStringLength _: index _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink
+ "sqInt dir_Lookup( char *pathString, sqInt pathStringLength, sqInt index,
+ /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate,
+ sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt * posixPermissions, sqInt *isSymlink)"
+ | result pathName |
+ pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString.
+ result := self primLookupEntryIn: pathName index: index.
+ result ifNil: [^DirNoMoreEntries].
+ result isInteger ifTrue:
+ [result > 1 ifTrue:
+ [interpreterProxy primitiveFailFor: result].
+ ^DirBadPath].
+ name replaceFrom: 1 to: result first size with: result first startingAt: 1.
+ nameLength at: 0 put: result first size.
+ creationDate at: 0 put: (result at: 2).
+ modificationDate at: 0 put: (result at: 3).
+ isDirectory at: 0 put: (result at: 4).
+ sizeIfFile at: 0 put: (result at: 5).
+ posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]).
+ isSymlink at: 0 put: (result at: 7 ifAbsent: [false]).
+ ^DirEntryFound!
Item was removed:
- ----- Method: InterpreterPlugin>>strncpy: (in category 'simulation support') -----
- strncpy: aString _: bString _: n
- <doNotGenerate>
- ^interpreterProxy strncpy: aString _: bString _: n!
Item was added:
+ ----- Method: InterpreterPlugin>>strncpy:_:_: (in category 'simulation support') -----
+ strncpy: aString _: bString _: n
+ <doNotGenerate>
+ ^interpreterProxy strncpy: aString _: bString _: n!
Item was removed:
- ----- Method: Spur32BitMemoryManager>>bytesBigEnoughForPrevPointer: (in category 'free space') -----
- bytesBigEnoughForPrevPointer: chunkBytes
- "Allocation unit, the minimum size, is enough for 2 pointers"
- ^ true!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>isLilliputianSize: (in category 'free space') -----
+ isLilliputianSize: chunkBytes
+ "Allocation unit, the minimum size, is enough for 2 pointers"
+ ^ false!
Item was removed:
- ----- Method: Spur64BitMemoryManager>>bytesBigEnoughForPrevPointer: (in category 'free space') -----
- bytesBigEnoughForPrevPointer: chunkBytes
- "To have a prev pointer, which follows the next pointer, we need at least two slots."
- ^chunkBytes > (self baseHeaderSize + self allocationUnit)!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>isLilliputianSize: (in category 'free space') -----
+ isLilliputianSize: chunkBytes
+ "To have a prev pointer, which follows the next pointer, we need at least two slots."
+ self assert: chunkBytes >= (self baseHeaderSize + self allocationUnit).
+ ^chunkBytes = (self baseHeaderSize + self allocationUnit)!
Item was removed:
- ----- Method: Spur64BitMemoryManager>>memmove: (in category 'simulation only') -----
- memmove: destAddress _: sourceAddress _: bytes
- <doNotGenerate>
- | dst src |
- dst := destAddress asInteger.
- src := sourceAddress asInteger.
- "Emulate the c library memmove function"
- self assert: bytes \\ 4 = 0.
- destAddress > sourceAddress
- ifTrue:
- [bytes - 4 to: 0 by: -4 do:
- [:i| self long32At: dst + i put: (self long32At: src + i)]]
- ifFalse:
- [0 to: bytes - 4 by: 4 do:
- [:i| self long32At: dst + i put: (self long32At: src + i)]]!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>memmove:_:_: (in category 'simulation only') -----
+ memmove: destAddress _: sourceAddress _: bytes
+ <doNotGenerate>
+ | dst src |
+ dst := destAddress asInteger.
+ src := sourceAddress asInteger.
+ "Emulate the c library memmove function"
+ self assert: bytes \\ 4 = 0.
+ destAddress > sourceAddress
+ ifTrue:
+ [bytes - 4 to: 0 by: -4 do:
+ [:i| self long32At: dst + i put: (self long32At: src + i)]]
+ ifFalse:
+ [0 to: bytes - 4 by: 4 do:
+ [:i| self long32At: dst + i put: (self long32At: src + i)]]!
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).
"Too slow to be enabled byt default but useful to debug Selective...
self deny: (compactor isSegmentBeingCompacted: (segmentManager segmentContainingObj: freeChunk))."
index := chunkBytes / self allocationUnit.
index < self numFreeLists ifTrue:
[self setNextFreeChunkOf: freeChunk withValue: (freeLists at: index) chunkBytes: chunkBytes.
+ (self isLilliputianSize: chunkBytes) ifFalse:
- (self bytesBigEnoughForPrevPointer: chunkBytes) ifTrue:
[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>>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) isLilliputianSize: false.
+ self setNextFreeChunkOf: child withValue: freeChunk isLilliputianSize: false.
- [self setNextFreeChunkOf: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: child) bytesBigEnoughForPrevPointer: true.
- self setNextFreeChunkOf: child withValue: freeChunk bytesBigEnoughForPrevPointer: true.
^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)
+ isLilliputianSize: false.
- bytesBigEnoughForPrevPointer: true.
^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 assertValidFreeObject: chunk.
self unlinkFreeChunk: chunk atIndex: initialIndex chunkBytes: chunkBytes.
^ chunk].
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 isLilliputianSize: false.
- self unlinkFreeChunk: chunk atIndex: index bytesBigEnoughForPrevPointer: true.
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 isLilliputianSize: false.
- self unlinkFreeChunk: chunk atIndex: index bytesBigEnoughForPrevPointer: true.
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.
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
setNextFreeChunkOf: child
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk)
+ isLilliputianSize: false.
- 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)
+ isLilliputianSize: false.
- 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.
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
ifTrue: [self unlinkFreeChunk: node atIndex: initialIndex 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.
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: node atIndex: index isLilliputianSize: false.]
+ ifFalse: [self setNextFreeChunkOf: prev withValue: next isLilliputianSize: false.].
- ifTrue: [self unlinkFreeChunk: node atIndex: index bytesBigEnoughForPrevPointer: true.]
- ifFalse: [self setNextFreeChunkOf: prev withValue: next bytesBigEnoughForPrevPointer: true.].
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.
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
+ ifTrue: [self unlinkFreeChunk: node atIndex: index isLilliputianSize: false.]
+ ifFalse: [self setNextFreeChunkOf: prev withValue: next isLilliputianSize: false.].
- ifTrue: [self unlinkFreeChunk: node atIndex: index bytesBigEnoughForPrevPointer: true.]
- ifFalse: [self setNextFreeChunkOf: prev withValue: next bytesBigEnoughForPrevPointer: true.].
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.
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
setNextFreeChunkOf: prev
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node)
+ isLilliputianSize: false.
- 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)
+ isLilliputianSize: false.
- 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>>assertFreeChunkPrevHeadZero (in category 'free space') -----
assertFreeChunkPrevHeadZero
|min|
self wordSize = 8 ifTrue: [min := 3] ifFalse: [min := 2].
min to: self numFreeLists - 1 do:
[:i|
(freeLists at: i) ~= 0 ifTrue:
+ [self deny: (self isLilliputianSize: (freeLists at: i)).
- [self assert: (self bytesBigEnoughForPrevPointer: (freeLists at: i)).
self assert: (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: (freeLists at: i)) = 0]].
"Large chunks"
self freeTreeNodesDo: [:freeNode |
self assert: (self fetchPointer: self freeChunkPrevIndex ofFreeChunk: freeNode) = 0.
freeNode].
^ true!
Item was changed:
----- 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, while in simulation, the code breaks on the assertion we want to."
| chunk index |
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 isLilliputianSize: (self bytesInObject: objOop)) ifFalse:
- (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]]
ifFalse:
[self freeTreeNodesDo: [:freeNode |
freeNode = objOop ifTrue: [self assert: chunk = 0]. freeNode]].
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 removed:
- ----- Method: SpurMemoryManager>>bytesBigEnoughForPrevPointer: (in category 'free space') -----
- bytesBigEnoughForPrevPointer: chunkBytes
- "Answer if chunkBytes (which includes an object header) has room enough for both
- a next free chunk and a previous free chunk pointer. This is always true in 32-bits,
- but in 64-bits requires at least 24 bytes."
- 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 isLilliputianSize: (self bytesInObject: obj)) ifFalse:
- (self bytesBigEnoughForPrevPointer: (self bytesInObject: obj)) ifTrue:
[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 isLilliputianSize: (self bytesInObject: obj)) ifFalse:
- (self bytesBigEnoughForPrevPointer: (self bytesInObject: obj)) ifTrue:
[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 changed:
----- Method: SpurMemoryManager>>detachFreeObject: (in category 'free space') -----
detachFreeObject: freeChunk
- "This is a rare operation, so its efficiency isn't critical.
- Having a valid prev link for tree nodes would help."
<inline: true>
| chunkBytes |
chunkBytes := self bytesInObject: freeChunk.
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
self unlinkFreeChunk: freeChunk chunkBytes: chunkBytes!
Item was added:
+ ----- Method: SpurMemoryManager>>firstLilliputianChunk (in category 'free space') -----
+ firstLilliputianChunk
+ ^freeLists at: self lilliputianChunkIndex!
Item was added:
+ ----- Method: SpurMemoryManager>>increaseFreeOldSpaceBy: (in category 'free space') -----
+ increaseFreeOldSpaceBy: bytes
+ totalFreeOldSpace := totalFreeOldSpace + bytes
+ !
Item was added:
+ ----- Method: SpurMemoryManager>>isLilliputianSize: (in category 'free space') -----
+ isLilliputianSize: chunkBytes
+ "Answer if chunkBytes (which includes an object header) is too small to hold both
+ a next free chunk and a previous free chunk pointer. This is always false in 32-bits,
+ but in 64 bits small chunk of size 2 are lilliputian."
+ self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>lilliputianChunkIndex (in category 'free space') -----
+ lilliputianChunkIndex
+ "See isLilliputianSize:"
+ ^(self baseHeaderSize + self allocationUnit) // self allocationUnit
+ !
Item was removed:
- ----- Method: SpurMemoryManager>>memcpy: (in category 'simulation') -----
- memcpy: destAddress _: sourceAddress _: bytes
- "For SpurGenerationScavenger>>copyToFutureSpace:bytes:. N.B. If ranges overlap, must use memmove."
- <doNotGenerate>
- self deny: ((destAddress <= sourceAddress and: [destAddress asInteger + bytes > sourceAddress])
- or: [sourceAddress <= destAddress and: [sourceAddress asInteger + bytes > destAddress]]).
- ^self memmove: destAddress _: sourceAddress _: bytes!
Item was added:
+ ----- Method: SpurMemoryManager>>memcpy:_:_: (in category 'simulation') -----
+ memcpy: destAddress _: sourceAddress _: bytes
+ "For SpurGenerationScavenger>>copyToFutureSpace:bytes:. N.B. If ranges overlap, must use memmove."
+ <doNotGenerate>
+ self deny: ((destAddress <= sourceAddress and: [destAddress asInteger + bytes > sourceAddress])
+ or: [sourceAddress <= destAddress and: [sourceAddress asInteger + bytes > destAddress]]).
+ ^self memmove: destAddress _: sourceAddress _: bytes!
Item was changed:
----- Method: SpurMemoryManager>>printFreeChunk:printAsTreeNode: (in category 'debug printing') -----
printFreeChunk: freeChunk printAsTreeNode: printAsTreeNode
| numBytes |
numBytes := self bytesInObject: freeChunk.
coInterpreter
print: 'freeChunk '; printHexPtrnp: freeChunk.
printAsTreeNode ifTrue:
[coInterpreter print: ' - '; printHexPtrnp:(self addressAfter: freeChunk)].
coInterpreter
print: ' bytes '; printNum: numBytes;
print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: freeChunk).
+ (self isLilliputianSize: numBytes) ifFalse:
- (self bytesBigEnoughForPrevPointer: numBytes) ifTrue:
[coInterpreter
print: ' prev '; printHexPtrnp: (self fetchPointer: self freeChunkPrevIndex
ofFreeChunk: freeChunk).].
(numBytes >= (self numFreeLists * self allocationUnit)
and: [printAsTreeNode]) ifTrue:
[coInterpreter
print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex
ofFreeChunk: freeChunk);
print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex
ofFreeChunk: freeChunk);
print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex
ofFreeChunk: freeChunk)].
coInterpreter cr!
Item was removed:
- ----- 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
self
setNextFreeChunkOf: freeChunk
withValue: nextFreeChunk
+ isLilliputianSize: (self isLilliputianSize: chunkBytes)
- bytesBigEnoughForPrevPointer: (self bytesBigEnoughForPrevPointer: chunkBytes)
!
Item was added:
+ ----- Method: SpurMemoryManager>>setNextFreeChunkOf:withValue:isLilliputianSize: (in category 'free space') -----
+ setNextFreeChunkOf: freeChunk withValue: nextFreeChunk isLilliputianSize: lilliputian
+ <inline: true> "Inlining is quite important since isLilliputianSize: is often true/false"
+ self
+ storePointer: self freeChunkNextIndex
+ ofFreeChunk: freeChunk
+ withValue: nextFreeChunk.
+ (nextFreeChunk ~= 0 and: [lilliputian not]) ifTrue:
+ [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)].
chunkBytes := self bytesInObject: chunk.
false ifTrue: "The prevPointer is not guaranteed to be valid in older images.
updateListStartingAt: via updateFreeLists does restore the prev pointer
in all small free lists, so simply avoid swizzling it now."
+ [(self isLilliputianSize: chunkBytes) ifFalse:
- [(self bytesBigEnoughForPrevPointer: chunkBytes) ifTrue:
[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 removed:
- ----- 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]]).
-
- "For some reason the assertion is not compiled correctly"
- self cCode: '' inSmalltalk: [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
+ isLilliputianSize: (self isLilliputianSize: chunkBytes) !
- bytesBigEnoughForPrevPointer: (self bytesBigEnoughForPrevPointer: chunkBytes) !
Item was added:
+ ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex:isLilliputianSize: (in category 'free space') -----
+ unlinkFreeChunk: chunk atIndex: index isLilliputianSize: lilliputian
+ "Unlink and answer a small chunk from one of the fixed size freeLists"
+ <inline: true> "inlining is important because isLilliputianSize: 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]]).
+
+ "For some reason the assertion is not compiled correctly"
+ self cCode: '' inSmalltalk: [self assert: (self isLilliputianSize: (self bytesInObject: chunk)) = lilliputian].
+
+ freeLists
+ at: index
+ put: (next := self
+ fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: chunk).
+ (lilliputian not 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 next prev |
index := chunkBytes / self allocationUnit.
"Pathological 64 bits case - size 1 - single linked list"
+ (self isLilliputianSize: chunkBytes) ifTrue:
+ [^self unlinkLilliputianChunk: freeChunk index: index].
- (self bytesBigEnoughForPrevPointer: chunkBytes) ifFalse:
- [^self unlinkSmallChunk: freeChunk index: index].
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.
^freeChunk].
"Is the beginning of a list"
"Small chunk"
(index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue:
+ [self unlinkFreeChunk: freeChunk atIndex: index isLilliputianSize: false.
- [self unlinkFreeChunk: freeChunk atIndex: index bytesBigEnoughForPrevPointer: true.
^freeChunk].
"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].
^freeChunk
!
Item was added:
+ ----- Method: SpurMemoryManager>>unlinkLilliputianChunk:index: (in category 'free space') -----
+ unlinkLilliputianChunk: freeChunk index: index
+ | node prev next |
+ <inline: #never> "for profiling"
+ node := freeLists at: index.
+ prev := 0.
+ [node ~= 0] whileTrue:
+ [self assert: node = (self startOfObject: node).
+ self assertValidFreeObject: node.
+ next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ node = freeChunk ifTrue:
+ [prev = 0
+ ifTrue: [self unlinkFreeChunk: freeChunk atIndex: index isLilliputianSize: true]
+ ifFalse: [self setNextFreeChunkOf: prev withValue: next isLilliputianSize: true].
+ ^freeChunk].
+ prev := node.
+ node := next].
+ self error: 'freeChunk not found in lilliputian chunk free list'
+
+
+
+ !
Item was removed:
- ----- Method: SpurMemoryManager>>unlinkSmallChunk:index: (in category 'free space') -----
- unlinkSmallChunk: freeChunk index: index
- | node prev next |
- <inline: #never> "for profiling"
- node := freeLists at: index.
- prev := 0.
- [node ~= 0] whileTrue:
- [self assert: node = (self startOfObject: node).
- self assertValidFreeObject: 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].
- ^freeChunk].
- prev := node.
- node := next].
- self error: 'freeChunk not found in free list of size 1'
-
-
-
- !
Item was changed:
----- Method: SpurMemoryManager>>updateListStartingAt: (in category 'initialization') -----
updateListStartingAt: freeNode
|prev obj|
freeNode = 0 ifTrue: [^self].
+ self deny: (self isLilliputianSize: (self bytesInObject: freeNode)).
- 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]!
Item was changed:
SpurSweeper subclass: #SpurSelectiveCompactor
+ instanceVariableNames: 'segmentToFill lastLilliputianChunk'
- instanceVariableNames: 'segmentToFill'
classVariableNames: 'MaxOccupationForCompaction'
poolDictionaries: ''
category: 'VMMaker-SpurMemoryManager'!
+ !SpurSelectiveCompactor commentStamp: 'cb 10/5/2018 12:58' prior: 0!
- !SpurSelectiveCompactor commentStamp: 'cb 5/17/2018 11:43' prior: 0!
SpurSelectiveCompactor compacts memory by selecting the memory segments with the most free space and compacting only those, to limit fragmentation while being really quick to perform. The algorithm is fast mostly because it does not update pointers: they are updated lazily during the next marking phase, so there is no need to read the fields of objects in other memory segments that the one compacted.
The algorithm works as follow. First, a global sweep pass iterates over the memory linearly, changing unmarked objects to free chunks and concatenating free chunks. During the global sweep phase, the segments of the heap are analysed to determine the percentage of occupation. Second, the least occupied segments are compacted by copying the remaining live objects into an entirely free segment, called regionToFill (we detail later in the paragraph where regionToFill comes from), changing their values to forwarding objects and marking the free chunks as unavailable (removed from free list and marked as data objects). Third, the next marking phase removes all forwarders. Fourth, at the beginning of the next compaction phase the compacted segments from the previous GC can be entirely marked as free space (No need to check anything inside, there were only forwarders and trash data). One of the compacted segment is then selected as the segmentToFill, others are just marked as free chunks.
The compaction is effectively partial, compacting only the most critical segments of the heap to limit fragmentation. Compaction time is crazy low, since a low number of objects are moved and pointer updated is lazily done during the next marking phase, while still preventing memory fragmentation.
Now this works well when biasForGC is true, but when performing a snapshot, the compactor is just total crap (we need to figure out a solution).
segmentToFill <SegInfo> the segment that will be filled through the copying algorithm
+ lastLilliputianChunk <Oop to FreeChunk> This is used as a performance trick for lilliputian free chunks. See below.
Segment abuse:
+ The swizzle field of segInfo is abused by using the low 8 bits for occupation and the 9th bit as isBeingCompacted bit.
+
+ Performance trick for lilliputian chunks:
+ Specific free chunks (called lilliputian, see isLilliputianSize:) are managed using a single linked list instead of a double linked list since there's not enough room in the free chunk for the back pointer. During the sweep phase this is not a problem since we're rebuilding the free chunk structure, but during selective compaction we're detaching free chunks from the free chunk structure and that can be horribly slow (10 seconds sometimes at 20Gb heap due to many iteration over the single linked list). To work around this problem, the sweep phase use lastLilliputianChunk variable to sort the lilliputian free chunk single linked list in ascending address order (See interceptAddFreeChunkWithBytes:at:). During the selective compation phase, the same variable is re-used to iterate at most once over the single linked list while detaching lilliputian chunks (See incrementalUnlinkSmallChunk:).
+ "!
- The swizzle field of segInfo is abused by using the low 8 bits for occupation and the 9th bit as isBeingCompacted bit.!
Item was changed:
----- Method: SpurSelectiveCompactor>>compact (in category 'api') -----
compact
<inline: #never> "for profiling, though we profile selectiveCompaction and sweep separatly."
self resetFreeLists.
self freePastSegmentsAndSetSegmentToFill.
self globalSweepAndSegmentOccupationAnalysis.
+ self assert: self sortedLilliputianChunks.
manager updateSweepEndUsecs.
self selectiveCompaction.
!
Item was changed:
----- Method: SpurSelectiveCompactor>>compactSegment:freeStart: (in category 'compaction') -----
compactSegment: segInfo freeStart: initialFreeStart
<var: 'segInfo' type: #'SpurSegmentInfo *'>
| currentEntity fillStart bytesToCopy bridge copy |
fillStart := initialFreeStart.
bridge := manager segmentManager bridgeFor: segInfo.
currentEntity := manager objectStartingAt: segInfo segStart.
[self oop: currentEntity isLessThan: bridge] whileTrue:
[(manager isFreeObject: currentEntity)
ifTrue:
["To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
+ (manager isLilliputianSize: (manager bytesInObject: currentEntity))
+ ifTrue: [self incrementalUnlinkLilliputianChunk: currentEntity] "Performance hack for single linked list"
+ ifFalse: [manager detachFreeObject: currentEntity].
- manager detachFreeObject: currentEntity.
manager set: currentEntity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
ifFalse:
["Copy the object in segmentToFill and replace it by a forwarder."
self assert: (manager isPinned: currentEntity) not.
bytesToCopy := manager bytesInObject: currentEntity.
manager memcpy: fillStart asVoidPointer _: (manager startOfObject: currentEntity) asVoidPointer _: bytesToCopy.
copy := manager objectStartingAt: fillStart.
(manager isRemembered: copy) ifTrue:
["copy has the remembered bit set, but is not in the remembered table."
manager setIsRememberedOf: copy to: false.
scavenger remember: copy].
manager forward: currentEntity to: (manager objectStartingAt: fillStart).
fillStart := fillStart + bytesToCopy.
self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))].
currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory].
self assert: currentEntity = bridge.
^ fillStart!
Item was changed:
----- Method: SpurSelectiveCompactor>>compactSegmentsToCompact (in category 'compaction') -----
compactSegmentsToCompact
"Forwards all objects in segments to compact and removes their freechunks"
| segInfo fillStart |
<var: 'segInfo' type: #'SpurSegmentInfo *'>
fillStart := segmentToFill segStart.
"Removes initial free chunk in segment to fill... (Segment is entirely free)"
manager detachFreeObject: (manager objectStartingAt: fillStart).
+ "Set-up hack to iterate at most one over size 1 free chunks single linked list."
+ lastLilliputianChunk := 0.
+
"Compact each segment to compact..."
0 to: manager numSegments - 1 do:
[:i|
segInfo := self addressOf: (manager segmentManager segments at: i).
(self isSegmentBeingCompacted: segInfo)
ifTrue: [fillStart := self compactSegment: segInfo freeStart: fillStart ]].
"Final free chunk in segment to fill..."
manager
addFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - fillStart
at: fillStart.
self postCompactionAction
!
Item was changed:
----- Method: SpurSelectiveCompactor>>globalSweepAndSegmentOccupationAnalysis (in category 'sweep phase') -----
globalSweepAndSegmentOccupationAnalysis
<inline: #never> "profiling"
"Iterate over old space, free unmarked objects, annotate each segment with each occupation"
| currentEntity nextBridge segmentIndex currentUsed currentUnused |
+ lastLilliputianChunk := 0. "performance hack for single linked list"
currentEntity := manager firstObject.
nextBridge := manager segmentManager bridgeAt: 0.
segmentIndex := currentUnused := currentUsed := 0.
[self oop: currentEntity isLessThan: manager endOfMemory] whileTrue:
[currentEntity = nextBridge "End of segment, set occupation"
ifTrue:
[self
setOccupationAtIndex: segmentIndex
used: currentUsed
unused: currentUnused.
currentUnused := currentUsed := 0.
segmentIndex := segmentIndex + 1.
nextBridge := manager segmentManager bridgeAt: segmentIndex]
ifFalse:
[(self canUseAsFreeSpace: currentEntity) "In-segment, sweep and compute occupation"
ifTrue:
[currentEntity := self bulkFreeChunkFrom: currentEntity.
currentUnused := currentUnused + (manager bytesInObject: currentEntity)]
ifFalse:
[self unmark: currentEntity.
currentUsed := currentUsed + (manager bytesInObject: currentEntity)]].
currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory].
self "set last segment occupation"
setOccupationAtIndex: segmentIndex
used: currentUsed
unused: currentUnused.
+ "we set the nextFreeChunk of last chunk at the end of the loop to avoid to set it at each iteration"
+ lastLilliputianChunk ~= 0 ifTrue:
+ [manager setNextFreeChunkOf: lastLilliputianChunk withValue: 0 isLilliputianSize: true].
manager checkFreeSpace: GCModeFull.
manager unmarkSurvivingObjectsForCompact.!
Item was added:
+ ----- Method: SpurSelectiveCompactor>>incrementalLilliputianSmallChunk: (in category 'compaction') -----
+ incrementalLilliputianSmallChunk: freeChunk
+ "This is duplicate form #unlinkSmallChunk:index: for performance hack (single iteration of single linked list)"
+ <inline: #never> "for profiling"
+ | node next |
+ self assert: (manager bytesInObject: freeChunk) = (manager baseHeaderSize + manager allocationUnit).
+ self assert: manager lilliputianChunkIndex = ((manager bytesInObject: freeChunk) / manager allocationUnit).
+ lastLilliputianChunk = 0 ifTrue: "first incremental unlink"
+ [(freeChunk = manager firstLilliputianChunk)
+ ifTrue: [^manager unlinkFreeChunk: freeChunk atIndex: manager lilliputianChunkIndex isLilliputianSize: true]
+ ifFalse: [lastLilliputianChunk := manager firstLilliputianChunk]].
+ node := manager fetchPointer: manager freeChunkNextIndex ofFreeChunk: lastLilliputianChunk.
+ [node ~= 0] whileTrue:
+ [self assert: node = (manager startOfObject: node).
+ manager assertValidFreeObject: node.
+ next := manager fetchPointer: manager freeChunkNextIndex ofFreeChunk: node.
+ node = freeChunk ifTrue:
+ [^manager setNextFreeChunkOf: lastLilliputianChunk withValue: next isLilliputianSize: true].
+ lastLilliputianChunk := node.
+ node := next].
+ self error: 'freeChunk not found in lilliputian chunk free list'
+
+
+ !
Item was added:
+ ----- Method: SpurSelectiveCompactor>>interceptAddFreeChunkWithBytes:at: (in category 'sweep phase') -----
+ interceptAddFreeChunkWithBytes: bytes at: start
+ <inline: true>
+ | freeChunk |
+ (manager isLilliputianSize: bytes) ifTrue: "build size 1 free chunk in ascending addresses order"
+ [lastLilliputianChunk = 0
+ ifTrue: [^lastLilliputianChunk := manager addFreeChunkWithBytes: bytes at: start]
+ ifFalse:
+ [manager increaseFreeOldSpaceBy: bytes.
+ freeChunk := manager initFreeChunkWithBytes: bytes at: start.
+ manager setNextFreeChunkOf: lastLilliputianChunk withValue: freeChunk isLilliputianSize: true.
+ "we set the nextFreeChunk of last chunk at the end of the loop to avoid to set it at each iteration"
+ ^lastLilliputianChunk := freeChunk]].
+ ^manager addFreeChunkWithBytes: bytes at: start
+ !
Item was added:
+ ----- Method: SpurSelectiveCompactor>>sortedLilliputianChunks (in category 'sweep phase') -----
+ sortedLilliputianChunks
+ |current next|
+ current := manager firstLilliputianChunk.
+ current = 0 ifTrue: [^true]. "no node"
+ [next := manager fetchPointer: manager freeChunkNextIndex ofFreeChunk: current.
+ next = 0] whileFalse:
+ [(manager oop: current isLessThan: next) ifFalse: [^false].
+ current := next].
+ ^ true
+ !
Item was changed:
----- Method: SpurSweeper>>bulkFreeChunkFrom: (in category 'sweep phase') -----
bulkFreeChunkFrom: objOop
"The old space entity before objOop is necessarily a marked object. Attempts to free as many bytes
from objOop start as possible, looking ahead to free contiguous freechunks / unmarked objects"
| bytes start next currentObj |
self assert: ((manager isMarked: objOop) not or: [manager isFreeObject: objOop]).
start := manager startOfObject: objOop.
currentObj := objOop.
bytes := 0.
[bytes := bytes + (manager bytesInObject: currentObj).
(manager isRemembered: currentObj)
ifTrue:
[self assert: (manager isFreeObject: currentObj) not.
scavenger forgetObject: currentObj].
next := manager objectStartingAt: start + bytes.
self assert: ((manager oop: next isLessThan: manager endOfMemory)
or: [next = manager endOfMemory and: [(self canUseAsFreeSpace: next) not]]).
self canUseAsFreeSpace: next]
whileTrue: [currentObj := next].
+ ^self interceptAddFreeChunkWithBytes: bytes at: start!
- ^manager addFreeChunkWithBytes: bytes at: start!
Item was added:
+ ----- Method: SpurSweeper>>interceptAddFreeChunkWithBytes:at: (in category 'sweep phase') -----
+ interceptAddFreeChunkWithBytes: bytes at: start
+ <inline: true>
+ ^manager addFreeChunkWithBytes: bytes at: start
+ !
Item was removed:
- ----- Method: VMClass>>memcpy: (in category 'C library simulation') -----
- memcpy: dString _: sString _: bytes
- <doNotGenerate>
- "implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
- (dString isString or: [sString isString]) ifFalse:
- [| destAddress sourceAddress |
- dString class == ByteArray ifTrue:
- [ByteString adoptInstance: dString.
- ^[self memcpy: dString _: sString _: bytes] ensure:
- [ByteArray adoptInstance: dString]].
- destAddress := dString asInteger.
- sourceAddress := sString asInteger.
- self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
- or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
- dString isString
- ifTrue:
- [1 to: bytes do:
- [:i| | v |
- v := sString isString
- ifTrue: [sString at: i]
- ifFalse: [Character value: (self byteAt: sString + i - 1)].
- dString at: i put: v]]
- ifFalse:
- [1 to: bytes do:
- [:i| | v |
- v := sString isString
- ifTrue: [(sString at: i) asInteger]
- ifFalse: [self byteAt: sString + i - 1].
- self byteAt: dString + i - 1 put: v]].
- ^dString!
Item was added:
+ ----- Method: VMClass>>memcpy:_:_: (in category 'C library simulation') -----
+ memcpy: dString _: sString _: bytes
+ <doNotGenerate>
+ "implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
+ (dString isString or: [sString isString]) ifFalse:
+ [| destAddress sourceAddress |
+ dString class == ByteArray ifTrue:
+ [ByteString adoptInstance: dString.
+ ^[self memcpy: dString _: sString _: bytes] ensure:
+ [ByteArray adoptInstance: dString]].
+ destAddress := dString asInteger.
+ sourceAddress := sString asInteger.
+ self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
+ or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
+ dString isString
+ ifTrue:
+ [1 to: bytes do:
+ [:i| | v |
+ v := sString isString
+ ifTrue: [sString at: i]
+ ifFalse: [Character value: (self byteAt: sString + i - 1)].
+ dString at: i put: v]]
+ ifFalse:
+ [1 to: bytes do:
+ [:i| | v |
+ v := sString isString
+ ifTrue: [(sString at: i) asInteger]
+ ifFalse: [self byteAt: sString + i - 1].
+ self byteAt: dString + i - 1 put: v]].
+ ^dString!
Item was removed:
- ----- Method: VMClass>>memmove: (in category 'C library simulation') -----
- memmove: destAddress _: sourceAddress _: bytes
- <doNotGenerate>
- | dst src |
- dst := destAddress asInteger.
- src := sourceAddress asInteger.
- "Emulate the c library memmove function"
- self assert: bytes \\ 4 = 0.
- destAddress > sourceAddress
- ifTrue:
- [bytes - 4 to: 0 by: -4 do:
- [:i| self longAt: dst + i put: (self longAt: src + i)]]
- ifFalse:
- [0 to: bytes - 4 by: 4 do:
- [:i| self longAt: dst + i put: (self longAt: src + i)]]!
Item was added:
+ ----- Method: VMClass>>memmove:_:_: (in category 'C library simulation') -----
+ memmove: destAddress _: sourceAddress _: bytes
+ <doNotGenerate>
+ | dst src |
+ dst := destAddress asInteger.
+ src := sourceAddress asInteger.
+ "Emulate the c library memmove function"
+ self assert: bytes \\ 4 = 0.
+ destAddress > sourceAddress
+ ifTrue:
+ [bytes - 4 to: 0 by: -4 do:
+ [:i| self longAt: dst + i put: (self longAt: src + i)]]
+ ifFalse:
+ [0 to: bytes - 4 by: 4 do:
+ [:i| self longAt: dst + i put: (self longAt: src + i)]]!
Item was removed:
- ----- Method: VMClass>>strcat: (in category 'C library simulation') -----
- strcat: aString _: bString
- <doNotGenerate>
- "implementation of strcat(3)"
- ^(self asString: aString), (self asString: bString)!
Item was added:
+ ----- Method: VMClass>>strcat:_: (in category 'C library simulation') -----
+ strcat: aString _: bString
+ <doNotGenerate>
+ "implementation of strcat(3)"
+ ^(self asString: aString), (self asString: bString)!
Item was removed:
- ----- Method: VMClass>>strncmp: (in category 'C library simulation') -----
- strncmp: aString _: bString _: n
- <doNotGenerate>
- "implementation of strncmp(3)"
- bString isString ifTrue:
- [1 to: n do:
- [:i|
- (aString at: i) asCharacter ~= (bString at: i) ifTrue:
- [^i]].
- ^0].
- 1 to: n do:
- [:i| | v |
- v := (aString at: i) asInteger - (self byteAt: bString + i - 1).
- v ~= 0 ifTrue: [^v]].
- ^0!
Item was added:
+ ----- Method: VMClass>>strncmp:_:_: (in category 'C library simulation') -----
+ strncmp: aString _: bString _: n
+ <doNotGenerate>
+ "implementation of strncmp(3)"
+ bString isString ifTrue:
+ [1 to: n do:
+ [:i|
+ (aString at: i) asCharacter ~= (bString at: i) ifTrue:
+ [^i]].
+ ^0].
+ 1 to: n do:
+ [:i| | v |
+ v := (aString at: i) asInteger - (self byteAt: bString + i - 1).
+ v ~= 0 ifTrue: [^v]].
+ ^0!
Item was removed:
- ----- Method: VMClass>>strncpy: (in category 'C library simulation') -----
- strncpy: aString _: bString _: n
- <doNotGenerate>
- "implementation of strncpy(3)"
- aString isString
- ifTrue:
- [1 to: n do:
- [:i| | v |
- v := bString isString
- ifTrue: [bString at: i]
- ifFalse: [Character value: (self byteAt: bString + i - 1)].
- aString at: i put: v.
- v asInteger = 0 ifTrue: [^aString]]]
- ifFalse:
- [1 to: n do:
- [:i| | v |
- v := bString isString
- ifTrue: [(bString at: i) asInteger]
- ifFalse: [self byteAt: bString + i - 1].
- self byteAt: aString + i - 1 put: v.
- v = 0 ifTrue: [^aString]]].
- ^aString!
Item was added:
+ ----- Method: VMClass>>strncpy:_:_: (in category 'C library simulation') -----
+ strncpy: aString _: bString _: n
+ <doNotGenerate>
+ "implementation of strncpy(3)"
+ aString isString
+ ifTrue:
+ [1 to: n do:
+ [:i| | v |
+ v := bString isString
+ ifTrue: [bString at: i]
+ ifFalse: [Character value: (self byteAt: bString + i - 1)].
+ aString at: i put: v.
+ v asInteger = 0 ifTrue: [^aString]]]
+ ifFalse:
+ [1 to: n do:
+ [:i| | v |
+ v := bString isString
+ ifTrue: [(bString at: i) asInteger]
+ ifFalse: [self byteAt: bString + i - 1].
+ self byteAt: aString + i - 1 put: v.
+ v = 0 ifTrue: [^aString]]].
+ ^aString!
More information about the Vm-dev
mailing list