;;; 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)))))
