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: 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: 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 := block bodyIncludesImplicitSends ifTrue:
 321        [gen contexts isEmpty
 322           ifTrue: [block topLevel namespace]
 323           ifFalse: [gen currentMethod environment]].
 324      sourceTree := block. ].
 325   gen contexts push: (gen Context newOn: newBlock).
 326   "we macroexpand everything before we set the current register because macroexpansion can add localvariables etc"
 327   statements ::= block statements collect:
 328     [| :statement | statement macroExpand &environment: gen currentMethod sourceTree].
 329   gen currentContext currentRegister := block localVariables size. "input variables might not be needed"
 330   statements isEmpty
 331     ifTrue: [gen emitInstruction: gen returnValue withParameters: {Nil} from: block]
 332     ifFalse:
 333       [statements allButLastDo: [| :node | gen generate: node result: Nil].
 334        gen emitInstruction: gen returnRegister withParameters: {gen generate: statements last result: Nil} from: block].
 335
 336   "Set the variable information after generation, just in case it was modified."
 337   newBlock `>>
 338    [inputVariables := block inputVariables size.
 339     localVariables := block localVariables size.
 340     restVariable := block restVariable isNotNil.
 341     registerCount := gen currentContext currentRegister + 1.
 342     "reserved1 := gen currentContext currentRegister + 1."
 343     optionalKeywords := block optionalKeywords. ].
 344   isClosure ::= gen currentContext isClosure.
 345
 346   gen contexts pop flush.
 347   "Forces the newBlock to record all the remaining stream input correctly."
 348
 349   gen contexts isEmpty \/ [topLevel]
 350     ifFalse:
 351       [result `defaultsTo: gen newRegister. "asking for a register requires a context"
 352        gen emitInstruction: (isClosure ifTrue: [gen newClosure] ifFalse: [gen loadLiteral])
 353            withParameters: {result. newBlock} from: block].
 354
 355   gen contexts isEmpty \/ [topLevel] ifTrue: [newBlock] ifFalse: [result]
 356 ].
 357
 358 gen@(VM SSACompiler traits) generate: sig@(nodes Signature traits) result: resultRegister
 359 [
 360   shouldNotImplement
 361 ].
 362
 363 gen@(VM SSACompiler traits) generate: def@(nodes MethodDefinition traits) result: resultRegister
 364 "Translate method definitions to equivalent asMethod:on: invocations."
 365 [
 366   gen contexts isEmpty
 367     ifTrue: [^ resend].
 368   blockRegister ::= #generate:result: sendTo: {gen. def. Nil} through: {gen. nodes Block. Nil}.
 369   arrayRegister ::= gen newRegister.
 370   selectorRegister ::= gen registerFor: def selector from: def result: Nil.
 371   roleRegisters ::= def roles collect: #(gen generate: _ result: Nil) `er.
 372   resultRegister `defaultsTo: gen newRegister.
 373   gen emitInstruction: gen newArrayWith withParameters: {arrayRegister. roleRegisters size} ; roleRegisters from: def.
 374   gen emitInstruction: gen directSendMessage withParameters: {resultRegister. #asMethod:on:. 3. blockRegister. selectorRegister. arrayRegister} from: def.
 375   resultRegister
 376 ].
 377
 378 gen@(VM SSACompiler traits) generate: r@(nodes Resend traits) result: resultRegister
 379 [
 380   scope ::= gen currentMethod sourceTree.
 381   lexOffset ::= gen contexts indexLast -
 382     ((gen contexts indexOfLastSatisfying: [| :context | context method sourceTree isSameAs: nodes MethodDefinition])
 383       ifNil:
 384         [error: 'resend must be used within a method definition.']).
 385   lexOffset isPositive
 386     ifTrue:
 387       [(gen contexts fromTop: lexOffset) method heapAllocate := True.
 388        (gen contexts top: lexOffset) do: #beClosure `er].
 389   resultRegister `defaultsTo: gen newRegister.
 390   gen emitInstruction: gen resendMessage withParameters: {resultRegister. lexOffset} from: r.
 391   resultRegister
 392 ].
 393
 394 gen@(VM SSACompiler traits) generate: r@(nodes Return traits) result: blah
 395 [overrideThis].
 396
 397 gen@(VM SSACompiler traits) generate: r@(nodes Return traits) by: lexOffset result: resultRegister
 398 [
 399   resultRegister `defaultsTo: gen newRegister.
 400   lexOffset isPositive
 401     ifTrue:
 402       [(gen contexts fromTop: lexOffset) method heapAllocate := True.
 403        (gen contexts top: lexOffset) do: #beClosure `er].
 404   gen generate: r value result: resultRegister.
 405   gen emitInstruction: gen returnFrom withParameters: {resultRegister. lexOffset} from: r.
 406   resultRegister.
 407 ].
 408
 409 gen@(VM SSACompiler traits) generate: r@(nodes ReturnClose traits) result: resultRegister
 410 "Exits the first enclosing named method in the lexical scope."
 411 [
 412   lexOffset ::= gen contexts indexLast -
 413     ((gen contexts indexOfLastSatisfying: [| :context | context method sourceTree isSameAs: nodes MethodDefinition])
 414       ifNil:
 415         [error: '^ must be used within a method definition.']).
 416   gen generate: r by: lexOffset result: resultRegister
 417 ].
 418
 419 gen@(VM SSACompiler traits) generate: r@(nodes ReturnFar traits) result: result
 420 "Exits the last enclosing named method in the lexical scope."
 421 [
 422   lexOffset ::= gen contexts indexLast -
 423     ((gen contexts indexOfFirstSatisfying: [| :context | context method sourceTree isSameAs: nodes MethodDefinition])
 424       ifNil:
 425         [error: '^^ must be used within a method definition.']).
 426   gen generate: r by: lexOffset result: result
 427 ].
 428
 429 gen@(VM SSACompiler traits) generate: r@(nodes ReturnLevel traits) result: result
 430 "Exits the Nth enclosing lexical scope."
 431 [gen generate: r by: r level result: result].
 432
 433 gen@(VM SSACompiler traits) generate: literal@(nodes Literal traits) result: result
 434 [
 435   gen registerFor: literal value from: literal result: result
 436 ].
 437
 438 gen@(VM SSACompiler traits) generate: n@(nodes CompoundStatement traits) result: result
 439 "return the registers that the values were saved into"
 440 [
 441   n statements isEmpty
 442     ifTrue: [#{}]
 443     ifFalse: [(n statements allButLast collect: [| :node | gen generate: node result: Nil])
 444                 ; {(gen generate: n statements last result: result)}]
 445 ].
 446
 447 gen@(VM SSACompiler traits) generate: n@(nodes Parenthesis traits) result: result
 448 "return the registers that the values were saved into"
 449 [
 450   n statements isEmpty
 451    ifTrue: [#{}]
 452    ifFalse: [n statements allButLastDo: [| :node | gen generate: node result: Nil].
 453              gen generate: n statements last result: result]
 454 ].
 455
 456 gen@(VM SSACompiler traits) generate: i@(nodes ImplicitArgument traits) result: result
 457 [
 458   result `defaultsTo: gen newRegister.
 459   gen emitInstruction: gen loadEnvironment withParameters: {result} from: i.
 460   result
 461 ].
 462
 463 gen@(VM SSACompiler traits) generate: _@(nodes Namespace traits) result: result
 464 [shouldNotImplement].
 465
 466 gen@(VM SSACompiler traits) generate: load@(nodes LoadVariable traits) result: result
 467 [
 468   scope ::= load variable scope.
 469   varIndex ::= scope localVariables indexOf: load variable.
 470   lexOffset ::= gen contexts indexLast -
 471     ((gen contexts indexOfLastSatisfying: [| :context | context method sourceTree == scope])
 472       ifNil:
 473         [error: 'Could not determine variable scope.']).
 474   lexOffset isZero
 475     ifTrue:
 476       [result `defaultsTo: varIndex.
 477        gen emitInstruction: gen loadVariable withParameters: {varIndex} from: load.
 478        result = varIndex
 479               ifFalse: [gen emitInstruction: gen moveRegister withParameters: {result. varIndex} from: load]]
 480     ifFalse:
 481       [result `defaultsTo: gen newRegister.
 482        (gen contexts fromTop: lexOffset) method heapAllocate := True.
 483        (gen contexts top: lexOffset) do: #beClosure `er.
 484        gen emitInstruction: gen loadFreeVariable withParameters: {result. lexOffset. varIndex} from: load].
 485   result
 486 ].
 487
 488 gen@(VM SSACompiler traits) generate: store@(nodes StoreVariable traits) result: result
 489 [
 490   scope ::= store variable scope.
 491   varIndex ::= scope localVariables indexOf: store variable.
 492   lexOffset ::= gen contexts indexLast -
 493     ((gen contexts indexOfLastSatisfying: [| :context | context method sourceTree == scope])
 494       ifNil:
 495         [error: 'Could not determine variable scope.']).
 496   lexOffset isZero
 497     ifTrue:
 498       [result `defaultsTo: varIndex.
 499        gen generate: store value result: varIndex.
 500        gen emitInstruction: gen storeVariable withParameters: {varIndex} from: store.
 501        result = varIndex
 502               ifFalse: [gen emitInstruction: gen moveRegister withParameters: {result. varIndex} from: store]]
 503     ifFalse:
 504       [result `defaultsTo: gen newRegister.
 505        gen generate: store value result: result.
 506        (gen contexts fromTop: lexOffset) method heapAllocate := True.
 507        (gen contexts top: lexOffset) do: #beClosure `er.
 508        gen emitInstruction: gen storeFreeVariable withParameters: {lexOffset. varIndex. result} from: store].
 509   result
 510 ].
 511
 512 gen@(VM SSACompiler traits) generate: array@(nodes Array traits) result: result
 513 "Generate the code to push the element expression results on the stack,
 514 then the appropriate literal-array constructor bytecode."
 515 [
 516   registers ::= resend.
 517   result `defaultsTo: gen newRegister.
 518   gen emitInstruction: gen newArrayWith withParameters: {result. array size} ; registers from: array.
 519   result
 520 ].
 521
 522 gen@(VM SSACompiler traits) generate: selector@(Symbol traits) on: args from: msg@(nodes Message traits) result: result
 523 "Generate the code to push the argument expression results on the stack, then
 524 the push for the selector, and then the appropriate message send bytecode."
 525 [
 526   result `defaultsTo: gen newRegister.
 527   argRegisters ::= args collect: #(gen generate: _ result: Nil) `er.
 528   gen emitInstruction: gen directSendMessage withParameters: {result. selector. args size} ; argRegisters from: msg.
 529   result
 530 ].
 531
 532 gen@(VM SSACompiler traits) generate: msg@(nodes Message traits) result: result &optionals: opts
 533 [
 534   gen generate: msg selector on: msg arguments from: (opts `defaultsTo: msg) result: result
 535 ].
 536
 537 gen@(VM SSACompiler traits) generate: macro@(nodes Macro traits) result: result &optionals: opts
 538 [
 539   "gen generate: (macro macroExpand &optionals: opts &environment: gen currentMethod sourceTree) result: result"
 540   error: 'SSA Compiler cannot support macroexpansion at code generation time because of localVariable side-effects'.
 541 ].
 542
 543 gen@(VM SSACompiler traits) generate: def@(nodes Deferred traits) result: result &optionals: opts
 544 [| message |
 545   block ::= nodes Block new `>> [parentScope := gen currentMethod sourceTree. ].
 546   def arguments size timesRepeat: [block addInputVariable].
 547   message := nodes Message sending: def selector to:
 548     (block inputVariables collect: #(nodes LoadVariable from: _) `er).
 549   opts
 550     ifNotNil:
 551       [message :=
 552         ((nodes OptionalArguments for: message)
 553           `>> [arguments := opts arguments deepCopy: block. ])].
 554   block statements := {message}.
 555   gen generate:
 556     (nodes KeywordMessage
 557       sending: #whenFulfilled:
 558       to: {def arguments as: nodes Array. block})
 559     result: result
 560 ].
 561
 562 gen@(VM SSACompiler traits) generate: selector@(Symbol traits) on: args from: opts@(nodes OptionalKeywords traits) result: result
 563 "Generate the code to push the argument expression results on the stack, then
 564 the push for the selector, and then the appropriate message send bytecode."
 565 [
 566   result `defaultsTo: gen newRegister.
 567   argRegisters ::= args collect: #(gen generate: _ result: Nil) `er.
 568   optsArray ::= ExtensibleArray new.
 569   optsWriter ::= optsArray writer.
 570   opts keywords with: opts arguments do:
 571     [| :key :arg |
 572      optsWriter nextPut: (gen registerFor: key from: opts result: Nil).
 573      optsWriter nextPut: (gen generate: arg result: Nil)].
 574   gen emitInstruction: gen sendMessageWithOptionalsInline withParameters:
 575     {result. selector. args size. optsArray size} ; argRegisters ; optsArray from: opts.
 576   result
 577 ].
 578
 579 gen@(VM SSACompiler traits) generate: opts@(nodes OptionalKeywords traits) result: result
 580 [
 581   gen generate: opts message result: result &optionals: opts
 582 ].
 583
 584 gen@(VM SSACompiler traits) generate: rest@(nodes RestArguments traits) result: result
 585 [
 586   gen generate: rest message selector on: rest message arguments ; rest arguments from: rest message result: result
 587 ].
 588
 589 gen@(VM SSACompiler traits) generate: _@#apply* on: args from: msg result: result
 590 [
 591   result `defaultsTo: gen newRegister.
 592   methodReg ::= gen generate: args first result: Nil.
 593   argRegs ::= args allButFirst collect: [| :item | gen generate: item result: Nil].
 594   gen emitInstruction: gen directApplyTo withParameters: {methodReg. argRegs size. result} ; argRegs from: msg.
 595   result
 596 ].
 597
 598 gen@(VM SSACompiler traits) generate: _@#applyTo: on: args from: msg result: result
 599 [
 600   (args second isSameAs: nodes Array)
 601     ifTrue:
 602       [result `defaultsTo: gen newRegister.
 603        methodReg ::= gen generate: args first result: Nil.
 604        argRegs ::= args second statements collect:
 605          [| :item | gen generate: item result: Nil].
 606        gen emitInstruction: gen directApplyTo
 607          withParameters: {methodReg. argRegs size. result} ; argRegs
 608          from: msg.
 609        result]
 610     ifFalse: [resend]
 611 ].
 612
 613 gen@(VM SSACompiler traits) generate: _@#primitiveApply* on: args from: msg result: result
 614 [
 615   result `defaultsTo: gen newRegister.
 616   indexReg ::= gen generate: args first result: Nil.
 617   argRegs ::= args second statements collect: [| :item | gen generate: item result: Nil].
 618   gen emitInstruction: gen primitiveDo withParameters: {indexReg. argRegs size. result} ; argRegs from: msg.
 619   result
 620 ].
 621
 622 gen@(VM SSACompiler traits) generate: _@#True on: args from: msg result: result
 623 [
 624   (args first isSameAs: nodes ImplicitArgument)
 625     ifTrue: [gen registerFor: True from: msg result: result]
 626     ifFalse: [resend]
 627 ].
 628
 629 gen@(VM SSACompiler traits) generate: _@#False on: args from: msg result: result
 630 [
 631   (args first isSameAs: nodes ImplicitArgument)
 632     ifTrue: [gen registerFor: False from: msg result: result]
 633     ifFalse: [resend]
 634 ].
 635
 636 gen@(VM SSACompiler traits) generate: _@#Nil on: args from: msg result: result
 637 [
 638   (args first isSameAs: nodes ImplicitArgument)
 639     ifTrue: [gen registerFor: Nil from: msg result: result]
 640     ifFalse: [resend]
 641 ].
 642
 643 gen@(VM SSACompiler traits) generate: _@#== on: args from: msg result: result
 644 [
 645   result `defaultsTo: gen newRegister.
 646   argRegs ::= args collect: [| :arg | gen generate: arg result: Nil].
 647   gen emitInstruction: gen isIdenticalTo withParameters: {result. argRegs first. argRegs second} from: msg.
 648   result
 649 ].
 650
 651 gen@(VM SSACompiler traits) generate: _@#do on: args from: msg result: result
 652 "If the block is a literal with no variables, then inline it.
 653 Otherwise, fall back to evaluating it via 'do'."
 654 [
 655   ((block ::= args first) isSameAs: nodes Block)
 656     /\ [block localVariables isEmpty]
 657     ifTrue:
 658       [result `defaultsTo: gen newRegister.
 659        block statements isEmpty
 660          ifTrue: [gen emitInstruction: gen loadLiteral withParameters: {result. Nil} from: msg.
 661                   result]
 662          ifFalse: [block statements allButLastDo: [| :node | gen generate: node result: Nil].
 663                    gen generate: block statements last result: result]]
 664     ifFalse: [resend]
 665 ].
 666
 667 gen@(VM SSACompiler traits) generateExecutionOf: args from: msg result: result
 668 [gen generate: #do on: args from: msg result: result].
 669
 670 gen@(VM SSACompiler traits) generate: _@#loop on: args from: msg result: result
 671 "Repeatedly evaluates a block via 'do'."
 672 [
 673   label ::= gen emitLabel.
 674   gen generateExecutionOf: args from: msg result: Nil.
 675   gen emitInstruction: gen jumpTo withParameters: #{}"see below" from: msg.
 676   gen emitBranchTo: label from: msg.
 677   gen registerFor: Nil from: msg result: result "return nil"
 678 ].
 679
 680 gen@(VM SSACompiler traits) generate: _@#isNil on: args from: msg result: result
 681 [
 682   result `defaultsTo: gen newRegister.
 683   objReg ::= gen generate: args first result: Nil.
 684   gen emitInstruction: gen isNilOp withParameters: {result. objReg} from: msg.
 685   result
 686 ].
 687
 688 gen@(VM SSACompiler traits) branchTableHash: key
 689 [
 690   key identityHash
 691 ].
 692
 693 gen@(VM SSACompiler traits) buildBranchTableMapping: keys
 694 [| tableSize |
 695   tableSize := 1.
 696   [tableSize < keys size]
 697     whileTrue:
 698       [tableSize *= 2].
 699   table ::= Array newSize: tableSize * 2.
 700   keys do:
 701     [| :key hash |
 702      hash := (gen branchTableHash: key) bitAnd: (tableSize - 1) * 2.
 703      [(table at: hash) isNil]
 704        whileFalse:
 705          [key = (table at: hash)
 706             ifTrue:
 707               [error: 'Duplicate key ' ; key printString ; ' in caseOf:.'].
 708           (hash += 2) >= (tableSize * 2) ifTrue:
 709             [hash := 0]].
 710      table at: hash put: key].
 711   table
 712 ].
 713
 714 gen@(VM SSACompiler traits) mayInlineCaseOf: msg
 715 "Answer whether a safe inlining is possible for a caseOf: expression without
 716 further analysis; currently this is the case where the second argument is a
 717 literal array, and the appropriate Associations and their elements are laid
 718 out with literal keys."
 719 [
 720   (msg arguments second isSameAs: nodes Array) /\
 721    [msg arguments second statements allSatisfy:
 722      [| :assoc |
 723       (assoc is: nodes Message)
 724         /\ [assoc selector = #->]
 725         /\ [assoc arguments first is: nodes Literal]
 726         /\ [{Symbol. ASCIIString Character. SmallInteger} anySatisfy:
 727           [| :proto | assoc arguments first value is: proto]]]]
 728 ].
 729
 730 gen@(VM SSACompiler traits) generate: _@#caseOf:otherwise: on: args from: msg result: finalResult
 731 [
 732   (gen mayInlineCaseOf: msg)
 733    ifFalse: [^ resend].
 734   assocs ::= args second statements.
 735   labels ::= assocs collect: [| :_ | gen newLabelIndex].
 736   finalResult `defaultsTo: gen newRegister.
 737   table ::=
 738     gen buildBranchTableMapping:
 739       (assocs collect: [| :assoc | assoc arguments first value]).
 740   indices ::= IdentityDictionary new.
 741   0 below: table size by: 2 do:
 742     [| :index | (table at: index) ifNotNilDo: [| :val | indices at: val put: index]].
 743
 744   switchKeyRegister ::= gen generate: args first result: Nil.
 745   gen emitInstruction: gen branchKeyed
 746     withParameters: {switchKeyRegister. gen registerFor: table from: msg result: Nil}
 747     from: msg.
 748   branchOffset ::= gen codeWriter position.
 749   gen emitInstruction: gen jumpTo from: msg.
 750   endLabel ::= gen newLabelIndex.
 751   otherwiseLabel ::= gen newLabelIndex.
 752   gen emitBranchTo: otherwiseLabel from: msg.
 753
 754   assocs with: labels do:
 755     [| :assoc :label |
 756      gen emitLabel &labelIndex: label.
 757      table
 758        at: (indices at: assoc arguments first value) + 1
 759        put: (gen currentContext resolveLabel: label at: branchOffset).
 760      gen generateExecutionOf: {assoc arguments second} from: msg result: finalResult.
 761      gen emitInstruction: gen jumpTo from: msg.
 762      gen emitBranchTo: endLabel from: msg].
 763
 764   "Handle the otherwise clause. If we didn't get a literal block for it, just
 765     encode a Nil-push."
 766   gen emitLabel &labelIndex: otherwiseLabel.
 767   args size >= 3
 768     ifTrue: [gen generateExecutionOf: {args third} from: msg result: finalResult]
 769     ifFalse: [gen registerFor: Nil from: msg result: finalResult].
 770   gen emitLabel &labelIndex: endLabel.
 771   finalResult
 772 ].
 773
 774 gen@(VM SSACompiler traits) generate: _@#caseOf: on: args from: msg result: result
 775 "Generates a caseOf:otherwise: with a default otherwise clause."
 776 [
 777   (gen mayInlineCaseOf: msg)
 778     ifTrue: [gen generate: #caseOf:otherwise: on: args from: msg result: result]
 779     ifFalse: [resend]
 780 ].
 781
 782 gen@(VM SSACompiler traits) generate: _@#ifTrue:ifFalse: on: args from: msg result: finalResult
 783 "Branches to one of two blocks and evaluates it."
 784 [
 785   falseLabel ::= gen newLabelIndex.
 786   endLabel ::= gen newLabelIndex.
 787   finalResult `defaultsTo: gen newRegister.
 788   (condReg ::= gen generate: args first result: Nil)
 789     ifNil: [error: 'conditional is nil: ' ; args first printString].
 790   gen emitInstruction: gen branchIfFalse withParameters: {condReg} from: msg.
 791   gen emitBranchTo: falseLabel from: msg.
 792   gen generateExecutionOf: {args second} from: msg result: finalResult.
 793   gen emitInstruction: gen jumpTo from: msg.
 794   gen emitBranchTo: endLabel from: msg.
 795   gen emitLabel &labelIndex: falseLabel.
 796   gen generateExecutionOf: {args third} from: msg result: finalResult.
 797   gen emitLabel &labelIndex: endLabel.
 798   finalResult
 799 ].
 800
 801 gen@(VM SSACompiler traits) generate: _@#ifTrue: on: args from: msg result: finalResult
 802 "Optionally evaluates a block."
 803 [
 804   falseLabel ::= gen newLabelIndex.
 805   endLabel ::= gen newLabelIndex.
 806   finalResult `defaultsTo: gen newRegister.
 807   (condReg ::= gen generate: args first result: Nil)
 808     ifNil: [error: 'conditional is nil: ' ; args first printString].
 809   gen emitInstruction: gen branchIfFalse withParameters: {condReg} from: msg.
 810   gen emitBranchTo: falseLabel from: msg.
 811   gen generateExecutionOf: {args second} from: msg result: finalResult.
 812   gen emitInstruction: gen jumpTo from: msg.
 813   gen emitBranchTo: endLabel from: msg.
 814   gen emitLabel &labelIndex: falseLabel.
 815   gen registerFor: Nil from: msg result: finalResult.
 816   gen emitLabel &labelIndex: endLabel.
 817   finalResult
 818 ].
 819
 820 gen@(VM SSACompiler traits) generate: _@#ifFalse: on: args from: msg result: finalResult
 821 [
 822   falseLabel ::= gen newLabelIndex.
 823   endLabel ::= gen newLabelIndex.
 824   finalResult `defaultsTo: gen newRegister.
 825   (condResult ::= gen generate: args first result: Nil)
 826     ifNil: [error: 'conditional is nil: ' ; args first printString].
 827   gen emitInstruction: gen branchIfTrue withParameters: {condResult} from: msg.
 828   gen emitBranchTo: falseLabel from: msg.
 829   gen generateExecutionOf: {args second} from: msg result: finalResult.
 830   gen emitInstruction: gen jumpTo from: msg.
 831   gen emitBranchTo: endLabel from: msg.
 832   gen emitLabel &labelIndex: falseLabel.
 833   gen registerFor: Nil from: msg result: finalResult.
 834   gen emitLabel &labelIndex: endLabel.
 835   finalResult
 836 ].
 837
 838 gen@(VM SSACompiler traits) generate: _@#ifNil: on: args from: msg result: finalResult
 839 [
 840   endLabel ::= gen newLabelIndex.
 841   finalResult `defaultsTo: gen newRegister.
 842   lhsValueReg ::= gen generate: args first result: finalResult. "do not evaluate twice"
 843   condReg ::= gen newRegister.
 844   gen emitInstruction: gen isNilOp withParameters: {condReg. lhsValueReg} from: msg.
 845   gen emitInstruction: gen branchIfFalse withParameters: {condReg} from: msg.
 846   gen emitBranchTo: endLabel from: msg.
 847   gen generateExecutionOf: {args second} from: msg result: finalResult.
 848   gen emitLabel &labelIndex: endLabel.
 849   finalResult
 850 ].
 851
 852 gen@(VM SSACompiler traits) generate: _@#ifNotNil: on: args from: msg result: finalResult
 853 [
 854   endLabel ::= gen newLabelIndex.
 855   finalResult `defaultsTo: gen newRegister.
 856   lhsValueReg ::= gen generate: args first result: finalResult. "do not evaluate twice"
 857   condReg ::= gen newRegister.
 858   gen emitInstruction: gen isNilOp withParameters: {condReg. lhsValueReg} from: msg.
 859   gen emitInstruction: gen branchIfTrue withParameters: {condReg} from: msg.
 860   gen emitBranchTo: endLabel from: msg.
 861   gen generateExecutionOf: {args second} from: msg result: finalResult.
 862   gen emitLabel &labelIndex: endLabel.
 863   finalResult
 864 ].
 865
 866 gen@(VM SSACompiler traits) generate: _@#/\ on: args from: msg result: finalResult
 867 "Optionally evaluates a block."
 868 [
 869   (args second isSameAs: nodes Block)
 870     ifFalse: [^ resend].
 871   falseLabel ::= gen newLabelIndex.
 872   endLabel ::= gen newLabelIndex.
 873   finalResult `defaultsTo: gen newRegister.
 874   (condResult ::= gen generate: args first result: Nil)
 875     ifNil: [error: 'conditional is nil: ' ; args first printString].
 876   gen emitInstruction: gen branchIfFalse withParameters: {condResult} from: msg.
 877   gen emitBranchTo: falseLabel from: msg.
 878   gen generateExecutionOf: {args second} from: msg result: finalResult.
 879   gen emitInstruction: gen jumpTo from: msg.
 880   gen emitBranchTo: endLabel from: msg.
 881   gen emitLabel &labelIndex: falseLabel.
 882   gen registerFor: False from: msg result: finalResult.
 883   gen emitLabel &labelIndex: endLabel.
 884   finalResult
 885 ].
 886
 887 gen@(VM SSACompiler traits) generate: _@#\/ on: args from: msg result: finalResult
 888 "Optionally evaluates a block."
 889 [
 890   (args second isSameAs: nodes Block)
 891     ifFalse: [^ resend].
 892   falseLabel ::= gen newLabelIndex.
 893   endLabel ::= gen newLabelIndex.
 894   finalResult `defaultsTo: gen newRegister.
 895   (condResult ::= gen generate: args first result: Nil)
 896     ifNil: [error: 'conditional is nil: ' ; args first printString].
 897   gen emitInstruction: gen branchIfTrue withParameters: {condResult} from: msg.
 898   gen emitBranchTo: falseLabel from: msg.
 899   gen generateExecutionOf: {args second} from: msg result: finalResult.
 900   gen emitInstruction: gen jumpTo from: msg.
 901   gen emitBranchTo: endLabel from: msg.
 902   gen emitLabel &labelIndex: falseLabel.
 903   gen registerFor: True from: msg result: finalResult.
 904   gen emitLabel &labelIndex: endLabel.
 905   finalResult
 906 ].
 907
 908 gen@(VM SSACompiler traits) generate: _@#whileTrue: on: args from: msg result: finalResult
 909 "Repeatedly evaluates a block while it returns True."
 910 [
 911   endLabel ::= gen newLabelIndex.
 912   label ::= gen emitLabel.
 913   (condResult ::= gen generateExecutionOf: {args first} from: msg result: Nil)
 914     ifNil: [error: 'conditional is nil: ' ; args first printString].
 915   gen emitInstruction: gen branchIfFalse withParameters: {condResult} from: msg.
 916   gen emitBranchTo: endLabel from: msg.
 917   gen generateExecutionOf: {args second} from: msg result: Nil.
 918   gen emitInstruction: gen jumpTo from: msg.
 919   gen emitBranchTo: label from: msg.
 920   gen emitLabel &labelIndex: endLabel.
 921   gen registerFor: Nil from: msg result: finalResult
 922 ].
 923
 924 gen@(VM SSACompiler traits) generate: _@#whileFalse: on: args from: msg result: finalResult
 925 "Repeatedly evaluates a block while it returns False."
 926 [
 927   endLabel ::= gen newLabelIndex.
 928   label ::= gen emitLabel.
 929   (condResult ::= gen generateExecutionOf: {args first} from: msg result: Nil)
 930     ifNil: [error: 'conditional is nil: ' ; args first printString].
 931   gen emitInstruction: gen branchIfTrue withParameters: {condResult} from: msg.
 932   gen emitBranchTo: endLabel from: msg.
 933   gen generateExecutionOf: {args second} from: msg result: Nil.
 934   gen emitInstruction: gen jumpTo from: msg.
 935   gen emitBranchTo: label from: msg.
 936   gen emitLabel &labelIndex: endLabel.
 937   gen registerFor: Nil from: msg result: finalResult
 938 ].
 939
 940 gen@(VM SSACompiler traits) generate: _@#whileTrue on: args from: msg result: result
 941 "Repeatedly evaluates a block while it returns True."
 942 [
 943   label ::= gen emitLabel.
 944   (condResult ::= gen generateExecutionOf: args from: msg result: Nil)
 945     ifNil: [error: 'conditional is nil: ' ; args first printString].
 946   gen emitInstruction: gen branchIfTrue withParameters: {condResult} from: msg.
 947   gen emitBranchTo: label from: msg.
 948   gen registerFor: Nil from: msg result: result
 949 ].
 950
 951 gen@(VM SSACompiler traits) generate: _@#whileFalse on: args from: msg result: result
 952 "Repeatedly evaluates a block while it returns False."
 953 [
 954   label ::= gen emitLabel.
 955   (condResult ::= gen generateExecutionOf: args from: msg result: Nil)
 956     ifNil: [error: 'conditional is nil: ' ; args first printString].
 957   gen emitInstruction: gen branchIfFalse withParameters: {condResult} from: msg.
 958   gen emitBranchTo: label from: msg.
 959   gen registerFor: Nil from: msg result: result
 960 ].
 961
 962 gen@(VM SSACompiler traits) generate: _@#primitiveDo: on: args from: msg result: result
 963 [
 964   result `defaultsTo: gen newRegister.
 965   indexReg ::= gen generate: args first result: Nil.
 966   argRegs ::= args second statements collect: [| :item | gen generate: item result: Nil].
 967   gen emitInstruction: gen primitiveDo withParameters: {indexReg. argRegs size. result} ; argRegs from: msg.
 968   result
 969 ].
 970
 971 gen@(VM SSACompiler traits) generate: _@#fill:with: on: args from: msg result: result
 972 [| index value tempVar |
 973   block ::= args first.
 974   index := args second.
 975   value := args third.
 976   (block isSameAs: nodes Block)
 977     /\ [index isSameAs: nodes Literal]
 978     /\ [block inputVariables acceptsKey: index value]
 979     ifFalse: [^ resend].
 980   (value isSameAs: nodes Literal)
 981     ifFalse:
 982       [tempVar := gen currentMethod sourceTree addVariable.
 983        gen generate: (nodes StoreVariable of: value into: tempVar) result: Nil. "fixme"
 984        value := nodes LoadVariable from: tempVar].
 985   index := index value.
 986   var ::= block inputVariables at: index.
 987   block inputVariables := block inputVariables copyWithoutAt: index.
 988   block localVariables
 989     replaceFrom: index
 990     below: block localVariables indexLast
 991     with: block localVariables
 992     startingAt: index + 1.
 993   block localVariables at: block localVariables indexLast put: var.
 994   block statements :=
 995     {nodes StoreVariable of: value into: var} ; block statements.
 996   gen generate: block result: result
 997 ].
 998
 999 gen@(VM SSACompiler traits) generate: _@#<-* on: args from: msg result: result
1000 "Optimizes currying calls on literal blocks using #fill:with:."
1001 [
1002   (args first isSameAs: nodes Block)
1003     ifTrue:
1004       [gen
1005          generate: #fill:with:
1006          on: (args copyWith:
1007                 (nodes Literal for: args first inputVariables indexLast) at: 1)
1008          from: msg
1009          result: result]
1010     ifFalse: [resend]
1011 ].