languages/tcl/src/grammar/expr/past2pir.tg

   1 grammar TclExpr::PIR::Grammar is TGE::Grammar;
   2
   3 transform result (ROOT)  {
   4     $S0 = typeof node
   5     .return tree.get('pir', node, $S0)
   6 }
   7
   8 transform pir (PAST::Expr) {
   9     .local pmc pir
  10     pir = new 'CodeString'
  11
  12     .local pmc value
  13     value = node['value']
  14     $P0 = tree.get('pir', value)
  15     pir .= $P0
  16     $S0 = value['ret']
  17     node['ret'] = $S0
  18
  19     .local pmc ret, label
  20     ret   = node['ret']
  21     label = pir.unique('expr_is_string')
  22
  23     pir.emit(<<'END_PIR', ret, label)
  24   .local pmc __number
  25   __number = get_root_global ['_tcl'], '__number'
  26   push_eh %1
  27     %0 = __number(%0)
  28   pop_eh
  29 %1:
  30 END_PIR
  31
  32     .return(pir)
  33 }
  34
  35 transform pir (PAST::Program) {
  36     .local pmc pir
  37     pir = new 'CodeString'
  38
  39     pir.emit(<<'END_PIR')
  40     .local pmc colons, split, epoch
  41     colons = get_root_global ['_tcl'], 'colons'
  42     split  = get_root_global ['parrot'; 'PGE::Util'], 'split'
  43     epoch = get_root_global ['_tcl'], 'epoch'
  44 END_PIR
  45
  46     .local pmc iter, child
  47     iter = node.'child_iter'()
  48 loop:
  49     unless iter goto end
  50     child = shift iter
  51     $P0 = tree.'get'('pir', child)
  52     $S0 = $P0
  53     pir .= $S0
  54     goto loop
  55 end:
  56     $S0 = child['ret']
  57     node['ret'] = $S0
  58     .return(pir)
  59 }
  60
  61 transform pir (PAST::Val) {
  62     .local pmc pir
  63     .local pmc ret
  64     .local pmc class
  65
  66     pir = new 'CodeString'
  67     ret = pir.unique('$P')
  68     class = node['class']
  69     pir.emit("    %0 = new '%1'", ret, class)
  70     $S0 = node['value']
  71     if class == "TclFloat"  goto assign_float
  72     if class == "TclString" goto assign_string
  73     goto assign_val
  74   assign_float:
  75     $I0 = index $S0, '.'                     # RT#40690: '.' hack due to
  76     if $I0 >= 0 goto assign_val              # parrotbug #38896
  77     $I0 = index $S0, 'E'
  78     if $I0 >= 0 goto assign_val
  79     $I0 = index $S0, 'e'
  80     if $I0 >= 0 goto assign_val
  81     concat $S0, '.'
  82     goto assign_val
  83   assign_string:
  84     $S0 = pir.escape($S0)
  85   assign_val:
  86     pir.emit('    assign %0, %1', ret, $S0)
  87   end:
  88     node['ret'] = ret
  89     node['istemp'] = 1
  90     .return (pir)
  91 }
  92
  93 transform pir (PAST::Var) {
  94     .local pmc pir, ret
  95     pir = new 'CodeString'
  96     ret = pir.unique('$P')
  97     node['ret']    = ret
  98     node['istemp'] = 1
  99
 100     .local string name
 101     name = node['name']
 102
 103     $I0 = exists node['index']
 104     if $I0 goto array
 105
 106     pir.emit(<<'END_PIR', ret, name)
 107   .local pmc __read
 108   __read = get_root_global ['_tcl'], '__read'
 109   %0 = __read('%1')
 110 END_PIR
 111     .return(pir)
 112
 113 array:
 114     .local pmc    index
 115     index = node['index']
 116
 117     $P0 = tree.get('pir', index)
 118     pir .= $P0
 119     $S0 = index['ret']
 120     pir.emit(<<'END_PIR', ret, name, $S0)
 121   .local pmc __read
 122   __read = get_root_global ['_tcl'], '__read'
 123   $S0 = %2
 124   $S0 = '%1(' . $S0
 125   $S0 = $S0 . ')'
 126   %0 = __read($S0)
 127 END_PIR
 128     .return(pir)
 129 }
 130
 131 transform pir (PAST::Op) {
 132     .local pmc args,iter,pir
 133     .local pmc return_register
 134
 135     pir = new 'CodeString'
 136     args = new 'ResizablePMCArray'
 137     iter = node.'child_iter'()
 138   iter_loop:
 139     unless iter goto iter_done
 140     $P1 = shift iter
 141     $P0 = tree.get('pir', $P1)
 142     return_register = $P1['ret']
 143     push args, return_register
 144     pir .= $P0
 145     goto iter_loop
 146   iter_done:
 147     # get a result PMC
 148     .local pmc retval
 149     retval = pir.unique('$P')
 150     pir .= retval
 151     pir .= " = get_hll_global '"
 152     $S0 = node['opfunc']
 153     pir .= $S0
 154     pir .= "'\n"
 155     pir .= retval
 156     pir .= " = "
 157     pir .= retval
 158     pir .= "("
 159     $S0 = join ", ", args
 160     pir .= $S0
 161     pir .= ")\n"
 162     node['ret'] = retval
 163     .return (pir)
 164 }
 165
 166 transform pir (PAST::MathFunc) {
 167     .local pmc args,iter,pir
 168     .local pmc return_register
 169
 170     pir  = new 'CodeString'
 171     args = new 'ResizablePMCArray'
 172     iter = node.'child_iter'()
 173   iter_loop:
 174     unless iter goto iter_done
 175     $P1 = shift iter
 176     $P0 = tree.get('pir', $P1)
 177     return_register = $P1['ret']
 178     push args, return_register
 179     pir .= $P0
 180     goto iter_loop
 181   iter_done:
 182     # get a result PMC
 183     .local pmc retval
 184     retval = pir.unique('$P')
 185     $S0    = node['mathfunc']
 186     pir.emit("%0 = get_hll_global ['tcl'; 'mathfunc'], '&%1'", retval, $S0)
 187     pir .= retval
 188     pir .= " = "
 189     pir .= retval
 190     pir .= "("
 191     $S0 = join ", ", args
 192     pir .= $S0
 193     pir .= ")\n"
 194     node['ret'] = retval
 195     .return (pir)
 196 }
 197
 198 transform pir (PAST::StaticCommand) {
 199     .local pmc args, children, iter, pir
 200     .local string reg
 201
 202     pir  = new 'CodeString'
 203     args = new 'ResizablePMCArray'
 204     children = node.'get_children'()
 205     iter = new 'Iterator', children
 206
 207     .local string name
 208     $P0  = shift iter
 209     name = $P0['value']
 210
 211     .local int has_expand
 212     has_expand = 0
 213
 214   iter_loop:
 215     unless iter goto iter_done
 216     $P1 = shift iter
 217     $P0 = tree.get('pir', $P1)
 218     reg = $P1['ret']
 219     push args, reg
 220     pir .= $P0
 221     $S0 = typeof $P1
 222     if $S0 == 'PAST::Expand' goto iter_expand
 223     unless $S0 == 'PAST::Var' goto iter_loop
 224     pir.emit("    %0 = clone %0", reg)
 225     goto iter_loop
 226   iter_expand:
 227     has_expand = 1
 228     goto iter_loop
 229   iter_done:
 230     .local string retval
 231     retval = pir.unique('$P')
 232
 233     .local string invalid_, done_, exec_
 234     invalid_ = pir.unique('invalid_')
 235     done_    = pir.unique('done_')
 236     exec_    = pir.unique('exec_')
 237
 238     $P0 = shift children
 239     $S0 = $P0['value']
 240     if has_expand goto dynamic
 241     $P1 = get_root_global ['_tcl'; 'builtins'], $S0
 242     if null $P1 goto dynamic
 243
 244     $P0 = $P1(retval, children,args)
 245     if null $P0 goto dynamic
 246
 247     .local pmc epoch
 248     epoch = get_root_global ['_tcl'], 'epoch'
 249     $S0 = pir.unique('dynamic_')
 250     pir.emit('  if epoch != %0 goto %1', epoch, $S0)
 251     pir .= $P0
 252     pir.emit('  goto %0', done_)
 253     pir.emit('%0:', $S0)
 254
 255   dynamic:
 256     .local string ns
 257     ns  = ''
 258     $S0 = join ", ", args
 259     $I0 = index name, "::"
 260     if $I0 == -1 goto no_ns
 261
 262     .local pmc split, colons
 263     split  = get_root_global ['parrot'; 'PGE::Util'], 'split'
 264     colons = get_root_global ['_tcl'], 'colons'
 265     $P0    = split(colons, name)
 266     $S1    = pop $P0
 267
 268     $S1 = '&' . $S1
 269     $S1 = pir.escape($S1)
 270
 271     $S2 = $P0[0]
 272     if $S2 == "" goto root_ns
 273
 274     ns = join "'; '", $P0
 275     ns = "['" . ns
 276     ns = ns . "'], "
 277
 278     .local string root_
 279     root_ = pir.unique('root_')
 280     pir.emit(<<'END_PIR', retval, ns, $S1, root_, exec_)
 281     %0 = get_global %1 %2
 282     if null %0 goto %3
 283     goto %4
 284 %3:
 285 END_PIR
 286     unshift $P0, ""
 287
 288   root_ns:
 289     $S2 = shift $P0
 290     $I0 = elements $P0
 291     if $I0 == 0 goto root_ns_emit
 292
 293     ns = join "'; '", $P0
 294     ns = "['" . ns
 295     ns = ns . "'], "
 296
 297   root_ns_emit:
 298     pir.emit(<<'END_PIR', retval, ns, $S1, invalid_, exec_)
 299     %0 = get_hll_global %1 %2
 300     if null %0 goto %3
 301 %4:
 302 END_PIR
 303     goto emit
 304
 305   no_ns:
 306     $S1 = '&' . name
 307     $S1 = pir.escape($S1)
 308     pir.emit(<<'END_PIR', retval, $S1, invalid_)
 309     %0 = find_name %1
 310     if null %0 goto %2
 311 END_PIR
 312
 313   emit:
 314     $S3  = pir.escape(name)
 315     pir.emit(<<'END_PIR', retval, $S3, $S0, invalid_, done_)
 316     %0 = %0(%2)
 317     goto %4
 318 %3:
 319     tcl_error 'invalid command name %1'
 320 %4:
 321 END_PIR
 322     node['ret'] = retval
 323     .return(pir)
 324 }
 325
 326 transform pir (PAST::DynamicCommand) {
 327     .local pmc args, children, iter, pir, reg
 328
 329     pir  = new 'CodeString'
 330     args = new 'ResizablePMCArray'
 331     children = node.'get_children'()
 332     iter = new 'Iterator', children
 333   iter_loop:
 334     unless iter goto iter_done
 335     $P1 = shift iter
 336     $P0 = tree.get('pir', $P1)
 337     reg = $P1['ret']
 338     push args, reg
 339     pir .= $P0
 340     pir.emit("%0 = clone %0", reg)
 341     goto iter_loop
 342   iter_done:
 343     .local pmc retval, name
 344     retval = pir.unique('$P')
 345     name = shift args
 346
 347     $S1 = pir.unique('invalid_')
 348     $S2 = pir.unique('done_')
 349
 350     $P0 = shift children
 351     $S0 = $P0['value']
 352     $S0 = join ", ", args
 353     $S4 = pir.unique('curr_namespace')
 354     $S5 = pir.unique('root_namespace')
 355     pir.emit(<<'END_PIR', retval, name, $S0, $S1, $S2, $S4, $S5)
 356   $S0 = %1
 357   $P0 = split(colons, $S0)
 358   $S0 = ""
 359   $I0 = elements $P0
 360   if $I0 == 0 goto %5
 361   $S0 = pop $P0
 362   if $I0 == 1 goto %5
 363   $S1 = $P0[0]
 364   if $S1 != "" goto %5
 365   $S1 = shift $P0
 366 %6:
 367   %0 = get_hll_namespace $P0
 368   if null %0 goto %3
 369   $S1 = '&' . $S0
 370   %0  = %0[$S1]
 371   if null %0 goto %3
 372   %0  = %0(%2)
 373   goto %4
 374 %5:
 375   %0 = get_namespace $P0
 376   if null %0 goto %6
 377   $S1 = '&' . $S0
 378   %0  = %0[$S1]
 379   if null %0 goto %6 # try the root namespace if it's not in the current
 380   %0  = %0(%2)
 381   goto %4
 382 %3:
 383   tcl_error 'invalid command name %1'
 384 %4:
 385 END_PIR
 386     node['ret'] = retval
 387     .return(pir)
 388 }
 389
 390 transform pir (PAST::Expand) {
 391     .local pmc pir, value
 392     pir   = new 'CodeString'
 393     value = node['value']
 394
 395     $S0 = tree.get('pir', value)
 396     pir .= $S0
 397
 398     $S0 = value['ret']
 399     $S1 = pir.'unique'('$P')
 400     $S2 = pir.'unique'('loop_')
 401     $S3 = pir.'unique'('end_')
 402     pir.emit(<<'END_PIR', $S0)
 403   .local pmc __list
 404   __list = get_root_global ['_tcl'], '__list'
 405   %0 = __list(%0)
 406 END_PIR
 407
 408     $S0 .= ' :flat'
 409     node['ret'] = $S0
 410     .return(pir)
 411 }
 412
 413 transform pir (PAST::Cond) {
 414     .local pmc args, pir, ret, label
 415     .local pmc children, cond, then, else
 416     .local string cond_result, then_result, else_result
 417
 418     pir = new 'CodeString'
 419     pir.emit('  .local pmc __boolean')
 420     pir.emit('  __boolean = get_root_global ["_tcl"], "__boolean"')
 421
 422     # This node has 3 children. generate PIR so that:
 423     # if node1 then node2 else node3
 424
 425     # pick a unique register to store our result in.
 426     ret = pir.unique('$P')
 427
 428     #  pick a unique number for our labels..
 429     label = pir.unique('label_')
 430
 431     children = node.'get_children'()
 432
 433     cond = children[0]
 434     $S0 = tree.get('pir', cond)
 435     pir .= $S0
 436     cond_result = cond['ret']
 437
 438     pir.emit("  %0 = __boolean(%0)",    cond_result)
 439     pir.emit("  unless %0 goto else_%1", cond_result, label)
 440
 441     then = children[1]
 442     $S0 = tree.get('pir', then)
 443     pir .= $S0
 444     then_result = then['ret']
 445
 446     pir.emit('    %0 = %1', ret, then_result)
 447     pir.emit("  goto end_if_%0", label)
 448
 449     #set the result register to the answer from this section
 450
 451    #then jump to custom end label..
 452
 453     pir.emit("  else_%0:",label)
 454
 455     else = children[2]
 456     $S0 = tree.get('pir', else)
 457     pir .= $S0
 458     else_result = else['ret']
 459
 460     pir.emit('    %0 = %1', ret, else_result)
 461
 462     #set the result register to the answer from this section
 463
 464     pir.emit("  end_if_%0:",label)
 465
 466     node['ret'] = ret
 467
 468     .return (pir)
 469 }
 470