languages/tcl/runtime/builtin/for.pir

   1 .HLL 'Tcl', ''
   2 .namespace []
   3
   4 .sub '&for'
   5   .param pmc argv :slurpy
   6
   7   .local int argc
   8   argc = elements argv
   9   if argc != 4 goto bad_args
  10   # get necessary conversion subs
  11   .local pmc compileTcl
  12   compileTcl = get_root_global ['_tcl'], 'compileTcl'
  13   .local pmc compileExpr
  14   compileExpr = get_root_global ['_tcl'], 'compileExpr'
  15
  16   .local pmc a_start
  17   a_start = argv[0]
  18   a_start = compileTcl(a_start)
  19   .local pmc a_test
  20   a_test = argv[1]
  21   a_test = compileExpr(a_test)
  22   .local pmc a_next
  23   a_next = argv[2]
  24   a_next = compileTcl(a_next)
  25   .local pmc a_command
  26   a_command = argv[3]
  27   a_command = compileTcl(a_command)
  28   .local pmc temp
  29
  30   .local pmc toBoolean
  31   toBoolean = get_root_global ['_tcl'], 'toBoolean'
  32   a_start()
  33
  34 loop:
  35   temp = a_test()
  36   $I0 = toBoolean(temp)
  37   unless $I0 goto done
  38   push_eh command_exception
  39     a_command()
  40   pop_eh
  41 continue:
  42   push_eh next_exception
  43     a_next()
  44   pop_eh
  45   goto loop
  46
  47 command_exception:
  48   .catch()
  49   .get_return_code($I0)
  50   if $I0 == .CONTROL_CONTINUE goto continue
  51   if $I0 == .CONTROL_BREAK    goto done
  52   .rethrow()
  53
  54 next_exception:
  55   .catch()
  56   .get_return_code($I0)
  57   if $I0 == .CONTROL_BREAK goto done
  58   .rethrow()
  59
  60 done:
  61   .return('')
  62 bad_args:
  63   die 'wrong # args: should be "for start test next command"'
  64 .end
  65
  66 # Local Variables:
  67 #   mode: pir
  68 #   fill-column: 100
  69 # End:
  70 # vim: expandtab shiftwidth=4 ft=pir: