ulongs and ushorts

[chiark-tcl.git] / hbytes / ulongs.c

diff --git a/hbytes/ulongs.c b/hbytes/ulongs.c
new file mode 100644 (file)
index 0000000..8260a44
--- /dev/null
+++ b/hbytes/ulongs.c
@@ -0,0 +1,61 @@
+/*
+ */
+
+#include "hbytes.h"
+#include "tables.h"
+
+#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
+
+int pat_ulong(Tcl_Interp *ip, Tcl_Obj *obj, unsigned long *val) {
+  char *str, *ep;
+
+  str= Tcl_GetString(obj);
+  errno= 0;
+  *val= strtoul(str,&ep,0);
+  if (*ep || errno) return staticerr(ip, "bad unsigned value");
+  return TCL_OK;
+}
+
+Tcl_Obj *ret_ulong(Tcl_Interp *ip, unsigned long val) {
+  char buf[11];
+  assert(val <= 0xffffffffUL);
+  snprintf(buf,sizeof(buf), "0x%08lx", val);
+  return Tcl_NewStringObj(buf,sizeof(buf)-1);
+}