chiark
/
gitweb
/
~ian
/
chiark-tcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
better core algorithm selection and new core alg suites
[chiark-tcl.git]
/
hbytes
/
ulongs.c
diff --git
a/hbytes/ulongs.c
b/hbytes/ulongs.c
index e352ba1e9691dbb0dc1d32d252e5ba3a26796af5..4652fd695c2816029fe8cd3f391a89aca76d22dd 100644
(file)
--- a/
hbytes/ulongs.c
+++ b/
hbytes/ulongs.c
@@
-8,7
+8,8
@@
int do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v,
uint32_t *result) {
int 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");
+ if (v<0) return
+ staticerr(ip,"cannot convert -ve integer to ulong","ULONG VALUE NEGATIVE");
*result= v;
return TCL_OK;
}
*result= v;
return TCL_OK;
}
@@
-19,6
+20,12
@@
int do_ulong_add(ClientData cd, Tcl_Interp *ip,
return TCL_OK;
}
return TCL_OK;
}
+int 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,
uint32_t a, uint32_t b, uint32_t *result) {
*result= a - b;
int do_ulong_subtract(ClientData cd, Tcl_Interp *ip,
uint32_t a, uint32_t b, uint32_t *result) {
*result= a - b;
@@
-35,7
+42,8
@@
int do_ulong_compare(ClientData cd, Tcl_Interp *ip,
int do_ulong_ul2int(ClientData cd, Tcl_Interp *ip,
uint32_t v, int *result) {
int 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");
+ if (v>INT_MAX) return
+ staticerr(ip,"ulong too large to fit in an int", "ULONG VALUE OVERFLOW");
*result= v;
return TCL_OK;
}
*result= v;
return TCL_OK;
}
@@
-48,7
+56,9
@@
int do_ulong_mask(ClientData cd, Tcl_Interp *ip,
int do_ulong_shift(ClientData cd, Tcl_Interp *ip, int right,
uint32_t v, int bits, uint32_t *result) {
int do_ulong_shift(ClientData cd, Tcl_Interp *ip, int right,
uint32_t v, int bits, uint32_t *result) {
- if (bits > 32) return staticerr(ip,"shift out of range (32) bits");
+ if (bits < 0) { bits= -bits; right= !right; }
+ if (bits > 32) return
+ staticerr(ip,"shift out of range (32) bits", "ULONG BITCOUNT OVERRUN");
*result= (bits==32 ? 0 :
right ? v >> bits : v << bits);
return TCL_OK;
*result= (bits==32 ? 0 :
right ? v >> bits : v << bits);
return TCL_OK;
@@
-116,15
+126,16
@@
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;
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");
+ if (v<0) return
+ 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) {
*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
");
+ 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));
}
return bf_var_read(ip,arg, ret_int(ip,*value_io));
}
@@
-152,10
+163,12
@@
static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
while (--objc) {
rc= Tcl_GetIntFromObj(ip,*++objv,&sz); if (rc) return rc;
while (--objc) {
rc= Tcl_GetIntFromObj(ip,*++objv,&sz); if (rc) return rc;
- if (!--objc) return staticerr(ip,"wrong # args: missing bitfield type");
+ if (!--objc) return staticerr(ip,"wrong # args: missing bitfield type"
,0
);
- if (sz<0) return staticerr(ip,"bitfield size is -ve");
- if (sz>pos) return staticerr(ip,"total size of bitfields >32");
+ 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");
pos -= sz;
pos -= sz;
@@
-168,7
+181,7
@@
static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
if (ftype->want_arg) {
if (!--objc)
if (ftype->want_arg) {
if (!--objc)
- return staticerr(ip,"wrong # args: missing arg for bitfield");
+ return staticerr(ip,"wrong # args: missing arg for bitfield"
,0
);
arg= *++objv;
} else {
arg= 0;
arg= *++objv;
} else {
arg= 0;
@@
-179,14
+192,15
@@
static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
if (!*ok_r) return TCL_OK;
if (this_field & ~sz_mask)
if (!*ok_r) return TCL_OK;
if (this_field & ~sz_mask)
- return staticerr(ip,"bitfield value has more bits than bitfield");
+ return staticerr(ip,"bitfield value has more bits than bitfield",
+ "ULONG VALUE OVERFLOW");
value &= ~this_mask;
value |= (this_field << pos);
}
value &= ~this_mask;
value |= (this_field << pos);
}
- if (pos != 0)
-
return staticerr(ip,"bitfield sizes add up to <32
");
+ if (pos != 0)
return
+
staticerr(ip,"bitfield sizes add up to <32","ULONG BITCOUNT UNDERRUN
");
*value_io= value;
return TCL_OK;
*value_io= value;
return TCL_OK;
@@
-243,7
+257,7
@@
static void ulong_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
static void ulong_t_ustr(Tcl_Obj *o) {
uint32_t val;
static void ulong_t_ustr(Tcl_Obj *o) {
uint32_t val;
- char buf[
11
];
+ char buf[
9
];
val= *(const uint32_t*)&o->internalRep.longValue;
val= *(const uint32_t*)&o->internalRep.longValue;
@@
-261,7
+275,8
@@
static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
int l;
l= hbytes_len(OBJ_HBYTES(o));
int l;
l= hbytes_len(OBJ_HBYTES(o));
- if (l > 4) return staticerr(ip, "hbytes as ulong must be of length < 4");
+ if (l > 4) return
+ staticerr(ip,"hbytes as ulong with length >4","HBYTES LENGTH OVERRUN");
ul= 0;
memcpy((Byte*)&ul + 4 - l, hbytes_data(OBJ_HBYTES(o)), l);
ul= htonl(ul);
ul= 0;
memcpy((Byte*)&ul + 4 - l, hbytes_data(OBJ_HBYTES(o)), l);
ul= htonl(ul);
@@
-277,7
+292,7
@@
static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
} else {
ul= strtoul(str,&ep,16);
}
} else {
ul= strtoul(str,&ep,16);
}
- if (*ep || errno) return staticerr(ip, "bad unsigned long value");
+ if (*ep || errno) return staticerr(ip, "bad unsigned long value"
, 0
);
}
}