admin/LithosAnanake
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

proof/: migrate cell from int to 64-bit signed word, full suite verifies

Browse Source 
cell_t is a 64-bit signed C long; the formal model previously used
unbounded HOL int, hiding wraparound and signed/unsigned distinctions
entirely. Switches cell to "64 word" throughout and fixes every proof
site that assumed int semantics:

- StarForth_Base.thy: cell_safe/cell_abs/cell_sdiv/cell_smod plus the
  sint-bridging lemmas used across the suite
- StarForth_Loop1_Heat.thy, StarForth_Loop3_Decay.thy: heat tracking
  converted to signed word comparisons (<s/\<le>s)
- StarForth_Stack_Words.thy: PICK/ROLL against real C ground truth
- StarForth_Arithmetic_Words.thy: ABS/MIN/MAX/div/mod rebuilt on signed
  word semantics (cell_sdiv/cell_smod match C99 truncating division;
  2/ uses signed_drop_bit to match "n >> 1"); documents a genuine
  ABS(INT64_MIN) wraparound hazard mirroring the real C behavior
- StarForth_Memory_Words.thy: @/!/C@/C! address checks converted to
  the signed order

All 23 theory files verify with zero errors, including
StarForth_Concurrent and StarForth_Correctness.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
Robert Allan James
2026-08-13 13:37:07 -04:00
co-authored by Claude Sonnet 5
parent 9b4bbc9de6
commit fe6e705867
6 changed files with 438 additions and 143 deletions
Download Patch File Download Diff File Expand all files Collapse all files
proof/StarForth_Memory_Words.thy
+52 -48
View File
@@ -53,27 +53,29 @@ definition forth_fetch :: "vm_state \<Rightarrow> vm_state" where
(case data_stack vm of
[] \<Rightarrow> set_error vm
| addr # xs \<Rightarrow>
if addr < 0
if addr <s 0
then set_error vm
else vm\<lparr>data_stack := mem_read (memory vm) (nat addr) # xs\<rparr>)"
else vm\<lparr>data_stack := mem_read (memory vm) (unat addr) # xs\<rparr>)"
lemma fetch_normal:
assumes "data_stack vm = addr # xs"
assumes "addr \<ge> 0"
shows "data_stack (forth_fetch vm) = mem_read (memory vm) (nat addr) # xs"
using assms by (auto simp: forth_fetch_def)
assumes "0 \<le>s addr"
shows "data_stack (forth_fetch vm) = mem_read (memory vm) (unat addr) # xs"
using assms by (auto simp: forth_fetch_def word_sle_eq word_sless_alt)
lemma fetch_reads_stored_value:
assumes "memory vm = mem_write m a v"
assumes "data_stack vm = int a # xs"
assumes "data_stack vm = addr # xs"
assumes "0 \<le>s addr"
assumes "unat addr = a"
shows "hd (data_stack (forth_fetch vm)) = v"
by (simp add: forth_fetch_def mem_read_def mem_write_def assms)
using assms by (simp add: forth_fetch_def mem_read_def mem_write_def word_sle_eq word_sless_alt)
lemma fetch_depth_preserved:
assumes "data_stack vm = addr # xs"
assumes "addr \<ge> 0"
assumes "0 \<le>s addr"
shows "length (data_stack (forth_fetch vm)) = length (data_stack vm)"
by (simp add: forth_fetch_def assms)
by (simp add: forth_fetch_def assms word_sle_eq word_sless_alt)
lemma fetch_underflow:
assumes "data_stack vm = []"
@@ -82,7 +84,7 @@ lemma fetch_underflow:
lemma fetch_neg_addr:
assumes "data_stack vm = addr # xs"
assumes "addr < 0"
assumes "addr <s 0"
shows "vm_error (forth_fetch vm)"
by (simp add: forth_fetch_def set_error_def assms)
@@ -94,37 +96,37 @@ definition forth_store :: "vm_state \<Rightarrow> vm_state" where
"forth_store vm =
(case data_stack vm of
addr # n # xs \<Rightarrow>
if addr < 0
if addr <s 0
then set_error vm
else vm\<lparr>data_stack := xs,
memory := mem_write (memory vm) (nat addr) n\<rparr>
memory := mem_write (memory vm) (unat addr) n\<rparr>
| _ \<Rightarrow> set_error vm)"
lemma store_normal:
assumes "data_stack vm = addr # n # xs"
assumes "addr \<ge> 0"
assumes "0 \<le>s addr"
shows "data_stack (forth_store vm) = xs"
and "memory (forth_store vm) = mem_write (memory vm) (nat addr) n"
using assms by (auto simp: forth_store_def)
and "memory (forth_store vm) = mem_write (memory vm) (unat addr) n"
using assms by (auto simp: forth_store_def word_sle_eq word_sless_alt)
lemma store_writes_value:
assumes "data_stack vm = addr # n # xs"
assumes "addr \<ge> 0"
shows "mem_read (memory (forth_store vm)) (nat addr) = n"
using assms by (auto simp: forth_store_def mem_write_def mem_read_def)
assumes "0 \<le>s addr"
shows "mem_read (memory (forth_store vm)) (unat addr) = n"
using assms by (auto simp: forth_store_def mem_write_def mem_read_def word_sle_eq word_sless_alt)
lemma store_depth_decreases:
assumes "data_stack vm = addr # n # xs"
assumes "addr \<ge> 0"
assumes "0 \<le>s addr"
shows "length (data_stack (forth_store vm)) = length (data_stack vm) - 2"
using assms by (auto simp: forth_store_def)
using assms by (auto simp: forth_store_def word_sle_eq word_sless_alt)
lemma store_other_unchanged:
assumes "data_stack vm = addr # n # xs"
assumes "addr \<ge> 0"
assumes "nat addr \<noteq> b"
assumes "0 \<le>s addr"
assumes "unat addr \<noteq> b"
shows "mem_read (memory (forth_store vm)) b = mem_read (memory vm) b"
using assms by (auto simp: forth_store_def mem_write_def mem_read_def)
using assms by (auto simp: forth_store_def mem_write_def mem_read_def word_sle_eq word_sless_alt)
lemma store_underflow_nil:
assumes "data_stack vm = []"
@@ -138,7 +140,7 @@ lemma store_underflow_one:
lemma store_neg_addr:
assumes "data_stack vm = addr # n # xs"
assumes "addr < 0"
assumes "addr <s 0"
shows "vm_error (forth_store vm)"
by (simp add: forth_store_def set_error_def assms)
@@ -146,12 +148,12 @@ lemma store_neg_addr:
lemma store_then_fetch:
assumes "data_stack vm = addr # n # xs"
assumes "addr \<ge> 0"
assumes "0 \<le>s addr"
assumes "data_stack vm' = addr # xs"
assumes "memory vm' = memory (forth_store vm)"
assumes "addr \<ge> 0"
shows "hd (data_stack (forth_fetch vm')) = n"
using assms by (auto simp: forth_fetch_def forth_store_def mem_write_def mem_read_def)
using assms by (auto simp: forth_fetch_def forth_store_def mem_write_def mem_read_def
word_sle_eq word_sless_alt)
(* ── C@ ( addr -- c ) ──────────────────────────────────────────────────── *)
(* Reads a single byte (0..255) from memory, zero-extended to cell width.
@@ -163,24 +165,25 @@ definition forth_cfetch :: "vm_state \<Rightarrow> vm_state" where
(case data_stack vm of
[] \<Rightarrow> set_error vm
| addr # xs \<Rightarrow>
if addr < 0
if addr <s 0
then set_error vm
else let byte = mem_read (memory vm) (nat addr) AND 0xFF
else let byte = mem_read (memory vm) (unat addr) AND 0xFF
in vm\<lparr>data_stack := byte # xs\<rparr>)"
lemma cfetch_normal:
assumes "data_stack vm = addr # xs"
assumes "addr \<ge> 0"
assumes "0 \<le>s addr"
shows "data_stack (forth_cfetch vm) =
(mem_read (memory vm) (nat addr) AND 0xFF) # xs"
using assms by (auto simp: forth_cfetch_def)
(mem_read (memory vm) (unat addr) AND 0xFF) # xs"
using assms by (auto simp: forth_cfetch_def word_sle_eq word_sless_alt)
lemma cfetch_byte_range:
assumes "data_stack vm = addr # xs"
assumes "addr \<ge> 0"
assumes "0 \<le>s addr"
shows "0 \<le> hd (data_stack (forth_cfetch vm))"
and "hd (data_stack (forth_cfetch vm)) \<le> 255"
using assms by (auto simp: forth_cfetch_def)
using assms word_and_le1[of "mem_read (memory vm) (unat addr)" "0xFF::cell"]
by (auto simp: forth_cfetch_def word_sle_eq word_sless_alt)
lemma cfetch_underflow:
assumes "data_stack vm = []"
@@ -189,7 +192,7 @@ lemma cfetch_underflow:
lemma cfetch_neg_addr:
assumes "data_stack vm = addr # xs"
assumes "addr < 0"
assumes "addr <s 0"
shows "vm_error (forth_cfetch vm)"
by (simp add: forth_cfetch_def set_error_def assms)
@@ -201,30 +204,30 @@ definition forth_cstore :: "vm_state \<Rightarrow> vm_state" where
"forth_cstore vm =
(case data_stack vm of
addr # c # xs \<Rightarrow>
if addr < 0
if addr <s 0
then set_error vm
else vm\<lparr>data_stack := xs,
memory := mem_write (memory vm) (nat addr) (c AND 0xFF)\<rparr>
memory := mem_write (memory vm) (unat addr) (c AND 0xFF)\<rparr>
| _ \<Rightarrow> set_error vm)"
lemma cstore_normal:
assumes "data_stack vm = addr # c # xs"
assumes "addr \<ge> 0"
assumes "0 \<le>s addr"
shows "data_stack (forth_cstore vm) = xs"
and "memory (forth_cstore vm) = mem_write (memory vm) (nat addr) (c AND 0xFF)"
using assms by (auto simp: forth_cstore_def)
and "memory (forth_cstore vm) = mem_write (memory vm) (unat addr) (c AND 0xFF)"
using assms by (auto simp: forth_cstore_def word_sle_eq word_sless_alt)
lemma cstore_writes_byte:
assumes "data_stack vm = addr # c # xs"
assumes "addr \<ge> 0"
shows "mem_read (memory (forth_cstore vm)) (nat addr) = c AND 0xFF"
using assms by (auto simp: forth_cstore_def mem_write_def mem_read_def)
assumes "0 \<le>s addr"
shows "mem_read (memory (forth_cstore vm)) (unat addr) = c AND 0xFF"
using assms by (auto simp: forth_cstore_def mem_write_def mem_read_def word_sle_eq word_sless_alt)
lemma cstore_depth_decreases:
assumes "data_stack vm = addr # c # xs"
assumes "addr \<ge> 0"
assumes "0 \<le>s addr"
shows "length (data_stack (forth_cstore vm)) = length (data_stack vm) - 2"
using assms by (auto simp: forth_cstore_def)
using assms by (auto simp: forth_cstore_def word_sle_eq word_sless_alt)
lemma cstore_underflow_nil:
assumes "data_stack vm = []"
@@ -238,17 +241,18 @@ lemma cstore_underflow_one:
lemma cstore_neg_addr:
assumes "data_stack vm = addr # c # xs"
assumes "addr < 0"
assumes "addr <s 0"
shows "vm_error (forth_cstore vm)"
by (simp add: forth_cstore_def set_error_def assms)
(* C! then C@ round-trip: byte written is byte read back. *)
lemma cstore_then_cfetch:
assumes "data_stack vm = addr # c # xs"
assumes "addr \<ge> 0"
assumes "0 \<le>s addr"
assumes "data_stack vm' = addr # xs"
assumes "memory vm' = memory (forth_cstore vm)"
shows "hd (data_stack (forth_cfetch vm')) = c AND 0xFF"
using assms by (auto simp: forth_cfetch_def forth_cstore_def mem_write_def mem_read_def)
using assms by (auto simp: forth_cfetch_def forth_cstore_def mem_write_def mem_read_def
word_sle_eq word_sless_alt)
end