languages/tcl/runtime/builtin/global.pir

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