languages/tcl/runtime/builtin/if.pir

   1 .HLL 'Tcl', ''
   2 .namespace []
   3
   4 .sub '&if'
   5     .param pmc argv :slurpy
   6
   7     .local int argc
   8     argc = elements argv
   9
  10     .local pmc compileExpr
  11     compileExpr = get_root_global ['_tcl'], 'compileExpr'
  12
  13     if argc == 0 goto no_args
  14
  15     .local pmc ns
  16     $P0 = getinterp
  17     ns  = $P0['namespace'; 1]
  18
  19     # we have to do arg checking first, to make sure we got the proper type of
  20     # exception. but [expr] checking has to happen before that. so replace each
  21     # string expression with a Sub that represents it. and while we're at it,
  22     # strip out the "then"s.
  23
  24     # convert to the expression to a Sub
  25     $S0 = argv[0]
  26     $P0 = compileExpr($S0, 'ns'=>ns)
  27
  28     $I0 = 1
  29     if $I0 == argc goto no_script
  30
  31     argv[0] = $P0
  32
  33     $S0 = argv[$I0]
  34     unless $S0 == 'then' goto arg_next
  35
  36     # we have to do this check first so that "then" shows up in the error
  37     inc $I0
  38     if $I0 == argc goto no_script
  39
  40     dec $I0
  41     delete argv[$I0]
  42     dec argc
  43 arg_next:
  44     inc $I0
  45     if $I0 == argc goto arg_end
  46
  47     $S0 = argv[$I0]
  48     if $S0 == 'elseif' goto arg_elseif
  49     if $S0 == 'else'   goto arg_else
  50
  51     # 'else' is optional
  52     dec $I0
  53     goto arg_else
  54
  55 arg_elseif:
  56     inc $I0
  57     if $I0 == argc goto no_expression
  58
  59     # convert to the expression to a Sub
  60     $S0 = argv[$I0]
  61     $P0 = compileExpr($S0)
  62
  63     inc $I0
  64     if $I0 == argc goto no_script
  65
  66     $I1 = $I0 - 1
  67     argv[$I1] = $P0
  68
  69     $S0 = argv[$I0]
  70     unless $S0 == 'then' goto arg_next
  71
  72     # we have to do this check first so that "then" shows up in the error
  73     inc $I0
  74     if $I0 == argc goto no_script
  75
  76     dec $I0
  77     delete argv[$I0]
  78     dec argc
  79     goto arg_next
  80
  81 arg_else:
  82     inc $I0
  83     if $I0 == argc goto no_script
  84
  85     inc $I0
  86     if $I0 != argc goto extra_words_after_else
  87 arg_end:
  88
  89     # now we can do the actual evaluation
  90     .local pmc compileTcl, toBoolean
  91     compileTcl  = get_root_global ['_tcl'], 'compileTcl'
  92     toBoolean = get_root_global ['_tcl'], 'toBoolean'
  93
  94     .local pmc    cond
  95     .local string code
  96     cond = argv[0]
  97     code = argv[1]
  98     $I0  = 1
  99
 100 loop:
 101     $P1 = cond()
 102     $I1 = toBoolean($P1)
 103     unless $I1 goto next
 104     $P0 = compileTcl(code, 'ns'=>ns)
 105     .return $P0()
 106
 107 next:
 108     inc $I0
 109     if $I0 == argc goto nothing
 110
 111     $S0 = argv[$I0]
 112     if $S0 == 'elseif' goto elseif
 113     if $S0 == 'else'   goto else
 114
 115     # 'else' is optional
 116     dec $I0
 117     goto else
 118
 119 elseif:
 120     inc $I0
 121     cond = argv[$I0]
 122     inc $I0
 123     code = argv[$I0]
 124     goto loop
 125
 126 else:
 127     inc $I0
 128     code = argv[$I0]
 129     $P0  = compileTcl(code, 'ns'=>ns)
 130     .return $P0()
 131
 132 extra_words_after_else:
 133     die 'wrong # args: extra words after "else" clause in "if" command'
 134
 135 nothing:
 136     .return('')
 137
 138 no_args:
 139     die 'wrong # args: no expression after "if" argument'
 140
 141 no_script:
 142     dec $I0
 143     $S0 = argv[$I0]
 144     $S0 = 'wrong # args: no script following "' . $S0
 145     $S0 = $S0 . '" argument'
 146     die $S0
 147
 148 no_expression:
 149     dec $I0
 150     $S0 = argv[$I0]
 151     $S0 = 'wrong # args: no expression after "' . $S0
 152     $S0 = $S0 . '" argument'
 153     die $S0
 154 .end
 155
 156 # Local Variables:
 157 #   mode: pir
 158 #   fill-column: 100
 159 # End:
 160 # vim: expandtab shiftwidth=4 ft=pir: