[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:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2430.mcz
==================== 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
Slang:
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 };
yourself!
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|
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].
^exprOrAssignment]]]].
^nil!
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: #()
statements:
(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: #()
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:
----- 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
put:
(TReturnNode new
setExpression: lastExpr;
comment: comment;
yourself)].
^exprTranslation].
^TReturnNode new
setExpression: exprTranslation;
comment: comment;
yourself!
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']
ifNotNil:
[: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:
[:superComment|
comment := comment
ifNil: [superComment]
ifNotNil: [superComment, comment]].
superTMethod extraVariableNumber ifNotNil:
[:scvn|
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:
[^nil].
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:
[^nil].
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