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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 29 04:00:08 UTC 2015


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

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

Name: VMMaker.oscog-eem.1481
Author: eem
Time: 28 September 2015, 8:58:19.086 pm
UUID: b3ce7300-4547-4a6d-be81-4c9d121a4d31
Ancestors: VMMaker.oscog-eem.1480

Slang:
Propagate types of actuals with other than the default sqInt type to untyped formals, hence fixing bogus inlining of genLoadHeaderIntoNewInstance: into genGetActiveContextLarge:inBlock:.

Fix baaaad bug in node:typeCompatibleWith:inliningInto:in: which was looking up the type of the formal parameter in inlining in the target method, not the method being inlined! (bug surfaced by previous fix).

Allow constant elimination for Const ifNil: [] ifNotNil: [], hence cleaning up uses of characterTable in the Spur VMs.

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

Item was changed:
  ----- Method: CCodeGenerator>>nilOrBooleanConstantReceiverOf: (in category 'utilities') -----
  nilOrBooleanConstantReceiverOf: aNode
  	"Answer nil or the boolean constant that is the receiver of the given message send.
  	 Used to suppress conditional code when the condition is a translation-time constant."
  
  	| val receiver argument |
  	generateDeadCode ifTrue:[^nil].
  	((self isConstantNode: aNode valueInto: [:v| val := v])
  	 and: [#(true false) includes: val]) ifTrue:
  		[^val].
  	aNode isSend ifTrue:
  		[aNode selector == #not ifTrue:
  			[(self nilOrBooleanConstantReceiverOf: aNode receiver) ifNotNil:
  				[:bool| ^bool not]].
  		 ((#(isNil notNil) includes: aNode selector)
  		  and: [self isNilConstantReceiverOf: aNode]) ifTrue:
  			[^aNode selector == #isNil].
  		 ((#(or: and:) includes: aNode selector)
  		 and: [aNode args last isStmtList
  		 and: [aNode args last statements size = 1]]) ifTrue:
  			[(self nilOrBooleanConstantReceiverOf: aNode receiver) ifNotNil:
  				[:rcvr|
  				((rcvr == false and: [aNode selector == #and:])
  				 or: [rcvr == true and: [aNode selector == #or:]]) ifTrue:
  					[^rcvr].
  				(self nilOrBooleanConstantReceiverOf: aNode args last statements first) ifNotNil:
  					[:arg|
  					^rcvr perform: aNode selector with: [arg]]].
  			 "We can also eliminate expr and: [false], but only if expr is side-effect free.
  			  This is a weak test; we don't traverse calls.  Caveat emptor!!"
  			 (aNode selector == #and:
  			  and: [(aNode receiver noneSatisfy: [:node| node isAssignment]) "No side-effects in the elided expression"
  			  and: [aNode args last statements size = 1]]) ifTrue:
  				[(self nilOrBooleanConstantReceiverOf: aNode args last statements first) ifNotNil:
  					[:arg|
  					arg ifFalse:
  						[^arg]]]].
  		 ((#(= ~= < > <= >=) includes: aNode selector)
  		  and: [(self isConstantNode: aNode receiver valueInto: [:v| receiver := v])
  		  and: [receiver isInteger
  		  and: [(self isConstantNode: aNode args first valueInto: [:v| argument := v])
  		  and: [argument isInteger]]]]) ifTrue:
+ 			[^receiver perform: aNode selector with: argument].
+ 		 "Inlining for e.g. CharacterTable ifNil: [...] ifNotNil: [...]], which compiles to CharacterTable == nil ifTrue: [...] ifFalse: [...]"
+ 		( aNode selector == #==
+ 		 and: [aNode args first isVariable
+ 		 and: [aNode args first name = 'nil'
+ 		 and: [aNode receiver isConstant
+ 		 and: [aNode receiver value == nil]]]]) ifTrue:
+ 			[^true]].
- 			[^receiver perform: aNode selector with: argument]].
  	^nil!

Item was changed:
  ----- Method: CCodeGenerator>>node:typeCompatibleWith:inliningInto:in: (in category 'inlining') -----
+ node: exprNode typeCompatibleWith: argName inliningInto: targetMethod in: aTMethod
- node: exprNode typeCompatibleWith: argName inliningInto: inlineSelector in: aTMethod
  	"Answer either exprNode or, if required, a cast of exprNode to the type of argName.
  	 The cast is required if
  		- argName is typed and exprNode is untyped
  		- argName is untyped and exprNode is an arithmetic type of size > #sqInt
  		- both argName and exprNode are typed but they are incompatible"
  	| formalType actualType |
+ 	formalType := targetMethod typeFor: argName in: self.
- 	formalType := aTMethod typeFor: argName in: self.
  	actualType := self typeFor: exprNode in: aTMethod.
  	^((exprNode isSend or: [exprNode isVariable])
  	   and: [(formalType notNil and: [actualType isNil])
  			or: [(formalType isNil and: [actualType notNil and: [(self isIntegralCType: actualType) and: [(self sizeOfIntegralCType: actualType) > (self sizeOfIntegralCType: #sqInt)]]])
  			or: [(self variableOfType: formalType acceptsValue: exprNode ofType: actualType) not]]])
  		ifTrue: [self nodeToCast: exprNode to: (formalType ifNil: [#sqInt])]
  		ifFalse:
  			[((exprNode isSend or: [exprNode isVariable])
  			  and: [(self
  					variableOfType: (self typeFor: exprNode in: aTMethod)
  					acceptsValue: exprNode
+ 					ofType: (targetMethod typeFor: argName in: self)) not]) ifTrue:
- 					ofType: (aTMethod typeFor: argName in: self)) not]) ifTrue:
  				[logger
  					nextPutAll:
+ 						'type mismatch for formal ', argName, ' and actual "', exprNode asString,
+ 						'" when inlining ', targetMethod selector, ' in ', aTMethod selector, '. Use a cast.';
- 						'type mismatch for formal ', argName, ' and actual ', exprNode asString,
- 						' when inlining ', inlineSelector, ' in ', aTMethod selector, '. Use a cast.';
  					cr; flush]. 
  			exprNode]!

Item was changed:
  ----- 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 |
  		(self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen)
  			ifTrue:
  				[substitutionDict
  					at: argName
  					put: (aCodeGen
  							node: exprNode
  							typeCompatibleWith: argName
+ 							inliningInto: meth
- 							inliningInto: meth selector
  							in: self).
  				 locals remove: argName]
  			ifFalse:
  				[stmtList addLast:
  					(TAssignmentNode new
  						setVariable: (TVariableNode new setName: argName)
  						expression: (aCodeGen
  										node: exprNode copy
  										typeCompatibleWith: argName
+ 										inliningInto: meth
- 										inliningInto: meth selector
  										in: self))]].
  	meth parseTree: (meth parseTree bindVariablesIn: substitutionDict).
  	^stmtList!

Item was added:
+ ----- Method: TMethod>>declarationAt:ifAbsent: (in category 'accessing') -----
+ declarationAt: aVariableName ifAbsent: absentBlock
+ 	^declarations at: aVariableName ifAbsent: absentBlock!

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 |
  	sel := aSendNode selector.
  	meth := aCodeGen methodNamed: sel.
  	methArgs := meth args.
  	"convenient for debugging..."
  	aCodeGen maybeBreakForInlineOf: aSendNode in: self.
  	(methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue:
  		[methArgs := methArgs allButFirst].
  	methArgs size = aSendNode args size ifFalse:
  		[^nil].
  	meth := meth copy.
  
  	"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, ' ', formal]]]].
+ 
  	meth renameVarsForInliningInto: self except: #() in: aCodeGen.
  	meth renameLabelsForInliningInto: self.
  	self addVarsDeclarationsAndLabelsOf: meth except: #().
  	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: 100)
  		add: (label := TLabeledCommentNode new setComment: 'begin ', sel);
  		addAll: (self argAssignmentsFor: meth send: aSendNode in: aCodeGen);
  		addAll: meth statements.  "method body"
  	(directReturn
  	 and: [meth endsWithReturn not]) ifTrue:
  		[inlineStmts add:
  			(TReturnNode new setExpression: (TVariableNode new setName: 'nil'))].
  	exitLabel ~= nil ifTrue:
  		[inlineStmts add:
  			(TLabeledCommentNode new setLabel:
  				exitLabel comment: 'end ', meth selector)].
  	^inlineStmts!

Item was changed:
  ----- Method: VMStructType class>>getter:bitPosition:bitWidth:type: (in category 'code generation') -----
  getter: getter bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
  	^String streamContents:
+ 		[:s| | startByte endByte alignedPowerOf2 shift |
- 		[:s| | startByte endByte alignedPowerOf2 shift bool |
  		startByte := bitPosition // 8.
  		endByte := bitPosition + bitWidth - 1 // 8.
  		shift := bitPosition \\ 8.
  		alignedPowerOf2 := (#(8 16 32 64) includes: bitWidth) and: [shift = 0].
  		s nextPutAll: getter; crtab: 1.
  		(typeOrNil notNil and: [typeOrNil last = $*]) ifTrue:
  			[s nextPutAll: '| v |'; crtab: 1].
  		s nextPut: $^.
  		typeOrNil ifNotNil:
  			[s nextPut: $(.
  			 typeOrNil last = $* ifTrue:
  				[s nextPutAll: 'v := ']].
  		alignedPowerOf2 ifFalse:
  			[s nextPut: $(].
  		shift ~= 0 ifTrue:
  			[s nextPut: $(].
  		s nextPutAll: 'memory unsigned';
  		   nextPutAll: (#('Byte' 'Short' 'Long' 'Long')
  							at: endByte - startByte + 1
+ 							ifAbsent: ['Long64']);
- 							ifAbsent: ['LongLong']);
  		  nextPutAll: 'At: address + '; print: startByte + 1.
  		(self offsetForInstVar: getter) ifNotNil:
  			[:offsetExpr| s nextPutAll: ' + '; nextPutAll: offsetExpr].
  		shift ~= 0 ifTrue:
  			[s nextPutAll: ') bitShift: -'; print: shift].
  		alignedPowerOf2 ifFalse:
  			[s nextPutAll: ') bitAnd: '; nextPutAll: ((1 << bitWidth) - 1) hex].
  		typeOrNil ifNotNil:
  			[s nextPutAll: ') ~= 0'.
  			typeOrNil last = $* ifTrue:
  				[s nextPutAll: ' ifTrue:';
  					crtab: 2;
  					nextPutAll: '[cogit cCoerceSimple: v to: ';
  					store: typeOrNil;
  					nextPut: $]]]]!

Item was changed:
  ----- Method: VMStructType class>>setter:bitPosition:bitWidth:type: (in category 'code generation') -----
  setter: getter bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
  	^String streamContents:
  		[:s| | startByte endByte shift alignedPowerOf2 accessor mask expr |
  		startByte := bitPosition // 8.
  		endByte := bitPosition + bitWidth - 1 // 8.
  		shift := bitPosition \\ 8.
  		alignedPowerOf2 := (#(8 16 32 64) includes: bitWidth) and: [shift = 0].
  		accessor := 'unsigned'
  					, (#('Byte' 'Short' 'Long' 'Long')
  							at: endByte - startByte + 1
+ 							ifAbsent: ['Long64'])
- 							ifAbsent: ['LongLong'])
  					, 'At: address + '.
  		(self offsetForInstVar: getter) ifNotNil:
  			[:offsetExpr| accessor := accessor, offsetExpr, ' + '].
  		mask := #(16rFF 16rFFFF 16rFFFFFFFF 16rFFFFFFFF)
  						at: endByte - startByte + 1
  						ifAbsent: [(2 raisedTo: 64) - 1].
  		s nextPutAll: getter; nextPutAll: ': aValue'.
  		(typeOrNil notNil or: [alignedPowerOf2]) ifFalse:
  			[s crtab: 1; nextPutAll: 'self assert: (aValue between: 0 and: '; nextPutAll:  ((1 << bitWidth) - 1) hex; nextPutAll: ').'].
  		s crtab: 1.
  		alignedPowerOf2 ifTrue:
  			[s nextPut: $^].
  		s nextPutAll: 'memory';
  		  crtab: 2; nextPutAll: accessor; print: startByte + 1.
  		s crtab: 2; nextPutAll: 'put: '.
  		typeOrNil ifNotNil:
  			[s nextPut: $(].
  		alignedPowerOf2 ifFalse:
  			[s nextPutAll: '((memory '; nextPutAll: accessor; print: startByte + 1;
  			    nextPutAll: ') bitAnd: '; nextPutAll: (mask - ((1 << bitWidth - 1) << shift)) hex;
  			    nextPutAll: ') + '].
  		expr := typeOrNil caseOf: {
  						[nil] -> ['aValue'].
  						[#Boolean] -> ['(aValue ifTrue: [1] ifFalse: [0])'] }
  					otherwise: ['(aValue ifNotNil: [aValue asUnsignedInteger] ifNil: [0])'].
  		shift = 0
  			ifTrue:
  				[s nextPutAll: expr]
  			ifFalse:
  				[s nextPut: $(; nextPutAll: expr; nextPutAll: ' bitShift: '; print: shift; nextPut: $)].
  		typeOrNil notNil ifTrue:
  			[s nextPut: $)].
  		alignedPowerOf2 ifFalse:
  			[s nextPut: $.; crtab: 1; nextPutAll: '^aValue']]!



More information about the Vm-dev mailing list