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)!
vm-dev@lists.squeakfoundation.org