*
* hbytes range VALUE START SIZE => substring (or error)
*
+ * 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 compare A B
* => -2 A is lexically earlier than B and not a prefix of B (A<B)
* -1 A is prefix of B but not equal (A<B)
/* from dgram.c */
-extern Tcl_ObjType sockid_type;
+extern Tcl_ObjType dgramsockid_type;
typedef struct DgramSocket *DgramSockID;
/* from hook.c */
void obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
int l, const char *prefix);
+void obj_updatestr_vstringls(Tcl_Obj *o, ...);
+ /* const char*, int, const char*, int, ..., (const char*)0 */
+void obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
+void obj_updatestr_string(Tcl_Obj *o, const char *str);
+
/* from parse.c */
typedef struct {
void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);
/* from chop.c */
+ /* only do_... functions declared in tables.h */
+
+/* from ulong.c */
+
+Tcl_ObjType ulong_type;
/* from enum.c */
obj_updatestr_array_prefix(o,byte,l,"");
}
+void obj_updatestr_vstringls(Tcl_Obj *o, ...) {
+ va_list al;
+ char *p;
+ const char *part;
+ int l, pl;
+
+ va_start(al,o);
+ for (l=0; (part= va_arg(al, const char*)); )
+ l+= va_arg(al, int);
+ va_end(al);
+
+ o->length= l;
+ o->bytes= TALLOC(l+1);
+
+ va_start(al,o);
+ for (p= o->bytes; (part= va_arg(al, const char*)); p += pl) {
+ pl= va_arg(al, int);
+ memcpy(p, part, pl);
+ }
+ va_end(al);
+
+ *p= 0;
+}
+
+void obj_updatestr_string(Tcl_Obj *o, const char *str) {
+ obj_updatestr_vstringls(o, str, strlen(str), (char*)0);
+}
+
static void hbytes_t_ustr(Tcl_Obj *o) {
obj_updatestr_array(o,
hbytes_data(OBJ_HBYTES(o)),
int do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
Tcl_Obj *binary, HBytes_Value *result) {
- const char *str;
+ const unsigned char *str;
int l;
- str= Tcl_GetStringFromObj(binary,&l);
+ str= Tcl_GetByteArrayFromObj(binary,&l);
hbytes_array(result, str, l);
return TCL_OK;
}
int do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
HBytes_Value hex, Tcl_Obj **result) {
- *result= Tcl_NewStringObj(hbytes_data(&hex), hbytes_len(&hex));
+ *result= Tcl_NewByteArrayObj(hbytes_data(&hex), hbytes_len(&hex));
return TCL_OK;
}
return TCL_OK;
}
-int do__hbytes(ClientData cd, Tcl_Interp *ip,
- const HBytes_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
+int do_toplevel_hbytes(ClientData cd, Tcl_Interp *ip,
+ const HBytes_SubCommand *subcmd,
+ int objc, Tcl_Obj *const *objv) {
+ return subcmd->func(0,ip,objc,objv);
+}
+
+int do_toplevel_dgram_socket(ClientData cd, Tcl_Interp *ip,
+ const DgramSocket_SubCommand *subcmd,
+ int objc, Tcl_Obj *const *objv) {
return subcmd->func(0,ip,objc,objv);
}
-int do__dgram_socket(ClientData cd, Tcl_Interp *ip,
- const DgramSocket_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
+int do_toplevel_ulong(ClientData cd, Tcl_Interp *ip,
+ const ULong_SubCommand *subcmd,
+ int objc, Tcl_Obj *const *objv) {
return subcmd->func(0,ip,objc,objv);
}
}
int Hbytes_Init(Tcl_Interp *ip) {
+ const TopLevel_Command *cmd;
+
Tcl_RegisterObjType(&hbytes_type);
Tcl_RegisterObjType(&blockcipherkey_type);
Tcl_RegisterObjType(&enum_nearlytype);
Tcl_RegisterObjType(&enum1_nearlytype);
Tcl_RegisterObjType(&sockaddr_type);
- Tcl_RegisterObjType(&sockid_type);
- Tcl_CreateObjCommand(ip, "hbytes", pa__hbytes, 0,0);
- Tcl_CreateObjCommand(ip, "dgram-socket", pa__dgram_socket, 0,0);
+ Tcl_RegisterObjType(&dgramsockid_type);
+ Tcl_RegisterObjType(&ulong_type);
+
+ for (cmd=toplevel_commands;
+ cmd->name;
+ cmd++)
+ Tcl_CreateObjCommand(ip, cmd->name, cmd->func, 0,0);
+
return TCL_OK;
}
H-Include "hbytes.h"
-Untabled
+Table toplevel TopLevel_Command
hbytes
subcmd enum(HBytes_SubCommand, "hbytes subcommand")
- obj ...
+ ... obj
dgram-socket
- subcmd enum(DgramSocket_SubCommand,"dgram-socket subcommand")
- obj ...
+ subcmd enum(DgramSocket_SubCommand,"dgram-socket subcommand")
+ ... obj
+ ulong
+ subcmd enum(ULong_SubCommand,"ulong subcommand")
+ ... obj
+
+Table ulong ULong_SubCommand
+ shift
+ right charfrom("lr", "shift direction")
+ v ulong
+ bits int
+ => ulong
+ mask
+ a ulong
+ b ulong
+ => ulong
+ compare
+ a ulong
+ b ulong
+ => int
+ ul2int
+ v ulong
+ => int
+ int2ul
+ v int
+ => ulong
+ ul2bitfields
+ value ulong
+ ... obj
+ => int
+ bitfields2ul
+ base ulong
+ ... obj
+ => ulong
Table hbytes HBytes_SubCommand
raw2h
=> hb
prepend
v hbv
- str ...
+ ... str
append
v hbv
- str ...
+ ... str
rep-info
v obj
=> obj
concat
- str ...
+ ... str
=> hb
unprepend
v hbv
badsyntax($wh,$.,"bad entry");
}
$tables{$c_table}{$c_entry}{A} = [ ];
- } elsif (@i==2 && m/^(\w+)\s+\.\.\.$/ && defined $c_entry) {
+ } elsif (@i==2 && m/^\.\.\.\s+(\w+)$/ && defined $c_entry) {
$tables{$c_table}{$c_entry}{V}= $1;
} elsif (@i==2 && m/^(\??)([a-z]\w*)\s*(\S.*)/
&& defined $c_entry) {
int rc, sockix;
DgramSocket *sock;
- rc= Tcl_ConvertToType(ip,o,&sockid_type);
+ rc= Tcl_ConvertToType(ip,o,&dgramsockid_type);
if (rc) return rc;
sockix= o->internalRep.longValue;
o= Tcl_NewObj();
Tcl_InvalidateStringRep(o);
o->internalRep.longValue= val->ix;
- o->typePtr= &sockid_type;
+ o->typePtr= &dgramsockid_type;
return o;
}
}
static void sockid_t_ustr(Tcl_Obj *o) {
- char buf[100];
- int l;
+ char buf[75];
- snprintf(buf,sizeof(buf),"dgramsock%d", (int)o->internalRep.longValue);
- l= o->length= strlen(buf);
- o->bytes= TALLOC(l+1);
- strcpy(o->bytes, buf);
+ snprintf(buf,sizeof(buf), "%d", (int)o->internalRep.longValue);
+ obj_updatestr_vstringls(o,
+ "dgramsock",9,
+ buf, strlen(buf),
+ (char*)0);
}
static int sockid_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
errno=0; ul=strtoul(str+9,&ep,10);
if (errno || *ep) return staticerr(ip,"bad dgram socket id number");
if (ul > INT_MAX) return staticerr(ip,"out of range dgram socket id");
+
+ objfreeir(o);
o->internalRep.longValue= ul;
+ o->typePtr= &dgramsockid_type;
return TCL_OK;
}
-Tcl_ObjType sockid_type = {
- "sockid-nearly",
+Tcl_ObjType dgramsockid_type = {
+ "dgramsockid",
sockid_t_free, sockid_t_dup, sockid_t_ustr, sockid_t_sfa
};
const struct sockaddr *sa;
char i46buf[INET6_ADDRSTRLEN], portbuf[50];
const struct sockaddr_in *sin;
- int al, sl, pl;
+ int al;
const char *string, *prepend;
sa= sockaddr_addr(OBJ_SOCKADDR(o));
return;
}
- pl= strlen(prepend);
- sl= strlen(string);
- o->length= pl+sl;
- o->bytes= TALLOC(pl+sl+1);
- memcpy(o->bytes, prepend, pl);
- memcpy(o->bytes+pl, string, sl+1);
+ obj_updatestr_vstringls(o,
+ prepend, strlen(prepend),
+ string, strlen(string),
+ (char*)0);
}
static int sockaddr_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
*
* hbytes range VALUE START SIZE => substring (or error)
*
+ * 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 compare A B
* => -2 A is lexically earlier than B and not a prefix of B (A<B)
* -1 A is prefix of B but not equal (A<B)
/* from dgram.c */
-extern Tcl_ObjType sockid_type;
+extern Tcl_ObjType dgramsockid_type;
typedef struct DgramSocket *DgramSockID;
/* from hook.c */
void obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
int l, const char *prefix);
+void obj_updatestr_vstringls(Tcl_Obj *o, ...);
+ /* const char*, int, const char*, int, ..., (const char*)0 */
+void obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
+void obj_updatestr_string(Tcl_Obj *o, const char *str);
+
/* from parse.c */
typedef struct {
void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);
/* from chop.c */
+ /* only do_... functions declared in tables.h */
+
+/* from ulong.c */
+
+Tcl_ObjType ulong_type;
/* from enum.c */
obj_updatestr_array_prefix(o,byte,l,"");
}
+void obj_updatestr_vstringls(Tcl_Obj *o, ...) {
+ va_list al;
+ char *p;
+ const char *part;
+ int l, pl;
+
+ va_start(al,o);
+ for (l=0; (part= va_arg(al, const char*)); )
+ l+= va_arg(al, int);
+ va_end(al);
+
+ o->length= l;
+ o->bytes= TALLOC(l+1);
+
+ va_start(al,o);
+ for (p= o->bytes; (part= va_arg(al, const char*)); p += pl) {
+ pl= va_arg(al, int);
+ memcpy(p, part, pl);
+ }
+ va_end(al);
+
+ *p= 0;
+}
+
+void obj_updatestr_string(Tcl_Obj *o, const char *str) {
+ obj_updatestr_vstringls(o, str, strlen(str), (char*)0);
+}
+
static void hbytes_t_ustr(Tcl_Obj *o) {
obj_updatestr_array(o,
hbytes_data(OBJ_HBYTES(o)),
int do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
Tcl_Obj *binary, HBytes_Value *result) {
- const char *str;
+ const unsigned char *str;
int l;
- str= Tcl_GetStringFromObj(binary,&l);
+ str= Tcl_GetByteArrayFromObj(binary,&l);
hbytes_array(result, str, l);
return TCL_OK;
}
int do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
HBytes_Value hex, Tcl_Obj **result) {
- *result= Tcl_NewStringObj(hbytes_data(&hex), hbytes_len(&hex));
+ *result= Tcl_NewByteArrayObj(hbytes_data(&hex), hbytes_len(&hex));
return TCL_OK;
}
return TCL_OK;
}
-int do__hbytes(ClientData cd, Tcl_Interp *ip,
- const HBytes_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
+int do_toplevel_hbytes(ClientData cd, Tcl_Interp *ip,
+ const HBytes_SubCommand *subcmd,
+ int objc, Tcl_Obj *const *objv) {
+ return subcmd->func(0,ip,objc,objv);
+}
+
+int do_toplevel_dgram_socket(ClientData cd, Tcl_Interp *ip,
+ const DgramSocket_SubCommand *subcmd,
+ int objc, Tcl_Obj *const *objv) {
return subcmd->func(0,ip,objc,objv);
}
-int do__dgram_socket(ClientData cd, Tcl_Interp *ip,
- const DgramSocket_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
+int do_toplevel_ulong(ClientData cd, Tcl_Interp *ip,
+ const ULong_SubCommand *subcmd,
+ int objc, Tcl_Obj *const *objv) {
return subcmd->func(0,ip,objc,objv);
}
}
int Hbytes_Init(Tcl_Interp *ip) {
+ const TopLevel_Command *cmd;
+
Tcl_RegisterObjType(&hbytes_type);
Tcl_RegisterObjType(&blockcipherkey_type);
Tcl_RegisterObjType(&enum_nearlytype);
Tcl_RegisterObjType(&enum1_nearlytype);
Tcl_RegisterObjType(&sockaddr_type);
- Tcl_RegisterObjType(&sockid_type);
- Tcl_CreateObjCommand(ip, "hbytes", pa__hbytes, 0,0);
- Tcl_CreateObjCommand(ip, "dgram-socket", pa__dgram_socket, 0,0);
+ Tcl_RegisterObjType(&dgramsockid_type);
+ Tcl_RegisterObjType(&ulong_type);
+
+ for (cmd=toplevel_commands;
+ cmd->name;
+ cmd++)
+ Tcl_CreateObjCommand(ip, cmd->name, cmd->func, 0,0);
+
return TCL_OK;
}
#include "hbytes.h"
#include "tables.h"
+/* nice simple functions */
+
+int do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v,
+ unsigned long *result) {
+ if (v<0) return staticerr(ip,"cannot convert -ve integer to ulong");
+ *result= v;
+ return TCL_OK;
+}
+
+int do_ulong_ul2int(ClientData cd, Tcl_Interp *ip,
+ unsigned long 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) {
+ *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) {
+ 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 *ok_io, Tcl_Obj *arg);
+} BitFieldType;
+
+static int bf_zero_read(Tcl_Interp *ip, unsigned long *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,
+ int *ok_io, Tcl_Obj *arg) {
+ *value_io= 0;
+ return TCL_OK;
+}
+
+static int bf_ignore(Tcl_Interp *ip, unsigned long *value_io,
+ int *ok_io, Tcl_Obj *arg) {
+ return TCL_OK;
+}
+
+static int bf_fixed_read(Tcl_Interp *ip, unsigned long *value_io,
+ int *ok_io, Tcl_Obj *arg) {
+ unsigned long ul;
+ int rc;
+
+ rc= pat_ulong(ip, arg, &ul); if (rc) return rc;
+ if (*value_io != ul) *ok_io= 0;
+ return TCL_OK;
+}
+
+static int bf_ulong_write(Tcl_Interp *ip, unsigned long *value_io,
+ int *ok_io, Tcl_Obj *arg) {
+ unsigned long ul;
+ int rc;
+
+ rc= pat_ulong(ip, arg, &ul); if (rc) return rc;
+ *value_io= ul;
+ return TCL_OK;
+}
+
+static int bf_var_read(Tcl_Interp *ip, Tcl_Obj *varname, Tcl_Obj *val) {
+ Tcl_Obj *rp;
+ rp= Tcl_ObjSetVar2(ip,varname,0,val,TCL_LEAVE_ERR_MSG);
+ if (!rp) return TCL_ERROR;
+ return TCL_OK;
+}
+
+static int bf_ulong_read(Tcl_Interp *ip, unsigned long *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,
+ 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");
+ *value_io= v;
+ return TCL_OK;
+}
+
+static int bf_uint_read(Tcl_Interp *ip, unsigned long *value_io,
+ int *ok_io, Tcl_Obj *arg) {
+ if (*value_io > INT_MAX)
+ return staticerr(ip,"value from bitfield exceeds INT_MAX");
+ return bf_var_read(ip,arg, ret_int(ip,*value_io));
+}
+
+#define BFT(t,a) { #t, a, { bf_read_##t, bf_write_##t } }
+static const BitFieldType bitfieldtypes[]= {
+ { "zero", 0, { bf_zero_read, bf_zero_write } },
+ { "ignore", 0, { bf_ignore, bf_ignore } },
+ { "fixed", 1, { bf_fixed_read, bf_ulong_write } },
+ { "ulong", 1, { bf_ulong_read, bf_ulong_write } },
+ { "uint", 1, { bf_uint_read, bf_uint_write } },
+ { 0 }
+};
+
+static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
+ unsigned long *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;
+
+ pos= 32;
+ value= *value_io;
+ *ok_r= 1;
+
+ while (--objc) {
+ rc= Tcl_GetIntFromObj(ip,*++objv,&sz); if (rc) return rc;
+ if (!--objc) return staticerr(ip,"wrong # args: missing bitfield type");
+
+ if (sz<0) return staticerr(ip,"bitfield size is -ve");
+ if (sz>pos) return staticerr(ip,"total size of bitfields >32");
+
+ pos -= sz;
+
+ sz_mask= ~(~0UL << sz);
+ this_mask= (sz_mask << pos);
+ this_field= (value & this_mask) >> pos;
+
+ ftype= enum_lookup_cached(ip,*++objv,bitfieldtypes,"bitfield type");
+ if (!ftype) return TCL_ERROR;
+
+ if (ftype->want_arg) {
+ if (!--objc)
+ return staticerr(ip,"wrong # args: missing arg for bitfield");
+ arg= *++objv;
+ } else {
+ arg= 0;
+ }
+ rc= ftype->reader_writer[writing](ip, &this_field, ok_r, arg);
+ if (rc) return rc;
+
+ if (!*ok_r) return TCL_OK;
+
+ if (this_field & ~sz_mask)
+ return staticerr(ip,"bitfield value has more bits than bitfield");
+
+ value &= ~this_mask;
+ value |= (this_field << pos);
+ }
+
+ if (pos != 0)
+ return staticerr(ip,"bitfield sizes add up to <32");
+
+ *value_io= value;
+ return TCL_OK;
+}
+
+int do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
+ unsigned long base,
+ int objc, Tcl_Obj *const *objv,
+ unsigned long *result) {
+ int ok, rc;
+
+ *result= base;
+ rc= do_bitfields(ip,1,&ok,result,objc,objv);
+ assert(ok);
+ return rc;
+}
+
+int do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
+ unsigned long 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) \
#undef DO_BYTE
#undef DO_SIZE
-int pat_ulong(Tcl_Interp *ip, Tcl_Obj *obj, unsigned long *val) {
- char *str, *ep;
+/* Arg parsing */
- str= Tcl_GetString(obj);
- errno= 0;
- *val= strtoul(str,&ep,0);
- if (*ep || errno) return staticerr(ip, "bad unsigned value");
+int pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, unsigned long *val) {
+ int rc;
+
+ rc= Tcl_ConvertToType(ip,o,&ulong_type);
+ if (rc) return rc;
+ *val= *(const unsigned long*)&o->internalRep.longValue;
return TCL_OK;
}
Tcl_Obj *ret_ulong(Tcl_Interp *ip, unsigned long val) {
+ Tcl_Obj *o;
+
+ o= Tcl_NewObj();
+ Tcl_InvalidateStringRep(o);
+ *(unsigned long*)&o->internalRep.longValue= val;
+ o->typePtr= &ulong_type;
+ return o;
+}
+
+/* Tcl ulong type */
+
+static void ulong_t_free(Tcl_Obj *o) { }
+
+static void ulong_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
+ dup->internalRep= src->internalRep;
+}
+
+static void ulong_t_ustr(Tcl_Obj *o) {
+ unsigned long val;
char buf[11];
+
+ val= *(const unsigned long*)&o->internalRep.longValue;
+
assert(val <= 0xffffffffUL);
snprintf(buf,sizeof(buf), "0x%08lx", val);
- return Tcl_NewStringObj(buf,sizeof(buf)-1);
+
+ 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;
+
+
+ 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);
+ }
+ if (*ep || errno) return staticerr(ip, "bad unsigned long value");
+
+ objfreeir(o);
+ *(unsigned long*)&o->internalRep.longValue= ul;
+ return TCL_OK;
}
+
+Tcl_ObjType ulong_type = {
+ "ulong-nearly",
+ ulong_t_free, ulong_t_dup, ulong_t_ustr, ulong_t_sfa
+};
~ian / chiark-tcl.git / commitdiff