From 743de63e7b3214a5abc748ec0fa90160b6983551 Mon Sep 17 00:00:00 2001 From: ian Date: Thu, 19 Sep 2002 17:27:12 +0000 Subject: [PATCH] ulong improved; clock arithmetic hbytes abolished; secnet responder implemented and debugged ish --- base/chiark-tcl.h | 45 +++++----- base/hook.c | 74 ++++++++++++---- base/parse.c | 8 ++ base/tables-examples.tct | 39 +++++---- hbytes/hbytes.h | 45 +++++----- hbytes/hook.c | 74 ++++++++++++---- hbytes/parse.c | 8 ++ hbytes/ulongs.c | 177 ++++++++++++++++----------------------- 8 files changed, 261 insertions(+), 209 deletions(-) diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h index c9975f2..0f38890 100644 --- a/base/chiark-tcl.h +++ b/base/chiark-tcl.h @@ -18,30 +18,8 @@ * hbytes trimleft VAR removes any leading 0 octets * hbytes repeat VALUE COUNT => COUNT copies of VALUE * - * hbytes clockincrement VAR INTEGER adds INTEGER to VAR mod 256^|VAR| - * INTEGER must be -255 .. 255 - * => carry (-255 to 255, - * and -1,0,1 if VAR not empty) - * - * hbytes h2ulong HEX => ulong (HEX len must be 4) - * hbytes ulong2h UL => hex - * - * ulong ul2bitfields VALUE [SIZE TYPE [TYPE-ARG...] ...] => 0/1 - * ulong bitfields2ul BASE [SIZE TYPE [TYPE-ARG...] ...] => ULONG - * goes from left (MSbit) to right (LSbit) where - * SIZE is size in bits - * TYPE [TYPE-ARGS...] is as below - * zero - * ignore - * fixed ULONG-VALUE - * uint VARNAME/VALUE (VARNAME if ul2bitfields; - * ulong VARNAME/VALUE VALUE if bitfields2ul) - * - * ulong ul2int ULONG => INT can fail if >INT_MAX - * ulong int2ul INT => ULONG can fail if <0 - * - * hbytes shift l|r ULONG BITS fails if BITS >32 - * hbytes mask A B => A & B + * hbytes ushort2h LONG => LONG must be <2^16, returns as hex + * hbytes h2ushort HEX => |HEX| must be 2 bytes, returns as ulong * * hbytes compare A B * => -2 A is lexically earlier than B and not a prefix of B (A hash * hbytes hmac ALG MESSAGE KEY [MACLENGTH] => mac * + * ulong ul2int ULONG => INT can fail if >INT_MAX + * ulong int2ul INT => ULONG can fail if <0 + * ulong mask A B => A & B + * ulong add A B => A + B (mod 2^32) + * ulong subtract A B => A - B (mod 2^32) + * ulong compare A B => 0/-1/1 + * ulong shift l|r ULONG BITS fails if BITS >32 + * + * ulong ul2bitfields VALUE [SIZE TYPE [TYPE-ARG...] ...] => 0/1 + * ulong bitfields2ul BASE [SIZE TYPE [TYPE-ARG...] ...] => ULONG + * goes from left (MSbit) to right (LSbit) where + * SIZE is size in bits + * TYPE [TYPE-ARGS...] is as below + * zero + * ignore + * fixed ULONG-VALUE + * uint VARNAME/VALUE (VARNAME if ul2bitfields; + * ulong VARNAME/VALUE VALUE if bitfields2ul) + * * Refs: HMAC: RFC2104 */ diff --git a/base/hook.c b/base/hook.c index cdcb246..61593ab 100644 --- a/base/hook.c +++ b/base/hook.c @@ -134,25 +134,35 @@ static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) { int l; char cbuf[3]; - os= str= Tcl_GetStringFromObj(o,&l); assert(str); - objfreeir(o); + if (o->typePtr == &ulong_type) { + uint32_t ul; - if (l & 1) return staticerr(ip, "hbytes: conversion from hex:" - " odd length in hex"); + ul= htonl(*(const uint32_t*)&o->internalRep.longValue); + hbytes_array(OBJ_HBYTES(o), (const Byte*)&ul, 4); - startbytes= bytes= hbytes_arrayspace(OBJ_HBYTES(o), l/2); - - cbuf[2]= 0; - while (l>0) { - cbuf[0]= *str++; - cbuf[1]= *str++; - *bytes++= strtoul(cbuf,&ep,16); - if (ep != cbuf+2) { - hbytes_free(OBJ_HBYTES(o)); - return staticerr(ip, "hbytes: conversion from hex:" - " bad hex digit"); + } else { + + os= str= Tcl_GetStringFromObj(o,&l); assert(str); + objfreeir(o); + + if (l & 1) return staticerr(ip, "hbytes: conversion from hex:" + " odd length in hex"); + + startbytes= bytes= hbytes_arrayspace(OBJ_HBYTES(o), l/2); + + cbuf[2]= 0; + while (l>0) { + cbuf[0]= *str++; + cbuf[1]= *str++; + *bytes++= strtoul(cbuf,&ep,16); + if (ep != cbuf+2) { + hbytes_free(OBJ_HBYTES(o)); + return staticerr(ip, "hbytes: conversion from hex:" + " bad hex digit"); + } + l -= 2; } - l -= 2; + } o->typePtr = &hbytes_type; @@ -283,7 +293,37 @@ int do_hbytes_range(ClientData cd, Tcl_Interp *ip, hbytes_array(result, data+start, size); return TCL_OK; } - + +/* hbytes representing uint16_t's */ + +int do_hbytes_h2ushort(ClientData cd, Tcl_Interp *ip, + HBytes_Value hex, long *result) { + const Byte *data; + int l; + + l= hbytes_len(&hex); + if (l>2) + return staticerr(ip, "hbytes h2ushort input more than 4 hex digits"); + + data= hbytes_data(&hex); + *result= data[l-1] | (l>1 ? data[0]<<8 : 0); + return TCL_OK; +} + +int do_hbytes_ushort2h(ClientData cd, Tcl_Interp *ip, + long input, HBytes_Value *result) { + uint16_t us; + + if (input > 0x0ffff) + return staticerr(ip, "hbytes ushort2h input >2^16"); + + us= htons(input); + hbytes_array(result,(const Byte*)&us,2); + return TCL_OK; +} + +/* toplevel functions */ + int do_toplevel_hbytes(ClientData cd, Tcl_Interp *ip, const HBytes_SubCommand *subcmd, int objc, Tcl_Obj *const *objv) { diff --git a/base/parse.c b/base/parse.c index c203be1..5e1f918 100644 --- a/base/parse.c +++ b/base/parse.c @@ -26,6 +26,10 @@ int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) { return Tcl_GetIntFromObj(ip, obj, val); } +int pat_long(Tcl_Interp *ip, Tcl_Obj *obj, long *val) { + return Tcl_GetLongFromObj(ip, obj, val); +} + int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) { int rc; Tcl_Obj *val; @@ -81,6 +85,10 @@ Tcl_Obj *ret_int(Tcl_Interp *ip, int val) { return Tcl_NewIntObj(val); } +Tcl_Obj *ret_long(Tcl_Interp *ip, long val) { + return Tcl_NewLongObj(val); +} + Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) { return val; } diff --git a/base/tables-examples.tct b/base/tables-examples.tct index 9a19c5a..3fd0801 100644 --- a/base/tables-examples.tct +++ b/base/tables-examples.tct @@ -9,7 +9,8 @@ Type sockaddr: SockAddr_Value @ Init sockaddr sockaddr_clear(&@); Type sockid: DgramSockID @ -Type ulong: unsigned long @ +Type ulong: uint32_t @ +Type long: long @ H-Include "hbytes.h" @@ -25,24 +26,32 @@ Table toplevel TopLevel_Command ... obj Table ulong ULong_SubCommand - shift - right charfrom("lr", "shift direction") + ul2int v ulong - bits int + => int + int2ul + v int => ulong mask a ulong b ulong => ulong + add + a ulong + b ulong + => ulong + subtract + a ulong + b ulong + => ulong compare a ulong b ulong => int - ul2int + shift + right charfrom("lr", "shift direction") v ulong - => int - int2ul - v int + bits int => ulong ul2bitfields value ulong @@ -60,18 +69,12 @@ Table hbytes HBytes_SubCommand h2raw hex hb => obj - ulong2h - value ulong - => hb - h2ulong - hex hb - => ulong ushort2h - value ulong + value long => hb h2ushort hex hb - => ulong + => long length v hb => int @@ -121,10 +124,6 @@ Table hbytes HBytes_SubCommand v hb count int => hb - clockincrement - value hbv - change int - => int random length int => hb diff --git a/hbytes/hbytes.h b/hbytes/hbytes.h index c9975f2..0f38890 100644 --- a/hbytes/hbytes.h +++ b/hbytes/hbytes.h @@ -18,30 +18,8 @@ * hbytes trimleft VAR removes any leading 0 octets * hbytes repeat VALUE COUNT => COUNT copies of VALUE * - * hbytes clockincrement VAR INTEGER adds INTEGER to VAR mod 256^|VAR| - * INTEGER must be -255 .. 255 - * => carry (-255 to 255, - * and -1,0,1 if VAR not empty) - * - * hbytes h2ulong HEX => ulong (HEX len must be 4) - * hbytes ulong2h UL => hex - * - * ulong ul2bitfields VALUE [SIZE TYPE [TYPE-ARG...] ...] => 0/1 - * ulong bitfields2ul BASE [SIZE TYPE [TYPE-ARG...] ...] => ULONG - * goes from left (MSbit) to right (LSbit) where - * SIZE is size in bits - * TYPE [TYPE-ARGS...] is as below - * zero - * ignore - * fixed ULONG-VALUE - * uint VARNAME/VALUE (VARNAME if ul2bitfields; - * ulong VARNAME/VALUE VALUE if bitfields2ul) - * - * ulong ul2int ULONG => INT can fail if >INT_MAX - * ulong int2ul INT => ULONG can fail if <0 - * - * hbytes shift l|r ULONG BITS fails if BITS >32 - * hbytes mask A B => A & B + * hbytes ushort2h LONG => LONG must be <2^16, returns as hex + * hbytes h2ushort HEX => |HEX| must be 2 bytes, returns as ulong * * hbytes compare A B * => -2 A is lexically earlier than B and not a prefix of B (A hash * hbytes hmac ALG MESSAGE KEY [MACLENGTH] => mac * + * ulong ul2int ULONG => INT can fail if >INT_MAX + * ulong int2ul INT => ULONG can fail if <0 + * ulong mask A B => A & B + * ulong add A B => A + B (mod 2^32) + * ulong subtract A B => A - B (mod 2^32) + * ulong compare A B => 0/-1/1 + * ulong shift l|r ULONG BITS fails if BITS >32 + * + * ulong ul2bitfields VALUE [SIZE TYPE [TYPE-ARG...] ...] => 0/1 + * ulong bitfields2ul BASE [SIZE TYPE [TYPE-ARG...] ...] => ULONG + * goes from left (MSbit) to right (LSbit) where + * SIZE is size in bits + * TYPE [TYPE-ARGS...] is as below + * zero + * ignore + * fixed ULONG-VALUE + * uint VARNAME/VALUE (VARNAME if ul2bitfields; + * ulong VARNAME/VALUE VALUE if bitfields2ul) + * * Refs: HMAC: RFC2104 */ diff --git a/hbytes/hook.c b/hbytes/hook.c index cdcb246..61593ab 100644 --- a/hbytes/hook.c +++ b/hbytes/hook.c @@ -134,25 +134,35 @@ static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) { int l; char cbuf[3]; - os= str= Tcl_GetStringFromObj(o,&l); assert(str); - objfreeir(o); + if (o->typePtr == &ulong_type) { + uint32_t ul; - if (l & 1) return staticerr(ip, "hbytes: conversion from hex:" - " odd length in hex"); + ul= htonl(*(const uint32_t*)&o->internalRep.longValue); + hbytes_array(OBJ_HBYTES(o), (const Byte*)&ul, 4); - startbytes= bytes= hbytes_arrayspace(OBJ_HBYTES(o), l/2); - - cbuf[2]= 0; - while (l>0) { - cbuf[0]= *str++; - cbuf[1]= *str++; - *bytes++= strtoul(cbuf,&ep,16); - if (ep != cbuf+2) { - hbytes_free(OBJ_HBYTES(o)); - return staticerr(ip, "hbytes: conversion from hex:" - " bad hex digit"); + } else { + + os= str= Tcl_GetStringFromObj(o,&l); assert(str); + objfreeir(o); + + if (l & 1) return staticerr(ip, "hbytes: conversion from hex:" + " odd length in hex"); + + startbytes= bytes= hbytes_arrayspace(OBJ_HBYTES(o), l/2); + + cbuf[2]= 0; + while (l>0) { + cbuf[0]= *str++; + cbuf[1]= *str++; + *bytes++= strtoul(cbuf,&ep,16); + if (ep != cbuf+2) { + hbytes_free(OBJ_HBYTES(o)); + return staticerr(ip, "hbytes: conversion from hex:" + " bad hex digit"); + } + l -= 2; } - l -= 2; + } o->typePtr = &hbytes_type; @@ -283,7 +293,37 @@ int do_hbytes_range(ClientData cd, Tcl_Interp *ip, hbytes_array(result, data+start, size); return TCL_OK; } - + +/* hbytes representing uint16_t's */ + +int do_hbytes_h2ushort(ClientData cd, Tcl_Interp *ip, + HBytes_Value hex, long *result) { + const Byte *data; + int l; + + l= hbytes_len(&hex); + if (l>2) + return staticerr(ip, "hbytes h2ushort input more than 4 hex digits"); + + data= hbytes_data(&hex); + *result= data[l-1] | (l>1 ? data[0]<<8 : 0); + return TCL_OK; +} + +int do_hbytes_ushort2h(ClientData cd, Tcl_Interp *ip, + long input, HBytes_Value *result) { + uint16_t us; + + if (input > 0x0ffff) + return staticerr(ip, "hbytes ushort2h input >2^16"); + + us= htons(input); + hbytes_array(result,(const Byte*)&us,2); + return TCL_OK; +} + +/* toplevel functions */ + int do_toplevel_hbytes(ClientData cd, Tcl_Interp *ip, const HBytes_SubCommand *subcmd, int objc, Tcl_Obj *const *objv) { diff --git a/hbytes/parse.c b/hbytes/parse.c index c203be1..5e1f918 100644 --- a/hbytes/parse.c +++ b/hbytes/parse.c @@ -26,6 +26,10 @@ int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) { return Tcl_GetIntFromObj(ip, obj, val); } +int pat_long(Tcl_Interp *ip, Tcl_Obj *obj, long *val) { + return Tcl_GetLongFromObj(ip, obj, val); +} + int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) { int rc; Tcl_Obj *val; @@ -81,6 +85,10 @@ Tcl_Obj *ret_int(Tcl_Interp *ip, int val) { return Tcl_NewIntObj(val); } +Tcl_Obj *ret_long(Tcl_Interp *ip, long val) { + return Tcl_NewLongObj(val); +} + Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) { return val; } diff --git a/hbytes/ulongs.c b/hbytes/ulongs.c index ac87933..e352ba1 100644 --- a/hbytes/ulongs.c +++ b/hbytes/ulongs.c @@ -6,94 +6,83 @@ /* nice simple functions */ -int do_hbytes_clockincrement(ClientData cd, Tcl_Interp *ip, - HBytes_Var value, int change, int *result) { - Byte *data; - int len, bv; - - if (change<-255 || change>255) - return staticerr(ip,"clockincrement change must be in range -255..255"); - - len= hbytes_len(value.hb); - data= hbytes_data(value.hb) + len; - while (len && change) { - bv= *--data; - bv += change; - *data= bv; - if (bv<0) change= -1; - else if (bv>255) change= +1; - else change= 0; - len--; - } - *result= change; - - return TCL_OK; -} - int do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v, - unsigned long *result) { + uint32_t *result) { if (v<0) return staticerr(ip,"cannot convert -ve integer to ulong"); *result= v; return TCL_OK; } +int 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, + uint32_t a, uint32_t b, uint32_t *result) { + *result= a - b; + return TCL_OK; +} + +int do_ulong_compare(ClientData cd, Tcl_Interp *ip, + uint32_t a, uint32_t b, int *result) { + *result= + a == b ? 0 : + a < b ? -1 : 1; + return TCL_OK; +} + int do_ulong_ul2int(ClientData cd, Tcl_Interp *ip, - unsigned long v, int *result) { + uint32_t v, int *result) { if (v>INT_MAX) return staticerr(ip,"ulong too large to fit in an int"); *result= v; return TCL_OK; } int do_ulong_mask(ClientData cd, Tcl_Interp *ip, - unsigned long a, unsigned long b, unsigned long *result) { + 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, - unsigned long v, int bits, unsigned long *result) { + uint32_t v, int bits, uint32_t *result) { if (bits > 32) return staticerr(ip,"shift out of range (32) bits"); *result= (bits==32 ? 0 : right ? v >> bits : v << bits); return TCL_OK; } -int do_ulong_compare(ClientData cd, Tcl_Interp *ip, - unsigned long a, unsigned long b, - int *result) { - *result= (a==b) ? -1 : (a < b) ? -1 : 1; - return TCL_OK; -} - /* bitfields */ typedef struct { const char *name; int want_arg; - int (*reader_writer[2])(Tcl_Interp *ip, unsigned long *value_io, + int (*reader_writer[2])(Tcl_Interp *ip, uint32_t *value_io, int *ok_io, Tcl_Obj *arg); } BitFieldType; -static int bf_zero_read(Tcl_Interp *ip, unsigned long *value_io, +static int bf_zero_read(Tcl_Interp *ip, uint32_t *value_io, int *ok_io, Tcl_Obj *arg) { if (*value_io) *ok_io= 0; return TCL_OK; } -static int bf_zero_write(Tcl_Interp *ip, unsigned long *value_io, +static int bf_zero_write(Tcl_Interp *ip, uint32_t *value_io, int *ok_io, Tcl_Obj *arg) { *value_io= 0; return TCL_OK; } -static int bf_ignore(Tcl_Interp *ip, unsigned long *value_io, +static int bf_ignore(Tcl_Interp *ip, uint32_t *value_io, int *ok_io, Tcl_Obj *arg) { return TCL_OK; } -static int bf_fixed_read(Tcl_Interp *ip, unsigned long *value_io, +static int bf_fixed_read(Tcl_Interp *ip, uint32_t *value_io, int *ok_io, Tcl_Obj *arg) { - unsigned long ul; + uint32_t ul; int rc; rc= pat_ulong(ip, arg, &ul); if (rc) return rc; @@ -101,9 +90,9 @@ static int bf_fixed_read(Tcl_Interp *ip, unsigned long *value_io, return TCL_OK; } -static int bf_ulong_write(Tcl_Interp *ip, unsigned long *value_io, +static int bf_ulong_write(Tcl_Interp *ip, uint32_t *value_io, int *ok_io, Tcl_Obj *arg) { - unsigned long ul; + uint32_t ul; int rc; rc= pat_ulong(ip, arg, &ul); if (rc) return rc; @@ -118,12 +107,12 @@ static int bf_var_read(Tcl_Interp *ip, Tcl_Obj *varname, Tcl_Obj *val) { return TCL_OK; } -static int bf_ulong_read(Tcl_Interp *ip, unsigned long *value_io, +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)); } -static int bf_uint_write(Tcl_Interp *ip, unsigned long *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; @@ -132,7 +121,7 @@ static int bf_uint_write(Tcl_Interp *ip, unsigned long *value_io, return TCL_OK; } -static int bf_uint_read(Tcl_Interp *ip, unsigned long *value_io, +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"); @@ -150,12 +139,12 @@ static const BitFieldType bitfieldtypes[]= { }; static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r, - unsigned long *value_io, + uint32_t *value_io, int objc, Tcl_Obj *const *objv) { const BitFieldType *ftype; Tcl_Obj *arg; int sz, pos, rc; - unsigned long value, sz_mask, this_mask, this_field; + uint32_t value, sz_mask, this_mask, this_field; pos= 32; value= *value_io; @@ -204,9 +193,9 @@ static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r, } int do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip, - unsigned long base, + uint32_t base, int objc, Tcl_Obj *const *objv, - unsigned long *result) { + uint32_t *result) { int ok, rc; *result= base; @@ -216,70 +205,29 @@ int do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip, } int do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip, - unsigned long value, + uint32_t value, int objc, Tcl_Obj *const *objv, int *result) { return do_bitfields(ip,0,result,&value,objc,objv); } -/* conversion to/from hbytes */ - -#define SIZES \ - DO_SIZE(ulong, 4, 0xffffffffUL, \ - DO_BYTE(0,24) \ - DO_BYTE(1,16) \ - DO_BYTE(2,8) \ - DO_BYTE(3,0)) \ - DO_SIZE(ushort, 2, 0x0000ffffUL, \ - DO_BYTE(0,8) \ - DO_BYTE(1,0)) - -#define DO_BYTE(index,shift) (data[index] << shift) | -#define DO_SIZE(ulongint, len, max, bytes) \ - int do_hbytes_h2##ulongint(ClientData cd, Tcl_Interp *ip, \ - HBytes_Value hex, unsigned long *result) { \ - const Byte *data; \ - if (hbytes_len(&hex) != len) \ - return staticerr(ip, #ulongint " must be " #len " bytes"); \ - data= hbytes_data(&hex); \ - *result= (bytes 0); \ - return TCL_OK; \ - } -SIZES -#undef DO_BYTE -#undef DO_SIZE - -#define DO_BYTE(index,shift) data[index]= (value >> shift); -#define DO_SIZE(ulongint, len, max, bytes) \ - int do_hbytes_##ulongint##2h(ClientData cd, Tcl_Interp *ip, \ - unsigned long value, HBytes_Value *result) { \ - Byte *data; \ - if (value > max) return staticerr(ip, #ulongint " too big"); \ - data= hbytes_arrayspace(result,len); \ - bytes \ - return TCL_OK; \ - } -SIZES -#undef DO_BYTE -#undef DO_SIZE - /* Arg parsing */ -int pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, unsigned long *val) { +int pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, uint32_t *val) { int rc; rc= Tcl_ConvertToType(ip,o,&ulong_type); if (rc) return rc; - *val= *(const unsigned long*)&o->internalRep.longValue; + *val= *(const uint32_t*)&o->internalRep.longValue; return TCL_OK; } -Tcl_Obj *ret_ulong(Tcl_Interp *ip, unsigned long val) { +Tcl_Obj *ret_ulong(Tcl_Interp *ip, uint32_t val) { Tcl_Obj *o; o= Tcl_NewObj(); Tcl_InvalidateStringRep(o); - *(unsigned long*)&o->internalRep.longValue= val; + *(uint32_t*)&o->internalRep.longValue= val; o->typePtr= &ulong_type; return o; } @@ -294,33 +242,48 @@ static void ulong_t_dup(Tcl_Obj *src, Tcl_Obj *dup) { } static void ulong_t_ustr(Tcl_Obj *o) { - unsigned long val; + uint32_t val; char buf[11]; - val= *(const unsigned long*)&o->internalRep.longValue; + val= *(const uint32_t*)&o->internalRep.longValue; assert(val <= 0xffffffffUL); - snprintf(buf,sizeof(buf), "0x%08lx", val); + snprintf(buf,sizeof(buf), "%08lx", (unsigned long)val); obj_updatestr_vstringls(o, buf, sizeof(buf)-1, (char*)0); } static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) { char *str, *ep; - unsigned long ul; + uint32_t ul; + + if (o->typePtr == &hbytes_type) { + int l; + l= hbytes_len(OBJ_HBYTES(o)); + if (l > 4) return staticerr(ip, "hbytes as ulong must be of length < 4"); + ul= 0; + memcpy((Byte*)&ul + 4 - l, hbytes_data(OBJ_HBYTES(o)), l); + ul= htonl(ul); - str= Tcl_GetString(o); - errno=0; - if (str[0]=='0' && str[1]=='b' && str[2]) { - ul= strtoul(str+2,&ep,2); } else { - ul= strtoul(str,&ep,0); + + str= Tcl_GetString(o); + errno=0; + if (str[0]=='0' && str[1]=='b' && str[2]) { + ul= strtoul(str+2,&ep,2); + } else if (str[0]=='0' && str[1]=='d' && str[2]) { + ul= strtoul(str+2,&ep,10); + } 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"); objfreeir(o); - *(unsigned long*)&o->internalRep.longValue= ul; + *(uint32_t*)&o->internalRep.longValue= ul; + o->typePtr= &ulong_type; return TCL_OK; } -- 2.30.2