Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.496.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.496 Author: eem Time: 2 November 2013, 12:12:59.565 pm UUID: f0401045-f2f7-470e-9940-3535be9c0334 Ancestors: VMMaker.oscog-eem.495
Fix global GC bug where stack pages containing marked contexts were being freed. Bug was that objects marked in newSpace were not being unmarked after GC. Add a DontTenureButDoUnmark tenuring policy to unmark newSpace objects. N.B. perhaps this should be used *before* the GC. But for now, with no incremental GC, we don't need to.
Fix nasty bug in MessageNode>>asTranslatorNodeIn: that left extra arguments in args for ifTrue:, and: et al, and hence confused the new nilOrBooleanConstantReceiverOf:.
Fix markAndTraceStackPages: to iterate while next page is untraced rather than unreached.
Mark setTraceFlagOnContextsFramesPageIfNeeded: as <inline: false>; we won't need multiple copies.
Add some frames-on-page printing utilities.
=============== Diff against VMMaker.oscog-eem.495 ===============
Item was changed: ----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') ----- asTranslatorNodeIn: aTMethod "make a CCodeGenerator equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used." | rcvrOrNil sel args ifNotNilBlock | rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: [^aTMethod superExpansionNodeFor: selector key args: arguments]. sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key]. ((sel == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." or: [sel == #cCode:]) and: [arguments first isBlockNode]) ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. args := arguments select: [:arg| arg notNil] thenCollect: [:arg| arg asTranslatorNodeIn: aTMethod]. (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue: ["Restore limit expr that got moved by transformToDo:" args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod. args second. args third. "add the limit var as a hidden extra argument; we may need it later" TVariableNode new setName: arguments first key}]. (sel == #ifTrue:ifFalse: and: [arguments first isJust: NodeNil]) ifTrue: [sel := #ifFalse:. args := {args last}]. (sel == #ifTrue:ifFalse: and: [arguments last isJust: NodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. (sel == #ifFalse:ifTrue: and: [arguments first isJust: NodeNil]) ifTrue: [sel := #ifTrue:. args := {args last}]. (sel == #ifFalse:ifTrue: and: [arguments last isJust: NodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. ((sel == #ifFalse: or: [sel == #or:]) and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: ["Restore argument block that got moved by transformOr: or transformIfFalse:" + args := {(arguments at: 2) asTranslatorNodeIn: aTMethod}]. + (args size > sel numArgs and: [sel ~~ #to:by:do:]) ifTrue: "to:by:do: has iLimiT hidden in last arg" + ["prune the extra blocks left by ifTrue:, ifFalse:, and: & or:" + self assert: args size - sel numArgs = 1. + self assert: (args last isStmtList + and: [args last statements size = 1 + and: [(args last statements first isVariable + or: [args last statements first isConstant]) + and: [#('nil' true false) includes: args last statements first nameOrValue]]]). + args := args first: sel numArgs]. - args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. "For the benefit of later passes, e.g. value: inlining, transform e ifNotNil: [:v| ...] into v := e. v ifNotNil: [...], which in fact means transforming (v := e) ifTrue: [:v|...] into v := e. v ifTrue: [...]." ((sel == #ifTrue: or: [sel == #ifFalse: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]]]) and: [receiver notNil and: [receiver isAssignmentEqualsEqualsNil and: [(ifNotNilBlock := args detect: [:arg| arg isStmtList and: [arg args size = 1]] ifNone: []) notNil]]]) ifTrue: [ifNotNilBlock setArguments: #(). ^TStmtListNode new setArguments: #() statements: { receiver receiver asTranslatorNodeIn: aTMethod. TSendNode new setSelector: sel receiver: (TSendNode new setSelector: #== receiver: (receiver receiver variable asTranslatorNodeIn: aTMethod) arguments: {receiver arguments first asTranslatorNodeIn: aTMethod}) arguments: args }]. ^TSendNode new setSelector: sel receiver: rcvrOrNil arguments: args!
Item was added: + ----- Method: Spur32BitMMLESimulator>>setIsMarkedOf:to: (in category 'header access') ----- + setIsMarkedOf: objOop to: aBoolean + super setIsMarkedOf: objOop to: aBoolean. + (aBoolean + and: [(self isContextNonImm: objOop) + and: [(coInterpreter + checkIsStillMarriedContext: objOop + currentFP: coInterpreter framePointer) + and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue: + [self halt]!
Item was changed: ----- Method: SpurGenerationScavenger class>>initialize (in category 'class initialization') ----- initialize "SpurGenerationScavenger initialize" RememberedSetLimit := 16384. RememberedSetRedZone := RememberedSetLimit - (RememberedSetLimit // 2).
TenureByAge := 1. + TenureByClass := 2. + DontTenureButDoUnmark := 3! - TenureByClass := 2!
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. - "Answer if an object should be tenured. 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. See e.g. - 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." + ^tenureCriterion caseOf: { [TenureByAge] -> [survivor < tenureThreshold]. [TenureByClass] -> + [(manager classIndexOf: survivor) = tenuringClassIndex]. + [DontTenureButDoUnmark] -> + [manager setIsMarkedOf: survivor to: false. + false] } - [(manager classIndexOf: survivor) = tenuringClassIndex] } otherwise: [false]!
Item was changed: SharedPool subclass: #SpurMemoryManagementConstants instanceVariableNames: '' + classVariableNames: 'DontTenureButDoUnmark TenureByAge TenureByClass' - classVariableNames: 'TenureByAge TenureByClass' poolDictionaries: '' category: 'VMMaker-SpurMemoryManager'!
Item was added: + ----- Method: SpurMemoryManager>>allObjectsUnmarked (in category 'gc - global') ----- + allObjectsUnmarked + self allObjectsDo: + [:o| (self isMarked: o) ifFalse: [^false]]. + ^true!
Item was changed: ----- Method: SpurMemoryManager>>eliminateAndFreeForwarders (in category 'gc - global') ----- eliminateAndFreeForwarders "As the final phase of global garbage collect, sweep the heap to follow forwarders, then free forwarders" | lowestForwarded firstForwarded lastForwarded | self assert: (self isForwarded: nilObj) not. self assert: (self isForwarded: falseObj) not. self assert: (self isForwarded: trueObj) not. self assert: (self isForwarded: hiddenRootsObj) not. (self isForwarded: specialObjectsOop) ifTrue: [specialObjectsOop := self followForwarded: specialObjectsOop]. self followForwardedObjStacks. scavenger followRememberedForwardersAndForgetFreeObjects. + self doScavenge: DontTenureButDoUnmark. - self doScavenge: TenureByAge. lowestForwarded := 0. "sweep, following forwarders in all live objects, and finding the first forwarder." self allOldSpaceObjectsDo: [:o| (self isForwarded: o) ifTrue: [lowestForwarded = 0 ifTrue: [lowestForwarded := 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 assert: ((self isImmediate: f) or: [self isYoung: f]) not. self storePointerUnchecked: i ofObject: o withValue: f]]]]. firstForwarded := lastForwarded := 0. "sweep from lowest forwarder, coalescing runs of forwarders." self allOldSpaceObjectsFrom: lowestForwarded do: [:o| (self isForwarded: o) ifTrue: [firstForwarded = 0 ifTrue: [firstForwarded := o]. lastForwarded := o] ifFalse: [firstForwarded ~= 0 ifTrue: [| start bytes | start := self startOfObject: firstForwarded. bytes := (self addressAfter: lastForwarded) - start. self addFreeChunkWithBytes: bytes at: start]. firstForwarded := 0]]. firstForwarded ~= 0 ifTrue: [| start bytes | start := self startOfObject: firstForwarded. bytes := (self addressAfter: lastForwarded) - start. self addFreeChunkWithBytes: bytes at: start].!
Item was changed: ----- Method: SpurMemoryManager>>ensureAllMarkBitsAreZero (in category 'gc - incremental') ----- ensureAllMarkBitsAreZero "If the incremental collector is running mark bits may be set; stop it and clear them if necessary." + self flag: 'need to implement the inc GC first...'. + self assert: self allObjectsUnmarked! - self flag: 'need to implement the inc GC first...'!
Item was changed: ----- Method: StackInterpreter>>markAndTraceStackPages: (in category 'object memory support') ----- markAndTraceStackPages: fullGCFlag "GC of pages. Throwing away all stack pages on full GC is simple but dangerous because it causes us to allocate lots of contexts immediately before a GC. Reclaiming pages whose top context is not referenced is poor because it would take N incrementalGCs to reclaim N unused pages. Only the page whose top context is not referred to by the bottom context of any other page would be reclaimed. Not until the next GC would the page whose top contect is the previously reclaimed page's base frame's bottom context be reclaimed.
Better is to not mark stack pages until their contexts are encountered. We can eagerly trace the active page and the page reachable from its bottom context if any, and so on. Other pages can be marked when we encounter a married context." | thePage context | <var: #thePage type: #'StackPage *'> <inline: false> self initStackPageGC.
"On an incremental GC simply consider all non-free stack pages to be roots." fullGCFlag ifFalse: [0 to: numStackPages - 1 do: [:i| thePage := stackPages stackPageAt: i. (stackPages isFree: thePage) ifFalse: [thePage trace: 2. self markAndTraceStackPage: thePage]]. ^nil].
+ "On a full GC only eagerly trace pages referenced from + the base of the active page, i.e. on the active stack." - "On a full GC only eagerly trace pages referenced from the active page." stackPage = 0 ifTrue: [^nil]. thePage := stackPage. [thePage trace: 2. self markAndTraceStackPage: thePage. context := self frameCallerContext: thePage baseFP. ((objectMemory isContext: context) and: [(self isMarriedOrWidowedContext: context) and: [self isStillMarriedContext: context]]) ifTrue: [thePage := stackPages stackPageFor: (self frameOfMarriedContext: context). self assert: (stackPages isFree: thePage) not]. + thePage trace < 2] whileTrue! - thePage trace = 0] whileTrue!
Item was added: + ----- Method: StackInterpreter>>printFramesOnStackPageListInUse (in category 'debug printing') ----- + printFramesOnStackPageListInUse + <export: true> + | page | + <inline: false> + <var: #page type: #'StackPage *'> + page := stackPages mostRecentlyUsedPage. + [(stackPages isFree: page) ifFalse: + [self printFramesInPage: page. + self cr]. + (page := page prevPage) ~= stackPages mostRecentlyUsedPage] whileTrue!
Item was changed: ----- Method: StackInterpreter>>setTraceFlagOnContextsFramesPageIfNeeded: (in category 'object memory support') ----- setTraceFlagOnContextsFramesPageIfNeeded: aContext | thePage | + <inline: false> <var: #thePage type: #'StackPage *'> (self isStillMarriedContext: aContext) ifTrue: [thePage := stackPages stackPageFor: (self frameOfMarriedContext: aContext). self assert: (thePage trace between: 0 and: 2). thePage trace = 0 ifTrue: [thePage trace: 1]]!
Item was added: + ----- Method: StackInterpreter>>shortPrintFramesOnStackPageListInUse (in category 'debug printing') ----- + shortPrintFramesOnStackPageListInUse + <export: true> + | page | + <inline: false> + <var: #page type: #'StackPage *'> + page := stackPages mostRecentlyUsedPage. + [(stackPages isFree: page) ifFalse: + [self shortPrintFramesInPage: page. + self cr]. + (page := page prevPage) ~= stackPages mostRecentlyUsedPage] whileTrue!
Item was added: + ----- Method: StackInterpreterSimulator>>stackPages (in category 'simulation only') ----- + stackPages + ^stackPages!
vm-dev@lists.squeakfoundation.org