chksum: generate with TXR.

A giant macro that generates numerous functions and variables
is hell for anyone who has to debug the code. The right
approach is external code generation, where the result is
a clean source file that is checked into the repository.

* genchksum.txr: New file.

* chksum.c: Now generated.
(chksum_impl): Macro and its invocations removed.
(sha1_stream_impl, sha1_stream, sha1_szmax_upd,
sha1_buf, sha1_str, sha1, sha1_ops,
sha1_begin,
sha1_utf8_byte_callback, sha1_hash,
sha1_end): These are directly defined again.
(sha256_stream_impl, sha256_stream, sha256_szmax_upd,
sha256_buf, sha256_str, sha256, sha256_ops,
sha256_begin,
sha256_utf8_byte_callback, sha256_hash,
sha256_end): Likewise.
generated by macro.
md5_stream_impl, md5_stream,
md5_szmax_upd,
md5_buf, md5_str, md5, md5_ops,
md5_begin,
md5_utf8_byte_callback, md5_hash,
md5_end): Likewise.

1 files changed, 235 insertions, 0 deletions

diff --git a/genchksum.txr b/genchksum.txr
new file mode 100644
index 00000000..932f2813
--- /dev/null
+++ b/genchksum.txr
@@ -0,0 +1,235 @@
+@(do
+   (defstruct (chksum cname type strname hashlen init update final) ()
+     cname
+     type
+     strname
+     hashlen
+     init
+     update
+     final))
+@(output :into sums-txt)
+sha1 SHA1_t "SHA-1" SHA1_DIGEST_LENGTH
+SHA1_init SHA1_update SHA1_final
+
+sha256 SHA256_t "SHA-256" SHA256_DIGEST_LENGTH
+SHA256_init SHA256_update SHA256_final
+
+md5 MD5_t "MD5" MD5_DIGEST_LENGTH
+MD5_init MD5_update MD5_final
+@(end)
+@(next :list sums-txt)
+@(collect :vars (s))
+@  cname @type @strname @hashlen
+@init @update @final
+@  (bind s @(new (chksum cname type strname hashlen init update final)))
+@(end)
+@(next "chksum.c")
+/* This file is generated by genchksum.txr */
+
+@(collect)
+@  prolog
+@(until)
+
+static void @{nil}_stream_impl(val stream, val nbytes,
+@(end)
+@(skip)
+@(data epilog)
+val crc32_stream(val stream, val nbytes, val init)
+@(output "chksum.c")
+/* This file is generated by genchksum.txr */
+
+@(repeat)
+@  prolog
+@(end)
+
+@(repeat)
+static void @{s.cname}_stream_impl(val stream, val nbytes,
+                                   unsigned char *hash, val self)
+{
+  @{s.type} ctx;
+  val buf = iobuf_get();
+  val bfsz = length_buf(buf);
+  @{s.init}(&ctx);
+
+  if (null_or_missing_p(nbytes)) {
+    for (;;) {
+      val read = fill_buf(buf, zero, stream);
+      cnum rd = c_num(read, self);
+
+      if (!rd)
+        break;
+
+      @{s.update}(&ctx, buf->b.data, rd);
+    }
+  } else {
+    while (ge(nbytes, bfsz)) {
+      val read = fill_buf(buf, zero, stream);
+      cnum rd = c_num(read, self);
+
+      if (zerop(read))
+        break;
+
+      @{s.update}(&ctx, buf->b.data, rd);
+      nbytes = minus(nbytes, read);
+    }
+
+    buf_set_length(buf, nbytes, nil);
+
+    {
+      val read = fill_buf(buf, zero, stream);
+      cnum rd = c_num(read, self);
+      if (rd)
+        @{s.update}(&ctx, buf->b.data, rd);
+    }
+  }
+
+  @{s.final}(&ctx, hash);
+  iobuf_put(buf);
+}
+
+val @{s.cname}_stream(val stream, val nbytes, val buf_in)
+{
+  val self = lit("@{s.cname}-stream");
+  unsigned char *hash;
+  val buf = chksum_ensure_buf(self, buf_in,
+                              num_fast(@{s.hashlen}),
+                              &hash, lit(@{s.strname}));
+  @{s.cname}_stream_impl(stream, nbytes, hash, self);
+  return buf;
+}
+
+static void @{s.cname}_szmax_upd(@{s.type} *pctx, mem_t *data, ucnum len)
+{
+  const size_t szmax = convert(size_t, -1) / 4 + 1;
+  while (len >= szmax) {
+    @{s.update}(pctx, data, szmax);
+    data += szmax;
+    len -= szmax;
+  }
+  if (len > 0)
+    @{s.update}(pctx, data, len);
+}
+
+static void @{s.cname}_buf(val buf, unsigned char *hash, val self)
+{
+  @{s.type} ctx;
+  @{s.init}(&ctx);
+  @{s.cname}_szmax_upd(&ctx, buf->b.data, c_unum(buf->b.len, self));
+  @{s.final}(&ctx, hash);
+}
+
+static void @{s.cname}_str(val str, unsigned char *hash, val self)
+{
+  char *s = utf8_dup_to(c_str(str, self));
+  @{s.type} ctx;
+  @{s.init}(&ctx);
+  @{s.update}(&ctx, coerce(const unsigned char *, s), strlen(s));
+  free(s);
+  @{s.final}(&ctx, hash);
+}
+
+val @{s.cname}(val obj, val buf_in)
+{
+  val self = lit("@{s.cname}");
+  unsigned char *hash;
+  val buf = chksum_ensure_buf(self, buf_in,
+                              num_fast(@{s.hashlen}),
+                              &hash, lit(@{s.strname}));
+  switch (type(obj)) {
+  case STR:
+  case LSTR:
+  case LIT:
+    @{s.cname}_str(obj, hash, self);
+    return buf;
+  case BUF:
+    @{s.cname}_buf(obj, hash, self);
+    return buf;
+  default:
+    uw_throwf(error_s,
+              lit("~a: cannot hash ~s, "
+                  "only buffer and strings"),
+              self, obj, nao);
+  }
+}
+
+static struct cobj_ops @{s.cname}_ops = cobj_ops_init(cobj_equal_handle_op,
+                                                       cobj_print_op,
+                                                       cobj_destroy_free_op,
+                                                       cobj_mark_op,
+                                                       cobj_handle_hash_op);
+
+val @{s.cname}_begin(void)
+{
+  @{s.type} *pctx = coerce(@{s.type} *, chk_malloc(sizeof *pctx));
+  @{s.init}(pctx);
+  return cobj(coerce(mem_t *, pctx), @{s.cname}_ctx_cls, &@{s.cname}_ops);
+}
+
+static int @{s.cname}_utf8_byte_callback(int b, mem_t *ctx)
+{
+  @{s.type} *pctx = coerce(@{s.type} *, ctx);
+  unsigned char uc = b;
+  @{s.update}(pctx, &uc, 1);
+  return 1;
+}
+
+val @{s.cname}_hash(val ctx, val obj)
+{
+  val self = lit("@{s.cname}-hash");
+  @{s.type} *pctx = coerce(@{s.type} *,
+                           cobj_handle(self, ctx, @{s.cname}_ctx_cls));
+  switch (type(obj)) {
+  case STR:
+  case LSTR:
+  case LIT:
+    {
+      char *str = utf8_dup_to(c_str(obj, self));
+      @{s.update}(pctx, coerce(const unsigned char *, str), strlen(str));
+      free(str);
+    }
+    break;
+  case BUF:
+    @{s.cname}_szmax_upd(pctx, obj->b.data, c_unum(obj->b.len, self));
+    break;
+  case CHR:
+    utf8_encode(c_ch(obj), @{s.cname}_utf8_byte_callback,
+                coerce(mem_t *, pctx));
+    break;
+  case NUM:
+    {
+      cnum n = c_num(obj, self);
+      unsigned char uc = n;
+      if (n < 0 || n > 255)
+        uw_throwf(error_s,
+                  lit("~a: byte value ~s out of range"),
+                  self, obj, nao);
+      @{s.update}(pctx, &uc, 1);
+    }
+    break;
+  default:
+    uw_throwf(error_s, lit("~a: cannot hash ~s, "
+                           "only buffer and strings"),
+              self, obj, nao);
+  }
+
+  return obj;
+}
+
+val @{s.cname}_end(val ctx, val buf_in)
+{
+  val self = lit("@{s.cname}-end");
+  unsigned char *hash;
+  @{s.type} *pctx = coerce(@{s.type} *,
+                           cobj_handle(self, ctx, @{s.cname}_ctx_cls));
+  val buf = chksum_ensure_buf(self, buf_in, num_fast(@{s.hashlen}),
+                              &hash, lit(@{s.strname}));
+  @{s.final}(pctx, hash);
+  @{s.init}(pctx);
+  return buf;
+}
+
+@(end)
+@(repeat)
+@  epilog
+@(end)
+@(end)