languages/tcl/runtime/builtin/lindex.pir

   1 ###
   2 # [source]
   3
   4 .HLL 'Tcl', 'tcl_group'
   5 .namespace []
   6
   7 .sub '&lindex'
   8   .param pmc argv :slurpy
   9
  10   .local int argc
  11   argc = argv
  12   if argc < 1 goto bad_args
  13
  14   .local pmc __list, __index
  15   __list  = get_root_global ['_tcl'], '__list'
  16   __index = get_root_global ['_tcl'], '__index'
  17
  18   .local pmc list
  19   list = argv[0]
  20   list = __list(list)
  21
  22 have_list:
  23   if argc == 1 goto done
  24
  25   $I0 = 0
  26 select_elem:
  27   inc $I0
  28   if $I0 == argc goto done
  29
  30   $P0 = argv[$I0]
  31   .local pmc indices
  32   push_eh not_a_list
  33     indices = __list($P0)
  34   pop_eh
  35   goto select
  36
  37 not_a_list:
  38   indices = new 'FixedPMCArray'
  39   indices = 1
  40   indices[0] = $P0
  41
  42 select:
  43   .local int index
  44   .local int elems
  45   elems = elements indices
  46   $I1 = 0
  47 select_loop:
  48   if $I1 >= elems goto select_elem
  49   list = __list(list)
  50
  51   $P0 = indices[$I1]
  52   index = __index($P0, list)
  53
  54   $I2 = elements list
  55   if index >= $I2 goto empty
  56   if index < 0    goto empty
  57
  58   list  = list[index]
  59
  60   inc $I1
  61   goto select_loop
  62
  63 done:
  64   .return(list)
  65
  66 empty:
  67   .return('')
  68
  69 bad_args:
  70   tcl_error 'wrong # args: should be "lindex list ?index...?"'
  71 .end
  72
  73 # Local Variables:
  74 #   mode: pir
  75 #   fill-column: 100
  76 # End:
  77 # vim: expandtab shiftwidth=4 ft=pir: