[Vm-dev] VM Maker: VMMaker.oscog-eem.525.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Nov 27 01:41:23 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.525.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.525
Author: eem
Time: 26 November 2013, 5:38:29.693 pm
UUID: 6e1e8f4a-3f4c-4aef-87cc-ad1016a9dbf8
Ancestors: VMMaker.oscog-eem.524
Correct detachFreeObject: given that freeChunkPrevIndex is not
maintained. Nuke all uses of freeChunkPrevIndex.
Fix dumb bugs in SpurMemoryManager>>assimilateNewSegment: &
allocateOldSpaceChunkOfExactlyBytes:suchThat:.
Change totalFreeListBytes to check that list nodes in the tree have
a null parent.
Correct and then comment-out the delay wakeup code in
CogVMSimulator>>primitiveSignalAtMilliseconds.
=============== Diff against VMMaker.oscog-eem.524 ===============
Item was changed:
----- Method: CogVMSimulator>>primitiveSignalAtMilliseconds (in category 'system control primitives') -----
primitiveSignalAtMilliseconds
super primitiveSignalAtMilliseconds.
+ "self successful ifTrue:
- self successful ifTrue:
[Transcript
cr; nextPutAll: thisContext selector;
nextPutAll: ' now '; nextPutAll: self ioUTCMicroseconds hex;
nextPutAll: ' wakeup '; nextPutAll: nextWakeupUsecs hex;
+ nextPutAll: ' wakeup - now '; print: nextWakeupUsecs - self ioUTCMicroseconds; flush]"!
- nextPutAll: ' wakeup - now '; print: self ioUTCMicroseconds - nextWakeupUsecs; flush]!
Item was removed:
- ----- Method: Spur32BitMemoryManager>>sortedFreeObject: (in category 'free space') -----
- sortedFreeObject: objOop
- "A variant of freeObject: that assumes objOop already has its valid number of slots, etc,
- but makes sure the freeChunkPrevIndex is valid."
- | bytes treeNode nextNode |
- bytes := self bytesInObject: objOop.
- totalFreeOldSpace := totalFreeOldSpace + bytes.
- self longAt: objOop put: 0.
- treeNode := self addToFreeList: objOop bytes: bytes.
- treeNode ~= 0 ifTrue:
- [self storePointer: self freeChunkPrevIndex ofFreeChunk: objOop withValue: treeNode].
- nextNode := self fetchPointer: self freeChunkNextIndex ofObject: objOop.
- nextNode ~= 0 ifTrue:
- [self storePointer: self freeChunkPrevIndex ofFreeChunk: nextNode withValue: objOop]!
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 allocationUnit >= self numFreeLists.
self
storePointer: self freeChunkNextIndex 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.
- storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0;
- storePointer: self freeChunkPrevIndex 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.
childBytes = chunkBytes ifTrue: "size match; add to list at node."
[self storePointer: self freeChunkNextIndex
ofFreeChunk: freeChunk
withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: freeChunk.
^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>>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."
| 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 storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
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 assert: (self isValidFreeObject: 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 storePointer: self freeChunkNextIndex
ofFreeChunk: prev
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
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>>assimilateNewSegment: (in category 'growing/shrinking memory') -----
assimilateNewSegment: segInfo
"Update after adding a segment.
Here we set freeOldSpaceStart & endOfMemory if required."
<var: #segInfo type: #'SpurSegmentInfo *'>
+ segInfo segLimit >= endOfMemory ifTrue:
- segInfo segStart >= endOfMemory ifTrue:
[freeOldSpaceStart :=
endOfMemory := segInfo segLimit - self bridgeSize]!
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: false>
+ | chunkBytes result |
- | chunkBytes index node prev next |
chunkBytes := self bytesInObject: freeChunk.
+ result := self allocateOldSpaceChunkOfExactlyBytes: chunkBytes suchThat: [:f| f = freeChunk].
+ self assert: result = (self startOfObject: freeChunk)!
- totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
- index := chunkBytes / self allocationUnit.
- index >= self numFreeLists ifTrue:
- [^self detachLargeFreeObject: freeChunk].
- node := freeLists at: index.
- freeChunk = node
- ifTrue:
- [(freeLists at: index put: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node)) = 0 ifTrue:
- [self assert: (freeListsMask anyMask: 1 << index).
- 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.
- node = freeChunk ifTrue:
- [prev = 0
- ifTrue: [freeLists at: index put: next]
- ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
- ^node].
- node := next]]!
Item was removed:
- ----- Method: SpurMemoryManager>>detachLargeFreeObject: (in category 'free space') -----
- detachLargeFreeObject: freeChunk
- | prev next |
- prev := self fetchPointer: self freeChunkPrevIndex ofObject: freeChunk.
- next := self fetchPointer: self freeChunkNextIndex ofObject: freeChunk.
- prev = 0
- ifTrue: "freeChunk is a treeNode"
- [next = 0
- ifTrue: "remove it from the tree"
- [self unlinkSolitaryFreeTreeNode: freeChunk]
- ifFalse: "replace freeChunk by its next node."
- [self unlinkFreeTreeNode: freeChunk withSiblings: next]]
- ifFalse: "freeChunk is a list node; simple"
- [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next.
- next ~= 0 ifTrue:
- [self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: prev]]!
Item was removed:
- ----- Method: SpurMemoryManager>>freeChunkPrevIndex (in category 'free space') -----
- freeChunkPrevIndex
- "for quickly unlinking nodes in the tree of large free chunks."
- ^5!
Item was changed:
----- Method: SpurMemoryManager>>setFree: (in category 'free space') -----
setFree: objOop
+ <inline: true>
"turn the object into a free chunk, zeroing classIndex, format, isGrey,isPinned,isRemembered,isImmutable & ?."
self long32At: objOop put: 0!
Item was changed:
----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
totalFreeListBytes
+ "This method both computes the actual number of free bytes by traversing all free objects
+ on the free lists/tree, and checks that the tree is valid. It is used mainly by checkFreeSpace."
| totalFreeBytes bytesInChunk listNode |
totalFreeBytes := 0.
1 to: self numFreeLists - 1 do:
[:i|
bytesInChunk := i * self allocationUnit.
listNode := freeLists at: i.
[listNode ~= 0] whileTrue:
[totalFreeBytes := totalFreeBytes + bytesInChunk.
self assert: (self isValidFreeObject: listNode).
self assert: bytesInChunk = (self bytesInObject: listNode).
listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]].
self freeTreeNodesDo:
[:treeNode|
bytesInChunk := self bytesInObject: treeNode.
self assert: bytesInChunk / self allocationUnit >= self numFreeLists.
listNode := treeNode.
[listNode ~= 0] whileTrue:
["self printFreeChunk: listNode"
self assert: (self isValidFreeObject: listNode).
+ self assert: (listNode = treeNode
+ or: [(self fetchPointer: self freeChunkParentIndex ofFreeChunk: listNode) = 0]).
totalFreeBytes := totalFreeBytes + bytesInChunk.
self assert: bytesInChunk = (self bytesInObject: listNode).
listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode].
treeNode].
^totalFreeBytes!
Item was changed:
----- Method: SpurMemoryManager>>unlinkFreeTreeNode:withSiblings: (in category 'free space') -----
unlinkFreeTreeNode: freeTreeNode withSiblings: next
"Unlink a freeTreeNode. Assumes the node has a list (non-null next link)."
| parent smaller larger |
parent := self fetchPointer: self freeChunkParentIndex ofObject: freeTreeNode.
smaller := self fetchPointer: self freeChunkSmallerIndex ofObject: freeTreeNode.
larger := self fetchPointer: self freeChunkLargerIndex ofObject: freeTreeNode.
- self storePointer: self freeChunkPrevIndex ofFreeChunk: next withValue: 0.
parent = 0
ifTrue: [freeLists at: 0 put: next]
ifFalse:
[self storePointer: (freeTreeNode = (self fetchPointer: self freeChunkSmallerIndex
ofObject: parent)
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: next.
self storePointer: self freeChunkParentIndex ofFreeChunk: next withValue: parent].
self storePointer: self freeChunkSmallerIndex ofFreeChunk: next withValue: smaller.
smaller ~= 0 ifTrue:
[self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: next].
self storePointer: self freeChunkLargerIndex ofFreeChunk: next withValue: larger.
larger ~= 0 ifTrue:
[self storePointer: self freeChunkParentIndex ofFreeChunk: larger withValue: next]!
More information about the Vm-dev
mailing list