[Vm-dev] VM Maker: VMMaker.oscog-eem.496.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Nov 2 20:00:45 UTC 2013 

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!

More information about the Vm-dev mailing list