src/mobius/compiler.slate

   1
   2 m@(CompiledMethod traits) new
   3 "Answer a new CompiledMethod with a fresh compilation state."
   4 [
   5   m clone `>>
   6     [| :newM |
   7      method := newM.
   8      inputVariables := 0.
   9      optionalKeywords := m optionalKeywords new.
  10      restVariable := False.
  11      registerCount := 0.
  12      environment := Nil.
  13      selector := Nil.
  14      literals := m literals new.
  15      selectors := m selectors new.
  16      code := m code new.
  17      debugMap := m debugMap new.
  18      sourceTree := Nil. ]
  19 ].
  20
  21 m@(CompiledMethod traits) sourceTreeOf: index
  22 "Find the source tree corresponding to a bytecode's index."
  23 [
  24   m debugMap do:
  25     [| :start :end :sourceTree |
  26      (index between: start and: end)
  27        ifTrue: [^ sourceTree]]
  28     inGroupsOf: 3.
  29   Nil
  30 ].
  31
  32 m@(CompiledMethod traits) definitionLocation
  33 [
  34   m sourceTree isNotNil /\ [m sourceTree hasSlotNamed: #source]
  35     ifTrue: [m sourceTree definitionLocation]
  36     ifFalse: ['Nil']
  37 ].
  38
  39 m@(CompiledMethod traits) recompile
  40 "If the method has a sourceTree, replace the method with a re-compiled version
  41 of it."
  42 [
  43   m sourceTree
  44     ifNil: [warn: 'The method has no source code to recompile.'. m]
  45     ifNotNilDo: [| :src | m forwardTo: src compile]
  46 ].
  47
  48 lobby ensureNamespace: #VM.
  49 VM ensureNamespace: #SSACode.
  50
  51 VM SSACode define: #Instruction &parents: {Cloneable} &slots: {
  52   #code.
  53   #selector.
  54   #name.
  55   #argNames -> {}.
  56   #offsettingArgIndices -> {}.
  57 }.
  58
  59 VM SSACode Instruction traits define: #ByCode -> Dictionary new.
  60
  61 i@(VM SSACode Instruction traits) instancesSetting: slotNames to: values
  62 [
  63   resend `>> [do: [| :each |
  64     each argNames do:
  65       [| :argName | (#{'arity'. 'size'} includes: argName) ifTrue:
  66         [""]].
  67     VM SSACode addImmutableSlot: each selector valued: each code.
  68     i ByCode at: each code put: each].
  69   ]
  70 ].
  71
  72 VM SSACode Instruction instancesSetting: #{#code. #selector. #name. #argNames. #offsettingArgIndices} to: #{
  73   {0. #directSendMessage. 'Direct Send'. {'register of result'. 'selector'. 'arity' ". args..."}. {2}}.
  74   "{1. #indirectSendMessage. 'Indirect Send'. {'register of result'. 'selector'. 'arity'. args...}. {2}}."
  75   "{2. #allocateRegisters. 'Allocate Registers'. 3. {}}."
  76   {3. #loadLiteral. 'Load Literal'. {'register of result'. 'index of literal'}}.
  77   "{4. #storeLiteral. 'Store Literal'. {'index of literal'. 'register of source'}}."
  78   {5. #sendMessageWithOptionals. 'Send with Optionals'. {'register of result'. 'selector'. 'arity'. 'register of optionals array' ". args..."}. {2}}.
  79   {7. #newClosure. 'New Closure'. {'register of result'. 'block'}}.
  80   {8. #newArrayWith. 'New Array With'. {'register of result'. 'size' ". args..."}. {1}}.
  81   {9. #resendMessage. 'Resend'. {'register of result'. 'lexical offset'}}.
  82   {10. #returnFrom. 'Return From'. {'register of result'. 'lexical offset'}}.
  83   {11. #loadEnvironment. 'Load Environment'. {'register of result'}}.
  84   {12. #loadVariable. 'Load Variable'. {'register of result'}}.
  85   {13. #storeVariable. 'Store Variable'. {'register of result'}}.
  86   {14. #loadFreeVariable. 'Load Free Variable'. {'register of result'. 'lexical offset'. 'index of variable'}}.
  87   {15. #storeFreeVariable. 'Store Free Variable'. {'lexical offset'. 'index of variable'. 'register of source'}}.
  88   {16. #isIdenticalTo. 'Is Identical To'. {'register of result'. 'register of x'. 'register of y'}}.
  89   {17. #branchKeyed. 'Branch Keyed'. {'register of key'. 'table'}}.
  90   {18. #jumpTo. 'Jump To'. {'offset'}}.
  91   "Used like SSA phi / branch merges:"
  92   {19. #moveRegister. 'Move Register'. {'register of source'. 'register of result'}}.
  93   {20. #branchIfTrue. 'Branch If True'. {'register of condition'. 'branch offset'}}.
  94   {21. #branchIfFalse. 'Branch If False'. {'register of condition'. 'branch offset'}}.
  95   "Marks the end of a block:"
  96   {22. #returnRegister. 'Return Register'. {'register of value'}}.
  97   "Marks the end of a block:"
  98   {23. #returnValue. 'Return Value'. {'value to return'}}.
  99   "I'm not sure what this does yet..used in bootstrap:"
 100   {24. #resume. 'Resume'. {}}.
 101   {25. #primitiveDo. 'Primitive Do'. {'number of primitive'. 'arity'. 'register of result' ". args..."}. {1}}.
 102   {26. #directApplyTo. 'Direct Apply To'. {'method'. 'arity'. 'register of result' ". args..."}. {1}}.
 103   {27. #isNilOp. 'Is Nil'. {'register of result'. 'register of x'}}.
 104   "these check the arguments to see if their maps match the ones in the map array"
 105   "if they match, we fall through to the next instruction which is the primitive (no code) or inlined function"
 106   "it also needs to set up the input varibles"
 107   {28. #inlinePrimitiveCheckJump. 'Inline Primitive Check Jump'. {'register of result'. 'map array'. 'prim number(in-opcode not a register)'. 'arity'. 'jump offset' ". args..."}. {3}}.
 108   {29. #inlineMethodCheckJump. 'Inline Method Check Jump'. {'map array'. 'arity'. 'jump offset' ". args..."}. {1}}.
 109   {30. #sendMessageWithOptionalsInline. 'Send with Optionals Inline'. {'register of result'. 'selector'. 'arity'. 'optional count'. ". args...optionals..."}. {2. 3}}.
 110
 111 }.
 112
 113 VM define: #SSACompiler &parents: {Cloneable}
 114   &slots: {#contexts -> Stack new}.
 115
 116 VM SSACompiler traitsWindow addDelegate: VM SSACode.
 117
 118 g@(VM SSACompiler traits) new
 119 [g clone `>> [contexts := g contexts new. ]].
 120
 121 VM SSACompiler traits define: #Context &parents: {Cloneable} &slots: {
 122   #isClosure -> False "Whether the method being compiled is a closure.".
 123   #method -> CompiledMethod new "The method the context targets.".
 124   #codeWriter "The stream for writing bytecodes to the method.".
 125   #debugMap -> ExtensibleArray new
 126     "Gathers the method's debug map; must be indexable at all times.".
 127   #registerValues -> ExtensibleArray new
 128     "The current register values.".
 129   #labels -> ExtensibleArray new
 130     "label serials -> code index.".
 131   #relocations -> Dictionary new
 132     "code index -> label serials".
 133   #currentRegister -> 0
 134     "The last assigned register value.. or the count?"
 135 }.
 136
 137 c@(VM SSACompiler Context traits) newOn: method
 138 [
 139   method code := Array new.
 140   c clone `setting: #{#method. #codeWriter. #debugMap. #registerValues. #relocations. #labels. #currentRegister}
 141    to: {method.
 142         method code writer.
 143         method debugMap as: c debugMap.
 144         c registerValues new.
 145         c relocations new.
 146         c labels new.
 147         method inputVariables + method localVariables}
 148 ].
 149
 150 c@(VM SSACompiler Context traits) copy
 151 [
 152   resend `setting: (registerValues relocations labels currentRegister)
 153     to: {c registerValues copy.
 154          c relocations copy.
 155          c labels copy.
 156          c currentRegister}
 157 ].
 158
 159 c@(VM SSACompiler Context traits) resolveLabel: label at: index
 160 [
 161   (c labels at: label) - index
 162 ].
 163
 164 c@(VM SSACompiler Context traits) resolveLabels
 165 "This takes the labels Dictionary and uses it to replace the temporary ID's
 166 placed in the jump fields with actual offsets."
 167 [
 168   code ::= c method code.
 169   c relocations keysAndValuesDo:
 170     [| :index :label offset |
 171      offset := c resolveLabel: label at: index.
 172      code at: index put: offset]
 173 ].
 174
 175 c@(VM SSACompiler Context traits) flush
 176 [
 177   c method code := c codeWriter contents.
 178   c method debugMap := c debugMap as: Array.
 179   c resolveLabels.
 180   c
 181 ].
 182
 183 c@(VM SSACompiler Context traits) beClosure [c isClosure := True].
 184
 185 gen@(VM SSACompiler traits) currentContext
 186 [gen contexts top].
 187
 188 gen@(VM SSACompiler traits) newRegister
 189 [
 190   gen contexts top currentRegister += 1
 191 ].
 192
 193 gen@(VM SSACompiler traits) registerFor: obj from: def result: result
 194 [
 195    "the whole problem with this function is that we could cache a literal that
 196  is only loaded in a loop which may not always be executed. remove this code
 197 until we have it figured out."
 198 "  gen contexts top registerValues do:
 199     [| :val | val value = obj
 200                  ifTrue:
 201                    [val key = result \/ [result isNil]
 202                         ifTrue: [^ val key]
 203                         ifFalse: [result `defaultsTo: gen newRegister.
 204                                    gen emitInstruction: gen moveRegister withParameters: {result. val key} from: def.
 205                                   ^ result]]].
 206  "
 207   "we don't want result to be a local variable and have it overwritten later"
 208   "saveRegister ::= result isNil."
 209   saveRegister ::= False.
 210   result `defaultsTo: gen newRegister.
 211   gen emitInstruction: gen loadLiteral withParameters: {result. obj} from: def.
 212   saveRegister ifTrue: [gen setRegister: result to: obj].
 213   result
 214 ].
 215
 216 gen@(VM SSACompiler traits) setRegister: x to: y
 217 [
 218   gen contexts top registerValues add: x -> y ifPresent:
 219     [error: 'Compiler error: Register already set.'].
 220 ].
 221
 222 gen@(VM SSACompiler traits) currentMethod
 223 [gen currentContext method].
 224
 225 gen@(VM SSACompiler traits) codeWriter
 226 [gen currentContext codeWriter].
 227
 228 gen@(VM SSACompiler traits) newLabelIndex
 229 [
 230   gen currentContext labels `>> [addLast: Nil. indexLast]
 231 ].
 232
 233 gen@(VM SSACompiler traits) emitLabel &labelIndex
 234 [
 235   labelIndex `defaultsTo: gen newLabelIndex.
 236   gen currentContext labels at: labelIndex put: gen codeWriter position.
 237   labelIndex
 238 ].
 239
 240 gen@(VM SSACompiler traits) emitRelocationAgainst: label
 241 [
 242   gen currentContext relocations at: gen codeWriter position put: label
 243 ].
 244
 245 gen@(VM SSACompiler traits) emitObject: value from: node
 246 [
 247   "0 below: bytesPerWord do: [| :byte | gen emitByte: (value byteShift: 0 - byte) intoByte from: node]."
 248   gen mapTo: node.
 249   gen codeWriter nextPut: value
 250 ].
 251
 252 gen@(VM SSACompiler traits) emitBranchTo: label from: msg
 253 [
 254   gen emitRelocationAgainst: label.
 255   gen emitObject: 0 from: msg "replaced later when flushed"
 256 ].
 257
 258 gen@(VM SSACompiler traits) mapTo: sourceTree
 259 [
 260   index ::= gen codeWriter position.
 261   (debugMap ::= gen currentContext debugMap) isEmpty not /\ [debugMap last == sourceTree]
 262     ifTrue: [debugMap at: debugMap indexLast - 1 infect: [| :value | index max: value].
 263              debugMap at: debugMap indexLast - 2 infect: [| :value | index min: value]]
 264     ifFalse: [debugMap addAllLast: {index. index. sourceTree}]
 265 ].
 266
 267 gen@(VM SSACompiler traits) emitInstruction: code@(Integer traits) withParameters: values from: node
 268 "this gets called before the real function"
 269 [
 270   "values do: [| :value | (value is: nodes Node) ifTrue: [error: 'bad code']]." "commented out because we could actually load node literals in compiler code"
 271   resend
 272 ].
 273
 274 gen@(VM SSACompiler traits) emitInstruction: code withParameters: values from: node
 275 [
 276   "add the selector to the list so we know what this function calls... so it can be unoptimized if needed"
 277   code = gen directSendMessage
 278     \/ [code = gen sendMessageWithOptionals]
 279     \/ [code = gen sendMessageWithOptionalsInline]
 280     ifTrue: [gen currentContext method selectors := gen currentContext method selectors ; {values second}].
 281   gen emitObject: code from: node.
 282   values do: [| :value | gen emitObject: value from: node]
 283 ].
 284
 285 gen@(VM SSACompiler traits) emitInstruction: code from: node
 286 "Emitting an instruction without an immediate value required just puts the
 287 byte onto the end."
 288 [
 289   gen emitInstruction: code withParameters: #{} from: node
 290 ].
 291
 292 "
 293 =======================================================================
 294 Generate methods. They all must return the register(s) with the results
 295 =======================================================================
 296 "
 297
 298 _@(VM SSACompiler traits) generate: _@(nodes Node traits)
 299 "Do nothing in the default case, for comments and annotations and such."
 300 [error: 'do not call generate without a result'].
 301
 302 _@(VM SSACompiler traits) generate: _@(nodes Node traits) result: result
 303 "Do nothing in the default case, for comments and annotations and such."
 304 [].
 305
 306 gen@(VM SSACompiler traits) generate: ann@(nodes Annotation traits) result: result
 307 "Generate the annotation's value."
 308 [
 309   gen generate: ann value
 310 ].
 311
 312 gen@(VM SSACompiler traits) generate: block@(nodes Block traits) result: result &topLevel
 313 "Encountering a new block, build a new CompiledMethod object and push it and
 314 a new bytecode array writer onto the generator, then go through the underlying
 315 code and generate that. When done, pop both, set up the block as a literal
 316 and push it onto the stack."
 317 [
 318   topLevel `defaultsTo: False.
 319   newBlock ::= CompiledMethod new `>>
 320     [environment := gen contexts isEmpty
 321        ifTrue: [block topLevel namespace]
 322        ifFalse: [gen currentMethod environment].
 323      sourceTree := block. ].
 324   gen contexts push: (gen Context newOn: newBlock).
 325   "we macroexpand everything before we set the current register because macroexpansion can add localvariables etc"
 326   statements ::= block statements collect:
 327     [| :statement | statement macroExpand &environment: gen currentMethod sourceTree].
 328   gen currentContext currentRegister := block localVariables size. "input variables might not be needed"
 329   statements isEmpty
 330     ifTrue: [gen emitInstruction: gen returnValue withParameters: {Nil} from: block]
 331     ifFalse:
 332       [statements allButLastDo: [| :node | gen generate: node result: Nil].
 333        gen emitInstruction: gen returnRegister withParameters: {gen generate: statements last result: Nil} from: block].
 334
 335   "Set the variable information after generation, just in case it was modified."
 336   newBlock `>>
 337    [inputVariables := block inputVariables size.
 338     localVariables := block localVariables size.
 339     restVariable := block restVariable isNotNil.
 340     registerCount := gen currentContext currentRegister + 1.
 341     "reserved1 := gen currentContext currentRegister + 1."
 342     optionalKeywords := block optionalKeywords. ].
 343   isClosure ::= gen currentContext isClosure.
 344
 345   gen contexts pop flush.
 346   "Forces the newBlock to record all the remaining stream input correctly."
 347
 348   gen contexts isEmpty \/ [topLevel]
 349     ifFalse:
 350       [result `defaultsTo: gen newRegister. "asking for a register requires a context"
 351        gen emitInstruction: (isClosure ifTrue: [gen newClosure] ifFalse: [gen loadLiteral])
 352            withParameters: {result. newBlock} from: block].
 353
 354   gen contexts isEmpty \/ [topLevel] ifTrue: [newBlock] ifFalse: [result]
 355 ].
 356
 357 gen@(VM SSACompiler traits) generate: sig@(nodes Signature traits) result: resultRegister
 358 [
 359   shouldNotImplement
 360 ].
 361
 362 gen@(VM SSACompiler traits) generate: def@(nodes MethodDefinition traits) result: resultRegister
 363 "Translate method definitions to equivalent asMethod:on: invocations."
 364 [
 365   gen contexts isEmpty
 366     ifTrue: [^ resend].
 367   blockRegister ::= #generate:result: sendTo: {gen. def. Nil} through: {gen. nodes Block. Nil}.
 368   arrayRegister ::= gen newRegister.
 369   selectorRegister ::= gen registerFor: def selector from: def result: Nil.
 370   roleRegisters ::= def roles collect: #(gen generate: _ result: Nil) `er.
 371   resultRegister `defaultsTo: gen newRegister.
 372   gen emitInstruction: gen newArrayWith withParameters: {arrayRegister. roleRegisters size} ; roleRegisters from: def.
 373   gen emitInstruction: gen directSendMessage withParameters: {resultRegister. #asMethod:on:. 3. blockRegister. selectorRegister. arrayRegister} from: def.
 374   resultRegister
 375 ].
 376
 377 gen@(VM SSACompiler traits) generate: r@(nodes Resend traits) result: resultRegister
 378 [
 379   scope ::= gen currentMethod sourceTree.
 380   lexOffset ::= gen contexts indexLast -
 381     ((gen contexts indexOfLastSatisfying: [| :context | context method sourceTree isSameAs: nodes MethodDefinition])
 382       ifNil:
 383         [error: 'resend must be used within a method definition.']).
 384   lexOffset isPositive
 385     ifTrue:
 386       [(gen contexts fromTop: lexOffset) method heapAllocate := True.
 387        (gen contexts top: lexOffset) do: #beClosure `er].
 388   resultRegister `defaultsTo: gen newRegister.
 389   gen emitInstruction: gen resendMessage withParameters: {resultRegister. lexOffset} from: r.
 390   resultRegister
 391 ].
 392
 393 gen@(VM SSACompiler traits) generate: r@(nodes Return traits) result: blah
 394 [overrideThis].
 395
 396 gen@(VM SSACompiler traits) generate: r@(nodes Return traits) by: lexOffset result: resultRegister
 397 [
 398   resultRegister `defaultsTo: gen newRegister.
 399   lexOffset isPositive
 400     ifTrue:
 401       [(gen contexts fromTop: lexOffset) method heapAllocate := True.
 402        (gen contexts top: lexOffset) do: #beClosure `er].
 403   gen generate: r value result: resultRegister.
 404   gen emitInstruction: gen returnFrom withParameters: {resultRegister. lexOffset} from: r.
 405   resultRegister.
 406 ].
 407
 408 gen@(VM SSACompiler traits) generate: r@(nodes ReturnClose traits) result: resultRegister
 409 "Exits the first enclosing named method in the lexical scope."
 410 [
 411   lexOffset ::= gen contexts indexLast -
 412     ((gen contexts indexOfLastSatisfying: [| :context | context method sourceTree isSameAs: nodes MethodDefinition])
 413       ifNil:
 414         [error: '^ must be used within a method definition.']).
 415   gen generate: r by: lexOffset result: resultRegister
 416 ].
 417
 418 gen@(VM SSACompiler traits) generate: r@(nodes ReturnFar traits) result: result
 419 "Exits the last enclosing named method in the lexical scope."
 420 [
 421   lexOffset ::= gen contexts indexLast -
 422     ((gen contexts indexOfFirstSatisfying: [| :context | context method sourceTree isSameAs: nodes MethodDefinition])
 423       ifNil:
 424         [error: '^^ must be used within a method definition.']).
 425   gen generate: r by: lexOffset result: result
 426 ].
 427
 428 gen@(VM SSACompiler traits) generate: r@(nodes ReturnLevel traits) result: result
 429 "Exits the Nth enclosing lexical scope."
 430 [gen generate: r by: r level result: result].
 431
 432 gen@(VM SSACompiler traits) generate: literal@(nodes Literal traits) result: result
 433 [
 434   gen registerFor: literal value from: literal result: result
 435 ].
 436
 437 gen@(VM SSACompiler traits) generate: n@(nodes CompoundStatement traits) result: result
 438 "return the registers that the values were saved into"
 439 [
 440   n statements isEmpty
 441     ifTrue: [#{}]
 442     ifFalse: [(n statements allButLast collect: [| :node | gen generate: node result: Nil])
 443                 ; {(gen generate: n statements last result: result)}]
 444 ].
 445
 446 gen@(VM SSACompiler traits) generate: n@(nodes Parenthesis traits) result: result
 447 "return the registers that the values were saved into"
 448 [
 449   n statements isEmpty
 450    ifTrue: [#{}]
 451    ifFalse: [n statements allButLastDo: [| :node | gen generate: node result: Nil].
 452              gen generate: n statements last result: result]
 453 ].
 454
 455 gen@(VM SSACompiler traits) generate: i@(nodes ImplicitArgument traits) result: result
 456 [
 457   result `defaultsTo: gen newRegister.
 458   gen emitInstruction: gen loadEnvironment withParameters: {result} from: i.
 459   result
 460 ].
 461
 462 gen@(VM SSACompiler traits) generate: _@(nodes Namespace traits) result: result
 463 [shouldNotImplement].
 464
 465 gen@(VM SSACompiler traits) generate: load@(nodes LoadVariable traits) result: result
 466 [
 467   scope ::= load variable scope.
 468   varIndex ::= scope localVariables indexOf: load variable.
 469   lexOffset ::= gen contexts indexLast -
 470     ((gen contexts indexOfLastSatisfying: [| :context | context method sourceTree == scope])
 471       ifNil:
 472         [error: 'Could not determine variable scope.']).
 473   lexOffset isZero
 474     ifTrue:
 475       [result `defaultsTo: varIndex.
 476        gen emitInstruction: gen loadVariable withParameters: {varIndex} from: load.
 477        result = varIndex
 478               ifFalse: [gen emitInstruction: gen moveRegister withParameters: {result. varIndex} from: load]]
 479     ifFalse:
 480       [result `defaultsTo: gen newRegister.
 481        (gen contexts fromTop: lexOffset) method heapAllocate := True.
 482        (gen contexts top: lexOffset) do: #beClosure `er.
 483        gen emitInstruction: gen loadFreeVariable withParameters: {result. lexOffset. varIndex} from: load].
 484   result
 485 ].
 486
 487 gen@(VM SSACompiler traits) generate: store@(nodes StoreVariable traits) result: result
 488 [
 489   scope ::= store variable scope.
 490   varIndex ::= scope localVariables indexOf: store variable.
 491   lexOffset ::= gen contexts indexLast -
 492     ((gen contexts indexOfLastSatisfying: [| :context | context method sourceTree == scope])
 493       ifNil:
 494         [error: 'Could not determine variable scope.']).
 495   lexOffset isZero
 496     ifTrue:
 497       [result `defaultsTo: varIndex.
 498        gen generate: store value result: varIndex.
 499        gen emitInstruction: gen storeVariable withParameters: {varIndex} from: store.
 500        result = varIndex
 501               ifFalse: [gen emitInstruction: gen moveRegister withParameters: {result. varIndex} from: store]]
 502     ifFalse:
 503       [result `defaultsTo: gen newRegister.
 504        gen generate: store value result: result.
 505        (gen contexts fromTop: lexOffset) method heapAllocate := True.
 506        (gen contexts top: lexOffset) do: #beClosure `er.
 507        gen emitInstruction: gen storeFreeVariable withParameters: {lexOffset. varIndex. result} from: store].
 508   result
 509 ].
 510
 511 gen@(VM SSACompiler traits) generate: array@(nodes Array traits) result: result
 512 "Generate the code to push the element expression results on the stack,
 513 then the appropriate literal-array constructor bytecode."
 514 [
 515   registers ::= resend.
 516   result `defaultsTo: gen newRegister.
 517   gen emitInstruction: gen newArrayWith withParameters: {result. array size} ; registers from: array.
 518   result
 519 ].
 520
 521 gen@(VM SSACompiler traits) generate: selector@(Symbol traits) on: args from: msg@(nodes Message traits) result: result
 522 "Generate the code to push the argument expression results on the stack, then
 523 the push for the selector, and then the appropriate message send bytecode."
 524 [
 525   result `defaultsTo: gen newRegister.
 526   argRegisters ::= args collect: #(gen generate: _ result: Nil) `er.
 527   gen emitInstruction: gen directSendMessage withParameters: {result. selector. args size} ; argRegisters from: msg.
 528   result
 529 ].
 530
 531 gen@(VM SSACompiler traits) generate: msg@(nodes Message traits) result: result &optionals: opts
 532 [
 533   gen generate: msg selector on: msg arguments from: (opts `defaultsTo: msg) result: result
 534 ].
 535
 536 gen@(VM SSACompiler traits) generate: macro@(nodes Macro traits) result: result &optionals: opts
 537 [
 538   "gen generate: (macro macroExpand &optionals: opts &environment: gen currentMethod sourceTree) result: result"
 539   error: 'SSA Compiler cannot support macroexpansion at code generation time because of localVariable side-effects'.
 540 ].
 541
 542 gen@(VM SSACompiler traits) generate: def@(nodes Deferred traits) result: result &optionals: opts
 543 [| message |
 544   block ::= nodes Block new `>> [parentScope := gen currentMethod sourceTree. ].
 545   def arguments size timesRepeat: [block addInputVariable].
 546   message := nodes Message sending: def selector to:
 547     (block inputVariables collect: #(nodes LoadVariable from: _) `er).
 548   opts
 549     ifNotNil:
 550       [message :=
 551         ((nodes OptionalArguments for: message)
 552           `>> [arguments := opts arguments deepCopy: block. ])].
 553   block statements := {message}.
 554   gen generate:
 555     (nodes KeywordMessage
 556       sending: #whenFulfilled:
 557       to: {def arguments as: nodes Array. block})
 558     result: result
 559 ].
 560
 561 gen@(VM SSACompiler traits) generate: selector@(Symbol traits) on: args from: opts@(nodes OptionalKeywords traits) result: result
 562 "Generate the code to push the argument expression results on the stack, then
 563 the push for the selector, and then the appropriate message send bytecode."
 564 [
 565   result `defaultsTo: gen newRegister.
 566   argRegisters ::= args collect: #(gen generate: _ result: Nil) `er.
 567   optsArray ::= ExtensibleArray new.
 568   optsWriter ::= optsArray writer.
 569   opts keywords with: opts arguments do:
 570     [| :key :arg |
 571      optsWriter nextPut: (gen registerFor: key from: opts result: Nil).
 572      optsWriter nextPut: (gen generate: arg result: Nil)].
 573   gen emitInstruction: gen sendMessageWithOptionalsInline withParameters:
 574     {result. selector. args size. optsArray size} ; argRegisters ; optsArray from: opts.
 575   result
 576 ].
 577
 578 gen@(VM SSACompiler traits) generate: opts@(nodes OptionalKeywords traits) result: result
 579 [
 580   gen generate: opts message result: result &optionals: opts
 581 ].
 582
 583 gen@(VM SSACompiler traits) generate: rest@(nodes RestArguments traits) result: result
 584 [
 585   gen generate: rest message selector on: rest message arguments ; rest arguments from: rest message result: result
 586 ].
 587
 588 gen@(VM SSACompiler traits) generate: _@#apply* on: args from: msg result: result
 589 [
 590   result `defaultsTo: gen newRegister.
 591   methodReg ::= gen generate: args first result: Nil.
 592   argRegs ::= args allButFirst collect: [| :item | gen generate: item result: Nil].
 593   gen emitInstruction: gen directApplyTo withParameters: {methodReg. argRegs size. result} ; argRegs from: msg.
 594   result
 595 ].
 596
 597 gen@(VM SSACompiler traits) generate: _@#applyTo: on: args from: msg result: result
 598 [
 599   (args second isSameAs: nodes Array)
 600     ifTrue:
 601       [result `defaultsTo: gen newRegister.
 602        methodReg ::= gen generate: args first result: Nil.
 603        argRegs ::= args second statements collect:
 604          [| :item | gen generate: item result: Nil].
 605        gen emitInstruction: gen directApplyTo
 606          withParameters: {methodReg. argRegs size. result} ; argRegs
 607          from: msg.
 608        result]
 609     ifFalse: [resend]
 610 ].
 611
 612 gen@(VM SSACompiler traits) generate: _@#primitiveApply* on: args from: msg result: result
 613 [
 614   result `defaultsTo: gen newRegister.
 615   indexReg ::= gen generate: args first result: Nil.
 616   argRegs ::= args second statements collect: [| :item | gen generate: item result: Nil].
 617   gen emitInstruction: gen primitiveDo withParameters: {indexReg. argRegs size. result} ; argRegs from: msg.
 618   result
 619 ].
 620
 621 gen@(VM SSACompiler traits) generate: _@#True on: args from: msg result: result
 622 [
 623   (args first isSameAs: nodes ImplicitArgument)
 624     ifTrue: [gen registerFor: True from: msg result: result]
 625     ifFalse: [resend]
 626 ].
 627
 628 gen@(VM SSACompiler traits) generate: _@#False on: args from: msg result: result
 629 [
 630   (args first isSameAs: nodes ImplicitArgument)
 631     ifTrue: [gen registerFor: False from: msg result: result]
 632     ifFalse: [resend]
 633 ].
 634
 635 gen@(VM SSACompiler traits) generate: _@#Nil on: args from: msg result: result
 636 [
 637   (args first isSameAs: nodes ImplicitArgument)
 638     ifTrue: [gen registerFor: Nil from: msg result: result]
 639     ifFalse: [resend]
 640 ].
 641
 642 gen@(VM SSACompiler traits) generate: _@#== on: args from: msg result: result
 643 [
 644   result `defaultsTo: gen newRegister.
 645   argRegs ::= args collect: [| :arg | gen generate: arg result: Nil].
 646   gen emitInstruction: gen isIdenticalTo withParameters: {result. argRegs first. argRegs second} from: msg.
 647   result
 648 ].
 649
 650 gen@(VM SSACompiler traits) generate: _@#do on: args from: msg result: result
 651 "If the block is a literal with no variables, then inline it.
 652 Otherwise, fall back to evaluating it via 'do'."
 653 [
 654   ((block ::= args first) isSameAs: nodes Block)
 655     /\ [block localVariables isEmpty]
 656     ifTrue:
 657       [result `defaultsTo: gen newRegister.
 658        block statements isEmpty
 659          ifTrue: [gen emitInstruction: gen loadLiteral withParameters: {result. Nil} from: msg.
 660                   result]
 661          ifFalse: [block statements allButLastDo: [| :node | gen generate: node result: Nil].
 662                    gen generate: block statements last result: result]]
 663     ifFalse: [resend]
 664 ].
 665
 666 gen@(VM SSACompiler traits) generateExecutionOf: args from: msg result: result
 667 [gen generate: #do on: args from: msg result: result].
 668
 669 gen@(VM SSACompiler traits) generate: _@#loop on: args from: msg result: result
 670 "Repeatedly evaluates a block via 'do'."
 671 [
 672   label ::= gen emitLabel.
 673   gen generateExecutionOf: args from: msg result: Nil.
 674   gen emitInstruction: gen jumpTo withParameters: #{}"see below" from: msg.
 675   gen emitBranchTo: label from: msg.
 676   gen registerFor: Nil from: msg result: result "return nil"
 677 ].
 678
 679 gen@(VM SSACompiler traits) generate: _@#isNil on: args from: msg result: result
 680 [
 681   result `defaultsTo: gen newRegister.
 682   objReg ::= gen generate: args first result: Nil.
 683   gen emitInstruction: gen isNilOp withParameters: {result. objReg} from: msg.
 684   result
 685 ].
 686
 687 gen@(VM SSACompiler traits) branchTableHash: key
 688 [
 689   key identityHash
 690 ].
 691
 692 gen@(VM SSACompiler traits) buildBranchTableMapping: keys
 693 [| tableSize |
 694   tableSize := 1.
 695   [tableSize < keys size]
 696     whileTrue:
 697       [tableSize *= 2].
 698   table ::= Array newSize: tableSize * 2.
 699   keys do:
 700     [| :key hash |
 701      hash := (gen branchTableHash: key) bitAnd: (tableSize - 1) * 2.
 702      [(table at: hash) isNil]
 703        whileFalse:
 704          [key = (table at: hash)
 705             ifTrue:
 706               [error: 'Duplicate key ' ; key printString ; ' in caseOf:.'].
 707           (hash += 2) >= (tableSize * 2) ifTrue:
 708             [hash := 0]].
 709      table at: hash put: key].
 710   table
 711 ].
 712
 713 gen@(VM SSACompiler traits) mayInlineCaseOf: msg
 714 "Answer whether a safe inlining is possible for a caseOf: expression without
 715 further analysis; currently this is the case where the second argument is a
 716 literal array, and the appropriate Associations and their elements are laid
 717 out with literal keys."
 718 [
 719   (msg arguments second isSameAs: nodes Array) /\
 720    [msg arguments second statements allSatisfy:
 721      [| :assoc |
 722       (assoc is: nodes Message)
 723         /\ [assoc selector = #->]
 724         /\ [assoc arguments first is: nodes Literal]
 725         /\ [{Symbol. ASCIIString Character. SmallInteger} anySatisfy:
 726           [| :proto | assoc arguments first value is: proto]]]]
 727 ].
 728
 729 gen@(VM SSACompiler traits) generate: _@#caseOf:otherwise: on: args from: msg result: finalResult
 730 [
 731   (gen mayInlineCaseOf: msg)
 732    ifFalse: [^ resend].
 733   assocs ::= args second statements.
 734   labels ::= assocs collect: [| :_ | gen newLabelIndex].
 735   finalResult `defaultsTo: gen newRegister.
 736   table ::=
 737     gen buildBranchTableMapping:
 738       (assocs collect: [| :assoc | assoc arguments first value]).
 739   indices ::= IdentityDictionary new.
 740   0 below: table size by: 2 do:
 741     [| :index | (table at: index) ifNotNilDo: [| :val | indices at: val put: index]].
 742
 743   switchKeyRegister ::= gen generate: args first result: Nil.
 744   gen emitInstruction: gen branchKeyed
 745     withParameters: {switchKeyRegister. gen registerFor: table from: msg result: Nil}
 746     from: msg.
 747   branchOffset ::= gen codeWriter position.
 748   gen emitInstruction: gen jumpTo from: msg.
 749   endLabel ::= gen newLabelIndex.
 750   otherwiseLabel ::= gen newLabelIndex.
 751   gen emitBranchTo: otherwiseLabel from: msg.
 752
 753   assocs with: labels do:
 754     [| :assoc :label |
 755      gen emitLabel &labelIndex: label.
 756      table
 757        at: (indices at: assoc arguments first value) + 1
 758        put: (gen currentContext resolveLabel: label at: branchOffset).
 759      gen generateExecutionOf: {assoc arguments second} from: msg result: finalResult.
 760      gen emitInstruction: gen jumpTo from: msg.
 761      gen emitBranchTo: endLabel from: msg].
 762
 763   "Handle the otherwise clause. If we didn't get a literal block for it, just
 764     encode a Nil-push."
 765   gen emitLabel &labelIndex: otherwiseLabel.
 766   args size >= 3
 767     ifTrue: [gen generateExecutionOf: {args third} from: msg result: finalResult]
 768     ifFalse: [gen registerFor: Nil from: msg result: finalResult].
 769   gen emitLabel &labelIndex: endLabel.
 770   finalResult
 771 ].
 772
 773 gen@(VM SSACompiler traits) generate: _@#caseOf: on: args from: msg result: result
 774 "Generates a caseOf:otherwise: with a default otherwise clause."
 775 [
 776   (gen mayInlineCaseOf: msg)
 777     ifTrue: [gen generate: #caseOf:otherwise: on: args from: msg result: result]
 778     ifFalse: [resend]
 779 ].
 780
 781 gen@(VM SSACompiler traits) generate: _@#ifTrue:ifFalse: on: args from: msg result: finalResult
 782 "Branches to one of two blocks and evaluates it."
 783 [
 784   falseLabel ::= gen newLabelIndex.
 785   endLabel ::= gen newLabelIndex.
 786   finalResult `defaultsTo: gen newRegister.
 787   (condReg ::= gen generate: args first result: Nil)
 788     ifNil: [error: 'conditional is nil: ' ; args first printString].
 789   gen emitInstruction: gen branchIfFalse withParameters: {condReg} from: msg.
 790   gen emitBranchTo: falseLabel from: msg.
 791   gen generateExecutionOf: {args second} from: msg result: finalResult.
 792   gen emitInstruction: gen jumpTo from: msg.
 793   gen emitBranchTo: endLabel from: msg.
 794   gen emitLabel &labelIndex: falseLabel.
 795   gen generateExecutionOf: {args third} from: msg result: finalResult.
 796   gen emitLabel &labelIndex: endLabel.
 797   finalResult
 798 ].
 799
 800 gen@(VM SSACompiler traits) generate: _@#ifTrue: on: args from: msg result: finalResult
 801 "Optionally evaluates a block."
 802 [
 803   falseLabel ::= gen newLabelIndex.
 804   endLabel ::= gen newLabelIndex.
 805   finalResult `defaultsTo: gen newRegister.
 806   (condReg ::= gen generate: args first result: Nil)
 807     ifNil: [error: 'conditional is nil: ' ; args first printString].
 808   gen emitInstruction: gen branchIfFalse withParameters: {condReg} from: msg.
 809   gen emitBranchTo: falseLabel from: msg.
 810   gen generateExecutionOf: {args second} from: msg result: finalResult.
 811   gen emitInstruction: gen jumpTo from: msg.
 812   gen emitBranchTo: endLabel from: msg.
 813   gen emitLabel &labelIndex: falseLabel.
 814   gen registerFor: Nil from: msg result: finalResult.
 815   gen emitLabel &labelIndex: endLabel.
 816   finalResult
 817 ].
 818
 819 gen@(VM SSACompiler traits) generate: _@#ifFalse: on: args from: msg result: finalResult
 820 [
 821   falseLabel ::= gen newLabelIndex.
 822   endLabel ::= gen newLabelIndex.
 823   finalResult `defaultsTo: gen newRegister.
 824   (condResult ::= gen generate: args first result: Nil)
 825     ifNil: [error: 'conditional is nil: ' ; args first printString].
 826   gen emitInstruction: gen branchIfTrue withParameters: {condResult} from: msg.
 827   gen emitBranchTo: falseLabel from: msg.
 828   gen generateExecutionOf: {args second} from: msg result: finalResult.
 829   gen emitInstruction: gen jumpTo from: msg.
 830   gen emitBranchTo: endLabel from: msg.
 831   gen emitLabel &labelIndex: falseLabel.
 832   gen registerFor: Nil from: msg result: finalResult.
 833   gen emitLabel &labelIndex: endLabel.
 834   finalResult
 835 ].
 836
 837 gen@(VM SSACompiler traits) generate: _@#ifNil: on: args from: msg result: finalResult
 838 [
 839   endLabel ::= gen newLabelIndex.
 840   finalResult `defaultsTo: gen newRegister.
 841   lhsValueReg ::= gen generate: args first result: finalResult. "do not evaluate twice"
 842   condReg ::= gen newRegister.
 843   gen emitInstruction: gen isNilOp withParameters: {condReg. lhsValueReg} from: msg.
 844   gen emitInstruction: gen branchIfFalse withParameters: {condReg} from: msg.
 845   gen emitBranchTo: endLabel from: msg.
 846   gen generateExecutionOf: {args second} from: msg result: finalResult.
 847   gen emitLabel &labelIndex: endLabel.
 848   finalResult
 849 ].
 850
 851 gen@(VM SSACompiler traits) generate: _@#ifNotNil: on: args from: msg result: finalResult
 852 [
 853   endLabel ::= gen newLabelIndex.
 854   finalResult `defaultsTo: gen newRegister.
 855   lhsValueReg ::= gen generate: args first result: finalResult. "do not evaluate twice"
 856   condReg ::= gen newRegister.
 857   gen emitInstruction: gen isNilOp withParameters: {condReg. lhsValueReg} from: msg.
 858   gen emitInstruction: gen branchIfTrue withParameters: {condReg} from: msg.
 859   gen emitBranchTo: endLabel from: msg.
 860   gen generateExecutionOf: {args second} from: msg result: finalResult.
 861   gen emitLabel &labelIndex: endLabel.
 862   finalResult
 863 ].
 864
 865 gen@(VM SSACompiler traits) generate: _@#/\ on: args from: msg result: finalResult
 866 "Optionally evaluates a block."
 867 [
 868   (args second isSameAs: nodes Block)
 869     ifFalse: [^ resend].
 870   falseLabel ::= gen newLabelIndex.
 871   endLabel ::= gen newLabelIndex.
 872   finalResult `defaultsTo: gen newRegister.
 873   (condResult ::= gen generate: args first result: Nil)
 874     ifNil: [error: 'conditional is nil: ' ; args first printString].
 875   gen emitInstruction: gen branchIfFalse withParameters: {condResult} from: msg.
 876   gen emitBranchTo: falseLabel from: msg.
 877   gen generateExecutionOf: {args second} from: msg result: finalResult.
 878   gen emitInstruction: gen jumpTo from: msg.
 879   gen emitBranchTo: endLabel from: msg.
 880   gen emitLabel &labelIndex: falseLabel.
 881   gen registerFor: False from: msg result: finalResult.
 882   gen emitLabel &labelIndex: endLabel.
 883   finalResult
 884 ].
 885
 886 gen@(VM SSACompiler traits) generate: _@#\/ on: args from: msg result: finalResult
 887 "Optionally evaluates a block."
 888 [
 889   (args second isSameAs: nodes Block)
 890     ifFalse: [^ resend].
 891   falseLabel ::= gen newLabelIndex.
 892   endLabel ::= gen newLabelIndex.
 893   finalResult `defaultsTo: gen newRegister.
 894   (condResult ::= gen generate: args first result: Nil)
 895     ifNil: [error: 'conditional is nil: ' ; args first printString].
 896   gen emitInstruction: gen branchIfTrue withParameters: {condResult} from: msg.
 897   gen emitBranchTo: falseLabel from: msg.
 898   gen generateExecutionOf: {args second} from: msg result: finalResult.
 899   gen emitInstruction: gen jumpTo from: msg.
 900   gen emitBranchTo: endLabel from: msg.
 901   gen emitLabel &labelIndex: falseLabel.
 902   gen registerFor: True from: msg result: finalResult.
 903   gen emitLabel &labelIndex: endLabel.
 904   finalResult
 905 ].
 906
 907 gen@(VM SSACompiler traits) generate: _@#whileTrue: on: args from: msg result: finalResult
 908 "Repeatedly evaluates a block while it returns True."
 909 [
 910   endLabel ::= gen newLabelIndex.
 911   label ::= gen emitLabel.
 912   (condResult ::= gen generateExecutionOf: {args first} from: msg result: Nil)
 913     ifNil: [error: 'conditional is nil: ' ; args first printString].
 914   gen emitInstruction: gen branchIfFalse withParameters: {condResult} from: msg.
 915   gen emitBranchTo: endLabel from: msg.
 916   gen generateExecutionOf: {args second} from: msg result: Nil.
 917   gen emitInstruction: gen jumpTo from: msg.
 918   gen emitBranchTo: label from: msg.
 919   gen emitLabel &labelIndex: endLabel.
 920   gen registerFor: Nil from: msg result: finalResult
 921 ].
 922
 923 gen@(VM SSACompiler traits) generate: _@#whileFalse: on: args from: msg result: finalResult
 924 "Repeatedly evaluates a block while it returns False."
 925 [
 926   endLabel ::= gen newLabelIndex.
 927   label ::= gen emitLabel.
 928   (condResult ::= gen generateExecutionOf: {args first} from: msg result: Nil)
 929     ifNil: [error: 'conditional is nil: ' ; args first printString].
 930   gen emitInstruction: gen branchIfTrue withParameters: {condResult} from: msg.
 931   gen emitBranchTo: endLabel from: msg.
 932   gen generateExecutionOf: {args second} from: msg result: Nil.
 933   gen emitInstruction: gen jumpTo from: msg.
 934   gen emitBranchTo: label from: msg.
 935   gen emitLabel &labelIndex: endLabel.
 936   gen registerFor: Nil from: msg result: finalResult
 937 ].
 938
 939 gen@(VM SSACompiler traits) generate: _@#whileTrue on: args from: msg result: result
 940 "Repeatedly evaluates a block while it returns True."
 941 [
 942   label ::= gen emitLabel.
 943   (condResult ::= gen generateExecutionOf: args from: msg result: Nil)
 944     ifNil: [error: 'conditional is nil: ' ; args first printString].
 945   gen emitInstruction: gen branchIfTrue withParameters: {condResult} from: msg.
 946   gen emitBranchTo: label from: msg.
 947   gen registerFor: Nil from: msg result: result
 948 ].
 949
 950 gen@(VM SSACompiler traits) generate: _@#whileFalse on: args from: msg result: result
 951 "Repeatedly evaluates a block while it returns False."
 952 [
 953   label ::= gen emitLabel.
 954   (condResult ::= gen generateExecutionOf: args from: msg result: Nil)
 955     ifNil: [error: 'conditional is nil: ' ; args first printString].
 956   gen emitInstruction: gen branchIfFalse withParameters: {condResult} from: msg.
 957   gen emitBranchTo: label from: msg.
 958   gen registerFor: Nil from: msg result: result
 959 ].
 960
 961 gen@(VM SSACompiler traits) generate: _@#primitiveDo: on: args from: msg result: result
 962 [
 963   result `defaultsTo: gen newRegister.
 964   indexReg ::= gen generate: args first result: Nil.
 965   argRegs ::= args second statements collect: [| :item | gen generate: item result: Nil].
 966   gen emitInstruction: gen primitiveDo withParameters: {indexReg. argRegs size. result} ; argRegs from: msg.
 967   result
 968 ].
 969
 970 gen@(VM SSACompiler traits) generate: _@#fill:with: on: args from: msg result: result
 971 [| index value tempVar |
 972   block ::= args first.
 973   index := args second.
 974   value := args third.
 975   (block isSameAs: nodes Block)
 976     /\ [index isSameAs: nodes Literal]
 977     /\ [block inputVariables acceptsKey: index value]
 978     ifFalse: [^ resend].
 979   (value isSameAs: nodes Literal)
 980     ifFalse:
 981       [tempVar := gen currentMethod sourceTree addVariable.
 982        gen generate: (nodes StoreVariable of: value into: tempVar) result: Nil. "fixme"
 983        value := nodes LoadVariable from: tempVar].
 984   index := index value.
 985   var ::= block inputVariables at: index.
 986   block inputVariables := block inputVariables copyWithoutAt: index.
 987   block localVariables
 988     replaceFrom: index
 989     below: block localVariables indexLast
 990     with: block localVariables
 991     startingAt: index + 1.
 992   block localVariables at: block localVariables indexLast put: var.
 993   block statements :=
 994     {nodes StoreVariable of: value into: var} ; block statements.
 995   gen generate: block result: result
 996 ].
 997
 998 gen@(VM SSACompiler traits) generate: _@#<-* on: args from: msg result: result
 999 "Optimizes currying calls on literal blocks using #fill:with:."
1000 [
1001   (args first isSameAs: nodes Block)
1002     ifTrue:
1003       [gen
1004          generate: #fill:with:
1005          on: (args copyWith:
1006                 (nodes Literal for: args first inputVariables indexLast) at: 1)
1007          from: msg
1008          result: result]
1009     ifFalse: [resend]
1010 ].