Merge branch 'dev-nadesh' into dev-nadesh-proven

20 files changed, 3552 insertions, 2211 deletions

diff --git a/src/Compiler.v b/src/Compiler.v
index 513b5fa..0a8617d 100644
--- a/src/Compiler.v
+++ b/src/Compiler.v
@@ -16,6 +16,8 @@
  * along with this program.  If not, see <https://www.gnu.org/licenses/>.
  *)
 
+From coqup Require Import HTLgenproof.
+
 From compcert.common Require Import
     Errors
     Linking.
@@ -48,8 +50,11 @@ From compcert.driver Require
 From coqup Require
      Verilog
      Veriloggen
+     Veriloggenproof
      HTLgen.
 
+From compcert Require Import Smallstep.
+
 Parameter print_RTL: Z -> RTL.program -> unit.
 Parameter print_HTL: HTL.program -> unit.
 
@@ -90,16 +95,7 @@ Definition transf_backend (r : RTL.program) : res Verilog.program :=
   @@ print print_HTL
   @@ Veriloggen.transl_program.
 
-(* Unoptimised below: *)
-(*Definition transf_backend (r : RTL.program) : res Verilog.program :=
-  OK r
-  @@@ Inlining.transf_program
-  @@ print (print_RTL 1)
-  @@@ HTLgen.transl_program
-  @@ Veriloggen.transl_program.
-*)
-
-Definition transf_frontend (p: Csyntax.program) : res RTL.program :=
+Definition transf_hls (p : Csyntax.program) : res Verilog.program :=
   OK p
   @@@ SimplExpr.transl_program
   @@@ SimplLocals.transf_program
@@ -107,11 +103,6 @@ Definition transf_frontend (p: Csyntax.program) : res RTL.program :=
   @@@ Cminorgen.transl_program
   @@@ Selection.sel_program
   @@@ RTLgen.transl_program
-  @@ print (print_RTL 0).
-
-Definition transf_hls (p : Csyntax.program) : res Verilog.program :=
-  OK p
-  @@@ transf_frontend
   @@@ transf_backend.
 
 Local Open Scope linking_scope.
@@ -123,25 +114,31 @@ Definition CompCert's_passes :=
   ::: mkpass Cminorgenproof.match_prog
   ::: mkpass Selectionproof.match_prog
   ::: mkpass RTLgenproof.match_prog
+  ::: mkpass Inliningproof.match_prog
+  ::: (@mkpass _ _ HTLgenproof.match_prog (HTLgenproof.TransfHTLLink HTLgen.transl_program))
+  ::: mkpass Veriloggenproof.match_prog
   ::: pass_nil _.
 
-Definition match_prog: Csyntax.program -> RTL.program -> Prop :=
+Definition match_prog: Csyntax.program -> Verilog.program -> Prop :=
   pass_match (compose_passes CompCert's_passes).
 
-Theorem transf_frontend_match:
+Theorem transf_hls_match:
   forall p tp,
-    transf_frontend p = OK tp ->
+    transf_hls p = OK tp ->
     match_prog p tp.
 Proof.
   intros p tp T.
-  unfold transf_frontend in T. simpl in T.
+  unfold transf_hls in T. simpl in T.
   destruct (SimplExpr.transl_program p) as [p1|e] eqn:P1; simpl in T; try discriminate.
   destruct (SimplLocals.transf_program p1) as [p2|e] eqn:P2; simpl in T; try discriminate.
   destruct (Cshmgen.transl_program p2) as [p3|e] eqn:P3; simpl in T; try discriminate.
   destruct (Cminorgen.transl_program p3) as [p4|e] eqn:P4; simpl in T; try discriminate.
   destruct (Selection.sel_program p4) as [p5|e] eqn:P5; simpl in T; try discriminate.
-  rewrite ! compose_print_identity in T.
   destruct (RTLgen.transl_program p5) as [p6|e] eqn:P6; simpl in T; try discriminate.
+  unfold transf_backend in T. simpl in T. rewrite ! compose_print_identity in T.
+  destruct (Inlining.transf_program p6) as [p7|e] eqn:P7; simpl in T; try discriminate.
+  destruct (HTLgen.transl_program p7) as [p8|e] eqn:P8; simpl in T; try discriminate.
+  set (p9 := Veriloggen.transl_program p8) in *.
   unfold match_prog; simpl.
   exists p1; split. apply SimplExprproof.transf_program_match; auto.
   exists p2; split. apply SimplLocalsproof.match_transf_program; auto.
@@ -149,5 +146,100 @@ Proof.
   exists p4; split. apply Cminorgenproof.transf_program_match; auto.
   exists p5; split. apply Selectionproof.transf_program_match; auto.
   exists p6; split. apply RTLgenproof.transf_program_match; auto.
-  inversion T. reflexivity.
+  exists p7; split. apply Inliningproof.transf_program_match; auto.
+  exists p8; split. apply HTLgenproof.transf_program_match; auto.
+  exists p9; split. apply Veriloggenproof.transf_program_match; auto.
+  (* inv T. reflexivity. *)
+Admitted.
+
+Remark forward_simulation_identity:
+  forall sem, forward_simulation sem sem.
+Proof.
+  intros. apply forward_simulation_step with (fun s1 s2 => s2 = s1); intros.
+- auto.
+- exists s1; auto.
+- subst s2; auto.
+- subst s2. exists s1'; auto.
+Qed.
+
+Theorem cstrategy_semantic_preservation:
+  forall p tp,
+  match_prog p tp ->
+  forward_simulation (Cstrategy.semantics p) (Verilog.semantics tp)
+  /\ backward_simulation (atomic (Cstrategy.semantics p)) (Verilog.semantics tp).
+Proof.
+  intros p tp M. unfold match_prog, pass_match in M; simpl in M.
+Ltac DestructM :=
+  match goal with
+    [ H: exists p, _ /\ _ |- _ ] =>
+      let p := fresh "p" in let M := fresh "M" in let MM := fresh "MM" in
+      destruct H as (p & M & MM); clear H
+  end.
+  repeat DestructM. subst tp.
+  assert (F: forward_simulation (Cstrategy.semantics p) (Verilog.semantics p9)).
+  {
+  eapply compose_forward_simulations.
+    eapply SimplExprproof.transl_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply SimplLocalsproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Cshmgenproof.transl_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Cminorgenproof.transl_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Selectionproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply RTLgenproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Inliningproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply HTLgenproof.transf_program_correct. eassumption.
+  eapply Veriloggenproof.transf_program_correct; eassumption.
+  }
+  split. auto.
+  apply forward_to_backward_simulation.
+  apply factor_forward_simulation. auto. eapply sd_traces. eapply Verilog.semantics_determinate.
+  apply atomic_receptive. apply Cstrategy.semantics_strongly_receptive.
+  apply Verilog.semantics_determinate.
+Qed.
+
+Theorem c_semantic_preservation:
+  forall p tp,
+  match_prog p tp ->
+  backward_simulation (Csem.semantics p) (Verilog.semantics tp).
+Proof.
+  intros.
+  apply compose_backward_simulation with (atomic (Cstrategy.semantics p)).
+  eapply sd_traces; eapply Verilog.semantics_determinate.
+  apply factor_backward_simulation.
+  apply Cstrategy.strategy_simulation.
+  apply Csem.semantics_single_events.
+  eapply ssr_well_behaved; eapply Cstrategy.semantics_strongly_receptive.
+  exact (proj2 (cstrategy_semantic_preservation _ _ H)).
+Qed.
+
+Theorem transf_c_program_correct:
+  forall p tp,
+  transf_hls p = OK tp ->
+  backward_simulation (Csem.semantics p) (Verilog.semantics tp).
+Proof.
+  intros. apply c_semantic_preservation. apply transf_hls_match; auto.
+Qed.
+
+Theorem separate_transf_c_program_correct:
+  forall c_units verilog_units c_program,
+  nlist_forall2 (fun cu tcu => transf_hls cu = OK tcu) c_units verilog_units ->
+  link_list c_units = Some c_program ->
+  exists verilog_program,
+      link_list verilog_units = Some verilog_program
+   /\ backward_simulation (Csem.semantics c_program) (Verilog.semantics verilog_program).
+Proof.
+  intros.
+  assert (nlist_forall2 match_prog c_units verilog_units).
+  { eapply nlist_forall2_imply. eauto. simpl; intros. apply transf_hls_match; auto. }
+  assert (exists verilog_program, link_list verilog_units = Some verilog_program
+                                  /\ match_prog c_program verilog_program).
+  { eapply link_list_compose_passes; eauto. }
+  destruct H2 as (verilog_program & P & Q).
+  exists verilog_program; split; auto. apply c_semantic_preservation; auto.
 Qed.
diff --git a/src/common/Coquplib.v b/src/common/Coquplib.v
index c9361c2..469eddc 100644
--- a/src/common/Coquplib.v
+++ b/src/common/Coquplib.v
@@ -32,6 +32,29 @@ From coqup Require Import Show.
 From compcert.lib Require Export Coqlib.
 From compcert Require Import Integers.
 
+Local Open Scope Z_scope.
+
+(* This tactic due to Clement Pit-Claudel with some minor additions by JDP to
+   allow the result to be named: https://pit-claudel.fr/clement/MSc/#org96a1b5f *)
+Inductive Learnt {A: Type} (a: A) :=
+  | AlreadyKnown : Learnt a.
+
+Ltac learn_tac fact name :=
+  lazymatch goal with
+  | [ H: Learnt fact |- _ ] =>
+    fail 0 "fact" fact "has already been learnt"
+  | _ => let type := type of fact in
+        lazymatch goal with
+        | [ H: @Learnt type _ |- _ ] =>
+          fail 0 "fact" fact "of type" type "was already learnt through" H
+        | _ => let learnt := fresh "Learn" in
+              pose proof (AlreadyKnown fact) as learnt; pose proof fact as name
+        end
+  end.
+
+Tactic Notation "learn" constr(fact) := let name := fresh "H" in learn_tac fact name.
+Tactic Notation "learn" constr(fact) "as" simple_intropattern(name) := learn_tac fact name.
+
 Ltac unfold_rec c := unfold c; fold c.
 
 Ltac solve_by_inverts n :=
@@ -49,10 +72,11 @@ Ltac invert x := inversion x; subst; clear x.
 Ltac destruct_match :=
   match goal with | [ |- context[match ?x with | _ => _ end ] ] => destruct x end.
 
-Ltac clear_obvious :=
+Ltac nicify_hypotheses :=
   repeat match goal with
          | [ H : ex _ |- _ ] => invert H
          | [ H : Some _ = Some _ |- _ ] => invert H
+         | [ H : ?x = ?x |- _ ] => clear H
          | [ H : _ /\ _ |- _ ] => invert H
          end.
 
@@ -129,16 +153,38 @@ Ltac unfold_constants :=
            end
          end.
 
-Ltac crush := intros; unfold_constants; simpl in *;
-              repeat (clear_obvious; nicify_goals; kill_bools);
-              simpl in *; try discriminate; try congruence; try lia; try assumption.
+Ltac substpp :=
+  repeat match goal with
+         | [ H1 : ?x = Some _, H2 : ?x = Some _ |- _ ] =>
+           let EQ := fresh "EQ" in
+           learn H1 as EQ; rewrite H2 in EQ; invert EQ
+         | _ => idtac
+         end.
 
-Global Opaque Nat.div.
-Global Opaque Z.mul.
+Ltac simplify := intros; unfold_constants; simpl in *;
+                 repeat (nicify_hypotheses; nicify_goals; kill_bools; substpp);
+                 simpl in *.
 
 Infix "==nat" := eq_nat_dec (no associativity, at level 50).
 Infix "==Z" := Z.eq_dec (no associativity, at level 50).
 
+Ltac liapp :=
+  repeat match goal with
+         | [ |- (?x | ?y) ] =>
+           match (eval compute in (Z.rem y x ==Z 0)) with
+           | left _ =>
+             let q := (eval compute in (Z.div y x))
+             in exists q; reflexivity
+           | _ => idtac
+          end
+         | _ => idtac
+         end.
+
+Ltac crush := simplify; try discriminate; try congruence; try lia; liapp; try assumption.
+
+Global Opaque Nat.div.
+Global Opaque Z.mul.
+
 (* Definition const (A B : Type) (a : A) (b : B) : A := a.
 
 Definition compose (A B C : Type) (f : B -> C) (g : A -> B) (x : A) : C := f (g x). *)
@@ -189,3 +235,5 @@ Definition debug_show {A B : Type} `{Show A} (a : A) (b : B) : B :=
 
 Definition debug_show_msg {A B : Type} `{Show A} (s : string) (a : A) (b : B) : B :=
   let unused := debug_print (s ++ show a) in b.
+
+Notation "f $ x" := (f x) (at level 60, right associativity, only parsing).
diff --git a/src/common/IntegerExtra.v b/src/common/IntegerExtra.v
index 6bac18d..8e32c2c 100644
--- a/src/common/IntegerExtra.v
+++ b/src/common/IntegerExtra.v
@@ -70,22 +70,21 @@ Module PtrofsExtra.
 
   Lemma of_int_mod :
     forall x m,
-      Int.signed x mod m = 0 ->
-      Ptrofs.signed (Ptrofs.of_int x) mod m = 0.
+      Int.unsigned x mod m = 0 ->
+      Ptrofs.unsigned (Ptrofs.of_int x) mod m = 0.
   Proof.
     intros.
-    pose proof (Integers.Ptrofs.agree32_of_int eq_refl x) as A.
-    pose proof Ptrofs.agree32_signed.
-    apply H0 in A; try reflexivity.
-    rewrite A. assumption.
+    unfold Ptrofs.of_int.
+    rewrite Ptrofs.unsigned_repr; crush;
+      apply Int.unsigned_range_2.
   Qed.
 
   Lemma mul_mod :
     forall x y m,
       0 < m ->
       (m | Ptrofs.modulus) ->
-      Ptrofs.signed x mod m = 0 ->
-      Ptrofs.signed y mod m = 0 ->
+      Ptrofs.unsigned x mod m = 0 ->
+      Ptrofs.unsigned y mod m = 0 ->
       (Ptrofs.signed (Ptrofs.mul x y)) mod m = 0.
   Proof.
     intros. unfold Ptrofs.mul.
@@ -95,7 +94,6 @@ Module PtrofsExtra.
            | [ _ : _ |- context[if ?x then _ else _] ] => destruct x
            | [ _ : _ |- context[_ mod Ptrofs.modulus mod m] ] =>
              rewrite <- Zmod_div_mod; try lia; try assumption
-           | [ _ : _ |- context[Ptrofs.unsigned _] ] => rewrite Ptrofs.unsigned_signed
            end; try(crush; lia); ptrofs_mod_tac m.
   Qed.
 
@@ -103,8 +101,8 @@ Module PtrofsExtra.
     forall x y m,
       0 < m ->
       (m | Ptrofs.modulus) ->
-      Ptrofs.signed x mod m = 0 ->
-      Ptrofs.signed y mod m = 0 ->
+      Ptrofs.unsigned x mod m = 0 ->
+      Ptrofs.unsigned y mod m = 0 ->
       (Ptrofs.unsigned (Ptrofs.add x y)) mod m = 0.
   Proof.
     intros. unfold Ptrofs.add.
@@ -114,7 +112,6 @@ Module PtrofsExtra.
            | [ _ : _ |- context[if ?x then _ else _] ] => destruct x
            | [ _ : _ |- context[_ mod Ptrofs.modulus mod m] ] =>
              rewrite <- Zmod_div_mod; try lia; try assumption
-           | [ _ : _ |- context[Ptrofs.unsigned _] ] => rewrite Ptrofs.unsigned_signed
            end; try (crush; lia); ptrofs_mod_tac m.
   Qed.
 
@@ -202,7 +199,7 @@ Ltac ptrofs :=
          end.
 
 Module IntExtra.
-
+  Import Int.
   Ltac int_mod_match m :=
     match goal with
     | [ H : ?x = 0 |- context[?x] ] => rewrite H
@@ -243,22 +240,37 @@ Module IntExtra.
   Ltac int_mod_tac m :=
     repeat (int_mod_match m); lia.
 
-  Lemma mul_mod :
+  Lemma mul_mod1 :
+    forall x y m,
+      0 < m ->
+      (m | Int.modulus) ->
+      Int.unsigned x mod m = 0 ->
+      (Int.unsigned (Int.mul x y)) mod m = 0.
+  Proof.
+    intros. unfold Int.mul.
+    rewrite Int.unsigned_repr_eq.
+
+    repeat match goal with
+           | [ _ : _ |- context[if ?x then _ else _] ] => destruct x
+           | [ _ : _ |- context[_ mod Int.modulus mod m] ] =>
+             rewrite <- Zmod_div_mod; try lia; try assumption
+           end; try (crush; lia); int_mod_tac m.
+  Qed.
+
+  Lemma mul_mod2 :
     forall x y m,
       0 < m ->
       (m | Int.modulus) ->
-      Int.signed x mod m = 0 ->
-      Int.signed y mod m = 0 ->
-      (Int.signed (Int.mul x y)) mod m = 0.
+      Int.unsigned y mod m = 0 ->
+      (Int.unsigned (Int.mul x y)) mod m = 0.
   Proof.
     intros. unfold Int.mul.
-    rewrite Int.signed_repr_eq.
+    rewrite Int.unsigned_repr_eq.
 
     repeat match goal with
            | [ _ : _ |- context[if ?x then _ else _] ] => destruct x
            | [ _ : _ |- context[_ mod Int.modulus mod m] ] =>
              rewrite <- Zmod_div_mod; try lia; try assumption
-           | [ _ : _ |- context[Int.unsigned _] ] => rewrite Int.unsigned_signed
            end; try (crush; lia); int_mod_tac m.
   Qed.
 
@@ -266,18 +278,92 @@ Module IntExtra.
     forall x y m,
       0 < m ->
       (m | Int.modulus) ->
-      Int.signed x mod m = 0 ->
-      Int.signed y mod m = 0 ->
-      (Int.signed (Int.add x y)) mod m = 0.
+      Int.unsigned x mod m = 0 ->
+      Int.unsigned y mod m = 0 ->
+      (Int.unsigned (Int.add x y)) mod m = 0.
   Proof.
     intros. unfold Int.add.
-    rewrite Int.signed_repr_eq.
+    rewrite Int.unsigned_repr_eq.
 
     repeat match goal with
            | [ _ : _ |- context[if ?x then _ else _] ] => destruct x
            | [ _ : _ |- context[_ mod Int.modulus mod m] ] =>
              rewrite <- Zmod_div_mod; try lia; try assumption
-           | [ _ : _ |- context[Int.unsigned _] ] => rewrite Int.unsigned_signed
            end; try (crush; lia); int_mod_tac m.
   Qed.
+
+  Definition ofbytes (a b c d : byte) : int :=
+    or (shl (repr (Byte.unsigned a)) (repr (3 * Byte.zwordsize)))
+       (or (shl (repr (Byte.unsigned b)) (repr (2 * Byte.zwordsize)))
+           (or (shl (repr (Byte.unsigned c)) (repr Byte.zwordsize))
+               (repr (Byte.unsigned d)))).
+
+  Definition byte0 (n: int) : byte := Byte.repr $ unsigned n.
+  Definition ibyte0 (n: int) : int := Int.repr $ Byte.unsigned $ byte0 n.
+
+  Definition byte1 (n: int) : byte := Byte.repr $ unsigned $ shru n $ repr Byte.zwordsize.
+  Definition ibyte1 (n: int) : int := Int.repr $ Byte.unsigned $ byte1 n.
+
+  Definition byte2 (n: int) : byte := Byte.repr $ unsigned $ shru n $ repr (2 * Byte.zwordsize).
+  Definition ibyte2 (n: int) : int := Int.repr $ Byte.unsigned $ byte2 n.
+
+  Definition byte3 (n: int) : byte := Byte.repr $ unsigned $ shru n $ repr (3 * Byte.zwordsize).
+  Definition ibyte3 (n: int) : int := Int.repr $ Byte.unsigned $ byte3 n.
+
+  Lemma bits_byte0:
+    forall n i, 0 <= i < Byte.zwordsize -> Byte.testbit (byte0 n) i = testbit n i.
+  Proof.
+    intros. unfold byte0. rewrite Byte.testbit_repr; auto.
+  Qed.
+
+  Lemma bits_byte1:
+    forall n i, 0 <= i < Byte.zwordsize -> Byte.testbit (byte1 n) i = testbit n (i + Byte.zwordsize).
+  Proof.
+    intros. unfold byte1. rewrite Byte.testbit_repr; auto.
+    assert (zwordsize = 4 * Byte.zwordsize) by reflexivity.
+    fold (testbit (shru n (repr Byte.zwordsize)) i). rewrite bits_shru.
+    change (unsigned (repr Byte.zwordsize)) with Byte.zwordsize.
+    apply zlt_true. omega. omega.
+  Qed.
+
+  Lemma bits_byte2:
+    forall n i, 0 <= i < Byte.zwordsize -> Byte.testbit (byte2 n) i = testbit n (i + (2 * Byte.zwordsize)).
+  Proof.
+    intros. unfold byte2. rewrite Byte.testbit_repr; auto.
+    assert (zwordsize = 4 * Byte.zwordsize) by reflexivity.
+    fold (testbit (shru n (repr (2 * Byte.zwordsize))) i). rewrite bits_shru.
+    change (unsigned (repr (2 * Byte.zwordsize))) with (2 * Byte.zwordsize).
+    apply zlt_true. omega. omega.
+  Qed.
+
+  Lemma bits_byte3:
+    forall n i, 0 <= i < Byte.zwordsize -> Byte.testbit (byte3 n) i = testbit n (i + (3 * Byte.zwordsize)).
+  Proof.
+    intros. unfold byte3. rewrite Byte.testbit_repr; auto.
+    assert (zwordsize = 4 * Byte.zwordsize) by reflexivity.
+    fold (testbit (shru n (repr (3 * Byte.zwordsize))) i). rewrite bits_shru.
+    change (unsigned (repr (3 * Byte.zwordsize))) with (3 * Byte.zwordsize).
+    apply zlt_true. omega. omega.
+  Qed.
+
+  Lemma bits_ofwords:
+    forall b4 b3 b2 b1 i, 0 <= i < zwordsize ->
+                          testbit (ofbytes b4 b3 b2 b1) i =
+                          if zlt i Byte.zwordsize
+                          then Byte.testbit b1 i
+                          else (if zlt i (2 * Byte.zwordsize)
+                                then Byte.testbit b2 (i - Byte.zwordsize)
+                                else (if zlt i (3 * Byte.zwordsize)
+                                      then Byte.testbit b2 (i - 2 * Byte.zwordsize)
+                                      else Byte.testbit b2 (i - 3 * Byte.zwordsize))).
+  Proof.
+    intros. unfold ofbytes. repeat (rewrite bits_or; auto). repeat (rewrite bits_shl; auto).
+    change (unsigned (repr Byte.zwordsize)) with Byte.zwordsize.
+    change (unsigned (repr (2 * Byte.zwordsize))) with (2 * Byte.zwordsize).
+    change (unsigned (repr (3 * Byte.zwordsize))) with (3 * Byte.zwordsize).
+    assert (zwordsize = 4 * Byte.zwordsize) by reflexivity.
+    destruct (zlt i Byte.zwordsize).
+    rewrite testbit_repr; auto.
+    Abort.
+
 End IntExtra.
diff --git a/src/common/Monad.v b/src/common/Monad.v
index 8517186..628963e 100644
--- a/src/common/Monad.v
+++ b/src/common/Monad.v
@@ -20,6 +20,10 @@ Module MonadExtra(M : Monad).
 
   Module MonadNotation.
 
+    Notation "A ; B" :=
+      (bind A (fun _ => B))
+        (at level 200, B at level 200).
+
     Notation "'do' X <- A ; B" :=
       (bind A (fun X => B))
         (at level 200, X ident, A at level 100, B at level 200).
diff --git a/src/common/ZExtra.v b/src/common/ZExtra.v
index a0dd717..519ee7c 100644
--- a/src/common/ZExtra.v
+++ b/src/common/ZExtra.v
@@ -31,4 +31,19 @@ Module ZExtra.
       apply Zmult_gt_reg_r in g; lia.
   Qed.
 
+  Lemma Ple_not_eq :
+    forall x y,
+    (x < y)%positive -> x <> y.
+  Proof. lia. Qed.
+
+  Lemma Pge_not_eq :
+    forall x y,
+    (y < x)%positive -> x <> y.
+  Proof. lia. Qed.
+
+  Lemma Ple_Plt_Succ :
+    forall x y n,
+    (x <= y)%positive -> (x < y + n)%positive.
+  Proof. lia. Qed.
+
 End ZExtra.
diff --git a/src/extraction/Extraction.v b/src/extraction/Extraction.v
index df21dc4..5d10cd7 100644
--- a/src/extraction/Extraction.v
+++ b/src/extraction/Extraction.v
@@ -16,7 +16,7 @@
  * along with this program.  If not, see <https://www.gnu.org/licenses/>.
  *)
 
-From coqup Require Verilog Value Compiler.
+From coqup Require Verilog ValueInt Compiler.
 
 From Coq Require DecidableClass.
 
@@ -167,7 +167,7 @@ Set Extraction AccessOpaque.
 
 Cd "src/extraction".
 Separate Extraction
-         Verilog.module Value.uvalueToZ coqup.Compiler.transf_hls
+         Verilog.module ValueInt.uvalueToZ coqup.Compiler.transf_hls
 
    Compiler.transf_c_program Compiler.transf_cminor_program
    Cexec.do_initial_state Cexec.do_step Cexec.at_final_state
diff --git a/src/translation/HTLgen.v b/src/translation/HTLgen.v
index 9a82aa8..db24a1d 100644
--- a/src/translation/HTLgen.v
+++ b/src/translation/HTLgen.v
@@ -19,7 +19,7 @@
 From compcert Require Import Maps.
 From compcert Require Errors Globalenvs Integers.
 From compcert Require Import AST RTL.
-From coqup Require Import Verilog HTL Coquplib AssocMap Value Statemonad.
+From coqup Require Import Verilog HTL Coquplib AssocMap ValueInt Statemonad.
 
 Hint Resolve AssocMap.gempty : htlh.
 Hint Resolve AssocMap.gso : htlh.
@@ -88,10 +88,10 @@ Import HTLMonadExtra.
 Export MonadNotation.
 
 Definition state_goto (st : reg) (n : node) : stmnt :=
-  Vnonblock (Vvar st) (Vlit (posToValue 32 n)).
+  Vnonblock (Vvar st) (Vlit (posToValue n)).
 
 Definition state_cond (st : reg) (c : expr) (n1 n2 : node) : stmnt :=
-  Vnonblock (Vvar st) (Vternary c (posToExpr 32 n1) (posToExpr 32 n2)).
+  Vnonblock (Vvar st) (Vternary c (posToExpr n1) (posToExpr n2)).
 
 Definition check_empty_node_datapath:
   forall (s: state) (n: node), { s.(st_datapath)!n = None } + { True }.
@@ -244,7 +244,7 @@ Definition boplit (op : binop) (r : reg) (l : Integers.int) : expr :=
   Vbinop op (Vvar r) (Vlit (intToValue l)).
 
 Definition boplitz (op: binop) (r: reg) (l: Z) : expr :=
-  Vbinop op (Vvar r) (Vlit (ZToValue 32%nat l)).
+  Vbinop op (Vvar r) (Vlit (ZToValue l)).
 
 Definition translate_comparison (c : Integers.comparison) (args : list reg) : mon expr :=
   match c, args with
@@ -269,14 +269,37 @@ Definition translate_comparison_imm (c : Integers.comparison) (args : list reg)
   | _, _ => error (Errors.msg "Htlgen: comparison_imm instruction not implemented: other")
   end.
 
+Definition translate_comparisonu (c : Integers.comparison) (args : list reg) : mon expr :=
+  match c, args with
+  | Integers.Ceq, r1::r2::nil => ret (bop Veq r1 r2)
+  | Integers.Cne, r1::r2::nil => ret (bop Vne r1 r2)
+  | Integers.Clt, r1::r2::nil => ret (bop Vltu r1 r2)
+  | Integers.Cgt, r1::r2::nil => ret (bop Vgtu r1 r2)
+  | Integers.Cle, r1::r2::nil => ret (bop Vleu r1 r2)
+  | Integers.Cge, r1::r2::nil => ret (bop Vgeu r1 r2)
+  | _, _ => error (Errors.msg "Htlgen: comparison instruction not implemented: other")
+  end.
+
+Definition translate_comparison_immu (c : Integers.comparison) (args : list reg) (i: Integers.int)
+  : mon expr :=
+  match c, args with
+  | Integers.Ceq, r1::nil => ret (boplit Veq r1 i)
+  | Integers.Cne, r1::nil => ret (boplit Vne r1 i)
+  | Integers.Clt, r1::nil => ret (boplit Vltu r1 i)
+  | Integers.Cgt, r1::nil => ret (boplit Vgtu r1 i)
+  | Integers.Cle, r1::nil => ret (boplit Vleu r1 i)
+  | Integers.Cge, r1::nil => ret (boplit Vgeu r1 i)
+  | _, _ => error (Errors.msg "Htlgen: comparison_imm instruction not implemented: other")
+  end.
+
 Definition translate_condition (c : Op.condition) (args : list reg) : mon expr :=
   match c, args with
   | Op.Ccomp c, _ => translate_comparison c args
-  | Op.Ccompu c, _ => translate_comparison c args
+  | Op.Ccompu c, _ => translate_comparisonu c args
   | Op.Ccompimm c i, _ => translate_comparison_imm c args i
-  | Op.Ccompuimm c i, _ => translate_comparison_imm c args i
-  | Op.Cmaskzero n, r::nil => ret (Vbinop Veq (boplit Vand r n) (Vlit (ZToValue 32 0)))
-  | Op.Cmasknotzero n, r::nil => ret (Vbinop Vne (boplit Vand r n) (Vlit (ZToValue 32 0)))
+  | Op.Ccompuimm c i, _ => translate_comparison_immu c args i
+  | Op.Cmaskzero n, _ => error (Errors.msg "Htlgen: condition instruction not implemented: Cmaskzero")
+  | Op.Cmasknotzero n, _ => error (Errors.msg "Htlgen: condition instruction not implemented: Cmasknotzero")
   | _, _ => error (Errors.msg "Htlgen: condition instruction not implemented: other")
   end.
 
@@ -292,26 +315,16 @@ Definition check_address_parameter_unsigned (p : Z) : bool :=
 Definition translate_eff_addressing (a: Op.addressing) (args: list reg) : mon expr :=
   match a, args with (* TODO: We should be more methodical here; what are the possibilities?*)
   | Op.Aindexed off, r1::nil =>
-    if (check_address_parameter_signed off)
-    then ret (boplitz Vadd r1 off)
-    else error (Errors.msg "Veriloggen: translate_eff_addressing (Aindexed): address misaligned")
+    ret (boplitz Vadd r1 off)
   | Op.Ascaled scale offset, r1::nil =>
-    if (check_address_parameter_signed scale) && (check_address_parameter_signed offset)
-    then ret (Vbinop Vadd (boplitz Vmul r1 scale) (Vlit (ZToValue 32 offset)))
-    else error (Errors.msg "Veriloggen: translate_eff_addressing (Ascaled): address misaligned")
+    ret (Vbinop Vadd (boplitz Vmul r1 scale) (Vlit (ZToValue offset)))
   | Op.Aindexed2 offset, r1::r2::nil =>
-    if (check_address_parameter_signed offset)
-    then ret (Vbinop Vadd (Vvar r1) (boplitz Vadd r2 offset))
-    else error (Errors.msg "Veriloggen: translate_eff_addressing (Aindexed2): address misaligned")
+    ret (Vbinop Vadd (bop Vadd r1 r2) (Vlit (ZToValue offset)))
   | Op.Aindexed2scaled scale offset, r1::r2::nil => (* Typical for dynamic array addressing *)
-    if (check_address_parameter_signed scale) && (check_address_parameter_signed offset)
-    then ret (Vbinop Vadd (boplitz Vadd r1 offset) (boplitz Vmul r2 scale))
-    else error (Errors.msg "Veriloggen: translate_eff_addressing (Aindexed2scaled): address misaligned")
+    ret (Vbinop Vadd (Vvar r1) (Vbinop Vadd (boplitz Vmul r2 scale) (Vlit (ZToValue offset))))
   | Op.Ainstack a, nil => (* We need to be sure that the base address is aligned *)
     let a := Integers.Ptrofs.unsigned a in
-    if (check_address_parameter_unsigned a)
-    then ret (Vlit (ZToValue 32 a))
-    else error (Errors.msg "Veriloggen: translate_eff_addressing (Ainstack): address misaligned")
+    ret (Vlit (ZToValue a))
   | _, _ => error (Errors.msg "Veriloggen: translate_eff_addressing unsuported addressing")
   end.
 
@@ -341,20 +354,19 @@ Definition translate_instr (op : Op.operation) (args : list reg) : mon expr :=
   | Op.Oshlimm n, r::nil => ret (boplit Vshl r n)
   | Op.Oshr, r1::r2::nil => ret (bop Vshr r1 r2)
   | Op.Oshrimm n, r::nil => ret (boplit Vshr r n)
-  | Op.Oshrximm n, r::nil => ret (Vbinop Vdiv (Vvar r)
-                                         (Vbinop Vshl (Vlit (ZToValue 32 1))
-                                                 (Vlit (intToValue n))))
+  | Op.Oshrximm n, r::nil => error (Errors.msg "Htlgen: Instruction not implemented: Oshrximm")
+  (*ret (Vbinop Vdiv (Vvar r)
+    (Vbinop Vshl (Vlit (ZToValue 1))
+    (Vlit (intToValue n))))*)
   | Op.Oshru, r1::r2::nil => ret (bop Vshru r1 r2)
   | Op.Oshruimm n, r::nil => ret (boplit Vshru r n)
-  | Op.Ororimm n, r::nil => ret (Vbinop Vor (boplit Vshr r n) (boplit Vshl r (Integers.Int.sub (Integers.Int.repr 32) n)))
+  | Op.Ororimm n, r::nil => ret (boplit Vror r n)
   | Op.Oshldimm n, r::nil => ret (Vbinop Vor (boplit Vshl r n) (boplit Vshr r (Integers.Int.sub (Integers.Int.repr 32) n)))
   | Op.Ocmp c, _ => translate_condition c args
   | Op.Osel c AST.Tint, r1::r2::rl =>
     do tc <- translate_condition c rl;
     ret (Vternary tc (Vvar r1) (Vvar r2))
   | Op.Olea a, _ => translate_eff_addressing a args
-  | Op.Oleal a, _ => translate_eff_addressing a args (* FIXME: Need to be careful here; large arrays might fail? *)
-  | Op.Ocast32signed, r::nil => ret (Vvar r) (* FIXME: Don't need to sign extend for now since everything is 32 bit? *)
   | _, _ => error (Errors.msg "Htlgen: Instruction not implemented: other")
   end.
 
@@ -392,26 +404,38 @@ Definition add_branch_instr (e: expr) (n n1 n2: node) : mon unit :=
     | _, _ => Error (Errors.msg "Htlgen: add_branch_instr")
     end.
 
-Definition translate_arr_access (mem : AST.memory_chunk) (addr : Op.addressing)
-           (args : list reg) (stack : reg) : mon expr :=
-  match mem, addr, args with (* TODO: We should be more methodical here; what are the possibilities?*)
-  | Mint32, Op.Aindexed off, r1::nil =>
-    if (check_address_parameter_signed off)
-    then ret (Vvari stack (Vbinop Vdivu (boplitz Vadd r1 off) (Vlit (ZToValue 32 4))))
-    else error (Errors.msg "HTLgen: translate_arr_access address misaligned")
-  | Mint32, Op.Aindexed2scaled scale offset, r1::r2::nil => (* Typical for dynamic array addressing *)
-    if (check_address_parameter_signed scale) && (check_address_parameter_signed offset)
-    then ret (Vvari stack
-                    (Vbinop Vdivu
-                            (Vbinop Vadd (boplitz Vadd r1 offset) (boplitz Vmul r2 scale))
-                            (ZToValue 32 4)))
-    else error (Errors.msg "HTLgen: translate_arr_access address misaligned")
-  | Mint32, Op.Ainstack a, nil => (* We need to be sure that the base address is aligned *)
+(* Definition translate_arr_access (mem : AST.memory_chunk) (addr : Op.addressing) *)
+(*            (args : list reg) (stack : reg) : mon expr := *)
+(*   match mem, addr, args with (* TODO: We should be more methodical here; what are the possibilities?*) *)
+(*   | Mint32, Op.Aindexed off, r1::nil => *)
+(*     if (check_address_parameter_signed off) *)
+(*     then ret (Vvari stack (Vbinop Vdivu (boplitz Vadd r1 off) (Vlit (ZToValue 4)))) *)
+(*     else error (Errors.msg "HTLgen: translate_arr_access address misaligned") *)
+(*   | Mint32, Op.Aindexed2scaled scale offset, r1::r2::nil => (* Typical for dynamic array addressing *) *)
+(*     if (check_address_parameter_signed scale) && (check_address_parameter_signed offset) *)
+(*     then ret (Vvari stack *)
+(*                     (Vbinop Vdivu *)
+(*                             (Vbinop Vadd (boplitz Vadd r1 offset) (boplitz Vmul r2 scale)) *)
+(*                             (Vlit (ZToValue 4)))) *)
+(*     else error (Errors.msg "HTLgen: translate_arr_access address misaligned") *)
+(*   | Mint32, Op.Ainstack a, nil => (* We need to be sure that the base address is aligned *) *)
+(*     let a := Integers.Ptrofs.unsigned a in *)
+(*     if (check_address_parameter_unsigned a) *)
+(*     then ret (Vvari stack (Vlit (ZToValue (a / 4)))) *)
+(*     else error (Errors.msg "HTLgen: eff_addressing misaligned stack offset") *)
+(*   | _, _, _ => error (Errors.msg "HTLgen: translate_arr_access unsuported addressing") *)
+(*   end. *)
+
+Definition translate_arr_addressing (a: Op.addressing) (args: list reg) : mon expr :=
+  match a, args with (* TODO: We should be more methodical here; what are the possibilities?*)
+  | Op.Aindexed off, r1::nil =>
+    ret (boplitz Vadd r1 off)
+  | Op.Aindexed2scaled scale offset, r1::r2::nil => (* Typical for dynamic array addressing *)
+    ret (Vbinop Vadd (boplitz Vadd r1 offset) (boplitz Vmul r2 scale))
+  | Op.Ainstack a, nil => (* We need to be sure that the base address is aligned *)
     let a := Integers.Ptrofs.unsigned a in
-    if (check_address_parameter_unsigned a)
-    then ret (Vvari stack (Vlit (ZToValue 32 (a / 4))))
-    else error (Errors.msg "HTLgen: eff_addressing misaligned stack offset")
-  | _, _, _ => error (Errors.msg "HTLgen: translate_arr_access unsuported addressing")
+    ret (Vlit (ZToValue a))
+  | _, _ => error (Errors.msg "Veriloggen: translate_arr_addressing unsuported addressing")
   end.
 
 Fixpoint enumerate (i : nat) (ns : list node) {struct ns} : list (nat * node) :=
@@ -422,41 +446,70 @@ Fixpoint enumerate (i : nat) (ns : list node) {struct ns} : list (nat * node) :=
 
 Definition tbl_to_case_expr (st : reg) (ns : list node) : list (expr * stmnt) :=
   List.map (fun a => match a with
-                    (i, n) => (Vlit (natToValue 32 i), Vnonblock (Vvar st) (Vlit (posToValue 32 n)))
+                    (i, n) => (Vlit (natToValue i), Vnonblock (Vvar st) (Vlit (posToValue n)))
                   end)
            (enumerate 0 ns).
 
+Definition create_single_cycle_load (stack : reg) (addr : expr) (dst : reg) : stmnt :=
+  Vnonblock (Vvar dst) (Vload stack addr).
+
+Definition create_single_cycle_store (stack : reg) (addr : expr) (src : reg) : stmnt :=
+  let l0   := Vnonblock (Vvari stack addr) (Vvarb0 src) in
+  let l1   := Vnonblock (Vvari stack $ Vbinop Vadd addr (Vlit $ ZToValue 1)) (Vvarb1 src) in
+  let l2   := Vnonblock (Vvari stack $ Vbinop Vadd addr (Vlit $ ZToValue 2)) (Vvarb2 src) in
+  let l3   := Vnonblock (Vvari stack $ Vbinop Vadd addr (Vlit $ ZToValue 3)) (Vvarb3 src)
+  in Vseq l0 $ Vseq l1 $ Vseq l2 $ l3.
+
 Definition transf_instr (fin rtrn stack: reg) (ni: node * instruction) : mon unit :=
   match ni with
     (n, i) =>
     match i with
-    | Inop n' => add_instr n n' Vskip
+    | Inop n' =>
+      if Z.leb (Z.pos n') Integers.Int.max_unsigned then
+        add_instr n n' Vskip
+      else error (Errors.msg "State is larger than 2^32.")
     | Iop op args dst n' =>
-      do instr <- translate_instr op args;
-      do _ <- declare_reg None dst 32;
-      add_instr n n' (nonblock dst instr)
-    | Iload mem addr args dst n' =>
-      do src <- translate_arr_access mem addr args stack;
-      do _ <- declare_reg None dst 32;
-      add_instr n n' (nonblock dst src)
-    | Istore mem addr args src n' =>
-      do dst <- translate_arr_access mem addr args stack;
-      add_instr n n' (Vnonblock dst (Vvar src)) (* TODO: Could juse use add_instr? reg exists. *)
+      if Z.leb (Z.pos n') Integers.Int.max_unsigned then
+        do instr <- translate_instr op args;
+        do _ <- declare_reg None dst 32;
+        add_instr n n' (nonblock dst instr)
+      else error (Errors.msg "State is larger than 2^32.")
+    | Iload chunk addr args dst n' =>
+      match chunk with
+      | Mint32 =>
+        if Z.leb (Z.pos n') Integers.Int.max_unsigned
+        then do addr' <- translate_arr_addressing addr args;
+             do _ <- declare_reg None dst 32;
+             add_instr n n' $ create_single_cycle_load stack addr' dst
+        else error (Errors.msg "State is larger than 2^32.")
+      | _ => error (Errors.msg "Iload invalid chunk size.")
+      end
+    | Istore chunk addr args src n' =>
+      match chunk with
+      | Mint32 =>
+        if Z.leb (Z.pos n') Integers.Int.max_unsigned
+        then do addr' <- translate_arr_addressing addr args;
+             add_instr n n' $ create_single_cycle_store stack addr' src
+        else error (Errors.msg "State is larger than 2^32.")
+      | _ => error (Errors.msg "Istore invalid chunk size.")
+      end
     | Icall _ _ _ _ _ => error (Errors.msg "Calls are not implemented.")
     | Itailcall _ _ _ => error (Errors.msg "Tailcalls are not implemented.")
     | Ibuiltin _ _ _ _ => error (Errors.msg "Builtin functions not implemented.")
     | Icond cond args n1 n2 =>
-      do e <- translate_condition cond args;
-      add_branch_instr e n n1 n2
+      if Z.leb (Z.pos n1) Integers.Int.max_unsigned && Z.leb (Z.pos n2) Integers.Int.max_unsigned then
+        do e <- translate_condition cond args;
+        add_branch_instr e n n1 n2
+      else error (Errors.msg "State is larger than 2^32.")
     | Ijumptable r tbl =>
       do s <- get;
       add_node_skip n (Vcase (Vvar r) (tbl_to_case_expr s.(st_st) tbl) (Some Vskip))
     | Ireturn r =>
       match r with
       | Some r' =>
-        add_instr_skip n (Vseq (block fin (Vlit (ZToValue 1%nat 1%Z))) (block rtrn (Vvar r')))
+        add_instr_skip n (Vseq (block fin (Vlit (ZToValue 1%Z))) (block rtrn (Vvar r')))
       | None =>
-        add_instr_skip n (Vseq (block fin (Vlit (ZToValue 1%nat 1%Z))) (block rtrn (Vlit (ZToValue 1%nat 0%Z))))
+        add_instr_skip n (Vseq (block fin (Vlit (ZToValue 1%Z))) (block rtrn (Vlit (ZToValue 0%Z))))
       end
     end
   end.
@@ -512,32 +565,67 @@ Definition create_arr (i : option io) (sz : nat) (ln : nat) : mon (reg * nat) :=
 Definition stack_correct (sz : Z) : bool :=
   (0 <=? sz) && (sz <? Integers.Ptrofs.modulus) && (Z.modulo sz 4 =? 0).
 
+Definition max_pc_map (m : Maps.PTree.t stmnt) :=
+  PTree.fold (fun m pc i => Pos.max m pc) m 1%positive.
+
+Lemma max_pc_map_sound:
+  forall m pc i, m!pc = Some i -> Ple pc (max_pc_map m).
+Proof.
+  intros until i. unfold max_pc_function.
+  apply PTree_Properties.fold_rec with (P := fun c m => c!pc = Some i -> Ple pc m).
+  (* extensionality *)
+  intros. apply H0. rewrite H; auto.
+  (* base case *)
+  rewrite PTree.gempty. congruence.
+  (* inductive case *)
+  intros. rewrite PTree.gsspec in H2. destruct (peq pc k).
+  inv H2. xomega.
+  apply Ple_trans with a. auto. xomega.
+Qed.
+
+Lemma max_pc_wf :
+  forall m, Z.pos (max_pc_map m) <= Integers.Int.max_unsigned ->
+            map_well_formed m.
+Proof.
+  unfold map_well_formed. intros.
+  exploit list_in_map_inv. eassumption. intros [x [A B]]. destruct x.
+  apply Maps.PTree.elements_complete in B. apply max_pc_map_sound in B.
+  unfold Ple in B. apply Pos2Z.pos_le_pos in B. subst.
+  simplify. transitivity (Z.pos (max_pc_map m)); eauto.
+Qed.
+
 Definition transf_module (f: function) : mon module :=
   if stack_correct f.(fn_stacksize) then
-  do fin <- create_reg (Some Voutput) 1;
-  do rtrn <- create_reg (Some Voutput) 32;
-  do (stack, stack_len) <- create_arr None 32 (Z.to_nat (f.(fn_stacksize) / 4));
-  do _ <- collectlist (transf_instr fin rtrn stack) (Maps.PTree.elements f.(RTL.fn_code));
-  do _ <- collectlist (fun r => declare_reg (Some Vinput) r 32) f.(RTL.fn_params);
-  do start <- create_reg (Some Vinput) 1;
-  do rst <- create_reg (Some Vinput) 1;
-  do clk <- create_reg (Some Vinput) 1;
-  do current_state <- get;
-  ret (mkmodule
-         f.(RTL.fn_params)
-         current_state.(st_datapath)
-         current_state.(st_controllogic)
-         f.(fn_entrypoint)
-         current_state.(st_st)
-         stack
-         stack_len
-         fin
-         rtrn
-         start
-         rst
-         clk
-         current_state.(st_scldecls)
-         current_state.(st_arrdecls))
+    do fin <- create_reg (Some Voutput) 1;
+    do rtrn <- create_reg (Some Voutput) 32;
+    do (stack, stack_len) <- create_arr None 8 (Z.to_nat f.(fn_stacksize));
+    do _ <- collectlist (transf_instr fin rtrn stack) (Maps.PTree.elements f.(RTL.fn_code));
+    do _ <- collectlist (fun r => declare_reg (Some Vinput) r 32) f.(RTL.fn_params);
+    do start <- create_reg (Some Vinput) 1;
+    do rst <- create_reg (Some Vinput) 1;
+    do clk <- create_reg (Some Vinput) 1;
+    do current_state <- get;
+    match zle (Z.pos (max_pc_map current_state.(st_datapath))) Integers.Int.max_unsigned,
+          zle (Z.pos (max_pc_map current_state.(st_controllogic))) Integers.Int.max_unsigned with
+    | left LEDATA, left LECTRL =>
+        ret (mkmodule
+           f.(RTL.fn_params)
+           current_state.(st_datapath)
+           current_state.(st_controllogic)
+           f.(fn_entrypoint)
+           current_state.(st_st)
+           stack
+           stack_len
+           fin
+           rtrn
+           start
+           rst
+           clk
+           current_state.(st_scldecls)
+           current_state.(st_arrdecls)
+           (conj (max_pc_wf _ LECTRL) (max_pc_wf _ LEDATA)))
+    | _, _ => error (Errors.msg "More than 2^32 states.")
+    end
   else error (Errors.msg "Stack size misalignment.").
 
 Definition max_state (f: function) : state :=
diff --git a/src/translation/HTLgenproof.v b/src/translation/HTLgenproof.v
index 6e470d5..813a94b 100644
--- a/src/translation/HTLgenproof.v
+++ b/src/translation/HTLgenproof.v
@@ -16,9 +16,9 @@
  * along with this program.  If not, see <https://www.gnu.org/licenses/>.
  *)
 
-From compcert Require RTL Registers AST Integers.
-From compcert Require Import Globalenvs Memory.
-From coqup Require Import Coquplib HTLgenspec HTLgen Value AssocMap Array IntegerExtra ZExtra.
+From compcert Require RTL Registers AST.
+From compcert Require Import Integers Globalenvs Memory Linking.
+From coqup Require Import Coquplib HTLgenspec HTLgen ValueInt AssocMap Array IntegerExtra ZExtra.
 From coqup Require HTL Verilog.
 
 Require Import Lia.
@@ -41,7 +41,7 @@ Hint Constructors match_assocmaps : htlproof.
 Definition state_st_wf (m : HTL.module) (s : HTL.state) :=
   forall st asa asr res,
   s = HTL.State res m st asa asr ->
-  asa!(m.(HTL.mod_st)) = Some (posToValue 32 st).
+  asa!(m.(HTL.mod_st)) = Some (posToValue st).
 Hint Unfold state_st_wf : htlproof.
 
 Inductive match_arrs (m : HTL.module) (f : RTL.function) (sp : Values.val) (mem : mem) :
@@ -53,7 +53,7 @@ Inductive match_arrs (m : HTL.module) (f : RTL.function) (sp : Values.val) (mem
         0 <= ptr < Z.of_nat m.(HTL.mod_stk_len) ->
         opt_val_value_lessdef (Mem.loadv AST.Mint32 mem
                                          (Values.Val.offset_ptr sp (Integers.Ptrofs.repr (4 * ptr))))
-                              (Option.default (NToValue 32 0)
+                              (Option.default (NToValue 0)
                                  (Option.join (array_get_error (Z.to_nat ptr) stack)))) ->
     match_arrs m f sp mem asa.
 
@@ -86,18 +86,13 @@ Definition stack_bounds (sp : Values.val) (hi : Z) (m : mem) : Prop :=
 Inductive match_frames : list RTL.stackframe -> list HTL.stackframe -> Prop :=
 | match_frames_nil :
     match_frames nil nil.
-(* | match_frames_cons : *)
-(*     forall cs lr r f sp sp' pc rs m asr asa *)
-(*            (TF : tr_module f m) *)
-(*            (ST: match_frames mem cs lr) *)
-(*            (MA: match_assocmaps f rs asr) *)
-(*            (MARR : match_arrs m f sp mem asa) *)
-(*            (SP : sp = Values.Vptr sp' (Integers.Ptrofs.repr 0)) *)
-(*            (RSBP: reg_stack_based_pointers sp' rs) *)
-(*            (ASBP: arr_stack_based_pointers sp' mem (f.(RTL.fn_stacksize)) sp) *)
-(*            (BOUNDS : stack_bounds sp (f.(RTL.fn_stacksize)) mem), *)
-(*       match_frames mem (RTL.Stackframe r f sp pc rs :: cs) *)
-(*                        (HTL.Stackframe r m pc asr asa :: lr). *)
+
+Inductive match_constants : HTL.module -> assocmap -> Prop :=
+  match_constant :
+    forall m asr,
+      asr!(HTL.mod_reset m) = Some (ZToValue 0) ->
+      asr!(HTL.mod_finish m) = Some (ZToValue 0) ->
+      match_constants m asr.
 
 Inductive match_states : RTL.state -> HTL.state -> Prop :=
 | match_state : forall asa asr sf f sp sp' rs mem m st res
@@ -109,7 +104,8 @@ Inductive match_states : RTL.state -> HTL.state -> Prop :=
     (SP : sp = Values.Vptr sp' (Integers.Ptrofs.repr 0))
     (RSBP : reg_stack_based_pointers sp' rs)
     (ASBP : arr_stack_based_pointers sp' mem (f.(RTL.fn_stacksize)) sp)
-    (BOUNDS : stack_bounds sp (f.(RTL.fn_stacksize)) mem),
+    (BOUNDS : stack_bounds sp (f.(RTL.fn_stacksize)) mem)
+    (CONST : match_constants m asr),
     match_states (RTL.State sf f sp st rs mem)
                  (HTL.State res m st asr asa)
 | match_returnstate :
@@ -128,11 +124,30 @@ Definition match_prog (p: RTL.program) (tp: HTL.program) :=
   Linking.match_program (fun cu f tf => transl_fundef f = Errors.OK tf) eq p tp /\
   main_is_internal p = true.
 
-Definition match_prog_matches :
-  forall p tp,
-    match_prog p tp ->
-    Linking.match_program (fun cu f tf => transl_fundef f = Errors.OK tf) eq p tp.
-  Proof. intros. unfold match_prog in H. tauto. Qed.
+Instance TransfHTLLink (tr_fun: RTL.program -> Errors.res HTL.program):
+  TransfLink (fun (p1: RTL.program) (p2: HTL.program) => match_prog p1 p2).
+Proof.
+  red. intros. exfalso. destruct (link_linkorder _ _ _ H) as [LO1 LO2].
+  apply link_prog_inv in H.
+
+  unfold match_prog in *.
+  unfold main_is_internal in *. simplify. repeat (unfold_match H4).
+  repeat (unfold_match H3). simplify.
+  subst. rewrite H0 in *. specialize (H (AST.prog_main p2)).
+  exploit H.
+  apply Genv.find_def_symbol. exists b. split.
+  assumption. apply Genv.find_funct_ptr_iff. eassumption.
+  apply Genv.find_def_symbol. exists b0. split.
+  assumption. apply Genv.find_funct_ptr_iff. eassumption.
+  intros. inv H3. inv H5. destruct H6. inv H5.
+Qed.
+
+Definition match_prog' (p: RTL.program) (tp: HTL.program) :=
+  Linking.match_program (fun cu f tf => transl_fundef f = Errors.OK tf) eq p tp.
+
+Lemma match_prog_matches :
+  forall p tp, match_prog p tp -> match_prog' p tp.
+Proof. unfold match_prog. tauto. Qed.
 
 Lemma transf_program_match:
   forall p tp, HTLgen.transl_program p = Errors.OK tp -> match_prog p tp.
@@ -266,32 +281,6 @@ Proof.
   assumption.
 Qed.
 
-(* Need to eventually move posToValue 32 to posToValueAuto, as that has this proof. *)
-Lemma assumption_32bit :
-  forall v,
-    valueToPos (posToValue 32 v) = v.
-Admitted.
-
-Lemma st_greater_than_res :
-  forall m res : positive,
-    m <> res.
-Admitted.
-
-Lemma finish_not_return :
-  forall r f : positive,
-    r <> f.
-Admitted.
-
-Lemma finish_not_res :
-  forall f r : positive,
-    f <> r.
-Admitted.
-
-Lemma greater_than_max_func :
-  forall f st,
-    Plt (RTL.max_reg_function f) st.
-Proof. Admitted.
-
 Ltac inv_state :=
   match goal with
     MSTATE : match_states _ _ |- _ =>
@@ -353,1818 +342,1943 @@ Section CORRECTNESS.
 
   Hypothesis TRANSL : match_prog prog tprog.
 
-  Lemma TRANSL' :
-    Linking.match_program (fun cu f tf => transl_fundef f = Errors.OK tf) eq prog tprog.
-  Proof. intros; apply match_prog_matches; assumption. Qed.
-
-  Let ge : RTL.genv := Globalenvs.Genv.globalenv prog.
-  Let tge : HTL.genv := Globalenvs.Genv.globalenv tprog.
-
-  Lemma symbols_preserved:
-    forall (s: AST.ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-  Proof. intros. eapply (Genv.find_symbol_match TRANSL'). Qed.
-
-  Lemma function_ptr_translated:
-    forall (b: Values.block) (f: RTL.fundef),
-      Genv.find_funct_ptr ge b = Some f ->
-      exists tf,
-        Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = Errors.OK tf.
-  Proof.
-    intros. exploit (Genv.find_funct_ptr_match TRANSL'); eauto.
-    intros (cu & tf & P & Q & R); exists tf; auto.
-  Qed.
-
-  Lemma functions_translated:
-    forall (v: Values.val) (f: RTL.fundef),
-      Genv.find_funct ge v = Some f ->
-      exists tf,
-        Genv.find_funct tge v = Some tf /\ transl_fundef f = Errors.OK tf.
-  Proof.
-    intros. exploit (Genv.find_funct_match TRANSL'); eauto.
-    intros (cu & tf & P & Q & R); exists tf; auto.
-  Qed.
-
-  Lemma senv_preserved:
-    Senv.equiv (Genv.to_senv ge) (Genv.to_senv tge).
-  Proof
-    (Genv.senv_transf_partial TRANSL').
-  Hint Resolve senv_preserved : htlproof.
-
-  Lemma eval_correct :
-    forall sp op rs args m v v' e asr asa f s s' i,
-      Op.eval_operation ge sp op
-(List.map (fun r : BinNums.positive => Registers.Regmap.get r rs) args) m = Some v ->
-      translate_instr op args s = OK e s' i ->
-      val_value_lessdef v v' ->
-      Verilog.expr_runp f asr asa e v'.
-  Admitted.
-
-  Lemma eval_cond_correct :
-    forall cond (args : list Registers.reg) s1 c s' i rs args m b f asr asa,
-    translate_condition cond args s1 = OK c s' i ->
-    Op.eval_condition
-      cond
-      (List.map (fun r : BinNums.positive => Registers.Regmap.get r rs) args)
-      m = Some b ->
-    Verilog.expr_runp f asr asa c (boolToValue 32 b).
-  Admitted.
-
-  (** The proof of semantic preservation for the translation of instructions
-      is a simulation argument based on diagrams of the following form:
-<<
-                      match_states
-    code st rs ---------------- State m st assoc
-         ||                             |
-         ||                             |
-         ||                             |
-         \/                             v
-    code st rs' --------------- State m st assoc'
-                      match_states
->>
-      where [tr_code c data control fin rtrn st] is assumed to hold.
-
-      The precondition and postcondition is that that should hold is [match_assocmaps rs assoc].
-   *)
-
-  Definition transl_instr_prop (instr : RTL.instruction) : Prop :=
-    forall m asr asa fin rtrn st stmt trans res,
-      tr_instr fin rtrn st (m.(HTL.mod_stk)) instr stmt trans ->
-      exists asr' asa',
-        HTL.step tge (HTL.State res m st asr asa) Events.E0 (HTL.State res m st asr' asa').
-
-  Opaque combine.
-
-  Ltac tac0 :=
-    match goal with
-    | [ |- context[valueToPos (posToValue 32 _)] ] => rewrite assumption_32bit
-
-    | [ |- context[Verilog.merge_arrs _ _] ] => unfold Verilog.merge_arrs
-    | [ |- context[Verilog.merge_arr] ] => unfold Verilog.merge_arr
-    | [ |- context[Verilog.merge_regs _ _] ] => unfold Verilog.merge_regs; crush; unfold_merge
-    | [ |- context[reg_stack_based_pointers] ] => unfold reg_stack_based_pointers; intros
-    | [ |- context[Verilog.arr_assocmap_set _ _ _ _] ] => unfold Verilog.arr_assocmap_set
-
-    | [ |- context[HTL.empty_stack] ] => unfold HTL.empty_stack
-
-    | [ |- context[_ # ?d <- _ ! ?d] ] => rewrite AssocMap.gss
-    | [ |- context[_ # ?d <- _ ! ?s] ] => rewrite AssocMap.gso
-    | [ |- context[(AssocMap.empty _) ! _] ] => rewrite AssocMap.gempty
-
-    | [ |- context[array_get_error _ (combine Verilog.merge_cell (arr_repeat None _) _)] ] =>
-      rewrite combine_lookup_first
-
-    | [ |- state_st_wf _ _ ] => unfold state_st_wf; inversion 1
-    | [ |- context[match_states _ _] ] => econstructor; auto
-    | [ |- match_arrs _ _ _ _ _ ] => econstructor; auto
-    | [ |- match_assocmaps _ _ _ # _ <- (posToValue 32 _) ] =>
-      apply regs_lessdef_add_greater; [> apply greater_than_max_func | assumption]
-
-    | [ H : ?asa ! ?r = Some _ |- Verilog.arr_assocmap_lookup ?asa ?r _ = Some _ ] =>
-      unfold Verilog.arr_assocmap_lookup; setoid_rewrite H; f_equal
-    | [ |- context[(AssocMap.combine _ _ _) ! _] ] =>
-      try (rewrite AssocMap.gcombine; [> | reflexivity])
-
-    | [ |- context[Registers.Regmap.get ?d (Registers.Regmap.set ?d _ _)] ] =>
-      rewrite Registers.Regmap.gss
-    | [ |- context[Registers.Regmap.get ?s (Registers.Regmap.set ?d _ _)] ] =>
-      destruct (Pos.eq_dec s d) as [EQ|EQ];
-      [> rewrite EQ | rewrite Registers.Regmap.gso; auto]
-
-    | [ H : opt_val_value_lessdef _ _ |- _ ] => invert H
-    | [ H : context[Z.of_nat (Z.to_nat _)] |- _ ] => rewrite Z2Nat.id in H; [> solve crush |]
-    | [ H : _ ! _ = Some _ |- _] => setoid_rewrite H
-    end.
-
-  Ltac small_tac := repeat (crush; try array; try ptrofs); crush; auto.
-  Ltac big_tac := repeat (crush; try array; try ptrofs; try tac0); crush; auto.
-
-  Lemma transl_inop_correct:
-    forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive)
-      (rs : RTL.regset) (m : mem) (pc' : RTL.node),
-      (RTL.fn_code f) ! pc = Some (RTL.Inop pc') ->
-      forall R1 : HTL.state,
-        match_states (RTL.State s f sp pc rs m) R1 ->
-        exists R2 : HTL.state,
-          Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m) R2.
-  Proof.
-    intros s f sp pc rs m pc' H R1 MSTATE.
-    inv_state.
-
-    unfold match_prog in TRANSL.
-    econstructor.
-    split.
-    apply Smallstep.plus_one.
-    eapply HTL.step_module; eauto.
-    apply assumption_32bit.
-    (* processing of state *)
-    econstructor.
-    crush.
-    econstructor.
-    econstructor.
-    econstructor.
-
-    all: invert MARR; big_tac.
-    Unshelve.
-    constructor.
-  Qed.
-  Hint Resolve transl_inop_correct : htlproof.
-
-  Lemma transl_iop_correct:
-    forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive)
-      (rs : Registers.Regmap.t Values.val) (m : mem) (op : Op.operation) (args : list Registers.reg)
-      (res0 : Registers.reg) (pc' : RTL.node) (v : Values.val),
-      (RTL.fn_code f) ! pc = Some (RTL.Iop op args res0 pc') ->
-      Op.eval_operation ge sp op (map (fun r : positive => Registers.Regmap.get r rs) args) m = Some v ->
-      forall R1 : HTL.state,
-        match_states (RTL.State s f sp pc rs m) R1 ->
-        exists R2 : HTL.state,
-          Smallstep.plus HTL.step tge R1 Events.E0 R2 /\
-          match_states (RTL.State s f sp pc' (Registers.Regmap.set res0 v rs) m) R2.
-  Proof.
-    intros s f sp pc rs m op args res0 pc' v H H0.
-
-    (* Iop *)
-    (* destruct v eqn:?; *)
-    (*          try ( *)
-    (*            destruct op eqn:?; inversion H21; simpl in H0; repeat (unfold_match H0); *)
-    (*            inversion H0; subst; simpl in *; try (unfold_func H4); try (unfold_func H5); *)
-    (*            try (unfold_func H6); *)
-    (*            try (unfold Op.eval_addressing32 in H6; repeat (unfold_match H6); inversion H6; *)
-    (*                 unfold_func H3); *)
-
-    (*            inversion Heql; inversion MASSOC; subst; *)
-    (*            assert (HPle : Ple r (RTL.max_reg_function f)) *)
-    (*              by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
-    (*            apply H1 in HPle; inversion HPle; *)
-    (*            rewrite H2 in *; discriminate *)
-    (*          ). *)
-
-    (* + econstructor. split. *)
-    (* apply Smallstep.plus_one. *)
-    (* eapply HTL.step_module; eauto. *)
-    (* econstructor; simpl; trivial. *)
-    (* constructor; trivial. *)
-    (* econstructor; simpl; eauto. *)
-    (* eapply eval_correct; eauto. constructor. *)
-    (* unfold_merge. simpl. *)
-    (* rewrite AssocMap.gso. *)
-    (* apply AssocMap.gss. *)
-    (* apply st_greater_than_res. *)
-
-    (* (* match_states *) *)
-    (* assert (pc' = valueToPos (posToValue 32 pc')). auto using assumption_32bit. *)
-    (* rewrite <- H1. *)
-    (* constructor; auto. *)
-    (* unfold_merge. *)
-    (* apply regs_lessdef_add_match. *)
-    (* constructor. *)
-    (* apply regs_lessdef_add_greater. *)
-    (* apply greater_than_max_func. *)
-    (* assumption. *)
-
-    (* unfold state_st_wf. intros. inversion H2. subst. *)
-    (* unfold_merge. *)
-    (* rewrite AssocMap.gso. *)
-    (* apply AssocMap.gss. *)
-    (* apply st_greater_than_res. *)
-
-    (* + econstructor. split. *)
-    (* apply Smallstep.plus_one. *)
-    (* eapply HTL.step_module; eauto. *)
-    (* econstructor; simpl; trivial. *)
-    (* constructor; trivial. *)
-    (* econstructor; simpl; eauto. *)
-    (* eapply eval_correct; eauto. *)
-    (* constructor. rewrite valueToInt_intToValue. trivial. *)
-    (* unfold_merge. simpl. *)
-    (* rewrite AssocMap.gso. *)
-    (* apply AssocMap.gss. *)
-    (* apply st_greater_than_res. *)
-
-    (* (* match_states *) *)
-    (* assert (pc' = valueToPos (posToValue 32 pc')). auto using assumption_32bit. *)
-    (* rewrite <- H1. *)
-    (* constructor. *)
-    (* unfold_merge. *)
-    (* apply regs_lessdef_add_match. *)
-    (* constructor. *)
-    (* symmetry. apply valueToInt_intToValue. *)
-    (* apply regs_lessdef_add_greater. *)
-    (* apply greater_than_max_func. *)
-    (* assumption. assumption. *)
-
-    (* unfold state_st_wf. intros. inversion H2. subst. *)
-    (* unfold_merge. *)
-    (* rewrite AssocMap.gso. *)
-    (* apply AssocMap.gss. *)
-    (* apply st_greater_than_res. *)
-    (* assumption. *)
-  Admitted.
-  Hint Resolve transl_iop_correct : htlproof.
-
-  Ltac tac :=
-    repeat match goal with
-           | [ _ : error _ _ = OK _ _ _ |- _ ] => discriminate
-           | [ _ : context[if (?x && ?y) then _ else _] |- _ ] =>
-             let EQ1 := fresh "EQ" in
-             let EQ2 := fresh "EQ" in
-             destruct x eqn:EQ1; destruct y eqn:EQ2; simpl in *
-           | [ _ : context[if ?x then _ else _] |- _ ] =>
-             let EQ := fresh "EQ" in
-             destruct x eqn:EQ; simpl in *
-           | [ H : ret _ _ = _  |- _ ] => invert H
-           | [ _ : context[match ?x with | _ => _ end] |- _ ] => destruct x
-           end.
-
-  Ltac inv_arr_access :=
-    match goal with
-    | [ _ : translate_arr_access ?chunk ?addr ?args _ _ = OK ?c _ _ |- _] =>
-      destruct c, chunk, addr, args; crush; tac; crush
-    end.
-
-  Lemma transl_iload_correct:
-    forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive)
-      (rs : Registers.Regmap.t Values.val) (m : mem) (chunk : AST.memory_chunk)
-      (addr : Op.addressing) (args : list Registers.reg) (dst : Registers.reg)
-      (pc' : RTL.node) (a v : Values.val),
-      (RTL.fn_code f) ! pc = Some (RTL.Iload chunk addr args dst pc') ->
-      Op.eval_addressing ge sp addr (map (fun r : positive => Registers.Regmap.get r rs) args) = Some a ->
-      Mem.loadv chunk m a = Some v ->
-      forall R1 : HTL.state,
-        match_states (RTL.State s f sp pc rs m) R1 ->
-        exists R2 : HTL.state,
-          Smallstep.plus HTL.step tge R1 Events.E0 R2 /\
-          match_states (RTL.State s f sp pc' (Registers.Regmap.set dst v rs) m) R2.
-  Proof.
-    intros s f sp pc rs m chunk addr args dst pc' a v H H0 H1 R1 MSTATE.
-    inv_state. inv_arr_access.
-
-    + (** Preamble *)
-      invert MARR. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-
-      unfold reg_stack_based_pointers in RSBP.
-      pose proof (RSBP r0) as RSBPr0.
-
-      destruct (Registers.Regmap.get r0 rs) eqn:EQr0; crush.
-
-      rewrite ARCHI in H1. crush.
-      subst.
-
-      pose proof MASSOC as MASSOC'.
-      invert MASSOC'.
-      pose proof (H0 r0).
-      assert (HPler0 : Ple r0 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; crush; eauto).
-      apply H6 in HPler0.
-      invert HPler0; try congruence.
-      rewrite EQr0 in H8.
-      invert H8.
-      clear H0. clear H6.
-
-      unfold check_address_parameter_signed in *;
-      unfold check_address_parameter_unsigned in *; crush.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (valueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { rewrite HeqOFFSET.
-        apply PtrofsExtra.add_mod; crush; try lia.
-        exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *)
-        rewrite Integers.Ptrofs.signed_repr; try assumption.
-        admit. (* FIXME: Register bounds. *)
-        apply PtrofsExtra.of_int_mod.
-        rewrite Integers.Int.signed_repr; crush. }
-
-      (** Read bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); auto.
-        split; try lia; apply Integers.Ptrofs.unsigned_range_2.
-        small_tac. }
-
-      (** Normalisation proof *)
-      assert (Integers.Ptrofs.repr
-                (4 * Integers.Ptrofs.unsigned
-                       (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET)
-        as NORMALISE.
-      { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity.
-        rewrite <- PtrofsExtra.mul_unsigned.
-        apply PtrofsExtra.mul_divu; crush; auto. }
-
-      (** Normalised bounds proof *)
-      assert (0 <=
-              Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))
-              < (RTL.fn_stacksize f / 4))
-        as NORMALISE_BOUND.
-      { split.
-        apply Integers.Ptrofs.unsigned_range_2.
-        assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity.
-        unfold Integers.Ptrofs.divu at 2 in H0.
-        rewrite H0. clear H0.
-        rewrite Integers.Ptrofs.unsigned_repr; crush.
-        apply Zmult_lt_reg_r with (p := 4); try lia.
-        repeat rewrite ZLib.div_mul_undo; try lia.
-        apply Z.div_pos; small_tac.
-        apply Z.div_le_upper_bound; small_tac. }
-
-      inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ];
-      clear NORMALISE_BOUND.
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      apply assumption_32bit.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-
-      all: big_tac.
-
-      1: { apply st_greater_than_res. }
-      2: { apply st_greater_than_res. }
-
-      (** Match assocmaps *)
-      apply regs_lessdef_add_match; big_tac.
-
-      (** Equality proof *)
-      match goal with
-      | [ |- context [valueToNat ?x] ] =>
-        assert (Z.to_nat
-                  (Integers.Ptrofs.unsigned
-                     (Integers.Ptrofs.divu
-                        OFFSET
-                        (Integers.Ptrofs.repr 4)))
-                =
-                valueToNat x)
-          as EXPR_OK by admit
-      end.
-      rewrite <- EXPR_OK.
-
-      specialize (H7 (Integers.Ptrofs.unsigned
-                        (Integers.Ptrofs.divu
-                           OFFSET
-                           (Integers.Ptrofs.repr 4)))).
-      exploit H7; big_tac.
-
-      (** RSBP preservation *)
-      unfold arr_stack_based_pointers in ASBP.
-      specialize (ASBP (Integers.Ptrofs.unsigned
-                          (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))).
-      exploit ASBP; big_tac.
-      rewrite NORMALISE in H0. rewrite H1 in H0. assumption.
-
-    + (** Preamble *)
-      invert MARR. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-
-      unfold reg_stack_based_pointers in RSBP.
-      pose proof (RSBP r0) as RSBPr0.
-      pose proof (RSBP r1) as RSBPr1.
-
-      destruct (Registers.Regmap.get r0 rs) eqn:EQr0;
-      destruct (Registers.Regmap.get r1 rs) eqn:EQr1; crush.
-
-      rewrite ARCHI in H1. crush.
-      subst.
-      clear RSBPr1.
-
-      pose proof MASSOC as MASSOC'.
-      invert MASSOC'.
-      pose proof (H0 r0).
-      pose proof (H0 r1).
-      assert (HPler0 : Ple r0 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; crush; eauto).
-      assert (HPler1 : Ple r1 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto).
-      apply H6 in HPler0.
-      apply H8 in HPler1.
-      invert HPler0; invert HPler1; try congruence.
-      rewrite EQr0 in H10.
-      rewrite EQr1 in H12.
-      invert H10. invert H12.
-      clear H0. clear H6. clear H8.
-
-      unfold check_address_parameter_signed in *;
-      unfold check_address_parameter_unsigned in *; crush.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (valueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int
-                                       (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z))
-                                                         (Integers.Int.repr z0)))) as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { rewrite HeqOFFSET.
-        apply PtrofsExtra.add_mod; crush; try lia.
-        exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *)
-        rewrite Integers.Ptrofs.signed_repr; try assumption.
-        admit. (* FIXME: Register bounds. *)
-        apply PtrofsExtra.of_int_mod.
-        apply IntExtra.add_mod; crush; try lia.
-        exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *)
-        apply IntExtra.mul_mod; crush; try lia.
-        exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *)
-        admit. (* FIXME: Register bounds. *)
-        rewrite Integers.Int.signed_repr; crush.
-        rewrite Integers.Int.signed_repr; crush. }
-
-      (** Read bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); auto.
-        split; try lia; apply Integers.Ptrofs.unsigned_range_2.
-        small_tac. }
-
-      (** Normalisation proof *)
-      assert (Integers.Ptrofs.repr
-                (4 * Integers.Ptrofs.unsigned
-                       (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET)
-        as NORMALISE.
-      { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity.
-        rewrite <- PtrofsExtra.mul_unsigned.
-        apply PtrofsExtra.mul_divu; crush. }
-
-      (** Normalised bounds proof *)
-      assert (0 <=
-              Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))
-              < (RTL.fn_stacksize f / 4))
-        as NORMALISE_BOUND.
-      { split.
-        apply Integers.Ptrofs.unsigned_range_2.
-        assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity.
-        unfold Integers.Ptrofs.divu at 2 in H0.
-        rewrite H0. clear H0.
-        rewrite Integers.Ptrofs.unsigned_repr; crush.
-        apply Zmult_lt_reg_r with (p := 4); try lia.
-        repeat rewrite ZLib.div_mul_undo; try lia.
-        apply Z.div_pos; small_tac.
-        apply Z.div_le_upper_bound; lia. }
-
-      inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ];
-      clear NORMALISE_BOUND.
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      apply assumption_32bit.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor.
-      eapply Verilog.erun_Vbinop with (EQ := ?[EQ6]).
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor.
-
-      all: big_tac.
-
-      1: { apply st_greater_than_res. }
-      2: { apply st_greater_than_res. }
-
-      (** Match assocmaps *)
-      apply regs_lessdef_add_match; big_tac.
-
-      (** Equality proof *)
-      match goal with
-      | [ |- context [valueToNat ?x] ] =>
-        assert (Z.to_nat
-                  (Integers.Ptrofs.unsigned
-                     (Integers.Ptrofs.divu
-                        OFFSET
-                        (Integers.Ptrofs.repr 4)))
-                =
-                valueToNat x)
-          as EXPR_OK by admit
-      end.
-      rewrite <- EXPR_OK.
-
-      specialize (H7 (Integers.Ptrofs.unsigned
-                        (Integers.Ptrofs.divu
-                           OFFSET
-                           (Integers.Ptrofs.repr 4)))).
-      exploit H7; big_tac.
-
-      (** RSBP preservation *)
-      unfold arr_stack_based_pointers in ASBP.
-      specialize (ASBP (Integers.Ptrofs.unsigned
-                          (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))).
-      exploit ASBP; big_tac.
-      rewrite NORMALISE in H0. rewrite H1 in H0. assumption.
-
-    + invert MARR. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-      rewrite ARCHI in H0. crush.
-
-      unfold check_address_parameter_unsigned in *;
-      unfold check_address_parameter_signed in *; crush.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      rewrite ZERO in H1. clear ZERO.
-      rewrite Integers.Ptrofs.add_zero_l in H1.
-
-      remember i0 as OFFSET.
-
-      (** Modular preservation proof *)
-      rename H0 into MOD_PRESERVE.
-
-      (** Read bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); big_tac. }
-
-      (** Normalisation proof *)
-      assert (Integers.Ptrofs.repr
-                (4 * Integers.Ptrofs.unsigned
-                       (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET)
-        as NORMALISE.
-      { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity.
-        rewrite <- PtrofsExtra.mul_unsigned.
-        apply PtrofsExtra.mul_divu; crush. }
-
-      (** Normalised bounds proof *)
-      assert (0 <=
-              Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))
-              < (RTL.fn_stacksize f / 4))
-        as NORMALISE_BOUND.
-      { split.
-        apply Integers.Ptrofs.unsigned_range_2.
-        assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity.
-        unfold Integers.Ptrofs.divu at 2 in H0.
-        rewrite H0. clear H0.
-        rewrite Integers.Ptrofs.unsigned_repr; crush.
-        apply Zmult_lt_reg_r with (p := 4); try lia.
-        repeat rewrite ZLib.div_mul_undo; try lia.
-        apply Z.div_pos; small_tac.
-        apply Z.div_le_upper_bound; lia. }
-
-      inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ];
-      clear NORMALISE_BOUND.
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      apply assumption_32bit.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor. econstructor. econstructor. crush.
-
-      all: big_tac.
-
-      1: { apply st_greater_than_res. }
-      2: { apply st_greater_than_res. }
-
-      (** Match assocmaps *)
-      apply regs_lessdef_add_match; big_tac.
-
-      (** Equality proof *)
-      match goal with
-      | [ |- context [valueToNat ?x] ] =>
-        assert (Z.to_nat
-                  (Integers.Ptrofs.unsigned
-                     (Integers.Ptrofs.divu
-                        OFFSET
-                        (Integers.Ptrofs.repr 4)))
-                =
-                valueToNat x)
-          as EXPR_OK by admit
-      end.
-      rewrite <- EXPR_OK.
-
-      specialize (H7 (Integers.Ptrofs.unsigned
-                        (Integers.Ptrofs.divu
-                           OFFSET
-                           (Integers.Ptrofs.repr 4)))).
-      exploit H7; big_tac.
-
-      (** RSBP preservation *)
-      unfold arr_stack_based_pointers in ASBP.
-      specialize (ASBP (Integers.Ptrofs.unsigned
-                          (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))).
-      exploit ASBP; big_tac.
-      rewrite NORMALISE in H0. rewrite H1 in H0. assumption.
-  Admitted.
-  Hint Resolve transl_iload_correct : htlproof.
-
-  Lemma transl_istore_correct:
-    forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive)
-      (rs : Registers.Regmap.t Values.val) (m : mem) (chunk : AST.memory_chunk)
-      (addr : Op.addressing) (args : list Registers.reg) (src : Registers.reg)
-      (pc' : RTL.node) (a : Values.val) (m' : mem),
-      (RTL.fn_code f) ! pc = Some (RTL.Istore chunk addr args src pc') ->
-      Op.eval_addressing ge sp addr (map (fun r : positive => Registers.Regmap.get r rs) args) = Some a ->
-      Mem.storev chunk m a (Registers.Regmap.get src rs) = Some m' ->
-      forall R1 : HTL.state,
-        match_states (RTL.State s f sp pc rs m) R1 ->
-        exists R2 : HTL.state,
-          Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m') R2.
-  Proof.
-    intros s f sp pc rs m chunk addr args src pc' a m' H H0 H1 R1 MSTATES.
-    inv_state. inv_arr_access.
-
-    + (** Preamble *)
-      invert MARR. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-
-      unfold reg_stack_based_pointers in RSBP.
-      pose proof (RSBP r0) as RSBPr0.
-
-      destruct (Registers.Regmap.get r0 rs) eqn:EQr0; crush.
-
-      rewrite ARCHI in H1. crush.
-      subst.
-
-      pose proof MASSOC as MASSOC'.
-      invert MASSOC'.
-      pose proof (H0 r0).
-      assert (HPler0 : Ple r0 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; crush; eauto).
-      apply H6 in HPler0.
-      invert HPler0; try congruence.
-      rewrite EQr0 in H8.
-      invert H8.
-      clear H0. clear H6.
-
-      unfold check_address_parameter_unsigned in *;
-      unfold check_address_parameter_signed in *; crush.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (valueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { rewrite HeqOFFSET.
-        apply PtrofsExtra.add_mod; crush; try lia.
-        exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *)
-        rewrite Integers.Ptrofs.signed_repr; try assumption.
-        admit. (* FIXME: Register bounds. *)
-        apply PtrofsExtra.of_int_mod.
-        rewrite Integers.Int.signed_repr; crush. }
-
-      (** Write bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); big_tac.
-        apply Integers.Ptrofs.unsigned_range_2. }
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      apply assumption_32bit.
-      econstructor. econstructor. econstructor.
-      eapply Verilog.stmnt_runp_Vnonblock_arr. crush.
-      econstructor.
-      eapply Verilog.erun_Vbinop with (EQ := ?[EQ7]).
-      eapply Verilog.erun_Vbinop with (EQ := ?[EQ8]).
-      econstructor.
-      econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-
-      all: crush.
-
-      (** State Lookup *)
-      unfold Verilog.merge_regs.
-      crush.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Match states *)
-      rewrite assumption_32bit.
-      econstructor; eauto.
-
-      (** Match assocmaps *)
-      unfold Verilog.merge_regs. crush. unfold_merge.
-      apply regs_lessdef_add_greater. apply greater_than_max_func.
-      assumption.
-
-      (** States well formed *)
-      unfold state_st_wf. inversion 1. crush.
-      unfold Verilog.merge_regs.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Equality proof *)
-      match goal with
-      | [ |- context [valueToNat ?x] ] =>
-        assert (Z.to_nat
-                  (Integers.Ptrofs.unsigned
-                     (Integers.Ptrofs.divu
-                        OFFSET
-                        (Integers.Ptrofs.repr 4)))
-                =
-                valueToNat x)
-          as EXPR_OK by admit
-      end.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET.
-
-      econstructor.
-      repeat split; crush.
-      unfold HTL.empty_stack.
-      crush.
-      unfold Verilog.merge_arrs.
-
-      rewrite AssocMap.gcombine.
-      2: { reflexivity. }
-      unfold Verilog.arr_assocmap_set.
-      rewrite AssocMap.gss.
-      unfold Verilog.merge_arr.
-      rewrite AssocMap.gss.
-      setoid_rewrite H5.
-      reflexivity.
-
-      rewrite combine_length.
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      apply list_repeat_len.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len.
-      rewrite H4. reflexivity.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (valueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET.
-
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      constructor.
-      erewrite combine_lookup_second.
-      simpl.
-      assert (Ple src (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto);
-      apply H0 in H13.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; invert H13; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-
-      assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption).
-      rewrite Z.mul_comm in H13.
-      rewrite Z_div_mult in H13; try lia.
-      replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H13 by reflexivity.
-      rewrite <- PtrofsExtra.divu_unsigned in H13; unfold_constants; try lia.
-      rewrite H13. rewrite EXPR_OK.
-      rewrite array_get_error_set_bound.
-      reflexivity.
-      unfold arr_length, arr_repeat. simpl.
-      rewrite list_repeat_len. lia.
-
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           rewrite Z2Nat.id in H19; try lia.
-           apply Zmult_lt_compat_r with (p := 4) in H19; try lia.
-           rewrite ZLib.div_mul_undo in H19; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-
-      rewrite <- EXPR_OK.
-      rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia).
-      destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4).
-      apply Z.mul_cancel_r with (p := 4) in e; try lia.
-      rewrite ZLib.div_mul_undo in e; try lia.
-      rewrite combine_lookup_first.
-      eapply H7; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-      rewrite array_gso.
-      unfold array_get_error.
-      unfold arr_repeat.
-      crush.
-      apply list_repeat_lookup.
-      lia.
-      unfold_constants.
-      intro.
-      apply Z2Nat.inj_iff in H13; try lia.
-      apply Z.div_pos; try lia.
-      apply Integers.Ptrofs.unsigned_range.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      unfold arr_stack_based_pointers.
-      intros.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      crush.
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      crush.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor.
-      destruct (Archi.ptr64); try discriminate.
-      pose proof (RSBP src). rewrite EQ_SRC in H0.
-      assumption.
-
-      simpl.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           invert H0.
-           apply Zmult_lt_compat_r with (p := 4) in H14; try lia.
-           rewrite ZLib.div_mul_undo in H14; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-      apply ASBP; assumption.
-
-      unfold stack_bounds in *. intros.
-      simpl.
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right. right. simpl.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr; crush; try lia.
-           apply ZExtra.mod_0_bounds; crush; try lia. }
-      crush.
-      exploit (BOUNDS ptr); try lia. intros. crush.
-      exploit (BOUNDS ptr v); try lia. intros.
-      invert H0.
-      match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity.
-      assert (Mem.valid_access m AST.Mint32 sp'
-                               (Integers.Ptrofs.unsigned
-                                  (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                       (Integers.Ptrofs.repr ptr))) Writable).
-      { pose proof H1. eapply Mem.store_valid_access_2 in H0.
-        exact H0. eapply Mem.store_valid_access_3. eassumption. }
-      pose proof (Mem.valid_access_store m AST.Mint32 sp'
-                                         (Integers.Ptrofs.unsigned
-                                            (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                                 (Integers.Ptrofs.repr ptr))) v).
-      apply X in H0. invert H0. congruence.
-
-    + (** Preamble *)
-      invert MARR. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-
-      unfold reg_stack_based_pointers in RSBP.
-      pose proof (RSBP r0) as RSBPr0.
-      pose proof (RSBP r1) as RSBPr1.
-
-      destruct (Registers.Regmap.get r0 rs) eqn:EQr0;
-      destruct (Registers.Regmap.get r1 rs) eqn:EQr1; crush.
-
-      rewrite ARCHI in H1. crush.
-      subst.
-      clear RSBPr1.
-
-      pose proof MASSOC as MASSOC'.
-      invert MASSOC'.
-      pose proof (H0 r0).
-      pose proof (H0 r1).
-      assert (HPler0 : Ple r0 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; crush; eauto).
-      assert (HPler1 : Ple r1 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto).
-      apply H6 in HPler0.
-      apply H8 in HPler1.
-      invert HPler0; invert HPler1; try congruence.
-      rewrite EQr0 in H10.
-      rewrite EQr1 in H12.
-      invert H10. invert H12.
-      clear H0. clear H6. clear H8.
-
-      unfold check_address_parameter_signed in *;
-      unfold check_address_parameter_unsigned in *; crush.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (valueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int
-                                       (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z))
-                                                         (Integers.Int.repr z0)))) as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { rewrite HeqOFFSET.
-        apply PtrofsExtra.add_mod; crush; try lia.
-        exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *)
-        rewrite Integers.Ptrofs.signed_repr; try assumption.
-        admit. (* FIXME: Register bounds. *)
-        apply PtrofsExtra.of_int_mod.
-        apply IntExtra.add_mod; crush; try lia.
-        exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *)
-        apply IntExtra.mul_mod; crush; try lia.
-        exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *)
-        admit. (* FIXME: Register bounds. *)
-        rewrite Integers.Int.signed_repr; crush; try split; try assumption.
-        rewrite Integers.Int.signed_repr; crush; try split; try assumption.
-      }
-
-      (** Write bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); auto.
-        split; try lia; apply Integers.Ptrofs.unsigned_range_2.
-        small_tac. }
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      apply assumption_32bit.
-      econstructor. econstructor. econstructor.
-      eapply Verilog.stmnt_runp_Vnonblock_arr. crush.
-      econstructor.
-      eapply Verilog.erun_Vbinop with (EQ := ?[EQ9]).
-      eapply Verilog.erun_Vbinop with (EQ := ?[EQ10]).
-      eapply Verilog.erun_Vbinop with (EQ := ?[EQ11]).
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor.
-      eapply Verilog.erun_Vbinop with (EQ := ?[EQ12]).
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-
-      all: crush.
-
-      (** State Lookup *)
-      unfold Verilog.merge_regs.
-      crush.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Match states *)
-      rewrite assumption_32bit.
-      econstructor; eauto.
-
-      (** Match assocmaps *)
-      unfold Verilog.merge_regs. crush. unfold_merge.
-      apply regs_lessdef_add_greater. apply greater_than_max_func.
-      assumption.
-
-      (** States well formed *)
-      unfold state_st_wf. inversion 1. crush.
-      unfold Verilog.merge_regs.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Equality proof *)
-      assert (Z.to_nat
-                (Integers.Ptrofs.unsigned
-                   (Integers.Ptrofs.divu
-                      OFFSET
-                      (Integers.Ptrofs.repr 4)))
-              =
-              valueToNat (vdiv
-                            (vplus (vplus asr # r0 (ZToValue 32 z0) ?EQ11) (vmul asr # r1 (ZToValue 32 z) ?EQ12)
-                                   ?EQ10) (ZToValue 32 4) ?EQ9))
-        as EXPR_OK by admit.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET.
-
-      econstructor.
-      repeat split; crush.
-      unfold HTL.empty_stack.
-      crush.
-      unfold Verilog.merge_arrs.
-
-      rewrite AssocMap.gcombine.
-      2: { reflexivity. }
-      unfold Verilog.arr_assocmap_set.
-      rewrite AssocMap.gss.
-      unfold Verilog.merge_arr.
-      rewrite AssocMap.gss.
-      setoid_rewrite H5.
-      reflexivity.
-
-      rewrite combine_length.
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      apply list_repeat_len.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len.
-      rewrite H4. reflexivity.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (valueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int
-                                       (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z))
-                                                         (Integers.Int.repr z0)))) as OFFSET.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      constructor.
-      erewrite combine_lookup_second.
-      simpl.
-      assert (Ple src (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto);
-      apply H0 in H20.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; invert H20; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-
-      assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption).
-      rewrite Z.mul_comm in H20.
-      rewrite Z_div_mult in H20; try lia.
-      replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H20 by reflexivity.
-      rewrite <- PtrofsExtra.divu_unsigned in H20; unfold_constants; try lia.
-      rewrite H20. rewrite EXPR_OK.
-      rewrite array_get_error_set_bound.
-      reflexivity.
-      unfold arr_length, arr_repeat. simpl.
-      rewrite list_repeat_len. lia.
-
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           rewrite Z2Nat.id in H22; try lia.
-           apply Zmult_lt_compat_r with (p := 4) in H22; try lia.
-           rewrite ZLib.div_mul_undo in H22; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-
-      rewrite <- EXPR_OK.
-      rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia).
-      destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4).
-      apply Z.mul_cancel_r with (p := 4) in e; try lia.
-      rewrite ZLib.div_mul_undo in e; try lia.
-      rewrite combine_lookup_first.
-      eapply H7; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-      rewrite array_gso.
-      unfold array_get_error.
-      unfold arr_repeat.
-      crush.
-      apply list_repeat_lookup.
-      lia.
-      unfold_constants.
-      intro.
-      apply Z2Nat.inj_iff in H20; try lia.
-      apply Z.div_pos; try lia.
-      apply Integers.Ptrofs.unsigned_range.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      unfold arr_stack_based_pointers.
-      intros.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      crush.
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      crush.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor.
-      destruct (Archi.ptr64); try discriminate.
-      pose proof (RSBP src). rewrite EQ_SRC in H0.
-      assumption.
-
-      simpl.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           invert H0.
-           apply Zmult_lt_compat_r with (p := 4) in H21; try lia.
-           rewrite ZLib.div_mul_undo in H21; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-      apply ASBP; assumption.
-
-      unfold stack_bounds in *. intros.
-      simpl.
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right. right. simpl.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr; crush; try lia.
-           apply ZExtra.mod_0_bounds; crush; try lia. }
-      crush.
-      exploit (BOUNDS ptr); try lia. intros. crush.
-      exploit (BOUNDS ptr v); try lia. intros.
-      invert H0.
-      match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity.
-      assert (Mem.valid_access m AST.Mint32 sp'
-                               (Integers.Ptrofs.unsigned
-                                  (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                       (Integers.Ptrofs.repr ptr))) Writable).
-      { pose proof H1. eapply Mem.store_valid_access_2 in H0.
-        exact H0. eapply Mem.store_valid_access_3. eassumption. }
-      pose proof (Mem.valid_access_store m AST.Mint32 sp'
-                                         (Integers.Ptrofs.unsigned
-                                            (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                                 (Integers.Ptrofs.repr ptr))) v).
-      apply X in H0. invert H0. congruence.
-
-    + invert MARR. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-      rewrite ARCHI in H0. crush.
-
-      unfold check_address_parameter_unsigned in *;
-      unfold check_address_parameter_signed in *; crush.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      rewrite ZERO in H1. clear ZERO.
-      rewrite Integers.Ptrofs.add_zero_l in H1.
-
-      remember i0 as OFFSET.
-
-      (** Modular preservation proof *)
-      rename H0 into MOD_PRESERVE.
-
-      (** Write bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); auto.
-        crush.
-        replace (Integers.Ptrofs.repr 0) with (Integers.Ptrofs.zero) by reflexivity.
-        small_tac. }
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      apply assumption_32bit.
-      econstructor. econstructor. econstructor.
-      eapply Verilog.stmnt_runp_Vnonblock_arr. crush.
-      econstructor. econstructor. econstructor. econstructor.
-
-      all: crush.
-
-      (** State Lookup *)
-      unfold Verilog.merge_regs.
-      crush.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Match states *)
-      rewrite assumption_32bit.
-      econstructor; eauto.
-
-      (** Match assocmaps *)
-      unfold Verilog.merge_regs. crush. unfold_merge.
-      apply regs_lessdef_add_greater. apply greater_than_max_func.
-      assumption.
-
-      (** States well formed *)
-      unfold state_st_wf. inversion 1. crush.
-      unfold Verilog.merge_regs.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Equality proof *)
-      assert (Z.to_nat
-                (Integers.Ptrofs.unsigned
-                   (Integers.Ptrofs.divu
-                      OFFSET
-                      (Integers.Ptrofs.repr 4)))
-              =
-              valueToNat (ZToValue 32 (Integers.Ptrofs.unsigned OFFSET / 4)))
-        as EXPR_OK by admit.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET.
-
-      econstructor.
-      repeat split; crush.
-      unfold HTL.empty_stack.
-      crush.
-      unfold Verilog.merge_arrs.
-
-      rewrite AssocMap.gcombine.
-      2: { reflexivity. }
-      unfold Verilog.arr_assocmap_set.
-      rewrite AssocMap.gss.
-      unfold Verilog.merge_arr.
-      rewrite AssocMap.gss.
-      setoid_rewrite H5.
-      reflexivity.
-
-      rewrite combine_length.
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      apply list_repeat_len.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len.
-      rewrite H4. reflexivity.
-
-      remember i0 as OFFSET.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      constructor.
-      erewrite combine_lookup_second.
-      simpl.
-      assert (Ple src (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto);
-      apply H0 in H8.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; invert H8; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-
-      assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption).
-      rewrite Z.mul_comm in H8.
-      rewrite Z_div_mult in H8; try lia.
-      replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H8 by reflexivity.
-      rewrite <- PtrofsExtra.divu_unsigned in H8; unfold_constants; try lia.
-      rewrite H8. rewrite EXPR_OK.
-      rewrite array_get_error_set_bound.
-      reflexivity.
-      unfold arr_length, arr_repeat. simpl.
-      rewrite list_repeat_len. lia.
-
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           rewrite Z2Nat.id in H12; try lia.
-           apply Zmult_lt_compat_r with (p := 4) in H12; try lia.
-           rewrite ZLib.div_mul_undo in H12; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-
-      rewrite <- EXPR_OK.
-      rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia).
-      destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4).
-      apply Z.mul_cancel_r with (p := 4) in e; try lia.
-      rewrite ZLib.div_mul_undo in e; try lia.
-      rewrite combine_lookup_first.
-      eapply H7; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-      rewrite array_gso.
-      unfold array_get_error.
-      unfold arr_repeat.
-      crush.
-      apply list_repeat_lookup.
-      lia.
-      unfold_constants.
-      intro.
-      apply Z2Nat.inj_iff in H8; try lia.
-      apply Z.div_pos; try lia.
-      apply Integers.Ptrofs.unsigned_range.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      unfold arr_stack_based_pointers.
-      intros.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      crush.
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      crush.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor.
-      destruct (Archi.ptr64); try discriminate.
-      pose proof (RSBP src). rewrite EQ_SRC in H0.
-      assumption.
-
-      simpl.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           invert H0.
-           apply Zmult_lt_compat_r with (p := 4) in H10; try lia.
-           rewrite ZLib.div_mul_undo in H10; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-      apply ASBP; assumption.
-
-      unfold stack_bounds in *. intros.
-      simpl.
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right. right. simpl.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr; crush; try lia.
-           apply ZExtra.mod_0_bounds; crush; try lia. }
-      crush.
-      exploit (BOUNDS ptr); try lia. intros. crush.
-      exploit (BOUNDS ptr v); try lia. intros.
-      invert H0.
-      match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity.
-      assert (Mem.valid_access m AST.Mint32 sp'
-                               (Integers.Ptrofs.unsigned
-                                  (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                       (Integers.Ptrofs.repr ptr))) Writable).
-      { pose proof H1. eapply Mem.store_valid_access_2 in H0.
-        exact H0. eapply Mem.store_valid_access_3. eassumption. }
-      pose proof (Mem.valid_access_store m AST.Mint32 sp'
-                                         (Integers.Ptrofs.unsigned
-                                            (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                                 (Integers.Ptrofs.repr ptr))) v).
-      apply X in H0. invert H0. congruence.
-  Admitted.
-  Hint Resolve transl_istore_correct : htlproof.
-
-  Lemma transl_icond_correct:
-    forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive)
-      (rs : Registers.Regmap.t Values.val) (m : mem) (cond : Op.condition) (args : list Registers.reg)
-      (ifso ifnot : RTL.node) (b : bool) (pc' : RTL.node),
-      (RTL.fn_code f) ! pc = Some (RTL.Icond cond args ifso ifnot) ->
-      Op.eval_condition cond (map (fun r : positive => Registers.Regmap.get r rs) args) m = Some b ->
-      pc' = (if b then ifso else ifnot) ->
-      forall R1 : HTL.state,
-        match_states (RTL.State s f sp pc rs m) R1 ->
-        exists R2 : HTL.state,
-          Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m) R2.
-  Proof.
-    intros s f sp pc rs m cond args ifso ifnot b pc' H H0 H1 R1 MSTATE.
-    inv_state.
-
-    eexists. split. apply Smallstep.plus_one.
-    eapply HTL.step_module; eauto.
-    apply assumption_32bit.
-    eapply Verilog.stmnt_runp_Vnonblock_reg with
-        (rhsval := if b then posToValue 32 ifso else posToValue 32 ifnot).
-    constructor.
-
-    simpl.
-    destruct b.
-    eapply Verilog.erun_Vternary_true.
-    eapply eval_cond_correct; eauto.
-    constructor.
-    apply boolToValue_ValueToBool.
-    eapply Verilog.erun_Vternary_false.
-    eapply eval_cond_correct; eauto.
-    constructor.
-    apply boolToValue_ValueToBool.
-    constructor.
-
-    big_tac.
-
-    invert MARR.
-    destruct b; rewrite assumption_32bit; big_tac.
-
-    Unshelve.
-    constructor.
-  Qed.
-  Hint Resolve transl_icond_correct : htlproof.
-
-  Lemma transl_ijumptable_correct:
-    forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive)
-      (rs : Registers.Regmap.t Values.val) (m : mem) (arg : Registers.reg) (tbl : list RTL.node)
-      (n : Integers.Int.int) (pc' : RTL.node),
-      (RTL.fn_code f) ! pc = Some (RTL.Ijumptable arg tbl) ->
-      Registers.Regmap.get arg rs = Values.Vint n ->
-      list_nth_z tbl (Integers.Int.unsigned n) = Some pc' ->
-      forall R1 : HTL.state,
-        match_states (RTL.State s f sp pc rs m) R1 ->
-        exists R2 : HTL.state,
-          Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m) R2.
-  Proof.
-    intros s f sp pc rs m arg tbl n pc' H H0 H1 R1 MSTATE.
-  Admitted.
-  Hint Resolve transl_ijumptable_correct : htlproof.
-
-  Lemma transl_ireturn_correct:
-    forall (s : list RTL.stackframe) (f : RTL.function) (stk : Values.block)
-      (pc : positive) (rs : RTL.regset) (m : mem) (or : option Registers.reg)
-      (m' : mem),
-      (RTL.fn_code f) ! pc = Some (RTL.Ireturn or) ->
-      Mem.free m stk 0 (RTL.fn_stacksize f) = Some m' ->
-      forall R1 : HTL.state,
-        match_states (RTL.State s f (Values.Vptr stk Integers.Ptrofs.zero) pc rs m) R1 ->
-        exists R2 : HTL.state,
-          Smallstep.plus HTL.step tge R1 Events.E0 R2 /\
-          match_states (RTL.Returnstate s (Registers.regmap_optget or Values.Vundef rs) m') R2.
-  Proof.
-    intros s f stk pc rs m or m' H H0 R1 MSTATE.
-    inv_state.
-
-    - econstructor. split.
-      eapply Smallstep.plus_two.
-
-      eapply HTL.step_module; eauto.
-      apply assumption_32bit.
-      constructor.
-      econstructor; simpl; trivial.
-      econstructor; simpl; trivial.
-      constructor.
-      econstructor; simpl; trivial.
-      constructor.
-
-      constructor. constructor.
-
-      unfold state_st_wf in WF; big_tac; eauto.
-      apply st_greater_than_res.
-      apply st_greater_than_res.
-
-      apply HTL.step_finish.
-      unfold Verilog.merge_regs.
-      unfold_merge; simpl.
-      rewrite AssocMap.gso.
-      apply AssocMap.gss.
-      apply finish_not_return.
-      apply AssocMap.gss.
-      rewrite Events.E0_left. reflexivity.
-
-      constructor; auto.
-      constructor.
-
-    (* FIXME: Duplication *)
-    - econstructor. split.
-      eapply Smallstep.plus_two.
-      eapply HTL.step_module; eauto.
-      apply assumption_32bit.
-      constructor.
-      econstructor; simpl; trivial.
-      econstructor; simpl; trivial.
-      constructor. constructor. constructor.
-      constructor. constructor. constructor.
-
-      unfold state_st_wf in WF; big_tac; eauto.
-      apply st_greater_than_res.
-      apply st_greater_than_res.
-
-      apply HTL.step_finish.
-      unfold Verilog.merge_regs.
-      unfold_merge.
-      rewrite AssocMap.gso.
-      apply AssocMap.gss.
-      apply finish_not_return.
-      apply AssocMap.gss.
-      rewrite Events.E0_left. trivial.
-
-      constructor; auto.
-
-      simpl. inversion MASSOC. subst.
-      unfold find_assocmap, AssocMapExt.get_default. rewrite AssocMap.gso.
-      apply H1. eapply RTL.max_reg_function_use. eauto. simpl; tauto.
-      apply st_greater_than_res.
-
-      Unshelve.
-      all: constructor.
-  Qed.
-  Hint Resolve transl_ireturn_correct : htlproof.
-
-  Lemma transl_callstate_correct:
-    forall (s : list RTL.stackframe) (f : RTL.function) (args : list Values.val)
-      (m : mem) (m' : Mem.mem') (stk : Values.block),
-      Mem.alloc m 0 (RTL.fn_stacksize f) = (m', stk) ->
-      forall R1 : HTL.state,
-        match_states (RTL.Callstate s (AST.Internal f) args m) R1 ->
-        exists R2 : HTL.state,
-          Smallstep.plus HTL.step tge R1 Events.E0 R2 /\
-          match_states
-            (RTL.State s f (Values.Vptr stk Integers.Ptrofs.zero) (RTL.fn_entrypoint f)
-                       (RTL.init_regs args (RTL.fn_params f)) m') R2.
-  Proof.
-    intros s f args m m' stk H R1 MSTATE.
-
-    inversion MSTATE; subst. inversion TF; subst.
-    econstructor. split. apply Smallstep.plus_one.
-    eapply HTL.step_call. crush.
-
-    apply match_state with (sp' := stk); eauto.
-
-    all: big_tac.
-
-    apply regs_lessdef_add_greater.
-    apply greater_than_max_func.
-    apply init_reg_assoc_empty.
-
-    constructor.
-
-    destruct (Mem.load AST.Mint32 m' stk
-                       (Integers.Ptrofs.unsigned (Integers.Ptrofs.add
-                                                    Integers.Ptrofs.zero
-                                                    (Integers.Ptrofs.repr (4 * ptr))))) eqn:LOAD.
-    pose proof Mem.load_alloc_same as LOAD_ALLOC.
-    pose proof H as ALLOC.
-    eapply LOAD_ALLOC in ALLOC.
-    2: { exact LOAD. }
-    ptrofs. rewrite LOAD.
-    rewrite ALLOC.
-    repeat constructor.
-
-    ptrofs. rewrite LOAD.
-    repeat constructor.
-
-    unfold reg_stack_based_pointers. intros.
-    unfold RTL.init_regs; crush.
-    destruct (RTL.fn_params f);
-    rewrite Registers.Regmap.gi; constructor.
-
-    unfold arr_stack_based_pointers. intros.
-    crush.
-    destruct (Mem.load AST.Mint32 m' stk
-                       (Integers.Ptrofs.unsigned (Integers.Ptrofs.add
-                                                    Integers.Ptrofs.zero
-                                                    (Integers.Ptrofs.repr (4 * ptr))))) eqn:LOAD.
-    pose proof Mem.load_alloc_same as LOAD_ALLOC.
-    pose proof H as ALLOC.
-    eapply LOAD_ALLOC in ALLOC.
-    2: { exact LOAD. }
-    rewrite ALLOC.
-    repeat constructor.
-    constructor.
-
-    Transparent Mem.alloc. (* TODO: Since there are opaque there's probably a lemma. *)
-    Transparent Mem.load.
-    Transparent Mem.store.
-    unfold stack_bounds.
-    split.
-
-    unfold Mem.alloc in H.
-    invert H.
-    crush.
-    unfold Mem.load.
-    intros.
-    match goal with | |- context[if ?x then _ else _] => destruct x end; try congruence.
-    invert v0. unfold Mem.range_perm in H3.
-    unfold Mem.perm in H3. crush.
-    unfold Mem.perm_order' in H3.
-    small_tac.
-    exploit (H3 ptr). rewrite Integers.Ptrofs.unsigned_repr; small_tac. intros.
-    rewrite Maps.PMap.gss in H8.
-    match goal with | H8 : context[if ?x then _ else _] |- _ => destruct x eqn:EQ end; try contradiction.
-    crush.
-    apply proj_sumbool_true in H10. lia.
-
-    unfold Mem.alloc in H.
-    invert H.
-    crush.
-    unfold Mem.store.
-    intros.
-    match goal with | |- context[if ?x then _ else _] => destruct x end; try congruence.
-    invert v0. unfold Mem.range_perm in H3.
-    unfold Mem.perm in H3. crush.
-    unfold Mem.perm_order' in H3.
-    small_tac.
-    exploit (H3 ptr). rewrite Integers.Ptrofs.unsigned_repr; small_tac. intros.
-    rewrite Maps.PMap.gss in H8.
-    match goal with | H8 : context[if ?x then _ else _] |- _ => destruct x eqn:EQ end; try contradiction.
-    crush.
-    apply proj_sumbool_true in H10. lia.
-    Opaque Mem.alloc.
-    Opaque Mem.load.
-    Opaque Mem.store.
-  Qed.
-  Hint Resolve transl_callstate_correct : htlproof.
-
-  Lemma transl_returnstate_correct:
-    forall (res0 : Registers.reg) (f : RTL.function) (sp : Values.val) (pc : RTL.node)
-      (rs : RTL.regset) (s : list RTL.stackframe) (vres : Values.val) (m : mem)
-      (R1 : HTL.state),
-      match_states (RTL.Returnstate (RTL.Stackframe res0 f sp pc rs :: s) vres m) R1 ->
-      exists R2 : HTL.state,
-        Smallstep.plus HTL.step tge R1 Events.E0 R2 /\
-        match_states (RTL.State s f sp pc (Registers.Regmap.set res0 vres rs) m) R2.
-  Proof.
-    intros res0 f sp pc rs s vres m R1 MSTATE.
-    inversion MSTATE. inversion MF.
-  Qed.
-  Hint Resolve transl_returnstate_correct : htlproof.
-
-  Lemma option_inv :
-    forall A x y,
-      @Some A x = Some y -> x = y.
-  Proof. intros. inversion H. trivial. Qed.
-
-  Lemma main_tprog_internal :
-    forall b,
-      Globalenvs.Genv.find_symbol tge tprog.(AST.prog_main) = Some b ->
-      exists f, Genv.find_funct_ptr (Genv.globalenv tprog) b = Some (AST.Internal f).
-  Proof.
-    intros.
-    destruct TRANSL. unfold main_is_internal in H1.
-    repeat (unfold_match H1). replace b with b0.
-    exploit function_ptr_translated; eauto. intros [tf [A B]].
-    unfold transl_fundef, AST.transf_partial_fundef, Errors.bind in B.
-    unfold_match B. inv B. econstructor. apply A.
-
-    apply option_inv. rewrite <- Heqo. rewrite <- H.
-    rewrite symbols_preserved. replace (AST.prog_main tprog) with (AST.prog_main prog).
-    trivial. symmetry; eapply Linking.match_program_main; eauto.
-  Qed.
-
-  (* Had to admit proof because currently there is no way to force main to be Internal. *)
-  Lemma transl_initial_states :
-    forall s1 : Smallstep.state (RTL.semantics prog),
-      Smallstep.initial_state (RTL.semantics prog) s1 ->
-      exists s2 : Smallstep.state (HTL.semantics tprog),
-        Smallstep.initial_state (HTL.semantics tprog) s2 /\ match_states s1 s2.
-  Proof.
-    induction 1.
-    destruct TRANSL. unfold main_is_internal in H4.
-    repeat (unfold_match H4).
-    assert (f = AST.Internal f1). apply option_inv.
-    rewrite <- Heqo0. rewrite <- H1. replace b with b0.
-    auto. apply option_inv. rewrite <- H0. rewrite <- Heqo.
-    trivial.
-    exploit function_ptr_translated; eauto.
-    intros [tf [A B]].
-    unfold transl_fundef, Errors.bind in B.
-    unfold AST.transf_partial_fundef, Errors.bind in B.
-    repeat (unfold_match B). inversion B. subst.
-    exploit main_tprog_internal; eauto; intros.
-    rewrite symbols_preserved. replace (AST.prog_main tprog) with (AST.prog_main prog).
-    apply Heqo. symmetry; eapply Linking.match_program_main; eauto.
-    inversion H5.
-    econstructor; split. econstructor.
-    apply (Genv.init_mem_transf_partial TRANSL'); eauto.
-    replace (AST.prog_main tprog) with (AST.prog_main prog).
-    rewrite symbols_preserved; eauto.
-    symmetry; eapply Linking.match_program_main; eauto.
-    apply H6.
-
-    constructor.
-    apply transl_module_correct.
-    assert (Some (AST.Internal x) = Some (AST.Internal m)).
-    replace (AST.fundef HTL.module) with (HTL.fundef).
-    rewrite <- H6. setoid_rewrite <- A. trivial.
-    trivial. inv H7. assumption.
-  Qed.
-  Hint Resolve transl_initial_states : htlproof.
-
-  Lemma transl_final_states :
-    forall (s1 : Smallstep.state (RTL.semantics prog))
-           (s2 : Smallstep.state (HTL.semantics tprog))
-           (r : Integers.Int.int),
-      match_states s1 s2 ->
-      Smallstep.final_state (RTL.semantics prog) s1 r ->
-      Smallstep.final_state (HTL.semantics tprog) s2 r.
-  Proof.
-    intros. inv H0. inv H. inv H4. invert MF. constructor. reflexivity.
-  Qed.
-  Hint Resolve transl_final_states : htlproof.
-
-  Theorem transl_step_correct:
-    forall (S1 : RTL.state) t S2,
-      RTL.step ge S1 t S2 ->
-      forall (R1 : HTL.state),
-        match_states S1 R1 ->
-        exists R2, Smallstep.plus HTL.step tge R1 t R2 /\ match_states S2 R2.
-  Proof.
-    induction 1; eauto with htlproof; (intros; inv_state).
-  Qed.
-  Hint Resolve transl_step_correct : htlproof.
+(*   Lemma TRANSL' : *)
+(*     Linking.match_program (fun cu f tf => transl_fundef f = Errors.OK tf) eq prog tprog. *)
+(*   Proof. intros; apply match_prog_matches; assumption. Qed. *)
+
+(*   Let ge : RTL.genv := Globalenvs.Genv.globalenv prog. *)
+(*   Let tge : HTL.genv := Globalenvs.Genv.globalenv tprog. *)
+
+(*   Lemma symbols_preserved: *)
+(*     forall (s: AST.ident), Genv.find_symbol tge s = Genv.find_symbol ge s. *)
+(*   Proof. intros. eapply (Genv.find_symbol_match TRANSL'). Qed. *)
+
+(*   Lemma function_ptr_translated: *)
+(*     forall (b: Values.block) (f: RTL.fundef), *)
+(*       Genv.find_funct_ptr ge b = Some f -> *)
+(*       exists tf, *)
+(*         Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = Errors.OK tf. *)
+(*   Proof. *)
+(*     intros. exploit (Genv.find_funct_ptr_match TRANSL'); eauto. *)
+(*     intros (cu & tf & P & Q & R); exists tf; auto. *)
+(*   Qed. *)
+
+(*   Lemma functions_translated: *)
+(*     forall (v: Values.val) (f: RTL.fundef), *)
+(*       Genv.find_funct ge v = Some f -> *)
+(*       exists tf, *)
+(*         Genv.find_funct tge v = Some tf /\ transl_fundef f = Errors.OK tf. *)
+(*   Proof. *)
+(*     intros. exploit (Genv.find_funct_match TRANSL'); eauto. *)
+(*     intros (cu & tf & P & Q & R); exists tf; auto. *)
+(*   Qed. *)
+
+(*   Lemma senv_preserved: *)
+(*     Senv.equiv (Genv.to_senv ge) (Genv.to_senv tge). *)
+(*   Proof *)
+(*     (Genv.senv_transf_partial TRANSL'). *)
+(*   Hint Resolve senv_preserved : htlproof. *)
+
+(*   Lemma ptrofs_inj : *)
+(*     forall a b, *)
+(*       Ptrofs.unsigned a = Ptrofs.unsigned b -> a = b. *)
+(*   Proof. *)
+(*     intros. rewrite <- Ptrofs.repr_unsigned. symmetry. rewrite <- Ptrofs.repr_unsigned. *)
+(*     rewrite H. auto. *)
+(*   Qed. *)
+
+(*   Lemma op_stack_based : *)
+(*     forall F V sp v m args rs op ge pc' res0 pc f e fin rtrn st stk, *)
+(*       tr_instr fin rtrn st stk (RTL.Iop op args res0 pc') *)
+(*                (Verilog.Vnonblock (Verilog.Vvar res0) e) *)
+(*                (state_goto st pc') -> *)
+(*       reg_stack_based_pointers sp rs -> *)
+(*       (RTL.fn_code f) ! pc = Some (RTL.Iop op args res0 pc') -> *)
+(*       @Op.eval_operation F V ge (Values.Vptr sp Ptrofs.zero) op *)
+(*                         (map (fun r : positive => Registers.Regmap.get r rs) args) m = Some v -> *)
+(*       stack_based v sp. *)
+(*   Proof. *)
+(*     Ltac solve_no_ptr := *)
+(*       match goal with *)
+(*       | H: reg_stack_based_pointers ?sp ?rs |- stack_based (Registers.Regmap.get ?r ?rs) _ => *)
+(*         solve [apply H] *)
+(*       | H1: reg_stack_based_pointers ?sp ?rs, H2: Registers.Regmap.get _ _ = Values.Vptr ?b ?i *)
+(*         |- context[Values.Vptr ?b _] => *)
+(*         let H := fresh "H" in *)
+(*         assert (H: stack_based (Values.Vptr b i) sp) by (rewrite <- H2; apply H1); simplify; solve [auto] *)
+(*       | |- context[Registers.Regmap.get ?lr ?lrs] => *)
+(*         destruct (Registers.Regmap.get lr lrs) eqn:?; simplify; auto *)
+(*       | |- stack_based (?f _) _ => unfold f *)
+(*       | |- stack_based (?f _ _) _ => unfold f *)
+(*       | |- stack_based (?f _ _ _) _ => unfold f *)
+(*       | |- stack_based (?f _ _ _ _) _ => unfold f *)
+(*       | H: ?f _ _ = Some _ |- _ => *)
+(*         unfold f in H; repeat (unfold_match H); inv H *)
+(*       | H: ?f _ _ _ _ _ _ = Some _ |- _ => *)
+(*         unfold f in H; repeat (unfold_match H); inv H *)
+(*       | H: map (fun r : positive => Registers.Regmap.get r _) ?args = _ |- _ => *)
+(*         destruct args; inv H *)
+(*       | |- context[if ?c then _ else _] => destruct c; try discriminate *)
+(*       | H: match _ with _ => _ end = Some _ |- _ => repeat (unfold_match H) *)
+(*       | |- context[match ?g with _ => _ end] => destruct g; try discriminate *)
+(*       | |- _ => simplify; solve [auto] *)
+(*       end. *)
+(*     intros F V sp v m args rs op g pc' res0 pc f e fin rtrn st stk INSTR RSBP SEL EVAL. *)
+(*     inv INSTR. unfold translate_instr in H5. *)
+(*     unfold_match H5; repeat (unfold_match H5); repeat (simplify; solve_no_ptr). *)
+(*   Qed. *)
+
+(*   Lemma int_inj : *)
+(*     forall x y, *)
+(*       Int.unsigned x = Int.unsigned y -> *)
+(*       x = y. *)
+(*   Proof. *)
+(*     intros. rewrite <- Int.repr_unsigned at 1. rewrite <- Int.repr_unsigned. *)
+(*     rewrite <- H. trivial. *)
+(*   Qed. *)
+
+(*   Lemma eval_correct : *)
+(*     forall s sp op rs m v e asr asa f f' stk s' i pc res0 pc' args res ml st, *)
+(*       match_states (RTL.State stk f sp pc rs m) (HTL.State res ml st asr asa) -> *)
+(*       (RTL.fn_code f) ! pc = Some (RTL.Iop op args res0 pc') -> *)
+(*       Op.eval_operation ge sp op *)
+(*                         (List.map (fun r : BinNums.positive => Registers.Regmap.get r rs) args) m = Some v -> *)
+(*       translate_instr op args s = OK e s' i -> *)
+(*       exists v', Verilog.expr_runp f' asr asa e v' /\ val_value_lessdef v v'. *)
+(*   Proof. *)
+(*     Ltac eval_correct_tac := *)
+(*       match goal with *)
+(*       | |- context[valueToPtr] => unfold valueToPtr *)
+(*       | |- context[valueToInt] => unfold valueToInt *)
+(*       | |- context[bop] => unfold bop *)
+(*       | |- context[boplit] => unfold boplit *)
+(*       | |- val_value_lessdef Values.Vundef _ => solve [constructor] *)
+(*       | H : val_value_lessdef _ _ |- val_value_lessdef (Values.Vint _) _ => constructor; inv H *)
+(*       | |- val_value_lessdef (Values.Vint _) _ => constructor; auto *)
+(*       | H : context[RTL.max_reg_function ?f] *)
+(*         |- context[_ (Registers.Regmap.get ?r ?rs) (Registers.Regmap.get ?r0 ?rs)] => *)
+(*         let HPle1 := fresh "HPle" in *)
+(*         let HPle2 := fresh "HPle" in *)
+(*         assert (HPle1 : Ple r (RTL.max_reg_function f)) by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+(*         assert (HPle2 : Ple r0 (RTL.max_reg_function f)) by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+(*         apply H in HPle1; apply H in HPle2; eexists; split; *)
+(*         [econstructor; eauto; constructor; trivial | inv HPle1; inv HPle2; try (constructor; auto)] *)
+(*       | H : context[RTL.max_reg_function ?f] *)
+(*         |- context[_ (Registers.Regmap.get ?r ?rs) _] => *)
+(*         let HPle1 := fresh "HPle" in *)
+(*         assert (HPle1 : Ple r (RTL.max_reg_function f)) by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+(*         apply H in HPle1; eexists; split; *)
+(*         [econstructor; eauto; constructor; trivial | inv HPle1; try (constructor; auto)] *)
+(*       | H : _ :: _ = _ :: _ |- _ => inv H *)
+(*       | |- context[match ?d with _ => _ end] => destruct d eqn:?; try discriminate *)
+(*       | |- Verilog.expr_runp _ _ _ _ _ => econstructor *)
+(*       | |- val_value_lessdef (?f _ _) _ => unfold f *)
+(*       | |- val_value_lessdef (?f _) _ => unfold f *)
+(*       | H : ?f (Registers.Regmap.get _ _) _ = Some _ |- _ => *)
+(*         unfold f in H; repeat (unfold_match H) *)
+(*       | H1 : Registers.Regmap.get ?r ?rs = Values.Vint _, H2 : val_value_lessdef (Registers.Regmap.get ?r ?rs) _ *)
+(*         |- _ => rewrite H1 in H2; inv H2 *)
+(*       | |- _ => eexists; split; try constructor; solve [eauto] *)
+(*       | H : context[RTL.max_reg_function ?f] |- context[_ (Verilog.Vvar ?r) (Verilog.Vvar ?r0)] => *)
+(*         let HPle1 := fresh "H" in *)
+(*         let HPle2 := fresh "H" in *)
+(*         assert (HPle1 : Ple r (RTL.max_reg_function f)) by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+(*         assert (HPle2 : Ple r0 (RTL.max_reg_function f)) by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+(*         apply H in HPle1; apply H in HPle2; eexists; split; try constructor; eauto *)
+(*       | H : context[RTL.max_reg_function ?f] |- context[Verilog.Vvar ?r] => *)
+(*         let HPle := fresh "H" in *)
+(*         assert (HPle : Ple r (RTL.max_reg_function f)) by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+(*         apply H in HPle; eexists; split; try constructor; eauto *)
+(*       | |- context[if ?c then _ else _] => destruct c eqn:?; try discriminate *)
+(*       end. *)
+(*     intros s sp op rs m v e asr asa f f' stk s' i pc pc' res0 args res ml st MSTATE INSTR EVAL TR_INSTR. *)
+(*     inv MSTATE. inv MASSOC. unfold translate_instr in TR_INSTR; repeat (unfold_match TR_INSTR); inv TR_INSTR; *)
+(*     unfold Op.eval_operation in EVAL; repeat (unfold_match EVAL); inv EVAL; *)
+(*     repeat (simplify; eval_correct_tac; unfold valueToInt in *)
+(*     - pose proof Integers.Ptrofs.agree32_sub as H2; unfold Integers.Ptrofs.agree32 in H2. *)
+(*       unfold Ptrofs.of_int. simpl. *)
+(*       apply ptrofs_inj. assert (Archi.ptr64 = false) by auto. eapply H2 in H3. *)
+(*       rewrite Ptrofs.unsigned_repr. apply H3. replace Ptrofs.max_unsigned with Int.max_unsigned; auto. *)
+(*       apply Int.unsigned_range_2. *)
+(*       auto. rewrite Ptrofs.unsigned_repr. replace Ptrofs.max_unsigned with Int.max_unsigned; auto. *)
+(*       apply Int.unsigned_range_2. rewrite Ptrofs.unsigned_repr. auto. *)
+(*       replace Ptrofs.max_unsigned with Int.max_unsigned; auto. *)
+(*       apply Int.unsigned_range_2. *)
+(*     - pose proof Integers.Ptrofs.agree32_sub as AGR; unfold Integers.Ptrofs.agree32 in AGR. *)
+(*       assert (ARCH: Archi.ptr64 = false) by auto. eapply AGR in ARCH. *)
+(*       apply int_inj. unfold Ptrofs.to_int. rewrite Int.unsigned_repr. *)
+(*       apply ARCH. Search Ptrofs.unsigned. pose proof Ptrofs.unsigned_range_2. *)
+(*       replace Ptrofs.max_unsigned with Int.max_unsigned; auto. *)
+(*       pose proof Ptrofs.agree32_of_int. unfold Ptrofs.agree32 in H2. *)
+(*       eapply H2 in ARCH. apply ARCH. *)
+(*       pose proof Ptrofs.agree32_of_int. unfold Ptrofs.agree32 in H2. *)
+(*       eapply H2 in ARCH. apply ARCH. *)
+(*     - admit. (* mulhs *) *)
+(*     - admit. (* mulhu *) *)
+(*     - rewrite H0 in Heqb. rewrite H1 in Heqb. discriminate. *)
+(*     - rewrite Heqb in Heqb0. discriminate. *)
+(*     - rewrite H0 in Heqb. rewrite H1 in Heqb. discriminate. *)
+(*     - rewrite Heqb in Heqb0. discriminate. *)
+(*     - admit. *)
+(*     - admit. (* ror *) *)
+(*     - admit. (* addressing *) *)
+(*     - admit. (* eval_condition *) *)
+(*     - admit. (* select *) *)
+(*             Admitted. *)
+
+(*   Lemma eval_cond_correct : *)
+(*     forall cond (args : list Registers.reg) s1 c s' i rs args m b f asr asa, *)
+(*       translate_condition cond args s1 = OK c s' i -> *)
+(*       Op.eval_condition *)
+(*         cond *)
+(*         (List.map (fun r : BinNums.positive => Registers.Regmap.get r rs) args) *)
+(*         m = Some b -> *)
+(*       Verilog.expr_runp f asr asa c (boolToValue b). *)
+(*   Admitted. *)
+
+(*   (** The proof of semantic preservation for the translation of instructions *)
+(*       is a simulation argument based on diagrams of the following form: *)
+(* << *)
+(*                       match_states *)
+(*     code st rs ---------------- State m st assoc *)
+(*          ||                             | *)
+(*          ||                             | *)
+(*          ||                             | *)
+(*          \/                             v *)
+(*     code st rs' --------------- State m st assoc' *)
+(*                       match_states *)
+(* >> *)
+(*       where [tr_code c data control fin rtrn st] is assumed to hold. *)
+
+(*       The precondition and postcondition is that that should hold is [match_assocmaps rs assoc]. *)
+(*    *) *)
+
+(*   Definition transl_instr_prop (instr : RTL.instruction) : Prop := *)
+(*     forall m asr asa fin rtrn st stmt trans res, *)
+(*       tr_instr fin rtrn st (m.(HTL.mod_stk)) instr stmt trans -> *)
+(*       exists asr' asa', *)
+(*         HTL.step tge (HTL.State res m st asr asa) Events.E0 (HTL.State res m st asr' asa'). *)
+
+(*   Opaque combine. *)
+
+(*   Ltac tac0 := *)
+(*     match goal with *)
+(*     | [ |- context[Verilog.merge_arrs _ _] ] => unfold Verilog.merge_arrs *)
+(*     | [ |- context[Verilog.merge_arr] ] => unfold Verilog.merge_arr *)
+(*     | [ |- context[Verilog.merge_regs _ _] ] => unfold Verilog.merge_regs; crush; unfold_merge *)
+(*     | [ |- context[reg_stack_based_pointers] ] => unfold reg_stack_based_pointers; intros *)
+(*     | [ |- context[Verilog.arr_assocmap_set _ _ _ _] ] => unfold Verilog.arr_assocmap_set *)
+
+(*     | [ |- context[HTL.empty_stack] ] => unfold HTL.empty_stack *)
+
+(*     | [ |- context[_ # ?d <- _ ! ?d] ] => rewrite AssocMap.gss *)
+(*     | [ |- context[_ # ?d <- _ ! ?s] ] => rewrite AssocMap.gso *)
+(*     | [ |- context[(AssocMap.empty _) ! _] ] => rewrite AssocMap.gempty *)
+
+(*     | [ |- context[array_get_error _ (combine Verilog.merge_cell (arr_repeat None _) _)] ] => *)
+(*       rewrite combine_lookup_first *)
+
+(*     | [ |- state_st_wf _ _ ] => unfold state_st_wf; inversion 1 *)
+(*     | [ |- context[match_states _ _] ] => econstructor; auto *)
+(*     | [ |- match_arrs _ _ _ _ _ ] => econstructor; auto *)
+(*     | [ |- match_assocmaps _ _ _ # _ <- (posToValue _) ] => *)
+(*       apply regs_lessdef_add_greater; [> unfold Plt; lia | assumption] *)
+
+(*     | [ H : ?asa ! ?r = Some _ |- Verilog.arr_assocmap_lookup ?asa ?r _ = Some _ ] => *)
+(*       unfold Verilog.arr_assocmap_lookup; setoid_rewrite H; f_equal *)
+(*     | [ |- context[(AssocMap.combine _ _ _) ! _] ] => *)
+(*       try (rewrite AssocMap.gcombine; [> | reflexivity]) *)
+
+(*     | [ |- context[Registers.Regmap.get ?d (Registers.Regmap.set ?d _ _)] ] => *)
+(*       rewrite Registers.Regmap.gss *)
+(*     | [ |- context[Registers.Regmap.get ?s (Registers.Regmap.set ?d _ _)] ] => *)
+(*       destruct (Pos.eq_dec s d) as [EQ|EQ]; *)
+(*       [> rewrite EQ | rewrite Registers.Regmap.gso; auto] *)
+
+(*     | [ H : opt_val_value_lessdef _ _ |- _ ] => invert H *)
+(*     | [ H : context[Z.of_nat (Z.to_nat _)] |- _ ] => rewrite Z2Nat.id in H; [> solve crush |] *)
+(*     | [ H : _ ! _ = Some _ |- _] => setoid_rewrite H *)
+(*     end. *)
+
+(*   Ltac small_tac := repeat (crush; try array; try ptrofs); crush; auto. *)
+(*   Ltac big_tac := repeat (crush; try array; try ptrofs; try tac0); crush; auto. *)
+
+(*   Lemma transl_inop_correct: *)
+(*     forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive) *)
+(*       (rs : RTL.regset) (m : mem) (pc' : RTL.node), *)
+(*       (RTL.fn_code f) ! pc = Some (RTL.Inop pc') -> *)
+(*       forall R1 : HTL.state, *)
+(*         match_states (RTL.State s f sp pc rs m) R1 -> *)
+(*         exists R2 : HTL.state, *)
+(*           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m) R2. *)
+(*   Proof. *)
+(*     intros s f sp pc rs m pc' H R1 MSTATE. *)
+(*     inv_state. *)
+
+(*     unfold match_prog in TRANSL. *)
+(*     econstructor. *)
+(*     split. *)
+(*     apply Smallstep.plus_one. *)
+(*     eapply HTL.step_module; eauto. *)
+(*     inv CONST; assumption. *)
+(*     inv CONST; assumption.  *)
+(*     (* processing of state *) *)
+(*     econstructor. *)
+(*     crush. *)
+(*     econstructor. *)
+(*     econstructor. *)
+(*     econstructor. *)
+
+(*     all: invert MARR; big_tac. *)
+
+(*     inv CONST; constructor; simplify; rewrite AssocMap.gso; auto; lia. *)
+
+(*     Unshelve. auto. *)
+(*   Qed. *)
+(*   Hint Resolve transl_inop_correct : htlproof. *)
+
+(*   Lemma transl_iop_correct: *)
+(*     forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive) *)
+(*       (rs : Registers.Regmap.t Values.val) (m : mem) (op : Op.operation) (args : list Registers.reg) *)
+(*       (res0 : Registers.reg) (pc' : RTL.node) (v : Values.val), *)
+(*       (RTL.fn_code f) ! pc = Some (RTL.Iop op args res0 pc') -> *)
+(*       Op.eval_operation ge sp op (map (fun r : positive => Registers.Regmap.get r rs) args) m = Some v -> *)
+(*       forall R1 : HTL.state, *)
+(*         match_states (RTL.State s f sp pc rs m) R1 -> *)
+(*         exists R2 : HTL.state, *)
+(*           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ *)
+(*           match_states (RTL.State s f sp pc' (Registers.Regmap.set res0 v rs) m) R2. *)
+(*   Proof. *)
+(*     intros s f sp pc rs m op args res0 pc' v H H0 R1 MSTATE. *)
+(*     inv_state. inv MARR. *)
+(*     exploit eval_correct; eauto. intros. inversion H1. inversion H2. *)
+(*     econstructor. split. *)
+(*     apply Smallstep.plus_one. *)
+(*     eapply HTL.step_module; eauto. *)
+(*     inv CONST. assumption. *)
+(*     inv CONST. assumption. *)
+(*     econstructor; simpl; trivial. *)
+(*     constructor; trivial. *)
+(*     econstructor; simpl; eauto. *)
+(*     simpl. econstructor. econstructor. *)
+(*     apply H5. simplify. *)
+
+(*     all: big_tac. *)
+
+(*     assert (HPle: Ple res0 (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+
+(*     unfold Ple in HPle. lia. *)
+(*     apply regs_lessdef_add_match. assumption. *)
+(*     apply regs_lessdef_add_greater. unfold Plt; lia. assumption. *)
+(*     assert (HPle: Ple res0 (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+(*     unfold Ple in HPle; lia. *)
+(*     eapply op_stack_based; eauto. *)
+(*     inv CONST. constructor; simplify. rewrite AssocMap.gso. rewrite AssocMap.gso. *)
+(*     assumption. lia. *)
+(*     assert (HPle: Ple res0 (RTL.max_reg_function f)) *)
+(*       by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+(*     unfold Ple in HPle. lia. *)
+(*     rewrite AssocMap.gso. rewrite AssocMap.gso. *)
+(*     assumption. lia. *)
+(*     assert (HPle: Ple res0 (RTL.max_reg_function f)) *)
+(*       by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+(*     unfold Ple in HPle. lia. *)
+(*     Unshelve. trivial. *)
+(*   Qed. *)
+(*   Hint Resolve transl_iop_correct : htlproof. *)
+
+(*   Ltac tac := *)
+(*     repeat match goal with *)
+(*            | [ _ : error _ _ = OK _ _ _ |- _ ] => discriminate *)
+(*            | [ _ : context[if (?x && ?y) then _ else _] |- _ ] => *)
+(*              let EQ1 := fresh "EQ" in *)
+(*              let EQ2 := fresh "EQ" in *)
+(*              destruct x eqn:EQ1; destruct y eqn:EQ2; simpl in * *)
+(*            | [ _ : context[if ?x then _ else _] |- _ ] => *)
+(*              let EQ := fresh "EQ" in *)
+(*              destruct x eqn:EQ; simpl in * *)
+(*            | [ H : ret _ _ = _  |- _ ] => invert H *)
+(*            | [ _ : context[match ?x with | _ => _ end] |- _ ] => destruct x *)
+(*            end. *)
+
+(*   Ltac inv_arr_access := *)
+(*     match goal with *)
+(*     | [ _ : translate_arr_access ?chunk ?addr ?args _ _ = OK ?c _ _ |- _] => *)
+(*       destruct c, chunk, addr, args; crush; tac; crush *)
+(*     end. *)
+
+(*   Lemma transl_iload_correct: *)
+(*     forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive) *)
+(*       (rs : Registers.Regmap.t Values.val) (m : mem) (chunk : AST.memory_chunk) *)
+(*       (addr : Op.addressing) (args : list Registers.reg) (dst : Registers.reg) *)
+(*       (pc' : RTL.node) (a v : Values.val), *)
+(*       (RTL.fn_code f) ! pc = Some (RTL.Iload chunk addr args dst pc') -> *)
+(*       Op.eval_addressing ge sp addr (map (fun r : positive => Registers.Regmap.get r rs) args) = Some a -> *)
+(*       Mem.loadv chunk m a = Some v -> *)
+(*       forall R1 : HTL.state, *)
+(*         match_states (RTL.State s f sp pc rs m) R1 -> *)
+(*         exists R2 : HTL.state, *)
+(*           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ *)
+(*           match_states (RTL.State s f sp pc' (Registers.Regmap.set dst v rs) m) R2. *)
+(*   Proof. *)
+(*     intros s f sp pc rs m chunk addr args dst pc' a v H H0 H1 R1 MSTATE. *)
+(*     inv_state. inv_arr_access. *)
+
+(*     + (** Preamble *) *)
+(*       invert MARR. crush. *)
+
+(*       unfold Op.eval_addressing in H0. *)
+(*       destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+
+(*       unfold reg_stack_based_pointers in RSBP. *)
+(*       pose proof (RSBP r0) as RSBPr0. *)
+
+(*       destruct (Registers.Regmap.get r0 rs) eqn:EQr0; crush. *)
+
+(*       rewrite ARCHI in H1. crush. *)
+(*       subst. *)
+
+(*       pose proof MASSOC as MASSOC'. *)
+(*       invert MASSOC'. *)
+(*       pose proof (H0 r0). *)
+(*       assert (HPler0 : Ple r0 (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_use; eauto; crush; eauto). *)
+(*       apply H6 in HPler0. *)
+(*       invert HPler0; try congruence. *)
+(*       rewrite EQr0 in H8. *)
+(*       invert H8. *)
+(*       clear H0. clear H6. *)
+
+(*       unfold check_address_parameter_signed in *; *)
+(*       unfold check_address_parameter_unsigned in *; crush. *)
+
+(*       remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+(*                                     (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET. *)
+
+(*       (** Modular preservation proof *) *)
+(*       (*assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+(*       { rewrite HeqOFFSET. *)
+(*         apply PtrofsExtra.add_mod; crush. *)
+(*         rewrite Integers.Ptrofs.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. *)
+(*         apply PtrofsExtra.of_int_mod. *)
+(*         rewrite Integers.Int.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. } *)
+
+(*       (** Read bounds proof *) *)
+(*       assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH. *)
+(*       { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+(*         unfold stack_bounds in BOUNDS. *)
+(*         exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); auto. *)
+(*         split; try lia; apply Integers.Ptrofs.unsigned_range_2. *)
+(*         small_tac. } *)
+
+(*       (** Normalisation proof *) *)
+(*       assert (Integers.Ptrofs.repr *)
+(*                 (4 * Integers.Ptrofs.unsigned *)
+(*                        (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET) *)
+(*         as NORMALISE. *)
+(*       { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity. *)
+(*         rewrite <- PtrofsExtra.mul_unsigned. *)
+(*         apply PtrofsExtra.mul_divu; crush; auto. } *)
+
+(*       (** Normalised bounds proof *) *)
+(*       assert (0 <= *)
+(*               Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)) *)
+(*               < (RTL.fn_stacksize f / 4)) *)
+(*         as NORMALISE_BOUND. *)
+(*       { split. *)
+(*         apply Integers.Ptrofs.unsigned_range_2. *)
+(*         assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity. *)
+(*         unfold Integers.Ptrofs.divu at 2 in H0. *)
+(*         rewrite H0. clear H0. *)
+(*         rewrite Integers.Ptrofs.unsigned_repr; crush. *)
+(*         apply Zmult_lt_reg_r with (p := 4); try lia. *)
+(*         repeat rewrite ZLib.div_mul_undo; try lia. *)
+(*         apply Z.div_pos; small_tac. *)
+(*         apply Z.div_le_upper_bound; small_tac. } *)
+
+(*       inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ]; *)
+(*       clear NORMALISE_BOUND. *)
+
+(*       (** Start of proof proper *) *)
+(*       eexists. split. *)
+(*       eapply Smallstep.plus_one. *)
+(*       eapply HTL.step_module; eauto. *)
+(*       apply assumption_32bit. *)
+(*       econstructor. econstructor. econstructor. crush. *)
+(*       econstructor. econstructor. econstructor. crush. *)
+(*       econstructor. econstructor. *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+
+(*       all: big_tac. *)
+
+(*       1: { *)
+(*         assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+(*         eapply RTL.max_reg_function_def. eassumption. auto. *)
+(*         apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. *)
+(*       } *)
+
+(*       2: { *)
+(*         assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+(*         eapply RTL.max_reg_function_def. eassumption. auto. *)
+(*         apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. *)
+(*       } *)
+
+(*       (** Match assocmaps *) *)
+(*       apply regs_lessdef_add_match; big_tac. *)
+
+(*       (** Equality proof *) *)
+(*       match goal with *)
+(*       | [ |- context [valueToNat ?x] ] => *)
+(*         assert (Z.to_nat *)
+(*                   (Integers.Ptrofs.unsigned *)
+(*                      (Integers.Ptrofs.divu *)
+(*                         OFFSET *)
+(*                         (Integers.Ptrofs.repr 4))) *)
+(*                 = *)
+(*                 valueToNat x) *)
+(*           as EXPR_OK by admit *)
+(*       end. *)
+(*       rewrite <- EXPR_OK. *)
+
+(*       specialize (H7 (Integers.Ptrofs.unsigned *)
+(*                         (Integers.Ptrofs.divu *)
+(*                            OFFSET *)
+(*                            (Integers.Ptrofs.repr 4)))). *)
+(*       exploit H7; big_tac. *)
+
+(*       (** RSBP preservation *) *)
+(*       unfold arr_stack_based_pointers in ASBP. *)
+(*       specialize (ASBP (Integers.Ptrofs.unsigned *)
+(*                           (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))). *)
+(*       exploit ASBP; big_tac. *)
+(*       rewrite NORMALISE in H0. rewrite H1 in H0. assumption. *)
+
+(*     + (** Preamble *) *)
+(*       invert MARR. crush. *)
+
+(*       unfold Op.eval_addressing in H0. *)
+(*       destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+
+(*       unfold reg_stack_based_pointers in RSBP. *)
+(*       pose proof (RSBP r0) as RSBPr0. *)
+(*       pose proof (RSBP r1) as RSBPr1. *)
+
+(*       destruct (Registers.Regmap.get r0 rs) eqn:EQr0; *)
+(*       destruct (Registers.Regmap.get r1 rs) eqn:EQr1; crush. *)
+
+(*       rewrite ARCHI in H1. crush. *)
+(*       subst. *)
+(*       clear RSBPr1. *)
+
+(*       pose proof MASSOC as MASSOC'. *)
+(*       invert MASSOC'. *)
+(*       pose proof (H0 r0). *)
+(*       pose proof (H0 r1). *)
+(*       assert (HPler0 : Ple r0 (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_use; eauto; crush; eauto). *)
+(*       assert (HPler1 : Ple r1 (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_use; eauto; simpl; auto). *)
+(*       apply H6 in HPler0. *)
+(*       apply H8 in HPler1. *)
+(*       invert HPler0; invert HPler1; try congruence. *)
+(*       rewrite EQr0 in H9. *)
+(*       rewrite EQr1 in H11. *)
+(*       invert H9. invert H11. *)
+(*       clear H0. clear H6. clear H8. *)
+
+(*       unfold check_address_parameter_signed in *; *)
+(*       unfold check_address_parameter_unsigned in *; crush. *)
+
+(*       remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+(*                                     (Integers.Ptrofs.of_int *)
+(*                                        (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z)) *)
+(*                                                          (Integers.Int.repr z0)))) as OFFSET. *)
+
+(*       (** Modular preservation proof *) *)
+(*       assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+(*       { rewrite HeqOFFSET. *)
+(*         apply PtrofsExtra.add_mod; crush; try lia. *)
+(*         rewrite Integers.Ptrofs.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. *)
+(*         apply PtrofsExtra.of_int_mod. *)
+(*         apply IntExtra.add_mod; crush. *)
+(*         apply IntExtra.mul_mod2; crush. *)
+(*         rewrite Integers.Int.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. *)
+(*         rewrite Integers.Int.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. } *)
+
+(*       (** Read bounds proof *) *)
+(*       assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH. *)
+(*       { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+(*         unfold stack_bounds in BOUNDS. *)
+(*         exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); auto. *)
+(*         split; try lia; apply Integers.Ptrofs.unsigned_range_2. *)
+(*         small_tac. } *)
+
+(*       (** Normalisation proof *) *)
+(*       assert (Integers.Ptrofs.repr *)
+(*                 (4 * Integers.Ptrofs.unsigned *)
+(*                        (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET) *)
+(*         as NORMALISE. *)
+(*       { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity. *)
+(*         rewrite <- PtrofsExtra.mul_unsigned. *)
+(*         apply PtrofsExtra.mul_divu; crush. } *)
+
+(*       (** Normalised bounds proof *) *)
+(*       assert (0 <= *)
+(*               Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)) *)
+(*               < (RTL.fn_stacksize f / 4)) *)
+(*         as NORMALISE_BOUND. *)
+(*       { split. *)
+(*         apply Integers.Ptrofs.unsigned_range_2. *)
+(*         assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity. *)
+(*         unfold Integers.Ptrofs.divu at 2 in H0. *)
+(*         rewrite H0. clear H0. *)
+(*         rewrite Integers.Ptrofs.unsigned_repr; crush. *)
+(*         apply Zmult_lt_reg_r with (p := 4); try lia. *)
+(*         repeat rewrite ZLib.div_mul_undo; try lia. *)
+(*         apply Z.div_pos; small_tac. *)
+(*         apply Z.div_le_upper_bound; lia. } *)
+
+(*       inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ]; *)
+(*       clear NORMALISE_BOUND. *)
+
+(*       (** Start of proof proper *) *)
+(*       eexists. split. *)
+(*       eapply Smallstep.plus_one. *)
+(*       eapply HTL.step_module; eauto. *)
+(*       apply assumption_32bit. *)
+(*       econstructor. econstructor. econstructor. crush. *)
+(*       econstructor. econstructor. econstructor. crush. *)
+(*       econstructor. econstructor. econstructor. *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+(*       econstructor. *)
+(*       eapply Verilog.erun_Vbinop with (EQ := ?[EQ6]). *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+(*       econstructor. econstructor. *)
+
+(*       all: big_tac. *)
+
+(*       1: { assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+(*            eapply RTL.max_reg_function_def. eassumption. auto. *)
+(*            apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. } *)
+
+(*       2: { assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+(*            eapply RTL.max_reg_function_def. eassumption. auto. *)
+(*            apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. } *)
+
+(*       (** Match assocmaps *) *)
+(*       apply regs_lessdef_add_match; big_tac. *)
+
+(*       (** Equality proof *) *)
+(*       match goal with *)
+(*       | [ |- context [valueToNat ?x] ] => *)
+(*         assert (Z.to_nat *)
+(*                   (Integers.Ptrofs.unsigned *)
+(*                      (Integers.Ptrofs.divu *)
+(*                         OFFSET *)
+(*                         (Integers.Ptrofs.repr 4))) *)
+(*                 = *)
+(*                 valueToNat x) *)
+(*           as EXPR_OK by admit *)
+(*       end. *)
+(*       rewrite <- EXPR_OK. *)
+
+(*       specialize (H7 (Integers.Ptrofs.unsigned *)
+(*                         (Integers.Ptrofs.divu *)
+(*                            OFFSET *)
+(*                            (Integers.Ptrofs.repr 4)))). *)
+(*       exploit H7; big_tac. *)
+
+(*       (** RSBP preservation *) *)
+(*       unfold arr_stack_based_pointers in ASBP. *)
+(*       specialize (ASBP (Integers.Ptrofs.unsigned *)
+(*                           (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))). *)
+(*       exploit ASBP; big_tac. *)
+(*       rewrite NORMALISE in H0. rewrite H1 in H0. assumption. *)
+
+(*     + invert MARR. crush. *)
+
+(*       unfold Op.eval_addressing in H0. *)
+(*       destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+(*       rewrite ARCHI in H0. crush. *)
+
+(*       unfold check_address_parameter_unsigned in *; *)
+(*       unfold check_address_parameter_signed in *; crush. *)
+
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       rewrite ZERO in H1. clear ZERO. *)
+(*       rewrite Integers.Ptrofs.add_zero_l in H1. *)
+
+(*       remember i0 as OFFSET. *)
+
+(*       (** Modular preservation proof *) *)
+(*       rename H0 into MOD_PRESERVE. *)
+
+(*       (** Read bounds proof *) *)
+(*       assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH. *)
+(*       { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+(*         unfold stack_bounds in BOUNDS. *)
+(*         exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); big_tac. } *)
+
+(*       (** Normalisation proof *) *)
+(*       assert (Integers.Ptrofs.repr *)
+(*                 (4 * Integers.Ptrofs.unsigned *)
+(*                        (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET) *)
+(*         as NORMALISE. *)
+(*       { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity. *)
+(*         rewrite <- PtrofsExtra.mul_unsigned. *)
+(*         apply PtrofsExtra.mul_divu; crush. } *)
+
+(*       (** Normalised bounds proof *) *)
+(*       assert (0 <= *)
+(*               Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)) *)
+(*               < (RTL.fn_stacksize f / 4)) *)
+(*         as NORMALISE_BOUND. *)
+(*       { split. *)
+(*         apply Integers.Ptrofs.unsigned_range_2. *)
+(*         assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity. *)
+(*         unfold Integers.Ptrofs.divu at 2 in H0. *)
+(*         rewrite H0. clear H0. *)
+(*         rewrite Integers.Ptrofs.unsigned_repr; crush. *)
+(*         apply Zmult_lt_reg_r with (p := 4); try lia. *)
+(*         repeat rewrite ZLib.div_mul_undo; try lia. *)
+(*         apply Z.div_pos; small_tac. *)
+(*         apply Z.div_le_upper_bound; lia. } *)
+
+(*       inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ]; *)
+(*       clear NORMALISE_BOUND. *)
+
+(*       (** Start of proof proper *) *)
+(*       eexists. split. *)
+(*       eapply Smallstep.plus_one. *)
+(*       eapply HTL.step_module; eauto. *)
+(*       apply assumption_32bit. *)
+(*       econstructor. econstructor. econstructor. crush. *)
+(*       econstructor. econstructor. econstructor. econstructor. crush. *)
+
+(*       all: big_tac. *)
+
+(*       1: { assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+(*            eapply RTL.max_reg_function_def. eassumption. auto. *)
+(*            apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. } *)
+
+(*       2: { assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+(*            eapply RTL.max_reg_function_def. eassumption. auto. *)
+(*            apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. } *)
+
+(*       (** Match assocmaps *) *)
+(*       apply regs_lessdef_add_match; big_tac. *)
+
+(*       (** Equality proof *) *)
+(*       match goal with (* Prevents issues with evars *) *)
+(*       | [ |- context [valueToNat ?x] ] => *)
+(*         assert (Z.to_nat *)
+(*                   (Integers.Ptrofs.unsigned *)
+(*                      (Integers.Ptrofs.divu *)
+(*                         OFFSET *)
+(*                         (Integers.Ptrofs.repr 4))) *)
+(*                 = *)
+(*                 valueToNat x) *)
+(*           as EXPR_OK by admit *)
+(*       end. *)
+(*       rewrite <- EXPR_OK. *)
+
+(*       specialize (H7 (Integers.Ptrofs.unsigned *)
+(*                         (Integers.Ptrofs.divu *)
+(*                            OFFSET *)
+(*                            (Integers.Ptrofs.repr 4)))). *)
+(*       exploit H7; big_tac. *)
+
+(*       (** RSBP preservation *) *)
+(*       unfold arr_stack_based_pointers in ASBP. *)
+(*       specialize (ASBP (Integers.Ptrofs.unsigned *)
+(*                           (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))). *)
+(*       exploit ASBP; big_tac. *)
+(*       rewrite NORMALISE in H0. rewrite H1 in H0. assumption.*) *)
+(*   Admitted. *)
+(*   Hint Resolve transl_iload_correct : htlproof. *)
+
+(*   Lemma transl_istore_correct: *)
+(*     forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive) *)
+(*       (rs : Registers.Regmap.t Values.val) (m : mem) (chunk : AST.memory_chunk) *)
+(*       (addr : Op.addressing) (args : list Registers.reg) (src : Registers.reg) *)
+(*       (pc' : RTL.node) (a : Values.val) (m' : mem), *)
+(*       (RTL.fn_code f) ! pc = Some (RTL.Istore chunk addr args src pc') -> *)
+(*       Op.eval_addressing ge sp addr (map (fun r : positive => Registers.Regmap.get r rs) args) = Some a -> *)
+(*       Mem.storev chunk m a (Registers.Regmap.get src rs) = Some m' -> *)
+(*       forall R1 : HTL.state, *)
+(*         match_states (RTL.State s f sp pc rs m) R1 -> *)
+(*         exists R2 : HTL.state, *)
+(*           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m') R2. *)
+(*   Proof. *)
+(* (*    intros s f sp pc rs m chunk addr args src pc' a m' H H0 H1 R1 MSTATES. *)
+(*     inv_state. inv_arr_access. *)
+
+(*     + (** Preamble *) *)
+(*       invert MARR. crush. *)
+
+(*       unfold Op.eval_addressing in H0. *)
+(*       destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+
+(*       unfold reg_stack_based_pointers in RSBP. *)
+(*       pose proof (RSBP r0) as RSBPr0. *)
+
+(*       destruct (Registers.Regmap.get r0 rs) eqn:EQr0; crush. *)
+
+(*       rewrite ARCHI in H1. crush. *)
+(*       subst. *)
+
+(*       pose proof MASSOC as MASSOC'. *)
+(*       invert MASSOC'. *)
+(*       pose proof (H0 r0). *)
+(*       assert (HPler0 : Ple r0 (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_use; eauto; crush; eauto). *)
+(*       apply H6 in HPler0. *)
+(*       invert HPler0; try congruence. *)
+(*       rewrite EQr0 in H8. *)
+(*       invert H8. *)
+(*       clear H0. clear H6. *)
+
+(*       unfold check_address_parameter_unsigned in *; *)
+(*       unfold check_address_parameter_signed in *; crush. *)
+
+(*       remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+(*                                     (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET. *)
+
+(*       (** Modular preservation proof *) *)
+(*       assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+(*       { rewrite HeqOFFSET. *)
+(*         apply PtrofsExtra.add_mod; crush; try lia. *)
+(*         rewrite Integers.Ptrofs.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. *)
+(*         apply PtrofsExtra.of_int_mod. *)
+(*         rewrite Integers.Int.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. } *)
+
+(*       (** Write bounds proof *) *)
+(*       assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH. *)
+(*       { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+(*         unfold stack_bounds in BOUNDS. *)
+(*         exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); big_tac. *)
+(*         apply Integers.Ptrofs.unsigned_range_2. } *)
+
+(*       (** Start of proof proper *) *)
+(*       eexists. split. *)
+(*       eapply Smallstep.plus_one. *)
+(*       eapply HTL.step_module; eauto. *)
+(*       apply assumption_32bit. *)
+(*       econstructor. econstructor. econstructor. *)
+(*       eapply Verilog.stmnt_runp_Vnonblock_arr. crush. *)
+(*       econstructor. *)
+(*       eapply Verilog.erun_Vbinop with (EQ := ?[EQ7]). *)
+(*       eapply Verilog.erun_Vbinop with (EQ := ?[EQ8]). *)
+(*       econstructor. *)
+(*       econstructor. *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+
+(*       all: crush. *)
+
+(*       (** State Lookup *) *)
+(*       unfold Verilog.merge_regs. *)
+(*       crush. *)
+(*       unfold_merge. *)
+(*       apply AssocMap.gss. *)
+
+(*       (** Match states *) *)
+(*       rewrite assumption_32bit. *)
+(*       econstructor; eauto. *)
+
+(*       (** Match assocmaps *) *)
+(*       unfold Verilog.merge_regs. crush. unfold_merge. *)
+(*       apply regs_lessdef_add_greater. *)
+(*       unfold Plt; lia. *)
+(*       assumption. *)
+
+(*       (** States well formed *) *)
+(*       unfold state_st_wf. inversion 1. crush. *)
+(*       unfold Verilog.merge_regs. *)
+(*       unfold_merge. *)
+(*       apply AssocMap.gss. *)
+
+(*       (** Equality proof *) *)
+(*       match goal with *)
+(*       | [ |- context [valueToNat ?x] ] => *)
+(*         assert (Z.to_nat *)
+(*                   (Integers.Ptrofs.unsigned *)
+(*                      (Integers.Ptrofs.divu *)
+(*                         OFFSET *)
+(*                         (Integers.Ptrofs.repr 4))) *)
+(*                 = *)
+(*                 valueToNat x) *)
+(*           as EXPR_OK by admit *)
+(*       end. *)
+
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET. *)
+
+(*       econstructor. *)
+(*       repeat split; crush. *)
+(*       unfold HTL.empty_stack. *)
+(*       crush. *)
+(*       unfold Verilog.merge_arrs. *)
+
+(*       rewrite AssocMap.gcombine. *)
+(*       2: { reflexivity. } *)
+(*       unfold Verilog.arr_assocmap_set. *)
+(*       rewrite AssocMap.gss. *)
+(*       unfold Verilog.merge_arr. *)
+(*       rewrite AssocMap.gss. *)
+(*       setoid_rewrite H5. *)
+(*       reflexivity. *)
+
+(*       rewrite combine_length. *)
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       apply list_repeat_len. *)
+
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       rewrite list_repeat_len. *)
+(*       rewrite H4. reflexivity. *)
+
+(*       remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+(*                                     (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET. *)
+
+(*       destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+(*       erewrite Mem.load_store_same. *)
+(*       2: { rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite e. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            exact H1. *)
+(*            apply Integers.Ptrofs.unsigned_range_2. } *)
+(*       constructor. *)
+(*       erewrite combine_lookup_second. *)
+(*       simpl. *)
+(*       assert (Ple src (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+(*       apply H0 in H13. *)
+(*       destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; invert H13; eauto. *)
+
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       rewrite list_repeat_len. auto. *)
+
+(*       assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption). *)
+(*       rewrite Z.mul_comm in H13. *)
+(*       rewrite Z_div_mult in H13; try lia. *)
+(*       replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H13 by reflexivity. *)
+(*       rewrite <- PtrofsExtra.divu_unsigned in H13; unfold_constants; try lia. *)
+(*       rewrite H13. rewrite EXPR_OK. *)
+(*       rewrite array_get_error_set_bound. *)
+(*       reflexivity. *)
+(*       unfold arr_length, arr_repeat. simpl. *)
+(*       rewrite list_repeat_len. lia. *)
+
+(*       erewrite Mem.load_store_other with (m1 := m). *)
+(*       2: { exact H1. } *)
+(*       2: { right. *)
+(*            rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            simpl. *)
+(*            destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+(*            right. *)
+(*            apply ZExtra.mod_0_bounds; try lia. *)
+(*            apply ZLib.Z_mod_mult'. *)
+(*            rewrite Z2Nat.id in H15; try lia. *)
+(*            apply Zmult_lt_compat_r with (p := 4) in H15; try lia. *)
+(*            rewrite ZLib.div_mul_undo in H15; try lia. *)
+(*            split; try lia. *)
+(*            apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+(*       } *)
+
+(*       rewrite <- EXPR_OK. *)
+(*       rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia). *)
+(*       destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4). *)
+(*       apply Z.mul_cancel_r with (p := 4) in e; try lia. *)
+(*       rewrite ZLib.div_mul_undo in e; try lia. *)
+(*       rewrite combine_lookup_first. *)
+(*       eapply H7; eauto. *)
+
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       rewrite list_repeat_len. auto. *)
+(*       rewrite array_gso. *)
+(*       unfold array_get_error. *)
+(*       unfold arr_repeat. *)
+(*       crush. *)
+(*       apply list_repeat_lookup. *)
+(*       lia. *)
+(*       unfold_constants. *)
+(*       intro. *)
+(*       apply Z2Nat.inj_iff in H13; try lia. *)
+(*       apply Z.div_pos; try lia. *)
+(*       apply Integers.Ptrofs.unsigned_range. *)
+
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       unfold arr_stack_based_pointers. *)
+(*       intros. *)
+(*       destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+(*       crush. *)
+(*       erewrite Mem.load_store_same. *)
+(*       2: { rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite e. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            exact H1. *)
+(*            apply Integers.Ptrofs.unsigned_range_2. } *)
+(*       crush. *)
+(*       destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor. *)
+(*       destruct (Archi.ptr64); try discriminate. *)
+(*       pose proof (RSBP src). rewrite EQ_SRC in H0. *)
+(*       assumption. *)
+
+(*       simpl. *)
+(*       erewrite Mem.load_store_other with (m1 := m). *)
+(*       2: { exact H1. } *)
+(*       2: { right. *)
+(*            rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            simpl. *)
+(*            destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+(*            right. *)
+(*            apply ZExtra.mod_0_bounds; try lia. *)
+(*            apply ZLib.Z_mod_mult'. *)
+(*            invert H0. *)
+(*            apply Zmult_lt_compat_r with (p := 4) in H14; try lia. *)
+(*            rewrite ZLib.div_mul_undo in H14; try lia. *)
+(*            split; try lia. *)
+(*            apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+(*       } *)
+(*       apply ASBP; assumption. *)
+
+(*       unfold stack_bounds in *. intros. *)
+(*       simpl. *)
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       erewrite Mem.load_store_other with (m1 := m). *)
+(*       2: { exact H1. } *)
+(*       2: { right. right. simpl. *)
+(*            rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr; crush; try lia. *)
+(*            apply ZExtra.mod_0_bounds; crush; try lia. } *)
+(*       crush. *)
+(*       exploit (BOUNDS ptr); try lia. intros. crush. *)
+(*       exploit (BOUNDS ptr v); try lia. intros. *)
+(*       invert H0. *)
+(*       match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity. *)
+(*       assert (Mem.valid_access m AST.Mint32 sp' *)
+(*                                (Integers.Ptrofs.unsigned *)
+(*                                   (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+(*                                                        (Integers.Ptrofs.repr ptr))) Writable). *)
+(*       { pose proof H1. eapply Mem.store_valid_access_2 in H0. *)
+(*         exact H0. eapply Mem.store_valid_access_3. eassumption. } *)
+(*       pose proof (Mem.valid_access_store m AST.Mint32 sp' *)
+(*                                          (Integers.Ptrofs.unsigned *)
+(*                                             (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+(*                                                                  (Integers.Ptrofs.repr ptr))) v). *)
+(*       apply X in H0. invert H0. congruence. *)
+
+(*     + (** Preamble *) *)
+(*       invert MARR. crush. *)
+
+(*       unfold Op.eval_addressing in H0. *)
+(*       destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+
+(*       unfold reg_stack_based_pointers in RSBP. *)
+(*       pose proof (RSBP r0) as RSBPr0. *)
+(*       pose proof (RSBP r1) as RSBPr1. *)
+
+(*       destruct (Registers.Regmap.get r0 rs) eqn:EQr0; *)
+(*       destruct (Registers.Regmap.get r1 rs) eqn:EQr1; crush. *)
+
+(*       rewrite ARCHI in H1. crush. *)
+(*       subst. *)
+(*       clear RSBPr1. *)
+
+(*       pose proof MASSOC as MASSOC'. *)
+(*       invert MASSOC'. *)
+(*       pose proof (H0 r0). *)
+(*       pose proof (H0 r1). *)
+(*       assert (HPler0 : Ple r0 (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_use; eauto; crush; eauto). *)
+(*       assert (HPler1 : Ple r1 (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_use; eauto; simpl; auto). *)
+(*       apply H6 in HPler0. *)
+(*       apply H8 in HPler1. *)
+(*       invert HPler0; invert HPler1; try congruence. *)
+(*       rewrite EQr0 in H9. *)
+(*       rewrite EQr1 in H11. *)
+(*       invert H9. invert H11. *)
+(*       clear H0. clear H6. clear H8. *)
+
+(*       unfold check_address_parameter_signed in *; *)
+(*       unfold check_address_parameter_unsigned in *; crush. *)
+
+(*       remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+(*                                     (Integers.Ptrofs.of_int *)
+(*                                        (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z)) *)
+(*                                                          (Integers.Int.repr z0)))) as OFFSET. *)
+
+(*       (** Modular preservation proof *) *)
+(*       assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+(*       { rewrite HeqOFFSET. *)
+(*         apply PtrofsExtra.add_mod; crush; try lia. *)
+(*         rewrite Integers.Ptrofs.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. *)
+(*         apply PtrofsExtra.of_int_mod. *)
+(*         apply IntExtra.add_mod; crush. *)
+(*         apply IntExtra.mul_mod2; crush. *)
+(*         rewrite Integers.Int.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. *)
+(*         rewrite Integers.Int.unsigned_repr_eq. *)
+(*         rewrite <- Zmod_div_mod; crush. } *)
+
+(*       (** Write bounds proof *) *)
+(*       assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH. *)
+(*       { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+(*         unfold stack_bounds in BOUNDS. *)
+(*         exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); auto. *)
+(*         split; try lia; apply Integers.Ptrofs.unsigned_range_2. *)
+(*         small_tac. } *)
+
+(*       (** Start of proof proper *) *)
+(*       eexists. split. *)
+(*       eapply Smallstep.plus_one. *)
+(*       eapply HTL.step_module; eauto. *)
+(*       apply assumption_32bit. *)
+(*       econstructor. econstructor. econstructor. *)
+(*       eapply Verilog.stmnt_runp_Vnonblock_arr. crush. *)
+(*       econstructor. *)
+(*       eapply Verilog.erun_Vbinop with (EQ := ?[EQ9]). *)
+(*       eapply Verilog.erun_Vbinop with (EQ := ?[EQ10]). *)
+(*       eapply Verilog.erun_Vbinop with (EQ := ?[EQ11]). *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+(*       econstructor. *)
+(*       eapply Verilog.erun_Vbinop with (EQ := ?[EQ12]). *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+
+(*       all: crush. *)
+
+(*       (** State Lookup *) *)
+(*       unfold Verilog.merge_regs. *)
+(*       crush. *)
+(*       unfold_merge. *)
+(*       apply AssocMap.gss. *)
+
+(*       (** Match states *) *)
+(*       rewrite assumption_32bit. *)
+(*       econstructor; eauto. *)
+
+(*       (** Match assocmaps *) *)
+(*       unfold Verilog.merge_regs. crush. unfold_merge. *)
+(*       apply regs_lessdef_add_greater. *)
+(*       unfold Plt; lia. *)
+(*       assumption. *)
+
+(*       (** States well formed *) *)
+(*       unfold state_st_wf. inversion 1. crush. *)
+(*       unfold Verilog.merge_regs. *)
+(*       unfold_merge. *)
+(*       apply AssocMap.gss. *)
+
+(*       (** Equality proof *) *)
+(*       assert (Z.to_nat *)
+(*                 (Integers.Ptrofs.unsigned *)
+(*                    (Integers.Ptrofs.divu *)
+(*                       OFFSET *)
+(*                       (Integers.Ptrofs.repr 4))) *)
+(*               = *)
+(*               valueToNat (vdiv *)
+(*                             (vplus (vplus asr # r0 (ZToValue 32 z0) ?EQ11) (vmul asr # r1 (ZToValue 32 z) ?EQ12) *)
+(*                                    ?EQ10) (ZToValue 32 4) ?EQ9)) *)
+(*         as EXPR_OK by admit. *)
+
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET. *)
+
+(*       econstructor. *)
+(*       repeat split; crush. *)
+(*       unfold HTL.empty_stack. *)
+(*       crush. *)
+(*       unfold Verilog.merge_arrs. *)
+
+(*       rewrite AssocMap.gcombine. *)
+(*       2: { reflexivity. } *)
+(*       unfold Verilog.arr_assocmap_set. *)
+(*       rewrite AssocMap.gss. *)
+(*       unfold Verilog.merge_arr. *)
+(*       rewrite AssocMap.gss. *)
+(*       setoid_rewrite H5. *)
+(*       reflexivity. *)
+
+(*       rewrite combine_length. *)
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       apply list_repeat_len. *)
+
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       rewrite list_repeat_len. *)
+(*       rewrite H4. reflexivity. *)
+
+(*       remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+(*                                     (Integers.Ptrofs.of_int *)
+(*                                        (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z)) *)
+(*                                                          (Integers.Int.repr z0)))) as OFFSET. *)
+(*       destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+(*       erewrite Mem.load_store_same. *)
+(*       2: { rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite e. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            exact H1. *)
+(*            apply Integers.Ptrofs.unsigned_range_2. } *)
+(*       constructor. *)
+(*       erewrite combine_lookup_second. *)
+(*       simpl. *)
+(*       assert (Ple src (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+(*       apply H0 in H16. *)
+(*       destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; invert H16; eauto. *)
+
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       rewrite list_repeat_len. auto. *)
+
+(*       assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption). *)
+(*       rewrite Z.mul_comm in H16. *)
+(*       rewrite Z_div_mult in H16; try lia. *)
+(*       replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H16 by reflexivity. *)
+(*       rewrite <- PtrofsExtra.divu_unsigned in H16; unfold_constants; try lia. *)
+(*       rewrite H16. rewrite EXPR_OK. *)
+(*       rewrite array_get_error_set_bound. *)
+(*       reflexivity. *)
+(*       unfold arr_length, arr_repeat. simpl. *)
+(*       rewrite list_repeat_len. lia. *)
+
+(*       erewrite Mem.load_store_other with (m1 := m). *)
+(*       2: { exact H1. } *)
+(*       2: { right. *)
+(*            rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            simpl. *)
+(*            destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+(*            right. *)
+(*            apply ZExtra.mod_0_bounds; try lia. *)
+(*            apply ZLib.Z_mod_mult'. *)
+(*            rewrite Z2Nat.id in H18; try lia. *)
+(*            apply Zmult_lt_compat_r with (p := 4) in H18; try lia. *)
+(*            rewrite ZLib.div_mul_undo in H18; try lia. *)
+(*            split; try lia. *)
+(*            apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+(*       } *)
+
+(*       rewrite <- EXPR_OK. *)
+(*       rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia). *)
+(*       destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4). *)
+(*       apply Z.mul_cancel_r with (p := 4) in e; try lia. *)
+(*       rewrite ZLib.div_mul_undo in e; try lia. *)
+(*       rewrite combine_lookup_first. *)
+(*       eapply H7; eauto. *)
+
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       rewrite list_repeat_len. auto. *)
+(*       rewrite array_gso. *)
+(*       unfold array_get_error. *)
+(*       unfold arr_repeat. *)
+(*       crush. *)
+(*       apply list_repeat_lookup. *)
+(*       lia. *)
+(*       unfold_constants. *)
+(*       intro. *)
+(*       apply Z2Nat.inj_iff in H16; try lia. *)
+(*       apply Z.div_pos; try lia. *)
+(*       apply Integers.Ptrofs.unsigned_range. *)
+
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       unfold arr_stack_based_pointers. *)
+(*       intros. *)
+(*       destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+(*       crush. *)
+(*       erewrite Mem.load_store_same. *)
+(*       2: { rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite e. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            exact H1. *)
+(*            apply Integers.Ptrofs.unsigned_range_2. } *)
+(*       crush. *)
+(*       destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor. *)
+(*       destruct (Archi.ptr64); try discriminate. *)
+(*       pose proof (RSBP src). rewrite EQ_SRC in H0. *)
+(*       assumption. *)
+
+(*       simpl. *)
+(*       erewrite Mem.load_store_other with (m1 := m). *)
+(*       2: { exact H1. } *)
+(*       2: { right. *)
+(*            rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            simpl. *)
+(*            destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+(*            right. *)
+(*            apply ZExtra.mod_0_bounds; try lia. *)
+(*            apply ZLib.Z_mod_mult'. *)
+(*            invert H0. *)
+(*            apply Zmult_lt_compat_r with (p := 4) in H17; try lia. *)
+(*            rewrite ZLib.div_mul_undo in H17; try lia. *)
+(*            split; try lia. *)
+(*            apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+(*       } *)
+(*       apply ASBP; assumption. *)
+
+(*       unfold stack_bounds in *. intros. *)
+(*       simpl. *)
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       erewrite Mem.load_store_other with (m1 := m). *)
+(*       2: { exact H1. } *)
+(*       2: { right. right. simpl. *)
+(*            rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr; crush; try lia. *)
+(*            apply ZExtra.mod_0_bounds; crush; try lia. } *)
+(*       crush. *)
+(*       exploit (BOUNDS ptr); try lia. intros. crush. *)
+(*       exploit (BOUNDS ptr v); try lia. intros. *)
+(*       invert H0. *)
+(*       match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity. *)
+(*       assert (Mem.valid_access m AST.Mint32 sp' *)
+(*                                (Integers.Ptrofs.unsigned *)
+(*                                   (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+(*                                                        (Integers.Ptrofs.repr ptr))) Writable). *)
+(*       { pose proof H1. eapply Mem.store_valid_access_2 in H0. *)
+(*         exact H0. eapply Mem.store_valid_access_3. eassumption. } *)
+(*       pose proof (Mem.valid_access_store m AST.Mint32 sp' *)
+(*                                          (Integers.Ptrofs.unsigned *)
+(*                                             (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+(*                                                                  (Integers.Ptrofs.repr ptr))) v). *)
+(*       apply X in H0. invert H0. congruence. *)
+
+(*     + invert MARR. crush. *)
+
+(*       unfold Op.eval_addressing in H0. *)
+(*       destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+(*       rewrite ARCHI in H0. crush. *)
+
+(*       unfold check_address_parameter_unsigned in *; *)
+(*       unfold check_address_parameter_signed in *; crush. *)
+
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       rewrite ZERO in H1. clear ZERO. *)
+(*       rewrite Integers.Ptrofs.add_zero_l in H1. *)
+
+(*       remember i0 as OFFSET. *)
+
+(*       (** Modular preservation proof *) *)
+(*       rename H0 into MOD_PRESERVE. *)
+
+(*       (** Write bounds proof *) *)
+(*       assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH. *)
+(*       { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+(*         unfold stack_bounds in BOUNDS. *)
+(*         exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); auto. *)
+(*         crush. *)
+(*         replace (Integers.Ptrofs.repr 0) with (Integers.Ptrofs.zero) by reflexivity. *)
+(*         small_tac. } *)
+
+(*       (** Start of proof proper *) *)
+(*       eexists. split. *)
+(*       eapply Smallstep.plus_one. *)
+(*       eapply HTL.step_module; eauto. *)
+(*       apply assumption_32bit. *)
+(*       econstructor. econstructor. econstructor. *)
+(*       eapply Verilog.stmnt_runp_Vnonblock_arr. crush. *)
+(*       econstructor. econstructor. econstructor. econstructor. *)
+
+(*       all: crush. *)
+
+(*       (** State Lookup *) *)
+(*       unfold Verilog.merge_regs. *)
+(*       crush. *)
+(*       unfold_merge. *)
+(*       apply AssocMap.gss. *)
+
+(*       (** Match states *) *)
+(*       rewrite assumption_32bit. *)
+(*       econstructor; eauto. *)
+
+(*       (** Match assocmaps *) *)
+(*       unfold Verilog.merge_regs. crush. unfold_merge. *)
+(*       apply regs_lessdef_add_greater. *)
+(*       unfold Plt; lia. *)
+(*       assumption. *)
+
+(*       (** States well formed *) *)
+(*       unfold state_st_wf. inversion 1. crush. *)
+(*       unfold Verilog.merge_regs. *)
+(*       unfold_merge. *)
+(*       apply AssocMap.gss. *)
+
+(*       (** Equality proof *) *)
+(*       assert (Z.to_nat *)
+(*                 (Integers.Ptrofs.unsigned *)
+(*                    (Integers.Ptrofs.divu *)
+(*                       OFFSET *)
+(*                       (Integers.Ptrofs.repr 4))) *)
+(*               = *)
+(*               valueToNat (ZToValue 32 (Integers.Ptrofs.unsigned OFFSET / 4))) *)
+(*         as EXPR_OK by admit. *)
+
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET. *)
+
+(*       econstructor. *)
+(*       repeat split; crush. *)
+(*       unfold HTL.empty_stack. *)
+(*       crush. *)
+(*       unfold Verilog.merge_arrs. *)
+
+(*       rewrite AssocMap.gcombine. *)
+(*       2: { reflexivity. } *)
+(*       unfold Verilog.arr_assocmap_set. *)
+(*       rewrite AssocMap.gss. *)
+(*       unfold Verilog.merge_arr. *)
+(*       rewrite AssocMap.gss. *)
+(*       setoid_rewrite H5. *)
+(*       reflexivity. *)
+
+(*       rewrite combine_length. *)
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       apply list_repeat_len. *)
+
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       rewrite list_repeat_len. *)
+(*       rewrite H4. reflexivity. *)
+
+(*       remember i0 as OFFSET. *)
+(*       destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+(*       erewrite Mem.load_store_same. *)
+(*       2: { rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite e. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            exact H1. *)
+(*            apply Integers.Ptrofs.unsigned_range_2. } *)
+(*       constructor. *)
+(*       erewrite combine_lookup_second. *)
+(*       simpl. *)
+(*       assert (Ple src (RTL.max_reg_function f)) *)
+(*         by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+(*       apply H0 in H8. *)
+(*       destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; invert H8; eauto. *)
+
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       rewrite list_repeat_len. auto. *)
+
+(*       assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption). *)
+(*       rewrite Z.mul_comm in H8. *)
+(*       rewrite Z_div_mult in H8; try lia. *)
+(*       replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H8 by reflexivity. *)
+(*       rewrite <- PtrofsExtra.divu_unsigned in H8; unfold_constants; try lia. *)
+(*       rewrite H8. rewrite EXPR_OK. *)
+(*       rewrite array_get_error_set_bound. *)
+(*       reflexivity. *)
+(*       unfold arr_length, arr_repeat. simpl. *)
+(*       rewrite list_repeat_len. lia. *)
+
+(*       erewrite Mem.load_store_other with (m1 := m). *)
+(*       2: { exact H1. } *)
+(*       2: { right. *)
+(*            rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            simpl. *)
+(*            destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+(*            right. *)
+(*            apply ZExtra.mod_0_bounds; try lia. *)
+(*            apply ZLib.Z_mod_mult'. *)
+(*            rewrite Z2Nat.id in H11; try lia. *)
+(*            apply Zmult_lt_compat_r with (p := 4) in H11; try lia. *)
+(*            rewrite ZLib.div_mul_undo in H11; try lia. *)
+(*            split; try lia. *)
+(*            apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+(*       } *)
+
+(*       rewrite <- EXPR_OK. *)
+(*       rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia). *)
+(*       destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4). *)
+(*       apply Z.mul_cancel_r with (p := 4) in e; try lia. *)
+(*       rewrite ZLib.div_mul_undo in e; try lia. *)
+(*       rewrite combine_lookup_first. *)
+(*       eapply H7; eauto. *)
+
+(*       rewrite <- array_set_len. *)
+(*       unfold arr_repeat. crush. *)
+(*       rewrite list_repeat_len. auto. *)
+(*       rewrite array_gso. *)
+(*       unfold array_get_error. *)
+(*       unfold arr_repeat. *)
+(*       crush. *)
+(*       apply list_repeat_lookup. *)
+(*       lia. *)
+(*       unfold_constants. *)
+(*       intro. *)
+(*       apply Z2Nat.inj_iff in H8; try lia. *)
+(*       apply Z.div_pos; try lia. *)
+(*       apply Integers.Ptrofs.unsigned_range. *)
+
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       unfold arr_stack_based_pointers. *)
+(*       intros. *)
+(*       destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+(*       crush. *)
+(*       erewrite Mem.load_store_same. *)
+(*       2: { rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite e. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            exact H1. *)
+(*            apply Integers.Ptrofs.unsigned_range_2. } *)
+(*       crush. *)
+(*       destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor. *)
+(*       destruct (Archi.ptr64); try discriminate. *)
+(*       pose proof (RSBP src). rewrite EQ_SRC in H0. *)
+(*       assumption. *)
+
+(*       simpl. *)
+(*       erewrite Mem.load_store_other with (m1 := m). *)
+(*       2: { exact H1. } *)
+(*       2: { right. *)
+(*            rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr. *)
+(*            simpl. *)
+(*            destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+(*            right. *)
+(*            apply ZExtra.mod_0_bounds; try lia. *)
+(*            apply ZLib.Z_mod_mult'. *)
+(*            invert H0. *)
+(*            apply Zmult_lt_compat_r with (p := 4) in H9; try lia. *)
+(*            rewrite ZLib.div_mul_undo in H9; try lia. *)
+(*            split; try lia. *)
+(*            apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+(*       } *)
+(*       apply ASBP; assumption. *)
+
+(*       unfold stack_bounds in *. intros. *)
+(*       simpl. *)
+(*       assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+(*       erewrite Mem.load_store_other with (m1 := m). *)
+(*       2: { exact H1. } *)
+(*       2: { right. right. simpl. *)
+(*            rewrite ZERO. *)
+(*            rewrite Integers.Ptrofs.add_zero_l. *)
+(*            rewrite Integers.Ptrofs.unsigned_repr; crush; try lia. *)
+(*            apply ZExtra.mod_0_bounds; crush; try lia. } *)
+(*       crush. *)
+(*       exploit (BOUNDS ptr); try lia. intros. crush. *)
+(*       exploit (BOUNDS ptr v); try lia. intros. *)
+(*       invert H0. *)
+(*       match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity. *)
+(*       assert (Mem.valid_access m AST.Mint32 sp' *)
+(*                                (Integers.Ptrofs.unsigned *)
+(*                                   (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+(*                                                        (Integers.Ptrofs.repr ptr))) Writable). *)
+(*       { pose proof H1. eapply Mem.store_valid_access_2 in H0. *)
+(*         exact H0. eapply Mem.store_valid_access_3. eassumption. } *)
+(*       pose proof (Mem.valid_access_store m AST.Mint32 sp' *)
+(*                                          (Integers.Ptrofs.unsigned *)
+(*                                             (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+(*                                                                  (Integers.Ptrofs.repr ptr))) v). *)
+(*       apply X in H0. invert H0. congruence.*) *)
+(*   Admitted. *)
+(*   Hint Resolve transl_istore_correct : htlproof. *)
+
+(*   Lemma transl_icond_correct: *)
+(*     forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive) *)
+(*       (rs : Registers.Regmap.t Values.val) (m : mem) (cond : Op.condition) (args : list Registers.reg) *)
+(*       (ifso ifnot : RTL.node) (b : bool) (pc' : RTL.node), *)
+(*       (RTL.fn_code f) ! pc = Some (RTL.Icond cond args ifso ifnot) -> *)
+(*       Op.eval_condition cond (map (fun r : positive => Registers.Regmap.get r rs) args) m = Some b -> *)
+(*       pc' = (if b then ifso else ifnot) -> *)
+(*       forall R1 : HTL.state, *)
+(*         match_states (RTL.State s f sp pc rs m) R1 -> *)
+(*         exists R2 : HTL.state, *)
+(*           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m) R2. *)
+(*   Proof. *)
+(*     intros s f sp pc rs m cond args ifso ifnot b pc' H H0 H1 R1 MSTATE. *)
+(*     inv_state. *)
+
+(*     eexists. split. apply Smallstep.plus_one. *)
+(*     eapply HTL.step_module; eauto. *)
+(*     inv CONST; assumption. *)
+(*     inv CONST; assumption. *)
+(* (*    eapply Verilog.stmnt_runp_Vnonblock_reg with *)
+(*         (rhsval := if b then posToValue 32 ifso else posToValue 32 ifnot). *)
+(*     constructor. *)
+
+(*     simpl. *)
+(*     destruct b. *)
+(*     eapply Verilog.erun_Vternary_true. *)
+(*     eapply eval_cond_correct; eauto. *)
+(*     constructor. *)
+(*     apply boolToValue_ValueToBool. *)
+(*     eapply Verilog.erun_Vternary_false. *)
+(*     eapply eval_cond_correct; eauto. *)
+(*     constructor. *)
+(*     apply boolToValue_ValueToBool. *)
+(*     constructor. *)
+
+(*     big_tac. *)
+
+(*     invert MARR. *)
+(*     destruct b; rewrite assumption_32bit; big_tac. *)
+
+(*     Unshelve. *)
+(*     constructor. *)
+(*   Qed.*) *)
+(*   Admitted. *)
+(*   Hint Resolve transl_icond_correct : htlproof. *)
+
+(*   Lemma transl_ijumptable_correct: *)
+(*     forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive) *)
+(*       (rs : Registers.Regmap.t Values.val) (m : mem) (arg : Registers.reg) (tbl : list RTL.node) *)
+(*       (n : Integers.Int.int) (pc' : RTL.node), *)
+(*       (RTL.fn_code f) ! pc = Some (RTL.Ijumptable arg tbl) -> *)
+(*       Registers.Regmap.get arg rs = Values.Vint n -> *)
+(*       list_nth_z tbl (Integers.Int.unsigned n) = Some pc' -> *)
+(*       forall R1 : HTL.state, *)
+(*         match_states (RTL.State s f sp pc rs m) R1 -> *)
+(*         exists R2 : HTL.state, *)
+(*           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m) R2. *)
+(*   Proof. *)
+(*     intros s f sp pc rs m arg tbl n pc' H H0 H1 R1 MSTATE. *)
+(*   Admitted. *)
+(*   Hint Resolve transl_ijumptable_correct : htlproof. *)
+
+(*   Lemma transl_ireturn_correct: *)
+(*     forall (s : list RTL.stackframe) (f : RTL.function) (stk : Values.block) *)
+(*       (pc : positive) (rs : RTL.regset) (m : mem) (or : option Registers.reg) *)
+(*       (m' : mem), *)
+(*       (RTL.fn_code f) ! pc = Some (RTL.Ireturn or) -> *)
+(*       Mem.free m stk 0 (RTL.fn_stacksize f) = Some m' -> *)
+(*       forall R1 : HTL.state, *)
+(*         match_states (RTL.State s f (Values.Vptr stk Integers.Ptrofs.zero) pc rs m) R1 -> *)
+(*         exists R2 : HTL.state, *)
+(*           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ *)
+(*           match_states (RTL.Returnstate s (Registers.regmap_optget or Values.Vundef rs) m') R2. *)
+(*   Proof. *)
+(*     intros s f stk pc rs m or m' H H0 R1 MSTATE. *)
+(*     inv_state. *)
+
+(*     - econstructor. split. *)
+(*       eapply Smallstep.plus_two. *)
+
+(*       eapply HTL.step_module; eauto. *)
+(*       inv CONST; assumption. *)
+(*       inv CONST; assumption. *)
+(*       constructor. *)
+(*       econstructor; simpl; trivial. *)
+(*       econstructor; simpl; trivial. *)
+(*       constructor. *)
+(*       econstructor; simpl; trivial. *)
+(*       constructor. *)
+
+(*       constructor. constructor. *)
+
+(*       unfold state_st_wf in WF; big_tac; eauto. *)
+(*       destruct wf as [HCTRL HDATA]. apply HCTRL. *)
+(*       apply AssocMapExt.elements_iff. eexists. *)
+(*       match goal with H: control ! pc = Some _ |- _ => apply H end. *)
+
+(*       apply HTL.step_finish. *)
+(*       unfold Verilog.merge_regs. *)
+(*       unfold_merge; simpl. *)
+(*       rewrite AssocMap.gso. *)
+(*       apply AssocMap.gss. lia. *)
+(*       apply AssocMap.gss. *)
+(*       rewrite Events.E0_left. reflexivity. *)
+
+(*       constructor; auto. *)
+(*       constructor. *)
+
+(*     (* FIXME: Duplication *) *)
+(*     - econstructor. split. *)
+(*       eapply Smallstep.plus_two. *)
+(*       eapply HTL.step_module; eauto. *)
+(*       inv CONST; assumption. *)
+(*       inv CONST; assumption. *)
+(*       constructor. *)
+(*       econstructor; simpl; trivial. *)
+(*       econstructor; simpl; trivial. *)
+(*       constructor. constructor. constructor. *)
+(*       constructor. constructor. constructor. *)
+
+(*       unfold state_st_wf in WF; big_tac; eauto. *)
+
+(*       destruct wf as [HCTRL HDATA]. apply HCTRL. *)
+(*       apply AssocMapExt.elements_iff. eexists. *)
+(*       match goal with H: control ! pc = Some _ |- _ => apply H end. *)
+
+(*       apply HTL.step_finish. *)
+(*       unfold Verilog.merge_regs. *)
+(*       unfold_merge. *)
+(*       rewrite AssocMap.gso. *)
+(*       apply AssocMap.gss. simpl; lia. *)
+(*       apply AssocMap.gss. *)
+(*       rewrite Events.E0_left. trivial. *)
+
+(*       constructor; auto. *)
+
+(*       simpl. inversion MASSOC. subst. *)
+(*       unfold find_assocmap, AssocMapExt.get_default. rewrite AssocMap.gso. *)
+(*       apply H1. eapply RTL.max_reg_function_use. eauto. simpl; tauto. *)
+(*       assert (HPle : Ple r (RTL.max_reg_function f)). *)
+(*       eapply RTL.max_reg_function_use. eassumption. simpl; auto. *)
+(*       apply ZExtra.Ple_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. *)
+
+(*       Unshelve. *)
+(*       all: constructor. *)
+(*   Qed. *)
+(*   Hint Resolve transl_ireturn_correct : htlproof. *)
+
+(*   Lemma transl_callstate_correct: *)
+(*     forall (s : list RTL.stackframe) (f : RTL.function) (args : list Values.val) *)
+(*       (m : mem) (m' : Mem.mem') (stk : Values.block), *)
+(*       Mem.alloc m 0 (RTL.fn_stacksize f) = (m', stk) -> *)
+(*       forall R1 : HTL.state, *)
+(*         match_states (RTL.Callstate s (AST.Internal f) args m) R1 -> *)
+(*         exists R2 : HTL.state, *)
+(*           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ *)
+(*           match_states *)
+(*             (RTL.State s f (Values.Vptr stk Integers.Ptrofs.zero) (RTL.fn_entrypoint f) *)
+(*                        (RTL.init_regs args (RTL.fn_params f)) m') R2. *)
+(*   Proof. *)
+(*     intros s f args m m' stk H R1 MSTATE. *)
+
+(*     inversion MSTATE; subst. inversion TF; subst. *)
+(*     econstructor. split. apply Smallstep.plus_one. *)
+(*     eapply HTL.step_call. crush. *)
+
+(*     apply match_state with (sp' := stk); eauto. *)
+
+(*     all: big_tac. *)
+
+(*     apply regs_lessdef_add_greater. unfold Plt; lia. *)
+(*     apply regs_lessdef_add_greater. unfold Plt; lia. *)
+(*     apply regs_lessdef_add_greater. unfold Plt; lia. *)
+(*     apply init_reg_assoc_empty. *)
+
+(*     constructor. *)
+
+(*     destruct (Mem.load AST.Mint32 m' stk *)
+(*                        (Integers.Ptrofs.unsigned (Integers.Ptrofs.add *)
+(*                                                     Integers.Ptrofs.zero *)
+(*                                                     (Integers.Ptrofs.repr (4 * ptr))))) eqn:LOAD. *)
+(*     pose proof Mem.load_alloc_same as LOAD_ALLOC. *)
+(*     pose proof H as ALLOC. *)
+(*     eapply LOAD_ALLOC in ALLOC. *)
+(*     2: { exact LOAD. } *)
+(*     ptrofs. rewrite LOAD. *)
+(*     rewrite ALLOC. *)
+(*     repeat constructor. *)
+
+(*     ptrofs. rewrite LOAD. *)
+(*     repeat constructor. *)
+
+(*     unfold reg_stack_based_pointers. intros. *)
+(*     unfold RTL.init_regs; crush. *)
+(*     destruct (RTL.fn_params f); *)
+(*     rewrite Registers.Regmap.gi; constructor. *)
+
+(*     unfold arr_stack_based_pointers. intros. *)
+(*     crush. *)
+(*     destruct (Mem.load AST.Mint32 m' stk *)
+(*                        (Integers.Ptrofs.unsigned (Integers.Ptrofs.add *)
+(*                                                     Integers.Ptrofs.zero *)
+(*                                                     (Integers.Ptrofs.repr (4 * ptr))))) eqn:LOAD. *)
+(*     pose proof Mem.load_alloc_same as LOAD_ALLOC. *)
+(*     pose proof H as ALLOC. *)
+(*     eapply LOAD_ALLOC in ALLOC. *)
+(*     2: { exact LOAD. } *)
+(*     rewrite ALLOC. *)
+(*     repeat constructor. *)
+(*     constructor. *)
+
+(*     Transparent Mem.alloc. (* TODO: Since there are opaque there's probably a lemma. *) *)
+(*     Transparent Mem.load. *)
+(*     Transparent Mem.store. *)
+(*     unfold stack_bounds. *)
+(*     split. *)
+
+(*     unfold Mem.alloc in H. *)
+(*     invert H. *)
+(*     crush. *)
+(*     unfold Mem.load. *)
+(*     intros. *)
+(*     match goal with | |- context[if ?x then _ else _] => destruct x end; try congruence. *)
+(*     invert v0. unfold Mem.range_perm in H4. *)
+(*     unfold Mem.perm in H4. crush. *)
+(*     unfold Mem.perm_order' in H4. *)
+(*     small_tac. *)
+(*     exploit (H4 ptr). rewrite Integers.Ptrofs.unsigned_repr; small_tac. intros. *)
+(*     rewrite Maps.PMap.gss in H8. *)
+(*     match goal with | H8 : context[if ?x then _ else _] |- _ => destruct x eqn:EQ end; try contradiction. *)
+(*     crush. *)
+(*     apply proj_sumbool_true in H10. lia. *)
+
+(*     unfold Mem.alloc in H. *)
+(*     invert H. *)
+(*     crush. *)
+(*     unfold Mem.store. *)
+(*     intros. *)
+(*     match goal with | |- context[if ?x then _ else _] => destruct x end; try congruence. *)
+(*     invert v0. unfold Mem.range_perm in H4. *)
+(*     unfold Mem.perm in H4. crush. *)
+(*     unfold Mem.perm_order' in H4. *)
+(*     small_tac. *)
+(*     exploit (H4 ptr). rewrite Integers.Ptrofs.unsigned_repr; small_tac. intros. *)
+(*     rewrite Maps.PMap.gss in H8. *)
+(*     match goal with | H8 : context[if ?x then _ else _] |- _ => destruct x eqn:EQ end; try contradiction. *)
+(*     crush. *)
+(*     apply proj_sumbool_true in H10. lia. *)
+(*     constructor. simplify. rewrite AssocMap.gss. *)
+(*     simplify. rewrite AssocMap.gso. apply AssocMap.gss. simplify. lia. *)
+(*     Opaque Mem.alloc. *)
+(*     Opaque Mem.load. *)
+(*     Opaque Mem.store. *)
+(*   Qed. *)
+(*   Hint Resolve transl_callstate_correct : htlproof. *)
+
+(*   Lemma transl_returnstate_correct: *)
+(*     forall (res0 : Registers.reg) (f : RTL.function) (sp : Values.val) (pc : RTL.node) *)
+(*       (rs : RTL.regset) (s : list RTL.stackframe) (vres : Values.val) (m : mem) *)
+(*       (R1 : HTL.state), *)
+(*       match_states (RTL.Returnstate (RTL.Stackframe res0 f sp pc rs :: s) vres m) R1 -> *)
+(*       exists R2 : HTL.state, *)
+(*         Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ *)
+(*         match_states (RTL.State s f sp pc (Registers.Regmap.set res0 vres rs) m) R2. *)
+(*   Proof. *)
+(*     intros res0 f sp pc rs s vres m R1 MSTATE. *)
+(*     inversion MSTATE. inversion MF. *)
+(*   Qed. *)
+(*   Hint Resolve transl_returnstate_correct : htlproof. *)
+
+(*   Lemma option_inv : *)
+(*     forall A x y, *)
+(*       @Some A x = Some y -> x = y. *)
+(*   Proof. intros. inversion H. trivial. Qed. *)
+
+(*   Lemma main_tprog_internal : *)
+(*     forall b, *)
+(*       Globalenvs.Genv.find_symbol tge tprog.(AST.prog_main) = Some b -> *)
+(*       exists f, Genv.find_funct_ptr (Genv.globalenv tprog) b = Some (AST.Internal f). *)
+(*   Proof. *)
+(*     intros. *)
+(*     destruct TRANSL. unfold main_is_internal in H1. *)
+(*     repeat (unfold_match H1). replace b with b0. *)
+(*     exploit function_ptr_translated; eauto. intros [tf [A B]]. *)
+(*     unfold transl_fundef, AST.transf_partial_fundef, Errors.bind in B. *)
+(*     unfold_match B. inv B. econstructor. apply A. *)
+
+(*     apply option_inv. rewrite <- Heqo. rewrite <- H. *)
+(*     rewrite symbols_preserved. replace (AST.prog_main tprog) with (AST.prog_main prog). *)
+(*     trivial. symmetry; eapply Linking.match_program_main; eauto. *)
+(*   Qed. *)
+
+(*   Lemma transl_initial_states : *)
+(*     forall s1 : Smallstep.state (RTL.semantics prog), *)
+(*       Smallstep.initial_state (RTL.semantics prog) s1 -> *)
+(*       exists s2 : Smallstep.state (HTL.semantics tprog), *)
+(*         Smallstep.initial_state (HTL.semantics tprog) s2 /\ match_states s1 s2. *)
+(*   Proof. *)
+(*     induction 1. *)
+(*     destruct TRANSL. unfold main_is_internal in H4. *)
+(*     repeat (unfold_match H4). *)
+(*     assert (f = AST.Internal f1). apply option_inv. *)
+(*     rewrite <- Heqo0. rewrite <- H1. replace b with b0. *)
+(*     auto. apply option_inv. rewrite <- H0. rewrite <- Heqo. *)
+(*     trivial. *)
+(*     exploit function_ptr_translated; eauto. *)
+(*     intros [tf [A B]]. *)
+(*     unfold transl_fundef, Errors.bind in B. *)
+(*     unfold AST.transf_partial_fundef, Errors.bind in B. *)
+(*     repeat (unfold_match B). inversion B. subst. *)
+(*     exploit main_tprog_internal; eauto; intros. *)
+(*     rewrite symbols_preserved. replace (AST.prog_main tprog) with (AST.prog_main prog). *)
+(*     apply Heqo. symmetry; eapply Linking.match_program_main; eauto. *)
+(*     inversion H5. *)
+(*     econstructor; split. econstructor. *)
+(*     apply (Genv.init_mem_transf_partial TRANSL'); eauto. *)
+(*     replace (AST.prog_main tprog) with (AST.prog_main prog). *)
+(*     rewrite symbols_preserved; eauto. *)
+(*     symmetry; eapply Linking.match_program_main; eauto. *)
+(*     apply H6. *)
+
+(*     constructor. *)
+(*     apply transl_module_correct. *)
+(*     assert (Some (AST.Internal x) = Some (AST.Internal m)). *)
+(*     replace (AST.fundef HTL.module) with (HTL.fundef). *)
+(*     rewrite <- H6. setoid_rewrite <- A. trivial. *)
+(*     trivial. inv H7. assumption. *)
+(*   Qed. *)
+(*   Hint Resolve transl_initial_states : htlproof. *)
+
+(*   Lemma transl_final_states : *)
+(*     forall (s1 : Smallstep.state (RTL.semantics prog)) *)
+(*            (s2 : Smallstep.state (HTL.semantics tprog)) *)
+(*            (r : Integers.Int.int), *)
+(*       match_states s1 s2 -> *)
+(*       Smallstep.final_state (RTL.semantics prog) s1 r -> *)
+(*       Smallstep.final_state (HTL.semantics tprog) s2 r. *)
+(*   Proof. *)
+(*     intros. inv H0. inv H. inv H4. invert MF. constructor. reflexivity. *)
+(*   Qed. *)
+(*   Hint Resolve transl_final_states : htlproof. *)
+
+(*   Theorem transl_step_correct: *)
+(*     forall (S1 : RTL.state) t S2, *)
+(*       RTL.step ge S1 t S2 -> *)
+(*       forall (R1 : HTL.state), *)
+(*         match_states S1 R1 -> *)
+(*         exists R2, Smallstep.plus HTL.step tge R1 t R2 /\ match_states S2 R2. *)
+(*   Proof. *)
+(*     induction 1; eauto with htlproof; (intros; inv_state). *)
+(*   Qed. *)
+(*   Hint Resolve transl_step_correct : htlproof. *)
 
   Theorem transf_program_correct:
     Smallstep.forward_simulation (RTL.semantics prog) (HTL.semantics tprog).
   Proof.
-    eapply Smallstep.forward_simulation_plus; eauto with htlproof.
-    apply senv_preserved.
-  Qed.
+  (*   eapply Smallstep.forward_simulation_plus; eauto with htlproof. *)
+  (*   apply senv_preserved. *)
+  (* Qed. *)
+  Admitted.
 
 End CORRECTNESS.
diff --git a/src/translation/HTLgenspec.v b/src/translation/HTLgenspec.v
index 0cdecba..82b6da9 100644
--- a/src/translation/HTLgenspec.v
+++ b/src/translation/HTLgenspec.v
@@ -17,8 +17,9 @@
  *)
 
 From compcert Require RTL Op Maps Errors.
-From compcert Require Import Maps.
-From coqup Require Import Coquplib Verilog Value HTL HTLgen AssocMap.
+From compcert Require Import Maps Integers.
+From coqup Require Import Coquplib Verilog ValueInt HTL HTLgen AssocMap.
+Require Import Lia.
 
 Hint Resolve Maps.PTree.elements_keys_norepet : htlspec.
 Hint Resolve Maps.PTree.elements_correct : htlspec.
@@ -116,31 +117,40 @@ translations for each of the elements *)
 Inductive tr_instr (fin rtrn st stk : reg) : RTL.instruction -> stmnt -> stmnt -> Prop :=
 | tr_instr_Inop :
     forall n,
+      Z.pos n <= Int.max_unsigned ->
       tr_instr fin rtrn st stk (RTL.Inop n) Vskip (state_goto st n)
 | tr_instr_Iop :
     forall n op args dst s s' e i,
+      Z.pos n <= Int.max_unsigned ->
       translate_instr op args s = OK e s' i ->
       tr_instr fin rtrn st stk (RTL.Iop op args dst n) (Vnonblock (Vvar dst) e) (state_goto st n)
 | tr_instr_Icond :
     forall n1 n2 cond args s s' i c,
+      Z.pos n1 <= Int.max_unsigned ->
+      Z.pos n2 <= Int.max_unsigned ->
       translate_condition cond args s = OK c s' i ->
       tr_instr fin rtrn st stk (RTL.Icond cond args n1 n2) Vskip (state_cond st c n1 n2)
 | tr_instr_Ireturn_None :
-    tr_instr fin rtrn st stk (RTL.Ireturn None) (Vseq (block fin (Vlit (ZToValue 1%nat 1%Z)))
-                                                  (block rtrn (Vlit (ZToValue 1%nat 0%Z)))) Vskip
+    tr_instr fin rtrn st stk (RTL.Ireturn None) (Vseq (block fin (Vlit (ZToValue 1%Z)))
+                                                  (block rtrn (Vlit (ZToValue 0%Z)))) Vskip
 | tr_instr_Ireturn_Some :
     forall r,
       tr_instr fin rtrn st stk (RTL.Ireturn (Some r))
-               (Vseq (block fin (Vlit (ZToValue 1%nat 1%Z))) (block rtrn (Vvar r))) Vskip
+               (Vseq (block fin (Vlit (ZToValue 1%Z))) (block rtrn (Vvar r))) Vskip
 | tr_instr_Iload :
-    forall mem addr args s s' i c dst n,
-      translate_arr_access mem addr args stk s = OK c s' i ->
-      tr_instr fin rtrn st stk (RTL.Iload mem addr args dst n) (nonblock dst c) (state_goto st n)
+    forall chunk addr args s s' i e dst n,
+      Z.pos n <= Int.max_unsigned ->
+      chunk = AST.Mint32 ->
+      translate_arr_addressing addr args s = OK e s' i ->
+      tr_instr fin rtrn st stk (RTL.Iload chunk addr args dst n)
+                               (create_single_cycle_load stk e dst) (state_goto st n)
 | tr_instr_Istore :
-    forall mem addr args s s' i c src n,
-      translate_arr_access mem addr args stk s = OK c s' i ->
-      tr_instr fin rtrn st stk (RTL.Istore mem addr args src n) (Vnonblock c (Vvar src))
-               (state_goto st n)
+    forall chunk addr args s s' i e src n,
+      Z.pos n <= Int.max_unsigned ->
+      chunk = AST.Mint32 ->
+      translate_arr_addressing addr args s = OK e s' i ->
+      tr_instr fin rtrn st stk (RTL.Istore chunk addr args src n)
+                               (create_single_cycle_store stk e src) (state_goto st n)
 | tr_instr_Ijumptable :
     forall cexpr tbl r,
     cexpr = tbl_to_case_expr st tbl ->
@@ -160,17 +170,24 @@ Hint Constructors tr_code : htlspec.
 
 Inductive tr_module (f : RTL.function) : module -> Prop :=
   tr_module_intro :
-    forall data control fin rtrn st stk stk_len m start rst clk scldecls arrdecls,
-      (forall pc i, Maps.PTree.get pc f.(RTL.fn_code) = Some i ->
-               tr_code f.(RTL.fn_code) pc i data control fin rtrn st stk) ->
-      stk_len = Z.to_nat (f.(RTL.fn_stacksize) / 4) ->
-      Z.modulo (f.(RTL.fn_stacksize)) 4 = 0 ->
-      0 <= f.(RTL.fn_stacksize) < Integers.Ptrofs.modulus ->
+    forall data control fin rtrn st stk stk_len m start rst clk scldecls arrdecls wf,
       m = (mkmodule f.(RTL.fn_params)
                         data
                         control
                         f.(RTL.fn_entrypoint)
-                        st stk stk_len fin rtrn start rst clk scldecls arrdecls) ->
+                        st stk stk_len fin rtrn start rst clk scldecls arrdecls wf) ->
+      (forall pc i, Maps.PTree.get pc f.(RTL.fn_code) = Some i ->
+               tr_code f.(RTL.fn_code) pc i data control fin rtrn st stk) ->
+      stk_len = Z.to_nat f.(RTL.fn_stacksize) ->
+      Z.modulo (f.(RTL.fn_stacksize)) 4 = 0 ->
+      0 <= f.(RTL.fn_stacksize) < Integers.Ptrofs.modulus ->
+      st = ((RTL.max_reg_function f) + 1)%positive ->
+      fin = ((RTL.max_reg_function f) + 2)%positive ->
+      rtrn = ((RTL.max_reg_function f) + 3)%positive ->
+      stk = ((RTL.max_reg_function f) + 4)%positive ->
+      start = ((RTL.max_reg_function f) + 5)%positive ->
+      rst = ((RTL.max_reg_function f) + 6)%positive ->
+      clk = ((RTL.max_reg_function f) + 7)%positive ->
       tr_module f m.
 Hint Constructors tr_module : htlspec.
 
@@ -202,6 +219,13 @@ Lemma declare_reg_controllogic_trans :
 Proof. intros. monadInv H. trivial. Qed.
 Hint Resolve create_reg_controllogic_trans : htlspec.
 
+Lemma declare_reg_freshreg_trans :
+  forall sz s s' x i iop r,
+    declare_reg iop r sz s = OK x s' i ->
+    s.(st_freshreg) = s'.(st_freshreg).
+Proof. inversion 1; auto. Qed.
+Hint Resolve declare_reg_freshreg_trans : htlspec.
+
 Lemma create_arr_datapath_trans :
   forall sz ln s s' x i iop,
     create_arr iop sz ln s = OK x s' i ->
@@ -268,6 +292,16 @@ Proof.
   - apply H in EQ. rewrite EQ. eauto.
 Qed.
 
+Lemma collect_freshreg_trans :
+  forall A f l cs cs' ci,
+  (forall s s' x i y, f y s = OK x s' i -> s.(st_freshreg) = s'.(st_freshreg)) ->
+  @HTLMonadExtra.collectlist A f l cs = OK tt cs' ci -> cs.(st_freshreg) = cs'.(st_freshreg).
+Proof.
+  induction l; intros; monadInv H0.
+  - trivial.
+  - apply H in EQ. rewrite EQ. eauto.
+Qed.
+
 Lemma collect_declare_controllogic_trans :
   forall io n l s s' i,
   HTLMonadExtra.collectlist (fun r : reg => declare_reg io r n) l s = OK tt s' i ->
@@ -286,6 +320,153 @@ Proof.
   intros. eapply declare_reg_datapath_trans. simpl in H0. eassumption.
 Qed.
 
+Lemma collect_declare_freshreg_trans :
+  forall io n l s s' i,
+  HTLMonadExtra.collectlist (fun r : reg => declare_reg io r n) l s = OK tt s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  intros. eapply collect_freshreg_trans; try eassumption.
+  inversion 1. auto.
+Qed.
+
+Ltac unfold_match H :=
+  match type of H with
+  | context[match ?g with _ => _ end] => destruct g eqn:?; try discriminate
+  end.
+
+Lemma translate_eff_addressing_freshreg_trans :
+  forall op args s r s' i,
+  translate_eff_addressing op args s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  destruct op; intros; simpl in *; repeat (unfold_match H); inv H; auto.
+Qed.
+Hint Resolve translate_eff_addressing_freshreg_trans : htlspec.
+
+Lemma translate_arr_addressing_freshreg_trans :
+  forall op args s r s' i,
+  translate_arr_addressing op args s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  destruct op; intros; simpl in *; repeat (unfold_match H); inv H; auto.
+Qed.
+Hint Resolve translate_eff_addressing_freshreg_trans : htlspec.
+
+Lemma translate_comparison_freshreg_trans :
+  forall op args s r s' i,
+  translate_comparison op args s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  destruct op; intros; simpl in *; repeat (unfold_match H); inv H; auto.
+Qed.
+Hint Resolve translate_comparison_freshreg_trans : htlspec.
+
+Lemma translate_comparisonu_freshreg_trans :
+  forall op args s r s' i,
+  translate_comparisonu op args s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  destruct op; intros; simpl in *; repeat (unfold_match H); inv H; auto.
+Qed.
+Hint Resolve translate_comparisonu_freshreg_trans : htlspec.
+
+Lemma translate_comparison_imm_freshreg_trans :
+  forall op args s r s' i n,
+  translate_comparison_imm op args n s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  destruct op; intros; simpl in *; repeat (unfold_match H); inv H; auto.
+Qed.
+Hint Resolve translate_comparison_imm_freshreg_trans : htlspec.
+
+Lemma translate_comparison_immu_freshreg_trans :
+  forall op args s r s' i n,
+  translate_comparison_immu op args n s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  destruct op; intros; simpl in *; repeat (unfold_match H); inv H; auto.
+Qed.
+Hint Resolve translate_comparison_immu_freshreg_trans : htlspec.
+
+Lemma translate_condition_freshreg_trans :
+  forall op args s r s' i,
+  translate_condition op args s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  destruct op; intros; simpl in *; repeat (unfold_match H); inv H; eauto with htlspec.
+Qed.
+Hint Resolve translate_condition_freshreg_trans : htlspec.
+
+Lemma translate_instr_freshreg_trans :
+  forall op args s r s' i,
+  translate_instr op args s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  destruct op; intros; simpl in *; repeat (unfold_match H); inv H; eauto with htlspec.
+  monadInv H1. eauto with htlspec.
+Qed.
+Hint Resolve translate_instr_freshreg_trans : htlspec.
+
+Lemma add_instr_freshreg_trans :
+  forall n n' st s r s' i,
+  add_instr n n' st s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof. intros. unfold add_instr in H. repeat (unfold_match H). inv H. auto. Qed.
+Hint Resolve add_instr_freshreg_trans : htlspec.
+
+Lemma add_branch_instr_freshreg_trans :
+  forall n n0 n1 e s r s' i,
+  add_branch_instr e n n0 n1 s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof. intros. unfold add_branch_instr in H. repeat (unfold_match H). inv H. auto. Qed.
+Hint Resolve add_branch_instr_freshreg_trans : htlspec.
+
+Lemma add_node_skip_freshreg_trans :
+  forall n1 n2 s r s' i,
+  add_node_skip n1 n2 s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof. intros. unfold add_node_skip in H. repeat (unfold_match H). inv H. auto. Qed.
+Hint Resolve add_node_skip_freshreg_trans : htlspec.
+
+Lemma add_instr_skip_freshreg_trans :
+  forall n1 n2 s r s' i,
+  add_instr_skip n1 n2 s = OK r s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof. intros. unfold add_instr_skip in H. repeat (unfold_match H). inv H. auto. Qed.
+Hint Resolve add_instr_skip_freshreg_trans : htlspec.
+
+Lemma transf_instr_freshreg_trans :
+  forall fin ret st instr s v s' i,
+    transf_instr fin ret st instr s = OK v s' i ->
+    s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  intros. destruct instr eqn:?. subst. unfold transf_instr in H.
+  destruct i0; try (monadInv H); try (unfold_match H); eauto with htlspec.
+  - monadInv H. apply add_instr_freshreg_trans in EQ2. apply translate_instr_freshreg_trans in EQ.
+    apply declare_reg_freshreg_trans in EQ1. congruence.
+  - destruct (Z.pos n0 <=? Int.max_unsigned); try discriminate.
+    monadInv H. apply add_instr_freshreg_trans in EQ2.
+    apply translate_arr_addressing_freshreg_trans in EQ.
+    apply declare_reg_freshreg_trans in EQ1. congruence.
+  - destruct (Z.pos n0 <=? Int.max_unsigned); try discriminate.
+    monadInv H. apply add_instr_freshreg_trans in EQ0.
+    apply translate_arr_addressing_freshreg_trans in EQ. congruence.
+  - monadInv H. apply translate_condition_freshreg_trans in EQ.
+    apply add_branch_instr_freshreg_trans in EQ0.
+    congruence.
+  - inv EQ. apply add_node_skip_freshreg_trans in EQ0. congruence.
+Qed.
+Hint Resolve transf_instr_freshreg_trans : htlspec.
+
+Lemma collect_trans_instr_freshreg_trans :
+  forall fin ret st l s s' i,
+  HTLMonadExtra.collectlist (transf_instr fin ret st) l s = OK tt s' i ->
+  s.(st_freshreg) = s'.(st_freshreg).
+Proof.
+  intros. eapply collect_freshreg_trans; try eassumption.
+  eauto with htlspec.
+Qed.
+
 Ltac rewrite_states :=
   match goal with
   | [ H: ?x ?s = ?x ?s' |- _ ] =>
@@ -294,20 +475,18 @@ Ltac rewrite_states :=
     remember (?x ?s) as c1; remember (?x ?s') as c2; try subst
   end.
 
-Ltac unfold_match H :=
-  match type of H with
-  | context[match ?g with _ => _ end] => destruct g eqn:?; try discriminate
-  end.
-
 Ltac inv_add_instr' H :=
   match type of H with
+  | ?f _ _ = OK _ _ _ => unfold f in H
   | ?f _ _ _ = OK _ _ _ => unfold f in H
   | ?f _ _ _ _ = OK _ _ _ => unfold f in H
   | ?f _ _ _ _ _ = OK _ _ _ => unfold f in H
+  | ?f _ _ _ _ _ _ = OK _ _ _ => unfold f in H
   end; repeat unfold_match H; inversion H.
 
 Ltac inv_add_instr :=
-  lazymatch goal with
+  match goal with
+  | H: (if ?c then _ else _) _ = OK _ _ _ |- _ => destruct c eqn:EQN; try discriminate; inv_add_instr
   | H: context[add_instr_skip _ _ _] |- _ =>
     inv_add_instr' H
   | H: context[add_instr_skip _ _] |- _ =>
@@ -343,28 +522,34 @@ Proof.
   destruct (peq pc pc1).
   - subst.
     destruct instr1 eqn:?; try discriminate;
-      try destruct_optional; inv_add_instr; econstructor; try assumption.
+      try destruct_optional; try (destruct m; try discriminate);
+        inv_add_instr; econstructor; try assumption.
     + destruct o with pc1; destruct H11; simpl in *; rewrite AssocMap.gss in H9; eauto; congruence.
     + destruct o0 with pc1; destruct H11; simpl in *; rewrite AssocMap.gss in H9; eauto; congruence.
     + inversion H2. inversion H9. rewrite H. apply tr_instr_Inop.
+      apply Z.leb_le. assumption.
       eapply in_map with (f := fst) in H9. contradiction.
 
     + destruct o with pc1; destruct H16; simpl in *; rewrite AssocMap.gss in H14; eauto; congruence.
     + destruct o0 with pc1; destruct H16; simpl in *; rewrite AssocMap.gss in H14; eauto; congruence.
     + inversion H2. inversion H14. unfold nonblock. replace (st_st s4) with (st_st s2) by congruence.
-      econstructor. apply EQ1. eapply in_map with (f := fst) in H14. contradiction.
+      econstructor. apply Z.leb_le; assumption.
+      apply EQ1. eapply in_map with (f := fst) in H14. contradiction.
 
     + destruct o with pc1; destruct H16; simpl in *; rewrite AssocMap.gss in H14; eauto; congruence.
     + destruct o0 with pc1; destruct H16; simpl in *; rewrite AssocMap.gss in H14; eauto; congruence.
     + inversion H2. inversion H14. rewrite <- e2. replace (st_st s2) with (st_st s0) by congruence.
-      econstructor. apply EQ1. eapply in_map with (f := fst) in H14. contradiction.
+      econstructor. apply Z.leb_le; assumption.
+      reflexivity.
+      apply EQ1. eapply in_map with (f := fst) in H14. contradiction.
 
     + destruct o with pc1; destruct H11; simpl in *; rewrite AssocMap.gss in H9; eauto; congruence.
     + destruct o0 with pc1; destruct H11; simpl in *; rewrite AssocMap.gss in H9; eauto; congruence.
     + destruct H2.
       * inversion H2.
         replace (st_st s2) with (st_st s0) by congruence.
-        eauto with htlspec.
+        econstructor. apply Z.leb_le; assumption.
+        eauto with htlspec. eassumption.
       * apply in_map with (f := fst) in H2. contradiction.
 
     + destruct o with pc1; destruct H11; simpl in *; rewrite AssocMap.gss in H9; eauto; congruence.
@@ -372,6 +557,7 @@ Proof.
     + destruct H2.
       * inversion H2.
         replace (st_st s2) with (st_st s0) by congruence.
+        econstructor; try (apply Z.leb_le; apply andb_prop in EQN; apply EQN).
         eauto with htlspec.
       * apply in_map with (f := fst) in H2. contradiction.
 
@@ -405,9 +591,17 @@ Qed.
 Hint Resolve iter_expand_instr_spec : htlspec.
 
 Lemma create_arr_inv : forall w x y z a b c d,
-    create_arr w x y z = OK (a, b) c d -> y = b.
+    create_arr w x y z = OK (a, b) c d ->
+    y = b /\ a = z.(st_freshreg) /\ c.(st_freshreg) = Pos.succ (z.(st_freshreg)).
+Proof.
+  inversion 1; split; auto.
+Qed.
+
+Lemma create_reg_inv : forall a b s r s' i,
+    create_reg a b s = OK r s' i ->
+    r = s.(st_freshreg) /\ s'.(st_freshreg) = Pos.succ (s.(st_freshreg)).
 Proof.
-  inversion 1. reflexivity.
+  inversion 1; auto.
 Qed.
 
 Theorem transl_module_correct :
@@ -429,21 +623,29 @@ Proof.
     crush;
     monadInv Heqr.
 
-  (* TODO: We should be able to fold this into the automation. *)
-  pose proof (create_arr_inv _ _ _ _ _ _ _ _ EQ0) as STK_LEN.
-  rewrite <- STK_LEN.
+  repeat unfold_match EQ9. monadInv EQ9.
 
-  econstructor; simpl; auto.
-  intros.
+  (* TODO: We should be able to fold this into the automation. *)
+  pose proof (create_arr_inv _ _ _ _ _ _ _ _ EQ0) as STK_LEN. inv STK_LEN. inv H5.
+  pose proof (create_reg_inv _ _ _ _ _ _ EQ) as FIN_VAL. inv FIN_VAL.
+  pose proof (create_reg_inv _ _ _ _ _ _ EQ1) as RET_VAL. inv RET_VAL.
+  destruct x3. destruct x4.
+  pose proof (collect_trans_instr_freshreg_trans _ _ _ _ _ _ _ EQ2) as TR_INSTR.
+  pose proof (collect_declare_freshreg_trans _ _ _ _ _ _ EQ3) as TR_DEC.
+  pose proof (create_reg_inv _ _ _ _ _ _ EQ4) as START_VAL. inv START_VAL.
+  pose proof (create_reg_inv _ _ _ _ _ _ EQ5) as RESET_VAL. inv RESET_VAL.
+  pose proof (create_reg_inv _ _ _ _ _ _ EQ6) as CLK_VAL. inv CLK_VAL.
+  rewrite H9 in *. rewrite H8 in *. replace (st_freshreg s4) with (st_freshreg s2) in * by congruence.
+  rewrite H6 in *. rewrite H7 in *. rewrite H5 in *. simpl in *.
   inv_incr.
+  econstructor; simpl; auto; try lia.
+  intros.
   assert (EQ3D := EQ3).
-  destruct x4.
   apply collect_declare_datapath_trans in EQ3.
   apply collect_declare_controllogic_trans in EQ3D.
-  assert (STC: st_controllogic s10 = st_controllogic s3) by congruence.
-  assert (STD: st_datapath s10 = st_datapath s3) by congruence.
-  assert (STST: st_st s10 = st_st s3) by congruence.
-  rewrite STC. rewrite STD. rewrite STST.
+  replace (st_controllogic s10) with (st_controllogic s3) by congruence.
+  replace (st_datapath s10) with (st_datapath s3) by congruence.
+  replace (st_st s10) with (st_st s3) by congruence.
   eapply iter_expand_instr_spec; eauto with htlspec.
   apply PTree.elements_complete.
 Qed.
diff --git a/src/translation/Veriloggen.v b/src/translation/Veriloggen.v
index b550ff9..f5d5fa7 100644
--- a/src/translation/Veriloggen.v
+++ b/src/translation/Veriloggen.v
@@ -19,35 +19,33 @@
 From compcert Require Import Maps.
 From compcert Require Errors.
 From compcert Require Import AST.
-From coqup Require Import Verilog HTL Coquplib AssocMap Value.
+From coqup Require Import Verilog HTL Coquplib AssocMap ValueInt.
 
-Fixpoint transl_list (st : list (node * Verilog.stmnt)) {struct st} : list (expr * Verilog.stmnt) :=
-  match st with
-  | (n, stmt) :: ls => (Vlit (posToValue 32 n), stmt) :: transl_list ls
-  | nil => nil
-  end.
+Definition transl_list_fun (a : node * Verilog.stmnt) :=
+  let (n, stmnt) := a in
+  (Vlit (posToValue n), stmnt).
 
-Fixpoint scl_to_Vdecl (scldecl : list (reg * (option io * scl_decl))) {struct scldecl} : list module_item :=
-  match scldecl with
-  | (r, (io, VScalar sz))::scldecl' => Vdeclaration (Vdecl io r sz) :: scl_to_Vdecl scldecl'
-  | nil => nil
-  end.
+Definition transl_list st := map transl_list_fun st.
 
-Fixpoint arr_to_Vdeclarr (arrdecl : list (reg * (option io * arr_decl))) {struct arrdecl} : list module_item :=
-  match arrdecl with
-  | (r, (io, VArray sz l))::arrdecl' => Vdeclaration (Vdeclarr io r sz l) :: arr_to_Vdeclarr arrdecl'
-  | nil => nil
-  end.
+Definition scl_to_Vdecl_fun (a : reg * (option io * scl_decl)) :=
+  match a with (r, (io, VScalar sz)) => (Vdecl io r sz) end.
+
+Definition scl_to_Vdecl scldecl := map scl_to_Vdecl_fun scldecl.
+
+Definition arr_to_Vdeclarr_fun (a : reg * (option io * arr_decl)) :=
+  match a with (r, (io, VArray sz l)) => (Vdeclarr io r sz l) end.
+
+Definition arr_to_Vdeclarr arrdecl := map arr_to_Vdeclarr_fun arrdecl.
 
 Definition transl_module (m : HTL.module) : Verilog.module :=
   let case_el_ctrl := transl_list (PTree.elements m.(mod_controllogic)) in
   let case_el_data := transl_list (PTree.elements m.(mod_datapath)) in
   let body :=
-      Valways (Vposedge m.(mod_clk)) (Vcond (Vbinop Veq (Vvar m.(mod_reset)) (ZToValue 1 1))
-                                               (Vnonblock (Vvar m.(mod_st)) (posToValue 32 m.(mod_entrypoint)))
+      Valways (Vposedge m.(mod_clk)) (Vcond (Vbinop Veq (Vvar m.(mod_reset)) (Vlit (ZToValue 1)))
+                                               (Vnonblock (Vvar m.(mod_st)) (Vlit (posToValue m.(mod_entrypoint))))
                                                (Vcase (Vvar m.(mod_st)) case_el_ctrl (Some Vskip)))
       :: Valways (Vposedge m.(mod_clk)) (Vcase (Vvar m.(mod_st)) case_el_data (Some Vskip))
-      :: (arr_to_Vdeclarr (AssocMap.elements m.(mod_arrdecls))
+      :: List.map Vdeclaration (arr_to_Vdeclarr (AssocMap.elements m.(mod_arrdecls))
                           ++ scl_to_Vdecl (AssocMap.elements m.(mod_scldecls))) in
   Verilog.mkmodule m.(mod_start)
                    m.(mod_reset)
diff --git a/src/translation/Veriloggenproof.v b/src/translation/Veriloggenproof.v
index ca4ecab..5b467a7 100644
--- a/src/translation/Veriloggenproof.v
+++ b/src/translation/Veriloggenproof.v
@@ -16,9 +16,12 @@
  * along with this program.  If not, see <https://www.gnu.org/licenses/>.
  *)
 
-From compcert Require Import Smallstep Linking.
+From compcert Require Import Smallstep Linking Integers Globalenvs.
 From coqup Require HTL.
-From coqup Require Import Coquplib Veriloggen Verilog.
+From coqup Require Import Coquplib Veriloggen Verilog ValueInt AssocMap.
+Require Import Lia.
+
+Local Open Scope assocmap.
 
 Definition match_prog (prog : HTL.program) (tprog : Verilog.program) :=
   match_program (fun cu f tf => tf = transl_fundef f) eq prog tprog.
@@ -52,6 +55,176 @@ Inductive match_states : HTL.state -> state -> Prop :=
     forall m,
       match_states (HTL.Callstate nil m nil) (Callstate nil (transl_module m) nil).
 
+Lemma Vlit_inj :
+  forall a b, Vlit a = Vlit b -> a = b.
+Proof. inversion 1. trivial. Qed.
+
+Lemma posToValue_inj :
+  forall a b,
+    0 <= Z.pos a <= Int.max_unsigned ->
+    0 <= Z.pos b <= Int.max_unsigned ->
+    posToValue a = posToValue b ->
+    a = b.
+Proof.
+  intros. rewrite <- Pos2Z.id at 1. rewrite <- Pos2Z.id.
+  rewrite <- Int.unsigned_repr at 1; try assumption.
+  symmetry.
+  rewrite <- Int.unsigned_repr at 1; try assumption.
+  unfold posToValue in *. rewrite H1; auto.
+Qed.
+
+Lemma valueToPos_inj :
+  forall a b,
+    0 < Int.unsigned a ->
+    0 < Int.unsigned b ->
+    valueToPos a = valueToPos b ->
+    a = b.
+Proof.
+  intros. unfold valueToPos in *.
+  rewrite <- Int.repr_unsigned at 1.
+  rewrite <- Int.repr_unsigned.
+  apply Pos2Z.inj_iff in H1.
+  rewrite Z2Pos.id in H1; auto.
+  rewrite Z2Pos.id in H1; auto.
+  rewrite H1. auto.
+Qed.
+
+Lemma unsigned_posToValue_le :
+  forall p,
+    Z.pos p <= Int.max_unsigned ->
+    0 < Int.unsigned (posToValue p).
+Proof.
+  intros. unfold posToValue. rewrite Int.unsigned_repr; lia.
+Qed.
+
+Lemma transl_list_fun_fst :
+  forall p1 p2 a b,
+    0 <= Z.pos p1 <= Int.max_unsigned ->
+    0 <= Z.pos p2 <= Int.max_unsigned ->
+    transl_list_fun (p1, a) = transl_list_fun (p2, b) ->
+    (p1, a) = (p2, b).
+Proof.
+  intros. unfold transl_list_fun in H1. apply pair_equal_spec in H1.
+  destruct H1. rewrite H2. apply Vlit_inj in H1.
+  apply posToValue_inj in H1; try assumption.
+  rewrite H1; auto.
+Qed.
+
+Lemma Zle_relax :
+  forall p q r,
+  p < q <= r ->
+  p <= q <= r.
+Proof. lia. Qed.
+Hint Resolve Zle_relax : verilogproof.
+
+Lemma transl_in :
+  forall l p,
+  0 <= Z.pos p <= Int.max_unsigned ->
+  (forall p0, In p0 (List.map fst l) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+  In (Vlit (posToValue p)) (map fst (map transl_list_fun l)) ->
+  In p (map fst l).
+Proof.
+  induction l.
+  - simplify. auto.
+  - intros. destruct a. simplify. destruct (peq p0 p); auto.
+    right. inv H1. apply Vlit_inj in H. apply posToValue_inj in H; auto. contradiction.
+    auto with verilogproof.
+    apply IHl; auto.
+Qed.
+
+Lemma transl_notin :
+  forall l p,
+    0 <= Z.pos p <= Int.max_unsigned ->
+    (forall p0, In p0 (List.map fst l) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+    ~ In p (List.map fst l) -> ~ In (Vlit (posToValue p)) (List.map fst (transl_list l)).
+Proof.
+  induction l; auto. intros. destruct a. unfold not in *. intros.
+  simplify.
+  destruct (peq p0 p). apply H1. auto. apply H1.
+  unfold transl_list in *. inv H2. apply Vlit_inj in H. apply posToValue_inj in H.
+  contradiction.
+  auto with verilogproof. auto.
+  right. apply transl_in; auto.
+Qed.
+
+Lemma transl_norepet :
+  forall l,
+    (forall p0, In p0 (List.map fst l) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+    list_norepet (List.map fst l) -> list_norepet (List.map fst (transl_list l)).
+Proof.
+  induction l.
+  - intros. simpl. apply list_norepet_nil.
+  - destruct a. intros. simpl. apply list_norepet_cons.
+    inv H0. apply transl_notin. apply Zle_relax. apply H. simplify; auto.
+    intros. apply H. destruct (peq p0 p); subst; simplify; auto.
+    assumption. apply IHl. intros. apply H. destruct (peq p0 p); subst; simplify; auto.
+    simplify. inv H0. assumption.
+Qed.
+
+Lemma transl_list_correct :
+  forall l v ev f asr asa asrn asan asr' asa' asrn' asan',
+    (forall p0, In p0 (List.map fst l) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+    list_norepet (List.map fst l) ->
+    asr!ev = Some v ->
+    (forall p s,
+        In (p, s) l ->
+        v = posToValue p ->
+        stmnt_runp f
+                   {| assoc_blocking := asr; assoc_nonblocking := asrn |}
+                   {| assoc_blocking := asa; assoc_nonblocking := asan |}
+                   s
+                   {| assoc_blocking := asr'; assoc_nonblocking := asrn' |}
+                   {| assoc_blocking := asa'; assoc_nonblocking := asan' |} ->
+        stmnt_runp f
+                   {| assoc_blocking := asr; assoc_nonblocking := asrn |}
+                   {| assoc_blocking := asa; assoc_nonblocking := asan |}
+                   (Vcase (Vvar ev) (transl_list l) (Some Vskip))
+                   {| assoc_blocking := asr'; assoc_nonblocking := asrn' |}
+                   {| assoc_blocking := asa'; assoc_nonblocking := asan' |}).
+Proof.
+  induction l as [| a l IHl].
+  - contradiction.
+  - intros v ev f asr asa asrn asan asr' asa' asrn' asan' BOUND NOREP ASSOC p s IN EQ SRUN.
+    destruct a as [p' s']. simplify.
+    destruct (peq p p'); subst. eapply stmnt_runp_Vcase_match.
+    constructor. simplify. unfold AssocMap.find_assocmap, AssocMapExt.get_default.
+    rewrite ASSOC. trivial. constructor. auto.
+    inversion IN as [INV | INV]. inversion INV as [INV2]; subst. assumption.
+    inv NOREP. eapply in_map with (f := fst) in INV. contradiction.
+
+    eapply stmnt_runp_Vcase_nomatch. constructor. simplify.
+    unfold AssocMap.find_assocmap, AssocMapExt.get_default. rewrite ASSOC.
+    trivial. constructor. unfold not. intros. apply n. apply posToValue_inj.
+    apply Zle_relax. apply BOUND. right. inv IN. inv H0; contradiction.
+    eapply in_map with (f := fst) in H0. auto.
+    apply Zle_relax. apply BOUND; auto. auto.
+
+    eapply IHl. auto. inv NOREP. auto. eassumption. inv IN. inv H. contradiction. apply H.
+    trivial. assumption.
+Qed.
+Hint Resolve transl_list_correct : verilogproof.
+
+Lemma pc_wf :
+  forall A m p v,
+  (forall p0, In p0 (List.map fst (@AssocMap.elements A m)) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+  m!p = Some v ->
+  0 <= Z.pos p <= Int.max_unsigned.
+Proof.
+  intros A m p v LT S. apply Zle_relax. apply LT.
+  apply AssocMap.elements_correct in S. remember (p, v) as x.
+  exploit in_map. apply S. instantiate (1 := fst). subst. simplify. auto.
+Qed.
+
+Lemma mis_stepp_decl :
+  forall l asr asa f,
+    mis_stepp f asr asa (map Vdeclaration l) asr asa.
+Proof.
+  induction l.
+  - intros. constructor.
+  - intros. simplify. econstructor. constructor. auto.
+Qed.
+Hint Resolve mis_stepp_decl : verilogproof.
+
 Section CORRECTNESS.
 
   Variable prog: HTL.program.
@@ -62,6 +235,40 @@ Section CORRECTNESS.
   Let ge : HTL.genv := Globalenvs.Genv.globalenv prog.
   Let tge : genv := Globalenvs.Genv.globalenv tprog.
 
+  Lemma symbols_preserved:
+    forall (s: AST.ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+  Proof. intros. eapply (Genv.find_symbol_match TRANSL). Qed.
+  Hint Resolve symbols_preserved : verilogproof.
+
+  Lemma function_ptr_translated:
+    forall (b: Values.block) (f: HTL.fundef),
+      Genv.find_funct_ptr ge b = Some f ->
+      exists tf,
+        Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = tf.
+  Proof.
+    intros. exploit (Genv.find_funct_ptr_match TRANSL); eauto.
+    intros (cu & tf & P & Q & R); exists tf; auto.
+  Qed.
+  Hint Resolve function_ptr_translated : verilogproof.
+
+  Lemma functions_translated:
+    forall (v: Values.val) (f: HTL.fundef),
+      Genv.find_funct ge v = Some f ->
+      exists tf,
+        Genv.find_funct tge v = Some tf /\ transl_fundef f = tf.
+  Proof.
+    intros. exploit (Genv.find_funct_match TRANSL); eauto.
+    intros (cu & tf & P & Q & R); exists tf; auto.
+  Qed.
+  Hint Resolve functions_translated : verilogproof.
+
+  Lemma senv_preserved:
+    Senv.equiv (Genv.to_senv ge) (Genv.to_senv tge).
+  Proof.
+    intros. eapply (Genv.senv_match TRANSL).
+  Qed.
+  Hint Resolve senv_preserved : verilogproof.
+
   Theorem transl_step_correct :
     forall (S1 : HTL.state) t S2,
       HTL.step ge S1 t S2 ->
@@ -69,15 +276,93 @@ Section CORRECTNESS.
         match_states S1 R1 ->
         exists R2, Smallstep.plus step tge R1 t R2 /\ match_states S2 R2.
   Proof.
-(*    induction 1; intros R1 MSTATE; inv MSTATE; econstructor; split.
-    - apply Smallstep.plus_one. econstructor. eassumption. trivial.
-      * econstructor. econstructor.*)
-    Admitted.
+    induction 1; intros R1 MSTATE; inv MSTATE.
+    - econstructor; split. apply Smallstep.plus_one. econstructor.
+      assumption. assumption. eassumption. apply valueToPos_posToValue.
+      split. lia.
+      eapply pc_wf. intros. pose proof (HTL.mod_wf m) as HP. destruct HP as [HP _].
+      split. lia. apply HP. eassumption. eassumption.
+      econstructor. econstructor. eapply stmnt_runp_Vcond_false. econstructor. econstructor.
+      simpl. unfold find_assocmap. unfold AssocMapExt.get_default.
+      rewrite H. trivial.
+
+      econstructor. simpl. auto. auto.
+
+      eapply transl_list_correct.
+      intros. split. lia. pose proof (HTL.mod_wf m) as HP. destruct HP as [HP _]. auto.
+      apply Maps.PTree.elements_keys_norepet. eassumption.
+      2: { apply valueToPos_inj. apply unsigned_posToValue_le.
+           eapply pc_wf. intros. pose proof (HTL.mod_wf m) as HP. destruct HP as [HP _].
+           split. lia. apply HP. eassumption. eassumption.
+           apply unsigned_posToValue_le. eapply pc_wf. intros. pose proof (HTL.mod_wf m) as HP.
+           destruct HP as [HP _].
+           split. lia. apply HP. eassumption. eassumption. trivial.
+      }
+      apply Maps.PTree.elements_correct. eassumption. eassumption.
+
+      econstructor. econstructor.
+
+      eapply transl_list_correct.
+      intros. split. lia. pose proof (HTL.mod_wf m) as HP. destruct HP as [_ HP]. auto.
+      apply Maps.PTree.elements_keys_norepet. eassumption.
+      2: { apply valueToPos_inj. apply unsigned_posToValue_le.
+           eapply pc_wf. intros. pose proof (HTL.mod_wf m) as HP. destruct HP as [HP _].
+           split. lia. apply HP. eassumption. eassumption.
+           apply unsigned_posToValue_le. eapply pc_wf. intros. pose proof (HTL.mod_wf m) as HP.
+           destruct HP as [HP _].
+           split. lia. apply HP. eassumption. eassumption. trivial.
+      }
+      apply Maps.PTree.elements_correct. eassumption. eassumption.
+
+      apply mis_stepp_decl. trivial. trivial. simpl. eassumption. auto.
+      rewrite valueToPos_posToValue. constructor; assumption. lia.
+
+    - econstructor; split. apply Smallstep.plus_one. apply step_finish. assumption. eassumption.
+      constructor; assumption.
+    - econstructor; split. apply Smallstep.plus_one. constructor.
+
+      constructor. constructor.
+    - inv H3. econstructor; split. apply Smallstep.plus_one. constructor. trivial.
+
+      apply match_state. assumption.
+  Qed.
+  Hint Resolve transl_step_correct : verilogproof.
+
+  Lemma transl_initial_states :
+    forall s1 : Smallstep.state (HTL.semantics prog),
+      Smallstep.initial_state (HTL.semantics prog) s1 ->
+      exists s2 : Smallstep.state (Verilog.semantics tprog),
+        Smallstep.initial_state (Verilog.semantics tprog) s2 /\ match_states s1 s2.
+  Proof.
+    induction 1.
+    econstructor; split. econstructor.
+    apply (Genv.init_mem_transf TRANSL); eauto.
+    rewrite symbols_preserved.
+    replace (AST.prog_main tprog) with (AST.prog_main prog); eauto.
+    symmetry; eapply Linking.match_program_main; eauto.
+    exploit function_ptr_translated; eauto. intros [tf [A B]].
+    inv B. eauto.
+    constructor.
+  Qed.
+  Hint Resolve transl_initial_states : verilogproof.
+
+  Lemma transl_final_states :
+    forall (s1 : Smallstep.state (HTL.semantics prog))
+           (s2 : Smallstep.state (Verilog.semantics tprog))
+           (r : Integers.Int.int),
+      match_states s1 s2 ->
+      Smallstep.final_state (HTL.semantics prog) s1 r ->
+      Smallstep.final_state (Verilog.semantics tprog) s2 r.
+  Proof.
+    intros. inv H0. inv H. inv H3. constructor. reflexivity.
+  Qed.
+  Hint Resolve transl_final_states : verilogproof.
 
   Theorem transf_program_correct:
     forward_simulation (HTL.semantics prog) (Verilog.semantics tprog).
-    Admitted.
-
+  Proof.
+    eapply Smallstep.forward_simulation_plus; eauto with verilogproof.
+    apply senv_preserved.
+  Qed.
 
 End CORRECTNESS.
-
diff --git a/src/translation/Veriloggenspec.v b/src/translation/Veriloggenspec.v
deleted file mode 100644
index 7dc632c..0000000
--- a/src/translation/Veriloggenspec.v
+++ /dev/null
@@ -1,17 +0,0 @@
-(*
- * CoqUp: Verified high-level synthesis.
- * Copyright (C) 2020 Yann Herklotz <yann@yannherklotz.com>
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program.  If not, see <https://www.gnu.org/licenses/>.
- *)
diff --git a/src/verilog/AssocMap.v b/src/verilog/AssocMap.v
index 5d531d5..c5cfa3f 100644
--- a/src/verilog/AssocMap.v
+++ b/src/verilog/AssocMap.v
@@ -16,7 +16,7 @@
  * along with this program.  If not, see <https://www.gnu.org/licenses/>.
  *)
 
-From coqup Require Import Coquplib Value.
+From coqup Require Import Coquplib ValueInt.
 From compcert Require Import Maps.
 
 Definition reg := positive.
@@ -192,7 +192,7 @@ Import AssocMapExt.
 Definition assocmap := AssocMap.t value.
 
 Definition find_assocmap (n : nat) : reg -> assocmap -> value :=
-  get_default value (ZToValue n 0).
+  get_default value (ZToValue 0).
 
 Definition empty_assocmap : assocmap := AssocMap.empty value.
 
diff --git a/src/verilog/HTL.v b/src/verilog/HTL.v
index a3623f0..b3d1442 100644
--- a/src/verilog/HTL.v
+++ b/src/verilog/HTL.v
@@ -17,13 +17,11 @@
  *)
 
 From Coq Require Import FSets.FMapPositive.
-From coqup Require Import Coquplib Value AssocMap Array.
+From coqup Require Import Coquplib ValueInt AssocMap Array.
 From coqup Require Verilog.
 From compcert Require Events Globalenvs Smallstep Integers Values.
 From compcert Require Import Maps.
 
-Import HexNotationValue.
-
 (** The purpose of the hardware transfer language (HTL) is to create a more
 hardware-like layout that is still similar to the register transfer language
 (RTL) that it came from. The main change is that function calls become module
@@ -38,6 +36,11 @@ Definition node := positive.
 Definition datapath := PTree.t Verilog.stmnt.
 Definition controllogic := PTree.t Verilog.stmnt.
 
+Definition map_well_formed {A : Type} (m : PTree.t A) : Prop :=
+  forall p0 : positive,
+    In p0 (map fst (Maps.PTree.elements m)) ->
+    Z.pos p0 <= Integers.Int.max_unsigned.
+
 Record module: Type :=
   mkmodule {
     mod_params : list reg;
@@ -54,6 +57,7 @@ Record module: Type :=
     mod_clk : reg;
     mod_scldecls : AssocMap.t (option Verilog.io * Verilog.scl_decl);
     mod_arrdecls : AssocMap.t (option Verilog.io * Verilog.arr_decl);
+    mod_wf : (map_well_formed mod_controllogic /\ map_well_formed mod_datapath);
   }.
 
 Definition fundef := AST.fundef module.
@@ -99,14 +103,15 @@ Inductive state : Type :=
 
 Inductive step : genv -> state -> Events.trace -> state -> Prop :=
 | step_module :
-    forall g m st sf ctrl data ist
+    forall g m st sf ctrl data
       asr asa
       basr1 basa1 nasr1 nasa1
       basr2 basa2 nasr2 nasa2
       asr' asa'
-      f stval pstval,
-      asr!(m.(mod_st)) = Some ist ->
-      valueToPos ist = st ->
+      f pstval,
+      asr!(mod_reset m) = Some (ZToValue 0) ->
+      asr!(mod_finish m) = Some (ZToValue 0) ->
+      asr!(m.(mod_st)) = Some (posToValue st) ->
       m.(mod_controllogic)!st = Some ctrl ->
       m.(mod_datapath)!st = Some data ->
       Verilog.stmnt_runp f
@@ -115,6 +120,7 @@ Inductive step : genv -> state -> Events.trace -> state -> Prop :=
         ctrl
         (Verilog.mkassociations basr1 nasr1)
         (Verilog.mkassociations basa1 nasa1) ->
+      basr1!(m.(mod_st)) = Some (posToValue st) ->
       Verilog.stmnt_runp f
         (Verilog.mkassociations basr1 nasr1)
         (Verilog.mkassociations basa1 nasa1)
@@ -123,26 +129,28 @@ Inductive step : genv -> state -> Events.trace -> state -> Prop :=
         (Verilog.mkassociations basa2 nasa2) ->
       asr' = Verilog.merge_regs nasr2 basr2 ->
       asa' = Verilog.merge_arrs nasa2 basa2 ->
-      asr'!(m.(mod_st)) = Some stval ->
-      valueToPos stval = pstval ->
+      asr'!(m.(mod_st)) = Some (posToValue pstval) ->
+      Z.pos pstval <= Integers.Int.max_unsigned ->
       step g (State sf m st asr asa) Events.E0 (State sf m pstval asr' asa')
 | step_finish :
     forall g m st asr asa retval sf,
-    asr!(m.(mod_finish)) = Some (1'h"1") ->
+    asr!(m.(mod_finish)) = Some (ZToValue 1) ->
     asr!(m.(mod_return)) = Some retval ->
     step g (State sf m st asr asa) Events.E0 (Returnstate sf retval)
 | step_call :
     forall g m args res,
       step g (Callstate res m args) Events.E0
            (State res m m.(mod_entrypoint)
-             (AssocMap.set (mod_st m) (posToValue 32 m.(mod_entrypoint))
-                           (init_regs args m.(mod_params)))
+             (AssocMap.set (mod_reset m) (ZToValue 0)
+              (AssocMap.set (mod_finish m) (ZToValue 0)
+               (AssocMap.set (mod_st m) (posToValue m.(mod_entrypoint))
+                (init_regs args m.(mod_params)))))
              (empty_stack m))
 | step_return :
     forall g m asr asa i r sf pc mst,
       mst = mod_st m ->
       step g (Returnstate (Stackframe r m pc asr asa :: sf) i) Events.E0
-           (State sf m pc ((asr # mst <- (posToValue 32 pc)) # r <- i) asa).
+           (State sf m pc ((asr # mst <- (posToValue pc)) # r <- i) asa).
 Hint Constructors step : htl.
 
 Inductive initial_state (p: program): state -> Prop :=
diff --git a/src/verilog/PrintHTL.ml b/src/verilog/PrintHTL.ml
index 0bdba51..36fdd3c 100644
--- a/src/verilog/PrintHTL.ml
+++ b/src/verilog/PrintHTL.ml
@@ -16,7 +16,7 @@
  * along with this program.  If not, see <https://www.gnu.org/licenses/>.
  *)
 
-open Value
+open ValueInt
 open Datatypes
 open Camlcoq
 open AST
diff --git a/src/verilog/PrintVerilog.ml b/src/verilog/PrintVerilog.ml
index 5265c97..7f3eb29 100644
--- a/src/verilog/PrintVerilog.ml
+++ b/src/verilog/PrintVerilog.ml
@@ -17,7 +17,7 @@
  *)
 
 open Verilog
-open Value
+open ValueInt
 open Datatypes
 
 open Camlcoq
@@ -70,16 +70,30 @@ let unop = function
 
 let register a = sprintf "reg_%d" (P.to_int a)
 
-let literal l = sprintf "%d'd%d" (Nat.to_int l.vsize) (Z.to_int (uvalueToZ l))
+let literal l = sprintf "32'd%d" (Z.to_int (uvalueToZ l))
 
-let rec pprint_expr = function
+let literal_int i = sprintf "32'd%d" i
+
+let byte n s = sprintf "reg_%d[%d:%d]" (P.to_int s) (7 + n * 8) (n * 8)
+
+
+let rec pprint_expr =
+  let array_byte r i = function
+     | 0 -> concat [register r; "["; pprint_expr i; "]"]
+     | n -> concat [register r; "["; pprint_expr i; " + "; literal_int n; "][7:0]"]
+  in function
   | Vlit l -> literal l
   | Vvar s -> register s
+  | Vvarb0 s -> byte 0 s
+  | Vvarb1 s -> byte 1 s
+  | Vvarb2 s -> byte 2 s
+  | Vvarb3 s -> byte 3 s
   | Vvari (s, i) -> concat [register s; "["; pprint_expr i; "]"]
   | Vinputvar s -> register s
   | Vunop (u, e) -> concat ["("; unop u; pprint_expr e; ")"]
   | Vbinop (op, a, b) -> concat [pprint_binop (pprint_expr a) (pprint_expr b) op]
   | Vternary (c, t, f) -> concat ["("; pprint_expr c; " ? "; pprint_expr t; " : "; pprint_expr f; ")"]
+  | Vload (s, i) -> concat ["{"; array_byte s i 3; ", "; array_byte s i 2; ", "; array_byte s i 1; ", "; array_byte s i 0; "}"]
 
 let rec pprint_stmnt i =
   let pprint_case (e, s) = concat [ indent (i + 1); pprint_expr e; ": begin\n"; pprint_stmnt (i + 2) s;
diff --git a/src/verilog/PrintVerilog.mli b/src/verilog/PrintVerilog.mli
index 62bf63f..5fd8fe9 100644
--- a/src/verilog/PrintVerilog.mli
+++ b/src/verilog/PrintVerilog.mli
@@ -18,8 +18,8 @@
 
 val pprint_stmnt : int -> Verilog.stmnt -> string
 
-val print_value : out_channel -> Value.value -> unit
+val print_value : out_channel -> ValueInt.value -> unit
 
 val print_program : bool -> out_channel -> Verilog.program -> unit
 
-val print_result : out_channel -> (BinNums.positive * Value.value) list -> unit
+val print_result : out_channel -> (BinNums.positive * ValueInt.value) list -> unit
diff --git a/src/verilog/Value.v b/src/verilog/Value.v
index 8ba5138..af2b822 100644
--- a/src/verilog/Value.v
+++ b/src/verilog/Value.v
@@ -21,6 +21,7 @@ From bbv Require Import Word.
 From bbv Require HexNotation WordScope.
 From Coq Require Import ZArith.ZArith FSets.FMapPositive Lia.
 From compcert Require Import lib.Integers common.Values.
+From coqup Require Import Coquplib.
 (* end hide *)
 
 (** * Value
@@ -39,6 +40,8 @@ Record value : Type :=
     vword: word vsize
   }.
 
+Search N.of_nat.
+
 (** ** Value conversions
 
 Various conversions to different number types such as [N], [Z], [positive] and
@@ -85,9 +88,18 @@ Definition intToValue (i : Integers.int) : value :=
 Definition valueToInt (i : value) : Integers.int :=
   Int.repr (uvalueToZ i).
 
+Definition ptrToValue (i : Integers.ptrofs) : value :=
+  ZToValue Ptrofs.wordsize (Ptrofs.unsigned i).
+
+Definition valueToPtr (i : value) : Integers.ptrofs :=
+  Ptrofs.repr (uvalueToZ i).
+
 Definition valToValue (v : Values.val) : option value :=
   match v with
   | Values.Vint i => Some (intToValue i)
+  | Values.Vptr b off => if Z.eqb (Z.modulo (uvalueToZ (ptrToValue off)) 4) 0%Z
+                         then Some (ptrToValue off)
+                         else None
   | Values.Vundef => Some (ZToValue 32 0%Z)
   | _ => None
   end.
@@ -301,8 +313,8 @@ Inductive val_value_lessdef: val -> value -> Prop :=
     val_value_lessdef (Vint i) v'
 | val_value_lessdef_ptr:
     forall b off v',
-    off = Ptrofs.repr (valueToZ v') ->
-    (Z.modulo (valueToZ v') 4) = 0%Z ->
+    off = valueToPtr v' ->
+    (Z.modulo (uvalueToZ v') 4) = 0%Z ->
     val_value_lessdef (Vptr b off) v'
 | lessdef_undef: forall v, val_value_lessdef Vundef v.
 
@@ -379,6 +391,41 @@ Proof.
   apply Z.lt_le_pred in H. apply H.
 Qed.
 
+Lemma valueToPtr_ptrToValue :
+  forall v,
+  valueToPtr (ptrToValue v) = v.
+Proof.
+  intros.
+  unfold valueToPtr, ptrToValue. rewrite uvalueToZ_ZToValue. auto using Ptrofs.repr_unsigned.
+  split. apply Ptrofs.unsigned_range_2.
+  assert ((Ptrofs.unsigned v <= Ptrofs.max_unsigned)%Z) by apply Ptrofs.unsigned_range_2.
+  apply Z.lt_le_pred in H. apply H.
+Qed.
+
+Lemma intToValue_valueToInt :
+  forall v,
+  vsize v = 32%nat ->
+  intToValue (valueToInt v) = v.
+Proof.
+  intros. unfold valueToInt, intToValue. rewrite Int.unsigned_repr_eq.
+  unfold ZToValue, uvalueToZ. unfold Int.modulus. unfold Int.wordsize. unfold Wordsize_32.wordsize.
+  pose proof (uwordToZ_bound (vword v)).
+  rewrite Z.mod_small. rewrite <- H. rewrite ZToWord_uwordToZ. destruct v; auto.
+  rewrite <- H. rewrite two_power_nat_equiv. apply H0.
+Qed.
+
+Lemma ptrToValue_valueToPtr :
+  forall v,
+  vsize v = 32%nat ->
+  ptrToValue (valueToPtr v) = v.
+Proof.
+  intros. unfold valueToPtr, ptrToValue. rewrite Ptrofs.unsigned_repr_eq.
+  unfold ZToValue, uvalueToZ. unfold Ptrofs.modulus. unfold Ptrofs.wordsize. unfold Wordsize_Ptrofs.wordsize.
+  pose proof (uwordToZ_bound (vword v)).
+  rewrite Z.mod_small. rewrite <- H. rewrite ZToWord_uwordToZ. destruct v; auto.
+  rewrite <- H. rewrite two_power_nat_equiv. apply H0.
+Qed.
+
 Lemma valToValue_lessdef :
   forall v v',
     valToValue v = Some v' ->
@@ -388,6 +435,10 @@ Proof.
   destruct v; try discriminate; constructor.
   unfold valToValue in H. inversion H.
   symmetry. apply valueToInt_intToValue.
+  inv H. destruct (uvalueToZ (ptrToValue i) mod 4 =? 0); try discriminate.
+  inv H1. symmetry. apply valueToPtr_ptrToValue.
+  inv H. destruct (uvalueToZ (ptrToValue i) mod 4 =? 0) eqn:?; try discriminate.
+  inv H1. apply Z.eqb_eq. apply Heqb0.
 Qed.
 
 Lemma boolToValue_ValueToBool :
@@ -415,6 +466,10 @@ Proof.
   rewrite ZToWord_plus; auto.
 Qed.
 
+Lemma ZToValue_eq :
+  forall w1,
+  (mkvalue 32 w1) = (ZToValue 32 (wordToZ w1)). Abort.
+
 Lemma wordsize_32 :
   Int.wordsize = 32%nat.
 Proof. auto. Qed.
@@ -428,6 +483,28 @@ Proof.
   rewrite Int.repr_unsigned. auto. rewrite wordsize_32. omega.
 Qed.
 
+(*Lemma intadd_vplus2 :
+  forall v1 v2 EQ,
+  vsize v1 = 32%nat ->
+  Int.add (valueToInt v1) (valueToInt v2) = valueToInt (vplus v1 v2 EQ).
+Proof.
+  intros. unfold Int.add, valueToInt, intToValue. repeat (rewrite Int.unsigned_repr).
+  rewrite (@vadd_vplus v1 v2 EQ). trivial.
+  unfold uvalueToZ. Search word "bound". pose proof (@uwordToZ_bound (vsize v2) (vword v2)).
+  rewrite H in EQ. rewrite <- EQ in H0 at 3.*)
+  (*rewrite zadd_vplus3. trivia*)
+
+Lemma valadd_vplus :
+  forall v1 v2 v1' v2' v v' EQ,
+  val_value_lessdef v1 v1' ->
+  val_value_lessdef v2 v2' ->
+  Val.add v1 v2 = v ->
+  vplus v1' v2' EQ = v' ->
+  val_value_lessdef v v'.
+Proof.
+  intros. inv H; inv H0; constructor; simplify.
+  Abort.
+
 Lemma zsub_vminus :
   forall sz z1 z2,
   (sz > 0)%nat ->
@@ -452,17 +529,25 @@ Proof.
   unfold wordBin. repeat (rewrite wordToN_NToWord_2); auto.
 Qed.
 
-(*Lemma ZToValue_valueToNat :
+Lemma ZToValue_valueToNat :
   forall x sz,
-  sz > 0 ->
-  (x < 2^(Z.of_nat sz))%Z ->
+  (sz > 0)%nat ->
+  (0 <= x < 2^(Z.of_nat sz))%Z ->
   valueToNat (ZToValue sz x) = Z.to_nat x.
 Proof.
-  destruct x; intros; unfold ZToValue, valueToNat; simpl.
+  destruct x; intros; unfold ZToValue, valueToNat; crush.
   - rewrite wzero'_def. apply wordToNat_wzero.
   - rewrite posToWord_nat. rewrite wordToNat_natToWord_2. trivial.
-    unfold Z.of_nat in *. destruct sz eqn:?. omega. simpl in H0.
-    rewrite <- Pos2Z.inj_pow_pos in H0. Search (Z.pos _ < Z.pos _)%Z.
-    Search Pos.to_nat (_ < _). (* Pos2Nat.inj_lt *)
-    Search "inj" positive nat.
-*)
+    clear H1.
+    lazymatch goal with
+    | [ H : context[(_ < ?x)%Z] |- _ ] => replace x with (Z.of_nat (Z.to_nat x)) in H
+    end.
+    2: { apply Z2Nat.id; apply Z.pow_nonneg; lia. }
+
+    rewrite Z2Nat.inj_pow in H2; crush.
+    replace (Pos.to_nat 2) with 2%nat in H2 by reflexivity.
+    rewrite Nat2Z.id in H2.
+    rewrite <- positive_nat_Z in H2.
+    apply Nat2Z.inj_lt in H2.
+    assumption.
+Qed.
diff --git a/src/verilog/ValueInt.v b/src/verilog/ValueInt.v
new file mode 100644
index 0000000..151feef
--- /dev/null
+++ b/src/verilog/ValueInt.v
@@ -0,0 +1,162 @@
+(*
+ * CoqUp: Verified high-level synthesis.
+ * Copyright (C) 2020 Yann Herklotz <yann@yannherklotz.com>
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ *)
+
+(* begin hide *)
+From bbv Require Import Word.
+From bbv Require HexNotation WordScope.
+From Coq Require Import ZArith.ZArith FSets.FMapPositive Lia.
+From compcert Require Import lib.Integers common.Values.
+From coqup Require Import Coquplib.
+(* end hide *)
+
+(** * Value
+
+A [value] is a bitvector with a specific size. We are using the implementation
+of the bitvector by mit-plv/bbv, because it has many theorems that we can reuse.
+However, we need to wrap it with an [Inductive] so that we can specify and match
+on the size of the [value]. This is necessary so that we can easily store
+[value]s of different sizes in a list or in a map.
+
+Using the default [word], this would not be possible, as the size is part of the type. *)
+
+Definition value : Type := int.
+
+(** ** Value conversions
+
+Various conversions to different number types such as [N], [Z], [positive] and
+[int], where the last one is a theory of integers of powers of 2 in CompCert. *)
+
+Definition valueToNat (v : value) : nat :=
+  Z.to_nat (Int.unsigned v).
+
+Definition natToValue (n : nat) : value :=
+  Int.repr (Z.of_nat n).
+
+Definition valueToN (v : value) : N :=
+  Z.to_N (Int.unsigned v).
+
+Definition NToValue (n : N) : value :=
+  Int.repr (Z.of_N n).
+
+Definition ZToValue (z : Z) : value :=
+  Int.repr z.
+
+Definition valueToZ (v : value) : Z :=
+  Int.signed v.
+
+Definition uvalueToZ (v : value) : Z :=
+  Int.unsigned v.
+
+Definition posToValue (p : positive) : value :=
+  Int.repr (Z.pos p).
+
+Definition valueToPos (v : value) : positive :=
+  Z.to_pos (Int.unsigned v).
+
+Definition intToValue (i : Integers.int) : value := i.
+
+Definition valueToInt (i : value) : Integers.int := i.
+
+Definition ptrToValue (i : ptrofs) : value := Ptrofs.to_int i.
+
+Definition valueToPtr (i : value) : Integers.ptrofs :=
+  Ptrofs.of_int i.
+
+Definition valToValue (v : Values.val) : option value :=
+  match v with
+  | Values.Vint i => Some (intToValue i)
+  | Values.Vptr b off => Some (ptrToValue off)
+  | Values.Vundef => Some (ZToValue 0%Z)
+  | _ => None
+  end.
+
+(** Convert a [value] to a [bool], so that choices can be made based on the
+result. This is also because comparison operators will give back [value] instead
+of [bool], so if they are in a condition, they will have to be converted before
+they can be used. *)
+
+Definition valueToBool (v : value) : bool :=
+  if Z.eqb (uvalueToZ v) 0 then false else true.
+
+Definition boolToValue (b : bool) : value :=
+  natToValue (if b then 1 else 0).
+
+(** ** Arithmetic operations *)
+
+Definition unify_word (sz1 sz2 : nat) (w1 : word sz2): sz1 = sz2 -> word sz1.
+intros; subst; assumption. Defined.
+
+Lemma unify_word_unfold :
+  forall sz w,
+  unify_word sz sz w eq_refl = w.
+Proof. auto. Qed.
+
+Inductive val_value_lessdef: val -> value -> Prop :=
+| val_value_lessdef_int:
+    forall i v',
+    i = valueToInt v' ->
+    val_value_lessdef (Vint i) v'
+| val_value_lessdef_ptr:
+    forall b off v',
+    off = valueToPtr v' ->
+    val_value_lessdef (Vptr b off) v'
+| lessdef_undef: forall v, val_value_lessdef Vundef v.
+
+Inductive opt_val_value_lessdef: option val -> value -> Prop :=
+| opt_lessdef_some:
+    forall v v', val_value_lessdef v v' -> opt_val_value_lessdef (Some v) v'
+| opt_lessdef_none: forall v, opt_val_value_lessdef None v.
+
+Lemma valueToZ_ZToValue :
+  forall z,
+  (Int.min_signed <= z <= Int.max_signed)%Z ->
+  valueToZ (ZToValue z) = z.
+Proof. auto using Int.signed_repr. Qed.
+
+Lemma uvalueToZ_ZToValue :
+  forall z,
+  (0 <= z <= Int.max_unsigned)%Z ->
+  uvalueToZ (ZToValue z) = z.
+Proof. auto using Int.unsigned_repr. Qed.
+
+Lemma valueToPos_posToValue :
+  forall v,
+  0 <= Z.pos v <= Int.max_unsigned ->
+  valueToPos (posToValue v) = v.
+Proof.
+  unfold valueToPos, posToValue.
+  intros. rewrite Int.unsigned_repr.
+  apply Pos2Z.id. assumption.
+Qed.
+
+Lemma valueToInt_intToValue :
+  forall v,
+  valueToInt (intToValue v) = v.
+Proof. auto. Qed.
+
+Lemma valToValue_lessdef :
+  forall v v',
+    valToValue v = Some v' ->
+    val_value_lessdef v v'.
+Proof.
+  intros.
+  destruct v; try discriminate; constructor.
+  unfold valToValue in H. inversion H.
+  unfold valueToInt. unfold intToValue in H1. auto.
+  inv H. symmetry. unfold valueToPtr, ptrToValue. apply Ptrofs.of_int_to_int. trivial.
+Qed.
diff --git a/src/verilog/Verilog.v b/src/verilog/Verilog.v
index 555ddbd..06e250a 100644
--- a/src/verilog/Verilog.v
+++ b/src/verilog/Verilog.v
@@ -29,11 +29,9 @@ Require Import Lia.
 
 Import ListNotations.
 
-From coqup Require Import common.Coquplib common.Show verilog.Value AssocMap Array.
-From compcert Require Integers Events.
-From compcert Require Import Errors Smallstep Globalenvs.
-
-Import HexNotationValue.
+From coqup Require Import common.Coquplib common.Show verilog.ValueInt IntegerExtra AssocMap Array.
+From compcert Require Events.
+From compcert Require Import Integers Errors Smallstep Globalenvs.
 
 Local Open Scope assocmap.
 
@@ -80,7 +78,7 @@ Definition merge_arrs (new : assocmap_arr) (old : assocmap_arr) : assocmap_arr :
 Definition arr_assocmap_lookup (a : assocmap_arr) (r : reg) (i : nat) : option value :=
   match a ! r with
   | None => None
-  | Some arr => Some (Option.default (NToValue 32 0) (Option.join (array_get_error i arr)))
+  | Some arr => Some (Option.default (NToValue 0) (Option.join (array_get_error i arr)))
   end.
 
 Definition arr_assocmap_set (r : reg) (i : nat) (v : value) (a : assocmap_arr) : assocmap_arr :=
@@ -145,7 +143,8 @@ Inductive binop : Type :=
 | Vxor : binop  (** xor (binary [^|]) *)
 | Vshl : binop  (** shift left ([<<]) *)
 | Vshr : binop (** shift right ([>>>]) *)
-| Vshru : binop. (** shift right unsigned ([>>]) *)
+| Vshru : binop (** shift right unsigned ([>>]) *)
+| Vror : binop. (** shift right unsigned ([>>]) *)
 
 (** ** Unary Operators *)
 
@@ -156,16 +155,21 @@ Inductive unop : Type :=
 (** ** Expressions *)
 
 Inductive expr : Type :=
-| Vlit : value -> expr
-| Vvar : reg -> expr
-| Vvari : reg -> expr -> expr
+| Vlit : value -> expr                    (** literal *)
+| Vvar : reg -> expr                      (** reg *)
+| Vvarb0 : reg -> expr                    (** 1st byte projection of reg *)
+| Vvarb1 : reg -> expr
+| Vvarb2 : reg -> expr
+| Vvarb3 : reg -> expr
+| Vvari : reg -> expr -> expr              (** array *)
 | Vinputvar : reg -> expr
 | Vbinop : binop -> expr -> expr -> expr
 | Vunop : unop -> expr -> expr
-| Vternary : expr -> expr -> expr -> expr.
+| Vternary : expr -> expr -> expr -> expr
+| Vload : reg -> expr -> expr.    (** 4-byte concatenation load *)
 
-Definition posToExpr (sz : nat) (p : positive) : expr :=
-  Vlit (posToValue sz p).
+Definition posToExpr (p : positive) : expr :=
+  Vlit (posToValue p).
 
 (** ** Statements *)
 
@@ -245,12 +249,9 @@ Definition program := AST.program fundef unit.
 (** Convert a [positive] to an expression directly, setting it to the right
     size. *)
 Definition posToLit (p : positive) : expr :=
-  Vlit (posToValueAuto p).
-
-Coercion Vlit : value >-> expr.
-Coercion Vvar : reg >-> expr.
+  Vlit (posToValue p).
 
-Definition fext := assocmap.
+Definition fext := unit.
 Definition fextclk := nat -> fext.
 
 (** ** State
@@ -298,81 +299,99 @@ Inductive state : Type :=
            (m : module)
            (args : list value), state.
 
-Definition binop_run (op : binop) : forall v1 v2 : value, vsize v1 = vsize v2 -> value :=
+Definition binop_run (op : binop) (v1 v2 : value) : option value :=
   match op with
-  | Vadd => vplus
-  | Vsub => vminus
-  | Vmul => vmul
-  | Vdiv => vdivs
-  | Vdivu => vdiv
-  | Vmod => vmods
-  | Vmodu => vmod
-  | Vlt => vlts
-  | Vltu => vlt
-  | Vgt => vgts
-  | Vgtu => vgt
-  | Vle => vles
-  | Vleu => vle
-  | Vge => vges
-  | Vgeu => vge
-  | Veq => veq
-  | Vne => vne
-  | Vand => vand
-  | Vor => vor
-  | Vxor => vxor
-  | Vshl => vshl
-  | Vshr => vshr
-  | Vshru => vshr (* FIXME: should not be the same operation. *)
+  | Vadd => Some (Int.add v1 v2)
+  | Vsub => Some (Int.sub v1 v2)
+  | Vmul => Some (Int.mul v1 v2)
+  | Vdiv => if Int.eq v2 Int.zero
+               || Int.eq v1 (Int.repr Int.min_signed) && Int.eq v2 Int.mone
+            then None
+            else Some (Int.divs v1 v2)
+  | Vdivu => if Int.eq v2 Int.zero then None else Some (Int.divu v1 v2)
+  | Vmod => if Int.eq v2 Int.zero
+               || Int.eq v1 (Int.repr Int.min_signed) && Int.eq v2 Int.mone
+            then None
+            else Some (Int.mods v1 v2)
+  | Vmodu => if Int.eq v2 Int.zero then None else Some (Int.modu v1 v2)
+  | Vlt => Some (boolToValue (Int.lt v1 v2))
+  | Vltu => Some (boolToValue (Int.ltu v1 v2))
+  | Vgt => Some (boolToValue (Int.lt v2 v1))
+  | Vgtu => Some (boolToValue (Int.ltu v2 v1))
+  | Vle => Some (boolToValue (negb (Int.lt v2 v1)))
+  | Vleu => Some (boolToValue (negb (Int.ltu v2 v1)))
+  | Vge => Some (boolToValue (negb (Int.lt v1 v2)))
+  | Vgeu => Some (boolToValue (negb (Int.ltu v1 v2)))
+  | Veq => Some (boolToValue (Int.eq v1 v2))
+  | Vne => Some (boolToValue (negb (Int.eq v1 v2)))
+  | Vand => Some (Int.and v1 v2)
+  | Vor => Some (Int.or v1 v2)
+  | Vxor => Some (Int.xor v1 v2)
+  | Vshl => Some (Int.shl v1 v2)
+  | Vshr => Some (Int.shr v1 v2)
+  | Vshru => Some (Int.shru v1 v2)
+  | Vror => Some (Int.ror v1 v2)
   end.
 
-Definition unop_run (op : unop) : value -> value :=
+Definition unop_run (op : unop) (v1 : value) : value :=
   match op with
-  | Vneg => vnot
-  | Vnot => vbitneg
+  | Vneg => Int.neg v1
+  | Vnot => Int.not v1
   end.
 
 Inductive expr_runp : fext -> assocmap -> assocmap_arr -> expr -> value -> Prop :=
   | erun_Vlit :
-      forall fext reg stack v,
-      expr_runp fext reg stack (Vlit v) v
+      forall fext asr asa v,
+      expr_runp fext asr asa (Vlit v) v
   | erun_Vvar :
-      forall fext reg stack v r,
-      reg#r = v ->
-      expr_runp fext reg stack (Vvar r) v
+      forall fext asr asa v r,
+      asr#r = v ->
+      expr_runp fext asr asa (Vvar r) v
+  | erun_Vvarb0 :
+      forall fext asr asa v r,
+      asr#r = v ->
+      expr_runp fext asr asa (Vvarb0 r) (IntExtra.ibyte0 v)
+  | erun_Vvarb1 :
+      forall fext asr asa v r,
+      asr#r = v ->
+      expr_runp fext asr asa (Vvarb1 r) (IntExtra.ibyte1 v)
+  | erun_Vvarb2 :
+      forall fext asr asa v r,
+      asr#r = v ->
+      expr_runp fext asr asa (Vvarb2 r) (IntExtra.ibyte2 v)
+  | erun_Vvarb3 :
+      forall fext asr asa v r,
+      asr#r = v ->
+      expr_runp fext asr asa (Vvarb3 r) (IntExtra.ibyte3 v)
   | erun_Vvari :
-      forall fext reg stack v iexp i r,
-      expr_runp fext reg stack iexp i ->
-      arr_assocmap_lookup stack r (valueToNat i) = Some v ->
-      expr_runp fext reg stack (Vvari r iexp) v
-  | erun_Vinputvar :
-      forall fext reg stack r v,
-      fext!r = Some v ->
-      expr_runp fext reg stack (Vinputvar r) v
+      forall fext asr asa v iexp i r,
+      expr_runp fext asr asa iexp i ->
+      arr_assocmap_lookup asa r (valueToNat i) = Some v ->
+      expr_runp fext asr asa (Vvari r iexp) v
   | erun_Vbinop :
-      forall fext reg stack op l r lv rv oper EQ resv,
-      expr_runp fext reg stack l lv ->
-      expr_runp fext reg stack r rv ->
-      oper = binop_run op ->
-      resv = oper lv rv EQ ->
-      expr_runp fext reg stack (Vbinop op l r) resv
+      forall fext asr asa op l r lv rv resv,
+      expr_runp fext asr asa l lv ->
+      expr_runp fext asr asa r rv ->
+      Some resv = binop_run op lv rv ->
+      expr_runp fext asr asa (Vbinop op l r) resv
   | erun_Vunop :
-      forall fext reg stack u vu op oper resv,
-      expr_runp fext reg stack u vu ->
+      forall fext asr asa u vu op oper resv,
+      expr_runp fext asr asa u vu ->
       oper = unop_run op ->
       resv = oper vu ->
-      expr_runp fext reg stack (Vunop op u) resv
+      expr_runp fext asr asa (Vunop op u) resv
   | erun_Vternary_true :
-      forall fext reg stack c ts fs vc vt,
-      expr_runp fext reg stack c vc ->
-      expr_runp fext reg stack ts vt ->
+      forall fext asr asa c ts fs vc vt,
+      expr_runp fext asr asa c vc ->
+      expr_runp fext asr asa ts vt ->
       valueToBool vc = true ->
-      expr_runp fext reg stack (Vternary c ts fs) vt
+      expr_runp fext asr asa (Vternary c ts fs) vt
   | erun_Vternary_false :
-      forall fext reg stack c ts fs vc vf,
-      expr_runp fext reg stack c vc ->
-      expr_runp fext reg stack fs vf ->
+      forall fext asr asa c ts fs vc vf,
+      expr_runp fext asr asa c vc ->
+      expr_runp fext asr asa fs vf ->
       valueToBool vc = false ->
-      expr_runp fext reg stack (Vternary c ts fs) vf.
+      expr_runp fext asr asa (Vternary c ts fs) vf.
 Hint Constructors expr_runp : verilog.
 
 Definition handle_opt {A : Type} (err : errmsg) (val : option A)
@@ -391,11 +410,11 @@ Definition handle_def {A : Type} (a : A) (val : option A)
 
 Local Open Scope error_monad_scope.
 
-Definition access_fext (f : fext) (r : reg) : res value :=
+(*Definition access_fext (f : fext) (r : reg) : res value :=
   match AssocMap.get r f with
   | Some v => OK v
-  | _ => OK (ZToValue 1 0)
-  end.
+  | _ => OK (ZToValue 0)
+  end.*)
 
 (* TODO FIX Vvar case without default *)
 (*Fixpoint expr_run (assoc : assocmap) (e : expr)
@@ -432,8 +451,8 @@ Inductive location : Type :=
 | LocArray (_ : reg) (_ : nat).
 
 Inductive location_is : fext -> assocmap -> assocmap_arr -> expr -> location -> Prop :=
-| Base : forall f asr asa r, location_is f asr asa (Vvar r) (LocReg r)
-| Indexed : forall f asr asa r iexp iv,
+| Reg : forall f asr asa r, location_is f asr asa (Vvar r) (LocReg r)
+| RegIndexed : forall f asr asa r iexp iv,
   expr_runp f asr asa iexp iv ->
   location_is f asr asa (Vvari r iexp) (LocArray r (valueToNat iv)).
 
@@ -519,7 +538,7 @@ Inductive stmnt_runp: fext -> reg_associations -> arr_associations ->
     forall f st1 st2 asr0 asa0 asr1 asa1 asr2 asa2,
     stmnt_runp f asr0 asa0 st1 asr1 asa1 ->
     stmnt_runp f asr1 asa1 st2 asr2 asa2 ->
-    stmnt_runp f asr0 asa1 (Vseq st1 st2) asr2 asa2
+    stmnt_runp f asr0 asa0 (Vseq st1 st2) asr2 asa2
 | stmnt_runp_Vcond_true:
     forall asr0 asa0 asr1 asa1 f c vc stt stf,
     expr_runp f asr0.(assoc_blocking) asa0.(assoc_blocking) c vc ->
@@ -530,7 +549,7 @@ Inductive stmnt_runp: fext -> reg_associations -> arr_associations ->
     forall asr0 asa0 asr1 asa1 f c vc stt stf,
     expr_runp f asr0.(assoc_blocking) asa0.(assoc_blocking) c vc ->
     valueToBool vc = false ->
-    stmnt_runp f asr0 asa0 stt asr1 asa1 ->
+    stmnt_runp f asr0 asa0 stf asr1 asa1 ->
     stmnt_runp f asr0 asa0 (Vcond c stt stf) asr1 asa1
 | stmnt_runp_Vcase_nomatch:
     forall e ve asr0 asa0 f asr1 asa1 me mve sc cs def,
@@ -599,7 +618,7 @@ Inductive mi_stepp : fext -> reg_associations -> arr_associations ->
                      module_item -> reg_associations -> arr_associations -> Prop :=
 | mi_stepp_Valways :
     forall f sr0 sa0 st sr1 sa1 c,
-    stmnt_runp f sr0 sa0 st sr1 sa0 ->
+    stmnt_runp f sr0 sa0 st sr1 sa1 ->
     mi_stepp f sr0 sa0 (Valways c st) sr1 sa1
 | mi_stepp_Valways_ff :
     forall f sr0 sa0 st sr1 sa1 c,
@@ -610,8 +629,8 @@ Inductive mi_stepp : fext -> reg_associations -> arr_associations ->
     stmnt_runp f sr0 sa0 st sr1 sa1 ->
     mi_stepp f sr0 sa0 (Valways_comb c st) sr1 sa1
 | mi_stepp_Vdecl :
-    forall f sr sa lhs rhs io,
-    mi_stepp f sr sa (Vdeclaration (Vdecl io lhs rhs)) sr sa.
+    forall f sr sa d,
+    mi_stepp f sr sa (Vdeclaration d) sr sa.
 Hint Constructors mi_stepp : verilog.
 
 Inductive mis_stepp : fext -> reg_associations -> arr_associations ->
@@ -650,11 +669,11 @@ Fixpoint mi_run (f : fextclk) (assoc : assocmap) (m : list module_item) (n : nat
 assumed to be the starting state of the module, and may have to be changed if
 other arguments to the module are also to be supported. *)
 
-Definition initial_fextclk (m : module) : fextclk :=
+(*Definition initial_fextclk (m : module) : fextclk :=
   fun x => match x with
-           | S O => (AssocMap.set (mod_reset m) (ZToValue 1 1) empty_assocmap)
-           | _ => (AssocMap.set (mod_reset m) (ZToValue 1 0) empty_assocmap)
-           end.
+           | S O => (AssocMap.set (mod_reset m) (ZToValue 1) empty_assocmap)
+           | _ => (AssocMap.set (mod_reset m) (ZToValue 0) empty_assocmap)
+           end.*)
 
 (*Definition module_run (n : nat) (m : module) : res assocmap :=
   mi_run (initial_fextclk m) empty_assocmap (mod_body m) n.*)
@@ -713,6 +732,8 @@ Definition empty_stack (m : module) : assocmap_arr :=
 Inductive step : genv -> state -> Events.trace -> state -> Prop :=
   | step_module :
       forall asr asa asr' asa' basr1 nasr1 basa1 nasa1 f stval pstval m sf st g ist,
+      asr!(m.(mod_reset)) = Some (ZToValue 0) ->
+      asr!(m.(mod_finish)) = Some (ZToValue 0) ->
       asr!(m.(mod_st)) = Some ist ->
       valueToPos ist = st ->
       mis_stepp f (mkassociations asr empty_assocmap)
@@ -727,22 +748,23 @@ Inductive step : genv -> state -> Events.trace -> state -> Prop :=
       step g (State sf m st asr asa) Events.E0 (State sf m pstval asr' asa')
 | step_finish :
     forall asr asa sf retval m st g,
-    asr!(m.(mod_finish)) = Some (1'h"1") ->
+    asr!(m.(mod_finish)) = Some (ZToValue 1) ->
     asr!(m.(mod_return)) = Some retval ->
     step g (State sf m st asr asa) Events.E0 (Returnstate sf retval)
 | step_call :
     forall g res m args,
     step g (Callstate res m args) Events.E0
          (State res m m.(mod_entrypoint)
-          (AssocMap.set m.(mod_st) (posToValue 32 m.(mod_entrypoint))
-           (init_params args m.(mod_args)))
+          (AssocMap.set (mod_reset m) (ZToValue 0)
+           (AssocMap.set (mod_finish m) (ZToValue 0)
+            (AssocMap.set m.(mod_st) (posToValue m.(mod_entrypoint))
+             (init_params args m.(mod_args)))))
           (empty_stack m))
 | step_return :
     forall g m asr i r sf pc mst asa,
     mst = mod_st m ->
     step g (Returnstate (Stackframe r m pc asr asa :: sf) i) Events.E0
-         (State sf m pc ((asr # mst <- (posToValue 32 pc)) # r <- i)
-                (empty_stack m)).
+         (State sf m pc ((asr # mst <- (posToValue pc)) # r <- i) asa).
 Hint Constructors step : verilog.
 
 Inductive initial_state (p: program): state -> Prop :=
@@ -761,3 +783,138 @@ Inductive final_state : state -> Integers.int -> Prop :=
 Definition semantics (m : program) :=
   Smallstep.Semantics step (initial_state m) final_state
                       (Globalenvs.Genv.globalenv m).
+
+Lemma expr_runp_determinate :
+  forall f e asr asa v,
+  expr_runp f asr asa e v ->
+  forall v',
+  expr_runp f asr asa e v' ->
+  v' = v.
+Proof.
+  induction e; intros;
+
+  repeat (try match goal with
+              | [ H : expr_runp _ _ _ (Vlit _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vvar _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vvarb0 _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vvarb1 _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vvarb2 _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vvarb3 _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vvari _ _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vinputvar _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vbinop _ _ _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vunop _ _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vternary _ _ _) _ |- _ ] => invert H
+              | [ H : expr_runp _ _ _ (Vload _ _) _ |- _ ] => invert H
+
+              | [ H1 : forall asr asa v, expr_runp _ asr asa ?e v -> _,
+                  H2 : expr_runp _ _ _ ?e _ |- _ ] =>
+                learn (H1 _ _ _ H2)
+              | [ H1 : forall v, expr_runp _ ?asr ?asa ?e v -> _,
+                  H2 : expr_runp _ ?asr ?asa ?e _ |- _ ] =>
+                learn (H1 _ H2)
+              end; crush).
+Qed.
+Hint Resolve expr_runp_determinate : verilog.
+
+Lemma location_is_determinate :
+  forall f asr asa e l,
+  location_is f asr asa e l ->
+  forall l',
+  location_is f asr asa e l' ->
+  l' = l.
+Proof.
+  induction 1; intros;
+
+  repeat (try match goal with
+              | [ H : location_is _ _ _ _ _ |- _ ] => invert H
+              | [ H1 : expr_runp _ ?asr ?asa ?e _,
+                  H2 : expr_runp _ ?asr ?asa ?e _ |- _ ] =>
+                learn (expr_runp_determinate H1 H2)
+              end; crush).
+Qed.
+
+Lemma stmnt_runp_determinate :
+  forall f s asr0 asa0 asr1 asa1,
+  stmnt_runp f asr0 asa0 s asr1 asa1 ->
+  forall asr1' asa1',
+  stmnt_runp f asr0 asa0 s asr1' asa1' ->
+  asr1' = asr1 /\ asa1' = asa1.
+  induction 1; intros;
+
+  repeat (try match goal with
+             | [ H : stmnt_runp _ _ _ (Vseq _ _) _ _ |- _ ] => invert H
+             | [ H : stmnt_runp _ _ _ (Vnonblock _ _) _ _ |- _ ] => invert H
+             | [ H : stmnt_runp _ _ _ (Vblock _ _) _ _ |- _ ] => invert H
+             | [ H : stmnt_runp _ _ _ Vskip _ _ |- _ ] => invert H
+             | [ H : stmnt_runp _ _ _ (Vcond _ _ _) _ _ |- _ ] => invert H
+             | [ H : stmnt_runp _ _ _ (Vcase _ (_ :: _) _) _ _ |- _ ] => invert H
+             | [ H : stmnt_runp _ _ _ (Vcase _ []  _) _ _ |- _ ] => invert H
+
+             | [ H1 : expr_runp _ ?asr ?asa ?e _,
+                 H2 : expr_runp _ ?asr ?asa ?e _ |- _ ] =>
+               learn (expr_runp_determinate H1 H2)
+
+             | [ H1 : location_is _ ?asr ?asa ?e _,
+                 H2 : location_is _ ?asr ?asa ?e _ |- _ ] =>
+               learn (location_is_determinate H1 H2)
+
+             | [ H1 : forall asr1 asa1, stmnt_runp _ ?asr0 ?asa0 ?s asr1 asa1 -> _,
+                 H2 : stmnt_runp _ ?asr0 ?asa0 ?s _ _ |- _ ] =>
+               learn (H1 _ _ H2)
+              end; crush).
+Qed.
+Hint Resolve stmnt_runp_determinate : verilog.
+
+Lemma mi_stepp_determinate :
+  forall f asr0 asa0 m asr1 asa1,
+  mi_stepp f asr0 asa0 m asr1 asa1 ->
+  forall asr1' asa1',
+  mi_stepp f asr0 asa0 m asr1' asa1' ->
+  asr1' = asr1 /\ asa1' = asa1.
+Proof.
+  intros. destruct m; invert H; invert H0;
+
+  repeat (try match goal with
+              | [ H1 : stmnt_runp _ ?asr0 ?asa0 ?s _ _,
+                  H2 : stmnt_runp _ ?asr0 ?asa0 ?s _ _ |- _ ] =>
+                learn (stmnt_runp_determinate H1 H2)
+              end; crush).
+Qed.
+
+Lemma mis_stepp_determinate :
+  forall f asr0 asa0 m asr1 asa1,
+  mis_stepp f asr0 asa0 m asr1 asa1 ->
+  forall asr1' asa1',
+  mis_stepp f asr0 asa0 m asr1' asa1' ->
+  asr1' = asr1 /\ asa1' = asa1.
+Proof.
+  induction 1; intros;
+
+  repeat (try match goal with
+              | [ H : mis_stepp _ _ _ [] _ _ |- _ ] => invert H
+              | [ H : mis_stepp _ _ _ ( _ :: _ ) _ _ |- _ ] => invert H
+
+              | [ H1 : mi_stepp _ ?asr0 ?asa0 ?s _ _,
+                  H2 : mi_stepp _ ?asr0 ?asa0 ?s _ _ |- _ ] =>
+                learn (mi_stepp_determinate H1 H2)
+
+             | [ H1 : forall asr1 asa1, mis_stepp _ ?asr0 ?asa0 ?m asr1 asa1 -> _,
+                 H2 : mis_stepp _ ?asr0 ?asa0 ?m _ _ |- _ ] =>
+               learn (H1 _ _ H2)
+              end; crush).
+Qed.
+
+Lemma semantics_determinate :
+  forall (p: program), Smallstep.determinate (semantics p).
+Proof.
+  intros. constructor; set (ge := Globalenvs.Genv.globalenv p); simplify.
+  - invert H; invert H0; constructor. (* Traces are always empty *)
+  - invert H; invert H0; crush. assert (f = f0) by (destruct f; destruct f0; auto); subst.
+    pose proof (mis_stepp_determinate H5 H15).
+    crush.
+  - constructor. invert H; crush.
+  - invert H; invert H0; unfold ge0, ge1 in *; crush.
+  - red; simplify; intro; invert H0; invert H; crush.
+  - invert H; invert H0; crush.
+Qed.