VM Maker Inbox: VMMaker.oscog-nice.2761.mcz

 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker Inbox:
http://source.squeak.org/VMMakerInbox/VMMaker.oscog-nice.2761.mcz

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

Name: VMMaker.oscog-nice.2761
Author: nice
Time: 20 June 2020, 8:11:09.897426 pm
UUID: e8105e2b-a95e-4698-9a5f-939360e251b8
Ancestors: VMMaker.oscog-eem.2760

1) Revise a bit the tranformation of assignment/returns for C code generation (see below)

2) Do not try to generate SHA256Plugin, it's obsolete and absent from latest cryptography packages.

In Smalltalk, every statement is an expression that can be used in other expression, assigned to variables, etc...

In C, not all statements are valid expressions, or IOW, not all statements have a value.
In C parlance, rvalues are the ones which can be used at the right of an assignment, lvalues the ones which can be used on the left of an assignment.

While working on FFI, I had invalid code generated looking like:

        err = switch(atomicType) ...

This is because there is brittle code for transforming some expressions, which are not generic enough.

For example, we have similar TSwitchStmtListNode and TCaseStmtNode for handling #dispatchOn:in:, but not exactly same handling of both.

Before this change, an overview can be given by reviewing senders of:
#isSwitch #isCaseStmt

This commit is an attempt to enhance/generalize handling of such non-rvalues by distributing the handling of those constructs in TParseNode hierarchy.

A slight change, is that assigning/returning result of a caseOf: without otherwise clause did create a default branch with an error message and a default value for the returned expression/assigned variable.
See #emitCCodeOn:addToEndOfCases:level:generator:
or #emitCCodeOn:prependToEndOfCases:level:generator:

The new #transformInAssignmentTo: only create the error message, but does not provide the default value.
This is because type analysis might have been not yet taken place at time of transformation.
Is this really needed? I don't think so.

Please review!
We might want to further extend the mechanism.

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

Item was changed:
  ----- Method: TAssignmentNode>>emitStatementListExpansion:on:level:generator: (in category 'C code generation') -----
  emitStatementListExpansion: stmtList on: aStream level: level generator: aCodeGen
  stmtList statements last = variable ifTrue:
  [^expression emitCCodeOn: aStream level: level generator: aCodeGen].
+ (stmtList copy transformInAssignmentTo: variable)
- stmtList copy
- assignLastExpressionTo: variable;
  emitCCodeOn: aStream level: level generator: aCodeGen!

Item was changed:
  ----- Method: TAssignmentNode>>emitStatementListExpansionAsExpression:on:level:generator: (in category 'C code generation') -----
  emitStatementListExpansionAsExpression: stmtList on: aStream level: level generator: aCodeGen
  stmtList statements last = variable ifTrue:
  [^expression emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen].
+ (stmtList copy transformInAssignmentTo: variable)
- stmtList copy
- assignLastExpressionTo: variable;
  emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen!

Item was changed:
  ----- Method: TAssignmentNode>>emitValueExpansionOn:level:generator: (in category 'C code generation') -----
  emitValueExpansionOn: aStream level: level generator: aCodeGen
  | stmtList lastStmt copiedStatements |
  self assert: (expression isSend and: [expression isValueExpansion]).
  stmtList := expression receiver.
  lastStmt := stmtList statements last.
  (lastStmt = variable or: [lastStmt isReturn]) ifTrue:
  [^expression emitCCodeOn: aStream level: level generator: aCodeGen].
+ copiedStatements := stmtList copy transformInAssignmentTo: variable.
- copiedStatements := stmtList copy.
- copiedStatements statements
- at: stmtList statements size
- put: (TAssignmentNode new
- setVariable: variable
- expression: lastStmt).
  expression copy
  receiver: copiedStatements;
  emitCCodeOn: aStream level: level generator: aCodeGen!

Item was added:
+ ----- Method: TAssignmentNode>>transformInAssignmentTo: (in category 'transformations') -----
+ transformInAssignmentTo: aTVariableNode
+ "Avoid transforming:
+ x := expression
+ into:
+ x := x := expression"
+
+ aTVariableNode = variable ifTrue: [^self].
+ ^super transformInAssignmentTo: aTVariableNode!

Item was changed:
  TParseNode subclass: #TCaseStmtNode
+ instanceVariableNames: 'expression firsts lasts cases otherwiseOrNil'
- instanceVariableNames: 'expression firsts lasts cases'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'VMMaker-Translation to C'!
 
  !TCaseStmtNode commentStamp: '<historical>' prior: 0!
  I implement the main dispatch case statements for bytecode and primitive dispatch.  See TMethod classPool associationAt: #CaseStatements!

Item was changed:
  ----- Method: TCaseStmtNode>>emitCCodeOn:level:generator: (in category 'C code generation') -----
  emitCCodeOn: aStream level: level generator: aCodeGen
  | printMod expansions duplicates |
  printMod := false.
  (expression isVariable
  and: [expression name = 'currentBytecode']) ifTrue:
  [printMod := true.
  aStream nextPutAll: 'bytecodeDispatchDebugHook();'; cr; crtab: level.
  aCodeGen outputAsmLabel: 'bytecodeDispatch' on: aStream.
  aStream crtab: level].
  aStream nextPutAll: 'switch ('.
  expression emitCCodeOn: aStream level: level generator: aCodeGen.
  aStream nextPutAll: ') {'; cr.
  expansions := aCodeGen suppressAsmLabelsWhile:
  [cases collect:
  [:case|
  self filterCommentsFrom:
  (String streamContents:
  [:s|
  case emitCCodeOn: s level: 0 generator: aCodeGen])]].
  duplicates := Set new.
  1 to: cases size do:
  [:i|
  (duplicates includes: i) ifFalse:
  [(duplicates addAll: ((i to: cases size) select: [:j| (expansions at: i) = (expansions at: j)])) do:
  [:k|
  (firsts at: k) to: (lasts at: k) do:
  [:caseIndex|
  aStream tab: level; nextPutAll: 'case '; print: caseIndex; nextPut: $:.
  (caseIndex > 255 and: [printMod]) ifTrue:
  [aStream nextPutAll: ' /*'; print: (caseIndex bitAnd: 255); nextPutAll: '*/'].
  aStream cr]].
  (cases at: i) emitCCodeOn: aStream level: level + 1 generator: aCodeGen.
  aStream tab: level + 1; nextPutAll: 'break;'; cr]].
+ otherwiseOrNil
+ ifNotNil:
+ [aStream
+ crtab: level;
+ nextPutAll: 'default:';
+ cr.
+ otherwiseOrNil emitCCodeOn: aStream level: level + 1 generator: aCodeGen].
  aStream tab: level; nextPut: $}!

Item was added:
+ ----- Method: TCaseStmtNode>>isAnRValueIn: (in category 'testing') -----
+ isAnRValueIn: aCodeGen
+ "A switch is not an rvalue"
+
+ ^false!

Item was added:
+ ----- Method: TCaseStmtNode>>transformInAssignmentTo: (in category 'transformations') -----
+ transformInAssignmentTo: aTVariableNode
+ "Destructively transform the receiver so that each case is transformed into an assignment."
+ cases := cases collect: [:node | node copy transformInAssignmentTo: aTVariableNode].
+ otherwiseOrNil := otherwiseOrNil isNil
+ ifTrue: [TStmtListNode new setArguments: #() statements:
+ {TSendNode new setSelector: #error
+ receiver: (TConstantNode new setValue: 'Case not found')
+ arguments: #()}]
+ ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode].
+ ^self!

Item was added:
+ ----- Method: TGoToNode>>isAnRValueIn: (in category 'testing') -----
+ isAnRValueIn: aCodeGen
+ "A goto is not an rvalue"
+
+ ^false!

Item was removed:
- ----- Method: TMethod>>isConditionalToBeTransformedForAssignment:in: (in category 'inlining') -----
- isConditionalToBeTransformedForAssignment: aSend in: aCodeGen
- "Answer if a send is of the form
- e1
- ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]]
- ifFalse: [self m3]
- such that at least one of the sends mN may be inlined.."
-
- ^(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: aSend selector)
-   and: [aSend args anySatisfy:
- [:arg| | stmt |
- self assert: arg isStmtList.
- arg statements size > 1
- or: [(stmt := arg statements first) isSwitch
- or: [stmt isSend
- and: [(aCodeGen mayInline: stmt selector)
- or: [self isConditionalToBeTransformedForAssignment: stmt in: aCodeGen]]]]]]!

Item was changed:
  ----- Method: TMethod>>transformConditionalAssignment:in: (in category 'inlining') -----
  transformConditionalAssignment: node in: aCodeGen
  "If possible answer the transformation of code of the form
  var := e1
  ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]]
  ifFalse: [self m3]
  into
  e1
  ifTrue: [e2 ifTrue: [var := self m1] ifFalse: [var := self m2]]
  ifFalse: [var := self m3]
+ to allow inlining of m1, m2, et al.  Otherwise answer nil.
+ Also apply to various C constructs like switch"
- to allow inlining of m1, m2, et al.  Otherwise answer nil."
 
- | expr |
  ^(node isAssignment
+   and: [node expression mustTransformWhenAssignedIn: aCodeGen]) ifTrue:
+ [node expression copy transformInAssignmentTo: node variable]!
-   and: [(expr := node expression) isSend
-   and: [(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector)
-   and: [self isConditionalToBeTransformedForAssignment: expr  in: aCodeGen]]]) ifTrue:
- [expr copy
- arguments:
- (expr args collect:
- [:stmtList| stmtList copy assignLastExpressionTo: node variable]);
- yourself]!

Item was changed:
  ----- Method: TMethod>>transformReturnSubExpression:toAssignmentOf:andGoto:unless:into: (in category 'inlining') -----
  transformReturnSubExpression: node toAssignmentOf: exitVar andGoto: exitLabel unless: eliminateReturnSelfs into: aBinaryBlock
  | expr replacement |
  expr := node isReturn ifTrue: [node expression] ifFalse: [node].
  replacement := (expr isVariable "Eliminate ^self's"
    and: [expr name = 'self'
    and: [eliminateReturnSelfs]])
  ifTrue: [nil]
  ifFalse:
  [exitVar
  ifNil: [expr]
+ ifNotNil: [expr transformInAssignmentTo: (TVariableNode new setName: exitVar)]].
- ifNotNil: [TAssignmentNode new
- setVariable: (TVariableNode new setName: exitVar)
- expression: expr]].
  node == parseTree statements last
  ifTrue:
  [aBinaryBlock value: replacement value: false]
  ifFalse:
  [replacement := replacement
  ifNil: [TGoToNode new setLabel: exitLabel; yourself]
  ifNotNil:
  [TStmtListNode new
  setArguments: #()
  statements: {replacement.
   TGoToNode new setLabel: exitLabel; yourself};
  yourself].
  aBinaryBlock value: replacement value: true]!

Item was changed:
  ----- Method: TMethod>>transformReturns (in category 'type inference') -----
  transformReturns
+ "Once the return type has been found or inferred, returns may need to be modified.
- "Once the return type has been found or inferred, returns may bneed to be modified.
  If the return type is #void, any occurrences of ^expr must be replaced with expr. ^self.
  If the type is #sqInt any any occurrences of ^self are replaced with ^0."
  (returnType == #void or: [returnType == #sqInt]) ifFalse:
  [^self].
  parseTree nodesWithParentsDo:
  [:node :parent|
  node isReturn ifTrue:
  [(node expression isVariable and: [node expression name = 'self'])
  ifTrue:
  [returnType = #sqInt ifTrue:
  [node setExpression: (TConstantNode new setValue: 0)]]
  ifFalse:
  [returnType = #void ifTrue:
  [parent
  replaceChild: node
  with: (TStmtListNode new
  setArguments: #()
  statements: {node expression.
   TReturnNode new
  setExpression: (TVariableNode new setName: 'self')
  yourself})]]]]!

Item was added:
+ ----- Method: TParseNode>>isAnRValueIn: (in category 'testing') -----
+ isAnRValueIn: aCodeGen
+ "Answer false if this node is potentially not a rvalue.
+ a rvalue is an expression that can occur to the right of an assignement.
+ In C code, not all expression can be a rvalue.
+ For example if() {} else {} are not rvalues, unless they can be transformed into a ()?: construct.
+ Likewise, while and for loops, switch statements are not possible rvalues.
+ This method has to take inlining into account, because a simple message send would be transformed into a function call which is an rvalue.
+ But if the method is inlined rather than called, this may not be the case.
+ Default behavior is to answer true, only notorious non-rvalues have to refine this"
+
+ ^true
+ !

Item was added:
+ ----- Method: TParseNode>>mustTransformWhenAssignedIn: (in category 'testing') -----
+ mustTransformWhenAssignedIn: aCodeGen
+ "Answer whether this node must be transformed when assigned to a variable
+ var := expr.
+ Not all statements can be used at the right of assignment in C (rvalues)."
+
+ ^(self isAnRValueIn: aCodeGen) not
+ !

Item was added:
+ ----- Method: TParseNode>>transformInAssignmentTo: (in category 'transformations') -----
+ transformInAssignmentTo: aTVariableNode
+ "Default behavior is to transform an expression into an assignement
+ var := expression.
+ This message has to be redefined in subclasses which are not rvalues."
+ ^TAssignmentNode new
+ setVariable: aTVariableNode
+ expression: self!

Item was added:
+ ----- Method: TReturnNode>>isAnRValueIn: (in category 'testing') -----
+ isAnRValueIn: aCodeGen
+ "This is not an rvalue, we cannot write:
+ x = return y"
+
+ ^false!

Item was added:
+ ----- Method: TReturnNode>>transformInAssignmentTo: (in category 'transformations') -----
+ transformInAssignmentTo: aTVariableNode
+ "a return shall not be assigned:
+ x := condition ifTrue: [^nil] ifFalse: [2]
+ shall be transformed into:
+ condition ifTrue: [^nil] ifFalse: [x := 2]"
+
+ ^self!

Item was added:
+ ----- Method: TSendNode>>isAnRValueIn: (in category 'testing') -----
+ isAnRValueIn: aCodeGen
+ self isConditionalSend
+ ifTrue: ["If all expressions of a conditional are rvalue, then the
+ conditional can be transformed into a ()?: construct and is
+ thus an rvalue"
+ ^ (receiver isAnRValueIn: aCodeGen)
+ and: [self args
+ allSatisfy: [:arg | arg isAnRValueIn: aCodeGen]]].
+ "inlined message sends are potentially not rvalues"
+ ^ (aCodeGen mayInline: self selector) not!

Item was added:
+ ----- Method: TSendNode>>mustTransformWhenAssignedIn: (in category 'transformations') -----
+ mustTransformWhenAssignedIn: aCodeGen
+ "Answer whether this node must be transformed.
+ Avoid infinite transformation loops caused by unchanged nodes."
+
+ (aCodeGen mayInline: self selector) ifTrue: [^false].
+ ^super mustTransformWhenAssignedIn: aCodeGen!

Item was added:
+ ----- Method: TSendNode>>transformInAssignmentTo: (in category 'transformations') -----
+ transformInAssignmentTo: aTVariableNode
+ "transform a conditional:
+ condition ifTrue: [stmt1. stmt2] ifFalse: [stmt3. stmt4].
+ into:
+ condition ifTrue: [stmt1. var := stmt2] ifFalse: [stmt3. var := stmt4].
+ If the last expression is itself not an rvalue, it will be transformed recursively"
+
+ self isConditionalSend ifTrue: [^self copy
+ arguments:
+ (self args collect:
+ [:stmtList| stmtList copy transformInAssignmentTo: aTVariableNode]);
+ yourself].
+ "don't attempt to assign aTVariableNode with the error condition (like default switch missing)"
+ selector = #error ifTrue: [^self].
+ ^super transformInAssignmentTo: aTVariableNode!

Item was removed:
- ----- Method: TStmtListNode>>assignLastExpressionTo: (in category 'transformations') -----
- assignLastExpressionTo: variableNode
- "Destructively transform the receiver so that its last expression is assigned to the argument."
- | index |
- index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not].
- statements
- at: index
- put: (TAssignmentNode new
- setVariable: variableNode
- expression: (statements at: index))!

Item was added:
+ ----- Method: TStmtListNode>>isAnRValueIn: (in category 'testing') -----
+ isAnRValueIn: aCodeGen
+ "A list of statements is not an rvalue...
+ Well, in simple cases we could use comma operator (,), but don't bother here."
+
+ ^statements size = 1 and: [statements first isAnRValueIn: aCodeGen]!

Item was added:
+ ----- Method: TStmtListNode>>transformInAssignmentTo: (in category 'transformations') -----
+ transformInAssignmentTo: aTVariableNode
+ "Destructively transform the receiver so that its last expression is assigned to the argument."
+ | index |
+ index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not].
+ statements
+ at: index
+ put: ((statements at: index) copy transformInAssignmentTo: aTVariableNode).
+ ^self!

Item was added:
+ ----- Method: TSwitchStmtNode>>isAnRValueIn: (in category 'testing') -----
+ isAnRValueIn: aCodeGen
+ "A switch is not an rvalue"
+
+ ^false!

Item was added:
+ ----- Method: TSwitchStmtNode>>transformInAssignmentTo: (in category 'transformations') -----
+ transformInAssignmentTo: aTVariableNode
+ "Destructively transform the receiver so that each case is transformed into an assignment."
+ cases := cases collect: [:pair | {pair first. pair last copy transformInAssignmentTo: aTVariableNode}].
+ otherwiseOrNil := otherwiseOrNil isNil
+ ifTrue: [TStmtListNode new setArguments: #() statements:
+ {TSendNode new setSelector: #error
+ receiver: (TConstantNode new setValue: 'Case not found and no otherwise clause')
+ arguments: #()}]
+ ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode].
+ ^self!

Item was added:
+ ----- Method: TVariableNode>>transformInAssignmentTo: (in category 'transformations') -----
+ transformInAssignmentTo: aTVariableNode
+ "Avoid transforming:
+ x
+ into:
+ x := x"
+
+ aTVariableNode = self ifTrue: [^self].
+ ^super transformInAssignmentTo: aTVariableNode!

Item was changed:
  ----- Method: VMMaker class>>generateVMPlugins (in category 'configurations') -----
  generateVMPlugins
  ^VMMaker
  generatePluginsTo: self sourceTree, '/src'
  options: #()
  platformDir: self sourceTree, '/platforms'
  including:#(ADPCMCodecPlugin AsynchFilePlugin
  BalloonEnginePlugin B3DAcceleratorPlugin B3DEnginePlugin BMPReadWriterPlugin BitBltSimulation
  BochsIA32Plugin BochsX64Plugin GdbARMv6Plugin GdbARMv8Plugin
  CameraPlugin CroquetPlugin DeflatePlugin DropPlugin
+ "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin
- "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin SHA256Plugin
  "FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FileAttributesPlugin Float64ArrayPlugin FloatArrayPlugin FloatMathPlugin
  GeniePlugin HostWindowPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin
  JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin
  LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin
  MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin
  ScratchPlugin SecurityPlugin SerialPlugin SocketPlugin
  SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin
  ThreadedFFIPlugin ThreadedARM32FFIPlugin ThreadedARM64FFIPlugin ThreadedIA32FFIPlugin
  ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin
  UnicodePlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin
  Win32OSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin WeDoPlugin
  XDisplayControlPlugin)!