@(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)