From 1152932547aac4169c645a9cc894bd1783fb22ae Mon Sep 17 00:00:00 2001
From: Felipe Lisboa <lisboafelipe5@gmail.com>
Date: Tue, 13 Feb 2024 16:23:59 +0100
Subject: [PATCH] Cleanning CavaDRAM code, added silveroak recompiled to
sub-module list
---
.gitmodules | 3 +
framework/CavaDRAM/CavaFIFO/CavaFIFO.v | 333 ----
.../CavaDRAM/CavaFIFO/CavaFIFOProperties.v | 1654 -----------------
framework/CavaDRAM/CavaFIFOREF/CavaFIFOREF.v | 376 ----
.../CavaFIFOREF/CavaFIFOREFProperties.v | 1630 ----------------
.../CavaFIFOREF/CavaFIFOREFProperties2.v | 311 ----
framework/CavaDRAM/CavaTDM/CavaTDMREF.v | 527 ------
.../CavaDRAM/CavaTDM/CavaTDMREFProperties.v | 111 --
framework/CavaDRAM/Core/CavaCommonInstances.v | 4 +-
framework/CavaDRAM/Core/CavaCounter.v | 47 -
.../CavaDRAM/Core/CavaCounterProperties.v | 201 --
framework/CavaDRAM/Core/CavaDemux.v | 69 -
framework/CavaDRAM/Core/CavaMemory.v | 66 -
framework/CavaDRAM/Core/CavaReqQueue.v | 7 +-
framework/CavaDRAM/Core/CavaSM.v | 51 -
framework/CavaDRAM/Core/CavaSMExtraction.v | 25 -
framework/CavaDRAM/Core/CavaSMProperties.v | 666 -------
framework/CavaDRAM/Core/CavaSMProperties2.v | 843 ---------
framework/CavaDRAM/Core/CavaSM_.v | 115 --
framework/CavaDRAM/Core/CavaSMbackup.v | 424 -----
framework/CavaDRAM/Core/CavaSubtractor.v | 117 --
.../CavaDRAM/Core/CavaSubtractorProperties.v | 72 -
framework/CavaDRAM/Core/CavaSystem.v | 3 +-
framework/CavaDRAM/Core/Memory.v | 296 ---
framework/CavaDRAM/Lib/CavaTactics.v | 26 -
framework/CavaDRAM/Lib/CavaUtil.v | 59 -
framework/CavaDRAM/Lib/Step.v | 16 +-
framework/CavaDRAM/Lib/Util.v | 32 +-
framework/CavaDRAM/Lib/backup.v | 1256 -------------
framework/CavaDRAM/_CoqProject | 20 +-
.../gencode/fifo_gencode/CavaFIFOSV.hs | 14 -
.../CavaDRAM/gencode/fifo_gencode/cava2sv.sh | 12 -
.../CavaDRAM/gencode/tdm_gencode/CavaTDMSV.hs | 14 -
.../CavaDRAM/gencode/tdm_gencode/cava2sv.sh | 12 -
framework/DRAM/Core/ImplementationInterface.v | 36 +-
.../DRAM/Implementations/TS/FIFOREF/FIFOREF.v | 44 +-
framework/DRAM/_CoqProject | 1 +
37 files changed, 91 insertions(+), 9402 deletions(-)
delete mode 100644 framework/CavaDRAM/CavaFIFO/CavaFIFO.v
delete mode 100644 framework/CavaDRAM/CavaFIFO/CavaFIFOProperties.v
delete mode 100644 framework/CavaDRAM/CavaFIFOREF/CavaFIFOREF.v
delete mode 100644 framework/CavaDRAM/CavaFIFOREF/CavaFIFOREFProperties.v
delete mode 100644 framework/CavaDRAM/CavaFIFOREF/CavaFIFOREFProperties2.v
delete mode 100644 framework/CavaDRAM/CavaTDM/CavaTDMREF.v
delete mode 100644 framework/CavaDRAM/CavaTDM/CavaTDMREFProperties.v
delete mode 100644 framework/CavaDRAM/Core/CavaCounter.v
delete mode 100644 framework/CavaDRAM/Core/CavaCounterProperties.v
delete mode 100644 framework/CavaDRAM/Core/CavaDemux.v
delete mode 100644 framework/CavaDRAM/Core/CavaMemory.v
delete mode 100644 framework/CavaDRAM/Core/CavaSM.v
delete mode 100644 framework/CavaDRAM/Core/CavaSMExtraction.v
delete mode 100644 framework/CavaDRAM/Core/CavaSMProperties.v
delete mode 100644 framework/CavaDRAM/Core/CavaSMProperties2.v
delete mode 100644 framework/CavaDRAM/Core/CavaSM_.v
delete mode 100644 framework/CavaDRAM/Core/CavaSMbackup.v
delete mode 100644 framework/CavaDRAM/Core/CavaSubtractor.v
delete mode 100644 framework/CavaDRAM/Core/CavaSubtractorProperties.v
delete mode 100644 framework/CavaDRAM/Core/Memory.v
delete mode 100644 framework/CavaDRAM/Lib/CavaTactics.v
delete mode 100644 framework/CavaDRAM/Lib/CavaUtil.v
delete mode 100644 framework/CavaDRAM/Lib/backup.v
delete mode 100644 framework/CavaDRAM/gencode/fifo_gencode/CavaFIFOSV.hs
delete mode 100755 framework/CavaDRAM/gencode/fifo_gencode/cava2sv.sh
delete mode 100644 framework/CavaDRAM/gencode/tdm_gencode/CavaTDMSV.hs
delete mode 100755 framework/CavaDRAM/gencode/tdm_gencode/cava2sv.sh
diff --git a/.gitmodules b/.gitmodules
index 850692d..56e6bd4 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -4,3 +4,6 @@
[submodule "mcsimcoq"]
path = mcsimcoq
url = git@gitlab.enst.fr:sdram20/mcsimcoq.git
+[submodule "silveroak"]
+ path = silveroak
+ url = git@gitlab.enst.fr:sdram/silveroak_dram.git
diff --git a/framework/CavaDRAM/CavaFIFO/CavaFIFO.v b/framework/CavaDRAM/CavaFIFO/CavaFIFO.v
deleted file mode 100644
index af6dd3b..0000000
--- a/framework/CavaDRAM/CavaFIFO/CavaFIFO.v
+++ /dev/null
@@ -1,333 +0,0 @@
-From Cava Require Export Cava.
-From Cava Require Export CavaProperties.
-
-Export Circuit.Notations.
-
-Require Export Coq.Vectors.Fin.
-Require Export Coq.Bool.Bool.
-Require Export Coq.Program.Basics.
-
-From CavaDRAM Require Export CavaSystem.
-(* From CavaDRAM Require Export CavaUtil. *)
-From CavaDRAM Require Export CavaMemory.
-From CavaDRAM Require Export CavaSubtractor.
-
-From CoqDRAM Require Export FIFO.
-
-Infix "++" := Vector.append.
-
-Section CavaFIFO.
-
- Context {CAVA_SYS : CavaSystem}.
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
-
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
-
- Definition COUNTER_WIDTH := Nat.log2 WAIT.
- Definition REQUEST_WIDTH := FE_CMD_WIDTH + FE_ADDR_WIDTH + FE_ID_WIDTH.
- Definition ADDR_WIDTH := Nat.log2 QUEUE_MAX_SIZE.
- Definition QUEUE_WIDTH := QUEUE_MAX_SIZE * REQUEST_WIDTH.
- Definition STATE_VEC_WIDTH := 2 * ADDR_WIDTH + QUEUE_WIDTH.
-
- Definition NOP := Vec.bitvec_literal (N2Bv_sized DRAM_CMD_WIDTH 0).
- Definition null_req := Vec.bitvec_literal (N2Bv_sized REQUEST_WIDTH 0).
- Definition cnt_nil := Vec.bitvec_literal (N2Bv_sized COUNTER_WIDTH 0).
-
- Definition fifo_memory :=
- memory_dp (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (QUEUE_MAX_SIZE - 1).
-
- Definition FullVEC := Vec.bitvec_literal (N2Bv_sized ADDR_WIDTH (N.of_nat QUEUE_MAX_SIZE - 1)).
- Definition EmptyVec := Vec.bitvec_literal (N2Bv_sized ADDR_WIDTH 0).
-
- (* Compares a bit vector passed as argument with FullVEC *)
- Definition EqFULL
- : Circuit (signal (Vec Bit ADDR_WIDTH)) (signal Bit)
- := Comb (fun '(input) => CavaPrelude.eqb (input,FullVEC)).
-
- Definition NotZero (input : signal (Vec Bit ADDR_WIDTH))
- : cava (signal Bit) :=
- eq <- CavaPrelude.eqb (input,EmptyVec) ;;
- inv eq.
-
- (* write address, read address -> full *)
- Definition FullLogic
- : Circuit (signal (Vec Bit ADDR_WIDTH) * signal (Vec Bit ADDR_WIDTH)) (signal Bit)
- := Subtractor >==> Comb (dropr) >==> EqFULL.
-
- (* if (w@ - 1) - r@ = FullVEC then fifo is full *)
- Definition FullLogicAlt
- : Circuit (signal (Vec Bit ADDR_WIDTH) * signal (Vec Bit ADDR_WIDTH)) (signal Bit)
- := Comb (fun '(wa,ra) =>
- wa_eq_zero <- CavaPrelude.eqb (wa,EmptyVec) ;;
- wa_minus_1 <- subtractor (wa,Vec.bitvec_literal(N2Bv_sized ADDR_WIDTH 1)) ;;
- wa_out <- mux2 wa_eq_zero (fst(wa_minus_1),EmptyVec) ;;
- wa_minus_ra <- subtractor (wa_out,ra) ;;
- CavaPrelude.eqb (fst(wa_minus_ra),FullVEC)
- ).
-
- Definition EmptyLogic
- : Circuit (signal (Vec Bit ADDR_WIDTH) * signal (Vec Bit ADDR_WIDTH)) (signal Bit)
- := Comb (CavaPrelude.eqb).
-
- Definition FullEmptyLogic
- : Circuit (signal (Vec Bit ADDR_WIDTH) * signal (Vec Bit ADDR_WIDTH)) (signal Bit * signal Bit)
- := Comb (fun '(a,b) => ret((a,b),(a,b)))
- >==> First (FullLogic)
- >==> Second (EmptyLogic).
-
- Definition incr_pointr
- : Circuit (signal (Vec Bit ADDR_WIDTH) * signal Bit) (signal (Vec Bit ADDR_WIDTH))
- := Comb (fun '(ptr,en) =>
- ptr_p1 <- incrN ptr ;;
- mux2 en (ptr,ptr_p1)
- ).
-
- (* rewrite and test CavaFIFOqueue -> is data_o ok ? *)
- Definition CavaFifoQueue_t
- : Circuit ((signal Bit) * (* push_i *)
- (signal (Vec Bit REQUEST_WIDTH)) * (* data_i *)
- (signal Bit)) (* pop_i *)
- ((signal Bit) * (* full_o *)
- (signal (Vec Bit REQUEST_WIDTH)) * (* data_o *)
- (signal Bit)) (* empty_o *)
- := let state_init : combType (Vec Bit (ADDR_WIDTH + ADDR_WIDTH))
- := (Vector.const zero (ADDR_WIDTH + ADDR_WIDTH)) in
- LoopInit state_init (
- Second (Comb (fun '(state) =>
- (* separes the two pointers;*)
- stateV <- unpackV (state) ;;
- wr_ad <- packV (slice_default zero stateV 0 ADDR_WIDTH) ;;
- rd_ad <- packV (slice_default zero stateV ADDR_WIDTH ADDR_WIDTH) ;;
- (* assignment of full_o & empty_o *)
- ret (wr_ad,rd_ad)) >==> Comb (fork2) >==> Second (FullEmptyLogic))
- >==> Comb (fun '(push_i, data_i, pop_i, ((wr_ad,rd_ad),(full_o,empty_o))) =>
- (* logic for write enable *)
- n_full <- inv full_o ;;
- wr_en <- and2 (push_i,n_full) ;;
- (* logic for read enable *)
- n_empt <- inv empty_o ;;
- rd_en <- and2 (pop_i,n_empt) ;;
- (* duplicate rd@ : first one will be incremented and second one to access the memory *)
- ret (full_o,data_i,empty_o,wr_ad,wr_en,rd_ad,rd_en,rd_ad))
- >==> Comb (fun '(full_o,data_i,empty_o,wr_ad,w_en,r_ad,rd_en,rd_ad) =>
- (* logic for read address going into the memory : not the most elegant solution for now: *)
- (* a better solution would be to make a memory with read enable *)
- (* if (rd_en = 0 && rd@ != 0) -> read from rd@ - 1 *)
- (* else read from rd@ *)
- rd_diff_0 <- NotZero rd_ad ;;
- n_r_en <- inv rd_en ;;
- sel_rd_ad <- and2 (rd_diff_0,n_r_en) ;;
- sub_result <- subtractor(rd_ad,Vec.bitvec_literal (N2Bv_sized ADDR_WIDTH 1)) ;;
- n_rd_ad <- mux2 sel_rd_ad (rd_ad,fst(sub_result)) ;;
- ret (full_o,empty_o,wr_ad,w_en,rd_ad,rd_en,(data_i,wr_ad,n_rd_ad,w_en)))
- (* memory access *)
- >==> Second(fifo_memory)
- (* re-organizes *)
- >==> Comb (fun '(full_o, empty_o, wr_ad, w_en, r_ad,r_en, data_o) =>
- ret (full_o,data_o,empty_o,((wr_ad,w_en),(r_ad,r_en))))
- (* increment pointers *)
- >==> Second (First (incr_pointr) >==> Second (incr_pointr) >==>
- Comb (fun '(n_wr_ad,n_rd_ad) =>
- wrV <- unpackV n_wr_ad ;;
- rdV <- unpackV n_rd_ad ;;
- packV (Vector.append wrV rdV)))
- ).
-
- (* different full logics *)
- Definition CavaFifoQueue_t_alt
- : Circuit
- ( signal Bit
- * signal (Vec Bit REQUEST_WIDTH)
- * signal Bit)
- ( signal Bit
- * signal (Vec Bit REQUEST_WIDTH)
- * signal Bit) :=
- Loop ( (* push_i,data_i,pop_i,wr_ad *)
- Loop ( (* push_i, data_i, pop_i, wr_ad,rd_adr *)
- Comb (fun '(push_i,data_i,pop_i,wr_ad,rd_ad) => ret (push_i,data_i,pop_i,(wr_ad,rd_ad)))
- >==> Second (Comb fork2 >==> (Second FullEmptyLogic))
- >==> Comb (fun '(push_i, data_i, pop_i, ((wr_ad, rd_ad), (full_o, empty_o))) =>
- n_full <- inv full_o ;;
- n_empt <- inv empty_o ;;
- wr_en <- and2 (push_i,n_full) ;;
- rd_en <- and2 (pop_i,n_empt) ;;
- ret (full_o,data_i,empty_o,wr_ad,wr_en,rd_ad,rd_en,rd_ad))
- >==> Comb (fun '(full_o,data_i,empty_o,wr_ad,w_en,r_ad,rd_en,rd_ad) =>
- rd_diff_0 <- NotZero rd_ad ;;
- n_r_en <- inv rd_en ;;
- sel_rd_ad <- and2 (rd_diff_0,n_r_en) ;;
- sub_result <- subtractor(rd_ad,Vec.bitvec_literal (N2Bv_sized ADDR_WIDTH 1)) ;;
- (* if (rd@ != 0 && !r_en) then rd@' := rd_ad - 1 else rd_ad *)
- n_rd_ad <- mux2 sel_rd_ad (rd_ad,fst(sub_result)) ;;
- ret (full_o,empty_o,wr_ad,w_en,rd_ad,rd_en,(data_i,wr_ad,n_rd_ad,w_en)))
- >==> Second(fifo_memory)
- >==> Comb (fun '(full_o, empty_o, wr_ad, w_en, r_ad,r_en, data_o) =>
- ret (full_o,data_o,empty_o,((wr_ad,w_en),(r_ad,r_en))))
- >==> Second (First (incr_pointr) >==> Second (incr_pointr))
- >==> Comb (fun '(full_o,data_o,empty_o,(n_wr_ad,n_rd_ad)) =>
- ret (full_o,data_o,empty_o,n_wr_ad,n_rd_ad))
- )
- ).
-
- Definition CavaFifoQueue_t_NF (* this is the right one *)
- : Circuit
- ( signal Bit
- * signal (Vec Bit REQUEST_WIDTH)
- * signal Bit)
- ( signal Bit
- * signal (Vec Bit REQUEST_WIDTH)
- * signal Bit) :=
- Loop ( (* push_i,data_i,pop_i,wr_ad *)
- Loop ( (* push_i, data_i, pop_i, wr_ad,rd_adr *)
- Comb (fun '(push_i,data_i,pop_i,wr_ad,rd_ad) => ret (push_i,data_i,pop_i,(wr_ad,rd_ad)))
- >==> Second (Comb fork2 >==> (Second FullEmptyLogic))
- >==> Comb (fun '(push_i, data_i, pop_i, ((wr_ad, rd_ad), (full_o, empty_o))) =>
- n_full <- inv full_o ;;
- n_empt <- inv empty_o ;;
- wr_en <- and2 (push_i,n_full) ;;
- rd_en <- and2 (pop_i,n_empt) ;;
- ret (full_o,data_i,empty_o,wr_ad,wr_en,rd_ad,rd_en,rd_ad))
- >==> Comb (fun '(full_o,data_i,empty_o,wr_ad,w_en,r_ad,rd_en,rd_ad) =>
- rd_diff_0 <- NotZero rd_ad ;;
- n_r_en <- inv rd_en ;;
- sel_rd_ad <- and2 (rd_diff_0,n_r_en) ;;
- sub_result <- subtractor(rd_ad,Vec.bitvec_literal (N2Bv_sized ADDR_WIDTH 1)) ;;
- (* if (rd@ != 0 && !r_en) then rd@' := rd_ad - 1 else rd_ad *)
- n_rd_ad <- mux2 sel_rd_ad (rd_ad,fst(sub_result)) ;;
- ret (full_o,empty_o,wr_ad,w_en,rd_ad,rd_en,(data_i,wr_ad,n_rd_ad,w_en)))
- >==> Second(fifo_memory)
- >==> Comb (fun '(full_o, empty_o, wr_ad, w_en, r_ad,r_en, data_o) =>
- ret (full_o,data_o,empty_o,((wr_ad,w_en),(r_ad,r_en))))
- >==> Second (First (incr_pointr) >==> Second (incr_pointr))
- >==> Second (Comb(fork2) >==> First(FullEmptyLogic))
- (* the empty signal is purposely delayed *)
- >==> Comb (fun '(full_o,data_o,empty_o,(n_full_o, n_empty_o,(n_wr_ad,n_rd_ad))) =>
- ret (n_full_o,data_o,empty_o,n_wr_ad,n_rd_ad))
- )
- ).
-
- Definition CavaFifoQueue_t_NF_RD (* this is the right one *)
- : Circuit
- ( signal Bit
- * signal (Vec Bit REQUEST_WIDTH)
- * signal Bit)
- ( signal Bit
- * signal (Vec Bit REQUEST_WIDTH)
- * signal Bit) :=
- Loop ( (* push_i,data_i,pop_i,wr_ad *)
- Loop ( (* push_i, data_i, pop_i, wr_ad,rd_zadr *)
- Comb (fun '(push_i,data_i,pop_i,wr_ad,rd_ad) => ret (push_i,data_i,pop_i,(wr_ad,rd_ad)))
- >==> Second (Comb fork2 >==> (Second FullEmptyLogic))
- >==> Comb (fun '(push_i, data_i, pop_i, ((wr_ad, rd_ad), (full_o, empty_o))) =>
- n_full <- inv full_o ;;
- n_empt <- inv empty_o ;;
- wr_en <- and2 (push_i,n_full) ;;
- rd_en <- and2 (pop_i,n_empt) ;;
- ret (full_o,empty_o,wr_ad,wr_en,rd_ad,rd_en,(data_i,wr_ad,rd_ad,wr_en)))
- >==> Second (fifo_memory)
- >==> Comb (fun '(full_o, empty_o,wr_ad,w_en,r_ad,r_en,data_o) =>
- ret (full_o,data_o,empty_o,((wr_ad,w_en),(r_ad,r_en))))
- >==> Second (First (incr_pointr) >==> Second (incr_pointr))
- >==> Second (Comb(fork2) >==> First(FullEmptyLogic))
- (* the empty signal is purposely delayed *)
- >==> Comb (fun '(full_o,data_o,empty_o,(n_full_o, n_empty_o,(n_wr_ad,n_rd_ad))) =>
- ret (n_full_o,data_o,empty_o,n_wr_ad,n_rd_ad))
- )
- ).
-
-End CavaFIFO.
-
-Section CodeGeneration.
-
- Existing Instance CavaCombinationalNet.
-
- Program Instance CAVA_SYS : CavaSystem := {
- FE_CMD_WIDTH := 2;
- FE_ADDR_WIDTH := 2;
- FE_ID_WIDTH := 2;
- ROW_ADDR_WIDTH := 1;
- BANK_ADDR_WIDTH := 1;
- DRAM_BUS_WIDTH := 1;
- DRAM_BANKS := 1;
- DRAM_CMD_WIDTH := 2;
- BL := 4;
- CLK_RATIO := 2;
- QUEUE_MAX_SIZE := 16;
- MEM_ADDR_WIDTH := 4;
- (* WAIT := 8;
- T_RP := 2;
- T_RCD := 2; *)
- }.
-
- Definition FIFO_out := (bool * Vector.t bool REQUEST_WIDTH * bool)%type.
-
- Definition cmd2string (cmd : Vector.t bool DRAM_CMD_WIDTH) : string :=
- if (Vector.eqb bool eqb cmd [true;false]) then "ACT"
- else if (Vector.eqb bool eqb cmd [true;true]) then "PRE"
- else if (Vector.eqb bool eqb cmd [false;true]) then "CAS"
- else "NOP".
-
- Definition tuple2string (e : FIFO_out) : (string * N * string) :=
- let '(full,req,empty) := e in
- let full_str := if full then "FULL" else "NOT FULL" in
- let empty_str := if empty then "EMPTY" else "NOT EMPTY" in
- let req_N := Bv2N req in (full_str,req_N,empty_str).
-
- Definition map_FIFO_out (input : seq FIFO_out)
- := map (tuple2string) input.
-
- Compute simulate FullLogic [(N2Bv_sized ADDR_WIDTH 0,N2Bv_sized ADDR_WIDTH 0)].
-
- Compute (map_FIFO_out (simulate CavaFifoQueue_t_NF_RD [
- (true, N2Bv_sized REQUEST_WIDTH 1, false);
- (true, N2Bv_sized REQUEST_WIDTH 2, false);
- (true, N2Bv_sized REQUEST_WIDTH 3, true)
- (* (false,N2Bv_sized REQUEST_WIDTH 0, true); *)
- (* (true, N2Bv_sized REQUEST_WIDTH 3, false) *)
- (* (true, N2Bv_sized REQUEST_WIDTH 2, false); *)
- (* (true, N2Bv_sized REQUEST_WIDTH 3, false) *)
- ])).
-
- Compute (map_FIFO_out (simulate CavaFifoQueue_t_NF_RD [
- (true, N2Bv_sized REQUEST_WIDTH 1, false);
- (* write 1 @ 0 -> n_ w@ : 1. reads nothing, r@ : 0 (empty queue) *)
-
- (true, N2Bv_sized REQUEST_WIDTH 2, true);
- (* write 2 @ 1 -> n_w@ : 2 , reads 1 (r@ = 0), n_r@ : 1 *)
-
- (true, N2Bv_sized REQUEST_WIDTH 3, false);
- (* write 3 @ 2 -> n_w@ : 3 , reads 1 (r@ - 1 = 0), n_r@ : 1 *)
-
- (true, N2Bv_sized REQUEST_WIDTH 4, true)
- (* write 4 @ 3 -> n_w@ : 0 , reads 2 (r@ = 1), n_r@ : 2 *)
-
- (* (true, N2Bv_sized REQUEST_WIDTH 5, false); *)
- (* write 5 @ 0 -> n_w@ : 1 , reads 2 (r@ - 1 = 1), n_r@ : 2 *)
-
- (* (true, N2Bv_sized REQUEST_WIDTH 6, false); *)
- (* R6 fails -> n_w@ : 1 , reads 2 (r@ - 1 = 1), n_r@ : 2 *)
-
- (* (true, N2Bv_sized REQUEST_WIDTH 6, true); *)
- (* R6 fails -> n_w@ : 1 , reads 3 (r@ = 1), n_r@ : 3 *)
-
- (* (true, N2Bv_sized REQUEST_WIDTH 6, true); *)
- (* write 6 @ 1 -> n_w@ : 2 , reads 4 (r@ = 3), n_r@ : 0 *)
-
- (* (false, N2Bv_sized REQUEST_WIDTH 0, true); *)
- (* no arrivals -> n_w@ : 2 , reads 5 (r@ = 0), n_r@ : 1 *)
-
- (* (false, N2Bv_sized REQUEST_WIDTH 0, true) *)
- (* no arrivals -> n_w@ : 2 , reads 6 (r@ = 1), n_r@ : 2 *)
- ])).
-
- Definition fifo_interface
- := sequentialInterface "fifo_interface"
- "clk" PositiveEdge "rst" PositiveEdge
- [mkPort "push_i" Bit; mkPort "data_i" (Vec Bit REQUEST_WIDTH); mkPort "pop_i" Bit]
- [mkPort "full_o" Bit; mkPort "data_o" (Vec Bit REQUEST_WIDTH); mkPort "empty_o" Bit].
-
- Definition fifo_netlist :=
- (makeCircuitNetlist fifo_interface CavaFifoQueue_t).
-
-End CodeGeneration.
\ No newline at end of file
diff --git a/framework/CavaDRAM/CavaFIFO/CavaFIFOProperties.v b/framework/CavaDRAM/CavaFIFO/CavaFIFOProperties.v
deleted file mode 100644
index 3ab6753..0000000
--- a/framework/CavaDRAM/CavaFIFO/CavaFIFOProperties.v
+++ /dev/null
@@ -1,1654 +0,0 @@
-Set Printing Projections.
-Set Warnings "-notation-overridden,-parsing".
-
-From CavaDRAM Require Import CavaFIFOREF CavaReqQueue CavaReqQueueProperties
-CavaCommonInstances CavaSubtractor Step CavaSystem Memory Util UtilSM.
-From CoqDRAM Require Import FIFO.
-From Coq Require Import Program BinaryString HexString NArith.
-From Cava Require Import Cava CavaProperties Util.Vector Util.Tactics.
-From mathcomp Require Import fintype ssrZ zify ring.
-
-Section CavaFIFOProperties.
-
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
- (* From Cava *)
- Existing Instance CombinationalSemantics.
- (* From CavaDRAM*)
- Context {CAVA_SYS : CavaSystem}.
- (* From CoqDRAM *)
- Existing Instance REQESTOR_CFG.
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
- Context {HAF : HW_Arrival_function_t}.
- Existing Instance ARBITER_CFG.
- Existing Instance FIFO_implementation.
-
- Import Memory.Properties BvectorNotations.
- Open Scope Bvector_scope.
-
- Definition mem_cells_ :=
- mem_cells (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem.
-
- Lemma nth_cells_read {T W I} (ad : Bvector W) c_req def
- (c : circuit_state (mem_cells T W (2 ^ W) I)) :
- nth_default def (N.to_nat (Bv2N ad)) (Cells_read true (N.to_nat (Bv2N ad)) c_req c) = c_req.
- Admitted.
-
- Lemma nth_cells_read_ {T W I N} (ad : Bvector (Nat.log2 N)) c_req def
- (c : circuit_state (mem_cells T W N I)) : N > 0 ->
- nth_default def (N.to_nat (Bv2N ad)) (Cells_read true (N.to_nat (Bv2N ad)) c_req c) = c_req.
- Proof.
- intros Hpos; rewrite nth_default_to_list.
- induction N; intros; [ discriminate | ].
- rewrite leq_eqVlt in Hpos; move: Hpos => /orP [/eqP Heq | Hpos].
- { assert (N = 0); [ lia | ]; clear IHN Heq; subst N.
- revert ad; rewrite Nat.log2_1; intros.
- apply Vector.case0 with (v := ad).
- simpl in c; destruct_products.
- rewrite /Cells_read //= andb_true_r.
- }
- assert (0 < N); [ lia | ]; clear Hpos.
- simpl in c; destruct_products; rewrite //= andb_true_r.
- specialize (Nat.log2_succ_or N) as Hor; destruct Hor as [Hor | Hor].
- { revert ad; rewrite Hor; intros.
- destruct (Nat.eqb (N.to_nat (Bv2N ad)) N) eqn:HH; set memvec := Cells_read true _ _ _.
- { assert (N.to_nat (Bv2N ad) = N) as H0; [ lia | ]; clear HH;
- rewrite H0.
- specialize (@length_to_list_shiftin (combType T) N memvec c_req) as HH.
- assert (N = (Datatypes.length (Vector.to_list (Vector.shiftin c_req memvec))) - 1)%coq_nat; [ lia | ].
- apply nth_last with (d := def) in H1; rewrite H1.
- by rewrite last_shiftin. }
- { unfold memvec.
- specialize (IHN (VectorDef.tl ad) c0); apply IHN in H as IH; clear IHN.
- rewrite (Vector.eta ad) Bv2N_cons.
- destruct (Vector.hd ad).
- { rewrite N2Nat.inj_succ_double //= !Nat.add_0_r.
- rewrite -nth_tl.
- set adtl := N.to_nat (Bv2N (VectorDef.tl ad)).
- fold adtl in IH.
- admit. }
- { admit. }
- Admitted.
-
- Lemma memcell_nch (c: circuit_state mem_cells_) (wra rda : Bvector ADDR_WIDTH) c_req def:
- wra <> rda ->
- nth_default def (N.to_nat (Bv2N rda)) (Cells_data c) =
- nth_default def (N.to_nat (Bv2N rda)) (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
- Admitted.
-
- (* ----------------------------------------------------------------------- *)
- (* Getters and state signals manipulation -------------------------------- *)
-
- Definition State_t := circuit_state FIFOSM_.
-
- Definition get_fields (s : State_t) :=
- let '(_,(_,(_,(_,(_,(_,(_,_,_,mem,_,_,_,_,rda),wra)),_,(_,(_,cr)),_,_,_,_,_,cref),cnt),st)) := s
- in (mem,rda,wra,cr,cref,cnt,st).
-
- Definition get_st (s : State_t) :=
- let '(_,_,_,_,_,_,st) := get_fields s in st.
-
- Definition get_cnt (s : State_t) :=
- let '(_,_,_,_,_,cnt,_) := get_fields s in cnt.
-
- Definition get_cref (s : State_t) :=
- let '(_,_,_,_,cref,_,_) := get_fields s in cref.
-
- Definition get_cr (s : State_t) :=
- let '(_,_,_,cr,_,_,_) := get_fields s in cr.
-
- Definition get_wra (s : State_t) :=
- let '(_,_,wra,_,_,_,_) := get_fields s in wra.
-
- Definition get_rda (s : State_t) :=
- let '(_,rda,_,_,_,_,_) := get_fields s in rda.
-
- Definition get_mem (s : State_t) : circuit_state memqueue' :=
- let '(mem,_,_,_,_,_,_) := get_fields s in mem.
-
- Definition get_reqqueue (s : State_t) : circuit_state RequestQueue' :=
- let '(_,(_,(_,(_,cs_requeue,_,_,_,_,_,_,_,_),_),_)) := s in cs_requeue.
-
- Create HintDb get_state.
- Hint Unfold get_fields get_st get_cnt get_cref get_reqqueue get_addr_RequestQueue get_mem
- get_memcells_RequestQueue get_mem_RequestQueue get_memcells get_cr : get_state.
-
- (* --------------------------Bounding the counter ------------------- *)
- Lemma cnt_bounded (cnt : Bvector COUNTER_WIDTH) :
- N.to_nat (Bv2N cnt) < WAIT.
- Proof.
- specialize @Bv2N_upper_bound_nat with (bv := cnt) as H.
- by rewrite /COUNTER_WIDTH WAIT_PW_2 in H.
- Qed.
-
- Definition Bv2cnt (cnt : Bvector COUNTER_WIDTH) : Counter_t :=
- Ordinal (cnt_bounded cnt).
-
- Definition cnt2Bv (cnt : Counter_t) :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
-
- (* -------------------------- cref counter -------------------------- *)
- Definition cref2Bv (cref : Counter_ref_t) :=
- N2Bv_sized COUNTER_REF_WIDTH (N.of_nat (nat_of_ord cref)).
-
- Lemma cref_bound (c : Counter_ref_t) :
- c < 2 ^ COUNTER_REF_WIDTH.
- Proof.
- unfold COUNTER_REF_WIDTH.
- destruct (_ == PREA_date + (WAIT - 1)) eqn:HPW2; destruct c.
- { simpl in *; move: HPW2 => /eqP HPW2; rewrite HPW2; lia. }
- { specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as h.
- specialize WAIT_pos as Hwpos; assert ((0 < PREA_date + (WAIT - 1))%coq_nat) as H0; [ lia | ].
- apply h in H0; destruct H0 as [_ H1]; move: H1 => /ltP H1.
- set aux := 2 ^ (Nat.log2 (PREA_date + (WAIT - 1))).+1; simpl; unfold aux; clear aux; lia.
- }
- Qed.
-
- Lemma prea_date_bound :
- PREA_date -1 < 2 ^ COUNTER_REF_WIDTH.
- Proof.
- unfold COUNTER_REF_WIDTH.
- destruct (_ == PREA_date + (WAIT - 1)) eqn:HPW2.
- { simpl in *; move: HPW2 => /eqP HPW2; rewrite HPW2; specialize WAIT_gt_one; lia. }
- { specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as h.
- assert ((0 < PREA_date + (WAIT - 1))%coq_nat) as H0;
- specialize WAIT_gt_one as Hwt1; [ lia | ]; clear Hwt1.
- apply h in H0; destruct H0 as [H0 H1]; lia.
- }
- Qed.
-
- Lemma wait_bound :
- WAIT - 1 < 2 ^ COUNTER_REF_WIDTH.
- Proof.
- unfold COUNTER_REF_WIDTH.
- destruct (_ == PREA_date + (WAIT - 1)) eqn:HPW2.
- { simpl in *; move: HPW2 => /eqP HPW2; rewrite HPW2. specialize PREA_date_pos; lia. }
- { specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as h.
- assert ((0 < PREA_date + (WAIT - 1))%coq_nat) as H0;
- specialize WAIT_gt_one as Hwt1; [ lia | ]; clear Hwt1.
- apply h in H0; destruct H0 as [H0 H1]; lia.
- }
- Qed.
-
- Lemma cref_preadate_false (c : Counter_ref_t) :
- (cref2Bv c =? CNT_REF_PREA) = false <->
- (nat_of_ord c == PREA_date - 1) = false.
- Proof.
- split. {
- unfold cref2Bv, CNT_REF_PREA; intros.
- apply BVEq_iff_neq in H; rewrite bitvec_literal_correct in H.
- apply N2Bv_sized_neq_if in H.
- apply of_nat_neq in H.
- by apply /eqP. }
- { intros.
- apply BVEq_iff_neq.
- rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct.
- apply N2Bv_sized_neq_iff; [ | | move: H => /eqP H; by rewrite Nat2N.inj_iff ];
- apply /leP; apply N.size_nat_le_nat; apply /leP;
- [ apply cref_bound | apply prea_date_bound ]. }
- Qed.
-
- Lemma cref_preadate_true (c : Counter_ref_t) :
- (cref2Bv c =? CNT_REF_PREA) = true <->
- (nat_of_ord c == PREA_date - 1) = true.
- Proof.
- split.
- { unfold cref2Bv, CNT_REF_PREA; intros.
- apply BVEq_iff_eq in H; rewrite bitvec_literal_correct in H.
- apply N2Bv_sized_eq_iff in H;
- [ apply Nat2N.inj in H; rewrite H; by apply /eqP | | ];
- apply N.size_nat_le_nat; apply /leP;
- [ apply cref_bound | apply prea_date_bound ].
- }
- { intros Href_prea; move: Href_prea => /eqP Href_prea; apply BVEq_iff_eq.
- rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct; f_equal.
- by rewrite Href_prea.
- }
- Qed.
-
- Lemma CrefPREA_lt_CNT_REF_PREA:
- CrefPREA_lt CNT_REF_PREA = false.
- Proof.
- cbv [CrefPREA_lt]; simpl_ident.
- unfold greaterThanOrEqual; simpl_ident; unfold greaterThanOrEqualBool.
- apply /negbF.
- rewrite {1}/CNT_REF_PREA; rewrite !bitvec_literal_correct.
- apply /N.leb_spec0; rewrite /CNT_REF_PREA /CNT_REF_WAIT !bitvec_literal_correct.
- rewrite !Bv2N_N2Bv_sized. { apply N.le_add_r. }
- all: apply to_nat_lt_pow; try rewrite -Nat2N.inj_add; rewrite Nat2N.id.
- 2 : {
- unfold COUNTER_REF_WIDTH; destruct (_ == PREA_date + (WAIT - 1)) eqn:Hpw2.
- { move: Hpw2 => /eqP Hpw2; rewrite Hpw2;
- specialize WAIT_gt_one; specialize PREA_date_gt_one; lia. }
- { specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as h.
- specialize WAIT_gt_one as Hwpos; assert ((0 < PREA_date + (WAIT - 1))%coq_nat) as H0; [ lia | ].
- apply h in H0; destruct H0 as [H0 H1]; lia.
- }
- }
- all: try (apply wait_bound || apply prea_date_bound).
- Qed.
-
- Lemma CrefPREA_lt_CNT_REF_WAIT cref:
- (cref2Bv cref =? CNT_REF_PREA) = false -> (cref + WAIT < PREA_date) = true ->
- CrefPREA_lt (cref2Bv cref) = true.
- Proof.
- intros Href_prea Href_service.
- rewrite /CrefPREA_lt; simpl_ident; rewrite /greaterThanOrEqual; simpl_ident.
- rewrite /greaterThanOrEqualBool /CNT_REF_WAIT /CNT_REF_PREA !bitvec_literal_correct !Bv2N_N2Bv_sized.
- { destruct (~~ _) eqn:Hbug; [ done | ].
- apply negbFE in Hbug; move: Hbug => /N.leb_spec0 Hbug.
- assert (cref + (WAIT - 1) < (PREA_date - 1)).
- { rewrite addnBA; [ | exact WAIT_pos].
- rewrite subn1 -ltnS prednK; [ | by rewrite addn_gt0 WAIT_pos orb_true_r ].
- rewrite subn1 prednK; [ | exact PREA_date_pos].
- by rewrite Href_service.
- }
- move: H => /ltP H; apply N_lt_inj in H.
- contradict Hbug; apply N.nle_gt; by rewrite -Nat2N.inj_add.
- }
- all: apply to_nat_lt_pow; try rewrite -Nat2N.inj_add; rewrite Nat2N.id.
- all: try (apply cref_bound || apply wait_bound || apply prea_date_bound).
- { unfold COUNTER_REF_WIDTH.
- destruct (_ == PREA_date + (WAIT - 1)) eqn:Heq.
- { move: Heq => /eqP Heq; rewrite Heq.
- destruct cref; simpl in *; lia. }
- { destruct cref.
- set aux := 2 ^ (Nat.log2 (PREA_date + (WAIT - 1))).+1; simpl.
- assert ((m + (WAIT - 1))%coq_nat < PREA_date + (WAIT - 1)); [ lia | ].
- specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as HH; lia.
- }
- }
- Qed.
-
- Lemma CrefPREA_lt_CNT_REF_WAIT_F (c1 : Counter_ref_t) :
- (c1 + WAIT < PREA_date) = false ->
- CrefPREA_lt (cref2Bv c1) = false.
- Proof.
- intros;
- rewrite /CrefPREA_lt; simpl_ident; rewrite /greaterThanOrEqual; simpl_ident.
- rewrite /greaterThanOrEqualBool /CNT_REF_WAIT /CNT_REF_PREA !bitvec_literal_correct !Bv2N_N2Bv_sized.
- { apply negb_false_iff; apply /N.leb_spec0; lia. }
- all: apply to_nat_lt_pow; try rewrite -Nat2N.inj_add; rewrite Nat2N.id.
- all: try (apply cref_bound || apply wait_bound || apply prea_date_bound).
- all: try (apply cref_bound || apply wait_bound || apply prea_date_bound).
- { unfold COUNTER_REF_WIDTH.
- destruct (_ == PREA_date + (WAIT - 1)) eqn:Heq.
- { move: Heq => /eqP Heq; rewrite Heq.
- destruct c1; simpl in *; lia. }
- { destruct c1.
- set aux := 2 ^ (Nat.log2 (PREA_date + (WAIT - 1))).+1; simpl.
- assert ((m + (WAIT - 1))%coq_nat < PREA_date + (WAIT - 1)); [ lia | ].
- specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as HH; lia.
- }
- }
- Qed.
-
- (* -------------------------- Predicates -------------------------------- *)
- Program Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
- Admitted.
-
- Lemma EqReqNil : EqReq nullreq REQUEST_NIL = true.
- Admitted.
-
- Hypothesis HaltIfFull : forall t c,
- let wra := get_wra c in
- let rda := get_rda c in
- if (HW_Arrival_at t != []) then ~~ fullQueue wra rda else true.
-
- Definition EqCmd (f_cmd : Command_kind_t) (c_cmd : Bvector DRAM_CMD_WIDTH) : bool :=
- match f_cmd with
- | ACT => (c_cmd =? ACT_VEC)
- | PRE => (c_cmd =? PRE_VEC)
- | PREA => (c_cmd =? PREA_VEC)
- | CRD => (c_cmd =? RD_VEC)
- | CWR => (c_cmd =? WR_VEC)
- | REF => (c_cmd =? REF_VEC)
- | NOP => (c_cmd =? NOP_VEC)
- end.
-
- Fixpoint EqQueue (P : Requests_t) (wra rda : Bvector ADDR_WIDTH) :=
- match P with
- | [::] => (wra =? rda)
- | x :: x0 => negb (wra =? rda) && (EqQueue x0 wra (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1)))
- end.
-
- Lemma EqQueue_diff_adr r0 r1 wra rda:
- EqQueue (r0 :: r1) wra rda -> wra <> rda.
- Proof.
- simpl; intros; move: H => /andP [Hd H];
- by move: Hd => /negPf Hd; apply BVEq_iff_neq in Hd.
- Qed.
-
- (* ----------------------------------------- *)
- Lemma leN_leqn a b:
- leq (S (addn (nat_of_bin a) 1)) (nat_of_bin b) -> N.lt (N.add a 1) b.
- Proof. lia. Qed.
-
- Lemma ltN_ltn a b:
- leq (S (nat_of_bin a)) (nat_of_bin b) <-> N.lt a b.
- Proof. lia. Qed.
-
- Lemma succ_double_inj_neq a b:
- a <> b -> N.succ_double a <> N.succ_double b.
- Proof.
- intros; rewrite !N.succ_double_spec; lia.
- Qed.
-
- Lemma succ_double_double_inj_neq a b:
- a <> b -> N.succ_double a <> N.double b.
- Proof.
- intros; rewrite N.succ_double_spec N.double_spec; lia.
- Qed.
-
- Lemma neq_nat_of_bin (a b : N) :
- not (@eq N a b) <->
- not (@eq nat (nat_of_bin a) (nat_of_bin b)).
- Proof. lia. Qed.
-
- Lemma cons_neq_BV {n} (a : bool) (x y: Bvector n) :
- ((a :: x)%vector) <> ((a :: y) %vector) -> x <> y.
- Admitted.
-
- Lemma Bv2N_neq_inj {W} (a b : Bvector W):
- a <> b -> Bv2N a <> Bv2N b.
- Proof.
- intros; induction W; [ admit | ].
- rewrite (Vector.eta a) (Vector.eta b); simpl;
- destruct (Vector.hd a) eqn:Ha, (Vector.hd b) eqn:Hb;
- specialize (IHW (VectorDef.tl a) (VectorDef.tl b)).
- { assert ((VectorDef.tl a) <> (VectorDef.tl b)) as H0.
- { rewrite (Vector.eta a) (Vector.eta b) in H; rewrite Ha Hb in H.
- by apply cons_neq_BV in H. }
- apply IHW in H0; by apply succ_double_inj_neq. }
- all: admit.
- Admitted.
-
- (* Use in EqQueue_aux *)
- Lemma Bvector_neq_N2Bv_sized_p1_neq {W} (a b : Bvector W) :
- W > 0 -> a <> b ->
- N2Bv_sized W (Bv2N a + 1) <> N2Bv_sized W (Bv2N b + 1).
- Proof.
- intros.
- specialize (@Bv2N_upper_bound_nat W b) as Hub_b.
- specialize (@Bv2N_upper_bound_nat W a) as Hub_a.
- specialize (N2Bv_sized_neq_iff W (Bv2N a) (Bv2N b)) as Hneq.
- apply Bv2N_neq_inj in H0; apply Hneq in H0; try (apply /leP; apply N.size_nat_le);
- [ | by apply to_nat_lt_pow in Hub_a | by apply to_nat_lt_pow in Hub_b]; clear Hneq.
- rewrite !N.add_1_r.
- (* apply N2Bv_sized_neq_iff. *)
- specialize (N2Bv_sized_neq_succ W (Bv2N a)) as Hsucc_a.
- specialize (N2Bv_sized_neq_succ W (Bv2N b)) as Hsucc_b.
- apply Hsucc_a in H as Ha'; clear Hsucc_a.
- apply Hsucc_b in H as Hb'; clear Hsucc_b.
- Admitted.
-
- (* Use in EqQueue_aux *)
- Lemma notfull_rd (wr rd : Bvector ADDR_WIDTH) :
- let rdp1 := N2Bv_sized ADDR_WIDTH (Bv2N rd + 1) in
- wr <> rd -> wr <> rdp1 -> ~~ fullQueue wr rd ->
- ~~ fullQueue wr rdp1.
- Proof.
- intros rdp1 Hdif1 Hdif2 HF; unfold fullQueue in HF.
- destruct (leq _ _) eqn:Hleq.
- { rewrite leq_eqVlt in Hleq; move: Hleq => /orP [/eqP Heq | Hleq].
- { admit. (* impossible *)}
- unfold fullQueue.
- destruct (Bv2N rdp1 <= _) eqn:Hleq2.
- { apply /negPf; apply Nat.eqb_neq.
- specialize (N.lt_neq (Bv2N wr - Bv2N rdp1) (N.of_nat QUEUE_MAX_SIZE - 1)) as H.
- apply neq_nat_of_bin; apply H; clear H.
- move: HF => /negPf HF; apply Nat.eqb_neq in HF.
- apply neq_nat_of_bin in HF.
- apply (N.lt_gt_cases (Bv2N wr - Bv2N rd) (N.of_nat QUEUE_MAX_SIZE - 1)) in HF as HF';
- destruct HF' as [H0 | H1].
- 2: admit. (* Impossible, Bv2N wr - Bv2N rd cannot be bigger than QMS *)
- apply (N.lt_trans (Bv2N wr - Bv2N rdp1) (Bv2N wr - Bv2N rd) (N.of_nat QUEUE_MAX_SIZE - 1));
- [ | exact H0 ].
- assert (N.lt (Bv2N rd) (Bv2N rdp1)); [ admit | ].
- lia.
- }
- { admit. }
- }
- { admit. }
- Admitted.
-
- (* Use in EqQueue_aux *)
- Lemma notfull_adrs (wr rd : Bvector ADDR_WIDTH) :
- let rdp1 := N2Bv_sized ADDR_WIDTH (Bv2N rd + 1) in
- let wrp1 := N2Bv_sized ADDR_WIDTH (Bv2N wr + 1) in
- wr <> rd -> ~~ fullQueue wr rd ->
- wrp1 <> rd.
- Proof.
- intros rdp1 wrp1 Hdif NF; unfold fullQueue in NF.
- destruct (leq _ _) eqn:Hleq.
- { move: NF => /negPf NF; apply Nat.eqb_neq in NF.
- rewrite leq_eqVlt in Hleq; move: Hleq => /orP [/eqP Hbug | Hltn].
- { admit. (* Impossible *)}
- apply neq_nat_of_bin in NF.
- apply (N.lt_gt_cases (Bv2N wr - Bv2N rd) (N.of_nat QUEUE_MAX_SIZE - 1)) in NF as NF';
- destruct NF' as [NF'| _].
- 2: admit. (* Impossible *)
- unfold wrp1.
- specialize (N2Bv_sized_Bv2N ADDR_WIDTH rd) as HH; rewrite -HH; clear HH.
- apply N2Bv_sized_neq_iff;
- admit.
- }
- { admit. }
- Admitted.
-
- Lemma EqQueue_aux wra rda r0 r1 r:
- ~~ fullQueue wra rda -> wra <> rda ->
- EqQueue (r0 :: r1)%SEQ wra rda ->
- EqQueue ((r0 :: r1)%SEQ ++ [r])%SEQ (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) rda.
- Proof.
- intros NFULL Hadr HQ; rewrite //=.
- simpl in HQ; move: HQ => /andP [_ HQ].
- revert HQ Hadr NFULL; generalize wra rda; induction r1; intros; simpl in HQ.
- { apply /andP; split.
- { unfold fullQueue in NFULL.
- move: NFULL; apply contraPN; intros; apply /negP; rewrite negb_involutive.
- specialize ADDR_WIDTH_pos as Hawp; move: Hawp => /ltP Hawp.
- destruct (Bv2N rda0 <= _) eqn:Hleq.
- { apply BVEq_iff_eq in HQ as HQ'; rewrite HQ' in H; clear HQ'.
- apply Bvector_wrap in H; [ | apply /ltP; exact ADDR_WIDTH_pos ].
- apply log2_eq1_pw2 in H as H2 ; [ | by rewrite QUEUE_MAX_SIZE_PW2 ]; clear H.
- rewrite H2; simpl ((N.of_nat 2 - 1)%N); simpl (N.add (Npos _) (Npos _)).
- apply BVEq_iff_eq in HQ; rewrite HQ Bv2N_N2Bv_sized; [ lia | ].
- apply /N.ltb_spec0.
- destruct ((Bv2N rda0 + 1 <? 2 ^ N.of_nat ADDR_WIDTH)%N) eqn:Hcont; [ done | ].
- move: Hcont => /negP /negP Hcont; rewrite -N.leb_antisym in Hcont.
- move: Hcont => /N.leb_spec0 Hcont.
- unfold ADDR_WIDTH in Hcont; rewrite QUEUE_MAX_SIZE_PW2_N in Hcont.
- rewrite leq_eqVlt in Hleq; move: Hleq => /orP [/eqP Hbug | Hltn].
- { specialize (@Bv2N_inj ADDR_WIDTH rda0 wra0) as HH.
- apply Bv_eq_translation in Hbug; apply HH in Hbug; by rewrite Hbug in Hadr. }
- { apply N.le_lteq in Hcont; destruct Hcont as [Hcont0 | Hcont1];
- specialize (@Bv2N_upper_bound_nat ADDR_WIDTH wra0) as H;
- apply Bv_ltn_translation in Hltn;
- apply to_nat_lt_pow in H;
- rewrite /ADDR_WIDTH QUEUE_MAX_SIZE_PW2_N in H;
- apply lt_trans_le with (p := N.of_nat QUEUE_MAX_SIZE) in Hltn; try by apply ltN_ltn.
- { contradict Hcont0; apply N.lt_asymm; by apply leN_leqn in Hltn. }
- { contradict Hcont1; apply N.neq_sym; apply N.lt_neq; by apply leN_leqn. }
- }
- }
- { apply BVEq_iff_eq in H; rewrite -H Bv2N_N2Bv_sized; [ lia | ].
- move: Hleq => /negP /negP Hleq; rewrite -ltnNge in Hleq; rename Hleq into Hltn.
- apply /N.ltb_spec0.
- destruct ((Bv2N wra0 + 1 <? 2 ^ N.of_nat ADDR_WIDTH)%N) eqn:Hcont; [ done | ].
- unfold ADDR_WIDTH in Hcont; rewrite QUEUE_MAX_SIZE_PW2_N in Hcont.
- move: Hcont => /negP /negP Hcont; rewrite -N.leb_antisym in Hcont; move: Hcont => /N.leb_spec0 Hcont.
- apply N.le_lteq in Hcont; destruct Hcont as [Hcont0 | Hcont1];
- specialize (@Bv2N_upper_bound_nat ADDR_WIDTH rda0) as Hub;
- apply Bv_ltn_translation in Hltn;
- apply to_nat_lt_pow in Hub;
- rewrite /ADDR_WIDTH QUEUE_MAX_SIZE_PW2_N in Hub;
- apply lt_trans_le with (p := N.of_nat QUEUE_MAX_SIZE) in Hltn; try by apply ltN_ltn.
- { contradict Hcont0; apply N.lt_asymm; by apply leN_leqn in Hltn. }
- { contradict Hcont1; apply N.neq_sym; apply N.lt_neq; by apply leN_leqn. }
- }
- }
- { simpl; apply BVEq_iff_eq in HQ; apply /andP; split.
- { apply /negPf; apply BVEq_iff_neq.
- apply Bvector_neq_N2Bv_sized_p1_neq; [ apply /ltP; exact ADDR_WIDTH_pos | done]. }
- { rewrite HQ; by apply BVEq_iff_eq. }
- }
- }
- move: HQ => /andP [neq HQ].
- specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1 in HQ as IH; clear IHr1.
- 3: {
- move: neq => /negPf neq; apply BVEq_iff_neq in neq.
- apply notfull_rd; done.
- }
- 2: by move: neq => /negPf neq; apply BVEq_iff_neq in neq.
- simpl; apply /andP; split.
- { move: IH => /andP [neq_ IH].
- apply /negPf; apply BVEq_iff_neq.
- apply notfull_adrs; try done.
- }
- exact IH.
- Qed.
-
- Fixpoint EqMem_ {W} (P : Requests_t) (rda : Bvector W)
- (memcells_vec : Vector.t (Bvector REQUEST_WIDTH) (Nat.pow 2 W)) : bool :=
- match P with
- | [::] => true
- | x :: x0 =>
- let nrda := N2Bv_sized W (Bv2N rda + 1) in
- let s := nth_default REQUEST_NIL (N.to_nat (Bv2N rda)) memcells_vec in
- (EqReq x s) && (EqMem_ x0 nrda memcells_vec)
- end.
-
- Lemma EqMem_rcons r1 (rda wra : Bvector ADDR_WIDTH) c R (c_req : combType (Vec Bit REQUEST_WIDTH)) :
- EqQueue r1 wra rda ->
- EqMem_ r1 rda (@Cells_data (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem c) ->
- EqReq R c_req ->
- EqMem_ (r1 ++ [R])%SEQ rda (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
- Proof.
- intros HQ Mem EqR; fold mem_cells_ in c; rewrite cats1.
- revert Mem HQ; generalize wra rda; induction r1; intros.
- { simpl; rewrite andb_true_r; simpl in HQ; apply BVEq_iff_eq in HQ; rewrite HQ.
- rewrite VectorSpec.map_id.
- unfold ADDR_WIDTH in wra,rda.
- specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem
- rda0 c_req REQUEST_NIL) as HH; rewrite /REQUEST_NIL bitvec_literal_correct //= in HH;
- unfold mem_cells_ in c; by rewrite HH. }
- simpl in Mem,HQ; simpl.
- move: Mem => /andP [EqR_ Mem]; apply /andP; split.
- { move: HQ => /andP [/negPf Heq HQ];
- apply BVEq_iff_neq in Heq; rewrite VectorSpec.map_id; rewrite VectorSpec.map_id in EqR_.
- rewrite -memcell_nch; done.
- }
- { move: HQ => /andP [neq HQ].
- specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1; done.
- }
- Qed.
-
- (* Just use the circuit directly <-> circuit does the work directly *)
- Definition EqMem (P : Requests_t) rda (mem : circuit_state RequestQueue') :=
- let memcells_vec := Cells_data (get_memcells_RequestQueue mem) in
- EqMem_ P rda memcells_vec.
-
- Definition State_Eq (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
- let s := get_st cava_state in
- let c' := get_cnt cava_state in
- let cref' := get_cref cava_state in
- let r' := get_cr cava_state in
- let RQ := get_reqqueue cava_state in
- let wra := fst (get_addr_RequestQueue RQ) in
- let rda := snd (get_addr_RequestQueue RQ) in
- match fram_state with
- | IDLE c cref P =>
- (s =? STATE_IDLE_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) &&
- (EqMem P rda RQ) && (EqQueue P wra rda)
- | RUNNING c cref P r =>
- (s =? STATE_RUN_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
- (EqQueue P wra rda) && (EqReq r r')
- | REFRESHING cref P =>
- (s =? STATE_REF_VEC) && (cref' =? cref2Bv cref) &&
- (EqMem P rda RQ) && (EqQueue P wra rda)
- end.
-
- (* -------------- Proofs about CmdGen ------------------------------- *)
- Lemma CmdGen_equiv_idle_to_idle_E (c : circuit_state CmdGen) cnt cref:
- (cref =? CNT_REF_PREA) = false ->
- exists c', step CmdGen c (STATE_IDLE_VEC,true,cnt,cref,REQUEST_NIL) =
- (c',NOP_VEC).
- Proof.
- intros H; simpl in c; destruct_products.
- eapply ex_intro.
- cbv [CmdGen]; cbn [step fst snd].
- simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; simpl.
- cbv [CrefPREA_eq].
- apply BVEq_iff_neq in H.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply HH in H; rewrite H VectorSpec.map_id; reflexivity.
- Qed.
-
- Lemma CmdGen_equiv_idle_to_idle (c : circuit_state CmdGen) cnt cref:
- (cref2Bv cref =? CNT_REF_PREA) = false ->
- (cref + WAIT < PREA_date) = false ->
- exists c', step CmdGen c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref),REQUEST_NIL) =
- (c',NOP_VEC).
- Proof.
- intros H Href_service; simpl in c; destruct_products; eapply ex_intro.
- cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; simpl.
- cbv [CrefPREA_eq]; apply BVEq_iff_neq in H.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply HH in H; rewrite H !VectorSpec.map_id.
- rewrite CrefPREA_lt_CNT_REF_WAIT_F; done.
- Qed.
-
- Lemma CmdGen_equiv_idle_to_ref (c : circuit_state CmdGen) cnt cref e:
- (cref =? CNT_REF_PREA) = true ->
- exists c', step CmdGen c (STATE_IDLE_VEC,e,cnt,cref,REQUEST_NIL) = (c',PREA_VEC).
- Proof.
- intros; simpl in c; destruct_products; eapply ex_intro.
- cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; simpl; rewrite VectorSpec.map_id.
- apply BVEq_iff_eq in H; subst cref; rewrite CrefPREA_lt_CNT_REF_PREA !VectorSpec.map_id.
- rewrite andb_false_r; rewrite /CrefPREA_eq.
- specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- assert (CNT_REF_PREA = CNT_REF_PREA); [done | ]; apply HH in H; by rewrite H.
- Qed.
-
- Lemma CmdGen_equiv_idle_to_running (c : circuit_state CmdGen) cnt cref tr:
- (cref2Bv cref =? CNT_REF_PREA) = false ->
- (cref + WAIT < PREA_date) = true ->
- exists c', step CmdGen c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref),tr) = (c',PRE_VEC).
- Proof.
- intros; simpl in c; destruct_products; eapply ex_intro.
- cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; simpl; rewrite !VectorSpec.map_id.
- rewrite CrefPREA_lt_CNT_REF_WAIT; done.
- Qed.
- (* ------------------------------------------------------------------ *)
-
- (* -------------- Proofs about NextCR ------------------------------- *)
- Lemma NextCR_equiv (c : circuit_state NextCR) cnt cref tr:
- exists c', step NextCR c (STATE_IDLE_VEC,true,cnt,cref,tr) =
- (c',REQUEST_NIL).
- Proof.
- simpl in c; destruct_products.
- eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd].
- simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; by simpl.
- Qed.
-
- Lemma NextCR_equiv_IDLE_NE_PREA c cnt cref tr:
- (cref =? CNT_REF_PREA) = true ->
- exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref,tr) =
- (c',REQUEST_NIL).
- Proof.
- intros; simpl in c; destruct_products; eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
- apply BVEq_iff_eq in H; subst cref.
- by rewrite CrefPREA_lt_CNT_REF_PREA.
- Qed.
-
- Lemma NextCR_equiv_IDLE_IDLE c cnt (cref : Counter_ref_t) tr:
- (cref + WAIT < PREA_date) = false ->
- exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref2Bv cref,tr) =
- (c',REQUEST_NIL).
- Proof.
- intros Href_service; simpl in c; destruct_products; eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
- rewrite CrefPREA_lt_CNT_REF_WAIT_F; done.
- Qed.
-
- Lemma NextCR_equiv_IDLE_RUNNING c cnt (cref : Counter_ref_t) tr:
- (cref2Bv cref =? CNT_REF_PREA) = false ->
- (cref + WAIT < PREA_date) = true ->
- exists c',
- step NextCR c (STATE_IDLE_VEC,false,cnt,cref2Bv cref,tr) = (c',tr) /\
- (snd (snd c')) = tr.
- Proof.
- intros Href_service Href_prea; simpl in c; destruct_products; eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
- rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
- rewrite CrefPREA_lt_CNT_REF_WAIT; done.
- Qed.
- (* ------------------------------------------------------------------ *)
-
- Create HintDb update.
- Lemma Sidle_true :
- Sidle STATE_IDLE_VEC = true.
- Proof.
- apply CavaPreludeProperties.eqb_refl.
- Qed.
- Hint Rewrite @Sidle_true : update.
-
- Lemma Sref_idle_false :
- Sref STATE_IDLE_VEC = false.
- Proof.
- by apply CavaPreludeProperties.eqb_neq.
- Qed.
- Hint Rewrite @Sref_idle_false : update.
-
- Lemma cnt_equiv (cnt : Bvector COUNTER_WIDTH) :
- (if CeqWAIT cnt then Bvect_false COUNTER_WIDTH
- else N2Bv_sized COUNTER_WIDTH (Bv2N cnt + 1)) = cnt2Bv (Next_cycle (Bv2cnt cnt)).
- Proof.
- cbv [CeqWAIT].
- destruct (CavaPrelude.eqb (cnt, CNT_WAIT)) eqn:Heq; rewrite Heq.
- { specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit COUNTER_WIDTH) (x := cnt) as H.
- apply H in Heq; clear H.
- unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { rewrite /CNT_WAIT bitvec_literal_correct in Heq.
- rewrite Heq /Bv2cnt //= Bv2N_N2Bv_sized in x.
- 2: {
- rewrite /COUNTER_WIDTH; have id := (N2Nat.id 2).
- rewrite -id Nat2N.inj_pow //= /Pos.to_nat //= WAIT_PW_2.
- apply: N_lt_inj; apply /ltP; by rewrite subn1 ltn_predL WAIT_pos.
- }
- rewrite Nat2N.id subn1 prednK in x; [ | exact WAIT_pos ]; by rewrite ltnn in x.
- }
- { unfold cnt2Bv,OCycle0; by simpl. }}
- { unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { unfold cnt2Bv; apply f_equal; simpl.
- rewrite N.add_1_r -(N.succ_pos_pred (Pos.of_succ_nat (N.to_nat (Bv2N cnt)))).
- apply f_equal; by rewrite predN_of_succ_nat. }
- { apply ltn_gt in e,x.
- rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
- { have HH := (@eqb_iff_neq (Vec Bit (@COUNTER_WIDTH SYS_CFG FIFO_CFG))).
- apply HH in Heq. rewrite /CNT_WAIT bitvec_literal_correct in Heq;
- rewrite -(N2Bv_sized_Bv2N (@COUNTER_WIDTH SYS_CFG FIFO_CFG) cnt) in Heq.
- apply N2Bv_sized_neq_if in Heq.
- by rewrite e subn1 -pred_Sn N2Nat.id in Heq. }
- { specialize ltn_ord with (n := @WAIT SYS_CFG FIFO_CFG) (i := Ordinal (cnt_bounded cnt)) as H.
- rewrite //= in H.
- contradict H; apply /negP; by rewrite -ltnNge.
- }
- }
- }
- Qed.
-
- (* -------------- Proofs about Update ------------------------------- *)
- Lemma Update_equiv_idle_idle_E (c : circuit_state Update) cnt cref :
- (cref =? CNT_REF_PREA) = false ->
- let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
- let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N cref + 1) in
- exists c', step Update_ c (STATE_IDLE_VEC,true,cnt,cref) =
- (c',(STATE_IDLE_VEC,nc,ncref)).
- Proof.
- intros Hcref Hcnt; simpl in c; eapply ex_intro.
- cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
- cbv [Update_ Update_s Update_c Update_cref].
- cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- autorewrite with update; vm_compute (false && _).
- apply BVEq_iff_neq in Hcref.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply pair_equal_spec; split.
- 2: {
- rewrite orb_false_l andb_true_l.
- rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
- }
- cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
- vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id andb_false_r.
- apply pair_equal_spec; split; [ done | ].
- vm_compute (orb false false); rewrite orb_false_r; by specialize (cnt_equiv cnt).
- Qed.
-
- Lemma Update_equiv_idle_idle (c : circuit_state Update) cnt cref :
- (cref2Bv cref =? CNT_REF_PREA) = false ->
- (cref + WAIT < PREA_date) = false ->
- let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
- let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N (cref2Bv cref) + 1) in
- exists c', step Update_ c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref)) =
- (c',(STATE_IDLE_VEC,nc,ncref)).
- Proof.
- intros Hcref Href_service Hcnt; simpl in c; eapply ex_intro.
- cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
- cbv [Update_ Update_s Update_c Update_cref].
- cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- autorewrite with update; vm_compute (false && _).
- apply BVEq_iff_neq in Hcref.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply pair_equal_spec; split.
- 2: {
- rewrite orb_false_l andb_true_l /CrefPREA_eq.
- apply HH in Hcref; by rewrite Hcref.
- }
- cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
- vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id andb_true_r !orb_false_r.
- rewrite !CrefPREA_lt_CNT_REF_WAIT_F; [ | done].
- rewrite //=.
- apply pair_equal_spec; split; [ done | ].
- rewrite orb_false_r; by specialize (cnt_equiv cnt).
- Qed.
-
- Lemma Update_equiv_idle_ref (c : circuit_state Update) cnt cref e:
- (cref =? CNT_REF_PREA) = true ->
- let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
- let ncref := CNT_REF_NIL in
- exists c', (step Update_ c (STATE_IDLE_VEC,e,cnt,cref)) =
- (c',(STATE_REF_VEC,nc,ncref)).
- Proof.
- intros Hcref Hcnt; simpl in c; eapply ex_intro.
- cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
- cbv [Update_ Update_s Update_e Update_c Update_cref].
- cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- autorewrite with update; vm_compute (false && _).
- apply BVEq_iff_eq in Hcref.
- specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply pair_equal_spec; split.
- 2: {
- rewrite orb_false_l andb_true_l.
- rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
- }
- cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
- vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id.
- apply pair_equal_spec; split.
- 2: {
- vm_compute (orb false false); rewrite orb_false_r.
- destruct e; [rewrite negb_true | rewrite negb_false].
- { rewrite andb_false_r orb_false_r; by specialize (cnt_equiv cnt). }
- { rewrite andb_true_r.
- destruct (CrefPREA_lt cref) eqn:Hbug.
- { by rewrite Hcref CrefPREA_lt_CNT_REF_PREA in Hbug. }
- { rewrite orb_false_r; by specialize (cnt_equiv cnt). }
- }
- }
- done.
- Qed.
-
- Lemma Update_equiv_idle_running (c : circuit_state Update) cnt
- (cref : Counter_ref_t) :
- (cref2Bv cref =? CNT_REF_PREA) = false ->
- (cref + WAIT < PREA_date) = true ->
- let nc := CNT_NIL in
- let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N (cref2Bv cref) + 1) in
- exists c', step Update_ c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref)) =
- (c',(STATE_RUN_VEC,nc,ncref)).
- Proof.
- intros Href_prea Href_service Hcnt;
- simpl in c; destruct_products; eapply ex_intro.
- cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
- cbv [Update_ Update_s Update_e Update_c Update_cref].
- cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ];
- autorewrite with update; fast_simpl_bool.
- rewrite !orb_false_l !andb_true_l /CrefPREA_eq.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply BVEq_iff_neq in Href_prea as Haux; apply HH in Haux.
- rewrite Haux //= !orb_false_r andb_true_r !VectorSpec.map_id; clear Haux.
- apply pair_equal_spec; split; [ | done].
- apply pair_equal_spec; split; rewrite CrefPREA_lt_CNT_REF_WAIT; try done.
- by rewrite orb_true_r.
- Qed.
- (* ------------------------------------------------------------------ *)
-
- (* ----------------------------- Cases ------------------------------ *)
- Theorem SM_Eq_3b (t : nat) (c_state : State_t) c0 (r0 r : Request_t) r1
- (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) :
- (c1 + WAIT < PREA_date) = false ->
- (nat_of_ord c1 == PREA_date - 1) = false ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM_.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
-
- move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ].
- apply EqQueue_diff_adr in HQ as Hadr.
-
- apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret; cbv [and2]; cbn [fst snd].
-
- assert ((Sidle STATE_IDLE_VEC && CrefPREA_lt (cref2Bv c1)) = false) as Haux;
- [ apply CrefPREA_lt_CNT_REF_WAIT_F in Href_service; by rewrite Href_service andb_false_r | ].
- rewrite Haux; clear Haux.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- apply (Queue_WR_NF_NE_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) in NFULL as S;
- apply S in Hadr as S'; clear S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S'.
- destruct S' as [full_o H]; rewrite H; clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- apply (NextCR_equiv_IDLE_IDLE (u7, (u8, cr)) (cnt2Bv c0) c1 tr) in Href_service as H.
- destruct H as [cs_nextcr H]; rewrite H; clear H; cbn [fst snd].
-
- apply cref_preadate_false in Href_prea as Href_prea_.
- apply (CmdGen_equiv_idle_to_idle u5 (cnt2Bv c0) c1) in Href_prea_ as H; [ | done ].
- destruct H as [cs_cmdgen H]; rewrite H; clear H; cbn [fst snd].
-
- apply (Update_equiv_idle_idle u3 (cnt2Bv c0) c1) in Href_prea_ as H; [ | done].
- destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
-
- rewrite /Next_state Href_prea Href_service /State_Eq.
- specialize (Queue_WR_NF_NE_fst (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra)) c_req false) as S.
- apply S in NFULL as H; clear S; apply H in Hadr as H'; clear H; rename H' into H.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H.
- cbv [get_addr_RequestQueue] in Hwra'; rewrite Hwra'; clear Hwra'.
- cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
- rewrite /Enqueue /R NF.
- apply (EqQueue_aux wra rda r0 r1 r); done.
- }
- apply /andP; split.
- 2 : {
- rewrite /EqMem (surjective_pairing (step RequestQueue' _ _)) H Hrda'; cbn [fst snd];
- unfold R; rewrite NF Hrw /Enqueue.
- cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
- apply EqMem_rcons; try done.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H;
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd].
- rewrite //= /Next_cycle_ref.
- set Hc := c1.+1 < PREA_date; dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
- 2: apply to_nat_lt_pow; rewrite Nat2N.id; apply cref_bound.
- rewrite /N2Bv_sized.
- destruct (N.of_nat c1 + 1)%N eqn:Hbug;
- [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
- apply BVEq_iff_eq; f_equal; lia.
- }
- { specialize (cref_bound c1) as Hc1_bound.
- destruct c1; clear H Hrw Hwra' Hrda' cs_requeue' cs_nextcr; simpl in *.
- apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x]; [ | lia].
- assert (m = PREA_date.-1); [ lia | ].
- rewrite H in Href_prea; contradict Href_prea; apply not_false_iff_true; by rewrite subn1 eq_refl.
- }
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H;
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd].
- rewrite /cnt2Bv //=; apply BVEq_iff_eq; f_equal; apply Nat2N.inj_iff.
- rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
- 2: {
- destruct c0; rewrite //= /COUNTER_WIDTH.
- rewrite WAIT_PW_2_N; apply N_lt_inj; by apply /ltP.
- }
- set (Hc := _ < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro; try rewrite Nat2N.id;
- try by rewrite Nat2N.id in x; move: Logic.eq_refl; rewrite {2 3}x; simpl; intro.
- }
- rewrite (surjective_pairing (step RequestQueue' _ _)) H;
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd].
- by [].
- Qed.
-
- Theorem SM_Eq_3a (t : nat) (c_state : State_t) c0 (r : Request_t)
- (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) :
- (c1 + WAIT < PREA_date) = false ->
- (nat_of_ord c1 == PREA_date - 1) = false ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM_.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
-
- move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr].
- simpl in Hadr.
- apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret; cbv [and2]; cbn [fst snd].
-
- assert ((Sidle STATE_IDLE_VEC && CrefPREA_lt (cref2Bv c1)) = false) as Haux;
- [ apply CrefPREA_lt_CNT_REF_WAIT_F in Href_service; by rewrite Href_service andb_false_r | ].
- rewrite Haux; clear Haux.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (Queue_WR_E_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in Hadr as H; clear S; destruct H as [full_o H].
- rewrite H; clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- specialize NextCR_equiv with (c := (u7, (u8, cr))) (cnt := cnt2Bv c0)
- (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
- rewrite H; cbv [fst]; clear H. cbn [snd].
-
- apply cref_preadate_false in Href_prea as Href_prea_.
- apply (CmdGen_equiv_idle_to_idle_E u5 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- apply (Update_equiv_idle_idle_E u3 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
- destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
-
- rewrite /Next_state Href_prea Href_service /State_Eq.
- specialize (Queue_WR_NF_E_fst (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra)) c_req false) as S.
- apply S in NFULL as H; clear S; apply H in Hadr as H'; clear H; rename H' into H.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H.
- cbv [get_addr_RequestQueue] in Hwra'; rewrite Hwra'; clear Hwra'.
- cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
- simpl; rewrite Hadr; unfold R; rewrite NF //=.
- apply /andP; split.
- { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
- specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
- by apply BVEq_iff_eq.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H.
- cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
- simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r.
- rewrite Hrw; autounfold with get_state; rewrite Hadr VectorSpec.map_id.
- specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req
- (Bvect_false REQUEST_WIDTH) c) as H'.
- rewrite H'; exact EqR.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H;
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd].
- rewrite //= /Next_cycle_ref.
- set Hc := c1.+1 < PREA_date; dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
- 2: apply to_nat_lt_pow; rewrite Nat2N.id; apply cref_bound.
- rewrite /N2Bv_sized.
- destruct (N.of_nat c1 + 1)%N eqn:Hbug;
- [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
- apply BVEq_iff_eq; f_equal; lia.
- }
- { specialize (cref_bound c1) as Hc1_bound.
- destruct c1; clear H Hrw Hwra' Hrda' cs_requeue' cs_nextcr; simpl in *.
- apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x]; [ | lia].
- assert (m = PREA_date.-1); [ lia | ].
- rewrite H in Href_prea; contradict Href_prea; apply not_false_iff_true; by rewrite subn1 eq_refl.
- }
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H;
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd].
- rewrite /cnt2Bv //=; apply BVEq_iff_eq; f_equal; apply Nat2N.inj_iff.
- rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
- 2: {
- destruct c0; rewrite //= /COUNTER_WIDTH.
- rewrite WAIT_PW_2_N; apply N_lt_inj; by apply /ltP.
- }
- set (Hc := _ < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro; try rewrite Nat2N.id;
- try by rewrite Nat2N.id in x; move: Logic.eq_refl; rewrite {2 3}x; simpl; intro.
- }
- rewrite (surjective_pairing (step RequestQueue' _ _)) H;
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd].
- by [].
- Qed.
-
- Theorem SM_Eq_2b (t : nat) (c_state : State_t) c0 r0 r1
- (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) r :
- (c1 + WAIT < PREA_date) = true ->
- (nat_of_ord c1 == PREA_date - 1) = false ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM_.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
-
- move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ].
- apply EqQueue_diff_adr in HQ as Hadr.
-
- apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret; cbv [and2].
- assert ((Sidle STATE_IDLE_VEC && CrefPREA_lt (cref2Bv c1)) = true) as Haux; [
- rewrite //= ; apply CrefPREA_lt_CNT_REF_WAIT;
- [ by apply cref_preadate_false in Href_prea | done ] | ]; rewrite Haux; clear Haux; cbn [snd].
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (Queue_WR_NF_NE_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req true) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
- rewrite H; clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- apply NextCR_equiv_IDLE_RUNNING with (c := (u7, (u8, cr))) (cnt := cnt2Bv c0)
- (cref := c1) (tr := tr) in Href_service as H.
- 2: by apply cref_preadate_false in Href_prea.
- destruct H as [cs_nextcr H]; destruct H as [H Htr].
- rewrite H; clear H; cbv [fst snd].
-
- specialize (CmdGen_equiv_idle_to_running u5 (cnt2Bv c0) c1 tr) as S.
- specialize Href_service as Href_service_.
- apply S in Href_service; clear S; rename Href_service into H.
- 2: by apply cref_preadate_false in Href_prea.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- specialize (Update_equiv_idle_running u3 (cnt2Bv c0) c1) as S;
- apply S in Href_service_ as S'; clear S.
- 2: by apply cref_preadate_false in Href_prea.
- destruct S' as [cs_update H]; rewrite H; clear H; cbn [fst snd].
-
- rewrite /Next_state Href_prea Href_service_ /State_Eq.
- specialize Queue_NF_WR_RD_fst with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S.
- apply H in Hadr as H'; clear H; rename H' into H.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
-
- apply /andP; split.
- 2: {
- unfold tr; simpl in Mem; move: Mem => /andP [EqReq_r0 Mem].
- rewrite {2}/get_memcells_RequestQueue /get_mem_RequestQueue /get_memcells in Hrw.
- apply (memcell_nch c wra rda c_req req_null) in Hadr as HH.
- rewrite /req_null //= in HH.
- rewrite VectorSpec.map_id /Bvect_false HH in EqReq_r0.
- by rewrite /req_null //=.
- }
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2 : {
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; rewrite Htr;
- unfold tr; simpl in Mem; move: Mem => /andP [EqReq_r0 Mem].
- rewrite {2}/get_memcells_RequestQueue /get_mem_RequestQueue /get_memcells in Hrw.
- apply (memcell_nch c wra rda c_req req_null) in Hadr as HH.
- rewrite /req_null //= in HH.
- rewrite VectorSpec.map_id /Bvect_false HH in EqReq_r0.
- by rewrite /req_null //=.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
- simpl; rewrite eq_refl.
- rewrite /Enqueue /R NF.
- simpl in HQ.
- specialize (EqQueue_aux wra rda r0 r1 r) as HH.
- apply HH in NFULL as HH'; clear HH; try done.
- move: HH'; simpl; intros HH.
- by move: HH => /andP [_ HH].
- }
- apply /andP; split.
- 2 : {
- rewrite /EqMem (surjective_pairing (step RequestQueue' _ _)) H Hrda' /Enqueue.
- simpl; unfold R; rewrite NF //=.
- rewrite Hrw eq_refl.
- simpl in Mem; move: Mem => /andP [_ Mem].
- apply EqMem_rcons; try done.
- simpl in HQ; by move: HQ => /andP [_ HQ].
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end.
- rewrite VectorSpec.map_id; cbn [fst snd].
- rewrite /Next_cycle_ref.
- set Hc := c1.+1 < WAIT_REF; dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
- 2: {
- unfold COUNTER_REF_WIDTH; rewrite WAIT_REF_PW_N.
- destruct c1; simpl; apply N_lt_inj; by apply /ltP.
- }
- rewrite /N2Bv_sized.
- destruct (N.of_nat c1 + 1)%N eqn:Hbug;
- [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
- apply BVEq_iff_eq; f_equal; lia.
- }
- { apply cref_preadate_false in Href_prea as Href_prea_.
- destruct c1; simpl in x,e,Hc0,Href_service_,Href_prea,Href_prea_.
- rewrite /cref2Bv VectorSpec.map_id //= in Href_prea_.
- apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x].
- { assert (m = WAIT_REF.-1); [ lia | ].
- rewrite H0 addnC -ltn_subRL in Href_service_.
- rewrite -subn1 ltn_subLR in Href_service_; [ | exact WAIT_REF_pos ].
- contradict Href_service_; apply /negP.
- rewrite -leqNgt leq_eqVlt addnC.
- specialize WAIT_REF_PREA_date as HH.
- apply ltn_trans with (m := PREA_date - WAIT + 1) in HH;
- [ by rewrite HH orb_true_r | ].
- rewrite -subnA.
- { by rewrite ltn_subrL subn_gt0 WAIT_gt_one PREA_date_pos. }
- { exact WAIT_pos. }
- { by rewrite leq_eqVlt PREA_date_WAIT orb_true_r. }
- }
- { rewrite ltnS in x; contradict x; apply /negP; by rewrite -ltnNge. }
- }
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end. cbn [fst snd]. rewrite VectorSpec.map_id.
- rewrite /cnt2Bv; apply BVEq_iff_eq; f_equal.
- rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
- }
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd]. by [].
- Qed. *)
-
- Theorem SM_Eq_2a (t : nat) (c_state : State_t) c0
- (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) r :
- (c1 + WAIT < PREA_date) = true ->
- (nat_of_ord c1 == PREA_date - 1) = false ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Admitted.
- (* Proof.
- intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM_.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
- move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr].
- simpl in Hadr.
-
- apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
- cbv [and2].
- assert ((Sidle STATE_IDLE_VEC && CrefPREA_lt (cref2Bv c1)) = true) as Haux; [
- rewrite //= ; apply CrefPREA_lt_CNT_REF_WAIT;
- [ by apply cref_preadate_false in Href_prea | done ] | ]; rewrite Haux; clear Haux.
- cbn [snd].
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (Queue_EMP_WR_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req true) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in Hadr as H; clear S; destruct H as [full_o H].
- rewrite H; clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- specialize NextCR_equiv with (c := (u7, (u8, cr))) (cnt := cnt2Bv c0)
- (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
- rewrite H; cbv [fst]; clear H. cbn [snd].
-
- apply cref_preadate_false in Href_prea as Href_prea_.
- apply (CmdGen_equiv_idle_to_idle_E u5 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- apply (Update_equiv_idle_idle_E u3 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
- destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
-
- cbv [get_rda get_wra get_fields] in NFULL.
- rewrite /Next_state Href_prea Href_service /State_Eq.
- specialize Queue_NF_EMP_WR_fst with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S. apply H in Hadr as H'; clear H; rename H' into H.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
- simpl; rewrite Hadr; unfold R; rewrite NF //=.
- apply /andP; split.
- { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
- specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
- by apply BVEq_iff_eq.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hrda'.
- simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r.
- rewrite Hrw; autounfold with get_state; rewrite Hadr VectorSpec.map_id.
- specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req
- (Bvect_false REQUEST_WIDTH) c) as H'.
- rewrite H'; exact EqR.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end.
- cbn [fst snd].
- rewrite /Next_cycle_ref.
- set Hc := c1.+1 < WAIT_REF; dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
- 2: {
- unfold COUNTER_REF_WIDTH; rewrite WAIT_REF_PW_N.
- destruct c1; simpl; apply N_lt_inj; by apply /ltP.
- }
- rewrite /N2Bv_sized.
- destruct (N.of_nat c1 + 1)%N eqn:Hbug;
- [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
- apply BVEq_iff_eq; f_equal; lia.
- }
- { destruct c1; simpl in x,e,Hc0,Href_prea,Href_prea_,Href_service.
- rewrite /cref2Bv VectorSpec.map_id //= in Href_prea_.
- apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x].
- { assert (m = WAIT_REF.-1); [ lia | ].
- rewrite H0 addnC -ltn_subRL in Href_service.
- rewrite -subn1 ltn_subLR in Href_service; [ | exact WAIT_REF_pos ].
- contradict Href_service; apply /negP.
- rewrite -leqNgt leq_eqVlt addnC.
- specialize WAIT_REF_PREA_date as HH.
- apply ltn_trans with (m := PREA_date - WAIT + 1) in HH;
- [ by rewrite HH orb_true_r | ].
- rewrite -subnA.
- { by rewrite ltn_subrL subn_gt0 WAIT_gt_one PREA_date_pos. }
- { exact WAIT_pos. }
- { by rewrite leq_eqVlt PREA_date_WAIT orb_true_r. }
- }
- { rewrite ltnS in x; contradict x; apply /negP; by rewrite -ltnNge. }
- }
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end. cbn [fst snd].
- rewrite /cnt2Bv; apply BVEq_iff_eq; f_equal.
- apply Nat2N.inj_iff.
- rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
- 2: {
- destruct c0; rewrite //= /COUNTER_WIDTH.
- rewrite WAIT_PW_2_N; apply N_lt_inj; by apply /ltP.
- }
- set (Hc := _ < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro; try rewrite Nat2N.id;
- try by rewrite Nat2N.id in x; move: Logic.eq_refl; rewrite {2 3}x; simpl; intro.
- }
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd]. by [].
- Qed. *)
-
-
- (* Assuming a non-full regime, i.e., the front-end has yielded a valid request *)
- (* If R is non empty than the queue is not full *)
- Theorem SM_Eq_1b (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r0 r1 (r : Request_t) :
- (nat_of_ord c1 == PREA_date - 1) = true ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Admitted.
- (* Proof.
- intros Href_prea f_state R NF EqR H; unfold FIFOSM_.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
- move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ].
- apply EqQueue_diff_adr in HQ as Hadr.
-
- apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
-
- apply cref_preadate_true in Href_prea as Href_prea_;
- apply BVEq_iff_eq in Href_prea_ as H'.
- cbv [and2]. cbn [fst snd].
- rewrite {1}H' CrefPREA_lt_CNT_REF_PREA andb_false_r.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (Queue_NEMP_NF_WR_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
- rewrite H; clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- specialize (NextCR_equiv_IDLE_NE_PREA (u7, (u8, cr)) (cnt2Bv c0) (cref2Bv c1) tr) as S.
- apply S in Href_prea_ as S'; clear S; destruct S' as [cs_nextcr H]; rewrite H.
-
- cbn [fst snd]; clear H.
- apply (CmdGen_equiv_idle_to_ref u5 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- apply (Update_equiv_idle_ref u3 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
- destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
-
- rewrite /Next_state Href_prea /State_Eq.
- specialize Queue_NF_WR_fst with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2 : {
- rewrite H /Enqueue /R NF.
- cbv [get_addr_RequestQueue] in Hwra'; rewrite Hwra'.
- cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'.
- by apply (EqQueue_aux wra rda r0 r1 r).
- }
- apply /andP; split.
- 2 : {
- rewrite H.
- cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
- rewrite /EqMem Hrw /Enqueue.
- autounfold with get_state; unfold R; rewrite NF.
- apply EqMem_rcons; done.
- }
- apply /andP; split.
- 2 : {
- rewrite H.
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end. cbn [fst snd]; simpl; rewrite VectorSpec.map_id.
- rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
- }
- rewrite H;
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd]. by [].
- Qed. *)
-
- Theorem SM_Eq_1a (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r :
- (nat_of_ord c1 == PREA_date - 1) = true ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Admitted.
- (* Proof.
- intros Href_prea f_state R NF EqR H; unfold FIFOSM_.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
- move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr].
-
- apply BVEq_iff_eq in EqS, EqCnt, EqCref,Hadr; subst s cnt cref.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
-
- apply cref_preadate_true in Href_prea as Href_prea_;
- apply BVEq_iff_eq in Href_prea_ as H'.
- cbv [and2]. cbn [fst snd].
- rewrite {1}H' CrefPREA_lt_CNT_REF_PREA andb_false_r.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (Queue_EMP_WR_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in Hadr as H; clear S; destruct H as [full_o H].
- rewrite H; clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- specialize NextCR_equiv with (c := (u7, (u8, cr))) (cnt := cnt2Bv c0)
- (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
- rewrite H; cbv [fst snd]; clear H.
-
- apply (CmdGen_equiv_idle_to_ref u5 (cnt2Bv c0) (cref2Bv c1) true) in Href_prea_ as H.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- apply (Update_equiv_idle_ref u3 (cnt2Bv c0) (cref2Bv c1) true) in Href_prea_ as H.
- destruct H as [cs_update H]; rewrite H; clear H.
-
- rewrite /Next_state Href_prea /State_Eq.
- specialize Queue_NF_WR_fst with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2 : {
- rewrite /Enqueue.
- rewrite (surjective_pairing (step RequestQueue' _ _)) H.
- cbv [get_addr_RequestQueue] in Hwra'; rewrite Hwra'; clear Hwra'.
- cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
- rewrite //= /R NF //= Hadr.
- apply /andP; split.
- { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
- specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
- by apply BVEq_iff_eq.
- }
- apply /andP; split.
- 2 : {
- rewrite /Enqueue.
- rewrite (surjective_pairing (step RequestQueue' _ _)) H.
- cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
- simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r VectorSpec.map_id.
- rewrite Hrw; autounfold with get_state; rewrite Hadr.
- specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req
- (Bvect_false REQUEST_WIDTH) c) as HH.
- rewrite HH; exact EqR.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H.
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd].
- rewrite //= VectorSpec.map_id.
- rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
- }
- rewrite (surjective_pairing (step RequestQueue' _ _)) H.
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; cbn [fst snd].
- by [].
- Qed. *)
-
- Theorem SM_Eq_NFULL (t : nat) (c_state : State_t) (f_req: Request_t)
- (c_req : Bvector REQUEST_WIDTH) (push : bool) :
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: f_req] -> EqReq f_req c_req -> State_Eq f_state c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R f_state in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- destruct (f_state) eqn:Hf_state.
- { destruct (nat_of_ord c0 == PREA_date - 1) eqn:Hcref_prea; move: Hcref_prea.
- { destruct r eqn:HR.
- { apply SM_Eq_1a. }
- { apply SM_Eq_1b. }
- }
- { destruct (c0 + WAIT < PREA_date) eqn:Hcref_service; move: Hcref_service.
- { destruct r eqn:HR.
- { apply SM_Eq_2a. }
- { apply SM_Eq_2b. }
- }
- { destruct r eqn:HR.
- { apply SM_Eq_3a. (* Case 3a: IDLE -> IDLE (empty queue )*) }
- { apply SM_Eq_3b. (* Case 3b: IDLE -> IDLE (non empty queue) *) }
- }
- }
- }
- { destruct (nat_of_ord c == OACT_date) eqn:Hact_date.
- { destruct r eqn:HR.
- { admit. (* Case 4a : RUNNING -> RUNNING (ACT) (empty queue) *) }
- { admit. (* Case 4b : RUNNING -> RUNNING (ACT) (non empty queue) *)}
- }
- { destruct (nat_of_ord c == OCAS_date) eqn:Hcas_date.
- { destruct r eqn:HR.
- { admit. (* Case 5a : RUNNING -> RUNNING (CAS) (empty queue )*) }
- { admit. (* Case 5b : RUNNING -> RUNNING (CAS) (non-empty queue) *)}
- }
- { destruct (nat_of_ord c == WAIT.-1) eqn:Hend_date.
- { destruct r eqn:HR.
- { admit. (* Case 6a : RUNNING -> IDLE (empty queue) *) }
- { admit. (* Case 6b : RUNNING -> IDLE (non empty queue) *)}
- }
- { destruct r eqn:HR.
- { admit. (* Case 7a : RUNNING -> RUNNING (empty queue) *) }
- { admit. (* Case 7b : RUNNING -> RUNNING (non empty queue) *) }
- }
- }
- }
- }
- { destruct (nat_of_ord c == OREF_date) eqn:Href_date.
- { destruct r eqn:HR.
- { admit. (* Case 8a REFRESHING -> REFRESHING (REF) *)}
- { admit. (* Case 8b REFRESHING -> REFRESHING (REF) *)}
- }
- { destruct (nat_of_ord c == OENDREF_date) eqn:Hendref_date.
- { destruct r eqn:HR.
- { admit. (* Case 9a REFRESHING -> IDLE*) }
- { admit. (* Case 9b REFRESHING -> IDLE *) }
- }
- { destruct r eqn:HR.
- { admit. (* Case 10a REFRESHING -> REFRESHING (REF) *) }
- { admit. (* Case 10b REFRESHING -> REFRESHING (REF) *) }
- }
- }
- }
- Admitted.
-
-End EquivalenceProof.
\ No newline at end of file
diff --git a/framework/CavaDRAM/CavaFIFOREF/CavaFIFOREF.v b/framework/CavaDRAM/CavaFIFOREF/CavaFIFOREF.v
deleted file mode 100644
index 1813e30..0000000
--- a/framework/CavaDRAM/CavaFIFOREF/CavaFIFOREF.v
+++ /dev/null
@@ -1,376 +0,0 @@
-Set Warnings "-notation-overridden,-parsing".
-
-From CavaDRAM Require Import CavaReqQueue CavaCommonInstances Util CavaSystem Memory.
-From DRAM Require Import FIFO.
-From Coq Require Import BinaryString HexString NArith Program.Equality.
-From Cava Require Import Cava.
-
-Section CavaFIFOREF.
-
- Context {CAVA_SYS : CavaSystem}.
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
-
- Import CavaReqQueue.DataNotation.
- Open Scope data_scope.
-
- Definition STATE_WIDTH := 2.
-
- Definition COUNTER_WIDTH := Nat.log2 (WAIT).
-
- Definition CNT_WAIT := Vec.bitvec_literal (#D (N.of_nat (WAIT - 1)) | COUNTER_WIDTH).
- Definition CNT_ACT := Vec.bitvec_literal (#D (N.of_nat ACT_date) | COUNTER_WIDTH).
- Definition CNT_CAS := Vec.bitvec_literal (#D (N.of_nat CAS_date) | COUNTER_WIDTH).
- Definition CNT_NIL := Vec.bitvec_literal (#D (N.of_nat 0) | COUNTER_WIDTH).
- Definition CNT_NIL_VEC := Vector.const false COUNTER_WIDTH.
-
- (* Definition COUNTER_REF_WIDTH := Nat.log2 (WAIT_REF). *)
- Definition COUNTER_REF_WIDTH :=
- if Nat.pow 2 (Nat.log2 (PREA_date + (WAIT - 1))) == (PREA_date + (WAIT - 1))
- then Nat.log2 (PREA_date + (WAIT - 1))
- else (Nat.log2 (PREA_date + (WAIT - 1))).+1.
-
- Definition state := Vec Bit STATE_WIDTH.
- Definition counter := Vec Bit COUNTER_WIDTH.
- Definition counter_ref := Vec Bit COUNTER_REF_WIDTH.
-
- Definition empty_t := signal Bit.
- Definition state_t := signal state.
- Definition counter_t := signal counter.
- Definition counter_ref_t := signal counter_ref.
-
- Definition NOP_VEC := (#B "11111" | DRAM_CMD_WIDTH).
- Definition NOP := Vec.bitvec_literal NOP_VEC.
- Definition PRE_VEC := (#B "10010" | DRAM_CMD_WIDTH).
- Definition PRE := Vec.bitvec_literal PRE_VEC.
- Definition ACT_VEC := (#B "10011" | DRAM_CMD_WIDTH).
- Definition ACT := Vec.bitvec_literal ACT_VEC.
- Definition RD_VEC := (#B "10101" | DRAM_CMD_WIDTH).
- Definition RD := Vec.bitvec_literal RD_VEC.
- Definition WR_VEC := (#B "10100" | DRAM_CMD_WIDTH).
- Definition WR := Vec.bitvec_literal WR_VEC.
- Definition PREA_VEC := (#B "10110" | DRAM_CMD_WIDTH).
- Definition PREA := Vec.bitvec_literal PREA_VEC.
- Definition REF_VEC := (#B "10001" | DRAM_CMD_WIDTH).
- Definition REF := Vec.bitvec_literal REF_VEC.
-
- Definition CNT_REF_WAIT := Vec.bitvec_literal (#D (N.of_nat (WAIT - 1)) | COUNTER_REF_WIDTH).
- Definition CNT_REF_PREA := Vec.bitvec_literal (#D (N.of_nat (PREA_date - 1)) | COUNTER_REF_WIDTH).
- Definition CNT_REF_REF := Vec.bitvec_literal (#D (N.of_nat REF_date) | COUNTER_REF_WIDTH).
- Definition CNT_REF_END := Vec.bitvec_literal (#D (N.of_nat END_REF_date) | COUNTER_REF_WIDTH).
- Definition CNT_REF_NIL := Vec.bitvec_literal (#D (N.of_nat 0) | COUNTER_REF_WIDTH).
- Definition CNT_REF_NIL_VEC := Vector.const false COUNTER_REF_WIDTH.
-
- Definition STATE_IDLE_VEC := Vector.const false STATE_WIDTH.
- Definition STATE_IDLE := Vec.bitvec_literal (#D 0 | STATE_WIDTH).
- Definition STATE_RUN_VEC := (#D 1 | STATE_WIDTH).
- Definition STATE_RUN := Vec.bitvec_literal STATE_RUN_VEC.
- Definition STATE_REF_VEC := (#D 2 | STATE_WIDTH).
- Definition STATE_REF := Vec.bitvec_literal STATE_REF_VEC.
-
- Definition Sidle (input : state_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,STATE_IDLE).
-
- Definition Srun (input : state_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,STATE_RUN).
-
- Definition Sref (input : state_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,STATE_REF).
-
- Definition CeqWAIT (input : counter_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_WAIT).
-
- Definition CeqCAS (input : counter_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_CAS).
-
- Definition CeqACT (input : counter_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_ACT).
-
- Definition CrefPREA_eq (input : counter_ref_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_REF_PREA).
-
- Definition CrefPREA_lt (input : counter_ref_t) : cava (signal Bit) :=
- t <- addN (input,CNT_REF_WAIT) ;;
- s <- greaterThanOrEqual (t,CNT_REF_PREA) ;; inv s.
-
- Definition CrefREF (input : counter_ref_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_REF_REF).
-
- Definition CrefEND (input : counter_ref_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_REF_END).
-
- (* Find a way to write this things more concisely *)
- Definition NextCR : Circuit
- (state_t * empty_t * counter_t * counter_ref_t * request_t) (request_t)
- := let state_init : combType (request) := Vector.const one (REQUEST_WIDTH) in
- LoopInit state_init (
- Comb (fun '(s,e,c,cref,tr,cr) =>
- (* signals *)
- s_idle <- Sidle s ;;
- s_run <- Srun s ;;
- (* s_ref <- Sref s ;; *)
- nc_wait <- (CeqWAIT >=> inv) c ;;
- c_prea <- (CrefPREA_lt) cref ;;
- ne <- inv e ;;
- (* first mux *)
- mux1_sel <- and2(s_run,nc_wait) ;;
- mux1_out <- mux2 mux1_sel (REQUEST_NIL,cr) ;;
- (* second mux *)
- t0 <- and2 (ne,c_prea) ;;
- mux2_sel <- and2 (s_idle,t0) ;;
- mux2_out <- mux2 mux2_sel (mux1_out,tr) ;;
- ret (mux2_out,mux2_out)
- )).
-
- Definition CmdGen : Circuit
- (state_t * empty_t * counter_t * counter_ref_t * request_t) (command_t) :=
- Comb (fun '(s,e,c,cref,req) =>
- (* signals *)
- s_idle <- Sidle s ;;
- s_run <- Srun s ;;
- s_ref <- Sref s ;;
- c_cas <- CeqCAS c ;;
- c_act <- CeqACT c ;;
- c_prea <- CrefPREA_eq cref ;;
- c_prea' <- CrefPREA_lt cref ;;
- (* c_prea_n <- inv c_prea ;; *)
- c_ref <- CrefREF cref ;;
- ne <- inv e ;;
- (* REF mux *)
- ref_mux_sel <- and2 (s_ref,c_ref) ;;
- ref_mux_out <- mux2 ref_mux_sel (NOP,REF) ;;
- (* PREA mux *)
- prea_mux_sel <- and2 (s_idle,c_prea) ;;
- prea_mux_out <- mux2 prea_mux_sel (ref_mux_out,PREA);;
- (* CAS mux *)
- rd_wr_mux_sel <- RequestType (req) ;;
- rd_wr_mux_out <- mux2 rd_wr_mux_sel (RD,WR) ;;
- cas_mux_sel <- and2 (s_run,c_cas) ;;
- cas_mux_out <- mux2 cas_mux_sel (prea_mux_out,rd_wr_mux_out) ;;
- (* ACT mux *)
- act_mux_sel <- and2 (s_run,c_act) ;;
- act_mux_out <- mux2 act_mux_sel (cas_mux_out,ACT) ;;
- (* PRE mux *)
- t0 <- and2 (ne,c_prea') ;;
- pre_mux_sel <- and2 (s_idle,t0) ;;
- mux2 pre_mux_sel (act_mux_out,PRE)
- ).
-
- Definition Update_s (input : state_t * empty_t * counter_t * counter_ref_t) :
- cava (state_t) := let '(s,e,c,cref) := input in
- s_idle <- Sidle s ;;
- s_run <- Srun s ;;
- s_ref <- Sref s ;;
- nc_eqwait <- (CeqWAIT >=> inv) c ;;
- (* true if there is enough time to treat a request *)
- c_service <- CrefPREA_lt cref ;;
- (* true if it is refresh time *)
- c_prea <- CrefPREA_eq cref ;;
- nc_refend <- (CrefEND >=> inv) cref ;;
- ne <- inv e ;;
- (* first mux *)
- t0 <- and2 (ne,c_service) ;;
- t1 <- and2 (s_idle,t0) ;;
- t2 <- and2 (s_run,nc_eqwait) ;;
- mux_idle_run_sel <- or2 (t1,t2) ;;
- mux_idle_run_out <- mux2 mux_idle_run_sel (STATE_IDLE,STATE_RUN) ;;
- (* second mux *)
- t3 <- and2 (s_ref,nc_refend) ;;
- t4 <- and2 (s_idle,c_prea) ;;
- mux_ref_sel <- or2 (t3,t4) ;;
- mux2 mux_ref_sel (mux_idle_run_out,STATE_REF).
-
- Definition Update_c (input : state_t * empty_t * counter_t * counter_ref_t) :
- cava (counter_t) := let '(s,e,c,cref) := input in
- s_idle <- Sidle s ;;
- s_ref <- Sref s ;;
- c_eqwait <- CeqWAIT c ;;
- c_prea <- CrefPREA_lt cref ;;
- c_refend <- CrefEND cref ;;
- ne <- inv e ;;
- (* mux logic *)
- t1 <- and2 (s_ref,c_refend) ;;
- t2 <- and2 (c_prea,ne) ;;
- t3 <- and2 (s_idle,t2) ;;
- t4 <- or2 (t3,t1) ;;
- mux_sel <- or2 (c_eqwait,t4) ;;
- cp1 <- incrN c ;;
- mux2 mux_sel (cp1,CNT_NIL).
-
- Definition Update_cref (input : state_t * empty_t * counter_t * counter_ref_t) :
- cava (counter_ref_t) := let '(s,_,_,cref) := input in
- s_idle <- Sidle s ;;
- s_ref <- Sref s ;;
- cref_prea <- CrefPREA_eq cref ;;
- cref_end <- CrefEND cref ;;
- t0 <- and2 (s_ref,cref_end) ;;
- t1 <- and2 (s_idle,cref_prea) ;;
- mux2_sel <- or2 (t0,t1) ;;
- crefp1 <- incrN cref ;;
- mux2 mux2_sel (crefp1,CNT_REF_NIL).
-
- Definition Update_ : Circuit
- (state_t * empty_t * counter_t * counter_ref_t)
- (state_t * counter_t * counter_ref_t) :=
- Comb (fun '(s,e,c,cref) =>
- s' <- Update_s (s,e,c,cref) ;;
- c' <- Update_c (s,e,c,cref) ;;
- cref' <- Update_cref (s,e,c,cref) ;;
- ret (s',c',cref')
- ).
-
- Definition FIFOSM_ : Circuit
- (signal Bit * signal (Vec Bit REQUEST_WIDTH))
- (signal Bit * signal (Vec Bit DRAM_CMD_WIDTH) * signal (Vec Bit REQUEST_WIDTH)) :=
- let s_init : combType (state) := STATE_IDLE_VEC in
- let cnt_init : combType (counter) := CNT_NIL_VEC in
- let cref_init : combType (counter_ref) := CNT_REF_NIL_VEC in
- LoopInit s_init ( (* Rp, Rd, s *)
- LoopInit cnt_init ( (* Rp, Rd, s, cnt *)
- LoopInit cref_init ( (* Rp, Rd, s, cref, cref *)
- Comb (fun '(Rp,Rd,s,cnt,cref) =>
- s_idle <- Sidle s ;;
- c_service <- CrefPREA_lt cref ;;
- pop <- and2 (s_idle,c_service) ;;
- ret(s,cnt,cref,(Rp,Rd,pop))
- ) >==>
- Second (RequestQueue') >==>
- Comb (fun '(s,c,cref,(full,data,empty)) => ret (full,s,empty,c,cref,(s,empty,c,cref,data)))
- >==> Second (NextCR) >==>
- Comb (fun '(full,s,e,c,cref,cr) => ret (full,cr,s,e,c,cref,(s,e,c,cref,cr)))
- >==> Second (CmdGen) >==>
- Comb (fun '(full,cr,s,e,c,cref,cmd) => ret (full,cmd,cr,(s,e,c,cref)))
- >==> Second (Update_) >==>
- Comb (fun '(full,cmd,cr,(ns,nc,ncref)) => ret (full,cmd,cr,ns,nc,ncref))))).
-
-End CavaFIFOREF.
-
-Section SimCodeGen.
-
- Existing Instance CavaCombinationalNet.
-
- (* Defined in CommonInstances *)
- Existing Instance SYS_CFG.
- Existing Instance CAVA_SYS.
-
- Program Instance FIFO_CFG : FIFO_configuration := {
- (* orig: 65 *)
- WAIT := 32;
- }.
-
- Definition fifo_interface
- := sequentialInterface "fifo_interface"
- "clk" PositiveEdge "rst" PositiveEdge
- [mkPort "Rp" Bit; mkPort "Rd" (Vec Bit REQUEST_WIDTH)]
- [mkPort "full_o" Bit; mkPort "cmd_o" (Vec Bit DRAM_CMD_WIDTH); mkPort "CR" (Vec Bit REQUEST_WIDTH)].
-
- Definition sm_netlist := makeCircuitNetlist fifo_interface FIFOSM_.
-
- (* Compute circuit_state memqueue'.
- Compute circuit_state RequestQueue'.
- Compute circuit_state FIFOSM_.
-
- Compute circuit_state NextCR. *)
-
- (* Compute circuit_state FIFOSM. *)
-
- (* Compute circuit_state memqueue'. *)
-
- (* Compute circuit_state memqueue'. *)
- (* Compute circuit_state *)
-
- (*
- Import CavaSM.DataNotation.
- Open Scope data_scope.
- Definition Rsim1_wr := #H "00fe468b00000" | REQUEST_WIDTH.
- Definition Rsim1_rd := #H "00fe468b10000" | REQUEST_WIDTH.
- Definition Rsim2_wr := #H "027f234500001" | REQUEST_WIDTH.
- Definition Rsim2_rd := #H "027f234510001" | REQUEST_WIDTH.
- Definition Rsim3_wr := #H "033f91a200001" | REQUEST_WIDTH.
- Definition Rsim3_rd := #H "033f91a210001" | REQUEST_WIDTH.
- Definition Rsim5_wr := #H "00467f2300007" | REQUEST_WIDTH.
-
- (* Compute simulate RequestTypeCircuit [Rsim1_wr; Rsim1_rd; Rsim2_wr; Rsim2_rd; Rsim3_wr; Rsim3_rd; Rsim5_wr]. *)
-
- Definition SM_out := (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH)%type.
-
- Definition cmd2string (cmd : Vector.t bool DRAM_CMD_WIDTH) : string :=
- let eq := Vector.eqb bool eqb cmd in if eq NOP_VEC then "NOP"
- else if eq PRE_VEC then "PRE"
- else if eq ACT_VEC then "ACT"
- else if eq RD_VEC then "RD"
- else if eq WR_VEC then "WR"
- else if eq PREA_VEC then "PREA"
- else if eq REF_VEC then "REF"
- else "INVALID".
-
- Infix "+s+" := String.append (at level 0).
-
- Definition tuple2string (e : SM_out) : (string) :=
- let '(full,cmd,req) := e in
- let full_str := if full then "FULL, " else "NOT FULL, " in
- let cmd_str := cmd2string cmd in
- let req_N := HexString.of_N (Bv2N req) in (full_str +s+ cmd_str +s+ " ," +s+ req_N).
-
- Fixpoint index_ {T} (e : seq T) : seq nat :=
- match e with
- | [::] => [0]
- | x :: s => [length e] ++ (index_ s)
- end.
-
- Definition map_out (input : seq (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH))
- := zip (rev (index_ input)) (map (tuple2string) input).
-
- Definition map_queue_out (e : seq (bool * Vector.t bool REQUEST_WIDTH * bool))
- := map (fun '(full,data,empty) => (full,HexString.of_N (Bv2N data),empty)) e.
-
- Definition state2string (s : Vector.t bool STATE_WIDTH) : string :=
- let eq := Vector.eqb bool eqb s in if eq STATE_IDLE_VEC then "IDLE"
- else if eq STATE_RUN_VEC then "RUNNING"
- else if eq STATE_REF_VEC then "REFRESHING"
- else "STATE INVALID".
-
- Definition map_update_out (e : seq (Vector.t bool STATE_WIDTH * bool * Vector.t bool COUNTER_WIDTH *
- Vector.t bool COUNTER_REF_WIDTH))
- := map (fun '(s,e,cnt,cref) => (state2string s,e,Bv2N cnt,Bv2N cref)) e.
-
- (* Compute map_queue_out (simulate RequestQueue [
- (true,Rsim1_wr,false);
- (true,Rsim1_rd,false)
- ]).
-
- Compute (map HexString.of_N (map Bv2N (simulate NextCR [
- (STATE_IDLE_VEC,true,CNT_NIL,CNT_REF_NIL,REQUEST_NIL);
- (STATE_IDLE_VEC,false,(#D 1 | COUNTER_WIDTH),(#D 1 | COUNTER_REF_WIDTH),Rsim1_wr)
- ]))).
-
- Compute (map BinaryString.of_N (map Bv2N (simulate CmdGen [
- (STATE_IDLE_VEC,true,CNT_NIL,CNT_REF_NIL,REQUEST_NIL);
- (STATE_IDLE_VEC,false,(#D 1 | COUNTER_WIDTH),(#D 1 | COUNTER_REF_WIDTH),Rsim1_wr))
- ]))).
-
- Compute (map_update_out (simulate Update [
- (STATE_IDLE_VEC,true,CNT_NIL,CNT_REF_NIL)
- ])). *)
-
- Open Scope seq_scope.
- Definition sm_inputs := [
- (true,Rsim1_wr);
- (true,Rsim1_rd);
- (true,Rsim2_wr);
- (true,Rsim2_rd);
- (true,Rsim3_wr);
- (true,Rsim3_rd)
- ] ++ (repeat (false,REQUEST_NIL) 20).
- Close Scope seq_scope.
-
- Compute (map_out (simulate FIFOSM sm_inputs)).
-
- Definition expected_out := simulate FIFOSM sm_inputs.
-
- Definition sm_tb :=
- testBench "sm_tb" (sm_interface) sm_inputs expected_out.
-
- *)
-End SimCodeGen.
\ No newline at end of file
diff --git a/framework/CavaDRAM/CavaFIFOREF/CavaFIFOREFProperties.v b/framework/CavaDRAM/CavaFIFOREF/CavaFIFOREFProperties.v
deleted file mode 100644
index 1e336a4..0000000
--- a/framework/CavaDRAM/CavaFIFOREF/CavaFIFOREFProperties.v
+++ /dev/null
@@ -1,1630 +0,0 @@
-Set Printing Projections.
-Set Warnings "-notation-overridden,-parsing".
-
-From CavaDRAM Require Import CavaFIFOREF CavaSM CavaReqQueue CavaCommonInstances CavaSubtractor Step CavaSystem Memory Util UtilSM.
-From CoqDRAM Require Import FIFO.
-From Coq Require Import Program BinaryString HexString NArith.
-From Cava Require Import Cava CavaProperties Util.Vector Util.Tactics.
-From mathcomp Require Import fintype ssrZ zify ring.
-
-Section CavaFIFOREFProperties.
-
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
- (* From Cava *)
- Existing Instance CombinationalSemantics.
- (* From CavaDRAM*)
- Context {CAVA_SYS : CavaSystem}.
- (* From CoqDRAM *)
- Existing Instance REQESTOR_CFG.
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
- Context {HAF : HW_Arrival_function_t}.
- Existing Instance ARBITER_CFG.
- Existing Instance FIFO_implementation.
-
- Import Memory.Properties BvectorNotations.
- Open Scope Bvector_scope.
-
- Lemma leq_Nle (a b : N) :
- leq (nat_of_bin a) (nat_of_bin b) -> (a <= b)%N.
- Proof.
- lia.
- Qed.
-
- Lemma ltn_Ntn (a b : N) :
- leq (S (nat_of_bin a)) (nat_of_bin b) -> (a < b)%N.
- Proof.
- lia.
- Qed.
-
- Lemma log2_eq1_pw2 (n : nat) :
- Nat.pow 2 (Nat.log2 n) = n ->
- Nat.log2 n = 1 -> n = 2.
- Proof.
- intros. by rewrite H0 in H.
- Qed.
-
- Lemma Bv_eq_translation {n} (a b : Bvector n) :
- (nat_of_bin (Bv2N a) = nat_of_bin (Bv2N b)) ->
- (Bv2N a = Bv2N b)%N.
- Proof.
- lia.
- Qed.
-
- Lemma Bv_ltn_translation {n} (a b : Bvector n) :
- (nat_of_bin (Bv2N a) < nat_of_bin (Bv2N b)) ->
- (Bv2N a < Bv2N b)%N.
- Proof.
- lia.
- Qed.
-
- Lemma lt_trans_le (n m p : N):
- (m < n)%N -> (n < p)%N -> (m + 1 < p)%N.
- Proof.
- lia.
- Qed.
-
- Lemma to_nat_lt_of_nat (a : N) (n : nat) :
- N.to_nat a < n -> (a < N.of_nat n)%N.
- Proof.
- intros.
- induction n; [ discriminate | ].
- rewrite leq_eqVlt in H; move: H => /orP [/eqP H | H].
- { rewrite -H Nat2N.inj_succ N2Nat.id; by specialize (N.lt_succ_diag_r a). }
- assert (N.to_nat a < n).
- { specialize (ltn_add2r 1 (N.to_nat a) n) as S; rewrite !addn1 in S; by rewrite S in H. }
- apply IHn in H0.
- apply N.lt_trans with (m := N.of_nat n); [ done | ].
- rewrite Nat2N.inj_succ; by specialize (N.lt_succ_diag_r (N.of_nat n)).
- Qed.
-
- Lemma to_nat_lt_pow a b:
- N.to_nat a < Nat.pow 2 b -> (a < 2 ^ N.of_nat b)%N.
- Proof.
- intros; apply to_nat_lt_of_nat in H.
- rewrite -Nat2N.inj_pow in H.
- by simpl (N.of_nat 2) in H.
- Qed.
-
- Lemma length_to_list_shiftin {A N} (v : Vector.t A N) (e : A) :
- Datatypes.length (Vector.to_list (Vector.shiftin e v)) = N + 1.
- Proof.
- induction v; [ rewrite //= | ].
- unfold Vector.shiftin; fold @Vector.shiftin.
- rewrite to_list_cons cons_length IHv; lia.
- Qed.
-
- Lemma last_shiftin {A N} (v : Vector.t A N) (def e : A) :
- last (Vector.to_list (Vector.shiftin e v)) def = e.
- Proof.
- induction v; [ rewrite //= | ].
- unfold Vector.shiftin; fold @Vector.shiftin.
- rewrite to_list_cons //=.
- destruct (Vector.to_list (Vector.shiftin e v)) eqn:Hbug;
- [ contradict Hbug; induction v; simpl; done | ].
- done.
- Qed.
-
- Lemma Bv2N_upper_bound {n : nat} (bv : Bvector n) :
- (N.to_nat (Bv2N bv) < (Nat.pow 2 n)).
- Proof.
- induction bv; [ by simpl | ]; destruct h; rewrite Bv2N_cons.
- { rewrite N.succ_double_spec.
- set z := Bv2N _; fold z in IHbv.
- rewrite N2Nat.inj_add N2Nat.inj_mul.
- vm_compute (N.to_nat 1); vm_compute (N.to_nat 2).
- assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
- assert ((2 * N.to_nat z + 1)%coq_nat = (2 * N.to_nat z + 1)%nat); try done; rewrite H; clear H.
- apply ltn_mul_add1 in IHbv.
- rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ].
- assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H. }
- { rewrite N.double_spec N2Nat.inj_mul; set z := Bv2N _; fold z in IHbv; vm_compute (N.to_nat 2).
- assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
- have aux : (0 < 2); [ done | ].
- have H := (ltn_pmul2l aux); rewrite -H in IHbv.
- rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ]; clear H.
- assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H.
- }
- Qed.
-
- Lemma size_nat_sub_leq {n} (a b : Bvector n):
- (Bv2N b <= Bv2N a)%N ->
- N.size_nat (Bv2N a - Bv2N b) <= n.
- Proof.
- intros; apply /leP; apply N.size_nat_le.
- specialize (@Bv2N_upper_bound n a) as Ha.
- specialize (@Bv2N_upper_bound n b) as Hb.
- destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try discriminate.
- { simpl in *; by apply to_nat_lt_pow. }
- { rewrite N.sub_0_r; by apply to_nat_lt_pow in Ha. }
- { by contradict H. }
- { apply to_nat_lt_pow in Ha,Hb.
- apply (N.lt_trans (N.pos p0 - N.pos p) (N.pos p0) (2 ^ N.of_nat n)%N); [ | done].
- apply N.sub_lt; done.
- }
- Qed.
-
- Lemma N2Bv_sized_eq_p1_false {W} (v : Bvector W):
- W > 0 -> (N2Bv_sized W (Bv2N v + 1) =? v) = false.
- Proof.
- intros; apply BVEq_iff_neq.
- rewrite N.add_1_r.
- specialize (N2Bv_sized_Bv2N W v) as H0; rewrite -{2}H0.
- by apply N2Bv_sized_neq_succ.
- Qed.
-
- Lemma cons_eq {n} (x : bool) (a b : Vector.t bool n):
- (x :: a)%vector =? (x :: b)%vector ->
- BVeq n n a b.
- Proof.
- Admitted.
-
- Lemma Bvector_wrap {W} (v : Bvector W) :
- W > 0 -> N2Bv_sized W (Bv2N (N2Bv_sized W (Bv2N v + 1)) + 1) =? v ->
- W = 1.
- Proof.
- intros Hpos H.
- induction v; intros; try discriminate.
- rewrite ltnS leq_eqVlt in Hpos; move: Hpos => /orP [/eqP Heq | Hpos];
- [ by subst n | ].
- apply (IHv) in Hpos as IH; clear IHv.
- 2: {
- destruct h; simpl in H; [
- rewrite N.succ_double_succ N2Bv_sized_double Bv2N_cons N.double_succ_double
- N2Bv_sized_succ_double N2Bv_sized_Bv2N in H |
- rewrite N.double_succ_double N2Bv_sized_succ_double Bv2N_cons N.succ_double_succ
- N2Bv_sized_double N2Bv_sized_Bv2N in H ];
- apply cons_eq in H;
- specialize (@N2Bv_sized_eq_p1_false n v) as HH; apply HH in Hpos;
- by rewrite Hpos in H.
- }
- revert H; generalize v; clear v; rewrite IH; intros.
- simpl in H; destruct h; rewrite (Vector.eta v) in H;
- specialize (@tl_0 bool v) as H0; rewrite H0 in H;
- destruct (VectorDef.hd v); simpl in H; discriminate H.
- Qed.
-
- (* --------------------------------------------------------------- *)
- (* Start of FIFO specific proofs *)
- Lemma N2Bv_sized_queuemax_neq0 :
- N2Bv_sized ADDR_WIDTH 0 <> N2Bv_sized ADDR_WIDTH (N.of_nat QUEUE_MAX_SIZE - 1).
- Proof.
- apply N2Bv_sized_neq_iff; unfold ADDR_WIDTH.
- { rewrite /N.size_nat /Nat.log2 //=. }
- { rewrite -N.pred_sub -Nat2N.inj_pred.
- apply /leP; apply N.size_nat_le_nat.
- rewrite QUEUE_MAX_SIZE_PW2; apply /leP.
- rewrite ltn_predL; apply /leP.
- exact QUEUE_MAX_SIZE_GT_0. }
- { rewrite -N.pred_sub -Nat2N.inj_pred.
- specialize QUEUE_MAX_SIZE_DIFF_0 as HH.
- move: HH => /N.eqb_spec HH.
- by apply /N.eqb_spec.
- }
- Qed.
-
- Definition mem_cells_ :=
- mem_cells (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem.
-
- Lemma shiftin_nth_default {A} (def : A) (a : A) n (v: Vector.t A n) (k1 k2 : nat) (eq: k1 = k2):
- k1 < n ->
- nth_default def k1 (Vector.shiftin a v) = nth_default def k2 v.
- Admitted.
-
- (* --------------------------------------------------------------- *)
- (* Solving the memory problem *)
-
- Lemma nth_cells_read {T W I} (ad : Bvector W) c_req def
- (c : circuit_state (mem_cells T W (2 ^ W) I)) :
- nth_default def (N.to_nat (Bv2N ad)) (Cells_read true (N.to_nat (Bv2N ad)) c_req c) = c_req.
- Admitted.
-
- Lemma nth_cells_read_ {T W I N} (ad : Bvector (Nat.log2 N)) c_req def
- (c : circuit_state (mem_cells T W N I)) : N > 0 ->
- nth_default def (N.to_nat (Bv2N ad)) (Cells_read true (N.to_nat (Bv2N ad)) c_req c) = c_req.
- Proof.
- intros Hpos; rewrite nth_default_to_list.
- induction N; intros; [ discriminate | ].
- rewrite leq_eqVlt in Hpos; move: Hpos => /orP [/eqP Heq | Hpos].
- { assert (N = 0); [ lia | ]; clear IHN Heq; subst N.
- revert ad; rewrite Nat.log2_1; intros.
- apply Vector.case0 with (v := ad).
- simpl in c; destruct_products.
- rewrite /Cells_read //= andb_true_r.
- }
- assert (0 < N); [ lia | ]; clear Hpos.
- simpl in c; destruct_products; rewrite //= andb_true_r.
- specialize (Nat.log2_succ_or N) as Hor; destruct Hor as [Hor | Hor].
- { revert ad; rewrite Hor; intros.
- destruct (Nat.eqb (N.to_nat (Bv2N ad)) N) eqn:HH; set memvec := Cells_read true _ _ _.
- { assert (N.to_nat (Bv2N ad) = N) as H0; [ lia | ]; clear HH;
- rewrite H0.
- specialize (@length_to_list_shiftin (combType T) N memvec c_req) as HH.
- assert (N = (Datatypes.length (Vector.to_list (Vector.shiftin c_req memvec))) - 1)%coq_nat; [ lia | ].
- apply nth_last with (d := def) in H1; rewrite H1.
- by rewrite last_shiftin. }
- { unfold memvec.
- specialize (IHN (VectorDef.tl ad) c0); apply IHN in H as IH; clear IHN.
- rewrite (Vector.eta ad) Bv2N_cons.
- destruct (Vector.hd ad).
- { rewrite N2Nat.inj_succ_double //= !Nat.add_0_r.
- rewrite -nth_tl.
- set adtl := N.to_nat (Bv2N (VectorDef.tl ad)).
- fold adtl in IH.
- admit. }
- { admit. }
- Admitted.
- (*-----------------------------------------------------------------------------------*)
-
- Lemma memcell_nch (c: circuit_state mem_cells_) (wra rda : Bvector ADDR_WIDTH) c_req def:
- wra <> rda ->
- nth_default def (N.to_nat (Bv2N rda)) (Cells_data c) =
- nth_default def (N.to_nat (Bv2N rda)) (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
- Admitted.
-
- (* Need a to be bigger than b *)
- Lemma size_nat_qms_sub (a b: Bvector ADDR_WIDTH) :
- (Bv2N b < Bv2N a)%N ->
- N.size_nat (N.of_nat QUEUE_MAX_SIZE - (Bv2N a - Bv2N b)) <= ADDR_WIDTH.
- Proof.
- intros Hlt; apply /leP.
- destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try done;
- apply N.size_nat_le; unfold ADDR_WIDTH; rewrite QUEUE_MAX_SIZE_PW2_N; try rewrite N.sub_0_r.
- { apply N.sub_lt; [ | done].
- unfold ADDR_WIDTH in a,b.
- specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
- rewrite QUEUE_MAX_SIZE_PW2 in Ha.
- rewrite Ha0 in Ha.
- apply to_nat_lt_of_nat in Ha.
- apply N.le_lteq; left; exact Ha.
- }
- { apply N.sub_lt; [ | apply N.lt_add_lt_sub_l; by rewrite N.add_0_r ].
- unfold ADDR_WIDTH in a,b.
- specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
- rewrite QUEUE_MAX_SIZE_PW2 in Ha.
- specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) b) as Hb.
- rewrite QUEUE_MAX_SIZE_PW2 in Hb.
- apply to_nat_lt_of_nat in Ha,Hb; rewrite Ha0 in Ha; rewrite Hb0 in Hb.
- apply N.le_sub_le_add_l; rewrite N.add_comm.
- apply N.lt_trans with (m := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (n := N.pos p0)
- (p := N.add (N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (N.pos p)) in Ha as H;
- [ apply N.le_lteq; by left | ].
- apply N.lt_add_pos_r; done.
- }
- Qed.
-
- Lemma size_nat_qms :
- N.size_nat (N.of_nat QUEUE_MAX_SIZE - 1) <= Nat.log2 QUEUE_MAX_SIZE.
- Proof.
- rewrite N.sub_1_r -Nat2N.inj_pred.
- apply /leP; apply N.size_nat_le_nat.
- rewrite QUEUE_MAX_SIZE_PW2.
- apply /ltP; rewrite ltn_predL; apply /ltP.
- exact QUEUE_MAX_SIZE_GT_0.
- Qed.
-
- Definition State_t := circuit_state FIFOSM.
-
- Definition get_mem (s : State_t) : circuit_state memqueue' :=
- let '(_,(_,(_,(_,_,_,memqueue_state,_,_,_,_,_),_),_,_)) := s in memqueue_state.
-
- Definition get_pop (s : State_t) :=
- let '(_,(_,_,_,pop)) := s in pop.
-
- Definition get_st (s : State_t) :=
- let '(_,(_,_,(_,(_,_,st)),_)) := s in st.
-
- Definition get_cnt (s : State_t) :=
- let '(_,(_,_,(_,(_,(_,_,cnt),_)),_)) := s in cnt.
-
- Definition get_cref (s : State_t) :=
- let '(_,(_,_,(_,(_,(_,(_,_,_,_,_,_,_,cref),_),_)),_)) := s in cref.
-
- Definition get_cr (s : State_t) :=
- let '(_,(_,_,(_,(_,(_,(_,(_,(_,cr)),_,_,_,_,_,_),_),_)),_)) := s in cr.
-
- Definition get_wra (s : State_t) :=
- let '(_,(_,(_,_,wra),_,_)) := s in wra.
-
- Definition get_rda (s : State_t) :=
- let '(_,(_,(_,(_,_,_,_,_,_,_,_,rda),_),_,_)) := s in rda.
-
- Definition get_reqqueue (s : State_t) : circuit_state RequestQueue' :=
- let '(_,(cs_requeue,_,_)) := s in cs_requeue.
-
- Definition get_mem_RequestQueue (c : circuit_state RequestQueue') :=
- let '(_,(_,(_,_, _,memqueue_state,_,_,_,_,_),_)) := c in memqueue_state.
-
- Definition get_addr_RequestQueue (c : circuit_state RequestQueue') :=
- let '(_,(_,(_,_, _,_,_,_,_,_,rda),wra)) := c in (wra,rda).
-
- Definition get_memcells (s : circuit_state memqueue') :=
- let '(_,memcells_state,_) := s in memcells_state.
-
- Definition get_memcells_RequestQueue (c : circuit_state RequestQueue') :=
- get_memcells (get_mem_RequestQueue c).
-
- (* --------------------------Bounding the counter ------------------- *)
- Lemma cnt_bounded (cnt : Bvector COUNTER_WIDTH) :
- N.to_nat (Bv2N cnt) < WAIT.
- Proof.
- specialize @Bv2N_upper_bound with (bv := cnt) as H.
- by rewrite /COUNTER_WIDTH WAIT_PW_2 in H.
- Qed.
-
- Definition Bv2cnt (cnt : Bvector COUNTER_WIDTH) : Counter_t :=
- Ordinal (cnt_bounded cnt).
-
- Definition cnt2Bv (cnt : Counter_t) :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
- (* ------------------------------------------------------------------ *)
-
- (* --------------------------Bounding cref counter ------------------- *)
- Lemma cref_bounded (cref : Bvector COUNTER_REF_WIDTH) :
- N.to_nat (Bv2N cref) < WAIT_REF.
- Proof.
- specialize @Bv2N_upper_bound with (bv := cref) as H.
- by rewrite /COUNTER_REF_WIDTH WAIT_REF_PW2 in H.
- Qed.
-
- Definition Bv2cref (cnt : Bvector COUNTER_REF_WIDTH) : Counter_ref_t :=
- Ordinal (cref_bounded cnt).
-
- Definition cref2Bv (cref : Counter_ref_t) :=
- N2Bv_sized COUNTER_REF_WIDTH (N.of_nat (nat_of_ord cref)).
- (* ------------------------------------------------------------------ *)
-
- Lemma cref_preadate_false (c : Counter_ref_t) :
- (cref2Bv c =? CNT_REF_PREA) = false <->
- (nat_of_ord c == PREA_date - 1) = false.
- Proof.
- split. {
- unfold cref2Bv, CNT_REF_PREA; intros.
- apply BVEq_iff_neq in H; rewrite bitvec_literal_correct in H.
- apply N2Bv_sized_neq_if in H.
- apply of_nat_neq in H.
- by apply /eqP.
- }
- { intros.
- apply BVEq_iff_neq.
- rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct.
- apply N2Bv_sized_neq_iff; [ | | move: H => /eqP H; by rewrite Nat2N.inj_iff ];
- apply /leP; apply N.size_nat_le_nat; unfold COUNTER_REF_WIDTH; apply /leP;
- rewrite WAIT_REF_PW2; [ by destruct c | specialize WAIT_REF_PREA_date as HH; by lia ].
- }
- Qed.
-
- Lemma cref_preadate_true (c : Counter_ref_t) :
- (cref2Bv c =? CNT_REF_PREA) = true <->
- (nat_of_ord c == PREA_date - 1) = true.
- Proof.
- split.
- { unfold cref2Bv, CNT_REF_PREA; intros.
- apply BVEq_iff_eq in H; rewrite bitvec_literal_correct in H.
- apply N2Bv_sized_eq_iff in H.
- { apply Nat2N.inj in H; rewrite H; by apply /eqP. }
- { apply N.size_nat_le_nat.
- destruct c; simpl in *; rewrite /COUNTER_REF_WIDTH; apply /ltP.
- by rewrite WAIT_REF_PW2. }
- { apply N.size_nat_le_nat; unfold COUNTER_REF_WIDTH.
- rewrite WAIT_REF_PW2 subn1; apply /ltP.
- specialize WAIT_REF_PREA_date as HH.
- apply ltn_trans with (m := PREA_date.-1) in HH; [ exact HH | ].
- by rewrite ltn_predL PREA_date_pos.
- }
- }
- { intros Href_prea; move: Href_prea => /eqP Href_prea; apply BVEq_iff_eq.
- rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct; f_equal.
- by rewrite Href_prea.
- }
- Qed.
-
- Definition fullQueue (wa ra : Bvector ADDR_WIDTH) : bool :=
- let waN := Bv2N wa in
- let raN := Bv2N ra in
- let qms := N.sub (N.of_nat QUEUE_MAX_SIZE) 1 in
- if (raN <= waN)%nat then ((Bv2N wa - Bv2N ra)%N == qms)
- else (((N.add qms 1) - (raN - waN))%N == qms).
-
- Hypothesis HaltIfFull : forall t c,
- let wra := get_wra c in
- let rda := get_rda c in
- if (HW_Arrival_at t != []) then ~~ fullQueue wra rda else true.
-
- Program Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
- Admitted.
-
- Lemma EqReqNil : EqReq nullreq REQUEST_NIL = true.
- Admitted.
-
- Definition EqCmd (f_cmd : Command_kind_t) (c_cmd : Bvector DRAM_CMD_WIDTH) : bool :=
- match f_cmd with
- | ACT => (c_cmd =? ACT_VEC)
- | PRE => (c_cmd =? PRE_VEC)
- | PREA => (c_cmd =? PREA_VEC)
- | CRD => (c_cmd =? RD_VEC)
- | CWR => (c_cmd =? WR_VEC)
- | REF => (c_cmd =? REF_VEC)
- | NOP => (c_cmd =? NOP_VEC)
- end.
-
- Fixpoint EqQueue (P : Requests_t) (wra rda : Bvector ADDR_WIDTH) :=
- match P with
- | [::] => (wra =? rda)
- | x :: x0 => negb (wra =? rda) && (EqQueue x0 wra (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1)))
- end.
-
- Lemma EqQueue_diff_adr r0 r1 wra rda:
- EqQueue (r0 :: r1) wra rda -> wra <> rda.
- Proof.
- simpl; intros; move: H => /andP [Hd H];
- by move: Hd => /negPf Hd; apply BVEq_iff_neq in Hd.
- Qed.
-
- Lemma EqQueue_aux wra rda r0 r1 r:
- ~~ fullQueue wra rda -> wra <> rda ->
- EqQueue (r0 :: r1)%SEQ wra rda ->
- EqQueue ((r0 :: r1)%SEQ ++ [r])%SEQ (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) rda.
- Proof.
- intros NFULL Hadr HQ; rewrite //=.
- simpl in HQ; move: HQ => /andP [_ HQ].
- revert HQ Hadr NFULL; generalize wra rda; induction r1; intros; simpl in HQ.
- { apply /andP; split.
- { unfold fullQueue in NFULL.
- move: NFULL; apply contraPN; intros; apply /negP; rewrite negb_involutive.
- specialize ADDR_WIDTH_pos as Hawp; move: Hawp => /ltP Hawp.
- destruct (Bv2N rda0 <= _) eqn:Hleq.
- { apply BVEq_iff_eq in HQ as HQ'; rewrite HQ' in H; clear HQ'.
- apply Bvector_wrap in H; [ | apply /ltP; exact ADDR_WIDTH_pos ].
- apply log2_eq1_pw2 in H as H2 ; [ | by rewrite QUEUE_MAX_SIZE_PW2 ]; clear H.
- rewrite H2; simpl ((N.of_nat 2 - 1)%N); simpl (N.add (Npos _) (Npos _)).
- apply BVEq_iff_eq in HQ; rewrite HQ Bv2N_N2Bv_sized; [ lia | ].
- apply /N.ltb_spec0.
- destruct ((Bv2N rda0 + 1 <? 2 ^ N.of_nat ADDR_WIDTH)%N) eqn:Hcont; [ done | ].
- move: Hcont => /negP /negP Hcont; rewrite -N.leb_antisym in Hcont.
- move: Hcont => /N.leb_spec0 Hcont.
- unfold ADDR_WIDTH in Hcont; rewrite QUEUE_MAX_SIZE_PW2_N in Hcont.
- rewrite leq_eqVlt in Hleq; move: Hleq => /orP [/eqP Hbug | Hltn].
- { specialize (@Bv2N_inj ADDR_WIDTH rda0 wra0) as HH.
- apply Bv_eq_translation in Hbug; apply HH in Hbug; by rewrite Hbug in Hadr. }
- apply N.le_lteq in Hcont; destruct Hcont as [Hcont0 | Hcont1];
- specialize (@Bv2N_upper_bound ADDR_WIDTH wra0) as H;
- apply Bv_ltn_translation in Hltn;
- apply to_nat_lt_pow in H;
- rewrite /ADDR_WIDTH QUEUE_MAX_SIZE_PW2_N in H;
- apply lt_trans_le with (p := N.of_nat QUEUE_MAX_SIZE) in Hltn; try done.
- { contradict Hcont0; by apply N.lt_asymm. }
- { contradict Hcont1; apply N.neq_sym; by apply N.lt_neq. }
- }
- { apply BVEq_iff_eq in H; rewrite -H Bv2N_N2Bv_sized; [ lia | ].
- move: Hleq => /negP /negP Hleq; rewrite -ltnNge in Hleq.
- apply /N.ltb_spec0.
- destruct ((Bv2N wra0 + 1 <? 2 ^ N.of_nat ADDR_WIDTH)%N) eqn:Hcont; [ done | ].
- unfold ADDR_WIDTH in Hcont; rewrite QUEUE_MAX_SIZE_PW2_N in Hcont.
- move: Hcont => /negP /negP Hcont; rewrite -N.leb_antisym in Hcont; move: Hcont => /N.leb_spec0 Hcont.
- apply N.le_lteq in Hcont; destruct Hcont as [Hcont0 | Hcont1].
- { (* use rda bound*) admit. (* proof on page 11 of FIFO notebook *) }
- { specialize (@Bv2N_upper_bound ADDR_WIDTH rda0) as Hu.
- unfold ADDR_WIDTH in Hu; rewrite QUEUE_MAX_SIZE_PW2 in Hu.
- assert (QUEUE_MAX_SIZE = N.to_nat (Bv2N wra0 + 1)).
- { specialize (N2Nat.id (Bv2N wra0 + 1)) as H_; rewrite -H_ in Hcont1.
- by apply Nat2N.inj in Hcont1. }
- admit.
- (* finish proof by rewriting H1 in Hu, which results in
- (Bv2N rda < Bv2N wra + 1) -> (Bv2N rda <= Bv2N wra), which contradicts
- Bv2N wra < Bv2N rda *)
- }
- }
- }
- { simpl; apply BVEq_iff_eq in HQ; apply /andP; split.
- { admit. (* should be easy *) }
- { rewrite HQ; by apply BVEq_iff_eq. }
- }
- }
- move: HQ => /andP [neq HQ].
- specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1 in HQ as IH; clear IHr1.
- 3: {
- (* Don't know how to prove that *)
- (* holds logically (page 12 FIFO notebook) *)
- unfold fullQueue; unfold fullQueue in NFULL.
- admit.
- }
- 2: by move: neq => /negPf neq; apply BVEq_iff_neq in neq.
- simpl; apply /andP; split.
- { move: IH => /andP [neq_ IH].
- admit. (* holds logically (page 12 FIFO notebook )*) }
- exact IH.
- Admitted.
-
- Check nth_default.
-
- Fixpoint EqMem_ {W} (P : Requests_t) (rda : Bvector W)
- (memcells_vec : Vector.t (Bvector REQUEST_WIDTH) (Nat.pow 2 W)) : bool :=
- match P with
- | [::] => true
- | x :: x0 =>
- let nrda := N2Bv_sized W (Bv2N rda + 1) in
- let s := nth_default REQUEST_NIL (N.to_nat (Bv2N rda)) memcells_vec in
- (EqReq x s) && (EqMem_ x0 nrda memcells_vec)
- end.
-
- Lemma EqMem_rcons r1 (rda wra : Bvector ADDR_WIDTH) c R (c_req : combType (Vec Bit REQUEST_WIDTH)) :
- EqQueue r1 wra rda ->
- EqMem_ r1 rda (@Cells_data (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem c) ->
- EqReq R c_req ->
- EqMem_ (r1 ++ [R])%SEQ rda (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
- Proof.
- intros HQ Mem EqR; fold mem_cells_ in c; rewrite cats1.
- revert Mem HQ; generalize wra rda; induction r1; intros.
- { simpl; rewrite andb_true_r; simpl in HQ; apply BVEq_iff_eq in HQ; rewrite HQ.
- rewrite VectorSpec.map_id.
- unfold ADDR_WIDTH in wra,rda.
- specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem
- rda0 c_req REQUEST_NIL) as HH; rewrite /REQUEST_NIL bitvec_literal_correct //= in HH;
- unfold mem_cells_ in c; by rewrite HH. }
- simpl in Mem,HQ; simpl.
- move: Mem => /andP [EqR_ Mem]; apply /andP; split.
- { move: HQ => /andP [/negPf Heq HQ];
- apply BVEq_iff_neq in Heq; rewrite VectorSpec.map_id; rewrite VectorSpec.map_id in EqR_.
- rewrite -memcell_nch; done.
- }
- { move: HQ => /andP [neq HQ].
- specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1; done.
- }
- Qed.
-
- (* Just use the circuit directly <-> circuit does the work directly *)
- Definition EqMem (P : Requests_t) rda (mem : circuit_state RequestQueue') :=
- let memcells_vec := Cells_data (get_memcells_RequestQueue mem) in
- EqMem_ P rda memcells_vec.
-
- Definition State_Eq (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
- let s := get_st cava_state in
- let c' := get_cnt cava_state in
- let cref' := get_cref cava_state in
- let r' := get_cr cava_state in
- let RQ := get_reqqueue cava_state in
- let wra := fst (get_addr_RequestQueue RQ) in
- let rda := snd (get_addr_RequestQueue RQ) in
- let pop := get_pop cava_state in
- match fram_state with
- | IDLE c cref P =>
- (s =? STATE_IDLE_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
- (EqQueue P wra rda) && (pop == false)
- | RUNNING c cref P r =>
- (s =? STATE_RUN_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
- (EqQueue P wra rda) && (EqReq r r') && (pop == (c == OCycle0))
- | REFRESHING cref P =>
- (s =? STATE_REF_VEC) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
- (EqQueue P wra rda) && (pop == false)
- end.
-
- (* -------------- Proofs about CmdGen ------------------------------- *)
- Lemma CmdGen_equiv_idle_to_idle (c : circuit_state CmdGen) cnt cref:
- (cref =? CNT_REF_PREA) = false ->
- exists c', step CmdGen c (STATE_IDLE_VEC,true,cnt,cref,REQUEST_NIL) =
- (c',NOP_VEC).
- Proof.
- intros H; simpl in c; destruct_products.
- eapply ex_intro.
- cbv [CmdGen]; cbn [step fst snd].
- simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; simpl.
- cbv [CrefPREA_eq].
- apply BVEq_iff_neq in H.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply HH in H; rewrite H VectorSpec.map_id; reflexivity.
- Qed.
-
- Lemma CrefPREA_lt_CNT_REF_PREA:
- CrefPREA_lt CNT_REF_PREA = false.
- Proof.
- cbv [CrefPREA_lt]; simpl_ident.
- unfold greaterThanOrEqual; simpl_ident; unfold greaterThanOrEqualBool.
- apply /negbF.
- rewrite {1}/CNT_REF_PREA; rewrite !bitvec_literal_correct.
- apply /N.leb_spec0; rewrite /CNT_REF_PREA /CNT_REF_WAIT !bitvec_literal_correct.
- rewrite !Bv2N_N2Bv_sized. { apply N.le_add_r. }
- all: rewrite /COUNTER_REF_WIDTH WAIT_REF_PW_N.
- all: try apply N_lt_inj.
- all: specialize WAIT_REF_PREA_date_WAIT as H; lia.
- Qed.
-
- Lemma CmdGen_equiv_idle_to_ref (c : circuit_state CmdGen) cnt cref e:
- (cref =? CNT_REF_PREA) = true ->
- exists c', step CmdGen c (STATE_IDLE_VEC,e,cnt,cref,REQUEST_NIL) = (c',PREA_VEC).
- Proof.
- intros; simpl in c; destruct_products; eapply ex_intro.
- cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; simpl; rewrite VectorSpec.map_id.
- apply BVEq_iff_eq in H; subst cref; rewrite CrefPREA_lt_CNT_REF_PREA !VectorSpec.map_id.
- rewrite andb_false_r; rewrite /CrefPREA_eq.
- specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- assert (CNT_REF_PREA = CNT_REF_PREA); [done | ]; apply HH in H; by rewrite H.
- Qed.
-
- Lemma CrefPREA_lt_CNT_REF_WAIT cref:
- (cref2Bv cref =? CNT_REF_PREA) = false -> (cref + WAIT < PREA_date) = true ->
- CrefPREA_lt (cref2Bv cref) = true.
- Proof.
- intros Href_prea Href_service.
- rewrite /CrefPREA_lt; simpl_ident; rewrite /greaterThanOrEqual; simpl_ident.
- rewrite /greaterThanOrEqualBool /CNT_REF_WAIT /CNT_REF_PREA !bitvec_literal_correct !Bv2N_N2Bv_sized.
- { destruct (~~ _) eqn:Hbug; [ done | ].
- apply negbFE in Hbug; move: Hbug => /N.leb_spec0 Hbug.
- assert (cref + (WAIT - 1) < (PREA_date - 1)).
- { rewrite addnBA; [ | exact WAIT_pos].
- rewrite subn1 -ltnS prednK; [ | by rewrite addn_gt0 WAIT_pos orb_true_r ].
- rewrite subn1 prednK; [ | exact PREA_date_pos].
- by rewrite Href_service.
- }
- move: H => /ltP H; apply N_lt_inj in H.
- contradict Hbug; apply N.nle_gt; by rewrite -Nat2N.inj_add.
- }
- all: unfold COUNTER_REF_WIDTH; rewrite WAIT_REF_PW_N.
- all: try rewrite -Nat2N.inj_add; apply N_lt_inj; apply /ltP.
- all: destruct cref; simpl in *; try done.
- all: specialize WAIT_REF_PREA_date_WAIT; lia.
- Qed.
-
- Lemma CmdGen_equiv_idle_to_running (c : circuit_state CmdGen) cnt cref tr:
- (cref2Bv cref =? CNT_REF_PREA) = false ->
- (cref + WAIT < PREA_date) = true ->
- exists c', step CmdGen c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref),tr) = (c',PRE_VEC).
- Proof.
- intros; simpl in c; destruct_products; eapply ex_intro.
- cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; simpl; rewrite !VectorSpec.map_id.
- rewrite CrefPREA_lt_CNT_REF_WAIT; done.
- Qed.
- (* ------------------------------------------------------------------ *)
-
- (* -------------- Proofs about NextCR ------------------------------- *)
- Lemma NextCR_equiv (c : circuit_state NextCR) cnt cref tr:
- exists c', step NextCR c (STATE_IDLE_VEC,true,cnt,cref,tr) =
- (c',REQUEST_NIL).
- Proof.
- simpl in c; destruct_products.
- eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd].
- simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; by simpl.
- Qed.
-
- Lemma NextCR_equiv_IDLE_NE_PREA c cnt cref tr:
- (cref =? CNT_REF_PREA) = true ->
- exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref,tr) =
- (c',REQUEST_NIL).
- Proof.
- intros; simpl in c; destruct_products; eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
- apply BVEq_iff_eq in H; subst cref.
- by rewrite CrefPREA_lt_CNT_REF_PREA.
- Qed.
-
- Lemma NextCR_equiv_IDLE_RUNNING c cnt (cref : Counter_ref_t) tr:
- (cref2Bv cref =? CNT_REF_PREA) = false ->
- (cref + WAIT < PREA_date) = true ->
- exists c',
- step NextCR c (STATE_IDLE_VEC,false,cnt,cref2Bv cref,tr) = (c',tr) /\
- (snd (snd c')) = tr.
- Proof.
- intros Href_service Href_prea; simpl in c; destruct_products; eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
- rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
- rewrite CrefPREA_lt_CNT_REF_WAIT; done.
- Qed.
-
- (* Lemma NextCR_equiv_IDLE_RUNNING c cnt (cref : Counter_ref_t) tr:
- (cref2Bv cref =? CNT_REF_PREA) = false ->
- (cref + WAIT < PREA_date) = true ->
- exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref2Bv cref,tr) =
- (c',tr).
- Proof.
- intros Href_service Href_prea; simpl in c; destruct_products; eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
- rewrite CrefPREA_lt_CNT_REF_WAIT; done.
- Qed. *)
- (* ------------------------------------------------------------------ *)
-
- Create HintDb update.
- Lemma Sidle_true :
- Sidle STATE_IDLE_VEC = true.
- Proof.
- apply CavaPreludeProperties.eqb_refl.
- Qed.
- Hint Rewrite @Sidle_true : update.
-
- Lemma Sref_idle_false :
- Sref STATE_IDLE_VEC = false.
- Proof.
- by apply CavaPreludeProperties.eqb_neq.
- Qed.
- Hint Rewrite @Sref_idle_false : update.
-
- Lemma cnt_equiv (cnt : Bvector COUNTER_WIDTH) :
- (if CeqWAIT cnt then Bvect_false COUNTER_WIDTH
- else N2Bv_sized COUNTER_WIDTH (Bv2N cnt + 1)) = cnt2Bv (Next_cycle (Bv2cnt cnt)).
- Proof.
- cbv [CeqWAIT].
- destruct (CavaPrelude.eqb (cnt, CNT_WAIT)) eqn:Heq; rewrite Heq.
- { specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit COUNTER_WIDTH) (x := cnt) as H.
- apply H in Heq; clear H.
- unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { rewrite /CNT_WAIT bitvec_literal_correct in Heq.
- rewrite Heq /Bv2cnt //= Bv2N_N2Bv_sized in x.
- 2: {
- rewrite /COUNTER_WIDTH; have id := (N2Nat.id 2).
- rewrite -id Nat2N.inj_pow //= /Pos.to_nat //= WAIT_PW_2.
- apply: N_lt_inj; apply /ltP; by rewrite subn1 ltn_predL WAIT_pos.
- }
- rewrite Nat2N.id subn1 prednK in x; [ | exact WAIT_pos ]; by rewrite ltnn in x.
- }
- { unfold cnt2Bv,OCycle0; by simpl. }}
- { unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { unfold cnt2Bv; apply f_equal; simpl.
- rewrite N.add_1_r -(N.succ_pos_pred (Pos.of_succ_nat (N.to_nat (Bv2N cnt)))).
- apply f_equal; by rewrite predN_of_succ_nat. }
- { apply ltn_gt in e,x.
- rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
- { have HH := (@eqb_iff_neq (Vec Bit (@COUNTER_WIDTH SYS_CFG FIFO_CFG))).
- apply HH in Heq. rewrite /CNT_WAIT bitvec_literal_correct in Heq;
- rewrite -(N2Bv_sized_Bv2N (@COUNTER_WIDTH SYS_CFG FIFO_CFG) cnt) in Heq.
- apply N2Bv_sized_neq_if in Heq.
- by rewrite e subn1 -pred_Sn N2Nat.id in Heq. }
- { specialize ltn_ord with (n := @WAIT SYS_CFG FIFO_CFG) (i := Ordinal (cnt_bounded cnt)) as H.
- rewrite //= in H.
- contradict H; apply /negP; by rewrite -ltnNge.
- }
- }
- }
- Qed.
-
- (* -------------- Proofs about Update ------------------------------- *)
- Lemma Update_equiv_idle_idle (c : circuit_state Update) cnt cref :
- (cref =? CNT_REF_PREA) = false ->
- let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
- let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N cref + 1) in
- exists c', step Update c (STATE_IDLE_VEC,true,cnt,cref) =
- (c',(STATE_IDLE_VEC,false,nc,ncref)).
- Proof.
- intros Hcref Hcnt; simpl in c; eapply ex_intro.
- cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
- cbv [Update Update_s Update_e Update_c Update_cref].
- cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- autorewrite with update; vm_compute (false && _).
- apply BVEq_iff_neq in Hcref.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply pair_equal_spec; split.
- 2: {
- rewrite orb_false_l andb_true_l.
- rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
- }
- cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
- vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id andb_false_r.
- apply pair_equal_spec; split; [
- apply pair_equal_spec; split; [ by unfold STATE_IDLE_VEC | reflexivity] | ].
- vm_compute (orb false false); rewrite orb_false_r; by specialize (cnt_equiv cnt).
- Qed.
-
- Lemma Update_equiv_idle_ref (c : circuit_state Update) cnt cref e:
- (cref =? CNT_REF_PREA) = true ->
- let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
- let ncref := CNT_REF_NIL in
- exists c', (step Update c (STATE_IDLE_VEC,e,cnt,cref)) =
- (c',(STATE_REF_VEC,false,nc,ncref)).
- Proof.
- intros Hcref Hcnt; simpl in c; eapply ex_intro.
- cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
- cbv [Update Update_s Update_e Update_c Update_cref].
- cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- autorewrite with update; vm_compute (false && _).
- apply BVEq_iff_eq in Hcref.
- specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply pair_equal_spec; split.
- 2: {
- rewrite orb_false_l andb_true_l.
- rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
- }
- cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
- vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id.
- apply pair_equal_spec; split.
- 2: {
- vm_compute (orb false false); rewrite orb_false_r.
- destruct e; [rewrite negb_true | rewrite negb_false].
- { rewrite andb_false_r orb_false_r; by specialize (cnt_equiv cnt). }
- { rewrite andb_true_r.
- destruct (CrefPREA_lt cref) eqn:Hbug.
- { by rewrite Hcref CrefPREA_lt_CNT_REF_PREA in Hbug. }
- { rewrite orb_false_r; by specialize (cnt_equiv cnt). }
- }
- }
- apply pair_equal_spec; split; [ done | ].
- rewrite Hcref CrefPREA_lt_CNT_REF_PREA; by rewrite andb_false_l.
- Qed.
-
- Lemma Update_equiv_idle_running (c : circuit_state Update) cnt
- (cref : Counter_ref_t) :
- (cref2Bv cref =? CNT_REF_PREA) = false ->
- (cref + WAIT < PREA_date) = true ->
- let nc := CNT_NIL in
- let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N (cref2Bv cref) + 1) in
- exists c', step Update c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref)) =
- (c',(STATE_RUN_VEC,true,nc,ncref)).
- Proof.
- intros Href_prea Href_service Hcnt;
- simpl in c; destruct_products; eapply ex_intro.
- cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
- cbv [Update Update_s Update_e Update_c Update_cref].
- cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- autorewrite with update; fast_simpl_bool;
- rewrite !orb_false_l !andb_true_l /CrefPREA_eq.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply BVEq_iff_neq in Href_prea as Haux; apply HH in Haux.
- rewrite Haux //= !orb_false_r andb_true_r !VectorSpec.map_id; clear Haux.
- apply pair_equal_spec; split; [ | done].
- apply pair_equal_spec; split; rewrite CrefPREA_lt_CNT_REF_WAIT; try done.
- by rewrite orb_true_r.
- Qed.
- (* ------------------------------------------------------------------ *)
-
- (* -------------- Proofs about FullEmptyLogic ------------------------------- *)
- Lemma FEL_emp_equiv (c : circuit_state FullEmptyLogic) wra rda :
- wra = rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,true)).
- Proof.
- intros H; eapply ex_intro.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
- cbn [step]; simpl_ret; cbn [fst snd].
- apply pair_equal_spec; split; [ reflexivity | ].
- apply pair_equal_spec; split; [ | by rewrite H CavaPreludeProperties.eqb_refl ].
- rewrite inv_correct; cbv [bind].
- rewrite fullAdder_cin; cbv [unpackV]; simpl_ret.
- destruct (one) eqn:Hone; [ | discriminate].
- destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
- [ | by rewrite H leqnn in Hleq ].
- assert (N.sub (Bv2N wra) (Bv2N rda) = 0%N); [ by rewrite H N.sub_diag | ].
- rewrite H0 !bitvec_literal_correct.
- set (N := N.sub _ _).
- specialize N2Bv_sized_queuemax_neq0 as H2.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@ADDR_WIDTH CAVA_SYS))
- (x := N2Bv_sized ADDR_WIDTH 0) (y := N2Bv_sized ADDR_WIDTH N) as HH.
- by apply HH in H2.
- Qed.
-
- Lemma FEL_nemp_wrap1_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
- let wrap1 := N2Bv_sized ADDR_WIDTH (Bv2N wra + 1) in
- wra = rda -> exists c' f', step FullEmptyLogic c (wrap1,rda) = (c',(f',false)).
- Proof.
- intros; repeat eapply ex_intro; unfold wrap1.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
- cbn [step]; simpl_ret; cbn [fst snd].
- apply pair_equal_spec; split; [ reflexivity | ].
- apply pair_equal_spec; split; [ reflexivity | ].
- apply CavaPreludeProperties.eqb_neq; rewrite H.
- apply N2Bv_sized_plusone_diff; unfold ADDR_WIDTH.
- specialize QUEUE_MAX_SIZE_GT_1 as HQ; apply Nat.log2_pos in HQ.
- by move: HQ => /ltP HQ.
- Qed.
-
- Lemma FEL_nemp_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
- ~~ (fullQueue wra rda) ->
- wra <> rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,false)).
- Proof.
- intros NF H; eapply ex_intro.
- rewrite /fullQueue in NF.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
- cbn [step]; simpl_ret; cbn [fst snd].
- apply pair_equal_spec; split; [ reflexivity | ].
- apply pair_equal_spec; split; [ | by apply CavaPreludeProperties.eqb_neq ].
- rewrite bitvec_literal_correct.
- rewrite fullAdder_cin; destruct (one) eqn:Hbug; try discriminate; clear Hbug.
- cbv [unpackV].
- destruct (_ <= _) eqn:Hleq; apply CavaPreludeProperties.eqb_neq.
- { set (xx := (Bv2N wra - Bv2N rda)%N); fold xx in NF.
- set (yy := ((N.of_nat QUEUE_MAX_SIZE - 1)%N)); fold yy in NF.
- assert (N.size_nat xx <= ADDR_WIDTH);
- [ apply size_nat_sub_leq; by apply leq_Nle in Hleq | ].
- assert (N.size_nat yy <= ADDR_WIDTH);
- [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
- apply N2Bv_sized_neq_iff; try done; by apply /eqP.
- }
- { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
- { assert (Bv2N rda > Bv2N wra); [ lia | ].
- apply size_nat_qms_sub; by apply ltn_Ntn in H0.
- }
- { unfold ADDR_WIDTH; by apply size_nat_qms. }
- specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH.
- rewrite HH in NF; [ | exact QUEUE_MAX_SIZE_GT_0_N].
- apply /eqP; exact NF.
- }
- Qed.
-
- Lemma FEL_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
- ~~ (fullQueue wra rda) ->
- exists c' e', step FullEmptyLogic c (wra,rda) = (c',(false,e')).
- Proof.
- intros NF; unfold fullQueue in NF; repeat eapply ex_intro.
- cbv [FullEmptyLogic]; cbn [step]; simpl_ret; cbn [fst snd].
- apply pair_equal_spec; split; [reflexivity | ].
- apply pair_equal_spec; split; [ | reflexivity ].
- cbv [dropr subtractor EqFULL FullVEC unpackV]; simpl_ident.
- destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
- destruct (one) eqn:Hone; try discriminate;
- rewrite fullAdder_cin Hleq;
- apply CavaPreludeProperties.eqb_neq; move: NF => /eqP NF.
- { set (xx := (Bv2N wra - Bv2N rda)%N); fold xx in NF.
- set (yy := ((N.of_nat QUEUE_MAX_SIZE - 1)%N)); fold yy in NF.
- assert (N.size_nat xx <= ADDR_WIDTH);
- [ apply size_nat_sub_leq; by apply leq_Nle in Hleq | ].
- assert (N.size_nat yy <= ADDR_WIDTH);
- [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
- apply N2Bv_sized_neq_iff; try done; by apply /eqP.
- }
- { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
- { assert (Bv2N rda > Bv2N wra) as H; [ lia | ].
- apply size_nat_qms_sub; by apply ltn_Ntn in H.
- }
- { unfold ADDR_WIDTH; by apply size_nat_qms. }
- specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH.
- by rewrite HH in NF; [ | exact QUEUE_MAX_SIZE_GT_0_N].
- }
- Qed.
- (* ------------------------------------------------------------------ *)
-
- Lemma incrn_pointr_true_equiv (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,true) =
- (tt,N2Bv_sized ADDR_WIDTH (Bv2N ad + 1)).
- Proof.
- cbv [incr_pointr step] ; by simpl_ident.
- Qed.
-
- Lemma incrn_pointr_false_equiv (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,false) = (tt,ad).
- Proof.
- cbv [incr_pointr step] ; by simpl_ident.
- Qed.
-
- Create HintDb get_state.
- Hint Unfold get_st get_cnt get_cref get_reqqueue get_addr_RequestQueue get_pop get_mem
- get_memcells_RequestQueue get_mem_RequestQueue get_memcells get_cr : get_state.
-
- (* the not full could come either be satisfies from the not full hypothesis
- or from wra = rda *)
- Lemma RQ_fst_pushT_popF_NF (c : circuit_state RequestQueue') c_req :
- let '(wra,rda) := get_addr_RequestQueue c in
- let S := get_memcells_RequestQueue c in
- let wra_idx := N.to_nat (Bv2N wra) in
- let memcells_spec := Cells_read true wra_idx c_req S in
- ~~ (fullQueue wra rda) -> exists c',
- ((Cells_data (get_memcells_RequestQueue c') = memcells_spec) /\
- (fst (get_addr_RequestQueue c')) = (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) /\
- (snd (get_addr_RequestQueue c')) = rda) /\
- fst (step RequestQueue' c (true,c_req,false)) = c'.
- Admitted.
- (* Proof.
- simpl in c; destruct_products.
- unfold get_addr_RequestQueue; intros Hfull; eapply ex_intro; split; [ | reflexivity].
- set (p := step RequestQueue' _ _).
- cbv [RequestQueue' LoopInit fork2] in p.
- cbn [step] in p; cbn [fst snd] in p; simpl_ret_H p; cbv [fst snd] in p.
- specialize FEL_NF_equiv with (c := (u17, (u19, u20, u18), u16))
- (rda := t0) (wra := t) as H; apply H in Hfull; clear H.
- destruct Hfull as [cs_FEL' [empty_o Hfull]].
- unfold p; clear p; rewrite Hfull.
- cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
- rewrite (surjective_pairing (step memqueue' _ _)).
- rewrite incrn_pointr_true_equiv incrn_pointr_false_equiv.
- rewrite (surjective_pairing (step FullEmptyLogic _ _)).
- set (fel := step FullEmptyLogic _ _).
- split.
- { simpl in fel; unfold fel; cbv [snd fst].
- cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end.
- cbv [memqueue' Memory' mem_write mem_read]; cbn [step fst snd]; simpl_ident; cbv [fst snd].
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end.
- cbv [fst snd].
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end.
- fold mem_cells_.
- specialize @Cells_matchX with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
- (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
- (S0 := c) (we := true) (wd := c_req) (wa := (N.to_nat (Bv2N t))) as HH.
- rewrite -HH; [reflexivity | | ].
- { intros.
- rewrite /indexConst; simpl_ident.
- rewrite /decode; simpl_ident.
- admit.
- }
- { rewrite /indexConst; simpl_ident.
- rewrite /decode; simpl_ident.
- admit.
- }
- }
- split; by simpl.
- Admitted. *)
-
- (* Ignoring the full signal because it just goes to the output *)
- Lemma RQ_snd_pushT_empty (c : circuit_state RequestQueue') c_req pop :
- let '(wra,rda) := get_addr_RequestQueue c in
- let S := get_memcells_RequestQueue c in
- let rda_idx := N.to_nat (Bv2N rda) in
- let wra_idx := N.to_nat (Bv2N wra) in
- let memcells' := Cells_read true wra_idx c_req S in
- let mem_val := nth_default (req_null) rda_idx memcells' in
- wra = rda -> exists f',
- snd (step RequestQueue' c (true,c_req,pop)) = (f',mem_val,true).
- Admitted.
- (* simpl in c; destruct_products; rename t0 into rda, t into wra.
- autounfold with get_state; intros.
- cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
- eapply FEL_emp_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH.
- destruct HH as [cs_FEL HH]; rewrite HH.
- cbn [fst snd bind inv and2 or2].
- rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
- cbv [fst snd]; fast_simpl_bool.
- rewrite incrn_pointr_true_equiv if_same incrn_pointr_false_equiv; clear HH.
- eapply FEL_nemp_wrap1_equiv with (c := (u4, (u6, u7, u5), u3)) in H as HH.
- destruct HH as [cs_FELL [full_o HH]]; rewrite HH; clear HH.
- eapply ex_intro.
- apply pair_equal_spec; split; [ | reflexivity ].
- apply pair_equal_spec; split; [ reflexivity | ].
- cbv [memqueue' Memory' mem_write mem_read].
- cbn [step fst snd]; simpl_ret.
- rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)).
- specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
- (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
- (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
- rewrite -HH.
- { cbv [indexAt indexConst defaultCombValue].
- cbv [unpackV bind]; simpl_ret.
- rewrite nth_0; simpl; unfold req_null.
- reflexivity.
- }
- all: admit.
- Admitted. *)
-
- Lemma RQ_snd_pushT_popF_NF_nempty (c : circuit_state RequestQueue') c_req:
- let '(wra,rda) := get_addr_RequestQueue c in
- let S := get_memcells_RequestQueue c in
- let rda_idx := N.to_nat (Bv2N rda) in
- let wra_idx := N.to_nat (Bv2N wra) in
- let memcells' := Cells_read true wra_idx c_req S in
- let mem_val := nth_default (req_null) rda_idx memcells' in
- ~~ (fullQueue wra rda) -> wra <> rda -> exists full_o,
- snd (step RequestQueue' c (true,c_req,false)) = (full_o,mem_val,false).
- Admitted.
- (*
- simpl in c; destruct_products; rename t0 into rda, t into wra.
- autounfold with get_state; intros.
- cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
- apply FEL_nemp_NF_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH; [ | done].
- destruct HH as [cs_FEL HH]; rewrite HH.
- cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
- rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
- cbv [fst snd]; fast_simpl_bool.
- rewrite incrn_pointr_true_equiv.
- rewrite incrn_pointr_false_equiv; clear HH.
- (* The second logic doesn't really matter much *)
- rewrite (surjective_pairing (step FullEmptyLogic _ _)).
- eapply ex_intro.
- apply pair_equal_spec; split; [ | reflexivity].
- apply pair_equal_spec; split; [ reflexivity | ].
- destruct_pair_let.
- cbv [memqueue' Memory' mem_write mem_read].
- cbn [step fst snd]; simpl_ret.
- rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)).
- specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
- (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
- (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
- rewrite -HH //=.
- all: admit.
- Admitted. *)
-
- (* IDLE -> RUNNING *)
- Theorem SM_Eq_2b (t : nat) (c_state : State_t) c0 r0 r1
- (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) r :
- (c1 + WAIT < PREA_date) = true ->
- (nat_of_ord c1 == PREA_date - 1) = false ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
- move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ] /eqP EqPop].
- apply EqQueue_diff_adr in HQ as Hadr.
-
- apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref pop.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (RQ_snd_pushT_popF_NF_nempty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
- rewrite H. clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- apply NextCR_equiv_IDLE_RUNNING with (c := (u9, (u10, cr))) (cnt := cnt2Bv c0)
- (cref := c1) (tr := tr) in Href_service as H.
- 2: by apply cref_preadate_false in Href_prea.
- destruct H as [cs_nextcr H]; destruct H as [H Htr].
- rewrite H; clear H; cbv [fst snd].
-
- specialize (CmdGen_equiv_idle_to_running u6 (cnt2Bv c0) c1 tr) as S.
- specialize Href_service as Href_service_.
- apply S in Href_service; clear S; rename Href_service into H.
- 2: by apply cref_preadate_false in Href_prea.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- specialize (Update_equiv_idle_running u4 (cnt2Bv c0) c1) as S;
- apply S in Href_service_ as S'; clear S.
- 2: by apply cref_preadate_false in Href_prea.
- destruct S' as [cs_update H]; rewrite H; clear H; cbn [fst snd].
-
- rewrite /Next_state Href_prea Href_service_ /State_Eq.
- specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
-
- apply /andP; split.
- 2: {
- unfold tr; simpl in Mem; move: Mem => /andP [EqReq_r0 Mem].
- rewrite {2}/get_memcells_RequestQueue /get_mem_RequestQueue /get_memcells in Hrw.
- apply (memcell_nch c wra rda c_req req_null) in Hadr as HH.
- rewrite /req_null //= in HH.
- rewrite VectorSpec.map_id /Bvect_false HH in EqReq_r0.
- by rewrite /req_null //=.
- }
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2: {
- rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; simpl; trivial. }
- apply /andP; split.
- 2 : {
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; rewrite Htr;
- unfold tr; simpl in Mem; move: Mem => /andP [EqReq_r0 Mem].
- rewrite {2}/get_memcells_RequestQueue /get_mem_RequestQueue /get_memcells in Hrw.
- apply (memcell_nch c wra rda c_req req_null) in Hadr as HH.
- rewrite /req_null //= in HH.
- rewrite VectorSpec.map_id /Bvect_false HH in EqReq_r0.
- by rewrite /req_null //=.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
- simpl; rewrite eq_refl.
- rewrite /Enqueue /R NF.
- simpl in HQ.
- (* specialize (EqQueue_aux wra rda r0 r1 r) as HH; apply HH; done. *)
- specialize (EqQueue_aux wra rda r0 r1 r) as HH.
- apply HH in NFULL as HH'; clear HH; try done.
- (* move: HH' => /andP [neqq HH]; fold @EqQueue in HH. *)
- move: HH'; simpl; intros HH.
- move: HH => /andP [Hadr_neq HH].
- rewrite /EqQueue in HH'.
-
- simpl; rewrite Hadr; unfold R; rewrite NF //=.
-
- }
-
- 2 : {
- rewrite /Enqueue (surjective_pairing (step RequestQueue' _ _)) H.
- autounfold with get_state in Hrda',Hwra'; cbn [fst snd]; rewrite Hwra' Hrda'; clear Hwra' Hrda'.
- unfold R; rewrite NF.
- specialize (EqQueue_aux wra rda r0 r1 r) as HH; apply HH; done.
- }
-
-
-
-
-
-
-
-
- Theorem SM_Eq_2a (t : nat) (c_state : State_t) c0
- (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) r :
- (c1 + WAIT < PREA_date) = true ->
- (nat_of_ord c1 == PREA_date - 1) = false ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
- move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr] /eqP EqPop].
- simpl in Hadr.
-
- apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref pop.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (RQ_snd_pushT_empty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in Hadr as H; clear S; destruct H as [full_o H].
- rewrite H; clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- specialize NextCR_equiv with (c := (u9, (u10, cr))) (cnt := cnt2Bv c0)
- (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
- rewrite H; cbv [fst]; clear H. cbn [snd].
-
- apply cref_preadate_false in Href_prea as Href_prea_.
- apply (CmdGen_equiv_idle_to_idle u6 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- apply (Update_equiv_idle_idle u4 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
- destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
-
- rewrite /Next_state Href_prea /State_Eq.
- specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
- rewrite Href_service.
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2: {
- rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; simpl; trivial. }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
- simpl; rewrite Hadr; unfold R; rewrite NF //=.
- apply /andP; split.
- { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
- specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
- by apply BVEq_iff_eq.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hrda'.
- simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r.
- rewrite Hrw; autounfold with get_state; rewrite Hadr.
- specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req c) as H'.
- rewrite H'; exact EqR.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
- destruct_pair_let.
- rewrite /Next_cycle_ref.
- set Hc := c1.+1 < WAIT_REF; dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
- 2: {
- unfold COUNTER_REF_WIDTH; rewrite WAIT_REF_PW_N.
- destruct c1; simpl; apply N_lt_inj; by apply /ltP.
- }
- rewrite /N2Bv_sized.
- destruct (N.of_nat c1 + 1)%N eqn:Hbug;
- [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
- apply BVEq_iff_eq; f_equal; lia.
- }
- { destruct c1; simpl in x,e,Hc0,Href_prea_,Href_service,Href_prea.
- rewrite /cref2Bv VectorSpec.map_id //= in Href_prea_.
- apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x].
- { assert (m = WAIT_REF.-1); [ lia | ].
- rewrite H0 addnC -ltn_subRL in Href_service.
- rewrite -subn1 ltn_subLR in Href_service; [ | exact WAIT_REF_pos ].
- contradict Href_service; apply /negP.
- rewrite -leqNgt leq_eqVlt addnC.
- specialize WAIT_REF_PREA_date as HH.
- apply ltn_trans with (m := PREA_date - WAIT + 1) in HH;
- [ by rewrite HH orb_true_r | ].
- rewrite -subnA.
- { by rewrite ltn_subrL subn_gt0 WAIT_gt_one PREA_date_pos. }
- { exact WAIT_pos. }
- { by rewrite leq_eqVlt PREA_date_WAIT orb_true_r. }
- }
- { rewrite ltnS in x; contradict x; apply /negP; by rewrite -ltnNge. }
- }
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
- destruct_pair_let.
- rewrite /cnt2Bv; apply BVEq_iff_eq; f_equal.
- apply Nat2N.inj_iff.
- rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
- 2: {
- destruct c0; rewrite //= /COUNTER_WIDTH.
- rewrite WAIT_PW_2_N; apply N_lt_inj; by apply /ltP.
- }
- set (Hc := _ < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro; try rewrite Nat2N.id;
- try by rewrite Nat2N.id in x; move: Logic.eq_refl; rewrite {2 3}x; simpl; intro.
- }
- cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
- by [].
- Qed.
-
-
- (* Assuming a non-full regime, i.e., the front-end has yielded a valid request *)
- (* If R is non empty than the queue is not full *)
- Theorem SM_Eq_1b (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r0 r1 (r : Request_t) :
- (nat_of_ord c1 == PREA_date - 1) = true ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Admitted.
- (* Proof.
- intros Href_prea f_state R NF EqR H; unfold FIFOSM.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
- move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ] /eqP EqPop].
- apply EqQueue_diff_adr in HQ as Hadr.
-
- apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref pop.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (RQ_snd_pushT_popF_NF_nempty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
- rewrite H. clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- specialize (NextCR_equiv_IDLE_NE_PREA (u9, (u10, cr)) (cnt2Bv c0) (cref2Bv c1) tr) as S.
- apply cref_preadate_true in Href_prea as Href_prea_.
- apply S in Href_prea_ as S'; clear S; destruct S' as [cs_nextcr H]; rewrite H.
-
- cbn [fst snd]; clear H.
- apply (CmdGen_equiv_idle_to_ref u6 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- apply (Update_equiv_idle_ref u4 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
- destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
-
- rewrite /Next_state Href_prea /State_Eq.
- specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2: {
- rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; simpl; trivial. }
- apply /andP; split.
- 2 : {
- rewrite /Enqueue (surjective_pairing (step RequestQueue' _ _)) H.
- autounfold with get_state in Hrda',Hwra'; cbn [fst snd]; rewrite Hwra' Hrda'; clear Hwra' Hrda'.
- unfold R; rewrite NF.
- specialize (EqQueue_aux wra rda r0 r1 r) as HH; apply HH; done.
- }
- apply /andP; split.
- 2 : {
- rewrite /EqMem (surjective_pairing (step RequestQueue' _ _)) H Hrw /Enqueue.
- autounfold with get_state in Hrda'; cbn [fst snd]; rewrite Hrda'; clear Hrda'.
- autounfold with get_state; unfold R; rewrite NF.
- apply EqMem_rcons; done.
- }
- apply /andP; split.
- 2 : {
- cbv [get_cref].
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //= VectorSpec.map_id.
- destruct_pair_let.
- rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
- }
- cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
- by [].
- Qed. *)
-
- Theorem SM_Eq_1a (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r :
- (nat_of_ord c1 == PREA_date - 1) = true ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Admitted.
- (* Proof.
- intros Href_prea f_state R NF EqR H; unfold FIFOSM.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rewrite NF //= in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
- rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
- move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr] /eqP EqPop].
- simpl in Hadr.
-
- apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref pop.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (RQ_snd_pushT_empty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in Hadr as H; clear S; destruct H as [full_o H].
- rewrite H; clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- specialize NextCR_equiv with (c := (u9, (u10, cr))) (cnt := cnt2Bv c0)
- (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
- rewrite H; cbv [fst]; clear H.
-
- apply cref_preadate_true in Href_prea as Href_prea_; cbn [fst snd].
- apply (CmdGen_equiv_idle_to_ref u6 (cnt2Bv c0) (cref2Bv c1) true) in Href_prea_ as H.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- apply (Update_equiv_idle_ref u4 (cnt2Bv c0) (cref2Bv c1) true) in Href_prea_ as H.
- destruct H as [cs_update H]; rewrite H; clear H.
-
- rewrite /Next_state Href_prea /State_Eq.
- specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- autounfold with get_state.
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2: {
- rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; simpl; trivial. }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
- simpl; rewrite Hadr; unfold R; rewrite NF //=.
- apply /andP; split.
- { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
- specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
- by apply BVEq_iff_eq.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hrda'.
- simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r.
- rewrite Hrw; autounfold with get_state; rewrite Hadr.
- specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req c) as H'.
- rewrite H'; exact EqR.
- }
- apply /andP; split.
- 2 : {
- cbv [get_cref].
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //= VectorSpec.map_id.
- destruct_pair_let.
- rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
- }
- cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
- by [].
- Qed. *)
-
- (* Have to add the full case *)
- (* REF bounded with PREA_date or arbitrary parameter *)
- (* if REF is bounded with PREA_date, a problem with cref + WAIT *)
- (* try bound with random parameter, but will not be correspondent to Next_cycle *)
- Theorem SM_Eq_NFULL (t : nat) (c_state : State_t) (f_req: Request_t)
- (c_req : Bvector REQUEST_WIDTH) (push : bool) :
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R == [:: f_req] -> EqReq f_req c_req -> State_Eq f_state c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R f_state in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- destruct (f_state) eqn:Hf_state.
- { destruct (nat_of_ord c0 == PREA_date - 1) eqn:Hcref_prea; move: Hcref_prea.
- { destruct r eqn:HR.
- { apply SM_Eq_1a. }
- { apply SM_Eq_1b. }
- }
- { destruct (c0 + WAIT < PREA_date) eqn:Hcref_service; move: Hcref_service.
- { destruct r eqn:HR.
- { apply SM_Eq_2a. }
- { admit. (* Case 2b: IDLE -> RUNNING (non-empty queue) *)}
- }
- { destruct r eqn:HR.
- { admit. (* Case 3a: IDLE -> IDLE (empty queue )*)}
- { admit. (* Case 3b: IDLE -> IDLE (non empty queue) *) }
- }
- }
- }
- { destruct (nat_of_ord c0 == OACT_date) eqn:Hact_date.
- { destruct r eqn:HR.
- { admit. (* Case 4a : RUNNING -> RUNNING (ACT) (empty queue) *) }
- { admit. (* Case 4b : RUNNING -> RUNNING (ACT) (non empty queue) *)}
- }
- { destruct (nat_of_ord c0 == OCAS_date) eqn:Hcas_date.
- { destruct r eqn:HR.
- { admit. (* Case 5a : RUNNING -> RUNNING (CAS) (empty queue )*) }
- { admit. (* Case 5b : RUNNING -> RUNNING (CAS) (non-empty queue) *)}
- }
- { destruct (nat_of_ord c0 == WAIT.-1) eqn:Hend_date.
- { destruct r eqn:HR.
- { admit. (* Case 6a : RUNNING -> IDLE (empty queue) *) }
- { admit. (* Case 6b : RUNNING -> IDLE (non empty queue) *)}
- }
- { destruct r eqn:HR.
- { admit. (* Case 7a : RUNNING -> RUNNING (empty queue) *) }
- { admit. (* Case 7b : RUNNING -> RUNNING (non empty queue) *) }
- }
- }
- }
- }
- { destruct (nat_of_ord c0 == OREF_date) eqn:Href_date.
- { destruct r eqn:HR.
- { admit. }
- { admit. }
- }
- { destruct (nat_of_ord c0 == OENDREF_date) eqn:Hendref_date.
-
- }
-
- }
-
-End EquivalenceProof.
\ No newline at end of file
diff --git a/framework/CavaDRAM/CavaFIFOREF/CavaFIFOREFProperties2.v b/framework/CavaDRAM/CavaFIFOREF/CavaFIFOREFProperties2.v
deleted file mode 100644
index 949d7ab..0000000
--- a/framework/CavaDRAM/CavaFIFOREF/CavaFIFOREFProperties2.v
+++ /dev/null
@@ -1,311 +0,0 @@
-Set Printing Projections.
-From CavaDRAM Require Import CavaFIFOREF.
-Require Import Program.
-
-Ltac destruct_products :=
- repeat match goal with
- | p: _ * _ |- _ => destruct p
- | H: _ /\ _ |- _ => let Hl := fresh H "l" in let Hr := fresh H "r" in destruct H as [Hl Hr]
- | E: exists y, _ |- _ => let yf := fresh y in destruct E as [yf E]
- end.
-
-Ltac simplify_step :=
- first [ destruct_pair_let
- | rewrite eqb_nat_to_bitvec_sized; by Lia.lia
- | rewrite nat_to_bitvec_to_nat; by Lia.lia
- | progress simpl_ident
- | progress autorewrite with to_spec
- | progress cbn [fst snd map] ].
-
-Ltac simplify := repeat simplify_step.
-Ltac simpl_ret := cbv [ret monad CombinationalSemantics Identity.Monad_ident].
-
-Section CavaSMProperties2.
- (* From Cava *)
- Existing Instance CombinationalSemantics.
- (* From CavaDRAM*)
- Context {CAVA_SYS : CavaSystem}.
- (* From CoqDRAM *)
- Existing Instance REQESTOR_CFG.
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
- Context {AF : Arrival_function_t}.
- Existing Instance FIFO_implementation.
-
- Definition State_t := circuit_state FIFOSM.
-
- Definition get_mem (s : State_t) :=
- let '(_,(_,(_,(_,(_, (_, (_,_, _),_)),_,mem_state,_,
- (_, _),(_, (_, (_, _, _),_)),_,_),_),(_,(_,(_,(_,
- (_, (_,_)),_, _, _,_, _,_),_),_)),_)) := s in mem_state.
-
- Definition get_pop (s : State_t) :=
- let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
- (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
- (_, (_,_)),_,_,_,_,_,_),_),_)),pop)) := s in pop.
-
- Definition get_st (s : State_t) :=
- let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
- (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
- (_, (_,_)),_,_,_,_,_,_),_),st)),_)) := s in st.
-
- Definition get_cnt (s : State_t) :=
- let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
- (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
- (_, (_,_)),_,_,_,_,_,_),cnt),_)),_)) := s in cnt.
-
- Definition get_cref (s : State_t) :=
- let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
- (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
- (_, (_,_)),_,_,_,_,_,cref),_),_)),_)) := s in cref.
-
- Definition get_cr (s : State_t) :=
- let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
- (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
- (_, (_,cr)),_,_,_,_,_,_),_),_)),_)) := s in cr.
-
- Definition get_wra (s : State_t) :=
- let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
- (_,_),(_,(_,(_,_,_),_)),_,_),wra),(_,(_,(_,(_,
- (_, (_,_)),_,_,_,_,_,_),_),_)),_)) := s in wra.
-
- Definition get_rda (s : State_t) :=
- let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
- (_,_),(_,(_,(_,_,_),_)),_,rda),_),(_,(_,(_,(_,
- (_, (_,_)),_,_,_,_,_,_),_),_)),_)) := s in rda.
-
- Definition cnt2Bv (cnt : Counter_t) :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
-
- Definition cref2Bv (cref : nat) :=
- N2Bv_sized COUNTER_REF_WIDTH (N.of_nat cref).
-
- Program Definition EqArrival (r : Requests_t) (r' : Bvector REQUEST_WIDTH) : bool.
- Admitted.
-
- Program Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
- Admitted.
-
- (* Write this *)
- Program Definition EqMem (P : Requests_t) (mem : circuit_state memqueue) : bool.
- Admitted.
-
- (* Rewrite the predicate *)
- Import BvectorNotations.
- Open Scope Bvector_scope.
- Definition State_Eq' (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
- let s := get_st cava_state in
- let c' := get_cnt cava_state in
- let cref' := get_cref cava_state in
- let r' := get_cr cava_state in
- let wra := get_wra cava_state in
- let rda := get_rda cava_state in
- let pop := get_pop cava_state in
- let mem := get_mem cava_state in
- match fram_state with
- | IDLE c cref P =>
- (s =? STATE_IDLE_VEC) && (cnt2Bv c =? c') && (cref2Bv cref =? cref') && (
- match P with
- | [::] => (wra =? rda)
- | x :: x0 => EqMem (x :: x0) mem
- end)
- | RUNNING c cref P r =>
- (s =? STATE_RUN_VEC) && (cnt2Bv c =? c') && (cref2Bv cref =? cref') && (
- match P with
- | [::] => (wra =? rda)
- | x0 :: xS => EqMem (x0 :: xS) mem
- end) &&
- (EqReq r r')
- | REFRESHING cref P =>
- (s =? STATE_REF_VEC) && (cref2Bv cref =? cref') &&
- ((wra =? rda) == (P == [::]))
- end.
-
- Definition State_Eq (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
- let s := get_st cava_state in
- let c' := get_cnt cava_state in
- let cref' := get_cref cava_state in
- let r' := get_cr cava_state in
- let wra := get_wra cava_state in
- let rda := get_rda cava_state in
- let pop := get_pop cava_state in
- match fram_state with
- | IDLE c cref P =>
- (s =? STATE_IDLE_VEC) && (cnt2Bv c =? c') && (cref2Bv cref =? cref') &&
- ((wra =? rda) == (P == [::]))
- | RUNNING c cref P r =>
- (s =? STATE_RUN_VEC) && (cnt2Bv c =? c') && (cref2Bv cref =? cref') && (EqReq r r') &&
- ((wra =? rda) == (P == [::]))
- | REFRESHING cref P =>
- (s =? STATE_REF_VEC) && (cref2Bv cref =? cref') &&
- ((wra =? rda) == (P == [::]))
- end.
-
- Lemma BVEq_eq {N} (a b : Bvector N) :
- (a =? b) = true -> a = b.
- Proof.
- intros.
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := a) (v2 := b) as HH.
- unfold BVeq in H.
- apply HH in H; [exact H | exact Bool.eqb_true_iff ].
- Qed.
-
- (* NOT IMPORTANT FOR FULL PROOF -> FOR FALSE SIGNAL *)
- Lemma fullAdder_cin {n} (x y : Vector.t bool n) cin:
- let c := N.to_nat (Bv2N y) <= N.to_nat (Bv2N x) in
- let out := if cin
- then (if c then (N.sub (Bv2N x) (Bv2N y)) else Bv2N (Vec.xor (x,y)))
- else (if c then Bv2N (Vector.map negb (Vec.xor (x,y))) else N.add (Bv2N x) (Bv2N (Vector.map negb y))) in
- fst (col fullAdder cin (vcombine x (Vector.map negb y))) =
- Vec.bitvec_literal (N2Bv_sized n out).
- Admitted.
-
- (* NOT IMPORTANT FOR FULL PROOF -> FOR FALSE SIGNAL *)
- Lemma P2Bv_sized_neq_iff (n : nat) (x y : positive) :
- (Pos.size_nat x <= n) ->
- (Pos.size_nat y <= n) ->
- (P2Bv_sized n x <> P2Bv_sized n y) <-> x <> y.
- Proof.
- revert x y; induction n; intros.
- { split; intros.
- { simpl in H1. contradict H1. reflexivity. }
- { pose proof (Pos_size_nat_nonzero x).
- contradict H. apply /negP. rewrite -ltnNge.
- apply /ltP; exact H2. }
- }
- { split; try congruence; [].
- cbn [P2Bv_sized].
- destruct x,y; try congruence; [ | | | ].
- all: cbn [Pos.size_nat] in *.
- all: admit.
- }
- Admitted.
-
- (* NOT IMPORTANT FOR FULL PROOF -> FOR FALSE SIGNAL *)
- Lemma N2Bv_sized_neq_iff: forall (n : nat) (x y : N),
- (N.size_nat x <= n)%coq_nat -> (N.size_nat y <= n)%coq_nat ->
- N2Bv_sized n x <> N2Bv_sized n y <-> x <> y.
- Proof.
- destruct x, y; cbn [N.size_nat N2Bv_sized]; intros; split; intros.
- 8: {
- rewrite P2Bv_sized_neq_iff; try congruence.
- all: apply /leP; try (exact H || exact H0).
- }
- all: try discriminate.
- all: try (cbv [Bvect_false] in H1; done).
- all: try (apply P2Bv_nonzero in H0; apply ssrfun.nesym in H0).
- all: try exact H0.
- all: try by apply P2Bv_nonzero in H.
- all: try (congruence).
- Qed.
-
- (* NOT IMPORTANT FOR FULL PROOF -> FOR FALSE SIGNAL *)
- Lemma FullEmptyLogic_equiv (c : circuit_state FullEmptyLogic) wra rda :
- wra = rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,true)).
- Proof.
- intro H; evar (c' : circuit_state FullEmptyLogic); exists c'.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL subtractor FullVEC];
- cbn [step fst snd].
- rewrite H CavaPreludeProperties.eqb_refl.
- rewrite fullAdder_cin.
- assert ((N.to_nat (Bv2N rda) <= N.to_nat (Bv2N rda)) = true); [by rewrite leqnn | ].
- rewrite H0.
- assert (N.sub (Bv2N rda) (Bv2N rda) = 0%N); [ by rewrite N.sub_diag | ]b_neq;
- [ instantiate (c' := ((), ((), (), ()), ())); by unfold c' | ].
- rewrite !bitvec_literal_correct.
- apply N2Bv_sized_neq_iff.
- { apply Nat.le_0_l. }
- { rewrite N.sub_1_r -Nat2N.inj_pred.
- apply N.size_nat_le_nat; unfold ADDR_WIDTH.
- specialize QUEUE_MAX_SIZE_GT_0 as Hq0.
- apply Nat.log2_spec in Hq0 as [H2 H2_].
- admit. (* lt / log2 / pow 2*)
- }
- { specialize QUEUE_MAX_SIZE_GT_1 as Hq1.
- apply Lt.lt_0_neq in Hq1.
- admit. (* Nat / nat*)
- }
- Admitted.
-
- Definition get_addr (c : circuit_state RequestQueue) :=
- let '(_,(_,(_,(_,(_,(_,_,_),_)),_,_,_,
- (_,_),(_,(_,(_,_,_),_)),_,rda),wra)) := c in (rda,wra).
-
- (* if address are the same -> modify the RequestQueue circuit : send back REQUEST_nil *)
- (* if addresses are different -> step through the queue will read whatever is stored in rda
- is that used in the circuit ? -> yes
- cr will be taken from the queue when (Sidle /\ ~~ empty /\ Cprea)
- *)
-
- (* make a lemma for diff address
- step RequestQueue c (true,c_req,pop) = (c',(f',MemRead@rda,p'))
- *)
-
- (* EMPTY OR NOT, data_o is always what is in rda *)
-
- Lemma RequestQueue_equiv (c : circuit_state RequestQueue) c_req pop :
- let '(rda,wra) := get_addr c in wra = rda -> exists c',
- step RequestQueue c (true,c_req,pop) = (c',(false,REQUEST_NIL,true)).
- Proof.
- simpl in c; destruct_products.
- rename t0 into rda, t into wra.
- cbv [get_addr]; intros.
- evar (c' : circuit_state RequestQueue); exists c'.
- cbv [RequestQueue LoopInit fork2].
- cbn [step fst snd].
- simpl_ret.
-
- specialize FullEmptyLogic_equiv with (c := (u15, (u17, u18, u16), u14)) (wra := wra) (rda := rda)
- as Hequiv1; apply Hequiv1 in H as HH; clear Hequiv1; destruct HH as [cequiv1 Hequiv1].
- rewrite Hequiv1.
- cbn [fst snd bind inv and2 or2].
-
- rewrite negb_false negb_true orbT.
- rewrite andb_false_r andb_true_r.
- Check memqueue.
- rewrite ; simpl (true && true).
-
- simpl (~~ false).
- rewrite orbT.
- progress autorewrite with simpl_ident.
- simpl_ident.
-
- simpl in cequiv1.
- unfold cequiv1. cbn [cequiv1].
- destruct_products.
- fold (memqueue c _).
- repeat destruct_pair_let. cbn [step].
- Admitted.
-
- Theorem SM_Eq (t : nat) (c_state : State_t) (f_req: Request_t)
- (c_req : Bvector REQUEST_WIDTH) :
- let f_state := (Default_arbitrate t).(Implementation_State) in
- let R := Arrival_at t in
- State_Eq f_state c_state -> EqArrival R c_req ->
- let '(f_nextstate,_) := Next_state R f_state in
- let '(c_nextstate,_) := step FIFOSM c_state (true,c_req) in
- State_Eq f_nextstate c_nextstate.
- Proof.
- intros f_state R H Hreq; cbv [FIFOSM] in *.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
- cbv [State_Eq get_st get_cnt get_cref get_wra get_rda get_cr] in H.
- destruct (f_state) eqn:Hf_state.
- { destruct R eqn:HR; [ admit (* impossible, contradicts Hreq *) | ].
- destruct r eqn:HP.
- { move: H => /andP [/andP [/andP [Hs Hc] Hcref] /eqP Haddr]; rewrite eq_refl in Haddr.
- apply BVEq_eq in Hs,Hc,Hcref,Haddr.
- subst s cnt cref wra.
- cbv [LoopInit].
- cbn [step fst snd].
- cbv [ret monad CombinationalSemantics Identity.Monad_ident].
- simpl_ident.
- cbv [ret ].
- destruct_pair_let.
- (* Make a lemma to step through RequestQueue *)
-
- }
- }
-
- (* Default arbitrate should be equal to the simulate function *)
-End EquivalenceProof.
\ No newline at end of file
diff --git a/framework/CavaDRAM/CavaTDM/CavaTDMREF.v b/framework/CavaDRAM/CavaTDM/CavaTDMREF.v
deleted file mode 100644
index 27d5a29..0000000
--- a/framework/CavaDRAM/CavaTDM/CavaTDMREF.v
+++ /dev/null
@@ -1,527 +0,0 @@
-Set Warnings "-notation-overridden,-parsing".
-From CavaDRAM Require Import CavaReqQueue CavaCommonInstances CavaSystem.
-From CoqDRAM Require Import TDM.
-From Coq Require Import BinaryString HexString NArith.
-From Cava Require Import Cava.
-
-Section CavaTDMREF.
-
- (* From CavaDRAM *)
- Context {CAVA_SYS : CavaSystem}.
- (* From Cava *)
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
- (* From CoqDRAM *)
- Context {SYS_CFG : System_configuration} {TDM_CFG : TDM_configuration}.
-
- Definition NR := BANKS.
- Definition STATE_WIDTH := 2.
-
- Definition SLOT_WIDTH := Nat.log2 NR.
- Definition COUNTER_WIDTH := Nat.log2 SL.
- Definition COUNTER_REF_WIDTH := Nat.log2 PREA_date.
-
- Definition state := Vec Bit STATE_WIDTH.
- Definition slot := Vec Bit SLOT_WIDTH.
- Definition counter := Vec Bit COUNTER_WIDTH.
- Definition counter_ref := Vec Bit COUNTER_REF_WIDTH.
-
- Definition empty_t := signal Bit.
- Definition state_t := signal state.
- Definition slot_t := signal slot.
- Definition counter_t := signal counter.
- Definition counter_ref_t := signal counter_ref.
-
- Import CavaReqQueue.DataNotation.
- Open Scope ds.
-
- Definition SLOT_SN := Vec.bitvec_literal (#D (N.of_nat (SN - 1)) | SLOT_WIDTH).
- Definition SLOT_NIL := Vec.bitvec_literal (#D 0 | SLOT_WIDTH).
- Definition SLOT_NIL_VEC := Vector.const false SLOT_WIDTH.
-
- Definition CNT_SL := Vec.bitvec_literal (#D (N.of_nat (SL - 1)) | COUNTER_WIDTH).
- Definition CNT_Z := Vec.bitvec_literal (#D 0 | COUNTER_WIDTH).
- Definition CNT_ACT := Vec.bitvec_literal (#D (N.of_nat ACT_date) | COUNTER_WIDTH).
- Definition CNT_CAS := Vec.bitvec_literal (#D (N.of_nat CAS_date) | COUNTER_WIDTH).
- Definition CNT_NIL := Vec.bitvec_literal (#D (N.of_nat 0) | COUNTER_WIDTH).
- Definition CNT_NIL_VEC := Vector.const false COUNTER_WIDTH.
-
- Definition CNT_REF_SNtSN := Vec.bitvec_literal (#D (N.of_nat (SN * SL - 1)) | COUNTER_REF_WIDTH).
- Definition CNT_REF_PREA := Vec.bitvec_literal (#D (N.of_nat PREA_date) | COUNTER_REF_WIDTH).
- Definition CNT_REF_REF := Vec.bitvec_literal (#D (N.of_nat REF_date) | COUNTER_REF_WIDTH).
- Definition CNT_REF_END := Vec.bitvec_literal (#D (N.of_nat END_REF_date) | COUNTER_REF_WIDTH).
- Definition CNT_REF_NIL := Vec.bitvec_literal (#D (N.of_nat 0) | COUNTER_REF_WIDTH).
- Definition CNT_REF_NIL_VEC := Vector.const false COUNTER_REF_WIDTH.
-
- Definition STATE_IDLE_VEC := (#D 0 | STATE_WIDTH).
- Definition STATE_IDLE := Vec.bitvec_literal STATE_IDLE_VEC.
- Definition STATE_RUN_VEC := (#D 1 | STATE_WIDTH).
- Definition STATE_RUN := Vec.bitvec_literal STATE_RUN_VEC.
- Definition STATE_REF_VEC := (#D 2 | STATE_WIDTH).
- Definition STATE_REF := Vec.bitvec_literal STATE_REF_VEC.
-
- (* Why redefine this ? *)
- #[local] Definition NOP_VEC := (#B "11111" | DRAM_CMD_WIDTH).
- #[local] Definition NOP := Vec.bitvec_literal NOP_VEC.
- #[local] Definition PRE_VEC := (#B "10010" | DRAM_CMD_WIDTH).
- #[local] Definition PRE := Vec.bitvec_literal PRE_VEC.
- #[local] Definition ACT_VEC := (#B "10011" | DRAM_CMD_WIDTH).
- #[local] Definition ACT := Vec.bitvec_literal ACT_VEC.
- #[local] Definition RD_VEC := (#B "10101" | DRAM_CMD_WIDTH).
- #[local] Definition RD := Vec.bitvec_literal RD_VEC.
- #[local] Definition WR_VEC := (#B "10100" | DRAM_CMD_WIDTH).
- #[local] Definition WR := Vec.bitvec_literal WR_VEC.
- #[local] Definition PREA_VEC := (#B "10110" | DRAM_CMD_WIDTH).
- #[local] Definition PREA := Vec.bitvec_literal PREA_VEC.
- #[local] Definition REF_VEC := (#B "10001" | DRAM_CMD_WIDTH).
- #[local] Definition REF := Vec.bitvec_literal REF_VEC.
-
- Definition Sidle (input : state_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,STATE_IDLE).
-
- Definition Srun (input : state_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,STATE_RUN).
-
- Definition Sref (input : state_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,STATE_REF).
-
- Definition CeqZ (input : counter_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_Z).
-
- Definition CeqSL (input : counter_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_SL).
-
- Definition CeqCAS (input : counter_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_CAS).
-
- Definition CeqACT (input : counter_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_ACT).
-
- Definition CrefPREA_eq (input : counter_ref_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_REF_PREA).
-
- Definition CrefPREA_lt (input : counter_ref_t) : cava (signal Bit) :=
- t <- addN (input,CNT_REF_SNtSN) ;;
- s <- greaterThanOrEqual (t,CNT_REF_PREA) ;; inv s.
-
- Definition CrefREF (input : counter_ref_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_REF_REF).
-
- Definition CrefEND (input : counter_ref_t) : cava (signal Bit) :=
- CavaPrelude.eqb (input,CNT_REF_END).
-
- Definition SeqSN (input : signal (Vec Bit SLOT_WIDTH)) : cava (signal Bit) :=
- CavaPrelude.eqb (input,SLOT_SN).
-
- (* Cuts FE_ID_WIDTH to be just the SLOT_WIDTH lsb *)
- (* Definition RequestId : Circuit
- (request_t) (signal (Vec Bit SLOT_WIDTH)) := Comb (fun r =>
- rV <- unpackV r ;;
- packV (slice_default defaultSignal rV 0 SLOT_WIDTH)). *)
-
- (* Will not depend on the slot *)
- Definition NextCR : Circuit
- (state_t * empty_t * counter_t * counter_ref_t * request_t) (request_t)
- := let state_init : combType (request) := Vector.const one (REQUEST_WIDTH) in
- LoopInit state_init (Comb (fun '(s,e,c,cref,tr,cr) =>
- (* signals *)
- s_idle <- Sidle s ;;
- s_run <- Srun s ;;
- (* s_ref <- Sref s ;; *)
- nc_sl <- (CeqSL >=> inv) c ;; cz <- CeqZ c ;;
- c_prea <- (CrefPREA_lt) cref ;;
- ne <- inv e ;;
- (* first mux *)
- mux1_sel <- and2(s_run,nc_sl) ;;
- mux1_out <- mux2 mux1_sel (REQUEST_NIL,cr) ;;
- (* second mux *)
- t0 <- and2 (s_idle,ne) ;;
- t1 <- and2 (c_prea, cz);;
- mux2_sel <- and2 (t0,t1) ;;
- mux2_out <- mux2 mux2_sel (mux1_out,tr) ;;
- ret (mux2_out,mux2_out)
- )).
-
- (*
- Definition CmdGen : Circuit
- (state_t * empty_t * counter_t * counter_ref_t * request_t) (command_t) :=
- Comb (fun '(s,e,c,cref,req) =>
- (* signals *)
- s_idle <- Sidle s ;; s_run <- Srun s ;; s_ref <- Sref s ;;
- c_cas <- CeqCAS c ;; c_act <- CeqACT c ;; cz <- CeqZ c ;;
- c_prea <- CrefPREA_eq cref ;; c_prea' <- CrefPREA_lt cref ;;
- (* c_prea_n <- inv c_prea ;; *)
- c_ref <- CrefREF cref ;;
- ne <- inv e ;;
- (* REF mux *)
- ref_mux_sel <- and2 (s_ref,c_ref) ;;
- ref_mux_out <- mux2 ref_mux_sel (NOP,REF) ;;
- (* PREA mux *)
- prea_mux_sel <- and2 (s_idle,c_prea) ;;
- prea_mux_out <- mux2 prea_mux_sel (ref_mux_out,PREA);;
- (* CAS mux *)
- rd_wr_mux_sel <- RequestType (req) ;;
- rd_wr_mux_out <- mux2 rd_wr_mux_sel (RD,WR) ;;
- cas_mux_sel <- and2 (s_run,c_cas) ;;
- cas_mux_out <- mux2 cas_mux_sel (prea_mux_out,rd_wr_mux_out) ;;
- (* ACT mux *)
- act_mux_sel <- and2 (s_run,c_act) ;;
- act_mux_out <- mux2 act_mux_sel (cas_mux_out,ACT) ;;
- (* PRE mux *)
- t0 <- and2 (s_idle,ne) ;;
- t1 <- and2 (c_prea',cz);;
- pre_mux_sel <- and2 (t0,t1) ;;
- mux2 pre_mux_sel (act_mux_out,PRE)
- ).
- *)
-
- (* Will not depend on the slot *)
- Definition Update_s (input : state_t * empty_t * counter_t * counter_ref_t) :
- cava (state_t) := let '(s,e,c,cref) := input in
- s_idle <- Sidle s ;;
- s_run <- Srun s ;;
- s_ref <- Sref s ;;
- nc_eqsl <- (CeqSL >=> inv) c ;; cz <- CeqZ c ;;
- (* true if there is enough time to treat a request *)
- c_service <- CrefPREA_lt cref ;;
- (* true if it is refresh time *)
- c_prea <- CrefPREA_eq cref ;;
- nc_refend <- (CrefEND >=> inv) cref ;;
- ne <- inv e ;;
- (* first mux *)
- t0 <- and2 (ne,c_service) ;;
- t1 <- and2 (s_idle,cz) ;;
- t' <- and2 (t0,t1);;
- t2 <- and2 (s_run,nc_eqsl) ;;
- mux_idle_run_sel <- or2 (t',t2) ;;
- mux_idle_run_out <- mux2 mux_idle_run_sel (STATE_IDLE,STATE_RUN) ;;
- (* second mux *)
- t3 <- and2 (s_ref,nc_refend) ;;
- t4 <- and2 (s_idle,c_prea) ;;
- mux_ref_sel <- or2 (t3,t4) ;;
- mux2 mux_ref_sel (mux_idle_run_out,STATE_REF).
-
- Definition Update_c (input : state_t * empty_t * counter_t * counter_ref_t) :
- cava (counter_t) := let '(_,_,c,_) := input in
- c_sl <- CeqSL c ;;
- cp1 <- incrN c ;;
- mux2 c_sl (cp1,CNT_NIL).
-
- Definition Update_cref (input : state_t * empty_t * counter_t * counter_ref_t) :
- cava (counter_ref_t) := let '(s,_,_,cref) := input in
- s_idle <- Sidle s ;;
- s_ref <- Sref s ;;
- cref_prea <- CrefPREA_eq cref ;;
- cref_end <- CrefEND cref ;;
- t0 <- and2 (s_ref,cref_end) ;;
- t1 <- and2 (s_idle,cref_prea) ;;
- mux2_sel <- or2 (t0,t1) ;;
- crefp1 <- incrN cref ;;
- mux2 mux2_sel (crefp1,CNT_REF_NIL).
-
- Definition Update_slot (i : state_t * slot_t * empty_t * counter_t * counter_ref_t)
- : cava (slot_t) := let '(_,sl,_,cnt,_) := i in
- mux1_sel <- SeqSN sl ;;
- sp1 <- incrN sl ;;
- mux1_out <- mux2 mux1_sel (sp1,SLOT_NIL) ;;
- mux2_sel <- (CeqSL >=> inv) cnt ;;
- mux2 mux2_sel (mux1_out,sl).
-
- Definition Update : Circuit
- (state_t * slot_t * empty_t * counter_t * counter_ref_t)
- (state_t * slot_t * counter_t * counter_ref_t) :=
- Comb (fun '(s,sl,e,c,cref) =>
- s' <- Update_s (s,e,c,cref) ;;
- sl' <- Update_slot (s,sl,e,c,cref) ;;
- c' <- Update_c (s,e,c,cref) ;;
- cref' <- Update_cref (s,e,c,cref) ;;
- ret (s',sl',c',cref')
- ).
-
- Definition Idx {W A} n
- : signal (Vec A W.+1) -> cava (signal (Vec A W) * signal A) :=
- fun i => o <- Vec.tl i ;; idx <- indexConst i n ;; ret(o,idx).
-
- Fixpoint Queues N : Circuit
- (signal (Vec Bit N) * signal (Vec (Vec Bit REQUEST_WIDTH) N) * signal (Vec Bit N))
- (signal (Vec Bit N) * signal (Vec (Vec Bit REQUEST_WIDTH) N) * signal (Vec Bit N)) :=
- match N with
- | 0 => (Comb (fun '(push_v,data_v,pop_v) =>
- full_def <- Vec.const zero 0 ;;
- data_def <- Vec.const REQUEST_NIL 0 ;;
- empt_def <- Vec.const zero 0 ;;
- ret (full_def,data_def,empt_def)))
- | S n => Comb (fun '(push_v,data_v,pop_v) =>
- let idx := N - (n + 1) in
- '(push_v,push_i) <- Idx idx push_v ;;
- '(data_v,data_i) <- Idx idx data_v ;;
- '(pop_v,pop_i) <- Idx idx pop_v ;;
- ret((push_v,data_v,pop_v),(push_i,data_i,pop_i)))
- >==> First (Queues n) >==> Second RequestQueue
- >==> Comb (fun '((f_pred,d_pred,e_pred),(f,d,e)) =>
- t0 <- Vec.cons f f_pred ;;
- t1 <- Vec.cons d d_pred ;;
- t2 <- Vec.cons e e_pred ;;
- ret (t0,t1,t2)
- )
- end.
-
- (* A 1:N 1-bit demultiplexer *)
- Fixpoint demux_bit W N : Circuit
- (signal Bit * signal (Vec Bit W)) (signal (Vec Bit N)) :=
- match N with
- | 0 => Comb (fun '(_,_) => Vec.const zero 0)
- | S n => Comb (fun '(Rp,sel) =>
- let i := (#D (N.of_nat (NR - (n + 1))) | W) in
- i_vec <- Vec.bitvec_literal i ;;
- eq_sel <- CavaPrelude.eqb(sel,i_vec) ;;
- t <- mux2 eq_sel (zero,Rp) ;;
- ret (t,(Rp,sel)))
- >==> Second (demux_bit W n) >==>
- Comb (fun '(t,t0) => Vec.cons t t0)
- end.
-
- Fixpoint repeatF {A} NR : Circuit (signal A) (signal (Vec A NR)) :=
- match NR with
- | 0 => Comb (fun e => Vec.const e 0)
- | S n => Comb (fork2)
- >==> Second (repeatF n)
- >==> Comb (fun '(t,t0) => Vec.cons t t0)
- end.
-
- Definition mux_sigs N : Circuit
- (signal (Vec Bit N) * signal (Vec (Vec Bit REQUEST_WIDTH) N) * signal (Vec Bit N) * signal (Vec Bit SLOT_WIDTH))
- (signal Bit * request_t * signal Bit) :=
- Comb (fun '(f_vec,d_vec,e_vec,slot) =>
- f <- indexAt f_vec slot ;;
- d <- indexAt d_vec slot ;;
- e <- indexAt e_vec slot ;;
- ret (f,d,e)
- ).
-
- (* push, pop, bank, slot, request -> slot, push_vec, req_vec, pop_vec *)
- Definition DemuxInputs : Circuit
- (signal Bit * signal Bit * request_t * bank_t * slot_t )
- (slot_t * signal (Vec Bit NR) * signal(Vec request NR) * signal (Vec Bit NR)) :=
- Comb (fun '(push,pop,req,bank,sl) => ret (push,pop,bank,sl,(req)))
- (* Repeats req to all queues *)
- >==> Second (repeatF (A := request) NR)
- (* Use the slot to demux the pop signal into the queus*)
- >==> Comb (fun '(push,pop,bank,sl,req_vec) => ret (sl,push,bank,req_vec,(pop,sl)))
- >==> Second (demux_bit SLOT_WIDTH NR)
- (* Use the bank to demux the push signal into the queues *)
- >==> Comb (fun '(sl,push,bank,req_vec,pop_vec) => ret (sl,req_vec,pop_vec,(push,bank)))
- >==> Second (demux_bit BANK_ADDR_WIDTH NR)
- (* Return *)
- >==> Comb (fun '(sl,req_vec,pop_vec,push_vec) => ret (sl,push_vec,req_vec,pop_vec)).
-
- Definition TDMSM_v3 : Circuit
- (signal Bit * request_t) (signal Bit * command_t * request_t) :=
- let slot_init : combType (slot) := SLOT_NIL_VEC in
- let s_init : combType (state) := STATE_IDLE_VEC in
- let cnt_init : combType (counter) := CNT_NIL_VEC in
- let cref_init : combType (counter_ref) := CNT_REF_NIL_VEC in
- Second (Comb (fork2) >==> Second (StripRequest)) >==>
- Comb (fun '(push,(req,(_,_,bank,type))) => ret (push,bank,type,req)) >==>
- LoopInit slot_init (
- LoopInit s_init (
- LoopInit cnt_init (
- LoopInit cref_init ( (* push, bank, type, slot, s, cnt, cref *)
- Comb (fun '(push,bank,type,req,sl,s,cnt,cref) =>
- s_idle <- Sidle s ;;
- c_service <- CrefPREA_lt cref ;;
- pop <- and2 (s_idle,c_service) ;;
- ret(type,req,s,cnt,cref,(push,pop,req,bank,sl)))
- >==> Second (DemuxInputs)
- >==> Comb (fun '(type,req,s,cnt,cref,(sl,push_vec,reqin_vec,pop_vec)) =>
- ret (type,req,s,cnt,cref,sl,(push_vec,reqin_vec,pop_vec)))
- >==> Second (Queues NR)
- >==> Comb (fun '(type,req,s,cnt,cref,sl,(full_vec,data_vec,empty_vec)) =>
- ret (one,NOP,REQUEST_NIL,SLOT_NIL,STATE_IDLE,CNT_NIL,CNT_REF_NIL)))))).
-
- (* Definition TDMSM_ : Circuit
- (signal Bit * request_t) (signal Bit * command_t * request_t) :=
- let slot_init : combType (slot) := SLOT_NIL_VEC in
- let s_init : combType (state) := STATE_IDLE_VEC in
- let cnt_init : combType (counter) := CNT_NIL_VEC in
- let cref_init : combType (counter_ref) := CNT_REF_NIL_VEC in
- LoopInit slot_init (
- LoopInit s_init (
- LoopInit cnt_init (
- LoopInit cref_init ( (* Rp, Rd, sl, st, cnt, cref *)
- Comb (fun '(Rp,Rd,sl,s,cnt,cref) =>
- s_idle <- Sidle s ;;
- c_service <- CrefPREA_lt cref ;;
- pop <- and2 (s_idle,c_service) ;;
- ret(s,cnt,cref,(Rp,Rd,pop,sl))
- ) >==>
- Second (DemuxInputs) >==>
- Comb (fun '(s,cnt,cref,(sl,f_vec,d_vec,e_vec)) => ret(s,cnt,cref,sl,(f_vec,d_vec,e_vec,sl)))
- >==> Second (mux_sigs NR) >==> (* s,cnt,cref,sl,(f,d,e) *)
- Comb (fun '(s,cnt,cref,sl,(full,data,empty)) => ret(full,sl,s,empty,cnt,cref,(s,empty,cnt,cref,data)))
- >==> Second (NextCR) >==> (*full,sl,s,empty,cnt,cref,cr *)
- Comb (fun '(full,sl,s,empty,cnt,cref,cr) => ret(full,cr,sl,s,empty,cnt,cref,(s,empty,cnt,cref,cr)))
- >==> Second (CmdGen) >==>
- Comb (fun '(full,cr,sl,s,empty,cnt,cref,cmd) => ret(full,cmd,cr,(s,sl,empty,cnt,cref)))
- >==> Second (Update_) >==>
- Comb (fun '(full,cmd,cr,(ns,nsl,nc,ncref)) => ret (full,cmd,cr,nsl,ns,nc,ncref)))))).
-
- Definition TDMSM : Circuit
- (signal Bit * request_t) (signal Bit * command_t * request_t) :=
- let pop_init : combType (Bit) := false in
- let slot_init : combType (slot) := SLOT_NIL_VEC in
- let s_init : combType (state) := STATE_IDLE_VEC in
- let cnt_init : combType (counter) := CNT_NIL_VEC in
- let cref_init : combType (counter_ref) := CNT_REF_NIL_VEC in
- LoopInit pop_init ( (* Rp, Rd, p *)
- LoopInit slot_init ( (* Rp, Rd, p, sl*)
- DemuxInputs >==> (* sl, Rp_vec, Rd_vec, E_vec *)
- Comb (fun '(sl,f_vec,d_vec,e_vec) => ret (sl,(f_vec,d_vec,e_vec,sl)))
- >==> Second (mux_sigs NR) >==>
- Comb (fun '(sl,(f,d,e)) => ret (sl,f,d,e)) >==>
- LoopInit s_init (
- LoopInit cnt_init (
- LoopInit cref_init ( (* slot,full,data,empty,state,counter,cref *)
- Comb (fun '(sl,full,data,empty,s,cnt,cref) => ret(full,sl,s,empty,cnt,cref,(s,empty,cnt,cref,data)))
- >==> Second (NextCR) >==> (*full,sl,s,empty,cnt,cref,cr *)
- Comb (fun '(full,sl,s,empty,cnt,cref,cr) => ret(full,cr,sl,s,empty,cnt,cref,(s,empty,cnt,cref,cr)))
- >==> Second (CmdGen) >==>
- Comb (fun '(full,cr,sl,s,empty,cnt,cref,cmd) => ret(full,cmd,cr,(s,sl,empty,cnt,cref)))
- >==> Second (Update) >==>
- Comb (fun '(full,cmd,cr,(ns,nsl,np,nc,ncref)) => ret (full,cmd,cr,np,nsl,ns,nc,ncref))))))). *)
-
-End CavaTDMREF.
-
-Section CavaTDMREFsim.
-
- Existing Instance CavaCombinationalNet.
- Existing Instance CAVA_SYS.
- Existing Instance SYS_CFG.
-
- Program Instance TDM_CFG : TDM_configuration := {
- SL := 32;
- SN := 8
- }.
-
- (* 2 banks -> slot_width *)
- (* Compute circuit_state TDMSM. *)
-
- Definition tdm_interface
- := sequentialInterface "tdm_interface"
- "clk" PositiveEdge "rst" PositiveEdge
- [mkPort "Rp" Bit; mkPort "Rd" (Vec Bit REQUEST_WIDTH)]
- [mkPort "full_o" Bit; mkPort "cmd_o" (Vec Bit DRAM_CMD_WIDTH); mkPort "CR" (Vec Bit REQUEST_WIDTH)].
-
- Definition tdm_netlist := makeCircuitNetlist tdm_interface TDMSM.
-
- (*
-
- Import CavaSM.DataNotation.
- Open Scope data_scope.
- Definition Rsim1_wr := #H "00fe468b00000" | REQUEST_WIDTH.
- Definition Rsim1_rd := #H "00fe468b10000" | REQUEST_WIDTH.
- Definition Rsim2_wr := #H "027f234500001" | REQUEST_WIDTH.
- Definition Rsim2_rd := #H "027f234510001" | REQUEST_WIDTH.
- Definition Rsim3_wr := #H "033f91a200001" | REQUEST_WIDTH.
- Definition Rsim3_rd := #H "033f91a210001" | REQUEST_WIDTH.
- Definition Rsim5_wr := #H "00467f2300007" | REQUEST_WIDTH.
-
- Definition test (e : seq (bool * Bvector REQUEST_WIDTH * bool)) :=
- map (fun '(f,d,e) => (f,HexString.of_N (Bv2N d),e)) e.
-
- Compute (test (simulate RequestQueue [
- (* wra = 0, rda = 0*)
- (true,Rsim1_wr,false);
- (* wra = 1, rda = 0*)
- (false,Rsim2_wr,true);
- (* wra = 1 ,rda = 1 *)
- (true,Rsim1_wr,false)
- ])).
-
- Compute simulate memqueue [
- (* Rsim1_wr @0 *)
- (Rsim1_wr,(#D 0 | ADDR_WIDTH), (#D 0 | ADDR_WIDTH),true);
- (* Reads Rsim_wr @0 *)
- ((#D 1 | REQUEST_WIDTH),(#D 0 | ADDR_WIDTH), (#D 0 | ADDR_WIDTH),true);
- (* Reads R1 @0 *)
- ((#D 2 | REQUEST_WIDTH),(#D 0 | ADDR_WIDTH), (#D 0 | ADDR_WIDTH),true)
- ].
-
- (*
- Definition Rsim1_wr := #H "00fe468b00000" | REQUEST_WIDTH.
- Definition Rsim1_rd := #H "00fe468b10000" | REQUEST_WIDTH.
- Definition Rsim2_wr := #H "027f234500001" | REQUEST_WIDTH.
- Definition Rsim2_rd := #H "027f234510001" | REQUEST_WIDTH.
- Definition Rsim3_wr := #H "033f91a200001" | REQUEST_WIDTH.
- Definition Rsim3_rd := #H "033f91a210001" | REQUEST_WIDTH.
- Definition Rsim5_wr := #H "00467f2300007" | REQUEST_WIDTH.
-
- Definition SM_out := (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH)%type.
-
- Definition cmd2string (cmd : Vector.t bool DRAM_CMD_WIDTH) : string :=
- let eq := Vector.eqb bool eqb cmd in if eq NOP_VEC then "NOP"
- else if eq PRE_VEC then "PRE"
- else if eq ACT_VEC then "ACT"
- else if eq RD_VEC then "RD"
- else if eq WR_VEC then "WR"
- else if eq PREA_VEC then "PREA"
- else if eq REF_VEC then "REF"
- else "INVALID".
-
- Infix "+s+" := String.append (at level 0).
- Definition tuple2string (e : SM_out) : (string) :=
- let '(full,cmd,req) := e in
- let full_str := if full then "FULL, " else "NOT FULL, " in
- let cmd_str := cmd2string cmd in
- let req_N := HexString.of_N (Bv2N req) in (full_str +s+ cmd_str +s+ " ," +s+ req_N).
-
- Fixpoint index_ {T} (e : seq T) : seq nat :=
- match e with
- | [::] => [0]
- | x :: s => [length e] ++ (index_ s)
- end.
-
- Definition map_out (input : seq (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH))
- := zip (rev (index_ input)) (map (tuple2string) input).
-
- Open Scope seq_scope.
- Definition sm_inputs := [
- (true,Rsim1_wr);
- (true,Rsim1_rd);
- (true,Rsim2_wr)
- ] ++ (repeat (false,REQUEST_NIL) 150).
-
- Definition Test1_inputs := [
- (true,Rsim1_wr,false,(#D 0 | SLOT_WIDTH));
- (true,Rsim1_rd,false,(#D 0 | SLOT_WIDTH));
- (true,Rsim2_wr,false,(#D 0 | SLOT_WIDTH));
- (false,REQUEST_NIL,false, (#D 0 | SLOT_WIDTH))
- ].
- Close Scope seq_scope.
-
- Definition map_dvec (e : Vector.t (Vector.t bool REQUEST_WIDTH) NR) :=
- Vector.map (fun el => HexString.of_N (Bv2N el)) e.
-
- Definition map_queues_out (e : combType (Vec Bit NR) * combType (Vec request NR) * combType (Vec Bit NR)) :=
- let '(f_vec,d_vec,e_vec) := e in (f_vec,map_dvec d_vec,e_vec).
-
- Definition map_demux_out
- (e : combType (Vec Bit SLOT_WIDTH) * combType (Vec Bit NR) * combType (Vec request NR) * combType (Vec Bit NR)) :=
- let '(sl,f_vec,d_vec,e_vec) := e in (Bv2N sl,f_vec,map_dvec d_vec,e_vec).
-
- (* Compute (map map_demux_out) (simulate DemuxInputs Test1_inputs). *)
-
- Definition state2string (s : Vector.t bool STATE_WIDTH) : string :=
- let eq := Vector.eqb bool eqb s in if eq STATE_IDLE_VEC then "IDLE"
- else if eq STATE_RUN_VEC then "RUNNING"
- else if eq STATE_REF_VEC then "REFRESHING"
- else "STATE INVALID".
-
- Definition map_update_out (e : seq (Vector.t bool STATE_WIDTH * Vector.t bool SLOT_WIDTH *
- bool * Vector.t bool COUNTER_WIDTH * Vector.t bool COUNTER_REF_WIDTH))
- := map (fun '(s,sl,e,cnt,cref) => (state2string s,Bv2N sl, e,Bv2N cnt,Bv2N cref)) e.
-
- Compute (map_out (simulate TDMSM sm_inputs)). *)
-
- *)
-
-End CavaTDMREFsim.
diff --git a/framework/CavaDRAM/CavaTDM/CavaTDMREFProperties.v b/framework/CavaDRAM/CavaTDM/CavaTDMREFProperties.v
deleted file mode 100644
index e84159a..0000000
--- a/framework/CavaDRAM/CavaTDM/CavaTDMREFProperties.v
+++ /dev/null
@@ -1,111 +0,0 @@
-Set Printing Projections.
-Set Warnings "-notation-overridden,-parsing".
-
-From CavaDRAM Require Import CavaTDMREF CavaSM CavaReqQueue CavaCommonInstances CavaSubtractor Step CavaSystem Memory Util UtilSM.
-From CoqDRAM Require Import TDM.
-From Coq Require Import Program BinaryString HexString NArith.
-From Cava Require Import Cava CavaProperties Util.Vector Util.Tactics.
-From mathcomp Require Import fintype ssrZ zify ring.
-
-Section CavaFIFOREFProperties.
- (* From Cava *)
- Existing Instance CombinationalSemantics.
- (* From CavaDRAM*)
- Context {CAVA_SYS : CavaSystem}.
- (* From CoqDRAM *)
- Existing Instance REQESTOR_CFG.
- Context {SYS_CFG : System_configuration}.
- Context {TDM_CFG : TDM_configuration}.
- Context {HAF : HW_Arrival_function_t}.
- Existing Instance ARBITER_CFG.
- Existing Instance TDM_implementation.
-
- Import Memory.Properties BvectorNotations.
- Open Scope Bvector_scope.
-
- Definition State_t := circuit_state TDMSM.
-
- Definition get_state (s : State_t) : combType (CavaTDMREF.state) :=
- let '(_,(_,(_,_,_,_,_,_,_,_,_,_,_,_,(_,(_,_,st)),_),_)) := s in st.
-
- Definition get_slot (s : State_t) : combType (Vec Bit SLOT_WIDTH) :=
- let '(_,(_,(_,_, _,_,_,_,_,_,_,_,_,_,_,slot),_)) := s in slot.
-
- Definition get_pop (s : State_t) : combType Bit :=
- let '(_,(_,_,pop)) := s in pop.
-
- Definition get_cnt (s : State_t) : combType (Vec Bit COUNTER_WIDTH) :=
- let '(_,(_,(_,_,_,_,_,_,_,_,_,_,_,_,(_,(_,(_,_,cnt),_)),_),_)) := s in cnt.
-
- Definition get_cref (s : State_t) : combType (Vec Bit COUNTER_REF_WIDTH) :=
- let '(_,(_,(_,_,_,_,_,_,_,_,_,_,_,_,(_,(_,(_,(_,_,_,_,_,_,_,cref),_),_)),_),_)) := s in cref.
-
- Definition get_req (s : State_t) : combType (Vec Bit REQUEST_WIDTH) :=
- let '(_,(_,(_,_,_,_,_,_,_,_,_,_,_,_,(_,(_,(_,(_,(_, (_,req)),_,_,_,_,_,_),_),_)),_),_)) := s in req.
-
- Definition cnt2Bv (cnt : Counter_t) :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
-
- Definition cref2Bv (cref : Counter_ref_t) :=
- N2Bv_sized COUNTER_REF_WIDTH (N.of_nat (nat_of_ord cref)).
-
- Definition slot2Bv (slot : Slot_t) :=
- N2Bv_sized SLOT_WIDTH (N.of_nat (nat_of_ord slot)).
-
- Definition get_mem (s : State_t) : circuit_state (Queues NR) :=
- let '(_,(_,(_,_,_,_,_,_,_,mem,_,_,_,_,_,_),_)) := s in mem.
-
- (* Think about this *)
- Definition MemPred (P : Requests_t) (mem : circuit_state (Queues NR)) : bool.
- Admitted.
-
- Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
- Admitted.
-
- (* Think about EqMem and EqQueues *)
- Definition State_Eq (fs : TDM_state_t) (cs : State_t) : bool :=
- let cs_state := get_state cs in
- let cs_sl := get_slot cs in
- let cs_cnt := get_cnt cs in
- let cs_cref := get_cref cs in
- let cs_mem := get_mem cs in
- let cs_pop := get_pop cs in
- let cs_req := get_req cs in
- match fs with
- | IDLE sl cnt cref P => (cs_state =? STATE_IDLE_VEC)
- && (cs_sl =? slot2Bv sl) && (cs_cnt =? cnt2Bv cnt) && (cs_cref =? cref2Bv cref)
- && (MemPred P cs_mem) && (cs_pop == false)
- | RUNNING sl cnt cref P r => (cs_state =? STATE_RUN_VEC)
- && (cs_sl =? slot2Bv sl) && (cs_cnt =? cnt2Bv cnt) && (cs_cref =? cref2Bv cref)
- && (MemPred P cs_mem) && (cs_pop == (nat_of_ord cnt == 1)) && (EqReq r cs_req)
- | REFRESHING sl cnt cref P => (cs_state =? STATE_REF_VEC)
- && (cs_sl =? slot2Bv sl) && (cs_cnt =? cnt2Bv cnt) && (cs_cref =? cref2Bv cref)
- && (MemPred P cs_mem) && (cs_pop == false)
- end.
-
- Theorem TS_Bisimulation (c_req : Bvector REQUEST_WIDTH) :
- forall c_state t,
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- State_Eq f_state c_state -> EqReq R c_req ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R f_state in
- exists c_nextstate, (c_nextstate = fst (step TDMSM c_state (true,c_req))) /\
- State_Eq f_nextstate c_nextstate.
- Proof.
- intros c_state t f_state R H Hreq.
- repeat destruct_pair_let.
- eapply ex_intro; split; [reflexivity | ].
- unfold State_t in c_state; simpl in c_state; destruct_products.
- rename t4 into cr, t3 into cref, t2 into cnt, t1 into state, t0 into slot, b into pop.
- unfold State_Eq in H; cbv [get_state get_slot get_cnt get_cref get_pop get_mem] in H.
- destruct f_state eqn:Hf_state.
- { move: H => /andP [/andP [/andP [/andP [/andP [EqS EqSlot] EqCnt] EqCref] EqMem] EqPop].
- apply BVEq_iff_eq in EqS, EqSlot, EqCnt, EqCref; move: EqPop => /eqP EqPop;
- subst state slot cnt cref pop.
- cbv [TDMSM LoopInit].
- cbn [step fst snd]; simpl_ret.
- admit.
- }
- Admitted.
-
-End CavaFIFOREFProperties.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Core/CavaCommonInstances.v b/framework/CavaDRAM/Core/CavaCommonInstances.v
index a150dfc..c996903 100644
--- a/framework/CavaDRAM/Core/CavaCommonInstances.v
+++ b/framework/CavaDRAM/Core/CavaCommonInstances.v
@@ -1,11 +1,13 @@
Set Warnings "-notation-overridden,-parsing".
+
From CavaDRAM Require Import CavaSystem.
-From CoqDRAM Require Import System.
+From DRAM Require Import System.
From Coq Require Program.
From mathcomp Require Import fintype ssrZ zify ring.
Section CommonInstances.
+(* Useful for testing *)
Program Instance CAVA_SYS : CavaSystem := {
DRAM_CMD_WIDTH := 5;
(* FE_ADDR_WIDTH := 32 *)
diff --git a/framework/CavaDRAM/Core/CavaCounter.v b/framework/CavaDRAM/Core/CavaCounter.v
deleted file mode 100644
index b261b5a..0000000
--- a/framework/CavaDRAM/Core/CavaCounter.v
+++ /dev/null
@@ -1,47 +0,0 @@
-Require Export Cava.Cava.
-Require Export Cava.CavaProperties.
-
-Export Circuit.Notations.
-
-Require Export Coq.Vectors.Fin.
-Require Export Coq.Bool.Bool.
-Require Export Coq.Program.Basics.
-Require Export FunInd.
-
-Require Export CavaSystem.
-(* Require Export CavaUtil. *)
-Require Export CavaMemory.
-
-Require Export Lia.
-Require Export Omega.
-
-From CoqDRAM Require Export FIFO.
-
-Section CavaCounter.
-
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
-
- Context {CAVA_SYS : CavaSystem}.
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
-
- Definition COUNTER_WIDTH := Nat.log2 WAIT.
-
- Definition incrN_circ :
- Circuit (signal (Vec Bit COUNTER_WIDTH)) (signal (Vec Bit COUNTER_WIDTH)) :=
- Comb (incrN).
-
- (* Counter with wrap arround : assynchronous reset input *)
- Definition CavaCounter_t
- : Circuit (signal Bit) (signal (Vec Bit COUNTER_WIDTH)) :=
- let count_init : combType (Vec Bit COUNTER_WIDTH) := Vector.const zero COUNTER_WIDTH in
- LoopInit count_init ( (* rst, count *)
- Comb (fun '(rst,count) =>
- let zero_out := Vec.bitvec_literal (N2Bv_sized COUNTER_WIDTH 0) in
- cp1 <- incrN count ;;
- out <- mux2 rst (cp1,zero_out) ;;
- ret (out,out)
- )
- ).
-
-End CavaCounter.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Core/CavaCounterProperties.v b/framework/CavaDRAM/Core/CavaCounterProperties.v
deleted file mode 100644
index a12f233..0000000
--- a/framework/CavaDRAM/Core/CavaCounterProperties.v
+++ /dev/null
@@ -1,201 +0,0 @@
-Require Import CavaCounter.
-
-Section CavaCounterProperties.
-
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
- Context {CAVA_SYS : CavaSystem}.
- Existing Instance CombinationalSemantics.
-
- Axiom WAIT_gt_one : 1 < WAIT.
-
- Fixpoint counter_spec_ (rst : list bool) : list nat :=
- match rst with
- | [] => []
- | h :: t =>
- let prev := counter_spec_ t in
- let e := hd 0 prev in
- if (eqb h true || Nat.eqb e WAIT.-1) then app[0] prev
- else (if (Nat.eqb e 0) then app [1] prev else app [e + 1] prev)
- end.
-
- Definition counter_spec (rst : list (combType Bit)) : list N :=
- map (N.of_nat) (rev (counter_spec_ (rev rst))).
-
- Definition counter_spec_vec (rst : list (combType Bit)) : list (combType (Vec Bit COUNTER_WIDTH)) :=
- map (N2Bv_sized COUNTER_WIDTH) (counter_spec rst).
-
- Fixpoint counter_val_ (rst : list bool) c : nat :=
- match rst with
- | [] => c
- | b :: t =>
- if (Bool.eqb b false) then
- (if (c + 1 < WAIT) then counter_val_ t (c + 1) else counter_val_ t 0)
- else
- counter_val_ t 0
- end.
-
- Functional Scheme counter_val_ind := Induction for counter_val_ Sort Prop.
- Check counter_val_ind.
-
- Lemma counter_val_bounded rst c:
- List.length rst > 0 ->
- counter_val_ rst c < WAIT.
- Proof.
- pattern rst, (counter_val_ rst c);
- apply counter_val_ind; intros; clear rst c.
- 1: discriminate.
- all: destruct (Datatypes.length t > 0) eqn:Hbug; try by apply H.
- all: try (
- rewrite lt0n in Hbug; move: Hbug => /eqP Hbug; apply length_zero_iff_nil in Hbug;
- rewrite Hbug //=
- ).
- all: exact WAIT_pos.
- Qed.
-
- Lemma counter_val_last_true (l : list bool) c (def : bool) :
- List.length l > 0 -> List.last l def = true ->
- counter_val_ l c = 0.
- Proof.
- pattern l, (counter_val_ l c);
- apply counter_val_ind; intros; clear l c.
- 1: discriminate.
- all: destruct (Datatypes.length t > 0) eqn:Hbug.
- all: try (
- rewrite lt0n in Hbug; move: Hbug => /eqP Hbug;
- apply length_zero_iff_nil in Hbug; rewrite Hbug in H1;
- rewrite Hbug //=
- ).
- all: try (
- contradict e0; simpl in H1; rewrite H1 //=
- ).
- all: apply H; try done; destruct t; (discriminate || exact H1).
- Qed.
-
- Lemma aux l c:
- Datatypes.length l > 0 ->
- counter_val_ (removelast l) (c + 1) = counter_val_ (removelast (false :: l)) c.
- Proof.
- Admitted.
-
- (* pattern c, (counter_val_ t c); apply counter_val_ind; intros.
- 1: discriminate.
- { apply eqb_prop in e0; subst b rst; clear c; simpl; by rewrite e1. }
- { apply eqb_prop in e0; subst b rst; clear c; simpl; rewrite e1.
- rewrite add0n WAIT_gt_one.
- destruct (c0 + 1 + 1 < WAIT) eqn:Hcont.
- { contradict e1; apply not_false_iff_true.
- apply ltn_trans with (m := c0 + 1) in Hcont.
- 1: exact Hcont.
- apply nat_ltn_add; done. }
- { admit. }
- }
- { admit. }
- Admitted. *)
-
- Lemma counter_val_last_false (l : list bool) c (def : bool) :
- List.length l > 1 -> List.last l def = false ->
- let l0 := removelast l in
- if (List.last l0 def == true) then counter_val_ l c = 1
- else counter_val_ l c = (counter_val_ l0 c).+1.
- Proof.
- pattern l,(counter_val_ l c); apply counter_val_ind; intros.
- 1: simpl in H; discriminate.
- { apply eqb_prop in e0; subst b rst; unfold l0 in *; clear l0.
- destruct (Datatypes.length t > 1) eqn:Hbug.
- { admit. }
- { clear H.
- destruct t eqn:Ht.
- { subst t; simpl in *; inversion H0. }
- { rewrite cons_length in Hbug.
- rewrite ltnS lt0n in Hbug.
- move: Hbug => /eqP Hbug; apply length_zero_iff_nil in Hbug; subst l0; simpl in *.
- subst b; simpl; rewrite e1.
- destruct (c0 + 1 + 1 < WAIT) eqn:Hwait.
- { rewrite addn1; reflexivity. }
- { admit. }
- }
- }
- }
- all: admit.
- Admitted.
-
- Definition counter_invariant
- (input : list bool)
- (t : nat)
- (loop_state : unit * combType (Vec Bit COUNTER_WIDTH))
- (output_accumulator : list (combType (Vec Bit COUNTER_WIDTH))) : Prop :=
- loop_state = (tt, N2Bv_sized COUNTER_WIDTH (N.of_nat (counter_val_ (firstn t input) 0)))
- /\ output_accumulator = counter_spec_vec (firstn t input).
-
- Check counter_invariant.
-
- Lemma last_app l d (b : bool):
- List.last (app l [b]) d = b.
- Proof.
- induction l.
- { simpl; reflexivity. }
- simpl.
- destruct (app l [b]) eqn:Hseq.
- { apply app_eq_nil in Hseq; destruct Hseq as [_ Hbug]; discriminate. }
- exact IHl.
- Qed.
-
- (* Variable asy_rst : list (combType Bit).
-
- Check counter_invariant asy_rst.
-
- Check fold_left_accumulate_invariant_seq.
-
- Check fold_left_accumulate_invariant_seq (counter_invariant asy_rst). *)
-
- Lemma counter_correct (asy_rst : list (combType Bit)) :
- simulate CavaCounter_t asy_rst = counter_spec_vec asy_rst.
- Proof.
- cbv [CavaCounter_t]; autorewrite with push_simulate; simpl_ident.
- (* apply fold_left_accumulate_invariant_seq with (I := counter_invariant asy_rst). *)
- eapply fold_left_accumulate_invariant_seq with (I := counter_invariant asy_rst).
- { (* prove that the invariant holds at the start of the loop *)
- cbv [counter_invariant]; cbn; split; reflexivity. }
- { (* prove that, if the invariant holds at the beginning of the loop body for t, it should hold for t + 1*)
- cbv [counter_invariant step]. intros. logical_simplify. subst.
- split.
- { unfold fst; rewrite mux2_correct; destruct (t > 0) eqn:Ht.
- { destruct (List.nth t asy_rst d) eqn:H; apply firstn_succ_snoc with (d0 := d) in H1 as Hx; rewrite H in Hx; rewrite Hx.
- { specialize last_app with (l := firstn t asy_rst) (d := d) (b := true) as HH.
- apply counter_val_last_true with (c := 0) in HH.
- 2: by rewrite app_length addn_gt0 ltnS leqnn orbT.
- rewrite HH; reflexivity. }
- { rewrite incrN_correct Bv2N_N2Bv_sized.
- 2: admit.
- specialize last_app with (l := firstn t asy_rst) (d := d) (b := false) as HH.
- apply counter_val_last_false with (c := 0) in HH.
- 2: admit.
- (* 2: by rewrite app_length addn_gt0 //= ltnS leqnn orbT. *)
- rewrite removelast_app //= app_nil_r in HH.
- destruct (List.last (firstn t asy_rst) d == true) eqn:Hy; rewrite Hy in HH; rewrite HH.
- { move: Hy => /eqP Hy.
- apply counter_val_last_true with (c := 0) in Hy.
- 2: {
- rewrite firstn_length min_l.
- 2: by apply Nat.lt_le_incl.
- exact Ht.
- }
- rewrite Hy; reflexivity. }
- { specialize Nat2N.inj_add with (n := counter_val_ (firstn t asy_rst) O) (n' := 1) as Hinj.
- rewrite -Hinj Nat.add_1_r; reflexivity. }}
- }
- { rewrite lt0n in Ht; move: Ht => /eqP Ht; rewrite Ht //=.
- destruct (List.nth 0 asy_rst d) eqn:H; rewrite H //=; try rewrite incrN_correct;
- destruct (asy_rst) eqn:Hasy; try (by simpl).
- all: try (simpl; simpl in H; rewrite H //=).
- all: try (by simpl in H1; rewrite Ht in H1; inversion H1).
- rewrite add0n WAIT_gt_one; rewrite Bv2N_Bvect_false; reflexivity.
- }
- }
- { admit. }
- }
- { admit. }
- Admitted.
-
-End CavaCounterProperties.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Core/CavaDemux.v b/framework/CavaDRAM/Core/CavaDemux.v
deleted file mode 100644
index 0eac003..0000000
--- a/framework/CavaDRAM/Core/CavaDemux.v
+++ /dev/null
@@ -1,69 +0,0 @@
-From Cava Require Export Cava CavaProperties.
-From CavaDRAM Require Import CavaSystem.
-From mathcomp Require Export ssreflect ssrnat ssrbool seq eqtype.
-
-Import Vec.BitVecNotations.
-Open Scope bitvec_scope.
-
-Section CavaDemux.
-
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
-
- Definition ext_const {n} (input : signal Bit) : cava (signal (Vec Bit n)) :=
- t0 <- Vec.const zero n ;; t1 <- Vec.const one n ;;
- mux2 input (t0,t1).
-
- Definition demux2 {n} : Circuit (signal Bit * signal (Vec Bit n))
- (signal (Vec (Vec Bit n) 2)) :=
- Comb (fun '(sel,F) =>
- sel_ext <- ext_const sel ;;
- inv_sel <- inv sel ;;
- inv_sel_ext <- ext_const inv_sel ;;
- A <- Vec.and(F,inv_sel_ext) ;; AV <- unpackV A ;;
- B <- Vec.and(F,sel_ext) ;; BV <- unpackV B ;;
- Vec.packV2([AV;BV])
- ).
-
- Definition demux2' {n} : Circuit (signal (Vec Bit 1) * signal (Vec Bit n))
- (signal (Vec (Vec Bit n) 2)) :=
- Comb (fun '(sel,F) =>
- sel <- indexConst sel 0 ;;
- sel_ext <- ext_const sel ;;
- inv_sel <- inv sel ;;
- inv_sel_ext <- ext_const inv_sel ;;
- A <- Vec.and(F,inv_sel_ext) ;; AV <- unpackV A ;;
- B <- Vec.and(F,sel_ext) ;; BV <- unpackV B ;;
- Vec.packV2([AV;BV])
- ).
-
- Definition demux2_ {n} (inputs: signal Bit * signal (Vec Bit n))
- : cava (signal (Vec (Vec Bit n) 2)) :=
- let '(sel,F) := inputs in
- sel_ext <- ext_const sel ;;
- inv_sel <- inv sel ;;
- inv_sel_ext <- ext_const inv_sel ;;
- A <- Vec.and(F,inv_sel_ext) ;; AV <- unpackV A ;;
- B <- Vec.and(F,sel_ext) ;; BV <- unpackV B ;;
- Vec.packV2([AV;BV]).
-
- Definition demux4 {n} : Circuit (signal (Vec Bit 2) * signal (Vec Bit n))
- (signal (Vec (Vec Bit n) 4)) :=
- Comb (fun '(sel,F) =>
- (* first bit of sel *)
- bit0_sel <- Vec.const zero 1 ;; sel0 <- indexAt sel bit0_sel ;;
- inv_sel0 <- inv sel0 ;;
- inv_sel0_ext <- ext_const inv_sel0 ;;
- sel0_ext <- ext_const sel0 ;;
- (* second bit of sel *)
- bit1_sel <- Vec.const one 1 ;; sel1 <- indexAt sel bit1_sel ;;
- inv_sel1 <- inv sel1 ;; inv_sel1_ext <- ext_const inv_sel1 ;;
- sel1_ext <- ext_const sel1 ;;
- (* Outputs *)
- A <- F & inv_sel0_ext & inv_sel1_ext ;; AV <- unpackV A ;;
- B <- F & sel0_ext & inv_sel1_ext ;; BV <- unpackV B ;;
- C <- F & inv_sel0_ext & sel1_ext ;; CV <- unpackV C ;;
- D <- F & sel0_ext & sel1_ext ;; DV <- unpackV D ;;
- Vec.packV2 [AV;BV;CV;DV]
- ).
-
-End CavaDemux.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Core/CavaMemory.v b/framework/CavaDRAM/Core/CavaMemory.v
deleted file mode 100644
index 67220d3..0000000
--- a/framework/CavaDRAM/Core/CavaMemory.v
+++ /dev/null
@@ -1,66 +0,0 @@
-From Cava Require Import Cava CavaProperties Lib.Multiplexers Lib.Vec.
-
-(* From Coq Require Import Vectors.Fin Bool.Bool Program.Basics. *)
-
-From CavaDRAM Require Import CavaSystem.
-
-Import Circuit.Notations.
-Import Init.Logic.EqNotations.
-
-Section CavaMemory.
- Context {signal} `{Cava' : Cava signal}.
- (* write data * write address * write enable -> write data * write enable * read enable *)
- Definition isN T W N (input : signal T * signal (Vec Bit W) * signal Bit)
- : cava (signal T * signal Bit * signal Bit) :=
- let '(wd, wa, we) := input in
- ca <- (Vec.of_N (N.of_nat N));; (* current address *)
- re <- eqb (ca, wa);; (* check if N matches wa *)
- t <- and2 (re, we);;
- ret (wd, t, re).
-
- Definition isN_ext T W N (input : signal T * signal (Vec Bit W) * signal (Vec Bit W) * signal Bit)
- : cava (signal T * signal Bit * signal Bit) :=
- let '(wd,wa,ra,we) := input in
- ca <- (Vec.of_N (N.of_nat N));;
- re <- eqb(ca,ra) ;;
- we_ <- eqb(ca,wa) ;;
- we <- and2 (we,we_) ;;
- ret (wd,we,re).
-
- (* write data * write enable -> read data*)
- Definition mem_cell T :=
- DelayCE (t := T).
-
- (* read data A * read data B * select -> read data *)
- Definition mem_select T (input : signal T * (signal T * signal Bit)) : cava (signal T) :=
- let '(rdA, (rdB, sel)) := input in
- v <- mux2 sel (rdA, rdB);;
- ret v.
-
- Fixpoint memory T W N :=
- match N with
- | 0 => Comb (isN T W 0) >==> First (mem_cell T) >==> Comb(dropr)
- | S N' => Comb(fork2)
- >==> First (memory T W N')
- >==> Second (Comb (isN T W N) >==> First (mem_cell T))
- >==> Comb (mem_select T)
- end.
-
- (* inputs : write data, write address, read address, write enable *)
- (* output : read data *)
- (* T : data type, W : address size, N : memory size *)
- Fixpoint memory_dp T W N
- : Circuit (signal T * signal (Vec Bit W) * signal (Vec Bit W) * signal Bit)
- (signal T) :=
- match N with
- | 0 => Comb (isN_ext T W 0) >==> First (mem_cell T) >==> Comb(dropr)
- | S N' => Comb(fork2)
- >==> First (memory_dp T W N')
- >==> Second (Comb (isN_ext T W N) >==> First (mem_cell T))
- >==> Comb (mem_select T)
- end.
-
-End CavaMemory.
-
-
-
diff --git a/framework/CavaDRAM/Core/CavaReqQueue.v b/framework/CavaDRAM/Core/CavaReqQueue.v
index 8200b90..ba5e888 100644
--- a/framework/CavaDRAM/Core/CavaReqQueue.v
+++ b/framework/CavaDRAM/Core/CavaReqQueue.v
@@ -1,7 +1,7 @@
From Cava Require Import Cava CavaProperties.
From Coq Require Import Vectors.Fin Bool.Bool Program BinaryString HexString NArith.
-From CavaDRAM Require Import CavaSystem CavaMemory CavaSubtractor Memory.
+From CavaDRAM Require Import CavaSystem CavaSubtractor Memory.
From mathcomp Require Import ssreflect.
Export Circuit.Notations.
@@ -65,8 +65,9 @@ Section CavaReqQueue.
type <- packV (slice_default defaultSignal rV (ROW_ADDR_WIDTH + COL_ADDR_WIDTH + BANK_ADDR_WIDTH) FE_CMD_WIDTH) ;;
ReqType type.
- Definition memqueue :=
- memory_dp (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (QUEUE_MAX_SIZE - 1).
+ (*
+ Definition memqueue := memory_dp (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (QUEUE_MAX_SIZE - 1).
+ *)
Definition InitMem (n : nat) := Bvect_false REQUEST_WIDTH.
diff --git a/framework/CavaDRAM/Core/CavaSM.v b/framework/CavaDRAM/Core/CavaSM.v
deleted file mode 100644
index 6577229..0000000
--- a/framework/CavaDRAM/Core/CavaSM.v
+++ /dev/null
@@ -1,51 +0,0 @@
-From CavaDRAM Require Import CavaReqQueue.
-From DRAM Require Import System.
-From Coq Require Import BinaryString HexString NArith.
-
-Module DataNotation.
-Declare Scope data_scope.
-Delimit Scope data_scope with ds.
-Infix "++" := Vector.append.
-Notation "'#B' n '|' w" := (N2Bv_sized w (BinaryString.Raw.to_N n 0)) (at level 0) : data_scope.
-Notation "'#D' n '|' w" := (N2Bv_sized w n) (at level 0) : data_scope.
-Notation "'#H' n '|' w" := (N2Bv_sized w (HexString.Raw.to_N n 0)) (at level 0) : data_scope.
-End DataNotation.
-
-Section CavaSM.
-
- Context {CAVA_SYS : CavaSystem}.
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
- Context {SYS_CFG : System_configuration}.
-
- Definition powerOfTwo (n : nat) : bool :=
- N.eqb (N.land (N.of_nat n) (N.of_nat (n - 1))) 0.
-
- Import DataNotation.
- Open Scope data_scope.
- Definition request := Vec Bit REQUEST_WIDTH.
- Definition request_t := signal request.
- Definition REQUEST_NIL := Vec.bitvec_literal (#D 0 | REQUEST_WIDTH).
- Definition READ_REQUEST := Vec.bitvec_literal (#D 1 | FE_CMD_WIDTH).
- Definition WRITE_REQUEST := Vec.bitvec_literal (#D 0 | FE_CMD_WIDTH).
-
- Definition command := Vec Bit DRAM_CMD_WIDTH.
- Definition command_t := signal command.
-
- Definition ReqType (input : signal (Vec Bit FE_CMD_WIDTH)) : cava (signal Bit) :=
- CavaPrelude.eqb (input,WRITE_REQUEST).
-
- Definition RequestType (r : request_t) : cava (signal Bit) :=
- rV <- unpackV r ;;
- r_type' <- packV (slice_default defaultSignal rV FE_ID_WIDTH FE_CMD_WIDTH) ;; (* 1 bit vector *)
- ReqType r_type'.
-
- Class CavaSMImplementation :=
- {
- STATE_WIDTH : N;
-
- SM : Circuit (signal Bit * request_t)
- (signal Bit * request_t * command_t);
- }.
-
-End CavaSM.
-
diff --git a/framework/CavaDRAM/Core/CavaSMExtraction.v b/framework/CavaDRAM/Core/CavaSMExtraction.v
deleted file mode 100644
index e9e8a0f..0000000
--- a/framework/CavaDRAM/Core/CavaSMExtraction.v
+++ /dev/null
@@ -1,25 +0,0 @@
-Set Warnings "-notation-overridden,-parsing".
-
-Require Import CavaFIFOREF.
-
-Require Import Extraction.
-Require Import ExtrHaskellBasic.
-Require Import ExtrHaskellNatInt.
-Require Import ExtrHaskellNatInteger.
-Require Import ExtrHaskellNatNum.
-Require Import ExtrHaskellString.
-Require Import ExtrHaskellZInt.
-Require Import ExtrHaskellZInteger.
-Require Import ExtrHaskellZNum.
-
-Extraction Language Haskell.
-
-Cd "fifo_gencode".
-Recursive Extraction Library CavaFIFOREF.
-Cd "..".
-
-(*
-Cd "tdm_gencode".
-Recursive Extraction Library CavaTDMREF.
-Cd "..".
-*)
diff --git a/framework/CavaDRAM/Core/CavaSMProperties.v b/framework/CavaDRAM/Core/CavaSMProperties.v
deleted file mode 100644
index 73da64b..0000000
--- a/framework/CavaDRAM/Core/CavaSMProperties.v
+++ /dev/null
@@ -1,666 +0,0 @@
-Require Import CavaSM.
-Require Import CavaSubtractorProperties.
-Require Import Program.
-
-Section CavaSMProperties.
-
- (* Cava silveroak *)
- Existing Instance CombinationalSemantics.
-
- (* CavaDRAM *)
- Context {CAVA_SYS : CavaSystem}.
-
- (* DRAM *)
- Existing Instance REQESTOR_CFG.
-
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
- Context {AF : Arrival_function_t}.
-
- Existing Instance FIFO_implementation.
- Existing Instance FIFO_arbiter.
-
- Definition ACT_vec :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat Cava_ACT_date).
-
- Definition PRE_vec :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat 0).
-
- Definition CAS_vec :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat Cava_CAS_date).
-
- Definition Command_Eq (cmd : Command_kind_t) (cava_cmd : combType (Vec Bit DRAM_CMD_WIDTH)) : bool :=
- match cmd with
- | ACT => Vector.eqb bool eqb cava_cmd ACT_vec
- | PRE => Vector.eqb bool eqb cava_cmd PRE_vec
- | CRD => Vector.eqb bool eqb cava_cmd CAS_vec
- | CWR => Vector.eqb bool eqb cava_cmd CAS_vec
- | _ => false
- end.
-
- Definition CavaFIFO_state := circuit_state CavaFIFO_NextState.
-
- Definition CavaFIFO_state2tuple (state : CavaFIFO_state) :=
- let '(_,(_,(_,(_,cnt),s),p)) := state in (p,(s,cnt))%type.
-
- Definition cnt2Bv (cnt : Counter_t) :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)) .
-
- Definition State_Eq (fram_state : FIFO_state_t) (cava_state : CavaFIFO_state)
- (ar_req : Requests_t) : bool :=
- let '(p,(s,cnt)) := CavaFIFO_state2tuple cava_state in
- match fram_state with
- | IDLE c P => (s == false) && (Vector.eqb bool Bool.eqb (cnt2Bv c) cnt)
- && (p == (P != cat [::] ar_req))
- | RUNNING c P r => (s == true) && (Vector.eqb bool Bool.eqb (cnt2Bv c) cnt)
- && (p == ((P != cat [::] ar_req) && (nat_of_ord c == WAIT.-1)))
- end.
-
- Definition State_Eq_ (fram_state : FIFO_state_t) (state : CavaFIFO_state) (ar_req : Requests_t) : bool :=
- let '(_,(_,(_,(_,(_,(_,(_, (_, (_, (_, _, _), _)), _, memory_state, _,
- (_, _), (_, (_, (_, _, _), _)), _, wra), rda)), _,
- (_, (_, creq)), _, _, _, _, _, cnt), s), p)) := state in
- match fram_state with
- | IDLE c P =>
- (s == false) &&
- (Vector.eqb bool Bool.eqb (cnt2Bv c) cnt) &&
- (p == (P != cat [::] ar_req)) &&
- ((P == [::]) == (Vector.eqb bool Bool.eqb wra rda))
- | RUNNING c P r =>
- (s == true) &&
- (Vector.eqb bool Bool.eqb (cnt2Bv c) cnt) &&
- (p == ((P != cat [::] ar_req) && (nat_of_ord c == WAIT.-1))) &&
- ((P == [::]) == (Vector.eqb bool Bool.eqb wra rda))
- end.
-
- (* in the Cava implementation only one request can arrive at a time *)
- Definition Request_Eq (f_req : Request_t) (c_req : combType (Vec Bit REQUEST_WIDTH)) : bool.
- Admitted.
-
- Ltac destruct_products :=
- repeat match goal with
- | p: _ * _ |- _ => destruct p
- | H: _ /\ _ |- _ => let Hl := fresh H "l" in let Hr := fresh H "r" in destruct H as [Hl Hr]
- | E: exists y, _ |- _ => let yf := fresh y in destruct E as [yf E]
- end.
-
- Local Ltac simplify_step :=
- first [ destruct_pair_let
- | rewrite eqb_nat_to_bitvec_sized; by Lia.lia
- | rewrite nat_to_bitvec_to_nat; by Lia.lia
- | progress simpl_ident
- | progress autorewrite with to_spec
- | progress cbn [fst snd map] ].
- Local Ltac simplify := repeat simplify_step.
-
- (* to prove :
- - fullAdder_cin (CavaSubtractorProperties)
- - N2Bv ADDR_WIDTH 0 <> FullVEC (d epends on P2Bv_sized_neq_iff)
- *)
-
- Lemma P2Bv_sized_neq_iff (n : nat) (x y : positive) :
- (Pos.size_nat x <= n) ->
- (Pos.size_nat y <= n) ->
- (P2Bv_sized n x <> P2Bv_sized n y) <-> x <> y.
- Proof.
- revert x y; induction n; intros.
- { split; intros.
- { simpl in H1. contradict H1. reflexivity. }
- { pose proof (Pos_size_nat_nonzero x).
- contradict H. apply /negP. rewrite -ltnNge.
- apply /ltP; exact H2. }}
- { split; try congruence; [].
- cbn [P2Bv_sized].
- destruct x,y; try congruence; [ | | | ].
- all: cbn [Pos.size_nat] in *.
- all: admit.
- }
- Admitted.
-
- Lemma N2Bv_sized_neq_if: forall (n : nat) (x y : N),
- N2Bv_sized n x <> N2Bv_sized n y -> x <> y.
- Proof.
- destruct x, y; cbn [N.size_nat N2Bv_sized]; intros.
- all: try discriminate.
- all: try (cbv [Bvect_false] in H; done).
- congruence.
- Qed.
-
- Lemma N2Bv_sized_neq_iff: forall (n : nat) (x y : N),
- (N.size_nat x <= n)%coq_nat ->
- (N.size_nat y <= n)%coq_nat -> N2Bv_sized n x <> N2Bv_sized n y <-> x <> y.
- Proof.
- destruct x, y; cbn [N.size_nat N2Bv_sized]; intros; split; intros.
- 8: {
- rewrite P2Bv_sized_neq_iff; try congruence.
- all: apply /leP; try (exact H || exact H0).
- }
- all: try discriminate.
- all: try (cbv [Bvect_false] in H1; done).
- all: try (apply P2Bv_nonzero in H0; apply ssrfun.nesym in H0).
- all: try exact H0.
- all: try by apply P2Bv_nonzero in H.
- all: try (congruence).
- Qed.
-
- Lemma FullEmptyLogic_equiv c wra rda:
- Vector.eqb bool Bool.eqb wra rda -> exists cs',
- step FullEmptyLogic c (rda,wra) = (cs',(false,true)).
- Proof.
- intros; evar (cs : circuit_state FullEmptyLogic); exists cs.
- assert (wra = rda).
- { apply VectorEq.eqb_eq with (A_beq := Bool.eqb) in H.
- 2: exact Bool.eqb_true_iff.
- exact H.
- }
- rewrite H0.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor dropr EqFULL subtractor]; cbn [step].
- simplify.
- rewrite CavaPreludeProperties.eqb_refl.
- rewrite fullAdder_cin leqnn N.sub_diag CavaPreludeProperties.eqb_neq.
- 2: admit.
- instantiate (cs := (tt, (tt, tt, tt), tt)); unfold cs.
- reflexivity.
- Admitted.
-
- (* QUEUE_MAX_SIZE = 2, memory instantiated with N = 1 -> 2 elements *)
- (* 1 el -> 2 prods *)
- (* 2 el -> 6 prods *)
- (* 3 el -> 10 prods *)
- (* 4 el -> 14 prods *)
- (* n * 4 - 2 *)
- (* Example test (a b c d : nat) : ((a,b),(c,d))%type. *)
-
- (* Check match c with
- | (tt,tt) => true
- | _ => false
- end. *)
-
- (* Fixpoint memory_fetch {n} ad
- (c : circuit_state (memory_dp (Vec Bit REQUEST_WIDTH) ADDR_WIDTH n)) : bool :=
- match c with
- | unit => true
- | pair a b => false
- end.
-
- Fixpoint memory_at_ {A B : Type} (c : prod A B) i cnt ad req
- : (combType (Bit) * combType (Vec Bit REQUEST_WIDTH)):=
- match i with
- | 0 => (true,req)
- | S n => match c with
- | (tt,Vector.cons bool a REQUEST_WIDTH) =>
- if (cnt == ad) then (true,Vector.cons bool a REQUEST_WIDTH)
- else (false,Vector.const false REQUEST_WIDTH)
- | ((a,b),(c,d)) =>
- let '(b,found_req) := (memory_at_ (prod c d) n cnt ad req) in
- if b then memory_at_ (prod unit unit) 0 cnt ad found_req
- else memory_at_ (prod a b) n cnt.+1 ad req
- | (tt,(a,b)) => memory_at_ (prod a b) n cnt ad req
- | ((a,b),tt) => memory_at_ (prod a b) n cnt ad req
- end
- end. *)
-
- Lemma fifo_memory_equiv (c : circuit_state fifo_memory) c_req ad :
- exists (cs' : circuit_state fifo_memory) req,
- step fifo_memory c (c_req,ad,ad,true) =
- (cs',req).
- Proof.
- cbv [fifo_memory] in *.
- induction (QUEUE_MAX_SIZE - 1).
- { simpl in c.
- destruct_products; rename t into reg.
- evar (cs : circuit_state (memory_dp (Vec Bit REQUEST_WIDTH) ADDR_WIDTH 0)); exists (cs).
- cbv [memory_dp isN_ext mem_cell DelayCE]. cbn [step].
- simplify. rewrite andTb.
- exists (reg).
- instantiate (cs := (
- tt,
- if CavaPrelude.eqb (N2Bv_sized ADDR_WIDTH (N.of_nat 0), ad)
- then c_req
- else reg, tt
- )); unfold cs.
- reflexivity.
- }
- (* evar (cs : circuit_state (memory_dp (Vec Bit REQUEST_WIDTH) ADDR_WIDTH n.+1)); exists (cs). *)
- (* evar (req : combType (Vec Bit REQUEST_WIDTH)); exists (req). *)
- rewrite {4}/memory_dp.
- cbn [step]. fold memory_dp.
- specialize IHn with (c := (snd (fst (fst c)))).
- destruct IHn as [cs' [req_ IH]].
- rewrite IH.
- cbv [fork2 mem_cell isN_ext DelayCE]. cbn [step].
- simplify. rewrite andTb.
- cbv [mem_select].
- simplify.
- destruct (CavaPrelude.eqb (N2Bv_sized ADDR_WIDTH (N.of_nat n.+1), ad)) eqn:H.
- { exists (tt, cs', (tt, c_req), tt); exists (snd (snd (fst c))). }
- admit.
- Admitted.
-
- Lemma incrn_pointr_en_correct (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,true) =
- (tt,N2Bv_sized ADDR_WIDTH (Bv2N ad + 1)).
- Admitted.
-
- Lemma incrn_pointr_keep_correct (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,false) =
- (tt,ad).
- Admitted.
-
- Lemma FullEmptyLogic_plusone (c : circuit_state FullEmptyLogic) ad:
- exists cs' future_full_o,
- step FullEmptyLogic c (N2Bv_sized ADDR_WIDTH (Bv2N ad + 1), ad) =
- (cs',(future_full_o,false)).
- Admitted.
-
- Lemma CavaFIFO_equiv_ (c : circuit_state CavaFifoQueue_t_NF_RD) c_req :
- let '((_,(_,(_, (_, (_, (_, _, _), _)), _, mem_state, _,
- (_, _), (_, (_, (_, _, _), _)), _, wra), rda))) := c in
- Vector.eqb bool Bool.eqb wra rda -> exists cs' data_o,
- step CavaFifoQueue_t_NF_RD c (true,c_req,false) =
- (cs',(false,data_o,true)).
- Proof.
- simpl in c; destruct_products; intros.
- rename t into rda, t0 into wra.
- assert (wra = rda) as Haddr_eq.
- { apply VectorEq.eqb_eq with (A_beq := Bool.eqb) in H.
- 2: exact Bool.eqb_true_iff.
- exact H.
- }
- (* rewrite Haddr_eq. *)
- evar (cs : circuit_state CavaFifoQueue_t_NF_RD); exists cs.
- (* evar (future_full_o : combType Bit); exists future_full_o. *)
- evar (data_o : combType (Vec Bit REQUEST_WIDTH)); exists (data_o).
-
- cbv [CavaFifoQueue_t_NF_RD Loop]. cbn [step]. cbv [fst snd fork2].
- simpl_ident.
-
- apply FullEmptyLogic_equiv with (c := (u15, (u17, u18, u16), u14)) in H.
- destruct H as [fel_cs' H].
- rewrite H; simpl (true && ~~ false); simpl (false && ~~ true).
-
- specialize fifo_memory_equiv with (c_req := c_req) (c := c) (ad := rda) as Hfifo.
- destruct Hfifo as [c' [cr_out Hfifo]].
- rewrite Haddr_eq.
- rewrite Hfifo.
-
- specialize incrn_pointr_en_correct with (c := u8) as Hincr.
- rewrite Hincr.
-
- specialize incrn_pointr_keep_correct with (c := u9) as Hincr_.
- rewrite Hincr_.
-
- specialize FullEmptyLogic_plusone with (c := (u4, (u6, u7, u5), u3)) (ad := rda) as HH.
- destruct HH as [u_fodase [future_full_o' HH]]. simpl in u_fodase.
- rewrite HH.
-
- Admitted.
-
-
- (* assert (step incr_pointr u8 (rda,true) = )
-
- cbv [incr_pointr incrN]. cbn [step].
- simplify.
- cbn [step].
- simplify.
-
- repeat destruct_pair_let.
- rewrite
-
- apply EmptyLogic_equiv with (c := (u15, (u17, u18, u16), u14)) in H.
- destruct H as [cs' [full_o' H]].
- rewrite H.
- rewrite andTb andb_false_l.
- simplify.
- (* when rda = wra -> read nil, state that with a Lemma *)
- Admitted. *)
-
- Lemma CavaFIFO_equiv (f_state : FIFO_state_t) (c : circuit_state CavaFifoQueue_t_NF_RD) c_req :
- FIFO_pending (f_state) == [::] -> exists cs' full_o data_o,
- step CavaFifoQueue_t_NF_RD c (true,c_req,false) =
- (cs',(full_o,data_o,true)).
- Admitted.
-
- Lemma NextCR_equiv (c : circuit_state NextCR) c0 d0 :
- exists cs', step NextCR c (false,c0,true,d0) = (cs',null_req).
- Proof.
- destruct c. simpl in c1. simpl in c.
- evar (cs : circuit_state NextCR); exists cs.
- cbv [NextCR LoopInit]. cbn [step]. simplify.
- rewrite andTb negb_false orbT.
- instantiate (cs := (tt,(tt,null_req))); by unfold cs.
- Qed.
-
- Lemma CmdGen_equiv (c : circuit_state CmdGen) c0 :
- exists cs', step CmdGen c (false, c0, true) = (cs',N2Bv_sized DRAM_CMD_WIDTH 0).
- Proof.
- evar (cs : circuit_state UpdateState); exists cs.
- cbv [CmdGen]. cbn [step]. simplify.
- simpl. by instantiate (cs := tt).
- Qed.
-
- Lemma UpdateState_equiv (c0 : Counter_t) (c : circuit_state UpdateState):
- exists cs',
- step UpdateState c (false,(N2Bv_sized COUNTER_WIDTH (N.of_nat c0)),true) =
- (cs',(false,(cnt2Bv (Next_cycle c0)),false)).
- Proof.
- evar (cs : circuit_state UpdateState); exists cs.
- cbv [UpdateState]. cbn [step]. simplify.
- rewrite andTb andb_false_l negb_false orTb negb_true andb_false_r orb_false_r /WaitVEC.
- simplify.
- destruct (nat_of_ord c0 == WAIT - 1) eqn:H.
- { move: H => /eqP H; rewrite H.
- set (x := N2Bv_sized COUNTER_WIDTH (N.of_nat (WAIT - 1))); fold x.
- rewrite CavaPreludeProperties.eqb_refl /Next_cycle.
- set (Hc := c0.+1 < WAIT). dependent destruction Hc.
- { rewrite H subn1 prednK in x; try (exact WAIT_pos || by rewrite ltnn in x). }
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; intro; clear e.
- rewrite /cnt_nil; simplify.
- rewrite /cnt2Bv /OCycle0 //=.
- instantiate (cs := ()); by unfold cs. }
- { rewrite CavaPreludeProperties.eqb_neq.
- 2: { admit. }
- rewrite /cnt2Bv Bv2N_N2Bv_sized.
- 2: {
- rewrite /COUNTER_WIDTH.
- admit.
- (* apply N.log2_lt_pow2. *)
- }
- rewrite /Next_cycle.
- set (Hc := c0.+1 < WAIT); dependent destruction Hc.
- all: apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; intro; clear x.
- 2: { (* contradiction *)
- destruct c0; simpl in *.
- apply ltn_gt in e; rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
- { by rewrite e subn1 -pred_Sn eq_refl in H. }
- contradict e; apply /negP; by rewrite -leqNgt.
- }
- simpl; rewrite /N2Bv_sized.
- destruct ((N.of_nat (nat_of_ord c0) + 1)%num) eqn:HH.
- { rewrite N.add_1_r in HH.
- specialize N.neq_succ_0 with (n := N.of_nat c0) as Hsuc.
- by rewrite HH in Hsuc. }
- assert (Pos.of_succ_nat c0 = p).
- { admit. }
- rewrite H0.
- reflexivity.
- }
- Admitted.
-
-
- Proof.
- intros f_state arriving_req Hfreq H Hreq; cbv [CavaFIFO_state] in *.
- simpl in c_state. destruct_products.
- rename b into p, b0 into s, t0 into cnt, t1 into current_req, t2 into rda, t3 into wra.
- cbv [State_Eq_] in H. destruct (f_state) eqn:Hf_state.
- { destruct r eqn:HP.
- { destruct arriving_req eqn:Har0; simpl in H.
- 2: { (* cannot happen *)
- specialize FIFO_arrival with (t := t) (r0 := r0) (r1 := r1) as HH.
- fold arriving_req in HH; apply HH in Har0.
- rewrite /FIFO_pending in Har0.
- fold f_state in Har0; by rewrite Hf_state in Har0.
- }
- simpl in H; move: H => /andP [/andP [/andP [/eqP Hs Hc] /eqP Hp] Haddr]; rewrite eq_refl in Haddr.
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := cnt2Bv c0) (v2 := cnt) as HH.
- apply HH in Hc; clear HH; try exact Bool.eqb_true_iff.
- subst s cnt p.
-
- cbv [CavaFIFO_NextState LoopInit]. cbn [step fst snd].
- cbv [ret monad CombinationalSemantics Identity.Monad_ident].
- cbv [fst snd].
-
- assert (Vector.eqb bool Bool.eqb wra rda) as Haddr_eq.
- { done. }
-
- apply CavaFIFO_equiv_ with (c_req := c_req) (c := (u11,(u12,
- (u24, (u25, (u27, (u29, u30, u28), u26)), u23, c, u22, (u20, u21),
- (u14, (u16, (u18, u19, u17), u15)), u13, wra), rda))) in Haddr_eq as H.
- destruct H as [cs' [future_full_o [future_req H]]].
-
- rewrite H; clear H.
-
- specialize NextCR_equiv with (c := (u7, (u8, current_req))) (c0 := cnt2Bv c0) (d0 := future_req) as H.
- destruct H as [ncr_cs' H].
- rewrite H; clear H.
-
- specialize CmdGen_equiv with (c := u5) (c0 := cnt2Bv c0) as H.
- destruct H as [cmd_cs' H].
- rewrite H. clear H.
-
- specialize UpdateState_equiv with (c := u3) (c0 := c0) as H.
- destruct H as [ups_cs' H].
- rewrite H.
-
- unfold State_Eq_.
- repeat destruct_pair_let.
-
- rewrite /Next_state //=.
- simpl in cs'. destruct_products; cbv [fst snd].
- admit.
- }
- }
- admit.
- Admitted.
-
- (* ----------------------------------------------------------- *)
-
- Theorem SM_Eq_ (t : nat) (c_state : CavaFIFO_state)
- (f_req: Request_t) (c_req : combType (Vec Bit REQUEST_WIDTH)) :
- let f_state := (Default_arbitrate t).(Implementation_State) in
- let arriving_req := Arrival_at t in
- f_req \in Arrival_at t.+1 ->
- State_Eq f_state c_state arriving_req -> Request_Eq f_req c_req ->
- let '(f_nextstate,_) := Next_state [:: f_req] f_state in
- let '(c_nextstate,_) := step CavaFIFO_NextState c_state (true,c_req) in
- State_Eq f_nextstate c_nextstate [:: f_req].
- Proof.
- intros f_state arriving_req Hfreq H Hreq; cbv [CavaFIFO_state] in *.
- simpl in c_state. destruct_products.
- rename b into p, b0 into s, t0 into cnt.
- cbv [State_Eq] in H. destruct (f_state) eqn:Hf_state.
- { destruct r eqn:HP.
- { destruct arriving_req eqn:Har0; simpl in H.
- 2: { (* cannot happen *)
- specialize FIFO_arrival with (t := t) (r0 := r0) (r1 := r1) as HH.
- fold arriving_req in HH; apply HH in Har0.
- rewrite /FIFO_pending in Har0.
- fold f_state in Har0; by rewrite Hf_state in Har0.
- }
- simpl in H; move: H => /andP [/andP [/eqP Hs Hc] /eqP Hp].
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := cnt2Bv c0) (v2 := cnt) as HH.
- apply HH in Hc; clear HH; try exact Bool.eqb_true_iff.
- subst s cnt p.
-
- cbv [CavaFIFO_NextState LoopInit].
- cbn [step fst snd].
- simpl_ident.
-
- specialize CavaFIFO_equiv_ with (c :=
- (u11,(u12,(u24, (u25, (u27, (u29, u30, u28), u26)), u23, c, u22,
- (u20, u21), (u14, (u16, (u18, u19, u17), u15)), u13, t3),t2))) (c_req := c_req) as H.
- (* assert (FIFO_pending f_state == [::]) as H0; try by rewrite /FIFO_pending Hf_state eq_refl. *)
- apply H in H0. destruct H0 as [cs' [full_o [data_o H0]]].
- rewrite H0; clear H H0.
-
- specialize NextCR_equiv with (c := (u7, (u8, t1))) (c0 := cnt2Bv c0) (d0 := data_o) as H.
- destruct H as [ncr_cs' H].
- rewrite H; clear H.
-
- specialize CmdGen_equiv with (c := u5) (c0 := cnt2Bv c0) as H.
- destruct H as [cmd_cs' H].
- rewrite H. clear H.
-
- specialize UpdateState_equiv with (c := u3) (c0 := c0) as H.
- destruct H as [ups_cs' H].
- rewrite H //=.
-
- rewrite /State_Eq /CavaFIFO_state2tuple eq_refl andTb //=.
- assert ([:: f_req] != [:: f_req] = false); try by apply /eqP.
- rewrite H0 eq_refl andbT.
-
- apply Vector.eqb_eq; try exact Bool.eqb_true_iff.
- reflexivity.
- }
- { (* now in IDLE but queue is not empty *)
-
- }
-
- Admitted.
-
- (* write something to get rid of the x *)
- Theorem SM_Eq_ (t : nat)
- (f_state : FIFO_state_t)
- (f_req : Request_t)
- (arriving_req : Requests_t)
- (c_state : CavaFIFO_state)
- (c_req : combType (Vec Bit REQUEST_WIDTH)) :
- arriving_req = Arrival_at t -> f_req \in Arrival_at t.+1 ->
- State_Eq f_state c_state arriving_req -> Request_Eq f_req c_req ->
- let '(f_nextstate,_) := Next_state [:: f_req] f_state in
- let '(c_nextstate,_) := step CavaFIFO_NextState c_state (true,c_req) in
- State_Eq f_nextstate c_nextstate [:: f_req].
- Proof.
- intros Hart Hart1 H Hreq; unfold CavaFIFO_state in *.
- simpl in c_state. destruct_products.
- rename b into p, b0 into s, t0 into cnt.
- cbv [State_Eq] in H; destruct (f_state) eqn:Hf_state.
- { destruct r eqn:HP.
- { destruct arriving_req eqn:Har0.
- { simpl in H; move: H => /andP [/andP [/eqP Hs Hc] /eqP Hp].
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := cnt2Bv c0) (v2 := cnt) as HH.
- apply HH in Hc; clear HH; try exact Bool.eqb_true_iff.
- subst s cnt p.
-
- cbv [CavaFIFO_NextState LoopInit].
- cbn [step].
- cbn [fst snd].
- simpl_ident.
- specialize CavaFIFO_equiv_ with (f_state := f_state) (c :=
- (u11,
- (u12,
- (u24, (u25, (u27, (u29, u30, u28), u26)), u23, c, u22,
- (u20, u21), (u14, (u16, (u18, u19, u17), u15)), u13, t3),
- t2))
- ) (c_req := c_req) as H.
- assert (FIFO_pending f_state == [::]) as H0; try by rewrite /FIFO_pending Hf_state eq_refl.
- apply H in H0. destruct H0 as [cs' [full_o [data_o H0]]].
- rewrite H0; clear H H0.
- cbv [fst snd].
-
- specialize NextCR_equiv with (c := (u7, (u8, t1))) (c0 := cnt2Bv c0) (d0 := data_o) as H.
- destruct H as [ncr_cs' H].
- rewrite H; clear H.
-
- specialize CmdGen_equiv with (c := u5) (c0 := cnt2Bv c0) as H.
- destruct H as [cmd_cs' H].
- rewrite H. clear H.
-
- destruct (c0.+1 < WAIT) eqn:Hwait.
- { specialize UpdateState_equiv with (c := u3) (f_state := f_state) as H.
- rewrite /FIFO_counter Hf_state in H.
- apply H in Hwait as HH. clear H. destruct HH as [ups_cs' H].
- rewrite H.
-
- rewrite /Next_state /Next_cycle.
- set (Hc := c0.+1 < WAIT). dependent destruction Hc; try by rewrite Hwait in x.
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- rewrite /State_Eq /CavaFIFO_state2tuple eq_refl andTb.
- simpl.
- assert ([:: f_req] != [:: f_req] = false); try by apply /eqP.
- rewrite H0 eq_refl andbT.
- admit.
- }
- { specialize UpdateState_equiv_border with (c := u3) (f_state := f_state) as H.
- rewrite /FIFO_counter Hf_state in H.
- assert (c0.+1 == WAIT). { admit. }
- apply H in H0. clear H. destruct H0 as [ups_cs' H].
- rewrite H.
-
- rewrite /Next_state /Next_cycle.
- set (Hc := c0.+1 < WAIT). dependent destruction Hc; try by rewrite Hwait in x.
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- rewrite /State_Eq /CavaFIFO_state2tuple eq_refl andTb.
- simpl.
- assert ([:: f_req] != [:: f_req] = false); try by apply /eqP.
- rewrite H0 eq_refl andbT.
- admit.
- }}
- { (* now arriving_req is not empty *)
- (* has to be wrong because if P = [::] then no one can have arrived *)
- (* P = Enqueue (Arrival_at t)*)
- simpl in H; move: H => /andP [/andP [/eqP Hs Hc] /eqP Hp].
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := cnt2Bv c0) (v2 := cnt) as HH.
- apply HH in Hc; clear HH; try exact Bool.eqb_true_iff.
- subst s cnt p.
-
- cbv [CavaFIFO_NextState LoopInit].
- cbn [step].
- cbn [fst snd].
- simpl_ident.
-
- specialize CavaFIFO_equiv_ with (f_state := f_state) (c :=
- (u11,
- (u12,
- (u24, (u25, (u27, (u29, u30, u28), u26)), u23, c, u22,
- (u20, u21), (u14, (u16, (u18, u19, u17), u15)), u13, t3),
- t2))
- ) (c_req := c_req) as H.
- assert (FIFO_pending f_state == [::]) as H0; try by rewrite /FIFO_pending Hf_state eq_refl.
- apply H in H0. destruct H0 as [cs' [full_o [data_o H0]]].
- rewrite H0; clear H H0.
- cbv [fst snd].
-
-
- contradict Hwait.
- rewrite leq_eqVlt.
- rewrite -ltn_predRL.
- rewrite leq_eqVlt.
- (* rewrite -ltn_predRL in Hwait. *)
- assert (m < WAIT) as icp. { exact i. }
- contradict icp.
- apply /negP.
- rewrite -leqNgt.
-
- rewrite -ltnS in i.
- rewr
- assert (m.+1 >= WAIT). {
- apply leq_eqVlt
- }
- rewrite -ltn_predRL in Hwait.
- move: Hwait => /eqP Hwait.
- apply ltn_trans with (n := WAIT.-1) in i as iii.
- rewrite leq_eqVlt in Hwait.
- apply ltnW in i as ii.
- rewrite ii in Hwait.
- (* rewrite addn1 in ii. *)
- apply leq_gtF in ii.
- (* rewrite -addn1 in Hwait. *)
- rewrite -leq_gtF in Hwait
- }
-
-
- }
- specialize UpdateState_equiv with (c := u3) (f_state := f_state) as H.
-
- destruct (c0.+1 < WAIT) eqn:Hwait.
- { rewrite /FIFO_counter Hf_state in H.
- apply H in Hwait as HH. clear H. destruct HH as [ups_cs' H].
- rewrite H.
-
- rewrite /Next_state /Next_cycle.
- set (Hc := c0.+1 < WAIT). dependent destruction Hc; try by rewrite Hwait in x.
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- rewrite /State_Eq /CavaFIFO_state2tuple eq_refl andTb.
- simpl.
- assert ([:: f_req] != [:: f_req] = false); try by apply /eqP.
- rewrite H0 eq_refl andbT.
- admit.
- }
- { rewrite /FIFO_counter Hf_state in H.
-
- }
- Admitted.
-
- (* Default arbitrate should be equal to the simulate function *)
-End EquivalenceProof.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Core/CavaSMProperties2.v b/framework/CavaDRAM/Core/CavaSMProperties2.v
deleted file mode 100644
index 5a637c9..0000000
--- a/framework/CavaDRAM/Core/CavaSMProperties2.v
+++ /dev/null
@@ -1,843 +0,0 @@
-Require Import CavaSM.
-Require Import CavaSubtractorProperties.
-Require Import CavaTactics.
-Require Import Program.
-
-Ltac destruct_products :=
- repeat match goal with
- | p: _ * _ |- _ => destruct p
- | H: _ /\ _ |- _ => let Hl := fresh H "l" in let Hr := fresh H "r" in destruct H as [Hl Hr]
- | E: exists y, _ |- _ => let yf := fresh y in destruct E as [yf E]
- end.
-
-Ltac simplify_step :=
- first [ destruct_pair_let
- | rewrite eqb_nat_to_bitvec_sized; by Lia.lia
- | rewrite nat_to_bitvec_to_nat; by Lia.lia
- | progress simpl_ident
- | progress autorewrite with to_spec
- | progress cbn [fst snd map] ].
-
-Ltac simplify := repeat simplify_step.
-
-Ltac simpl_ret := cbv [ret monad CombinationalSemantics Identity.Monad_ident].
-
-Section CavaSMProperties2.
-
- (* Cava silveroak *)
- Existing Instance CombinationalSemantics.
-
- (* CavaDRAM *)
- Context {CAVA_SYS : CavaSystem}.
-
- (* DRAM *)
- Existing Instance REQESTOR_CFG.
-
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
- Context {AF : Arrival_function_t}.
-
- Existing Instance FIFO_implementation.
- Existing Instance FIFO_arbiter.
-
- Definition ACT_vec :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat Cava_ACT_date).
-
- Definition PRE_vec :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat 0).
-
- Definition CAS_vec :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat Cava_CAS_date).
-
- Definition Command_Eq (cmd : Command_kind_t) (cava_cmd : combType (Vec Bit DRAM_CMD_WIDTH)) : bool :=
- match cmd with
- | ACT => Vector.eqb bool eqb cava_cmd ACT_vec
- | PRE => Vector.eqb bool eqb cava_cmd PRE_vec
- | CRD => Vector.eqb bool eqb cava_cmd CAS_vec
- | CWR => Vector.eqb bool eqb cava_cmd CAS_vec
- | _ => false
- end.
-
- Definition CavaFIFO_state := circuit_state CavaFIFO_NextState : Type.
-
- (* tuplize_state *)
- Definition tuplize_state (state : CavaFIFO_state) :=
- let '(_,(_,(_,(_,(_,(_,(_, (_, (_, (_, _, _), _)), _, memory_state, _,
- (_, _), (_, (_, (_, _, _), _)), _, wra), rda)), _,
- (_, (_, creq)), _, _, _, _, _, cnt), s), p)) := state in
- (memory_state,wra,rda,creq,cnt,s,p)%type.
-
- Definition cnt2Bv (cnt : Counter_t) :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)) .
-
- Definition State_Eq (fram_state : FIFO_state_t) (state : CavaFIFO_state) (ar_req : Requests_t) : bool :=
- let '(mem_state,wra,rda,creq,cnt,s,p) := tuplize_state state in
- match fram_state with
- | IDLE c P =>
- (s == false) &&
- (Vector.eqb bool Bool.eqb (cnt2Bv c) cnt) &&
- (p == (P != cat [::] ar_req)) &&
- ((P == [::]) == (Vector.eqb bool Bool.eqb wra rda))
- | RUNNING c P r =>
- (s == true) &&
- (Vector.eqb bool Bool.eqb (cnt2Bv c) cnt) &&
- (p == ((P != cat [::] ar_req) && (nat_of_ord c == WAIT.-1))) &&
- ((P == [::]) == (Vector.eqb bool Bool.eqb wra rda))
- end.
-
- (* in the Cava implementation only one request can arrive at a time *)
- Definition Request_Eq (f_req : Request_t) (c_req : combType (Vec Bit REQUEST_WIDTH)) : bool.
- Admitted.
-
- Lemma eqb_eq_rewrite (wra rda : combType (Vec Bit ADDR_WIDTH)):
- Vector.eqb bool Bool.eqb wra rda -> wra = rda.
- Proof.
- intros.
- apply VectorEq.eqb_eq with (A_beq := Bool.eqb) in H.
- 2: exact Bool.eqb_true_iff.
- exact H.
- Qed.
-
- Lemma FullEmptyLogic_equiv c wra rda:
- Vector.eqb bool Bool.eqb wra rda -> exists cs',
- step FullEmptyLogic c (rda,wra) = (cs',(false,true)).
- Proof.
- intros; evar (cs : circuit_state FullEmptyLogic); exists cs.
- apply eqb_eq_rewrite in H as H0.
- rewrite H0.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor dropr EqFULL subtractor]; cbn [step].
- simplify.
- rewrite CavaPreludeProperties.eqb_refl.
- rewrite fullAdder_cin leqnn N.sub_diag CavaPreludeProperties.eqb_neq.
- 2: { rewrite /FullVEC; simplify. admit. }
- instantiate (cs := (tt, (tt, tt, tt), tt)); unfo(CavaPrelude.eqb
- (let (x, _) :=
- not_b <- Vec.inv rda;;
- aV <- unpackV rda;; bV <- unpackV not_b;; col fullAdder one (vcombine aV bV) in
- x, Vec.bitvec_literal (N2Bv_sized ADDR_WIDTH (N.of_nat QUEUE_MAX_SIZE - 1)))ld cs.
- reflexivity.
- Admitted.
-
- Lemma fifo_memory_equiv (c : circuit_state fifo_memory) c_req ad :
- exists (cs' : circuit_state fifo_memory) req,
- step fifo_memory c (c_req,ad,ad,true) =
- (cs',req).
- Admitted.
-
- Lemma incrn_pointr_true_equiv (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,true) =
- (tt,N2Bv_sized ADDR_WIDTH (Bv2N ad + 1)).
- Admitted.
-
- Lemma incrn_pointr_false_equiv (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,false) =
- (tt,ad).
- Admitted.
-
- Lemma FullEmptyLogic_plusone_equiv (c : circuit_state FullEmptyLogic) ad:
- exists cs' future_full_o,
- step FullEmptyLogic c (N2Bv_sized ADDR_WIDTH (Bv2N ad + 1), ad) =
- (cs',(future_full_o,false)).
- Admitted.
-
- (* has to produce a side condition that address will be different *)
- Lemma CavaFIFO_equiv_ (c : circuit_state CavaFifoQueue_t_NF_RD) c_req :
- let '((_,(_,(_, (_, (_, (_, _, _), _)), _, mem_state, _,
- (_, _), (_, (_, (_, _, _), _)), _, wra), rda))) := c in
- Vector.eqb bool Bool.eqb wra rda -> exists cs' future_full_o data_o,
- step CavaFifoQueue_t_NF_RD c (true,c_req,false) =
- (cs',(future_full_o,data_o,true)).
- Proof.
- simpl in c; destruct_products; intros.
- rename t into rda, t0 into wra.
-
- evar (cs : circuit_state CavaFifoQueue_t_NF_RD); exists cs.
- evar (future_full_o : combType Bit); exists future_full_o.
- evar (data_o : combType (Vec Bit REQUEST_WIDTH)); exists (data_o).
-
- cbv [CavaFifoQueue_t_NF_RD Loop]. cbn [step]. cbv [fst snd fork2].
- simpl_ident.
-
- apply FullEmptyLogic_equiv with (c := (u15, (u17, u18, u16), u14)) in H as Hr.
- destruct Hr as [fel_cs' Hr].
- rewrite Hr; simpl (true && ~~ false); simpl (false && ~~ true); clear Hr.
-
- apply eqb_eq_rewrite in H as Haddr_eq.
- specialize fifo_memory_equiv with (c := c) (c_req := c_req) (ad := rda) as [cs' [req' Hr]].
- rewrite Haddr_eq Hr.
- rewrite incrn_pointr_true_equiv incrn_pointr_false_equiv. clear Hr.
-
- specialize FullEmptyLogic_plusone_equiv with (c := (u4, (u6, u7, u5), u3)) (ad := rda) as Hr.
- destruct Hr as [fel_cs'' [future_full_o' Hr]].
- rewrite Hr.
- Admitted.
-
- Lemma NextCR_equiv (c : circuit_state NextCR) c0 d0 :
- exists cs', step NextCR c (false,c0,true,d0) = (cs',null_req).
- Proof.
- destruct c. simpl in c1. simpl in c.
- evar (cs : circuit_state NextCR); exists cs.
- cbv [NextCR LoopInit]. cbn [step]. simplify.
- rewrite andTb negb_false orbT.
- instantiate (cs := (tt,(tt,null_req))); by unfold cs.
- Qed.
-
- Lemma CmdGen_equiv (c : circuit_state CmdGen) c0 :
- exists cs', step CmdGen c (false, c0, true) = (cs',N2Bv_sized DRAM_CMD_WIDTH 0).
- Proof.
- evar (cs : circuit_state UpdateState); exists cs.
- cbv [CmdGen]. cbn [step]. simplify.
- simpl. by instantiate (cs := tt).
- Qed.
-
- Lemma UpdateState_equiv (c0 : Counter_t) (c : circuit_state UpdateState):
- exists cs',
- step UpdateState c (false,(N2Bv_sized COUNTER_WIDTH (N.of_nat c0)),true) =
- (cs',(false,(cnt2Bv (Next_cycle c0)),false)).
- Proof.
- evar (cs : circuit_state UpdateState); exists cs.
- cbv [UpdateState]. cbn [step]. simplify.
- rewrite andTb andb_false_l negb_false orTb negb_true andb_false_r orb_false_r /WaitVEC.
- simplify.
- destruct (nat_of_ord c0 == WAIT - 1) eqn:H.
- { move: H => /eqP H; rewrite H.
- set (x := N2Bv_sized COUNTER_WIDTH (N.of_nat (WAIT - 1))); fold x.
- rewrite CavaPreludeProperties.eqb_refl /Next_cycle.
- set (Hc := c0.+1 < WAIT). dependent destruction Hc.
- { rewrite H subn1 prednK in x; try (exact WAIT_pos || by rewrite ltnn in x). }
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; intro; clear e.
- rewrite /cnt_nil; simplify.
- rewrite /cnt2Bv /OCycle0 //=.
- instantiate (cs := ()); by unfold cs. }
- { rewrite CavaPreludeProperties.eqb_neq.
- 2: { admit. }
- rewrite /cnt2Bv Bv2N_N2Bv_sized.
- 2: {
- rewrite /COUNTER_WIDTH.
- admit.
- (* apply N.log2_lt_pow2. *)
- }
- rewrite /Next_cycle.
- set (Hc := c0.+1 < WAIT); dependent destruction Hc.
- all: apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; intro; clear x.
- 2: { (* contradiction *)
- destruct c0; simpl in *.
- apply ltn_gt in e; rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
- { by rewrite e subn1 -pred_Sn eq_refl in H. }
- contradict e; apply /negP; by rewrite -leqNgt.
- }
- simpl; rewrite /N2Bv_sized.
- destruct ((N.of_nat (nat_of_ord c0) + 1)%num) eqn:HH.
- { rewrite N.add_1_r in HH.
- specialize N.neq_succ_0 with (n := N.of_nat c0) as Hsuc.
- by rewrite HH in Hsuc. }
- assert (Pos.of_succ_nat c0 = p).
- { admit. }
- rewrite H0.
- reflexivity.
- }
- Admitted.
-
- Theorem SM_Eq (t : nat) (c_state : CavaFIFO_state)
- (f_req: Request_t) (c_req : combType (Vec Bit REQUEST_WIDTH)) :
- let f_state := (Default_arbitrate t).(Implementation_State) in
- let arriving_req := Arrival_at t in
- f_req \in Arrival_at t.+1 ->
- State_Eq f_state c_state arriving_req -> Request_Eq f_req c_req ->
- let '(f_nextstate,_) := Next_state [:: f_req] f_state in
- let '(c_nextstate,_) := step CavaFIFO_NextState c_state (true,c_req) in
- State_Eq f_nextstate c_nextstate [:: f_req].
- Proof.
- intros f_state arriving_req Hfreq H Hreq; cbv [CavaFIFO_state] in *.
- simpl in c_state; destruct_products.
- rename b into p, b0 into s, t0 into cnt, t1 into current_req, t2 into rda, t3 into wra.
- cbv [State_Eq tuplize_state] in H; destruct (f_state) eqn:Hf_state.
- { destruct r eqn:HP.
- { destruct arriving_req eqn:Har0; simpl in H.
- 2: { (* cannot happen *)
- specialize FIFO_arrival with (t := t) (r0 := r0) (r1 := r1) as HH.
- fold arriving_req in HH; apply HH in Har0.
- rewrite /FIFO_pending in Har0.
- fold f_state in Har0; by rewrite Hf_state in Har0.
- }
-
- simpl in H; move: H => /andP [/andP [/andP [/eqP Hs Hc] /eqP Hp] Haddr]; rewrite eq_refl in Haddr.
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := cnt2Bv c0) (v2 := cnt) as HH.
- apply HH in Hc; clear HH; try exact Bool.eqb_true_iff.
- subst s cnt p.
-
- cbv [CavaFIFO_NextState LoopInit]. cbn [step fst snd].
- simpl_ret.
- cbv [ret monad CombinationalSemantics Identity.Monad_ident].
- cbv [fst snd].
-
- assert (Vector.eqb bool Bool.eqb wra rda); [done | ].
-
- apply CavaFIFO_equiv_ with (c := (u11,(u12,
- (u24, (u25, (u27, (u29, u30, u28), u26)), u23, c, u22,
- (u20, u21), (u14, (u16, (u18, u19, u17), u15)), u13, wra),
- rda))) (c_req := c_req) in H as [fifo_cs' [full_o [cr_o Hr]]].
- rewrite Hr. clear Hr.
-
- specialize NextCR_equiv with (c := (u7, (u8, current_req))) (c0 := cnt2Bv c0) (d0 := cr_o) as [ncr_cs' Hr].
- rewrite Hr. clear Hr.
-
- specialize CmdGen_equiv with (c := u5) (c0 := cnt2Bv c0) as [cmd_cs' Hr].
- rewrite Hr. clear Hr.
-
- specialize UpdateState_equiv with (c := u3) (c0 := c0) as [ups_cs' Hr].
- rewrite Hr.
-
- simpl in fifo_cs'; destruct_products.
- rewrite /Next_state.
- simpl (CavaClass.constant true); simpl.
- rewrite /State_Eq /tuplize_state.
- repeat destruct_pair_let.
- cbv [fst snd].
-
- unfold State_Eq, tuplize_state; simpl.
-
-
-
-
-
- }
-
-
- Lemma P2Bv_sized_neq_iff (n : nat) (x y : positive) :
- (Pos.size_nat x <= n) ->
- (Pos.size_nat y <= n) ->
- (P2Bv_sized n x <> P2Bv_sized n y) <-> x <> y.
- Proof.
- revert x y; induction n; intros.
- { split; intros.
- { simpl in H1. contradict H1. reflexivity. }
- { pose proof (Pos_size_nat_nonzero x).
- contradict H. apply /negP. rewrite -ltnNge.
- apply /ltP; exact H2. }}
- { split; try congruence; [].
- cbn [P2Bv_sized].
- destruct x,y; try congruence; [ | | | ].
- all: cbn [Pos.size_nat] in *.
- all: admit.
- }
- Admitted.
-
- Lemma N2Bv_sized_neq_if: forall (n : nat) (x y : N),
- N2Bv_sized n x <> N2Bv_sized n y -> x <> y.
- Proof.
- destruct x, y; cbn [N.size_nat N2Bv_sized]; intros.
- all: try discriminate.
- all: try (cbv [Bvect_false] in H; done).
- congruence.
- Qed.
-
- Lemma N2Bv_sized_neq_iff: forall (n : nat) (x y : N),
- (N.size_nat x <= n)%coq_nat ->
- (N.size_nat y <= n)%coq_nat -> N2Bv_sized n x <> N2Bv_sized n y <-> x <> y.
- Proof.
- destruct x, y; cbn [N.size_nat N2Bv_sized]; intros; split; intros.
- 8: {
- rewrite P2Bv_sized_neq_iff; try congruence.
- all: apply /leP; try (exact H || exact H0).
- }
- all: try discriminate.
- all: try (cbv [Bvect_false] in H1; done).
- all: try (apply P2Bv_nonzero in H0; apply ssrfun.nesym in H0).
- all: try exact H0.
- all: try by apply P2Bv_nonzero in H.
- all: try (congruence).
- Qed.
-
- Lemma FullEmptyLogic_equiv c wra rda:
- Vector.eqb bool Bool.eqb wra rda -> exists cs',
- step FullEmptyLogic c (rda,wra) = (cs',(false,true)).
- Proof.
- intros; evar (cs : circuit_state FullEmptyLogic); exists cs.
- assert (wra = rda).
- { apply VectorEq.eqb_eq with (A_beq := Bool.eqb) in H.
- 2: exact Bool.eqb_true_iff.
- exact H.
- }
- rewrite H0.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor dropr EqFULL subtractor]; cbn [step].
- simplify.
- rewrite CavaPreludeProperties.eqb_refl.
- rewrite fullAdder_cin leqnn N.sub_diag CavaPreludeProperties.eqb_neq.
- 2: admit.
- instantiate (cs := (tt, (tt, tt, tt), tt)); unfold cs.
- reflexivity.
- Admitted.
-
- Lemma fifo_memory_equiv (c : circuit_state fifo_memory) c_req ad :
- exists (cs' : circuit_state fifo_memory) req,
- step fifo_memory c (c_req,ad,ad,true) =
- (cs',req).
- Proof.
- cbv [fifo_memory] in *.
- induction (QUEUE_MAX_SIZE - 1).
- { simpl in c.
- destruct_products; rename t into reg.
- evar (cs : circuit_state (memory_dp (Vec Bit REQUEST_WIDTH) ADDR_WIDTH 0)); exists (cs).
- cbv [memory_dp isN_ext mem_cell DelayCE]. cbn [step].
- simplify. rewrite andTb.
- exists (reg).
- instantiate (cs := (
- tt,
- if CavaPrelude.eqb (N2Bv_sized ADDR_WIDTH (N.of_nat 0), ad)
- then c_req
- else reg, tt
- )); unfold cs.
- reflexivity.
- }
- (* evar (cs : circuit_state (memory_dp (Vec Bit REQUEST_WIDTH) ADDR_WIDTH n.+1)); exists (cs). *)
- (* evar (req : combType (Vec Bit REQUEST_WIDTH)); exists (req). *)
- rewrite {4}/memory_dp.
- cbn [step]. fold memory_dp.
- specialize IHn with (c := (snd (fst (fst c)))).
- destruct IHn as [cs' [req_ IH]].
- rewrite IH.
- cbv [fork2 mem_cell isN_ext DelayCE]. cbn [step].
- simplify. rewrite andTb.
- cbv [mem_select].
- simplify.
- destruct (CavaPrelude.eqb (N2Bv_sized ADDR_WIDTH (N.of_nat n.+1), ad)) eqn:H.
- { exists (tt, cs', (tt, c_req), tt); exists (snd (snd (fst c))). }
- admit.
- Admitted.
-
- Lemma incrn_pointr_en_correct (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,true) =
- (tt,N2Bv_sized ADDR_WIDTH (Bv2N ad + 1)).
- Admitted.
-
- Lemma incrn_pointr_keep_correct (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,false) =
- (tt,ad).
- Admitted.
-
- Lemma FullEmptyLogic_plusone (c : circuit_state FullEmptyLogic) ad:
- exists cs' future_full_o,
- step FullEmptyLogic c (N2Bv_sized ADDR_WIDTH (Bv2N ad + 1), ad) =
- (cs',(future_full_o,false)).
- Admitted.
-
- Lemma CavaFIFO_equiv_ (c : circuit_state CavaFifoQueue_t_NF_RD) c_req :
- let '((_,(_,(_, (_, (_, (_, _, _), _)), _, mem_state, _,
- (_, _), (_, (_, (_, _, _), _)), _, wra), rda))) := c in
- Vector.eqb bool Bool.eqb wra rda -> exists cs' future_full_o data_o,
- step CavaFifoQueue_t_NF_RD c (true,c_req,false) =
- (cs',(future_full_o,data_o,true)).
- Proof.
- simpl in c; destruct_products; intros.
- rename t into rda, t0 into wra.
- assert (wra = rda) as Haddr_eq.
- { apply VectorEq.eqb_eq with (A_beq := Bool.eqb) in H.
- 2: exact Bool.eqb_true_iff.
- exact H.
- }
- (* rewrite Haddr_eq. *)
- evar (cs : circuit_state CavaFifoQueue_t_NF_RD); exists cs.
- evar (future_full_o : combType Bit); exists future_full_o.
- evar (data_o : combType (Vec Bit REQUEST_WIDTH)); exists (data_o).
-
- cbv [CavaFifoQueue_t_NF_RD Loop]. cbn [step]. cbv [fst snd fork2].
- simpl_ident.
-
- apply FullEmptyLogic_equiv with (c := (u15, (u17, u18, u16), u14)) in H.
- destruct H as [fel_cs' H].
- rewrite H; simpl (true && ~~ false); simpl (false && ~~ true).
-
- specialize fifo_memory_equiv with (c_req := c_req) (c := c) (ad := rda) as Hfifo.
- destruct Hfifo as [c' [cr_out Hfifo]].
- rewrite Haddr_eq.
- rewrite Hfifo.
-
- specialize incrn_pointr_en_correct with (c := u8) as Hincr.
- rewrite Hincr.
-
- specialize incrn_pointr_keep_correct with (c := u9) as Hincr_.
- rewrite Hincr_.
-
- specialize FullEmptyLogic_plusone with (c := (u4, (u6, u7, u5), u3)) (ad := rda) as HH.
- destruct HH as [u_fodase [future_full_o' HH]]. simpl in u_fodase.
- rewrite HH.
-
- Admitted.
-
-
- (* assert (step incr_pointr u8 (rda,true) = )
-
- cbv [incr_pointr incrN]. cbn [step].
- simplify.
- cbn [step].
- simplify.
-
- repeat destruct_pair_let.
- rewrite
-
- apply EmptyLogic_equiv with (c := (u15, (u17, u18, u16), u14)) in H.
- destruct H as [cs' [full_o' H]].
- rewrite H.
- rewrite andTb andb_false_l.
- simplify.
- (* when rda = wra -> read nil, state that with a Lemma *)
- Admitted. *)
-
- Lemma CavaFIFO_equiv (f_state : FIFO_state_t) (c : circuit_state CavaFifoQueue_t_NF_RD) c_req :
- FIFO_pending (f_state) == [::] -> exists cs' full_o data_o,
- step CavaFifoQueue_t_NF_RD c (true,c_req,false) =
- (cs',(full_o,data_o,true)).
- Admitted.
-
- Lemma NextCR_equiv (c : circuit_state NextCR) c0 d0 :
- exists cs', step NextCR c (false,c0,true,d0) = (cs',null_req).
- Proof.
- destruct c. simpl in c1. simpl in c.
- evar (cs : circuit_state NextCR); exists cs.
- cbv [NextCR LoopInit]. cbn [step]. simplify.
- rewrite andTb negb_false orbT.
- instantiate (cs := (tt,(tt,null_req))); by unfold cs.
- Qed.
-
- Lemma CmdGen_equiv (c : circuit_state CmdGen) c0 :
- exists cs', step CmdGen c (false, c0, true) = (cs',N2Bv_sized DRAM_CMD_WIDTH 0).
- Proof.
- evar (cs : circuit_state UpdateState); exists cs.
- cbv [CmdGen]. cbn [step]. simplify.
- simpl. by instantiate (cs := tt).
- Qed.
-
- Lemma UpdateState_equiv (c0 : Counter_t) (c : circuit_state UpdateState):
- exists cs',
- step UpdateState c (false,(N2Bv_sized COUNTER_WIDTH (N.of_nat c0)),true) =
- (cs',(false,(cnt2Bv (Next_cycle c0)),false)).
- Proof.
- evar (cs : circuit_state UpdateState); exists cs.
- cbv [UpdateState]. cbn [step]. simplify.
- rewrite andTb andb_false_l negb_false orTb negb_true andb_false_r orb_false_r /WaitVEC.
- simplify.
- destruct (nat_of_ord c0 == WAIT - 1) eqn:H.
- { move: H => /eqP H; rewrite H.
- set (x := N2Bv_sized COUNTER_WIDTH (N.of_nat (WAIT - 1))); fold x.
- rewrite CavaPreludeProperties.eqb_refl /Next_cycle.
- set (Hc := c0.+1 < WAIT). dependent destruction Hc.
- { rewrite H subn1 prednK in x; try (exact WAIT_pos || by rewrite ltnn in x). }
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; intro; clear e.
- rewrite /cnt_nil; simplify.
- rewrite /cnt2Bv /OCycle0 //=.
- instantiate (cs := ()); by unfold cs. }
- { rewrite CavaPreludeProperties.eqb_neq.
- 2: { admit. }
- rewrite /cnt2Bv Bv2N_N2Bv_sized.
- 2: {
- rewrite /COUNTER_WIDTH.
- admit.
- (* apply N.log2_lt_pow2. *)
- }
- rewrite /Next_cycle.
- set (Hc := c0.+1 < WAIT); dependent destruction Hc.
- all: apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; intro; clear x.
- 2: { (* contradiction *)
- destruct c0; simpl in *.
- apply ltn_gt in e; rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
- { by rewrite e subn1 -pred_Sn eq_refl in H. }
- contradict e; apply /negP; by rewrite -leqNgt.
- }
- simpl; rewrite /N2Bv_sized.
- destruct ((N.of_nat (nat_of_ord c0) + 1)%num) eqn:HH.
- { rewrite N.add_1_r in HH.
- specialize N.neq_succ_0 with (n := N.of_nat c0) as Hsuc.
- by rewrite HH in Hsuc. }
- assert (Pos.of_succ_nat c0 = p).
- { admit. }
- rewrite H0.
- reflexivity.
- }
- Admitted.
-
- Theorem SM_Eq (t : nat) (c_state : CavaFIFO_state)
- (f_req: Request_t) (c_req : combType (Vec Bit REQUEST_WIDTH)) :
- let f_state := (Default_arbitrate t).(Implementation_State) in
- let arriving_req := Arrival_at t in
- f_req \in Arrival_at t.+1 ->
- State_Eq_ f_state c_state arriving_req -> Request_Eq f_req c_req ->
- let '(f_nextstate,_) := Next_state [:: f_req] f_state in
- let '(c_nextstate,_) := step CavaFIFO_NextState c_state (true,c_req) in
- State_Eq_ f_nextstate c_nextstate [:: f_req].
- Proof.
- intros f_state arriving_req Hfreq H Hreq; cbv [CavaFIFO_state] in *.
- simpl in c_state. destruct_products.
- rename b into p, b0 into s, t0 into cnt, t1 into current_req, t2 into rda, t3 into wra.
- cbv [State_Eq_] in H. destruct (f_state) eqn:Hf_state.
- { destruct r eqn:HP.
- { destruct arriving_req eqn:Har0; simpl in H.
- 2: { (* cannot happen *)
- specialize FIFO_arrival with (t := t) (r0 := r0) (r1 := r1) as HH.
- fold arriving_req in HH; apply HH in Har0.
- rewrite /FIFO_pending in Har0.
- fold f_state in Har0; by rewrite Hf_state in Har0.
- }
- simpl in H; move: H => /andP [/andP [/andP [/eqP Hs Hc] /eqP Hp] Haddr]; rewrite eq_refl in Haddr.
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := cnt2Bv c0) (v2 := cnt) as HH.
- apply HH in Hc; clear HH; try exact Bool.eqb_true_iff.
- subst s cnt p.
-
- cbv [CavaFIFO_NextState LoopInit]. cbn [step fst snd].
- cbv [ret monad CombinationalSemantics Identity.Monad_ident].
- cbv [fst snd].
-
- assert (Vector.eqb bool Bool.eqb wra rda) as Haddr_eq.
- { done. }
-
- apply CavaFIFO_equiv_ with (c_req := c_req) (c := (u11,(u12,
- (u24, (u25, (u27, (u29, u30, u28), u26)), u23, c, u22, (u20, u21),
- (u14, (u16, (u18, u19, u17), u15)), u13, wra), rda))) in Haddr_eq as H.
- destruct H as [cs' [future_full_o [future_req H]]].
-
- rewrite H; clear H.
-
- specialize NextCR_equiv with (c := (u7, (u8, current_req))) (c0 := cnt2Bv c0) (d0 := future_req) as H.
- destruct H as [ncr_cs' H].
- rewrite H; clear H.
-
- specialize CmdGen_equiv with (c := u5) (c0 := cnt2Bv c0) as H.
- destruct H as [cmd_cs' H].
- rewrite H. clear H.
-
- specialize UpdateState_equiv with (c := u3) (c0 := c0) as H.
- destruct H as [ups_cs' H].
- rewrite H.
-
- unfold State_Eq_.
- repeat destruct_pair_let.
-
- rewrite /Next_state //=.
- simpl in cs'. destruct_products; cbv [fst snd].
- admit.
- }
- }
- admit.
- Admitted.
-
- (* ----------------------------------------------------------- *)
-
- Theorem SM_Eq_ (t : nat) (c_state : CavaFIFO_state)
- (f_req: Request_t) (c_req : combType (Vec Bit REQUEST_WIDTH)) :
- let f_state := (Default_arbitrate t).(Implementation_State) in
- let arriving_req := Arrival_at t in
- f_req \in Arrival_at t.+1 ->
- State_Eq f_state c_state arriving_req -> Request_Eq f_req c_req ->
- let '(f_nextstate,_) := Next_state [:: f_req] f_state in
- let '(c_nextstate,_) := step CavaFIFO_NextState c_state (true,c_req) in
- State_Eq f_nextstate c_nextstate [:: f_req].
- Proof.
- intros f_state arriving_req Hfreq H Hreq; cbv [CavaFIFO_state] in *.
- simpl in c_state. destruct_products.
- rename b into p, b0 into s, t0 into cnt.
- cbv [State_Eq] in H. destruct (f_state) eqn:Hf_state.
- { destruct r eqn:HP.
- { destruct arriving_req eqn:Har0; simpl in H.
- 2: { (* cannot happen *)
- specialize FIFO_arrival with (t := t) (r0 := r0) (r1 := r1) as HH.
- fold arriving_req in HH; apply HH in Har0.
- rewrite /FIFO_pending in Har0.
- fold f_state in Har0; by rewrite Hf_state in Har0.
- }
- simpl in H; move: H => /andP [/andP [/eqP Hs Hc] /eqP Hp].
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := cnt2Bv c0) (v2 := cnt) as HH.
- apply HH in Hc; clear HH; try exact Bool.eqb_true_iff.
- subst s cnt p.
-
- cbv [CavaFIFO_NextState LoopInit].
- cbn [step fst snd].
- simpl_ident.
-
- specialize CavaFIFO_equiv_ with (c :=
- (u11,(u12,(u24, (u25, (u27, (u29, u30, u28), u26)), u23, c, u22,
- (u20, u21), (u14, (u16, (u18, u19, u17), u15)), u13, t3),t2))) (c_req := c_req) as H.
- (* assert (FIFO_pending f_state == [::]) as H0; try by rewrite /FIFO_pending Hf_state eq_refl. *)
- apply H in H0. destruct H0 as [cs' [full_o [data_o H0]]].
- rewrite H0; clear H H0.
-
- specialize NextCR_equiv with (c := (u7, (u8, t1))) (c0 := cnt2Bv c0) (d0 := data_o) as H.
- destruct H as [ncr_cs' H].
- rewrite H; clear H.
-
- specialize CmdGen_equiv with (c := u5) (c0 := cnt2Bv c0) as H.
- destruct H as [cmd_cs' H].
- rewrite H. clear H.
-
- specialize UpdateState_equiv with (c := u3) (c0 := c0) as H.
- destruct H as [ups_cs' H].
- rewrite H //=.
-
- rewrite /State_Eq /CavaFIFO_state2tuple eq_refl andTb //=.
- assert ([:: f_req] != [:: f_req] = false); try by apply /eqP.
- rewrite H0 eq_refl andbT.
-
- apply Vector.eqb_eq; try exact Bool.eqb_true_iff.
- reflexivity.
- }
- { (* now in IDLE but queue is not empty *)
-
- }
-
- Admitted.
-
- (* write something to get rid of the x *)
- Theorem SM_Eq_ (t : nat)
- (f_state : FIFO_state_t)
- (f_req : Request_t)
- (arriving_req : Requests_t)
- (c_state : CavaFIFO_state)
- (c_req : combType (Vec Bit REQUEST_WIDTH)) :
- arriving_req = Arrival_at t -> f_req \in Arrival_at t.+1 ->
- State_Eq f_state c_state arriving_req -> Request_Eq f_req c_req ->
- let '(f_nextstate,_) := Next_state [:: f_req] f_state in
- let '(c_nextstate,_) := step CavaFIFO_NextState c_state (true,c_req) in
- State_Eq f_nextstate c_nextstate [:: f_req].
- Proof.
- intros Hart Hart1 H Hreq; unfold CavaFIFO_state in *.
- simpl in c_state. destruct_products.
- rename b into p, b0 into s, t0 into cnt.
- cbv [State_Eq] in H; destruct (f_state) eqn:Hf_state.
- { destruct r eqn:HP.
- { destruct arriving_req eqn:Har0.
- { simpl in H; move: H => /andP [/andP [/eqP Hs Hc] /eqP Hp].
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := cnt2Bv c0) (v2 := cnt) as HH.
- apply HH in Hc; clear HH; try exact Bool.eqb_true_iff.
- subst s cnt p.
-
- cbv [CavaFIFO_NextState LoopInit].
- cbn [step].
- cbn [fst snd].
- simpl_ident.
- specialize CavaFIFO_equiv_ with (f_state := f_state) (c :=
- (u11,
- (u12,
- (u24, (u25, (u27, (u29, u30, u28), u26)), u23, c, u22,
- (u20, u21), (u14, (u16, (u18, u19, u17), u15)), u13, t3),
- t2))
- ) (c_req := c_req) as H.
- assert (FIFO_pending f_state == [::]) as H0; try by rewrite /FIFO_pending Hf_state eq_refl.
- apply H in H0. destruct H0 as [cs' [full_o [data_o H0]]].
- rewrite H0; clear H H0.
- cbv [fst snd].
-
- specialize NextCR_equiv with (c := (u7, (u8, t1))) (c0 := cnt2Bv c0) (d0 := data_o) as H.
- destruct H as [ncr_cs' H].
- rewrite H; clear H.
-
- specialize CmdGen_equiv with (c := u5) (c0 := cnt2Bv c0) as H.
- destruct H as [cmd_cs' H].
- rewrite H. clear H.
-
- destruct (c0.+1 < WAIT) eqn:Hwait.
- { specialize UpdateState_equiv with (c := u3) (f_state := f_state) as H.
- rewrite /FIFO_counter Hf_state in H.
- apply H in Hwait as HH. clear H. destruct HH as [ups_cs' H].
- rewrite H.
-
- rewrite /Next_state /Next_cycle.
- set (Hc := c0.+1 < WAIT). dependent destruction Hc; try by rewrite Hwait in x.
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- rewrite /State_Eq /CavaFIFO_state2tuple eq_refl andTb.
- simpl.
- assert ([:: f_req] != [:: f_req] = false); try by apply /eqP.
- rewrite H0 eq_refl andbT.
- admit.
- }
- { specialize UpdateState_equiv_border with (c := u3) (f_state := f_state) as H.
- rewrite /FIFO_counter Hf_state in H.
- assert (c0.+1 == WAIT). { admit. }
- apply H in H0. clear H. destruct H0 as [ups_cs' H].
- rewrite H.
-
- rewrite /Next_state /Next_cycle.
- set (Hc := c0.+1 < WAIT). dependent destruction Hc; try by rewrite Hwait in x.
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- rewrite /State_Eq /CavaFIFO_state2tuple eq_refl andTb.
- simpl.
- assert ([:: f_req] != [:: f_req] = false); try by apply /eqP.
- rewrite H0 eq_refl andbT.
- admit.
- }}
- { (* now arriving_req is not empty *)
- (* has to be wrong because if P = [::] then no one can have arrived *)
- (* P = Enqueue (Arrival_at t)*)
- simpl in H; move: H => /andP [/andP [/eqP Hs Hc] /eqP Hp].
- specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := cnt2Bv c0) (v2 := cnt) as HH.
- apply HH in Hc; clear HH; try exact Bool.eqb_true_iff.
- subst s cnt p.
-
- cbv [CavaFIFO_NextState LoopInit].
- cbn [step].
- cbn [fst snd].
- simpl_ident.
-
- specialize CavaFIFO_equiv_ with (f_state := f_state) (c :=
- (u11,
- (u12,
- (u24, (u25, (u27, (u29, u30, u28), u26)), u23, c, u22,
- (u20, u21), (u14, (u16, (u18, u19, u17), u15)), u13, t3),
- t2))
- ) (c_req := c_req) as H.
- assert (FIFO_pending f_state == [::]) as H0; try by rewrite /FIFO_pending Hf_state eq_refl.
- apply H in H0. destruct H0 as [cs' [full_o [data_o H0]]].
- rewrite H0; clear H H0.
- cbv [fst snd].
-
-
- contradict Hwait.
- rewrite leq_eqVlt.
- rewrite -ltn_predRL.
- rewrite leq_eqVlt.
- (* rewrite -ltn_predRL in Hwait. *)
- assert (m < WAIT) as icp. { exact i. }
- contradict icp.
- apply /negP.
- rewrite -leqNgt.
-
- rewrite -ltnS in i.
- rewr
- assert (m.+1 >= WAIT). {
- apply leq_eqVlt
- }
- rewrite -ltn_predRL in Hwait.
- move: Hwait => /eqP Hwait.
- apply ltn_trans with (n := WAIT.-1) in i as iii.
- rewrite leq_eqVlt in Hwait.
- apply ltnW in i as ii.
- rewrite ii in Hwait.
- (* rewrite addn1 in ii. *)
- apply leq_gtF in ii.
- (* rewrite -addn1 in Hwait. *)
- rewrite -leq_gtF in Hwait
- }
-
-
- }
- specialize UpdateState_equiv with (c := u3) (f_state := f_state) as H.
-
- destruct (c0.+1 < WAIT) eqn:Hwait.
- { rewrite /FIFO_counter Hf_state in H.
- apply H in Hwait as HH. clear H. destruct HH as [ups_cs' H].
- rewrite H.
-
- rewrite /Next_state /Next_cycle.
- set (Hc := c0.+1 < WAIT). dependent destruction Hc; try by rewrite Hwait in x.
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- rewrite /State_Eq /CavaFIFO_state2tuple eq_refl andTb.
- simpl.
- assert ([:: f_req] != [:: f_req] = false); try by apply /eqP.
- rewrite H0 eq_refl andbT.
- admit.
- }
- { rewrite /FIFO_counter Hf_state in H.
-
- }
- Admitted.
-
- (* Default arbitrate should be equal to the simulate function *)
-End EquivalenceProof.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Core/CavaSM_.v b/framework/CavaDRAM/Core/CavaSM_.v
deleted file mode 100644
index 77f01b7..0000000
--- a/framework/CavaDRAM/Core/CavaSM_.v
+++ /dev/null
@@ -1,115 +0,0 @@
-From CavaDRAM Require Import CavaReqQueue CavaUtil.
-From CoqDRAM Require Import System.
-From Coq Require Import BinaryString HexString NArith.
-
-Module DataNotation.
-Declare Scope data_scope.
-Delimit Scope data_scope with ds.
-Infix "++" := Vector.append.
-Notation "'#B' n '|' w" := (N2Bv_sized w (BinaryString.Raw.to_N n 0)) (at level 0) : data_scope.
-Notation "'#D' n '|' w" := (N2Bv_sized w n) (at level 0) : data_scope.
-Notation "'#H' n '|' w" := (N2Bv_sized w (HexString.Raw.to_N n 0)) (at level 0) : data_scope.
-End DataNotation.
-
-Section CavaSM.
-
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
- Context {CAVA_SYS : CavaSystem}.
- Context {SYS_CFG : System_configuration}.
-
- (* Program Instance CAVA_SYS : CavaSystem := {
- DRAM_CMD_WIDTH := 5;
- FE_ADDR_WIDTH := 32;
- FE_CMD_WIDTH := 1;
- FE_ID_WIDTH := 16;
- QUEUE_MAX_SIZE := 512;
- }. *)
-
- Import DataNotation.
- Open Scope data_scope.
-
- (* REQUEST_WIDTH is defined in CavaReqQueue *)
-
- Class CavaSMImplementation {f : SignalType -> Type} {CAVA_SYS : CavaSystem} :=
- {
- STATE_WIDTH : N ;
-
- SM : Circuit (signal Bit * request_t)
- (signal Bit * command_t * signal Bit)
- }.
-
- Definition powerOfTwo (n : nat) : bool :=
- N.eqb (N.land (N.of_nat n) (N.of_nat (n - 1))) 0.
-
- (* DDR4 SDRAM MT40A 1G8 075E *)
- (* tCK = 0.75ns, CL = 19 *)
- (* Program Instance SYS_CFG : System_configuration := {
- BANKGROUPS := 4;
- BANKS := 8;
- T_BURST := 4; (* 4*)
- T_WL := 5; (* 5*)
- T_RRD_s := 4; (*4*)
- T_RRD_l := 6; (*6*)
- T_FAW := 16; (*16*)
- T_RC := 20; (* Most constraining, dividing by 2 for test purposes, orig 64 *)
- T_RP := 6; (* orig: 6 *)
- T_RCD := 6; (* orig: 6*)
- T_RAS := 15; (*15*)
- T_RTP := 4; (*4*)
- T_WR := 6; (*6*)
- T_RTW := 12; (*12*)
- T_WTR_s := 4; (*4*)
- T_WTR_l := 6; (*6*)
- T_CCD_s := 4; (*4*)
- T_CCD_l := 5; (*5*)
- T_REFI := 2880; (*orig: 2880, 7.8 us*)
- T_RFC := 44; (* orig: 44, 1Gb 110 ns *)
- }. *)
-
- Context {SMImp : CavaSMImplementation (f := signal)}.
-
- (* Output formating *)
- Definition SM_out := (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH)%type.
-
- Definition cmd2string (cmd : Vector.t bool DRAM_CMD_WIDTH) : string :=
- let eq := Vector.eqb bool eqb cmd in if eq NOP_VEC then "NOP"
- else if eq PRE_VEC then "PRE"
- else if eq ACT_VEC then "ACT"
- else if eq RD_VEC then "RD"
- else if eq WR_VEC then "WR"
- else if eq PREA_VEC then "PREA"
- else if eq REF_VEC then "REF"
- else "INVALID".
-
- Declare Scope string_scope.
- Infix "+s+" := String.append (at level 0).
- Open Scope string_scope.
-
- Definition tuple2string (e : SM_out) : (string) :=
- let '(full,cmd,req) := e in
- let full_str := if full then "FULL, " else "NOT FULL, " in
- let cmd_str := cmd2string cmd in
- let req_N := HexString.of_N (Bv2N req) in (full_str +s+ cmd_str +s+ " ," +s+ req_N).
-
- Close Scope string_scope.
-
- Fixpoint index_ {T} (e : seq T) : seq nat :=
- match e with
- | [::] => [0]
- | x :: s => [length e] ++ (index_ s)
- end.
-
- Definition map_out (input : seq (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH))
- := zip (rev (index_ input)) (map (tuple2string) input).
-
- (* Definition state2string (s : Vector.t bool STATE_WIDTH) : string :=
- let eq := Vector.eqb bool eqb s in if eq STATE_IDLE_VEC then "IDLE"
- else if eq STATE_RUN_VEC then "RUNNING"
- else if eq STATE_REF_VEC then "REFRESHING"
- else "STATE INVALID".
-
- Definition map_update_out (e : seq (Vector.t bool STATE_WIDTH * bool * Vector.t bool COUNTER_WIDTH *
- Vector.t bool COUNTER_REF_WIDTH))
- := map (fun '(s,e,cnt,cref) => (state2string s,e,Bv2N cnt,Bv2N cref)) e. *)
-
-End CavaSM.
diff --git a/framework/CavaDRAM/Core/CavaSMbackup.v b/framework/CavaDRAM/Core/CavaSMbackup.v
deleted file mode 100644
index 8275535..0000000
--- a/framework/CavaDRAM/Core/CavaSMbackup.v
+++ /dev/null
@@ -1,424 +0,0 @@
-From Cava Require Export Cava CavaProperties Util.List BitArithmeticProperties.
-
-From Coq Require Export Vectors.Fin Bool.Bool Program.Basics.
-
-From CavaDRAM Require Export CavaReqQueue.
-
-From CoqDRAM Require Export FIFO.
-
-Section CavaSM.
-
- Context {CAVA_SYS : CavaSystem}.
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
-
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
-
- (* Have to change such that COUNTER_WIDTH is defined by the right number of bits *)
- Definition COUNTER_WIDTH := Nat.log2 WAIT.
-
- Definition Cava_ACT_date := T_RP.-1.
- Definition Cava_CAS_date := ACT_date + T_RCD.
-
- Definition NOP := Vec.bitvec_literal (N2Bv_sized DRAM_CMD_WIDTH 0).
- Definition null_req := Vec.bitvec_literal (N2Bv_sized REQUEST_WIDTH 0).
-
- Definition cnt_nil_combType := Vector.const false COUNTER_WIDTH.
- Definition cnt_nil := Vec.bitvec_literal (N2Bv_sized COUNTER_WIDTH 0).
-
- Definition WaitVEC := Vec.bitvec_literal (N2Bv_sized COUNTER_WIDTH (N.of_nat (WAIT - 1))).
-
- (* Definition WaitVECm1 := Vec.bitvec_literal (N2Bv_sized COUNTER_WIDTH (N.of_nat (WAIT - 2))). *)
-
- Definition EqWAIT : Circuit (signal (Vec Bit COUNTER_WIDTH)) (signal Bit) :=
- Comb (fun x => CavaPrelude.eqb (x,WaitVEC)).
-
- Definition NextCR : Circuit
- ( signal Bit (* SM state *)
- * signal (Vec Bit COUNTER_WIDTH) (* counter *)
- * signal Bit (* empty *)
- * signal (Vec Bit REQUEST_WIDTH)) (* top request *)
- ( signal (Vec Bit REQUEST_WIDTH))
- := let state_init : combType (Vec Bit REQUEST_WIDTH) := Vector.const zero (REQUEST_WIDTH) in
- LoopInit state_init (
- Comb ( fun '(s,c,e,tr,cr) =>
- ns <- inv s ;; ne <- inv e ;;
- c_eq <- CavaPrelude.eqb (c,WaitVEC) ;;
- w1 <- or2 (c_eq,ns) ;;
- mux1_sel <- and2 (ne,w1) ;;
- mux1_out <- mux2 mux1_sel (cr,tr) ;;
- (* if (empty && (c == w-1 || state = idle)) then cr' = nullreq
- else if (!empty && (c == w-1 || state = idle)) then cr' = tr (from the fifo)
- else cr' = cr *)
- mux2_sel <- and2 (e,w1) ;;
- mux2_out <- mux2 mux2_sel (mux1_out,null_req) ;;
- ret (mux2_out,mux2_out)
- )
- ).
-
- (* definitely not optimzed, just 5 muxes in a row *)
- (* state * counter * pop -> command *)
- Definition CmdGen : Circuit
- ( signal Bit (* SM state *)
- * signal (Vec Bit COUNTER_WIDTH) (* counter *)
- * signal Bit ) (* empty *)
- ( signal (Vec Bit DRAM_CMD_WIDTH)) (* command *) :=
- let act_vec := Vec.bitvec_literal (N2Bv_sized COUNTER_WIDTH (N.of_nat Cava_ACT_date)) in
- let cas_vec := Vec.bitvec_literal (N2Bv_sized COUNTER_WIDTH (N.of_nat Cava_CAS_date)) in
- let NOP := Vec.bitvec_literal (N2Bv_sized DRAM_CMD_WIDTH 0) in
- let ACT := Vec.bitvec_literal (N2Bv_sized DRAM_CMD_WIDTH 1) in
- let CAS := Vec.bitvec_literal (N2Bv_sized DRAM_CMD_WIDTH 2) in
- let PRE := Vec.bitvec_literal (N2Bv_sized DRAM_CMD_WIDTH 3) in
- Comb (fun '(s,c,e) =>
- eq_wait <- CavaPrelude.eqb (c,WaitVEC) ;;
- eq_act <- CavaPrelude.eqb (c,act_vec) ;;
- eq_cas <- CavaPrelude.eqb (c,cas_vec) ;;
- ne <- inv e ;; ns <- inv s ;;
- mux0_sel <- and2 (eq_wait,ne) ;; mux0_out <- mux2 mux0_sel (NOP,PRE) ;;
- mux1_out <- mux2 eq_cas (mux0_out,CAS) ;;
- mux2_out <- mux2 eq_act (mux1_out,ACT) ;;
- mux3_sel <- and2 (ns,ne) ;; mux3_out <- mux2 mux3_sel (mux2_out,PRE) ;;
- mux4_sel <- and2 (ns,e) ;; mux4_out <- mux2 mux4_sel (mux3_out,NOP) ;;
- ret (mux4_out)
- ).
-
- (* s, c == w.-1, e -> *)
- Definition UpdateState
- : Circuit
- ( signal Bit (* SM state *)
- * signal (Vec Bit COUNTER_WIDTH) (* Counter *)
- * signal Bit) (* Empty *)
- ( signal Bit (* SM state *)
- * signal (Vec Bit COUNTER_WIDTH) (* Counter *)
- * signal Bit) := (* Empty *)
- Comb (fun '(s,cnt,e) =>
- c <- CavaPrelude.eqb (cnt,WaitVEC) ;;
- (* cm1 <- CavaPrelude.eqb (cnt,WaitVECm1) ;; *)
- ns <- inv s ;;
- ne <- inv e ;;
- t <- or2 (ns,c) ;;
- t0 <- and2 (ns,ne) ;;
- (* t1 <- or2 (ns,cm1) ;; *)
- (* new s *)
- new_s_sel <- and2(e,t);;
- new_s <- mux2 new_s_sel (one,zero) ;;
- (* new counter *)
- cntp1 <- incrN cnt ;;
- new_cnt_sel <- or2 (c,t0) ;;
- new_cnt <- mux2 new_cnt_sel (cntp1,cnt_nil) ;;
- (* new pop *)
- new_p_sel <- and2(ne,t) ;;
- new_p <- mux2 new_p_sel (zero,one) ;;
- (* end *)
- ret (new_s,new_cnt,new_p)
- ).
-
- (* read data * read pending -> full * command * current request *)
- Definition CavaFIFO_NextState
- : Circuit
- ( signal Bit (* request pending *)
- * signal (Vec Bit REQUEST_WIDTH) (* request data *)
- )
- ( signal Bit (* queue is full *)
- * signal (Vec Bit DRAM_CMD_WIDTH) (* command *)
- * signal (Vec Bit REQUEST_WIDTH) (* current request *)
- ) :=
- let pop_init : combType (Bit) := false in
- let s_init : combType (Bit) := false in
- let cnt_init : combType (Vec Bit COUNTER_WIDTH) := cnt_nil_combType in
- LoopInit pop_init ( (* Rp, Rd, p *)
- LoopInit s_init ( (* (Rp, Rd, p), s *)
- LoopInit cnt_init ( (* (Rp, Rd, p), s, cnt *)
- Comb (fun '(Rp,Rd,p,s,cnt) => ret (s,cnt,(Rp,Rd,p)))
- >==> Second (RequestQueue)
- >==> Comb (fun '(s,cnt,(full_o,tr,empty_o)) => ret (full_o,s,cnt,empty_o,(s,cnt,empty_o,tr)))
- >==> Second (NextCR)
- >==> Comb (fun '(full_o,s,cnt,empty_o,(cr)) => ret (full_o,cr,s,cnt,empty_o,(s,cnt,empty_o)))
- >==> Second (CmdGen)
- >==> Comb (fun '(full_o,cr,s,cnt,empty_o,cmd) => ret(full_o,cmd,cr,(s,cnt,empty_o)))
- >==> Second (UpdateState)
- >==> Comb (fun '(full_o,cmd,cr,(ns,nc,ne)) => ret (full_o,cmd,cr,ne,ns,nc))
- )
- )
- ).
-
-End CavaSM.
-
-Section CodeGeneration.
-
- Existing Instance CavaCombinationalNet.
-
- Program Instance CAVA_SYS : CavaSystem := {
-
- (* Defines Request Size *)
- FE_CMD_WIDTH := 1;
- FE_ADDR_WIDTH := 28;
- FE_ID_WIDTH := 2;
-
- ROW_ADDR_WIDTH := 16;
- BANK_ADDR_WIDTH := 2;
- DRAM_BUS_WIDTH := 2;
- DRAM_BANKS := 8;
- DRAM_CMD_WIDTH := 2;
- BL := 4;
- CLK_RATIO := 2;
-
- (* Defines Memory Size *)
- QUEUE_MAX_SIZE := 4;
-
- (* not used*)
- MEM_ADDR_WIDTH := 4;
- }.
-
- (* Values from DDR3-1600K *)
- Program Instance SYS_CFG : System_configuration :=
- {
- BANKGROUPS := 1;
- BANKS := 8;
-
- T_BURST := 2;
- T_WL := 2;
-
- T_RRD_s := 2;
- T_RRD_l := 3;
-
- T_FAW := 2;
-
- T_RC := 2;
- T_RP := 2;
- T_RCD := 2;
- T_RAS := 2;
- T_RTP := 2;
- T_WR := 2;
-
- T_RTW := 2;
- T_WTR_s := 2;
- T_WTR_l := 3;
- T_CCD_s := 2;
- T_CCD_l := 3;
-
- T_REFI := 50;
- T_RFC := 10
- }.
-
- Program Instance FIFO_CFG : FIFO_configuration :=
- {
- WAIT := 25
- }.
-
- Definition test_req := N2Bv_sized REQUEST_WIDTH 3.
-
- Locate defaultSignal.
-
- Check slice_default (stest_req.
-
- (* problem is that WAIT = 10 is represented with 3 bits only *)
- (* COUNTER_WIDTH should be using a ceiling function *)
- Compute Nat.log2 WAIT. (* COUNTER_WIDTH = 3 *)
- Compute simulate EqWAIT [(N2Bv_sized COUNTER_WIDTH 15)].
-
- (* Definition sm_interface
- := sequentialInterface "sm_interface"
- "clk" PositiveEdge "rst" PositiveEdge
- [mkPort "Rp" Bit; mkPort "Rd" (Vec Bit REQUEST_WIDTH)]
- [mkPort "full_o" Bit; mkPort "cmd_o" (Vec Bit DRAM_CMD_WIDTH); mkPort "CR" (Vec Bit REQUEST_WIDTH)]. *)
-
- (* Definition sm_netlist :=
- (makeCircuitNetlist sm_interface CavaFIFO_NextState). *)
-
- (* Definition SM_out := (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH)%type.
-
- Definition cmd2string (cmd : Vector.t bool DRAM_CMD_WIDTH) : string :=
- if (Vector.eqb bool eqb cmd [true;false]) then "ACT"
- else if (Vector.eqb bool eqb cmd [true;true]) then "PRE"
- else if (Vector.eqb bool eqb cmd [false;true]) then "CAS"
- else "NOP".
-
- Definition tuple2string (e : SM_out) : (string * N) :=
- let '(full,cmd,req) := e in
- let full_str := if full then "FULL, " else "NOT FULL, " in
- let cmd_str := cmd2string cmd in
- let req_N := Bv2N req in ((append full_str cmd_str), req_N).
-
- Definition map_out (input : seq (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH))
- := map (tuple2string) input. *)
-
- (* Compute (map_FIFO_out (simulate RequestQueue [
- (true, N2Bv_sized REQUEST_WIDTH 1, false);
- (true, N2Bv_sized REQUEST_WIDTH 2, false);
- (true, N2Bv_sized REQUEST_WIDTH 3, true);
- (true, N2Bv_sized REQUEST_WIDTH 4, false)
- ])).
-
- Compute (simulate NextCR [
- (false,cnt_nil_combType, true, null_req);
- (false,N2Bv_sized COUNTER_WIDTH 1,false,N2Bv_sized REQUEST_WIDTH 1);
- (true,cnt_nil_combType,false,N2Bv_sized REQUEST_WIDTH 1);
- (true,N2Bv_sized COUNTER_WIDTH 1,false,N2Bv_sized REQUEST_WIDTH 2)
- ]).
-
- Compute (map cmd2string (simulate CmdGen [
- (false,cnt_nil_combType,true);
- (false,N2Bv_sized COUNTER_WIDTH 1,false);
- (true,cnt_nil_combType,false)
- ])).
-
- Compute (simulate UpdateState [
- (false,cnt_nil_combType,true);
- (false,N2Bv_sized COUNTER_WIDTH 1, false);
- (true,cnt_nil_combType,false)
- ]). *)
-
- Definition sm_inputs := [
- (true, N2Bv_sized REQUEST_WIDTH 1);
- (true, N2Bv_sized REQUEST_WIDTH 2);
- (true, N2Bv_sized REQUEST_WIDTH 3);
- (true, N2Bv_sized REQUEST_WIDTH 4)]
- ++ (repeat (false, N2Bv_sized REQUEST_WIDTH 1) 30)
- ++ [(true, N2Bv_sized REQUEST_WIDTH 5)]
- ++ (repeat (false, null_req) 30).
-
- (* Definition sm_expected_outputs :=
- simulate CavaFIFO_NextState sm_inputs.
-
- Definition sm_tb := testBench "sm_tb" (sm_interface) sm_inputs sm_expected_outputs. *)
-
- (* will actually fit just 3 requests in the queue
- Compute (map_out (simulate CavaFIFO_NextState ([
- (true, N2Bv_sized REQUEST_WIDTH 1);
- (* R1 : 1 -> queue: [r1], cnt = 1, wa = 1, rda = 0 *)
- (true, N2Bv_sized REQUEST_WIDTH 2);
- (* R2 : 2 -> queue: [r2], cnt = 0, wa = 2, rda = 1, R1 PRE*)
- (true, N2Bv_sized REQUEST_WIDTH 3);
- (* R3 : 3 -> queue: [r3,r2], cnt = 1, wa = 3, rda = 1 *)
- (true, N2Bv_sized REQUEST_WIDTH 4);
- (* R4 : 4 -> queue: [r4,r3,r2], cnt = 2, wa = 0, rda = 1 (FULL), *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 3 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 4 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 5 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 6 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 7 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 8 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 9 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 10 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 11 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 12 *)
- (true,N2Bv_sized REQUEST_WIDTH 5);
- (* cnt = 13, R5 arrival fails, queue is full *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 14 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 15 *)
- (false,N2Bv_sized REQUEST_WIDTH 0);
- (* cnt = 0, RUNNING, R2 PRE *)
- (false,N2Bv_sized REQUEST_WIDTH 0)
- (* (false,N2Bv_sized REQUEST_WIDTH 0); *)
- (* (false,N2Bv_sized REQUEST_WIDTH 0); *)
- (* (false,N2Bv_sized REQUEST_WIDTH 0) *)
- ] ++ (repeat (false,N2Bv_sized REQUEST_WIDTH 0) 20))
- )). *)
-
-End CodeGeneration.
-
-(* Section Test.
-
- Existing Instance CombinationalSemantics.
-
- (* Instance already defined in CavaFIFO.v *)
- Existing Instance CAVA_SYS.
-
- Program Instance SYS_CFG : System_configuration :=
- {
- BANKGROUPS := 1;
- BANKS := 4;
-
- T_BURST := 1;
- T_WL := 1;
-
- T_RRD_s := 1;
- T_RRD_l := 3;
-
- T_FAW := 20;
-
- T_RC := 3;
- T_RP := 4;
- T_RCD := 2;
- T_RAS := 4;
- T_RTP := 4;
- T_WR := 1;
-
- T_RTW := 10;
- T_WTR_s := 1;
- T_WTR_l := 10;
- T_CCD_s := 1;
- T_CCD_l := 12;
- }.
-
- Program Instance FIFO_CFG : FIFO_configuration :=
- {
- WAIT := 13
- }.
-
- Definition SM_out := (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH)%type.
-
- Definition cmd2string (cmd : Vector.t bool DRAM_CMD_WIDTH) : string :=
- if (Vector.eqb bool eqb cmd [true;false]) then "ACT"
- else if (Vector.eqb bool eqb cmd [true;true]) then "PRE"
- else if (Vector.eqb bool eqb cmd [false;true]) then "CAS"
- else "NOP".
-
- Definition tuple2string (e : SM_out) : (string * N) :=
- let '(full,cmd,req) := e in
- let full_str := if full then "FULL, " else "NOT FULL, " in
- let cmd_str := cmd2string cmd in
- let req_N := Bv2N req in ((append full_str cmd_str), req_N).
-
- Definition map_out (input : seq (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH))
- := map (tuple2string) input.
-
- (* the full signal relates to the current state of the fifo *)
- (* if there is only one space in the fifo *)
-
- (* current state of the fifo is calculated through write and read addresses *)
- (* operation is performed on clock edge and fifo should output signals regarding the new state *)
- (* full should really be the result of the fifo after writing *)
-
- (* Check repeat (false,N2Bv_sized REQUEST_WIDTH 0) 5. *)
-
- Compute (map_out (simulate CavaFIFO_NextState [
- (true, N2Bv_sized REQUEST_WIDTH 1);
- (* R1 : 1 -> queue: [r1], cnt = 1, wa = 1, rda = 0 *)
-
- (true, N2Bv_sized REQUEST_WIDTH 2);
- (* R2 : 2 -> queue: [r2], cnt = 0, wa = 2, rda = 1, R1 PRE*)
-
- (true, N2Bv_sized REQUEST_WIDTH 3);
- (* R3 : 3 -> queue: [r3,r2], cnt = 1, wa = 3, rda = 1 *)
-
- (true, N2Bv_sized REQUEST_WIDTH 4);
- (* R4 : 4 -> queue: [r4,r3,r2], cnt = 2, wa = 0, rda = 1 (FULL), R1 ACT *)
-
- (false,N2Bv_sized REQUEST_WIDTH 0); (* cnt = 3 *)
- (false,N2Bv_sized REQUEST_WIDTH 0); (* cnt = 4 *)
- (false,N2Bv_sized REQUEST_WIDTH 0); (* cnt = 5 *)
- (false,N2Bv_sized REQUEST_WIDTH 0); (* cnt = 6 *)
- (false,N2Bv_sized REQUEST_WIDTH 0); (* cnt = 7 *)
-
- (* this write will not work because the FIFO is still full, R2 PRE *)
- (true,N2Bv_sized REQUEST_WIDTH 5);
-
- (* now it works, cnt = 1, wa = 1, rda = 2 (FULL), NOP *)
- (true,N2Bv_sized REQUEST_WIDTH 5)
- ])).
-
-End Test. *)
\ No newline at end of file
diff --git a/framework/CavaDRAM/Core/CavaSubtractor.v b/framework/CavaDRAM/Core/CavaSubtractor.v
deleted file mode 100644
index ff7b196..0000000
--- a/framework/CavaDRAM/Core/CavaSubtractor.v
+++ /dev/null
@@ -1,117 +0,0 @@
-Require Import Cava.Cava.
-Require Import Cava.CavaProperties.
-Require Import Cava.Util.Vector.
-
-From mathcomp Require Import ssreflect ssrnat ssrbool seq eqtype ssrZ zify ring.
-From Coq Require Import NArith.
-
-From CavaDRAM Require Import CavaSystem UtilSM.
-From CoqDRAM Require Import Util.
-
-Import Circuit.Notations.
-
-Section CavaSubtractor.
-
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
-
- Definition subtractor {n : nat}
- (inputs : signal (Vec Bit n) * signal (Vec Bit n))
- : cava (signal (Vec Bit n) * signal Bit)
- := let '(a,b) := inputs in
- not_b <- Vec.inv b ;;
- aV <- unpackV a ;;
- bV <- unpackV not_b ;;
- col fullAdder one (vcombine aV bV).
-
- Definition Subtractor {n : nat}
- : Circuit _ (signal (Vec Bit n) * signal Bit)
- := Comb subtractor.
-
-End CavaSubtractor.
-
-Section CavaSubtractorProperties.
-
- Lemma case1 (x y : N) (z : nat) :
- N.to_nat x < z ->
- N.to_nat y < z ->
- (y < x) = false ->
- let t := N.of_nat z in
- (2 * (t - (y - x) - 1) + 1)%N =
- (2 * t - (2 * y + 1 - (2 * x + 1)) - 1)%N.
- Proof.
- lia.
- Qed.
-
- Lemma case2 (x y : N) (z : nat) :
- N.to_nat x < z ->
- N.to_nat y < z ->
- (y <= x) = false ->
- let t := N.of_nat z in
- (2 * (t - (y - x)) + 1)%N =
- (2 * t - (2 * y - (2 * x + 1)))%N.
- Proof.
- lia.
- Qed.
-
- Lemma case3 (x y : N) (z : nat) :
- N.to_nat x < z ->
- N.to_nat y < z ->
- (y < x) = false ->
- let t := N.of_nat z in
- (2 * (t - (y - x) - 1) + 1)%N =
- (2 * t - (2 * y + 1 - 2 * x))%N.
- Proof.
- lia.
- Qed.
-
- Lemma case4 (x y : N) (z : nat) :
- N.to_nat x < z ->
- N.to_nat y < z ->
- (y < x) = false ->
- let t := N.of_nat z in
- (2 * (t - (y - x) - 1) + 1)%N =
- (2 * t - (2 * y - 2 * x) - 1)%N.
- Proof.
- lia.
- Qed.
-
- Lemma fullAdder_cin {n} (x y : Vector.t bool n) cin:
- let xN := Bv2N x in
- let yN := Bv2N y in
- let out := if cin
- then (if (yN <= xN)%nat then (xN - yN)%N else ((N.of_nat (Nat.pow 2 n)) - (yN - xN))%N)
- else (if (yN < xN)%nat then (xN - yN - 1)%N else ((N.of_nat (Nat.pow 2 n)) - (yN - xN) - 1)%N) in
- fst (col fullAdder cin (vcombine x (Vector.map negb y))) = N2Bv_sized n out.
- Proof.
- intros out; unfold out; clear out.
- revert x y cin.
- induction n; intros;
- [ apply Vector.case0 with (v:=x); apply Vector.case0 with (v:=y);
- destruct cin; reflexivity | ].
- rewrite col_step fullAdder_correct; cbn [fst snd].
- rewrite (Vector.eta x) (Vector.eta y); simpl; rewrite IHn; clear IHn;
- destruct (Vector.hd x) eqn:Hx, (Vector.hd y) eqn:Hy, cin eqn:Hcin; simpl;
- repeat match goal with
- | |- context [?y <= ?x] =>
- let H := fresh "x" in destruct (y <= x) eqn:H
- | |- context [?y < ?x] =>
- let H := fresh "x" in destruct (y < x) eqn:H
- end;
- set xx := Bv2N (Vector.tl x); set yy := Bv2N (Vector.tl y); fold xx yy in x0, x1.
- all: try (rewrite -N2Bv_sized_double || rewrite -N2Bv_sized_succ_double); apply f_equal.
- all: try (rewrite Nat.add_0_r;
- match goal with
- | |- context [Nat.pow 2 ?n] => set z := Nat.pow 2 n
- end; rewrite of_nat_add_double).
- all: try (rewrite !N.double_spec); try (rewrite !N.succ_double_spec); try lia.
- all: try (rewrite !N.succ_double_spec in x1); try (rewrite !N.double_spec in x1).
- all: try (contradict x1; lia);
- specialize (@Bv2N_upper_bound_nat n (Vector.tl x)) as Hxb; fold xx in Hxb;
- specialize (@Bv2N_upper_bound_nat n (Vector.tl y)) as Hyb; fold yy in Hyb.
- all: try apply case1; try done.
- all: try apply case2; try done.
- all: try apply case3; try done.
- all: try apply case4; try done.
- Qed.
-
-End CavaSubtractorProperties.
diff --git a/framework/CavaDRAM/Core/CavaSubtractorProperties.v b/framework/CavaDRAM/Core/CavaSubtractorProperties.v
deleted file mode 100644
index 471d25e..0000000
--- a/framework/CavaDRAM/Core/CavaSubtractorProperties.v
+++ /dev/null
@@ -1,72 +0,0 @@
-Require Import CavaSubtractor.
-Require Import Coq.micromega.Lia.
-
-From CoqDRAM Require Import Util.
-
-Section CavaSubtractorProperties.
-
- Existing Instance CombinationalSemantics.
-
- Compute map (fun '(a,b) => (Bv2N a, b)) (simulate Subtractor [
- ((N2Bv_sized 3 6),(N2Bv_sized 3 6))
- ]).
-
- (* poid faible *)
- Definition test_vec1 := (N2Bv_sized 4 1).
- Compute test_vec1.
- Compute VectorDef.hd test_vec1.
-
- Local Ltac simplify_step :=
- first [ destruct_pair_let
- | rewrite eqb_nat_to_bitvec_sized; by Lia.lia
- | rewrite nat_to_bitvec_to_nat; by Lia.lia
- | progress simpl_ident
- | progress autorewrite with to_spec
- | progress cbn [fst snd map] ].
- Local Ltac simplify := repeat simplify_step.
-
- Lemma fullAdder_cin {n} (x y : Vector.t bool n) cin:
- let c := N.to_nat (Bv2N y) <= N.to_nat (Bv2N x) in
- let out := if cin
- then (if c then (N.sub (Bv2N x) (Bv2N y)) else Bv2N (Vec.xor (x,y)))
- else (if c then Bv2N (Vector.map negb (Vec.xor (x,y))) else N.add (Bv2N x) (Bv2N (Vector.map negb y))) in
- fst (col fullAdder cin (vcombine x (Vector.map negb y))) = N2Bv_sized n out.
- Proof.
- intros c out; unfold out. clear out. unfold c. clear c.
- revert x y cin.
- induction n; intros;
- [ apply Vector.case0 with (v:=x); apply Vector.case0 with (v:=y);
- destruct cin; reflexivity | ].
- rewrite col_step fullAdder_correct. cbn [fst snd].
- rewrite (Vector.eta x) (Vector.eta y); simpl. rewrite IHn. clear IHn.
- destruct (VectorDef.hd x) eqn:Hx, (VectorDef.hd y) eqn:Hy, cin eqn:Hcin; simpl;
- repeat match goal with
- | |- context [N.to_nat ?y <= N.to_nat ?x] =>
- let H := fresh "x" in destruct (N.to_nat y <= N.to_nat x) eqn:H
- end;
- set (xx := Bv2N (VectorDef.tl x)); (set yy := Bv2N (VectorDef.tl y)); fold xx yy in x0, x1.
- all: try (rewrite N2Bv_sized_double !N2Bv_sized_Bv2N; reflexivity).
- all: try (rewrite -N2Bv_sized_double).
- all: try (rewrite !N.succ_double_spec N.double_spec).
- all: try (repeat apply f_equal).
- 1: { (* the actual deal *)
- rewrite leq_eqVlt in x0. apply orb_prop in x0 as [x0 | x0].
- { move: x0 => /eqP x0; apply N2Nat.inj_iff in x0; rewrite x0.
- by rewrite N.mul_sub_distr_l !N.sub_diag.
- }
- rewrite N.mul_sub_distr_l N.add_sub_swap.
- 2: {
- rewrite N.add_1_r. apply N.le_succ_l. apply N.mul_lt_mono_pos_l.
- 1: exact N.lt_0_2.
- specialize N2Nat.inj_ltb with (x := yy) (y := xx) as HH.
- apply N.ltb_lt.
- rewrite HH.
- apply /Nat.ltb_spec0.
- admit.
- }
- admit.
- }
- all: admit.
- Admitted.
-
-End CavaSubtractorProperties.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Core/CavaSystem.v b/framework/CavaDRAM/Core/CavaSystem.v
index f487878..be7cc9a 100644
--- a/framework/CavaDRAM/Core/CavaSystem.v
+++ b/framework/CavaDRAM/Core/CavaSystem.v
@@ -1,5 +1,6 @@
Set Warnings "-notation-overridden,-parsing".
-Require Import Coq.NArith.NArith.
+
+From Coq Require Import NArith.
From mathcomp Require Import ssreflect ssrnat ssrbool seq eqtype.
diff --git a/framework/CavaDRAM/Core/Memory.v b/framework/CavaDRAM/Core/Memory.v
deleted file mode 100644
index 1582b4c..0000000
--- a/framework/CavaDRAM/Core/Memory.v
+++ /dev/null
@@ -1,296 +0,0 @@
-From Coq Require Import String NArith PeanoNat Bvector.
-From mathcomp Require Import ssreflect.
-
-Require BinaryString Vectors.VectorDef Coq.Arith.Compare.
-Global Open Scope string_scope.
-
-Require Import ExtLib.Structures.Monad.
-
-From Cava Require Import Core Semantics.Simulation Semantics.Combinational Util.Tactics.
-From Cava.Lib Require Vec.
-From Cava.Lib Require Import CavaPrelude Combinators Multiplexers Decoder DecoderProperties CombinatorsProperties.
-
-Import MonadNotation Circuit.Notations Init.Logic.EqNotations.
-Global Open Scope monad_scope.
-
-Require Import CavaDRAM.Util CavaDRAM.Step.
-
-Section WithCava.
- Context `{semantics : Cava}.
-
- (* write data * write enable -> read data*)
- Definition mem_cell T I :=
- DelayInitCE (t := T) I.
-
- (* read data vector * write data * write enable * read data -> read data vector *)
- Definition mem_combine {M N} T (H : S M = N) :=
- Comb (
- fun (input : signal (Vec T M) * (signal T * signal Bit * signal T)) =>
- let '(rdV, (wd, we, rd)) := input in
- v <- mux2 we (rd, wd);;
- x <- Vec.shiftin v rdV;;
- r <- Util.vec_cast T H x;;
- ret r
- ).
-
- (* write data * write enable vector -> write data * write enable *)
- Definition mem_we T W N :=
- Comb (
- fun input : signal T * signal (Vec Bit (2^W)) =>
- let '(wd, weV) := input in
- we <- indexConst weV (N-1);;
- ret (wd, we)
- ).
-
- (* write data * write enable vector -> read data vector *)
- Fixpoint mem_cells T W N I: (Circuit (signal T * signal (Vec Bit (2^W))) (signal (Vec T N))) :=
- match N as X return X = N -> _ with
- | 0 =>
- fun H =>
- Comb (fun x =>
- r <- Vec.nil;;
- x <- (Util.vec_cast T H r);;
- ret x
- )
- | S N' =>
- fun H =>
- Comb(fork2)
- >==> First (mem_cells T W N' I)
- >==> Second (mem_we T W N >==> Comb(fork2) >==> Second (mem_cell T (I N')))
- >==> mem_combine T H
- end Logic.eq_refl.
-
- (* write data * write address * write enable -> write data * write enable vector *)
- Definition mem_write T W :=
- Comb (
- fun input : signal T * signal (Vec Bit W) * signal Bit =>
- let '(wd, wa, we) := input in
- weV <- Util.decode we wa;;
- ret (wd, weV)
- ).
-
- (* read address * read data vecor -> read data *)
- Definition mem_read T W N P (PP : nat) :=
- Comb (
- fun input : signal (Vec (Vec Bit W) P) * signal (Vec T N) =>
- '(rdAV, rdV) <- input;;
- rdA <- indexConst rdAV PP;;
- indexAt rdV rdA
- ).
-
- Definition mem_read_combine {M N} T (H : S M = N) :=
- Comb (
- fun (input : signal (Vec T M) * (signal T)) =>
- let '(rdV, rd) := input in
- x <- Vec.shiftin rd rdV;;
- r <- Util.vec_cast T H x;;
- ret r
- ).
-
- Fixpoint mem_reads T W N P PP : (Circuit (signal (Vec (Vec Bit W) P) * signal (Vec T N)) (signal (Vec T PP))) :=
- match PP as X return X = PP -> _ with
- | 0 =>
- fun H =>
- Comb (fun x =>
- r <- Vec.nil;;
- x <- (Util.vec_cast T H r);;
- ret x
- )
- | S PP' =>
- fun H =>
- Comb(fork2)
- >==> First (mem_reads T W N P PP')
- >==> Second (mem_read T W N P PP')
- >==> mem_read_combine T H
- end Logic.eq_refl.
-
- (* read addresses * write data * write address * write enable -> read data
- T: type of memory cell contents (Vec 32)
- W: address width in bits
- P: number of read ports
- I: initial content of memory
- *)
- (* Second (mem_write T W >==> mem_cells T W (2^W) I). >==> mem_read T W (2^W) P 1). *)
-
- Definition Memory T W P I :=
- Second (mem_write T W >==> mem_cells T W (2^W) I) >==> mem_reads T W (2^W) P P.
-
- Definition Memory' T W P I :=
- Second (mem_write T W >==> mem_cells T W (2^W) I) >==> mem_read T W (2^W) P 0.
-
-End WithCava.
-
-Module Test.
- Import ListNotations Vector.VectorNotations.
- Import Cava.Semantics.Simulation.
-
- Definition Test_input1 := [
- ([N2Bv_sized 3 0; N2Bv_sized 3 2]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, false));
- ([N2Bv_sized 3 1; N2Bv_sized 3 3]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, false));
- ([N2Bv_sized 3 2; N2Bv_sized 3 0]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, false));
- ([N2Bv_sized 3 3; N2Bv_sized 3 1]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, false))
- ]%list.
-
- Definition Test_result1 :=
- [
- [0%N; 2%N]%vector;
- [1%N; 3%N]%vector;
- [2%N; 0%N]%vector;
- [3%N; 1%N]%vector
- ]%list.
-
- (* Initializes the memory content with the address *)
- Definition Init1 (n : nat):=
- N2Bv_sized 2 (N.of_nat n).
-
- Definition Test_run1 :=
- map (Vector.map Bv2N) (simulate (Memory (Vec Bit 2) 3 2 Init1) Test_input1).
-
- Lemma Test: Test_run1 = Test_result1.
- Proof.
- reflexivity.
- Qed.
-
- Definition Test_input2 :=
- [
- (* writes 0 at @0, reads @0 := 0 and @3 := 0 *)
- ([N2Bv_sized 3 0; N2Bv_sized 3 3]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, true));
- (* writes 1 at @1, reads @1 := 1 and @2 := 1 *)
- ([N2Bv_sized 3 1; N2Bv_sized 3 2]%vector, (N2Bv_sized 2 1, N2Bv_sized 3 1, true));
- (* writes 2 at @2, reads @2 := 2 and @1 := 1*)
- ([N2Bv_sized 3 2; N2Bv_sized 3 1]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 2, true));
- ([N2Bv_sized 3 3; N2Bv_sized 3 0]%vector, (N2Bv_sized 2 3, N2Bv_sized 3 3, true));
- ([N2Bv_sized 3 0; N2Bv_sized 3 3]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 1, false));
- ([N2Bv_sized 3 1; N2Bv_sized 3 2]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 1, false));
- ([N2Bv_sized 3 2; N2Bv_sized 3 1]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 1, false));
- ([N2Bv_sized 3 3; N2Bv_sized 3 0]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 1, false))
- ]%list.
-
- Definition Init2 (n : nat):=
- N2Bv_sized 2 (N.of_nat (3-n)).
-
- Definition Test_run2 :=
- map (Vector.map Bv2N) (simulate (Memory (Vec Bit 2) 3 2 Init2) Test_input2).
-
- Definition Test_result2 :=
- [
- [0%N; 0%N]%vector;
- [1%N; 1%N]%vector;
- [2%N; 1%N]%vector;
- [3%N; 0%N]%vector;
- [0%N; 3%N]%vector;
- [1%N; 2%N]%vector;
- [2%N; 1%N]%vector;
- [3%N; 0%N]%vector
- ]%list.
-
- Lemma Test2 : Test_run2 = Test_result2.
- reflexivity.
- Qed.
-End Test.
-
-Module Properties.
-
- Definition Cells_state_prod {T W N M I} (H : N = S M) (r : circuit_state (mem_cells T W N I)) :
- (unit * circuit_state (mem_cells T W M I) * (unit * unit * circuit_state (mem_cell T (I N))) * unit)%type.
- Proof.
- destruct N.
- - discriminate H.
- - rewrite H in r; simpl in r; exact r.
- Defined.
-
- Fixpoint Cells_data {T W N I} (S : circuit_state (mem_cells T W N I)) : Vector.t (combType T) N :=
- match N as X return N = X -> X = N -> _ with
- | 0%nat =>
- fun H H' =>
- Vector.nil (combType T)
- | S N' =>
- fun H H'=>
- let '(_, s', (_, _, v), _) := Cells_state_prod H S in
- let r := Cells_data s' in
- Vector.shiftin v r
- end Logic.eq_refl Logic.eq_refl.
-
- Fixpoint Cells_read {T W N I} we wa wd (S : circuit_state (mem_cells T W N I)) : Vector.t (combType T) N :=
- match N as X return N = X -> X = N -> _ with
- | 0%nat =>
- fun H H' =>
- Vector.nil (combType T)
- | S N' =>
- fun H H'=>
- let '(_, s', (_, _, v), _) := Cells_state_prod H S in
- let r := Cells_read we wa wd s' in
- if ((wa =? N') && we)%nat then Vector.shiftin wd r
- else Vector.shiftin v r
- end Logic.eq_refl Logic.eq_refl.
-
- (* cells data won't change if not writing *)
- Lemma Cells_const {T W N I} (S : circuit_state (mem_cells T W N I)) wd we:
- (forall n, indexConst we n = constant false) ->
- Cells_data S = Cells_data (fst (step (mem_cells T W N I) S (wd, we))).
- Proof.
- intros Hwe.
- induction N.
- - reflexivity.
- - unfold mem_cells; fold mem_cells; unfold mem_cell.
- repeat step_destruct.
- rewrite (surjective_pairing (step (mem_cells _ _ _ _) SC3 _)) /=.
- rewrite Hwe (surjective_pairing SC2) (surjective_pairing (fst SC2)) IHN.
- reflexivity.
- Qed.
-
- (* Other parts of the memory do not change *)
- Lemma Cells_match {T W N I} (S : circuit_state (mem_cells T W N I)) wd wa we wev:
- (forall n, (wa =? n)%nat = false ->
- indexConst wev n = constant false) ->
- indexConst wev wa = constant we ->
- Cells_read we wa wd S = Cells_read we wa wd (fst (step (mem_cells T W N I) S (wd, wev))).
- Proof.
- intros Hwde Hwe.
- induction N.
- - reflexivity.
- - unfold mem_cells; fold mem_cells; unfold mem_cell.
- repeat step_destruct.
- rewrite (surjective_pairing (step (mem_cells _ _ _ _) SC3 _)) /=.
- rewrite (surjective_pairing SC2) (surjective_pairing (fst SC2)) IHN.
- destruct (wa =? N)%nat eqn:Hwa, we.
- + move : Hwa => /Nat.eqb_eq Hwa; subst N; reflexivity.
- + move : Hwa => /Nat.eqb_eq Hwa; subst N; rewrite Nat.sub_0_r Hwe; reflexivity.
- + rewrite Nat.sub_0_r (Hwde N Hwa); reflexivity.
- + rewrite Nat.sub_0_r (Hwde N Hwa); reflexivity.
- Qed.
-
- Lemma Cells_matchX {T W N I} (S : circuit_state (mem_cells T W N I)) wd wa we wev:
- (forall n, (wa =? n)%nat = false -> indexConst wev n = constant false) ->
- indexConst wev wa = constant we ->
- Cells_read we wa wd S = Cells_data (fst (step (mem_cells T W N I) S (wd, wev))).
- Proof.
- intros Hwde Hwe.
- induction N.
- - reflexivity.
- - unfold mem_cells; fold mem_cells; unfold mem_cell.
- repeat step_destruct.
- rewrite (surjective_pairing (step (mem_cells _ _ _ _) SC3 _)) /=.
- rewrite (surjective_pairing SC2) (surjective_pairing (fst SC2)) IHN.
- destruct (wa =? N)%nat eqn:Hwa, we.
- + move : Hwa => /Nat.eqb_eq Hwa; subst N; rewrite Nat.sub_0_r Hwe; reflexivity.
- + move : Hwa => /Nat.eqb_eq Hwa; subst N; rewrite Nat.sub_0_r Hwe; reflexivity.
- + rewrite Nat.sub_0_r (Hwde N Hwa); reflexivity.
- + rewrite Nat.sub_0_r (Hwde N Hwa); reflexivity.
- Qed.
-
- (* Fixpoint Mem_read {T W PP} (md : Vector.t (combType T) (2^W)) (rav : VectorDef.t (Bvector W) PP) :=
- match PP as X return PP = X -> _ with
- | 0 =>
- fun H =>
- Vector.nil (combType T)
- | S PP' =>
- fun H =>
- let rav := Vector.cast rav H in
- let r := Mem_read md (Vector.tl rav) in
- let i := Bv2Fin (Vector.hd rav) in
- let v := Vector.nth md i in
- Vector.shiftin v r
- end Logic.eq_refl. *)
-
-End Properties.
diff --git a/framework/CavaDRAM/Lib/CavaTactics.v b/framework/CavaDRAM/Lib/CavaTactics.v
deleted file mode 100644
index e9f52c4..0000000
--- a/framework/CavaDRAM/Lib/CavaTactics.v
+++ /dev/null
@@ -1,26 +0,0 @@
-Require Import CavaSM.
-Require Import Lia.
-From mathcomp Require Export ssreflect ssrnat ssrbool seq eqtype div.
-
-Ltac destruct_products :=
- repeat match goal with
- | p: _ * _ |- _ => destruct p
- | H: _ /\ _ |- _ => let Hl := fresh H "l" in let Hr := fresh H "r" in destruct H as [Hl Hr]
- | E: exists y, _ |- _ => let yf := fresh y in destruct E as [yf E]
- end.
-
-Ltac simplify_step :=
- first [ destruct_pair_let
- | rewrite eqb_nat_to_bitvec_sized; by Lia.lia
- | rewrite nat_to_bitvec_to_nat; by Lia.lia
- | progress simpl_ident
- | progress autorewrite with to_spec
- | progress cbn [fst snd map] ].
-
-Ltac simplify := repeat simplify_step.
-
-Ltac destruct_pair_let_ H :=
- match goal with
- | |- context [ match ?p with pair _ _ => _ end ] =>
- rewrite (surjective_pairing p)
- end.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Lib/CavaUtil.v b/framework/CavaDRAM/Lib/CavaUtil.v
deleted file mode 100644
index 3354b07..0000000
--- a/framework/CavaDRAM/Lib/CavaUtil.v
+++ /dev/null
@@ -1,59 +0,0 @@
-Require Import Cava.Cava.
-Require Import Cava.CavaProperties.
-
-From CavaDRAM Require Import CavaSystem.
-Import Circuit.Notations.
-
-Section CavaUtil.
-
- Context {signal : SignalType -> Type} {semantics : Cava signal}.
-
- Definition powerOfTwo (n : nat) : bool :=
- N.eqb (N.land (N.of_nat n) (N.of_nat (n - 1))) 0.
-
- Definition get_width x :=
- if (powerOfTwo x) then Nat.log2 x else (Nat.log2 x + 1).
-
- (* Inverses a bit vector *)
- Definition xor_1 {n : nat}
- : Circuit (signal (Vec Bit n)) (* N-bit Minued *)
- (signal (Vec Bit n))
- := let bvN_1 := Vec.bitvec_literal (N2Bv_sized n (N.of_nat (Nat.pow 2 n) - 1)) in
- Comb (fun '(a) => Vec.xor (a,bvN_1)).
-
- Definition xor_1_alt {n : nat} (inputs : signal (Vec Bit n))
- : cava (signal (Vec Bit n))
- := let bvN_1 := Vec.bitvec_literal (N2Bv_sized n (N.of_nat (Nat.pow 2 n) - 1)) in
- Vec.xor (inputs,bvN_1).
-
- (* Different subtractor versions : trying different things to falicitate proofs *)
- Definition Subtractor_v1 {n : nat}
- : Circuit (signal (Vec Bit n) * (* N-bit Minued *)
- signal (Vec Bit n)) (* N-bit Subtrahend *)
- (signal (Vec Bit n) * (* N-bit Difference*)
- signal Bit)
- := Second (xor_1) >==>
- Comb (fun '(a,b) =>
- a <- unpackV a ;;
- b <- unpackV b ;;
- col fullAdder one (vcombine a b)
- ).
-
- Definition subtractor_v2 {n : nat}
- (inputs : signal (Vec Bit n) * signal (Vec Bit n))
- : cava (signal (Vec Bit n) * signal Bit)
- := let '(a,b) := inputs in
- aV <- unpackV a ;;
- nb <- xor_1_alt b ;;
- nbV <- unpackV nb ;;
- col fullAdder one (vcombine aV nbV).
-
- Definition Subtractor_v2 {n : nat}
- : Circuit (signal (Vec Bit n) * (* N-bit Minued *)
- signal (Vec Bit n)) (* N-bit Subtrahend *)
- (signal (Vec Bit n) * (* N-bit Difference*)
- signal Bit)
- := Comb (subtractor_v2).
-
-End CavaUtil.
-
diff --git a/framework/CavaDRAM/Lib/Step.v b/framework/CavaDRAM/Lib/Step.v
index ddde91f..44c2295 100644
--- a/framework/CavaDRAM/Lib/Step.v
+++ b/framework/CavaDRAM/Lib/Step.v
@@ -1,18 +1,18 @@
Set Printing Projections.
-Require Import String NArith PeanoNat Bvector Vectors.Vector ssreflect.
-Require BinaryString Vectors.Vector Coq.Arith.Compare ZArith.BinInt.
-Global Open Scope string_scope.
-Require Import ExtLib.Structures.Monad.
-Require Import Cava.Core.Core Cava.Semantics.Simulation Cava.Semantics.Combinational Cava.Util.Tactics.
-From Cava.Lib Require Vec.
-From Cava.Lib Require Import CavaPrelude Combinators.
+From Coq Require Import String NArith Arith ZArith PeanoNat Bvector Vectors.Vector Arith BinaryString.
+From mathcomp Require ssreflect.
+From ExtLib Require Import Monad.
+From Cava Require Import Cava Lib Semantics.Combinational.
Import MonadNotation Circuit.Notations Init.Logic.EqNotations.
-Open Scope monad_scope.
+Global Open Scope string_scope.
+Open Scope monad_scope.
Open Scope vector_scope.
+#[global] Existing Instance CombinationalSemantics.
+
Lemma step_compose {I M O} (c1 : Circuit I M) (c2 : Circuit M O) i cs :
step (Compose c1 c2) cs i = let (sc1, o1) := (step c1 (fst cs) i) in
let (sc2, o2) := (step c2 (snd cs) o1) in (sc1, sc2, o2).
diff --git a/framework/CavaDRAM/Lib/Util.v b/framework/CavaDRAM/Lib/Util.v
index 7573b02..5a0ac5c 100644
--- a/framework/CavaDRAM/Lib/Util.v
+++ b/framework/CavaDRAM/Lib/Util.v
@@ -2,18 +2,17 @@ Set Printing Projections.
Set Warnings "-notation-overridden,-parsing".
From Coq Require Import String NArith PeanoNat Bvector ssreflect.
-Require BinaryString Vectors.Vector Coq.Arith.Compare.
-Global Open Scope string_scope.
+From Coq Require BinaryString Vectors.Vector Arith.Compare.
+From ExtLib Require Import Structures.Monad.
+From Cava Require Import Cava Lib.
-Require Import ExtLib.Structures.Monad.
-Require Import Cava.Core.Core Cava.Semantics.Simulation.
-From Cava.Lib Require Vec.
-From Cava.Lib Require Import CavaPrelude Combinators Multiplexers Decoder Adders.
-Import MonadNotation Circuit.Notations Init.Logic.EqNotations.
-Global Open Scope monad_scope.
+Import Init.Logic.EqNotations.
Section WithCava.
- Context `{semantics : Cava}.
+
+ Context {signal : SignalType -> Type}.
+ Context {semantics : Cava signal}.
+
Definition bin_constant w (s : String.string) : signal (Vec Bit w) :=
Vec.of_N (n := w) (BinaryString.Raw.to_N s 0).
@@ -131,9 +130,9 @@ Section WithCava.
{ simpl. rewrite !Nat.add_0_r; destruct h.
{ rewrite -Nat.add_succ_r. apply Nat.add_lt_le_mono.
{ exact IHbv. }
- { apply Lt.lt_le_S;exact IHbv. }
+ { apply Nat.le_succ_l;exact IHbv. }
}
- { apply Plus.plus_lt_compat; exact IHbv. }
+ { apply Nat.add_lt_mono; exact IHbv. }
}
Qed.
@@ -142,13 +141,4 @@ Section WithCava.
exact (Fin.of_nat_lt H).
Defined.
-End WithCava.
-
-(* get rid of the reverse *)
-(* Section Properties.
-
- Context `{semantics : Cava}.
-
- Print Instances Cava.
- Lemma test (n : nat) (t : cava (signal (Vec Bit n))):
- indexConst (decode one t) n = zero. *)
+End WithCava.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Lib/backup.v b/framework/CavaDRAM/Lib/backup.v
deleted file mode 100644
index afe832f..0000000
--- a/framework/CavaDRAM/Lib/backup.v
+++ /dev/null
@@ -1,1256 +0,0 @@
-Set Printing Projections.
-Set Warnings "-notation-overridden,-parsing".
-
-From CavaDRAM Require Import CavaFIFOREF CavaSM CavaReqQueue CavaCommonInstances CavaSubtractor Step CavaSystem Memory Util UtilSM.
-From CoqDRAM Require Import FIFO.
-From Coq Require Import Program BinaryString HexString NArith.
-From Cava Require Import Cava CavaProperties Util.Vector Util.Tactics.
-From mathcomp Require Import fintype ssrZ zify ring.
-
-Section CavaFIFOREFProperties.
- (* From Cava *)
- Existing Instance CombinationalSemantics.
- (* From CavaDRAM*)
- Context {CAVA_SYS : CavaSystem}.
- (* From CoqDRAM *)
- Existing Instance REQESTOR_CFG.
- Context {SYS_CFG : System_configuration}.
- Context {FIFO_CFG : FIFO_configuration}.
- Context {HAF : HW_Arrival_function_t}.
- Existing Instance ARBITER_CFG.
- Existing Instance FIFO_implementation.
-
- Import Memory.Properties BvectorNotations.
- Open Scope Bvector_scope.
-
- Lemma leq_Nle (a b : N) :
- leq (nat_of_bin a) (nat_of_bin b) -> (a <= b)%N.
- Proof.
- lia.
- Qed.
-
- Lemma ltn_Ntn (a b : N) :
- leq (S (nat_of_bin a)) (nat_of_bin b) -> (a < b)%N.
- Proof.
- lia.
- Qed.
-
- Lemma Bv2N_upper_bound {n : nat} (bv : Bvector n) :
- (N.to_nat (Bv2N bv) < (Nat.pow 2 n)).
- Proof.
- induction bv; [ by simpl | ]; destruct h; rewrite Bv2N_cons.
- { rewrite N.succ_double_spec.
- set z := Bv2N _; fold z in IHbv.
- rewrite N2Nat.inj_add N2Nat.inj_mul.
- vm_compute (N.to_nat 1); vm_compute (N.to_nat 2).
- assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
- assert ((2 * N.to_nat z + 1)%coq_nat = (2 * N.to_nat z + 1)%nat); try done; rewrite H; clear H.
- apply ltn_mul_add1 in IHbv.
- rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ].
- assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H. }
- { rewrite N.double_spec N2Nat.inj_mul; set z := Bv2N _; fold z in IHbv; vm_compute (N.to_nat 2).
- assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
- have aux : (0 < 2); [ done | ].
- have H := (ltn_pmul2l aux); rewrite -H in IHbv.
- rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ]; clear H.
- assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H.
- }
- Qed.
-
- Lemma N2Bv_sized_queuemax_neq0 :
- N2Bv_sized ADDR_WIDTH 0 <> N2Bv_sized ADDR_WIDTH (N.of_nat QUEUE_MAX_SIZE - 1).
- Proof.
- apply N2Bv_sized_neq_iff; unfold ADDR_WIDTH.
- { rewrite /N.size_nat /Nat.log2 //=. }
- { rewrite -N.pred_sub -Nat2N.inj_pred.
- apply /leP; apply N.size_nat_le_nat.
- rewrite QUEUE_MAX_SIZE_PW2; apply /leP.
- rewrite ltn_predL; apply /leP.
- exact QUEUE_MAX_SIZE_GT_0. }
- { rewrite -N.pred_sub -Nat2N.inj_pred.
- specialize QUEUE_MAX_SIZE_DIFF_0 as HH.
- move: HH => /N.eqb_spec HH.
- by apply /N.eqb_spec.
- }
- Qed.
-
- Definition mem_cells_ :=
- mem_cells (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem.
-
- (* Check VectorDef.nth. *)
- Lemma nth_cells_read {T W I} (ad : Bvector W) c_req
- (c : circuit_state (mem_cells T W (2 ^ W) I)) :
- VectorDef.nth (Cells_read true (N.to_nat (Bv2N ad)) c_req c) (Bv2Fin ad) = c_req.
- Proof.
- (* Induction had to be on N *)
- induction W.
- { simpl in c; destruct_products; simpl.
- apply Vector.case0 with (v := ad); rewrite //=. }
- { specialize (Vector.eta ad) as HH; rewrite HH //=.
- simpl in c.
- destruct (Vector.hd ad).
- { specialize (IHW (Vector.tl ad)).
- rewrite /Bv2Fin //=.
- set Hc := Nat.add _ _.
- dependent destruction Hc; admit.
- }
- }
- Admitted.
-
- Lemma memcell_nch (c: circuit_state mem_cells_) wra rda c_req:
- wra <> rda ->
- (Cells_data c)[@(Bv2Fin rda)] = (Cells_read true (N.to_nat (Bv2N wra)) c_req c)[@(Bv2Fin rda)].
- Proof.
- intros Hdiff.
- unfold mem_cells_ in c.
- set Hc := 2 ^ ADDR_WIDTH; dependent induction Hc.
- { apply Logic.eq_sym in x; simpl in x.
- admit. (* can't happen *)
- }
- specialize (IHHc HAF0 FIFO_CFG0 CAVA_SYS c wra rda c_req).
- apply Logic.eq_sym in x.
- Admitted.
-
- Lemma to_nat_lt_of_nat (a : N) (n : nat) :
- N.to_nat a < n -> (a < N.of_nat n)%N.
- Proof.
- intros.
- induction n; [ discriminate | ].
- rewrite leq_eqVlt in H; move: H => /orP [/eqP H | H].
- { rewrite -H Nat2N.inj_succ N2Nat.id; by specialize (N.lt_succ_diag_r a). }
- assert (N.to_nat a < n).
- { specialize (ltn_add2r 1 (N.to_nat a) n) as S; rewrite !addn1 in S; by rewrite S in H. }
- apply IHn in H0.
- apply N.lt_trans with (m := N.of_nat n); [ done | ].
- rewrite Nat2N.inj_succ; by specialize (N.lt_succ_diag_r (N.of_nat n)).
- Qed.
-
- Lemma to_nat_lt_pow a b:
- N.to_nat a < Nat.pow 2 b -> (a < 2 ^ N.of_nat b)%N.
- Proof.
- intros; apply to_nat_lt_of_nat in H.
- rewrite -Nat2N.inj_pow in H.
- by simpl (N.of_nat 2) in H.
- Qed.
-
- Lemma size_nat_sub_leq {n} (a b : Bvector n):
- (Bv2N b <= Bv2N a)%N ->
- N.size_nat (Bv2N a - Bv2N b) <= n.
- Proof.
- intros; apply /leP; apply N.size_nat_le.
- specialize (@Bv2N_upper_bound n a) as Ha.
- specialize (@Bv2N_upper_bound n b) as Hb.
- destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try discriminate.
- { simpl in *; by apply to_nat_lt_pow. }
- { rewrite N.sub_0_r; by apply to_nat_lt_pow in Ha. }
- { by contradict H. }
- { apply to_nat_lt_pow in Ha,Hb.
- apply (N.lt_trans (N.pos p0 - N.pos p) (N.pos p0) (2 ^ N.of_nat n)%N); [ | done].
- apply N.sub_lt; done.
- }
- Qed.
-
- (* Need a to be bigger than b *)
- Lemma size_nat_qms_sub (a b: Bvector ADDR_WIDTH) :
- (Bv2N b < Bv2N a)%N ->
- N.size_nat (N.of_nat QUEUE_MAX_SIZE - (Bv2N a - Bv2N b)) <= ADDR_WIDTH.
- Proof.
- intros Hlt; apply /leP.
- destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try done;
- apply N.size_nat_le; unfold ADDR_WIDTH; rewrite QUEUE_MAX_SIZE_PW2_N; try rewrite N.sub_0_r.
- { apply N.sub_lt; [ | done].
- unfold ADDR_WIDTH in a,b.
- specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
- rewrite QUEUE_MAX_SIZE_PW2 in Ha.
- rewrite Ha0 in Ha.
- apply to_nat_lt_of_nat in Ha.
- apply N.le_lteq; left; exact Ha.
- }
- { apply N.sub_lt; [ | apply N.lt_add_lt_sub_l; by rewrite N.add_0_r ].
- unfold ADDR_WIDTH in a,b.
- specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
- rewrite QUEUE_MAX_SIZE_PW2 in Ha.
- specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) b) as Hb.
- rewrite QUEUE_MAX_SIZE_PW2 in Hb.
- apply to_nat_lt_of_nat in Ha,Hb; rewrite Ha0 in Ha; rewrite Hb0 in Hb.
- apply N.le_sub_le_add_l; rewrite N.add_comm.
- apply N.lt_trans with (m := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (n := N.pos p0)
- (p := N.add (N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (N.pos p)) in Ha as H;
- [ apply N.le_lteq; by left | ].
- apply N.lt_add_pos_r; done.
- }
- Qed.
-
- Lemma size_nat_qms :
- N.size_nat (N.of_nat QUEUE_MAX_SIZE - 1) <= Nat.log2 QUEUE_MAX_SIZE.
- Proof.
- rewrite N.sub_1_r -Nat2N.inj_pred.
- apply /leP; apply N.size_nat_le_nat.
- rewrite QUEUE_MAX_SIZE_PW2.
- apply /ltP; rewrite ltn_predL; apply /ltP.
- exact QUEUE_MAX_SIZE_GT_0.
- Qed.
-
- Lemma N2Bv_sized_eq_p1_false {W} (v : Bvector W):
- W > 0 -> (N2Bv_sized W (Bv2N v + 1) =? v) = false.
- Proof.
- intros; apply BVEq_iff_neq.
- rewrite N.add_1_r.
- specialize (N2Bv_sized_Bv2N W v) as H0; rewrite -{2}H0.
- by apply N2Bv_sized_neq_succ.
- Qed.
-
- Definition State_t := circuit_state FIFOSM.
-
- Definition get_mem (s : State_t) : circuit_state memqueue' :=
- let '(_,(_,(_,(_,_,_,memqueue_state,_,_,_,_,_),_),_,_)) := s in memqueue_state.
-
- Definition get_pop (s : State_t) :=
- let '(_,(_,_,_,pop)) := s in pop.
-
- Definition get_st (s : State_t) :=
- let '(_,(_,_,(_,(_,_,st)),_)) := s in st.
-
- Definition get_cnt (s : State_t) :=
- let '(_,(_,_,(_,(_,(_,_,cnt),_)),_)) := s in cnt.
-
- Definition get_cref (s : State_t) :=
- let '(_,(_,_,(_,(_,(_,(_,_,_,_,_,_,_,cref),_),_)),_)) := s in cref.
-
- Definition get_cr (s : State_t) :=
- let '(_,(_,_,(_,(_,(_,(_,(_,(_,cr)),_,_,_,_,_,_),_),_)),_)) := s in cr.
-
- Definition get_wra (s : State_t) :=
- let '(_,(_,(_,_,wra),_,_)) := s in wra.
-
- Definition get_rda (s : State_t) :=
- let '(_,(_,(_,(_,_,_,_,_,_,_,_,rda),_),_,_)) := s in rda.
-
- Definition get_reqqueue (s : State_t) : circuit_state RequestQueue' :=
- let '(_,(cs_requeue,_,_)) := s in cs_requeue.
-
- Definition get_mem_RequestQueue (c : circuit_state RequestQueue') :=
- let '(_,(_,(_,_, _,memqueue_state,_,_,_,_,_),_)) := c in memqueue_state.
-
- Definition get_addr_RequestQueue (c : circuit_state RequestQueue') :=
- let '(_,(_,(_,_, _,_,_,_,_,_,rda),wra)) := c in (wra,rda).
-
- Definition get_memcells (s : circuit_state memqueue') :=
- let '(_,memcells_state,_) := s in memcells_state.
-
- Definition get_memcells_RequestQueue (c : circuit_state RequestQueue') :=
- get_memcells (get_mem_RequestQueue c).
-
- (* --------------------------Bounding the counter ------------------- *)
- Lemma cnt_bounded (cnt : Bvector COUNTER_WIDTH) :
- N.to_nat (Bv2N cnt) < WAIT.
- Proof.
- specialize @Bv2N_upper_bound with (bv := cnt) as H.
- by rewrite /COUNTER_WIDTH WAIT_PW_2 in H.
- Qed.
-
- Definition Bv2cnt (cnt : Bvector COUNTER_WIDTH) : Counter_t :=
- Ordinal (cnt_bounded cnt).
-
- Definition cnt2Bv (cnt : Counter_t) :=
- N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
- (* ------------------------------------------------------------------ *)
-
- (* --------------------------Bounding cref counter ------------------- *)
- Lemma cref_bounded (cref : Bvector COUNTER_REF_WIDTH) :
- N.to_nat (Bv2N cref) < WAIT_REF.
- Proof.
- specialize @Bv2N_upper_bound with (bv := cref) as H.
- by rewrite /COUNTER_REF_WIDTH WAIT_REF_PW2 in H.
- Qed.
-
- Definition Bv2cref (cnt : Bvector COUNTER_REF_WIDTH) : Counter_ref_t :=
- Ordinal (cref_bounded cnt).
-
- Definition cref2Bv (cref : Counter_ref_t) :=
- N2Bv_sized COUNTER_REF_WIDTH (N.of_nat (nat_of_ord cref)).
- (* ------------------------------------------------------------------ *)
-
- Lemma cref_preadate_false (c : Counter_ref_t) :
- (cref2Bv c =? CNT_REF_PREA) = false ->
- (nat_of_ord c == PREA_date - 1) = false.
- Proof.
- unfold cref2Bv, CNT_REF_PREA; intros.
- apply BVEq_iff_neq in H; rewrite bitvec_literal_correct in H.
- apply N2Bv_sized_neq_if in H.
- apply of_nat_neq in H.
- by apply /eqP.
- Qed.
-
- Lemma cref_preadate_true (c : Counter_ref_t) :
- (cref2Bv c =? CNT_REF_PREA) = true ->
- (nat_of_ord c == PREA_date - 1) = true.
- Proof.
- unfold cref2Bv, CNT_REF_PREA; intros.
- apply BVEq_iff_eq in H; rewrite bitvec_literal_correct in H.
- apply N2Bv_sized_eq_iff in H.
- { apply Nat2N.inj in H; rewrite H; by apply /eqP. }
- { apply N.size_nat_le_nat.
- destruct c; simpl in *; rewrite /COUNTER_REF_WIDTH; apply /ltP.
- by rewrite WAIT_REF_PW2. }
- { apply N.size_nat_le_nat; unfold COUNTER_REF_WIDTH.
- rewrite WAIT_REF_PW2 subn1; apply /ltP.
- specialize WAIT_REF_PREA_date as HH.
- apply ltn_trans with (m := PREA_date.-1) in HH; [ exact HH | ].
- by rewrite ltn_predL PREA_date_pos.
- }
- Qed.
-
- Definition fullQueue (wa ra : Bvector ADDR_WIDTH) : bool :=
- let waN := Bv2N wa in
- let raN := Bv2N ra in
- let qms := N.sub (N.of_nat QUEUE_MAX_SIZE) 1 in
- if (raN <= waN)%nat then ((Bv2N wa - Bv2N ra)%N == qms)
- else (((N.add qms 1) - (raN - waN))%N == qms).
-
- Hypothesis HaltIfFull : forall t c,
- let wra := get_wra c in
- let rda := get_rda c in
- if (HW_Arrival_at t != []) then ~~ fullQueue wra rda else true.
-
- Program Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
- Admitted.
-
- Lemma EqReqNil : EqReq nullreq REQUEST_NIL = true.
- Admitted.
-
- (* Change FIFO implememtation: set of requests of max size 1,
- so it could either have a request or a non arriving request,
- that way, eveyr request in P is a valid request
- would have to change lots of things here:
- - HaltIfFull
- - EqQueue
- - EqMem
- *)
-
- (* Manually force push to be false *)
-
- (* Definition EqArrival r r' push c : bool :=
- let wra := get_wra c in
- let rda := get_rda c in
- if r == nullreq
- (* If the arriving request is nullreq, either the fifo is full or there are no arriving requests *)
- then (r' =? REQUEST_NIL) && (push == false)
- (* If a request did arrive indeed than the fifo is not full *)
- else (EqReq r r') && (push == true) && (~~ fullQueue wra rda). *)
-
- Definition EqCmd (f_cmd : Command_kind_t) (c_cmd : Bvector DRAM_CMD_WIDTH) : bool :=
- match f_cmd with
- | ACT => (c_cmd =? ACT_VEC)
- | PRE => (c_cmd =? PRE_VEC)
- | PREA => (c_cmd =? PREA_VEC)
- | CRD => (c_cmd =? RD_VEC)
- | CWR => (c_cmd =? WR_VEC)
- | REF => (c_cmd =? REF_VEC)
- | NOP => (c_cmd =? NOP_VEC)
- end.
-
- Fixpoint EqQueue (P : Requests_t) (wra rda : Bvector ADDR_WIDTH) :=
- match P with
- | [::] => (wra =? rda)
- | x :: x0 =>
- if (x0 == []) then
- (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? wra)
- else
- negb (wra =? rda) && (EqQueue x0 wra (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1)))
- end.
-
-
- if (x == nullreq) then (EqQueue x0 wra rda)
- else (if (x0 == []) then
- (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? wra) (* only one non-null addres in the queue *)
- else
- negb (wra =? rda) && (EqQueue x0 wra (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1)))
- )
- end.
-
- Fixpoint EqMem_ {W} (P : Requests_t) (rda : Bvector W)
- (memcells_vec : Vector.t (Bvector REQUEST_WIDTH) (Nat.pow 2 W)) : bool :=
- match P with
- | [::] => true
- | x :: x0 => let nrda := N2Bv_sized W (Bv2N rda + 1) in
- if (x == nullreq) then
- (EqMem_ x0 rda memcells_vec)
- else
- (EqReq x memcells_vec[@(Bv2Fin rda)]) && (EqMem_ x0 nrda memcells_vec)
- end.
-
- Lemma EqMem_rcons r1 (rda wra : Bvector ADDR_WIDTH) c R (c_req : combType (Vec Bit REQUEST_WIDTH)) :
- EqQueue r1 wra rda -> r1 != [::] ->
- EqMem_ r1 rda (@Cells_data (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem c) ->
- EqReq R c_req ->
- EqMem_ (r1 ++ [R])%SEQ rda (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
- Proof.
- intros HQ Hnot_nil Mem EqR; fold mem_cells_ in c; rewrite cats1.
- revert Mem HQ Hnot_nil; generalize wra rda; induction r1; try discriminate; intros.
- simpl in Mem,HQ; simpl; destruct (a == _) eqn:Hanull.
- { destruct r1 eqn:Hr1; simpl in Mem,HQ.
- { clear IHr1 Mem.
- simpl; destruct (R == _); [trivial | rewrite andb_true_r].
- apply BVEq_iff_eq in HQ; rewrite -HQ.
- by rewrite (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem wra0 c_req c).
- }
- { apply IHr1 with (wra := wra0) (rda := rda0) in HQ; done. }
- }
- move: Mem => /andP [EqR_ Mem]; apply /andP; split.
- { destruct r1 eqn:hr1; simpl in HQ,Mem; simpl.
- { destruct (wra0 =? rda0) eqn:Heq.
- { apply BVEq_iff_eq in Heq; rewrite Heq in HQ.
- specialize ADDR_WIDTH_pos as H0; move: H0 => /ltP H0.
- apply N2Bv_sized_eq_p1_false with (v := rda0) in H0; by rewrite H0 in HQ.
- }
- { apply BVEq_iff_neq in Heq.
- rewrite -memcell_nch; done. }}
- { move: HQ => /andP [neq HQ].
- destruct (r == _),l.
- all: move: neq => /negPf neq; apply BVEq_iff_neq in neq; rewrite -memcell_nch; done. }}
- { destruct r1 eqn:hr1; simpl in HQ,Mem; simpl.
- { destruct (R == _); [trivial | rewrite andb_true_r].
- apply BVEq_iff_eq in HQ; rewrite HQ.
- by rewrite (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem wra0 c_req c).
- }
- { move: HQ => /andP [neq HQ].
- specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1; try done. }
- }
- Qed.
-
- (* Just use the circuit directly <-> circuit does the work directly *)
- Definition EqMem (P : Requests_t) rda (mem : circuit_state RequestQueue') :=
- let memcells_vec := Cells_data (get_memcells_RequestQueue mem) in
- EqMem_ P rda memcells_vec.
-
- Definition State_Eq (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
- let s := get_st cava_state in
- let c' := get_cnt cava_state in
- let cref' := get_cref cava_state in
- let r' := get_cr cava_state in
- let RQ := get_reqqueue cava_state in
- let wra := fst (get_addr_RequestQueue RQ) in
- let rda := snd (get_addr_RequestQueue RQ) in
- let pop := get_pop cava_state in
- match fram_state with
- | IDLE c cref P =>
- (s =? STATE_IDLE_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
- (EqQueue P wra rda) && (pop == false)
- | RUNNING c cref P r =>
- (s =? STATE_RUN_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
- (EqQueue P wra rda) && (EqReq r r') && (pop == (c == OCycle0))
- | REFRESHING cref P =>
- (s =? STATE_REF_VEC) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
- (EqQueue P wra rda) && (pop == false)
- end.
-
- (* -------------- Proofs about CmdGen ------------------------------- *)
- Lemma CmdGen_equiv_idle_to_idle (c : circuit_state CmdGen) cnt cref:
- (cref =? CNT_REF_PREA) = false ->
- exists c', step CmdGen c (STATE_IDLE_VEC,true,cnt,cref,REQUEST_NIL) =
- (c',NOP_VEC).
- Proof.
- intros H; simpl in c; destruct_products.
- eapply ex_intro.
- cbv [CmdGen]; cbn [step fst snd].
- simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; simpl.
- cbv [CrefPREA_eq].
- apply BVEq_iff_neq in H.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply HH in H; rewrite H VectorSpec.map_id; reflexivity.
- Qed.
-
- Lemma CrefPREA_lt_CNT_REF_PREA:
- CrefPREA_lt CNT_REF_PREA = false.
- Proof.
- cbv [CrefPREA_lt]; simpl_ident.
- unfold greaterThanOrEqual; simpl_ident; unfold greaterThanOrEqualBool.
- apply /negbF.
- rewrite {1}/CNT_REF_PREA; rewrite !bitvec_literal_correct.
- apply /N.leb_spec0; rewrite /CNT_REF_PREA /CNT_REF_WAIT !bitvec_literal_correct.
- rewrite !Bv2N_N2Bv_sized. { apply N.le_add_r. }
- all: rewrite /COUNTER_REF_WIDTH WAIT_REF_PW_N.
- all: try apply N_lt_inj.
- all: specialize WAIT_REF_PREA_date_WAIT as H; lia.
- Qed.
-
- Lemma CmdGen_equiv_idle_to_ref (c : circuit_state CmdGen) cnt cref e:
- (cref =? CNT_REF_PREA) = true ->
- exists c', step CmdGen c (STATE_IDLE_VEC,e,cnt,cref,REQUEST_NIL) = (c',PREA_VEC).
- Proof.
- intros; simpl in c; destruct_products; eapply ex_intro.
- cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; simpl; rewrite VectorSpec.map_id.
- apply BVEq_iff_eq in H; subst cref; rewrite CrefPREA_lt_CNT_REF_PREA !VectorSpec.map_id.
- rewrite andb_false_r; rewrite /CrefPREA_eq.
- specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- assert (CNT_REF_PREA = CNT_REF_PREA); [done | ]; apply HH in H; by rewrite H.
- Qed.
- (* ------------------------------------------------------------------ *)
-
- (* -------------- Proofs about NextCR ------------------------------- *)
- Lemma NextCR_equiv (c : circuit_state NextCR) cnt cref tr:
- exists c', step NextCR c (STATE_IDLE_VEC,true,cnt,cref,tr) =
- (c',REQUEST_NIL).
- Proof.
- simpl in c; destruct_products.
- eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd].
- simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- fast_simpl_bool; by simpl.
- Qed.
-
- Lemma NextCR_equiv_IDLE_NE_PREA c cnt cref tr:
- (cref =? CNT_REF_PREA) = true ->
- exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref,tr) =
- (c',REQUEST_NIL).
- Proof.
- intros; simpl in c; destruct_products; eapply ex_intro.
- cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
- apply BVEq_iff_eq in H; subst cref.
- by rewrite CrefPREA_lt_CNT_REF_PREA.
- Qed.
- (* ------------------------------------------------------------------ *)
-
- Create HintDb update.
- Lemma Sidle_true :
- Sidle STATE_IDLE_VEC = true.
- Proof.
- apply CavaPreludeProperties.eqb_refl.
- Qed.
- Hint Rewrite @Sidle_true : update.
-
- Lemma Sref_idle_false :
- Sref STATE_IDLE_VEC = false.
- Proof.
- by apply CavaPreludeProperties.eqb_neq.
- Qed.
- Hint Rewrite @Sref_idle_false : update.
-
- Lemma cnt_equiv (cnt : Bvector COUNTER_WIDTH) :
- (if CeqWAIT cnt then Bvect_false COUNTER_WIDTH
- else N2Bv_sized COUNTER_WIDTH (Bv2N cnt + 1)) = cnt2Bv (Next_cycle (Bv2cnt cnt)).
- Proof.
- cbv [CeqWAIT].
- destruct (CavaPrelude.eqb (cnt, CNT_WAIT)) eqn:Heq; rewrite Heq.
- { specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit COUNTER_WIDTH) (x := cnt) as H.
- apply H in Heq; clear H.
- unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { rewrite /CNT_WAIT bitvec_literal_correct in Heq.
- rewrite Heq /Bv2cnt //= Bv2N_N2Bv_sized in x.
- 2: {
- rewrite /COUNTER_WIDTH; have id := (N2Nat.id 2).
- rewrite -id Nat2N.inj_pow //= /Pos.to_nat //= WAIT_PW_2.
- apply: N_lt_inj; apply /ltP; by rewrite subn1 ltn_predL WAIT_pos.
- }
- rewrite Nat2N.id subn1 prednK in x; [ | exact WAIT_pos ]; by rewrite ltnn in x.
- }
- { unfold cnt2Bv,OCycle0; by simpl. }}
- { unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { unfold cnt2Bv; apply f_equal; simpl.
- rewrite N.add_1_r -(N.succ_pos_pred (Pos.of_succ_nat (N.to_nat (Bv2N cnt)))).
- apply f_equal; by rewrite predN_of_succ_nat. }
- { apply ltn_gt in e,x.
- rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
- { have HH := (@eqb_iff_neq (Vec Bit (@COUNTER_WIDTH SYS_CFG FIFO_CFG))).
- apply HH in Heq. rewrite /CNT_WAIT bitvec_literal_correct in Heq;
- rewrite -(N2Bv_sized_Bv2N (@COUNTER_WIDTH SYS_CFG FIFO_CFG) cnt) in Heq.
- apply N2Bv_sized_neq_if in Heq.
- by rewrite e subn1 -pred_Sn N2Nat.id in Heq. }
- { specialize ltn_ord with (n := @WAIT SYS_CFG FIFO_CFG) (i := Ordinal (cnt_bounded cnt)) as H.
- rewrite //= in H.
- contradict H; apply /negP; by rewrite -ltnNge.
- }
- }
- }
- Qed.
-
- Lemma cref_equiv (cref : Bvector COUNTER_REF_WIDTH) :
- (if CrefPREA_eq cref then Bvect_false COUNTER_REF_WIDTH
- else N2Bv_sized COUNTER_REF_WIDTH (Bv2N cref + 1)) = cref2Bv (Next_cycle_ref (Bv2cref cref)).
- Admitted.
- (* Proof.
- cbv [CrefPREA_eq].
- destruct (CavaPrelude.eqb (cref, CNT_REF_PREA)) eqn:Hcref; rewrite Hcref.
- { specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit COUNTER_REF_WIDTH) (x := cref) as H.
- apply H in Hcref; clear H.
- unfold Next_cycle_ref; set (Hc := (Bv2cref cref).+1 < WAIT_REF); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { rewrite /CNT_REF_PREA bitvec_literal_correct in Hcref.
- rewrite Hcref /Bv2cref //= Bv2N_N2Bv_sized in x.
- 2: {
- rewrite /COUNTER_REF_WIDTH; have id := (N2Nat.id 2).
- rewrite WAIT_REF_PW_N.
- (* rewrite -id Nat2N.inj_pow //=. *)
- (* rewrite /Pos.to_nat //=. WAIT_REF_PW_N. *)
- apply: N_lt_inj; apply /ltP.
- rewrite subn1.
- specialize WAIT_REF_PREA_date as H.
- apply ltn_trans with (n := PREA_date); [ | exact WAIT_REF_PREA_date].
- by rewrite ltn_predL PREA_date_pos.
- }
- rewrite Nat2N.id subn1 prednK in x; [ | exact PREA_date_pos ]; by rewrite ltnn in x.
- }
- { unfold cref2Bv,OCycle0; by simpl. }}
- { unfold Next_cycle_ref; set (Hc := (Bv2cref cref).+1 < PREA_date); dependent destruction Hc;
- apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
- { unfold cref2Bv; apply f_equal; simpl.
- rewrite N.add_1_r -(N.succ_pos_pred (Pos.of_succ_nat (N.to_nat (Bv2N cref)))).
- f_equal; by rewrite predN_of_succ_nat. }
- { apply ltn_gt in e,x.
- rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
- { have HH := (@eqb_iff_neq (Vec Bit (@COUNTER_REF_WIDTH SYS_CFG))).
- apply HH in Hcref. rewrite /CNT_REF_PREA bitvec_literal_correct in Hcref;
- rewrite -(N2Bv_sized_Bv2N (@COUNTER_REF_WIDTH SYS_CFG) cref) in Hcref.
- apply N2Bv_sized_neq_if in Hcref.
- by rewrite e subn1 -pred_Sn N2Nat.id in Hcref. }
- { specialize ltn_ord with (n := PREA_date) (i := Ordinal (cref_bounded cref)) as H.
- rewrite //= in H.
- contradict H; apply /negP; by rewrite -ltnNge.
- }
- }
- }
- Qed. *)
-
- (* -------------- Proofs about Update ------------------------------- *)
- (* Don't try to match it with the next_cycle_ref, but rather something else *)
- Lemma Update_equiv_idle_idle (c : circuit_state Update) cnt cref :
- (cref =? CNT_REF_PREA) = false ->
- let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
- let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N cref + 1) in
- snd (step Update c (STATE_IDLE_VEC,true,cnt,cref)) =
- (STATE_IDLE_VEC,false,nc,ncref).
- Proof.
- intros Hcref Hcnt; simpl in c.
- cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
- cbv [Update Update_s Update_e Update_c Update_cref].
- cbn [step fst snd]; simpl_ident.
- autorewrite with update; vm_compute (false && _).
- apply BVEq_iff_neq in Hcref.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply pair_equal_spec; split.
- 2: {
- rewrite orb_false_l andb_true_l.
- rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
- }
- cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
- vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id andb_false_r.
- apply pair_equal_spec; split; [
- apply pair_equal_spec; split; [ by unfold STATE_IDLE_VEC | reflexivity] | ].
- vm_compute (orb false false); rewrite orb_false_r; by specialize (cnt_equiv cnt).
- Qed.
-
- Lemma Update_equiv_idle_ref (c : circuit_state Update) cnt cref e:
- (cref =? CNT_REF_PREA) = true ->
- let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
- let ncref := CNT_REF_NIL in
- exists c', (step Update c (STATE_IDLE_VEC,e,cnt,cref)) =
- (c',(STATE_REF_VEC,false,nc,ncref)).
- Proof.
- intros Hcref Hcnt; simpl in c; eapply ex_intro.
- cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
- cbv [Update Update_s Update_e Update_c Update_cref].
- cbn [step fst snd]; simpl_ident.
- apply pair_equal_spec; split; [reflexivity | ].
- autorewrite with update; vm_compute (false && _).
- apply BVEq_iff_eq in Hcref.
- specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
- apply pair_equal_spec; split.
- 2: {
- rewrite orb_false_l andb_true_l.
- rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
- }
- cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
- vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id.
- apply pair_equal_spec; split.
- 2: {
- vm_compute (orb false false); rewrite orb_false_r.
- destruct e; [rewrite negb_true | rewrite negb_false].
- { rewrite andb_false_r orb_false_r; by specialize (cnt_equiv cnt). }
- { rewrite andb_true_r.
- destruct (CrefPREA_lt cref) eqn:Hbug.
- { by rewrite Hcref CrefPREA_lt_CNT_REF_PREA in Hbug. }
- { rewrite orb_false_r; by specialize (cnt_equiv cnt). }
- }
- }
- apply pair_equal_spec; split; [ done | ].
- rewrite Hcref CrefPREA_lt_CNT_REF_PREA; by rewrite andb_false_l.
- Qed.
- (* ------------------------------------------------------------------ *)
-
- (* -------------- Proofs about FullEmptyLogic ------------------------------- *)
- Lemma FEL_emp_equiv (c : circuit_state FullEmptyLogic) wra rda :
- wra = rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,true)).
- Proof.
- intros H; eapply ex_intro.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
- cbn [step]; simpl_ret; cbn [fst snd].
- apply pair_equal_spec; split; [ reflexivity | ].
- apply pair_equal_spec; split; [ | by rewrite H CavaPreludeProperties.eqb_refl ].
- rewrite inv_correct; cbv [bind].
- rewrite fullAdder_cin; cbv [unpackV]; simpl_ret.
- destruct (one) eqn:Hone; [ | discriminate].
- destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
- [ | by rewrite H leqnn in Hleq ].
- assert (N.sub (Bv2N wra) (Bv2N rda) = 0%N); [ by rewrite H N.sub_diag | ].
- rewrite H0 !bitvec_literal_correct.
- set (N := N.sub _ _).
- specialize N2Bv_sized_queuemax_neq0 as H2.
- specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@ADDR_WIDTH CAVA_SYS))
- (x := N2Bv_sized ADDR_WIDTH 0) (y := N2Bv_sized ADDR_WIDTH N) as HH.
- by apply HH in H2.
- Qed.
-
- Lemma FEL_nemp_wrap1_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
- let wrap1 := N2Bv_sized ADDR_WIDTH (Bv2N wra + 1) in
- wra = rda -> exists c' f', step FullEmptyLogic c (wrap1,rda) = (c',(f',false)).
- Proof.
- intros; repeat eapply ex_intro; unfold wrap1.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
- cbn [step]; simpl_ret; cbn [fst snd].
- apply pair_equal_spec; split; [ reflexivity | ].
- apply pair_equal_spec; split; [ reflexivity | ].
- apply CavaPreludeProperties.eqb_neq; rewrite H.
- apply N2Bv_sized_plusone_diff; unfold ADDR_WIDTH.
- specialize QUEUE_MAX_SIZE_GT_1 as HQ; apply Nat.log2_pos in HQ.
- by move: HQ => /ltP HQ.
- Qed.
-
- Lemma FEL_nemp_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
- ~~ (fullQueue wra rda) ->
- wra <> rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,false)).
- Proof.
- intros NF H; eapply ex_intro.
- rewrite /fullQueue in NF.
- cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
- cbn [step]; simpl_ret; cbn [fst snd].
- apply pair_equal_spec; split; [ reflexivity | ].
- apply pair_equal_spec; split; [ | by apply CavaPreludeProperties.eqb_neq ].
- rewrite bitvec_literal_correct.
- rewrite fullAdder_cin; destruct (one) eqn:Hbug; try discriminate; clear Hbug.
- cbv [unpackV].
- destruct (_ <= _) eqn:Hleq; apply CavaPreludeProperties.eqb_neq.
- { set (xx := (Bv2N wra - Bv2N rda)%N); fold xx in NF.
- set (yy := ((N.of_nat QUEUE_MAX_SIZE - 1)%N)); fold yy in NF.
- assert (N.size_nat xx <= ADDR_WIDTH);
- [ apply size_nat_sub_leq; by apply leq_Nle in Hleq | ].
- assert (N.size_nat yy <= ADDR_WIDTH);
- [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
- apply N2Bv_sized_neq_iff; try done; by apply /eqP.
- }
- { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
- { assert (Bv2N rda > Bv2N wra); [ lia | ].
- apply size_nat_qms_sub; by apply ltn_Ntn in H0.
- }
- { unfold ADDR_WIDTH; by apply size_nat_qms. }
- specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH.
- rewrite HH in NF; [ | exact QUEUE_MAX_SIZE_GT_0_N].
- apply /eqP; exact NF.
- }
- Qed.
-
- Lemma FEL_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
- ~~ (fullQueue wra rda) ->
- exists c' e', step FullEmptyLogic c (wra,rda) = (c',(false,e')).
- Proof.
- intros NF; unfold fullQueue in NF; repeat eapply ex_intro.
- cbv [FullEmptyLogic]; cbn [step]; simpl_ret; cbn [fst snd].
- apply pair_equal_spec; split; [reflexivity | ].
- apply pair_equal_spec; split; [ | reflexivity ].
- cbv [dropr subtractor EqFULL FullVEC unpackV]; simpl_ident.
- destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
- destruct (one) eqn:Hone; try discriminate;
- rewrite fullAdder_cin Hleq;
- apply CavaPreludeProperties.eqb_neq; move: NF => /eqP NF.
- { set (xx := (Bv2N wra - Bv2N rda)%N); fold xx in NF.
- set (yy := ((N.of_nat QUEUE_MAX_SIZE - 1)%N)); fold yy in NF.
- assert (N.size_nat xx <= ADDR_WIDTH);
- [ apply size_nat_sub_leq; by apply leq_Nle in Hleq | ].
- assert (N.size_nat yy <= ADDR_WIDTH);
- [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
- apply N2Bv_sized_neq_iff; try done; by apply /eqP.
- }
- { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
- { assert (Bv2N rda > Bv2N wra) as H; [ lia | ].
- apply size_nat_qms_sub; by apply ltn_Ntn in H.
- }
- { unfold ADDR_WIDTH; by apply size_nat_qms. }
- specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH.
- by rewrite HH in NF; [ | exact QUEUE_MAX_SIZE_GT_0_N].
- }
- Qed.
- (* ------------------------------------------------------------------ *)
-
- Lemma incrn_pointr_true_equiv (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,true) =
- (tt,N2Bv_sized ADDR_WIDTH (Bv2N ad + 1)).
- Proof.
- cbv [incr_pointr step] ; by simpl_ident.
- Qed.
-
- Lemma incrn_pointr_false_equiv (c : circuit_state incr_pointr) ad :
- step incr_pointr c (ad,false) = (tt,ad).
- Proof.
- cbv [incr_pointr step] ; by simpl_ident.
- Qed.
-
- Create HintDb get_state.
- Hint Unfold get_memcells : get_state.
- Hint Unfold get_addr_RequestQueue : get_state.
- Hint Unfold get_mem_RequestQueue : get_state.
- Hint Unfold get_memcells_RequestQueue : get_state.
- Hint Unfold get_mem : get_state.
-
- (* the not full could come either be satisfies from the not full hypothesis
- or from wra = rda *)
- Lemma RQ_fst_pushT_popF_NF (c : circuit_state RequestQueue') c_req :
- let '(wra,rda) := get_addr_RequestQueue c in
- let S := get_memcells_RequestQueue c in
- let wra_idx := N.to_nat (Bv2N wra) in
- let memcells_spec := Cells_read true wra_idx c_req S in
- ~~ (fullQueue wra rda) -> exists c',
- ((Cells_data (get_memcells_RequestQueue c') = memcells_spec) /\
- (fst (get_addr_RequestQueue c')) = (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) /\
- (snd (get_addr_RequestQueue c')) = rda) /\
- fst (step RequestQueue' c (true,c_req,false)) = c'.
- Admitted.
- (* simpl in c; destruct_products.
- unfold get_addr_RequestQueue; intros Hfull; eapply ex_intro; split; [ | reflexivity].
- set (p := step RequestQueue' _ _).
- cbv [RequestQueue' LoopInit fork2] in p.
- cbn [step] in p; cbn [fst snd] in p; simpl_ret_H p;z cbv [fst snd] in p.
- specialize FEL_NF_equiv with (c := (u17, (u19, u20, u18), u16))
- (rda := t0) (wra := t) as H; apply H in Hfull; clear H.
- destruct Hfull as [cs_FEL' [empty_o Hfull]].
- unfold p; clear p; rewrite Hfull.
- cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
- rewrite (surjective_pairing (step memqueue' _ _)).
- rewrite incrn_pointr_true_equiv incrn_pointr_false_equiv.
- rewrite (surjective_pairing (step FullEmptyLogic _ _)).
- set (fel := step FullEmptyLogic _ _).
- split.
- { simpl in fel; unfold fel; cbv [snd fst].
- cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end.
- cbv [memqueue' Memory' mem_write mem_read]; cbn [step fst snd]; simpl_ident; cbv [fst snd].
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end.
- cbv [fst snd].
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end.
- fold mem_cells_.
- specialize @Cells_matchX with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
- (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
- (S0 := c) (we := true) (wd := c_req) (wa := (N.to_nat (Bv2N t))) as HH.
- rewrite -HH; [reflexivity | | ].
- all: admit.
- }
- split; by simpl.
- Admitted. *)
-
- (* Ignoring the full signal because it just goes to the output *)
- Lemma RQ_snd_pushT_empty (c : circuit_state RequestQueue') c_req pop :
- let '(wra,rda) := get_addr_RequestQueue c in
- let S := get_memcells_RequestQueue c in
- let rda_idx := N.to_nat (Bv2N rda) in
- let wra_idx := N.to_nat (Bv2N wra) in
- let memcells' := Cells_read true wra_idx c_req S in
- let mem_val := nth_default (req_null) rda_idx memcells' in
- wra = rda -> exists f',
- snd (step RequestQueue' c (true,c_req,pop)) = (f',mem_val,true).
- Admitted.
- (* simpl in c; destruct_products; rename t0 into rda, t into wra.
- autounfold with get_state; intros.
- cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
- eapply FEL_emp_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH.
- destruct HH as [cs_FEL HH]; rewrite HH.
- cbn [fst snd bind inv and2 or2].
- rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
- cbv [fst snd]; fast_simpl_bool.
- rewrite incrn_pointr_true_equiv if_same incrn_pointr_false_equiv; clear HH.
- eapply FEL_nemp_wrap1_equiv with (c := (u4, (u6, u7, u5), u3)) in H as HH.
- destruct HH as [cs_FELL [full_o HH]]; rewrite HH; clear HH.
- eapply ex_intro.
- apply pair_equal_spec; split; [ | reflexivity ].
- apply pair_equal_spec; split; [ reflexivity | ].
- cbv [memqueue' Memory' mem_write mem_read].
- cbn [step fst snd]; simpl_ret.
- rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)).
- specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
- (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
- (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
- rewrite -HH.
- { cbv [indexAt indexConst defaultCombValue].
- cbv [unpackV bind]; simpl_ret.
- rewrite nth_0; simpl; unfold req_null.
- reflexivity.
- }
- all: admit.
- Admitted. *)
-
- Lemma RQ_snd_pushT_popF_NF_nempty (c : circuit_state RequestQueue') c_req:
- let '(wra,rda) := get_addr_RequestQueue c in
- let S := get_memcells_RequestQueue c in
- let rda_idx := N.to_nat (Bv2N rda) in
- let wra_idx := N.to_nat (Bv2N wra) in
- let memcells' := Cells_read true wra_idx c_req S in
- let mem_val := nth_default (req_null) rda_idx memcells' in
- ~~ (fullQueue wra rda) -> wra <> rda -> exists full_o,
- snd (step RequestQueue' c (true,c_req,false)) = (full_o,mem_val,false).
- Admitted.
- (* simpl in c; destruct_products; rename t0 into rda, t into wra.
- autounfold with get_state; intros.
- cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
- apply FEL_nemp_NF_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH; [ | done].
- destruct HH as [cs_FEL HH].
- rewrite HH.
- cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
- rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
- cbv [fst snd]; fast_simpl_bool.
- rewrite incrn_pointr_true_equiv.
- rewrite incrn_pointr_false_equiv; clear HH.
- (* The second logic doesn't really matter much *)
- rewrite (surjective_pairing (step FullEmptyLogic _ _)).
- eapply ex_intro.
- apply pair_equal_spec; split; [ | reflexivity].
- apply pair_equal_spec; split; [ reflexivity | ].
- destruct_pair_let.
- cbv [memqueue' Memory' mem_write mem_read].
- cbn [step fst snd]; simpl_ret.
- rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)).
- specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
- (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
- (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
- rewrite -HH //=.
- all: admit.
- Admitted. *)
-
- (* For the queue part *)
- Lemma NF_ad_diff wra rda:
- ~~ (fullQueue wra rda) -> wra <> rda ->
- N2Bv_sized ADDR_WIDTH (Bv2N wra + 1) <> rda.
- Admitted.
-
- Theorem SM_Eq_1b (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r0 r1:
- (nat_of_ord c1 == PREA_date - 1) = true ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R != nullreq -> EqReq R c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- intros Href_prea f_state R NF EqR H; unfold FIFOSM.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- cbv [get_wra get_rda] in NFULL; rewrite NF in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
- rewrite /State_Eq in H.
- cbv [get_st get_cnt get_cref get_reqqueue get_addr_RequestQueue get_pop] in H.
- unfold EqMem in H; cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells get_cr] in H.
- (* unfold EqQueue in H; cbn [fst snd] in H. *)
- move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr] /eqP EqPop].
- cbn [fst snd] in Hadr.
- simpl in Hadr.
-
- destruct r1 eqn:Hr1; simpl in Hadr.
- destruct (r0 == nullreq) eqn:Hr0.
-
- (* apply negb_true_iff in Hadr; apply BVEq_iff_neq in Hadr. *)
- apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref pop.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (RQ_snd_pushT_popF_NF_nempty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
- rewrite H. clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- specialize (NextCR_equiv_IDLE_NE_PREA (u9, (u10, cr)) (cnt2Bv c0) (cref2Bv c1) tr) as S.
- assert ((cref2Bv c1 =? CNT_REF_PREA) = true) as Href_prea_.
- { move: Href_prea => /eqP Href_prea; apply BVEq_iff_eq.
- rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct; f_equal.
- by rewrite Href_prea.
- }
- apply S in Href_prea_ as S'; clear S; destruct S' as [cs_nextcr H].
- rewrite H.
-
- cbn [fst snd]; clear H.
- apply (CmdGen_equiv_idle_to_ref u6 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- apply (Update_equiv_idle_ref u4 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
- destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
-
- rewrite /Next_state Href_prea /State_Eq.
- specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- cbv [get_st get_cref get_reqqueue get_addr_RequestQueue get_pop].
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2: {
- rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; simpl; trivial. }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
- cbv [EqQueue Enqueue]; simpl.
- apply NF_ad_diff in NFULL; [ | done].
- apply /negPf; by apply BVEq_iff_neq.
- }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
- cbn [fst snd]; unfold EqMem, Enqueue; simpl; rewrite Hrw.
- cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
- unfold EqMem_ in Mem.
- destruct (r0 == _); fold @EqMem_ in Mem.
- {
- admit.
- }
- { assert (((size (r1 ++ [R])).+1 == 1) = false); [ admit | ].
- rewrite H0.
- destruct (size (r0 :: r1) == 1).
- { simpl.
-
- }
- move: Mem => /andP [EqR_ Mem].
- apply /andP; split.
- { admit. }
- { admit. }
- }
-
- destruct (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? wra) eqn:HH.
- { apply BVEq_iff_eq in HH; rewrite HH.
- assert ((wra =? N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) = false) as H0; [admit | ].
- rewrite H0.
- destruct (r0 == _).
- { fold @EqMem_ in Mem.
- admit. }
- { apply /andP; split.
- { admit. (* (Cells_data c)[@rda] = (Cells_read ...)[@rda] *) }
- { admit. }}}
- { assert ((N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) = false) as H0; [admit | ].
- rewrite H0.
- destruct (r0 == _); fold @EqMem_ in Mem.
- { admit. }
- { }
-
- }
- assert ((N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) = false). { admit. }
- rewrite H0.
- destruct (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? wra) eqn:HH.
- { destruct (r0 == _).
- {
-
- }
-
- }
- destruct (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? _).
- unfold EqMem_ in Mem.
- destruct (r0 == nullreq).
- 2: {
- move: Mem => /andP [EqR_ Mem].
- apply /andP; split. { (* EqR_ *) admit. }
- fold @EqMem_ in Mem.
- assert (EqMem_)
- rewrite cats1 /rcons.
- admit.
- }
- fold @EqMem_ in Mem.
- admit.
- }
- apply /andP; split.
- 2 : {
- cbv [get_cref].
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //= VectorSpec.map_id.
- destruct_pair_let.
- rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
- }
- cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
- by [].
- Admitted.
-
- Theorem SM_Eq_1a (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) :
- (nat_of_ord c1 == PREA_date - 1) = true ->
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R != nullreq -> EqReq R c_req -> State_Eq (IDLE c0 c1 []) c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- intros Href_prea f_state R NF EqR H; unfold FIFOSM.
- unfold R in NF; specialize (HaltIfFull t c_state) as NFULL.
- unfold State_t in c_state; simpl in c_state; destruct_products.
- cbv [get_wra get_rda] in NFULL; rewrite NF in NFULL.
- rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
- rewrite /State_Eq in H.
- cbv [get_st get_cnt get_cref get_reqqueue get_addr_RequestQueue get_pop] in H.
- unfold EqMem in H; cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells get_cr] in H.
- unfold EqQueue in H; cbn [fst snd] in H.
- move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr] /eqP EqPop].
- apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref pop.
- cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
-
- rewrite (surjective_pairing (step RequestQueue' _ _)).
- specialize (RQ_snd_pushT_empty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
- cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
- apply S in Hadr as H; clear S.
- destruct H as [full_o H]; rewrite H.
- clear H; cbn [fst snd].
-
- set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
- specialize NextCR_equiv with (c := (u9, (u10, cr))) (cnt := cnt2Bv c0)
- (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
- rewrite H; cbv [fst]; clear H.
-
- cbn [snd].
- assert ((cref2Bv c1 =? CNT_REF_PREA) = true) as Href_prea_.
- { move: Href_prea => /eqP Href_prea; apply BVEq_iff_eq.
- rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct; f_equal.
- by rewrite Href_prea.
- }
- apply (CmdGen_equiv_idle_to_ref u6 (cnt2Bv c0)) in Href_prea_ as H.
- destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
-
- apply (Update_equiv_idle_ref u4 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
- destruct H as [cs_update H]; rewrite H; clear H.
-
- rewrite /Next_state Href_prea /State_Eq.
- specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
- (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
- apply S in NFULL as H; clear S.
- destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
- cbv [get_st get_cref get_reqqueue get_addr_RequestQueue get_pop].
-
- apply /andP; split.
- 2 : exact EqReqNil.
- apply /andP; split.
- 2 : unfold EqCmd; by apply BVEq_iff_eq.
- apply /andP; split.
- 2: {
- rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
- repeat lazymatch goal with
- | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
- end; simpl; trivial. }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
- cbv [EqQueue Enqueue]; simpl.
- unfold R; rewrite NF.
- apply /negPf; apply BVEq_iff_neq; rewrite Hadr N.add_1_r.
- specialize N2Bv_sized_neq_succ with (n := @ADDR_WIDTH CAVA_SYS) (x := Bv2N rda) as HH.
- rewrite N2Bv_sized_Bv2N in HH; specialize ADDR_WIDTH_pos as H0; move: H0 => /ltP H0.
- by apply HH in H0. }
- apply /andP; split.
- 2 : {
- rewrite (surjective_pairing (step RequestQueue' _ _)) H Hrda'.
- unfold EqMem, Enqueue; simpl; rewrite andb_true_r.
- destruct (R == _) eqn:HH; [ trivial | ].
- rewrite Hrw; cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
- specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req c) as H'.
- rewrite Hadr H'; exact EqR.
- }
- apply /andP; split.
- 2 : {
- cbv [get_cref].
- rewrite (surjective_pairing (step RequestQueue' _ _)) H //= VectorSpec.map_id.
- destruct_pair_let.
- rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
- }
- cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
- by [].
- Qed.
-
- (* Have to add the full case *)
- (* REF bounded with PREA_date or arbitrary parameter *)
- (* if REF is bounded with PREA_date, a problem with cref + WAIT *)
- (* try bound with random parameter, but will not be correspondent to Next_cycle *)
- Theorem SM_Eq_NFULL (t : nat) (c_state : State_t) (f_req: Request_t)
- (c_req : Bvector REQUEST_WIDTH) (push : bool) :
- let f_state := (HW_Default_arbitrate t).(Implementation_State) in
- let R := HW_Arrival_at t in
- R != nullreq -> EqReq R c_req -> State_Eq f_state c_state ->
- let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R f_state in
- let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
- (State_Eq f_nextstate c_nextstate) &&
- (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
- Proof.
- destruct (f_state) eqn:Hf_state.
- { destruct (nat_of_ord c0 == PREA_date - 1) eqn:Hcref_prea; move: Hcref_prea.
- { destruct r eqn:HR.
- { apply SM_Eq_1a. }
- { admit. (* Case 1b: IDLE -> REFRESHING (non-empty queue)*) }
- }
- { destruct (c1 + WAIT < PREA_date) eqn:Hcref_service.
- { destruct r eqn:HR.
- { admit. (* Case 2a: IDLE -> IDLE (empty queue) *)}
- { admit. (* Case 2b: IDLE -> RUNNING (non-empty queue) *)}
- }
- { destruct r eqn:HR.
- { admit. (* Case 3a: IDLE -> IDLE (empty queue )*)}
- { admit. (* Case 3b: IDLE -> IDLE (non empty queue) *) }
- }
- }
- }
- { destruct (nat_of_ord c0 == OACT_date) eqn:Hact_date.
- { destruct r eqn:HR.
- { admit. (* Case 4a : RUNNING -> RUNNING (ACT) (empty queue) *) }
- { admit. (* Case 4b : RUNNING -> RUNNING (ACT) (non empty queue) *)}
- }
- { destruct (nat_of_ord c0 == OCAS_date) eqn:Hcas_date.
- { destruct r eqn:HR.
- { admit. (* Case 5a : RUNNING -> RUNNING (CAS) (empty queue )*) }
- { admit. (* Case 5b : RUNNING -> RUNNING (CAS) (non-empty queue) *)}
- }
- { destruct (nat_of_ord c0 == WAIT.-1) eqn:Hend_date.
- { destruct r eqn:HR.
- { admit. (* Case 6a : RUNNING -> IDLE (empty queue) *) }
- { admit. (* Case 6b : RUNNING -> IDLE (non empty queue) *)}
- }
- { destruct r eqn:HR.
- { admit. (* Case 7a : RUNNING -> RUNNING (empty queue) *) }
- { admit. (* Case 7b : RUNNING -> RUNNING (non empty queue) *) }
- }
- }
- }
- }
- { destruct (nat_of_ord c0 == OREF_date) eqn:Href_date.
- { destruct r eqn:HR.
- { admit. }
- { admit. }
- }
- { destruct (nat_of_ord c0 == OENDREF_date) eqn:Hendref_date.
-
- }
-
- }
-
-End EquivalenceProof.
\ No newline at end of file
diff --git a/framework/CavaDRAM/_CoqProject b/framework/CavaDRAM/_CoqProject
index e49a740..fb83b19 100644
--- a/framework/CavaDRAM/_CoqProject
+++ b/framework/CavaDRAM/_CoqProject
@@ -1,20 +1,20 @@
INSTALLDEFAULTROOT = CavaDRAM
-R . CavaDRAM
-R /home/felipe/PHD/repository/cleanup/sdram/framework/DRAM DRAM
--R /home/felipe/PHD/tools/cava/silveroakrecompiled/cava/Cava Cava
--R /home/felipe/PHD/tools/cava/silveroakrecompiled/third_party/coq-ext-lib/theories ExtLib
--R /home/felipe/PHD/tools/cava/silveroakrecompiled/third_party/bedrock2/deps/coqutil/src/coqutil coqutil
+-R /home/felipe/PHD/tools/cava/silveroakrecompiled_coq817/silveroak/cava/Cava Cava
+-R /home/felipe/PHD/tools/cava/silveroakrecompiled_coq817/silveroak/third_party/coq-ext-lib/theories ExtLib
+-R /home/felipe/PHD/tools/cava/silveroakrecompiled_coq817/silveroak/third_party/bedrock2/deps/coqutil/src/coqutil coqutil
-Lib/UtilSM.v
Lib/Util.v
Lib/Step.v
+Lib/Memories/Memory.v
+Lib/UtilSM.v
+Lib/Subtractor/CavaSubtractor.v
-Core/Memory.v
Core/CavaSystem.v
-Core/CavaSubtractor.v
-Core/CavaMemory.v
-Core/CavaReqQueue.v
-Core/CavaReqQueueProperties.v
Core/CavaCommonInstances.v
+Core/CavaReqQueue.v
+
+Implementations/CavaFIFOREF/CavaFIFOREF.v
+
-CavaFIFOREF/CavaFIFOREF.v
diff --git a/framework/CavaDRAM/gencode/fifo_gencode/CavaFIFOSV.hs b/framework/CavaDRAM/gencode/fifo_gencode/CavaFIFOSV.hs
deleted file mode 100644
index 6a4d71d..0000000
--- a/framework/CavaDRAM/gencode/fifo_gencode/CavaFIFOSV.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Main where
-
-import Cava2SystemVerilog
-import CavaMemory
-import CavaReqQueue
-import CavaFIFOREF
-
-main :: IO ()
-main = do
- writeSystemVerilog sm_netlist ;;
- -- writeTestBench sm_tb
- --
- -- writeTestBench queue_tb ;;
- -- writeSystemVerilog queue_netlist
\ No newline at end of file
diff --git a/framework/CavaDRAM/gencode/fifo_gencode/cava2sv.sh b/framework/CavaDRAM/gencode/fifo_gencode/cava2sv.sh
deleted file mode 100755
index ae53342..0000000
--- a/framework/CavaDRAM/gencode/fifo_gencode/cava2sv.sh
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/bin/bash
-
-cava_src_dir="/home/felipe/PHD/tools/cava/silveroak/cava"
-cava_hdl_dir=${cava_src_dir}/Cava2HDL
-
-echo "Import missing haskell libraries"
-sed -i '3iimport qualified Data.Bits' Ascii.hs ByteVector.hs
-sed -i '3iimport qualified Data.Char' Ascii.hs ByteVector.hs
-
-echo "Generating SV files..."
-ghc -i${cava_src_dir}:${cava_hdl_dir} CavaFIFOSV.hs
-./CavaFIFOSV
diff --git a/framework/CavaDRAM/gencode/tdm_gencode/CavaTDMSV.hs b/framework/CavaDRAM/gencode/tdm_gencode/CavaTDMSV.hs
deleted file mode 100644
index 00ae1dc..0000000
--- a/framework/CavaDRAM/gencode/tdm_gencode/CavaTDMSV.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Main where
-
-import Cava2SystemVerilog
-import CavaMemory
-import CavaReqQueue
-import CavaTDMREF
-
-main :: IO ()
-main = do
- writeSystemVerilog tdm_netlist ;;
- -- writeTestBench sm_tb
- --
- -- writeTestBench queue_tb ;;
- -- writeSystemVerilog queue_netlist
\ No newline at end of file
diff --git a/framework/CavaDRAM/gencode/tdm_gencode/cava2sv.sh b/framework/CavaDRAM/gencode/tdm_gencode/cava2sv.sh
deleted file mode 100755
index f0079b4..0000000
--- a/framework/CavaDRAM/gencode/tdm_gencode/cava2sv.sh
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/bin/bash
-
-cava_src_dir="/home/felipe/PHD/tools/cava/silveroak/cava"
-cava_hdl_dir=${cava_src_dir}/Cava2HDL
-
-echo "Import missing haskell libraries"
-sed -i '3iimport qualified Data.Bits' Ascii.hs ByteVector.hs
-sed -i '3iimport qualified Data.Char' Ascii.hs ByteVector.hs
-
-echo "Generating SV files..."
-ghc -i${cava_src_dir}:${cava_hdl_dir} CavaTDMSV.hs
-./CavaTDMSV
diff --git a/framework/DRAM/Core/ImplementationInterface.v b/framework/DRAM/Core/ImplementationInterface.v
index a4f52b7..a8c9207 100644
--- a/framework/DRAM/Core/ImplementationInterface.v
+++ b/framework/DRAM/Core/ImplementationInterface.v
@@ -5,14 +5,13 @@ From DRAM Require Export Arbiter.
Section ImplementationInterface.
- Class Arbiter_configuration :=
- {
+ Class Arbiter_configuration := {
State_t : Type;
}.
- Context {SYS_CFG : System_configuration}.
- Context {REQUESTOR_CFG : Requestor_configuration}.
- Context {ARBITER_CFG : Arbiter_configuration}.
+ Context {SYS_CFG : System_configuration}.
+ Context {REQUESTOR_CFG : Requestor_configuration}.
+ Context {ARBITER_CFG : Arbiter_configuration}.
Class Implementation_t := mkImplementation
{
@@ -52,11 +51,30 @@ Section ImplementationInterface.
apply /eqP; apply Default_arbitrate_time_match.
Qed.
- Definition Enqueue (R P : Requests_t) :=
- P ++ R.
+ Definition Enqueue (R P : Requests_t) := P ++ R.
+
+ Definition Dequeue r (P : Requests_t) := rem r P.
+
+ (* ------------ Hardware constrained versions -------------------- *)
+
+ Class HW_Implementation_t := mkHWImplementation
+ {
+ HWInit : Request_t -> State_t;
+ HWNext : Request_t -> State_t -> State_t * Command_kind_t;
+ }.
- Definition Dequeue r (P : Requests_t) :=
- rem r P.
+ Fixpoint HW_Default_arbitrate
+ {HAF : HW_Arrival_function_t}
+ {HIM : HW_Implementation_t} t {struct t} : Arbiter_state_t :=
+ let R := HW_Arrival_at t in
+ match t with
+ | 0 => mkArbiterState [::] t (HWInit R)
+ | S(t') => let old_state := HW_Default_arbitrate t' in
+ let (new_state,new_cmd_kind) := HWNext R old_state.(Implementation_State) in
+ let new_cmd := mkCmd t new_cmd_kind in
+ let cmd_list := (new_cmd :: old_state.(Arbiter_Commands)) in
+ mkArbiterState cmd_list t new_state
+ end.
End ImplementationInterface.
diff --git a/framework/DRAM/Implementations/TS/FIFOREF/FIFOREF.v b/framework/DRAM/Implementations/TS/FIFOREF/FIFOREF.v
index 4fc378d..52cd486 100644
--- a/framework/DRAM/Implementations/TS/FIFOREF/FIFOREF.v
+++ b/framework/DRAM/Implementations/TS/FIFOREF/FIFOREF.v
@@ -6,7 +6,7 @@ From mathcomp Require Import ssrnat fintype div ssrZ zify ring.
From DRAM Require Export ImplementationInterface.
From Coq Require Import Program NArith.
-Section FIFO.
+Section FIFOREF.
Context {SYS_CFG : System_configuration}.
@@ -128,45 +128,45 @@ Section FIFO.
Definition Enqueue (R : Request_t) (P : Requests_t) := P ++ [:: R].
Definition Dequeue r (P : Requests_t) := rem r P.
- (* Definition Init_state R := IDLE OCycle0 0 (Enqueue R [::]). *)
- Definition Init_state R := IDLE OCycle0 OCycle0REF [:: R].
- Definition nullreq := mkReq tt 0 RD (Nat_to_bankgroup 0) (Nat_to_bank 0) 0.
+ Definition Init_state R := IDLE OCycle0 OCycle0REF [:: R].
+ Definition nullreq := mkReq tt 0 RD
+ (mkAddress (Nat_to_bankgroup 0) (Nat_to_bank 0) 0).
(* check if there's enough time to proc another req *)
Definition Next_state (R : Request_t) (AS : FIFO_state_t)
- : (FIFO_state_t * (Command_kind_t * Request_t)) :=
- match AS return FIFO_state_t * (Command_kind_t * Request_t) with
+ : (FIFO_state_t * Command_kind_t ) :=
+ match AS return FIFO_state_t * Command_kind_t with
| IDLE c cref P =>
let P' := Enqueue R P in
let c' := Next_cycle c in
let cref' := Next_cycle_ref cref in
- if (nat_of_ord cref == (PREA_date - 1)) then (REFRESHING OCycle0REF P',(PREA,nullreq))
+ if (nat_of_ord cref == (PREA_date - 1)) then (REFRESHING OCycle0REF P', PREA)
else if (cref + WAIT < PREA_date) then
match P with
- | [::] => (IDLE c' cref' P', (NOP,nullreq))
- | r :: PP => (RUNNING OCycle0 cref' (Enqueue R (Dequeue r P)) r, (PRE,r))
+ | [::] => (IDLE c' cref' P', NOP)
+ | r :: PP => (RUNNING OCycle0 cref' (Enqueue R (Dequeue r P)) r, (PRE r))
end
- else (IDLE c' cref' P', (NOP,nullreq))
+ else (IDLE c' cref' P', NOP)
| RUNNING c cref P r =>
let P' := Enqueue R P in
let c' := Next_cycle c in
let cref' := Next_cycle_ref cref in
- if nat_of_ord c == OACT_date then (RUNNING c' cref' P' r, (ACT,r))
- else if nat_of_ord c == OCAS_date then (RUNNING c' cref' P' r, ((Kind_of_req r), r))
- else if nat_of_ord c == WAIT.-1 then (IDLE OCycle0 cref' P', (NOP,nullreq))
- else (RUNNING c' cref' P' r, (NOP,r))
+ if nat_of_ord c == OACT_date then (RUNNING c' cref' P' r, (ACT r))
+ else if nat_of_ord c == OCAS_date then (RUNNING c' cref' P' r, ((Kind_of_req r) r))
+ else if nat_of_ord c == WAIT.-1 then (IDLE OCycle0 cref' P', NOP)
+ else (RUNNING c' cref' P' r, NOP)
| REFRESHING cref P =>
let P' := Enqueue R P in
let cref' := Next_cycle_ref cref in
- if (nat_of_ord cref == OREF_date) then (REFRESHING cref' P', (REF,nullreq))
- else if (cref == OENDREF_date) then (IDLE OCycle0 OCycle0REF P', (NOP, nullreq))
- else (REFRESHING cref' P', (NOP,nullreq))
+ if (nat_of_ord cref == OREF_date) then
+ (REFRESHING cref' P', REF)
+ else if (cref == OENDREF_date) then
+ (IDLE OCycle0 OCycle0REF P', NOP)
+ else
+ (REFRESHING cref' P', NOP)
end.
- (* Global Instance FIFO_implementation : Implementation_t :=
- mkImplementation Init_state Next_state. *)
-
- Global Instance FIFO_implementation : HWImplementation_t :=
+ #[global] Instance FIFO_implementation : HW_Implementation_t :=
mkHWImplementation Init_state Next_state.
-End FIFO.
\ No newline at end of file
+End FIFOREF.
\ No newline at end of file
diff --git a/framework/DRAM/_CoqProject b/framework/DRAM/_CoqProject
index 3044567..15ed225 100644
--- a/framework/DRAM/_CoqProject
+++ b/framework/DRAM/_CoqProject
@@ -14,6 +14,7 @@ Core/InterfaceSubLayer.v
Implementations/TS/FIFO/FIFO.v
Implementations/TS/TDM/TDM.v
+Implementations/TS/FIFOREF/FIFOREF.v
Implementations/BM/FIFOimpSL/FIFOimpSL.v
Implementations/BM/RRimpSL/RRimpSL.v
--
GitLab