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

commits at source.squeak.org commits at source.squeak.org
Thu Aug 16 01:44:23 UTC 2018

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:

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

Name: VMMaker.oscog-eem.2430
Author: eem
Time: 15 August 2018, 6:43:58.396178 pm
UUID: 4966a4b7-293a-4911-8f2d-396a7b97d82a
Ancestors: VMMaker.oscog-eem.2429

Send asTranslationMethodOfClass: to  CompiledMethods dirctly, allowing CompiledMehtod to choose between Smalltalk-80 parse trees and RefactoringBrowser parse trees.

Add a simple test for the Slang conversion to C

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

Item was changed:
  ----- Method: AssignmentNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of me"
- 	"make a CCodeGenerator equivalent of me"
  	| varNode valueNode |
  	varNode := variable asTranslatorNodeIn: aTMethod.
  	valueNode := value asTranslatorNodeIn: aTMethod.
  	valueNode isStmtList ifFalse:
  		[^TAssignmentNode new
  			setVariable: varNode
  			expression: valueNode;
  			comment: comment].
  	 "This is a super expansion.  We are in trouble if any statement other than the last is a return."
  	(self anyReturns: valueNode statements allButLast) ifTrue:
  		[self error: 'haven''t implemented pushing down assignments into other than the last return'].
  	"As of 6/25/2012 19:30 superExpansionNodeFor:args: elides the final return."
  	self assert: valueNode statements last isReturn not.
  	^TStmtListNode new
  		setStatements: valueNode statements allButLast,
  					{ TAssignmentNode new
  						setVariable: varNode
  						expression: valueNode statements last;
  						comment: comment };

Item was changed:
  ----- Method: BlockNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of me"
- 	"make a CCodeGenerator equivalent of me"
  	| statementList |
  	statementList := OrderedCollection new.
  	statements do:
  		[:s | | newS |
  		 newS := s asTranslatorNodeIn: aTMethod.
  		 "inline the statement list returned when a CascadeNode is translated and/or when ifNotNil: is transformed"
  		 newS isStmtList
  			ifTrue:  [statementList addAll: newS statements]
  			ifFalse: [statementList add: newS]].
  	^TStmtListNode new
  		setArguments: (arguments asArray collect: [:arg | arg key])
  		statements: statementList;
  		comment: comment!

Item was changed:
  ----- Method: BraceNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of me."
- 	"make a CCodeGenerator equivalent of me."
  	"This is for case statements"
  	(elements allSatisfy: [:elem| elem isMessageNode and: [elem selector key = #->]]) ifTrue:
  		[self assert: (elements allSatisfy:
  			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].
  	"This is for varargs selectors (variants of printf:)"
  	^elements collect: [:elem| elem asTranslatorNodeIn: aTMethod]!

Item was changed:
  ----- Method: CCodeGenerator>>compileToTMethodSelector:in: (in category 'utilities') -----
  compileToTMethodSelector: selector in: aClass
  	"Compile a method to a TMethod"
+ 	^(aClass >> selector) asTranslationMethodOfClass: self translationMethodClass
+ 	"was:
  	| implementingClass |
  	implementingClass := aClass.
  	^(Compiler new
  		parse: ([aClass sourceCodeAt: selector]
  					on: KeyNotFound
+ 					do: [:ex| ""Quick hack for simulating Pharo images...""
- 					do: [:ex| "Quick hack for simulating Pharo images..."
  						(PharoVM and: [aClass == String class and: [selector == #findSubstringViaPrimitive:in:startingAt:matchTable:]]) ifFalse:
  							[ex pass].
+ 						(implementingClass := ByteString) sourceCodeAt: #findSubstring:in:startingAt:matchTable:])
- 						(implementingClass :=  ByteString) sourceCodeAt: #findSubstring:in:startingAt:matchTable:])
  		in: implementingClass
  		notifying: nil)
+ 			asTranslationMethodOfClass: self translationMethodClass"!
- 			asTranslationMethodOfClass: self translationMethodClass!

Item was changed:
  ----- Method: CCodeGenerator>>initializerForInstVar:in: (in category 'inlining') -----
  initializerForInstVar: varName in: aClass
  	| instVarIndex |
  	instVarIndex := aClass instVarIndexFor: varName ifAbsent: [^nil].
  	aClass selectorsAndMethodsDo:
  		[:s :m| | tmeth |
  		((s beginsWith: 'initialize')
  		 and: [m writesField: instVarIndex]) ifTrue:
+ 			[tmeth := m asTranslationMethodOfClass: TMethod.
- 			[tmeth := m methodNode asTranslationMethodOfClass: TMethod.
  			 tmeth parseTree nodesDo:
  				[:node| | exprOrAssignment |
  				(node isAssignment
  				 and: [node variable name = varName]) ifTrue:
  					[exprOrAssignment := node.
  					 [exprOrAssignment isAssignment] whileTrue:
  						[exprOrAssignment := exprOrAssignment expression].

Item was changed:
  ----- Method: CascadeNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of me."
- 	"make a CCodeGenerator equivalent of me."
  	^TStmtListNode new
  		setArguments: #()
  			(Array streamContents:
  				[:s| | receiverNode |
  				receiverNode := receiver asTranslatorNodeIn: aTMethod.
  				"don't expand the receiver if it is a send to get an implicit receiver,
  				 e.g self interpreter printHex: oop => printHex(oop), /not/ printHex(cascade0,oop)."
  				(receiverNode isSend and: [aTMethod definingClass isNonArgumentImplicitReceiverVariableName: receiverNode selector]) ifTrue:
  					[receiverNode := TVariableNode new setName: receiverNode selector].
  				receiverNode isLeaf ifFalse:
  					[| varNode |
  					 varNode := aTMethod newCascadeTempFor: receiverNode.
  					 s nextPut: (TAssignmentNode new
  								setVariable: varNode
  								expression: receiverNode).
  					receiverNode := varNode].
  				messages do:
  					[ :msg | s nextPut: ((msg asTranslatorNodeIn: aTMethod) receiver: receiverNode)]]);
  		comment: comment!

Item was added:
+ ----- Method: CompiledMethod>>asTranslationMethodOfClass: (in category '*VMMaker-C translation') -----
+ asTranslationMethodOfClass: aTMethodClass
+  	"Answer a TMethod (or subclass) derived from the receiver."
+ 	^((CompiledMethod includesSelector: #ast)
+ 			ifTrue: [self ast] "Pharo Opal Bytecode Compiler"
+ 			ifFalse: [self methodNode]) "Squeak Smalltalk-80 Bytecode Compiler"
+ 		asTranslationMethodOfClass: aTMethodClass!

Item was changed:
  ----- Method: LiteralNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of me"
- 	"make a CCodeGenerator equivalent of me"
  	^TConstantNode new setValue: key!

Item was changed:
  ----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of me"
- 	"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: #()
  				{	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:
  ----- Method: MethodNode>>asTranslationMethodOfClass: (in category '*VMMaker-C translation') -----
  asTranslationMethodOfClass: aClass
+  	"Answer a TMethod (or subclass) derived from the receiver."
+ 	^aClass new
- 	^ aClass new
  		setSelector: selectorOrFalse
  		definingClass: encoder associationForClass value
  		args: arguments
  		locals: encoder tempsAndBlockArgs
  		block: block
  		primitive: primitive
  		properties: properties
+ 		comment: comment!
- 		comment: comment
- !

Item was added:
+ ----- Method: ParseNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
+ asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of me"
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: ReturnNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of a return."
- 	"Make a CCodeGenerator equivalent of a return."
  	| exprTranslation lastExpr |
  	exprTranslation := expr asTranslatorNodeIn: aTMethod.
  	(expr isMessage
  	 and: [expr receiver isVariableNode
  	 and: [expr receiver key = 'super'
  	 and: [exprTranslation isStmtList]]]) ifTrue:
  		["super expansions containing returns are fine, and (as of 6/25/2012 19:27) the last
  		  return is elided from the expansion by TMethod>>superExpansionNodeFor:args:. 
  		  So we need to ensure the last expression is a return and simply reuse any other
  		  returns in the expansion."
  		lastExpr := exprTranslation statements last.
  		(lastExpr isReturn
  		 or: [lastExpr isReturningIf]) ifFalse:
  			[exprTranslation statements
  				at: exprTranslation statements size
  					(TReturnNode new 
  						setExpression: lastExpr;
  						comment: comment;
  	^TReturnNode new 
  		setExpression: exprTranslation;
  		comment: comment;

Item was added:
+ TestCase subclass: #SlangTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Tests'!

Item was added:
+ ----- Method: SlangTests>>testSimpleMethod (in category 'tests') -----
+ testSimpleMethod
+ 	| codeGenerator tMethod code |
+ 	codeGenerator := CCodeGenerator new.
+ 	tMethod := codeGenerator compileToTMethodSelector: #extBBytecode in: StackInterpreter.
+ 	self assert: #(	#'['
+ 					byte #':=' self fetchByte #'.'
+ 					self fetchNextBytecode #'.'
+ 					extB #':=' #(numExtB #= 0 and: #'[' byte #> 127 #']')
+ 									ifTrue: #'[' byte #- 256 #']'
+ 									ifFalse: #'[' #(extB bitShift: 8) #+ byte #']' #'.'
+ 					numExtB #':=' numExtB #+ 1 #'.'
+ 					#'^' self
+ 					#']')
+ 		equals: (Scanner new scanTokens: tMethod parseTree printString).
+ 	code := String streamContents: [:s| tMethod emitCCodeOn: s generator: codeGenerator].
+ 	code := code allButFirst: (code indexOfSubCollection: 'sqInt') - 1.
+ 	self assert:  #('sqInt' 'extBBytecode(void)' '{' 'sqInt' 'byte;'
+ 					'byte' '=' 'fetchByte();'
+ 					'fetchNextBytecode();'
+ 					'extB' '=' '((numExtB' '==' '0)' '&&' '(byte' '>' '0x7F)'
+ 						'?' 'byte' '-' '256'
+ 						':' '(((usqInt)' 'extB' '<<' '8))' '+' 'byte);'
+ 					'numExtB' '+=' '1;' 'return' 'self;' '}')
+ 		equals: (code findTokens: Character separators) asArray !

Item was changed:
  ----- Method: TMethod>>superExpansionNodeFor:args: (in category 'inlining') -----
  superExpansionNodeFor: aSelector args: argumentNodes
  	"Answer the expansion of a super send.  Merge the super expansion's
  	 locals, properties and comment into this method's properties."
  	(definingClass superclass lookupSelector: aSelector)
  		ifNil: [self error: 'superclass does not define super method']
  			[:superMethod| | superTMethod commonVars varMap |
+ 			superTMethod := superMethod asTranslationMethodOfClass: self class.
- 			superTMethod := superMethod methodNode asTranslationMethodOfClass: self class.
  			((argumentNodes allSatisfy: [:parseNode| parseNode isVariableNode])
  			and: [(argumentNodes asOrderedCollection collect: [:parseNode| parseNode key]) = superTMethod args]) ifFalse:
  				[self error: definingClass name, '>>',selector, ' args ~= ',
  							superTMethod definingClass name, '>>', aSelector,
  							(String with: $. with: Character cr),
  							'For super expansions to be translated correctly each argument must be a variable with the same name as the corresponding argument in the super method.'].
  			(commonVars := superTMethod locals intersection: self locals) notEmpty ifTrue:
  				[varMap := Dictionary new.
  				 commonVars do:
  					[:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)].
  				 superTMethod renameVariablesUsing: varMap].
  			self mergePropertiesOfSuperMethod: superTMethod.
  			self assert: (superTMethod locals allSatisfy: [:var| (self locals includes: var) not]).
  			locals addAll: superTMethod locals.
  			superTMethod declarations keysAndValuesDo:
  				[:var :decl|
  				self declarationAt: var put: decl].
  			superTMethod comment ifNotNil:
  				comment := comment
  								ifNil: [superComment]
  								ifNotNil: [superComment, comment]].
  			superTMethod extraVariableNumber ifNotNil:
  				extraVariableNumber := extraVariableNumber ifNil: [scvn] ifNotNil: [:cvn| cvn + scvn]].
  			superTMethod elideAnyFinalReturn.
  			^superTMethod parseTree]!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>accessorsAndAssignmentsForSubMethodNamed:actuals:depth:interpreterClass:into: (in category 'spur primitive compilation') -----
  accessorsAndAssignmentsForSubMethodNamed: selector actuals: actualParameters depth: depth interpreterClass: interpreterClass into: aTrinaryBlock
  	"Evaluate aTrinaryBlock with the root accessor sends, accessor sends and assignments in the sub-method named selector."
  	| method map |
  	(inProgressSelectors includes: selector) ifTrue:
  	inProgressSelectors add: selector.
  	method := self methodNamed: selector.
  	"this is unsatisfactory.  a pluggable scheme that asks the relevant plugin the right question would
  	 be better but for now the only cross-plugin load is for loadBitBltFrom:warping: and variants."
  	(#(loadBitBltFrom: loadWarpBltFrom: loadBitBltFrom:warping:) includes: selector) ifTrue:
  		[(method isNil
  		  or: [method definingClass ~~ BitBltSimulation]) ifTrue:
+ 			[method := (BitBltSimulation >> selector) asTranslationMethodOfClass: TMethod]].
- 			[method := (BitBltSimulation >> selector) methodNode asTranslationMethodOfClass: TMethod]].
  	method ifNil:
  	map := Dictionary new.
  	method args do: [:var| map at: var put: depth asString, var].
  	method locals do: [:var| map at: var put: depth asString, var].
  	^self accessorsAndAssignmentsForMethod: (method copy renameVariablesUsing: map)
  		actuals: actualParameters
  		depth: depth + 1
  		interpreterClass: interpreterClass
  		into: aTrinaryBlock!

Item was changed:
  ----- Method: VariableNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
  asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of me"
- 	"make a CCodeGenerator equivalent of me"
  	name = 'true' ifTrue: [^ TConstantNode new setValue: true].
  	name = 'false' ifTrue: [^ TConstantNode new setValue: false].
+ 	^TVariableNode new setName: name!
- 	^ TVariableNode new setName: name!

More information about the Vm-dev mailing list