/*
*/
-#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_subtract(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 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 :
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;
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;
}
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;
}
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 } }
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;
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;
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;
}
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) {
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) {
/* 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;
}
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) {
uint32_t val;
- char buf[11];
+ char buf[9];
val= *(const uint32_t*)&o->internalRep.longValue;
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 {
} 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
};
~ian / chiark-tcl.git / blobdiff