diff --git a/c/builtins.c b/c/builtins.c index ce27159..5fac107 100644 --- a/c/builtins.c +++ b/c/builtins.c @@ -1337,6 +1337,295 @@ static Value bi_read_binary_file(Value *a, int n, Env *e) { return r; } +/* walk-circuit-ops / op-specs->bytes / count-lumbda-ops + * + * C-tier ports of the three Python primitives at lumbda.py + * _walk_circuit_ops / _op_specs_to_bytes / _count_lumbda_ops. Each + * lifts foxhop ecdsa's emit-ops-bin pipeline out of our Scheme tree- + * walker — same algorithms, native C dispatch. + * + * NO_SLOT representation differs across tiers: Python tier stores the + * literal 18446744073709551615 fixnum (Python big-int). C tier fixnums + * cap at 48 bits, so we use VAL_FALSE as our slot sentinel inside the + * op-spec vector; op-specs->bytes packs 0xFFFFFFFFFFFFFFFF when it + * sees VAL_FALSE. Both tiers produce byte-identical QECCOPS1 output. + * + * Kind enum (matches ecdsa/lumbda/emit-ops-bin.lsp): + * 1 Register, 2 AppendToRegister, 6 X, 7 Z, 8 CX, 9 CZ, 10 Swap, + * 13 CCX, 14 CCZ. + */ + +/* Cached symbol interns — populated lazily on first call; symbol + * interning is idempotent so repeated calls cost nothing. */ +static Value g_sym_alloc, g_sym_free; +static Value g_sym_x, g_sym_z; +static Value g_sym_cx, g_sym_cz; +static Value g_sym_ccx, g_sym_ccz; +static Value g_sym_swap; +static int g_walk_syms_init = 0; + +static void walk_syms_init(void) { + if (g_walk_syms_init) return; + g_sym_alloc = intern("alloc"); + g_sym_free = intern("free"); + g_sym_x = intern("x"); + g_sym_z = intern("z"); + g_sym_cx = intern("cx"); + g_sym_cz = intern("cz"); + g_sym_ccx = intern("ccx"); + g_sym_ccz = intern("ccz"); + g_sym_swap = intern("swap"); + g_walk_syms_init = 1; +} + +/* Build a fresh op-spec Vector (7 elements: kind q2 q1 qt ct cc rt). + * Unused slots take VAL_FALSE as sentinel. */ +static Value mk_op_spec(int64_t kind, Value q2, Value q1, Value qt, + Value ct, Value cc, Value rt) { + Value items[7]; + items[0] = VAL_INT(kind); + items[1] = q2; items[2] = q1; items[3] = qt; + items[4] = ct; items[5] = cc; items[6] = rt; + return make_vector_from(items, 7); +} + +/* Layout lookup: hash-table from Symbol → fixnum base. + * Returns the base as int64_t. Caller must ensure name exists. */ +static int64_t layout_base(ULHashTable *layout, Value name) { + bool found; + Value v = ht_ref(layout, name, &found); + if (!found) lisp_error("walk-circuit-ops: unknown register"); + return as_int(v); +} + +/* Append Register + width × AppendToRegister to result list (in + * reverse so we can reverse at end). next_q & reg_id updated as + * declared registers grow the layout. Returns the new next_q. */ +static int64_t emit_register_boilerplate(Value *result_head, + Value name, int64_t width, + int64_t next_q, + ULHashTable *layout) { + int64_t base = next_q; + int64_t reg_id = base; + ht_set(layout, name, VAL_INT(base)); + /* Register record. */ + *result_head = cons(mk_op_spec(1, + VAL_FALSE, VAL_FALSE, VAL_FALSE, + VAL_FALSE, VAL_FALSE, + VAL_INT(reg_id)), + *result_head); + /* width × AppendToRegister. */ + for (int64_t i = 0; i < width; i++) { + *result_head = cons(mk_op_spec(2, + VAL_FALSE, VAL_FALSE, + VAL_INT(base + i), + VAL_FALSE, VAL_FALSE, + VAL_INT(reg_id)), + *result_head); + } + return next_q + width; +} + +/* Reverse a Scheme list in place via cons rebuild. */ +static Value list_reverse(Value lst) { + Value r = VAL_NIL; + while (IS_PAIR(lst)) { + r = cons(CAR(lst), r); + lst = CDR(lst); + } + return r; +} + +static Value bi_walk_circuit_ops(Value *a, int n, Env *e) { + (void)e; CHECK_ARITY("walk-circuit-ops", 2); + walk_syms_init(); + + Value registers_lst = a[0]; + Value ops_lst = a[1]; + + Value layout_v = make_hashtable(); + ULHashTable *layout = AS_HASHTABLE(layout_v); + int64_t next_q = 0; + Value result_head = VAL_NIL; /* built in reverse */ + + /* Declared registers first (boilerplate). */ + while (IS_PAIR(registers_lst)) { + Value rec = CAR(registers_lst); + /* rec = (name width) */ + Value name = CAR(rec); + int64_t width = as_int(CADR(rec)); + next_q = emit_register_boilerplate(&result_head, name, width, + next_q, layout); + registers_lst = CDR(registers_lst); + } + + /* Walk ops. */ + while (IS_PAIR(ops_lst)) { + Value op = CAR(ops_lst); + Value tag = CAR(op); + Value rest = CDR(op); + + if (tag == g_sym_ccx) { + Value c1 = CAR(rest); + Value c2 = CAR(CDR(rest)); + Value tgt = CAR(CDR(CDR(rest))); + int64_t q1 = layout_base(layout, CAR(c1)) + as_int(CADR(c1)); + int64_t q2 = layout_base(layout, CAR(c2)) + as_int(CADR(c2)); + int64_t qt = layout_base(layout, CAR(tgt)) + as_int(CADR(tgt)); + result_head = cons(mk_op_spec(13, + VAL_INT(q2), VAL_INT(q1), VAL_INT(qt), + VAL_FALSE, VAL_FALSE, VAL_FALSE), + result_head); + } else if (tag == g_sym_cx) { + Value c1 = CAR(rest); + Value tgt = CAR(CDR(rest)); + int64_t q1 = layout_base(layout, CAR(c1)) + as_int(CADR(c1)); + int64_t qt = layout_base(layout, CAR(tgt)) + as_int(CADR(tgt)); + result_head = cons(mk_op_spec(8, + VAL_FALSE, VAL_INT(q1), VAL_INT(qt), + VAL_FALSE, VAL_FALSE, VAL_FALSE), + result_head); + } else if (tag == g_sym_x) { + Value tgt = CAR(rest); + int64_t qt = layout_base(layout, CAR(tgt)) + as_int(CADR(tgt)); + result_head = cons(mk_op_spec(6, + VAL_FALSE, VAL_FALSE, VAL_INT(qt), + VAL_FALSE, VAL_FALSE, VAL_FALSE), + result_head); + } else if (tag == g_sym_alloc) { + Value name = CAR(rest); + int64_t width = as_int(CADR(rest)); + next_q = emit_register_boilerplate(&result_head, name, width, + next_q, layout); + } else if (tag == g_sym_free) { + Value name = CAR(rest); + ht_delete(layout, name); + } else if (tag == g_sym_z) { + Value tgt = CAR(rest); + int64_t qt = layout_base(layout, CAR(tgt)) + as_int(CADR(tgt)); + result_head = cons(mk_op_spec(7, + VAL_FALSE, VAL_FALSE, VAL_INT(qt), + VAL_FALSE, VAL_FALSE, VAL_FALSE), + result_head); + } else if (tag == g_sym_cz) { + Value c1 = CAR(rest); + Value tgt = CAR(CDR(rest)); + int64_t q1 = layout_base(layout, CAR(c1)) + as_int(CADR(c1)); + int64_t qt = layout_base(layout, CAR(tgt)) + as_int(CADR(tgt)); + result_head = cons(mk_op_spec(9, + VAL_FALSE, VAL_INT(q1), VAL_INT(qt), + VAL_FALSE, VAL_FALSE, VAL_FALSE), + result_head); + } else if (tag == g_sym_swap) { + Value aa = CAR(rest); + Value bb = CAR(CDR(rest)); + int64_t q1 = layout_base(layout, CAR(aa)) + as_int(CADR(aa)); + int64_t qt = layout_base(layout, CAR(bb)) + as_int(CADR(bb)); + result_head = cons(mk_op_spec(10, + VAL_FALSE, VAL_INT(q1), VAL_INT(qt), + VAL_FALSE, VAL_FALSE, VAL_FALSE), + result_head); + } else if (tag == g_sym_ccz) { + Value c1 = CAR(rest); + Value c2 = CAR(CDR(rest)); + Value tgt = CAR(CDR(CDR(rest))); + int64_t q1 = layout_base(layout, CAR(c1)) + as_int(CADR(c1)); + int64_t q2 = layout_base(layout, CAR(c2)) + as_int(CADR(c2)); + int64_t qt = layout_base(layout, CAR(tgt)) + as_int(CADR(tgt)); + result_head = cons(mk_op_spec(14, + VAL_INT(q2), VAL_INT(q1), VAL_INT(qt), + VAL_FALSE, VAL_FALSE, VAL_FALSE), + result_head); + } else { + lisp_error("walk-circuit-ops: unknown op tag"); + } + + ops_lst = CDR(ops_lst); + } + + return list_reverse(result_head); +} + +/* Pack a single u64 into 8 LE bytes at buf. VAL_FALSE → NO_SLOT + * (0xFFFFFFFFFFFFFFFF). Otherwise the fixnum value as unsigned. */ +static void pack_u64_slot(char *buf, Value v) { + uint64_t u; + if (v == VAL_FALSE) { + u = 0xFFFFFFFFFFFFFFFFULL; + } else { + u = (uint64_t)as_int(v); + } + buf[0] = (char)(u & 0xFF); + buf[1] = (char)((u >> 8) & 0xFF); + buf[2] = (char)((u >> 16) & 0xFF); + buf[3] = (char)((u >> 24) & 0xFF); + buf[4] = (char)((u >> 32) & 0xFF); + buf[5] = (char)((u >> 40) & 0xFF); + buf[6] = (char)((u >> 48) & 0xFF); + buf[7] = (char)((u >> 56) & 0xFF); +} + +static Value bi_op_specs_to_bytes(Value *a, int n, Env *e) { + (void)e; CHECK_ARITY("op-specs->bytes", 1); + + /* Two-pass: count first to size the buffer exactly. */ + size_t count = 0; + { + Value lst = a[0]; + while (IS_PAIR(lst)) { count++; lst = CDR(lst); } + } + size_t total = count * 56; + char *buf = (char *)ul_malloc(total + 1); + + Value lst = a[0]; + size_t pos = 0; + while (IS_PAIR(lst)) { + Value v = CAR(lst); + if (!IS_VECTOR(v)) lisp_error("op-specs->bytes: not a vector"); + ULVector *vec = AS_VECTOR(v); + if (vec->len < 7) lisp_error("op-specs->bytes: short vector"); + /* u32 kind */ + uint32_t kind = (uint32_t)as_int(vec->data[0]); + buf[pos++] = (char)(kind & 0xFF); + buf[pos++] = (char)((kind >> 8) & 0xFF); + buf[pos++] = (char)((kind >> 16) & 0xFF); + buf[pos++] = (char)((kind >> 24) & 0xFF); + /* u32 pad (zero) */ + buf[pos++] = 0; buf[pos++] = 0; buf[pos++] = 0; buf[pos++] = 0; + /* 6× u64 slots */ + for (int i = 1; i <= 6; i++) { + pack_u64_slot(buf + pos, vec->data[i]); + pos += 8; + } + lst = CDR(lst); + } + buf[pos] = 0; + Value r = make_string(buf, total, false); + ul_free(buf); + return r; +} + +static Value bi_count_lumbda_ops(Value *a, int n, Env *e) { + (void)e; CHECK_ARITY("count-lumbda-ops", 1); + walk_syms_init(); + + int64_t tof = 0, cli = 0, tot = 0; + Value lst = a[0]; + while (IS_PAIR(lst)) { + Value op = CAR(lst); + Value tag = IS_PAIR(op) ? CAR(op) : op; + tot++; + if (tag == g_sym_ccx) tof++; + else if (tag == g_sym_x || tag == g_sym_cx) cli++; + lst = CDR(lst); + } + Value items[3]; + items[0] = VAL_INT(tof); + items[1] = VAL_INT(cli); + items[2] = VAL_INT(tot); + return make_vector_from(items, 3); +} + /* heap-snapshot / heap-restore: asm-only arena primitives. The asm impl * has no GC; these let a server rewind its bump allocator between * requests. Python + C have real GCs — no-ops here so portable .lsp @@ -2024,6 +2313,9 @@ Env *make_global_env(void) { DEF("flush-port", bi_flush_port); DEF("write-binary-file", bi_write_binary_file); DEF("read-binary-file", bi_read_binary_file); + DEF("walk-circuit-ops", bi_walk_circuit_ops); + DEF("op-specs->bytes", bi_op_specs_to_bytes); + DEF("count-lumbda-ops", bi_count_lumbda_ops); DEF("heap-snapshot", bi_heap_snapshot); DEF("heap-restore", bi_heap_restore); DEF("current-time-ms", bi_current_time_ms);