languages/tcl/runtime/builtin/binary.pir

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