From 14647e886c3945d3cdba848af1e9aca2422381d1 Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 12:47:02 +0000 Subject: [PATCH 1/2] SHA-384/512/512-224/512-256 streaming on ARMv7 through MdStream MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Generalize the ARMv7 streaming Merkle-Damgård code and proofs (Impl/MdStream/Arm.lean, Proof/MdStream/Arm/) over the block size B and the length-field size L, as on x86-64, and instantiate them for the SHA-512 family on ARMv7, deleting its bespoke streaming code and proofs. MD5, SHA-1 and SHA-256 (B = 64, L = 8) emit the same code; the SHA-512 family's update now compresses whole blocks straight from the data. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_019oSrQeJdKT2MeBHirxaPKi --- lean/VerifiedGarbage/Impl/Md5/Arm/Stream.lean | 2 + lean/VerifiedGarbage/Impl/MdStream/Arm.lean | 61 +- .../VerifiedGarbage/Impl/Sha1/Arm/Stream.lean | 2 + .../Impl/Sha256/Arm/Stream.lean | 2 + .../Impl/Sha512/Arm/Stream.lean | 131 +- .../Proof/Ed25519/Arm/Whole/Hash.lean | 6 +- .../Proof/Md5/Arm/Stream/Md.lean | 7 +- .../Proof/MdStream/Arm/Common.lean | 131 +- .../Proof/MdStream/Arm/Finalize.lean | 201 +-- .../Proof/MdStream/Arm/Update.lean | 341 ++--- .../Proof/Pbkdf2/Md/Arm/Words.lean | 6 +- .../Proof/Sha1/Arm/Stream/Md.lean | 7 +- .../Proof/Sha256/Arm/Stream/Common.lean | 2 +- .../Proof/Sha256/Arm/Stream/Md.lean | 7 +- .../Proof/Sha512/Arm/Stream/Finalize.lean | 1208 +++-------------- .../Proof/Sha512/Arm/Stream/Update.lean | 1169 +--------------- .../Proof/Sha512/X86/Stream/Update.lean | 3 +- 17 files changed, 661 insertions(+), 2625 deletions(-) diff --git a/lean/VerifiedGarbage/Impl/Md5/Arm/Stream.lean b/lean/VerifiedGarbage/Impl/Md5/Arm/Stream.lean index b98db2295..ac3c0821b 100644 --- a/lean/VerifiedGarbage/Impl/Md5/Arm/Stream.lean +++ b/lean/VerifiedGarbage/Impl/Md5/Arm/Stream.lean @@ -31,6 +31,8 @@ The generic streaming code (`Impl/MdStream/Arm.lean`). -/ def params : MdStream.Arm.Params where N := 16 + B := 64 + L := 8 so := 64 len := MdStream.Arm.len64 72 false out := MdStream.Arm.out32 4 false diff --git a/lean/VerifiedGarbage/Impl/MdStream/Arm.lean b/lean/VerifiedGarbage/Impl/MdStream/Arm.lean index e4aedd58a..3e67cb478 100644 --- a/lean/VerifiedGarbage/Impl/MdStream/Arm.lean +++ b/lean/VerifiedGarbage/Impl/MdStream/Arm.lean @@ -3,15 +3,15 @@ import VerifiedGarbage.TCB.Arm.Isa /-! # Streaming Merkle–Damgård hash functions: 32-bit ARM implementation -The streaming `update` and `finalize` of MD5, SHA-1 and SHA-256, whose blocks -are 64 bytes and whose length fields are 8 bytes, and which differ only in -the size of their hash values, in how they store the message length and -output the digest, and in the compression function they call (`Params`). +The streaming `update` and `finalize` of MD5, SHA-1, SHA-256 and the SHA-512 +family, which differ only in their sizes, in how they store the message +length and output the digest, and in the compression function they call +(`Params`). Each hash function's `Impl//Arm/Stream.lean` instantiates them. The same algorithm as on AArch64 (`VG.Impl.MdStream.AArch64`). -The streaming state (`N + 64` bytes at `state`) is the hash value (`N` -bytes) followed by a 64-byte buffer. +The streaming state (`N + B` bytes at `state`) is the hash value (`N` +bytes) followed by a `B`-byte buffer. * `update(state = r0, count = r2:r3, data = [sp], len = [sp, #4], scratch = [sp, #8])` compresses, in each iteration, every whole block left @@ -44,14 +44,18 @@ open VG.Arm structure Params where /-- The size of the hash value, where the buffer starts. -/ N : Nat + /-- The block size, a power of two. -/ + B : Nat + /-- The size of the length field at the end of the last block. -/ + L : Nat /-- Where our caller's registers are saved in the scratch space, after the compression function's own. -/ so : Nat /-- Stores the length field, from `count` in `r4:r5` (low, high), at - `r0 + N + 56`; writes only `r9`. -/ + `r0 + N + B - L`; writes only `r9`. -/ len : List Instr /-- Writes the digest, from the hash value at `r0`, to `r6`; writes only - `r9`. -/ + `r9` and `r10`. -/ out : List Instr variable (P : Params) @@ -84,43 +88,46 @@ Registers: `r4` = bytes in the buffer (`r`), `r5` = `data`, `r6` = bytes of `data` left, `r7` = the number of blocks this iteration compresses (at `r1`). The loop runs while `r6 ≠ 0`, so each iteration starts with `r6 ≥ 1` and -`r4 < 64`. -/ +`r4 < B`. -/ -/-- Every whole block left, straight from `data`: `len >> 6` blocks, -`(len >> 6) << 6` bytes. -/ +/-- Every whole block left, straight from `data`: `len >> log₂ B` blocks, +`(len >> log₂ B) << log₂ B` bytes. -/ def direct : List Instr := - [.mov .r1 (.reg .r5), .mov .r7 (.shifted .r6 .lsr 6), .mov .r12 (.shifted .r7 .lsl 6), + [.mov .r1 (.reg .r5), .mov .r7 (.shifted .r6 .lsr (Nat.log2 P.B)), + .mov .r12 (.shifted .r7 .lsl (Nat.log2 P.B)), .dp .add .r5 .r5 (.reg .r12), .dp .sub .r6 .r6 (.reg .r12)] -/-- Copy `n = min(64 - r, len) ≥ 1` bytes of `data` into the buffer; if that +/-- Copy `n = min(B - r, len) ≥ 1` bytes of `data` into the buffer; if that fills it, compress it. -/ def fill : Prog isa := - -- r8 := 64 - r; if len < 64 and len + r < 64 (i.e. len < 64 - r), r8 := len. - .seq (.block [.mov .r8 (.imm 64), .dp .sub .r8 .r8 (.reg .r4), .mov .r12 (.shifted .r6 .lsr 6), - .cmp .r12 (.imm 0)]) + -- r8 := B - r; if len < B and len + r < B (i.e. len < B - r), r8 := len. + .seq (.block [.mov .r8 (.imm (BitVec.ofNat 32 P.B)), .dp .sub .r8 .r8 (.reg .r4), + .mov .r12 (.shifted .r6 .lsr (Nat.log2 P.B)), .cmp .r12 (.imm 0)]) (.seq (.ite .eq - (.seq (.block [.dp .add .r12 .r6 (.reg .r4), .mov .r12 (.shifted .r12 .lsr 6), .cmp .r12 (.imm 0)]) + (.seq (.block [.dp .add .r12 .r6 (.reg .r4), .mov .r12 (.shifted .r12 .lsr (Nat.log2 P.B)), + .cmp .r12 (.imm 0)]) (.ite .eq (.block [.mov .r8 (.reg .r6)]) (.block []))) (.block [])) (.seq (.block [.dp .sub .r6 .r6 (.reg .r8)]) (.seq (.loop (.block [.ldrb .r12 .r5 0, .dp .add .r1 .r0 (.reg .r4), .strb .r12 .r1 P.N, .dp .add .r5 .r5 (.imm 1), .dp .add .r4 .r4 (.imm 1), .subs .r8 .r8 (.imm 1)]) .ne) -- Full: compress the buffer. - (.seq (.block [.cmp .r4 (.imm 64)]) + (.seq (.block [.cmp .r4 (.imm (BitVec.ofNat 32 P.B))]) (.ite .eq (.block [.dp .add .r1 .r0 (.imm (BitVec.ofNat 32 P.N)), .mov .r4 (.imm 0), .mov .r7 (.imm 1)]) (.block [])))))) def updateBody (name : String) (code : Prog isa) : Prog isa := .seq (.block [.mov .r7 (.imm 0), .cmp .r4 (.imm 0)]) (.seq (.ite .eq - (.seq (.block [.mov .r12 (.shifted .r6 .lsr 6), .cmp .r12 (.imm 0)]) (.ite .eq (fill P) (.block direct))) + (.seq (.block [.mov .r12 (.shifted .r6 .lsr (Nat.log2 P.B)), .cmp .r12 (.imm 0)]) + (.ite .eq (fill P) (.block (direct P)))) (fill P)) (.seq (.seq (.block [.cmp .r7 (.imm 0)]) (.ite .eq (.block []) (compressN name code))) (.block [.cmp .r6 (.imm 0)]))) def update (name : String) (code : Prog isa) : Prog isa := - .seq (.block ([.ldrSp .r12 8] ++ save P .r12 ++ [.mov .r3 (.reg .r12), .dp .and .r4 .r2 (.imm 63), - .ldrSp .r5 0, .ldrSp .r6 4, .cmp .r6 (.imm 0)])) + .seq (.block ([.ldrSp .r12 8] ++ save P .r12 ++ [.mov .r3 (.reg .r12), + .dp .and .r4 .r2 (.imm (BitVec.ofNat 32 (P.B - 1))), .ldrSp .r5 0, .ldrSp .r6 4, .cmp .r6 (.imm 0)])) (.seq (.ite .eq (.block []) (.loop (updateBody P name code) .ne)) (.block (restore P))) @@ -131,9 +138,9 @@ the buffer (`r`), `r8` = 1 while the block being padded is not the last one (then 0). -/ def finalizeBody (name : String) (code : Prog isa) : Prog isa := - -- Zero the buffer from `r` to 64, or to 56 in the last block. - .seq (.block [.mov .r9 (.imm 64), .cmp .r8 (.imm 0)]) - (.seq (.ite .eq (.block [.mov .r9 (.imm 56)]) (.block [])) + -- Zero the buffer from `r` to `B`, or to `B - L` in the last block. + .seq (.block [.mov .r9 (.imm (BitVec.ofNat 32 P.B)), .cmp .r8 (.imm 0)]) + (.seq (.ite .eq (.block [.mov .r9 (.imm (BitVec.ofNat 32 (P.B - P.L)))]) (.block [])) (.seq (.block [.mov .r12 (.imm 0), .subs .r9 .r9 (.reg .r7)]) (.seq (.ite .eq (.block []) (.loop (.block [.dp .add .r1 .r0 (.reg .r7), .strb .r12 .r1 P.N, .dp .add .r7 .r7 (.imm 1), @@ -147,11 +154,11 @@ def finalizeBody (name : String) (code : Prog isa) : Prog isa := def finalize (name : String) (code : Prog isa) : Prog isa := .seq (.block ([.ldrSp .r12 4] ++ save P .r12 ++ [.mov .r4 (.reg .r2), .mov .r5 (.reg .r3), - .mov .r3 (.reg .r12), .ldrSp .r6 0, .dp .and .r7 .r4 (.imm 63), + .mov .r3 (.reg .r12), .ldrSp .r6 0, .dp .and .r7 .r4 (.imm (BitVec.ofNat 32 (P.B - 1))), -- The `0x80` byte. .mov .r12 (.imm 0x80), .dp .add .r1 .r0 (.reg .r7), .strb .r12 .r1 P.N, .dp .add .r7 .r7 (.imm 1), - -- Two blocks iff that leaves fewer than 8 bytes for the length (r ≥ 57). - .dp .add .r8 .r7 (.imm 7), .mov .r8 (.shifted .r8 .lsr 6)])) + -- Two blocks iff that leaves fewer than `L` bytes for the length (r > B - L). + .dp .add .r8 .r7 (.imm (BitVec.ofNat 32 (P.L - 1))), .mov .r8 (.shifted .r8 .lsr (Nat.log2 P.B))])) (.seq (.loop (finalizeBody P name code) .eq) (.block (P.out ++ restore P))) diff --git a/lean/VerifiedGarbage/Impl/Sha1/Arm/Stream.lean b/lean/VerifiedGarbage/Impl/Sha1/Arm/Stream.lean index 89c5cb6b7..6e205829c 100644 --- a/lean/VerifiedGarbage/Impl/Sha1/Arm/Stream.lean +++ b/lean/VerifiedGarbage/Impl/Sha1/Arm/Stream.lean @@ -31,6 +31,8 @@ The generic streaming code (`Impl/MdStream/Arm.lean`). -/ def params : MdStream.Arm.Params where N := 20 + B := 64 + L := 8 so := 112 len := MdStream.Arm.len64 76 true out := MdStream.Arm.out32 5 true diff --git a/lean/VerifiedGarbage/Impl/Sha256/Arm/Stream.lean b/lean/VerifiedGarbage/Impl/Sha256/Arm/Stream.lean index 43c515dd3..b066eabd4 100644 --- a/lean/VerifiedGarbage/Impl/Sha256/Arm/Stream.lean +++ b/lean/VerifiedGarbage/Impl/Sha256/Arm/Stream.lean @@ -59,6 +59,8 @@ The generic streaming code (`Impl/MdStream/Arm.lean`). -/ def params : MdStream.Arm.Params where N := 32 + B := 64 + L := 8 so := 112 len := MdStream.Arm.len64 88 true out := MdStream.Arm.out32 8 true diff --git a/lean/VerifiedGarbage/Impl/Sha512/Arm/Stream.lean b/lean/VerifiedGarbage/Impl/Sha512/Arm/Stream.lean index cd3deb19f..83d3c14c7 100644 --- a/lean/VerifiedGarbage/Impl/Sha512/Arm/Stream.lean +++ b/lean/VerifiedGarbage/Impl/Sha512/Arm/Stream.lean @@ -1,4 +1,5 @@ import VerifiedGarbage.Impl.Sha512.Arm +import VerifiedGarbage.Impl.MdStream.Arm /-! # Streaming SHA-512: 32-bit ARM implementation @@ -8,33 +9,20 @@ The streaming state (192 bytes at `state`) is the hash value followed by a value is stored little-endian, so as its low half followed by its high half. * `init iv (state = r0)` stores the initial hash value `iv`. -* `update(state = r0, count = r2:r3, data = [sp], len = [sp, #4], - scratch = [sp, #8])` processes the data in pieces: each iteration copies - as many bytes as fit into the buffer (a whole block when the buffer is - empty and a whole block remains), and compresses the buffer once it is - full. -* `finalize(state = r0, count = r2:r3, out = [sp], scratch = [sp, #4])` pads - the buffered bytes (one or two blocks), compresses them and writes the - final hash value. - -The buffer is compressed by calling `vg_sha512_compress`, with -`scratch[0..224)` as its scratch space. Its code never writes `r0` or `r3`, -so `state` stays in `r0` and `scratch` in `r3`; it preserves `r4`–`r11`, so -our variables live in `r4`–`r6`. Our caller's `r4`–`r11` and our return -address (`lr`, which the calls overwrite) are saved in `scratch[224..260)`. -`finalize` also keeps `count` in `scratch[260..268)`. - -Byte `r` of the buffer is addressed as `[r1, #64]` with `r1 = state + r` -computed just before the access, and `data` is consumed through a pointer -that advances. Every comparison is a `cmp` or `subs` tested with `eq`/`ne`. -Every address and branch depends only on `sp`, the pointers, `count` and -`len`. +* `update` and `finalize` are the generic streaming code + (`Impl/MdStream/Arm.lean`), calling the compression function + (`vg_sha512_compress`) with `scratch[0..224)` as its scratch space, and + saving our caller's `r4`–`r11` and `lr` in `scratch[224..260)`. The length + field is the length in bits as a 128-bit big-endian integer: `count >> 61`, + then `count << 3` (modulo 2⁶⁴); the words of the final hash value are + big-endian. -/ namespace VG.Impl.Sha512.Arm.Stream open VG.Arm open VG.Impl.Sha512.Arm (compress lo hi) +open VG.Impl.MdStream.Arm (Params len64) /-- Store word `k` of `iv`. -/ def initW (iv : Spec.Sha512.HashValue) (k : Nat) : List Instr := @@ -46,98 +34,23 @@ def initW (iv : Spec.Sha512.HashValue) (k : Nat) : List Instr := def init (iv : Spec.Sha512.HashValue) : Prog isa := .block ((List.range 8).flatMap (initW iv)) -/-- The callee-saved registers we use (and `lr`), and where they are saved in `scratch`. -/ -def saved : List (Reg × Nat) := - [(.r4, 224), (.r5, 228), (.r6, 232), (.r7, 236), (.r8, 240), (.r9, 244), (.r10, 248), (.r11, 252), - (.lr, 256)] - -/-- Save them, with `scratch` in `b`. -/ -def save (b : Reg) : List Instr := saved.map fun (r, d) => .str r b d - -/-- Restore them from `scratch` in `r3`. -/ -def restore : List Instr := saved.map fun (r, d) => .ldr r .r3 d - -/-- A call of `vg_sha512_compress`. -/ -def compressCall : Prog isa := .call "vg_sha512_compress" compress - -/-- Compress the buffer of the state at `r0` into its hash value, with -scratch space `r3`. -/ -def compressAt : Prog isa := .seq (.block [.dp .add .r1 .r0 (.imm 64), .mov .r2 (.imm 1)]) compressCall - -/-! ## `update` - -Registers: `r4` = bytes in the buffer (`r`), `r5` = `data`, `r6` = bytes of -`data` left. The loop runs while `r6 ≠ 0`, so each iteration starts with -`r6 ≥ 1` and `r4 < 128`. -/ - -/-- Copy `n = min(128 - r, len) ≥ 1` bytes of `data` into the buffer; if that -fills it, compress it. -/ -def fill : Prog isa := - -- r8 := 128 - r; if len < 128 and len + r < 128 (i.e. len < 128 - r), r8 := len. - .seq (.block [.mov .r8 (.imm 128), .dp .sub .r8 .r8 (.reg .r4), .mov .r12 (.shifted .r6 .lsr 7), - .cmp .r12 (.imm 0)]) - (.seq (.ite .eq - (.seq (.block [.dp .add .r12 .r6 (.reg .r4), .mov .r12 (.shifted .r12 .lsr 7), .cmp .r12 (.imm 0)]) - (.ite .eq (.block [.mov .r8 (.reg .r6)]) (.block []))) - (.block [])) - (.seq (.block [.dp .sub .r6 .r6 (.reg .r8)]) - (.seq (.loop (.block [.ldrb .r12 .r5 0, .dp .add .r1 .r0 (.reg .r4), .strb .r12 .r1 64, - .dp .add .r5 .r5 (.imm 1), .dp .add .r4 .r4 (.imm 1), .subs .r8 .r8 (.imm 1)]) .ne) - -- Full: compress the buffer. - (.seq (.block [.cmp .r4 (.imm 128)]) - (.ite .eq (.seq compressAt (.block [.mov .r4 (.imm 0)])) (.block [])))))) - -def updateBody : Prog isa := .seq fill (.block [.cmp .r6 (.imm 0)]) - -def update : Prog isa := - .seq (.block ([.ldrSp .r12 8] ++ save .r12 ++ [.mov .r3 (.reg .r12), .dp .and .r4 .r2 (.imm 127), - .ldrSp .r5 0, .ldrSp .r6 4, .cmp .r6 (.imm 0)])) - (.seq (.ite .eq (.block []) (.loop updateBody .ne)) - (.block restore)) - -/-! ## `finalize` - -Registers: `r4` = bytes in the buffer (`r`), `r5` = 1 while the block being -padded is not the last one (then 0), `r6` = `out`. -/ - -/-- The message length in bits as a 128-bit big-endian integer, at the end of -the buffer: `count >> 61`, then `count << 3` (modulo 2⁶⁴), from `count` in -`scratch[260..268)`. -/ -def lenW : List Instr := - [.ldr .r9 .r3 260, .ldr .r10 .r3 264, - .mov .r11 (.imm 0), .str .r11 .r0 176, - .mov .r11 (.shifted .r10 .lsr 29), .rev .r11 .r11, .str .r11 .r0 180, - .mov .r11 (.shifted .r10 .lsl 3), .dp .orr .r11 .r11 (.shifted .r9 .lsr 29), .rev .r11 .r11, - .str .r11 .r0 184, - .mov .r11 (.shifted .r9 .lsl 3), .rev .r11 .r11, .str .r11 .r0 188] - -def finalizeBody : Prog isa := - -- Zero the buffer from `r` to 128, or to 112 in the last block. - .seq (.block [.mov .r9 (.imm 128), .cmp .r5 (.imm 0)]) - (.seq (.ite .eq (.block [.mov .r9 (.imm 112)]) (.block [])) - (.seq (.block [.mov .r12 (.imm 0), .subs .r9 .r9 (.reg .r4)]) - (.seq (.ite .eq (.block []) - (.loop (.block [.dp .add .r1 .r0 (.reg .r4), .strb .r12 .r1 64, .dp .add .r4 .r4 (.imm 1), - .subs .r9 .r9 (.imm 1)]) .ne)) - -- In the last block, the message length. - (.seq (.block [.cmp .r5 (.imm 0)]) - (.seq (.ite .eq (.block lenW) (.block [])) - (.seq compressAt - (.block [.mov .r4 (.imm 0), .subs .r5 .r5 (.imm 1)]))))))) - /-- Word `k` of the final hash value, big-endian. -/ def outW (k : Nat) : List Instr := [.ldr .r9 .r0 (8 * k), .ldr .r10 .r0 (8 * k + 4), .rev .r10 .r10, .rev .r9 .r9, .str .r10 .r6 (8 * k), .str .r9 .r6 (8 * k + 4)] -def finalize : Prog isa := - .seq (.block ([.ldrSp .r12 4] ++ save .r12 ++ [.str .r2 .r12 260, .str .r3 .r12 264, - .mov .r3 (.reg .r12), .ldrSp .r6 0, .dp .and .r4 .r2 (.imm 127), - -- The `0x80` byte. - .mov .r12 (.imm 0x80), .dp .add .r1 .r0 (.reg .r4), .strb .r12 .r1 64, .dp .add .r4 .r4 (.imm 1), - -- Two blocks iff that leaves fewer than 16 bytes for the length (r ≥ 113). - .dp .add .r5 .r4 (.imm 15), .mov .r5 (.shifted .r5 .lsr 7)])) - (.seq (.loop finalizeBody .eq) - (.block ((List.range 8).flatMap outW ++ restore))) +/-- The sizes, the length field and the digest. -/ +def params : Params where + N := 64 + B := 128 + L := 16 + so := 224 + len := [.mov .r9 (.imm 0), .str .r9 .r0 176, .mov .r9 (.shifted .r5 .lsr 29), .rev .r9 .r9, .str .r9 .r0 180] ++ + len64 184 true + out := (List.range 8).flatMap outW + +def update : Prog isa := MdStream.Arm.update params "vg_sha512_compress" compress + +def finalize : Prog isa := MdStream.Arm.finalize params "vg_sha512_compress" compress end VG.Impl.Sha512.Arm.Stream diff --git a/lean/VerifiedGarbage/Proof/Ed25519/Arm/Whole/Hash.lean b/lean/VerifiedGarbage/Proof/Ed25519/Arm/Whole/Hash.lean index 445916ef2..7fc08c636 100644 --- a/lean/VerifiedGarbage/Proof/Ed25519/Arm/Whole/Hash.lean +++ b/lean/VerifiedGarbage/Proof/Ed25519/Arm/Whole/Hash.lean @@ -14,12 +14,14 @@ private theorem rounds_noFrames (n : Nat) : (Impl.Sha512.Arm.rounds n).noFrames | succ n ih => simp only [Impl.Sha512.Arm.rounds, Code.noFrames, ih, Bool.and_self] theorem update_noFrames : update.noFrames = true := by - simp only [update, updateBody, fill, compressAt, compressCall, + simp only [update, Impl.MdStream.Arm.update, Impl.MdStream.Arm.updateBody, Impl.MdStream.Arm.fill, + Impl.MdStream.Arm.compressN, Impl.MdStream.Arm.compressWith, Impl.Sha512.Arm.compress, Impl.Sha512.Arm.body, Code.noFrames, Bool.and_self] rw [rounds_noFrames]; rfl theorem finalize_noFrames : finalize.noFrames = true := by - simp only [finalize, finalizeBody, compressAt, compressCall, + simp only [finalize, Impl.MdStream.Arm.finalize, Impl.MdStream.Arm.finalizeBody, + Impl.MdStream.Arm.compressAt, Impl.MdStream.Arm.compressWith, Impl.Sha512.Arm.compress, Impl.Sha512.Arm.body, Code.noFrames, Bool.and_self] rw [rounds_noFrames]; rfl diff --git a/lean/VerifiedGarbage/Proof/Md5/Arm/Stream/Md.lean b/lean/VerifiedGarbage/Proof/Md5/Arm/Stream/Md.lean index 578690c91..f0a74178f 100644 --- a/lean/VerifiedGarbage/Proof/Md5/Arm/Stream/Md.lean +++ b/lean/VerifiedGarbage/Proof/Md5/Arm/Stream/Md.lean @@ -23,13 +23,14 @@ open VG VG.Arm VG.Proof.MdStream VG.Proof.MdStream.Arm abbrev params := Impl.Md5.Arm.Stream.params -theorem dims : Dims params := ⟨by decide, by decide, by decide⟩ +theorem dims : Dims params := ⟨.inl rfl, by decide, by decide, by decide, by decide, by decide⟩ theorem shape : Shape (P := params) md where - len _ hfit hout := len64_ok (d := params.N + 56) (be := false) (by decide) (by omega) hout + len _ hfit hout := len64_ok (d := params.N + (params.B - params.L)) (be := false) (by decide) + (by have : params.B = 64 := rfl; have : params.L = 8 := rfl; omega) hout out _ f₀ f₆ hin hout hd := by refine (out32_ok (n := 4) false (by decide) f₀ f₆ hin hout hd).mono fun s' ⟨g, rd, wr, sp, m⟩ => - ⟨g, rd, wr, sp, ?_⟩ + ⟨fun r h _ => g r h, rd, wr, sp, ?_⟩ rw [m, digest_eq] theorem callee : CalleeOk (P := params) md Impl.Md5.Arm.compress := diff --git a/lean/VerifiedGarbage/Proof/MdStream/Arm/Common.lean b/lean/VerifiedGarbage/Proof/MdStream/Arm/Common.lean index be9fbb573..611eb9543 100644 --- a/lean/VerifiedGarbage/Proof/MdStream/Arm/Common.lean +++ b/lean/VerifiedGarbage/Proof/MdStream/Arm/Common.lean @@ -237,11 +237,14 @@ theorem shr6 {a : Nat} (h : a < 2 ^ 32) : BitVec.ofNat 32 a >>> 6 = BitVec.ofNat theorem cmp0 {a : Nat} (h : a < 2 ^ 32) : (BitVec.ofNat 32 a - 0 == 0) = decide (a = 0) := by rw [show BitVec.ofNat 32 a - 0 = BitVec.ofNat 32 a by simp]; exact ofNat_beq_zero h -theorem and63 (x : BitVec 32) : x &&& 63 = BitVec.ofNat 32 (x.toNat % 64) := by +theorem and_pow_sub_one (x : BitVec 32) {n : Nat} (hn : n ≤ 32) : + x &&& BitVec.ofNat 32 (2 ^ n - 1) = BitVec.ofNat 32 (x.toNat % 2 ^ n) := by apply BitVec.eq_of_toNat_eq + have : 2 ^ n ≤ 2 ^ 32 := Nat.pow_le_pow_right (by decide) hn + have : 0 < 2 ^ n := Nat.two_pow_pos n simp only [BitVec.toNat_and, BitVec.toNat_ofNat] - rw [show (63 : BitVec 32).toNat = 2 ^ 6 - 1 from rfl, Nat.and_two_pow_sub_one_eq_mod] - omega + rw [Nat.mod_eq_of_lt (show 2 ^ n - 1 < 2 ^ 32 by omega), Nat.and_two_pow_sub_one_eq_mod, + Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le (Nat.mod_lt _ (by omega)) (by omega))] /-! ## Saving and restoring registers -/ @@ -333,9 +336,72 @@ theorem restoreList_ok {rest : List Instr} (l : List (Reg × Nat)) : /-- The sizes the generic proofs support, checked for each hash function by `decide`. -/ structure Dims (P : Params) : Prop where + B : P.B = 64 ∨ P.B = 128 + L : 0 < P.L ∧ P.L ≤ 16 N : 0 < P.N ∧ P.N ≤ 64 so : P.so % 4 = 0 ∧ P.so ≤ 256 enc : encodable (BitVec.ofNat 32 P.N) = true + /-- The immediates the code compares and masks with. -/ + encB : encodable (BitVec.ofNat 32 P.B) = true ∧ encodable (BitVec.ofNat 32 (P.B - 1)) = true ∧ + encodable (BitVec.ofNat 32 (P.B - P.L)) = true ∧ encodable (BitVec.ofNat 32 (P.L - 1)) = true + +section +variable {P : Params} + +theorem Dims.pos (hd : Dims P) : 0 < P.B := by rcases hd.B with h | h <;> omega + +theorem Dims.le (hd : Dims P) : 64 ≤ P.B ∧ P.B ≤ 128 := by rcases hd.B with h | h <;> omega + +/-- The shift count of `direct`, `fill` and `finalize`. -/ +theorem Dims.lg (hd : Dims P) : 1 ≤ Nat.log2 P.B ∧ Nat.log2 P.B ≤ 31 ∧ 2 ^ Nat.log2 P.B = P.B := by + rcases hd.B with h | h <;> rw [h] + · rw [show (64 : Nat) = 2 ^ 6 from rfl, Nat.log2_two_pow]; decide + · rw [show (128 : Nat) = 2 ^ 7 from rfl, Nat.log2_two_pow]; decide + +/-- A block size divides `2³²`. -/ +theorem Dims.mod (hd : Dims P) (h l : Nat) : (h * 2 ^ 32 + l) % P.B = l % P.B := by + rcases hd.B with e | e <;> rw [e] <;> omega + +/-- A block size divides `2⁶⁴`. -/ +theorem Dims.mod64 (hd : Dims P) (n : Nat) : n % 2 ^ 64 % P.B = n % P.B := by + rcases hd.B with e | e <;> rw [e] <;> omega + +theorem Dims.div_eq_zero (hd : Dims P) {a : Nat} : a / P.B = 0 ↔ a < P.B := by + rcases hd.B with e | e <;> rw [e] <;> omega + +theorem shrB (hd : Dims P) {a : Nat} (h : a < 2 ^ 32) : + BitVec.ofNat 32 a >>> Nat.log2 P.B = BitVec.ofNat 32 (a / P.B) := by + rw [ofNat_shr h, hd.lg.2.2] + +/-- Whether `a >>> log₂ B` is zero. -/ +theorem cmp0_shrB (hd : Dims P) {a : Nat} (h : a < 2 ^ 32) : + (BitVec.ofNat 32 a >>> Nat.log2 P.B - 0 == 0) = decide (a < P.B) := by + rw [shrB hd h, cmp0 (Nat.lt_of_le_of_lt (Nat.div_le_self _ _) h)] + exact decide_eq_decide.mpr hd.div_eq_zero + +theorem andB (hd : Dims P) (x : BitVec 32) : + x &&& BitVec.ofNat 32 (P.B - 1) = BitVec.ofNat 32 (x.toNat % P.B) := by + have := hd.lg + have e := and_pow_sub_one x (n := Nat.log2 P.B) (by omega) + rwa [this.2.2] at e + +theorem op2_shrB (hd : Dims P) {s : State} {r : Reg} : + (Op2.shifted r .lsr (Nat.log2 P.B)).eval s = some (s.gpr r >>> Nat.log2 P.B) := + op2_lsr ⟨hd.lg.1, hd.lg.2.1⟩ + +theorem ofNat_shlB (hd : Dims P) {a : Nat} (h : P.B * a < 2 ^ 32) : + BitVec.ofNat 32 a <<< Nat.log2 P.B = BitVec.ofNat 32 (P.B * a) := by + have := hd.pos + have : a ≤ P.B * a := Nat.le_mul_of_pos_left a this + apply BitVec.eq_of_toNat_eq + rw [BitVec.toNat_shiftLeft, BitVec.toNat_ofNat, BitVec.toNat_ofNat, Nat.shiftLeft_eq, hd.lg.2.2, + Nat.mod_eq_of_lt (show a < 2 ^ 32 by omega), Nat.mul_comm, Nat.mod_eq_of_lt h] + +theorem op2_shlB (hd : Dims P) {s : State} {r : Reg} : + (Op2.shifted r .lsl (Nat.log2 P.B)).eval s = some (s.gpr r <<< Nat.log2 P.B) := + op2_lsl ⟨hd.lg.1, hd.lg.2.1⟩ + +end /-! ## Saving the caller's registers -/ @@ -423,18 +489,18 @@ low word in `r2`). -/ def count (s : State) : BitVec 64 := s.gpr .r3 ++ s.gpr .r2 section -variable {P : Params} (H : Md 64 P.N 8) +variable {P : Params} (H : Md P.B P.N P.L) /-- The contract of the compression function: updates the hash value at `r0` with the `r2` blocks at `r1`, with scratch space `r3` (`so` bytes). -/ def compressK : Contract isa where pre s := let state : Region := ⟨State.addr (s.gpr .r0), P.N⟩ - let blocks : Region := ⟨State.addr (s.gpr .r1), 64 * (s.gpr .r2).toNat⟩ + let blocks : Region := ⟨State.addr (s.gpr .r1), P.B * (s.gpr .r2).toNat⟩ let scratch : Region := ⟨State.addr (s.gpr .r3), P.so⟩ s.rd = [blocks] ∧ s.wr = [state, scratch] ∧ state.Disjoint scratch ∧ blocks.Disjoint state ∧ blocks.Disjoint scratch ∧ - (s.gpr .r0).toNat + P.N ≤ 2 ^ 32 ∧ (s.gpr .r1).toNat + 64 * (s.gpr .r2).toNat ≤ 2 ^ 32 ∧ + (s.gpr .r0).toNat + P.N ≤ 2 ^ 32 ∧ (s.gpr .r1).toNat + P.B * (s.gpr .r2).toNat ≤ 2 ^ 32 ∧ (s.gpr .r3).toNat + P.so ≤ 2 ^ 32 post s s' := H.stateAt s'.mem (State.addr (s.gpr .r0)) = @@ -449,14 +515,14 @@ def compressK : Contract isa where that message followed by the `len` bytes at `data`. -/ def updK : Contract isa where pre s := - let state : Region := ⟨State.addr (s.gpr .r0), P.N + 64⟩ + let state : Region := ⟨State.addr (s.gpr .r0), P.N + P.B⟩ let data : Region := ⟨State.addr (stackArg s 0), (stackArg s 1).toNat⟩ let scratch : Region := ⟨State.addr (stackArg s 2), P.so + 48⟩ let args : Region := ⟨stackArgAddr s 0, 12⟩ s.rd = [data, args] ∧ s.wr = [state, scratch] ∧ state.Disjoint scratch ∧ data.Disjoint state ∧ data.Disjoint scratch ∧ args.Disjoint state ∧ args.Disjoint scratch ∧ - (s.gpr .r0).toNat + (P.N + 64) ≤ 2 ^ 32 ∧ (stackArg s 0).toNat + (stackArg s 1).toNat ≤ 2 ^ 32 ∧ + (s.gpr .r0).toNat + (P.N + P.B) ≤ 2 ^ 32 ∧ (stackArg s 0).toNat + (stackArg s 1).toNat ≤ 2 ^ 32 ∧ (stackArg s 2).toNat + (P.so + 48) ≤ 2 ^ 32 ∧ s.sp.toNat + 12 ≤ 2 ^ 32 post s s' := ∀ iv m, H.Repr iv s.mem (State.addr (s.gpr .r0)) m → count s = BitVec.ofNat 64 m.length → H.Repr iv s'.mem (State.addr (s.gpr .r0)) @@ -469,14 +535,14 @@ def updK : Contract isa where `count` bytes, writes its final hash value to `out` (`N` bytes). -/ def finK : Contract isa where pre s := - let state : Region := ⟨State.addr (s.gpr .r0), P.N + 64⟩ + let state : Region := ⟨State.addr (s.gpr .r0), P.N + P.B⟩ let out : Region := ⟨State.addr (stackArg s 0), P.N⟩ let scratch : Region := ⟨State.addr (stackArg s 1), P.so + 48⟩ let args : Region := ⟨stackArgAddr s 0, 8⟩ s.rd = [args] ∧ s.wr = [state, out, scratch] ∧ state.Disjoint out ∧ state.Disjoint scratch ∧ out.Disjoint scratch ∧ args.Disjoint state ∧ args.Disjoint out ∧ args.Disjoint scratch ∧ - (s.gpr .r0).toNat + (P.N + 64) ≤ 2 ^ 32 ∧ (stackArg s 0).toNat + P.N ≤ 2 ^ 32 ∧ + (s.gpr .r0).toNat + (P.N + P.B) ≤ 2 ^ 32 ∧ (stackArg s 0).toNat + P.N ≤ 2 ^ 32 ∧ (stackArg s 1).toNat + (P.so + 48) ≤ 2 ^ 32 ∧ s.sp.toNat + 8 ≤ 2 ^ 32 post s s' := ∀ iv m, H.Repr iv s.mem (State.addr (s.gpr .r0)) m → H.lenOk m.length → count s = BitVec.ofNat 64 m.length → bytesAt s'.mem (State.addr (stackArg s 0)) P.N = H.hash iv m @@ -489,25 +555,26 @@ end /-! ## What each hash function's own code must do -/ /-- The length field and the digest: `P.len` stores the length field for the -byte count in `r4:r5` at `r0 + N + 56`, and `P.out` writes the digest of the -hash value at `r0` to `r6`; both write only `r9`. -/ -structure Shape {P : Params} (H : Md 64 P.N 8) : Prop where - len : ∀ s : State, (s.gpr .r0).toNat + (P.N + 64) ≤ 2 ^ 32 → - InRegions s.wr (State.addr (s.gpr .r0) + BitVec.ofNat 64 (P.N + 56)) 8 → +byte count in `r4:r5` at `r0 + N + B - L`, writing only `r9`, and `P.out` +writes the digest of the hash value at `r0` to `r6`, writing only `r9` and +`r10`. -/ +structure Shape {P : Params} (H : Md P.B P.N P.L) : Prop where + len : ∀ s : State, (s.gpr .r0).toNat + (P.N + P.B) ≤ 2 ^ 32 → + InRegions s.wr (State.addr (s.gpr .r0) + BitVec.ofNat 64 (P.N + (P.B - P.L))) P.L → WP isa (.block P.len) s fun s' => (∀ r, r ≠ .r9 → s'.gpr r = s.gpr r) ∧ s'.rd = s.rd ∧ s'.wr = s.wr ∧ s'.sp = s.sp ∧ - s'.mem = writeBytes s.mem (State.addr (s.gpr .r0) + BitVec.ofNat 64 (P.N + 56)) + s'.mem = writeBytes s.mem (State.addr (s.gpr .r0) + BitVec.ofNat 64 (P.N + (P.B - P.L))) (H.lenOf (s.gpr .r5 ++ s.gpr .r4)) out : ∀ s : State, (s.gpr .r0).toNat + P.N ≤ 2 ^ 32 → (s.gpr .r6).toNat + P.N ≤ 2 ^ 32 → InRegions (s.rd ++ s.wr) (State.addr (s.gpr .r0)) P.N → InRegions s.wr (State.addr (s.gpr .r6)) P.N → Region.Disjoint ⟨State.addr (s.gpr .r0), P.N⟩ ⟨State.addr (s.gpr .r6), P.N⟩ → - WP isa (.block P.out) s fun s' => (∀ r, r ≠ .r9 → s'.gpr r = s.gpr r) ∧ s'.rd = s.rd ∧ + WP isa (.block P.out) s fun s' => (∀ r, r ≠ .r9 → r ≠ .r10 → s'.gpr r = s.gpr r) ∧ s'.rd = s.rd ∧ s'.wr = s.wr ∧ s'.sp = s.sp ∧ s'.mem = writeBytes s.mem (State.addr (s.gpr .r6)) (H.digest (H.stateAt s.mem (State.addr (s.gpr .r0)))) /-- What `compressAt` needs of the compression function it calls: that it is correct, makes no calls, and never writes `r0` or `r3`. -/ -structure CalleeOk {P : Params} (H : Md 64 P.N 8) (code : Prog isa) : Prop where +structure CalleeOk {P : Params} (H : Md P.B P.N P.L) (code : Prog isa) : Prop where verified : ∀ s, (compressK H).pre s → ∃ t s', Exec isa code s t s' ∧ abiPreserved s s' ∧ (compressK H).post s s' noCalls : code.noCalls = true @@ -526,15 +593,15 @@ theorem setsN_r7 (s : State) : SetsN (.mov .r2 (.reg .r7)) s (s.gpr .r7) := fun /-- Compressing the `k` blocks at `r1` (their number set in `r2` by `n`) into the hash value at `r0`, with scratch space at `r3`. -/ -theorem compressWith_ok {P : Params} {H : Md 64 P.N 8} {n : Instr} {s : State} {v : BitVec 32} +theorem compressWith_ok {P : Params} {H : Md P.B P.N P.L} {n : Instr} {s : State} {v : BitVec 32} (hn : SetsN n s v) {k : Nat} (hkv : v.toNat = k) {name : String} {code : Prog isa} (hf : CalleeOk H code) {st scr src : BitVec 32} (h0 : s.gpr .r0 = st) (h3 : s.gpr .r3 = scr) (h1 : s.gpr .r1 = src) - (f₀ : st.toNat + P.N ≤ 2 ^ 32) (f₁ : src.toNat + 64 * k ≤ 2 ^ 32) (f₃ : scr.toNat + P.so ≤ 2 ^ 32) + (f₀ : st.toNat + P.N ≤ 2 ^ 32) (f₁ : src.toNat + P.B * k ≤ 2 ^ 32) (f₃ : scr.toNat + P.so ≤ 2 ^ 32) (d₁ : Region.Disjoint ⟨State.addr st, P.N⟩ ⟨State.addr scr, P.so⟩) - (d₂ : Region.Disjoint ⟨State.addr src, 64 * k⟩ ⟨State.addr st, P.N⟩) - (d₃ : Region.Disjoint ⟨State.addr src, 64 * k⟩ ⟨State.addr scr, P.so⟩) - (hc : Covers [⟨State.addr src, 64 * k⟩, ⟨State.addr st, P.N⟩, ⟨State.addr scr, P.so⟩] (s.rd ++ s.wr)) + (d₂ : Region.Disjoint ⟨State.addr src, P.B * k⟩ ⟨State.addr st, P.N⟩) + (d₃ : Region.Disjoint ⟨State.addr src, P.B * k⟩ ⟨State.addr scr, P.so⟩) + (hc : Covers [⟨State.addr src, P.B * k⟩, ⟨State.addr st, P.N⟩, ⟨State.addr scr, P.so⟩] (s.rd ++ s.wr)) (hw : Covers [⟨State.addr st, P.N⟩, ⟨State.addr scr, P.so⟩] s.wr) {Q : State → Prop} (hQ : ∀ s', s'.rd = s.rd → s'.wr = s.wr → (∀ r ∈ preserved, r ≠ .lr → s'.gpr r = s.gpr r) → s'.gpr .r0 = st → s'.gpr .r3 = scr → s'.sp = s.sp → @@ -555,7 +622,7 @@ theorem compressWith_ok {P : Params} {H : Md 64 P.N 8} {n : Instr} {s : State} { have e3 : s₁.gpr .r3 = scr := by rw [u₁.other _ (by decide), h3] have c : ∀ r, r ∉ linkRegs → s₁.callEntry.gpr r = s₁.gpr r := fun r h => State.callEntry_gpr s₁ h refine WP.call (k := compressK H) hf.verified - (rd := [⟨State.addr src, 64 * k⟩]) (wr := [⟨State.addr st, P.N⟩, ⟨State.addr scr, P.so⟩]) ?_ ?_ ?_ ?_ + (rd := [⟨State.addr src, P.B * k⟩]) (wr := [⟨State.addr st, P.N⟩, ⟨State.addr scr, P.so⟩]) ?_ ?_ ?_ ?_ hf.noCalls · simp only [compressK, State.withRegions_gpr, State.withRegions_rd, State.withRegions_wr, c _ (show Reg.r0 ∉ linkRegs by decide), c _ (show Reg.r1 ∉ linkRegs by decide), @@ -577,22 +644,24 @@ theorem compressWith_ok {P : Params} {H : Md 64 P.N 8} {n : Instr} {s : State} { /-- Compressing the block at `r1` into the hash value at `r0`, with scratch space at `r3`. -/ -theorem compressAt_ok {P : Params} {H : Md 64 P.N 8} {name : String} {code : Prog isa} (hf : CalleeOk H code) +theorem compressAt_ok {P : Params} {H : Md P.B P.N P.L} {name : String} {code : Prog isa} (hf : CalleeOk H code) {s : State} {st scr src : BitVec 32} (h0 : s.gpr .r0 = st) (h3 : s.gpr .r3 = scr) (h1 : s.gpr .r1 = src) - (f₀ : st.toNat + P.N ≤ 2 ^ 32) (f₁ : src.toNat + 64 ≤ 2 ^ 32) (f₃ : scr.toNat + P.so ≤ 2 ^ 32) + (f₀ : st.toNat + P.N ≤ 2 ^ 32) (f₁ : src.toNat + P.B ≤ 2 ^ 32) (f₃ : scr.toNat + P.so ≤ 2 ^ 32) (d₁ : Region.Disjoint ⟨State.addr st, P.N⟩ ⟨State.addr scr, P.so⟩) - (d₂ : Region.Disjoint ⟨State.addr src, 64⟩ ⟨State.addr st, P.N⟩) - (d₃ : Region.Disjoint ⟨State.addr src, 64⟩ ⟨State.addr scr, P.so⟩) - (hc : Covers [⟨State.addr src, 64⟩, ⟨State.addr st, P.N⟩, ⟨State.addr scr, P.so⟩] (s.rd ++ s.wr)) + (d₂ : Region.Disjoint ⟨State.addr src, P.B⟩ ⟨State.addr st, P.N⟩) + (d₃ : Region.Disjoint ⟨State.addr src, P.B⟩ ⟨State.addr scr, P.so⟩) + (hc : Covers [⟨State.addr src, P.B⟩, ⟨State.addr st, P.N⟩, ⟨State.addr scr, P.so⟩] (s.rd ++ s.wr)) (hw : Covers [⟨State.addr st, P.N⟩, ⟨State.addr scr, P.so⟩] s.wr) {Q : State → Prop} (hQ : ∀ s', s'.rd = s.rd → s'.wr = s.wr → (∀ r ∈ preserved, r ≠ .lr → s'.gpr r = s.gpr r) → s'.gpr .r0 = st → s'.gpr .r3 = scr → s'.sp = s.sp → Frame [⟨State.addr st, P.N⟩, ⟨State.addr scr, P.so⟩] s.mem s'.mem → H.stateAt s'.mem (State.addr st) = H.compress (H.stateAt s.mem (State.addr st)) (H.blockAt s.mem (State.addr src)) → Q s') : - WP isa (compressAt name code) s Q := - compressWith_ok (setsN_one s) (k := 1) rfl hf h0 h3 h1 f₀ f₁ f₃ d₁ d₂ d₃ hc hw + WP isa (compressAt name code) s Q := by + have e : P.B * 1 = P.B := Nat.mul_one _ + refine compressWith_ok (setsN_one s) (k := 1) rfl hf h0 h3 h1 f₀ (by rw [e]; exact f₁) f₃ d₁ + (by rw [e]; exact d₂) (by rw [e]; exact d₃) (by rw [e]; exact hc) hw fun s' hrd hwr hcs h0' h3' hsp hf' hs => hQ s' hrd hwr hcs h0' h3' hsp hf' (by rw [hs, Md.compressBlocks_one]) end VG.Proof.MdStream.Arm diff --git a/lean/VerifiedGarbage/Proof/MdStream/Arm/Finalize.lean b/lean/VerifiedGarbage/Proof/MdStream/Arm/Finalize.lean index ec4bab9e3..24e01eb0b 100644 --- a/lean/VerifiedGarbage/Proof/MdStream/Arm/Finalize.lean +++ b/lean/VerifiedGarbage/Proof/MdStream/Arm/Finalize.lean @@ -33,7 +33,7 @@ abbrev scr : BitVec 32 := stackArg s₀ 1 abbrev stA : Addr := State.addr (st s₀) abbrev outA : Addr := State.addr (out s₀) abbrev scA : Addr := State.addr (scr s₀) -abbrev stR : Region := ⟨stA s₀, P.N + 64⟩ +abbrev stR : Region := ⟨stA s₀, P.N + P.B⟩ abbrev outR : Region := ⟨outA s₀, P.N⟩ abbrev scR : Region := ⟨scA s₀, P.so + 48⟩ abbrev argR : Region := ⟨stackArgAddr s₀ 0, 8⟩ @@ -47,7 +47,7 @@ def Saved (m : Mem) : Prop := end section -variable {P : Params} (H : Md 64 P.N 8) (s₀ : State) +variable {P : Params} (H : Md P.B P.N P.L) (s₀ : State) /-- The messages the initial state represents, from `iv`. -/ def R₀ (iv : H.HV) (m : List Byte) : Prop := @@ -56,13 +56,14 @@ def R₀ (iv : H.HV) (m : List Byte) : Prop := /-- The final hash value, if `n` bytes are buffered in a block that is not the last. -/ def Fin1 (mem : Mem) (n : Nat) (m : List Byte) : H.HV := H.compress (H.compress (H.stateAt mem (stA s₀)) - (H.parse fun t => (bytesAt mem (buf P s₀) n ++ List.replicate (64 - n) 0).getD t 0)) - (H.parse fun t => (List.replicate 56 0 ++ H.lenBytes m.length).getD t 0) + (H.parse fun t => (bytesAt mem (buf P s₀) n ++ List.replicate (P.B - n) 0).getD t 0)) + (H.parse fun t => (List.replicate (P.B - P.L) 0 ++ H.lenBytes m.length).getD t 0) /-- The final hash value, if `n` bytes are buffered in the last block. -/ def Fin0 (mem : Mem) (n : Nat) (m : List Byte) : H.HV := H.compress (H.stateAt mem (stA s₀)) - (H.parse fun t => (bytesAt mem (buf P s₀) n ++ List.replicate (56 - n) 0 ++ H.lenBytes m.length).getD t 0) + (H.parse fun t => (bytesAt mem (buf P s₀) n ++ List.replicate (P.B - P.L - n) 0 ++ + H.lenBytes m.length).getD t 0) end @@ -75,12 +76,12 @@ structure Pre (P : Params) (s₀ : State) : Prop where a_st : (argR s₀).Disjoint (stR P s₀) a_out : (argR s₀).Disjoint (outR P s₀) a_scr : (argR s₀).Disjoint (scR P s₀) - st_fit : (st s₀).toNat + (P.N + 64) ≤ 2 ^ 32 + st_fit : (st s₀).toNat + (P.N + P.B) ≤ 2 ^ 32 out_fit : (out s₀).toNat + P.N ≤ 2 ^ 32 scr_fit : (scr s₀).toNat + (P.so + 48) ≤ 2 ^ 32 sp_fit : s₀.sp.toNat + 8 ≤ 2 ^ 32 -theorem pre_of {P : Params} {H : Md 64 P.N 8} {s₀ : State} (h : (finK H).pre s₀) : Pre P s₀ := by +theorem pre_of {P : Params} {H : Md P.B P.N P.L} {s₀ : State} (h : (finK H).pre s₀) : Pre P s₀ := by obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ := h exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ @@ -98,34 +99,46 @@ structure Common (P : Params) (s₀ : State) (s : State) : Prop where frame : Frame [stR P s₀, scR P s₀] s₀.mem s.mem saved : Saved P s₀ s.mem +/-- Where the zeros padding a block end: at the end of the buffer if `k = 1` +(the block is not the last one), otherwise where the length field starts. -/ +def lim (P : Params) (k : Nat) : Nat := if k = 1 then P.B else P.B - P.L + +theorem lim_one (P : Params) : lim P 1 = P.B := by simp [lim] + +theorem lim_zero (P : Params) : lim P 0 = P.B - P.L := by simp [lim] + +theorem lim_le (P : Params) (k : Nat) : lim P k ≤ P.B := by + unfold lim; split <;> omega + /-- The loop invariant: `k = 1` while the block being padded is not the last one, with `n` bytes of it buffered. -/ -structure LInv {P : Params} (H : Md 64 P.N 8) (s₀ : State) (k n : Nat) (s : State) : Prop +structure LInv {P : Params} (H : Md P.B P.N P.L) (s₀ : State) (k n : Nat) (s : State) : Prop extends Common P s₀ s where k_le : k ≤ 1 - n_le : n ≤ 56 + 8 * k + n_le : n ≤ lim P k r7 : s.gpr .r7 = BitVec.ofNat 32 n r8 : s.gpr .r8 = BitVec.ofNat 32 k hash : ∀ iv m, R₀ H s₀ iv m → H.lenOk m.length → H.hash iv m = H.digest (if k = 1 then Fin1 H s₀ s.mem n m else Fin0 H s₀ s.mem n m) /-- All blocks are compressed. -/ -def Done {P : Params} (H : Md 64 P.N 8) (s₀ : State) (s : State) : Prop := +def Done {P : Params} (H : Md P.B P.N P.L) (s₀ : State) (s : State) : Prop := Common P s₀ s ∧ ∀ iv m, R₀ H s₀ iv m → H.lenOk m.length → H.hash iv m = H.digest (H.stateAt s.mem (stA s₀)) def keepRegs : List Reg := [.r0, .r3, .r6, .r4, .r5, .lr] section -variable {P : Params} {H : Md 64 P.N 8} +variable {P : Params} {H : Md P.B P.N P.L} -theorem cnt_mod (s₀ : State) : cnt s₀ % 64 = (s₀.gpr .r2).toNat % 64 := by +theorem cnt_mod (hd : Dims P) (s₀ : State) : cnt s₀ % P.B = (s₀.gpr .r2).toNat % P.B := by simp only [cnt, count] rw [BitVec.toNat_append, ← Nat.shiftLeft_add_eq_or_of_lt (s₀.gpr .r2).isLt, Nat.shiftLeft_eq] - omega + exact hd.mod _ _ -theorem R₀.length {s₀ : State} {iv : H.HV} {m : List Byte} (h : R₀ H s₀ iv m) : cnt s₀ % 64 = m.length % 64 := by +theorem R₀.length (hd : Dims P) {s₀ : State} {iv : H.HV} {m : List Byte} (h : R₀ H s₀ iv m) : + cnt s₀ % P.B = m.length % P.B := by rw [cnt, h.2, BitVec.toNat_ofNat] - omega + exact hd.mod64 _ theorem buf_add (s₀ : State) (n : Nat) : buf P s₀ + BitVec.ofNat 64 n = stA s₀ + BitVec.ofNat 64 (P.N + n) := add_ofNat _ _ _ @@ -160,10 +173,11 @@ theorem saved_sub (hd : Dims P) {s₀ : State} {p : Reg × Nat} (hp : p ∈ save /-- Writing buffer bytes `[n, n + |xs|)` keeps `Common`'s memory facts. -/ theorem Common.writeBuf (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {s : State} (h : Common P s₀ s) {n : Nat} - {xs : List Byte} (hn : n + xs.length ≤ 64) : + {xs : List Byte} (hn : n + xs.length ≤ P.B) : Frame [stR P s₀] s.mem (writeBytes s.mem (buf P s₀ + BitVec.ofNat 64 n) xs) ∧ Frame [stR P s₀, scR P s₀] s₀.mem (writeBytes s.mem (buf P s₀ + BitVec.ofNat 64 n) xs) ∧ Saved P s₀ (writeBytes s.mem (buf P s₀ + BitVec.ofNat 64 n) xs) := by + have hBle := hd.le have := hd.N have hf : Frame [stR P s₀] s.mem (writeBytes s.mem (buf P s₀ + BitVec.ofNat 64 n) xs) := by refine writeBytes_frame _ _ _ ?_ @@ -178,7 +192,7 @@ theorem Common.writeBuf (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {s : Stat exact hp.st_scr.symm.sub_left (saved_sub hd hp') /-- Byte `k` of the buffer, addressed as `[r0 + k, #N]`. -/ -theorem buf_addr {s₀ : State} (hp : Pre P s₀) {k : Nat} (hk : k < 64) : +theorem buf_addr {s₀ : State} (hp : Pre P s₀) {k : Nat} (hk : k < P.B) : State.addr (st s₀ + BitVec.ofNat 32 k + BitVec.ofNat 32 P.N) = buf P s₀ + BitVec.ofNat 64 k := by have := hp.st_fit rw [BitVec.add_assoc, ← BitVec.ofNat_add, addr_off (by omega), add_ofNat, Nat.add_comm] @@ -204,12 +218,13 @@ def zeroBody (P : Params) : List Instr := [.dp .add .r1 .r0 (.reg .r7), .strb .r12 .r1 P.N, .dp .add .r7 .r7 (.imm 1), .subs .r9 .r9 (.imm 1)] section -variable {P : Params} {H : Md 64 P.N 8} +variable {P : Params} {H : Md P.B P.N P.L} theorem zero_step (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {sI : State} (hC : Common P s₀ sI) - {n lim j : Nat} (hlim : lim ≤ 64) (hj : j < lim - n) {s : State} (h : Zero P s₀ sI n lim j s) : + {n lim j : Nat} (hlim : lim ≤ P.B) (hj : j < lim - n) {s : State} (h : Zero P s₀ sI n lim j s) : WP isa (.block (zeroBody P)) s fun s' => Zero P s₀ sI n lim (j + 1) s' ∧ s'.z = (BitVec.ofNat 32 (lim - n - (j + 1)) == 0) := by + have hBle := hd.le have := hd.N; have := hp.st_fit have hr0 : s.gpr .r0 = st s₀ := by rw [h.keep _ (by simp [keepRegs]), hC.r0] have hout : InRegions s.wr (buf P s₀ + BitVec.ofNat 64 n + BitVec.ofNat 64 j) 1 := by @@ -241,9 +256,10 @@ theorem zero_step (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {sI : State} (h show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega), Nat.sub_sub, Nat.sub_sub] theorem zero_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {sI : State} (hC : Common P s₀ sI) {n lim : Nat} - (hlim : lim ≤ 64) (hn : n ≤ lim) {s : State} (h : Zero P s₀ sI n lim 0 s) + (hlim : lim ≤ P.B) (hn : n ≤ lim) {s : State} (h : Zero P s₀ sI n lim 0 s) (hz : s.z = decide (lim - n = 0)) : WP isa (.ite .eq (.block []) (.loop (.block (zeroBody P)) .ne)) s (Zero P s₀ sI n lim (lim - n)) := by + have hBle := hd.le refine WP.ite (decide (lim - n = 0)) (by show VG.Arm.eval .eq s = _; rw [eval_eq, hz]) (fun hb => ?_) (fun hb => ?_) · simp only [decide_eq_true_eq] at hb @@ -271,14 +287,15 @@ theorem compress_buf (hd : Dims P) {name : String} {code : Prog isa} (hf : Calle (hQ : ∀ s', Common P s₀ s' → (∀ r ∈ preserved, r ≠ .lr → s'.gpr r = s.gpr r) → H.stateAt s'.mem (stA s₀) = H.compress (H.stateAt s.mem (stA s₀)) (H.blockAt s.mem (buf P s₀)) → Q s') : WP isa (compressAt name code) s Q := by + have hBle := hd.le have hst := hp.st_fit; have hsc := hp.scr_fit; have := hd.N; have := hd.so have eN : Region.Sub ⟨stA s₀, P.N⟩ (stR P s₀) := Region.sub_prefix (by omega) have eso : Region.Sub ⟨scA s₀, P.so⟩ (scR P s₀) := Region.sub_prefix (by omega) have ha : State.addr (st s₀ + BitVec.ofNat 32 P.N) = buf P s₀ := addr_off (by omega) - have eb : Region.Sub ⟨buf P s₀, 64⟩ (stR P s₀) := sub_offset (by omega) (by omega) - have d₂ : Region.Disjoint ⟨State.addr (st s₀ + BitVec.ofNat 32 P.N), 64⟩ ⟨stA s₀, P.N⟩ := by + have eb : Region.Sub ⟨buf P s₀, P.B⟩ (stR P s₀) := sub_offset (by omega) (by omega) + have d₂ : Region.Disjoint ⟨State.addr (st s₀ + BitVec.ofNat 32 P.N), P.B⟩ ⟨stA s₀, P.N⟩ := by rw [ha]; exact Offset.disjoint_base _ (Nat.le_refl _) (by omega) - have d₃ : Region.Disjoint ⟨State.addr (st s₀ + BitVec.ofNat 32 P.N), 64⟩ ⟨scA s₀, P.so⟩ := by + have d₃ : Region.Disjoint ⟨State.addr (st s₀ + BitVec.ofNat 32 P.N), P.B⟩ ⟨scA s₀, P.so⟩ := by rw [ha]; exact (hp.st_scr.sub_left eb).sub_right eso refine compressAt_ok hf hC.r0 hC.r3 hr1 (by omega) (by rw [BitVec.toNat_add, BitVec.toNat_ofNat]; omega) (by omega) ((hp.st_scr.sub_left eN).sub_right eso) d₂ d₃ @@ -316,12 +333,12 @@ theorem compress_buf (hd : Dims P) {name : String} {code : Prog isa} (hf : Calle · exact Offset.disjoint_base _ this.1 (by omega_using [this.2, hd.so.2]) /-- The loop's postcondition for one iteration. -/ -def Step {P : Params} (H : Md 64 P.N 8) (s₀ : State) (k : Nat) (s : State) : Prop := +def Step {P : Params} (H : Md P.B P.N P.L) (s₀ : State) (k : Nat) (s : State) : Prop := (VG.Arm.eval .eq s = some false ∧ Done H s₀ s) ∨ (VG.Arm.eval .eq s = some true ∧ k = 1 ∧ LInv H s₀ 0 0 s) theorem body_eq (name : String) (code : Prog isa) : finalizeBody P name code = - .seq (.block [.mov .r9 (.imm 64), .cmp .r8 (.imm 0)]) - (.seq (.ite .eq (.block [.mov .r9 (.imm 56)]) (.block [])) + .seq (.block [.mov .r9 (.imm (BitVec.ofNat 32 P.B)), .cmp .r8 (.imm 0)]) + (.seq (.ite .eq (.block [.mov .r9 (.imm (BitVec.ofNat 32 (P.B - P.L)))]) (.block [])) (.seq (.block [.mov .r12 (.imm 0), .subs .r9 .r9 (.reg .r7)]) (.seq (.ite .eq (.block []) (.loop (.block (zeroBody P)) .ne)) (.seq (.block [.cmp .r8 (.imm 0)]) @@ -332,34 +349,35 @@ theorem body_eq (name : String) (code : Prog isa) : finalizeBody P name code = theorem body_ok (hd : Dims P) (hs : Shape H) {name : String} {code : Prog isa} (hf : CalleeOk H code) {s₀ : State} (hp : Pre P s₀) {k n : Nat} {s : State} (h : LInv H s₀ k n s) : WP isa (finalizeBody P name code) s (Step H s₀ k) := by - have hk := h.k_le; have hn := h.n_le; have hst := hp.st_fit; have := hd.N + have hk := h.k_le; have hn := h.n_le; have hst := hp.st_fit; have := hd.N; have := hd.le; have := hd.L + have hlim := lim_le P k have hC := h.toCommon rw [body_eq] - -- `r9 := 64` or `56`: the end of the zeros. - refine WP.seq (wp_mov (op2_imm (by decide)) fun s₁ u₁ => wp_cmp (op2_imm (by decide)) fun s₂ f₂ z₂ => + -- `r9 := B` or `B - L`: the end of the zeros. + refine WP.seq (wp_mov (op2_imm hd.encB.1) fun s₁ u₁ => wp_cmp (op2_imm (by decide)) fun s₂ f₂ z₂ => WP.block_nil ?_) have hz₂ : s₂.z = decide (k = 0) := by rw [z₂, u₁.other _ (by decide), h.r8, cmp0 (by omega)] - refine WP.seq (WP.mono (Q := fun (s₃ : State) => s₃.gpr .r9 = BitVec.ofNat 32 (56 + 8 * k) ∧ + refine WP.seq (WP.mono (Q := fun (s₃ : State) => s₃.gpr .r9 = BitVec.ofNat 32 (lim P k) ∧ (∀ r, r ≠ .r9 → s₃.gpr r = s.gpr r) ∧ s₃.mem = s.mem ∧ s₃.rd = s.rd ∧ s₃.wr = s.wr ∧ s₃.sp = s.sp) ?_ fun s₃ ⟨h9₃, g₃, m₃, rd₃, wr₃, sp₃⟩ => ?_) · refine WP.ite (decide (k = 0)) (by show VG.Arm.eval .eq s₂ = _; rw [eval_eq, hz₂]) (fun hb => ?_) (fun hb => ?_) · simp only [decide_eq_true_eq] at hb; subst hb - refine wp_mov (op2_imm (by decide)) fun s₃ u₃ => WP.block_nil ⟨by rw [u₃.gpr]; rfl, fun r hr => ?_, + refine wp_mov (op2_imm hd.encB.2.2.1) fun s₃ u₃ => WP.block_nil ⟨by rw [u₃.gpr, lim_zero], fun r hr => ?_, by rw [u₃.mem, f₂.mem, u₁.mem], by rw [u₃.rd, f₂.rd, u₁.rd], by rw [u₃.wr, f₂.wr, u₁.wr], by rw [u₃.sp, f₂.sp, u₁.sp]⟩ rw [u₃.other r hr, f₂.gpr, u₁.other r hr] · simp only [decide_eq_false_iff_not] at hb - refine WP.block_nil ⟨by rw [f₂.gpr, u₁.gpr, show k = 1 by omega]; rfl, fun r hr => ?_, + refine WP.block_nil ⟨by rw [f₂.gpr, u₁.gpr, show k = 1 by omega, lim_one], fun r hr => ?_, by rw [f₂.mem, u₁.mem], by rw [f₂.rd, u₁.rd], by rw [f₂.wr, u₁.wr], by rw [f₂.sp, u₁.sp]⟩ rw [f₂.gpr, u₁.other r hr] -- Zero the rest of the buffer, up to `lim`. refine WP.seq (wp_mov (op2_imm (by decide)) fun s₄ u₄ => wp_subs (op2_reg _ _) fun s₅ u₅ z₅ => WP.block_nil ?_) - have h9₅ : s₅.gpr .r9 = BitVec.ofNat 32 (56 + 8 * k - n) := by + have h9₅ : s₅.gpr .r9 = BitVec.ofNat 32 (lim P k - n) := by rw [u₅.gpr, u₄.other _ (by decide), h9₃, u₄.other _ (by decide), g₃ _ (by decide), h.r7, sub_ofNat (by omega)] - have hZ : Zero P s₀ s n (56 + 8 * k) 0 s₅ := by + have hZ : Zero P s₀ s n (lim P k) 0 s₅ := by refine ⟨Nat.zero_le _, fun r hr => ?_, by rw [u₅.rd, u₄.rd, rd₃], by rw [u₅.wr, u₄.wr, wr₃], by rw [u₅.sp, u₄.sp, sp₃], ?_, ?_, by rw [h9₅, Nat.sub_zero], ?_⟩ · have : r ≠ .r9 ∧ r ≠ .r12 := by @@ -369,10 +387,10 @@ theorem body_ok (hd : Dims P) (hs : Shape H) {name : String} {code : Prog isa} ( · rw [u₅.other _ (by decide), u₄.gpr] · rw [u₅.other _ (by decide), u₄.other _ (by decide), g₃ _ (by decide), h.r7, Nat.add_zero] · rw [u₅.mem, u₄.mem, m₃, List.replicate_zero, writeBytes_nil] - have hz₅ : s₅.z = decide (56 + 8 * k - n - 0 = 0) := by + have hz₅ : s₅.z = decide (lim P k - n - 0 = 0) := by rw [z₅, ← u₅.gpr, h9₅, ofNat_beq_zero (by omega), Nat.sub_zero] refine WP.seq (WP.mono (zero_ok hd hp hC (by omega) hn hZ hz₅) fun s₆ hZ₆ => ?_) - obtain ⟨hf₆, hfr₆, hsv₆⟩ := hC.writeBuf hd hp (n := n) (xs := List.replicate (56 + 8 * k - n) 0) + obtain ⟨hf₆, hfr₆, hsv₆⟩ := hC.writeBuf hd hp (n := n) (xs := List.replicate (lim P k - n) 0) (by simp only [List.length_replicate]; omega) have hC₆ : Common P s₀ s₆ := ⟨hZ₆.rd.trans hC.rd, hZ₆.wr.trans hC.wr, by rw [hZ₆.keep _ (by simp [keepRegs]), hC.r0], @@ -385,8 +403,8 @@ theorem body_ok (hd : Dims P) (hs : Shape H) {name : String} {code : Prog isa} ( intro i hi rw [buf_add] exact writeBytes_before _ _ _ (by omega) (by simp only [List.length_replicate]; omega) - have hby₆ : bytesAt s₆.mem (buf P s₀) (56 + 8 * k) = - bytesAt s.mem (buf P s₀) n ++ List.replicate (56 + 8 * k - n) 0 := by + have hby₆ : bytesAt s₆.mem (buf P s₀) (lim P k) = + bytesAt s.mem (buf P s₀) n ++ List.replicate (lim P k - n) 0 := by rw [hZ₆.mem, ← bytesAt_writeBytes _ _ _ _ (by simp only [List.length_replicate]; omega)] congr 1; simp only [List.length_replicate]; omega have h8₆ : s₆.gpr .r8 = BitVec.ofNat 32 k := by rw [hZ₆.keep _ (by simp [keepRegs]), h.r8] @@ -397,19 +415,20 @@ theorem body_ok (hd : Dims P) (hs : Shape H) {name : String} {code : Prog isa} ( have hz₇ : s₇.z = decide (k = 0) := by rw [z₇, h8₆, cmp0 (by omega)] refine WP.seq (WP.mono (Q := fun (s₈ : State) => Common P s₀ s₈ ∧ s₈.gpr .r8 = BitVec.ofNat 32 k ∧ H.stateAt s₈.mem (stA s₀) = H.stateAt s.mem (stA s₀) ∧ - ∀ iv m, R₀ H s₀ iv m → H.lenOk m.length → bytesAt s₈.mem (buf P s₀) 64 = bytesAt s.mem (buf P s₀) n ++ - (if k = 1 then List.replicate (64 - n) 0 else List.replicate (56 - n) 0 ++ H.lenBytes m.length)) ?_ + ∀ iv m, R₀ H s₀ iv m → H.lenOk m.length → bytesAt s₈.mem (buf P s₀) P.B = bytesAt s.mem (buf P s₀) n ++ + (if k = 1 then List.replicate (P.B - n) 0 else List.replicate (P.B - P.L - n) 0 ++ H.lenBytes m.length)) ?_ fun s₈ ⟨hC₈, h8₈, hst₈, hby₈⟩ => ?_) · refine WP.ite (decide (k = 0)) (by show VG.Arm.eval .eq s₇ = _; rw [eval_eq, hz₇]) (fun hb => ?_) (fun hb => ?_) · simp only [decide_eq_true_eq] at hb; subst hb - have hout : InRegions s₇.wr (State.addr (s₇.gpr .r0) + BitVec.ofNat 64 (P.N + 56)) 8 := + have hout : InRegions s₇.wr (State.addr (s₇.gpr .r0) + BitVec.ofNat 64 (P.N + (P.B - P.L))) P.L := ⟨stR P s₀, by simp [hC₇.wr, hp.wr], by rw [hC₇.r0]; exact contains_offset (by omega) (by omega)⟩ refine WP.mono (hs.len s₇ (by rw [hC₇.r0]; omega) hout) fun s₈ ⟨g₈, rd₈, wr₈, sp₈, m₈⟩ => ?_ - have e : stA s₀ + BitVec.ofNat 64 (P.N + 56) = buf P s₀ + BitVec.ofNat 64 56 := (buf_add _ _).symm + have e : stA s₀ + BitVec.ofNat 64 (P.N + (P.B - P.L)) = buf P s₀ + BitVec.ofNat 64 (P.B - P.L) := + (buf_add _ _).symm rw [hC₇.r0, hC₇.r5, hC₇.r4, e, f₇.mem] at m₈ have hlen := H.lenOf_length (s₀.gpr .r3 ++ s₀.gpr .r2) - obtain ⟨-, hfr, hsv⟩ := hC₆.writeBuf hd hp (n := 56) (xs := H.lenOf (s₀.gpr .r3 ++ s₀.gpr .r2)) + obtain ⟨-, hfr, hsv⟩ := hC₆.writeBuf hd hp (n := P.B - P.L) (xs := H.lenOf (s₀.gpr .r3 ++ s₀.gpr .r2)) (by omega) refine ⟨⟨rd₈.trans hC₇.rd, wr₈.trans hC₇.wr, by rw [g₈ _ (by decide), hC₇.r0], by rw [g₈ _ (by decide), hC₇.r3], by rw [g₈ _ (by decide), hC₇.r6], @@ -423,14 +442,16 @@ theorem body_ok (hd : Dims P) (hs : Shape H) {name : String} {code : Prog isa} ( exact writeBytes_before _ _ _ (by omega) (by omega) · simp only [show ¬ ((0 : Nat) = 1) by decide, ite_false] rw [show s₀.gpr .r3 ++ s₀.gpr .r2 = count s₀ from rfl, hm.2, H.lenOf_eq _ hok] at m₈ - have e := bytesAt_writeBytes s₆.mem (buf P s₀) 56 (H.lenBytes m.length) + have e := bytesAt_writeBytes s₆.mem (buf P s₀) (P.B - P.L) (H.lenBytes m.length) (by rw [H.lenBytes_length]; omega) - rw [H.lenBytes_length] at e + rw [H.lenBytes_length, Nat.sub_add_cancel (by omega)] at e + rw [lim_zero] at hby₆ rw [m₈, e, hby₆, List.append_assoc] · simp only [decide_eq_false_iff_not] at hb have hk1 : k = 1 := by omega subst hk1 refine WP.block_nil ⟨hC₇, h8₇, by rw [f₇.mem, hst₆], fun iv m _ _ => ?_⟩ + rw [lim_one] at hby₆ rw [f₇.mem, hby₆]; simp -- Compress the block. refine WP.seq (wp_add (op2_imm hd.enc) fun s₉ u₉ => WP.block_nil ?_) @@ -441,7 +462,7 @@ theorem body_ok (hd : Dims P) (hs : Shape H) {name : String} {code : Prog isa} ( rw [cs₁₁ _ (by decide) (by decide), u₉.other _ (by decide), h8₈] have hblk : ∀ iv m, R₀ H s₀ iv m → H.lenOk m.length → H.blockAt s₉.mem (buf P s₀) = H.parse fun t => (bytesAt s.mem (buf P s₀) n ++ - (if k = 1 then List.replicate (64 - n) 0 else List.replicate (56 - n) 0 ++ H.lenBytes m.length)).getD t 0 := by + (if k = 1 then List.replicate (P.B - n) 0 else List.replicate (P.B - P.L - n) 0 ++ H.lenBytes m.length)).getD t 0 := by intro iv m hm hok apply H.parse_congr intro t ht @@ -458,7 +479,7 @@ theorem body_ok (hd : Dims P) (hs : Shape H) {name : String} {code : Prog isa} ( have hst : ∀ iv m, R₀ H s₀ iv m → H.lenOk m.length → H.stateAt s₁₃.mem (stA s₀) = H.compress (H.stateAt s.mem (stA s₀)) (H.parse fun t => (bytesAt s.mem (buf P s₀) n ++ - (if k = 1 then List.replicate (64 - n) 0 else List.replicate (56 - n) 0 ++ H.lenBytes m.length)).getD t 0) := by + (if k = 1 then List.replicate (P.B - n) 0 else List.replicate (P.B - P.L - n) 0 ++ H.lenBytes m.length)).getD t 0) := by intro iv m hm hok rw [u₁₃.mem, u₁₂.mem, hst₁₁, u₉.mem, hst₈, ← hblk iv m hm hok, u₉.mem] by_cases hk1 : k = 1 @@ -481,12 +502,13 @@ end /-- The prologue after saving. -/ def prologue (P : Params) : List Instr := - [.mov .r4 (.reg .r2), .mov .r5 (.reg .r3), .mov .r3 (.reg .r12), .ldrSp .r6 0, .dp .and .r7 .r4 (.imm 63), + [.mov .r4 (.reg .r2), .mov .r5 (.reg .r3), .mov .r3 (.reg .r12), .ldrSp .r6 0, + .dp .and .r7 .r4 (.imm (BitVec.ofNat 32 (P.B - 1))), .mov .r12 (.imm 0x80), .dp .add .r1 .r0 (.reg .r7), .strb .r12 .r1 P.N, .dp .add .r7 .r7 (.imm 1), - .dp .add .r8 .r7 (.imm 7), .mov .r8 (.shifted .r8 .lsr 6)] + .dp .add .r8 .r7 (.imm (BitVec.ofNat 32 (P.L - 1))), .mov .r8 (.shifted .r8 .lsr (Nat.log2 P.B))] section -variable {P : Params} {H : Md 64 P.N 8} +variable {P : Params} {H : Md P.B P.N P.L} theorem finalize_eq (name : String) (code : Prog isa) : finalize P name code = .seq (.block (([.ldrSp .r12 4] : List Instr) ++ save P .r12 ++ prologue P)) @@ -509,9 +531,9 @@ theorem arg_sub {s₀ : State} (hp : Pre P s₀) {k : Nat} (hk : k < 2) : theorem prologue_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) : WP isa (.block (([.ldrSp .r12 4] : List Instr) ++ save P .r12 ++ prologue P)) s₀ - fun s => ∃ k, LInv H s₀ k (cnt s₀ % 64 + 1) s := by - have hr : cnt s₀ % 64 < 64 := Nat.mod_lt _ (by omega) - have hsc := hp.scr_fit; have hst := hp.st_fit; have := hd.so; have := hd.N + fun s => ∃ k, LInv H s₀ k (cnt s₀ % P.B + 1) s := by + have hr : cnt s₀ % P.B < P.B := Nat.mod_lt _ hd.pos + have hsc := hp.scr_fit; have hst := hp.st_fit; have := hd.so; have := hd.N; have := hd.le; have := hd.L simp only [List.cons_append, List.nil_append] refine wp_ldrSp (a := stackArgAddr s₀ 1) (by decide) rfl (arg_in hp (by decide)) fun s₁ u₁ => ?_ have h12 : s₁.gpr .r12 = scr s₀ := u₁.gpr @@ -524,7 +546,7 @@ theorem prologue_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) : refine wp_mov (op2_reg _ _) fun s₃ u₃ => wp_mov (op2_reg _ _) fun s₄ u₄ => wp_mov (op2_reg _ _) fun s₅ u₅ => ?_ refine wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) (by rw [u₅.sp, u₄.sp, u₃.sp, sp₂, u₁.sp]; rfl) (by rw [u₅.rd, u₅.wr, u₄.rd, u₄.wr, u₃.rd, u₃.wr, rd₂, wr₂, u₁.rd, u₁.wr]; exact arg_in hp (by decide)) - fun s₆ u₆ => wp_and (op2_imm (by decide)) fun s₇ u₇ => ?_ + fun s₆ u₆ => wp_and (op2_imm hd.encB.2.1) fun s₇ u₇ => ?_ have hm₇ : s₇.mem = s₂.mem := by rw [u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem] have g₇ : ∀ r, r ∉ [Reg.r3, .r4, .r5, .r6, .r7, .r12] → s₇.gpr r = s₀.gpr r := fun r hr => by simp only [List.mem_cons, List.not_mem_nil, or_false, not_or] at hr @@ -547,24 +569,24 @@ theorem prologue_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) : · rw [hm₇, m₂, u₁.mem, h12, saveMem_saved hd _ _ _ p hp', u₁.other _ (Ne.symm ?_)] simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' rcases hp' with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> dsimp only <;> decide - have hr7 : s₇.gpr .r7 = BitVec.ofNat 32 (cnt s₀ % 64) := by + have hr7 : s₇.gpr .r7 = BitVec.ofNat 32 (cnt s₀ % P.B) := by rw [u₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, g₂, - u₁.other _ (by decide), and63, cnt_mod] + u₁.other _ (by decide), andB hd, cnt_mod hd] -- The `0x80` byte. - have hout : InRegions s₇.wr (buf P s₀ + BitVec.ofNat 64 (cnt s₀ % 64)) 1 := by + have hout : InRegions s₇.wr (buf P s₀ + BitVec.ofNat 64 (cnt s₀ % P.B)) 1 := by refine ⟨stR P s₀, by simp [hC₇.wr, hp.wr], ?_⟩ rw [buf_add]; exact contains_offset (by omega) (by omega) refine wp_mov (op2_imm (by decide)) fun s₈ u₈ => wp_add (op2_reg _ _) fun s₉ u₉ => - wp_strb (a := buf P s₀ + BitVec.ofNat 64 (cnt s₀ % 64)) (by omega) ?_ + wp_strb (a := buf P s₀ + BitVec.ofNat 64 (cnt s₀ % P.B)) (by omega) ?_ (by rw [u₉.wr, u₈.wr]; exact hout) fun s₁₀ g₁₀ => ?_ · rw [u₉.gpr, u₈.other _ (by decide), u₈.other _ (by decide), hC₇.r0, hr7, buf_addr hp hr] - obtain ⟨-, hfr, hsv⟩ := hC₇.writeBuf hd hp (n := cnt s₀ % 64) (xs := [0x80]) (by simp; omega) - have hm₁₀ : s₁₀.mem = writeBytes s₇.mem (buf P s₀ + BitVec.ofNat 64 (cnt s₀ % 64)) [0x80] := by + obtain ⟨-, hfr, hsv⟩ := hC₇.writeBuf hd hp (n := cnt s₀ % P.B) (xs := [0x80]) (by simp; omega) + have hm₁₀ : s₁₀.mem = writeBytes s₇.mem (buf P s₀ + BitVec.ofNat 64 (cnt s₀ % P.B)) [0x80] := by rw [g₁₀.mem, u₉.mem, u₈.mem, u₉.other _ (by decide), u₈.gpr, ← List.nil_append [(0x80 : Byte)], writeBytes_snoc _ _ _ _ (by simp), writeBytes_nil] simp - refine wp_add (op2_imm (by decide)) fun s₁₁ u₁₁ => wp_add (op2_imm (by decide)) fun s₁₂ u₁₂ => - wp_mov (op2_lsr (by decide)) fun s₁₃ u₁₃ => WP.block_nil ?_ + refine wp_add (op2_imm (by decide)) fun s₁₁ u₁₁ => wp_add (op2_imm hd.encB.2.2.2) fun s₁₂ u₁₂ => + wp_mov (op2_shrB hd) fun s₁₃ u₁₃ => WP.block_nil ?_ have keep : ∀ r, r ≠ .r7 → r ≠ .r8 → r ≠ .r12 → r ≠ .r1 → s₁₃.gpr r = s₇.gpr r := fun r h1 h2 h3 h4 => by rw [u₁₃.other r h2, u₁₂.other r h2, u₁₁.other r h1, g₁₀.gpr, u₉.other r h4, u₈.other r h3] @@ -579,52 +601,52 @@ theorem prologue_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) : by rw [keep _ (by decide) (by decide) (by decide) (by decide), hC₇.r5], by rw [u₁₃.sp, u₁₂.sp, u₁₁.sp, g₁₀.sp, u₉.sp, u₈.sp, hC₇.sp], by rw [hm₁₃, hm₁₀]; exact hfr, by rw [hm₁₃, hm₁₀]; exact hsv⟩ - have hr7' : s₁₃.gpr .r7 = BitVec.ofNat 32 (cnt s₀ % 64 + 1) := by + have hr7' : s₁₃.gpr .r7 = BitVec.ofNat 32 (cnt s₀ % P.B + 1) := by rw [u₁₃.other _ (by decide), u₁₂.other _ (by decide), u₁₁.gpr, g₁₀.gpr, u₉.other _ (by decide), u₈.other _ (by decide), hr7, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, ← BitVec.ofNat_add] - have hr8 : s₁₃.gpr .r8 = BitVec.ofNat 32 ((cnt s₀ % 64 + 8) / 64) := by + have hr8 : s₁₃.gpr .r8 = BitVec.ofNat 32 ((cnt s₀ % P.B + 1 + (P.L - 1)) / P.B) := by rw [u₁₃.gpr, u₁₂.gpr, u₁₁.gpr, g₁₀.gpr, u₉.other _ (by decide), u₈.other _ (by decide), hr7, - show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, show (7 : BitVec 32) = BitVec.ofNat 32 7 from rfl, - ← BitVec.ofNat_add, ← BitVec.ofNat_add, shr6 (by omega)] + show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, ← BitVec.ofNat_add, ← BitVec.ofNat_add, shrB hd (by omega)] -- The facts about the buffer. - have hbytes : ∀ iv m, R₀ H s₀ iv m → bytesAt s₁₃.mem (buf P s₀) (cnt s₀ % 64 + 1) = - Md.rest 64 m ++ [0x80] := by + have hbytes : ∀ iv m, R₀ H s₀ iv m → bytesAt s₁₃.mem (buf P s₀) (cnt s₀ % P.B + 1) = + Md.rest P.B m ++ [0x80] := by intro iv m hm - have e := bytesAt_writeBytes s₇.mem (buf P s₀) (cnt s₀ % 64) [0x80] (by simp; omega) + have := Nat.mod_lt m.length hd.pos + have e := bytesAt_writeBytes s₇.mem (buf P s₀) (cnt s₀ % P.B) [0x80] (by simp; omega) simp only [List.length_singleton] at e rw [hm₁₃, hm₁₀, e, hm₇] refine congrArg (· ++ [0x80]) ?_ - rw [hm.length] + rw [hm.length hd] refine (bytesAt_congr ?_).trans hm.1.2 intro i hi have := frame_bytes hframe (R := stR P s₀) (by simpa using hp.st_scr) - (by show P.N + 64 ≤ 2 ^ 64; omega) (i := P.N + i) (by show P.N + i < P.N + 64; omega) + (by show P.N + P.B ≤ 2 ^ 64; omega) (i := P.N + i) (by show P.N + i < P.N + P.B; omega) rwa [← buf_add] at this have hstate : H.stateAt s₁₃.mem (stA s₀) = H.stateAt s₀.mem (stA s₀) := by apply H.stateAt_congr intro i hi rw [hm₁₃, hm₁₀, buf_add, writeBytes_before _ _ _ (by omega) (by simp; omega), hm₇] exact frame_bytes hframe (R := stR P s₀) (by simpa using hp.st_scr) - (by show P.N + 64 ≤ 2 ^ 64; omega) (by show i < P.N + 64; omega) - by_cases hb : 57 ≤ cnt s₀ % 64 + 1 - · have hk : (cnt s₀ % 64 + 8) / 64 = 1 := by omega - refine ⟨1, hC₁₃, (Nat.le_refl _), by omega, hr7', by rw [hr8, hk], fun iv m hm _ => ?_⟩ + (by show P.N + P.B ≤ 2 ^ 64; omega) (by show i < P.N + P.B; omega) + by_cases hb : P.B ≤ cnt s₀ % P.B + P.L + · have hk : (cnt s₀ % P.B + 1 + (P.L - 1)) / P.B = 1 := Nat.div_eq_of_lt_le (by omega) (by omega) + refine ⟨1, hC₁₃, (Nat.le_refl _), by rw [lim_one]; omega, hr7', by rw [hr8, hk], fun iv m hm _ => ?_⟩ simp only [↓reduceIte] - rw [Md.hash_two H (by decide) (by decide) (by rw [← hm.length]; omega), Fin1, hbytes iv m hm, hstate, - hm.1.1, ← hm.length, show 64 - (cnt s₀ % 64 + 1) = 64 - 1 - cnt s₀ % 64 by omega] - · have hk : (cnt s₀ % 64 + 8) / 64 = 0 := by omega - refine ⟨0, hC₁₃, by omega, by omega, hr7', by rw [hr8, hk], fun iv m hm _ => ?_⟩ + rw [Md.hash_two H hd.pos (by omega) (by rw [← hm.length hd]; omega), Fin1, hbytes iv m hm, hstate, + hm.1.1, ← hm.length hd, show P.B - (cnt s₀ % P.B + 1) = P.B - 1 - cnt s₀ % P.B by omega] + · have hk : (cnt s₀ % P.B + 1 + (P.L - 1)) / P.B = 0 := Nat.div_eq_of_lt (by omega) + refine ⟨0, hC₁₃, by omega, by rw [lim_zero]; omega, hr7', by rw [hr8, hk], fun iv m hm _ => ?_⟩ simp only [show ((0 : Nat) = 1) = False by decide, ite_false] - rw [Md.hash_one H (by decide) (by rw [← hm.length]; omega), Fin0, hbytes iv m hm, hstate, hm.1.1, - ← hm.length, show 56 - (cnt s₀ % 64 + 1) = 64 - 8 - 1 - cnt s₀ % 64 by omega] + rw [Md.hash_one H hd.pos (by rw [← hm.length hd]; omega), Fin0, hbytes iv m hm, hstate, hm.1.1, + ← hm.length hd, show P.B - P.L - (cnt s₀ % P.B + 1) = P.B - P.L - 1 - cnt s₀ % P.B by omega] /-! ## Output and epilogue -/ /-- The epilogue's postcondition. -/ -def Post (P : Params) (H : Md 64 P.N 8) (s₀ s' : State) : Prop := abiPreserved s₀ s' ∧ (finK H).post s₀ s' +def Post (P : Params) (H : Md P.B P.N P.L) (s₀ s' : State) : Prop := abiPreserved s₀ s' ∧ (finK H).post s₀ s' theorem epilogue_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {sD : State} (hD : Done H s₀ sD) {s : State} - (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) (hkeep : ∀ r, r ≠ .r9 → s.gpr r = sD.gpr r) + (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) (hkeep : ∀ r, r ≠ .r9 → r ≠ .r10 → s.gpr r = sD.gpr r) (hsp : s.sp = sD.sp) (hm : s.mem = writeBytes sD.mem (outA s₀) (H.digest (H.stateAt sD.mem (stA s₀)))) : WP isa (.block (restore P)) s (Post P H s₀) := by have := hd.N; have := hd.so @@ -634,7 +656,7 @@ theorem epilogue_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {sD : State} writeBytes_frame _ _ _ (by rw [show outA s₀ = outA s₀ + BitVec.ofNat 64 0 by simp] exact contains_offset (by omega) (by omega)) - refine restore_ok hd (scr := scr s₀) (by rw [hkeep _ (by decide), hC.r3]) hp.scr_fit + refine restore_ok hd (scr := scr s₀) (by rw [hkeep _ (by decide) (by decide), hC.r3]) hp.scr_fit (fun d hd₁ hd₂ => ⟨scR P s₀, by simp [hrd, hwr, hp.wr], contains_offset (by omega) (by omega)⟩) s₀.gpr (fun p hp' => ?_) fun s' hs _ hmem _ _ hsp' => ⟨⟨preserved_of hs, by rw [hsp', hsp, hC.sp]⟩, ?_⟩ · rw [hm, ← hC.saved p hp'] @@ -669,7 +691,7 @@ theorem correct (hd : Dims P) (hs : Shape H) {name : String} {code : Prog isa} ( fun s ⟨g, rd, wr, sp, m⟩ => epilogue_ok hd hp hD (rd.trans hC.rd) (wr.trans hC.wr) g sp (by rw [m, hC.r6, hC.r0]) · refine ⟨stR P s₀, by simp [hC.rd, hC.wr, hp.wr, hp.rd], ?_⟩ - rw [hC.r0]; simpa using contains_offset (base := stA s₀) (off := 0) (n := P.N) (len := P.N + 64) + rw [hC.r0]; simpa using contains_offset (base := stA s₀) (off := 0) (n := P.N) (len := P.N + P.B) (by omega) (by omega) · refine ⟨outR P s₀, by simp [hC.wr, hp.wr], ?_⟩ rw [hC.r6]; simpa using contains_offset (base := outA s₀) (off := 0) (n := P.N) (len := P.N) @@ -685,11 +707,11 @@ end points at the state, and the 8 bytes of stack arguments are public, the second one pointing at the scratch space. -/ def τ₀ (P : Params) : VG.Arm.Taint.T := - { regs := .ofList [.r0, .r2, .r3], flags := false, lens := [P.N + 64, P.N, P.so + 48], bases := [(.r0, 0)], + { regs := .ofList [.r0, .r2, .r3], flags := false, lens := [P.N + P.B, P.N, P.so + 48], bases := [(.r0, 0)], argLen := 8, argBases := [(4, 2)] } section -variable {P : Params} {H : Md 64 P.N 8} +variable {P : Params} {H : Md P.B P.N P.L} theorem wf₀ {s : State} (h : (finK H).pre s) : VG.Arm.Taint.Wf (τ₀ P) s := by have hp := pre_of h @@ -747,14 +769,15 @@ def satBase : State where /-- A state satisfying the precondition. -/ def sat (P : Params) : State := - { satBase with wr := [⟨0x1000, P.N + 64⟩, ⟨0x2000, P.N⟩, ⟨0x3000, P.so + 48⟩] } + { satBase with wr := [⟨0x1000, P.N + P.B⟩, ⟨0x2000, P.N⟩, ⟨0x3000, P.so + 48⟩] } /-- `finalize` is verified, given that it is constant time (which the taint analysis proves of each hash function's code). -/ -theorem verified {P : Params} {H : Md 64 P.N 8} (hd : Dims P) (hs : Shape H) {name : String} +theorem verified {P : Params} {H : Md P.B P.N P.L} (hd : Dims P) (hs : Shape H) {name : String} {code : Prog isa} (hf : CalleeOk H code) (hct : ConstantTime isa (finK H).pre (finK H).pub (finalize P name code)) : Verified Arm.target (finalize P name code) (finK H) := by + have hBle := hd.le have := hd.N; have := hd.so refine ⟨fun s hs' => ?_, hct, ?_⟩ · obtain ⟨t, s', he, h⟩ := correct hd hs hf (pre_of hs') diff --git a/lean/VerifiedGarbage/Proof/MdStream/Arm/Update.lean b/lean/VerifiedGarbage/Proof/MdStream/Arm/Update.lean index cbe888ef6..765bf2f4a 100644 --- a/lean/VerifiedGarbage/Proof/MdStream/Arm/Update.lean +++ b/lean/VerifiedGarbage/Proof/MdStream/Arm/Update.lean @@ -33,7 +33,7 @@ abbrev scr : BitVec 32 := stackArg s₀ 2 abbrev stA : Addr := State.addr (st s₀) abbrev dA : Addr := State.addr (dp s₀) abbrev scA : Addr := State.addr (scr s₀) -abbrev stR : Region := ⟨stA s₀, P.N + 64⟩ +abbrev stR : Region := ⟨stA s₀, P.N + P.B⟩ abbrev dR : Region := ⟨dA s₀, len s₀⟩ abbrev scR : Region := ⟨scA s₀, P.so + 48⟩ abbrev argR : Region := ⟨stackArgAddr s₀ 0, 12⟩ @@ -49,7 +49,7 @@ def Saved (m : Mem) : Prop := end /-- The messages the initial state represents, from `iv`. -/ -def R₀ {P : Params} (H : Md 64 P.N 8) (s₀ : State) (iv : H.HV) (m : List Byte) : Prop := +def R₀ {P : Params} (H : Md P.B P.N P.L) (s₀ : State) (iv : H.HV) (m : List Byte) : Prop := H.Repr iv s₀.mem (stA s₀) m ∧ count s₀ = BitVec.ofNat 64 m.length structure Pre (P : Params) (s₀ : State) : Prop where @@ -60,27 +60,27 @@ structure Pre (P : Params) (s₀ : State) : Prop where d_scr : (dR s₀).Disjoint (scR P s₀) a_st : (argR s₀).Disjoint (stR P s₀) a_scr : (argR s₀).Disjoint (scR P s₀) - st_fit : (st s₀).toNat + (P.N + 64) ≤ 2 ^ 32 + st_fit : (st s₀).toNat + (P.N + P.B) ≤ 2 ^ 32 d_fit : (dp s₀).toNat + len s₀ ≤ 2 ^ 32 scr_fit : (scr s₀).toNat + (P.so + 48) ≤ 2 ^ 32 sp_fit : s₀.sp.toNat + 12 ≤ 2 ^ 32 section -variable {P : Params} {H : Md 64 P.N 8} +variable {P : Params} {H : Md P.B P.N P.L} theorem pre_of {s₀ : State} (h : (updK H).pre s₀) : Pre P s₀ := by obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11⟩ := h exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11⟩ -theorem cnt_mod (s₀ : State) : cnt s₀ % 64 = (s₀.gpr .r2).toNat % 64 := by +theorem cnt_mod (hd : Dims P) (s₀ : State) : cnt s₀ % P.B = (s₀.gpr .r2).toNat % P.B := by simp only [cnt, count] rw [BitVec.toNat_append, ← Nat.shiftLeft_add_eq_or_of_lt (s₀.gpr .r2).isLt, Nat.shiftLeft_eq] - omega + exact hd.mod _ _ -theorem R₀.length {s₀ : State} {iv : H.HV} {m : List Byte} (h : R₀ H s₀ iv m) : - cnt s₀ % 64 = m.length % 64 := by +theorem R₀.length (hd : Dims P) {s₀ : State} {iv : H.HV} {m : List Byte} (h : R₀ H s₀ iv m) : + cnt s₀ % P.B = m.length % P.B := by rw [cnt, h.2, BitVec.toNat_ofNat] - omega + exact hd.mod64 _ theorem len_lt (s₀ : State) : len s₀ < 2 ^ 32 := (stackArg s₀ 1).isLt @@ -105,31 +105,31 @@ structure Common (P : Params) (s₀ : State) (c : Nat) (s : State) : Prop where /-- The loop invariant: the state represents the message followed by the first `c` bytes of data. -/ -structure Inv {P : Params} (H : Md 64 P.N 8) (s₀ : State) (c : Nat) (s : State) : Prop +structure Inv {P : Params} (H : Md P.B P.N P.L) (s₀ : State) (c : Nat) (s : State) : Prop extends Common P s₀ c s where - r4 : s.gpr .r4 = BitVec.ofNat 32 ((cnt s₀ + c) % 64) + r4 : s.gpr .r4 = BitVec.ofNat 32 ((cnt s₀ + c) % P.B) repr : ∀ iv m, R₀ H s₀ iv m → H.Repr iv s.mem (stA s₀) (m ++ (D s₀).take c) /-- `k ≥ 1` whole blocks are ready at `r1` (the buffer, or the data), and compressing them absorbs the first `c` bytes of data. -/ -structure Pending {P : Params} (H : Md 64 P.N 8) (s₀ : State) (c k : Nat) (s : State) : Prop +structure Pending {P : Params} (H : Md P.B P.N P.L) (s₀ : State) (c k : Nat) (s : State) : Prop extends Common P s₀ c s where r4 : s.gpr .r4 = 0 r7 : s.gpr .r7 = BitVec.ofNat 32 k k_pos : 0 < k - mod : (cnt s₀ + c) % 64 = 0 + mod : (cnt s₀ + c) % P.B = 0 src : (s.gpr .r1 = st s₀ + BitVec.ofNat 32 P.N ∧ k = 1) ∨ - ∃ c₀, s.gpr .r1 = dp s₀ + BitVec.ofNat 32 c₀ ∧ c₀ + 64 * k ≤ len s₀ + ∃ c₀, s.gpr .r1 = dp s₀ + BitVec.ofNat 32 c₀ ∧ c₀ + P.B * k ≤ len s₀ repr : ∀ iv m, R₀ H s₀ iv m → ∀ mem', H.stateAt mem' (stA s₀) = H.compressBlocks (H.stateAt s.mem (stA s₀)) s.mem (State.addr (s.gpr .r1)) k → H.Repr iv mem' (stA s₀) (m ++ (D s₀).take c) /-- All the data is absorbed, and nothing is pending. -/ -def Done {P : Params} (H : Md 64 P.N 8) (s₀ : State) (s : State) : Prop := +def Done {P : Params} (H : Md P.B P.N P.L) (s₀ : State) (s : State) : Prop := Inv H s₀ (len s₀) s ∧ s.gpr .r7 = 0 section -variable {P : Params} {H : Md 64 P.N 8} +variable {P : Params} {H : Md P.B P.N P.L} theorem Common.of_gpr {s₀ : State} {c : Nat} {s s' : State} (h : Common P s₀ c s) (hg : ∀ r ∈ [Reg.r0, .r3, .r5, .r6, .lr], s'.gpr r = s.gpr r) @@ -192,11 +192,10 @@ theorem Common.data {s₀ : State} (hp : Pre P s₀) {c : Nat} {s : State} (h : exact frame_bytes h.frame (R := dR s₀) (by simpa using ⟨hp.d_st, hp.d_scr⟩) (by have := len_lt s₀; show len s₀ ≤ 2 ^ 64; omega) hi -theorem length_mid (s₀ : State) {iv : H.HV} {m : List Byte} (hm : R₀ H s₀ iv m) {c : Nat} (hc : c ≤ len s₀) : - (m ++ (D s₀).take c).length % 64 = (cnt s₀ + c) % 64 := by - have := hm.length +theorem length_mid (hd : Dims P) (s₀ : State) {iv : H.HV} {m : List Byte} (hm : R₀ H s₀ iv m) {c : Nat} + (hc : c ≤ len s₀) : (m ++ (D s₀).take c).length % P.B = (cnt s₀ + c) % P.B := by simp only [List.length_append, List.length_take, D_length, Nat.min_eq_left hc] - omega + rw [Nat.add_mod, ← hm.length hd, ← Nat.add_mod] theorem take_add_data (s₀ : State) (c t : Nat) (m : List Byte) : m ++ (D s₀).take c ++ ((D s₀).drop c).take t = m ++ (D s₀).take (c + t) := by @@ -204,36 +203,40 @@ theorem take_add_data (s₀ : State) (c t : Nat) (m : List Byte) : /-! ## Compressing pending blocks -/ -theorem Pending.k_lt {s₀ : State} {c k : Nat} {s : State} (h : Pending H s₀ c k s) : k < 2 ^ 32 := by +theorem Pending.k_lt (hd : Dims P) {s₀ : State} {c k : Nat} {s : State} (h : Pending H s₀ c k s) : + k < 2 ^ 32 := by have := len_lt s₀ + have : k ≤ P.B * k := Nat.le_mul_of_pos_left k hd.pos rcases h.src with ⟨_, rfl⟩ | ⟨c₀, _, hc₀⟩ <;> omega theorem Pending.compress_ok (hd : Dims P) {name : String} {code : Prog isa} (hf : CalleeOk H code) {s₀ : State} (hp : Pre P s₀) {c k : Nat} {s : State} (h : Pending H s₀ c k s) : WP isa (compressN name code) s (Inv H s₀ c) := by + have hBle := hd.le have hst := hp.st_fit; have hdf := hp.d_fit; have hsc := hp.scr_fit have hk0 := h.k_pos - have := hd.N; have := hd.so + have hBk : k ≤ P.B * k := Nat.le_mul_of_pos_left k hd.pos + have := hd.N; have := hd.so; have := hd.le have eN : Region.Sub ⟨stA s₀, P.N⟩ (stR P s₀) := Region.sub_prefix (by omega) have eso : Region.Sub ⟨scA s₀, P.so⟩ (scR P s₀) := Region.sub_prefix (by omega) -- The block's address. - obtain ⟨hfit, hsub, hdisj⟩ : (s.gpr .r1).toNat + 64 * k ≤ 2 ^ 32 ∧ + obtain ⟨hfit, hsub, hdisj⟩ : (s.gpr .r1).toNat + P.B * k ≤ 2 ^ 32 ∧ (∃ R ∈ [stR P s₀, dR s₀], ∃ off, State.addr (s.gpr .r1) = R.base + BitVec.ofNat 64 off ∧ - off + 64 * k ≤ R.len) ∧ - Region.Disjoint ⟨State.addr (s.gpr .r1), 64 * k⟩ ⟨stA s₀, P.N⟩ ∧ - Region.Disjoint ⟨State.addr (s.gpr .r1), 64 * k⟩ ⟨scA s₀, P.so⟩ := by + off + P.B * k ≤ R.len) ∧ + Region.Disjoint ⟨State.addr (s.gpr .r1), P.B * k⟩ ⟨stA s₀, P.N⟩ ∧ + Region.Disjoint ⟨State.addr (s.gpr .r1), P.B * k⟩ ⟨scA s₀, P.so⟩ := by rcases h.src with ⟨h', rfl⟩ | ⟨c₀, h', hc₀⟩ · have ha : State.addr (s.gpr .r1) = stA s₀ + BitVec.ofNat 64 P.N := by rw [h', addr_off (by omega)] - have hs : Region.Sub ⟨State.addr (s.gpr .r1), 64 * 1⟩ (stR P s₀) := + have hs : Region.Sub ⟨State.addr (s.gpr .r1), P.B * 1⟩ (stR P s₀) := ha ▸ sub_offset (by omega) (by omega) refine ⟨by rw [h', BitVec.toNat_add, BitVec.toNat_ofNat]; omega, ⟨stR P s₀, by simp, P.N, ha, by simp⟩, ?_, (hp.st_scr.sub_left hs).sub_right eso⟩ rw [ha]; exact Offset.disjoint_base _ (Nat.le_refl _) (by omega) · have ha : State.addr (s.gpr .r1) = dA s₀ + BitVec.ofNat 64 c₀ := by rw [h', addr_off (by omega)] - have hs : Region.Sub ⟨State.addr (s.gpr .r1), 64 * k⟩ (dR s₀) := ha ▸ sub_offset (by omega) (by omega) + have hs : Region.Sub ⟨State.addr (s.gpr .r1), P.B * k⟩ (dR s₀) := ha ▸ sub_offset (by omega) (by omega) refine ⟨by rw [h', BitVec.toNat_add, BitVec.toNat_ofNat]; omega, ⟨dR s₀, by simp, c₀, ha, hc₀⟩, (hp.d_st.sub_left hs).sub_right eN, (hp.d_scr.sub_left hs).sub_right eso⟩ - have hk : (s.gpr .r7).toNat = k := by rw [h.r7, BitVec.toNat_ofNat, Nat.mod_eq_of_lt h.k_lt] + have hk : (s.gpr .r7).toNat = k := by rw [h.r7, BitVec.toNat_ofNat, Nat.mod_eq_of_lt (h.k_lt hd)] refine compressWith_ok (setsN_r7 s) hk hf h.r0 h.r3 rfl (by omega) hfit (by omega) ((hp.st_scr.sub_left eN).sub_right eso) hdisj.1 hdisj.2 ?_ ?_ fun s' hrd hwr hcs h0 h3 hsp hf' hstate => ?_ @@ -276,24 +279,18 @@ theorem Pending.compress_ok (hd : Dims P) {name : String} {code : Prog isa} (hf /-! ## Whole blocks straight from the data -/ -/-- `x <<< 6`, of a number whose product with 64 is below 2³². -/ -theorem ofNat_shl6 {a : Nat} (h : 64 * a < 2 ^ 32) : BitVec.ofNat 32 a <<< 6 = BitVec.ofNat 32 (64 * a) := by - apply BitVec.eq_of_toNat_eq - rw [BitVec.toNat_shiftLeft, BitVec.toNat_ofNat, BitVec.toNat_ofNat, Nat.shiftLeft_eq, - Nat.mod_eq_of_lt (show a < 2 ^ 32 by omega), Nat.mod_eq_of_lt h] - omega - -theorem direct_ok {s₀ : State} (hp : Pre P s₀) {c : Nat} {s : State} (hI : Inv H s₀ c s) - (hr : (cnt s₀ + c) % 64 = 0) (hl : 64 ≤ len s₀ - c) : - WP isa (.block direct) s (Pending H s₀ (c + 64 * ((len s₀ - c) / 64)) ((len s₀ - c) / 64)) := by - have hd := hp.d_fit +theorem direct_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {s : State} (hI : Inv H s₀ c s) + (hr : (cnt s₀ + c) % P.B = 0) (hl : P.B ≤ len s₀ - c) : + WP isa (.block (direct P)) s (Pending H s₀ (c + P.B * ((len s₀ - c) / P.B)) ((len s₀ - c) / P.B)) := by + have hBle := hd.le + have hdf := hp.d_fit have hlen := len_lt s₀ - generalize hq : (len s₀ - c) / 64 = q - have hq1 : 1 ≤ q := by omega - have hq2 : 64 * q ≤ len s₀ - c := by omega + have hq1 : 1 ≤ (len s₀ - c) / P.B := Nat.div_pos hl hd.pos + have hq2 : P.B * ((len s₀ - c) / P.B) ≤ len s₀ - c := Nat.mul_div_le _ _ + generalize hq : (len s₀ - c) / P.B = q at hq1 hq2 ⊢ unfold direct - refine wp_mov (op2_reg _ _) fun s₁ u₁ => wp_mov (op2_lsr (by decide)) fun s₂ u₂ => - wp_mov (op2_lsl (by decide)) fun s₃ u₃ => wp_add (op2_reg _ _) fun s₄ u₄ => + refine wp_mov (op2_reg _ _) fun s₁ u₁ => wp_mov (op2_shrB hd) fun s₂ u₂ => + wp_mov (op2_shlB hd) fun s₃ u₃ => wp_add (op2_reg _ _) fun s₄ u₄ => wp_sub (op2_reg _ _) fun s₅ u₅ => WP.block_nil ?_ have g : ∀ r, r ≠ .r1 → r ≠ .r7 → r ≠ .r12 → r ≠ .r5 → r ≠ .r6 → s₅.gpr r = s.gpr r := fun r h1 h2 h3 h4 h5 => by @@ -304,25 +301,26 @@ theorem direct_ok {s₀ : State} (hp : Pre P s₀) {c : Nat} {s : State} (hI : I u₁.gpr, hI.r5] have h7 : s₅.gpr .r7 = BitVec.ofNat 32 q := by rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.gpr, - u₁.other _ (by decide), hI.r6, shr6 (by omega), hq] - have h12 : s₃.gpr .r12 = BitVec.ofNat 32 (64 * q) := by - rw [u₃.gpr, u₂.gpr, u₁.other _ (by decide), hI.r6, shr6 (by omega), hq, ofNat_shl6 (by omega)] - have h12' : s₄.gpr .r12 = BitVec.ofNat 32 (64 * q) := by rw [u₄.other _ (by decide), h12] + u₁.other _ (by decide), hI.r6, shrB hd (by omega), hq] + have h12 : s₃.gpr .r12 = BitVec.ofNat 32 (P.B * q) := by + rw [u₃.gpr, u₂.gpr, u₁.other _ (by decide), hI.r6, shrB hd (by omega), hq, ofNat_shlB hd (by omega)] + have h12' : s₄.gpr .r12 = BitVec.ofNat 32 (P.B * q) := by rw [u₄.other _ (by decide), h12] refine ⟨⟨by omega, by rw [u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, hI.rd], by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, hI.wr], by rw [g _ (by decide) (by decide) (by decide) (by decide) (by decide), hI.r0], by rw [g _ (by decide) (by decide) (by decide) (by decide) (by decide), hI.r3], by rw [u₅.sp, u₄.sp, u₃.sp, u₂.sp, u₁.sp, hI.sp], ?_, ?_, by rw [m₅]; exact hI.frame, - by rw [m₅]; exact hI.saved⟩, ?_, h7, hq1, by omega, .inr ⟨c, h1, by omega⟩, ?_⟩ + by rw [m₅]; exact hI.saved⟩, ?_, h7, hq1, by rw [← Nat.add_assoc, Nat.add_mul_mod_self_left]; exact hr, + .inr ⟨c, h1, by omega⟩, ?_⟩ · rw [u₅.other _ (by decide), u₄.gpr, h12, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), hI.r5, BitVec.add_assoc, ← BitVec.ofNat_add] · rw [u₅.gpr, h12', u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), hI.r6, sub_ofNat (by omega), Nat.sub_sub] · rw [g _ (by decide) (by decide) (by decide) (by decide) (by decide), hI.r4, hr]; rfl · intro iv m hm mem' hs - have hmod := length_mid s₀ hm (c := c) (by omega) + have hmod := length_mid hd s₀ hm (c := c) (by omega) rw [← take_add_data] - refine H.repr_append_blocks (n := q) (by decide) (hI.repr iv m hm) (by rw [hmod, hr]) + refine H.repr_append_blocks (n := q) hd.pos (hI.repr iv m hm) (by rw [hmod, hr]) (by rw [List.length_take, List.length_drop, D_length]; omega) ?_ rw [hs, m₅, h1, addr_off (by omega)] apply H.compressBlocks_eq @@ -335,30 +333,30 @@ theorem direct_ok {s₀ : State} (hp : Pre P s₀) {c : Nat} {s : State} (hI : I section variable (P) (s₀ : State) (c : Nat) /-- Bytes in the buffer before this iteration. -/ -abbrev rr : Nat := (cnt s₀ + c) % 64 +abbrev rr : Nat := (cnt s₀ + c) % P.B /-- Bytes copied into the buffer in this iteration. -/ -abbrev tt : Nat := min (64 - rr s₀ c) (len s₀ - c) +abbrev tt : Nat := min (P.B - rr P s₀ c) (len s₀ - c) /-- Where they go. -/ -abbrev q : Addr := buf P s₀ + BitVec.ofNat 64 (rr s₀ c) +abbrev q : Addr := buf P s₀ + BitVec.ofNat 64 (rr P s₀ c) /-- The data copied. -/ -abbrev xs : List Byte := ((D s₀).drop c).take (tt s₀ c) +abbrev xs : List Byte := ((D s₀).drop c).take (tt P s₀ c) end -theorem rr_lt (s₀ : State) (c : Nat) : rr s₀ c < 64 := Nat.mod_lt _ (by omega) -theorem tt_le (s₀ : State) (c : Nat) : tt s₀ c ≤ len s₀ - c := Nat.min_le_right _ _ -theorem tt_le' (s₀ : State) (c : Nat) : tt s₀ c ≤ 64 - rr s₀ c := Nat.min_le_left _ _ -theorem rr_eq (s₀ : State) (c : Nat) : rr s₀ c = (cnt s₀ + c) % 64 := rfl -theorem tt_eq (s₀ : State) (c : Nat) : tt s₀ c = min (64 - rr s₀ c) (len s₀ - c) := rfl +theorem rr_lt (hd : Dims P) (s₀ : State) (c : Nat) : rr P s₀ c < P.B := Nat.mod_lt _ hd.pos +theorem tt_le (s₀ : State) (c : Nat) : tt P s₀ c ≤ len s₀ - c := Nat.min_le_right _ _ +theorem tt_le' (s₀ : State) (c : Nat) : tt P s₀ c ≤ P.B - rr P s₀ c := Nat.min_le_left _ _ +theorem rr_eq (s₀ : State) (c : Nat) : rr P s₀ c = (cnt s₀ + c) % P.B := rfl +theorem tt_eq (s₀ : State) (c : Nat) : tt P s₀ c = min (P.B - rr P s₀ c) (len s₀ - c) := rfl -theorem q_eq (s₀ : State) (c : Nat) : q P s₀ c = stA s₀ + BitVec.ofNat 64 (P.N + rr s₀ c) := +theorem q_eq (s₀ : State) (c : Nat) : q P s₀ c = stA s₀ + BitVec.ofNat 64 (P.N + rr P s₀ c) := add_ofNat _ _ _ -theorem xs_length (s₀ : State) (c : Nat) : (xs s₀ c).length = tt s₀ c := by - have := tt_le s₀ c +theorem xs_length (s₀ : State) (c : Nat) : (xs P s₀ c).length = tt P s₀ c := by + have := tt_le (P := P) s₀ c simp only [xs, List.length_take, List.length_drop, D_length]; omega /-- Byte `k` of the buffer, addressed as `[r0 + k, #N]`. -/ -theorem buf_addr {s₀ : State} (hp : Pre P s₀) {k : Nat} (hk : k < 64) : +theorem buf_addr {s₀ : State} (hp : Pre P s₀) {k : Nat} (hk : k < P.B) : State.addr (st s₀ + BitVec.ofNat 32 k + BitVec.ofNat 32 P.N) = buf P s₀ + BitVec.ofNat 64 k := by have := hp.st_fit rw [BitVec.add_assoc, ← BitVec.ofNat_add, addr_off (by omega), add_ofNat, Nat.add_comm] @@ -367,18 +365,18 @@ end /-- The state while copying: `j` bytes copied, into memory otherwise as in `mI`. -/ structure Copy (P : Params) (s₀ : State) (c : Nat) (mI : Mem) (j : Nat) (s : State) : Prop where - j_le : j ≤ tt s₀ c + j_le : j ≤ tt P s₀ c rd : s.rd = s₀.rd wr : s.wr = s₀.wr r0 : s.gpr .r0 = st s₀ r3 : s.gpr .r3 = scr s₀ sp : s.sp = s₀.sp r5 : s.gpr .r5 = dp s₀ + BitVec.ofNat 32 (c + j) - r6 : s.gpr .r6 = BitVec.ofNat 32 (len s₀ - c - tt s₀ c) - r4 : s.gpr .r4 = BitVec.ofNat 32 (rr s₀ c + j) - r8 : s.gpr .r8 = BitVec.ofNat 32 (tt s₀ c - j) + r6 : s.gpr .r6 = BitVec.ofNat 32 (len s₀ - c - tt P s₀ c) + r4 : s.gpr .r4 = BitVec.ofNat 32 (rr P s₀ c + j) + r8 : s.gpr .r8 = BitVec.ofNat 32 (tt P s₀ c - j) r7 : s.gpr .r7 = 0 - mem : s.mem = writeBytes mI (q P s₀ c) ((xs s₀ c).take j) + mem : s.mem = writeBytes mI (q P s₀ c) ((xs P s₀ c).take j) /-- The copy loop's body. -/ def copyBody (P : Params) : List Instr := @@ -386,23 +384,25 @@ def copyBody (P : Params) : List Instr := .dp .add .r4 .r4 (.imm 1), .subs .r8 .r8 (.imm 1)] section -variable {P : Params} {H : Md 64 P.N 8} +variable {P : Params} {H : Md P.B P.N P.L} -theorem write_frame (hd : Dims P) (s₀ : State) (c : Nat) (mI : Mem) (j : Nat) (hj : j ≤ tt s₀ c) : - Frame [stR P s₀] mI (writeBytes mI (q P s₀ c) ((xs s₀ c).take j)) := by - have := tt_le' s₀ c; have := rr_lt s₀ c; have := hd.N +theorem write_frame (hd : Dims P) (s₀ : State) (c : Nat) (mI : Mem) (j : Nat) (hj : j ≤ tt P s₀ c) : + Frame [stR P s₀] mI (writeBytes mI (q P s₀ c) ((xs P s₀ c).take j)) := by + have hBle := hd.le + have := tt_le' (P := P) s₀ c; have := rr_lt hd s₀ c; have := hd.N refine writeBytes_frame _ _ _ ?_ rw [q_eq] exact contains_offset (by simp only [List.length_take]; omega) (by omega) theorem copy_step (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : State} (hI : Inv H s₀ c sI) - {j : Nat} (hj : j < tt s₀ c) {s : State} (h : Copy P s₀ c sI.mem j s) : + {j : Nat} (hj : j < tt P s₀ c) {s : State} (h : Copy P s₀ c sI.mem j s) : WP isa (.block (copyBody P)) s fun s' => - Copy P s₀ c sI.mem (j + 1) s' ∧ s'.z = (BitVec.ofNat 32 (tt s₀ c - (j + 1)) == 0) := by + Copy P s₀ c sI.mem (j + 1) s' ∧ s'.z = (BitVec.ofNat 32 (tt P s₀ c - (j + 1)) == 0) := by + have hBle := hd.le have hdf := hp.d_fit have hc := hI.c_le - have hr := rr_lt s₀ c - have ht := tt_le s₀ c; have ht' := tt_le' s₀ c + have hr := rr_lt hd s₀ c + have ht := tt_le (P := P) s₀ c; have ht' := tt_le' (P := P) s₀ c have := hd.N -- The byte read. have hin : InRegions (s.rd ++ s.wr) (dA s₀ + BitVec.ofNat 64 (c + j)) 1 := @@ -415,7 +415,7 @@ theorem copy_step (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : have hout : InRegions s.wr (q P s₀ c + BitVec.ofNat 64 j) 1 := ⟨stR P s₀, by simp [h.wr, hp.wr], by rw [q_eq, add_ofNat]; exact contains_offset (by omega) (by omega)⟩ - have hxs := xs_length s₀ c + have hxs := xs_length (P := P) s₀ c unfold copyBody refine wp_ldrb (a := dA s₀ + BitVec.ofNat 64 (c + j)) (by omega) (by rw [h.r5, BitVec.add_zero, addr_off (by omega)]) hin @@ -430,7 +430,7 @@ theorem copy_step (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : have g : ∀ r, r ≠ .r12 → r ≠ .r1 → r ≠ .r5 → r ≠ .r4 → r ≠ .r8 → s₆.gpr r = s.gpr r := fun r h1 h2 h3 h4 h5 => by rw [u₆.other r h5, u₅.other r h4, u₄.other r h3, g₃.gpr, u₂.other r h2, u₁.other r h1] - have h8 : s₆.gpr .r8 = BitVec.ofNat 32 (tt s₀ c - (j + 1)) := by + have h8 : s₆.gpr .r8 = BitVec.ofNat 32 (tt P s₀ c - (j + 1)) := by rw [u₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), g₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), h.r8, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega), Nat.sub_sub] @@ -448,11 +448,11 @@ theorem copy_step (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : u₁.other _ (by decide), h.r4, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, ← BitVec.ofNat_add, Nat.add_assoc] · rw [g .r7 (by decide) (by decide) (by decide) (by decide) (by decide), h.r7] - · have hj' : j < (xs s₀ c).length := by omega + · have hj' : j < (xs P s₀ c).length := by omega rw [u₆.mem, u₅.mem, u₄.mem, g₃.mem, u₂.mem, u₁.mem, u₂.other _ (by decide), u₁.gpr, hbyte, h.mem, List.take_add_one, List.getElem?_eq_getElem hj', Option.toList_some, writeBytes_snoc _ _ _ _ (by simp only [List.length_take]; omega)] - have hl : (List.take j (xs s₀ c)).length = j := by + have hl : (List.take j (xs P s₀ c)).length = j := by rw [List.length_take, Nat.min_eq_left (Nat.le_of_lt hj')] rw [hl] have e : ((List.getD (D s₀) (c + j) 0).setWidth 32).setWidth 8 = List.getD (D s₀) (c + j) 0 := by @@ -464,32 +464,34 @@ theorem copy_step (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : · rw [z₆, ← u₆.gpr, h8] theorem copy_loop_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : State} (hI : Inv H s₀ c sI) - {s : State} (h : Copy P s₀ c sI.mem 0 s) (ht : 0 < tt s₀ c) : - WP isa (.loop (.block (copyBody P)) .ne) s (Copy P s₀ c sI.mem (tt s₀ c)) := by - refine WP.loop (M := isa) (fun n s => ∃ j, n = tt s₀ c - j ∧ j < tt s₀ c ∧ Copy P s₀ c sI.mem j s) - ?_ (tt s₀ c) s ⟨0, rfl, ht, h⟩ + {s : State} (h : Copy P s₀ c sI.mem 0 s) (ht : 0 < tt P s₀ c) : + WP isa (.loop (.block (copyBody P)) .ne) s (Copy P s₀ c sI.mem (tt P s₀ c)) := by + have hBle := hd.le + refine WP.loop (M := isa) (fun n s => ∃ j, n = tt P s₀ c - j ∧ j < tt P s₀ c ∧ Copy P s₀ c sI.mem j s) + ?_ (tt P s₀ c) s ⟨0, rfl, ht, h⟩ rintro n s ⟨j, rfl, hj, hc⟩ refine WP.mono (copy_step hd hp hI hj hc) fun s' ⟨hc', hz'⟩ => ?_ - have hz : isa.eval .ne s' = some (decide (tt s₀ c - (j + 1) ≠ 0)) := by + have hz : isa.eval .ne s' = some (decide (tt P s₀ c - (j + 1) ≠ 0)) := by show VG.Arm.eval .ne s' = _ - rw [eval_ne, hz', ofNat_beq_zero (by have := tt_le' s₀ c; omega)] + rw [eval_ne, hz', ofNat_beq_zero (by have := tt_le' (P := P) s₀ c; omega)] simp - by_cases hl : tt s₀ c - (j + 1) = 0 + by_cases hl : tt P s₀ c - (j + 1) = 0 · refine .inl ⟨by rw [hz, decide_eq_false fun h => h hl], ?_⟩ - rwa [show j + 1 = tt s₀ c by omega] at hc' + rwa [show j + 1 = tt P s₀ c by omega] at hc' · exact .inr ⟨by rw [hz, decide_eq_true hl], _, by omega, j + 1, rfl, by omega, hc'⟩ /-- The memory after copying `tt` bytes. -/ theorem copied_facts (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : State} (hI : Inv H s₀ c sI) : - let mem := writeBytes sI.mem (q P s₀ c) (xs s₀ c) + let mem := writeBytes sI.mem (q P s₀ c) (xs P s₀ c) Frame [stR P s₀, scR P s₀] s₀.mem mem ∧ Saved P s₀ mem ∧ H.stateAt mem (stA s₀) = H.stateAt sI.mem (stA s₀) ∧ - bytesAt mem (buf P s₀) (rr s₀ c + tt s₀ c) = bytesAt sI.mem (buf P s₀) (rr s₀ c) ++ xs s₀ c := by + bytesAt mem (buf P s₀) (rr P s₀ c + tt P s₀ c) = bytesAt sI.mem (buf P s₀) (rr P s₀ c) ++ xs P s₀ c := by + have hBle := hd.le intro mem - have hr := rr_lt s₀ c; have ht' := tt_le' s₀ c; have := hd.N - have hxs := xs_length s₀ c + have hr := rr_lt hd s₀ c; have ht' := tt_le' (P := P) s₀ c; have := hd.N + have hxs := xs_length (P := P) s₀ c have hf : Frame [stR P s₀] sI.mem mem := by - have := write_frame hd s₀ c sI.mem (tt s₀ c) (Nat.le_refl _) + have := write_frame hd s₀ c sI.mem (tt P s₀ c) (Nat.le_refl _) rwa [List.take_of_length_le (by omega)] at this refine ⟨hI.frame.trans (hf.mono (by simp)), Saved.of_frame hd hp hI.saved hf, ?_, ?_⟩ · apply H.stateAt_congr @@ -501,17 +503,18 @@ theorem copied_facts (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {s /-- A full buffer: compress it. -/ theorem fill_pending (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : State} (hI : Inv H s₀ c sI) - {s : State} (h : Copy P s₀ c sI.mem (tt s₀ c) s) (hfull : rr s₀ c + tt s₀ c = 64) : + {s : State} (h : Copy P s₀ c sI.mem (tt P s₀ c) s) (hfull : rr P s₀ c + tt P s₀ c = P.B) : WP isa (.block [.dp .add .r1 .r0 (.imm (BitVec.ofNat 32 P.N)), .mov .r4 (.imm 0), .mov .r7 (.imm 1)]) s - (Pending H s₀ (c + tt s₀ c) 1) := by - have ht' := tt_le' s₀ c - have hrr := rr_eq s₀ c; have htt := tt_eq s₀ c - have hxs := xs_length s₀ c + (Pending H s₀ (c + tt P s₀ c) 1) := by + have hBle := hd.le + have ht' := tt_le' (P := P) s₀ c + have hrr := rr_eq (P := P) s₀ c; have htt := tt_eq (P := P) s₀ c + have hxs := xs_length (P := P) s₀ c have hc := hI.c_le have hst := hp.st_fit have := hd.N obtain ⟨hfr, hsv, hstt, hby⟩ := copied_facts hd hp hI - have hmem : s.mem = writeBytes sI.mem (q P s₀ c) (xs s₀ c) := by + have hmem : s.mem = writeBytes sI.mem (q P s₀ c) (xs P s₀ c) := by rw [h.mem, List.take_of_length_le (by omega_using [hxs])] refine wp_add (op2_imm hd.enc) fun s₁ u₁ => wp_mov (op2_imm (by decide)) fun s₂ u₂ => wp_mov (op2_imm (by decide)) fun s₃ u₃ => WP.block_nil ?_ @@ -521,7 +524,8 @@ theorem fill_pending (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {s have hx1 : s₃.gpr .r1 = st s₀ + BitVec.ofNat 32 P.N := by rw [u₃.other _ (by decide), u₂.other _ (by decide), u₁.gpr, h.r0] refine ⟨⟨by omega, ?_, ?_, ?_, ?_, ?_, ?_, ?_, by rw [m₃, hmem]; exact hfr, by rw [m₃, hmem]; exact hsv⟩, - by rw [u₃.other _ (by decide), u₂.gpr], by rw [u₃.gpr]; rfl, Nat.one_pos, by omega, .inl ⟨hx1, rfl⟩, ?_⟩ + by rw [u₃.other _ (by decide), u₂.gpr], by rw [u₃.gpr]; rfl, Nat.one_pos, + by rw [← Nat.add_assoc]; exact Md.add_mod_of_eq hfull, .inl ⟨hx1, rfl⟩, ?_⟩ · rw [u₃.rd, u₂.rd, u₁.rd, h.rd] · rw [u₃.wr, u₂.wr, u₁.wr, h.wr] · rw [g .r0 (by decide) (by decide) (by decide), h.r0] @@ -532,33 +536,36 @@ theorem fill_pending (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {s · intro iv m hm mem' hs rw [Md.compressBlocks_one] at hs rw [← take_add_data] - have hmod := length_mid s₀ hm hc - refine H.repr_append_block (by decide) (hI.repr iv m hm) (by rw [hmod, hxs]; exact hfull) ?_ + have hmod := length_mid hd s₀ hm hc + refine H.repr_append_block hd.pos (hI.repr iv m hm) (by rw [hmod, hxs]; exact hfull) ?_ rw [hs, m₃, hmem, hstt, hx1, addr_off (by omega)] refine congrArg (H.compress _) (H.parse_congr fun k hk => ?_) have hb := (hI.repr iv m hm).2 rw [hmod] at hb - rw [hb, show rr s₀ c + tt s₀ c = 64 from hfull] at hby + rw [hb, show rr P s₀ c + tt P s₀ c = P.B from hfull] at hby exact bytesAt_getD hby hk /-- All the data fits in the buffer. -/ theorem fill_done (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : State} (hI : Inv H s₀ c sI) - {s : State} (h : Copy P s₀ c sI.mem (tt s₀ c) s) (hnf : rr s₀ c + tt s₀ c ≠ 64) : Done H s₀ s := by - have hr := rr_lt s₀ c; have ht' := tt_le' s₀ c - have hrr := rr_eq s₀ c; have htt := tt_eq s₀ c - have hxs := xs_length s₀ c + {s : State} (h : Copy P s₀ c sI.mem (tt P s₀ c) s) (hnf : rr P s₀ c + tt P s₀ c ≠ P.B) : Done H s₀ s := by + have hBle := hd.le + have hr := rr_lt hd s₀ c; have ht' := tt_le' (P := P) s₀ c + have hrr := rr_eq (P := P) s₀ c; have htt := tt_eq (P := P) s₀ c + have hxs := xs_length (P := P) s₀ c have hc := hI.c_le - have htl : tt s₀ c = len s₀ - c := by omega + have htl : tt P s₀ c = len s₀ - c := by omega obtain ⟨hfr, hsv, hstt, hby⟩ := copied_facts hd hp hI - have hmem : s.mem = writeBytes sI.mem (q P s₀ c) (xs s₀ c) := by + have hmem : s.mem = writeBytes sI.mem (q P s₀ c) (xs P s₀ c) := by rw [h.mem, List.take_of_length_le (by omega_using [hxs])] refine ⟨⟨⟨(Nat.le_refl _), h.rd, h.wr, h.r0, h.r3, h.sp, ?_, ?_, by rw [hmem]; exact hfr, by rw [hmem]; exact hsv⟩, ?_, fun iv m hm => ?_⟩, h.r7⟩ · rw [h.r5]; congr 2; omega_using [htl, hc] · rw [h.r6]; congr 1; omega_using [htl] - · rw [h.r4]; congr 1; omega_using [htl, hc, hrr, hr, ht', hnf] - · have hmod := length_mid s₀ hm hc - rw [show len s₀ = c + tt s₀ c by omega_using [htl, hc], ← take_add_data] + · rw [h.r4]; congr 1 + rw [show cnt s₀ + len s₀ = cnt s₀ + c + tt P s₀ c by omega_using [htl, hc], + Md.add_mod_of_lt (by omega_using [hrr, hr, ht', hnf]), ← hrr] + · have hmod := length_mid hd s₀ hm hc + rw [show len s₀ = c + tt P s₀ c by omega_using [htl, hc], ← take_add_data] refine H.repr_append_buf (hI.repr iv m hm) (by rw [hmod, hxs]; omega) (by rw [hmem, hstt]) ?_ rw [hmod, hxs, hmem, hby] have hb := (hI.repr iv m hm).2 @@ -566,52 +573,52 @@ theorem fill_done (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {sI : rw [hb] theorem fill_eq : fill P = - .seq (.block [.mov .r8 (.imm 64), .dp .sub .r8 .r8 (.reg .r4), .mov .r12 (.shifted .r6 .lsr 6), - .cmp .r12 (.imm 0)]) + .seq (.block [.mov .r8 (.imm (BitVec.ofNat 32 P.B)), .dp .sub .r8 .r8 (.reg .r4), + .mov .r12 (.shifted .r6 .lsr (Nat.log2 P.B)), .cmp .r12 (.imm 0)]) (.seq (.ite .eq - (.seq (.block [.dp .add .r12 .r6 (.reg .r4), .mov .r12 (.shifted .r12 .lsr 6), .cmp .r12 (.imm 0)]) + (.seq (.block [.dp .add .r12 .r6 (.reg .r4), .mov .r12 (.shifted .r12 .lsr (Nat.log2 P.B)), + .cmp .r12 (.imm 0)]) (.ite .eq (.block [.mov .r8 (.reg .r6)]) (.block []))) (.block [])) (.seq (.block [.dp .sub .r6 .r6 (.reg .r8)]) (.seq (.loop (.block (copyBody P)) .ne) - (.seq (.block [.cmp .r4 (.imm 64)]) + (.seq (.block [.cmp .r4 (.imm (BitVec.ofNat 32 P.B))]) (.ite .eq (.block [.dp .add .r1 .r0 (.imm (BitVec.ofNat 32 P.N)), .mov .r4 (.imm 0), .mov .r7 (.imm 1)]) (.block [])))))) := rfl theorem fill_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {s : State} (hI : Inv H s₀ c s) (hcl : c < len s₀) (h7 : s.gpr .r7 = 0) : WP isa (fill P) s fun s' => (∃ c' k, c < c' ∧ Pending H s₀ c' k s') ∨ Done H s₀ s' := by - have ht' := tt_le' s₀ c - have hrr := rr_eq s₀ c; have htt := tt_eq s₀ c - have hlen := len_lt s₀ + have ht' := tt_le' (P := P) s₀ c + have hrr := rr_eq (P := P) s₀ c; have htt := tt_eq (P := P) s₀ c + have hlen := len_lt s₀; have hr := rr_lt hd s₀ c; have := hd.le rw [fill_eq] - -- `r8 := 64 - r; r12 := len >> 6` - refine WP.seq (wp_mov (op2_imm (by decide)) fun s₁ u₁ => wp_sub (op2_reg _ _) fun s₂ u₂ => - wp_mov (op2_lsr (by decide)) fun s₃ u₃ => wp_cmp (op2_imm (by decide)) fun s₄ f₄ z₄ => WP.block_nil ?_) + -- `r8 := B - r; r12 := len >> log₂ B` + refine WP.seq (wp_mov (op2_imm hd.encB.1) fun s₁ u₁ => wp_sub (op2_reg _ _) fun s₂ u₂ => + wp_mov (op2_shrB hd) fun s₃ u₃ => wp_cmp (op2_imm (by decide)) fun s₄ f₄ z₄ => WP.block_nil ?_) have hI₄ : Inv H s₀ c s₄ := ((((hI.of_upd u₁ (by decide)).of_upd u₂ (by decide)).of_upd u₃ (by decide))).of_flags f₄ - have h8₄ : s₄.gpr .r8 = BitVec.ofNat 32 (64 - rr s₀ c) := by - rw [f₄.gpr, u₃.other _ (by decide), u₂.gpr, u₁.gpr, u₁.other _ (by decide), hI.r4, - show (64 : BitVec 32) = BitVec.ofNat 32 64 from rfl, sub_ofNat (by omega)] + have h8₄ : s₄.gpr .r8 = BitVec.ofNat 32 (P.B - rr P s₀ c) := by + rw [f₄.gpr, u₃.other _ (by decide), u₂.gpr, u₁.gpr, u₁.other _ (by decide), hI.r4, sub_ofNat (by omega)] have h7₄ : s₄.gpr .r7 = 0 := by rw [f₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h7] have hm₄ : s₄.mem = s.mem := by rw [f₄.mem, u₃.mem, u₂.mem, u₁.mem] - have hz₄ : s₄.z = decide ((len s₀ - c) / 64 = 0) := by - rw [z₄, u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), hI.r6, shr6 (by omega), cmp0 (by omega)] + have hz₄ : s₄.z = decide (len s₀ - c < P.B) := by + rw [z₄, u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), hI.r6, cmp0_shrB hd (by omega)] -- `r8 := min(r8, len)` - refine WP.seq (WP.mono (Q := fun (s₅ : State) => Inv H s₀ c s₅ ∧ s₅.gpr .r8 = BitVec.ofNat 32 (tt s₀ c) ∧ + refine WP.seq (WP.mono (Q := fun (s₅ : State) => Inv H s₀ c s₅ ∧ s₅.gpr .r8 = BitVec.ofNat 32 (tt P s₀ c) ∧ s₅.gpr .r7 = 0 ∧ s₅.mem = s.mem) ?_ fun s₅ ⟨hI₅, h8₅, h7₅, hm₅⟩ => ?_) - · refine WP.ite (decide ((len s₀ - c) / 64 = 0)) + · refine WP.ite (decide (len s₀ - c < P.B)) (by show VG.Arm.eval .eq s₄ = _; rw [eval_eq, hz₄]) (fun hb => ?_) (fun hb => ?_) · simp only [decide_eq_true_eq] at hb - refine WP.seq (wp_add (op2_reg _ _) fun s₆ u₆ => wp_mov (op2_lsr (by decide)) fun s₇ u₇ => + refine WP.seq (wp_add (op2_reg _ _) fun s₆ u₆ => wp_mov (op2_shrB hd) fun s₇ u₇ => wp_cmp (op2_imm (by decide)) fun s₈ f₈ z₈ => WP.block_nil ?_) have hI₈ : Inv H s₀ c s₈ := ((hI₄.of_upd u₆ (by decide)).of_upd u₇ (by decide)).of_flags f₈ - have hz₈ : s₈.z = decide ((len s₀ - c + rr s₀ c) / 64 = 0) := by - rw [z₈, u₇.gpr, u₆.gpr, hI₄.r6, hI₄.r4, ← BitVec.ofNat_add, shr6 (by omega), cmp0 (by omega)] + have hz₈ : s₈.z = decide (len s₀ - c + rr P s₀ c < P.B) := by + rw [z₈, u₇.gpr, u₆.gpr, hI₄.r6, hI₄.r4, ← BitVec.ofNat_add, cmp0_shrB hd (by omega)] have e₈ : ∀ r, r ≠ .r12 → s₈.gpr r = s₄.gpr r := fun r h => by rw [f₈.gpr, u₇.other r h, u₆.other r h] have hm₈ : s₈.mem = s.mem := by rw [f₈.mem, u₇.mem, u₆.mem, hm₄] - refine WP.ite (decide ((len s₀ - c + rr s₀ c) / 64 = 0)) + refine WP.ite (decide (len s₀ - c + rr P s₀ c < P.B)) (by show VG.Arm.eval .eq s₈ = _; rw [eval_eq, hz₈]) (fun hb' => ?_) (fun hb' => ?_) · simp only [decide_eq_true_eq] at hb' refine wp_mov (op2_reg _ _) fun s₉ u₉ => WP.block_nil ⟨hI₈.of_upd u₉ (by decide), ?_, @@ -637,16 +644,16 @@ theorem fill_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {s : St -- Copy the bytes. refine WP.seq (WP.mono (copy_loop_ok hd hp hI hC₀ (by omega)) fun s₇ hC => ?_) -- Is the buffer full? - refine WP.seq (wp_cmp (op2_imm (by decide)) fun s₈ f₈ z₈ => WP.block_nil ?_) - have hC₈ : Copy P s₀ c s.mem (tt s₀ c) s₈ := + refine WP.seq (wp_cmp (op2_imm hd.encB.1) fun s₈ f₈ z₈ => WP.block_nil ?_) + have hC₈ : Copy P s₀ c s.mem (tt P s₀ c) s₈ := ⟨hC.j_le, by rw [f₈.rd, hC.rd], by rw [f₈.wr, hC.wr], by rw [f₈.gpr, hC.r0], by rw [f₈.gpr, hC.r3], by rw [f₈.sp, hC.sp], by rw [f₈.gpr, hC.r5], by rw [f₈.gpr, hC.r6], by rw [f₈.gpr, hC.r4], by rw [f₈.gpr, hC.r8], by rw [f₈.gpr, hC.r7], by rw [f₈.mem, hC.mem]⟩ - have hz : VG.Arm.eval .eq s₈ = some (decide (rr s₀ c + tt s₀ c = 64)) := by - rw [eval_eq, z₈, hC.r4, show (64 : BitVec 32) = BitVec.ofNat 32 64 from rfl, sub_beq (by omega) (by omega)] - refine WP.ite (decide (rr s₀ c + tt s₀ c = 64)) hz (fun hb => ?_) (fun hb => ?_) + have hz : VG.Arm.eval .eq s₈ = some (decide (rr P s₀ c + tt P s₀ c = P.B)) := by + rw [eval_eq, z₈, hC.r4, sub_beq (by omega) (by omega)] + refine WP.ite (decide (rr P s₀ c + tt P s₀ c = P.B)) hz (fun hb => ?_) (fun hb => ?_) · simp only [decide_eq_true_eq] at hb - exact WP.mono (fill_pending hd hp hI hC₈ hb) fun s' h => .inl ⟨c + tt s₀ c, 1, by omega, h⟩ + exact WP.mono (fill_pending hd hp hI hC₈ hb) fun s' h => .inl ⟨c + tt P s₀ c, 1, by omega, h⟩ · simp only [decide_eq_false_iff_not] at hb exact WP.block_nil (.inr (fill_done hd hp hI hC₈ hb)) @@ -655,29 +662,31 @@ theorem fill_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) {c : Nat} {s : St theorem body_ok (hd : Dims P) {name : String} {code : Prog isa} (hf : CalleeOk H code) {s₀ : State} (hp : Pre P s₀) {c : Nat} {s : State} (hI : Inv H s₀ c s) (hcl : c < len s₀) : WP isa (updateBody P name code) s fun s' => ∃ c', c < c' ∧ Inv H s₀ c' s' ∧ s'.z = decide (len s₀ - c' = 0) := by - have hlen := len_lt s₀; have hr := rr_lt s₀ c + have hBle := hd.le + have hlen := len_lt s₀; have hr := rr_lt hd s₀ c unfold updateBody refine WP.seq (wp_mov (op2_imm (by decide)) fun s₁ u₁ => wp_cmp (op2_imm (by decide)) fun s₂ f₂ z₂ => WP.block_nil ?_) have hI₂ : Inv H s₀ c s₂ := (hI.of_upd u₁ (by decide)).of_flags f₂ have h7₂ : s₂.gpr .r7 = 0 := by rw [f₂.gpr, u₁.gpr] - have hz₂ : s₂.z = decide (rr s₀ c = 0) := by - rw [z₂, u₁.other _ (by decide), hI.r4, cmp0 (by omega)] + have hz₂ : s₂.z = decide (rr P s₀ c = 0) := by + rw [z₂, u₁.other _ (by decide), hI.r4, cmp0 (Nat.lt_of_lt_of_le hr (by omega))] refine WP.seq (WP.mono (Q := fun s' => (∃ c' k, c < c' ∧ Pending H s₀ c' k s') ∨ Done H s₀ s') ?_ fun s' h => ?_) - · refine WP.ite (decide (rr s₀ c = 0)) (by show VG.Arm.eval .eq s₂ = _; rw [eval_eq, hz₂]) + · refine WP.ite (decide (rr P s₀ c = 0)) (by show VG.Arm.eval .eq s₂ = _; rw [eval_eq, hz₂]) (fun hb => ?_) (fun _ => fill_ok hd hp hI₂ hcl h7₂) simp only [decide_eq_true_eq] at hb - refine WP.seq (wp_mov (op2_lsr (by decide)) fun s₃ u₃ => wp_cmp (op2_imm (by decide)) fun s₄ f₄ z₄ => + refine WP.seq (wp_mov (op2_shrB hd) fun s₃ u₃ => wp_cmp (op2_imm (by decide)) fun s₄ f₄ z₄ => WP.block_nil ?_) have hI₄ : Inv H s₀ c s₄ := (hI₂.of_upd u₃ (by decide)).of_flags f₄ have h7₄ : s₄.gpr .r7 = 0 := by rw [f₄.gpr, u₃.other _ (by decide), h7₂] - have hz₄ : s₄.z = decide ((len s₀ - c) / 64 = 0) := by - rw [z₄, u₃.gpr, hI₂.r6, shr6 (by omega), cmp0 (by omega)] - refine WP.ite (decide ((len s₀ - c) / 64 = 0)) (by show VG.Arm.eval .eq s₄ = _; rw [eval_eq, hz₄]) + have hz₄ : s₄.z = decide (len s₀ - c < P.B) := by + rw [z₄, u₃.gpr, hI₂.r6, cmp0_shrB hd (by omega)] + refine WP.ite (decide (len s₀ - c < P.B)) (by show VG.Arm.eval .eq s₄ = _; rw [eval_eq, hz₄]) (fun _ => fill_ok hd hp hI₄ hcl h7₄) (fun hb' => ?_) - simp only [decide_eq_false_iff_not] at hb' - exact WP.mono (direct_ok hp hI₄ hb (by omega)) fun s' h => .inl ⟨_, _, by omega, h⟩ + simp only [decide_eq_false_iff_not, Nat.not_lt] at hb' + have := Nat.mul_pos hd.pos (Nat.div_pos hb' hd.pos) + exact WP.mono (direct_ok hd hp hI₄ hb hb') fun s' h => .inl ⟨_, _, by omega, h⟩ · refine WP.seq (WP.mono (Q := fun (s' : State) => ∃ c', c < c' ∧ Inv H s₀ c' s') ?_ ?_) · refine WP.seq (wp_cmp (op2_imm (by decide)) fun s₅ f₅ z₅ => WP.block_nil ?_) rcases h with ⟨c', k, hc', hP⟩ | ⟨hD, h7⟩ @@ -691,7 +700,7 @@ theorem body_ok (hd : Dims P) {name : String} {code : Prog isa} (hf : CalleeOk H repr := by rw [f₅.mem, f₅.gpr]; exact hP.repr } refine WP.ite false (by show VG.Arm.eval .eq s₅ = _ - rw [eval_eq, z₅, hP.r7, cmp0 hP.k_lt, decide_eq_false (Nat.pos_iff_ne_zero.mp hP.k_pos)]) + rw [eval_eq, z₅, hP.r7, cmp0 (hP.k_lt hd), decide_eq_false (Nat.pos_iff_ne_zero.mp hP.k_pos)]) (fun h => by cases h) fun _ => WP.mono (hP₅.compress_ok hd hf hp) fun s'' h => ⟨c', hc', h⟩ · refine WP.ite true (by show VG.Arm.eval .eq s₅ = _; rw [eval_eq, z₅, h7]; rfl) (fun _ => WP.block_nil ⟨len s₀, hcl, hD.of_flags f₅⟩) fun h => by cases h @@ -704,14 +713,15 @@ end /-! ## Prologue and epilogue -/ /-- The prologue after saving. -/ -def prologue : List Instr := - [.mov .r3 (.reg .r12), .dp .and .r4 .r2 (.imm 63), .ldrSp .r5 0, .ldrSp .r6 4, .cmp .r6 (.imm 0)] +def prologue (P : Params) : List Instr := + [.mov .r3 (.reg .r12), .dp .and .r4 .r2 (.imm (BitVec.ofNat 32 (P.B - 1))), .ldrSp .r5 0, .ldrSp .r6 4, + .cmp .r6 (.imm 0)] section -variable {P : Params} {H : Md 64 P.N 8} +variable {P : Params} {H : Md P.B P.N P.L} theorem update_eq (name : String) (code : Prog isa) : update P name code = - .seq (.block (([.ldrSp .r12 8] : List Instr) ++ save P .r12 ++ prologue)) + .seq (.block (([.ldrSp .r12 8] : List Instr) ++ save P .r12 ++ prologue P)) (.seq (.ite .eq (.block []) (.loop (updateBody P name code) .ne)) (.block (restore P))) := rfl /-- The stack arguments, word by word. -/ @@ -731,7 +741,7 @@ theorem arg_sub {s₀ : State} (hp : Pre P s₀) {k : Nat} (hk : k < 3) : rw [argAddr_eq hp hk]; exact sub_offset (by omega) (by omega) theorem prologue_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) : - WP isa (.block (([.ldrSp .r12 8] : List Instr) ++ save P .r12 ++ prologue)) s₀ + WP isa (.block (([.ldrSp .r12 8] : List Instr) ++ save P .r12 ++ prologue P)) s₀ fun s => Inv H s₀ 0 s ∧ s.z = decide (len s₀ = 0) := by have hsc := hp.scr_fit; have := hd.so; have := hd.N simp only [List.cons_append, List.nil_append] @@ -746,7 +756,7 @@ theorem prologue_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) : have harg : ∀ k, k < 3 → s₂.mem.readW (stackArgAddr s₀ k) 32 = stackArg s₀ k := fun k hk => hframe.readW (Region.contains_self _ _) (by simpa using (hp.a_scr.sub_left (arg_sub hp hk))) (by decide) unfold prologue - refine wp_mov (op2_reg _ _) fun s₃ u₃ => wp_and (op2_imm (by decide)) fun s₄ u₄ => ?_ + refine wp_mov (op2_reg _ _) fun s₃ u₃ => wp_and (op2_imm hd.encB.2.1) fun s₄ u₄ => ?_ refine wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) (by rw [u₄.sp, u₃.sp, sp₂, u₁.sp]; rfl) (by rw [u₄.rd, u₄.wr, u₃.rd, u₃.wr, rd₂, wr₂, u₁.rd, u₁.wr]; exact arg_in hp (by decide)) fun s₅ u₅ => ?_ @@ -774,11 +784,11 @@ theorem prologue_ok (hd : Dims P) {s₀ : State} (hp : Pre P s₀) : simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' rcases hp' with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> dsimp only <;> decide · rw [f₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.other _ (by decide), g₂, - u₁.other _ (by decide), and63, Nat.add_zero, cnt_mod] + u₁.other _ (by decide), andB hd, Nat.add_zero, cnt_mod hd] · intro iv m hm rw [List.take_zero, List.append_nil, mm] - exact H.repr_congr (by decide) (fun i hi => frame_bytes hframe (R := stR P s₀) - (by simpa using hp.st_scr) (by show P.N + 64 ≤ 2 ^ 64; omega) hi) hm.1 + exact H.repr_congr hd.pos (fun i hi => frame_bytes hframe (R := stR P s₀) + (by simpa using hp.st_scr) (by show P.N + P.B ≤ 2 ^ 64; have := hd.le; omega) hi) hm.1 · rw [z₇, h6'] have := cmp0 (a := len s₀) (len_lt s₀) simpa using this @@ -826,11 +836,11 @@ end points at the state, and the 12 bytes of stack arguments are public, the third one pointing at the scratch space. -/ def τ₀ (P : Params) : VG.Arm.Taint.T := - { regs := .ofList [.r0, .r2, .r3], flags := false, lens := [P.N + 64, P.so + 48], bases := [(.r0, 0)], + { regs := .ofList [.r0, .r2, .r3], flags := false, lens := [P.N + P.B, P.so + 48], bases := [(.r0, 0)], argLen := 12, argBases := [(8, 1)] } section -variable {P : Params} {H : Md 64 P.N 8} +variable {P : Params} {H : Md P.B P.N P.L} theorem wf₀ {s : State} (h : (updK H).pre s) : VG.Arm.Taint.Wf (τ₀ P) s := by have hp := pre_of h @@ -880,13 +890,14 @@ def sat (P : Params) : State where v := false mem _ := 0 rd := [⟨0, 0⟩, ⟨0x4000, 12⟩] - wr := [⟨0x1000, P.N + 64⟩, ⟨0, P.so + 48⟩] + wr := [⟨0x1000, P.N + P.B⟩, ⟨0, P.so + 48⟩] /-- `update` is verified, given that it is constant time (which the taint analysis proves of each hash function's code). -/ -theorem verified {P : Params} {H : Md 64 P.N 8} (hd : Dims P) {name : String} {code : Prog isa} +theorem verified {P : Params} {H : Md P.B P.N P.L} (hd : Dims P) {name : String} {code : Prog isa} (hf : CalleeOk H code) (hct : ConstantTime isa (updK H).pre (updK H).pub (update P name code)) : Verified Arm.target (update P name code) (updK H) := by + have hBle := hd.le have := hd.N; have := hd.so refine ⟨fun s hs => ?_, hct, ?_⟩ · obtain ⟨t, s', he, h⟩ := correct hd hf (pre_of hs) diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean index 4566a103e..97950e77e 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean @@ -304,10 +304,10 @@ def OutOk {B N L : Nat} (H : Md B N L) (out : List Instr) : Prop := s'.wr = s.wr ∧ s'.sp = s.sp ∧ s'.mem = writeBytes s.mem (State.addr (s.gpr .r6)) (H.digest (H.stateAt s.mem (State.addr (s.gpr .r0)))) -/-- The streaming proofs' digest code, for a hash function with 64-byte blocks. -/ -theorem OutOk.ofShape {P : Impl.MdStream.Arm.Params} {H : Md 64 P.N 8} (h : MdStream.Arm.Shape H) : +/-- The streaming proofs' digest code. -/ +theorem OutOk.ofShape {P : Impl.MdStream.Arm.Params} {H : Md P.B P.N P.L} (h : MdStream.Arm.Shape H) : OutOk H P.out := fun s f₀ f₆ hin hout hd => - (h.out s f₀ f₆ hin hout hd).mono fun _ ⟨g, rd, wr, sp, m⟩ => ⟨fun r h9 _ => g r h9, rd, wr, sp, m⟩ + h.out s f₀ f₆ hin hout hd /-! ## Blocks -/ diff --git a/lean/VerifiedGarbage/Proof/Sha1/Arm/Stream/Md.lean b/lean/VerifiedGarbage/Proof/Sha1/Arm/Stream/Md.lean index eaacf4b28..9b1b7290f 100644 --- a/lean/VerifiedGarbage/Proof/Sha1/Arm/Stream/Md.lean +++ b/lean/VerifiedGarbage/Proof/Sha1/Arm/Stream/Md.lean @@ -24,13 +24,14 @@ open VG VG.Arm VG.Proof.MdStream VG.Proof.MdStream.Arm abbrev params := Impl.Sha1.Arm.Stream.params -theorem dims : Dims params := ⟨by decide, by decide, by decide⟩ +theorem dims : Dims params := ⟨.inl rfl, by decide, by decide, by decide, by decide, by decide⟩ theorem shape : Shape (P := params) md where - len _ hfit hout := len64_ok (d := params.N + 56) (be := true) (by decide) (by omega) hout + len _ hfit hout := len64_ok (d := params.N + (params.B - params.L)) (be := true) (by decide) + (by have : params.B = 64 := rfl; have : params.L = 8 := rfl; omega) hout out _ f₀ f₆ hin hout hd := by refine (out32_ok (n := 5) true (by decide) f₀ f₆ hin hout hd).mono fun s' ⟨g, rd, wr, sp, m⟩ => - ⟨g, rd, wr, sp, ?_⟩ + ⟨fun r h _ => g r h, rd, wr, sp, ?_⟩ rw [m, digest_eq] theorem callee : CalleeOk (P := params) md Impl.Sha1.Arm.compress := diff --git a/lean/VerifiedGarbage/Proof/Sha256/Arm/Stream/Common.lean b/lean/VerifiedGarbage/Proof/Sha256/Arm/Stream/Common.lean index 59dd824e3..e6950900c 100644 --- a/lean/VerifiedGarbage/Proof/Sha256/Arm/Stream/Common.lean +++ b/lean/VerifiedGarbage/Proof/Sha256/Arm/Stream/Common.lean @@ -102,7 +102,7 @@ theorem save_ok {b : Reg} {rest : List Instr} {s : State} {Q : State → Prop} theorem saveMem_saved (m : Mem) (B : Addr) (g : Reg → BitVec 32) : ∀ p ∈ saved, (Proof.MdStream.Arm.saveMem m B g saved).readW (B + BitVec.ofNat 64 p.2) 32 = g p.1 := - Proof.MdStream.Arm.saveMem_saved (P := params) ⟨by decide, by decide, by decide⟩ m B g + Proof.MdStream.Arm.saveMem_saved (P := params) ⟨.inl rfl, by decide, by decide, by decide, by decide, by decide⟩ m B g theorem saveMem_frame (m : Mem) (B : Addr) (g : Reg → BitVec 32) : ∀ (l : List (Reg × Nat)), (∀ p ∈ l, p.2 + 4 ≤ 160) → Frame [⟨B, 160⟩] m (Proof.MdStream.Arm.saveMem m B g l) := by diff --git a/lean/VerifiedGarbage/Proof/Sha256/Arm/Stream/Md.lean b/lean/VerifiedGarbage/Proof/Sha256/Arm/Stream/Md.lean index 577db43ac..8cd365830 100644 --- a/lean/VerifiedGarbage/Proof/Sha256/Arm/Stream/Md.lean +++ b/lean/VerifiedGarbage/Proof/Sha256/Arm/Stream/Md.lean @@ -25,13 +25,14 @@ open VG VG.Arm VG.Proof.MdStream VG.Proof.MdStream.Arm abbrev params := Impl.Sha256.Arm.Stream.params -theorem dims : Dims params := ⟨by decide, by decide, by decide⟩ +theorem dims : Dims params := ⟨.inl rfl, by decide, by decide, by decide, by decide, by decide⟩ theorem shape : Shape (P := params) md where - len _ hfit hout := len64_ok (d := params.N + 56) (be := true) (by decide) (by omega) hout + len _ hfit hout := len64_ok (d := params.N + (params.B - params.L)) (be := true) (by decide) + (by have : params.B = 64 := rfl; have : params.L = 8 := rfl; omega) hout out _ f₀ f₆ hin hout hd := by refine (out32_ok (n := 8) true (by decide) f₀ f₆ hin hout hd).mono fun s' ⟨g, rd, wr, sp, m⟩ => - ⟨g, rd, wr, sp, ?_⟩ + ⟨fun r h _ => g r h, rd, wr, sp, ?_⟩ rw [m, digest_eq] theorem callee : CalleeOk (P := params) md Impl.Sha256.Arm.compress := diff --git a/lean/VerifiedGarbage/Proof/Sha512/Arm/Stream/Finalize.lean b/lean/VerifiedGarbage/Proof/Sha512/Arm/Stream/Finalize.lean index 8643a0968..b98e41939 100644 --- a/lean/VerifiedGarbage/Proof/Sha512/Arm/Stream/Finalize.lean +++ b/lean/VerifiedGarbage/Proof/Sha512/Arm/Stream/Finalize.lean @@ -1,35 +1,31 @@ +import VerifiedGarbage.Proof.MdStream.Arm.Finalize +import VerifiedGarbage.Proof.MdStream.Arm.Words import VerifiedGarbage.Proof.Sha512.Arm.Stream.Update -import VerifiedGarbage.Proof.Framework.Contract -import VerifiedGarbage.Proof.Framework.RelCTAssoc /-! # Streaming SHA-512 on ARMv7: `finalize` -The structure of the SHA-256 proof (`VG.Proof.MdStream.Arm.Finalize`), with -`state` in `r0`, `scratch` in `r3`, `out` in `r6`, the buffered bytes in `r4`, -whether the block is not the last in `r5`, and `count` saved in the scratch -space (with our caller's registers). +`finalize` is the generic streaming code (`Impl/MdStream/Arm.lean`), so it is +verified by the generic proof (`Proof/MdStream/Arm/Finalize.lean`) for the +SHA-512 family's instance (`Proof/Sha512/Md.lean`), given what the family's +own pieces do: its length field and digest (`shape`), that its compression +function is verified (`callee`), and that the taint analysis accepts its code. -/ namespace VG.Proof.Sha512.Arm.Stream.Finalize -open VG VG.Arm VG.Impl.Sha512.Arm.Stream +open VG VG.Arm VG.Proof.MdStream VG.Proof.MdStream.Arm open VG.Impl.Sha512.Arm (lo hi) -open VG.Proof.MdStream.Arm (contains_offset) -open VG.Proof.MdStream.Arm (Upd Mupd Fupd op2_imm op2_reg op2_lsr op2_lsl wp_mov wp_add wp_and - wp_orr wp_subs wp_cmp wp_rev wp_ldr wp_str wp_strb wp_ldrSp saveMem saveList_ok readW_writeW_save - sub_offset frame_bytes bytesAt_getD eval_eq eval_ne ofNat_beq_zero sub_ofNat sub_beq) -open VG.Proof.Sha512.Arm (temps) -open VG.Proof.Sha512.Arm.Stream -open VG.Proof.Sha512.Arm.Stream.Update (addr_toNat shr7 cmp0) -open VG.Proof.Sha512.Stream -open VG.Spec.Sha512 (HashValue stateAt blockAt compress parseBlock bytesAt wordBytes) -open VG.Proof.Sha512 (countArm) +open VG.Impl.Sha512.Arm.Stream (outW) +open VG.Impl.MdStream.Arm (len64) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_append writeBytes_frame write_eq_writeBytes) +open VG.Proof.Sha512.Arm (readW_lo readW_hi) +open VG.Spec.Sha512 (HashValue stateAt wordBytes) /-! ## Words -The halves of the length the padding ends with (`Proof/Sha512/Word64.lean`), -for the implementation's `lo` and `hi`. -/ +The halves of the words of the length field and the digest +(`Proof/Sha512/Word64.lean`), for the implementation's `lo` and `hi`. -/ theorem wordBytes_split (x : BitVec 64) : wordBytes x = Spec.Sha256.wordBytes (hi x) ++ Spec.Sha256.wordBytes (lo x) := @@ -40,728 +36,6 @@ theorem writeW_rev (m : Mem) (a : Addr) (w : BitVec 32) : rw [Mem.writeW, write_eq_writeBytes] exact congrArg (writeBytes m a) (byteRev32_extract w) -theorem lo_shr61 (x : BitVec 64) : lo (x >>> 61) = hi x >>> 29 := Word64.lo_shr61 x - -theorem hi_shr61 (x : BitVec 64) : hi (x >>> 61) = 0 := Word64.hi_shr61 x - -theorem lo_shl3 (x : BitVec 64) : lo (x <<< 3) = lo x <<< 3 := Word64.lo_shl3 x - -theorem hi_shl3 (x : BitVec 64) : hi (x <<< 3) = (hi x <<< 3) ||| (lo x >>> 29) := Word64.hi_shl3 x - -/-! ## The precondition -/ - -/-- What the prologue stores in the scratch space: our caller's registers and -`count`. -/ -def stored : List (Reg × Nat) := saved ++ [(.r2, 260), (.r3, 264)] - -theorem stored_bound : ∀ p ∈ stored, 224 ≤ p.2 ∧ p.2 + 4 ≤ 268 := by decide - -theorem saved_stored {p : Reg × Nat} (hp : p ∈ saved) : p ∈ stored := List.mem_append_left _ hp - -section -variable (s₀ : State) - -abbrev st : BitVec 32 := s₀.gpr .r0 -abbrev cnt : Nat := (countArm s₀).toNat -abbrev out : BitVec 32 := stackArg s₀ 0 -abbrev scr : BitVec 32 := stackArg s₀ 1 -abbrev stA : Addr := State.addr (st s₀) -abbrev outA : Addr := State.addr (out s₀) -abbrev scA : Addr := State.addr (scr s₀) -abbrev stR : Region := ⟨stA s₀, 192⟩ -abbrev outR : Region := ⟨outA s₀, 64⟩ -abbrev scR : Region := ⟨scA s₀, 272⟩ -abbrev argR : Region := ⟨stackArgAddr s₀ 0, 8⟩ - -/-- The messages the initial state represents, from the initial hash value -`iv`, of fewer than 2⁶⁴ bytes. -/ -def R₀ (iv : HashValue) (m : List Byte) : Prop := - Spec.Sha512.Repr iv s₀.mem (stA s₀) m ∧ m.length < 2 ^ 64 ∧ countArm s₀ = BitVec.ofNat 64 m.length - -/-- The caller's registers and `count` are stored in the scratch space. -/ -def Saved (m : Mem) : Prop := - ∀ p ∈ stored, m.readW (scA s₀ + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 - -/-- The digest, if `n` bytes are buffered in a block that is not the last. -/ -def Fin1 (mem : Mem) (n : Nat) (m : List Byte) : HashValue := - compress (compress (stateAt mem (stA s₀)) - (parseBlock fun t => (bytesAt mem (stA s₀ + 64) n ++ List.replicate (128 - n) 0).getD t 0)) - (parseBlock fun t => (List.replicate 112 0 ++ lenBytes m).getD t 0) - -/-- The digest, if `n` bytes are buffered in the last block. -/ -def Fin0 (mem : Mem) (n : Nat) (m : List Byte) : HashValue := - compress (stateAt mem (stA s₀)) - (parseBlock fun t => (bytesAt mem (stA s₀ + 64) n ++ List.replicate (112 - n) 0 ++ lenBytes m).getD t 0) - -end - -structure Pre (s₀ : State) : Prop where - rd : s₀.rd = [argR s₀] - wr : s₀.wr = [stR s₀, outR s₀, scR s₀] - st_out : (stR s₀).Disjoint (outR s₀) - st_scr : (stR s₀).Disjoint (scR s₀) - out_scr : (outR s₀).Disjoint (scR s₀) - a_st : (argR s₀).Disjoint (stR s₀) - a_out : (argR s₀).Disjoint (outR s₀) - a_scr : (argR s₀).Disjoint (scR s₀) - st_fit : (st s₀).toNat + 192 ≤ 2 ^ 32 - out_fit : (out s₀).toNat + 64 ≤ 2 ^ 32 - scr_fit : (scr s₀).toNat + 272 ≤ 2 ^ 32 - sp_fit : s₀.sp.toNat + 8 ≤ 2 ^ 32 - -theorem pre_of {s₀ : State} (h : Proof.Sha512.finalizeArm.pre s₀) : Pre s₀ := by - obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ := h - exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ - -theorem cnt_mod (s₀ : State) : cnt s₀ % 128 = (s₀.gpr .r2).toNat % 128 := by - simp only [cnt, countArm] - rw [BitVec.toNat_append, ← Nat.shiftLeft_add_eq_or_of_lt (s₀.gpr .r2).isLt, Nat.shiftLeft_eq] - omega - -theorem R₀.length {s₀ : State} {iv : HashValue} {m : List Byte} (h : R₀ s₀ iv m) : - cnt s₀ % 128 = m.length % 128 := by - rw [cnt, h.2.2, BitVec.toNat_ofNat] - omega - -theorem st_add (s₀ : State) (n : Nat) : - stA s₀ + 64 + BitVec.ofNat 64 n = stA s₀ + BitVec.ofNat 64 (64 + n) := by - simp only [BitVec.ofNat_add]; rw [BitVec.add_assoc]; rfl - -/-! ## Invariants -/ - -structure Common (s₀ : State) (s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - r0 : s.gpr .r0 = st s₀ - r3 : s.gpr .r3 = scr s₀ - r6 : s.gpr .r6 = out s₀ - sp : s.sp = s₀.sp - frame : Frame [stR s₀, scR s₀] s₀.mem s.mem - saved : Saved s₀ s.mem - -/-- The loop invariant: `k = 1` while the block being padded is not the last -one, with `n` bytes of it buffered. -/ -structure LInv (s₀ : State) (k n : Nat) (s : State) : Prop extends Common s₀ s where - k_le : k ≤ 1 - n_le : n ≤ 112 + 16 * k - r4 : s.gpr .r4 = BitVec.ofNat 32 n - r5 : s.gpr .r5 = BitVec.ofNat 32 k - hash : ∀ iv m, R₀ s₀ iv m → Spec.Sha512.finalHash iv m = - (if k = 1 then Fin1 s₀ s.mem n m else Fin0 s₀ s.mem n m).toList.flatMap wordBytes - -/-- All blocks are compressed. -/ -def Done (s₀ : State) (s : State) : Prop := - Common s₀ s ∧ ∀ iv m, R₀ s₀ iv m → Spec.Sha512.finalHash iv m = (stateAt s.mem (stA s₀)).toList.flatMap wordBytes - -def keepRegs : List Reg := [.r0, .r3, .r6] - -theorem Common.of_gpr {s₀ : State} {s s' : State} (h : Common s₀ s) - (hg : ∀ r ∈ keepRegs, s'.gpr r = s.gpr r) - (hm : s'.mem = s.mem) (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) (hsp : s'.sp = s.sp) : - Common s₀ s' where - rd := hrd.trans h.rd - wr := hwr.trans h.wr - r0 := by rw [hg _ (by simp [keepRegs])]; exact h.r0 - r3 := by rw [hg _ (by simp [keepRegs])]; exact h.r3 - r6 := by rw [hg _ (by simp [keepRegs])]; exact h.r6 - sp := hsp.trans h.sp - frame := by rw [hm]; exact h.frame - saved := by rw [hm]; exact h.saved - -theorem Common.of_upd {s₀ : State} {s s' : State} (h : Common s₀ s) {d : Reg} {v : BitVec 32} - (u : Upd s s' d v) (hd : d ∉ keepRegs) : Common s₀ s' := - h.of_gpr (fun r hr => u.other r fun e => hd (e ▸ hr)) u.mem u.rd u.wr u.sp - -theorem Common.of_flags {s₀ : State} {s s' : State} (h : Common s₀ s) (u : Fupd s s') : Common s₀ s' := - h.of_gpr (fun r _ => by rw [u.gpr]) u.mem u.rd u.wr u.sp - -/-- Where the caller's registers and `count` are stored. -/ -theorem stored_sub {s₀ : State} {p : Reg × Nat} (hp : p ∈ stored) : - Region.Sub ⟨scA s₀ + BitVec.ofNat 64 p.2, 4⟩ (scR s₀) := - sub_offset (by have := (stored_bound p hp).2; omega) (by have := (stored_bound p hp).2; omega) - -/-- Writing buffer bytes `[n, n + |xs|)` keeps `Common`'s memory facts. -/ -theorem Common.writeBuf {s₀ : State} (hp : Pre s₀) {s : State} (h : Common s₀ s) {n : Nat} - {xs : List Byte} (hn : n + xs.length ≤ 128) : - Frame [stR s₀] s.mem (writeBytes s.mem (stA s₀ + 64 + BitVec.ofNat 64 n) xs) ∧ - Frame [stR s₀, scR s₀] s₀.mem (writeBytes s.mem (stA s₀ + 64 + BitVec.ofNat 64 n) xs) ∧ - Saved s₀ (writeBytes s.mem (stA s₀ + 64 + BitVec.ofNat 64 n) xs) := by - have hf : Frame [stR s₀] s.mem (writeBytes s.mem (stA s₀ + 64 + BitVec.ofNat 64 n) xs) := by - refine writeBytes_frame _ _ _ ?_ - rw [st_add] - exact contains_offset (by omega) (by omega) - refine ⟨hf, h.frame.trans (hf.mono (by simp)), fun p hp' => ?_⟩ - rw [← h.saved p hp'] - refine hf.readW (r := ⟨scA s₀ + BitVec.ofNat 64 p.2, 4⟩) (Region.contains_self _ _) ?_ (by decide) - intro r' hr' - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' - subst hr' - exact hp.st_scr.symm.sub_left (stored_sub hp') - -/-- Byte `k` of the buffer, addressed as `[r0 + k, #64]`. -/ -theorem buf_addr {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 128) : - State.addr (st s₀ + BitVec.ofNat 32 k + BitVec.ofNat 32 64) = stA s₀ + 64 + BitVec.ofNat 64 k := by - have := hp.st_fit - rw [BitVec.add_assoc, ← BitVec.ofNat_add, addr_add (by omega), Nat.add_comm, BitVec.ofNat_add, - ← BitVec.add_assoc] - rfl - -/-! ## Zeroing the buffer -/ - -/-- Zeroing buffer bytes `[n, lim)` from state `sI`: `j` of them done. -/ -structure Zero (s₀ : State) (sI : State) (n lim j : Nat) (s : State) : Prop where - j_le : j ≤ lim - n - keep : ∀ r ∈ .r5 :: keepRegs, s.gpr r = sI.gpr r - rd : s.rd = sI.rd - wr : s.wr = sI.wr - sp : s.sp = sI.sp - r12 : s.gpr .r12 = 0 - r4 : s.gpr .r4 = BitVec.ofNat 32 (n + j) - r9 : s.gpr .r9 = BitVec.ofNat 32 (lim - n - j) - mem : s.mem = writeBytes sI.mem (stA s₀ + 64 + BitVec.ofNat 64 n) (List.replicate j 0) - -/-- The zeroing loop's body. -/ -def zeroBody : List Instr := - [.dp .add .r1 .r0 (.reg .r4), .strb .r12 .r1 64, .dp .add .r4 .r4 (.imm 1), .subs .r9 .r9 (.imm 1)] - -theorem zero_step {s₀ : State} (hp : Pre s₀) {sI : State} (hC : Common s₀ sI) {n lim j : Nat} - (hlim : lim ≤ 128) (hj : j < lim - n) {s : State} (h : Zero s₀ sI n lim j s) : - WP isa (.block zeroBody) s fun s' => - Zero s₀ sI n lim (j + 1) s' ∧ s'.z = (BitVec.ofNat 32 (lim - n - (j + 1)) == 0) := by - have hr0 : s.gpr .r0 = st s₀ := by rw [h.keep _ (by simp [keepRegs]), hC.r0] - have hout : InRegions s.wr (stA s₀ + 64 + BitVec.ofNat 64 n + BitVec.ofNat 64 j) 1 := by - refine ⟨stR s₀, by simp [h.wr, hC.wr, hp.wr], ?_⟩ - rw [show stA s₀ + 64 + BitVec.ofNat 64 n + BitVec.ofNat 64 j = stA s₀ + BitVec.ofNat 64 (64 + n + j) by - simp only [BitVec.ofNat_add]; ac_rfl] - exact contains_offset (by omega) (by omega) - unfold zeroBody - refine wp_add (op2_reg _ _) fun s₁ u₁ => - wp_strb (a := stA s₀ + 64 + BitVec.ofNat 64 n + BitVec.ofNat 64 j) (by omega) ?_ - (by rw [u₁.wr]; exact hout) fun s₂ g₂ => ?_ - · rw [u₁.gpr, hr0, h.r4, buf_addr hp (by omega)] - simp only [BitVec.ofNat_add] - ac_rfl - refine wp_add (op2_imm (by decide)) fun s₃ u₃ => wp_subs (op2_imm (by decide)) fun s₄ u₄ z₄ => - WP.block_nil ⟨⟨by omega, fun r hr => ?_, by rw [u₄.rd, u₃.rd, g₂.rd, u₁.rd, h.rd], - by rw [u₄.wr, u₃.wr, g₂.wr, u₁.wr, h.wr], by rw [u₄.sp, u₃.sp, g₂.sp, u₁.sp, h.sp], ?_, ?_, ?_, ?_⟩, ?_⟩ - · have : r ≠ .r9 ∧ r ≠ .r4 ∧ r ≠ .r1 := by - simp only [keepRegs, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide - rw [u₄.other r this.1, u₃.other r this.2.1, g₂.gpr, u₁.other r this.2.2, h.keep r hr] - · rw [u₄.other _ (by decide), u₃.other _ (by decide), g₂.gpr, u₁.other _ (by decide), h.r12] - · rw [u₄.other _ (by decide), u₃.gpr, g₂.gpr, u₁.other _ (by decide), h.r4, - show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, ← BitVec.ofNat_add, Nat.add_assoc] - · rw [u₄.gpr, u₃.other _ (by decide), g₂.gpr, u₁.other _ (by decide), h.r9, - show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega), Nat.sub_sub] - · rw [u₄.mem, u₃.mem, g₂.mem, u₁.mem, u₁.other _ (by decide), h.r12, h.mem, List.replicate_succ', - writeBytes_snoc _ _ _ _ (by simp only [List.length_replicate]; omega), List.length_replicate] - rfl - · rw [z₄, u₃.other _ (by decide), g₂.gpr, u₁.other _ (by decide), h.r9, - show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega), Nat.sub_sub, Nat.sub_sub] - -theorem zero_ok {s₀ : State} (hp : Pre s₀) {sI : State} (hC : Common s₀ sI) {n lim : Nat} - (hlim : lim ≤ 128) (hn : n ≤ lim) {s : State} (h : Zero s₀ sI n lim 0 s) - (hz : s.z = decide (lim - n = 0)) : - WP isa (.ite .eq (.block []) (.loop (.block zeroBody) .ne)) s (Zero s₀ sI n lim (lim - n)) := by - refine WP.ite (decide (lim - n = 0)) (by show VG.Arm.eval .eq s = _; rw [eval_eq, hz]) - (fun hb => ?_) (fun hb => ?_) - · simp only [decide_eq_true_eq] at hb - exact WP.block_nil (hb ▸ h) - · simp only [decide_eq_false_iff_not] at hb - refine WP.loop (M := isa) (fun k s => ∃ j, k = lim - n - j ∧ j < lim - n ∧ Zero s₀ sI n lim j s) - ?_ (lim - n) s ⟨0, rfl, by omega, h⟩ - rintro k s ⟨j, rfl, hj, hZ⟩ - refine WP.mono (zero_step hp hC hlim hj hZ) fun s' ⟨hZ', hz'⟩ => ?_ - have hz'' : isa.eval .ne s' = some (decide (lim - n - (j + 1) ≠ 0)) := by - show VG.Arm.eval .ne s' = _ - rw [eval_ne, hz', ofNat_beq_zero (by omega)] - simp - by_cases hl : lim - n - (j + 1) = 0 - · refine .inl ⟨by rw [hz'', decide_eq_false fun h => h hl], ?_⟩ - rwa [show j + 1 = lim - n by omega] at hZ' - · exact .inr ⟨by rw [hz'', decide_eq_true hl], _, by omega, j + 1, rfl, by omega, hZ'⟩ - -/-! ## One block -/ - -/-- What the call of the compression function needs. -/ -theorem Common.atPre {s₀ : State} (hp : Pre s₀) {s : State} (hC : Common s₀ s) : AtPre (st s₀) (scr s₀) s := - ⟨hC.r0, hC.r3, by simp [hC.wr, hp.wr], by simp [hC.wr, hp.wr]⟩ - -/-- The call of the compression function on the buffer. -/ -theorem compress_buf {s₀ : State} (hp : Pre s₀) {s : State} (hC : Common s₀ s) {Q : State → Prop} - (hQ : ∀ s', Common s₀ s' → (∀ r, r ∉ temps → r ≠ .lr → s'.gpr r = s.gpr r) → - stateAt s'.mem (stA s₀) = compress (stateAt s.mem (stA s₀)) (blockAt s.mem (stA s₀ + 64)) → Q s') : - WP isa compressAt s Q := by - have hsc := hp.scr_fit - have e64 : Region.Sub ⟨scA s₀, 224⟩ (scR s₀) := Region.sub_prefix (by omega) - refine compressBuf_ok hp.st_fit hp.scr_fit hp.st_scr (hC.atPre hp) fun s' hrd hwr hg hsp hf hst => hQ s' ⟨hrd.trans hC.rd, hwr.trans hC.wr, - by rw [hg _ (by decide) (by decide), hC.r0], by rw [hg _ (by decide) (by decide), hC.r3], - by rw [hg _ (by decide) (by decide), hC.r6], hsp.trans hC.sp, hC.frame.trans (hf.sub fun r hr => ?_), - fun p hp' => ?_⟩ hg hst - · simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact ⟨stR s₀, by simp, fun _ h => h⟩ - · exact ⟨scR s₀, by simp, e64⟩ - · rw [← hC.saved p hp'] - refine hf.readW (r := ⟨scA s₀ + BitVec.ofNat 64 p.2, 4⟩) (Region.contains_self _ _) ?_ (by decide) - intro r' hr' - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' - rcases hr' with rfl | rfl - · exact hp.st_scr.symm.sub_left (stored_sub hp') - · have := stored_bound p hp' - exact Offset.disjoint_base _ (by omega) (by omega) - -/-! ## The message length -/ - -/-- The bytes `lenW` writes, from `count` in `r2:r3`. -/ -def lenL (s₀ : State) : List Byte := - Spec.Sha256.wordBytes 0 ++ Spec.Sha256.wordBytes (s₀.gpr .r3 >>> 29) ++ - Spec.Sha256.wordBytes ((s₀.gpr .r3 <<< 3) ||| (s₀.gpr .r2 >>> 29)) ++ Spec.Sha256.wordBytes (s₀.gpr .r2 <<< 3) - -theorem lenL_eq {s₀ : State} {iv : HashValue} {m : List Byte} (hm : R₀ s₀ iv m) : lenL s₀ = lenBytes m := by - have hc := hm.2.2 - have h8 : BitVec.ofNat 64 (8 * m.length) = countArm s₀ <<< 3 := by - rw [hc] - apply BitVec.eq_of_toNat_eq - simp only [BitVec.toNat_ofNat, BitVec.toNat_shiftLeft, Nat.shiftLeft_eq] - omega - rw [lenBytes_split m hm.2.1, ← hc, h8, wordBytes_split, wordBytes_split, hi_shr61, lo_shr61, hi_shl3, - lo_shl3] - simp only [countArm, hi_append, lo_append, lenL, List.append_assoc] - -theorem lenL_length (s₀ : State) : (lenL s₀).length = 16 := rfl - -/-- Writing the message length. -/ -theorem len_ok {s₀ : State} (hp : Pre s₀) {s : State} (hC : Common s₀ s) {Q : State → Prop} - (hQ : ∀ s', Common s₀ s' → (∀ r, r ≠ .r9 → r ≠ .r10 → r ≠ .r11 → s'.gpr r = s.gpr r) → - s'.mem = writeBytes s.mem (stA s₀ + 64 + BitVec.ofNat 64 112) (lenL s₀) → Q s') : - WP isa (.block lenW) s Q := by - have hst := hp.st_fit; have hsc := hp.scr_fit - have hin : ∀ o, o + 4 ≤ 272 → InRegions (s.rd ++ s.wr) (scA s₀ + BitVec.ofNat 64 o) 4 := fun o ho => - ⟨scR s₀, by simp [hC.wr, hC.rd, hp.wr], contains_offset (by omega) (by omega)⟩ - have hout : ∀ o, o + 4 ≤ 192 → InRegions s.wr (stA s₀ + BitVec.ofNat 64 o) 4 := fun o ho => - ⟨stR s₀, by simp [hC.wr, hp.wr], contains_offset (by omega) (by omega)⟩ - have h2 := hC.saved (.r2, 260) (by decide) - have h3 := hC.saved (.r3, 264) (by decide) - unfold lenW - refine wp_ldr (a := scA s₀ + BitVec.ofNat 64 260) (by decide) (by rw [hC.r3, addr_add (by omega)]) - (hin 260 (by omega)) fun s₁ u₁ => ?_ - refine wp_ldr (a := scA s₀ + BitVec.ofNat 64 264) (by decide) - (by rw [u₁.other _ (by decide), hC.r3, addr_add (by omega)]) - (by rw [u₁.rd, u₁.wr]; exact hin 264 (by omega)) fun s₂ u₂ => ?_ - have e0 : s₂.gpr .r0 = st s₀ := by rw [u₂.other _ (by decide), u₁.other _ (by decide), hC.r0] - have e9 : s₂.gpr .r9 = s₀.gpr .r2 := by rw [u₂.other _ (by decide), u₁.gpr, h2] - have e10 : s₂.gpr .r10 = s₀.gpr .r3 := by rw [u₂.gpr, u₁.mem, h3] - refine wp_mov (op2_imm (by decide)) fun s₃ u₃ => - wp_str (a := stA s₀ + BitVec.ofNat 64 176) (by decide) - (by rw [u₃.other _ (by decide), e0, addr_add (by omega)]) - (by rw [u₃.wr, u₂.wr, u₁.wr]; exact hout 176 (by omega)) fun s₄ g₄ => ?_ - refine wp_mov (op2_lsr (by decide)) fun s₅ u₅ => wp_rev fun s₆ u₆ => - wp_str (a := stA s₀ + BitVec.ofNat 64 180) (by decide) - (by rw [u₆.other _ (by decide), u₅.other _ (by decide), g₄.gpr, u₃.other _ (by decide), e0, - addr_add (by omega)]) - (by rw [u₆.wr, u₅.wr, g₄.wr, u₃.wr, u₂.wr, u₁.wr]; exact hout 180 (by omega)) fun s₇ g₇ => ?_ - refine wp_mov (op2_lsl (by decide)) fun s₈ u₈ => wp_orr (op2_lsr (by decide)) fun s₉ u₉ => - wp_rev fun s₁₀ u₁₀ => wp_str (a := stA s₀ + BitVec.ofNat 64 184) (by decide) - (by rw [u₁₀.other _ (by decide), u₉.other _ (by decide), u₈.other _ (by decide), g₇.gpr, - u₆.other _ (by decide), u₅.other _ (by decide), g₄.gpr, u₃.other _ (by decide), e0, addr_add (by omega)]) - (by rw [u₁₀.wr, u₉.wr, u₈.wr, g₇.wr, u₆.wr, u₅.wr, g₄.wr, u₃.wr, u₂.wr, u₁.wr]; exact hout 184 (by omega)) - fun s₁₁ g₁₁ => ?_ - refine wp_mov (op2_lsl (by decide)) fun s₁₂ u₁₂ => wp_rev fun s₁₃ u₁₃ => - wp_str (a := stA s₀ + BitVec.ofNat 64 188) (by decide) - (by rw [u₁₃.other _ (by decide), u₁₂.other _ (by decide), g₁₁.gpr, u₁₀.other _ (by decide), - u₉.other _ (by decide), u₈.other _ (by decide), g₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), - g₄.gpr, u₃.other _ (by decide), e0, addr_add (by omega)]) - (by rw [u₁₃.wr, u₁₂.wr, g₁₁.wr, u₁₀.wr, u₉.wr, u₈.wr, g₇.wr, u₆.wr, u₅.wr, g₄.wr, u₃.wr, u₂.wr, u₁.wr] - exact hout 188 (by omega)) - fun s₁₄ g₁₄ => WP.block_nil ?_ - have keep : ∀ r, r ≠ .r9 → r ≠ .r10 → r ≠ .r11 → s₁₄.gpr r = s.gpr r := fun r a b c => by - rw [g₁₄.gpr, u₁₃.other r c, u₁₂.other r c, g₁₁.gpr, u₁₀.other r c, u₉.other r c, u₈.other r c, g₇.gpr, - u₆.other r c, u₅.other r c, g₄.gpr, u₃.other r c, u₂.other r b, u₁.other r a] - -- The values stored. - have v1 : s₆.gpr .r11 = rev (s₀.gpr .r3 >>> 29) := by - rw [u₆.gpr, u₅.gpr, g₄.gpr, u₃.other _ (by decide), e10] - have v2 : s₁₀.gpr .r11 = rev ((s₀.gpr .r3 <<< 3) ||| (s₀.gpr .r2 >>> 29)) := by - rw [u₁₀.gpr, u₉.gpr, u₈.gpr, u₈.other .r9 (by decide), g₇.gpr, u₆.other .r10 (by decide), - u₆.other .r9 (by decide), u₅.other .r10 (by decide), u₅.other .r9 (by decide), g₄.gpr, - u₃.other .r10 (by decide), u₃.other .r9 (by decide), e10, e9] - have v3 : s₁₃.gpr .r11 = rev (s₀.gpr .r2 <<< 3) := by - rw [u₁₃.gpr, u₁₂.gpr, g₁₁.gpr, u₁₀.other _ (by decide), u₉.other _ (by decide), u₈.other _ (by decide), - g₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), g₄.gpr, u₃.other _ (by decide), e9] - have v0 : s₃.gpr .r11 = rev 0 := by rw [u₃.gpr]; decide - have hw : s₁₄.mem = writeBytes s.mem (stA s₀ + 64 + BitVec.ofNat 64 112) (lenL s₀) := by - have a1 : stA s₀ + BitVec.ofNat 64 180 = stA s₀ + BitVec.ofNat 64 176 + BitVec.ofNat 64 4 := by - rw [BitVec.add_assoc]; rfl - have a2 : stA s₀ + BitVec.ofNat 64 184 = stA s₀ + BitVec.ofNat 64 176 + BitVec.ofNat 64 8 := by - rw [BitVec.add_assoc]; rfl - have a3 : stA s₀ + BitVec.ofNat 64 188 = stA s₀ + BitVec.ofNat 64 176 + BitVec.ofNat 64 12 := by - rw [BitVec.add_assoc]; rfl - have a0 : stA s₀ + 64 + BitVec.ofNat 64 112 = stA s₀ + BitVec.ofNat 64 176 := by - rw [BitVec.add_assoc]; rfl - rw [g₁₄.mem, u₁₃.mem, u₁₂.mem, g₁₁.mem, u₁₀.mem, u₉.mem, u₈.mem, g₇.mem, u₆.mem, u₅.mem, g₄.mem, u₃.mem, - u₂.mem, u₁.mem, v3, v2, v1, v0, writeW_rev, writeW_rev, writeW_rev, writeW_rev, a0, a1, a2, a3, - show (4 : Nat) = (Spec.Sha256.wordBytes 0).length from rfl, - writeBytes_append _ _ _ _ (by simp [Spec.Sha256.wordBytes]), - show (8 : Nat) = (Spec.Sha256.wordBytes 0 ++ Spec.Sha256.wordBytes (s₀.gpr .r3 >>> 29)).length from rfl, - writeBytes_append _ _ _ _ (by simp [Spec.Sha256.wordBytes]), - show (12 : Nat) = (Spec.Sha256.wordBytes 0 ++ Spec.Sha256.wordBytes (s₀.gpr .r3 >>> 29) ++ - Spec.Sha256.wordBytes ((s₀.gpr .r3 <<< 3) ||| (s₀.gpr .r2 >>> 29))).length from rfl, - writeBytes_append _ _ _ _ (by simp [Spec.Sha256.wordBytes])] - rfl - obtain ⟨-, hfr, hsv⟩ := hC.writeBuf hp (n := 112) (xs := lenL s₀) (by rw [lenL_length]) - refine hQ s₁₄ ⟨?_, ?_, by rw [keep _ (by decide) (by decide) (by decide), hC.r0], - by rw [keep _ (by decide) (by decide) (by decide), hC.r3], - by rw [keep _ (by decide) (by decide) (by decide), hC.r6], ?_, by rw [hw]; exact hfr, - by rw [hw]; exact hsv⟩ keep hw - · rw [g₁₄.rd, u₁₃.rd, u₁₂.rd, g₁₁.rd, u₁₀.rd, u₉.rd, u₈.rd, g₇.rd, u₆.rd, u₅.rd, g₄.rd, u₃.rd, u₂.rd, u₁.rd, - hC.rd] - · rw [g₁₄.wr, u₁₃.wr, u₁₂.wr, g₁₁.wr, u₁₀.wr, u₉.wr, u₈.wr, g₇.wr, u₆.wr, u₅.wr, g₄.wr, u₃.wr, u₂.wr, u₁.wr, - hC.wr] - · rw [g₁₄.sp, u₁₃.sp, u₁₂.sp, g₁₁.sp, u₁₀.sp, u₉.sp, u₈.sp, g₇.sp, u₆.sp, u₅.sp, g₄.sp, u₃.sp, u₂.sp, u₁.sp, - hC.sp] - -/-! ## One block -/ - -/-- The end of the loop's body: the length, if this is the last block, and -the compression. -/ -def tailP : Prog isa := - .seq (.block [.cmp .r5 (.imm 0)]) - (.seq (.ite .eq (.block lenW) (.block [])) - (.seq compressAt (.block [.mov .r4 (.imm 0), .subs .r5 .r5 (.imm 1)]))) - -/-- The loop's body up to `T`: zeroing the rest of the block. -/ -def padded (T : Prog isa) : Prog isa := - .seq (.block [.mov .r9 (.imm 128), .cmp .r5 (.imm 0)]) - (.seq (.ite .eq (.block [.mov .r9 (.imm 112)]) (.block [])) - (.seq (.block [.mov .r12 (.imm 0), .subs .r9 .r9 (.reg .r4)]) - (.seq (.ite .eq (.block []) (.loop (.block zeroBody) .ne)) T))) - -theorem body_eq : finalizeBody = padded tailP := rfl - -def bodyEnd : List Instr := [.mov .r4 (.imm 0), .subs .r5 .r5 (.imm 1)] - -/-- The loop's body before the call of the compression function. -/ -def bodyPre : Prog isa := - .seq (.seq (.seq (.seq (.seq (.block [.mov .r9 (.imm 128), .cmp .r5 (.imm 0)]) - (.ite .eq (.block [.mov .r9 (.imm 112)]) (.block []))) - (.block [.mov .r12 (.imm 0), .subs .r9 .r9 (.reg .r4)])) - (.ite .eq (.block []) (.loop (.block zeroBody) .ne))) - (.block [.cmp .r5 (.imm 0)])) - (.ite .eq (.block lenW) (.block [])) - -/-- Zeroing the rest of the block, up to the length or its end. -/ -theorem pad_ok {s₀ : State} (hp : Pre s₀) {k n : Nat} {s : State} (h : LInv s₀ k n s) {T : Prog isa} - {Q : State → Prop} - (hQ : ∀ s', Common s₀ s' → s'.gpr .r5 = BitVec.ofNat 32 k → - stateAt s'.mem (stA s₀) = stateAt s.mem (stA s₀) → - bytesAt s'.mem (stA s₀ + 64) (112 + 16 * k) = - bytesAt s.mem (stA s₀ + 64) n ++ List.replicate (112 + 16 * k - n) 0 → - WP isa T s' Q) : - WP isa (padded T) s Q := by - have hk := h.k_le; have hn := h.n_le; have hst := hp.st_fit - have hC := h.toCommon - unfold padded - -- `r9 := 128` or `112`: the end of the zeros. - refine WP.seq (wp_mov (op2_imm (by decide)) fun s₁ u₁ => wp_cmp (op2_imm (by decide)) fun s₂ f₂ z₂ => - WP.block_nil ?_) - have hz₂ : s₂.z = decide (k = 0) := by rw [z₂, u₁.other _ (by decide), h.r5, cmp0 (by omega)] - refine WP.seq (WP.mono (Q := fun (s₃ : State) => s₃.gpr .r9 = BitVec.ofNat 32 (112 + 16 * k) ∧ - (∀ r, r ≠ .r9 → s₃.gpr r = s.gpr r) ∧ s₃.mem = s.mem ∧ s₃.rd = s.rd ∧ s₃.wr = s.wr ∧ - s₃.sp = s.sp) ?_ fun s₃ ⟨h9₃, g₃, m₃, rd₃, wr₃, sp₃⟩ => ?_) - · refine WP.ite (decide (k = 0)) (by show VG.Arm.eval .eq s₂ = _; rw [eval_eq, hz₂]) - (fun hb => ?_) (fun hb => ?_) - · simp only [decide_eq_true_eq] at hb; subst hb - refine wp_mov (op2_imm (by decide)) fun s₃ u₃ => WP.block_nil ⟨by rw [u₃.gpr]; rfl, fun r hr => ?_, - by rw [u₃.mem, f₂.mem, u₁.mem], by rw [u₃.rd, f₂.rd, u₁.rd], by rw [u₃.wr, f₂.wr, u₁.wr], - by rw [u₃.sp, f₂.sp, u₁.sp]⟩ - rw [u₃.other r hr, f₂.gpr, u₁.other r hr] - · simp only [decide_eq_false_iff_not] at hb - refine WP.block_nil ⟨by rw [f₂.gpr, u₁.gpr, show k = 1 by omega]; rfl, fun r hr => ?_, - by rw [f₂.mem, u₁.mem], by rw [f₂.rd, u₁.rd], by rw [f₂.wr, u₁.wr], by rw [f₂.sp, u₁.sp]⟩ - rw [f₂.gpr, u₁.other r hr] - -- Zero the rest of the buffer, up to `lim`. - refine WP.seq (wp_mov (op2_imm (by decide)) fun s₄ u₄ => wp_subs (op2_reg _ _) fun s₅ u₅ z₅ => - WP.block_nil ?_) - have h9₅ : s₅.gpr .r9 = BitVec.ofNat 32 (112 + 16 * k - n) := by - rw [u₅.gpr, u₄.other _ (by decide), h9₃, u₄.other _ (by decide), g₃ _ (by decide), h.r4, - sub_ofNat (by omega)] - have hZ : Zero s₀ s n (112 + 16 * k) 0 s₅ := by - refine ⟨Nat.zero_le _, fun r hr => ?_, by rw [u₅.rd, u₄.rd, rd₃], by rw [u₅.wr, u₄.wr, wr₃], - by rw [u₅.sp, u₄.sp, sp₃], ?_, ?_, by rw [h9₅, Nat.sub_zero], ?_⟩ - · have : r ≠ .r9 ∧ r ≠ .r12 := by - simp only [keepRegs, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide - rw [u₅.other r this.1, u₄.other r this.2, g₃ r this.1] - · rw [u₅.other _ (by decide), u₄.gpr] - · rw [u₅.other _ (by decide), u₄.other _ (by decide), g₃ _ (by decide), h.r4, Nat.add_zero] - · rw [u₅.mem, u₄.mem, m₃, List.replicate_zero, writeBytes_nil] - have hz₅ : s₅.z = decide (112 + 16 * k - n - 0 = 0) := by - rw [z₅, ← u₅.gpr, h9₅, ofNat_beq_zero (by omega), Nat.sub_zero] - refine WP.seq (WP.mono (zero_ok hp hC (by omega) hn hZ hz₅) fun s₆ hZ₆ => ?_) - obtain ⟨-, hfr₆, hsv₆⟩ := hC.writeBuf hp (n := n) (xs := List.replicate (112 + 16 * k - n) 0) - (by simp only [List.length_replicate]; omega) - refine hQ s₆ ⟨hZ₆.rd.trans hC.rd, hZ₆.wr.trans hC.wr, by rw [hZ₆.keep _ (by simp [keepRegs]), hC.r0], - by rw [hZ₆.keep _ (by simp [keepRegs]), hC.r3], by rw [hZ₆.keep _ (by simp [keepRegs]), hC.r6], - hZ₆.sp.trans hC.sp, - by rw [hZ₆.mem]; exact hfr₆, by rw [hZ₆.mem]; exact hsv₆⟩ - (by rw [hZ₆.keep _ (by simp [keepRegs]), h.r5]) ?_ ?_ - · rw [hZ₆.mem] - apply stateAt_congr - intro i hi - rw [st_add] - exact writeBytes_before _ _ _ (by omega) (by simp only [List.length_replicate]; omega) - · rw [hZ₆.mem, ← bytesAt_writeBytes _ _ _ _ (by simp only [List.length_replicate]; omega)] - congr 1; simp only [List.length_replicate]; omega - -/-- What the end of the loop's body leaves: the length, if this is the last -block, and the compression. -/ -def TailPost (s₀ : State) (k : Nat) (H : HashValue) (B : List Byte) (s' : State) : Prop := - Common s₀ s' ∧ VG.Arm.eval .eq s' = some (decide (k = 1)) ∧ - s'.gpr .r4 = 0 ∧ s'.gpr .r5 = BitVec.ofNat 32 k - 1 ∧ - ∀ iv m, R₀ s₀ iv m → stateAt s'.mem (stA s₀) = - compress H (parseBlock fun t => (B ++ if k = 1 then [] else lenBytes m).getD t 0) - -/-- The length, if this is the last block, and the compression. -/ -theorem tailPre_ok {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k ≤ 1) {s : State} (hC : Common s₀ s) - (h5 : s.gpr .r5 = BitVec.ofNat 32 k) {H : HashValue} {B : List Byte} - (hst : stateAt s.mem (stA s₀) = H) (hby : bytesAt s.mem (stA s₀ + 64) (112 + 16 * k) = B) : - WP isa (.seq (.block [.cmp .r5 (.imm 0)]) (.ite .eq (.block lenW) (.block []))) s fun s₂ => - Common s₀ s₂ ∧ WP isa (.seq compressAt (.block bodyEnd)) s₂ (TailPost s₀ k H B) := by - have hst' := hp.st_fit - refine WP.seq (wp_cmp (op2_imm (by decide)) fun s₁ f₁ z₁ => WP.block_nil ?_) - have hC₁ := hC.of_flags f₁ - have hz₁ : s₁.z = decide (k = 0) := by rw [z₁, h5, cmp0 (by omega)] - refine (WP.mono (Q := fun (s₂ : State) => Common s₀ s₂ ∧ s₂.gpr .r5 = BitVec.ofNat 32 k ∧ - stateAt s₂.mem (stA s₀) = H ∧ - ∀ iv m, R₀ s₀ iv m → bytesAt s₂.mem (stA s₀ + 64) 128 = B ++ if k = 1 then [] else lenBytes m) ?_ - fun s₂ ⟨hC₂, h5₂, hst₂, hby₂⟩ => ?_) - · refine WP.ite (decide (k = 0)) (by show VG.Arm.eval .eq s₁ = _; rw [eval_eq, hz₁]) - (fun hb => ?_) (fun hb => ?_) - · simp only [decide_eq_true_eq] at hb; subst hb - refine len_ok hp hC₁ fun s₂ hC₂ keep hw => - ⟨hC₂, by rw [keep _ (by decide) (by decide) (by decide), f₁.gpr, h5], ?_, fun iv m hm => ?_⟩ - · rw [hw, ← hst, ← f₁.mem] - apply stateAt_congr - intro i hi - rw [st_add] - exact writeBytes_before _ _ _ (by omega) (by rw [lenL_length]; omega) - · have e := bytesAt_writeBytes s₁.mem (stA s₀ + 64) 112 (lenL s₀) (by rw [lenL_length]; omega) - rw [lenL_length] at e - rw [show 112 + 16 * 0 = 112 from rfl] at hby - rw [hw, e, f₁.mem, hby, lenL_eq hm] - simp - · simp only [decide_eq_false_iff_not] at hb - have hk1 : k = 1 := by omega - subst hk1 - rw [show 112 + 16 * 1 = 128 from rfl] at hby - exact WP.block_nil ⟨hC₁, by rw [f₁.gpr, h5], by rw [f₁.mem, hst], fun iv m _ => by rw [f₁.mem, hby]; simp⟩ - -- Compress the block. - refine ⟨hC₂, WP.seq (compress_buf hp hC₂ fun s₃ hC₃ g₃ hst₃ => ?_)⟩ - refine wp_mov (op2_imm (by decide)) fun s₄ u₄ => wp_subs (op2_imm (by decide)) fun s₅ u₅ z₅ => - WP.block_nil ?_ - have h5₃ : s₃.gpr .r5 = BitVec.ofNat 32 k := by rw [g₃ _ (by decide) (by decide), h5₂] - refine ⟨(hC₃.of_upd u₄ (by decide)).of_upd u₅ (by decide), ?_, ?_, ?_, fun iv m hm => ?_⟩ - · rw [eval_eq, z₅, u₄.other _ (by decide), h5₃, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, - sub_beq (by omega) (by omega)] - · rw [u₅.other _ (by decide), u₄.gpr] - · rw [u₅.gpr, u₄.other _ (by decide), h5₃] - · rw [u₅.mem, u₄.mem, hst₃, hst₂] - exact congrArg (compress H) (parseBlock_congr fun t ht => bytesAt_getD (hby₂ iv m hm) ht) - -theorem tail_ok {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k ≤ 1) {s : State} (hC : Common s₀ s) - (h5 : s.gpr .r5 = BitVec.ofNat 32 k) {H : HashValue} {B : List Byte} - (hst : stateAt s.mem (stA s₀) = H) (hby : bytesAt s.mem (stA s₀ + 64) (112 + 16 * k) = B) : - WP isa tailP s (TailPost s₀ k H B) := - WP.assoc (WP.seq (WP.mono (tailPre_ok hp hk hC h5 hst hby) fun _ h => h.2)) - -/-- The loop's postcondition for one iteration. -/ -def Step (s₀ : State) (k : Nat) (s : State) : Prop := - (VG.Arm.eval .eq s = some false ∧ k = 0 ∧ Done s₀ s) ∨ (VG.Arm.eval .eq s = some true ∧ k = 1 ∧ LInv s₀ 0 0 s) - -theorem step_of {s₀ : State} {k n : Nat} {s : State} (h : LInv s₀ k n s) {s' : State} - (ht : TailPost s₀ k (stateAt s.mem (stA s₀)) - (bytesAt s.mem (stA s₀ + 64) n ++ List.replicate (112 + 16 * k - n) 0) s') : Step s₀ k s' := by - have hk := h.k_le; have hn := h.n_le - obtain ⟨hC', he, h4, h5, hst'⟩ := ht - by_cases hk1 : k = 1 - · subst hk1 - refine .inr ⟨by rw [he]; rfl, rfl, ⟨hC', by omega, by omega, by rw [h4]; rfl, by rw [h5]; rfl, - fun iv m hm => ?_⟩⟩ - rw [h.hash iv m hm] - simp only [ite_true, show ¬ ((0 : Nat) = 1) by decide, ite_false, Fin1, Fin0, hst' iv m hm, - List.append_nil, show 112 + 16 * 1 - n = 128 - n by omega, Nat.sub_zero] - rfl - · have hk0 : k = 0 := by omega - subst hk0 - refine .inl ⟨by rw [he]; rfl, rfl, hC', fun iv m hm => ?_⟩ - rw [h.hash iv m hm, hst' iv m hm] - simp only [show ¬ ((0 : Nat) = 1) by decide, ite_false, Fin0, Nat.mul_zero, Nat.add_zero] - -theorem body_ok {s₀ : State} (hp : Pre s₀) {k n : Nat} {s : State} (h : LInv s₀ k n s) : - WP isa finalizeBody s (Step s₀ k) := - pad_ok hp h fun _ hC₁ h5₁ hst₁ hby₁ => - WP.mono (tail_ok hp h.k_le hC₁ h5₁ hst₁ hby₁) fun _ ht => step_of h ht - -theorem pre_ok {s₀ : State} (hp : Pre s₀) {k n : Nat} {s : State} (h : LInv s₀ k n s) : - WP isa bodyPre s fun s' => Common s₀ s' ∧ WP isa (.seq compressAt (.block bodyEnd)) s' (Step s₀ k) := by - unfold bodyPre - exact WP.assoc' (WP.assoc' (WP.assoc' (WP.assoc' (pad_ok hp h fun _ hC₁ h5₁ hst₁ hby₁ => - WP.mono (tailPre_ok hp h.k_le hC₁ h5₁ hst₁ hby₁) fun _ h' => ⟨h'.1, WP.mono h'.2 fun _ ht => step_of h ht⟩)))) - -/-! ## Prologue -/ - -set_option simprocs false in -theorem saveMem_stored (m : Mem) (B : Addr) (g : Reg → BitVec 32) : - ∀ p ∈ stored, (saveMem m B g stored).readW (B + BitVec.ofNat 64 p.2) 32 = g p.1 := by - intro p hp - simp only [stored, saved, List.cons_append, List.nil_append, List.mem_cons, List.not_mem_nil, - or_false] at hp - rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> - simp (config := {decide := true}) only [stored, saved, List.cons_append, List.nil_append, saveMem, - Mem.readW_writeW_self32, readW_writeW_save] - -/-- Whether the prologue pads two blocks. -/ -def kOf (s₀ : State) : Nat := (cnt s₀ % 128 + 16) / 128 - -/-- The prologue after saving. -/ -def prologue : List Instr := - [.mov .r3 (.reg .r12), .ldrSp .r6 0, .dp .and .r4 .r2 (.imm 127), - .mov .r12 (.imm 0x80), .dp .add .r1 .r0 (.reg .r4), .strb .r12 .r1 64, .dp .add .r4 .r4 (.imm 1), - .dp .add .r5 .r4 (.imm 15), .mov .r5 (.shifted .r5 .lsr 7)] - -theorem finalize_eq : finalize = - .seq (.block (([.ldrSp .r12 4] : List Instr) ++ (stored.map (fun p => Instr.str p.1 .r12 p.2) ++ prologue))) - (.seq (.loop finalizeBody .eq) (.block ((List.range 8).flatMap outW ++ restore))) := rfl - -theorem argAddr_eq {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 2) : - stackArgAddr s₀ k = stackArgAddr s₀ 0 + BitVec.ofNat 64 (4 * k) := by - have := hp.sp_fit - simp only [stackArgAddr] - rw [addr_add (by omega)] - simp - -theorem arg_in {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 2) : - InRegions (s₀.rd ++ s₀.wr) (stackArgAddr s₀ k) 4 := - ⟨argR s₀, by simp [hp.rd], by rw [argAddr_eq hp hk]; exact contains_offset (by omega) (by omega)⟩ - -theorem arg_sub {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 2) : - Region.Sub ⟨stackArgAddr s₀ k, 4⟩ (argR s₀) := by - rw [argAddr_eq hp hk]; exact sub_offset (by omega) (by omega) - -theorem prologue_ok {s₀ : State} (hp : Pre s₀) : - WP isa (.block (([.ldrSp .r12 4] : List Instr) ++ (stored.map (fun p => Instr.str p.1 .r12 p.2) ++ prologue))) s₀ - fun s => ∃ k, k = kOf s₀ ∧ LInv s₀ k (cnt s₀ % 128 + 1) s := by - have hr : cnt s₀ % 128 < 128 := Nat.mod_lt _ (by omega) - have hsc := hp.scr_fit; have hst := hp.st_fit - rw [List.singleton_append] - refine wp_ldrSp (a := stackArgAddr s₀ 1) (by decide) rfl (arg_in hp (by decide)) fun s₁ u₁ => ?_ - have h12 : s₁.gpr .r12 = scr s₀ := u₁.gpr - refine saveList_ok stored s₁ _ (fun p hp' => ?_) fun s₂ g₂ rd₂ wr₂ sp₂ m₂ => ?_ - · have := stored_bound p hp' - exact ⟨by omega, by rw [h12]; omega, ⟨scR s₀, by simp [u₁.wr, hp.wr], - by rw [h12]; exact contains_offset (by omega) (by omega)⟩⟩ - have hframe : Frame [scR s₀] s₀.mem s₂.mem := by - rw [m₂, u₁.mem, h12] - exact saveMem_frame _ _ _ (by omega) stored fun p hp' => by have := (stored_bound p hp').2; omega - unfold prologue - refine wp_mov (op2_reg _ _) fun s₃ u₃ => ?_ - refine wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) (by rw [u₃.sp, sp₂, u₁.sp]; rfl) - (by rw [u₃.rd, u₃.wr, rd₂, wr₂, u₁.rd, u₁.wr]; exact arg_in hp (by decide)) - fun s₄ u₄ => wp_and (op2_imm (by decide)) fun s₅ u₅ => ?_ - have hm₅ : s₅.mem = s₂.mem := by rw [u₅.mem, u₄.mem, u₃.mem] - have g₅ : ∀ r, r ∉ [Reg.r3, .r4, .r6, .r12] → s₅.gpr r = s₀.gpr r := fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false, not_or] at hr - rw [u₅.other r hr.2.1, u₄.other r hr.2.2.1, u₃.other r hr.1, g₂, u₁.other r hr.2.2.2] - have hC₅ : Common s₀ s₅ := by - refine ⟨by rw [u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd], by rw [u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr], - g₅ _ (by decide), ?_, ?_, by rw [u₅.sp, u₄.sp, u₃.sp, sp₂, u₁.sp], - by rw [hm₅]; exact hframe.mono (by simp), fun p hp' => ?_⟩ - · rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, g₂, h12] - · rw [u₅.other _ (by decide), u₄.gpr, u₃.mem] - exact hframe.readW (Region.contains_self _ _) (by simpa using (hp.a_scr.sub_left (arg_sub hp (by decide)))) - (by decide) - · rw [hm₅, m₂, u₁.mem, h12, saveMem_stored _ _ _ p hp', u₁.other] - simp only [stored, Impl.Sha512.Arm.Stream.saved, List.cons_append, List.nil_append, List.mem_cons, - List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> decide - have hr4 : s₅.gpr .r4 = BitVec.ofNat 32 (cnt s₀ % 128) := by - rw [u₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), g₂, u₁.other _ (by decide), and127, cnt_mod] - -- The `0x80` byte. - have hout : InRegions s₅.wr (stA s₀ + 64 + BitVec.ofNat 64 (cnt s₀ % 128)) 1 := by - refine ⟨stR s₀, by simp [hC₅.wr, hp.wr], ?_⟩ - rw [st_add]; exact contains_offset (by omega) (by omega) - refine wp_mov (op2_imm (by decide)) fun s₆ u₆ => wp_add (op2_reg _ _) fun s₇ u₇ => - wp_strb (a := stA s₀ + 64 + BitVec.ofNat 64 (cnt s₀ % 128)) (by omega) ?_ - (by rw [u₇.wr, u₆.wr]; exact hout) fun s₈ g₈ => ?_ - · rw [u₇.gpr, u₆.other _ (by decide), u₆.other _ (by decide), hC₅.r0, hr4, buf_addr hp hr] - obtain ⟨-, hfr, hsv⟩ := hC₅.writeBuf hp (n := cnt s₀ % 128) (xs := [0x80]) (by simp; omega) - have hm₈ : s₈.mem = writeBytes s₅.mem (stA s₀ + 64 + BitVec.ofNat 64 (cnt s₀ % 128)) [0x80] := by - rw [g₈.mem, u₇.mem, u₆.mem, u₇.other _ (by decide), u₆.gpr, ← List.nil_append [(0x80 : Byte)], - writeBytes_snoc _ _ _ _ (by simp), writeBytes_nil] - simp - refine wp_add (op2_imm (by decide)) fun s₉ u₉ => wp_add (op2_imm (by decide)) fun s₁₀ u₁₀ => - wp_mov (op2_lsr (by decide)) fun s₁₁ u₁₁ => WP.block_nil ?_ - have keep : ∀ r, r ≠ .r4 → r ≠ .r5 → r ≠ .r12 → r ≠ .r1 → s₁₁.gpr r = s₅.gpr r := - fun r h1 h2 h3 h4 => by - rw [u₁₁.other r h2, u₁₀.other r h2, u₉.other r h1, g₈.gpr, u₇.other r h4, u₆.other r h3] - have hm₁₁ : s₁₁.mem = s₈.mem := by rw [u₁₁.mem, u₁₀.mem, u₉.mem] - have hC₁₁ : Common s₀ s₁₁ := - ⟨by rw [u₁₁.rd, u₁₀.rd, u₉.rd, g₈.rd, u₇.rd, u₆.rd, hC₅.rd], - by rw [u₁₁.wr, u₁₀.wr, u₉.wr, g₈.wr, u₇.wr, u₆.wr, hC₅.wr], - by rw [keep _ (by decide) (by decide) (by decide) (by decide), hC₅.r0], - by rw [keep _ (by decide) (by decide) (by decide) (by decide), hC₅.r3], - by rw [keep _ (by decide) (by decide) (by decide) (by decide), hC₅.r6], - by rw [u₁₁.sp, u₁₀.sp, u₉.sp, g₈.sp, u₇.sp, u₆.sp, hC₅.sp], - by rw [hm₁₁, hm₈]; exact hfr, by rw [hm₁₁, hm₈]; exact hsv⟩ - have hr4₉ : s₉.gpr .r4 = BitVec.ofNat 32 (cnt s₀ % 128 + 1) := by - rw [u₉.gpr, g₈.gpr, u₇.other _ (by decide), u₆.other _ (by decide), hr4, - show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, ← BitVec.ofNat_add] - have hr4' : s₁₁.gpr .r4 = BitVec.ofNat 32 (cnt s₀ % 128 + 1) := by - rw [u₁₁.other _ (by decide), u₁₀.other _ (by decide), hr4₉] - have hr5 : s₁₁.gpr .r5 = BitVec.ofNat 32 ((cnt s₀ % 128 + 16) / 128) := by - rw [u₁₁.gpr, u₁₀.gpr, hr4₉, show (15 : BitVec 32) = BitVec.ofNat 32 15 from rfl, ← BitVec.ofNat_add, - shr7 (by omega)] - -- The facts about the buffer. - have hbytes : ∀ iv m, R₀ s₀ iv m → - bytesAt s₁₁.mem (stA s₀ + 64) (cnt s₀ % 128 + 1) = rest m ++ [0x80] := by - intro iv m hm - have e := bytesAt_writeBytes s₅.mem (stA s₀ + 64) (cnt s₀ % 128) [0x80] (by simp; omega) - simp only [List.length_singleton] at e - rw [hm₁₁, hm₈, e, hm₅] - congr 1 - rw [hm.length] - refine (bytesAt_congr ?_).trans hm.1.2 - intro i hi - have := frame_bytes hframe (R := stR s₀) (by simpa using hp.st_scr) (by simp) (i := 64 + i) - (by show 64 + i < 192; omega) - rwa [← st_add] at this - have hstate : stateAt s₁₁.mem (stA s₀) = stateAt s₀.mem (stA s₀) := by - apply stateAt_congr - intro i hi - rw [hm₁₁, hm₈, st_add, writeBytes_before _ _ _ (by omega) (by simp; omega), hm₅] - exact frame_bytes hframe (R := stR s₀) (by simpa using hp.st_scr) (by simp) (by show i < 192; omega) - by_cases hb : 112 ≤ cnt s₀ % 128 - · have hk : (cnt s₀ % 128 + 16) / 128 = 1 := by omega - refine ⟨1, hk.symm, hC₁₁, (Nat.le_refl _), by omega, hr4', by rw [hr5, hk], fun iv m hm => ?_⟩ - simp only [↓reduceIte] - rw [hash_two (by rw [← hm.length]; omega), Fin1, hbytes iv m hm, hstate, hm.1.1, - ← hm.length, show 128 - (cnt s₀ % 128 + 1) = 127 - cnt s₀ % 128 by omega] - · have hk : (cnt s₀ % 128 + 16) / 128 = 0 := by omega - refine ⟨0, hk.symm, hC₁₁, by omega, by omega, hr4', by rw [hr5, hk], fun iv m hm => ?_⟩ - simp only [show ((0 : Nat) = 1) = False by decide, ite_false] - rw [hash_one (by rw [← hm.length]; omega), Fin0, hbytes iv m hm, hstate, hm.1.1, - ← hm.length, show 112 - (cnt s₀ % 128 + 1) = 111 - cnt s₀ % 128 by omega] - -/-! ## Output and epilogue -/ - -/-- `k` words of the digest are written. -/ -structure Out (s₀ sD : State) (k : Nat) (s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - keep : ∀ r ∈ keepRegs, s.gpr r = sD.gpr r - sp : s.sp = sD.sp - mem : s.mem = writeBytes sD.mem (outA s₀) (((stateAt sD.mem (stA s₀)).toList.take k).flatMap wordBytes) - theorem flat_length (H : HashValue) (k : Nat) (hk : k ≤ 8) : ((H.toList.take k).flatMap wordBytes).length = 8 * k := by rw [List.length_flatMap] @@ -769,315 +43,165 @@ theorem flat_length (H : HashValue) (k : Nat) (hk : k ≤ 8) : rw [List.map_congr_left this, List.map_const', List.sum_replicate_nat, List.length_take] simp; omega -theorem out_frame (s₀ : State) (m : Mem) (xs : List Byte) (hx : xs.length ≤ 64) : - Frame [outR s₀] m (writeBytes m (outA s₀) xs) := - writeBytes_frame _ _ _ (by - rw [show outA s₀ = outA s₀ + BitVec.ofNat 64 0 by simp] - exact contains_offset (by omega) (by omega)) +theorem lo_shr61 (x : BitVec 64) : lo (x >>> 61) = hi x >>> 29 := Word64.lo_shr61 x -theorem out_step {s₀ : State} (hp : Pre s₀) {sD : State} (hD : Done s₀ sD) {k : Nat} (hk : k < 8) - {s : State} (h : Out s₀ sD k s) {rest : List Instr} {Q : State → Prop} - (hnext : ∀ s', Out s₀ sD (k + 1) s' → WP isa (.block rest) s' Q) : - WP isa (.block (outW k ++ rest)) s Q := by - have hC := hD.1 - have hst := hp.st_fit; have ho := hp.out_fit - have hr0 : s.gpr .r0 = st s₀ := by rw [h.keep _ (by simp [keepRegs]), hC.r0] - have hr6 : s.gpr .r6 = out s₀ := by rw [h.keep _ (by simp [keepRegs]), hC.r6] - have hP := flat_length (stateAt sD.mem (stA s₀)) k (Nat.le_of_lt hk) - -- The word's halves, unchanged since `Done`. - have hread : ∀ o, o + 4 ≤ 8 → s.mem.readW (stA s₀ + BitVec.ofNat 64 (8 * k + o)) 32 = - sD.mem.readW (stA s₀ + BitVec.ofNat 64 (8 * k + o)) 32 := by - intro o ho' - rw [h.mem] - refine (out_frame s₀ sD.mem _ (by omega)).readW (r := ⟨stA s₀ + BitVec.ofNat 64 (8 * k + o), 4⟩) - (Region.contains_self _ _) ?_ (by decide) - intro r' hr' - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' - subst hr' - exact hp.st_out.sub_left (sub_offset (by omega) (by omega)) - have hw : (stateAt sD.mem (stA s₀))[k] = sD.mem.readW (stA s₀ + BitVec.ofNat 64 (8 * k)) 64 := by - simp [stateAt] - have wlo : sD.mem.readW (stA s₀ + BitVec.ofNat 64 (8 * k + 0)) 32 = lo (stateAt sD.mem (stA s₀))[k] := by - rw [hw, readW_lo, Nat.add_zero] - have whi : sD.mem.readW (stA s₀ + BitVec.ofNat 64 (8 * k + 4)) 32 = hi (stateAt sD.mem (stA s₀))[k] := by - rw [hw, readW_hi, BitVec.ofNat_add, ← BitVec.add_assoc]; rfl - simp only [outW, List.cons_append, List.nil_append] - refine wp_ldr (a := stA s₀ + BitVec.ofNat 64 (8 * k + 0)) (by omega) (by rw [hr0, addr_add (by omega), Nat.add_zero]) - ⟨stR s₀, by simp [h.rd, h.wr, hp.wr], contains_offset (by omega) (by omega)⟩ fun s₁ u₁ => ?_ - refine wp_ldr (a := stA s₀ + BitVec.ofNat 64 (8 * k + 4)) (by omega) - (by rw [u₁.other _ (by decide), hr0, addr_add (by omega)]) - (by rw [u₁.rd, u₁.wr]; exact ⟨stR s₀, by simp [h.rd, h.wr, hp.wr], contains_offset (by omega) (by omega)⟩) - fun s₂ u₂ => wp_rev fun s₃ u₃ => wp_rev fun s₄ u₄ => ?_ - refine wp_str (a := outA s₀ + BitVec.ofNat 64 (8 * k)) (by omega) - (by rw [u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), - hr6, addr_add (by omega)]) - (by rw [u₄.wr, u₃.wr, u₂.wr, u₁.wr] - exact ⟨outR s₀, by simp [h.wr, hp.wr], contains_offset (by omega) (by omega)⟩) fun s₅ g₅ => ?_ - refine wp_str (a := outA s₀ + BitVec.ofNat 64 (8 * k + 4)) (by omega) - (by rw [g₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), - u₁.other _ (by decide), hr6, addr_add (by omega)]) - (by rw [g₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr] - exact ⟨outR s₀, by simp [h.wr, hp.wr], contains_offset (by omega) (by omega)⟩) fun s₆ g₆ => - hnext s₆ ⟨by rw [g₆.rd, g₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], - by rw [g₆.wr, g₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], fun r hr => ?_, - by rw [g₆.sp, g₅.sp, u₄.sp, u₃.sp, u₂.sp, u₁.sp, h.sp], ?_⟩ - · have : r ≠ .r9 ∧ r ≠ .r10 := by - simp only [keepRegs, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl <;> decide - rw [g₆.gpr, g₅.gpr, u₄.other r this.1, u₃.other r this.2, u₂.other r this.2, u₁.other r this.1, - h.keep r hr] - · have v10 : s₄.gpr .r10 = rev (hi (stateAt sD.mem (stA s₀))[k]) := by - rw [u₄.other _ (by decide), u₃.gpr, u₂.gpr, u₁.mem, hread 4 (by omega), whi] - have v9 : s₅.gpr .r9 = rev (lo (stateAt sD.mem (stA s₀))[k]) := by - rw [g₅.gpr, u₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.gpr, hread 0 (by omega), wlo] - have a4 : outA s₀ + BitVec.ofNat 64 (8 * k + 4) = - outA s₀ + BitVec.ofNat 64 (8 * k) + BitVec.ofNat 64 (Spec.Sha256.wordBytes (hi (stateAt sD.mem (stA s₀))[k])).length := by - rw [BitVec.ofNat_add, ← BitVec.add_assoc]; rfl - have a8 : outA s₀ + BitVec.ofNat 64 (8 * k) = outA s₀ + - BitVec.ofNat 64 (((stateAt sD.mem (stA s₀)).toList.take k).flatMap wordBytes).length := by - rw [hP] - rw [g₆.mem, v9, g₅.mem, v10, u₄.mem, u₃.mem, u₂.mem, u₁.mem, writeW_rev, writeW_rev, a4, - writeBytes_append _ _ _ _ (by simp [Spec.Sha256.wordBytes]), ← wordBytes_split, h.mem, a8, - writeBytes_append _ _ _ _ (by rw [hP]; simp [wordBytes]; omega), List.take_add_one, - List.getElem?_eq_getElem (by simp; omega), Option.toList_some, List.flatMap_append, - List.flatMap_singleton, Vector.getElem_toList] +theorem hi_shr61 (x : BitVec 64) : hi (x >>> 61) = 0 := Word64.hi_shr61 x -/-- The epilogue's postcondition. -/ -def Post (s₀ s' : State) : Prop := abiPreserved s₀ s' ∧ Proof.Sha512.finalizeArm.post s₀ s' +/-! ## The length field -/ -theorem epilogue_ok {s₀ : State} (hp : Pre s₀) {sD : State} (hD : Done s₀ sD) {s : State} - (h : Out s₀ sD 8 s) : WP isa (.block restore) s (Post s₀) := by - have hC := hD.1 - have hfo := out_frame s₀ sD.mem (((stateAt sD.mem (stA s₀)).toList.take 8).flatMap wordBytes) - (by rw [flat_length _ _ (Nat.le_refl _)]) - refine restore_ok (scr := scr s₀) (by rw [h.keep _ (by simp [keepRegs]), hC.r3]) hp.scr_fit - (fun d hd₁ hd₂ => ⟨scR s₀, by simp [h.rd, h.wr, hp.wr], contains_offset (by omega) (by omega)⟩) s₀.gpr - (fun p hp' => ?_) fun s' hs ho hmem _ _ hsp => - ⟨⟨preserved_saved hs, - by rw [hsp, h.sp, hC.sp]⟩, fun iv m hr hl hc => ?_⟩ - · rw [h.mem, ← hC.saved p (saved_stored hp')] - refine hfo.readW (r := ⟨scA s₀ + BitVec.ofNat 64 p.2, 4⟩) (Region.contains_self _ _) ?_ (by decide) - intro r' hr' - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' - subst hr' - exact hp.out_scr.symm.sub_left (stored_sub (saved_stored hp')) - · have e := bytesAt_writeBytes sD.mem (outA s₀) 0 (((stateAt sD.mem (stA s₀)).toList.take 8).flatMap wordBytes) - (by rw [flat_length _ _ (Nat.le_refl _)]; omega) - have e' : bytesAt (writeBytes sD.mem (outA s₀) (((stateAt sD.mem (stA s₀)).toList.take 8).flatMap wordBytes)) - (outA s₀) 64 = ((stateAt sD.mem (stA s₀)).toList.take 8).flatMap wordBytes := by - rw [flat_length _ _ (Nat.le_refl _), show outA s₀ + BitVec.ofNat 64 0 = outA s₀ by simp, - show bytesAt sD.mem (outA s₀) 0 = [] from rfl, List.nil_append] at e - exact e - rw [← h.mem, ← hmem] at e' - show bytesAt s'.mem (outA s₀) 64 = _ - rw [e', hD.2 iv m ⟨hr, hl, hc⟩, List.take_of_length_le (by simp)] +/-- The length field of a byte count `hi:lo`: `count >> 61`, whose high half +is zero, then `8 count`. -/ +theorem lenOf_halves (h l : BitVec 32) : + Proof.Sha512.md.lenOf (h ++ l) = Spec.Sha256.wordBytes 0 ++ Spec.Sha256.wordBytes (h >>> 29) ++ + bytes64 true (BitVec.ofNat 64 (8 * (h ++ l).toNat)) := by + rw [Proof.Sha512.lenOf_split, wordBytes_split, hi_shr61, lo_shr61, Proof.Sha512.Arm.hi_append] + rfl -theorem out_all {s₀ : State} (hp : Pre s₀) {sD : State} (hD : Done s₀ sD) : - ∀ j ≤ 8, ∀ s, Out s₀ sD (8 - j) s → - WP isa (.block (((List.range 8).drop (8 - j)).flatMap outW ++ restore)) s (Post s₀) := by - intro j - induction j with +/-- The length field, at `r0 + 176`: zero, `count >> 61` (from its high half +in `r5`), then `8 count` (`len64`). -/ +theorem len_ok (s : State) (hfit : (s.gpr .r0).toNat + (64 + 128) ≤ 2 ^ 32) + (hout : InRegions s.wr (State.addr (s.gpr .r0) + BitVec.ofNat 64 (64 + (128 - 16))) 16) : + WP isa (.block params.len) s fun s' => (∀ r, r ≠ .r9 → s'.gpr r = s.gpr r) ∧ s'.rd = s.rd ∧ + s'.wr = s.wr ∧ s'.sp = s.sp ∧ + s'.mem = writeBytes s.mem (State.addr (s.gpr .r0) + BitVec.ofNat 64 (64 + (128 - 16))) + (Proof.Sha512.md.lenOf (s.gpr .r5 ++ s.gpr .r4)) := by + have a176 : State.addr (s.gpr .r0 + BitVec.ofNat 32 176) = State.addr (s.gpr .r0) + BitVec.ofNat 64 176 := + addr_off (by omega) + have a180 : State.addr (s.gpr .r0 + BitVec.ofNat 32 180) = + State.addr (s.gpr .r0) + BitVec.ofNat 64 176 + BitVec.ofNat 64 4 := by + rw [addr_off (by omega), add_ofNat] + have o176 : InRegions s.wr (State.addr (s.gpr .r0) + BitVec.ofNat 64 176) 4 := by + simpa using InRegions.offset hout (off := 0) (m := 4) (by omega) (by omega) + have o180 : InRegions s.wr (State.addr (s.gpr .r0) + BitVec.ofNat 64 176 + BitVec.ofNat 64 4) 4 := + InRegions.offset hout (by omega) (by omega) + have o184 : InRegions s.wr (State.addr (s.gpr .r0) + BitVec.ofNat 64 184) 8 := by + have := InRegions.offset hout (off := 8) (m := 8) (by omega) (by omega) + rwa [add_ofNat] at this + show WP isa (.block (.mov .r9 (.imm 0) :: .str .r9 .r0 176 :: .mov .r9 (.shifted .r5 .lsr 29) :: + .rev .r9 .r9 :: .str .r9 .r0 180 :: len64 184 true)) s _ + refine wp_mov (op2_imm (by decide)) fun s₁ u₁ => wp_str (by decide) + (by rw [u₁.other _ (by decide), a176]) (by rw [u₁.wr]; exact o176) fun s₂ g₂ => ?_ + refine wp_mov (op2_lsr (by decide)) fun s₃ u₃ => wp_rev fun s₄ u₄ => wp_str (by decide) + (by rw [u₄.other _ (by decide), u₃.other _ (by decide), g₂.gpr, u₁.other _ (by decide), a180]) + (by rw [u₄.wr, u₃.wr, g₂.wr, u₁.wr]; exact o180) fun s₅ g₅ => ?_ + have k₅ : ∀ r, r ≠ .r9 → s₅.gpr r = s.gpr r := fun r h => by + rw [g₅.gpr, u₄.other r h, u₃.other r h, g₂.gpr, u₁.other r h] + refine (len64_ok (d := 184) (be := true) (by decide) (by rw [k₅ _ (by decide)]; omega) + (by rw [g₅.wr, u₄.wr, u₃.wr, g₂.wr, u₁.wr, k₅ _ (by decide)]; exact o184)).mono + fun s' ⟨g, rd, wr, sp, m⟩ => ⟨fun r h => by rw [g r h, k₅ r h], by rw [rd, g₅.rd, u₄.rd, u₃.rd, g₂.rd, u₁.rd], + by rw [wr, g₅.wr, u₄.wr, u₃.wr, g₂.wr, u₁.wr], by rw [sp, g₅.sp, u₄.sp, u₃.sp, g₂.sp, u₁.sp], ?_⟩ + have v₄ : s₄.gpr .r9 = rev (s.gpr .r5 >>> 29) := by + rw [u₄.gpr, u₃.gpr, g₂.gpr, u₁.other _ (by decide)] + have v₁ : s₁.gpr .r9 = rev 0 := by rw [u₁.gpr]; decide + have e184 : State.addr (s.gpr .r0) + BitVec.ofNat 64 184 = State.addr (s.gpr .r0) + BitVec.ofNat 64 176 + + BitVec.ofNat 64 (Spec.Sha256.wordBytes 0 ++ Spec.Sha256.wordBytes (s.gpr .r5 >>> 29)).length := by + rw [add_ofNat]; rfl + have e176 : State.addr (s.gpr .r0) + BitVec.ofNat 64 (64 + (128 - 16)) = + State.addr (s.gpr .r0) + BitVec.ofNat 64 176 := rfl + rw [m, k₅ _ (by decide), k₅ _ (by decide), k₅ _ (by decide), g₅.mem, u₄.mem, u₃.mem, g₂.mem, u₁.mem, v₄, + v₁, writeW_rev, writeW_rev, show (4 : Nat) = (Spec.Sha256.wordBytes 0).length from rfl, + writeBytes_append _ _ _ _ (by simp [Spec.Sha256.wordBytes]), e184, + writeBytes_append _ _ _ _ (by simp [Spec.Sha256.wordBytes, bytes64_length]), lenOf_halves, e176] + +/-! ## The digest -/ + +/-- The first `n` words of the final hash value at `p0` (`r0`), big-endian, to `p6` (`r6`). -/ +theorem out_ok {p0 p6 : BitVec 32} (f0 : p0.toNat + 64 ≤ 2 ^ 32) (f6 : p6.toNat + 64 ≤ 2 ^ 32) + (hd : Region.Disjoint ⟨State.addr p0, 64⟩ ⟨State.addr p6, 64⟩) : + ∀ n ≤ 8, ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .r0 = p0 → s.gpr .r6 = p6 → + InRegions (s.rd ++ s.wr) (State.addr p0) 64 → InRegions s.wr (State.addr p6) 64 → + (∀ s', (∀ r, r ≠ .r9 → r ≠ .r10 → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → + s'.mem = writeBytes s.mem (State.addr p6) (((stateAt s.mem (State.addr p0)).toList.take n).flatMap wordBytes) → + WP isa (.block rest) s' Q) → + WP isa (.block ((List.range n).flatMap outW ++ rest)) s Q := by + intro n + induction n with | zero => - intro _ s h - rw [show (List.range 8).drop (8 - 0) = [] from rfl, List.flatMap_nil, List.nil_append] - exact epilogue_ok hp hD h - | succ j ih => - intro hj s h - rw [List.drop_eq_getElem_cons (by simp; omega), List.flatMap_cons, List.append_assoc, - List.getElem_range] - refine out_step hp hD (by omega) h fun s' h' => ?_ - rw [show 8 - (j + 1) + 1 = 8 - j by omega] - exact ih (by omega) s' (by rwa [show 8 - (j + 1) + 1 = 8 - j by omega] at h') - -theorem correct {s₀ : State} (hp : Pre s₀) : WP isa finalize s₀ (Post s₀) := by - rw [finalize_eq] - refine WP.seq (WP.mono (prologue_ok hp) fun s₁ ⟨k, _, hL⟩ => ?_) - refine WP.seq (WP.mono (Q := Done s₀) ?_ fun sD hD => ?_) - · refine WP.loop (M := isa) (fun i s => ∃ n, LInv s₀ i n s) ?_ k s₁ ⟨_, hL⟩ - rintro i s ⟨n, hL⟩ - refine WP.mono (body_ok hp hL) fun s' h => ?_ - rcases h with ⟨he, -, hD⟩ | ⟨he, rfl, hL'⟩ - · exact .inl ⟨he, hD⟩ - · exact .inr ⟨he, 0, by omega, 0, hL'⟩ - · have := out_all hp hD 8 (Nat.le_refl _) sD ⟨hD.1.rd, hD.1.wr, fun _ _ => rfl, rfl, by simp [writeBytes_nil]⟩ - rw [show 8 - 8 = 0 from rfl, List.drop_zero] at this - exact this - -/-! ## Constant time -/ - -/-- The initial taint: `r0` (`state`) and `r2:r3` (`count`) are public, `r0` -points at the state, and the 8 bytes of stack arguments are public, the -second one pointing at the scratch space. -/ -def τ₀ : VG.Arm.Taint.T := - { regs := .ofList [.r0, .r2, .r3], flags := false, lens := [192, 64, 272], bases := [(.r0, 0)], argLen := 8, - argBases := [(4, 2)] } - -theorem argByte_eq {s : State} (hsp : s.sp.toNat + 8 ≤ 2 ^ 32) {k : Nat} (hk : k < 8) : - VG.Arm.Taint.argByte s k = stackArgAddr s (k / 4) + BitVec.ofNat 64 (k % 4) := by - simp only [VG.Arm.Taint.argByte, stackArgAddr] - rw [addr_add (by omega), BitVec.add_assoc, ← BitVec.ofNat_add] - congr 2; omega + intro _ rest s Q _ _ _ _ k + exact k s (fun _ _ _ => rfl) rfl rfl rfl (by simp [writeBytes_nil]) + | succ n ih => + intro hn rest s Q h0 h6 hin hout k + rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] + refine ih (by omega) _ s Q h0 h6 hin hout fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ + have hP := flat_length (stateAt s.mem (State.addr p0)) n (by omega) + simp only [outW, List.cons_append, List.nil_append] + have i₀ : ∀ o, o + 4 ≤ 8 → InRegions (s₁.rd ++ s₁.wr) (State.addr p0 + BitVec.ofNat 64 (8 * n + o)) 4 := + fun o ho => by + rw [rd₁, wr₁]; exact InRegions.offset hin (by omega) (by omega) + have o₀ : ∀ o, o + 4 ≤ 8 → InRegions s₁.wr (State.addr p6 + BitVec.ofNat 64 (8 * n + o)) 4 := + fun o ho => by rw [wr₁]; exact InRegions.offset hout (by omega) (by omega) + refine wp_ldr (a := State.addr p0 + BitVec.ofNat 64 (8 * n + 0)) (by omega) + (by rw [g₁ _ (by decide) (by decide), h0, addr_add (by omega)]; rfl) (i₀ 0 (by omega)) fun s₂ u₂ => ?_ + refine wp_ldr (a := State.addr p0 + BitVec.ofNat 64 (8 * n + 4)) (by omega) + (by rw [u₂.other _ (by decide), g₁ _ (by decide) (by decide), h0, addr_add (by omega)]) + (by rw [u₂.rd, u₂.wr]; exact i₀ 4 (by omega)) fun s₃ u₃ => wp_rev fun s₄ u₄ => wp_rev fun s₅ u₅ => ?_ + have e6 : s₅.gpr .r6 = p6 := by + rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), + g₁ _ (by decide) (by decide), h6] + refine wp_str (a := State.addr p6 + BitVec.ofNat 64 (8 * n + 0)) (by omega) + (by rw [e6, addr_add (by omega)]; rfl) (by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr]; exact o₀ 0 (by omega)) + fun s₆ g₆ => ?_ + refine wp_str (a := State.addr p6 + BitVec.ofNat 64 (8 * n + 4)) (by omega) + (by rw [g₆.gpr, e6, addr_add (by omega)]) (by rw [g₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr]; exact o₀ 4 (by omega)) + fun s₇ g₇ => k s₇ (fun r h9 h10 => by + rw [g₇.gpr, g₆.gpr, u₅.other r h9, u₄.other r h10, u₃.other r h10, u₂.other r h9, g₁ r h9 h10]) + (by rw [g₇.rd, g₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, rd₁]) + (by rw [g₇.wr, g₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, wr₁]) + (by rw [g₇.sp, g₆.sp, u₅.sp, u₄.sp, u₃.sp, u₂.sp, sp₁]) ?_ + -- The word's halves, as in `s`: the writes so far are to `p6`. + have hread : ∀ o, o + 4 ≤ 8 → s₁.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n + o)) 32 = + s.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n + o)) 32 := by + intro o ho + rw [m₁] + refine (writeBytes_frame s.mem (State.addr p6) _ (R := ⟨State.addr p6, 64⟩) ?_).readW + (r := ⟨State.addr p0 + BitVec.ofNat 64 (8 * n + o), 4⟩) (Region.contains_self _ _) ?_ (by decide) + · rw [hP]; simpa using Offset.contains_base (State.addr p6) (d := 0) (n := 8 * n) (k := 64) (by omega) + (by decide) + · intro r' hr' + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' + subst hr' + exact hd.sub_left (Offset.sub_base _ (by omega)) + have hw : (stateAt s.mem (State.addr p0))[n] = s.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n)) 64 := by + simp [stateAt] + have wlo : s.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n + 0)) 32 = + lo (stateAt s.mem (State.addr p0))[n] := by + rw [hw, readW_lo, Nat.add_zero] + have whi : s.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n + 4)) 32 = + hi (stateAt s.mem (State.addr p0))[n] := by + rw [hw, readW_hi, BitVec.ofNat_add, ← BitVec.add_assoc]; rfl + have v10 : s₅.gpr .r10 = rev (hi (stateAt s.mem (State.addr p0))[n]) := by + rw [u₅.other _ (by decide), u₄.gpr, u₃.gpr, u₂.mem, hread 4 (by omega), whi] + have v9 : s₆.gpr .r9 = rev (lo (stateAt s.mem (State.addr p0))[n]) := by + rw [g₆.gpr, u₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), u₂.gpr, hread 0 (by omega), wlo] + have a4 : State.addr p6 + BitVec.ofNat 64 (8 * n + 4) = + State.addr p6 + BitVec.ofNat 64 (8 * n + 0) + + BitVec.ofNat 64 (Spec.Sha256.wordBytes (hi (stateAt s.mem (State.addr p0))[n])).length := by + rw [BitVec.add_assoc, ← BitVec.ofNat_add]; rfl + have a8 : State.addr p6 + BitVec.ofNat 64 (8 * n + 0) = State.addr p6 + + BitVec.ofNat 64 (((stateAt s.mem (State.addr p0)).toList.take n).flatMap wordBytes).length := by + rw [hP]; rfl + rw [g₇.mem, v9, g₆.mem, v10, u₅.mem, u₄.mem, u₃.mem, u₂.mem, writeW_rev, writeW_rev, a4, + writeBytes_append _ _ _ _ (by simp [Spec.Sha256.wordBytes]), ← wordBytes_split, m₁, a8, + writeBytes_append _ _ _ _ (by rw [hP]; simp [wordBytes]; omega), List.take_add_one, + List.getElem?_eq_getElem (by simp; omega), Option.toList_some, List.flatMap_append, + List.flatMap_singleton, Vector.getElem_toList] -theorem wf₀ {s : State} (h : Proof.Sha512.finalizeArm.pre s) : VG.Arm.Taint.Wf τ₀ s := by - have hp := pre_of h - have hst := hp.st_fit; have ho := hp.out_fit; have hsc := hp.scr_fit; have hs := hp.sp_fit - refine ⟨fun _ => ⟨by simp [hp.wr, τ₀], ?_, ?_⟩, ?_, fun _ => ⟨hs, ?_⟩, ?_⟩ - · simp only [hp.wr, List.pairwise_cons, List.mem_cons, List.not_mem_nil, or_false, forall_eq_or_imp, - forall_eq, List.Pairwise.nil, and_true] - exact ⟨⟨hp.st_out, hp.st_scr⟩, hp.out_scr, fun _ h => h.elim⟩ - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) <;> simp only [addr_toNat] <;> omega - · intro p hp'; simp only [τ₀, List.mem_singleton] at hp'; subst hp'; simp [VG.Arm.Taint.region, hp.wr] - · have e : (⟨State.addr s.sp, 8⟩ : Region) = argR s := by simp [stackArgAddr] - simp only [τ₀, e, hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.a_st - · exact hp.a_out - · exact hp.a_scr - · intro p hp'; simp only [τ₀, List.mem_singleton] at hp'; subst hp' - refine ⟨by decide, ?_⟩ - simp only [VG.Arm.Taint.region, hp.wr] +theorem shape : Shape (P := params) Proof.Sha512.md where + len s hfit hout := len_ok s hfit hout + out s f₀ f₆ hin hout hd := by + rw [← List.append_nil params.out] + refine out_ok f₀ f₆ hd 8 (Nat.le_refl _) [] s _ rfl rfl hin hout fun s' g rd wr sp m => WP.block_nil + ⟨g, rd, wr, sp, ?_⟩ + rw [m, List.take_of_length_le (by simp)] rfl -theorem agree₀ {s₁ s₂ : State} (h₁ : Proof.Sha512.finalizeArm.pre s₁) (h₂ : Proof.Sha512.finalizeArm.pre s₂) - (hpub : Proof.Sha512.finalizeArm.pub s₁ s₂) : VG.Arm.Taint.Agree τ₀ s₁ s₂ := by - obtain ⟨psp, p0, p2, p3, a0, a1⟩ := hpub - have hp₁ := pre_of h₁; have hp₂ := pre_of h₂ - refine ⟨⟨fun r hr => ?_, fun h => nomatch h⟩, fun _ => ?_, wf₀ h₁, wf₀ h₂, - fun _ h => (List.not_mem_nil h).elim, fun _ h => (List.not_mem_nil h).elim, fun _ => psp, fun k hk => ?_⟩ - · simp only [τ₀, RegSet.mem_ofList, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl <;> assumption - · rw [hp₁.wr, hp₂.wr]; simp only [stR, outR, scR, stA, outA, scA, st, out, scr, p0, a0, a1] - · simp only [τ₀] at hk - rw [argByte_eq hp₁.sp_fit hk, argByte_eq hp₂.sp_fit hk, Mem.readW_byte s₁.mem _ (Nat.mod_lt _ (by omega)), - Mem.readW_byte s₂.mem _ (Nat.mod_lt _ (by omega))] - have : k / 4 = 0 ∨ k / 4 = 1 := by omega - rcases this with h | h <;> rw [h] - · exact congrArg _ a0 - · exact congrArg _ a1 - -/-- A state satisfying the precondition: `out` at `0x2000` and the scratch -space at `0x3000`, passed on the stack at `0x5000`. -/ -def sat : State where - gpr r := match r with - | .r0 => 0x1000 | _ => 0 - sp := 0x5000 - n := false - z := false - c := false - v := false - mem a := if a = 0x5001 then 0x20 else if a = 0x5005 then 0x30 else 0 - rd := [⟨0x5000, 8⟩] - wr := [⟨0x1000, 192⟩, ⟨0x2000, 64⟩, ⟨0x3000, 272⟩] - -/-! ## Constant time, by relating two runs - -The prologue is checked by the taint analysis from the initial taint; in the -loop, the code before the call of the compression function from the -registers that hold our variables, the call by the compression function's -contract (`compressAt_rel`); the epilogue from the pointers. Whether a -second block is padded depends only on `count`, so both runs go through the -loop the same number of times, with the same registers. -/ - -section CT -variable {s₀ s₀' : State} (hp : Pre s₀) (hp' : Pre s₀') (hpub : Proof.Sha512.finalizeArm.pub s₀ s₀') - -include hpub - -theorem cnt_eq : cnt s₀ = cnt s₀' := by - obtain ⟨-, -, p2, p3, -, -⟩ := hpub - simp only [cnt, countArm, p2, p3] - -theorem LInv.agree {k n : Nat} {s s' : State} (h : LInv s₀ k n s) (h' : LInv s₀' k n s') : - ∀ r ∈ [Reg.r0, .r3, .r4, .r5], s.gpr r = s'.gpr r := by - obtain ⟨-, p0, -, -, -, a1⟩ := hpub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl - · rw [h.r0, h'.r0]; exact p0 - · rw [h.r3, h'.r3]; exact a1 - · rw [h.r4, h'.r4] - · rw [h.r5, h'.r5] - -include hp hp' - -theorem body_rel {k n : Nat} : - RelCT isa (fun s₁ s₂ => LInv s₀ k n s₁ ∧ LInv s₀' k n s₂) finalizeBody - fun s₁ s₂ => Step s₀ k s₁ ∧ Step s₀' k s₂ := by - have p0 := hpub.2.1 - have a1 := hpub.2.2.2.2.2 - have pre : RelCT isa (fun s₁ s₂ => LInv s₀ k n s₁ ∧ LInv s₀' k n s₂) bodyPre fun s₁ s₂ => - (Common s₀ s₁ ∧ WP isa (.seq compressAt (.block bodyEnd)) s₁ (Step s₀ k)) ∧ - (Common s₀' s₂ ∧ WP isa (.seq compressAt (.block bodyEnd)) s₂ (Step s₀' k)) := - ((RelCT.taint (A := taint) (Taint.ofRegs [.r0, .r3, .r4, .r5]) - (fun _ _ h => Taint.agree_ofRegs (LInv.agree hpub h.1 h.2)) (c := bodyPre) (by taint_decide)).wp - fun _ _ h => ⟨pre_ok hp h.1, pre_ok hp' h.2⟩).mono (fun _ _ h => h) fun _ _ h => h.2 - have cmp : RelCT isa (fun s₁ s₂ => - (Common s₀ s₁ ∧ WP isa (.seq compressAt (.block bodyEnd)) s₁ (Step s₀ k)) ∧ - (Common s₀' s₂ ∧ WP isa (.seq compressAt (.block bodyEnd)) s₂ (Step s₀' k))) - compressAt fun s₁ s₂ => WP isa (.block bodyEnd) s₁ (Step s₀ k) ∧ - WP isa (.block bodyEnd) s₂ (Step s₀' k) := - (((compressAt_rel hp.st_fit hp.scr_fit hp.st_scr).mono - (fun _ _ h => ⟨h.1.1.atPre hp, by have := h.2.1.atPre hp'; rwa [st, scr, ← p0, ← a1] at this⟩) - fun _ _ h => h).wp fun _ _ h => ⟨WP.seq_iff.mp h.1.2, WP.seq_iff.mp h.2.2⟩).mono - (fun _ _ h => h) fun _ _ h => h.2 - have fin : RelCT isa (fun s₁ s₂ => WP isa (.block bodyEnd) s₁ (Step s₀ k) ∧ - WP isa (.block bodyEnd) s₂ (Step s₀' k)) (.block bodyEnd) - fun s₁ s₂ => Step s₀ k s₁ ∧ Step s₀' k s₂ := - ((RelCT.taint (A := taint) (Taint.ofRegs []) (fun _ _ _ => Taint.agree_ofRegs (by simp)) - (c := .block bodyEnd) (by taint_decide)).wp fun _ _ h => h).mono (fun _ _ h => h) fun _ _ h => h.2 - exact RelCT.assoc (RelCT.assoc (RelCT.assoc (RelCT.assoc (RelCT.assoc (pre.seq (cmp.seq fin)))))) - -theorem finalize_rel (h₀ : Proof.Sha512.finalizeArm.pre s₀) (h₀' : Proof.Sha512.finalizeArm.pre s₀') : - RelCT isa (fun s₁ s₂ => s₁ = s₀ ∧ s₂ = s₀') finalize fun _ _ => True := by - have ek : kOf s₀' = kOf s₀ := by simp only [kOf, cnt_eq hpub] - have pro : RelCT isa (fun s₁ s₂ => s₁ = s₀ ∧ s₂ = s₀') - (.block (([.ldrSp .r12 4] : List Instr) ++ (stored.map (fun p => Instr.str p.1 .r12 p.2) ++ prologue))) - fun s₁ s₂ => ∃ n, LInv s₀ (kOf s₀) n s₁ ∧ LInv s₀' (kOf s₀) n s₂ := - ((RelCT.taint (A := taint) τ₀ (fun _ _ ⟨e, e'⟩ => by rw [e, e']; exact agree₀ h₀ h₀' hpub) - (c := .block (([.ldrSp .r12 4] : List Instr) ++ (stored.map (fun p => Instr.str p.1 .r12 p.2) ++ prologue))) - (by taint_decide)).wp - (F₁ := fun s => ∃ k, k = kOf s₀ ∧ LInv s₀ k (cnt s₀ % 128 + 1) s) - (F₂ := fun s => ∃ k, k = kOf s₀' ∧ LInv s₀' k (cnt s₀' % 128 + 1) s) - fun _ _ ⟨e, e'⟩ => by rw [e, e']; exact ⟨prologue_ok hp, prologue_ok hp'⟩).mono (fun _ _ h => h) - fun _ _ ⟨_, ⟨k, hk, L⟩, ⟨k', hk', L'⟩⟩ => ⟨_, hk ▸ L, by rw [cnt_eq hpub, ← ek, ← hk']; exact L'⟩ - have lp := RelCT.loop (M := isa) (body := finalizeBody) (c := .eq) - (Q := fun s₁ s₂ => Done s₀ s₁ ∧ Done s₀' s₂) - (fun m s₁ s₂ => ∃ n, LInv s₀ m n s₁ ∧ LInv s₀' m n s₂) (fun m => RelCT.exists_ fun n => - (body_rel hp hp' hpub).mono (fun _ _ h => h) fun s₁ s₂ ⟨h₁, h₂⟩ => by - rcases h₁ with ⟨z₁, rfl, D₁⟩ | ⟨z₁, rfl, L₁⟩ <;> - rcases h₂ with ⟨z₂, h0, D₂⟩ | ⟨z₂, h1, L₂⟩ - · exact ⟨z₁.trans z₂.symm, fun _ => ⟨D₁, D₂⟩, fun h => absurd (z₁.symm.trans h) (by simp)⟩ - · cases h1 - · cases h0 - · exact ⟨z₁.trans z₂.symm, fun h => absurd (z₁.symm.trans h) (by simp), - fun _ => ⟨0, by omega, 0, L₁, L₂⟩⟩) (kOf s₀) - obtain ⟨-, p0, -, -, a0, a1⟩ := hpub - have epi : RelCT isa (fun s₁ s₂ => Done s₀ s₁ ∧ Done s₀' s₂) - (.block ((List.range 8).flatMap outW ++ restore)) fun _ _ => True := - RelCT.taint (A := taint) (Taint.ofRegs [.r0, .r3, .r6]) (fun _ _ h => Taint.agree_ofRegs fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · rw [h.1.1.r0, h.2.1.r0]; exact p0 - · rw [h.1.1.r3, h.2.1.r3]; exact a1 - · rw [h.1.1.r6, h.2.1.r6]; exact a0) (by taint_decide) - rw [finalize_eq] - exact pro.seq (lp.seq epi) - -end CT +theorem finalize_verified : Verified Arm.target Impl.Sha512.Arm.Stream.finalize Proof.Sha512.finalizeArm := + have h := MdStream.Arm.Finalize.verified (name := "vg_sha512_compress") dims shape callee + (VG.Taint.constantTime (A := taint) (MdStream.Arm.Finalize.τ₀ params) + (fun _ _ h₁ h₂ hp => MdStream.Arm.Finalize.agree₀ h₁ h₂ hp) (by taint_decide)) + Verified.of_implies h ⟨fun _ h => h, fun _ _ _ h iv m hr hl hc => h iv m hr hl hc, fun _ _ _ _ h => h, h.2.2⟩ -theorem finalize_verified : Verified Arm.target finalize Proof.Sha512.finalizeArm := by - refine ⟨fun s hs => ?_, ?_, ?_⟩ - · obtain ⟨t, s', he, h⟩ := correct (pre_of hs) - exact ⟨t, s', he, h⟩ - · intro s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ - exact (finalize_rel (pre_of h₁) (pre_of h₂) hpub h₁ h₂ _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 - · have e0 : stackArg sat 0 = 0x2000 := by decide - have e1 : stackArg sat 1 = 0x3000 := by decide - refine ⟨sat, ?_⟩ - simp only [Proof.Sha512.finalizeArm, e0, e1] - refine ⟨by simp [sat, stackArgAddr]; decide, rfl, ?_, ?_, ?_, ?_, ?_, ?_, by decide, by decide, by decide, - by decide⟩ <;> - exact Region.disjoint_of_sep (by decide) +/-- A state satisfying `finalize`'s precondition. -/ +abbrev sat : State := MdStream.Arm.Finalize.sat params end VG.Proof.Sha512.Arm.Stream.Finalize diff --git a/lean/VerifiedGarbage/Proof/Sha512/Arm/Stream/Update.lean b/lean/VerifiedGarbage/Proof/Sha512/Arm/Stream/Update.lean index bd73992f2..264418c8c 100644 --- a/lean/VerifiedGarbage/Proof/Sha512/Arm/Stream/Update.lean +++ b/lean/VerifiedGarbage/Proof/Sha512/Arm/Stream/Update.lean @@ -1,1162 +1,41 @@ -import VerifiedGarbage.Proof.Sha512.Arm.Stream.Init -import VerifiedGarbage.Proof.Framework.Arm.RelCT +import VerifiedGarbage.Proof.MdStream.Arm.Update +import VerifiedGarbage.Proof.Sha512.Md import VerifiedGarbage.Proof.Framework.Contract -import VerifiedGarbage.Proof.Framework.RelCTAssoc +import VerifiedGarbage.Proof.Sha512.Arm.Compress +import VerifiedGarbage.Impl.Sha512.Arm.Stream +import VerifiedGarbage.Proof.Sha512.Arm.Lit /-! -# Streaming SHA-512 on ARMv7: common lemmas +# Streaming SHA-512 on ARMv7: `update` -Saving and restoring our caller's registers, the call of the compression -function in the terms of the streaming proofs, and arithmetic on 32-bit -values. +`update` is the generic streaming code (`Impl/MdStream/Arm.lean`), so it is +verified by the generic proof (`Proof/MdStream/Arm/Update.lean`) for the +SHA-512 family's instance (`Proof/Sha512/Md.lean`), given that its compression +function is verified (`callee`) and that the taint analysis accepts its code. -/ namespace VG.Proof.Sha512.Arm.Stream -open VG VG.Arm VG.Impl.Sha512.Arm.Stream -open VG.Proof.MdStream.Arm (contains_offset) -open VG.Proof.MdStream.Arm (Upd Mupd Fupd saveMem saveList_ok restoreList_ok readW_writeW_save - sub_offset wp_add wp_mov op2_imm) -open VG.Proof.Sha512.Arm (temps) -open VG.Proof.Sha512.Arm.Compress (compress_verified) -open VG.Spec.Sha512 (HashValue stateAt blockAt compress compressBlocks) - -/-! ## Saving and restoring our caller's registers -/ - -theorem save_eq (b : Reg) : save b = saved.map (fun p => Instr.str p.1 b p.2) := rfl - -/-- Saving `r4`–`r11` and `lr` with the scratch pointer in `b`. -/ -theorem save_ok {b : Reg} {rest : List Instr} {s : State} {Q : State → Prop} - (hfit : (s.gpr b).toNat + 272 ≤ 2 ^ 32) - (hin : ∀ d, 224 ≤ d → d + 4 ≤ 260 → InRegions s.wr (State.addr (s.gpr b) + BitVec.ofNat 64 d) 4) - (k : ∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → - s'.mem = saveMem s.mem (State.addr (s.gpr b)) s.gpr saved → WP isa (.block rest) s' Q) : - WP isa (.block (save b ++ rest)) s Q := by - rw [save_eq] - refine saveList_ok saved s Q (fun p hp => ?_) k - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> - exact ⟨by decide, by simp only; omega, hin _ (by decide) (by decide)⟩ - -set_option simprocs false in -theorem saveMem_saved (m : Mem) (B : Addr) (g : Reg → BitVec 32) : - ∀ p ∈ saved, (saveMem m B g saved).readW (B + BitVec.ofNat 64 p.2) 32 = g p.1 := by - intro p hp - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> - simp (config := {decide := true}) only [saved, saveMem, Mem.readW_writeW_self32, readW_writeW_save] - -theorem saveMem_frame (m : Mem) (B : Addr) (g : Reg → BitVec 32) {N : Nat} (hN : N < 2 ^ 64) : - ∀ (l : List (Reg × Nat)), (∀ p ∈ l, p.2 + 4 ≤ N) → Frame [⟨B, N⟩] m (saveMem m B g l) := by - intro l - induction l generalizing m with - | nil => intro _; exact Frame.refl _ _ - | cons p l ih => - intro hl - have h := hl p (by simp) - exact ((Frame.refl _ _).writeW (List.mem_singleton_self _) _ - (contains_offset (n := 32 / 8) h (by omega))).trans (ih _ fun q hq => hl q (List.mem_cons_of_mem _ hq)) - -theorem saved_bound : ∀ p ∈ saved, 224 ≤ p.2 ∧ p.2 + 4 ≤ 260 := by decide - -theorem restore_eq : restore = saved.map (fun p => Instr.ldr p.1 .r3 p.2) := rfl - -/-- Restoring `r4`–`r11` and `lr` from the save area at `scratch`. -/ -theorem restore_ok {s : State} {scr : BitVec 32} (h3 : s.gpr .r3 = scr) (hfit : scr.toNat + 272 ≤ 2 ^ 32) - (hin : ∀ d, 224 ≤ d → d + 4 ≤ 260 → InRegions (s.rd ++ s.wr) (State.addr scr + BitVec.ofNat 64 d) 4) - (g : Reg → BitVec 32) (hsv : ∀ p ∈ saved, s.mem.readW (State.addr scr + BitVec.ofNat 64 p.2) 32 = g p.1) - {Q : State → Prop} - (k : ∀ s', (∀ p ∈ saved, s'.gpr p.1 = g p.1) → (∀ r, r ∉ saved.map Prod.fst → s'.gpr r = s.gpr r) → - s'.mem = s.mem → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → Q s') : - WP isa (.block restore) s Q := by - rw [restore_eq, ← List.append_nil (saved.map _)] - refine restoreList_ok saved s Q (by decide) (fun p hp => ?_) - fun s' ho hr hm hrd hwr hsp => WP.block_nil (k s' (fun p hp => ?_) hr hm hrd hwr hsp) - · simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rw [h3] - rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> - exact ⟨by decide, by decide, by simp only; omega, hin _ (by decide) (by decide)⟩ - · rw [ho p hp, h3, hsv p hp] - -/-- The saved registers are preserved by the ABI. -/ -theorem preserved_saved {s₀ s' : State} (hs : ∀ p ∈ saved, s'.gpr p.1 = s₀.gpr p.1) : - ∀ r ∈ preserved, s'.gpr r = s₀.gpr r := by - intro r hr - simp only [preserved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl - · exact hs (.r4, 224) (by simp [saved]) - · exact hs (.r5, 228) (by simp [saved]) - · exact hs (.r6, 232) (by simp [saved]) - · exact hs (.r7, 236) (by simp [saved]) - · exact hs (.r8, 240) (by simp [saved]) - · exact hs (.r9, 244) (by simp [saved]) - · exact hs (.r10, 248) (by simp [saved]) - · exact hs (.r11, 252) (by simp [saved]) - · exact hs (.lr, 256) (by simp [saved]) - -/-! ## The call of the compression function -/ - -theorem compressBlocks_one (H : HashValue) (m : Mem) (p : Addr) : - compressBlocks H m p 1 = compress H (blockAt m p) := by - simp [compressBlocks] - -/-- No instruction of the compression function writes `r0` or `r3`. -/ -theorem r03_ok : ((instrs Impl.Sha512.Arm.compress).all fun i => - dstOf i != some .r0 && dstOf i != some .r3) = true := by - rw [← Code.allInstrs_eq]; lit_decide - -theorem r0_ok : ∀ i ∈ instrs Impl.Sha512.Arm.compress, dstOf i ≠ some .r0 := fun i hi => by - have := List.all_eq_true.mp r03_ok i hi - simp only [Bool.and_eq_true, bne_iff_ne, ne_eq] at this - exact this.1 - -theorem r3_ok : ∀ i ∈ instrs Impl.Sha512.Arm.compress, dstOf i ≠ some .r3 := fun i hi => by - have := List.all_eq_true.mp r03_ok i hi - simp only [Bool.and_eq_true, bne_iff_ne, ne_eq] at this - exact this.2 +open VG VG.Arm VG.Proof.MdStream VG.Proof.MdStream.Arm -/-- The registers the compression function's contract accounts for: every -register but its temporaries and `lr` is `r0`, `r3` or callee-saved. -/ -theorem regs_split (r : Reg) (ht : r ∉ temps) (hl : r ≠ .lr) : r = .r0 ∨ r = .r3 ∨ r ∈ preserved := by - revert ht hl; cases r <;> decide +abbrev params := Impl.Sha512.Arm.Stream.params -/-- What `compressAt` needs of the state it starts from: the state at `st` in -`r0`, the scratch space `scr` in `r3`. -/ -structure AtPre (st scr : BitVec 32) (s : State) : Prop where - r0 : s.gpr .r0 = st - r3 : s.gpr .r3 = scr - hS : ⟨State.addr st, 192⟩ ∈ s.wr - hV : ⟨State.addr scr, 272⟩ ∈ s.wr +theorem dims : Dims params := ⟨.inr rfl, by decide, by decide, by decide, by decide, by decide⟩ -/-- The registers the compression function is called with. -/ -structure CallRegs (st scr : BitVec 32) (s : State) : Prop where - r0 : s.gpr .r0 = st - r1 : s.gpr .r1 = st + 64 - r2 : s.gpr .r2 = 1 - r3 : s.gpr .r3 = scr - hS : ⟨State.addr st, 192⟩ ∈ s.wr - hV : ⟨State.addr scr, 272⟩ ∈ s.wr +theorem callee : CalleeOk (P := params) Proof.Sha512.md Impl.Sha512.Arm.compress := + ⟨Compress.compress_verified.1, by lit_decide, by rw [← Code.allInstrs_eq]; lit_decide⟩ -/-- The arguments of the call. -/ -abbrev argsAt : List Instr := [.dp .add .r1 .r0 (.imm 64), .mov .r2 (.imm 1)] +namespace Update -theorem compressAt_eq : compressAt = .seq (.block argsAt) compressCall := rfl +theorem update_verified : Verified Arm.target Impl.Sha512.Arm.Stream.update Proof.Sha512.updateArm := + have h := MdStream.Arm.Update.verified (name := "vg_sha512_compress") dims callee + (VG.Taint.constantTime (A := taint) (MdStream.Arm.Update.τ₀ params) + (fun _ _ h₁ h₂ hp => MdStream.Arm.Update.agree₀ h₁ h₂ hp) (by taint_decide)) + Verified.of_implies h ⟨fun _ h => h, fun _ _ _ h iv m hr hc => h iv m hr hc, fun _ _ _ _ h => h, h.2.2⟩ -theorem argsAt_ok {st scr : BitVec 32} {s : State} (h : AtPre st scr s) : - WP isa (.block argsAt) s fun s' => CallRegs st scr s' ∧ s'.rd = s.rd ∧ s'.wr = s.wr ∧ - s'.mem = s.mem ∧ s'.sp = s.sp ∧ ∀ r, r ≠ .r1 → r ≠ .r2 → s'.gpr r = s.gpr r := by - refine wp_add (op2_imm (by decide)) fun s₁ u₁ => wp_mov (op2_imm (by decide)) fun s₂ u₂ => WP.block_nil ?_ - have wr₂ : s₂.wr = s.wr := by rw [u₂.wr, u₁.wr] - exact ⟨⟨by rw [u₂.other _ (by decide), u₁.other _ (by decide), h.r0], by rw [u₂.other _ (by decide), u₁.gpr, h.r0], - u₂.gpr, by rw [u₂.other _ (by decide), u₁.other _ (by decide), h.r3], by rw [wr₂]; exact h.hS, - by rw [wr₂]; exact h.hV⟩, by rw [u₂.rd, u₁.rd], wr₂, by rw [u₂.mem, u₁.mem], by rw [u₂.sp, u₁.sp], - fun r h1 h2 => by rw [u₂.other r h2, u₁.other r h1]⟩ +/-- A state satisfying `update`'s precondition. -/ +abbrev sat : State := MdStream.Arm.Update.sat params -/-- The regions the compression function is given to read (the block in the -buffer) and to write (the hash value and the scratch space it uses). -/ -abbrev rdC (st : BitVec 32) : List Region := [⟨State.addr (st + 64), 128 * 1⟩] -abbrev wrC (st scr : BitVec 32) : List Region := [⟨State.addr st, 64⟩, ⟨State.addr scr, 224⟩] - -theorem addr_st64 {st : BitVec 32} (f₀ : st.toNat + 192 ≤ 2 ^ 32) : - State.addr (st + 64) = State.addr st + BitVec.ofNat 64 64 := addr_add (k := 64) (by omega) - -theorem callEntry_gpr_of {s : State} {r : Reg} (h : r ∉ linkRegs) : s.callEntry.gpr r = s.gpr r := - State.callEntry_gpr s h - -section -variable {st scr : BitVec 32} (f₀ : st.toNat + 192 ≤ 2 ^ 32) (f₃ : scr.toNat + 272 ≤ 2 ^ 32) - (d : Region.Disjoint ⟨State.addr st, 192⟩ ⟨State.addr scr, 272⟩) -include f₀ f₃ d - -/-- The compression function may be called: its precondition holds, narrowed -to `rdC` and `wrC`. -/ -theorem callPre {s : State} (c : CallRegs st scr s) : - Proof.Sha512.compressArm.pre (s.callEntry.withRegions (rdC st) (wrC st scr)) ∧ - Covers (rdC st ++ wrC st scr) (s.rd ++ s.wr) ∧ Covers (wrC st scr) s.wr := by - have hb := addr_st64 f₀ - have hbt : (st + 64).toNat = st.toNat + 64 := by - rw [BitVec.toNat_add, show (64 : BitVec 32).toNat = 64 from rfl, Nat.mod_eq_of_lt (by omega)] - have sS : Region.Sub ⟨State.addr st, 64⟩ ⟨State.addr st, 192⟩ := Region.sub_prefix (by omega) - have sB : Region.Sub ⟨State.addr (st + 64), 128 * 1⟩ ⟨State.addr st, 192⟩ := by - rw [hb]; exact sub_offset (off := 64) (len := 128 * 1) (len' := 192) (by decide) (by decide) - have sV : Region.Sub ⟨State.addr scr, 224⟩ ⟨State.addr scr, 272⟩ := Region.sub_prefix (by omega) - have dBS : Region.Disjoint ⟨State.addr (st + 64), 128 * 1⟩ ⟨State.addr st, 64⟩ := by - rw [hb]; exact Offset.disjoint_base _ (by omega) (by omega) - refine ⟨?_, ?_, ?_⟩ - · simp only [Proof.Sha512.compressArm, State.withRegions_gpr, State.withRegions_rd, - State.withRegions_wr, callEntry_gpr_of (show Reg.r0 ∉ linkRegs by decide), - callEntry_gpr_of (show Reg.r1 ∉ linkRegs by decide), callEntry_gpr_of (show Reg.r2 ∉ linkRegs by decide), - callEntry_gpr_of (show Reg.r3 ∉ linkRegs by decide), c.r0, c.r1, c.r2, c.r3] - exact ⟨rfl, trivial, (d.sub_left sS).sub_right sV, dBS, (d.sub_left sB).sub_right sV, by omega, - by rw [hbt]; simp only [show (1 : BitVec 32).toNat = 1 from rfl]; omega, by omega⟩ - · apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false, List.cons_append, List.nil_append] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨_, List.mem_append_right _ c.hS, 64, hb, by simp⟩ - · exact ⟨_, List.mem_append_right _ c.hS, 0, by simp, by simp⟩ - · exact ⟨_, List.mem_append_right _ c.hV, 0, by simp, by simp⟩ - · apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact ⟨_, c.hS, 0, by simp, by simp⟩ - · exact ⟨_, c.hV, 0, by simp, by simp⟩ - -/-- Compressing the buffer of the state at `r0` into its hash value, with -the scratch space (272 bytes, of which the compression function uses 224) at -`r3`. -/ -theorem compressBuf_ok {s : State} (h : AtPre st scr s) {Q : State → Prop} - (hQ : ∀ s', s'.rd = s.rd → s'.wr = s.wr → (∀ r, r ∉ temps → r ≠ .lr → s'.gpr r = s.gpr r) → - s'.sp = s.sp → Frame [⟨State.addr st, 192⟩, ⟨State.addr scr, 224⟩] s.mem s'.mem → - stateAt s'.mem (State.addr st) = - compress (stateAt s.mem (State.addr st)) (blockAt s.mem (State.addr st + 64)) → Q s') : - WP isa compressAt s Q := by - rw [compressAt_eq] - refine WP.seq (WP.mono (argsAt_ok h) fun s₂ ⟨c, rd₂, wr₂, m₂, sp₂, g₂⟩ => ?_) - have hb := addr_st64 f₀ - have sS : Region.Sub ⟨State.addr st, 64⟩ ⟨State.addr st, 192⟩ := Region.sub_prefix (by omega) - obtain ⟨hpre, hc, hw⟩ := callPre f₀ f₃ d c - refine WP.call (k := Proof.Sha512.compressArm) compress_verified.1 hpre hc hw ?_ - intro s' hrd hwr hsp hf hcs hg hpost - simp only [Proof.Sha512.compressArm, State.withRegions_gpr, State.withRegions_mem, State.callEntry_mem, - callEntry_gpr_of (show Reg.r0 ∉ linkRegs by decide), callEntry_gpr_of (show Reg.r1 ∉ linkRegs by decide), - callEntry_gpr_of (show Reg.r2 ∉ linkRegs by decide), c.r0, c.r1, c.r2, m₂] at hpost - rw [show (BitVec.toNat (1 : BitVec 32)) = 1 from rfl, compressBlocks_one, hb] at hpost - refine hQ s' (hrd.trans rd₂) (hwr.trans wr₂) (fun r hr hlr => ?_) (hsp.trans sp₂) ?_ hpost - · rcases regs_split r hr hlr with rfl | rfl | hp - · rw [hg _ r0_ok (by decide), c.r0, h.r0] - · rw [hg _ r3_ok (by decide), c.r3, h.r3] - · have h1 : r ≠ .r1 := by rintro rfl; simp [preserved] at hp - have h2 : r ≠ .r2 := by rintro rfl; simp [preserved] at hp - rw [hcs r hp hlr, g₂ r h1 h2] - · rw [← m₂] - refine hf.sub fun r hr => ?_ - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact ⟨_, by simp, sS⟩ - · exact ⟨_, by simp, fun _ h => h⟩ - -/-- Two runs of `compressAt` from states that agree on `st` and `scr` leak -the same trace: the arguments by the taint analysis, the call by the -compression function's contract. -/ -theorem compressAt_rel : - RelCT isa (fun s₁ s₂ => AtPre st scr s₁ ∧ AtPre st scr s₂) compressAt fun _ _ => True := by - rw [compressAt_eq] - refine RelCT.seq (R := fun s₁ s₂ => CallRegs st scr s₁ ∧ CallRegs st scr s₂) ?_ ?_ - · refine ((RelCT.taint (A := taint) (Taint.ofRegs [.r0]) (fun _ _ h => Taint.agree_ofRegs fun r hr => ?_) - (c := .block argsAt) (by taint_decide)).wp - (F₁ := CallRegs st scr) (F₂ := CallRegs st scr) fun _ _ h => - ⟨WP.mono (argsAt_ok h.1) fun _ h => h.1, WP.mono (argsAt_ok h.2) fun _ h => h.1⟩).mono - (fun _ _ h => h) fun _ _ h => h.2 - simp only [List.mem_singleton] at hr - subst hr - rw [h.1.r0, h.2.r0] - · refine RelCT.call compress_verified.1 compress_verified.2.1 (rdC st) (wrC st scr) fun s₁ s₂ ⟨c₁, c₂⟩ => ?_ - obtain ⟨p₁, v₁, w₁⟩ := callPre f₀ f₃ d c₁ - obtain ⟨p₂, v₂, w₂⟩ := callPre f₀ f₃ d c₂ - refine ⟨p₁, p₂, ?_, v₁, w₁, v₂, w₂⟩ - simp only [Proof.Sha512.compressArm, State.withRegions_gpr, - callEntry_gpr_of (show Reg.r0 ∉ linkRegs by decide), callEntry_gpr_of (show Reg.r1 ∉ linkRegs by decide), - callEntry_gpr_of (show Reg.r2 ∉ linkRegs by decide), callEntry_gpr_of (show Reg.r3 ∉ linkRegs by decide), - c₁.r0, c₁.r1, c₁.r2, c₁.r3, c₂.r0, c₂.r1, c₂.r2, c₂.r3, and_self] - -end - -/-! ## Arithmetic -/ - -theorem and127 (x : BitVec 32) : x &&& 127 = BitVec.ofNat 32 (x.toNat % 128) := by - apply BitVec.eq_of_toNat_eq - simp only [BitVec.toNat_and, BitVec.toNat_ofNat] - rw [show (127 : BitVec 32).toNat = 2 ^ 7 - 1 from rfl, Nat.and_two_pow_sub_one_eq_mod] - omega +end Update end VG.Proof.Sha512.Arm.Stream - -/-! -# Streaming SHA-512 on ARMv7: `update` - -The structure of the SHA-256 proof (`VG.Proof.MdStream.Arm.Update`), with -`state` in `r0`, `scratch` in `r3`, `data` in `r5`, the bytes left in `r6` and -the buffered bytes in `r4`; every block goes through the buffer, which is -compressed as soon as it is full. --/ - -namespace VG.Proof.Sha512.Arm.Stream.Update - -open VG VG.Arm VG.Impl.Sha512.Arm.Stream -open VG.Proof.MdStream.Arm (contains_offset) -open VG.Proof.MdStream.Arm (Upd Mupd Fupd op2_imm op2_reg op2_lsr wp_mov wp_add wp_sub wp_and - wp_subs wp_cmp wp_ldrb wp_strb wp_ldrSp saveMem sub_offset frame_bytes bytesAt_getD eval_eq - eval_ne ofNat_beq_zero sub_ofNat sub_beq ofNat_shr) -open VG.Proof.Sha512.Arm (temps) -open VG.Proof.Sha512.Arm.Stream -open VG.Proof.Sha512.Stream -open VG.Spec.Sha512 (HashValue stateAt blockAt compress parseBlock bytesAt) -open VG.Proof.Sha512 (countArm) - -/-! ## The precondition -/ - -section -variable (s₀ : State) - -abbrev st : BitVec 32 := s₀.gpr .r0 -abbrev cnt : Nat := (countArm s₀).toNat -abbrev dp : BitVec 32 := stackArg s₀ 0 -abbrev len : Nat := (stackArg s₀ 1).toNat -abbrev scr : BitVec 32 := stackArg s₀ 2 -abbrev stA : Addr := State.addr (st s₀) -abbrev dA : Addr := State.addr (dp s₀) -abbrev scA : Addr := State.addr (scr s₀) -abbrev stR : Region := ⟨stA s₀, 192⟩ -abbrev dR : Region := ⟨dA s₀, len s₀⟩ -abbrev scR : Region := ⟨scA s₀, 272⟩ -abbrev argR : Region := ⟨stackArgAddr s₀ 0, 12⟩ -/-- The data. -/ -abbrev D : List Byte := bytesAt s₀.mem (dA s₀) (len s₀) - -/-- The messages the initial state represents, from the initial hash value `iv`. -/ -def R₀ (iv : HashValue) (m : List Byte) : Prop := - Spec.Sha512.Repr iv s₀.mem (stA s₀) m ∧ countArm s₀ = BitVec.ofNat 64 m.length - -/-- The caller's registers are saved in the scratch space. -/ -def Saved (m : Mem) : Prop := - ∀ p ∈ saved, m.readW (scA s₀ + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 - -end - -structure Pre (s₀ : State) : Prop where - rd : s₀.rd = [dR s₀, argR s₀] - wr : s₀.wr = [stR s₀, scR s₀] - st_scr : (stR s₀).Disjoint (scR s₀) - d_st : (dR s₀).Disjoint (stR s₀) - d_scr : (dR s₀).Disjoint (scR s₀) - a_st : (argR s₀).Disjoint (stR s₀) - a_scr : (argR s₀).Disjoint (scR s₀) - st_fit : (st s₀).toNat + 192 ≤ 2 ^ 32 - d_fit : (dp s₀).toNat + len s₀ ≤ 2 ^ 32 - scr_fit : (scr s₀).toNat + 272 ≤ 2 ^ 32 - sp_fit : s₀.sp.toNat + 12 ≤ 2 ^ 32 - -theorem pre_of {s₀ : State} (h : Proof.Sha512.updateArm.pre s₀) : Pre s₀ := by - obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11⟩ := h - exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11⟩ - -theorem cnt_mod (s₀ : State) : cnt s₀ % 128 = (s₀.gpr .r2).toNat % 128 := by - simp only [cnt, countArm] - rw [BitVec.toNat_append, ← Nat.shiftLeft_add_eq_or_of_lt (s₀.gpr .r2).isLt, Nat.shiftLeft_eq] - omega - -theorem R₀.length {s₀ : State} {iv : HashValue} {m : List Byte} (h : R₀ s₀ iv m) : - cnt s₀ % 128 = m.length % 128 := by - rw [cnt, h.2, BitVec.toNat_ofNat] - omega - -theorem len_lt (s₀ : State) : len s₀ < 2 ^ 32 := (stackArg s₀ 1).isLt - -theorem D_length (s₀ : State) : (D s₀).length = len s₀ := by simp [bytesAt] - -theorem addr_toNat (a : BitVec 32) : (State.addr a).toNat = a.toNat := by - simp only [State.addr, BitVec.toNat_setWidth] - exact Nat.mod_eq_of_lt (by have := a.isLt; omega) - -/-! ## Invariants -/ - -/-- What holds throughout, after consuming `c` bytes of data. -/ -structure Common (s₀ : State) (c : Nat) (s : State) : Prop where - c_le : c ≤ len s₀ - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - r0 : s.gpr .r0 = st s₀ - r3 : s.gpr .r3 = scr s₀ - sp : s.sp = s₀.sp - r5 : s.gpr .r5 = dp s₀ + BitVec.ofNat 32 c - r6 : s.gpr .r6 = BitVec.ofNat 32 (len s₀ - c) - frame : Frame [stR s₀, scR s₀] s₀.mem s.mem - saved : Saved s₀ s.mem - -/-- The loop invariant: the state represents the message followed by the -first `c` bytes of data. -/ -structure Inv (s₀ : State) (c : Nat) (s : State) : Prop extends Common s₀ c s where - r4 : s.gpr .r4 = BitVec.ofNat 32 ((cnt s₀ + c) % 128) - repr : ∀ iv m, R₀ s₀ iv m → Spec.Sha512.Repr iv s.mem (stA s₀) (m ++ (D s₀).take c) - -theorem Common.of_gpr {s₀ : State} {c : Nat} {s s' : State} (h : Common s₀ c s) - (hg : ∀ r ∈ [Reg.r0, .r3, .r5, .r6, .lr], s'.gpr r = s.gpr r) - (hm : s'.mem = s.mem) (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) (hsp : s'.sp = s.sp) : - Common s₀ c s' where - c_le := h.c_le - rd := hrd.trans h.rd - wr := hwr.trans h.wr - r0 := by rw [hg _ (by simp)]; exact h.r0 - r3 := by rw [hg _ (by simp)]; exact h.r3 - sp := hsp.trans h.sp - r5 := by rw [hg _ (by simp)]; exact h.r5 - r6 := by rw [hg _ (by simp)]; exact h.r6 - frame := by rw [hm]; exact h.frame - saved := by rw [hm]; exact h.saved - -theorem Inv.of_gpr {s₀ : State} {c : Nat} {s s' : State} (h : Inv s₀ c s) - (hg : ∀ r ∈ [Reg.r0, .r3, .r5, .r6, .lr, .r4], s'.gpr r = s.gpr r) - (hm : s'.mem = s.mem) (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) (hsp : s'.sp = s.sp) : - Inv s₀ c s' := - { h.toCommon.of_gpr (fun r hr => hg r (List.mem_append_left [Reg.r4] hr)) hm hrd hwr hsp with - r4 := by rw [hg _ (by simp)]; exact h.r4 - repr := by rw [hm]; exact h.repr } - -theorem Inv.of_upd {s₀ : State} {c : Nat} {s s' : State} (h : Inv s₀ c s) {d : Reg} {v : BitVec 32} - (u : Upd s s' d v) (hd : d ∉ [Reg.r0, .r3, .r5, .r6, .lr, .r4]) : Inv s₀ c s' := - h.of_gpr (fun r hr => u.other r fun e => hd (e ▸ hr)) u.mem u.rd u.wr u.sp - -theorem Inv.of_flags {s₀ : State} {c : Nat} {s s' : State} (h : Inv s₀ c s) (u : Fupd s s') : Inv s₀ c s' := - h.of_gpr (fun r _ => by rw [u.gpr]) u.mem u.rd u.wr u.sp - -/-- Where the caller's registers are saved. -/ -theorem saved_sub {s₀ : State} {p : Reg × Nat} (hp : p ∈ saved) : - Region.Sub ⟨scA s₀ + BitVec.ofNat 64 p.2, 4⟩ (scR s₀) := - sub_offset (by have := (saved_bound p hp).2; omega) (by have := (saved_bound p hp).2; omega) - -/-! ## Consuming data -/ - -theorem D_getD (s₀ : State) {i : Nat} (hi : i < len s₀) : - (D s₀).getD i 0 = s₀.mem (dA s₀ + BitVec.ofNat 64 i) := by - simp [bytesAt, List.getD_eq_getElem?_getD, hi] - -/-- The data is unchanged. -/ -theorem Common.data {s₀ : State} (hp : Pre s₀) {c : Nat} {s : State} (h : Common s₀ c s) {i : Nat} - (hi : i < len s₀) : s.mem (dA s₀ + BitVec.ofNat 64 i) = (D s₀).getD i 0 := by - rw [D_getD s₀ hi] - exact frame_bytes h.frame (R := dR s₀) (by simpa using ⟨hp.d_st, hp.d_scr⟩) - (by have := len_lt s₀; show len s₀ ≤ 2 ^ 64; omega) hi - -theorem length_mid (s₀ : State) {iv : HashValue} {m : List Byte} (hm : R₀ s₀ iv m) {c : Nat} - (hc : c ≤ len s₀) : (m ++ (D s₀).take c).length % 128 = (cnt s₀ + c) % 128 := by - have := hm.length - simp only [List.length_append, List.length_take, D_length, Nat.min_eq_left hc] - omega - -theorem take_add_data (s₀ : State) (c t : Nat) (m : List Byte) : - m ++ (D s₀).take c ++ ((D s₀).drop c).take t = m ++ (D s₀).take (c + t) := by - rw [List.take_add, List.append_assoc] - -/-! ## Buffering data -/ - -section -variable (s₀ : State) (c : Nat) -/-- Bytes in the buffer before this iteration. -/ -abbrev rr : Nat := (cnt s₀ + c) % 128 -/-- Bytes copied into the buffer in this iteration. -/ -abbrev tt : Nat := min (128 - rr s₀ c) (len s₀ - c) -/-- Where they go. -/ -abbrev q : Addr := stA s₀ + 64 + BitVec.ofNat 64 (rr s₀ c) -/-- The data copied. -/ -abbrev xs : List Byte := ((D s₀).drop c).take (tt s₀ c) -end - -theorem rr_lt (s₀ : State) (c : Nat) : rr s₀ c < 128 := Nat.mod_lt _ (by omega) -theorem tt_le (s₀ : State) (c : Nat) : tt s₀ c ≤ len s₀ - c := Nat.min_le_right _ _ -theorem tt_le' (s₀ : State) (c : Nat) : tt s₀ c ≤ 128 - rr s₀ c := Nat.min_le_left _ _ -theorem rr_eq (s₀ : State) (c : Nat) : rr s₀ c = (cnt s₀ + c) % 128 := rfl -theorem tt_eq (s₀ : State) (c : Nat) : tt s₀ c = min (128 - rr s₀ c) (len s₀ - c) := rfl - -theorem q_eq (s₀ : State) (c : Nat) : q s₀ c = stA s₀ + BitVec.ofNat 64 (64 + rr s₀ c) := by - simp only [q, BitVec.ofNat_add]; rw [BitVec.add_assoc]; rfl - -theorem xs_length (s₀ : State) (c : Nat) : (xs s₀ c).length = tt s₀ c := by - have := tt_le s₀ c - simp only [xs, List.length_take, List.length_drop, D_length]; omega - -/-- Byte `k` of the buffer, addressed as `[r0 + k, #64]`. -/ -theorem buf_addr {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 128) : - State.addr (st s₀ + BitVec.ofNat 32 k + BitVec.ofNat 32 64) = stA s₀ + 64 + BitVec.ofNat 64 k := by - have := hp.st_fit - rw [BitVec.add_assoc, ← BitVec.ofNat_add, addr_add (by omega), Nat.add_comm, BitVec.ofNat_add, - ← BitVec.add_assoc] - rfl - -/-- The state while copying: `j` bytes copied, into memory otherwise as in `mI`. -/ -structure Copy (s₀ : State) (c : Nat) (mI : Mem) (j : Nat) (s : State) : Prop where - j_le : j ≤ tt s₀ c - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - r0 : s.gpr .r0 = st s₀ - r3 : s.gpr .r3 = scr s₀ - sp : s.sp = s₀.sp - r5 : s.gpr .r5 = dp s₀ + BitVec.ofNat 32 (c + j) - r6 : s.gpr .r6 = BitVec.ofNat 32 (len s₀ - c - tt s₀ c) - r4 : s.gpr .r4 = BitVec.ofNat 32 (rr s₀ c + j) - r8 : s.gpr .r8 = BitVec.ofNat 32 (tt s₀ c - j) - mem : s.mem = writeBytes mI (q s₀ c) ((xs s₀ c).take j) - -theorem write_frame (s₀ : State) (c : Nat) (mI : Mem) (j : Nat) (hj : j ≤ tt s₀ c) : - Frame [stR s₀] mI (writeBytes mI (q s₀ c) ((xs s₀ c).take j)) := by - have := tt_le' s₀ c; have := rr_lt s₀ c - refine writeBytes_frame _ _ _ ?_ - rw [q_eq] - exact contains_offset (by simp only [List.length_take]; omega) (by omega) - -/-- The copy loop's body. -/ -def copyBody : List Instr := - [.ldrb .r12 .r5 0, .dp .add .r1 .r0 (.reg .r4), .strb .r12 .r1 64, .dp .add .r5 .r5 (.imm 1), - .dp .add .r4 .r4 (.imm 1), .subs .r8 .r8 (.imm 1)] - -theorem copy_step {s₀ : State} (hp : Pre s₀) {c : Nat} {sI : State} (hI : Inv s₀ c sI) {j : Nat} - (hj : j < tt s₀ c) {s : State} (h : Copy s₀ c sI.mem j s) : - WP isa (.block copyBody) s fun s' => - Copy s₀ c sI.mem (j + 1) s' ∧ s'.z = (BitVec.ofNat 32 (tt s₀ c - (j + 1)) == 0) := by - have hlen := len_lt s₀; have hd := hp.d_fit - have hc := hI.c_le - have hr := rr_lt s₀ c - have ht := tt_le s₀ c; have ht' := tt_le' s₀ c - -- The byte read. - have hin : InRegions (s.rd ++ s.wr) (dA s₀ + BitVec.ofNat 64 (c + j)) 1 := - ⟨dR s₀, by simp [h.rd, hp.rd], contains_offset (by omega) (by omega)⟩ - have hbyte : s.mem (dA s₀ + BitVec.ofNat 64 (c + j)) = (D s₀).getD (c + j) 0 := by - rw [h.mem, ← hI.data hp (by omega)] - exact frame_bytes (write_frame s₀ c sI.mem j h.j_le) (R := dR s₀) (by simpa using hp.d_st) - (by show len s₀ ≤ 2 ^ 64; omega) (by show c + j < len s₀; omega) - -- The byte written. - have hout : InRegions s.wr (q s₀ c + BitVec.ofNat 64 j) 1 := - ⟨stR s₀, by simp [h.wr, hp.wr], by - rw [q_eq, BitVec.add_assoc, ← BitVec.ofNat_add]; exact contains_offset (by omega) (by omega)⟩ - have hxs := xs_length s₀ c - unfold copyBody - refine wp_ldrb (a := dA s₀ + BitVec.ofNat 64 (c + j)) (by omega) - (by rw [h.r5, BitVec.add_zero, addr_add (by omega)]) hin - fun s₁ u₁ => ?_ - refine wp_add (op2_reg _ _) fun s₂ u₂ => wp_strb (a := q s₀ c + BitVec.ofNat 64 j) (by omega) ?_ - (by rw [u₂.wr, u₁.wr]; exact hout) fun s₃ g₃ => ?_ - · rw [u₂.gpr, u₁.other _ (by decide), u₁.other _ (by decide), h.r0, h.r4, buf_addr hp (by omega), q] - simp only [BitVec.ofNat_add] - ac_rfl - refine wp_add (op2_imm (by decide)) fun s₄ u₄ => wp_add (op2_imm (by decide)) fun s₅ u₅ => - wp_subs (op2_imm (by decide)) fun s₆ u₆ z₆ => WP.block_nil ?_ - have g : ∀ r, r ≠ .r12 → r ≠ .r1 → r ≠ .r5 → r ≠ .r4 → r ≠ .r8 → s₆.gpr r = s.gpr r := - fun r h1 h2 h3 h4 h5 => by - rw [u₆.other r h5, u₅.other r h4, u₄.other r h3, g₃.gpr, u₂.other r h2, u₁.other r h1] - have h8 : s₆.gpr .r8 = BitVec.ofNat 32 (tt s₀ c - (j + 1)) := by - rw [u₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), g₃.gpr, u₂.other _ (by decide), - u₁.other _ (by decide), h.r8, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega), - Nat.sub_sub] - refine ⟨⟨by omega, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, h8, ?_⟩, ?_⟩ - · rw [u₆.rd, u₅.rd, u₄.rd, g₃.rd, u₂.rd, u₁.rd, h.rd] - · rw [u₆.wr, u₅.wr, u₄.wr, g₃.wr, u₂.wr, u₁.wr, h.wr] - · rw [g .r0 (by decide) (by decide) (by decide) (by decide) (by decide), h.r0] - · rw [g .r3 (by decide) (by decide) (by decide) (by decide) (by decide), h.r3] - · rw [u₆.sp, u₅.sp, u₄.sp, g₃.sp, u₂.sp, u₁.sp, h.sp] - · rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, g₃.gpr, u₂.other _ (by decide), - u₁.other _ (by decide), h.r5, BitVec.add_assoc, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, - ← BitVec.ofNat_add, Nat.add_assoc] - · rw [g .r6 (by decide) (by decide) (by decide) (by decide) (by decide), h.r6] - · rw [u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), g₃.gpr, u₂.other _ (by decide), - u₁.other _ (by decide), h.r4, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, ← BitVec.ofNat_add, - Nat.add_assoc] - · have hj' : j < (xs s₀ c).length := by omega - rw [u₆.mem, u₅.mem, u₄.mem, g₃.mem, u₂.mem, u₁.mem, u₂.other _ (by decide), u₁.gpr, hbyte, h.mem, - List.take_add_one, List.getElem?_eq_getElem hj', Option.toList_some, - writeBytes_snoc _ _ _ _ (by simp only [List.length_take]; omega)] - have hl : (List.take j (xs s₀ c)).length = j := by rw [List.length_take, Nat.min_eq_left (Nat.le_of_lt hj')] - rw [hl] - have e : ((List.getD (D s₀) (c + j) 0).setWidth 32).setWidth 8 = List.getD (D s₀) (c + j) 0 := by - ext i hi; simp - rw [e] - congr 1 - simp only [xs, List.getElem_take, List.getElem_drop, List.getD_eq_getElem?_getD, - List.getElem?_eq_getElem (show c + j < (D s₀).length by rw [D_length]; omega), Option.getD_some] - · rw [z₆, ← u₆.gpr, h8] - -theorem copy_loop_ok {s₀ : State} (hp : Pre s₀) {c : Nat} {sI : State} (hI : Inv s₀ c sI) {s : State} - (h : Copy s₀ c sI.mem 0 s) (ht : 0 < tt s₀ c) : - WP isa (.loop (.block copyBody) .ne) s (Copy s₀ c sI.mem (tt s₀ c)) := by - refine WP.loop (M := isa) (fun n s => ∃ j, n = tt s₀ c - j ∧ j < tt s₀ c ∧ Copy s₀ c sI.mem j s) - ?_ (tt s₀ c) s ⟨0, rfl, ht, h⟩ - rintro n s ⟨j, rfl, hj, hc⟩ - refine WP.mono (copy_step hp hI hj hc) fun s' ⟨hc', hz'⟩ => ?_ - have hz : isa.eval .ne s' = some (decide (tt s₀ c - (j + 1) ≠ 0)) := by - show VG.Arm.eval .ne s' = _ - rw [eval_ne, hz', ofNat_beq_zero (by have := tt_le' s₀ c; omega)] - simp - by_cases hl : tt s₀ c - (j + 1) = 0 - · refine .inl ⟨by rw [hz, decide_eq_false fun h => h hl], ?_⟩ - rwa [show j + 1 = tt s₀ c by omega] at hc' - · exact .inr ⟨by rw [hz, decide_eq_true hl], _, by omega, j + 1, rfl, by omega, hc'⟩ - -/-- The memory after copying `tt` bytes. -/ -theorem copied_facts {s₀ : State} (hp : Pre s₀) {c : Nat} {sI : State} (hI : Inv s₀ c sI) : - let mem := writeBytes sI.mem (q s₀ c) (xs s₀ c) - Frame [stR s₀, scR s₀] s₀.mem mem ∧ Saved s₀ mem ∧ stateAt mem (stA s₀) = stateAt sI.mem (stA s₀) ∧ - bytesAt mem (stA s₀ + 64) (rr s₀ c + tt s₀ c) = bytesAt sI.mem (stA s₀ + 64) (rr s₀ c) ++ xs s₀ c := by - intro mem - have hr := rr_lt s₀ c; have ht' := tt_le' s₀ c - have hxs := xs_length s₀ c - have hf : Frame [stR s₀] sI.mem mem := by - have := write_frame s₀ c sI.mem (tt s₀ c) (Nat.le_refl _) - rwa [List.take_of_length_le (by omega)] at this - refine ⟨hI.frame.trans (hf.mono (by simp)), fun p hp' => ?_, ?_, ?_⟩ - · rw [← hI.saved p hp'] - refine hf.readW (r := ⟨scA s₀ + BitVec.ofNat 64 p.2, 4⟩) (Region.contains_self _ _) ?_ (by decide) - intro r' hr' - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' - subst hr' - exact hp.st_scr.symm.sub_left (saved_sub hp') - · apply stateAt_congr - intro i hi - simp only [mem, q_eq] - exact writeBytes_before _ _ _ (by omega) (by omega) - · rw [← hxs] - exact bytesAt_writeBytes _ _ _ _ (by omega) - -/-- A full buffer: compress it. -/ -theorem fill_full {s₀ : State} (hp : Pre s₀) {c : Nat} {sI : State} (hI : Inv s₀ c sI) {s : State} - (h : Copy s₀ c sI.mem (tt s₀ c) s) (hfull : rr s₀ c + tt s₀ c = 128) : - WP isa (.seq compressAt (.block [.mov .r4 (.imm 0)])) s (Inv s₀ (c + tt s₀ c)) := by - have hr := rr_lt s₀ c; have ht := tt_le s₀ c; have ht' := tt_le' s₀ c - have hxs := xs_length s₀ c - have hc := hI.c_le - have hst := hp.st_fit; have hsc := hp.scr_fit - obtain ⟨hfr, hsv, hstt, hby⟩ := copied_facts hp hI - have hmem : s.mem = writeBytes sI.mem (q s₀ c) (xs s₀ c) := by - rw [h.mem, List.take_of_length_le (by omega)] - have e64 : Region.Sub ⟨scA s₀, 224⟩ (scR s₀) := Region.sub_prefix (by omega) - refine WP.seq (compressBuf_ok hst hsc hp.st_scr ⟨h.r0, h.r3, by simp [h.wr, hp.wr], by simp [h.wr, hp.wr]⟩ - fun s' hrd hwr hg hsp hf hstate => ?_) - refine wp_mov (op2_imm (by decide)) fun s'' u => WP.block_nil ?_ - have e : ∀ r, r ≠ .r4 → r ∉ temps → r ≠ .lr → s''.gpr r = s.gpr r := fun r h4 ht hl => by - rw [u.other r h4, hg r ht hl] - refine ⟨⟨by omega, by rw [u.rd, hrd, h.rd], by rw [u.wr, hwr, h.wr], - by rw [e _ (by decide) (by decide) (by decide), h.r0], - by rw [e _ (by decide) (by decide) (by decide), h.r3], by rw [u.sp, hsp, h.sp], - by rw [e _ (by decide) (by decide) (by decide), h.r5], - by rw [e _ (by decide) (by decide) (by decide), h.r6, Nat.sub_sub], - ?_, fun p hp' => ?_⟩, ?_, fun iv m hm => ?_⟩ - · rw [u.mem] - rw [hmem] at hf - refine hfr.trans (hf.sub fun r hr => ?_) - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact ⟨stR s₀, by simp, fun _ h => h⟩ - · exact ⟨scR s₀, by simp, e64⟩ - · rw [u.mem, ← hsv p hp', ← hmem] - refine hf.readW (r := ⟨scA s₀ + BitVec.ofNat 64 p.2, 4⟩) (Region.contains_self _ _) ?_ (by decide) - intro r' hr' - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' - rcases hr' with rfl | rfl - · exact hp.st_scr.symm.sub_left (saved_sub hp') - · have := saved_bound p hp' - exact Offset.disjoint_base _ (by omega) (by omega) - · rw [u.gpr] - show 0 = BitVec.ofNat 32 ((cnt s₀ + (c + tt s₀ c)) % 128) - rw [show (cnt s₀ + (c + tt s₀ c)) % 128 = 0 by have := rr_eq s₀ c; omega]; rfl - · rw [← take_add_data] - have hmod := length_mid s₀ hm hc - refine repr_append_block (hI.repr iv m hm) (by rw [hmod, hxs]; exact hfull) ?_ - rw [u.mem, hstate, hmem, hstt] - refine congrArg (compress _) (parseBlock_congr fun k hk => ?_) - have hb := (hI.repr iv m hm).2 - rw [hmod] at hb - rw [hb, show rr s₀ c + tt s₀ c = 128 from hfull] at hby - exact bytesAt_getD hby hk - -/-- All the data fits in the buffer. -/ -theorem fill_done {s₀ : State} (hp : Pre s₀) {c : Nat} {sI : State} (hI : Inv s₀ c sI) {s : State} - (h : Copy s₀ c sI.mem (tt s₀ c) s) (hnf : rr s₀ c + tt s₀ c ≠ 128) : Inv s₀ (len s₀) s := by - have hr := rr_lt s₀ c; have ht := tt_le s₀ c; have ht' := tt_le' s₀ c - have hrr := rr_eq s₀ c; have htt := tt_eq s₀ c - have hxs := xs_length s₀ c - have hc := hI.c_le - have htl : tt s₀ c = len s₀ - c := by omega - obtain ⟨hfr, hsv, hstt, hby⟩ := copied_facts hp hI - have hmem : s.mem = writeBytes sI.mem (q s₀ c) (xs s₀ c) := by - rw [h.mem, List.take_of_length_le (by omega)] - refine ⟨⟨(Nat.le_refl _), h.rd, h.wr, h.r0, h.r3, h.sp, ?_, ?_, by rw [hmem]; exact hfr, - by rw [hmem]; exact hsv⟩, ?_, fun iv m hm => ?_⟩ - · rw [h.r5]; congr 2; omega - · rw [h.r6]; congr 1; omega - · rw [h.r4]; congr 1; omega - · have hmod := length_mid s₀ hm hc - rw [show len s₀ = c + tt s₀ c by omega, ← take_add_data] - refine repr_append_buf (hI.repr iv m hm) (by rw [hmod, hxs]; omega) (by rw [hmem, hstt]) ?_ - rw [hmod, hxs, hmem, hby] - have hb := (hI.repr iv m hm).2 - rw [hmod] at hb - rw [hb] - -theorem fill_eq : fill = - .seq (.block [.mov .r8 (.imm 128), .dp .sub .r8 .r8 (.reg .r4), .mov .r12 (.shifted .r6 .lsr 7), - .cmp .r12 (.imm 0)]) - (.seq (.ite .eq - (.seq (.block [.dp .add .r12 .r6 (.reg .r4), .mov .r12 (.shifted .r12 .lsr 7), .cmp .r12 (.imm 0)]) - (.ite .eq (.block [.mov .r8 (.reg .r6)]) (.block []))) - (.block [])) - (.seq (.block [.dp .sub .r6 .r6 (.reg .r8)]) - (.seq (.loop (.block copyBody) .ne) - (.seq (.block [.cmp .r4 (.imm 128)]) - (.ite .eq (.seq compressAt (.block [.mov .r4 (.imm 0)])) (.block [])))))) := rfl - -theorem shr7 {a : Nat} (h : a < 2 ^ 32) : BitVec.ofNat 32 a >>> 7 = BitVec.ofNat 32 (a / 128) := - ofNat_shr h - -theorem cmp0 {a : Nat} (h : a < 2 ^ 32) : (BitVec.ofNat 32 a - 0 == 0) = decide (a = 0) := by - rw [show BitVec.ofNat 32 a - 0 = BitVec.ofNat 32 a by simp]; exact ofNat_beq_zero h - -/-- The bytes consumed after an iteration that started with `c`. -/ -def nextC (s₀ : State) (c : Nat) : Nat := if rr s₀ c + tt s₀ c = 128 then c + tt s₀ c else len s₀ - -/-- `fill` before the test of whether the buffer is full, and after. -/ -def fillPre : Prog isa := - .seq (.seq (.seq (.seq (.block [.mov .r8 (.imm 128), .dp .sub .r8 .r8 (.reg .r4), .mov .r12 (.shifted .r6 .lsr 7), - .cmp .r12 (.imm 0)]) - (.ite .eq - (.seq (.block [.dp .add .r12 .r6 (.reg .r4), .mov .r12 (.shifted .r12 .lsr 7), .cmp .r12 (.imm 0)]) - (.ite .eq (.block [.mov .r8 (.reg .r6)]) (.block []))) - (.block []))) - (.block [.dp .sub .r6 .r6 (.reg .r8)])) - (.loop (.block copyBody) .ne)) - (.block [.cmp .r4 (.imm 128)]) - -def fillEnd : Prog isa := .ite .eq (.seq compressAt (.block [.mov .r4 (.imm 0)])) (.block []) - -theorem nextC_gt (s₀ : State) {c : Nat} (hcl : c < len s₀) : c < nextC s₀ c := by - have := tt_eq s₀ c; have := rr_lt s₀ c - simp only [nextC]; split <;> omega - -/-- Where `fill` tests whether the buffer is full. -/ -def Mid (s₀ : State) (c : Nat) (s : State) : Prop := AtPre (st s₀) (scr s₀) s ∧ - VG.Arm.eval .eq s = some (decide (rr s₀ c + tt s₀ c = 128)) ∧ WP isa fillEnd s (Inv s₀ (nextC s₀ c)) - -theorem pre_ok {s₀ : State} (hp : Pre s₀) {c : Nat} {s : State} (hI : Inv s₀ c s) (hcl : c < len s₀) : - WP isa fillPre s (Mid s₀ c) := by - have hr := rr_lt s₀ c; have ht := tt_le s₀ c; have ht' := tt_le' s₀ c - have hrr := rr_eq s₀ c; have htt := tt_eq s₀ c - have hc := hI.c_le; have hlen := len_lt s₀ - unfold fillPre - refine WP.seq (WP.seq (WP.seq (WP.seq ?_))) - -- `r8 := 128 - r; r12 := len >> 7` - refine (wp_mov (op2_imm (by decide)) fun s₁ u₁ => wp_sub (op2_reg _ _) fun s₂ u₂ => - wp_mov (op2_lsr (by decide)) fun s₃ u₃ => wp_cmp (op2_imm (by decide)) fun s₄ f₄ z₄ => WP.block_nil ?_) - have hI₄ : Inv s₀ c s₄ := ((((hI.of_upd u₁ (by decide)).of_upd u₂ (by decide)).of_upd u₃ (by decide))).of_flags f₄ - have h8₄ : s₄.gpr .r8 = BitVec.ofNat 32 (128 - rr s₀ c) := by - rw [f₄.gpr, u₃.other _ (by decide), u₂.gpr, u₁.gpr, u₁.other _ (by decide), hI.r4, - show (128 : BitVec 32) = BitVec.ofNat 32 128 from rfl, sub_ofNat (by omega)] - have hm₄ : s₄.mem = s.mem := by rw [f₄.mem, u₃.mem, u₂.mem, u₁.mem] - have hz₄ : s₄.z = decide ((len s₀ - c) / 128 = 0) := by - rw [z₄, u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), hI.r6, shr7 (by omega), cmp0 (by omega)] - -- `r8 := min(r8, len)` - refine (WP.mono (Q := fun (s₅ : State) => Inv s₀ c s₅ ∧ s₅.gpr .r8 = BitVec.ofNat 32 (tt s₀ c) ∧ - s₅.mem = s.mem) ?_ fun s₅ ⟨hI₅, h8₅, hm₅⟩ => ?_) - · refine WP.ite (decide ((len s₀ - c) / 128 = 0)) - (by show VG.Arm.eval .eq s₄ = _; rw [eval_eq, hz₄]) (fun hb => ?_) (fun hb => ?_) - · simp only [decide_eq_true_eq] at hb - refine WP.seq (wp_add (op2_reg _ _) fun s₆ u₆ => wp_mov (op2_lsr (by decide)) fun s₇ u₇ => - wp_cmp (op2_imm (by decide)) fun s₈ f₈ z₈ => WP.block_nil ?_) - have hI₈ : Inv s₀ c s₈ := ((hI₄.of_upd u₆ (by decide)).of_upd u₇ (by decide)).of_flags f₈ - have hz₈ : s₈.z = decide ((len s₀ - c + rr s₀ c) / 128 = 0) := by - rw [z₈, u₇.gpr, u₆.gpr, hI₄.r6, hI₄.r4, ← BitVec.ofNat_add, shr7 (by omega), cmp0 (by omega)] - have e₈ : ∀ r, r ≠ .r12 → s₈.gpr r = s₄.gpr r := fun r h => by rw [f₈.gpr, u₇.other r h, u₆.other r h] - have hm₈ : s₈.mem = s.mem := by rw [f₈.mem, u₇.mem, u₆.mem, hm₄] - refine WP.ite (decide ((len s₀ - c + rr s₀ c) / 128 = 0)) - (by show VG.Arm.eval .eq s₈ = _; rw [eval_eq, hz₈]) (fun hb' => ?_) (fun hb' => ?_) - · simp only [decide_eq_true_eq] at hb' - refine wp_mov (op2_reg _ _) fun s₉ u₉ => WP.block_nil ⟨hI₈.of_upd u₉ (by decide), ?_, - by rw [u₉.mem, hm₈]⟩ - rw [u₉.gpr, hI₈.r6]; congr 1; omega - · simp only [decide_eq_false_iff_not] at hb' - refine WP.block_nil ⟨hI₈, ?_, hm₈⟩ - rw [e₈ _ (by decide), h8₄]; congr 1; omega - · simp only [decide_eq_false_iff_not] at hb - refine WP.block_nil ⟨hI₄, ?_, hm₄⟩ - rw [h8₄]; congr 1; omega - -- `r6 -= r8` - refine (wp_sub (op2_reg _ _) fun s₆ u₆ => WP.block_nil ?_) - have hC₀ : Copy s₀ c s.mem 0 s₆ := by - have e : ∀ r, r ≠ .r6 → s₆.gpr r = s₅.gpr r := fun r h => u₆.other r h - refine ⟨Nat.zero_le _, by rw [u₆.rd, hI₅.rd], by rw [u₆.wr, hI₅.wr], - by rw [e _ (by decide), hI₅.r0], by rw [e _ (by decide), hI₅.r3], - by rw [u₆.sp, hI₅.sp], by rw [e _ (by decide), hI₅.r5, Nat.add_zero], ?_, - by rw [e _ (by decide), hI₅.r4, Nat.add_zero], by rw [e _ (by decide), h8₅, Nat.sub_zero], ?_⟩ - · rw [u₆.gpr, hI₅.r6, h8₅, sub_ofNat (by omega), Nat.sub_sub] - · rw [u₆.mem, hm₅, List.take_zero, writeBytes_nil] - -- Copy the bytes. - refine (WP.mono (copy_loop_ok hp hI hC₀ (by omega)) fun s₇ hC => ?_) - -- Is the buffer full? - refine (wp_cmp (op2_imm (by decide)) fun s₈ f₈ z₈ => WP.block_nil ?_) - have hC₈ : Copy s₀ c s.mem (tt s₀ c) s₈ := - ⟨hC.j_le, by rw [f₈.rd, hC.rd], by rw [f₈.wr, hC.wr], by rw [f₈.gpr, hC.r0], by rw [f₈.gpr, hC.r3], - by rw [f₈.sp, hC.sp], by rw [f₈.gpr, hC.r5], by rw [f₈.gpr, hC.r6], - by rw [f₈.gpr, hC.r4], by rw [f₈.gpr, hC.r8], by rw [f₈.mem, hC.mem]⟩ - have hz : VG.Arm.eval .eq s₈ = some (decide (rr s₀ c + tt s₀ c = 128)) := by - rw [eval_eq, z₈, hC.r4, show (128 : BitVec 32) = BitVec.ofNat 32 128 from rfl, - sub_beq (by omega) (by omega)] - refine ⟨⟨hC₈.r0, hC₈.r3, by simp [hC₈.wr, hp.wr], by simp [hC₈.wr, hp.wr]⟩, hz, - WP.ite (decide (rr s₀ c + tt s₀ c = 128)) hz (fun hb => ?_) (fun hb => ?_)⟩ - · simp only [decide_eq_true_eq] at hb - have e : nextC s₀ c = c + tt s₀ c := by simp only [nextC]; split <;> omega - rw [e] - exact fill_full hp hI hC₈ hb - · simp only [decide_eq_false_iff_not] at hb - have e : nextC s₀ c = len s₀ := by simp only [nextC]; split <;> omega - rw [e] - exact WP.block_nil (fill_done hp hI hC₈ hb) - -theorem fill_ok {s₀ : State} (hp : Pre s₀) {c : Nat} {s : State} (hI : Inv s₀ c s) (hcl : c < len s₀) : - WP isa fill s fun s' => ∃ c', c < c' ∧ Inv s₀ c' s' := by - rw [fill_eq] - exact WP.assoc (WP.assoc (WP.assoc (WP.assoc (WP.seq (WP.mono (pre_ok hp hI hcl) - fun _ h => WP.mono h.2.2 fun _ h => ⟨_, nextC_gt s₀ hcl, h⟩))))) - -/-! ## One iteration -/ - -/-- The loop's test: bytes left? -/ -theorem test_ok {s₀ : State} {c : Nat} {s : State} (hI : Inv s₀ c s) : - WP isa (.block [.cmp .r6 (.imm 0)]) s fun s' => Inv s₀ c s' ∧ s'.z = decide (len s₀ - c = 0) := by - have hlen := len_lt s₀ - have hc'' := hI.c_le - refine wp_cmp (op2_imm (by decide)) fun s'' f'' z'' => WP.block_nil ⟨hI.of_flags f'', ?_⟩ - rw [z'', hI.r6, cmp0 (by omega)] - -theorem body_ok {s₀ : State} (hp : Pre s₀) {c : Nat} {s : State} (hI : Inv s₀ c s) (hcl : c < len s₀) : - WP isa updateBody s fun s' => ∃ c', c < c' ∧ Inv s₀ c' s' ∧ s'.z = decide (len s₀ - c' = 0) := - WP.seq (WP.mono (fill_ok hp hI hcl) fun _ ⟨c', hc', hI'⟩ => - WP.mono (test_ok hI') fun _ h => ⟨c', hc', h⟩) - -/-! ## Prologue and epilogue -/ - -/-- The prologue after saving. -/ -def prologue : List Instr := - [.mov .r3 (.reg .r12), .dp .and .r4 .r2 (.imm 127), .ldrSp .r5 0, .ldrSp .r6 4, .cmp .r6 (.imm 0)] - -theorem update_eq : update = .seq (.block (([.ldrSp .r12 8] : List Instr) ++ save .r12 ++ prologue)) - (.seq (.ite .eq (.block []) (.loop updateBody .ne)) (.block restore)) := rfl - -/-- The stack arguments, word by word. -/ -theorem argAddr_eq {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 3) : - stackArgAddr s₀ k = stackArgAddr s₀ 0 + BitVec.ofNat 64 (4 * k) := by - have := hp.sp_fit - simp only [stackArgAddr] - rw [addr_add (by omega)] - simp - -theorem arg_in {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 3) : - InRegions (s₀.rd ++ s₀.wr) (stackArgAddr s₀ k) 4 := - ⟨argR s₀, by simp [hp.rd], by rw [argAddr_eq hp hk]; exact contains_offset (by omega) (by omega)⟩ - -theorem arg_sub {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 3) : - Region.Sub ⟨stackArgAddr s₀ k, 4⟩ (argR s₀) := by - rw [argAddr_eq hp hk]; exact sub_offset (by omega) (by omega) - -theorem prologue_ok {s₀ : State} (hp : Pre s₀) : - WP isa (.block (([.ldrSp .r12 8] : List Instr) ++ save .r12 ++ prologue)) s₀ - fun s => Inv s₀ 0 s ∧ s.z = decide (len s₀ = 0) := by - have hsc := hp.scr_fit; have hst := hp.st_fit - simp only [List.cons_append, List.nil_append] - refine wp_ldrSp (a := stackArgAddr s₀ 2) (by decide) rfl (arg_in hp (by decide)) fun s₁ u₁ => ?_ - have h12 : s₁.gpr .r12 = scr s₀ := u₁.gpr - refine save_ok (by rw [h12]; omega) (fun d hd₁ hd₂ => ⟨scR s₀, by simp [u₁.wr, hp.wr], - by rw [h12]; exact contains_offset (by omega) (by omega)⟩) fun s₂ g₂ rd₂ wr₂ sp₂ m₂ => ?_ - -- The stack arguments are unchanged by the save. - have hframe : Frame [scR s₀] s₀.mem s₂.mem := by - rw [m₂, u₁.mem, h12] - exact saveMem_frame _ _ _ (by omega) saved fun p hp' => by have := (saved_bound p hp').2; omega - have harg : ∀ k, k < 3 → s₂.mem.readW (stackArgAddr s₀ k) 32 = stackArg s₀ k := fun k hk => - hframe.readW (Region.contains_self _ _) (by simpa using (hp.a_scr.sub_left (arg_sub hp hk))) (by decide) - unfold prologue - refine wp_mov (op2_reg _ _) fun s₃ u₃ => wp_and (op2_imm (by decide)) fun s₄ u₄ => ?_ - refine wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) - (by rw [u₄.sp, u₃.sp, sp₂, u₁.sp]; rfl) - (by rw [u₄.rd, u₄.wr, u₃.rd, u₃.wr, rd₂, wr₂, u₁.rd, u₁.wr]; exact arg_in hp (by decide)) fun s₅ u₅ => ?_ - refine wp_ldrSp (a := stackArgAddr s₀ 1) (by decide) - (by rw [u₅.sp, u₄.sp, u₃.sp, sp₂, u₁.sp]; rfl) - (by rw [u₅.rd, u₅.wr, u₄.rd, u₄.wr, u₃.rd, u₃.wr, rd₂, wr₂, u₁.rd, u₁.wr]; exact arg_in hp (by decide)) - fun s₆ u₆ => wp_cmp (op2_imm (by decide)) fun s₇ f₇ z₇ => WP.block_nil ?_ - have mm : s₇.mem = s₂.mem := by rw [f₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem] - have g : ∀ r, r ∉ [Reg.r3, .r4, .r5, .r6, .r12] → s₇.gpr r = s₀.gpr r := fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false, not_or] at hr - rw [f₇.gpr, u₆.other r hr.2.2.2.1, u₅.other r hr.2.2.1, u₄.other r hr.2.1, u₃.other r hr.1, g₂, - u₁.other r hr.2.2.2.2] - have h6' : s₆.gpr .r6 = stackArg s₀ 1 := by - rw [u₆.gpr, u₅.mem, u₄.mem, u₃.mem, harg 1 (by decide)] - have h6 : s₇.gpr .r6 = stackArg s₀ 1 := by rw [f₇.gpr, h6'] - refine ⟨⟨⟨Nat.zero_le _, by rw [f₇.rd, u₆.rd, u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd], - by rw [f₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr], g _ (by decide), ?_, - by rw [f₇.sp, u₆.sp, u₅.sp, u₄.sp, u₃.sp, sp₂, u₁.sp], ?_, ?_, ?_, ?_⟩, ?_, ?_⟩, ?_⟩ - · rw [f₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, g₂, h12] - · rw [f₇.gpr, u₆.other _ (by decide), u₅.gpr, u₄.mem, u₃.mem, harg 0 (by decide)]; simp - · rw [h6]; simp - · rw [mm]; exact hframe.mono (by simp) - · intro p hp' - rw [mm, m₂, u₁.mem, h12, saveMem_saved _ _ _ p hp', u₁.other] - simp only [Impl.Sha512.Arm.Stream.saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> decide - · rw [f₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.other _ (by decide), g₂, - u₁.other _ (by decide), and127, Nat.add_zero, cnt_mod] - · intro iv m hm - rw [List.take_zero, List.append_nil, mm] - exact repr_congr (fun i hi => frame_bytes hframe (R := stR s₀) (by simpa using hp.st_scr) (by simp) hi) hm.1 - · rw [z₇, h6'] - have := cmp0 (a := len s₀) (len_lt s₀) - simpa using this - -theorem epilogue_ok {s₀ : State} (hp : Pre s₀) {s : State} (hI : Inv s₀ (len s₀) s) : - WP isa (.block restore) s fun s' => abiPreserved s₀ s' ∧ Proof.Sha512.updateArm.post s₀ s' := by - refine restore_ok hI.r3 hp.scr_fit - (fun d hd₁ hd₂ => ⟨scR s₀, by simp [hI.rd, hI.wr, hp.wr], contains_offset (by omega) (by omega)⟩) s₀.gpr - hI.saved fun s' hs ho hmem _ _ hsp => - ⟨⟨preserved_saved hs, by rw [hsp, hI.sp]⟩, fun iv m hr hc => ?_⟩ - have := hI.repr iv m ⟨hr, hc⟩ - rwa [List.take_of_length_le (Nat.le_of_eq (D_length s₀)), ← hmem] at this - -theorem correct {s₀ : State} (hp : Pre s₀) : - WP isa update s₀ fun s' => abiPreserved s₀ s' ∧ Proof.Sha512.updateArm.post s₀ s' := by - have hlen := len_lt s₀ - rw [update_eq] - refine WP.seq (WP.mono (prologue_ok hp) fun s₁ ⟨hI, hz⟩ => ?_) - refine WP.seq (WP.mono (Q := Inv s₀ (len s₀)) ?_ fun s₂ hI₂ => epilogue_ok hp hI₂) - refine WP.ite (decide (len s₀ = 0)) (by show VG.Arm.eval .eq s₁ = _; rw [eval_eq, hz]) - (fun hb => ?_) (fun hb => ?_) - · simp only [decide_eq_true_eq] at hb - exact WP.block_nil (hb ▸ hI) - · simp only [decide_eq_false_iff_not] at hb - refine WP.loop (M := isa) (fun n s => ∃ c, n = len s₀ - c ∧ c < len s₀ ∧ Inv s₀ c s) ?_ (len s₀) s₁ - ⟨0, rfl, by omega, hI⟩ - rintro n s ⟨c, rfl, hcl, hI⟩ - refine WP.mono (body_ok hp hI hcl) fun s' ⟨c', hc, hI', hz'⟩ => ?_ - have hc' := hI'.c_le - have hz : isa.eval .ne s' = some (decide (len s₀ - c' ≠ 0)) := by - show VG.Arm.eval .ne s' = _ - rw [eval_ne, hz'] - simp - by_cases hl : len s₀ - c' = 0 - · refine .inl ⟨by rw [hz, decide_eq_false fun h => h hl], ?_⟩ - rwa [show c' = len s₀ by omega] at hI' - · exact .inr ⟨by rw [hz, decide_eq_true hl], len s₀ - c', by omega, c', rfl, by omega, hI'⟩ - -/-! ## Constant time -/ - -/-- The initial taint: `r0` (`state`) and `r2:r3` (`count`) are public, `r0` -points at the state, and the 12 bytes of stack arguments are public, the -third one pointing at the scratch space. -/ -def τ₀ : VG.Arm.Taint.T := - { regs := .ofList [.r0, .r2, .r3], flags := false, lens := [192, 272], bases := [(.r0, 0)], argLen := 12, - argBases := [(8, 1)] } - -theorem argByte_eq {s : State} (hsp : s.sp.toNat + 12 ≤ 2 ^ 32) {k : Nat} (hk : k < 12) : - VG.Arm.Taint.argByte s k = stackArgAddr s (k / 4) + BitVec.ofNat 64 (k % 4) := by - simp only [VG.Arm.Taint.argByte, stackArgAddr] - rw [addr_add (by omega), BitVec.add_assoc, ← BitVec.ofNat_add] - congr 2; omega - -theorem wf₀ {s : State} (h : Proof.Sha512.updateArm.pre s) : VG.Arm.Taint.Wf τ₀ s := by - have hp := pre_of h - have hst := hp.st_fit; have hsc := hp.scr_fit; have hs := hp.sp_fit - refine ⟨fun _ => ⟨by simp [hp.wr, τ₀], by simpa [hp.wr] using hp.st_scr, ?_⟩, ?_, fun _ => ⟨hs, ?_⟩, ?_⟩ - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) <;> simp only [addr_toNat] <;> omega - · intro p hp'; simp only [τ₀, List.mem_singleton] at hp'; subst hp'; simp [VG.Arm.Taint.region, hp.wr] - · have e : (⟨State.addr s.sp, 12⟩ : Region) = argR s := by simp [stackArgAddr] - simp only [τ₀, e, hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact hp.a_st - · exact hp.a_scr - · intro p hp'; simp only [τ₀, List.mem_singleton] at hp'; subst hp' - refine ⟨by decide, ?_⟩ - simp only [VG.Arm.Taint.region, hp.wr] - rfl - -theorem agree₀ {s₁ s₂ : State} (h₁ : Proof.Sha512.updateArm.pre s₁) (h₂ : Proof.Sha512.updateArm.pre s₂) - (hpub : Proof.Sha512.updateArm.pub s₁ s₂) : VG.Arm.Taint.Agree τ₀ s₁ s₂ := by - obtain ⟨psp, p0, p2, p3, a0, a1, a2⟩ := hpub - have hp₁ := pre_of h₁; have hp₂ := pre_of h₂ - refine ⟨⟨fun r hr => ?_, fun h => nomatch h⟩, fun _ => ?_, wf₀ h₁, wf₀ h₂, - fun _ h => (List.not_mem_nil h).elim, fun _ h => (List.not_mem_nil h).elim, fun _ => psp, fun k hk => ?_⟩ - · simp only [τ₀, RegSet.mem_ofList, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl <;> assumption - · rw [hp₁.wr, hp₂.wr]; simp only [stR, scR, stA, scA, st, scr, p0, a2] - · simp only [τ₀] at hk - rw [argByte_eq hp₁.sp_fit hk, argByte_eq hp₂.sp_fit hk, Mem.readW_byte s₁.mem _ (Nat.mod_lt _ (by omega)), - Mem.readW_byte s₂.mem _ (Nat.mod_lt _ (by omega))] - have : k / 4 = 0 ∨ k / 4 = 1 ∨ k / 4 = 2 := by omega - rcases this with h | h | h <;> rw [h] - · exact congrArg _ a0 - · exact congrArg _ a1 - · exact congrArg _ a2 - -/-- A state satisfying the precondition (with no data, and the scratch space at 0). -/ -def sat : State where - gpr r := match r with - | .r0 => 0x1000 | _ => 0 - sp := 0x4000 - n := false - z := false - c := false - v := false - mem _ := 0 - rd := [⟨0, 0⟩, ⟨0x4000, 12⟩] - wr := [⟨0x1000, 192⟩, ⟨0, 272⟩] - -/-! ## Constant time, by relating two runs - -The prologue is checked by the taint analysis from the initial taint; in the -loop, `fill` up to the test of whether the buffer is full from the registers -that hold our variables, the call of the compression function by its -contract (`compressAt_rel`); the epilogue from the scratch pointer. How many -bytes each iteration consumes depends only on `count` and `len`, so both -runs go through the loop the same number of times, with the same -registers. -/ - -section CT -variable {s₀ s₀' : State} (hp : Pre s₀) (hp' : Pre s₀') (hpub : Proof.Sha512.updateArm.pub s₀ s₀') - -include hpub - -theorem cnt_eq : cnt s₀ = cnt s₀' := by - obtain ⟨-, -, p2, p3, -⟩ := hpub - simp only [cnt, countArm, p2, p3] - -theorem len_eq : len s₀ = len s₀' := by - simp only [len, hpub.2.2.2.2.2.1] - -theorem nextC_eq (c : Nat) : nextC s₀' c = nextC s₀ c := by - unfold nextC tt rr - rw [cnt_eq hpub, len_eq hpub] - -theorem Inv.agree {c : Nat} {s s' : State} (h : Inv s₀ c s) (h' : Inv s₀' c s') : - ∀ r ∈ [Reg.r0, .r3, .r4, .r5, .r6], s.gpr r = s'.gpr r := by - have p0 := hpub.2.1 - have a0 := hpub.2.2.2.2.1 - have a2 := hpub.2.2.2.2.2.2 - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl - · rw [h.r0, h'.r0]; exact p0 - · rw [h.r3, h'.r3]; exact a2 - · rw [h.r4, h'.r4, cnt_eq hpub] - · rw [h.r5, h'.r5, dp, dp, a0] - · rw [h.r6, h'.r6, len_eq hpub] - -include hp hp' - -theorem fill_rel {c : Nat} (hcl : c < len s₀) : - RelCT isa (fun s₁ s₂ => Inv s₀ c s₁ ∧ Inv s₀' c s₂) fill - fun s₁ s₂ => Inv s₀ (nextC s₀ c) s₁ ∧ Inv s₀' (nextC s₀ c) s₂ := by - have hcl' : c < len s₀' := len_eq hpub ▸ hcl - have e0 : st s₀' = st s₀ := hpub.2.1.symm - have e2 : scr s₀' = scr s₀ := hpub.2.2.2.2.2.2.symm - have ez : rr s₀' c + tt s₀' c = rr s₀ c + tt s₀ c := by unfold tt rr; rw [cnt_eq hpub, len_eq hpub] - have pre : RelCT isa (fun s₁ s₂ => Inv s₀ c s₁ ∧ Inv s₀' c s₂) fillPre fun s₁ s₂ => Mid s₀ c s₁ ∧ Mid s₀' c s₂ := - ((RelCT.taint (A := taint) (Taint.ofRegs [.r0, .r3, .r4, .r5, .r6]) - (fun _ _ h => Taint.agree_ofRegs (Inv.agree hpub h.1 h.2)) (c := fillPre) (by taint_decide)).wp - (F₁ := Mid s₀ c) (F₂ := Mid s₀' c) fun _ _ h => ⟨pre_ok hp h.1 hcl, pre_ok hp' h.2 hcl'⟩).mono - (fun _ _ h => h) fun _ _ h => h.2 - have hat : ∀ s, Mid s₀' c s → AtPre (st s₀) (scr s₀) s := fun s h => by - have := h.1; rwa [e0, e2] at this - have cmp : RelCT isa (fun s₁ s₂ => (Mid s₀ c s₁ ∧ Mid s₀' c s₂) ∧ isa.eval .eq s₁ = some true) - (.seq compressAt (.block [.mov .r4 (.imm 0)])) - fun s₁ s₂ => Inv s₀ (nextC s₀ c) s₁ ∧ Inv s₀' (nextC s₀ c) s₂ := by - have hz : ∀ s₁ s₂, (Mid s₀ c s₁ ∧ Mid s₀' c s₂) ∧ isa.eval .eq s₁ = some true → - isa.eval .eq s₂ = some true := fun s₁ s₂ ⟨⟨m₁, m₂⟩, h⟩ => by - have e₁ : isa.eval .eq s₁ = some (decide (rr s₀ c + tt s₀ c = 128)) := m₁.2.1 - have e₂ : isa.eval .eq s₂ = some (decide (rr s₀ c + tt s₀ c = 128)) := by rw [← ez]; exact m₂.2.1 - rw [e₂, ← e₁, h] - refine RelCT.seq (R := fun s₁ s₂ => WP isa (.block [.mov .r4 (.imm 0)]) s₁ (Inv s₀ (nextC s₀ c)) ∧ - WP isa (.block [.mov .r4 (.imm 0)]) s₂ (Inv s₀' (nextC s₀' c))) ?_ ?_ - · exact (((compressAt_rel hp.st_fit hp.scr_fit hp.st_scr).mono (fun _ _ h => ⟨h.1.1.1, hat _ h.1.2⟩) - fun _ _ h => h).wp - fun s₁ s₂ h => ⟨WP.seq_iff.mp (WP.ite_true h.1.1.2.2 h.2), - WP.seq_iff.mp (WP.ite_true h.1.2.2.2 (hz _ _ h))⟩).mono (fun _ _ h => h) fun _ _ h => h.2 - · refine ((RelCT.taint (A := taint) (Taint.ofRegs []) (fun _ _ _ => Taint.agree_ofRegs (by simp)) - (c := .block [.mov .r4 (.imm 0)]) (by taint_decide)).wp fun _ _ h => h).mono (fun _ _ h => h) - fun _ _ h => ⟨h.2.1, ?_⟩ - rw [← nextC_eq hpub]; exact h.2.2 - have fend : RelCT isa (fun s₁ s₂ => Mid s₀ c s₁ ∧ Mid s₀' c s₂) fillEnd - fun s₁ s₂ => Inv s₀ (nextC s₀ c) s₁ ∧ Inv s₀' (nextC s₀ c) s₂ := by - refine RelCT.ite (fun s₁ s₂ h => ?_) cmp (RelCT.block_nil fun s₁ s₂ ⟨⟨m₁, m₂⟩, hf⟩ => ?_) - · have e₁ : isa.eval .eq s₁ = some (decide (rr s₀ c + tt s₀ c = 128)) := h.1.2.1 - have e₂ : isa.eval .eq s₂ = some (decide (rr s₀ c + tt s₀ c = 128)) := by rw [← ez]; exact h.2.2.1 - rw [e₁, e₂] - · have e₁ : isa.eval .eq s₁ = some (decide (rr s₀ c + tt s₀ c = 128)) := m₁.2.1 - have e₂ : isa.eval .eq s₂ = some false := by - have : isa.eval .eq s₂ = some (decide (rr s₀ c + tt s₀ c = 128)) := by rw [← ez]; exact m₂.2.1 - rw [this, ← e₁, hf] - refine ⟨WP.block_nil_iff.mp (WP.ite_false m₁.2.2 hf), ?_⟩ - rw [← nextC_eq hpub]; exact WP.block_nil_iff.mp (WP.ite_false m₂.2.2 e₂) - rw [fill_eq] - exact RelCT.assoc (RelCT.assoc (RelCT.assoc (RelCT.assoc (pre.seq fend)))) - -theorem update_rel (h₀ : Proof.Sha512.updateArm.pre s₀) (h₀' : Proof.Sha512.updateArm.pre s₀') : - RelCT isa (fun s₁ s₂ => s₁ = s₀ ∧ s₂ = s₀') update fun _ _ => True := by - have pro : RelCT isa (fun s₁ s₂ => s₁ = s₀ ∧ s₂ = s₀') - (.block (([.ldrSp .r12 8] : List Instr) ++ save .r12 ++ prologue)) fun s₁ s₂ => - (Inv s₀ 0 s₁ ∧ s₁.z = decide (len s₀ = 0)) ∧ (Inv s₀' 0 s₂ ∧ s₂.z = decide (len s₀' = 0)) := - ((RelCT.taint (A := taint) τ₀ (fun _ _ ⟨e, e'⟩ => by rw [e, e']; exact agree₀ h₀ h₀' hpub) - (c := .block (([.ldrSp .r12 8] : List Instr) ++ save .r12 ++ prologue)) (by taint_decide)).wp - (F₁ := fun (s : State) => Inv s₀ 0 s ∧ s.z = decide (len s₀ = 0)) - (F₂ := fun (s : State) => Inv s₀' 0 s ∧ s.z = decide (len s₀' = 0)) - fun _ _ ⟨e, e'⟩ => by rw [e, e']; exact ⟨prologue_ok hp, prologue_ok hp'⟩).mono (fun _ _ h => h) - fun _ _ h => h.2 - have lp := RelCT.loop (M := isa) (body := updateBody) (c := .ne) - (Q := fun s₁ s₂ => Inv s₀ (len s₀) s₁ ∧ Inv s₀' (len s₀') s₂) - (fun n s₁ s₂ => ∃ c, n = len s₀ - c ∧ c < len s₀ ∧ Inv s₀ c s₁ ∧ Inv s₀' c s₂) (fun n => RelCT.exists_ fun c => by - by_cases hcn : c < len s₀ ∧ n = len s₀ - c - · obtain ⟨hcl, rfl⟩ := hcn - have hn := nextC_gt s₀ hcl - have tst : RelCT isa (fun s₁ s₂ => Inv s₀ (nextC s₀ c) s₁ ∧ Inv s₀' (nextC s₀ c) s₂) - (.block [.cmp .r6 (.imm 0)]) fun s₁ s₂ => - (Inv s₀ (nextC s₀ c) s₁ ∧ s₁.z = decide (len s₀ - nextC s₀ c = 0)) ∧ - (Inv s₀' (nextC s₀ c) s₂ ∧ s₂.z = decide (len s₀' - nextC s₀ c = 0)) := - ((RelCT.taint (A := taint) (Taint.ofRegs []) (fun _ _ _ => Taint.agree_ofRegs (by simp)) - (c := .block [.cmp .r6 (.imm 0)]) (by taint_decide)).wp - (F₁ := fun (s : State) => Inv s₀ (nextC s₀ c) s ∧ s.z = decide (len s₀ - nextC s₀ c = 0)) - (F₂ := fun (s : State) => Inv s₀' (nextC s₀ c) s ∧ s.z = decide (len s₀' - nextC s₀ c = 0)) - fun _ _ h => ⟨test_ok h.1, test_ok h.2⟩).mono (fun _ _ h => h) fun _ _ h => h.2 - refine ((fill_rel hp hp' hpub hcl).seq tst).mono (fun _ _ h => ⟨h.2.2.1, h.2.2.2⟩) fun s₁ s₂ h => ?_ - obtain ⟨⟨I₁, z₁⟩, ⟨I₂, z₂⟩⟩ := h - have hc' := I₁.c_le - have e₁ : isa.eval .ne s₁ = some (decide (len s₀ - nextC s₀ c ≠ 0)) := by - rw [show isa.eval .ne s₁ = some !s₁.z from rfl, z₁]; simp - have e₂ : isa.eval .ne s₂ = some (decide (len s₀ - nextC s₀ c ≠ 0)) := by - rw [show isa.eval .ne s₂ = some !s₂.z from rfl, z₂, ← len_eq hpub]; simp - refine ⟨e₁.trans e₂.symm, fun hf => ?_, fun ht => ⟨len s₀ - nextC s₀ c, by omega, nextC s₀ c, rfl, - ?_, I₁, I₂⟩⟩ - · have : len s₀ - nextC s₀ c = 0 := by - rw [e₁] at hf; simpa using hf - have e : nextC s₀ c = len s₀ := by omega - rw [e] at I₁ I₂; rw [← len_eq hpub]; exact ⟨I₁, I₂⟩ - · rw [e₁] at ht; simp at ht; omega - · exact RelCT.of_false fun _ _ h => hcn ⟨h.2.1, h.1⟩) (len s₀) - have ite : RelCT isa (fun s₁ s₂ => - (Inv s₀ 0 s₁ ∧ s₁.z = decide (len s₀ = 0)) ∧ (Inv s₀' 0 s₂ ∧ s₂.z = decide (len s₀' = 0))) - (.ite .eq (.block []) (.loop updateBody .ne)) - fun s₁ s₂ => Inv s₀ (len s₀) s₁ ∧ Inv s₀' (len s₀') s₂ := by - refine RelCT.ite (fun s₁ s₂ h => ?_) (RelCT.block_nil fun s₁ s₂ ⟨⟨⟨I₁, z₁⟩, ⟨I₂, _⟩⟩, ht⟩ => ?_) - (lp.mono (fun s₁ s₂ ⟨⟨⟨I₁, z₁⟩, ⟨I₂, _⟩⟩, hf⟩ => ⟨0, by omega, ?_, I₁, I₂⟩) fun _ _ h => h) - · rw [show isa.eval .eq s₁ = some s₁.z from rfl, show isa.eval .eq s₂ = some s₂.z from rfl, h.1.2, h.2.2, - len_eq hpub] - · have : len s₀ = 0 := by - rw [show isa.eval .eq s₁ = some s₁.z from rfl, z₁] at ht; simpa using ht - rw [← len_eq hpub, this]; exact ⟨I₁, I₂⟩ - · rw [show isa.eval .eq s₁ = some s₁.z from rfl, z₁] at hf; simp at hf; omega - have epi : RelCT isa (fun s₁ s₂ => Inv s₀ (len s₀) s₁ ∧ Inv s₀' (len s₀') s₂) (.block restore) - fun _ _ => True := - RelCT.taint (A := taint) (Taint.ofRegs [.r3]) (fun _ _ h => Taint.agree_ofRegs fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - rw [h.1.r3, h.2.r3]; exact hpub.2.2.2.2.2.2) (by taint_decide) - rw [update_eq] - exact pro.seq (ite.seq epi) - -end CT - -theorem update_verified : Verified Arm.target update Proof.Sha512.updateArm := by - refine ⟨fun s hs => ?_, ?_, ?_⟩ - · obtain ⟨t, s', he, h⟩ := correct (pre_of hs) - exact ⟨t, s', he, h⟩ - · intro s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ - exact (update_rel (pre_of h₁) (pre_of h₂) hpub h₁ h₂ _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 - · have e : ∀ k, stackArg sat k = 0 := fun k => by - simp [stackArg, sat, Mem.readW, Mem.read] - refine ⟨sat, ?_⟩ - simp only [Proof.Sha512.updateArm, e] - refine ⟨by simp [sat, stackArgAddr]; decide, rfl, ?_, ?_, ?_, ?_, ?_, by decide, by decide, by decide, - by decide⟩ <;> - exact Region.disjoint_of_sep (by decide) - -end VG.Proof.Sha512.Arm.Stream.Update diff --git a/lean/VerifiedGarbage/Proof/Sha512/X86/Stream/Update.lean b/lean/VerifiedGarbage/Proof/Sha512/X86/Stream/Update.lean index 01feee9b9..eed171f11 100644 --- a/lean/VerifiedGarbage/Proof/Sha512/X86/Stream/Update.lean +++ b/lean/VerifiedGarbage/Proof/Sha512/X86/Stream/Update.lean @@ -6,8 +6,7 @@ import VerifiedGarbage.Proof.Framework.X86.ArgTaint /-! # Streaming SHA-512 on x86 (32-bit): `update` -The structure of the ARMv7 proof (`VG.Proof.Sha512.Arm.Stream.Update`), with -`state` in `ebx`, `data` in `esi`, the bytes left in `ebp` and the buffered +With `state` in `ebx`, `data` in `esi`, the bytes left in `ebp` and the buffered bytes in `edi`; every block goes through the buffer, which is compressed as soon as it is full, by calling the compression function (`compressAt_ok`) with the 20 bytes below `esp` for its frame. From b98bdb1e0799588a181700f8ebdf615143bdfc24 Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 13:52:24 +0000 Subject: [PATCH 2/2] Regenerate src/asm/arm/sha512.rs Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_019oSrQeJdKT2MeBHirxaPKi --- src/asm/arm/sha512.rs | 138 +++++++++++++++++++++++++++++------------- 1 file changed, 96 insertions(+), 42 deletions(-) diff --git a/src/asm/arm/sha512.rs b/src/asm/arm/sha512.rs index e31590da6..6319b3cf2 100644 --- a/src/asm/arm/sha512.rs +++ b/src/asm/arm/sha512.rs @@ -9196,40 +9196,96 @@ pub(crate) unsafe extern "C" fn vg_sha512_update(state: *mut [u8; 192], count: u "cmp r6, #0", "beq 20f", "22:", + "mov r7, #0", + "cmp r4, #0", + "beq 23f", "mov r8, #128", "sub r8, r8, r4", "lsr r12, r6, #7", "cmp r12, #0", - "beq 23f", + "beq 25f", + "b 26f", + "25:", + "add r12, r6, r4", + "lsr r12, r12, #7", + "cmp r12, #0", + "beq 27f", + "b 28f", + "27:", + "mov r8, r6", + "28:", + "26:", + "sub r6, r6, r8", + "29:", + "ldrb r12, [r5, #0]", + "add r1, r0, r4", + "strb r12, [r1, #64]", + "add r5, r5, #1", + "add r4, r4, #1", + "subs r8, r8, #1", + "bne 29b", + "cmp r4, #128", + "beq 210f", + "b 211f", + "210:", + "add r1, r0, #64", + "mov r4, #0", + "mov r7, #1", + "211:", "b 24f", "23:", + "lsr r12, r6, #7", + "cmp r12, #0", + "beq 212f", + "mov r1, r5", + "lsr r7, r6, #7", + "lsl r12, r7, #7", + "add r5, r5, r12", + "sub r6, r6, r12", + "b 213f", + "212:", + "mov r8, #128", + "sub r8, r8, r4", + "lsr r12, r6, #7", + "cmp r12, #0", + "beq 214f", + "b 215f", + "214:", "add r12, r6, r4", "lsr r12, r12, #7", "cmp r12, #0", - "beq 25f", - "b 26f", - "25:", + "beq 216f", + "b 217f", + "216:", "mov r8, r6", - "26:", - "24:", + "217:", + "215:", "sub r6, r6, r8", - "27:", + "218:", "ldrb r12, [r5, #0]", "add r1, r0, r4", "strb r12, [r1, #64]", "add r5, r5, #1", "add r4, r4, #1", "subs r8, r8, #1", - "bne 27b", + "bne 218b", "cmp r4, #128", - "beq 28f", - "b 29f", - "28:", + "beq 219f", + "b 220f", + "219:", "add r1, r0, #64", - "mov r2, #1", - "bl {vg_sha512_compress}", "mov r4, #0", - "29:", + "mov r7, #1", + "220:", + "213:", + "24:", + "cmp r7, #0", + "beq 221f", + "mov r2, r7", + "bl {vg_sha512_compress}", + "b 222f", + "221:", + "222:", "cmp r6, #0", "bne 22b", "b 21f", @@ -9276,61 +9332,59 @@ pub(crate) unsafe extern "C" fn vg_sha512_finalize(state: *mut [u8; 192], count: "str r10, [r12, #248]", "str r11, [r12, #252]", "str lr, [r12, #256]", - "str r2, [r12, #260]", - "str r3, [r12, #264]", + "mov r4, r2", + "mov r5, r3", "mov r3, r12", "ldr r6, [sp, #0]", - "and r4, r2, #127", + "and r7, r4, #127", "mov r12, #128", - "add r1, r0, r4", + "add r1, r0, r7", "strb r12, [r1, #64]", - "add r4, r4, #1", - "add r5, r4, #15", - "lsr r5, r5, #7", + "add r7, r7, #1", + "add r8, r7, #15", + "lsr r8, r8, #7", "20:", "mov r9, #128", - "cmp r5, #0", + "cmp r8, #0", "beq 21f", "b 22f", "21:", "mov r9, #112", "22:", "mov r12, #0", - "subs r9, r9, r4", + "subs r9, r9, r7", "beq 23f", "25:", - "add r1, r0, r4", + "add r1, r0, r7", "strb r12, [r1, #64]", - "add r4, r4, #1", + "add r7, r7, #1", "subs r9, r9, #1", "bne 25b", "b 24f", "23:", "24:", - "cmp r5, #0", + "cmp r8, #0", "beq 26f", "b 27f", "26:", - "ldr r9, [r3, #260]", - "ldr r10, [r3, #264]", - "mov r11, #0", - "str r11, [r0, #176]", - "lsr r11, r10, #29", - "rev r11, r11", - "str r11, [r0, #180]", - "lsl r11, r10, #3", - "orr r11, r11, r9, lsr #29", - "rev r11, r11", - "str r11, [r0, #184]", - "lsl r11, r9, #3", - "rev r11, r11", - "str r11, [r0, #188]", + "mov r9, #0", + "str r9, [r0, #176]", + "lsr r9, r5, #29", + "rev r9, r9", + "str r9, [r0, #180]", + "lsl r9, r5, #3", + "orr r9, r9, r4, lsr #29", + "rev r9, r9", + "str r9, [r0, #184]", + "lsl r9, r4, #3", + "rev r9, r9", + "str r9, [r0, #188]", "27:", "add r1, r0, #64", "mov r2, #1", "bl {vg_sha512_compress}", - "mov r4, #0", - "subs r5, r5, #1", + "mov r7, #0", + "subs r8, r8, #1", "beq 20b", "ldr r9, [r0, #0]", "ldr r10, [r0, #4]",