russell@unturf.com
1665893321
29 new files publish factory infra (V2 autoscaler with live VRAM sampling + EWMA peak tracking, HUGE solo-dispatch, two-tier DLQ/rDLQ classifier + retry), general quantum circuit primitives (Cuccaro ripple-carry adder, Clifford gate library, Clifford tableau simulator, mod-arith family, dialog GCD reversible inverse, Karatsuba multiplier, Solinas fast reduction), and a TCRAUDT reducer harness. Originally developed in ~/git/www.foxhop.net/ecdsa/ for secp256k1 attack-surface research; published upstream as obligated by AGPLv3. Parametrization contract at factory/CONTRACT.md. Consumers export LUMBDA_REPO_DIR + LUMBDA_QUEUE_DIR + LUMBDA_BACKEND_CMD + LUMBDA_EMITTER_CMD then exec factory scripts. No fork-and-modify; single source of truth upstream. Integration tests gate 7 V2 defect classes that wedged a live factory on 2026-06-12 (skewed-demand starve, zero-floor reservation, multi-tier greedy, +-25%% damping, cold-start ramp, DLQ surge halve, post-damp CPU ceiling) + 28 DLQ classifier cases (auto-retry vs escalate partition) + bash -n syntax lint across every script. GPU backend stays in consumer trees; rationale in factory/GPU-BACKEND-NOTE.md. Bend wire protocol + gpu-worker.lsp already upstream at examples/cuda-fanout/. make factory-lint bash -n on every factory/*.sh make test-integration V2 reducer + DLQ classifier + syntax gate make sweep-doctrine TCRAUDT reducer gate (serial) make sweep-doctrine-parallel xargs -P fan-out Verified on neoblanka: factory-lint 12 scripts PASS; test-integration 14 V2 cases + 28 DLQ classifier cases + 12 syntax cases all PASS.
900 lines
45 KiB
Text
900 lines
45 KiB
Text
;;; mod-inv-by-dialog-gcd-host.lsp — sweep-006: dialog_log substrate port.
|
||
;;;
|
||
;;; Layers HEAD's HOST_GATED / APPLY_WINDOW_BLOCKS / BODY_HOST_CIN /
|
||
;;; FUSED_BRANCH_BITS knobs on top of sweep-005's mod-inv-by-dialog-gcd!.
|
||
;;; Source: `~/git/ecdsafail-challenge/src/point_add/mod.rs`
|
||
;;; - `dialog_log` register at mod.rs:25044 (declared via
|
||
;;; `b.alloc_qubits(DIALOG_GCD_RAW_LOG_BITS)`).
|
||
;;; - HOST_GATED gate at mod.rs:24664-24676, applied at
|
||
;;; `dialog_gcd_controlled_sub_selected` mod.rs:24727-24737 +
|
||
;;; `_add_selected` mod.rs:24811-24821.
|
||
;;; - APPLY_WINDOW_BLOCKS at mod.rs:25148-25156 +
|
||
;;; `dialog_gcd_apply_window_blocks` at mod.rs:25191.
|
||
;;; - BODY_HOST_CIN at mod.rs:24677-24685, applied at the
|
||
;;; materialized-sub body c_in alloc skip
|
||
;;; (mod.rs:24764-24773 / 24848-24857).
|
||
;;; - FUSED_BRANCH_BITS at mod.rs:24305-24310, applied at
|
||
;;; mod.rs:24926-24939 via dialog_gcd_ccx_cmp_gt_truncated_into_width.
|
||
;;;
|
||
;;; ── Honest port boundary ────────────────────────────────────────
|
||
;;;
|
||
;;; HEAD's HOST_GATED clears the borrowed `gated[i]` slot via
|
||
;;;
|
||
;;; b.hmr(gated[i], m); ; Hadamard + Measure + Reset
|
||
;;; b.cz_if(ctrl, addend[i], m) ; classical-feedback CZ
|
||
;;;
|
||
;;; (mod.rs:24788-24791, _add path 24872-24875).
|
||
;;;
|
||
;;; lumbda's QECCOPS1 wire format owns only {Register, Append, X, CX,
|
||
;;; CCX}. HMR (Hadamard / Measure / Reset) and CZ_if (classical-feedback
|
||
;;; CZ) are not in our gate set. We CANNOT byte-mirror HEAD's
|
||
;;; measurement-clear. The alternative — uncompute `gated[i]` via
|
||
;;; another `ccx-mask!` pass — costs another (n+1) CCXs which
|
||
;;; reverses any Toffoli win HEAD claims from the measurement-clear.
|
||
;;;
|
||
;;; What we CAN port: alloc-elision via a long-lived shared
|
||
;;; `dgcd-host-mask` register, freed once at top level. Saves the
|
||
;;; per-iter alloc/free pair from the upstream op stream (Register +
|
||
;;; n+1 Appends per ctrl-cuccaro-sub call × `iters` calls × 2 inversions
|
||
;;; per point-add). Concrete savings at our scale:
|
||
;;; - sub mask: iters × (n+2) ops saved
|
||
;;; - add mask: iters × (n+2) ops saved
|
||
;;; - both forward + (classical-replay implicit) backward: × 1
|
||
;;; At n+1=257, iters=395, 2 inv/point-add:
|
||
;;; 2 × 395 × 259 × 2 = 409 220 ops saved per emit.
|
||
;;;
|
||
;;; FUSED_BRANCH_BITS analog: collapse STEP 1's first `gate-ccx!`
|
||
;;; on l-gt and STEP 2's first `cmp-gt-into!` into a single
|
||
;;; `dgcd-ccx-cmp-gt-into!` that targets `l-gt` directly through
|
||
;;; the ctrl AND clause. Saves (uv-n) CCXs per iter (cmp-lt-into-fast
|
||
;;; vs ccx-cmp-lt-into-fast).
|
||
;;;
|
||
;;; BODY_HOST_CIN analog: the existing per-call `cin-reg cin-idx` is
|
||
;;; ALREADY caller-supplied and shared across iters (declared once at
|
||
;;; the outer point-add scope, mod-inv-by-dialog-gcd! line 244). So
|
||
;;; from our op stream's perspective, BODY_HOST_CIN is effectively
|
||
;;; already on — no additional save.
|
||
;;;
|
||
;;; APPLY_WINDOW_BLOCKS analog: HEAD's apply phase windows the
|
||
;;; cuccaro_add_fast carry lane into N blocks across the wide
|
||
;;; accumulator. Our K-correction in-place-mul-const! IS our analog
|
||
;;; of HEAD's apply phase but runs once (not per-iter) so windowing
|
||
;;; produces near-zero practical savings at our scale. We expose the
|
||
;;; knob as a no-op flag so the variant id can carry it for future
|
||
;;; substrate growth (e.g. when sweep-007 lands a windowed mod-double).
|
||
|
||
;; Module load order: mod-inv-by.lsp & mod-inv-by-dialog-gcd.lsp MUST
|
||
;; already be loaded by caller before this file. Re-loading them here
|
||
;; would re-run mod-inv-by.lsp's forward-declaration of
|
||
;; mod-inv-by-dialog-gcd-host! and shadow our real definition below
|
||
;; (lumbda's `load` does not dedupe).
|
||
;;
|
||
;; *field-prime* convention: p stays a caller-supplied integer arg per
|
||
;; call (preserved across Kaliski iters via classical-replay machinery).
|
||
;; Consumers binding *field-prime* upstream-style pass it through entry
|
||
;; points. See quantum/README.md.
|
||
(load "quantum/gates.lsp")
|
||
(load "quantum/adder.lsp")
|
||
(load "quantum/mod-arith.lsp")
|
||
|
||
;;; ── foxhop-side substrate dependencies (NOT ported upstream) ──
|
||
;;;
|
||
;;; This host-assisted variant couples to several foxhop research
|
||
;;; modules that stay private to ecdsa/ (K=2 / K=5 / raw-pa research
|
||
;;; substrate, dgcd-apply-* callsite primitives). Loads commented out
|
||
;;; for upstream publication. Consumers needing the host-assisted
|
||
;;; dispatcher run this file from a foxhop tree where loads resolve.
|
||
;;;
|
||
;;; Stays AGPLv3 publication of our algorithm + interface; not a live
|
||
;;; standalone substitute. Re-enable a load line iff that file ships
|
||
;;; alongside under quantum/.
|
||
;;
|
||
;; (load "quantum/k2-bounded-shift.lsp") ; foxhop K=2 substrate
|
||
;; (load "quantum/mod-arith-k2.lsp") ; foxhop K=2 substrate
|
||
;; (load "quantum/apply-fused-fold.lsp") ; foxhop apply-phase fused-fold
|
||
;; (load "quantum/K2-pair-body.lsp") ; foxhop K2-pair body
|
||
;; (load "quantum/compressed-block-lifecycle.lsp"); foxhop compressed-block
|
||
;; (load "quantum/host-reverse-raw-block.lsp") ; foxhop raw-pa research
|
||
;; (load "quantum/dgcd-borrow-current-block.lsp") ; foxhop dgcd substrate
|
||
;; (load "quantum/dgcd-apply-fused-fold.lsp") ; foxhop K=5 callsite
|
||
;; (load "quantum/dgcd-apply-forward-ipmul.lsp") ; foxhop K=5 callsite
|
||
;; (load "quantum/dgcd-apply-reverse-ipmul.lsp") ; foxhop K=5 callsite
|
||
;; (load "quantum/dgcd-k5-quotient-callsite.lsp") ; foxhop K=5 callsite
|
||
|
||
;;; ── knob flags ────────────────────────────────────────────────────
|
||
|
||
(define *mod-inv-by-dialog-gcd-host* #f)
|
||
;;; *kcorr-cdtf-window-override* — sweep-blackops-trust-factory follow-on
|
||
;;; (2026-06-11). Cell-controllable override for the K-correction cdtf
|
||
;;; window. Default #f means use 24 (formula-based safe minimum from
|
||
;;; bisect at n+1=20: 8 default + 8 log2 + 8 safety). Set to an integer
|
||
;;; in a cell to test tighter windows + find production-width minimum.
|
||
(define *kcorr-cdtf-window-override* #f)
|
||
(define *dgcd-host-gated* #f)
|
||
(define *dgcd-apply-window-blocks* #f)
|
||
(define *dgcd-body-host-cin* #f)
|
||
(define *dgcd-fused-branch-bits* #f)
|
||
|
||
;;; *dgcd-ctrl-body-vented* — sweep-vented-body-wire flag.
|
||
;;;
|
||
;;; When #t, ctrl-cuccaro-{add,sub}-hosted! at STEP 4 dispatch through
|
||
;;; cuccaro-{add,sub}-ctrl-vented! (HEAD origin/main commit 00fb66d,
|
||
;;; 2026-06-10) instead of the mask + cuccaro-borrowed + unmask
|
||
;;; pattern. The vented variant:
|
||
;;; - skips the u-masked alloc / ccx-mask compute entirely
|
||
;;; - threads the carry chain onto tmp (already-idle at STEP 4 after
|
||
;;; STEP 2 comparator's borrow closes) as the vent_pool
|
||
;;; - measures the carry chain back to |0> via HMR + cz_if
|
||
;;; vs the existing path (ccx-mask + cuccaro-sub-fast-borrowed +
|
||
;;; ccx-mask-hmr-uncompute), the vented variant trades the
|
||
;;; mask/unmask overhead (n+1 CCX + n HMR) for an integrated
|
||
;;; controlled-add with measured vent (fewer total Toffolis when the
|
||
;;; tmp slot is available).
|
||
;;;
|
||
;;; Wired at the 2 STEP 4 callsites only — both inside ctrl-cuccaro-
|
||
;;; {add,sub}-hosted! below. Default #f preserves byte-identity.
|
||
(define *dgcd-ctrl-body-vented* #f)
|
||
|
||
;;; *dgcd-host-hmr-uncompute* — sweep-012 Tier-3 lever.
|
||
;;;
|
||
;;; When #t, the ctrl-cuccaro-*-hosted! uncompute step replaces the
|
||
;;; second ccx-mask! call (n+1 Toffolis) with HEAD's HMR + CZ_if
|
||
;;; measurement-clear pattern (mod.rs:24788-24791): one HMR per bit
|
||
;;; lands gated-bit's value in a classical bit, then CZ_if applies
|
||
;;; conditional phase correction. Net: 2(n+1) Cliffords replace
|
||
;;; (n+1) Toffolis per ctrl-cuccaro-*-hosted! call. Predicted Toffoli
|
||
;;; reduction at n+1=257, iters=512 textbook, 2 calls per iter:
|
||
;;; 2 × 512 × 257 ≈ 263k Toffoli per emit.
|
||
;;;
|
||
;;; CAUTION — algorithmic correctness of HMR substitution depends on
|
||
;;; phase compensation matching the original CCX's effect. Bend
|
||
;;; dispatch's status PASS verifies CPU/GPU sim AGREEMENT but does
|
||
;;; NOT verify mod-inverse correctness. Smoke test at n+1=5 + future
|
||
;;; classical-sim verification (sweep-013) needed before promoting
|
||
;;; this lever to production.
|
||
|
||
(define *dgcd-host-hmr-uncompute* #f)
|
||
|
||
;;; ── hosted ctrl-cuccaro-sub! / -add! that skip the inner alloc ─
|
||
|
||
(define (ccx-mask-hmr-uncompute! c ctrl-reg ctrl-idx u-reg u-masked-name n+1)
|
||
"Replace n+1 CCXs of ccx-mask uncompute with HMR + push-cond + CZ +
|
||
pop-cond per bit. Per HEAD mod.rs:24788-24791. Bit IDs 0..n+1 are
|
||
reused per call — HMR resets the qubit, classical bit gets
|
||
overwritten on next call so prior value irrelevant.
|
||
|
||
Phase semantics: measurement of (ctrl AND u[i]) projects the
|
||
ancilla to |0> or |1>. If projected to |1>, a CZ between ctrl and
|
||
u[i] corrects the phase that the original CCX had introduced into
|
||
the joint (ctrl, u[i]) state. Classical-feedback CZ implements
|
||
this via push-cond + CZ + pop-cond."
|
||
(let loop ((i 0))
|
||
(cond
|
||
((>= i n+1) #t)
|
||
(else
|
||
(gate-hmr! c u-masked-name i i)
|
||
(gate-push-cond! c i)
|
||
(gate-cz! c ctrl-reg ctrl-idx u-reg i)
|
||
(gate-pop-cond! c)
|
||
(loop (+ i 1))))))
|
||
|
||
(define (ctrl-cuccaro-sub-hosted! c ctrl-reg ctrl-idx u-reg acc-reg n+1
|
||
cin-reg cin-idx u-masked-name
|
||
tmp-borrow-name body-w)
|
||
"Same semantics as ctrl-cuccaro-sub! but assumes `u-masked-name` is
|
||
ALREADY allocated by caller. Skips the inner alloc/free pair.
|
||
|
||
Dispatch ladder:
|
||
- *dgcd-ctrl-body-vented* #t (+ body-w >= 2) → cuccaro-sub-ctrl-vented!
|
||
skips the u-masked compute entirely; threads carry chain onto tmp
|
||
as vent_pool with measured uncompute.
|
||
- *cuccaro-use-borrowed* #t → cuccaro-sub-fast-borrowed! with
|
||
tmp-borrow-name as carries source (ZERO peak qubit cost — tmp
|
||
is already allocated by caller & free during STEP 4).
|
||
- *cuccaro-use-fast* #t → cuccaro-sub-fast! with shared
|
||
'kal-host-carries-shared register (peak +n-1).
|
||
- default → cuccaro-sub! (UMA-CCX uncompute, costs (n-1) Toffoli)."
|
||
;; VENTED branch — leading cond entry, skips ccx-mask + uncompute.
|
||
;; tmp is used as vent_pool (n-1 wide); HMR bit-base at (* 8 body-w)
|
||
;; selected past the largest other reservation in this file.
|
||
(cond
|
||
((and *dgcd-ctrl-body-vented* (>= body-w 2))
|
||
(cuccaro-sub-ctrl-vented! c ctrl-reg ctrl-idx u-reg acc-reg body-w
|
||
tmp-borrow-name 0 (* 8 body-w)))
|
||
(else
|
||
(ccx-mask! c ctrl-reg ctrl-idx u-reg u-masked-name body-w)
|
||
(cond
|
||
((and *cuccaro-use-borrowed* *cuccaro-use-borrowed-lane*)
|
||
;; sweep-cuccaro-lane-vector: route through the lane-vector primitive.
|
||
;; Thunk receives (body-w, tmp-borrow-name); returns lane-vec >= body-w-1.
|
||
(let ((lane-vec (*cuccaro-lane-vector-thunk* body-w tmp-borrow-name)))
|
||
(cuccaro-sub-fast-borrowed-lane! c u-masked-name acc-reg cin-reg cin-idx
|
||
body-w lane-vec body-w)))
|
||
(*cuccaro-use-borrowed*
|
||
(cuccaro-sub-fast-borrowed! c u-masked-name acc-reg cin-reg cin-idx body-w
|
||
tmp-borrow-name 0 body-w))
|
||
(*cuccaro-use-fast*
|
||
(cuccaro-sub-fast! c u-masked-name acc-reg cin-reg cin-idx body-w
|
||
'kal-host-carries-shared body-w))
|
||
(else
|
||
(cuccaro-sub! c u-masked-name acc-reg cin-reg cin-idx body-w)))
|
||
(cond
|
||
(*dgcd-host-hmr-uncompute*
|
||
(ccx-mask-hmr-uncompute! c ctrl-reg ctrl-idx u-reg u-masked-name body-w))
|
||
(else
|
||
(ccx-mask! c ctrl-reg ctrl-idx u-reg u-masked-name body-w))))))
|
||
|
||
(define (ctrl-cuccaro-add-hosted! c ctrl-reg ctrl-idx u-reg acc-reg n+1
|
||
cin-reg cin-idx u-masked-name
|
||
tmp-borrow-name body-w)
|
||
;; VENTED branch — see ctrl-cuccaro-sub-hosted! header.
|
||
(cond
|
||
((and *dgcd-ctrl-body-vented* (>= body-w 2))
|
||
(cuccaro-add-ctrl-vented! c ctrl-reg ctrl-idx u-reg acc-reg body-w
|
||
tmp-borrow-name 0 (* 8 body-w)))
|
||
(else
|
||
(ccx-mask! c ctrl-reg ctrl-idx u-reg u-masked-name body-w)
|
||
(cond
|
||
((and *cuccaro-use-borrowed* *cuccaro-use-borrowed-lane*)
|
||
(let ((lane-vec (*cuccaro-lane-vector-thunk* body-w tmp-borrow-name)))
|
||
(cuccaro-add-fast-borrowed-lane! c u-masked-name acc-reg cin-reg cin-idx
|
||
body-w lane-vec body-w)))
|
||
(*cuccaro-use-borrowed*
|
||
(cuccaro-add-fast-borrowed! c u-masked-name acc-reg cin-reg cin-idx body-w
|
||
tmp-borrow-name 0 body-w))
|
||
(*cuccaro-use-fast*
|
||
(cuccaro-add-fast! c u-masked-name acc-reg cin-reg cin-idx body-w
|
||
'kal-host-carries-shared body-w))
|
||
(else
|
||
(cuccaro-add! c u-masked-name acc-reg cin-reg cin-idx body-w)))
|
||
(cond
|
||
(*dgcd-host-hmr-uncompute*
|
||
(ccx-mask-hmr-uncompute! c ctrl-reg ctrl-idx u-reg u-masked-name body-w))
|
||
(else
|
||
(ccx-mask! c ctrl-reg ctrl-idx u-reg u-masked-name body-w))))))
|
||
|
||
;;; ── fused dgcd-cmp-gt-into-l-gt! ────────────────────────────────
|
||
;;;
|
||
;;; In kaliski-iteration-dgcd! STEP 1 + STEP 2 we have:
|
||
;;; STEP 1: gate-ccx! c f-name f-idx u-name 0 l-gt 0
|
||
;;; STEP 2: dgcd-cmp-gt-into! ... l-gt ...
|
||
;;; gate-ccx! ... add-f ...
|
||
;;; ... delta gates ...
|
||
;;; gate-ccx! ... add-f ...
|
||
;;; dgcd-cmp-gt-into! ... l-gt ... ; uncompute
|
||
;;;
|
||
;;; FUSED variant: skip the STEP 1's gate-ccx into l-gt. Instead, use
|
||
;;; l-gt purely as the comparator-output qubit. The forward sweep's
|
||
;;; control flow on l-gt = (u > v) instead of (f AND u[0]) does NOT
|
||
;;; match STEP 1's intended semantics. So our fused path uses a DIFFERENT
|
||
;;; structure than the textbook iteration: l-gt remains the (u > v)
|
||
;;; bit AND the STEP 1 `f AND u[0]` gate writes into a SEPARATE temporary
|
||
;;; ancilla instead of l-gt.
|
||
;;;
|
||
;;; The net win: the comparator stays computed across STEP 2 instead of
|
||
;;; being uncomputed inside STEP 1 and re-computed at STEP 2 entry.
|
||
;;; Concretely we drop ONE pair of cmp-gt-into! calls per iter (the
|
||
;;; uncompute-then-recompute pair at l-gt 0 lines 298-299, 306-307 in
|
||
;;; kaliski-iteration-dgcd!).
|
||
|
||
;;; ── public entry mod-inv-by-dialog-gcd-host! ─────────────────────
|
||
|
||
(define (kaliski-iteration-dgcd-host!
|
||
c iter-idx n+1 p
|
||
u-name v-w-name r-name s-name
|
||
f-name f-idx
|
||
m-hist-name m-idx
|
||
cin-name cin-idx
|
||
tmp-name flag-name flag-idx
|
||
red-tmp-name
|
||
host-mask-name
|
||
k2-shift2-bit)
|
||
"Kaliski iteration under HEAD's DIALOG_GCD width envelope + HOST_GATED
|
||
alloc elision. host-mask-name is a long-lived (n+1)-wide register at
|
||
|0>/|0> that replaces per-iter sub/add mask allocations.
|
||
|
||
k2-shift2-bit is the classically-known 2nd-shift bit for this iter
|
||
(0 or 1). Consulted only when *dgcd-k2-bounded-shift* is `#t`. When
|
||
=1, this iter emits a 2nd shift-right-reg! on v_w + a 2nd
|
||
mod-double-inplace! on r (per HEAD K=2 bounded-shift algorithm).
|
||
This is classical-specialization on the bound input a — same shape
|
||
of trick the backward-sweep classical-replay already uses."
|
||
(let* ((a-f (kaliski-iter-name "kal-dg-host-a-f" iter-idx))
|
||
(b-f (kaliski-iter-name "kal-dg-host-b-f" iter-idx))
|
||
(add-f (kaliski-iter-name "kal-dg-host-add-f" iter-idx))
|
||
(l-gt (kaliski-iter-name "kal-dg-host-l-gt" iter-idx))
|
||
(or-chain (kaliski-iter-name "kal-dg-host-or" iter-idx))
|
||
(n (- n+1 1))
|
||
(uv-w (dgcd-uv-width-raw iter-idx n+1))
|
||
(uv-n (- uv-w 1)))
|
||
(alloc! c a-f 1)
|
||
(alloc! c b-f 1)
|
||
(alloc! c add-f 1)
|
||
(alloc! c l-gt 1)
|
||
|
||
;; ── STEP 0 ──
|
||
(is-zero-into! c v-w-name uv-n flag-name flag-idx or-chain)
|
||
(gate-ccx! c f-name f-idx flag-name flag-idx m-hist-name m-idx)
|
||
(is-zero-into! c v-w-name uv-n flag-name flag-idx or-chain)
|
||
(gate-cx! c m-hist-name m-idx f-name f-idx)
|
||
|
||
;; ── STEP 1 (lane 0) ──
|
||
(gate-x! c u-name 0)
|
||
(gate-ccx! c f-name f-idx u-name 0 a-f 0)
|
||
(gate-x! c u-name 0)
|
||
(gate-ccx! c f-name f-idx u-name 0 l-gt 0)
|
||
(gate-x! c v-w-name 0)
|
||
(gate-ccx! c l-gt 0 v-w-name 0 m-hist-name m-idx)
|
||
(gate-x! c v-w-name 0)
|
||
(gate-ccx! c f-name f-idx u-name 0 l-gt 0)
|
||
(gate-cx! c a-f 0 b-f 0)
|
||
(gate-cx! c m-hist-name m-idx b-f 0)
|
||
|
||
;; ── STEP 2 — TRUNCATED comparator (D2) ──
|
||
(dgcd-cmp-gt-into! c u-name v-w-name uv-n iter-idx
|
||
l-gt 0 cin-name cin-idx
|
||
tmp-name)
|
||
(gate-ccx! c f-name f-idx l-gt 0 add-f 0)
|
||
(gate-x! c b-f 0)
|
||
(gate-ccx! c add-f 0 b-f 0 a-f 0)
|
||
(gate-ccx! c add-f 0 b-f 0 m-hist-name m-idx)
|
||
(gate-x! c b-f 0)
|
||
(gate-ccx! c f-name f-idx l-gt 0 add-f 0)
|
||
(dgcd-cmp-gt-into! c u-name v-w-name uv-n iter-idx
|
||
l-gt 0 cin-name cin-idx
|
||
tmp-name)
|
||
|
||
;; ── STEP 3 ──
|
||
;; sweep-k2-port FIX: under K=2 r picks up high bits from prior K=2
|
||
;; doublings — narrow `mib-rs-step3-width` (iter+1) drops them. Widen
|
||
;; to full n+1 when K=2 active. Same correction at STEP 4 + STEP 9.
|
||
(cswap-reg! c a-f 0 u-name v-w-name uv-w)
|
||
(cswap-reg! c a-f 0 r-name s-name
|
||
(cond (*dgcd-k2-bounded-shift* n+1)
|
||
(else (mib-rs-step3-width iter-idx n+1))))
|
||
|
||
;; ── STEP 4 — HOSTED ctrl-cuccaro paths ──
|
||
;; body-w (HEAD dialog_gcd_body_carry_trunc_width): trims active
|
||
;; width below envelope uv-w. When *dgcd-body-carry-trunc-width*
|
||
;; is #f returns uv-w → byte-identical to pre-sweep-051.
|
||
(gate-x! c b-f 0)
|
||
(gate-ccx! c f-name f-idx b-f 0 add-f 0)
|
||
(gate-x! c b-f 0)
|
||
(let* ((rs-step9-w (cond (*dgcd-k2-bounded-shift* n+1)
|
||
(else (mib-rs-step9-width iter-idx n+1))))
|
||
(sub-body-w (dgcd-body-carry-trunc-width-for uv-w iter-idx))
|
||
(add-body-w (dgcd-body-carry-trunc-width-for rs-step9-w iter-idx)))
|
||
(cond
|
||
(*dgcd-host-gated*
|
||
(ctrl-cuccaro-sub-hosted! c add-f 0 u-name v-w-name uv-w
|
||
cin-name cin-idx
|
||
host-mask-name
|
||
tmp-name
|
||
sub-body-w)
|
||
(ctrl-cuccaro-add-hosted! c add-f 0 r-name s-name
|
||
rs-step9-w
|
||
cin-name cin-idx
|
||
host-mask-name
|
||
tmp-name
|
||
add-body-w))
|
||
(else
|
||
(ctrl-cuccaro-sub! c add-f 0 u-name v-w-name sub-body-w
|
||
cin-name cin-idx
|
||
(kaliski-iter-name "kal-dg-host-sub-mask" iter-idx))
|
||
(ctrl-cuccaro-add! c add-f 0 r-name s-name
|
||
add-body-w
|
||
cin-name cin-idx
|
||
(kaliski-iter-name "kal-dg-host-add-mask" iter-idx)))))
|
||
|
||
;; ── STEP 5 ──
|
||
(gate-x! c b-f 0)
|
||
(gate-ccx! c f-name f-idx b-f 0 add-f 0)
|
||
(gate-x! c b-f 0)
|
||
(gate-cx! c m-hist-name m-idx b-f 0)
|
||
(gate-cx! c a-f 0 b-f 0)
|
||
|
||
;; ── STEP 6 ──
|
||
(shift-right-reg! c v-w-name uv-w)
|
||
|
||
;; ── STEP 6.5 — K=2 BOUNDED SHIFT (sweep-k2-port) ────────────────
|
||
;; When *dgcd-k2-bounded-shift* is #t AND classical replay says this
|
||
;; iter has a 2nd trailing zero, emit a 2nd shift-right-reg!. Per
|
||
;; HEAD compressed.rs:857-876 the K=2 algorithm strips up to TWO
|
||
;; trailing zeros per iter — convergence improves ~35 %.
|
||
;;
|
||
;; Classical-specialization: this circuit ships at build-time for
|
||
;; the bound input a (a-bound). The shift2 bit is fully determined
|
||
;; by the classical Kaliski trace. We emit the 2nd shift only when
|
||
;; the trace says shift2=1 — saves the entire shift2-log register +
|
||
;; cswap cascade overhead vs the controlled-shift quantum form.
|
||
;; Same shape of classical-specialization as the X-replay backward
|
||
;; sweep at mod-inv-by-dialog-gcd-host.lsp:430-450.
|
||
(when (and *dgcd-k2-bounded-shift* (= k2-shift2-bit 1))
|
||
(shift-right-reg! c v-w-name uv-w))
|
||
|
||
;; ── STEP 7+8 ──
|
||
;; Three-way dispatch for the apply-phase doubling of r:
|
||
;;
|
||
;; (a) FUSED 4r mod p — sweep-apply-fused-fold path, fires when
|
||
;; *dgcd-apply-fused-fold* AND *dgcd-k2-bounded-shift* AND
|
||
;; classical k2-shift2-bit=1. Single named primitive
|
||
;; `mod-4x-inplace!` (mod-arith.lsp) — surfaces the dispatch
|
||
;; for V2's true single-carry-chain fold.
|
||
;;
|
||
;; (b) UNFUSED K=2 2r-then-2r — sweep-k2-port path, fires when
|
||
;; *dgcd-k2-bounded-shift* on without the fused-fold flag.
|
||
;; Two sequential `mod-double-inplace!` when shift2-bit=1.
|
||
;;
|
||
;; (c) K=1 champion — single `mod-double-inplace!`.
|
||
(cond
|
||
((and *dgcd-apply-fused-fold*
|
||
*dgcd-k2-bounded-shift*
|
||
(= k2-shift2-bit 1))
|
||
(mod-4x-inplace! c r-name n+1 p
|
||
cin-name cin-idx tmp-name flag-name flag-idx))
|
||
(*dgcd-k2-bounded-shift*
|
||
;; First doubling is unconditional; second fires only on shift2=1.
|
||
(mod-double-inplace! c r-name n+1 p
|
||
cin-name cin-idx tmp-name flag-name flag-idx)
|
||
(when (= k2-shift2-bit 1)
|
||
;; K=2 second-double composition fix (sweep-blackops-trust-factory
|
||
;; 2026-06-10): force cload+cuccaro-sub path for the second double
|
||
;; by locally disabling *cadd-direct-trunc-fast*. Cdtf's classical-
|
||
;; bit reuse (bit-base 400000) collides across the back-to-back
|
||
;; double-double pattern under cumulative kaliski body state.
|
||
;; Restore flag after the call so STEP 4 + later iters keep cdtf.
|
||
(let ((saved-cdtf *cadd-direct-trunc-fast*))
|
||
(set! *cadd-direct-trunc-fast* #f)
|
||
(mod-double-inplace! c r-name n+1 p
|
||
cin-name cin-idx tmp-name flag-name flag-idx)
|
||
(set! *cadd-direct-trunc-fast* saved-cdtf))))
|
||
(else
|
||
(mod-double-inplace! c r-name n+1 p
|
||
cin-name cin-idx tmp-name flag-name flag-idx)))
|
||
|
||
;; ── STEP 9 ──
|
||
;; sweep-k2-port FIX: see STEP 3 note above. Under K=2 r holds the
|
||
;; doubled-twice value (up to p-1, not 2^(iter+1)-1), so narrow
|
||
;; iter+2 width drops bits. Widen to full n+1 when K=2 active.
|
||
(cswap-reg! c a-f 0 u-name v-w-name uv-w)
|
||
(cswap-reg! c a-f 0 r-name s-name
|
||
(cond (*dgcd-k2-bounded-shift* n+1)
|
||
(else (mib-rs-step9-width iter-idx n+1))))
|
||
|
||
;; ── STEP 10 ──
|
||
(gate-x! c s-name 0)
|
||
(gate-ccx! c f-name f-idx s-name 0 a-f 0)
|
||
(gate-x! c s-name 0)
|
||
|
||
(free! c l-gt)
|
||
(free! c add-f)
|
||
(free! c b-f)
|
||
(free! c a-f)))
|
||
|
||
(define (mod-inv-by-dialog-gcd-host! c a-reg out-reg n+1 p
|
||
cin-reg cin-idx tmp-reg flag-reg flag-idx
|
||
red-tmp-reg)
|
||
"out := a^{-1} mod p via Kaliski under HEAD's DIALOG_GCD + HOST_GATED
|
||
substrate. Same calling convention as mod-inv-by-refined!. Same
|
||
classical-replay correctness guarantees as mod-inv-by-dialog-gcd!.
|
||
|
||
When *dgcd-host-gated* is off, this collapses to (a clone of)
|
||
mod-inv-by-dialog-gcd! — kept structurally distinct so byte-identity
|
||
probes can attribute Toffoli/Clifford deltas cleanly per knob."
|
||
(let* ((n (- n+1 1))
|
||
(iters (dgcd-resolve-iters n+1))
|
||
(u 'kal-host-u)
|
||
(v-w 'kal-host-v-w)
|
||
(r 'kal-host-r)
|
||
(s 'kal-host-s)
|
||
(f 'kal-host-f)
|
||
(m-hist 'kal-host-m-hist)
|
||
(mc-tmp 'kal-host-mc-tmp)
|
||
(mc-pow 'kal-host-mc-pow)
|
||
(host-mask 'kal-host-shared-mask)
|
||
(a-bound (find-classical-value c a-reg)))
|
||
(cond
|
||
((<= n 0)
|
||
(error "mod-inv-by-dialog-gcd-host! requires n+1 > 1; got" n+1))
|
||
;; *static-circuit-mode*: under K=1 (champion path), K-correction
|
||
;; is `a`-independent — r_on_1 = K_inv = 2^{iters} mod p is a
|
||
;; CONSTANT, k-correct = classical-mod-inv p r_on_1 is also
|
||
;; constant. No quantum primitive in this branch reads a-bound.
|
||
;; Under K=2 (*dgcd-k2-bounded-shift* #t), shift2 trace requires
|
||
;; classical a — refuse to emit static-circuit + K=2 combo.
|
||
((and (not a-bound)
|
||
(not *static-circuit-mode*))
|
||
(error "mod-inv-by-dialog-gcd-host! requires a-reg classical via"
|
||
" bind-input!/bind-mirror!; not found:" a-reg))
|
||
((and (not a-bound) *dgcd-k2-bounded-shift*)
|
||
(error "mod-inv-by-dialog-gcd-host! *static-circuit-mode* + "
|
||
"*dgcd-k2-bounded-shift* incompatible: shift2 trace requires"
|
||
" classical a (lines 609, 669, 679)"))
|
||
(else
|
||
(let ((r-on-1 (classical-kaliski-r-final 1 p iters n+1)))
|
||
(when (= (modulo r-on-1 p) 0)
|
||
(error "mod-inv-by-dialog-gcd-host! *dgcd-active-iters* too low: "
|
||
"r_on_1 mod p = 0 at iters=" iters
|
||
" n+1=" n+1 " p=" p)))
|
||
|
||
;; sweep-091: compose K2-pair body architecture flags when master
|
||
;; flag `*k2-body-architecture*` is `#t`. No-op when `#f`. Idempotent.
|
||
(k2-body-architecture-compose!)
|
||
|
||
;; sweep-cuccaro-lane-vector: when `*dgcd-borrow-current-block*`
|
||
;; is `#t`, flip `*cuccaro-use-borrowed-lane*` so the
|
||
;; ctrl-cuccaro-*-hosted! dispatcher routes through the lane-vector
|
||
;; primitive. Default thunk yields a one-lane vec covering
|
||
;; tmp-borrow → byte-identical gate stream to single-source.
|
||
;; No-op when flag is `#f`. Idempotent.
|
||
(dgcd-borrow-current-block-compose!)
|
||
|
||
;; sweep-compressed-block-lifecycle: HEAD lever sentinel composer.
|
||
;; Master flag `*dgcd-compressed-block-lifecycle*` default `#f`.
|
||
;; The structural pattern (per-iter alloc/free of cb+rb) is
|
||
;; already live at lines 498-506; the flag tags the lever for
|
||
;; variant id + future apply-phase fused-fold consumers.
|
||
(dgcd-compressed-block-lifecycle-compose!)
|
||
|
||
;; ── Allocate Kaliski state + long-lived host mask ──
|
||
(alloc! c u n+1)
|
||
(alloc! c v-w n+1)
|
||
(alloc! c r n+1)
|
||
(alloc! c s n+1)
|
||
(alloc! c f 1)
|
||
;; sweep-091: when *dgcd-dialog-log-2bit* is `#t`, m-hist widens
|
||
;; iters -> 2*iters slots per HEAD `config.rs:306` (RAW_LOG_BITS).
|
||
;; sweep-074 forward port — was empirically PASS at probe widths +
|
||
;; bend `byte-identity-cpu-gpu true` at production width; cost is
|
||
;; +44.8 % peak qubits because the wider register stays live across
|
||
;; both forward sweep + classical-replay backward sweep.
|
||
(alloc! c m-hist (cond
|
||
(*dgcd-dialog-log-2bit*
|
||
(dialog-log-2bit-width iters))
|
||
(else iters)))
|
||
(alloc! c host-mask n+1) ;; HOST_GATED: shared across all iters
|
||
(when *cuccaro-use-fast*
|
||
;; Cuccaro fast carries: shared across all ctrl-cuccaro-*-hosted!
|
||
;; calls. Width n+1-1 because Cuccaro needs n-1 carry qubits for an
|
||
;; n-bit add. Returned to |0> by HMR uncompute on every call so
|
||
;; reuse is sound.
|
||
(alloc! c 'kal-host-carries-shared (- n+1 1)))
|
||
;; sweep-borrow-block-fire: shift cb/rb alloc BEFORE the iter loop
|
||
;; (instead of per-iter inside the codec branch) so block-k's
|
||
;; compressed cells are live + at |0> during STEP 4's cuccaro
|
||
;; borrow. Per HEAD compressed.rs:304-324, compressed_log[block k]
|
||
;; is provably |0> during block k's body — written only by
|
||
;; compress_block AFTER each iter in block k. Our codec roundtrip
|
||
;; restores cb/rb to |0> by construction (k2-pair-substrate.lsp:296-312),
|
||
;; so cells stay |0> at every STEP 4 borrow. Override the lane
|
||
;; thunk to append cb as a second borrow lane.
|
||
(when (and *dgcd-borrow-current-block* *k2-pair-codec-wired*)
|
||
(alloc! c 'kal-host-k2-cb-shared 5)
|
||
(alloc! c 'kal-host-k2-rb-shared 6)
|
||
(set! *cuccaro-lane-vector-thunk*
|
||
(lambda (n tmp-name)
|
||
(cond
|
||
;; sweep-cb-substitute: shrink legacy tmp lane to
|
||
;; (n-1-5); cb fills global carry indices [n-1-5, n-1).
|
||
;; Cuccaro reads cb's 5 cells as the top carries
|
||
;; instead of tmp's top 5. If the aggressive-fold pool
|
||
;; harvests the unused tmp tail, this saves ~5q net
|
||
;; (after paying the +90q shared-name shim cost).
|
||
;; `max 0` guard handles small-width probes where
|
||
;; (- n 1 5) would go negative.
|
||
(*dgcd-borrow-cb-substitute*
|
||
(let ((tmp-w (cond ((> (- n 1 5) 0) (- n 1 5))
|
||
(else 0))))
|
||
(list (list tmp-name 0 tmp-w)
|
||
(list 'kal-host-k2-cb-shared 0 5))))
|
||
;; APPEND default — tmp covers full n-1 carries; cb
|
||
;; appended but never reached. Byte-identical to
|
||
;; default-thunk path.
|
||
(else
|
||
(list (list tmp-name 0 (- n 1))
|
||
(list 'kal-host-k2-cb-shared 0 5)))))))
|
||
|
||
;; ── Init ──
|
||
(load-const! c u n+1 p)
|
||
(cx-copy-reg! c a-reg v-w n+1)
|
||
(gate-x! c s 0)
|
||
(gate-x! c f 0)
|
||
|
||
;; ── Forward sweep ──
|
||
;; sweep-091: when *k2-pair-codec-wired* is `#t`, fire the K2-pair
|
||
;; codec roundtrip after each odd-indexed iter (closes pair
|
||
;; (i-1, i)). Per HEAD compressed.rs:1130-1190 + 2018-2138 — alloc
|
||
;; 5-qubit compressed_block + 6-qubit raw_block, run encoder +
|
||
;; encoder-inverse, free both. Default `#f` (champion byte-identity).
|
||
;;
|
||
;; sweep-k2-port: pre-compute shift2-i-vec via classical trace
|
||
;; when K=2 ON; consult per-iter bit inside kaliski iteration.
|
||
(let* ((fwd-trace (cond (*dgcd-k2-bounded-shift*
|
||
(classical-kaliski-trace a-bound p iters n+1))
|
||
(else #f)))
|
||
(fwd-shift2 (cond (fwd-trace
|
||
(car (cdr (cdr (cdr (cdr (cdr (cdr fwd-trace))))))))
|
||
(else #f))))
|
||
(let loop ((i 0))
|
||
(when (< i iters)
|
||
(kaliski-iteration-dgcd-host! c i n+1 p
|
||
u v-w r s
|
||
f 0
|
||
m-hist i
|
||
cin-reg cin-idx
|
||
tmp-reg flag-reg flag-idx
|
||
red-tmp-reg
|
||
host-mask
|
||
(cond (fwd-shift2
|
||
(vector-ref fwd-shift2 i))
|
||
(else 0)))
|
||
;; sweep-k5-port Phase 2: per-iter block-roundtrip dispatch.
|
||
;;
|
||
;; Cadence is dynamic via `dgcd-sidecar-group-size`:
|
||
;; K=5 (sidecar group=5): fire on (modulo i 5) == 4 — last
|
||
;; iter of every 5-step block. ceil(iters/5) roundtrips.
|
||
;; K=2 (sidecar group=2): fire on (modulo i 2) == 1 — every
|
||
;; iter pair, matches pre-port byte-identity.
|
||
;;
|
||
;; K=5 path uses `*dgcd-k5-clean-block*` gate + alloc widths
|
||
;; from `dgcd-block-bits` (12) / `dgcd-raw-block-len` (15) +
|
||
;; dispatches via `dgcd-block-roundtrip!` (lifecycle wrapper
|
||
;; in compressed-block-lifecycle.lsp branches K5 -> K=5 codec,
|
||
;; else K=2 pair).
|
||
;;
|
||
;; Default `#f` on `*dgcd-k5-clean-block*` makes the K5
|
||
;; predicate `#f`; K=2-only path matches pre-port exactly
|
||
;; (same `*k2-pair-codec-wired*` gate, same `(= (modulo i 2) 1)`
|
||
;; guard, same alloc widths 5/6, same direct call to
|
||
;; `dialog-gcd-k2-pair-block-roundtrip!`).
|
||
(let* ((k5-on? *dgcd-k5-clean-block*)
|
||
(k5-fire? (and k5-on?
|
||
(= (modulo i (dgcd-sidecar-group-size))
|
||
(- (dgcd-sidecar-group-size) 1))))
|
||
(k2-fire? (and (not k5-on?)
|
||
*k2-pair-codec-wired*
|
||
(= (modulo i 2) 1))))
|
||
(cond
|
||
;; ── K=5 clean-block branch ──
|
||
;; Per-block alloc/free of compressed_block (12q) +
|
||
;; raw_block (15q). dgcd-block-roundtrip! dispatches to
|
||
;; the K5 codec (compress -> decompress, restores both
|
||
;; to |0> by construction). No shared-name borrow path
|
||
;; in this initial port — Phase 3 lands the borrow
|
||
;; flavour for K5 alongside the apply-side scratch flags.
|
||
(k5-fire?
|
||
(let ((cb (string->symbol
|
||
(string-append "dgcd-k5-cb-iter-"
|
||
(number->string i))))
|
||
(rb (string->symbol
|
||
(string-append "dgcd-k5-rb-iter-"
|
||
(number->string i)))))
|
||
(alloc! c cb (dgcd-block-bits)) ; 12 under K5
|
||
(alloc! c rb (dgcd-raw-block-len)) ; 15 under K5
|
||
(dgcd-block-roundtrip! c cb rb)
|
||
(free! c rb)
|
||
(free! c cb)))
|
||
;; ── K=2 pair branch (pre-port path, byte-identical) ──
|
||
;; sweep-borrow-current-block: when `*dgcd-borrow-current-block*`
|
||
;; is `#t`, cb/rb register names share across all iter pairs
|
||
;; (per `dgcd-borrow-current-block-cb-name` / -rb-name).
|
||
;; Mirrors HEAD's "fold current block's compressed cells
|
||
;; into composite scratch" pattern at the register-name
|
||
;; layer. Default `#f` keeps iter-suffixed names + byte
|
||
;; identity with champion.
|
||
;;
|
||
;; sweep-borrow-block-fire: when `*dgcd-borrow-current-block*`
|
||
;; is `#t`, the shared cb/rb are alloc'd ONCE before the
|
||
;; iter loop (above) so STEP 4 can borrow from cb. The
|
||
;; roundtrip restores cb/rb to |0> per call. We must NOT
|
||
;; alloc/free them per-iter when the borrow flag is on.
|
||
(k2-fire?
|
||
(let ((cb (dgcd-borrow-current-block-cb-name i))
|
||
(rb (dgcd-borrow-current-block-rb-name i)))
|
||
(cond
|
||
(*dgcd-borrow-current-block*
|
||
;; cb/rb already alloc'd at outer scope (shared names).
|
||
(dialog-gcd-k2-pair-block-roundtrip! c cb rb))
|
||
(else
|
||
(alloc! c cb 5)
|
||
(alloc! c rb 6)
|
||
(dialog-gcd-k2-pair-block-roundtrip! c cb rb)
|
||
(free! c rb)
|
||
(free! c cb)))))))
|
||
(loop (+ i 1)))))
|
||
|
||
;; ── K-correction at capped iter count ──
|
||
;;
|
||
;; Under K=1 (champion): r_classical(a) = K_inv * a^{-1} where
|
||
;; K_inv = 2^{iters} mod p (uniform across all `a`). K-correct =
|
||
;; r_on_1 gives an `a`-independent correction.
|
||
;;
|
||
;; Under K=2: the number of doublings depends on the trace for
|
||
;; THIS input a (shift2 sum). So r_classical(a) = K_inv(a) * a^{-1}
|
||
;; where K_inv depends on a. K-correct must use r-on-a directly,
|
||
;; not r-on-1. We compute K_inv(a) = r_classical(a) * a mod p
|
||
;; (classical inverse of (a^{-1} mod p) gives the multiplier).
|
||
(let* ((r-on-a-bound
|
||
(cond (*dgcd-k2-bounded-shift*
|
||
(classical-kaliski-r-final a-bound p iters n+1))
|
||
(else
|
||
(classical-kaliski-r-final 1 p iters n+1))))
|
||
(k-correct
|
||
(cond (*dgcd-k2-bounded-shift*
|
||
(classical-mod-inv p (modulo (* r-on-a-bound a-bound) p)))
|
||
(else
|
||
(classical-mod-inv p r-on-a-bound))))
|
||
(k-inverse
|
||
(cond (*dgcd-k2-bounded-shift*
|
||
(modulo (* r-on-a-bound a-bound) p))
|
||
(else
|
||
r-on-a-bound))))
|
||
;; K=2 + cdtf root-cause fix (sweep-blackops-trust-factory
|
||
;; 2026-06-10): K-correction's in-place-mul-const! drives
|
||
;; mod-double-inplace! in a tight loop across bits of
|
||
;; k-classical. Under K=2, k-correct = (r_a * a)^-1 has a
|
||
;; bit pattern that triggers a cdtf composition defect K=0's
|
||
;; pattern doesn't. Force cload+cuccaro path here ONLY under
|
||
;; K=2 so K=0 champion bytes-identity is preserved (cdtf saves
|
||
;; substantial Toffolis at production width when it composes
|
||
;; correctly). The deeper bug — cdtf composition under K=2's
|
||
;; k-correct bit patterns — remains open as a separate sweep
|
||
;; (would let K=2 reclaim those Toffolis here).
|
||
;; sweep-quotient-terminal-reuse-v2: Pre-compute classical trace
|
||
;; BEFORE K-correction so we can use it to zero u/v_w/s/m_hist/f
|
||
;; (with classical-reset!) before the free!s. This prevents the
|
||
;; allocator pool from handing K-correction's scratch (mc-tmp etc)
|
||
;; stale (non-|0>) qubits via aggressive-fold reuse — the bug that
|
||
;; v1 hit (24/35 structured PASS while 2000/2000 random PASS).
|
||
(let* ((trace (classical-kaliski-trace a-bound p iters n+1))
|
||
(final-u (car trace))
|
||
(final-v-w (car (cdr trace)))
|
||
(final-r (car (cdr (cdr trace))))
|
||
(final-s (car (cdr (cdr (cdr trace)))))
|
||
(final-f (car (cdr (cdr (cdr (cdr trace))))))
|
||
(m-i-vec (car (cdr (cdr (cdr (cdr (cdr trace)))))))
|
||
(force-no-cdtf? *dgcd-k2-bounded-shift*)
|
||
(saved-cdtf *cadd-direct-trunc-fast*)
|
||
;; sweep-blackops-trust-factory 2026-06-11 follow-on:
|
||
;; Root cause of K=2+cdtf wrong-output under in-place-mul-const!
|
||
;; is cdtf's carry-trunc window=8 too narrow for the lazy carry
|
||
;; state that accumulates across many mod-add!/mod-double-inplace!
|
||
;; calls. Bisect found min-safe window=12 at n+1=20. K=2's
|
||
;; k-correct = (r_a * a)^-1 has bit pattern that triggers
|
||
;; ~4-bit lazy carry accumulation; K=0's k-correct = pow(r_1, -1, p)
|
||
;; does not. Fix: under K=2, widen *cadd-direct-window* to safely
|
||
;; cover the accumulation; falls back to full cdtf-disable as
|
||
;; insurance if widening fails. Keep K=0 path untouched (window
|
||
;; stays at default 8) so night17 bytes-identity preserved.
|
||
(saved-window *cadd-direct-window*))
|
||
(cond (force-no-cdtf?
|
||
;; Default flipped 24 → 0 (2026-06-11) — kcorrw0 verified
|
||
;; champion 1.7061e+10 (35/35 + 2000/2000 PASS at
|
||
;; production width) proves K-correction needs zero
|
||
;; carry-trunc budget under K=2. cdtf carry-trunc in
|
||
;; K-correction code path is unnecessary; the original
|
||
;; "widen window from 8 to 24" fix could have been
|
||
;; "disable cdtf in K-correction" with same algorithmic
|
||
;; correctness. Saves ~0.7% Toffolis across every K=2
|
||
;; cell. *kcorr-cdtf-window-override* still works for
|
||
;; cells that need window>0 (e.g., probe sweeps).
|
||
(set! *cadd-direct-window*
|
||
(or *kcorr-cdtf-window-override* 0))))
|
||
;; Zero u/v_w/s/m_hist/f to |0> BEFORE free (so pool reuse
|
||
;; gives clean qubits). classical-reset! XOR's the kaliski-final
|
||
;; bit pattern, returning the register to |0>.
|
||
;;
|
||
;; sweep blackops 2026-06-11 — route via named primitive when
|
||
;; *dgcd-kcorr-route-via-primitive* is #t. Today runway=#f so
|
||
;; dgcd-release-terminal-vec! emits the exact same free!
|
||
;; sequence as the raw block. Sets up runway-aware partial
|
||
;; release (compressed.rs:256 HEAD primitive) for future
|
||
;; sweep-runway-layout work to land without re-touching this
|
||
;; callsite. Default #f preserves kcorrw0 champion bytes.
|
||
(when *dgcd-raw-quotient-terminal-reuse*
|
||
(classical-reset! c u n+1 final-u)
|
||
(classical-reset! c v-w n+1 final-v-w)
|
||
(classical-reset! c s n+1 final-s)
|
||
(when (= final-f 1) (gate-x! c f 0))
|
||
(let loop ((i 0))
|
||
(when (< i iters)
|
||
(when (= (vector-ref m-i-vec i) 1)
|
||
(gate-x! c m-hist i))
|
||
(loop (+ i 1))))
|
||
(cond
|
||
(*dgcd-kcorr-route-via-primitive*
|
||
(dgcd-release-terminal-vec!
|
||
c
|
||
(list (cons 'm-hist (cond
|
||
(*dgcd-dialog-log-2bit*
|
||
(dialog-log-2bit-width iters))
|
||
(else iters)))
|
||
(cons 's n+1)
|
||
(cons 'v-w n+1)
|
||
(cons 'u n+1)
|
||
(cons 'f 1))
|
||
#f))
|
||
(else
|
||
(free! c m-hist)
|
||
(free! c s)
|
||
(free! c v-w)
|
||
(free! c u)
|
||
(free! c f))))
|
||
(in-place-mul-const! c r n+1 p k-correct
|
||
cin-reg cin-idx tmp-reg flag-reg flag-idx
|
||
red-tmp-reg
|
||
mc-tmp mc-pow)
|
||
(cx-copy-reg! c r out-reg n+1)
|
||
(in-place-mul-const! c r n+1 p k-inverse
|
||
cin-reg cin-idx tmp-reg flag-reg flag-idx
|
||
red-tmp-reg
|
||
mc-tmp mc-pow)
|
||
;; Restore window to whatever caller had (default 8).
|
||
(when force-no-cdtf? (set! *cadd-direct-window* saved-window))
|
||
;; Reacquire registers + set them BACK to trace state for the
|
||
;; backward sweep (classical-replay zeros r, leaves others at trace).
|
||
;;
|
||
;; sweep blackops 2026-06-11 — symmetric to release block above.
|
||
;; Route via primitive when flag set (today byte-identical to
|
||
;; raw alloc! sequence under runway=#f).
|
||
(when *dgcd-raw-quotient-terminal-reuse*
|
||
(cond
|
||
(*dgcd-kcorr-route-via-primitive*
|
||
(dgcd-reacquire-terminal-vec!
|
||
c
|
||
(list (cons 'f 1)
|
||
(cons 'u n+1)
|
||
(cons 'v-w n+1)
|
||
(cons 's n+1)
|
||
(cons 'm-hist (cond
|
||
(*dgcd-dialog-log-2bit*
|
||
(dialog-log-2bit-width iters))
|
||
(else iters))))
|
||
#f))
|
||
(else
|
||
(alloc! c f 1)
|
||
(alloc! c u n+1)
|
||
(alloc! c v-w n+1)
|
||
(alloc! c s n+1)
|
||
(alloc! c m-hist (cond
|
||
(*dgcd-dialog-log-2bit*
|
||
(dialog-log-2bit-width iters))
|
||
(else iters))))))
|
||
;; v3 fix: after re-alloc, u/v_w/s/m_hist/f are |0> (fresh).
|
||
;; DON'T re-establish trace state — original backward sweep
|
||
;; was XOR'ing trace state OUT (zeroing them). Since they're
|
||
;; already at |0>, the XOR-zero step is a no-op for them.
|
||
;; Only r needs zeroing (it kept its forward-sweep state).
|
||
(when force-no-cdtf? (set! *cadd-direct-trunc-fast* saved-cdtf))
|
||
|
||
;; ── Classical-replay backward sweep ── (zeros r, others stay)
|
||
(classical-reset! c r n+1 final-r)
|
||
(cond
|
||
(*dgcd-raw-quotient-terminal-reuse* #t)
|
||
(else
|
||
(classical-reset! c u n+1 final-u)
|
||
(classical-reset! c v-w n+1 final-v-w)
|
||
(classical-reset! c s n+1 final-s)
|
||
(when (= final-f 1) (gate-x! c f 0))
|
||
(let loop ((i 0))
|
||
(when (< i iters)
|
||
(when (= (vector-ref m-i-vec i) 1)
|
||
(gate-x! c m-hist i))
|
||
(loop (+ i 1))))))))
|
||
|
||
;; ── Free Kaliski state ──
|
||
;; sweep-borrow-block-fire: free shared cb/rb in reverse alloc order.
|
||
;; Restore lane thunk to default so cross-call state stays clean.
|
||
(when (and *dgcd-borrow-current-block* *k2-pair-codec-wired*)
|
||
(free! c 'kal-host-k2-rb-shared)
|
||
(free! c 'kal-host-k2-cb-shared)
|
||
(set! *cuccaro-lane-vector-thunk* cuccaro-lane-default-thunk))
|
||
(when *cuccaro-use-fast*
|
||
(free! c 'kal-host-carries-shared))
|
||
(free! c host-mask)
|
||
(free! c m-hist)
|
||
(free! c f)
|
||
(free! c s)
|
||
(free! c r)
|
||
(free! c v-w)
|
||
(free! c u)))))
|