genchksum.txr

@(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 partially generated by genchksum.txr; see comment below. */

@(collect)
@  prolog
@(until)

static val @{nil}_ctx_s, @nil
@(end)
@(skip)
@(data crc32-start)
val crc32_stream(val stream, val nbytes, val init)
@(skip)
@(data chksum-init-start)
void chksum_init(void)
{
@(skip)
@(data epilog)
  reg_fun(intern(lit("crc32-stream"), user_package), func_n3o(crc32_stream, 1));
  reg_fun(intern(lit("crc32"), user_package), func_n2o(crc32, 1));
}
@(bind crc32 @(ldiff crc32-start chksum-init-start))
@(output "chksum.c")
/* This file is partially generated by genchksum.txr; see comment below. */

@(repeat)
@  prolog
@(end)

static val @(rep)@{s.cname}_ctx_s, @(last)@{s.cname}_ctx_s;@(end)
static struct cobj_class @(rep)*@{s.cname}_ctx_cls, @(last)*@{s.cname}_ctx_cls;@(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,
                                                       0);

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)
@  crc32
@(end)
void chksum_init(void)
{
@(repeat)
  @{s.cname}_ctx_s = intern(lit("@{s.cname}-ctx"), user_package);
@(end)
@(repeat)
  @{s.cname}_ctx_cls = cobj_register(@{s.cname}_ctx_s);
@(end)
@(repeat)
  reg_fun(intern(lit("@{s.cname}-stream"), user_package), func_n3o(@{s.cname}_stream, 1));
  reg_fun(intern(lit("@{s.cname}"), user_package), func_n2o(@{s.cname}, 1));
  reg_fun(intern(lit("@{s.cname}-begin"), user_package), func_n0(@{s.cname}_begin));
  reg_fun(intern(lit("@{s.cname}-hash"), user_package), func_n2(@{s.cname}_hash));
  reg_fun(intern(lit("@{s.cname}-end"), user_package), func_n2o(@{s.cname}_end, 1));
@(end)
@(repeat)
@  epilog
@(end)
@(end)