[Vm-dev] VM Maker: VMMaker.oscog-eem.706.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed May 7 04:15:42 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.706.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.706
Author: eem
Time: 6 May 2014, 9:11:20.717 pm
UUID: 6eba60e7-a131-4353-870a-b34e8230b701
Ancestors: VMMaker.oscog-djm.705
Spur:
Fix the coallescing sweep in pig compact to start from the
lowest of the first forwarder or the first free chunk.
Do a tenuring scavenge to void eden in freeUnmarked-
ObjectsAndSortAndCoalesceFreeSpaceForPigCompact
to avoid any tenuring due to futureSpace overflow in the
unmarking scavenge in eliminateAndFreeForwarders-
ForPigCompact. Do this by adding the MarkOnTenure
tenuring criterion. Change the use of shouldBeTenured:
to allow it to be inlined into copyAndForward:.
Add an assert to freeChunkWithBytes:at: to catch
accidental freeing of non-oldSpace. Refactor
SpurSegmentManager>>postSnapshot to not fall foul of
this new assert. Add a check to totalFreeListBytes to catch
double freeing (double freeing was caused by tenuring in
the eAFFFPC scavenge growing memory to make room for
tenuring, given free lists are not rebuilt at this point, and
later in eAFFFPC this memory being freed again).
Don't inline doScavenge: or scavengingGCTenuringIf:.
Refactor eliminateAndFreeForwardersForFitCompact to
extract the large loops.
Add printForwarders for debugging.
With these changes the StackInterpreter runs the Newspeak
bootstrap to completion, albeit with one presumably bogus
assert fail to do with a DependentsArray referring to
forwarder contents (this to be fixed tomorrow).
Cogit:
Fix a double free bug in unlinkSendsOf:isMNUSelector:.
Harmless cuz the result is only a bogus count of how many
methods freed. Beef up the cog method integrity check
to verify a its methodObject is a CompiledMethod.
Simulator:
Fix breakpointing on plugin and plugin function load when
breakSelector is nil.
=============== Diff against VMMaker.oscog-djm.705 ===============
Item was changed:
----- Method: CogVMSimulator>>ioLoadFunction:From:AccessorDepthInto: (in category 'plugin support') -----
ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr
"Load and return the requested function from a module.
Assign the accessor depth through accessorDepthPtr.
N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
| firstTime plugin fnSymbol |
firstTime := false.
fnSymbol := functionString asSymbol.
transcript
cr;
show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
+ (breakSelector notNil
+ and: [(self str: functionString n: breakSelector cmp: functionString size) = 0]) ifTrue:
- (self str: functionString n: breakSelector cmp: functionString size) = 0 ifTrue:
[self halt: functionString].
plugin := pluginList
detect: [:any| any key = pluginString asString]
ifNone:
[firstTime := true.
self loadNewPlugin: pluginString].
plugin ifNil:
[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
^0].
plugin := plugin value.
mappedPluginEntries doWithIndex:
[:pluginAndName :index|
((pluginAndName at: 1) == plugin
and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
[firstTime ifTrue: [transcript show: ' ... okay'; cr].
accessorDepthPtr at: 0 put: (pluginAndName at: 4).
^index]].
firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
^0!
Item was changed:
----- Method: CogVMSimulator>>loadNewPlugin: (in category 'plugin support') -----
loadNewPlugin: pluginString
+ (breakSelector notNil
+ and: [(self str: pluginString n: breakSelector cmp: pluginString size) = 0]) ifTrue:
- (self str: pluginString n: breakSelector cmp: pluginString size) = 0 ifTrue:
[self halt: pluginString].
^(self tryLoadNewPlugin: pluginString pluginEntries: mappedPluginEntries) ifNotNil:
[:entry|
pluginList := pluginList copyWith: entry.
entry]!
Item was changed:
----- Method: Cogit>>checkIntegrityOfObjectReferencesInCode: (in category 'debugging') -----
checkIntegrityOfObjectReferencesInCode: fullGCFlag
<api>
"Answer if all references to objects in machine-code are valid."
| cogMethod ok count |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
ok := true.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[cogMethod cmRefersToYoung ifTrue:
[(count := methodZone occurrencesInYoungReferrers: cogMethod) ~= 1 ifTrue:
[coInterpreter print: 'young referrer CM '; printHex: cogMethod asInteger.
count = 0
ifTrue: [coInterpreter print: ' is not in youngReferrers'; cr]
ifFalse: [coInterpreter print: ' is in youngReferrers '; printNum: count; print: ' times!!'; cr].
ok := false]].
(objectRepresentation checkValidObjectReference: cogMethod selector) ifFalse:
[coInterpreter print: 'object leak in CM '; printHex: cogMethod asInteger; print: ' selector'; cr.
ok := false].
cogMethod cmType = CMMethod
ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
(objectRepresentation checkValidObjectReference: cogMethod methodObject) ifFalse:
[coInterpreter print: 'object leak in CM '; printHex: cogMethod asInteger; print: ' methodObject'; cr.
ok := false].
+ (objectMemory isCompiledMethod: cogMethod methodObject) ifFalse:
+ [coInterpreter print: 'non-method in CM '; printHex: cogMethod asInteger; print: ' methodObject'; cr.
+ ok := false].
(self mapFor: cogMethod
performUntil: #checkIfValidObjectRef:pc:cogMethod:
arg: cogMethod asInteger) ~= 0
ifTrue: [ok := false].
fullGCFlag ifFalse:
[(((objectMemory isYoungObject: cogMethod methodObject)
or: [objectMemory isYoung: cogMethod selector])
and: [cogMethod cmRefersToYoung not]) ifTrue:
[coInterpreter print: 'CM '; printHex: cogMethod asInteger; print: ' refers to young but not marked as such'; cr.
ok := false]]]
ifFalse:
[cogMethod cmType = CMClosedPIC
ifTrue:
[(self checkValidObjectReferencesInClosedPIC: cogMethod) ifFalse:
[ok := false]]
ifFalse:
[cogMethod cmType = CMOpenPIC
ifTrue:
[(self mapFor: cogMethod
performUntil: #checkIfValidObjectRef:pc:cogMethod:
arg: cogMethod asInteger) ~= 0
ifTrue: [ok := false]]]]].
cogMethod := methodZone methodAfter: cogMethod].
^ok!
Item was changed:
----- Method: Cogit>>unlinkSendsOf:isMNUSelector: (in category 'jit - api') -----
unlinkSendsOf: selector isMNUSelector: isMNUSelector
<api>
"Unlink all sends in cog methods. Free all Closed PICs with the selector,
or with an MNU case if isMNUSelector. First check if any method actually
has the selector; if not there can't be any linked send to it. This routine
(including descendents) is performance critical. It contributes perhaps
30% of entire execution time in Compiler recompileAll."
| cogMethod mustScanAndUnlink |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase isNil ifTrue: [^self].
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
mustScanAndUnlink := false.
isMNUSelector
ifTrue:
[[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod cmType ~= CMFree ifTrue:
+ [cogMethod cpicHasMNUCase
+ ifTrue:
+ [self assert: cogMethod cmType = CMClosedPIC.
+ methodZone freeMethod: cogMethod.
+ mustScanAndUnlink := true]
+ ifFalse:
+ [cogMethod selector = selector ifTrue:
+ [mustScanAndUnlink := true.
+ cogMethod cmType = CMClosedPIC ifTrue:
+ [methodZone freeMethod: cogMethod]]]].
- [cogMethod cpicHasMNUCase
- ifTrue:
- [self assert: cogMethod cmType = CMClosedPIC.
- methodZone freeMethod: cogMethod.
- mustScanAndUnlink := true]
- ifFalse:
- [cogMethod selector = selector ifTrue:
- [mustScanAndUnlink := true.
- cogMethod cmType = CMClosedPIC ifTrue:
- [methodZone freeMethod: cogMethod]]].
cogMethod := methodZone methodAfter: cogMethod]]
ifFalse:
[[cogMethod < methodZone limitZony] whileTrue:
+ [(cogMethod cmType ~= CMFree
+ and: [cogMethod selector = selector]) ifTrue:
- [cogMethod selector = selector ifTrue:
[mustScanAndUnlink := true.
cogMethod cmType = CMClosedPIC ifTrue:
[methodZone freeMethod: cogMethod]].
cogMethod := methodZone methodAfter: cogMethod]].
mustScanAndUnlink ifFalse:
[^self].
codeModified := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType = CMMethod ifTrue:
[self mapFor: cogMethod
performUntil: #unlinkIfFreeOrLinkedSend:pc:of:
arg: selector].
cogMethod := methodZone methodAfter: cogMethod].
codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!
Item was changed:
----- Method: SpurGenerationScavenger class>>initialize (in category 'class initialization') -----
initialize
"SpurGenerationScavenger initialize"
RememberedSetLimit := 64 * 1024. "temporary; must move to heap"
RememberedSetRedZone := RememberedSetLimit - (RememberedSetLimit // 2).
TenureByAge := 1.
TenureByClass := 2.
+ DontTenure := 3.
+ DontTenureButDoUnmark := 4.
+ MarkOnTenure := 5!
- DontTenureButDoUnmark := 3!
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. If the object is weak
then corpse is threaded onto the weakList for later treatment."
<inline: false>
+ | bytesInObj format tenure newLocation |
- | bytesInObj format newLocation |
self assert: ((manager isInEden: survivor) "cog methods should be excluded."
or: [manager isInPastSpace: survivor]).
bytesInObj := manager bytesInObject: survivor.
format := manager formatOf: survivor.
+ tenure := self shouldBeTenured: survivor. "Allow Slang to inline."
+ (tenure or: [futureSurvivorStart + bytesInObj > futureSpace limit])
- ((self shouldBeTenured: survivor)
- or: [futureSurvivorStart + bytesInObj > futureSpace limit])
ifTrue: [newLocation := self copyToOldSpace: survivor bytes: bytesInObj format: format]
ifFalse: [newLocation := self copyToFutureSpace: survivor bytes: bytesInObj].
manager forwardSurvivor: survivor to: newLocation.
"if weak or ephemeron add to the relevant list for subsequent scanning."
(manager isWeakFormat: format) ifTrue:
[self addToWeakList: survivor].
((manager isEphemeronFormat: format)
and: [(self isScavengeSurvivor: (manager keyOfEphemeron: newLocation)) not]) ifTrue:
[self addToEphemeronList: survivor].
^newLocation!
Item was changed:
----- Method: SpurGenerationScavenger>>copyToOldSpace:bytes:format: (in category 'scavenger') -----
copyToOldSpace: survivor bytes: bytesInObject format: formatOfSurvivor
"Copy survivor to oldSpace. Answer the new oop of the object."
<inline: true>
| nTenures startOfSurvivor newStart newOop |
self assert: (formatOfSurvivor = (manager formatOf: survivor)
+ and: [((manager isMarked: survivor) not or: [tenureCriterion = MarkOnTenure])
- and: [(manager isMarked: survivor) not
and: [(manager isPinned: survivor) not
and: [(manager isRemembered: survivor) not]]]).
nTenures := statTenures.
startOfSurvivor := manager startOfObject: survivor.
newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
newStart ifNil:
[manager growOldSpaceByAtLeast: 0. "grow by growHeadroom"
newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
newStart ifNil:
[self error: 'out of memory']].
manager checkFreeSpace.
manager mem: newStart asVoidPointer cp: startOfSurvivor asVoidPointer y: bytesInObject.
newOop := newStart + (survivor - startOfSurvivor).
(manager isAnyPointerFormat: formatOfSurvivor) ifTrue:
[self remember: newOop.
manager setIsRememberedOf: newOop to: true].
+ tenureCriterion = MarkOnTenure ifTrue:
+ [manager setIsMarkedOf: newOop to: true].
statTenures := nTenures + 1.
^newOop!
Item was changed:
----- Method: SpurGenerationScavenger>>shouldBeTenured: (in category 'scavenger') -----
shouldBeTenured: survivor
"Answer if an object should be tenured. The default policy tenuring policy
is to use the tenuringThreshold to decide. If the survivors (measured in
bytes) are above some fraction of the survivor space then objects below
the threshold (older objects, since allocation grows upwards and hence
new objects are later than old) are scavenged. Otherwise, the threshold
is set to 0 and no objects are tenured. e.g. see
An adaptive tenuring policy for generation scavengers,
David Ungar & Frank Jackson.
ACM TOPLAS, Volume 14 Issue 1, Jan. 1992, pp 1 - 27.
The other policies are for special purposes."
- <inline: false> "Slang limitations given this used in (... or: []) ifTrue:"
^tenureCriterion
caseOf: {
[TenureByAge] ->
[survivor < tenureThreshold].
[TenureByClass] ->
[(manager classIndexOf: survivor) = tenuringClassIndex].
[DontTenureButDoUnmark] ->
[manager setIsMarkedOf: survivor to: false.
false] }
otherwise: [false]!
Item was changed:
SharedPool subclass: #SpurMemoryManagementConstants
instanceVariableNames: ''
+ classVariableNames: 'DontTenure DontTenureButDoUnmark MarkOnTenure TenureByAge TenureByClass'
- classVariableNames: 'DontTenureButDoUnmark TenureByAge TenureByClass'
poolDictionaries: ''
category: 'VMMaker-SpurMemoryManager'!
Item was changed:
----- Method: SpurMemoryManager>>doScavenge: (in category 'gc - scavenging') -----
doScavenge: tenuringCriterion
"The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it."
+ <inline: false>
-
scavengeInProgress := true.
pastSpaceStart := scavenger scavenge: tenuringCriterion.
self assert: (self
oop: pastSpaceStart
isGreaterThanOrEqualTo: scavenger pastSpace start
andLessThanOrEqualTo: scavenger pastSpace limit).
freeStart := scavenger eden start.
self initSpaceForAllocationCheck: (self addressOf: scavenger eden).
scavengeInProgress := false!
Item was changed:
----- Method: SpurMemoryManager>>eliminateAndFreeForwardersForFitCompact (in category 'gc - global') -----
eliminateAndFreeForwardersForFitCompact
"As the final phase of global garbage collect, sweep the heap to follow
forwarders, then free forwarders, coalescing with free space as we go."
+ | lowestFree |
- | lowestFree firstFree lastFree |
<inline: false>
self flag: 'this might be unnecessary. if we were to track firstFreeChunk we might be able to repeat the freeUnmarkedObjectsAndSortAndCoalesceFreeSpace; compact cycle until firstFreeChunk reaches a fixed point'.
self assert: (self isForwarded: nilObj) not.
self assert: (self isForwarded: falseObj) not.
self assert: (self isForwarded: trueObj) not.
self assert: (self isForwarded: self freeListsObj) not.
self assert: (self isForwarded: hiddenRootsObj) not.
self assert: (self isForwarded: classTableFirstPage) not.
self followSpecialObjectsOop.
+ "N.B. we don't have to explicitly do mapInterpreterOops since the scavenge below
+ will do it, except that scavenging maps only young references in machine code."
- "N.B. we don't have to explicitly do mapInterpreterOops
- since the scavenge below will do it."
self followForwardedObjStacks.
scavenger followRememberedForwardersAndForgetFreeObjects.
self doScavenge: DontTenureButDoUnmark.
+ coInterpreter mapMachineCode.
self checkFreeSpace.
+ lowestFree := self sweepToFollowForwardersForFitCompact.
- lowestFree := 0.
- "sweep, following forwarders in all live objects, and finding the first forwarder."
- self allOldSpaceEntitiesDo:
- [:o|
- ((self isFreeObject: o) or: [self isForwarded: o])
- ifTrue:
- [lowestFree = 0 ifTrue:
- [lowestFree := o]]
- ifFalse:
- [0 to: (self numPointerSlotsOf: o) - 1 do:
- [:i| | f |
- f := self fetchPointer: i ofObject: o.
- (self isOopForwarded: f) ifTrue:
- [f := self followForwarded: f.
- self storePointer: i ofObject: o withValue: f]]]].
self checkFreeSpace.
lowestFree = 0 ifTrue: "yeah, right..."
[^self].
+ self sweepToCoallesceFreeSpaceAndRebuildFreeListsForFitCompactFrom: lowestFree.
- firstFree := lastFree := 0.
- "Sweep from lowest forwarder, coalescing runs of forwarders and free objects."
- self allOldSpaceEntitiesFrom: lowestFree do:
- [:o|
- (self isFreeObject: o)
- ifTrue: "two cases, isolated, in which case leave alone, or adjacent,
- in which case, remove from free set prior to coalesce."
- [| next |
- next := self objectAfter: o limit: endOfMemory.
- self assert: (next = endOfMemory or: [(self isFreeObject: next) not]). "free chunks have already been coalesced"
- (firstFree ~= 0
- or: [next ~= endOfMemory and: [self isForwarded: next]]) ifTrue:
- [firstFree = 0 ifTrue:
- [firstFree := o].
- lastFree := o.
- self detachFreeObject: o.
- self checkFreeSpace]]
- ifFalse:
- [(self isForwarded: o)
- ifTrue:
- [firstFree = 0 ifTrue:
- [firstFree := o].
- lastFree := o]
- ifFalse:
- [firstFree ~= 0 ifTrue:
- [| start bytes |
- start := self startOfObject: firstFree.
- bytes := (self addressAfter: lastFree) - start.
- self addFreeChunkWithBytes: bytes at: start.
- self checkFreeSpace].
- firstFree := 0]]].
- firstFree ~= 0 ifTrue:
- [| start bytes |
- start := self startOfObject: firstFree.
- bytes := (self addressAfter: lastFree) - start.
- self addFreeChunkWithBytes: bytes at: start].
self checkFreeSpace!
Item was changed:
----- Method: SpurMemoryManager>>eliminateAndFreeForwardersForPigCompact (in category 'gc - global') -----
eliminateAndFreeForwardersForPigCompact
"As the final phase of global garbage collect, sweep the heap to follow
forwarders, then free forwarders, coalescing with free space as we go."
<inline: false>
+ | lowestForwarder |
self assert: (self isForwarded: nilObj) not.
self assert: (self isForwarded: falseObj) not.
self assert: (self isForwarded: trueObj) not.
self assert: (self isForwarded: self freeListsObj) not.
self assert: (self isForwarded: hiddenRootsObj) not.
self assert: (self isForwarded: classTableFirstPage) not.
self followSpecialObjectsOop.
+ "N.B. we don't have to explicitly do mapInterpreterOops since the scavenge below
+ will do it, except that scavenging maps only young references in machine code."
- "N.B. we don't have to explicitly do mapInterpreterOops
- since the scavenge below will do it."
self followForwardedObjStacks.
scavenger followRememberedForwardersAndForgetFreeObjectsForPigCompact.
+ "Because of the flushEden before markObjects the scavenge /should not/
+ tenure. In fact it must not because the free list has not been rebuilt, so
+ there is no space, and any attempt to tenure will allocate a new segment."
+ totalFreeOldSpace := 0.
self doScavenge: DontTenureButDoUnmark.
+ self assert: totalFreeOldSpace = 0.
+ coInterpreter mapMachineCode.
+ lowestForwarder := self sweepToFollowForwardersForPigCompact.
+ self sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompactFrom: lowestForwarder.
- self sweepToFollowForwardersForPigCompact.
- self sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact.
self checkFreeSpace.
self assert: self numberOfForwarders = 0!
Item was added:
+ ----- Method: SpurMemoryManager>>flushEden (in category 'gc - scavenging') -----
+ flushEden
+ "Fush everything in eden. Do so by doing a non-tenuring scavenge."
+ self scavengingGCTenuringIf: DontTenure.
+ self assert: pastSpaceStart = scavenger pastSpace start.
+ self assert: freeStart = scavenger eden start!
Item was changed:
----- Method: SpurMemoryManager>>flushNewSpace (in category 'gc - scavenging') -----
flushNewSpace
+ "Fush everything in new space. Do so by setting the tenure
+ threshold above everything in newSpace, i.e. newSpaceLimit."
| savedTenuringThreshold |
savedTenuringThreshold := scavenger getRawTenuringThreshold.
scavenger setRawTenuringThreshold: newSpaceLimit.
self scavengingGCTenuringIf: TenureByAge.
scavenger setRawTenuringThreshold: savedTenuringThreshold.
self assert: scavenger rememberedSetSize = 0.
self assert: pastSpaceStart = scavenger pastSpace start.
self assert: freeStart = scavenger eden start!
Item was changed:
----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') -----
freeChunkWithBytes: bytes at: address
<inline: false>
| freeChunk |
self assert: (lastSubdividedFreeChunk := address) ~= 0.
+ self assert: (self isInOldSpace: address).
freeChunk := self initFreeChunkWithBytes: bytes at: address.
self assert: (self isInMemory: (self addressAfter: freeChunk)).
self addToFreeList: freeChunk bytes: bytes.
self assert: freeChunk = (self objectStartingAt: address).
^freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact (in category 'gc - global') -----
freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact
"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
Doubly-link the free chunks in address order through the freeChunkNextIndex field using the
xor trick to use only one field, see e.g.
The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18
http://en.wikipedia.org/wiki/XOR_linked_list.
Record the lowest free object in firstFreeChunk and the highest in lastFreeChunk.
Let the segmentManager mark which segments contain pinned objects via notePinned:."
| prevPrevFree prevFree |
<inline: false>
self checkFreeSpace.
+ "Using pigCompact we scavenge to unmark objects before the free list has been
+ rebuilt, and that scavenge must not tenure. So get tenuring out of the way now."
scavenger forgetUnmarkedRememberedObjects.
+ self self doScavenge: MarkOnTenure.
segmentManager prepareForGlobalSweep."for notePinned:"
"throw away the list heads, including the tree."
self resetFreeListHeads.
firstFreeChunk := prevPrevFree := prevFree := 0.
self allOldSpaceEntitiesForCoalescingDo:
[:o|
self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
(self isMarked: o)
ifTrue: "forwarders should have been followed in markAndTrace:"
[self assert: (self isForwarded: o) not.
self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
(self isPinned: o) ifTrue:
[segmentManager notePinned: o]]
ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
[| here |
self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
here := self coallesceFreeChunk: o.
self setObjectFree: here.
self inSortedFreeListLink: prevFree to: here given: prevPrevFree.
prevPrevFree := prevFree.
prevFree := here]].
prevFree ~= firstFreeChunk ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: prevFree
withValue: prevPrevFree].
lastFreeChunk := prevFree.
self cCode: [] inSmalltalk: [self checkTraversableSortedFreeList]!
Item was changed:
----- Method: SpurMemoryManager>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') -----
growOldSpaceByAtLeast: minAmmount
"Attempt to grow memory by at least minAmmount.
Answer the size of the new segment, or nil if the attempt failed."
| ammount |
<var: #segInfo type: #'SpurSegmentInfo *'>
"statGrowMemory counts attempts, not successes."
statGrowMemory := statGrowMemory + 1.
"we need to include overhead for a new object header plus the segment bridge."
ammount := minAmmount + (self baseHeaderSize * 2 + self bridgeSize).
"round up to the nearest power of two."
ammount := 1 << (ammount - 1) highBit.
"and grow by at least growHeadroom."
ammount := ammount max: growHeadroom.
^(segmentManager addSegmentOfSize: ammount) ifNotNil:
[:segInfo|
self assimilateNewSegment: segInfo.
+ "and add the new free chunk to the free list; done here
+ instead of in assimilateNewSegment: for the assert"
+ self addFreeChunkWithBytes: segInfo segSize - self bridgeSize at: segInfo segStart.
+ self assert: (self addressAfter: (self objectStartingAt: segInfo segStart))
+ = (segInfo segLimit - self bridgeSize).
self checkFreeSpace.
segInfo segSize]!
Item was added:
+ ----- Method: SpurMemoryManager>>printForwarders (in category 'debug printing') -----
+ printForwarders
+ <api>
+ self allHeapEntitiesDo:
+ [:objOop|
+ (self isForwarded: objOop) ifTrue:
+ [coInterpreter printHex: objOop; cr]]!
Item was changed:
----- Method: SpurMemoryManager>>scavengingGCTenuringIf: (in category 'gc - scavenging') -----
scavengingGCTenuringIf: tenuringCriterion
"Run the scavenger."
+ <inline: false>
-
self assert: remapBufferCount = 0.
(self asserta: scavenger eden limit - freeStart > coInterpreter interpreterAllocationReserveBytes) ifFalse:
[coInterpreter tab;
printNum: scavenger eden limit - freeStart; space;
printNum: coInterpreter interpreterAllocationReserveBytes; space;
printNum: coInterpreter interpreterAllocationReserveBytes - (scavenger eden limit - freeStart); cr].
self checkMemoryMap.
self checkFreeSpace.
self runLeakCheckerForFullGC: false.
coInterpreter
preGCAction: GCModeScavenge;
"would prefer this to be in mapInterpreterOops, but
compatibility with ObjectMemory dictates it goes here."
flushMethodCacheFrom: newSpaceStart to: newSpaceLimit.
needGCFlag := false.
gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
self doScavenge: tenuringCriterion.
statScavenges := statScavenges + 1.
statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
statRootTableCount := scavenger rememberedSetSize.
coInterpreter postGCAction: GCModeScavenge.
self runLeakCheckerForFullGC: false.
self checkFreeSpace!
Item was changed:
----- Method: SpurMemoryManager>>sortedFreeListPairwiseReverseDo: (in category 'compaction') -----
sortedFreeListPairwiseReverseDo: aBinaryBlock
"Evaluate aBinaryBlock with adjacent entries in the free list, from
high address to low address. The second argument is in fact the
start of the next free chunk, not the free chunk itself. Use
endOfMemory - bridgeSize as the second argument in the first evaluation."
| free nextFree prevFree prevPrevFree |
free := lastFreeChunk.
prevPrevFree := prevFree := 0.
[free ~= 0] whileTrue:
[nextFree := self nextInSortedFreeListLink: free given: prevFree.
self assert: (free = 0 or: [self isFreeObject: free]).
self assert: (prevFree = 0 or: [prevFree > free]).
aBinaryBlock value: free value: (prevFree = 0
ifTrue: [endOfMemory - self bridgeSize]
ifFalse: [self startOfObject: prevFree]).
self assert: (prevFree = 0 or: [self isFreeObject: prevFree]).
self assert: (prevPrevFree = 0 or: [self isFreeObject: prevPrevFree]).
(self isFreeObject: free) ifFalse:
[free := self nextInSortedFreeListLink: prevFree given: prevPrevFree].
+ (nextFree = 0 or: [self isFreeObject: nextFree])
- (self isFreeObject: nextFree)
ifTrue:
[prevPrevFree := prevFree.
prevFree := free.
free := nextFree]
ifFalse:
[free := lastFreeChunk.
prevPrevFree := prevFree := 0.
[free > nextFree] whileTrue:
[nextFree := self nextInSortedFreeListLink: free given: prevFree.
self assert: (self isFreeObject: nextFree).
prevPrevFree := prevFree.
prevFree := free.
free := nextFree]]]!
Item was added:
+ ----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceAndRebuildFreeListsForFitCompactFrom: (in category 'compaction') -----
+ sweepToCoallesceFreeSpaceAndRebuildFreeListsForFitCompactFrom: lowestFree
+ | firstFree lastFree |
+ firstFree := lastFree := 0.
+ "Sweep from lowest forwarder, coalescing runs of forwarders and free objects."
+ self allOldSpaceEntitiesFrom: lowestFree do:
+ [:o|
+ (self isFreeObject: o)
+ ifTrue: "two cases, isolated, in which case leave alone, or adjacent,
+ in which case, remove from free set prior to coalesce."
+ [| next |
+ next := self objectAfter: o limit: endOfMemory.
+ self assert: (next = endOfMemory or: [(self isFreeObject: next) not]). "free chunks have already been coalesced"
+ (firstFree ~= 0
+ or: [next ~= endOfMemory and: [self isForwarded: next]]) ifTrue:
+ [firstFree = 0 ifTrue:
+ [firstFree := o].
+ lastFree := o.
+ self detachFreeObject: o.
+ self checkFreeSpace]]
+ ifFalse:
+ [(self isForwarded: o)
+ ifTrue:
+ [firstFree = 0 ifTrue:
+ [firstFree := o].
+ lastFree := o]
+ ifFalse:
+ [firstFree ~= 0 ifTrue:
+ [| start bytes |
+ start := self startOfObject: firstFree.
+ bytes := (self addressAfter: lastFree) - start.
+ self addFreeChunkWithBytes: bytes at: start.
+ self checkFreeSpace].
+ firstFree := 0]]].
+ firstFree ~= 0 ifTrue:
+ [| start bytes |
+ start := self startOfObject: firstFree.
+ bytes := (self addressAfter: lastFree) - start.
+ self addFreeChunkWithBytes: bytes at: start].!
Item was removed:
- ----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact (in category 'gc - global') -----
- sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact
- "Coallesce free chunks and forwarders and rebuild the free list."
- | firstFree firstFreeStart lastFree |
- self assert: (self noForwardersBelowFirstFreeChunk).
- firstFree := totalFreeOldSpace := 0.
- self allOldSpaceEntitiesFrom: firstFreeChunk do:
- [:o|
- ((self isFreeObject: o) or: [self isForwarded: o])
- ifTrue:
- [firstFree = 0 ifTrue:
- [firstFree := o.
- firstFreeStart := self startOfObject: o].
- lastFree := o]
- ifFalse:
- [firstFree ~= 0 ifTrue:
- [| bytes |
- bytes := (self addressAfter: lastFree) - firstFreeStart.
- self addFreeChunkWithBytes: bytes at: firstFreeStart].
- firstFree := 0]].
- firstFree ~= 0 ifTrue:
- [| bytes |
- bytes := (self addressAfter: lastFree) - firstFreeStart.
- self addFreeChunkWithBytes: bytes at: firstFreeStart].
- firstFreeChunk := lastFreeChunk := 0!
Item was added:
+ ----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompactFrom: (in category 'compaction') -----
+ sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompactFrom: lowestForwarder
+ "Coallesce free chunks and forwarders and rebuild the free list."
+ | lowest firstFree firstFreeStart lastFree |
+ lowest := (lowestForwarder = 0 ifTrue: [endOfMemory] ifFalse: [lowestForwarder])
+ min: (firstFreeChunk = 0 ifTrue: [endOfMemory] ifFalse: [firstFreeChunk]).
+ firstFree := totalFreeOldSpace := 0.
+ self allOldSpaceEntitiesFrom: lowest do:
+ [:o|
+ ((self isFreeObject: o) or: [self isForwarded: o])
+ ifTrue:
+ [firstFree = 0 ifTrue:
+ [firstFree := o.
+ firstFreeStart := self startOfObject: o].
+ lastFree := o]
+ ifFalse:
+ [firstFree ~= 0 ifTrue:
+ [| bytes |
+ bytes := (self addressAfter: lastFree) - firstFreeStart.
+ self addFreeChunkWithBytes: bytes at: firstFreeStart].
+ firstFree := 0]].
+ firstFree ~= 0 ifTrue:
+ [| bytes |
+ bytes := (self addressAfter: lastFree) - firstFreeStart.
+ self addFreeChunkWithBytes: bytes at: firstFreeStart].
+ firstFreeChunk := lastFreeChunk := 0!
Item was changed:
+ ----- Method: SpurMemoryManager>>sweepToFollowForwarders (in category 'compaction') -----
- ----- Method: SpurMemoryManager>>sweepToFollowForwarders (in category 'gc - global') -----
sweepToFollowForwarders
"sweep, following forwarders in all live objects, and answering the first forwarder or free object."
| lowestFree |
lowestFree := 0.
self allOldSpaceEntitiesDo:
[:o|
((self isFreeObject: o) or: [self isForwarded: o])
ifTrue:
[lowestFree = 0 ifTrue:
[lowestFree := o]]
ifFalse:
[0 to: (self numPointerSlotsOf: o) - 1 do:
[:i| | f |
f := self fetchPointer: i ofObject: o.
(self isOopForwarded: f) ifTrue:
[f := self followForwarded: f.
self storePointer: i ofObject: o withValue: f]]]].
^lowestFree
!
Item was added:
+ ----- Method: SpurMemoryManager>>sweepToFollowForwardersForFitCompact (in category 'compaction') -----
+ sweepToFollowForwardersForFitCompact
+ "sweep, following forwarders in all live objects, and finding the first forwarder."
+ | lowestFree |
+ lowestFree := 0.
+ self allOldSpaceEntitiesDo:
+ [:o|
+ ((self isFreeObject: o) or: [self isForwarded: o])
+ ifTrue:
+ [lowestFree = 0 ifTrue:
+ [lowestFree := o]]
+ ifFalse:
+ [0 to: (self numPointerSlotsOf: o) - 1 do:
+ [:i| | f |
+ f := self fetchPointer: i ofObject: o.
+ (self isOopForwarded: f) ifTrue:
+ [f := self followForwarded: f.
+ self storePointer: i ofObject: o withValue: f]]]].
+ ^lowestFree!
Item was changed:
+ ----- Method: SpurMemoryManager>>sweepToFollowForwardersForPigCompact (in category 'compaction') -----
- ----- Method: SpurMemoryManager>>sweepToFollowForwardersForPigCompact (in category 'gc - global') -----
sweepToFollowForwardersForPigCompact
+ "Sweep, following forwarders in all live objects.
+ Answer the lowest forwarder."
+ | lowestForwarder |
+ lowestForwarder := 0.
- "sweep, following forwarders in all live objects."
self allOldSpaceObjectsDo:
[:o|
+ (self isForwarded: o)
+ ifTrue:
+ [lowestForwarder = 0 ifTrue:
+ [lowestForwarder := 0]]
+ ifFalse:
+ [0 to: (self numPointerSlotsOf: o) - 1 do:
+ [:i| | f |
+ f := self fetchPointer: i ofObject: o.
+ (self isOopForwarded: f) ifTrue:
+ [f := self followForwarded: f.
+ self storePointer: i ofObject: o withValue: f]]]].
+ ^lowestForwarder!
- (self isForwarded: o) ifFalse:
- [0 to: (self numPointerSlotsOf: o) - 1 do:
- [:i| | f |
- f := self fetchPointer: i ofObject: o.
- (self isOopForwarded: f) ifTrue:
- [f := self followForwarded: f.
- self storePointer: i ofObject: o withValue: f]]]]!
Item was changed:
----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
totalFreeListBytes
"This method both computes the actual number of free bytes by traversing all free objects
on the free lists/tree, and checks that the tree is valid. It is used mainly by checkFreeSpace."
+ | totalFreeBytes bytesInChunk listNode nextNode |
- | totalFreeBytes bytesInChunk listNode |
totalFreeBytes := 0.
1 to: self numFreeLists - 1 do:
[:i|
bytesInChunk := i * self allocationUnit.
listNode := freeLists at: i.
[listNode ~= 0] whileTrue:
[totalFreeBytes := totalFreeBytes + bytesInChunk.
self assert: (self isValidFreeObject: listNode).
self assert: bytesInChunk = (self bytesInObject: listNode).
+ nextNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode.
+ self assert: nextNode ~= listNode.
+ listNode := nextNode]].
- listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]].
self freeTreeNodesDo:
[:treeNode|
bytesInChunk := self bytesInObject: treeNode.
self assert: bytesInChunk / self allocationUnit >= self numFreeLists.
listNode := treeNode.
[listNode ~= 0] whileTrue:
["self printFreeChunk: listNode"
self assert: (self isValidFreeObject: listNode).
self assert: (listNode = treeNode
or: [(self fetchPointer: self freeChunkParentIndex ofFreeChunk: listNode) = 0]).
totalFreeBytes := totalFreeBytes + bytesInChunk.
self assert: bytesInChunk = (self bytesInObject: listNode).
+ nextNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode.
+ self assert: nextNode ~= listNode.
+ listNode := nextNode].
- listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode].
treeNode].
^totalFreeBytes!
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 asUnsignedLong;
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).
"test isInMemory:"
0 to: numSegments - 1 do:
[:i|
self assert: (self isInSegments: (segments at: i) segStart).
self assert: (self isInSegments: (segments at: i) segLimit - manager wordSize).
self assert: ((self isInSegments: (segments at: i) segLimit) not
or: [i < (numSegments - 1)
and: [(segments at: i) segLimit = (segments at: i + 1) segStart]]).
self assert: ((self isInSegments: (segments at: i) segStart - manager wordSize) not
or: [i > 0
and: [(segments at: i - 1) segLimit = (segments at: i) segStart]])].
^newSeg].
^nil!
Item was changed:
----- Method: SpurSegmentManager>>postSnapshot (in category 'snapshot') -----
postSnapshot
+ "Restore all shortened segments to their proper size, re-freeing the trailing space."
+ <inline: false>
+ | seg |
+ <var: #seg type: #'SpurSegmentInfo *'>
+ "Set endOfMemory first, to avoid assert fails in freeChunkWithBytes:at:."
+ seg := self addressOf: (segments at: numSegments - 1).
+ seg lastFreeObject
+ ifNil: [self assert: manager endOfMemory = (seg segLimit - manager bridgeSize)]
+ ifNotNil: [manager setEndOfMemory: seg savedSegSize + seg segStart - manager bridgeSize].
+
- "Restore all shortened segments to their proper size,
- re-freeing the trailing space."
numSegments - 1 to: 0 by: -1 do:
[:i|
+ seg := self addressOf: (segments at: i).
+ seg lastFreeObject ifNotNil:
- (segments at: i) lastFreeObject ifNotNil:
[:freeChunk| | address |
+ address := seg segLimit - manager bridgeSize.
+ seg segSize: seg savedSegSize.
+ self bridgeFrom: seg
- address := (segments at: i) segLimit - manager bridgeSize.
- (segments at: i) segSize: (segments at: i) savedSegSize.
- self bridgeFrom: (self addressOf: (segments at: i))
to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)]).
manager
+ addFreeChunkWithBytes: seg segLimit - address - manager bridgeSize
+ at: address]]!
- addFreeChunkWithBytes: (segments at: i) segLimit - address - manager bridgeSize
- at: address]].
-
- "perhaps this should read
- manager setEndOfMemory: 0; assimilateNewSegment: (segments at: numSegments - 1)"
- manager setEndOfMemory: (segments at: numSegments - 1) segLimit - manager bridgeSize!
More information about the Vm-dev
mailing list