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

commits at source.squeak.org commits at source.squeak.org
Fri Nov 10 23:09:56 UTC 2017


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2275.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.2275
Author: eem
Time: 10 November 2017, 3:07:20.900806 pm
UUID: 3eae42a8-dc29-4b23-b794-b910c178a4dc
Ancestors: VMMaker.oscog-cb.2274

Provide a logging facility that uses the Printf package.  See VMClass>>log:with:* for API.  See Slang changes below for support.

Use the logging facility to log scavenges. Each scavenge produces output such as

scavenge 31 eden bytes: 0x2cfaf00/47165184 past bytes: 0x17c618/1558040
	remembered set: 73 redzone: 98304 size: 131072
	tenure below 0x0/0 by age
	survivor bytes: 0x17dd90/1564048 remembered objects: 73 tenured: 0

Slang:
Add the notion of a varargs selector (currently anything ending in printf:, such as f:printf:).  Transform sends of such selectors with a brace of arguments into a varargs call (i.e. include all the arguments in the brace).

When inlining, if the method being inlined is of the form
	guard ifTrue: [...]
and the argument assignments are side-effect free,
and the guard does not refer to the arguments,
push the argument assignments past the guard into the block so that they too are guarded.

=============== Diff against VMMaker.oscog-cb.2274 ===============

Item was changed:
  ----- Method: BraceNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
+ 	"make a CCodeGenerator equivalent of me."
+ 
+ 	"This is for varargs selectors (variants of printf:)"
+ 	(elements notEmpty and: [elements allSatisfy: [:e| e isTemp]]) ifTrue:
+ 		[^elements collect: [:elem| elem asTranslatorNodeIn: aTMethod]].
+ 
+ 	"This is for case statements"
- 	"make a CCodeGenerator equivalent of me"
  	self assert: (elements allSatisfy:
  		[:elem|
  		elem isMessageNode
  		and: [elem selector key = #->
  		and: [elem receiver isBlockNode
  		and: [elem arguments first isBlockNode
  		and: [elem receiver isPotentialCCaseLabelIn: aTMethod]]]]]).
  	^TBraceCaseNode new
  		caseLabels: (elements collect: [:elem| elem receiver asTranslatorNodeIn: aTMethod]);
  		cases: (elements collect: [:elem| elem arguments first asTranslatorNodeIn: aTMethod]);
  		comment: comment!

Item was added:
+ ----- Method: CCodeGenerator class>>isVarargsSelector: (in category 'testing') -----
+ isVarargsSelector: aSymbol
+ 	^aSymbol endsWith: 'printf:'!

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.
  
  	 Expand super nodes in place. Elide sends of halt so that halts can be
  	 sprinkled through the simulator but will be eliminated from the generated C."
  	| 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 == #halt ifTrue: [^rcvrOrNil].
  	(sel == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
  	  or: [sel == #cCode:]) ifTrue:
  		[arguments first isBlockNode ifTrue:
  			[| block |
  			 ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
  				ifTrue: [block statements first]
  				ifFalse: [block]].
  		 (arguments first isLiteralNode
  		 and: [arguments first key isString
  		 and: [arguments first key isEmpty]]) ifTrue:
  			[^arguments first asTranslatorNodeIn: aTMethod]].
  	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].
  	"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 }].
+ 	((CCodeGenerator isVarargsSelector: sel)
+ 	 and: [args last isCollection
+ 	 and: [args last isSequenceable]]) ifTrue:
+ 		[args := args allButLast, args last].
  	^TSendNode new
  		setSelector: sel
  		receiver: rcvrOrNil
  		arguments: args!

Item was changed:
  CogClass subclass: #SpurGenerationScavenger
+ 	instanceVariableNames: 'coInterpreter manager eden futureSpace pastSpace futureSurvivorStart rememberedSet rememberedSetSize previousRememberedSetSize rememberedSetRedZone rememberedSetLimit refCountToShrinkRT weakList ephemeronList tenureCriterion tenureThreshold tenuringClassIndex tenuringProportion numRememberedEphemerons scavengeLog statSurvivorCount statTenures'
- 	instanceVariableNames: 'coInterpreter manager eden futureSpace pastSpace futureSurvivorStart rememberedSet rememberedSetSize previousRememberedSetSize rememberedSetRedZone rememberedSetLimit refCountToShrinkRT weakList ephemeronList tenureCriterion tenureThreshold tenuringClassIndex tenuringProportion numRememberedEphemerons statSurvivorCount statTenures'
  	classVariableNames: ''
  	poolDictionaries: 'SpurMemoryManagementConstants'
  	category: 'VMMaker-SpurMemoryManager'!
  
+ !SpurGenerationScavenger commentStamp: 'eem 11/7/2017 17:26' prior: 0!
- !SpurGenerationScavenger commentStamp: 'eem 9/30/2013 11:05' prior: 0!
  SpurGenerationScavenger is an implementation of David Ungar's Generation Scavenging garbage collection algorithm.  See
  	Generation Scavenging, A Non-disruptive, High-Performance Storage Reclamation Algorithm
  	David Ungar
  	Proceeding
  	SDE 1 Proceedings of the first ACM SIGSOFT/SIGPLAN software engineering symposium on Practical software development environments
  	Pages 157 - 167 
  	ACM New York, NY, USA ©1984 
  
  Also relevant are
  	An adaptive tenuring policy for generation scavengers
  	David Ungar & Frank Jackson
  	ACM Transactions on Programming Languages and Systems (TOPLAS) TOPLAS Homepage archive
  	Volume 14 Issue 1, Jan. 1992 
  	Pages 1 - 27 
  	ACM New York, NY, USA ©1992
  and
  	Ephemerons: a new finalization mechanism
  	Barry Hayes
  	Proceedings of the 12th ACM SIGPLAN conference on Object-oriented programming, systems, languages, and applications
  	Pages 176-183 
  	ACM New York, NY, USA ©1997
  
  See text below the variable definitions and explanation below for a full explanation of weak and ephemeron processing.
  
  Instance Variables
  	coInterpreter:					<StackInterpreterSimulator|CogVMSimulator>
  	eden:							<SpurNewSpaceSpace>
  	ephemeronList:					<Integer|nil>
  	futureSpace:					<SpurNewSpaceSpace>
  	futureSurvivorStart:				<Integer address>
  	manager:						<SpurMemoryManager|Spur32BitMMLESimulator et al>
  	numRememberedEphemerons:	<Integer>
  	pastSpace:						<SpurNewSpaceSpace>
  	previousRememberedSetSize:	<Integer>
  	rememberedSet:				<CArrayAccessor on: Array>
  	rememberedSetSize:			<Integer>
  	tenuringProportion:				<Float>
  	tenuringThreshold:				<Integer address>
  	weakList:						<Integer|nil>
  
  coInterpreter
  	- the interpreter/vm, in this context, the mutator
  
  manager
  	- the Spur memory manager
  
  eden
  	- the space containing newly created objects
  
  futureSpace
  	- the space to which surviving objects are copied during a scavenge
  
  futureSurvivorStart
  	- the allocation pointer into futureSpace
  
  pastSpace
  	- the space surviving objects live in until the next scavenge
  
  rememberedSet
  	- the root old space objects that refer to objects in new space; a scavenge starts form these roots and the interpreter's stack
  
  rememberedSetSize
  	- the size of the remembered set, also the first unused index in the rememberedSet
  
  previousRememberedSetSize:
  	- the size of the remembered set before scavenging objects in future space.
  
  numRememberedEphemerons
  	- the number of unscavenged ephemerons at the front of the rememberedSet.
  
  ephemeronList
  	- the head of the list of corpses of unscavenged ephemerons reached in the current phase
  
  weakList
  	- the head of the list of corpses of weak arrays reached during the scavenge.
  
  tenuringProportion
  	- the amount of pastSpace below which the system will not tenure unless futureSpace fills up, and above which it will eagerly tenure
  
  tenuringThreshold
  	- the pointer into pastSpace below which objects will be tenured
  
  Weakness and Ephemerality in the Scavenger.
  Weak arrays should not hold onto their referents (except from their strong fileds, their named inst vars).  Ephemerons are objects that implement instance-based finalization; attaching an ephemeron to an object keeps that object alive and causes the ephemeron to "fire" when the object is only reachable from the ephemeron (or other ephemerons & weak arrays).  They are a special kind of Associations that detect when their keys are about to die, i.e. when an ephemeron's key is not reachable from the roots except from weak arrays and other ephemerons with about-to-die keys.  Note that if an ephemeron's key is not about to die then references from the rest of the ephemeron can indeed prevent ephemeron keys from dying.
  
  The scavenger is concerned with collecting objects in new space, therefore it ony deals with weak arrays and ephemerons that are either in the remembered set or in new space.  By deferring scanning these objects until other reachable objects have been scavenged, the scavenger can detect dead or dying references.
  
  Weak Array Processing
  In the case of weak arrays this is simple.  The scavenger refuses to scavenge the referents of weak arrays in scavengeReferentsOf: until the entire scavenge is over.  It then scans the weak arrays in the remembered set and in future space and nils all fields in them that are referring to unforwarded objects in eden and past space, because these objects have not survived the scavenge.  The root weak arrays remaining to be scavenged are in the remembered table.  Surviving weak arrays in future space are collected on a list.  The list is threaded through the corpses of weak arrays in eden and/or past space.  weakList holds the slot offset of the first weak array found in eden and/or past space.  The next offset is stored in the weak array corpse's identityHash and format fields (22 bits & 5 bits of allocationUnits, for a max new space size of 2^28 bytes, 256Mb).  The list is threaded throguh corpses, but the surviving arrays are pointed to by the corpses' forwarding pointers.
  
  Ephemeron Processing
  The case of ephemerons is a little more complicated because an ephemeron's key should survive.  The scavenger is cyclical.  It scavenges the remembered set, which may copy and forward surviving objects in past and/or eden spaces to future space.  It then scavenges those promoted objects in future space until no more are promoted, which may in turn remember more objects.  The cycles continue until no more objects get promoted to future space and no more objects get remembered.  At this point all surviving objecta are in futureSpace.
  
+ So if the scavenger does not scan ephemerons in the remembered set or in future space until the scavenger finishes cycling, it can detect ephemerons whose keys are about to die because these will be unforwarded objects in eden and/or past space.  Ephemerons encountered in the remembered set are either processed like ordinary objects if their keys have been promoted to futureSpace, or are moved to the front of the rememberedSet (because, dear reader, it is a sequence) if their keys have not been promoted.  Ephemerons encountered in scavengeReferentsOf: are either scanned like normal objects if their keys have been promoted, or added to the ephemeronList, organized identically to the weakList, if their keys are yet to be promoted.  Since references from other ephemerons with surviving keys to ephemeron keys can and should prevent the ephemerons whose keys they are from firing the scavenger does not fire ephemerons unless all unscavenged ephemerons have unscavenged keys.  So the unsca
 venged ephemerons (they will be at the beginning of the remembered set and on the ephemeronList) are scanned and any that have promoted keys are scavenged.  But if no unscavenged ephemerons have surviving keys then all the unscavenged ephemerons are fired and then scavenged.  This in turn may remember more objects and promote more objects to future space, and encounter more unscavenged ephemerons.  So the scavenger continues until no more objects are remembered, no more objects are promoted to future space and no more unscavenged ephemerons exist.!
- So if the scavenger does not scan ephemerons in the remembered set or in future space until the scavenger finishes cycling, it can detect ephemerons whose keys are about to die because these will be unforwarded objects in eden and/or past space.  Ephemerons encountered in the remembered set are either processed like ordinary objects if their keys have been promoted to futureSpace, or are moved to the front of the rememberedSet (because, dear reader, it is a sequence) if their keys have not been promoted.  Ephemerons encountered in scavengeReferentsOf: are either scanned like normal objects if their keys have been promoted, or added to the ephemeronList, organized identically to the weakList, if their keys are yet to be promoted.  Since references from other ephemerons with surviving keys to ephemeron keys can and should prevent the ephemerons whose keys they are from firing the scavenger does not fire ephemerons unless all unscavenged ephemerons have unscavenged keys.  So the unsca
 venged ephemerons (the will be at the beginning of the remembered set and on the ephemeronList) are scanned and any that have promoted keys are scavenged.  But if no unscavenged ephemerons have surviving keys then all the unscavenged ephemerons are fired and then scavenged.  This in turn may remember more objects and promote more objects to future space, and encounter more unscavenged ephemerons.  So the scavenger continues until no more objects are remembered, no more objects are promoted to future space and no more unscavenged ephemerons exist.!

Item was changed:
  ----- Method: SpurGenerationScavenger class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	#(eden futureSpace pastSpace) do:
  		[:var| aCCodeGenerator var: var type: #SpurNewSpaceSpace].
+ 	aCCodeGenerator
+ 		var: #rememberedSet type: #'sqInt *';
+ 		var: #tenuringProportion type: #double;
+ 		var: #scavengeLog type: #'FILE *'!
- 	aCCodeGenerator var: #rememberedSet type: #'sqInt *'.
- 	aCCodeGenerator var: #tenuringProportion type: #double!

Item was added:
+ ----- Method: SpurGenerationScavenger>>logEndScavenge (in category 'logging') -----
+ logEndScavenge
+ 	<inline: #always>
+ 	self log: '	survivor bytes: 0x%lx/%ld remembered objects: %ld tenured: %ld\n'
+ 		with: futureSurvivorStart - pastSpace start
+ 		with: futureSurvivorStart - pastSpace start
+ 		with: rememberedSetSize
+ 		with: statTenures;
+ 		flushLog!

Item was added:
+ ----- Method: SpurGenerationScavenger>>logStartScavenge (in category 'logging') -----
+ logStartScavenge
+ 	<inline: #always>
+ 	self log: 'scavenge %ld eden bytes: 0x%lx/%ld past bytes: 0x%lx/%ld\n\tremembered set: %ld redzone: %ld size: %ld\n'
+ 		with: manager statScavenges
+ 		with: manager freeStart - eden start
+ 		with: manager freeStart - eden start
+ 		with: manager pastSpaceStart - pastSpace start
+ 		with: manager pastSpaceStart - pastSpace start
+ 		with: rememberedSetSize
+ 		with: rememberedSetRedZone
+ 		with: rememberedSetLimit!

Item was added:
+ ----- Method: SpurGenerationScavenger>>logStream (in category 'logging') -----
+ logStream
+ 	<inline: #always>
+ 	^scavengeLog!

Item was added:
+ ----- Method: SpurGenerationScavenger>>logTenuringPolicy (in category 'logging') -----
+ logTenuringPolicy
+ 	<inline: #always>
+ 	| policyNames |
+ 	<var: 'policyNames' declareC: 'static char *policyNames[] = {"", "by age", "by class", "to shrink rt", "don''t tenure", "mark on tenure"}'>
+ 	self cCode: []
+ 		inSmalltalk: [policyNames := CLiteralArray on: #('' 'by age' 'by class' 'to shrink rt' 'don''t tenure' 'mark on tenure')].
+ 	self log: (tenureCriterion = TenureToShrinkRT ifFalse: ['	tenure below 0x%lx/%ld %s\n'] ifTrue: ['	tenure below 0x%lx/%ld %s refct %ld\n'])
+ 		with: ((tenureCriterion = TenureByAge and: [tenureThreshold > pastSpace start]) ifTrue: [tenureThreshold - pastSpace start] ifFalse: [0])
+ 		with: ((tenureCriterion = TenureByAge and: [tenureThreshold > pastSpace start]) ifTrue: [tenureThreshold - pastSpace start] ifFalse: [0])
+ 		with: (policyNames at: tenureCriterion)
+ 		with: refCountToShrinkRT!

Item was added:
+ ----- Method: SpurGenerationScavenger>>openScavengeLog (in category 'logging') -----
+ openScavengeLog
+ 	<api>
+ 	scavengeLog := self f: 'scavenge.log' open: 'a+'!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavenge: (in category 'scavenger') -----
  scavenge: tenuringCriterion
  	"The main routine, scavenge, scavenges young objects reachable from the roots (the stack zone
  	 and the rememberedTable).  It first scavenges the new objects immediately reachable from old
  	 ones (all in the remembered table), then the stack zone.  Then it scavenges those that are
  	 transitively reachable.  If this results in a promotion, the promotee gets remembered, and it first
  	 scavenges objects adjacent to the promotee, then scavenges the ones reachable from the
  	 promoted.  This loop continues until no more reachable objects are left.  At that point,
  	 pastSurvivorSpace is exchanged with futureSurvivorSpace.  Then any surviving weakArrays and
  	 weakArrays in the remembered set can be processed and their dead elements nilled.
  
  	 By default promotion (tenuring) is based on age and ammount of objects scavenged.  But
  	 tenuring can be based on e.g. a particular class.  The argument selects the tenuring criterion.
  
  	 Answer the limit of pastSpace, to allow the memory manager to bounds check survivors."
  	statSurvivorCount := 0.
  	tenureCriterion := tenuringCriterion.
+ 	self logStartScavenge.
  	self strategizeToLimitRememberedTable.
+ 	self logTenuringPolicy.
  	self scavengeLoop.
  	self processWeaklings.
  	self computeTenuringThreshold.
  	self exchangeSurvivorSpaces.
+ 	self logEndScavenge.
  	^self initFutureSpaceStart!

Item was added:
+ ----- Method: SpurMemoryManager>>pastSpaceStart (in category 'accessing') -----
+ pastSpaceStart
+ 	<cmacro: '() GIV(pastSpaceStart)'>
+ 	^pastSpaceStart!

Item was changed:
  ----- Method: TMethod>>inferReturnTypeFromReturnsIn: (in category 'type inference') -----
  inferReturnTypeFromReturnsIn: aCodeGen
  	"Attempt to infer the return type of the receiver from returns in the parse tree."
  
  	"this for determining which returns have which return types:"
  	"aCodeGen
  		pushScope: declarations
  		while: [parseTree
  				nodesSelect: [:n| n isReturn]
  				thenCollect: [:n| | s |
  					s := Set new.
  					self addTypesFor: n expression to: s in: aCodeGen.
  					{n. s}]]"
  			
  	aCodeGen maybeBreakForTestToInline: selector in: self.
  	returnType ifNotNil: [^self].
  	aCodeGen
  		pushScope: declarations
  		while:
  			[| hasReturn returnTypes |
  			 hasReturn := false.
  			 returnTypes := Set new.
  			 "Debug:
  			 (| rettypes |
  			  rettypes := Dictionary new.
  			  parseTree nodesDo:
  				[:node|
  				node isReturn ifTrue:
  					[| types |
  					 self addTypesFor: node expression to: (types := Set new) in: aCodeGen.
  					 rettypes at: node expression put: types]].
  			  rettypes)"
  			 parseTree nodesDo:
  				[:node|
  				node isReturn ifTrue:
  					[hasReturn := true.
  					 "If we encounter a send of an as-yet-untyped method then abort,
  					  retrying and computing the type when that method is fully typed."
  					 (self addTypesFor: node expression to: returnTypes in: aCodeGen) ifTrue:
  						[^self]]].
  			returnTypes remove: #implicit ifAbsent: [].
  			returnTypes := aCodeGen harmonizeReturnTypesIn: returnTypes.
  			hasReturn
  				ifTrue:
  					[returnTypes size > 1 ifTrue:
  						[| message |
  						 message := String streamContents:
  										[:s|
  										 s nextPutAll: 'conflicting return types '.
  										 returnTypes
  											do: [:t| s nextPutAll: t]
  											separatedBy: [s nextPutAll: ', '].
  										 s nextPutAll: ' in '; nextPutAll: selector; cr].
  						 Notification signal: message.
+ 						 aCodeGen logger ensureCr; show: message].
- 						 aCodeGen logger show: message].
  					 returnTypes size = 1 ifTrue:
  						[self returnType: returnTypes anyOne]]
  				ifFalse:
  					[self returnType: (aCodeGen implicitReturnTypeFor: selector)]]!

Item was changed:
  ----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') -----
  inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen
  	"Answer a collection of statements to replace the given send.  directReturn indicates
  	 that the send is the expression in a return statement, so returns can be left in the
  	 body of the inlined method. If exitVar is nil, the value returned by the send is not
  	 used; thus, returns need not assign to the output variable.
  
  	 Types are propagated to as-yet-untyped variables when inlining a send that is assigned,
  	 otherwise the assignee variable type must match the return type of the inlinee.  Return
  	 types are not propagated."
  
+ 	| sel meth methArgs exitLabel inlineStmts exitType elidedArgs argAssignments conditional |
- 	| sel meth methArgs exitLabel inlineStmts label exitType elidedArgs |
  	sel := aSendNode selector.
  	meth := aCodeGen methodNamed: sel.
  	methArgs := meth args.
  	"convenient for debugging..."
  	aCodeGen maybeBreakForInlineOf: aSendNode in: self.
  	elidedArgs := #().
  	(methArgs notEmpty and: [methArgs first beginsWith: 'self_in_'])
  		ifTrue: "If the first arg is not used we can and should elide it."
  			[| varNode |
  			 varNode := TVariableNode new setName: methArgs first.
  			 (meth parseTree noneSatisfy: [:node| varNode isSameAs: node]) ifTrue:
  				[elidedArgs := {methArgs first}].
  			 methArgs := methArgs allButFirst].
  	methArgs size = aSendNode args size ifFalse:
  		[^nil].
  	meth := meth copy.
  
  	(meth statements size > 1
  	 and: [meth statements first isSend
  	 and: [meth statements first selector == #flag:]]) ifTrue:
  		[meth statements removeFirst].
  
  	"Propagate the return type of an inlined method"
  	(directReturn or: [exitVar notNil]) ifTrue:
  		[exitType := directReturn 
  						ifTrue: [returnType] 
  						ifFalse: [(self typeFor: exitVar in: aCodeGen) ifNil: [#sqInt]].
  		(exitType = #void or: [exitType = meth returnType]) ifFalse:
  			[meth propagateReturnIn: aCodeGen]].
  
  	"Propagate any unusual argument types to untyped argument variables"
  	methArgs
  		with: aSendNode args
  		do: [:formal :actual|
  			(meth declarationAt: formal ifAbsent: nil) ifNil:
  				[(self typeFor: actual in: aCodeGen) ifNotNil:
  					[:type|
  					type ~= #sqInt ifTrue:
  						[meth declarationAt: formal put: (type last = $* ifTrue: [type, formal] ifFalse: [type, ' ', formal])]]]].
  
  	meth renameVarsForInliningInto: self except: elidedArgs in: aCodeGen.
  	meth renameLabelsForInliningInto: self.
  	self addVarsDeclarationsAndLabelsOf: meth except: elidedArgs.
  	meth hasReturn ifTrue:
  		[directReturn ifFalse:
  			[exitLabel := self unusedLabelForInliningInto: self.
  			 (meth exitVar: exitVar label: exitLabel) "is label used?"
  				ifTrue: [ labels add: exitLabel ]
  				ifFalse: [ exitLabel := nil ]]].
  	(inlineStmts := OrderedCollection new: meth statements size + meth args size + 2)
+ 		add: (TLabeledCommentNode new setComment: 'begin ', sel).
+ 	argAssignments := self argAssignmentsFor: meth send: aSendNode except: elidedArgs in: aCodeGen.
+ 	"If the method being inlined is of the form
+ 		guard ifTrue: [...]
+ 	 and the argument assignments have no side effects,
+ 	 and guard does not refer to the arguments,
+ 	 push the argument assignments past the guard into the block so that they too are guarded."
+ 	(meth statements size = 1
+ 	 and: [(conditional := meth statements first) isConditionalSend
+ 	 and: [conditional numArgs = 1
+ 	 and: [(argAssignments noneSatisfy: [:assign| assign expression hasSideEffect])
+ 	 and: [conditional receiver noneSatisfy: [:node| node isVariable and: [methArgs includes: node name]]]]]])
+ 		ifTrue: [conditional args first statements addAllFirst: argAssignments]
+ 		ifFalse: [inlineStmts addAll: argAssignments].
+ 	inlineStmts addAll: meth statements.  "method body"
- 		add: (label := TLabeledCommentNode new setComment: 'begin ', sel);
- 		addAll: (self argAssignmentsFor: meth send: aSendNode except: elidedArgs in: aCodeGen);
- 		addAll: meth statements.  "method body"
  	directReturn ifTrue:
  		[meth endsWithReturn
  			ifTrue:
  				[exitVar ifNotNil: "don't remove the returns if being invoked in the context of a return"
  					[inlineStmts at: inlineStmts size put: inlineStmts last copyWithoutReturn]]
  			ifFalse:
  				[inlineStmts add:
  					(TReturnNode new setExpression: (TVariableNode new setName: 'nil'))]].
  	exitLabel ifNotNil:
  		[inlineStmts add:
  			(TLabeledCommentNode new setLabel:
  				exitLabel comment: 'end ', meth selector)].
  	inlineStmts size = 1 ifTrue: "Nuke empty methods; e.g. override of flushAtCache"
  		[self assert: inlineStmts first isComment.
  		 inlineStmts removeFirst].
  	^inlineStmts!

Item was added:
+ ----- Method: VMClass>>f:open: (in category 'printf logging') -----
+ f: logFilename open: mode
+ 	"Simulate a FILE stream by answering a transcript.
+ 	 Can be used with the log:* methods."
+ 	<doNotGenerate>
+ 	^true
+ 		ifTrue: [(TranscriptStream on: (String new: 100000))
+ 					openLabel: logFilename;
+ 					yourself]
+ 		ifFalse: [self coInterpreter transcript]!

Item was added:
+ ----- Method: VMClass>>flushLog (in category 'printf logging') -----
+ flushLog
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self cCode: [self logStream fflush] inSmalltalk: [self logStream flush]]!

Item was added:
+ ----- Method: VMClass>>log: (in category 'printf logging') -----
+ log: printfString
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[printfString fprintf: self logStream]!

Item was added:
+ ----- Method: VMClass>>log:with: (in category 'printf logging') -----
+ log: printfString with: anArgument
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self logStream f: printfString printf: {anArgument}]!

Item was added:
+ ----- Method: VMClass>>log:with:with: (in category 'printf logging') -----
+ log: printfString with: aArgument with: bArgument
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self logStream f: printfString printf: {aArgument. bArgument}]!

Item was added:
+ ----- Method: VMClass>>log:with:with:with: (in category 'printf logging') -----
+ log: printfString with: aArgument with: bArgument with: cArgument
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self logStream f: printfString printf: {aArgument. bArgument. cArgument}]!

Item was added:
+ ----- Method: VMClass>>log:with:with:with:with: (in category 'printf logging') -----
+ log: printfString with: aArgument with: bArgument with: cArgument with: dArgument
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self logStream f: printfString printf: {aArgument. bArgument. cArgument. dArgument}]!

Item was added:
+ ----- Method: VMClass>>log:with:with:with:with:with: (in category 'printf logging') -----
+ log: printfString with: aArgument with: bArgument with: cArgument with: dArgument with: eArgument
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self logStream f: printfString printf: {aArgument. bArgument. cArgument. dArgument. eArgument}]!

Item was added:
+ ----- Method: VMClass>>log:with:with:with:with:with:with: (in category 'printf logging') -----
+ log: printfString with: aArgument with: bArgument with: cArgument with: dArgument with: eArgument with: fArgument
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self logStream f: printfString printf: {aArgument. bArgument. cArgument. dArgument. eArgument. fArgument}]!

Item was added:
+ ----- Method: VMClass>>log:with:with:with:with:with:with:with: (in category 'printf logging') -----
+ log: printfString with: aArgument with: bArgument with: cArgument with: dArgument with: eArgument with: fArgument with: gArgument
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self logStream f: printfString printf: {aArgument. bArgument. cArgument. dArgument. eArgument. fArgument. gArgument}]!

Item was added:
+ ----- Method: VMClass>>log:with:with:with:with:with:with:with:with: (in category 'printf logging') -----
+ log: printfString with: aArgument with: bArgument with: cArgument with: dArgument with: eArgument with: fArgument with: gArgument with: hArgument
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self logStream f: printfString printf: {aArgument. bArgument. cArgument. dArgument. eArgument. fArgument. gArgument. hArgument}]!

Item was added:
+ ----- Method: VMClass>>log:withArgs: (in category 'printf logging') -----
+ log: printfString withArgs: arguments
+ 	"Log via printf-style format strings.  Subclasses must implement logStream to answer their log stream/file."
+ 	<inline: #always>
+ 	self logStream ifNotNil:
+ 		[self logStream f: printfString printf: arguments]!



More information about the Vm-dev mailing list