languages/tcl/runtime/builtin/binary.pir

   1 .HLL 'Tcl', 'tcl_group'
   2 .namespace []
   3
   4 .sub '&binary'
   5     .param pmc argv :slurpy
   6
   7     .local pmc retval
   8
   9     $I0 = elements argv
  10     unless $I0 goto no_args
  11
  12     .local string subcommand_name
  13     subcommand_name = shift argv
  14
  15     .local pmc options
  16     options = new 'ResizablePMCArray'
  17     push options, 'format'
  18     push options, 'scan'
  19
  20     .local pmc select_option
  21     select_option  = get_root_global ['_tcl'], 'select_option'
  22     .local string canonical_subcommand
  23     canonical_subcommand = select_option(options, subcommand_name)
  24
  25     .local pmc subcommand_proc
  26     null subcommand_proc
  27
  28     subcommand_proc = get_root_global ['_tcl'; 'helpers'; 'binary'], canonical_subcommand
  29     if_null subcommand_proc, bad_args
  30     .return subcommand_proc(argv)
  31
  32 bad_args:
  33   .return ('') # once all commands are implemented, remove this...
  34
  35 no_args:
  36     tcl_error 'wrong # args: should be "binary option ?arg arg ...?"'
  37 .end
  38
  39 .HLL '_Tcl',''
  40 .namespace [ 'helpers'; 'binary' ]
  41
  42 .sub 'format'
  43     .param pmc argv
  44
  45     .local int argc
  46     .local pmc retval
  47
  48     argc = elements argv
  49     unless argc goto bad_args
  50
  51     .local string formatString, binStr
  52     formatString = shift argv
  53     binStr       = tcl_binary_format formatString, argv
  54
  55     .return(binStr)
  56
  57 bad_args:
  58     tcl_error 'wrong # args: should be "binary format formatString ?arg arg ...?"'
  59 .end
  60
  61 .sub 'scan'
  62     .param pmc argv
  63
  64     .local int argc
  65     argc = elements argv
  66     unless argc >= 2 goto bad_args
  67
  68     .local string value, formatString
  69     value        = shift argv
  70     formatString = shift argv
  71
  72     .local pmc ret
  73     ret = tcl_binary_scan value, formatString
  74
  75     .local pmc __set, variables, values
  76     __set = get_root_global ['_tcl'], '__set'
  77     variables = new 'Iterator', argv
  78     values    = new 'Iterator', ret
  79 loop:
  80     unless variables goto end
  81     unless values    goto end
  82
  83     .local pmc var, value
  84     var   = shift variables
  85     value = shift values
  86     __set(var, value)
  87
  88     goto loop
  89 end:
  90
  91     .return('')
  92
  93 bad_args:
  94     tcl_error 'wrong # args: should be "binary scan value formatString ?varName varName ...?"'
  95 .end
  96
  97 # Local Variables:
  98 #   mode: pir
  99 #   fill-column: 100
 100 # End:
 101 # vim: expandtab shiftwidth=4 ft=pir: