VM Maker: VMMaker.oscog-eem.2430.mcz

 
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!