compilers/pct/src/PAST/Compiler.pir

   1 # $Id$
   2
   3 =head1 NAME
   4
   5 PAST::Compiler - PAST Compiler
   6
   7 =head1 DESCRIPTION
   8
   9 PAST::Compiler implements a basic compiler for PAST nodes.
  10 By default PAST::Compiler transforms a PAST tree into POST.
  11
  12 =head2 Signature Flags
  13
  14 Throughout the compiler PAST uses a number of 1-character
  15 "flags" to indicate allowable register types and conversions.
  16 This helps the compiler generate more efficient code and know
  17 what sorts of conversions are allowed (or desired).  The
  18 basic flags are:
  19
  20     P,S,I,N   PMC, string, int, or num register
  21     Q         keyed PMC, next flag indicates type of key
  22     s         string register or constant
  23     i         int register or constant
  24     n         num register or constant
  25     r         any register result
  26     v         void (no result)
  27     *         any result type except void
  28     +         PMC, int register, num register, or numeric constant
  29     ~         PMC, string register, or string constant
  30     :         argument (same as '*'), possibly with :named or :flat
  31     0-9       use the nth input operand as the output result of this operation
  32
  33 These flags are used to describe signatures and desired return
  34 types for various operations.  For example, if an opcode is
  35 specified with a signature of C<I~P*>, then the opcode places
  36 its result in an int register, its first child is coerced into
  37 some sort of string value, its second child is coerced into a
  38 PMC register, and the third and subsequent children can return
  39 any value type.
  40
  41 =cut
  42
  43 .include "cclass.pasm"
  44 .include "except_types.pasm"
  45 .include "interpinfo.pasm"
  46
  47 .namespace [ 'PAST';'Compiler' ]
  48
  49 .sub 'onload' :anon :load :init
  50     load_bytecode 'PCT/HLLCompiler.pbc'
  51     .local pmc p6meta, cproto
  52     p6meta = new 'P6metaclass'
  53     cproto = p6meta.'new_class'('PAST::Compiler', 'parent'=>'PCT::HLLCompiler', 'attr'=>'%!symtable')
  54     cproto.'language'('PAST')
  55     $P1 = split ' ', 'post pir evalpmc'
  56     cproto.'stages'($P1)
  57
  58     ##  %piropsig is a table of common opcode signatures
  59     .local pmc piropsig
  60     piropsig = new 'Hash'
  61     piropsig['add']        = 'PP+'
  62     piropsig['band']       = 'PPP'
  63     piropsig['bxor']       = 'PPP'
  64     piropsig['bnot']       = 'PP'
  65     piropsig['bor']        = 'PPP'
  66     piropsig['can']        = 'IPs'
  67     piropsig['chr']        = 'Si'
  68     piropsig['clone']      = 'PP'
  69     piropsig['concat']     = 'PP~'
  70     piropsig['copy']       = '0PP'
  71     piropsig['defined']    = 'IP'
  72     piropsig['delete']     = 'vQ*'
  73     piropsig['die']        = 'v~'
  74     piropsig['div']        = 'PP+'
  75     piropsig['does']       = 'IPs'
  76     piropsig['downcase']   = 'Ss'
  77     piropsig['elements']   = 'IP'
  78     piropsig['exists']     = 'IQ*'
  79     piropsig['exit']       = 'vi'
  80     piropsig['fdiv']       = 'PP+'
  81     piropsig['find_codepoint']   = 'Is'
  82     piropsig['find_dynamic_lex'] = 'Ps'
  83     piropsig['find_name']  = 'Ps'
  84     piropsig['getinterp']  = 'P'
  85     piropsig['getprop']    = 'P~P'
  86     piropsig['getstderr']  = 'P'
  87     piropsig['getstdin']   = 'P'
  88     piropsig['getstdout']  = 'P'
  89     piropsig['index']      = 'Issi'
  90     piropsig['isa']        = 'IP~'
  91     piropsig['isfalse']    = 'IP'
  92     piropsig['isnull']     = 'IP'
  93     piropsig['issame']     = 'IPP'
  94     piropsig['istrue']     = 'IP'
  95     piropsig['join']       = 'SsP'
  96     piropsig['length']     = 'Is'
  97     piropsig['load_bytecode'] = 'vs'
  98     piropsig['load_language'] = 'vs'
  99     piropsig['loadlib']    = 'P~'
 100     piropsig['mod']        = 'PP+'
 101     piropsig['mul']        = 'PP+'
 102     piropsig['neg']        = 'PP'
 103     piropsig['new']        = 'P~'
 104     piropsig['newclosure'] = 'PP'
 105     piropsig['not']        = 'PP'
 106     piropsig['ord']        = 'Isi'
 107     piropsig['pop']        = 'PP'
 108     piropsig['pow']        = 'NN+'
 109     piropsig['print']      = 'v*'
 110     piropsig['printerr']   = 'v*'
 111     piropsig['push']       = '0P*'
 112     piropsig['repeat']     = 'Ssi'
 113     piropsig['replace']    = 'Ssiis'
 114     piropsig['say']        = 'v*'
 115     piropsig['set']        = 'PP'
 116     piropsig['setprop']    = '0P~P'
 117     piropsig['setattribute'] = '0P~P'
 118     piropsig['shift']      = 'PP'
 119     piropsig['shl']        = 'PP+'
 120     piropsig['shr']        = 'PP+'
 121     piropsig['sleep']      = 'v+'
 122     piropsig['splice']     = '0PPii'
 123     piropsig['split']      = 'Pss'
 124     piropsig['sub']        = 'PP+'
 125     piropsig['substr']     = 'Ssii'
 126     piropsig['titlecase']  = 'Ss'
 127     piropsig['trace']      = 'vi'
 128     piropsig['typeof']     = 'SP'
 129     piropsig['unshift']    = '0P*'
 130     piropsig['upcase']     = 'Ss'
 131     set_global '%piropsig', piropsig
 132
 133     ##  %valflags specifies when PAST::Val nodes are allowed to
 134     ##  be used as a constant.  The 'e' flag indicates that the
 135     ##  value must be quoted+escaped in PIR code.
 136     .local pmc valflags
 137     valflags = new 'Hash'
 138     valflags['String']   = 's~*:e'
 139     valflags['Integer']  = 'i+*:'
 140     valflags['Float']    = 'n+*:'
 141     valflags['!cconst']          = 'i+*:c'
 142     valflags['!except_severity'] = 'i+*:c'
 143     valflags['!except_types']    = 'i+*:c'
 144     valflags['!iterator']        = 'i+*:c'
 145     valflags['!socket']          = 'i+*:c'
 146     set_global '%valflags', valflags
 147
 148     ##  %!controltypes holds the list of exception types for each
 149     ##  type of exception handler we support
 150     .local pmc controltypes
 151     controltypes = new 'Hash'
 152     controltypes['CONTROL']  = '.CONTROL_RETURN, .CONTROL_OK, .CONTROL_BREAK, .CONTROL_CONTINUE, .CONTROL_TAKE, .CONTROL_LEAVE, .CONTROL_EXIT, .CONTROL_LOOP_NEXT, .CONTROL_LOOP_LAST, .CONTROL_LOOP_REDO'
 153     controltypes['RETURN']   = '.CONTROL_RETURN'
 154     controltypes['OK']       = '.CONTROL_OK'
 155     controltypes['BREAK']    = '.CONTROL_BREAK'
 156     controltypes['CONTINUE'] = '.CONTROL_CONTINUE'
 157     controltypes['ERROR']    = '.CONTROL_ERROR'
 158     controltypes['GATHER']   = '.CONTROL_TAKE'
 159     controltypes['LEAVE']    = '.CONTROL_LEAVE'
 160     controltypes['EXIT']     = '.CONTROL_EXIT'
 161     controltypes['NEXT']     = '.CONTROL_NEXT'
 162     controltypes['LAST']     = '.CONTROL_LAST'
 163     controltypes['REDO']     = '.CONTROL_REDO'
 164     set_global '%!controltypes', controltypes
 165
 166     $P0 = box 11
 167     set_global '$!serno', $P0
 168
 169     .return ()
 170 .end
 171
 172 =head2 Compiler methods
 173
 174 =over 4
 175
 176 =item to_post(node [, 'option'=>option, ...])
 177
 178 Compile the abstract syntax tree given by C<past> into POST.
 179
 180 =cut
 181
 182 .sub 'to_post' :method
 183     .param pmc past
 184     .param pmc options         :slurpy :named
 185
 186     .local pmc symtable
 187     symtable = new 'Hash'
 188     setattribute self, '%!symtable', symtable
 189
 190     .local pmc blockpast
 191     blockpast = get_global '@?BLOCK'
 192     unless null blockpast goto have_blockpast
 193     blockpast = new 'ResizablePMCArray'
 194     set_global '@?BLOCK', blockpast
 195   have_blockpast:
 196     .lex '@*BLOCKPAST', blockpast
 197     null $P99
 198     .lex '$*SUB', $P99
 199     $P1 = self.'as_post'(past, 'rtype'=>'v')
 200     .return ($P1)
 201 .end
 202
 203 =item escape(str)
 204
 205 Return C<str> as a PIR constant string.
 206
 207 =cut
 208
 209 .sub 'escape' :method
 210     .param string str
 211     .local string estr
 212     estr = escape str
 213     $I0 = index estr, "\\x"
 214     if $I0 >= 0 goto unicode_prefix
 215     $I0 = index estr, "\\u"
 216     if $I0 >= 0 goto unicode_prefix
 217     estr = concat '"', estr
 218     goto done
 219   unicode_prefix:
 220     estr = concat 'unicode:"', estr
 221   done:
 222     estr = concat estr, '"'
 223     .return (estr)
 224 .end
 225
 226 =item unique([STR fmt])
 227
 228 Generate a unique number that can be used as an identifier.
 229 If C<fmt> is provided, then it will be used as a prefix to the
 230 unique number.
 231
 232 =cut
 233
 234 .sub 'unique' :method
 235     .param string fmt          :optional
 236     .param int has_fmt         :opt_flag
 237
 238     if has_fmt goto unique_1
 239     fmt = ''
 240   unique_1:
 241     $P0 = get_global '$!serno'
 242     $S0 = $P0
 243     $S0 = concat fmt, $S0
 244     inc $P0
 245     .return ($S0)
 246 .end
 247
 248 =item uniquereg(rtype)
 249
 250 Generate a unique register based on C<rtype>, where C<rtype>
 251 is one of the signature flags described above.
 252
 253 =cut
 254
 255 .sub 'uniquereg' :method
 256     .param string rtype
 257     unless rtype goto err_nortype
 258     if rtype == 'v' goto reg_void
 259     .local string reg
 260     reg = 'P'
 261     $I0 = index 'Ss~Nn+Ii', rtype
 262     if $I0 < 0 goto reg_psin
 263     reg = substr 'SSSNNNII', $I0, 1
 264   reg_psin:
 265     reg = concat '$', reg
 266     .tailcall self.'unique'(reg)
 267   reg_void:
 268     .return ('')
 269   err_nortype:
 270     self.'panic'('rtype not set')
 271 .end
 272
 273 =item coerce(post, rtype)
 274
 275 Return a POST tree that coerces the result of C<post> to have a
 276 return value compatible with C<rtype>.  C<rtype> can also be
 277 a specific register, in which case the result of C<post> is
 278 forced into that register (with conversions as needed).
 279
 280 =cut
 281
 282 .sub 'coerce' :method
 283     .param pmc post
 284     .param string rtype
 285
 286     unless rtype goto err_nortype
 287
 288     .local string pmctype, result, rrtype
 289     null pmctype
 290     null result
 291
 292     ##  if rtype is a register, then set result and use the register
 293     ##  type as rtype
 294     $S0 = substr rtype, 0, 1
 295     unless $S0 == '$' goto have_rtype
 296     result = rtype
 297     rtype = substr result, 1, 1
 298   have_rtype:
 299
 300     ##  these rtypes allow any return value, so no coercion needed.
 301     $I0 = index 'v*:', rtype
 302     if $I0 >= 0 goto end
 303
 304     ##  figure out what type of result we already have
 305     .local string source
 306     source = post.'result'()
 307     $S0 = substr source, 0, 1
 308     if $S0 == '$' goto source_reg
 309     if $S0 == '"' goto source_str
 310     if $S0 == '.' goto source_int_or_num
 311     if $S0 == '-' goto source_int_or_num
 312     $I0 = is_cclass .CCLASS_NUMERIC, source, 0
 313     if $I0 goto source_int_or_num
 314     $S0 = substr source, 0, 8
 315     if $S0 == 'unicode:' goto source_str
 316     ##  assume that whatever is left acts like a PMC
 317     goto source_pmc
 318
 319   source_reg:
 320     ##  source is some sort of register
 321     ##  if a register is all we need, we're done
 322     if rtype == 'r' goto end
 323     $S0 = substr source, 1, 1
 324     ##  if we have the correct register type already, we're done
 325     if $S0 != rtype goto source_reg_1
 326     unless result goto end
 327     goto coerce_reg
 328   source_reg_1:
 329     $S0 = downcase $S0
 330     if $S0 == rtype goto end
 331     ##  figure it out based on the register type
 332     if $S0 == 's' goto source_str
 333     if rtype == '+' goto end
 334     if $S0 == 'i' goto source_int
 335     if $S0 == 'n' goto source_num
 336   source_pmc:
 337     $I0 = index 'SINsin', rtype
 338     if $I0 < 0 goto end
 339     goto coerce_reg
 340
 341   source_str:
 342     if rtype == '~' goto end
 343     if rtype == 's' goto end
 344     rrtype = 'S'
 345     pmctype = "'String'"
 346     goto coerce_reg
 347
 348   source_int_or_num:
 349     if rtype == '+' goto end
 350     ##  existence of an 'e' or '.' implies num
 351     $I0 = index source, '.'
 352     if $I0 >= 0 goto source_num
 353     $I0 = index source, 'E'
 354     if $I0 >= 0 goto source_num
 355
 356   source_int:
 357     if rtype == 'i' goto end
 358     rrtype = 'I'
 359     pmctype = "'Integer'"
 360     goto coerce_reg
 361
 362   source_num:
 363     if rtype == 'n' goto end
 364     rrtype = 'N'
 365     pmctype = "'Float'"
 366
 367   coerce_reg:
 368     ##  okay, we know we have to do a coercion.
 369     ##  If we just need the value in a register (rtype == 'r'),
 370     ##  then create result based on the preferred register type (rrtype).
 371     if rtype != 'r' goto coerce_reg_1
 372     result = self.'uniquereg'(rrtype)
 373   coerce_reg_1:
 374     ##  if we haven't set the result target yet, then generate one
 375     ##  based on rtype.  (The case of rtype == 'r' was handled above.)
 376     if result goto coerce_reg_2
 377     result = self.'uniquereg'(rtype)
 378   coerce_reg_2:
 379     ##  create a new ops node to hold the coercion, put C<post> in it.
 380     $P0 = get_hll_global ['POST'], 'Ops'
 381     post = $P0.'new'(post, 'result'=>result)
 382     ##  if we need a new pmc (rtype == 'P' && pmctype defined), create it
 383     if rtype != 'P' goto have_result
 384     unless pmctype goto have_result
 385     post.'push_pirop'('new', result, pmctype)
 386   have_result:
 387     ##  store the value into the target register
 388     post.'push_pirop'('set', result, source)
 389
 390   end:
 391     .return (post)
 392
 393   err_nortype:
 394     self.'panic'('rtype not set')
 395 .end
 396
 397
 398 =item post_children(node [, 'signature'=>signature] )
 399
 400 Return the POST representation of evaluating all of C<node>'s
 401 children in sequence.  The C<signature> option is a string of
 402 flags as described in "Signature Flags" above.  Since we're
 403 just evaluating children nodes, the first character of
 404 C<signature> (return value type) is ignored.  Thus a C<signature>
 405 of C<v~P*> says that the first child needs to be something
 406 in string context, the second child should be a PMC, and the
 407 third and subsequent children can be any value they wish.
 408
 409 =cut
 410
 411 .sub 'post_children' :method
 412     .param pmc node
 413     .param pmc options         :slurpy :named
 414
 415     .local pmc ops
 416     $P0 = get_hll_global ['POST'], 'Ops'
 417     ops = $P0.'new'('node'=>node)
 418
 419     ##  get any conversion types
 420     .local string signature
 421     signature = options['signature']
 422     if signature goto have_signature
 423     signature = '**'
 424   have_signature:
 425     .local int sigmax, sigidx
 426     sigmax = length signature
 427     dec sigmax
 428
 429     ##  if the signature contains a ':', then we're doing
 430     ##  flagged arguments (:flat, :named)
 431     .local pmc posargs, namedargs
 432     posargs = new 'ResizableStringArray'
 433     null namedargs
 434     $I0 = index signature, ':'
 435     if $I0 < 0 goto nocolon
 436     namedargs = new 'ResizableStringArray'
 437   nocolon:
 438
 439     .local pmc iter
 440     .local string rtype
 441     iter = node.'iterator'()
 442     sigidx = 1
 443     rtype = substr signature, sigidx, 1
 444   iter_loop:
 445     if rtype == 'Q' goto keyed_pos
 446     unless iter goto iter_end
 447     .local pmc cpast, cpost
 448     cpast = shift iter
 449     cpost = self.'as_post'(cpast, 'rtype'=>rtype)
 450     cpost = self.'coerce'(cpost, rtype)
 451     ops.'push'(cpost)
 452     $I0 = isa cpast, ['PAST';'Node']
 453     unless $I0 goto cpost_pos
 454     .local pmc isflat
 455     isflat = cpast.'flat'()
 456     if rtype != ':' goto iter_pos
 457     .local pmc npast, npost
 458     npast = cpast.'named'()
 459     unless npast goto iter_pos
 460     $S0 = cpost
 461     if isflat goto flat_named
 462     npost = self.'as_post'(npast, 'rtype'=>'~')
 463     $S1 = npost
 464     ops.'push'(npost)
 465     concat $S0, ' :named('
 466     concat $S0, $S1
 467     concat $S0, ')'
 468     goto named_done
 469   flat_named:
 470     concat $S0, ' :named :flat'
 471   named_done:
 472     push namedargs, $S0
 473     goto iter_rtype
 474   iter_pos:
 475     if isflat goto flat_pos
 476   cpost_pos:
 477     push posargs, cpost
 478     goto iter_rtype
 479   flat_pos:
 480     $S0 = cpost
 481     concat $S0, ' :flat'
 482     push posargs, $S0
 483   iter_rtype:
 484     unless sigidx < sigmax goto iter_loop
 485     inc sigidx
 486     rtype = substr signature, sigidx, 1
 487     goto iter_loop
 488   keyed_pos:
 489     # rtype is 'Q', so construct a keyed pmc argument
 490     # first, get the base PMC
 491     unless iter goto iter_end
 492     cpast = shift iter
 493     cpost = self.'as_post'(cpast, 'rtype'=>'P')
 494     cpost = self.'coerce'(cpost, 'P')
 495     # now process the key arg
 496     unless iter goto iter_end
 497     .local pmc kpast, kpost
 498     kpast = shift iter
 499     inc sigidx
 500     rtype = substr signature, sigidx, 1
 501     kpost = self.'as_post'(kpast, 'rtype'=>rtype)
 502     kpost = self.'coerce'(kpost, rtype)
 503     ops.'push'(kpost)
 504     ops.'push'(cpost)
 505     # now construct the keyed PMC
 506     $S0 = cpost
 507     concat $S0, '['
 508     $S1 = kpost
 509     concat $S0, $S1
 510     concat $S0, ']'
 511     push posargs, $S0
 512     goto iter_rtype
 513   iter_end:
 514     .return (ops, posargs, namedargs)
 515 .end
 516
 517 =back
 518
 519 =head2 Methods on C<PAST::Node> arguments
 520
 521 The methods below are used to transform PAST nodes into their
 522 POST equivalents.
 523
 524 =head3 Defaults
 525
 526 =over 4
 527
 528 =item as_post(node) (General)
 529
 530 Return a POST representation of C<node>.  Note that C<post> is
 531 a multimethod based on the type of its first argument, this is
 532 the method that is called when no other methods match.
 533
 534 =item as_post(Any)
 535
 536 This is the "fallback" method for any unrecognized node types.
 537 We use this to throw a more useful exception in case any non-PAST
 538 nodes make it into the tree.
 539
 540 =cut
 541
 542 .sub 'as_post' :method :multi(_, _)
 543     .param pmc node
 544     .param pmc options         :slurpy :named
 545     unless null node goto not_null_node
 546     self.'panic'("PAST::Compiler can't compile a null node")
 547     not_null_node:
 548
 549     $S0 = typeof node
 550     self.'panic'("PAST::Compiler can't compile node of type ", $S0)
 551 .end
 552
 553 =item as_post(Undef)
 554
 555 Return an empty POST node that can be used to hold a (PMC) result.
 556
 557 =cut
 558
 559 .sub 'as_post' :method :multi(_, Undef)
 560     .param pmc node
 561     .param pmc options         :slurpy :named
 562     .local string result
 563     $P0 = get_hll_global ['POST'], 'Ops'
 564     result = self.'uniquereg'('P')
 565     .tailcall $P0.'new'('result'=>result)
 566 .end
 567
 568
 569 =item as_post(Integer)
 570
 571 =item as_post(Float)
 572
 573 =item as_post(String)
 574
 575 Handle Integer, Float, and String nodes in the PAST tree, by
 576 generating a constant or an appropriate register setting.
 577
 578 =cut
 579
 580 .sub 'as_post' :method :multi(_, Integer)
 581     .param pmc node
 582     .param pmc options         :slurpy :named
 583     $P0 = get_hll_global ['POST'], 'Ops'
 584     $P0 = $P0.'new'( 'result'=>node )
 585     $S0 = options['rtype']
 586     .tailcall self.'coerce'($P0, $S0)
 587 .end
 588
 589 .sub 'as_post' :method :multi(_, Float)
 590     .param pmc node
 591     .param pmc options         :slurpy :named
 592     $P0 = get_hll_global ['POST'], 'Ops'
 593     $P0 = $P0.'new'( 'result'=>node )
 594     $S0 = options['rtype']
 595     .tailcall self.'coerce'($P0, $S0)
 596 .end
 597
 598 .sub 'as_post' :method :multi(_, String)
 599     .param pmc node
 600     .param pmc options         :slurpy :named
 601     .local string value
 602     value = self.'escape'(node)
 603     $P0 = get_hll_global ['POST'], 'Ops'
 604     $P0 = $P0.'new'( 'result'=>value )
 605     $S0 = options['rtype']
 606     .tailcall self.'coerce'($P0, $S0)
 607 .end
 608
 609
 610 =item as_vivipost(String class)
 611
 612 Generate POST to create a new object of type C<class>.  This
 613 is typically invoked by the various vivification methods below
 614 (e.g., in a PAST::Var node to default a variable to a given type).
 615
 616 =cut
 617
 618 .sub 'as_vivipost' :method :multi(_, String)
 619     .param pmc node
 620     .param pmc options         :slurpy :named
 621
 622     .local string result
 623     $P0 = get_hll_global ['POST'], 'Op'
 624     result = self.'uniquereg'('P')
 625     $S0 = self.'escape'(node)
 626     .tailcall $P0.'new'(result, $S0, 'pirop'=>'new', 'result'=>result)
 627 .end
 628
 629 =item as_vivipost(PAST::Node node)
 630
 631 =cut
 632
 633 .sub 'as_vivipost' :method :multi(_, _)
 634     .param pmc node
 635     .param pmc options         :slurpy :named
 636     .tailcall self.'as_post'(node, options :flat :named)
 637 .end
 638
 639 =item as_post(PAST::Node node)
 640
 641 Return the POST representation of executing C<node>'s children in
 642 sequence.  The result of the final child is used as the result
 643 of this node.
 644
 645 N.B.:  This method is also the one that is invoked for converting
 646 nodes of type C<PAST::Stmts>.
 647
 648 =cut
 649
 650 .sub 'as_post' :method :multi(_, ['PAST';'Node']) :subid('Node.as_post')
 651     .param pmc node
 652     .param pmc options         :slurpy :named
 653
 654     .local pmc ops
 655     .local string rtype
 656     rtype = options['rtype']
 657     $P0 = node.'list'()
 658     $I0 = elements $P0
 659     $S0 = repeat 'v', $I0
 660     concat $S0, rtype
 661     ops = self.'post_children'(node, 'signature'=>$S0)
 662     $P0 = ops[-1]
 663     ops.'result'($P0)
 664     .local pmc eh
 665     eh = node.'handlers'()
 666     unless eh, no_eh
 667     ops = self.'wrap_handlers'(ops, eh, 'rtype'=>rtype)
 668   no_eh:
 669     .return (ops)
 670 .end
 671
 672 =back
 673
 674 =head3 C<PAST::Control>
 675
 676 =over 4
 677
 678 =item as_post(PAST::Control node)
 679
 680 Return the POST representation of a C<PAST::Control>.
 681
 682 =cut
 683
 684 .sub 'as_post' :method :multi(_, ['PAST';'Control'])
 685     .param pmc node
 686     .param pmc options         :slurpy :named
 687
 688     .local pmc ops, children, ishandled, nothandled
 689     .local string handled
 690     $P0 = get_hll_global ['POST'], 'Label'
 691     $S0 = self.'unique'('handled_')
 692     ishandled = $P0.'new'('result'=>$S0)
 693     $S0 = self.'unique'('nothandled_')
 694     nothandled = $P0.'new'('result'=>$S0)
 695     $P0 = get_hll_global ['POST'], 'Ops'
 696     ops = $P0.'new'('node'=>node)
 697     .local string rtype
 698     rtype = options['rtype']
 699     $P0 = node.'list'()
 700     $I0 = elements $P0
 701     $S0 = repeat 'v', $I0
 702     concat $S0, rtype
 703     ops.'push_pirop'('.local pmc exception')
 704     ops.'push_pirop'('.get_results (exception)')
 705     children = self.'post_children'(node, 'signature'=>$S0)
 706     ops.'push'(children)
 707     handled = self.'uniquereg'('I')
 708     ops.'push_pirop'('set', handled, 'exception["handled"]')
 709     ops.'push_pirop'('ne', handled, 1, nothandled)
 710     ops.'push'(ishandled)
 711     ops.'push_pirop'('return', 'exception')
 712     ops.'push'(nothandled)
 713     ops.'push_pirop'('rethrow', 'exception')
 714     .return (ops)
 715 .end
 716
 717 .sub 'wrap_handlers' :method
 718     .param pmc child
 719     .param pmc ehs
 720     .param pmc options         :slurpy :named
 721
 722     .local string rtype
 723     rtype = options['rtype']
 724
 725     .local pmc it, node, ops, pops, tail, skip
 726     $P0 = get_hll_global ['POST'], 'Ops'
 727     ops = $P0.'new'('node'=>node)
 728     $P0 = get_hll_global ['POST'], 'Ops'
 729     pops = $P0.'new'('node'=>node)
 730     $P0 = get_hll_global ['POST'], 'Ops'
 731     tail = $P0.'new'('node'=>node)
 732     $P0 = get_hll_global ['POST'], 'Label'
 733     $S0 = self.'unique'('skip_handler_')
 734     skip = $P0.'new'('result'=>$S0)
 735
 736     it = iter ehs
 737   handler_loop:
 738     unless it, handler_loop_done
 739     node = shift it
 740
 741     .local pmc ehpir, label, controltypes, subpost
 742     .local string ehreg, type
 743     $P0 = get_hll_global ['POST'], 'Label'
 744     $S0 = self.'unique'('control_')
 745     label = $P0.'new'('result'=>$S0)
 746
 747     subpost = find_dynamic_lex '$*SUB'
 748
 749     ehreg = self.'uniquereg'('P')
 750     ops.'push_pirop'('new', ehreg, "'ExceptionHandler'")
 751     ops.'push_pirop'('set_addr', ehreg, label)
 752     controltypes = get_global '%!controltypes'
 753     type = node.'handle_types'()
 754     unless type, handle_types_done
 755     type = controltypes[type]
 756     unless type, handle_types_done
 757     $P0 = split ',', type
 758     ops.'push_pirop'('callmethod', '"handle_types"', ehreg, $P0 :flat)
 759     subpost.'add_directive'('.include "except_types.pasm"')
 760   handle_types_done:
 761     type = node.'handle_types_except'()
 762     unless type, handle_types_except_done
 763     type = controltypes[type]
 764     unless type, handle_types_except_done
 765     $P0 = split ',', type
 766     ops.'push_pirop'('callmethod', '"handle_types_except"', ehreg, $P0 :flat)
 767     subpost.'add_directive'('.include "except_types.pasm"')
 768   handle_types_except_done:
 769     ops.'push_pirop'('push_eh', ehreg)
 770
 771     # Add one pop_eh for every handler we push_eh
 772     pops.'push_pirop'('pop_eh')
 773
 774     # Push the handler itself
 775     tail.'push'(label)
 776     ehpir = self.'as_post'(node, 'rtype'=>rtype)
 777     tail.'push'(ehpir)
 778
 779     goto handler_loop
 780   handler_loop_done:
 781
 782     ops.'push'(child)
 783
 784
 785     ops.'push'(pops)
 786     ops.'push_pirop'('goto', skip)
 787     ops.'push'(tail)
 788     ops.'push'(skip)
 789
 790     .return (ops)
 791 .end
 792
 793 =back
 794
 795 =head3 C<PAST::Block>
 796
 797 =over 4
 798
 799 =item as_post(PAST::Block node)
 800
 801 Return the POST representation of a C<PAST::Block>.
 802
 803 =cut
 804
 805 .sub 'as_post' :method :multi(_, ['PAST';'Block'])
 806     .param pmc node
 807     .param pmc options         :slurpy :named
 808
 809     ##  add current block node to @*BLOCKPAST
 810     .local pmc blockpast
 811     blockpast = find_dynamic_lex '@*BLOCKPAST'
 812     unshift blockpast, node
 813
 814     .local string name, pirflags, blocktype
 815     .local pmc nsentry, subid, ns, hll, multi
 816     name = node.'name'()
 817     pirflags = node.'pirflags'()
 818     blocktype = node.'blocktype'()
 819     nsentry = node.'nsentry'()
 820     subid = node.'subid'()
 821     ns = node.'namespace'()
 822     hll = node.'hll'()
 823     multi = node.'multi'()
 824
 825     ##  handle nsentry attribute
 826     $I0 = defined nsentry
 827     unless $I0 goto nsentry_done
 828     unless nsentry goto nsentry_anon
 829     $S0 = self.'escape'(nsentry)
 830     pirflags = concat pirflags, ' :nsentry('
 831     pirflags = concat pirflags, $S0
 832     pirflags = concat pirflags, ')'
 833     goto nsentry_done
 834   nsentry_anon:
 835     pirflags = concat pirflags, ' :anon'
 836   nsentry_done:
 837
 838     ##  handle anonymous blocks
 839     if name goto have_name
 840     name = self.'unique'('_block')
 841     if ns goto have_name
 842     if nsentry goto have_name
 843     pirflags = concat pirflags, ' :anon'
 844   have_name:
 845
 846     ##  create a POST::Sub node for this block
 847     .local pmc bpost
 848     $P0 = get_hll_global ['POST'], 'Sub'
 849     bpost = $P0.'new'('node'=>node, 'name'=>name, 'blocktype'=>blocktype, 'namespace'=>ns, 'hll'=>hll, 'subid'=>subid, 'multi'=>multi)
 850     unless pirflags goto pirflags_done
 851     bpost.'pirflags'(pirflags)
 852   pirflags_done:
 853
 854     ##  pir-encode name and namespace
 855     .local string blockreg, blockref
 856     blockreg = self.'uniquereg'('P')
 857     if ns goto block_ns
 858     blockref = concat ".const 'Sub' ", blockreg
 859     concat blockref, ' = '
 860     $P0 = bpost.'subid'()
 861     $S0 = self.'escape'($P0)
 862     concat blockref, $S0
 863     goto have_blockref
 864   block_ns:
 865     $P0 = get_hll_global ['POST'], 'Compiler'
 866     blockref = concat 'get_hll_global ', blockreg
 867     $S0 = $P0.'key_pir'(ns)
 868     concat blockref, ', '
 869     concat blockref, $S0
 870     $S0 = self.'escape'(name)
 871     concat blockref, ', '
 872     concat blockref, $S0
 873   have_blockref:
 874
 875     ##  determine the outer POST::Sub for the new one
 876     .local pmc outerpost
 877     outerpost = find_dynamic_lex '$*SUB'
 878     .lex '$*SUB', bpost
 879
 880     .local int islexical
 881     islexical = node.'lexical'()
 882     unless islexical goto outer_done
 883     bpost.'outer'(outerpost)
 884
 885     ##  add block setup code (cpost) to outer block if needed
 886     if null outerpost goto outer_done
 887     .local pmc cpost
 888     $P0 = get_hll_global ['POST'], 'Ops'
 889     cpost = $P0.'new'( 'result'=>blockreg )
 890     cpost.'push_pirop'(blockref)
 891     cpost.'push_pirop'('capture_lex', blockreg)
 892     outerpost.'unshift'(cpost)
 893   outer_done:
 894
 895     ##  merge the node's symtable with the master
 896     .local pmc outersym, symtable
 897     outersym = getattribute self, '%!symtable'
 898     symtable = outersym
 899     ##  if the Block doesn't have a symtable, re-use the existing one
 900     $P0 = node.'symtable'()
 901     unless $P0 goto have_symtable
 902     ##  if the Block has a default ('') entry, use the Block's symtable as-is
 903     symtable = $P0
 904     $I0 = defined symtable['']
 905     if $I0 goto have_symtable
 906     ##  merge the Block's symtable with outersym
 907     symtable = clone symtable
 908   symtable_merge:
 909     .local pmc it
 910     it = iter outersym
 911   symtable_merge_loop:
 912     unless it goto have_symtable
 913     $S0 = shift it
 914     $I0 = exists symtable[$S0]
 915     if $I0 goto symtable_merge_loop
 916     $P0 = it[$S0]
 917     symtable[$S0] = $P0
 918     goto symtable_merge_loop
 919   have_symtable:
 920     setattribute self, '%!symtable', symtable
 921
 922     .local pmc compiler
 923     compiler = node.'compiler'()
 924     if compiler goto children_compiler
 925
 926     ##  control exception handler
 927     .local pmc ctrlpast, ctrllabel
 928     ctrlpast = node.'control'()
 929     unless ctrlpast goto children_past
 930     $P0 = get_hll_global ['POST'], 'Label'
 931     $S0 = self.'unique'('control_')
 932     ctrllabel = $P0.'new'('result'=>$S0)
 933     $S0 = self.'uniquereg'('P')
 934     bpost.'push_pirop'('new', $S0, "'ExceptionHandler'")
 935     bpost.'push_pirop'('set_addr', $S0, ctrllabel)
 936     bpost.'push_pirop'('callmethod', '"handle_types"', $S0, '.CONTROL_RETURN')
 937     bpost.'push_pirop'('push_eh', $S0)
 938     bpost.'add_directive'('.include "except_types.pasm"')
 939
 940   children_past:
 941     ##  all children but last are void context, last returns anything
 942     $P0 = node.'list'()
 943     $I0 = elements $P0
 944     $S0 = repeat 'v', $I0
 945     concat $S0, '*'
 946     ##  convert children to post
 947     .local pmc ops, retval
 948     ops = self.'post_children'(node, 'signature'=>$S0)
 949     ##  wrap the child with appropriate exception handlers, if any
 950     .local pmc eh
 951     eh = node.'handlers'()
 952     unless eh, no_eh
 953     $S0 = options['rtype']
 954     retval = ops[-1]
 955     ops = self.'wrap_handlers'(ops, eh, 'rtype'=>$S0)
 956     goto had_eh
 957   no_eh:
 958     ##  result of last child is return from block
 959     retval = ops[-1]
 960   had_eh:
 961     bpost.'push'(ops)
 962     bpost.'push_pirop'('return', retval)
 963
 964     unless ctrlpast goto sub_done
 965     bpost.'push'(ctrllabel)
 966     bpost.'push_pirop'('.local pmc exception')
 967     bpost.'push_pirop'('.get_results (exception)')
 968     $I0 = isa ctrlpast, ['PAST';'Node']
 969     if $I0 goto control_past
 970     if ctrlpast == 'return_pir' goto control_return
 971     self.'panic'("Unrecognized control handler '", ctrlpast, "'")
 972   control_return:
 973     ##  handle 'return' exceptions
 974     $S0 = self.'uniquereg'('P')
 975     bpost.'push_pirop'('getattribute', $S0, 'exception', '"payload"')
 976     bpost.'push_pirop'('return', $S0)
 977     goto sub_done
 978   control_past:
 979     $P0 = self.'as_post'(ctrlpast, 'rtype'=>'*')
 980     bpost.'push'($P0)
 981     goto sub_done
 982
 983   children_compiler:
 984     ##  set the compiler to use for the POST::Sub node, pass on
 985     ##  and compiler arguments and add this block's child to it.
 986     bpost.'compiler'(compiler)
 987     $P0 = node.'compiler_args'()
 988     bpost.'compiler_args'($P0)
 989     $P0 = node[0]
 990     bpost.'push'($P0)
 991
 992   sub_done:
 993     ##  generate any loadinit code for the sub
 994     $I0 = exists node['loadinit']
 995     unless $I0 goto loadinit_done
 996     .local pmc lisub
 997     $P0 = get_hll_global ['POST'], 'Sub'
 998     lisub = $P0.'new'('outer'=>bpost, 'pirflags'=>':load :init')
 999     lisub.'push_pirop'(blockref)
1000     lisub.'push_pirop'('.local pmc', 'block')
1001     lisub.'push_pirop'('set', 'block', blockreg)
1002     .local pmc lipast, lipost
1003     lipast = node.'loadinit'()
1004     lipost = self.'as_post'(lipast, 'rtype'=>'v')
1005     lisub.'push'(lipost)
1006     bpost['loadinit'] = lisub
1007   loadinit_done:
1008
1009     ##  restore previous outer scope and symtable
1010     setattribute self, '%!symtable', outersym
1011
1012     ##  return block or block result
1013     .local string rtype, result
1014     rtype = options['rtype']
1015
1016     if blocktype == 'immediate' goto block_immediate
1017     if rtype == 'v' goto block_done
1018     $P0 = get_hll_global ['POST'], 'Ops'
1019     bpost = $P0.'new'( bpost, 'node'=>node, 'result'=>blockreg)
1020     bpost.'push_pirop'( blockref, 'result'=>blockreg )
1021     unless islexical goto block_done
1022     $I0 = node.'closure'()
1023     if $I0 goto block_closure
1024     bpost.'push_pirop'('capture_lex', blockreg)
1025     goto block_done
1026
1027   block_closure:
1028     ##  return a reference to a clone of the block with captured outer context
1029     result = self.'uniquereg'('P')
1030     bpost.'push_pirop'('newclosure', result, blockreg)
1031     bpost.'result'(result)
1032     goto block_done
1033
1034   block_immediate:
1035     .local pmc arglist
1036     arglist = options['arglist']
1037     unless null arglist goto have_arglist
1038     arglist = new 'ResizablePMCArray'
1039   have_arglist:
1040     result = self.'uniquereg'(rtype)
1041     $P0 = get_hll_global ['POST'], 'Ops'
1042     bpost = $P0.'new'(bpost, 'node'=>node, 'result'=>result)
1043     bpost.'push_pirop'(blockref)
1044     unless islexical goto block_immediate_capture_skip
1045     bpost.'push_pirop'('capture_lex', blockreg)
1046   block_immediate_capture_skip:
1047     bpost.'push_pirop'('call', blockreg, arglist :flat, 'result'=>result)
1048
1049   block_done:
1050     ##  remove current block from @*BLOCKPAST
1051     $P99 = shift blockpast
1052     .return (bpost)
1053 .end
1054
1055
1056 =back
1057
1058 =head3 C<PAST::Op>
1059
1060 =over 4
1061
1062 =item as_post(PAST::Op node)
1063
1064 Return the POST representation of a C<PAST::Op> node.  Normally
1065 this is handled by redispatching to a method corresponding to
1066 the node's "pasttype" attribute.
1067
1068 =cut
1069
1070 .sub 'as_post' :method :multi(_, ['PAST';'Op'])
1071     .param pmc node
1072     .param pmc options         :slurpy :named
1073
1074     ##  see if we set first child's lvalue
1075     $I0 = node.'lvalue'()
1076     unless $I0 goto have_lvalue
1077     $P0 = node[0]
1078     if null $P0 goto have_lvalue
1079     $I1 = exists $P0['lvalue']
1080     if $I1 goto have_lvalue
1081     $P0.'lvalue'($I0)
1082   have_lvalue:
1083
1084     .local string pasttype
1085     pasttype = node.'pasttype'()
1086     unless pasttype goto post_pirop
1087     $P0 = find_method self, pasttype
1088     .tailcall self.$P0(node, options :flat :named)
1089
1090   post_pirop:
1091     .local pmc pirop
1092     pirop = node.'pirop'()
1093     unless pirop goto post_inline
1094     .tailcall self.'pirop'(node, options :flat :named)
1095
1096   post_inline:
1097     .local pmc inline
1098     inline = node.'inline'()
1099     unless inline goto post_call
1100     .tailcall self.'inline'(node, options :flat :named)
1101
1102   post_call:
1103     .tailcall self.'call'(node, options :flat :named)
1104 .end
1105
1106
1107 =item pirop(PAST::Op node)
1108
1109 Return the POST representation of a C<PAST::Op> node with
1110 a 'pasttype' of 'pirop'.
1111
1112 =cut
1113
1114 .sub 'pirop' :method :multi(_, ['PAST';'Op'])
1115     .param pmc node
1116     .param pmc options         :slurpy :named
1117
1118     .local string pirop, signature
1119     pirop = node.'pirop'()
1120     ##  see if pirop is of form "pirop signature"
1121     $I0 = index pirop, ' '
1122     if $I0 < 0 goto pirop_0
1123     $I1 = $I0 + 1
1124     signature = substr pirop, $I1
1125     pirop = substr pirop, 0, $I0
1126     goto have_signature
1127   pirop_0:
1128     ##  see if pirop is of form "pirop__signature"
1129     $I0 = index pirop, '__'
1130     if $I0 < 0 goto pirop_1
1131     $I1 = $I0 + 2
1132     signature = substr pirop, $I1
1133     pirop = substr pirop, 0, $I0
1134     goto have_signature
1135   pirop_1:
1136     $P0 = get_global '%piropsig'
1137     signature = $P0[pirop]
1138     if signature goto have_signature
1139     signature = 'vP'
1140   have_signature:
1141
1142     .local pmc ops, posargs
1143     (ops, posargs) = self.'post_children'(node, 'signature'=>signature)
1144
1145     .local pmc arglist
1146     arglist = ops.'list'()
1147
1148     $S0 = substr signature, 0, 1
1149     if $S0 == 'v' goto pirop_void
1150     $I0 = index '0123456789', $S0
1151     if $I0 < 0 goto pirop_reg
1152     $S0 = arglist[$I0]
1153     ops.'result'($S0)
1154     goto pirop_void
1155   pirop_reg:
1156     .local string result
1157     result = self.'uniquereg'($S0)
1158     ops.'result'(result)
1159     ops.'push_pirop'(pirop, result, posargs :flat)
1160     .return (ops)
1161   pirop_void:
1162     ops.'push_pirop'(pirop, posargs :flat)
1163     .return (ops)
1164 .end
1165
1166
1167 =item call(PAST::Op node)
1168
1169 Return the POST representation of a C<PAST::Op> node
1170 for calling a sub.
1171
1172 =cut
1173
1174 .sub 'call' :method :multi(_, ['PAST';'Op'])
1175     .param pmc node
1176     .param pmc options         :slurpy :named
1177     .local string pasttype
1178     pasttype = node.'pasttype'()
1179     if pasttype goto have_pasttype
1180     pasttype = 'call'
1181   have_pasttype:
1182
1183     .local string signature
1184     signature = 'v:'
1185     ## for callmethod, the invocant (child) must be a PMC
1186     if pasttype != 'callmethod' goto have_signature
1187     signature = 'vP:'
1188   have_signature:
1189
1190     .local pmc name, ops, posargs, namedargs
1191     name = node.'name'()
1192     if name goto call_by_name
1193     ##  our first child is the thing to be invoked, so make sure it's a PMC
1194     signature = replace signature, 1, 0, 'P'
1195     (ops, posargs, namedargs) = self.'post_children'(node, 'signature'=>signature)
1196     goto children_done
1197   call_by_name:
1198     (ops, posargs, namedargs) = self.'post_children'(node, 'signature'=>signature)
1199     $I0 = isa name, ['PAST';'Node']
1200     if $I0 goto call_by_name_past
1201     $S0 = self.'escape'(name)
1202     unshift posargs, $S0
1203     goto children_done
1204   call_by_name_past:
1205     .local pmc name_post
1206     name_post = self.'as_post'(name, 'rtype'=>'s')
1207     name_post = self.'coerce'(name_post, 's')
1208     ops.'push'(name_post)
1209     unshift posargs, name_post
1210   children_done:
1211
1212     ##  generate the call itself
1213     .local string result, rtype
1214     rtype = options['rtype']
1215     result = self.'uniquereg'(rtype)
1216     ops.'push_pirop'(pasttype, posargs :flat, namedargs :flat, 'result'=>result)
1217     ops.'result'(result)
1218     .return (ops)
1219 .end
1220
1221
1222 =item callmethod(PAST::Op node)
1223
1224 Return the POST representation of a C<PAST::Op> node
1225 to invoke a method on a PMC.
1226
1227 =cut
1228
1229 .sub 'callmethod' :method :multi(_, ['PAST';'Op'])
1230     .param pmc node
1231     .param pmc options         :slurpy :named
1232     .tailcall self.'call'(node, options :flat :named)
1233 .end
1234
1235
1236 =item if(PAST::Op node)
1237
1238 =item unless(PAST::Op node)
1239
1240 Return the POST representation of C<PAST::Op> nodes with
1241 a 'pasttype' of if/unless.
1242
1243 =cut
1244
1245 .sub 'if' :method :multi(_,['PAST';'Op'])
1246     .param pmc node
1247     .param pmc options         :slurpy :named
1248
1249     .local pmc opsclass, ops
1250     opsclass = get_hll_global ['POST'], 'Ops'
1251     ops = opsclass.'new'('node'=>node)
1252
1253     .local string rtype, result
1254     rtype = options['rtype']
1255     result = self.'uniquereg'(rtype)
1256     ops.'result'(result)
1257
1258     .local string pasttype
1259     pasttype = node.'pasttype'()
1260
1261     .local pmc exprpast, thenpast, elsepast, childpast
1262     .local pmc exprpost, thenpost, elsepost, childpost
1263     exprpast = node[0]
1264     thenpast = node[1]
1265     elsepast = node[2]
1266
1267     .local pmc thenlabel, endlabel
1268     $P0 = get_hll_global ['POST'], 'Label'
1269     $S0 = concat pasttype, '_'
1270     $S0 = self.'unique'($S0)
1271     thenlabel = $P0.'new'('result'=>$S0)
1272     $S0 = concat $S0, '_end'
1273     endlabel = $P0.'new'('result'=>$S0)
1274
1275     .local string exprrtype, childrtype
1276     exprrtype = 'r'
1277     if rtype != 'v' goto have_exprrtype
1278     exprrtype = '*'
1279   have_exprrtype:
1280     childrtype = rtype
1281     $I0 = index '*:', rtype
1282     if $I0 < 0 goto have_childrtype
1283     childrtype = 'P'
1284   have_childrtype:
1285
1286     exprpost = self.'as_post'(exprpast, 'rtype'=>exprrtype)
1287
1288     .local pmc jmpstack
1289     jmpstack = new 'ResizableIntegerArray'
1290     childpast = thenpast
1291     local_branch jmpstack, make_childpost
1292     thenpost = childpost
1293     childpast = elsepast
1294     local_branch jmpstack, make_childpost
1295     elsepost = childpost
1296
1297     if null elsepost goto no_elsepost
1298
1299     ops.'push'(exprpost)
1300     ops.'push_pirop'(pasttype, exprpost, thenlabel)
1301     if null elsepost goto else_done
1302     ops.'push'(elsepost)
1303   else_done:
1304     ops.'push_pirop'('goto', endlabel)
1305     ops.'push'(thenlabel)
1306     if null thenpost goto then_done
1307     ops.'push'(thenpost)
1308   then_done:
1309     ops.'push'(endlabel)
1310     .return (ops)
1311
1312   no_elsepost:
1313     $S0 = 'if'
1314     unless pasttype == $S0 goto no_elsepost_1
1315     $S0 = 'unless'
1316   no_elsepost_1:
1317     ops.'push'(exprpost)
1318     ops.'push_pirop'($S0, exprpost, endlabel)
1319     if null thenpost goto no_elsepost_2
1320     ops.'push'(thenpost)
1321   no_elsepost_2:
1322     ops.'push'(endlabel)
1323     .return (ops)
1324
1325   make_childpost:
1326     null childpost
1327     $I0 = defined childpast
1328     unless $I0 goto no_childpast
1329     .local pmc arglist
1330     arglist = new 'ResizablePMCArray'
1331     $I0 = childpast.'arity'()
1332     unless $I0 > 0 goto have_arglist
1333     push arglist, exprpost
1334   have_arglist:
1335     childpost = self.'as_post'(childpast, 'rtype'=>childrtype, 'arglist'=>arglist)
1336     goto childpost_coerce
1337   no_childpast:
1338     if rtype == 'v' goto ret_childpost
1339     childpost = opsclass.'new'('result'=>exprpost)
1340   childpost_coerce:
1341     unless result goto ret_childpost
1342     childpost = self.'coerce'(childpost, result)
1343   ret_childpost:
1344     local_return jmpstack
1345 .end
1346
1347 .sub 'unless' :method :multi(_, ['PAST';'Op'])
1348     .param pmc node
1349     .param pmc options         :slurpy :named
1350     .tailcall self.'if'(node, options :flat :named)
1351 .end
1352
1353
1354 =item loop_gen(...)
1355
1356 Generate a standard loop with NEXT/LAST/REDO exception handling.
1357
1358 =cut
1359
1360 .sub 'loop_gen' :method
1361     .param pmc options         :slurpy :named
1362
1363     .local pmc testlabel, prelabel, redolabel, nextlabel, donelabel, handlabel
1364     $P0 = get_hll_global ['POST'], 'Label'
1365     .local string loopname
1366     loopname = self.'unique'('loop')
1367     $S0 = concat loopname, '_test'
1368     testlabel = $P0.'new'('result'=>$S0)
1369     $S0 = concat loopname, '_redo'
1370     redolabel = $P0.'new'('result'=>$S0)
1371     $S0 = concat loopname, '_next'
1372     nextlabel = $P0.'new'('result'=>$S0)
1373     $S0 = concat loopname, '_done'
1374     donelabel = $P0.'new'('result'=>$S0)
1375     $S0 = concat loopname, '_handler'
1376     handlabel = $P0.'new'('result'=>$S0)
1377
1378     .local pmc testpost, prepost, bodypost, nextpost
1379     .local string testop
1380     .local int bodyfirst
1381     testop = options['testop']
1382     testpost = options['test']
1383     prepost  = options['pre']
1384     bodypost = options['body']
1385     nextpost = options['next']
1386     bodyfirst = options['bodyfirst']
1387
1388     if testop goto have_testop
1389     testop = 'unless'
1390   have_testop:
1391
1392     .local pmc ops
1393     $P0 = get_hll_global ['POST'], 'Ops'
1394     ops = $P0.'new'()
1395
1396     $P0 = find_dynamic_lex '$*SUB'
1397     $P0.'add_directive'('.include "except_types.pasm"')
1398
1399     .local string handreg
1400     handreg = self.'uniquereg'('P')
1401     ops.'push_pirop'('new', handreg, "'ExceptionHandler'")
1402     ops.'push_pirop'('set_addr', handreg, handlabel)
1403     ops.'push_pirop'('callmethod', '"handle_types"', handreg, '.CONTROL_LOOP_NEXT', '.CONTROL_LOOP_REDO', '.CONTROL_LOOP_LAST')
1404     ops.'push_pirop'('push_eh', handreg)
1405
1406     unless bodyfirst goto bodyfirst_done
1407     ops.'push_pirop'('goto', redolabel)
1408   bodyfirst_done:
1409     ops.'push'(testlabel)
1410     if null testpost goto test_done
1411     ops.'push'(testpost)
1412     ops.'push_pirop'(testop, testpost, donelabel)
1413   test_done:
1414     if null prepost goto pre_done
1415     ops.'push'(prepost)
1416   pre_done:
1417     ops.'push'(redolabel)
1418     if null bodypost goto body_done
1419     ops.'push'(bodypost)
1420   body_done:
1421     ops.'push'(nextlabel)
1422     if null nextpost goto next_done
1423     ops.'push'(nextpost)
1424   next_done:
1425     ops.'push_pirop'('goto', testlabel)
1426     ops.'push'(handlabel)
1427     ops.'push_pirop'('.local pmc exception')
1428     ops.'push_pirop'('.get_results (exception)')
1429     $S0 = self.'uniquereg'('P')
1430     ops.'push_pirop'('getattribute', $S0, 'exception', "'type'")
1431     ops.'push_pirop'('eq', $S0, '.CONTROL_LOOP_NEXT', nextlabel)
1432     ops.'push_pirop'('eq', $S0, '.CONTROL_LOOP_REDO', redolabel)
1433     ops.'push'(donelabel)
1434     ops.'push_pirop'('pop_eh')
1435     .return (ops)
1436 .end
1437
1438
1439 =item while(PAST::Op node)
1440
1441 =item until(PAST::Op node)
1442
1443 =item repeat_while(PAST::Op node)
1444
1445 =item repeat_until(PAST::Op node)
1446
1447 Return the POST representation of a C<while> or C<until> loop.
1448
1449 =cut
1450
1451 .sub 'while' :method :multi(_, ['PAST';'Op'])
1452     .param pmc node
1453     .param pmc options         :slurpy :named
1454     .local pmc exprpast, bodypast, nextpast
1455     exprpast = node[0]
1456     bodypast = node[1]
1457     nextpast = node[2]
1458
1459     .local pmc exprpost, bodypost, nextpost
1460     exprpost = self.'as_post'(exprpast, 'rtype'=>'r')
1461
1462     .local pmc arglist
1463     arglist = new 'ResizablePMCArray'
1464     $I0 = bodypast.'arity'()
1465     if $I0 < 1 goto have_arglist
1466     push arglist, exprpost
1467   have_arglist:
1468     bodypost = self.'as_post'(bodypast, 'rtype'=>'v', 'arglist'=>arglist)
1469
1470     null nextpost
1471     if null nextpast goto have_nextpost
1472     nextpost = self.'as_post'(nextpast, 'rtype'=>'v')
1473   have_nextpost:
1474
1475     .local string testop
1476     testop = options['testop']
1477     .local int bodyfirst
1478     bodyfirst = options['bodyfirst']
1479
1480     .local pmc ops
1481     ops = self.'loop_gen'('testop'=>testop, 'test'=>exprpost, 'body'=>bodypost, 'bodyfirst'=>bodyfirst, 'next'=>nextpost)
1482     ops.'result'(exprpost)
1483     ops.'node'(node)
1484     .return (ops)
1485 .end
1486
1487 .sub 'until' :method :multi(_, ['PAST';'Op'])
1488     .param pmc node
1489     .param pmc options         :slurpy :named
1490     .tailcall self.'while'(node, options :flat :named, 'testop'=>'if')
1491 .end
1492
1493 .sub 'repeat_while' :method :multi(_, ['PAST';'Op'])
1494     .param pmc node
1495     .param pmc options         :slurpy :named
1496     .tailcall self.'while'(node, options :flat :named, 'bodyfirst'=>1)
1497 .end
1498
1499 .sub 'repeat_until' :method :multi(_, ['PAST';'Op'])
1500     .param pmc node
1501     .param pmc options         :slurpy :named
1502     .tailcall self.'while'(node, options :flat :named, 'testop'=>'if', 'bodyfirst'=>1)
1503 .end
1504
1505
1506 =item for(PAST::Op node)
1507
1508 Return the POST representation of the C<for> loop given
1509 by C<node>.
1510
1511 =cut
1512
1513 .sub 'for' :method :multi(_, ['PAST';'Op'])
1514     .param pmc node
1515     .param pmc options         :slurpy :named
1516
1517     .local pmc ops, prepost, testpost
1518     $P0 = get_hll_global ['POST'], 'Ops'
1519     ops      = $P0.'new'('node'=>node)
1520     prepost  = $P0.'new'()
1521     $S0      = self.'uniquereg'('P')
1522     testpost = $P0.'new'('result'=>$S0)
1523
1524     .local pmc collpast, bodypast
1525     collpast = node[0]
1526     bodypast = node[1]
1527
1528     .local pmc collpost
1529     collpost = self.'as_post'(collpast, 'rtype'=>'P')
1530     ops.'push'(collpost)
1531
1532     ##  don't try to iterate undefined values
1533     .local pmc undeflabel
1534     $P0 = get_hll_global ['POST'], 'Label'
1535     undeflabel = $P0.'new'('name'=>'for_undef_')
1536     $S0 = self.'uniquereg'('I')
1537     ops.'push_pirop'('defined', $S0, collpost)
1538     ops.'push_pirop'('unless', $S0, undeflabel)
1539
1540     ops.'push_pirop'('iter', testpost, collpost)
1541
1542     ##  determine the arity of the loop.  We check arity of the 'for'
1543     ##  node itself, and if not set we use the arity of the body.
1544     .local int arity
1545     arity = 1
1546     $P0 = node.'arity'()
1547     $I0 = defined $P0
1548     unless $I0 goto arity_child
1549     arity = $P0
1550     goto have_arity
1551   arity_child:
1552     $P0 = bodypast.'arity'()
1553     $I0 = defined $P0
1554     unless $I0 goto have_arity
1555     arity = $P0
1556   have_arity:
1557
1558     ##  build the argument list to pass to the body
1559     .local pmc arglist
1560     arglist = new 'ResizablePMCArray'
1561   arity_loop:
1562     .local string nextarg
1563     nextarg = self.'uniquereg'('P')
1564     prepost.'push_pirop'('shift', nextarg, testpost)
1565     if arity < 1 goto arity_end
1566     push arglist, nextarg
1567     dec arity
1568     if arity > 0 goto arity_loop
1569   arity_end:
1570
1571     ##  now build the body itself
1572     .local pmc bodypost
1573     bodypost = self.'as_post'(bodypast, 'rtype'=>'v', 'arglist'=>arglist)
1574
1575     ##  generate the loop and return
1576     $P0 = self.'loop_gen'('test'=>testpost, 'pre'=>prepost, 'body'=>bodypost)
1577     ops.'push'($P0)
1578     ops.'push'(undeflabel)
1579     ops.'result'(testpost)
1580     .return (ops)
1581 .end
1582
1583
1584 =item list(PAST::Op node)
1585
1586 Build a list from the children.  The type of list constructed
1587 is determined by the C<returns> attribute, which defaults
1588 to C<ResizablePMCArray> if not set.
1589
1590 =cut
1591
1592 .sub 'list' :method :multi(_, ['PAST';'Op'])
1593     .param pmc node
1594     .param pmc options         :slurpy :named
1595
1596     .local pmc ops, posargs
1597     (ops, posargs) = self.'post_children'(node, 'signature'=>'v*')
1598
1599     .local pmc returns
1600     returns = node.'returns'()
1601     if returns goto have_returns
1602     returns = box 'ResizablePMCArray'
1603   have_returns:
1604
1605     .local pmc listpost, it
1606     listpost = self.'as_vivipost'(returns, 'rtype'=>'P')
1607     ops.'result'(listpost)
1608     ops.'push'(listpost)
1609     it = iter posargs
1610   iter_loop:
1611     unless it goto iter_end
1612     $S0 = shift it
1613     ops.'push_pirop'('push', listpost, $S0)
1614     goto iter_loop
1615   iter_end:
1616     .return (ops)
1617 .end
1618
1619
1620 =item stmts(PAST::Op node)
1621
1622 Treat the node like a PAST::Stmts node -- i.e., invoke all the
1623 children and return the value of the last one.
1624
1625 =cut
1626
1627 .sub 'stmts' :method :multi(_, ['PAST';'Op'])
1628     .param pmc node
1629     .param pmc options         :slurpy :named
1630
1631     .const 'Sub' $P0 = 'Node.as_post'
1632     .tailcall self.$P0(node, options :flat :named)
1633 .end
1634
1635
1636 =item null(PAST::Op node)
1637
1638 A "no-op" node -- none of the children are processed, and
1639 no statements are generated.
1640
1641 =cut
1642
1643 .sub 'null' :method :multi(_, ['PAST';'Op'])
1644     .param pmc node
1645     .param pmc options         :slurpy :named
1646     $P0 = get_hll_global ['POST'], 'Ops'
1647     .tailcall $P0.'new'('node'=>node)
1648 .end
1649
1650
1651 =item return(PAST::Op node)
1652
1653 Generate a return exception, using the first child (if any) as
1654 a return value.
1655
1656 =cut
1657
1658 .sub 'return' :method :multi(_, ['PAST';'Op'])
1659     .param pmc node
1660     .param pmc options         :slurpy :named
1661
1662     .local pmc ops
1663     $P0 = get_hll_global ['POST'], 'Ops'
1664     ops = $P0.'new'('node'=>node)
1665
1666     .local string exreg, extype
1667     exreg = self.'uniquereg'('P')
1668     extype = concat exreg, "['type']"
1669     ops.'push_pirop'('new', exreg, '"Exception"')
1670     ops.'push_pirop'('set', extype, '.CONTROL_RETURN')
1671     $P0 = find_dynamic_lex '$*SUB'
1672     $P0.'add_directive'('.include "except_types.pasm"')
1673
1674     .local pmc cpast, cpost
1675     cpast = node[0]
1676     unless cpast goto cpast_done
1677     cpost = self.'as_post'(cpast, 'rtype'=>'P')
1678     cpost = self.'coerce'(cpost, 'P')
1679     ops.'push'(cpost)
1680     ops.'push_pirop'('setattribute', exreg, "'payload'", cpost)
1681   cpast_done:
1682     ops.'push_pirop'('throw', exreg)
1683     .return (ops)
1684 .end
1685
1686
1687 =item try(PAST::Op node)
1688
1689 Return the POST representation of a C<PAST::Op>
1690 node with a 'pasttype' of bind.  The first child
1691 is the code to be surrounded by an exception handler,
1692 the second child (if any) is the code to process the
1693 handler.
1694
1695 =cut
1696
1697 .sub 'try' :method :multi(_, ['PAST';'Op'])
1698     .param pmc node
1699     .param pmc options       :slurpy :named
1700
1701     .local pmc ops
1702     $P0 = get_hll_global ['POST'], 'Ops'
1703     ops = $P0.'new'('node'=>node)
1704
1705     .local pmc catchlabel, endlabel
1706     $P0 = get_hll_global ['POST'], 'Label'
1707     $S0 = self.'unique'('catch_')
1708     catchlabel = $P0.'new'('result'=>$S0)
1709     $S0 = concat $S0, '_end'
1710     endlabel = $P0.'new'('result'=>$S0)
1711
1712     .local string rtype
1713     rtype = options['rtype']
1714
1715     .local pmc trypast, trypost
1716     trypast = node[0]
1717     trypost = self.'as_post'(trypast, 'rtype'=>rtype)
1718     ops.'push_pirop'('push_eh', catchlabel)
1719     ops.'push'(trypost)
1720     ops.'push_pirop'('pop_eh')
1721     .local pmc elsepast, elsepost
1722     elsepast = node[2]
1723     if null elsepast goto else_done
1724     elsepost = self.'as_post'(elsepast, 'rtype'=>'v')
1725     ops.'push'(elsepost)
1726   else_done:
1727     ops.'push_pirop'('goto', endlabel)
1728     ops.'push'(catchlabel)
1729     .local pmc catchpast, catchpost
1730     catchpast = node[1]
1731     if null catchpast goto catch_done
1732     catchpost = self.'as_post'(catchpast, 'rtype'=>'v')
1733     ops.'push'(catchpost)
1734     ops.'push_pirop'('pop_eh')         # FIXME: should be before catchpost
1735   catch_done:
1736     ops.'push'(endlabel)
1737     ops.'result'(trypost)
1738     .return (ops)
1739 .end
1740
1741
1742 =item chain(PAST::Op node)
1743
1744 A short-circuiting chain of operations.  In a sequence of nodes
1745 with pasttype 'chain', the right operand of a node serves as
1746 the left operand of its parent.  Each node is evaluated only
1747 once, and the first false result short-circuits the chain.
1748 In other words,  C<<  $x < $y < $z >>  is true only if
1749 $x < $y and $y < $z, but $y only gets evaluated once.
1750
1751 =cut
1752
1753 .sub 'chain' :method :multi(_, ['PAST';'Op'])
1754     .param pmc node
1755     .param pmc options         :slurpy :named
1756     .local pmc clist, cpast
1757
1758     ##  first, we build up the list of nodes in the chain
1759     clist = new 'ResizablePMCArray'
1760     cpast = node
1761   chain_loop:
1762     $I0 = isa cpast, ['PAST';'Op']
1763     if $I0 == 0 goto chain_end
1764     .local string pasttype
1765     pasttype = cpast.'pasttype'()
1766     if pasttype != 'chain' goto chain_end
1767     push clist, cpast
1768     cpast = cpast[0]
1769     goto chain_loop
1770   chain_end:
1771
1772     .local pmc ops, endlabel
1773     $P0 = get_hll_global ['POST'], 'Ops'
1774     ops = $P0.'new'('node'=>node)
1775     $S0 = self.'unique'('$P')
1776     ops.'result'($S0)
1777     $P0 = get_hll_global ['POST'], 'Label'
1778     endlabel = $P0.'new'('name'=>'chain_end_')
1779
1780     .local pmc apast, apost
1781     cpast = pop clist
1782     apast = cpast[0]
1783     apost = self.'as_post'(apast, 'rtype'=>'P')
1784     ops.'push'(apost)
1785
1786   clist_loop:
1787     .local pmc bpast, bpost
1788     bpast = cpast[1]
1789     bpost = self.'as_post'(bpast, 'rtype'=>'P')
1790     ops.'push'(bpost)
1791     .local string name
1792     name = cpast.'name'()
1793     name = self.'escape'(name)
1794     ops.'push_pirop'('call', name, apost, bpost, 'result'=>ops)
1795     unless clist goto clist_end
1796     ops.'push_pirop'('unless', ops, endlabel)
1797     cpast = pop clist
1798     apost = bpost
1799     goto clist_loop
1800   clist_end:
1801     ops.'push'(endlabel)
1802     .return (ops)
1803 .end
1804
1805
1806 =item def_or(PAST::Op node)
1807
1808 The short-circuiting default operator (e.g., Perl 6's C<< infix:<//> >>).
1809 Returns its first child if its defined, otherwise it evaluates and returns
1810 the second child.  (N.B.: This particular pasttype is a candidate for
1811 being refactored out using thunks of some sort.)
1812
1813 =cut
1814
1815 .sub 'def_or' :method :multi(_, ['PAST';'Op'])
1816     .param pmc node
1817     .param pmc options         :slurpy :named
1818
1819     .local pmc ops
1820     $P0 = get_hll_global ['POST'], 'Ops'
1821     $S0 = self.'unique'('$P')
1822     ops = $P0.'new'('node'=>node, 'result'=>$S0)
1823
1824     .local pmc lpast, lpost
1825     lpast = node[0]
1826     lpost = self.'as_post'(lpast, 'rtype'=>'P')
1827     ops.'push'(lpost)
1828     ops.'push_pirop'('set', ops, lpost)
1829
1830     .local pmc endlabel
1831     $P0 = get_hll_global ['POST'], 'Label'
1832     $S0 = self.'unique'('default_')
1833     endlabel = $P0.'new'('result'=>$S0)
1834
1835     $S0 = self.'unique'('$I')
1836     ops.'push_pirop'('defined', $S0, ops)
1837     ops.'push_pirop'('if', $S0, endlabel)
1838     .local pmc rpast, rpost
1839     rpast = node[1]
1840     rpost = self.'as_post'(rpast, 'rtype'=>'P')
1841     ops.'push'(rpost)
1842     ops.'push_pirop'('set', ops, rpost)
1843     ops.'push'(endlabel)
1844     .return (ops)
1845 .end
1846
1847
1848 =item xor(PAST::Op node)
1849
1850 A short-circuiting exclusive-or operation.  Each child is evaluated,
1851 if exactly one child evaluates to true then its value is returned,
1852 otherwise return Undef.  Short-circuits with Undef as soon as
1853 a second child is found that evaluates as true.
1854
1855 =cut
1856
1857 .sub 'xor' :method :multi(_,['PAST';'Op'])
1858     .param pmc node
1859     .param pmc options         :slurpy :named
1860
1861     .local pmc ops
1862     $P0 = get_hll_global ['POST'], 'Ops'
1863     ops = $P0.'new'('node'=>node)
1864     $S0 = self.'unique'('$P')
1865     ops.'result'($S0)
1866
1867     .local pmc labelproto, endlabel, falselabel
1868     labelproto = get_hll_global ['POST'], 'Label'
1869     falselabel = labelproto.'new'('name'=>'xor_false')
1870     endlabel = labelproto.'new'('name'=>'xor_end')
1871
1872     .local pmc iter, apast, apost, i, t, u
1873     i = self.'unique'('$I')
1874     t = self.'unique'('$I')
1875     u = self.'unique'('$I')
1876     iter = node.'iterator'()
1877     apast = shift iter
1878     apost = self.'as_post'(apast, 'rtype'=>'P')
1879     ops.'push'(apost)
1880     ops.'push_pirop'('set', ops, apost)
1881     ops.'push_pirop'('istrue', t, apost)
1882   middle_child:
1883     .local pmc bpast, bpost
1884     bpast = shift iter
1885     bpost = self.'as_post'(bpast, 'rtype'=>'P')
1886     ops.'push'(bpost)
1887     ops.'push_pirop'('istrue', u, bpost)
1888     ops.'push_pirop'('and', i, t, u)
1889     ops.'push_pirop'('if', i, falselabel)
1890     unless iter goto last_child
1891     .local pmc truelabel
1892     truelabel = labelproto.'new'('name'=>'xor_true')
1893     ops.'push_pirop'('if', t, truelabel)
1894     ops.'push_pirop'('set', ops, bpost)
1895     ops.'push_pirop'('set', t, u)
1896     ops.'push'(truelabel)
1897     goto middle_child
1898   last_child:
1899     ops.'push_pirop'('if', t, endlabel)
1900     ops.'push_pirop'('set', ops, bpost)
1901     ops.'push_pirop'('goto', endlabel)
1902     ops.'push'(falselabel)
1903     ops.'push_pirop'('new', ops, '"Undef"')
1904     ops.'push'(endlabel)
1905     .return (ops)
1906 .end
1907
1908
1909 =item bind(PAST::Op node)
1910
1911 Return the POST representation of a C<PAST::Op>
1912 node with a 'pasttype' of bind.
1913
1914 =cut
1915
1916 .sub 'bind' :method :multi(_, ['PAST';'Op'])
1917     .param pmc node
1918     .param pmc options         :slurpy :named
1919
1920     .local pmc ops, lpast, rpast, lpost, rpost
1921     lpast = node[0]
1922     rpast = node[1]
1923
1924     $P0 = get_hll_global ['POST'], 'Ops'
1925     ops = $P0.'new'('node'=>node)
1926     rpost = self.'as_post'(rpast, 'rtype'=>'P')
1927     rpost = self.'coerce'(rpost, 'P')
1928     ops.'push'(rpost)
1929
1930     lpast.'lvalue'(1)
1931     lpost = self.'as_post'(lpast, 'bindpost'=>rpost)
1932     ops.'push'(lpost)
1933     ops.'result'(lpost)
1934     .return (ops)
1935 .end
1936
1937
1938 =item copy(PAST::Op node)
1939
1940 Implement a 'copy' assignment (at least until we get the 'copy' opcode).
1941
1942 =cut
1943
1944 .sub 'copy' :method :multi(_, ['PAST';'Op'])
1945     .param pmc node
1946     .param pmc options         :slurpy :named
1947     .local pmc rpast, rpost, lpast, lpost
1948     rpast = node[1]
1949     lpast = node[0]
1950     rpost = self.'as_post'(rpast, 'rtype'=>'P')
1951     lpost = self.'as_post'(lpast, 'rtype'=>'P')
1952     .local pmc ops, alabel
1953     $P0 = get_hll_global ['POST'], 'Ops'
1954     ops = $P0.'new'(rpost, lpost, 'node'=>node, 'result'=>lpost)
1955     ops.'push_pirop'('copy', lpost, rpost)
1956     .return (ops)
1957 .end
1958
1959
1960 =item inline(PAST::Op node)
1961
1962 Return the POST representation of a C<PAST::Op>
1963 node with a 'pasttype' of inline.
1964
1965 =cut
1966
1967 .sub 'inline' :method :multi(_, ['PAST';'Op'])
1968     .param pmc node
1969     .param pmc options         :slurpy :named
1970
1971     .local pmc ops
1972     ops = self.'post_children'(node, 'signature'=>'vP')
1973
1974     .local pmc inline_pmc
1975     .local string inline
1976     inline_pmc = node.'inline'()
1977     $I0 = does inline_pmc, 'array'
1978     if $I0 goto inline_array
1979     inline = inline_pmc
1980     goto have_inline
1981   inline_array:
1982     inline = join "\n", inline_pmc
1983   have_inline:
1984
1985     .local string result
1986     result = ''
1987     $I0 = index inline, '%t'
1988     if $I0 >= 0 goto result_new
1989     $I0 = index inline, '%r'
1990     unless $I0 >= 0 goto have_result
1991     result = self.'unique'('$P')
1992     ops.'result'(result)
1993     goto have_result
1994   result_new:
1995     result = self.'unique'('$P')
1996     ops.'push_pirop'('new', result, "'Undef'")
1997     ops.'result'(result)
1998   have_result:
1999
2000     .local pmc arglist
2001     arglist = ops.'list'()
2002     ops.'push_pirop'('inline', arglist :flat, 'inline'=>inline, 'result'=>result)
2003     $S0 = options['rtype']
2004     .return (ops)
2005 .end
2006
2007
2008 =back
2009
2010 =head3 C<PAST::Var>
2011
2012 =over 4
2013
2014 =item as_post(PAST::Var node)
2015
2016 Return the POST representation of a C<PAST::Var>.  Generally we
2017 redispatch to an appropriate handler based on the node's 'scope'
2018 attribute.
2019
2020 =cut
2021
2022 .sub 'as_post' :method :multi(_, ['PAST';'Var'])
2023     .param pmc node
2024     .param pmc options         :slurpy :named
2025
2026     ##  set 'bindpost'
2027     .local pmc bindpost
2028     bindpost = options['bindpost']
2029     unless null bindpost goto have_bindpost
2030     bindpost = new 'Undef'
2031   have_bindpost:
2032
2033     ## determine the node's scope.  First, check the node itself
2034     .local string scope
2035     scope = node.'scope'()
2036     if scope goto have_scope
2037     ## otherwise, check the current symbol table under the variable's name
2038     .local string name
2039     name = node.'name'()
2040     .local pmc symtable
2041     symtable = getattribute self, '%!symtable'
2042     $P0 = symtable[name]
2043     if null $P0 goto default_scope
2044     scope = $P0['scope']
2045     if scope goto have_scope
2046   default_scope:
2047     ##  see if an outer block has set a default scope
2048     $P0 = symtable['']
2049     if null $P0 goto scope_error
2050     scope = $P0['scope']
2051     unless scope goto scope_error
2052   have_scope:
2053     push_eh scope_error_ex
2054     $P0 = find_method self, scope
2055     .tailcall self.$P0(node, bindpost)
2056   scope_error_ex:
2057     pop_eh
2058   scope_error:
2059     unless scope goto scope_error_1
2060     scope = concat " in '", scope
2061     scope = concat scope, "' scope"
2062   scope_error_1:
2063     # Find the nearest named block
2064     .local string blockname
2065     blockname = ''
2066     .local pmc it
2067     $P0 = find_dynamic_lex '@*BLOCKPAST'
2068     it = iter $P0
2069   scope_error_block_loop:
2070     unless it goto scope_error_2
2071     $P0 = shift it
2072     blockname = $P0.'name'()
2073     unless blockname goto scope_error_block_loop
2074   scope_error_2:
2075     if blockname goto have_blockname
2076     blockname = '<anonymous>'
2077   have_blockname:
2078     # Find the source location, if available
2079     .local string sourceline
2080     .local pmc source, pos, files
2081     sourceline = ''
2082     source = node['source']
2083     pos = node['pos']
2084     if null source goto scope_error_3
2085     files = find_caller_lex '$?FILES'
2086     if null files goto scope_error_3
2087     $S0 = files
2088     sourceline = concat ' (', $S0
2089     concat sourceline, ':'
2090     $I0 = self.'lineof'(source, pos)
2091     inc $I0
2092     $S0 = $I0
2093     concat sourceline, $S0
2094     concat sourceline, ')'
2095   scope_error_3:
2096     .tailcall self.'panic'("Symbol '", name, "' not predeclared", scope, " in ", blockname, sourceline)
2097 .end
2098
2099
2100 .sub 'vivify' :method
2101     .param pmc node
2102     .param pmc ops
2103     .param pmc fetchop
2104     .param pmc storeop
2105
2106     .local pmc viviself, vivipost, vivilabel
2107     viviself = node.'viviself'()
2108     vivipost = self.'as_vivipost'(viviself, 'rtype'=>'P')
2109     .local string result
2110     result = vivipost.'result'()
2111     unless result == '' goto have_result
2112     result = self.'uniquereg'('P')
2113   have_result:
2114     ops.'result'(result)
2115     ops.'push'(fetchop)
2116     unless viviself goto vivipost_done
2117     $P0 = get_hll_global ['POST'], 'Label'
2118     vivilabel = $P0.'new'('name'=>'vivify_')
2119     ops.'push_pirop'('unless_null', ops, vivilabel)
2120     ops.'push'(vivipost)
2121     $I0 = node.'lvalue'()
2122     unless $I0 goto vivipost_stored
2123     ops.'push'(storeop)
2124   vivipost_stored:
2125     ops.'push'(vivilabel)
2126   vivipost_done:
2127     .return (ops)
2128 .end
2129
2130
2131 .sub 'parameter' :method :multi(_, ['PAST';'Var'])
2132     .param pmc node
2133     .param pmc bindpost
2134
2135     ##  get the current sub
2136     .local pmc subpost
2137     subpost = find_dynamic_lex '$*SUB'
2138
2139     ##  determine lexical, register, and parameter names
2140     .local string named, pname, has_pname
2141     .local pmc name
2142     name = node.'name'()
2143     named = node.'named'()
2144     pname = self.'unique'('param_')
2145     has_pname = concat 'has_', pname
2146
2147     ##  returned post node
2148     .local pmc ops
2149     $P0 = get_hll_global ['POST'], 'Ops'
2150     ops = $P0.'new'('node'=>node, 'result'=>pname)
2151
2152     ##  handle optional params
2153     .local pmc viviself, vivipost, vivilabel
2154     viviself = node.'viviself'()
2155     unless viviself goto param_required
2156     vivipost = self.'as_vivipost'(viviself, 'rtype'=>'P')
2157     $P0 = get_hll_global ['POST'], 'Label'
2158     vivilabel = $P0.'new'('name'=>'optparam_')
2159     subpost.'add_param'(pname, 'named'=>named, 'optional'=>1)
2160     ops.'push_pirop'('if', has_pname, vivilabel)
2161     ops.'push'(vivipost)
2162     ops.'push_pirop'('set', ops, vivipost)
2163     ops.'push'(vivilabel)
2164     goto param_done
2165
2166   param_required:
2167     .local int call_sig, slurpy
2168     call_sig = node.'call_sig'()
2169     slurpy = node.'slurpy'()
2170     subpost.'add_param'(pname, 'named'=>named, 'slurpy'=>slurpy, 'call_sig'=>call_sig)
2171
2172   param_done:
2173     $I0 = defined name
2174     unless $I0 goto param_lex_done
2175     name = self.'escape'(name)
2176     ops.'push_pirop'('.lex', name, ops)
2177   param_lex_done:
2178     .return (ops)
2179 .end
2180
2181
2182 .sub 'package' :method :multi(_, ['PAST';'Var'])
2183     .param pmc node
2184     .param pmc bindpost
2185
2186     .local pmc ops, fetchop, storeop
2187     $P0 = get_hll_global ['POST'], 'Ops'
2188     ops = $P0.'new'('node'=>node)
2189
2190     .local string name
2191     name = node.'name'()
2192     name = self.'escape'(name)
2193
2194     $P0 = get_hll_global ['POST'], 'Op'
2195     .local pmc ns
2196     ns = node.'namespace'()
2197     $I0 = defined ns
2198     if $I0 goto package_hll
2199     if bindpost goto package_bind
2200     fetchop = $P0.'new'(ops, name, 'pirop'=>'get_global')
2201     storeop = $P0.'new'(name, ops, 'pirop'=>'set_global')
2202     .tailcall self.'vivify'(node, ops, fetchop, storeop)
2203   package_bind:
2204     .tailcall $P0.'new'(name, bindpost, 'pirop'=>'set_global', 'result'=>bindpost)
2205
2206   package_hll:
2207     if ns goto package_ns
2208     if bindpost goto package_hll_bind
2209     fetchop = $P0.'new'(ops, name, 'pirop'=>'get_hll_global')
2210     storeop = $P0.'new'(name, ops, 'pirop'=>'set_hll_global')
2211     .tailcall self.'vivify'(node, ops, fetchop, storeop)
2212   package_hll_bind:
2213     .tailcall $P0.'new'(name, bindpost, 'pirop'=>'set_hll_global', 'result'=>bindpost)
2214
2215   package_ns:
2216     $P1 = get_hll_global ['POST'], 'Compiler'
2217     ns = $P1.'key_pir'(ns)
2218     if bindpost goto package_ns_bind
2219     fetchop = $P0.'new'(ops, ns, name, 'pirop'=>'get_hll_global')
2220     storeop = $P0.'new'(ns, name, ops, 'pirop'=>'set_hll_global')
2221     .tailcall self.'vivify'(node, ops, fetchop, storeop)
2222   package_ns_bind:
2223     .tailcall $P0.'new'(ns, name, bindpost, 'pirop'=>'set_hll_global', 'result'=>bindpost)
2224 .end
2225
2226
2227 .sub 'lexical' :method :multi(_, ['PAST';'Var'])
2228     .param pmc node
2229     .param pmc bindpost
2230
2231     .local string name
2232     $P0 = get_hll_global ['POST'], 'Ops'
2233     name = node.'name'()
2234     name = self.'escape'(name)
2235
2236     .local int isdecl
2237     isdecl = node.'isdecl'()
2238
2239     if bindpost goto lexical_bind
2240
2241   lexical_post:
2242     if isdecl goto lexical_decl
2243     .local pmc ops, fetchop, storeop
2244     ops = $P0.'new'('node'=>node)
2245     $P0 = get_hll_global ['POST'], 'Op'
2246     fetchop = $P0.'new'(ops, name, 'pirop'=>'find_lex')
2247     storeop = $P0.'new'(name, ops, 'pirop'=>'store_lex')
2248     .tailcall self.'vivify'(node, ops, fetchop, storeop)
2249
2250   lexical_decl:
2251     ops = $P0.'new'('node'=>node)
2252     .local pmc viviself, vivipost
2253     viviself = node.'viviself'()
2254     vivipost = self.'as_vivipost'(viviself, 'rtype'=>'P')
2255     ops.'push'(vivipost)
2256     ops.'push_pirop'('.lex', name, vivipost)
2257     ops.'result'(vivipost)
2258     .return (ops)
2259
2260   lexical_bind:
2261     $P0 = get_hll_global ['POST'], 'Op'
2262     if isdecl goto lexical_bind_decl
2263     .tailcall $P0.'new'(name, bindpost, 'pirop'=>'store_lex', 'result'=>bindpost)
2264   lexical_bind_decl:
2265     .tailcall $P0.'new'(name, bindpost, 'pirop'=>'.lex', 'result'=>bindpost)
2266 .end
2267
2268
2269 .sub 'contextual' :method :multi(_, ['PAST';'Var'])
2270     .param pmc node
2271     .param pmc bindpost
2272     # If we've requested a contextual in a block that
2273     # explicitly declares the variable as a different type,
2274     # treat it as that type.
2275     .local string name
2276     name = node.'name'()
2277     $P0 = find_dynamic_lex '@*BLOCKPAST'
2278     $P0 = $P0[0]
2279     $P0 = $P0.'symtable'()
2280     unless $P0 goto contextual
2281     $P0 = $P0[name]
2282     if null $P0 goto contextual
2283     $S0 = $P0['scope']
2284     unless $S0 goto contextual
2285     if $S0 == 'contextual' goto contextual
2286     .tailcall self.$S0(node, bindpost)
2287
2288   contextual:
2289     # If this is a declaration, treat it like a normal lexical
2290     .local int isdecl
2291     isdecl = node.'isdecl'()
2292     if isdecl goto contextual_lex
2293
2294     name = self.'escape'(name)
2295     if bindpost goto contextual_bind
2296
2297   contextual_post:
2298     .local pmc ops, fetchop, storeop
2299     $P0 = get_hll_global ['POST'], 'Ops'
2300     ops = $P0.'new'('node'=>node)
2301     $P0 = get_hll_global ['POST'], 'Op'
2302     fetchop = $P0.'new'(ops, name, 'pirop'=>'find_dynamic_lex')
2303     storeop = $P0.'new'(name, ops, 'pirop'=>'store_dynamic_lex')
2304     .tailcall self.'vivify'(node, ops, fetchop, storeop)
2305
2306   contextual_bind:
2307     $P0 = get_hll_global ['POST'], 'Op'
2308     .tailcall $P0.'new'(name, bindpost, 'pirop'=>'store_dynamic_lex', 'result'=>bindpost)
2309
2310   contextual_lex:
2311     .tailcall self.'lexical'(node, bindpost)
2312 .end
2313
2314
2315 .sub 'keyed' :method :multi(_, ['PAST';'Var'])
2316     .param pmc node
2317     .param pmc bindpost
2318     .param string keyrtype     :optional
2319     .param int has_keyrtype    :opt_flag
2320
2321     .local pmc ops
2322     $P0 = get_hll_global ['POST'], 'Ops'
2323     ops = $P0.'new'('node'=>node)
2324
2325     if has_keyrtype goto have_keyrtype
2326     keyrtype = '*'
2327   have_keyrtype:
2328
2329     .local pmc keypast, keypost
2330     keypast = node[1]
2331     keypost = self.'as_post'(keypast, 'rtype'=>keyrtype)
2332     keypost = self.'coerce'(keypost, keyrtype)
2333     ops.'push'(keypost)
2334
2335     .local pmc basepast, basepost
2336     basepast = node[0]
2337
2338     $P0 = node.'vivibase'()
2339     unless $P0 goto have_vivibase
2340     $I0 = can basepast, 'viviself'
2341     unless $I0 goto have_vivibase
2342     $P1 = basepast.'viviself'()
2343     unless $P1 goto vivibase_1
2344     if $P1 != 'Undef' goto have_vivibase
2345   vivibase_1:
2346     basepast.'viviself'($P0)
2347   have_vivibase:
2348
2349     #  if the keyed node is an lvalue, its base is an lvalue also
2350     $I0 = node.'lvalue'()
2351     unless $I0 goto have_lvalue
2352     basepast.'lvalue'($I0)
2353   have_lvalue:
2354
2355     basepost = self.'as_post'(basepast, 'rtype'=>'P')
2356     ops.'push'(basepost)
2357     .local string name
2358     $S0 = basepost.'result'()
2359     name = concat $S0, '['
2360     $S0 = keypost.'result'()
2361     concat name, $S0
2362     concat name, ']'
2363     .local pmc fetchop, storeop
2364     $P0 = get_hll_global ['POST'], 'Op'
2365     if bindpost goto keyed_bind
2366     fetchop = $P0.'new'(ops, name, 'pirop'=>'set')
2367     storeop = $P0.'new'(name, ops, 'pirop'=>'set')
2368     .tailcall self.'vivify'(node, ops, fetchop, storeop)
2369   keyed_bind:
2370     ops.'result'(bindpost)
2371     ops.'push_pirop'('set', name, ops)
2372     .return (ops)
2373 .end
2374
2375
2376 .sub 'keyed_int' :method :multi(_, ['PAST';'Var'])
2377     .param pmc node
2378     .param pmc bindpost
2379     .tailcall self.'keyed'(node, bindpost, 'i')
2380 .end
2381
2382
2383 .sub 'attribute' :method :multi(_, ['PAST';'Var'])
2384     .param pmc node
2385     .param pmc bindpost
2386
2387     .local pmc ops
2388     $P0 = get_hll_global ['POST'], 'Ops'
2389     ops = $P0.'new'('node'=>node)
2390     .local string name
2391     name = node.'name'()
2392     name = self.'escape'(name)
2393
2394     .local pmc call_on
2395     call_on = node[0]
2396     if null call_on goto use_self
2397     call_on = self.'as_post'(call_on, 'rtype'=>'P')
2398     ops.'push'(call_on)
2399     goto invocant_done
2400   use_self:
2401     call_on = box 'self'
2402   invocant_done:
2403
2404     if bindpost goto attribute_bind
2405
2406   attribute_post:
2407     .local pmc fetchop, storeop
2408     $P0 = get_hll_global ['POST'], 'Op'
2409     fetchop = $P0.'new'(ops, call_on, name, 'pirop'=>'getattribute')
2410     storeop = $P0.'new'(call_on, name, ops, 'pirop'=>'setattribute')
2411     .tailcall self.'vivify'(node, ops, fetchop, storeop)
2412
2413   attribute_bind:
2414     ops.'push_pirop'('setattribute', call_on, name, bindpost)
2415     ops.'result'(bindpost)
2416     .return (ops)
2417 .end
2418
2419
2420 .sub 'register' :method :multi(_, ['PAST';'Var'])
2421     .param pmc node
2422     .param pmc bindpost
2423
2424     .local string name
2425     name = node.'name'()
2426     if name goto have_name
2427     name = self.'uniquereg'('P')
2428     node.'name'(name)
2429   have_name:
2430
2431     .local pmc ops
2432     $P0 = get_hll_global ['POST'], 'Ops'
2433     ops = $P0.'new'('result'=>name, 'node'=>node)
2434
2435     .local int isdecl
2436     isdecl = node.'isdecl'()
2437     unless isdecl goto decl_done
2438     ops.'push_pirop'('.local pmc', ops)
2439   decl_done:
2440
2441     if bindpost goto register_bind
2442
2443     .local pmc viviself, vivipost
2444     viviself = node.'viviself'()
2445     unless viviself goto end
2446     vivipost = self.'as_vivipost'(viviself, 'rtype'=>'P')
2447     ops.'push'(vivipost)
2448     ops.'push_pirop'('set', ops, vivipost)
2449     goto end
2450
2451   register_bind:
2452     ops.'push_pirop'('set', ops, bindpost)
2453
2454   end:
2455     .return (ops)
2456 .end
2457
2458
2459 =back
2460
2461 =head3 C<PAST::Val>
2462
2463 =over 4
2464
2465 =item as_post(PAST::Val node [, 'rtype'=>rtype])
2466
2467 Return the POST representation of the constant value given
2468 by C<node>.  The C<rtype> parameter advises the method whether
2469 the value may be returned directly as a PIR constant or needs
2470 to have a PMC generated containing the constant value.
2471
2472 =cut
2473
2474 .sub 'as_post' :method :multi(_, ['PAST';'Val'])
2475     .param pmc node
2476     .param pmc options         :slurpy :named
2477
2478     .local pmc ops
2479     $P0 = get_hll_global ['POST'], 'Ops'
2480     ops = $P0.'new'('node'=>node)
2481
2482     .local pmc value, returns
2483     value = node['value']
2484     if null value goto err_novalue
2485     $I0 = isa value, ['PAST';'Block']
2486     if $I0 goto value_block
2487     returns = node.'returns'()
2488     if returns goto have_returns
2489     $S0 = typeof value
2490     returns = $S0
2491   have_returns:
2492
2493     .local string valflags
2494     $P0 = get_global '%valflags'
2495     valflags = $P0[returns]
2496
2497     $I0 = index valflags, 'e'
2498     if $I0 < 0 goto escape_done
2499     value = self.'escape'(value)
2500   escape_done:
2501
2502     # See if this is a pasm constant type
2503     $I0 = index valflags, 'c'
2504     if $I0 < 0 goto const_done
2505     # Add the directive for the appropriate .include statement.
2506     $S0 = returns
2507     $S0 = replace $S0, 0, 1, '.include "'
2508     $S0 = concat $S0, '.pasm"'
2509     $P0 = find_dynamic_lex '$*SUB'
2510     $P0.'add_directive'($S0)
2511     # Add a leading dot to the value if one isn't already there.
2512     $S0 = substr value, 0, 1
2513     if $S0 == '.' goto const_done
2514     $P0 = box '.'
2515     value = concat $P0, value
2516   const_done:
2517
2518     .local string rtype
2519     rtype = options['rtype']
2520     $I0 = index valflags, rtype
2521     if $I0 < 0 goto result_convert
2522     ops.'result'(value)
2523     .return (ops)
2524
2525   result_convert:
2526     # handle int-to-num conversion here
2527     if rtype != 'n' goto result_pmc
2528     $I0 = index valflags, 'i'
2529     if $I0 < 0 goto result_pmc
2530     value = concat value, '.0'
2531     ops.'result'(value)
2532     .return (ops)
2533
2534   result_pmc:
2535     .local string result
2536     result = self.'uniquereg'('P')
2537     returns = self.'escape'(returns)
2538     ops.'push_pirop'('new', result, returns)
2539     ops.'push_pirop'('assign', result, value)
2540     ops.'result'(result)
2541     .return (ops)
2542
2543   value_block:
2544     .local string blockreg, blockref
2545     blockreg = self.'uniquereg'('P')
2546     blockref = concat ".const 'Sub' ", blockreg
2547     concat blockref, ' = '
2548     $P0 = value.'subid'()
2549     $S0 = self.'escape'($P0)
2550     concat blockref, $S0
2551     ops.'push_pirop'(blockref)
2552     ops.'result'(blockreg)
2553     .return (ops)
2554
2555   err_novalue:
2556     self.'panic'('PAST::Val node missing :value attribute')
2557 .end
2558
2559
2560 =back
2561
2562 =head1 AUTHOR
2563
2564 Patrick Michaud <pmichaud@pobox.com> is the author and maintainer.
2565 Please send patches and suggestions to the Parrot porters or
2566 Perl 6 compilers mailing lists.
2567
2568 =head1 HISTORY
2569
2570 2006-11-20  Patrick Michaud added first draft of POD documentation.
2571 2006-11-27  Significant refactor into separate modules.
2572
2573 =head1 COPYRIGHT
2574
2575 Copyright (C) 2006-2008, Parrot Foundation.
2576
2577 =cut
2578
2579 # Local Variables:
2580 #   mode: pir
2581 #   fill-column: 100
2582 # End:
2583 # vim: expandtab shiftwidth=4 ft=pir: