[Vm-dev] VM Maker: VMMakerCompatibilityForPharo6-eem.8.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Sep 9 17:57:44 UTC 2018


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

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

Name: VMMakerCompatibilityForPharo6-eem.8
Author: eem
Time: 9 September 2018, 7:57:29.62651 pm
UUID: 816211b6-d531-0d00-bcd1-bebc012ef449
Ancestors: VMMakerCompatibilityForPharo6-eem.7

Add translation support for brace constructs in case statements.
And include a *Tools extension for TranscriptStream.

=============== Diff against VMMakerCompatibilityForPharo6-eem.7 ===============

Item was added:
+ ----- Method: RBArrayNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
+ asTranslatorNodeIn: aTMethod
+ 	"Answer a TParseNode subclass equivalent of me."
+ 
+ 	"This is for case statements"
+ 	(statements allSatisfy: [:elem| elem isMessage and: [elem selector = #->]]) ifTrue:
+ 		[self assert: (statements allSatisfy:
+ 			[:elem|
+ 			elem receiver isBlockNode
+ 			and: [elem arguments first isBlockNode
+ 			and: [elem receiver isPotentialCCaseLabelIn: aTMethod]]]).
+ 		^TBraceCaseNode new
+ 			caseLabels: (statements collect: [:elem| elem receiver asTranslatorNodeIn: aTMethod]);
+ 			cases: (statements collect: [:elem| elem arguments first asTranslatorNodeIn: aTMethod]);
+ 			comment: statements].
+ 
+ 	"This is for varargs selectors (variants of printf:)"
+ 	^statements collect: [:elem| elem asTranslatorNodeIn: aTMethod]!

Item was added:
+ ----- Method: RBBlockNode>>isPotentialCCaseLabel:in: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
+ isPotentialCCaseLabel: stmt in: aTMethod
+ 	(stmt isVariable
+ 	 or: [stmt isLiteralNode
+ 		and: [stmt isConstantNumber or: [stmt literalValue isSymbol]]]) ifTrue:
+ 		[^true].
+ 	stmt isMessage ifTrue:
+ 		[| selector implementingClass method |
+ 		 selector := stmt selector.
+ 		 (#(* + -) includes: selector) ifTrue:
+ 			[^(self isPotentialCCaseLabel: stmt receiver in: aTMethod)
+ 			   and: [self isPotentialCCaseLabel: stmt arguments first in: aTMethod]].
+ 
+ 		 (selector = #asSymbol
+ 		  and: [stmt receiver isLiteralNode
+ 		  and: [stmt receiver literalValue isSymbol]]) ifTrue:
+ 			[^true].
+ 
+ 		 (stmt arguments isEmpty
+ 		  and: [implementingClass := aTMethod definingClass whichClassIncludesSelector: selector.
+ 			   implementingClass ifNil:
+ 				[implementingClass := aTMethod definingClass objectMemoryClass whichClassIncludesSelector: selector].
+ 			   method := implementingClass >> selector.
+ 			   (method isQuick
+ 				or: [(method literalAt: 1) isInteger
+ 					and: [method numLiterals = 3]])
+ 		   and: [(implementingClass basicNew perform: selector) isInteger]]) ifTrue:
+ 				[^true]].
+ 	^false!

Item was added:
+ ----- Method: RBBlockNode>>isPotentialCCaseLabelIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
+ isPotentialCCaseLabelIn: aTMethod
+ 	body statements size ~= 1 ifTrue: [^false].
+ 	^self isPotentialCCaseLabel: body statements first in: aTMethod!

Item was added:
+ ----- Method: RBLiteralValueNode>>isConstantNumber (in category '*VMMakerCompatibilityForPharo6-testing') -----
+ isConstantNumber
+ 	^value isNumber!

Item was changed:
  ----- Method: RBMessageNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
  asTranslatorNodeIn: aTMethod
  	"Answer a TParseNode subclass 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 args: arguments].
+ 	sel := selector. "historical; can be simply selector"
- 		[^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 value isString
  		 and: [arguments first value isEmpty]]) ifTrue:
  			[^arguments first asTranslatorNodeIn: aTMethod]].
+ 	args := arguments collect: [:arg| arg asTranslatorNodeIn: aTMethod].
- 	args := arguments
- 				select: [:arg| arg notNil]
- 				thenCollect: [:arg| arg asTranslatorNodeIn: aTMethod].
  false ifTrue:
  	[(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 isNodeNil]) ifTrue:
  		[sel := #ifFalse:. args := {args last}].
  	(sel == #ifTrue:ifFalse: and: [arguments last isNodeNil]) ifTrue:
  		[sel := #ifTrue:. args := {args first}].
  	(sel == #ifFalse:ifTrue: and: [arguments first isNodeNil]) ifTrue:
  		[sel := #ifTrue:. args := {args last}].
  	(sel == #ifFalse:ifTrue: and: [arguments last isNodeNil]) 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 added:
+ ----- Method: RBProgramNode>>isConstantNumber (in category '*VMMakerCompatibilityForPharo6-testing') -----
+ isConstantNumber  "Overridden in RBLiteralValueNode"
+ 	^false!

Item was added:
+ ----- Method: RBVariableNode>>key (in category '*VMMakerCompatibilityForPharo6-accessing') -----
+ key
+ 	^name!

Item was added:
+ ----- Method: TranscriptStream>>codePaneMenu:shifted: (in category 'Tools compatibility') -----
+ codePaneMenu: aMenu shifted: shifted
+ 	"Note that unless we override perform:orSendTo:, PluggableTextController will respond to all menu items"
+ 
+ 	| donorMenu |
+ 	donorMenu := shifted
+ 						ifTrue: [SmalltalkEditor shiftedYellowButtonMenu]
+ 						ifFalse: [SmalltalkEditor yellowButtonMenu].
+ 	^aMenu addAllFrom: donorMenu!



More information about the Vm-dev mailing list