;;; mod-inv-by-dialog-gcd.lsp — Phase B sweep-005: DIALOG_GCD lever.
;;;
;;; Ports HEAD's DIALOG_GCD production wiring
;;; (`configure_ecdsafail_submission_route` at
;;; `~/git/ecdsafail-challenge/src/point_add/mod.rs:31052-31257`) onto
;;; our Bernstein-Yang / Kaliski substrate. See dialog-gcd-design.md
;;; for which HEAD knobs map vs which are HEAD-substrate-specific.
;;;
;;; Three actionable HEAD levers ship here:
;;;
;;;   (D1) Smooth linear width envelope per step. HEAD's
;;;        `dialog_gcd_tobitvector_active_width`
;;;        (mod.rs:24452-24459) replaces our coarse step-function
;;;        `mib-uv-width` with a monotone-decreasing formula:
;;;
;;;          ideal   = N - step * SLOPE + MARGIN
;;;          rounded = 2 * ceiling(max(ideal, 1) / 2)
;;;          width   = clamp(rounded, 1, N)
;;;
;;;        At every iter (not only the late half) u/v ops run at the
;;;        truncated width. HEAD's production tuning at n=256:
;;;        SLOPE = 0.711, MARGIN = 26.
;;;
;;;   (D2) Truncated comparator window. HEAD's
;;;        `dialog_gcd_cmp_gt_truncated_into_width` (mod.rs:24319)
;;;        compares only the top COMPARE_BITS slice of u/v. Sound
;;;        because by D1 the high bits above active_width are |0>;
;;;        comparing only the top comparator-bits of the active
;;;        window is value-exact on the verifier support. HEAD's
;;;        production: COMPARE_BITS = 56 at n=256.
;;;
;;;   (D3) ACTIVE_ITERATIONS truncation. HEAD's
;;;        `dialog_gcd_active_iterations` (mod.rs:24243-24248) caps
;;;        the forward sweep at fewer than 2n iters. The verifier-
;;;        reachable support converges before 2n; rare overflow is
;;;        caught by the Fiat-Shamir reroll machinery. HEAD's
;;;        production: 395 at n=256. We do NOT have a reroll
;;;        machinery — we VERIFY correctness on every tested input;
;;;        cap is set conservatively per-width.
;;;
;;; HEAD knobs that DO NOT map onto our substrate (no-op here):
;;;
;;;   DIALOG_GCD_HOST_GATED         — needs HEAD's `dialog_log`
;;;                                   register (we have no equivalent)
;;;   DIALOG_GCD_APPLY_WINDOW_BLOCKS — applies to HEAD's apply-phase
;;;                                   only (we have no apply-phase)
;;;   DIALOG_GCD_BODY_HOST_CIN      — phase tracking primitive needed
;;;                                   (pattern 4, not yet shipped)
;;;   DIALOG_GCD_FUSED_BRANCH_BITS  — HEAD's control-flow shape
;;;                                   diverges from ours
;;;
;;; HEAD knobs landed in v2 (this file, sweep-006):
;;;
;;;   DIALOG_GCD_LATE_BORROW_UV_HIGH — borrow u[active..active+uv-w] as
;;;     the masking ancilla for ctrl-cuccaro-sub!/add!. Premise:
;;;     bits u[uv-w..n+1] are |0> by our width-truncation envelope. We
;;;     alias them as the mask scratch via offset-aware ccx-mask +
;;;     cuccaro-sub-offset! / cuccaro-add-offset!, computing the mask
;;;     in-place on u's high zero slice and uncomputing after. Peak
;;;     qubits drop by uv-w on every iteration where the borrow
;;;     engages (uv-w + uv-w <= n+1). Engagement gate:
;;;       2 * uv-w <= n+1
;;;     HEAD ref: dialog_gcd_pick_borrow_slice (mod.rs:24699-24712),
;;;     dialog_gcd_pick_runway_safe_borrow_slice (mod.rs:26328-26354),
;;;     production wire at mod.rs:31227.
;;;
;;;   DIALOG_GCD_ODD_U_LOWBIT_FASTPATH — skip lane 0 of the cswap +
;;;     ctrl-cuccaro-sub!/add! body. Premise: u stays odd across
;;;     every Kaliski iter (binary-GCD invariant; p is prime so
;;;     initial u=p is odd; v_w-=u when both odd produces even v_w
;;;     which gets shifted right; the swap controlled by a_f preserves
;;;     u-odd because a_f = (f AND NOT u[0]) is zero whenever u is
;;;     odd, so the cswap on lane 0 never fires). Under that
;;;     invariant, the lane-0 mask compute collapses to cx(ctrl,
;;;     v_w[0]) (a_f's branch never engages on lane 0 because cswap
;;;     never swapped it) and the body adder can start at bit 1. HEAD
;;;     ref: dialog_gcd_controlled_sub_selected lane-0 skip at
;;;     mod.rs:24747-24758, ditto add at mod.rs:24831-24841, cswap
;;;     skip at mod.rs:24944, production wire at mod.rs:31256.
;;;
;;;     On HEAD this fastpath co-tunes with the Fiat-Shamir reroll;
;;;     our substrate verifies every input, so we GATE-test soundness
;;;     at circuit build by classically tracing u[0] across every
;;;     iteration and erroring if u ever lands on even.
;;;
;;; ── Sign / correction handling ──────────────────────────────────
;;;
;;; classical-kaliski-trace runs the SAME classical Kaliski loop body
;;; as the quantum circuit, parameterized by the iteration count. When
;;; we cap iters at *dgcd-active-iters* we MUST recompute K-correct and
;;; the trace at the SAME capped count, else the forward & backward
;;; sweeps disagree and free! trips on dirty registers.
;;;
;;; Soundness gate: for each input a we verify
;;;
;;;   classical-kaliski-r-final(a, p, iters-cap, n+1) * K = a^{-1} mod p
;;;
;;; at circuit-build time. If the cap is too aggressive for some a, K
;;; would have to differ per-a, which our 1-K-fits-all wiring can't
;;; support. We detect this and ERROR, NOT silently drop.
;;;
;;; All ancillae return to |0> by classical-replay backward sweep on
;;; the capped trace (mirrors mod-inv-by-refined!'s R1).

;;; ── *field-prime* convention ─────────────────────────────────────
;;;
;;; Dialog-GCD primitives are field-prime agnostic: classical Kaliski
;;; trace consumes p as integer arg, never reads *field-prime* directly.
;;; Consumers binding *field-prime* upstream-style still need to pass p
;;; through Kaliski entry points (mod-inv-by-dialog-gcd! &c). Width
;;; derives from caller's n+1 arg or (bit-length p). See quantum/README.md.

(load "quantum/gates.lsp")
(load "quantum/adder.lsp")
(load "quantum/mod-arith.lsp")
(load "quantum/mod-inv-by.lsp")

;;; ── knob flags ────────────────────────────────────────────────────

;;; *mod-inv-by-dialog-gcd* — main dispatcher.
;;;
;;; When non-#f, mod-inv-by! routes through mod-inv-by-dialog-gcd!.
;;; Default #f so existing sweeps reproduce byte-for-byte.

(define *mod-inv-by-dialog-gcd* #f)

;;; *dgcd-width-margin* — HEAD's DIALOG_GCD_WIDTH_MARGIN.
;;;
;;; Added to the ideal width per step. Default 37 = HEAD's pre-tuning
;;; baseline (mod.rs:24438). HEAD's production tightens to 26.

(define *dgcd-width-margin* 37)

;;; *dgcd-width-slope-x1000* — HEAD's DIALOG_GCD_WIDTH_SLOPE_X1000.
;;;
;;; Per-step shrink rate × 1000 (so an integer knob). Default 708 ~=
;;; 0.5 * 1.415 (HEAD's baseline at mod.rs:24449). HEAD's production:
;;; 711.

(define *dgcd-width-slope-x1000* 708)

;;; *dgcd-active-iters* — HEAD's DIALOG_GCD_ACTIVE_ITERATIONS.
;;;
;;; Number of Kaliski iterations. #f = 2n (textbook). Integer = capped.
;;; HEAD's production: 395 at n=256 (vs textbook 512).

(define *dgcd-active-iters* #f)

;;; *dgcd-compare-bits* — HEAD's DIALOG_GCD_COMPARE_BITS.
;;;
;;; Truncated comparator window (HEAD's `cmp_gt_truncated_into_width`).
;;; #f = full active width. Integer = top `dgcd-compare-bits` of u/v.
;;; HEAD's production: 56 at n=256.

(define *dgcd-compare-bits* #f)

;;; *dgcd-apply-clean-compare-bits* — HEAD's CLEAN_COMPARE_BITS lever
;;; (config.rs:406 dialog_gcd_apply_clean_compare_bits). Separate
;;; compare-bits for the apply-phase "clean" comparator path
;;; (dialog/mod.rs:1173-1206 dialog_gcd_clean_truncated_underflow).
;;; HEAD's a66b042 frontier sets CLEAN_COMPARE_BITS=20 — sweep-026 §2
;;; identified this as load-bearing for the 1309q route's score
;;; advantage (alongside HOSTED comparator). Distinct from the main
;;; *dgcd-compare-bits* which gates the body-phase comparator.
;;;
;;; #f = use *dgcd-compare-bits* fallback (HEAD's None branch).
;;; Integer = override with this width specifically for the apply-phase
;;; clean-comparator dispatch. AUDIT §9 lever row 358.

(define *dgcd-apply-clean-compare-bits* #f)

(define (dgcd-apply-clean-compare-bits-for-step step)
  ;; HEAD dialog_gcd_apply_clean_compare_bits with global override.
  ;; Returns the effective compare-bits for the apply-phase clean
  ;; comparator at `step`. Falls back to *dgcd-compare-bits* when
  ;; *dgcd-apply-clean-compare-bits* is #f.
  (or *dgcd-apply-clean-compare-bits* *dgcd-compare-bits* 56))

;;; ── HEAD apply-phase fused measured-uncompute lever family ─────────
;;;
;;; HEAD's dialog/config.rs:146-181 + 183-195 defines 6 default-OFF
;;; levers that replace specific CCX uncomputes inside the apply-phase
;;; fused double_y / halve_y emitters with Gidney measurement (HMR +
;;; classically-conditioned CZ). 0 Toffoli for each replaced uncompute,
;;; phase-exact precisely because each control ancilla deterministically
;;; equals its set-expression at the HMR moment so the HMR's `q·rng`
;;; phase is cancelled by the cz_if's `(q-expr)·rng`.
;;;
;;; Closes AUDIT §9 row 373-374. All flags default #f (HEAD default-OFF
;;; matches lumbda byte-identity convention). Wiring into the apply-
;;; phase emit path is a follow-on sweep once dialog_gcd_fused_double_y
;;; + dialog_gcd_fused_halve_y are themselves ported (currently ABSENT
;;; per AUDIT §11 note).

;; hclear: uncompute `h = a & b` (apply-phase fused double_y/halve_y).
;; HEAD config.rs:146.
(define *dgcd-fused-hclear-measured* #f)

;; dclear: uncompute `d = ovf1 & s2` (apply-phase fused double_y).
;; Forward only -- in halve_y the matching `d` clear reads y[1]
;; after csub overwrite, so set-controls are no longer live.
;; HEAD config.rs:163.
(define *dgcd-fused-dclear-measured* #f)

;; ovfclear: uncompute ovf1 / ovf2 cleanup ancillae using known mux
;; / AND expressions (apply-phase fused double_y). HEAD config.rs:172.
(define *dgcd-fused-ovfclear-measured* #f)

;; halve_edclear: uncompute `e` and `d` in fused halve_y cleanup.
;; HEAD config.rs:179.
(define *dgcd-fused-halve-edclear-measured* #f)

;; apply-final-windowed-fast-blocks: Option<usize>; #f = disabled,
;; integer >= 2 = block count. HEAD config.rs:183.
(define *dgcd-apply-final-windowed-fast-blocks* #f)

;; apply-final-topclean-bits: usize; 0 = disabled. HEAD config.rs:190.
(define *dgcd-apply-final-topclean-bits* 0)

;; apply-final-lowq: bool; HEAD config.rs:134 (dialog_gcd_apply_final
;; _lowq_enabled). Lowq variant for the final apply step.
(define *dgcd-apply-final-lowq* #f)

;;; ── HEAD apply-chunked-f lever family ─────────────────────────────
;;;
;;; HEAD dialog/config.rs:71-131 defines 9 levers tuning the apply-
;;; phase chunked-f path. Closes AUDIT §9 rows 370-371. All default
;;; #f in lumbda. HEAD defaults reuse_cin_zero + fuse_boundary_clears
;;; ON; lumbda preserves byte-identity by defaulting them OFF.

(define *dgcd-apply-chunked-f-blocks* #f)
(define *dgcd-apply-chunked-f-cut*  #f)
(define *dgcd-apply-chunked-f-cut2* #f)
(define *dgcd-apply-chunked-f-cut3* #f)
(define *dgcd-apply-chunked-f-cut4* #f)
(define *dgcd-apply-chunked-f-custom4* #f)
(define *dgcd-apply-chunked-f-custom5* #f)
(define *dgcd-apply-chunked-f-reuse-cin-zero* #f)
(define *dgcd-apply-chunked-f-fuse-boundary-clears* #f)

;;; ── apply-boundary-split lever ─────────────────────────────────────
;;;
;;; HEAD dialog/config.rs:190 (apply_boundary_split). Closes AUDIT §9
;;; row 375 third option; the other two siblings (conditional_replay
;;; + replay_swap_host) PORTED earlier.

(define *dgcd-apply-boundary-split* 0)

;;; ── HEAD raw-tier lever family ─────────────────────────────────────
;;;
;;; HEAD dialog/config.rs:43-316. Closes AUDIT §9 rows 360-369 + 373-374.
;;; 19 default-OFF flag declarations covering raw-tier dispatch (tobitvector,
;;; ipmul, quotient, apply, pa-stop). Substrate wiring lives downstream:
;;; HEAD reads these via env vars in dialog/mod.rs's raw-path routers
;;; (round763 packer, ipmul block emit, quotient driver, apply phase
;;; truncated-clean variant). Lumbda byte-identity convention: all #f
;;; means current emit unchanged; cells that match HEAD's tuned route set
;;; the relevant flag #t.

;; raw-apply-{direct,materialized}-special-add: HEAD config.rs:43,50.
;; Selects DIRECT vs MATERIALIZED special-add variants in raw-apply.
(define *dgcd-raw-apply-direct-special-add*       #f)
(define *dgcd-raw-apply-materialized-special-add* #f)

;; raw-apply-reverse-{fast-sub,materialized-special-sub}: HEAD config.rs:57,64.
;; Mirrors above for the reverse-direction apply sub-path.
(define *dgcd-raw-apply-reverse-fast-sub*                  #f)
(define *dgcd-raw-apply-reverse-materialized-special-sub*  #f)

;; reverse-branch-conditional-replay: HEAD config.rs:204.
(define *dgcd-reverse-branch-conditional-replay* #f)

;; raw-tobitvector levers: HEAD config.rs:233,240,247.
(define *dgcd-raw-tobitvector-materialized-sub*           #f)
(define *dgcd-raw-tobitvector-variable-width*             #f)
(define *dgcd-raw-tobitvector-borrow-future-log-carries*  #f)

;; raw-ipmul / raw-quotient levers: HEAD config.rs:255-281.
;; raw-quotient-terminal-reuse falls back to raw-ipmul-terminal-reuse
;; in HEAD when its env var is unset; lumbda mirrors with a #f
;; sentinel meaning "fall through" — callers check raw-ipmul flag
;; if quotient flag is #f.
(define *dgcd-raw-ipmul-terminal-reuse*    #f)
(define *dgcd-raw-ipmul-clear-p-residual*  #f)
(define *dgcd-raw-quotient-terminal-reuse* #f)
(define *dgcd-raw-quotient-keep-terminal-u* #f)

;; kcorr-route-via-primitive (sweep blackops 2026-06-11): when #t,
;; the host file's K-correction release/reacquire window routes
;; through dgcd-{release,reacquire}-terminal-vec! instead of raw
;; free!/alloc! calls. Today, runway=#f, byte-identical to raw
;; free!/alloc! sequence. Forward-compat with runway-aware partial
;; release (sweep-runway-layout follow-up). Default #f preserves
;; byte-identity for kcorrw0 + night17 champions.
(define *dgcd-kcorr-route-via-primitive* #f)

;; raw-apply-truncated-clean: HEAD config.rs:283.
(define *dgcd-raw-apply-truncated-clean* #f)

;; raw-pa-stop-* family: HEAD config.rs:290-315. Early-stop hooks
;; for the PA (point-add) driver after intermediate primitives,
;; used by HEAD's circuit-size measurement harness.
(define *dgcd-raw-pa-stop-after-quotient* #f)
(define *dgcd-raw-pa-stop-after-xtail*    #f)
(define *dgcd-raw-pa-stop-after-c*        #f)
(define *dgcd-raw-pa-stop-after-pair2*    #f)

;; compressed-sidecar-log: HEAD config.rs:327.
(define *dgcd-compressed-sidecar-log* #f)

;;; ── dgcd-chunk-hi — sweep-dgcd-chunk-hi ───────────────────────────
;;;
;;; HEAD dialog/mod.rs:1280 dialog_gcd_chunk_hi. Pure classical helper
;;; that computes the high-boundary index of chunk `block` (0-indexed)
;;; in a chunked-f apply pass with `blocks` total chunks over an
;;; `ext_n`-wide accumulator. Closes AUDIT row 410.
;;;
;;; Dispatch logic per HEAD:
;;;   - blocks=4 + *dgcd-apply-chunked-f-custom4*: cuts at chunked-f-
;;;     cut/cut2/cut3 (defaults ext_n/4, ext_n/2, 3*ext_n/4)
;;;   - blocks=5 + *dgcd-apply-chunked-f-custom5*: cuts at chunked-f-
;;;     cut/cut2/cut3/cut4 (defaults ext_n/5..4*ext_n/5)
;;;   - block=0, blocks<=3: chunked-f-cut min ext_n-1 (default ext_n/2)
;;;   - blocks=3, block=1: chunked-f-cut2 min ext_n-1 (default 2*ext_n/3)
;;;   - else: ((block+1)*ext_n)/blocks  (uniform partition)
;;;
;;; Flag-value contract: lumbda *dgcd-apply-chunked-f-cut*N* is #f for
;;; "use HEAD's default" or an integer for "use this value". Mirrors
;;; HEAD's Option<usize> exactly. The custom4/5 toggles are bool flags.

(define (dgcd-chunk-hi blocks block ext-n)
  "Port of HEAD dialog_gcd_chunk_hi (dialog/mod.rs:1280). Returns the
   high-boundary index of the given chunk under chunked-f config."
  (cond
    ;; blocks=4 custom path
    ((and (= blocks 4) *dgcd-apply-chunked-f-custom4*)
     (let* ((c0 (or *dgcd-apply-chunked-f-cut*  (quotient ext-n 4)))
            (c1 (or *dgcd-apply-chunked-f-cut2* (quotient ext-n 2)))
            (c2 (or *dgcd-apply-chunked-f-cut3* (quotient (* 3 ext-n) 4))))
       (cond
         ((< block 3)
          (cond ((= block 0) c0)
                ((= block 1) c1)
                (else        c2)))
         (else (quotient (* (+ block 1) ext-n) blocks)))))
    ;; blocks=5 custom path
    ((and (= blocks 5) *dgcd-apply-chunked-f-custom5*)
     (let* ((c0 (or *dgcd-apply-chunked-f-cut*  (quotient ext-n 5)))
            (c1 (or *dgcd-apply-chunked-f-cut2* (quotient (* 2 ext-n) 5)))
            (c2 (or *dgcd-apply-chunked-f-cut3* (quotient (* 3 ext-n) 5)))
            (c3 (or *dgcd-apply-chunked-f-cut4* (quotient (* 4 ext-n) 5))))
       (cond
         ((< block 4)
          (cond ((= block 0) c0)
                ((= block 1) c1)
                ((= block 2) c2)
                (else        c3)))
         (else (quotient (* (+ block 1) ext-n) blocks)))))
    ;; block=0, blocks<=3
    ((and (= block 0) (<= blocks 3))
     (min (or *dgcd-apply-chunked-f-cut* (quotient ext-n 2))
          (- ext-n 1)))
    ;; blocks=3, block=1
    ((and (= blocks 3) (= block 1))
     (min (or *dgcd-apply-chunked-f-cut2* (quotient (* 2 ext-n) 3))
          (- ext-n 1)))
    ;; Uniform partition fallback
    (else (quotient (* (+ block 1) ext-n) blocks))))

;;; ── dgcd-conditional-boundary-replay! — sweep-dgcd-chunk-hi ──────
;;;
;;; HEAD dialog/mod.rs:1323 dialog_gcd_conditional_boundary_replay.
;;; Closes AUDIT row 408.
;;;
;;; For each target in reverse order, HMR-uncompute the target bit + run
;;; cmp_lt_phase_conditioned_with_cin on the prefix u[start..p] / v[start..p],
;;; where start = previous-target's p (or 0 for first), carry_in =
;;; previous-target's qubit (or c_in for first).
;;;
;;; Caller responsibility:
;;;   u-reg/v-reg: data registers width n
;;;   ctrl-reg/ctrl-idx: external control
;;;   cin-reg/cin-idx: initial carry-in bit
;;;   targets: list of (target-reg target-idx p) triples; strictly
;;;     ascending in p
;;;   carries-reg/carries-offset + bit-base: scratch for the inner
;;;     cmp-lt-phase-conditioned-with-cin! call

(define (dgcd-conditional-boundary-replay!
          c u-reg v-reg ctrl-reg ctrl-idx cin-reg cin-idx
          targets carries-reg carries-offset)
  "Port of HEAD dialog_gcd_conditional_boundary_replay (dialog/mod.rs:1323)."
  (let loop ((idx (- (length targets) 1)))
    (when (>= idx 0)
      (let* ((cur     (list-ref targets idx))
             (cur-tr  (car cur))
             (cur-ti  (cadr cur))
             (cur-p   (caddr cur))
             (prev    (if (= idx 0)
                          (list cin-reg cin-idx 0)
                          (list-ref targets (- idx 1))))
             (start   (caddr prev))
             (carry-r (car prev))
             (carry-i (cadr prev))
             (phase-bit (+ 600000 idx)))
        (gate-hmr! c cur-tr cur-ti phase-bit)
        (cmp-lt-phase-conditioned-with-cin!
          c u-reg v-reg (- cur-p start)
          ctrl-reg ctrl-idx
          carry-r carry-i
          carries-reg carries-offset
          phase-bit))
      (loop (- idx 1)))))

;;; ── dgcd-pick-borrow-slice — sweep-dgcd-pick-borrow-slice ─────────
;;;
;;; HEAD dialog/mod.rs:457 dialog_gcd_pick_borrow_slice. Closes AUDIT
;;; row 411. Pure classical picker: chooses between a caller-supplied
;;; `future` borrow slice and a fallback slice carved from u's
;;; high-bits region.
;;;
;;; HEAD signature: Option<&[QubitId]> in, Option<&[QubitId]> out.
;;; Lumbda port returns a 3-tuple (reg, offset, length) when a slice
;;; is selected, or #f when nothing fits. Caller projects (reg,
;;; offset, length) into their slice consumers (e.g.,
;;; cuccaro-add-fast-borrowed-lane!).
;;;
;;; Dispatch:
;;;   - *dgcd-late-borrow-uv-high* must be #t AND active-width >= 1
;;;   - want = 2 * active-width - 1
;;;   - if future is shorter than want (or absent) AND u has enough
;;;     room for active-width + want, return u[active-width..
;;;     active-width+want]
;;;   - else return future as-is (may be #f).
;;;
;;; The `future` argument is itself a (reg, offset, length) triple or #f.

(define (dgcd-pick-borrow-slice future u-reg u-len active-width)
  "Port of HEAD dialog_gcd_pick_borrow_slice (dialog/mod.rs:457).
   `future` is #f or a (reg offset length) list. Returns a (reg
   offset length) list or #f."
  (cond
    ((and *dgcd-late-borrow-uv-high* (>= active-width 1))
     (let* ((want   (- (* 2 active-width) 1))
            (short  (or (not future)
                        (< (list-ref future 2) want))))
       (cond
         ((and short (>= u-len (+ active-width want)))
          (list u-reg active-width want))
         (else future))))
    (else future)))

;;; ── selected-body lever family — sweep-selected-body-flags ────────
;;;
;;; HEAD dialog/mod.rs:341,363,394,416,423,438. Closes AUDIT row 364
;;; (selected-body-nocin) + adds the stream-suffix-map + body-host-cin
;;; flags + the per-step suffix-bits getter.
;;;
;;; All flags default OFF / 0 / empty. Downstream wiring lives in
;;; `dialog_gcd_controlled_sub_selected` (HEAD mod.rs:472) which is
;;; substrate work; this sweep makes the lever surface available.

;; *dgcd-body-host-cin* — HEAD mod.rs:389. DIALOG_GCD_BODY_HOST_CIN.
;; Default OFF. When #t, materialized selected add/sub body sources
;; its c_in from a caller-supplied host register lane instead of
;; allocating fresh.
(define *dgcd-body-host-cin* #f)

;; *dgcd-selected-body-nocin* — HEAD mod.rs:394. Integer 0/1/2.
;;   0 (#f): OFF (default)
;;   1: full no-cin path (drops c_in lane + folds carry into Cuccaro seed)
;;   2: keep-pool variant (no-cin body but legacy 2n-1 composite pool)
(define *dgcd-selected-body-nocin* 0)

;; Helper: keep-pool predicate. HEAD mod.rs:416.
(define (dgcd-selected-body-nocin-keep-pool?)
  (= *dgcd-selected-body-nocin* 2))

;; Helper: nocin-enabled predicate. HEAD mod.rs:405-408.
(define (dgcd-selected-body-nocin-enabled?)
  (or (= *dgcd-selected-body-nocin* 1)
      (= *dgcd-selected-body-nocin* 2)))

;; *dgcd-selected-body-stream-suffix-map* — HEAD mod.rs:424.
;; DIALOG_GCD_SELECTED_BODY_STREAM_SUFFIX_MAP env var format
;; "step1:bits1,step2:bits2,...". Lumbda representation: alist
;; ((step . bits) ...). Default '() = empty map.
(define *dgcd-selected-body-stream-suffix-map* '())

(define (dgcd-selected-body-stream-suffix-bits step body-len)
  "Port of HEAD dialog_gcd_selected_body_stream_suffix_bits
   (mod.rs:423). Looks up `step` in the alist + clamps to body-len-1."
  (let ((found (assq step *dgcd-selected-body-stream-suffix-map*)))
    (cond
      (found (min (cdr found) (max 0 (- body-len 1))))
      (else  0))))

(define (dgcd-selected-body-stream-top-enabled? step body-len)
  "Port of HEAD dialog_gcd_selected_body_stream_top_enabled (mod.rs:438).
   #t when the suffix-bits lookup returns exactly 1."
  (= (dgcd-selected-body-stream-suffix-bits step body-len) 1))

;;; *dgcd-pa9024-compare-schedule* — HEAD's per-step comparator schedule
;;; (config.rs:390 `DIALOG_GCD_PA9024_COMPARE_SCHEDULE`). Replaces the
;;; flat `*dgcd-compare-bits*` with a 258-entry table tuned for the K=2
;;; bounded-shift stack (active=258, WIDTH_SLOPE=1.014, WIDTH_MARGIN=10).
;;; Doc-comment from HEAD: "OBSERVED maximum req_cb = active_width
;;; - msb(u^v) ... measured over 8,000,000 reachable GCD factors ...
;;; under the active route (K2 double-shift)."
;;;
;;; HEAD's effective per-step cmp:
;;;     scheduled = max(floor, schedule[step] + margin) min active_width
;;;     effective = max(1, min(global_cmp, scheduled))
;;; When the global cmp is tighter the schedule never relaxes; when it
;;; would over-tighten the schedule pulls toward HEAD's calibrated value.
;;;
;;; Defaults: flag OFF (use flat compare-bits), margin=0, floor=1. Setting
;;; the flag #t at K=2 stacks matches HEAD's production envelope.

(define *dgcd-pa9024-compare-schedule* #f)
(define *dgcd-pa9024-compare-margin* 0)
(define *dgcd-pa9024-compare-floor* 1)

;;; HEAD's DIALOG_GCD_PA9024_COMPARE_SCHEDULE verbatim (258 entries).
;;; Verified against /tmp/ecdsafail-challenge/src/point_add/rounds/dialog/
;;; config.rs:390-402 commit 2dcf00d. Index = step.
(define *dgcd-pa9024-compare-schedule-table*
  '#( 22 21 24 24 28 25 29 26 29 30 33 35 31 32 31 33 33 34 30 32 33 35 33 35
      34 33 35 35 35 34 33 33 33 34 34 38 35 35 33 36 34 36 37 36 38 36 38 36
      42 36 37 37 39 36 36 39 37 39 35 38 38 38 36 44 37 38 36 39 41 38 37 41
      40 35 36 37 41 38 38 38 37 37 39 37 37 37 38 39 38 37 42 40 38 38 39 43
      41 39 40 42 40 39 44 39 44 40 43 40 40 41 42 41 43 42 45 41 43 42 43 42
      43 42 44 42 46 41 44 42 44 42 43 46 44 43 48 50 48 44 44 44 55 46 46 44
      43 49 44 45 44 48 44 46 45 46 45 44 45 46 48 46 45 46 50 48 44 47 47 46
      45 46 45 48 47 49 47 47 46 49 48 49 46 48 50 51 47 54 49 48 47 48 51 50
      53 54 50 52 50 51 53 52 49 52 50 52 49 52 49 53 51 55 52 51 51 51 49 47
      47 45 45 43 43 41 41 39 39 37 37 35 35 33 33 31 31 29 29 27 27 25 25 23
      23 21 21 19 19 17 17 15 15 13 13 11 11 9 9 7 7 5))

(define (pa9024-schedule-lookup step)
  "Returns the PA9024 schedule entry for `step`, or 0 if out of range
   (HEAD falls back to global cmp via unwrap_or)."
  (cond
    ((< step 0) 0)
    ((>= step (vector-length *dgcd-pa9024-compare-schedule-table*)) 0)
    (else (vector-ref *dgcd-pa9024-compare-schedule-table* step))))

;;; *dgcd-late-borrow-uv-high* — HEAD's DIALOG_GCD_LATE_BORROW_UV_HIGH.
;;;
;;; When #t, ctrl-cuccaro-sub!/add! inside kaliski-iteration-dgcd!
;;; aliases u[uv-w..2*uv-w] as the masking ancilla instead of
;;; allocating a fresh uv-w-wide register. Engages only when
;;; 2 * uv-w <= n+1 (i.e., u has enough high zero space). Peak qubits
;;; drop by uv-w per engaged iter. Toffoli/Clifford counts identical
;;; (same gates, different target qubits).

(define *dgcd-late-borrow-uv-high* #f)

;;; *dgcd-odd-u-lowbit-fastpath* — HEAD's DIALOG_GCD_ODD_U_LOWBIT_FASTPATH.
;;;
;;; When #t, kaliski-iteration-dgcd! skips lane 0 in the cswap loop
;;; (since the cswap's controller a_f = (f AND NOT u[0]) is zero
;;; while u stays odd, so lane-0 cswap is a no-op anyway) and the
;;; lane-0 mask compute (since the body's controller add_f=1
;;; implies both u and v_w are odd, so v_w[0]-=ctrl AND u[0] becomes
;;; v_w[0]^=add_f with no borrow into bit 1). Replaces lane-0 body
;;; with a single cx(add_f, v_w[0]). Saves 2 Toffoli + 4 Clifford
;;; per iter (cswap × 2) + 4 Toffoli + minor Clifford per iter
;;; (mask compute + cuccaro lane-0 + mask uncompute, both sub and
;;; add) and saves 1 peak qubit (mask is uv-w-1 wide instead of
;;; uv-w). Soundness gate at build time verifies u stays odd on
;;; every classically traced iteration.

(define *dgcd-odd-u-lowbit-fastpath* #f)

;;; *dgcd-body-carry-trunc-width* — HEAD DIALOG_GCD_BODY_CARRY_TRUNC_W.
;;; Mirrors HEAD `dialog_gcd_body_carry_trunc_width` at
;;; rounds/dialog/mod.rs:235-261:
;;;   body_w = active_width.saturating_sub(trunc_w).max(2)
;;; Default #f = no trunc (byte-identical pre-sweep-051).
;;;
;;; Sweep-057: re-added after sweep-053 merge dropped a sweep-051 block
;;; that this branch's host.lsp still references (lines 269-271). Without
;;; this block, every emit invoking mod-inv-by-dialog-gcd-host! errors
;;; on a missing helper.

(define *dgcd-body-carry-trunc-width* #f)

;;; *dgcd-binder-notch-steps* — HEAD DIALOG_GCD_BINDER_NOTCH_STEPS.

(define *dgcd-binder-notch-steps* (quote ()))

;;; *dgcd-binder-notch-extra* — HEAD DIALOG_GCD_BINDER_NOTCH_EXTRA.

(define *dgcd-binder-notch-extra* 0)

;;; ── HEAD width helpers — sweep-width-helpers ──────────────────────
;;;
;;; HEAD dialog/mod.rs:200,212,223,246,264,276,288,316,
;;; +316/dialog_gcd_binder_notch_map_extra.
;;;
;;; Closes the width-helper substrate needed by composite-scratch +
;;; compressed-sidecar runway-layout. All pure classical helpers.

;; *dgcd-body-carry-band-trims* — HEAD mod.rs:247
;; DIALOG_GCD_BODY_CARRY_BAND_TRIMS env var format "trim1,trim2,...".
;; Lumbda: list of trims, '() = empty (no band-trim).
(define *dgcd-body-carry-band-trims* '())

;; *dgcd-tobitvector-cswap-body-trim* — HEAD mod.rs:264
;; DIALOG_GCD_TOBITVECTOR_CSWAP_BODY_TRIM env var. When #t, cswap
;; uses body-carry-trunc-width.
(define *dgcd-tobitvector-cswap-body-trim* #f)

;; *dgcd-tobitvector-shift-body-trim* — HEAD mod.rs:276
;; DIALOG_GCD_TOBITVECTOR_SHIFT_BODY_TRIM env var. Same for shift.
(define *dgcd-tobitvector-shift-body-trim* #f)

;; *dgcd-binder-notch-map-extra* — HEAD mod.rs:316 (referenced
;; from line 312). DIALOG_GCD_BINDER_NOTCH_MAP_EXTRA env var format
;; "step1:extra1,step2:extra2,...". Lumbda: alist of (step . extra).
(define *dgcd-binder-notch-map-extra* '())

;; *dgcd-trio-width-notch-step* + *_extra* already declared above
;; (sweep-fused-measured-flags era).

(define (dgcd-width-margin)
  "HEAD mod.rs:200 dialog_gcd_width_margin. Default 37.0; lumbda
   stores integer via *dgcd-width-margin* (default 37)."
  (exact->inexact *dgcd-width-margin*))

(define (dgcd-width-slope)
  "HEAD mod.rs:212 dialog_gcd_width_slope. Default 0.5*1.415 = 0.7075;
   lumbda stores per-thousand via *dgcd-width-slope-x1000* (default 708)."
  (/ (exact->inexact *dgcd-width-slope-x1000*) 1000.0))

(define (dgcd-tobitvector-active-width step)
  "HEAD mod.rs:223 dialog_gcd_tobitvector_active_width. Returns the
   active width at the given step. When variable-width is OFF, returns
   N=256."
  (cond
    ((not *dgcd-raw-tobitvector-variable-width*) 256)
    (else
     (let* ((ideal   (+ (- 256.0 (* (exact->inexact step) (dgcd-width-slope)))
                        (dgcd-width-margin)))
            (capped  (max 1.0 ideal))
            (halved  (ceiling (/ capped 2.0)))
            (rounded (* 2 (inexact->exact halved))))
       (max 1 (min 256 rounded))))))

(define (dgcd-body-carry-band-trim step)
  "HEAD mod.rs:246. Returns the per-step band trim from
   *dgcd-body-carry-band-trims*, or #f when empty."
  (cond
    ((null? *dgcd-body-carry-band-trims*) #f)
    (else
     (let* ((iters     (max 1 *dgcd-active-iters*))
            (trims-len (length *dgcd-body-carry-band-trims*))
            (band-size (max 1 (quotient (+ iters (- trims-len 1)) trims-len)))
            (band      (min (- trims-len 1) (quotient step band-size))))
       (list-ref *dgcd-body-carry-band-trims* band)))))

(define (dgcd-binder-notch-map-extra-for step)
  "HEAD mod.rs:316 dialog_gcd_binder_notch_map_extra. Looks up step in
   the alist + returns the extra trim, or 0 when absent."
  (let ((found (assq step *dgcd-binder-notch-map-extra*)))
    (cond
      (found (cdr found))
      (else  0))))

(define (dgcd-body-carry-trunc-width active-width step)
  "HEAD mod.rs:288 dialog_gcd_body_carry_trunc_width. Full version
   including band-trim + trio-notch + binder-notch + map-extra.
   Supersedes dgcd-body-carry-trunc-width-for (kept below for ABI)."
  (let* ((w0 (or (dgcd-body-carry-band-trim step)
                 (cond
                   (*dgcd-body-carry-trunc-width*
                    (cond
                      ((number? *dgcd-body-carry-trunc-width*)
                       *dgcd-body-carry-trunc-width*)
                      (else 0)))
                   (else 0))))
         (w1 (cond
               ((and *dgcd-trio-width-notch-enabled*
                     (= step *dgcd-trio-width-notch-step*))
                (+ w0 *dgcd-trio-width-notch-extra*))
               (else w0)))
         (w2 (cond
               ((and (> *dgcd-binder-notch-extra* 0)
                     (member step *dgcd-binder-notch-steps*))
                (+ w1 *dgcd-binder-notch-extra*))
               (else w1)))
         (w3 (+ w2 (dgcd-binder-notch-map-extra-for step))))
    (max 2 (- active-width w3))))

(define (dgcd-tobitvector-cswap-width active-width step)
  "HEAD mod.rs:264 dialog_gcd_tobitvector_cswap_width."
  (cond
    (*dgcd-tobitvector-cswap-body-trim*
     (min (dgcd-body-carry-trunc-width active-width step) active-width))
    (else active-width)))

(define (dgcd-tobitvector-shift-width active-width step)
  "HEAD mod.rs:276 dialog_gcd_tobitvector_shift_width."
  (cond
    (*dgcd-tobitvector-shift-body-trim*
     (min (dgcd-body-carry-trunc-width active-width step) active-width))
    (else active-width)))

;;; dgcd-body-carry-trunc-width-for — effective body width at step.
(define (dgcd-body-carry-trunc-width-for active-w step)
  (cond
    ((not *dgcd-body-carry-trunc-width*) active-w)
    (else
     (let* ((base-trim *dgcd-body-carry-trunc-width*)
            (notch?    (and (> *dgcd-binder-notch-extra* 0)
                            (member step *dgcd-binder-notch-steps*)))
            (trim-w    (if notch?
                           (+ base-trim *dgcd-binder-notch-extra*)
                           base-trim))
            (body-w    (- active-w trim-w)))
       (cond
         ((< body-w 2) 2)
         ((> body-w active-w) active-w)
         (else body-w))))))

;;; *cmp-lt-with-cin* — sweep-053 Primitive 1.
;;;
;;; Mirrors HEAD's `cmp_lt_into_fast_with_cin`
;;; (point_add/arith/compare.rs:55-106). HEAD ships two variants:
;;;
;;;   cmp_lt_into_fast            — internally allocs cin (+1 peak qubit)
;;;   cmp_lt_into_fast_with_cin   — caller supplies cin from idle lane
;;;
;;; lumbda's existing cmp-lt-into-fast! (mod-arith.lsp:154) already takes
;;; cin-reg/cin-idx from caller, so its API matches HEAD's `with_cin`. The
;;; peak-qubit win HEAD captures comes from the CALLER borrowing cin from
;;; an idle operand lane instead of allocating a fresh qubit.
;;;
;;; At our dgcd-cmp-gt-into! hot site, the caller already passes cin-reg/
;;; cin-idx via the borrowed-tmp path. When this flag is #t the call
;;; documentation marks the with-cin contract explicitly + the caller
;;; routes cin into the tmp-borrow tail (which is provably |0> at the
;;; comparator instant by the active-width clamp). Provides a regression
;;; checkpoint in case future primitives lose the with-cin invariant.
;;;
;;; Score-neutral when caller already supplies cin from idle lane
;;; (current dgcd-cmp-gt-into! does — gate sequence identical to the
;;; existing path); modest peak qubit save (1-3) at comparator instant
;;; if future call sites stop borrowing.
;;;
;;; Default #f = current behavior (no semantic-marker enforcement). When
;;; #t, also serves as a build-time assertion that the cin-reg passed in
;;; was sourced from a borrow rather than a fresh alloc — surfaces in
;;; logs if a substrate gap reintroduces the alloc path.
;;;
;;; HEAD's `assert!(!u.contains(&c_in))` invariant: we satisfy by
;;; keeping cin inside the borrowed carries register where (i) carries-
;;; reg is neither u-reg nor v-reg, AND (ii) the borrowed register tail
;;; bit is dead at the comparator instant.

(define *cmp-lt-with-cin* #f)

;;; cmp-lt-into-fast-with-cin! — HEAD's `cmp_lt_into_fast_with_cin`
;;; wrapper. Semantic-marker variant of cmp-lt-into-fast! emphasizing
;;; the caller-supplied cin contract. Body byte-identical — difference
;;; vs cmp_lt_into_fast lives at the CALL SITE (cin chosen from an idle
;;; lane, not freshly alloced). Provided so future call sites that opt
;;; into the *cmp-lt-with-cin* discipline can signal intent in source.

(define (cmp-lt-into-fast-with-cin! c u-reg v-reg n
                                     flag-reg flag-idx cin-reg cin-idx
                                     carries-reg carries-offset bit-base)
  "Caller-supplied-cin variant of cmp-lt-into-fast! (HEAD compare.rs:55).
   Identical gate sequence; the discipline is that cin-reg/cin-idx must
   point into an idle operand lane the caller BORROWED rather than fresh-
   allocated. carries-reg[carries-offset..+n) must be |0> in/out via the
   HMR backward sweep. bit-base..+n-1 reserves classical bits."
  (cmp-lt-into-fast! c u-reg v-reg n
                     flag-reg flag-idx cin-reg cin-idx
                     carries-reg carries-offset bit-base))

;;; ── width envelope helpers ────────────────────────────────────────

;;; ceiling-div — ceiling(a / b) for positive a, b.

(define (dgcd-ceiling-div a b)
  (quotient (+ a (- b 1)) b))

;;; dgcd-uv-width — smooth linear envelope per step.
;;;
;;; Ports HEAD's `dialog_gcd_tobitvector_active_width` at
;;; mod.rs:24452-24459. The `2 * ceiling(ideal / 2)` keeps the width
;;; even (HEAD's comparator/cuccaro family is even-width-friendly).
;;; We clamp at 1 below & n+1 above so the helper never returns a
;;; degenerate width.
;;;
;;; To stay integer-only inside lumbda we scale by 1000:
;;;   ideal × 1000 = N×1000 - step × slope-x1000 + margin × 1000
;;; then divide by 1000 with ceiling for the final width-half.

;;; *dgcd-trio-width-notch-enabled* / -step / -extra ────────────────
;;;
;;; HEAD's DIALOG_GCD_TRIO_WIDTH_NOTCH lever family (dialog/mod.rs:376-394).
;;; HEAD's docstring on the enabled flag: "Default-on successor from
;;; aaf9616: the current route inherited its body geometry, and this
;;; one-step notch is needed to reclaim the 1306q tier." sweep-026 §2
;;; flagged this as a knob HEAD's a66b042 frontier uses.
;;;
;;; What it does: adds `*dgcd-trio-width-notch-extra*` to the active
;;; width at exactly step = `*dgcd-trio-width-notch-step*`. HEAD's
;;; defaults: enabled=#t, step=11, extra=2.
;;;
;;; AUDIT §9 lever row 368. Default-OFF in lumbda to preserve byte-
;;; identity for existing cells; cells that want HEAD's default
;;; behavior MUST explicitly set *dgcd-trio-width-notch-enabled* #t.
;;; (HEAD env-default-on vs lumbda flags-default-off is a deliberate
;;; convention difference -- per CLAUDE.md "merge-to-master rule":
;;; flags default OFF, primitives are additive, never modify existing
;;; behavior.) HEAD's step + extra defaults are preserved so the
;;; behavior on opt-in matches HEAD.

(define *dgcd-trio-width-notch-enabled* #f)
(define *dgcd-trio-width-notch-step* 11)
(define *dgcd-trio-width-notch-extra* 2)

;;; ── Missing HEAD submission-route flags — sweep-missing-route-flags
;;;
;;; Dialog-side flags missing from lumbda. All default OFF / sentinel.

;; *dgcd-branch-bits-host-comparator* — HEAD mod.rs:69
;; DIALOG_GCD_BRANCH_BITS_HOST_COMPARATOR. Routes the fused branch-bit
;; path through borrowed-carry comparator on future-log slice instead
;; of allocating cmp ancilla. 1466 -> peak-cut substrate lever.
(define *dgcd-branch-bits-host-comparator* #f)

;; *dgcd-measured-apply-sub* — HEAD mod.rs:1186 (DIALOG_GCD_MEASURED_APPLY_SUB).
;; Gidney measurement uncompute for apply-phase modular subtract's raw
;; difference. ~n Toffoli instead of ~2n per call; peak-neutral.
(define *dgcd-measured-apply-sub* #f)

;; *dgcd-raw-pa* — HEAD mod.rs:1106 (DIALOG_GCD_RAW_PA).
;; Master toggle for raw point-add path.
(define *dgcd-raw-pa* #f)

;; *dgcd-measured-underflow-gate* — HEAD mod.rs:1056
;; DIALOG_GCD_MEASURED_UNDERFLOW_GATE. Measured uncompute for the
;; underflow comparator gate.
(define *dgcd-measured-underflow-gate* #f)

;; *mod-fast-flag-conditional-replay* — HEAD mod.rs:1105
;; MOD_FAST_FLAG_CONDITIONAL_REPLAY. Routes mod_add_qq_fast's flag
;; uncompute through cmp_lt_phase_conditioned (HMR-vented) instead of
;; cmp_lt_into_fast. Saves the load_const transient.
(define *mod-fast-flag-conditional-replay* #f)

;; *dgcd-free-scratch-before-shift* — HEAD mod.rs:1314
;; DIALOG_GCD_FREE_SCRATCH_BEFORE_SHIFT. Bennett-frees composite scratch
;; before the shift phase, reducing peak.
(define *dgcd-free-scratch-before-shift* #f)

;; *dgcd-special-overflow-clean-step-bits* — HEAD mod.rs:1285
;; DIALOG_GCD_SPECIAL_OVERFLOW_CLEAN_STEP_BITS env "step:bits,..." map.
;; Per-step overflow-clean comparator width override. Lumbda: alist.
(define *dgcd-special-overflow-clean-step-bits* '())

;; *dgcd-special-underflow-clean-step-bits* — HEAD mod.rs:1289
;; Symmetric for underflow-clean. Lumbda: alist.
(define *dgcd-special-underflow-clean-step-bits* '())

(define (dgcd-uv-width-raw step n+1)
  "HEAD-formula raw active width for `step`. Returns even integer in
   [2, n+1] (even because HEAD's family is even-width-friendly). step
   = 0 returns ~ n + MARGIN, monotone-decreasing thereafter.

   sweep-trio-width-notch (2026-06-10): applies the HEAD trio-width-
   notch one-step bump when *dgcd-trio-width-notch-enabled* AND step
   matches the configured notch step. Adds *dgcd-trio-width-notch-
   extra* to the active width AT that step only, then resumes the
   baseline envelope. Maintains the even-rounded clamp."
  (let* ((n            (- n+1 1))
         (n-times-1000 (* n 1000))
         (step-slope   (* step *dgcd-width-slope-x1000*))
         (margin-x1000 (* *dgcd-width-margin* 1000))
         (ideal-x1000  (+ (- n-times-1000 step-slope) margin-x1000))
         (ideal-x1000+ (if (< ideal-x1000 1000) 1000 ideal-x1000))
         (half-ceil    (dgcd-ceiling-div ideal-x1000+ 2000))
         (rounded      (* 2 half-ceil))
         ;; Apply trio-width-notch bump at the configured step.
         (notch-extra  (cond
                         ((and *dgcd-trio-width-notch-enabled*
                               (= step *dgcd-trio-width-notch-step*))
                          *dgcd-trio-width-notch-extra*)
                         (else 0)))
         (with-notch   (+ rounded notch-extra))
         (clamped-hi   (if (> with-notch n+1) n+1 with-notch))
         (clamped-lo   (if (< clamped-hi 2) 2 clamped-hi)))
    clamped-lo))

;;; dgcd-compare-bits-for-step — comparator window per step.
;;;
;;; HEAD's `dialog_gcd_compare_bits_for_step` (mod.rs:24290) compares
;;; only the top `min(*dgcd-compare-bits*, active-width)` bits. When
;;; *dgcd-compare-bits* is #f we use the full active width (no
;;; truncation).

(define (dgcd-compare-bits-for-step step n+1)
  (let* ((active (dgcd-uv-width-raw step n+1))
         (n      (- active 1))
         (global (cond
                   ((not *dgcd-compare-bits*) n)
                   ((>= *dgcd-compare-bits* n) n)
                   ((< *dgcd-compare-bits* 1)  1)
                   (else *dgcd-compare-bits*))))
    ;; HEAD's compare_bits_for_step (dialog_gcd_classical_filter.rs:133):
    ;; when pa9024_compare_schedule is set, look up schedule[step], add
    ;; margin, clamp to [floor, active]; the final result is min'd with
    ;; the global cmp + max'd with 1 so the schedule can only TIGHTEN.
    (cond
      ((not *dgcd-pa9024-compare-schedule*) global)
      (else
       (let* ((raw       (pa9024-schedule-lookup step))
              (with-marg (+ raw *dgcd-pa9024-compare-margin*))
              (floored   (max with-marg *dgcd-pa9024-compare-floor*))
              (capped    (min floored n))
              (scheduled (min capped global)))
         (max 1 scheduled))))))

;;; dgcd-resolve-iters — concrete iteration count to use.
;;;
;;; #f means full textbook 2n; integer is the capped value (clamped
;;; into [1, 2n] to defend against absurd values).

(define (dgcd-resolve-iters n+1)
  (let ((textbook (* 2 (- n+1 1))))
    (cond
      ((not *dgcd-active-iters*) textbook)
      ((> *dgcd-active-iters* textbook) textbook)
      ((< *dgcd-active-iters* 1) 1)
      (else *dgcd-active-iters*))))

;;; ── truncated comparator wrapper ────────────────────────────────

;;; dgcd-cmp-gt-into! — flag ^= (u[top..] > v[top..]) over compare-bits.
;;;
;;; Mirrors HEAD's `dialog_gcd_cmp_gt_truncated_into_width`. When
;;; compare-bits = active width this collapses to the standard
;;; cmp-gt-into!. When narrower, we slice both operands to their top
;;; compare-bits suffix (HEAD's "start = u.len() - compare_bits").
;;;
;;; lumbda's cmp-lt-into! / cmp-gt-into! reads bit-by-bit by integer
;;; index into the register. We pass `n` = compare-bits and rely on
;;; the comparator to read indices [0..n-1]. Since the active-width
;;; truncation guarantees bits above active are |0>, comparing the
;;; LOW compare-bits gives the WRONG answer in general (we want the
;;; top); rebind by aliasing to a shifted view is awkward in our
;;; substrate.
;;;
;;; DECISION for v1: take the comparator over the LOW compare-bits.
;;; Sound? Only if u, v have known-zero high bits AND the low
;;; compare-bits suffice to determine the comparison. On the
;;; verifier-reachable support after sufficiently many iters, both
;;; u and v are small enough to fit in compare-bits — so the LOW
;;; truncation is value-exact then. EARLY iters where u or v exceeds
;;; 2^compare-bits would give the wrong comparator. So:
;;;
;;;   guard: only truncate when active-width <= compare-bits, else
;;;          fall through to full active-width comparator.
;;;
;;; This is more conservative than HEAD's TOP-bits truncation but
;;; gives the same Toffoli savings on the late-step support (where
;;; HEAD's win is concentrated). For TOP-bits we'd need a sliced-
;;; register view primitive that mod-arith does not currently expose.

;;; *dgcd-host-comparator* — sweep-hosted-cmp-wire flag.
;;;
;;; When #t, dgcd-cmp-gt-into! compares the TOP cmp-bits of u and v
;;; (HEAD's HOSTED semantics: cmp over u[start..] / v[start..] where
;;; start = active-width - cmp-bits) instead of the LOW cmp-bits
;;; (current default which can mis-decide when low bits of GCD operands
;;; differ but high bits don't — caught by Fiat-Shamir reroll).
;;;
;;; Routes through cmp-lt-into-fast-offset! (sweep-prefix-targets-split).
;;; Saves no Toffolis per call vs the low-bit path, but the TOP-bit
;;; semantics matches HEAD's tuned route + makes the comparator more
;;; reliable at tight width margins (fewer reroll hazards).
;;;
;;; Default #f preserves the current low-bit behavior + champion
;;; byte-identity.
(define *dgcd-host-comparator* #f)

(define (dgcd-cmp-gt-into! c u-reg v-reg active-width step
                           flag-reg flag-idx cin-reg cin-idx
                           . tmp-borrow-opt)
  "flag ^= (u > v) at the active comparator width for `step`.
   Defers to cmp-gt-into! over the appropriate width.
   When *cuccaro-use-borrowed* is #t & tmp-borrow-opt supplies a
   register name, uses cmp-lt-into-fast! (HMR uncompute, saves n CCX
   per call). Arg swapped (v u) to convert > → < per cmp-gt-into!'s
   contract.

   sweep-hosted-cmp-wire: when *dgcd-host-comparator* is #t AND
   *cuccaro-use-borrowed* is #t AND tmp-borrow-opt is supplied,
   routes through cmp-lt-into-fast-offset! at TOP-bit slice
   (u[start..] / v[start..] where start = active-width - cmp-bits).
   Matches HEAD's HOSTED comparator semantics."
  (let ((cmp-w (cond
                 ((not *dgcd-compare-bits*) active-width)
                 ((>= *dgcd-compare-bits* active-width) active-width)
                 (else *dgcd-compare-bits*))))
    (cond
      ((and *dgcd-host-comparator*
            *cuccaro-use-borrowed*
            (not (null? tmp-borrow-opt)))
       ;; HOSTED top-bit comparator (sweep-hosted-cmp-wire).
       (let ((start (- active-width cmp-w)))
         (cmp-lt-into-fast-offset! c v-reg start u-reg start cmp-w
                                   flag-reg flag-idx cin-reg cin-idx
                                   (car tmp-borrow-opt) 0
                                   (* 4 active-width))))
      ((and *cuccaro-use-borrowed* (not (null? tmp-borrow-opt)))
       (cmp-lt-into-fast! c v-reg u-reg cmp-w
                          flag-reg flag-idx cin-reg cin-idx
                          (car tmp-borrow-opt) 0 (* 4 active-width)))
      (else
       (cmp-gt-into! c u-reg v-reg cmp-w
                     flag-reg flag-idx cin-reg cin-idx)))))

;;; ── dgcd-ccx-cmp-gt-truncated-into-width-hosted! ─────────────────
;;;
;;; Port of HEAD dgcd_ccx_cmp_gt_truncated_into_width_hosted
;;; dialog/mod.rs:83-123, commit 2dcf00d. THE single biggest score
;;; lever HEAD has that we lack -- per sweep-026 section 2, HEAD's
;;; a66b042 frontier uses CLEAN_COMPARE_BITS=20 + the HOSTED
;;; comparator path to land its 1309q route's score advantage.
;;;
;;; What HOSTED does: comparator over a TRUNCATED top-bit window
;;; ( u[start..], v[start..] where start = active-width - compare-bits )
;;; with the c-in + carries lanes BORROWED from a transient
;;; future-log prefix that's idle at the comparator's instant. Three
;;; dispatch modes per HEAD lines 108-121:
;;;
;;;   (a) PARTIAL-HOST: borrowed available > 0 but < need; allocate
;;;       only the deficit, prepend borrowed prefix, call
;;;       borrowed-carries on the gathered lane. Saves the peak
;;;       qubit that an all-or-nothing alloc would pin at the late-
;;;       step branch_bits instant. Requires the partial-host flag.
;;;
;;;   (b) FULL-HOST: borrowed >= need; no own-alloc, call borrowed-
;;;       carries directly on the borrowed prefix.
;;;
;;;   (c) NO-HOST: no borrowed lane available; alloc fresh cin +
;;;       carries, call borrowed-carries (HEAD calls
;;;       ccx_cmp_lt_into_fast directly, but lumbda's only standalone
;;;       ccx variant IS borrowed-carries so we route through it).
;;;
;;; Argument swap (cmp_u = v, cmp_v = u) converts > -> < matching
;;; HEAD's pattern + our dgcd-cmp-gt-into!'s convention.
;;;
;;; Lumbda signature mirrors HEAD via offset/length triples since
;;; lumbda lacks slice types. The borrowed lane is encoded as
;;; (borrowed-reg, borrowed-off, borrowed-len); pass borrowed-reg=#f
;;; to indicate no borrowed lane (NO-HOST mode).
;;;
;;; Substrate status: ADDITIVE. No lumbda caller dispatches through
;;; this primitive yet. Wired into a callsite by a follow-on sweep
;;; that ports the dialog-gcd branch-bit comparator HOSTED path
;;; (HEAD dialog/mod.rs:303-360 region; uses this primitive at the
;;; per-step comparator instant).
;;;
;;; HEAD-PARITY-COLLAB section 1.2 row 7 closes with this port.

(define *dgcd-partial-host-comparator* #f)

(define (dgcd-ccx-cmp-gt-truncated-into-width-hosted!
         c u-reg v-reg active-width
         ctrl-reg ctrl-idx target-reg target-idx
         compare-bits
         borrowed-reg borrowed-off borrowed-len
         carries-fallback-reg carries-fallback-off
         cin-fallback-reg cin-fallback-idx
         bit-base)
  ;; HOSTED truncated > comparator. See header.
  ;; Caller supplies fallback cin + carries lanes that get used in
  ;; NO-HOST mode (lumbda alloc happens at caller scope, not inline).
  ;; PARTIAL-HOST mode would need an additional own-alloc deficit
  ;; lane the caller pre-stages; for v1 we conservatively fall back
  ;; to FULL-HOST when borrowed >= need, else NO-HOST. The PARTIAL
  ;; flag + deficit-alloc path is a follow-on sweep so the dispatcher
  ;; lands clean here.
  (let* ((cmp-bits (max 1 (min compare-bits active-width)))
         (start    (- active-width cmp-bits))
         (need     (+ cmp-bits 1)))
    (cond
      ;; FULL-HOST: borrowed available + sufficient.
      ((and borrowed-reg (>= borrowed-len need))
       ;; Borrowed slot 0 = c_in; slots 1..cmp-bits = carries.
       (ccx-cmp-lt-into-fast-borrowed-carries-offset!
         c v-reg start u-reg start cmp-bits
         ctrl-reg ctrl-idx target-reg target-idx
         borrowed-reg (+ borrowed-off 1)
         borrowed-reg borrowed-off
         bit-base))
      ;; NO-HOST / PARTIAL fallback (PARTIAL deficit-alloc TODO).
      (else
       (ccx-cmp-lt-into-fast-borrowed-carries-offset!
         c v-reg start u-reg start cmp-bits
         ctrl-reg ctrl-idx target-reg target-idx
         carries-fallback-reg carries-fallback-off
         cin-fallback-reg cin-fallback-idx
         bit-base)))))

;;; ── dgcd-clean-truncated-underflow! ────────────────────────────────
;;;
;;; Port of HEAD dialog_gcd_clean_truncated_underflow
;;; (src/point_add/rounds/dialog/mod.rs:1173-1206, commit 2dcf00d).
;;; Special-purpose helper inside HEAD's apply-phase that conditionally
;;; clears acc_ovf when the truncated-top comparator says acc < a.
;;;
;;; HEAD's two dispatch paths:
;;;   (a) special_clean_conditional_replay_enabled: HMR(acc_ovf) +
;;;       z_if(ctrl, phase) + phase-conditioned comparator. The
;;;       conditional replay only fires on the half-shots where HMR
;;;       projected acc_ovf to 1.
;;;   (b) plain: cx(ctrl, acc_ovf) + ccx_cmp_lt_into_fast on the top
;;;       compare-bits slice.
;;;
;;; Both paths bracketed by negate-u envelope (X on a[compare_start..]).
;;;
;;; Substrate status: ADDITIVE. No lumbda caller dispatches yet.
;;; Closes AUDIT §10 dialog_gcd_clean_truncated_underflow ABSENT row.
;;; Lumbda caller integration is a follow-on sweep that wires
;;; dgcd-special-clean-conditional-replay flag into apply-phase
;;; emit. Path (a) routes through `cmp-lt-phase-conditioned-with-cin!`
;;; (PORTED, offset-indexed variant at mod-arith.lsp:703). Path (b)
;;; routes through `ccx-cmp-lt-into-fast-borrowed-carries-offset!`
;;; (PORTED via sweep-hosted-comparator at mod-arith.lsp).

(define *dgcd-special-clean-conditional-replay* #f)

(define (dgcd-special-underflow-clean-compare-bits step)
  ;; HEAD dialog/config.rs:dialog_gcd_special_underflow_clean_compare_bits
  ;; — per-step compare-bits for the underflow-clean comparator. Default
  ;; falls back to the global *dgcd-compare-bits*. step argument matches
  ;; HEAD's Option<usize>; pass #f for global default.
  (cond
    ((not step) (or *dgcd-compare-bits* 56))   ; HEAD's flat default at production
    (else       (or *dgcd-compare-bits* 56))))

(define (dgcd-clean-truncated-underflow!
         c acc-reg a-reg active-width
         ctrl-reg ctrl-idx
         acc-ovf-reg acc-ovf-idx
         step
         ;; Path (a) ancilla: cin for phase-conditioned, phase-bit ID,
         ;; bit-base for window-inverse HMR; carries for the inner
         ;; phase-conditioned window pair.
         phase-cin-reg phase-cin-idx
         phase-bit
         phase-carries-reg phase-carries-off
         phase-bit-base
         ;; Path (b) ancilla: borrowed-carries-offset's carries + cin
         ;; + bit-base. Only one of (a)/(b) ancilla pairs is consumed
         ;; per call; caller may pass dummy values for the unused
         ;; path.
         plain-carries-reg plain-carries-off
         plain-cin-reg plain-cin-idx
         plain-bit-base)
  ;; HEAD lines 1181-1205 with two dispatch paths gated by
  ;; *dgcd-special-clean-conditional-replay*.
  (let* ((cmp-bits     (dgcd-special-underflow-clean-compare-bits step))
         (compare-start (- active-width cmp-bits)))
    ;; (1) Negate the top slice of a (HEAD: for &q in &a[compare_start..]: b.x(q)).
    (let loop ((i compare-start))
      (when (< i active-width)
        (gate-x! c a-reg i)
        (loop (+ i 1))))
    ;; (2) Dispatch.
    (cond
      (*dgcd-special-clean-conditional-replay*
       ;; Path (a): HMR + z_if + phase-conditioned comparator.
       ;; HEAD lines 1186-1198.
       (gate-hmr! c acc-ovf-reg acc-ovf-idx phase-bit)
       ;; z_if(ctrl, phase): in lumbda, push-cond + cz + pop-cond.
       ;; z_if(q, c) emits an X+CZ+X identity at small width but
       ;; the lumbda primitive sequence captures the same semantics
       ;; via the phase-bit gating.
       (gate-push-cond! c phase-bit)
       (gate-cz!        c ctrl-reg ctrl-idx ctrl-reg ctrl-idx)
       (gate-pop-cond!  c)
       (cmp-lt-phase-conditioned-with-cin!
         c acc-reg compare-start a-reg compare-start cmp-bits
         phase-cin-reg phase-cin-idx
         ctrl-reg ctrl-idx
         phase-bit
         phase-carries-reg phase-carries-off
         phase-bit-base))
      (else
       ;; Path (b): plain cx + ccx_cmp_lt_into_fast.
       ;; HEAD lines 1200-1201.
       (gate-cx! c ctrl-reg ctrl-idx acc-ovf-reg acc-ovf-idx)
       (ccx-cmp-lt-into-fast-borrowed-carries-offset!
         c acc-reg compare-start a-reg compare-start cmp-bits
         ctrl-reg ctrl-idx acc-ovf-reg acc-ovf-idx
         plain-carries-reg plain-carries-off
         plain-cin-reg plain-cin-idx
         plain-bit-base)))
    ;; (3) Un-negate the top slice of a.
    (let loop ((i compare-start))
      (when (< i active-width)
        (gate-x! c a-reg i)
        (loop (+ i 1))))))

;;; ── v2 helpers: LATE_BORROW + ODD_U lane-0 fastpath ──────────────
;;;
;;; ccx-mask-offset! — like ccx-mask! but with offsets on src & dst.
;;;
;;; Walks k in [body-start, body-end) emitting
;;;   ccx(ctrl, src[src-off+k], dst[dst-off+k])
;;; Self-inverse on the (ctrl, src) inputs; uncomputes by replaying.

(define (dgcd-ccx-mask-offset! c ctrl-reg ctrl-idx
                               src-reg src-off
                               dst-reg dst-off
                               body-start body-end)
  (let loop ((k body-start))
    (when (< k body-end)
      (gate-ccx! c ctrl-reg ctrl-idx
                 src-reg (+ src-off k)
                 dst-reg (+ dst-off k))
      (loop (+ k 1)))))

;;; dgcd-ctrl-cuccaro-sub-extended! — substrate-faithful sub with the
;;; LATE_BORROW + ODD_U knobs applied.
;;;
;;; Effect (over uv-w bits):
;;;   acc[..uv-w] := acc[..uv-w] - (ctrl ? u[..uv-w] : 0) mod 2^uv-w
;;;
;;; Knob semantics:
;;;   borrow? = #t — host the masking ancilla on u[uv-w..2*uv-w] (which
;;;                  is guaranteed |0> when 2*uv-w <= n+1 by the width-
;;;                  truncation premise). When #f, allocate a fresh
;;;                  uv-w-wide register named mask-name as before.
;;;   odd-u?  = #t — skip lane 0 of the mask compute & cuccaro body;
;;;                  emit a single (gate-cx ctrl acc[0]) instead. Body
;;;                  runs over bits 1..uv-w-1.
;;;
;;; Caller must guarantee:
;;;   - When borrow? = #t: 2 * uv-w <= n+1 (so u[uv-w..2*uv-w] exists).
;;;     u[uv-w..2*uv-w] must be |0> on entry (truncation premise).
;;;     Returns |0> on exit.
;;;   - When odd-u? = #t: ctrl ⇒ (u[0] = 1) AND (acc[0] = ctrl). When
;;;     ctrl = 0 the lane-0 body is a no-op; when ctrl = 1 we have
;;;     acc[0] - u[0] = ctrl - 1 = 0 with no borrow into bit 1.
;;;
;;; cuccaro-sub-offset! n=1 special-cases to (cx a[0] acc[0])(cx cin
;;; acc[0]); we never enter the n=1 sub-body when odd-u? is on because
;;; the body starts at bit 1.

(define (dgcd-ctrl-cuccaro-sub-extended! c
                                         ctrl-reg ctrl-idx
                                         u-reg uv-w n+1
                                         acc-reg
                                         cin-reg cin-idx
                                         mask-name
                                         borrow? odd-u?)
  (let* ((mask-w     (if odd-u? (- uv-w 1) uv-w))
         (body-start (if odd-u? 1 0))
         (body-end   uv-w)
         (mask-host  u-reg)
         (mask-off   uv-w))
    ;; Allocate or alias the mask scratch.
    (cond
      (borrow?
       ;; Aliasing u[uv-w..uv-w+mask-w] as the mask. Requires
       ;; uv-w + mask-w <= n+1 (caller-side guard).
       (when (> (+ uv-w mask-w) n+1)
         (error "dgcd-ctrl-cuccaro-sub-extended!: borrow? requires "
                "uv-w + mask-w <= n+1; uv-w=" uv-w
                " mask-w=" mask-w " n+1=" n+1)))
      (else
       (alloc! c mask-name mask-w)))
    ;; ── compute mask = ctrl AND u over [body-start, body-end) ──
    (cond
      (borrow?
       ;; mask lives at u[uv-w + (k - body-start)]; src is u[k]
       (let loop ((k body-start))
         (when (< k body-end)
           (gate-ccx! c ctrl-reg ctrl-idx
                      u-reg k
                      mask-host (+ uv-w (- k body-start)))
           (loop (+ k 1)))))
      (else
       ;; mask-name lives at index (k - body-start)
       (let loop ((k body-start))
         (when (< k body-end)
           (gate-ccx! c ctrl-reg ctrl-idx
                      u-reg k
                      mask-name (- k body-start))
           (loop (+ k 1))))))
    ;; ── odd-u lane-0 contribution: acc[0] ^= ctrl ──
    (when odd-u?
      (gate-cx! c ctrl-reg ctrl-idx acc-reg 0))
    ;; ── cuccaro-sub-offset over the mask body ──
    (when (> mask-w 0)
      (cond
        (borrow?
         (cuccaro-sub-offset! c mask-host uv-w acc-reg body-start
                              cin-reg cin-idx mask-w))
        (else
         (cuccaro-sub-offset! c mask-name 0 acc-reg body-start
                              cin-reg cin-idx mask-w))))
    ;; ── uncompute mask (ccx self-inverse) ──
    (cond
      (borrow?
       (let loop ((k body-start))
         (when (< k body-end)
           (gate-ccx! c ctrl-reg ctrl-idx
                      u-reg k
                      mask-host (+ uv-w (- k body-start)))
           (loop (+ k 1)))))
      (else
       (let loop ((k body-start))
         (when (< k body-end)
           (gate-ccx! c ctrl-reg ctrl-idx
                      u-reg k
                      mask-name (- k body-start))
           (loop (+ k 1))))))
    ;; ── free the mask register if we allocated it ──
    (when (not borrow?)
      (free! c mask-name))))

(define (dgcd-ctrl-cuccaro-add-extended! c
                                         ctrl-reg ctrl-idx
                                         u-reg uv-w n+1
                                         acc-reg
                                         cin-reg cin-idx
                                         mask-name
                                         borrow? odd-u?)
  "Inverse of dgcd-ctrl-cuccaro-sub-extended!: acc += ctrl ? u : 0
   mod 2^uv-w. Same borrow / odd-u semantics. Used in the s-side
   r-cuccaro-add slot, where the soundness premise on odd-u differs
   (r and s do NOT carry a binary-GCD oddness invariant) — caller
   must therefore NOT set odd-u? = #t when this helper is applied to
   r/s. The kaliski-iteration-dgcd! call sites enforce this."
  (let* ((mask-w     (if odd-u? (- uv-w 1) uv-w))
         (body-start (if odd-u? 1 0))
         (body-end   uv-w)
         (mask-host  u-reg))
    (cond
      (borrow?
       (when (> (+ uv-w mask-w) n+1)
         (error "dgcd-ctrl-cuccaro-add-extended!: borrow? requires "
                "uv-w + mask-w <= n+1; uv-w=" uv-w
                " mask-w=" mask-w " n+1=" n+1)))
      (else
       (alloc! c mask-name mask-w)))
    (cond
      (borrow?
       (let loop ((k body-start))
         (when (< k body-end)
           (gate-ccx! c ctrl-reg ctrl-idx
                      u-reg k
                      mask-host (+ uv-w (- k body-start)))
           (loop (+ k 1)))))
      (else
       (let loop ((k body-start))
         (when (< k body-end)
           (gate-ccx! c ctrl-reg ctrl-idx
                      u-reg k
                      mask-name (- k body-start))
           (loop (+ k 1))))))
    (when odd-u?
      (gate-cx! c ctrl-reg ctrl-idx acc-reg 0))
    (when (> mask-w 0)
      (cond
        (borrow?
         (cuccaro-add-offset! c mask-host uv-w acc-reg body-start
                              cin-reg cin-idx mask-w))
        (else
         (cuccaro-add-offset! c mask-name 0 acc-reg body-start
                              cin-reg cin-idx mask-w))))
    (cond
      (borrow?
       (let loop ((k body-start))
         (when (< k body-end)
           (gate-ccx! c ctrl-reg ctrl-idx
                      u-reg k
                      mask-host (+ uv-w (- k body-start)))
           (loop (+ k 1)))))
      (else
       (let loop ((k body-start))
         (when (< k body-end)
           (gate-ccx! c ctrl-reg ctrl-idx
                      u-reg k
                      mask-name (- k body-start))
           (loop (+ k 1))))))
    (when (not borrow?)
      (free! c mask-name))))

;;; dgcd-borrow-engages? — gate function for LATE_BORROW per iter.
;;;
;;; HEAD's pick_borrow_slice falls back to u-high only when the
;;; compressed future log is short. Our substrate has no future log;
;;; we engage whenever the width-truncation envelope leaves enough
;;; high-zero space on u.

(define (dgcd-borrow-engages? uv-w n+1 odd-u-on?)
  (let ((mask-w (if odd-u-on? (- uv-w 1) uv-w)))
    (and *dgcd-late-borrow-uv-high*
         (>= mask-w 1)
         (<= (+ uv-w mask-w) n+1))))

;;; ── one Kaliski iteration with dialog-gcd width schedule ────────

;;; kaliski-iteration-dgcd! — clone of kaliski-iteration-trunc! but
;;; with the smooth envelope and truncated comparator.
;;;
;;; Identical control flow to kaliski-iteration-trunc!
;;; (mod-inv-by.lsp:1046); only the width helpers change. We name
;;; iteration-local ancillae with a "dg-" prefix so allocator names
;;; don't collide with concurrently-built kaliski-iteration-trunc!
;;; circuits inside the same emitter (defensive — no current call
;;; site mixes them).

(define (kaliski-iteration-dgcd! 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
                                 a-masked-scratch-name)
  "Kaliski iteration under HEAD's DIALOG_GCD width envelope. Same
   semantics as kaliski-iteration-trunc!; widths from dgcd helpers."
  (let* ((a-f      (string->symbol
                    (string-append "kal-dg-a-f-"
                                   (number->string iter-idx))))
         (b-f      (string->symbol
                    (string-append "kal-dg-b-f-"
                                   (number->string iter-idx))))
         (add-f    (string->symbol
                    (string-append "kal-dg-add-f-"
                                   (number->string iter-idx))))
         (l-gt     (string->symbol
                    (string-append "kal-dg-l-gt-"
                                   (number->string iter-idx))))
         (or-chain (string->symbol
                    (string-append "kal-dg-or-chain-"
                                   (number->string iter-idx))))
         (n        (- n+1 1))
         (uv-w     (dgcd-uv-width-raw  iter-idx n+1))
         (uv-n     (- uv-w 1))
         (rs3-w    (mib-rs-step3-width iter-idx n+1))
         (rs9-w    (mib-rs-step9-width iter-idx n+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 check over uv-n bits of v_w ──
    (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)
    (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)

    ;; ── STEP 3: cswap(u, v_w) over uv-w; cswap(r, s) over rs3-w ──
    ;;
    ;; ODD_U fastpath does NOT skip lane 0 of cswap in our substrate.
    ;; Our cswap is controlled by a_f, which fires in the (u[0]=0,
    ;; v_w[0]=1) sub-case where lane-0 swap is NOT identity. HEAD
    ;; can skip because its cswap is controlled by b0_and_b1 =
    ;; v_w[0] AND (u>v_w) which only fires when both are odd
    ;; (cswap on two 1-bits = identity). Substrate mismatch
    ;; documented at HEAD ref mod.rs:24944 + classical trace
    ;; mod-inv-by.lsp:782-785.
    (cswap-reg! c a-f 0 u-name v-w-name uv-w)
    (cswap-reg! c a-f 0 r-name s-name   rs3-w)

    ;; ── STEP 4 ──
    (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)
    ;; sub: borrow + odd-u apply to u→v_w slot (binary-GCD invariant
    ;; carries u). Engagement gate folds *dgcd-late-borrow-uv-high*
    ;; AND room (2*mask-w <= n+1).
    (let* ((odd-u? *dgcd-odd-u-lowbit-fastpath*)
           (borrow? (dgcd-borrow-engages? uv-w n+1 odd-u?))
           (sub-mask (string->symbol
                       (string-append "kal-dg-sub-mask-"
                                      (number->string iter-idx)))))
      (cond
        ((or borrow? odd-u?)
         (dgcd-ctrl-cuccaro-sub-extended! c add-f 0
                                          u-name uv-w n+1
                                          v-w-name
                                          cin-name cin-idx
                                          sub-mask
                                          borrow? odd-u?))
        (else
         (ctrl-cuccaro-sub! c add-f 0 u-name v-w-name uv-w
                            cin-name cin-idx sub-mask))))
    ;; add: r/s side — odd-u does NOT apply here (no oddness on r/s).
    ;; LATE_BORROW also does NOT engage on r/s (r has no truncation
    ;; envelope; full n+1 bits live throughout).
    (ctrl-cuccaro-add! c add-f 0 r-name s-name rs9-w
                       cin-name cin-idx
                       (string->symbol
                        (string-append "kal-dg-add-mask-"
                                       (number->string 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: v_w := v_w >> 1 over uv-w bits ──
    (shift-right-reg! c v-w-name uv-w)

    ;; ── STEP 7+8: r := 2r mod p (full p, see kaliski-iteration-trunc!) ──
    (mod-double-inplace! c r-name n+1 p
                         cin-name cin-idx tmp-name flag-name flag-idx)

    ;; ── STEP 9 ──
    ;; Same lane-0-cswap-preserved policy as STEP 3 — see above.
    (cswap-reg! c a-f 0 u-name v-w-name uv-w)
    (cswap-reg! c a-f 0 r-name s-name   rs9-w)

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

;;; ── mod-inv-by-dialog-gcd! — top-level entry ─────────────────────

;;; Same calling convention as mod-inv-by-refined!. The classical-
;;; replay backward sweep handles the cap-aware uncompute.
;;;
;;; CRITICAL: classical-kaliski-r-final and classical-kaliski-trace
;;; are parameterized by `iters`. We pass the resolved
;;; *dgcd-active-iters* cap so the K-correction and final-state
;;; reset match the capped quantum forward sweep.

(define (mod-inv-by-dialog-gcd! 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 lever.
   Same calling convention as mod-inv-by-refined!. REQUIRES a-reg
   bound via bind-input!/bind-mirror!. *dgcd-active-iters* may cap
   below 2n; correctness gate runs at build time."
  (let* ((n      (- n+1 1))
         (iters  (dgcd-resolve-iters n+1))
         (u      'kal-u)
         (v-w    'kal-v-w)
         (r      'kal-r)
         (s      'kal-s)
         (f      'kal-f)
         (m-hist 'kal-m-hist)
         (mc-tmp 'kal-mc-tmp)
         (mc-pow 'kal-mc-pow)
         (a-mask 'kal-a-masked)
         (a-bound (find-classical-value c a-reg)))
    (cond
      ((<= n 0)
       (error "mod-inv-by-dialog-gcd! requires n+1 > 1; got" n+1))
      ;; *static-circuit-mode*: under K=1, K-correction here is
      ;; `a`-independent (same as mod-inv-by-dialog-gcd-host! above).
      ;; K=2 is gated to host-only at the next branch — no need to
      ;; duplicate the static-mode + K=2 incompatibility check.
      ((and (not a-bound)
            (not *static-circuit-mode*))
       (error "mod-inv-by-dialog-gcd! requires a-reg classical via"
              " bind-input!/bind-mirror!; not found:" a-reg))
      (*dgcd-k2-bounded-shift*
       ;; sweep-k2-port: K=2 bounded shift only ported into the host
       ;; variant. Non-host classical-replay's final-* values reflect
       ;; K=2 forward — but non-host quantum forward sweep does K=1 —
       ;; so the backward sweep would reset to WRONG state. Refuse to
       ;; emit instead of producing a silently-broken .bin. Use the
       ;; host variant (mod-inv-by-dialog-gcd-host!) for K=2.
       (error "*dgcd-k2-bounded-shift* requires HOST_GATED variant. "
              "Set *dgcd-host-gated* and use mod-inv-by-dialog-gcd-host!"))
      (else
       ;; ── Build-time correctness gate: K from a=1 trace must invert ──
       ;; r_on_1 (at the capped iter count) the SAME way it does at 2n.
       ;; If the cap is too aggressive r_on_1 may be 0 (no inverse), in
       ;; which case we error before emitting any gates.
       (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! *dgcd-active-iters* too low: "
                  "r_on_1 mod p = 0 at iters=" iters
                  " n+1=" n+1 " p=" p)))

       ;; ── ODD_U soundness gate ──
       ;; The body fastpath (skip-lane-0 of mask compute + body, with
       ;; cx(add_f, v_w[0]) compensation) is structurally sound on
       ;; our substrate: from the classical kaliski-iteration-trunc!
       ;; trace, add_f=1 occurs ⇔ both u and v_w are odd at the
       ;; body call site (proof: add_f4 = f AND NOT b_f1; b_f1=0
       ;; only when both u, v_w odd). When add_f=1, v_w[0]-u[0] =
       ;; 1-1 = 0 with no borrow into bit 1 — value-exact lane-0
       ;; replacement. The CSWAP lane 0 is NOT skipped (our cswap
       ;; controller a_f fires in u[0]=0,v_w[0]=1 cases where
       ;; lane-0 swap is not identity). HEAD's cswap-skip relies
       ;; on its b0_and_b1 controller which differs from a_f.

       ;; ── Allocate Kaliski state ──
       (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)
       (alloc! c m-hist iters)
       (alloc! c a-mask n+1)

       ;; ── 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 (D1 + D2 + D3) ──
       (let loop ((i 0))
         (when (< i iters)
           (kaliski-iteration-dgcd! 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
                                    a-mask)
           (loop (+ i 1))))

       ;; ── Classical correction K at the capped iter count ──
       (let* ((r-on-1     (classical-kaliski-r-final 1 p iters n+1))
              (k-correct  (classical-mod-inv p r-on-1))
              (k-inverse  r-on-1))
         (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))

       ;; ── Classical-replay backward sweep (capped trace) ──
       (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))))))))
         (classical-reset! c u   n+1 final-u)
         (classical-reset! c v-w n+1 final-v-w)
         (classical-reset! c r   n+1 final-r)
         (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 ──
       (free! c a-mask)
       (free! c m-hist)
       (free! c f)
       (free! c s)
       (free! c r)
       (free! c v-w)
       (free! c u)))))

;;; ── public-name dispatch from mod-inv-by! is NOT done here ───────
;;;
;;; To keep this lever isolated from karatsuba-agent's concurrent
;;; work on mod-inv-by.lsp / variants-real.lsp, the variant entry in
;;; sweep-005 calls mod-inv-by-dialog-gcd! DIRECTLY via a thin
;;; builder. See variants-real.lsp's v-by-dialog-gcd-solinas (added
;;; in this file's load order so existing variants stay untouched).
