diff --git a/.github/workflows/hardware.yml b/.github/workflows/hardware.yml new file mode 100644 index 0000000000000000000000000000000000000000..b359c86dedbe455a7f9a9b4727f1b990804149cf --- /dev/null +++ b/.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" diff --git a/.github/workflows/lean.yml b/.github/workflows/lean.yml index 8ffcf4137a63bcd7d80ab7328273d0c45c0c3a5a..24d3264f202f6b013b282dc2c9328550670ee2d2 100644 --- a/.github/workflows/lean.yml +++ b/.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 diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000000000000000000000000000000000000..5c4df588ff1064bf1bc0fdcaaac0ec5f0dbe9ae5 --- /dev/null +++ b/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`). diff --git a/NEXT_STEPS.md b/NEXT_STEPS.md index 6039f3d0ad20740a01e7b7b201f2f6d94dd3ba16..ec30cef9abfe0444c744ca45f91047352719f40c 100644 --- a/NEXT_STEPS.md +++ b/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 diff --git a/README.md b/README.md index ab9e1ca49222167b73291d92cd18dca1428d7718..412adcf6f5990f52a6ed5f4d699bd9d020dd5829 100644 --- a/README.md +++ b/README.md @@ -15,7 +15,7 @@ tags: - arm64 --- -> Mirrored from [https://github.com/SNAPKITTYAGENT9NOVA/ai-free](https://github.com/SNAPKITTYAGENT9NOVA/ai-free) at commit `8d0f04c`. Part of the **SnapKitty October 2026 main drop**. +> Mirrored from [https://github.com/SNAPKITTYAGENT9NOVA/ai-free](https://github.com/SNAPKITTYAGENT9NOVA/ai-free) at commit `25c8330`. Part of the **SnapKitty October 2026 main drop**. # UniversalWord: follow the word @@ -27,7 +27,7 @@ Think of this repository as a railway atlas. The source frontends are departure This README is the project's single guide. [Part I](#part-i-the-atlas) is a guided journey through that atlas: every Lean file receives an individual stop, with a link, a description, and a reason to open it. You can follow the whole route or jump directly to the part that interests you: writing Forth, understanding compiler correctness, exploring matrix multiplication, inspecting native assembly, or studying WebAssembly dispatch. -**Inventory note:** the source tree contains **200 `.lean` files**, and the numbered atlas below gives each one its own stop, including library entry files, executable entry points, and the audit. The original survey of `master`, commit [`93d6d84`](https://github.com/SNAPKITTYWEST/ai-free/tree/93d6d84fe80d3b7f333e31324b35ba27a964b9cc), counted 81; `Forth/LoopProps.lean`, `Forth/Grammar.lean`, `Forth/Double.lean`, `Forth/DoubleMath.lean`, `Forth/DoubleCorrect.lean`, the 23 files of the AArch64 backend (`backend/arm64`) the 22 files of the RISC-V backend (`backend/riscv64`) the 22 files of the RV32 microcontroller profile (`backend/rv32`), the 23 files of the Cortex-M profile (`backend/cortexm`), the 23 files of the Cortex-M0 profile (`backend/cortexm0`) and the 32-bit harness `backend/common/Harness32.lean` have been added since. CI runs [`scripts/check_inventory.sh`](scripts/check_inventory.sh), which fails when a Lean file has no stop or a stop links to a missing file, so the inventory stays complete. [Part II](#part-ii-how-each-part-works) is the technical companion to the atlas: what each library defines and proves, with diagrams of the pipeline, each backend's design and the trust boundaries. The project's direction, and where it stands against each part, is in the [game plan](docs/GAME_PLAN.md). +**Inventory note:** the source tree contains **201 `.lean` files**, and the numbered atlas below gives each one its own stop, including library entry files, executable entry points, and the audit. The original survey of `master`, commit [`93d6d84`](https://github.com/snapkittyagent9nova/ai-free/tree/93d6d84fe80d3b7f333e31324b35ba27a964b9cc), counted 81; `Forth/LoopProps.lean`, `Forth/Grammar.lean`, `Forth/Double.lean`, `Forth/DoubleMath.lean`, `Forth/DoubleCorrect.lean`, the 23 files of the AArch64 backend (`backend/arm64`) the 22 files of the RISC-V backend (`backend/riscv64`) the 22 files of the RV32 microcontroller profile (`backend/rv32`), the 23 files of the Cortex-M profile (`backend/cortexm`), the 23 files of the Cortex-M0 profile (`backend/cortexm0`), the 32-bit harness `backend/common/Harness32.lean` and the stack-depth certificates `WordDialect/Depth.lean` have been added since. CI runs [`scripts/check_inventory.sh`](scripts/check_inventory.sh), which fails when a Lean file has no stop or a stop links to a missing file, so the inventory stays complete. [Part II](#part-ii-how-each-part-works) is the technical companion to the atlas: what each library defines and proves, with diagrams of the pipeline, each backend's design and the trust boundaries. The project's direction, and where it stands against each part, is in the [game plan](docs/GAME_PLAN.md). ## Contents @@ -37,8 +37,9 @@ This README is the project's single guide. [Part I](#part-i-the-atlas) is a guid library, and [the trust boundaries](#trust-boundaries-in-one-place) * [Part III: run it and read it](#part-iii-run-it-and-read-it): building, running the checks, reading routes, the verification practice, and the license -* Elsewhere: the [game plan](docs/GAME_PLAN.md) (direction and status) and - [NEXT_STEPS.md](NEXT_STEPS.md) (the next concrete items) +* Elsewhere: the [game plan](docs/GAME_PLAN.md) (direction and status), + [NEXT_STEPS.md](NEXT_STEPS.md) (the next concrete items) and + [docs/HARDWARE.md](docs/HARDWARE.md) (running on real boards) ## Choose your route @@ -253,7 +254,7 @@ The IR describes unbounded stacks. The targets provide finite regions and check # Part I: the atlas -## Station I: the common word machine — files 1–10 +## Station I: the common word machine — files 1–11 Every route passes through this region. Its definitions give the shared instruction stream meaning, and its theorems provide the language used throughout the frontend and backend proofs. @@ -289,819 +290,823 @@ Defines finite continuing paths with `Steps`, terminating executions with `Exec` Builds memory from an image, defines the initial state, and extracts a final data stack from an outcome. It includes the direct IR version of `5 DUP +` and proves its result. -### 9. [WordDialect.lean](formal/WordDialect.lean) — the public doorway +### 9. [Depth.lean](formal/WordDialect/Depth.lean) — checked depth certificates + +A certificate `c : Nat → Nat` claims a lower bound on the data-stack depth at each instruction. `certOk` checks it locally: the entry claims nothing, each successor's claim is at most what the instruction leaves behind, and every return point claims nothing. `DepthInv.steps` proves that a checked certificate holds at every reachable state. Upper bounds come in two kinds, both checked against a stack capacity: a `Bound` per instruction (`boundOk`), and a frame certificate (`frameOk`) that tracks depth relative to the entry of the word being executed, with each word's net stack effect, so a recursive word does not spoil the bounds of its callers. Each is backed by an invariant (`UbSound`), and they combine by `min` (`upperTable_sound`). The analyses that propose certificates (`analyse`, `analyseBound`, `analyseFrames`) are untrusted; their results are used only when the checkers accept them. The three microcontroller backends (RV32, Cortex-M3, Cortex-M0) use both to leave out underflow and overflow guards (stops 135, 157 and 180). + +### 10. [WordDialect.lean](formal/WordDialect.lean) — the public doorway Collects the word-machine modules into one import. Its role is architectural: users and downstream libraries can open the semantic foundation through `import WordDialect`. -### 10. [Audit.lean](formal/Audit.lean) — the proof ledger +### 11. [Audit.lean](formal/Audit.lean) — the proof ledger Imports the project libraries and implements `#audit_wd`. It traverses theorem declarations in the `WordDialect` namespace and collects their axiom dependencies. The command allows Lean's standard `propext`, `Quot.sound`, and `Classical.choice`, reporting other dependencies as errors. -## Station II: the compiler's construction kit — files 11–17 +## Station II: the compiler's construction kit — files 12–18 The frontends share more than an instruction set. This region packages recurring compiler arguments so expressions, branches, and loops can reuse an established foundation. -### 11. [Straight.lean](word-ir/WordIR/Straight.lean) — an uninterrupted stretch +### 12. [Straight.lean](word-ir/WordIR/Straight.lean) — an uninterrupted stretch Defines straight-line instructions, code placement with `At`, and sequence execution with `execSeq`. Its theorems turn sequence calculations into machine paths or trapping executions. -### 12. [Frag.lean](word-ir/WordIR/Frag.lean) — track that fits its position +### 13. [Frag.lean](word-ir/WordIR/Frag.lean) — track that fits its position Defines position-dependent fragments whose emitted addresses adapt to their placement while their size stays fixed. Sequencing, conditionals, until loops, while loops, and repeat loops come with placement and execution rules. -### 13. [Flag.lean](word-ir/WordIR/Flag.lean) — a shared signal convention +### 14. [Flag.lean](word-ir/WordIR/Flag.lean) — a shared signal convention Defines source truth flags as all ones for true and zero for false. The IR comparison produces one or zero; `cmpFlagCode` converts that result to the Forth and BCPL convention. -### 14. [RExpr.lean](word-ir/WordIR/RExpr.lean) — expressions with a destination +### 15. [RExpr.lean](word-ir/WordIR/RExpr.lean) — expressions with a destination Defines register-and-memory expressions built from constants, registers, arithmetic, and loads. Each expression has an evaluator and an instruction sequence that leaves its result on the data stack. -### 15. [Loop.lean](word-ir/WordIR/Loop.lean) — repeat with an invariant +### 16. [Loop.lean](word-ir/WordIR/Loop.lean) — repeat with an invariant Builds a counted loop using a virtual register, initialization, an unsigned bound test, and an increment. `countedLoop_run` carries a supplied invariant through every iteration to the endpoint. -### 16. [Program.lean](word-ir/WordIR/Program.lean) — arrive at a final outcome +### 17. [Program.lean](word-ir/WordIR/Program.lean) — arrive at a final outcome Lifts straight-line code into a complete program by appending `halt`. Its theorems connect a successful `execSeq` calculation to a halted execution and a trapping calculation to the same trap. -### 17. [WordIR.lean](word-ir/WordIR.lean) — the workshop entrance +### 18. [WordIR.lean](word-ir/WordIR.lean) — the workshop entrance Exports the straight-line, fragment, flag, expression, loop, and whole-program tools through one import. This entry file shows the compiler layer's reusable vocabulary at a glance. -## Station III: Forth, from text to execution — files 18–33 +## Station III: Forth, from text to execution — files 19–34 Forth makes the common machine tangible. Its data-stack operations have direct IR counterparts, while definitions, recursion, variables, return-data operations, and structured loops reveal how the translation grows into a complete source pipeline. -### 18. [Semantics.lean](forth/Forth/Semantics.lean) — Forth's own account +### 19. [Semantics.lean](forth/Forth/Semantics.lean) — Forth's own account Defines operations, blocks, programs, source state, and the `Run` relation. It specifies signed division, remainder, truth flags, memory access, calls, early exit, `BEGIN … WHILE … REPEAT`, `CASE … ENDCASE`, data space (`CREATE ALLOT ,`), the core stack and arithmetic words, the double-cell words (`UM*`, `UM/MOD`, `M*`, `SM/REM`, `FM/MOD`, `*/MOD`, `*/`), `DO … LOOP`, `DO … +LOOP`, `LEAVE` and `UNLOOP`. The source return-data stack is separate from call frames. -### 19. [Compile.lean](forth/Forth/Compile.lean) — words become instructions +### 20. [Compile.lean](forth/Forth/Compile.lean) — words become instructions Lowers primitives and blocks into IR fragments. It places the main block before `halt`, then lays out definition bodies followed by `ret`. Definition addresses come from fixed code sizes. Each block is compiled with a leave target, the end of its innermost loop, where `LEAVE` jumps. -### 20. [OpCorrect.lean](forth/Forth/OpCorrect.lean) — each primitive keeps its meaning +### 21. [OpCorrect.lean](forth/Forth/OpCorrect.lean) — each primitive keeps its meaning Proves that lowering a Forth operation produces straight-line code with the behavior specified by `Op.sem`. Success transfers the resulting source state to the machine; failure preserves the trap. -### 21. [Double.lean](forth/Forth/Double.lean) — two words for one number +### 22. [Double.lean](forth/Forth/Double.lean) — two words for one number Builds the double-cell words from single-word instructions. `UM*` is a shift-and-add loop and `UM/MOD` a restoring-division loop, each run `n` times by `countedLoop` with its state in virtual registers. `M*` corrects the unsigned product's high word for negative factors. `SM/REM` divides absolute values with `UM/MOD` and puts the signs back; `FM/MOD` does the same with a floor adjustment. `*/MOD` and `*/` combine `M*` and `SM/REM`. -### 22. [DoubleMath.lean](forth/Forth/DoubleMath.lean) — the arithmetic behind the loops +### 23. [DoubleMath.lean](forth/Forth/DoubleMath.lean) — the arithmetic behind the loops Natural-number and integer facts with no machine in sight: the shift-and-add and restoring-division invariants, one round at a time (`umstar_step`, `umdiv_step`), truncated and floored division through absolute values (`tdiv_natAbs`, `tmod_natAbs`, `fdiv_fmod_natAbs`), and the exact overflow conditions of `SM/REM` and `FM/MOD` (`smrem_cond`, `fmmod_cond`). -### 23. [DoubleCorrect.lean](forth/Forth/DoubleCorrect.lean) — the loops compute the product and quotient +### 24. [DoubleCorrect.lean](forth/Forth/DoubleCorrect.lean) — the loops compute the product and quotient Proves each double-cell word against `Op.sem` for every width `n`, on success and on traps, with a register invariant per loop. `opFrag_run` then states one correctness lemma for every operation, straight-line or loop, and is what `Correct.lean` uses. -### 24. [Correct.lean](forth/Forth/Correct.lean) — the complete translation argument +### 25. [Correct.lean](forth/Forth/Correct.lean) — the complete translation argument Connects source `Run` derivations to compiled machine paths, early returns, and matching traps. `DefsAt` describes dictionary-body placement, including recursive calls. `Program.compile_correct` lifts the argument to an initialized whole program. -### 25. [LoopProps.lean](forth/Forth/LoopProps.lean) — where a counted loop stops +### 26. [LoopProps.lean](forth/Forth/LoopProps.lean) — where a counted loop stops Proves that the `+LOOP` exit test is ANS Forth's crossing rule, the signed overflow of `index - limit - 2^(n-1) + step` (`loopCrossed_eq_saddOverflow`), and that with step one it is the `LOOP` test `index + 1 = limit` (`loopCrossed_one`). -### 26. [Eval.lean](forth/Forth/Eval.lean) — a reference you can evaluate +### 27. [Eval.lean](forth/Forth/Eval.lean) — a reference you can evaluate Implements a fuel-bounded source interpreter and proves `eval_sound` against `Run`. Concrete evaluation can therefore supply a source-semantics derivation, including for recursive words. -### 27. [Example.lean](forth/Forth/Example.lean) — five becomes ten +### 28. [Example.lean](forth/Forth/Example.lean) — five becomes ten Takes `5 DUP +` through source semantics, compilation, and machine execution. The tiny example makes the entire frontend argument visible without a large program. -### 28. [Parse.lean](forth/Forth/Parse.lean) — the text ticket office +### 29. [Parse.lean](forth/Forth/Parse.lean) — the text ticket office Turns source text into a dictionary, main block, and variable count. It handles case-insensitive words, comments, literals, colon definitions, recursion, early exit, variables, constants, conditionals, and loops, including `+LOOP`, `?DO` and `LEAVE` (rejected outside a loop). -### 29. [Print.lean](forth/Forth/Print.lean) — a return ticket to text +### 30. [Print.lean](forth/Forth/Print.lean) — a return ticket to text Prints programs using canonical variable and definition names, then proves `parse_print` for well-formed programs. The argument covers both token generation and parsing. -### 30. [ParseProps.lean](forth/Forth/ParseProps.lean) — the parser's promises +### 31. [ParseProps.lean](forth/Forth/ParseProps.lean) — the parser's promises Proves that successful parsing yields a well-formed program and that printing such a result gives canonical source. Further results cover case behavior, comments, constants, dictionary definitions, and `RECURSE`. -### 31. [Grammar.lean](forth/Forth/Grammar.lean) — the parser's timetable without fuel +### 32. [Grammar.lean](forth/Forth/Grammar.lean) — the parser's timetable without fuel Gives the parser an inductive grammar, `Seq` for blocks, `Top` for definitions, variables and constants, and `Prog` for whole programs, and proves the parser accepts exactly its derivations (`parse_iff`), which are unambiguous. The fuel is irrelevant (`parseSeq_fuel`), and `parse` never reports running out of it (`parse_ne_fuel`). -### 32. [TextExample.lean](forth/Forth/TextExample.lean) — the journey in source spelling +### 33. [TextExample.lean](forth/Forth/TextExample.lean) — the journey in source spelling Provides concrete examples spanning parsing, reference evaluation, compilation, and machine results. Its subjects include recursive sums, variables, constants, remainder, early exits, nested loops, `+LOOP` up and down, `?DO`, `LEAVE`, `UNLOOP`, and return-data operations. It also records parser outcomes for selected malformed inputs. -### 33. [Forth.lean](forth/Forth.lean) — the frontend entrance +### 34. [Forth.lean](forth/Forth.lean) — the frontend entrance Exports the Forth library through one import, bringing its semantics, compiler, proofs, evaluator, text tools, and examples together. For an application, this is the convenient access point. -## Station IV: BCPL and the memory-centered route — files 34–39 +## Station IV: BCPL and the memory-centered route — files 35–40 BCPL reaches the same machine from a different source perspective. Variables are memory cells, values are words, and expression and statement semantics supply the reference for compilation. -### 34. [Semantics.lean](bcpl/BCPL/Semantics.lean) — expressions and statements in words +### 35. [Semantics.lean](bcpl/BCPL/Semantics.lean) — expressions and statements in words Defines the supported syntax, operator meanings, expression evaluation, assignment, and statement execution. It includes indirection, address-of, conditionals, and loops. Evaluation order and signed division are explicit, and comparisons use all-ones truth flags. -### 35. [Compile.lean](bcpl/BCPL/Compile.lean) — memory programs enter the interchange +### 36. [Compile.lean](bcpl/BCPL/Compile.lean) — memory programs enter the interchange Lowers expressions to stack-producing instruction sequences and statements to fragments. Variables use a supplied address mapping, and statements restore the data stack on completion. Arithmetic and assignments use straight-line code; structured control uses the common fragment toolkit. -### 36. [ExprCorrect.lean](bcpl/BCPL/ExprCorrect.lean) — expression results travel intact +### 37. [ExprCorrect.lean](bcpl/BCPL/ExprCorrect.lean) — expression results travel intact Proves straight-line properties and correctness for operator and expression lowering, covering successful values and traps. These results establish the evaluator-to-instruction connection needed by statement compilation. -### 37. [Correct.lean](bcpl/BCPL/Correct.lean) — statements reach their promised memory +### 38. [Correct.lean](bcpl/BCPL/Correct.lean) — statements reach their promised memory Proves assignment and statement translation correctness. Successful compiled execution reaches the statement endpoint with the source result's memory and an unchanged data stack; trapping source execution leads to the matching machine trap. -### 38. [Example.lean](bcpl/BCPL/Example.lean) — put five in a cell +### 39. [Example.lean](bcpl/BCPL/Example.lean) — put five in a cell Uses the assignment `x := 2 + 3` to demonstrate the complete BCPL route. Given an addressable variable cell, the reference statement produces the expected memory and the compiled machine program stores five there. -### 39. [BCPL.lean](bcpl/BCPL.lean) — the BCPL doorway +### 40. [BCPL.lean](bcpl/BCPL.lean) — the BCPL doorway Collects the BCPL semantics, translation, correctness results, and example under one import. The entry file marks a clean frontend boundary: the source language has its own account of execution, then connects through compiler proofs to the shared machine. -## Station V: mathematical expressions and matrix cargo — files 40–44 +## Station V: mathematical expressions and matrix cargo — files 41–45 The Wolfram-style route connects mathematical integer expressions to fixed-width computation. Matrix multiplication then turns that connection into nested loops over a concrete memory layout. -### 40. [Scalar.lean](wolfram/Wolfram/Scalar.lean) — integers meet fixed-width words +### 41. [Scalar.lean](wolfram/Wolfram/Scalar.lean) — integers meet fixed-width words Defines scalar expressions for integer literals, symbols, addition, multiplication, subtraction, and negation. Integer evaluation connects to `RExpr` lowering modulo the word width. Compilation and assignment theorems cover successful results and errors. -### 41. [MatrixLayout.lean](wolfram/Wolfram/MatrixLayout.lean) — pack the rows +### 42. [MatrixLayout.lean](wolfram/Wolfram/MatrixLayout.lean) — pack the rows Defines partial dot sums, row-major matrix representation with `MatAt`, and destination-prefix updates with `CWritten`. Its lemmas describe extending the written output while preserving source cells outside that region. -### 42. [MatrixDot.lean](wolfram/Wolfram/MatrixDot.lean) — three loops carry the product +### 43. [MatrixDot.lean](wolfram/Wolfram/MatrixDot.lean) — three loops carry the product Lowers matrix multiplication into row, column, and accumulation loops using four virtual registers. Geometry conditions specify address bounds and separation. Proofs progress from index expressions and accumulation to cells, rows, the full fragment, and `dotProgram_correct`. -### 43. [MatrixExample.lean](wolfram/Wolfram/MatrixExample.lean) — a product you can recognize +### 44. [MatrixExample.lean](wolfram/Wolfram/MatrixExample.lean) — a product you can recognize Instantiates the matrix geometry and memory representation for `[[1,2],[3,4]]` multiplied by `[[5,6],[7,8]]`, whose product is `[[19,22],[43,50]]`. It stores the inputs at word addresses zero and four and the output at eight. -### 44. [Wolfram.lean](wolfram/Wolfram.lean) — the mathematical entrance +### 45. [Wolfram.lean](wolfram/Wolfram.lean) — the mathematical entrance Exports the scalar and matrix modules, connecting expression lowering, layout vocabulary, multiplication proofs, and the worked example. Start through this import when constructing a mathematical sample. -## Station VI: the shared observation platform — files 45–46 +## Station VI: the shared observation platform — files 46–47 -### 45. [Harness.lean](backend/common/Harness.lean) — compare the arrivals +### 46. [Harness.lean](backend/common/Harness.lean) — compare the arrivals Defines samples, expected Lean outcomes, target result decoding, the backend `Runner` interface, fixed examples, and generated programs. The harness compares trap codes or final data stack, memory, and virtual registers. -### 46. [Harness32.lean](backend/common/Harness32.lean) — the platform at 32 bits +### 47. [Harness32.lean](backend/common/Harness32.lean) — the platform at 32 bits The same comparison at word width 32, shared by the two microcontroller profiles (`rv32c`, `cmc`): `Sample32`, the Lean outcome at width 32, `narrow` (which turns the shared samples and generated programs into 32-bit ones, mapping the edge values near `2^63` and `2^64` to those near `2^31` and `2^32`), 32-bit edge cases, the auxiliary-stack and overflow programs, Forth files compiled at width 32, and the parser for the hexadecimal halt dump both bare-metal runtimes print. -## Station VII: the x86-64 express — files 47–68 +## Station VII: the x86-64 express — files 48–69 The native route implements the IR with concrete registers, guarded stack regions, and GNU assembly. Its proof structure proceeds from machine semantics through local simulation to whole-program and entry-point results. -### 47. [Isa.lean](backend/x86_64/X86/Isa.lean) — the native vehicle +### 48. [Isa.lean](backend/x86_64/X86/Isa.lean) — the native vehicle Models the emitted x86-64 instruction subset, registers, condition flags, memory access, and target outcomes. Faults and runtime exits are explicit. -### 48. [Lower.lean](backend/x86_64/X86/Lower.lean) — choose the native track +### 49. [Lower.lean](backend/x86_64/X86/Lower.lean) — choose the native track Defines runtime register roles, operand and capacity guards, instruction sizes, offsets, and lowering. The data stack uses `r15`, virtual registers use `r14`, IR memory uses `r13`, entry stack position uses `r12`, and auxiliary data uses `rbp`. -### 49. [Emit.lean](backend/x86_64/X86/Emit.lean) — print the assembly journey +### 50. [Emit.lean](backend/x86_64/X86/Emit.lean) — print the assembly journey Prints lowered instructions in GNU assembler Intel syntax and supplies the runtime prologue and output/exit helpers. Runtime declarations establish memory and stack regions. Successful execution writes a binary state dump; traps and overflow use their exit codes. -### 50. [Rel.lean](backend/x86_64/X86/Rel.lean) — match the two timetables +### 51. [Rel.lean](backend/x86_64/X86/Rel.lean) — match the two timetables Defines runtime geometry and the relation between IR and native states. It maps stacks, virtual registers, memory, and return addresses into disjoint target regions. Frame lemmas support updates. -### 51. [Run.lean](backend/x86_64/X86/Run.lean) — locate and follow native code +### 52. [Run.lean](backend/x86_64/X86/Run.lean) — locate and follow native code Defines native continuing and terminating execution relations, code placement, and theorems locating each lowered IR instruction. It connects offset calculations to the emitted instruction list, including the trailing bad-program-counter stub. -### 52. [Seq.lean](backend/x86_64/X86/Seq.lean) — compose short native stretches +### 53. [Seq.lean](backend/x86_64/X86/Seq.lean) — compose short native stretches Provides straight-line native execution and its connection to native step paths. It also proves the conditional-jump-and-trap guard pattern. -### 53. [Flags.lean](backend/x86_64/X86/Flags.lean) — read the signals correctly +### 54. [Flags.lean](backend/x86_64/X86/Flags.lean) — read the signals correctly Proves that native condition-code interpretation after subtraction matches all ten IR comparison predicates. The argument accounts for zero, sign, carry, and overflow flags. -### 54. [Micro.lean](backend/x86_64/X86/Micro.lean) — the smallest useful moves +### 55. [Micro.lean](backend/x86_64/X86/Micro.lean) — the smallest useful moves Establishes local effects of target loads, stores, scratch-register updates, stack-pointer adjustment, and pushing a word. Each lemma works with the state relation. -### 55. [Guard.lean](backend/x86_64/X86/Guard.lean) — check room and operands +### 56. [Guard.lean](backend/x86_64/X86/Guard.lean) — check room and operands Proves operand-count guards and data- and return-stack capacity checks. With enough operands or room, the code continues; otherwise it produces the specified underflow or overflow outcome. -### 56. [SimBin.lean](backend/x86_64/X86/SimBin.lean) — one pattern, many operators +### 57. [SimBin.lean](backend/x86_64/X86/SimBin.lean) — one pattern, many operators Defines `MidSpec` and proves a generic binary-operation simulation. The pattern loads two operands, computes in scratch state, stores the result, and removes one stack slot. -### 57. [SimOps.lean](backend/x86_64/X86/SimOps.lean) — instantiate the arithmetic route +### 58. [SimOps.lean](backend/x86_64/X86/SimOps.lean) — instantiate the arithmetic route Applies the generic binary pattern to arithmetic, bitwise operations, shifts, rotations, and comparisons. Its middle specifications show the target computation matches the IR operation. -### 58. [SimStack.lean](backend/x86_64/X86/SimStack.lean) — rearrange the carried words +### 59. [SimStack.lean](backend/x86_64/X86/SimStack.lean) — rearrange the carried words Proves simulations for literals, pointers, complement, duplication, dropping, swapping, copying a lower stack item, and rotation. Local target-step lemmas support the stack updates. -### 59. [SimMem.lean](backend/x86_64/X86/SimMem.lean) — preserve neighboring regions +### 60. [SimMem.lean](backend/x86_64/X86/SimMem.lean) — preserve neighboring regions Develops address and frame lemmas for virtual-register and IR-memory access. It establishes the effects of reading and writing those cells while preserving stack and other-region relations. -### 60. [SimMemOps.lean](backend/x86_64/X86/SimMemOps.lean) — perform the checked access +### 61. [SimMemOps.lean](backend/x86_64/X86/SimMemOps.lean) — perform the checked access Proves the address bounds guard and complete simulations for virtual-register push/pop and memory load/store. Both successful access and bad-address traps are covered, with overflow behavior for a growing data stack. -### 61. [SimDiv.lean](backend/x86_64/X86/SimDiv.lean) — handle division's special junctions +### 62. [SimDiv.lean](backend/x86_64/X86/SimDiv.lean) — handle division's special junctions Covers unsigned division, signed division, and three-operand selection. The proofs include zero-divisor traps and the signed divisor-minus-one path that avoids native division overflow while preserving modular word semantics. -### 62. [SimCtl.lean](backend/x86_64/X86/SimCtl.lean) — branch, call, and return +### 63. [SimCtl.lean](backend/x86_64/X86/SimCtl.lean) — branch, call, and return Proves simulations for jumps, conditional branches, calls, returns, and halt. The native return stack stores lowered return-code indices corresponding to IR addresses. Return underflow and call overflow receive explicit results. -### 63. [SimAux.lean](backend/x86_64/X86/SimAux.lean) — a separate place for saved data +### 64. [SimAux.lean](backend/x86_64/X86/SimAux.lean) — a separate place for saved data Proves auxiliary-stack access, push/pop effects, capacity and empty-stack guards, and the `tor`, `fromr`, and `rfetch` simulations. Its dedicated region and `rbp` pointer preserve saved words across native calls. -### 64. [SimStep.lean](backend/x86_64/X86/SimStep.lean) — every instruction gets a connection +### 65. [SimStep.lean](backend/x86_64/X86/SimStep.lean) — every instruction gets a connection Combines the instruction-family results into `sim_exec`, covering each IR instruction and continuing, halted, or trapped outcomes. `Fits` describes required stack headroom, and simulation includes overflow where capacity runs out. -### 65. [Correct.lean](backend/x86_64/X86/Correct.lean) — preserve the complete journey +### 66. [Correct.lean](backend/x86_64/X86/Correct.lean) — preserve the complete journey Lifts instruction simulation to whole-program behavior. `lowerProg_correct_or_overflow` allows a matching IR outcome or overflow; `lowerProg_correct` gives the matching outcome when reachable states fit. Geometry, layout agreement, code-address bounds, and valid register indices make the program's target contract explicit. -### 66. [Init.lean](backend/x86_64/X86/Init.lean) — begin at the binary entrance +### 67. [Init.lean](backend/x86_64/X86/Init.lean) — begin at the binary entrance Models the prologue and proves its effect, then relates the resulting native state to `State.init`. `Loader.Holds` gathers the loader's memory, placement, and entry-stack facts. -### 67. [X86.lean](backend/x86_64/X86.lean) — the native library entrance +### 68. [X86.lean](backend/x86_64/X86.lean) — the native library entrance Exports the native model, lowering, emitter, relations, simulation modules, whole-program proofs, and initialization result. This import gives users the complete backend library. -### 68. [Main.lean](backend/x86_64/Main.lean) — take the express for a run +### 69. [Main.lean](backend/x86_64/Main.lean) — take the express for a run Implements `wordc`: emit assembly, assemble and link with `as` and `ld`, execute, and compare against Lean. It supports fixed/generated checks and Forth files, plus auxiliary-stack and overflow samples. -## Station VIII: the WebAssembly line — files 69–87 +## Station VIII: the WebAssembly line — files 70–88 WebAssembly offers structured control, typed operands, and byte memory. This route represents each IR instruction as a function returning the next instruction index, then runs those functions through a dispatch loop. -### 69. [Isa.lean](backend/wasm/Wasm/Isa.lean) — the WebAssembly vehicle +### 70. [Isa.lean](backend/wasm/Wasm/Isa.lean) — the WebAssembly vehicle Models typed values, globals, byte-addressed linear memory, the emitted instruction subset, function tables, and structured execution. Reads and writes use little-endian bytes; loops and branches obey label discipline. Division and host-exit behavior are explicit. -### 70. [Lower.lean](backend/wasm/Wasm/Lower.lean) — turn jumps into dispatch +### 71. [Lower.lean](backend/wasm/Wasm/Lower.lean) — turn jumps into dispatch Lowers each IR instruction to a function returning an `i32` next index. A dispatch loop calls through the function table. Globals track program counter and three stack pointers; memory regions hold registers, IR cells, and stacks. -### 71. [Emit.lean](backend/wasm/Wasm/Emit.lean) — print the module +### 72. [Emit.lean](backend/wasm/Wasm/Emit.lean) — print the module Produces WebAssembly text from lowered instructions and supplies memory declarations, data bytes, globals, imports, and the halt helper. Runtime layout constants determine region placement and capacity. -### 72. [Mem.lean](backend/wasm/Wasm/Mem.lean) — eight bytes make a word +### 73. [Mem.lean](backend/wasm/Wasm/Mem.lean) — eight bytes make a word Proves that writing eight bytes reconstructs the same 64-bit value on a read at that address. Reads of disjoint cells stay unchanged, and writes preserve memory size. -### 73. [Rel.lean](backend/wasm/Wasm/Rel.lean) — align the two state views +### 74. [Rel.lean](backend/wasm/Wasm/Rel.lean) — align the two state views Defines runtime geometry and the relation between IR values and WebAssembly globals and memory. Separate views cover the data stack, registers, IR memory, return addresses, and auxiliary words. -### 74. [Seq.lean](backend/wasm/Wasm/Seq.lean) — join target computations +### 75. [Seq.lean](backend/wasm/Wasm/Seq.lean) — join target computations Defines straight-line execution with `execL` and derives the target `Run` relation from successful calculations. Sequencing lemmas handle normal completion and abrupt outcomes, with useful conditional cases. -### 75. [Frame.lean](backend/wasm/Wasm/Frame.lean) — update one region at a time +### 76. [Frame.lean](backend/wasm/Wasm/Frame.lean) — update one region at a time Proves how eight-byte writes affect the five state views. Updates to a stack, register, or IR-memory cell preserve the other regions. Further lemmas handle stack-pointer adjustment and pushing or popping return and auxiliary entries. -### 76. [Guard.lean](backend/wasm/Wasm/Guard.lean) — the checked platform edge +### 77. [Guard.lean](backend/wasm/Wasm/Guard.lean) — the checked platform edge Proves sequence append behavior, state-relation conveniences, operand guards, and capacity guards. Passing checks preserve the required relation; failing checks produce the appropriate exit. -### 77. [SimAlu.lean](backend/wasm/Wasm/SimAlu.lean) — the arithmetic carriage +### 78. [SimAlu.lean](backend/wasm/Wasm/SimAlu.lean) — the arithmetic carriage Provides generic binary-operation simulation and instantiates it for arithmetic, bitwise operations, rotations, and comparisons. It connects two stack-cell loads, a target operation, a result store, and stack adjustment. -### 78. [SimAlu2.lean](backend/wasm/Wasm/SimAlu2.lean) — arithmetic's special connections +### 79. [SimAlu2.lean](backend/wasm/Wasm/SimAlu2.lean) — arithmetic's special connections Handles shifts, division, signed division, and complement. Large shift counts yield zero as required by the IR, while division checks zero explicitly. The signed divisor-minus-one case preserves modular semantics while avoiding WebAssembly's signed-division overflow trap. -### 79. [SimStack.lean](backend/wasm/Wasm/SimStack.lean) — move words through memory +### 80. [SimStack.lean](backend/wasm/Wasm/SimStack.lean) — move words through memory Proves stack manipulation, selection, literals, pointers, and virtual-register transfers. General push and core-sequence lemmas support multiple operations, with guards for operand availability and capacity. -### 80. [SimMem.lean](backend/wasm/Wasm/SimMem.lean) — find the right eight bytes +### 81. [SimMem.lean](backend/wasm/Wasm/SimMem.lean) — find the right eight bytes Proves IR-address checking, conversion to `mb + 8a`, and simulations of load and store. A valid word address reaches the corresponding bytes; an invalid address exits with bad-address code two. -### 81. [SimCtl.lean](backend/wasm/Wasm/SimCtl.lean) — return the next station index +### 82. [SimCtl.lean](backend/wasm/Wasm/SimCtl.lean) — return the next station index Covers jumps, branches, calls, returns, halt, and the bad-program-counter stub. Continuing instruction functions leave the next IR index for dispatch. Calls and returns update the dedicated return region; empty returns and full call stacks receive defined exits. -### 82. [SimAux.lean](backend/wasm/Wasm/SimAux.lean) — preserve the saved-word connection +### 83. [SimAux.lean](backend/wasm/Wasm/SimAux.lean) — preserve the saved-word connection Proves `tor`, `fromr`, and `rfetch` over the auxiliary region tracked by `$ap`. It covers successful movement and copying, empty-stack code five, and capacity code six. -### 83. [SimExec.lean](backend/wasm/Wasm/SimExec.lean) — one complete dispatch step +### 84. [SimExec.lean](backend/wasm/Wasm/SimExec.lean) — one complete dispatch step Combines all instruction-family results into `sim_step`. It defines stack headroom, trap-code mapping, and the relation between one emitted function's execution and one IR outcome. -### 84. [Correct.lean](backend/wasm/Wasm/Correct.lean) — carry the result through the loop +### 85. [Correct.lean](backend/wasm/Wasm/Correct.lean) — carry the result through the loop Proves dispatch-loop preservation and lifts it to the module's start function. The two main results offer matching IR behavior with overflow allowed, or exact matching behavior under capacity conditions. -### 85. [Init.lean](backend/wasm/Wasm/Init.lean) — start from an instantiated module +### 86. [Init.lean](backend/wasm/Wasm/Init.lean) — start from an instantiated module Constructs initial globals and zeroed memory with the emitted data image, proves runtime geometry and the initial state relation, and establishes `module_correct`. Program-layout fit and register and instruction bounds remain explicit. -### 86. [Wasm.lean](backend/wasm/Wasm.lean) — the WebAssembly library entrance +### 87. [Wasm.lean](backend/wasm/Wasm.lean) — the WebAssembly library entrance Exports the target model, lowering, emitter, memory facts, relations, framing, guards, instruction simulations, whole-program correctness, and initialization. One import provides the full WebAssembly backend. -### 87. [WasmMain.lean](backend/wasm/WasmMain.lean) — ride the line in Wasmtime +### 88. [WasmMain.lean](backend/wasm/WasmMain.lean) — ride the line in Wasmtime Implements `wasmw`: emit WAT, run it through Wasmtime, and compare target output with Lean. It supports sample checks, generated programs, source Forth execution, and source emission. -## Station IX: the AArch64 line — files 88–110 +## Station IX: the AArch64 line — files 89–111 The ARM64 route keeps the x86-64 backend's register roles, lowering shape and proof structure, so most of its files are the x86-64 files with AArch64 registers. The differences are where the two machines differ: AArch64 division never faults, there is no rotate-left instruction, calls and returns use a dedicated return-stack register, and 64-bit constants are built from 16-bit pieces. `a64c` runs the emitted binaries under `qemu-aarch64`. -### 88. [Isa.lean](backend/arm64/A64/Isa.lean) — the ARM vehicle +### 89. [Isa.lean](backend/arm64/A64/Isa.lean) — the ARM vehicle Models the emitted AArch64 subset: `x` registers, `NZCV` flags (with the carry stored as the borrow, `NOT C`, so conditions read like their x86-64 counterparts), loads and stores, `csel`, `udiv`/`sdiv` as `BitVec.udiv`/`BitVec.sdiv`, and the three fixed sequences `movImm` (`movz` + `movk`), `call` and `ret`. Arithmetic is modelled as making the flags unknown, which is more conservative than the hardware. For hand-written programs it also models `x0`–`x8`, the three-register forms (`add x2, x0, x1`, `sub mul and orr eor`) and shifts by a constant (`lsl`, `lsr`, `asr`), which the lowering does not use. -### 89. [Lower.lean](backend/arm64/A64/Lower.lean) — the same track on new rails +### 90. [Lower.lean](backend/arm64/A64/Lower.lean) — the same track on new rails The x86-64 lowering with AArch64 registers. The data stack uses `x19`, virtual registers use `x20`, IR memory uses `x21`, the empty return stack is `x22`, the return-stack pointer is `x23`, and auxiliary data uses `x24`. Division needs only the zero guard, and `rotl` is `neg` followed by `ror`. -### 90. [Emit.lean](backend/arm64/A64/Emit.lean) — print the ARM assembly +### 91. [Emit.lean](backend/arm64/A64/Emit.lean) — print the ARM assembly Prints the model instructions as AArch64 assembly for `clang --target=aarch64-linux-gnu`. Each condition is printed under its AArch64 name, and the three fixed sequences are expanded. An immediate or displacement the encoding cannot hold becomes an `.error` directive, so the assembler rejects it. The runtime places the data, return and auxiliary stacks in their own sections and dumps state on halt through Linux system calls. -### 91. [Rel.lean](backend/arm64/A64/Rel.lean) — match the two timetables +### 92. [Rel.lean](backend/arm64/A64/Rel.lean) — match the two timetables The relation between IR and AArch64 states, with the same disjoint regions as x86-64. The return stack is the `.rstack` section below `sp0`. -### 92. [Run.lean](backend/arm64/A64/Run.lean) — locate and follow the code +### 93. [Run.lean](backend/arm64/A64/Run.lean) — locate and follow the code Defines the running and terminating relations `ASteps` and `AExec` and the code-placement predicate `AAt`, and locates each lowered IR instruction and the trailing bad-pc stub. -### 93. [Seq.lean](backend/arm64/A64/Seq.lean) — compose short stretches +### 94. [Seq.lean](backend/arm64/A64/Seq.lean) — compose short stretches Straight-line execution (`aseq`) and the branch-and-trap guard pattern. -### 94. [Flags.lean](backend/arm64/A64/Flags.lean) — read the signals correctly +### 95. [Flags.lean](backend/arm64/A64/Flags.lean) — read the signals correctly Proves that each condition, evaluated on the flags of `cmp a, b`, is the IR comparison predicate, for all ten conditions. -### 95. [Micro.lean](backend/arm64/A64/Micro.lean) — the smallest useful moves +### 96. [Micro.lean](backend/arm64/A64/Micro.lean) — the smallest useful moves Local effects of loads, stores, scratch-register writes, stack-pointer adjustment and the two-instruction push, under the state relation. -### 96. [Guard.lean](backend/arm64/A64/Guard.lean) — check room and operands +### 97. [Guard.lean](backend/arm64/A64/Guard.lean) — check room and operands Operand-count guards and data- and return-stack capacity checks: continue, trap `stackUnderflow`, or exit with `overflow`. -### 97. [SimBin.lean](backend/arm64/A64/SimBin.lean) — one pattern, many operators +### 98. [SimBin.lean](backend/arm64/A64/SimBin.lean) — one pattern, many operators `MidSpec` and the generic binary-operation simulation: load two operands, compute, store, pop one slot. -### 98. [SimOps.lean](backend/arm64/A64/SimOps.lean) — the arithmetic route +### 99. [SimOps.lean](backend/arm64/A64/SimOps.lean) — the arithmetic route Arithmetic, bitwise operations, shifts, rotations and comparisons. `ror_neg` proves that rotating right by `-n` is rotating left by `n`, which is how `rotl` is lowered. -### 99. [SimStack.lean](backend/arm64/A64/SimStack.lean) — rearrange the carried words +### 100. [SimStack.lean](backend/arm64/A64/SimStack.lean) — rearrange the carried words Literals, pointers, complement, `dup`, `drop`, `swap`, `over` and `rot`. -### 100. [SimMem.lean](backend/arm64/A64/SimMem.lean) — preserve neighboring regions +### 101. [SimMem.lean](backend/arm64/A64/SimMem.lean) — preserve neighboring regions Address and frame lemmas for virtual-register and IR-memory access. -### 101. [SimMemOps.lean](backend/arm64/A64/SimMemOps.lean) — perform the checked access +### 102. [SimMemOps.lean](backend/arm64/A64/SimMemOps.lean) — perform the checked access The address bounds guard and the `push`/`pop` and `load`/`store` simulations, for both success and bad-address traps. -### 102. [SimDiv.lean](backend/arm64/A64/SimDiv.lean) — division without special junctions +### 103. [SimDiv.lean](backend/arm64/A64/SimDiv.lean) — division without special junctions `select`, and both divisions through one lemma (`sim_divop_ok`). After the zero guard the division is a single instruction, because AArch64 `udiv` and `sdiv` never fault and are exactly the IR's `BitVec` division. -### 103. [SimCtl.lean](backend/arm64/A64/SimCtl.lean) — branch, call, and return +### 104. [SimCtl.lean](backend/arm64/A64/SimCtl.lean) — branch, call, and return Jumps, branches, calls, returns and halt. `call` pushes the return index on the `x23` stack and `ret` pops it, both writing `x30`. Return underflow and call overflow have explicit outcomes. -### 104. [SimAux.lean](backend/arm64/A64/SimAux.lean) — a separate place for saved data +### 105. [SimAux.lean](backend/arm64/A64/SimAux.lean) — a separate place for saved data The auxiliary stack on `x24`: its guards and the `tor`, `fromr` and `rfetch` simulations. -### 105. [SimStep.lean](backend/arm64/A64/SimStep.lean) — every instruction gets a connection +### 106. [SimStep.lean](backend/arm64/A64/SimStep.lean) — every instruction gets a connection `sim_exec`: every IR instruction, for every outcome, including overflow when a stack is full. -### 106. [Correct.lean](backend/arm64/A64/Correct.lean) — preserve the complete journey +### 107. [Correct.lean](backend/arm64/A64/Correct.lean) — preserve the complete journey Whole-program preservation: `lowerProg_correct_or_overflow` and `lowerProg_correct`, with the same hypotheses as x86-64. -### 107. [Init.lean](backend/arm64/A64/Init.lean) — begin at the binary entrance +### 108. [Init.lean](backend/arm64/A64/Init.lean) — begin at the binary entrance The six-instruction prologue model and its proved effect, `entry_rel`, and the end-to-end `binary_correct`. Because the return stack is a linked section rather than the operating system's stack, `Loader.Holds` has no entry-register fact, only memory, placement and image facts. -### 108. [DataOps.lean](backend/arm64/A64/DataOps.lean) — hand-written ARM programs +### 109. [DataOps.lean](backend/arm64/A64/DataOps.lean) — hand-written ARM programs The general AArch64 data-processing forms that hand-written programs use: three registers (`add x2, x0, x1`, and likewise `sub mul and orr eor`) and shifts by a constant (`lsl`, `lsr`, and the arithmetic `asr`). It proves what each computes (`alu_toNat`, `lsl_toNat`, `lsr_toNat`, `asr_toInt`, `udiv_toNat`, `sub_toInt`, `mul_toInt`) and that a short program using all of them halts with the values its comments state (`dataProcessing_run`). `a64c check` runs that program and 100 random ones under qemu and compares the registers with the model. -### 109. [A64.lean](backend/arm64/A64.lean) — the AArch64 library entrance +### 110. [A64.lean](backend/arm64/A64.lean) — the AArch64 library entrance Exports the AArch64 model, lowering, emitter, simulation modules, whole-program proofs and initialization result. -### 110. [A64Main.lean](backend/arm64/A64Main.lean) — ride the line under qemu +### 111. [A64Main.lean](backend/arm64/A64Main.lean) — ride the line under qemu Implements `a64c`: emit assembly, assemble with `clang`, link with `ld.lld`, run under `qemu-aarch64` (or directly on an AArch64 Linux host), and compare against Lean. It runs the same fixed, generated, auxiliary-stack, overflow and Forth-file checks as `wordc`, plus a check of hand-written programs: the data-processing program of `DataOps.lean` and 100 random programs over the three-register and constant-shift forms, compared register by register (`x0`–`x11`) with the model. -## Station X: the RISC-V line — files 111–132 +## Station X: the RISC-V line — files 112–133 The RV64 route keeps the register roles and proof structure of the x86-64 and AArch64 backends, but RISC-V has no condition flags. Every check is a compare-and-branch on two registers, a comparison result comes from a branch around a constant, and `select` branches around a move. There is no indexed addressing and no rotate instruction in the base ISA. `rv64c` runs the emitted binaries under `qemu-riscv64`. -### 111. [Isa.lean](backend/riscv64/RV/Isa.lean) — a machine without flags +### 112. [Isa.lean](backend/riscv64/RV/Isa.lean) — a machine without flags Models the emitted RV64IM subset: integer registers, `ld`/`sd`, register-register arithmetic, `sltiu`, `sll`/`srl` with the amount modulo 64, and `divu`/`div` exactly as RISC-V defines them (all ones on a zero divisor; `div` wraps on overflow). The conditional branch `bcc c a b t` takes the IR's own comparison `Cond`, so its meaning needs no flag encoding. `movImm` (the assembler's `li`), far branches, `call` and `ret` are fixed sequences. For hand-written programs it also has the three-register forms (`alu`), shifts by a constant (`shiftImm`: `slli srli srai`) and the registers `a0`–`a7`, `s7`–`s10`. -### 112. [Lower.lean](backend/riscv64/RV/Lower.lean) — the same track without signals +### 113. [Lower.lean](backend/riscv64/RV/Lower.lean) — the same track without signals The data stack uses `s1`, virtual registers use `s2`, IR memory uses `s3`, the empty return stack is `s4`, the return-stack pointer is `s5`, and auxiliary data uses `s6`. Each guard is three instructions (load a limit, `bcc`, trap or overflow stub). Memory access computes the address with `slli` and `add`. `shl`/`shr` mask the result to zero for amounts of 64 or more, and the rotations are two shifts and an `or`. -### 113. [Emit.lean](backend/riscv64/RV/Emit.lean) — print the RISC-V assembly +### 114. [Emit.lean](backend/riscv64/RV/Emit.lean) — print the RISC-V assembly Prints the model instructions for `clang --target=riscv64-linux-gnu -march=rv64im`. Each conditional branch is printed as the opposite branch over a `j`, so it reaches as far as `j` does. An out-of-range immediate becomes an `.error` directive. The runtime uses `li`/`lla`, places the three stacks in their own sections, and dumps state on halt through Linux system calls. -### 114. [Rel.lean](backend/riscv64/RV/Rel.lean) — match the two timetables +### 115. [Rel.lean](backend/riscv64/RV/Rel.lean) — match the two timetables The relation between IR and RISC-V states. The regions and their disjointness are the same as on the other native targets. -### 115. [Run.lean](backend/riscv64/RV/Run.lean) — locate and follow the code +### 116. [Run.lean](backend/riscv64/RV/Run.lean) — locate and follow the code `RSteps`, `RExec` and `RAt`, and the placement of each lowered IR instruction and the trailing bad-pc stub. -### 116. [Seq.lean](backend/riscv64/RV/Seq.lean) — compose short stretches +### 117. [Seq.lean](backend/riscv64/RV/Seq.lean) — compose short stretches Straight-line execution (`rseq`), and the branch-and-stub guard lemmas `guard_pass`/`guard_trap` and `ovf_pass`/`ovf_trap`, all stated directly on `Cond.eval` of two registers. -### 117. [Micro.lean](backend/riscv64/RV/Micro.lean) — the smallest useful moves +### 118. [Micro.lean](backend/riscv64/RV/Micro.lean) — the smallest useful moves Local effects of loads, stores, scratch-register writes, stack-pointer adjustment and the two-instruction push. -### 118. [Guard.lean](backend/riscv64/RV/Guard.lean) — check room and operands +### 119. [Guard.lean](backend/riscv64/RV/Guard.lean) — check room and operands The operand-count guard (`bcc .ule`) and the data- and return-stack capacity guards (`bcc .uge`), each with its passing and failing case. -### 119. [SimBin.lean](backend/riscv64/RV/SimBin.lean) — one pattern, many operators +### 120. [SimBin.lean](backend/riscv64/RV/SimBin.lean) — one pattern, many operators `MidSpec` and the generic binary-operation simulation, as on the other native targets. -### 120. [SimOps.lean](backend/riscv64/RV/SimOps.lean) — arithmetic without rotate +### 121. [SimOps.lean](backend/riscv64/RV/SimOps.lean) — arithmetic without rotate Arithmetic, bitwise operations, shifts and rotations. `mask_lt` justifies the shift mask, and `rotl_shifts`/`rotr_shifts` prove that two shifts and an `or` are the rotations. -### 121. [SimStack.lean](backend/riscv64/RV/SimStack.lean) — rearrange the carried words +### 122. [SimStack.lean](backend/riscv64/RV/SimStack.lean) — rearrange the carried words Literals, pointers, complement, `dup`, `drop`, `swap`, `over` and `rot`. -### 122. [SimMem.lean](backend/riscv64/RV/SimMem.lean) — compute the address, keep the neighbours +### 123. [SimMem.lean](backend/riscv64/RV/SimMem.lean) — compute the address, keep the neighbours Frame lemmas for the register file and IR memory, and the address computation `idx_addr`/`idx_steps` that replaces indexed addressing. -### 123. [SimMemOps.lean](backend/riscv64/RV/SimMemOps.lean) — perform the checked access +### 124. [SimMemOps.lean](backend/riscv64/RV/SimMemOps.lean) — perform the checked access The `bltu` bounds guard and the `push`/`pop` and `load`/`store` simulations, for success and bad-address traps. -### 124. [SimDiv.lean](backend/riscv64/RV/SimDiv.lean) — branches inside an instruction +### 125. [SimDiv.lean](backend/riscv64/RV/SimDiv.lean) — branches inside an instruction The divisions after a `bnez` zero guard, and the two instructions whose lowering branches internally: `select` (`beqz` over a `mv`) and `cmp` (`bcc` over setting `0`), each proved for both paths. -### 125. [SimCtl.lean](backend/riscv64/RV/SimCtl.lean) — branch, call, and return +### 126. [SimCtl.lean](backend/riscv64/RV/SimCtl.lean) — branch, call, and return `jmp`, `branch` (`bnez`), `call` and `ret` on the `s5` return stack, and halt. -### 126. [SimAux.lean](backend/riscv64/RV/SimAux.lean) — a separate place for saved data +### 127. [SimAux.lean](backend/riscv64/RV/SimAux.lean) — a separate place for saved data The auxiliary stack on `s6`: its `bcc` guards and the `tor`, `fromr` and `rfetch` simulations. -### 127. [SimStep.lean](backend/riscv64/RV/SimStep.lean) — every instruction gets a connection +### 128. [SimStep.lean](backend/riscv64/RV/SimStep.lean) — every instruction gets a connection `sim_exec`: every IR instruction, for every outcome, including overflow when a stack is full. -### 128. [Correct.lean](backend/riscv64/RV/Correct.lean) — preserve the complete journey +### 129. [Correct.lean](backend/riscv64/RV/Correct.lean) — preserve the complete journey `lowerProg_correct_or_overflow` and `lowerProg_correct`, with the same hypotheses as the other native targets. -### 129. [Init.lean](backend/riscv64/RV/Init.lean) — begin at the binary entrance +### 130. [Init.lean](backend/riscv64/RV/Init.lean) — begin at the binary entrance The six-instruction prologue model and its effect, `entry_rel`, and the end-to-end `binary_correct`. -### 130. [DataOps.lean](backend/riscv64/RV/DataOps.lean) — hand-written RISC-V programs +### 131. [DataOps.lean](backend/riscv64/RV/DataOps.lean) — hand-written RISC-V programs The general RISC-V data-processing forms that hand-written programs use: three registers (`add a2, a0, a1`, and likewise `sub mul and or xor`), register shifts (`sll srl sra`, amount modulo 64) and shifts by a constant (`slli`, `srli`, and the arithmetic `srai`). It proves what each computes (`alu_toNat`, `slli_toNat`, `srli_toNat`, `srai_toInt`, `divu_toNat`, `sub_toInt`, `mul_toInt`, `shift_reg`), that division by zero gives all ones (`divu_zero`, `div_zero`), and that the RISC-V version of the AArch64 data-processing program halts with the same values (`dataProcessing_run`). `rv64c check` runs that program and 100 random ones under qemu and compares the registers with the model. -### 131. [RV.lean](backend/riscv64/RV.lean) — the RISC-V library entrance +### 132. [RV.lean](backend/riscv64/RV.lean) — the RISC-V library entrance Exports the RISC-V model, lowering, emitter, simulation modules, whole-program proofs and initialization result. -### 132. [RVMain.lean](backend/riscv64/RVMain.lean) — ride the line under qemu +### 133. [RVMain.lean](backend/riscv64/RVMain.lean) — ride the line under qemu Implements `rv64c`: emit assembly, assemble with `clang`, link with `ld.lld`, run under `qemu-riscv64` (or directly on a RISC-V Linux host), and compare against Lean, with the same checks as `wordc` and `a64c`, including the hand-written data-processing check of `DataOps.lean` (registers `a0`–`a7`, `s7`–`s10`). -## Station XI: the microcontroller profile (RV32) — files 133–154 +## Station XI: the microcontroller profile (RV32) — files 134–155 The same IR at width 32, on a RISC-V microcontroller-class core with no operating system. The backend is the RV64 line of Station X with 32-bit words and 4-byte cells, and every proof is carried over. What is new is the runtime: the program starts at the reset address, prints through a UART and stops through a test device. `rv32c` runs it on the bare QEMU `virt` board (`qemu-system-riscv32 -bios none`). -### 133. [Isa.lean](backend/rv32/RV32/Isa.lean) — the same instructions on a smaller machine +### 134. [Isa.lean](backend/rv32/RV32/Isa.lean) — the same instructions on a smaller machine -The RV32IM model: the instructions of stop 111 on 32-bit registers, with `lw`/`sw`, shift amounts modulo 32 and 4-byte return-stack entries. Its header states that the instruction semantics are the stated assumption of the profile and that the stubs talk to memory-mapped devices rather than an operating system. +The RV32IM model: the instructions of stop 112 on 32-bit registers, with `lw`/`sw`, shift amounts modulo 32 and 4-byte return-stack entries. Its header states that the instruction semantics are the stated assumption of the profile and that the stubs talk to memory-mapped devices rather than an operating system. -### 134. [Lower.lean](backend/rv32/RV32/Lower.lean) — lower 32-bit words +### 135. [Lower.lean](backend/rv32/RV32/Lower.lean) — lower 32-bit words -Lowers `Prog 32`. The register roles and code sizes are those of stop 112; every cell is four bytes, so addresses use `slli 2` and stack offsets are multiples of four, and the shift mask tests `amount (tested under qemu)"] RM["RISC-V model = hardware
(tested under qemu)"] MM["RV32 model = hardware,
UART and test device
(tested on the qemu virt board)"] - CMM["Cortex-M model = hardware,
UART and semihosting
(tested on an emulated Cortex-M3)"] + CMM["Cortex-M model = hardware,
UART and board set-up
(tested on an emulated Cortex-M3)"] CM0M["Cortex-M0 model = hardware
(tested on an emulated Cortex-M0)"] INST["wasm instantiation rule"] LDR["ELF loader facts (Loader.Holds;
for Cortex-M only flash facts, FlashHolds)"] @@ -2146,6 +2248,12 @@ Things to keep in mind when reading the theorems: `push`/`pop` exist (`RegsOk`), the program has fewer than `2^32` instructions (WebAssembly) or `17 · length < 2^64` (x86-64, AArch64 and RISC-V) or `17 · length < 2^32` (RV32 and Cortex-M), or `36 · length < 2^32` (Cortex-M0, whose division sequences are longer), and the register file and memory image fit the runtime layout (WebAssembly). +* **Optimisations take a checked certificate, not a trusted analysis.** The microcontroller + lowerings (RV32, Cortex-M3, Cortex-M0) drop an underflow or overflow guard only where a + stack-depth certificate or bound says it cannot fire; their theorems assume `certOk` and + `UbSound` for them, which the drivers obtain from decidable checks (`certTable_ok`, + `upperTable_sound`). The analyses that propose them are outside the trusted base: if a result + fails its check, the driver uses the certificate that claims nothing and keeps those guards. * **The emitted text is generated from the verified instruction lists.** `Wasm.Emit`, `X86.Emit`, `A64.Emit`, `RV.Emit`, `RV32.Emit`, `CM.Emit` and `CM0.Emit` print exactly what the lowering produced, so there is no second hand-written copy of the code to drift. The hand-written parts are the small runtimes (prologue, dump routine, trap @@ -2158,12 +2266,12 @@ Things to keep in mind when reading the theorems: Install Git and [elan](https://github.com/leanprover/elan), then make `lean` and `lake` available on your path. The repository pins `leanprover/lean4:v4.34.1`; elan selects that toolchain. The Lake package is named `UniversalWord`, and its manifest lists no external package dependencies. ```sh -git clone https://github.com/SNAPKITTYWEST/ai-free.git +git clone https://github.com/snapkittyagent9nova/ai-free.git cd ai-free lake build ``` -The default build includes the semantic and frontend libraries, shared harness, the seven backend libraries, and the `wordc`, `wasmw`, `a64c`, `rv64c`, `rv32c`, `cmc` and `cm0c` executables. Native execution uses x86-64 Linux with GNU `as` and `ld`. WebAssembly execution uses [Wasmtime](https://github.com/bytecodealliance/wasmtime/releases); the workflow selects version `30.0.2`. AArch64 and RISC-V execution use `clang` and `ld.lld` to build the binary and `qemu-aarch64` / `qemu-riscv64` (Debian/Ubuntu package `qemu-user`) to run it; on a matching Linux machine the binaries run directly. The RV32 microcontroller profile uses the same `clang` and `ld.lld` and runs on the emulated `virt` board, `qemu-system-riscv32` (package `qemu-system-misc`); the Cortex-M profiles run on emulated Cortex-M3 and Cortex-M0 boards, `qemu-system-arm` (package `qemu-system-arm`). +The default build includes the semantic and frontend libraries, shared harness, the seven backend libraries, and the `wordc`, `wasmw`, `a64c`, `rv64c`, `rv32c`, `cmc` and `cm0c` executables. Native execution uses x86-64 Linux with GNU `as` and `ld`. WebAssembly execution uses [Wasmtime](https://github.com/bytecodealliance/wasmtime/releases); the workflow selects version `30.0.2`. AArch64 and RISC-V execution use `clang` and `ld.lld` to build the binary and `qemu-aarch64` / `qemu-riscv64` (Debian/Ubuntu package `qemu-user`) to run it; on a matching Linux machine the binaries run directly. The RV32 microcontroller profile uses the same `clang` and `ld.lld` and runs on the emulated `virt` board, `qemu-system-riscv32` (package `qemu-system-misc`); the Cortex-M profiles run on emulated Cortex-M3 and Cortex-M0 boards, `qemu-system-arm` (package `qemu-system-arm`). Board images (`cmc image`, `cm0c image`) also need `llvm-objcopy` (package `llvm`). The changes in each version are in [`CHANGELOG.md`](CHANGELOG.md). Try a short source file containing `5 DUP +`, or use the repository's [Forth examples](examples/forth). The commands below exercise real source parsing and compilation before comparing target behavior with Lean: @@ -2209,6 +2317,18 @@ You can also inspect a built-in sample's output without running the target: Other named samples include `bcpl_sum_1_to_10`, `wolfram_dot_2x2`, and `raw_call_ret`. The shared harness contains the complete sample lists. Native execution artifacts are written under `/tmp/wordc`; WebAssembly artifacts use `/tmp/wasmw`, AArch64 artifacts `/tmp/a64c`, RISC-V artifacts `/tmp/rv64c`, RV32 artifacts `/tmp/rv32c`, Cortex-M artifacts `/tmp/cmc`, and Cortex-M0 artifacts `/tmp/cm0c`. Successful target output is a binary state dump decoded by the harness, so these commands are most informative when used with the comparison tools or emitter output. +## Running on a real board + +`cm0c image prog.fs` (BBC micro:bit V1, or `--board microbit-v2`, or Microchip's SAM D21 +Curiosity Nano with `--board samd21-cnano`) and `cmc image prog.fs` (Stellaris EK-LM3S6965) write +a flashable ELF and Intel HEX file plus the exact serial output a correct run prints. Flash the board, capture its serial port at 115200 8N1, and check the log with +`cm0c verify prog.fs serial.log` / `cmc verify prog.fs serial.log`. The runtimes need no debugger: +a run ends with an `EXIT` line and the status on the UART. The runbook, including what a mismatch +means, is [docs/HARDWARE.md](docs/HARDWARE.md). [docs/HIL.md](docs/HIL.md) automates it on a Linux machine with boards attached +(`scripts/hil/`), as a CI job on a self-hosted runner. The board set-up has so far been exercised only on +QEMU's models of these boards; the SAM D21 has no QEMU model, so its start-up code is checked +only by building and disassembling the image. + ## Checking everything at once ```sh @@ -2285,7 +2405,7 @@ The project uses the [Parr Source License — No AI Training, Version 1.0](Licen ### 💼 Commercial License -This repository is published under **Parr Source License (No AI Training) 1.0**. Building a commercial product or service? A **proprietary commercial license** from Snapkitty Collective LLC lets you ship this code on terms other than the Parr Source License (No AI Training) 1.0. +This repository is published under **the Parr Source License (No AI Training) 1.0**. Building a commercial product or service? A **proprietary commercial license** from Snapkitty Collective LLC lets you ship this code on terms other than the Parr Source License (No AI Training) 1.0. **[→ Get a commercial license](mailto:A.parr@belespritdaccord.uk?subject=Commercial%20license:%20ai-free)** · A.parr@belespritdaccord.uk diff --git a/backend/common/Harness32.lean b/backend/common/Harness32.lean index 1a745b25829edb122df5e7255c62b5dfc0ed28ce..adfd8a8b6d5f361986bccbba33a6facc33e71bd6 100644 --- a/backend/common/Harness32.lean +++ b/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 `.elf`, `.hex` and `.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 diff --git a/backend/cortexm/CM/Boot.lean b/backend/cortexm/CM/Boot.lean index 8a1bb4bbcbe6c85e47011e9877f7f8a454f1f670..685ac8acc0135eb2280afc8c26fb64ed394b4ccb 100644 --- a/backend/cortexm/CM/Boot.lean +++ b/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 diff --git a/backend/cortexm/CM/Correct.lean b/backend/cortexm/CM/Correct.lean index e8e9fe6b8225365da3388dff33bde066fc3f8850..83f941765a6f8a6fddc849e531056067591a51eb 100644 --- a/backend/cortexm/CM/Correct.lean +++ b/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 diff --git a/backend/cortexm/CM/Emit.lean b/backend/cortexm/CM/Emit.lean index d87a5004d4bfb8dbd01667523fe8383048612a7d..2dc5b05e1e09fe74d7fa31594fb3235704c6dc6c 100644 --- a/backend/cortexm/CM/Emit.lean +++ b/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" ++ diff --git a/backend/cortexm/CM/Guard.lean b/backend/cortexm/CM/Guard.lean index 3782f058e68d83c3d459f654f645a376c27593a1..7678bc20f1888cc4009a5b892419c63e3613be5a 100644 --- a/backend/cortexm/CM/Guard.lean +++ b/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) = diff --git a/backend/cortexm/CM/Init.lean b/backend/cortexm/CM/Init.lean index cfdbaa4554db5f60b1fbb4e553fed15df25904bc..764ee741a39c9a58020fc32041aef3815eedd0c4 100644 --- a/backend/cortexm/CM/Init.lean +++ b/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 diff --git a/backend/cortexm/CM/Isa.lean b/backend/cortexm/CM/Isa.lean index ae6d05ca240d04d2c2f7610091f4136cf5370471..2b5e3a95ab1c043b3db8d88fb6e2d284fc4ec162 100644 --- a/backend/cortexm/CM/Isa.lean +++ b/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`). diff --git a/backend/cortexm/CM/Lower.lean b/backend/cortexm/CM/Lower.lean index 44ac81b7b5566b4f92cd155d8de21dadc594f1e0..96cc8718cf53b40823300368bd08f7323d9eb342 100644 --- a/backend/cortexm/CM/Lower.lean +++ b/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 diff --git a/backend/cortexm/CM/Rel.lean b/backend/cortexm/CM/Rel.lean index 3547520364a125049dcfb7755cc2ca1722cf7343..74d9b36ce492f44a56cd6cbe2eb2a4e9212d1850 100644 --- a/backend/cortexm/CM/Rel.lean +++ b/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) diff --git a/backend/cortexm/CM/Run.lean b/backend/cortexm/CM/Run.lean index 49d3da1801cd1d405d7d2d52f5df7be54f5ae07e..5df73f72c411c1b23d009d1501d98da49ed7c88d 100644 --- a/backend/cortexm/CM/Run.lean +++ b/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 diff --git a/backend/cortexm/CM/SimAux.lean b/backend/cortexm/CM/SimAux.lean index be8cea86058149f6486e6fce2da86ac41a50aa97..34494f3c8e00d43705c1e8673041b6a41c99aef6 100644 --- a/backend/cortexm/CM/SimAux.lean +++ b/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 diff --git a/backend/cortexm/CM/SimBin.lean b/backend/cortexm/CM/SimBin.lean index 501f601aec01f8aa050be1e3cf08420a6ca9873d..14c45e73219fb6b43e76b55d04c585daa0d9aa89 100644 --- a/backend/cortexm/CM/SimBin.lean +++ b/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 diff --git a/backend/cortexm/CM/SimCtl.lean b/backend/cortexm/CM/SimCtl.lean index ab40339fcafce1ead42a9e62ff5e5e67ea06d216..720186413f60396f4a78c4c6d60d3c76c456e869 100644 --- a/backend/cortexm/CM/SimCtl.lean +++ b/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 diff --git a/backend/cortexm/CM/SimDiv.lean b/backend/cortexm/CM/SimDiv.lean index b2551b6cf283db2cc1646481c36a137d5774ac70..d38499b04611f4d6885556a16dc012fb0cb39622 100644 --- a/backend/cortexm/CM/SimDiv.lean +++ b/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 diff --git a/backend/cortexm/CM/SimMemOps.lean b/backend/cortexm/CM/SimMemOps.lean index aa06d120060a80f72c6868c295ebd60d9868e680..78273e743ef36713e20fd0ce817dd792a74adc9b 100644 --- a/backend/cortexm/CM/SimMemOps.lean +++ b/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⟩)) diff --git a/backend/cortexm/CM/SimOps.lean b/backend/cortexm/CM/SimOps.lean index d5a982a5afffb4d86c5817e23482cb9f3859ffb2..fd2cd54d732a61bae74f2b6e067a5fac3e29ff24 100644 --- a/backend/cortexm/CM/SimOps.lean +++ b/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 diff --git a/backend/cortexm/CM/SimStack.lean b/backend/cortexm/CM/SimStack.lean index 77c09d6832b7b69620dd1e608ab9369f50e4c5c8..c22a28dc3f06c804583b2cbfee3a6b196ce9dbbf 100644 --- a/backend/cortexm/CM/SimStack.lean +++ b/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 diff --git a/backend/cortexm/CM/SimStep.lean b/backend/cortexm/CM/SimStep.lean index 9b0e1b5d9ef844cb535edea5843b177563437468..f70bb573a9c5bcc0a761fd3e717c1d5eb487fa7f 100644 --- a/backend/cortexm/CM/SimStep.lean +++ b/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] diff --git a/backend/cortexm/CMMain.lean b/backend/cortexm/CMMain.lean index 9f7c4935365b03633bea49fcfcbba0e9c56a8901..604d80ec1ec9661b34366c014d7bbbf013d36c56 100644 --- a/backend/cortexm/CMMain.lean +++ b/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 `, `cmc forth [memWords]`, -`cmc emit-forth [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 [memWords]`, +`cmc verify [memWords]`, `cmc emit `, `cmc forth [memWords]`, +`cmc emit-forth [memWords]`, `cmc stats [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 [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 [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 [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 [memWords]"; return 2 + | some m => verifyLog (← forthFileSample32 path m) log + | "stats" :: path :: rest => + match parseMem rest with + | none => IO.eprintln "usage: cmc stats [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 | cmc forth [memWords] | cmc emit-forth [memWords]"; return 2 + return (if ok && okc && isa then 0 else 1) + | _ => IO.eprintln "usage: cmc check [fuzzCount] | cmc emit | cmc forth [memWords] | cmc emit-forth [memWords] | cmc image [memWords] | cmc verify [memWords]"; return 2 diff --git a/backend/cortexm0/CM0/Boot.lean b/backend/cortexm0/CM0/Boot.lean index b8c7e07a180671a27bc5cdde404c32460c12b1d1..eacfc14473cb0651216bf194d7035328eb09f626 100644 --- a/backend/cortexm0/CM0/Boot.lean +++ b/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 diff --git a/backend/cortexm0/CM0/Correct.lean b/backend/cortexm0/CM0/Correct.lean index 906f94db0dd4ef43c3b11d4c690edabe529f3845..17bbd83a6a176b825737f80f5550864459d7b73e 100644 --- a/backend/cortexm0/CM0/Correct.lean +++ b/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 diff --git a/backend/cortexm0/CM0/Emit.lean b/backend/cortexm0/CM0/Emit.lean index eed90048bc09af6f5a9c2285adeffafe2fd9562c..40fec0bf44b3c930cddcbc4b8ee54d42fecd6be7 100644 --- a/backend/cortexm0/CM0/Emit.lean +++ b/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" ++ diff --git a/backend/cortexm0/CM0/Guard.lean b/backend/cortexm0/CM0/Guard.lean index 6bf6af242ed52680d8bd791bad2ec7d2e4e0121c..674db493b6713ee5ac5c2144df29b75a92becd18 100644 --- a/backend/cortexm0/CM0/Guard.lean +++ b/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) = diff --git a/backend/cortexm0/CM0/Init.lean b/backend/cortexm0/CM0/Init.lean index b7529d120a262999d38a3eca2d59bd04ddfa979a..47f6c375a2b0a7b32fedb85c56fcd6ef640bbf56 100644 --- a/backend/cortexm0/CM0/Init.lean +++ b/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 diff --git a/backend/cortexm0/CM0/Isa.lean b/backend/cortexm0/CM0/Isa.lean index c6fcca215ae133a7fda8110836d1af3eb45d9018..8f390ea33815baa59d172e4e3912f77230380c15 100644 --- a/backend/cortexm0/CM0/Isa.lean +++ b/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`). diff --git a/backend/cortexm0/CM0/Lower.lean b/backend/cortexm0/CM0/Lower.lean index 3360159411f61c9e09c3f1dfca80c04cbe03a448..011d4baf19472b196e9de84a4cd87dc06c5a5d1b 100644 --- a/backend/cortexm0/CM0/Lower.lean +++ b/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 diff --git a/backend/cortexm0/CM0/Rel.lean b/backend/cortexm0/CM0/Rel.lean index 4834b5df0cca539c3f698410225c22f101671a00..44f985e8e660b1c0ef35af74e5307ed82af15c78 100644 --- a/backend/cortexm0/CM0/Rel.lean +++ b/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) diff --git a/backend/cortexm0/CM0/Run.lean b/backend/cortexm0/CM0/Run.lean index 6adf265f202d877a3b31315f642f9b669f05402b..308daf9870379a2f5e174b0aaaeffd6fe19d536e 100644 --- a/backend/cortexm0/CM0/Run.lean +++ b/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 diff --git a/backend/cortexm0/CM0/SimAux.lean b/backend/cortexm0/CM0/SimAux.lean index 01cdc07711d80b18a29102c626583b2964b1a27c..726eccdcfd3955a20c5ffbea7569365525d4d3a7 100644 --- a/backend/cortexm0/CM0/SimAux.lean +++ b/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 diff --git a/backend/cortexm0/CM0/SimBin.lean b/backend/cortexm0/CM0/SimBin.lean index 8af19234d2ddc99e27260e2a37e9b51b9e0b588d..6aee25ed50889738ce947bbddf418670ec49ecb8 100644 --- a/backend/cortexm0/CM0/SimBin.lean +++ b/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 diff --git a/backend/cortexm0/CM0/SimCtl.lean b/backend/cortexm0/CM0/SimCtl.lean index cb6a8138c3abe1bc8e0da52f0abeaf8e8864dd18..db0613dcf894a028b00e118a2ee9f21136df7306 100644 --- a/backend/cortexm0/CM0/SimCtl.lean +++ b/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 diff --git a/backend/cortexm0/CM0/SimDiv.lean b/backend/cortexm0/CM0/SimDiv.lean index 155e4f32dc1f12589aa9f9b50acd44473ba7bcb9..1fd8ec190e0c0cbc383a5f5cb93df591c16410fc 100644 --- a/backend/cortexm0/CM0/SimDiv.lean +++ b/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 diff --git a/backend/cortexm0/CM0/SimMemOps.lean b/backend/cortexm0/CM0/SimMemOps.lean index 0ce6c224501668fc4968d4a4ae302ce91ae79647..8b3897b4415cdf22f97247bcc027ce74388af666 100644 --- a/backend/cortexm0/CM0/SimMemOps.lean +++ b/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⟩)) diff --git a/backend/cortexm0/CM0/SimOps.lean b/backend/cortexm0/CM0/SimOps.lean index 0cbfa9b5cbf6f9ce263fada440ebd23fcda2c97c..fcaeb0a8d7f46357a14c5ad9091f3d6028061199 100644 --- a/backend/cortexm0/CM0/SimOps.lean +++ b/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 diff --git a/backend/cortexm0/CM0/SimStack.lean b/backend/cortexm0/CM0/SimStack.lean index 890733316990bdf152edf0879ae8a30dd4f6370f..7e083dbb74851e8724764cdaad520c6f198dacf1 100644 --- a/backend/cortexm0/CM0/SimStack.lean +++ b/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 diff --git a/backend/cortexm0/CM0/SimStep.lean b/backend/cortexm0/CM0/SimStep.lean index 71313d4f3b35d6a0d281605efebb2f970c8b863c..18131b10319a5b5519d527c00490364aad373e95 100644 --- a/backend/cortexm0/CM0/SimStep.lean +++ b/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] diff --git a/backend/cortexm0/CM0Main.lean b/backend/cortexm0/CM0Main.lean index 783e8ec5fef7f3b268210fe5de8c2296df7e87d1..f76d4111bdb3888a083b0b2a2f87914be34f6a45 100644 --- a/backend/cortexm0/CM0Main.lean +++ b/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 `, `cm0c forth [memWords]`, -`cm0c emit-forth [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 [memWords] [--board …]`, +`cm0c verify [memWords]`, `cm0c emit `, `cm0c forth [memWords]`, +`cm0c emit-forth [memWords]`; `--no-opt` with any of them lowers without the +stack-depth certificate and bound, keeping every guard; `cm0c stats ` 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 [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 [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 [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 [memWords]"; return 2 + | some m => verifyLog (← forthFileSample32 path m) log + | "stats" :: path :: rest => + match parseMem rest with + | none => IO.eprintln "usage: cm0c stats [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 | cm0c forth [memWords] | cm0c emit-forth [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 | cm0c forth [memWords] | cm0c emit-forth [memWords] | cm0c image [memWords] [--board microbit-v1|microbit-v2|samd21-cnano] | cm0c verify [memWords] | cm0c stats [memWords] (any command: --no-opt keeps every guard)"; return 2 diff --git a/backend/rv32/RV32/Correct.lean b/backend/rv32/RV32/Correct.lean index d6b5358c703c38a7a91f6fd13e939f2b26406eb0..970f74f0c075cce1997d72ba903dcacd850a5b47 100644 --- a/backend/rv32/RV32/Correct.lean +++ b/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 diff --git a/backend/rv32/RV32/Emit.lean b/backend/rv32/RV32/Emit.lean index 310fac53ba70abc6947de5e09c19dc2c40ee2d03..d8336e318228482e3c5ff2ac19571fc860e71747 100644 --- a/backend/rv32/RV32/Emit.lean +++ b/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. -/ diff --git a/backend/rv32/RV32/Guard.lean b/backend/rv32/RV32/Guard.lean index 8b96bc3918c61a3c780feccd77a3fdcf776ad6de..d109a75cf6740bc5bf054def9703b8c16f1a1781 100644 --- a/backend/rv32/RV32/Guard.lean +++ b/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) = diff --git a/backend/rv32/RV32/Init.lean b/backend/rv32/RV32/Init.lean index 6cca8f8238ec9a6c6668fb5c79c0f8e989e10c0f..5ae13fb0f200fd961e147d986adb68a28bd5f260 100644 --- a/backend/rv32/RV32/Init.lean +++ b/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 diff --git a/backend/rv32/RV32/Lower.lean b/backend/rv32/RV32/Lower.lean index 394ec875aeecaf1fa05ebc50cbf22c4059b66b52..b10ca905bbcc7ab4ef89207c7a3819ed2fd94fd3 100644 --- a/backend/rv32/RV32/Lower.lean +++ b/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 diff --git a/backend/rv32/RV32/Rel.lean b/backend/rv32/RV32/Rel.lean index 6c4558f97b347eeb23f7383b9d346510114f9993..a9deee606a7a2a1e056b853815d4e7ae697580b1 100644 --- a/backend/rv32/RV32/Rel.lean +++ b/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) diff --git a/backend/rv32/RV32/Run.lean b/backend/rv32/RV32/Run.lean index 36f0af6cfea434db4b8f6fa070defe969afa746e..3510cf08b2933ac3b8e409b4b77a4c5e81307865 100644 --- a/backend/rv32/RV32/Run.lean +++ b/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 diff --git a/backend/rv32/RV32/SimAux.lean b/backend/rv32/RV32/SimAux.lean index 2348472e520e6623f0d96d7a7056940bedbc979a..4baf90944d0a031eade637f934140196c89ad9a6 100644 --- a/backend/rv32/RV32/SimAux.lean +++ b/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 diff --git a/backend/rv32/RV32/SimBin.lean b/backend/rv32/RV32/SimBin.lean index 3e3375b0049cc366dbbe5774aaaece84d1ebd0bf..8f73c7cc458d88b1217cbbf58c24202f85aa5934 100644 --- a/backend/rv32/RV32/SimBin.lean +++ b/backend/rv32/RV32/SimBin.lean @@ -28,23 +28,23 @@ theorem scratch_ne (r : Reg) (h : r = t0 ∨ r = t1 ∨ r = t2 ∨ r = t3) : 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 = t0 ∨ rr = t1 ∨ rr = t2 ∨ rr = t3) (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 t1 s1 0, .load t0 s1 4] ++ mid ++ [.store s1 4 rr, .addImm s1 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 t1 (by simp) have hrax := scratch_ne t0 (by simp) -- load t1, [s1 + 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 t1 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 t0, [s1 + 4] have e1 := ld_stack hr2 (j := 1) (v := a) (by simp [hd]) t0 (disp := 4) (by simp) obtain ⟨x3, hx3⟩ : ∃ x3, x3 = x2.mov t0 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 t0 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 t0 = a := by simp [hx3, M.mov, M.setReg, M.adv] have hcx : x3.regs t1 = 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 s1 have hlen5 : 1 ≤ ({ s with dstack := s.dstack.set 1 (x4.regs rr) } : State 32).dstack.length := by diff --git a/backend/rv32/RV32/SimCtl.lean b/backend/rv32/RV32/SimCtl.lean index 452dfbb49bb2b18dba91b6a34b4ec126c74113db..1b704470fb99acf32bb3875ef66f4273b810fa23 100644 --- a/backend/rv32/RV32/SimCtl.lean +++ b/backend/rv32/RV32/SimCtl.lean @@ -14,19 +14,24 @@ namespace RV32 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 t0 Reg.s1 0, .addImm Reg.s1 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 t0 Reg.s1 0, .addImm Reg.s1 4, .bnez t0 (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 := t0) (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) (`s5`) and writes `ra`. -/ 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 s5 s4 (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 - ra (ofN (offs p a))).setReg s5 (ofN (c.sp0 - 4 * rs.length))) with pc := offs p a } := by + ra (ofN (offs c.facts p a))).setReg s5 (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 s5 = 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 s5 s4 (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 diff --git a/backend/rv32/RV32/SimDiv.lean b/backend/rv32/RV32/SimDiv.lean index a5b52e245045d8f39c056f1b1cc9e645dac8af36..83895281194bfe2efecc3b7ab44c1232dafb503c 100644 --- a/backend/rv32/RV32/SimDiv.lean +++ b/backend/rv32/RV32/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 t1 = 0#32) {t : Nat} /-- `div` and `sdiv` share their lowering shape: load both operands, trap on a zero divisor, divide into `t0`, store and pop. `g` is the RISC-V 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 t0 (g (m.regs t0) (m.regs t1)))) - (hfg : ∀ a b, b ≠ 0#32 → g a b = f a b) - (hat : RAt code base (uf L 2 base ++ [.load t1 Reg.s1 0, .load t0 Reg.s1 4, - .bnez t1 (base + ufSize 2 + 4), .exitTrap .divideByZero, i, .store Reg.s1 4 t0, + (hpc : x.pc = base) (i : Instr Nat) (gf f : W → W → W) + (hi : ∀ m : M, exec i m = .next (m.arith t0 (gf (m.regs t0) (m.regs t1)))) + (hfg : ∀ a b, b ≠ 0#32 → gf a b = f a b) + (hat : RAt code base (uf L (need g 2) base ++ [.load t1 Reg.s1 0, .load t0 Reg.s1 4, + .bnez t1 (base + ufSize (need g 2) + 4), .exitTrap .divideByZero, i, .store Reg.s1 4 t0, .addImm Reg.s1 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 := t1) (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 := t0) (by simp) (disp := 4) (by simp) (fetch_cast f1 (by omega)) have hcx3 : x3.regs t1 = b := by rw [ho3 t1 (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 t0 = a := by rw [hreg4, hv3] have hcx4 : x4.regs t1 = b := by rw [hreg4, hcx3] - let x5 := x4.arith t0 (g (x4.regs t0) (x4.regs t1)) + let x5 := x4.arith t0 (gf (x4.regs t0) (x4.regs t1)) 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 t0 (scratch_ne t0 (by simp)) _ have hax5 : x5.regs t0 = 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 t1 Reg.s1 0, .load t0 Reg.s1 4, - .bnez t1 (base + ufSize 2 + 4), .exitTrap .divideByZero] ++ rest))) + (hat : RAt code base (uf L (need g 2) base ++ ([.load t1 Reg.s1 0, .load t0 Reg.s1 4, + .bnez t1 (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 := t1) (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 t0 t0 t1) 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 t0 t0 t1, .store Reg.s1 4 t0, .addImm Reg.s1 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 t0 t0 t1) 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 t0 t0 t1, .store Reg.s1 4 t0, .addImm Reg.s1 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 t1 Reg.s1 0, .load t0 Reg.s1 4, - .load t3 Reg.s1 8, .beqz t1 (base + ufSize 3 + 5), .movRR t0 t3, .store Reg.s1 8 t0, + x'.pc = base + isize g (.select : WordDialect.Instr 32) := by + have hat' : RAt code base (uf L (need g 3) base ++ [.load t1 Reg.s1 0, .load t0 Reg.s1 4, + .load t3 Reg.s1 8, .beqz t1 (base + ufSize (need g 3) + 5), .movRR t0 t3, .store Reg.s1 8 t0, .addImm Reg.s1 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 := t1) (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 := t3) (by simp) (disp := 8) (by simp) (fetch_cast f2 (by omega)) have hcx4 : x4.regs t1 = cc := by rw [ho4 t1 (by decide), ho3 t1 (by decide), hv2] have hax4 : x4.regs t0 = y := by rw [ho4 t0 (by decide), hv3] - -- after the branch (and the `mv` when `cc ≠ 0`), `t0` holds the result at `base + 3 + 5` + -- after the branch (and the `mv` when `cc ≠ 0`), `t0` 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 t0 = (if Word.isTrue cc then v else y) := by + x6.pc = base + ufSize (need g 3) + 5 ∧ x6.regs t0 = (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`: `t2 := 1`, then `bcc c` skips `t2 := 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 t1 Reg.s1 0, .load t0 Reg.s1 4, - .movImm t2 1#32, .bcc cd t0 t1 (base + ufSize 2 + 5), .movImm t2 0#32, .store Reg.s1 4 t2, + x'.pc = base + isize g (.cmp cd : WordDialect.Instr 32) := by + have hat' : RAt code base (uf L (need g 2) base ++ [.load t1 Reg.s1 0, .load t0 Reg.s1 4, + .movImm t2 1#32, .bcc cd t0 t1 (base + ufSize (need g 2) + 5), .movImm t2 0#32, .store Reg.s1 4 t2, .addImm Reg.s1 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 := t1) (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 t0 = a := by rw [ho4 t0 (by decide), hv3] have hcx4 : x4.regs t1 = b := by rw [ho4 t1 (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 t2 = Word.ofBool (cd.eval a b) := by + x6.pc = base + ufSize (need g 2) + 5 ∧ x6.regs t2 = 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 diff --git a/backend/rv32/RV32/SimMemOps.lean b/backend/rv32/RV32/SimMemOps.lean index 2b08aa0362ebd58b78e03d506244bec27fa5f91e..e11e827831de1fa5a4d83f69ffe15f93e4b7e73b 100644 --- a/backend/rv32/RV32/SimMemOps.lean +++ b/backend/rv32/RV32/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 = t1 ∨ rt = t2) {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 t0 (s.regs r)) := by rw [rstep_of_fetch (by rw [hpc0]; exact f0), ld_reg hr0 hr t0 rfl] have hr1 : Rel0 c p s (x0.mov t0 (s.regs r)) := mov_rel0 hr0 t0 (scratch_ne t0 (by simp)) _ - have hpc1 : (x0.mov t0 (s.regs r)).pc = base + 3 + 1 := by simp [M.mov, M.setReg, M.adv, hpc0] + have hpc1 : (x0.mov t0 (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 t0 (by decide) hfit ⟨fetch_cast f1 (by omega), fetch_cast f2 (by omega), trivial⟩ have hv : (x0.mov t0 (s.regs r)).regs t0 = 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 t0 Reg.s1 0, .addImm Reg.s1 4, + x'.pc = base + isize g (.pop r : WordDialect.Instr 32) := by + have hat' : RAt code base (uf L (need g 1) base ++ [.load t0 Reg.s1 0, .addImm Reg.s1 4, .store Reg.s2 (4 * (r : Int)) t0]) := 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 := t0) (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 t0 Reg.s1 0, .movImm t1 (BitVec.ofNat 32 L.memSize), - .bcc .ult t0 t1 (base + ufSize 1 + 4), .exitTrap .badAddress, .shlImm t0 2, .add t0 Reg.s3, + x'.pc = base + isize g (.load : WordDialect.Instr 32) := by + have hat' : RAt code base (uf L (need g 1) base ++ [.load t0 Reg.s1 0, .movImm t1 (BitVec.ofNat 32 L.memSize), + .bcc .ult t0 t1 (base + ufSize (need g 1) + 4), .exitTrap .badAddress, .shlImm t0 2, .add t0 Reg.s3, .load t0 t0 0, .store Reg.s1 0 t0]) := 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 := t0) (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 := t1) (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 t0 Reg.s1 0, .movImm t1 (BitVec.ofNat 32 L.memSize), - .bcc .ult t0 t1 (base + ufSize 1 + 4), .exitTrap .badAddress, .shlImm t0 2, .add t0 Reg.s3, + have hat' : RAt code base (uf L (need g 1) base ++ [.load t0 Reg.s1 0, .movImm t1 (BitVec.ofNat 32 L.memSize), + .bcc .ult t0 t1 (base + ufSize (need g 1) + 4), .exitTrap .badAddress, .shlImm t0 2, .add t0 Reg.s3, .load t0 t0 0, .store Reg.s1 0 t0]) := 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 := t0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega)) exact RExec.of_steps (hs1.trans hs2) (addr_trap (code := code) hr2 (rt := t1) (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 t0 Reg.s1 0, .load t1 Reg.s1 4, - .movImm t2 (BitVec.ofNat 32 L.memSize), .bcc .ult t0 t2 (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 t0 Reg.s1 0, .load t1 Reg.s1 4, + .movImm t2 (BitVec.ofNat 32 L.memSize), .bcc .ult t0 t2 (base + ufSize (need g 2) + 5), .exitTrap .badAddress, .shlImm t0 2, .add t0 Reg.s3, .store t0 0 t1, .addImm Reg.s1 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 := t0) (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 := t1) (by simp) (disp := 4) (by simp) (fetch_cast f1 (by omega)) have hax3 : x3.regs t0 = a := by rw [ho3 t0 (by decide), hv2] obtain ⟨x4, hs4, hr4, hpc4, hax4, ho4, hm4⟩ := addr_pass (code := code) hr3 (rt := t2) (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 t1 = v := by rw [ho4 t1 (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 t0 Reg.s1 0, .load t1 Reg.s1 4, - .movImm t2 (BitVec.ofNat 32 L.memSize), .bcc .ult t0 t2 (base + ufSize 2 + 5), + have hat' : RAt code base (uf L (need g 2) base ++ [.load t0 Reg.s1 0, .load t1 Reg.s1 4, + .movImm t2 (BitVec.ofNat 32 L.memSize), .bcc .ult t0 t2 (base + ufSize (need g 2) + 5), .exitTrap .badAddress, .shlImm t0 2, .add t0 Reg.s3, .store t0 0 t1, .addImm Reg.s1 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 := t0) (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 := t1) (by simp) (disp := 4) (by simp) (fetch_cast f1 (by omega)) have hax3 : x3.regs t0 = a := by rw [ho3 t0 (by decide), hv2] exact RExec.of_steps ((hs1.trans hs2).trans hs3) (addr_trap (code := code) hr3 (rt := t2) - (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⟩)) diff --git a/backend/rv32/RV32/SimOps.lean b/backend/rv32/RV32/SimOps.lean index b3ca7bfc3c0825aab23700419ba4df752332619b..2406779df9ccf5dddcae1f36f39302fe7f023e84 100644 --- a/backend/rv32/RV32/SimOps.lean +++ b/backend/rv32/RV32/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 = t0 ∨ rr = t1 ∨ rr = t2 ∨ rr = t3) (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 t1 s1 0, .load t0 s1 4] ++ mid ++ [.store s1 4 rr, .addImm s1 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 -/ @@ -160,87 +160,87 @@ theorem midspec_rotr : 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 t0 t1] t0 (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 t0 t1] t0 (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 t0 t1] t0 (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 t0 t1] t0 (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 t0 t1] t0 (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 t0 t1] t0 (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 _ t0 (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 _ t0 (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 _ t0 (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 _ t0 (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 diff --git a/backend/rv32/RV32/SimStack.lean b/backend/rv32/RV32/SimStack.lean index 273e9a6bde35e020df17eeb1731bb1be9bc18dff..c7b85fbdc7f55dabe261fefb839ac4909234af5b 100644 --- a/backend/rv32/RV32/SimStack.lean +++ b/backend/rv32/RV32/SimStack.lean @@ -64,51 +64,53 @@ theorem not_step (hs : Rel0 c p s x) (hf : code[x.pc]? = some (.not t0)) : 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 t0 Reg.s1 0, .not t0, .store Reg.s1 0 t0]) := hat + x'.pc = base + isize g (.not : WordDialect.Instr 32) := by + have hat' : RAt code base (uf L (need g 1) base ++ [.load t0 Reg.s1 0, .not t0, .store Reg.s1 0 t0]) := 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 := t0) (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 := t0) (disp := 0) (by simp) (fetch_cast f2 (by omega)) have e : s.dstack.set 0 (x3.regs t0) = (~~~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 := t0) (by simp) (disp := 0) (by simp) (fetch_cast f0 (by omega)) obtain ⟨x3, hs3, hr3, hpc3, _⟩ := push_pair hg hr2 t0 (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.s1 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.s1 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 := t0) (by simp) (v := w) (by rw [hpc0]; exact f0) obtain ⟨x2, hs2, hr2, hpc2, _⟩ := push_pair hg hr1 t0 (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 t0 Reg.s1 0, .load t1 Reg.s1 4, + x'.pc = base + isize g (.swap : WordDialect.Instr 32) := by + have hat' : RAt code base (uf L (need g 2) base ++ [.load t0 Reg.s1 0, .load t1 Reg.s1 4, .store Reg.s1 0 t1, .store Reg.s1 4 t0]) := 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 := t0) (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 t1)).set 1 (x4.regs t0) = 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 := t0) (by simp) (disp := 4) (by simp) (fetch_cast f0 (by omega)) obtain ⟨x3, hs3, hr3, hpc3, _⟩ := push_pair hg hr2 t0 (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 t0 Reg.s1 0, .load t1 Reg.s1 4, + x'.pc = base + isize g (.rot : WordDialect.Instr 32) := by + have hat' : RAt code base (uf L (need g 3) base ++ [.load t0 Reg.s1 0, .load t1 Reg.s1 4, .load t2 Reg.s1 8, .store Reg.s1 0 t2, .store Reg.s1 4 t0, .store Reg.s1 8 t1]) := 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 := t0) (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 diff --git a/backend/rv32/RV32/SimStep.lean b/backend/rv32/RV32/SimStep.lean index 69a5907f6e896a6badabdf07ebb74837f39cb736..6823417ad92ede5a4ad22fd72b552915d589f143 100644 --- a/backend/rv32/RV32/SimStep.lean +++ b/backend/rv32/RV32/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] diff --git a/backend/rv32/RV32Main.lean b/backend/rv32/RV32Main.lean index e67612837990c07a66c47b0c08f9cac5e7b17139..3130cc4ef22f70d876e12716e02319cf806810ee 100644 --- a/backend/rv32/RV32Main.lean +++ b/backend/rv32/RV32Main.lean @@ -21,7 +21,8 @@ and Forth source files compiled at width 32. `check` also runs the hand-written programs of `RV32.DataOps`. Usage: `rv32c check [fuzzCount]`, `rv32c emit `, `rv32c forth [memWords]`, -`rv32c emit-forth [memWords]`. +`rv32c emit-forth [memWords]`, `rv32c stats [memWords]` (the guards the depth +certificates leave out); `--no-opt` with any of them lowers with every guard. -/ open WordDialect @@ -38,12 +39,23 @@ def rBase : Nat := 0x80300000 def rcap : Nat := 4096 def rEnd : Nat := rBase + 4 * rcap -def runtimeFor (s : Sample32) : RV32.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 := - RV32.Emit.program (runtimeFor s) (RV32.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) : RV32.Emit.Runtime := + let r : RV32.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 + RV32.Emit.program r (RV32.lowerProg r.layout s.prog) /-- Code from `0x80000000` (where the `virt` board starts with `-bios none`), then data; the stacks are uninitialised sections at fixed addresses. -/ @@ -80,8 +92,8 @@ def runAsm (name asm : String) : IO (Except String (String × UInt32)) := do | 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 +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) @@ -157,27 +169,40 @@ 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: rv32c forth [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: rv32c emit-forth [memWords]"; return 2 + | none => IO.eprintln "usage: rv32c emit-forth [memWords] | rv32c stats [memWords] (any command: --no-opt keeps every guard)"; return 2 | some m => 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 + | "stats" :: path :: rest => + match parseMem rest with + | none => IO.eprintln "usage: rv32c stats [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: rv32c check [fuzzCount] | rv32c emit | rv32c forth [memWords] | rv32c emit-forth [memWords]"; return 2 + return (if ok && okc && isa then 0 else 1) + | _ => IO.eprintln "usage: rv32c check [fuzzCount] | rv32c emit | rv32c forth [memWords] | rv32c emit-forth [memWords] | rv32c stats [memWords] (any command: --no-opt keeps every guard)"; return 2 diff --git a/docs/GAME_PLAN.md b/docs/GAME_PLAN.md index 9dafc5977f3ad16f377edd3e5660969053dd7791..0169a3353939aabd028c4353723044fa6b8fd8b6 100644 --- a/docs/GAME_PLAN.md +++ b/docs/GAME_PLAN.md @@ -129,7 +129,7 @@ flowchart TB | 3 | Forth and BCPL translation | Tests whether distinct programming models share the IR correctly | Done and proved, plus Wolfram expressions and matrices | | 4 | Differential test harness | Detects mismatches between translation and execution | Done: `wordc check`, `wasmw check`, `a64c check`, `rv64c check`, `rv32c check`, `cmc check`, `cm0c check`, Forth example files | | 5 | One target emitter | Demonstrates that the IR can reach real hardware | Done: seven (x86-64, AArch64, RISC-V at 64 and 32 bits, Cortex-M3, Cortex-M0, and WebAssembly), proved against their models | -| 6 | Verified optimizations | Establishes that performance improvements preserve behavior | Not started | +| 6 | Verified optimizations | Establishes that performance improvements preserve behavior | Started: underflow- and overflow-guard elimination from checked stack-depth certificates on the three microcontroller targets (RV32, Cortex-M3, Cortex-M0), code up to 72% smaller | | 7 | Matrix and GPU extensions | Expands into numerical computing and acceleration | Integer matrices done; GPU not started | ## Next phase: close out the Lean work, then port @@ -169,7 +169,7 @@ Porting: profile (`CM.Emit.binary_correct`). Flags are not model state: every flag-setting instruction sits inside one fixed sequence with its reader. Rotations use `ror`; register shifts follow ARM's bottom-byte rule, and division by zero gives zero. The image starts from the Cortex-M - vector table, prints through a UART and stops through semihosting; `cmc` runs it on an + vector table, prints through a UART and ends the run there; `cmc` runs it on an emulated Cortex-M3 microcontroller through the shared 32-bit harness (`Harness32`). CI runs it. * **Booting from flash (Cortex-M): done.** The image keeps its vector table and code in flash, and the reset handler copies `.data` to SRAM with a loop printed from the model and proved @@ -184,8 +184,28 @@ Porting: `BitVec.sdiv` (`CM0/Divide.lean`). The return stack is `sp` (`push {lr}`, `pop {pc}`) and every branch is a `bl`. `cm0c` runs it from flash on an emulated BBC micro:bit (`qemu-system-arm -M microbit`). CI runs it. -* Next candidates: the same flash boot for the RV32 profile, and verified optimizations (build - order item 6). +* **Verified optimization, first step: done.** `formal/WordDialect/Depth.lean` defines stack-depth + certificates, a local check `certOk`, and proves that a checked certificate holds at every + reachable state. The Cortex-M0 lowering leaves out each underflow guard the certificate makes + redundant, and its end-to-end theorems (`binary_correct`, `boot_correct`) take `certOk` as one + more hypothesis. The analysis that proposes certificates is untrusted. `cm0c` images are about a + third smaller (`double.fs`: 40408 → 24616 bytes of code). +* **Overflow-guard elimination: done.** `Depth.lean` adds upper bounds (`Bound`, checked by + `boundOk` against the target's stack capacity, kept by `BoundInv.step`). The Cortex-M0 lowering + also leaves out each data-stack overflow guard where the bound shows room, with `boundOk` as + one more hypothesis of `binary_correct` and `boot_correct`. With both certificates `double.fs` + goes from 40408 to 11488 bytes of code (72% smaller). +* **Per-word stack effects: done.** Frame certificates (`Frames`, `frameOk`, `FrameInv.step`) + bound the depth relative to the entry of the current word, with each word's net effect, so a + recursive word no longer saturates the bounds of its callers. The backends take any upper bound + backed by an invariant (`UbSound`); `upperTable` combines both kinds. Across the ten Forth + examples, 2 of 947 data-stack overflow guards remain, both inside recursive words that grow + the stack. +* **Guard elimination on RV32 and Cortex-M3: done.** Both profiles take the same `Facts`-driven + lowering and the same hypotheses (`certOk`, `UbSound`); `double.fs` shrinks by 60% on the + Cortex-M3 and 56% on RV32. +* Next candidates: the certificates for the 64-bit backends (x86-64, AArch64, RISC-V) and + WebAssembly, auxiliary- and return-stack bounds, and the same flash boot for the RV32 profile. ## The strategic opportunity diff --git a/docs/HARDWARE.md b/docs/HARDWARE.md new file mode 100644 index 0000000000000000000000000000000000000000..6bf5b69f45b7a6084ef4de8bfa81156007893155 --- /dev/null +++ b/docs/HARDWARE.md @@ -0,0 +1,158 @@ +# Running on real boards + +The Cortex-M3 (`cmc`) and Cortex-M0 (`cm0c`) profiles build images that run on bare boards with +no operating system and no debugger. A run prints its result on the board's serial port and +ends with a line `EXIT` and the status; `verify` compares what the board printed with what the +Lean semantics says the program must compute. + +> **Status.** The board set-up below follows the vendors' documentation and is exercised in CI +> only on QEMU's models of these boards, which ignore clocks, pin multiplexing and baud rates. +> It has not yet been run on physical boards. The first runs on real hardware are the test of +> that part; report what you see (a log that `verify` rejects, or no output at all) as an issue. + +## What the image does + +1. The core reads the initial stack pointer and reset vector from the vector table in flash. +2. The reset handler copies `.data` (IR memory and the register file) from flash to RAM, sets up + the runtime registers and runs the program. Both steps are proved (`CM/Boot.lean`, + `CM0/Boot.lean`, `boot_correct`). +3. When the program halts, or traps, the runtime sets up the clock and the UART, prints the + result, and sleeps (`wfi`) for good: + + ``` + 00000001 depth of the data stack + 00000262 the data stack, top first (610 = fib 15) + 00000000 … IR memory, then the virtual registers + EXIT + 00000000 status: 0 halt, 1 stack underflow, 2 bad address, 3 divide by zero, + 4 bad pc, 5 return underflow, 6 a target stack is full + ``` + + The status is also left in RAM at the symbol `exitblk` (status, then the marker `0xe0d0f1a1`) + for a debugger that wants it. + +Serial settings: **115200 baud, 8 data bits, no parity, 1 stop bit (8N1), no flow control.** + +## Build an image + +`image` needs `clang`, `ld.lld` and `llvm-objcopy` on the path (on Debian or Ubuntu: +`apt-get install clang lld llvm`). + +```sh +lake build +cd /tmp +/path/to/ai-free/.lake/build/bin/cm0c image /path/to/ai-free/examples/forth/fib.fs +# fib-microbit-v1.elf, fib-microbit-v1.hex, fib-microbit-v1.expected +/path/to/ai-free/.lake/build/bin/cm0c image /path/to/ai-free/examples/forth/fib.fs --board microbit-v2 +/path/to/ai-free/.lake/build/bin/cmc image /path/to/ai-free/examples/forth/fib.fs +# fib.elf, fib.hex, fib.expected +``` + +`.expected` is the exact serial output of a correct run. An optional last argument gives the +number of IR memory words (default 16), as for `forth`. + +## BBC micro:bit (`cm0c`) + +| | V1 (nRF51822, Cortex-M0) | V2 (nRF52833, Cortex-M4F) | +| --- | --- | --- | +| image | `cm0c image prog.fs` | `cm0c image prog.fs --board microbit-v2` | +| UART pins | TX P0.24, RX P0.25 | TX P0.06, RX P1.08 | +| memory used | 256 KiB flash, 16 KiB RAM (all of it fits in 16 KiB) | the same layout; the V2 has more of both | + +The V2's Cortex-M4F runs ARMv6-M code unchanged; only the UART pins differ. The emulator models +only the V1. + +1. Connect the micro:bit by USB. It appears as a drive called `MICROBIT` and as a serial port + (Linux `/dev/ttyACM0`, macOS `/dev/cu.usbmodem…`, Windows `COMn`); the board's interface + chip connects that serial port to the UART pins above. +2. Start capturing the serial port before flashing, so the output is not missed: + + ```sh + stty -F /dev/ttyACM0 115200 raw -echo # Linux; on macOS: stty -f /dev/cu.usbmodem… 115200 + cat /dev/ttyACM0 | tee serial.log + ``` + + (`screen /dev/ttyACM0 115200`, `minicom` or `picocom -b 115200` work too; save the log.) +3. Copy the `.hex` file onto the `MICROBIT` drive. The board flashes it and resets; the + program runs and the result appears on the serial port. Press the reset button to run it + again. +4. Check the log: + + ```sh + cm0c verify /path/to/ai-free/examples/forth/fib.fs serial.log + ``` + + `verify` ignores carriage returns and anything before the first result line, so a log from + a terminal program can be used as it is. + +## Microchip SAM D21 Curiosity Nano (`cm0c --board samd21-cnano`) + +Microchip's SAM D21 Curiosity Nano (DM320119) carries an `ATSAMD21G17D`, a Cortex-M0+ with +128 KiB of flash and 16 KiB of SRAM, and an on-board debugger (nEDBG) that programs it and +provides a virtual COM port over the same USB cable. The Cortex-M0+ runs `cm0c`'s ARMv6-M code +unchanged, with the same memory layout as the micro:bit; only the start-up, output and end of +run differ (`CM0.Emit`: `uartInitSamd21`, `putcSamd21`, `finishSamd21`, with the register +addresses and fields of the SAM D21/DA1 data sheet, DS40001882G): + +| | | +| --- | --- | +| image | `cm0c image prog.fs --board samd21-cnano` | +| clock | the internal 8 MHz oscillator, undivided (the board's 32 kHz crystal is not connected by default) | +| serial | SERCOM5 as a USART, TX PA22 (pad 0), RX PB22 (pad 2): the debugger's virtual COM port, 115200 8N1 | +| result LED | the yellow LED0 (PB10) lights when the run halts with status 0 | +| run again | press SW0 (PB11): the chip resets and runs the program again, printing a fresh transcript | + +The debugger does not offer a drag-and-drop drive on this board (its user guide, DS70005409D, +section 3.1.2), and it only forwards serial data while a terminal has the port open (DTR set), so: + +1. Connect the board by USB. The virtual COM port appears as `/dev/ttyACM0` (Linux), + `/dev/cu.usbmodem…` (macOS) or `COMn` (Windows). +2. Open the port at 115200 8N1 and start saving the log (as for the micro:bit above). +3. Program the `.hex` with **MPLAB X IPE** (free from Microchip): select the device + `ATSAMD21G17D` and the board's debugger as the tool, connect, load + `prog-samd21-cnano.hex`, and program. (Any CMSIS-DAP programmer for SAM D21 works too, for + example OpenOCD with `interface/cmsis-dap.cfg` and `target/at91samdXX.cfg`.) +4. The program runs after programming. If the terminal was not yet open, press SW0 to run it + again; the LED shows the result at a glance. +5. `cm0c verify /path/to/ai-free/examples/forth/fib.fs serial.log`. + +This board is not emulated, so its start-up code is checked here only by building and +disassembling the image; the first runs on the board are its test. If nothing appears on the +serial port, check that the terminal opened the right port (DTR set) and press SW0; if the LED +lights but the log is garbled, the serial settings or the clock are the suspects. + +## Stellaris EK-LM3S6965 (`cmc`) + +The image runs from the LM3S6965's 256 KiB flash and 64 KiB SRAM. The runtime switches the system +clock to the board's 8 MHz crystal and drives UART0 on PA0/PA1, which the board's FTDI chip +connects to its USB serial port (the second of the two ports it creates). + +1. Flash it, with OpenOCD: + + ```sh + openocd -f board/ek-lm3s6965.cfg -c "program fib.elf verify reset exit" + ``` + + or with TI's `lm4flash fib.bin` (make the `.bin` with `llvm-objcopy -O binary fib.elf fib.bin`). +2. Capture the serial port at 115200 8N1 (as above, typically `/dev/ttyUSB1`) and press reset. +3. `cmc verify /path/to/ai-free/examples/forth/fib.fs serial.log`. + +On another LM3S part or crystal, change `clockHz` in `CM.Emit.Runtime` (the UART divisor is +computed from it). + +## Automating it + +`scripts/hil/run-board.sh` does the steps above in one command (build, open the port, program +with OpenOCD, capture, verify), and `scripts/hil/run-all.sh` runs every example; with a Linux +machine and boards attached they run as a CI job. See [HIL.md](HIL.md). + +## What a mismatch means + +* **No output at all.** The board set-up is wrong for this board: clock, pins, or the serial + settings on the host. This is the part not yet checked on silicon. +* **Garbled characters.** The baud rate is off: the clock the runtime assumes is not the one + the board runs at. +* **`verify` reports different values.** The board computed something other than the Lean + semantics. The compiled code is proved correct against the instruction-set model, so a + difference means the model and the silicon disagree (or the toolchain mis-assembled): please + report it with the `.elf`, the log and `cm0c emit-forth`/`cmc emit-forth` output. diff --git a/docs/HIL.md b/docs/HIL.md new file mode 100644 index 0000000000000000000000000000000000000000..e8f48c0dbd31c5bb5ffb7f09acba8b65b6cefab4 --- /dev/null +++ b/docs/HIL.md @@ -0,0 +1,89 @@ +# Hardware in the loop + +`scripts/hil/` runs the Forth examples on real boards and checks each board's serial output +against the Lean semantics, the same comparison `cm0c verify` makes for a log captured by hand +(`docs/HARDWARE.md`). With a small Linux machine and boards attached it becomes a CI job +(`.github/workflows/hardware.yml`), so every change to `master` is checked on real chips, not +only on emulators. + +> **Status.** The scripts are tested against a simulated board (a pseudo-terminal fed with the +> expected transcript, a corrupted one, and line noise). The OpenOCD target settings for the +> SAM D21 Curiosity Nano's debugger and the board's start-up code have not yet run on a real +> board; the first run on the rig is that test. + +## What it does + +`scripts/hil/run-board.sh `: + +1. builds the image with `cm0c image … --board `; +2. opens the serial port first (`capture.py`): the Curiosity Nano's debugger only forwards serial + data while the port is open; +3. programs the board with OpenOCD over CMSIS-DAP (`program … verify reset exit`), which resets it, + so the program runs; +4. reads until the `EXIT` line and the status (keeping only printable ASCII, so glitch bytes as the + UART comes up do no harm), then runs `cm0c verify`. + +It exits 0 when the board's output matches Lean. `scripts/hil/run-all.sh ` runs +every file in `examples/forth/` and prints a `PASS`/`FAIL` line for each. + +Boards: `samd21-cnano` (Microchip SAM D21 Curiosity Nano) and `microbit-v1`. + +## The rig + +- A small Linux machine (any x86-64 or 64-bit Arm box running Ubuntu or Debian). +- A powered USB hub. +- One or more SAM D21 Curiosity Nano boards (DM320119), each on its own USB cable. + +## Setting it up + +1. Install the tools: + + ```sh + sudo apt-get install clang lld llvm openocd python3 git curl + curl -sSfL https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh | sh -s -- -y --default-toolchain none + ``` + +2. Give your user access to the serial ports and the debugger, then log out and in again: + + ```sh + sudo usermod -aG dialout,plugdev "$USER" + ``` + + (The `openocd` package installs udev rules for CMSIS-DAP debuggers; if OpenOCD reports a + permission error, check `/usr/lib/udev/rules.d/60-openocd.rules`.) + +3. Find each board's serial port by its stable name: + + ```sh + ls -l /dev/serial/by-id/ + ``` + +4. Run one program by hand first: + + ```sh + git clone https://github.com/snapkittyagent9nova/ai-free.git && cd ai-free + lake build cm0c + scripts/hil/run-board.sh samd21-cnano examples/forth/fib.fs /dev/serial/by-id/ + ``` + + A `PASS fib …` line means the board ran the verified code and printed exactly what Lean + predicts; the yellow LED is lit. With `HIL_KEEP=/tmp/hil` the image, serial log and OpenOCD + log are kept for inspection. With several boards attached, set `HIL_ADAPTER_SERIAL` to the + debugger's USB serial number (OpenOCD prints the serial numbers it finds). + +5. Register the machine as a self-hosted GitHub Actions runner for the repository + (repository Settings → Actions → Runners → New self-hosted runner, and follow the steps there), + with the extra label `samd21`. Then set the repository variable `SAMD21_TTY` (Settings → + Secrets and variables → Actions → Variables) to the board's `/dev/serial/by-id/…` path, and, + with several boards, `SAMD21_ADAPTER_SERIAL`. + +6. Run the `hardware` workflow from the Actions tab. Once it passes, make it run on every push to + `master` too: add `push: { branches: [master] }` under `on:` in + `.github/workflows/hardware.yml` (the file says where). + +## Security + +A self-hosted runner executes whatever the workflow tells it to on the machine. The workflow +therefore runs only on demand (and, once enabled, on pushes to `master`), never on pull requests (where anyone +could change the workflow). Keep it that way, use a machine that holds nothing else of value, and +keep the repository's Actions settings requiring approval for workflows from outside contributors. diff --git a/formal/WordDialect.lean b/formal/WordDialect.lean index 57b47d8aa44d11647fd6295ab6dda79269ccc6d0..fe258140a8d44b3b0de3bc6972fb8672a1cf4148 100644 --- a/formal/WordDialect.lean +++ b/formal/WordDialect.lean @@ -6,3 +6,4 @@ import WordDialect.Invariants import WordDialect.Exec import WordDialect.Rules import WordDialect.Init +import WordDialect.Depth diff --git a/formal/WordDialect/Depth.lean b/formal/WordDialect/Depth.lean new file mode 100644 index 0000000000000000000000000000000000000000..27f778484ae58441c3e35711180ab9e441124dc7 --- /dev/null +++ b/formal/WordDialect/Depth.lean @@ -0,0 +1,656 @@ +import WordDialect.Exec +import WordDialect.Invariants +import WordDialect.Init + +/-! +# WordDialect.Depth + +A verified stack-depth analysis: the basis of the first verified optimisation. + +Every backend guards each instruction that pops with an operand-count check, because the IR traps +`stackUnderflow` when the data stack is too short. Most of those checks can never fail: after +`5 7`, an `add` always has its two operands. A *depth certificate* `c : Nat → Nat` claims a lower +bound `c k` on the data-stack depth whenever control is at instruction `k`. A backend may drop the +guard of an instruction that pops at most `c k` words. + +The certificate comes from an untrusted analysis (`analyse`) and is checked by a decidable +`certOk`, which is proved sound (`DepthInv.step`): from a state where the bounds hold, one step +leads to a state where they hold again. They hold at the start (`DepthInv.init`), so they hold in +every reachable state (`DepthInv.steps`). `safeCert` is `analyse`'s result when it checks, and the +trivial certificate `0` (which always checks, and drops no guard) when it does not; so the +analysis can only make code smaller, never wrong. + +The rules `certOk` checks, for each instruction `i` at `k` with operand count `pops i` (`WordDialect.Stack`): +* each successor `t` of `i` (where control goes when `i` does not trap) gets + `c t ≤ c k - pops i + pushes i`, the depth `i` leaves (with natural-number subtraction, which + stays sound when `c k < pops i`: then the actual depth is at least `pops i`); +* the instruction after a `call` gets `c (k + 1) = 0`: control returns there from anywhere; +* `c 0 = 0`: the program starts with an empty stack. +-/ + +namespace WordDialect + +variable {n : Nat} + +/-- Where control can go next from instruction `i` at `k` without a trap (`ret` goes to a return +address, covered by the rule for `call`; `halt` stops). -/ +def Instr.succs (k : Nat) : Instr n → List Nat + | .jmp t => [t] + | .branch t => [k + 1, t] + | .call t => [t] + | .ret | .halt => [] + | _ => [k + 1] + +/-- The checker. -/ +def certOk (p : Prog n) (c : Nat → Nat) : Bool := + c 0 == 0 && + p.zipIdx.all fun (i, k) => + (i.succs k).all (fun t => decide (c t ≤ c k - i.pops + i.pushes)) && + (match i with | .call _ => c (k + 1) == 0 | _ => true) + +/-- The bounds hold in state `s`: the depth at the current instruction, and `0` at every return +address on the return stack (where control can come back with any depth). -/ +structure DepthInv (c : Nat → Nat) (s : State n) : Prop where + depth : c s.pc ≤ s.dstack.length + rets : ∀ a ∈ s.rstack, c a = 0 + +theorem certOk_at {p : Prog n} {c : Nat → Nat} (h : certOk p c = true) {k : Nat} {i : Instr n} + (hk : p[k]? = some i) : + (∀ t ∈ i.succs k, c t ≤ c k - i.pops + i.pushes) ∧ + (∀ t, i = .call t → c (k + 1) = 0) := by + simp only [certOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true, decide_eq_true_eq] at h + have hmem : (i, k) ∈ p.zipIdx := by + rw [List.mem_zipIdx_iff_getElem?]; simpa using hk + obtain ⟨hs, hc⟩ := h.2 _ hmem + refine ⟨hs, ?_⟩ + rintro t rfl + simpa using hc + +theorem DepthInv.init {c : Nat → Nat} (h : c 0 = 0) (mem : Memory n) : + DepthInv c (State.init mem) where + depth := by simp [State.init, h] + rets := by simp [State.init] + +/-- Where control goes when an instruction continues: to one of its successors with the return +stack unchanged, or (`call`) to its target with the return address pushed, or (`ret`) to the +return address it pops. -/ +theorem exec_flow (i : Instr n) (s s' : State n) (h : exec i s = .next s') : + (s'.pc ∈ i.succs s.pc ∧ s'.rstack = s.rstack) ∨ + (∃ t, i = .call t ∧ s'.pc = t ∧ s'.rstack = (s.pc + 1) :: s.rstack) ∨ + (i = .ret ∧ s.rstack = s'.pc :: s'.rstack) := by + obtain ⟨pc, d, rs, as, regs, mem⟩ := s + cases i <;> rcases d with _ | ⟨x, _ | ⟨y, _ | ⟨z, d⟩⟩⟩ <;> + simp only [exec, State.fall] at h <;> + (try split at h) <;> (try split at h) <;> (try cases h) <;> + simp_all [Instr.succs] + +/-- **Soundness of the checker:** one step keeps the bounds. -/ +theorem DepthInv.step {p : Prog n} {c : Nat → Nat} (hok : certOk p c = true) {s s' : State n} + (hi : DepthInv c s) (h : WordDialect.step p s = .next s') : DepthInv c s' := by + unfold WordDialect.step at h + split at h + · cases h + · rename_i i hk + obtain ⟨hsucc, hcall⟩ := certOk_at hok hk + have hdep := exec_depth i s s' h + have hpops : i.pops ≤ s.dstack.length := by + rcases Nat.lt_or_ge s.dstack.length i.pops with hlt | hge + · rw [exec_underflow i s hlt] at h; cases h + · exact hge + have hd := hi.depth + rcases exec_flow i s s' h with ⟨hpc, hrs⟩ | ⟨t, rfl, hpc, hrs⟩ | ⟨rfl, hrs⟩ + · refine ⟨?_, by rw [hrs]; exact hi.rets⟩ + have := hsucc _ hpc + omega + · refine ⟨?_, ?_⟩ + · have := hsucc t (by simp [Instr.succs]) + simp only [Instr.pops, Instr.pushes] at this hdep + rw [hpc]; omega + · rw [hrs]; intro a ha + simp only [List.mem_cons] at ha + rcases ha with rfl | ha + · exact hcall t rfl + · exact hi.rets a ha + · refine ⟨?_, ?_⟩ + · rw [hi.rets _ (by rw [hrs]; simp)]; exact Nat.zero_le _ + · intro a ha; exact hi.rets a (by rw [hrs]; simp [ha]) + +/-- The bounds hold in every state reachable from one where they hold. -/ +theorem DepthInv.steps {p : Prog n} {c : Nat → Nat} (hok : certOk p c = true) {s s' : State n} + (hi : DepthInv c s) (h : Steps p s s') : DepthInv c s' := by + induction h with + | refl => exact hi + | cons hs _ ih => exact ih (DepthInv.step hok hi hs) + +/-! ## The analysis (untrusted) -/ + +/-- A fixpoint iteration for the least depth at each instruction: start from "unreached", give +the entry, every return point and every instruction unreachable from those depth `0`, and propagate each instruction's depth effect to +its successors until nothing changes (or the iteration budget runs out). Not trusted: its result +is used only when `certOk` accepts it. -/ +def analyse (p : Prog n) : Array Nat := Id.run do + let len := p.length + let unreached := len * 3 + 1000000 + -- Reachability from the entry and the return points. An instruction nothing reaches is given + -- depth `0` and propagated from like the entry, so its successors' entries stay consistent. + let mut live : Array Bool := Array.replicate (len + 1) false + let mut work : List Nat := [0] + for (i, k) in p.zipIdx do + if let .call _ := i then work := (k + 1) :: work + for _ in List.range (4 * len + 4) do + match work with + | [] => break + | k :: rest => + work := rest + if k ≤ len && !live[k]! then + live := live.set! k true + if let some i := p[k]? then work := i.succs k ++ work + let mut d : Array Nat := Array.replicate (len + 1) unreached + d := d.set! 0 0 + for (i, k) in p.zipIdx do + if let .call _ := i then d := d.set! (k + 1) 0 + for k in List.range (len + 1) do + if !live[k]! then d := d.set! k 0 + for _ in List.range (4 * len + 4) do + let mut changed := false + for (i, k) in p.zipIdx do + let dk := d[k]! + if dk == unreached then continue + let out := dk - i.pops + i.pushes + for t in i.succs k do + if t ≤ len && out < d[t]! then + d := d.set! t out + changed := true + if !changed then break + return d.map fun x => if x == unreached then 0 else x + +/-- The checked table: the analysis when `certOk` accepts it, else empty (no claims). An array +rather than a function, so a compiled caller computes it once. -/ +def certTable (p : Prog n) : Array Nat := + let a := analyse p + if certOk p (fun k => a.getD k 0) then a else #[] + +/-- The certificate the backends use: the checked table, reading `0` outside it. -/ +def safeCert (p : Prog n) : Nat → Nat := fun k => (certTable p).getD k 0 + +theorem certOk_zero (p : Prog n) : certOk p (fun _ => 0) = true := by + simp only [certOk, beq_self_eq_true, Bool.true_and, List.all_eq_true, Bool.and_eq_true, + decide_eq_true_eq] + intro x _ + refine ⟨fun _ _ => Nat.zero_le _, ?_⟩ + split <;> rfl + +theorem certTable_ok (p : Prog n) : certOk p (fun k => (certTable p).getD k 0) = true := by + unfold certTable + simp only [] + by_cases h : (certOk p fun k => (analyse p).getD k 0) = true + · rw [if_pos h]; exact h + · rw [if_neg h]; simpa using certOk_zero p + +theorem safeCert_ok (p : Prog n) : certOk p (safeCert p) = true := certTable_ok p + +/-- A checked certificate claims nothing at the entry point. -/ +theorem certOk_entry {p : Prog n} {c : Nat → Nat} (h : certOk p c = true) : c 0 = 0 := by + simp only [certOk, Bool.and_eq_true, beq_iff_eq] at h + exact h.1 + +theorem safeCert_zero (p : Prog n) : safeCert p 0 = 0 := certOk_entry (safeCert_ok p) + + +/-! ## Upper bounds + +The dual question: how deep can the data stack get? IR stacks are unbounded, so every backend +guards each instruction that grows the data stack with an overflow check (exit 6 when the target's +stack is full). A *bound* `b` claims an upper bound `b.bound k` on the depth at instruction `k`; +where `b.bound k + 1` words fit, the check cannot fire and a backend may drop it. + +Unlike lower bounds, an upper bound has no trivial value in the IR, where recursion can grow the +stack without limit. The target's capacity `cap` supplies one: a backend only runs while the +depth is at most `cap` (its other guards see to that), so the checker reasons from +`min (b.bound k) cap`, and a bound of `cap + 3` everywhere (`Bound.top`) always checks. + +Returns are handled context-insensitively: `b.ret` bounds the depth at every `ret`, and every +return point (the instruction after a `call`) must allow `b.ret`. + +The rules `boundOk` checks, for each instruction `i` at `k`: +* each successor `t` gets `min (b.bound k) cap - pops i + pushes i ≤ b.bound t`; +* a `call` at `k` gets `b.ret ≤ b.bound (k + 1)`; +* a `ret` at `k` gets `min (b.bound k) cap ≤ b.ret`. +No rule is needed at the entry: the stack starts empty. +-/ + +theorem Instr.pushes_le (i : Instr n) : i.pushes ≤ 3 := by cases i <;> simp [Instr.pushes] + +/-- An upper-bound certificate: a bound per instruction, and one for every `ret`. -/ +structure Bound where + bound : Nat → Nat + ret : Nat + +/-- The bound that claims nothing beyond the capacity. -/ +def Bound.top (cap : Nat) : Bound := ⟨fun _ => cap + 3, cap + 3⟩ + +/-- The checker for upper bounds against capacity `cap`. -/ +def boundOk (p : Prog n) (cap : Nat) (b : Bound) : Bool := + p.zipIdx.all fun (i, k) => + (i.succs k).all (fun t => decide (min (b.bound k) cap - i.pops + i.pushes ≤ b.bound t)) && + (match i with + | .call _ => decide (b.ret ≤ b.bound (k + 1)) + | .ret => decide (min (b.bound k) cap ≤ b.ret) + | _ => true) + +/-- The upper bounds hold in state `s`: at the current instruction, and every return address on +the return stack allows `b.ret`. -/ +structure BoundInv (b : Bound) (s : State n) : Prop where + depth : s.dstack.length ≤ b.bound s.pc + rets : ∀ a ∈ s.rstack, b.ret ≤ b.bound a + +theorem boundOk_at {p : Prog n} {cap : Nat} {b : Bound} (h : boundOk p cap b = true) {k : Nat} + {i : Instr n} (hk : p[k]? = some i) : + (∀ t ∈ i.succs k, min (b.bound k) cap - i.pops + i.pushes ≤ b.bound t) ∧ + (∀ t, i = .call t → b.ret ≤ b.bound (k + 1)) ∧ + (i = .ret → min (b.bound k) cap ≤ b.ret) := by + simp only [boundOk, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] at h + have hmem : (i, k) ∈ p.zipIdx := by + rw [List.mem_zipIdx_iff_getElem?]; simpa using hk + obtain ⟨hs, hc⟩ := h _ hmem + refine ⟨hs, ?_, ?_⟩ + · rintro t rfl; simpa using hc + · rintro rfl; simpa using hc + +theorem boundOk_top (p : Prog n) (cap : Nat) : boundOk p cap (Bound.top cap) = true := by + simp only [boundOk, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] + intro x _ + refine ⟨fun _ _ => ?_, ?_⟩ + · have := Instr.pushes_le x.1 + simp only [Bound.top] + omega + · split <;> simp [Bound.top] + +theorem BoundInv.init (b : Bound) (mem : Memory n) : BoundInv b (State.init mem) where + depth := by simp [State.init] + rets := by simp [State.init] + +/-- **Soundness of the checker:** one step from a state within the capacity keeps the bounds. -/ +theorem BoundInv.step {p : Prog n} {cap : Nat} {b : Bound} (hok : boundOk p cap b = true) + {s s' : State n} (hi : BoundInv b s) (hcap : s.dstack.length ≤ cap) + (h : WordDialect.step p s = .next s') : BoundInv b s' := by + unfold WordDialect.step at h + split at h + · cases h + · rename_i i hk + obtain ⟨hsucc, hcall, hret⟩ := boundOk_at hok hk + have hdep := exec_depth i s s' h + have hd := hi.depth + have hm : s.dstack.length ≤ min (b.bound s.pc) cap := Nat.le_min.mpr ⟨hd, hcap⟩ + rcases exec_flow i s s' h with ⟨hpc, hrs⟩ | ⟨t, rfl, hpc, hrs⟩ | ⟨rfl, hrs⟩ + · refine ⟨?_, by rw [hrs]; exact hi.rets⟩ + have := hsucc _ hpc + omega + · refine ⟨?_, ?_⟩ + · have := hsucc t (by simp [Instr.succs]) + simp only [Instr.pops, Instr.pushes] at this hdep + rw [hpc]; omega + · rw [hrs]; intro a ha + simp only [List.mem_cons] at ha + rcases ha with rfl | ha + · exact hcall t rfl + · exact hi.rets a ha + · have hr := hret rfl + simp only [Instr.pops, Instr.pushes] at hdep + refine ⟨?_, ?_⟩ + · have := hi.rets s'.pc (by rw [hrs]; simp) + omega + · intro a ha; exact hi.rets a (by rw [hrs]; simp [ha]) + +/-- An untrusted analysis for upper bounds: the least solution of the `boundOk` rules, by +iteration from `0` (it exists, every value being at most `cap + 3`). Its result is used only +when `boundOk` accepts it. -/ +def analyseBound (p : Prog n) (cap : Nat) : Array Nat × Nat := Id.run do + let len := p.length + let mut u : Array Nat := Array.replicate (len + 1) 0 + let mut r := 0 + for _ in List.range (4 * len + 2 * cap + 16) do + let mut changed := false + for (i, k) in p.zipIdx do + let m := min u[k]! cap + let out := m - i.pops + i.pushes + for t in i.succs k do + if t ≤ len && u[t]! < out then + u := u.set! t out + changed := true + match i with + | .call _ => + if u[k + 1]! < r then + u := u.set! (k + 1) r + changed := true + | .ret => + if r < m then + r := m + changed := true + | _ => pure () + if !changed then break + return (u, r) + +/-- The checked bound: the analysis when `boundOk` accepts it (reading `cap + 3` outside its +table), else `Bound.top`. -/ +def boundTable (p : Prog n) (cap : Nat) : Bound := + let a := analyseBound p cap + let b : Bound := ⟨fun k => a.1.getD k (cap + 3), a.2⟩ + if boundOk p cap b then b else Bound.top cap + +theorem boundTable_ok (p : Prog n) (cap : Nat) : boundOk p cap (boundTable p cap) = true := by + unfold boundTable + simp only [] + split + · assumption + · exact boundOk_top p cap + +/-! ## Sound upper bounds, and how to combine them + +`UbSound p cap u` says `u` is an upper bound on the data-stack depth that some invariant +guarantees: it holds initially, it is kept by every step taken from a state within the capacity +`cap`, and it implies `depth ≤ u pc`. This is all a backend needs to drop an overflow guard where +`u k + 1 ≤ cap`. Sound bounds combine by `min` (`UbSound.min`), so independent analyses can be +used together. +-/ + +/-- An upper bound backed by an invariant. -/ +def UbSound (p : Prog n) (cap : Nat) (u : Nat → Nat) : Prop := + ∃ I : State n → Prop, (∀ mem, I (State.init mem)) ∧ + (∀ s s', I s → s.dstack.length ≤ cap → WordDialect.step p s = .next s' → I s') ∧ + (∀ s, I s → s.dstack.length ≤ u s.pc) + +theorem boundOk_sound {p : Prog n} {cap : Nat} {b : Bound} (h : boundOk p cap b = true) : + UbSound p cap b.bound := + ⟨BoundInv b, fun mem => BoundInv.init b mem, fun _ _ hi hc hs => BoundInv.step h hi hc hs, + fun _ hi => hi.depth⟩ + +theorem UbSound.min {p : Prog n} {cap : Nat} {u v : Nat → Nat} (hu : UbSound p cap u) + (hv : UbSound p cap v) : UbSound p cap (fun k => Nat.min (u k) (v k)) := by + obtain ⟨I, i0, is, ib⟩ := hu + obtain ⟨J, j0, js, jb⟩ := hv + exact ⟨fun s => I s ∧ J s, fun m => ⟨i0 m, j0 m⟩, + fun s s' h hc hs => ⟨is s s' h.1 hc hs, js s s' h.2 hc hs⟩, + fun s h => Nat.le_min.mpr ⟨ib s h.1, jb s h.2⟩⟩ + +theorem UbSound.mono {p : Prog n} {cap : Nat} {u v : Nat → Nat} (hu : UbSound p cap u) + (hle : ∀ k, u k ≤ v k) : UbSound p cap v := by + obtain ⟨I, i0, is, ib⟩ := hu + exact ⟨I, i0, is, fun s h => Nat.le_trans (ib s h) (hle _)⟩ + +/-- Within the capacity, one step adds at most three words. -/ +theorem ubSound_top (p : Prog n) (cap : Nat) : UbSound p cap (fun _ => cap + 3) := by + refine ⟨fun s => s.dstack.length ≤ cap + 3, fun _ => by simp [State.init], ?_, fun _ h => h⟩ + intro s s' _ hc h + unfold WordDialect.step at h + split at h + · cases h + · rename_i i _ + have := exec_depth i s s' h + have := Instr.pushes_le i + omega + +/-! ## Per-word stack effects + +The bound above treats every return alike, so one recursive word, whose depth is unbounded, +saturates the bound after every call in the program. A *frame certificate* tracks depth relative +to the frame of the word being executed instead. For each live instruction `k` it gives the word +`fn k` it belongs to (the entry of that word) and a bound `rel k` on the depth relative to the +depth at the word's entry; for each word `f` it gives `eff f`, a bound on that relative depth at +its `ret`s (its net stack effect), and `base f`, a bound on the depth at its entry. The absolute +bound at `k` is `base (fn k) + rel k`. + +A call then leaves the caller at `rel` plus the callee's effect, whatever the callee does in +between. Even a recursive word with a balanced effect (`sum.fs`) leaves its callers bounded: only +the word's own body, whose `base` saturates at the capacity, keeps its guards. + +The checker `frameOk` checks, for every live instruction `i` at `k` (with `m = min (rel k) cap`): +* a `call t`: `t` is live, is the entry of its own word (`fn t = t`), `rel t ≥ 0`; the return + point `k + 1` is live in the caller's word, with `rel (k + 1) ≥ m + eff t`; and + `base t ≥ min cap (base (fn k) + rel k)`; +* a `ret`: `m ≤ eff (fn k)`; +* any other instruction: each successor `t` is live, in the same word, with + `rel t ≥ m - pops + pushes`; +and at the entry: `0` is live, `rel 0 ≥ 0` and `base (fn 0) ≥ 0`. + +`FrameInv` carries the actual entry depth of every active word, one per return-stack entry +(`Frames.chain`), and `FrameInv.step` proves the checker sound. +-/ + +/-- A frame certificate. -/ +structure Frames where + live : Nat → Bool + fn : Nat → Nat + rel : Nat → Int + eff : Nat → Int + base : Nat → Int + +/-- The absolute upper bound a frame certificate gives at instruction `k`. -/ +def Frames.ub (fr : Frames) (k : Nat) : Nat := (fr.base (fr.fn k) + fr.rel k).toNat + +/-- The local rule for one live instruction. -/ +def frameStep (cap : Nat) (fr : Frames) (k : Nat) : Instr n → Bool + | .call t => fr.live t && decide (fr.fn t = t) && decide (0 ≤ fr.rel t) && fr.live (k + 1) && + decide (fr.fn (k + 1) = fr.fn k) && + decide (min (fr.rel k) (cap : Int) + fr.eff t ≤ fr.rel (k + 1)) && + decide (min (cap : Int) (fr.base (fr.fn k) + fr.rel k) ≤ fr.base t) + | .ret => decide (min (fr.rel k) (cap : Int) ≤ fr.eff (fr.fn k)) + | i => (i.succs k).all fun t => fr.live t && decide (fr.fn t = fr.fn k) && + decide (min (fr.rel k) (cap : Int) - i.pops + i.pushes ≤ fr.rel t) + +/-- The checker for frame certificates. -/ +def frameOk (p : Prog n) (cap : Nat) (fr : Frames) : Bool := + fr.live 0 && decide (0 ≤ fr.rel 0) && decide (0 ≤ fr.base (fr.fn 0)) && + p.zipIdx.all fun (i, k) => !fr.live k || frameStep cap fr k i + +theorem frameOk_at {p : Prog n} {cap : Nat} {fr : Frames} (h : frameOk p cap fr = true) {k : Nat} + {i : Instr n} (hk : p[k]? = some i) (hl : fr.live k = true) : frameStep cap fr k i = true := by + simp only [frameOk, Bool.and_eq_true, List.all_eq_true] at h + have hmem : (i, k) ∈ p.zipIdx := by + rw [List.mem_zipIdx_iff_getElem?]; simpa using hk + have := h.2 _ hmem + simpa [hl] using this + +theorem frameStep_flow {cap : Nat} {fr : Frames} {k : Nat} {i : Instr n} + (hst : frameStep cap fr k i = true) (hc : ∀ t, i ≠ .call t) (hr : i ≠ .ret) : + ∀ t ∈ i.succs k, fr.live t = true ∧ fr.fn t = fr.fn k ∧ + min (fr.rel k) (cap : Int) - i.pops + i.pushes ≤ fr.rel t := by + cases i <;> first + | exact absurd rfl (hc _) + | exact absurd rfl hr + | (simp only [frameStep, List.all_eq_true, Bool.and_eq_true, decide_eq_true_eq] at hst + exact fun t ht => (fun h => ⟨h.1.1, h.1.2, h.2⟩) (hst t ht)) + +/-- The entry depths of the suspended words: `b` is the entry depth of the word `f` being left by +the next `ret`, which returns to `a` in a word entered at depth `b'`. -/ +def Frames.chain (fr : Frames) : Nat → Nat → List Nat → List Nat → Prop + | _, _, [], [] => True + | b, f, a :: as, b' :: bs => + (b : Int) + fr.eff f ≤ (b' : Int) + fr.rel a ∧ (b' : Int) ≤ fr.base (fr.fn a) ∧ + fr.live a = true ∧ fr.chain b' (fr.fn a) as bs + | _, _, _, _ => False + +/-- The frame invariant: the current instruction is live, and there are entry depths for the +current word (`b0`) and every suspended one under which the bounds hold. -/ +structure FrameInv (fr : Frames) (s : State n) : Prop where + live : fr.live s.pc = true + frame : ∃ (b0 : Nat) (bs : List Nat), (s.dstack.length : Int) ≤ b0 + fr.rel s.pc ∧ + (b0 : Int) ≤ fr.base (fr.fn s.pc) ∧ fr.chain b0 (fr.fn s.pc) s.rstack bs + +theorem FrameInv.init {p : Prog n} {cap : Nat} {fr : Frames} (h : frameOk p cap fr = true) + (mem : Memory n) : FrameInv fr (State.init mem) := by + simp only [frameOk, Bool.and_eq_true, decide_eq_true_eq] at h + obtain ⟨⟨⟨hl, hr⟩, hb⟩, _⟩ := h + refine ⟨by simpa [State.init] using hl, 0, [], ?_, ?_, ?_⟩ + · simpa [State.init] using hr + · simpa [State.init] using hb + · simp [State.init, Frames.chain] + +/-- **Soundness of the frame checker:** one step from a state within the capacity keeps the +invariant. -/ +theorem FrameInv.step {p : Prog n} {cap : Nat} {fr : Frames} (hok : frameOk p cap fr = true) + {s s' : State n} (hi : FrameInv fr s) (hcap : s.dstack.length ≤ cap) + (h : WordDialect.step p s = .next s') : FrameInv fr s' := by + unfold WordDialect.step at h + split at h + · cases h + · rename_i i hk + have hst := frameOk_at hok hk hi.live + have hdep := exec_depth i s s' h + obtain ⟨b0, bs, hd, hb, hch⟩ := hi.frame + have hmin : (s.dstack.length : Int) ≤ b0 + min (fr.rel s.pc) (cap : Int) := by + rw [Int.min_def]; split <;> omega + rcases exec_flow i s s' h with ⟨hpc, hrs⟩ | ⟨t, rfl, hpc, hrs⟩ | ⟨rfl, hrs⟩ + · have hc : ∀ t, i ≠ .call t := by + rintro t rfl + simp only [exec] at h + cases h + simp at hrs + have hr : i ≠ .ret := by rintro rfl; simp [Instr.succs] at hpc + obtain ⟨hl, hf, hrel⟩ := frameStep_flow hst hc hr _ hpc + refine ⟨hl, b0, bs, ?_, ?_, ?_⟩ + · omega + · rw [hf]; exact hb + · rw [hf, hrs]; exact hch + · simp only [frameStep, Bool.and_eq_true, decide_eq_true_eq] at hst + obtain ⟨⟨⟨⟨⟨⟨hlt, hft⟩, hrt⟩, hl1⟩, hf1⟩, hr1⟩, hbt⟩ := hst + simp only [Instr.pops, Instr.pushes] at hdep + refine ⟨by rw [hpc]; exact hlt, s.dstack.length, b0 :: bs, ?_, ?_, ?_⟩ + · rw [hpc]; omega + · rw [hpc, hft] + have : (s.dstack.length : Int) ≤ fr.base (fr.fn s.pc) + fr.rel s.pc := by omega + rw [Int.min_def] at hbt; split at hbt <;> omega + · rw [hpc, hrs, hft] + refine ⟨?_, ?_, hl1, ?_⟩ + · omega + · rw [hf1]; exact hb + · rw [hf1]; exact hch + · simp only [frameStep, decide_eq_true_eq] at hst + simp only [Instr.pops, Instr.pushes] at hdep + rw [hrs] at hch + cases bs with + | nil => simp [Frames.chain] at hch + | cons b1 bs => + obtain ⟨he, hb1, hla, hch'⟩ := hch + refine ⟨hla, b1, bs, ?_, hb1, hch'⟩ + omega + +theorem FrameInv.bound {fr : Frames} {s : State n} (hi : FrameInv fr s) : + s.dstack.length ≤ fr.ub s.pc := by + obtain ⟨b0, bs, hd, hb, _⟩ := hi.frame + unfold Frames.ub + omega + +theorem frameOk_sound {p : Prog n} {cap : Nat} {fr : Frames} (h : frameOk p cap fr = true) : + UbSound p cap fr.ub := + ⟨FrameInv fr, FrameInv.init h, fun _ _ hi hc hs => FrameInv.step h hi hc hs, + fun _ hi => hi.bound⟩ + +/-- Raise entry `t` of a table of optional bounds to at least `v`. After 16 raises the entry +jumps to `top`, so the iteration ends. -/ +def raiseOpt (a : Array (Option Int)) (cnt : Array Nat) (t : Nat) (v top : Int) : + Array (Option Int) × Array Nat × Bool := + if t < a.size then + match a[t]! with + | some old => + if v ≤ old then (a, cnt, false) + else + let c := cnt[t]! + 1 + (a.set! t (some (if 16 < c then top else v)), cnt.set! t c, true) + | none => (a.set! t (some v), cnt, true) + else (a, cnt, false) + +/-- The same for a table of bounds. -/ +def raise (a : Array Int) (cnt : Array Nat) (t : Nat) (v top : Int) : + Array Int × Array Nat × Bool := + if t < a.size && a[t]! < v then + let c := cnt[t]! + 1 + (a.set! t (if 16 < c then top else v), cnt.set! t c, true) + else (a, cnt, false) + +/-- An untrusted analysis proposing a frame certificate: the live instructions and their words by +a walk from the entry (a `call t` starts word `t`), then the least relative bounds, effects and +entry bounds by iteration, with widening. Its result is used only when `frameOk` accepts it. -/ +def analyseFrames (p : Prog n) (cap : Nat) : Frames := Id.run do + let len := p.length + let size := len + 2 + let mut live : Array Bool := Array.replicate size false + let mut fn : Array Nat := Array.replicate size 0 + let mut work : List (Nat × Nat) := [(0, 0)] + for _ in List.range (4 * size + 8) do + match work with + | [] => break + | (k, f) :: rest => + work := rest + if k < size && !live[k]! then + live := live.set! k true + fn := fn.set! k f + match p[k]? with + | some (.call t) => work := (t, t) :: (k + 1, f) :: work + | some i => work := (i.succs k).map (fun t => (t, f)) ++ work + | none => pure () + let capI : Int := cap + let topRel : Int := 2 * capI + 16 + let effMin : Int := -(2 * capI + 16) + let mut rel : Array (Option Int) := Array.replicate size none + let mut relN : Array Nat := Array.replicate size 0 + let mut eff : Array Int := Array.replicate size effMin + let mut effN : Array Nat := Array.replicate size 0 + let mut base : Array Int := Array.replicate size 0 + let mut baseN : Array Nat := Array.replicate size 0 + rel := rel.set! 0 (some 0) + for (i, k) in p.zipIdx do + if let .call t := i then + if t < size && live[k]! then rel := rel.set! t (some 0) + for _ in List.range (64 * size + 64) do + let mut changed := false + for (i, k) in p.zipIdx do + if live[k]! then + if let some r := rel[k]! then + let m := min r capI + match i with + | .call t => + if t < size then + let (a, c, ch) := raiseOpt rel relN (k + 1) (m + eff[t]!) topRel + rel := a; relN := c; changed := changed || ch + let (a, c, ch) := raise base baseN t (min capI (base[fn[k]!]! + r)) capI + base := a; baseN := c; changed := changed || ch + | .ret => + let (a, c, ch) := raise eff effN fn[k]! m capI + eff := a; effN := c; changed := changed || ch + | _ => + for t in i.succs k do + let (a, c, ch) := raiseOpt rel relN t (m - i.pops + i.pushes) topRel + rel := a; relN := c; changed := changed || ch + if !changed then break + return { live := fun k => live.getD k false, fn := fun k => fn.getD k 0, + rel := fun k => (rel.getD k none).getD 0, eff := fun f => eff.getD f effMin, + base := fun f => base.getD f 0 } + +/-- The upper bounds the backends use, as a table: the least of the context-insensitive bound, +the frame certificate's bound (when `frameOk` accepts it) and `cap + 3`. -/ +def upperTable (p : Prog n) (cap : Nat) : Array Nat := + let b := boundTable p cap + let fr := analyseFrames p cap + let ok := frameOk p cap fr + (Array.range (p.length + 1)).map fun k => + Nat.min (Nat.min (b.bound k) (if ok then fr.ub k else cap + 3)) (cap + 3) + +/-- Reading the table: `cap + 3` (no room) outside it. -/ +def upperAt (a : Array Nat) (cap k : Nat) : Nat := a.getD k (cap + 3) + +theorem upperTable_sound (p : Prog n) (cap : Nat) : + UbSound p cap (fun k => upperAt (upperTable p cap) cap k) := by + have hb := boundOk_sound (boundTable_ok p cap) + have hf : UbSound p cap (fun k => if frameOk p cap (analyseFrames p cap) = true then + (analyseFrames p cap).ub k else cap + 3) := by + cases h : frameOk p cap (analyseFrames p cap) + · simpa using ubSound_top p cap + · simpa using frameOk_sound h + refine UbSound.mono ((hb.min hf).min (ubSound_top p cap)) ?_ + intro k + simp only [upperAt, upperTable, Array.getD_eq_getD_getElem?, Array.getElem?_map, + Array.getElem?_range] + split <;> split <;> simp <;> omega + +end WordDialect diff --git a/scripts/hil/capture.py b/scripts/hil/capture.py new file mode 100644 index 0000000000000000000000000000000000000000..b9e95bfabfd9af2cfbd6cf4e94d056b5adc9f16a --- /dev/null +++ b/scripts/hil/capture.py @@ -0,0 +1,37 @@ +"""Read a serial port until the end-of-run transcript is complete. + + python3 capture.py + +Opens (already set to 115200 8N1 raw by the caller), touches once the +port is open (opening it raises DTR, which the Curiosity Nano's debugger needs before it forwards +any data), and copies everything to until the line after `EXIT` (the status) has been +received, or the timeout passes. Only printable ASCII and newlines are kept (carriage returns, +NUL and other glitch bytes as the UART comes up are dropped), so line noise cannot hide the +transcript. Exit status 0 if the transcript ended. +""" +import os, select, sys, time + +dev, out, limit, ready = sys.argv[1], sys.argv[2], float(sys.argv[3]), sys.argv[4] +fd = os.open(dev, os.O_RDONLY | os.O_NOCTTY) +open(ready, 'w').close() +buf = b'' +deadline = time.monotonic() + limit +done = False +with open(out, 'wb') as log: + while time.monotonic() < deadline and not done: + r, _, _ = select.select([fd], [], [], 0.2) + if not r: + continue + raw = os.read(fd, 4096) + if not raw: + break + chunk = bytes(b for b in raw if b == 10 or 32 <= b < 127) + buf += chunk + log.write(chunk) + log.flush() + lines = buf.split(b'\n') + for i, line in enumerate(lines[:-1]): + if line.strip() == b'EXIT' and i + 1 < len(lines) - 1: + done = True + break +sys.exit(0 if done else 1) diff --git a/scripts/hil/run-all.sh b/scripts/hil/run-all.sh new file mode 100644 index 0000000000000000000000000000000000000000..11057c7c57df30fef665b4f4c121c0b8d33ec9eb --- /dev/null +++ b/scripts/hil/run-all.sh @@ -0,0 +1,14 @@ +#!/bin/sh +# Run every Forth example on a real board: scripts/hil/run-all.sh +# Prints one PASS/FAIL line per program; exits non-zero if any fails. +set -u +board=$1; tty=$2 +fail=0 +for f in examples/forth/*.fs; do + if out=$(scripts/hil/run-board.sh "$board" "$f" "$tty" 2>&1); then + echo "$out" | head -1 + else + echo "FAIL $(basename "$f" .fs) on $board"; echo "$out" | sed 's/^/ /'; fail=1 + fi +done +exit $fail diff --git a/scripts/hil/run-board.sh b/scripts/hil/run-board.sh new file mode 100644 index 0000000000000000000000000000000000000000..996005041f0f4523c937a4e1122a25fc1b82a42c --- /dev/null +++ b/scripts/hil/run-board.sh @@ -0,0 +1,57 @@ +#!/bin/sh +# Run one Forth program on a real board and check its serial transcript against Lean. +# +# scripts/hil/run-board.sh [memWords] +# +# is samd21-cnano (Microchip SAM D21 Curiosity Nano) or microbit-v1. The script builds +# the image with cm0c, opens the serial port first (the Curiosity Nano's debugger only forwards +# serial data while the port is open), programs the board with OpenOCD over CMSIS-DAP, which +# resets it so the program runs, reads the serial port until the EXIT line and the status, and +# runs `cm0c verify`. Exit status: 0 when the board's output matches Lean, non-zero otherwise. +# +# Environment: CM0C (path to cm0c, default .lake/build/bin/cm0c), OPENOCD (default openocd), +# HIL_TIMEOUT (seconds to wait for the transcript, default 30), HIL_KEEP (a directory to keep +# the image, serial log and OpenOCD log in), HIL_ADAPTER_SERIAL (the debugger's +# USB serial number, to pick one board when several are attached). +set -eu +board=$1; prog=$2; tty=$3; mem=${4:-16} +cm0c=${CM0C:-.lake/build/bin/cm0c} +cm0c=$(cd "$(dirname "$cm0c")" && pwd)/$(basename "$cm0c") +prog=$(cd "$(dirname "$prog")" && pwd)/$(basename "$prog") +openocd=${OPENOCD:-openocd} +timeout_s=${HIL_TIMEOUT:-30} +work=$(mktemp -d) +reader="" +trap 'kill "$reader" 2>/dev/null || true; if [ -n "${HIL_KEEP:-}" ]; then cp -r "$work" "$HIL_KEEP" || true; fi; rm -rf "$work"' EXIT + +name=$(basename "$prog" .fs) +(cd "$work" && "$cm0c" image "$prog" "$mem" --board "$board" >/dev/null) || + { echo "ERROR $name: image build failed"; exit 2; } +elf="$work/$name-$board.elf" + +case "$board" in + samd21-cnano) target="-c 'set CHIPNAME at91samd21g17' -f target/at91samdXX.cfg" ;; + microbit-v1) target="-f target/nrf51.cfg" ;; + *) echo "unknown board $board"; exit 2 ;; +esac +serial="" +[ -n "${HIL_ADAPTER_SERIAL:-}" ] && serial="-c 'adapter serial $HIL_ADAPTER_SERIAL'" + +# 1. open the port (raw, 115200 8N1) and capture until the status line after EXIT +stty -F "$tty" 115200 cs8 -cstopb -parenb raw -echo +log="$work/serial.log" +python3 "$(dirname "$0")/capture.py" "$tty" "$log" "$timeout_s" "$work/ready" & +reader=$! +while [ ! -e "$work/ready" ]; do + kill -0 "$reader" 2>/dev/null || { echo "ERROR $name: cannot open $tty"; exit 2; } + sleep 0.1 +done + +# 2. program and reset (the program runs after the reset) +eval "$openocd -f interface/cmsis-dap.cfg -c 'transport select swd' $serial $target \ + -c 'program $elf verify reset exit'" > "$work/openocd.log" 2>&1 || + { echo "ERROR $name: programming failed"; cat "$work/openocd.log"; exit 2; } + +# 3. wait for the transcript, then compare with Lean +wait "$reader" || echo "warning: no complete transcript within ${timeout_s}s" >&2 +"$cm0c" verify "$prog" "$log" "$mem"