hbytes/ulongs.c

   1 /*
   2  */
   3
   4 #include "hbytes.h"
   5 #include "tables.h"
   6
   7 /* nice simple functions */
   8
   9 int do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v,
  10                     uint32_t *result) {
  11   if (v<0) return staticerr(ip,"cannot convert -ve integer to ulong");
  12   *result= v;
  13   return TCL_OK;
  14 }
  15
  16 int do_ulong_add(ClientData cd, Tcl_Interp *ip,
  17                  uint32_t a, uint32_t b, uint32_t *result) {
  18   *result= a + b;
  19   return TCL_OK;
  20 }
  21
  22 int do_ulong_subtract(ClientData cd, Tcl_Interp *ip,
  23                       uint32_t a, uint32_t b, uint32_t *result) {
  24   *result= a - b;
  25   return TCL_OK;
  26 }
  27
  28 int do_ulong_compare(ClientData cd, Tcl_Interp *ip,
  29                      uint32_t a, uint32_t b, int *result) {
  30   *result=
  31     a == b ? 0 :
  32     a < b ? -1 : 1;
  33   return TCL_OK;
  34 }
  35
  36 int do_ulong_ul2int(ClientData cd, Tcl_Interp *ip,
  37                     uint32_t v, int *result) {
  38   if (v>INT_MAX) return staticerr(ip,"ulong too large to fit in an int");
  39   *result= v;
  40   return TCL_OK;
  41 }
  42
  43 int do_ulong_mask(ClientData cd, Tcl_Interp *ip,
  44                   uint32_t a, uint32_t b, uint32_t *result) {
  45   *result= a & b;
  46   return TCL_OK;
  47 }
  48
  49 int do_ulong_shift(ClientData cd, Tcl_Interp *ip, int right,
  50                    uint32_t v, int bits, uint32_t *result) {
  51   if (bits > 32) return staticerr(ip,"shift out of range (32) bits");
  52   *result= (bits==32 ? 0 :
  53             right ? v >> bits : v << bits);
  54   return TCL_OK;
  55 }
  56
  57 /* bitfields */
  58
  59 typedef struct {
  60   const char *name;
  61   int want_arg;
  62   int (*reader_writer[2])(Tcl_Interp *ip, uint32_t *value_io,
  63                           int *ok_io, Tcl_Obj *arg);
  64 } BitFieldType;
  65
  66 static int bf_zero_read(Tcl_Interp *ip, uint32_t *value_io,
  67                         int *ok_io, Tcl_Obj *arg) {
  68   if (*value_io) *ok_io= 0;
  69   return TCL_OK;
  70 }
  71
  72 static int bf_zero_write(Tcl_Interp *ip, uint32_t *value_io,
  73                          int *ok_io, Tcl_Obj *arg) {
  74   *value_io= 0;
  75   return TCL_OK;
  76 }
  77
  78 static int bf_ignore(Tcl_Interp *ip, uint32_t *value_io,
  79                      int *ok_io, Tcl_Obj *arg) {
  80   return TCL_OK;
  81 }
  82
  83 static int bf_fixed_read(Tcl_Interp *ip, uint32_t *value_io,
  84                          int *ok_io, Tcl_Obj *arg) {
  85   uint32_t ul;
  86   int rc;
  87
  88   rc= pat_ulong(ip, arg, &ul);  if (rc) return rc;
  89   if (*value_io != ul) *ok_io= 0;
  90   return TCL_OK;
  91 }
  92
  93 static int bf_ulong_write(Tcl_Interp *ip, uint32_t *value_io,
  94                           int *ok_io, Tcl_Obj *arg) {
  95   uint32_t ul;
  96   int rc;
  97
  98   rc= pat_ulong(ip, arg, &ul);  if (rc) return rc;
  99   *value_io= ul;
 100   return TCL_OK;
 101 }
 102
 103 static int bf_var_read(Tcl_Interp *ip, Tcl_Obj *varname, Tcl_Obj *val) {
 104   Tcl_Obj *rp;
 105   rp= Tcl_ObjSetVar2(ip,varname,0,val,TCL_LEAVE_ERR_MSG);
 106   if (!rp) return TCL_ERROR;
 107   return TCL_OK;
 108 }
 109
 110 static int bf_ulong_read(Tcl_Interp *ip, uint32_t *value_io,
 111                          int *ok_io, Tcl_Obj *arg) {
 112   return bf_var_read(ip,arg, ret_ulong(ip,*value_io));
 113 }
 114
 115 static int bf_uint_write(Tcl_Interp *ip, uint32_t *value_io,
 116                          int *ok_io, Tcl_Obj *arg) {
 117   int rc, v;
 118   rc= pat_int(ip, arg, &v);  if (rc) return rc;
 119   if (v<0) return staticerr(ip,"value for bitfield is -ve");
 120   *value_io= v;
 121   return TCL_OK;
 122 }
 123
 124 static int bf_uint_read(Tcl_Interp *ip, uint32_t *value_io,
 125                         int *ok_io, Tcl_Obj *arg) {
 126   if (*value_io > INT_MAX)
 127     return staticerr(ip,"value from bitfield exceeds INT_MAX");
 128   return bf_var_read(ip,arg, ret_int(ip,*value_io));
 129 }
 130
 131 #define BFT(t,a) { #t, a, { bf_read_##t, bf_write_##t } }
 132 static const BitFieldType bitfieldtypes[]= {
 133   { "zero",   0, { bf_zero_read,  bf_zero_write  } },
 134   { "ignore", 0, { bf_ignore,     bf_ignore      } },
 135   { "fixed",  1, { bf_fixed_read, bf_ulong_write } },
 136   { "ulong",  1, { bf_ulong_read, bf_ulong_write } },
 137   { "uint",   1, { bf_uint_read,  bf_uint_write  } },
 138   { 0 }
 139 };
 140
 141 static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
 142                         uint32_t *value_io,
 143                         int objc, Tcl_Obj *const *objv) {
 144   const BitFieldType *ftype;
 145   Tcl_Obj *arg;
 146   int sz, pos, rc;
 147   uint32_t value, sz_mask, this_mask, this_field;
 148
 149   pos= 32;
 150   value= *value_io;
 151   *ok_r= 1;
 152
 153   while (--objc) {
 154     rc= Tcl_GetIntFromObj(ip,*++objv,&sz);  if (rc) return rc;
 155     if (!--objc) return staticerr(ip,"wrong # args: missing bitfield type");
 156
 157     if (sz<0) return staticerr(ip,"bitfield size is -ve");
 158     if (sz>pos) return staticerr(ip,"total size of bitfields >32");
 159
 160     pos -= sz;
 161
 162     sz_mask= ~(~0UL << sz);
 163     this_mask= (sz_mask << pos);
 164     this_field= (value & this_mask) >> pos;
 165
 166     ftype= enum_lookup_cached(ip,*++objv,bitfieldtypes,"bitfield type");
 167     if (!ftype) return TCL_ERROR;
 168
 169     if (ftype->want_arg) {
 170       if (!--objc)
 171         return staticerr(ip,"wrong # args: missing arg for bitfield");
 172       arg= *++objv;
 173     } else {
 174       arg= 0;
 175     }
 176     rc= ftype->reader_writer[writing](ip, &this_field, ok_r, arg);
 177     if (rc) return rc;
 178
 179     if (!*ok_r) return TCL_OK;
 180
 181     if (this_field & ~sz_mask)
 182       return staticerr(ip,"bitfield value has more bits than bitfield");
 183
 184     value &= ~this_mask;
 185     value |= (this_field << pos);
 186   }
 187
 188   if (pos != 0)
 189     return staticerr(ip,"bitfield sizes add up to <32");
 190
 191   *value_io= value;
 192   return TCL_OK;
 193 }
 194
 195 int do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
 196                           uint32_t base,
 197                           int objc, Tcl_Obj *const *objv,
 198                           uint32_t *result) {
 199   int ok, rc;
 200
 201   *result= base;
 202   rc= do_bitfields(ip,1,&ok,result,objc,objv);
 203   assert(ok);
 204   return rc;
 205 }
 206
 207 int do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
 208                           uint32_t value,
 209                           int objc, Tcl_Obj *const *objv,
 210                           int *result) {
 211   return do_bitfields(ip,0,result,&value,objc,objv);
 212 }
 213
 214 /* Arg parsing */
 215
 216 int pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, uint32_t *val) {
 217   int rc;
 218
 219   rc= Tcl_ConvertToType(ip,o,&ulong_type);
 220   if (rc) return rc;
 221   *val= *(const uint32_t*)&o->internalRep.longValue;
 222   return TCL_OK;
 223 }
 224
 225 Tcl_Obj *ret_ulong(Tcl_Interp *ip, uint32_t val) {
 226   Tcl_Obj *o;
 227
 228   o= Tcl_NewObj();
 229   Tcl_InvalidateStringRep(o);
 230   *(uint32_t*)&o->internalRep.longValue= val;
 231   o->typePtr= &ulong_type;
 232   return o;
 233 }
 234
 235 /* Tcl ulong type */
 236
 237 static void ulong_t_free(Tcl_Obj *o) { }
 238
 239 static void ulong_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
 240   dup->internalRep= src->internalRep;
 241   dup->typePtr= &ulong_type;
 242 }
 243
 244 static void ulong_t_ustr(Tcl_Obj *o) {
 245   uint32_t val;
 246   char buf[11];
 247
 248   val= *(const uint32_t*)&o->internalRep.longValue;
 249
 250   assert(val <= 0xffffffffUL);
 251   snprintf(buf,sizeof(buf), "%08lx", (unsigned long)val);
 252
 253   obj_updatestr_vstringls(o, buf, sizeof(buf)-1, (char*)0);
 254 }
 255
 256 static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
 257   char *str, *ep;
 258   uint32_t ul;
 259
 260   if (o->typePtr == &hbytes_type) {
 261     int l;
 262
 263     l= hbytes_len(OBJ_HBYTES(o));
 264     if (l > 4) return staticerr(ip, "hbytes as ulong must be of length < 4");
 265     ul= 0;
 266     memcpy((Byte*)&ul + 4 - l, hbytes_data(OBJ_HBYTES(o)), l);
 267     ul= htonl(ul);
 268
 269   } else {
 270
 271     str= Tcl_GetString(o);
 272     errno=0;
 273     if (str[0]=='0' && str[1]=='b' && str[2]) {
 274       ul= strtoul(str+2,&ep,2);
 275     } else if (str[0]=='0' && str[1]=='d' && str[2]) {
 276       ul= strtoul(str+2,&ep,10);
 277     } else {
 278       ul= strtoul(str,&ep,16);
 279     }
 280     if (*ep || errno) return staticerr(ip, "bad unsigned long value");
 281
 282   }
 283
 284   objfreeir(o);
 285   *(uint32_t*)&o->internalRep.longValue= ul;
 286   o->typePtr= &ulong_type;
 287   return TCL_OK;
 288 }
 289
 290 Tcl_ObjType ulong_type = {
 291   "ulong-nearly",
 292   ulong_t_free, ulong_t_dup, ulong_t_ustr, ulong_t_sfa
 293 };