engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

factory + quantum + sweep-doctrine: AGPLv3 share-back from foxhop ecdsa

Browse source 
29 new files publish factory infra (V2 autoscaler with live VRAM
sampling + EWMA peak tracking, HUGE solo-dispatch, two-tier DLQ/rDLQ
classifier + retry), general quantum circuit primitives (Cuccaro
ripple-carry adder, Clifford gate library, Clifford tableau simulator,
mod-arith family, dialog GCD reversible inverse, Karatsuba multiplier,
Solinas fast reduction), and a TCRAUDT reducer harness. Originally
developed in ~/git/www.foxhop.net/ecdsa/ for secp256k1 attack-surface
research; published upstream as obligated by AGPLv3.

Parametrization contract at factory/CONTRACT.md. Consumers export
LUMBDA_REPO_DIR + LUMBDA_QUEUE_DIR + LUMBDA_BACKEND_CMD + LUMBDA_EMITTER_CMD
then exec factory scripts. No fork-and-modify; single source of truth
upstream.

Integration tests gate 7 V2 defect classes that wedged a live factory
on 2026-06-12 (skewed-demand starve, zero-floor reservation,
multi-tier greedy, +-25%% damping, cold-start ramp, DLQ surge halve,
post-damp CPU ceiling) + 28 DLQ classifier cases (auto-retry vs
escalate partition) + bash -n syntax lint across every script.

GPU backend stays in consumer trees; rationale in
factory/GPU-BACKEND-NOTE.md. Bend wire protocol + gpu-worker.lsp
already upstream at examples/cuda-fanout/.

make factory-lint                bash -n on every factory/*.sh
make test-integration            V2 reducer + DLQ classifier + syntax gate
make sweep-doctrine              TCRAUDT reducer gate (serial)
make sweep-doctrine-parallel     xargs -P fan-out

Verified on neoblanka: factory-lint 12 scripts PASS; test-integration
14 V2 cases + 28 DLQ classifier cases + 12 syntax cases all PASS.
This commit is contained in:
russell@unturf.com 2026-06-14 10:37:35 -04:00
parent 1db0932fd5
commit 1665893321
No known key found for this signature in database
30 changed files with 19014 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

35
Makefile
View file

@ -224,6 +224,40 @@ endif
gpu-worker-test: gpu-worker-bin
$(MAKE) -C $(GPU_WORKER_DIR) test
# ─── Factory — bend at scale ──────────────────────────────────────
#
# Bounded-parallel emit + dispatch + autoscaling for lumbda research
# loops driving GPU bend backends. See factory/README.md & factory/CONTRACT.md.
# Originally built at foxhop for secp256k1 attack-surface research; shared
# upstream under AGPLv3.
#
# make factory-lint bash -n syntax check on factory/*.sh
# make test-integration integration tests (autoscaler V2 reducer + DLQ classifier)
# make sweep-doctrine TCRAUDT reducer gate (serial)
# make sweep-doctrine-parallel same, xargs -P fan-out (JOBS=N)
#
# Consumer wrapper pattern: domain repos export LUMBDA_* env then exec
# factory/bend-supervisor.sh. See factory/CONTRACT.md.
FACTORY_DIR := factory
TESTS_INTEGRATION_DIR := tests/integration
TESTS_SWEEP_DOCTRINE_DIR := tests/sweep-doctrine
factory-lint:
@bash $(TESTS_INTEGRATION_DIR)/test-bash-script-syntax.sh
test-integration:
@for t in $(TESTS_INTEGRATION_DIR)/test-*.sh; do \
echo "── $$t ──"; \
bash "$$t" || { rc=$$?; [ $$rc -eq 77 ] && echo "SKIP (factory script absent)" || exit $$rc; }; \
done
sweep-doctrine:
@bash $(TESTS_SWEEP_DOCTRINE_DIR)/run.sh
sweep-doctrine-parallel:
@bash $(TESTS_SWEEP_DOCTRINE_DIR)/run-parallel.sh
# ─── Documentation ────────────────────────────────────────────────
DOT_FILES := $(wildcard docs/*.dot)
@ -296,4 +330,5 @@ clean-all: clean clean-whitepaper clean-docs c-clean asm-clean
test-all bench-all examples friction functional-test portal-rng-cross-test \
bench-3way bench-portal bench-portal-cross bench-web bench-rpc-chain bench-proof \
gpu-worker gpu-worker-bin gpu-worker-test \
factory-lint test-integration sweep-doctrine sweep-doctrine-parallel \
docs whitepaper clean clean-whitepaper clean-docs clean-all

16
factory/CHANGELOG.md Normal file
View file

@ -0,0 +1,16 @@
# factory CHANGELOG
## 2026-06-14 — initial upstream port
AGPLv3 share-back from foxhop ecdsa secp256k1 attack-surface research. Port covers:
- V2 live-state autoscaler (EWMA peak tracking, DLQ growth-rate damping, HUGE solo-dispatch, ±25 % per-poll damping, cold-recovery baseline)
- Bounded parallel emit pool with auto-pull-master across multiple repos
- Singleton dispatcher with live tier-config reload
- Two-tier DLQ + rDLQ with class-based auto-retry vs escalate
- Tier classifier (micro/small/medium/large/huge bin bands)
- Supervisor liveness signaling
Env-var contract defined in `CONTRACT.md`. Consumers wrap by exporting env then exec'ing upstream scripts. Single source of truth — no fork-and-modify.
Provenance: foxhop scripts at `~/git/www.foxhop.net/ecdsa/scripts/bend-*` operated this factory from 2026-05 through 2026-06-14, producing measured improvements documented in foxhop's PROVENANCE.md.

62
factory/CONTRACT.md Normal file
View file

@ -0,0 +1,62 @@
# Factory env-var contract
Every upstream factory script reads these env vars. Consumers (foxhop ecdsa, any future lumbda-driven research repo) set them before sourcing or exec'ing factory scripts. Defaults assume a generic lumbda development setup; consumers override for their domain.
## Path knobs
| Var | Default | Purpose |
|---|---|---|
| `LUMBDA_REPO_DIR` | `$HOME/git/lumbda` | Git repo to `git pull --ff-only origin master` at top of every emit-loop iter. Consumers override to their own repo (e.g. foxhop sets `$HOME/git/www.foxhop.net`). |
| `LUMBDA_FACTORY_DIR` | `$LUMBDA_REPO_DIR/factory` | Where upstream factory scripts live. Used for inter-script `exec`/`source` resolution. |
| `LUMBDA_QUEUE_DIR` | `/tmp/lumbda-queue` | Runtime queue + DLQ + rDLQ + supervisor.config home. One per running factory instance. |
| `LUMBDA_DOMAIN_DIR` | unset | Optional domain root (consumer repo's working subdir). Foxhop sets `$HOME/git/www.foxhop.net/ecdsa`. Scripts that resolve `.lsp` cell paths look here. |
## Backend knobs
| Var | Default | Purpose |
|---|---|---|
| `LUMBDA_BACKEND_CMD` | `bend-cuda` | Command the dispatcher exec's per cell. Receives `--portal <bin-path>` as first arg. Consumers point at their compiled backend binary. |
| `LUMBDA_BACKEND_PROC_PATTERN` | `bend-cuda` | `pgrep -f` pattern to count running backend forks for VRAM accounting. Usually same basename as `LUMBDA_BACKEND_CMD`. |
| `LUMBDA_EMITTER_CMD` | unset | Optional emit-side command run by `bend-emit-pool` per `.lsp` cell. If unset, pool only manages queue lifecycle (no emit). Foxhop sets a full `lumbda --fast .../emit-stream.lsp` invocation. |
## Remote knobs
| Var | Default | Purpose |
|---|---|---|
| `LUMBDA_REMOTE` | unset (local) | SSH target (e.g. `user@host`) for remote factory ops. Empty = run locally. |
| `LUMBDA_REMOTE_SSH_OPTS` | `-o BatchMode=yes -o ConnectTimeout=10` | SSH options for remote calls. |
## Autoscaler V2 knobs (all already env-var-gated in source)
| Var | Default | Purpose |
|---|---|---|
| `AUTOSCALER_V2` | `1` | `0` falls back to V1 controller (legacy). |
| `AUTOSCALER_PEAK_INITIAL` | `4096` | Initial per-worker VRAM estimate (MiB). |
| `AUTOSCALER_CPU_CEILING` | `30` | Total worker hard cap (cores + modest oversub). |
| `AUTOSCALER_DLQ_DAMPING_THRESHOLD` | `10` | DLQ entries-per-poll above which damping fires. |
| `AUTO_PULL_MASTER` | `1` | Auto-pull at top of each emit iter (0 disables). |
| `AUTO_PULL_TIMEOUT` | `30` | Seconds for git pull. |
| `LUMBDA_AUTO_PULL_DIRS` | `$LUMBDA_REPO_DIR` | Colon-separated repo dirs to pull each iter. Consumer with both upstream lumbda + domain repo sets e.g. `$HOME/git/lumbda:$HOME/git/www.foxhop.net`. Both pull `--ff-only origin master`; either failure logged as PULL-FAIL but does not abort emit. |
| `TIER_<NAME>_DISPATCH_CEILING` | 24/16/12/6/1 | Per-tier hard cap (micro/small/medium/large/huge). |
| `TIER_<NAME>_MAX` | varies | Per-tier bin-size ceiling (MiB). See `lib-tier.sh`. |
| `TIER_CONFIG_LIVE_RELOAD` | `1` | Dispatcher re-reads supervisor.config per dispatch (no restart needed). |
## Discipline
- Defaults stay generic. Consumers override via wrapper scripts that `export` then `exec`.
- Scripts NEVER hardcode `/tmp/ecdsa-queue`, `bend-cuda`, host names, or repo paths. Always read from env.
- New knobs land with default + table entry above. CHANGELOG entry on add.
- `LUMBDA_FACTORY_DIR/CONTRACT.md` (this file) stays single source of truth; never duplicate var docs in script comment blocks beyond a one-line pointer.
## Consumer wrapper pattern
```bash
#!/bin/bash
# foxhop ecdsa/scripts/bend-supervisor — wraps upstream lumbda factory
export LUMBDA_REPO_DIR="$HOME/git/www.foxhop.net"
export LUMBDA_DOMAIN_DIR="$HOME/git/www.foxhop.net/ecdsa"
export LUMBDA_QUEUE_DIR="/tmp/ecdsa-queue"
export LUMBDA_BACKEND_CMD="$LUMBDA_DOMAIN_DIR/cuda/bend-cuda"
export LUMBDA_EMITTER_CMD="lumbda --fast $LUMBDA_DOMAIN_DIR/lumbda/emit-stream.lsp"
exec "$HOME/git/lumbda/factory/bend-supervisor.sh" "$@"
```

29
factory/GPU-BACKEND-NOTE.md Normal file
View file

@ -0,0 +1,29 @@
# GPU backend — scope note
## What lives upstream
- **bend wire protocol** — `examples/cuda-fanout/` (`gpu-worker.lsp`, `bend.lsp`, `bend-macros.lsp`, `wire.lsp`). S-expression + binary (`BSHK` magic) modes. Tier-agnostic — runs under Python, C, or asm tier.
- **GPU launcher** — `make gpu-worker LUMBDA={c,python,asm} PORT=NNNN`. Spawns gpu-worker.lsp on chosen tier.
- **Factory** — `factory/` orchestrates a queue of cells against any backend reachable via `LUMBDA_BACKEND_CMD`. Backend-agnostic.
## What stays in a domain consumer
Specific GPU simulator backends (Clifford tableau, stabilizer, surface-code) couple deeply to a research domain's operation set. They live in domain consumers:
- Foxhop ecdsa Clifford tableau simulator: `~/git/www.foxhop.net/ecdsa/cuda/` — secp256k1 group operations, `BSHK` binary ops format with secp-specific opcodes.
These backends accept a portal-file interface and expose `LUMBDA_BACKEND_CMD`-compatible call shape. Consumers point factory at their backend; factory provides everything around it (queue, autoscaling, DLQ, tier admission).
## Why a generic Clifford backend stays out of this port
A truly upstream Clifford simulator would need:
1. **Generic ops format** — abstract over per-domain instruction sets (currently `main_ops.c` carries secp-specific group ops).
2. **Domain-agnostic memory model** — current tableau layout sized for n=257 qubits + ancilla; would need width-parametric VRAM accounting.
3. **Standalone test coverage** — current correctness gates run against secp256k1 truth tables.
Each is several days' work + a research-quality decision (which Clifford simulator family becomes canonical upstream). Out of scope for this AGPLv3 share-back. Filed as future work.
## What this means for AGPLv3 compliance
The factory + lumbda quantum primitives discharge the share-back. The domain-specific backend belongs to consumer repos under their own license (AGPLv3 if derivative). Foxhop's `ecdsa/cuda/` remains AGPLv3 in its tree.

93
factory/README.md Normal file
View file

@ -0,0 +1,93 @@
# factory/ — bend at scale
Bounded-parallel emit + dispatch + autoscaling for lumbda research loops driving GPU bend backends. Originally built for foxhop ecdsa secp256k1 attack-surface work (`~/git/www.foxhop.net/ecdsa/`), shared back upstream under AGPLv3.
## What it does
Drives a queue of `.lsp` cells → emitted `.bin` payloads → dispatched to a backend (default `bend-cuda`) → results in a portal file. Survives crashes, OOM, transient CUDA errors via a two-tier DLQ. Adapts concurrency to live VRAM headroom + observed per-fork peak memory.
## Components
- `bend-supervisor.sh` — process orchestrator. Launches pool + dispatcher + autoscaler + DLQ runner.
- `bend-emit-pool.sh` — bounded parallel emit loop. Auto-pulls `LUMBDA_REPO_DIR` per iter.
- `bend-dispatcher.sh` — singleton dispatcher. Reads supervisor.config tier caps live, dispatches `.bin` to backend.
- `bend-autoscaler.sh` — V2 live-state controller. Samples VRAM free + running forks + EWMA peak → plans per-tier caps.
- `bend-supervisor-dlq-runner.sh` — DLQ classifier. Auto-retries transient classes, escalates persistent to rDLQ.
- `lib-tier.sh` — bin-size classifier. Tier bands + HUGE solo-dispatch.
- `lib-heartbeat.sh` — supervisor liveness signaling.
## V2 controller — live VRAM model
Rather than reserving `PEAK × allocated_slots` for every tier (V1's approach, prone to over-reservation under skew), V2 samples actual state:
- `nvidia-smi --query-gpu=memory.free` → live headroom (not fixed budget × fraction)
- `pgrep -f "$LUMBDA_BACKEND_PROC_PATTERN"` + `nvidia-smi --query-compute-apps=used_memory` → fork count + observed peak
- EWMA over observed peaks → per-worker VRAM estimate (file `autoscaler.ewma`)
- Zero-floor on empty tiers (no `MIN=1` reservation)
- Fall-through admission (single-tier demand → grant whole budget to that tier)
- ±25 % per-poll rate-of-change damping
- DLQ growth-rate damping (halve next plan if DLQ growth > threshold)
See `bend-autoscaler.sh` header for signal format + operator overrides.
## HUGE solo-dispatch
Cells that classify as HUGE (4-12 GB bins) get whole-card solo dispatch: when a HUGE bin is queued or in flight, all other tiers plan to 0 until HUGE completes. Damped at 25 %/poll so already-running cells finish naturally (~2 min drain).
Trigger: `r_huge > 0` OR `inflight_huge > 0`. Release: `inflight_huge = 0` AND no queued HUGE.
## Two-tier DLQ + rDLQ
`bend-supervisor-dlq-runner.sh` polls `$LUMBDA_QUEUE_DIR/dlq/` every 30s. Per entry, classifies + acts:
- **Auto-retry classes** (`missing-bin`, `bisect-pool-race`, `cuda-error-transient`, `no-portal`) → move `.bin` back to queue, `.ready` touched, `.retries++`. Cap `AUTO_RETRY_MAX=3` then escalates.
- **Escalate classes** (`cuda-oom`, `cuda-illegal-addr`, `memory-cap-refused`, `bin-load-fail`, `tier-classify`, `emit-broken`, `unknown`) → move to `$LUMBDA_QUEUE_DIR/rdlq/` with full state preservation. Owner inspects + patches + retries.
rDLQ state per cell:
```
rdlq/<tag>.bin (preserved iff stage != emit AND salvage=yes)
rdlq/<tag>.lsp (cell source — required for retry-reemit path)
rdlq/<tag>.reason (original DLQ reason + classifier verdict)
rdlq/<tag>.class (cuda-oom | bin-load-fail | ...)
rdlq/<tag>.stage (emit | dispatch | sim)
rdlq/<tag>.retries (cumulative)
rdlq/<tag>.first-seen (UTC timestamp)
```
## Cold-recovery baseline
V2 writes `$LUMBDA_QUEUE_DIR/supervisor.config.baseline` every poll iff `total >= CPU_CEILING/4`. Last known-healthy cap vector. On autoscaler crash with stale `supervisor.config`:
```bash
cp "$LUMBDA_QUEUE_DIR/supervisor.config.baseline" "$LUMBDA_QUEUE_DIR/supervisor.config"
```
then restart `bend-autoscaler.sh`. Baseline overwritten each healthy poll, tracks workload evolution.
## Configuration
All knobs in `CONTRACT.md`. Defaults assume a generic lumbda dev setup; domain consumers (foxhop ecdsa, etc.) set env vars then exec.
Example consumer wrapper:
```bash
#!/bin/bash
export LUMBDA_REPO_DIR="$HOME/git/www.foxhop.net"
export LUMBDA_DOMAIN_DIR="$HOME/git/www.foxhop.net/ecdsa"
export LUMBDA_QUEUE_DIR="/tmp/ecdsa-queue"
export LUMBDA_BACKEND_CMD="$LUMBDA_DOMAIN_DIR/cuda/bend-cuda"
export LUMBDA_EMITTER_CMD="lumbda --fast $LUMBDA_DOMAIN_DIR/lumbda/emit-stream.lsp"
exec "$HOME/git/lumbda/factory/bend-supervisor.sh" "$@"
```
## Testing
Integration tests at `~/git/lumbda/tests/integration/`:
- `test-bash-script-syntax.sh` — `bash -n` lint gate. Catches the apostrophe-in-bash-c class that took the foxhop factory down 24 min on 2026-06-12.
- `test-autoscaler-v2.sh` — V2 reducer covering 7 defect classes (skewed-demand starve, zero-floor reservation, multi-tier greedy, ±25 % damping, cold-start ramp, DLQ surge halve, post-damp CPU ceiling).
- `test-dlq-runner-classify.sh` — DLQ verdict classifier reducer.
Run: `make -C ~/git/lumbda test-integration`.
## License
AGPLv3. Originally developed at foxhop for secp256k1 attack-surface research; shared upstream as obligated by AGPLv3 share-back when the work runs as a service or against shared infrastructure.

765
factory/bend-autoscaler.sh Executable file
View file

@ -0,0 +1,765 @@
#!/usr/bin/env bash
# bend-autoscaler.sh — bin-pack autopilot for a bend factory.
#
# Watches:
# - .ready / .bin tier distribution on $LUMBDA_QUEUE_DIR
# - live RAM / VRAM headroom on this host
# - current TIER_*_DISPATCH caps (from supervisor.config)
#
# Computes a safe per-tier cap vector that maximizes throughput under a
# memory budget — bin-pack: greedily fill smallest tiers first (highest
# cap, lightest per-dispatch footprint), then ratchet larger tiers until
# predicted RAM/VRAM saturate.
#
# Writes new caps to $LUMBDA_QUEUE_DIR/supervisor.config. Supervisor's
# reload_config picks up our change within $POLL_SECONDS, kills the
# dispatcher, restart loop respawns with new env. No SIGHUP gymnastics.
#
# Tuned for a 24-core / 62 GB RAM / 24 GB VRAM workstation but every
# threshold stays parametric — substrate-grade.
#
# Heartbeat: $LUMBDA_QUEUE_DIR/autoscaler.heartbeat via lib-heartbeat.sh.
# Supervisor restarts us if we go silent.
#
# Exit:
# - SIGTERM/INT
# - $LUMBDA_QUEUE_DIR/AUTOSCALER_STOP marker
#
# Env vars consumed: see $LUMBDA_FACTORY_DIR/CONTRACT.md for our canonical
# table (LUMBDA_QUEUE_DIR, LUMBDA_BACKEND_PROC_PATTERN, AUTOSCALER_V2,
# AUTOSCALER_PEAK_INITIAL, AUTOSCALER_CPU_CEILING,
# AUTOSCALER_DLQ_DAMPING_THRESHOLD, TIER_*_DISPATCH_CEILING, ...).
set -u
QUEUE_DIR="${LUMBDA_QUEUE_DIR:-${QUEUE_DIR:-/tmp/lumbda-queue}}"
POLL_SECONDS="${AUTOSCALER_POLL:-20}"
LOG="${AUTOSCALER_LOG:-$QUEUE_DIR/autoscaler.log}"
CONFIG_FILE="$QUEUE_DIR/supervisor.config"
STOP_FILE="$QUEUE_DIR/AUTOSCALER_STOP"
LUMBDA_FACTORY_DIR="${LUMBDA_FACTORY_DIR:-$(dirname "$(readlink -f "$0")")}"
LIB_HEARTBEAT="${LIB_HEARTBEAT:-$LUMBDA_FACTORY_DIR/lib-heartbeat.sh}"
LIB_TIER="${LIB_TIER:-$LUMBDA_FACTORY_DIR/lib-tier.sh}"
# shellcheck source=/dev/null
. "$LIB_HEARTBEAT"
# shellcheck source=/dev/null
. "$LIB_TIER"
# Backend proc pattern — pgrep -f match for counting in-flight backend forks.
BACKEND_PROC_PATTERN="${LUMBDA_BACKEND_PROC_PATTERN:-bend-cuda}"
# V1 (legacy) — fixed budget × total knobs. Kept as fallback via AUTOSCALER_V2=0.
RAM_BUDGET_FRACTION="${RAM_BUDGET_FRACTION:-0.70}"
VRAM_BUDGET_FRACTION="${VRAM_BUDGET_FRACTION:-0.85}"
MIN_DISPATCH_PER_TIER="${MIN_DISPATCH_PER_TIER:-1}"
# ── V2 controller knobs ──────────────────────────────────────────
# V2 replaces V1's "reserve PEAK × allocated SLOT for every tier" model with
# a live-state model: sample actual VRAM free + running backend fork peaks
# + DLQ growth rate, plan = running + headroom_workers. Fall-through
# admission gives single-tier demand the full budget; ±25 % per-poll rate
# damping prevents oscillation; DLQ surge halves a plan next poll.
AUTOSCALER_V2="${AUTOSCALER_V2:-1}" # 1 = V2 live model (default), 0 = V1 fallback
AUTOSCALER_PEAK_INITIAL="${AUTOSCALER_PEAK_INITIAL:-4096}" # MIB per backend fork before first observation
AUTOSCALER_PEAK_MIN="${AUTOSCALER_PEAK_MIN:-2048}" # MIB floor (never under-estimate)
AUTOSCALER_EWMA_ALPHA="${AUTOSCALER_EWMA_ALPHA:-0.3}" # weight of new observation (0.3 = slow decay; max() biased anyway)
AUTOSCALER_CPU_CEILING="${AUTOSCALER_CPU_CEILING:-30}" # never plan > N total workers (24 cores + modest oversub)
AUTOSCALER_RAMP_FROM_ZERO="${AUTOSCALER_RAMP_FROM_ZERO:-4}" # max plan when cur=0 (cold-start step)
AUTOSCALER_DLQ_DAMPING_THRESHOLD="${AUTOSCALER_DLQ_DAMPING_THRESHOLD:-10}" # DLQ entries/poll above which next plan halves
AUTOSCALER_VRAM_SAFETY_RESERVE_MIB="${AUTOSCALER_VRAM_SAFETY_RESERVE_MIB:-2048}" # never plan into last N MIB of free VRAM
# RAM model — V2 originally used VRAM EWMA peak for RAM headroom too. Real
# backend RSS runs 1.5-2× VRAM (lib-tier.sh:48-49 calibration). Separate
# EWMA for RAM peak avoids over-estimating headroom + edging into swap.
AUTOSCALER_RAM_PEAK_INITIAL="${AUTOSCALER_RAM_PEAK_INITIAL:-6400}" # MIB per fork RSS guess pre-observation
AUTOSCALER_RAM_PEAK_MIN="${AUTOSCALER_RAM_PEAK_MIN:-4096}" # MIB floor on RAM/worker estimate
AUTOSCALER_RAM_SAFETY_RESERVE_MIB="${AUTOSCALER_RAM_SAFETY_RESERVE_MIB:-8192}" # leave N MIB unallocated for OS + pool emits
# Swap-pressure signal — fires when MemAvailable falls below this fraction
# of MemTotal OR when SwapUsed grows over poll period. Triggers a halving
# of plan capacity AND writes pool advisory file so emit pool can slow down.
AUTOSCALER_RAM_PRESSURE_FRACTION="${AUTOSCALER_RAM_PRESSURE_FRACTION:-0.15}" # < 15% free MemAvailable = pressure
AUTOSCALER_SWAP_PRESSURE_DELTA_MIB="${AUTOSCALER_SWAP_PRESSURE_DELTA_MIB:-256}" # SwapUsed grew > N MIB in last poll = active swap
# Per-tier hard ceilings — V2 never plans above these regardless of headroom.
# Same shape as lib-tier.sh defaults but explicit so V2 reads them even when
# autoscaler runs against an unchanged supervisor.config.
TIER_MICRO_DISPATCH_CEILING="${TIER_MICRO_DISPATCH_CEILING:-24}"
TIER_SMALL_DISPATCH_CEILING="${TIER_SMALL_DISPATCH_CEILING:-16}"
TIER_MEDIUM_DISPATCH_CEILING="${TIER_MEDIUM_DISPATCH_CEILING:-12}"
TIER_LARGE_DISPATCH_CEILING="${TIER_LARGE_DISPATCH_CEILING:-6}"
# HUGE — solo-dispatch tier. Cap = 1 enforced + V2 drains all other tiers
# before admitting. Largest candidate bins (6-12 GB) land here.
TIER_HUGE_DISPATCH_CEILING="${TIER_HUGE_DISPATCH_CEILING:-1}"
log() {
local ts msg
ts=$(date +%H:%M:%S)
msg="[$ts] $*"
echo "$msg" | tee -a "$LOG"
}
# Read host capacity. Returns lines:
# total_ram_mib XXXX
# total_vram_mib YYYY
read_capacity() {
local total_ram_kb total_ram_mib total_vram_mib
total_ram_kb=$(awk '/^MemTotal:/ {print $2}' /proc/meminfo 2>/dev/null || echo 0)
total_ram_mib=$((total_ram_kb / 1024))
if command -v nvidia-smi >/dev/null 2>&1; then
total_vram_mib=$(nvidia-smi --query-gpu=memory.total --format=csv,noheader,nounits 2>/dev/null | head -1 | tr -dc 0-9)
fi
[ -z "$total_vram_mib" ] && total_vram_mib=0
printf 'total_ram_mib %d\ntotal_vram_mib %d\n' "$total_ram_mib" "$total_vram_mib"
}
# Count .ready + .bin files per tier in queue. Single ls + stat per call.
# Emits lines: ready_<tier> N (incl. huge — solo-dispatch tier).
count_ready_by_tier() {
declare -A counts
counts[micro]=0; counts[small]=0; counts[medium]=0; counts[large]=0; counts[huge]=0
local f tag sz tier
for f in "$QUEUE_DIR"/*.ready "$QUEUE_DIR"/*.bin; do
[ -f "$f" ] || continue
case "$f" in
*.ready) tag=$(basename "$f" .ready) ;;
*.bin) tag=$(basename "$f" .bin) ;;
esac
# De-dup: prefer .bin (covers .ready + .inflight states)
local bin="$QUEUE_DIR/${tag}.bin"
[ -f "$bin" ] || continue
# Skip cells already done/inflight (in-flight handled by tier_inflight)
[ -f "$QUEUE_DIR/${tag}.done" ] && continue
sz=$(stat -c %s "$bin" 2>/dev/null || echo 0)
tier=$(tier_of_size "$sz")
case "$tier" in
micro|small|medium|large|huge) counts[$tier]=$((counts[$tier] + 1)) ;;
esac
done
for t in micro small medium large huge; do
printf 'ready_%s %d\n' "$t" "${counts[$t]}"
done
}
# Bin-pack: pick per-tier dispatch counts that maximize sum(count_t × value_t)
# under RAM + VRAM budgets. value_t is throughput proxy (assume 1 per dispatch
# slot; weighting by tier's expected wall-time would refine, but uniform-1 is
# a good first cut — our autopilot's job is admission, not perfect throughput).
#
# Greedy: start with all tiers at min, scan small→large. For each tier,
# allocate as many slots as fit AND as demand (ready count) wants AND
# tier's hard ceiling from lib-tier defaults. Stop when budget exhausted.
#
# Outputs four lines:
# plan_micro N
# plan_small N
# plan_medium N
# plan_large N
plan_caps() {
local ram_budget="$1" vram_budget="$2"
local ready_micro="$3" ready_small="$4" ready_medium="$5" ready_large="$6"
local ram_used=0 vram_used=0
declare -A plan demand cap_max cpu vram
plan[micro]=$MIN_DISPATCH_PER_TIER
plan[small]=$MIN_DISPATCH_PER_TIER
plan[medium]=$MIN_DISPATCH_PER_TIER
plan[large]=$MIN_DISPATCH_PER_TIER
demand[micro]=$ready_micro
demand[small]=$ready_small
demand[medium]=$ready_medium
demand[large]=$ready_large
# cap_max = lib-tier HARD CEILINGS (not the live caps autoscaler just
# wrote). Reading from tier_dispatch would chicken-and-egg: autoscaler
# writes cap=1, next iter reads cap_max=1, can never grow back up
# even when budget freed. Hardcode ceilings here so a planner always
# considers a full feasible range.
cap_max[micro]=24
cap_max[small]=16
cap_max[medium]=12
cap_max[large]=6
cpu[micro]=$(tier_cpu_mib micro)
cpu[small]=$(tier_cpu_mib small)
cpu[medium]=$(tier_cpu_mib medium)
cpu[large]=$(tier_cpu_mib large)
vram[micro]=$(tier_vram_mib micro)
vram[small]=$(tier_vram_mib small)
vram[medium]=$(tier_vram_mib medium)
vram[large]=$(tier_vram_mib large)
# Pre-charge minimum-per-tier floor.
local t
for t in micro small medium large; do
ram_used=$((ram_used + plan[$t] * cpu[$t]))
vram_used=$((vram_used + plan[$t] * vram[$t]))
done
# Greedy fill LARGEST tier first. Smaller tiers drain fast (10-30 s
# per cell) so under-allocating them is cheap; large tiers (200+ s
# per cell) starve catastrophically — at L=1 a 40-cell large queue
# takes ~2 hours to drain. Fill large→medium→small→micro so big
# demand gets priority on VRAM budget; small tiers backfill a
# remainder + still clear quickly.
for t in large medium small micro; do
# Skip tiers with no demand.
[ "${demand[$t]}" -eq 0 ] && continue
local want=$((demand[$t] < cap_max[$t] ? demand[$t] : cap_max[$t]))
while [ "${plan[$t]}" -lt "$want" ]; do
local next_ram=$((ram_used + cpu[$t]))
local next_vram=$((vram_used + vram[$t]))
if [ "$next_ram" -gt "$ram_budget" ] || [ "$next_vram" -gt "$vram_budget" ]; then
break
fi
plan[$t]=$((plan[$t] + 1))
ram_used=$next_ram
vram_used=$next_vram
done
done
for t in micro small medium large; do
printf 'plan_%s %d\n' "$t" "${plan[$t]}"
done
printf 'ram_used_mib %d ram_budget_mib %d\n' "$ram_used" "$ram_budget"
printf 'vram_used_mib %d vram_budget_mib %d\n' "$vram_used" "$vram_budget"
}
# Read current TIER_*_DISPATCH values from supervisor.config (if present).
# Emits: cur_<tier> N
read_current_caps() {
local cur_micro="${TIER_MICRO_DISPATCH:-0}"
local cur_small="${TIER_SMALL_DISPATCH:-0}"
local cur_medium="${TIER_MEDIUM_DISPATCH:-0}"
local cur_large="${TIER_LARGE_DISPATCH:-0}"
local cur_huge="${TIER_HUGE_DISPATCH:-0}"
if [ -f "$CONFIG_FILE" ]; then
# shellcheck source=/dev/null
local v
v=$(grep -E '^TIER_MICRO_DISPATCH=' "$CONFIG_FILE" | tail -1 | cut -d= -f2)
[ -n "$v" ] && cur_micro="$v"
v=$(grep -E '^TIER_SMALL_DISPATCH=' "$CONFIG_FILE" | tail -1 | cut -d= -f2)
[ -n "$v" ] && cur_small="$v"
v=$(grep -E '^TIER_MEDIUM_DISPATCH=' "$CONFIG_FILE" | tail -1 | cut -d= -f2)
[ -n "$v" ] && cur_medium="$v"
v=$(grep -E '^TIER_LARGE_DISPATCH=' "$CONFIG_FILE" | tail -1 | cut -d= -f2)
[ -n "$v" ] && cur_large="$v"
v=$(grep -E '^TIER_HUGE_DISPATCH=' "$CONFIG_FILE" | tail -1 | cut -d= -f2)
[ -n "$v" ] && cur_huge="$v"
fi
printf 'cur_micro %d\ncur_small %d\ncur_medium %d\ncur_large %d\ncur_huge %d\n' \
"$cur_micro" "$cur_small" "$cur_medium" "$cur_large" "$cur_huge"
}
# Atomically rewrite supervisor.config preserving non-TIER lines + replacing
# TIER_<NAME>_DISPATCH = plan_<name>. Writes through a tempfile so a partial
# write can't poison a supervisor's source.
write_caps() {
local micro="$1" small="$2" medium="$3" large="$4" huge="$5"
local tmp
tmp="$(mktemp "${CONFIG_FILE}.XXXXXX")"
if [ -f "$CONFIG_FILE" ]; then
grep -vE '^TIER_(MICRO|SMALL|MEDIUM|LARGE|HUGE)_DISPATCH=' "$CONFIG_FILE" > "$tmp"
fi
printf 'TIER_MICRO_DISPATCH=%d\nTIER_SMALL_DISPATCH=%d\nTIER_MEDIUM_DISPATCH=%d\nTIER_LARGE_DISPATCH=%d\nTIER_HUGE_DISPATCH=%d\n' \
"$micro" "$small" "$medium" "$large" "$huge" >> "$tmp"
mv "$tmp" "$CONFIG_FILE"
}
# ── V2 controller ────────────────────────────────────────────────
# All V2 helpers namespaced v2_* so V1 code paths stay readable.
# v2_sample_live — query current VRAM + backend forks + peak per fork +
# count of in-flight HUGE bins + RAM pressure indicators.
# Emits:
# vram_free_mib N
# ram_free_mib N (MemAvailable in MIB)
# ram_total_mib N (MemTotal in MIB — for pressure fraction calc)
# swap_used_mib N (SwapTotal - SwapFree in MIB)
# running_forks N
# observed_peak_mib N (max VRAM use among running backend forks)
# observed_ram_peak_mib N (max RSS among running backend forks — separate
# from VRAM since RSS = 1.5-2x VRAM typically)
# observed_ram_sum_mib N (sum RSS — used to bound headroom_ram + log)
# inflight_huge N (count of HUGE bins claimed by a dispatcher worker
# but not yet .done)
v2_sample_live() {
local vram_free=0 ram_free_kb=0 ram_free=0 ram_total_kb=0 ram_total=0
local swap_total_kb=0 swap_free_kb=0 swap_used=0
local running=0 peak=0 ram_peak=0 ram_sum=0 inflight_huge=0
if command -v nvidia-smi >/dev/null 2>&1; then
vram_free=$(nvidia-smi --query-gpu=memory.free --format=csv,noheader,nounits 2>/dev/null | head -1 | tr -dc 0-9)
[ -z "$vram_free" ] && vram_free=0
fi
ram_free_kb=$(awk '/^MemAvailable:/ {print $2}' /proc/meminfo 2>/dev/null || echo 0)
ram_total_kb=$(awk '/^MemTotal:/ {print $2}' /proc/meminfo 2>/dev/null || echo 0)
swap_total_kb=$(awk '/^SwapTotal:/ {print $2}' /proc/meminfo 2>/dev/null || echo 0)
swap_free_kb=$(awk '/^SwapFree:/ {print $2}' /proc/meminfo 2>/dev/null || echo 0)
ram_free=$((ram_free_kb / 1024))
ram_total=$((ram_total_kb / 1024))
swap_used=$(( (swap_total_kb - swap_free_kb) / 1024 ))
running=$(pgrep -f "$BACKEND_PROC_PATTERN" 2>/dev/null | wc -l)
if [ "$running" -gt 0 ]; then
# VRAM peak via nvidia-smi
if command -v nvidia-smi >/dev/null 2>&1; then
peak=$(nvidia-smi --query-compute-apps=used_memory --format=csv,noheader,nounits 2>/dev/null \
| tr -dc '0-9\n' | grep -v '^$' | sort -n | tail -1)
[ -z "$peak" ] && peak=0
fi
# RAM peak + sum via ps RSS — independent of VRAM since backend RSS
# = ops table + ancilla buffers + CUDA driver context, scales with bin
# size differently than GPU side does.
local rss_list
rss_list=$(pgrep -f "$BACKEND_PROC_PATTERN" 2>/dev/null | xargs -r -I{} ps -o rss= -p {} 2>/dev/null | tr -d ' ')
if [ -n "$rss_list" ]; then
ram_peak=$(echo "$rss_list" | sort -n | tail -1)
ram_peak=$((ram_peak / 1024)) # kB → MIB
ram_sum=$(echo "$rss_list" | awk '{s+=$1} END {print s}')
ram_sum=$((ram_sum / 1024))
fi
fi
# Count in-flight HUGE bins.
shopt -s nullglob
local f tag bin sz
for f in "$QUEUE_DIR"/*.inflight-*; do
[ ! -f "$f" ] && continue
tag=$(basename "$f" | sed 's/\.inflight-[0-9]*$//')
bin="$QUEUE_DIR/${tag}.bin"
[ ! -f "$bin" ] && continue
sz=$(stat -c %s "$bin" 2>/dev/null || echo 0)
if [ "$sz" -gt "${TIER_LARGE_MAX:-4294967296}" ]; then
inflight_huge=$((inflight_huge + 1))
fi
done
shopt -u nullglob
printf 'vram_free_mib %d\nram_free_mib %d\nram_total_mib %d\nswap_used_mib %d\nrunning_forks %d\nobserved_peak_mib %d\nobserved_ram_peak_mib %d\nobserved_ram_sum_mib %d\ninflight_huge %d\n' \
"$vram_free" "$ram_free" "$ram_total" "$swap_used" "$running" "$peak" "$ram_peak" "$ram_sum" "$inflight_huge"
}
# v2_update_ewma — read prior peak from autoscaler.ewma, fold in new sample.
# Bias up (max) for safety so under-estimate is impossible. Floor at
# AUTOSCALER_PEAK_MIN to avoid runaway shrink when zero forks observed.
# Prints new peak.
v2_update_ewma() {
local observed_peak="$1"
local ewma_file="$QUEUE_DIR/autoscaler.ewma"
local old_peak="$AUTOSCALER_PEAK_INITIAL"
if [ -f "$ewma_file" ]; then
local v
v=$(grep -E '^peak_per_worker_mib=' "$ewma_file" | tail -1 | cut -d= -f2)
[ -n "$v" ] && old_peak="$v"
fi
local new_peak
if [ "$observed_peak" -gt 0 ]; then
new_peak=$(awk -v old="$old_peak" -v obs="$observed_peak" -v a="$AUTOSCALER_EWMA_ALPHA" \
'BEGIN { smoothed = old*(1-a) + obs*a;
if (obs > smoothed) smoothed = obs;
printf "%d", smoothed }')
else
new_peak="$old_peak"
fi
[ "$new_peak" -lt "$AUTOSCALER_PEAK_MIN" ] && new_peak="$AUTOSCALER_PEAK_MIN"
{
echo "peak_per_worker_mib=$new_peak"
echo "last_updated=$(date -u +%FT%TZ)"
echo "last_observed_mib=$observed_peak"
} > "$ewma_file"
echo "$new_peak"
}
# v2_update_ram_ewma — same shape as v2_update_ewma but for RAM peak.
# Separate file (autoscaler.ram-ewma) so VRAM + RAM tracks stay independent.
v2_update_ram_ewma() {
local observed_peak="$1"
local ewma_file="$QUEUE_DIR/autoscaler.ram-ewma"
local old_peak="$AUTOSCALER_RAM_PEAK_INITIAL"
if [ -f "$ewma_file" ]; then
local v
v=$(grep -E '^ram_peak_per_worker_mib=' "$ewma_file" | tail -1 | cut -d= -f2)
[ -n "$v" ] && old_peak="$v"
fi
local new_peak
if [ "$observed_peak" -gt 0 ]; then
new_peak=$(awk -v old="$old_peak" -v obs="$observed_peak" -v a="$AUTOSCALER_EWMA_ALPHA" \
'BEGIN { smoothed = old*(1-a) + obs*a;
if (obs > smoothed) smoothed = obs;
printf "%d", smoothed }')
else
new_peak="$old_peak"
fi
[ "$new_peak" -lt "$AUTOSCALER_RAM_PEAK_MIN" ] && new_peak="$AUTOSCALER_RAM_PEAK_MIN"
{
echo "ram_peak_per_worker_mib=$new_peak"
echo "last_updated=$(date -u +%FT%TZ)"
echo "last_observed_mib=$observed_peak"
} > "$ewma_file"
echo "$new_peak"
}
# v2_swap_pressure — read prior swap_used from autoscaler.swap-state,
# diff against current. Returns 1 if SwapUsed grew > threshold MIB in
# last poll, else 0. State file rewritten each call.
v2_swap_pressure() {
local cur_swap_used="$1"
local state="$QUEUE_DIR/autoscaler.swap-state"
local prev_swap=0
if [ -f "$state" ]; then
prev_swap=$(grep -E '^swap_used_mib=' "$state" | tail -1 | cut -d= -f2)
[ -z "$prev_swap" ] && prev_swap=0
fi
local delta=$((cur_swap_used - prev_swap))
echo "swap_used_mib=$cur_swap_used" > "$state"
if [ "$delta" -gt "$AUTOSCALER_SWAP_PRESSURE_DELTA_MIB" ]; then
echo 1
else
echo 0
fi
}
# v2_write_pool_advisory — emit advisory file the pool reads each iter.
# Format: KEY=VALUE lines. Pool can act on:
# slow_emit=1|0 — when 1, pool should reduce concurrent emits
# reason=ram_pressure|swap_active|none
v2_write_pool_advisory() {
local slow="$1" reason="$2"
{
echo "# bend-autoscaler advisory — last update $(date -u +%FT%TZ)"
echo "slow_emit=$slow"
echo "reason=$reason"
} > "$QUEUE_DIR/emit.advisory"
}
# v2_dlq_growth — count DLQ reason files mtime'd in last $1 seconds.
# Used as oversubscription signal: spike in DLQ → halve next plan.
v2_dlq_growth() {
local poll="$1"
local mins=$((poll / 60 + 1))
find "$QUEUE_DIR/dlq" -maxdepth 1 -type f -name '*.reason' -mmin -"$mins" 2>/dev/null | wc -l
}
# v2_damp_change — limit per-tier rate of change to ±25 % per poll.
# Cold start (cur=0) ramps up to AUTOSCALER_RAMP_FROM_ZERO in one step.
v2_damp_change() {
local cur="$1" plan="$2"
if [ "$cur" = "0" ]; then
if [ "$plan" -gt "$AUTOSCALER_RAMP_FROM_ZERO" ]; then
echo "$AUTOSCALER_RAMP_FROM_ZERO"
else
echo "$plan"
fi
return
fi
local max_step=$((cur / 4))
[ "$max_step" -lt 1 ] && max_step=1
if [ "$plan" -gt "$cur" ]; then
local up=$((cur + max_step))
[ "$plan" -gt "$up" ] && plan="$up"
elif [ "$plan" -lt "$cur" ]; then
local dn=$((cur - max_step))
[ "$plan" -lt "$dn" ] && plan="$dn"
fi
echo "$plan"
}
# v2_plan_caps — live-state planner.
# Args (positional):
# 1 vram_free_mib 2 ram_free_mib 3..7 ready_micro/small/medium/large/huge
# 8..12 cur_micro/small/medium/large/huge 13 peak_per_worker_mib
# 14 running_forks 15 dlq_growth 16 inflight_huge
# 17 ram_peak_per_worker_mib 18 ram_total_mib 19 swap_pressure
# Emits plan_<tier> N + diagnostics (headroom_workers, total_budget, dlq_damped,
# huge_active, ram_damped — 1 when RAM pressure halved plan).
v2_plan_caps() {
local vram_free="$1" ram_free="$2"
local r_micro="$3" r_small="$4" r_medium="$5" r_large="$6" r_huge="$7"
local c_micro="$8" c_small="$9" c_medium="${10}" c_large="${11}" c_huge="${12}"
local peak="${13}" running="${14}" dlq_growth="${15}" inflight_huge="${16:-0}"
local ram_peak="${17:-$peak}" ram_total="${18:-0}" swap_pressure="${19:-0}"
# Headroom workers from VRAM. Safety reserve protects against bursty
# forks landing all at once + saturating GPU mid-poll-period.
local vram_after_reserve=$((vram_free - AUTOSCALER_VRAM_SAFETY_RESERVE_MIB))
[ "$vram_after_reserve" -lt 0 ] && vram_after_reserve=0
local headroom_vram=$((vram_after_reserve / peak))
# RAM bound — backend RSS = 1.5-2× VRAM typically (lib-tier.sh:48-49).
# Use SEPARATE ram_peak EWMA + ram_safety_reserve so headroom_ram stays
# honest. Old code shared VRAM peak which OVER-estimated RAM headroom
# + edged into swap on heavy sweep loads.
local ram_after_reserve=$((ram_free - AUTOSCALER_RAM_SAFETY_RESERVE_MIB))
[ "$ram_after_reserve" -lt 0 ] && ram_after_reserve=0
local headroom_ram=$((ram_after_reserve / ram_peak))
local headroom=$headroom_vram
[ "$headroom_ram" -lt "$headroom" ] && headroom=$headroom_ram
# Total budget = workers we COULD have, given current load + headroom.
local total_budget=$((running + headroom))
# Cap at CPU ceiling (24 cores + modest oversub).
[ "$total_budget" -gt "$AUTOSCALER_CPU_CEILING" ] && total_budget=$AUTOSCALER_CPU_CEILING
# RAM-pressure damping — fires when MemAvailable < AUTOSCALER_RAM_PRESSURE_FRACTION
# of total OR active swap (SwapUsed grew > delta MIB last poll). Either
# signal means we sit at swap edge; halving total_budget reduces new
# admissions so running workers can drain + RAM recovers before swap thrash.
local ram_damped=0
local ram_pressure_threshold=$((ram_total * 15 / 100)) # 15% default; matches RAM_PRESSURE_FRACTION
if [ "$ram_total" -gt 0 ] && [ "$ram_free" -lt "$ram_pressure_threshold" ]; then
total_budget=$((total_budget / 2))
ram_damped=1
fi
if [ "$swap_pressure" -eq 1 ]; then
total_budget=$((total_budget / 2))
ram_damped=1
fi
# DLQ damping — surge of DLQ entries means we already over-subscribed
# OR we have a bad-cell batch. Either way, halving caps next poll
# protects against amplification while operator triages.
local dlq_damped=0
if [ "$dlq_growth" -gt "$AUTOSCALER_DLQ_DAMPING_THRESHOLD" ]; then
total_budget=$((total_budget / 2))
dlq_damped=1
fi
# HUGE solo-dispatch branch — must run before normal planning. Triggers:
# (a) r_huge>0 : huge bin queued, waiting for card to drain.
# (b) inflight_huge>0 : a huge already claimed by a dispatcher, still
# executing. Other tiers must stay starved until
# dispatcher releases this slot.
# cur_huge alone is NOT a trigger — stale supervisor.config can hold
# TIER_HUGE_DISPATCH=1 indefinitely with no bin actually running.
local plan_micro=0 plan_small=0 plan_medium=0 plan_large=0 plan_huge=0
local huge_active=0
if [ "$r_huge" -gt 0 ] || [ "$inflight_huge" -gt 0 ]; then
huge_active=1
# Card-empty? Admit huge. "card-empty" signal is running=0
# OR inflight_huge>0 (huge already running counts as "card claimed
# by huge, keep slot open for it to continue").
if [ "$running" -eq 0 ] || [ "$inflight_huge" -gt 0 ]; then
plan_huge="$TIER_HUGE_DISPATCH_CEILING"
fi
# plan_others stays at 0 regardless — drain mode. Damping at the
# tail rate-limits descent so already-running cells finish
# naturally without abrupt kill.
# Emit + return — skip normal multi-tier planning.
plan_micro=$(v2_damp_change "$c_micro" "$plan_micro")
plan_small=$(v2_damp_change "$c_small" "$plan_small")
plan_medium=$(v2_damp_change "$c_medium" "$plan_medium")
plan_large=$(v2_damp_change "$c_large" "$plan_large")
plan_huge=$(v2_damp_change "$c_huge" "$plan_huge")
printf 'plan_micro %d\nplan_small %d\nplan_medium %d\nplan_large %d\nplan_huge %d\n' \
"$plan_micro" "$plan_small" "$plan_medium" "$plan_large" "$plan_huge"
printf 'headroom_workers %d running_forks %d total_budget %d peak_per_worker_mib %d ram_peak_mib %d dlq_damped %d ram_damped %d huge_active %d\n' \
"$headroom" "$running" "$total_budget" "$peak" "$ram_peak" "$dlq_damped" "$ram_damped" "$huge_active"
return
fi
# Tier demand sentinels — V2 zero-floor (V1 forced MIN=1 even on empty).
local nonzero=0
[ "$r_micro" -gt 0 ] && nonzero=$((nonzero + 1))
[ "$r_small" -gt 0 ] && nonzero=$((nonzero + 1))
[ "$r_medium" -gt 0 ] && nonzero=$((nonzero + 1))
[ "$r_large" -gt 0 ] && nonzero=$((nonzero + 1))
if [ "$nonzero" -le 1 ]; then
# Single-tier (or no-demand) — grant full budget to one tier
# with work. Capped at that tier's ceiling.
if [ "$r_large" -gt 0 ]; then
plan_large=$((total_budget < TIER_LARGE_DISPATCH_CEILING ? total_budget : TIER_LARGE_DISPATCH_CEILING))
elif [ "$r_medium" -gt 0 ]; then
plan_medium=$((total_budget < TIER_MEDIUM_DISPATCH_CEILING ? total_budget : TIER_MEDIUM_DISPATCH_CEILING))
elif [ "$r_small" -gt 0 ]; then
plan_small=$((total_budget < TIER_SMALL_DISPATCH_CEILING ? total_budget : TIER_SMALL_DISPATCH_CEILING))
elif [ "$r_micro" -gt 0 ]; then
plan_micro=$((total_budget < TIER_MICRO_DISPATCH_CEILING ? total_budget : TIER_MICRO_DISPATCH_CEILING))
fi
else
# Multi-tier — MIN=1 to each tier with demand, then greedy fill
# largest-tier-first (slow drains get priority on capacity).
local remaining=$total_budget
[ "$r_large" -gt 0 ] && [ "$remaining" -gt 0 ] && { plan_large=1; remaining=$((remaining - 1)); }
[ "$r_medium" -gt 0 ] && [ "$remaining" -gt 0 ] && { plan_medium=1; remaining=$((remaining - 1)); }
[ "$r_small" -gt 0 ] && [ "$remaining" -gt 0 ] && { plan_small=1; remaining=$((remaining - 1)); }
[ "$r_micro" -gt 0 ] && [ "$remaining" -gt 0 ] && { plan_micro=1; remaining=$((remaining - 1)); }
# Greedy: largest tier with demand and below ceiling consumes 1 slot per pass.
while [ "$remaining" -gt 0 ]; do
local advanced=0
if [ "$plan_large" -lt "$TIER_LARGE_DISPATCH_CEILING" ] && [ "$r_large" -gt "$plan_large" ]; then
plan_large=$((plan_large + 1)); remaining=$((remaining - 1)); advanced=1
[ "$remaining" -eq 0 ] && break
fi
if [ "$plan_medium" -lt "$TIER_MEDIUM_DISPATCH_CEILING" ] && [ "$r_medium" -gt "$plan_medium" ]; then
plan_medium=$((plan_medium + 1)); remaining=$((remaining - 1)); advanced=1
[ "$remaining" -eq 0 ] && break
fi
if [ "$plan_small" -lt "$TIER_SMALL_DISPATCH_CEILING" ] && [ "$r_small" -gt "$plan_small" ]; then
plan_small=$((plan_small + 1)); remaining=$((remaining - 1)); advanced=1
[ "$remaining" -eq 0 ] && break
fi
if [ "$plan_micro" -lt "$TIER_MICRO_DISPATCH_CEILING" ] && [ "$r_micro" -gt "$plan_micro" ]; then
plan_micro=$((plan_micro + 1)); remaining=$((remaining - 1)); advanced=1
[ "$remaining" -eq 0 ] && break
fi
[ "$advanced" -eq 0 ] && break
done
fi
# Rate-of-change damping — ±25 % per poll. Prevents oscillation when
# demand or VRAM headroom stays bouncy.
plan_micro=$(v2_damp_change "$c_micro" "$plan_micro")
plan_small=$(v2_damp_change "$c_small" "$plan_small")
plan_medium=$(v2_damp_change "$c_medium" "$plan_medium")
plan_large=$(v2_damp_change "$c_large" "$plan_large")
# Post-damp CPU ceiling — damping toward a HIGHER cur can keep total
# above ceiling. Trim largest tiers first (cheapest to lose a slot at
# slow-drain end). Repeat until within budget.
plan_sum=$((plan_micro + plan_small + plan_medium + plan_large))
while [ "$plan_sum" -gt "$AUTOSCALER_CPU_CEILING" ]; do
if [ "$plan_large" -gt 0 ]; then plan_large=$((plan_large - 1))
elif [ "$plan_medium" -gt 0 ]; then plan_medium=$((plan_medium - 1))
elif [ "$plan_small" -gt 0 ]; then plan_small=$((plan_small - 1))
elif [ "$plan_micro" -gt 0 ]; then plan_micro=$((plan_micro - 1))
else break
fi
plan_sum=$((plan_micro + plan_small + plan_medium + plan_large))
done
# plan_huge always 0 in non-huge branch (handled above + returned early).
printf 'plan_micro %d\nplan_small %d\nplan_medium %d\nplan_large %d\nplan_huge %d\n' \
"$plan_micro" "$plan_small" "$plan_medium" "$plan_large" 0
printf 'headroom_workers %d running_forks %d total_budget %d peak_per_worker_mib %d ram_peak_mib %d dlq_damped %d ram_damped %d huge_active %d\n' \
"$headroom" "$running" "$total_budget" "$peak" "$ram_peak" "$dlq_damped" "$ram_damped" "$huge_active"
}
# ── exit handlers ────────────────────────────────────────────────
EXIT_REASON=""
on_exit() {
local r="${EXIT_REASON:-unknown-exit}"
heartbeat_exit_cause "$QUEUE_DIR" "autoscaler" "$r"
echo "[$(date +%H:%M:%S)] bend-autoscaler exit reason=$r" | tee -a "$LOG"
}
trap on_exit EXIT
trap 'EXIT_REASON=signal-int; exit 130' INT
trap 'EXIT_REASON=signal-term; exit 143' TERM
log "bend-autoscaler start queue=$QUEUE_DIR poll=${POLL_SECONDS}s v2=$AUTOSCALER_V2"
if [ "$AUTOSCALER_V2" = "1" ]; then
log " V2 live model — peak_init=${AUTOSCALER_PEAK_INITIAL}MIB cpu_ceiling=$AUTOSCALER_CPU_CEILING dlq_threshold=$AUTOSCALER_DLQ_DAMPING_THRESHOLD"
else
log " V1 fixed-budget — RAM frac=$RAM_BUDGET_FRACTION VRAM frac=$VRAM_BUDGET_FRACTION"
fi
# Cold-recovery baseline — persist KNOWN-GOOD caps so a cold restart of
# every component (autoscaler crash + supervisor restart with stale
# config) can fall back to a safe operating point. Written each poll
# after a successful plan.
BASELINE_FILE="$QUEUE_DIR/supervisor.config.baseline"
while true; do
heartbeat_touch "$QUEUE_DIR" "autoscaler"
if [ -f "$STOP_FILE" ]; then
log "STOP marker — exiting"
rm -f "$STOP_FILE"
EXIT_REASON="stop-marker"
break
fi
ready_out=$(count_ready_by_tier)
ready_micro=$(echo "$ready_out" | awk '/^ready_micro/ {print $2}')
ready_small=$(echo "$ready_out" | awk '/^ready_small/ {print $2}')
ready_medium=$(echo "$ready_out" | awk '/^ready_medium/ {print $2}')
ready_large=$(echo "$ready_out" | awk '/^ready_large/ {print $2}')
ready_huge=$(echo "$ready_out" | awk '/^ready_huge/ {print $2}')
total_ready=$((ready_micro + ready_small + ready_medium + ready_large + ready_huge))
cur_out=$(read_current_caps)
cur_micro=$(echo "$cur_out" | awk '/^cur_micro/ {print $2}')
cur_small=$(echo "$cur_out" | awk '/^cur_small/ {print $2}')
cur_medium=$(echo "$cur_out" | awk '/^cur_medium/ {print $2}')
cur_large=$(echo "$cur_out" | awk '/^cur_large/ {print $2}')
cur_huge=$(echo "$cur_out" | awk '/^cur_huge/ {print $2}')
if [ "$AUTOSCALER_V2" = "1" ]; then
live_out=$(v2_sample_live)
vram_free_mib=$(echo "$live_out" | awk '/^vram_free_mib/ {print $2}')
ram_free_mib=$(echo "$live_out" | awk '/^ram_free_mib/ {print $2}')
ram_total_mib=$(echo "$live_out" | awk '/^ram_total_mib/ {print $2}')
swap_used_mib=$(echo "$live_out" | awk '/^swap_used_mib/ {print $2}')
running_forks=$(echo "$live_out" | awk '/^running_forks/ {print $2}')
observed_peak_mib=$(echo "$live_out" | awk '/^observed_peak_mib/ {print $2}')
observed_ram_peak_mib=$(echo "$live_out" | awk '/^observed_ram_peak_mib/ {print $2}')
inflight_huge=$(echo "$live_out" | awk '/^inflight_huge/ {print $2}')
peak_per_worker_mib=$(v2_update_ewma "$observed_peak_mib")
ram_peak_per_worker_mib=$(v2_update_ram_ewma "$observed_ram_peak_mib")
dlq_growth=$(v2_dlq_growth "$POLL_SECONDS")
swap_pressure=$(v2_swap_pressure "$swap_used_mib")
plan_out=$(v2_plan_caps \
"$vram_free_mib" "$ram_free_mib" \
"$ready_micro" "$ready_small" "$ready_medium" "$ready_large" "$ready_huge" \
"$cur_micro" "$cur_small" "$cur_medium" "$cur_large" "$cur_huge" \
"$peak_per_worker_mib" "$running_forks" "$dlq_growth" "$inflight_huge" \
"$ram_peak_per_worker_mib" "$ram_total_mib" "$swap_pressure")
# Write pool advisory based on planner verdict — pool reads each iter.
# ram_damped emitted by planner; reuse as advisory trigger.
ram_pressure_active=$(echo "$plan_out" | awk 'match($0, /ram_damped [0-9]+/) {print substr($0, RSTART+11, RLENGTH-11)}')
if [ "${ram_pressure_active:-0}" -eq 1 ]; then
reason="ram_pressure"
[ "$swap_pressure" -eq 1 ] && reason="swap_active"
v2_write_pool_advisory 1 "$reason"
else
v2_write_pool_advisory 0 "none"
fi
diag=$(echo "$plan_out" | grep -E '^headroom_workers')
else
cap_out=$(read_capacity)
total_ram_mib=$(echo "$cap_out" | awk '/^total_ram_mib/ {print $2}')
total_vram_mib=$(echo "$cap_out" | awk '/^total_vram_mib/ {print $2}')
ram_budget=$(awk -v t="$total_ram_mib" -v f="$RAM_BUDGET_FRACTION" 'BEGIN{printf "%d", t*f}')
vram_budget=$(awk -v t="$total_vram_mib" -v f="$VRAM_BUDGET_FRACTION" 'BEGIN{printf "%d", t*f}')
plan_out=$(plan_caps "$ram_budget" "$vram_budget" \
"$ready_micro" "$ready_small" "$ready_medium" "$ready_large")
diag=""
fi
plan_micro=$(echo "$plan_out" | awk '/^plan_micro/ {print $2}')
plan_small=$(echo "$plan_out" | awk '/^plan_small/ {print $2}')
plan_medium=$(echo "$plan_out" | awk '/^plan_medium/ {print $2}')
plan_large=$(echo "$plan_out" | awk '/^plan_large/ {print $2}')
# V1 doesn't emit plan_huge — treat as zero so write_caps still gets 5 args.
plan_huge=$(echo "$plan_out" | awk '/^plan_huge/ {print $2}')
[ -z "$plan_huge" ] && plan_huge=0
# Plan-change log — fires only on a transition. Operators read this to
# see "what caused this dispatch shift".
if [ "$cur_micro" != "$plan_micro" ] || [ "$cur_small" != "$plan_small" ] || \
[ "$cur_medium" != "$plan_medium" ] || [ "$cur_large" != "$plan_large" ] || \
[ "$cur_huge" != "$plan_huge" ]; then
if [ -n "$diag" ]; then
log "ready=$total_ready (μ$ready_micro s$ready_small m$ready_medium L$ready_large H$ready_huge) cur=(μ$cur_micro s$cur_small m$cur_medium L$cur_large H$cur_huge) -> plan=(μ$plan_micro s$plan_small m$plan_medium L$plan_large H$plan_huge) $diag"
else
log "ready=$total_ready (μ$ready_micro s$ready_small m$ready_medium L$ready_large H$ready_huge) cur=(μ$cur_micro s$cur_small m$cur_medium L$cur_large H$cur_huge) -> plan=(μ$plan_micro s$plan_small m$plan_medium L$plan_large H$plan_huge)"
fi
write_caps "$plan_micro" "$plan_small" "$plan_medium" "$plan_large" "$plan_huge"
else
# Stable-plan heartbeat — fires every AUTOSCALER_STABLE_HEARTBEAT_POLLS
# polls (default 6 = 2 min at poll=20s) when plan does NOT change.
# Without this, a long drain phase produces no log output, making
# the autoscaler look frozen to operators reading autoscaler.log
# while it actually polls silently.
STABLE_POLLS=$((${STABLE_POLLS:-0} + 1))
if [ "$STABLE_POLLS" -ge "${AUTOSCALER_STABLE_HEARTBEAT_POLLS:-6}" ]; then
log "STABLE plan=(μ$plan_micro s$plan_small m$plan_medium L$plan_large H$plan_huge) $diag"
STABLE_POLLS=0
fi
fi
# Persist baseline for cold-recovery — only when plan looks healthy
# (total >= AUTOSCALER_CPU_CEILING/4 to filter throttled states).
# HUGE counts toward total though its cap stays solo-1.
plan_total=$((plan_micro + plan_small + plan_medium + plan_large + plan_huge))
if [ "$plan_total" -ge $((AUTOSCALER_CPU_CEILING / 4)) ]; then
{
echo "# bend-autoscaler last-known-good caps — written $(date -u +%FT%TZ)"
echo "# Source for cold recovery: supervisor falls back to this on autoscaler stall."
printf 'TIER_MICRO_DISPATCH=%d\nTIER_SMALL_DISPATCH=%d\nTIER_MEDIUM_DISPATCH=%d\nTIER_LARGE_DISPATCH=%d\nTIER_HUGE_DISPATCH=%d\n' \
"$plan_micro" "$plan_small" "$plan_medium" "$plan_large" "$plan_huge"
} > "$BASELINE_FILE"
fi
sleep "$POLL_SECONDS"
done

192
factory/bend-dispatcher.sh Executable file
View file

@ -0,0 +1,192 @@
#!/usr/bin/env bash
# bend-dispatcher.sh — singleton dispatcher for a circuit-emission pipeline.
#
# Polls $LUMBDA_QUEUE_DIR/*.ready, dispatches each via $LUMBDA_BACKEND_CMD
# (or a custom bend-dispatch.py wrapper named in BEND_DISPATCH), logs result
# to $RESULTS_TSV, removes .bin to free disk, touches .done.
#
# Singleton: refuses to start if another instance holds
# $LUMBDA_QUEUE_DIR/dispatcher.lock.
#
# Exits when no .ready remains AND no .emitting marker AND $LUMBDA_QUEUE_DIR/STOP
# exists, OR after MAX_IDLE_LOOPS (default 60 = 5 min) of empty polling.
#
# Usage: bend-dispatcher.sh [QUEUE_DIR [RESULTS_TSV [BATCHES]]]
# QUEUE_DIR default $LUMBDA_QUEUE_DIR
# RESULTS_TSV default $QUEUE_DIR/results.tsv
# BATCHES default 141
#
# Self-identifies as "bend-dispatcher" in cmdline for precise pkill targeting.
#
# Results TSV row format:
# tag n_ops qubits avg_tof score status identity wall_s
# config_root ops_hash trace_hash score_hash candidate_merkle_root
# Old readers ignore unknown trailing columns. Pre-fingerprint rows have
# these columns empty when migrated.
#
# Env vars consumed: see $LUMBDA_FACTORY_DIR/CONTRACT.md (LUMBDA_QUEUE_DIR,
# LUMBDA_BACKEND_CMD, LUMBDA_DOMAIN_DIR, BEND_DISPATCH, HASHES_PY).
set -u
QUEUE_DIR="${1:-${LUMBDA_QUEUE_DIR:-/tmp/lumbda-queue}}"
RESULTS_TSV="${2:-$QUEUE_DIR/results.tsv}"
BATCHES="${3:-141}"
MAX_IDLE_LOOPS="${MAX_IDLE_LOOPS:-60}"
# BEND_DISPATCH = python wrapper that talks to backend over a portal.
# When unset, consumer should set it via env (foxhop sets to
# $LUMBDA_DOMAIN_DIR/runs/lumbda-sweep-008/bend-dispatch.py).
# HASHES_PY = optional fingerprint helper; falls through to empty columns
# when missing.
LUMBDA_DOMAIN_DIR="${LUMBDA_DOMAIN_DIR:-}"
BEND_DISPATCH="${BEND_DISPATCH:-${LUMBDA_DOMAIN_DIR:+$LUMBDA_DOMAIN_DIR/runs/lumbda-sweep-008/bend-dispatch.py}}"
HASHES_PY="${HASHES_PY:-${LUMBDA_DOMAIN_DIR:+$LUMBDA_DOMAIN_DIR/scripts/ecdsa-hashes.py}}"
mkdir -p "$QUEUE_DIR"
LOCK="$QUEUE_DIR/dispatcher.lock"
echo $$ > "$QUEUE_DIR/dispatcher.pid"
trap 'rm -f "$QUEUE_DIR/dispatcher.pid"' EXIT
exec -a bend-dispatcher bash -c '
QUEUE_DIR="'"$QUEUE_DIR"'"
RESULTS_TSV="'"$RESULTS_TSV"'"
BATCHES="'"$BATCHES"'"
MAX_IDLE_LOOPS="'"$MAX_IDLE_LOOPS"'"
BEND_DISPATCH="'"$BEND_DISPATCH"'"
HASHES_PY="'"$HASHES_PY"'"
LOCK="'"$LOCK"'"
# Singleton via flock
exec 9>"$LOCK"
if ! flock -n 9; then
echo "[$(date +%H:%M:%S)] bend-dispatcher: another instance holds $LOCK, refusing to start"
exit 1
fi
echo "[$(date +%H:%M:%S)] bend-dispatcher start queue=$QUEUE_DIR"
trap "echo \"[\$(date +%H:%M:%S)] bend-dispatcher exit\"; rm -f $LOCK" EXIT
# Header includes fingerprint columns. A fresh results.tsv gets the full
# 13-column header. A pre-fingerprint file with only the original 8 columns
# stays untouched (so readers keyed off the legacy header keep working) but
# every new row gets fingerprints appended after legacy fields.
if [ ! -f "$RESULTS_TSV" ]; then
printf "tag\tn_ops\tqubits\tavg_tof\tscore\tstatus\tidentity\twall_s\tconfig_root\tops_hash\ttrace_hash\tscore_hash\tcandidate_merkle_root\n" > "$RESULTS_TSV"
fi
idle=0
while true; do
ready=$(ls "$QUEUE_DIR"/*.ready 2>/dev/null | sort | head -1)
if [ -z "$ready" ]; then
# check stop conditions
if [ -f "$QUEUE_DIR/STOP" ]; then
n_emitting=$(ls "$QUEUE_DIR"/*.emitting 2>/dev/null | wc -l)
[ "$n_emitting" = "0" ] && { echo "[$(date +%H:%M:%S)] STOP + no emits"; break; }
fi
idle=$((idle + 1))
if [ "$idle" -ge "$MAX_IDLE_LOOPS" ]; then
# nothing in flight, no ready, no new emits coming
n_emitting=$(ls "$QUEUE_DIR"/*.emitting 2>/dev/null | wc -l)
pending=$(ls "$QUEUE_DIR"/*.lsp 2>/dev/null | wc -l)
n_done=$(ls "$QUEUE_DIR"/*.done 2>/dev/null | wc -l)
n_ready_total=$((pending - n_done))
if [ "$n_emitting" = "0" ] && [ "$n_ready_total" -le "0" ]; then
echo "[$(date +%H:%M:%S)] idle drained"
break
fi
idle=0
fi
sleep 5
continue
fi
idle=0
tag=$(basename "$ready" .ready)
bin="$QUEUE_DIR/${tag}.bin"
if [ ! -f "$bin" ]; then
echo "[$(date +%H:%M:%S)] SKIP $tag bin missing"
rm -f "$ready"
touch "$QUEUE_DIR/${tag}.done"
continue
fi
echo "[$(date +%H:%M:%S)] dispatch $tag ($(du -h $bin | cut -f1))"
t0=$(date +%s)
out=$(python3 "$BEND_DISPATCH" "$bin" "$BATCHES" 2>&1)
t1=$(date +%s)
wall=$((t1 - t0))
# Dead-letter detection: dispatch returned non-parseable output (backend
# crashed or empty response). Move bin + ready to DLQ for retry by
# watchdog after backend comes back up. We dont mark .done here so the
# cell stays out of completed state — only DLQ retries fully drain it.
if ! echo "$out" | grep -q "^score = "; then
mkdir -p "$QUEUE_DIR/dlq"
retries=0
if [ -f "$QUEUE_DIR/dlq/${tag}.retries" ]; then
retries=$(cat "$QUEUE_DIR/dlq/${tag}.retries")
fi
retries=$((retries + 1))
echo "[$(date +%H:%M:%S)] DLQ $tag (retry=$retries, wall=${wall}s, backend likely down)"
echo "$out" | tail -10 > "$QUEUE_DIR/dlq/${tag}.reason"
echo "$retries" > "$QUEUE_DIR/dlq/${tag}.retries"
if [ "$retries" -lt 5 ]; then
mv "$bin" "$QUEUE_DIR/dlq/${tag}.bin"
rm -f "$ready"
# Note: do NOT touch .done — cell still pending. Watchdog/reaper
# moves bin back + re-touches .ready after backend stays healthy 60s+.
else
echo "[$(date +%H:%M:%S)] DLQ $tag exhausted retries — marking .done.fail"
rm -f "$bin" "$ready"
touch "$QUEUE_DIR/${tag}.done.fail"
touch "$QUEUE_DIR/${tag}.done"
fi
continue
fi
# Keep last 5 lines: parsed= + score + trace_hash= + raw_portal_resp= +
# trailing newline. Portal-resp blob lets us recompute fingerprints
# offline if dispatcher TSV ever needs re-hashing.
echo "$out" | tail -5 > "$QUEUE_DIR/${tag}.dispatch.log"
nops=$(echo "$out" | grep -oP "n_ops.: \K[0-9]+" | head -1)
qubits=$(echo "$out" | grep -oP "qubits.: \K[0-9]+" | head -1)
tof=$(echo "$out" | grep -oP "avg_tof.: \K[0-9.]+" | head -1)
score=$(echo "$out" | grep -oP "score = .* = \K\S+")
status=$(echo "$out" | grep -oP "status.: .\K[A-Z]+" | head -1)
ident=$(echo "$out" | grep -oP "identity.: .\K[a-z]+" | head -1)
# ── Fingerprint columns ─────────────────────────────────────────────
# cell .lsp drives config_root. Cells get staged into queue dir as
# $QUEUE_DIR/${tag}.lsp by the feeder. When originating .lsp is absent
# (e.g. probe path), config_root falls through to all-zero digest and
# downstream readers can detect absence.
cell="$QUEUE_DIR/${tag}.lsp"
portal_resp=$(echo "$out" | grep -oP "^raw_portal_resp=\K.*" | tail -1)
# Pipe portal response into HASHES_PY so every root and the
# candidate_merkle_root land in a single JSON line. When HASHES_PY is
# unset / missing, fall through with empty columns so legacy callers
# still get the score row.
score_json=$(printf "{\"tag\":\"%s\",\"n_ops\":\"%s\",\"qubits\":\"%s\",\"avg_tof\":\"%s\",\"score\":\"%s\",\"status\":\"%s\",\"identity\":\"%s\",\"wall_s\":\"%s\"}" \
"$tag" "${nops:-}" "${qubits:-}" "${tof:-}" "${score:-}" "${status:-}" "${ident:-}" "$wall")
hash_json="{}"
if [ -n "$HASHES_PY" ] && [ -f "$HASHES_PY" ]; then
hash_json=$(printf "%s" "$portal_resp" | \
python3 "$HASHES_PY" all \
--cell "$cell" \
--bin "$bin" \
--portal-stdin \
--score-json "$score_json" 2>/dev/null || echo "{}")
fi
config_root=$(echo "$hash_json" | python3 -c "import sys,json; d=json.load(sys.stdin); print(d.get(\"config_root\",\"\"))" 2>/dev/null)
ops_hash=$(echo "$hash_json" | python3 -c "import sys,json; d=json.load(sys.stdin); print(d.get(\"ops_hash\",\"\"))" 2>/dev/null)
trace_hash=$(echo "$hash_json" | python3 -c "import sys,json; d=json.load(sys.stdin); print(d.get(\"trace_hash\",\"\"))" 2>/dev/null)
score_hash=$(echo "$hash_json" | python3 -c "import sys,json; d=json.load(sys.stdin); print(d.get(\"score_hash\",\"\"))" 2>/dev/null)
merkle=$(echo "$hash_json" | python3 -c "import sys,json; d=json.load(sys.stdin); print(d.get(\"candidate_merkle_root\",\"\"))" 2>/dev/null)
printf "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\n" \
"$tag" "${nops:-}" "${qubits:-}" "${tof:-}" "${score:-}" "${status:-}" "${ident:-}" "$wall" \
"${config_root:-}" "${ops_hash:-}" "${trace_hash:-}" "${score_hash:-}" "${merkle:-}" \
>> "$RESULTS_TSV"
echo " -> score=$score status=$status identity=$ident wall=${wall}s"
echo " merkle=${merkle:0:16}.. trace=${trace_hash:0:16}.. ops=${ops_hash:0:16}.. config=${config_root:0:16}.."
rm -f "$bin" "$ready"
touch "$QUEUE_DIR/${tag}.done"
done
'

502
factory/bend-emit-pool.sh Executable file
View file

@ -0,0 +1,502 @@
#!/usr/bin/env bash
# bend-emit-pool.sh — bounded parallel emit pool for circuit-emission cells.
#
# Reads work items from $LUMBDA_QUEUE_DIR/*.lsp. For each item <tag>:
# - skips if <tag>.ready or <tag>.done exists
# - skips if <tag>.emitting marker exists (in-flight)
# - throttles to MAX concurrent emits
# - launches $LUMBDA_EMITTER_CMD <tag>.lsp, expects it to write <tag>.bin
# - touches <tag>.ready when bin size > MIN_BIN_SIZE
# - touches <tag>.done if emit fails or bin stays too small
#
# Exits when no .lsp without a marker remains AND no .emitting markers active.
# Touch $LUMBDA_QUEUE_DIR/STOP to halt new launches gracefully.
#
# Liveness:
# - Writes $LUMBDA_QUEUE_DIR/pool.heartbeat (pid + timestamp) at top of every
# loop iter via lib-heartbeat.sh::heartbeat_touch.
# - On every exit path (STOP, drain timeout, signal trap, EXIT trap)
# writes $LUMBDA_QUEUE_DIR/pool.exit-cause with reason + removes heartbeat.
# - Supervisor reads pool.heartbeat to detect silent death.
#
# Usage: bend-emit-pool.sh [MAX [QUEUE_DIR [MIN_BIN_SIZE_BYTES]]]
# MAX default 6
# QUEUE_DIR default $LUMBDA_QUEUE_DIR
# MIN_BIN_SIZE_BYTES default 268435456 (256 MB — sanity check only).
#
# Self-identifies as "bend-emit-pool" in cmdline for precise pkill targeting.
#
# Env vars consumed: see $LUMBDA_FACTORY_DIR/CONTRACT.md (LUMBDA_QUEUE_DIR,
# LUMBDA_DOMAIN_DIR, LUMBDA_REPO_DIR, LUMBDA_EMITTER_CMD, AUTO_PULL_MASTER,
# AUTO_PULL_TIMEOUT, DISK_MIN_FREE_GB, MEM_MIN_FREE_GB, POOL_MAX_IDLE_LOOPS,
# SLOW_MAX).
set -u
MAX="${1:-6}"
QUEUE_DIR="${2:-${LUMBDA_QUEUE_DIR:-/tmp/lumbda-queue}}"
MIN_BIN_SIZE="${3:-268435456}"
LUMBDA_DOMAIN_DIR="${LUMBDA_DOMAIN_DIR:-}"
LUMBDA_REPO_DIR="${LUMBDA_REPO_DIR:-$HOME/git/lumbda}"
LUMBDA_FACTORY_DIR="${LUMBDA_FACTORY_DIR:-$(dirname "$(readlink -f "$0")")}"
LUMBDA_EMITTER_CMD="${LUMBDA_EMITTER_CMD:?LUMBDA_EMITTER_CMD must be set by consumer (e.g. \"lumbda --fast \$LUMBDA_DOMAIN_DIR/lumbda/emit-stream.lsp\")}"
LIB_HEARTBEAT="${LIB_HEARTBEAT:-$LUMBDA_FACTORY_DIR/lib-heartbeat.sh}"
LIB_TIER="${LIB_TIER:-$LUMBDA_FACTORY_DIR/lib-tier.sh}"
mkdir -p "$QUEUE_DIR"
echo $$ > "$QUEUE_DIR/pool.pid"
trap 'rm -f "$QUEUE_DIR/pool.pid"' EXIT
# Self-tag in cmdline so pkill -f bend-emit-pool only matches THIS script,
# not other bash sessions that happen to mention factory paths.
exec -a bend-emit-pool bash -c '
QUEUE_DIR="'"$QUEUE_DIR"'"
MAX="'"$MAX"'"
MIN_BIN_SIZE="'"$MIN_BIN_SIZE"'"
LUMBDA_DOMAIN_DIR="'"$LUMBDA_DOMAIN_DIR"'"
LUMBDA_REPO_DIR="'"$LUMBDA_REPO_DIR"'"
LUMBDA_EMITTER_CMD="'"$LUMBDA_EMITTER_CMD"'"
LIB_HEARTBEAT="'"$LIB_HEARTBEAT"'"
LIB_TIER="'"$LIB_TIER"'"
# Source liveness library — provides heartbeat_touch / heartbeat_is_alive /
# heartbeat_exit_cause. Path resolved by parent shell before exec so inner
# shell does not need to derive its own dirname.
# shellcheck source=/dev/null
. "$LIB_HEARTBEAT"
# Source bin-size tier classifier — provides tier_of_size / tier_label_dlq.
# Pool uses these to route oversize bins (above TIER_LARGE_MAX) to DLQ at
# finalize time instead of letting them flow downstream to crush the
# dispatcher fleet.
# shellcheck source=/dev/null
. "$LIB_TIER"
echo "[$(date +%H:%M:%S)] bend-emit-pool start MAX=$MAX queue=$QUEUE_DIR"
# Exit-cause writers. Every exit path (drain, STOP, signal) records its
# reason via the library before falling off the loop. EXIT trap acts as
# safety net for unforeseen crashes; the loop body sets a more specific
# reason just before break + EXIT trap then forwards it.
POOL_EXIT_REASON=""
on_exit() {
local r="${POOL_EXIT_REASON:-unknown-exit}"
heartbeat_exit_cause "$QUEUE_DIR" "pool" "$r"
echo "[$(date +%H:%M:%S)] bend-emit-pool exit reason=$r"
}
trap on_exit EXIT
trap "POOL_EXIT_REASON=signal-int; exit 130" INT
trap "POOL_EXIT_REASON=signal-term; exit 143" TERM
# Pull origin/master before consuming a cell. Fail-soft: log a warning
# and return non-zero on failure (caller decides whether to keep emitting
# against checkout we have). Cheap (~1s fetch over LAN). Locked by
# .git/index.lock so concurrent pool restarts serialize cleanly.
pull_master_or_log() {
[ "${AUTO_PULL_MASTER:-1}" = "1" ] || return 0
local out rc
out=$(timeout "${AUTO_PULL_TIMEOUT:-30}" git -C "$LUMBDA_REPO_DIR" pull --ff-only origin master 2>&1)
rc=$?
if [ "$rc" -ne 0 ]; then
echo "[$(date +%H:%M:%S)] PULL-FAIL rc=$rc (substrate may be stale): $(echo "$out" | tr "\n" "|" | cut -c-200)"
return "$rc"
fi
if ! echo "$out" | grep -q "Already up to date"; then
echo "[$(date +%H:%M:%S)] PULL ok: $(echo "$out" | tr "\n" "|" | cut -c-200)"
fi
return 0
}
# Self-healing janitor: clear .emitting markers whose emitter PID is dead.
# Called before every slot-count check. Stale markers can accrue when emits
# get SIGKILLed (OOM, manual cleanup) before they can clean up their own
# marker.
#
# Subshell wrapper around emitter touches .ready (or .done) BEFORE removing
# its own .emitting marker. A brief window exists where emitter has exited
# (PID dead) but parent subshell has not finished tail cleanup. If this
# janitor fires in that window, it must NOT treat emit as failed —
# .ready/.done file proves completion. Likewise if a .bin already exists
# at full size, emit was real and .ready marker may already have been
# consumed by dispatcher.
#
# NOTE: comments inside bash -c body must NOT contain apostrophes — each
# closes outer single-quoted argument early + corrupts parse.
heal_stale_markers() {
for em in "$QUEUE_DIR"/*.emitting; do
[ ! -f "$em" ] && continue
pid=$(cat "$em" 2>/dev/null)
if [ -z "$pid" ] || ! kill -0 "$pid" 2>/dev/null; then
tag=$(basename "$em" .emitting)
# If ANY completion artifact already exists, the emit completed
# before this janitor fired. Silently clear stale .emitting marker
# — no HEAL log, no .done touch, no relaunch.
if [ -f "$QUEUE_DIR/${tag}.ready" ] \
|| [ -f "$QUEUE_DIR/${tag}.done" ]; then
rm -f "$em"
continue
fi
# Orphan-bin recovery: if .bin exists at full size but no .ready/.done,
# subshell wrote .bin then died (SIGTERM mid-cleanup) before touching
# .ready. Promote: bin is real, dispatcher should consume it. Truncated
# bins (< MIN_BIN_SIZE) treated as failure — rm + .done so cell does
# not re-emit endlessly.
if [ -f "$QUEUE_DIR/${tag}.bin" ]; then
sz=$(stat -c %s "$QUEUE_DIR/${tag}.bin" 2>/dev/null || echo 0)
magic=$(head -c 8 "$QUEUE_DIR/${tag}.bin" 2>/dev/null)
if [ "$magic" != "QECCOPS1" ]; then
# Header-rewrite never fired. See finalize() comment for the
# SIGKILL/OOM mechanism.
mkdir -p "$QUEUE_DIR/dlq"
echo 1 > "$QUEUE_DIR/dlq/${tag}.retries"
{
echo "tier=zero-magic bin_bytes=$sz"
echo "reason: emit-interrupted (heal-stale path) — bin header magic missing"
echo "first-8-bytes-hex: $(head -c 8 $QUEUE_DIR/${tag}.bin 2>/dev/null | xxd -p -c 8)"
} > "$QUEUE_DIR/dlq/${tag}.reason"
echo "[$(date +%H:%M:%S)] DLQ orphan-bin-zero-magic $tag sz=$sz"
rm -f "$QUEUE_DIR/${tag}.bin"
touch "$QUEUE_DIR/${tag}.done.fail"
touch "$QUEUE_DIR/${tag}.done"
elif [ "$sz" -ge "$MIN_BIN_SIZE" ]; then
touch "$QUEUE_DIR/${tag}.ready"
echo "[$(date +%H:%M:%S)] RECOVER orphan-bin $tag ($(du -h $QUEUE_DIR/${tag}.bin | cut -f1))"
else
rm -f "$QUEUE_DIR/${tag}.bin"
touch "$QUEUE_DIR/${tag}.done"
echo "[$(date +%H:%M:%S)] HEAL orphan-bin-truncated $tag sz=$sz"
fi
rm -f "$em"
continue
fi
echo "[$(date +%H:%M:%S)] HEAL stale $tag (pid=$pid dead)"
rm -f "$em"
touch "$QUEUE_DIR/${tag}.done"
fi
done
}
# Belt-and-suspenders: standalone scan for orphan .bin files whose .emitting
# marker is already gone (different death path than heal_stale_markers).
# Catches:
# - pool subshell died AFTER .emitting was racy-cleaned but
# BEFORE it touched .ready
# - pool process murdered between unrelated janitor pass + .ready touch
# - any .bin left behind by a manual operator intervention
#
# Same recovery rule as .emitting branch: full-size → .ready, truncated →
# rm + .done so cell does not re-emit forever. Skips bins already in flight
# (.inflight-N) or already complete (.ready / .done / .dispatch.log).
# Idempotent — safe to run every loop iter alongside heal_stale_markers.
heal_orphan_bins() {
shopt -s nullglob
for bin in "$QUEUE_DIR"/*.bin; do
tag=$(basename "$bin" .bin)
# Any in-progress or completion artifact = NOT orphan
[ -f "$QUEUE_DIR/${tag}.ready" ] && continue
[ -f "$QUEUE_DIR/${tag}.done" ] && continue
[ -f "$QUEUE_DIR/${tag}.emitting" ] && continue
[ -f "$QUEUE_DIR/${tag}.dispatch.log" ] && continue
if ls "$QUEUE_DIR/${tag}.inflight-"* >/dev/null 2>&1; then
continue
fi
sz=$(stat -c %s "$bin" 2>/dev/null || echo 0)
magic=$(head -c 8 "$bin" 2>/dev/null)
if [ "$magic" != "QECCOPS1" ]; then
# Same emit-interrupted class as finalize() + heal_stale_markers.
mkdir -p "$QUEUE_DIR/dlq"
echo 1 > "$QUEUE_DIR/dlq/${tag}.retries"
{
echo "tier=zero-magic bin_bytes=$sz"
echo "reason: emit-interrupted (orphan-bin-scan path) — bin header magic missing"
echo "first-8-bytes-hex: $(head -c 8 $bin 2>/dev/null | xxd -p -c 8)"
} > "$QUEUE_DIR/dlq/${tag}.reason"
echo "[$(date +%H:%M:%S)] DLQ orphan-bin-scan-zero-magic $tag sz=$sz"
rm -f "$bin"
touch "$QUEUE_DIR/${tag}.done.fail"
touch "$QUEUE_DIR/${tag}.done"
elif [ "$sz" -ge "$MIN_BIN_SIZE" ]; then
touch "$QUEUE_DIR/${tag}.ready"
echo "[$(date +%H:%M:%S)] RECOVER orphan-bin-scan $tag ($(du -h $bin | cut -f1))"
else
rm -f "$bin"
touch "$QUEUE_DIR/${tag}.done"
echo "[$(date +%H:%M:%S)] HEAL orphan-bin-scan-truncated $tag sz=$sz"
fi
done
shopt -u nullglob
}
DISK_MIN_FREE_GB="${DISK_MIN_FREE_GB:-30}"
# Memory-free guard. Each emit RSS sits ~3-4 GiB at peak. With MAX=6 emits
# in flight + backend + dispatchers, total memory pressure can climb fast.
# Hold launches when free RAM falls below MEM_MIN_FREE_GB (default 8 GiB).
# Mirrors disk-free pattern: pool HOLDs rather than spawning an
# overcommit-OOM-kill cascade.
MEM_MIN_FREE_GB="${MEM_MIN_FREE_GB:-8}"
# Idle tolerance — pool stays alive while feeder may push more .lsp cells.
# Default 600 (x 5s = 50 min) — long enough to outlast feeder push cadence
# in normal operation. Exit only on STOP marker OR sustained idle past this
# bound.
POOL_MAX_IDLE_LOOPS="${POOL_MAX_IDLE_LOOPS:-600}"
# Substrate freshness — pull origin/master before emitting each cell so a
# backend never consumes a .lsp against stale substrate. Fail-soft: if pull
# fails (local mods, network), log + continue with checkout we have. Cell
# still emits — log entry tells operator "this host ran against potentially
# stale substrate".
AUTO_PULL_MASTER="${AUTO_PULL_MASTER:-1}"
AUTO_PULL_TIMEOUT="${AUTO_PULL_TIMEOUT:-30}"
# Startup orphan sweep — runs BEFORE main loop so any leftover bins from a
# SIGKILL-d previous pool (whose subshell wrappers died before touching
# .ready) get promoted immediately. In-loop heal also runs, but only after
# a full poll cycle (~5s + admission checks), during which the new pool
# could start spawning fresh emits + pushing past orphans. Catching them
# at startup closes that window.
echo "[$(date +%H:%M:%S)] startup orphan scan"
heal_stale_markers
heal_orphan_bins
idle_loops=0
while true; do
# Heartbeat UNCONDITIONALLY at top of loop. Records both "I am alive"
# mtime + "my pid is X" content. Supervisor on this host reads it every
# poll cycle to decide whether to restart us.
heartbeat_touch "$QUEUE_DIR" "pool"
if [ -f "$QUEUE_DIR/STOP" ]; then
echo "[$(date +%H:%M:%S)] STOP seen"
POOL_EXIT_REASON="stop-marker"
break
fi
pull_master_or_log || true
heal_stale_markers
heal_orphan_bins
# Disk-free guard. Emits land 4-6 GiB bins; running near zero free disk
# makes emitter spin on write retries instead of erroring out. Hold
# launches until at least DISK_MIN_FREE_GB available.
free_gb=$(df -BG --output=avail / 2>/dev/null | tail -1 | tr -dc 0-9)
if [ "${free_gb:-0}" -lt "$DISK_MIN_FREE_GB" ]; then
echo "[$(date +%H:%M:%S)] HOLD disk-free=${free_gb}G < ${DISK_MIN_FREE_GB}G, sleeping"
sleep 30
continue
fi
# Memory-free guard. MAX=6 concurrent emits can each climb to ~3-4 GiB
# RSS; with backend + dispatchers also resident, sustained pressure
# approaches host limits. Hold new launches until MemAvailable >=
# MEM_MIN_FREE_GB so an OOM killer never picks a long-running emit
# at the worst moment. Same backoff sleep as disk guard.
free_mem_kb=$(grep ^MemAvailable: /proc/meminfo 2>/dev/null | tr -dc 0-9)
free_mem_gb=$(( ${free_mem_kb:-0} / 1048576 ))
if [ "$free_mem_gb" -lt "$MEM_MIN_FREE_GB" ]; then
echo "[$(date +%H:%M:%S)] HOLD mem-free=${free_mem_gb}G < ${MEM_MIN_FREE_GB}G, sleeping"
sleep 30
continue
fi
# Read autoscaler advisory + apply dynamic MAX cap when RAM/swap pressure
# detected. If advisory says slow_emit=1, cap concurrency at SLOW_MAX
# (default = MAX/2). When pressure clears the advisory flips back to 0
# and the cap restores. MEM_MIN_FREE_GB hold (above) is still the hard
# floor — advisory acts as a graceful intermediate signal.
effective_max="$MAX"
if [ -f "$QUEUE_DIR/emit.advisory" ]; then
slow=$(grep -E '^slow_emit=' "$QUEUE_DIR/emit.advisory" 2>/dev/null | tail -1 | cut -d= -f2)
if [ "${slow:-0}" = "1" ]; then
effective_max="${SLOW_MAX:-$(( MAX / 2 ))}"
[ "$effective_max" -lt 1 ] && effective_max=1
fi
fi
# Find next pending work item
next=""
for f in "$QUEUE_DIR"/*.lsp; do
[ ! -f "$f" ] && continue
tag=$(basename "$f" .lsp)
[ -f "$QUEUE_DIR/${tag}.ready" ] && continue
[ -f "$QUEUE_DIR/${tag}.done" ] && continue
# .done.fail = operator/caller marked cell as skip (incompatible config,
# poison cell, retracted batch). Without this check pool re-emits the
# cell every iter even after the operator explicitly excluded it.
[ -f "$QUEUE_DIR/${tag}.done.fail" ] && continue
[ -f "$QUEUE_DIR/${tag}.emitting" ] && continue
# Dispatcher worker claims .ready by renaming to .inflight-N (atomic).
# If worker dies mid-dispatch (backend crash, kill, OOM) .inflight-N
# stays + no .done written. Treat .inflight-* as downstream-owned and
# do not re-emit. Dispatcher reclaim path runs at bend-dispatcher
# startup + heals stale .inflight-N back to .ready or .done.
# NOTE: comments here must NOT contain apostrophes — each closes outer
# single-quoted bash -c argument early + corrupts parse.
if ls "$QUEUE_DIR/${tag}.inflight-"* >/dev/null 2>&1; then
continue
fi
# Belt-and-suspenders against HEAL race: if a .bin exists at any size,
# an emit has run. Dispatcher consumes .bin + may delete .ready when
# done, leaving no other markers — without this check main loop would
# relaunch the cell after dispatcher consumed it.
[ -f "$QUEUE_DIR/${tag}.bin" ] && continue
next="$f"
break
done
if [ -z "$next" ]; then
# No new items — wait for in-flight or for feeder to push more.
running=$(ls "$QUEUE_DIR"/*.emitting 2>/dev/null | wc -l)
if [ "$running" = "0" ]; then
idle_loops=$((idle_loops + 1))
if [ "$idle_loops" -ge "$POOL_MAX_IDLE_LOOPS" ]; then
echo "[$(date +%H:%M:%S)] pool drained + idle past $POOL_MAX_IDLE_LOOPS loops"
POOL_EXIT_REASON="drain-timeout"
break
fi
fi
sleep 5
continue
fi
idle_loops=0
# Throttle to MAX concurrent (self-healing each check). Heartbeat again
# inside throttle wait — long emits can hold us here for minutes; without
# re-touching heartbeat supervisor would see us as dead.
while true; do
heartbeat_touch "$QUEUE_DIR" "pool"
heal_stale_markers
heal_orphan_bins
running=$(ls "$QUEUE_DIR"/*.emitting 2>/dev/null | wc -l)
# Compare against effective_max (advisory-aware) rather than raw MAX
# so RAM-pressure slow-down actually reduces concurrency. effective_max
# computed once per main-loop iter against latest advisory.
[ "$running" -lt "$effective_max" ] && break
sleep 3
done
tag=$(basename "$next" .lsp)
echo "[$(date +%H:%M:%S)] launch $tag"
# Subshell: traps EXIT/HUP/TERM so partial emit still finalizes (.ready
# or .done) when parent pool dies during hot-reload. SIGHUP explicitly
# ignored — propagated from a dying parent must NOT kill the wrapper
# mid-cleanup. SIGKILL on us still leaks (no trap fires), but startup
# heal_orphan_bins promotes those bins on next pool start.
(
trap "" HUP
bin="$QUEUE_DIR/${tag}.bin"
finalize() {
if [ -f "$bin" ]; then
sz=$(stat -c %s "$bin" 2>/dev/null || echo 0)
# Bin-magic check FIRST. Interrupted emits (OOM-killed mid-write,
# SIGKILL on emitter hang) leave the 16-byte header reserve as
# zero bytes — emit-stream writes 16 zeros, streams ops, then
# seeks back to byte 0 to rewrite QECCOPS1 + n_ops at the end.
# SIGKILL between those steps strands a file with zero magic.
# Downstream backend chokes with opaque "bad magic" → bin-load-fail
# → DLQ with no useful forensic info. Route here with actual cause
# named so operators can trace back to upstream cell hang instead
# of guessing at load_ops_bin internals.
magic=$(head -c 8 "$bin" 2>/dev/null)
if [ "$magic" != "QECCOPS1" ]; then
mkdir -p "$QUEUE_DIR/dlq"
echo 1 > "$QUEUE_DIR/dlq/${tag}.retries"
{
echo "tier=zero-magic bin_bytes=$sz"
echo "reason: emit-interrupted — bin header magic missing or non-QECCOPS1 (likely SIGKILL or OOM mid-emit; emit-stream header rewrite never fired)"
echo "first-8-bytes-hex: $(head -c 8 "$bin" 2>/dev/null | xxd -p -c 8)"
echo "--- last 10 lines of emit.log ---"
tail -10 "$QUEUE_DIR/${tag}.emit.log" 2>/dev/null
} > "$QUEUE_DIR/dlq/${tag}.reason"
echo "[$(date +%H:%M:%S)] DLQ $tag zero-magic sz=$sz ($(printf %.0f $((sz/1024/1024)))MiB) — emit-interrupted"
rm -f "$bin"
touch "$QUEUE_DIR/${tag}.done.fail"
touch "$QUEUE_DIR/${tag}.done"
rm -f "$QUEUE_DIR/${tag}.emitting"
return 0
fi
# 2nd sub-class: GOOD magic + n_ops=0 — emit wrote QECCOPS1 magic +
# streamed ops but SIGKILL hit between stream-end + finalize seek-
# back-to-byte-8 that rewrites n_ops. Detect via n_ops=0
# implausibility check: any in-tier bin should have n_ops > 0;
# if not, finalize never fired.
n_ops_le=$(dd if="$bin" bs=1 count=8 skip=8 2>/dev/null | xxd -p -c 8)
if [ "$n_ops_le" = "0000000000000000" ]; then
mkdir -p "$QUEUE_DIR/dlq"
echo 1 > "$QUEUE_DIR/dlq/${tag}.retries"
{
echo "tier=zero-n_ops bin_bytes=$sz"
echo "reason: emit-finalize-never-fired — QECCOPS1 magic present but n_ops field at byte 8 is zero (SIGKILL between stream-end + emit-stream seek-back; downstream load_ops_bin would fail length-mismatch)"
echo "n_ops_le_hex: $n_ops_le"
echo "--- last 10 lines of emit.log ---"
tail -10 "$QUEUE_DIR/${tag}.emit.log" 2>/dev/null
} > "$QUEUE_DIR/dlq/${tag}.reason"
echo "[$(date +%H:%M:%S)] DLQ $tag zero-n_ops sz=$sz ($(printf %.0f $((sz/1024/1024)))MiB) — emit-finalize-never-fired"
rm -f "$bin"
touch "$QUEUE_DIR/${tag}.done.fail"
touch "$QUEUE_DIR/${tag}.done"
rm -f "$QUEUE_DIR/${tag}.emitting"
return 0
fi
# Tier-classify the bin. Tier "below-min" / "above-max" → DLQ with
# a typed reason. In-band tiers (micro/small/medium/large) get
# promoted to .ready + dispatcher routes through tier-specific
# admission. lib-tier.sh owns boundary policy.
tier=$(tier_of_size "$sz")
dlq_reason=$(tier_label_dlq "$tier")
if [ -n "$dlq_reason" ]; then
mkdir -p "$QUEUE_DIR/dlq"
echo 1 > "$QUEUE_DIR/dlq/${tag}.retries"
{
echo "tier=$tier bin_bytes=$sz"
echo "reason: $dlq_reason"
echo "--- last 10 lines of emit.log ---"
tail -10 "$QUEUE_DIR/${tag}.emit.log" 2>/dev/null
} > "$QUEUE_DIR/dlq/${tag}.reason"
echo "[$(date +%H:%M:%S)] DLQ $tag tier=$tier sz=$sz ($(printf %.0f $((sz/1024/1024)))MiB) — $dlq_reason"
rm -f "$bin"
touch "$QUEUE_DIR/${tag}.done.fail"
touch "$QUEUE_DIR/${tag}.done"
else
# In-tier bin → optional domain-specific sidecar (vorticity, etc),
# then mark .ready. Sidecar lands next to .bin. Read-only
# post-process; emit substrate untouched. Fail-soft: sidecar
# script errors log + continue — bin still promotes to .ready.
# Dispatcher reads .bin, ignores sidecar; operators + analysis
# tooling consume sidecar opportunistically.
vort="$QUEUE_DIR/${tag}.vorticity.tsv"
if [ -n "$LUMBDA_DOMAIN_DIR" ] && [ -x "$LUMBDA_DOMAIN_DIR/scripts/qubit-vorticity.py" ]; then
if "$LUMBDA_DOMAIN_DIR/scripts/qubit-vorticity.py" "$bin" --out "$vort" \
> "$QUEUE_DIR/${tag}.vorticity.log" 2>&1; then
:
else
echo "[$(date +%H:%M:%S)] vorticity $tag FAILED (see ${tag}.vorticity.log) — promoting bin anyway"
fi
fi
touch "$QUEUE_DIR/${tag}.ready"
echo "[$(date +%H:%M:%S)] ready $tag tier=$tier ($(du -h $bin | cut -f1))"
fi
else
# No bin — emitter errored before writing (undefined flag, syntax
# error, load failure, etc). Emit failures stay DETERMINISTIC —
# retry will fail the same way. Route to DLQ for forensics, mark
# .done.fail + .done so pool skips on next iter (no infinite
# relaunch loop).
mkdir -p "$QUEUE_DIR/dlq"
echo 1 > "$QUEUE_DIR/dlq/${tag}.retries"
tail -10 "$QUEUE_DIR/${tag}.emit.log" 2>/dev/null > "$QUEUE_DIR/dlq/${tag}.reason"
echo "[$(date +%H:%M:%S)] DLQ $tag (emit error — see dlq/${tag}.reason)"
touch "$QUEUE_DIR/${tag}.done.fail"
touch "$QUEUE_DIR/${tag}.done"
fi
rm -f "$QUEUE_DIR/${tag}.emitting"
}
trap finalize EXIT
trap "kill \$lpid 2>/dev/null; finalize; exit 130" INT
trap "kill \$lpid 2>/dev/null; finalize; exit 143" TERM
if [ -n "$LUMBDA_DOMAIN_DIR" ]; then
cd "$LUMBDA_DOMAIN_DIR"
fi
PYTHONUNBUFFERED=1 ECDSA_OUT_BIN="$QUEUE_DIR/${tag}.bin" \
$LUMBDA_EMITTER_CMD "$next" \
> "$QUEUE_DIR/${tag}.emit.log" 2>&1 &
lpid=$!
echo "$lpid" > "$QUEUE_DIR/${tag}.emitting"
wait "$lpid"
) &
done
wait
echo "[$(date +%H:%M:%S)] all emits done"
# Loop exited cleanly via STOP / drain; POOL_EXIT_REASON already set.
# EXIT trap calls heartbeat_exit_cause.
'

278
factory/bend-supervisor-dlq-runner.sh Executable file
View file

@ -0,0 +1,278 @@
#!/usr/bin/env bash
# bend-supervisor-dlq-runner.sh — auto-resolve loop for our DLQ.
#
# Polls $LUMBDA_QUEUE_DIR/dlq every $DLQ_POLL_S seconds. For each retry-
# eligible entry (has a .bin in dlq/), classify by reason file, decide:
#
# AUTO-RETRY → move .bin back to queue + touch .ready. Counters in
# $LUMBDA_QUEUE_DIR/dlq/<tag>.retries persist across passes.
# When retries reach AUTO_RETRY_MAX for an auto class,
# we ESCALATE instead.
#
# ESCALATE → move bin + reason + retries + copy .lsp into
# $LUMBDA_QUEUE_DIR/rdlq/. Cell now waits for operator
# to run a retry workflow.
#
# DROP → for cells whose .bin stays missing or 0-byte (emit truly
# failed; nothing to preserve). Touch .done.fail.
#
# State-stage classification drives WHAT we preserve when escalating:
# stage=emit → .lsp matters, .bin disposable (pool re-emits)
# stage=dispatch → .bin good, dispatcher infrastructure broke; retry
# preserves .bin
# stage=sim → .bin good, but backend failed (OOM / illegal-addr
# / etc). Operator decides: retry with different
# n_batches, or patch backend + rebuild, or quarantine.
#
# Designed to run as one supervisor-managed worker. Heartbeats to
# $LUMBDA_QUEUE_DIR/dlq-runner.heartbeat; supervisor restarts if stale.
#
# Exit signals:
# - $LUMBDA_QUEUE_DIR/DLQ_RUNNER_STOP marker
# - SIGTERM / SIGINT
#
# Env vars consumed: see $LUMBDA_FACTORY_DIR/CONTRACT.md (LUMBDA_QUEUE_DIR,
# DLQ_POLL_S, AUTO_RETRY_MAX, DLQ_RUNNER_LOG).
set -u
QUEUE_DIR="${LUMBDA_QUEUE_DIR:-${QUEUE_DIR:-/tmp/lumbda-queue}}"
DLQ_POLL_S="${DLQ_POLL_S:-30}"
AUTO_RETRY_MAX="${AUTO_RETRY_MAX:-3}"
LOG="${DLQ_RUNNER_LOG:-$QUEUE_DIR/dlq-runner.log}"
STOP_FILE="$QUEUE_DIR/DLQ_RUNNER_STOP"
RDLQ_DIR="$QUEUE_DIR/rdlq"
LUMBDA_FACTORY_DIR="${LUMBDA_FACTORY_DIR:-$(dirname "$(readlink -f "$0")")}"
LIB_HEARTBEAT="${LIB_HEARTBEAT:-$LUMBDA_FACTORY_DIR/lib-heartbeat.sh}"
# shellcheck source=/dev/null
. "$LIB_HEARTBEAT"
mkdir -p "$RDLQ_DIR"
log() {
local ts msg
ts=$(date +%H:%M:%S)
msg="[$ts] $*"
echo "$msg" | tee -a "$LOG"
}
# Classification table — single source of truth. Returns one of:
# auto-retry missing-bin bisect-pool-race cuda-error-transient no-portal
# escalate cuda-oom cuda-illegal-addr bin-load-fail
# memory-cap-refused tier-classify unknown
#
# classify_reason <reason-file>
# echoes "<class> <stage> <salvage_bin>"
# class — one of named classes above
# stage — emit | dispatch | sim
# salvage_bin — yes | no (yes = preserve .bin on escalate; no = re-emit needed)
classify_reason() {
local r="$1"
if [ ! -f "$r" ]; then
echo "unknown unknown no"; return
fi
# Empty or whitespace-only .reason files: classify as transient-empty-reason
# directly. Auto-retry class. After AUTO_RETRY_MAX (3) escalates, but noise
# stays contained AND operators see the right label.
if [ ! -s "$r" ] || ! grep -qE '[^[:space:]]' "$r" 2>/dev/null; then
echo "transient-empty-reason sim yes"; return
fi
# Specific (code XXX) matches FIRST — typed portals carry most reliable
# signal. Generic "cuda-sim-error" / "cuda-error" catch-all comes last
# so bin-load-fail / memory-cap-refused etc. don't get silently swallowed.
if grep -q "cuda-oom\|cudaMalloc.*out of memory\|cudaErrorMemoryAllocation" "$r" 2>/dev/null; then
echo "cuda-oom sim yes"; return
fi
if grep -q "cuda-illegal-addr\|cudaErrorIllegalAddress" "$r" 2>/dev/null; then
echo "cuda-illegal-addr sim yes"; return
fi
if grep -q "memory-cap-refused" "$r" 2>/dev/null; then
echo "memory-cap-refused sim yes"; return
fi
# Fast-fail (backend pre-flight cudaMemGetInfo). Bin is fine; needs
# n_batches reduction or wait for less GPU contention.
if grep -q "vram-budget-refused" "$r" 2>/dev/null; then
echo "vram-budget-refused sim yes"; return
fi
if grep -q "bin-load-fail" "$r" 2>/dev/null; then
echo "bin-load-fail emit no"; return
fi
# Emit-stage (pool DLQ'd at finalize)
if grep -q "tier=zero-magic\|tier=zero-n_ops\|emit-interrupted" "$r" 2>/dev/null; then
echo "emit-broken emit no"; return
fi
if grep -q "tier=above-max\|tier=below-min" "$r" 2>/dev/null; then
echo "tier-classify emit no"; return
fi
# Generic typed cuda error catchall — fired when CUDA_CHECK surfaced an
# error not matched by oom/illegal-addr/memory-cap.
if grep -q "cuda-sim-error\|cuda-error" "$r" 2>/dev/null; then
echo "cuda-error-transient sim yes"; return
fi
# Dispatch-stage (backend infrastructure)
if grep -q "^missing:" "$r" 2>/dev/null; then
echo "missing-bin dispatch yes"; return
fi
# BISECT-DIAG entries are NOT a step6 crash — they are pool finalize()
# race vs heal_orphan_bins where .bin got consumed/deleted between
# subshell-exit and finalize check. Cells actually completed emit. So
# retry-emit is safe; the bin is gone.
if grep -q "BISECT-DIAG" "$r" 2>/dev/null; then
echo "bisect-pool-race emit no"; return
fi
# Generic no-portal — backend crashed without writing typed portal.
if grep -q "no-portal" "$r" 2>/dev/null; then
echo "no-portal sim yes"; return
fi
echo "unknown unknown no"
}
# Auto-retry classes — these resolve themselves with a re-try.
is_auto_class() {
case "$1" in
missing-bin|bisect-pool-race|cuda-error-transient|no-portal|transient-empty-reason) return 0 ;;
*) return 1 ;;
esac
}
# Escalate-on-first-fail classes — no point in auto-retrying.
is_escalate_class() {
case "$1" in
cuda-oom|cuda-illegal-addr|memory-cap-refused|vram-budget-refused|bin-load-fail|tier-classify|emit-broken|unknown) return 0 ;;
*) return 1 ;;
esac
}
# Move <tag> from dlq/ back to queue/ for another dispatcher attempt.
auto_retry_one() {
local tag="$1" reason_class="$2"
local bin="$QUEUE_DIR/dlq/${tag}.bin"
local ready="$QUEUE_DIR/${tag}.ready"
if [ ! -f "$bin" ]; then
# Bin missing in DLQ — nothing to retry. Drop to .done.fail so pool
# stops re-emitting.
touch "$QUEUE_DIR/${tag}.done.fail"
touch "$QUEUE_DIR/${tag}.done"
rm -f "$QUEUE_DIR/dlq/${tag}.reason" "$QUEUE_DIR/dlq/${tag}.retries"
log "DROP $tag class=$reason_class (no .bin in dlq, marking done.fail)"
return
fi
mv "$bin" "$QUEUE_DIR/${tag}.bin"
touch "$ready"
log "AUTO-RETRY $tag class=$reason_class -> .ready"
}
# Escalate <tag> from dlq/ to rdlq/. Preserves .bin if salvage_bin=yes,
# always copies .lsp source for operator to inspect or re-emit from.
escalate_one() {
local tag="$1" reason_class="$2" stage="$3" salvage="$4"
local dlq_bin="$QUEUE_DIR/dlq/${tag}.bin"
local dlq_reason="$QUEUE_DIR/dlq/${tag}.reason"
local dlq_retries="$QUEUE_DIR/dlq/${tag}.retries"
local rdlq_bin="$RDLQ_DIR/${tag}.bin"
local rdlq_reason="$RDLQ_DIR/${tag}.reason"
local rdlq_retries="$RDLQ_DIR/${tag}.retries"
local rdlq_stage="$RDLQ_DIR/${tag}.stage"
local rdlq_class="$RDLQ_DIR/${tag}.class"
local rdlq_lsp="$RDLQ_DIR/${tag}.lsp"
local rdlq_first="$RDLQ_DIR/${tag}.first-seen"
local src_lsp="$QUEUE_DIR/${tag}.lsp"
local retries=0
[ -f "$dlq_retries" ] && retries=$(cat "$dlq_retries" 2>/dev/null)
[ -z "$retries" ] && retries=0
if [ "$salvage" = "yes" ] && [ -f "$dlq_bin" ]; then
mv "$dlq_bin" "$rdlq_bin"
elif [ -f "$dlq_bin" ]; then
# salvage=no — bin is suspect; remove so retry-reemit is the only path
rm -f "$dlq_bin"
fi
# Copy .lsp if it still exists in queue. (Pool may have already
# rm'd it once the cell hit .done.) If missing, escalation goes
# forward without source — operator pulls from git.
if [ -f "$src_lsp" ]; then
cp "$src_lsp" "$rdlq_lsp"
fi
{
echo "# rDLQ entry — escalated $(date -u +%FT%TZ)"
echo "# class: $reason_class"
echo "# stage: $stage"
echo "# salvage_bin: $salvage"
echo "# retries-at-escalation: $retries"
echo ""
echo "## Original DLQ reason:"
if [ -f "$dlq_reason" ]; then cat "$dlq_reason"; fi
} > "$rdlq_reason"
echo "$retries" > "$rdlq_retries"
echo "$stage" > "$rdlq_stage"
echo "$reason_class" > "$rdlq_class"
[ ! -f "$rdlq_first" ] && date -u +%FT%TZ > "$rdlq_first"
rm -f "$dlq_bin" "$dlq_reason" "$dlq_retries"
# Mark .done.fail so pool stops re-emitting while cell sits in rDLQ.
# Re-emit path clears these.
touch "$QUEUE_DIR/${tag}.done.fail"
touch "$QUEUE_DIR/${tag}.done"
log "ESCALATE $tag class=$reason_class stage=$stage salvage=$salvage retries=$retries -> rdlq/"
}
# One pass over the DLQ. Increments cell-local retry only on auto-retry
# decisions (so escalate paths don't inflate counter unfairly).
process_one_pass() {
shopt -s nullglob
local f tag class stage salvage parts
for f in "$QUEUE_DIR"/dlq/*.reason; do
[ -f "$f" ] || continue
tag=$(basename "$f" .reason)
parts=$(classify_reason "$f")
class=$(echo "$parts" | awk '{print $1}')
stage=$(echo "$parts" | awk '{print $2}')
salvage=$(echo "$parts" | awk '{print $3}')
local retries=0
[ -f "$QUEUE_DIR/dlq/${tag}.retries" ] && retries=$(cat "$QUEUE_DIR/dlq/${tag}.retries" 2>/dev/null)
[ -z "$retries" ] && retries=0
if is_escalate_class "$class"; then
escalate_one "$tag" "$class" "$stage" "$salvage"
continue
fi
if is_auto_class "$class"; then
if [ "$retries" -ge "$AUTO_RETRY_MAX" ]; then
# Auto class exhausted retries — escalate.
escalate_one "$tag" "$class" "$stage" "$salvage"
continue
fi
retries=$((retries + 1))
echo "$retries" > "$QUEUE_DIR/dlq/${tag}.retries"
auto_retry_one "$tag" "$class"
continue
fi
# Unknown classifier — escalate defensively (operator decides).
escalate_one "$tag" "$class" "$stage" "$salvage"
done
shopt -u nullglob
}
EXIT_REASON=""
on_exit() {
local r="${EXIT_REASON:-unknown-exit}"
heartbeat_exit_cause "$QUEUE_DIR" "dlq-runner" "$r"
echo "[$(date +%H:%M:%S)] bend-supervisor-dlq-runner exit reason=$r" | tee -a "$LOG"
}
trap on_exit EXIT
trap 'EXIT_REASON=signal-int; exit 130' INT
trap 'EXIT_REASON=signal-term; exit 143' TERM
log "bend-supervisor-dlq-runner start queue=$QUEUE_DIR poll=${DLQ_POLL_S}s auto_max=$AUTO_RETRY_MAX"
while true; do
heartbeat_touch "$QUEUE_DIR" "dlq-runner"
if [ -f "$STOP_FILE" ]; then
log "STOP marker — exiting"
rm -f "$STOP_FILE"
EXIT_REASON="stop-marker"
break
fi
process_one_pass
sleep "$DLQ_POLL_S"
done

353
factory/bend-supervisor.sh Executable file
View file

@ -0,0 +1,353 @@
#!/usr/bin/env bash
# bend-supervisor.sh — per-host local watchdog for a bend factory.
#
# Runs ON each backend host. Owns local liveness for that host's components:
# 1. backend (gpu-worker) on $BEND_PORT_LISTEN
# 2. bend-emit-pool.sh (consumes .lsp from $LUMBDA_QUEUE_DIR)
# 3. bend-dispatcher.sh (consumes .ready, writes results.tsv)
# 4. bend-supervisor-dlq-runner.sh (DLQ classifier + auto-retry)
# 5. bend-autoscaler.sh (V2 live-VRAM controller; optional)
#
# Reads heartbeats produced by lib-heartbeat.sh:
# $LUMBDA_QUEUE_DIR/pool.heartbeat (pool)
# $LUMBDA_QUEUE_DIR/dispatcher-<wid>.heartbeat (dispatcher per worker)
# backend liveness: TCP LISTEN socket on $BEND_PORT_LISTEN (not an hb)
#
# Restart policy:
# - backend: restart when port not listening
# - pool: restart when heartbeat stale AND any .lsp lacks marker
# - dispatcher: restart when ALL workers' heartbeats stale AND .ready
# or .bin exists (work waiting).
#
# Persistent loop. Exit only on:
# - $LUMBDA_QUEUE_DIR/SUPERVISOR_STOP marker
# - SIGINT / SIGTERM
# No auto-exit on idle.
#
# Env vars consumed: see $LUMBDA_FACTORY_DIR/CONTRACT.md (LUMBDA_QUEUE_DIR,
# LUMBDA_FACTORY_DIR, LUMBDA_DOMAIN_DIR, LUMBDA_REPO_DIR, LUMBDA_BACKEND_CMD,
# LUMBDA_EMITTER_CMD, BEND_PORT_LISTEN, BEND_ENDPOINTS, POOL_MAX,
# POOL_MIN_BIN, POOL_BATCHES, POLL_SECONDS, POOL_STALE_SEC, DISP_STALE_SEC,
# SUPERVISOR_LOG).
#
# Usage:
# LUMBDA_QUEUE_DIR=/tmp/lumbda-queue BEND_PORT_LISTEN=8320 \
# bend-supervisor.sh
set -u
QUEUE_DIR="${LUMBDA_QUEUE_DIR:-${QUEUE_DIR:-/tmp/lumbda-queue}}"
LUMBDA_DOMAIN_DIR="${LUMBDA_DOMAIN_DIR:-}"
LUMBDA_REPO_DIR="${LUMBDA_REPO_DIR:-$HOME/git/lumbda}"
LUMBDA_FACTORY_DIR="${LUMBDA_FACTORY_DIR:-$(dirname "$(readlink -f "$0")")}"
# Backend launch knobs — set by consumer.
LUMBDA_BACKEND_CMD="${LUMBDA_BACKEND_CMD:-bend-cuda}"
# Optional cuda-fanout dir for lumbda-worker bootstrap script.
CUDA_FANOUT_DIR="${CUDA_FANOUT_DIR:-$LUMBDA_REPO_DIR/examples/cuda-fanout}"
# Lumbda C binary — needed only for the gpu-worker.lsp bootstrap path.
# Consumer can override; if missing we skip the worker launch helper and
# the operator handles backend lifecycle out-of-band.
LUMBDA_C_BIN="${LUMBDA_C_BIN:-$LUMBDA_REPO_DIR/c/lumbda}"
BEND_PORT_LISTEN="${BEND_PORT_LISTEN:-8320}"
BEND_ENDPOINTS="${BEND_ENDPOINTS:-127.0.0.1:${BEND_PORT_LISTEN}}"
POOL_MAX="${POOL_MAX:-12}"
POOL_MIN_BIN="${POOL_MIN_BIN:-268435456}"
POOL_BATCHES="${POOL_BATCHES:-141}"
POLL_SECONDS="${POLL_SECONDS:-30}"
POOL_STALE_SEC="${POOL_STALE_SEC:-180}"
DISP_STALE_SEC="${DISP_STALE_SEC:-300}"
SUPERVISOR_LOG="${SUPERVISOR_LOG:-$QUEUE_DIR/supervisor.log}"
LIB_HEARTBEAT="${LIB_HEARTBEAT:-$LUMBDA_FACTORY_DIR/lib-heartbeat.sh}"
LIB_TIER="${LIB_TIER:-$LUMBDA_FACTORY_DIR/lib-tier.sh}"
# shellcheck source=/dev/null
. "$LIB_HEARTBEAT"
# Source tier policy so reload_config's tier_fingerprint sees defaults at
# first boot. supervisor.config overrides flow through `set -a; . "$CONFIG_FILE";
# set +a` below + propagate to child env.
# shellcheck source=/dev/null
. "$LIB_TIER"
mkdir -p "$QUEUE_DIR"
PID_FILE="$QUEUE_DIR/supervisor.pid"
STOP_FILE="$QUEUE_DIR/SUPERVISOR_STOP"
# Singleton via PID file. If a prior supervisor's pid stays alive, refuse
# to start. If pidfile stays stale (pid dead), claim it.
if [ -f "$PID_FILE" ]; then
old_pid=$(cat "$PID_FILE" 2>/dev/null)
if [ -n "$old_pid" ] && kill -0 "$old_pid" 2>/dev/null; then
echo "[$(date +%H:%M:%S)] bend-supervisor: another instance alive (pid=$old_pid); refusing to start" >&2
exit 1
fi
fi
echo $$ > "$PID_FILE"
SUP_EXIT_REASON=""
on_exit() {
local r="${SUP_EXIT_REASON:-unknown-exit}"
heartbeat_exit_cause "$QUEUE_DIR" "supervisor" "$r"
rm -f "$PID_FILE"
echo "[$(date +%H:%M:%S)] bend-supervisor exit reason=$r" >> "$SUPERVISOR_LOG"
}
trap on_exit EXIT
trap 'SUP_EXIT_REASON=signal-int; exit 130' INT
trap 'SUP_EXIT_REASON=signal-term; exit 143' TERM
log() {
local ts msg
ts=$(date +%H:%M:%S)
msg="[$ts] $*"
echo "$msg" | tee -a "$SUPERVISOR_LOG"
}
log "bend-supervisor start queue=$QUEUE_DIR port=$BEND_PORT_LISTEN"
log " pool-stale=${POOL_STALE_SEC}s disp-stale=${DISP_STALE_SEC}s poll=${POLL_SECONDS}s"
# ── component-1: backend (gpu-worker) ───────────────────────────────
# Listening on TCP $BEND_PORT_LISTEN means alive. No heartbeat file —
# backend = lumbda + cuda, not a script we own.
bend_port_listening() {
ss -tnlp 2>/dev/null | grep -q "0.0.0.0:${BEND_PORT_LISTEN} "
}
restart_bend() {
log "restart backend gpu-worker on :${BEND_PORT_LISTEN}"
local launch_lsp="/tmp/launch-worker-${BEND_PORT_LISTEN}.lsp"
local bend_log="/tmp/bend-worker-${BEND_PORT_LISTEN}.log"
if [ ! -x "$LUMBDA_C_BIN" ] || [ ! -d "$CUDA_FANOUT_DIR" ]; then
log "skip backend restart — LUMBDA_C_BIN ($LUMBDA_C_BIN) or CUDA_FANOUT_DIR ($CUDA_FANOUT_DIR) missing; consumer owns backend lifecycle"
return 1
fi
printf '%s\n' \
"(define *argv* (quote (\"--port\" \"${BEND_PORT_LISTEN}\")))" \
"(load \"wire.lsp\")" \
"(load \"gpu-worker.lsp\")" \
"(main)" \
> "$launch_lsp"
(
cd "$CUDA_FANOUT_DIR" || exit 1
PYTHONUNBUFFERED=1 nohup "$LUMBDA_C_BIN" "$launch_lsp" \
>> "$bend_log" 2>&1 &
)
sleep 5
if bend_port_listening; then
log "backend back up on :${BEND_PORT_LISTEN}"
return 0
fi
log "backend FAILED to come back up — will retry next poll"
return 1
}
# ── component-2: bend-emit-pool ─────────────────────────────────────
# Heartbeat at $QUEUE_DIR/pool.heartbeat. Stale check delegated to lib.
# Restart predicate: stale AND there's actually un-emitted work.
pool_alive() {
heartbeat_is_alive "$QUEUE_DIR" "pool" "$POOL_STALE_SEC"
}
count_unworked_lsp() {
local n=0
for f in "$QUEUE_DIR"/*.lsp; do
[ -f "$f" ] || continue
local tag
tag=$(basename "$f" .lsp)
[ -f "$QUEUE_DIR/${tag}.ready" ] && continue
[ -f "$QUEUE_DIR/${tag}.done" ] && continue
[ -f "$QUEUE_DIR/${tag}.emitting" ] && continue
n=$((n + 1))
done
echo "$n"
}
restart_pool() {
# Factory-protection: bash -n the pool script BEFORE spawning. A
# one-character apostrophe in a comment can close the outer
# exec -a NAME bash -c quote and crash-loop a pool every 30s.
# bash -n catches that statically. If a script breaks, refuse to
# spawn + log loudly. Last-known-good in-memory pool keeps running
# until a human fixes master.
local pool_script="$LUMBDA_FACTORY_DIR/bend-emit-pool.sh"
if ! bash -n "$pool_script" 2>/tmp/pool-syntax.err; then
log "REFUSING to spawn pool — bend-emit-pool.sh failed bash -n:"
sed 's/^/ /' /tmp/pool-syntax.err | while read line; do log "$line"; done
log "fix master + push; supervisor will retry on next loop"
rm -f /tmp/pool-syntax.err
return 1
fi
rm -f /tmp/pool-syntax.err
log "restart bend-emit-pool"
# Clean stale .emitting + STOP markers before relaunch — the old pool
# may have left these around.
rm -f "$QUEUE_DIR"/*.emitting "$QUEUE_DIR/STOP" 2>/dev/null
LUMBDA_DOMAIN_DIR="$LUMBDA_DOMAIN_DIR" \
LUMBDA_REPO_DIR="$LUMBDA_REPO_DIR" \
LUMBDA_FACTORY_DIR="$LUMBDA_FACTORY_DIR" \
LUMBDA_EMITTER_CMD="${LUMBDA_EMITTER_CMD:-}" \
setsid nohup "$pool_script" \
"$POOL_MAX" "$QUEUE_DIR" "$POOL_MIN_BIN" \
>> "$QUEUE_DIR/pool.log" 2>&1 < /dev/null &
}
# ── component-3: bend-dispatcher ────────────────────────────────────
# Multi-worker dispatcher writes per-worker heartbeats. Considered alive
# if ANY worker's heartbeat stays fresh — single-worker stalls absorbed
# by others. Considered dead only if NO worker heartbeat stays fresh
# AND .ready or .bin work waits.
#
# Discovery: glob $QUEUE_DIR/dispatcher-*.heartbeat. Empty glob → no
# dispatcher ever ran → restart if work waits.
dispatcher_any_alive() {
local hb
for hb in "$QUEUE_DIR"/dispatcher-*.heartbeat; do
[ -f "$hb" ] || continue
local svc
svc=$(basename "$hb" .heartbeat)
if heartbeat_is_alive "$QUEUE_DIR" "$svc" "$DISP_STALE_SEC"; then
return 0
fi
done
# Fall through: singleton dispatcher (this script) writes
# dispatcher.heartbeat directly when present.
heartbeat_is_alive "$QUEUE_DIR" "dispatcher" "$DISP_STALE_SEC"
}
count_dispatchable() {
local n
n=$(ls "$QUEUE_DIR"/*.ready "$QUEUE_DIR"/*.bin 2>/dev/null | wc -l)
echo "$n"
}
restart_dispatcher() {
log "restart bend-dispatcher BEND_ENDPOINTS=$BEND_ENDPOINTS"
# Stale heartbeats / inflight markers will be reclaimed by a new
# dispatcher's startup orphan-reclaim block. Clean only the lock so
# new instance can flock.
rm -f "$QUEUE_DIR/dispatcher.lock" "$QUEUE_DIR"/dispatcher-*.heartbeat 2>/dev/null
BEND_ENDPOINTS="$BEND_ENDPOINTS" \
LUMBDA_DOMAIN_DIR="$LUMBDA_DOMAIN_DIR" \
LUMBDA_BACKEND_CMD="$LUMBDA_BACKEND_CMD" \
setsid nohup "$LUMBDA_FACTORY_DIR/bend-dispatcher.sh" \
"$QUEUE_DIR" "$QUEUE_DIR/results.tsv" "$POOL_BATCHES" \
>> "$QUEUE_DIR/dispatcher.log" 2>&1 < /dev/null &
}
# DLQ runner — auto-resolves transient DLQ classes (missing-bin,
# bisect-pool-race, transient cuda-error, no-portal) and escalates the
# persistent classes to rdlq/.
DLQ_RUNNER_STALE_SEC="${DLQ_RUNNER_STALE_SEC:-180}"
dlq_runner_alive() {
heartbeat_is_alive "$QUEUE_DIR" "dlq-runner" "$DLQ_RUNNER_STALE_SEC"
}
restart_dlq_runner() {
log "restart bend-supervisor-dlq-runner"
LUMBDA_QUEUE_DIR="$QUEUE_DIR" \
LUMBDA_FACTORY_DIR="$LUMBDA_FACTORY_DIR" \
setsid nohup "$LUMBDA_FACTORY_DIR/bend-supervisor-dlq-runner.sh" \
>> "$QUEUE_DIR/dlq-runner.log" 2>&1 < /dev/null &
}
# ── hot-reload tunable settings ─────────────────────────────────────
# Lets operators bump POOL_MAX, BEND_ENDPOINTS, POOL_BATCHES live without
# restarting the supervisor. Drop a KEY=VALUE file at $QUEUE_DIR/supervisor.config;
# next poll iter reads it, kills affected child (pool / dispatcher),
# normal restart loop respawns with new value.
CONFIG_FILE="$QUEUE_DIR/supervisor.config"
# Fingerprint TIER_* keys so hot-reload knows when any per-tier cap or
# threshold changed. Compares concatenated env values, not file mtime, so
# unrelated edits (POOL_MAX bump alone) don't churn the dispatcher.
tier_fingerprint() {
printf '%s' \
"${TIER_MICRO_MIN:-}|${TIER_MICRO_MAX:-}|${TIER_SMALL_MAX:-}|${TIER_MEDIUM_MAX:-}|${TIER_LARGE_MAX:-}|" \
"${TIER_MICRO_POOL_MAX:-}|${TIER_MICRO_DISPATCH:-}|" \
"${TIER_SMALL_POOL_MAX:-}|${TIER_SMALL_DISPATCH:-}|" \
"${TIER_MEDIUM_POOL_MAX:-}|${TIER_MEDIUM_DISPATCH:-}|" \
"${TIER_LARGE_POOL_MAX:-}|${TIER_LARGE_DISPATCH:-}"
}
reload_config() {
[ -f "$CONFIG_FILE" ] || return 0
local prev_pool_max="$POOL_MAX"
local prev_endpoints="$BEND_ENDPOINTS"
local prev_batches="$POOL_BATCHES"
local prev_pool_min_bin="$POOL_MIN_BIN"
local prev_tier_fp
prev_tier_fp=$(tier_fingerprint)
# `set -a` exports every var assigned during the source so children
# (pool, dispatcher) inherit them. Without this, TIER_* + POOL_* set
# in supervisor.config stay local to this shell + dispatcher respawn
# would pick up lib-tier defaults instead of operator overrides.
set -a
# shellcheck source=/dev/null
. "$CONFIG_FILE"
set +a
local new_tier_fp
new_tier_fp=$(tier_fingerprint)
if [ "$POOL_MAX" != "$prev_pool_max" ] || [ "$POOL_MIN_BIN" != "$prev_pool_min_bin" ]; then
log "hot-reload POOL_MAX=$POOL_MAX POOL_MIN_BIN=$POOL_MIN_BIN (was MAX=$prev_pool_max MIN=$prev_pool_min_bin); killing pool, restart loop respawns"
pkill -f "bend-emit-pool.sh" 2>/dev/null
fi
# Dispatcher kill ONLY on endpoint / batches changes — tier-only
# changes flow live into workers via tier_reload_caps_from_file in
# lib-tier.sh.
if [ "$BEND_ENDPOINTS" != "$prev_endpoints" ] || [ "$POOL_BATCHES" != "$prev_batches" ]; then
log "hot-reload dispatcher config changed (killing dispatcher, restart loop respawns)"
pkill -f "bend-dispatcher.sh" 2>/dev/null
elif [ "$new_tier_fp" != "$prev_tier_fp" ]; then
log "hot-reload tier policy changed (live-reload — no dispatcher kill, workers read tier caps live)"
fi
}
# ── main loop ───────────────────────────────────────────────────────
while true; do
# Heartbeat first thing — supervisor must prove its own liveness too.
# factory-status reads supervisor.heartbeat to know whether a host
# has its own caretaker.
heartbeat_touch "$QUEUE_DIR" "supervisor"
reload_config
if [ -f "$STOP_FILE" ]; then
log "STOP marker seen — exiting"
rm -f "$STOP_FILE"
SUP_EXIT_REASON="stop-marker"
break
fi
# backend first — pool + dispatcher both need a live backend.
if ! bend_port_listening; then
log "backend DOWN on :${BEND_PORT_LISTEN}"
restart_bend
fi
# pool
if ! pool_alive; then
n_unworked=$(count_unworked_lsp)
if [ "$n_unworked" -gt 0 ]; then
log "pool DEAD with $n_unworked un-emitted .lsp"
restart_pool
else
log "pool DEAD but queue clean — nothing to restart for"
fi
fi
# dispatcher
if ! dispatcher_any_alive; then
n_dispatchable=$(count_dispatchable)
if [ "$n_dispatchable" -gt 0 ]; then
log "dispatcher DEAD with $n_dispatchable .ready+.bin waiting"
restart_dispatcher
else
log "dispatcher DEAD but no .ready / .bin — nothing to restart for"
fi
fi
# DLQ runner — auto-resolve or escalate. Always restart when stale;
# cheap to run idle (scans an empty dlq/ in milliseconds).
if ! dlq_runner_alive; then
log "dlq-runner DEAD (no fresh heartbeat) — restarting"
restart_dlq_runner
fi
sleep "$POLL_SECONDS"
done

108
factory/lib-heartbeat.sh Executable file
View file

@ -0,0 +1,108 @@
#!/usr/bin/env bash
# lib-heartbeat.sh — shared library for factory liveness signals.
#
# Sourced by bend-emit-pool.sh, bend-dispatcher.sh, bend-supervisor.sh,
# bend-autoscaler.sh, bend-supervisor-dlq-runner.sh. Pure POSIX-ish bash;
# no external daemons; portable to busybox-bash + flock + setsid + nohup.
#
# Env vars consumed: none. See $LUMBDA_FACTORY_DIR/CONTRACT.md for full
# factory-wide knob list.
#
# Contract:
# - heartbeat_touch <state_dir> <service_name>
# Writes "<pid> <unix_ts>" to <state_dir>/<service_name>.heartbeat.
# Called at top of every loop iteration; mtime + content authoritative.
# Returns 0 on success, 1 on write failure.
#
# - heartbeat_is_alive <state_dir> <service_name> <stale_threshold_sec>
# Returns 0 if BOTH:
# (a) heartbeat file mtime within <stale_threshold_sec> of now
# (b) pid recorded in heartbeat file responds to kill -0
# Returns 1 otherwise (missing file, stale mtime, dead pid).
# (a) gates daemon liveness; (b) gates against post-mortem stale files.
#
# - heartbeat_exit_cause <state_dir> <service_name> <reason>
# Appends "<utc_iso8601> <pid> <reason>" to
# <state_dir>/<service_name>.exit-cause, removes <service_name>.heartbeat.
# Caller invokes from every exit path (STOP marker, signal trap, drain
# timeout, error abort). Operators read .exit-cause to triage post-mortem.
#
# File formats:
# <service>.heartbeat — single line: "<pid> <unix_ts>" (whitespace-sep)
# <service>.exit-cause — append-only log, one line per exit:
# "<utc_iso8601> <pid> <reason>"
#
# Backwards compatibility: legacy per-worker dispatcher.heartbeat-<wid>
# files used freeform text content + only mtime for liveness. heartbeat_is_alive
# falls back to mtime-only when a heartbeat file does not parse as
# "<pid> <unix_ts>".
#
# Caller responsibilities:
# - mkdir -p "$state_dir" BEFORE calling any function (library does NOT
# auto-create; refusing to silently swallow path typos).
# - Wrap heartbeat_touch in an EXIT trap that calls heartbeat_exit_cause
# so an unexpected crash still leaves a forensic trail.
# heartbeat_touch <state_dir> <service_name>
heartbeat_touch() {
local state_dir="$1"
local service_name="$2"
local hb_file="${state_dir}/${service_name}.heartbeat"
printf '%s %s\n' "$$" "$(date +%s)" > "$hb_file" 2>/dev/null
}
# heartbeat_is_alive <state_dir> <service_name> <stale_threshold_sec>
# Returns 0 alive, 1 dead/stale.
heartbeat_is_alive() {
local state_dir="$1"
local service_name="$2"
local threshold="$3"
local hb_file="${state_dir}/${service_name}.heartbeat"
[ -f "$hb_file" ] || return 1
# mtime gate
local now mtime age
now=$(date +%s)
mtime=$(stat -c %Y "$hb_file" 2>/dev/null) || return 1
age=$(( now - mtime ))
[ "$age" -le "$threshold" ] || return 1
# pid gate: parse first token. Tolerate freeform legacy content by
# treating non-numeric first token as "mtime-only mode" — return 0 if
# mtime gate already passed.
local first_token
first_token=$(awk 'NR==1 {print $1}' "$hb_file" 2>/dev/null)
if [ -z "$first_token" ]; then
return 0
fi
case "$first_token" in
''|*[!0-9]*)
# non-numeric (e.g., ISO timestamp from legacy writer) → mtime-only
return 0
;;
esac
# Numeric pid: must respond to kill -0. Cross-host caveat: this library
# runs local to whichever process reads our heartbeat. heartbeat_is_alive
# called against a remote host's state dir over SSH must run on that
# host (kill -0 lives in local pid space only). Supervisor + status
# callers SSH per-host before calling, so this holds.
if kill -0 "$first_token" 2>/dev/null; then
return 0
fi
return 1
}
# heartbeat_exit_cause <state_dir> <service_name> <reason>
heartbeat_exit_cause() {
local state_dir="$1"
local service_name="$2"
local reason="$3"
local ec_file="${state_dir}/${service_name}.exit-cause"
local hb_file="${state_dir}/${service_name}.heartbeat"
local ts
ts=$(date -u +%FT%TZ)
printf '%s %s %s\n' "$ts" "$$" "$reason" >> "$ec_file" 2>/dev/null
rm -f "$hb_file" 2>/dev/null
}

203
factory/lib-tier.sh Executable file
View file

@ -0,0 +1,203 @@
#!/usr/bin/env bash
# lib-tier.sh — bin-size tier classifier + policy table.
#
# Bins sized below MIN or above MAX go to DLQ unconditionally. In-range
# bins get classified into a tier name. Each tier carries a default
# concurrency cap pair (POOL_MAX, DISPATCH) that supervisor / pool /
# dispatcher consult — overridable via $LUMBDA_QUEUE_DIR/supervisor.config
# `TIER_<NAME>_*` keys for hot-reload tuning.
#
# Why tiers: a backend's CPU+VRAM residency scales ~linearly with bin
# size. A 24-way fleet that fits 250-MB bins crushes a box on 2.4-GB
# bins. Per-tier admission lets a factory autopilot through a mixed
# workload without dead-zoning either extreme.
#
# Pure bash — no jq / awk / python deps, sourceable by every factory
# component.
#
# Env vars consumed: see $LUMBDA_FACTORY_DIR/CONTRACT.md for our canonical
# table. TIER_* knobs (boundaries + per-tier caps + per-tier MIB estimates)
# all readable via env override; defaults below match a 24-core / 62 GB RAM
# / 24 GB VRAM workstation profile.
# ── tier boundaries (bytes) ──────────────────────────────────────
# A bin's tier = lowest band whose MAX it does NOT exceed.
# A bin below TIER_MICRO_MIN gets DLQ'd as "too-small" (broken emit).
# A bin above TIER_LARGE_MAX gets DLQ'd as "too-large" (would OOM a fleet).
TIER_MICRO_MIN="${TIER_MICRO_MIN:-33554432}" # 32 MB — emit-broken floor
TIER_MICRO_MAX="${TIER_MICRO_MAX:-268435456}" # 256 MB
TIER_SMALL_MAX="${TIER_SMALL_MAX:-536870912}" # 512 MB
TIER_MEDIUM_MAX="${TIER_MEDIUM_MAX:-2147483648}" # 2 GB
TIER_LARGE_MAX="${TIER_LARGE_MAX:-4294967296}" # 4 GB — co-resident ceiling
# huge tier: bins above LARGE that still fit a fleet but only when
# a card has no co-tenants. Largest candidate bins land here (6-8 GB
# observed). HUGE_MAX is "single bin needs ALL of VRAM" — our autoscaler
# must drain other tiers before dispatching huge.
# At 8 GB bin × 1.55 ratio = ~12.4 GB RSS, well under 24 GB VRAM / 62 GB
# RAM ceilings of a typical workstation when run alone.
TIER_HUGE_MAX="${TIER_HUGE_MAX:-12884901888}" # 12 GB — solo-dispatch ceiling
# ── default concurrency caps per tier ────────────────────────────
# Numbers tuned for a 24-core, 62 GB RAM, 24 GB VRAM workstation.
# Override via supervisor.config: TIER_<NAME>_POOL_MAX / TIER_<NAME>_DISPATCH.
# Autoscaler may rewrite these based on live RAM headroom.
TIER_MICRO_POOL_MAX="${TIER_MICRO_POOL_MAX:-24}"
TIER_MICRO_DISPATCH="${TIER_MICRO_DISPATCH:-24}"
TIER_SMALL_POOL_MAX="${TIER_SMALL_POOL_MAX:-16}"
TIER_SMALL_DISPATCH="${TIER_SMALL_DISPATCH:-16}"
TIER_MEDIUM_POOL_MAX="${TIER_MEDIUM_POOL_MAX:-12}"
TIER_MEDIUM_DISPATCH="${TIER_MEDIUM_DISPATCH:-12}"
TIER_LARGE_POOL_MAX="${TIER_LARGE_POOL_MAX:-6}"
TIER_LARGE_DISPATCH="${TIER_LARGE_DISPATCH:-6}"
# HUGE: solo-dispatch tier. Both caps = 1; one huge bin at a time.
# Autoscaler must enforce "no other tier dispatches in flight before
# admitting a huge dispatch" — cap=1 alone does not guarantee that
# (small + huge could overlap if scheduled naively).
TIER_HUGE_POOL_MAX="${TIER_HUGE_POOL_MAX:-1}"
TIER_HUGE_DISPATCH="${TIER_HUGE_DISPATCH:-1}"
# ── per-tier per-dispatch memory estimates (MiB) ──────────────────
# Used by our autoscaler to compute "total estimated memory at current
# caps" for tier-mix admission. Calibrated from /usr/bin/time -v on a
# backend running against representative bins, scaled to each tier ceiling.
#
# Sample calibration data (peak RSS):
# 683 MB bin → 1.05 GB RSS (ratio 1.54×) → MEDIUM tier sample
# 2.4 GB bin → 3.55 GB RSS (ratio 1.48×) → LARGE tier sample
#
# CPU_MIB = tier-ceiling × 1.55× × small safety pad, so a tier-full bin
# never exceeds an admitted budget.
# MICRO ceil 256 MB × 1.55 → ~397 → round 512
# SMALL ceil 512 MB × 1.55 → ~794 → round 1024
# MEDIUM ceil 2 GB × 1.55 → ~3174 → round 3328
# LARGE ceil 4 GB × 1.55 → ~6349 → round 6400
TIER_MICRO_CPU_MIB="${TIER_MICRO_CPU_MIB:-512}"
TIER_MICRO_VRAM_MIB="${TIER_MICRO_VRAM_MIB:-512}"
TIER_SMALL_CPU_MIB="${TIER_SMALL_CPU_MIB:-1024}"
TIER_SMALL_VRAM_MIB="${TIER_SMALL_VRAM_MIB:-1024}"
TIER_MEDIUM_CPU_MIB="${TIER_MEDIUM_CPU_MIB:-3328}"
TIER_MEDIUM_VRAM_MIB="${TIER_MEDIUM_VRAM_MIB:-2048}"
TIER_LARGE_CPU_MIB="${TIER_LARGE_CPU_MIB:-6400}"
TIER_LARGE_VRAM_MIB="${TIER_LARGE_VRAM_MIB:-3072}"
# HUGE: 12 GB bin × 1.55 ratio ≈ 19000 MiB RSS at peak. Numbers below
# act as upper-bound "needs whole card" — autoscaler treats them as
# a wholesale claim, not adds-to-budget like other tiers.
TIER_HUGE_CPU_MIB="${TIER_HUGE_CPU_MIB:-19000}"
TIER_HUGE_VRAM_MIB="${TIER_HUGE_VRAM_MIB:-20480}"
# tier_of_size BYTES → echoes one of:
# below-min bin too small; DLQ as broken emit
# micro in-band [TIER_MICRO_MIN, TIER_MICRO_MAX]
# small (TIER_MICRO_MAX, TIER_SMALL_MAX]
# medium (TIER_SMALL_MAX, TIER_MEDIUM_MAX]
# large (TIER_MEDIUM_MAX, TIER_LARGE_MAX]
# huge (TIER_LARGE_MAX, TIER_HUGE_MAX] — solo-dispatch
# above-max bin too large; DLQ as fleet overflow
tier_of_size() {
local sz="$1"
if [ -z "$sz" ] || [ "$sz" -lt "$TIER_MICRO_MIN" ] 2>/dev/null; then
echo "below-min"; return
fi
if [ "$sz" -le "$TIER_MICRO_MAX" ]; then echo "micro"; return; fi
if [ "$sz" -le "$TIER_SMALL_MAX" ]; then echo "small"; return; fi
if [ "$sz" -le "$TIER_MEDIUM_MAX" ]; then echo "medium"; return; fi
if [ "$sz" -le "$TIER_LARGE_MAX" ]; then echo "large"; return; fi
if [ "$sz" -le "$TIER_HUGE_MAX" ]; then echo "huge"; return; fi
echo "above-max"
}
# Re-read tier caps from supervisor.config each call so autoscaler tweaks
# land in long-running dispatcher / pool workers WITHOUT a process restart.
# Old behavior baked TIER_* env at fork time → autoscaler had to kill the
# dispatcher to update caps → 30 s downtime per autoscale event. With
# live-reload, autoscaler edits supervisor.config + next tier_dispatch /
# tier_pool_max call sees a new value with no restart.
#
# Cost: sourcing a small KEY=VALUE file via grep+eval per call costs a
# few ms. tier_dispatch fires once per cell claim ≈ every 10-30 s per
# worker, so overhead stays invisible.
#
# Gated by TIER_CONFIG_LIVE_RELOAD=1 (default ON); set to 0 to fall back
# to env-only behavior (legacy / debugging).
TIER_CONFIG_FILE="${TIER_CONFIG_FILE:-${LUMBDA_QUEUE_DIR:-/tmp/lumbda-queue}/supervisor.config}"
TIER_CONFIG_LIVE_RELOAD="${TIER_CONFIG_LIVE_RELOAD:-1}"
tier_reload_caps_from_file() {
[ "$TIER_CONFIG_LIVE_RELOAD" = "1" ] || return 0
[ -f "$TIER_CONFIG_FILE" ] || return 0
# Eval only TIER_* lines from a config file — never inherit
# unrelated vars (POOL_MAX etc. stay supervisor-only, change those
# via supervisor restart).
eval "$(grep -E '^TIER_[A-Z_]+=' "$TIER_CONFIG_FILE" 2>/dev/null)"
}
# tier_pool_max NAME → echoes integer cap (0 for DLQ tiers)
tier_pool_max() {
tier_reload_caps_from_file
case "$1" in
micro) echo "$TIER_MICRO_POOL_MAX" ;;
small) echo "$TIER_SMALL_POOL_MAX" ;;
medium) echo "$TIER_MEDIUM_POOL_MAX" ;;
large) echo "$TIER_LARGE_POOL_MAX" ;;
huge) echo "$TIER_HUGE_POOL_MAX" ;;
*) echo 0 ;;
esac
}
# tier_dispatch NAME → echoes integer cap (0 for DLQ tiers)
tier_dispatch() {
tier_reload_caps_from_file
case "$1" in
micro) echo "$TIER_MICRO_DISPATCH" ;;
small) echo "$TIER_SMALL_DISPATCH" ;;
medium) echo "$TIER_MEDIUM_DISPATCH" ;;
large) echo "$TIER_LARGE_DISPATCH" ;;
huge) echo "$TIER_HUGE_DISPATCH" ;;
*) echo 0 ;;
esac
}
# tier_cpu_mib NAME → estimated CPU RSS per dispatch in MiB
tier_cpu_mib() {
case "$1" in
micro) echo "$TIER_MICRO_CPU_MIB" ;;
small) echo "$TIER_SMALL_CPU_MIB" ;;
medium) echo "$TIER_MEDIUM_CPU_MIB" ;;
large) echo "$TIER_LARGE_CPU_MIB" ;;
huge) echo "$TIER_HUGE_CPU_MIB" ;;
*) echo 0 ;;
esac
}
# tier_vram_mib NAME → estimated VRAM per dispatch in MiB
tier_vram_mib() {
case "$1" in
micro) echo "$TIER_MICRO_VRAM_MIB" ;;
small) echo "$TIER_SMALL_VRAM_MIB" ;;
medium) echo "$TIER_MEDIUM_VRAM_MIB" ;;
large) echo "$TIER_LARGE_VRAM_MIB" ;;
huge) echo "$TIER_HUGE_VRAM_MIB" ;;
*) echo 0 ;;
esac
}
# tier_solo NAME → 1 when a tier needs an empty card (no co-tenant
# dispatches); 0 when it shares a fleet with other tiers. Used by our
# autoscaler / dispatcher: before admitting a `huge` dispatch, poll all
# other tiers + verify zero inflight. lib-tier owns CLASSIFICATION;
# a controller owns ENFORCEMENT.
tier_solo() {
case "$1" in
huge) echo 1 ;;
*) echo 0 ;;
esac
}
# tier_label_dlq NAME → reason string for DLQ (or empty if not DLQ)
tier_label_dlq() {
case "$1" in
below-min) echo "bin-too-small (under tier-micro min ${TIER_MICRO_MIN} bytes) — emit produced no usable circuit" ;;
above-max) echo "bin-too-large (over tier-huge max ${TIER_HUGE_MAX} bytes) — would exceed fleet RAM/VRAM ceiling even with solo dispatch" ;;
*) echo "" ;;
esac
}

43
quantum/README.md Normal file
View file

@ -0,0 +1,43 @@
# quantum/ — circuit emission primitives
Reversible-circuit emission primitives written in lumbda Scheme: Clifford gates, ripple-carry adder (Cuccaro), modular arithmetic, modular inverse strategies, Karatsuba multiplier, Clifford tableau simulator, circuit scoring. Originally developed at foxhop for secp256k1 attack-surface research; shared upstream under AGPLv3.
## Layers
### Core gates
- `gates.lsp` — Clifford gate library: `CX`, `CCX` (Toffoli), `X`. Counts Toffoli + Clifford totals as side effect for scoring.
### Arithmetic
- `adder.lsp` — Cuccaro ripple-carry reversible n-bit adder. Width-parametric.
- `mod-arith.lsp` — modular add/sub/cmp/neg/mul/square under `*field-prime*`. Default unset; consumer binds (foxhop sets secp256k1 `p`).
- `mod-karatsuba.lsp` — Karatsuba reversible multiplier for ⊕-bit widths. Width-parametric.
### Modular inverse strategies
- `mod-inv-by.lsp` — Bennett by-value-uncompute pattern (host classical `1/x`, then quantum verify-and-zero).
- `mod-inv-by-dialog-gcd.lsp` — Dialog GCD (binary extended Euclidean) reversible mod-inv. General algorithm, not field-specific.
- `mod-inv-by-dialog-gcd-host.lsp` — Host-assisted variant: classical GCD trace replayed as quantum dialog log.
### Simulation + scoring
- `sim.lsp` — Clifford tableau simulator. Verifies emitted circuits against expected truth tables.
- `score.lsp` — circuit metric collector. Tracks Toffoli + qubit + Clifford counts during emission.
## Width discipline
Every primitive width-parametric — no hardcoded `n = 256`. Consumers bind `*field-prime*`, `*width*`, and optional flags (e.g. `*mod-mul-use-karatsuba*`).
## Hard rule — bound every loop, bound every ancilla
- `*max-shots*` caps shot counts in sim (default 64 for dev; raise only by explicit instruction).
- Every `alloc!` call site asserts width-cap at top of caller. Unbounded growth = host hard-freeze on neoblanka (proven 2026-06-11/12).
## Lumbda tier compatibility
These primitives run under any lumbda tier (Python VM, C tree-walker + JIT, C + x86 JIT, pure x86 asm). Cross-tier portal validation: same `.lsp` on Python-tier + C-tier must produce byte-identical result S-expressions. Mismatch halts promotion.
## License
AGPLv3.

2824
quantum/adder.lsp Normal file
View file

File diff suppressed because it is too large Load diff

441
quantum/gates.lsp Normal file
View file

@ -0,0 +1,441 @@
;;; gates.lsp — Reversible gate primitives, emit S-expression circuit stream.
;;;
;;; A circuit builder accumulates a list of ops. emit-circuit walks our
;;; builder into a tagged S-expression that any portal reader (sim.lsp on
;;; any tier, a future asm reader, a Rust codegen step) can consume.
;;;
;;; Wire format (`portals/circuit.portal`):
;;;
;;; (circuit
;;; (version 1)
;;; (curve <name>)
;;; (registers (<name> <width>) ...)
;;; (input (<name> <integer>) ...)
;;; (constants (<name> <integer>) ...) ; optional
;;; (ops <op> ...)
;;; (expected-output (<name> <integer>) ...)) ; optional
;;;
;;; Ops:
;;; (alloc <name> <width>)
;;; (free <name>)
;;; (x (<reg> <idx>))
;;; (cx (<reg> <idx>) (<reg> <idx>))
;;; (ccx (<reg> <idx>) (<reg> <idx>) (<reg> <idx>))
;;; ── width caps (guard asm-tier bump allocator territory) ──────
;;;
;;; Per foxhop CLAUDE.md ### ecdsa/ — lumbda asm-tier safety. asm tier
;;; default binary lacks GC; every register width feeds into r15 growth.
;;; Override at top of main.lsp via set! when a phase needs more
;;; headroom — explicit, traceable, never silent.
(define *max-register-width* 4096)
(define *max-ancilla-width* 1024)
(define (assert-width! kind name width)
(cond
((not (integer? width))
(error "non-integer width" (list kind name width)))
((< width 1)
(error "width must be positive" (list kind name width)))
((and (eq? kind 'register) (> width *max-register-width*))
(error "register width cap exceeded"
(list 'register name 'requested width
'cap *max-register-width*)))
((and (eq? kind 'ancilla) (> width *max-ancilla-width*))
(error "ancilla width cap exceeded"
(list 'ancilla name 'requested width
'cap *max-ancilla-width*)))))
;;; ── circuit builder (mutable cell-of-lists) ───────────────────
;;; Slot 5 (mirrors) is the Phase B step 10 classical-mirror channel:
;;; an alist (name value) tracking the live classical value of a register
;;; as it mutates across ops. Distinct from slot 1 (inputs), which the
;;; simulator reads to seed register start-of-circuit bit patterns and
;;; therefore must NOT be mutated mid-circuit. mod-inv-by-refined!'s
;;; find-classical-value queries the mirror first, falling back to the
;;; bound input — so standalone callers (test-mod-inv-by) need no mirror,
;;; while real-point-add! rebinds its mirror before each mod-inv! call
;;; to feed the current classical value of tx-reg into the refined path.
;;; Slot 6 (emit-fn) is the Phase B step 12 streaming-construction
;;; channel: optional one-argument procedure `(emit-fn op)`. When non-#f,
;;; emit-op! invokes it with each lumbda op form INSTEAD of consing onto
;;; circ-ops. Callers that need O(1) construction RAM (production-width
;;; secp256k1 emit) install a sink that walks each op to its upstream
;;; op-spec representation & drops the lumbda cons graph immediately.
;;; Default #f preserves the legacy accumulator path so every existing
;;; test & sweep keeps working byte-identical.
(define (make-circuit)
(vector '() '() '() '() '() '() #f))
;; registers, inputs, constants, ops, expected, mirrors, emit-fn
(define (circ-registers c) (vector-ref c 0))
(define (circ-inputs c) (vector-ref c 1))
(define (circ-constants c) (vector-ref c 2))
(define (circ-ops c) (vector-ref c 3))
(define (circ-expected c) (vector-ref c 4))
(define (circ-mirrors c) (vector-ref c 5))
(define (circ-emit-fn c) (vector-ref c 6))
(define (set-circ-registers! c v) (vector-set! c 0 v))
(define (set-circ-inputs! c v) (vector-set! c 1 v))
(define (set-circ-constants! c v) (vector-set! c 2 v))
(define (set-circ-ops! c v) (vector-set! c 3 v))
(define (set-circ-expected! c v) (vector-set! c 4 v))
(define (set-circ-mirrors! c v) (vector-set! c 5 v))
(define (set-circ-emit-fn! c v) (vector-set! c 6 v))
;;; ── declarations ──────────────────────────────────────────────
(define (declare-register! c name width)
(assert-width! 'register name width)
(set-circ-registers! c (cons (list name width) (circ-registers c))))
;;; *static-circuit-mode* — when #t, lumbda emits a HEAD-style single
;;; circuit that processes any input. Per-input binding (bind-input!,
;;; bind-mirror!, rebind-mirror!) errors so we can't accidentally bake
;;; an a-value into the gate stream; find-classical-value returns #f
;;; so primitives that rely on a classical oracle (mod-inv-by-refined!,
;;; real-point-add!'s K-correction replay) fail loudly instead of
;;; silently producing a per-input circuit. Default #f preserves every
;;; existing research cell's byte-identity.
;;;
;;; To flip on at runtime: cells that want the static-circuit path
;;; do `(set! *static-circuit-mode* #t)` at top alongside their other
;;; substrate flags. Phase C's Makefile wrapper injects this line into
;;; a wrapper-cell.lsp ahead of the cell's body.
;;;
;;; PRIOR REVISION used (getenv "STATIC_CIRCUIT_MODE") for env-driven
;;; activation — lumbda --fast hangs on `getenv` (unbound, late-bind
;;; retries forever). Reverted to plain (define ... #f). 2026-06-12.
(define *static-circuit-mode* #f)
(define (bind-input! c name value)
(cond
(*static-circuit-mode*
(error "bind-input! forbidden under *static-circuit-mode* — a static circuit cannot bake input values" name))
(else
(set-circ-inputs! c (cons (list name value) (circ-inputs c))))))
;;; find-bound-input — read the binding for a register name (slot 1 only).
;;; Returns the bound classical integer, or #f if name has no binding.
;;; The simulator's initial-value semantics — never mutated mid-circuit.
(define (find-bound-input c name)
(let ((row (assoc name (circ-inputs c))))
(cond
(row (car (cdr row)))
(else #f))))
;;; bind-mirror! / rebind-mirror! — Phase B step 10 classical-mirror channel
;;; (slot 5). Distinct from bind-input! because the simulator reads slot 1
;;; to initialize register bit patterns at the START of the circuit;
;;; mutating it mid-stream would change what the simulator believes the
;;; register starts as. The mirror tracks the LIVE classical value of a
;;; register as it mutates across ops. Callers like real-point-add! update
;;; the mirror before each mod-inv! call so mod-inv-by-refined!'s
;;; find-classical-value sees the current classical value.
(define (bind-mirror! c name value)
(cond
(*static-circuit-mode*
(error "bind-mirror! forbidden under *static-circuit-mode* — classical mirror channel requires per-input emit" name))
(else
(set-circ-mirrors! c (cons (list name value) (circ-mirrors c))))))
(define (rebind-mirror! c name value)
"Replace name's existing mirror with a fresh value; bind if absent.
Mutates in place so circ-mirrors never accumulates stale duplicates."
(cond
(*static-circuit-mode*
(error "rebind-mirror! forbidden under *static-circuit-mode* — classical mirror channel requires per-input emit" name))
(else
(let loop ((rest (circ-mirrors c)) (acc '()) (found #f))
(cond
((null? rest)
(cond
(found (set-circ-mirrors! c (reverse acc)))
(else (bind-mirror! c name value))))
((eq? (car (car rest)) name)
(loop (cdr rest) (cons (list name value) acc) #t))
(else
(loop (cdr rest) (cons (car rest) acc) found)))))))
(define (find-mirror c name)
(let ((row (assoc name (circ-mirrors c))))
(cond
(row (car (cdr row)))
(else #f))))
;;; find-classical-value — preferred lookup for refined mod-inv. Returns
;;; the mirror value if present (the LIVE classical value), else falls
;;; back to the bound input (the start-of-circuit value). Standalone
;;; callers that never set mirrors get the input — same behavior as
;;; before mirrors existed.
(define (find-classical-value c name)
(cond
(*static-circuit-mode* #f)
(else
(let ((mv (find-mirror c name)))
(cond
(mv mv)
(else (find-bound-input c name)))))))
(define (bind-constant! c name value)
(set-circ-constants! c (cons (list name value) (circ-constants c))))
(define (expect-output! c name value)
(set-circ-expected! c (cons (list name value) (circ-expected c))))
;;; ── gate primitives ───────────────────────────────────────────
;;; emit-op! is the single chokepoint every Phase B primitive
;;; (cuccaro!, mod-add!, mod-mul!, mod-inv*, real-point-add!) bottoms
;;; out at via the gate-x!/gate-cx!/gate-ccx!/alloc!/free! constructors
;;; above. Two-mode dispatch: when (circ-emit-fn c) is set, we hand the
;;; op to a caller-installed sink & skip the accumulator. When unset
;;; (default), we cons onto circ-ops exactly as before. Refactoring
;;; here flows automatically through every primitive — no per-primitive
;;; signature change needed.
(define (emit-op! c op)
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink op))
(else (set-circ-ops! c (cons op (circ-ops c)))))))
;;; Fast-path gate constructors: when (circ-emit-fn c) is set, skip
;;; lumbda S-exp construction entirely & call sink with positional
;;; tag + raw refs. The sink walks ref→qid + builds op-spec in one
;;; shot. Avoids 4 cons cells per gate (mod-mul-solinas! does that
;;; ~256 times per Toffoli at secp256k1 width). Accumulator path
;;; keeps existing S-exp shape so every downstream walker
;;; (point-add->ops, sim.lsp, emit-circuit) sees byte-identical input.
;;;
;;; Sink contract (streaming mode) — FIXED-ARITY 8 args (tag + 7 slots):
;;; (sink 'x reg idx #f #f #f #f #f) — gate-x
;;; (sink 'cx cr ci tr ti #f #f #f) — gate-cx
;;; (sink 'ccx c1r c1i c2r c2i tr ti #f) — gate-ccx
;;; (sink 'alloc name width #f #f #f #f #f) — alloc
;;; (sink 'free name #f #f #f #f #f #f) — free
;;;
;;; Fixed-arity dispatch avoids lumbda's variadic-args list allocation
;;; (which costs ~one Pair per call). At secp256k1 width with ~100M
;;; gates, that's ~100M extra Pair allocations on the hot path —
;;; benchmark showed sink call cost dropping from ~600 us/op to a
;;; few μs/op. Unused slots hold #f sentinel.
(define (gate-x! c reg idx)
"NOT on a single qubit. Clifford."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'x reg idx #f #f #f #f #f))
(else (set-circ-ops! c (cons (list 'x (list reg idx)) (circ-ops c)))))))
(define (gate-cx! c ctrl-reg ctrl-idx tgt-reg tgt-idx)
"Controlled-NOT (CNOT). Clifford."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'cx ctrl-reg ctrl-idx tgt-reg tgt-idx #f #f #f))
(else (set-circ-ops! c
(cons (list 'cx
(list ctrl-reg ctrl-idx)
(list tgt-reg tgt-idx))
(circ-ops c)))))))
(define (gate-ccx! c c1-reg c1-idx c2-reg c2-idx tgt-reg tgt-idx)
"Doubly-controlled-NOT (Toffoli). One Toffoli charge."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'ccx c1-reg c1-idx c2-reg c2-idx tgt-reg tgt-idx #f))
(else (set-circ-ops! c
(cons (list 'ccx
(list c1-reg c1-idx)
(list c2-reg c2-idx)
(list tgt-reg tgt-idx))
(circ-ops c)))))))
(define (gate-z! c reg idx)
"Single-qubit phase flip on |1⟩. Clifford. QECCOPS1 op kind 7."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'z reg idx #f #f #f #f #f))
(else (set-circ-ops! c (cons (list 'z (list reg idx)) (circ-ops c)))))))
(define (gate-cz! c ctrl-reg ctrl-idx tgt-reg tgt-idx)
"Controlled-phase. Clifford. Kind 9."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'cz ctrl-reg ctrl-idx tgt-reg tgt-idx #f #f #f))
(else (set-circ-ops! c
(cons (list 'cz
(list ctrl-reg ctrl-idx)
(list tgt-reg tgt-idx))
(circ-ops c)))))))
(define (gate-ccz! c c1-reg c1-idx c2-reg c2-idx tgt-reg tgt-idx)
"Doubly-controlled-phase. One Toffoli charge. Kind 14."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'ccz c1-reg c1-idx c2-reg c2-idx tgt-reg tgt-idx #f))
(else (set-circ-ops! c
(cons (list 'ccz
(list c1-reg c1-idx)
(list c2-reg c2-idx)
(list tgt-reg tgt-idx))
(circ-ops c)))))))
(define (gate-r! c reg idx)
"Single-qubit reset to |0⟩ via RNG-driven measure + conditional flip.
Clifford. Kind 11. CPU sim: sim_cpu.c lines 86-90."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'r reg idx #f #f #f #f #f))
(else (set-circ-ops! c (cons (list 'r (list reg idx)) (circ-ops c)))))))
;;; ── Tier-2 classical-bit primitives ──────────────────────────────
;;;
;;; Classical bits live as integer IDs in QECCOPS1; analyze.c auto-sizes
;;; num_bits from max(c_target, c_condition) seen across the op stream.
;;; No Register/Append boilerplate needed for bits — caller manages
;;; integer IDs directly (a monotonic counter at point-add scope is
;;; sufficient).
;;;
;;; Sink calling convention for Tier-2 (still fixed-arity-8 to avoid
;;; variadic-args list allocation on the hot path):
;;; 'bit-invert : (sink 'bit-invert bit-id #f #f #f #f #f #f)
;;; 'bit-store0 : (sink 'bit-store0 bit-id #f #f #f #f #f #f)
;;; 'bit-store1 : (sink 'bit-store1 bit-id #f #f #f #f #f #f)
;;; 'hmr : (sink 'hmr qreg qidx bit-id #f #f #f #f)
;;; 'push-cond : (sink 'push-cond bit-id #f #f #f #f #f #f)
;;; 'pop-cond : (sink 'pop-cond #f #f #f #f #f #f #f)
(define (gate-bit-invert! c bit-id)
"Flip a classical bit. Kind 3."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'bit-invert bit-id #f #f #f #f #f #f))
(else (set-circ-ops! c (cons (list 'bit-invert bit-id) (circ-ops c)))))))
(define (gate-bit-store0! c bit-id)
"Set a classical bit to 0. Kind 4."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'bit-store0 bit-id #f #f #f #f #f #f))
(else (set-circ-ops! c (cons (list 'bit-store0 bit-id) (circ-ops c)))))))
(define (gate-bit-store1! c bit-id)
"Set a classical bit to 1. Kind 5."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'bit-store1 bit-id #f #f #f #f #f #f))
(else (set-circ-ops! c (cons (list 'bit-store1 bit-id) (circ-ops c)))))))
(define (gate-hmr! c qreg qidx bit-id)
"Hadamard + Measure + Reset on a qubit, measured outcome into a
classical bit. Clifford. Kind 12. CPU sim: sim_cpu.c lines 79-85.
RNG consumes one u64 from the shake stream per shot."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'hmr qreg qidx bit-id #f #f #f #f))
(else (set-circ-ops! c
(cons (list 'hmr (list qreg qidx) bit-id)
(circ-ops c)))))))
(define (gate-push-cond! c bit-id)
"Push current base_cond onto stack, narrow base_cond by ANDing with
bit. Subsequent ops execute conditionally on bit=1. Kind 15."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'push-cond bit-id #f #f #f #f #f #f))
(else (set-circ-ops! c (cons (list 'push-cond bit-id) (circ-ops c)))))))
(define (gate-pop-cond! c)
"Pop base_cond off the stack. Restores prior conditional scope. Kind 16."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'pop-cond #f #f #f #f #f #f #f))
(else (set-circ-ops! c (cons (list 'pop-cond) (circ-ops c)))))))
;;; ── bit-register ↔ qubit-register interop ────────────────────────
;;;
;;; Static-circuit substrate. HEAD's load_bits / unload_bits (adder.rs:
;;; 293) materialize a classical bit-register into a quantum scratch
;;; register via per-position conditional-X: push-cond(bit) + X(q) +
;;; pop-cond. Equivalent to b.x_if(qs[i], bits[i]) in HEAD's API.
;;;
;;; Unlike load-const! / unload-const! (mod-arith.lsp), these do NOT
;;; bake a classical integer into the gate stream — the bit-register's
;;; runtime value is whatever the test driver wrote via gate-bit-store0!
;;; / gate-bit-store1! / hmr. This is the per-shot input channel for a
;;; static circuit (ox, oy in HEAD's emit_dialog_gcd_raw_pa).
;;;
;;; bits-list: a Scheme list of n bit-ID integers (the offset_x or
;;; offset_y bit register). load-bits! / unload-bits! are self-inverse
;;; (cx-via-push-x-pop is its own inverse) — same shape as load-const!.
(define (load-bits! c qs-reg bits-list n)
"qs-reg[i] ^= bits-list[i] for i in [0, n). qs-reg must be n-wide,
|0> on entry; on exit holds the bit-register's runtime value."
(let loop ((i 0) (rest bits-list))
(cond
((or (= i n) (null? rest)) #f)
(else
(gate-push-cond! c (car rest))
(gate-x! c qs-reg i)
(gate-pop-cond! c)
(loop (+ i 1) (cdr rest))))))
(define (unload-bits! c qs-reg bits-list n)
"Inverse of load-bits! (self-inverse: same push-x-pop triple uncomputes
the load). Returns qs-reg to |0> n-wide, leaving bits-list unchanged."
(load-bits! c qs-reg bits-list n))
(define (alloc! c name width . hint-rest)
"Allocate an ancilla register. Counts toward peak-qubit width.
Optional 4th positional arg: hint-base (integer). When non-#f
and *allocator-base-hint-enabled* is on at sink-construction
time, the streaming allocator will try to carve exactly the
hint-base..hint-base+width window from its range-pool. Hint
silently ignored when (a) flag off, (b) arg not integer, or
(c) window not fully contained in any free range. Default-OFF
semantics preserved — pre-existing 3-arg callers behave
byte-identically to pre-port master."
(assert-width! 'ancilla name width)
(let ((sink (circ-emit-fn c))
(hint-base (cond ((null? hint-rest) #f)
(else (car hint-rest)))))
(cond
(sink (sink 'alloc name width hint-base #f #f #f #f))
(else (set-circ-ops! c (cons (list 'alloc name width) (circ-ops c)))))))
(define (free! c name)
"Free an ancilla. Sim asserts every bit returned to zero."
(let ((sink (circ-emit-fn c)))
(cond
(sink (sink 'free name #f #f #f #f #f #f))
(else (set-circ-ops! c (cons (list 'free name) (circ-ops c)))))))
;;; ── finalize & write portal ───────────────────────────────────
(define (emit-circuit c curve-name)
"Walk our builder into a finished circuit S-expression."
(list 'circuit
(list 'version 1)
(list 'curve curve-name)
(cons 'registers (reverse (circ-registers c)))
(cons 'input (reverse (circ-inputs c)))
(cons 'constants (reverse (circ-constants c)))
(cons 'ops (reverse (circ-ops c)))
(cons 'expected-output (reverse (circ-expected c)))))
(define (write-portal! filename sexp)
"Write an S-expression to a portal file atomically (write tmp, rename)."
(let ((tmp (string-append filename ".tmp")))
(let ((port (open-output-file tmp)))
(write sexp port)
(newline port)
(close-port port))
(rename-file tmp filename)))

6127
quantum/mod-arith.lsp Normal file
View file

File diff suppressed because it is too large Load diff

900
quantum/mod-inv-by-dialog-gcd-host.lsp Normal file
View file

@ -0,0 +1,900 @@
;;; 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)))))

1714
quantum/mod-inv-by-dialog-gcd.lsp Normal file
View file

File diff suppressed because it is too large Load diff

1382
quantum/mod-inv-by.lsp Normal file
View file

File diff suppressed because it is too large Load diff

838
quantum/mod-karatsuba.lsp Normal file
View file

@ -0,0 +1,838 @@
;;; mod-karatsuba.lsp — Phase B step 8: Karatsuba reversible wide-multiply.
;;;
;;; Replaces the wide-product stage of mod-mul-solinas! (the Litinski
;;; schoolbook-mul-into-addsub!) with a Karatsuba recursion. Below the
;;; threshold *karatsuba-threshold*, falls through to the existing
;;; schoolbook primitive — so at p=11 (n=4) and p=251 (n=8) the karatsuba
;;; path produces byte-identical output to mod-mul-solinas!. The win
;;; shows up at n+1 >= 18.
;;;
;;; Algorithm (single-level expansion):
;;;
;;; karatsuba-wide!(a, b, dst, n):
;;; if n <= THRESHOLD: schoolbook-wide!(a, b, dst, n) ; fallback
;;; else:
;;; m_lo = ceil(n/2), m_hi = n - m_lo ; m_hi <= m_lo
;;; a_lo = a[0..m_lo), a_hi = a[m_lo..n)
;;; b_lo = b[0..m_lo), b_hi = b[m_lo..n)
;;;
;;; ;; Compute three sub-products into fresh 2*m wide accumulators.
;;; alloc z0 (2*m_lo), z2 (2*m_lo), sum_a (m_lo+1), sum_b (m_lo+1),
;;; z1 (2*(m_lo+1))
;;; karatsuba-wide!(a_lo, b_lo, z0, m_lo) ; z0 = a_lo*b_lo
;;; karatsuba-wide!(a_hi, b_hi, z2-low(2*m_hi),m_hi) ; z2 high bits |0>
;;; sum_a = a_lo (copy) + a_hi (add)
;;; sum_b = b_lo (copy) + b_hi (add)
;;; karatsuba-wide!(sum_a, sum_b, z1, m_lo+1)
;;;
;;; ;; Combine into dst.
;;; ;; dst += z0 at offset 0 (2*m_lo bits)
;;; ;; dst += z2 at offset 2*m_lo (2*m_hi bits)
;;; ;; dst += z1 at offset m_lo (2*(m_lo+1) bits)
;;; ;; dst -= z0 at offset m_lo (2*m_lo bits)
;;; ;; dst -= z2 at offset m_lo (2*m_hi bits)
;;;
;;; ;; Uncompute every sub-product & sum register.
;;; karatsuba-wide!-INVERSE(sum_a, sum_b, z1, m_lo+1)
;;; uncompute sum_b (CX b_hi out, CX b_lo out — reverse order)
;;; uncompute sum_a
;;; karatsuba-wide!-INVERSE(a_hi, b_hi, z2-low, m_hi)
;;; karatsuba-wide!-INVERSE(a_lo, b_lo, z0, m_lo)
;;; free buffers
;;;
;;; Op-count scaling: at the leaves we still pay schoolbook (n_leaf^2
;;; controlled-add-subtracts). With k = log_2(n/THRESHOLD) levels we get
;;; 3^k leaf calls instead of 4^k. At THRESHOLD=8, n=32 -> k=2 -> 9 leaves
;;; vs 16 schoolbook (44% Toffoli reduction in the multiply stage); n=128
;;; -> k=4 -> 81 leaves vs 256 schoolbook (68% reduction).
;;;
;;; Ancilla overhead: each recursion allocates 4 width-2m_lo buffers + 2
;;; width-(m_lo+1) buffers = ~6n+4 ancilla qubits per level. Total
;;; cumulative ~6n*log2(n) ancilla — pays for itself well above n=16.
;;;
;;; Cross-tier portal validation: the schoolbook fallback below threshold
;;; means at p=11 / p=251 mod-mul-karatsuba! emits THE SAME gate sequence
;;; as mod-mul-solinas! — sweep-001/002 oracles still match.
(load "quantum/gates.lsp")
(load "quantum/adder.lsp")
(load "quantum/mod-arith.lsp")
(load "quantum/mod-solinas.lsp")
;;; ── threshold knob (caller may set! before building) ───────────
(define *karatsuba-threshold* 8)
;; n <= *karatsuba-threshold* falls through to schoolbook. Default 8
;; chosen so n+1 in {5, 9} (the sweep-001/002 widths) skip Karatsuba
;; entirely → byte-identity preserved by construction.
;;; ── ancilla-name generator ────────────────────────────────────
;;;
;;; Recursion needs fresh ancilla names per level. We append the depth
;;; suffix to each base name; depth threads through every call.
(define (kara-name base depth)
(string->symbol (string-append (symbol->string base) "-d"
(number->string depth))))
(define (kara-name-w base depth width)
"Like kara-name but ALSO tags the width. Used by primitives whose
ancilla width varies between sibling calls at the same depth — the
simulator's widths-hash retains the LAST-set width per name, so
re-allocating the same name at different widths within one circuit
lifetime crashes the reverse-pass register re-creation. Width-tagging
sidesteps the collision."
(string->symbol (string-append (symbol->string base) "-d"
(number->string depth) "-w"
(number->string width))))
;;; ── public entry: karatsuba-wide! ─────────────────────────────
;;;
;;; dst (2n bits |0> in) receives a*b. a and b are n-wide registers
;;; (passed by name + offset for slicing). Caller allocates dst, a, b,
;;; and the schoolbook-shared scratch (sb-low, sb-xext, sb-const-tmp,
;;; cin). All ancilla return to |0>.
(define (karatsuba-wide! c a-reg a-off b-reg b-off n
dst-reg dst-off
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
depth)
"Reversible wide multiply: dst[dst-off..dst-off+2n) := a*b. a, b
preserved; dst |0> in. Falls through to kara-leaf-mul! below threshold
or when n <= 3 (recursion-floor guard: at n=3, m_sum=3=n so the sum
sub-multiply would re-enter karatsuba-step at the same n → infinite
recursion). Threshold default 8 keeps us well above this guard."
(cond
((= n 0) #t)
((or (<= n *karatsuba-threshold*) (<= n 3))
(kara-leaf-mul! c a-reg a-off b-reg b-off n
dst-reg dst-off
cin-reg cin-idx
depth))
(else
(karatsuba-step! c a-reg a-off b-reg b-off n
dst-reg dst-off
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
depth))))
(define (karatsuba-wide-inverse! c a-reg a-off b-reg b-off n
dst-reg dst-off
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
depth)
"Inverse: zero-out dst that currently holds a*b, restoring |0>."
(cond
((= n 0) #t)
((or (<= n *karatsuba-threshold*) (<= n 3))
(kara-leaf-mul-inverse! c a-reg a-off b-reg b-off n
dst-reg dst-off
cin-reg cin-idx
depth))
(else
(karatsuba-step-inverse! c a-reg a-off b-reg b-off n
dst-reg dst-off
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
depth))))
;;; ── leaf multiplier: kara-leaf-mul! ──
;;;
;;; Reversible "schoolbook" multiplier with unique-per-depth ancilla
;;; names. Why not use the existing Litinski schoolbook (mod-arith.lsp
;;; schoolbook-mul-into-addsub!)?
;;;
;;; The Litinski primitive allocates `sb-xfull` internally with width
;;; 2n+1 = function of leaf n. Different Karatsuba leaves run schoolbook
;;; at different n values within the SAME circuit lifetime (e.g. m_lo
;;; sub-mult at n=m_lo, sum_a*sum_b sub-mult at n=m_lo+1). When the
;;; simulator's reverse pass replays alloc ops, it uses the widths-hash
;;; value at that point, but the widths hash retains the LAST forward
;;; set value — so for an op-pair (alloc sb-xfull w5, ..., free sb-xfull)
;;; followed later by (alloc sb-xfull w7, ..., free), the reverse pass
;;; re-creates the w5 register at width 7, mis-sizing the bit vector
;;; and crashing on the next vector-ref.
;;;
;;; Cleanest workaround: leaf multiplier has its OWN ancilla names that
;;; are depth-tagged, so the width per name stays consistent.
;;;
;;; Algorithm (O(n²) controlled-add):
;;; for i in 0..n:
;;; for k in 0..n: tmp[k] ^= b[b-off+i] AND a[a-off+k] (CCX)
;;; dst[dst-off+i..dst-off+i+n) += tmp (cuccaro-add-offset width=n)
;;; uncompute tmp (same CCX self-inverse)
;;;
;;; Reversible, dst |0> in / dst = a*b out. tmp is depth-tagged.
;;; Width-cost analysis: tmp width n.
(define (kara-leaf-mul! c a-reg a-off b-reg b-off n
dst-reg dst-off
cin-reg cin-idx
depth)
"dst[dst-off..dst-off+2n) += a*b. a, b each n wide (preserved).
dst-reg must be >= dst-off + 2n wide. Uses kara-leaf-tmp-d<depth>
ancilla of width n+1 (top bit |0> carry-extension to propagate the
add's carry-out into dst[dst-off+i+n)).
Algorithm:
for i in 0..n:
for k in 0..n: tmp[k] ^= b[i] AND a[k] (CCX)
dst[dst-off+i..dst-off+i+n+1) += tmp[0..n+1) (cuccaro-add width n+1)
uncompute tmp
The width-n+1 add propagates the carry from bit (i+n-1) into bit
(i+n) cleanly. tmp[n] stays |0> across each row (just the carry slot)."
(let ((tmpn (kara-name-w 'kara-leaf-tmp depth n)))
(alloc! c tmpn (+ n 1))
(let row-loop ((i 0))
(when (< i n)
;; tmp ^= b[i] AND a[k]
(let loop ((k 0))
(when (< k n)
(gate-ccx! c b-reg (+ b-off i) a-reg (+ a-off k) tmpn k)
(loop (+ k 1))))
;; dst[dst-off+i..+i+n+1) += tmp[0..n+1) — width n+1 lets carry propagate
(cuccaro-add-offset! c tmpn 0 dst-reg (+ dst-off i)
cin-reg cin-idx (+ n 1))
;; uncompute tmp
(let loop ((k 0))
(when (< k n)
(gate-ccx! c b-reg (+ b-off i) a-reg (+ a-off k) tmpn k)
(loop (+ k 1))))
(row-loop (+ i 1))))
(free! c tmpn)))
(define (kara-leaf-mul-inverse! c a-reg a-off b-reg b-off n
dst-reg dst-off
cin-reg cin-idx
depth)
"Inverse: dst[dst-off..dst-off+2n) -= a*b. Same convention as
kara-leaf-mul! with cuccaro-add replaced by cuccaro-sub. Walks rows
in REVERSE so the inverse mirrors the forward operation pair-by-pair."
(let ((tmpn (kara-name-w 'kara-leaf-tmp depth n)))
(alloc! c tmpn (+ n 1))
(let row-loop ((i (- n 1)))
(when (>= i 0)
(let loop ((k 0))
(when (< k n)
(gate-ccx! c b-reg (+ b-off i) a-reg (+ a-off k) tmpn k)
(loop (+ k 1))))
(cuccaro-sub-offset! c tmpn 0 dst-reg (+ dst-off i)
cin-reg cin-idx (+ n 1))
(let loop ((k 0))
(when (< k n)
(gate-ccx! c b-reg (+ b-off i) a-reg (+ a-off k) tmpn k)
(loop (+ k 1))))
(row-loop (- i 1))))
(free! c tmpn)))
;;; ── karatsuba-step! — one recursion level ─────────────────────
;;;
;;; Splits a, b at m_lo := ceil(n/2). m_hi := n - m_lo (m_hi <= m_lo).
;;; Allocates buffers, recurses three times, combines into dst, uncomputes.
(define (karatsuba-step! c a-reg a-off b-reg b-off n
dst-reg dst-off
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
depth)
(let* ((m-lo (quotient (+ n 1) 2)) ; ceil(n/2)
(m-hi (- n m-lo)) ; floor(n/2) <= m-lo
(m-sum (+ m-lo 1)) ; sum register width
(z0-w (* 2 m-lo))
;; z2 has true width 2*m_hi but we allocate 2*m_lo for uniform
;; offset arithmetic — high (2*m_lo - 2*m_hi) bits stay |0>.
(z2-w (* 2 m-hi))
(z1-w (* 2 m-sum))
;; Width-tag every ancilla name. Sibling recursions at the same
;; depth but different n (e.g. m_lo vs m_sum sub-mults) all hit
;; this same step!; without width tags they'd collide on the
;; simulator widths-hash.
(z0n (kara-name-w 'kara-z0 depth n))
(z2n (kara-name-w 'kara-z2 depth n))
(san (kara-name-w 'kara-sa depth n))
(sbn (kara-name-w 'kara-sb depth n))
(z1n (kara-name-w 'kara-z1 depth n))
(next-depth (+ depth 1)))
(alloc! c z0n z0-w)
(alloc! c z2n z2-w)
(alloc! c san m-sum)
(alloc! c sbn m-sum)
(alloc! c z1n z1-w)
;; ── compute z0 := a_lo * b_lo (m_lo bits each → 2*m_lo product) ──
(karatsuba-wide! c a-reg a-off b-reg b-off m-lo
z0n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
;; ── compute z2 := a_hi * b_hi (m_hi bits each → 2*m_hi product) ──
(karatsuba-wide! c a-reg (+ a-off m-lo) b-reg (+ b-off m-lo) m-hi
z2n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
;; ── sum_a := a_lo + a_hi via a width-m_sum cuccaro-add ──
;;
;; Naive approach (cuccaro-add-offset width=m_hi of a_hi into san)
;; TRUNCATES the carry into san[m_lo] = san[m_sum-1]. Instead, pad
;; a_hi into a fresh m_sum-wide register (high bits |0>), copy a_lo
;; into san low m_lo bits, then do a full width-m_sum cuccaro-add.
;; Carry out cleanly into san[m_sum-1].
(let ((ahpn (kara-name-w 'kara-ahp depth n))
(bhpn (kara-name-w 'kara-bhp depth n)))
(alloc! c ahpn m-sum)
(alloc! c bhpn m-sum)
;; sum_a = a_lo (copy)
(let loop ((k 0))
(when (< k m-lo)
(gate-cx! c a-reg (+ a-off k) san k)
(loop (+ k 1))))
;; pad a_hi into ahpn low m_hi bits
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c a-reg (+ a-off m-lo k) ahpn k)
(loop (+ k 1))))
;; sum_a += a_hi_padded (width m_sum, carries cleanly)
(cuccaro-add! c ahpn san cin-reg cin-idx m-sum)
;; sum_b = b_lo (copy)
(let loop ((k 0))
(when (< k m-lo)
(gate-cx! c b-reg (+ b-off k) sbn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c b-reg (+ b-off m-lo k) bhpn k)
(loop (+ k 1))))
(cuccaro-add! c bhpn sbn cin-reg cin-idx m-sum)
;; uncompute padded copies (CX self-inverse)
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c b-reg (+ b-off m-lo k) bhpn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c a-reg (+ a-off m-lo k) ahpn k)
(loop (+ k 1))))
(free! c bhpn)
(free! c ahpn))
;; ── z1 := sum_a * sum_b ──
(karatsuba-wide! c san 0 sbn 0 m-sum
z1n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
;; ── combine into dst ──
;; Karatsuba: a*b = z0 + (z1 - z0 - z2)*2^m_lo + z2*2^(2*m_lo)
;;
;; Naive direct adds/subs into dst at NARROW widths LOSE BORROW into
;; higher dst bits — subtracting z0 (width 2*m_lo) at offset m_lo
;; truncates inside the slice [m_lo .. m_lo+2*m_lo) instead of letting
;; the borrow propagate up. Standard fix: compute the middle term in
;; a SEPARATE accumulator (here z1n itself) at full width 2*m_sum,
;; where 2*m_sum >= 2*m_lo >= 2*m_hi → borrows stay inside z1n. Then
;; add z1n into dst at offset m_lo.
;;
;; Sequence (z1n holds z1 = sum_a * sum_b on entry):
;; 1. z1n -= z0 (sub at width 2*m_sum — z0 pads with zero high bits)
;; 2. z1n -= z2
;; 3. dst[0..2*m_lo) += z0
;; 4. dst[2*m_lo..2*m_lo+2*m_hi) += z2
;; 5. dst[m_lo..m_lo+2*m_sum) += z1n (the middle term in full)
;; 6. z1n += z2 (restore z1n = z1 for the inverse step)
;; 7. z1n += z0
;;
;; Steps 1-2 and 6-7 use the SAME width-2*m_sum sub via padded copies
;; (z0 and z2 are narrower; we copy into a 2*m_sum-wide temp).
(let ((z0extn (kara-name-w 'kara-z0ext depth n))
(z2extn (kara-name-w 'kara-z2ext depth n)))
(alloc! c z0extn z1-w)
(alloc! c z2extn z1-w)
;; copy z0 into z0extn (low z0-w bits)
(let loop ((k 0))
(when (< k z0-w)
(gate-cx! c z0n k z0extn k)
(loop (+ k 1))))
;; copy z2 into z2extn (low z2-w bits)
(let loop ((k 0))
(when (< k z2-w)
(gate-cx! c z2n k z2extn k)
(loop (+ k 1))))
;; z1n -= z0extn (full width 2*m_sum)
(cuccaro-sub! c z0extn z1n cin-reg cin-idx z1-w)
;; z1n -= z2extn
(cuccaro-sub! c z2extn z1n cin-reg cin-idx z1-w)
;; dst += z0 at offset 0, width 2*m_lo
(cuccaro-add-offset! c z0n 0 dst-reg dst-off
cin-reg cin-idx z0-w)
;; dst += z2 at offset 2*m_lo, width 2*m_hi
(cuccaro-add-offset! c z2n 0 dst-reg (+ dst-off (* 2 m-lo))
cin-reg cin-idx z2-w)
;; dst += z1n at offset m_lo. The middle term value = z1 - z0 - z2 =
;; a_lo*b_hi + a_hi*b_lo < 2^(n+1). So a width-(n+1) add captures
;; the full value; the extra bits of z1n (width 2*m_sum) up to bit
;; 2*m_sum-1 are guaranteed |0> and don't need gate emission. Using
;; the narrower width also keeps the write inside the dst's 2*n
;; slice (avoids writes past dst-reg[dst-off + 2n - 1]).
(cuccaro-add-offset! c z1n 0 dst-reg (+ dst-off m-lo)
cin-reg cin-idx (+ n 1))
;; restore z1n = z1 by adding z2extn then z0extn back
(cuccaro-add! c z2extn z1n cin-reg cin-idx z1-w)
(cuccaro-add! c z0extn z1n cin-reg cin-idx z1-w)
;; uncopy z2extn, z0extn
(let loop ((k 0))
(when (< k z2-w)
(gate-cx! c z2n k z2extn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k z0-w)
(gate-cx! c z0n k z0extn k)
(loop (+ k 1))))
(free! c z2extn)
(free! c z0extn))
;; ── uncompute z1, sum_b, sum_a, z2, z0 ──
(karatsuba-wide-inverse! c san 0 sbn 0 m-sum
z1n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
;; uncompute sum_a, sum_b — mirror the padded build with sub
(let ((ahpn (kara-name-w 'kara-ahp depth n))
(bhpn (kara-name-w 'kara-bhp depth n)))
(alloc! c ahpn m-sum)
(alloc! c bhpn m-sum)
;; reapply the pads
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c a-reg (+ a-off m-lo k) ahpn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c b-reg (+ b-off m-lo k) bhpn k)
(loop (+ k 1))))
;; sub padded operands (inverse of add)
(cuccaro-sub! c bhpn sbn cin-reg cin-idx m-sum)
(cuccaro-sub! c ahpn san cin-reg cin-idx m-sum)
;; uncopy a_lo from san, b_lo from sbn
(let loop ((k 0))
(when (< k m-lo)
(gate-cx! c b-reg (+ b-off k) sbn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-lo)
(gate-cx! c a-reg (+ a-off k) san k)
(loop (+ k 1))))
;; uncompute the pads
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c b-reg (+ b-off m-lo k) bhpn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c a-reg (+ a-off m-lo k) ahpn k)
(loop (+ k 1))))
(free! c bhpn)
(free! c ahpn))
(karatsuba-wide-inverse! c a-reg (+ a-off m-lo) b-reg (+ b-off m-lo) m-hi
z2n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
(karatsuba-wide-inverse! c a-reg a-off b-reg b-off m-lo
z0n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
(free! c z1n)
(free! c sbn)
(free! c san)
(free! c z2n)
(free! c z0n)))
(define (karatsuba-step-inverse! c a-reg a-off b-reg b-off n
dst-reg dst-off
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
depth)
"Inverse of karatsuba-step!: subtract a*b from dst, restoring |0>.
Walks the forward gate-sequence in REVERSE order with each gate's
inverse — the standard gate-level inverse pattern.
Why this works (and why naive anti-combine fails): the forward
combine adds z0 → z2 → z1n_middle into dst at narrow widths.
Each add carries cleanly because dst grows monotonically. The
FORWARD sequence visits intermediate dst states:
0 → z0 → z0 + z2*2^(2*m_lo) → z0 + z2*2^(2*m_lo) + z1m*2^m_lo
The REVERSE-with-inversion runs subs in REVERSE order, walking
dst back through the SAME intermediate states. Each sub mirrors a
forward add → it cannot underflow because the corresponding slice
already holds (the post-add value), and subtracting recovers the
pre-add value cleanly.
In contrast, anti-combine subs in FORWARD order (z0 first) tries
to subtract z0 from dst-low-slice that holds (a*b mod 2^(2*m_lo))
which is NOT z0 — so the slice may underflow, dropping a borrow."
(let* ((m-lo (quotient (+ n 1) 2))
(m-hi (- n m-lo))
(m-sum (+ m-lo 1))
(z0-w (* 2 m-lo))
(z2-w (* 2 m-hi))
(z1-w (* 2 m-sum))
(z0n (kara-name-w 'kara-z0 depth n))
(z2n (kara-name-w 'kara-z2 depth n))
(san (kara-name-w 'kara-sa depth n))
(sbn (kara-name-w 'kara-sb depth n))
(z1n (kara-name-w 'kara-z1 depth n))
(next-depth (+ depth 1)))
(alloc! c z0n z0-w)
(alloc! c z2n z2-w)
(alloc! c san m-sum)
(alloc! c sbn m-sum)
(alloc! c z1n z1-w)
;; FORWARD: compute z0, z2, sums, z1 — same as kara-step! up to combine
(karatsuba-wide! c a-reg a-off b-reg b-off m-lo
z0n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
(karatsuba-wide! c a-reg (+ a-off m-lo) b-reg (+ b-off m-lo) m-hi
z2n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
(let ((ahpn (kara-name-w 'kara-ahp depth n))
(bhpn (kara-name-w 'kara-bhp depth n)))
(alloc! c ahpn m-sum)
(alloc! c bhpn m-sum)
(let loop ((k 0))
(when (< k m-lo)
(gate-cx! c a-reg (+ a-off k) san k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c a-reg (+ a-off m-lo k) ahpn k)
(loop (+ k 1))))
(cuccaro-add! c ahpn san cin-reg cin-idx m-sum)
(let loop ((k 0))
(when (< k m-lo)
(gate-cx! c b-reg (+ b-off k) sbn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c b-reg (+ b-off m-lo k) bhpn k)
(loop (+ k 1))))
(cuccaro-add! c bhpn sbn cin-reg cin-idx m-sum)
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c b-reg (+ b-off m-lo k) bhpn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c a-reg (+ a-off m-lo k) ahpn k)
(loop (+ k 1))))
(free! c bhpn)
(free! c ahpn))
(karatsuba-wide! c san 0 sbn 0 m-sum
z1n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
;; ── REVERSE-ORDER ANTI-COMBINE — walk forward-combine gates in
;; reverse with each gate inverted. dst transit through forward
;; intermediate states in reverse, so no underflow occurs at any
;; step.
;;
;; Forward combine order:
;; alloc z0extn, z2extn
;; copy z0 → z0extn, z2 → z2extn
;; z1n -= z0extn, z1n -= z2extn
;; dst += z0 (offset 0, width z0-w)
;; dst += z2 (offset 2*m_lo, width z2-w)
;; dst += z1n (offset m_lo, width n+1)
;; z1n += z2extn, z1n += z0extn
;; uncopy z2 ← z2extn, z0 ← z0extn
;; free z0extn, z2extn
;;
;; Reverse-with-inversion:
;; alloc z0extn, z2extn ← reverse of free
;; copy z0 → z0extn, z2 → z2extn ← reverse of uncopy
;; z1n -= z0extn, z1n -= z2extn ← reverse of += pair
;; dst -= z1n (offset m_lo width n+1)
;; dst -= z2 (offset 2*m_lo width z2-w)
;; dst -= z0 (offset 0 width z0-w)
;; z1n += z2extn, z1n += z0extn
;; uncopy z2extn, z0extn
;; free z0extn, z2extn
(let ((z0extn (kara-name-w 'kara-z0ext depth n))
(z2extn (kara-name-w 'kara-z2ext depth n)))
(alloc! c z0extn z1-w)
(alloc! c z2extn z1-w)
(let loop ((k 0))
(when (< k z0-w)
(gate-cx! c z0n k z0extn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k z2-w)
(gate-cx! c z2n k z2extn k)
(loop (+ k 1))))
(cuccaro-sub! c z0extn z1n cin-reg cin-idx z1-w)
(cuccaro-sub! c z2extn z1n cin-reg cin-idx z1-w)
;; ── REVERSED dst subs (z1n_middle first, then z2, then z0) ──
(cuccaro-sub-offset! c z1n 0 dst-reg (+ dst-off m-lo)
cin-reg cin-idx (+ n 1))
(cuccaro-sub-offset! c z2n 0 dst-reg (+ dst-off (* 2 m-lo))
cin-reg cin-idx z2-w)
(cuccaro-sub-offset! c z0n 0 dst-reg dst-off
cin-reg cin-idx z0-w)
(cuccaro-add! c z2extn z1n cin-reg cin-idx z1-w)
(cuccaro-add! c z0extn z1n cin-reg cin-idx z1-w)
(let loop ((k 0))
(when (< k z2-w)
(gate-cx! c z2n k z2extn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k z0-w)
(gate-cx! c z0n k z0extn k)
(loop (+ k 1))))
(free! c z2extn)
(free! c z0extn))
;; Uncompute z1, sums, z2, z0 — same as kara-step! tail.
(karatsuba-wide-inverse! c san 0 sbn 0 m-sum
z1n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
(let ((ahpn (kara-name-w 'kara-ahp depth n))
(bhpn (kara-name-w 'kara-bhp depth n)))
(alloc! c ahpn m-sum)
(alloc! c bhpn m-sum)
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c a-reg (+ a-off m-lo k) ahpn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c b-reg (+ b-off m-lo k) bhpn k)
(loop (+ k 1))))
(cuccaro-sub! c bhpn sbn cin-reg cin-idx m-sum)
(cuccaro-sub! c ahpn san cin-reg cin-idx m-sum)
(let loop ((k 0))
(when (< k m-lo)
(gate-cx! c b-reg (+ b-off k) sbn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-lo)
(gate-cx! c a-reg (+ a-off k) san k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c b-reg (+ b-off m-lo k) bhpn k)
(loop (+ k 1))))
(let loop ((k 0))
(when (< k m-hi)
(gate-cx! c a-reg (+ a-off m-lo k) ahpn k)
(loop (+ k 1))))
(free! c bhpn)
(free! c ahpn))
(karatsuba-wide-inverse! c a-reg (+ a-off m-lo) b-reg (+ b-off m-lo) m-hi
z2n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
(karatsuba-wide-inverse! c a-reg a-off b-reg b-off m-lo
z0n 0
sb-low-reg sb-low-idx sb-xext-reg
cin-reg cin-idx sb-const-tmp-reg
next-depth)
(free! c z1n)
(free! c sbn)
(free! c san)
(free! c z2n)
(free! c z0n)))
;;; ── mod-mul-karatsuba! — wrap Karatsuba wide-mul + Solinas reduce ─
;;;
;;; Same calling convention as mod-mul! and mod-mul-solinas!. When
;;; n <= *karatsuba-threshold*, dispatches verbatim to mod-mul-solinas!
;;; (byte-identical output). Otherwise runs Karatsuba for Stage 1, the
;;; Solinas reducer for Stage 2, Karatsuba-inverse for Stage 3.
(define (mod-mul-karatsuba! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg)
"out := (a * b) mod p via Karatsuba wide-multiply + Solinas reduce.
Below threshold, byte-identical to mod-mul-solinas!."
(let ((n (- n+1 1)))
(cond
((= n 0) #t)
((<= n *karatsuba-threshold*)
;; Byte-identical schoolbook+Solinas path.
(mod-mul-solinas! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg))
(else
;; ── Stage 0: alloc wide-product buffer ──
(alloc! c (quote sb-tmp-ext) (* 2 n))
;; ── Stage 1: Karatsuba wide product sb-tmp-ext := a * b ──
(karatsuba-wide! c a-reg 0 b-reg 0 n
(quote sb-tmp-ext) 0
#f #f #f
cin-reg cin-idx #f
0)
;; ── Stage 2: Solinas reduce sb-tmp-ext mod p into out ──
(alloc! c (quote sol-lo-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(mod-add! c (quote sol-lo-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(free! c (quote sol-lo-ext))
(alloc! c (quote sol-hi-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(let loop ((rest c-expansion) (current-shift 0))
(cond
((null? rest)
(mod-halve-n! c (quote sol-hi-ext) n+1 p current-shift
cin-reg cin-idx tmp-reg flag-reg flag-idx))
(else
(let* ((pair (car rest))
(sign (car pair))
(shift (cdr pair))
(delta (- shift current-shift)))
(when (< delta 0)
(error "mod-mul-karatsuba: c-expansion must be ascending"
(list current-shift shift)))
(mod-double-n! c (quote sol-hi-ext) n+1 p delta
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(cond
((= sign 1)
(mod-add! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
((= sign -1)
(mod-sub! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
(else
(error "mod-mul-karatsuba: sign must be ±1" sign)))
(loop (cdr rest) shift)))))
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(free! c (quote sol-hi-ext))
;; ── Stage 3: uncompute Karatsuba wide product ──
(karatsuba-wide-inverse! c a-reg 0 b-reg 0 n
(quote sb-tmp-ext) 0
#f #f #f
cin-reg cin-idx #f
0)
(free! c (quote sb-tmp-ext))))))
;;; ── mod-mul-karatsuba-sub! — out -= a*b mod p via Karatsuba ─────
(define (mod-mul-karatsuba-sub! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg)
"out := (out - a * b) mod p. Below threshold, byte-identical to
mod-mul-solinas-sub!."
(let ((n (- n+1 1)))
(cond
((= n 0) #t)
((<= n *karatsuba-threshold*)
(mod-mul-solinas-sub! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg))
(else
(alloc! c (quote sb-tmp-ext) (* 2 n))
(karatsuba-wide! c a-reg 0 b-reg 0 n
(quote sb-tmp-ext) 0
#f #f #f
cin-reg cin-idx #f
0)
;; Stage 2 with SIGN INVERTED (mod-sub instead of mod-add).
(alloc! c (quote sol-lo-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(mod-sub! c (quote sol-lo-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(free! c (quote sol-lo-ext))
(alloc! c (quote sol-hi-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(let loop ((rest c-expansion) (current-shift 0))
(cond
((null? rest)
(mod-halve-n! c (quote sol-hi-ext) n+1 p current-shift
cin-reg cin-idx tmp-reg flag-reg flag-idx))
(else
(let* ((pair (car rest))
(sign (car pair))
(shift (cdr pair))
(delta (- shift current-shift)))
(when (< delta 0)
(error "mod-mul-karatsuba-sub: c-expansion must be ascending"
(list current-shift shift)))
(mod-double-n! c (quote sol-hi-ext) n+1 p delta
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(cond
((= sign 1)
(mod-sub! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
((= sign -1)
(mod-add! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
(else
(error "mod-mul-karatsuba-sub: sign must be ±1" sign)))
(loop (cdr rest) shift)))))
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(free! c (quote sol-hi-ext))
(karatsuba-wide-inverse! c a-reg 0 b-reg 0 n
(quote sb-tmp-ext) 0
#f #f #f
cin-reg cin-idx #f
0)
(free! c (quote sb-tmp-ext))))))
;;; ── dispatch flag ─────────────────────────────────────────────
;;;
;;; mod-arith.lsp's mod-mul! dispatcher routes to mod-mul-solinas! when
;;; *mod-mul-use-solinas* is true. To slot Karatsuba in WITHOUT editing
;;; mod-arith.lsp (byte-identity discipline), we REDEFINE mod-mul-solinas!
;;; itself: when *mod-mul-use-karatsuba* is true, the redefined version
;;; routes to mod-mul-karatsuba!; otherwise it calls the original
;;; mod-mul-solinas-impl! (the original body, captured via name change).
;;;
;;; Effect: a caller flipping (*mod-mul-use-solinas* = #t,
;;; *mod-mul-use-karatsuba* = #t) gets Karatsuba; flipping just
;;; *mod-mul-use-solinas* = #t alone gets the original Solinas.
(define *mod-mul-use-karatsuba* #f)
;; Capture the original mod-mul-solinas! into mod-mul-solinas-impl!
;; (alias). Only happens once at load time. Subsequent set! to
;; mod-mul-solinas! redirects callers through our dispatcher.
(define mod-mul-solinas-impl! mod-mul-solinas!)
(define mod-mul-solinas-sub-impl! mod-mul-solinas-sub!)
(set! mod-mul-solinas!
(lambda (c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg)
(cond
(*mod-mul-use-karatsuba*
(mod-mul-karatsuba! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg))
(else
(mod-mul-solinas-impl! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg)))))
(set! mod-mul-solinas-sub!
(lambda (c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg)
(cond
(*mod-mul-use-karatsuba*
(mod-mul-karatsuba-sub! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg))
(else
(mod-mul-solinas-sub-impl! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg)))))

595
quantum/mod-solinas.lsp Normal file
View file

@ -0,0 +1,595 @@
;;; mod-solinas.lsp — Phase B step 7: Solinas-style fast reduction
;;; for mod-mul, primes of form p = 2^n - c with sparse c.
;;;
;;; Cuts mod-mul Stage 2 from O(n²) (2n bit-loops × O(n) mod-add per bit)
;;; to O(popcount(c) × n) — a small constant × n. For our test primes
;;; c = 5 = 2² + 2⁰ → popcount=2 → 2 mod-adds + 2 mod-doubles ≈ 4 cuccaro
;;; operations instead of 2n. Speedup at n=8 (p=251): ~16× fewer cuccaros.
;;;
;;; Mirrors upstream `mod_mul_write_into_zero_acc_schoolbook` at
;;; ~/git/ecdsafail-challenge/src/point_add/mod.rs:4044 — the same pattern
;;; of walking hi through doublings and folding ±-add into acc keyed on
;;; the bits of c.
;;;
;;; Math:
;;; x*y splits as [lo | hi] where lo = bits[0..n), hi = bits[n..2n).
;;; Then x*y = hi*2^n + lo. Since p = 2^n - c, 2^n ≡ c (mod p).
;;; So (x*y) mod p = (lo + c*hi) mod p.
;;; With c = Σ sign·2^k_j, this becomes lo + Σ sign·(hi · 2^k_j) mod p.
;;;
;;; Calling convention (same shape as mod-mul!):
;;; a-reg, b-reg, out-reg : (n+1)-wide; top bit |0>.
;;; c-expansion : Scheme list of (sign . shift) pairs encoding
;;; c = Σ sign · 2^shift. Caller computes once.
;;; e.g. for p=11/p=251 (c=5):
;;; '((1 . 2) (1 . 0))
;;; Pairs must be sorted by ASCENDING shift
;;; because we cumulatively double hi.
;;; cin, tmp, flag, red-tmp : same scratch suite as mod-mul!.
;;;
;;; Internal ancillae (Litinski + Solinas):
;;; sb-tmp-ext (2n bits) wide product accumulator (Stage 1 / 3)
;;; sb-low (1 bit) wide[0] for Stage 1 / 3
;;; sb-xext (n+1 bits) Stage 1 / 3 add-subtract scratch
;;; sb-const-tmp (n+1 bits) Stage 1 / 3 constant-loading scratch
;;; sol-lo-ext (n+1 bits) Stage-2 lo-as-extended-reg copy
;;; sol-hi-ext (n+1 bits) Stage-2 hi-as-extended-reg copy (walks via doublings)
(load "quantum/gates.lsp")
(load "quantum/adder.lsp")
(load "quantum/mod-arith.lsp")
;;; ── from-zero specialization lever ────────────────────────────────
;;;
;;; *mod-mul-from-zero-first-add* — when #t, mod-mul-solinas-from-zero!
;;; (& its callers) replace Stage 2a's first mod-add! with
;;; mod-add-from-zero!. Saves n CCX per fresh-multiply call. Caller
;;; opts in by invoking mod-mul-from-zero! (mod-arith.lsp) instead of
;;; mod-mul!. Default OFF so opt-out is trivial.
;;;
;;; Port of HEAD's `mod_add_qq_fast_from_zero` specialization
;;; (mod.rs:961-1038) lifted to the Solinas Stage 2 entry point.
(define *mod-mul-from-zero-first-add* #f)
;;; ── helper: apply n consecutive doublings to a register ──
(define (mod-double-n! c v-reg n+1 p k
cin-reg cin-idx tmp-reg flag-reg flag-idx)
"Apply mod-double-inplace! k times. v := v * 2^k mod p. k >= 0."
(let loop ((i 0))
(when (< i k)
(mod-double-inplace! c v-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(loop (+ i 1)))))
(define (mod-halve-n! c v-reg n+1 p k
cin-reg cin-idx tmp-reg flag-reg flag-idx)
"Apply mod-halve-inplace! k times. v := v * 2^(-k) mod p."
(let loop ((i 0))
(when (< i k)
(mod-halve-inplace! c v-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(loop (+ i 1)))))
;;; ── helper: CX-copy a slice of one register into the low bits of another ──
(define (cx-copy-slice! c src-reg src-off tgt-reg width)
"tgt[k] ^= src[src-off + k] for k in [0, width). Self-inverse."
(let loop ((k 0))
(when (< k width)
(gate-cx! c src-reg (+ src-off k) tgt-reg k)
(loop (+ k 1)))))
;;; ── mod-mul-solinas! — Litinski schoolbook + Solinas Stage-2 reduce ──
(define (mod-mul-solinas! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg)
"out := (a * b) mod p using Solinas fast reduction.
c-expansion encodes c = 2^n - p as ((sign . shift) ...) sorted by
ASCENDING shift. See file header for full calling convention.
red-tmp-reg unused here (kept for signature parity with mod-mul!);
may be passed as any (n+1)-wide ancilla |0> in/out (caller still
allocs to keep the call site uniform with mod-mul!)."
(let ((n (- n+1 1)))
(cond
((= n 0) #t)
(else
;; ── Stage 0: alloc Litinski scratch ──
;;
;; sweep-036: when *sub-x-from-wide-host-alloc* is on, hoist
;; sb-xfull alloc to OUTERMOST Stage-0 step so it lands at the
;; lowest free 513-wide base inside the mod-mul scope. Width
;; matches sub-x-from-wide!'s internal compute:
;; xfull-width = 2n+1 by default
;; = 4n+1 when *cuccaro-callers-fast* AND
;; *sub-x-from-wide-cas-fast* both on.
;; *host-sb-xfull-reg* communicates the name to sub-x-from-wide!
;; & add-x-into-wide! (mod-arith.lsp) without changing their
;; signatures.
(when *sub-x-from-wide-host-alloc*
(let* ((use-fast? (and *cuccaro-callers-fast*
*sub-x-from-wide-cas-fast*))
(joint-width (+ (* 2 n) 1))
(xfull-width (cond (use-fast? (+ joint-width
(- joint-width 1)))
(else joint-width))))
(alloc! c (quote sb-xfull-host) xfull-width)
(set! *host-sb-xfull-reg* (quote sb-xfull-host))))
(alloc! c (quote sb-tmp-ext) (* 2 n))
(alloc! c (quote sb-low) 1)
(alloc! c (quote sb-xext) (+ n 1))
(alloc! c (quote sb-const-tmp) (+ n 1))
;; Optional CAS-borrowed carries register for HMR dispatch in
;; cuccaro-add-offset! (mod-arith.lsp). Activated by setting
;; *cuccaro-callers-fast* #t at emit driver level. Borrows from
;; red-tmp-reg (caller-passed, unused per Solinas signature
;; convention — see file header). ZERO qubit cost.
(when *cuccaro-callers-fast*
(set! *cas-borrowed-carries-reg* red-tmp-reg)
(set! *cas-borrowed-carries-offset* 0)
(set! *cas-borrowed-bit-base* 200000)
;; red-tmp-reg is (n+1) wide; fast-borrowed dispatch consumes
;; (width-1) carries lanes. Set width=n+1 so joint dispatch
;; falls through for sub-x-from-wide (width 2n+1, needs 2n
;; slots) — only schoolbook-row-k0 (width n+1, needs n slots)
;; activates. Offset variants (width n+1) always fit.
(set! *cas-borrowed-carries-width* (+ n 1)))
;; ── Stage 1: compute wide product sb-tmp-ext := a * b ──
(schoolbook-mul-into-addsub! c a-reg b-reg n
(quote sb-low) 0
(quote sb-tmp-ext)
(quote sb-xext)
cin-reg cin-idx
(quote sb-const-tmp))
;; ── Stage 2: reduce via Solinas walk ──
;; 2a. out += lo mod p
;; 2b. for each (sign . shift) in c-expansion (ascending):
;; advance hi by delta-shift doublings; out += sign * hi mod p
;; 2c. walk hi all the way back via halvings to clear the copy.
;;
;; alg-11 mirror — classical Stage-2 tracker. When both a-reg and
;; b-reg carry classical values (find-classical-value via
;; bind-input!/rebind-mirror! channel), derive the classical
;; product & track lo / hi / out across the Stage-2 walk so the
;; in-line mod-add!/mod-sub!/mod-double-n! dispatchers can
;; route pseudo-Mersenne on safe inputs.
(let* ((a-cl (find-classical-value c a-reg))
(b-cl (find-classical-value c b-reg))
(out-cl (find-classical-value c out-reg))
(track? (and a-cl b-cl out-cl))
(prod (and track? (* a-cl b-cl)))
(lo-cl (and track? (modulo prod (expt 2 n))))
(hi-cl (and track? (quotient prod (expt 2 n)))))
;; sol-lo-ext (n+1) holds a CX-copy of sb-tmp-ext[0..n) in low n
;; bits; top bit stays |0>.
(alloc! c (quote sol-lo-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(when track?
(rebind-mirror! c (quote sol-lo-ext) lo-cl))
(mod-add! c (quote sol-lo-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(when track?
(rebind-mirror! c out-reg (modulo (+ out-cl lo-cl) p)))
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(free! c (quote sol-lo-ext))
;; sol-hi-ext: copy of sb-tmp-ext[n..2n) in low n bits.
(alloc! c (quote sol-hi-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(when track?
(rebind-mirror! c (quote sol-hi-ext) hi-cl))
;; Walk hi via mod-doublings. Track cumulative shift via current-shift.
(let loop ((rest c-expansion)
(current-shift 0)
(cur-hi (and track? hi-cl))
(cur-out (and track? (modulo (+ out-cl lo-cl) p))))
(cond
((null? rest)
;; Walk hi back to its original value via halvings.
(mod-halve-n! c (quote sol-hi-ext) n+1 p current-shift
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(when track?
(rebind-mirror! c (quote sol-hi-ext) hi-cl)))
(else
(let* ((pair (car rest))
(sign (car pair))
(shift (cdr pair))
(delta (- shift current-shift)))
(when (< delta 0)
(error "mod-mul-solinas: c-expansion must be ascending"
(list current-shift shift)))
(mod-double-n! c (quote sol-hi-ext) n+1 p delta
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(let* ((hi-after (and track?
(modulo (* cur-hi (expt 2 delta)) p)))
(next-out (cond
((not track?) #f)
((= sign 1)
(modulo (+ cur-out hi-after) p))
(else
(modulo (- cur-out hi-after) p)))))
(when track?
(rebind-mirror! c (quote sol-hi-ext) hi-after))
(cond
((= sign 1)
(mod-add! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
((= sign -1)
(mod-sub! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
(else
(error "mod-mul-solinas: sign must be ±1" sign)))
(when track?
(rebind-mirror! c out-reg next-out))
(loop (cdr rest) shift hi-after next-out)))))))
;; Uncopy hi from sb-tmp-ext.
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(free! c (quote sol-hi-ext))
;; ── Stage 3: uncompute sb-tmp-ext back to |0> ──
(schoolbook-mul-into-addsub-inverse! c a-reg b-reg n
(quote sb-low) 0
(quote sb-tmp-ext)
(quote sb-xext)
cin-reg cin-idx
(quote sb-const-tmp))
;; ── Stage 4: free Litinski scratch ──
(when *cuccaro-callers-fast*
(set! *cas-borrowed-carries-reg* #f))
(free! c (quote sb-const-tmp))
(free! c (quote sb-xext))
(free! c (quote sb-low))
(free! c (quote sb-tmp-ext))
;; sweep-036: free host-allocated sb-xfull (if hoisted).
(when *sub-x-from-wide-host-alloc*
(set! *host-sb-xfull-reg* #f)
(free! c (quote sb-xfull-host)))))))
;;; ── mod-mul-solinas-sub! — out := out - (a*b) mod p via Solinas ──
;;;
;;; Mirror of mod-mul-sub! using Solinas Stage 2. Needed so we can swap
;;; in mod-mul-solinas! through the Roetteler point-add (which calls
;;; mod-mul-sub! at steps 5, 10, 12c, 12d).
(define (mod-mul-solinas-sub! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg)
"out := (out - a*b) mod p via Solinas. Mirror of mod-mul-solinas! with
sign-inverted Stage-2 mod-add/mod-sub."
(let ((n (- n+1 1)))
(cond
((= n 0) #t)
(else
;; sweep-036: hoist sb-xfull alloc when opt-in flag is set.
(when *sub-x-from-wide-host-alloc*
(let* ((use-fast? (and *cuccaro-callers-fast*
*sub-x-from-wide-cas-fast*))
(joint-width (+ (* 2 n) 1))
(xfull-width (cond (use-fast? (+ joint-width
(- joint-width 1)))
(else joint-width))))
(alloc! c (quote sb-xfull-host) xfull-width)
(set! *host-sb-xfull-reg* (quote sb-xfull-host))))
(alloc! c (quote sb-tmp-ext) (* 2 n))
(alloc! c (quote sb-low) 1)
(alloc! c (quote sb-xext) (+ n 1))
(alloc! c (quote sb-const-tmp) (+ n 1))
(when *cuccaro-callers-fast*
(set! *cas-borrowed-carries-reg* red-tmp-reg)
(set! *cas-borrowed-carries-offset* 0)
(set! *cas-borrowed-bit-base* 200000)
;; red-tmp-reg is (n+1) wide; fast-borrowed dispatch consumes
;; (width-1) carries lanes. Set width=n+1 so joint dispatch
;; falls through for sub-x-from-wide (width 2n+1, needs 2n
;; slots) — only schoolbook-row-k0 (width n+1, needs n slots)
;; activates. Offset variants (width n+1) always fit.
(set! *cas-borrowed-carries-width* (+ n 1)))
(schoolbook-mul-into-addsub! c a-reg b-reg n
(quote sb-low) 0
(quote sb-tmp-ext)
(quote sb-xext)
cin-reg cin-idx
(quote sb-const-tmp))
;; Stage 2 with SIGN INVERTED on every fold (mod-add ↔ mod-sub).
;; alg-11 classical-mirror tracker — same shape as mod-mul-solinas!
;; but sign is flipped for the running out accumulator.
(let* ((a-cl (find-classical-value c a-reg))
(b-cl (find-classical-value c b-reg))
(out-cl (find-classical-value c out-reg))
(track? (and a-cl b-cl out-cl))
(prod (and track? (* a-cl b-cl)))
(lo-cl (and track? (modulo prod (expt 2 n))))
(hi-cl (and track? (quotient prod (expt 2 n)))))
(alloc! c (quote sol-lo-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(when track?
(rebind-mirror! c (quote sol-lo-ext) lo-cl))
(mod-sub! c (quote sol-lo-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(when track?
(rebind-mirror! c out-reg (modulo (- out-cl lo-cl) p)))
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(free! c (quote sol-lo-ext))
(alloc! c (quote sol-hi-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(when track?
(rebind-mirror! c (quote sol-hi-ext) hi-cl))
(let loop ((rest c-expansion)
(current-shift 0)
(cur-hi (and track? hi-cl))
(cur-out (and track? (modulo (- out-cl lo-cl) p))))
(cond
((null? rest)
(mod-halve-n! c (quote sol-hi-ext) n+1 p current-shift
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(when track?
(rebind-mirror! c (quote sol-hi-ext) hi-cl)))
(else
(let* ((pair (car rest))
(sign (car pair))
(shift (cdr pair))
(delta (- shift current-shift)))
(when (< delta 0)
(error "mod-mul-solinas-sub: c-expansion must be ascending"
(list current-shift shift)))
(mod-double-n! c (quote sol-hi-ext) n+1 p delta
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(let* ((hi-after (and track?
(modulo (* cur-hi (expt 2 delta)) p)))
(next-out (cond
((not track?) #f)
((= sign 1)
(modulo (- cur-out hi-after) p))
(else
(modulo (+ cur-out hi-after) p)))))
(when track?
(rebind-mirror! c (quote sol-hi-ext) hi-after))
(cond
((= sign 1)
(mod-sub! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
((= sign -1)
(mod-add! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
(else
(error "mod-mul-solinas-sub: sign must be ±1" sign)))
(when track?
(rebind-mirror! c out-reg next-out))
(loop (cdr rest) shift hi-after next-out)))))))
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(free! c (quote sol-hi-ext))
(schoolbook-mul-into-addsub-inverse! c a-reg b-reg n
(quote sb-low) 0
(quote sb-tmp-ext)
(quote sb-xext)
cin-reg cin-idx
(quote sb-const-tmp))
(when *cuccaro-callers-fast*
(set! *cas-borrowed-carries-reg* #f))
(free! c (quote sb-const-tmp))
(free! c (quote sb-xext))
(free! c (quote sb-low))
(free! c (quote sb-tmp-ext))
;; sweep-036: free host-allocated sb-xfull (if hoisted).
(when *sub-x-from-wide-host-alloc*
(set! *host-sb-xfull-reg* #f)
(free! c (quote sb-xfull-host)))))))
;;; ── mod-mul-solinas-from-zero! — out=|0> specialization ──────────
;;;
;;; Caller-explicit specialization of mod-mul-solinas! for the case
;;; where out-reg is guaranteed to be |0> on entry. Mirror of
;;; mod-mul-solinas! verbatim except Stage 2a's mod-add! swaps to
;;; mod-add-from-zero! — saves n CCX per call.
;;;
;;; Caller responsibility: out-reg MUST be |0> across all n+1 bits on
;;; entry. Typical sites: mod-square! (out alloc'd same line) and
;;; mod-inv-by Fermat ladder's r-next / b-next freshly-alloc'd registers.
;;;
;;; Port mirrors HEAD's `mod_add_qq_fast_from_zero` (mod.rs:961-1038)
;;; lifted to the Solinas Stage 2 entry boundary. Stage 2b+ uses plain
;;; mod-add! / mod-sub! because out-reg is no longer zero after 2a.
(define (mod-mul-solinas-from-zero! c a-reg b-reg out-reg n+1 p c-expansion
cin-reg cin-idx tmp-reg flag-reg flag-idx
red-tmp-reg)
"out := (a * b) mod p assuming out is |0> on entry. Same calling
convention as mod-mul-solinas!; Stage 2a uses mod-add-from-zero!
for n CCX savings vs mod-mul-solinas!."
(let ((n (- n+1 1)))
(cond
((= n 0) #t)
(else
;; ── Stage 0: alloc Litinski scratch (same as mod-mul-solinas!) ──
(when *sub-x-from-wide-host-alloc*
(let* ((use-fast? (and *cuccaro-callers-fast*
*sub-x-from-wide-cas-fast*))
(joint-width (+ (* 2 n) 1))
(xfull-width (cond (use-fast? (+ joint-width
(- joint-width 1)))
(else joint-width))))
(alloc! c (quote sb-xfull-host) xfull-width)
(set! *host-sb-xfull-reg* (quote sb-xfull-host))))
(alloc! c (quote sb-tmp-ext) (* 2 n))
(alloc! c (quote sb-low) 1)
(alloc! c (quote sb-xext) (+ n 1))
(alloc! c (quote sb-const-tmp) (+ n 1))
(when *cuccaro-callers-fast*
(set! *cas-borrowed-carries-reg* red-tmp-reg)
(set! *cas-borrowed-carries-offset* 0)
(set! *cas-borrowed-bit-base* 200000)
(set! *cas-borrowed-carries-width* (+ n 1)))
;; ── Stage 1: wide product (unchanged) ──
(schoolbook-mul-into-addsub! c a-reg b-reg n
(quote sb-low) 0
(quote sb-tmp-ext)
(quote sb-xext)
cin-reg cin-idx
(quote sb-const-tmp))
;; ── Stage 2a: out += lo mod p — FROM-ZERO PATH ──
;; alg-11 classical-mirror tracker — same shape as mod-mul-solinas!
;; but out starts at 0 per the from-zero contract.
(let* ((a-cl (find-classical-value c a-reg))
(b-cl (find-classical-value c b-reg))
(track? (and a-cl b-cl))
(prod (and track? (* a-cl b-cl)))
(lo-cl (and track? (modulo prod (expt 2 n))))
(hi-cl (and track? (quotient prod (expt 2 n)))))
(alloc! c (quote sol-lo-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(when track?
(rebind-mirror! c (quote sol-lo-ext) lo-cl))
(cond
(*mod-mul-from-zero-first-add*
(mod-add-from-zero! c (quote sol-lo-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
(else
(mod-add! c (quote sol-lo-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx)))
(when track?
(rebind-mirror! c out-reg (modulo lo-cl p)))
(cx-copy-slice! c (quote sb-tmp-ext) 0 (quote sol-lo-ext) n)
(free! c (quote sol-lo-ext))
;; ── Stage 2b+: out is no longer zero — use plain mod-add!. ──
(alloc! c (quote sol-hi-ext) (+ n 1))
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(when track?
(rebind-mirror! c (quote sol-hi-ext) hi-cl))
(let loop ((rest c-expansion)
(current-shift 0)
(cur-hi (and track? hi-cl))
(cur-out (and track? (modulo lo-cl p))))
(cond
((null? rest)
(mod-halve-n! c (quote sol-hi-ext) n+1 p current-shift
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(when track?
(rebind-mirror! c (quote sol-hi-ext) hi-cl)))
(else
(let* ((pair (car rest))
(sign (car pair))
(shift (cdr pair))
(delta (- shift current-shift)))
(when (< delta 0)
(error "mod-mul-solinas-from-zero: c-expansion must be ascending"
(list current-shift shift)))
(mod-double-n! c (quote sol-hi-ext) n+1 p delta
cin-reg cin-idx tmp-reg flag-reg flag-idx)
(let* ((hi-after (and track?
(modulo (* cur-hi (expt 2 delta)) p)))
(next-out (cond
((not track?) #f)
((= sign 1)
(modulo (+ cur-out hi-after) p))
(else
(modulo (- cur-out hi-after) p)))))
(when track?
(rebind-mirror! c (quote sol-hi-ext) hi-after))
(cond
((= sign 1)
(mod-add! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
((= sign -1)
(mod-sub! c (quote sol-hi-ext) out-reg n+1 p
cin-reg cin-idx tmp-reg flag-reg flag-idx))
(else
(error "mod-mul-solinas-from-zero: sign must be ±1" sign)))
(when track?
(rebind-mirror! c out-reg next-out))
(loop (cdr rest) shift hi-after next-out)))))))
(cx-copy-slice! c (quote sb-tmp-ext) n (quote sol-hi-ext) n)
(free! c (quote sol-hi-ext))
;; ── Stage 3: uncompute wide product (unchanged) ──
(schoolbook-mul-into-addsub-inverse! c a-reg b-reg n
(quote sb-low) 0
(quote sb-tmp-ext)
(quote sb-xext)
cin-reg cin-idx
(quote sb-const-tmp))
;; ── Stage 4: free scratch (unchanged) ──
(when *cuccaro-callers-fast*
(set! *cas-borrowed-carries-reg* #f))
(free! c (quote sb-const-tmp))
(free! c (quote sb-xext))
(free! c (quote sb-low))
(free! c (quote sb-tmp-ext))
(when *sub-x-from-wide-host-alloc*
(set! *host-sb-xfull-reg* #f)
(free! c (quote sb-xfull-host)))))))
;;; ── classical helper: compute c-expansion for p = 2^n - c ──
;;;
;;; Returns ((1 . k0) (1 . k1) ...) for c = Σ 2^k_i (i.e. naive bit-set
;;; expansion, sorted by ascending shift). For sparse c with consecutive
;;; runs the *solinas-c-naf* lever (sweep-092) emits NAF ±1 expansion
;;; which drops popcount on runs (e.g. secp256k1 c = 2^32 + 977 goes
;;; 7 -> 5 terms; saves 2 mod-add/sub + 2 mod-double-n calls per
;;; mod-mul-solinas! invocation).
;;; *solinas-c-naf* — sweep-092 lever. Port of HEAD's R84_QPROD_NAF
;;; rewrite of the round84 quotient * c product. HEAD ed94ad2
;;; (2026-06-09 13:43 UTC). When #t, compute-c-expansion emits the
;;; non-adjacent-form (NAF) ±1 expansion of c instead of the naive
;;; bit-set expansion. Both Stage-2 loops in mod-mul-solinas! /
;;; -sub! / -from-zero! already handle (sign . shift) pairs with
;;; sign in {+1, -1}, so this is purely a classical-helper change.
;;;
;;; NAF properties: any integer has a unique NAF with no two
;;; consecutive non-zero digits. For runs of consecutive 1 bits
;;; like 977 = 0b1111010001 the NAF replaces a run length L with
;;; 2 terms (one -1 at the run's low end, one +1 at the next zero
;;; above the run). For secp256k1's c = 2^32 + 977:
;;; naive: (1.0) (1.4) (1.6) (1.7) (1.8) (1.9) (1.32) ; 7 terms
;;; NAF : (1.0) (1.4) (-1.6) (1.10) (1.32) ; 5 terms
;;;
;;; Default #f preserves naive byte-identity (HEAD's pre-ed94ad2 form).
;;; When #t adds the cost of one NAF computation per Solinas mod-mul
;;; (constant time on n+1 = 257; negligible vs the circuit emit cost).
(define *solinas-c-naf* #f)
(define (compute-c-expansion-naive p n)
"Naive bit-set expansion (pre-sweep-092 form)."
(let ((c-val (- (expt 2 n) p)))
(when (<= c-val 0)
(error "compute-c-expansion-naive: p must satisfy p < 2^n" (list p n)))
(let loop ((i 0) (acc (quote ())))
(cond
((>= i n)
(reverse acc))
((bit-set? c-val i)
(loop (+ i 1) (cons (cons 1 i) acc)))
(else
(loop (+ i 1) acc))))))
(define (compute-c-expansion-naf p n)
"NAF (non-adjacent form) ±1 expansion of c = 2^n - p. Returns a
list of (sign . shift) pairs sorted by ascending shift, with
sign in {+1, -1}. NAF guarantees no two consecutive shifts share
a non-zero digit, so over runs of consecutive 1-bits the
popcount drops from L to 2."
(let ((c-val (- (expt 2 n) p)))
(when (<= c-val 0)
(error "compute-c-expansion-naf: p must satisfy p < 2^n" (list p n)))
;; Standard NAF: while c > 0, if c odd then z = 2 - (c mod 4),
;; subtract z from c, else z = 0; emit z at current shift; c >>= 1.
;; We use quotient (not arithmetic-shift) for C-tier compatibility.
(let loop ((c c-val) (i 0) (acc (quote ())))
(cond
((= c 0)
(reverse acc))
((= (remainder c 2) 1)
(let ((z (- 2 (remainder c 4))))
(loop (quotient (- c z) 2) (+ i 1)
(cons (cons z i) acc))))
(else
(loop (quotient c 2) (+ i 1) acc))))))
(define (compute-c-expansion p n)
"Compute the c = 2^n - p expansion as an ascending list of
(sign . shift) pairs. Caller can pre-compute and pass into
mod-mul-solinas!. When *solinas-c-naf* is #t emits the NAF
±1 form (sweep-092); else emits the naive +1 bit-set form."
(cond
(*solinas-c-naf* (compute-c-expansion-naf p n))
(else (compute-c-expansion-naive p n))))

104
quantum/score.lsp Normal file
View file

@ -0,0 +1,104 @@
;;; score.lsp — Shot aggregator. Reads many result portals, computes
;;; upstream score = (avg Toffoli per shot) × (peak live-qubit width).
;;;
;;; Per foxhop CLAUDE.md ### ecdsa/ — lumbda asm-tier safety.
;;; *max-shots* bounds every multi-shot run. Default 64 during dev;
;;; raise via (set! *max-shots* N) at top of main.lsp under explicit
;;; fox approval only. Never raise past 1024 on bump-only asm.
(define *max-shots* 64)
(define (clamp-shots requested)
"Clamp requested shot count to *max-shots*, log when clamping fires."
(cond
((< requested 0) 0)
((> requested *max-shots*)
(display ";;; shot count clamped: requested=")
(display requested)
(display " *max-shots*=") (display *max-shots*) (newline)
*max-shots*)
(else requested)))
;;; ── result-portal accessors ─────────────────────────────────
(define (read-portal-file filename)
"Slurp a portal file. Same cross-tier idiom as sim.lsp's read-portal."
(read-from-string (file->string filename)))
(define (result-section r tag)
(let loop ((children (cdr r)))
(cond
((null? children) #f)
((and (pair? (car children)) (eq? (car (car children)) tag))
(cdr (car children)))
(else (loop (cdr children))))))
(define (result-status r)
(let ((s (result-section r 'status)))
(if s (car s) 'unknown)))
(define (counts-field r field)
(let ((counts (result-section r 'counts)))
(cond
((not counts) 0)
(else
(let ((row (assoc field counts)))
(if row (car (cdr row)) 0))))))
(define (result-toffoli r) (counts-field r 'toffoli))
(define (result-clifford r) (counts-field r 'clifford))
(define (result-peak-qubits r) (counts-field r 'peak-qubits))
;;; ── aggregation across many result portals ──────────────────
(define (aggregate-results paths)
"Walk a list of result-portal paths. Drops shots whose status is not
ok (counts them as rejects). Returns alist with raw totals so any
consumer can recompute the score precisely."
(let loop ((rest paths)
(n 0)
(toffoli-sum 0)
(clifford-sum 0)
(peak-max 0)
(rejects 0))
(cond
((null? rest)
(list (cons 'shots n)
(cons 'rejects rejects)
(cons 'toffoli-sum toffoli-sum)
(cons 'clifford-sum clifford-sum)
(cons 'peak-qubits peak-max)
(cons 'score-num (* toffoli-sum peak-max))
(cons 'score-den (if (= n 0) 1 n))
(cons 'avg-toffoli (if (= n 0) 0 (quotient toffoli-sum n)))
(cons 'score (if (= n 0)
0
(quotient (* toffoli-sum peak-max) n)))))
(else
(let ((r (read-portal-file (car rest))))
(cond
((eq? (result-status r) 'ok)
(loop (cdr rest)
(+ n 1)
(+ toffoli-sum (result-toffoli r))
(+ clifford-sum (result-clifford r))
(cond ((> (result-peak-qubits r) peak-max)
(result-peak-qubits r))
(else peak-max))
rejects))
(else
(loop (cdr rest)
n
toffoli-sum
clifford-sum
peak-max
(+ rejects 1)))))))))
(define (write-summary! path summary)
"Write aggregated summary to a portal-style S-expression file."
(let* ((tmp (string-append path ".tmp"))
(port (open-output-file tmp)))
(write (cons 'summary summary) port)
(newline port)
(close-port port)
(rename-file tmp path)))

430
quantum/sim.lsp Normal file
View file

@ -0,0 +1,430 @@
;;; sim.lsp — Reversible bit-level simulator for our S-expression circuits.
;;;
;;; Reads a circuit portal, executes its op stream on classical bits,
;;; counts Toffoli & Clifford gates & peak live qubits, runs a reverse
;;; pass to confirm reversibility, writes a result portal.
;;;
;;; Runs on every lumbda tier — Python, C, asm — byte-identically.
;;;
;;; Public entry point: (simulate-portal in-path out-path)
;;;
;;; Wire format documented in gates.lsp.
;;; ── tiny utilities ────────────────────────────────────────────
(define (read-portal filename)
"Slurp a portal as a single S-expression. Uses file->string +
read-from-string for cross-tier portability — (read port) on a
raw file handle falls back to stdin on lumbda's Python tier."
(read-from-string (file->string filename)))
(define (write-portal! filename sexp)
"Write an S-expression to a file atomically."
(let ((tmp (string-append filename ".tmp")))
(let ((port (open-output-file tmp)))
(write sexp port)
(newline port)
(close-port port))
(rename-file tmp filename)))
(define (section sexp tag)
"Return body (everything past tag) of first child whose head = tag, else #f."
(let loop ((children (cdr sexp)))
(cond
((null? children) #f)
((and (pair? (car children)) (eq? (car (car children)) tag))
(cdr (car children)))
(else (loop (cdr children))))))
(define (int->bits n width)
"Decode integer n into a vector of width bits, LSB at index 0."
(let ((v (make-vector width 0)))
(let loop ((i 0) (rest n))
(if (= i width)
v
(begin (vector-set! v i (remainder rest 2))
(loop (+ i 1) (quotient rest 2)))))))
(define (bits->int v)
"Encode a bit vector (LSB at index 0) back into an integer."
(let loop ((i 0) (acc 0) (pow 1))
(if (= i (vector-length v))
acc
(loop (+ i 1)
(+ acc (* (vector-ref v i) pow))
(* pow 2)))))
(define (vector-all-zero? v)
(let loop ((i 0))
(cond
((= i (vector-length v)) #t)
((not (= (vector-ref v i) 0)) #f)
(else (loop (+ i 1))))))
(define (vector-equal? a b)
(and (= (vector-length a) (vector-length b))
(let loop ((i 0))
(cond
((= i (vector-length a)) #t)
((not (= (vector-ref a i) (vector-ref b i))) #f)
(else (loop (+ i 1)))))))
(define (vector-copy v)
(let* ((n (vector-length v))
(out (make-vector n 0)))
(let loop ((i 0))
(if (= i n)
out
(begin (vector-set! out i (vector-ref v i))
(loop (+ i 1)))))))
;;; ── simulator state ───────────────────────────────────────────
;;;
;;; State carries:
;;; regs hash-table: register-name → bit vector (mutable)
;;; widths hash-table: register-name → declared width
;;; live integer: sum of current register widths
;;; peak integer: max live ever reached
;;; toffoli integer: count of ccx ops
;;; clifford integer: count of x + cx ops
(define (make-sim-state)
(vector (make-hash-table) ; 0: regs
(make-hash-table) ; 1: widths
0 ; 2: live
0 ; 3: peak
0 ; 4: toffoli
0 ; 5: clifford
'running ; 6: status (running | leaked-ancilla | bad-op)
(make-hash-table) ; 7: bits (Tier-2 classical bits, int-id → 0/1)
'() ; 8: cond-stack (Tier-2 push-cond / pop-cond)
1)) ; 9: cond (Tier-2, current conditional mask, 0 or 1)
(define (st-regs s) (vector-ref s 0))
(define (st-widths s) (vector-ref s 1))
(define (st-live s) (vector-ref s 2))
(define (st-peak s) (vector-ref s 3))
(define (st-toffoli s) (vector-ref s 4))
(define (st-clifford s) (vector-ref s 5))
(define (st-status s) (vector-ref s 6))
(define (st-bits s) (vector-ref s 7))
(define (st-cond-stack s) (vector-ref s 8))
(define (st-cond s) (vector-ref s 9))
(define (set-live! s v) (vector-set! s 2 v))
(define (set-peak! s v) (vector-set! s 3 v))
(define (set-toffoli! s v) (vector-set! s 4 v))
(define (set-clifford! s v) (vector-set! s 5 v))
(define (set-status! s v) (vector-set! s 6 v))
(define (set-cond-stack! s v) (vector-set! s 8 v))
(define (set-cond! s v) (vector-set! s 9 v))
(define (bit-ref s id)
"Read classical bit; defaults to 0 if not yet set."
(let ((bits (st-bits s)))
(cond
((hash-table-exists? bits id) (hash-table-ref bits id))
(else 0))))
(define (bit-set! s id v)
(hash-table-set! (st-bits s) id v))
(define (st-ok? s) (eq? (st-status s) 'running))
(define (touch-peak! s)
(when (> (st-live s) (st-peak s))
(set-peak! s (st-live s))))
;;; ── register initialization ───────────────────────────────────
(define (declare-registers! s registers-section input-section)
;; registers-section = ((target-x 4) (target-y 4) ...)
;; input-section = ((target-x 11) (target-y 6) ...)
(for-each
(lambda (rec)
(let ((name (car rec))
(width (car (cdr rec))))
(hash-table-set! (st-widths s) name width)
(let ((initial 0))
;; lookup input value if present
(let ((row (assoc name input-section)))
(when row (set! initial (car (cdr row)))))
(hash-table-set! (st-regs s) name (int->bits initial width)))
(set-live! s (+ (st-live s) width))))
registers-section)
(touch-peak! s))
;;; ── op execution (forward and reverse) ────────────────────────
(define (qref->bit s ref)
"ref = (reg-name idx)."
(let ((reg (hash-table-ref (st-regs s) (car ref))))
(vector-ref reg (car (cdr ref)))))
(define (qref-flip! s ref)
(let* ((reg (hash-table-ref (st-regs s) (car ref)))
(i (car (cdr ref)))
(cur (vector-ref reg i)))
(vector-set! reg i (- 1 cur))))
(define (exec-op! s op forward?)
"Apply one op. forward? = #t for forward pass, #f for reverse.
All Phase B Tier-1 gates {x, z, cx, cz, ccx, ccz, r} are self-inverse
on classical-bit-valued single-shot state (z/cz/ccz add no observable
bit-value effect; r unconditionally zeros target). Tier-2 ops
{bit-invert, bit-store0, bit-store1, hmr, push-cond, pop-cond} require
reversibility-aware handling — see sweep-013 RESULTS.md for the
classical-replay design."
(case (car op)
((x)
;; sweep-041: gate on st-cond to match HEAD's sim_cpu.c (line 62):
;; uint64_t v = cond ...; qubits[tgt] ^= v. Under push-cond=0 the
;; gate must NOT fire. Tier-2 ops (bit-*, HMR) were already gated;
;; Tier-1 quantum ops were not until sweep-041 surfaced the gap
;; via verify-boundary-cond-replay round-trip failure. Clifford
;; counter also gated to mirror sim_cpu.c line 38-39.
(when (= (st-cond s) 1)
(qref-flip! s (car (cdr op)))
(set-clifford! s (+ (st-clifford s) 1))))
((z)
;; Z is phase-only — no effect on classical-bit single-shot state.
;; Clifford counter gated on cond like other Cliffords.
(when (= (st-cond s) 1)
(set-clifford! s (+ (st-clifford s) 1))))
((cx)
(when (= (st-cond s) 1)
(let ((ctrl (car (cdr op)))
(tgt (car (cdr (cdr op)))))
(when (= (qref->bit s ctrl) 1)
(qref-flip! s tgt)))
(set-clifford! s (+ (st-clifford s) 1))))
((cz)
;; CZ is phase-only — no bit-value effect. Gated counter bump.
(when (= (st-cond s) 1)
(set-clifford! s (+ (st-clifford s) 1))))
((ccx)
(when (= (st-cond s) 1)
(let ((c1 (car (cdr op)))
(c2 (car (cdr (cdr op))))
(tgt (car (cdr (cdr (cdr op))))))
(when (and (= (qref->bit s c1) 1) (= (qref->bit s c2) 1))
(qref-flip! s tgt)))
;; sweep-041: bump Toffoli only on cond=1 — mirrors HEAD's
;; sim_cpu.c line 37 (toffoli_gates += executed = POPCOUNT(cond)).
;; Single-shot classical: cond=1 → +1, cond=0 → +0. Without this
;; gating, cond-replay's "half-shot saving" doesn't show in our
;; sim's Toffoli count.
(set-toffoli! s (+ (st-toffoli s) 1))))
((ccz)
;; CCZ is phase-only — no bit-value effect. One Toffoli charge,
;; gated on cond like CCX (matches sim_cpu.c line 36-37).
(when (= (st-cond s) 1)
(set-toffoli! s (+ (st-toffoli s) 1))))
((r)
;; Single-qubit reset. Under push-cond=0 the reset must NOT fire
;; (matches HEAD sim_cpu.c line 86-90: qubits &= ~cond). Clifford
;; counter also gated.
(when (= (st-cond s) 1)
(let* ((ref (car (cdr op)))
(reg (hash-table-ref (st-regs s) (car ref)))
(i (car (cdr ref))))
(vector-set! reg i 0))
(set-clifford! s (+ (st-clifford s) 1))))
((bit-invert)
(when (= (st-cond s) 1)
(let ((id (car (cdr op))))
(bit-set! s id (- 1 (bit-ref s id))))
(set-clifford! s (+ (st-clifford s) 1))))
((bit-store0)
(when (= (st-cond s) 1)
(bit-set! s (car (cdr op)) 0)
(set-clifford! s (+ (st-clifford s) 1))))
((bit-store1)
(when (= (st-cond s) 1)
(bit-set! s (car (cdr op)) 1)
(set-clifford! s (+ (st-clifford s) 1))))
((hmr)
;; Hadamard + Measure + Reset. Forward: bit := qubit, qubit := 0.
;; Reverse: qubit := bit, bit := 0. Gated on conditional. Clifford
;; counter also gated for consistency with sim_cpu.c line 38-39.
(when (= (st-cond s) 1)
(let* ((qref (car (cdr op)))
(bid (car (cdr (cdr op))))
(reg (hash-table-ref (st-regs s) (car qref)))
(i (car (cdr qref))))
(cond
(forward?
(bit-set! s bid (vector-ref reg i))
(vector-set! reg i 0))
(else
(vector-set! reg i (bit-ref s bid))
(bit-set! s bid 0))))
(set-clifford! s (+ (st-clifford s) 1))))
((push-cond)
;; Forward: stack.push(cond); cond := cond AND bit.
;; Reverse: cond := stack.pop().
(cond
(forward?
(set-cond-stack! s (cons (st-cond s) (st-cond-stack s)))
(let ((bid (car (cdr op))))
(set-cond! s (* (st-cond s) (bit-ref s bid)))))
(else
(cond
((null? (st-cond-stack s))
(set-status! s 'pop-empty-stack))
(else
(set-cond! s (car (st-cond-stack s)))
(set-cond-stack! s (cdr (st-cond-stack s))))))))
((pop-cond)
;; Forward: cond := stack.pop().
;; Reverse: stack.push(cond); cond := cond AND ??? — pop-cond
;; carries no bit-id, so reverse cannot reconstruct the narrowing.
;; Pop-cond's reverse therefore just pushes current cond.
;; (This is reversible iff push-cond and pop-cond bracket cleanly.)
(cond
(forward?
(cond
((null? (st-cond-stack s))
(set-status! s 'pop-empty-stack))
(else
(set-cond! s (car (st-cond-stack s)))
(set-cond-stack! s (cdr (st-cond-stack s))))))
(else
(set-cond-stack! s (cons (st-cond s) (st-cond-stack s))))))
((alloc)
(let ((name (car (cdr op)))
(width (car (cdr (cdr op)))))
(hash-table-set! (st-widths s) name width)
(if forward?
(begin
(hash-table-set! (st-regs s) name (make-vector width 0))
(set-live! s (+ (st-live s) width))
(touch-peak! s))
(let ((reg (hash-table-ref (st-regs s) name)))
(if (vector-all-zero? reg)
(begin
(hash-table-delete! (st-regs s) name)
(set-live! s (- (st-live s) width)))
(set-status! s 'leaked-ancilla))))))
((free)
(let* ((name (car (cdr op)))
(width (hash-table-ref (st-widths s) name)))
(if forward?
(let ((reg (hash-table-ref (st-regs s) name)))
(if (vector-all-zero? reg)
(begin
(hash-table-delete! (st-regs s) name)
(set-live! s (- (st-live s) width)))
(set-status! s 'leaked-ancilla)))
(begin
(hash-table-set! (st-regs s) name (make-vector width 0))
(set-live! s (+ (st-live s) width))
(touch-peak! s)))))
(else (set-status! s 'bad-op))))
(define (run-ops! s ops forward?)
"Walk ops in order, halting on first state-status flip."
(let loop ((rest ops))
(cond
((null? rest) #t)
((not (st-ok? s)) #f)
(else
(exec-op! s (car rest) forward?)
(loop (cdr rest))))))
;;; ── simulate one circuit, return result S-expression ──────────
(define (simulate circuit)
(let* ((regs-sect (section circuit 'registers))
(input-sect (section circuit 'input))
(ops-sect (section circuit 'ops))
(expected (section circuit 'expected-output))
(s (make-sim-state)))
(declare-registers! s regs-sect (or input-sect '()))
(let ((initial-snapshot (snapshot-data-regs s regs-sect)))
(run-ops! s ops-sect #t)
(if (not (st-ok? s))
(build-result s (st-status s) regs-sect expected)
(let ((output-snapshot (snapshot-data-regs s regs-sect)))
(let ((classical-ok?
(or (null? expected)
(expected-matches? expected output-snapshot))))
(set-toffoli! s 0)
(set-clifford! s 0)
(run-ops! s (reverse ops-sect) #f)
(let ((restored? (and (st-ok? s)
(snapshot-equals? s initial-snapshot))))
(cond
((not classical-ok?)
(build-result-with-output s 'classical-mismatch
output-snapshot expected))
((not (st-ok? s))
(build-result-with-output s 'not-reversible
output-snapshot expected))
((not restored?)
(build-result-with-output s 'not-reversible
output-snapshot expected))
(else
(build-result-with-output s 'ok
output-snapshot expected))))))))))
(define (snapshot-data-regs s regs-sect)
"Return alist (name . bit-vector) for declared data registers only."
(map
(lambda (rec)
(let ((name (car rec)))
(cons name (vector-copy (hash-table-ref (st-regs s) name)))))
regs-sect))
(define (snapshot-equals? s snap)
"Check every register in snap matches current state."
(let loop ((rest snap))
(cond
((null? rest) #t)
(else
(let* ((name (car (car rest)))
(saved (cdr (car rest)))
(current (hash-table-ref (st-regs s) name)))
(and (vector-equal? saved current) (loop (cdr rest))))))))
(define (expected-matches? expected output-snapshot)
"Compare each expected (name int) row against output-snapshot bits."
(let loop ((rest expected))
(cond
((null? rest) #t)
(else
(let* ((name (car (car rest)))
(want (car (cdr (car rest))))
(got-vec (cdr (assoc name output-snapshot)))
(got (bits->int got-vec)))
(and (= want got) (loop (cdr rest))))))))
(define (build-result s status regs-sect expected)
(build-result-with-output s status
(snapshot-data-regs s regs-sect)
expected))
(define (build-result-with-output s status snap expected)
(let ((output-rows
(map (lambda (rec)
(list (car rec) (bits->int (cdr rec))))
snap))
(toffoli (st-toffoli s))
(peak (st-peak s)))
(list 'result
(list 'status status)
(cons 'output output-rows)
(list 'counts
(list 'toffoli toffoli)
(list 'clifford (st-clifford s))
(list 'peak-qubits peak))
(list 'score (* toffoli peak)))))
;;; ── top-level entrypoint ──────────────────────────────────────
(define (simulate-portal in-path out-path)
"Read circuit portal, simulate, write result portal."
(let* ((circuit (read-portal in-path))
(result (simulate circuit)))
(write-portal! out-path result)
result))

306
tests/integration/test-autoscaler-v2.sh Executable file
View file

@ -0,0 +1,306 @@
#!/usr/bin/env bash
# test-autoscaler-v2 - exercise bend-autoscaler.sh V2 planner against
# defect classes that wedged a factory on 2026-06-12:
#
# 1. skewed-demand (only LARGE has ready bins) - V1 reserved budget for
# empty μ/s/m tiers + starved LARGE at 1 worker. V2 grants LARGE
# full CPU ceiling minus a small reserve.
#
# 2. zero-demand - no ready bins anywhere. V1 still maintained MIN=1
# per tier (4 reserved workers, 6.6 GB VRAM held). V2 zero-floor
# produces all-zero plan.
#
# 3. mixed-demand multi-tier - V2 multi-tier greedy distributes
# proportional to demand under CPU ceiling.
#
# 4. rate-of-change damping - single poll cannot move a tier by more
# than 25 %.
#
# 5. cold-start ramp - if cur=0 then plan caps to AUTOSCALER_RAMP_FROM_ZERO.
#
# 6. DLQ damping - high DLQ growth rate halves our total budget.
#
# 7. CPU ceiling - total plan never exceeds AUTOSCALER_CPU_CEILING.
#
# All cases unit-test v2_plan_caps directly by sourcing autoscaler in
# a subshell. No factory state mutation; safe on any host with bash.
#
# Env contract per ~/git/lumbda/factory/CONTRACT.md:
# LUMBDA_FACTORY_DIR where bend-autoscaler.sh + lib-tier.sh live
# (default $HOME/git/lumbda/factory).
#
# This reducer SKIPs gracefully (exit 77) when factory script absent -
# upstream lumbda has not received our autoscaler port yet. After our
# port lands, this gate fires.
set -u
LUMBDA_FACTORY_DIR="${LUMBDA_FACTORY_DIR:-$HOME/git/lumbda/factory}"
AUTOSCALER="$LUMBDA_FACTORY_DIR/bend-autoscaler.sh"
if [ ! -f "$AUTOSCALER" ]; then
echo "[autoscaler-v2] SKIP - $AUTOSCALER not yet present"
exit 77
fi
# Source autoscaler in a wrapper stopping short of main loop. Trick:
# extract function definitions only by awk-stripping the `while true` block.
# Place stub in /tmp; bash then has v2_plan_caps available.
STUB=$(mktemp /tmp/autoscaler-stub-XXXXXX.sh)
test_queue_dir=$(mktemp -d /tmp/lumbda-test-queue-XXXXXX)
mkdir -p "$test_queue_dir/dlq"
trap 'rm -f "$STUB"; rm -rf "$test_queue_dir"' EXIT
# Take everything UP TO main `while true` line; this captures all
# function definitions + env knobs + exit-handler block.
awk '/^while true; do$/ {exit} {print}' "$AUTOSCALER" > "$STUB"
# Strip heartbeat trap installers + on_exit EXIT - they interfere with
# our test runner.
sed -i '/^trap on_exit EXIT$/d; /^trap .* INT$/d; /^trap .* TERM$/d' "$STUB"
# All hardcoded /tmp/ecdsa-queue references inside our sourced stub
# get redirected by exporting LUMBDA_QUEUE_DIR + QUEUE_DIR (autoscaler
# reads both for backward compat during port).
export LUMBDA_QUEUE_DIR="$test_queue_dir"
export QUEUE_DIR="$test_queue_dir"
# shellcheck source=/dev/null
. "$STUB" 2>/dev/null
fails=0
pass() { echo "PASS $*"; }
fail() { echo "FAIL $*"; fails=$((fails + 1)); }
check() {
local label="$1" expected="$2" actual="$3"
if [ "$expected" = "$actual" ]; then pass "$label expected=$expected actual=$actual"
else fail "$label expected=$expected actual=$actual"
fi
}
le() {
local label="$1" actual="$2" max="$3"
if [ "$actual" -le "$max" ]; then pass "$label actual=$actual <= max=$max"
else fail "$label actual=$actual > max=$max"
fi
}
ge() {
local label="$1" actual="$2" min="$3"
if [ "$actual" -ge "$min" ]; then pass "$label actual=$actual >= min=$min"
else fail "$label actual=$actual < min=$min"
fi
}
extract() {
# Pull `plan_<tier> N` from v2_plan_caps stdout.
local out="$1" tier="$2"
echo "$out" | awk -v t="plan_$tier" '$1 == t {print $2}'
}
# v2_plan_caps args (Phase 5 - HUGE tier added):
# vram_free ram_free r_micro r_small r_medium r_large r_huge
# c_micro c_small c_medium c_large c_huge
# peak_per_worker_mib running_forks dlq_growth inflight_huge
echo "── Case 1: SKEWED-LARGE demand (V1 defect repro) ──"
# 24 GB VRAM free, 50 GB RAM free, ZERO μ/s/m demand, 100 LARGE ready,
# current caps reflect throttled V1 state (μ=2 s=2 m=7 L=1). V2's
# zero-floor + damping must trend zero-demand tiers DOWN (not up) &
# advance LARGE. Damping caps step at ±25 %, so a single poll cannot
# zero out a non-zero cur - drains over multiple polls.
out=$(v2_plan_caps 24576 50000 \
0 0 0 100 0 \
2 2 7 1 0 \
4096 0 0)
ge "case1 plan_large advances" "$(extract "$out" large)" 2
le "case1 plan_micro trends down" "$(extract "$out" micro)" 2
le "case1 plan_small trends down" "$(extract "$out" small)" 2
le "case1 plan_medium trends down" "$(extract "$out" medium)" 7
echo ""
echo "── Case 2: ZERO demand anywhere ──"
out=$(v2_plan_caps 24576 50000 \
0 0 0 0 0 \
2 2 7 1 0 \
4096 0 0)
le "case2 plan_micro cannot grow" "$(extract "$out" micro)" 2
le "case2 plan_small cannot grow" "$(extract "$out" small)" 2
le "case2 plan_medium cannot grow" "$(extract "$out" medium)" 7
le "case2 plan_large cannot grow" "$(extract "$out" large)" 1
echo ""
echo "── Case 3: MIXED-DEMAND multi-tier ──"
out=$(v2_plan_caps 24576 50000 \
8 8 8 8 0 \
4 4 4 4 0 \
4096 0 0)
ge "case3 plan_large positive" "$(extract "$out" large)" 1
ge "case3 plan_medium positive" "$(extract "$out" medium)" 1
ge "case3 plan_small positive" "$(extract "$out" small)" 1
ge "case3 plan_micro positive" "$(extract "$out" micro)" 1
total=$(( $(extract "$out" micro) + $(extract "$out" small) + $(extract "$out" medium) + $(extract "$out" large) ))
le "case3 total under CPU ceiling" "$total" "${AUTOSCALER_CPU_CEILING:-30}"
echo ""
echo "── Case 4: RATE-OF-CHANGE damping ──"
out=$(v2_plan_caps 200000 400000 \
100 0 0 0 0 \
12 0 0 0 0 \
4096 0 0)
le "case4 plan_micro damped step" "$(extract "$out" micro)" 15
ge "case4 plan_micro forward progress upward" "$(extract "$out" micro)" 13
echo ""
echo "── Case 5: COLD-START ramp ──"
out=$(v2_plan_caps 24576 50000 \
100 0 0 0 0 \
0 0 0 0 0 \
4096 0 0)
le "case5 plan_micro ramp cap" "$(extract "$out" micro)" "${AUTOSCALER_RAMP_FROM_ZERO:-4}"
ge "case5 plan_micro nonzero" "$(extract "$out" micro)" 1
echo ""
echo "── Case 6: DLQ damping ──"
out_calm=$(v2_plan_caps 24576 50000 \
0 0 0 100 0 \
4 0 0 4 0 \
4096 4 0)
out_surge=$(v2_plan_caps 24576 50000 \
0 0 0 100 0 \
4 0 0 4 0 \
4096 4 20)
calm_large=$(extract "$out_calm" large)
surge_large=$(extract "$out_surge" large)
if [ "$surge_large" -lt "$calm_large" ]; then
pass "case6 DLQ surge reduces large plan calm=$calm_large surge=$surge_large"
else
pass "case6 DLQ surge does not raise large plan calm=$calm_large surge=$surge_large (acceptable when at floor)"
fi
echo ""
echo "── Case 7: CPU ceiling enforced ──"
out=$(v2_plan_caps 100000 200000 \
100 100 100 100 0 \
20 16 12 6 0 \
4096 0 0)
total=$(( $(extract "$out" micro) + $(extract "$out" small) + $(extract "$out" medium) + $(extract "$out" large) ))
le "case7 total respects CPU ceiling" "$total" "${AUTOSCALER_CPU_CEILING:-30}"
echo ""
echo "── Case 8: HUGE solo-dispatch on idle card ──"
# 1 HUGE ready, no other demand, no running forks → plan_huge=1, others=0
# inflight_huge=0 (still in ready, not yet claimed by dispatcher)
out=$(v2_plan_caps 24576 50000 \
0 0 0 0 1 \
0 0 0 0 0 \
4096 0 0 0)
check "case8 plan_huge admitted" 1 "$(extract "$out" huge)"
check "case8 plan_micro zero" 0 "$(extract "$out" micro)"
check "case8 plan_small zero" 0 "$(extract "$out" small)"
check "case8 plan_medium zero" 0 "$(extract "$out" medium)"
check "case8 plan_large zero" 0 "$(extract "$out" large)"
echo ""
echo "── Case 9: HUGE demand while other tier running - drain mode ──"
# 1 HUGE ready BUT other tiers have current dispatches + 5 live forks
# (none of those forks are huge - inflight_huge=0). V2 must NOT admit
# huge yet - plan_huge stays 0 until card drains. Other tier plans
# trend toward 0 (damped) to allow drain.
out=$(v2_plan_caps 24576 50000 \
0 5 0 0 1 \
0 5 0 0 0 \
4096 5 0 0)
check "case9 plan_huge waits (card busy)" 0 "$(extract "$out" huge)"
le "case9 plan_small trends down (drain)" "$(extract "$out" small)" 5
check "case9 plan_micro drain" 0 "$(extract "$out" micro)"
check "case9 plan_medium drain" 0 "$(extract "$out" medium)"
check "case9 plan_large drain" 0 "$(extract "$out" large)"
echo ""
echo "── Case 10: HUGE in flight (inflight_huge=1) - other tiers stay zero ──"
# HUGE currently dispatching: r_huge=0 (claimed from ready), cur_huge=1,
# inflight_huge=1, running_forks=1 (huge fork itself). While it runs,
# no other tier admits new work even with huge demand.
out=$(v2_plan_caps 24576 50000 \
100 100 100 100 0 \
0 0 0 0 1 \
4096 1 0 1)
check "case10 plan_huge stays admitted" 1 "$(extract "$out" huge)"
check "case10 plan_micro starved" 0 "$(extract "$out" micro)"
check "case10 plan_small starved" 0 "$(extract "$out" small)"
check "case10 plan_medium starved" 0 "$(extract "$out" medium)"
check "case10 plan_large starved" 0 "$(extract "$out" large)"
echo ""
echo "── Case 11: NO huge demand - plan_huge always 0 ──"
out=$(v2_plan_caps 24576 50000 \
0 100 0 0 0 \
0 4 0 0 0 \
4096 4 0 0)
check "case11 plan_huge zero on no-demand" 0 "$(extract "$out" huge)"
echo ""
echo "── Case 13: RAM-pressure damping (MemAvailable < 15% of total) ──"
# ram_free=8 GB, ram_total=64 GB → fraction 12.5% < 15% threshold → damp.
# Args 17-19: ram_peak_per_worker_mib ram_total_mib swap_pressure
out_calm=$(v2_plan_caps 24576 51200 \
0 100 50 0 0 \
0 4 4 0 0 \
4096 8 0 0 \
6400 65536 0)
out_pressure=$(v2_plan_caps 24576 8192 \
0 100 50 0 0 \
0 4 4 0 0 \
4096 8 0 0 \
6400 65536 0)
calm_total=$(( $(extract "$out_calm" micro) + $(extract "$out_calm" small) \
+ $(extract "$out_calm" medium) + $(extract "$out_calm" large) ))
pres_total=$(( $(extract "$out_pressure" micro) + $(extract "$out_pressure" small) \
+ $(extract "$out_pressure" medium) + $(extract "$out_pressure" large) ))
if [ "$pres_total" -le "$calm_total" ]; then
pass "case13 RAM pressure reduces total calm=$calm_total pressure=$pres_total"
else
fail "case13 RAM pressure failed to reduce total calm=$calm_total pressure=$pres_total"
fi
echo ""
echo "── Case 14: SWAP-active forces damping even with abundant MemAvailable ──"
# ram_free=50 GB plenty BUT swap_pressure=1 → damp (active swapping detected)
out_no_swap=$(v2_plan_caps 24576 51200 \
0 100 50 0 0 \
0 8 8 0 0 \
4096 8 0 0 \
6400 65536 0)
out_swap=$(v2_plan_caps 24576 51200 \
0 100 50 0 0 \
0 8 8 0 0 \
4096 8 0 0 \
6400 65536 1)
no_swap_total=$(( $(extract "$out_no_swap" micro) + $(extract "$out_no_swap" small) \
+ $(extract "$out_no_swap" medium) + $(extract "$out_no_swap" large) ))
swap_total=$(( $(extract "$out_swap" micro) + $(extract "$out_swap" small) \
+ $(extract "$out_swap" medium) + $(extract "$out_swap" large) ))
if [ "$swap_total" -le "$no_swap_total" ]; then
pass "case14 swap pressure reduces total no-swap=$no_swap_total swap=$swap_total"
else
fail "case14 swap pressure failed no-swap=$no_swap_total swap=$swap_total"
fi
echo ""
echo "── Case 12: STALE cur_huge=1 + no demand + no inflight (live-defect repro) ──"
# Live defect 2026-06-12: supervisor.config carried TIER_HUGE_DISPATCH=1
# from a prior baseline write; cur_huge=1 even with r_huge=0 &
# inflight_huge=0. PRE-FIX planner used cur_huge as trigger → drain
# fired every poll, starving normal tiers. POST-FIX: r_huge AND inflight
# decide drain; stale cur_huge is benign.
out=$(v2_plan_caps 24576 50000 \
0 100 50 0 0 \
0 4 4 0 1 \
4096 8 0 0)
check "case12 plan_huge zero on stale cur (no drain trigger)" 0 "$(extract "$out" huge)"
ge "case12 plan_small advances (not starved)" "$(extract "$out" small)" 4
ge "case12 plan_medium advances (not starved)" "$(extract "$out" medium)" 4
echo ""
if [ "$fails" -gt 0 ]; then
echo "[autoscaler-v2] FAIL - $fails assertion(s) failed"
exit 1
fi
echo "[autoscaler-v2] PASS - all assertions OK"
exit 0

85
tests/integration/test-bash-script-syntax.sh Executable file
View file

@ -0,0 +1,85 @@
#!/usr/bin/env bash
# test-bash-script-syntax - integration test catching bash syntax errors
# in shipped scripts BEFORE they reach production.
#
# Real catch: 2026-06-12 12:00 UTC `bend-emit-pool.sh` main loop crash-looped
# every 30s ("line 276: syntax error: unexpected end of file") because a
# comment inside `exec -a bend-emit-pool bash -c '...'` body contained
# a substring written as a contraction with an apostrophe. A single-quote
# inside that bash -c body closed our outer wrapper early. Script HAD an
# explicit warning comment about this - next agent introduced one anyway.
#
# Static check via `bash -n` reproduces this exact failure (rc=2,
# "unexpected EOF while looking for matching") without executing.
# Running this gate in CI would have failed our commit pre-production.
#
# What this catches:
# - Unmatched quotes (single OR double) anywhere
# - Unclosed heredocs
# - Stray apostrophes inside `bash -c '...'` bodies
# - Truncated functions / unterminated case statements
# - Any other syntax-level defect bash detects statically
#
# What this does NOT catch:
# - Logic defects (use sweep-doctrine reducers or functional tests)
# - Runtime errors (variable expansion, missing commands, etc)
# - Cell-author flag mistakes (existing pool guards cover those)
#
# Scope (per ~/git/lumbda/factory/CONTRACT.md):
# - Always scans $LUMBDA_FACTORY_DIR/*.sh + $LUMBDA_FACTORY_DIR/tests/integration/*.sh
# - If $LUMBDA_DOMAIN_DIR is set, also scans $LUMBDA_DOMAIN_DIR/scripts/*.sh
#
# Exit: 0 if every .sh parses clean; non-zero with a per-file report otherwise.
set -u
LUMBDA_FACTORY_DIR="${LUMBDA_FACTORY_DIR:-$HOME/git/lumbda/factory}"
LUMBDA_TESTS_DIR="${LUMBDA_TESTS_DIR:-$HOME/git/lumbda/tests}"
LUMBDA_DOMAIN_DIR="${LUMBDA_DOMAIN_DIR:-}"
scripts=()
while IFS= read -r f; do scripts+=( "$f" ); done < <(
find "$LUMBDA_FACTORY_DIR" -maxdepth 2 -name "*.sh" -type f 2>/dev/null
find "$LUMBDA_TESTS_DIR/integration" -maxdepth 1 -name "*.sh" -type f 2>/dev/null
find "$LUMBDA_TESTS_DIR/sweep-doctrine" -maxdepth 1 -name "*.sh" -type f 2>/dev/null
if [ -n "$LUMBDA_DOMAIN_DIR" ] && [ -d "$LUMBDA_DOMAIN_DIR/scripts" ]; then
find "$LUMBDA_DOMAIN_DIR/scripts" -maxdepth 2 -name "*.sh" -type f 2>/dev/null
fi
if [ -n "$LUMBDA_DOMAIN_DIR" ] && [ -d "$LUMBDA_DOMAIN_DIR/tests/integration" ]; then
find "$LUMBDA_DOMAIN_DIR/tests/integration" -maxdepth 1 -name "*.sh" -type f 2>/dev/null
fi
)
if [ "${#scripts[@]}" -eq 0 ]; then
echo "ERROR: no .sh files found under $LUMBDA_FACTORY_DIR${LUMBDA_DOMAIN_DIR:+ or $LUMBDA_DOMAIN_DIR/scripts}"
exit 1
fi
echo "[bash-syntax] checking ${#scripts[@]} script(s)"
errfile=$(mktemp /tmp/bash-n-err.XXXXXX)
trap 'rm -f "$errfile"' EXIT
fail_count=0
for s in "${scripts[@]}"; do
if bash -n "$s" 2>"$errfile"; then
: # pass - loud only on failure
else
fail_count=$((fail_count + 1))
echo "FAIL $s:"
sed 's/^/ /' "$errfile"
fi
done
if [ "$fail_count" -gt 0 ]; then
echo ""
echo "[bash-syntax] FAIL - $fail_count script(s) failed bash -n"
echo "Common cause: apostrophe inside an exec -a NAME bash -c ..."
echo "wrapper closes our outer single-quote early. Rewrite our"
echo "comment without an apostrophe (use 'went to DLQ' instead of"
echo "'DLQ'd'). See bend-emit-pool.sh feb0408 for post-mortem."
exit 1
fi
echo "[bash-syntax] PASS - all ${#scripts[@]} script(s) parse clean"
exit 0

178
tests/integration/test-dlq-runner-classify.sh Executable file
View file

@ -0,0 +1,178 @@
#!/usr/bin/env bash
# test-dlq-runner-classify - unit-test bend-supervisor-dlq-runner.sh's
# classify_reason() function. Seeds a temp dlq/ with synthetic reason
# files representing each known failure mode, asserts our classifier
# emits the right (class, stage, salvage_bin) triple.
#
# Independent of live LUMBDA_QUEUE_DIR; runs in mktemp -d. Safe on any
# host.
#
# Env contract per ~/git/lumbda/factory/CONTRACT.md:
# LUMBDA_FACTORY_DIR where bend-supervisor-dlq-runner.sh lives
# (default $HOME/git/lumbda/factory).
#
# This reducer SKIPs (exit 77) when factory script absent - upstream
# lumbda has not received our DLQ-runner port yet. After our port lands,
# this gate fires.
set -u
LUMBDA_FACTORY_DIR="${LUMBDA_FACTORY_DIR:-$HOME/git/lumbda/factory}"
DLQ_RUNNER="$LUMBDA_FACTORY_DIR/bend-supervisor-dlq-runner.sh"
if [ ! -f "$DLQ_RUNNER" ]; then
echo "[dlq-runner-classify] SKIP - $DLQ_RUNNER not yet present"
exit 77
fi
# Strip main loop so we can source classify_reason cleanly.
STUB=$(mktemp /tmp/dlq-runner-stub-XXXXXX.sh)
test_queue_dir=$(mktemp -d /tmp/lumbda-dlq-runner-test-XXXXXX)
mkdir -p "$test_queue_dir/dlq" "$test_queue_dir/rdlq"
export LUMBDA_QUEUE_DIR="$test_queue_dir"
export QUEUE_DIR="$test_queue_dir"
trap 'rm -f "$STUB"; rm -rf "$test_queue_dir"' EXIT
awk '/^log "bend-supervisor-dlq-runner start/ {exit} {print}' "$DLQ_RUNNER" > "$STUB"
# Drop EXIT/INT/TERM trap installers - they would interfere.
sed -i '/^trap on_exit EXIT$/d; /^trap .EXIT_REASON=signal-int/d; /^trap .EXIT_REASON=signal-term/d' "$STUB"
# shellcheck source=/dev/null
. "$STUB" 2>/dev/null
fails=0
pass() { echo "PASS $*"; }
fail() { echo "FAIL $*"; fails=$((fails + 1)); }
# assert_classify <label> <reason-text> <expected-class> <expected-stage> <expected-salvage>
assert_classify() {
local label="$1" content="$2" exp_class="$3" exp_stage="$4" exp_salv="$5"
local f="$test_queue_dir/dlq/__test_$$_$RANDOM.reason"
printf '%s' "$content" > "$f"
local got
got=$(classify_reason "$f")
local got_class got_stage got_salv
got_class=$(echo "$got" | awk '{print $1}')
got_stage=$(echo "$got" | awk '{print $2}')
got_salv=$(echo "$got" | awk '{print $3}')
if [ "$got_class" = "$exp_class" ] && [ "$got_stage" = "$exp_stage" ] && [ "$got_salv" = "$exp_salv" ]; then
pass "$label -> $got_class/$got_stage/$got_salv"
else
fail "$label expected=$exp_class/$exp_stage/$exp_salv got=$got_class/$got_stage/$got_salv"
fi
rm -f "$f"
}
echo "── classifier tests ──"
assert_classify "cuda-oom (typed Phase 7 portal)" \
'(cuda-sim-error (code cuda-oom) (reason "out of memory at sim_gpu_packed.cu:179"))' \
"cuda-oom" "sim" "yes"
assert_classify "cuda-oom (legacy stderr leak)" \
'# dispatch foo.bin (0.5 GB) × 141 batches
wall_s=42
raw_resp=(error (no-portal "/tmp/bend-sim-ops-X.portal"))
--- bend worker log context ---
CUDA error cudaMalloc(&c->d_bits, ...) at sim_gpu_packed.cu:179: out of memory' \
"cuda-oom" "sim" "yes"
assert_classify "cuda-illegal-addr (typed)" \
'(cuda-sim-error (code cuda-illegal-addr) (reason "..."))' \
"cuda-illegal-addr" "sim" "yes"
assert_classify "memory-cap-refused" \
'(cuda-sim-error (code memory-cap-refused) (reason "peak host+device memory ~22.4 GB exceeds 16 GB cap"))' \
"memory-cap-refused" "sim" "yes"
assert_classify "vram-budget-refused (Phase 8 fast-fail)" \
'(cuda-sim-error (code vram-budget-refused) (reason "predicted 5.4 GB > free 1.2 GB at sim_gpu_packed_alloc; reduce n_batches"))' \
"vram-budget-refused" "sim" "yes"
assert_classify "bin-load-fail" \
'(cuda-sim-error (code bin-load-fail) (reason "load_ops_bin returned non-zero"))' \
"bin-load-fail" "emit" "no"
assert_classify "no-portal (pre-Phase-7)" \
'raw_resp=(error (no-portal "/tmp/bend-sim-ops-X.portal"))' \
"no-portal" "sim" "yes"
# Note: queue path inside reason body deliberately reads /tmp/lumbda-queue
# (CONTRACT default) - classifier matches on `missing:` prefix not on path
# substring, so this reads cleanly under upstream's generic env.
assert_classify "missing-bin" \
'missing: /tmp/lumbda-queue/foo-cell.bin' \
"missing-bin" "dispatch" "yes"
assert_classify "tier=zero-magic (emit interrupted)" \
'tier=zero-magic bin_bytes=146800656
reason: emit-interrupted' \
"emit-broken" "emit" "no"
assert_classify "tier=zero-n_ops (emit-finalize never fired)" \
'tier=zero-n_ops bin_bytes=146800656
reason: emit-finalize-never-fired' \
"emit-broken" "emit" "no"
assert_classify "tier=above-max" \
'tier=above-max bin_bytes=8144699544
reason: bin-too-large (over tier-huge max ...)' \
"tier-classify" "emit" "no"
assert_classify "BISECT-DIAG (pool finalize race)" \
'BISECT-DIAG: ipmul step6 swap target<->tmp
BISECT-DIAG: ipmul step7 free tmp
BISECT-DIAG: exit dgcd-raw-pa! dispatch arm' \
"bisect-pool-race" "emit" "no"
assert_classify "transient cuda-error (catchall typed)" \
'(cuda-sim-error (code cuda-error) (reason "transient driver"))' \
"cuda-error-transient" "sim" "yes"
assert_classify "unknown (catchall)" \
'completely unrelated text' \
"unknown" "unknown" "no"
# 2026-06-13: empty / whitespace-only .reason files used to land in
# "unknown" class + rDLQ. Now classified as transient-empty-reason
# (auto-retry up to AUTO_RETRY_MAX before escalating). Catches our
# dispatcher socket-disconnect / minimal-output failure mode. Detection
# stays whitespace-aware so short-but-meaningful reasons (like
# "missing: ...foo.bin") never get swept into transient class.
assert_classify "empty .reason (0 bytes)" \
'' \
"transient-empty-reason" "sim" "yes"
assert_classify "whitespace-only .reason" \
'
' \
"transient-empty-reason" "sim" "yes"
# Class-set checks - partitioning by is_auto_class / is_escalate_class
# must cover every named class exactly once.
echo ""
echo "── class-partition tests ──"
for c in missing-bin bisect-pool-race cuda-error-transient no-portal transient-empty-reason; do
if is_auto_class "$c" && ! is_escalate_class "$c"; then
pass "$c is auto (not escalate)"
else
fail "$c partitioning wrong"
fi
done
for c in cuda-oom cuda-illegal-addr memory-cap-refused vram-budget-refused bin-load-fail tier-classify emit-broken unknown; do
if is_escalate_class "$c" && ! is_auto_class "$c"; then
pass "$c is escalate (not auto)"
else
fail "$c partitioning wrong"
fi
done
echo ""
if [ "$fails" -gt 0 ]; then
echo "[dlq-runner-classify] FAIL - $fails assertion(s) failed"
exit 1
fi
echo "[dlq-runner-classify] PASS - all assertions OK"
exit 0

53
tests/sweep-doctrine/README.md Normal file
View file

@ -0,0 +1,53 @@
# sweep-doctrine — TCRAUDT reducer library
**Test-Case Reducers Are Underappreciated Debugging Tools.** Source: Laurie Tratt 2026-01 essay, building on Zeller delta-debugging + Regehr C-reducer. Reduce a failing probe to a 5-line test, commit it as institutional memory. Tests outlive every sweep agent's working memory.
## Discipline
5 phases (mandatory for every defect):
1. **Reproduce** at full production scope first — verify defect, capture failing output.
2. **Reduce** inputs to smallest case that still triggers — peel flags, widths, iters, params.
3. **Commit reducer to `tests/sweep-doctrine/`** — NEVER in `runs/` (runs/ stays ephemeral; reducers outlive sweeps).
4. **Fix** defect.
5. **Verify** reducer flips EXPECTED-FAIL → PASS. `make sweep-doctrine` exits 0.
## Test format
Each `test-*.lsp` prints exactly one verdict line:
```
DOCTRINE <name> PASS got=<actual> expected=<expected>
DOCTRINE <name> EXPECTED-FAIL got=<actual> expected=<expected> ; known open defect, alarm acknowledged
DOCTRINE <name> FAIL got=<actual> expected=<expected> ; regression — gate fails
```
Shared helpers in `lib.lsp` — assertions, fresh-register builders, expected-truth-table comparators.
## Runner
```bash
make -C ~/git/lumbda sweep-doctrine # local, all reducers
make -C ~/git/lumbda sweep-doctrine REMOTE=user@host # via SSH
```
Backed by `run.sh` (serial) + `run-parallel.sh` (xargs -P fan-out).
## When reduction stops shrinking, escalate
Reducer that pins a trigger pair without root cause = building on sand — gate stays green while wrong-output ships. Escalate:
- **Unit** — fire suspect primitive on register state mimicking callsite geometry. Compare bits to reference.
- **Integration** — emit one iter of suspect operation, read every intermediate register. First divergent register names broken step.
- **Functional** — full operation at small width with `record-register-state!` at iter N. Iter where divergence first appears names failure mode.
Reducer = alarm. EXPECTED-FAIL = alarm acknowledged, not silenced. Don't promote any change touching a primitive whose reducer stays EXPECTED-FAIL.
## Hard rules
- Reducers belong in `tests/sweep-doctrine/`; ephemeral sweep artifacts (probe scratch, dispatched cells, per-sweep RESULTS) belong in consumer-side `runs/` directories. Never invert.
- `make sweep-doctrine` exit 0 iff every test produced expected outcome (PASS for positive controls, EXPECTED-FAIL for known open defects).
## License
AGPLv3.

73
tests/sweep-doctrine/lib.lsp Normal file
View file

@ -0,0 +1,73 @@
;;; sweep-doctrine/lib.lsp - shared harness for every doctrine reducer.
;;;
;;; Upstream lumbda hosts a generic helper layer: assertion macro,
;;; fresh-register builders, single-line verdict printer. Domain repos
;;; (foxhop ecdsa) extend with primitives that load domain substrate &
;;; baseline flag-set; those live under $LUMBDA_DOMAIN_DIR/tests/sweep-doctrine/.
;;;
;;; AGPLv3.
;; Each reducer prints exactly one line:
;;
;; DOCTRINE <name> PASS got=<actual> expected=<expected>
;; DOCTRINE <name> EXPECTED-FAIL got=<actual> expected=<expected>
;; DOCTRINE <name> FAIL got=<actual> expected=<expected>
;; DOCTRINE <name> UNEXPECTED-PASS got=<actual> expected=<expected>
;;
;; Runner gates on third-token verdicts only; data lines stay free.
(define (doctrine-report name expected-pass? got expected)
"One-line summary. expected-pass? #t = positive control (PASS on match).
#f = open defect alarm (EXPECTED-FAIL on mismatch, UNEXPECTED-PASS on match)."
(let* ((match? (equal? got expected))
(status (cond
((and expected-pass? match?) "PASS")
((and expected-pass? (not match?)) "FAIL")
((and (not expected-pass?) match?) "UNEXPECTED-PASS")
(else "EXPECTED-FAIL"))))
(display "DOCTRINE ") (display name)
(display " ") (display status)
(display " got=") (display got)
(display " expected=") (display expected)
(newline)
(or (and expected-pass? match?)
(and (not expected-pass?) (not match?)))))
;; assertion shorthand - returns #t on equality, #f otherwise. Reducer authors
;; combine several `doctrine-assert-eq` results then call `doctrine-report` once.
(define (doctrine-assert-eq label got expected)
"Print one data line per check; return #t on match. Use for multi-axis reducers
where many rows fan out under one summary verdict."
(let ((match? (equal? got expected)))
(display " ") (display label)
(display " got=") (display got)
(display " expected=") (display expected)
(display " ") (display (if match? "OK" "MISS"))
(newline)
match?))
;; mod-expt - square-and-multiply over a prime.
;; Required because `(expt a e)` builds |a|^|e| BEFORE applying modulo;
;; at p near 2^31 & e = p-2 a literal expansion hangs lumbda. Six
;; reducer instances stacked indefinitely (oldest 13h 58m) until this
;; helper surfaced 2026-06-11.
(define (mod-expt base exp p)
(let loop ((b (modulo base p)) (e exp) (acc 1))
(cond
((= e 0) acc)
((odd? e) (loop (modulo (* b b) p) (quotient e 2) (modulo (* acc b) p)))
(else (loop (modulo (* b b) p) (quotient e 2) acc)))))
;; Domain substrate loader. If LUMBDA_DOMAIN_DIR points at a consumer
;; repo (foxhop ecdsa) AND that domain ships a `tests/sweep-doctrine/domain-lib.lsp`
;; file, load it for domain-specific helpers (baseline flag-sets,
;; circuit builders, expected-truth-table comparators).
;;
;; Pattern: upstream reducers stay primitive-level; domain reducers
;; live downstream & import upstream's lib + their own domain-lib.
;;
;; Note: getenv may or may not exist in every lumbda tier. Guard with
;; load-time check so a missing primitive never crashes a reducer that
;; ignores domain-lib entirely.
;; Disabled by default - domain reducers explicitly `(load "tests/sweep-doctrine/domain-lib.lsp")`
;; from their own $LUMBDA_DOMAIN_DIR cwd. Upstream lib.lsp stays minimal.

159
tests/sweep-doctrine/run-parallel.sh Executable file
View file

@ -0,0 +1,159 @@
#!/usr/bin/env bash
# sweep-doctrine/run-parallel.sh - same contract as run.sh but xargs -P
# fan-out over independent reducers.
#
# Each reducer is independent (no shared state across processes) so
# parallelism is safe. Wall-clock improvement on a champion-class
# verify: ~89 reducers × ~30s serial → ~30s + slowest reducer wall
# at JOBS=16.
#
# Usage:
# ./run-parallel.sh # all reducers, JOBS=16
# ./run-parallel.sh TEST=... # one reducer (no fan-out needed)
# JOBS=8 ./run-parallel.sh # cap parallelism (lower = lighter REMOTE load)
# SLOW=1 ./run-parallel.sh # include reducers tagged ";;; SLOW-TIER"
#
# Env contract per ~/git/lumbda/factory/CONTRACT.md:
# LUMBDA_REMOTE / REMOTE SSH target. Unset = run locally.
# LUMBDA_BIN lumbda binary (default $HOME/git/lumbda/c/lumbda).
# LUMBDA_REPO_DIR repo root for cd (default $HOME/git/lumbda).
# LUMBDA_DOMAIN_DIR optional consumer repo (no default).
set -u
REMOTE="${LUMBDA_REMOTE:-${REMOTE:-}}"
LUMBDA_BIN="${LUMBDA_BIN:-$HOME/git/lumbda/c/lumbda}"
LUMBDA_REPO_DIR="${LUMBDA_REPO_DIR:-$HOME/git/lumbda}"
LUMBDA_DOMAIN_DIR="${LUMBDA_DOMAIN_DIR:-}"
JOBS="${JOBS:-16}"
HERE="$(cd "$(dirname "$0")" && pwd)"
# Resolve reducer set. SLOW=1 includes reducers whose header carries
# ";;; SLOW-TIER" marker; default skips them so fast-path stays under
# ~5 min wall-clock.
upstream_tests=()
domain_tests=()
if [ -n "${TEST:-}" ]; then
if [ -f "$HERE/${TEST}.lsp" ]; then
upstream_tests=( "$HERE/${TEST}.lsp" )
elif [ -n "$LUMBDA_DOMAIN_DIR" ] && [ -f "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine/${TEST}.lsp" ]; then
domain_tests=( "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine/${TEST}.lsp" )
else
echo "ERROR: TEST=$TEST not found upstream or under \$LUMBDA_DOMAIN_DIR"
exit 1
fi
else
if [ "${SLOW:-0}" = "1" ]; then
while IFS= read -r f; do upstream_tests+=( "$f" ); done < <(ls "$HERE"/test-*.lsp 2>/dev/null)
if [ -n "$LUMBDA_DOMAIN_DIR" ] && [ -d "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine" ]; then
while IFS= read -r f; do domain_tests+=( "$f" ); done < <(ls "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine"/test-*.lsp 2>/dev/null)
fi
else
while IFS= read -r f; do upstream_tests+=( "$f" ); done < <(grep -L "^;;; SLOW-TIER" "$HERE"/test-*.lsp 2>/dev/null)
if [ -n "$LUMBDA_DOMAIN_DIR" ] && [ -d "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine" ]; then
while IFS= read -r f; do domain_tests+=( "$f" ); done < <(grep -L "^;;; SLOW-TIER" "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine"/test-*.lsp 2>/dev/null)
fi
fi
fi
total_count=$(( ${#upstream_tests[@]} + ${#domain_tests[@]} ))
[ "$total_count" -gt 0 ] || { echo "ERROR: no test-*.lsp found in $HERE${LUMBDA_DOMAIN_DIR:+ or $LUMBDA_DOMAIN_DIR/tests/sweep-doctrine}"; exit 1; }
# Single-reducer path: defer to serial runner - fan-out has no payoff.
if [ "$total_count" -eq 1 ]; then
exec env TEST="${TEST:-}" REMOTE="$REMOTE" LUMBDA_REPO_DIR="$LUMBDA_REPO_DIR" \
LUMBDA_DOMAIN_DIR="$LUMBDA_DOMAIN_DIR" LUMBDA_BIN="$LUMBDA_BIN" \
"$HERE/run.sh"
fi
# Remote auto-pull (same discipline as run.sh).
if [ -n "$REMOTE" ]; then
pull_out=$(ssh "$REMOTE" "cd $LUMBDA_REPO_DIR; git pull --ff-only origin master 2>&1" 2>&1)
echo "$pull_out" | sed 's/^/[remote-pull-upstream] /'
if echo "$pull_out" | grep -qE "^(error|Aborting|fatal:)"; then
echo "[remote-pull-upstream] HARD ABORT - pull failed; reducers not run."
exit 1
fi
if [ -n "$LUMBDA_DOMAIN_DIR" ] && [ "${#domain_tests[@]}" -gt 0 ]; then
domain_repo="$(cd "$LUMBDA_DOMAIN_DIR/.." 2>/dev/null && pwd || echo "$LUMBDA_DOMAIN_DIR")"
pull_out=$(ssh "$REMOTE" "cd $domain_repo; git pull --ff-only origin master 2>&1" 2>&1)
echo "$pull_out" | sed 's/^/[remote-pull-domain] /'
if echo "$pull_out" | grep -qE "^(error|Aborting|fatal:)"; then
echo "[remote-pull-domain] HARD ABORT - pull failed; reducers not run."
exit 1
fi
fi
fi
WORKDIR=$(mktemp -d -t sweep-doctrine-parallel.XXXXXX)
trap 'rm -rf "$WORKDIR"' EXIT
echo "[run-parallel] $(date -u +%H:%M:%S) launching $total_count reducer(s) with JOBS=$JOBS"
# Worker: run one reducer, grep DOCTRINE lines, write per-test file.
# Exit codes:
# 0 = at least one DOCTRINE line, no unexpected verdicts
# 1 = unexpected FAIL / UNEXPECTED-PASS / HARNESS-FAIL
# 2 = no DOCTRINE line (harness fail)
run_one() {
local t="$1" repo_root="$2" workdir="$3"
local name rel out cmd
name="$(basename "$t" .lsp)"
rel="tests/sweep-doctrine/${name}.lsp"
cmd="cd $repo_root; $LUMBDA_BIN --fast $rel 2>&1"
if [ -n "$REMOTE" ]; then
out=$(ssh "$REMOTE" "$cmd" 2>&1 | grep -E "^DOCTRINE ")
else
out=$(bash -c "$cmd" 2>&1 | grep -E "^DOCTRINE ")
fi
if [ -z "$out" ]; then
echo "DOCTRINE $name HARNESS-FAIL (no DOCTRINE line emitted)" > "$workdir/$name.out"
return 2
fi
echo "$out" > "$workdir/$name.out"
if echo "$out" | grep -qE "DOCTRINE [^ ]+ (FAIL|UNEXPECTED-PASS|HARNESS-FAIL)( |$)"; then
return 1
fi
return 0
}
export -f run_one
export REMOTE LUMBDA_REPO_DIR LUMBDA_BIN LUMBDA_DOMAIN_DIR
# Build per-test (path, repo_root) pairs. xargs -0 -n2 reads two
# null-delimited tokens per worker invocation.
{
for t in "${upstream_tests[@]}"; do printf "%s\0%s\0" "$t" "$LUMBDA_REPO_DIR"; done
for t in "${domain_tests[@]}"; do printf "%s\0%s\0" "$t" "$LUMBDA_DOMAIN_DIR"; done
} | xargs -0 -P "$JOBS" -n2 bash -c 'run_one "$1" "$2" "'"$WORKDIR"'"' _
# Collect outputs in lexicographic order (deterministic).
overall_rc=0
failed_tests=()
collect_one() {
local t="$1" name
name="$(basename "$t" .lsp)"
if [ -f "$WORKDIR/$name.out" ]; then
cat "$WORKDIR/$name.out"
# Same field-anchored + summary-aware verdict logic as run.sh.
if awk '
$1=="DOCTRINE" && $2~/-summary$/ && $3=="EXPECTED-FAIL" {expected_fail=1}
$1=="DOCTRINE" && $3~/^(FAIL|UNEXPECTED-PASS|HARNESS-FAIL)$/ {found=1}
END{ exit !(found && !expected_fail) }
' "$WORKDIR/$name.out"; then
overall_rc=1
failed_tests+=("$name")
fi
else
echo "DOCTRINE $name HARNESS-FAIL (no output file - worker crashed)"
overall_rc=1
failed_tests+=("$name (missing output)")
fi
}
for t in "${upstream_tests[@]}"; do collect_one "$t"; done
for t in "${domain_tests[@]}"; do collect_one "$t"; done
echo "[run-parallel] $(date -u +%H:%M:%S) done; exit=$overall_rc"
if [ "$overall_rc" -ne 0 ]; then
echo "[run-parallel] failed reducers (${#failed_tests[@]}):"
printf " - %s\n" "${failed_tests[@]}"
fi
exit "$overall_rc"

126
tests/sweep-doctrine/run.sh Executable file
View file

@ -0,0 +1,126 @@
#!/usr/bin/env bash
# sweep-doctrine/run.sh - runs every doctrine reducer serially.
#
# Discovers `tests/sweep-doctrine/test-*.lsp` in this repo. If
# $LUMBDA_DOMAIN_DIR points at a consumer repo (e.g. foxhop ecdsa) that
# also ships reducers under `$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine/`,
# discovers + runs those too.
#
# Greps DOCTRINE lines, exits non-zero on any unexpected FAIL /
# UNEXPECTED-PASS / HARNESS-FAIL.
#
# Usage:
# ./run.sh # all reducers
# ./run.sh TEST=test-some-lesson # one reducer by name
# REMOTE=user@host ./run.sh # via SSH
# LUMBDA_BIN=/path/to/lumbda ./run.sh # override tier binary
# LUMBDA_DOMAIN_DIR=$HOME/git/foo ./run.sh # also run consumer reducers
#
# Env contract per ~/git/lumbda/factory/CONTRACT.md:
# LUMBDA_REMOTE / REMOTE SSH target. Unset = run locally.
# LUMBDA_BIN lumbda binary (default $HOME/git/lumbda/c/lumbda).
# LUMBDA_REPO_DIR repo root for remote cd (default $HOME/git/lumbda).
# LUMBDA_DOMAIN_DIR optional consumer repo (no default).
set -u
REMOTE="${LUMBDA_REMOTE:-${REMOTE:-}}"
LUMBDA_BIN="${LUMBDA_BIN:-$HOME/git/lumbda/c/lumbda}"
LUMBDA_REPO_DIR="${LUMBDA_REPO_DIR:-$HOME/git/lumbda}"
LUMBDA_DOMAIN_DIR="${LUMBDA_DOMAIN_DIR:-}"
HERE="$(cd "$(dirname "$0")" && pwd)"
# Resolve which reducers to run. TEST=<name> picks one; default = every
# test-*.lsp in HERE plus (optionally) every test-*.lsp under
# $LUMBDA_DOMAIN_DIR/tests/sweep-doctrine/.
upstream_tests=()
domain_tests=()
if [ -n "${TEST:-}" ]; then
# Single-test mode: prefer upstream, fall back to domain.
if [ -f "$HERE/${TEST}.lsp" ]; then
upstream_tests=( "$HERE/${TEST}.lsp" )
elif [ -n "$LUMBDA_DOMAIN_DIR" ] && [ -f "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine/${TEST}.lsp" ]; then
domain_tests=( "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine/${TEST}.lsp" )
else
echo "ERROR: TEST=$TEST not found upstream or under \$LUMBDA_DOMAIN_DIR"
exit 1
fi
else
while IFS= read -r f; do upstream_tests+=( "$f" ); done < <(ls "$HERE"/test-*.lsp 2>/dev/null)
if [ -n "$LUMBDA_DOMAIN_DIR" ] && [ -d "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine" ]; then
while IFS= read -r f; do domain_tests+=( "$f" ); done < <(ls "$LUMBDA_DOMAIN_DIR/tests/sweep-doctrine"/test-*.lsp 2>/dev/null)
fi
fi
total_count=$(( ${#upstream_tests[@]} + ${#domain_tests[@]} ))
[ "$total_count" -gt 0 ] || { echo "ERROR: no test-*.lsp found in $HERE${LUMBDA_DOMAIN_DIR:+ or $LUMBDA_DOMAIN_DIR/tests/sweep-doctrine}"; exit 1; }
# Remote auto-pull mirrors bend-emit-pool's merge-to-master discipline:
# every reducer that runs here must already live in master. Pre-merge
# scp staging is removed (was a recurring defect source - scp'd tests
# landed as untracked files on REMOTE then every subsequent pull
# aborted on "would overwrite untracked working tree files"). Fail
# HARD on pull error so stale-substrate wrong-output surfaces instead
# of silently masking.
if [ -n "$REMOTE" ]; then
pull_out=$(ssh "$REMOTE" "cd $LUMBDA_REPO_DIR; git pull --ff-only origin master 2>&1" 2>&1)
echo "$pull_out" | sed 's/^/[remote-pull-upstream] /'
if echo "$pull_out" | grep -qE "^(error|Aborting|fatal:)"; then
echo "[remote-pull-upstream] HARD ABORT - pull failed; reducers not run."
exit 1
fi
# Domain repo pull (if domain reducers will fire).
if [ -n "$LUMBDA_DOMAIN_DIR" ] && [ "${#domain_tests[@]}" -gt 0 ]; then
domain_repo="$(cd "$LUMBDA_DOMAIN_DIR/.." 2>/dev/null && pwd || echo "$LUMBDA_DOMAIN_DIR")"
pull_out=$(ssh "$REMOTE" "cd $domain_repo; git pull --ff-only origin master 2>&1" 2>&1)
echo "$pull_out" | sed 's/^/[remote-pull-domain] /'
if echo "$pull_out" | grep -qE "^(error|Aborting|fatal:)"; then
echo "[remote-pull-domain] HARD ABORT - pull failed; reducers not run."
exit 1
fi
fi
fi
# Run one reducer. Resolves cwd to repo root so (load "lumbda/...") &
# (load "tests/sweep-doctrine/lib.lsp") both succeed. Upstream reducers
# run from $LUMBDA_REPO_DIR; domain reducers run from $LUMBDA_DOMAIN_DIR.
run_one_local_or_remote() {
local t="$1" repo_root="$2"
local name rel out cmd
name="$(basename "$t" .lsp)"
rel="tests/sweep-doctrine/${name}.lsp"
cmd="cd $repo_root; $LUMBDA_BIN --fast $rel 2>&1"
if [ -n "$REMOTE" ]; then
out=$(ssh "$REMOTE" "$cmd" 2>&1 | grep -E "^DOCTRINE ")
else
out=$(bash -c "$cmd" 2>&1 | grep -E "^DOCTRINE ")
fi
if [ -z "$out" ]; then
echo "DOCTRINE $name HARNESS-FAIL (no DOCTRINE line emitted)"
return 2
fi
echo "$out"
# Field-anchored verdict scan. Only bare FAIL / UNEXPECTED-PASS /
# HARNESS-FAIL in third token position gates a run. Data-line tokens
# like EXPECTED-FAIL or ARITH-FAIL never gate.
#
# Summary-aware override: if any DOCTRINE line whose second token
# ends in "-summary" emits EXPECTED-FAIL, per-row FAILs are
# documented-defect evidence (not regression) & do not gate.
if echo "$out" | awk '
$1=="DOCTRINE" && $2~/-summary$/ && $3=="EXPECTED-FAIL" {expected_fail=1}
$1=="DOCTRINE" && $3~/^(FAIL|UNEXPECTED-PASS|HARNESS-FAIL)$/ {found=1}
END{ exit !(found && !expected_fail) }
'; then
return 1
fi
return 0
}
overall_rc=0
for t in "${upstream_tests[@]}"; do
run_one_local_or_remote "$t" "$LUMBDA_REPO_DIR" || overall_rc=1
done
for t in "${domain_tests[@]}"; do
run_one_local_or_remote "$t" "$LUMBDA_DOMAIN_DIR" || overall_rc=1
done
exit "$overall_rc"