chiark / gitweb /
working on compiling out of troglodyte; before relegage maskmap
[chiark-tcl.git] / hbytes / ulongs.c
index 4652fd6..0f99db3 100644 (file)
@@ -1,38 +1,37 @@
 /*
  */
 
-#include "hbytes.h"
-#include "tables.h"
+#include "chiark_tcl_hbytes.h"
 
 /* nice simple functions */
 
-int do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v,
+int cht_do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v,
                    uint32_t *result) {
-  if (v<0) return
-    staticerr(ip,"cannot convert -ve integer to ulong","ULONG VALUE NEGATIVE");
+  if (v<0) return cht_staticerr(ip,"cannot convert"
+      " -ve integer to ulong","ULONG VALUE NEGATIVE");
   *result= v;
   return TCL_OK;
 }
   
-int do_ulong_add(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_add(ClientData cd, Tcl_Interp *ip,
                 uint32_t a, uint32_t b, uint32_t *result) {
   *result= a + b;
   return TCL_OK;
 }
   
-int do_ulong_multiply(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_multiply(ClientData cd, Tcl_Interp *ip,
                      uint32_t a, uint32_t b, uint32_t *result) {
   *result= a * b;
   return TCL_OK;
 }
   
-int do_ulong_subtract(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_subtract(ClientData cd, Tcl_Interp *ip,
                      uint32_t a, uint32_t b, uint32_t *result) {
   *result= a - b;
   return TCL_OK;
 }
   
-int do_ulong_compare(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_compare(ClientData cd, Tcl_Interp *ip,
                     uint32_t a, uint32_t b, int *result) {
   *result=
     a == b ? 0 :
@@ -40,25 +39,26 @@ int do_ulong_compare(ClientData cd, Tcl_Interp *ip,
   return TCL_OK;
 }
 
-int do_ulong_ul2int(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_ul2int(ClientData cd, Tcl_Interp *ip,
                    uint32_t v, int *result) {
   if (v>INT_MAX) return
-    staticerr(ip,"ulong too large to fit in an int", "ULONG VALUE OVERFLOW");
+                  cht_staticerr(ip,"ulong too large"
+                                " to fit in an int", "ULONG VALUE OVERFLOW");
   *result= v;
   return TCL_OK;
 }
 
-int do_ulong_mask(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_mask(ClientData cd, Tcl_Interp *ip,
                  uint32_t a, uint32_t b, uint32_t *result) {
   *result= a & b;
   return TCL_OK;
 }
   
-int do_ulong_shift(ClientData cd, Tcl_Interp *ip, int right,
+int cht_do_ulong_shift(ClientData cd, Tcl_Interp *ip, int right,
                   uint32_t v, int bits, uint32_t *result) {
   if (bits < 0) { bits= -bits; right= !right; }
-  if (bits > 32) return
-    staticerr(ip,"shift out of range (32) bits", "ULONG BITCOUNT OVERRUN");
+  if (bits > 32) return cht_staticerr(ip,"shift out of range (32) bits",
+                                     "ULONG BITCOUNT OVERRUN");
   *result= (bits==32 ? 0 :
            right ? v >> bits : v << bits);
   return TCL_OK;
@@ -95,7 +95,7 @@ static int bf_fixed_read(Tcl_Interp *ip, uint32_t *value_io,
   uint32_t ul;
   int rc;
   
-  rc= pat_ulong(ip, arg, &ul);  if (rc) return rc;
+  rc= cht_pat_ulong(ip, arg, &ul);  if (rc) return rc;
   if (*value_io != ul) *ok_io= 0;
   return TCL_OK;
 }
@@ -105,7 +105,7 @@ static int bf_ulong_write(Tcl_Interp *ip, uint32_t *value_io,
   uint32_t ul;
   int rc;
   
-  rc= pat_ulong(ip, arg, &ul);  if (rc) return rc;
+  rc= cht_pat_ulong(ip, arg, &ul);  if (rc) return rc;
   *value_io= ul;
   return TCL_OK;
 }
@@ -119,24 +119,25 @@ static int bf_var_read(Tcl_Interp *ip, Tcl_Obj *varname, Tcl_Obj *val) {
 
 static int bf_ulong_read(Tcl_Interp *ip, uint32_t *value_io,
                         int *ok_io, Tcl_Obj *arg) {
-  return bf_var_read(ip,arg, ret_ulong(ip,*value_io));
+  return bf_var_read(ip,arg, cht_ret_ulong(ip,*value_io));
 }
 
 static int bf_uint_write(Tcl_Interp *ip, uint32_t *value_io,
                         int *ok_io, Tcl_Obj *arg) {
   int rc, v;
-  rc= pat_int(ip, arg, &v);  if (rc) return rc;
-  if (v<0) return
-    staticerr(ip,"value for bitfield is -ve", "ULONG VALUE NEGATIVE");
+  rc= cht_pat_int(ip, arg, &v);  if (rc) return rc;
+  if (v<0) return cht_staticerr(ip,"value for bitfield is -ve",
+                               "ULONG VALUE NEGATIVE");
   *value_io= v;
   return TCL_OK;
 }
 
 static int bf_uint_read(Tcl_Interp *ip, uint32_t *value_io,
                        int *ok_io, Tcl_Obj *arg) {
-  if (*value_io > INT_MAX) return
-    staticerr(ip,"value from bitfield exceeds INT_MAX","ULONG VALUE OVERFLOW");
-  return bf_var_read(ip,arg, ret_int(ip,*value_io));
+  if (*value_io > INT_MAX)
+    return cht_staticerr(ip,"value from bitfield"
+                        " exceeds INT_MAX","ULONG VALUE OVERFLOW");
+  return bf_var_read(ip,arg, cht_ret_int(ip,*value_io));
 }
 
 #define BFT(t,a) { #t, a, { bf_read_##t, bf_write_##t } }
@@ -163,12 +164,15 @@ static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
 
   while (--objc) {
     rc= Tcl_GetIntFromObj(ip,*++objv,&sz);  if (rc) return rc;
-    if (!--objc) return staticerr(ip,"wrong # args: missing bitfield type",0);
+    if (!--objc)
+      return cht_staticerr(ip,"wrong # args: missing bitfield type",0);
 
     if (sz<0)
-      return staticerr(ip,"bitfield size is -ve", "ULONG BITCOUNT NEGATIVE");
-    if (sz>pos) return
-      staticerr(ip,"total size of bitfields >32", "ULONG BITCOUNT OVERRUN");
+      return cht_staticerr(ip,"bitfield size is -ve",
+                          "ULONG BITCOUNT NEGATIVE");
+    if (sz>pos)
+      return cht_staticerr(ip,"total size of bitfields >32",
+                          "ULONG BITCOUNT OVERRUN");
 
     pos -= sz;
 
@@ -181,7 +185,7 @@ static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
 
     if (ftype->want_arg) {
       if (!--objc)
-       return staticerr(ip,"wrong # args: missing arg for bitfield",0);
+       return cht_staticerr(ip,"wrong # args: missing arg for bitfield",0);
       arg= *++objv;
     } else {
       arg= 0;
@@ -192,7 +196,7 @@ static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
     if (!*ok_r) return TCL_OK;
 
     if (this_field & ~sz_mask)
-      return staticerr(ip,"bitfield value has more bits than bitfield",
+      return cht_staticerr(ip,"bitfield value has more bits than bitfield",
                       "ULONG VALUE OVERFLOW");
     
     value &= ~this_mask;
@@ -200,13 +204,13 @@ static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
   }
 
   if (pos != 0) return
-    staticerr(ip,"bitfield sizes add up to <32","ULONG BITCOUNT UNDERRUN");
+    cht_staticerr(ip,"bitfield sizes add up to <32","ULONG BITCOUNT UNDERRUN");
 
   *value_io= value;
   return TCL_OK;
 }
 
-int do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
                          uint32_t base,
                          int objc, Tcl_Obj *const *objv,
                          uint32_t *result) {
@@ -218,7 +222,7 @@ int do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
   return rc;
 }
 
-int do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
                          uint32_t value,
                          int objc, Tcl_Obj *const *objv,
                          int *result) {
@@ -227,22 +231,22 @@ int do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
 
 /* Arg parsing */
 
-int pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, uint32_t *val) {
+int cht_pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, uint32_t *val) {
   int rc;
   
-  rc= Tcl_ConvertToType(ip,o,&ulong_type);
+  rc= Tcl_ConvertToType(ip,o,&cht_ulong_type);
   if (rc) return rc;
   *val= *(const uint32_t*)&o->internalRep.longValue;
   return TCL_OK;
 }
 
-Tcl_Obj *ret_ulong(Tcl_Interp *ip, uint32_t val) {
+Tcl_Obj *cht_ret_ulong(Tcl_Interp *ip, uint32_t val) {
   Tcl_Obj *o;
 
   o= Tcl_NewObj();
   Tcl_InvalidateStringRep(o);
   *(uint32_t*)&o->internalRep.longValue= val;
-  o->typePtr= &ulong_type;
+  o->typePtr= &cht_ulong_type;
   return o;
 }
 
@@ -252,7 +256,7 @@ static void ulong_t_free(Tcl_Obj *o) { }
 
 static void ulong_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
   dup->internalRep= src->internalRep;
-  dup->typePtr= &ulong_type;
+  dup->typePtr= &cht_ulong_type;
 }
 
 static void ulong_t_ustr(Tcl_Obj *o) {
@@ -264,21 +268,21 @@ static void ulong_t_ustr(Tcl_Obj *o) {
   assert(val <= 0xffffffffUL);
   snprintf(buf,sizeof(buf), "%08lx", (unsigned long)val);
 
-  obj_updatestr_vstringls(o, buf, sizeof(buf)-1, (char*)0);
+  cht_obj_updatestr_vstringls(o, buf, sizeof(buf)-1, (char*)0);
 }
 
 static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   char *str, *ep;
   uint32_t ul;
 
-  if (o->typePtr == &hbytes_type) {
+  if (o->typePtr == &cht_hbytes_type) {
     int l;
 
-    l= hbytes_len(OBJ_HBYTES(o));
-    if (l > 4) return
-      staticerr(ip,"hbytes as ulong with length >4","HBYTES LENGTH OVERRUN");
+    l= cht_hb_len(OBJ_HBYTES(o));
+    if (l > 4) return cht_staticerr(ip,"hbytes as ulong with length >4",
+                                   "HBYTES LENGTH OVERRUN");
     ul= 0;
-    memcpy((Byte*)&ul + 4 - l, hbytes_data(OBJ_HBYTES(o)), l);
+    memcpy((Byte*)&ul + 4 - l, cht_hb_data(OBJ_HBYTES(o)), l);
     ul= htonl(ul);
 
   } else {
@@ -292,17 +296,17 @@ static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
     } else {
       ul= strtoul(str,&ep,16);
     }
-    if (*ep || errno) return staticerr(ip, "bad unsigned long value", 0);
+    if (*ep || errno) return cht_staticerr(ip, "bad unsigned long value", 0);
 
   }
 
-  objfreeir(o);
+  cht_objfreeir(o);
   *(uint32_t*)&o->internalRep.longValue= ul;
-  o->typePtr= &ulong_type;
+  o->typePtr= &cht_ulong_type;
   return TCL_OK;
 }
 
-Tcl_ObjType ulong_type = {
+Tcl_ObjType cht_ulong_type = {
   "ulong-nearly",
   ulong_t_free, ulong_t_dup, ulong_t_ustr, ulong_t_sfa
 };