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

commits at source.squeak.org commits at source.squeak.org
Thu May 4 20:33:54 UTC 2017


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

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

Name: VMMaker.oscog-eem.2208
Author: eem
Time: 4 May 2017, 1:33:09.085365 pm
UUID: 4877be7d-941d-4e15-b6df-4f1b8c7072a8
Ancestors: VMMaker.oscog-eem.2207

Slang: Re previous commit, the arg's declaration can only be removed if it isn't used.  If we elide the decl then its type is lost and field accesses through struct accessors will break.

=============== Diff against VMMaker.oscog-eem.2207 ===============

Item was added:
+ ----- Method: TMethod>>argAssignmentsFor:send:except:in: (in category 'inlining') -----
+ argAssignmentsFor: meth send: aSendNode except: elidedArgs in: aCodeGen
+ 	"Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method."
+ 	"Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals."
+ 
+ 	| stmtList substitutionDict argList |
+ 	meth args size > (argList := aSendNode args) size ifTrue:
+ 		[self assert: (meth args first beginsWith: 'self_in_').
+ 		 argList := {aSendNode receiver}, aSendNode args].
+ 	
+ 	stmtList := OrderedCollection new: argList size.
+ 	substitutionDict := Dictionary new: argList size.
+ 	meth args with: argList do:
+ 		[:argName :exprNode |
+ 		(self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen)
+ 			ifTrue:
+ 				[substitutionDict
+ 					at: argName
+ 					put: (aCodeGen
+ 							node: exprNode
+ 							typeCompatibleWith: argName
+ 							inliningInto: meth
+ 							in: self).
+ 				 locals remove: argName ifAbsent: [self assert: (argName beginsWith: 'self_in_')].
+ 				 declarations removeKey: argName ifAbsent: nil]
+ 			ifFalse: "Add an assignment for anything except an unused self_in_foo argument"
+ 				[(elidedArgs includes: argName) ifFalse:
+ 					[stmtList addLast:
+ 						(TAssignmentNode new
+ 							setVariable: (TVariableNode new setName: argName)
+ 							expression: (aCodeGen
+ 											node: exprNode copy
+ 											typeCompatibleWith: argName
+ 											inliningInto: meth
+ 											in: self))]]].
+ 	meth parseTree: (meth parseTree bindVariablesIn: substitutionDict).
+ 	^stmtList!

Item was removed:
- ----- Method: TMethod>>argAssignmentsFor:send:in: (in category 'inlining') -----
- argAssignmentsFor: meth send: aSendNode in: aCodeGen
- 	"Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method."
- 	"Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals."
- 
- 	| stmtList substitutionDict argList |
- 	meth args size > (argList := aSendNode args) size ifTrue:
- 		[self assert: (meth args first beginsWith: 'self_in_').
- 		 argList := {aSendNode receiver}, aSendNode args].
- 	
- 	stmtList := OrderedCollection new: argList size.
- 	substitutionDict := Dictionary new: argList size.
- 	meth args with: argList do:
- 		[:argName :exprNode | | varNode |
- 		(self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen)
- 			ifTrue:
- 				[substitutionDict
- 					at: argName
- 					put: (aCodeGen
- 							node: exprNode
- 							typeCompatibleWith: argName
- 							inliningInto: meth
- 							in: self).
- 				 locals remove: argName ifAbsent: [self assert: (argName beginsWith: 'self_in_')].
- 				 declarations removeKey: argName ifAbsent: nil]
- 			ifFalse: "Add an assignment for anything except an unused self_in_foo argument"
- 				[varNode := TVariableNode new setName: argName.
- 				 ((argName beginsWith: 'self_in_')
- 				  and: [meth parseTree noneSatisfy: [:node| varNode isSameAs: node]]) ifFalse:
- 					[stmtList addLast:
- 						(TAssignmentNode new
- 							setVariable: varNode
- 							expression: (aCodeGen
- 											node: exprNode copy
- 											typeCompatibleWith: argName
- 											inliningInto: meth
- 											in: self))]]].
- 	meth parseTree: (meth parseTree bindVariablesIn: substitutionDict).
- 	^stmtList!

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 label exitType elidedArgs |
- 	| sel meth methArgs exitLabel inlineStmts label exitType notToBeRenamed |
  	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].
- 		ifTrue:
- 			[notToBeRenamed := {methArgs first}.
- 			 methArgs := methArgs allButFirst]
- 		ifFalse:
- 			[notToBeRenamed := #()].
  	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 renameVarsForInliningInto: self except: notToBeRenamed in: aCodeGen.
  	meth renameLabelsForInliningInto: self.
+ 	self addVarsDeclarationsAndLabelsOf: meth except: elidedArgs.
- 	self addVarsDeclarationsAndLabelsOf: meth except: notToBeRenamed.
  	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: (label := TLabeledCommentNode new setComment: 'begin ', sel);
+ 		addAll: (self argAssignmentsFor: meth send: aSendNode except: elidedArgs in: aCodeGen);
- 		addAll: (self argAssignmentsFor: meth send: aSendNode 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!



More information about the Vm-dev mailing list