[Vm-dev] VM Maker: VMMaker.oscog-eem.509.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Nov 13 00:51:07 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.509.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.509
Author: eem
Time: 12 November 2013, 4:47:46.161 pm
UUID: 1f030e9c-8603-4588-8ad9-b3a935699fae
Ancestors: VMMaker.oscog-eem.508
Fix the bootstrap now that sufficientSPaceAfterGC: will grow.
Change (we hope) all oop comparisons into self oop: o isFoo: l
forms.
Comment typo.
=============== Diff against VMMaker.oscog-eem.508 ===============
Item was changed:
----- Method: Spur32BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') -----
fillObj: objOop numSlots: numSlots with: fillValue
<inline: true>
+ self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1
+ isLessThan: (self addressAfter: objOop)).
- self assert: (objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1)
- < (self addressAfter: objOop).
objOop + self baseHeaderSize
to: objOop + self baseHeaderSize + (numSlots * self wordSize) - 1
by: self allocationUnit
do: [:p|
self longAt: p put: fillValue;
longAt: p + 4 put: fillValue]!
Item was changed:
----- Method: Spur32BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') -----
objectAfter: objOop limit: limit
"Object parsing.
1. all objects have at least a word following the header, for a forwarding pointer.
2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word
following an object doesn't have a saturated numSlots field it must be a single-header object.
If the word following does have a saturated numSlots it must be the overflow size word."
| followingWordAddress followingWord |
followingWordAddress := self addressAfter: objOop.
+ (self oop: followingWordAddress isGreaterThanOrEqualTo: limit) ifTrue:
- followingWordAddress >= limit ifTrue:
[^limit].
self flag: #endianness.
followingWord := self longAt: followingWordAddress + 4.
^followingWord >> self numSlotsHalfShift = self numSlotsMask
ifTrue: [followingWordAddress + self baseHeaderSize]
ifFalse: [followingWordAddress]!
Item was changed:
----- Method: Spur64BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') -----
fillObj: objOop numSlots: numSlots with: fillValue
<inline: true>
+ self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1
+ isLessThan: (self addressAfter: objOop)).
- self assert: (objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1)
- < (self addressAfter: objOop).
objOop + self baseHeaderSize
to: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1
by: self allocationUnit
do: [:p| self longAt: p put: fillValue]!
Item was changed:
----- Method: Spur64BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') -----
objectAfter: objOop limit: limit
"Object parsing.
1. all objects have at least a word following the header, for a forwarding pointer.
2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word
following an object doesn't have a saturated numSlots field it must be a single-header object.
If the word following does have a saturated numSlots it must be the overflow size word."
| followingWordAddress followingWord |
followingWordAddress := self addressAfter: objOop.
+ (self oop: followingWordAddress isGreaterThanOrEqualTo: limit) ifTrue:
- followingWordAddress >= limit ifTrue:
[^limit].
self flag: #endianness.
followingWord := self longAt: followingWordAddress.
^followingWord >> self numSlotsFullShift = self numSlotsMask
ifTrue: [followingWordAddress + self baseHeaderSize]
ifFalse: [followingWordAddress]!
Item was changed:
----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceLimit pastSpaceStart
+ lowSpaceThreshold freeOldSpaceStart startOfMemory endOfMemory sortedFreeChunks)
- lowSpaceThreshold freeOldSpaceStart endOfMemory sortedFreeChunks)
in: aCCodeGenerator.
self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
in: aCCodeGenerator.
aCCodeGenerator
var: #freeListsMask type: #usqInt;
var: #freeLists type: #'sqInt *';
var: #classTableBitmap type: #'unsigned char *';
var: #highestObjects type: #SpurCircularBuffer;
var: #unscannedEphemerons type: #SpurContiguousObjStack.
aCCodeGenerator
var: #remapBuffer
declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
aCCodeGenerator
var: #extraRoots
declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.!
Item was changed:
----- Method: SpurMemoryManager>>allExistingNewSpaceObjectsDo: (in category 'object enumeration') -----
allExistingNewSpaceObjectsDo: aBlock
<inline: true>
| prevObj prevPrevObj objOop limit |
prevPrevObj := prevObj := nil.
"After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are
in pastSpace. Objects are allocated in eden. So enumerate only eden and pastSpace."
objOop := self objectStartingAt: scavenger eden start.
limit := freeStart.
+ [self oop: objOop isLessThan: limit] whileTrue:
- [objOop < limit] whileTrue:
[(self isEnumerableObject: objOop) ifTrue:
[aBlock value: objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: freeStart].
objOop := self objectStartingAt: scavenger pastSpace start.
limit := pastSpaceStart.
+ [self oop: objOop isLessThan: limit] whileTrue:
- [objOop < limit] whileTrue:
[(self isFreeObject: objOop) ifFalse:
[aBlock value: objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: limit].
self touch: prevPrevObj.
self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>allExistingOldSpaceObjectsDo: (in category 'object enumeration') -----
allExistingOldSpaceObjectsDo: aBlock
"Enumerate all old space objects, excluding any objects created
during the execution of allExistingOldSpaceObjectsDo:."
<inline: true>
| oldSpaceLimit prevObj prevPrevObj objOop |
prevPrevObj := prevObj := nil.
objOop := self firstObject.
oldSpaceLimit := freeOldSpaceStart.
[self assert: objOop \\ self allocationUnit = 0.
+ self oop: objOop isLessThan: oldSpaceLimit] whileTrue:
- objOop < oldSpaceLimit] whileTrue:
[self assert: (self longLongAt: objOop) ~= 0.
(self isEnumerableObject: objOop) ifTrue:
[aBlock value: objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: freeOldSpaceStart].
self touch: prevPrevObj.
self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>allNewSpaceEntitiesDo: (in category 'object enumeration') -----
allNewSpaceEntitiesDo: aBlock
"Enumerate all new space objects, including free objects."
<inline: true>
| prevObj prevPrevObj objOop limit |
prevPrevObj := prevObj := nil.
"After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are
in pastSpace. Objects are allocated in eden. So enumerate only eden and pastSpace."
objOop := self objectStartingAt: scavenger eden start.
+ [self oop: objOop isLessThan: freeStart] whileTrue:
- [objOop < freeStart] whileTrue:
[aBlock value: objOop.
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: freeStart].
objOop := self objectStartingAt: scavenger pastSpace start.
limit := pastSpaceStart.
+ [self oop: objOop isLessThan: limit] whileTrue:
- [objOop < limit] whileTrue:
[aBlock value: objOop.
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: limit].
self touch: prevPrevObj.
self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCoalescingDo: (in category 'object enumeration') -----
allOldSpaceEntitiesForCoalescingDo: aBlock
<inline: true>
| prevObj prevPrevObj objOop rawNumSlots rawNumSlotsAfter |
prevPrevObj := prevObj := nil.
objOop := self firstObject.
[self assert: objOop \\ self allocationUnit = 0.
+ self oop: objOop isLessThan: freeOldSpaceStart] whileTrue:
- objOop < freeOldSpaceStart] whileTrue:
[self assert: (self longLongAt: objOop) ~= 0.
rawNumSlots := self rawNumSlotsOf: objOop.
aBlock value: objOop.
"If the number of slot changes coalescing changed an object from a single to a double header."
rawNumSlotsAfter := self rawNumSlotsOf: objOop.
(rawNumSlotsAfter ~= rawNumSlots
and: [rawNumSlotsAfter = self numSlotsMask]) ifTrue:
[objOop := objOop + self baseHeaderSize.
self assert: (self objectAfter: prevObj limit: freeOldSpaceStart) = objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: freeOldSpaceStart].
self touch: prevPrevObj.
self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>allOldSpaceEntitiesFrom:do: (in category 'object enumeration') -----
allOldSpaceEntitiesFrom: initialObject do: aBlock
<inline: true>
| prevObj prevPrevObj objOop |
prevPrevObj := prevObj := nil.
objOop := initialObject.
[self assert: objOop \\ self allocationUnit = 0.
+ self oop: objOop isLessThan: freeOldSpaceStart] whileTrue:
- objOop < freeOldSpaceStart] whileTrue:
[self assert: (self longLongAt: objOop) ~= 0.
aBlock value: objOop.
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: freeOldSpaceStart].
self touch: prevPrevObj.
self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>checkHeapIntegrity: (in category 'debug support') -----
checkHeapIntegrity: excludeUnmarkedNewSpaceObjs
"Perform an integrity/leak check using the heapMap. Assume
clearLeakMapAndMapAccessibleObjects has set a bit at each
object's header. Scan all objects in the heap checking that every
pointer points to a header. Scan the rootTable, remapBuffer and
extraRootTable checking that every entry is a pointer to a header.
Check that the number of roots is correct and that all rootTable
entries have their rootBit set. Answer if all checks pass."
| ok numRememberedRootsInHeap |
<inline: false>
ok := true.
numRememberedRootsInHeap := 0.
self allHeapEntitiesDo:
[:obj| | containsYoung fieldOop classIndex classOop |
((self isFreeObject: obj)
or: [(self isYoung: obj) and: [(self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]]]) ifFalse:
[containsYoung := false.
(self isRemembered: obj) ifTrue:
[numRememberedRootsInHeap := numRememberedRootsInHeap + 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 isYoung: fieldOop) ifTrue:
[containsYoung := true]]
ifFalse:
[classOop := self classAtIndex: (classIndex := self classIndexOf: obj).
((classOop isNil or: [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].
self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do:
[:ptr|
fieldOop := self longAt: obj + ptr.
(self isNonImmediate: fieldOop) ifTrue:
[| fi |
fi := ptr - self baseHeaderSize / self wordSize.
(fieldOop bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
self eek.
ok := false]
ifFalse:
[(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].
"don't be misled by CogMethods; they appear to be young, but they're not"
+ ((self isYoung: fieldOop)
+ and: [self oop: fieldOop isGreaterThanOrEqualTo: startOfMemory]) ifTrue:
- ((self isYoung: fieldOop) and: [fieldOop >= startOfMemory]) ifTrue:
[containsYoung := true]]]]].
(containsYoung and: [(self isYoung: obj) not]) ifTrue:
[(self isRemembered: obj) ifFalse:
[coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
self eek.
ok := false]]]].
numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
[coInterpreter
print: 'root count mismatch. #heap roots ';
printNum: numRememberedRootsInHeap;
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]]]].
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>>checkOkayOop: (in category 'debug support') -----
checkOkayOop: oop
"Verify that the given oop is legitimate. Check address, header, and size but not class.
Answer true if OK. Otherwise print reason and answer false."
<api>
<var: #oop type: #usqInt>
| classIndex fmt unusedBits unusedBitsInYoungObjects |
<var: #unusedBits type: #usqLong>
"address and size checks"
(self isImmediate: oop) ifTrue: [^true].
(self addressCouldBeObjWhileScavenging: oop) ifFalse:
[self print: 'oop '; printHex: oop; print: ' is not a valid address'. ^false].
+ (self oop: (self addressAfter: oop) isLessThanOrEqualTo: freeOldSpaceStart) ifFalse:
- (self addressAfter: oop) <= freeOldSpaceStart ifFalse:
[self print: 'oop '; printHex: oop; print: ' size would make it extend beyond the end of memory'. ^false].
"header type checks"
(classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse:
[self print: 'oop '; printHex: oop; print: ' is a free chunk, or bridge, not an object'. ^false].
((self rawNumSlotsOf: oop) = self numSlotsMask
and: [(self rawNumSlotsOf: oop - self baseHeaderSize) ~= self numSlotsMask]) ifTrue:
[self print: 'oop '; printHex: oop; print: ' header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false].
"format check"
fmt := self formatOf: oop.
(fmt = 6) | (fmt = 8) ifTrue:
[self print: 'oop '; printHex: oop; print: ' has an unknown format type'. ^false].
(fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue:
[self print: 'oop '; printHex: oop; print: ' has mis-matched format/classIndex fields; only one of them is the isForwarded value'. ^false].
"specific header bit checks"
unusedBits := (1 << self classIndexFieldWidth)
| (1 << (self identityHashFieldWidth + 32)).
((self longLongAt: oop) bitAnd: unusedBits) ~= 0 ifTrue:
[self print: 'oop '; printHex: oop; print: ' has some unused header bits set; should be zero'. ^false].
unusedBitsInYoungObjects := self newSpaceRefCountMask.
((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue:
[self print: 'oop '; printHex: oop; print: ' has some header bits unused in young objects set; should be zero'. ^false].
^true!
Item was changed:
----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') -----
exactFitCompact
"Compact all of memory above firstFreeChunk using exact-fit, assuming free
space is sorted and that as many of the the highest objects as will fit are
recorded in highestObjects. Don't move pinned objects.
Note that we don't actually move; we merely copy and forward. Eliminating
forwarders will be done in a final pass. Leave the objects that don't fit
exactly (the misfits), and hence aren't moved, in highestObjects."
<inline: false>
| misfits first nfits nmiss nHighest nMisses savedLimit |
<var: #misfits type: #usqInt>
self checkFreeSpace.
totalFreeOldSpace = 0 ifTrue: [^self].
highestObjects isEmpty ifTrue:
[^self].
nfits := nmiss := 0.
misfits := highestObjects last + self wordSize.
[statCompactPassCount := statCompactPassCount + 1.
highestObjects from: misfits - self wordSize reverseDo:
[:o| | b |
+ self assert: (self oop: o isGreaterThan: firstFreeChunk).
- self assert: o > firstFreeChunk.
((self isForwarded: o) or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
(self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
ifNil:
[nmiss := nmiss + 1.
misfits := misfits - self wordSize.
misfits < highestObjects start ifTrue:
[misfits := highestObjects limit - self wordSize].
self longAt: misfits put: o]
ifNotNil:
[:f|
nfits := nfits + 1.
self copyAndForward: o withBytes: b toFreeChunk: f]]].
self checkFreeSpace.
"now highestObjects contains only misfits, if any, from misfits to last.
set first to first failure and refill buffer. next cycle will add more misfits.
give up on exact-fit when half of the highest objects fail to fit."
first := self longAt: highestObjects first.
+ self assert: (self oop: first isGreaterThan: firstFreeChunk).
- self assert: first > firstFreeChunk.
nHighest := highestObjects usedSize.
highestObjects first: misfits.
nMisses := highestObjects usedSize.
nMisses > (nHighest // 2) ifTrue:
[coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr.
^self].
self findFirstFreeChunkPostCompactionPass.
savedLimit := self moveMisfitsToTopOfHighestObjects: misfits.
self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first.
misfits := self moveMisfitsInHighestObjectsBack: savedLimit.
highestObjects usedSize > 0] whileTrue!
Item was changed:
----- Method: SpurMemoryManager>>fillHighestObjectsWithMovableObjectsFrom:upTo: (in category 'compaction') -----
fillHighestObjectsWithMovableObjectsFrom: startObj upTo: limitObj
"Refill highestObjects with movable objects up to, but not including limitObj.
c.f. the loop in freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace."
| lastHighest highestObjectsWraps |
highestObjects resetAsEmpty.
lastHighest := highestObjects last.
highestObjectsWraps := 0.
self allOldSpaceObjectsFrom: startObj do:
[:o|
+ (self oop: o isGreaterThanOrEqualTo: limitObj) ifTrue:
- o >= limitObj ifTrue:
[highestObjects last: lastHighest.
^self].
((self isForwarded: o) or: [self isPinned: o]) ifFalse:
[false "conceptually...: "
ifTrue: [highestObjects addLast: o]
ifFalse: "but we inline so we can use the local lastHighest"
[(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
[highestObjectsWraps := highestObjectsWraps + 1].
self longAt: lastHighest put: o]]].
highestObjects last: lastHighest!
Item was changed:
----- Method: SpurMemoryManager>>firstFitCompact (in category 'compaction') -----
firstFitCompact
"Compact all of memory above firstFreeChunk using first-fit, assuming free
space is sorted and that as many of the the highest objects as will fit are
recorded in highestObjects. Don't move pinned objects.
Note that we don't actually move; we merely copy and forward. Eliminating
forwarders will be done in a final pass."
<inline: false>
| first nhits nmisses |
self checkFreeSpace.
totalFreeOldSpace = 0 ifTrue: [^self].
highestObjects isEmpty ifTrue:
[^self].
nhits := nmisses := 0.
[statCompactPassCount := statCompactPassCount + 1.
highestObjects reverseDo:
[:o| | b |
+ (self oop: o isLessThanOrEqualTo: firstFreeChunk) ifTrue:
- o <= firstFreeChunk ifTrue:
[coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr.
^self].
((self isForwarded: o) or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
(self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o])
ifNil:
[nmisses := nmisses + 1]
ifNotNil:
[:f|
nhits := nhits + 1.
self copyAndForward: o withBytes: b toFreeChunk: f.
self assert: (lastSubdividedFreeChunk = 0
or: [(self addressAfter: (self objectStartingAt: f)) = lastSubdividedFreeChunk])]]].
self checkFreeSpace.
first := self longAt: highestObjects first.
+ self assert: (self oop: first isGreaterThan: firstFreeChunk).
- self assert: first > firstFreeChunk.
self findFirstFreeChunkPostCompactionPass.
self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first.
highestObjects usedSize > 0] whileTrue.
coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr!
Item was changed:
----- Method: SpurMemoryManager>>instanceAfter: (in category 'object enumeration') -----
instanceAfter: objOop
| actualObj classIndex |
actualObj := objOop.
classIndex := self classIndexOf: objOop.
(self isInEden: objOop) ifTrue:
[[actualObj := self objectAfter: actualObj limit: freeStart.
+ self oop: actualObj isLessThan: freeStart] whileTrue:
- actualObj < freeStart] whileTrue:
[classIndex = (self classIndexOf: actualObj) ifTrue:
[^actualObj]].
+ actualObj := (self oop: pastSpaceStart isGreaterThan: scavenger pastSpace start)
- actualObj := pastSpaceStart > scavenger pastSpace start
ifTrue: [self objectStartingAt: scavenger pastSpace start]
ifFalse: [nilObj]].
(self isInSurvivorSpace: actualObj) ifTrue:
[[actualObj := self objectAfter: actualObj limit: pastSpaceStart.
+ self oop: actualObj isLessThan: pastSpaceStart] whileTrue:
- actualObj < pastSpaceStart] whileTrue:
[classIndex = (self classIndexOf: actualObj) ifTrue:
[^actualObj]].
actualObj := nilObj].
[actualObj := self objectAfter: actualObj limit: freeOldSpaceStart.
+ self oop:actualObj isLessThan: freeOldSpaceStart] whileTrue:
- actualObj < freeOldSpaceStart] whileTrue:
[classIndex = (self classIndexOf: actualObj) ifTrue:
[^actualObj]].
^nil!
Item was changed:
----- Method: SpurMemoryManager>>isInNewSpace: (in category 'object testing') -----
isInNewSpace: objOop
+ ^(self oop: objOop isLessThan: newSpaceLimit)
+ and: [self oop: objOop isGreaterThanOrEqualTo: startOfMemory]!
- ^objOop >= startOfMemory
- and: [objOop < newSpaceLimit]!
Item was changed:
----- Method: SpurMemoryManager>>markAndTraceHiddenRoots (in category 'gc - global') -----
markAndTraceHiddenRoots
"The hidden roots hold both the class table pages and the obj stacks,
and hence need special treatment.
The obj stacks must be marked specially; their pages must be marked,
but only the contents of the ephemeronQueue should be marked.
If a class table page is weak we can mark and trace the hiddenRoots,
+ which will not trace through class table opages because they are weak.
- which will not trace throguh class table opages because they are weak.
But if class table pages are strong, we must mark the pages and *not*
trace them so that only classes reachable from the true roots will be
marked, and unreachable classes will be left unmarked."
self markAndTraceObjStack: markStack andContents: false.
self markAndTraceObjStack: weaklingStack andContents: false.
self markAndTraceObjStack: ephemeronQueue andContents: true.
self setIsMarkedOf: self freeListsObj to: true.
(self isWeakNonImm: classTableFirstPage) ifTrue:
[^self markAndTrace: hiddenRootsObj].
self setIsMarkedOf: hiddenRootsObj to: true.
self markAndTrace: classTableFirstPage.
1 to: numClassTablePages - 1 do:
[:i| self setIsMarkedOf: (self fetchPointer: i ofObject: hiddenRootsObj)
to: true]!
Item was changed:
----- Method: SpurMemoryManager>>moveMisfitsToTopOfHighestObjects: (in category 'compaction') -----
moveMisfitsToTopOfHighestObjects: misfits
"After a cycle of exact-fit compaction highestObjects may contain some
number of mobile objects that fail to fit, and more objects may exist to
move. Move existing misfits to top of highestObjects and temporarily
shrink highestObjects to refill it without overwriting misfits. Answer the
old limit. moveMisfitsInHighestObjectsBack: will undo the change."
| oldLimit bytesToMove |
oldLimit := highestObjects limit.
misfits = (highestObjects last + self wordSize) ifTrue:
[^oldLimit].
+ (self oop: misfits isLessThanOrEqualTo: highestObjects last) ifTrue:
- misfits <= highestObjects last ifTrue:
[bytesToMove := highestObjects last + self wordSize - misfits.
self mem: (highestObjects limit - bytesToMove) asVoidPointer
mo: misfits asVoidPointer
ve: bytesToMove.
highestObjects limit: misfits - self wordSize.
^oldLimit].
"misfits wrapped; move in two stages to preserve ordering"
bytesToMove := highestObjects last - highestObjects start.
self mem: (misfits - bytesToMove) asVoidPointer
mo: misfits asVoidPointer
ve: oldLimit - misfits.
highestObjects limit: misfits - bytesToMove.
self mem: (oldLimit - bytesToMove) asVoidPointer
mo: highestObjects start asVoidPointer
ve: bytesToMove.
^oldLimit!
Item was changed:
----- Method: SpurMemoryManager>>objectAfter: (in category 'object enumeration') -----
objectAfter: objOop
<api>
"Object parsing.
1. all objects have at least a word following the header, for a forwarding pointer.
2. objects with an overflow size have a preceeing word with a saturated slotSize. If the word following
an object doesn't have a saturated size field it must be a single-header object. If the word following
does have a saturated slotSize it must be the overflow size word."
<inline: false>
+ (self oop: objOop isLessThan: newSpaceLimit) ifTrue:
- objOop < newSpaceLimit ifTrue:
[(self isInEden: objOop) ifTrue:
[^self objectAfter: objOop limit: freeStart].
(self isInSurvivorSpace: objOop) ifTrue:
[^self objectAfter: objOop limit: pastSpaceStart].
^self objectAfter: objOop limit: scavenger futureSurvivorStart].
^self objectAfter: objOop limit: freeOldSpaceStart!
Item was changed:
----- Method: SpurMemoryManager>>objectBefore: (in category 'object enumeration') -----
objectBefore: objOop
<api>
| prev |
prev := nil.
+ (self oop: objOop isLessThan: newSpaceLimit) ifTrue:
- objOop < newSpaceLimit ifTrue:
[self allNewSpaceObjectsDo:
[:o|
+ (self oop: o isGreaterThanOrEqualTo: objOop) ifTrue:
- o >= objOop ifTrue:
[^prev].
prev := o].
^prev].
self allOldSpaceObjectsDo:
[:o|
+ (self oop: o isGreaterThanOrEqualTo: objOop) ifTrue:
- o >= objOop ifTrue:
[^prev].
prev := o].
^prev!
Item was changed:
----- Method: SpurMemoryManager>>okayOop: (in category 'debug support') -----
okayOop: signedOop
"Verify that the given oop is legitimate. Check address, header, and size but not class."
| oop classIndex fmt unusedBits unusedBitsInYoungObjects |
<var: #oop type: #usqInt>
<var: #unusedBits type: #usqLong>
oop := self cCoerce: signedOop to: #usqInt.
"address and size checks"
(self isImmediate: oop) ifTrue: [^true].
(self addressCouldBeObjWhileScavenging: oop) ifFalse:
[self error: 'oop is not a valid address'. ^false].
+ (self oop: (self addressAfter: oop) isLessThanOrEqualTo: freeOldSpaceStart) ifFalse:
- (self addressAfter: oop) <= freeOldSpaceStart ifFalse:
[self error: 'oop size would make it extend beyond the end of memory'. ^false].
"header type checks"
(classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse:
[self error: 'oop is a free chunk, or bridge, not an object'. ^false].
((self rawNumSlotsOf: oop) = self numSlotsMask
and: [(self rawNumSlotsOf: oop - self baseHeaderSize) ~= self numSlotsMask]) ifTrue:
[self error: 'oop header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false].
"format check"
fmt := self formatOf: oop.
(fmt = 6) | (fmt = 8) ifTrue:
[self error: 'oop has an unknown format type'. ^false].
(fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue:
[self error: 'oop has mis-matched format/classIndex fields; only one of them is the isForwarded value'. ^false].
"specific header bit checks"
unusedBits := (1 << self classIndexFieldWidth)
| (1 << (self identityHashFieldWidth + 32)).
((self longLongAt: oop) bitAnd: unusedBits) ~= 0 ifTrue:
[self error: 'some unused header bits are set; should be zero'. ^false].
unusedBitsInYoungObjects := (1 << self greyBitShift)
| (1 << self pinnedBitShift)
| (1 << self rememberedBitShift).
((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue:
[self error: 'some header bits unused in young objects are set; should be zero'. ^false].
^true
!
Item was changed:
----- Method: SpurMemoryManager>>sortFreeListAt: (in category 'free space') -----
sortFreeListAt: i
"Sort the individual free list i so that the lowest address is at the head of the list.
Use an insertion sort with a scan for initially sorted elements."
| list next head |
list := freeLists at: i. "list of objects to be inserted"
list = 0 ifTrue: "empty list; we're done"
[^self].
head := list.
"scan list to find find first out-of-order element"
[(next := self fetchPointer: self freeChunkNextIndex ofObject: list) > list]
whileTrue:
[list := next].
"no out-of-order elements; list was already sorted; we're done"
next = 0 ifTrue:
[^self].
"detatch already sorted list"
self storePointer: self freeChunkNextIndex ofFreeChunk: list withValue: 0.
list := next.
[list ~= 0] whileTrue:
[| node prev |
"grab next node to be inserted"
next := self fetchPointer: self freeChunkNextIndex ofObject: list.
"search sorted list for insertion point"
prev := 0. "prev node for insertion sort"
node := head. "current node for insertion sort"
[node ~= 0
+ and: [self oop: node isLessThan: list]] whileTrue:
- and: [node < list]] whileTrue:
[prev := node.
node := self fetchPointer: self freeChunkNextIndex ofObject: node].
"insert the node into the sorted list"
self assert: (node = 0 or: [node > list]).
prev = 0
ifTrue:
[head := list]
ifFalse:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: prev
withValue: list].
self storePointer: self freeChunkNextIndex
ofFreeChunk: list
withValue: node.
list := next].
"replace the list with the sorted list"
freeLists at: i put: head!
Item was changed:
----- Method: SpurMemoryManager>>startOfMemory: (in category 'simulation') -----
startOfMemory: value
startOfMemory := value.
+ (freeStart isNil or: [self oop: freeStart isLessThan: value]) ifTrue:
- (freeStart isNil or: [freeStart < value]) ifTrue:
[freeStart := value]!
Item was changed:
----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') -----
addSegmentOfSize: ammount
<returnTypeC: #'SpurSegmentInfo *'>
<inline: false>
| allocatedSize |
<var: #newSeg type: #'SpurSegmentInfo *'>
<var: #segAddress type: #'void *'>
+ self cCode: [] inSmalltalk: [segments ifNil: [^nil]]. "bootstrap"
(manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
sqAllocateMemorySegmentOfSize: ammount
Above: (segments at: 0) segLimit asVoidPointer
AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
[:segAddress| | newSegIndex newSeg |
newSegIndex := self insertSegmentFor: segAddress asUnsignedLong.
newSeg := self addressOf: (segments at: newSegIndex).
newSeg
segStart: segAddress;
segSize: allocatedSize.
self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
[self addressOf: (segments at: newSegIndex + 1)]).
"and add the new free chunk to the free list; done here
instead of in assimilateNewSegment: for the assert"
manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart.
self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart))
= (newSeg segLimit - manager bridgeSize).
^newSeg].
^nil!
More information about the Vm-dev
mailing list