[Vm-dev] VM Maker: VMMaker.oscog-eem.409.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Sep 25 00:17:15 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.409.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.409
Author: eem
Time: 24 September 2013, 5:13:52.723 pm
UUID: 00fb78b3-11aa-450f-ba56-3eb8c3f9f082
Ancestors: VMMaker.oscog-eem.408
Fix wrong index bugs in allocateOldSpaceChunkOfBytes:.
Implement removing interior nodes from the free tree there-in.
Bootstrap of startreader image now hits assert failure when trying
to free an 8-byte sliver, instead of corrupting the free space lists.
Refactor the oldSpace allocation chain to avoid duplications of
bytesInObject: and/or objectBytesForSlots: calculations.
Abstract out free space check to its own method.
Add (more) asserts to some free space routines.
=============== Diff against VMMaker.oscog-eem.408 ===============
Item was changed:
----- Method: InterpreterPrimitives>>primitiveNewWithArg (in category 'object access primitives') -----
primitiveNewWithArg
"Allocate a new indexable instance. Fail if the allocation would leave less than lowSpaceThreshold bytes free. May cause a GC."
| size spaceOkay |
size := self positive32BitValueOf: self stackTop.
+ self cppIf: NewspeakVM
+ ifTrue: "For the mirror prims check that the class obj is actually a valid class."
+ [(argumentCount < 2
+ or: [self addressCouldBeClassObj: (self stackValue: 1)]) ifFalse:
+ [self primitiveFailFor: PrimErrBadArgument]].
(self successful and: [size >= 0])
ifTrue:
[objectMemory hasSpurMemoryManagerAPI
ifTrue:
[(objectMemory instantiateClass: (self stackValue: 1) indexableSize: size)
ifNotNil: [:obj| self pop: argumentCount + 1 thenPush: obj]
ifNil: [self primitiveFailFor: PrimErrNoMemory]]
ifFalse:
[spaceOkay := objectMemory sufficientSpaceToInstantiate: (self stackValue: 1) indexableSize: size.
spaceOkay
ifTrue:
[self
pop: argumentCount + 1
thenPush: (objectMemory instantiateClass: (self stackValue: 1) indexableSize: size)]
ifFalse:
[self primitiveFailFor: PrimErrNoMemory]]]
ifFalse:
[self primitiveFailFor: PrimErrBadArgument]!
Item was changed:
----- Method: Spur32BitMMLESimulator>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a32BitValue
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ "(byteAddress = 16r1614CB8 and: [a32BitValue = 16rA000035]) ifTrue:
- "(byteAddress = 16r11D8240 and: [a32BitValue = 16r1D8368]) ifTrue:
[self halt]."
byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
^memory at: byteAddress // 4 + 1 put: a32BitValue!
Item was changed:
----- Method: Spur32BitMMLESimulator>>longLongAt:put: (in category 'memory access') -----
longLongAt: byteAddress put: a64BitValue
- "memory is a Bitmap, a 32-bit indexable array of bits"
byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ self
+ longAt: byteAddress put: (a64BitValue bitAnd: 16rffffffff);
+ longAt: byteAddress + 4 put: a64BitValue >> 32.
- "(byteAddress = 16r11D8240 and: [(a64BitValue bitAnd: 16rffffffff) = 16r1D8368]) ifTrue:
- [self halt]."
- memory
- at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff);
- at: byteAddress // 4 + 2 put: a64BitValue >> 32.
^a64BitValue!
Item was changed:
----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
allocateSlots: numSlots format: formatField classIndex: classIndex
| numBytes newObj |
"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
16 bytes otherwise (num slots in preceeding word).
Objects always have at least one slot, for the forwarding pointer,
and are multiples of 8 bytes in length."
numSlots >= self numSlotsMask
ifTrue:
[newObj := freeStart + self baseHeaderSize.
numBytes := self baseHeaderSize + self baseHeaderSize "double header"
+ (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit"
ifFalse:
[newObj := freeStart.
numBytes := self baseHeaderSize "single header"
+ (numSlots <= 1
ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit"
freeStart + numBytes > scavengeThreshold ifTrue:
[needGCFlag ifFalse: [self scheduleScavenge].
freeStart + numBytes > scavenger eden limit ifTrue:
+ [^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]].
- [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]].
numSlots >= self numSlotsMask
ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self flag: #endianness.
self longAt: freeStart put: numSlots.
self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
ifFalse:
[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
self assert: numBytes \\ self allocationUnit = 0.
self assert: newObj \\ self allocationUnit = 0.
freeStart := freeStart + numBytes.
^newObj!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
+ allocateSlotsInOldSpace: numSlots bytes: totalBytes 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."
+ | chunk |
+ chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
+ self checkFreeSpace.
+ 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 removed:
- ----- 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: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
instantiateClass: classObj indexableSize: nElements
| instSpec classFormat numSlots classIndex newObj fillValue |
classFormat := self formatOfClass: classObj.
instSpec := self instSpecOfClassFormat: classFormat.
fillValue := 0.
instSpec caseOf: {
[self arrayFormat] ->
[numSlots := nElements.
fillValue := nilObj].
[self indexablePointersFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self weakArrayFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self sixtyFourBitIndexableFormat] ->
[numSlots := nElements * 2].
[self firstLongFormat] ->
[numSlots := nElements].
[self firstShortFormat] ->
[numSlots := nElements + 1 // 2.
instSpec := instSpec + (nElements bitAnd: 1)].
[self firstByteFormat] ->
[numSlots := nElements + 3 // 4.
instSpec := instSpec + (4 - nElements bitAnd: 3)].
[self firstCompiledMethodFormat] ->
[numSlots := nElements + 3 // 4.
instSpec := instSpec + (4 - nElements bitAnd: 3)] }
+ otherwise: ["some Squeak images include funky fixed subclasses of abstract variable
+ superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection.
+ Allow fixed classes to be instantiated here iff nElements = 0."
+ numSlots := self fixedFieldsOfClassFormat: classFormat.
+ nElements ~= 0 ifTrue:
+ [^nil]]. "non-indexable"
- otherwise: [^nil]. "non-indexable"
classIndex := self ensureBehaviorHash: classObj.
classIndex < 0 ifTrue:
[coInterpreter primitiveFailFor: classIndex negated.
^nil].
newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
newObj ifNotNil:
[self fillObj: newObj numSlots: numSlots with: fillValue].
^newObj!
Item was changed:
----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
allocateSlots: numSlots format: formatField classIndex: classIndex
| numBytes newObj |
"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
16 bytes otherwise (num slots in preceeding word).
Objects always have at least one slot, for the forwarding pointer,
and are multiples of 8 bytes in length."
numSlots >= self numSlotsMask
ifTrue:
[numSlots > 16rffffffff ifTrue:
[^nil].
newObj := freeStart + self baseHeaderSize.
numBytes := (self baseHeaderSize + self baseHeaderSize) "double header"
+ (numSlots * self bytesPerSlot)]
ifFalse:
[newObj := freeStart.
numBytes := self baseHeaderSize "single header"
+ (numSlots < 1
ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
ifFalse: [numSlots * self bytesPerSlot])].
freeStart + numBytes > scavengeThreshold ifTrue:
[needGCFlag ifFalse: [self scheduleScavenge].
freeStart + numBytes > scavenger eden limit ifTrue:
+ [^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]].
- [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]].
numSlots >= self numSlotsMask
ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self flag: #endianness.
self longAt: freeStart put: numSlots.
self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
ifFalse:
[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
self assert: numBytes \\ self allocationUnit = 0.
self assert: newObj \\ self allocationUnit = 0.
freeStart := freeStart + numBytes.
^newObj!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
+ allocateSlotsInOldSpace: numSlots bytes: totalBytes 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."
+ | chunk |
+ chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
+ chunk ifNil:
+ [^nil].
+ numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
+ [self longAt: chunk
+ put: numSlots + (self numSlotsMask << self numSlotsFullShift).
+ self longAt: chunk + self baseHeaderSize
+ put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
+ ^chunk + self baseHeaderSize].
+ self longAt: chunk
+ put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
+ ^chunk!
Item was removed:
- ----- Method: Spur64BitMemoryManager>>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.
- chunk ifNil:
- [^nil].
- numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
- [self longAt: chunk
- put: numSlots + (self numSlotsMask << self numSlotsFullShift).
- self longAt: chunk + self baseHeaderSize
- put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
- ^chunk + self baseHeaderSize].
- self longAt: chunk
- put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
- ^chunk!
Item was removed:
- ----- Method: SpurMemoryManager>>addToFreeList: (in category 'free space') -----
- addToFreeList: freeChunk
- | chunkBytes childBytes parent child index |
- "coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk."
- chunkBytes := self bytesInObject: freeChunk.
- index := chunkBytes / self allocationUnit.
- index < NumFreeLists ifTrue:
- [self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index).
- freeLists at: index put: freeChunk.
- freeListsMask := freeListsMask bitOr: 1 << index.
- ^self].
- freeListsMask := freeListsMask bitOr: 1.
- 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.
- "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.
- ^self].
- "walk down the tree"
- parent := child.
- child := self fetchPointer: (childBytes > chunkBytes
- ifTrue: [self freeChunkSmallerIndex]
- ifFalse: [self freeChunkLargerIndex])
- ofObject: child].
- parent = 0 ifTrue:
- [self assert: (freeLists at: 0) = 0.
- freeLists at: 0 put: freeChunk.
- ^self].
- "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!
Item was added:
+ ----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') -----
+ addToFreeList: freeChunk bytes: chunkBytes
+ | childBytes parent child index |
+ "coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk."
+ self assert: (self isFreeObject: freeChunk).
+ self assert: chunkBytes = (self bytesInObject: freeChunk).
+ index := chunkBytes / self allocationUnit.
+ index < NumFreeLists ifTrue:
+ [self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index).
+ freeLists at: index put: freeChunk.
+ freeListsMask := freeListsMask bitOr: 1 << index.
+ ^self].
+ freeListsMask := freeListsMask bitOr: 1.
+ 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.
+ "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.
+ ^self].
+ "walk down the tree"
+ parent := child.
+ child := self fetchPointer: (childBytes > chunkBytes
+ ifTrue: [self freeChunkSmallerIndex]
+ ifFalse: [self freeChunkLargerIndex])
+ ofObject: child].
+ parent = 0 ifTrue:
+ [self assert: (freeLists at: 0) = 0.
+ freeLists at: 0 put: freeChunk.
+ ^self].
+ "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!
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."
+ | initialIndex chunk index nodeBytes parent child smaller larger |
- | index chunk nextIndex nodeBytes parent child smaller larger |
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
+ initialIndex := chunkBytes / self allocationUnit.
+ (initialIndex < NumFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
+ [(chunk := freeLists at: initialIndex) ~= 0 ifTrue:
- 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: initialIndex].
+ freeListsMask := freeListsMask - (1 << initialIndex).
- ^self unlinkFreeChunk: chunk atIndex: index].
"first search for free chunks of a multiple of chunkBytes in size"
+ index := initialIndex.
+ [(index := index + index) < NumFreeLists
+ and: [1 << index <= freeListsMask]] whileTrue:
- 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 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"
+ index := initialIndex.
+ [(index := index + 1) < NumFreeLists
+ and: [1 << index <= freeListsMask]] whileTrue:
- 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 assert: (self bytesInObject: chunk) = index * self allocationUnit.
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: chunk) + chunkBytes.
^chunk].
freeListsMask := freeListsMask - (1 << index)]]].
"Large chunk, or no space on small free lists. Search the large chunk list.
Large chunk list organized as a tree, each node of which is a list of chunks
of the same size. Beneath the node are smaller and larger blocks.
When the search ends parent should hold the smallest chunk at least as
large as chunkBytes, or 0 if none."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[| childBytes |
+ self assert: (self isFreeObject: 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 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]].
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; reorder tree simply. two cases (which have mirrors, for four total):
- "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
- 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.
add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | R |
_/_ _\_ _/_
| L | | R | | L |"
+ chunk := parent.
+ smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
+ larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
+ parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
+ parent = 0
+ ifTrue: "no parent; stitch the subnodes back into the root"
+ [smaller = 0
+ ifTrue: [freeLists at: 0 put: larger]
+ ifFalse:
+ [freeLists at: 0 put: smaller.
+ larger ~= 0 ifTrue:
+ [self addFreeSubTree: larger]]]
+ ifFalse: "parent; stitch back into appropriate side of parent."
+ [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]]].
+ "if there's space left over, add the fragment back."
- 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!
Item was changed:
----- Method: SpurMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex
+ <inline: true>
+ ^self
+ allocateSlotsInOldSpace: numSlots
+ bytes: (self objectBytesForSlots: numSlots)
+ format: formatField
+ classIndex: classIndex!
- self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') -----
bytesInFreeTree: freeNode
+ | freeBytes bytesInObject listNode |
- | freeBytes bytesInObject next |
freeNode = 0 ifTrue: [^0].
freeBytes := 0.
bytesInObject := self bytesInObject: freeNode.
self assert: bytesInObject / self allocationUnit >= NumFreeLists.
+ self assert: (self isFreeObject: freeNode).
+ listNode := freeNode.
+ [listNode ~= 0] whileTrue:
- next := freeNode.
- [next ~= 0] whileTrue:
[freeBytes := freeBytes + bytesInObject.
+ self assert: bytesInObject = (self bytesInObject: listNode).
+ listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode].
- 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))!
Item was added:
+ ----- Method: SpurMemoryManager>>checkFreeSpace (in category 'debug support') -----
+ checkFreeSpace
+ self assert: totalFreeOldSpace = self totalFreeListBytes!
Item was changed:
----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') -----
freeChunkWithBytes: bytes at: address
<inline: true>
| freeChunk |
freeChunk := self initFreeChunkWithBytes: bytes at: address.
+ self addToFreeList: freeChunk bytes: bytes.
- self addToFreeList: freeChunk.
^freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') -----
initializeOldSpaceFirstFree: startOfFreeOldSpace
<var: 'startOfFreeOldSpace' type: #usqLong>
| freeOldStart freeChunk |
<var: 'freeOldStart' type: #usqLong>
endOfMemory > startOfFreeOldSpace ifTrue:
[totalFreeOldSpace := totalFreeOldSpace + (endOfMemory - startOfFreeOldSpace).
freeOldStart := startOfFreeOldSpace.
[endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue:
[freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart.
freeOldStart := freeOldStart + (2 raisedTo: 32).
self assert: freeOldStart = (self addressAfter: freeChunk)].
freeOldStart < endOfMemory ifTrue:
[freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart.
self assert: (self addressAfter: freeChunk) = endOfMemory]].
freeOldSpaceStart := endOfMemory.
+ self checkFreeSpace!
- self assert: totalFreeOldSpace = self totalFreeListBytes!
Item was changed:
----- Method: SpurMemoryManager>>scavengingGC (in category 'generation scavenging') -----
scavengingGC
"Run the scavenger."
self assert: remapBufferCount = 0.
+ self checkFreeSpace.
- self assert: self totalFreeListBytes = totalFreeOldSpace.
"coInterpreter printCallStackFP: coInterpreter framePointer"
self runLeakCheckerForFullGC: false.
coInterpreter preGCAction: GCModeIncr.
needGCFlag := false.
gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
scavengeInProgress := true.
pastSpaceStart := scavenger scavenge.
self assert: (self
oop: pastSpaceStart
isGreaterThanOrEqualTo: scavenger pastSpace start
andLessThanOrEqualTo: scavenger pastSpace limit).
freeStart := scavenger eden start.
self initSpaceForAllocationCheck: scavenger eden.
scavengeInProgress := false.
statScavenges := statScavenges + 1.
statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
coInterpreter postGCAction.
self runLeakCheckerForFullGC: false.
+ self checkFreeSpace!
- self assert: self totalFreeListBytes = totalFreeOldSpace!
Item was added:
+ ----- Method: SpurMemoryManager>>statScavenges (in category 'accessing') -----
+ statScavenges
+ ^statScavenges!
Item was changed:
----- Method: SpurMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') -----
storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer
self assert: (self isFreeObject: objOop).
+ self assert: (valuePointer = 0 or: [self isFreeObject: objOop]).
^self
longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
put: valuePointer!
Item was changed:
----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
totalFreeListBytes
| freeBytes bytesInObject obj |
freeBytes := 0.
1 to: NumFreeLists - 1 do:
[:i|
bytesInObject := i * self allocationUnit.
obj := freeLists at: i.
[obj ~= 0] whileTrue:
[freeBytes := freeBytes + bytesInObject.
self assert: bytesInObject = (self bytesInObject: obj).
+ self assert: (self isFreeObject: obj).
obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]].
^freeBytes + (self bytesInFreeTree: (freeLists at: 0))!
Item was changed:
----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex: (in category 'free space') -----
unlinkFreeChunk: chunk atIndex: index
<inline: true>
+ self assert: ((self bytesInObject: chunk) = (index * self allocationUnit)
- self assert: ((self bytesInObject: chunk) = index * self allocationUnit
and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit"]).
freeLists
at: index
put: (self
fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
^chunk!
More information about the Vm-dev
mailing list