Sync from GitHub at 25c8330: hardware-in-the-loop rig, SAM D21 board, guard elimination on RV32/Cortex-M3

.github/workflows/hardware.yml

@@ -0,0 +1,33 @@
+name: hardware
+# Runs every Forth example on real boards attached to a self-hosted runner (docs/HIL.md) and
+# checks each board's serial transcript against the Lean semantics. A self-hosted runner must
+# never run code from pull requests, so it never runs on them.
+#
+# For now it runs only when started from the Actions tab, so pushes do not queue a job that no
+# machine can take. Once the rig is registered (docs/HIL.md, step 5), add
+#   push:
+#     branches: [master]
+# under `on:` to check every change to master on the boards.
+on:
+  workflow_dispatch:
+jobs:
+  samd21:
+    runs-on: [self-hosted, linux, samd21]
+    env:
+      HIL_TTY: ${{ vars.SAMD21_TTY }}
+      HIL_ADAPTER_SERIAL: ${{ vars.SAMD21_ADAPTER_SERIAL }}
+    steps:
+      - uses: actions/checkout@v4
+      - name: Make lake available
+        run: |
+          if [ ! -x "$HOME/.elan/bin/lake" ]; then
+            curl -sSfL https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -o elan-init.sh
+            sh elan-init.sh -y --default-toolchain none
+          fi
+          echo "$HOME/.elan/bin" >> "$GITHUB_PATH"
+      - name: Build cm0c
+        run: lake build cm0c
+      - name: Every example on the SAM D21 Curiosity Nano
+        run: |
+          [ -n "$HIL_TTY" ] || { echo "set the repository variable SAMD21_TTY (docs/HIL.md)"; exit 1; }
+          scripts/hil/run-all.sh samd21-cnano "$HIL_TTY"

.github/workflows/lean.yml

@@ -33,7 +33,7 @@ jobs:
       - name: Forth source files (WebAssembly)
         run: for f in examples/forth/*.fs; do .lake/build/bin/wasmw forth "$f" || exit 1; done
       - name: Install AArch64/RISC-V toolchain and emulators (user mode, the bare RV32 board and the Cortex-M boards)
-        run: sudo apt-get update && sudo apt-get install -y clang lld qemu-user qemu-system-misc qemu-system-arm
+        run: sudo apt-get update && sudo apt-get install -y clang lld llvm qemu-user qemu-system-misc qemu-system-arm
       - name: AArch64 execution check (qemu)
         run: .lake/build/bin/a64c check 300
       - name: Forth source files (AArch64)
@@ -54,3 +54,34 @@ jobs:
         run: .lake/build/bin/cm0c check 300
       - name: Forth source files (Cortex-M0, 32-bit words)
         run: for f in examples/forth/*.fs; do .lake/build/bin/cm0c forth "$f" || exit 1; done
+      - name: Without the depth certificates (--no-opt keeps every guard)
+        run: |
+          for t in cm0c cmc rv32c; do
+            for f in examples/forth/*.fs; do .lake/build/bin/$t forth "$f" --no-opt || exit 1; done
+          done
+      - name: Guard elimination shrinks the microcontroller code
+        run: |
+          mkdir -p /tmp/size && cd /tmp/size
+          for spec in cm0c:thumbv6m-none-eabi:-mcpu=cortex-m0 cmc:thumbv7m-none-eabi:-mcpu=cortex-m3 rv32c:riscv32-unknown-elf:-march=rv32im; do
+            t=${spec%%:*}; rest=${spec#*:}; tgt=${rest%%:*}; fl=${rest#*:}
+            for f in $GITHUB_WORKSPACE/examples/forth/*.fs; do
+              n=$(basename "$f" .fs)
+              $GITHUB_WORKSPACE/.lake/build/bin/$t emit-forth "$f" > "$t-$n-opt.s"
+              $GITHUB_WORKSPACE/.lake/build/bin/$t emit-forth "$f" --no-opt > "$t-$n-all.s"
+              for v in opt all; do clang --target=$tgt $fl -c -o "$t-$n-$v.o" "$t-$n-$v.s" || exit 1; done
+              a=$(llvm-size "$t-$n-all.o" | awk 'NR==2{print $1}'); b=$(llvm-size "$t-$n-opt.o" | awk 'NR==2{print $1}')
+              echo "$t $n: $a -> $b bytes of code"
+              [ "$b" -le "$a" ] || exit 1
+            done
+          done
+      - name: Board images (image, run on the emulated boards, verify the serial log)
+        run: |
+          mkdir -p /tmp/board && cd /tmp/board
+          # Microchip SAM D21 Curiosity Nano: not emulated; build every example's image (it must
+          # assemble, link into 128 KiB of flash and convert to Intel HEX)
+          for f in $GITHUB_WORKSPACE/examples/forth/*.fs; do $GITHUB_WORKSPACE/.lake/build/bin/cm0c image "$f" --board samd21-cnano || exit 1; done
+          for t in cm0c cmc; do $GITHUB_WORKSPACE/.lake/build/bin/$t image $GITHUB_WORKSPACE/examples/forth/fib.fs || exit 1; done
+          (timeout 10 qemu-system-arm -M microbit -kernel fib-microbit-v1.elf -display none -serial stdio -monitor none || true) > v1.log
+          (timeout 10 qemu-system-arm -M lm3s6965evb -kernel fib.elf -display none -serial stdio -monitor none || true) > lm3s.log
+          $GITHUB_WORKSPACE/.lake/build/bin/cm0c verify $GITHUB_WORKSPACE/examples/forth/fib.fs v1.log
+          $GITHUB_WORKSPACE/.lake/build/bin/cmc verify $GITHUB_WORKSPACE/examples/forth/fib.fs lm3s.log

CHANGELOG.md

@@ -0,0 +1,59 @@
+# Changelog
+
+All notable changes to UniversalWord. The version is the one in `lakefile.toml`.
+
+## 0.1.0 — unreleased
+
+The first release. Everything below is proved in Lean 4 (`leanprover/lean4:v4.34.1`) using only
+the standard axioms `propext`, `Quot.sound` and `Classical.choice`, which `formal/Audit.lean`
+checks in CI, or, for the agreement of the models with real tools and machines, tested by
+execution in CI.
+
+### The Universal Word IR (`formal/`)
+
+- Word-level machine semantics: words, memory, the instruction set, traps, the data, return and
+  auxiliary stacks, execution relations and a fuel-bounded interpreter proved sound and complete
+  against them (#4, #17).
+- Checked stack-depth certificates (`WordDialect/Depth.lean`): lower bounds (`certOk`), upper
+  bounds against a capacity (`boundOk`), and per-word frame certificates that track each word's
+  net stack effect (`frameOk`), each proved sound; untrusted analyses propose them (#34–#36).
+
+### Frontends
+
+- Forth: colon definitions, recursion, variables and constants, `CREATE`/`ALLOT`/`,`,
+  `IF`/`ELSE`/`THEN`, `BEGIN … UNTIL`/`WHILE … REPEAT`, `DO … LOOP`/`+LOOP` with `?DO`, `LEAVE`
+  and `UNLOOP`, `CASE … ENDCASE`, `>R R> R@`, and the double-cell words
+  `UM* UM/MOD M* SM/REM FM/MOD */MOD */`, compiled to the IR with `compile_correct`; a parser that
+  implements an inductive grammar exactly, with a proved print/parse round trip (#15–#23).
+- A BCPL subset and Wolfram-style integer expressions and matrix products, compiled to the IR
+  with correctness proofs (#4).
+
+### Backends, each proved against its machine model and tested under emulation
+
+- x86-64 (#5, #13, #15), WebAssembly (#6, #9, #10, #12, #14), AArch64 (#24, #27) and RISC-V
+  RV64IM (#25, #28), with `wordc`, `wasmw`, `a64c` and `rv64c`.
+- Microcontroller profiles at 32-bit words, bare metal: RV32IM on the QEMU `virt` board
+  (`rv32c`, #29), Cortex-M3 on a Stellaris LM3S6965 (`cmc`, #30) and Cortex-M0 on a BBC micro:bit
+  (`cm0c`, #32, with division by a proved loop).
+- Cortex-M images boot from flash, with the start-up copy proved (#31).
+- Board runtime: UART set-up for the real boards, the end of a run signalled on the UART,
+  flashable `.hex` images, the expected serial transcript and a `verify` command
+  (`docs/HARDWARE.md`, #33). Not yet run on physical boards.
+
+### Verified optimisation
+
+- The microcontroller backends leave out the stack guards the depth certificates show cannot
+  fire, with the certificates' checks as hypotheses of the end-to-end theorems: code is up to
+  72% smaller on the Cortex-M0, 60% on the Cortex-M3 and 56% on RV32 (#34–#37). `--no-opt` keeps
+  every guard; `stats` counts the guards left out.
+
+### Known limits
+
+- The machine models (and, for the boards, the device set-up) are trusted; agreement with real
+  assemblers, emulators and machines is tested, not proved. Physical boards are untested.
+- The Forth lexer has no independent specification yet (`NEXT_STEPS.md`).
+- Guard elimination is not yet used by the 64-bit backends or WebAssembly.
+
+### License
+
+Parr Source License — No AI Training, Version 1.0 (`License`).

NEXT_STEPS.md

@@ -63,13 +63,21 @@ the device addresses are those of the `virt` board, and the stacks hold 4096 wor
 ## Done: Cortex-M profile
 
 `backend/cortexm` lowers the 32-bit IR to Thumb-2 (ARMv7-M) and proves it end to end
-(`CM.Emit.binary_correct`), with a bare-metal runtime (vector table, UART output, semihosting
-exit). The image boots from flash: the reset handler's copy of `.data` to SRAM is proved
+(`CM.Emit.binary_correct`), with a bare-metal runtime (vector table, UART output, end of run on
+the UART). The image boots from flash: the reset handler's copy of `.data` to SRAM is proved
 (`CM/Boot.lean`, `boot_correct`). `cmc` runs it on an emulated Stellaris LM3S6965 Cortex-M3
-(`qemu-system-arm -M lm3s6965evb`); CI runs it. Choices a later change may revisit: the stop
-uses semihosting (a board without a debugger needs another end-of-run signal), the UART
-initialisation leaves the baud rate at its reset value, and the cell address uses `lsl` and
-`add` rather than Thumb-2's indexed `ldr`.
+(`qemu-system-arm -M lm3s6965evb`); CI runs it. Choices a later change may revisit: the cell
+address uses `lsl` and `add` rather than Thumb-2's indexed `ldr`.
+
+## Done: board runtime
+
+The Cortex-M3 and Cortex-M0 runtimes set up the clock and UART as a real board needs (crystal,
+UART clock and pins, 115200 8N1) and end a run on the UART (`EXIT` and the status, then `wfi`)
+instead of semihosting, so no debugger is needed. `cmc image` / `cm0c image` write the ELF, an
+Intel HEX file and the UART transcript a correct run prints; `cmc verify` / `cm0c verify` check a
+serial log captured from a board. `docs/HARDWARE.md` is the runbook. **Not yet run on real
+silicon**: the board set-up follows the vendors' documentation and is exercised only on the
+emulators, which ignore clocks and baud rates.
 
 ## Done: Cortex-M0 profile
 
@@ -81,6 +89,26 @@ end, from the flash image (`CM0.Emit.boot_correct`). ARMv6-M has no divide instr
 a `bl` (simple, at a cost in code size), constants are built from bytes rather than loaded from
 literal pools, and the stacks hold 1024 words each to fit the 16 KiB of SRAM.
 
+## Done: stack-guard elimination (RV32, Cortex-M3, Cortex-M0)
+
+`formal/WordDialect/Depth.lean`: a stack-depth certificate, checked by `certOk`, holds at every
+reachable state (`DepthInv.steps`); upper bounds, checked by `boundOk` and `frameOk` (per word)
+against a capacity, are backed by invariants kept through every step taken within it
+(`UbSound`). The three microcontroller lowerings drop each underflow guard the certificate covers
+and each data-stack overflow guard where the bound shows room; `binary_correct` (and
+`boot_correct` on the Cortex-M profiles) assume `certOk` and `UbSound`, which `rv32c`, `cmc` and
+`cm0c` obtain from checks (`certTable`, `upperTable`), falling back to keeping the guards. Code
+is up to 72% smaller. Choices a later
+change may revisit:
+
+- the 64-bit backends and WebAssembly do not use them yet;
+- upper bounds are per word (frame certificates): a word is identified by its entry, so code
+  shared between two words (one reached by a jump from another) makes `frameOk` reject the
+  certificate, and the context-insensitive bound is used alone;
+- auxiliary-stack and return-stack overflow guards are all kept (they are few);
+- call return points claim depth 0 for lower bounds, so an underflow guard right after a call
+  stays.
+
 ## 1. Forth: double-cell storage and arithmetic
 
 The double-cell storage words (`2@ 2! 2VARIABLE`) and double-cell arithmetic

backend/common/Harness32.lean

@@ -93,6 +93,55 @@ def parseHexDump (s : Sample32) (out : String) : Except String Result :=
     else .ok (.halted (rest.take depth) ((rest.drop depth).take m) (rest.drop (depth + m)))
   | _ => .error s!"malformed dump: {out}"
 
+/-! ## The end-of-run protocol of the microcontroller runtimes
+
+A board has no exit status to give back, so the Cortex-M runtimes end every run on the UART:
+after the halt dump (if the program halted) they write a line `EXIT` and the status as one more
+word line (`0` for halt, the trap code otherwise), then sleep. The host reads up to that line,
+whether the other end is an emulator or a serial port. -/
+
+def exitMarker : String := "EXIT"
+
+/-- The eight-hexadecimal-digit line the runtimes print for a word. -/
+def hexLine (v : Nat) : String :=
+  let d := Nat.toDigits 16 (v % 2 ^ 32)
+  String.ofList (List.replicate (8 - d.length) '0' ++ d)
+
+/-- Lines of a transcript: carriage returns dropped (a serial terminal may add them), blank
+lines and anything before the first word line (boot noise on a real board) ignored. -/
+def transcriptLines (t : String) : List String :=
+  let ls := ((t.replace "\r" "").splitOn "\n").map String.trim |>.filter (· ≠ "")
+  ls.dropWhile fun l => l ≠ exitMarker ∧ (hexWords l).isNone
+
+/-- The result a transcript reports: the status after `EXIT`, and for status 0 the dump before it. -/
+def parseTranscript (s : Sample32) (t : String) : Except String Result :=
+  let ls := transcriptLines t
+  match ls.findIdx? (· == exitMarker) with
+  | none => .error s!"no {exitMarker} line in the output: {t}"
+  | some i =>
+    match hexWords (ls.getD (i + 1) "") with
+    | some [0] => parseHexDump s (String.intercalate "\n" (ls.take i))
+    | some [k] => .ok (.trap k)
+    | _ => .error s!"no status after {exitMarker}: {t}"
+
+/-- The exact UART output a correct run prints: what a board's serial log must contain. -/
+def transcriptOf : Result → Option String
+  | .halted st mem regs =>
+    some (String.intercalate "\n" ((st.length :: st ++ mem ++ regs).map hexLine ++
+      [exitMarker, hexLine 0]) ++ "\n")
+  | .trap k => some (exitMarker ++ "\n" ++ hexLine k ++ "\n")
+  | .timeout => none
+
+/-- Read a running target's UART up to the `EXIT` line and the status after it (or the end of
+the output, if the target stops first). -/
+partial def readUntilExit (h : IO.FS.Handle) (acc : String := "") (seen : Bool := false) :
+    IO String := do
+  let l ← h.getLine
+  if l.isEmpty then return acc
+  let acc := acc ++ l
+  if seen then return acc
+  readUntilExit h acc (l.trim == exitMarker)
+
 def check32 (run : Runner32) (s : Sample32) : IO Bool := do
   if let some e := s.buildError then
     IO.println s!"ERROR {s.name}: {e}"; return false
@@ -211,3 +260,84 @@ def checkAll32 (run : Runner32) (count : Nat) : IO Bool := do
   let fz ← fuzz32 run count
   let ovf ← checkOverflow32 run
   return ok && fz && ovf
+
+/-! ## Guard elimination
+
+The microcontroller profiles leave out stack guards that the checked certificates of
+`WordDialect.Depth` show cannot fire. These checks exercise the boundary: a data stack of
+`capacity` words filled exactly by straight-line code (every overflow guard removed; the run
+halts), the same after a call to a word with net effect -1, and one word more in each case, or a
+recursion that grows the stack (the guard that must fire is kept; exit 6). -/
+
+def checkCapacity32 (run : Runner32) (capacity : Nat) : IO Bool := do
+  let fill : Sample32 :=
+    { name := "cap_fill", prog := List.replicate capacity (.word 1) ++ [.halt], mem := [] }
+  let ok1 ← check32 run fill
+  -- the word at `w` pushes two words and drops three: net effect -1
+  let afterCall (extra : Nat) : List (WordDialect.Instr 32) :=
+    let w := 2 + (capacity + extra) + 1
+    [.word 7, .call w] ++ List.replicate (capacity + extra) (.word 1) ++ [.halt] ++
+      [.word 1, .word 2, .drop, .drop, .drop, .ret]
+  let ok2 ← check32 run { name := "cap_fill_after_call", prog := afterCall 0, mem := [] }
+  let mut ok := ok1 && ok2
+  for (name, prog) in [("cap_over_word", List.replicate capacity (.word 1) ++ [.word 1, .halt]),
+                       ("cap_over_dup", List.replicate capacity (.word 1) ++ [.dup, .halt]),
+                       ("cap_over_after_call", afterCall 1),
+                       -- recursion that grows the data stack by two words a level
+                       ("ovf_recursive_push2", [.call 2, .halt, .word 1, .word 2, .call 2, .ret])] do
+    match ← run { name, prog, mem := [] } with
+    | .ok (.trap 6) => IO.println s!"PASS  {name}  overflow exit 6"
+    | .ok got => IO.println s!"FAIL  {name}  expected overflow exit 6, got {repr got}"; ok := false
+    | .error e => IO.println s!"ERROR {name}: {e}"; ok := false
+  return ok
+
+/-- How many guards the certificates `lo` (lower bounds) and `hi` (upper bounds) leave out of
+program `p`, against a data stack of `dCap` words. -/
+def guardStats (s : Sample32) (lo hi : Nat → Nat) (dCap : Nat) : String :=
+  let p := s.prog
+  let grows : WordDialect.Instr 32 → Bool
+    | .word _ | .ptr _ | .push _ | .dup | .over | .fromr | .rfetch => true
+    | _ => false
+  let idx := p.zipIdx
+  let uf := idx.filter fun (i, _) => 0 < i.pops
+  let ufKept := uf.filter fun (i, k) => lo k < i.pops
+  let ov := idx.filter fun (i, _) => grows i
+  let ovKept := ov.filter fun (_, k) => !(hi k + 1 ≤ dCap)
+  let frames := if frameOk p dCap (analyseFrames p dCap) then "accepted" else "rejected"
+  s!"{s.name}: {p.length} instructions; underflow guards {uf.length} → {ufKept.length}; data-stack overflow guards {ov.length} → {ovKept.length} (frame certificate {frames})"
+
+/-! ## Images for real boards
+
+`image` turns a program into files for a real board: the ELF, an Intel HEX file (what a
+micro:bit takes by drag and drop, and what most flash tools accept), and the UART transcript a
+correct run prints (`transcriptOf` of the Lean outcome). `verify` checks a serial log captured
+from the board against the Lean semantics. -/
+
+/-- Write `<stem>.elf`, `<stem>.hex` and `<stem>.expected` next to each other. -/
+def writeImage (s : Sample32) (elf : String) (stem : String) : IO UInt32 := do
+  if let some e := s.buildError then IO.eprintln e; return 1
+  match transcriptOf (expected32 s) with
+  | none => IO.eprintln s!"{s.name}: the IR run does not end within the fuel"; return 1
+  | some t =>
+    IO.FS.writeBinFile (stem ++ ".elf") (← IO.FS.readBinFile elf)
+    let o ← IO.Process.output
+      { cmd := "llvm-objcopy", args := #["-O", "ihex", elf, stem ++ ".hex"] }
+    if o.exitCode != 0 then IO.eprintln s!"llvm-objcopy failed: {o.stderr}"; return 1
+    IO.FS.writeFile (stem ++ ".expected") t
+    IO.println s!"wrote {stem}.elf, {stem}.hex and {stem}.expected (the UART output a correct run prints)"
+    return 0
+
+/-- Compare a serial log from a board with the Lean semantics. -/
+def verifyLog (s : Sample32) (logPath : String) : IO UInt32 := do
+  if let some e := s.buildError then IO.eprintln e; return 1
+  -- keep printable ASCII and newlines: a board can put glitch bytes (not UTF-8) on the line as
+  -- its UART comes up
+  let bytes ← IO.FS.readBinFile logPath
+  let log := String.mk (bytes.toList.filterMap fun b =>
+    if b == 10 || (32 ≤ b && b < 127) then some (Char.ofNat b.toNat) else none)
+  let exp := expected32 s
+  match parseTranscript s log with
+  | .error e => IO.println s!"FAIL  {s.name}: {e}"; return 1
+  | .ok got =>
+    if got == exp then IO.println s!"PASS  {s.name}  {repr exp}"; return 0
+    else IO.println s!"FAIL  {s.name}\n  lean:  {repr exp}\n  board: {repr got}"; return 1

backend/cortexm/CM/Boot.lean

@@ -4,7 +4,7 @@ import CM.Init
 # CM.Boot
 
 Booting from flash, proved. A Cortex-M runs from flash: the vector table and code are there, and
-`.data` (IR memory, the register file and the semihosting block) is linked to RAM with its load
+`.data` (IR memory, the register file and the two-word status block) is linked to RAM with its load
 address in flash. The reset handler first copies `.data` to RAM with the ten-instruction loop
 `Emit.copyCode`, printed from the model like the lowered program, then runs the prologue.
 
@@ -260,15 +260,15 @@ theorem copy_holds {r : Runtime} {ld : Loader} {lma : Nat} {x0 : M} (h : FlashHo
 copy loop runs to its end; from there the prologue runs, and the lowered code reaches the outcome
 the IR reaches from `State.init` on the memory image, or exits with `overflow`. -/
 theorem boot_correct (r : Runtime) (ld : Loader) (lma : Nat) (p : Prog 32)
-    (hlen : 17 * p.length < 2 ^ 32) (hreg : RegsOk (cfgOf r ld) p) {o : Outcome 32}
-    (hx : Exec p (State.init (Memory.ofImage r.memImage)) o) {x0 : M}
+    (hlen : 17 * p.length < 2 ^ 32) (hreg : RegsOk (cfgOf r ld) p) (hok : certOk p r.cert = true)
+    (hub : UbSound p r.dCap r.ub) {o : Outcome 32} (hx : Exec p (State.init (Memory.ofImage r.memImage)) o) {x0 : M}
     (h : FlashHolds r ld lma x0) (hpc : x0.pc = 0) :
     ∃ x1, RSteps (copyCode (ofN lma) (ofN ld.mb) (dataWords r)) x0 x1 ∧ x1.pc = 10 ∧
       rseq (prologueCode r ld) x1 = .next { entryState r ld x1 with pc := x1.pc + 6 } ∧
       (Final (cfgOf r ld) p (lowerProg r.layout p) (entryState r ld x1) o ∨
         RExec (lowerProg r.layout p) (entryState r ld x1) .overflow) := by
   obtain ⟨x1, hs, hpc1, hh⟩ := copy_holds h hpc
-  exact ⟨x1, hs, hpc1, binary_correct r ld p hlen hreg hx hh⟩
+  exact ⟨x1, hs, hpc1, binary_correct r ld p hlen hreg hok hub hx hh⟩
 
 end Emit
 end CM

backend/cortexm/CM/Correct.lean

@@ -25,6 +25,11 @@ Hypotheses of both (all explicit):
                       at least two;
 * `L` matches `c`     data-stack end and limit, return-stack gap, auxiliary-stack end and limit,
                       and IR memory size;
+* `hLf`, `hok`, `I`   the code was lowered with the configuration's facts: its lower-bound
+                      certificate passes `certOk`, and its upper bound `c.ub` is implied by an
+                      invariant `I` kept by every step within the data stack's capacity (`hIs`,
+                      `hIb`; `WordDialect.UbSound`); the runs carry `DepthInv` and `I`, so every
+                      underflow or overflow guard the lowering left out would have passed;
 * `hsz`               code indices fit in 32 bits;
 * `RegsOk`            every `push r`/`pop r` names a register inside the register file.
 -/
@@ -44,15 +49,30 @@ def Final (c : Cfg) (p : Prog 32) (code : List (Instr Nat)) (x : M) : Outcome 32
   | .halted s' => ∃ x', RExec code x (.halted x') ∧ Rel0 c p s' x'
   | .trapped t => RExec code x (.trapped t)
 
-theorem offs_ge {p : Prog 32} {k : Nat} (h : p.length ≤ k) : offs p k = offs p p.length := by
-  simp [offs, List.take_of_length_le h, List.take_length]
+theorem offs_ge (cf : Nat → Facts) {p : Prog 32} {k : Nat} (h : p.length ≤ k) :
+    offs cf p k = offs cf p p.length := by
+  induction p generalizing cf k with
+  | nil => cases k <;> simp [offs]
+  | cons i is ih =>
+    cases k with
+    | zero => simp at h
+    | succ k => simp only [List.length_cons, offs]; rw [ih _ (by simp at h; omega)]
+
+/-- A related state is within the data stack's capacity. -/
+theorem cap_of_rel {c : Cfg} {p : Prog 32} {s : State 32} {x : M} (hs : Rel c p s x) :
+    s.dstack.length ≤ c.dCap := by
+  have := hs.1.capD
+  unfold Cfg.dCap
+  omega
 
 /-- One IR step from a related state: the bad-pc stub, or the dispatched instruction. -/
 theorem step_sim {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
     (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M) (hLd : L.dLim = ofN (c.dBase + 4))
     (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hLa : L.aEnd = ofN c.aEnd)
-    (hLal : L.aLim = ofN (c.aBase + 4)) (hsz : ∀ k, offs p k < 2 ^ 32) (hreg : RegsOk c p)
-    {s : State 32} {x : M} (hs : Rel c p s x) :
+    (hLal : L.aLim = ofN (c.aBase + 4)) (hLf : L.facts = c.facts) (hok : certOk p c.cert = true)
+    (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hreg : RegsOk c p)
+    {s : State 32} {x : M} (hs : Rel c p s x) (hdi : DepthInv c.cert s)
+    (hub : s.dstack.length ≤ c.ub s.pc) :
     Sim c p (lowerProg L p) x (WordDialect.step p s) ∨
       (¬ Fits c s ∧ RExec (lowerProg L p) x .overflow) := by
   cases hi : p[s.pc]? with
@@ -65,43 +85,48 @@ theorem step_sim {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
       · rw [List.getElem?_eq_getElem hh] at hi; simp at hi
       · omega
     obtain ⟨f0, _⟩ := lowerProg_stub L p
-    have hpc : x.pc = offs p p.length := by rw [hs.2, offs_ge hge]
+    rw [hLf] at f0
+    have hpc : x.pc = offs c.facts p p.length := by rw [hs.2, offs_ge _ hge]
     exact RExec.trap (by rw [rstep_of_fetch (by rw [hpc]; exact f0)]; rfl)
   | some i =>
     have hst : WordDialect.step p s = WordDialect.exec i s := by simp [WordDialect.step, hi]
     rw [hst]
-    exact sim_exec hg hL hMs hLd hLr hLa hLal hsz hs hi (fun r hr => hreg s.pc i hi r hr)
+    exact sim_exec hg hL hMs hLd hLr hLa hLal hLf hsz hs hdi.depth hub hi (fun r hr => hreg s.pc i hi r hr)
 
 /-- Whole-program preservation, with no capacity hypothesis: the Thumb-2 code reaches the IR
 outcome, or exits with `overflow` because a stack was full. -/
 theorem lowerProg_correct_or_overflow {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
     (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M) (hLd : L.dLim = ofN (c.dBase + 4))
     (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hLa : L.aEnd = ofN c.aEnd)
-    (hLal : L.aLim = ofN (c.aBase + 4)) (hsz : ∀ k, offs p k < 2 ^ 32) (hreg : RegsOk c p)
+    (hLal : L.aLim = ofN (c.aBase + 4)) (hLf : L.facts = c.facts) (hok : certOk p c.cert = true)
+    {I : State 32 → Prop}
+    (hIs : ∀ s s', I s → s.dstack.length ≤ c.dCap → WordDialect.step p s = .next s' → I s')
+    (hIb : ∀ s, I s → s.dstack.length ≤ c.ub s.pc)
+    (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hreg : RegsOk c p)
     {s : State 32} {o : Outcome 32} (h : Exec p s o) :
-    ∀ {x : M}, Rel c p s x →
+    ∀ {x : M}, Rel c p s x → DepthInv c.cert s → I s →
       Final c p (lowerProg L p) x o ∨ RExec (lowerProg L p) x .overflow := by
   induction h with
   | @halt s s' hst =>
-    intro x hs
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨_, h6⟩
     · exact .inl this
     · exact .inr h6
   | @trap s t hst =>
-    intro x hs
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨_, h6⟩
     · exact .inl this
     · exact .inr h6
   | @next s s' o hst _ ih =>
-    intro x hs
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with ⟨x1, hsteps, hrel⟩ | ⟨_, h6⟩
-    · rcases ih hrel with hih | h6
+    · rcases ih hrel (DepthInv.step hok hdi hst) (hIs s _ hbi (cap_of_rel hs) hst) with hih | h6
       · left
         cases o with
         | next _ => exact hih.elim
@@ -117,31 +142,35 @@ every reachable state), no overflow guard fires and the outcome is exactly the I
 theorem lowerProg_correct {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
     (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M) (hLd : L.dLim = ofN (c.dBase + 4))
     (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hLa : L.aEnd = ofN c.aEnd)
-    (hLal : L.aLim = ofN (c.aBase + 4)) (hsz : ∀ k, offs p k < 2 ^ 32) (hreg : RegsOk c p)
+    (hLal : L.aLim = ofN (c.aBase + 4)) (hLf : L.facts = c.facts) (hok : certOk p c.cert = true)
+    {I : State 32 → Prop}
+    (hIs : ∀ s s', I s → s.dstack.length ≤ c.dCap → WordDialect.step p s = .next s' → I s')
+    (hIb : ∀ s, I s → s.dstack.length ≤ c.ub s.pc)
+    (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hreg : RegsOk c p)
     {s : State 32} {o : Outcome 32} (h : Exec p s o) :
-    ∀ {x : M}, Rel c p s x → (∀ s', Steps p s s' → Fits c s') →
+    ∀ {x : M}, Rel c p s x → DepthInv c.cert s → I s → (∀ s', Steps p s s' → Fits c s') →
       Final c p (lowerProg L p) x o := by
   induction h with
   | @halt s s' hst =>
-    intro x hs hb
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi hb
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨hnf, _⟩
     · exact this
     · exact absurd (hb s .refl) hnf
   | @trap s t hst =>
-    intro x hs hb
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi hb
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨hnf, _⟩
     · exact this
     · exact absurd (hb s .refl) hnf
   | @next s s' o hst _ ih =>
-    intro x hs hb
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi hb
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with ⟨x1, hsteps, hrel⟩ | ⟨hnf, _⟩
-    · have hih := ih hrel (fun s'' hss => hb s'' (Steps.cons hst hss))
+    · have hih := ih hrel (DepthInv.step hok hdi hst) (hIs s _ hbi (cap_of_rel hs) hst) (fun s'' hss => hb s'' (Steps.cons hst hss))
       cases o with
       | next _ => exact hih.elim
       | halted r5 =>
@@ -159,7 +188,7 @@ theorem init_rel {c : Cfg} {p : Prog 32} {s0 : State 32} {x0 : M} (hg : Geom c)
     (h13 : x0.regs Reg.r6 = ofN c.mb) (h12 : x0.regs Reg.r7 = ofN c.sp0)
     (hsp : x0.regs Reg.r8 = ofN c.sp0) (hbp : x0.regs Reg.r9 = ofN c.aEnd) (hregs : RegRel c x0.mem s0.regs)
     (hmem : MemRel c x0.mem s0.mem) (hiv : ∀ a : Word 32, s0.mem.valid a = decide (a.toNat < c.M))
-    (hxv : RegionsValid c x0.mem.valid) (hpc : x0.pc = offs p s0.pc) : Rel c p s0 x0 :=
+    (hxv : RegionsValid c x0.mem.valid) (hpc : x0.pc = offs c.facts p s0.pc) : Rel c p s0 x0 :=
   ⟨{ r4 := by simpa [hd] using h15
      r5 := h14
      r6 := h13

backend/cortexm/CM/Emit.lean

@@ -25,13 +25,14 @@ is linked to RAM with its load address in flash. There is no operating system. T
 The rest of the runtime (`epilogue`) is hand-written assembly. It
 * implements `exitHalt` as: write `depth`, the data stack, IR memory and the virtual register
   file to the UART (a PL011, UART0 of the Stellaris LM3S6965 at `uartBase`, polling its
-  transmit-full flag), one word per line as eight hexadecimal digits, then stop with status 0,
-* implements `exitTrap t` as stopping with status `code t`, and `exitOvf` (stack overflow) with
+  transmit-full flag), one word per line as eight hexadecimal digits, then end with status 0,
+* implements `exitTrap t` as ending with status `code t`, and `exitOvf` (stack overflow) with
   status 6.
 
-The machine is stopped through semihosting (`bkpt 0xab`, operation `SYS_EXIT_EXTENDED`), which
-the emulator and debug probes implement; on a board running without a debugger, that one stub is
-replaced by whatever signals the end of a run. The lowered code itself uses no device.
+A run ends on the UART, the same way on the emulator and on a board, with no debugger: after
+the dump (if any) the runtime prints a line `EXIT` and the status, stores the status at `exitblk`,
+and sleeps. Before printing it sets up the clock and UART0 as a board needs (`uartInit`). The
+lowered code itself uses no device.
 -/
 
 namespace WordDialect
@@ -150,7 +151,8 @@ def body (code : List (Instr Nat)) : String :=
 /-- Data-stack placement (`capacity` words ending at `dEnd`), return-stack placement (`rcap`
 entries ending at `rEnd`), IR memory image, register-file size, auxiliary-stack placement
 (`acap` words ending at `aEnd`), the initial stack pointer of the vector table (used only by
-exception entry; the lowered code does not use `sp`), and the address of the PL011 UART. The three stacks
+exception entry; the lowered code does not use `sp`), the address of the PL011 UART, and the
+clock and baud rate its divisor is computed from. The three stacks
 are sections the linker places at fixed addresses (`cmc` uses a linker script). -/
 structure Runtime where
   dEnd : Nat
@@ -163,6 +165,16 @@ structure Runtime where
   acap : Nat
   spInit : Nat := 0x20010000
   uartBase : Nat := 0x4000C000
+  /-- System clock the UART divisor is computed from: the 8 MHz crystal of the EK-LM3S6965. -/
+  clockHz : Nat := 8000000
+  baud : Nat := 115200
+  /-- The stack-depth certificate the code is lowered with (`WordDialect.Depth`); the driver
+  passes `safeCert` of the program. The default claims nothing and keeps every guard. -/
+  cert : Nat → Nat := fun _ => 0
+  /-- The upper bound on the data-stack depth the code is lowered with; the driver passes
+  `upperTable` of the program against `dCap` (`WordDialect.Depth`). An overflow guard is left out
+  where `ub k + 1 ≤ dCap`; the default (`2^32` everywhere) shows no room, so every guard stays. -/
+  ub : Nat → Nat := fun _ => 2 ^ 32
 
 def Runtime.dBase (r : Runtime) : Nat := r.dEnd - 4 * r.capacity
 
@@ -170,11 +182,15 @@ def Runtime.rBase (r : Runtime) : Nat := r.rEnd - 4 * r.rcap
 
 def Runtime.aBase (r : Runtime) : Nat := r.aEnd - 4 * r.acap
 
+/-- The data stack's capacity in words. -/
+def Runtime.dCap (r : Runtime) : Nat := (r.dEnd - r.dBase) / 4
+
 /-- The lowering's view of the runtime: the constants the guards and bounds checks use. -/
 def Runtime.layout (r : Runtime) : Layout :=
   { dEnd := BitVec.ofNat 32 r.dEnd, memSize := r.memImage.length,
     dLim := BitVec.ofNat 32 (r.dBase + 4), rGap := BitVec.ofNat 32 (4 * r.rcap - 8),
-    aEnd := BitVec.ofNat 32 r.aEnd, aLim := BitVec.ofNat 32 (r.aBase + 4) }
+    aEnd := BitVec.ofNat 32 r.aEnd, aLim := BitVec.ofNat 32 (r.aBase + 4), cert := r.cert,
+    ub := r.ub, dCap := r.dCap }
 
 /-- Assembler directives and the vector table: initial stack pointer and reset vector. -/
 def vectors (r : Runtime) : String :=
@@ -182,7 +198,7 @@ def vectors (r : Runtime) : String :=
   s!"\t.word {hex r.spInit}\n\t.word _start\n"
 
 /-- The `.data` image: IR memory, the register file (`nregs + 1` words) and the two-word
-semihosting parameter block, in the order `epilogue` lays them out. The image is linked into
+status block `exitblk`, in the order `epilogue` lays them out. The image is linked into
 flash and copied to RAM at reset. -/
 def dataImage (r : Runtime) : List Nat := r.memImage ++ List.replicate (r.nregs + 3) 0
 
@@ -212,11 +228,43 @@ def prologue (r : Runtime) : String :=
   s!"\t{li "r7" r.rEnd}\n\tmov r8, r7\n\t{la "r6" "irmem"}\n\t{la "r5" "regfile"}\n" ++
   s!"\t{li "r4" r.dEnd}\n\t{li "r9" r.aEnd}\n"
 
-/-- Output and exit routines, entered only from `exitHalt`, `exitTrap` and `exitOvf`, so they
-may use any register. `putc` writes `r3` to the UART; `putw` writes `r0` as eight hexadecimal
-digits and a newline; `putws` writes the `r9` words at address `r7`. `.Lexit` stops the machine
-through semihosting with status `r1`. -/
+/-- The UART divisor for `baud` at `clockHz`: 64 × the PL011's `clock / (16 baud)`, rounded,
+split into the integer (`IBRD`) and fractional (`FBRD`) parts. -/
+def Runtime.divisor (r : Runtime) : Nat × Nat :=
+  let d := (r.clockHz * 4 + r.baud / 2) / r.baud
+  (d / 64, d % 64)
+
+/-- Bring up UART0 as a board needs it (the emulator needs none of it): run the system clock
+from the main oscillator with the 8 MHz crystal (as StellarisWare's `SysCtlClockSet` with
+`SYSCTL_USE_OSC | SYSCTL_OSC_MAIN | SYSCTL_XTAL_8MHZ` does: `RCC.MOSCDIS = 0`, `OSCSRC = main`,
+`XTAL = 8 MHz`), wait for it, clock UART0 and GPIO port A, give PA0/PA1 to the UART, and set
+`baud` 8N1. Uses `r10 … r12`. -/
+def uartInit (r : Runtime) : String :=
+  let (ib, fb) := r.divisor
+  "\t.thumb_func\nuart_init:\n" ++
+  s!"\t{li "r12" 0x400FE060}\n\tldr r11, [r12]\n\t{li "r10" 0x3F1}\n\tbic r11, r11, r10\n" ++
+  "\torr r11, r11, #0x380\n\tstr r11, [r12]\n" ++
+  "\tmovw r11, #0x8000\n9:\tsubs r11, r11, #1\n\tbne 9b\n" ++
+  s!"\t{li "r12" 0x400FE104}\n\tldr r11, [r12]\n\torr r11, r11, #1\n\tstr r11, [r12]\n" ++
+  s!"\t{li "r12" 0x400FE108}\n\tldr r11, [r12]\n\torr r11, r11, #1\n\tstr r11, [r12]\n" ++
+  "\tnop\n\tnop\n\tnop\n" ++
+  s!"\t{li "r12" 0x40004000}\n\tldr r11, [r12, #0x420]\n\torr r11, r11, #3\n\tstr r11, [r12, #0x420]\n" ++
+  "\tldr r11, [r12, #0x51C]\n\torr r11, r11, #3\n\tstr r11, [r12, #0x51C]\n" ++
+  s!"\t{li "r12" r.uartBase}\n\tmovs r11, #0\n\tstr r11, [r12, #0x30]\n" ++
+  s!"\tmovw r11, #{ib}\n\tstr r11, [r12, #0x24]\n\tmovw r11, #{fb}\n\tstr r11, [r12, #0x28]\n" ++
+  "\tmovs r11, #0x60\n\tstr r11, [r12, #0x2C]\n\tmovw r11, #0x301\n\tstr r11, [r12, #0x30]\n" ++
+  "\tbx lr\n"
+
+/-- Output and end-of-run routines, entered only from `exitHalt`, `exitTrap` and `exitOvf`, so
+they may use any register. `putc` writes `r3` to the UART; `putw` writes `r0` as eight
+hexadecimal digits and a newline; `putws` writes the `r9` words at address `r7`.
+
+The end of a run (`.Lexit` with the status in `r1`, entered with the UART not yet set up;
+`.Lfinish` with it set up) needs no debugger: the status goes to the two words at `exitblk`
+(the status and the marker `0xE0D0F1A1`, for a debugger that wants to read it), then the UART
+gets the line `EXIT` and the status as a word line, and the core sleeps (`wfi`) for good. -/
 def devices (r : Runtime) : String :=
+  uartInit r ++
   "\t.thumb_func\nputc:\n" ++
   s!"\t{li "r12" r.uartBase}\n" ++
   "1:\tldr r11, [r12, #0x18]\n\ttst r11, #0x20\n\tbne 1b\n\tstr r3, [r12]\n\tbx lr\n" ++
@@ -227,15 +275,13 @@ def devices (r : Runtime) : String :=
   "\t.thumb_func\nputws:\n\tmov r8, lr\n" ++
   "5:\tcmp r9, #0\n\tbeq 6f\n\tldr r0, [r7], #4\n\tbl putw\n\tsubs r9, r9, #1\n\tb 5b\n" ++
   "6:\tbx r8\n" ++
-  s!".Lexit:\n\t{la "r0" "exitblk"}\n\t{li "r2" 0x20026}\n" ++
-  "\tstr r2, [r0]\n\tstr r1, [r0, #4]\n\tmov r1, r0\n\tmovs r0, #0x20\n\tbkpt 0xab\n7:\tb 7b\n"
+  ".Lexit:\n\tmov r6, r1\n\tbl uart_init\n\tmov r1, r6\n" ++
+  s!".Lfinish:\n\tmov r6, r1\n\t{la "r0" "exitblk"}\n\tstr r1, [r0]\n\t{li "r2" 0xE0D0F1A1}\n\tstr r2, [r0, #4]\n" ++
+  String.join ("EXIT\n".toList.map fun ch => s!"\tmovs r3, #{ch.toNat}\n\tbl putc\n") ++
+  "\tmov r0, r6\n\tbl putw\n7:\twfi\n\tb 7b\n"
 
-/-- Turn on UART0: its clock (`RCGC1`, bit 0, in the Stellaris system control block) and the
-UART with its transmitter (`UARTCTL = UARTEN | TXE | RXE`). The baud rate is left at its reset
-divisor; the emulator ignores it. -/
-def uartOn (r : Runtime) : String :=
-  s!"\t{li "r12" 0x400FE104}\n\tldr r11, [r12]\n\torr r11, r11, #1\n\tstr r11, [r12]\n" ++
-  s!"\t{li "r12" r.uartBase}\n\tmovw r11, #0x301\n\tstr r11, [r12, #0x30]\n"
+/-- Set up the UART for the halt dump. -/
+def uartOn (_r : Runtime) : String := "\tbl uart_init\n"
 
 def epilogue (r : Runtime) : String :=
   let m := r.memImage.length
@@ -244,7 +290,7 @@ def epilogue (r : Runtime) : String :=
   "\tmov r7, r4\n\tbl putws\n" ++
   s!"\t{la "r7" "irmem"}\n\t{li "r9" m}\n\tbl putws\n" ++
   s!"\t{la "r7" "regfile"}\n\t{li "r9" r.nregs}\n\tbl putws\n" ++
-  "\tmovs r1, #0\n\tb .Lexit\n" ++
+  "\tmovs r1, #0\n\tb .Lfinish\n" ++
   String.join ((List.range 6).map fun k => s!".Ltrap{k + 1}:\n\tmovs r1, #{k + 1}\n\tb .Lexit\n") ++
   devices r ++ "\t.ltorg\n" ++
   "\t.data\n\t.balign 4\nirmem:\n" ++

backend/cortexm/CM/Guard.lean

@@ -40,7 +40,7 @@ theorem uf_cond {c : Cfg} {p : Prog 32} {s : State 32} {x : M} (hg : Geom c) (hs
   · simp [h]; omega
 
 /-- Enough operands: the guard falls through to `base + 3`, changing only scratch state. -/
-theorem uf_pass {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
+theorem uf_pass_pos {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
     {L : Layout} {base n : Nat} (hg : Geom c) (hs : Rel0 c p s x) (hL : L.dEnd = ofN c.dEnd)
     (hn : 0 < n) (hn3 : n ≤ 3) (hk : n ≤ s.dstack.length) (hpc : x.pc = base)
     (hat : RAt code base (uf L n base)) :
@@ -62,19 +62,38 @@ theorem uf_pass {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Ins
       simp [xa, M.adv, M.mov, M.setReg]
   · intro r hr; simp [xa, M.adv, M.mov, M.setReg, hr]
 
-/-- Too few operands: the guard exits with `stackUnderflow`. -/
+/-- The guard of an instruction popping `k` words, when the data stack is known to hold at least
+`g` words: with enough operands it falls through, to `base + ufSize (need g k)` (at once when the
+certificate made the guard empty). -/
+theorem uf_pass {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
+    {L : Layout} {base k : Nat} {g : Facts} (hg : Geom c) (hs : Rel0 c p s x)
+    (hL : L.dEnd = ofN c.dEnd) (hk3 : k ≤ 3) (hk : k ≤ s.dstack.length) (hpc : x.pc = base)
+    (hat : RAt code base (uf L (need g k) base)) :
+    ∃ x1, RSteps code x x1 ∧ Rel0 c p s x1 ∧ x1.pc = base + ufSize (need g k) ∧ x1.mem = x.mem ∧
+      (∀ r, r ≠ r0 → x1.regs r = x.regs r) := by
+  by_cases h0 : need g k = 0
+  · rw [h0]; exact ⟨x, .refl, hs, by simp [ufSize, hpc], rfl, fun _ _ => rfl⟩
+  · have hn : 0 < need g k := Nat.pos_of_ne_zero h0
+    have hle := need_le g k
+    obtain ⟨x1, a, b, hpc1, d, e⟩ := uf_pass_pos hg hs hL hn (by omega) (by omega) hpc hat
+    exact ⟨x1, a, b, by rw [hpc1, ufSize_pos hn], d, e⟩
+
+/-- Too few operands: the guard exits with `stackUnderflow`. It is there, because the depth
+certificate's bound `g.lo` is a true lower bound (`hgd`) and the stack holds fewer than `k` words. -/
 theorem uf_trap {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base n : Nat} (hg : Geom c) (hs : Rel0 c p s x) (hL : L.dEnd = ofN c.dEnd)
-    (hn : 0 < n) (hn3 : n ≤ 3) (hk : s.dstack.length < n) (hpc : x.pc = base)
-    (hat : RAt code base (uf L n base)) : RExec code x (.trapped .stackUnderflow) := by
-  rw [uf_eq L hn] at hat
+    {L : Layout} {base k : Nat} {g : Facts} (hg : Geom c) (hs : Rel0 c p s x)
+    (hL : L.dEnd = ofN c.dEnd) (hk0 : 0 < k) (hk3 : k ≤ 3) (hgd : g.lo ≤ s.dstack.length) (hk : s.dstack.length < k)
+    (hpc : x.pc = base) (hat : RAt code base (uf L (need g k) base)) :
+    RExec code x (.trapped .stackUnderflow) := by
+  rw [need_of_lt (by omega)] at hat
+  rw [uf_eq L hk0] at hat
   obtain ⟨h1, h2, h3, _⟩ := hat
-  let xa := x.mov r0 (L.dEnd - BitVec.ofNat 32 (4 * n))
+  let xa := x.mov r0 (L.dEnd - BitVec.ofNat 32 (4 * k))
   have hst1 : step code x = .next xa := by rw [rstep_of_fetch (by rw [hpc]; exact h1)]; rfl
   have hxa_pc : xa.pc = base + 1 := by simp [xa, M.mov, M.setReg, M.adv, hpc]
   have hholds : Cond.eval .ule (xa.regs r4) (xa.regs r0) = false := by
-    have := uf_cond hg hs hL hn hn3
-    have h : ¬ n ≤ s.dstack.length := by omega
+    have := uf_cond hg hs hL hk0 hk3
+    have h : ¬ k ≤ s.dstack.length := by omega
     simpa [xa, M.mov, M.setReg, M.adv, h] using this
   exact RExec.of_steps (RSteps.single hst1)
     (guard_trap (code := code) (pc := base + 1) (m := xa) (t := .stackUnderflow)
@@ -131,6 +150,29 @@ theorem ovfD_trap (hg : Geom c) (hs : Rel0 c p s x) (hLd : L.dLim = ofN (c.dBase
     rw [hra r4 (by decide), hta, ovfD_cond hg hs hLd]; simpa using h
   exact RExec.of_steps hsa (ovf_trap hj he hpca hholds)
 
+/-- The data-stack guard where the facts keep it: with room for one more word, it falls through
+to `base + ovfSize g` (at once when the bound left the guard out). -/
+theorem ovfG_pass {g : Facts} (hg : Geom c) (hs : Rel0 c p s x) (hLd : L.dLim = ofN (c.dBase + 4))
+    (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) (hpc : x.pc = base)
+    (hat : RAt code base (ovf L g base)) :
+    ∃ x1, RSteps code x x1 ∧ Rel0 c p s x1 ∧ x1.pc = base + ovfSize g ∧ x1.mem = x.mem ∧
+      (∀ r, r ≠ r0 → x1.regs r = x.regs r) := by
+  unfold ovf at hat
+  unfold ovfSize
+  cases hn : g.noOvf
+  · simp only [hn, Bool.false_eq_true, if_false] at hat ⊢
+    exact ovfD_pass hg hs hLd hfit hpc hat
+  · exact ⟨x, .refl, hs, by simp [hpc], rfl, fun _ _ => rfl⟩
+
+/-- Data stack full: the guard is there (the bound did not claim room) and exits with
+`overflow`. -/
+theorem ovfG_trap {g : Facts} (hn : g.noOvf = false) (hg : Geom c) (hs : Rel0 c p s x)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd)
+    (hpc : x.pc = base) (hat : RAt code base (ovf L g base)) : RExec code x .overflow := by
+  unfold ovf at hat
+  simp only [hn, Bool.false_eq_true, if_false] at hat
+  exact ovfD_trap hg hs hLd h hpc hat
+
 /-- The return-stack guard's comparison, in terms of return-stack depth. -/
 theorem ovfR_cond (hg : Geom c) (hs : Rel0 c p s x) (hLr : L.rGap = ofN (4 * c.rcap - 8)) :
     Cond.eval .uge (x.regs Reg.r8) (x.regs Reg.r7 - L.rGap) =

backend/cortexm/CM/Init.lean

@@ -34,7 +34,9 @@ flash only (`copy_holds`, `boot_correct`).
 
 `binary_correct`: under those loader facts, after the prologue the lowered code reaches the IR
 outcome from `State.init` on the memory image, or exits with `overflow`. Its other hypotheses are
-only about the program.
+only about the program, including `certOk` for the runtime's stack-depth certificate and
+`UbSound` for its upper bound (the lowering leaves out the underflow and overflow guards they
+cover).
 -/
 
 namespace WordDialect
@@ -51,7 +53,8 @@ structure Loader where
 /-- The runtime placement for one run, as a `Cfg`. -/
 def cfgOf (r : Runtime) (ld : Loader) : Cfg :=
   { dEnd := r.dEnd, dBase := r.dBase, rf := ld.rf, nregs := r.nregs, mb := ld.mb,
-    M := r.memImage.length, sp0 := r.rEnd, rcap := r.rcap, aEnd := r.aEnd, aBase := r.aBase }
+    M := r.memImage.length, sp0 := r.rEnd, rcap := r.rcap, aEnd := r.aEnd, aBase := r.aBase,
+    cert := r.cert, ub := r.ub }
 
 /-- What the loader guarantees about the machine state `x0` at `_start`. -/
 structure Loader.Holds (r : Runtime) (ld : Loader) (x0 : M) : Prop where
@@ -76,36 +79,38 @@ theorem prologue_run (r : Runtime) (ld : Loader) (x0 : M) :
       .next { entryState r ld x0 with pc := x0.pc + 6 } := by
   simp [prologueCode, entryState, rseq, exec, M.mov, M.setReg, M.adv]
 
-theorem isize_le (i : WordDialect.Instr 32) : isize i ≤ 17 := by
-  cases i <;> simp [isize, ufSize]
-
-theorem sum_isize_le : ∀ l : Prog 32, (l.map isize).sum ≤ 17 * l.length
-  | [] => by simp
-  | i :: l => by
-    have := isize_le i
-    have := sum_isize_le l
-    simp only [List.map_cons, List.sum_cons, List.length_cons]
+theorem isize_le (g : Facts) (i : WordDialect.Instr 32) : isize g i ≤ 17 := by
+  have hu : ∀ k, ufSize (need g k) ≤ 3 := fun k => by unfold ufSize; split <;> omega
+  have hv : ovfSize g ≤ 3 := by unfold ovfSize; split <;> omega
+  have h1 := hu 1; have h2 := hu 2; have h3 := hu 3
+  cases i <;> simp only [isize] <;> omega
+
+theorem offs_le (cf : Nat → Facts) : ∀ (p : Prog 32) (k : Nat), offs cf p k ≤ 17 * p.length
+  | [], k => by cases k <;> simp [offs]
+  | i :: l, 0 => by simp [offs]
+  | i :: l, k + 1 => by
+    have := isize_le (cf 0) i
+    have := offs_le (fun j => cf (j + 1)) l k
+    simp only [offs, List.length_cons]
     omega
 
 /-- Code indices are bounded by the program length. -/
-theorem offs_lt {p : Prog 32} (h : 17 * p.length < 2 ^ 32) (k : Nat) : offs p k < 2 ^ 32 := by
-  have h1 := sum_isize_le (p.take k)
-  have h2 : (p.take k).length ≤ p.length := by rw [List.length_take]; omega
-  simp only [offs]
-  omega
+theorem offs_lt (cf : Nat → Facts) {p : Prog 32} (h : 17 * p.length < 2 ^ 32) (k : Nat) :
+    offs cf p k < 2 ^ 32 :=
+  Nat.lt_of_le_of_lt (offs_le cf p k) h
 
 theorem layout_ok (r : Runtime) (ld : Loader) :
-    r.layout.dEnd = ofN (cfgOf r ld).dEnd ∧ r.layout.memSize = (cfgOf r ld).M ∧
+    r.layout.facts = (cfgOf r ld).facts ∧ r.layout.dEnd = ofN (cfgOf r ld).dEnd ∧ r.layout.memSize = (cfgOf r ld).M ∧
       r.layout.dLim = ofN ((cfgOf r ld).dBase + 4) ∧ r.layout.rGap = ofN (4 * (cfgOf r ld).rcap - 8) ∧
       r.layout.aEnd = ofN (cfgOf r ld).aEnd ∧ r.layout.aLim = ofN ((cfgOf r ld).aBase + 4) :=
-  ⟨rfl, rfl, rfl, rfl, rfl, rfl⟩
+  ⟨funext fun _ => rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩
 
 /-- After the prologue, the machine is related to the IR's initial state. -/
 theorem entry_rel (r : Runtime) (ld : Loader) {x0 : M} (h : ld.Holds r x0) (p : Prog 32) :
     Rel (cfgOf r ld) p (State.init (Memory.ofImage r.memImage)) (entryState r ld x0) := by
   have hg := h.geom
   refine init_rel hg rfl rfl rfl (by have := hg.rcap_ge; simp [cfgOf] at this ⊢; omega)
-    ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ (fun _ => rfl) ?_ (by simp [entryState, offs, State.init])
+    ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ (fun _ => rfl) ?_ (by simp [entryState, offs, State.init, offs_zero])
   · simp [entryState, M.mov, M.setReg, M.adv, cfgOf]
   · simp [entryState, M.mov, M.setReg, M.adv, cfgOf]
   · simp [entryState, M.mov, M.setReg, M.adv, cfgOf]
@@ -126,14 +131,17 @@ theorem entry_rel (r : Runtime) (ld : Loader) {x0 : M} (h : ld.Holds r x0) (p :
 the outcome the IR reaches from `State.init` on the memory image, or exits with `overflow` (exit
 code 6). Program hypotheses: code indices fit in 32 bits and register indices are in range. -/
 theorem binary_correct (r : Runtime) (ld : Loader) (p : Prog 32) (hlen : 17 * p.length < 2 ^ 32)
-    (hreg : RegsOk (cfgOf r ld) p) {o : Outcome 32}
+    (hreg : RegsOk (cfgOf r ld) p) (hok : certOk p r.cert = true)
+    (hub : UbSound p r.dCap r.ub) {o : Outcome 32}
     (hx : Exec p (State.init (Memory.ofImage r.memImage)) o) {x0 : M} (h : ld.Holds r x0) :
     rseq (prologueCode r ld) x0 = .next { entryState r ld x0 with pc := x0.pc + 6 } ∧
       (Final (cfgOf r ld) p (lowerProg r.layout p) (entryState r ld x0) o ∨
         RExec (lowerProg r.layout p) (entryState r ld x0) .overflow) := by
-  obtain ⟨hL, hMs, hLd, hLr, hLa, hLal⟩ := layout_ok r ld
+  obtain ⟨hLc, hL, hMs, hLd, hLr, hLa, hLal⟩ := layout_ok r ld
+  obtain ⟨I, hI0, hIs, hIb⟩ := hub
   exact ⟨prologue_run r ld x0,
-    lowerProg_correct_or_overflow h.geom hL hMs hLd hLr hLa hLal (offs_lt hlen) hreg hx (entry_rel r ld h p)⟩
+    lowerProg_correct_or_overflow h.geom hL hMs hLd hLr hLa hLal hLc hok hIs hIb (offs_lt _ hlen)
+      hreg hx (entry_rel r ld h p) (DepthInv.init (certOk_entry hok) _) (hI0 _)⟩
 
 end Emit
 end CM

backend/cortexm/CM/Isa.lean

@@ -38,7 +38,7 @@ Scope and trust boundary:
 * `exitHalt` / `exitTrap t` stand for the runtime stubs that dump state and stop the machine;
   they are terminal here. `exitOvf` is the stub for a stack-overflow guard (status 6); it has no
   IR counterpart, since IR stacks are unbounded. There is no operating system: the stubs talk to
-  a UART and stop the machine through semihosting (`CM.Emit`).
+  a UART and end the run there (`CM.Emit`).
 
 That the model matches the hardware is the stated assumption of this backend; `cmc` tests it by
 running the emitted code on an emulated Cortex-M3 board (`qemu-system-arm -M lm3s6965evb`).

backend/cortexm/CM/Lower.lean

@@ -1,4 +1,5 @@
 import CM.Isa
+import WordDialect.Depth
 
 /-!
 # CM.Lower
@@ -49,6 +50,24 @@ structure Layout where
   rGap : W        -- `4 rcap - 8`: a call has room iff `r8 ≥ r7 - rGap`
   aEnd : W        -- empty auxiliary stack: `r9 = aEnd`
   aLim : W        -- `aBase + 4`: the auxiliary stack has room for one more word iff `r9 ≥ aLim`
+  /-- A depth certificate (`WordDialect.Depth`): at IR instruction `k` the data stack holds at
+  least `cert k` words, so an operand-count guard for at most that many words is left out. -/
+  cert : Nat → Nat := fun _ => 0
+  /-- An upper bound on the data-stack depth at each IR instruction, and the data stack's
+  capacity in words. Where `ub k + 1 ≤ dCap` the data-stack overflow guard is left out. The
+  default capacity `0` leaves every guard in. -/
+  ub : Nat → Nat := fun _ => 0
+  dCap : Nat := 0
+
+/-- What the lowering knows at one IR instruction: a lower bound on the data-stack depth, and
+whether one more word is known to fit. -/
+structure Facts where
+  lo : Nat := 0
+  noOvf : Bool := false
+
+/-- The facts at IR instruction `k`. -/
+def Layout.facts (L : Layout) (k : Nat) : Facts :=
+  { lo := L.cert k, noOvf := decide (L.ub k + 1 ≤ L.dCap) }
 
 /-- Stack-underflow guard for `k` operands: continue when `r4 ≤ dEnd - 4k`. -/
 def uf (L : Layout) (k base : Nat) : List (Instr Nat) :=
@@ -58,10 +77,25 @@ def uf (L : Layout) (k base : Nat) : List (Instr Nat) :=
 
 def ufSize (k : Nat) : Nat := if k = 0 then 0 else 3
 
+/-- The operand count an instruction popping `k` words still has to check when the data stack is
+known to hold at least `g.lo` words: none if `k ≤ g.lo`. -/
+def need (g : Facts) (k : Nat) : Nat := if k ≤ g.lo then 0 else k
+
+theorem need_le (g : Facts) (k : Nat) : need g k ≤ k := by unfold need; split <;> omega
+
+theorem need_of_lt {g : Facts} {k : Nat} (h : g.lo < k) : need g k = k := by
+  unfold need; split <;> omega
+
 /-- Data-stack overflow guard: exit 6 unless one more word fits. -/
 def ovfD (L : Layout) (base : Nat) : List (Instr Nat) :=
   [.movImm r0 L.dLim, .bcc .uge r4 r0 (base + 3), .exitOvf]
 
+/-- The data-stack overflow guard where it is needed: none when the facts say one more word fits. -/
+def ovf (L : Layout) (g : Facts) (base : Nat) : List (Instr Nat) :=
+  if g.noOvf then [] else ovfD L base
+
+def ovfSize (g : Facts) : Nat := if g.noOvf then 0 else 3
+
 /-- Return-stack overflow guard: exit 6 unless a call has room on the return stack. -/
 def ovfR (L : Layout) (base : Nat) : List (Instr Nat) :=
   [.movRR r0 r7, .movImm r1 L.rGap, .sub r0 r1, .bcc .uge r8 r0 (base + 5), .exitOvf]
@@ -75,131 +109,144 @@ def emptyA (L : Layout) (base : Nat) : List (Instr Nat) :=
   [.movImm r0 L.aEnd, .bcc .ne r9 r0 (base + 3), .exitTrap .returnUnderflow]
 
 /-- Code size of one IR instruction. -/
-def isize : WordDialect.Instr 32 → Nat
-  | .word _ | .ptr _ => 6
-  | .load => ufSize 1 + 8
-  | .store => ufSize 2 + 9
-  | .add | .sub | .mul | .and | .or | .xor => ufSize 2 + 5
-  | .div | .sdiv => ufSize 2 + 7
-  | .not => ufSize 1 + 3
-  | .shl | .shr => ufSize 2 + 8
-  | .rotl => ufSize 2 + 6
-  | .rotr => ufSize 2 + 5
-  | .cmp _ => ufSize 2 + 7
-  | .select => ufSize 3 + 7
+def isize (g : Facts) : WordDialect.Instr 32 → Nat
+  | .word _ | .ptr _ => ovfSize g + 3
+  | .load => ufSize (need g 1) + 8
+  | .store => ufSize (need g 2) + 9
+  | .add | .sub | .mul | .and | .or | .xor => ufSize (need g 2) + 5
+  | .div | .sdiv => ufSize (need g 2) + 7
+  | .not => ufSize (need g 1) + 3
+  | .shl | .shr => ufSize (need g 2) + 8
+  | .rotl => ufSize (need g 2) + 6
+  | .rotr => ufSize (need g 2) + 5
+  | .cmp _ => ufSize (need g 2) + 7
+  | .select => ufSize (need g 3) + 7
   | .jmp _ => 1
-  | .branch _ => ufSize 1 + 3
+  | .branch _ => ufSize (need g 1) + 3
   | .call _ => 6
   | .ret => 3
-  | .push _ => 6
-  | .pop _ => ufSize 1 + 3
-  | .dup => ufSize 1 + 6
-  | .drop => ufSize 1 + 1
-  | .swap => ufSize 2 + 4
-  | .over => ufSize 2 + 6
-  | .rot => ufSize 3 + 6
-  | .tor => ufSize 1 + 7
-  | .fromr => 10
-  | .rfetch => 9
+  | .push _ => ovfSize g + 3
+  | .pop _ => ufSize (need g 1) + 3
+  | .dup => ufSize (need g 1) + ovfSize g + 3
+  | .drop => ufSize (need g 1) + 1
+  | .swap => ufSize (need g 2) + 4
+  | .over => ufSize (need g 2) + ovfSize g + 3
+  | .rot => ufSize (need g 3) + 6
+  | .tor => ufSize (need g 1) + 7
+  | .fromr => ovfSize g + 7
+  | .rfetch => ovfSize g + 6
   | .halt => 1
 
 /-- Code for one IR instruction placed at code index `base`; `off t` is the code index of IR
 instruction `t` (clamped to the bad-pc stub for out-of-range targets). -/
-def lowerInstr (L : Layout) (base : Nat) (off : Nat → Nat) : WordDialect.Instr 32 → List (Instr Nat)
-  | .word w => ovfD L base ++ [.movImm r0 w, .addImm r4 (-4), .store r4 0 r0]
-  | .ptr p => ovfD L base ++ [.movImm r0 p.toWord, .addImm r4 (-4), .store r4 0 r0]
+def lowerInstr (L : Layout) (base : Nat) (off : Nat → Nat) (g : Facts) :
+    WordDialect.Instr 32 → List (Instr Nat)
+  | .word w => ovf L g base ++ [.movImm r0 w, .addImm r4 (-4), .store r4 0 r0]
+  | .ptr p => ovf L g base ++ [.movImm r0 p.toWord, .addImm r4 (-4), .store r4 0 r0]
   | .load =>
-    let b0 := base + ufSize 1
-    uf L 1 base ++
+    let b0 := base + ufSize (need g 1)
+    uf L (need g 1) base ++
       [.load r0 r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r1 (b0 + 4),
        .exitTrap .badAddress, .shlImm r0 2, .add r0 r6, .load r0 r0 0, .store r4 0 r0]
   | .store =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load r0 r4 0, .load r1 r4 4, .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (b0 + 5),
        .exitTrap .badAddress, .shlImm r0 2, .add r0 r6, .store r0 0 r1, .addImm r4 8]
-  | .add => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .add r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .sub => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .sub r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .mul => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .mul r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .and => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .and r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .or => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .or r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .xor => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .xor r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .add => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .add r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .sub => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .sub r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .mul => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .mul r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .and => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .and r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .or => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .or r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .xor => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .xor r0 r1, .store r4 4 r0, .addImm r4 4]
   | .div =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .bnez r1 (b0 + 4), .exitTrap .divideByZero, .divu r0 r0 r1,
        .store r4 4 r0, .addImm r4 4]
   | .sdiv =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .bnez r1 (b0 + 4), .exitTrap .divideByZero, .div r0 r0 r1,
        .store r4 4 r0, .addImm r4 4]
-  | .not => uf L 1 base ++ [.load r0 r4 0, .not r0, .store r4 0 r0]
+  | .not => uf L (need g 1) base ++ [.load r0 r4 0, .not r0, .store r4 0 r0]
   | .shl =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .lsl r0 r1, .sltiu r2 r1 32, .neg r2, .and r0 r2,
        .store r4 4 r0, .addImm r4 4]
   | .shr =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .lsr r0 r1, .sltiu r2 r1 32, .neg r2, .and r0 r2,
        .store r4 4 r0, .addImm r4 4]
   | .rotl =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .neg r1, .ror r0 r1, .store r4 4 r0, .addImm r4 4]
   | .rotr =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .ror r0 r1, .store r4 4 r0, .addImm r4 4]
   | .cmp c =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .movImm r2 1#32, .bcc c r0 r1 (b0 + 5), .movImm r2 0#32,
        .store r4 4 r2, .addImm r4 4]
   | .select =>
-    let b0 := base + ufSize 3
-    uf L 3 base ++
+    let b0 := base + ufSize (need g 3)
+    uf L (need g 3) base ++
       [.load r1 r4 0, .load r0 r4 4, .load r3 r4 8, .beqz r1 (b0 + 5), .movRR r0 r3,
        .store r4 8 r0, .addImm r4 8]
   | .jmp t => [.jmp (off t)]
-  | .branch t => uf L 1 base ++ [.load r0 r4 0, .addImm r4 4, .bnez r0 (off t)]
+  | .branch t => uf L (need g 1) base ++ [.load r0 r4 0, .addImm r4 4, .bnez r0 (off t)]
   | .call t => ovfR L base ++ [.call (off t)]
   | .ret => [.bcc .ne r8 r7 (base + 2), .exitTrap .returnUnderflow, .ret]
-  | .push r => ovfD L base ++ [.load r0 r5 (4 * (r : Int)), .addImm r4 (-4), .store r4 0 r0]
-  | .pop r => uf L 1 base ++ [.load r0 r4 0, .addImm r4 4, .store r5 (4 * (r : Int)) r0]
+  | .push r => ovf L g base ++ [.load r0 r5 (4 * (r : Int)), .addImm r4 (-4), .store r4 0 r0]
+  | .pop r => uf L (need g 1) base ++ [.load r0 r4 0, .addImm r4 4, .store r5 (4 * (r : Int)) r0]
   | .dup =>
-    uf L 1 base ++ ovfD L (base + ufSize 1) ++ [.load r0 r4 0, .addImm r4 (-4), .store r4 0 r0]
-  | .drop => uf L 1 base ++ [.addImm r4 4]
-  | .swap => uf L 2 base ++ [.load r0 r4 0, .load r1 r4 4, .store r4 0 r1, .store r4 4 r0]
+    uf L (need g 1) base ++ ovf L g (base + ufSize (need g 1)) ++ [.load r0 r4 0, .addImm r4 (-4), .store r4 0 r0]
+  | .drop => uf L (need g 1) base ++ [.addImm r4 4]
+  | .swap => uf L (need g 2) base ++ [.load r0 r4 0, .load r1 r4 4, .store r4 0 r1, .store r4 4 r0]
   | .over =>
-    uf L 2 base ++ ovfD L (base + ufSize 2) ++ [.load r0 r4 4, .addImm r4 (-4), .store r4 0 r0]
+    uf L (need g 2) base ++ ovf L g (base + ufSize (need g 2)) ++ [.load r0 r4 4, .addImm r4 (-4), .store r4 0 r0]
   | .rot =>
-    uf L 3 base ++
+    uf L (need g 3) base ++
       [.load r0 r4 0, .load r1 r4 4, .load r2 r4 8, .store r4 0 r2, .store r4 4 r0,
        .store r4 8 r1]
   | .tor =>
-    uf L 1 base ++ ovfA L (base + ufSize 1) ++
+    uf L (need g 1) base ++ ovfA L (base + ufSize (need g 1)) ++
       [.load r0 r4 0, .addImm r4 4, .addImm r9 (-4), .store r9 0 r0]
   | .fromr =>
-    emptyA L base ++ ovfD L (base + 3) ++
+    emptyA L base ++ ovf L g (base + 3) ++
       [.load r0 r9 0, .addImm r9 4, .addImm r4 (-4), .store r4 0 r0]
   | .rfetch =>
-    emptyA L base ++ ovfD L (base + 3) ++ [.load r0 r9 0, .addImm r4 (-4), .store r4 0 r0]
+    emptyA L base ++ ovf L g (base + 3) ++ [.load r0 r9 0, .addImm r4 (-4), .store r4 0 r0]
   | .halt => [.exitHalt]
 
-theorem lowerInstr_length (L : Layout) (base : Nat) (off : Nat → Nat) (i : WordDialect.Instr 32) :
-    (lowerInstr L base off i).length = isize i := by
-  cases i <;> simp [lowerInstr, isize, uf, ufSize, ovfD, ovfR, ovfA, emptyA] <;> (try split) <;> simp
+theorem uf_length (L : Layout) (k base : Nat) : (uf L k base).length = ufSize k := by
+  unfold uf ufSize; split <;> simp
+
+theorem ovf_length (L : Layout) (g : Facts) (base : Nat) : (ovf L g base).length = ovfSize g := by
+  unfold ovf ovfSize; split <;> simp [ovfD]
+
+theorem lowerInstr_length (L : Layout) (base : Nat) (off : Nat → Nat) (g : Facts)
+    (i : WordDialect.Instr 32) : (lowerInstr L base off g i).length = isize g i := by
+  cases i <;> simp [lowerInstr, isize, uf_length, ovf_length, ovfR, ovfA, emptyA] <;> omega
 
-/-- Prefix sums of instruction sizes: `offs p k` is the code index of IR instruction `k`.
-For `k` past the end it is the index of the final bad-pc stub. -/
-def offs (p : Prog 32) (k : Nat) : Nat := ((p.take k).map isize).sum
+/-- Prefix sums of instruction sizes: `offs cf p k` is the code index of IR instruction `k`,
+where `cf j` are the facts at instruction `j` (its guards depend on them). For `k` past
+the end it is the index of the final bad-pc stub. -/
+def offs (cf : Nat → Facts) : Prog 32 → Nat → Nat
+  | _, 0 => 0
+  | [], _ + 1 => 0
+  | i :: is, k + 1 => isize (cf 0) i + offs (fun j => cf (j + 1)) is k
 
-def lowerGo (L : Layout) (off : Nat → Nat) : Nat → List (WordDialect.Instr 32) → List (Instr Nat)
-  | _, [] => [.exitTrap .badPc]
-  | b, i :: is => lowerInstr L b off i ++ lowerGo L off (b + isize i) is
+def lowerGo (L : Layout) (off : Nat → Nat) :
+    (Nat → Facts) → Nat → List (WordDialect.Instr 32) → List (Instr Nat)
+  | _, _, [] => [.exitTrap .badPc]
+  | cf, b, i :: is => lowerInstr L b off (cf 0) i ++ lowerGo L off (fun j => cf (j + 1)) (b + isize (cf 0) i) is
 
 /-- The whole program; the last instruction is the bad-pc stub, so jumping past the end of the
-IR program traps `badPc` exactly as the IR semantics does. -/
-def lowerProg (L : Layout) (p : Prog 32) : List (Instr Nat) := lowerGo L (offs p) 0 p
+IR program traps `badPc` exactly as the IR semantics does. Instruction `k` leaves out the
+guards that `L.facts k` makes redundant. -/
+def lowerProg (L : Layout) (p : Prog 32) : List (Instr Nat) := lowerGo L (offs L.facts p) L.facts 0 p
 
 end CM
 end WordDialect

backend/cortexm/CM/Rel.lean

@@ -33,6 +33,17 @@ structure Cfg where
   rcap : Nat
   aEnd : Nat
   aBase : Nat
+  /-- The depth certificate the code was lowered with (`Layout.cert`). -/
+  cert : Nat → Nat := fun _ => 0
+  /-- The upper bound on the data-stack depth the code was lowered with (`Layout.ub`). -/
+  ub : Nat → Nat := fun _ => 2 ^ 32
+
+/-- The data stack's capacity in words. -/
+def Cfg.dCap (c : Cfg) : Nat := (c.dEnd - c.dBase) / 4
+
+/-- The facts the code was lowered with (`Layout.facts`). -/
+def Cfg.facts (c : Cfg) (k : Nat) : Facts :=
+  { lo := c.cert k, noOvf := decide (c.ub k + 1 ≤ c.dCap) }
 
 structure Geom (c : Cfg) : Prop where
   dEnd_lt : c.dEnd < 2 ^ 32
@@ -95,7 +106,7 @@ def MemRel (c : Cfg) (mem : Memory 32) (m : Memory 32) : Prop :=
   ∀ a, a < c.M → mem.read? (ofN (c.mb + 4 * a)) = some (m.cell (ofN a))
 
 def RsRel (c : Cfg) (p : Prog 32) (mem : Memory 32) (rs : List Nat) : Prop :=
-  ∀ i a, rs[i]? = some a → mem.read? (ofN (c.sp0 - 4 * rs.length + 4 * i)) = some (ofN (offs p a))
+  ∀ i a, rs[i]? = some a → mem.read? (ofN (c.sp0 - 4 * rs.length + 4 * i)) = some (ofN (offs c.facts p a))
 
 /-- The Thumb-2 memory's addressable set covers every region. -/
 def RegionsValid (c : Cfg) (v : W → Bool) : Prop :=
@@ -125,7 +136,7 @@ structure Rel0 (c : Cfg) (p : Prog 32) (s : State 32) (x : M) : Prop where
 
 /-- Full relation: everything in `Rel0`, and the Thumb-2 pc is the start of the IR pc's code. -/
 def Rel (c : Cfg) (p : Prog 32) (s : State 32) (x : M) : Prop :=
-  Rel0 c p s x ∧ x.pc = offs p s.pc
+  Rel0 c p s x ∧ x.pc = offs c.facts p s.pc
 
 /-- `Rel0` does not look at scratch registers or the pc. -/
 theorem Rel0.congr {c : Cfg} {p : Prog 32} {s : State 32} {x x' : M} (h : Rel0 c p s x)

backend/cortexm/CM/Run.lean

@@ -63,11 +63,10 @@ theorem rstep_of_fetch {code : List (Instr Nat)} {m : M} {i : Instr Nat}
   simp [step, h]
 
 /-- Prefix sums: `offs` of a cons. -/
-theorem offs_cons (i : WordDialect.Instr 32) (is : Prog 32) (k : Nat) :
-    offs (i :: is) (k + 1) = isize i + offs is k := by
-  simp [offs, List.take_succ_cons]
+theorem offs_cons (cf : Nat → Facts) (i : WordDialect.Instr 32) (is : Prog 32) (k : Nat) :
+    offs cf (i :: is) (k + 1) = isize (cf 0) i + offs (fun j => cf (j + 1)) is k := rfl
 
-theorem offs_zero (p : Prog 32) : offs p 0 = 0 := by simp [offs]
+theorem offs_zero (cf : Nat → Facts) (p : Prog 32) : offs cf p 0 = 0 := by cases p <;> rfl
 
 theorem rat_embed (pre seg post : List (Instr Nat)) : RAt (pre ++ seg ++ post) pre.length seg := by
   induction seg generalizing pre with
@@ -77,66 +76,70 @@ theorem rat_embed (pre seg post : List (Instr Nat)) : RAt (pre ++ seg ++ post) p
     have := ih (pre ++ [i])
     simpa [List.append_assoc] using this
 
-/-- Where the lowered code of IR instruction `k` sits: at index `pre.length + offs ps k`. -/
+/-- Where the lowered code of IR instruction `k` sits: at index `pre.length + offs cf ps k`, with
+the guards for the facts `cf k`. -/
 theorem lowerGo_at (L : Layout) (off : Nat → Nat) :
-    ∀ (ps : Prog 32) (pre : List (Instr Nat)) (k : Nat) (i : WordDialect.Instr 32),
+    ∀ (ps : Prog 32) (cf : Nat → Facts) (pre : List (Instr Nat)) (k : Nat) (i : WordDialect.Instr 32),
       ps[k]? = some i →
-      RAt (pre ++ lowerGo L off pre.length ps) (pre.length + offs ps k)
-        (lowerInstr L (pre.length + offs ps k) off i) := by
+      RAt (pre ++ lowerGo L off cf pre.length ps) (pre.length + offs cf ps k)
+        (lowerInstr L (pre.length + offs cf ps k) off (cf k) i) := by
   intro ps
   induction ps with
-  | nil => intro pre k i h; simp at h
+  | nil => intro cf pre k i h; simp at h
   | cons j js ih =>
-    intro pre k i h
+    intro cf pre k i h
     cases k with
     | zero =>
       simp at h; subst h
       simp only [offs_zero, Nat.add_zero, lowerGo]
-      have := rat_embed pre (lowerInstr L pre.length off j) (lowerGo L off (pre.length + isize j) js)
+      have := rat_embed pre (lowerInstr L pre.length off (cf 0) j)
+        (lowerGo L off (fun j => cf (j + 1)) (pre.length + isize (cf 0) j) js)
       simpa [List.append_assoc] using this
     | succ k =>
       simp only [List.getElem?_cons_succ] at h
-      have := ih (pre ++ lowerInstr L pre.length off j) k i h
-      have hl : (pre ++ lowerInstr L pre.length off j).length = pre.length + isize j := by
+      have := ih (fun j => cf (j + 1)) (pre ++ lowerInstr L pre.length off (cf 0) j) k i h
+      have hl : (pre ++ lowerInstr L pre.length off (cf 0) j).length = pre.length + isize (cf 0) j := by
         simp [lowerInstr_length]
       rw [hl] at this
       simp only [lowerGo, offs_cons]
-      have e : pre.length + (isize j + offs js k) = pre.length + isize j + offs js k := by omega
+      have e : pre.length + (isize (cf 0) j + offs (fun j => cf (j + 1)) js k) =
+          pre.length + isize (cf 0) j + offs (fun j => cf (j + 1)) js k := by omega
       rw [e]
       simpa [List.append_assoc] using this
 
 theorem lowerProg_at (L : Layout) (p : Prog 32) (k : Nat) (i : WordDialect.Instr 32)
     (h : p[k]? = some i) :
-    RAt (lowerProg L p) (offs p k) (lowerInstr L (offs p k) (offs p) i) := by
-  have := lowerGo_at L (offs p) p [] k i h
+    RAt (lowerProg L p) (offs L.facts p k) (lowerInstr L (offs L.facts p k) (offs L.facts p) (L.facts k) i) := by
+  have := lowerGo_at L (offs L.facts p) p L.facts [] k i h
   simpa [lowerProg] using this
 
-/-- The final stub (bad-pc trap) sits at `offs p p.length`. -/
+/-- The final stub (bad-pc trap) sits at `offs cf p p.length`. -/
 theorem lowerGo_stub (L : Layout) (off : Nat → Nat) :
-    ∀ (ps : Prog 32) (pre : List (Instr Nat)),
-      RAt (pre ++ lowerGo L off pre.length ps) (pre.length + offs ps ps.length) [.exitTrap .badPc] := by
+    ∀ (ps : Prog 32) (cf : Nat → Facts) (pre : List (Instr Nat)),
+      RAt (pre ++ lowerGo L off cf pre.length ps) (pre.length + offs cf ps ps.length)
+        [.exitTrap .badPc] := by
   intro ps
   induction ps with
   | nil =>
-    intro pre
-    simp only [lowerGo, List.length_nil, offs, List.take_nil, List.map_nil, List.sum_nil,
-      Nat.add_zero]
+    intro cf pre
+    simp only [lowerGo, List.length_nil, offs_zero, Nat.add_zero]
     have := rat_embed pre [.exitTrap .badPc] []
     simpa using this
   | cons j js ih =>
-    intro pre
-    have := ih (pre ++ lowerInstr L pre.length off j)
-    have hl : (pre ++ lowerInstr L pre.length off j).length = pre.length + isize j := by
+    intro cf pre
+    have := ih (fun j => cf (j + 1)) (pre ++ lowerInstr L pre.length off (cf 0) j)
+    have hl : (pre ++ lowerInstr L pre.length off (cf 0) j).length = pre.length + isize (cf 0) j := by
       simp [lowerInstr_length]
     rw [hl] at this
     simp only [lowerGo, List.length_cons, offs_cons]
-    have e : pre.length + (isize j + offs js js.length) = pre.length + isize j + offs js js.length := by omega
+    have e : pre.length + (isize (cf 0) j + offs (fun j => cf (j + 1)) js js.length) =
+        pre.length + isize (cf 0) j + offs (fun j => cf (j + 1)) js js.length := by omega
     rw [e]
     simpa [List.append_assoc] using this
 
 theorem lowerProg_stub (L : Layout) (p : Prog 32) :
-    RAt (lowerProg L p) (offs p p.length) [.exitTrap .badPc] := by
-  have := lowerGo_stub L (offs p) p []
+    RAt (lowerProg L p) (offs L.facts p p.length) [.exitTrap .badPc] := by
+  have := lowerGo_stub L (offs L.facts p) p L.facts []
   simpa [lowerProg] using this
 
 end CM

backend/cortexm/CM/SimAux.lean

@@ -203,7 +203,7 @@ end Steps
 section Guards
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)} {L : Layout}
-  {base : Nat}
+  {base : Nat} {g : Facts}
 
 /-- The auxiliary-stack guard's comparison, in terms of its depth. -/
 theorem ovfA_cond (hg : Geom c) (hs : Rel0 c p s x) (hLal : L.aLim = ofN (c.aBase + 4)) :
@@ -305,32 +305,32 @@ end Guards
 section Ops
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 /-- Placement of the `tor` code. -/
-theorem xat_tor (hat : RAt code base (lowerInstr L base off .tor)) :
-    RAt code base (uf L 1 base) ∧ RAt code (base + 3) (ovfA L (base + 3)) ∧
-      RAt code (base + 6) [.load r0 Reg.r4 0, .addImm Reg.r4 4, .addImm Reg.r9 (-4),
+theorem xat_tor (hat : RAt code base (lowerInstr L base off g .tor)) :
+    RAt code base (uf L (need g 1) base) ∧ RAt code (base + ufSize (need g 1)) (ovfA L (base + ufSize (need g 1))) ∧
+      RAt code (base + ufSize (need g 1) + 3) [.load r0 Reg.r4 0, .addImm Reg.r4 4, .addImm Reg.r9 (-4),
         .store Reg.r9 0 r0] := by
-  have hat' : RAt code base (uf L 1 base ++ ovfA L (base + 3) ++
+  have hat' : RAt code base (uf L (need g 1) base ++ ovfA L (base + ufSize (need g 1)) ++
       [.load r0 Reg.r4 0, .addImm Reg.r4 4, .addImm Reg.r9 (-4), .store Reg.r9 0 r0]) := hat
   obtain ⟨hatuo, hatr⟩ := rat_append.mp hat'
   obtain ⟨hatuf, hato⟩ := rat_append.mp hatuo
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hato
-  have hl : (uf L 1 base ++ ovfA L (base + 3)).length = 6 := by simp [hufl, ovfA]
+  have hl : (uf L (need g 1) base ++ ovfA L (base + ufSize (need g 1))).length = ufSize (need g 1) + 3 := by simp [hufl, ovfA]
   rw [hl] at hatr
   exact ⟨hatuf, hato, hatr⟩
 
 theorem sim_tor_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hLal : L.aLim = ofN (c.aBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .tor))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .tor))
     {a : W} {d : List W} (hd : s.dstack = a :: d)
     (hfit : c.aBase + 4 * (s.astack.length + 1) ≤ c.aEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := d, astack := a :: s.astack } x' ∧
-      x'.pc = base + isize (.tor : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.tor : WordDialect.Instr 32) := by
   obtain ⟨hatuf, hato, f0, f1, f2, f3, _⟩ := xat_tor hat
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfA_pass hg hr1 hLal hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1' (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
@@ -343,39 +343,40 @@ theorem sim_tor_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hLal : L.aLim = ofN
     ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩
   rw [hax3] at hr4
   exact ⟨x4, (((hs1.trans hs1').trans hs2).trans hs3).trans hs4, hr4,
-    by simp [isize, ufSize]; omega⟩
+    by simp [isize]; omega⟩
 
 theorem sim_tor_ovf (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hLal : L.aLim = ofN (c.aBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .tor))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .tor))
     (hk : 1 ≤ s.dstack.length) (h : ¬ c.aBase + 4 * (s.astack.length + 1) ≤ c.aEnd) :
     RExec code x .overflow := by
   obtain ⟨hatuf, hato, _⟩ := xat_tor hat
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   exact RExec.of_steps hs1 (ovfA_trap hg hr1 hLal h hpc1 hato)
 
-/-- Placement of `emptyA L base ++ ovfD L (base + 3) ++ rest`. -/
+/-- Placement of `emptyA L base ++ ovf L g (base + 3) ++ rest`. -/
 theorem xat_take {rest : List (Instr Nat)}
-    (hat : RAt code base (emptyA L base ++ ovfD L (base + 3) ++ rest)) :
-    RAt code base (emptyA L base) ∧ RAt code (base + 3) (ovfD L (base + 3)) ∧
-      RAt code (base + 6) rest := by
+    (hat : RAt code base (emptyA L base ++ ovf L g (base + 3) ++ rest)) :
+    RAt code base (emptyA L base) ∧ RAt code (base + 3) (ovf L g (base + 3)) ∧
+      RAt code (base + 3 + ovfSize g) rest := by
   obtain ⟨hatuo, hatr⟩ := rat_append.mp hat
   obtain ⟨hate, hato⟩ := rat_append.mp hatuo
   have hel : (emptyA L base).length = 3 := rfl
   rw [hel] at hato
-  have hl : (emptyA L base ++ ovfD L (base + 3)).length = 6 := rfl
-  rw [hl] at hatr
+  have hl : (emptyA L base ++ ovf L g (base + 3)).length = 3 + ovfSize g := by
+    simp [ovf_length, emptyA]; omega
+  rw [hl, ← Nat.add_assoc] at hatr
   exact ⟨hate, hato, hatr⟩
 
 theorem sim_fromr_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .fromr))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .fromr))
     {a : W} {as : List W} (hd : s.astack = a :: as)
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: s.dstack, astack := as } x' ∧
-      x'.pc = base + isize (.fromr : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.fromr : WordDialect.Instr 32) := by
   obtain ⟨hate, hato, f0, f1, f2, f3, _⟩ := xat_take (L := L) (rest := [.load r0 Reg.r9 0,
     .addImm Reg.r9 4, .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa (by simp [hd]) hpc hate
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_aux_step (code := code) hr1' hd (rd := r0)
     (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, ho3⟩ := aux_drop (code := code) hr2 hd (fetch_cast f1 (by omega))
@@ -386,30 +387,30 @@ theorem sim_fromr_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = o
   exact ⟨x4, (((hs1.trans hs1').trans hs2).trans hs3).trans hs4, hr4, by simp [isize]; omega⟩
 
 theorem sim_fromr_trap (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .fromr)) (he : s.astack = []) :
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .fromr)) (he : s.astack = []) :
     RExec code x (.trapped .returnUnderflow) :=
   emptyA_trap hg hs hLa he hpc (xat_take (L := L) (rest := [.load r0 Reg.r9 0,
     .addImm Reg.r9 4, .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat).1
 
-theorem sim_fromr_ovf (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .fromr))
+theorem sim_fromr_ovf (hn : g.noOvf = false) (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .fromr))
     (hne : s.astack ≠ []) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
   obtain ⟨hate, hato, _⟩ := xat_take (L := L) (rest := [.load r0 Reg.r9 0,
     .addImm Reg.r9 4, .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa hne hpc hate
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 theorem sim_rfetch_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .rfetch))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .rfetch))
     {a : W} {as : List W} (hd : s.astack = a :: as)
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: s.dstack } x' ∧
-      x'.pc = base + isize (.rfetch : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.rfetch : WordDialect.Instr 32) := by
   obtain ⟨hate, hato, f0, f1, f2, _⟩ := xat_take (L := L) (rest := [.load r0 Reg.r9 0,
     .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa (by simp [hd]) hpc hate
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_aux_step (code := code) hr1' hd (rd := r0)
     (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, _⟩ := push_pair hg hr2 r0 (by decide) hfit
@@ -418,19 +419,19 @@ theorem sim_rfetch_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim =
   exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize]; omega⟩
 
 theorem sim_rfetch_trap (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .rfetch)) (he : s.astack = []) :
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .rfetch)) (he : s.astack = []) :
     RExec code x (.trapped .returnUnderflow) :=
   emptyA_trap hg hs hLa he hpc (xat_take (L := L) (rest := [.load r0 Reg.r9 0,
     .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat).1
 
-theorem sim_rfetch_ovf (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .rfetch))
+theorem sim_rfetch_ovf (hn : g.noOvf = false) (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .rfetch))
     (hne : s.astack ≠ []) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
   obtain ⟨hate, hato, _⟩ := xat_take (L := L) (rest := [.load r0 Reg.r9 0,
     .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa hne hpc hate
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 end Ops
 

backend/cortexm/CM/SimBin.lean

@@ -28,23 +28,23 @@ theorem scratch_ne (r : Reg) (h : r = r0 ∨ r = r1 ∨ r = r2 ∨ r = r3) :
   rcases h with rfl | rfl | rfl | rfl <;> decide
 
 theorem sim_bin_ok {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base : Nat} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
+    {L : Layout} {base : Nat} {g : Facts} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
     (hpc : x.pc = base) (mid : List (Instr Nat)) (rr : Reg)
     (hrr : rr = r0 ∨ rr = r1 ∨ rr = r2 ∨ rr = r3) (f : W → W → W)
     (hmid : MidSpec mid rr f) (hstr : ∀ i ∈ mid, i.straightR = true)
-    (hat : RAt code base (uf L 2 base ++
+    (hat : RAt code base (uf L (need g 2) base ++
       ([.load r1 r4 0, .load r0 r4 4] ++ mid ++ [.store r4 4 rr, .addImm r4 4])))
     {b a : W} {d : List W} (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := f a b :: d } x' ∧
-      x'.pc = base + 3 + (4 + mid.length) := by
+      x'.pc = base + ufSize (need g 2) + (4 + mid.length) := by
   have hk : 2 ≤ s.dstack.length := by simp [hd]
   obtain ⟨hatuf, hatrest⟩ := rat_append.mp hat
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatrest
   obtain ⟨hatA, hatB⟩ := rat_append.mp hatrest
   obtain ⟨hatLd, hatMid⟩ := rat_append.mp hatA
   obtain ⟨f0, f1, _⟩ := hatLd
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   have hrcx := scratch_ne r1 (by simp)
   have hrax := scratch_ne r0 (by simp)
   -- load r1, [r4 + 0]
@@ -53,14 +53,14 @@ theorem sim_bin_ok {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (
   have hst0 : RSteps code x1 x2 := RSteps.single (by
     rw [rstep_of_fetch (m := x1) (by rw [hpc1]; exact f0), e0, hx2])
   have hr2 : Rel0 c p s x2 := by rw [hx2]; exact mov_rel0 hr1 r1 hrcx b
-  have hpc2 : x2.pc = base + 3 + 1 := by simp [hx2, M.mov, M.setReg, M.adv, hpc1]
+  have hpc2 : x2.pc = base + ufSize (need g 2) + 1 := by simp [hx2, M.mov, M.setReg, M.adv, hpc1]
   -- load r0, [r4 + 4]
   have e1 := ld_stack hr2 (j := 1) (v := a) (by simp [hd]) r0 (disp := 4) (by simp)
   obtain ⟨x3, hx3⟩ : ∃ x3, x3 = x2.mov r0 a := ⟨_, rfl⟩
   have hst1 : RSteps code x2 x3 := RSteps.single (by
     rw [rstep_of_fetch (m := x2) (by rw [hpc2]; exact f1), e1, hx3])
   have hr3 : Rel0 c p s x3 := by rw [hx3]; exact mov_rel0 hr2 r0 hrax a
-  have hpc3 : x3.pc = base + 3 + 2 := by simp [hx3, M.mov, M.setReg, M.adv, hpc2]
+  have hpc3 : x3.pc = base + ufSize (need g 2) + 2 := by simp [hx3, M.mov, M.setReg, M.adv, hpc2]
   have hax : x3.regs r0 = a := by simp [hx3, M.mov, M.setReg, M.adv]
   have hcx : x3.regs r1 = b := by simp [hx3, hx2, M.mov, M.setReg, M.adv]
   -- mid
@@ -71,12 +71,12 @@ theorem sim_bin_ok {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (
   have hlen : 1 < s.dstack.length := by simp [hd]
   obtain ⟨mem', e2, hr5⟩ := st_stack hg hr4 (j := 1) hlen rr (disp := 4) (by simp)
   obtain ⟨st, adj, _⟩ := hatB
-  have hpc4' : x4.pc = base + 3 + (2 + mid.length) := by rw [hpc4, hpc3]; omega
+  have hpc4' : x4.pc = base + ufSize (need g 2) + (2 + mid.length) := by rw [hpc4, hpc3]; omega
   obtain ⟨x5, hx5⟩ : ∃ x5, x5 = ({ x4.adv with mem := mem' } : M) := ⟨_, rfl⟩
   have hst2 : RSteps code x4 x5 := RSteps.single (by
     rw [rstep_of_fetch (m := x4) (fetch_cast st (by rw [hpc4']; simp; omega)), e2, hx5])
   rw [← hx5] at hr5
-  have hpc5 : x5.pc = base + 3 + (2 + mid.length + 1) := by
+  have hpc5 : x5.pc = base + ufSize (need g 2) + (2 + mid.length + 1) := by
     simp [hx5, M.adv]; omega
   -- adjust r4
   have hlen5 : 1 ≤ ({ s with dstack := s.dstack.set 1 (x4.regs rr) } : State 32).dstack.length := by

backend/cortexm/CM/SimCtl.lean

@@ -14,19 +14,24 @@ namespace CM
 
 open Reg
 
-theorem offs_succ {p : Prog 32} {k : Nat} {i : WordDialect.Instr 32} (h : p[k]? = some i) :
-    offs p (k + 1) = offs p k + isize i := by
-  have hk : k < p.length := (List.getElem?_eq_some_iff.mp h).1
-  have hi : p[k] = i := (List.getElem?_eq_some_iff.mp h).2
-  simp [offs, List.take_succ, h, List.sum_append]
+theorem offs_succ (cf : Nat → Facts) {p : Prog 32} {k : Nat} {i : WordDialect.Instr 32}
+    (h : p[k]? = some i) : offs cf p (k + 1) = offs cf p k + isize (cf k) i := by
+  induction p generalizing cf k with
+  | nil => simp at h
+  | cons j js ih =>
+    cases k with
+    | zero => simp at h; subst h; simp [offs_cons, offs_zero]
+    | succ k =>
+      simp only [List.getElem?_cons_succ] at h
+      rw [offs_cons, offs_cons, ih (fun j => cf (j + 1)) h]; omega
 
 section Ctl
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 theorem sim_jmp_ok (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
-    (hat : RAt code base (lowerInstr L base off (.jmp t))) :
+    (hat : RAt code base (lowerInstr L base off g (.jmp t))) :
     ∃ x', RSteps code x x' ∧ Rel0 c p s x' ∧ x'.pc = off t := by
   have hat' : RAt code base [.jmp (off t)] := hat
   obtain ⟨f0, _⟩ := hat'
@@ -35,18 +40,18 @@ theorem sim_jmp_ok (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
 
 /-- `branch t`: both outcomes. -/
 theorem sim_branch_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) {t : Nat} (hat : RAt code base (lowerInstr L base off (.branch t)))
+    (hpc : x.pc = base) {t : Nat} (hat : RAt code base (lowerInstr L base off g (.branch t)))
     {cc : W} {d : List W} (hd : s.dstack = cc :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := d } x' ∧
-      x'.pc = (if Word.isTrue cc then off t else base + isize (.branch t : WordDialect.Instr 32)) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .addImm Reg.r4 4,
+      x'.pc = (if Word.isTrue cc then off t else base + isize g (.branch t : WordDialect.Instr 32)) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .addImm Reg.r4 4,
       .bnez r0 (off t)]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := cc)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, ho3⟩ := adj_step (code := code) hg hr2 (n := 1) (by simp [hd])
@@ -60,7 +65,7 @@ theorem sim_branch_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
       simp [exec, hax3, hc]
     refine ⟨x3.adv, ((hs1.trans hs2).trans hs3).trans (RSteps.single hst4),
       hr3.congr rfl rfl rfl rfl rfl rfl rfl, ?_⟩
-    simp [hc, Word.isTrue, M.adv, hpc3, isize, ufSize]; omega
+    simp [hc, Word.isTrue, M.adv, hpc3, isize]; omega
   · have hst4 : step code x3 = .next { x3 with pc := off t } := by
       rw [rstep_of_fetch (m := x3) (fetch_cast f2 (by omega))]
       simp [exec, hax3, hc]
@@ -69,7 +74,7 @@ theorem sim_branch_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
     simp [hc, Word.isTrue]
 
 theorem sim_halt (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .halt)) : RExec code x (.halted x) := by
+    (hat : RAt code base (lowerInstr L base off g .halt)) : RExec code x (.halted x) := by
   have hat' : RAt code base [.exitHalt] := hat
   obtain ⟨f0, _⟩ := hat'
   exact RExec.halt (by rw [rstep_of_fetch (by rw [hpc]; exact f0)]; rfl)
@@ -78,7 +83,7 @@ theorem sim_halt (hs : Rel0 c p s x) (hpc : x.pc = base)
 (`r8`) and writes `lr`. -/
 theorem sim_call_core (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
     (hat : RAt code base [.call (off t)])
-    (hret : base + 1 = offs p (s.pc + 1)) (hfitR : s.rstack.length + 2 ≤ c.rcap) :
+    (hret : base + 1 = offs c.facts p (s.pc + 1)) (hfitR : s.rstack.length + 2 ≤ c.rcap) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with rstack := (s.pc + 1) :: s.rstack } x' ∧
       x'.pc = off t := by
   obtain ⟨f0, _⟩ := hat
@@ -170,9 +175,9 @@ theorem sim_call_core (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t :
   · simp only [List.length_cons]; omega
 
 theorem sim_ret_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .ret)) {a : Nat} {rs : List Nat}
-    (hr : s.rstack = a :: rs) (hsz : offs p a < 2 ^ 32) :
-    ∃ x', RSteps code x x' ∧ Rel0 c p { s with rstack := rs } x' ∧ x'.pc = offs p a := by
+    (hat : RAt code base (lowerInstr L base off g .ret)) {a : Nat} {rs : List Nat}
+    (hr : s.rstack = a :: rs) (hsz : offs c.facts p a < 2 ^ 32) :
+    ∃ x', RSteps code x x' ∧ Rel0 c p { s with rstack := rs } x' ∧ x'.pc = offs c.facts p a := by
   have hat' : RAt code base [.bcc .ne r8 r7 (base + 2), .exitTrap .returnUnderflow, .ret] := hat
   obtain ⟨f0, f1, f3, _⟩ := hat'
   have hcapR := hs.capR
@@ -194,14 +199,14 @@ theorem sim_ret_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base)
   rw [hr] at hread
   simp only [List.length_cons, Nat.mul_zero, Nat.add_zero] at hread
   have hst3 : step code { x1 with pc := base + 2 } = .next { ((({ x1 with pc := base + 2 } : M).setReg
-      lr (ofN (offs p a))).setReg r8 (ofN (c.sp0 - 4 * rs.length))) with pc := offs p a } := by
+      lr (ofN (offs c.facts p a))).setReg r8 (ofN (c.sp0 - 4 * rs.length))) with pc := offs c.facts p a } := by
     rw [rstep_of_fetch (m := { x1 with pc := base + 2 }) f3]
     have hx1r : x1.regs r8 = ofN (c.sp0 - 4 * (rs.length + 1)) := hrsp
     have hx1m : x1.mem = x.mem := rfl
     have hadd : ofN (c.sp0 - 4 * (rs.length + 1)) + 4#32 = ofN (c.sp0 - 4 * rs.length) := by
       show ofN _ + ofN 4 = _
       rw [ofN_add]; congr 1; omega
-    have hv : (ofN (offs p a)).toNat = offs p a := by
+    have hv : (ofN (offs c.facts p a)).toNat = offs c.facts p a := by
       simp [ofN, BitVec.toNat_ofNat, Nat.mod_eq_of_lt hsz]
     simp only [exec]
     rw [hx1m, hx1r, hread]
@@ -230,7 +235,7 @@ theorem sim_ret_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base)
     omega
 
 theorem sim_ret_trap (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .ret)) (hr : s.rstack = []) :
+    (hat : RAt code base (lowerInstr L base off g .ret)) (hr : s.rstack = []) :
     RExec code x (.trapped .returnUnderflow) := by
   have hat' : RAt code base [.bcc .ne r8 r7 (base + 2), .exitTrap .returnUnderflow, .ret] := hat
   obtain ⟨f0, f1, _⟩ := hat'
@@ -241,8 +246,8 @@ theorem sim_ret_trap (hs : Rel0 c p s x) (hpc : x.pc = base)
 
 /-- `call t`: the return-stack guard, then the model's `call`. -/
 theorem sim_call_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
-    (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hat : RAt code base (lowerInstr L base off (.call t)))
-    (hret : base + isize (.call t : WordDialect.Instr 32) = offs p (s.pc + 1))
+    (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hat : RAt code base (lowerInstr L base off g (.call t)))
+    (hret : base + isize g (.call t : WordDialect.Instr 32) = offs c.facts p (s.pc + 1))
     (hfitR : s.rstack.length + 2 ≤ c.rcap) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with rstack := (s.pc + 1) :: s.rstack } x' ∧
       x'.pc = off t := by
@@ -255,7 +260,7 @@ theorem sim_call_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t : N
   exact ⟨x', hs1.trans hs', hr', hpc'⟩
 
 theorem sim_call_ovf (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
-    (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hat : RAt code base (lowerInstr L base off (.call t)))
+    (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hat : RAt code base (lowerInstr L base off g (.call t)))
     (h : ¬ s.rstack.length + 2 ≤ c.rcap) : RExec code x .overflow := by
   have hat' : RAt code base (ovfR L base ++ [.call (off t)]) := hat
   exact ovfR_trap hg hs hLr h hpc (rat_append.mp hat').1

backend/cortexm/CM/SimDiv.lean

@@ -18,7 +18,7 @@ open Reg
 section Div
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 /-- `Rel0` ignores scratch registers. -/
 theorem rel0_scratch (hs : Rel0 c p s x) {x' : M} (hm : x'.mem = x.mem)
@@ -50,32 +50,32 @@ theorem zg_trap (hb : x.regs r1 = 0#32) {t : Nat}
 /-- `div` and `sdiv` share their lowering shape: load both operands, trap on a zero divisor,
 divide into `r0`, store and pop. `g` is the Thumb-2 division (defined at zero), `f` the IR's. -/
 theorem sim_divop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (i : Instr Nat) (g f : W → W → W)
-    (hi : ∀ m : M, exec i m = .next (m.arith r0 (g (m.regs r0) (m.regs r1))))
-    (hfg : ∀ a b, b ≠ 0#32 → g a b = f a b)
-    (hat : RAt code base (uf L 2 base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .bnez r1 (base + ufSize 2 + 4), .exitTrap .divideByZero, i, .store Reg.r4 4 r0,
+    (hpc : x.pc = base) (i : Instr Nat) (gf f : W → W → W)
+    (hi : ∀ m : M, exec i m = .next (m.arith r0 (gf (m.regs r0) (m.regs r1))))
+    (hfg : ∀ a b, b ≠ 0#32 → gf a b = f a b)
+    (hat : RAt code base (uf L (need g 2) base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .bnez r1 (base + ufSize (need g 2) + 4), .exitTrap .divideByZero, i, .store Reg.r4 4 r0,
       .addImm Reg.r4 4]))
     {a b : W} {d : List W} (hd : s.dstack = b :: a :: d) (hb : b ≠ 0#32) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := f a b :: d } x' ∧
-      x'.pc = base + (ufSize 2 + 7) := by
+      x'.pc = base + (ufSize (need g 2) + 7) := by
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, f6, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := b)
     (by simp [hd]) (rd := r1) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 4) (by simp) (fetch_cast f1 (by omega))
   have hcx3 : x3.regs r1 = b := by rw [ho3 r1 (by decide), hv2]
   obtain ⟨x4, hs4, hr4, hpc4, hreg4, hm4⟩ := zg_pass (code := code) hr3 hcx3 hb
-    (t := base + ufSize 2 + 4) (by simp [ufSize]; omega)
+    (t := base + ufSize (need g 2) + 4) (by omega)
     ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩
   have hax4 : x4.regs r0 = a := by rw [hreg4, hv3]
   have hcx4 : x4.regs r1 = b := by rw [hreg4, hcx3]
-  let x5 := x4.arith r0 (g (x4.regs r0) (x4.regs r1))
+  let x5 := x4.arith r0 (gf (x4.regs r0) (x4.regs r1))
   have hst5 : step code x4 = .next x5 := by rw [rstep_of_fetch (fetch_cast f4 (by omega)), hi]
   have hr5 : Rel0 c p s x5 := arith_rel0 hr4 r0 (scratch_ne r0 (by simp)) _
   have hax5 : x5.regs r0 = f a b := by simp [x5, M.arith, M.setReg, hax4, hcx4, hfg a b hb]
@@ -90,19 +90,19 @@ theorem sim_divop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x
   rw [e] at hr7'
   exact ⟨x7, ((((hs1.trans hs2).trans hs3).trans hs4).trans
     ((RSteps.single hst5).trans (hs6.trans hs7))), hr7', by
-      simp [x5, M.arith, ufSize] at hpc7 hpc6 ⊢; omega⟩
+      simp [x5, M.arith] at hpc7 hpc6 ⊢; omega⟩
 
 theorem sim_divop_zero (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
     (hpc : x.pc = base) (rest : List (Instr Nat))
-    (hat : RAt code base (uf L 2 base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .bnez r1 (base + ufSize 2 + 4), .exitTrap .divideByZero] ++ rest)))
+    (hat : RAt code base (uf L (need g 2) base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .bnez r1 (base + ufSize (need g 2) + 4), .exitTrap .divideByZero] ++ rest)))
     {a : W} {d : List W} (hd : s.dstack = 0#32 :: a :: d) : RExec code x (.trapped .divideByZero) := by
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := 0#32)
     (by simp [hd]) (rd := r1) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := a)
@@ -112,46 +112,46 @@ theorem sim_divop_zero (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
     ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩)
 
 theorem sim_div_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .div)) {a b : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .div)) {a b : W} {d : List W}
     (hd : s.dstack = b :: a :: d) (hb : b ≠ 0#32) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a.udiv b :: d } x' ∧
-      x'.pc = base + isize (.div : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.div : WordDialect.Instr 32) :=
   sim_divop_ok hg hL hs hpc (.divu r0 r0 r1) divu BitVec.udiv (fun _ => rfl)
     (fun a b h => by simp [divu, h]) hat hd hb
 
 theorem sim_div_zero (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .div)) {a : W} {d : List W}
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .div)) {a : W} {d : List W}
     (hd : s.dstack = 0#32 :: a :: d) : RExec code x (.trapped .divideByZero) :=
   sim_divop_zero hg hL hs hpc [.divu r0 r0 r1, .store Reg.r4 4 r0, .addImm Reg.r4 4] hat hd
 
 theorem sim_sdiv_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .sdiv)) {a b : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .sdiv)) {a b : W} {d : List W}
     (hd : s.dstack = b :: a :: d) (hb : b ≠ 0#32) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a.sdiv b :: d } x' ∧
-      x'.pc = base + isize (.sdiv : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.sdiv : WordDialect.Instr 32) :=
   sim_divop_ok hg hL hs hpc (.div r0 r0 r1) divs BitVec.sdiv (fun _ => rfl)
     (fun a b h => by simp [divs, h]) hat hd hb
 
 theorem sim_sdiv_zero (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .sdiv)) {a : W} {d : List W}
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .sdiv)) {a : W} {d : List W}
     (hd : s.dstack = 0#32 :: a :: d) : RExec code x (.trapped .divideByZero) :=
   sim_divop_zero hg hL hs hpc [.div r0 r0 r1, .store Reg.r4 4 r0, .addImm Reg.r4 4] hat hd
 
 theorem sim_select_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .select)) {cc y v : W}
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .select)) {cc y v : W}
     {d : List W} (hd : s.dstack = cc :: y :: v :: d) :
     ∃ x', RSteps code x x' ∧
       Rel0 c p { s with dstack := (if Word.isTrue cc then v else y) :: d } x' ∧
-      x'.pc = base + isize (.select : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 3 base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .load r3 Reg.r4 8, .beqz r1 (base + ufSize 3 + 5), .movRR r0 r3, .store Reg.r4 8 r0,
+      x'.pc = base + isize g (.select : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 3) base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .load r3 Reg.r4 8, .beqz r1 (base + ufSize (need g 3) + 5), .movRR r0 r3, .store Reg.r4 8 r0,
       .addImm Reg.r4 8]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 3 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 3) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, f6, _⟩ := hatr
   have hk : 3 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := cc)
     (by simp [hd]) (rd := r1) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := y)
@@ -160,13 +160,13 @@ theorem sim_select_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
     (by simp [hd]) (rd := r3) (by simp) (disp := 8) (by simp) (fetch_cast f2 (by omega))
   have hcx4 : x4.regs r1 = cc := by rw [ho4 r1 (by decide), ho3 r1 (by decide), hv2]
   have hax4 : x4.regs r0 = y := by rw [ho4 r0 (by decide), hv3]
-  -- after the branch (and the `mv` when `cc ≠ 0`), `r0` holds the result at `base + 3 + 5`
+  -- after the branch (and the `mv` when `cc ≠ 0`), `r0` holds the result at `base + ufSize (need g 3) + 5`
   obtain ⟨x6, hs6, hr6, hpc6, hval⟩ : ∃ x6, RSteps code x4 x6 ∧ Rel0 c p s x6 ∧
-      x6.pc = base + 3 + 5 ∧ x6.regs r0 = (if Word.isTrue cc then v else y) := by
+      x6.pc = base + ufSize (need g 3) + 5 ∧ x6.regs r0 = (if Word.isTrue cc then v else y) := by
     by_cases hc : cc = 0#32
-    · have hst : step code x4 = .next { x4 with pc := base + ufSize 3 + 5 } := by
+    · have hst : step code x4 = .next { x4 with pc := base + ufSize (need g 3) + 5 } := by
         rw [rstep_of_fetch (m := x4) (fetch_cast f3 (by omega))]; simp [exec, hcx4, hc]
-      refine ⟨_, RSteps.single hst, hr4.congr rfl rfl rfl rfl rfl rfl rfl, by simp [ufSize], ?_⟩
+      refine ⟨_, RSteps.single hst, hr4.congr rfl rfl rfl rfl rfl rfl rfl, rfl, ?_⟩
       simp [hax4, Word.isTrue, hc]
     · have hst : step code x4 = .next x4.adv := by
         rw [rstep_of_fetch (m := x4) (fetch_cast f3 (by omega))]; simp [exec, hcx4, hc]
@@ -189,24 +189,24 @@ theorem sim_select_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
     simp [hd, hval]
   rw [e] at hr8'
   exact ⟨x8, (((((hs1.trans hs2).trans hs3).trans hs4).trans hs6).trans hs7).trans hs8, hr8',
-    by simp [isize, ufSize]; omega⟩
+    by simp [isize]; omega⟩
 
 /-- `cmp c`: `r2 := 1`, then `bcc c` skips `r2 := 0` exactly when the IR comparison holds. -/
 theorem sim_cmp_ok (cd : WordDialect.Cond) (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off (.cmp cd)))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g (.cmp cd)))
     {b a : W} {d : List W} (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧
       Rel0 c p { s with dstack := Word.ofBool (cd.eval a b) :: d } x' ∧
-      x'.pc = base + isize (.cmp cd : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 2 base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .movImm r2 1#32, .bcc cd r0 r1 (base + ufSize 2 + 5), .movImm r2 0#32, .store Reg.r4 4 r2,
+      x'.pc = base + isize g (.cmp cd : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 2) base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .movImm r2 1#32, .bcc cd r0 r1 (base + ufSize (need g 2) + 5), .movImm r2 0#32, .store Reg.r4 4 r2,
       .addImm Reg.r4 4]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, f6, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := b)
     (by simp [hd]) (rd := r1) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := a)
@@ -217,11 +217,11 @@ theorem sim_cmp_ok (cd : WordDialect.Cond) (hg : Geom c) (hL : L.dEnd = ofN c.dE
   have hax4 : x4.regs r0 = a := by rw [ho4 r0 (by decide), hv3]
   have hcx4 : x4.regs r1 = b := by rw [ho4 r1 (by decide), hcx3]
   obtain ⟨x6, hs6, hr6, hpc6, hval⟩ : ∃ x6, RSteps code x4 x6 ∧ Rel0 c p s x6 ∧
-      x6.pc = base + 3 + 5 ∧ x6.regs r2 = Word.ofBool (cd.eval a b) := by
+      x6.pc = base + ufSize (need g 2) + 5 ∧ x6.regs r2 = Word.ofBool (cd.eval a b) := by
     by_cases hc : cd.eval a b = true
-    · have hst : step code x4 = .next { x4 with pc := base + ufSize 2 + 5 } := by
+    · have hst : step code x4 = .next { x4 with pc := base + ufSize (need g 2) + 5 } := by
         rw [rstep_of_fetch (m := x4) (fetch_cast f3 (by omega))]; simp [exec, hax4, hcx4, hc]
-      refine ⟨_, RSteps.single hst, hr4.congr rfl rfl rfl rfl rfl rfl rfl, by simp [ufSize], ?_⟩
+      refine ⟨_, RSteps.single hst, hr4.congr rfl rfl rfl rfl rfl rfl rfl, rfl, ?_⟩
       simp [hv4, hc, Word.ofBool]
     · have hc' : cd.eval a b = false := by simpa using hc
       have hst : step code x4 = .next x4.adv := by
@@ -242,7 +242,7 @@ theorem sim_cmp_ok (cd : WordDialect.Cond) (hg : Geom c) (hL : L.dEnd = ofN c.dE
     simp [hd, hval]
   rw [e] at hr8'
   exact ⟨x8, (((((hs1.trans hs2).trans hs3).trans hs4).trans hs6).trans hs7).trans hs8, hr8',
-    by simp [isize, ufSize]; omega⟩
+    by simp [isize]; omega⟩
 
 end Div
 

backend/cortexm/CM/SimMemOps.lean

@@ -16,7 +16,7 @@ open Reg
 section Ops
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 theorem ult_memSize {a : W} {n : Nat} (hn : n < 2 ^ 32) :
     a.ult (BitVec.ofNat 32 n) = decide (a.toNat < n) := by
@@ -65,42 +65,42 @@ theorem addr_trap (hs : Rel0 c p s x) {rt : Reg} (hrt : rt = r1 ∨ rt = r2) {n
 
 theorem sim_push_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {r : Nat}
     (hr : r < c.nregs) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hat : RAt code base (lowerInstr L base off (.push r)))
+    (hat : RAt code base (lowerInstr L base off g (.push r)))
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := s.regs r :: s.dstack } x' ∧
-      x'.pc = base + isize (.push r : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.push r : WordDialect.Instr 32) := by
   obtain ⟨hato, f0, f1, f2⟩ := xat_ovf3 (L := L) (by exact hat)
-  obtain ⟨x0, hs0, hr0, hpc0, _, _⟩ := ovfD_pass hg hs hLd hfit hpc hato
+  obtain ⟨x0, hs0, hr0, hpc0, _, _⟩ := ovfG_pass hg hs hLd hfit hpc hato
   have hst : step code x0 = .next (x0.mov r0 (s.regs r)) := by
     rw [rstep_of_fetch (by rw [hpc0]; exact f0), ld_reg hr0 hr r0 rfl]
   have hr1 : Rel0 c p s (x0.mov r0 (s.regs r)) := mov_rel0 hr0 r0 (scratch_ne r0 (by simp)) _
-  have hpc1 : (x0.mov r0 (s.regs r)).pc = base + 3 + 1 := by simp [M.mov, M.setReg, M.adv, hpc0]
+  have hpc1 : (x0.mov r0 (s.regs r)).pc = base + ovfSize g + 1 := by simp [M.mov, M.setReg, M.adv, hpc0]
   obtain ⟨x2, hs2, hr2, hpc2, _⟩ := push_pair hg hr1 r0 (by decide) hfit
     ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), trivial⟩
   have hv : (x0.mov r0 (s.regs r)).regs r0 = s.regs r := by simp [M.mov, M.setReg, M.adv]
   rw [hv] at hr2
   exact ⟨x2, (hs0.trans (RSteps.single hst)).trans hs2, hr2, by simp [isize]; omega⟩
 
-theorem sim_push_ovf (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {r : Nat}
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.push r)))
+theorem sim_push_ovf (hn : g.noOvf = false) (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {r : Nat}
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.push r)))
     (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) : RExec code x .overflow := by
   obtain ⟨hato, _⟩ := xat_ovf3 (L := L) (by exact hat)
-  exact ovfD_trap hg hs hLd h hpc hato
+  exact ovfG_trap hn hg hs hLd h hpc hato
 
 theorem sim_pop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    {r : Nat} (hr : r < c.nregs) (hat : RAt code base (lowerInstr L base off (.pop r)))
+    {r : Nat} (hr : r < c.nregs) (hat : RAt code base (lowerInstr L base off g (.pop r)))
     {a : W} {d : List W} (hd : s.dstack = a :: d) :
     ∃ x', RSteps code x x' ∧
       Rel0 c p { s with dstack := d, regs := State.setReg s.regs r a } x' ∧
-      x'.pc = base + isize (.pop r : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .addImm Reg.r4 4,
+      x'.pc = base + isize g (.pop r : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .addImm Reg.r4 4,
       .store Reg.r5 (4 * (r : Int)) r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, ho3⟩ := adj_step (code := code) hg hr2 (n := 1) (by simp [hd])
@@ -114,18 +114,18 @@ theorem sim_pop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
   have e : s.dstack.drop 1 = d := by simp [hd]
   rw [e, hax3] at hr4'
   exact ⟨_, ((hs1.trans hs2).trans hs3).trans (RSteps.single hst4), hr4',
-    by simp [M.adv, isize, ufSize]; omega⟩
+    by simp [M.adv, isize]; omega⟩
 
 theorem sim_load_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .load))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .load))
     {a v : W} {d : List W} (hd : s.dstack = a :: d) (hv : s.mem.read? a = some v) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := v :: d } x' ∧
-      x'.pc = base + isize (.load : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize),
-      .bcc .ult r0 r1 (base + ufSize 1 + 4), .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r6,
+      x'.pc = base + isize g (.load : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize),
+      .bcc .ult r0 r1 (base + ufSize (need g 1) + 4), .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r6,
       .load r0 r0 0, .store Reg.r4 0 r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, f6, f7, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
@@ -135,11 +135,11 @@ theorem sim_load_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize =
     have := hs.irvalid a
     rw [hvv] at this
     simpa using this.symm
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, hm2⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hax3, ho3, hm3⟩ := addr_pass (code := code) hr2 (rt := r1) (by simp)
-    (n := c.M) hMlt (t := base + ufSize 1 + 4) (by simp [ufSize]; omega) hv2 hlt (by
+    (n := c.M) hMlt (t := base + ufSize (need g 1) + 4) (by omega) hv2 hlt (by
       rw [← hMs]
       refine ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩)
   obtain ⟨x4, hs4, hr4, hpc4, hax4, _, _⟩ := idx_steps hr3 hax3
@@ -153,17 +153,17 @@ theorem sim_load_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize =
     simp [hd, M.mov, M.setReg, M.adv]
   rw [e] at hr6
   exact ⟨x6, ((((hs1.trans hs2).trans hs3).trans hs4).trans (RSteps.single hst5)).trans hs6, hr6,
-    by simp [M.mov, M.setReg, M.adv, isize, ufSize] at *; omega⟩
+    by simp [M.mov, M.setReg, M.adv, isize] at *; omega⟩
 
 theorem sim_load_trap (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .load))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .load))
     {a : W} {d : List W} (hd : s.dstack = a :: d) (hv : s.mem.read? a = none) :
     RExec code x (.trapped .badAddress) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize),
-      .bcc .ult r0 r1 (base + ufSize 1 + 4), .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r6,
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize),
+      .bcc .ult r0 r1 (base + ufSize (need g 1) + 4), .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r6,
       .load r0 r0 0, .store Reg.r4 0 r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
@@ -173,25 +173,25 @@ theorem sim_load_trap (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize
     have := hs.irvalid a
     rw [hvv] at this
     simpa using this
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, hm2⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   exact RExec.of_steps (hs1.trans hs2) (addr_trap (code := code) hr2 (rt := r1) (by simp)
-    (n := c.M) hMlt (t := base + ufSize 1 + 4) (by simp [ufSize]; omega) hv2 hge (by
+    (n := c.M) hMlt (t := base + ufSize (need g 1) + 4) (by omega) hv2 hge (by
       rw [← hMs]
       refine ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩))
 
 theorem sim_store_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .store))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .store))
     {a v : W} {d : List W} (hd : s.dstack = a :: v :: d) {m : Memory 32}
     (hw : s.mem.write? a v = some m) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := d, mem := m } x' ∧
-      x'.pc = base + isize (.store : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 2 base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
-      .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (base + ufSize 2 + 5),
+      x'.pc = base + isize g (.store : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 2) base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
+      .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (base + ufSize (need g 2) + 5),
       .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r6, .store r0 0 r1, .addImm Reg.r4 8]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, f6, f7, f8, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
@@ -204,14 +204,14 @@ theorem sim_store_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize =
     have := hs.irvalid a
     rw [hv] at this
     simpa using this.symm
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, hm2⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, hm3⟩ := ld_step (code := code) hr2 (j := 1) (v := v)
     (by simp [hd]) (rd := r1) (by simp) (disp := 4) (by simp) (fetch_cast f1 (by omega))
   have hax3 : x3.regs r0 = a := by rw [ho3 r0 (by decide), hv2]
   obtain ⟨x4, hs4, hr4, hpc4, hax4, ho4, hm4⟩ := addr_pass (code := code) hr3 (rt := r2) (by simp)
-    (n := c.M) hMlt (t := base + ufSize 2 + 5) (by simp [ufSize]; omega) hax3 hlt (by
+    (n := c.M) hMlt (t := base + ufSize (need g 2) + 5) (by omega) hax3 hlt (by
       rw [← hMs]
       refine ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), fetch_cast f4 (by omega), trivial⟩)
   have hcx4 : x4.regs r1 = v := by rw [ho4 r1 (by decide), hv3]
@@ -229,17 +229,17 @@ theorem sim_store_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize =
         = { s with dstack := d, mem := m } := by simp [hd]
     rw [← this]; exact hr7
   exact ⟨x7, (((((hs1.trans hs2).trans hs3).trans hs4).trans hs5).trans (RSteps.single hst6)).trans hs7,
-    hr7', by simp [M.adv, isize, ufSize] at *; omega⟩
+    hr7', by simp [M.adv, isize] at *; omega⟩
 
 theorem sim_store_trap (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .store))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .store))
     {a v : W} {d : List W} (hd : s.dstack = a :: v :: d) (hw : s.mem.write? a v = none) :
     RExec code x (.trapped .badAddress) := by
-  have hat' : RAt code base (uf L 2 base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
-      .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (base + ufSize 2 + 5),
+  have hat' : RAt code base (uf L (need g 2) base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
+      .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (base + ufSize (need g 2) + 5),
       .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r6, .store r0 0 r1, .addImm Reg.r4 8]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
@@ -249,14 +249,14 @@ theorem sim_store_trap (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize
     have := hs.irvalid a
     rw [hvv] at this
     simpa using this
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, hm2⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, hm3⟩ := ld_step (code := code) hr2 (j := 1) (v := v)
     (by simp [hd]) (rd := r1) (by simp) (disp := 4) (by simp) (fetch_cast f1 (by omega))
   have hax3 : x3.regs r0 = a := by rw [ho3 r0 (by decide), hv2]
   exact RExec.of_steps ((hs1.trans hs2).trans hs3) (addr_trap (code := code) hr3 (rt := r2)
-    (by simp) (n := c.M) hMlt (t := base + ufSize 2 + 5) (by simp [ufSize]; omega) hax3 hge (by
+    (by simp) (n := c.M) hMlt (t := base + ufSize (need g 2) + 5) (by omega) hax3 hge (by
       rw [← hMs]
       refine ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), fetch_cast f4 (by omega), trivial⟩))
 

backend/cortexm/CM/SimOps.lean

@@ -16,40 +16,40 @@ open Reg
 
 /-- Operand-count trap: any lowering that starts with `uf n` exits with `stackUnderflow`. -/
 theorem sim_uf_trap {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base n : Nat} {rest : List (Instr Nat)} (hg : Geom c) (hs : Rel0 c p s x)
-    (hL : L.dEnd = ofN c.dEnd) (hn : 0 < n) (hn3 : n ≤ 3) (hk : s.dstack.length < n)
-    (hpc : x.pc = base) (hat : RAt code base (uf L n base ++ rest)) :
+    {L : Layout} {base n : Nat} {g : Facts} {rest : List (Instr Nat)} (hg : Geom c) (hs : Rel0 c p s x)
+    (hL : L.dEnd = ofN c.dEnd) (hn : 0 < n) (hn3 : n ≤ 3) (hgd : g.lo ≤ s.dstack.length)
+    (hk : s.dstack.length < n) (hpc : x.pc = base) (hat : RAt code base (uf L (need g n) base ++ rest)) :
     RExec code x (.trapped .stackUnderflow) :=
-  uf_trap hg hs hL hn hn3 hk hpc (rat_append.mp hat).1
+  uf_trap hg hs hL hn hn3 hgd hk hpc (rat_append.mp hat).1
 
 macro "mid_tac" : tactic =>
   `(tactic| (intro m a b ha hb
              simp [rseq, exec, M.arith, M.mov, M.setReg, M.adv, ha, hb, MidSpec]))
 
 theorem sim_bin_instr {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base : Nat} {off : Nat → Nat} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
+    {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
     (hs : Rel0 c p s x) (hpc : x.pc = base) (i : WordDialect.Instr 32) (mid : List (Instr Nat))
     (rr : Reg) (hrr : rr = r0 ∨ rr = r1 ∨ rr = r2 ∨ rr = r3) (f : W → W → W)
     (hmid : MidSpec mid rr f) (hstr : ∀ j ∈ mid, j.straightR = true)
-    (hlow : lowerInstr L base off i = uf L 2 base ++
+    (hlow : lowerInstr L base off g i = uf L (need g 2) base ++
       ([.load r1 r4 0, .load r0 r4 4] ++ mid ++ [.store r4 4 rr, .addImm r4 4]))
-    (hsize : isize i = 3 + (4 + mid.length))
-    (hat : RAt code base (lowerInstr L base off i)) {b a : W} {d : List W}
+    (hsize : isize g i = ufSize (need g 2) + (4 + mid.length))
+    (hat : RAt code base (lowerInstr L base off g i)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := f a b :: d } x' ∧
-      x'.pc = base + isize i := by
+      x'.pc = base + isize g i := by
   rw [hlow] at hat
   obtain ⟨x', h1, h2, h3⟩ := sim_bin_ok hg hL hs hpc mid rr hrr f hmid hstr hat hd
   exact ⟨x', h1, h2, by rw [h3, hsize]; omega⟩
 
 theorem sim_uf2_trap {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base : Nat} {off : Nat → Nat} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
+    {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
     (hs : Rel0 c p s x) (hpc : x.pc = base) (i : WordDialect.Instr 32) (rest : List (Instr Nat))
-    (hlow : lowerInstr L base off i = uf L 2 base ++ rest)
-    (hat : RAt code base (lowerInstr L base off i)) (hk : s.dstack.length < 2) :
-    RExec code x (.trapped .stackUnderflow) := by
+    (hlow : lowerInstr L base off g i = uf L (need g 2) base ++ rest)
+    (hat : RAt code base (lowerInstr L base off g i)) (hgd : g.lo ≤ s.dstack.length)
+    (hk : s.dstack.length < 2) : RExec code x (.trapped .stackUnderflow) := by
   rw [hlow] at hat
-  exact sim_uf_trap hg hs hL (by decide) (by decide) hk hpc hat
+  exact sim_uf_trap hg hs hL (by decide) (by decide) hgd hk hpc hat
 
 /-! ### Middle computations -/
 
@@ -155,87 +155,87 @@ theorem midspec_rotr : MidSpec [.ror r0 r1] r0 Word.rotr := by
 
 section Ops
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)} {L : Layout}
-  {base : Nat} {off : Nat → Nat}
+  {base : Nat} {off : Nat → Nat} {g : Facts}
 
 theorem sim_add_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .add)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .add)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a + b) :: d } x' ∧
-      x'.pc = base + isize (.add : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.add : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .add [.add r0 r1] r0 (by simp) (· + ·) midspec_add
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_sub_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .sub)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .sub)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a - b) :: d } x' ∧
-      x'.pc = base + isize (.sub : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.sub : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .sub [.sub r0 r1] r0 (by simp) (· - ·) midspec_sub
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_mul_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .mul)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .mul)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a * b) :: d } x' ∧
-      x'.pc = base + isize (.mul : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.mul : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .mul [.mul r0 r1] r0 (by simp) (· * ·) midspec_mul
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_and_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .and)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .and)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a &&& b) :: d } x' ∧
-      x'.pc = base + isize (.and : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.and : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .and [.and r0 r1] r0 (by simp) (· &&& ·) midspec_and
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_or_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .or)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .or)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a ||| b) :: d } x' ∧
-      x'.pc = base + isize (.or : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.or : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .or [.or r0 r1] r0 (by simp) (· ||| ·) midspec_or
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_xor_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .xor)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .xor)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a ^^^ b) :: d } x' ∧
-      x'.pc = base + isize (.xor : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.xor : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .xor [.xor r0 r1] r0 (by simp) (· ^^^ ·) midspec_xor
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_shl_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .shl)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .shl)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := Word.shl a b :: d } x' ∧
-      x'.pc = base + isize (.shl : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.shl : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .shl _ r0 (by simp) Word.shl midspec_shl
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_shr_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .shr)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .shr)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := Word.shr a b :: d } x' ∧
-      x'.pc = base + isize (.shr : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.shr : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .shr _ r0 (by simp) Word.shr midspec_shr
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_rotl_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .rotl)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .rotl)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := Word.rotl a b :: d } x' ∧
-      x'.pc = base + isize (.rotl : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.rotl : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .rotl _ r0 (by simp) Word.rotl midspec_rotl
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_rotr_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .rotr)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .rotr)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := Word.rotr a b :: d } x' ∧
-      x'.pc = base + isize (.rotr : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.rotr : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .rotr _ r0 (by simp) Word.rotr midspec_rotr
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 end Ops
 

backend/cortexm/CM/SimStack.lean

@@ -64,51 +64,53 @@ theorem not_step (hs : Rel0 c p s x) (hf : code[x.pc]? = some (.not r0)) :
 
 end Steps
 
-/-- Placement of `ovfD L base ++ [i0, i1, i2]`. -/
-theorem xat_ovf3 {code : List (Instr Nat)} {L : Layout} {base : Nat} {i0 i1 i2 : Instr Nat}
-    (hat : RAt code base (ovfD L base ++ [i0, i1, i2])) :
-    RAt code base (ovfD L base) ∧ code[base + 3]? = some i0 ∧ code[base + 3 + 1]? = some i1 ∧
-      code[base + 3 + 1 + 1]? = some i2 := by
+/-- Placement of `ovf L g base ++ [i0, i1, i2]`. -/
+theorem xat_ovf3 {code : List (Instr Nat)} {L : Layout} {g : Facts} {base : Nat}
+    {i0 i1 i2 : Instr Nat} (hat : RAt code base (ovf L g base ++ [i0, i1, i2])) :
+    RAt code base (ovf L g base) ∧ code[base + ovfSize g]? = some i0 ∧
+      code[base + ovfSize g + 1]? = some i1 ∧ code[base + ovfSize g + 1 + 1]? = some i2 := by
   obtain ⟨hato, hatr⟩ := rat_append.mp hat
-  have hl : (ovfD L base).length = 3 := rfl
-  rw [hl] at hatr
+  rw [ovf_length] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
   exact ⟨hato, f0, f1, f2⟩
 
-/-- Placement of `uf L n base ++ ovfD L (base + ufSize n) ++ [i0, i1, i2]`. -/
-theorem xat_uf_ovf {code : List (Instr Nat)} {L : Layout} {base n : Nat} (hn : 0 < n)
+/-- Placement of `uf L n base ++ ovf L g (base + ufSize n) ++ [i0, i1, i2]`. -/
+theorem xat_uf_ovf {code : List (Instr Nat)} {L : Layout} {g : Facts} {base n : Nat}
     {i0 i1 i2 : Instr Nat} {rest : List (Instr Nat)} (hrest : rest = [i0, i1, i2])
-    (hat : RAt code base (uf L n base ++ ovfD L (base + ufSize n) ++ rest)) :
-    RAt code base (uf L n base) ∧ RAt code (base + 3) (ovfD L (base + 3)) ∧
-      code[base + 6]? = some i0 ∧ code[base + 6 + 1]? = some i1 ∧ code[base + 6 + 1 + 1]? = some i2 := by
+    (hat : RAt code base (uf L n base ++ ovf L g (base + ufSize n) ++ rest)) :
+    RAt code base (uf L n base) ∧ RAt code (base + ufSize n) (ovf L g (base + ufSize n)) ∧
+      code[base + ufSize n + ovfSize g]? = some i0 ∧
+      code[base + ufSize n + ovfSize g + 1]? = some i1 ∧
+      code[base + ufSize n + ovfSize g + 1 + 1]? = some i2 := by
   subst hrest
-  rw [ufSize_pos hn] at hat
   obtain ⟨hatuo, hatr⟩ := rat_append.mp hat
   obtain ⟨hatuf, hato⟩ := rat_append.mp hatuo
-  have hufl : (uf L n base).length = 3 := by rw [uf_eq L hn]; rfl
+  have hufl := uf_length L n base
   rw [hufl] at hato
-  have hl : (uf L n base ++ ovfD L (base + 3)).length = 6 := by simp [hufl, ovfD]
+  have hl : (uf L n base ++ ovf L g (base + ufSize n)).length = ufSize n + ovfSize g := by
+    simp [hufl, ovf_length]
   rw [hl] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
-  exact ⟨hatuf, hato, f0, f1, f2⟩
+  exact ⟨hatuf, hato, by simpa [Nat.add_assoc] using f0, by simpa [Nat.add_assoc] using f1,
+    by simpa [Nat.add_assoc] using f2⟩
 
 section Ops
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 theorem sim_not_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .not)) {a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .not)) {a : W} {d : List W}
     (hd : s.dstack = a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (~~~a) :: d } x' ∧
-      x'.pc = base + isize (.not : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .not r0, .store Reg.r4 0 r0]) := hat
+      x'.pc = base + isize g (.not : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .not r0, .store Reg.r4 0 r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3⟩ := not_step (code := code) hr2 (fetch_cast f1 (by omega))
@@ -116,57 +118,57 @@ theorem sim_not_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
     (rs := r0) (disp := 0) (by simp) (fetch_cast f2 (by omega))
   have e : s.dstack.set 0 (x3.regs r0) = (~~~a) :: d := by simp [hd, hv3, hv2]
   rw [e] at hr4
-  exact ⟨x4, ((hs1.trans hs2).trans hs3).trans hs4, hr4, by simp [isize, ufSize]; omega⟩
+  exact ⟨x4, ((hs1.trans hs2).trans hs3).trans hs4, hr4, by simp [isize]; omega⟩
 
 theorem sim_dup_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off .dup)) {a : W}
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g .dup)) {a : W}
     {d : List W} (hd : s.dstack = a :: d) (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: a :: d } x' ∧
-      x'.pc = base + isize (.dup : WordDialect.Instr 32) := by
-  obtain ⟨hatuf, hato, f0, f1, f2⟩ := xat_uf_ovf (L := L) (n := 1) (by decide) rfl hat
+      x'.pc = base + isize g (.dup : WordDialect.Instr 32) := by
+  obtain ⟨hatuf, hato, f0, f1, f2⟩ := xat_uf_ovf (L := L) (n := need g 1) rfl hat
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1' (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, _⟩ := push_pair hg hr2 r0 (by decide) hfit
     ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), trivial⟩
   rw [hv2, hd] at hr3
-  exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize, ufSize]; omega⟩
+  exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize]; omega⟩
 
-theorem sim_dup_ovf (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off .dup)) {a : W}
+theorem sim_dup_ovf (hn : g.noOvf = false) (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g .dup)) {a : W}
     {d : List W} (hd : s.dstack = a :: d) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
-  obtain ⟨hatuf, hato, _⟩ := xat_uf_ovf (L := L) (n := 1) (by decide) rfl hat
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) (by simp [hd]) hpc hatuf
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  obtain ⟨hatuf, hato, _⟩ := xat_uf_ovf (L := L) (n := need g 1) rfl hat
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by simp [hd]) hpc hatuf
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 theorem sim_drop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .drop)) {a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .drop)) {a : W} {d : List W}
     (hd : s.dstack = a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := d } x' ∧
-      x'.pc = base + isize (.drop : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 1 base ++ [.addImm Reg.r4 4]) := hat
+      x'.pc = base + isize g (.drop : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.addImm Reg.r4 4]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, _⟩ := adj_step (code := code) hg hr1 (n := 1) (by simp [hd])
     (δ := 4) (by simp) (fetch_cast f0 (by omega))
   have e : (s.dstack).drop 1 = d := by simp [hd]
   rw [e] at hr2
-  exact ⟨x2, hs1.trans hs2, hr2, by simp [isize, ufSize]; omega⟩
+  exact ⟨x2, hs1.trans hs2, hr2, by simp [isize]; omega⟩
 
 theorem sim_word_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (w : W)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.word w)))
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.word w)))
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := w :: s.dstack } x' ∧
-      x'.pc = base + isize (.word w : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.word w : WordDialect.Instr 32) := by
   obtain ⟨hato, f0, f1, f2⟩ := xat_ovf3 (L := L) (by exact hat)
-  obtain ⟨x0, hs0, hr0, hpc0, _, _⟩ := ovfD_pass hg hs hLd hfit hpc hato
+  obtain ⟨x0, hs0, hr0, hpc0, _, _⟩ := ovfG_pass hg hs hLd hfit hpc hato
   obtain ⟨x1, hs1, hr1, hpc1, hv1, _⟩ := movimm_step (code := code) hr0 (rd := r0) (by simp)
     (v := w) (by rw [hpc0]; exact f0)
   obtain ⟨x2, hs2, hr2, hpc2, _⟩ := push_pair hg hr1 r0 (by decide) hfit
@@ -174,37 +176,37 @@ theorem sim_word_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (w : W
   rw [hv1] at hr2
   exact ⟨x2, (hs0.trans hs1).trans hs2, hr2, by simp [isize]; omega⟩
 
-theorem sim_word_ovf (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (w : W)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.word w)))
+theorem sim_word_ovf (hn : g.noOvf = false) (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (w : W)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.word w)))
     (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) : RExec code x .overflow := by
   obtain ⟨hato, _⟩ := xat_ovf3 (L := L) (by exact hat)
-  exact ovfD_trap hg hs hLd h hpc hato
+  exact ovfG_trap hn hg hs hLd h hpc hato
 
 theorem sim_ptr_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (q : WordDialect.Ptr 32)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.ptr q)))
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.ptr q)))
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := q.toWord :: s.dstack } x' ∧
-      x'.pc = base + isize (.ptr q : WordDialect.Instr 32) :=
-  sim_word_ok (L := L) (off := off) hg hs hpc q.toWord hLd hat hfit
+      x'.pc = base + isize g (.ptr q : WordDialect.Instr 32) :=
+  sim_word_ok (L := L) (off := off) (g := g) hg hs hpc q.toWord hLd hat hfit
 
-theorem sim_ptr_ovf (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (q : WordDialect.Ptr 32)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.ptr q)))
+theorem sim_ptr_ovf (hn : g.noOvf = false) (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (q : WordDialect.Ptr 32)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.ptr q)))
     (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) : RExec code x .overflow :=
-  sim_word_ovf (L := L) (off := off) hg hs hpc q.toWord hLd hat h
+  sim_word_ovf (L := L) (off := off) (g := g) hn hg hs hpc q.toWord hLd hat h
 
 theorem sim_swap_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .swap)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .swap)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: b :: d } x' ∧
-      x'.pc = base + isize (.swap : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 2 base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
+      x'.pc = base + isize g (.swap : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 2) base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
       .store Reg.r4 0 r1, .store Reg.r4 4 r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1 (j := 0) (v := b)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := a)
@@ -220,45 +222,45 @@ theorem sim_swap_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
   have e : (s.dstack.set 0 (x3.regs r1)).set 1 (x4.regs r0) = a :: b :: d := by
     simp [hd, hv3, hreg4, hax3]
   rw [e] at hr5'
-  exact ⟨x5, (((hs1.trans hs2).trans hs3).trans hs4).trans hs5, hr5', by simp [isize, ufSize]; omega⟩
+  exact ⟨x5, (((hs1.trans hs2).trans hs3).trans hs4).trans hs5, hr5', by simp [isize]; omega⟩
 
 theorem sim_over_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off .over)) {b a : W}
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g .over)) {b a : W}
     {d : List W} (hd : s.dstack = b :: a :: d) (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: b :: a :: d } x' ∧
-      x'.pc = base + isize (.over : WordDialect.Instr 32) := by
-  obtain ⟨hatuf, hato, f0, f1, f2⟩ := xat_uf_ovf (L := L) (n := 2) (by decide) rfl hat
+      x'.pc = base + isize g (.over : WordDialect.Instr 32) := by
+  obtain ⟨hatuf, hato, f0, f1, f2⟩ := xat_uf_ovf (L := L) (n := need g 2) rfl hat
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1' (j := 1) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 4) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, _⟩ := push_pair hg hr2 r0 (by decide) hfit
     ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), trivial⟩
   rw [hv2, hd] at hr3
-  exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize, ufSize]; omega⟩
+  exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize]; omega⟩
 
-theorem sim_over_ovf (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off .over)) {b a : W}
+theorem sim_over_ovf (hn : g.noOvf = false) (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g .over)) {b a : W}
     {d : List W} (hd : s.dstack = b :: a :: d) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
-  obtain ⟨hatuf, hato, _⟩ := xat_uf_ovf (L := L) (n := 2) (by decide) rfl hat
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) (by simp [hd]) hpc hatuf
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  obtain ⟨hatuf, hato, _⟩ := xat_uf_ovf (L := L) (n := need g 2) rfl hat
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by simp [hd]) hpc hatuf
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 theorem sim_rot_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .rot)) {cc b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .rot)) {cc b a : W} {d : List W}
     (hd : s.dstack = cc :: b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: cc :: b :: d } x' ∧
-      x'.pc = base + isize (.rot : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 3 base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
+      x'.pc = base + isize g (.rot : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 3) base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
       .load r2 Reg.r4 8, .store Reg.r4 0 r2, .store Reg.r4 4 r0, .store Reg.r4 8 r1]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 3 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 3) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, _⟩ := hatr
   have hk : 3 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1 (j := 0) (v := cc)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := b)
@@ -284,7 +286,7 @@ theorem sim_rot_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
     simp [hd, hv4, hreg5, hreg6, hax4, hcx4]
   rw [e] at hr7'
   exact ⟨x7, (((((hs1.trans hs2).trans hs3).trans hs4).trans hs5).trans hs6).trans hs7, hr7',
-    by simp [isize, ufSize]; omega⟩
+    by simp [isize]; omega⟩
 
 end Ops
 

backend/cortexm/CM/SimStep.lean

@@ -53,10 +53,13 @@ theorem shape3 {l : List W} (h : 3 ≤ l.length) : ∃ cc y v d, l = cc :: y ::
       | nil => simp at h
       | cons v d => exact ⟨cc, y, v, d, rfl⟩
 
-theorem lowerInstr_uf (L : Layout) (base : Nat) (off : Nat → Nat) (i : WordDialect.Instr 32)
+theorem lowerInstr_uf (L : Layout) (base : Nat) (off : Nat → Nat) (g : Facts) (i : WordDialect.Instr 32)
     (h : 0 < i.pops) :
-    ∃ rest, lowerInstr L base off i = uf L i.pops base ++ rest ∧ i.pops ≤ 3 := by
-  cases i <;> first | exact ⟨_, rfl, by simp [Instr.pops]⟩ | exact absurd h (by simp [Instr.pops])
+    ∃ rest, lowerInstr L base off g i = uf L (need g i.pops) base ++ rest ∧ i.pops ≤ 3 := by
+  cases i <;> first
+    | exact ⟨_, rfl, by simp [Instr.pops]⟩
+    | exact ⟨_, List.append_assoc _ _ _, by simp [Instr.pops]⟩
+    | exact absurd h (by simp [Instr.pops])
 
 theorem Rel0.setPc {c : Cfg} {p : Prog 32} {s : State 32} {x : M} (h : Rel0 c p s x) (n : Nat) :
     Rel0 c p { s with pc := n } x :=
@@ -78,14 +81,15 @@ theorem sim_trapped {code : List (Instr Nat)} {t : Trap} (h : RExec code x (.tra
     Sim c p code x (.trapped t) := h
 
 theorem rel_fall {i : WordDialect.Instr 32} (hi : p[s.pc]? = some i) {s' : State 32}
-    {x' : M} (h0 : Rel0 c p s' x') (hpc : x'.pc = offs p s.pc + isize i) :
+    {x' : M} (h0 : Rel0 c p s' x') (hpc : x'.pc = offs c.facts p s.pc + isize (c.facts s.pc) i) :
     Rel c p { s' with pc := s.pc + 1 } x' :=
-  ⟨h0.setPc _, by rw [hpc, offs_succ hi]⟩
+  ⟨h0.setPc _, by rw [hpc, offs_succ c.facts hi]⟩
 
 theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
     (hLd : L.dLim = ofN (c.dBase + 4)) (hLr : L.rGap = ofN (4 * c.rcap - 8))
     (hLa : L.aEnd = ofN c.aEnd) (hLal : L.aLim = ofN (c.aBase + 4))
-    (hsz : ∀ k, offs p k < 2 ^ 32) (hs : Rel c p s x)
+    (hLf : L.facts = c.facts) (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hs : Rel c p s x)
+    (hgd : c.cert s.pc ≤ s.dstack.length) (hub : s.dstack.length ≤ c.ub s.pc)
     {i : WordDialect.Instr 32} (hi : p[s.pc]? = some i)
     (hreg : ∀ r, (i = .push r ∨ i = .pop r) → r < c.nregs) :
     Sim c p (lowerProg L p) x (WordDialect.exec i s) ∨
@@ -93,27 +97,39 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
   have nfD : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd → ¬ Fits c s := fun h hf => h hf.1
   have nfR : ¬ s.rstack.length + 2 ≤ c.rcap → ¬ Fits c s := fun h hf => h hf.2.1
   have nfA : ¬ c.aBase + 4 * (s.astack.length + 1) ≤ c.aEnd → ¬ Fits c s := fun h hf => h hf.2.2
-  have hpc : x.pc = offs p s.pc := hs.2
+  have hpc : x.pc = offs c.facts p s.pc := hs.2
   have hs0 : Rel0 c p s x := hs.1
   have hat := lowerProg_at L p s.pc i hi
+  rw [hLf] at hat
+  -- Where the stack may be full, the overflow guard is there: the bound left it out only where
+  -- one more word fits.
+  have hnov : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd → (c.facts s.pc).noOvf = false := by
+    intro hf
+    cases h : (c.facts s.pc).noOvf
+    · rfl
+    · exfalso; apply hf
+      simp only [Cfg.facts, decide_eq_true_eq] at h
+      unfold Cfg.dCap at h
+      omega
   by_cases hk : s.dstack.length < i.pops
   · rw [exec_underflow i s hk]
-    obtain ⟨rest, hlow, h3⟩ := lowerInstr_uf L (offs p s.pc) (offs p) i (by omega)
+    obtain ⟨rest, hlow, h3⟩ := lowerInstr_uf L (offs c.facts p s.pc) (offs c.facts p) (c.facts s.pc) i
+      (by omega)
     rw [hlow] at hat
-    exact .inl <| sim_trapped (sim_uf_trap hg hs0 hL (by omega) h3 hk hpc hat)
+    exact .inl <| sim_trapped (sim_uf_trap hg hs0 hL (by omega) h3 hgd hk hpc hat)
   · have hk' : i.pops ≤ s.dstack.length := by omega
     cases i with
     | word w =>
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_word_ovf hg hs0 hpc w hLd hat hf⟩
+      · exact .inr ⟨nfD hf, sim_word_ovf (hnov hf) hg hs0 hpc w hLd hat hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_word_ok hg hs0 hpc w hLd hat hf
       rw [exec_word]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
     | ptr q =>
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_ptr_ovf hg hs0 hpc q hLd hat hf⟩
+      · exact .inr ⟨nfD hf, sim_ptr_ovf (hnov hf) hg hs0 hpc q hLd hat hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_ptr_ok hg hs0 hpc q hLd hat hf
       rw [exec_ptr]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
@@ -238,8 +254,9 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
         simp only [hc', Bool.false_eq_true, if_false] at hpc'
         exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
     | call t =>
-      have hret : offs p s.pc + isize (.call t : WordDialect.Instr 32) = offs p (s.pc + 1) := by
-        rw [offs_succ hi]
+      have hret : offs c.facts p s.pc + isize (c.facts s.pc) (.call t : WordDialect.Instr 32) =
+          offs c.facts p (s.pc + 1) := by
+        rw [offs_succ c.facts hi]
       by_cases hf : s.rstack.length + 2 ≤ c.rcap
       rotate_left
       · exact .inr ⟨nfR hf, sim_call_ovf hg hs0 hpc hLr hat hf⟩
@@ -259,7 +276,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
     | push r =>
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_push_ovf hg hs0 hpc hLd hat hf⟩
+      · exact .inr ⟨nfD hf, sim_push_ovf (hnov hf) hg hs0 hpc hLd hat hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_push_ok hg hs0 hpc (hreg r (Or.inl rfl)) hLd hat hf
       rw [exec_push]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
@@ -272,7 +289,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
       obtain ⟨a, d, hd⟩ := shape1 (by simpa [Instr.pops] using hk')
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_dup_ovf hg hL hs0 hpc hLd hat hd hf⟩
+      · exact .inr ⟨nfD hf, sim_dup_ovf (hnov hf) hg hL hs0 hpc hLd hat hd hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_dup_ok hg hL hs0 hpc hLd hat hd hf
       rw [exec_dup hd]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
@@ -290,7 +307,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
       obtain ⟨b, a, d, hd⟩ := shape2 (by simpa [Instr.pops] using hk')
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_over_ovf hg hL hs0 hpc hLd hat hd hf⟩
+      · exact .inr ⟨nfD hf, sim_over_ovf (hnov hf) hg hL hs0 hpc hLd hat hd hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_over_ok hg hL hs0 hpc hLd hat hd hf
       rw [exec_over hd]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
@@ -320,7 +337,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
       | cons a as =>
         by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
         rotate_left
-        · exact .inr ⟨nfD hf, sim_fromr_ovf hg hLa hLd hs0 hpc hat (by simp [ha]) hf⟩
+        · exact .inr ⟨nfD hf, sim_fromr_ovf (hnov hf) hg hLa hLd hs0 hpc hat (by simp [ha]) hf⟩
         obtain ⟨x', hst, h0, hpc'⟩ := sim_fromr_ok hg hLa hLd hs0 hpc hat ha hf
         have e : WordDialect.exec WordDialect.Instr.fromr s =
             .next { s with pc := s.pc + 1, dstack := a :: s.dstack, astack := as } := by
@@ -337,7 +354,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
       | cons a as =>
         by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
         rotate_left
-        · exact .inr ⟨nfD hf, sim_rfetch_ovf hg hLa hLd hs0 hpc hat (by simp [ha]) hf⟩
+        · exact .inr ⟨nfD hf, sim_rfetch_ovf (hnov hf) hg hLa hLd hs0 hpc hat (by simp [ha]) hf⟩
         obtain ⟨x', hst, h0, hpc'⟩ := sim_rfetch_ok hg hLa hLd hs0 hpc hat ha hf
         have e : WordDialect.exec WordDialect.Instr.rfetch s = s.fall (a :: s.dstack) := by
           simp [WordDialect.exec, ha]

backend/cortexm/CMMain.lean

@@ -13,7 +13,8 @@ For each program it
 3. runs the image on the emulated Stellaris LM3S6965 evaluation board, a Cortex-M3 with 256 KiB
    of flash and 64 KiB of SRAM (`qemu-system-arm -M lm3s6965evb`). It takes the initial stack
    pointer and reset vector from the vector table, copies `.data` from flash to SRAM, prints
-   through UART0 and stops through semihosting. The emulated flash ignores writes, so a program
+   through UART0 and ends the run there (an `EXIT` line and the status, then `wfi`; the harness
+   reads up to that line and stops the emulator). The emulated flash ignores writes, so a program
    that ran on the flash copy of `.data` instead of the RAM copy would fail the comparison,
 4. runs the same IR program under the Lean semantics at width 32 (`WordDialect.run`), and
 5. compares the exit status and the dumped data stack, IR memory and virtual registers.
@@ -23,8 +24,13 @@ samples and generated programs narrowed to 32-bit words, 32-bit edge cases, the
 and overflow programs, and Forth source files compiled at width 32. `check` also runs the
 hand-written data-processing programs of `CM.DataOps`.
 
-Usage: `cmc check [fuzzCount]`, `cmc emit <sample>`, `cmc forth <file.fs> [memWords]`,
-`cmc emit-forth <file.fs> [memWords]`.
+For a real board, `cmc image` writes the ELF, an Intel HEX file and the UART transcript a correct
+run prints; `cmc verify` checks a serial log captured from the board (`docs/HARDWARE.md`).
+
+Usage: `cmc check [fuzzCount]`, `cmc image <file.fs> [memWords]`,
+`cmc verify <file.fs> <serial.log> [memWords]`, `cmc emit <sample>`, `cmc forth <file.fs> [memWords]`,
+`cmc emit-forth <file.fs> [memWords]`, `cmc stats <file.fs> [memWords]` (the guards the depth
+certificates leave out); `--no-opt` with any of them lowers with every guard.
 -/
 
 open WordDialect
@@ -43,12 +49,23 @@ def rBase : Nat := 0x20009000
 def rcap : Nat := 4096
 def rEnd : Nat := rBase + 4 * rcap
 
-def runtimeFor (s : Sample32) : CM.Emit.Runtime :=
-  { dEnd := dEnd, capacity := capacity, rEnd := rEnd, rcap := rcap, memImage := s.mem,
-    nregs := s.nregs, aEnd := aEnd, acap := acap }
-
-def asmFor (s : Sample32) : String :=
-  CM.Emit.program (runtimeFor s) (CM.lowerProg (runtimeFor s).layout s.prog)
+/-- The runtime for one program. With `opt` the lowering uses the checked stack-depth
+certificate `certTable` and the checked upper bounds `upperTable` (`WordDialect.Depth`), which
+decide the guards left out; their checks are all the correctness theorem needs, so the analyses
+are not trusted. Without it every guard stays. -/
+def runtimeFor (s : Sample32) (opt : Bool := true) : CM.Emit.Runtime :=
+  let r : CM.Emit.Runtime :=
+    { dEnd := dEnd, capacity := capacity, rEnd := rEnd, rcap := rcap, memImage := s.mem,
+      nregs := s.nregs, aEnd := aEnd, acap := acap }
+  if opt then
+    let tbl := certTable s.prog
+    let up := upperTable s.prog r.dCap
+    { r with cert := fun k => tbl.getD k 0, ub := fun k => upperAt up r.dCap k }
+  else r
+
+def asmFor (s : Sample32) (opt : Bool := true) : String :=
+  let r := runtimeFor s opt
+  CM.Emit.program r (CM.lowerProg r.layout s.prog)
 
 /-- The vector table and code in flash from address 0 (where a Cortex-M reads its initial stack
 pointer and reset vector); `.data` in the first 4 KiB of SRAM, loaded into flash after the code
@@ -64,8 +81,8 @@ def linkerScript : String :=
 
 def workDir : String := "/tmp/cmc"
 
-/-- Assemble, link and run one assembly file; the UART output and the exit status. -/
-def runAsm (name asm : String) : IO (Except String (String × UInt32)) := do
+/-- Assemble and link one assembly file; the ELF's path. -/
+def buildElf (name asm : String) : IO (Except String String) := do
   IO.FS.createDirAll workDir
   let base := s!"{workDir}/{name}"
   IO.FS.writeFile (base ++ ".s") asm
@@ -77,21 +94,28 @@ def runAsm (name asm : String) : IO (Except String (String × UInt32)) := do
   let l ← IO.Process.output
     { cmd := "ld.lld", args := #["-T", workDir ++ "/link.ld", "-o", base, base ++ ".o"] }
   if l.exitCode != 0 then return .error s!"ld.lld failed: {l.stderr}"
-  let child ← IO.Process.spawn
-    { cmd := "qemu-system-arm",
-      args := #["-machine", "lm3s6965evb", "-kernel", base, "-display", "none", "-serial", "stdio",
-        "-monitor", "none", "-semihosting-config", "enable=on,target=native"],
-      stdout := .piped, stderr := .null, stdin := .null }
-  let out ← readAll child.stdout ByteArray.empty
-  let code ← child.wait
-  match String.fromUTF8? out with
-  | some t => return .ok (t, code)
-  | none => return .error "UART output is not text"
-
-def runNative : Runner32 := fun s => do
-  match ← runAsm s.name (asmFor s) with
+  return .ok base
+
+/-- Build, run on the emulated board, and read its UART up to the end of the run (the `EXIT`
+line and the status). The emulator is then stopped: the board itself sleeps for good. -/
+def runAsm (name asm : String) : IO (Except String String) := do
+  match ← buildElf name asm with
+  | .error e => return .error e
+  | .ok elf =>
+    let child ← IO.Process.spawn
+      { cmd := "qemu-system-arm",
+        args := #["-machine", "lm3s6965evb", "-kernel", elf, "-display", "none", "-serial", "stdio",
+          "-monitor", "none"],
+        stdout := .piped, stderr := .null, stdin := .null }
+    let out ← readUntilExit child.stdout
+    child.kill
+    let _ ← child.wait
+    return .ok out
+
+def runNative (opt : Bool := true) : Runner32 := fun s => do
+  match ← runAsm s.name (asmFor s opt) with
   | .error e => return .error e
-  | .ok (out, code) => return (if code != 0 then .ok (.trap code.toNat) else parseHexDump s out)
+  | .ok out => return parseTranscript s out
 
 /-! ## Hand-written Cortex-M programs (`CM.DataOps`) -/
 
@@ -106,7 +130,7 @@ def isaAsm (code : List (CM.Instr Nat)) : String :=
   CM.Emit.body code ++ s!".Lhalt:\n\t{CM.Emit.la "r12" "rbuf"}\n" ++
   String.join (isaRegs.zipIdx.map fun (x, k) => s!"\tstr {CM.Emit.regName x}, [r12, #{4 * k}]\n") ++
   CM.Emit.uartOn r ++ s!"\t{CM.Emit.la "r7" "rbuf"}\n\tmovs r9, #12\n\tbl putws\n" ++
-  "\tmovs r1, #0\n\tb .Lexit\n" ++ CM.Emit.devices r ++
+  "\tmovs r1, #0\n\tb .Lfinish\n" ++ CM.Emit.devices r ++
   "\t.data\n\t.balign 4\nrbuf:\n\t.zero 48\nexitblk:\n\t.word 0, 0\n"
 
 def checkIsaProg (name : String) (code : List (CM.Instr Nat)) : IO Bool := do
@@ -114,14 +138,15 @@ def checkIsaProg (name : String) (code : List (CM.Instr Nat)) : IO Bool := do
     (·.map BitVec.toNat)
   let got ← runAsm name (isaAsm code)
   match model, got with
-  | some exp, .ok (out, 0) =>
-    match hexWords out with
-    | some g =>
+  | some exp, .ok out =>
+    let ls := transcriptLines out
+    let i := ls.findIdx (· == exitMarker)
+    match hexWords (String.intercalate "\n" (ls.take i)), hexWords (ls.getD (i + 1) "") with
+    | some g, some [0] =>
       if exp == g then IO.println s!"PASS  {name}  {g}"; return true
       else IO.println s!"FAIL  {name}\n  lean:   {exp}\n  target: {g}"; return false
-    | none => IO.println s!"ERROR {name}: malformed output {out}"; return false
+    | _, _ => IO.println s!"ERROR {name}: malformed output {out}"; return false
   | none, _ => IO.println s!"ERROR {name}: the model did not halt"; return false
-  | _, .ok (_, c) => IO.println s!"ERROR {name}: exit {c}"; return false
   | _, .error e => IO.println s!"ERROR {name}: {e}"; return false
 
 /-- A pseudo-random program over `r0 … r11`: initialise all twelve (some to small values, so
@@ -167,16 +192,19 @@ def parseMem (rest : List String) : Option Nat :=
   | [m] => m.toNat?
   | _ => none
 
-def main (args : List String) : IO UInt32 := do
+def main (args0 : List String) : IO UInt32 := do
+  -- `--no-opt` keeps every guard (the lowering without depth certificates).
+  let opt := !args0.contains "--no-opt"
+  let args := args0.filter (· != "--no-opt")
   match args with
   | ["emit", name] =>
     match allSamples32.find? (·.name == name) with
-    | some s => IO.println (asmFor s); return 0
+    | some s => IO.println (asmFor s opt); return 0
     | none => IO.eprintln "unknown sample"; return 1
   | "forth" :: path :: rest =>
     match parseMem rest with
     | none => IO.eprintln "usage: cmc forth <file.fs> [memWords]"; return 2
-    | some m => return (if ← check32 runNative (← forthFileSample32 path m) then 0 else 1)
+    | some m => return (if ← check32 (runNative opt) (← forthFileSample32 path m) then 0 else 1)
   | "emit-forth" :: path :: rest =>
     match parseMem rest with
     | none => IO.eprintln "usage: cmc emit-forth <file.fs> [memWords]"; return 2
@@ -184,10 +212,33 @@ def main (args : List String) : IO UInt32 := do
       let s ← forthFileSample32 path m
       match s.buildError with
       | some e => IO.eprintln e; return 1
-      | none => IO.println (asmFor s); return 0
+      | none => IO.println (asmFor s opt); return 0
+  | "image" :: path :: rest =>
+    match parseMem rest with
+    | none => IO.eprintln "usage: cmc image <file.fs> [memWords]"; return 2
+    | some m =>
+      let s ← forthFileSample32 path m
+      if let some e := s.buildError then IO.eprintln e; return 1
+      match ← buildElf s.name (asmFor s opt) with
+      | .error e => IO.eprintln e; return 1
+      | .ok elf => writeImage s elf s.name
+  | "verify" :: path :: log :: rest =>
+    match parseMem rest with
+    | none => IO.eprintln "usage: cmc verify <file.fs> <serial.log> [memWords]"; return 2
+    | some m => verifyLog (← forthFileSample32 path m) log
+  | "stats" :: path :: rest =>
+    match parseMem rest with
+    | none => IO.eprintln "usage: cmc stats <file.fs> [memWords]"; return 2
+    | some m =>
+      let s ← forthFileSample32 path m
+      if let some e := s.buildError then IO.eprintln e; return 1
+      let r := runtimeFor s
+      IO.println (guardStats s r.cert r.ub r.dCap)
+      return 0
   | "check" :: rest =>
     let count := match rest with | [n] => n.toNat! | _ => 200
-    let ok ← checkAll32 runNative count
+    let ok ← checkAll32 (runNative opt) count
+    let okc ← checkCapacity32 (runNative opt) capacity
     let isa ← checkIsa 100
-    return (if ok && isa then 0 else 1)
-  | _ => IO.eprintln "usage: cmc check [fuzzCount] | cmc emit <sample> | cmc forth <file.fs> [memWords] | cmc emit-forth <file.fs> [memWords]"; return 2
+    return (if ok && okc && isa then 0 else 1)
+  | _ => IO.eprintln "usage: cmc check [fuzzCount] | cmc emit <sample> | cmc forth <file.fs> [memWords] | cmc emit-forth <file.fs> [memWords] | cmc image <file.fs> [memWords] | cmc verify <file.fs> <serial.log> [memWords]"; return 2

backend/cortexm0/CM0/Boot.lean

@@ -4,7 +4,7 @@ import CM0.Init
 # CM0.Boot
 
 Booting from flash, proved. A Cortex-M runs from flash: the vector table and code are there, and
-`.data` (IR memory, the register file and the semihosting block) is linked to RAM with its load
+`.data` (IR memory, the register file and the two-word status block) is linked to RAM with its load
 address in flash. The reset handler first copies `.data` to RAM with the ten-instruction loop
 `Emit.copyCode`, printed from the model like the lowered program, then runs the prologue.
 
@@ -260,15 +260,15 @@ theorem copy_holds {r : Runtime} {ld : Loader} {lma : Nat} {x0 : M} (h : FlashHo
 copy loop runs to its end; from there the prologue runs, and the lowered code reaches the outcome
 the IR reaches from `State.init` on the memory image, or exits with `overflow`. -/
 theorem boot_correct (r : Runtime) (ld : Loader) (lma : Nat) (p : Prog 32)
-    (hlen : 36 * p.length < 2 ^ 32) (hreg : RegsOk (cfgOf r ld) p) {o : Outcome 32}
-    (hx : Exec p (State.init (Memory.ofImage r.memImage)) o) {x0 : M}
+    (hlen : 36 * p.length < 2 ^ 32) (hreg : RegsOk (cfgOf r ld) p) (hok : certOk p r.cert = true)
+    (hub : UbSound p r.dCap r.ub) {o : Outcome 32} (hx : Exec p (State.init (Memory.ofImage r.memImage)) o) {x0 : M}
     (h : FlashHolds r ld lma x0) (hpc : x0.pc = 0) :
     ∃ x1, RSteps (copyCode (ofN lma) (ofN ld.mb) (dataWords r)) x0 x1 ∧ x1.pc = 10 ∧
       rseq (prologueCode r ld) x1 = .next { entryState r ld x1 with pc := x1.pc + 8 } ∧
       (Final (cfgOf r ld) p (lowerProg r.layout p) (entryState r ld x1) o ∨
         RExec (lowerProg r.layout p) (entryState r ld x1) .overflow) := by
   obtain ⟨x1, hs, hpc1, hh⟩ := copy_holds h hpc
-  exact ⟨x1, hs, hpc1, binary_correct r ld p hlen hreg hx hh⟩
+  exact ⟨x1, hs, hpc1, binary_correct r ld p hlen hreg hok hub hx hh⟩
 
 end Emit
 end CM0

backend/cortexm0/CM0/Correct.lean

@@ -25,6 +25,11 @@ Hypotheses of both (all explicit):
                       at least two;
 * `L` matches `c`     data-stack end and limit, return-stack gap, auxiliary-stack end and limit,
                       and IR memory size;
+* `hLf`, `hok`, `I`   the code was lowered with the configuration's facts: its lower-bound
+                      certificate passes `certOk`, and its upper bound `c.ub` is implied by an
+                      invariant `I` kept by every step within the data stack's capacity (`hIs`,
+                      `hIb`; `WordDialect.UbSound`); the runs carry `DepthInv` and `I`, so every
+                      underflow or overflow guard the lowering left out would have passed;
 * `hsz`               code indices fit in 32 bits;
 * `RegsOk`            every `push r`/`pop r` names a register inside the register file.
 -/
@@ -44,15 +49,30 @@ def Final (c : Cfg) (p : Prog 32) (code : List (Instr Nat)) (x : M) : Outcome 32
   | .halted s' => ∃ x', RExec code x (.halted x') ∧ Rel0 c p s' x'
   | .trapped t => RExec code x (.trapped t)
 
-theorem offs_ge {p : Prog 32} {k : Nat} (h : p.length ≤ k) : offs p k = offs p p.length := by
-  simp [offs, List.take_of_length_le h, List.take_length]
+theorem offs_ge (cf : Nat → Facts) {p : Prog 32} {k : Nat} (h : p.length ≤ k) :
+    offs cf p k = offs cf p p.length := by
+  induction p generalizing cf k with
+  | nil => cases k <;> simp [offs]
+  | cons i is ih =>
+    cases k with
+    | zero => simp at h
+    | succ k => simp only [List.length_cons, offs]; rw [ih _ (by simp at h; omega)]
+
+/-- A related state is within the data stack's capacity. -/
+theorem cap_of_rel {c : Cfg} {p : Prog 32} {s : State 32} {x : M} (hs : Rel c p s x) :
+    s.dstack.length ≤ c.dCap := by
+  have := hs.1.capD
+  unfold Cfg.dCap
+  omega
 
 /-- One IR step from a related state: the bad-pc stub, or the dispatched instruction. -/
 theorem step_sim {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
     (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M) (hLd : L.dLim = ofN (c.dBase + 4))
     (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hLa : L.aEnd = ofN c.aEnd)
-    (hLal : L.aLim = ofN (c.aBase + 4)) (hsz : ∀ k, offs p k < 2 ^ 32) (hreg : RegsOk c p)
-    {s : State 32} {x : M} (hs : Rel c p s x) :
+    (hLal : L.aLim = ofN (c.aBase + 4)) (hLf : L.facts = c.facts) (hok : certOk p c.cert = true)
+    (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hreg : RegsOk c p)
+    {s : State 32} {x : M} (hs : Rel c p s x) (hdi : DepthInv c.cert s)
+    (hub : s.dstack.length ≤ c.ub s.pc) :
     Sim c p (lowerProg L p) x (WordDialect.step p s) ∨
       (¬ Fits c s ∧ RExec (lowerProg L p) x .overflow) := by
   cases hi : p[s.pc]? with
@@ -65,43 +85,48 @@ theorem step_sim {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
       · rw [List.getElem?_eq_getElem hh] at hi; simp at hi
       · omega
     obtain ⟨f0, _⟩ := lowerProg_stub L p
-    have hpc : x.pc = offs p p.length := by rw [hs.2, offs_ge hge]
+    rw [hLf] at f0
+    have hpc : x.pc = offs c.facts p p.length := by rw [hs.2, offs_ge _ hge]
     exact RExec.trap (by rw [rstep_of_fetch (by rw [hpc]; exact f0)]; rfl)
   | some i =>
     have hst : WordDialect.step p s = WordDialect.exec i s := by simp [WordDialect.step, hi]
     rw [hst]
-    exact sim_exec hg hL hMs hLd hLr hLa hLal hsz hs hi (fun r hr => hreg s.pc i hi r hr)
+    exact sim_exec hg hL hMs hLd hLr hLa hLal hLf hsz hs hdi.depth hub hi (fun r hr => hreg s.pc i hi r hr)
 
 /-- Whole-program preservation, with no capacity hypothesis: the ARMv6-M code reaches the IR
 outcome, or exits with `overflow` because a stack was full. -/
 theorem lowerProg_correct_or_overflow {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
     (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M) (hLd : L.dLim = ofN (c.dBase + 4))
     (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hLa : L.aEnd = ofN c.aEnd)
-    (hLal : L.aLim = ofN (c.aBase + 4)) (hsz : ∀ k, offs p k < 2 ^ 32) (hreg : RegsOk c p)
+    (hLal : L.aLim = ofN (c.aBase + 4)) (hLf : L.facts = c.facts) (hok : certOk p c.cert = true)
+    {I : State 32 → Prop}
+    (hIs : ∀ s s', I s → s.dstack.length ≤ c.dCap → WordDialect.step p s = .next s' → I s')
+    (hIb : ∀ s, I s → s.dstack.length ≤ c.ub s.pc)
+    (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hreg : RegsOk c p)
     {s : State 32} {o : Outcome 32} (h : Exec p s o) :
-    ∀ {x : M}, Rel c p s x →
+    ∀ {x : M}, Rel c p s x → DepthInv c.cert s → I s →
       Final c p (lowerProg L p) x o ∨ RExec (lowerProg L p) x .overflow := by
   induction h with
   | @halt s s' hst =>
-    intro x hs
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨_, h6⟩
     · exact .inl this
     · exact .inr h6
   | @trap s t hst =>
-    intro x hs
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨_, h6⟩
     · exact .inl this
     · exact .inr h6
   | @next s s' o hst _ ih =>
-    intro x hs
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with ⟨x1, hsteps, hrel⟩ | ⟨_, h6⟩
-    · rcases ih hrel with hih | h6
+    · rcases ih hrel (DepthInv.step hok hdi hst) (hIs s _ hbi (cap_of_rel hs) hst) with hih | h6
       · left
         cases o with
         | next _ => exact hih.elim
@@ -117,31 +142,35 @@ every reachable state), no overflow guard fires and the outcome is exactly the I
 theorem lowerProg_correct {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
     (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M) (hLd : L.dLim = ofN (c.dBase + 4))
     (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hLa : L.aEnd = ofN c.aEnd)
-    (hLal : L.aLim = ofN (c.aBase + 4)) (hsz : ∀ k, offs p k < 2 ^ 32) (hreg : RegsOk c p)
+    (hLal : L.aLim = ofN (c.aBase + 4)) (hLf : L.facts = c.facts) (hok : certOk p c.cert = true)
+    {I : State 32 → Prop}
+    (hIs : ∀ s s', I s → s.dstack.length ≤ c.dCap → WordDialect.step p s = .next s' → I s')
+    (hIb : ∀ s, I s → s.dstack.length ≤ c.ub s.pc)
+    (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hreg : RegsOk c p)
     {s : State 32} {o : Outcome 32} (h : Exec p s o) :
-    ∀ {x : M}, Rel c p s x → (∀ s', Steps p s s' → Fits c s') →
+    ∀ {x : M}, Rel c p s x → DepthInv c.cert s → I s → (∀ s', Steps p s s' → Fits c s') →
       Final c p (lowerProg L p) x o := by
   induction h with
   | @halt s s' hst =>
-    intro x hs hb
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi hb
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨hnf, _⟩
     · exact this
     · exact absurd (hb s .refl) hnf
   | @trap s t hst =>
-    intro x hs hb
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi hb
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨hnf, _⟩
     · exact this
     · exact absurd (hb s .refl) hnf
   | @next s s' o hst _ ih =>
-    intro x hs hb
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi hb
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with ⟨x1, hsteps, hrel⟩ | ⟨hnf, _⟩
-    · have hih := ih hrel (fun s'' hss => hb s'' (Steps.cons hst hss))
+    · have hih := ih hrel (DepthInv.step hok hdi hst) (hIs s _ hbi (cap_of_rel hs) hst) (fun s'' hss => hb s'' (Steps.cons hst hss))
       cases o with
       | next _ => exact hih.elim
       | halted r5 =>
@@ -159,7 +188,7 @@ theorem init_rel {c : Cfg} {p : Prog 32} {s0 : State 32} {x0 : M} (hg : Geom c)
     (h13 : x0.regs Reg.r8 = ofN c.mb) (h12 : x0.regs Reg.r9 = ofN c.sp0)
     (hsp : x0.regs Reg.sp = ofN c.sp0) (hbp : x0.regs Reg.r6 = ofN c.aEnd) (hregs : RegRel c x0.mem s0.regs)
     (hmem : MemRel c x0.mem s0.mem) (hiv : ∀ a : Word 32, s0.mem.valid a = decide (a.toNat < c.M))
-    (hxv : RegionsValid c x0.mem.valid) (hpc : x0.pc = offs p s0.pc) : Rel c p s0 x0 :=
+    (hxv : RegionsValid c x0.mem.valid) (hpc : x0.pc = offs c.facts p s0.pc) : Rel c p s0 x0 :=
   ⟨{ r4 := by simpa [hd] using h15
      r5 := h14
      r8 := h13

backend/cortexm0/CM0/Emit.lean

@@ -19,12 +19,13 @@ RAM with `copyCode` (proved in `CM0/Boot.lean`), runs the prologue, then jumps o
 pool to the lowered code. The rest of the runtime (`epilogue`) is hand-written assembly. It
 * implements `exitHalt` as: write `depth`, the data stack, IR memory and the virtual register
   file to the UART (the nRF51 UART at `uartBase`, waiting for `EVENTS_TXDRDY` after each byte),
-  one word per line as eight hexadecimal digits, then stop with status 0,
-* implements `exitTrap t` as stopping with status `code t`, and `exitOvf` (stack overflow) with
+  one word per line as eight hexadecimal digits, then end with status 0,
+* implements `exitTrap t` as ending with status `code t`, and `exitOvf` (stack overflow) with
   status 6.
 
-The machine is stopped through semihosting (`bkpt 0xab`, operation `SYS_EXIT_EXTENDED`); on a
-board running without a debugger, that one stub is replaced by whatever signals the end of a run.
+A run ends on the UART, the same way on the emulator and on a board, with no debugger: after the
+dump (if any) the runtime prints a line `EXIT` and the status, stores the status at `exitblk`, and
+sleeps. Before printing it starts the crystal and sets up the UART as a board needs (`uartInit`).
 -/
 
 namespace WordDialect
@@ -148,9 +149,20 @@ def instr (k : Nat) (i : Instr Nat) : String := instrP "" k i
 def body (code : List (Instr Nat)) : String :=
   String.intercalate "\n" (code.zipIdx.map fun (i, k) => s!"{lbl k}:\n\t{instr k i}") ++ "\n"
 
+/-- The chip family the runtime's device code is written for. The lowered program and its proofs
+do not depend on it; only the hand-written set-up, output and end-of-run code does. -/
+inductive Soc where
+  /-- Nordic nRF51/nRF52 (BBC micro:bit): the UART at `uartBase`. -/
+  | nrf
+  /-- Microchip SAM D21 (SAM D21 Curiosity Nano, `ATSAMD21G17D`): SERCOM5 as a USART on
+  PA22 (TX, pad 0) and PB22 (RX, pad 2), the debugger's virtual COM port; the yellow LED on PB10;
+  the switch SW0 on PB11. -/
+  | samd21
+  deriving DecidableEq, Repr
+
 /-- Data-stack placement (`capacity` words ending at `dEnd`), return-stack placement (`rcap`
 entries ending at `rEnd`, the stack `sp` points into), IR memory image, register-file size,
-auxiliary-stack placement (`acap` words ending at `aEnd`), and the UART address. The three
+auxiliary-stack placement (`acap` words ending at `aEnd`), the UART address and its pins. The three
 stacks are sections the linker places at fixed addresses (`cm0c` uses a linker script). -/
 structure Runtime where
   dEnd : Nat
@@ -162,6 +174,19 @@ structure Runtime where
   aEnd : Nat
   acap : Nat
   uartBase : Nat := 0x40002000
+  /-- The UART pins as the nRF `PSEL` registers take them, and the TX pin's number in GPIO
+  port 0. The defaults are the BBC micro:bit V1's (TX P0.24, RX P0.25). -/
+  txPin : Nat := 24
+  rxPsel : Nat := 25
+  /-- The chip family of the board (see `Soc`). -/
+  soc : Soc := .nrf
+  /-- The stack-depth certificate the code is lowered with (`WordDialect.Depth`); the driver
+  passes `safeCert` of the program. The default claims nothing and keeps every guard. -/
+  cert : Nat → Nat := fun _ => 0
+  /-- The upper bound on the data-stack depth the code is lowered with; the driver passes
+  `upperTable` of the program against `dCap` (`WordDialect.Depth`). An overflow guard is left out
+  where `ub k + 1 ≤ dCap`; the default (`2^32` everywhere) shows no room, so every guard stays. -/
+  ub : Nat → Nat := fun _ => 2 ^ 32
 
 def Runtime.dBase (r : Runtime) : Nat := r.dEnd - 4 * r.capacity
 
@@ -169,14 +194,18 @@ def Runtime.rBase (r : Runtime) : Nat := r.rEnd - 4 * r.rcap
 
 def Runtime.aBase (r : Runtime) : Nat := r.aEnd - 4 * r.acap
 
+/-- The data stack's capacity in words. -/
+def Runtime.dCap (r : Runtime) : Nat := (r.dEnd - r.dBase) / 4
+
 /-- The lowering's view of the runtime: the constants the guards and bounds checks use. -/
 def Runtime.layout (r : Runtime) : Layout :=
   { dEnd := BitVec.ofNat 32 r.dEnd, memSize := r.memImage.length,
     dLim := BitVec.ofNat 32 (r.dBase + 4), rGap := BitVec.ofNat 32 (4 * r.rcap - 8),
-    aEnd := BitVec.ofNat 32 r.aEnd, aLim := BitVec.ofNat 32 (r.aBase + 4) }
+    aEnd := BitVec.ofNat 32 r.aEnd, aLim := BitVec.ofNat 32 (r.aBase + 4), cert := r.cert,
+    ub := r.ub, dCap := r.dCap }
 
 /-- The `.data` image: IR memory, the register file (`nregs + 1` words) and the two-word
-semihosting parameter block, in the order `epilogue` lays them out. The image is linked into
+status block `exitblk`, in the order `epilogue` lays them out. The image is linked into
 flash and copied to RAM at reset. -/
 def dataImage (r : Runtime) : List Nat := r.memImage ++ List.replicate (r.nregs + 3) 0
 
@@ -214,14 +243,96 @@ def prologue (r : Runtime) : String :=
   s!"\t{la "r5" "regfile"}\n\t{li "r4" r.dEnd}\n\t{li "r6" r.aEnd}\n" ++
   "\tb .L0\n\t.ltorg\n"
 
-/-- Output and exit routines, entered only from `exitHalt`, `exitTrap` and `exitOvf`, so they
-may use any register. `putc` writes `r0` to the UART; `putw` writes `r6` as eight hexadecimal
-digits and a newline; `putws` writes the `r5` words at address `r4`. `.Lexit` stops the machine
-through semihosting with status `r1`. -/
-def devices (r : Runtime) : String :=
+/-- Bring up the UART as a board needs it (the emulator needs none of it): start the 16 MHz
+crystal (`TASKS_HFCLKSTART`, waiting a bounded time for `EVENTS_HFCLKSTARTED`, since the
+internal RC oscillator is too loose for a serial line), make the TX pin an output that idles
+high, select the pins, set 115200 baud (`BAUDRATE = 0x01D7E000`), enable the UART and start
+its transmitter. Uses `r0 … r3`. -/
+def uartInit (r : Runtime) : String :=
+  "\t.thumb_func\nuart_init:\n" ++
+  s!"\t{la "r2" "0x40000000"}\n\tmovs r3, #1\n\tstr r3, [r2]\n" ++
+  s!"\t{la "r1" "0x100000"}\n\t{la "r0" "0x100"}\n" ++
+  "9:\tldr r3, [r2, r0]\n\tcmp r3, #0\n\tbne 8f\n\tsubs r1, #1\n\tbne 9b\n8:\n" ++
+  s!"\t{la "r2" "0x50000000"}\n\t{la "r0" "0x508"}\n\t{la "r3" (hex (2 ^ r.txPin))}\n\tstr r3, [r2, r0]\n" ++
+  s!"\t{la "r0" (hex (0x700 + 4 * r.txPin))}\n\tmovs r3, #1\n\tstr r3, [r2, r0]\n" ++
+  s!"\t{la "r2" (hex r.uartBase)}\n" ++
+  s!"\t{la "r0" "0x50C"}\n\t{la "r3" (hex r.txPin)}\n\tstr r3, [r2, r0]\n" ++
+  s!"\t{la "r0" "0x514"}\n\t{la "r3" (hex r.rxPsel)}\n\tstr r3, [r2, r0]\n" ++
+  s!"\t{la "r0" "0x524"}\n\t{la "r3" "0x01D7E000"}\n\tstr r3, [r2, r0]\n" ++
+  s!"\t{la "r0" "0x500"}\n\tmovs r3, #4\n\tstr r3, [r2, r0]\n" ++
+  "\tmovs r3, #1\n\tstr r3, [r2, #8]\n\tbx lr\n"
+
+/-- SAM D21 bring-up (register addresses and fields from the SAM D21/DA1 data sheet,
+DS40001882G): run the CPU and GCLK generator 0 from the 8 MHz internal oscillator undivided
+(`SYSCTRL.OSC8M.PRESC := 0`; at reset it is divided by 8, too slow for 115200 baud), clock
+SERCOM5 (`PM.APBCMASK` bit 7, `GCLK.CLKCTRL := CLKEN | GEN0 | ID 0x19`), hand PA22 and PB22 to
+peripheral function D (SERCOM5 pads 0 and 2), and make SERCOM5 a USART with the internal clock,
+LSB first, TX on pad 0, RX on pad 2, 16x oversampling, 8 data bits, no parity, one stop bit,
+`BAUD = 65536 · (1 - 16 · 115200 / 8000000) = 50436`. Waits are bounded. Uses `r0 … r3`. -/
+def uartInitSamd21 : String :=
+  "\t.thumb_func\nuart_init:\n" ++
+  -- SYSCTRL.OSC8M (0x40000820): clear PRESC (bits 9:8)
+  s!"\t{la "r2" "0x40000800"}\n\tldr r3, [r2, #0x20]\n\t{la "r1" "0x300"}\n\tbics r3, r1\n\tstr r3, [r2, #0x20]\n" ++
+  -- PM.APBCMASK (0x40000420): SERCOM5 clock on
+  s!"\t{la "r2" "0x40000400"}\n\tldr r3, [r2, #0x20]\n\tmovs r1, #0x80\n\torrs r3, r1\n\tstr r3, [r2, #0x20]\n" ++
+  -- GCLK.CLKCTRL (0x40000C02, 16 bits): SERCOM5_CORE from generator 0; wait for STATUS.SYNCBUSY
+  s!"\t{la "r2" "0x40000C00"}\n\t{la "r3" "0x4019"}\n\tstrh r3, [r2, #2]\n" ++
+  s!"\t{la "r1" "0x100000"}\n9:\tldrb r3, [r2, #1]\n\tlsls r3, r3, #24\n\tbpl 8f\n\tsubs r1, #1\n\tbne 9b\n8:\n" ++
+  -- PORT group A (0x41004400): PA22 -> function D (PMUX11 low nibble, PINCFG22.PMUXEN)
+  s!"\t{la "r2" "0x41004400"}\n" ++
+  "\tmovs r1, #0x3B\n\tldrb r3, [r2, r1]\n\tmovs r0, #0x0F\n\tbics r3, r0\n\tmovs r0, #3\n\torrs r3, r0\n\tstrb r3, [r2, r1]\n" ++
+  "\tmovs r1, #0x56\n\tldrb r3, [r2, r1]\n\tmovs r0, #1\n\torrs r3, r0\n\tstrb r3, [r2, r1]\n" ++
+  -- PORT group B (0x41004480): PB22 -> function D
+  "\tadds r2, #0x80\n" ++
+  "\tmovs r1, #0x3B\n\tldrb r3, [r2, r1]\n\tmovs r0, #0x0F\n\tbics r3, r0\n\tmovs r0, #3\n\torrs r3, r0\n\tstrb r3, [r2, r1]\n" ++
+  "\tmovs r1, #0x56\n\tldrb r3, [r2, r1]\n\tmovs r0, #1\n\torrs r3, r0\n\tstrb r3, [r2, r1]\n" ++
+  -- SERCOM5 (0x42001C00): CTRLA, CTRLB (wait SYNCBUSY), BAUD, then ENABLE (wait SYNCBUSY)
+  s!"\t{la "r2" "0x42001C00"}\n\t{la "r3" "0x40200004"}\n\tstr r3, [r2]\n" ++
+  s!"\t{la "r3" "0x00030000"}\n\tstr r3, [r2, #4]\n" ++
+  s!"\t{la "r1" "0x100000"}\n7:\tldr r3, [r2, #0x1C]\n\tcmp r3, #0\n\tbeq 6f\n\tsubs r1, #1\n\tbne 7b\n6:\n" ++
+  s!"\t{la "r3" "50436"}\n\tstrh r3, [r2, #0x0C]\n" ++
+  s!"\t{la "r3" "0x40200006"}\n\tstr r3, [r2]\n" ++
+  s!"\t{la "r1" "0x100000"}\n5:\tldr r3, [r2, #0x1C]\n\tcmp r3, #0\n\tbeq 4f\n\tsubs r1, #1\n\tbne 5b\n4:\n" ++
+  "\tbx lr\n"
+
+/-- SAM D21 `putc`: wait for `INTFLAG.DRE`, write `DATA`, then wait for `INTFLAG.TXC`, so the
+last byte is on the wire before the run ends. -/
+def putcSamd21 : String :=
   "\t.thumb_func\nputc:\n" ++
-  s!"\t{la "r2" (hex r.uartBase)}\n\t{la "r1" "0x51C"}\n\tstr r0, [r2, r1]\n\t{la "r1" "0x11C"}\n" ++
-  "1:\tldr r3, [r2, r1]\n\tcmp r3, #0\n\tbeq 1b\n\tmovs r3, #0\n\tstr r3, [r2, r1]\n\tbx lr\n" ++
+  s!"\t{la "r2" "0x42001C00"}\n" ++
+  "1:\tldrb r3, [r2, #0x18]\n\tlsls r3, r3, #31\n\tbeq 1b\n\tstrh r0, [r2, #0x28]\n" ++
+  "2:\tldrb r3, [r2, #0x18]\n\tlsls r3, r3, #30\n\tbpl 2b\n\tbx lr\n"
+
+/-- SAM D21 end of run, after the transcript, with the status in `r6`: light the yellow LED
+(PB10, active low) when the status is 0, then wait for the switch SW0 (PB11, input with the
+internal pull-up) to be released and pressed, and reset the chip (`AIRCR.SYSRESETREQ`), so each
+press runs the program again and prints a fresh transcript. -/
+def finishSamd21 : String :=
+  s!"\t{la "r2" "0x41004480"}\n\tcmp r6, #0\n\tbne 1f\n" ++
+  s!"\t{la "r3" "0x400"}\n\tstr r3, [r2, #0x08]\n\tstr r3, [r2, #0x14]\n1:\n" ++
+  "\tmovs r1, #0x4B\n\tmovs r3, #6\n\tstrb r3, [r2, r1]\n" ++
+  s!"\t{la "r3" "0x800"}\n\tstr r3, [r2, #0x18]\n" ++
+  "2:\tldr r0, [r2, #0x20]\n\ttst r0, r3\n\tbeq 2b\n" ++
+  "3:\tldr r0, [r2, #0x20]\n\ttst r0, r3\n\tbne 3b\n" ++
+  s!"\t{la "r1" "0xE000ED0C"}\n\t{la "r0" "0x05FA0004"}\n\tstr r0, [r1]\n4:\tb 4b\n"
+
+/-- Output and end-of-run routines, entered only from `exitHalt`, `exitTrap` and `exitOvf`, so
+they may use any register. `putc` writes `r0` to the UART; `putw` writes `r6` as eight
+hexadecimal digits and a newline; `putws` writes the `r5` words at address `r4`.
+
+The end of a run (`.Lexit` with the status in `r1`, entered with the UART not yet set up;
+`.Lfinish` with the status in `r6` and the UART set up) needs no debugger: the status goes to
+the two words at `exitblk` (the status and the marker `0xE0D0F1A1`, for a debugger that wants
+to read it), then the UART gets the line `EXIT` and the status as a word line, and the core
+sleeps (`wfi`) for good. -/
+def devices (r : Runtime) : String :=
+  (match r.soc with
+   | .nrf =>
+     uartInit r ++
+     "\t.thumb_func\nputc:\n" ++
+     s!"\t{la "r2" (hex r.uartBase)}\n\t{la "r1" "0x51C"}\n\tstr r0, [r2, r1]\n\t{la "r1" "0x11C"}\n" ++
+     "1:\tldr r3, [r2, r1]\n\tcmp r3, #0\n\tbeq 1b\n\tmovs r3, #0\n\tstr r3, [r2, r1]\n\tbx lr\n"
+   | .samd21 => uartInitSamd21 ++ putcSamd21) ++
   "\t.thumb_func\nputw:\n\tmov r10, lr\n\tmovs r7, #28\n" ++
   "2:\tmov r0, r6\n\tlsrs r0, r7\n\tmovs r1, #15\n\tands r0, r1\n\tcmp r0, #10\n\tbhs 3f\n" ++
   "\tadds r0, #48\n\tb 4f\n3:\tadds r0, #87\n4:\tbl putc\n" ++
@@ -229,13 +340,16 @@ def devices (r : Runtime) : String :=
   "\t.thumb_func\nputws:\n\tmov r9, lr\n" ++
   "5:\tcmp r5, #0\n\tbeq 6f\n\tldr r6, [r4]\n\tadds r4, #4\n\tbl putw\n\tsubs r5, #1\n\tb 5b\n" ++
   "6:\tbx r9\n" ++
-  s!".Lexit:\n\t{la "r0" "exitblk"}\n\t{la "r2" "0x20026"}\n" ++
-  "\tstr r2, [r0]\n\tstr r1, [r0, #4]\n\tmov r1, r0\n\tmovs r0, #0x20\n\tbkpt 0xab\n7:\tb 7b\n"
+  ".Lexit:\n\tmov r6, r1\n\tbl uart_init\n" ++
+  s!".Lfinish:\n\t{la "r0" "exitblk"}\n\tstr r6, [r0]\n\t{la "r1" "0xE0D0F1A1"}\n\tstr r1, [r0, #4]\n" ++
+  String.join ("EXIT\n".toList.map fun ch => s!"\tmovs r0, #{ch.toNat}\n\tbl putc\n") ++
+  "\tbl putw\n" ++
+  (match r.soc with
+   | .nrf => "7:\twfi\n\tb 7b\n"
+   | .samd21 => finishSamd21)
 
-/-- Turn on the UART (`ENABLE = 4`) and its transmitter (`TASKS_STARTTX`). -/
-def uartOn (r : Runtime) : String :=
-  s!"\t{la "r2" (hex r.uartBase)}\n\t{la "r1" "0x500"}\n\tmovs r3, #4\n\tstr r3, [r2, r1]\n" ++
-  "\tmovs r3, #1\n\tstr r3, [r2, #8]\n"
+/-- Set up the UART for the halt dump. -/
+def uartOn (_r : Runtime) : String := "\tbl uart_init\n"
 
 def epilogue (r : Runtime) : String :=
   let m := r.memImage.length
@@ -245,7 +359,7 @@ def epilogue (r : Runtime) : String :=
   "\tbl putw\n\tbl putws\n" ++
   s!"\tmov r4, r8\n\t{li "r5" m}\n\tbl putws\n" ++
   s!"\tmov r4, r11\n\t{li "r5" r.nregs}\n\tbl putws\n" ++
-  "\tmovs r1, #0\n\tb .Lexit\n" ++
+  "\tmovs r6, #0\n\tb .Lfinish\n" ++
   String.join ((List.range 6).map fun k => s!".Ltrap{k + 1}:\n\tmovs r1, #{k + 1}\n\tb .Lexit\n") ++
   devices r ++ "\t.ltorg\n" ++
   "\t.data\n\t.balign 4\nirmem:\n" ++

backend/cortexm0/CM0/Guard.lean

@@ -40,7 +40,7 @@ theorem uf_cond {c : Cfg} {p : Prog 32} {s : State 32} {x : M} (hg : Geom c) (hs
   · simp [h]; omega
 
 /-- Enough operands: the guard falls through to `base + 3`, changing only scratch state. -/
-theorem uf_pass {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
+theorem uf_pass_pos {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
     {L : Layout} {base n : Nat} (hg : Geom c) (hs : Rel0 c p s x) (hL : L.dEnd = ofN c.dEnd)
     (hn : 0 < n) (hn3 : n ≤ 3) (hk : n ≤ s.dstack.length) (hpc : x.pc = base)
     (hat : RAt code base (uf L n base)) :
@@ -62,19 +62,38 @@ theorem uf_pass {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Ins
       simp [xa, M.adv, M.mov, M.setReg]
   · intro r hr; simp [xa, M.adv, M.mov, M.setReg, hr]
 
-/-- Too few operands: the guard exits with `stackUnderflow`. -/
+/-- The guard of an instruction popping `k` words, when the data stack is known to hold at least
+`g` words: with enough operands it falls through, to `base + ufSize (need g k)` (at once when the
+certificate made the guard empty). -/
+theorem uf_pass {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
+    {L : Layout} {base k : Nat} {g : Facts} (hg : Geom c) (hs : Rel0 c p s x)
+    (hL : L.dEnd = ofN c.dEnd) (hk3 : k ≤ 3) (hk : k ≤ s.dstack.length) (hpc : x.pc = base)
+    (hat : RAt code base (uf L (need g k) base)) :
+    ∃ x1, RSteps code x x1 ∧ Rel0 c p s x1 ∧ x1.pc = base + ufSize (need g k) ∧ x1.mem = x.mem ∧
+      (∀ r, r ≠ r0 → x1.regs r = x.regs r) := by
+  by_cases h0 : need g k = 0
+  · rw [h0]; exact ⟨x, .refl, hs, by simp [ufSize, hpc], rfl, fun _ _ => rfl⟩
+  · have hn : 0 < need g k := Nat.pos_of_ne_zero h0
+    have hle := need_le g k
+    obtain ⟨x1, a, b, hpc1, d, e⟩ := uf_pass_pos hg hs hL hn (by omega) (by omega) hpc hat
+    exact ⟨x1, a, b, by rw [hpc1, ufSize_pos hn], d, e⟩
+
+/-- Too few operands: the guard exits with `stackUnderflow`. It is there, because the depth
+certificate's bound `g.lo` is a true lower bound (`hgd`) and the stack holds fewer than `k` words. -/
 theorem uf_trap {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base n : Nat} (hg : Geom c) (hs : Rel0 c p s x) (hL : L.dEnd = ofN c.dEnd)
-    (hn : 0 < n) (hn3 : n ≤ 3) (hk : s.dstack.length < n) (hpc : x.pc = base)
-    (hat : RAt code base (uf L n base)) : RExec code x (.trapped .stackUnderflow) := by
-  rw [uf_eq L hn] at hat
+    {L : Layout} {base k : Nat} {g : Facts} (hg : Geom c) (hs : Rel0 c p s x)
+    (hL : L.dEnd = ofN c.dEnd) (hk0 : 0 < k) (hk3 : k ≤ 3) (hgd : g.lo ≤ s.dstack.length) (hk : s.dstack.length < k)
+    (hpc : x.pc = base) (hat : RAt code base (uf L (need g k) base)) :
+    RExec code x (.trapped .stackUnderflow) := by
+  rw [need_of_lt (by omega)] at hat
+  rw [uf_eq L hk0] at hat
   obtain ⟨h1, h2, h3, _⟩ := hat
-  let xa := x.mov r0 (L.dEnd - BitVec.ofNat 32 (4 * n))
+  let xa := x.mov r0 (L.dEnd - BitVec.ofNat 32 (4 * k))
   have hst1 : step code x = .next xa := by rw [rstep_of_fetch (by rw [hpc]; exact h1)]; rfl
   have hxa_pc : xa.pc = base + 1 := by simp [xa, M.mov, M.setReg, M.adv, hpc]
   have hholds : Cond.eval .ule (xa.regs r4) (xa.regs r0) = false := by
-    have := uf_cond hg hs hL hn hn3
-    have h : ¬ n ≤ s.dstack.length := by omega
+    have := uf_cond hg hs hL hk0 hk3
+    have h : ¬ k ≤ s.dstack.length := by omega
     simpa [xa, M.mov, M.setReg, M.adv, h] using this
   exact RExec.of_steps (RSteps.single hst1)
     (guard_trap (code := code) (pc := base + 1) (m := xa) (t := .stackUnderflow)
@@ -131,6 +150,29 @@ theorem ovfD_trap (hg : Geom c) (hs : Rel0 c p s x) (hLd : L.dLim = ofN (c.dBase
     rw [hra r4 (by decide), hta, ovfD_cond hg hs hLd]; simpa using h
   exact RExec.of_steps hsa (ovf_trap hj he hpca hholds)
 
+/-- The data-stack guard where the facts keep it: with room for one more word, it falls through
+to `base + ovfSize g` (at once when the bound left the guard out). -/
+theorem ovfG_pass {g : Facts} (hg : Geom c) (hs : Rel0 c p s x) (hLd : L.dLim = ofN (c.dBase + 4))
+    (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) (hpc : x.pc = base)
+    (hat : RAt code base (ovf L g base)) :
+    ∃ x1, RSteps code x x1 ∧ Rel0 c p s x1 ∧ x1.pc = base + ovfSize g ∧ x1.mem = x.mem ∧
+      (∀ r, r ≠ r0 → x1.regs r = x.regs r) := by
+  unfold ovf at hat
+  unfold ovfSize
+  cases hn : g.noOvf
+  · simp only [hn, Bool.false_eq_true, if_false] at hat ⊢
+    exact ovfD_pass hg hs hLd hfit hpc hat
+  · exact ⟨x, .refl, hs, by simp [hpc], rfl, fun _ _ => rfl⟩
+
+/-- Data stack full: the guard is there (the bound did not claim room) and exits with
+`overflow`. -/
+theorem ovfG_trap {g : Facts} (hn : g.noOvf = false) (hg : Geom c) (hs : Rel0 c p s x)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd)
+    (hpc : x.pc = base) (hat : RAt code base (ovf L g base)) : RExec code x .overflow := by
+  unfold ovf at hat
+  simp only [hn, Bool.false_eq_true, if_false] at hat
+  exact ovfD_trap hg hs hLd h hpc hat
+
 /-- The return-stack guard's comparison, in terms of return-stack depth. -/
 theorem ovfR_cond (hg : Geom c) (hs : Rel0 c p s x) (hLr : L.rGap = ofN (4 * c.rcap - 8)) :
     Cond.eval .uge (x.regs Reg.sp) (x.regs Reg.r9 - L.rGap) =

backend/cortexm0/CM0/Init.lean

@@ -35,7 +35,9 @@ flash only (`copy_holds`, `boot_correct`).
 
 `binary_correct`: under those loader facts, after the prologue the lowered code reaches the IR
 outcome from `State.init` on the memory image, or exits with `overflow`. Its other hypotheses are
-only about the program.
+only about the program, including `certOk` for the runtime's stack-depth certificate and
+`UbSound` for its upper bound (the lowering leaves out the underflow and overflow guards they
+cover).
 -/
 
 namespace WordDialect
@@ -52,7 +54,8 @@ structure Loader where
 /-- The runtime placement for one run, as a `Cfg`. -/
 def cfgOf (r : Runtime) (ld : Loader) : Cfg :=
   { dEnd := r.dEnd, dBase := r.dBase, rf := ld.rf, nregs := r.nregs, mb := ld.mb,
-    M := r.memImage.length, sp0 := r.rEnd, rcap := r.rcap, aEnd := r.aEnd, aBase := r.aBase }
+    M := r.memImage.length, sp0 := r.rEnd, rcap := r.rcap, aEnd := r.aEnd, aBase := r.aBase,
+    cert := r.cert, ub := r.ub }
 
 /-- What the loader guarantees about the machine state `x0` at `_start`. -/
 structure Loader.Holds (r : Runtime) (ld : Loader) (x0 : M) : Prop where
@@ -78,36 +81,38 @@ theorem prologue_run (r : Runtime) (ld : Loader) (x0 : M) :
       .next { entryState r ld x0 with pc := x0.pc + 8 } := by
   simp [prologueCode, entryState, rseq, exec, M.mov, M.setReg, M.adv]
 
-theorem isize_le (i : WordDialect.Instr 32) : isize i ≤ 36 := by
-  cases i <;> simp [isize, ufSize]
-
-theorem sum_isize_le : ∀ l : Prog 32, (l.map isize).sum ≤ 36 * l.length
-  | [] => by simp
-  | i :: l => by
-    have := isize_le i
-    have := sum_isize_le l
-    simp only [List.map_cons, List.sum_cons, List.length_cons]
+theorem isize_le (g : Facts) (i : WordDialect.Instr 32) : isize g i ≤ 36 := by
+  have hu : ∀ k, ufSize (need g k) ≤ 3 := fun k => by unfold ufSize; split <;> omega
+  have hv : ovfSize g ≤ 3 := by unfold ovfSize; split <;> omega
+  have h1 := hu 1; have h2 := hu 2; have h3 := hu 3
+  cases i <;> simp only [isize] <;> omega
+
+theorem offs_le (cf : Nat → Facts) : ∀ (p : Prog 32) (k : Nat), offs cf p k ≤ 36 * p.length
+  | [], k => by cases k <;> simp [offs]
+  | i :: l, 0 => by simp [offs]
+  | i :: l, k + 1 => by
+    have := isize_le (cf 0) i
+    have := offs_le (fun j => cf (j + 1)) l k
+    simp only [offs, List.length_cons]
     omega
 
 /-- Code indices are bounded by the program length. -/
-theorem offs_lt {p : Prog 32} (h : 36 * p.length < 2 ^ 32) (k : Nat) : offs p k < 2 ^ 32 := by
-  have h1 := sum_isize_le (p.take k)
-  have h2 : (p.take k).length ≤ p.length := by rw [List.length_take]; omega
-  simp only [offs]
-  omega
+theorem offs_lt (cf : Nat → Facts) {p : Prog 32} (h : 36 * p.length < 2 ^ 32) (k : Nat) :
+    offs cf p k < 2 ^ 32 :=
+  Nat.lt_of_le_of_lt (offs_le cf p k) h
 
 theorem layout_ok (r : Runtime) (ld : Loader) :
-    r.layout.dEnd = ofN (cfgOf r ld).dEnd ∧ r.layout.memSize = (cfgOf r ld).M ∧
+    r.layout.facts = (cfgOf r ld).facts ∧ r.layout.dEnd = ofN (cfgOf r ld).dEnd ∧ r.layout.memSize = (cfgOf r ld).M ∧
       r.layout.dLim = ofN ((cfgOf r ld).dBase + 4) ∧ r.layout.rGap = ofN (4 * (cfgOf r ld).rcap - 8) ∧
       r.layout.aEnd = ofN (cfgOf r ld).aEnd ∧ r.layout.aLim = ofN ((cfgOf r ld).aBase + 4) :=
-  ⟨rfl, rfl, rfl, rfl, rfl, rfl⟩
+  ⟨funext fun _ => rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩
 
 /-- After the prologue, the machine is related to the IR's initial state. -/
 theorem entry_rel (r : Runtime) (ld : Loader) {x0 : M} (h : ld.Holds r x0) (p : Prog 32) :
     Rel (cfgOf r ld) p (State.init (Memory.ofImage r.memImage)) (entryState r ld x0) := by
   have hg := h.geom
   refine init_rel hg rfl rfl rfl (by have := hg.rcap_ge; simp [cfgOf] at this ⊢; omega)
-    ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ (fun _ => rfl) ?_ (by simp [entryState, offs, State.init])
+    ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ (fun _ => rfl) ?_ (by simp [entryState, offs, State.init, offs_zero])
   · simp [entryState, M.mov, M.setReg, M.adv, cfgOf]
   · simp [entryState, M.mov, M.setReg, M.adv, cfgOf]
   · simp [entryState, M.mov, M.setReg, M.adv, cfgOf]
@@ -128,14 +133,17 @@ theorem entry_rel (r : Runtime) (ld : Loader) {x0 : M} (h : ld.Holds r x0) (p :
 the outcome the IR reaches from `State.init` on the memory image, or exits with `overflow` (exit
 code 6). Program hypotheses: code indices fit in 32 bits and register indices are in range. -/
 theorem binary_correct (r : Runtime) (ld : Loader) (p : Prog 32) (hlen : 36 * p.length < 2 ^ 32)
-    (hreg : RegsOk (cfgOf r ld) p) {o : Outcome 32}
+    (hreg : RegsOk (cfgOf r ld) p) (hok : certOk p r.cert = true)
+    (hub : UbSound p r.dCap r.ub) {o : Outcome 32}
     (hx : Exec p (State.init (Memory.ofImage r.memImage)) o) {x0 : M} (h : ld.Holds r x0) :
     rseq (prologueCode r ld) x0 = .next { entryState r ld x0 with pc := x0.pc + 8 } ∧
       (Final (cfgOf r ld) p (lowerProg r.layout p) (entryState r ld x0) o ∨
         RExec (lowerProg r.layout p) (entryState r ld x0) .overflow) := by
-  obtain ⟨hL, hMs, hLd, hLr, hLa, hLal⟩ := layout_ok r ld
+  obtain ⟨hLc, hL, hMs, hLd, hLr, hLa, hLal⟩ := layout_ok r ld
+  obtain ⟨I, hI0, hIs, hIb⟩ := hub
   exact ⟨prologue_run r ld x0,
-    lowerProg_correct_or_overflow h.geom hL hMs hLd hLr hLa hLal (offs_lt hlen) hreg hx (entry_rel r ld h p)⟩
+    lowerProg_correct_or_overflow h.geom hL hMs hLd hLr hLa hLal hLc hok hIs hIb (offs_lt _ hlen)
+      hreg hx (entry_rel r ld h p) (DepthInv.init (certOk_entry hok) _) (hI0 _)⟩
 
 end Emit
 end CM0

backend/cortexm0/CM0/Isa.lean

@@ -41,7 +41,7 @@ Scope and trust boundary:
 * `exitHalt` / `exitTrap t` stand for the runtime stubs that dump state and stop the machine;
   they are terminal here. `exitOvf` is the stub for a stack-overflow guard (status 6); it has no
   IR counterpart, since IR stacks are unbounded. There is no operating system: the stubs talk to
-  a UART and stop the machine through semihosting (`CM0.Emit`).
+  a UART and end the run there (`CM0.Emit`).
 
 That the model matches the hardware is the stated assumption of this backend; `cm0c` tests it by
 running the emitted code on an emulated Cortex-M0 board (`qemu-system-arm -M microbit`).

backend/cortexm0/CM0/Lower.lean

@@ -1,4 +1,5 @@
 import CM0.Isa
+import WordDialect.Depth
 
 /-!
 # CM0.Lower
@@ -34,8 +35,11 @@ exits 6 (`exitOvf`). `tor` likewise checks `r6 ≥ aBase + 4` before growing the
 stack, and `fromr`/`rfetch` trap `returnUnderflow` when `r6 = aEnd` (empty). IR stacks are unbounded, so this exit has no IR counterpart: it reports that
 the run exceeded the target's stack capacity.
 
-Every instruction's code has a size that depends only on the instruction, so jump targets are
-absolute code indices computed from prefix sums (`offs`). One definition serves both the
+Two checked certificates (`WordDialect.Depth`) remove guards: where the data stack is known to
+hold enough operands, the operand-count guard is left out, and where one more word is known to
+fit, the overflow guard is. Every instruction's code has a size that depends only on the
+instruction and those facts, so jump targets are absolute code indices computed from prefix sums
+(`offs`). One definition serves both the
 model and the assembly text.
 -/
 
@@ -51,6 +55,24 @@ structure Layout where
   rGap : W        -- `4 rcap - 8`: a call has room iff `sp ≥ r9 - rGap`
   aEnd : W        -- empty auxiliary stack: `r6 = aEnd`
   aLim : W        -- `aBase + 4`: the auxiliary stack has room for one more word iff `r6 ≥ aLim`
+  /-- A depth certificate (`WordDialect.Depth`): at IR instruction `k` the data stack holds at
+  least `cert k` words, so an operand-count guard for at most that many words is left out. -/
+  cert : Nat → Nat := fun _ => 0
+  /-- An upper bound on the data-stack depth at each IR instruction (`WordDialect.Bound`), and
+  the data stack's capacity in words. Where `ub k + 1 ≤ dCap` the data-stack overflow guard is
+  left out. The default capacity `0` leaves every guard in. -/
+  ub : Nat → Nat := fun _ => 0
+  dCap : Nat := 0
+
+/-- What the lowering knows at one IR instruction: a lower bound on the data-stack depth, and
+whether one more word is known to fit. -/
+structure Facts where
+  lo : Nat := 0
+  noOvf : Bool := false
+
+/-- The facts at IR instruction `k`. -/
+def Layout.facts (L : Layout) (k : Nat) : Facts :=
+  { lo := L.cert k, noOvf := decide (L.ub k + 1 ≤ L.dCap) }
 
 /-- Stack-underflow guard for `k` operands: continue when `r4 ≤ dEnd - 4k`. -/
 def uf (L : Layout) (k base : Nat) : List (Instr Nat) :=
@@ -60,10 +82,25 @@ def uf (L : Layout) (k base : Nat) : List (Instr Nat) :=
 
 def ufSize (k : Nat) : Nat := if k = 0 then 0 else 3
 
+/-- The operand count an instruction popping `k` words still has to check when the data stack is
+known to hold at least `g` words: none if `k ≤ g`. -/
+def need (g : Facts) (k : Nat) : Nat := if k ≤ g.lo then 0 else k
+
+theorem need_le (g : Facts) (k : Nat) : need g k ≤ k := by unfold need; split <;> omega
+
+theorem need_of_lt {g : Facts} {k : Nat} (h : g.lo < k) : need g k = k := by
+  unfold need; split <;> omega
+
 /-- Data-stack overflow guard: exit 6 unless one more word fits. -/
 def ovfD (L : Layout) (base : Nat) : List (Instr Nat) :=
   [.movImm r0 L.dLim, .bcc .uge r4 r0 (base + 3), .exitOvf]
 
+/-- The data-stack overflow guard where it is needed: none when the facts say one more word fits. -/
+def ovf (L : Layout) (g : Facts) (base : Nat) : List (Instr Nat) :=
+  if g.noOvf then [] else ovfD L base
+
+def ovfSize (g : Facts) : Nat := if g.noOvf then 0 else 3
+
 /-- Return-stack overflow guard: exit 6 unless a call has room on the return stack. -/
 def ovfR (L : Layout) (base : Nat) : List (Instr Nat) :=
   [.movRR r0 r9, .movImm r1 L.rGap, .sub r0 r1, .bcc .uge sp r0 (base + 5), .exitOvf]
@@ -98,132 +135,146 @@ def sdivSeq (q : Nat) : List (Instr Nat) :=
   [.movRR r3 r10, .movImm r7 0#32, .bcc .sge r3 r7 (q + 26), .neg r2, .movRR r0 r2]
 
 /-- Code size of one IR instruction. -/
-def isize : WordDialect.Instr 32 → Nat
-  | .word _ | .ptr _ => 6
-  | .load => ufSize 1 + 8
-  | .store => ufSize 2 + 9
-  | .add | .sub | .mul | .and | .or | .xor => ufSize 2 + 5
-  | .div => ufSize 2 + 21
-  | .sdiv => ufSize 2 + 33
-  | .not => ufSize 1 + 3
-  | .shl | .shr => ufSize 2 + 8
-  | .rotl => ufSize 2 + 6
-  | .rotr => ufSize 2 + 5
-  | .cmp _ => ufSize 2 + 7
-  | .select => ufSize 3 + 7
+def isize (g : Facts) : WordDialect.Instr 32 → Nat
+  | .word _ | .ptr _ => ovfSize g + 3
+  | .load => ufSize (need g 1) + 8
+  | .store => ufSize (need g 2) + 9
+  | .add | .sub | .mul | .and | .or | .xor => ufSize (need g 2) + 5
+  | .div => ufSize (need g 2) + 21
+  | .sdiv => ufSize (need g 2) + 33
+  | .not => ufSize (need g 1) + 3
+  | .shl | .shr => ufSize (need g 2) + 8
+  | .rotl => ufSize (need g 2) + 6
+  | .rotr => ufSize (need g 2) + 5
+  | .cmp _ => ufSize (need g 2) + 7
+  | .select => ufSize (need g 3) + 7
   | .jmp _ => 1
-  | .branch _ => ufSize 1 + 3
+  | .branch _ => ufSize (need g 1) + 3
   | .call _ => 6
   | .ret => 3
-  | .push _ => 6
-  | .pop _ => ufSize 1 + 3
-  | .dup => ufSize 1 + 6
-  | .drop => ufSize 1 + 1
-  | .swap => ufSize 2 + 4
-  | .over => ufSize 2 + 6
-  | .rot => ufSize 3 + 6
-  | .tor => ufSize 1 + 7
-  | .fromr => 10
-  | .rfetch => 9
+  | .push _ => ovfSize g + 3
+  | .pop _ => ufSize (need g 1) + 3
+  | .dup => ufSize (need g 1) + ovfSize g + 3
+  | .drop => ufSize (need g 1) + 1
+  | .swap => ufSize (need g 2) + 4
+  | .over => ufSize (need g 2) + ovfSize g + 3
+  | .rot => ufSize (need g 3) + 6
+  | .tor => ufSize (need g 1) + 7
+  | .fromr => ovfSize g + 7
+  | .rfetch => ovfSize g + 6
   | .halt => 1
 
 /-- Code for one IR instruction placed at code index `base`; `off t` is the code index of IR
 instruction `t` (clamped to the bad-pc stub for out-of-range targets). -/
-def lowerInstr (L : Layout) (base : Nat) (off : Nat → Nat) : WordDialect.Instr 32 → List (Instr Nat)
-  | .word w => ovfD L base ++ [.movImm r0 w, .addImm r4 (-4), .store r4 0 r0]
-  | .ptr p => ovfD L base ++ [.movImm r0 p.toWord, .addImm r4 (-4), .store r4 0 r0]
+def lowerInstr (L : Layout) (base : Nat) (off : Nat → Nat) (g : Facts) :
+    WordDialect.Instr 32 → List (Instr Nat)
+  | .word w => ovf L g base ++ [.movImm r0 w, .addImm r4 (-4), .store r4 0 r0]
+  | .ptr p => ovf L g base ++ [.movImm r0 p.toWord, .addImm r4 (-4), .store r4 0 r0]
   | .load =>
-    let b0 := base + ufSize 1
-    uf L 1 base ++
+    let b0 := base + ufSize (need g 1)
+    uf L (need g 1) base ++
       [.load r0 r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r1 (b0 + 4),
        .exitTrap .badAddress, .shlImm r0 2, .add r0 r8, .load r0 r0 0, .store r4 0 r0]
   | .store =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load r0 r4 0, .load r1 r4 4, .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (b0 + 5),
        .exitTrap .badAddress, .shlImm r0 2, .add r0 r8, .store r0 0 r1, .addImm r4 8]
-  | .add => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .add r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .sub => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .sub r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .mul => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .mul r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .and => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .and r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .or => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .or r0 r1, .store r4 4 r0, .addImm r4 4]
-  | .xor => uf L 2 base ++ [.load r1 r4 0, .load r0 r4 4, .xor r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .add => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .add r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .sub => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .sub r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .mul => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .mul r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .and => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .and r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .or => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .or r0 r1, .store r4 4 r0, .addImm r4 4]
+  | .xor => uf L (need g 2) base ++ [.load r1 r4 0, .load r0 r4 4, .xor r0 r1, .store r4 4 r0, .addImm r4 4]
   | .div =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       ([.load r1 r4 0, .load r0 r4 4, .bnez r1 (b0 + 4), .exitTrap .divideByZero] ++
        udivSeq (b0 + 4) ++ [.store r4 4 r0, .addImm r4 4])
   | .sdiv =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       ([.load r1 r4 0, .load r0 r4 4, .bnez r1 (b0 + 4), .exitTrap .divideByZero] ++
        sdivSeq (b0 + 4) ++ [.store r4 4 r0, .addImm r4 4])
-  | .not => uf L 1 base ++ [.load r0 r4 0, .not r0, .store r4 0 r0]
+  | .not => uf L (need g 1) base ++ [.load r0 r4 0, .not r0, .store r4 0 r0]
   | .shl =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .lsl r0 r1, .sltiu r2 r1 32, .neg r2, .and r0 r2,
        .store r4 4 r0, .addImm r4 4]
   | .shr =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .lsr r0 r1, .sltiu r2 r1 32, .neg r2, .and r0 r2,
        .store r4 4 r0, .addImm r4 4]
   | .rotl =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .neg r1, .ror r0 r1, .store r4 4 r0, .addImm r4 4]
   | .rotr =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .ror r0 r1, .store r4 4 r0, .addImm r4 4]
   | .cmp c =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load r1 r4 0, .load r0 r4 4, .movImm r2 1#32, .bcc c r0 r1 (b0 + 5), .movImm r2 0#32,
        .store r4 4 r2, .addImm r4 4]
   | .select =>
-    let b0 := base + ufSize 3
-    uf L 3 base ++
+    let b0 := base + ufSize (need g 3)
+    uf L (need g 3) base ++
       [.load r1 r4 0, .load r0 r4 4, .load r3 r4 8, .beqz r1 (b0 + 5), .movRR r0 r3,
        .store r4 8 r0, .addImm r4 8]
   | .jmp t => [.jmp (off t)]
-  | .branch t => uf L 1 base ++ [.load r0 r4 0, .addImm r4 4, .bnez r0 (off t)]
+  | .branch t => uf L (need g 1) base ++ [.load r0 r4 0, .addImm r4 4, .bnez r0 (off t)]
   | .call t => ovfR L base ++ [.call (off t)]
   | .ret => [.bcc .ne sp r9 (base + 2), .exitTrap .returnUnderflow, .ret]
-  | .push r => ovfD L base ++ [.load r0 r5 (4 * (r : Int)), .addImm r4 (-4), .store r4 0 r0]
-  | .pop r => uf L 1 base ++ [.load r0 r4 0, .addImm r4 4, .store r5 (4 * (r : Int)) r0]
+  | .push r => ovf L g base ++ [.load r0 r5 (4 * (r : Int)), .addImm r4 (-4), .store r4 0 r0]
+  | .pop r => uf L (need g 1) base ++ [.load r0 r4 0, .addImm r4 4, .store r5 (4 * (r : Int)) r0]
   | .dup =>
-    uf L 1 base ++ ovfD L (base + ufSize 1) ++ [.load r0 r4 0, .addImm r4 (-4), .store r4 0 r0]
-  | .drop => uf L 1 base ++ [.addImm r4 4]
-  | .swap => uf L 2 base ++ [.load r0 r4 0, .load r1 r4 4, .store r4 0 r1, .store r4 4 r0]
+    uf L (need g 1) base ++ ovf L g (base + ufSize (need g 1)) ++ [.load r0 r4 0, .addImm r4 (-4), .store r4 0 r0]
+  | .drop => uf L (need g 1) base ++ [.addImm r4 4]
+  | .swap => uf L (need g 2) base ++ [.load r0 r4 0, .load r1 r4 4, .store r4 0 r1, .store r4 4 r0]
   | .over =>
-    uf L 2 base ++ ovfD L (base + ufSize 2) ++ [.load r0 r4 4, .addImm r4 (-4), .store r4 0 r0]
+    uf L (need g 2) base ++ ovf L g (base + ufSize (need g 2)) ++ [.load r0 r4 4, .addImm r4 (-4), .store r4 0 r0]
   | .rot =>
-    uf L 3 base ++
+    uf L (need g 3) base ++
       [.load r0 r4 0, .load r1 r4 4, .load r2 r4 8, .store r4 0 r2, .store r4 4 r0,
        .store r4 8 r1]
   | .tor =>
-    uf L 1 base ++ ovfA L (base + ufSize 1) ++
+    uf L (need g 1) base ++ ovfA L (base + ufSize (need g 1)) ++
       [.load r0 r4 0, .addImm r4 4, .addImm r6 (-4), .store r6 0 r0]
   | .fromr =>
-    emptyA L base ++ ovfD L (base + 3) ++
+    emptyA L base ++ ovf L g (base + 3) ++
       [.load r0 r6 0, .addImm r6 4, .addImm r4 (-4), .store r4 0 r0]
   | .rfetch =>
-    emptyA L base ++ ovfD L (base + 3) ++ [.load r0 r6 0, .addImm r4 (-4), .store r4 0 r0]
+    emptyA L base ++ ovf L g (base + 3) ++ [.load r0 r6 0, .addImm r4 (-4), .store r4 0 r0]
   | .halt => [.exitHalt]
 
-theorem lowerInstr_length (L : Layout) (base : Nat) (off : Nat → Nat) (i : WordDialect.Instr 32) :
-    (lowerInstr L base off i).length = isize i := by
-  cases i <;> simp [lowerInstr, isize, uf, ufSize, ovfD, ovfR, ovfA, emptyA, udivSeq, sdivSeq, udivCode] <;> (try split) <;> simp
+theorem uf_length (L : Layout) (k base : Nat) : (uf L k base).length = ufSize k := by
+  unfold uf ufSize; split <;> simp
+
+theorem ovf_length (L : Layout) (g : Facts) (base : Nat) : (ovf L g base).length = ovfSize g := by
+  unfold ovf ovfSize; split <;> simp [ovfD]
+
+theorem lowerInstr_length (L : Layout) (base : Nat) (off : Nat → Nat) (g : Facts)
+    (i : WordDialect.Instr 32) : (lowerInstr L base off g i).length = isize g i := by
+  cases i <;> simp [lowerInstr, isize, uf_length, ovf_length, ovfR, ovfA, emptyA, udivSeq,
+    sdivSeq, udivCode] <;> omega
 
-/-- Prefix sums of instruction sizes: `offs p k` is the code index of IR instruction `k`.
-For `k` past the end it is the index of the final bad-pc stub. -/
-def offs (p : Prog 32) (k : Nat) : Nat := ((p.take k).map isize).sum
+/-- Prefix sums of instruction sizes: `offs cf p k` is the code index of IR instruction `k`,
+where `cf j` are the facts at instruction `j` (its guards depend on them). For `k` past
+the end it is the index of the final bad-pc stub. -/
+def offs (cf : Nat → Facts) : Prog 32 → Nat → Nat
+  | _, 0 => 0
+  | [], _ + 1 => 0
+  | i :: is, k + 1 => isize (cf 0) i + offs (fun j => cf (j + 1)) is k
 
-def lowerGo (L : Layout) (off : Nat → Nat) : Nat → List (WordDialect.Instr 32) → List (Instr Nat)
-  | _, [] => [.exitTrap .badPc]
-  | b, i :: is => lowerInstr L b off i ++ lowerGo L off (b + isize i) is
+def lowerGo (L : Layout) (off : Nat → Nat) :
+    (Nat → Facts) → Nat → List (WordDialect.Instr 32) → List (Instr Nat)
+  | _, _, [] => [.exitTrap .badPc]
+  | cf, b, i :: is => lowerInstr L b off (cf 0) i ++ lowerGo L off (fun j => cf (j + 1)) (b + isize (cf 0) i) is
 
 /-- The whole program; the last instruction is the bad-pc stub, so jumping past the end of the
-IR program traps `badPc` exactly as the IR semantics does. -/
-def lowerProg (L : Layout) (p : Prog 32) : List (Instr Nat) := lowerGo L (offs p) 0 p
+IR program traps `badPc` exactly as the IR semantics does. Instruction `k` leaves out the
+guards that `L.facts k` makes redundant. -/
+def lowerProg (L : Layout) (p : Prog 32) : List (Instr Nat) := lowerGo L (offs L.facts p) L.facts 0 p
 
 end CM0
 end WordDialect

backend/cortexm0/CM0/Rel.lean

@@ -33,6 +33,17 @@ structure Cfg where
   rcap : Nat
   aEnd : Nat
   aBase : Nat
+  /-- The depth certificate the code was lowered with (`Layout.cert`). -/
+  cert : Nat → Nat := fun _ => 0
+  /-- The upper bound on the data-stack depth the code was lowered with (`Layout.ub`). -/
+  ub : Nat → Nat := fun _ => 2 ^ 32
+
+/-- The data stack's capacity in words. -/
+def Cfg.dCap (c : Cfg) : Nat := (c.dEnd - c.dBase) / 4
+
+/-- The facts the code was lowered with (`Layout.facts`). -/
+def Cfg.facts (c : Cfg) (k : Nat) : Facts :=
+  { lo := c.cert k, noOvf := decide (c.ub k + 1 ≤ c.dCap) }
 
 structure Geom (c : Cfg) : Prop where
   dEnd_lt : c.dEnd < 2 ^ 32
@@ -95,7 +106,7 @@ def MemRel (c : Cfg) (mem : Memory 32) (m : Memory 32) : Prop :=
   ∀ a, a < c.M → mem.read? (ofN (c.mb + 4 * a)) = some (m.cell (ofN a))
 
 def RsRel (c : Cfg) (p : Prog 32) (mem : Memory 32) (rs : List Nat) : Prop :=
-  ∀ i a, rs[i]? = some a → mem.read? (ofN (c.sp0 - 4 * rs.length + 4 * i)) = some (ofN (offs p a))
+  ∀ i a, rs[i]? = some a → mem.read? (ofN (c.sp0 - 4 * rs.length + 4 * i)) = some (ofN (offs c.facts p a))
 
 /-- The ARMv6-M memory's addressable set covers every region. -/
 def RegionsValid (c : Cfg) (v : W → Bool) : Prop :=
@@ -125,7 +136,7 @@ structure Rel0 (c : Cfg) (p : Prog 32) (s : State 32) (x : M) : Prop where
 
 /-- Full relation: everything in `Rel0`, and the ARMv6-M pc is the start of the IR pc's code. -/
 def Rel (c : Cfg) (p : Prog 32) (s : State 32) (x : M) : Prop :=
-  Rel0 c p s x ∧ x.pc = offs p s.pc
+  Rel0 c p s x ∧ x.pc = offs c.facts p s.pc
 
 /-- `Rel0` does not look at scratch registers or the pc. -/
 theorem Rel0.congr {c : Cfg} {p : Prog 32} {s : State 32} {x x' : M} (h : Rel0 c p s x)

backend/cortexm0/CM0/Run.lean

@@ -63,11 +63,10 @@ theorem rstep_of_fetch {code : List (Instr Nat)} {m : M} {i : Instr Nat}
   simp [step, h]
 
 /-- Prefix sums: `offs` of a cons. -/
-theorem offs_cons (i : WordDialect.Instr 32) (is : Prog 32) (k : Nat) :
-    offs (i :: is) (k + 1) = isize i + offs is k := by
-  simp [offs, List.take_succ_cons]
+theorem offs_cons (cf : Nat → Facts) (i : WordDialect.Instr 32) (is : Prog 32) (k : Nat) :
+    offs cf (i :: is) (k + 1) = isize (cf 0) i + offs (fun j => cf (j + 1)) is k := rfl
 
-theorem offs_zero (p : Prog 32) : offs p 0 = 0 := by simp [offs]
+theorem offs_zero (cf : Nat → Facts) (p : Prog 32) : offs cf p 0 = 0 := by cases p <;> rfl
 
 theorem rat_embed (pre seg post : List (Instr Nat)) : RAt (pre ++ seg ++ post) pre.length seg := by
   induction seg generalizing pre with
@@ -77,66 +76,70 @@ theorem rat_embed (pre seg post : List (Instr Nat)) : RAt (pre ++ seg ++ post) p
     have := ih (pre ++ [i])
     simpa [List.append_assoc] using this
 
-/-- Where the lowered code of IR instruction `k` sits: at index `pre.length + offs ps k`. -/
+/-- Where the lowered code of IR instruction `k` sits: at index `pre.length + offs cf ps k`, with
+the guards for the facts `cf k`. -/
 theorem lowerGo_at (L : Layout) (off : Nat → Nat) :
-    ∀ (ps : Prog 32) (pre : List (Instr Nat)) (k : Nat) (i : WordDialect.Instr 32),
+    ∀ (ps : Prog 32) (cf : Nat → Facts) (pre : List (Instr Nat)) (k : Nat) (i : WordDialect.Instr 32),
       ps[k]? = some i →
-      RAt (pre ++ lowerGo L off pre.length ps) (pre.length + offs ps k)
-        (lowerInstr L (pre.length + offs ps k) off i) := by
+      RAt (pre ++ lowerGo L off cf pre.length ps) (pre.length + offs cf ps k)
+        (lowerInstr L (pre.length + offs cf ps k) off (cf k) i) := by
   intro ps
   induction ps with
-  | nil => intro pre k i h; simp at h
+  | nil => intro cf pre k i h; simp at h
   | cons j js ih =>
-    intro pre k i h
+    intro cf pre k i h
     cases k with
     | zero =>
       simp at h; subst h
       simp only [offs_zero, Nat.add_zero, lowerGo]
-      have := rat_embed pre (lowerInstr L pre.length off j) (lowerGo L off (pre.length + isize j) js)
+      have := rat_embed pre (lowerInstr L pre.length off (cf 0) j)
+        (lowerGo L off (fun j => cf (j + 1)) (pre.length + isize (cf 0) j) js)
       simpa [List.append_assoc] using this
     | succ k =>
       simp only [List.getElem?_cons_succ] at h
-      have := ih (pre ++ lowerInstr L pre.length off j) k i h
-      have hl : (pre ++ lowerInstr L pre.length off j).length = pre.length + isize j := by
+      have := ih (fun j => cf (j + 1)) (pre ++ lowerInstr L pre.length off (cf 0) j) k i h
+      have hl : (pre ++ lowerInstr L pre.length off (cf 0) j).length = pre.length + isize (cf 0) j := by
         simp [lowerInstr_length]
       rw [hl] at this
       simp only [lowerGo, offs_cons]
-      have e : pre.length + (isize j + offs js k) = pre.length + isize j + offs js k := by omega
+      have e : pre.length + (isize (cf 0) j + offs (fun j => cf (j + 1)) js k) =
+          pre.length + isize (cf 0) j + offs (fun j => cf (j + 1)) js k := by omega
       rw [e]
       simpa [List.append_assoc] using this
 
 theorem lowerProg_at (L : Layout) (p : Prog 32) (k : Nat) (i : WordDialect.Instr 32)
     (h : p[k]? = some i) :
-    RAt (lowerProg L p) (offs p k) (lowerInstr L (offs p k) (offs p) i) := by
-  have := lowerGo_at L (offs p) p [] k i h
+    RAt (lowerProg L p) (offs L.facts p k) (lowerInstr L (offs L.facts p k) (offs L.facts p) (L.facts k) i) := by
+  have := lowerGo_at L (offs L.facts p) p L.facts [] k i h
   simpa [lowerProg] using this
 
-/-- The final stub (bad-pc trap) sits at `offs p p.length`. -/
+/-- The final stub (bad-pc trap) sits at `offs cf p p.length`. -/
 theorem lowerGo_stub (L : Layout) (off : Nat → Nat) :
-    ∀ (ps : Prog 32) (pre : List (Instr Nat)),
-      RAt (pre ++ lowerGo L off pre.length ps) (pre.length + offs ps ps.length) [.exitTrap .badPc] := by
+    ∀ (ps : Prog 32) (cf : Nat → Facts) (pre : List (Instr Nat)),
+      RAt (pre ++ lowerGo L off cf pre.length ps) (pre.length + offs cf ps ps.length)
+        [.exitTrap .badPc] := by
   intro ps
   induction ps with
   | nil =>
-    intro pre
-    simp only [lowerGo, List.length_nil, offs, List.take_nil, List.map_nil, List.sum_nil,
-      Nat.add_zero]
+    intro cf pre
+    simp only [lowerGo, List.length_nil, offs_zero, Nat.add_zero]
     have := rat_embed pre [.exitTrap .badPc] []
     simpa using this
   | cons j js ih =>
-    intro pre
-    have := ih (pre ++ lowerInstr L pre.length off j)
-    have hl : (pre ++ lowerInstr L pre.length off j).length = pre.length + isize j := by
+    intro cf pre
+    have := ih (fun j => cf (j + 1)) (pre ++ lowerInstr L pre.length off (cf 0) j)
+    have hl : (pre ++ lowerInstr L pre.length off (cf 0) j).length = pre.length + isize (cf 0) j := by
       simp [lowerInstr_length]
     rw [hl] at this
     simp only [lowerGo, List.length_cons, offs_cons]
-    have e : pre.length + (isize j + offs js js.length) = pre.length + isize j + offs js js.length := by omega
+    have e : pre.length + (isize (cf 0) j + offs (fun j => cf (j + 1)) js js.length) =
+        pre.length + isize (cf 0) j + offs (fun j => cf (j + 1)) js js.length := by omega
     rw [e]
     simpa [List.append_assoc] using this
 
 theorem lowerProg_stub (L : Layout) (p : Prog 32) :
-    RAt (lowerProg L p) (offs p p.length) [.exitTrap .badPc] := by
-  have := lowerGo_stub L (offs p) p []
+    RAt (lowerProg L p) (offs L.facts p p.length) [.exitTrap .badPc] := by
+  have := lowerGo_stub L (offs L.facts p) p L.facts []
   simpa [lowerProg] using this
 
 end CM0

backend/cortexm0/CM0/SimAux.lean

@@ -203,7 +203,7 @@ end Steps
 section Guards
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)} {L : Layout}
-  {base : Nat}
+  {base : Nat} {g : Facts}
 
 /-- The auxiliary-stack guard's comparison, in terms of its depth. -/
 theorem ovfA_cond (hg : Geom c) (hs : Rel0 c p s x) (hLal : L.aLim = ofN (c.aBase + 4)) :
@@ -305,32 +305,32 @@ end Guards
 section Ops
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 /-- Placement of the `tor` code. -/
-theorem xat_tor (hat : RAt code base (lowerInstr L base off .tor)) :
-    RAt code base (uf L 1 base) ∧ RAt code (base + 3) (ovfA L (base + 3)) ∧
-      RAt code (base + 6) [.load r0 Reg.r4 0, .addImm Reg.r4 4, .addImm Reg.r6 (-4),
+theorem xat_tor (hat : RAt code base (lowerInstr L base off g .tor)) :
+    RAt code base (uf L (need g 1) base) ∧ RAt code (base + ufSize (need g 1)) (ovfA L (base + ufSize (need g 1))) ∧
+      RAt code (base + ufSize (need g 1) + 3) [.load r0 Reg.r4 0, .addImm Reg.r4 4, .addImm Reg.r6 (-4),
         .store Reg.r6 0 r0] := by
-  have hat' : RAt code base (uf L 1 base ++ ovfA L (base + 3) ++
+  have hat' : RAt code base (uf L (need g 1) base ++ ovfA L (base + ufSize (need g 1)) ++
       [.load r0 Reg.r4 0, .addImm Reg.r4 4, .addImm Reg.r6 (-4), .store Reg.r6 0 r0]) := hat
   obtain ⟨hatuo, hatr⟩ := rat_append.mp hat'
   obtain ⟨hatuf, hato⟩ := rat_append.mp hatuo
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hato
-  have hl : (uf L 1 base ++ ovfA L (base + 3)).length = 6 := by simp [hufl, ovfA]
+  have hl : (uf L (need g 1) base ++ ovfA L (base + ufSize (need g 1))).length = ufSize (need g 1) + 3 := by simp [hufl, ovfA]
   rw [hl] at hatr
   exact ⟨hatuf, hato, hatr⟩
 
 theorem sim_tor_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hLal : L.aLim = ofN (c.aBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .tor))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .tor))
     {a : W} {d : List W} (hd : s.dstack = a :: d)
     (hfit : c.aBase + 4 * (s.astack.length + 1) ≤ c.aEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := d, astack := a :: s.astack } x' ∧
-      x'.pc = base + isize (.tor : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.tor : WordDialect.Instr 32) := by
   obtain ⟨hatuf, hato, f0, f1, f2, f3, _⟩ := xat_tor hat
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfA_pass hg hr1 hLal hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1' (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
@@ -343,39 +343,40 @@ theorem sim_tor_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hLal : L.aLim = ofN
     ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩
   rw [hax3] at hr4
   exact ⟨x4, (((hs1.trans hs1').trans hs2).trans hs3).trans hs4, hr4,
-    by simp [isize, ufSize]; omega⟩
+    by simp [isize]; omega⟩
 
 theorem sim_tor_ovf (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hLal : L.aLim = ofN (c.aBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .tor))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .tor))
     (hk : 1 ≤ s.dstack.length) (h : ¬ c.aBase + 4 * (s.astack.length + 1) ≤ c.aEnd) :
     RExec code x .overflow := by
   obtain ⟨hatuf, hato, _⟩ := xat_tor hat
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   exact RExec.of_steps hs1 (ovfA_trap hg hr1 hLal h hpc1 hato)
 
-/-- Placement of `emptyA L base ++ ovfD L (base + 3) ++ rest`. -/
+/-- Placement of `emptyA L base ++ ovf L g (base + 3) ++ rest`. -/
 theorem xat_take {rest : List (Instr Nat)}
-    (hat : RAt code base (emptyA L base ++ ovfD L (base + 3) ++ rest)) :
-    RAt code base (emptyA L base) ∧ RAt code (base + 3) (ovfD L (base + 3)) ∧
-      RAt code (base + 6) rest := by
+    (hat : RAt code base (emptyA L base ++ ovf L g (base + 3) ++ rest)) :
+    RAt code base (emptyA L base) ∧ RAt code (base + 3) (ovf L g (base + 3)) ∧
+      RAt code (base + 3 + ovfSize g) rest := by
   obtain ⟨hatuo, hatr⟩ := rat_append.mp hat
   obtain ⟨hate, hato⟩ := rat_append.mp hatuo
   have hel : (emptyA L base).length = 3 := rfl
   rw [hel] at hato
-  have hl : (emptyA L base ++ ovfD L (base + 3)).length = 6 := rfl
-  rw [hl] at hatr
+  have hl : (emptyA L base ++ ovf L g (base + 3)).length = 3 + ovfSize g := by
+    simp [ovf_length, emptyA]; omega
+  rw [hl, ← Nat.add_assoc] at hatr
   exact ⟨hate, hato, hatr⟩
 
 theorem sim_fromr_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .fromr))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .fromr))
     {a : W} {as : List W} (hd : s.astack = a :: as)
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: s.dstack, astack := as } x' ∧
-      x'.pc = base + isize (.fromr : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.fromr : WordDialect.Instr 32) := by
   obtain ⟨hate, hato, f0, f1, f2, f3, _⟩ := xat_take (L := L) (rest := [.load r0 Reg.r6 0,
     .addImm Reg.r6 4, .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa (by simp [hd]) hpc hate
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_aux_step (code := code) hr1' hd (rd := r0)
     (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, ho3⟩ := aux_drop (code := code) hr2 hd (fetch_cast f1 (by omega))
@@ -386,30 +387,30 @@ theorem sim_fromr_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = o
   exact ⟨x4, (((hs1.trans hs1').trans hs2).trans hs3).trans hs4, hr4, by simp [isize]; omega⟩
 
 theorem sim_fromr_trap (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .fromr)) (he : s.astack = []) :
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .fromr)) (he : s.astack = []) :
     RExec code x (.trapped .returnUnderflow) :=
   emptyA_trap hg hs hLa he hpc (xat_take (L := L) (rest := [.load r0 Reg.r6 0,
     .addImm Reg.r6 4, .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat).1
 
-theorem sim_fromr_ovf (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .fromr))
+theorem sim_fromr_ovf (hn : g.noOvf = false) (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .fromr))
     (hne : s.astack ≠ []) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
   obtain ⟨hate, hato, _⟩ := xat_take (L := L) (rest := [.load r0 Reg.r6 0,
     .addImm Reg.r6 4, .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa hne hpc hate
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 theorem sim_rfetch_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .rfetch))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .rfetch))
     {a : W} {as : List W} (hd : s.astack = a :: as)
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: s.dstack } x' ∧
-      x'.pc = base + isize (.rfetch : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.rfetch : WordDialect.Instr 32) := by
   obtain ⟨hate, hato, f0, f1, f2, _⟩ := xat_take (L := L) (rest := [.load r0 Reg.r6 0,
     .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa (by simp [hd]) hpc hate
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_aux_step (code := code) hr1' hd (rd := r0)
     (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, _⟩ := push_pair hg hr2 r0 (by decide) hfit
@@ -418,19 +419,19 @@ theorem sim_rfetch_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim =
   exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize]; omega⟩
 
 theorem sim_rfetch_trap (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .rfetch)) (he : s.astack = []) :
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .rfetch)) (he : s.astack = []) :
     RExec code x (.trapped .returnUnderflow) :=
   emptyA_trap hg hs hLa he hpc (xat_take (L := L) (rest := [.load r0 Reg.r6 0,
     .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat).1
 
-theorem sim_rfetch_ovf (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .rfetch))
+theorem sim_rfetch_ovf (hn : g.noOvf = false) (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .rfetch))
     (hne : s.astack ≠ []) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
   obtain ⟨hate, hato, _⟩ := xat_take (L := L) (rest := [.load r0 Reg.r6 0,
     .addImm Reg.r4 (-4), .store Reg.r4 0 r0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa hne hpc hate
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 end Ops
 

backend/cortexm0/CM0/SimBin.lean

@@ -28,23 +28,23 @@ theorem scratch_ne (r : Reg) (h : r = r0 ∨ r = r1 ∨ r = r2 ∨ r = r3) :
   rcases h with rfl | rfl | rfl | rfl <;> decide
 
 theorem sim_bin_ok {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base : Nat} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
+    {L : Layout} {base : Nat} {g : Facts} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
     (hpc : x.pc = base) (mid : List (Instr Nat)) (rr : Reg)
     (hrr : rr = r0 ∨ rr = r1 ∨ rr = r2 ∨ rr = r3) (f : W → W → W)
     (hmid : MidSpec mid rr f) (hstr : ∀ i ∈ mid, i.straightR = true)
-    (hat : RAt code base (uf L 2 base ++
+    (hat : RAt code base (uf L (need g 2) base ++
       ([.load r1 r4 0, .load r0 r4 4] ++ mid ++ [.store r4 4 rr, .addImm r4 4])))
     {b a : W} {d : List W} (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := f a b :: d } x' ∧
-      x'.pc = base + 3 + (4 + mid.length) := by
+      x'.pc = base + ufSize (need g 2) + (4 + mid.length) := by
   have hk : 2 ≤ s.dstack.length := by simp [hd]
   obtain ⟨hatuf, hatrest⟩ := rat_append.mp hat
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatrest
   obtain ⟨hatA, hatB⟩ := rat_append.mp hatrest
   obtain ⟨hatLd, hatMid⟩ := rat_append.mp hatA
   obtain ⟨f0, f1, _⟩ := hatLd
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   have hrcx := scratch_ne r1 (by simp)
   have hrax := scratch_ne r0 (by simp)
   -- load r1, [r4 + 0]
@@ -53,14 +53,14 @@ theorem sim_bin_ok {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (
   have hst0 : RSteps code x1 x2 := RSteps.single (by
     rw [rstep_of_fetch (m := x1) (by rw [hpc1]; exact f0), e0, hx2])
   have hr2 : Rel0 c p s x2 := by rw [hx2]; exact mov_rel0 hr1 r1 hrcx b
-  have hpc2 : x2.pc = base + 3 + 1 := by simp [hx2, M.mov, M.setReg, M.adv, hpc1]
+  have hpc2 : x2.pc = base + ufSize (need g 2) + 1 := by simp [hx2, M.mov, M.setReg, M.adv, hpc1]
   -- load r0, [r4 + 4]
   have e1 := ld_stack hr2 (j := 1) (v := a) (by simp [hd]) r0 (disp := 4) (by simp)
   obtain ⟨x3, hx3⟩ : ∃ x3, x3 = x2.mov r0 a := ⟨_, rfl⟩
   have hst1 : RSteps code x2 x3 := RSteps.single (by
     rw [rstep_of_fetch (m := x2) (by rw [hpc2]; exact f1), e1, hx3])
   have hr3 : Rel0 c p s x3 := by rw [hx3]; exact mov_rel0 hr2 r0 hrax a
-  have hpc3 : x3.pc = base + 3 + 2 := by simp [hx3, M.mov, M.setReg, M.adv, hpc2]
+  have hpc3 : x3.pc = base + ufSize (need g 2) + 2 := by simp [hx3, M.mov, M.setReg, M.adv, hpc2]
   have hax : x3.regs r0 = a := by simp [hx3, M.mov, M.setReg, M.adv]
   have hcx : x3.regs r1 = b := by simp [hx3, hx2, M.mov, M.setReg, M.adv]
   -- mid
@@ -71,12 +71,12 @@ theorem sim_bin_ok {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (
   have hlen : 1 < s.dstack.length := by simp [hd]
   obtain ⟨mem', e2, hr5⟩ := st_stack hg hr4 (j := 1) hlen rr (disp := 4) (by simp)
   obtain ⟨st, adj, _⟩ := hatB
-  have hpc4' : x4.pc = base + 3 + (2 + mid.length) := by rw [hpc4, hpc3]; omega
+  have hpc4' : x4.pc = base + ufSize (need g 2) + (2 + mid.length) := by rw [hpc4, hpc3]; omega
   obtain ⟨x5, hx5⟩ : ∃ x5, x5 = ({ x4.adv with mem := mem' } : M) := ⟨_, rfl⟩
   have hst2 : RSteps code x4 x5 := RSteps.single (by
     rw [rstep_of_fetch (m := x4) (fetch_cast st (by rw [hpc4']; simp; omega)), e2, hx5])
   rw [← hx5] at hr5
-  have hpc5 : x5.pc = base + 3 + (2 + mid.length + 1) := by
+  have hpc5 : x5.pc = base + ufSize (need g 2) + (2 + mid.length + 1) := by
     simp [hx5, M.adv]; omega
   -- adjust r4
   have hlen5 : 1 ≤ ({ s with dstack := s.dstack.set 1 (x4.regs rr) } : State 32).dstack.length := by

backend/cortexm0/CM0/SimCtl.lean

@@ -14,19 +14,24 @@ namespace CM0
 
 open Reg
 
-theorem offs_succ {p : Prog 32} {k : Nat} {i : WordDialect.Instr 32} (h : p[k]? = some i) :
-    offs p (k + 1) = offs p k + isize i := by
-  have hk : k < p.length := (List.getElem?_eq_some_iff.mp h).1
-  have hi : p[k] = i := (List.getElem?_eq_some_iff.mp h).2
-  simp [offs, List.take_succ, h, List.sum_append]
+theorem offs_succ (cf : Nat → Facts) {p : Prog 32} {k : Nat} {i : WordDialect.Instr 32}
+    (h : p[k]? = some i) : offs cf p (k + 1) = offs cf p k + isize (cf k) i := by
+  induction p generalizing cf k with
+  | nil => simp at h
+  | cons j js ih =>
+    cases k with
+    | zero => simp at h; subst h; simp [offs_cons, offs_zero]
+    | succ k =>
+      simp only [List.getElem?_cons_succ] at h
+      rw [offs_cons, offs_cons, ih (fun j => cf (j + 1)) h]; omega
 
 section Ctl
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 theorem sim_jmp_ok (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
-    (hat : RAt code base (lowerInstr L base off (.jmp t))) :
+    (hat : RAt code base (lowerInstr L base off g (.jmp t))) :
     ∃ x', RSteps code x x' ∧ Rel0 c p s x' ∧ x'.pc = off t := by
   have hat' : RAt code base [.jmp (off t)] := hat
   obtain ⟨f0, _⟩ := hat'
@@ -35,18 +40,18 @@ theorem sim_jmp_ok (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
 
 /-- `branch t`: both outcomes. -/
 theorem sim_branch_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) {t : Nat} (hat : RAt code base (lowerInstr L base off (.branch t)))
+    (hpc : x.pc = base) {t : Nat} (hat : RAt code base (lowerInstr L base off g (.branch t)))
     {cc : W} {d : List W} (hd : s.dstack = cc :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := d } x' ∧
-      x'.pc = (if Word.isTrue cc then off t else base + isize (.branch t : WordDialect.Instr 32)) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .addImm Reg.r4 4,
+      x'.pc = (if Word.isTrue cc then off t else base + isize g (.branch t : WordDialect.Instr 32)) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .addImm Reg.r4 4,
       .bnez r0 (off t)]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := cc)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, ho3⟩ := adj_step (code := code) hg hr2 (n := 1) (by simp [hd])
@@ -60,7 +65,7 @@ theorem sim_branch_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
       simp [exec, hax3, hc]
     refine ⟨x3.adv, ((hs1.trans hs2).trans hs3).trans (RSteps.single hst4),
       hr3.congr rfl rfl rfl rfl rfl rfl rfl, ?_⟩
-    simp [hc, Word.isTrue, M.adv, hpc3, isize, ufSize]; omega
+    simp [hc, Word.isTrue, M.adv, hpc3, isize]; omega
   · have hst4 : step code x3 = .next { x3 with pc := off t } := by
       rw [rstep_of_fetch (m := x3) (fetch_cast f2 (by omega))]
       simp [exec, hax3, hc]
@@ -69,7 +74,7 @@ theorem sim_branch_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
     simp [hc, Word.isTrue]
 
 theorem sim_halt (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .halt)) : RExec code x (.halted x) := by
+    (hat : RAt code base (lowerInstr L base off g .halt)) : RExec code x (.halted x) := by
   have hat' : RAt code base [.exitHalt] := hat
   obtain ⟨f0, _⟩ := hat'
   exact RExec.halt (by rw [rstep_of_fetch (by rw [hpc]; exact f0)]; rfl)
@@ -78,7 +83,7 @@ theorem sim_halt (hs : Rel0 c p s x) (hpc : x.pc = base)
 (`sp`). -/
 theorem sim_call_core (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
     (hat : RAt code base [.call (off t)])
-    (hret : base + 1 = offs p (s.pc + 1)) (hfitR : s.rstack.length + 2 ≤ c.rcap) :
+    (hret : base + 1 = offs c.facts p (s.pc + 1)) (hfitR : s.rstack.length + 2 ≤ c.rcap) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with rstack := (s.pc + 1) :: s.rstack } x' ∧
       x'.pc = off t := by
   obtain ⟨f0, _⟩ := hat
@@ -170,9 +175,9 @@ theorem sim_call_core (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t :
   · simp only [List.length_cons]; omega
 
 theorem sim_ret_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .ret)) {a : Nat} {rs : List Nat}
-    (hr : s.rstack = a :: rs) (hsz : offs p a < 2 ^ 32) :
-    ∃ x', RSteps code x x' ∧ Rel0 c p { s with rstack := rs } x' ∧ x'.pc = offs p a := by
+    (hat : RAt code base (lowerInstr L base off g .ret)) {a : Nat} {rs : List Nat}
+    (hr : s.rstack = a :: rs) (hsz : offs c.facts p a < 2 ^ 32) :
+    ∃ x', RSteps code x x' ∧ Rel0 c p { s with rstack := rs } x' ∧ x'.pc = offs c.facts p a := by
   have hat' : RAt code base [.bcc .ne sp r9 (base + 2), .exitTrap .returnUnderflow, .ret] := hat
   obtain ⟨f0, f1, f3, _⟩ := hat'
   have hcapR := hs.capR
@@ -194,14 +199,14 @@ theorem sim_ret_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base)
   rw [hr] at hread
   simp only [List.length_cons, Nat.mul_zero, Nat.add_zero] at hread
   have hst3 : step code { x1 with pc := base + 2 } = .next { (({ x1 with pc := base + 2 } : M).setReg
-      sp (ofN (c.sp0 - 4 * rs.length))) with pc := offs p a } := by
+      sp (ofN (c.sp0 - 4 * rs.length))) with pc := offs c.facts p a } := by
     rw [rstep_of_fetch (m := { x1 with pc := base + 2 }) f3]
     have hx1r : x1.regs sp = ofN (c.sp0 - 4 * (rs.length + 1)) := hrsp
     have hx1m : x1.mem = x.mem := rfl
     have hadd : ofN (c.sp0 - 4 * (rs.length + 1)) + 4#32 = ofN (c.sp0 - 4 * rs.length) := by
       show ofN _ + ofN 4 = _
       rw [ofN_add]; congr 1; omega
-    have hv : (ofN (offs p a)).toNat = offs p a := by
+    have hv : (ofN (offs c.facts p a)).toNat = offs c.facts p a := by
       simp [ofN, BitVec.toNat_ofNat, Nat.mod_eq_of_lt hsz]
     simp only [exec]
     rw [hx1m, hx1r, hread]
@@ -230,7 +235,7 @@ theorem sim_ret_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base)
     omega
 
 theorem sim_ret_trap (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .ret)) (hr : s.rstack = []) :
+    (hat : RAt code base (lowerInstr L base off g .ret)) (hr : s.rstack = []) :
     RExec code x (.trapped .returnUnderflow) := by
   have hat' : RAt code base [.bcc .ne sp r9 (base + 2), .exitTrap .returnUnderflow, .ret] := hat
   obtain ⟨f0, f1, _⟩ := hat'
@@ -241,8 +246,8 @@ theorem sim_ret_trap (hs : Rel0 c p s x) (hpc : x.pc = base)
 
 /-- `call t`: the return-stack guard, then the model's `call`. -/
 theorem sim_call_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
-    (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hat : RAt code base (lowerInstr L base off (.call t)))
-    (hret : base + isize (.call t : WordDialect.Instr 32) = offs p (s.pc + 1))
+    (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hat : RAt code base (lowerInstr L base off g (.call t)))
+    (hret : base + isize g (.call t : WordDialect.Instr 32) = offs c.facts p (s.pc + 1))
     (hfitR : s.rstack.length + 2 ≤ c.rcap) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with rstack := (s.pc + 1) :: s.rstack } x' ∧
       x'.pc = off t := by
@@ -255,7 +260,7 @@ theorem sim_call_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t : N
   exact ⟨x', hs1.trans hs', hr', hpc'⟩
 
 theorem sim_call_ovf (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {t : Nat}
-    (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hat : RAt code base (lowerInstr L base off (.call t)))
+    (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hat : RAt code base (lowerInstr L base off g (.call t)))
     (h : ¬ s.rstack.length + 2 ≤ c.rcap) : RExec code x .overflow := by
   have hat' : RAt code base (ovfR L base ++ [.call (off t)]) := hat
   exact ovfR_trap hg hs hLr h hpc (rat_append.mp hat').1

backend/cortexm0/CM0/SimDiv.lean

@@ -19,7 +19,7 @@ open Reg
 section Div
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 /-- `Rel0` ignores scratch registers. -/
 theorem rel0_scratch (hs : Rel0 c p s x) {x' : M} (hm : x'.mem = x.mem)
@@ -52,18 +52,18 @@ theorem zg_trap (hb : x.regs r1 = 0#32) {t : Nat}
 run a division sequence `seg` that leaves `f a b` in `r0` (`CM0/Divide.lean`), store and pop. -/
 theorem sim_divop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
     (hpc : x.pc = base) (seg : List (Instr Nat)) (f : W → W → W)
-    (hseg : ∀ (m : M) (a b : W), RAt code (base + ufSize 2 + 4) seg → m.pc = base + ufSize 2 + 4 →
+    (hseg : ∀ (m : M) (a b : W), RAt code (base + ufSize (need g 2) + 4) seg → m.pc = base + ufSize (need g 2) + 4 →
       m.regs r0 = a → m.regs r1 = b → b ≠ 0#32 →
-      ∃ m', RSteps code m m' ∧ m'.pc = base + ufSize 2 + 4 + seg.length ∧ m'.regs r0 = f a b ∧
+      ∃ m', RSteps code m m' ∧ m'.pc = base + ufSize (need g 2) + 4 + seg.length ∧ m'.regs r0 = f a b ∧
         m'.mem = m.mem ∧ ∀ r, ¬ DivScratch r → m'.regs r = m.regs r)
-    (hat : RAt code base (uf L 2 base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .bnez r1 (base + ufSize 2 + 4), .exitTrap .divideByZero] ++ seg ++ [.store Reg.r4 4 r0,
+    (hat : RAt code base (uf L (need g 2) base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .bnez r1 (base + ufSize (need g 2) + 4), .exitTrap .divideByZero] ++ seg ++ [.store Reg.r4 4 r0,
       .addImm Reg.r4 4])))
     {a b : W} {d : List W} (hd : s.dstack = b :: a :: d) (hb : b ≠ 0#32) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := f a b :: d } x' ∧
-      x'.pc = base + (ufSize 2 + 4 + seg.length + 2) := by
+      x'.pc = base + (ufSize (need g 2) + 4 + seg.length + 2) := by
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨hat4s, hatend⟩ := rat_append.mp hatr
   obtain ⟨hat4, hatseg⟩ := rat_append.mp hat4s
@@ -71,47 +71,47 @@ theorem sim_divop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x
   obtain ⟨f5, f6, _⟩ := hatend
   simp only [List.length_append, List.length_cons, List.length_nil] at hatseg f5 f6
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := b)
     (by simp [hd]) (rd := r1) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 4) (by simp) (fetch_cast f1 (by omega))
   have hcx3 : x3.regs r1 = b := by rw [ho3 r1 (by decide), hv2]
   obtain ⟨x4, hs4, hr4, hpc4, hreg4, hm4⟩ := zg_pass (code := code) hr3 hcx3 hb
-    (t := base + ufSize 2 + 4) (by simp [ufSize]; omega)
+    (t := base + ufSize (need g 2) + 4) (by omega)
     ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩
   have hax4 : x4.regs r0 = a := by rw [hreg4, hv3]
   have hcx4 : x4.regs r1 = b := by rw [hreg4, hcx3]
-  have hpc4' : x4.pc = base + ufSize 2 + 4 := by simp [ufSize]; omega
+  have hpc4' : x4.pc = base + ufSize (need g 2) + 4 := by omega
   obtain ⟨x5, hs5, hpc5, hax5, hm5, hfr5⟩ := hseg x4 a b
-    (by simpa [ufSize, Nat.add_assoc] using hatseg) hpc4' hax4 hcx4 hb
+    (by simpa [Nat.add_assoc] using hatseg) hpc4' hax4 hcx4 hb
   have hr5 : Rel0 c p s x5 :=
     hr4.congr hm5 (hfr5 _ (by simp [DivScratch])) (hfr5 _ (by simp [DivScratch]))
       (hfr5 _ (by simp [DivScratch])) (hfr5 _ (by simp [DivScratch]))
       (hfr5 _ (by simp [DivScratch])) (hfr5 _ (by simp [DivScratch]))
   obtain ⟨x6, hs6, hr6, hpc6, _⟩ := st_step (code := code) hg hr5 (j := 1) (by simp [hd])
-    (rs := r0) (disp := 4) (by simp) (fetch_cast f5 (by simp [ufSize] at hpc5 ⊢; omega))
+    (rs := r0) (disp := 4) (by simp) (fetch_cast f5 (by omega))
   have hlen : 1 ≤ ({ s with dstack := s.dstack.set 1 (x5.regs r0) } : State 32).dstack.length := by
     simp [hd]
   obtain ⟨x7, hs7, hr7, hpc7, _⟩ := adj_step (code := code) hg hr6 (n := 1) hlen (δ := 4) (by simp)
-    (fetch_cast f6 (by simp [ufSize] at hpc5 hpc6 ⊢; omega))
+    (fetch_cast f6 (by omega))
   have hr7' : Rel0 c p { s with dstack := (s.dstack.set 1 (x5.regs r0)).drop 1 } x7 := hr7
   have e : (s.dstack.set 1 (x5.regs r0)).drop 1 = f a b :: d := by simp [hd, hax5]
   rw [e] at hr7'
   exact ⟨x7, ((((hs1.trans hs2).trans hs3).trans hs4).trans (hs5.trans (hs6.trans hs7))), hr7', by
-      simp [ufSize] at hpc7 hpc6 hpc5 ⊢; omega⟩
+      omega⟩
 
 theorem sim_divop_zero (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
     (hpc : x.pc = base) (rest : List (Instr Nat))
-    (hat : RAt code base (uf L 2 base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .bnez r1 (base + ufSize 2 + 4), .exitTrap .divideByZero] ++ rest)))
+    (hat : RAt code base (uf L (need g 2) base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .bnez r1 (base + ufSize (need g 2) + 4), .exitTrap .divideByZero] ++ rest)))
     {a : W} {d : List W} (hd : s.dstack = 0#32 :: a :: d) : RExec code x (.trapped .divideByZero) := by
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := 0#32)
     (by simp [hd]) (rd := r1) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := a)
@@ -121,12 +121,12 @@ theorem sim_divop_zero (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
     ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩)
 
 theorem sim_div_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .div)) {a b : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .div)) {a b : W} {d : List W}
     (hd : s.dstack = b :: a :: d) (hb : b ≠ 0#32) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a.udiv b :: d } x' ∧
-      x'.pc = base + isize (.div : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 2 base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .bnez r1 (base + ufSize 2 + 4), .exitTrap .divideByZero] ++ udivSeq (base + ufSize 2 + 4) ++
+      x'.pc = base + isize g (.div : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 2) base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .bnez r1 (base + ufSize (need g 2) + 4), .exitTrap .divideByZero] ++ udivSeq (base + ufSize (need g 2) + 4) ++
       [.store Reg.r4 4 r0, .addImm Reg.r4 4])) := hat
   obtain ⟨x', hs', hr', hpc'⟩ := sim_divop_ok hg hL hs hpc _ BitVec.udiv
     (fun m a b hat hpc h0 h1 hb => by
@@ -134,18 +134,18 @@ theorem sim_div_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
   exact ⟨x', hs', hr', by rw [hpc']; simp [isize, udivSeq, udivCode]⟩
 
 theorem sim_div_zero (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .div)) {a : W} {d : List W}
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .div)) {a : W} {d : List W}
     (hd : s.dstack = 0#32 :: a :: d) : RExec code x (.trapped .divideByZero) :=
-  sim_divop_zero hg hL hs hpc (udivSeq (base + ufSize 2 + 4) ++ [.store Reg.r4 4 r0, .addImm Reg.r4 4])
+  sim_divop_zero hg hL hs hpc (udivSeq (base + ufSize (need g 2) + 4) ++ [.store Reg.r4 4 r0, .addImm Reg.r4 4])
     (by simpa [lowerInstr, List.append_assoc] using hat) hd
 
 theorem sim_sdiv_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .sdiv)) {a b : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .sdiv)) {a b : W} {d : List W}
     (hd : s.dstack = b :: a :: d) (hb : b ≠ 0#32) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a.sdiv b :: d } x' ∧
-      x'.pc = base + isize (.sdiv : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 2 base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .bnez r1 (base + ufSize 2 + 4), .exitTrap .divideByZero] ++ sdivSeq (base + ufSize 2 + 4) ++
+      x'.pc = base + isize g (.sdiv : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 2) base ++ ([.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .bnez r1 (base + ufSize (need g 2) + 4), .exitTrap .divideByZero] ++ sdivSeq (base + ufSize (need g 2) + 4) ++
       [.store Reg.r4 4 r0, .addImm Reg.r4 4])) := hat
   obtain ⟨x', hs', hr', hpc'⟩ := sim_divop_ok hg hL hs hpc _ BitVec.sdiv
     (fun m a b hat hpc h0 h1 hb => by
@@ -153,26 +153,26 @@ theorem sim_sdiv_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
   exact ⟨x', hs', hr', by rw [hpc']; simp [isize, sdivSeq, udivCode]⟩
 
 theorem sim_sdiv_zero (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .sdiv)) {a : W} {d : List W}
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .sdiv)) {a : W} {d : List W}
     (hd : s.dstack = 0#32 :: a :: d) : RExec code x (.trapped .divideByZero) :=
-  sim_divop_zero hg hL hs hpc (sdivSeq (base + ufSize 2 + 4) ++ [.store Reg.r4 4 r0, .addImm Reg.r4 4])
+  sim_divop_zero hg hL hs hpc (sdivSeq (base + ufSize (need g 2) + 4) ++ [.store Reg.r4 4 r0, .addImm Reg.r4 4])
     (by simpa [lowerInstr, List.append_assoc] using hat) hd
 
 theorem sim_select_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .select)) {cc y v : W}
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .select)) {cc y v : W}
     {d : List W} (hd : s.dstack = cc :: y :: v :: d) :
     ∃ x', RSteps code x x' ∧
       Rel0 c p { s with dstack := (if Word.isTrue cc then v else y) :: d } x' ∧
-      x'.pc = base + isize (.select : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 3 base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .load r3 Reg.r4 8, .beqz r1 (base + ufSize 3 + 5), .movRR r0 r3, .store Reg.r4 8 r0,
+      x'.pc = base + isize g (.select : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 3) base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .load r3 Reg.r4 8, .beqz r1 (base + ufSize (need g 3) + 5), .movRR r0 r3, .store Reg.r4 8 r0,
       .addImm Reg.r4 8]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 3 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 3) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, f6, _⟩ := hatr
   have hk : 3 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := cc)
     (by simp [hd]) (rd := r1) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := y)
@@ -181,13 +181,13 @@ theorem sim_select_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
     (by simp [hd]) (rd := r3) (by simp) (disp := 8) (by simp) (fetch_cast f2 (by omega))
   have hcx4 : x4.regs r1 = cc := by rw [ho4 r1 (by decide), ho3 r1 (by decide), hv2]
   have hax4 : x4.regs r0 = y := by rw [ho4 r0 (by decide), hv3]
-  -- after the branch (and the `mv` when `cc ≠ 0`), `r0` holds the result at `base + 3 + 5`
+  -- after the branch (and the `mv` when `cc ≠ 0`), `r0` holds the result at `base + ufSize (need g 3) + 5`
   obtain ⟨x6, hs6, hr6, hpc6, hval⟩ : ∃ x6, RSteps code x4 x6 ∧ Rel0 c p s x6 ∧
-      x6.pc = base + 3 + 5 ∧ x6.regs r0 = (if Word.isTrue cc then v else y) := by
+      x6.pc = base + ufSize (need g 3) + 5 ∧ x6.regs r0 = (if Word.isTrue cc then v else y) := by
     by_cases hc : cc = 0#32
-    · have hst : step code x4 = .next { x4 with pc := base + ufSize 3 + 5 } := by
+    · have hst : step code x4 = .next { x4 with pc := base + ufSize (need g 3) + 5 } := by
         rw [rstep_of_fetch (m := x4) (fetch_cast f3 (by omega))]; simp [exec, hcx4, hc]
-      refine ⟨_, RSteps.single hst, hr4.congr rfl rfl rfl rfl rfl rfl rfl, by simp [ufSize], ?_⟩
+      refine ⟨_, RSteps.single hst, hr4.congr rfl rfl rfl rfl rfl rfl rfl, rfl, ?_⟩
       simp [hax4, Word.isTrue, hc]
     · have hst : step code x4 = .next x4.adv := by
         rw [rstep_of_fetch (m := x4) (fetch_cast f3 (by omega))]; simp [exec, hcx4, hc]
@@ -210,24 +210,24 @@ theorem sim_select_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s
     simp [hd, hval]
   rw [e] at hr8'
   exact ⟨x8, (((((hs1.trans hs2).trans hs3).trans hs4).trans hs6).trans hs7).trans hs8, hr8',
-    by simp [isize, ufSize]; omega⟩
+    by simp [isize]; omega⟩
 
 /-- `cmp c`: `r2 := 1`, then `bcc c` skips `r2 := 0` exactly when the IR comparison holds. -/
 theorem sim_cmp_ok (cd : WordDialect.Cond) (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off (.cmp cd)))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g (.cmp cd)))
     {b a : W} {d : List W} (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧
       Rel0 c p { s with dstack := Word.ofBool (cd.eval a b) :: d } x' ∧
-      x'.pc = base + isize (.cmp cd : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 2 base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
-      .movImm r2 1#32, .bcc cd r0 r1 (base + ufSize 2 + 5), .movImm r2 0#32, .store Reg.r4 4 r2,
+      x'.pc = base + isize g (.cmp cd : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 2) base ++ [.load r1 Reg.r4 0, .load r0 Reg.r4 4,
+      .movImm r2 1#32, .bcc cd r0 r1 (base + ufSize (need g 2) + 5), .movImm r2 0#32, .store Reg.r4 4 r2,
       .addImm Reg.r4 4]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, f6, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, _⟩ := ld_step (code := code) hr1 (j := 0) (v := b)
     (by simp [hd]) (rd := r1) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := a)
@@ -238,11 +238,11 @@ theorem sim_cmp_ok (cd : WordDialect.Cond) (hg : Geom c) (hL : L.dEnd = ofN c.dE
   have hax4 : x4.regs r0 = a := by rw [ho4 r0 (by decide), hv3]
   have hcx4 : x4.regs r1 = b := by rw [ho4 r1 (by decide), hcx3]
   obtain ⟨x6, hs6, hr6, hpc6, hval⟩ : ∃ x6, RSteps code x4 x6 ∧ Rel0 c p s x6 ∧
-      x6.pc = base + 3 + 5 ∧ x6.regs r2 = Word.ofBool (cd.eval a b) := by
+      x6.pc = base + ufSize (need g 2) + 5 ∧ x6.regs r2 = Word.ofBool (cd.eval a b) := by
     by_cases hc : cd.eval a b = true
-    · have hst : step code x4 = .next { x4 with pc := base + ufSize 2 + 5 } := by
+    · have hst : step code x4 = .next { x4 with pc := base + ufSize (need g 2) + 5 } := by
         rw [rstep_of_fetch (m := x4) (fetch_cast f3 (by omega))]; simp [exec, hax4, hcx4, hc]
-      refine ⟨_, RSteps.single hst, hr4.congr rfl rfl rfl rfl rfl rfl rfl, by simp [ufSize], ?_⟩
+      refine ⟨_, RSteps.single hst, hr4.congr rfl rfl rfl rfl rfl rfl rfl, rfl, ?_⟩
       simp [hv4, hc, Word.ofBool]
     · have hc' : cd.eval a b = false := by simpa using hc
       have hst : step code x4 = .next x4.adv := by
@@ -263,7 +263,7 @@ theorem sim_cmp_ok (cd : WordDialect.Cond) (hg : Geom c) (hL : L.dEnd = ofN c.dE
     simp [hd, hval]
   rw [e] at hr8'
   exact ⟨x8, (((((hs1.trans hs2).trans hs3).trans hs4).trans hs6).trans hs7).trans hs8, hr8',
-    by simp [isize, ufSize]; omega⟩
+    by simp [isize]; omega⟩
 
 end Div
 

backend/cortexm0/CM0/SimMemOps.lean

@@ -16,7 +16,7 @@ open Reg
 section Ops
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 theorem ult_memSize {a : W} {n : Nat} (hn : n < 2 ^ 32) :
     a.ult (BitVec.ofNat 32 n) = decide (a.toNat < n) := by
@@ -65,42 +65,42 @@ theorem addr_trap (hs : Rel0 c p s x) {rt : Reg} (hrt : rt = r1 ∨ rt = r2) {n
 
 theorem sim_push_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {r : Nat}
     (hr : r < c.nregs) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hat : RAt code base (lowerInstr L base off (.push r)))
+    (hat : RAt code base (lowerInstr L base off g (.push r)))
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := s.regs r :: s.dstack } x' ∧
-      x'.pc = base + isize (.push r : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.push r : WordDialect.Instr 32) := by
   obtain ⟨hato, f0, f1, f2⟩ := xat_ovf3 (L := L) (by exact hat)
-  obtain ⟨x0, hs0, hr0, hpc0, _, _⟩ := ovfD_pass hg hs hLd hfit hpc hato
+  obtain ⟨x0, hs0, hr0, hpc0, _, _⟩ := ovfG_pass hg hs hLd hfit hpc hato
   have hst : step code x0 = .next (x0.mov r0 (s.regs r)) := by
     rw [rstep_of_fetch (by rw [hpc0]; exact f0), ld_reg hr0 hr r0 rfl]
   have hr1 : Rel0 c p s (x0.mov r0 (s.regs r)) := mov_rel0 hr0 r0 (scratch_ne r0 (by simp)) _
-  have hpc1 : (x0.mov r0 (s.regs r)).pc = base + 3 + 1 := by simp [M.mov, M.setReg, M.adv, hpc0]
+  have hpc1 : (x0.mov r0 (s.regs r)).pc = base + ovfSize g + 1 := by simp [M.mov, M.setReg, M.adv, hpc0]
   obtain ⟨x2, hs2, hr2, hpc2, _⟩ := push_pair hg hr1 r0 (by decide) hfit
     ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), trivial⟩
   have hv : (x0.mov r0 (s.regs r)).regs r0 = s.regs r := by simp [M.mov, M.setReg, M.adv]
   rw [hv] at hr2
   exact ⟨x2, (hs0.trans (RSteps.single hst)).trans hs2, hr2, by simp [isize]; omega⟩
 
-theorem sim_push_ovf (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {r : Nat}
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.push r)))
+theorem sim_push_ovf (hn : g.noOvf = false) (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) {r : Nat}
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.push r)))
     (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) : RExec code x .overflow := by
   obtain ⟨hato, _⟩ := xat_ovf3 (L := L) (by exact hat)
-  exact ovfD_trap hg hs hLd h hpc hato
+  exact ovfG_trap hn hg hs hLd h hpc hato
 
 theorem sim_pop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    {r : Nat} (hr : r < c.nregs) (hat : RAt code base (lowerInstr L base off (.pop r)))
+    {r : Nat} (hr : r < c.nregs) (hat : RAt code base (lowerInstr L base off g (.pop r)))
     {a : W} {d : List W} (hd : s.dstack = a :: d) :
     ∃ x', RSteps code x x' ∧
       Rel0 c p { s with dstack := d, regs := State.setReg s.regs r a } x' ∧
-      x'.pc = base + isize (.pop r : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .addImm Reg.r4 4,
+      x'.pc = base + isize g (.pop r : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .addImm Reg.r4 4,
       .store Reg.r5 (4 * (r : Int)) r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, ho3⟩ := adj_step (code := code) hg hr2 (n := 1) (by simp [hd])
@@ -114,18 +114,18 @@ theorem sim_pop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
   have e : s.dstack.drop 1 = d := by simp [hd]
   rw [e, hax3] at hr4'
   exact ⟨_, ((hs1.trans hs2).trans hs3).trans (RSteps.single hst4), hr4',
-    by simp [M.adv, isize, ufSize]; omega⟩
+    by simp [M.adv, isize]; omega⟩
 
 theorem sim_load_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .load))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .load))
     {a v : W} {d : List W} (hd : s.dstack = a :: d) (hv : s.mem.read? a = some v) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := v :: d } x' ∧
-      x'.pc = base + isize (.load : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize),
-      .bcc .ult r0 r1 (base + ufSize 1 + 4), .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r8,
+      x'.pc = base + isize g (.load : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize),
+      .bcc .ult r0 r1 (base + ufSize (need g 1) + 4), .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r8,
       .load r0 r0 0, .store Reg.r4 0 r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, f6, f7, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
@@ -135,11 +135,11 @@ theorem sim_load_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize =
     have := hs.irvalid a
     rw [hvv] at this
     simpa using this.symm
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, hm2⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hax3, ho3, hm3⟩ := addr_pass (code := code) hr2 (rt := r1) (by simp)
-    (n := c.M) hMlt (t := base + ufSize 1 + 4) (by simp [ufSize]; omega) hv2 hlt (by
+    (n := c.M) hMlt (t := base + ufSize (need g 1) + 4) (by omega) hv2 hlt (by
       rw [← hMs]
       refine ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩)
   obtain ⟨x4, hs4, hr4, hpc4, hax4, _, _⟩ := idx_steps hr3 hax3
@@ -153,17 +153,17 @@ theorem sim_load_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize =
     simp [hd, M.mov, M.setReg, M.adv]
   rw [e] at hr6
   exact ⟨x6, ((((hs1.trans hs2).trans hs3).trans hs4).trans (RSteps.single hst5)).trans hs6, hr6,
-    by simp [M.mov, M.setReg, M.adv, isize, ufSize] at *; omega⟩
+    by simp [M.mov, M.setReg, M.adv, isize] at *; omega⟩
 
 theorem sim_load_trap (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .load))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .load))
     {a : W} {d : List W} (hd : s.dstack = a :: d) (hv : s.mem.read? a = none) :
     RExec code x (.trapped .badAddress) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize),
-      .bcc .ult r0 r1 (base + ufSize 1 + 4), .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r8,
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .movImm r1 (BitVec.ofNat 32 L.memSize),
+      .bcc .ult r0 r1 (base + ufSize (need g 1) + 4), .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r8,
       .load r0 r0 0, .store Reg.r4 0 r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
@@ -173,25 +173,25 @@ theorem sim_load_trap (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize
     have := hs.irvalid a
     rw [hvv] at this
     simpa using this
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, hm2⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   exact RExec.of_steps (hs1.trans hs2) (addr_trap (code := code) hr2 (rt := r1) (by simp)
-    (n := c.M) hMlt (t := base + ufSize 1 + 4) (by simp [ufSize]; omega) hv2 hge (by
+    (n := c.M) hMlt (t := base + ufSize (need g 1) + 4) (by omega) hv2 hge (by
       rw [← hMs]
       refine ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩))
 
 theorem sim_store_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .store))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .store))
     {a v : W} {d : List W} (hd : s.dstack = a :: v :: d) {m : Memory 32}
     (hw : s.mem.write? a v = some m) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := d, mem := m } x' ∧
-      x'.pc = base + isize (.store : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 2 base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
-      .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (base + ufSize 2 + 5),
+      x'.pc = base + isize g (.store : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 2) base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
+      .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (base + ufSize (need g 2) + 5),
       .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r8, .store r0 0 r1, .addImm Reg.r4 8]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, f6, f7, f8, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
@@ -204,14 +204,14 @@ theorem sim_store_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize =
     have := hs.irvalid a
     rw [hv] at this
     simpa using this.symm
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, hm2⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, hm3⟩ := ld_step (code := code) hr2 (j := 1) (v := v)
     (by simp [hd]) (rd := r1) (by simp) (disp := 4) (by simp) (fetch_cast f1 (by omega))
   have hax3 : x3.regs r0 = a := by rw [ho3 r0 (by decide), hv2]
   obtain ⟨x4, hs4, hr4, hpc4, hax4, ho4, hm4⟩ := addr_pass (code := code) hr3 (rt := r2) (by simp)
-    (n := c.M) hMlt (t := base + ufSize 2 + 5) (by simp [ufSize]; omega) hax3 hlt (by
+    (n := c.M) hMlt (t := base + ufSize (need g 2) + 5) (by omega) hax3 hlt (by
       rw [← hMs]
       refine ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), fetch_cast f4 (by omega), trivial⟩)
   have hcx4 : x4.regs r1 = v := by rw [ho4 r1 (by decide), hv3]
@@ -229,17 +229,17 @@ theorem sim_store_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize =
         = { s with dstack := d, mem := m } := by simp [hd]
     rw [← this]; exact hr7
   exact ⟨x7, (((((hs1.trans hs2).trans hs3).trans hs4).trans hs5).trans (RSteps.single hst6)).trans hs7,
-    hr7', by simp [M.adv, isize, ufSize] at *; omega⟩
+    hr7', by simp [M.adv, isize] at *; omega⟩
 
 theorem sim_store_trap (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .store))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .store))
     {a v : W} {d : List W} (hd : s.dstack = a :: v :: d) (hw : s.mem.write? a v = none) :
     RExec code x (.trapped .badAddress) := by
-  have hat' : RAt code base (uf L 2 base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
-      .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (base + ufSize 2 + 5),
+  have hat' : RAt code base (uf L (need g 2) base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
+      .movImm r2 (BitVec.ofNat 32 L.memSize), .bcc .ult r0 r2 (base + ufSize (need g 2) + 5),
       .exitTrap .badAddress, .shlImm r0 2, .add r0 Reg.r8, .store r0 0 r1, .addImm Reg.r4 8]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
@@ -249,14 +249,14 @@ theorem sim_store_trap (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize
     have := hs.irvalid a
     rw [hvv] at this
     simpa using this
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, ho2, hm2⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, hm3⟩ := ld_step (code := code) hr2 (j := 1) (v := v)
     (by simp [hd]) (rd := r1) (by simp) (disp := 4) (by simp) (fetch_cast f1 (by omega))
   have hax3 : x3.regs r0 = a := by rw [ho3 r0 (by decide), hv2]
   exact RExec.of_steps ((hs1.trans hs2).trans hs3) (addr_trap (code := code) hr3 (rt := r2)
-    (by simp) (n := c.M) hMlt (t := base + ufSize 2 + 5) (by simp [ufSize]; omega) hax3 hge (by
+    (by simp) (n := c.M) hMlt (t := base + ufSize (need g 2) + 5) (by omega) hax3 hge (by
       rw [← hMs]
       refine ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), fetch_cast f4 (by omega), trivial⟩))
 

backend/cortexm0/CM0/SimOps.lean

@@ -16,40 +16,40 @@ open Reg
 
 /-- Operand-count trap: any lowering that starts with `uf n` exits with `stackUnderflow`. -/
 theorem sim_uf_trap {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base n : Nat} {rest : List (Instr Nat)} (hg : Geom c) (hs : Rel0 c p s x)
-    (hL : L.dEnd = ofN c.dEnd) (hn : 0 < n) (hn3 : n ≤ 3) (hk : s.dstack.length < n)
-    (hpc : x.pc = base) (hat : RAt code base (uf L n base ++ rest)) :
+    {L : Layout} {base n : Nat} {g : Facts} {rest : List (Instr Nat)} (hg : Geom c) (hs : Rel0 c p s x)
+    (hL : L.dEnd = ofN c.dEnd) (hn : 0 < n) (hn3 : n ≤ 3) (hgd : g.lo ≤ s.dstack.length)
+    (hk : s.dstack.length < n) (hpc : x.pc = base) (hat : RAt code base (uf L (need g n) base ++ rest)) :
     RExec code x (.trapped .stackUnderflow) :=
-  uf_trap hg hs hL hn hn3 hk hpc (rat_append.mp hat).1
+  uf_trap hg hs hL hn hn3 hgd hk hpc (rat_append.mp hat).1
 
 macro "mid_tac" : tactic =>
   `(tactic| (intro m a b ha hb
              simp [rseq, exec, M.arith, M.mov, M.setReg, M.adv, ha, hb, MidSpec]))
 
 theorem sim_bin_instr {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base : Nat} {off : Nat → Nat} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
+    {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
     (hs : Rel0 c p s x) (hpc : x.pc = base) (i : WordDialect.Instr 32) (mid : List (Instr Nat))
     (rr : Reg) (hrr : rr = r0 ∨ rr = r1 ∨ rr = r2 ∨ rr = r3) (f : W → W → W)
     (hmid : MidSpec mid rr f) (hstr : ∀ j ∈ mid, j.straightR = true)
-    (hlow : lowerInstr L base off i = uf L 2 base ++
+    (hlow : lowerInstr L base off g i = uf L (need g 2) base ++
       ([.load r1 r4 0, .load r0 r4 4] ++ mid ++ [.store r4 4 rr, .addImm r4 4]))
-    (hsize : isize i = 3 + (4 + mid.length))
-    (hat : RAt code base (lowerInstr L base off i)) {b a : W} {d : List W}
+    (hsize : isize g i = ufSize (need g 2) + (4 + mid.length))
+    (hat : RAt code base (lowerInstr L base off g i)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := f a b :: d } x' ∧
-      x'.pc = base + isize i := by
+      x'.pc = base + isize g i := by
   rw [hlow] at hat
   obtain ⟨x', h1, h2, h3⟩ := sim_bin_ok hg hL hs hpc mid rr hrr f hmid hstr hat hd
   exact ⟨x', h1, h2, by rw [h3, hsize]; omega⟩
 
 theorem sim_uf2_trap {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base : Nat} {off : Nat → Nat} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
+    {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts} (hg : Geom c) (hL : L.dEnd = ofN c.dEnd)
     (hs : Rel0 c p s x) (hpc : x.pc = base) (i : WordDialect.Instr 32) (rest : List (Instr Nat))
-    (hlow : lowerInstr L base off i = uf L 2 base ++ rest)
-    (hat : RAt code base (lowerInstr L base off i)) (hk : s.dstack.length < 2) :
-    RExec code x (.trapped .stackUnderflow) := by
+    (hlow : lowerInstr L base off g i = uf L (need g 2) base ++ rest)
+    (hat : RAt code base (lowerInstr L base off g i)) (hgd : g.lo ≤ s.dstack.length)
+    (hk : s.dstack.length < 2) : RExec code x (.trapped .stackUnderflow) := by
   rw [hlow] at hat
-  exact sim_uf_trap hg hs hL (by decide) (by decide) hk hpc hat
+  exact sim_uf_trap hg hs hL (by decide) (by decide) hgd hk hpc hat
 
 /-! ### Middle computations -/
 
@@ -155,87 +155,87 @@ theorem midspec_rotr : MidSpec [.ror r0 r1] r0 Word.rotr := by
 
 section Ops
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)} {L : Layout}
-  {base : Nat} {off : Nat → Nat}
+  {base : Nat} {off : Nat → Nat} {g : Facts}
 
 theorem sim_add_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .add)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .add)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a + b) :: d } x' ∧
-      x'.pc = base + isize (.add : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.add : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .add [.add r0 r1] r0 (by simp) (· + ·) midspec_add
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_sub_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .sub)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .sub)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a - b) :: d } x' ∧
-      x'.pc = base + isize (.sub : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.sub : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .sub [.sub r0 r1] r0 (by simp) (· - ·) midspec_sub
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_mul_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .mul)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .mul)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a * b) :: d } x' ∧
-      x'.pc = base + isize (.mul : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.mul : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .mul [.mul r0 r1] r0 (by simp) (· * ·) midspec_mul
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_and_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .and)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .and)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a &&& b) :: d } x' ∧
-      x'.pc = base + isize (.and : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.and : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .and [.and r0 r1] r0 (by simp) (· &&& ·) midspec_and
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_or_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .or)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .or)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a ||| b) :: d } x' ∧
-      x'.pc = base + isize (.or : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.or : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .or [.or r0 r1] r0 (by simp) (· ||| ·) midspec_or
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_xor_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .xor)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .xor)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (a ^^^ b) :: d } x' ∧
-      x'.pc = base + isize (.xor : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.xor : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .xor [.xor r0 r1] r0 (by simp) (· ^^^ ·) midspec_xor
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_shl_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .shl)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .shl)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := Word.shl a b :: d } x' ∧
-      x'.pc = base + isize (.shl : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.shl : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .shl _ r0 (by simp) Word.shl midspec_shl
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_shr_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .shr)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .shr)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := Word.shr a b :: d } x' ∧
-      x'.pc = base + isize (.shr : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.shr : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .shr _ r0 (by simp) Word.shr midspec_shr
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_rotl_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .rotl)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .rotl)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := Word.rotl a b :: d } x' ∧
-      x'.pc = base + isize (.rotl : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.rotl : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .rotl _ r0 (by simp) Word.rotl midspec_rotl
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 theorem sim_rotr_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .rotr)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .rotr)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := Word.rotr a b :: d } x' ∧
-      x'.pc = base + isize (.rotr : WordDialect.Instr 32) :=
+      x'.pc = base + isize g (.rotr : WordDialect.Instr 32) :=
   sim_bin_instr hg hL hs hpc .rotr _ r0 (by simp) Word.rotr midspec_rotr
-    (by simp [Instr.straightR]) rfl (by simp [isize, ufSize]) hat hd
+    (by simp [Instr.straightR]) rfl (by simp [isize]) hat hd
 
 end Ops
 

backend/cortexm0/CM0/SimStack.lean

@@ -64,51 +64,53 @@ theorem not_step (hs : Rel0 c p s x) (hf : code[x.pc]? = some (.not r0)) :
 
 end Steps
 
-/-- Placement of `ovfD L base ++ [i0, i1, i2]`. -/
-theorem xat_ovf3 {code : List (Instr Nat)} {L : Layout} {base : Nat} {i0 i1 i2 : Instr Nat}
-    (hat : RAt code base (ovfD L base ++ [i0, i1, i2])) :
-    RAt code base (ovfD L base) ∧ code[base + 3]? = some i0 ∧ code[base + 3 + 1]? = some i1 ∧
-      code[base + 3 + 1 + 1]? = some i2 := by
+/-- Placement of `ovf L g base ++ [i0, i1, i2]`. -/
+theorem xat_ovf3 {code : List (Instr Nat)} {L : Layout} {g : Facts} {base : Nat}
+    {i0 i1 i2 : Instr Nat} (hat : RAt code base (ovf L g base ++ [i0, i1, i2])) :
+    RAt code base (ovf L g base) ∧ code[base + ovfSize g]? = some i0 ∧
+      code[base + ovfSize g + 1]? = some i1 ∧ code[base + ovfSize g + 1 + 1]? = some i2 := by
   obtain ⟨hato, hatr⟩ := rat_append.mp hat
-  have hl : (ovfD L base).length = 3 := rfl
-  rw [hl] at hatr
+  rw [ovf_length] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
   exact ⟨hato, f0, f1, f2⟩
 
-/-- Placement of `uf L n base ++ ovfD L (base + ufSize n) ++ [i0, i1, i2]`. -/
-theorem xat_uf_ovf {code : List (Instr Nat)} {L : Layout} {base n : Nat} (hn : 0 < n)
+/-- Placement of `uf L n base ++ ovf L g (base + ufSize n) ++ [i0, i1, i2]`. -/
+theorem xat_uf_ovf {code : List (Instr Nat)} {L : Layout} {g : Facts} {base n : Nat}
     {i0 i1 i2 : Instr Nat} {rest : List (Instr Nat)} (hrest : rest = [i0, i1, i2])
-    (hat : RAt code base (uf L n base ++ ovfD L (base + ufSize n) ++ rest)) :
-    RAt code base (uf L n base) ∧ RAt code (base + 3) (ovfD L (base + 3)) ∧
-      code[base + 6]? = some i0 ∧ code[base + 6 + 1]? = some i1 ∧ code[base + 6 + 1 + 1]? = some i2 := by
+    (hat : RAt code base (uf L n base ++ ovf L g (base + ufSize n) ++ rest)) :
+    RAt code base (uf L n base) ∧ RAt code (base + ufSize n) (ovf L g (base + ufSize n)) ∧
+      code[base + ufSize n + ovfSize g]? = some i0 ∧
+      code[base + ufSize n + ovfSize g + 1]? = some i1 ∧
+      code[base + ufSize n + ovfSize g + 1 + 1]? = some i2 := by
   subst hrest
-  rw [ufSize_pos hn] at hat
   obtain ⟨hatuo, hatr⟩ := rat_append.mp hat
   obtain ⟨hatuf, hato⟩ := rat_append.mp hatuo
-  have hufl : (uf L n base).length = 3 := by rw [uf_eq L hn]; rfl
+  have hufl := uf_length L n base
   rw [hufl] at hato
-  have hl : (uf L n base ++ ovfD L (base + 3)).length = 6 := by simp [hufl, ovfD]
+  have hl : (uf L n base ++ ovf L g (base + ufSize n)).length = ufSize n + ovfSize g := by
+    simp [hufl, ovf_length]
   rw [hl] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
-  exact ⟨hatuf, hato, f0, f1, f2⟩
+  exact ⟨hatuf, hato, by simpa [Nat.add_assoc] using f0, by simpa [Nat.add_assoc] using f1,
+    by simpa [Nat.add_assoc] using f2⟩
 
 section Ops
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 theorem sim_not_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .not)) {a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .not)) {a : W} {d : List W}
     (hd : s.dstack = a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := (~~~a) :: d } x' ∧
-      x'.pc = base + isize (.not : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 1 base ++ [.load r0 Reg.r4 0, .not r0, .store Reg.r4 0 r0]) := hat
+      x'.pc = base + isize g (.not : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.load r0 Reg.r4 0, .not r0, .store Reg.r4 0 r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1 (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3⟩ := not_step (code := code) hr2 (fetch_cast f1 (by omega))
@@ -116,57 +118,57 @@ theorem sim_not_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
     (rs := r0) (disp := 0) (by simp) (fetch_cast f2 (by omega))
   have e : s.dstack.set 0 (x3.regs r0) = (~~~a) :: d := by simp [hd, hv3, hv2]
   rw [e] at hr4
-  exact ⟨x4, ((hs1.trans hs2).trans hs3).trans hs4, hr4, by simp [isize, ufSize]; omega⟩
+  exact ⟨x4, ((hs1.trans hs2).trans hs3).trans hs4, hr4, by simp [isize]; omega⟩
 
 theorem sim_dup_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off .dup)) {a : W}
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g .dup)) {a : W}
     {d : List W} (hd : s.dstack = a :: d) (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: a :: d } x' ∧
-      x'.pc = base + isize (.dup : WordDialect.Instr 32) := by
-  obtain ⟨hatuf, hato, f0, f1, f2⟩ := xat_uf_ovf (L := L) (n := 1) (by decide) rfl hat
+      x'.pc = base + isize g (.dup : WordDialect.Instr 32) := by
+  obtain ⟨hatuf, hato, f0, f1, f2⟩ := xat_uf_ovf (L := L) (n := need g 1) rfl hat
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1' (j := 0) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, _⟩ := push_pair hg hr2 r0 (by decide) hfit
     ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), trivial⟩
   rw [hv2, hd] at hr3
-  exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize, ufSize]; omega⟩
+  exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize]; omega⟩
 
-theorem sim_dup_ovf (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off .dup)) {a : W}
+theorem sim_dup_ovf (hn : g.noOvf = false) (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g .dup)) {a : W}
     {d : List W} (hd : s.dstack = a :: d) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
-  obtain ⟨hatuf, hato, _⟩ := xat_uf_ovf (L := L) (n := 1) (by decide) rfl hat
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) (by simp [hd]) hpc hatuf
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  obtain ⟨hatuf, hato, _⟩ := xat_uf_ovf (L := L) (n := need g 1) rfl hat
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by simp [hd]) hpc hatuf
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 theorem sim_drop_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .drop)) {a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .drop)) {a : W} {d : List W}
     (hd : s.dstack = a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := d } x' ∧
-      x'.pc = base + isize (.drop : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 1 base ++ [.addImm Reg.r4 4]) := hat
+      x'.pc = base + isize g (.drop : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 1) base ++ [.addImm Reg.r4 4]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hatr
   obtain ⟨f0, _⟩ := hatr
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, _⟩ := adj_step (code := code) hg hr1 (n := 1) (by simp [hd])
     (δ := 4) (by simp) (fetch_cast f0 (by omega))
   have e : (s.dstack).drop 1 = d := by simp [hd]
   rw [e] at hr2
-  exact ⟨x2, hs1.trans hs2, hr2, by simp [isize, ufSize]; omega⟩
+  exact ⟨x2, hs1.trans hs2, hr2, by simp [isize]; omega⟩
 
 theorem sim_word_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (w : W)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.word w)))
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.word w)))
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := w :: s.dstack } x' ∧
-      x'.pc = base + isize (.word w : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.word w : WordDialect.Instr 32) := by
   obtain ⟨hato, f0, f1, f2⟩ := xat_ovf3 (L := L) (by exact hat)
-  obtain ⟨x0, hs0, hr0, hpc0, _, _⟩ := ovfD_pass hg hs hLd hfit hpc hato
+  obtain ⟨x0, hs0, hr0, hpc0, _, _⟩ := ovfG_pass hg hs hLd hfit hpc hato
   obtain ⟨x1, hs1, hr1, hpc1, hv1, _⟩ := movimm_step (code := code) hr0 (rd := r0) (by simp)
     (v := w) (by rw [hpc0]; exact f0)
   obtain ⟨x2, hs2, hr2, hpc2, _⟩ := push_pair hg hr1 r0 (by decide) hfit
@@ -174,37 +176,37 @@ theorem sim_word_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (w : W
   rw [hv1] at hr2
   exact ⟨x2, (hs0.trans hs1).trans hs2, hr2, by simp [isize]; omega⟩
 
-theorem sim_word_ovf (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (w : W)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.word w)))
+theorem sim_word_ovf (hn : g.noOvf = false) (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (w : W)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.word w)))
     (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) : RExec code x .overflow := by
   obtain ⟨hato, _⟩ := xat_ovf3 (L := L) (by exact hat)
-  exact ovfD_trap hg hs hLd h hpc hato
+  exact ovfG_trap hn hg hs hLd h hpc hato
 
 theorem sim_ptr_ok (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (q : WordDialect.Ptr 32)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.ptr q)))
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.ptr q)))
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := q.toWord :: s.dstack } x' ∧
-      x'.pc = base + isize (.ptr q : WordDialect.Instr 32) :=
-  sim_word_ok (L := L) (off := off) hg hs hpc q.toWord hLd hat hfit
+      x'.pc = base + isize g (.ptr q : WordDialect.Instr 32) :=
+  sim_word_ok (L := L) (off := off) (g := g) hg hs hpc q.toWord hLd hat hfit
 
-theorem sim_ptr_ovf (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (q : WordDialect.Ptr 32)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off (.ptr q)))
+theorem sim_ptr_ovf (hn : g.noOvf = false) (hg : Geom c) (hs : Rel0 c p s x) (hpc : x.pc = base) (q : WordDialect.Ptr 32)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g (.ptr q)))
     (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) : RExec code x .overflow :=
-  sim_word_ovf (L := L) (off := off) hg hs hpc q.toWord hLd hat h
+  sim_word_ovf (L := L) (off := off) (g := g) hn hg hs hpc q.toWord hLd hat h
 
 theorem sim_swap_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .swap)) {b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .swap)) {b a : W} {d : List W}
     (hd : s.dstack = b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: b :: d } x' ∧
-      x'.pc = base + isize (.swap : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 2 base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
+      x'.pc = base + isize g (.swap : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 2) base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
       .store Reg.r4 0 r1, .store Reg.r4 4 r0]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 2 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 2) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, _⟩ := hatr
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1 (j := 0) (v := b)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := a)
@@ -220,45 +222,45 @@ theorem sim_swap_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
   have e : (s.dstack.set 0 (x3.regs r1)).set 1 (x4.regs r0) = a :: b :: d := by
     simp [hd, hv3, hreg4, hax3]
   rw [e] at hr5'
-  exact ⟨x5, (((hs1.trans hs2).trans hs3).trans hs4).trans hs5, hr5', by simp [isize, ufSize]; omega⟩
+  exact ⟨x5, (((hs1.trans hs2).trans hs3).trans hs4).trans hs5, hr5', by simp [isize]; omega⟩
 
 theorem sim_over_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off .over)) {b a : W}
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g .over)) {b a : W}
     {d : List W} (hd : s.dstack = b :: a :: d) (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: b :: a :: d } x' ∧
-      x'.pc = base + isize (.over : WordDialect.Instr 32) := by
-  obtain ⟨hatuf, hato, f0, f1, f2⟩ := xat_uf_ovf (L := L) (n := 2) (by decide) rfl hat
+      x'.pc = base + isize g (.over : WordDialect.Instr 32) := by
+  obtain ⟨hatuf, hato, f0, f1, f2⟩ := xat_uf_ovf (L := L) (n := need g 2) rfl hat
   have hk : 2 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1' (j := 1) (v := a)
     (by simp [hd]) (rd := r0) (by simp) (disp := 4) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, _⟩ := push_pair hg hr2 r0 (by decide) hfit
     ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), trivial⟩
   rw [hv2, hd] at hr3
-  exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize, ufSize]; omega⟩
+  exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize]; omega⟩
 
-theorem sim_over_ovf (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off .over)) {b a : W}
+theorem sim_over_ovf (hn : g.noOvf = false) (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (hat : RAt code base (lowerInstr L base off g .over)) {b a : W}
     {d : List W} (hd : s.dstack = b :: a :: d) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
-  obtain ⟨hatuf, hato, _⟩ := xat_uf_ovf (L := L) (n := 2) (by decide) rfl hat
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) (by simp [hd]) hpc hatuf
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  obtain ⟨hatuf, hato, _⟩ := xat_uf_ovf (L := L) (n := need g 2) rfl hat
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by simp [hd]) hpc hatuf
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 theorem sim_rot_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x) (hpc : x.pc = base)
-    (hat : RAt code base (lowerInstr L base off .rot)) {cc b a : W} {d : List W}
+    (hat : RAt code base (lowerInstr L base off g .rot)) {cc b a : W} {d : List W}
     (hd : s.dstack = cc :: b :: a :: d) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: cc :: b :: d } x' ∧
-      x'.pc = base + isize (.rot : WordDialect.Instr 32) := by
-  have hat' : RAt code base (uf L 3 base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
+      x'.pc = base + isize g (.rot : WordDialect.Instr 32) := by
+  have hat' : RAt code base (uf L (need g 3) base ++ [.load r0 Reg.r4 0, .load r1 Reg.r4 4,
       .load r2 Reg.r4 8, .store Reg.r4 0 r2, .store Reg.r4 4 r0, .store Reg.r4 8 r1]) := hat
   obtain ⟨hatuf, hatr⟩ := rat_append.mp hat'
-  have hufl : (uf L 3 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 3) base
   rw [hufl] at hatr
   obtain ⟨f0, f1, f2, f3, f4, f5, _⟩ := hatr
   have hk : 3 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, hm1, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1 (j := 0) (v := cc)
     (by simp [hd]) (rd := r0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, hv3, ho3, _⟩ := ld_step (code := code) hr2 (j := 1) (v := b)
@@ -284,7 +286,7 @@ theorem sim_rot_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hs : Rel0 c p s x)
     simp [hd, hv4, hreg5, hreg6, hax4, hcx4]
   rw [e] at hr7'
   exact ⟨x7, (((((hs1.trans hs2).trans hs3).trans hs4).trans hs5).trans hs6).trans hs7, hr7',
-    by simp [isize, ufSize]; omega⟩
+    by simp [isize]; omega⟩
 
 end Ops
 

backend/cortexm0/CM0/SimStep.lean

@@ -53,10 +53,13 @@ theorem shape3 {l : List W} (h : 3 ≤ l.length) : ∃ cc y v d, l = cc :: y ::
       | nil => simp at h
       | cons v d => exact ⟨cc, y, v, d, rfl⟩
 
-theorem lowerInstr_uf (L : Layout) (base : Nat) (off : Nat → Nat) (i : WordDialect.Instr 32)
+theorem lowerInstr_uf (L : Layout) (base : Nat) (off : Nat → Nat) (g : Facts) (i : WordDialect.Instr 32)
     (h : 0 < i.pops) :
-    ∃ rest, lowerInstr L base off i = uf L i.pops base ++ rest ∧ i.pops ≤ 3 := by
-  cases i <;> first | exact ⟨_, rfl, by simp [Instr.pops]⟩ | exact absurd h (by simp [Instr.pops])
+    ∃ rest, lowerInstr L base off g i = uf L (need g i.pops) base ++ rest ∧ i.pops ≤ 3 := by
+  cases i <;> first
+    | exact ⟨_, rfl, by simp [Instr.pops]⟩
+    | exact ⟨_, List.append_assoc _ _ _, by simp [Instr.pops]⟩
+    | exact absurd h (by simp [Instr.pops])
 
 theorem Rel0.setPc {c : Cfg} {p : Prog 32} {s : State 32} {x : M} (h : Rel0 c p s x) (n : Nat) :
     Rel0 c p { s with pc := n } x :=
@@ -78,14 +81,15 @@ theorem sim_trapped {code : List (Instr Nat)} {t : Trap} (h : RExec code x (.tra
     Sim c p code x (.trapped t) := h
 
 theorem rel_fall {i : WordDialect.Instr 32} (hi : p[s.pc]? = some i) {s' : State 32}
-    {x' : M} (h0 : Rel0 c p s' x') (hpc : x'.pc = offs p s.pc + isize i) :
+    {x' : M} (h0 : Rel0 c p s' x') (hpc : x'.pc = offs c.facts p s.pc + isize (c.facts s.pc) i) :
     Rel c p { s' with pc := s.pc + 1 } x' :=
-  ⟨h0.setPc _, by rw [hpc, offs_succ hi]⟩
+  ⟨h0.setPc _, by rw [hpc, offs_succ c.facts hi]⟩
 
 theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M)
     (hLd : L.dLim = ofN (c.dBase + 4)) (hLr : L.rGap = ofN (4 * c.rcap - 8))
     (hLa : L.aEnd = ofN c.aEnd) (hLal : L.aLim = ofN (c.aBase + 4))
-    (hsz : ∀ k, offs p k < 2 ^ 32) (hs : Rel c p s x)
+    (hLf : L.facts = c.facts) (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hs : Rel c p s x)
+    (hgd : c.cert s.pc ≤ s.dstack.length) (hub : s.dstack.length ≤ c.ub s.pc)
     {i : WordDialect.Instr 32} (hi : p[s.pc]? = some i)
     (hreg : ∀ r, (i = .push r ∨ i = .pop r) → r < c.nregs) :
     Sim c p (lowerProg L p) x (WordDialect.exec i s) ∨
@@ -93,27 +97,39 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
   have nfD : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd → ¬ Fits c s := fun h hf => h hf.1
   have nfR : ¬ s.rstack.length + 2 ≤ c.rcap → ¬ Fits c s := fun h hf => h hf.2.1
   have nfA : ¬ c.aBase + 4 * (s.astack.length + 1) ≤ c.aEnd → ¬ Fits c s := fun h hf => h hf.2.2
-  have hpc : x.pc = offs p s.pc := hs.2
+  have hpc : x.pc = offs c.facts p s.pc := hs.2
   have hs0 : Rel0 c p s x := hs.1
   have hat := lowerProg_at L p s.pc i hi
+  rw [hLf] at hat
+  -- Where the stack may be full, the overflow guard is there: the bound left it out only where
+  -- one more word fits.
+  have hnov : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd → (c.facts s.pc).noOvf = false := by
+    intro hf
+    cases h : (c.facts s.pc).noOvf
+    · rfl
+    · exfalso; apply hf
+      simp only [Cfg.facts, decide_eq_true_eq] at h
+      unfold Cfg.dCap at h
+      omega
   by_cases hk : s.dstack.length < i.pops
   · rw [exec_underflow i s hk]
-    obtain ⟨rest, hlow, h3⟩ := lowerInstr_uf L (offs p s.pc) (offs p) i (by omega)
+    obtain ⟨rest, hlow, h3⟩ := lowerInstr_uf L (offs c.facts p s.pc) (offs c.facts p) (c.facts s.pc) i
+      (by omega)
     rw [hlow] at hat
-    exact .inl <| sim_trapped (sim_uf_trap hg hs0 hL (by omega) h3 hk hpc hat)
+    exact .inl <| sim_trapped (sim_uf_trap hg hs0 hL (by omega) h3 hgd hk hpc hat)
   · have hk' : i.pops ≤ s.dstack.length := by omega
     cases i with
     | word w =>
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_word_ovf hg hs0 hpc w hLd hat hf⟩
+      · exact .inr ⟨nfD hf, sim_word_ovf (hnov hf) hg hs0 hpc w hLd hat hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_word_ok hg hs0 hpc w hLd hat hf
       rw [exec_word]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
     | ptr q =>
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_ptr_ovf hg hs0 hpc q hLd hat hf⟩
+      · exact .inr ⟨nfD hf, sim_ptr_ovf (hnov hf) hg hs0 hpc q hLd hat hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_ptr_ok hg hs0 hpc q hLd hat hf
       rw [exec_ptr]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
@@ -238,8 +254,9 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
         simp only [hc', Bool.false_eq_true, if_false] at hpc'
         exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
     | call t =>
-      have hret : offs p s.pc + isize (.call t : WordDialect.Instr 32) = offs p (s.pc + 1) := by
-        rw [offs_succ hi]
+      have hret : offs c.facts p s.pc + isize (c.facts s.pc) (.call t : WordDialect.Instr 32) =
+          offs c.facts p (s.pc + 1) := by
+        rw [offs_succ c.facts hi]
       by_cases hf : s.rstack.length + 2 ≤ c.rcap
       rotate_left
       · exact .inr ⟨nfR hf, sim_call_ovf hg hs0 hpc hLr hat hf⟩
@@ -259,7 +276,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
     | push r =>
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_push_ovf hg hs0 hpc hLd hat hf⟩
+      · exact .inr ⟨nfD hf, sim_push_ovf (hnov hf) hg hs0 hpc hLd hat hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_push_ok hg hs0 hpc (hreg r (Or.inl rfl)) hLd hat hf
       rw [exec_push]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
@@ -272,7 +289,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
       obtain ⟨a, d, hd⟩ := shape1 (by simpa [Instr.pops] using hk')
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_dup_ovf hg hL hs0 hpc hLd hat hd hf⟩
+      · exact .inr ⟨nfD hf, sim_dup_ovf (hnov hf) hg hL hs0 hpc hLd hat hd hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_dup_ok hg hL hs0 hpc hLd hat hd hf
       rw [exec_dup hd]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
@@ -290,7 +307,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
       obtain ⟨b, a, d, hd⟩ := shape2 (by simpa [Instr.pops] using hk')
       by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
       rotate_left
-      · exact .inr ⟨nfD hf, sim_over_ovf hg hL hs0 hpc hLd hat hd hf⟩
+      · exact .inr ⟨nfD hf, sim_over_ovf (hnov hf) hg hL hs0 hpc hLd hat hd hf⟩
       obtain ⟨x', hst, h0, hpc'⟩ := sim_over_ok hg hL hs0 hpc hLd hat hd hf
       rw [exec_over hd]
       exact .inl <| sim_next ⟨x', hst, rel_fall hi h0 hpc'⟩
@@ -320,7 +337,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
       | cons a as =>
         by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
         rotate_left
-        · exact .inr ⟨nfD hf, sim_fromr_ovf hg hLa hLd hs0 hpc hat (by simp [ha]) hf⟩
+        · exact .inr ⟨nfD hf, sim_fromr_ovf (hnov hf) hg hLa hLd hs0 hpc hat (by simp [ha]) hf⟩
         obtain ⟨x', hst, h0, hpc'⟩ := sim_fromr_ok hg hLa hLd hs0 hpc hat ha hf
         have e : WordDialect.exec WordDialect.Instr.fromr s =
             .next { s with pc := s.pc + 1, dstack := a :: s.dstack, astack := as } := by
@@ -337,7 +354,7 @@ theorem sim_exec (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M
       | cons a as =>
         by_cases hf : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd
         rotate_left
-        · exact .inr ⟨nfD hf, sim_rfetch_ovf hg hLa hLd hs0 hpc hat (by simp [ha]) hf⟩
+        · exact .inr ⟨nfD hf, sim_rfetch_ovf (hnov hf) hg hLa hLd hs0 hpc hat (by simp [ha]) hf⟩
         obtain ⟨x', hst, h0, hpc'⟩ := sim_rfetch_ok hg hLa hLd hs0 hpc hat ha hf
         have e : WordDialect.exec WordDialect.Instr.rfetch s = s.fall (a :: s.dstack) := by
           simp [WordDialect.exec, ha]

backend/cortexm0/CM0Main.lean

@@ -14,7 +14,8 @@ divide instruction. For each program it
 3. runs the image on the emulated BBC micro:bit, an nRF51822 (Cortex-M0, 256 KiB of flash,
    16 KiB of SRAM; `qemu-system-arm -M microbit`). It takes the initial stack pointer and reset
    vector from the vector table, copies `.data` from flash to SRAM, prints through the nRF51
-   UART and stops through semihosting,
+   UART and ends the run there (an `EXIT` line and the status, then `wfi`; the harness reads up
+   to that line and stops the emulator),
 4. runs the same IR program under the Lean semantics at width 32 (`WordDialect.run`), and
 5. compares the exit status and the dumped data stack, IR memory and virtual registers.
 
@@ -23,8 +24,16 @@ shared samples and generated programs narrowed to 32-bit words, 32-bit edge case
 `INT_MIN / -1`, which the division loop must wrap), the auxiliary-stack and overflow programs,
 and Forth source files compiled at width 32.
 
-Usage: `cm0c check [fuzzCount]`, `cm0c emit <sample>`, `cm0c forth <file.fs> [memWords]`,
-`cm0c emit-forth <file.fs> [memWords]`.
+For a real board, `cm0c image` writes the ELF, an Intel HEX file (copy it onto the micro:bit's
+`MICROBIT` drive) and the UART transcript a correct run prints, for the micro:bit V1 or, with
+`--board microbit-v2`, the V2; `cm0c verify` checks a serial log captured from the board
+(`docs/HARDWARE.md`).
+
+Usage: `cm0c check [fuzzCount]`, `cm0c image <file.fs> [memWords] [--board …]`,
+`cm0c verify <file.fs> <serial.log> [memWords]`, `cm0c emit <sample>`, `cm0c forth <file.fs> [memWords]`,
+`cm0c emit-forth <file.fs> [memWords]`; `--no-opt` with any of them lowers without the
+stack-depth certificate and bound, keeping every guard; `cm0c stats <file.fs>` prints how many
+guards the two leave out.
 -/
 
 open WordDialect
@@ -43,18 +52,53 @@ def rBase : Nat := 0x20002400
 def rcap : Nat := 1024
 def rEnd : Nat := rBase + 4 * rcap
 
-def runtimeFor (s : Sample32) : CM0.Emit.Runtime :=
-  { dEnd := dEnd, capacity := capacity, rEnd := rEnd, rcap := rcap, memImage := s.mem,
-    nregs := s.nregs, aEnd := aEnd, acap := acap }
-
-def asmFor (s : Sample32) : String :=
-  CM0.Emit.program (runtimeFor s) (CM0.lowerProg (runtimeFor s).layout s.prog)
+/-- A board: its chip family, flash size, and (on nRF chips) its UART pins. -/
+structure Board where
+  name : String
+  txPin : Nat := 0
+  rxPsel : Nat := 0
+  soc : CM0.Emit.Soc := .nrf
+  flashKiB : Nat := 256
+
+/-- The BBC micro:bit V1 (nRF51822, a Cortex-M0): TX P0.24, RX P0.25. The emulator models it. -/
+def microbitV1 : Board := { name := "microbit-v1", txPin := 24, rxPsel := 25 }
+
+/-- The BBC micro:bit V2 (nRF52833, a Cortex-M4F, which runs ARMv6-M code): TX P0.06, RX P1.08
+(`PSEL` 40 = port 1, pin 8). Not modelled by the emulator; for real boards. -/
+def microbitV2 : Board := { name := "microbit-v2", txPin := 6, rxPsel := 40 }
+
+/-- Microchip's SAM D21 Curiosity Nano (DM320119; `ATSAMD21G17D`, a Cortex-M0+ with 128 KiB of
+flash and 16 KiB of SRAM, the same SRAM layout as the micro:bit). The transcript goes to the
+on-board debugger's virtual COM port (SERCOM5 on PA22/PB22); the yellow LED lights when the run
+halts with status 0; pressing SW0 runs the program again. Not modelled by the emulator. -/
+def samd21Cnano : Board := { name := "samd21-cnano", soc := .samd21, flashKiB := 128 }
+
+/-- The runtime for one program. With `opt` the lowering uses the stack-depth certificate
+`safeCert` (`WordDialect.Depth`): the analysis result if `certOk` accepts it, else the empty
+certificate. Either way `certOk` holds (`certTable_ok`), which is all the correctness theorem
+needs, so the analysis itself is not trusted. The table is computed once per runtime. Likewise
+the upper bounds `upperTable` (the least of the checked context-insensitive bound and the checked
+per-word frame bound; `upperTable_sound`) decide which overflow guards are left out. -/
+def runtimeFor (s : Sample32) (b : Board := microbitV1) (opt : Bool := true) : CM0.Emit.Runtime :=
+  let tbl := if opt then certTable s.prog else #[]
+  let r : CM0.Emit.Runtime :=
+    { dEnd := dEnd, capacity := capacity, rEnd := rEnd, rcap := rcap, memImage := s.mem,
+      nregs := s.nregs, aEnd := aEnd, acap := acap, txPin := b.txPin, rxPsel := b.rxPsel,
+      soc := b.soc, cert := fun k => tbl.getD k 0 }
+  if opt then
+    let up := upperTable s.prog r.dCap
+    { r with ub := fun k => upperAt up r.dCap k }
+  else r
+
+def asmFor (s : Sample32) (b : Board := microbitV1) (opt : Bool := true) : String :=
+  let r := runtimeFor s b opt
+  CM0.Emit.program r (CM0.lowerProg r.layout s.prog)
 
 /-- The vector table and code in flash from address 0 (where a Cortex-M reads its initial stack
 pointer and reset vector); `.data` in the first 1 KiB of SRAM, loaded into flash after the code
 (`__data_load`); the stacks are uninitialised sections at fixed addresses. -/
-def linkerScript : String :=
-  "ENTRY(_start)\nMEMORY {\n  FLASH (rx) : ORIGIN = 0x0, LENGTH = 256K\n" ++
+def linkerScript (b : Board := microbitV1) : String :=
+  s!"ENTRY(_start)\nMEMORY \{\n  FLASH (rx) : ORIGIN = 0x0, LENGTH = {b.flashKiB}K\n" ++
   "  DATA (rw) : ORIGIN = 0x20000000, LENGTH = 1K\n  STACKS (rw) : ORIGIN = 0x20000400, LENGTH = 12K\n}\nSECTIONS {\n" ++
   "  .vectors : { *(.vectors) } > FLASH\n  .text : { *(.text*) } > FLASH\n" ++
   "  .data : { *(.data*) } > DATA AT > FLASH\n  __data_load = LOADADDR(.data);\n" ++
@@ -64,12 +108,12 @@ def linkerScript : String :=
 
 def workDir : String := "/tmp/cm0c"
 
-/-- Assemble, link and run one assembly file; the UART output and the exit status. -/
-def runAsm (name asm : String) : IO (Except String (String × UInt32)) := do
+/-- Assemble and link one assembly file; the ELF's path. -/
+def buildElf (name asm : String) (b : Board := microbitV1) : IO (Except String String) := do
   IO.FS.createDirAll workDir
   let base := s!"{workDir}/{name}"
   IO.FS.writeFile (base ++ ".s") asm
-  IO.FS.writeFile (workDir ++ "/link.ld") linkerScript
+  IO.FS.writeFile (workDir ++ "/link.ld") (linkerScript b)
   let asArgs := #["--target=thumbv6m-none-eabi", "-mcpu=cortex-m0", "-c", "-o", base ++ ".o",
     base ++ ".s"]
   let a ← IO.Process.output { cmd := "clang", args := asArgs }
@@ -77,40 +121,59 @@ def runAsm (name asm : String) : IO (Except String (String × UInt32)) := do
   let l ← IO.Process.output
     { cmd := "ld.lld", args := #["-T", workDir ++ "/link.ld", "-o", base, base ++ ".o"] }
   if l.exitCode != 0 then return .error s!"ld.lld failed: {l.stderr}"
-  let child ← IO.Process.spawn
-    { cmd := "qemu-system-arm",
-      args := #["-machine", "microbit", "-kernel", base, "-display", "none", "-serial", "stdio",
-        "-monitor", "none", "-semihosting-config", "enable=on,target=native"],
-      stdout := .piped, stderr := .null, stdin := .null }
-  let out ← readAll child.stdout ByteArray.empty
-  let code ← child.wait
-  match String.fromUTF8? out with
-  | some t => return .ok (t, code)
-  | none => return .error "UART output is not text"
-
-def runNative : Runner32 := fun s => do
-  match ← runAsm s.name (asmFor s) with
+  return .ok base
+
+/-- Build, run on the emulated micro:bit, and read its UART up to the end of the run (the `EXIT`
+line and the status). The emulator is then stopped: the board itself sleeps for good. -/
+def runAsm (name asm : String) : IO (Except String String) := do
+  match ← buildElf name asm with
   | .error e => return .error e
-  | .ok (out, code) => return (if code != 0 then .ok (.trap code.toNat) else parseHexDump s out)
+  | .ok elf =>
+    let child ← IO.Process.spawn
+      { cmd := "qemu-system-arm",
+        args := #["-machine", "microbit", "-kernel", elf, "-display", "none", "-serial", "stdio",
+          "-monitor", "none"],
+        stdout := .piped, stderr := .null, stdin := .null }
+    let out ← readUntilExit child.stdout
+    child.kill
+    let _ ← child.wait
+    return .ok out
+
+def runNative (opt : Bool := true) : Runner32 := fun s => do
+  match ← runAsm s.name (asmFor s microbitV1 opt) with
+  | .error e => return .error e
+  | .ok out => return parseTranscript s out
 
 /-! ## Driver -/
 
+/-- `--board microbit-v1|microbit-v2|samd21-cnano` anywhere in the arguments, and the rest. -/
+def takeBoard : List String → Option Board × List String
+  | "--board" :: "microbit-v1" :: rest => (some microbitV1, rest)
+  | "--board" :: "microbit-v2" :: rest => (some microbitV2, rest)
+  | "--board" :: "samd21-cnano" :: rest => (some samd21Cnano, rest)
+  | "--board" :: _ :: rest => (none, "--board?" :: rest)
+  | a :: rest => let (b, r) := takeBoard rest; (b, a :: r)
+  | [] => (none, [])
+
 def parseMem (rest : List String) : Option Nat :=
   match rest with
   | [] => some 16
   | [m] => m.toNat?
   | _ => none
 
-def main (args : List String) : IO UInt32 := do
+def main (args0 : List String) : IO UInt32 := do
+  -- `--no-opt` keeps every guard (the lowering without depth certificates).
+  let opt := !args0.contains "--no-opt"
+  let args := args0.filter (· != "--no-opt")
   match args with
   | ["emit", name] =>
     match allSamples32.find? (·.name == name) with
-    | some s => IO.println (asmFor s); return 0
+    | some s => IO.println (asmFor s microbitV1 opt); return 0
     | none => IO.eprintln "unknown sample"; return 1
   | "forth" :: path :: rest =>
     match parseMem rest with
     | none => IO.eprintln "usage: cm0c forth <file.fs> [memWords]"; return 2
-    | some m => return (if ← check32 runNative (← forthFileSample32 path m) then 0 else 1)
+    | some m => return (if ← check32 (runNative opt) (← forthFileSample32 path m) then 0 else 1)
   | "emit-forth" :: path :: rest =>
     match parseMem rest with
     | none => IO.eprintln "usage: cm0c emit-forth <file.fs> [memWords]"; return 2
@@ -118,9 +181,34 @@ def main (args : List String) : IO UInt32 := do
       let s ← forthFileSample32 path m
       match s.buildError with
       | some e => IO.eprintln e; return 1
-      | none => IO.println (asmFor s); return 0
+      | none => IO.println (asmFor s microbitV1 opt); return 0
+  | "image" :: path :: rest =>
+    let (b, rest) := takeBoard rest
+    match parseMem rest with
+    | none => IO.eprintln "usage: cm0c image <file.fs> [memWords] [--board microbit-v1|microbit-v2|samd21-cnano]"; return 2
+    | some m =>
+      let board := b.getD microbitV1
+      let s ← forthFileSample32 path m
+      if let some e := s.buildError then IO.eprintln e; return 1
+      match ← buildElf s!"{s.name}-{board.name}" (asmFor s board opt) board with
+      | .error e => IO.eprintln e; return 1
+      | .ok elf => writeImage s elf s!"{s.name}-{board.name}"
+  | "verify" :: path :: log :: rest =>
+    match parseMem rest with
+    | none => IO.eprintln "usage: cm0c verify <file.fs> <serial.log> [memWords]"; return 2
+    | some m => verifyLog (← forthFileSample32 path m) log
+  | "stats" :: path :: rest =>
+    match parseMem rest with
+    | none => IO.eprintln "usage: cm0c stats <file.fs> [memWords]"; return 2
+    | some m =>
+      let s ← forthFileSample32 path m
+      if let some e := s.buildError then IO.eprintln e; return 1
+      let r := runtimeFor s
+      IO.println (guardStats s r.cert r.ub r.dCap)
+      return 0
   | "check" :: rest =>
     let count := match rest with | [n] => n.toNat! | _ => 200
-    let ok ← checkAll32 runNative count
-    return (if ok then 0 else 1)
-  | _ => IO.eprintln "usage: cm0c check [fuzzCount] | cm0c emit <sample> | cm0c forth <file.fs> [memWords] | cm0c emit-forth <file.fs> [memWords]"; return 2
+    let ok ← checkAll32 (runNative opt) count
+    let okc ← checkCapacity32 (runNative opt) capacity
+    return (if ok && okc then 0 else 1)
+  | _ => IO.eprintln "usage: cm0c check [fuzzCount] | cm0c emit <sample> | cm0c forth <file.fs> [memWords] | cm0c emit-forth <file.fs> [memWords] | cm0c image <file.fs> [memWords] [--board microbit-v1|microbit-v2|samd21-cnano] | cm0c verify <file.fs> <serial.log> [memWords] | cm0c stats <file.fs> [memWords]  (any command: --no-opt keeps every guard)"; return 2

backend/rv32/RV32/Correct.lean

@@ -25,6 +25,11 @@ Hypotheses of both (all explicit):
                       at least two;
 * `L` matches `c`     data-stack end and limit, return-stack gap, auxiliary-stack end and limit,
                       and IR memory size;
+* `hLf`, `hok`, `I`   the code was lowered with the configuration's facts: its lower-bound
+                      certificate passes `certOk`, and its upper bound `c.ub` is implied by an
+                      invariant `I` kept by every step within the data stack's capacity (`hIs`,
+                      `hIb`; `WordDialect.UbSound`); the runs carry `DepthInv` and `I`, so every
+                      underflow or overflow guard the lowering left out would have passed;
 * `hsz`               code indices fit in 32 bits;
 * `RegsOk`            every `push r`/`pop r` names a register inside the register file.
 -/
@@ -44,15 +49,30 @@ def Final (c : Cfg) (p : Prog 32) (code : List (Instr Nat)) (x : M) : Outcome 32
   | .halted s' => ∃ x', RExec code x (.halted x') ∧ Rel0 c p s' x'
   | .trapped t => RExec code x (.trapped t)
 
-theorem offs_ge {p : Prog 32} {k : Nat} (h : p.length ≤ k) : offs p k = offs p p.length := by
-  simp [offs, List.take_of_length_le h, List.take_length]
+theorem offs_ge (cf : Nat → Facts) {p : Prog 32} {k : Nat} (h : p.length ≤ k) :
+    offs cf p k = offs cf p p.length := by
+  induction p generalizing cf k with
+  | nil => cases k <;> simp [offs]
+  | cons i is ih =>
+    cases k with
+    | zero => simp at h
+    | succ k => simp only [List.length_cons, offs]; rw [ih _ (by simp at h; omega)]
+
+/-- A related state is within the data stack's capacity. -/
+theorem cap_of_rel {c : Cfg} {p : Prog 32} {s : State 32} {x : M} (hs : Rel c p s x) :
+    s.dstack.length ≤ c.dCap := by
+  have := hs.1.capD
+  unfold Cfg.dCap
+  omega
 
 /-- One IR step from a related state: the bad-pc stub, or the dispatched instruction. -/
 theorem step_sim {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
     (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M) (hLd : L.dLim = ofN (c.dBase + 4))
     (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hLa : L.aEnd = ofN c.aEnd)
-    (hLal : L.aLim = ofN (c.aBase + 4)) (hsz : ∀ k, offs p k < 2 ^ 32) (hreg : RegsOk c p)
-    {s : State 32} {x : M} (hs : Rel c p s x) :
+    (hLal : L.aLim = ofN (c.aBase + 4)) (hLf : L.facts = c.facts) (hok : certOk p c.cert = true)
+    (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hreg : RegsOk c p)
+    {s : State 32} {x : M} (hs : Rel c p s x) (hdi : DepthInv c.cert s)
+    (hub : s.dstack.length ≤ c.ub s.pc) :
     Sim c p (lowerProg L p) x (WordDialect.step p s) ∨
       (¬ Fits c s ∧ RExec (lowerProg L p) x .overflow) := by
   cases hi : p[s.pc]? with
@@ -65,43 +85,48 @@ theorem step_sim {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
       · rw [List.getElem?_eq_getElem hh] at hi; simp at hi
       · omega
     obtain ⟨f0, _⟩ := lowerProg_stub L p
-    have hpc : x.pc = offs p p.length := by rw [hs.2, offs_ge hge]
+    rw [hLf] at f0
+    have hpc : x.pc = offs c.facts p p.length := by rw [hs.2, offs_ge _ hge]
     exact RExec.trap (by rw [rstep_of_fetch (by rw [hpc]; exact f0)]; rfl)
   | some i =>
     have hst : WordDialect.step p s = WordDialect.exec i s := by simp [WordDialect.step, hi]
     rw [hst]
-    exact sim_exec hg hL hMs hLd hLr hLa hLal hsz hs hi (fun r hr => hreg s.pc i hi r hr)
+    exact sim_exec hg hL hMs hLd hLr hLa hLal hLf hsz hs hdi.depth hub hi (fun r hr => hreg s.pc i hi r hr)
 
 /-- Whole-program preservation, with no capacity hypothesis: the RISC-V code reaches the IR
 outcome, or exits with `overflow` because a stack was full. -/
 theorem lowerProg_correct_or_overflow {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
     (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M) (hLd : L.dLim = ofN (c.dBase + 4))
     (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hLa : L.aEnd = ofN c.aEnd)
-    (hLal : L.aLim = ofN (c.aBase + 4)) (hsz : ∀ k, offs p k < 2 ^ 32) (hreg : RegsOk c p)
+    (hLal : L.aLim = ofN (c.aBase + 4)) (hLf : L.facts = c.facts) (hok : certOk p c.cert = true)
+    {I : State 32 → Prop}
+    (hIs : ∀ s s', I s → s.dstack.length ≤ c.dCap → WordDialect.step p s = .next s' → I s')
+    (hIb : ∀ s, I s → s.dstack.length ≤ c.ub s.pc)
+    (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hreg : RegsOk c p)
     {s : State 32} {o : Outcome 32} (h : Exec p s o) :
-    ∀ {x : M}, Rel c p s x →
+    ∀ {x : M}, Rel c p s x → DepthInv c.cert s → I s →
       Final c p (lowerProg L p) x o ∨ RExec (lowerProg L p) x .overflow := by
   induction h with
   | @halt s s' hst =>
-    intro x hs
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨_, h6⟩
     · exact .inl this
     · exact .inr h6
   | @trap s t hst =>
-    intro x hs
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨_, h6⟩
     · exact .inl this
     · exact .inr h6
   | @next s s' o hst _ ih =>
-    intro x hs
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with ⟨x1, hsteps, hrel⟩ | ⟨_, h6⟩
-    · rcases ih hrel with hih | h6
+    · rcases ih hrel (DepthInv.step hok hdi hst) (hIs s _ hbi (cap_of_rel hs) hst) with hih | h6
       · left
         cases o with
         | next _ => exact hih.elim
@@ -117,31 +142,35 @@ every reachable state), no overflow guard fires and the outcome is exactly the I
 theorem lowerProg_correct {c : Cfg} {p : Prog 32} {L : Layout} (hg : Geom c)
     (hL : L.dEnd = ofN c.dEnd) (hMs : L.memSize = c.M) (hLd : L.dLim = ofN (c.dBase + 4))
     (hLr : L.rGap = ofN (4 * c.rcap - 8)) (hLa : L.aEnd = ofN c.aEnd)
-    (hLal : L.aLim = ofN (c.aBase + 4)) (hsz : ∀ k, offs p k < 2 ^ 32) (hreg : RegsOk c p)
+    (hLal : L.aLim = ofN (c.aBase + 4)) (hLf : L.facts = c.facts) (hok : certOk p c.cert = true)
+    {I : State 32 → Prop}
+    (hIs : ∀ s s', I s → s.dstack.length ≤ c.dCap → WordDialect.step p s = .next s' → I s')
+    (hIb : ∀ s, I s → s.dstack.length ≤ c.ub s.pc)
+    (hsz : ∀ k, offs c.facts p k < 2 ^ 32) (hreg : RegsOk c p)
     {s : State 32} {o : Outcome 32} (h : Exec p s o) :
-    ∀ {x : M}, Rel c p s x → (∀ s', Steps p s s' → Fits c s') →
+    ∀ {x : M}, Rel c p s x → DepthInv c.cert s → I s → (∀ s', Steps p s s' → Fits c s') →
       Final c p (lowerProg L p) x o := by
   induction h with
   | @halt s s' hst =>
-    intro x hs hb
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi hb
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨hnf, _⟩
     · exact this
     · exact absurd (hb s .refl) hnf
   | @trap s t hst =>
-    intro x hs hb
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi hb
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with this | ⟨hnf, _⟩
     · exact this
     · exact absurd (hb s .refl) hnf
   | @next s s' o hst _ ih =>
-    intro x hs hb
-    have := step_sim hg hL hMs hLd hLr hLa hLal hsz hreg hs
+    intro x hs hdi hbi hb
+    have := step_sim hg hL hMs hLd hLr hLa hLal hLf hok hsz hreg hs hdi (hIb s hbi)
     rw [hst] at this
     rcases this with ⟨x1, hsteps, hrel⟩ | ⟨hnf, _⟩
-    · have hih := ih hrel (fun s'' hss => hb s'' (Steps.cons hst hss))
+    · have hih := ih hrel (DepthInv.step hok hdi hst) (hIs s _ hbi (cap_of_rel hs) hst) (fun s'' hss => hb s'' (Steps.cons hst hss))
       cases o with
       | next _ => exact hih.elim
       | halted s2 =>
@@ -159,7 +188,7 @@ theorem init_rel {c : Cfg} {p : Prog 32} {s0 : State 32} {x0 : M} (hg : Geom c)
     (h13 : x0.regs Reg.s3 = ofN c.mb) (h12 : x0.regs Reg.s4 = ofN c.sp0)
     (hsp : x0.regs Reg.s5 = ofN c.sp0) (hbp : x0.regs Reg.s6 = ofN c.aEnd) (hregs : RegRel c x0.mem s0.regs)
     (hmem : MemRel c x0.mem s0.mem) (hiv : ∀ a : Word 32, s0.mem.valid a = decide (a.toNat < c.M))
-    (hxv : RegionsValid c x0.mem.valid) (hpc : x0.pc = offs p s0.pc) : Rel c p s0 x0 :=
+    (hxv : RegionsValid c x0.mem.valid) (hpc : x0.pc = offs c.facts p s0.pc) : Rel c p s0 x0 :=
   ⟨{ s1 := by simpa [hd] using h15
      s2 := h14
      s3 := h13

backend/rv32/RV32/Emit.lean

@@ -146,6 +146,13 @@ structure Runtime where
   acap : Nat
   uartBase : Nat := 0x10000000
   exitBase : Nat := 0x100000
+  /-- The stack-depth certificate the code is lowered with (`WordDialect.Depth`); the driver
+  passes `certTable` of the program. The default claims nothing and keeps every guard. -/
+  cert : Nat → Nat := fun _ => 0
+  /-- The upper bound on the data-stack depth the code is lowered with; the driver passes
+  `upperTable` of the program against `dCap` (`WordDialect.Depth`). An overflow guard is left out
+  where `ub k + 1 ≤ dCap`; the default (`2^32` everywhere) shows no room, so every guard stays. -/
+  ub : Nat → Nat := fun _ => 2 ^ 32
 
 def Runtime.dBase (r : Runtime) : Nat := r.dEnd - 4 * r.capacity
 
@@ -153,11 +160,15 @@ def Runtime.rBase (r : Runtime) : Nat := r.rEnd - 4 * r.rcap
 
 def Runtime.aBase (r : Runtime) : Nat := r.aEnd - 4 * r.acap
 
+/-- The data stack's capacity in words. -/
+def Runtime.dCap (r : Runtime) : Nat := (r.dEnd - r.dBase) / 4
+
 /-- The lowering's view of the runtime: the constants the guards and bounds checks use. -/
 def Runtime.layout (r : Runtime) : Layout :=
   { dEnd := BitVec.ofNat 32 r.dEnd, memSize := r.memImage.length,
     dLim := BitVec.ofNat 32 (r.dBase + 4), rGap := BitVec.ofNat 32 (4 * r.rcap - 8),
-    aEnd := BitVec.ofNat 32 r.aEnd, aLim := BitVec.ofNat 32 (r.aBase + 4) }
+    aEnd := BitVec.ofNat 32 r.aEnd, aLim := BitVec.ofNat 32 (r.aBase + 4), cert := r.cert,
+    ub := r.ub, dCap := r.dCap }
 
 /-- The runtime prologue. Its model is `RV32.Emit.prologueCode` (`RV32/Init.lean`), where each
 `lla` is the `movImm` of the address the linker resolves the symbol to; keep the two in step. -/

backend/rv32/RV32/Guard.lean

@@ -40,7 +40,7 @@ theorem uf_cond {c : Cfg} {p : Prog 32} {s : State 32} {x : M} (hg : Geom c) (hs
   · simp [h]; omega
 
 /-- Enough operands: the guard falls through to `base + 3`, changing only scratch state. -/
-theorem uf_pass {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
+theorem uf_pass_pos {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
     {L : Layout} {base n : Nat} (hg : Geom c) (hs : Rel0 c p s x) (hL : L.dEnd = ofN c.dEnd)
     (hn : 0 < n) (hn3 : n ≤ 3) (hk : n ≤ s.dstack.length) (hpc : x.pc = base)
     (hat : RAt code base (uf L n base)) :
@@ -62,19 +62,38 @@ theorem uf_pass {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Ins
       simp [xa, M.adv, M.mov, M.setReg]
   · intro r hr; simp [xa, M.adv, M.mov, M.setReg, hr]
 
-/-- Too few operands: the guard exits with `stackUnderflow`. -/
+/-- The guard of an instruction popping `k` words, when the data stack is known to hold at least
+`g` words: with enough operands it falls through, to `base + ufSize (need g k)` (at once when the
+certificate made the guard empty). -/
+theorem uf_pass {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
+    {L : Layout} {base k : Nat} {g : Facts} (hg : Geom c) (hs : Rel0 c p s x)
+    (hL : L.dEnd = ofN c.dEnd) (hk3 : k ≤ 3) (hk : k ≤ s.dstack.length) (hpc : x.pc = base)
+    (hat : RAt code base (uf L (need g k) base)) :
+    ∃ x1, RSteps code x x1 ∧ Rel0 c p s x1 ∧ x1.pc = base + ufSize (need g k) ∧ x1.mem = x.mem ∧
+      (∀ r, r ≠ t0 → x1.regs r = x.regs r) := by
+  by_cases h0 : need g k = 0
+  · rw [h0]; exact ⟨x, .refl, hs, by simp [ufSize, hpc], rfl, fun _ _ => rfl⟩
+  · have hn : 0 < need g k := Nat.pos_of_ne_zero h0
+    have hle := need_le g k
+    obtain ⟨x1, a, b, hpc1, d, e⟩ := uf_pass_pos hg hs hL hn (by omega) (by omega) hpc hat
+    exact ⟨x1, a, b, by rw [hpc1, ufSize_pos hn], d, e⟩
+
+/-- Too few operands: the guard exits with `stackUnderflow`. It is there, because the depth
+certificate's bound `g.lo` is a true lower bound (`hgd`) and the stack holds fewer than `k` words. -/
 theorem uf_trap {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-    {L : Layout} {base n : Nat} (hg : Geom c) (hs : Rel0 c p s x) (hL : L.dEnd = ofN c.dEnd)
-    (hn : 0 < n) (hn3 : n ≤ 3) (hk : s.dstack.length < n) (hpc : x.pc = base)
-    (hat : RAt code base (uf L n base)) : RExec code x (.trapped .stackUnderflow) := by
-  rw [uf_eq L hn] at hat
+    {L : Layout} {base k : Nat} {g : Facts} (hg : Geom c) (hs : Rel0 c p s x)
+    (hL : L.dEnd = ofN c.dEnd) (hk0 : 0 < k) (hk3 : k ≤ 3) (hgd : g.lo ≤ s.dstack.length) (hk : s.dstack.length < k)
+    (hpc : x.pc = base) (hat : RAt code base (uf L (need g k) base)) :
+    RExec code x (.trapped .stackUnderflow) := by
+  rw [need_of_lt (by omega)] at hat
+  rw [uf_eq L hk0] at hat
   obtain ⟨h1, h2, h3, _⟩ := hat
-  let xa := x.mov t0 (L.dEnd - BitVec.ofNat 32 (4 * n))
+  let xa := x.mov t0 (L.dEnd - BitVec.ofNat 32 (4 * k))
   have hst1 : step code x = .next xa := by rw [rstep_of_fetch (by rw [hpc]; exact h1)]; rfl
   have hxa_pc : xa.pc = base + 1 := by simp [xa, M.mov, M.setReg, M.adv, hpc]
   have hholds : Cond.eval .ule (xa.regs s1) (xa.regs t0) = false := by
-    have := uf_cond hg hs hL hn hn3
-    have h : ¬ n ≤ s.dstack.length := by omega
+    have := uf_cond hg hs hL hk0 hk3
+    have h : ¬ k ≤ s.dstack.length := by omega
     simpa [xa, M.mov, M.setReg, M.adv, h] using this
   exact RExec.of_steps (RSteps.single hst1)
     (guard_trap (code := code) (pc := base + 1) (m := xa) (t := .stackUnderflow)
@@ -131,6 +150,29 @@ theorem ovfD_trap (hg : Geom c) (hs : Rel0 c p s x) (hLd : L.dLim = ofN (c.dBase
     rw [hra s1 (by decide), hta, ovfD_cond hg hs hLd]; simpa using h
   exact RExec.of_steps hsa (ovf_trap hj he hpca hholds)
 
+/-- The data-stack guard where the facts keep it: with room for one more word, it falls through
+to `base + ovfSize g` (at once when the bound left the guard out). -/
+theorem ovfG_pass {g : Facts} (hg : Geom c) (hs : Rel0 c p s x) (hLd : L.dLim = ofN (c.dBase + 4))
+    (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) (hpc : x.pc = base)
+    (hat : RAt code base (ovf L g base)) :
+    ∃ x1, RSteps code x x1 ∧ Rel0 c p s x1 ∧ x1.pc = base + ovfSize g ∧ x1.mem = x.mem ∧
+      (∀ r, r ≠ t0 → x1.regs r = x.regs r) := by
+  unfold ovf at hat
+  unfold ovfSize
+  cases hn : g.noOvf
+  · simp only [hn, Bool.false_eq_true, if_false] at hat ⊢
+    exact ovfD_pass hg hs hLd hfit hpc hat
+  · exact ⟨x, .refl, hs, by simp [hpc], rfl, fun _ _ => rfl⟩
+
+/-- Data stack full: the guard is there (the bound did not claim room) and exits with
+`overflow`. -/
+theorem ovfG_trap {g : Facts} (hn : g.noOvf = false) (hg : Geom c) (hs : Rel0 c p s x)
+    (hLd : L.dLim = ofN (c.dBase + 4)) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd)
+    (hpc : x.pc = base) (hat : RAt code base (ovf L g base)) : RExec code x .overflow := by
+  unfold ovf at hat
+  simp only [hn, Bool.false_eq_true, if_false] at hat
+  exact ovfD_trap hg hs hLd h hpc hat
+
 /-- The return-stack guard's comparison, in terms of return-stack depth. -/
 theorem ovfR_cond (hg : Geom c) (hs : Rel0 c p s x) (hLr : L.rGap = ofN (4 * c.rcap - 8)) :
     Cond.eval .uge (x.regs Reg.s5) (x.regs Reg.s4 - L.rGap) =

backend/rv32/RV32/Init.lean

@@ -28,7 +28,9 @@ be derived inside the model, so it is stated once, explicitly, as `Loader.Holds`
 
 `binary_correct`: under those loader facts, after the prologue the lowered code reaches the IR
 outcome from `State.init` on the memory image, or exits with `overflow`. Its other hypotheses are
-only about the program.
+only about the program, including `certOk` for the runtime's stack-depth certificate and
+`UbSound` for its upper bound (the lowering leaves out the underflow and overflow guards they
+cover).
 -/
 
 namespace WordDialect
@@ -45,7 +47,8 @@ structure Loader where
 /-- The runtime placement for one run, as a `Cfg`. -/
 def cfgOf (r : Runtime) (ld : Loader) : Cfg :=
   { dEnd := r.dEnd, dBase := r.dBase, rf := ld.rf, nregs := r.nregs, mb := ld.mb,
-    M := r.memImage.length, sp0 := r.rEnd, rcap := r.rcap, aEnd := r.aEnd, aBase := r.aBase }
+    M := r.memImage.length, sp0 := r.rEnd, rcap := r.rcap, aEnd := r.aEnd, aBase := r.aBase,
+    cert := r.cert, ub := r.ub }
 
 /-- What the loader guarantees about the machine state `x0` at `_start`. -/
 structure Loader.Holds (r : Runtime) (ld : Loader) (x0 : M) : Prop where
@@ -70,36 +73,38 @@ theorem prologue_run (r : Runtime) (ld : Loader) (x0 : M) :
       .next { entryState r ld x0 with pc := x0.pc + 6 } := by
   simp [prologueCode, entryState, rseq, exec, M.mov, M.setReg, M.adv]
 
-theorem isize_le (i : WordDialect.Instr 32) : isize i ≤ 17 := by
-  cases i <;> simp [isize, ufSize]
-
-theorem sum_isize_le : ∀ l : Prog 32, (l.map isize).sum ≤ 17 * l.length
-  | [] => by simp
-  | i :: l => by
-    have := isize_le i
-    have := sum_isize_le l
-    simp only [List.map_cons, List.sum_cons, List.length_cons]
+theorem isize_le (g : Facts) (i : WordDialect.Instr 32) : isize g i ≤ 17 := by
+  have hu : ∀ k, ufSize (need g k) ≤ 3 := fun k => by unfold ufSize; split <;> omega
+  have hv : ovfSize g ≤ 3 := by unfold ovfSize; split <;> omega
+  have h1 := hu 1; have h2 := hu 2; have h3 := hu 3
+  cases i <;> simp only [isize] <;> omega
+
+theorem offs_le (cf : Nat → Facts) : ∀ (p : Prog 32) (k : Nat), offs cf p k ≤ 17 * p.length
+  | [], k => by cases k <;> simp [offs]
+  | i :: l, 0 => by simp [offs]
+  | i :: l, k + 1 => by
+    have := isize_le (cf 0) i
+    have := offs_le (fun j => cf (j + 1)) l k
+    simp only [offs, List.length_cons]
     omega
 
 /-- Code indices are bounded by the program length. -/
-theorem offs_lt {p : Prog 32} (h : 17 * p.length < 2 ^ 32) (k : Nat) : offs p k < 2 ^ 32 := by
-  have h1 := sum_isize_le (p.take k)
-  have h2 : (p.take k).length ≤ p.length := by rw [List.length_take]; omega
-  simp only [offs]
-  omega
+theorem offs_lt (cf : Nat → Facts) {p : Prog 32} (h : 17 * p.length < 2 ^ 32) (k : Nat) :
+    offs cf p k < 2 ^ 32 :=
+  Nat.lt_of_le_of_lt (offs_le cf p k) h
 
 theorem layout_ok (r : Runtime) (ld : Loader) :
-    r.layout.dEnd = ofN (cfgOf r ld).dEnd ∧ r.layout.memSize = (cfgOf r ld).M ∧
+    r.layout.facts = (cfgOf r ld).facts ∧ r.layout.dEnd = ofN (cfgOf r ld).dEnd ∧ r.layout.memSize = (cfgOf r ld).M ∧
       r.layout.dLim = ofN ((cfgOf r ld).dBase + 4) ∧ r.layout.rGap = ofN (4 * (cfgOf r ld).rcap - 8) ∧
       r.layout.aEnd = ofN (cfgOf r ld).aEnd ∧ r.layout.aLim = ofN ((cfgOf r ld).aBase + 4) :=
-  ⟨rfl, rfl, rfl, rfl, rfl, rfl⟩
+  ⟨funext fun _ => rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩
 
 /-- After the prologue, the machine is related to the IR's initial state. -/
 theorem entry_rel (r : Runtime) (ld : Loader) {x0 : M} (h : ld.Holds r x0) (p : Prog 32) :
     Rel (cfgOf r ld) p (State.init (Memory.ofImage r.memImage)) (entryState r ld x0) := by
   have hg := h.geom
   refine init_rel hg rfl rfl rfl (by have := hg.rcap_ge; simp [cfgOf] at this ⊢; omega)
-    ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ (fun _ => rfl) ?_ (by simp [entryState, offs, State.init])
+    ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ (fun _ => rfl) ?_ (by simp [entryState, offs, State.init, offs_zero])
   · simp [entryState, M.mov, M.setReg, M.adv, cfgOf]
   · simp [entryState, M.mov, M.setReg, M.adv, cfgOf]
   · simp [entryState, M.mov, M.setReg, M.adv, cfgOf]
@@ -120,14 +125,17 @@ theorem entry_rel (r : Runtime) (ld : Loader) {x0 : M} (h : ld.Holds r x0) (p :
 the outcome the IR reaches from `State.init` on the memory image, or exits with `overflow` (exit
 code 6). Program hypotheses: code indices fit in 32 bits and register indices are in range. -/
 theorem binary_correct (r : Runtime) (ld : Loader) (p : Prog 32) (hlen : 17 * p.length < 2 ^ 32)
-    (hreg : RegsOk (cfgOf r ld) p) {o : Outcome 32}
+    (hreg : RegsOk (cfgOf r ld) p) (hok : certOk p r.cert = true)
+    (hub : UbSound p r.dCap r.ub) {o : Outcome 32}
     (hx : Exec p (State.init (Memory.ofImage r.memImage)) o) {x0 : M} (h : ld.Holds r x0) :
     rseq (prologueCode r ld) x0 = .next { entryState r ld x0 with pc := x0.pc + 6 } ∧
       (Final (cfgOf r ld) p (lowerProg r.layout p) (entryState r ld x0) o ∨
         RExec (lowerProg r.layout p) (entryState r ld x0) .overflow) := by
-  obtain ⟨hL, hMs, hLd, hLr, hLa, hLal⟩ := layout_ok r ld
+  obtain ⟨hLc, hL, hMs, hLd, hLr, hLa, hLal⟩ := layout_ok r ld
+  obtain ⟨I, hI0, hIs, hIb⟩ := hub
   exact ⟨prologue_run r ld x0,
-    lowerProg_correct_or_overflow h.geom hL hMs hLd hLr hLa hLal (offs_lt hlen) hreg hx (entry_rel r ld h p)⟩
+    lowerProg_correct_or_overflow h.geom hL hMs hLd hLr hLa hLal hLc hok hIs hIb (offs_lt _ hlen)
+      hreg hx (entry_rel r ld h p) (DepthInv.init (certOk_entry hok) _) (hI0 _)⟩
 
 end Emit
 end RV32

backend/rv32/RV32/Lower.lean

@@ -1,4 +1,5 @@
 import RV32.Isa
+import WordDialect.Depth
 
 /-!
 # RV32.Lower
@@ -45,6 +46,24 @@ structure Layout where
   rGap : W        -- `4 rcap - 8`: a call has room iff `s5 ≥ s4 - rGap`
   aEnd : W        -- empty auxiliary stack: `s6 = aEnd`
   aLim : W        -- `aBase + 4`: the auxiliary stack has room for one more word iff `s6 ≥ aLim`
+  /-- A depth certificate (`WordDialect.Depth`): at IR instruction `k` the data stack holds at
+  least `cert k` words, so an operand-count guard for at most that many words is left out. -/
+  cert : Nat → Nat := fun _ => 0
+  /-- An upper bound on the data-stack depth at each IR instruction, and the data stack's
+  capacity in words. Where `ub k + 1 ≤ dCap` the data-stack overflow guard is left out. The
+  default capacity `0` leaves every guard in. -/
+  ub : Nat → Nat := fun _ => 0
+  dCap : Nat := 0
+
+/-- What the lowering knows at one IR instruction: a lower bound on the data-stack depth, and
+whether one more word is known to fit. -/
+structure Facts where
+  lo : Nat := 0
+  noOvf : Bool := false
+
+/-- The facts at IR instruction `k`. -/
+def Layout.facts (L : Layout) (k : Nat) : Facts :=
+  { lo := L.cert k, noOvf := decide (L.ub k + 1 ≤ L.dCap) }
 
 /-- Stack-underflow guard for `k` operands: continue when `s1 ≤ dEnd - 4k`. -/
 def uf (L : Layout) (k base : Nat) : List (Instr Nat) :=
@@ -54,10 +73,25 @@ def uf (L : Layout) (k base : Nat) : List (Instr Nat) :=
 
 def ufSize (k : Nat) : Nat := if k = 0 then 0 else 3
 
+/-- The operand count an instruction popping `k` words still has to check when the data stack is
+known to hold at least `g.lo` words: none if `k ≤ g.lo`. -/
+def need (g : Facts) (k : Nat) : Nat := if k ≤ g.lo then 0 else k
+
+theorem need_le (g : Facts) (k : Nat) : need g k ≤ k := by unfold need; split <;> omega
+
+theorem need_of_lt {g : Facts} {k : Nat} (h : g.lo < k) : need g k = k := by
+  unfold need; split <;> omega
+
 /-- Data-stack overflow guard: exit 6 unless one more word fits. -/
 def ovfD (L : Layout) (base : Nat) : List (Instr Nat) :=
   [.movImm t0 L.dLim, .bcc .uge s1 t0 (base + 3), .exitOvf]
 
+/-- The data-stack overflow guard where it is needed: none when the facts say one more word fits. -/
+def ovf (L : Layout) (g : Facts) (base : Nat) : List (Instr Nat) :=
+  if g.noOvf then [] else ovfD L base
+
+def ovfSize (g : Facts) : Nat := if g.noOvf then 0 else 3
+
 /-- Return-stack overflow guard: exit 6 unless a call has room on the return stack. -/
 def ovfR (L : Layout) (base : Nat) : List (Instr Nat) :=
   [.movRR t0 s4, .movImm t1 L.rGap, .sub t0 t1, .bcc .uge s5 t0 (base + 5), .exitOvf]
@@ -71,132 +105,145 @@ def emptyA (L : Layout) (base : Nat) : List (Instr Nat) :=
   [.movImm t0 L.aEnd, .bcc .ne s6 t0 (base + 3), .exitTrap .returnUnderflow]
 
 /-- Code size of one IR instruction. -/
-def isize : WordDialect.Instr 32 → Nat
-  | .word _ | .ptr _ => 6
-  | .load => ufSize 1 + 8
-  | .store => ufSize 2 + 9
-  | .add | .sub | .mul | .and | .or | .xor => ufSize 2 + 5
-  | .div | .sdiv => ufSize 2 + 7
-  | .not => ufSize 1 + 3
-  | .shl | .shr => ufSize 2 + 8
-  | .rotl | .rotr => ufSize 2 + 9
-  | .cmp _ => ufSize 2 + 7
-  | .select => ufSize 3 + 7
+def isize (g : Facts) : WordDialect.Instr 32 → Nat
+  | .word _ | .ptr _ => ovfSize g + 3
+  | .load => ufSize (need g 1) + 8
+  | .store => ufSize (need g 2) + 9
+  | .add | .sub | .mul | .and | .or | .xor => ufSize (need g 2) + 5
+  | .div | .sdiv => ufSize (need g 2) + 7
+  | .not => ufSize (need g 1) + 3
+  | .shl | .shr => ufSize (need g 2) + 8
+  | .rotl | .rotr => ufSize (need g 2) + 9
+  | .cmp _ => ufSize (need g 2) + 7
+  | .select => ufSize (need g 3) + 7
   | .jmp _ => 1
-  | .branch _ => ufSize 1 + 3
+  | .branch _ => ufSize (need g 1) + 3
   | .call _ => 6
   | .ret => 3
-  | .push _ => 6
-  | .pop _ => ufSize 1 + 3
-  | .dup => ufSize 1 + 6
-  | .drop => ufSize 1 + 1
-  | .swap => ufSize 2 + 4
-  | .over => ufSize 2 + 6
-  | .rot => ufSize 3 + 6
-  | .tor => ufSize 1 + 7
-  | .fromr => 10
-  | .rfetch => 9
+  | .push _ => ovfSize g + 3
+  | .pop _ => ufSize (need g 1) + 3
+  | .dup => ufSize (need g 1) + ovfSize g + 3
+  | .drop => ufSize (need g 1) + 1
+  | .swap => ufSize (need g 2) + 4
+  | .over => ufSize (need g 2) + ovfSize g + 3
+  | .rot => ufSize (need g 3) + 6
+  | .tor => ufSize (need g 1) + 7
+  | .fromr => ovfSize g + 7
+  | .rfetch => ovfSize g + 6
   | .halt => 1
 
 /-- Code for one IR instruction placed at RV index `base`; `off t` is the RV index of IR
 instruction `t` (clamped to the bad-pc stub for out-of-range targets). -/
-def lowerInstr (L : Layout) (base : Nat) (off : Nat → Nat) : WordDialect.Instr 32 → List (Instr Nat)
-  | .word w => ovfD L base ++ [.movImm t0 w, .addImm s1 (-4), .store s1 0 t0]
-  | .ptr p => ovfD L base ++ [.movImm t0 p.toWord, .addImm s1 (-4), .store s1 0 t0]
+def lowerInstr (L : Layout) (base : Nat) (off : Nat → Nat) (g : Facts) :
+    WordDialect.Instr 32 → List (Instr Nat)
+  | .word w => ovf L g base ++ [.movImm t0 w, .addImm s1 (-4), .store s1 0 t0]
+  | .ptr p => ovf L g base ++ [.movImm t0 p.toWord, .addImm s1 (-4), .store s1 0 t0]
   | .load =>
-    let b0 := base + ufSize 1
-    uf L 1 base ++
+    let b0 := base + ufSize (need g 1)
+    uf L (need g 1) base ++
       [.load t0 s1 0, .movImm t1 (BitVec.ofNat 32 L.memSize), .bcc .ult t0 t1 (b0 + 4),
        .exitTrap .badAddress, .shlImm t0 2, .add t0 s3, .load t0 t0 0, .store s1 0 t0]
   | .store =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load t0 s1 0, .load t1 s1 4, .movImm t2 (BitVec.ofNat 32 L.memSize), .bcc .ult t0 t2 (b0 + 5),
        .exitTrap .badAddress, .shlImm t0 2, .add t0 s3, .store t0 0 t1, .addImm s1 8]
-  | .add => uf L 2 base ++ [.load t1 s1 0, .load t0 s1 4, .add t0 t1, .store s1 4 t0, .addImm s1 4]
-  | .sub => uf L 2 base ++ [.load t1 s1 0, .load t0 s1 4, .sub t0 t1, .store s1 4 t0, .addImm s1 4]
-  | .mul => uf L 2 base ++ [.load t1 s1 0, .load t0 s1 4, .mul t0 t1, .store s1 4 t0, .addImm s1 4]
-  | .and => uf L 2 base ++ [.load t1 s1 0, .load t0 s1 4, .and t0 t1, .store s1 4 t0, .addImm s1 4]
-  | .or => uf L 2 base ++ [.load t1 s1 0, .load t0 s1 4, .or t0 t1, .store s1 4 t0, .addImm s1 4]
-  | .xor => uf L 2 base ++ [.load t1 s1 0, .load t0 s1 4, .xor t0 t1, .store s1 4 t0, .addImm s1 4]
+  | .add => uf L (need g 2) base ++ [.load t1 s1 0, .load t0 s1 4, .add t0 t1, .store s1 4 t0, .addImm s1 4]
+  | .sub => uf L (need g 2) base ++ [.load t1 s1 0, .load t0 s1 4, .sub t0 t1, .store s1 4 t0, .addImm s1 4]
+  | .mul => uf L (need g 2) base ++ [.load t1 s1 0, .load t0 s1 4, .mul t0 t1, .store s1 4 t0, .addImm s1 4]
+  | .and => uf L (need g 2) base ++ [.load t1 s1 0, .load t0 s1 4, .and t0 t1, .store s1 4 t0, .addImm s1 4]
+  | .or => uf L (need g 2) base ++ [.load t1 s1 0, .load t0 s1 4, .or t0 t1, .store s1 4 t0, .addImm s1 4]
+  | .xor => uf L (need g 2) base ++ [.load t1 s1 0, .load t0 s1 4, .xor t0 t1, .store s1 4 t0, .addImm s1 4]
   | .div =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load t1 s1 0, .load t0 s1 4, .bnez t1 (b0 + 4), .exitTrap .divideByZero, .divu t0 t0 t1,
        .store s1 4 t0, .addImm s1 4]
   | .sdiv =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load t1 s1 0, .load t0 s1 4, .bnez t1 (b0 + 4), .exitTrap .divideByZero, .div t0 t0 t1,
        .store s1 4 t0, .addImm s1 4]
-  | .not => uf L 1 base ++ [.load t0 s1 0, .not t0, .store s1 0 t0]
+  | .not => uf L (need g 1) base ++ [.load t0 s1 0, .not t0, .store s1 0 t0]
   | .shl =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load t1 s1 0, .load t0 s1 4, .sll t0 t1, .sltiu t2 t1 32, .neg t2, .and t0 t2,
        .store s1 4 t0, .addImm s1 4]
   | .shr =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load t1 s1 0, .load t0 s1 4, .srl t0 t1, .sltiu t2 t1 32, .neg t2, .and t0 t2,
        .store s1 4 t0, .addImm s1 4]
   | .rotl =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load t1 s1 0, .load t0 s1 4, .movRR t2 t0, .sll t0 t1, .neg t1, .srl t2 t1, .or t0 t2,
        .store s1 4 t0, .addImm s1 4]
   | .rotr =>
-    uf L 2 base ++
+    uf L (need g 2) base ++
       [.load t1 s1 0, .load t0 s1 4, .movRR t2 t0, .srl t0 t1, .neg t1, .sll t2 t1, .or t0 t2,
        .store s1 4 t0, .addImm s1 4]
   | .cmp c =>
-    let b0 := base + ufSize 2
-    uf L 2 base ++
+    let b0 := base + ufSize (need g 2)
+    uf L (need g 2) base ++
       [.load t1 s1 0, .load t0 s1 4, .movImm t2 1#32, .bcc c t0 t1 (b0 + 5), .movImm t2 0#32,
        .store s1 4 t2, .addImm s1 4]
   | .select =>
-    let b0 := base + ufSize 3
-    uf L 3 base ++
+    let b0 := base + ufSize (need g 3)
+    uf L (need g 3) base ++
       [.load t1 s1 0, .load t0 s1 4, .load t3 s1 8, .beqz t1 (b0 + 5), .movRR t0 t3,
        .store s1 8 t0, .addImm s1 8]
   | .jmp t => [.jmp (off t)]
-  | .branch t => uf L 1 base ++ [.load t0 s1 0, .addImm s1 4, .bnez t0 (off t)]
+  | .branch t => uf L (need g 1) base ++ [.load t0 s1 0, .addImm s1 4, .bnez t0 (off t)]
   | .call t => ovfR L base ++ [.call (off t)]
   | .ret => [.bcc .ne s5 s4 (base + 2), .exitTrap .returnUnderflow, .ret]
-  | .push r => ovfD L base ++ [.load t0 s2 (4 * (r : Int)), .addImm s1 (-4), .store s1 0 t0]
-  | .pop r => uf L 1 base ++ [.load t0 s1 0, .addImm s1 4, .store s2 (4 * (r : Int)) t0]
+  | .push r => ovf L g base ++ [.load t0 s2 (4 * (r : Int)), .addImm s1 (-4), .store s1 0 t0]
+  | .pop r => uf L (need g 1) base ++ [.load t0 s1 0, .addImm s1 4, .store s2 (4 * (r : Int)) t0]
   | .dup =>
-    uf L 1 base ++ ovfD L (base + ufSize 1) ++ [.load t0 s1 0, .addImm s1 (-4), .store s1 0 t0]
-  | .drop => uf L 1 base ++ [.addImm s1 4]
-  | .swap => uf L 2 base ++ [.load t0 s1 0, .load t1 s1 4, .store s1 0 t1, .store s1 4 t0]
+    uf L (need g 1) base ++ ovf L g (base + ufSize (need g 1)) ++ [.load t0 s1 0, .addImm s1 (-4), .store s1 0 t0]
+  | .drop => uf L (need g 1) base ++ [.addImm s1 4]
+  | .swap => uf L (need g 2) base ++ [.load t0 s1 0, .load t1 s1 4, .store s1 0 t1, .store s1 4 t0]
   | .over =>
-    uf L 2 base ++ ovfD L (base + ufSize 2) ++ [.load t0 s1 4, .addImm s1 (-4), .store s1 0 t0]
+    uf L (need g 2) base ++ ovf L g (base + ufSize (need g 2)) ++ [.load t0 s1 4, .addImm s1 (-4), .store s1 0 t0]
   | .rot =>
-    uf L 3 base ++
+    uf L (need g 3) base ++
       [.load t0 s1 0, .load t1 s1 4, .load t2 s1 8, .store s1 0 t2, .store s1 4 t0,
        .store s1 8 t1]
   | .tor =>
-    uf L 1 base ++ ovfA L (base + ufSize 1) ++
+    uf L (need g 1) base ++ ovfA L (base + ufSize (need g 1)) ++
       [.load t0 s1 0, .addImm s1 4, .addImm s6 (-4), .store s6 0 t0]
   | .fromr =>
-    emptyA L base ++ ovfD L (base + 3) ++
+    emptyA L base ++ ovf L g (base + 3) ++
       [.load t0 s6 0, .addImm s6 4, .addImm s1 (-4), .store s1 0 t0]
   | .rfetch =>
-    emptyA L base ++ ovfD L (base + 3) ++ [.load t0 s6 0, .addImm s1 (-4), .store s1 0 t0]
+    emptyA L base ++ ovf L g (base + 3) ++ [.load t0 s6 0, .addImm s1 (-4), .store s1 0 t0]
   | .halt => [.exitHalt]
 
-theorem lowerInstr_length (L : Layout) (base : Nat) (off : Nat → Nat) (i : WordDialect.Instr 32) :
-    (lowerInstr L base off i).length = isize i := by
-  cases i <;> simp [lowerInstr, isize, uf, ufSize, ovfD, ovfR, ovfA, emptyA] <;> (try split) <;> simp
+theorem uf_length (L : Layout) (k base : Nat) : (uf L k base).length = ufSize k := by
+  unfold uf ufSize; split <;> simp
+
+theorem ovf_length (L : Layout) (g : Facts) (base : Nat) : (ovf L g base).length = ovfSize g := by
+  unfold ovf ovfSize; split <;> simp [ovfD]
+
+theorem lowerInstr_length (L : Layout) (base : Nat) (off : Nat → Nat) (g : Facts)
+    (i : WordDialect.Instr 32) : (lowerInstr L base off g i).length = isize g i := by
+  cases i <;> simp [lowerInstr, isize, uf_length, ovf_length, ovfR, ovfA, emptyA] <;> omega
 
-/-- Prefix sums of instruction sizes: `offs p k` is the RV index of IR instruction `k`.
-For `k` past the end it is the index of the final bad-pc stub. -/
-def offs (p : Prog 32) (k : Nat) : Nat := ((p.take k).map isize).sum
+/-- Prefix sums of instruction sizes: `offs cf p k` is the code index of IR instruction `k`,
+where `cf j` are the facts at instruction `j` (its guards depend on them). For `k` past
+the end it is the index of the final bad-pc stub. -/
+def offs (cf : Nat → Facts) : Prog 32 → Nat → Nat
+  | _, 0 => 0
+  | [], _ + 1 => 0
+  | i :: is, k + 1 => isize (cf 0) i + offs (fun j => cf (j + 1)) is k
 
-def lowerGo (L : Layout) (off : Nat → Nat) : Nat → List (WordDialect.Instr 32) → List (Instr Nat)
-  | _, [] => [.exitTrap .badPc]
-  | b, i :: is => lowerInstr L b off i ++ lowerGo L off (b + isize i) is
+def lowerGo (L : Layout) (off : Nat → Nat) :
+    (Nat → Facts) → Nat → List (WordDialect.Instr 32) → List (Instr Nat)
+  | _, _, [] => [.exitTrap .badPc]
+  | cf, b, i :: is => lowerInstr L b off (cf 0) i ++ lowerGo L off (fun j => cf (j + 1)) (b + isize (cf 0) i) is
 
 /-- The whole program; the last instruction is the bad-pc stub, so jumping past the end of the
-IR program traps `badPc` exactly as the IR semantics does. -/
-def lowerProg (L : Layout) (p : Prog 32) : List (Instr Nat) := lowerGo L (offs p) 0 p
+IR program traps `badPc` exactly as the IR semantics does. Instruction `k` leaves out the
+guards that `L.facts k` makes redundant. -/
+def lowerProg (L : Layout) (p : Prog 32) : List (Instr Nat) := lowerGo L (offs L.facts p) L.facts 0 p
 
 end RV32
 end WordDialect

backend/rv32/RV32/Rel.lean

@@ -33,6 +33,17 @@ structure Cfg where
   rcap : Nat
   aEnd : Nat
   aBase : Nat
+  /-- The depth certificate the code was lowered with (`Layout.cert`). -/
+  cert : Nat → Nat := fun _ => 0
+  /-- The upper bound on the data-stack depth the code was lowered with (`Layout.ub`). -/
+  ub : Nat → Nat := fun _ => 2 ^ 32
+
+/-- The data stack's capacity in words. -/
+def Cfg.dCap (c : Cfg) : Nat := (c.dEnd - c.dBase) / 4
+
+/-- The facts the code was lowered with (`Layout.facts`). -/
+def Cfg.facts (c : Cfg) (k : Nat) : Facts :=
+  { lo := c.cert k, noOvf := decide (c.ub k + 1 ≤ c.dCap) }
 
 structure Geom (c : Cfg) : Prop where
   dEnd_lt : c.dEnd < 2 ^ 32
@@ -95,7 +106,7 @@ def MemRel (c : Cfg) (mem : Memory 32) (m : Memory 32) : Prop :=
   ∀ a, a < c.M → mem.read? (ofN (c.mb + 4 * a)) = some (m.cell (ofN a))
 
 def RsRel (c : Cfg) (p : Prog 32) (mem : Memory 32) (rs : List Nat) : Prop :=
-  ∀ i a, rs[i]? = some a → mem.read? (ofN (c.sp0 - 4 * rs.length + 4 * i)) = some (ofN (offs p a))
+  ∀ i a, rs[i]? = some a → mem.read? (ofN (c.sp0 - 4 * rs.length + 4 * i)) = some (ofN (offs c.facts p a))
 
 /-- The RISC-V memory's addressable set covers every region. -/
 def RegionsValid (c : Cfg) (v : W → Bool) : Prop :=
@@ -125,7 +136,7 @@ structure Rel0 (c : Cfg) (p : Prog 32) (s : State 32) (x : M) : Prop where
 
 /-- Full relation: everything in `Rel0`, and the RISC-V pc is the start of the IR pc's code. -/
 def Rel (c : Cfg) (p : Prog 32) (s : State 32) (x : M) : Prop :=
-  Rel0 c p s x ∧ x.pc = offs p s.pc
+  Rel0 c p s x ∧ x.pc = offs c.facts p s.pc
 
 /-- `Rel0` does not look at scratch registers or the pc. -/
 theorem Rel0.congr {c : Cfg} {p : Prog 32} {s : State 32} {x x' : M} (h : Rel0 c p s x)

backend/rv32/RV32/Run.lean

@@ -63,11 +63,10 @@ theorem rstep_of_fetch {code : List (Instr Nat)} {m : M} {i : Instr Nat}
   simp [step, h]
 
 /-- Prefix sums: `offs` of a cons. -/
-theorem offs_cons (i : WordDialect.Instr 32) (is : Prog 32) (k : Nat) :
-    offs (i :: is) (k + 1) = isize i + offs is k := by
-  simp [offs, List.take_succ_cons]
+theorem offs_cons (cf : Nat → Facts) (i : WordDialect.Instr 32) (is : Prog 32) (k : Nat) :
+    offs cf (i :: is) (k + 1) = isize (cf 0) i + offs (fun j => cf (j + 1)) is k := rfl
 
-theorem offs_zero (p : Prog 32) : offs p 0 = 0 := by simp [offs]
+theorem offs_zero (cf : Nat → Facts) (p : Prog 32) : offs cf p 0 = 0 := by cases p <;> rfl
 
 theorem rat_embed (pre seg post : List (Instr Nat)) : RAt (pre ++ seg ++ post) pre.length seg := by
   induction seg generalizing pre with
@@ -77,66 +76,70 @@ theorem rat_embed (pre seg post : List (Instr Nat)) : RAt (pre ++ seg ++ post) p
     have := ih (pre ++ [i])
     simpa [List.append_assoc] using this
 
-/-- Where the lowered code of IR instruction `k` sits: at index `pre.length + offs ps k`. -/
+/-- Where the lowered code of IR instruction `k` sits: at index `pre.length + offs cf ps k`, with
+the guards for the facts `cf k`. -/
 theorem lowerGo_at (L : Layout) (off : Nat → Nat) :
-    ∀ (ps : Prog 32) (pre : List (Instr Nat)) (k : Nat) (i : WordDialect.Instr 32),
+    ∀ (ps : Prog 32) (cf : Nat → Facts) (pre : List (Instr Nat)) (k : Nat) (i : WordDialect.Instr 32),
       ps[k]? = some i →
-      RAt (pre ++ lowerGo L off pre.length ps) (pre.length + offs ps k)
-        (lowerInstr L (pre.length + offs ps k) off i) := by
+      RAt (pre ++ lowerGo L off cf pre.length ps) (pre.length + offs cf ps k)
+        (lowerInstr L (pre.length + offs cf ps k) off (cf k) i) := by
   intro ps
   induction ps with
-  | nil => intro pre k i h; simp at h
+  | nil => intro cf pre k i h; simp at h
   | cons j js ih =>
-    intro pre k i h
+    intro cf pre k i h
     cases k with
     | zero =>
       simp at h; subst h
       simp only [offs_zero, Nat.add_zero, lowerGo]
-      have := rat_embed pre (lowerInstr L pre.length off j) (lowerGo L off (pre.length + isize j) js)
+      have := rat_embed pre (lowerInstr L pre.length off (cf 0) j)
+        (lowerGo L off (fun j => cf (j + 1)) (pre.length + isize (cf 0) j) js)
       simpa [List.append_assoc] using this
     | succ k =>
       simp only [List.getElem?_cons_succ] at h
-      have := ih (pre ++ lowerInstr L pre.length off j) k i h
-      have hl : (pre ++ lowerInstr L pre.length off j).length = pre.length + isize j := by
+      have := ih (fun j => cf (j + 1)) (pre ++ lowerInstr L pre.length off (cf 0) j) k i h
+      have hl : (pre ++ lowerInstr L pre.length off (cf 0) j).length = pre.length + isize (cf 0) j := by
         simp [lowerInstr_length]
       rw [hl] at this
       simp only [lowerGo, offs_cons]
-      have e : pre.length + (isize j + offs js k) = pre.length + isize j + offs js k := by omega
+      have e : pre.length + (isize (cf 0) j + offs (fun j => cf (j + 1)) js k) =
+          pre.length + isize (cf 0) j + offs (fun j => cf (j + 1)) js k := by omega
       rw [e]
       simpa [List.append_assoc] using this
 
 theorem lowerProg_at (L : Layout) (p : Prog 32) (k : Nat) (i : WordDialect.Instr 32)
     (h : p[k]? = some i) :
-    RAt (lowerProg L p) (offs p k) (lowerInstr L (offs p k) (offs p) i) := by
-  have := lowerGo_at L (offs p) p [] k i h
+    RAt (lowerProg L p) (offs L.facts p k) (lowerInstr L (offs L.facts p k) (offs L.facts p) (L.facts k) i) := by
+  have := lowerGo_at L (offs L.facts p) p L.facts [] k i h
   simpa [lowerProg] using this
 
-/-- The final stub (bad-pc trap) sits at `offs p p.length`. -/
+/-- The final stub (bad-pc trap) sits at `offs cf p p.length`. -/
 theorem lowerGo_stub (L : Layout) (off : Nat → Nat) :
-    ∀ (ps : Prog 32) (pre : List (Instr Nat)),
-      RAt (pre ++ lowerGo L off pre.length ps) (pre.length + offs ps ps.length) [.exitTrap .badPc] := by
+    ∀ (ps : Prog 32) (cf : Nat → Facts) (pre : List (Instr Nat)),
+      RAt (pre ++ lowerGo L off cf pre.length ps) (pre.length + offs cf ps ps.length)
+        [.exitTrap .badPc] := by
   intro ps
   induction ps with
   | nil =>
-    intro pre
-    simp only [lowerGo, List.length_nil, offs, List.take_nil, List.map_nil, List.sum_nil,
-      Nat.add_zero]
+    intro cf pre
+    simp only [lowerGo, List.length_nil, offs_zero, Nat.add_zero]
     have := rat_embed pre [.exitTrap .badPc] []
     simpa using this
   | cons j js ih =>
-    intro pre
-    have := ih (pre ++ lowerInstr L pre.length off j)
-    have hl : (pre ++ lowerInstr L pre.length off j).length = pre.length + isize j := by
+    intro cf pre
+    have := ih (fun j => cf (j + 1)) (pre ++ lowerInstr L pre.length off (cf 0) j)
+    have hl : (pre ++ lowerInstr L pre.length off (cf 0) j).length = pre.length + isize (cf 0) j := by
       simp [lowerInstr_length]
     rw [hl] at this
     simp only [lowerGo, List.length_cons, offs_cons]
-    have e : pre.length + (isize j + offs js js.length) = pre.length + isize j + offs js js.length := by omega
+    have e : pre.length + (isize (cf 0) j + offs (fun j => cf (j + 1)) js js.length) =
+        pre.length + isize (cf 0) j + offs (fun j => cf (j + 1)) js js.length := by omega
     rw [e]
     simpa [List.append_assoc] using this
 
 theorem lowerProg_stub (L : Layout) (p : Prog 32) :
-    RAt (lowerProg L p) (offs p p.length) [.exitTrap .badPc] := by
-  have := lowerGo_stub L (offs p) p []
+    RAt (lowerProg L p) (offs L.facts p p.length) [.exitTrap .badPc] := by
+  have := lowerGo_stub L (offs L.facts p) p L.facts []
   simpa [lowerProg] using this
 
 end RV32

backend/rv32/RV32/SimAux.lean

@@ -203,7 +203,7 @@ end Steps
 section Guards
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)} {L : Layout}
-  {base : Nat}
+  {base : Nat} {g : Facts}
 
 /-- The auxiliary-stack guard's comparison, in terms of its depth. -/
 theorem ovfA_cond (hg : Geom c) (hs : Rel0 c p s x) (hLal : L.aLim = ofN (c.aBase + 4)) :
@@ -305,32 +305,32 @@ end Guards
 section Ops
 
 variable {c : Cfg} {p : Prog 32} {s : State 32} {x : M} {code : List (Instr Nat)}
-  {L : Layout} {base : Nat} {off : Nat → Nat}
+  {L : Layout} {base : Nat} {off : Nat → Nat} {g : Facts}
 
 /-- Placement of the `tor` code. -/
-theorem xat_tor (hat : RAt code base (lowerInstr L base off .tor)) :
-    RAt code base (uf L 1 base) ∧ RAt code (base + 3) (ovfA L (base + 3)) ∧
-      RAt code (base + 6) [.load t0 Reg.s1 0, .addImm Reg.s1 4, .addImm Reg.s6 (-4),
+theorem xat_tor (hat : RAt code base (lowerInstr L base off g .tor)) :
+    RAt code base (uf L (need g 1) base) ∧ RAt code (base + ufSize (need g 1)) (ovfA L (base + ufSize (need g 1))) ∧
+      RAt code (base + ufSize (need g 1) + 3) [.load t0 Reg.s1 0, .addImm Reg.s1 4, .addImm Reg.s6 (-4),
         .store Reg.s6 0 t0] := by
-  have hat' : RAt code base (uf L 1 base ++ ovfA L (base + 3) ++
+  have hat' : RAt code base (uf L (need g 1) base ++ ovfA L (base + ufSize (need g 1)) ++
       [.load t0 Reg.s1 0, .addImm Reg.s1 4, .addImm Reg.s6 (-4), .store Reg.s6 0 t0]) := hat
   obtain ⟨hatuo, hatr⟩ := rat_append.mp hat'
   obtain ⟨hatuf, hato⟩ := rat_append.mp hatuo
-  have hufl : (uf L 1 base).length = 3 := by simp [uf]
+  have hufl := uf_length L (need g 1) base
   rw [hufl] at hato
-  have hl : (uf L 1 base ++ ovfA L (base + 3)).length = 6 := by simp [hufl, ovfA]
+  have hl : (uf L (need g 1) base ++ ovfA L (base + ufSize (need g 1))).length = ufSize (need g 1) + 3 := by simp [hufl, ovfA]
   rw [hl] at hatr
   exact ⟨hatuf, hato, hatr⟩
 
 theorem sim_tor_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hLal : L.aLim = ofN (c.aBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .tor))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .tor))
     {a : W} {d : List W} (hd : s.dstack = a :: d)
     (hfit : c.aBase + 4 * (s.astack.length + 1) ≤ c.aEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := d, astack := a :: s.astack } x' ∧
-      x'.pc = base + isize (.tor : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.tor : WordDialect.Instr 32) := by
   obtain ⟨hatuf, hato, f0, f1, f2, f3, _⟩ := xat_tor hat
   have hk : 1 ≤ s.dstack.length := by simp [hd]
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfA_pass hg hr1 hLal hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_step (code := code) hr1' (j := 0) (v := a)
     (by simp [hd]) (rd := t0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega))
@@ -343,39 +343,40 @@ theorem sim_tor_ok (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hLal : L.aLim = ofN
     ⟨fetch_cast f2 (by omega), fetch_cast f3 (by omega), trivial⟩
   rw [hax3] at hr4
   exact ⟨x4, (((hs1.trans hs1').trans hs2).trans hs3).trans hs4, hr4,
-    by simp [isize, ufSize]; omega⟩
+    by simp [isize]; omega⟩
 
 theorem sim_tor_ovf (hg : Geom c) (hL : L.dEnd = ofN c.dEnd) (hLal : L.aLim = ofN (c.aBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .tor))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .tor))
     (hk : 1 ≤ s.dstack.length) (h : ¬ c.aBase + 4 * (s.astack.length + 1) ≤ c.aEnd) :
     RExec code x .overflow := by
   obtain ⟨hatuf, hato, _⟩ := xat_tor hat
-  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) (by decide) hk hpc hatuf
+  obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := uf_pass hg hs hL (by decide) hk hpc hatuf
   exact RExec.of_steps hs1 (ovfA_trap hg hr1 hLal h hpc1 hato)
 
-/-- Placement of `emptyA L base ++ ovfD L (base + 3) ++ rest`. -/
+/-- Placement of `emptyA L base ++ ovf L g (base + 3) ++ rest`. -/
 theorem xat_take {rest : List (Instr Nat)}
-    (hat : RAt code base (emptyA L base ++ ovfD L (base + 3) ++ rest)) :
-    RAt code base (emptyA L base) ∧ RAt code (base + 3) (ovfD L (base + 3)) ∧
-      RAt code (base + 6) rest := by
+    (hat : RAt code base (emptyA L base ++ ovf L g (base + 3) ++ rest)) :
+    RAt code base (emptyA L base) ∧ RAt code (base + 3) (ovf L g (base + 3)) ∧
+      RAt code (base + 3 + ovfSize g) rest := by
   obtain ⟨hatuo, hatr⟩ := rat_append.mp hat
   obtain ⟨hate, hato⟩ := rat_append.mp hatuo
   have hel : (emptyA L base).length = 3 := rfl
   rw [hel] at hato
-  have hl : (emptyA L base ++ ovfD L (base + 3)).length = 6 := rfl
-  rw [hl] at hatr
+  have hl : (emptyA L base ++ ovf L g (base + 3)).length = 3 + ovfSize g := by
+    simp [ovf_length, emptyA]; omega
+  rw [hl, ← Nat.add_assoc] at hatr
   exact ⟨hate, hato, hatr⟩
 
 theorem sim_fromr_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .fromr))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .fromr))
     {a : W} {as : List W} (hd : s.astack = a :: as)
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: s.dstack, astack := as } x' ∧
-      x'.pc = base + isize (.fromr : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.fromr : WordDialect.Instr 32) := by
   obtain ⟨hate, hato, f0, f1, f2, f3, _⟩ := xat_take (L := L) (rest := [.load t0 Reg.s6 0,
     .addImm Reg.s6 4, .addImm Reg.s1 (-4), .store Reg.s1 0 t0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa (by simp [hd]) hpc hate
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_aux_step (code := code) hr1' hd (rd := t0)
     (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, ho3⟩ := aux_drop (code := code) hr2 hd (fetch_cast f1 (by omega))
@@ -386,30 +387,30 @@ theorem sim_fromr_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = o
   exact ⟨x4, (((hs1.trans hs1').trans hs2).trans hs3).trans hs4, hr4, by simp [isize]; omega⟩
 
 theorem sim_fromr_trap (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .fromr)) (he : s.astack = []) :
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .fromr)) (he : s.astack = []) :
     RExec code x (.trapped .returnUnderflow) :=
   emptyA_trap hg hs hLa he hpc (xat_take (L := L) (rest := [.load t0 Reg.s6 0,
     .addImm Reg.s6 4, .addImm Reg.s1 (-4), .store Reg.s1 0 t0]) hat).1
 
-theorem sim_fromr_ovf (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .fromr))
+theorem sim_fromr_ovf (hn : g.noOvf = false) (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .fromr))
     (hne : s.astack ≠ []) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
   obtain ⟨hate, hato, _⟩ := xat_take (L := L) (rest := [.load t0 Reg.s6 0,
     .addImm Reg.s6 4, .addImm Reg.s1 (-4), .store Reg.s1 0 t0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa hne hpc hate
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 theorem sim_rfetch_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .rfetch))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .rfetch))
     {a : W} {as : List W} (hd : s.astack = a :: as)
     (hfit : c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     ∃ x', RSteps code x x' ∧ Rel0 c p { s with dstack := a :: s.dstack } x' ∧
-      x'.pc = base + isize (.rfetch : WordDialect.Instr 32) := by
+      x'.pc = base + isize g (.rfetch : WordDialect.Instr 32) := by
   obtain ⟨hate, hato, f0, f1, f2, _⟩ := xat_take (L := L) (rest := [.load t0 Reg.s6 0,
     .addImm Reg.s1 (-4), .store Reg.s1 0 t0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa (by simp [hd]) hpc hate
-  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfD_pass hg hr1 hLd hfit hpc1 hato
+  obtain ⟨x1', hs1', hr1', hpc1', _, _⟩ := ovfG_pass hg hr1 hLd hfit hpc1 hato
   obtain ⟨x2, hs2, hr2, hpc2, hv2, _, _⟩ := ld_aux_step (code := code) hr1' hd (rd := t0)
     (by simp) (fetch_cast f0 (by omega))
   obtain ⟨x3, hs3, hr3, hpc3, _⟩ := push_pair hg hr2 t0 (by decide) hfit
@@ -418,19 +419,19 @@ theorem sim_rfetch_ok (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim =
   exact ⟨x3, ((hs1.trans hs1').trans hs2).trans hs3, hr3, by simp [isize]; omega⟩
 
 theorem sim_rfetch_trap (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hs : Rel0 c p s x)
-    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .rfetch)) (he : s.astack = []) :
+    (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .rfetch)) (he : s.astack = []) :
     RExec code x (.trapped .returnUnderflow) :=
   emptyA_trap hg hs hLa he hpc (xat_take (L := L) (rest := [.load t0 Reg.s6 0,
     .addImm Reg.s1 (-4), .store Reg.s1 0 t0]) hat).1
 
-theorem sim_rfetch_ovf (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
-    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off .rfetch))
+theorem sim_rfetch_ovf (hn : g.noOvf = false) (hg : Geom c) (hLa : L.aEnd = ofN c.aEnd) (hLd : L.dLim = ofN (c.dBase + 4))
+    (hs : Rel0 c p s x) (hpc : x.pc = base) (hat : RAt code base (lowerInstr L base off g .rfetch))
     (hne : s.astack ≠ []) (h : ¬ c.dBase + 4 * (s.dstack.length + 1) ≤ c.dEnd) :
     RExec code x .overflow := by
   obtain ⟨hate, hato, _⟩ := xat_take (L := L) (rest := [.load t0 Reg.s6 0,
     .addImm Reg.s1 (-4), .store Reg.s1 0 t0]) hat
   obtain ⟨x1, hs1, hr1, hpc1, _, _⟩ := emptyA_pass hg hs hLa hne hpc hate
-  exact RExec.of_steps hs1 (ovfD_trap hg hr1 hLd h hpc1 hato)
+  exact RExec.of_steps hs1 (ovfG_trap hn hg hr1 hLd h hpc1 hato)
 
 end Ops