languages/tcl/runtime/builtin/global.pir

   1 ###
   2 # [global]
   3
   4 .HLL 'Tcl', 'tcl_group'
   5 .namespace []
   6
   7 .sub '&global'
   8   .param pmc argv :slurpy
   9
  10   .local int argc
  11   argc = argv
  12
  13   if argc == 0 goto badargs
  14
  15   .local pmc call_chain, lexpad
  16   .local int call_level
  17   call_chain = get_root_global ['_tcl'], 'call_chain'
  18   call_level = elements call_chain
  19   unless call_level goto done # global doesn't work when already global.
  20   lexpad = call_chain[-1]
  21
  22   .local int ii
  23   ii = 0
  24   .local string varname
  25   .local string sigil_varname
  26
  27 loop:
  28   if ii == argc goto done
  29   varname = argv[ii]
  30   sigil_varname = '$' . varname
  31
  32   $P1 = get_hll_global sigil_varname
  33   if null $P1 goto create_global
  34 has_global:
  35   lexpad[sigil_varname] = $P1
  36   inc ii
  37   goto loop
  38
  39 create_global:
  40   $P1 = new 'Undef'
  41   set_hll_global sigil_varname, $P1
  42   goto has_global
  43
  44 done:
  45   .return('')
  46
  47 badargs:
  48   tcl_error 'wrong # args: should be "global varName ?varName ...?"'
  49 .end
  50
  51 # Local Variables:
  52 #   mode: pir
  53 #   fill-column: 100
  54 # End:
  55 # vim: expandtab shiftwidth=4 ft=pir: