[Vm-dev] VM Maker: VMMaker.oscog-eem.408.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Sep 24 22:07:32 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.408.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.408
Author: eem
Time: 24 September 2013, 3:03:59.462 pm
UUID: d156deea-74a3-4c80-8a1c-b7ead517f77f
Ancestors: VMMaker.oscog-eem.407
Implement tree reorganization on removing an interior node of the
free chunk tree. Plus fix the tree traversal which was nonsense.
Add an assert to allocateSlotsInOldSpace:format:classIndex: to check
that totalFreeOldSpace is maintained correctly.
Remember to set the identityHash in the copy when scavenging.
More protocol.
=============== Diff against VMMaker.oscog-eem.407 ===============
Item was changed:
----- Method: BalloonEngineBase>>loadTransformFrom:into:length: (in category 'loading state') -----
loadTransformFrom: transformOop into: destPtr length: n
"Load a transformation from transformOop into the float array
defined by destPtr. The transformation is assumed to be either
an array or a FloatArray of length n."
<inline: false>
<var: #destPtr type:'float *'>
transformOop = interpreterProxy nilObject ifTrue:[^false].
+ (interpreterProxy isImmediate: transformOop)
- (interpreterProxy isIntegerObject: transformOop)
ifTrue:[^interpreterProxy primitiveFail].
(interpreterProxy slotSizeOf: transformOop) = n
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy isWords: transformOop)
ifTrue:[self loadWordTransformFrom: transformOop into: destPtr length: n]
ifFalse:[self loadArrayTransformFrom: transformOop into: destPtr length: n].
^true!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>floatValueOf: (in category 'simulation only') -----
+ floatValueOf: obj
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter floatValueOf: obj!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ "Used by Balloon"
+
+ ^long32 bitAnd: 16rFFFF!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ "Used by Balloon"
+
+ ^long32 bitShift: -16!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>isFloatObject: (in category 'simulation only') -----
+ isFloatObject: oop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter isFloatObject: oop!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>pushFloat: (in category 'simulation only') -----
+ pushFloat: f
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter pushFloat: f!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>stackFloatValue: (in category 'simulation only') -----
+ stackFloatValue: offset
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter stackFloatValue: offset!
Item was changed:
----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex
"Answer the oop of a chunk of space in oldSpace with numSlots slots. The header
will have been filled-in but not the contents."
| bytes chunk |
bytes := self objectBytesForSlots: numSlots.
chunk := self allocateOldSpaceChunkOfBytes: bytes.
+ self assert: totalFreeOldSpace = self totalFreeListBytes.
chunk ifNil:
[^nil].
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self flag: #endianness.
self longAt: chunk put: numSlots.
self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift.
self longLongAt: chunk + self baseHeaderSize
put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
^chunk + self baseHeaderSize].
self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
^chunk!
Item was changed:
----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'scavenger') -----
copyAndForward: survivor
"copyAndForward: survivor copies a survivor object either to
futureSurvivorSpace or, if it is to be promoted, to oldSpace.
It leaves a forwarding pointer behind."
<inline: true>
+ | bytesInObject newLocation hash |
- | bytesInObject newLocation |
bytesInObject := manager bytesInObject: survivor.
newLocation := ((self shouldBeTenured: survivor)
or: [futureSurvivorStart + bytesInObject > futureSpace limit])
ifTrue: [self copyToOldSpace: survivor]
ifFalse: [self copyToFutureSpace: survivor bytes: bytesInObject].
+ hash := manager rawHashBitsOf: survivor.
+ hash ~= 0 ifTrue:
+ [manager setHashBitsOf: newLocation to: hash].
manager forward: survivor to: newLocation.
^newLocation!
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. N.B. the chunk is simply a pointer, it has
no valid header. The caller *must* fill in the header correctly."
| index chunk nextIndex nodeBytes parent child smaller larger |
+ "for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
index := chunkBytes / self allocationUnit.
(index < NumFreeLists and: [1 << index <= freeListsMask]) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: chunk).
^self unlinkFreeChunk: chunk atIndex: index].
"first search for free chunks of a multiple of chunkBytes in size"
nextIndex := index.
[1 << index <= freeListsMask
and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue:
[((freeListsMask anyMask: 1 << index)
and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
[self assert: chunk = (self startOfObject: 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]].
"now get desperate and use the first that'll fit"
nextIndex := index.
[1 << index >= freeListsMask
and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: 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."
- of the same size. Beneath the node are smaller and larger blocks."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
+ [| childBytes |
+ 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 storePointer: self freeChunkNextIndex
+ ofFreeChunk: child
+ withValue: (self fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: chunk).
+ ^self startOfObject: chunk].
+ child := 0]. "break out of loop to remove interior node"
+ childBytes < chunkBytes
+ ifTrue: "walk down the tree"
+ [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
+ ifFalse:
+ [parent := child.
+ nodeBytes := childBytes.
+ child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]].
- [nodeBytes := self bytesInObject: child.
- parent := child.
- nodeBytes = chunkBytes
- ifTrue: "size match; try to remove from list at node."
- [chunk := self fetchPointer: self freeChunkNextIndex
- ofFreeChunk: child.
- chunk ~= 0 ifTrue:
- [self storePointer: self freeChunkNextIndex
- ofFreeChunk: child
- withValue: (self fetchPointer: self freeChunkNextIndex
- ofFreeChunk: chunk).
- ^self startOfObject: chunk].
- child := 0] "break out of loop to remove interior node"
- ifFalse:"walk down the tree"
- [child := self fetchPointer: (nodeBytes > chunkBytes
- ifTrue: [self freeChunkSmallerIndex]
- ifFalse: [self freeChunkLargerIndex])
- ofFreeChunk: child]].
parent = 0 ifTrue:
[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
self halt].
"self printFreeChunk: parent"
+ self assert: nodeBytes >= chunkBytes.
self assert: (self bytesInObject: parent) = nodeBytes.
+
"attempt to remove from list"
chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: parent.
chunk ~= 0 ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: parent
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk].
+
"no list; remove an interior node"
chunk := parent.
+
+ smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
+ larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
+
"no parent; stitch the subnodes back into the root"
parent = 0 ifTrue:
+ [smaller = 0
- [smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
- larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
- smaller = 0
ifTrue: [freeLists at: 0 put: larger]
ifFalse:
[freeLists at: 0 put: smaller.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]].
"coInterpreter transcript ensureCr.
coInterpreter print: 'new free tree root '.
(freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)].
coInterpreter cr."
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk].
+
"remove node from tree; reorder tree simply. two cases (which have mirrors, for four total):
case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | S |
_/_
+ | S |
+
+ case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
- | S |"
- self halt.
- "case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | R |
_/_ _\_ _/_
| L | | R | | L |"
+
+ smaller = 0
+ ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
+ ifTrue: [self freeChunkSmallerIndex]
+ ifFalse: [self freeChunkLargerIndex])
+ ofFreeChunk: parent
+ withValue: larger]
+ ifFalse:
+ [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
+ ifTrue: [self freeChunkSmallerIndex]
+ ifFalse: [self freeChunkLargerIndex])
+ ofFreeChunk: parent
+ withValue: smaller.
+ larger ~= 0 ifTrue:
+ [self addFreeSubTree: larger]].
+ chunkBytes ~= nodeBytes ifTrue:
+ [self freeChunkWithBytes: nodeBytes - chunkBytes
+ at: (self startOfObject: chunk) + chunkBytes].
+ ^self startOfObject: chunk!
- self halt!
Item was changed:
----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') -----
bytesInFreeTree: freeNode
| freeBytes bytesInObject next |
freeNode = 0 ifTrue: [^0].
freeBytes := 0.
bytesInObject := self bytesInObject: freeNode.
self assert: bytesInObject / self allocationUnit >= NumFreeLists.
next := freeNode.
[next ~= 0] whileTrue:
[freeBytes := freeBytes + bytesInObject.
self assert: bytesInObject = (self bytesInObject: next).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next].
^freeBytes
+ + (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeNode))
+ + (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeNode))!
- + (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: next))
- + (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: next))!
Item was changed:
----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') -----
printFreeChunk: freeChunk
<doNotGenerate>
| numBytes |
numBytes := self bytesInObject: freeChunk.
coInterpreter
+ print: 'freeChunk '; printHexPtrnp: freeChunk;
- print: 'freeChunk @ '; printHexPtr: freeChunk;
print: ' bytes '; printNum: numBytes;
+ print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: freeChunk).
- print: ' next '; print: (self fetchPointer: self freeChunkNextIndex
- ofFreeChunk: freeChunk) hex.
numBytes / self allocationUnit > NumFreeLists 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)].
- print: ' ^ '; print: (self fetchPointer: self freeChunkParentIndex
- ofFreeChunk: freeChunk) hex;
- print: ' < '; print: (self fetchPointer: self freeChunkSmallerIndex
- ofFreeChunk: freeChunk) hex;
- print: ' > '; print: (self fetchPointer: self freeChunkLargerIndex
- ofFreeChunk: freeChunk) hex].
coInterpreter cr!
Item was changed:
----- Method: StackInterpreter>>printHexPtr: (in category 'debug printing') -----
printHexPtr: p
+ "Print p in hex, padded to 10 characters in the form ' 0x1234'"
- "Print p in hex, passed to 10 characters in the form ' 0x1234'"
<inline: true>
<var: #p type: #'void *'>
self printHex: (self oopForPointer: p)!
Item was added:
+ ----- Method: StackInterpreter>>printHexPtrnp: (in category 'debug printing') -----
+ printHexPtrnp: p
+ "Print p in hex, unpadded, in the form '0x1234'"
+ <inline: true>
+ <var: #p type: #'void *'>
+ self printHexnp: (self oopForPointer: p)!
More information about the Vm-dev
mailing list