Merge of the nonstrict-ops branch:

- Most RTL operators now evaluate to Some Vundef instead of None
  when undefined behavior occurs.
- More aggressive instruction selection.
- "Bertotization" of pattern-matchings now implemented by a proper preprocessor.
- Cast optimization moved to cfrontend/Cminorgen; removed backend/CastOptim.


git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1790 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e

9 files changed, 2677 insertions, 3544 deletions

diff --git a/ia32/Asm.v b/ia32/Asm.v
index 4fc38ba..63149aa 100644
--- a/ia32/Asm.v
+++ b/ia32/Asm.v
@@ -295,9 +295,9 @@ Definition eval_addrmode (a: addrmode) (rs: regset) : val :=
 
 SOF is (morally) the XOR of the SF and OF flags of the processor. *)
 
-Definition compare_ints (x y: val) (rs: regset) : regset :=
-  rs #ZF  <- (Val.cmp Ceq x y)
-     #CF  <- (Val.cmpu Clt x y)
+Definition compare_ints (x y: val) (rs: regset) (m: mem): regset :=
+  rs #ZF  <- (Val.cmpu (Mem.valid_pointer m) Ceq x y)
+     #CF  <- (Val.cmpu (Mem.valid_pointer m) Clt x y)
      #SOF <- (Val.cmp Clt x y)
      #PF  <- Vundef.
 
@@ -512,9 +512,9 @@ Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome
   | Pcvtsd2ss_mf a r1 =>
       exec_store Mfloat32 m a rs r1
   | Pcvttsd2si_rf rd r1 =>
-      Next (nextinstr (rs#rd <- (Val.intoffloat rs#r1))) m
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.intoffloat rs#r1)))) m
   | Pcvtsi2sd_fr rd r1 =>
-      Next (nextinstr (rs#rd <- (Val.floatofint rs#r1))) m
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.floatofint rs#r1)))) m
   (** Integer arithmetic *)
   | Plea rd a =>
       Next (nextinstr (rs#rd <- (eval_addrmode a rs))) m
@@ -527,11 +527,17 @@ Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome
   | Pimul_ri rd n =>
       Next (nextinstr_nf (rs#rd <- (Val.mul rs#rd (Vint n)))) m
   | Pdiv r1 =>
-      Next (nextinstr_nf (rs#EAX <- (Val.divu rs#EAX (rs#EDX <- Vundef)#r1)
-                            #EDX <- (Val.modu rs#EAX (rs#EDX <- Vundef)#r1))) m
+      let vn := rs#EAX in let vd := (rs#EDX <- Vundef)#r1 in
+      match Val.divu vn vd, Val.modu vn vd with
+      | Some vq, Some vr => Next (nextinstr_nf (rs#EAX <- vq #EDX <- vr)) m
+      | _, _ => Stuck
+      end
   | Pidiv r1 =>
-      Next (nextinstr_nf (rs#EAX <- (Val.divs rs#EAX (rs#EDX <- Vundef)#r1)
-                            #EDX <- (Val.mods rs#EAX (rs#EDX <- Vundef)#r1))) m
+      let vn := rs#EAX in let vd := (rs#EDX <- Vundef)#r1 in
+      match Val.divs vn vd, Val.mods vn vd with
+      | Some vq, Some vr => Next (nextinstr_nf (rs#EAX <- vq #EDX <- vr)) m
+      | _, _ => Stuck
+      end
   | Pand_rr rd r1 =>
       Next (nextinstr_nf (rs#rd <- (Val.and rs#rd rs#r1))) m
   | Pand_ri rd n =>
@@ -561,24 +567,21 @@ Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome
   | Pror_ri rd n =>
       Next (nextinstr_nf (rs#rd <- (Val.ror rs#rd (Vint n)))) m
   | Pcmp_rr r1 r2 =>
-      Next (nextinstr (compare_ints (rs r1) (rs r2) rs)) m
+      Next (nextinstr (compare_ints (rs r1) (rs r2) rs m)) m
   | Pcmp_ri r1 n =>
-      Next (nextinstr (compare_ints (rs r1) (Vint n) rs)) m
+      Next (nextinstr (compare_ints (rs r1) (Vint n) rs m)) m
   | Ptest_rr r1 r2 =>
-      Next (nextinstr (compare_ints (Val.and (rs r1) (rs r2)) Vzero rs)) m
+      Next (nextinstr (compare_ints (Val.and (rs r1) (rs r2)) Vzero rs m)) m
   | Ptest_ri r1 n =>
-      Next (nextinstr (compare_ints (Val.and (rs r1) (Vint n)) Vzero rs)) m
+      Next (nextinstr (compare_ints (Val.and (rs r1) (Vint n)) Vzero rs m)) m
   | Pcmov c rd r1 =>
       match eval_testcond c rs with
       | Some true => Next (nextinstr (rs#rd <- (rs#r1))) m
       | Some false => Next (nextinstr rs) m
-      | None => Stuck
+      | None => Next (nextinstr (rs#rd <- Vundef)) m
       end
   | Psetcc c rd =>
-      match eval_testcond c rs with
-      | Some b => Next (nextinstr (rs#ECX <- Vundef #rd <- (Val.of_bool b))) m
-      | None => Stuck
-      end
+      Next (nextinstr (rs#ECX <- Vundef #rd <- (Val.of_optbool (eval_testcond c rs)))) m
   (** Arithmetic operations over floats *)
   | Paddd_ff rd r1 =>
       Next (nextinstr (rs#rd <- (Val.addf rs#rd rs#r1))) m
diff --git a/ia32/Asmgenproof.v b/ia32/Asmgenproof.v
index e8c6757..a49a7ff 100644
--- a/ia32/Asmgenproof.v
+++ b/ia32/Asmgenproof.v
@@ -844,8 +844,9 @@ Proof.
   intros [v' [A B]]. rewrite (sp_val _ _ _ AG) in A. 
   left; eapply exec_straight_steps; eauto; intros. simpl in H1. 
   exploit transl_op_correct; eauto. intros [rs2 [P [Q R]]]. 
+  assert (S: Val.lessdef v (rs2 (preg_of res))) by (eapply Val.lessdef_trans; eauto).
   exists rs2; split. eauto.
-  split. rewrite <- Q in B.
+  split.
   unfold undef_op.
   destruct op; try (eapply agree_set_undef_mreg; eauto).
   eapply agree_set_undef_move_mreg; eauto. 
@@ -1119,8 +1120,10 @@ Proof.
   intros; red; intros; inv MS. assert (f0 = f) by congruence. subst f0.
   exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros EC.
   left; eapply exec_straight_steps_goto; eauto.
-  intros. simpl in H2. 
-  exploit transl_cond_correct; eauto. intros [rs' [A [B C]]].
+  intros. simpl in H2.
+  destruct (transl_cond_correct tge tf cond args _ _ rs m' H2)
+  as [rs' [A [B C]]]. 
+  unfold PregEq.t in B; rewrite EC in B.
   destruct (testcond_for_condition cond); simpl in *.
 (* simple jcc *)
   exists (Pjcc c1 lbl); exists k; exists rs'.
@@ -1165,7 +1168,9 @@ Proof.
   intros; red; intros; inv MS.
   exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros EC.
   left; eapply exec_straight_steps; eauto. intros. simpl in H0. 
-  exploit transl_cond_correct; eauto. intros [rs' [A [B C]]].
+  destruct (transl_cond_correct tge tf cond args _ _ rs m' H0)
+  as [rs' [A [B C]]]. 
+  unfold PregEq.t in B; rewrite EC in B.
   destruct (testcond_for_condition cond); simpl in *.
 (* simple jcc *)
   econstructor; split.
diff --git a/ia32/Asmgenproof1.v b/ia32/Asmgenproof1.v
index be40f3d..5749a0b 100644
--- a/ia32/Asmgenproof1.v
+++ b/ia32/Asmgenproof1.v
@@ -625,26 +625,37 @@ Qed.
 (** Smart constructor for division *)
 
 Lemma mk_div_correct:
-  forall mkinstr dsem msem r1 r2 k c rs1 m,
+  forall mkinstr dsem msem r1 r2 k c (rs1: regset) m vq vr,
   mk_div mkinstr r1 r2 k = OK c ->
   (forall r c rs m,
    exec_instr ge c (mkinstr r) rs m =
-   Next (nextinstr_nf (rs#EAX <- (dsem rs#EAX (rs#EDX <- Vundef)#r) 
-                         #EDX <- (msem rs#EAX (rs#EDX <- Vundef)#r))) m) ->
+      let vn := rs#EAX in let vd := (rs#EDX <- Vundef)#r in
+      match dsem vn vd, msem vn vd with
+      | Some vq, Some vr => Next (nextinstr_nf (rs#EAX <- vq #EDX <- vr)) m
+      | _, _ => Stuck
+      end) ->
+  dsem rs1#r1 rs1#r2 = Some vq ->
+  msem rs1#r1 rs1#r2 = Some vr ->
   exists rs2,
      exec_straight c rs1 m k rs2 m
-  /\ rs2#r1 = dsem rs1#r1 rs1#r2
+  /\ rs2#r1 = vq
   /\ forall r, nontemp_preg r = true -> r <> r1 -> rs2#r = rs1#r.
 Proof.
   unfold mk_div; intros. 
   destruct (ireg_eq r1 EAX). destruct (ireg_eq r2 EDX); monadInv H.
 (* r1=EAX r2=EDX *)
-  econstructor. split. eapply exec_straight_two. simpl; eauto. apply H0. auto. auto.
+  econstructor. split. eapply exec_straight_two. simpl; eauto. 
+  rewrite H0.
+  change (nextinstr rs1 # ECX <- (rs1 EDX) EAX) with (rs1#EAX). 
+  change ((nextinstr rs1 # ECX <- (rs1 EDX)) # EDX <- Vundef ECX) with (rs1#EDX).
+  rewrite H1. rewrite H2. eauto. auto. auto. 
   split. SRes. 
-  intros. repeat SOther. 
+  intros. repeat SOther.
 (* r1=EAX r2<>EDX *)
-  econstructor. split. eapply exec_straight_one. apply H0. auto.
-  split. repeat SRes. decEq. apply Pregmap.gso. congruence. 
+  econstructor. split. eapply exec_straight_one. rewrite H0. 
+  replace (rs1 # EDX <- Vundef r2) with (rs1 r2). rewrite H1; rewrite H2. eauto. 
+  symmetry. SOther. auto.
+  split. SRes.
   intros. repeat SOther. 
 (* r1 <> EAX *)
   monadInv H.
@@ -654,9 +665,12 @@ Proof.
   econstructor; split.
   apply exec_straight_step with rs2 m; auto.
   eapply exec_straight_trans. eexact A. 
-  eapply exec_straight_three. simpl; eauto. simpl; eauto. simpl; eauto. 
+  eapply exec_straight_three.
+  rewrite H0. replace (rs3 EAX) with (rs1 r1). replace (rs3 # EDX <- Vundef ECX) with (rs1 r2).
+  rewrite H1; rewrite H2. eauto.  
+  simpl; eauto. simpl; eauto.
   auto. auto. auto. 
-  split. repeat SRes. decEq. rewrite B; unfold rs2; SRes. SOther.
+  split. repeat SRes.
   intros. destruct (preg_eq r EAX). subst.
   repeat SRes. rewrite D; auto with ppcgen. 
   repeat SOther. rewrite D; auto with ppcgen. unfold rs2; repeat SOther.
@@ -665,27 +679,42 @@ Qed.
 (** Smart constructor for modulus *)
 
 Lemma mk_mod_correct:
-  forall mkinstr dsem msem r1 r2 k c rs1 m,
+ forall mkinstr dsem msem r1 r2 k c (rs1: regset) m vq vr,
   mk_mod mkinstr r1 r2 k = OK c ->
   (forall r c rs m,
    exec_instr ge c (mkinstr r) rs m =
-   Next (nextinstr_nf (rs#EAX <- (dsem rs#EAX (rs#EDX <- Vundef)#r) 
-                         #EDX <- (msem rs#EAX (rs#EDX <- Vundef)#r))) m) ->
+      let vn := rs#EAX in let vd := (rs#EDX <- Vundef)#r in
+      match dsem vn vd, msem vn vd with
+      | Some vq, Some vr => Next (nextinstr_nf (rs#EAX <- vq #EDX <- vr)) m
+      | _, _ => Stuck
+      end) ->
+  dsem rs1#r1 rs1#r2 = Some vq ->
+  msem rs1#r1 rs1#r2 = Some vr ->
   exists rs2,
      exec_straight c rs1 m k rs2 m
-  /\ rs2#r1 = msem rs1#r1 rs1#r2
+  /\ rs2#r1 = vr
   /\ forall r, nontemp_preg r = true -> r <> r1 -> rs2#r = rs1#r.
 Proof.
   unfold mk_mod; intros. 
   destruct (ireg_eq r1 EAX). destruct (ireg_eq r2 EDX); monadInv H.
 (* r1=EAX r2=EDX *)
   econstructor. split. eapply exec_straight_three.
-  simpl; eauto. apply H0. simpl; eauto. auto. auto. auto.
+  simpl; eauto.
+  rewrite H0.
+  change (nextinstr rs1 # ECX <- (rs1 EDX) EAX) with (rs1#EAX). 
+  change ((nextinstr rs1 # ECX <- (rs1 EDX)) # EDX <- Vundef ECX) with (rs1#EDX).
+  rewrite H1. rewrite H2. eauto.
+  simpl; eauto.
+  auto. auto. auto. 
   split. SRes. 
-  intros. repeat SOther. 
+  intros. repeat SOther.
 (* r1=EAX r2<>EDX *)
-  econstructor. split. eapply exec_straight_two. apply H0. simpl; eauto. auto. auto.
-  split. repeat SRes. decEq. apply Pregmap.gso. congruence. 
+  econstructor. split. eapply exec_straight_two. rewrite H0. 
+  replace (rs1 # EDX <- Vundef r2) with (rs1 r2). rewrite H1; rewrite H2. eauto. 
+  symmetry. SOther. 
+  simpl; eauto. 
+  auto. auto. 
+  split. SRes.
   intros. repeat SOther. 
 (* r1 <> EAX *)
   monadInv H.
@@ -695,57 +724,79 @@ Proof.
   econstructor; split.
   apply exec_straight_step with rs2 m; auto.
   eapply exec_straight_trans. eexact A. 
-  eapply exec_straight_three. simpl; eauto. simpl; eauto. simpl; eauto. 
+  eapply exec_straight_three.
+  rewrite H0. replace (rs3 EAX) with (rs1 r1). replace (rs3 # EDX <- Vundef ECX) with (rs1 r2).
+  rewrite H1; rewrite H2. eauto.  
+  simpl; eauto. simpl; eauto.
   auto. auto. auto. 
-  split. repeat SRes. decEq. rewrite B; unfold rs2; SRes. SOther.
+  split. repeat SRes.
   intros. destruct (preg_eq r EAX). subst.
   repeat SRes. rewrite D; auto with ppcgen. 
   repeat SOther. rewrite D; auto with ppcgen. unfold rs2; repeat SOther.
 Qed.
 
+Remark divs_mods_exist:
+  forall v1 v2,
+  match Val.divs v1 v2, Val.mods v1 v2 with
+  | Some _, Some _ => True
+  | None, None => True
+  | _, _ => False
+  end.
+Proof.
+  intros. unfold Val.divs, Val.mods. destruct v1; auto. destruct v2; auto.
+  destruct (Int.eq i0 Int.zero); auto. 
+Qed.
+
+Remark divu_modu_exist:
+  forall v1 v2,
+  match Val.divu v1 v2, Val.modu v1 v2 with
+  | Some _, Some _ => True
+  | None, None => True
+  | _, _ => False
+  end.
+Proof.
+  intros. unfold Val.divu, Val.modu. destruct v1; auto. destruct v2; auto.
+  destruct (Int.eq i0 Int.zero); auto. 
+Qed.
+
 (** Smart constructor for [shrx] *)
 
 Lemma mk_shrximm_correct:
-  forall r1 n k c (rs1: regset) x m,
+  forall r1 n k c (rs1: regset) v m,
   mk_shrximm r1 n k = OK c ->
-  rs1#r1 = Vint x ->
-  Int.ltu n (Int.repr 31) = true ->
+  Val.shrx (rs1#r1) (Vint n) = Some v ->
   exists rs2,
      exec_straight c rs1 m k rs2 m
-  /\ rs2#r1 = Vint (Int.shrx x n)
+  /\ rs2#r1 = v
   /\ forall r, nontemp_preg r = true -> r <> r1 -> rs2#r = rs1#r.
 Proof.
   unfold mk_shrximm; intros. inv H.
+  exploit Val.shrx_shr; eauto. intros [x [y [A [B C]]]].
+  inversion B; clear B; subst y; subst v; clear H0.
   set (tmp := if ireg_eq r1 ECX then EDX else ECX).
   assert (TMP1: tmp <> r1). unfold tmp; destruct (ireg_eq r1 ECX); congruence. 
   assert (TMP2: nontemp_preg tmp = false). unfold tmp; destruct (ireg_eq r1 ECX); auto. 
-  rewrite Int.shrx_shr; auto.
   set (tnm1 := Int.sub (Int.shl Int.one n) Int.one).
   set (x' := Int.add x tnm1).
-  set (rs2 := nextinstr (compare_ints (Vint x) (Vint Int.zero) rs1)).
+  set (rs2 := nextinstr (compare_ints (Vint x) (Vint Int.zero) rs1 m)).
   set (rs3 := nextinstr (rs2#tmp <- (Vint x'))).
   set (rs4 := nextinstr (if Int.lt x Int.zero then rs3#r1 <- (Vint x') else rs3)).
   set (rs5 := nextinstr_nf (rs4#r1 <- (Val.shr rs4#r1 (Vint n)))).
   assert (rs3#r1 = Vint x). unfold rs3. SRes. SRes. 
   assert (rs3#tmp = Vint x'). unfold rs3. SRes. SRes. 
   exists rs5. split. 
-  apply exec_straight_step with rs2 m. simpl. rewrite H0. simpl. rewrite Int.and_idem. auto. auto.
+  apply exec_straight_step with rs2 m. simpl. rewrite A. simpl. rewrite Int.and_idem. auto. auto.
   apply exec_straight_step with rs3 m. simpl. 
-  change (rs2 r1) with (rs1 r1). rewrite H0. simpl. 
+  change (rs2 r1) with (rs1 r1). rewrite A. simpl. 
   rewrite (Int.add_commut Int.zero tnm1). rewrite Int.add_zero. auto. auto.
   apply exec_straight_step with rs4 m. simpl. 
   change (rs3 SOF) with (rs2 SOF). unfold rs2. rewrite nextinstr_inv; auto with ppcgen. 
-  unfold compare_ints. rewrite Pregmap.gso; auto with ppcgen. rewrite Pregmap.gss. 
-  simpl. unfold rs4. destruct (Int.lt x Int.zero); auto. rewrite H2; auto. 
-  unfold rs4. destruct (Int.lt x Int.zero); auto.
+  unfold compare_ints. rewrite Pregmap.gso; auto with ppcgen. rewrite Pregmap.gss.
+  unfold Val.cmp. simpl. unfold rs4. destruct (Int.lt x Int.zero); simpl; auto. rewrite H0; auto.
+  unfold rs4. destruct (Int.lt x Int.zero); simpl; auto.
   apply exec_straight_one. auto. auto.
   split. unfold rs5. SRes. SRes. unfold rs4. rewrite nextinstr_inv; auto with ppcgen.
-  assert (Int.ltu n Int.iwordsize = true).
-    unfold Int.ltu in *. change (Int.unsigned (Int.repr 31)) with 31 in H1. 
-    destruct (zlt (Int.unsigned n) 31); try discriminate.
-    change (Int.unsigned Int.iwordsize) with 32. apply zlt_true. omega.
-  destruct (Int.lt x Int.zero). rewrite Pregmap.gss. unfold Val.shr. rewrite H3. auto.
-  rewrite H. unfold Val.shr. rewrite H3. auto. 
+  destruct (Int.lt x Int.zero). rewrite Pregmap.gss. rewrite A; auto. rewrite A; rewrite H; auto.
   intros. unfold rs5. repeat SOther. unfold rs4. SOther.
   transitivity (rs3#r). destruct (Int.lt x Int.zero). SOther. auto. 
   unfold rs3. repeat SOther. unfold rs2. repeat SOther. 
@@ -904,58 +955,55 @@ Lemma transl_addressing_mode_correct:
   forall addr args am (rs: regset) v,
   transl_addressing addr args = OK am ->
   eval_addressing ge (rs ESP) addr (List.map rs (List.map preg_of args)) = Some v ->
-  eval_addrmode ge am rs = v.
+  Val.lessdef v (eval_addrmode ge am rs).
 Proof.
   assert (A: forall n, Int.add Int.zero n = n). 
     intros. rewrite Int.add_commut. apply Int.add_zero.
   assert (B: forall n i, (if Int.eq i Int.one then Vint n else Vint (Int.mul n i)) = Vint (Int.mul n i)).
-    intros. generalize (Int.eq_spec i Int.one); destruct (Int.eq i Int.one); intros.
+    intros. predSpec Int.eq Int.eq_spec i Int.one. 
     subst i. rewrite Int.mul_one. auto. auto.
+  assert (C: forall v i,
+    Val.lessdef (Val.mul v (Vint i))
+               (if Int.eq i Int.one then v else Val.mul v (Vint i))).
+    intros. predSpec Int.eq Int.eq_spec i Int.one.
+    subst i. destruct v; simpl; auto. rewrite Int.mul_one; auto.
+    destruct v; simpl; auto.
   unfold transl_addressing; intros.
-  destruct addr; repeat (destruct args; try discriminate); simpl in H0.
+  destruct addr; repeat (destruct args; try discriminate); simpl in H0; inv H0.
 (* indexed *)
-  monadInv H. rewrite (ireg_of_eq _ _ EQ) in H0. simpl.
-  destruct (rs x); inv H0; simpl. rewrite A; auto. rewrite A; auto.
+  monadInv H. rewrite (ireg_of_eq _ _ EQ). simpl. rewrite A; auto.
 (* indexed2 *)
-  monadInv H. rewrite (ireg_of_eq _ _ EQ) in H0; rewrite (ireg_of_eq _ _ EQ1) in H0. simpl.
-  destruct (rs x); try discriminate; destruct (rs x0); inv H0; simpl.
-  rewrite Int.add_assoc; auto. 
-  repeat rewrite Int.add_assoc. decEq. decEq. apply Int.add_commut.
-  rewrite Int.add_assoc; auto.
+  monadInv H. rewrite (ireg_of_eq _ _ EQ); rewrite (ireg_of_eq _ _ EQ1). simpl.
+  rewrite Val.add_assoc; auto. 
 (* scaled *)
-  monadInv H. rewrite (ireg_of_eq _ _ EQ) in H0. simpl.
-  destruct (rs x); inv H0; simpl.
-  rewrite B. simpl. rewrite A. auto.
+  monadInv H. rewrite (ireg_of_eq _ _ EQ). unfold eval_addrmode. 
+  rewrite Val.add_permut. simpl. rewrite A. apply Val.add_lessdef; auto. 
 (* indexed2scaled *)
-  monadInv H. rewrite (ireg_of_eq _ _ EQ) in H0; rewrite (ireg_of_eq _ _ EQ1) in H0. simpl.
-  destruct (rs x); try discriminate; destruct (rs x0); inv H0; simpl.
-  rewrite B. simpl. auto.
-  rewrite B. simpl. auto.
+  monadInv H. rewrite (ireg_of_eq _ _ EQ); rewrite (ireg_of_eq _ _ EQ1); simpl.
+  apply Val.add_lessdef; auto. apply Val.add_lessdef; auto. 
 (* global *)
-  inv H. simpl. unfold symbol_offset. destruct (Genv.find_symbol ge i); inv H0.
-  repeat rewrite Int.add_zero. auto.
+  inv H. simpl. unfold symbol_address, symbol_offset.
+  destruct (Genv.find_symbol ge i); simpl; auto. repeat rewrite Int.add_zero. auto.
 (* based *)
-  monadInv H. rewrite (ireg_of_eq _ _ EQ) in H0. simpl.
-  destruct (rs x); inv H0; simpl.
-  unfold symbol_offset. destruct (Genv.find_symbol ge i); inv H1. 
-  rewrite Int.add_zero; auto.
+  monadInv H. rewrite (ireg_of_eq _ _ EQ). simpl.
+  unfold symbol_address, symbol_offset. destruct (Genv.find_symbol ge i); simpl; auto.
+  rewrite Int.add_zero. rewrite Val.add_commut. auto. 
 (* basedscaled *)
-  monadInv H. rewrite (ireg_of_eq _ _ EQ) in H0. simpl.
-  destruct (rs x); inv H0; simpl.
-  rewrite B. unfold symbol_offset. destruct (Genv.find_symbol ge i0); inv H1. 
-  simpl. rewrite Int.add_zero. auto.
+  monadInv H. rewrite (ireg_of_eq _ _ EQ). unfold eval_addrmode. 
+  rewrite (Val.add_commut Vzero). rewrite Val.add_assoc. rewrite Val.add_permut.
+  apply Val.add_lessdef; auto. destruct (rs x); simpl; auto. rewrite B. simpl.
+  rewrite Int.add_zero. auto.
 (* instack *)
-  inv H; simpl. unfold offset_sp in H0. 
-  destruct (rs ESP); inv H0. simpl. rewrite A; auto. 
+  inv H; simpl. rewrite A; auto.
 Qed.
 
 (** Processor conditions and comparisons *)
 
 Lemma compare_ints_spec:
-  forall rs v1 v2,
-  let rs' := nextinstr (compare_ints v1 v2 rs) in
-     rs'#ZF = Val.cmp Ceq v1 v2
-  /\ rs'#CF = Val.cmpu Clt v1 v2
+  forall rs v1 v2 m,
+  let rs' := nextinstr (compare_ints v1 v2 rs m) in
+     rs'#ZF = Val.cmpu (Mem.valid_pointer m) Ceq v1 v2
+  /\ rs'#CF = Val.cmpu (Mem.valid_pointer m) Clt v1 v2
   /\ rs'#SOF = Val.cmp Clt v1 v2
   /\ (forall r, nontemp_preg r = true -> rs'#r = rs#r).
 Proof.
@@ -1012,112 +1060,69 @@ Proof.
   intros. rewrite <- negb_orb. rewrite <- int_not_ltu. rewrite negb_involutive. auto.
 Qed.
 
-Lemma testcond_for_signed_comparison_correct_ii:
-  forall c n1 n2 rs,
+Lemma testcond_for_signed_comparison_correct:
+  forall c v1 v2 rs m b,
+  Val.cmp_bool c v1 v2 = Some b ->
   eval_testcond (testcond_for_signed_comparison c)
-                (nextinstr (compare_ints (Vint n1) (Vint n2) rs)) =
-  Some(Int.cmp c n1 n2).
-Proof.
-  intros. generalize (compare_ints_spec rs (Vint n1) (Vint n2)).
-  set (rs' := nextinstr (compare_ints (Vint n1) (Vint n2) rs)). 
-  intros [A [B [C D]]].
-  unfold eval_testcond. rewrite A; rewrite B; rewrite C.
-  destruct c; simpl.
-  destruct (Int.eq n1 n2); auto.
-  destruct (Int.eq n1 n2); auto.
-  destruct (Int.lt n1 n2); auto.
-  rewrite int_not_lt. destruct (Int.lt n1 n2); destruct (Int.eq n1 n2); auto.
-  rewrite (int_lt_not n1 n2). destruct (Int.lt n1 n2); destruct (Int.eq n1 n2); auto.
-  destruct (Int.lt n1 n2); auto.
-Qed.
-
-Lemma testcond_for_unsigned_comparison_correct_ii:
-  forall c n1 n2 rs,
-  eval_testcond (testcond_for_unsigned_comparison c)
-                (nextinstr (compare_ints (Vint n1) (Vint n2) rs)) =
-  Some(Int.cmpu c n1 n2).
+                (nextinstr (compare_ints v1 v2 rs m)) = Some b.
 Proof.
-  intros. generalize (compare_ints_spec rs (Vint n1) (Vint n2)).
-  set (rs' := nextinstr (compare_ints (Vint n1) (Vint n2) rs)). 
+  intros. generalize (compare_ints_spec rs v1 v2 m).
+  set (rs' := nextinstr (compare_ints v1 v2 rs m)).
   intros [A [B [C D]]].
-  unfold eval_testcond. rewrite A; rewrite B; rewrite C.
+  destruct v1; destruct v2; simpl in H; inv H.
+  unfold eval_testcond. rewrite A; rewrite B; rewrite C. unfold Val.cmp, Val.cmpu.
   destruct c; simpl.
-  destruct (Int.eq n1 n2); auto.
-  destruct (Int.eq n1 n2); auto.
-  destruct (Int.ltu n1 n2); auto.
-  rewrite int_not_ltu. destruct (Int.ltu n1 n2); destruct (Int.eq n1 n2); auto.
-  rewrite (int_ltu_not n1 n2). destruct (Int.ltu n1 n2); destruct (Int.eq n1 n2); auto.
-  destruct (Int.ltu n1 n2); auto.
+  destruct (Int.eq i i0); auto.
+  destruct (Int.eq i i0); auto.
+  destruct (Int.lt i i0); auto.
+  rewrite int_not_lt. destruct (Int.lt i i0); simpl; destruct (Int.eq i i0); auto.
+  rewrite (int_lt_not i i0). destruct (Int.lt i i0); destruct (Int.eq i i0); reflexivity.
+  destruct (Int.lt i i0); reflexivity.
 Qed.
 
-Lemma testcond_for_unsigned_comparison_correct_pi:
-  forall c blk n1 n2 rs b,
-  eval_compare_null c n2 = Some b ->
+Lemma testcond_for_unsigned_comparison_correct:
+  forall c v1 v2 rs m b,
+  Val.cmpu_bool (Mem.valid_pointer m) c v1 v2 = Some b ->
   eval_testcond (testcond_for_unsigned_comparison c)
-                (nextinstr (compare_ints (Vptr blk n1) (Vint n2) rs)) = Some b.
+                (nextinstr (compare_ints v1 v2 rs m)) = Some b.
 Proof.
-  intros.
-  revert H. unfold eval_compare_null. 
-  generalize (Int.eq_spec n2 Int.zero); destruct (Int.eq n2 Int.zero); intros; try discriminate.
-  subst n2.
-  generalize (compare_ints_spec rs (Vptr blk n1) (Vint Int.zero)).
-  set (rs' := nextinstr (compare_ints (Vptr blk n1) (Vint Int.zero) rs)). 
+  intros. generalize (compare_ints_spec rs v1 v2 m).
+  set (rs' := nextinstr (compare_ints v1 v2 rs m)).
   intros [A [B [C D]]].
-  unfold eval_testcond. rewrite A; rewrite B; rewrite C.
-  destruct c; simpl; try discriminate.
-  rewrite <- H0; auto.
-  rewrite <- H0; auto.
-Qed.
-
-Lemma testcond_for_unsigned_comparison_correct_ip:
-  forall c blk n1 n2 rs b,
-  eval_compare_null c n1 = Some b ->
-  eval_testcond (testcond_for_unsigned_comparison c)
-                (nextinstr (compare_ints (Vint n1) (Vptr blk n2) rs)) = Some b.
-Proof.
-  intros.
-  revert H. unfold eval_compare_null. 
-  generalize (Int.eq_spec n1 Int.zero); destruct (Int.eq n1 Int.zero); intros; try discriminate.
-  subst n1.
-  generalize (compare_ints_spec rs (Vint Int.zero) (Vptr blk n2)).
-  set (rs' := nextinstr (compare_ints (Vint Int.zero) (Vptr blk n2) rs)). 
-  intros [A [B [C D]]].
-  unfold eval_testcond. rewrite A; rewrite B; rewrite C.
-  destruct c; simpl; try discriminate.
-  rewrite <- H0; auto.
-  rewrite <- H0; auto.
-Qed.
-
-Lemma testcond_for_unsigned_comparison_correct_pp:
-  forall c b1 n1 b2 n2 rs m b,
-  (if Mem.valid_pointer m b1 (Int.unsigned n1) && Mem.valid_pointer m b2 (Int.unsigned n2) 
-   then if eq_block b1 b2 then Some (Int.cmpu c n1 n2) else eval_compare_mismatch c
-   else None) = Some b ->
-  eval_testcond (testcond_for_unsigned_comparison c)
-                (nextinstr (compare_ints (Vptr b1 n1) (Vptr b2 n2) rs)) =
-  Some b.
-Proof.
-  intros.
-  destruct (Mem.valid_pointer m b1 (Int.unsigned n1) && Mem.valid_pointer m b2 (Int.unsigned n2)); try discriminate.
-  generalize (compare_ints_spec rs (Vptr b1 n1) (Vptr b2 n2)).
-  set (rs' := nextinstr (compare_ints (Vptr b1 n1) (Vptr b2 n2) rs)). 
-  intros [A [B [C D]]]. unfold eq_block in H.
-  unfold eval_testcond. rewrite A; rewrite B; rewrite C.
-  destruct c; simpl.
-  destruct (zeq b1 b2). inversion H. destruct (Int.eq n1 n2); auto.
-  rewrite <- H; auto.
-  destruct (zeq b1 b2). inversion H. destruct (Int.eq n1 n2); auto.
-  rewrite <- H; auto.
-  destruct (zeq b1 b2). inversion H. destruct (Int.ltu n1 n2); auto.
-  discriminate.
-  destruct (zeq b1 b2). inversion H. 
-  rewrite int_not_ltu. destruct (Int.ltu n1 n2); destruct (Int.eq n1 n2); auto.
-  discriminate.
-  destruct (zeq b1 b2). inversion H. 
-  rewrite (int_ltu_not n1 n2). destruct (Int.ltu n1 n2); destruct (Int.eq n1 n2); auto.
-  discriminate.
-  destruct (zeq b1 b2). inversion H. destruct (Int.ltu n1 n2); auto.
-  discriminate.
+  unfold eval_testcond. rewrite A; rewrite B; rewrite C. unfold Val.cmpu, Val.cmp.
+  destruct v1; destruct v2; simpl in H; inv H.
+(* int int *)
+  destruct c; simpl; auto.
+  destruct (Int.eq i i0); reflexivity.
+  destruct (Int.eq i i0); auto.
+  destruct (Int.ltu i i0); auto.
+  rewrite int_not_ltu. destruct (Int.ltu i i0); simpl; destruct (Int.eq i i0); auto.
+  rewrite (int_ltu_not i i0). destruct (Int.ltu i i0); destruct (Int.eq i i0); reflexivity.
+  destruct (Int.ltu i i0); reflexivity.
+(* int ptr *)
+  destruct (Int.eq i Int.zero) as []_eqn; try discriminate.
+  destruct c; simpl in *; inv H1.
+  rewrite Heqb1; reflexivity. 
+  rewrite Heqb1; reflexivity.
+(* ptr int *)
+  destruct (Int.eq i0 Int.zero) as []_eqn; try discriminate.
+  destruct c; simpl in *; inv H1.
+  rewrite Heqb1; reflexivity. 
+  rewrite Heqb1; reflexivity.
+(* ptr ptr *)
+  simpl. 
+  destruct (Mem.valid_pointer m b0 (Int.unsigned i) &&
+            Mem.valid_pointer m b1 (Int.unsigned i0)); try discriminate.
+  destruct (zeq b0 b1).
+  inversion H1.
+  destruct c; simpl; auto.
+  destruct (Int.eq i i0); reflexivity.
+  destruct (Int.eq i i0); auto.
+  destruct (Int.ltu i i0); auto.
+  rewrite int_not_ltu. destruct (Int.ltu i i0); simpl; destruct (Int.eq i i0); auto.
+  rewrite (int_ltu_not i i0). destruct (Int.ltu i i0); destruct (Int.eq i i0); reflexivity.
+  destruct (Int.ltu i i0); reflexivity.
+  destruct c; simpl in *; inv H1; reflexivity.
 Qed.
 
 Lemma compare_floats_spec:
@@ -1151,7 +1156,113 @@ Definition eval_extcond (xc: extcond) (rs: regset) : option bool :=
       end
   end.
 
-Definition swap_floats (c: comparison) (n1 n2: float) : float :=
+(*******
+
+Definition swap_floats {A: Type} (c: comparison) (n1 n2: A) : A :=
+  match c with
+  | Clt | Cle => n2
+  | Ceq | Cne | Cgt | Cge => n1
+  end.
+
+Lemma testcond_for_float_comparison_correct:
+  forall c v1 v2 rs b,
+  Val.cmpf_bool c v1 v2 = Some b ->
+  eval_extcond (testcond_for_condition (Ccompf c))
+               (nextinstr (compare_floats (swap_floats c v1 v2)
+                                         (swap_floats c v2 v1) rs)) = Some b.
+Proof.
+  intros. destruct v1; destruct v2; simpl in H; inv H.
+  assert (SWP: forall f1 f2, Vfloat (swap_floats c f1 f2) = swap_floats c (Vfloat f1) (Vfloat f2)).
+    destruct c; auto.
+  generalize (compare_floats_spec rs (swap_floats c f f0) (swap_floats c f0 f)).
+  repeat rewrite <- SWP.
+  set (rs' := nextinstr (compare_floats (Vfloat (swap_floats c f f0))
+                                      (Vfloat (swap_floats c f0 f)) rs)).
+  intros [A [B [C D]]].
+  unfold eval_extcond, eval_testcond. rewrite A; rewrite B; rewrite C.
+  destruct c; simpl.
+(* eq *)
+  rewrite Float.cmp_ne_eq.
+  destruct (Float.cmp Ceq f f0). auto.
+  simpl. destruct (Float.cmp Clt f f0 || Float.cmp Cgt f f0); auto.
+(* ne *)
+  rewrite Float.cmp_ne_eq.
+  destruct (Float.cmp Ceq f f0). auto.
+  simpl. destruct (Float.cmp Clt f f0 || Float.cmp Cgt f f0); auto.
+(* lt *)
+  rewrite <- (Float.cmp_swap Cge f f0).
+  rewrite <- (Float.cmp_swap Cne f f0).
+  simpl.
+  rewrite Float.cmp_ne_eq. rewrite Float.cmp_le_lt_eq.
+  caseEq (Float.cmp Clt f f0); intros; simpl.
+  caseEq (Float.cmp Ceq f f0); intros; simpl. 
+  elimtype False. eapply Float.cmp_lt_eq_false; eauto. 
+  auto. 
+  destruct (Float.cmp Ceq f f0); auto.
+(* le *)
+  rewrite <- (Float.cmp_swap Cge f f0). simpl.
+  destruct (Float.cmp Cle f f0); auto.
+(* gt *)
+  rewrite Float.cmp_ne_eq. rewrite Float.cmp_ge_gt_eq. 
+  caseEq (Float.cmp Cgt f f0); intros; simpl.
+  caseEq (Float.cmp Ceq f f0); intros; simpl. 
+  elimtype False. eapply Float.cmp_gt_eq_false; eauto. 
+  auto. 
+  destruct (Float.cmp Ceq f f0); auto.
+(* ge *)
+  destruct (Float.cmp Cge f f0); auto.
+Qed.
+
+Lemma testcond_for_neg_float_comparison_correct:
+  forall c n1 n2 rs,
+  eval_extcond (testcond_for_condition (Cnotcompf c))
+               (nextinstr (compare_floats (Vfloat (swap_floats c n1 n2))
+                                          (Vfloat (swap_floats c n2 n1)) rs)) =
+  Some(negb(Float.cmp c n1 n2)).
+Proof.
+  intros.
+  generalize (compare_floats_spec rs (swap_floats c n1 n2) (swap_floats c n2 n1)).
+  set (rs' := nextinstr (compare_floats (Vfloat (swap_floats c n1 n2))
+                                        (Vfloat (swap_floats c n2 n1)) rs)).
+  intros [A [B [C D]]].
+  unfold eval_extcond, eval_testcond. rewrite A; rewrite B; rewrite C.
+  destruct c; simpl.
+(* eq *)
+  rewrite Float.cmp_ne_eq.
+  caseEq (Float.cmp Ceq n1 n2); intros.
+  auto.
+  simpl. destruct (Float.cmp Clt n1 n2 || Float.cmp Cgt n1 n2); auto.
+(* ne *)
+  rewrite Float.cmp_ne_eq.
+  caseEq (Float.cmp Ceq n1 n2); intros.
+  auto.
+  simpl. destruct (Float.cmp Clt n1 n2 || Float.cmp Cgt n1 n2); auto.
+(* lt *)
+  rewrite <- (Float.cmp_swap Cge n1 n2).
+  rewrite <- (Float.cmp_swap Cne n1 n2).
+  simpl.
+  rewrite Float.cmp_ne_eq. rewrite Float.cmp_le_lt_eq.
+  caseEq (Float.cmp Clt n1 n2); intros; simpl.
+  caseEq (Float.cmp Ceq n1 n2); intros; simpl. 
+  elimtype False. eapply Float.cmp_lt_eq_false; eauto.
+  auto. 
+  destruct (Float.cmp Ceq n1 n2); auto.
+(* le *)
+  rewrite <- (Float.cmp_swap Cge n1 n2). simpl.
+  destruct (Float.cmp Cle n1 n2); auto.
+(* gt *)
+  rewrite Float.cmp_ne_eq. rewrite Float.cmp_ge_gt_eq. 
+  caseEq (Float.cmp Cgt n1 n2); intros; simpl.
+  caseEq (Float.cmp Ceq n1 n2); intros; simpl. 
+  elimtype False. eapply Float.cmp_gt_eq_false; eauto. 
+  auto. 
+  destruct (Float.cmp Ceq n1 n2); auto.
+(* ge *)
+  destruct (Float.cmp Cge n1 n2); auto.
+Qed.
+***************)
+
+Definition swap_floats {A: Type} (c: comparison) (n1 n2: A) : A :=
   match c with
   | Clt | Cle => n2
   | Ceq | Cne | Cgt | Cge => n1
@@ -1253,81 +1364,95 @@ Proof.
   destruct (Float.cmp Cge n1 n2); auto.
 Qed.
 
+Remark swap_floats_commut:
+  forall c x y, swap_floats c (Vfloat x) (Vfloat y) = Vfloat (swap_floats c x y).
+Proof.
+  intros. destruct c; auto. 
+Qed.
+
+Remark compare_floats_inv:
+  forall vx vy rs r,
+  r <> CR ZF -> r <> CR CF -> r <> CR PF -> r <> CR SOF ->
+  compare_floats vx vy rs r = rs r.
+Proof.
+  intros. 
+  assert (DFL: undef_regs (CR ZF :: CR CF :: CR PF :: CR SOF :: nil) rs r = rs r).
+    simpl. repeat SOther.
+  unfold compare_floats; destruct vx; destruct vy; auto. repeat SOther.
+Qed.  
+
 Lemma transl_cond_correct:
-  forall cond args k c rs m b,
+  forall cond args k c rs m,
   transl_cond cond args k = OK c ->
-  eval_condition cond (map rs (map preg_of args)) m = Some b ->
   exists rs',
      exec_straight c rs m k rs' m
-  /\ eval_extcond (testcond_for_condition cond) rs' = Some b
+  /\ match eval_condition cond (map rs (map preg_of args)) m with
+     | None => True
+     | Some b => eval_extcond (testcond_for_condition cond) rs' = Some b
+     end
   /\ forall r, nontemp_preg r = true -> rs'#r = rs r.
 Proof.
   unfold transl_cond; intros. 
   destruct cond; repeat (destruct args; try discriminate); monadInv H.
 (* comp *)
-  simpl map in H0. rewrite (ireg_of_eq _ _ EQ) in H0. rewrite (ireg_of_eq _ _ EQ1) in H0.
+  simpl. rewrite (ireg_of_eq _ _ EQ). rewrite (ireg_of_eq _ _ EQ1).
   econstructor. split. apply exec_straight_one. simpl. eauto. auto.
-  split. simpl in H0. FuncInv.
-  subst b. simpl. apply testcond_for_signed_comparison_correct_ii. 
+  split. destruct (Val.cmp_bool c0 (rs x) (rs x0)) as []_eqn; auto.
+  eapply testcond_for_signed_comparison_correct; eauto. 
   intros. unfold compare_ints. repeat SOther.
 (* compu *)
-  simpl map in H0. 
-  rewrite (ireg_of_eq _ _ EQ) in H0. rewrite (ireg_of_eq _ _ EQ1) in H0.
+  simpl. rewrite (ireg_of_eq _ _ EQ). rewrite (ireg_of_eq _ _ EQ1).
   econstructor. split. apply exec_straight_one. simpl. eauto. auto.
-  split. simpl in H0. FuncInv.
-  subst b. simpl; apply testcond_for_unsigned_comparison_correct_ii. 
-  simpl; apply testcond_for_unsigned_comparison_correct_ip; auto. 
-  simpl; apply testcond_for_unsigned_comparison_correct_pi; auto.
-  simpl; eapply testcond_for_unsigned_comparison_correct_pp; eauto.
+  split. destruct (Val.cmpu_bool (Mem.valid_pointer m) c0 (rs x) (rs x0)) as []_eqn; auto.
+  eapply testcond_for_unsigned_comparison_correct; eauto. 
   intros. unfold compare_ints. repeat SOther.
 (* compimm *)
-  simpl map in H0. rewrite (ireg_of_eq _ _ EQ) in H0.
-  exists (nextinstr (compare_ints (rs x) (Vint i) rs)).
-  split. destruct (Int.eq_dec i Int.zero). 
-  apply exec_straight_one. subst i. simpl.
-  simpl in H0. FuncInv. simpl. rewrite Int.and_idem. auto. auto.
-  apply exec_straight_one; auto.
-  split. simpl in H0. FuncInv.
-  subst b. simpl; apply testcond_for_signed_comparison_correct_ii.
+  simpl. rewrite (ireg_of_eq _ _ EQ). destruct (Int.eq_dec i Int.zero).
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto. 
+  split. destruct (rs x); simpl; auto. subst. rewrite Int.and_idem.
+  eapply testcond_for_signed_comparison_correct; eauto. 
+  intros. unfold compare_ints. repeat SOther.
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto. 
+  split. destruct (Val.cmp_bool c0 (rs x) (Vint i)) as []_eqn; auto.
+  eapply testcond_for_signed_comparison_correct; eauto. 
   intros. unfold compare_ints. repeat SOther.
 (* compuimm *)
-  simpl map in H0. rewrite (ireg_of_eq _ _ EQ) in H0.
-  econstructor. split. apply exec_straight_one. simpl; eauto. auto.
-  split. simpl in H0. FuncInv. 
-  subst b. simpl; apply testcond_for_unsigned_comparison_correct_ii. 
-  simpl; apply testcond_for_unsigned_comparison_correct_pi; auto.
+  simpl. rewrite (ireg_of_eq _ _ EQ).
+  econstructor. split. apply exec_straight_one. simpl. eauto. auto.
+  split. destruct (Val.cmpu_bool (Mem.valid_pointer m) c0 (rs x) (Vint i)) as []_eqn; auto.
+  eapply testcond_for_unsigned_comparison_correct; eauto. 
   intros. unfold compare_ints. repeat SOther.
 (* compf *)
-  simpl map in H0. rewrite (freg_of_eq _ _ EQ) in H0. rewrite (freg_of_eq _ _ EQ1) in H0.
-  remember (rs x) as v1; remember (rs x0) as v2. simpl in H0. FuncInv.
-  exists (nextinstr (compare_floats (Vfloat (swap_floats c0 f f0)) (Vfloat (swap_floats c0 f0 f)) rs)).
+  simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1).
+  exists (nextinstr (compare_floats (swap_floats c0 (rs x) (rs x0)) (swap_floats c0 (rs x0) (rs x)) rs)).
   split. apply exec_straight_one. 
-  destruct c0; unfold floatcomp, exec_instr, swap_floats; congruence.
-  auto.
-  split. subst b. apply testcond_for_float_comparison_correct. 
-  intros. unfold compare_floats. repeat SOther.
+  destruct c0; simpl; auto.
+  unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats_inv; auto with ppcgen. 
+  split. destruct (rs x); destruct (rs x0); simpl; auto.
+  repeat rewrite swap_floats_commut. apply testcond_for_float_comparison_correct.
+  intros. SOther. apply compare_floats_inv; auto with ppcgen. 
 (* notcompf *)
-  simpl map in H0. rewrite (freg_of_eq _ _ EQ) in H0. rewrite (freg_of_eq _ _ EQ1) in H0.
-  remember (rs x) as v1; remember (rs x0) as v2. simpl in H0. FuncInv.
-  exists (nextinstr (compare_floats (Vfloat (swap_floats c0 f f0)) (Vfloat (swap_floats c0 f0 f)) rs)).
+  simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1).
+  exists (nextinstr (compare_floats (swap_floats c0 (rs x) (rs x0)) (swap_floats c0 (rs x0) (rs x)) rs)).
   split. apply exec_straight_one. 
-  destruct c0; unfold floatcomp, exec_instr, swap_floats; congruence.
-  auto.
-  split. subst b. apply testcond_for_neg_float_comparison_correct. 
-  intros. unfold compare_floats. repeat SOther.
+  destruct c0; simpl; auto.
+  unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats_inv; auto with ppcgen. 
+  split. destruct (rs x); destruct (rs x0); simpl; auto.
+  repeat rewrite swap_floats_commut. apply testcond_for_neg_float_comparison_correct.
+  intros. SOther. apply compare_floats_inv; auto with ppcgen. 
 (* maskzero *)
-  simpl map in H0. rewrite (ireg_of_eq _ _ EQ) in H0.
+  simpl. rewrite (ireg_of_eq _ _ EQ).
   econstructor. split. apply exec_straight_one. simpl; eauto. auto.
-  split. simpl in H0. FuncInv. simpl.
-  generalize (compare_ints_spec rs (Vint (Int.and i0 i)) Vzero).
-  intros [A B]. rewrite A. subst b. simpl. destruct (Int.eq (Int.and i0 i) Int.zero); auto.
+  split. destruct (rs x); simpl; auto. 
+  generalize (compare_ints_spec rs (Vint (Int.and i0 i)) Vzero m).
+  intros [A B]. rewrite A. unfold Val.cmpu; simpl. destruct (Int.eq (Int.and i0 i) Int.zero); auto.
   intros. unfold compare_ints. repeat SOther.
 (* masknotzero *)
-  simpl map in H0. rewrite (ireg_of_eq _ _ EQ) in H0.
+  simpl. rewrite (ireg_of_eq _ _ EQ).
   econstructor. split. apply exec_straight_one. simpl; eauto. auto.
-  split. simpl in H0. FuncInv. simpl.
-  generalize (compare_ints_spec rs (Vint (Int.and i0 i)) Vzero).
-  intros [A B]. rewrite A. subst b. simpl. destruct (Int.eq (Int.and i0 i) Int.zero); auto.
+  split. destruct (rs x); simpl; auto. 
+  generalize (compare_ints_spec rs (Vint (Int.and i0 i)) Vzero m).
+  intros [A B]. rewrite A. unfold Val.cmpu; simpl. destruct (Int.eq (Int.and i0 i) Int.zero); auto.
   intros. unfold compare_ints. repeat SOther.
 Qed.
 
@@ -1344,62 +1469,83 @@ Proof.
 Qed.
 
 Lemma mk_setcc_correct:
-  forall cond rd k rs1 m b,
-  eval_extcond cond rs1 = Some b ->
+  forall cond rd k rs1 m,
   exists rs2,
   exec_straight (mk_setcc cond rd k) rs1 m k rs2 m
-  /\ rs2#rd = Val.of_bool b
+  /\ rs2#rd = Val.of_optbool(eval_extcond cond rs1)
   /\ forall r, nontemp_preg r = true -> r <> rd -> rs2#r = rs1#r.
 Proof.
   intros. destruct cond; simpl in *.
 (* base *)
   econstructor; split.
-  apply exec_straight_one. simpl; rewrite H. eauto. auto.
-  split. repeat SRes. 
-  intros. repeat SOther. 
+  apply exec_straight_one. simpl; eauto. auto. 
+  split. SRes. SRes. 
+  intros; repeat SOther.
 (* or *)
-  destruct (eval_testcond c1 rs1) as [b1|]_eqn;
-  destruct (eval_testcond c2 rs1) as [b2|]_eqn; inv H.
-  assert (D: Val.or (Val.of_bool b1) (Val.of_bool b2) = Val.of_bool (b1 || b2)).
-    destruct b1; destruct b2; auto.
+  assert (Val.of_optbool
+    match eval_testcond c1 rs1 with
+    | Some b1 =>
+        match eval_testcond c2 rs1 with
+        | Some b2 => Some (b1 || b2)
+        | None => None
+        end
+    | None => None
+    end =
+    Val.or (Val.of_optbool (eval_testcond c1 rs1)) (Val.of_optbool (eval_testcond c2 rs1))).
+  destruct (eval_testcond c1 rs1). destruct (eval_testcond c2 rs1). 
+  destruct b; destruct b0; auto.
+  destruct b; auto.
+  auto.
+  rewrite H; clear H.
   destruct (ireg_eq rd EDX).
   subst rd. econstructor; split.
   eapply exec_straight_three.
-  simpl; rewrite Heqo; eauto.
-  simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg.  rewrite Heqo0. eauto. 
-  simpl. eauto. 
+  simpl; eauto.
+  simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg. eauto.
+  simpl; eauto.
   auto. auto. auto.
   split. SRes. 
   intros. repeat SOther.
   econstructor; split.
   eapply exec_straight_three.
-  simpl; rewrite Heqo; eauto.
-  simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg.  rewrite Heqo0. eauto. 
+  simpl; eauto.
+  simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg. eauto. 
   simpl. eauto. 
   auto. auto. auto.
-  split. repeat SRes. rewrite <- D. rewrite Val.or_commut. decEq; repeat SRes. 
+  split. repeat SRes. rewrite Val.or_commut. decEq; repeat SRes. 
   intros. repeat SOther.
 (* and *)
-  destruct (eval_testcond c1 rs1) as [b1|]_eqn;
-  destruct (eval_testcond c2 rs1) as [b2|]_eqn; inv H.
-  assert (D: Val.and (Val.of_bool b1) (Val.of_bool b2) = Val.of_bool (b1 && b2)).
-    destruct b1; destruct b2; auto.
+  assert (Val.of_optbool
+    match eval_testcond c1 rs1 with
+    | Some b1 =>
+        match eval_testcond c2 rs1 with
+        | Some b2 => Some (b1 && b2)
+        | None => None
+        end
+    | None => None
+    end =
+    Val.and (Val.of_optbool (eval_testcond c1 rs1)) (Val.of_optbool (eval_testcond c2 rs1))).
+  destruct (eval_testcond c1 rs1). destruct (eval_testcond c2 rs1). 
+  destruct b; destruct b0; auto.
+  destruct b; auto.
+  auto.
+  rewrite H; clear H.
   destruct (ireg_eq rd EDX).
   subst rd. econstructor; split.
   eapply exec_straight_three.
-  simpl; rewrite Heqo; eauto.
-  simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg.  rewrite Heqo0. eauto. 
-  simpl. eauto. 
+  simpl; eauto.
+  simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg. eauto.
+  simpl; eauto.
   auto. auto. auto.
   split. SRes. 
   intros. repeat SOther.
   econstructor; split.
   eapply exec_straight_three.
-  simpl; rewrite Heqo; eauto.
-  simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg.  rewrite Heqo0. eauto. 
+  simpl; eauto.
+  simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg. eauto. 
   simpl. eauto. 
   auto. auto. auto.
-  split. repeat SRes. rewrite <- D. rewrite Val.and_commut. decEq; repeat SRes. 
+  split. repeat SRes. rewrite Val.and_commut. decEq; repeat SRes. 
   intros. repeat SOther.
 Qed.
 
@@ -1421,70 +1567,93 @@ Ltac TranslOp :=
   [ apply exec_straight_one; [ simpl; eauto | auto ] 
   | split; [ repeat SRes | intros; repeat SOther ]].
 
+
 Lemma transl_op_correct:
   forall op args res k c (rs: regset) m v,
   transl_op op args res k = OK c ->
   eval_operation ge (rs#ESP) op (map rs (map preg_of args)) m = Some v ->
   exists rs',
      exec_straight c rs m k rs' m
-  /\ rs'#(preg_of res) = v
+  /\ Val.lessdef v rs'#(preg_of res)
   /\ forall r, 
      match op with Omove => important_preg r = true /\ r <> ST0 | _ => nontemp_preg r = true end ->
      r <> preg_of res -> rs' r = rs r.
 Proof.
   intros until v; intros TR EV.
-  rewrite <- (eval_operation_weaken _ _ _ _ _ EV).
-  destruct op; simpl in TR; ArgsInv; try (TranslOp; fail).
+  assert (SAME:
+  (exists rs',
+     exec_straight c rs m k rs' m
+  /\ rs'#(preg_of res) = v
+  /\ forall r, 
+     match op with Omove => important_preg r = true /\ r <> ST0 | _ => nontemp_preg r = true end ->
+     r <> preg_of res -> rs' r = rs r) ->
+  exists rs',
+     exec_straight c rs m k rs' m
+  /\ Val.lessdef v rs'#(preg_of res)
+  /\ forall r, 
+     match op with Omove => important_preg r = true /\ r <> ST0 | _ => nontemp_preg r = true end ->
+     r <> preg_of res -> rs' r = rs r).
+  intros [rs' [A [B C]]]. subst v. exists rs'; auto. 
+
+  destruct op; simpl in TR; ArgsInv; simpl in EV; try (inv EV); try (apply SAME; TranslOp; fail).
 (* move *)
   exploit mk_mov_correct; eauto. intros [rs2 [A [B C]]]. 
-  exists rs2. split. eauto. split. simpl. auto. intros. destruct H; auto.
+  apply SAME. exists rs2. split. eauto. split. simpl. auto. intros. destruct H; auto.
 (* intconst *)
-  inv EV. destruct (Int.eq_dec i Int.zero). subst i. TranslOp. TranslOp.
+  apply SAME. destruct (Int.eq_dec i Int.zero). subst i. TranslOp. TranslOp.
 (* floatconst *)
-  inv EV. destruct (Float.eq_dec f Float.zero). subst f. TranslOp. TranslOp.
+  apply SAME. destruct (Float.eq_dec f Float.zero). subst f. TranslOp. TranslOp.
 (* cast8signed *)
-  eapply mk_intconv_correct; eauto.
+  apply SAME. eapply mk_intconv_correct; eauto.
 (* cast8unsigned *)
-  eapply mk_intconv_correct; eauto. 
+  apply SAME. eapply mk_intconv_correct; eauto. 
 (* cast16signed *)
-  eapply mk_intconv_correct; eauto.
+  apply SAME. eapply mk_intconv_correct; eauto.
 (* cast16unsigned *)
-  eapply mk_intconv_correct; eauto.
+  apply SAME. eapply mk_intconv_correct; eauto.
 (* div *)
-  eapply mk_div_correct; eauto. intros. simpl. eauto. 
+  apply SAME.
+  specialize (divs_mods_exist (rs x0) (rs x1)). rewrite H0. 
+  destruct (Val.mods (rs x0) (rs x1)) as [vr|]_eqn; intros; try contradiction.
+  eapply mk_div_correct with (dsem := Val.divs) (msem := Val.mods); eauto.
 (* divu *)
-  eapply mk_div_correct; eauto. intros. simpl. eauto. 
+  apply SAME.
+  specialize (divu_modu_exist (rs x0) (rs x1)). rewrite H0. 
+  destruct (Val.modu (rs x0) (rs x1)) as [vr|]_eqn; intros; try contradiction.
+  eapply mk_div_correct with (dsem := Val.divu) (msem := Val.modu); eauto.
 (* mod *)
-  eapply mk_mod_correct; eauto. intros. simpl. eauto. 
+  apply SAME.
+  specialize (divs_mods_exist (rs x0) (rs x1)). rewrite H0. 
+  destruct (Val.divs (rs x0) (rs x1)) as [vq|]_eqn; intros; try contradiction.
+  eapply mk_mod_correct with (dsem := Val.divs) (msem := Val.mods); eauto.
 (* modu *)
-  eapply mk_mod_correct; eauto. intros. simpl. eauto. 
+  apply SAME.
+  specialize (divu_modu_exist (rs x0) (rs x1)). rewrite H0. 
+  destruct (Val.divu (rs x0) (rs x1)) as [vq|]_eqn; intros; try contradiction.
+  eapply mk_mod_correct with (dsem := Val.divu) (msem := Val.modu); eauto.
 (* shl *)
-  eapply mk_shift_correct; eauto. 
+  apply SAME. eapply mk_shift_correct; eauto. 
 (* shr *)
-  eapply mk_shift_correct; eauto. 
+  apply SAME. eapply mk_shift_correct; eauto. 
 (* shrximm *)
-  remember (rs x0) as v1. FuncInv.
-  remember (Int.ltu i (Int.repr 31)) as L. destruct L; inv EV.
-  simpl. replace (Int.ltu i Int.iwordsize) with true. 
-  apply mk_shrximm_correct; auto.
-  unfold Int.ltu. rewrite zlt_true; auto. 
-  generalize (Int.ltu_inv _ _ (sym_equal HeqL)).
-  assert (Int.unsigned (Int.repr 31) < Int.unsigned Int.iwordsize) by (compute; auto).
-  omega. 
+  apply SAME. eapply mk_shrximm_correct; eauto.
 (* shru *)
-  eapply mk_shift_correct; eauto.
+  apply SAME. eapply mk_shift_correct; eauto.
 (* lea *)
   exploit transl_addressing_mode_correct; eauto. intros EA.
-  rewrite (eval_addressing_weaken _ _ _ _ EV). rewrite <- EA. 
-  TranslOp.
+  TranslOp. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss; auto.
+(* intoffloat *)
+  apply SAME. TranslOp. rewrite H0; auto.
+(* floatofint *)
+  apply SAME. TranslOp. rewrite H0; auto.
 (* condition *)
-  remember (eval_condition c0 rs ## (preg_of ## args) m) as ob. destruct ob; inv EV. 
-  rewrite (eval_condition_weaken _ _ _ (sym_equal Heqob)). 
   exploit transl_cond_correct; eauto. intros [rs2 [P [Q R]]].
   exploit mk_setcc_correct; eauto. intros [rs3 [S [T U]]].
   exists rs3.
   split. eapply exec_straight_trans. eexact P. eexact S.
-  split. auto.
+  split. rewrite T. destruct (eval_condition c0 rs ## (preg_of ## args) m).
+  rewrite Q. auto.
+  simpl; auto.
   intros. transitivity (rs2 r); auto.
 Qed.
 
@@ -1502,9 +1671,10 @@ Lemma transl_load_correct:
 Proof.
   unfold transl_load; intros. monadInv H. 
   exploit transl_addressing_mode_correct; eauto. intro EA.
+  assert (EA': eval_addrmode ge x rs = a). destruct a; simpl in H1; try discriminate; inv EA; auto.
   set (rs2 := nextinstr_nf (rs#(preg_of dest) <- v)).
   assert (exec_load ge chunk m x rs (preg_of dest) = Next rs2 m).
-    unfold exec_load. rewrite EA. rewrite H1. auto.
+    unfold exec_load. rewrite EA'. rewrite H1. auto.
   assert (rs2 PC = Val.add (rs PC) Vone).
     transitivity (Val.add ((rs#(preg_of dest) <- v) PC) Vone).
     auto. decEq. apply Pregmap.gso; auto with ppcgen.
@@ -1524,8 +1694,9 @@ Lemma transl_store_correct:
   /\ forall r, nontemp_preg r = true -> rs'#r = rs#r.
 Proof.
   unfold transl_store; intros. monadInv H. 
-  exploit transl_addressing_mode_correct; eauto. intro EA. rewrite <- EA in H1.
-  destruct chunk; ArgsInv.
+  exploit transl_addressing_mode_correct; eauto. intro EA.
+  assert (EA': eval_addrmode ge x rs = a). destruct a; simpl in H1; try discriminate; inv EA; auto.
+  rewrite <- EA' in H1. destruct chunk; ArgsInv.
 (* int8signed *)
   eapply mk_smallstore_correct; eauto.
   intros. simpl. unfold exec_store.
diff --git a/ia32/ConstpropOp.v b/ia32/ConstpropOp.v
index 815ba0e..3d07a4d 100644
--- a/ia32/ConstpropOp.v
+++ b/ia32/ConstpropOp.v
@@ -32,9 +32,10 @@ Inductive approx : Type :=
                              no compile-time information is available. *)
   | I: int -> approx     (** A known integer value. *)
   | F: float -> approx   (** A known floating-point value. *)
-  | S: ident -> int -> approx.
+  | G: ident -> int -> approx
                          (** The value is the address of the given global
                              symbol plus the given integer offset. *)
+  | S: int -> approx.    (** The value is the stack pointer plus the offset. *)
 
 (** We now define the abstract interpretations of conditions and operators
   over this set of approximations.  For instance, the abstract interpretation
@@ -44,11 +45,12 @@ Inductive approx : Type :=
 
   The static approximations are defined by large pattern-matchings over
   the approximations of the results.  We write these matchings in the
-  indirect style described in file [Cmconstr] to avoid excessive
+  indirect style described in file [SelectOp] to avoid excessive
   duplication of cases in proofs. *)
 
-(*
-Definition eval_static_condition (cond: condition) (vl: list approx) :=
+(** Original definition:
+<<
+Nondetfunction eval_static_condition (cond: condition) (vl: list approx) :=
   match cond, vl with
   | Ccomp c, I n1 :: I n2 :: nil => Some(Int.cmp c n1 n2)
   | Ccompu c, I n1 :: I n2 :: nil => Some(Int.cmpu c n1 n2)
@@ -57,198 +59,175 @@ Definition eval_static_condition (cond: condition) (vl: list approx) :=
   | Ccompf c, F n1 :: F n2 :: nil => Some(Float.cmp c n1 n2)
   | Cnotcompf c, F n1 :: F n2 :: nil => Some(negb(Float.cmp c n1 n2))
   | Cmaskzero n, I n1 :: nil => Some(Int.eq (Int.and n1 n) Int.zero)
-  | Cmasknotzero n, n1::nil => Some(negb(Int.eq (Int.and n1 n) Int.zero))
+  | Cmasknotzero n, I n1::nil => Some(negb(Int.eq (Int.and n1 n) Int.zero))
   | _, _ => None
   end.
+>>
 *)
 
 Inductive eval_static_condition_cases: forall (cond: condition) (vl: list approx), Type :=
-  | eval_static_condition_case1:
-      forall c n1 n2,
-      eval_static_condition_cases (Ccomp c) (I n1 :: I n2 :: nil)
-  | eval_static_condition_case2:
-      forall c n1 n2,
-      eval_static_condition_cases (Ccompu c) (I n1 :: I n2 :: nil)
-  | eval_static_condition_case3:
-      forall c n n1,
-      eval_static_condition_cases (Ccompimm c n) (I n1 :: nil)
-  | eval_static_condition_case4:
-      forall c n n1,
-      eval_static_condition_cases (Ccompuimm c n) (I n1 :: nil)
-  | eval_static_condition_case5:
-      forall c n1 n2,
-      eval_static_condition_cases (Ccompf c) (F n1 :: F n2 :: nil)
-  | eval_static_condition_case6:
-      forall c n1 n2,
-      eval_static_condition_cases (Cnotcompf c) (F n1 :: F n2 :: nil)
-  | eval_static_condition_case7:
-      forall n n1,
-      eval_static_condition_cases (Cmaskzero n) (I n1 :: nil)
-  | eval_static_condition_case8:
-      forall n n1,
-      eval_static_condition_cases (Cmasknotzero n) (I n1 :: nil)
-  | eval_static_condition_default:
-      forall (cond: condition) (vl: list approx),
-      eval_static_condition_cases cond vl.
+  | eval_static_condition_case1: forall c n1 n2, eval_static_condition_cases (Ccomp c) (I n1 :: I n2 :: nil)
+  | eval_static_condition_case2: forall c n1 n2, eval_static_condition_cases (Ccompu c) (I n1 :: I n2 :: nil)
+  | eval_static_condition_case3: forall c n n1, eval_static_condition_cases (Ccompimm c n) (I n1 :: nil)
+  | eval_static_condition_case4: forall c n n1, eval_static_condition_cases (Ccompuimm c n) (I n1 :: nil)
+  | eval_static_condition_case5: forall c n1 n2, eval_static_condition_cases (Ccompf c) (F n1 :: F n2 :: nil)
+  | eval_static_condition_case6: forall c n1 n2, eval_static_condition_cases (Cnotcompf c) (F n1 :: F n2 :: nil)
+  | eval_static_condition_case7: forall n n1, eval_static_condition_cases (Cmaskzero n) (I n1 :: nil)
+  | eval_static_condition_case8: forall n n1, eval_static_condition_cases (Cmasknotzero n) (I n1::nil)
+  | eval_static_condition_default: forall (cond: condition) (vl: list approx), eval_static_condition_cases cond vl.
 
 Definition eval_static_condition_match (cond: condition) (vl: list approx) :=
-  match cond as z1, vl as z2 return eval_static_condition_cases z1 z2 with
-  | Ccomp c, I n1 :: I n2 :: nil =>
-      eval_static_condition_case1 c n1 n2
-  | Ccompu c, I n1 :: I n2 :: nil =>
-      eval_static_condition_case2 c n1 n2
-  | Ccompimm c n, I n1 :: nil =>
-      eval_static_condition_case3 c n n1
-  | Ccompuimm c n, I n1 :: nil =>
-      eval_static_condition_case4 c n n1
-  | Ccompf c, F n1 :: F n2 :: nil =>
-      eval_static_condition_case5 c n1 n2
-  | Cnotcompf c, F n1 :: F n2 :: nil =>
-      eval_static_condition_case6 c n1 n2
-  | Cmaskzero n, I n1 :: nil =>
-      eval_static_condition_case7 n n1
-  | Cmasknotzero n, I n1 :: nil =>
-      eval_static_condition_case8 n n1
-  | cond, vl =>
-      eval_static_condition_default cond vl
+  match cond as zz1, vl as zz2 return eval_static_condition_cases zz1 zz2 with
+  | Ccomp c, I n1 :: I n2 :: nil => eval_static_condition_case1 c n1 n2
+  | Ccompu c, I n1 :: I n2 :: nil => eval_static_condition_case2 c n1 n2
+  | Ccompimm c n, I n1 :: nil => eval_static_condition_case3 c n n1
+  | Ccompuimm c n, I n1 :: nil => eval_static_condition_case4 c n n1
+  | Ccompf c, F n1 :: F n2 :: nil => eval_static_condition_case5 c n1 n2
+  | Cnotcompf c, F n1 :: F n2 :: nil => eval_static_condition_case6 c n1 n2
+  | Cmaskzero n, I n1 :: nil => eval_static_condition_case7 n n1
+  | Cmasknotzero n, I n1::nil => eval_static_condition_case8 n n1
+  | cond, vl => eval_static_condition_default cond vl
   end.
 
 Definition eval_static_condition (cond: condition) (vl: list approx) :=
   match eval_static_condition_match cond vl with
-  | eval_static_condition_case1 c n1 n2 =>
+  | eval_static_condition_case1 c n1 n2 => (* Ccomp c, I n1 :: I n2 :: nil *) 
       Some(Int.cmp c n1 n2)
-  | eval_static_condition_case2 c n1 n2 =>
+  | eval_static_condition_case2 c n1 n2 => (* Ccompu c, I n1 :: I n2 :: nil *) 
       Some(Int.cmpu c n1 n2)
-  | eval_static_condition_case3 c n n1 =>
+  | eval_static_condition_case3 c n n1 => (* Ccompimm c n, I n1 :: nil *) 
       Some(Int.cmp c n1 n)
-  | eval_static_condition_case4 c n n1 =>
+  | eval_static_condition_case4 c n n1 => (* Ccompuimm c n, I n1 :: nil *) 
       Some(Int.cmpu c n1 n)
-  | eval_static_condition_case5 c n1 n2 =>
+  | eval_static_condition_case5 c n1 n2 => (* Ccompf c, F n1 :: F n2 :: nil *) 
       Some(Float.cmp c n1 n2)
-  | eval_static_condition_case6 c n1 n2 =>
+  | eval_static_condition_case6 c n1 n2 => (* Cnotcompf c, F n1 :: F n2 :: nil *) 
       Some(negb(Float.cmp c n1 n2))
-  | eval_static_condition_case7 n n1 =>
+  | eval_static_condition_case7 n n1 => (* Cmaskzero n, I n1 :: nil *) 
       Some(Int.eq (Int.and n1 n) Int.zero)
-  | eval_static_condition_case8 n n1 =>
+  | eval_static_condition_case8 n n1 => (* Cmasknotzero n, I n1::nil *) 
       Some(negb(Int.eq (Int.and n1 n) Int.zero))
   | eval_static_condition_default cond vl =>
       None
   end.
 
-(*
-Definition eval_static_addressing (addr: addressing) (vl: list approx) :=
-  match op, vl with
+
+Definition eval_static_condition_val (cond: condition) (vl: list approx) :=
+  match eval_static_condition cond vl with
+  | None => Unknown
+  | Some b => I(if b then Int.one else Int.zero)
+  end.
+
+Definition eval_static_intoffloat (f: float) :=
+  match Float.intoffloat f with Some x => I x | None => Unknown end.
+
+(** Original definition:
+<<
+Nondetfunction eval_static_addressing (addr: addressing) (vl: list approx) :=
+  match addr, vl with
   | Aindexed n, I n1::nil => I (Int.add n1 n)
-  | Aindexed n, S id ofs::nil => S id (Int.add ofs n)
+  | Aindexed n, G id ofs::nil => G id (Int.add ofs n)
+  | Aindexed n, S ofs::nil => S (Int.add ofs n)
   | Aindexed2 n, I n1::I n2::nil => I (Int.add (Int.add n1 n2) n)
-  | Aindexed2 n, S id ofs::I n2::nil => S id (Int.add (Int.add ofs n2) n)
-  | Aindexed2 n, I n1::S id ofs::nil => S id (Int.add (Int.add ofs n1) n)
+  | Aindexed2 n, G id ofs::I n2::nil => G id (Int.add (Int.add ofs n2) n)
+  | Aindexed2 n, I n1::G id ofs::nil => G id (Int.add (Int.add ofs n1) n)
+  | Aindexed2 n, S ofs::I n2::nil => S (Int.add (Int.add ofs n2) n)
+  | Aindexed2 n, I n1::S ofs::nil => S (Int.add (Int.add ofs n1) n)
   | Ascaled sc n, I n1::nil => I (Int.add (Int.mul n1 sc) n)
   | Aindexed2scaled sc n, I n1::I n2::nil => I (Int.add n1 (Int.add (Int.mul n2 sc) n))
-  | Aindexed2scaled sc n, S id ofs::I n2::nil => S id (Int.add ofs (Int.add (Int.mul n2 sc) n))
-  | Aglobal id ofs, nil => S id ofs
-  | Abased id ofs, I n1::nil => S id (Int.add ofs n1)
-  | Abasedscaled sc id ofs, I n1::nil => S id (Int.add ofs (Int.mul sc n1))
+  | Aindexed2scaled sc n, G id ofs::I n2::nil => G id (Int.add ofs (Int.add (Int.mul n2 sc) n))
+  | Aindexed2scaled sc n, S ofs::I n2::nil => S (Int.add ofs (Int.add (Int.mul n2 sc) n))
+  | Aglobal id ofs, nil => G id ofs
+  | Abased id ofs, I n1::nil => G id (Int.add ofs n1)
+  | Abasedscaled sc id ofs, I n1::nil => G id (Int.add ofs (Int.mul sc n1))
+  | Ainstack ofs, nil => S ofs
   | _, _ => Unknown
   end.
+>>
 *)
 
 Inductive eval_static_addressing_cases: forall (addr: addressing) (vl: list approx), Type :=
-  | eval_static_addressing_case1:
-      forall n n1,
-      eval_static_addressing_cases (Aindexed n) (I n1::nil)
-  | eval_static_addressing_case2:
-      forall n id ofs,
-      eval_static_addressing_cases (Aindexed n) (S id ofs::nil)
-  | eval_static_addressing_case3:
-      forall n n1 n2,
-      eval_static_addressing_cases (Aindexed2 n) (I n1::I n2::nil)
-  | eval_static_addressing_case4:
-      forall n id ofs n2,
-      eval_static_addressing_cases (Aindexed2 n) (S id ofs::I n2::nil)
-  | eval_static_addressing_case5:
-      forall n n1 id ofs,
-      eval_static_addressing_cases (Aindexed2 n) (I n1::S id ofs::nil)
-  | eval_static_addressing_case6:
-      forall sc n n1,
-      eval_static_addressing_cases (Ascaled sc n) (I n1::nil)
-  | eval_static_addressing_case7:
-      forall sc n n1 n2,
-      eval_static_addressing_cases (Aindexed2scaled sc n) (I n1::I n2::nil)
-  | eval_static_addressing_case8:
-      forall sc n id ofs n2,
-      eval_static_addressing_cases (Aindexed2scaled sc n) (S id ofs::I n2::nil)
-  | eval_static_addressing_case9:
-      forall id ofs,
-      eval_static_addressing_cases (Aglobal id ofs) (nil)
-  | eval_static_addressing_case10:
-      forall id ofs n1,
-      eval_static_addressing_cases (Abased id ofs) (I n1::nil)
-  | eval_static_addressing_case11:
-      forall sc id ofs n1,
-      eval_static_addressing_cases (Abasedscaled sc id ofs) (I n1::nil)
-  | eval_static_addressing_default:
-      forall (addr: addressing) (vl: list approx),
-      eval_static_addressing_cases addr vl.
+  | eval_static_addressing_case1: forall n n1, eval_static_addressing_cases (Aindexed n) (I n1::nil)
+  | eval_static_addressing_case2: forall n id ofs, eval_static_addressing_cases (Aindexed n) (G id ofs::nil)
+  | eval_static_addressing_case3: forall n ofs, eval_static_addressing_cases (Aindexed n) (S ofs::nil)
+  | eval_static_addressing_case4: forall n n1 n2, eval_static_addressing_cases (Aindexed2 n) (I n1::I n2::nil)
+  | eval_static_addressing_case5: forall n id ofs n2, eval_static_addressing_cases (Aindexed2 n) (G id ofs::I n2::nil)
+  | eval_static_addressing_case6: forall n n1 id ofs, eval_static_addressing_cases (Aindexed2 n) (I n1::G id ofs::nil)
+  | eval_static_addressing_case7: forall n ofs n2, eval_static_addressing_cases (Aindexed2 n) (S ofs::I n2::nil)
+  | eval_static_addressing_case8: forall n n1 ofs, eval_static_addressing_cases (Aindexed2 n) (I n1::S ofs::nil)
+  | eval_static_addressing_case9: forall sc n n1, eval_static_addressing_cases (Ascaled sc n) (I n1::nil)
+  | eval_static_addressing_case10: forall sc n n1 n2, eval_static_addressing_cases (Aindexed2scaled sc n) (I n1::I n2::nil)
+  | eval_static_addressing_case11: forall sc n id ofs n2, eval_static_addressing_cases (Aindexed2scaled sc n) (G id ofs::I n2::nil)
+  | eval_static_addressing_case12: forall sc n ofs n2, eval_static_addressing_cases (Aindexed2scaled sc n) (S ofs::I n2::nil)
+  | eval_static_addressing_case13: forall id ofs, eval_static_addressing_cases (Aglobal id ofs) (nil)
+  | eval_static_addressing_case14: forall id ofs n1, eval_static_addressing_cases (Abased id ofs) (I n1::nil)
+  | eval_static_addressing_case15: forall sc id ofs n1, eval_static_addressing_cases (Abasedscaled sc id ofs) (I n1::nil)
+  | eval_static_addressing_case16: forall ofs, eval_static_addressing_cases (Ainstack ofs) (nil)
+  | eval_static_addressing_default: forall (addr: addressing) (vl: list approx), eval_static_addressing_cases addr vl.
 
 Definition eval_static_addressing_match (addr: addressing) (vl: list approx) :=
-  match addr as z1, vl as z2 return eval_static_addressing_cases z1 z2 with
-  | Aindexed n, I n1::nil =>
-      eval_static_addressing_case1 n n1
-  | Aindexed n, S id ofs::nil =>
-      eval_static_addressing_case2 n id ofs
-  | Aindexed2 n, I n1::I n2::nil =>
-      eval_static_addressing_case3 n n1 n2
-  | Aindexed2 n, S id ofs::I n2::nil =>
-      eval_static_addressing_case4 n id ofs n2
-  | Aindexed2 n, I n1::S id ofs::nil =>
-      eval_static_addressing_case5 n n1 id ofs
-  | Ascaled sc n, I n1::nil =>
-      eval_static_addressing_case6 sc n n1
-  | Aindexed2scaled sc n, I n1::I n2::nil =>
-      eval_static_addressing_case7 sc n n1 n2
-  | Aindexed2scaled sc n, S id ofs::I n2::nil =>
-      eval_static_addressing_case8 sc n id ofs n2
-  | Aglobal id ofs, nil =>
-      eval_static_addressing_case9 id ofs
-  | Abased id ofs, I n1::nil =>
-      eval_static_addressing_case10 id ofs n1
-  | Abasedscaled sc id ofs, I n1::nil =>
-      eval_static_addressing_case11 sc id ofs n1
-  | addr, vl =>
-      eval_static_addressing_default addr vl
+  match addr as zz1, vl as zz2 return eval_static_addressing_cases zz1 zz2 with
+  | Aindexed n, I n1::nil => eval_static_addressing_case1 n n1
+  | Aindexed n, G id ofs::nil => eval_static_addressing_case2 n id ofs
+  | Aindexed n, S ofs::nil => eval_static_addressing_case3 n ofs
+  | Aindexed2 n, I n1::I n2::nil => eval_static_addressing_case4 n n1 n2
+  | Aindexed2 n, G id ofs::I n2::nil => eval_static_addressing_case5 n id ofs n2
+  | Aindexed2 n, I n1::G id ofs::nil => eval_static_addressing_case6 n n1 id ofs
+  | Aindexed2 n, S ofs::I n2::nil => eval_static_addressing_case7 n ofs n2
+  | Aindexed2 n, I n1::S ofs::nil => eval_static_addressing_case8 n n1 ofs
+  | Ascaled sc n, I n1::nil => eval_static_addressing_case9 sc n n1
+  | Aindexed2scaled sc n, I n1::I n2::nil => eval_static_addressing_case10 sc n n1 n2
+  | Aindexed2scaled sc n, G id ofs::I n2::nil => eval_static_addressing_case11 sc n id ofs n2
+  | Aindexed2scaled sc n, S ofs::I n2::nil => eval_static_addressing_case12 sc n ofs n2
+  | Aglobal id ofs, nil => eval_static_addressing_case13 id ofs
+  | Abased id ofs, I n1::nil => eval_static_addressing_case14 id ofs n1
+  | Abasedscaled sc id ofs, I n1::nil => eval_static_addressing_case15 sc id ofs n1
+  | Ainstack ofs, nil => eval_static_addressing_case16 ofs
+  | addr, vl => eval_static_addressing_default addr vl
   end.
 
 Definition eval_static_addressing (addr: addressing) (vl: list approx) :=
   match eval_static_addressing_match addr vl with
-  | eval_static_addressing_case1 n n1 =>
+  | eval_static_addressing_case1 n n1 => (* Aindexed n, I n1::nil *) 
       I (Int.add n1 n)
-  | eval_static_addressing_case2 n id ofs =>
-      S id (Int.add ofs n)
-  | eval_static_addressing_case3 n n1 n2 =>
+  | eval_static_addressing_case2 n id ofs => (* Aindexed n, G id ofs::nil *) 
+      G id (Int.add ofs n)
+  | eval_static_addressing_case3 n ofs => (* Aindexed n, S ofs::nil *) 
+      S (Int.add ofs n)
+  | eval_static_addressing_case4 n n1 n2 => (* Aindexed2 n, I n1::I n2::nil *) 
       I (Int.add (Int.add n1 n2) n)
-  | eval_static_addressing_case4 n id ofs n2 =>
-      S id (Int.add (Int.add ofs n2) n)
-  | eval_static_addressing_case5 n n1 id ofs =>
-      S id (Int.add (Int.add ofs n1) n)
-  | eval_static_addressing_case6 sc n n1 =>
+  | eval_static_addressing_case5 n id ofs n2 => (* Aindexed2 n, G id ofs::I n2::nil *) 
+      G id (Int.add (Int.add ofs n2) n)
+  | eval_static_addressing_case6 n n1 id ofs => (* Aindexed2 n, I n1::G id ofs::nil *) 
+      G id (Int.add (Int.add ofs n1) n)
+  | eval_static_addressing_case7 n ofs n2 => (* Aindexed2 n, S ofs::I n2::nil *) 
+      S (Int.add (Int.add ofs n2) n)
+  | eval_static_addressing_case8 n n1 ofs => (* Aindexed2 n, I n1::S ofs::nil *) 
+      S (Int.add (Int.add ofs n1) n)
+  | eval_static_addressing_case9 sc n n1 => (* Ascaled sc n, I n1::nil *) 
       I (Int.add (Int.mul n1 sc) n)
-  | eval_static_addressing_case7 sc n n1 n2 =>
+  | eval_static_addressing_case10 sc n n1 n2 => (* Aindexed2scaled sc n, I n1::I n2::nil *) 
       I (Int.add n1 (Int.add (Int.mul n2 sc) n))
-  | eval_static_addressing_case8 sc n id ofs n2 =>
-      S id (Int.add ofs (Int.add (Int.mul n2 sc) n))
-  | eval_static_addressing_case9 id ofs =>
-      S id ofs
-  | eval_static_addressing_case10 id ofs n1 =>
-      S id (Int.add ofs n1)
-  | eval_static_addressing_case11 sc id ofs n1 =>
-      S id (Int.add ofs (Int.mul sc n1))
+  | eval_static_addressing_case11 sc n id ofs n2 => (* Aindexed2scaled sc n, G id ofs::I n2::nil *) 
+      G id (Int.add ofs (Int.add (Int.mul n2 sc) n))
+  | eval_static_addressing_case12 sc n ofs n2 => (* Aindexed2scaled sc n, S ofs::I n2::nil *) 
+      S (Int.add ofs (Int.add (Int.mul n2 sc) n))
+  | eval_static_addressing_case13 id ofs => (* Aglobal id ofs, nil *) 
+      G id ofs
+  | eval_static_addressing_case14 id ofs n1 => (* Abased id ofs, I n1::nil *) 
+      G id (Int.add ofs n1)
+  | eval_static_addressing_case15 sc id ofs n1 => (* Abasedscaled sc id ofs, I n1::nil *) 
+      G id (Int.add ofs (Int.mul sc n1))
+  | eval_static_addressing_case16 ofs => (* Ainstack ofs, nil *) 
+      S ofs
   | eval_static_addressing_default addr vl =>
       Unknown
   end.
 
-(*
-Definition eval_static_operation (op: operation) (vl: list approx) :=
+
+(** Original definition:
+<<
+Nondetfunction eval_static_operation (op: operation) (vl: list approx) :=
   match op, vl with
   | Omove, v1::nil => v1
   | Ointconst n, nil => I n
@@ -259,7 +238,7 @@ Definition eval_static_operation (op: operation) (vl: list approx) :=
   | Ocast16unsigned, I n1 :: nil => I(Int.zero_ext 16 n1)
   | Oneg, I n1 :: nil => I(Int.neg n1)
   | Osub, I n1 :: I n2 :: nil => I(Int.sub n1 n2)
-  | Osub, S s1 n1 :: I n2 :: nil => S s1 (Int.sub n1 n2)
+  | Osub, G s1 n1 :: I n2 :: nil => G s1 (Int.sub n1 n2)
   | Omul, I n1 :: I n2 :: nil => I(Int.mul n1 n2)
   | Omulimm n, I n1 :: nil => I(Int.mul n1 n)
   | Odiv, I n1 :: I n2 :: nil => if Int.eq n2 Int.zero then Unknown else I(Int.divs n1 n2)
@@ -276,7 +255,7 @@ Definition eval_static_operation (op: operation) (vl: list approx) :=
   | Oshlimm n, I n1 :: nil => if Int.ltu n Int.iwordsize then I(Int.shl n1 n) else Unknown
   | Oshr, I n1 :: I n2 :: nil => if Int.ltu n2 Int.iwordsize then I(Int.shr n1 n2) else Unknown
   | Oshrimm n, I n1 :: nil => if Int.ltu n Int.iwordsize then I(Int.shr n1 n) else Unknown
-  | Oshrximm n, I n1 :: nil => if Int.ltu n Int.iwordsize then I(Int.shrx n1 n) else Unknown
+  | Oshrximm n, I n1 :: nil => if Int.ltu n (Int.repr 31) then I(Int.shrx n1 n) else Unknown
   | Oshru, I n1 :: I n2 :: nil => if Int.ltu n2 Int.iwordsize then I(Int.shru n1 n2) else Unknown
   | Oshruimm n, I n1 :: nil => if Int.ltu n Int.iwordsize then I(Int.shru n1 n) else Unknown
   | Ororimm n, I n1 :: nil => if Int.ltu n Int.iwordsize then I(Int.ror n1 n) else Unknown
@@ -288,320 +267,193 @@ Definition eval_static_operation (op: operation) (vl: list approx) :=
   | Omulf, F n1 :: F n2 :: nil => F(Float.mul n1 n2)
   | Odivf, F n1 :: F n2 :: nil => F(Float.div n1 n2)
   | Osingleoffloat, F n1 :: nil => F(Float.singleoffloat n1)
-  | Ointoffloat, F n1 :: nil => match Float.intoffloat n1 with Some x => I x | None => Unknown end
+  | Ointoffloat, F n1 :: nil => eval_static_intoffloat n1
   | Ofloatofint, I n1 :: nil => F(Float.floatofint n1)
-  | Ocmp c, vl => match eval_static_condition c vl with None => Unknown | Some b => I(if b then Int.one else Int.zero) end
+  | Ocmp c, vl => eval_static_condition_val c vl
   | _, _ => Unknown
   end.
+>>
 *)
 
 Inductive eval_static_operation_cases: forall (op: operation) (vl: list approx), Type :=
-  | eval_static_operation_case1:
-      forall v1,
-      eval_static_operation_cases (Omove) (v1::nil)
-  | eval_static_operation_case2:
-      forall n,
-      eval_static_operation_cases (Ointconst n) (nil)
-  | eval_static_operation_case3:
-      forall n,
-      eval_static_operation_cases (Ofloatconst n) (nil)
-  | eval_static_operation_case4:
-      forall n1,
-      eval_static_operation_cases (Ocast8signed) (I n1 :: nil)
-  | eval_static_operation_case5:
-      forall n1,
-      eval_static_operation_cases (Ocast8unsigned) (I n1 :: nil)
-  | eval_static_operation_case6:
-      forall n1,
-      eval_static_operation_cases (Ocast16signed) (I n1 :: nil)
-  | eval_static_operation_case7:
-      forall n1,
-      eval_static_operation_cases (Ocast16unsigned) (I n1 :: nil)
-  | eval_static_operation_case8:
-      forall n1,
-      eval_static_operation_cases (Oneg) (I n1 :: nil)
-  | eval_static_operation_case9:
-      forall n1 n2,
-      eval_static_operation_cases (Osub) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case10:
-      forall s1 n1 n2,
-      eval_static_operation_cases (Osub) (S s1 n1 :: I n2 :: nil)
-  | eval_static_operation_case11:
-      forall n1 n2,
-      eval_static_operation_cases (Omul) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case12:
-      forall n n1,
-      eval_static_operation_cases (Omulimm n) (I n1 :: nil)
-  | eval_static_operation_case13:
-      forall n1 n2,
-      eval_static_operation_cases (Odiv) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case14:
-      forall n1 n2,
-      eval_static_operation_cases (Odivu) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case15:
-      forall n1 n2,
-      eval_static_operation_cases (Omod) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case16:
-      forall n1 n2,
-      eval_static_operation_cases (Omodu) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case17:
-      forall n1 n2,
-      eval_static_operation_cases (Oand) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case18:
-      forall n n1,
-      eval_static_operation_cases (Oandimm n) (I n1 :: nil)
-  | eval_static_operation_case19:
-      forall n1 n2,
-      eval_static_operation_cases (Oor) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case20:
-      forall n n1,
-      eval_static_operation_cases (Oorimm n) (I n1 :: nil)
-  | eval_static_operation_case21:
-      forall n1 n2,
-      eval_static_operation_cases (Oxor) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case22:
-      forall n n1,
-      eval_static_operation_cases (Oxorimm n) (I n1 :: nil)
-  | eval_static_operation_case23:
-      forall n1 n2,
-      eval_static_operation_cases (Oshl) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case24:
-      forall n n1,
-      eval_static_operation_cases (Oshlimm n) (I n1 :: nil)
-  | eval_static_operation_case25:
-      forall n1 n2,
-      eval_static_operation_cases (Oshr) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case26:
-      forall n n1,
-      eval_static_operation_cases (Oshrimm n) (I n1 :: nil)
-  | eval_static_operation_case27:
-      forall n n1,
-      eval_static_operation_cases (Oshrximm n) (I n1 :: nil)
-  | eval_static_operation_case28:
-      forall n1 n2,
-      eval_static_operation_cases (Oshru) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case29:
-      forall n n1,
-      eval_static_operation_cases (Oshruimm n) (I n1 :: nil)
-  | eval_static_operation_case30:
-      forall n n1,
-      eval_static_operation_cases (Ororimm n) (I n1 :: nil)
-  | eval_static_operation_case31:
-      forall mode vl,
-      eval_static_operation_cases (Olea mode) (vl)
-  | eval_static_operation_case32:
-      forall n1,
-      eval_static_operation_cases (Onegf) (F n1 :: nil)
-  | eval_static_operation_case33:
-      forall n1,
-      eval_static_operation_cases (Oabsf) (F n1 :: nil)
-  | eval_static_operation_case34:
-      forall n1 n2,
-      eval_static_operation_cases (Oaddf) (F n1 :: F n2 :: nil)
-  | eval_static_operation_case35:
-      forall n1 n2,
-      eval_static_operation_cases (Osubf) (F n1 :: F n2 :: nil)
-  | eval_static_operation_case36:
-      forall n1 n2,
-      eval_static_operation_cases (Omulf) (F n1 :: F n2 :: nil)
-  | eval_static_operation_case37:
-      forall n1 n2,
-      eval_static_operation_cases (Odivf) (F n1 :: F n2 :: nil)
-  | eval_static_operation_case38:
-      forall n1,
-      eval_static_operation_cases (Osingleoffloat) (F n1 :: nil)
-  | eval_static_operation_case39:
-      forall n1,
-      eval_static_operation_cases (Ointoffloat) (F n1 :: nil)
-  | eval_static_operation_case41:
-      forall n1,
-      eval_static_operation_cases (Ofloatofint) (I n1 :: nil)
-  | eval_static_operation_case43:
-      forall c vl,
-      eval_static_operation_cases (Ocmp c) vl
-  | eval_static_operation_default:
-      forall (op: operation) (vl: list approx),
-      eval_static_operation_cases op vl.
+  | eval_static_operation_case1: forall v1, eval_static_operation_cases (Omove) (v1::nil)
+  | eval_static_operation_case2: forall n, eval_static_operation_cases (Ointconst n) (nil)
+  | eval_static_operation_case3: forall n, eval_static_operation_cases (Ofloatconst n) (nil)
+  | eval_static_operation_case4: forall n1, eval_static_operation_cases (Ocast8signed) (I n1 :: nil)
+  | eval_static_operation_case5: forall n1, eval_static_operation_cases (Ocast8unsigned) (I n1 :: nil)
+  | eval_static_operation_case6: forall n1, eval_static_operation_cases (Ocast16signed) (I n1 :: nil)
+  | eval_static_operation_case7: forall n1, eval_static_operation_cases (Ocast16unsigned) (I n1 :: nil)
+  | eval_static_operation_case8: forall n1, eval_static_operation_cases (Oneg) (I n1 :: nil)
+  | eval_static_operation_case9: forall n1 n2, eval_static_operation_cases (Osub) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case10: forall s1 n1 n2, eval_static_operation_cases (Osub) (G s1 n1 :: I n2 :: nil)
+  | eval_static_operation_case11: forall n1 n2, eval_static_operation_cases (Omul) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case12: forall n n1, eval_static_operation_cases (Omulimm n) (I n1 :: nil)
+  | eval_static_operation_case13: forall n1 n2, eval_static_operation_cases (Odiv) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case14: forall n1 n2, eval_static_operation_cases (Odivu) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case15: forall n1 n2, eval_static_operation_cases (Omod) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case16: forall n1 n2, eval_static_operation_cases (Omodu) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case17: forall n1 n2, eval_static_operation_cases (Oand) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case18: forall n n1, eval_static_operation_cases (Oandimm n) (I n1 :: nil)
+  | eval_static_operation_case19: forall n1 n2, eval_static_operation_cases (Oor) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case20: forall n n1, eval_static_operation_cases (Oorimm n) (I n1 :: nil)
+  | eval_static_operation_case21: forall n1 n2, eval_static_operation_cases (Oxor) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case22: forall n n1, eval_static_operation_cases (Oxorimm n) (I n1 :: nil)
+  | eval_static_operation_case23: forall n1 n2, eval_static_operation_cases (Oshl) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case24: forall n n1, eval_static_operation_cases (Oshlimm n) (I n1 :: nil)
+  | eval_static_operation_case25: forall n1 n2, eval_static_operation_cases (Oshr) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case26: forall n n1, eval_static_operation_cases (Oshrimm n) (I n1 :: nil)
+  | eval_static_operation_case27: forall n n1, eval_static_operation_cases (Oshrximm n) (I n1 :: nil)
+  | eval_static_operation_case28: forall n1 n2, eval_static_operation_cases (Oshru) (I n1 :: I n2 :: nil)
+  | eval_static_operation_case29: forall n n1, eval_static_operation_cases (Oshruimm n) (I n1 :: nil)
+  | eval_static_operation_case30: forall n n1, eval_static_operation_cases (Ororimm n) (I n1 :: nil)
+  | eval_static_operation_case31: forall mode vl, eval_static_operation_cases (Olea mode) (vl)
+  | eval_static_operation_case32: forall n1, eval_static_operation_cases (Onegf) (F n1 :: nil)
+  | eval_static_operation_case33: forall n1, eval_static_operation_cases (Oabsf) (F n1 :: nil)
+  | eval_static_operation_case34: forall n1 n2, eval_static_operation_cases (Oaddf) (F n1 :: F n2 :: nil)
+  | eval_static_operation_case35: forall n1 n2, eval_static_operation_cases (Osubf) (F n1 :: F n2 :: nil)
+  | eval_static_operation_case36: forall n1 n2, eval_static_operation_cases (Omulf) (F n1 :: F n2 :: nil)
+  | eval_static_operation_case37: forall n1 n2, eval_static_operation_cases (Odivf) (F n1 :: F n2 :: nil)
+  | eval_static_operation_case38: forall n1, eval_static_operation_cases (Osingleoffloat) (F n1 :: nil)
+  | eval_static_operation_case39: forall n1, eval_static_operation_cases (Ointoffloat) (F n1 :: nil)
+  | eval_static_operation_case40: forall n1, eval_static_operation_cases (Ofloatofint) (I n1 :: nil)
+  | eval_static_operation_case41: forall c vl, eval_static_operation_cases (Ocmp c) (vl)
+  | eval_static_operation_default: forall (op: operation) (vl: list approx), eval_static_operation_cases op vl.
 
 Definition eval_static_operation_match (op: operation) (vl: list approx) :=
-  match op as z1, vl as z2 return eval_static_operation_cases z1 z2 with
-  | Omove, v1::nil =>
-      eval_static_operation_case1 v1
-  | Ointconst n, nil =>
-      eval_static_operation_case2 n
-  | Ofloatconst n, nil =>
-      eval_static_operation_case3 n
-  | Ocast8signed, I n1 :: nil =>
-      eval_static_operation_case4 n1
-  | Ocast8unsigned, I n1 :: nil =>
-      eval_static_operation_case5 n1
-  | Ocast16signed, I n1 :: nil =>
-      eval_static_operation_case6 n1
-  | Ocast16unsigned, I n1 :: nil =>
-      eval_static_operation_case7 n1
-  | Oneg, I n1 :: nil =>
-      eval_static_operation_case8 n1
-  | Osub, I n1 :: I n2 :: nil =>
-      eval_static_operation_case9 n1 n2
-  | Osub, S s1 n1 :: I n2 :: nil =>
-      eval_static_operation_case10 s1 n1 n2
-  | Omul, I n1 :: I n2 :: nil =>
-      eval_static_operation_case11 n1 n2
-  | Omulimm n, I n1 :: nil =>
-      eval_static_operation_case12 n n1
-  | Odiv, I n1 :: I n2 :: nil =>
-      eval_static_operation_case13 n1 n2
-  | Odivu, I n1 :: I n2 :: nil =>
-      eval_static_operation_case14 n1 n2
-  | Omod, I n1 :: I n2 :: nil =>
-      eval_static_operation_case15 n1 n2
-  | Omodu, I n1 :: I n2 :: nil =>
-      eval_static_operation_case16 n1 n2
-  | Oand, I n1 :: I n2 :: nil =>
-      eval_static_operation_case17 n1 n2
-  | Oandimm n, I n1 :: nil =>
-      eval_static_operation_case18 n n1
-  | Oor, I n1 :: I n2 :: nil =>
-      eval_static_operation_case19 n1 n2
-  | Oorimm n, I n1 :: nil =>
-      eval_static_operation_case20 n n1
-  | Oxor, I n1 :: I n2 :: nil =>
-      eval_static_operation_case21 n1 n2
-  | Oxorimm n, I n1 :: nil =>
-      eval_static_operation_case22 n n1
-  | Oshl, I n1 :: I n2 :: nil =>
-      eval_static_operation_case23 n1 n2
-  | Oshlimm n, I n1 :: nil =>
-      eval_static_operation_case24 n n1
-  | Oshr, I n1 :: I n2 :: nil =>
-      eval_static_operation_case25 n1 n2
-  | Oshrimm n, I n1 :: nil =>
-      eval_static_operation_case26 n n1
-  | Oshrximm n, I n1 :: nil =>
-      eval_static_operation_case27 n n1
-  | Oshru, I n1 :: I n2 :: nil =>
-      eval_static_operation_case28 n1 n2
-  | Oshruimm n, I n1 :: nil =>
-      eval_static_operation_case29 n n1
-  | Ororimm n, I n1 :: nil =>
-      eval_static_operation_case30 n n1
-  | Olea mode, vl =>
-      eval_static_operation_case31 mode vl
-  | Onegf, F n1 :: nil =>
-      eval_static_operation_case32 n1
-  | Oabsf, F n1 :: nil =>
-      eval_static_operation_case33 n1
-  | Oaddf, F n1 :: F n2 :: nil =>
-      eval_static_operation_case34 n1 n2
-  | Osubf, F n1 :: F n2 :: nil =>
-      eval_static_operation_case35 n1 n2
-  | Omulf, F n1 :: F n2 :: nil =>
-      eval_static_operation_case36 n1 n2
-  | Odivf, F n1 :: F n2 :: nil =>
-      eval_static_operation_case37 n1 n2
-  | Osingleoffloat, F n1 :: nil =>
-      eval_static_operation_case38 n1
-  | Ointoffloat, F n1 :: nil =>
-      eval_static_operation_case39 n1
-  | Ofloatofint, I n1 :: nil =>
-      eval_static_operation_case41 n1
-  | Ocmp c, vl =>
-      eval_static_operation_case43 c vl
-  | op, vl =>
-      eval_static_operation_default op vl
+  match op as zz1, vl as zz2 return eval_static_operation_cases zz1 zz2 with
+  | Omove, v1::nil => eval_static_operation_case1 v1
+  | Ointconst n, nil => eval_static_operation_case2 n
+  | Ofloatconst n, nil => eval_static_operation_case3 n
+  | Ocast8signed, I n1 :: nil => eval_static_operation_case4 n1
+  | Ocast8unsigned, I n1 :: nil => eval_static_operation_case5 n1
+  | Ocast16signed, I n1 :: nil => eval_static_operation_case6 n1
+  | Ocast16unsigned, I n1 :: nil => eval_static_operation_case7 n1
+  | Oneg, I n1 :: nil => eval_static_operation_case8 n1
+  | Osub, I n1 :: I n2 :: nil => eval_static_operation_case9 n1 n2
+  | Osub, G s1 n1 :: I n2 :: nil => eval_static_operation_case10 s1 n1 n2
+  | Omul, I n1 :: I n2 :: nil => eval_static_operation_case11 n1 n2
+  | Omulimm n, I n1 :: nil => eval_static_operation_case12 n n1
+  | Odiv, I n1 :: I n2 :: nil => eval_static_operation_case13 n1 n2
+  | Odivu, I n1 :: I n2 :: nil => eval_static_operation_case14 n1 n2
+  | Omod, I n1 :: I n2 :: nil => eval_static_operation_case15 n1 n2
+  | Omodu, I n1 :: I n2 :: nil => eval_static_operation_case16 n1 n2
+  | Oand, I n1 :: I n2 :: nil => eval_static_operation_case17 n1 n2
+  | Oandimm n, I n1 :: nil => eval_static_operation_case18 n n1
+  | Oor, I n1 :: I n2 :: nil => eval_static_operation_case19 n1 n2
+  | Oorimm n, I n1 :: nil => eval_static_operation_case20 n n1
+  | Oxor, I n1 :: I n2 :: nil => eval_static_operation_case21 n1 n2
+  | Oxorimm n, I n1 :: nil => eval_static_operation_case22 n n1
+  | Oshl, I n1 :: I n2 :: nil => eval_static_operation_case23 n1 n2
+  | Oshlimm n, I n1 :: nil => eval_static_operation_case24 n n1
+  | Oshr, I n1 :: I n2 :: nil => eval_static_operation_case25 n1 n2
+  | Oshrimm n, I n1 :: nil => eval_static_operation_case26 n n1
+  | Oshrximm n, I n1 :: nil => eval_static_operation_case27 n n1
+  | Oshru, I n1 :: I n2 :: nil => eval_static_operation_case28 n1 n2
+  | Oshruimm n, I n1 :: nil => eval_static_operation_case29 n n1
+  | Ororimm n, I n1 :: nil => eval_static_operation_case30 n n1
+  | Olea mode, vl => eval_static_operation_case31 mode vl
+  | Onegf, F n1 :: nil => eval_static_operation_case32 n1
+  | Oabsf, F n1 :: nil => eval_static_operation_case33 n1
+  | Oaddf, F n1 :: F n2 :: nil => eval_static_operation_case34 n1 n2
+  | Osubf, F n1 :: F n2 :: nil => eval_static_operation_case35 n1 n2
+  | Omulf, F n1 :: F n2 :: nil => eval_static_operation_case36 n1 n2
+  | Odivf, F n1 :: F n2 :: nil => eval_static_operation_case37 n1 n2
+  | Osingleoffloat, F n1 :: nil => eval_static_operation_case38 n1
+  | Ointoffloat, F n1 :: nil => eval_static_operation_case39 n1
+  | Ofloatofint, I n1 :: nil => eval_static_operation_case40 n1
+  | Ocmp c, vl => eval_static_operation_case41 c vl
+  | op, vl => eval_static_operation_default op vl
   end.
 
 Definition eval_static_operation (op: operation) (vl: list approx) :=
   match eval_static_operation_match op vl with
-  | eval_static_operation_case1 v1 =>
+  | eval_static_operation_case1 v1 => (* Omove, v1::nil *) 
       v1
-  | eval_static_operation_case2 n =>
+  | eval_static_operation_case2 n => (* Ointconst n, nil *) 
       I n
-  | eval_static_operation_case3 n =>
+  | eval_static_operation_case3 n => (* Ofloatconst n, nil *) 
       F n
-  | eval_static_operation_case4 n1 =>
+  | eval_static_operation_case4 n1 => (* Ocast8signed, I n1 :: nil *) 
       I(Int.sign_ext 8 n1)
-  | eval_static_operation_case5 n1 =>
+  | eval_static_operation_case5 n1 => (* Ocast8unsigned, I n1 :: nil *) 
       I(Int.zero_ext 8 n1)
-  | eval_static_operation_case6 n1 =>
+  | eval_static_operation_case6 n1 => (* Ocast16signed, I n1 :: nil *) 
       I(Int.sign_ext 16 n1)
-  | eval_static_operation_case7 n1 =>
+  | eval_static_operation_case7 n1 => (* Ocast16unsigned, I n1 :: nil *) 
       I(Int.zero_ext 16 n1)
-  | eval_static_operation_case8 n1 =>
+  | eval_static_operation_case8 n1 => (* Oneg, I n1 :: nil *) 
       I(Int.neg n1)
-  | eval_static_operation_case9 n1 n2 =>
+  | eval_static_operation_case9 n1 n2 => (* Osub, I n1 :: I n2 :: nil *) 
       I(Int.sub n1 n2)
-  | eval_static_operation_case10 s1 n1 n2 =>
-      S s1 (Int.sub n1 n2)
-  | eval_static_operation_case11 n1 n2 =>
+  | eval_static_operation_case10 s1 n1 n2 => (* Osub, G s1 n1 :: I n2 :: nil *) 
+      G s1 (Int.sub n1 n2)
+  | eval_static_operation_case11 n1 n2 => (* Omul, I n1 :: I n2 :: nil *) 
       I(Int.mul n1 n2)
-  | eval_static_operation_case12 n n1 =>
+  | eval_static_operation_case12 n n1 => (* Omulimm n, I n1 :: nil *) 
       I(Int.mul n1 n)
-  | eval_static_operation_case13 n1 n2 =>
+  | eval_static_operation_case13 n1 n2 => (* Odiv, I n1 :: I n2 :: nil *) 
       if Int.eq n2 Int.zero then Unknown else I(Int.divs n1 n2)
-  | eval_static_operation_case14 n1 n2 =>
+  | eval_static_operation_case14 n1 n2 => (* Odivu, I n1 :: I n2 :: nil *) 
       if Int.eq n2 Int.zero then Unknown else I(Int.divu n1 n2)
-  | eval_static_operation_case15 n1 n2 =>
+  | eval_static_operation_case15 n1 n2 => (* Omod, I n1 :: I n2 :: nil *) 
       if Int.eq n2 Int.zero then Unknown else I(Int.mods n1 n2)
-  | eval_static_operation_case16 n1 n2 =>
+  | eval_static_operation_case16 n1 n2 => (* Omodu, I n1 :: I n2 :: nil *) 
       if Int.eq n2 Int.zero then Unknown else I(Int.modu n1 n2)
-  | eval_static_operation_case17 n1 n2 =>
+  | eval_static_operation_case17 n1 n2 => (* Oand, I n1 :: I n2 :: nil *) 
       I(Int.and n1 n2)
-  | eval_static_operation_case18 n n1 =>
+  | eval_static_operation_case18 n n1 => (* Oandimm n, I n1 :: nil *) 
       I(Int.and n1 n)
-  | eval_static_operation_case19 n1 n2 =>
+  | eval_static_operation_case19 n1 n2 => (* Oor, I n1 :: I n2 :: nil *) 
       I(Int.or n1 n2)
-  | eval_static_operation_case20 n n1 =>
+  | eval_static_operation_case20 n n1 => (* Oorimm n, I n1 :: nil *) 
       I(Int.or n1 n)
-  | eval_static_operation_case21 n1 n2 =>
+  | eval_static_operation_case21 n1 n2 => (* Oxor, I n1 :: I n2 :: nil *) 
       I(Int.xor n1 n2)
-  | eval_static_operation_case22 n n1 =>
+  | eval_static_operation_case22 n n1 => (* Oxorimm n, I n1 :: nil *) 
       I(Int.xor n1 n)
-  | eval_static_operation_case23 n1 n2 =>
+  | eval_static_operation_case23 n1 n2 => (* Oshl, I n1 :: I n2 :: nil *) 
       if Int.ltu n2 Int.iwordsize then I(Int.shl n1 n2) else Unknown
-  | eval_static_operation_case24 n n1 =>
+  | eval_static_operation_case24 n n1 => (* Oshlimm n, I n1 :: nil *) 
       if Int.ltu n Int.iwordsize then I(Int.shl n1 n) else Unknown
-  | eval_static_operation_case25 n1 n2 =>
+  | eval_static_operation_case25 n1 n2 => (* Oshr, I n1 :: I n2 :: nil *) 
       if Int.ltu n2 Int.iwordsize then I(Int.shr n1 n2) else Unknown
-  | eval_static_operation_case26 n n1 =>
+  | eval_static_operation_case26 n n1 => (* Oshrimm n, I n1 :: nil *) 
       if Int.ltu n Int.iwordsize then I(Int.shr n1 n) else Unknown
-  | eval_static_operation_case27 n n1 =>
+  | eval_static_operation_case27 n n1 => (* Oshrximm n, I n1 :: nil *) 
       if Int.ltu n (Int.repr 31) then I(Int.shrx n1 n) else Unknown
-  | eval_static_operation_case28 n1 n2 =>
+  | eval_static_operation_case28 n1 n2 => (* Oshru, I n1 :: I n2 :: nil *) 
       if Int.ltu n2 Int.iwordsize then I(Int.shru n1 n2) else Unknown
-  | eval_static_operation_case29 n n1 =>
+  | eval_static_operation_case29 n n1 => (* Oshruimm n, I n1 :: nil *) 
       if Int.ltu n Int.iwordsize then I(Int.shru n1 n) else Unknown
-  | eval_static_operation_case30 n n1 =>
+  | eval_static_operation_case30 n n1 => (* Ororimm n, I n1 :: nil *) 
       if Int.ltu n Int.iwordsize then I(Int.ror n1 n) else Unknown
-  | eval_static_operation_case31 mode vl =>
+  | eval_static_operation_case31 mode vl => (* Olea mode, vl *) 
       eval_static_addressing mode vl
-  | eval_static_operation_case32 n1 =>
+  | eval_static_operation_case32 n1 => (* Onegf, F n1 :: nil *) 
       F(Float.neg n1)
-  | eval_static_operation_case33 n1 =>
+  | eval_static_operation_case33 n1 => (* Oabsf, F n1 :: nil *) 
       F(Float.abs n1)
-  | eval_static_operation_case34 n1 n2 =>
+  | eval_static_operation_case34 n1 n2 => (* Oaddf, F n1 :: F n2 :: nil *) 
       F(Float.add n1 n2)
-  | eval_static_operation_case35 n1 n2 =>
+  | eval_static_operation_case35 n1 n2 => (* Osubf, F n1 :: F n2 :: nil *) 
       F(Float.sub n1 n2)
-  | eval_static_operation_case36 n1 n2 =>
+  | eval_static_operation_case36 n1 n2 => (* Omulf, F n1 :: F n2 :: nil *) 
       F(Float.mul n1 n2)
-  | eval_static_operation_case37 n1 n2 =>
+  | eval_static_operation_case37 n1 n2 => (* Odivf, F n1 :: F n2 :: nil *) 
       F(Float.div n1 n2)
-  | eval_static_operation_case38 n1 =>
+  | eval_static_operation_case38 n1 => (* Osingleoffloat, F n1 :: nil *) 
       F(Float.singleoffloat n1)
-  | eval_static_operation_case39 n1 =>
-      match Float.intoffloat n1 with Some x => I x | None => Unknown end
-  | eval_static_operation_case41 n1 =>
+  | eval_static_operation_case39 n1 => (* Ointoffloat, F n1 :: nil *) 
+      eval_static_intoffloat n1
+  | eval_static_operation_case40 n1 => (* Ofloatofint, I n1 :: nil *) 
       F(Float.floatofint n1)
-  | eval_static_operation_case43 c vl =>
-      match eval_static_condition c vl with
-      | None => Unknown
-      | Some b => I(if b then Int.one else Int.zero)
-      end
+  | eval_static_operation_case41 c vl => (* Ocmp c, vl *) 
+      eval_static_condition_val c vl
   | eval_static_operation_default op vl =>
       Unknown
   end.
 
+
 (** * Operator strength reduction *)
 
 (** We now define auxiliary functions for strength reduction of
@@ -613,146 +465,178 @@ Section STRENGTH_REDUCTION.
 
 Variable app: reg -> approx.
 
-Definition intval (r: reg) : option int :=
-  match app r with I n => Some n | _ => None end.
-
-Inductive cond_strength_reduction_cases: condition -> list reg -> Type :=
-  | csr_case1:
-      forall c r1 r2,
-      cond_strength_reduction_cases (Ccomp c) (r1 :: r2 :: nil)
-  | csr_case2:
-      forall c r1 r2,
-      cond_strength_reduction_cases (Ccompu c) (r1 :: r2 :: nil)
-  | csr_default:
-      forall c rl,
-      cond_strength_reduction_cases c rl.
-
-Definition cond_strength_reduction_match (cond: condition) (rl: list reg) :=
-  match cond as x, rl as y return cond_strength_reduction_cases x y with
-  | Ccomp c, r1 :: r2 :: nil =>
-      csr_case1 c r1 r2
-  | Ccompu c, r1 :: r2 :: nil =>
-      csr_case2 c r1 r2
-  | cond, rl =>
-      csr_default cond rl
+(** Original definition:
+<<
+Nondetfunction cond_strength_reduction 
+              (cond: condition) (args: list reg) (vl: list approx) :=
+  match cond, args, vl with
+  | Ccomp c, r1 :: r2 :: nil, I n1 :: v2 :: nil =>
+      (Ccompimm (swap_comparison c) n1, r2 :: nil)
+  | Ccomp c, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
+      (Ccompimm c n2, r1 :: nil)
+  | Ccompu c, r1 :: r2 :: nil, I n1 :: v2 :: nil =>
+      (Ccompuimm (swap_comparison c) n1, r2 :: nil)
+  | Ccompu c, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
+      (Ccompuimm c n2, r1 :: nil)
+  | _, _, _ => 
+      (cond, args)
+  end.
+>>
+*)
+
+Inductive cond_strength_reduction_cases: forall (cond: condition) (args: list reg) (vl: list approx), Type :=
+  | cond_strength_reduction_case1: forall c r1 r2 n1 v2, cond_strength_reduction_cases (Ccomp c) (r1 :: r2 :: nil) (I n1 :: v2 :: nil)
+  | cond_strength_reduction_case2: forall c r1 r2 v1 n2, cond_strength_reduction_cases (Ccomp c) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | cond_strength_reduction_case3: forall c r1 r2 n1 v2, cond_strength_reduction_cases (Ccompu c) (r1 :: r2 :: nil) (I n1 :: v2 :: nil)
+  | cond_strength_reduction_case4: forall c r1 r2 v1 n2, cond_strength_reduction_cases (Ccompu c) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | cond_strength_reduction_default: forall (cond: condition) (args: list reg) (vl: list approx), cond_strength_reduction_cases cond args vl.
+
+Definition cond_strength_reduction_match (cond: condition) (args: list reg) (vl: list approx) :=
+  match cond as zz1, args as zz2, vl as zz3 return cond_strength_reduction_cases zz1 zz2 zz3 with
+  | Ccomp c, r1 :: r2 :: nil, I n1 :: v2 :: nil => cond_strength_reduction_case1 c r1 r2 n1 v2
+  | Ccomp c, r1 :: r2 :: nil, v1 :: I n2 :: nil => cond_strength_reduction_case2 c r1 r2 v1 n2
+  | Ccompu c, r1 :: r2 :: nil, I n1 :: v2 :: nil => cond_strength_reduction_case3 c r1 r2 n1 v2
+  | Ccompu c, r1 :: r2 :: nil, v1 :: I n2 :: nil => cond_strength_reduction_case4 c r1 r2 v1 n2
+  | cond, args, vl => cond_strength_reduction_default cond args vl
   end.
 
-Definition cond_strength_reduction
-              (cond: condition) (args: list reg) : condition * list reg :=
-  match cond_strength_reduction_match cond args with
-  | csr_case1 c r1 r2 =>
-      match intval r1, intval r2 with
-      | Some n, _ =>
-          (Ccompimm (swap_comparison c) n, r2 :: nil)
-      | _, Some n =>
-          (Ccompimm c n, r1 :: nil)
-      | _, _ =>
-          (cond, args)
-      end
-  | csr_case2 c r1 r2 =>
-      match intval r1, intval r2 with
-      | Some n, _ =>
-          (Ccompuimm (swap_comparison c) n, r2 :: nil)
-      | _, Some n =>
-          (Ccompuimm c n, r1 :: nil)
-      | _, _ =>
-          (cond, args)
-      end
-  | csr_default cond args =>
+Definition cond_strength_reduction (cond: condition) (args: list reg) (vl: list approx) :=
+  match cond_strength_reduction_match cond args vl with
+  | cond_strength_reduction_case1 c r1 r2 n1 v2 => (* Ccomp c, r1 :: r2 :: nil, I n1 :: v2 :: nil *) 
+      (Ccompimm (swap_comparison c) n1, r2 :: nil)
+  | cond_strength_reduction_case2 c r1 r2 v1 n2 => (* Ccomp c, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      (Ccompimm c n2, r1 :: nil)
+  | cond_strength_reduction_case3 c r1 r2 n1 v2 => (* Ccompu c, r1 :: r2 :: nil, I n1 :: v2 :: nil *) 
+      (Ccompuimm (swap_comparison c) n1, r2 :: nil)
+  | cond_strength_reduction_case4 c r1 r2 v1 n2 => (* Ccompu c, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      (Ccompuimm c n2, r1 :: nil)
+  | cond_strength_reduction_default cond args vl =>
       (cond, args)
   end.
 
-(*
-Definition addr_strength_reduction (addr: addressing) (args: list reg) :=
-  match addr, args with
-  | Aindexed ofs, r1 :: nil => (* Aindexed *)
-  | Aindexed2 ofs, r1 :: r2 :: nil => (* Aindexed2 *)
-  | Aindexed2scaled sc ofs, r1 :: r2 :: nil => (* Aindexed2scaled *)
-  | Abased id ofs, r1 :: nil => (* Abased *)
-  | Abasedscaled sc id ofs, r1 :: nil => (* Abasedscaled *)
-  | _, _ => (* default *)
+
+(** Original definition:
+<<
+Nondetfunction addr_strength_reduction
+                (addr: addressing) (args: list reg) (vl: list approx) :=
+  match addr, args, vl with
+
+  | Aindexed ofs, r1 :: nil, G symb n :: nil =>
+      (Aglobal symb (Int.add n ofs), nil)
+  | Aindexed ofs, r1 :: nil, S n :: nil =>
+      (Ainstack (Int.add n ofs), nil)
+
+  | Aindexed2 ofs, r1 :: r2 :: nil, G symb n1 :: I n2 :: nil =>
+      (Aglobal symb (Int.add (Int.add n1 n2) ofs), nil)
+  | Aindexed2 ofs, r1 :: r2 :: nil, I n1 :: G symb n2 :: nil =>
+      (Aglobal symb (Int.add (Int.add n1 n2) ofs), nil)
+  | Aindexed2 ofs, r1 :: r2 :: nil, S n1 :: I n2 :: nil =>
+      (Ainstack (Int.add (Int.add n1 n2) ofs), nil)
+  | Aindexed2 ofs, r1 :: r2 :: nil, I n1 :: S n2 :: nil =>
+      (Ainstack (Int.add (Int.add n1 n2) ofs), nil)
+  | Aindexed2 ofs, r1 :: r2 :: nil, G symb n1 :: v2 :: nil =>
+      (Abased symb (Int.add n1 ofs), r2 :: nil)
+  | Aindexed2 ofs, r1 :: r2 :: nil, v1 :: G symb n2 :: nil =>
+      (Abased symb (Int.add n2 ofs), r1 :: nil)
+  | Aindexed2 ofs, r1 :: r2 :: nil, I n1 :: v2 :: nil =>
+      (Aindexed (Int.add n1 ofs), r2 :: nil)
+  | Aindexed2 ofs, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
+      (Aindexed (Int.add n2 ofs), r1 :: nil)
+
+  | Aindexed2scaled sc ofs, r1 :: r2 :: nil, G symb n1 :: I n2 :: nil =>
+      (Aglobal symb (Int.add (Int.add n1 (Int.mul n2 sc)) ofs), nil)
+  | Aindexed2scaled sc ofs, r1 :: r2 :: nil, G symb n1 :: v2 :: nil =>
+      (Abasedscaled sc symb (Int.add n1 ofs), r2 :: nil)
+  | Aindexed2scaled sc ofs, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
+      (Aindexed (Int.add (Int.mul n2 sc) ofs), r1 :: nil)
+
+  | Abased id ofs, r1 :: nil, I n1 :: nil =>
+      (Aglobal id (Int.add ofs n1), nil)
+
+  | Abasedscaled sc id ofs, r1 :: nil, I n1 :: nil =>
+      (Aglobal id (Int.add ofs (Int.mul sc n1)), nil)
+
+  | _, _ =>
+      (addr, args)
   end.
+>>
 *)
 
-Inductive addr_strength_reduction_cases: forall (addr: addressing) (args: list reg), Type :=
-  | addr_strength_reduction_case1:
-      forall ofs r1,
-      addr_strength_reduction_cases (Aindexed ofs) (r1 :: nil)
-  | addr_strength_reduction_case2:
-      forall ofs r1 r2,
-      addr_strength_reduction_cases (Aindexed2 ofs) (r1 :: r2 :: nil)
-  | addr_strength_reduction_case3:
-      forall sc ofs r1 r2,
-      addr_strength_reduction_cases (Aindexed2scaled sc ofs) (r1 :: r2 :: nil)
-  | addr_strength_reduction_case4:
-      forall id ofs r1,
-      addr_strength_reduction_cases (Abased id ofs) (r1 :: nil)
-  | addr_strength_reduction_case5:
-      forall sc id ofs r1,
-      addr_strength_reduction_cases (Abasedscaled sc id ofs) (r1 :: nil)
-  | addr_strength_reduction_default:
-      forall (addr: addressing) (args: list reg),
-      addr_strength_reduction_cases addr args.
-
-Definition addr_strength_reduction_match (addr: addressing) (args: list reg) :=
-  match addr as z1, args as z2 return addr_strength_reduction_cases z1 z2 with
-  | Aindexed ofs, r1 :: nil =>
-      addr_strength_reduction_case1 ofs r1
-  | Aindexed2 ofs, r1 :: r2 :: nil =>
-      addr_strength_reduction_case2 ofs r1 r2
-  | Aindexed2scaled sc ofs, r1 :: r2 :: nil =>
-      addr_strength_reduction_case3 sc ofs r1 r2
-  | Abased id ofs, r1 :: nil =>
-      addr_strength_reduction_case4 id ofs r1
-  | Abasedscaled sc id ofs, r1 :: nil =>
-      addr_strength_reduction_case5 sc id ofs r1
-  | addr, args =>
-      addr_strength_reduction_default addr args
+Inductive addr_strength_reduction_cases: forall (addr: addressing) (args: list reg) (vl: list approx), Type :=
+  | addr_strength_reduction_case1: forall ofs r1 symb n, addr_strength_reduction_cases (Aindexed ofs) (r1 :: nil) (G symb n :: nil)
+  | addr_strength_reduction_case2: forall ofs r1 n, addr_strength_reduction_cases (Aindexed ofs) (r1 :: nil) (S n :: nil)
+  | addr_strength_reduction_case3: forall ofs r1 r2 symb n1 n2, addr_strength_reduction_cases (Aindexed2 ofs) (r1 :: r2 :: nil) (G symb n1 :: I n2 :: nil)
+  | addr_strength_reduction_case4: forall ofs r1 r2 n1 symb n2, addr_strength_reduction_cases (Aindexed2 ofs) (r1 :: r2 :: nil) (I n1 :: G symb n2 :: nil)
+  | addr_strength_reduction_case5: forall ofs r1 r2 n1 n2, addr_strength_reduction_cases (Aindexed2 ofs) (r1 :: r2 :: nil) (S n1 :: I n2 :: nil)
+  | addr_strength_reduction_case6: forall ofs r1 r2 n1 n2, addr_strength_reduction_cases (Aindexed2 ofs) (r1 :: r2 :: nil) (I n1 :: S n2 :: nil)
+  | addr_strength_reduction_case7: forall ofs r1 r2 symb n1 v2, addr_strength_reduction_cases (Aindexed2 ofs) (r1 :: r2 :: nil) (G symb n1 :: v2 :: nil)
+  | addr_strength_reduction_case8: forall ofs r1 r2 v1 symb n2, addr_strength_reduction_cases (Aindexed2 ofs) (r1 :: r2 :: nil) (v1 :: G symb n2 :: nil)
+  | addr_strength_reduction_case9: forall ofs r1 r2 n1 v2, addr_strength_reduction_cases (Aindexed2 ofs) (r1 :: r2 :: nil) (I n1 :: v2 :: nil)
+  | addr_strength_reduction_case10: forall ofs r1 r2 v1 n2, addr_strength_reduction_cases (Aindexed2 ofs) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | addr_strength_reduction_case11: forall sc ofs r1 r2 symb n1 n2, addr_strength_reduction_cases (Aindexed2scaled sc ofs) (r1 :: r2 :: nil) (G symb n1 :: I n2 :: nil)
+  | addr_strength_reduction_case12: forall sc ofs r1 r2 symb n1 v2, addr_strength_reduction_cases (Aindexed2scaled sc ofs) (r1 :: r2 :: nil) (G symb n1 :: v2 :: nil)
+  | addr_strength_reduction_case13: forall sc ofs r1 r2 v1 n2, addr_strength_reduction_cases (Aindexed2scaled sc ofs) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | addr_strength_reduction_case14: forall id ofs r1 n1, addr_strength_reduction_cases (Abased id ofs) (r1 :: nil) (I n1 :: nil)
+  | addr_strength_reduction_case15: forall sc id ofs r1 n1, addr_strength_reduction_cases (Abasedscaled sc id ofs) (r1 :: nil) (I n1 :: nil)
+  | addr_strength_reduction_default: forall (addr: addressing) (args: list reg) (vl: list approx), addr_strength_reduction_cases addr args vl.
+
+Definition addr_strength_reduction_match (addr: addressing) (args: list reg) (vl: list approx) :=
+  match addr as zz1, args as zz2, vl as zz3 return addr_strength_reduction_cases zz1 zz2 zz3 with
+  | Aindexed ofs, r1 :: nil, G symb n :: nil => addr_strength_reduction_case1 ofs r1 symb n
+  | Aindexed ofs, r1 :: nil, S n :: nil => addr_strength_reduction_case2 ofs r1 n
+  | Aindexed2 ofs, r1 :: r2 :: nil, G symb n1 :: I n2 :: nil => addr_strength_reduction_case3 ofs r1 r2 symb n1 n2
+  | Aindexed2 ofs, r1 :: r2 :: nil, I n1 :: G symb n2 :: nil => addr_strength_reduction_case4 ofs r1 r2 n1 symb n2
+  | Aindexed2 ofs, r1 :: r2 :: nil, S n1 :: I n2 :: nil => addr_strength_reduction_case5 ofs r1 r2 n1 n2
+  | Aindexed2 ofs, r1 :: r2 :: nil, I n1 :: S n2 :: nil => addr_strength_reduction_case6 ofs r1 r2 n1 n2
+  | Aindexed2 ofs, r1 :: r2 :: nil, G symb n1 :: v2 :: nil => addr_strength_reduction_case7 ofs r1 r2 symb n1 v2
+  | Aindexed2 ofs, r1 :: r2 :: nil, v1 :: G symb n2 :: nil => addr_strength_reduction_case8 ofs r1 r2 v1 symb n2
+  | Aindexed2 ofs, r1 :: r2 :: nil, I n1 :: v2 :: nil => addr_strength_reduction_case9 ofs r1 r2 n1 v2
+  | Aindexed2 ofs, r1 :: r2 :: nil, v1 :: I n2 :: nil => addr_strength_reduction_case10 ofs r1 r2 v1 n2
+  | Aindexed2scaled sc ofs, r1 :: r2 :: nil, G symb n1 :: I n2 :: nil => addr_strength_reduction_case11 sc ofs r1 r2 symb n1 n2
+  | Aindexed2scaled sc ofs, r1 :: r2 :: nil, G symb n1 :: v2 :: nil => addr_strength_reduction_case12 sc ofs r1 r2 symb n1 v2
+  | Aindexed2scaled sc ofs, r1 :: r2 :: nil, v1 :: I n2 :: nil => addr_strength_reduction_case13 sc ofs r1 r2 v1 n2
+  | Abased id ofs, r1 :: nil, I n1 :: nil => addr_strength_reduction_case14 id ofs r1 n1
+  | Abasedscaled sc id ofs, r1 :: nil, I n1 :: nil => addr_strength_reduction_case15 sc id ofs r1 n1
+  | addr, args, vl => addr_strength_reduction_default addr args vl
   end.
 
-Definition addr_strength_reduction (addr: addressing) (args: list reg) :=
-  match addr_strength_reduction_match addr args with
-  | addr_strength_reduction_case1 ofs r1 =>
-      (* Aindexed *)
-      match app r1 with
-      | S symb n => (Aglobal symb (Int.add ofs n), nil)
-      | _ => (addr, args)
-      end
-  | addr_strength_reduction_case2 ofs r1 r2 =>
-      (* Aindexed2 *)
-      match app r1, app r2 with
-      | S symb n1, I n2 => (Aglobal symb (Int.add (Int.add n1 n2) ofs), nil)
-      | I n1, S symb n2 => (Aglobal symb (Int.add (Int.add n1 n2) ofs), nil)
-      | S symb n1, _ => (Abased symb (Int.add n1 ofs), r2 :: nil)
-      | _, S symb n2 => (Abased symb (Int.add n2 ofs), r1 :: nil)
-      | I n1, _ => (Aindexed (Int.add n1 ofs), r2 :: nil)
-      | _, I n2 => (Aindexed (Int.add n2 ofs), r1 :: nil)
-      | _, _ => (addr, args)
-      end
-  | addr_strength_reduction_case3 sc ofs r1 r2 =>
-      (* Aindexed2scaled *)
-      match app r1, app r2 with
-      | S symb n1, I n2 => (Aglobal symb (Int.add (Int.add n1 (Int.mul n2 sc)) ofs), nil)
-      | S symb n1, _ => (Abasedscaled sc symb (Int.add n1 ofs), r2 :: nil)
-      | _, I n2 => (Aindexed (Int.add (Int.mul n2 sc) ofs), r1 :: nil)
-      | _, _ => (addr, args)
-      end
-  | addr_strength_reduction_case4 id ofs r1 =>
-      (* Abased *)
-      match app r1 with
-      | I n1 => (Aglobal id (Int.add ofs n1), nil)
-      | _ => (addr, args)
-      end
-  | addr_strength_reduction_case5 sc id ofs r1 =>
-      (* Abasedscaled *)
-      match app r1 with
-      | I n1 => (Aglobal id (Int.add ofs (Int.mul sc n1)), nil)
-      | _ => (addr, args)
-      end
-  | addr_strength_reduction_default addr args =>
+Definition addr_strength_reduction (addr: addressing) (args: list reg) (vl: list approx) :=
+  match addr_strength_reduction_match addr args vl with
+  | addr_strength_reduction_case1 ofs r1 symb n => (* Aindexed ofs, r1 :: nil, G symb n :: nil *) 
+      (Aglobal symb (Int.add n ofs), nil)
+  | addr_strength_reduction_case2 ofs r1 n => (* Aindexed ofs, r1 :: nil, S n :: nil *) 
+      (Ainstack (Int.add n ofs), nil)
+  | addr_strength_reduction_case3 ofs r1 r2 symb n1 n2 => (* Aindexed2 ofs, r1 :: r2 :: nil, G symb n1 :: I n2 :: nil *) 
+      (Aglobal symb (Int.add (Int.add n1 n2) ofs), nil)
+  | addr_strength_reduction_case4 ofs r1 r2 n1 symb n2 => (* Aindexed2 ofs, r1 :: r2 :: nil, I n1 :: G symb n2 :: nil *) 
+      (Aglobal symb (Int.add (Int.add n1 n2) ofs), nil)
+  | addr_strength_reduction_case5 ofs r1 r2 n1 n2 => (* Aindexed2 ofs, r1 :: r2 :: nil, S n1 :: I n2 :: nil *) 
+      (Ainstack (Int.add (Int.add n1 n2) ofs), nil)
+  | addr_strength_reduction_case6 ofs r1 r2 n1 n2 => (* Aindexed2 ofs, r1 :: r2 :: nil, I n1 :: S n2 :: nil *) 
+      (Ainstack (Int.add (Int.add n1 n2) ofs), nil)
+  | addr_strength_reduction_case7 ofs r1 r2 symb n1 v2 => (* Aindexed2 ofs, r1 :: r2 :: nil, G symb n1 :: v2 :: nil *) 
+      (Abased symb (Int.add n1 ofs), r2 :: nil)
+  | addr_strength_reduction_case8 ofs r1 r2 v1 symb n2 => (* Aindexed2 ofs, r1 :: r2 :: nil, v1 :: G symb n2 :: nil *) 
+      (Abased symb (Int.add n2 ofs), r1 :: nil)
+  | addr_strength_reduction_case9 ofs r1 r2 n1 v2 => (* Aindexed2 ofs, r1 :: r2 :: nil, I n1 :: v2 :: nil *) 
+      (Aindexed (Int.add n1 ofs), r2 :: nil)
+  | addr_strength_reduction_case10 ofs r1 r2 v1 n2 => (* Aindexed2 ofs, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      (Aindexed (Int.add n2 ofs), r1 :: nil)
+  | addr_strength_reduction_case11 sc ofs r1 r2 symb n1 n2 => (* Aindexed2scaled sc ofs, r1 :: r2 :: nil, G symb n1 :: I n2 :: nil *) 
+      (Aglobal symb (Int.add (Int.add n1 (Int.mul n2 sc)) ofs), nil)
+  | addr_strength_reduction_case12 sc ofs r1 r2 symb n1 v2 => (* Aindexed2scaled sc ofs, r1 :: r2 :: nil, G symb n1 :: v2 :: nil *) 
+      (Abasedscaled sc symb (Int.add n1 ofs), r2 :: nil)
+  | addr_strength_reduction_case13 sc ofs r1 r2 v1 n2 => (* Aindexed2scaled sc ofs, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      (Aindexed (Int.add (Int.mul n2 sc) ofs), r1 :: nil)
+  | addr_strength_reduction_case14 id ofs r1 n1 => (* Abased id ofs, r1 :: nil, I n1 :: nil *) 
+      (Aglobal id (Int.add ofs n1), nil)
+  | addr_strength_reduction_case15 sc id ofs r1 n1 => (* Abasedscaled sc id ofs, r1 :: nil, I n1 :: nil *) 
+      (Aglobal id (Int.add ofs (Int.mul sc n1)), nil)
+  | addr_strength_reduction_default addr args vl =>
       (addr, args)
   end.
 
+
 Definition make_addimm (n: int) (r: reg) :=
   if Int.eq n Int.zero
   then (Omove, r :: nil)
@@ -800,211 +684,122 @@ Definition make_xorimm (n: int) (r: reg) :=
   then (Omove, r :: nil)
   else (Oxorimm n, r :: nil).
 
-(*
-Definition op_strength_reduction (op: operation) (args: list reg) :=
-  match op, args with
-  | Osub, r1 :: r2 :: nil => (* Osub *)
-  | Omul, r1 :: r2 :: nil => (* Omul *)
-  | Odiv, r1 :: r2 :: nil => (* Odiv *)
-  | Odivu, r1 :: r2 :: nil => (* Odivu *)
-  | Omodu, r1 :: r2 :: nil => (* Omodu *)
-  | Oand, r1 :: r2 :: nil => (* Oand *)
-  | Oor, r1 :: r2 :: nil => (* Oor *)
-  | Oxor, r1 :: r2 :: nil => (* Oxor *)
-  | Oshl, r1 :: r2 :: nil => (* Oshl *)
-  | Oshr, r1 :: r2 :: nil => (* Oshr *)
-  | Oshru, r1 :: r2 :: nil => (* Oshru *)
-  | Olea addr, args => (* Olea *)
-  | Ocmp c, args => (* Ocmp *)
-  | _, _ => (* default *)
+Definition make_divimm n (r1 r2: reg) :=
+  match Int.is_power2 n with
+  | Some l => if Int.ltu l (Int.repr 31)
+              then (Oshrximm l, r1 :: nil)
+              else (Odiv, r1 :: r2 :: nil)
+  | None   => (Odiv, r1 :: r2 :: nil)
+  end.
+
+Definition make_divuimm n (r1 r2: reg) :=
+  match Int.is_power2 n with
+  | Some l => make_shruimm l r1
+  | None   => (Odivu, r1 :: r2 :: nil)
   end.
-*)
 
-Inductive op_strength_reduction_cases: forall (op: operation) (args: list reg), Type :=
-  | op_strength_reduction_case2:
-      forall r1 r2,
-      op_strength_reduction_cases (Osub) (r1 :: r2 :: nil)
-  | op_strength_reduction_case3:
-      forall r1 r2,
-      op_strength_reduction_cases (Omul) (r1 :: r2 :: nil)
-  | op_strength_reduction_case4:
-      forall r1 r2,
-      op_strength_reduction_cases (Odiv) (r1 :: r2 :: nil)
-  | op_strength_reduction_case5:
-      forall r1 r2,
-      op_strength_reduction_cases (Odivu) (r1 :: r2 :: nil)
-  | op_strength_reduction_case7:
-      forall r1 r2,
-      op_strength_reduction_cases (Omodu) (r1 :: r2 :: nil)
-  | op_strength_reduction_case8:
-      forall r1 r2,
-      op_strength_reduction_cases (Oand) (r1 :: r2 :: nil)
-  | op_strength_reduction_case9:
-      forall r1 r2,
-      op_strength_reduction_cases (Oor) (r1 :: r2 :: nil)
-  | op_strength_reduction_case10:
-      forall r1 r2,
-      op_strength_reduction_cases (Oxor) (r1 :: r2 :: nil)
-  | op_strength_reduction_case11:
-      forall r1 r2,
-      op_strength_reduction_cases (Oshl) (r1 :: r2 :: nil)
-  | op_strength_reduction_case12:
-      forall r1 r2,
-      op_strength_reduction_cases (Oshr) (r1 :: r2 :: nil)
-  | op_strength_reduction_case13:
-      forall r1 r2,
-      op_strength_reduction_cases (Oshru) (r1 :: r2 :: nil)
-  | op_strength_reduction_case14:
-      forall addr args,
-      op_strength_reduction_cases (Olea addr) (args)
-  | op_strength_reduction_case15:
-      forall c args,
-      op_strength_reduction_cases (Ocmp c) (args)
-  | op_strength_reduction_default:
-      forall (op: operation) (args: list reg),
-      op_strength_reduction_cases op args.
-
-Definition op_strength_reduction_match (op: operation) (args: list reg) :=
-  match op as z1, args as z2 return op_strength_reduction_cases z1 z2 with
-  | Osub, r1 :: r2 :: nil =>
-      op_strength_reduction_case2 r1 r2
-  | Omul, r1 :: r2 :: nil =>
-      op_strength_reduction_case3 r1 r2
-  | Odiv, r1 :: r2 :: nil =>
-      op_strength_reduction_case4 r1 r2
-  | Odivu, r1 :: r2 :: nil =>
-      op_strength_reduction_case5 r1 r2
-  | Omodu, r1 :: r2 :: nil =>
-      op_strength_reduction_case7 r1 r2
-  | Oand, r1 :: r2 :: nil =>
-      op_strength_reduction_case8 r1 r2
-  | Oor, r1 :: r2 :: nil =>
-      op_strength_reduction_case9 r1 r2
-  | Oxor, r1 :: r2 :: nil =>
-      op_strength_reduction_case10 r1 r2
-  | Oshl, r1 :: r2 :: nil =>
-      op_strength_reduction_case11 r1 r2
-  | Oshr, r1 :: r2 :: nil =>
-      op_strength_reduction_case12 r1 r2
-  | Oshru, r1 :: r2 :: nil =>
-      op_strength_reduction_case13 r1 r2
-  | Olea addr, args =>
-      op_strength_reduction_case14 addr args
-  | Ocmp c, args =>
-      op_strength_reduction_case15 c args
-  | op, args =>
-      op_strength_reduction_default op args
+Definition make_moduimm n (r1 r2: reg) :=
+  match Int.is_power2 n with
+  | Some l => (Oandimm (Int.sub n Int.one), r1 :: nil)
+  | None   => (Omodu, r1 :: r2 :: nil)
   end.
 
 (** We must be careful to preserve 2-address constraints over the
     RTL code, which means that commutative operations cannot
     be specialized if their first argument is a constant. *)
 
-Definition op_strength_reduction (op: operation) (args: list reg) :=
-  match op_strength_reduction_match op args with
-  | op_strength_reduction_case2 r1 r2 =>
-      (* Osub *)
-      match intval r2 with
-      | Some n => make_addimm (Int.neg n) r1
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case3 r1 r2 =>
-      (* Omul *)
-      match intval r2 with
-      | Some n => make_mulimm n r1
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case4 r1 r2 =>
-      (* Odiv *)
-      match intval r2 with
-      | Some n =>
-          match Int.is_power2 n with
-          | Some l => if Int.ltu l (Int.repr 31)
-                      then (Oshrximm l, r1 :: nil)
-                      else (op, args)
-          | None   => (op, args)
-          end
-      | None =>
-          (op, args)
-      end
-  | op_strength_reduction_case5 r1 r2 =>
-      (* Odivu *)
-      match intval r2 with
-      | Some n =>
-          match Int.is_power2 n with
-          | Some l => make_shruimm l r1
-          | None   => (op, args)
-          end
-      | None =>
-          (op, args)
-      end
-  | op_strength_reduction_case7 r1 r2 =>
-      (* Omodu *)
-      match intval r2 with
-      | Some n =>
-          match Int.is_power2 n with
-          | Some l => (Oandimm (Int.sub n Int.one), r1 :: nil)
-          | None   => (op, args)
-          end
-      | None =>
-          (op, args)
-      end
-  | op_strength_reduction_case8 r1 r2 =>
-      (* Oand *)
-      match intval r2 with
-      | Some n => make_andimm n r1
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case9 r1 r2 =>
-      (* Oor *)
-      match intval r2 with
-      | Some n => make_orimm n r1
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case10 r1 r2 =>
-      (* Oxor *)
-      match intval r2 with
-      | Some n => make_xorimm n r1
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case11 r1 r2 =>
-      (* Oshl *)
-      match intval r2 with
-      | Some n =>
-          if Int.ltu n Int.iwordsize
-          then make_shlimm n r1
-          else (op, args)
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case12 r1 r2 =>
-      (* Oshr *)
-      match intval r2 with
-      | Some n =>
-          if Int.ltu n Int.iwordsize
-          then make_shrimm n r1
-          else (op, args)
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case13 r1 r2 =>
-      (* Oshru *)
-      match intval r2 with
-      | Some n =>
-          if Int.ltu n Int.iwordsize
-          then make_shruimm n r1
-          else (op, args)
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case14 addr args =>
-      (* Olea *)
-      let (addr', args') := addr_strength_reduction addr args in
+(** Original definition:
+<<
+Nondetfunction op_strength_reduction 
+              (op: operation) (args: list reg) (vl: list approx) :=
+  match op, args, vl with
+  | Osub, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (Int.neg n2) r1
+  | Omul, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_mulimm n2 r1
+  | Odiv, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_divimm n2 r1 r2
+  | Odivu, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_divuimm n2 r1 r2
+  | Omodu, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_moduimm n2 r1 r2
+  | Oand, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm n2 r1
+  | Oor, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_orimm n2 r1
+  | Oxor, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_xorimm n2 r1
+  | Oshl, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shlimm n2 r1
+  | Oshr, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shrimm n2 r1
+  | Oshru, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shruimm n2 r1
+  | Olea addr, args, vl =>
+      let (addr', args') := addr_strength_reduction addr args vl in
       (Olea addr', args')
-  | op_strength_reduction_case15 c args =>
-      (* Ocmp *)
-      let (c', args') := cond_strength_reduction c args in
+  | Ocmp c, args, vl =>
+      let (c', args') := cond_strength_reduction c args vl in 
       (Ocmp c', args')
-  | op_strength_reduction_default op args =>
-      (* default *)
+  | _, _, _ => (op, args)
+  end.
+>>
+*)
+
+Inductive op_strength_reduction_cases: forall (op: operation) (args: list reg) (vl: list approx), Type :=
+  | op_strength_reduction_case1: forall r1 r2 v1 n2, op_strength_reduction_cases (Osub) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case2: forall r1 r2 v1 n2, op_strength_reduction_cases (Omul) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case3: forall r1 r2 v1 n2, op_strength_reduction_cases (Odiv) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case4: forall r1 r2 v1 n2, op_strength_reduction_cases (Odivu) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case5: forall r1 r2 v1 n2, op_strength_reduction_cases (Omodu) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case6: forall r1 r2 v1 n2, op_strength_reduction_cases (Oand) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case7: forall r1 r2 v1 n2, op_strength_reduction_cases (Oor) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case8: forall r1 r2 v1 n2, op_strength_reduction_cases (Oxor) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case9: forall r1 r2 v1 n2, op_strength_reduction_cases (Oshl) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case10: forall r1 r2 v1 n2, op_strength_reduction_cases (Oshr) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case11: forall r1 r2 v1 n2, op_strength_reduction_cases (Oshru) (r1 :: r2 :: nil) (v1 :: I n2 :: nil)
+  | op_strength_reduction_case12: forall addr args vl, op_strength_reduction_cases (Olea addr) (args) (vl)
+  | op_strength_reduction_case13: forall c args vl, op_strength_reduction_cases (Ocmp c) (args) (vl)
+  | op_strength_reduction_default: forall (op: operation) (args: list reg) (vl: list approx), op_strength_reduction_cases op args vl.
+
+Definition op_strength_reduction_match (op: operation) (args: list reg) (vl: list approx) :=
+  match op as zz1, args as zz2, vl as zz3 return op_strength_reduction_cases zz1 zz2 zz3 with
+  | Osub, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case1 r1 r2 v1 n2
+  | Omul, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case2 r1 r2 v1 n2
+  | Odiv, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case3 r1 r2 v1 n2
+  | Odivu, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case4 r1 r2 v1 n2
+  | Omodu, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case5 r1 r2 v1 n2
+  | Oand, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case6 r1 r2 v1 n2
+  | Oor, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case7 r1 r2 v1 n2
+  | Oxor, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case8 r1 r2 v1 n2
+  | Oshl, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case9 r1 r2 v1 n2
+  | Oshr, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case10 r1 r2 v1 n2
+  | Oshru, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case11 r1 r2 v1 n2
+  | Olea addr, args, vl => op_strength_reduction_case12 addr args vl
+  | Ocmp c, args, vl => op_strength_reduction_case13 c args vl
+  | op, args, vl => op_strength_reduction_default op args vl
+  end.
+
+Definition op_strength_reduction (op: operation) (args: list reg) (vl: list approx) :=
+  match op_strength_reduction_match op args vl with
+  | op_strength_reduction_case1 r1 r2 v1 n2 => (* Osub, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_addimm (Int.neg n2) r1
+  | op_strength_reduction_case2 r1 r2 v1 n2 => (* Omul, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_mulimm n2 r1
+  | op_strength_reduction_case3 r1 r2 v1 n2 => (* Odiv, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_divimm n2 r1 r2
+  | op_strength_reduction_case4 r1 r2 v1 n2 => (* Odivu, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_divuimm n2 r1 r2
+  | op_strength_reduction_case5 r1 r2 v1 n2 => (* Omodu, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_moduimm n2 r1 r2
+  | op_strength_reduction_case6 r1 r2 v1 n2 => (* Oand, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_andimm n2 r1
+  | op_strength_reduction_case7 r1 r2 v1 n2 => (* Oor, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_orimm n2 r1
+  | op_strength_reduction_case8 r1 r2 v1 n2 => (* Oxor, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_xorimm n2 r1
+  | op_strength_reduction_case9 r1 r2 v1 n2 => (* Oshl, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_shlimm n2 r1
+  | op_strength_reduction_case10 r1 r2 v1 n2 => (* Oshr, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_shrimm n2 r1
+  | op_strength_reduction_case11 r1 r2 v1 n2 => (* Oshru, r1 :: r2 :: nil, v1 :: I n2 :: nil *) 
+      make_shruimm n2 r1
+  | op_strength_reduction_case12 addr args vl => (* Olea addr, args, vl *) 
+      let (addr', args') := addr_strength_reduction addr args vl in (Olea addr', args')
+  | op_strength_reduction_case13 c args vl => (* Ocmp c, args, vl *) 
+      let (c', args') := cond_strength_reduction c args vl in (Ocmp c', args')
+  | op_strength_reduction_default op args vl =>
       (op, args)
   end.
 
+
 End STRENGTH_REDUCTION.
diff --git a/ia32/ConstpropOpproof.v b/ia32/ConstpropOpproof.v
index 79e1537..afb284a 100644
--- a/ia32/ConstpropOpproof.v
+++ b/ia32/ConstpropOpproof.v
@@ -30,6 +30,7 @@ Require Import Constprop.
 Section ANALYSIS.
 
 Variable ge: genv.
+Variable sp: val.
 
 (** We first show that the dataflow analysis is correct with respect
   to the dynamic semantics: the approximations (sets of values) 
@@ -43,7 +44,8 @@ Definition val_match_approx (a: approx) (v: val) : Prop :=
   | Unknown => True
   | I p => v = Vint p
   | F p => v = Vfloat p
-  | S symb ofs => exists b, Genv.find_symbol ge symb = Some b /\ v = Vptr b ofs
+  | G symb ofs => v = symbol_address ge symb ofs
+  | S ofs => v = Val.add sp (Vint ofs)
   | _ => False
   end.
 
@@ -62,12 +64,10 @@ Ltac SimplVMA :=
       simpl in H; (try subst v); SimplVMA
   | H: (val_match_approx (F _) ?v) |- _ =>
       simpl in H; (try subst v); SimplVMA
-  | H: (val_match_approx (S _ _) ?v) |- _ =>
-      simpl in H; 
-      (try (elim H;
-            let b := fresh "b" in let A := fresh in let B := fresh in
-            (intros b [A B]; subst v; clear H)));
-      SimplVMA
+  | H: (val_match_approx (G _ _) ?v) |- _ =>
+      simpl in H; (try subst v); SimplVMA
+  | H: (val_match_approx (S _) ?v) |- _ =>
+      simpl in H; (try subst v); SimplVMA
   | _ =>
       idtac
   end.
@@ -75,9 +75,9 @@ Ltac SimplVMA :=
 Ltac InvVLMA :=
   match goal with
   | H: (val_list_match_approx nil ?vl) |- _ =>
-      inversion H
+      inv H
   | H: (val_list_match_approx (?a :: ?al) ?vl) |- _ =>
-      inversion H; SimplVMA; InvVLMA
+      inv H; SimplVMA; InvVLMA
   | _ =>
       idtac
   end.
@@ -99,28 +99,39 @@ Proof.
   InvVLMA; simpl; congruence.
 Qed.
 
+Remark shift_symbol_address:
+  forall symb ofs n,
+  symbol_address ge symb (Int.add ofs n) = Val.add (symbol_address ge symb ofs) (Vint n).
+Proof.
+  unfold symbol_address; intros. destruct (Genv.find_symbol ge symb); auto. 
+Qed.
+
 Lemma eval_static_addressing_correct:
-  forall addr sp al vl v,
+  forall addr al vl v,
   val_list_match_approx al vl ->
   eval_addressing ge sp addr vl = Some v ->
   val_match_approx (eval_static_addressing addr al) v.
 Proof.
   intros until v. unfold eval_static_addressing.
   case (eval_static_addressing_match addr al); intros;
-  InvVLMA; simpl in *; FuncInv; try congruence.
-  inv H4. exists b0; auto.
-  inv H4. inv H14. exists b0; auto. 
-  inv H4. inv H13. exists b0; auto. 
-  inv H4. inv H14. exists b0; auto.
-  destruct (Genv.find_symbol ge id); inv H0. exists b; auto.
-  inv H4. destruct (Genv.find_symbol ge id); inv H0. exists b; auto.
-  inv H4. destruct (Genv.find_symbol ge id); inv H0.
-  exists b; split; auto. rewrite Int.mul_commut; auto.
-  auto.
+  InvVLMA; simpl in *; FuncInv; try subst v; auto.
+  rewrite shift_symbol_address; auto.
+  rewrite Val.add_assoc. auto.
+  repeat rewrite shift_symbol_address. auto.
+  fold (Val.add (Vint n1) (symbol_address ge id ofs)).
+  repeat rewrite shift_symbol_address. repeat rewrite Val.add_assoc. rewrite Val.add_permut. auto.
+  repeat rewrite Val.add_assoc. decEq; simpl. rewrite Int.add_assoc. auto.
+  fold (Val.add (Vint n1) (Val.add sp (Vint ofs))).
+  rewrite Val.add_assoc. rewrite Val.add_permut. rewrite Val.add_assoc. 
+  simpl. rewrite Int.add_assoc; auto.
+  rewrite shift_symbol_address. auto.
+  rewrite Val.add_assoc. auto. 
+  rewrite shift_symbol_address. auto.
+  rewrite shift_symbol_address. rewrite Int.mul_commut; auto. 
 Qed.
 
 Lemma eval_static_operation_correct:
-  forall op sp al vl m v,
+  forall op al vl m v,
   val_list_match_approx al vl ->
   eval_operation ge sp op vl m = Some v ->
   val_match_approx (eval_static_operation op al) v.
@@ -128,65 +139,29 @@ Proof.
   intros until v.
   unfold eval_static_operation. 
   case (eval_static_operation_match op al); intros;
-  InvVLMA; simpl in *; FuncInv; try congruence.
-
-  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
-  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
-
-  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
-  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
-
-  exists b. split. auto. congruence.
-
-  replace n2 with i0. destruct (Int.eq i0 Int.zero). 
-  discriminate. injection H0; intro; subst v. simpl. congruence. congruence.
-
-  replace n2 with i0. destruct (Int.eq i0 Int.zero). 
-  discriminate. injection H0; intro; subst v. simpl. congruence. congruence.
-
-  replace n2 with i0. destruct (Int.eq i0 Int.zero). 
-  discriminate. injection H0; intro; subst v. simpl. congruence. congruence.
-
-  replace n2 with i0. destruct (Int.eq i0 Int.zero). 
-  discriminate. injection H0; intro; subst v. simpl. congruence. congruence.
-
-  replace n2 with i0. destruct (Int.ltu i0 Int.iwordsize).
-  injection H0; intro; subst v. simpl. congruence. discriminate. congruence. 
-
-  destruct (Int.ltu n Int.iwordsize).
-  injection H0; intro; subst v. simpl. congruence. discriminate.
-
-  replace n2 with i0. destruct (Int.ltu i0 Int.iwordsize).
-  injection H0; intro; subst v. simpl. congruence. discriminate. congruence. 
-
-  destruct (Int.ltu n Int.iwordsize).
-  injection H0; intro; subst v. simpl. congruence. discriminate.
-
-  destruct (Int.ltu n (Int.repr 31)).
-  injection H0; intro; subst v. simpl. congruence. discriminate.
-
-  replace n2 with i0. destruct (Int.ltu i0 Int.iwordsize).
-  injection H0; intro; subst v. simpl. congruence. discriminate. congruence. 
-
-  destruct (Int.ltu n Int.iwordsize).
-  injection H0; intro; subst v. simpl. congruence. discriminate.
-
-  destruct (Int.ltu n Int.iwordsize).
-  injection H0; intro; subst v. simpl. congruence. discriminate.
-
+  InvVLMA; simpl in *; FuncInv; try subst v; auto.
+
+  rewrite Int.sub_add_opp. rewrite shift_symbol_address. rewrite Val.sub_add_opp. auto.
+  destruct (Int.eq n2 Int.zero); inv H0; simpl; auto.
+  destruct (Int.eq n2 Int.zero); inv H0; simpl; auto.
+  destruct (Int.eq n2 Int.zero); inv H0; simpl; auto.
+  destruct (Int.eq n2 Int.zero); inv H0; simpl; auto.
+  destruct (Int.ltu n2 Int.iwordsize); simpl; auto.
+  destruct (Int.ltu n Int.iwordsize); simpl; auto.
+  destruct (Int.ltu n2 Int.iwordsize); simpl; auto.
+  destruct (Int.ltu n Int.iwordsize); simpl; auto.
+  destruct (Int.ltu n (Int.repr 31)); inv H0. simpl; auto.
+  destruct (Int.ltu n2 Int.iwordsize); simpl; auto.
+  destruct (Int.ltu n Int.iwordsize); simpl; auto.
+  destruct (Int.ltu n Int.iwordsize); simpl; auto.
   eapply eval_static_addressing_correct; eauto.
-
-  rewrite <- H3. replace v0 with (Vfloat n1). reflexivity. congruence.
-
-  inv H4. destruct (Float.intoffloat f); inv H0. red; auto.
-
-  caseEq (eval_static_condition c vl0).
-  intros. generalize (eval_static_condition_correct _ _ _ m _ H H1).
-  intro. rewrite H2 in H0. 
-  destruct b; injection H0; intro; subst v; simpl; auto.
-  intros; simpl; auto.
-
-  auto.
+  unfold eval_static_intoffloat.
+  destruct (Float.intoffloat n1) as []_eqn; simpl in H0; inv H0.
+  simpl; auto.
+  unfold eval_static_condition_val. destruct (eval_static_condition c vl0) as [b|]_eqn.
+  rewrite (eval_static_condition_correct _ _ _ m _ H Heqo). 
+  destruct b; simpl; auto.
+  simpl; auto.
 Qed.
 
 (** * Correctness of strength reduction *)
@@ -199,299 +174,248 @@ Qed.
 
 Section STRENGTH_REDUCTION.
 
-Variable app: reg -> approx.
-Variable sp: val.
+Variable app: D.t.
 Variable rs: regset.
 Variable m: mem.
-Hypothesis MATCH: forall r, val_match_approx (app r) rs#r.
+Hypothesis MATCH: forall r, val_match_approx (approx_reg app r) rs#r.
 
-Lemma intval_correct:
-  forall r n,
-  intval app r = Some n -> rs#r = Vint n.
-Proof.
-  intros until n.
-  unfold intval. caseEq (app r); intros; try discriminate.
-  generalize (MATCH r). unfold val_match_approx. rewrite H.
-  congruence. 
-Qed.
+Ltac InvApproxRegs :=
+  match goal with
+  | [ H: _ :: _ = _ :: _ |- _ ] => 
+        injection H; clear H; intros; InvApproxRegs
+  | [ H: ?v = approx_reg app ?r |- _ ] => 
+        generalize (MATCH r); rewrite <- H; clear H; intro; InvApproxRegs
+  | _ => idtac
+  end.
 
 Lemma cond_strength_reduction_correct:
-  forall cond args,
-  let (cond', args') := cond_strength_reduction app cond args in
+  forall cond args vl,
+  vl = approx_regs app args ->
+  let (cond', args') := cond_strength_reduction cond args vl in
   eval_condition cond' rs##args' m = eval_condition cond rs##args m.
 Proof.
-  intros. unfold cond_strength_reduction.
-  case (cond_strength_reduction_match cond args); intros.
-  caseEq (intval app r1); intros.
-  simpl. rewrite (intval_correct _ _ H). 
-  destruct (rs#r2); auto. rewrite Int.swap_cmp. auto.
-  caseEq (intval app r2); intros.
-  simpl. rewrite (intval_correct _ _ H0). auto.
-  auto.
-  caseEq (intval app r1); intros.
-  simpl. rewrite (intval_correct _ _ H). 
-  destruct (rs#r2); auto. rewrite Int.swap_cmpu. auto.
-  destruct c; reflexivity.
-  caseEq (intval app r2); intros.
-  simpl. rewrite (intval_correct _ _ H0). auto.
-  auto.
+  intros until vl. unfold cond_strength_reduction.
+  case (cond_strength_reduction_match cond args vl); simpl; intros; InvApproxRegs; SimplVMA.
+  rewrite H0. apply Val.swap_cmp_bool. 
+  rewrite H. auto.
+  rewrite H0. apply Val.swap_cmpu_bool.
+  rewrite H. auto.
   auto.
 Qed.
 
-Ltac KnownApprox :=
-  match goal with
-  | H: ?approx ?r = ?a |- _ =>
-      generalize (MATCH r); rewrite H; intro; clear H; KnownApprox
-  | _ => idtac
-  end.
- 
 Lemma addr_strength_reduction_correct:
-  forall addr args,
-  let (addr', args') := addr_strength_reduction app addr args in
+  forall addr args vl,
+  vl = approx_regs app args ->
+  let (addr', args') := addr_strength_reduction addr args vl in
   eval_addressing ge sp addr' rs##args' = eval_addressing ge sp addr rs##args.
 Proof.
-  intros. 
-
-  unfold addr_strength_reduction. destruct (addr_strength_reduction_match addr args). 
-
-  generalize (MATCH r1); caseEq (app r1); intros; auto.
-  simpl in H0. destruct H0 as [b [A B]]. simpl. rewrite A; rewrite B.
-  rewrite Int.add_commut; auto.
-
-  generalize (MATCH r1) (MATCH r2); caseEq (app r1); auto; caseEq (app r2); auto;
-  simpl val_match_approx; intros; try contradiction; simpl.
-  rewrite H2. destruct (rs#r1); auto. rewrite Int.add_assoc; auto. rewrite Int.add_assoc; auto.
-  destruct H2 as [b [A B]]. rewrite A; rewrite B. 
-  destruct (rs#r1); auto. repeat rewrite Int.add_assoc. decEq. decEq. decEq. apply Int.add_commut.
-  rewrite H1. destruct (rs#r2); auto.
-  rewrite Int.add_assoc; auto. rewrite Int.add_permut. auto.
-  rewrite Int.add_assoc; auto.
-  rewrite H1; rewrite H2. rewrite Int.add_permut. rewrite Int.add_assoc. auto.
-  rewrite H1; rewrite H2. auto.
-  destruct H2 as [b [A B]]. rewrite A; rewrite B. rewrite H1. do 3 decEq. apply Int.add_commut.
-  rewrite H1; auto.
-  rewrite H1; auto.
-  destruct H1 as [b [A B]]. rewrite A; rewrite B. destruct (rs#r2); auto.
-  repeat rewrite Int.add_assoc. do 3 decEq. apply Int.add_commut.
-  destruct H1 as [b [A B]]. rewrite A; rewrite B; rewrite H2. auto.
-  rewrite H2. destruct (rs#r1); auto.
-  destruct H1 as [b [A B]]. destruct H2 as [b' [A' B']].
-  rewrite A; rewrite B; rewrite B'. auto.
-
-  generalize (MATCH r1) (MATCH r2); caseEq (app r1); auto; caseEq (app r2); auto;
-  simpl val_match_approx; intros; try contradiction; simpl.
-  rewrite H2. destruct (rs#r1); auto.
-  rewrite H1; rewrite H2. auto.
-  rewrite H1. auto.
-  destruct H1 as [b [A B]]. rewrite A; rewrite B.
-  destruct (rs#r2); auto. rewrite Int.add_assoc. do 3 decEq. apply Int.add_commut.
-  destruct H1 as [b [A B]]. rewrite A; rewrite B; rewrite H2. rewrite Int.add_assoc. auto.
-  rewrite H2. destruct (rs#r1); auto.
-  destruct H1 as [b [A B]]. destruct H2 as [b' [A' B']].
-  rewrite A; rewrite B; rewrite B'. auto.
-
-  generalize (MATCH r1); caseEq (app r1); auto;
-  simpl val_match_approx; intros; try contradiction; simpl.
-  rewrite H0. auto.
-
-  generalize (MATCH r1); caseEq (app r1); auto;
-  simpl val_match_approx; intros; try contradiction; simpl.
-  rewrite H0. rewrite Int.mul_commut. auto.
-
+  intros until vl. unfold addr_strength_reduction.
+  destruct (addr_strength_reduction_match addr args vl); simpl; intros; InvApproxRegs; SimplVMA.
+  rewrite shift_symbol_address; congruence.
+  rewrite H. rewrite Val.add_assoc; auto.
+  rewrite H; rewrite H0. repeat rewrite shift_symbol_address. auto.
+  rewrite H; rewrite H0. rewrite Int.add_assoc. rewrite Int.add_permut. repeat rewrite shift_symbol_address.
+  rewrite Val.add_assoc. rewrite Val.add_permut. auto.
+  rewrite H; rewrite H0. repeat rewrite Val.add_assoc. rewrite Int.add_assoc. auto.
+  rewrite H; rewrite H0. repeat rewrite Val.add_assoc. rewrite Val.add_permut. 
+  rewrite Int.add_assoc. auto.
+  rewrite H0. rewrite shift_symbol_address. repeat rewrite Val.add_assoc. 
+  decEq; decEq. apply Val.add_commut.
+  rewrite H. rewrite shift_symbol_address. repeat rewrite Val.add_assoc.
+  rewrite (Val.add_permut (rs#r1)). decEq; decEq. apply Val.add_commut.
+  rewrite H0. rewrite Val.add_assoc. rewrite Val.add_permut. auto.
+  rewrite H. rewrite Val.add_assoc. auto.
+  rewrite H; rewrite H0. rewrite Int.add_assoc. repeat rewrite shift_symbol_address. auto.
+  rewrite H0. rewrite shift_symbol_address. rewrite Val.add_assoc. decEq; decEq. apply Val.add_commut.
+  rewrite H. auto.
+  rewrite H. rewrite shift_symbol_address. auto.
+  rewrite H. rewrite shift_symbol_address. rewrite Int.mul_commut; auto.
   auto.
 Qed.
 
+Lemma make_addimm_correct:
+  forall n r,
+  let (op, args) := make_addimm n r in
+  exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.add rs#r (Vint n)) v.
+Proof.
+  intros. unfold make_addimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. 
+  subst. exists (rs#r); split; auto. destruct (rs#r); simpl; auto; rewrite Int.add_zero; auto.
+  exists (Val.add rs#r (Vint n)); auto.
+Qed.
+  
 Lemma make_shlimm_correct:
-  forall n r v,
-  let (op, args) := make_shlimm n r in
-  eval_operation ge sp Oshl (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
+  forall n r1,
+  let (op, args) := make_shlimm n r1 in
+  exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.shl rs#r1 (Vint n)) v.
 Proof.
   intros; unfold make_shlimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
-  subst n. simpl in *. FuncInv. rewrite Int.shl_zero in H. congruence.
-  simpl in *. auto.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shl_zero. auto.
+  econstructor; split. simpl. eauto. auto.
 Qed.
 
 Lemma make_shrimm_correct:
-  forall n r v,
-  let (op, args) := make_shrimm n r in
-  eval_operation ge sp Oshr (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
+  forall n r1,
+  let (op, args) := make_shrimm n r1 in
+  exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.shr rs#r1 (Vint n)) v.
 Proof.
   intros; unfold make_shrimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
-  subst n. simpl in *. FuncInv. rewrite Int.shr_zero in H. congruence.
-  assumption.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shr_zero. auto.
+  econstructor; split; eauto. simpl. auto.
 Qed.
 
 Lemma make_shruimm_correct:
-  forall n r v,
-  let (op, args) := make_shruimm n r in
-  eval_operation ge sp Oshru (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
+  forall n r1,
+  let (op, args) := make_shruimm n r1 in
+  exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.shru rs#r1 (Vint n)) v.
 Proof.
   intros; unfold make_shruimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
-  subst n. simpl in *. FuncInv. rewrite Int.shru_zero in H. congruence.
-  assumption.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shru_zero. auto.
+  econstructor; split; eauto. simpl. congruence.
 Qed.
 
 Lemma make_mulimm_correct:
-  forall n r v,
-  let (op, args) := make_mulimm n r in
-  eval_operation ge sp Omul (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
+  forall n r1,
+  let (op, args) := make_mulimm n r1 in
+  exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.mul rs#r1 (Vint n)) v.
 Proof.
   intros; unfold make_mulimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
-  subst n. simpl in H0. FuncInv. rewrite Int.mul_zero in H. simpl. congruence.
-  generalize (Int.eq_spec n Int.one); case (Int.eq n Int.one); intros.
-  subst n. simpl in H1. simpl. FuncInv. rewrite Int.mul_one in H0. congruence.
-  caseEq (Int.is_power2 n); intros.
-  replace (eval_operation ge sp Omul (rs # r :: Vint n :: nil) m)
-     with (eval_operation ge sp Oshl (rs # r :: Vint i :: nil) m).
-  apply make_shlimm_correct. 
-  simpl. generalize (Int.is_power2_range _ _ H1). 
-  change (Z_of_nat Int.wordsize) with 32. intro. rewrite H2.
-  destruct rs#r; auto. rewrite (Int.mul_pow2 i0 _ _ H1). auto.
-  exact H2.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (Vint Int.zero); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.mul_zero; auto.
+  predSpec Int.eq Int.eq_spec n Int.one; intros. subst.
+  exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.mul_one; auto.
+  destruct (Int.is_power2 n) as []_eqn; intros.
+  rewrite (Val.mul_pow2 rs#r1 _ _ Heqo). apply make_shlimm_correct; auto. 
+  econstructor; split; eauto. auto. 
+Qed.
+
+Lemma make_divimm_correct:
+  forall n r1 r2 v,
+  Val.divs rs#r1 rs#r2 = Some v ->
+  rs#r2 = Vint n ->
+  let (op, args) := make_divimm n r1 r2 in
+  exists w, eval_operation ge sp op rs##args m = Some w /\ Val.lessdef v w.
+Proof.
+  intros; unfold make_divimm.
+  destruct (Int.is_power2 n) as []_eqn.
+  destruct (Int.ltu i (Int.repr 31)) as []_eqn.
+  exists v; split; auto. simpl. eapply Val.divs_pow2; eauto. congruence. 
+  exists v; auto.
+  exists v; auto.
+Qed.
+
+Lemma make_divuimm_correct:
+  forall n r1 r2 v,
+  Val.divu rs#r1 rs#r2 = Some v ->
+  rs#r2 = Vint n ->
+  let (op, args) := make_divuimm n r1 r2 in
+  exists w, eval_operation ge sp op rs##args m = Some w /\ Val.lessdef v w.
+Proof.
+  intros; unfold make_divuimm.
+  destruct (Int.is_power2 n) as []_eqn.
+  replace v with (Val.shru rs#r1 (Vint i)). 
+  eapply make_shruimm_correct; eauto.
+  eapply Val.divu_pow2; eauto. congruence.
+  exists v; auto.
+Qed.
+
+Lemma make_moduimm_correct:
+  forall n r1 r2 v,
+  Val.modu rs#r1 rs#r2 = Some v ->
+  rs#r2 = Vint n ->
+  let (op, args) := make_moduimm n r1 r2 in
+  exists w, eval_operation ge sp op rs##args m = Some w /\ Val.lessdef v w.
+Proof.
+  intros; unfold make_moduimm.
+  destruct (Int.is_power2 n) as []_eqn.
+  exists v; split; auto. simpl. decEq. eapply Val.modu_pow2; eauto. congruence.
+  exists v; auto.
 Qed.
 
 Lemma make_andimm_correct:
-  forall n r v,
+  forall n r,
   let (op, args) := make_andimm n r in
-  eval_operation ge sp Oand (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
+  exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.and rs#r (Vint n)) v.
 Proof.
   intros; unfold make_andimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
-  subst n. simpl in *. FuncInv. rewrite Int.and_zero in H. congruence.
-  generalize (Int.eq_spec n Int.mone); case (Int.eq n Int.mone); intros.
-  subst n. simpl in *. FuncInv. rewrite Int.and_mone in H0. congruence.
-  exact H1.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros.
+  subst n. exists (Vint Int.zero); split; auto. destruct (rs#r); simpl; auto. rewrite Int.and_zero; auto.
+  predSpec Int.eq Int.eq_spec n Int.mone; intros.
+  subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.and_mone; auto.
+  econstructor; split; eauto. auto. 
 Qed.
 
 Lemma make_orimm_correct:
-  forall n r v,
+  forall n r,
   let (op, args) := make_orimm n r in
-  eval_operation ge sp Oor (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
+  exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.or rs#r (Vint n)) v.
 Proof.
   intros; unfold make_orimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
-  subst n. simpl in *. FuncInv. rewrite Int.or_zero in H. congruence.
-  generalize (Int.eq_spec n Int.mone); case (Int.eq n Int.mone); intros.
-  subst n. simpl in *. FuncInv. rewrite Int.or_mone in H0. congruence.
-  exact H1.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros.
+  subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.or_zero; auto.
+  predSpec Int.eq Int.eq_spec n Int.mone; intros.
+  subst n. exists (Vint Int.mone); split; auto. destruct (rs#r); simpl; auto. rewrite Int.or_mone; auto.
+  econstructor; split; eauto. auto. 
 Qed.
 
 Lemma make_xorimm_correct:
-  forall n r v,
+  forall n r,
   let (op, args) := make_xorimm n r in
-  eval_operation ge sp Oxor (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
+  exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.xor rs#r (Vint n)) v.
 Proof.
   intros; unfold make_xorimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
-  subst n. simpl in *. FuncInv. rewrite Int.xor_zero in H. congruence.
-  exact H0.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros.
+  subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.xor_zero; auto.
+  econstructor; split; eauto. auto. 
 Qed.
 
 Lemma op_strength_reduction_correct:
-  forall op args v,
-  let (op', args') := op_strength_reduction app op args in
+  forall op args vl v,
+  vl = approx_regs app args ->
   eval_operation ge sp op rs##args m = Some v ->
-  eval_operation ge sp op' rs##args' m = Some v.
+  let (op', args') := op_strength_reduction op args vl in
+  exists w, eval_operation ge sp op' rs##args' m = Some w /\ Val.lessdef v w.
 Proof.
-  intros; unfold op_strength_reduction;
-  case (op_strength_reduction_match op args); intros; simpl List.map.
-  (* Osub *)
-  caseEq (intval app r2); intros.
-  rewrite (intval_correct _ _ H).
-  unfold make_addimm. generalize (Int.eq_spec (Int.neg i) Int.zero). 
-  destruct (Int.eq (Int.neg i) (Int.zero)); intros. 
-  assert (i = Int.zero). rewrite <- (Int.neg_involutive i). rewrite H0. reflexivity.
-  subst i. simpl in *. destruct (rs#r1); inv H1; rewrite Int.sub_zero_l; auto.
-  simpl in *. destruct (rs#r1); inv H1; rewrite Int.sub_add_opp; auto.
-  auto.
-  (* Omul *)
-  caseEq (intval app r2); intros.
-  rewrite (intval_correct _ _ H). apply make_mulimm_correct.
-  assumption.
-  (* Odiv *)
-  caseEq (intval app r2); intros.
-  caseEq (Int.is_power2 i); intros.
-  caseEq (Int.ltu i0 (Int.repr 31)); intros.
-  rewrite (intval_correct _ _ H) in H2.   
-  simpl in *; FuncInv. destruct (Int.eq i Int.zero). congruence.
-  rewrite H1. rewrite (Int.divs_pow2 i1 _ _ H0) in H2. auto.
-  assumption.
-  assumption.
-  assumption.
-  (* Odivu *)
-  caseEq (intval app r2); intros.
-  caseEq (Int.is_power2 i); intros.
-  rewrite (intval_correct _ _ H).
-  replace (eval_operation ge sp Odivu (rs # r1 :: Vint i :: nil) m)
-     with (eval_operation ge sp Oshru (rs # r1 :: Vint i0 :: nil) m).
-  apply make_shruimm_correct. 
-  simpl. destruct rs#r1; auto. 
-  rewrite (Int.is_power2_range _ _ H0). 
-  generalize (Int.eq_spec i Int.zero); case (Int.eq i Int.zero); intros.
-  subst i. discriminate. 
-  rewrite (Int.divu_pow2 i1 _ _ H0). auto.
-  assumption.
-  assumption.
-  (* Omodu *)
-  caseEq (intval app r2); intros.
-  caseEq (Int.is_power2 i); intros.
-  rewrite (intval_correct _ _ H) in H1.   
-  simpl in *; FuncInv. destruct (Int.eq i Int.zero). congruence.
-  rewrite (Int.modu_and i1 _ _ H0) in H1. auto.
-  assumption.
-  assumption.
-
-  (* Oand *)
-  caseEq (intval app r2); intros.
-  rewrite (intval_correct _ _ H). apply make_andimm_correct.
-  assumption.
-  (* Oor *)
-  caseEq (intval app r2); intros.
-  rewrite (intval_correct _ _ H). apply make_orimm_correct.
-  assumption.
-  (* Oxor *)
-  caseEq (intval app r2); intros.
-  rewrite (intval_correct _ _ H). apply make_xorimm_correct.
-  assumption.
-  (* Oshl *)
-  caseEq (intval app r2); intros.
-  caseEq (Int.ltu i Int.iwordsize); intros.
-  rewrite (intval_correct _ _ H). apply make_shlimm_correct.
-  assumption.
-  assumption.
-  (* Oshr *)
-  caseEq (intval app r2); intros.
-  caseEq (Int.ltu i Int.iwordsize); intros.
-  rewrite (intval_correct _ _ H). apply make_shrimm_correct.
-  assumption.
-  assumption.
-  (* Oshru *)
-  caseEq (intval app r2); intros.
-  caseEq (Int.ltu i Int.iwordsize); intros.
-  rewrite (intval_correct _ _ H). apply make_shruimm_correct.
-  assumption.
-  assumption.
-  (* Olea *)
-  generalize (addr_strength_reduction_correct addr args0). 
-  destruct (addr_strength_reduction app addr args0) as [addr' args'].
-  intros. simpl in *. congruence.
-  (* Ocmp *)
-  generalize (cond_strength_reduction_correct c args0).
-  destruct (cond_strength_reduction app c args0).
-  simpl. intro. rewrite H. auto.
-  (* default *)
-  assumption.
+  intros until v; unfold op_strength_reduction;
+  case (op_strength_reduction_match op args vl); simpl; intros.
+(* sub *)
+  InvApproxRegs. SimplVMA. inv H0; rewrite H. rewrite Val.sub_add_opp. apply make_addimm_correct; auto. 
+(* mul *)
+  InvApproxRegs. SimplVMA. inv H0; rewrite H. apply make_mulimm_correct; auto.
+(* divs *) 
+  assert (rs#r2 = Vint n2). clear H0. InvApproxRegs; SimplVMA; auto.
+  apply make_divimm_correct; auto.
+(* divu *) 
+  assert (rs#r2 = Vint n2). clear H0. InvApproxRegs; SimplVMA; auto.
+  apply make_divuimm_correct; auto.
+(* modu *) 
+  assert (rs#r2 = Vint n2). clear H0. InvApproxRegs; SimplVMA; auto.
+  apply make_moduimm_correct; auto.
+(* and *)
+  InvApproxRegs. SimplVMA. inv H0; rewrite H. apply make_andimm_correct; auto.
+(* or *)
+  InvApproxRegs. SimplVMA. inv H0; rewrite H. apply make_orimm_correct; auto.
+(* xor *)
+  InvApproxRegs. SimplVMA. inv H0; rewrite H. apply make_xorimm_correct; auto.
+(* shl *)
+  InvApproxRegs. SimplVMA. inv H0; rewrite H. apply make_shlimm_correct; auto.
+(* shr *)
+  InvApproxRegs. SimplVMA. inv H0; rewrite H. apply make_shrimm_correct; auto.
+(* shru *)
+  InvApproxRegs. SimplVMA. inv H0; rewrite H. apply make_shruimm_correct; auto.
+(* lea *)
+  generalize (addr_strength_reduction_correct addr args0 vl0 H). 
+  destruct (addr_strength_reduction addr args0 vl0) as [addr' args'].
+  intro EQ. exists v; split; auto. simpl. congruence.
+(* cond *)
+  generalize (cond_strength_reduction_correct c args0 vl0 H). 
+  destruct (cond_strength_reduction c args0 vl0) as [c' args']; intros.
+  rewrite <- H1 in H0; auto. econstructor; split; eauto.
+(* default *)
+  exists v; auto.
 Qed.
 
 End STRENGTH_REDUCTION.
diff --git a/ia32/Op.v b/ia32/Op.v
index 6c301a8..6389567 100644
--- a/ia32/Op.v
+++ b/ia32/Op.v
@@ -114,6 +114,7 @@ Inductive operation : Type :=
 (** Derived operators. *)
 
 Definition Oaddrsymbol (id: ident) (ofs: int) : operation := Olea (Aglobal id ofs).
+Definition Oaddrstack (ofs: int) : operation := Olea (Ainstack ofs).
 Definition Oaddimm (n: int) : operation := Olea (Aindexed n).
 
 (** Comparison functions (used in module [CSE]). *)
@@ -136,97 +137,52 @@ Proof.
   apply eq_addressing.
 Qed.
 
-(** Evaluation of conditions, operators and addressing modes applied
-  to lists of values.  Return [None] when the computation is undefined:
-  wrong number of arguments, arguments of the wrong types, undefined 
-  operations such as division by zero.  [eval_condition] returns a boolean,
-  [eval_operation] and [eval_addressing] return a value. *)
+(** * Evaluation functions *)
 
-Definition eval_compare_mismatch (c: comparison) : option bool :=
-  match c with Ceq => Some false | Cne => Some true | _ => None end.
+Definition symbol_address (F V: Type) (genv: Genv.t F V) (id: ident) (ofs: int) : val :=
+  match Genv.find_symbol genv id with
+  | Some b => Vptr b ofs
+  | None => Vundef
+  end.
 
-Definition eval_compare_null (c: comparison) (n: int) : option bool :=
-  if Int.eq n Int.zero then eval_compare_mismatch c else None.
+(** Evaluation of conditions, operators and addressing modes applied
+  to lists of values.  Return [None] when the computation can trigger an
+  error, e.g. integer division by zero.  [eval_condition] returns a boolean,
+  [eval_operation] and [eval_addressing] return a value. *)
 
-Definition eval_condition (cond: condition) (vl: list val) (m: mem):
-               option bool :=
+Definition eval_condition (cond: condition) (vl: list val) (m: mem): option bool :=
   match cond, vl with
-  | Ccomp c, Vint n1 :: Vint n2 :: nil =>
-      Some (Int.cmp c n1 n2)
-  | Ccompu c, Vint n1 :: Vint n2 :: nil =>
-      Some (Int.cmpu c n1 n2)
-  | Ccompu c, Vptr b1 n1 :: Vptr b2 n2 :: nil =>
-      if Mem.valid_pointer m b1 (Int.unsigned n1)
-      && Mem.valid_pointer m b2 (Int.unsigned n2) then
-        if eq_block b1 b2
-        then Some (Int.cmpu c n1 n2)
-        else eval_compare_mismatch c
-      else None
-  | Ccompu c, Vptr b1 n1 :: Vint n2 :: nil =>
-      eval_compare_null c n2
-  | Ccompu c, Vint n1 :: Vptr b2 n2 :: nil =>
-      eval_compare_null c n1
-  | Ccompimm c n, Vint n1 :: nil =>
-      Some (Int.cmp c n1 n)
-  | Ccompuimm c n, Vint n1 :: nil =>
-      Some (Int.cmpu c n1 n)
-  | Ccompuimm c n, Vptr b1 n1 :: nil =>
-      eval_compare_null c n
-  | Ccompf c, Vfloat f1 :: Vfloat f2 :: nil =>
-      Some (Float.cmp c f1 f2)
-  | Cnotcompf c, Vfloat f1 :: Vfloat f2 :: nil =>
-      Some (negb (Float.cmp c f1 f2))
-  | Cmaskzero n, Vint n1 :: nil =>
-      Some (Int.eq (Int.and n1 n) Int.zero)
-  | Cmasknotzero n, Vint n1 :: nil =>
-      Some (negb (Int.eq (Int.and n1 n) Int.zero))
-  | _, _ =>
-      None
-  end.
-
-Definition offset_sp (sp: val) (delta: int) : option val :=
-  match sp with
-  | Vptr b n => Some (Vptr b (Int.add n delta))
-  | _ => None
+  | Ccomp c, v1 :: v2 :: nil => Val.cmp_bool c v1 v2
+  | Ccompu c, v1 :: v2 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 v2
+  | Ccompimm c n, v1 :: nil => Val.cmp_bool c v1 (Vint n)
+  | Ccompuimm c n, v1 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 (Vint n)
+  | Ccompf c, v1 :: v2 :: nil => Val.cmpf_bool c v1 v2
+  | Cnotcompf c, v1 :: v2 :: nil => option_map negb (Val.cmpf_bool c v1 v2)
+  | Cmaskzero n, Vint n1 :: nil => Some (Int.eq (Int.and n1 n) Int.zero)
+  | Cmasknotzero n, Vint n1 :: nil => Some (negb (Int.eq (Int.and n1 n) Int.zero))
+  | _, _ => None
   end.
 
 Definition eval_addressing
     (F V: Type) (genv: Genv.t F V) (sp: val)
     (addr: addressing) (vl: list val) : option val :=
   match addr, vl with
-  | Aindexed n, Vint n1 :: nil =>
-      Some (Vint (Int.add n1 n))
-  | Aindexed n, Vptr b1 n1 :: nil =>
-      Some (Vptr b1 (Int.add n1 n))
-  | Aindexed2 n, Vint n1 :: Vint n2 :: nil =>
-      Some (Vint (Int.add (Int.add n1 n2) n))
-  | Aindexed2 n, Vptr b1 n1 :: Vint n2 :: nil =>
-      Some (Vptr b1 (Int.add (Int.add n1 n2) n))
-  | Aindexed2 n, Vint n1 :: Vptr b2 n2 :: nil =>
-      Some (Vptr b2 (Int.add (Int.add n2 n1) n))
-  | Ascaled sc ofs, Vint n1 :: nil =>
-      Some (Vint (Int.add (Int.mul n1 sc) ofs))
-  | Aindexed2scaled sc ofs, Vint n1 :: Vint n2 :: nil =>
-      Some (Vint (Int.add n1 (Int.add (Int.mul n2 sc) ofs)))
-  | Aindexed2scaled sc ofs, Vptr b1 n1 :: Vint n2 :: nil =>
-      Some (Vptr b1 (Int.add n1 (Int.add (Int.mul n2 sc) ofs)))
+  | Aindexed n, v1::nil =>
+      Some (Val.add v1 (Vint n))
+  | Aindexed2 n, v1::v2::nil =>
+      Some (Val.add (Val.add v1 v2) (Vint n))
+  | Ascaled sc ofs, v1::nil =>
+      Some (Val.add (Val.mul v1 (Vint sc)) (Vint ofs))
+  | Aindexed2scaled sc ofs, v1::v2::nil =>
+      Some(Val.add v1 (Val.add (Val.mul v2 (Vint sc)) (Vint ofs)))
   | Aglobal s ofs, nil =>
-      match Genv.find_symbol genv s with
-      | None => None
-      | Some b => Some (Vptr b ofs)
-      end
-  | Abased s ofs, Vint n1 :: nil =>
-      match Genv.find_symbol genv s with
-      | None => None
-      | Some b => Some (Vptr b (Int.add ofs n1))
-      end
-  | Abasedscaled sc s ofs, Vint n1 :: nil =>
-      match Genv.find_symbol genv s with
-      | None => None
-      | Some b => Some (Vptr b (Int.add ofs (Int.mul n1 sc)))
-      end
+      Some (symbol_address genv s ofs)
+  | Abased s ofs, v1::nil =>
+      Some (Val.add (symbol_address genv s ofs) v1)
+  | Abasedscaled sc s ofs, v1::nil =>
+      Some (Val.add (symbol_address genv s ofs) (Val.mul v1 (Vint sc)))
   | Ainstack ofs, nil =>
-      offset_sp sp ofs
+      Some(Val.add sp (Vint ofs))
   | _, _ => None
   end.
 
@@ -241,78 +197,42 @@ Definition eval_operation
   | Ocast8unsigned, v1 :: nil => Some (Val.zero_ext 8 v1)
   | Ocast16signed, v1 :: nil => Some (Val.sign_ext 16 v1)
   | Ocast16unsigned, v1 :: nil => Some (Val.zero_ext 16 v1)
-  | Oneg, Vint n1 :: nil => Some (Vint (Int.neg n1))
-  | Osub, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.sub n1 n2))
-  | Osub, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.sub n1 n2))
-  | Osub, Vptr b1 n1 :: Vptr b2 n2 :: nil =>
-      if eq_block b1 b2 then Some (Vint (Int.sub n1 n2)) else None
-  | Omul, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.mul n1 n2))
-  | Omulimm n, Vint n1 :: nil => Some (Vint (Int.mul n1 n))
-  | Odiv, Vint n1 :: Vint n2 :: nil =>
-      if Int.eq n2 Int.zero then None else Some (Vint (Int.divs n1 n2))
-  | Odivu, Vint n1 :: Vint n2 :: nil =>
-      if Int.eq n2 Int.zero then None else Some (Vint (Int.divu n1 n2))
-  | Omod, Vint n1 :: Vint n2 :: nil =>
-      if Int.eq n2 Int.zero then None else Some (Vint (Int.mods n1 n2))
-  | Omodu, Vint n1 :: Vint n2 :: nil =>
-      if Int.eq n2 Int.zero then None else Some (Vint (Int.modu n1 n2))
-  | Oand, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.and n1 n2))
-  | Oandimm n, Vint n1 :: nil => Some (Vint (Int.and n1 n))
-  | Oor, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.or n1 n2))
-  | Oorimm n, Vint n1 :: nil => Some (Vint (Int.or n1 n))
-  | Oxor, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.xor n1 n2))
-  | Oxorimm n, Vint n1 :: nil => Some (Vint (Int.xor n1 n))
-  | Oshl, Vint n1 :: Vint n2 :: nil =>
-      if Int.ltu n2 Int.iwordsize then Some (Vint (Int.shl n1 n2)) else None
-  | Oshlimm n, Vint n1 :: nil =>
-      if Int.ltu n Int.iwordsize then Some (Vint (Int.shl n1 n)) else None
-  | Oshr, Vint n1 :: Vint n2 :: nil =>
-      if Int.ltu n2 Int.iwordsize then Some (Vint (Int.shr n1 n2)) else None
-  | Oshrimm n, Vint n1 :: nil =>
-      if Int.ltu n Int.iwordsize then Some (Vint (Int.shr n1 n)) else None
-  | Oshrximm n, Vint n1 :: nil =>
-      if Int.ltu n (Int.repr 31) then Some (Vint (Int.shrx n1 n)) else None
-  | Oshru, Vint n1 :: Vint n2 :: nil =>
-      if Int.ltu n2 Int.iwordsize then Some (Vint (Int.shru n1 n2)) else None
-  | Oshruimm n, Vint n1 :: nil =>
-      if Int.ltu n Int.iwordsize then Some (Vint (Int.shru n1 n)) else None
-  | Ororimm n, Vint n1 :: nil =>
-      if Int.ltu n Int.iwordsize then Some (Vint (Int.ror n1 n)) else None
-  | Olea addr, _ =>
-      eval_addressing genv sp addr vl
-  | Onegf, Vfloat f1 :: nil => Some (Vfloat (Float.neg f1))
-  | Oabsf, Vfloat f1 :: nil => Some (Vfloat (Float.abs f1))
-  | Oaddf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.add f1 f2))
-  | Osubf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.sub f1 f2))
-  | Omulf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.mul f1 f2))
-  | Odivf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.div f1 f2))
-  | Osingleoffloat, v1 :: nil =>
-      Some (Val.singleoffloat v1)
-  | Ointoffloat, Vfloat f1 :: nil => 
-      option_map Vint (Float.intoffloat f1)
-  | Ofloatofint, Vint n1 :: nil => 
-      Some (Vfloat (Float.floatofint n1))
-  | Ocmp c, _ =>
-      match eval_condition c vl m with
-      | None => None
-      | Some false => Some Vfalse
-      | Some true => Some Vtrue
-      end
+  | Oneg, v1::nil => Some (Val.neg v1)
+  | Osub, v1::v2::nil => Some (Val.sub v1 v2)
+  | Omul, v1::v2::nil => Some (Val.mul v1 v2)
+  | Omulimm n, v1::nil => Some (Val.mul v1 (Vint n))
+  | Odiv, v1::v2::nil => Val.divs v1 v2
+  | Odivu, v1::v2::nil => Val.divu v1 v2
+  | Omod, v1::v2::nil => Val.mods v1 v2
+  | Omodu, v1::v2::nil => Val.modu v1 v2
+  | Oand, v1::v2::nil => Some(Val.and v1 v2)
+  | Oandimm n, v1::nil => Some (Val.and v1 (Vint n))
+  | Oor, v1::v2::nil => Some(Val.or v1 v2)
+  | Oorimm n, v1::nil => Some (Val.or v1 (Vint n))
+  | Oxor, v1::v2::nil => Some(Val.xor v1 v2)
+  | Oxorimm n, v1::nil => Some (Val.xor v1 (Vint n))
+  | Oshl, v1::v2::nil => Some (Val.shl v1 v2)
+  | Oshlimm n, v1::nil => Some (Val.shl v1 (Vint n))
+  | Oshr, v1::v2::nil => Some (Val.shr v1 v2)
+  | Oshrimm n, v1::nil => Some (Val.shr v1 (Vint n))
+  | Oshrximm n, v1::nil => Val.shrx v1 (Vint n)
+  | Oshru, v1::v2::nil => Some (Val.shru v1 v2)
+  | Oshruimm n, v1::nil => Some (Val.shru v1 (Vint n))
+  | Ororimm n, v1::nil => Some (Val.ror v1 (Vint n))
+  | Olea addr, _ => eval_addressing genv sp addr vl
+  | Onegf, v1::nil => Some(Val.negf v1)
+  | Oabsf, v1::nil => Some(Val.absf v1)
+  | Oaddf, v1::v2::nil => Some(Val.addf v1 v2)
+  | Osubf, v1::v2::nil => Some(Val.subf v1 v2)
+  | Omulf, v1::v2::nil => Some(Val.mulf v1 v2)
+  | Odivf, v1::v2::nil => Some(Val.divf v1 v2)
+  | Osingleoffloat, v1::nil => Some(Val.singleoffloat v1)
+  | Ointoffloat, v1::nil => Val.intoffloat v1
+  | Ofloatofint, v1::nil => Val.floatofint v1
+  | Ocmp c, _ => Some(Val.of_optbool (eval_condition c vl m))
   | _, _ => None
   end.
 
-Definition negate_condition (cond: condition): condition :=
-  match cond with
-  | Ccomp c => Ccomp(negate_comparison c)
-  | Ccompu c => Ccompu(negate_comparison c)
-  | Ccompimm c n => Ccompimm (negate_comparison c) n
-  | Ccompuimm c n => Ccompuimm (negate_comparison c) n
-  | Ccompf c => Cnotcompf c
-  | Cnotcompf c => Ccompf c
-  | Cmaskzero n => Cmasknotzero n
-  | Cmasknotzero n => Cmaskzero n
-  end.
-
 Ltac FuncInv :=
   match goal with
   | H: (match ?x with nil => _ | _ :: _ => _ end = Some _) |- _ =>
@@ -325,104 +245,7 @@ Ltac FuncInv :=
       idtac
   end.
 
-Remark eval_negate_compare_mismatch:
-  forall c b,
-  eval_compare_mismatch c = Some b ->
-  eval_compare_mismatch (negate_comparison c) = Some (negb b).
-Proof.
-  intros until b. unfold eval_compare_mismatch.
-  destruct c; intro EQ; inv EQ; auto. 
-Qed.
-
-Remark eval_negate_compare_null:
-  forall c i b,
-  eval_compare_null c i = Some b ->
-  eval_compare_null (negate_comparison c) i = Some (negb b).
-Proof.
-  unfold eval_compare_null; intros.
-  destruct (Int.eq i Int.zero). apply eval_negate_compare_mismatch; auto. congruence.
-Qed.
-
-Lemma eval_negate_condition:
-  forall (cond: condition) (vl: list val) (b: bool) (m: mem),
-  eval_condition cond vl m = Some b ->
-  eval_condition (negate_condition cond) vl m = Some (negb b).
-Proof.
-  intros. 
-  destruct cond; simpl in H; FuncInv; try subst b; simpl.
-  rewrite Int.negate_cmp. auto.
-  rewrite Int.negate_cmpu. auto.
-  apply eval_negate_compare_null; auto.
-  apply eval_negate_compare_null; auto.
-  destruct (Mem.valid_pointer m b0 (Int.unsigned i) &&
-           Mem.valid_pointer m b1 (Int.unsigned i0)); try discriminate.
-  destruct (eq_block b0 b1); try discriminate.
-  rewrite Int.negate_cmpu. congruence.
-  apply eval_negate_compare_mismatch; auto. 
-  rewrite Int.negate_cmp. auto.
-  rewrite Int.negate_cmpu. auto.
-  apply eval_negate_compare_null; auto.
-  auto.
-  rewrite negb_elim. auto.
-  auto.
-  rewrite negb_elim. auto.
-Qed.
-
-(** [eval_operation] and [eval_addressing] depend on a global environment
-  for resolving references to global symbols.  We show that they give
-  the same results if a global environment is replaced by another that
-  assigns the same addresses to the same symbols. *)
-
-Section GENV_TRANSF.
-
-Variable F1 F2 V1 V2: Type.
-Variable ge1: Genv.t F1 V1.
-Variable ge2: Genv.t F2 V2.
-Hypothesis agree_on_symbols:
-  forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s.
-
-Lemma eval_addressing_preserved:
-  forall sp addr vl,
-  eval_addressing ge2 sp addr vl = eval_addressing ge1 sp addr vl.
-Proof.
-  intros.
-  unfold eval_addressing; destruct addr; try rewrite agree_on_symbols;
-  reflexivity.
-Qed.
-
-Lemma eval_operation_preserved:
-  forall sp op vl m,
-  eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m.
-Proof.
-  intros.
-  unfold eval_operation; destruct op; try rewrite agree_on_symbols; auto.
-  apply eval_addressing_preserved.
-Qed.
-
-End GENV_TRANSF.
-
-(** Recognition of move operations. *)
-
-Definition is_move_operation
-    (A: Type) (op: operation) (args: list A) : option A :=
-  match op, args with
-  | Omove, arg :: nil => Some arg
-  | _, _ => None
-  end.
-
-Lemma is_move_operation_correct:
-  forall (A: Type) (op: operation) (args: list A) (a: A),
-  is_move_operation op args = Some a ->
-  op = Omove /\ args = a :: nil.
-Proof.
-  intros until a. unfold is_move_operation; destruct op;
-  try (intros; discriminate).
-  destruct args. intros; discriminate.
-  destruct args. intros. intuition congruence. 
-  intros; discriminate.
-Qed.
-
-(** Static typing of conditions, operators and addressing modes. *)
+(** * Static typing of conditions, operators and addressing modes. *)
 
 Definition type_of_condition (c: condition) : list typ :=
   match c with
@@ -505,12 +328,18 @@ Lemma type_of_addressing_sound:
   forall addr vl sp v,
   eval_addressing genv sp addr vl = Some v ->
   Val.has_type v Tint.
-Proof.
-  intros. destruct addr; simpl in H; FuncInv; try subst v; try exact I.
-  destruct (Genv.find_symbol genv i); inv H; exact I.
-  destruct (Genv.find_symbol genv i); inv H; exact I.
-  destruct (Genv.find_symbol genv i0); inv H; exact I.
-  unfold offset_sp in H. destruct sp; inv H; exact I.
+Proof with (try exact I).
+  intros. destruct addr; simpl in H; FuncInv; subst; simpl.
+  destruct v0...
+  destruct v0... destruct v1... destruct v1...
+  destruct v0...
+  destruct v0... destruct v1... destruct v1...
+  unfold symbol_address; destruct (Genv.find_symbol genv i)...
+  unfold symbol_address; destruct (Genv.find_symbol genv i)...
+  unfold symbol_address; destruct (Genv.find_symbol genv i)... destruct v0...
+  destruct v0...
+  unfold symbol_address; destruct (Genv.find_symbol genv i0)... destruct v0...
+  destruct sp...
 Qed.
 
 Lemma type_of_operation_sound:
@@ -518,46 +347,49 @@ Lemma type_of_operation_sound:
   op <> Omove ->
   eval_operation genv sp op vl m = Some v ->
   Val.has_type v (snd (type_of_operation op)).
-Proof.
+Proof with (try exact I).
   intros.
-  destruct op; simpl in H0; FuncInv; try subst v; try exact I.
+  destruct op; simpl in H0; FuncInv; subst; simpl.
   congruence.
-  destruct v0; exact I. 
-  destruct v0; exact I. 
-  destruct v0; exact I. 
-  destruct v0; exact I. 
-  destruct (eq_block b b0). injection H0; intro; subst v; exact I.
-  discriminate.
-  destruct (Int.eq i0 Int.zero). discriminate. 
-  injection H0; intro; subst v; exact I.
-  destruct (Int.eq i0 Int.zero). discriminate. 
-  injection H0; intro; subst v; exact I.
-  destruct (Int.eq i0 Int.zero). discriminate. 
-  injection H0; intro; subst v; exact I.
-  destruct (Int.eq i0 Int.zero). discriminate. 
-  injection H0; intro; subst v; exact I.
-  destruct (Int.ltu i0 Int.iwordsize).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i Int.iwordsize).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i0 Int.iwordsize).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i Int.iwordsize).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i (Int.repr 31)). 
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i0 Int.iwordsize).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i Int.iwordsize).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i Int.iwordsize).
-  injection H0; intro; subst v; exact I. discriminate.
-  simpl. eapply type_of_addressing_sound; eauto.
-  destruct v0; exact I.
-  destruct (Float.intoffloat f); simpl in H0; inv H0. exact I.
-  destruct (eval_condition c vl). 
-  destruct b; injection H0; intro; subst v; exact I.
-  discriminate.
+  exact I.
+  exact I.
+  destruct v0...
+  destruct v0...
+  destruct v0...
+  destruct v0...
+  destruct v0...
+  destruct v0; destruct v1... simpl. destruct (zeq b b0)...
+  destruct v0; destruct v1...
+  destruct v0...
+  destruct v0; destruct v1; simpl in *; inv H0. destruct (Int.eq i0 Int.zero); inv H2...
+  destruct v0; destruct v1; simpl in *; inv H0. destruct (Int.eq i0 Int.zero); inv H2...
+  destruct v0; destruct v1; simpl in *; inv H0. destruct (Int.eq i0 Int.zero); inv H2...
+  destruct v0; destruct v1; simpl in *; inv H0. destruct (Int.eq i0 Int.zero); inv H2...
+  destruct v0; destruct v1...
+  destruct v0...
+  destruct v0; destruct v1...
+  destruct v0...
+  destruct v0; destruct v1...
+  destruct v0...
+  destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
+  destruct v0; simpl... destruct (Int.ltu i Int.iwordsize)...
+  destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
+  destruct v0; simpl... destruct (Int.ltu i Int.iwordsize)...
+  destruct v0; simpl in H0; try discriminate. destruct (Int.ltu i (Int.repr 31)); inv H0...
+  destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
+  destruct v0; simpl... destruct (Int.ltu i Int.iwordsize)...
+  destruct v0; simpl... destruct (Int.ltu i Int.iwordsize)...
+  eapply type_of_addressing_sound; eauto.
+  destruct v0...
+  destruct v0...
+  destruct v0; destruct v1...
+  destruct v0; destruct v1...
+  destruct v0; destruct v1...
+  destruct v0; destruct v1...
+  destruct v0...
+  destruct v0; simpl in H0; inv H0. destruct (Float.intoffloat f); inv H2...
+  destruct v0; simpl in H0; inv H0...
+  destruct (eval_condition c vl m); simpl... destruct b... 
 Qed.
 
 Lemma type_of_chunk_correct:
@@ -575,292 +407,61 @@ Qed.
 
 End SOUNDNESS.
 
-(** Alternate definition of [eval_condition], [eval_op], [eval_addressing]
-  as total functions that return [Vundef] when not applicable
-  (instead of [None]).  Used in the proof of [Asmgen]. *)
+(** * Manipulating and transforming operations *)
 
-Section EVAL_OP_TOTAL.
-
-Variable F V: Type.
-Variable genv: Genv.t F V.
-
-Definition find_symbol_offset (id: ident) (ofs: int) : val :=
-  match Genv.find_symbol genv id with
-  | Some b => Vptr b ofs
-  | None => Vundef
-  end.
-
-Definition eval_condition_total (cond: condition) (vl: list val) : val :=
-  match cond, vl with
-  | Ccomp c, v1::v2::nil => Val.cmp c v1 v2
-  | Ccompu c, v1::v2::nil => Val.cmpu c v1 v2
-  | Ccompimm c n, v1::nil => Val.cmp c v1 (Vint n)
-  | Ccompuimm c n, v1::nil => Val.cmpu c v1 (Vint n)
-  | Ccompf c, v1::v2::nil => Val.cmpf c v1 v2
-  | Cnotcompf c, v1::v2::nil => Val.notbool(Val.cmpf c v1 v2)
-  | Cmaskzero n, v1::nil => Val.notbool (Val.and v1 (Vint n))
-  | Cmasknotzero n, v1::nil => Val.notbool(Val.notbool (Val.and v1 (Vint n)))
-  | _, _ => Vundef
-  end.
-
-Definition eval_addressing_total
-    (sp: val) (addr: addressing) (vl: list val) : val :=
-  match addr, vl with
-  | Aindexed n, v1::nil => Val.add v1 (Vint n)
-  | Aindexed2 n, v1::v2::nil => Val.add (Val.add v1 v2) (Vint n)
-  | Ascaled sc ofs, v1::nil => Val.add (Val.mul v1 (Vint sc)) (Vint ofs)
-  | Aindexed2scaled sc ofs, v1::v2::nil =>
-      Val.add v1 (Val.add (Val.mul v2 (Vint sc)) (Vint ofs))
-  | Aglobal s ofs, nil => find_symbol_offset s ofs
-  | Abased s ofs, v1::nil => Val.add (find_symbol_offset s ofs) v1
-  | Abasedscaled sc s ofs, v1::nil => Val.add (find_symbol_offset s ofs) (Val.mul v1 (Vint sc))
-  | Ainstack ofs, nil => Val.add sp (Vint ofs)
-  | _, _ => Vundef
-  end.
+(** Recognition of move operations. *)
 
-Definition eval_operation_total (sp: val) (op: operation) (vl: list val) : val :=
-  match op, vl with
-  | Omove, v1::nil => v1
-  | Ointconst n, nil => Vint n
-  | Ofloatconst n, nil => Vfloat n
-  | Ocast8signed, v1::nil => Val.sign_ext 8 v1
-  | Ocast8unsigned, v1::nil => Val.zero_ext 8 v1
-  | Ocast16signed, v1::nil => Val.sign_ext 16 v1
-  | Ocast16unsigned, v1::nil => Val.zero_ext 16 v1
-  | Oneg, v1::nil => Val.neg v1
-  | Osub, v1::v2::nil => Val.sub v1 v2
-  | Omul, v1::v2::nil => Val.mul v1 v2
-  | Omulimm n, v1::nil => Val.mul v1 (Vint n)
-  | Odiv, v1::v2::nil => Val.divs v1 v2
-  | Odivu, v1::v2::nil => Val.divu v1 v2
-  | Omod, v1::v2::nil => Val.mods v1 v2
-  | Omodu, v1::v2::nil => Val.modu v1 v2
-  | Oand, v1::v2::nil => Val.and v1 v2
-  | Oandimm n, v1::nil => Val.and v1 (Vint n)
-  | Oor, v1::v2::nil => Val.or v1 v2
-  | Oorimm n, v1::nil => Val.or v1 (Vint n)
-  | Oxor, v1::v2::nil => Val.xor v1 v2
-  | Oxorimm n, v1::nil => Val.xor v1 (Vint n)
-  | Oshl, v1::v2::nil => Val.shl v1 v2
-  | Oshlimm n, v1::nil => Val.shl v1 (Vint n)
-  | Oshr, v1::v2::nil => Val.shr v1 v2
-  | Oshrimm n, v1::nil => Val.shr v1 (Vint n)
-  | Oshrximm n, v1::nil => Val.shrx v1 (Vint n)
-  | Oshru, v1::v2::nil => Val.shru v1 v2
-  | Oshruimm n, v1::nil => Val.shru v1 (Vint n)
-  | Ororimm n, v1::nil => Val.ror v1 (Vint n)
-  | Olea addr, _ => eval_addressing_total sp addr vl
-  | Onegf, v1::nil => Val.negf v1
-  | Oabsf, v1::nil => Val.absf v1
-  | Oaddf, v1::v2::nil => Val.addf v1 v2
-  | Osubf, v1::v2::nil => Val.subf v1 v2
-  | Omulf, v1::v2::nil => Val.mulf v1 v2
-  | Odivf, v1::v2::nil => Val.divf v1 v2
-  | Osingleoffloat, v1::nil => Val.singleoffloat v1
-  | Ointoffloat, v1::nil => Val.intoffloat v1
-  | Ofloatofint, v1::nil => Val.floatofint v1
-  | Ocmp c, _ => eval_condition_total c vl
-  | _, _ => Vundef
+Definition is_move_operation
+    (A: Type) (op: operation) (args: list A) : option A :=
+  match op, args with
+  | Omove, arg :: nil => Some arg
+  | _, _ => None
   end.
 
-Lemma eval_compare_mismatch_weaken:
-  forall c b,
-  eval_compare_mismatch c = Some b ->
-  Val.cmp_mismatch c = Val.of_bool b.
-Proof.
-  unfold eval_compare_mismatch. intros. destruct c; inv H; auto.
-Qed.
-
-Lemma eval_compare_null_weaken:
-  forall n c b,
-  eval_compare_null c n = Some b ->
-  (if Int.eq n Int.zero then Val.cmp_mismatch c else Vundef) = Val.of_bool b.
-Proof.
-  unfold eval_compare_null.
-  intros. destruct (Int.eq n Int.zero). apply eval_compare_mismatch_weaken. auto.
-  discriminate.
-Qed.
-
-Lemma eval_condition_weaken:
-  forall c vl b m,
-  eval_condition c vl m = Some b ->
-  eval_condition_total c vl = Val.of_bool b.
-Proof.
-  intros. 
-  unfold eval_condition in H; destruct c; FuncInv;
-  try subst b; try reflexivity; simpl;
-  try (apply eval_compare_null_weaken; auto).
-  destruct (Mem.valid_pointer m b0 (Int.unsigned i) &&
-           Mem.valid_pointer m b1 (Int.unsigned i0)); try discriminate.
-  unfold eq_block in H. destruct (zeq b0 b1).
-  congruence.
-  apply eval_compare_mismatch_weaken; auto.
-  symmetry. apply Val.notbool_negb_1. 
-  symmetry. apply Val.notbool_negb_1. 
-Qed.
-
-Lemma eval_addressing_weaken:
-  forall sp addr vl v,
-  eval_addressing genv sp addr vl = Some v ->
-  eval_addressing_total sp addr vl = v.
-Proof.
-  intros.
-  unfold eval_addressing in H; destruct addr; FuncInv;
-  try subst v; simpl; try reflexivity.
-  unfold find_symbol_offset. destruct (Genv.find_symbol genv i); congruence.
-  unfold find_symbol_offset. destruct (Genv.find_symbol genv i); simpl; congruence.
-  unfold find_symbol_offset. destruct (Genv.find_symbol genv i0); simpl; congruence.
-  unfold offset_sp in H. destruct sp; simpl; congruence.
-Qed.
-
-Lemma eval_operation_weaken:
-  forall sp op vl v m,
-  eval_operation genv sp op vl m = Some v ->
-  eval_operation_total sp op vl = v.
-Proof.
-  intros.
-  unfold eval_operation in H; destruct op; FuncInv;
-  try subst v; try reflexivity; simpl.
-  unfold eq_block in H. destruct (zeq b b0); congruence.
-  destruct (Int.eq i0 Int.zero); congruence.
-  destruct (Int.eq i0 Int.zero); congruence.
-  destruct (Int.eq i0 Int.zero); congruence.
-  destruct (Int.eq i0 Int.zero); congruence.
-  destruct (Int.ltu i0 Int.iwordsize); congruence.
-  destruct (Int.ltu i Int.iwordsize); congruence.
-  destruct (Int.ltu i0 Int.iwordsize); congruence.
-  destruct (Int.ltu i Int.iwordsize); congruence.
-  unfold Int.ltu in *. destruct (zlt (Int.unsigned i) (Int.unsigned (Int.repr 31))).
-  rewrite zlt_true. congruence. eapply Zlt_trans. eauto. compute; auto.
-  congruence.
-  destruct (Int.ltu i0 Int.iwordsize); congruence.
-  destruct (Int.ltu i Int.iwordsize); congruence.
-  destruct (Int.ltu i Int.iwordsize); congruence.
-  apply eval_addressing_weaken; auto.
-  destruct (Float.intoffloat f); simpl in H; inv H. auto.
-  caseEq (eval_condition c vl m); intros; rewrite H0 in H.
-  replace v with (Val.of_bool b).
-  eapply eval_condition_weaken; eauto.
-  destruct b; simpl; congruence.
-  discriminate.
-Qed.
-
-Lemma eval_condition_total_is_bool:
-  forall cond vl, Val.is_bool (eval_condition_total cond vl).
+Lemma is_move_operation_correct:
+  forall (A: Type) (op: operation) (args: list A) (a: A),
+  is_move_operation op args = Some a ->
+  op = Omove /\ args = a :: nil.
 Proof.
-  intros; destruct cond;
-  destruct vl; try apply Val.undef_is_bool;
-  destruct vl; try apply Val.undef_is_bool;
-  try (destruct vl; try apply Val.undef_is_bool); simpl.
-  apply Val.cmp_is_bool.
-  apply Val.cmpu_is_bool.
-  apply Val.cmp_is_bool.
-  apply Val.cmpu_is_bool.
-  apply Val.cmpf_is_bool.
-  apply Val.notbool_is_bool.
-  apply Val.notbool_is_bool.
-  apply Val.notbool_is_bool.
+  intros until a. unfold is_move_operation; destruct op;
+  try (intros; discriminate).
+  destruct args. intros; discriminate.
+  destruct args. intros. intuition congruence. 
+  intros; discriminate.
 Qed.
 
-End EVAL_OP_TOTAL.
-
-(** Compatibility of the evaluation functions with the
-    ``is less defined'' relation over values. *)
-
-Section EVAL_LESSDEF.
-
-Variable F V: Type.
-Variable genv: Genv.t F V.
-
-Ltac InvLessdef :=
-  match goal with
-  | [ H: Val.lessdef (Vint _) _ |- _ ] =>
-      inv H; InvLessdef
-  | [ H: Val.lessdef (Vfloat _) _ |- _ ] =>
-      inv H; InvLessdef
-  | [ H: Val.lessdef (Vptr _ _) _ |- _ ] =>
-      inv H; InvLessdef
-  | [ H: Val.lessdef_list nil _ |- _ ] =>
-      inv H; InvLessdef
-  | [ H: Val.lessdef_list (_ :: _) _ |- _ ] =>
-      inv H; InvLessdef
-  | _ => idtac
-  end.
-
-Lemma eval_condition_lessdef:
-  forall cond vl1 vl2 b m1 m2,
-  Val.lessdef_list vl1 vl2 ->
-  Mem.extends m1 m2 ->
-  eval_condition cond vl1 m1 = Some b ->
-  eval_condition cond vl2 m2 = Some b.
-Proof.
-  intros. destruct cond; simpl in *; FuncInv; InvLessdef; auto.
-  destruct (Mem.valid_pointer m1 b0 (Int.unsigned i) &&
-            Mem.valid_pointer m1 b1 (Int.unsigned i0)) as [] _eqn; try discriminate.
-  destruct (andb_prop _ _ Heqb2) as [A B].
-  assert (forall b ofs, Mem.valid_pointer m1 b ofs = true -> Mem.valid_pointer m2 b ofs = true).
-    intros until ofs. repeat rewrite Mem.valid_pointer_nonempty_perm. 
-    apply Mem.perm_extends; auto.
-  rewrite (H _ _ A). rewrite (H _ _ B). auto. 
-Qed.
+(** [negate_condition cond] returns a condition that is logically
+  equivalent to the negation of [cond]. *)
 
-Ltac TrivialExists :=
-  match goal with
-  | [ |- exists v2, Some ?v1 = Some v2 /\ Val.lessdef ?v1 v2 ] =>
-      exists v1; split; [auto | constructor]
-  | _ => idtac
+Definition negate_condition (cond: condition): condition :=
+  match cond with
+  | Ccomp c => Ccomp(negate_comparison c)
+  | Ccompu c => Ccompu(negate_comparison c)
+  | Ccompimm c n => Ccompimm (negate_comparison c) n
+  | Ccompuimm c n => Ccompuimm (negate_comparison c) n
+  | Ccompf c => Cnotcompf c
+  | Cnotcompf c => Ccompf c
+  | Cmaskzero n => Cmasknotzero n
+  | Cmasknotzero n => Cmaskzero n
   end.
 
-Lemma eval_addressing_lessdef:
-  forall sp addr vl1 vl2 v1,
-  Val.lessdef_list vl1 vl2 ->
-  eval_addressing genv sp addr vl1 = Some v1 ->
-  exists v2, eval_addressing genv sp addr vl2 = Some v2 /\ Val.lessdef v1 v2.
-Proof.
-  intros. destruct addr; simpl in *; FuncInv; InvLessdef; TrivialExists.
-  destruct (Genv.find_symbol genv i); inv H0. TrivialExists.
-  destruct (Genv.find_symbol genv i); inv H0. TrivialExists.
-  destruct (Genv.find_symbol genv i0); inv H0. TrivialExists.
-  exists v1; auto.
-Qed.
-
-Lemma eval_operation_lessdef:
-  forall sp op vl1 vl2 v1 m1 m2,
-  Val.lessdef_list vl1 vl2 ->
-  Mem.extends m1 m2 ->
-  eval_operation genv sp op vl1 m1 = Some v1 ->
-  exists v2, eval_operation genv sp op vl2 m2 = Some v2 /\ Val.lessdef v1 v2.
+Lemma eval_negate_condition:
+  forall cond vl m b,
+  eval_condition cond vl m = Some b ->
+  eval_condition (negate_condition cond) vl m = Some (negb b).
 Proof.
-  intros. destruct op; simpl in *; FuncInv; InvLessdef; TrivialExists.
-  exists v2; auto.
-  exists (Val.sign_ext 8 v2); split. auto. apply Val.sign_ext_lessdef; auto.
-  exists (Val.zero_ext 8 v2); split. auto. apply Val.zero_ext_lessdef; auto.
-  exists (Val.sign_ext 16 v2); split. auto. apply Val.sign_ext_lessdef; auto.
-  exists (Val.zero_ext 16 v2); split. auto. apply Val.zero_ext_lessdef; auto.
-  destruct (eq_block b b0); inv H1. TrivialExists.
-  destruct (Int.eq i0 Int.zero); inv H1; TrivialExists.
-  destruct (Int.eq i0 Int.zero); inv H1; TrivialExists.
-  destruct (Int.eq i0 Int.zero); inv H1; TrivialExists.
-  destruct (Int.eq i0 Int.zero); inv H1; TrivialExists.
-  destruct (Int.ltu i0 Int.iwordsize); inv H1; TrivialExists.
-  destruct (Int.ltu i Int.iwordsize); inv H1; TrivialExists.
-  destruct (Int.ltu i0 Int.iwordsize); inv H1; TrivialExists.
-  destruct (Int.ltu i Int.iwordsize); inv H1; TrivialExists.
-  destruct (Int.ltu i (Int.repr 31)); inv H1; TrivialExists.
-  destruct (Int.ltu i0 Int.iwordsize); inv H1; TrivialExists.
-  destruct (Int.ltu i Int.iwordsize); inv H1; TrivialExists.
-  destruct (Int.ltu i Int.iwordsize); inv H1; TrivialExists.
-  eapply eval_addressing_lessdef; eauto.
-  exists (Val.singleoffloat v2); split. auto. apply Val.singleoffloat_lessdef; auto.
-  exists v1; split; auto. 
-  destruct (eval_condition c vl1 m1) as [] _eqn. 
-  rewrite (eval_condition_lessdef c H H0 Heqo).
-  destruct b; inv H1; TrivialExists.
-  discriminate.
+  intros. 
+  destruct cond; simpl in H; FuncInv; simpl.
+  rewrite Val.negate_cmp_bool; rewrite H; auto.
+  rewrite Val.negate_cmpu_bool; rewrite H; auto.
+  rewrite Val.negate_cmp_bool; rewrite H; auto.
+  rewrite Val.negate_cmpu_bool; rewrite H; auto.
+  rewrite H; auto.
+  destruct (Val.cmpf_bool c v v0); simpl in H; inv H. rewrite negb_elim; auto. 
+  rewrite H0; auto.
+  rewrite <- H0. rewrite negb_elim; auto.
 Qed.
 
-End EVAL_LESSDEF.
-
 (** Shifting stack-relative references.  This is used in [Stacking]. *)
 
 Definition shift_stack_addressing (delta: int) (addr: addressing) :=
@@ -887,132 +488,24 @@ Proof.
   intros. destruct op; auto. simpl. decEq. apply type_shift_stack_addressing. 
 Qed.
 
-(** Compatibility of the evaluation functions with memory injections. *)
-
-Section EVAL_INJECT.
-
-Variable F V: Type.
-Variable genv: Genv.t F V.
-Variable f: meminj.
-Hypothesis globals: meminj_preserves_globals genv f.
-Variable sp1: block.
-Variable sp2: block.
-Variable delta: Z.
-Hypothesis sp_inj: f sp1 = Some(sp2, delta).
-
-Ltac InvInject :=
-  match goal with
-  | [ H: val_inject _ (Vint _) _ |- _ ] =>
-      inv H; InvInject
-  | [ H: val_inject _ (Vfloat _) _ |- _ ] =>
-      inv H; InvInject
-  | [ H: val_inject _ (Vptr _ _) _ |- _ ] =>
-      inv H; InvInject
-  | [ H: val_list_inject _ nil _ |- _ ] =>
-      inv H; InvInject
-  | [ H: val_list_inject _ (_ :: _) _ |- _ ] =>
-      inv H; InvInject
-  | _ => idtac
-  end.
-
-Lemma eval_condition_inject:
-  forall cond vl1 vl2 b m1 m2,
-  val_list_inject f vl1 vl2 ->
-  Mem.inject f m1 m2 ->
-  eval_condition cond vl1 m1 = Some b ->
-  eval_condition cond vl2 m2 = Some b.
-Proof.
-  intros. destruct cond; simpl in *; FuncInv; InvInject; auto.
-  destruct (Mem.valid_pointer m1 b0 (Int.unsigned i)) as [] _eqn; try discriminate.
-  destruct (Mem.valid_pointer m1 b1 (Int.unsigned i0)) as [] _eqn; try discriminate.
-  simpl in H1.
-  exploit Mem.valid_pointer_inject_val. eauto. eexact Heqb0. econstructor; eauto. 
-  intros V1. rewrite V1.
-  exploit Mem.valid_pointer_inject_val. eauto. eexact Heqb2. econstructor; eauto. 
-  intros V2. rewrite V2.
-  simpl. 
-  destruct (eq_block b0 b1); inv H1.
-  rewrite H3 in H5; inv H5. rewrite dec_eq_true.
-  decEq. apply Int.translate_cmpu.
-  eapply Mem.valid_pointer_inject_no_overflow; eauto.
-  eapply Mem.valid_pointer_inject_no_overflow; eauto.
-  exploit Mem.different_pointers_inject; eauto. intros P.
-  destruct (eq_block b3 b4); auto.
-  destruct P. contradiction.
-  destruct c; unfold eval_compare_mismatch in *; inv H2. 
-  unfold Int.cmpu. rewrite Int.eq_false; auto. congruence. 
-  unfold Int.cmpu. rewrite Int.eq_false; auto. congruence.
-Qed.
-
-Ltac TrivialExists2 :=
-  match goal with
-  | [ |- exists v2, Some ?v1 = Some v2 /\ val_inject _ _ v2 ] =>
-      exists v1; split; [auto | econstructor; eauto]
-  | _ => idtac
-  end.
-
-Lemma eval_addressing_inject:
-  forall addr vl1 vl2 v1,
-  val_list_inject f vl1 vl2 ->
-  eval_addressing genv (Vptr sp1 Int.zero) addr vl1 = Some v1 ->
-  exists v2, 
-     eval_addressing genv (Vptr sp2 Int.zero) (shift_stack_addressing (Int.repr delta) addr) vl2 = Some v2
-  /\ val_inject f v1 v2.
+Lemma eval_shift_stack_addressing:
+  forall F V (ge: Genv.t F V) sp addr vl delta,
+  eval_addressing ge sp (shift_stack_addressing delta addr) vl =
+  eval_addressing ge (Val.add sp (Vint delta)) addr vl.
 Proof.
-  intros. destruct addr; simpl in *; FuncInv; InvInject; TrivialExists2.
-  repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. 
-  repeat rewrite Int.add_assoc. decEq. rewrite Int.add_commut. apply Int.add_assoc. 
-  repeat rewrite Int.add_assoc. decEq. rewrite Int.add_commut. apply Int.add_assoc. 
-  repeat rewrite Int.add_assoc. decEq. rewrite Int.add_commut. apply Int.add_assoc.
-  destruct (Genv.find_symbol genv i) as [] _eqn; inv H0.
-  TrivialExists2. eapply (proj1 globals); eauto. rewrite Int.add_zero; auto.
-  destruct (Genv.find_symbol genv i) as [] _eqn; inv H0.
-  TrivialExists2. eapply (proj1 globals); eauto. rewrite Int.add_zero; auto.
-  destruct (Genv.find_symbol genv i0) as [] _eqn; inv H0.
-  TrivialExists2. eapply (proj1 globals); eauto. rewrite Int.add_zero; auto.
-  rewrite Int.add_assoc. decEq. apply Int.add_commut.
+  intros. destruct addr; simpl; auto.
+  rewrite Val.add_assoc. simpl. auto.
 Qed.
 
-Lemma eval_operation_inject:
-  forall op vl1 vl2 v1 m1 m2,
-  val_list_inject f vl1 vl2 ->
-  Mem.inject f m1 m2 ->
-  eval_operation genv (Vptr sp1 Int.zero) op vl1 m1 = Some v1 ->
-  exists v2,
-     eval_operation genv (Vptr sp2 Int.zero) (shift_stack_operation (Int.repr delta) op) vl2 m2 = Some v2
-  /\ val_inject f v1 v2.
+Lemma eval_shift_stack_operation:
+  forall F V (ge: Genv.t F V) sp op vl m delta,
+  eval_operation ge sp (shift_stack_operation delta op) vl m =
+  eval_operation ge (Val.add sp (Vint delta)) op vl m.
 Proof.
-  intros. destruct op; simpl in *; FuncInv; InvInject; TrivialExists2.
-  exists v'; auto.
-  exists (Val.sign_ext 8 v'); split; auto. inv H4; simpl; auto.
-  exists (Val.zero_ext 8 v'); split; auto. inv H4; simpl; auto.
-  exists (Val.sign_ext 16 v'); split; auto. inv H4; simpl; auto.
-  exists (Val.zero_ext 16 v'); split; auto. inv H4; simpl; auto.
-  rewrite Int.sub_add_l. auto.
-  destruct (eq_block b b0); inv H1. rewrite H3 in H5; inv H5. rewrite dec_eq_true.
-  rewrite Int.sub_shifted. TrivialExists2.
-  destruct (Int.eq i0 Int.zero); inv H1. TrivialExists2.
-  destruct (Int.eq i0 Int.zero); inv H1. TrivialExists2.
-  destruct (Int.eq i0 Int.zero); inv H1. TrivialExists2.
-  destruct (Int.eq i0 Int.zero); inv H1. TrivialExists2.
-  destruct (Int.ltu i0 Int.iwordsize); inv H1. TrivialExists2.
-  destruct (Int.ltu i Int.iwordsize); inv H1. TrivialExists2.
-  destruct (Int.ltu i0 Int.iwordsize); inv H1. TrivialExists2.
-  destruct (Int.ltu i Int.iwordsize); inv H1. TrivialExists2.
-  destruct (Int.ltu i (Int.repr 31)); inv H1. TrivialExists2.
-  destruct (Int.ltu i0 Int.iwordsize); inv H1. TrivialExists2.
-  destruct (Int.ltu i Int.iwordsize); inv H1. TrivialExists2.
-  destruct (Int.ltu i Int.iwordsize); inv H1. TrivialExists2.
-  eapply eval_addressing_inject; eauto.
-  exists (Val.singleoffloat v'); split; auto. inv H4; simpl; auto.
-  destruct (Float.intoffloat f0); simpl in *; inv H1. TrivialExists2.
-  destruct (eval_condition c vl1 m1) as [] _eqn; try discriminate.
-  exploit eval_condition_inject; eauto. intros EQ; rewrite EQ. 
-  destruct b; inv H1; TrivialExists2.
+  intros. destruct op; simpl; auto.
+  apply eval_shift_stack_addressing. 
 Qed.
 
-End EVAL_INJECT.
-
 (** Transformation of addressing modes with two operands or more
   into an equivalent arithmetic operation.  This is used in the [Reload]
   pass when a store instruction cannot be reloaded directly because
@@ -1037,6 +530,7 @@ Proof.
   intros. simpl. auto.
 Qed.
 
+
 (** Two-address operations.  Return [true] if the first argument and
   the result must be in the same location. *)
 
@@ -1109,7 +603,387 @@ Lemma op_depends_on_memory_correct:
   eval_operation ge sp op args m1 = eval_operation ge sp op args m2.
 Proof.
   intros until m2. destruct op; simpl; try congruence.
-  destruct c; simpl; congruence.
+  destruct c; simpl; try congruence. reflexivity. 
 Qed.
 
+(** * Invariance and compatibility properties. *)
+
+(** [eval_operation] and [eval_addressing] depend on a global environment
+  for resolving references to global symbols.  We show that they give
+  the same results if a global environment is replaced by another that
+  assigns the same addresses to the same symbols. *)
+
+Section GENV_TRANSF.
+
+Variable F1 F2 V1 V2: Type.
+Variable ge1: Genv.t F1 V1.
+Variable ge2: Genv.t F2 V2.
+Hypothesis agree_on_symbols:
+  forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s.
+
+Lemma eval_addressing_preserved:
+  forall sp addr vl,
+  eval_addressing ge2 sp addr vl = eval_addressing ge1 sp addr vl.
+Proof.
+  intros.
+  unfold eval_addressing, symbol_address; destruct addr; try rewrite agree_on_symbols;
+  reflexivity.
+Qed.
+
+Lemma eval_operation_preserved:
+  forall sp op vl m,
+  eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m.
+Proof.
+  intros.
+  unfold eval_operation; destruct op; auto.
+  apply eval_addressing_preserved.
+Qed.
+
+End GENV_TRANSF.
+
+(** Compatibility of the evaluation functions with value injections. *)
+
+Section EVAL_COMPAT.
+
+Variable F V: Type.
+Variable genv: Genv.t F V.
+Variable f: meminj.
+
+Hypothesis symbol_address_inj: 
+  forall id ofs,
+  val_inject f (symbol_address genv id ofs) (symbol_address genv id ofs).
+
+Variable m1: mem.
+Variable m2: mem.
+
+Hypothesis valid_pointer_inj:
+  forall b1 ofs b2 delta,
+  f b1 = Some(b2, delta) ->
+  Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true ->
+  Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true.
+
+Hypothesis valid_pointer_no_overflow:
+  forall b1 ofs b2 delta,
+  f b1 = Some(b2, delta) ->
+  Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true ->
+  0 <= Int.unsigned ofs + Int.unsigned (Int.repr delta) <= Int.max_unsigned.
+
+Hypothesis valid_different_pointers_inj:
+  forall b1 ofs1 b2 ofs2 b1' delta1 b2' delta2,
+  b1 <> b2 ->
+  Mem.valid_pointer m1 b1 (Int.unsigned ofs1) = true ->
+  Mem.valid_pointer m1 b2 (Int.unsigned ofs2) = true ->
+  f b1 = Some (b1', delta1) ->
+  f b2 = Some (b2', delta2) ->
+  b1' <> b2' \/
+  Int.unsigned (Int.add ofs1 (Int.repr delta1)) <> Int.unsigned (Int.add ofs2 (Int.repr delta2)).
+
+Ltac InvInject :=
+  match goal with
+  | [ H: val_inject _ (Vint _) _ |- _ ] =>
+      inv H; InvInject
+  | [ H: val_inject _ (Vfloat _) _ |- _ ] =>
+      inv H; InvInject
+  | [ H: val_inject _ (Vptr _ _) _ |- _ ] =>
+      inv H; InvInject
+  | [ H: val_list_inject _ nil _ |- _ ] =>
+      inv H; InvInject
+  | [ H: val_list_inject _ (_ :: _) _ |- _ ] =>
+      inv H; InvInject
+  | _ => idtac
+  end.
+
+Remark val_add_inj:
+  forall v1 v1' v2 v2',
+  val_inject f v1 v1' -> val_inject f v2 v2' -> val_inject f (Val.add v1 v2) (Val.add v1' v2').
+Proof.
+  intros. inv H; inv H0; simpl; econstructor; eauto. 
+  repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
+  repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
+Qed.
+
+Lemma eval_condition_inj:
+  forall cond vl1 vl2 b,
+  val_list_inject f vl1 vl2 ->
+  eval_condition cond vl1 m1 = Some b ->
+  eval_condition cond vl2 m2 = Some b.
+Proof.
+Opaque Int.add.
+  assert (CMPU:
+    forall c v1 v2 v1' v2' b,
+    val_inject f v1 v1' ->
+    val_inject f v2 v2' ->
+    Val.cmpu_bool (Mem.valid_pointer m1) c v1 v2 = Some b ->
+    Val.cmpu_bool (Mem.valid_pointer m2) c v1' v2' = Some b).
+  intros. inv H; simpl in H1; try discriminate; inv H0; simpl in H1; try discriminate; simpl; auto.
+  destruct (Mem.valid_pointer m1 b1 (Int.unsigned ofs1)) as []_eqn; try discriminate.
+  destruct (Mem.valid_pointer m1 b0 (Int.unsigned ofs0)) as []_eqn; try discriminate.
+  rewrite (valid_pointer_inj _ H2 Heqb4).
+  rewrite (valid_pointer_inj _ H Heqb0). simpl.
+  destruct (zeq b1 b0); simpl in H1.
+  inv H1. rewrite H in H2; inv H2. rewrite zeq_true. 
+  decEq. apply Int.translate_cmpu.
+  eapply valid_pointer_no_overflow; eauto.
+  eapply valid_pointer_no_overflow; eauto.
+  exploit valid_different_pointers_inj; eauto. intros P.
+  destruct (zeq b2 b3); auto.
+  destruct P. congruence. 
+  destruct c; simpl in H1; inv H1.
+  simpl; decEq. rewrite Int.eq_false; auto. congruence.
+  simpl; decEq. rewrite Int.eq_false; auto. congruence.
+
+  intros. destruct cond; simpl in H0; FuncInv; InvInject; simpl; auto.
+  inv H3; inv H2; simpl in H0; inv H0; auto.
+  eauto.
+  inv H3; simpl in H0; inv H0; auto.
+  eauto. 
+  inv H3; inv H2; simpl in H0; inv H0; auto.
+  inv H3; inv H2; simpl in H0; inv H0; auto.
+Qed.
+
+Ltac TrivialExists :=
+  match goal with
+  | [ |- exists v2, Some ?v1 = Some v2 /\ val_inject _ _ v2 ] =>
+      exists v1; split; auto
+  | _ => idtac
+  end.
+
+Lemma eval_addressing_inj:
+  forall addr sp1 vl1 sp2 vl2 v1,
+  val_inject f sp1 sp2 ->
+  val_list_inject f vl1 vl2 ->
+  eval_addressing genv sp1 addr vl1 = Some v1 ->
+  exists v2, eval_addressing genv sp2 addr vl2 = Some v2 /\ val_inject f v1 v2.
+Proof.
+  intros. destruct addr; simpl in H1; simpl; FuncInv; InvInject; TrivialExists.
+  apply val_add_inj; auto.
+  apply val_add_inj; auto. apply val_add_inj; auto.
+  apply val_add_inj; auto. inv H4; simpl; auto.
+  apply val_add_inj; auto. apply val_add_inj; auto. inv H2; simpl; auto.
+  apply val_add_inj; auto.
+  apply val_add_inj; auto. inv H4; simpl; auto.
+  apply val_add_inj; auto.
+Qed.
+
+Lemma eval_operation_inj:
+  forall op sp1 vl1 sp2 vl2 v1,
+  val_inject f sp1 sp2 ->
+  val_list_inject f vl1 vl2 ->
+  eval_operation genv sp1 op vl1 m1 = Some v1 ->
+  exists v2, eval_operation genv sp2 op vl2 m2 = Some v2 /\ val_inject f v1 v2.
+Proof.
+  intros. destruct op; simpl in H1; simpl; FuncInv; InvInject; TrivialExists.
+  inv H4; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; inv H2; simpl; auto. econstructor; eauto. 
+    rewrite Int.sub_add_l. auto.
+    destruct (zeq b1 b0); auto. subst. rewrite H1 in H0. inv H0. rewrite zeq_true. 
+    rewrite Int.sub_shifted. auto.
+  inv H4; inv H2; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; inv H3; simpl in H1; inv H1. simpl. 
+    destruct (Int.eq i0 Int.zero); inv H2. TrivialExists.
+  inv H4; inv H3; simpl in H1; inv H1. simpl. 
+    destruct (Int.eq i0 Int.zero); inv H2. TrivialExists.
+  inv H4; inv H3; simpl in H1; inv H1. simpl. 
+    destruct (Int.eq i0 Int.zero); inv H2. TrivialExists.
+  inv H4; inv H3; simpl in H1; inv H1. simpl. 
+    destruct (Int.eq i0 Int.zero); inv H2. TrivialExists.
+  inv H4; inv H2; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; inv H2; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; inv H2; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto.
+  inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto.
+  inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto.
+  inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto.
+  inv H4; simpl in H1; try discriminate. simpl. 
+  destruct (Int.ltu i (Int.repr 31)); inv H1. TrivialExists.
+  inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto.
+  inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto.
+  inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto.
+  eapply eval_addressing_inj; eauto. 
+  inv H4; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; inv H2; simpl; auto.
+  inv H4; inv H2; simpl; auto.
+  inv H4; inv H2; simpl; auto.
+  inv H4; inv H2; simpl; auto.
+  inv H4; simpl; auto.
+  inv H4; simpl in H1; inv H1. simpl. destruct (Float.intoffloat f0); simpl in H2; inv H2.
+  exists (Vint i); auto.
+  inv H4; simpl in H1; inv H1. simpl. TrivialExists.
+  subst v1. destruct (eval_condition c vl1 m1) as []_eqn.
+  exploit eval_condition_inj; eauto. intros EQ; rewrite EQ.
+  destruct b; simpl; constructor.
+  simpl; constructor.
+Qed.
+
+End EVAL_COMPAT.
+
+(** Compatibility of the evaluation functions with the ``is less defined'' relation over values. *)
+
+Section EVAL_LESSDEF.
+
+Variable F V: Type.
+Variable genv: Genv.t F V.
+
+Remark valid_pointer_extends:
+  forall m1 m2, Mem.extends m1 m2 ->
+  forall b1 ofs b2 delta,
+  Some(b1, 0) = Some(b2, delta) ->
+  Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true ->
+  Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true.
+Proof.
+  intros. inv H0. rewrite Int.add_zero. eapply Mem.valid_pointer_extends; eauto. 
+Qed.
+
+Remark valid_pointer_no_overflow_extends:
+  forall m1 b1 ofs b2 delta,
+  Some(b1, 0) = Some(b2, delta) ->
+  Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true ->
+  0 <= Int.unsigned ofs + Int.unsigned (Int.repr delta) <= Int.max_unsigned.
+Proof.
+  intros. inv H. rewrite Zplus_0_r. apply Int.unsigned_range_2.
+Qed.
+
+Remark valid_different_pointers_extends:
+  forall m1 b1 ofs1 b2 ofs2 b1' delta1 b2' delta2,
+  b1 <> b2 ->
+  Mem.valid_pointer m1 b1 (Int.unsigned ofs1) = true ->
+  Mem.valid_pointer m1 b2 (Int.unsigned ofs2) = true ->
+  Some(b1, 0) = Some (b1', delta1) ->
+  Some(b2, 0) = Some (b2', delta2) ->
+  b1' <> b2' \/
+  Int.unsigned(Int.add ofs1 (Int.repr delta1)) <> Int.unsigned(Int.add ofs2 (Int.repr delta2)).
+Proof.
+  intros. inv H2; inv H3. auto.
+Qed.
+
+Lemma eval_condition_lessdef:
+  forall cond vl1 vl2 b m1 m2,
+  Val.lessdef_list vl1 vl2 ->
+  Mem.extends m1 m2 ->
+  eval_condition cond vl1 m1 = Some b ->
+  eval_condition cond vl2 m2 = Some b.
+Proof.
+  intros. eapply eval_condition_inj with (f := fun b => Some(b, 0)) (m1 := m1).
+  apply valid_pointer_extends; auto.
+  apply valid_pointer_no_overflow_extends; auto. 
+  apply valid_different_pointers_extends; auto.
+  rewrite <- val_list_inject_lessdef. eauto. auto.
+Qed.
+
+Lemma eval_operation_lessdef:
+  forall sp op vl1 vl2 v1 m1 m2,
+  Val.lessdef_list vl1 vl2 ->
+  Mem.extends m1 m2 ->
+  eval_operation genv sp op vl1 m1 = Some v1 ->
+  exists v2, eval_operation genv sp op vl2 m2 = Some v2 /\ Val.lessdef v1 v2.
+Proof.
+  intros. rewrite val_list_inject_lessdef in H.
+  assert (exists v2 : val,
+          eval_operation genv sp op vl2 m2 = Some v2
+          /\ val_inject (fun b => Some(b, 0)) v1 v2).
+  eapply eval_operation_inj with (m1 := m1) (sp1 := sp).
+  intros. rewrite <- val_inject_lessdef; auto.
+  apply valid_pointer_extends; auto.
+  apply valid_pointer_no_overflow_extends; auto. 
+  apply valid_different_pointers_extends; auto.
+  rewrite <- val_inject_lessdef; auto.
+  eauto. auto. 
+  destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. 
+Qed.
+
+Lemma eval_addressing_lessdef:
+  forall sp addr vl1 vl2 v1,
+  Val.lessdef_list vl1 vl2 ->
+  eval_addressing genv sp addr vl1 = Some v1 ->
+  exists v2, eval_addressing genv sp addr vl2 = Some v2 /\ Val.lessdef v1 v2.
+Proof.
+  intros. rewrite val_list_inject_lessdef in H.
+  assert (exists v2 : val,
+          eval_addressing genv sp addr vl2 = Some v2
+          /\ val_inject (fun b => Some(b, 0)) v1 v2).
+  eapply eval_addressing_inj with (sp1 := sp).
+  intros. rewrite <- val_inject_lessdef; auto.
+  rewrite <- val_inject_lessdef; auto.
+  eauto. auto. 
+  destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. 
+Qed.
+
+End EVAL_LESSDEF.
+
+(** Compatibility of the evaluation functions with memory injections. *)
+
+Section EVAL_INJECT.
+
+Variable F V: Type.
+Variable genv: Genv.t F V.
+Variable f: meminj.
+Hypothesis globals: meminj_preserves_globals genv f.
+Variable sp1: block.
+Variable sp2: block.
+Variable delta: Z.
+Hypothesis sp_inj: f sp1 = Some(sp2, delta).
+
+Remark symbol_address_inject:
+  forall id ofs, val_inject f (symbol_address genv id ofs) (symbol_address genv id ofs).
+Proof.
+  intros. unfold symbol_address. destruct (Genv.find_symbol genv id) as []_eqn; auto.
+  exploit (proj1 globals); eauto. intros. 
+  econstructor; eauto. rewrite Int.add_zero; auto.
+Qed.
+
+Lemma eval_condition_inject:
+  forall cond vl1 vl2 b m1 m2,
+  val_list_inject f vl1 vl2 ->
+  Mem.inject f m1 m2 ->
+  eval_condition cond vl1 m1 = Some b ->
+  eval_condition cond vl2 m2 = Some b.
+Proof.
+  intros. eapply eval_condition_inj with (f := f) (m1 := m1); eauto.
+  intros; eapply Mem.valid_pointer_inject_val; eauto.
+  intros; eapply Mem.valid_pointer_inject_no_overflow; eauto.
+  intros; eapply Mem.different_pointers_inject; eauto.
+Qed.
+
+Lemma eval_addressing_inject:
+  forall addr vl1 vl2 v1,
+  val_list_inject f vl1 vl2 ->
+  eval_addressing genv (Vptr sp1 Int.zero) addr vl1 = Some v1 ->
+  exists v2, 
+     eval_addressing genv (Vptr sp2 Int.zero) (shift_stack_addressing (Int.repr delta) addr) vl2 = Some v2
+  /\ val_inject f v1 v2.
+Proof.
+  intros. 
+  rewrite eval_shift_stack_addressing. simpl.
+  eapply eval_addressing_inj with (sp1 := Vptr sp1 Int.zero); eauto.
+  exact symbol_address_inject.
+Qed.
+
+Lemma eval_operation_inject:
+  forall op vl1 vl2 v1 m1 m2,
+  val_list_inject f vl1 vl2 ->
+  Mem.inject f m1 m2 ->
+  eval_operation genv (Vptr sp1 Int.zero) op vl1 m1 = Some v1 ->
+  exists v2,
+     eval_operation genv (Vptr sp2 Int.zero) (shift_stack_operation (Int.repr delta) op) vl2 m2 = Some v2
+  /\ val_inject f v1 v2.
+Proof.
+  intros. 
+  rewrite eval_shift_stack_operation. simpl.
+  eapply eval_operation_inj with (sp1 := Vptr sp1 Int.zero) (m1 := m1); eauto.
+  exact symbol_address_inject.
+  intros; eapply Mem.valid_pointer_inject_val; eauto.
+  intros; eapply Mem.valid_pointer_inject_no_overflow; eauto.
+  intros; eapply Mem.different_pointers_inject; eauto.
+Qed.
+
+End EVAL_INJECT.
 
diff --git a/ia32/SelectOp.v b/ia32/SelectOp.v
deleted file mode 100644
index c1f5703..0000000
--- a/ia32/SelectOp.v
+++ /dev/null
@@ -1,839 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** Instruction selection for operators *)
-
-(** The instruction selection pass recognizes opportunities for using
-  combined arithmetic and logical operations and addressing modes
-  offered by the target processor.  For instance, the expression [x + 1]
-  can take advantage of the "immediate add" instruction of the processor,
-  and on the PowerPC, the expression [(x >> 6) & 0xFF] can be turned
-  into a "rotate and mask" instruction.
-
-  This file defines functions for building CminorSel expressions and
-  statements, especially expressions consisting of operator
-  applications.  These functions examine their arguments to choose
-  cheaper forms of operators whenever possible.
-
-  For instance, [add e1 e2] will return a CminorSel expression semantically
-  equivalent to [Eop Oadd (e1 ::: e2 ::: Enil)], but will use a
-  [Oaddimm] operator if one of the arguments is an integer constant,
-  or suppress the addition altogether if one of the arguments is the
-  null integer.  In passing, we perform operator reassociation
-  ([(e + c1) * c2] becomes [(e * c2) + (c1 * c2)]) and a small amount
-  of constant propagation.
-
-  On top of the "smart constructor" functions defined below,
-  module [Selection] implements the actual instruction selection pass.
-*)
-
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Cminor.
-Require Import Op.
-Require Import CminorSel.
-
-Open Local Scope cminorsel_scope.
-
-(** ** Constants **)
-
-Definition addrsymbol (id: ident) (ofs: int) :=
-  Eop (Olea (Aglobal id ofs)) Enil.
-
-Definition addrstack (ofs: int) :=
-  Eop (Olea (Ainstack ofs)) Enil.
-
-(** ** Boolean negation *)
-
-Definition notbool_base (e: expr) :=
-  Eop (Ocmp (Ccompuimm Ceq Int.zero)) (e ::: Enil).
-
-Fixpoint notbool (e: expr) {struct e} : expr :=
-  match e with
-  | Eop (Ointconst n) Enil =>
-      Eop (Ointconst (if Int.eq n Int.zero then Int.one else Int.zero)) Enil
-  | Eop (Ocmp cond) args =>
-      Eop (Ocmp (negate_condition cond)) args
-  | Econdition e1 e2 e3 =>
-      Econdition e1 (notbool e2) (notbool e3)
-  | _ =>
-      notbool_base e
-  end.
-
-(** ** Integer addition and pointer addition *)
-
-Definition offset_addressing (a: addressing) (ofs: int) : addressing :=
-  match a with
-  | Aindexed n => Aindexed (Int.add n ofs)
-  | Aindexed2 n => Aindexed2 (Int.add n ofs)
-  | Ascaled sc n => Ascaled sc (Int.add n ofs)
-  | Aindexed2scaled sc n => Aindexed2scaled sc (Int.add n ofs)
-  | Aglobal id n => Aglobal id (Int.add n ofs)
-  | Abased id n => Abased id (Int.add n ofs)
-  | Abasedscaled sc id n => Abasedscaled sc id (Int.add n ofs)
-  | Ainstack n => Ainstack (Int.add n ofs)
-  end.
-
-(** Addition of an integer constant *)
-
-(*
-Definition addimm (n: int) (e: expr) :=
-  if Int.eq n Int.zero then e else
-  match e with
-  | Eop (Ointconst m) Enil       => Eop (Ointconst(Int.add n m)) Enil
-  | Eop (Olea addr) args         => Eop (Olea (offset_addressing addr n)) args
-  | _                            => Eop (Olea (Aindexed n)) (e ::: Enil)
-  end.
-*)
-
-Inductive addimm_cases: forall (e: expr), Type :=
-  | addimm_case1:
-      forall m,
-      addimm_cases (Eop (Ointconst m) Enil)
-  | addimm_case2:
-      forall addr args,
-      addimm_cases (Eop (Olea addr) args)
-  | addimm_default:
-      forall (e: expr),
-      addimm_cases e.
-
-Definition addimm_match (e: expr) :=
-  match e as z1 return addimm_cases z1 with
-  | Eop (Ointconst m) Enil =>
-      addimm_case1 m
-  | Eop (Olea addr) args =>
-      addimm_case2 addr args
-  | e =>
-      addimm_default e
-  end.
-
-Definition addimm (n: int) (e: expr) :=
-  if Int.eq n Int.zero then e else
-  match addimm_match e with
-  | addimm_case1 m =>
-      Eop (Ointconst(Int.add n m)) Enil
-  | addimm_case2 addr args =>
-      Eop (Olea (offset_addressing addr n)) args
-  | addimm_default e =>
-      Eop (Olea (Aindexed n)) (e ::: Enil)
-  end.
-
-(** Addition of two integer or pointer expressions *)
-
-(*
-Definition add (e1: expr) (e2: expr) :=
-  match e1, e2 with
-  | Eop (Ointconst n1) Enil, t2 => addimm n1 t2
-  | t1, Eop (Ointconst n2) Enil => addimm n2 t1
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) => Eop (Olea (Aindexed2 (Int.add n1 n2))) (t1:::t2:::Enil)
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Ascaled sc n2)) (t2:::Enil) => Eop (Olea (Aindexed2scaled sc (Int.add n1 n2))) (t1:::t2:::Enil)
-  | Eop (Olea (Ascaled sc n1)) (t1:::Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) => Eop (Olea (Aindexed2scaled sc (Int.add n1 n2))) (t2:::t1:::Enil)
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Aglobal id ofs)) Enil) => Eop (Olea (Abased id (Int.add ofs n1))) (t1:::Enil)
-  | Eop (Olea (Aglobal id ofs)) Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) => Eop (Olea (Abased id (Int.add ofs n2))) (t2:::Enil)
-  | Eop (Olea (Ascaled sc n1)) (t1:::Enil), Eop (Olea (Aglobal id ofs)) Enil) => Eop (Olea (Abasedscaled sc id (Int.add ofs n1))) (t1:::Enil)
-  | Eop (Olea (Aglobal id ofs)) Enil), Eop (Olea (Ascaled sc n2)) (t2:::Enil) => Eop (Olea (Abasedscaled sc id (Int.add ofs n2))) (t2:::Enil)
-  | Eop (Olea (Ascaled sc n)) (t1:::Enil), t2 => Eop (Olea (Aindexed2scaled sc n)) (t2:::t1:::Enil)
-  | t1, Eop (Olea (Ascaled sc n)) (t2:::Enil) => Eop (Olea (Aindexed2scaled sc n)) (t1:::t2:::Enil)
-  | Eop (Olea (Aindexed n)) (t1:::Enil), t2 => Eop (Olea (Aindexed2 n)) (t1:::t2:::Enil)
-  | t1, Eop (Olea (Aindexed n)) (t2:::Enil) => Eop (Olea (Aindexed2 n)) (t1:::t2:::Enil)
-  | _, _ => Eop (Olea (Aindexed2 Int.zero)) (e1:::e2:::Enil)
-  end.
-*)
-
-Inductive add_cases: forall (e1: expr) (e2: expr), Type :=
-  | add_case1:
-      forall n1 t2,
-      add_cases (Eop (Ointconst n1) Enil) (t2)
-  | add_case2:
-      forall t1 n2,
-      add_cases (t1) (Eop (Ointconst n2) Enil)
-  | add_case3:
-      forall n1 t1 n2 t2,
-      add_cases (Eop (Olea (Aindexed n1)) (t1:::Enil)) (Eop (Olea (Aindexed n2)) (t2:::Enil))
-  | add_case4:
-      forall n1 t1 sc n2 t2,
-      add_cases (Eop (Olea (Aindexed n1)) (t1:::Enil)) (Eop (Olea (Ascaled sc n2)) (t2:::Enil))
-  | add_case5:
-      forall sc n1 t1 n2 t2,
-      add_cases (Eop (Olea (Ascaled sc n1)) (t1:::Enil)) (Eop (Olea (Aindexed n2)) (t2:::Enil))
-  | add_case6:
-      forall n1 t1 id ofs,
-      add_cases (Eop (Olea (Aindexed n1)) (t1:::Enil)) (Eop (Olea (Aglobal id ofs)) Enil)
-  | add_case7:
-      forall id ofs n2 t2,
-      add_cases (Eop (Olea (Aglobal id ofs)) Enil) (Eop (Olea (Aindexed n2)) (t2:::Enil))
-  | add_case8:
-      forall sc n1 t1 id ofs,
-      add_cases (Eop (Olea (Ascaled sc n1)) (t1:::Enil)) (Eop (Olea (Aglobal id ofs)) Enil)
-  | add_case9:
-      forall id ofs sc n2 t2,
-      add_cases (Eop (Olea (Aglobal id ofs)) Enil) (Eop (Olea (Ascaled sc n2)) (t2:::Enil))
-  | add_case10:
-      forall sc n t1 t2,
-      add_cases (Eop (Olea (Ascaled sc n)) (t1:::Enil)) (t2)
-  | add_case11:
-      forall t1 sc n t2,
-      add_cases (t1) (Eop (Olea (Ascaled sc n)) (t2:::Enil))
-  | add_case12:
-      forall n t1 t2,
-      add_cases (Eop (Olea (Aindexed n)) (t1:::Enil)) (t2)
-  | add_case13:
-      forall t1 n t2,
-      add_cases (t1) (Eop (Olea (Aindexed n)) (t2:::Enil))
-  | add_default:
-      forall (e1: expr) (e2: expr),
-      add_cases e1 e2.
-
-Definition add_match (e1: expr) (e2: expr) :=
-  match e1 as z1, e2 as z2 return add_cases z1 z2 with
-  | Eop (Ointconst n1) Enil, t2 =>
-      add_case1 n1 t2
-  | t1, Eop (Ointconst n2) Enil =>
-      add_case2 t1 n2
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) =>
-      add_case3 n1 t1 n2 t2
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Ascaled sc n2)) (t2:::Enil) =>
-      add_case4 n1 t1 sc n2 t2
-  | Eop (Olea (Ascaled sc n1)) (t1:::Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) =>
-      add_case5 sc n1 t1 n2 t2
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Aglobal id ofs)) Enil =>
-      add_case6 n1 t1 id ofs
-  | Eop (Olea (Aglobal id ofs)) Enil, Eop (Olea (Aindexed n2)) (t2:::Enil) =>
-      add_case7 id ofs n2 t2
-  | Eop (Olea (Ascaled sc n1)) (t1:::Enil), Eop (Olea (Aglobal id ofs)) Enil =>
-      add_case8 sc n1 t1 id ofs
-  | Eop (Olea (Aglobal id ofs)) Enil, Eop (Olea (Ascaled sc n2)) (t2:::Enil) =>
-      add_case9 id ofs sc n2 t2
-  | Eop (Olea (Ascaled sc n)) (t1:::Enil), t2 =>
-      add_case10 sc n t1 t2
-  | t1, Eop (Olea (Ascaled sc n)) (t2:::Enil) =>
-      add_case11 t1 sc n t2
-  | Eop (Olea (Aindexed n)) (t1:::Enil), t2 =>
-      add_case12 n t1 t2
-  | t1, Eop (Olea (Aindexed n)) (t2:::Enil) =>
-      add_case13 t1 n t2
-  | e1, e2 =>
-      add_default e1 e2
-  end.
-
-Definition add (e1: expr) (e2: expr) :=
-  match add_match e1 e2 with
-  | add_case1 n1 t2 =>
-      addimm n1 t2
-  | add_case2 t1 n2 =>
-      addimm n2 t1
-  | add_case3 n1 t1 n2 t2 =>
-      Eop (Olea (Aindexed2 (Int.add n1 n2))) (t1:::t2:::Enil)
-  | add_case4 n1 t1 sc n2 t2 =>
-      Eop (Olea (Aindexed2scaled sc (Int.add n1 n2))) (t1:::t2:::Enil)
-  | add_case5 sc n1 t1 n2 t2 =>
-      Eop (Olea (Aindexed2scaled sc (Int.add n1 n2))) (t2:::t1:::Enil)
-  | add_case6 n1 t1 id ofs =>
-      Eop (Olea (Abased id (Int.add ofs n1))) (t1:::Enil)
-  | add_case7 id ofs n2 t2 =>
-      Eop (Olea (Abased id (Int.add ofs n2))) (t2:::Enil)
-  | add_case8 sc n1 t1 id ofs =>
-      Eop (Olea (Abasedscaled sc id (Int.add ofs n1))) (t1:::Enil)
-  | add_case9 id ofs sc n2 t2 =>
-      Eop (Olea (Abasedscaled sc id (Int.add ofs n2))) (t2:::Enil)
-  | add_case10 sc n t1 t2 =>
-      Eop (Olea (Aindexed2scaled sc n)) (t2:::t1:::Enil)
-  | add_case11 t1 sc n t2 =>
-      Eop (Olea (Aindexed2scaled sc n)) (t1:::t2:::Enil)
-  | add_case12 n t1 t2 =>
-      Eop (Olea (Aindexed2 n)) (t1:::t2:::Enil)
-  | add_case13 t1 n t2 =>
-      Eop (Olea (Aindexed2 n)) (t1:::t2:::Enil)
-  | add_default e1 e2 =>
-      Eop (Olea (Aindexed2 Int.zero)) (e1:::e2:::Enil)
-  end.
-
-(** ** Integer and pointer subtraction *)
-
-(*
-Definition sub (e1: expr) (e2: expr) :=
-  match e1, e2 with
-  | t1, Eop (Ointconst n2) Enil => addimm (Int.neg n2) t1
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) => addimm (Int.sub n1 n2) (Eop Osub (t1:::t2:::Enil))
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), t2 => addimm n1 (Eop Osub (t1:::t2:::Enil))
-  | t1, Eop (Olea (Aindexed n2)) (t2:::Enil) => addimm (Int.neg n2) (Eop Osub (t1:::t2:::Enil))
-  | _, _ => Eop Osub (e1:::e2:::Enil)
-  end.
-*)
-
-Inductive sub_cases: forall (e1: expr) (e2: expr), Type :=
-  | sub_case1:
-      forall t1 n2,
-      sub_cases (t1) (Eop (Ointconst n2) Enil)
-  | sub_case2:
-      forall n1 t1 n2 t2,
-      sub_cases (Eop (Olea (Aindexed n1)) (t1:::Enil)) (Eop (Olea (Aindexed n2)) (t2:::Enil))
-  | sub_case3:
-      forall n1 t1 t2,
-      sub_cases (Eop (Olea (Aindexed n1)) (t1:::Enil)) (t2)
-  | sub_case4:
-      forall t1 n2 t2,
-      sub_cases (t1) (Eop (Olea (Aindexed n2)) (t2:::Enil))
-  | sub_default:
-      forall (e1: expr) (e2: expr),
-      sub_cases e1 e2.
-
-Definition sub_match (e1: expr) (e2: expr) :=
-  match e1 as z1, e2 as z2 return sub_cases z1 z2 with
-  | t1, Eop (Ointconst n2) Enil =>
-      sub_case1 t1 n2
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) =>
-      sub_case2 n1 t1 n2 t2
-  | Eop (Olea (Aindexed n1)) (t1:::Enil), t2 =>
-      sub_case3 n1 t1 t2
-  | t1, Eop (Olea (Aindexed n2)) (t2:::Enil) =>
-      sub_case4 t1 n2 t2
-  | e1, e2 =>
-      sub_default e1 e2
-  end.
-
-Definition sub (e1: expr) (e2: expr) :=
-  match sub_match e1 e2 with
-  | sub_case1 t1 n2 =>
-      addimm (Int.neg n2) t1
-  | sub_case2 n1 t1 n2 t2 =>
-      addimm (Int.sub n1 n2) (Eop Osub (t1:::t2:::Enil))
-  | sub_case3 n1 t1 t2 =>
-      addimm n1 (Eop Osub (t1:::t2:::Enil))
-  | sub_case4 t1 n2 t2 =>
-      addimm (Int.neg n2) (Eop Osub (t1:::t2:::Enil))
-  | sub_default e1 e2 =>
-      Eop Osub (e1:::e2:::Enil)
-  end.
-
-(** ** Immediate shifts *)
-
-Definition shift_is_scale (n: int) : bool :=
-  Int.eq n (Int.repr 1) || Int.eq n (Int.repr 2) || Int.eq n (Int.repr 3).
-
-(*
-Definition shlimm (e1: expr) :=
-  if Int.eq n Int.zero then e1 else
-  match e1 with
-  | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shl n1 n))
-  | Eop (Oshlimm n1) (t1:::Enil) => if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshlimm (Int.add n n1)) (t1:::Enil) else Eop (Oshlimm n) (e1:::Enil)
-  | Eop (Olea (Aindexed n1)) (t1:::Enil) => if shift_is_scale n then Eop (Olea (Ascaled (Int.shl Int.one n) (Int.shl n1 n))) (t1:::Enil) else Eop (Oshlimm n) (e1:::Enil)
-  | _ => if shift_is_scale n then Eop (Olea (Ascaled (Int.shl Int.one n) Int.zero) (t1:::Enil) else Eop (Oshlimm n) (e1:::Enil)
-  end.
-*)
-
-Inductive shlimm_cases: forall (e1: expr), Type :=
-  | shlimm_case1:
-      forall n1,
-      shlimm_cases (Eop (Ointconst n1) Enil)
-  | shlimm_case2:
-      forall n1 t1,
-      shlimm_cases (Eop (Oshlimm n1) (t1:::Enil))
-  | shlimm_case3:
-      forall n1 t1,
-      shlimm_cases (Eop (Olea (Aindexed n1)) (t1:::Enil))
-  | shlimm_default:
-      forall (e1: expr),
-      shlimm_cases e1.
-
-Definition shlimm_match (e1: expr) :=
-  match e1 as z1 return shlimm_cases z1 with
-  | Eop (Ointconst n1) Enil =>
-      shlimm_case1 n1
-  | Eop (Oshlimm n1) (t1:::Enil) =>
-      shlimm_case2 n1 t1
-  | Eop (Olea (Aindexed n1)) (t1:::Enil) =>
-      shlimm_case3 n1 t1
-  | e1 =>
-      shlimm_default e1
-  end.
-
-Definition shlimm (e1: expr) (n: int) :=
-  if Int.eq n Int.zero then e1 else
-  match shlimm_match e1 with
-  | shlimm_case1 n1 =>
-      Eop (Ointconst(Int.shl n1 n)) Enil
-  | shlimm_case2 n1 t1 =>
-      if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshlimm (Int.add n n1)) (t1:::Enil) else Eop (Oshlimm n) (e1:::Enil)
-  | shlimm_case3 n1 t1 =>
-      if shift_is_scale n then Eop (Olea (Ascaled (Int.shl Int.one n) (Int.shl n1 n))) (t1:::Enil) else Eop (Oshlimm n) (e1:::Enil)
-  | shlimm_default e1 =>
-      if shift_is_scale n then Eop (Olea (Ascaled (Int.shl Int.one n) Int.zero)) (e1:::Enil) else Eop (Oshlimm n) (e1:::Enil)
-  end.
-
-(*
-Definition shruimm (e1: expr) :=
-  if Int.eq n Int.zero then e1 else
-  match e1 with
-  | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shru n1 n))
-  | Eop (Oshruimm n1) (t1:::Enil) => if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshruimm (Int.add n n1)) (t1:::Enil) else Eop (Oshruimm n) (e1:::Enil)
-  | _ => Eop (Oshruimm n) (e1:::Enil)
-  end.
-*)
-
-Inductive shruimm_cases: forall (e1: expr), Type :=
-  | shruimm_case1:
-      forall n1,
-      shruimm_cases (Eop (Ointconst n1) Enil)
-  | shruimm_case2:
-      forall n1 t1,
-      shruimm_cases (Eop (Oshruimm n1) (t1:::Enil))
-  | shruimm_default:
-      forall (e1: expr),
-      shruimm_cases e1.
-
-Definition shruimm_match (e1: expr) :=
-  match e1 as z1 return shruimm_cases z1 with
-  | Eop (Ointconst n1) Enil =>
-      shruimm_case1 n1
-  | Eop (Oshruimm n1) (t1:::Enil) =>
-      shruimm_case2 n1 t1
-  | e1 =>
-      shruimm_default e1
-  end.
-
-Definition shruimm (e1: expr) (n: int) :=
-  if Int.eq n Int.zero then e1 else
-  match shruimm_match e1 with
-  | shruimm_case1 n1 =>
-      Eop (Ointconst(Int.shru n1 n)) Enil
-  | shruimm_case2 n1 t1 =>
-      if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshruimm (Int.add n n1)) (t1:::Enil) else Eop (Oshruimm n) (e1:::Enil)
-  | shruimm_default e1 =>
-      Eop (Oshruimm n) (e1:::Enil)
-  end.
-
-(*
-Definition shrimm (e1: expr) :=
-  if Int.eq n Int.zero then e1 else
-  match e1 with
-  | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shr n1 n)) Enil
-  | Eop (Oshrimm n1) (t1:::Enil) => if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshrimm (Int.add n n1)) (t1:::Enil) else Eop (Oshrimm n) (e1:::Enil)
-  | _ => Eop (Oshrimm n) (e1:::Enil)
-  end.
-*)
-
-Inductive shrimm_cases: forall (e1: expr), Type :=
-  | shrimm_case1:
-      forall n1,
-      shrimm_cases (Eop (Ointconst n1) Enil)
-  | shrimm_case2:
-      forall n1 t1,
-      shrimm_cases (Eop (Oshrimm n1) (t1:::Enil))
-  | shrimm_default:
-      forall (e1: expr),
-      shrimm_cases e1.
-
-Definition shrimm_match (e1: expr) :=
-  match e1 as z1 return shrimm_cases z1 with
-  | Eop (Ointconst n1) Enil =>
-      shrimm_case1 n1
-  | Eop (Oshrimm n1) (t1:::Enil) =>
-      shrimm_case2 n1 t1
-  | e1 =>
-      shrimm_default e1
-  end.
-
-Definition shrimm (e1: expr) (n: int) :=
-  if Int.eq n Int.zero then e1 else 
-  match shrimm_match e1 with
-  | shrimm_case1 n1 =>
-      Eop (Ointconst(Int.shr n1 n)) Enil
-  | shrimm_case2 n1 t1 =>
-      if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshrimm (Int.add n n1)) (t1:::Enil) else Eop (Oshrimm n) (e1:::Enil)
-  | shrimm_default e1 =>
-      Eop (Oshrimm n) (e1:::Enil)
-  end.
-
-(** ** Integer multiply *)
-
-Definition mulimm_base (n1: int) (e2: expr) :=
-  match Int.one_bits n1 with
-  | i :: nil =>
-      shlimm e2 i
-  | i :: j :: nil =>
-      Elet e2 (add (shlimm (Eletvar 0) i) (shlimm (Eletvar 0) j))
-  | _ =>
-      Eop (Omulimm n1) (e2:::Enil)
-  end.
-
-(*
-Definition mulimm (n1: int) (e2: expr) :=
-  if Int.eq n1 Int.zero then 
-   Eop (Ointconst Int.zero) Enil
-  else if Int.eq n1 Int.one then
-    e2
-  else match e2 with
-  | Eop (Ointconst n2) Enil => Eop (Ointconst(intmul n1 n2)) Enil
-  | Eop (Olea (Aindexed n2)) (t2:::Enil) => if mul_is_scale n1 then Eop (Olea (Ascaled n1 (Int.mul n1 n2))) (t2:::Enil) else addimm (Int.mul n1 n2) (mulimm_base n1 t2)
-  | _ => mulimm_base n1 e2
-  end.
-
-Definition mulimm (e2: expr) :=
-  match e2 with
-  | Eop (Ointconst n2) Enil => Eop (Ointconst(intmul n1 n2)) Enil
-  | Eop (Olea (Aindexed n2)) (t2:::Enil) => if mul_is_scale n1 then Eop (Olea (Ascaled n1 (Int.mul n1 n2))) (t2:::Enil) else addimm (Int.mul n1 n2) (mulimm_base n1 t2)
-  | _ => mulimm_base n1 e2
-  end.
-*)
-
-Inductive mulimm_cases: forall (e2: expr), Type :=
-  | mulimm_case1:
-      forall n2,
-      mulimm_cases (Eop (Ointconst n2) Enil)
-  | mulimm_case2:
-      forall n2 t2,
-      mulimm_cases (Eop (Olea (Aindexed n2)) (t2:::Enil))
-  | mulimm_default:
-      forall (e2: expr),
-      mulimm_cases e2.
-
-Definition mulimm_match (e2: expr) :=
-  match e2 as z1 return mulimm_cases z1 with
-  | Eop (Ointconst n2) Enil =>
-      mulimm_case1 n2
-  | Eop (Olea (Aindexed n2)) (t2:::Enil) =>
-      mulimm_case2 n2 t2
-  | e2 =>
-      mulimm_default e2
-  end.
-
-Definition mulimm (n1: int) (e2: expr) :=
-  if Int.eq n1 Int.zero then 
-   Eop (Ointconst Int.zero) Enil
-  else if Int.eq n1 Int.one then
-    e2
-  else match mulimm_match e2 with
-  | mulimm_case1 n2 =>
-      Eop (Ointconst(Int.mul n1 n2)) Enil
-  | mulimm_case2 n2 t2 =>
-      addimm (Int.mul n1 n2) (mulimm_base n1 t2)
-  | mulimm_default e2 =>
-      mulimm_base n1 e2
-  end.
-
-(*
-Definition mul (e1: expr) (e2: expr) :=
-  match e1, e2 with
-  | Eop (Ointconst n1) Enil, t2 => mulimm n1 t2
-  | t1, Eop (Ointconst n2) Enil => mulimm n2 t1
-  | _, _ => Eop Omul (e1:::e2:::Enil)
-  end.
-*)
-
-Inductive mul_cases: forall (e1: expr) (e2: expr), Type :=
-  | mul_case1:
-      forall (n1: int) (t2: expr),
-      mul_cases (Eop (Ointconst n1) Enil) (t2)
-  | mul_case2:
-      forall (t1: expr) (n2: int),
-      mul_cases (t1) (Eop (Ointconst n2) Enil)
-  | mul_default:
-      forall (e1: expr) (e2: expr),
-      mul_cases e1 e2.
-
-Definition mul_match_aux (e1: expr) (e2: expr) :=
-  match e2 as z2 return mul_cases e1 z2 with
-  | Eop (Ointconst n2) Enil =>
-      mul_case2 e1 n2
-  | e2 =>
-      mul_default e1 e2
-  end.
-
-Definition mul_match (e1: expr) (e2: expr) :=
-  match e1 as z1 return mul_cases z1 e2 with
-  | Eop (Ointconst n1) Enil =>
-      mul_case1 n1 e2
-  | e1 =>
-      mul_match_aux e1 e2
-  end.
-
-Definition mul (e1: expr) (e2: expr) :=
-  match mul_match e1 e2 with
-  | mul_case1 n1 t2 =>
-      mulimm n1 t2
-  | mul_case2 t1 n2 =>
-      mulimm n2 t1
-  | mul_default e1 e2 =>
-      Eop Omul (e1:::e2:::Enil)
-  end.
-
-(** ** Bitwise and, or, xor *)
-
-Definition orimm (n: int) (e: expr) :=
-  if Int.eq n Int.zero then e
-  else if Int.eq n Int.mone then Eop (Ointconst Int.mone) Enil
-  else Eop (Oorimm n) (e:::Enil).
-
-Definition same_expr_pure (e1 e2: expr) :=
-  match e1, e2 with
-  | Evar v1, Evar v2 => if ident_eq v1 v2 then true else false
-  | _, _ => false
-  end.
-
-(*
-Definition or (e1: expr) (e2: expr) :=
-  match e1, e2 with
-  | Eop (Ointconst n1) Enil, t2 => orimm n1 t2
-  | t1, Eop (Ointconst n2) Enil => orimm n2 t1
-  | Eop (Oshlimm n1) (t1:::Enil), Eop (Oshruimm n2) (t2:::Enil)) => ...
-  | Eop (Oshruimm n2) (t2:::Enil)), Eop (Oshlimm n1) (t1:::Enil) => ...
-  | _, _ => Eop Oor (e1:::e2:::Enil)
-  end.
-*)
-
-Inductive or_cases: forall (e1: expr) (e2: expr), Type :=
-  | or_case1:
-      forall n1 t2,
-      or_cases (Eop (Ointconst n1) Enil) (t2)
-  | or_case2:
-      forall t1 n2,
-      or_cases (t1) (Eop (Ointconst n2) Enil)
-  | or_case3:
-      forall n1 t1 n2 t2,
-      or_cases (Eop (Oshlimm n1) (t1:::Enil)) (Eop (Oshruimm n2) (t2:::Enil))
-  | or_case4:
-      forall n2 t2 n1 t1,
-      or_cases (Eop (Oshruimm n2) (t2:::Enil)) (Eop (Oshlimm n1) (t1:::Enil))
-  | or_default:
-      forall (e1: expr) (e2: expr),
-      or_cases e1 e2.
-
-Definition or_match (e1: expr) (e2: expr) :=
-  match e1 as z1, e2 as z2 return or_cases z1 z2 with
-  | Eop (Ointconst n1) Enil, t2 =>
-      or_case1 n1 t2
-  | t1, Eop (Ointconst n2) Enil =>
-      or_case2 t1 n2
-  | Eop (Oshlimm n1) (t1:::Enil), Eop (Oshruimm n2) (t2:::Enil) =>
-      or_case3 n1 t1 n2 t2
-  | Eop (Oshruimm n2) (t2:::Enil), Eop (Oshlimm n1) (t1:::Enil) =>
-      or_case4 n2 t2 n1 t1
-  | e1, e2 =>
-      or_default e1 e2
-  end.
-
-Definition or (e1: expr) (e2: expr) :=
-  match or_match e1 e2 with
-  | or_case1 n1 t2 =>
-      orimm n1 t2
-  | or_case2 t1 n2 =>
-      orimm n2 t1
-  | or_case3 n1 t1 n2 t2 =>
-      if Int.eq (Int.add n1 n2) Int.iwordsize
-      && same_expr_pure t1 t2
-      then Eop (Ororimm n2) (t1:::Enil)
-      else Eop Oor (e1:::e2:::Enil)
-  | or_case4 n2 t2 n1 t1 =>
-      if Int.eq (Int.add n1 n2) Int.iwordsize
-      && same_expr_pure t1 t2
-      then Eop (Ororimm n2) (t1:::Enil)
-      else Eop Oor (e1:::e2:::Enil)
-  | or_default e1 e2 =>
-      Eop Oor (e1:::e2:::Enil)
-  end.
-
-Definition andimm (n: int) (e: expr) :=
-  if Int.eq n Int.zero then Eop (Ointconst Int.zero) Enil
-  else if Int.eq n Int.mone then e
-  else Eop (Oandimm n) (e:::Enil).
-
-Definition and (e1: expr) (e2: expr) :=
-  match mul_match e1 e2 with
-  | mul_case1 n1 t2 =>
-      andimm n1 t2
-  | mul_case2 t1 n2 =>
-      andimm n2 t1
-  | mul_default e1 e2 =>
-      Eop Oand (e1:::e2:::Enil)
-  end.
-
-Definition xorimm (n: int) (e: expr) :=
-  if Int.eq n Int.zero then e
-  else Eop (Oxorimm n) (e:::Enil).
-
-Definition xor (e1: expr) (e2: expr) :=
-  match mul_match e1 e2 with
-  | mul_case1 n1 t2 =>
-      xorimm n1 t2
-  | mul_case2 t1 n2 =>
-      xorimm n2 t1
-  | mul_default e1 e2 =>
-      Eop Oxor (e1:::e2:::Enil)
-  end.
-
-(** ** General shifts *)
-
-Inductive shift_cases: forall (e1: expr), Type :=
-  | shift_case1:
-      forall (n2: int),
-      shift_cases (Eop (Ointconst n2) Enil)
-  | shift_default:
-      forall (e1: expr),
-      shift_cases e1.
-
-Definition shift_match (e1: expr) :=
-  match e1 as z1 return shift_cases z1 with
-  | Eop (Ointconst n2) Enil =>
-      shift_case1 n2
-  | e1 =>
-      shift_default e1
-  end.
-
-Definition shl (e1: expr) (e2: expr) :=
-  match shift_match e2 with
-  | shift_case1 n2 =>
-      shlimm e1 n2
-  | shift_default e2 =>
-      Eop Oshl (e1:::e2:::Enil)
-  end.
-
-Definition shru (e1: expr) (e2: expr) :=
-  match shift_match e2 with
-  | shift_case1 n2 =>
-      shruimm e1 n2
-  | shift_default e2 =>
-      Eop Oshru (e1:::e2:::Enil)
-  end.
-
-Definition shr (e1: expr) (e2: expr) :=
-  match shift_match e2 with
-  | shift_case1 n2 =>
-      shrimm e1 n2
-  | shift_default e2 =>
-      Eop Oshr (e1:::e2:::Enil)
-  end.
-
-(** ** Comparisons *)
-
-Inductive comp_cases: forall (e1: expr) (e2: expr), Type :=
-  | comp_case1:
-      forall n1 t2,
-      comp_cases (Eop (Ointconst n1) Enil) (t2)
-  | comp_case2:
-      forall t1 n2,
-      comp_cases (t1) (Eop (Ointconst n2) Enil)
-  | comp_default:
-      forall (e1: expr) (e2: expr),
-      comp_cases e1 e2.
-
-Definition comp_match (e1: expr) (e2: expr) :=
-  match e1 as z1, e2 as z2 return comp_cases z1 z2 with
-  | Eop (Ointconst n1) Enil, t2 =>
-      comp_case1 n1 t2
-  | t1, Eop (Ointconst n2) Enil =>
-      comp_case2 t1 n2
-  | e1, e2 =>
-      comp_default e1 e2
-  end.
-
-Definition comp (c: comparison) (e1: expr) (e2: expr) :=
-  match comp_match e1 e2 with
-  | comp_case1 n1 t2 =>
-      Eop (Ocmp (Ccompimm (swap_comparison c) n1)) (t2 ::: Enil)
-  | comp_case2 t1 n2 =>
-      Eop (Ocmp (Ccompimm c n2)) (t1 ::: Enil)
-  | comp_default e1 e2 =>
-      Eop (Ocmp (Ccomp c)) (e1 ::: e2 ::: Enil)
-  end.
-
-Definition compu (c: comparison) (e1: expr) (e2: expr) :=
-  match comp_match e1 e2 with
-  | comp_case1 n1 t2 =>
-      Eop (Ocmp (Ccompuimm (swap_comparison c) n1)) (t2 ::: Enil)
-  | comp_case2 t1 n2 =>
-      Eop (Ocmp (Ccompuimm c n2)) (t1 ::: Enil)
-  | comp_default e1 e2 =>
-      Eop (Ocmp (Ccompu c)) (e1 ::: e2 ::: Enil)
-  end.
-
-Definition compf (c: comparison) (e1: expr) (e2: expr) :=
-  Eop (Ocmp (Ccompf c)) (e1 ::: e2 ::: Enil).
-
-(** ** Other operators, not optimized. *)
-
-Definition cast8unsigned (e: expr) := Eop Ocast8unsigned (e ::: Enil).
-Definition cast8signed (e: expr) := Eop Ocast8signed (e ::: Enil).
-Definition cast16unsigned (e: expr) := Eop Ocast16unsigned (e ::: Enil).
-Definition cast16signed (e: expr) := Eop Ocast16signed (e ::: Enil).
-Definition divu (e1: expr) (e2: expr) := Eop Odivu (e1:::e2:::Enil).
-Definition modu (e1: expr) (e2: expr) := Eop Omodu (e1:::e2:::Enil).
-Definition divs (e1: expr) (e2: expr) := Eop Odiv (e1:::e2:::Enil).
-Definition mods (e1: expr) (e2: expr) := Eop Omod (e1:::e2:::Enil).
-Definition negint (e: expr) := Eop Oneg (e ::: Enil).
-Definition notint (e: expr) := Eop (Oxorimm Int.mone) (e ::: Enil).
-Definition negf (e: expr) :=  Eop Onegf (e ::: Enil).
-Definition absf (e: expr) :=  Eop Oabsf (e ::: Enil).
-Definition singleoffloat (e: expr) := Eop Osingleoffloat (e ::: Enil).
-Definition intoffloat (e: expr) := Eop Ointoffloat (e ::: Enil).
-Definition floatofint (e: expr) := Eop Ofloatofint (e ::: Enil).
-Definition addf (e1 e2: expr) :=  Eop Oaddf (e1 ::: e2 ::: Enil).
-Definition subf (e1 e2: expr) :=  Eop Osubf (e1 ::: e2 ::: Enil).
-Definition mulf (e1 e2: expr) :=  Eop Omulf (e1 ::: e2 ::: Enil).
-Definition divf (e1 e2: expr) :=  Eop Odivf (e1 ::: e2 ::: Enil).
-
-(** ** Conversions between unsigned ints and floats *)
-
-Definition intuoffloat (e: expr) :=
-  let f := Eop (Ofloatconst (Float.floatofintu Float.ox8000_0000)) Enil in
-  Elet e
-    (Econdition (CEcond (Ccompf Clt) (Eletvar O ::: f ::: Enil))
-      (intoffloat (Eletvar O))
-      (addimm Float.ox8000_0000 (intoffloat (subf (Eletvar O) f)))).
-
-Definition floatofintu (e: expr) :=
-  let f := Eop (Ofloatconst (Float.floatofintu Float.ox8000_0000)) Enil in
-  Elet e
-    (Econdition (CEcond (Ccompuimm Clt Float.ox8000_0000) (Eletvar O ::: Enil))
-      (floatofint (Eletvar O))
-      (addf (floatofint (addimm (Int.neg Float.ox8000_0000) (Eletvar O))) f)).
-
-(** ** Addressing modes *)
-
-(*
-Definition addressing (e: expr) :=
-  match e with
-  | Eop (Olea addr) args => (addr, args)
-  | _ => (Aindexed Int.zero, e:::Enil)
-  end.
-*)
-
-Inductive addressing_cases: forall (e: expr), Type :=
-  | addressing_case1:
-      forall addr args,
-      addressing_cases (Eop (Olea addr) args)
-  | addressing_default:
-      forall (e: expr),
-      addressing_cases e.
-
-Definition addressing_match (e: expr) :=
-  match e as z1 return addressing_cases z1 with
-  | Eop (Olea addr) args =>
-      addressing_case1 addr args
-  | e =>
-      addressing_default e
-  end.
-
-Definition addressing (chunk: memory_chunk) (e: expr) :=
-  match addressing_match e with
-  | addressing_case1 addr args =>
-      (addr, args)
-  | addressing_default e =>
-      (Aindexed Int.zero, e:::Enil)
-  end.
-
diff --git a/ia32/SelectOp.vp b/ia32/SelectOp.vp
new file mode 100644
index 0000000..71dc83b
--- /dev/null
+++ b/ia32/SelectOp.vp
@@ -0,0 +1,416 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Instruction selection for operators *)
+
+(** The instruction selection pass recognizes opportunities for using
+  combined arithmetic and logical operations and addressing modes
+  offered by the target processor.  For instance, the expression [x + 1]
+  can take advantage of the "immediate add" instruction of the processor,
+  and on the PowerPC, the expression [(x >> 6) & 0xFF] can be turned
+  into a "rotate and mask" instruction.
+
+  This file defines functions for building CminorSel expressions and
+  statements, especially expressions consisting of operator
+  applications.  These functions examine their arguments to choose
+  cheaper forms of operators whenever possible.
+
+  For instance, [add e1 e2] will return a CminorSel expression semantically
+  equivalent to [Eop Oadd (e1 ::: e2 ::: Enil)], but will use a
+  [Oaddimm] operator if one of the arguments is an integer constant,
+  or suppress the addition altogether if one of the arguments is the
+  null integer.  In passing, we perform operator reassociation
+  ([(e + c1) * c2] becomes [(e * c2) + (c1 * c2)]) and a small amount
+  of constant propagation.
+
+  On top of the "smart constructor" functions defined below,
+  module [Selection] implements the actual instruction selection pass.
+*)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memory.
+Require Import Globalenvs.
+Require Cminor.
+Require Import Op.
+Require Import CminorSel.
+
+Open Local Scope cminorsel_scope.
+
+(** ** Constants **)
+
+Definition addrsymbol (id: ident) (ofs: int) :=
+  Eop (Olea (Aglobal id ofs)) Enil.
+
+Definition addrstack (ofs: int) :=
+  Eop (Olea (Ainstack ofs)) Enil.
+
+(** ** Integer logical negation *)
+
+Definition notint (e: expr) := Eop (Oxorimm Int.mone) (e ::: Enil).
+
+(** ** Boolean negation *)
+
+Fixpoint notbool (e: expr) {struct e} : expr :=
+  let default := Eop (Ocmp (Ccompuimm Ceq Int.zero)) (e ::: Enil) in
+  match e with 
+  | Eop (Ointconst n) Enil =>
+      Eop (Ointconst (if Int.eq n Int.zero then Int.one else Int.zero)) Enil
+  | Eop (Ocmp cond) args =>
+      Eop (Ocmp (negate_condition cond)) args
+  | Econdition e1 e2 e3 =>
+      Econdition e1 (notbool e2) (notbool e3)
+  | _ =>
+      default
+  end.
+
+(** ** Integer addition and pointer addition *)
+
+Definition offset_addressing (a: addressing) (ofs: int) : addressing :=
+  match a with
+  | Aindexed n => Aindexed (Int.add n ofs)
+  | Aindexed2 n => Aindexed2 (Int.add n ofs)
+  | Ascaled sc n => Ascaled sc (Int.add n ofs)
+  | Aindexed2scaled sc n => Aindexed2scaled sc (Int.add n ofs)
+  | Aglobal id n => Aglobal id (Int.add n ofs)
+  | Abased id n => Abased id (Int.add n ofs)
+  | Abasedscaled sc id n => Abasedscaled sc id (Int.add n ofs)
+  | Ainstack n => Ainstack (Int.add n ofs)
+  end.
+
+Nondetfunction addimm (n: int) (e: expr) :=
+  if Int.eq n Int.zero then e else
+  match e with
+  | Eop (Ointconst m) Enil       => Eop (Ointconst(Int.add n m)) Enil
+  | Eop (Olea addr) args         => Eop (Olea (offset_addressing addr n)) args
+  | _                            => Eop (Olea (Aindexed n)) (e ::: Enil)
+  end.
+
+Nondetfunction add (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => addimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => addimm n2 t1
+  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) =>
+      Eop (Olea (Aindexed2 (Int.add n1 n2))) (t1:::t2:::Enil)
+  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Ascaled sc n2)) (t2:::Enil) =>
+      Eop (Olea (Aindexed2scaled sc (Int.add n1 n2))) (t1:::t2:::Enil)
+  | Eop (Olea (Ascaled sc n1)) (t1:::Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) =>
+      Eop (Olea (Aindexed2scaled sc (Int.add n1 n2))) (t2:::t1:::Enil)
+  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Aglobal id ofs)) Enil =>
+      Eop (Olea (Abased id (Int.add ofs n1))) (t1:::Enil)
+  | Eop (Olea (Aglobal id ofs)) Enil, Eop (Olea (Aindexed n2)) (t2:::Enil) =>
+      Eop (Olea (Abased id (Int.add ofs n2))) (t2:::Enil)
+  | Eop (Olea (Ascaled sc n1)) (t1:::Enil), Eop (Olea (Aglobal id ofs)) Enil =>
+      Eop (Olea (Abasedscaled sc id (Int.add ofs n1))) (t1:::Enil)
+  | Eop (Olea (Aglobal id ofs)) Enil, Eop (Olea (Ascaled sc n2)) (t2:::Enil) =>
+      Eop (Olea (Abasedscaled sc id (Int.add ofs n2))) (t2:::Enil)
+  | Eop (Olea (Ascaled sc n)) (t1:::Enil), t2 =>
+      Eop (Olea (Aindexed2scaled sc n)) (t2:::t1:::Enil)
+  | t1, Eop (Olea (Ascaled sc n)) (t2:::Enil) =>
+      Eop (Olea (Aindexed2scaled sc n)) (t1:::t2:::Enil)
+  | Eop (Olea (Aindexed n)) (t1:::Enil), t2 =>
+      Eop (Olea (Aindexed2 n)) (t1:::t2:::Enil)
+  | t1, Eop (Olea (Aindexed n)) (t2:::Enil) =>
+      Eop (Olea (Aindexed2 n)) (t1:::t2:::Enil)
+  | _, _ =>
+      Eop (Olea (Aindexed2 Int.zero)) (e1:::e2:::Enil)
+  end.
+
+(** ** Integer and pointer subtraction *)
+
+Nondetfunction sub (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | t1, Eop (Ointconst n2) Enil => addimm (Int.neg n2) t1
+  | Eop (Olea (Aindexed n1)) (t1:::Enil), Eop (Olea (Aindexed n2)) (t2:::Enil) =>
+      addimm (Int.sub n1 n2) (Eop Osub (t1:::t2:::Enil))
+  | Eop (Olea (Aindexed n1)) (t1:::Enil), t2 =>
+      addimm n1 (Eop Osub (t1:::t2:::Enil))
+  | t1, Eop (Olea (Aindexed n2)) (t2:::Enil) =>
+      addimm (Int.neg n2) (Eop Osub (t1:::t2:::Enil))
+  | _, _ =>
+      Eop Osub (e1:::e2:::Enil)
+  end.
+
+Definition negint (e: expr) := Eop Oneg (e ::: Enil).
+
+(** ** Immediate shifts *)
+
+Definition shift_is_scale (n: int) : bool :=
+  Int.eq n (Int.repr 1) || Int.eq n (Int.repr 2) || Int.eq n (Int.repr 3).
+
+Nondetfunction shlimm (e1: expr) (n: int) :=
+  if Int.eq n Int.zero then e1 else
+  match e1 with
+  | Eop (Ointconst n1) Enil =>
+      Eop (Ointconst(Int.shl n1 n)) Enil
+  | Eop (Oshlimm n1) (t1:::Enil) =>
+      if Int.ltu (Int.add n n1) Int.iwordsize
+      then Eop (Oshlimm (Int.add n n1)) (t1:::Enil)
+      else Eop (Oshlimm n) (e1:::Enil)
+  | Eop (Olea (Aindexed n1)) (t1:::Enil) =>
+      if shift_is_scale n
+      then Eop (Olea (Ascaled (Int.shl Int.one n) (Int.shl n1 n))) (t1:::Enil)
+      else Eop (Oshlimm n) (e1:::Enil)
+  | _ =>
+      if shift_is_scale n
+      then Eop (Olea (Ascaled (Int.shl Int.one n) Int.zero)) (e1:::Enil)
+      else Eop (Oshlimm n) (e1:::Enil)
+  end.
+
+Nondetfunction shruimm (e1: expr) (n: int) :=
+  if Int.eq n Int.zero then e1 else
+  match e1 with
+  | Eop (Ointconst n1) Enil =>
+      Eop (Ointconst(Int.shru n1 n)) Enil
+  | Eop (Oshruimm n1) (t1:::Enil) =>
+      if Int.ltu (Int.add n n1) Int.iwordsize
+      then Eop (Oshruimm (Int.add n n1)) (t1:::Enil)
+      else Eop (Oshruimm n) (e1:::Enil)
+  | _ =>
+      Eop (Oshruimm n) (e1:::Enil)
+  end.
+
+Nondetfunction shrimm (e1: expr) (n: int) :=
+  if Int.eq n Int.zero then e1 else
+  match e1 with
+  | Eop (Ointconst n1) Enil =>
+      Eop (Ointconst(Int.shr n1 n)) Enil
+  | Eop (Oshrimm n1) (t1:::Enil) =>
+      if Int.ltu (Int.add n n1) Int.iwordsize
+      then Eop (Oshrimm (Int.add n n1)) (t1:::Enil)
+      else Eop (Oshrimm n) (e1:::Enil)
+  | _ =>
+      Eop (Oshrimm n) (e1:::Enil)
+  end.
+
+(** ** Integer multiply *)
+
+Definition mulimm_base (n1: int) (e2: expr) :=
+  match Int.one_bits n1 with
+  | i :: nil =>
+      shlimm e2 i
+  | i :: j :: nil =>
+      Elet e2 (add (shlimm (Eletvar 0) i) (shlimm (Eletvar 0) j))
+  | _ =>
+      Eop (Omulimm n1) (e2:::Enil)
+  end.
+
+Nondetfunction mulimm (n1: int) (e2: expr) :=
+  if Int.eq n1 Int.zero then Eop (Ointconst Int.zero) Enil
+  else if Int.eq n1 Int.one then e2
+  else match e2 with
+  | Eop (Ointconst n2) Enil => Eop (Ointconst(Int.mul n1 n2)) Enil
+  | Eop (Olea (Aindexed n2)) (t2:::Enil) => addimm (Int.mul n1 n2) (mulimm_base n1 t2)
+  | _ => mulimm_base n1 e2
+  end.
+
+Nondetfunction mul (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => mulimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => mulimm n2 t1
+  | _, _ => Eop Omul (e1:::e2:::Enil)
+  end.
+
+(** ** Bitwise and, or, xor *)
+
+Nondetfunction andimm (n1: int) (e2: expr) :=
+  if Int.eq n1 Int.zero then Eop (Ointconst Int.zero) Enil
+  else if Int.eq n1 Int.mone then e2
+  else match e2 with
+  | Eop (Ointconst n2) Enil =>
+      Eop (Ointconst (Int.and n1 n2)) Enil
+  | Eop (Oandimm n2) (t2:::Enil) =>
+     Eop (Oandimm (Int.and n1 n2)) (t2:::Enil)
+  | Eop Ocast8unsigned (t2:::Enil) =>
+     Eop (Oandimm (Int.and n1 (Int.repr 255))) (t2:::Enil)
+  | Eop Ocast16unsigned (t2:::Enil) =>
+     Eop (Oandimm (Int.and n1 (Int.repr 65535))) (t2:::Enil)
+  | _ =>
+     Eop (Oandimm n1) (e2:::Enil)
+  end.
+
+Nondetfunction and (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => andimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => andimm n2 t1
+  | _, _ => Eop Oand (e1:::e2:::Enil)
+  end.
+
+Nondetfunction orimm (n1: int) (e2: expr) :=
+  if Int.eq n1 Int.zero then e2
+  else if Int.eq n1 Int.mone then Eop (Ointconst Int.mone) Enil
+  else match e2 with
+  | Eop (Ointconst n2) Enil =>
+      Eop (Ointconst (Int.or n1 n2)) Enil
+  | Eop (Oorimm n2) (t2:::Enil) =>
+     Eop (Oorimm (Int.or n1 n2)) (t2:::Enil)
+  | _ =>
+     Eop (Oorimm n1) (e2:::Enil)
+  end.
+
+Definition same_expr_pure (e1 e2: expr) :=
+  match e1, e2 with
+  | Evar v1, Evar v2 => if ident_eq v1 v2 then true else false
+  | _, _ => false
+  end.
+
+Nondetfunction or (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => orimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => orimm n2 t1
+  | Eop (Oshlimm n1) (t1:::Enil), Eop (Oshruimm n2) (t2:::Enil) =>
+      if Int.eq (Int.add n1 n2) Int.iwordsize
+      && same_expr_pure t1 t2
+      then Eop (Ororimm n2) (t1:::Enil)
+      else Eop Oor (e1:::e2:::Enil)
+  | Eop (Oshruimm n2) (t2:::Enil), Eop (Oshlimm n1) (t1:::Enil) =>
+      if Int.eq (Int.add n1 n2) Int.iwordsize
+      && same_expr_pure t1 t2
+      then Eop (Ororimm n2) (t1:::Enil)
+      else Eop Oor (e1:::e2:::Enil)
+  | _, _ =>
+      Eop Oor (e1:::e2:::Enil)
+  end.
+
+Nondetfunction xorimm (n1: int) (e2: expr) :=
+  if Int.eq n1 Int.zero then e2
+  else match e2 with
+  | Eop (Ointconst n2) Enil =>
+      Eop (Ointconst (Int.xor n1 n2)) Enil
+  | Eop (Oxorimm n2) (t2:::Enil) =>
+     Eop (Oxorimm (Int.xor n1 n2)) (t2:::Enil)
+  | _ =>
+     Eop (Oxorimm n1) (e2:::Enil)
+  end.
+
+Nondetfunction xor (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => xorimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => xorimm n2 t1
+  | _, _ => Eop Oxor (e1:::e2:::Enil)
+  end.
+
+(** ** Integer division and modulus *)
+
+Definition divu (e1: expr) (e2: expr) := Eop Odivu (e1:::e2:::Enil).
+Definition modu (e1: expr) (e2: expr) := Eop Omodu (e1:::e2:::Enil).
+Definition divs (e1: expr) (e2: expr) := Eop Odiv (e1:::e2:::Enil).
+Definition mods (e1: expr) (e2: expr) := Eop Omod (e1:::e2:::Enil).
+
+(** ** General shifts *)
+
+Nondetfunction shl (e1: expr) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => shlimm e1 n2
+  | _ => Eop Oshl (e1:::e2:::Enil)
+  end.
+
+Nondetfunction shr (e1: expr) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => shrimm e1 n2
+  | _ => Eop Oshr (e1:::e2:::Enil)
+  end.
+
+Nondetfunction shru (e1: expr) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => shruimm e1 n2
+  | _ => Eop Oshru (e1:::e2:::Enil)
+  end.
+
+(** ** Floating-point arithmetic *)
+
+Definition negf (e: expr) :=  Eop Onegf (e ::: Enil).
+Definition absf (e: expr) :=  Eop Oabsf (e ::: Enil).
+Definition addf (e1 e2: expr) :=  Eop Oaddf (e1 ::: e2 ::: Enil).
+Definition subf (e1 e2: expr) :=  Eop Osubf (e1 ::: e2 ::: Enil).
+Definition mulf (e1 e2: expr) :=  Eop Omulf (e1 ::: e2 ::: Enil).
+Definition divf (e1 e2: expr) :=  Eop Odivf (e1 ::: e2 ::: Enil).
+
+(** ** Comparisons *)
+
+Nondetfunction comp (c: comparison) (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 =>
+      Eop (Ocmp (Ccompimm (swap_comparison c) n1)) (t2 ::: Enil)
+  | t1, Eop (Ointconst n2) Enil =>
+      Eop (Ocmp (Ccompimm c n2)) (t1 ::: Enil)
+  | _, _ =>
+      Eop (Ocmp (Ccomp c)) (e1 ::: e2 ::: Enil)
+  end.
+
+Nondetfunction compu (c: comparison) (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 =>
+      Eop (Ocmp (Ccompuimm (swap_comparison c) n1)) (t2 ::: Enil)
+  | t1, Eop (Ointconst n2) Enil =>
+      Eop (Ocmp (Ccompuimm c n2)) (t1 ::: Enil)
+  | _, _ =>
+      Eop (Ocmp (Ccompu c)) (e1 ::: e2 ::: Enil)
+  end.
+
+Definition compf (c: comparison) (e1: expr) (e2: expr) :=
+  Eop (Ocmp (Ccompf c)) (e1 ::: e2 ::: Enil).
+
+(** ** Integer conversions *)
+
+Nondetfunction cast8unsigned (e: expr) := 
+  match e with
+  | Eop (Oandimm n) (t:::Enil) =>
+      Eop (Oandimm (Int.and (Int.repr 255) n)) (t:::Enil)
+  | _ =>
+      Eop Ocast8unsigned (e:::Enil)
+  end.
+
+Definition cast8signed (e: expr) := Eop Ocast8signed (e ::: Enil).
+
+Nondetfunction cast16unsigned (e: expr) := 
+  match e with
+  | Eop (Oandimm n) (t:::Enil) =>
+      Eop (Oandimm (Int.and (Int.repr 65535) n)) (t:::Enil)
+  | _ =>
+      Eop Ocast16unsigned (e:::Enil)
+  end.
+
+Definition cast16signed (e: expr) := Eop Ocast16signed (e ::: Enil).
+
+(** Floating-point conversions *)
+
+Definition singleoffloat (e: expr) := Eop Osingleoffloat (e ::: Enil).
+Definition intoffloat (e: expr) := Eop Ointoffloat (e ::: Enil).
+Definition floatofint (e: expr) := Eop Ofloatofint (e ::: Enil).
+
+Definition intuoffloat (e: expr) :=
+  let f := Eop (Ofloatconst (Float.floatofintu Float.ox8000_0000)) Enil in
+  Elet e
+    (Econdition (CEcond (Ccompf Clt) (Eletvar O ::: f ::: Enil))
+      (intoffloat (Eletvar O))
+      (addimm Float.ox8000_0000 (intoffloat (subf (Eletvar O) f)))).
+
+Definition floatofintu (e: expr) :=
+  let f := Eop (Ofloatconst (Float.floatofintu Float.ox8000_0000)) Enil in
+  Elet e
+    (Econdition (CEcond (Ccompuimm Clt Float.ox8000_0000) (Eletvar O ::: Enil))
+      (floatofint (Eletvar O))
+      (addf (floatofint (addimm (Int.neg Float.ox8000_0000) (Eletvar O))) f)).
+
+(** ** Addressing modes *)
+
+Nondetfunction addressing (chunk: memory_chunk) (e: expr) :=
+  match e with
+  | Eop (Olea addr) args => (addr, args)
+  | _ => (Aindexed Int.zero, e:::Enil)
+  end.
+
diff --git a/ia32/SelectOpproof.v b/ia32/SelectOpproof.v
index 82bca26..f14b6a9 100644
--- a/ia32/SelectOpproof.v
+++ b/ia32/SelectOpproof.v
@@ -44,8 +44,6 @@ Variable m: mem.
 
 Ltac EvalOp := eapply eval_Eop; eauto with evalexpr.
 
-Ltac TrivialOp cstr := unfold cstr; intros; EvalOp.
-
 Ltac InvEval1 :=
   match goal with
   | [ H: (eval_expr _ _ _ _ _ (Eop _ Enil) _) |- _ ] =>
@@ -78,6 +76,12 @@ Ltac InvEval2 :=
 
 Ltac InvEval := InvEval1; InvEval2; InvEval2.
 
+Ltac TrivialExists :=
+  match goal with
+  | [ |- exists v, _ /\ Val.lessdef ?a v ] => exists a; split; [EvalOp | auto]
+  end.
+
+
 (** * Correctness of the smart constructors *)
 
 (** We now show that the code generated by "smart constructor" functions
@@ -100,66 +104,70 @@ Ltac InvEval := InvEval1; InvEval2; InvEval2.
   by the smart constructor.
 *)
 
+Definition unary_constructor_sound (cstr: expr -> expr) (sem: val -> val) : Prop :=
+  forall le a x,
+  eval_expr ge sp e m le a x ->
+  exists v, eval_expr ge sp e m le (cstr a) v /\ Val.lessdef (sem x) v.
+
+Definition binary_constructor_sound (cstr: expr -> expr -> expr) (sem: val -> val -> val) : Prop :=
+  forall le a x b y,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  exists v, eval_expr ge sp e m le (cstr a b) v /\ Val.lessdef (sem x y) v.
+
 Theorem eval_addrsymbol:
-  forall le id ofs b,
-  Genv.find_symbol ge id = Some b ->
-  eval_expr ge sp e m le (addrsymbol id ofs) (Vptr b ofs).
+  forall le id ofs,
+  exists v, eval_expr ge sp e m le (addrsymbol id ofs) v /\ Val.lessdef (symbol_address ge id ofs) v.
 Proof.
-  intros. unfold addrsymbol. econstructor. constructor. 
-  simpl. rewrite H. auto.
+  intros. unfold addrsymbol. econstructor; split. 
+  EvalOp. simpl; eauto. 
+  auto.
 Qed.
 
 Theorem eval_addrstack:
-  forall le ofs b n,
-  sp = Vptr b n ->
-  eval_expr ge sp e m le (addrstack ofs) (Vptr b (Int.add n ofs)).
+  forall le ofs,
+  exists v, eval_expr ge sp e m le (addrstack ofs) v /\ Val.lessdef (Val.add sp (Vint ofs)) v.
 Proof.
-  intros. unfold addrstack. econstructor. constructor. 
-  simpl. unfold offset_sp. rewrite H. auto.
+  intros. unfold addrstack. econstructor; split.
+  EvalOp. simpl; eauto. 
+  auto.
 Qed.
 
-Lemma eval_notbool_base:
-  forall le a v b,
-  eval_expr ge sp e m le a v ->
-  Val.bool_of_val v b ->
-  eval_expr ge sp e m le (notbool_base a) (Val.of_bool (negb b)).
-Proof. 
-  TrivialOp notbool_base. simpl. 
-  inv H0. 
-  rewrite Int.eq_false; auto.
-  rewrite Int.eq_true; auto.
-  reflexivity.
+Theorem eval_notint: unary_constructor_sound notint Val.notint.
+Proof.
+  unfold notint; red; intros. TrivialExists. 
 Qed.
 
-Hint Resolve Val.bool_of_true_val Val.bool_of_false_val
-             Val.bool_of_true_val_inv Val.bool_of_false_val_inv: valboolof.
-
-Theorem eval_notbool:
-  forall le a v b,
-  eval_expr ge sp e m le a v ->
-  Val.bool_of_val v b ->
-  eval_expr ge sp e m le (notbool a) (Val.of_bool (negb b)).
+Theorem eval_notbool: unary_constructor_sound notbool Val.notbool.
 Proof.
-  induction a; simpl; intros; try (eapply eval_notbool_base; eauto).
-  destruct o; try (eapply eval_notbool_base; eauto).
-
-  destruct e0. InvEval. 
-  inv H0. rewrite Int.eq_false; auto. 
-  simpl; eauto with evalexpr.
-  rewrite Int.eq_true; simpl; eauto with evalexpr.
-  eapply eval_notbool_base; eauto.
+  assert (DFL: 
+    forall le a x,
+    eval_expr ge sp e m le a x ->
+     exists v, eval_expr ge sp e m le (Eop (Ocmp (Ccompuimm Ceq Int.zero)) (a ::: Enil)) v
+           /\ Val.lessdef (Val.notbool x) v).
+  intros. TrivialExists. simpl. destruct x; simpl; auto.
 
-  inv H. eapply eval_Eop; eauto.
-  simpl. assert (eval_condition c vl m = Some b).
-  generalize H6. simpl. 
-  case (eval_condition c vl); intros.
-  destruct b0; inv H1; inversion H0; auto; congruence.
-  congruence.
-  rewrite (Op.eval_negate_condition _ _ _ H). 
-  destruct b; reflexivity.
+  red. induction a; simpl; intros; eauto. destruct o; eauto.
+(* intconst *)
+  destruct e0; eauto. InvEval. TrivialExists. simpl. destruct (Int.eq i Int.zero); auto.
+(* cmp *)
+  inv H. simpl in H5.
+  destruct (eval_condition c vl m) as []_eqn. 
+  TrivialExists. simpl. rewrite (eval_negate_condition _ _ _ Heqo). destruct b; inv H5; auto.
+  inv H5. simpl. 
+  destruct (eval_condition (negate_condition c) vl m) as []_eqn.
+  destruct b; [exists Vtrue | exists Vfalse]; split; auto; EvalOp; simpl. rewrite Heqo0; auto. rewrite Heqo0; auto.
+  exists Vundef; split; auto; EvalOp; simpl. rewrite Heqo0; auto.
+(* condition *)
+  inv H. destruct v1.
+  exploit IHa1; eauto. intros [v [A B]]. exists v; split; auto. eapply eval_Econdition; eauto. 
+  exploit IHa2; eauto. intros [v [A B]]. exists v; split; auto. eapply eval_Econdition; eauto. 
+Qed.
 
-  inv H. eapply eval_Econdition; eauto. 
-  destruct v1; eauto.
+Lemma shift_symbol_address:
+  forall id ofs n, symbol_address ge id (Int.add ofs n) = Val.add (symbol_address ge id ofs) (Vint n).
+Proof.
+  intros. unfold symbol_address. destruct (Genv.find_symbol); auto. 
 Qed.
 
 Lemma eval_offset_addressing:
@@ -168,322 +176,247 @@ Lemma eval_offset_addressing:
   eval_addressing ge sp (offset_addressing addr n) args = Some (Val.add v (Vint n)).
 Proof.
   intros. destruct addr; simpl in *; FuncInv; subst; simpl.
-  rewrite Int.add_assoc. auto.
-  rewrite Int.add_assoc. auto.
-  rewrite <- Int.add_assoc. auto.
-  rewrite <- Int.add_assoc. auto.
-  rewrite <- Int.add_assoc. auto.
-  rewrite <- Int.add_assoc. auto.
-  rewrite <- Int.add_assoc. decEq. decEq. repeat rewrite Int.add_assoc. auto.
-  decEq. decEq. repeat rewrite Int.add_assoc. auto.
-  destruct (Genv.find_symbol ge i); inv H. auto. 
-  destruct (Genv.find_symbol ge i); inv H. simpl. 
-  repeat rewrite Int.add_assoc. decEq. decEq. decEq. apply Int.add_commut.
-  destruct (Genv.find_symbol ge i0); inv H. simpl.
-  repeat rewrite Int.add_assoc. decEq. decEq. decEq. apply Int.add_commut.
-  unfold offset_sp in *. destruct sp; inv H. simpl. rewrite Int.add_assoc. auto.
+  rewrite Val.add_assoc. auto. 
+  repeat rewrite Val.add_assoc. auto.
+  rewrite Val.add_assoc. auto.
+  repeat rewrite Val.add_assoc. auto.
+  rewrite shift_symbol_address. auto. 
+  rewrite shift_symbol_address. repeat rewrite Val.add_assoc. decEq; decEq. apply Val.add_commut.
+  rewrite shift_symbol_address. repeat rewrite Val.add_assoc. decEq; decEq. apply Val.add_commut.
+  rewrite Val.add_assoc. auto.
 Qed.
 
 Theorem eval_addimm:
-  forall le n a x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (addimm n a) (Vint (Int.add x n)).
-Proof.
-  unfold addimm; intros until x.
-  generalize (Int.eq_spec n Int.zero). case (Int.eq n Int.zero); intro.
-  subst n. rewrite Int.add_zero. auto.
-  case (addimm_match a); intros; InvEval.
-  EvalOp. simpl. rewrite Int.add_commut. auto.
-  inv H0. EvalOp. simpl. rewrite (eval_offset_addressing _ _ _ _ H6). auto. 
-  EvalOp. 
-Qed. 
-
-Theorem eval_addimm_ptr:
-  forall le n a b ofs,
-  eval_expr ge sp e m le a (Vptr b ofs) ->
-  eval_expr ge sp e m le (addimm n a) (Vptr b (Int.add ofs n)).
-Proof.
-  unfold addimm; intros until ofs.
-  generalize (Int.eq_spec n Int.zero). case (Int.eq n Int.zero); intro.
-  subst n. rewrite Int.add_zero. auto.
-  case (addimm_match a); intros; InvEval.
-  inv H0. EvalOp. simpl. rewrite (eval_offset_addressing _ _ _ _ H6). auto. 
-  EvalOp. 
-Qed.
-
-Theorem eval_add:
-  forall le a b x y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (add a b) (Vint (Int.add x y)).
-Proof.
-  intros until y.
+  forall n, unary_constructor_sound (addimm n) (fun x => Val.add x (Vint n)).
+Proof.
+  red; unfold addimm; intros until x.
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  subst n. intros. exists x; split; auto. 
+  destruct x; simpl; auto. rewrite Int.add_zero. auto. rewrite Int.add_zero. auto.
+  case (addimm_match a); intros; InvEval; simpl.
+  TrivialExists; simpl. rewrite Int.add_commut. auto.
+  inv H0. simpl in H6. TrivialExists. simpl. eapply eval_offset_addressing; eauto.
+  TrivialExists. 
+Qed.
+
+Theorem eval_add: binary_constructor_sound add Val.add.
+Proof.
+  red; intros until y.
   unfold add; case (add_match a b); intros; InvEval.
-  rewrite Int.add_commut. apply eval_addimm. auto.
-  apply eval_addimm. auto.
-  subst. EvalOp. simpl. decEq. decEq. repeat rewrite Int.add_assoc. decEq. apply Int.add_permut.
-  subst. EvalOp. simpl. decEq. decEq. repeat rewrite Int.add_assoc. decEq. apply Int.add_permut.
-  subst. EvalOp. simpl. decEq. decEq.
-    rewrite Int.add_permut. rewrite Int.add_assoc. decEq. apply Int.add_permut.
-  destruct (Genv.find_symbol ge id); inv H0.
-  destruct (Genv.find_symbol ge id); inv H0.
-  destruct (Genv.find_symbol ge id); inv H0.
-  destruct (Genv.find_symbol ge id); inv H0.
-  subst. EvalOp. simpl. rewrite Int.add_commut. auto.
-  subst. EvalOp. 
-  subst. EvalOp. simpl. decEq. decEq. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  subst. EvalOp. simpl. decEq. decEq. apply Int.add_assoc.
-  EvalOp. simpl.  rewrite Int.add_zero. auto.
-Qed.
-
-Theorem eval_add_ptr:
-  forall le a b p x y,
-  eval_expr ge sp e m le a (Vptr p x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (add a b) (Vptr p (Int.add x y)).
-Proof.
-  intros until y. unfold add; case (add_match a b); intros; InvEval.
-  apply eval_addimm_ptr; auto.
-  subst. EvalOp; simpl. decEq. decEq. repeat rewrite Int.add_assoc. decEq. apply Int.add_permut.
-  subst. EvalOp; simpl. decEq. decEq. repeat rewrite Int.add_assoc. decEq. apply Int.add_permut.
-  destruct (Genv.find_symbol ge id); inv H0.
-  subst. EvalOp; simpl. destruct (Genv.find_symbol ge id); inv H0. 
-  decEq. decEq. rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  subst. EvalOp; simpl. destruct (Genv.find_symbol ge id); inv H0. 
-  decEq. decEq. rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  subst. EvalOp.
-  subst. EvalOp; simpl. decEq. decEq. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  subst. EvalOp; simpl. decEq. decEq. repeat rewrite Int.add_assoc. auto.
-  EvalOp; simpl. rewrite Int.add_zero. auto.
-Qed.
-
-Theorem eval_add_ptr_2:
-  forall le a b x p y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vptr p y) ->
-  eval_expr ge sp e m le (add a b) (Vptr p (Int.add y x)).
-Proof.
-  intros until y. unfold add; case (add_match a b); intros; InvEval.
-  apply eval_addimm_ptr; auto.
-  subst. EvalOp; simpl. decEq. decEq. repeat rewrite Int.add_assoc. decEq.
-    rewrite (Int.add_commut n1 n2). apply Int.add_permut.
-  subst. EvalOp; simpl. decEq. decEq. repeat rewrite Int.add_assoc. decEq. 
-    rewrite (Int.add_commut n1 n2). apply Int.add_permut.
-  subst. EvalOp; simpl. destruct (Genv.find_symbol ge id); inv H0. 
-  decEq. decEq. rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  destruct (Genv.find_symbol ge id); inv H0. 
-  subst. EvalOp; simpl. destruct (Genv.find_symbol ge id); inv H0. 
-  decEq. decEq. rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  subst. EvalOp. 
-  subst. EvalOp; simpl. decEq. decEq. repeat rewrite Int.add_assoc. auto.
-  subst. EvalOp; simpl. decEq. decEq. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  EvalOp; simpl. rewrite Int.add_zero. auto.
-Qed.
-
-Theorem eval_sub:
-  forall le a b x y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (sub a b) (Vint (Int.sub x y)).
-Proof.
-  intros until y.
-  unfold sub; case (sub_match a b); intros; InvEval.
-  rewrite Int.sub_add_opp. 
-    apply eval_addimm. assumption.
-  replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)).
-    apply eval_addimm. EvalOp.
-    subst x; subst y.
-    repeat rewrite Int.sub_add_opp.
-    repeat rewrite Int.add_assoc. decEq. 
-    rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr.
-  replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
-    apply eval_addimm. EvalOp.
-    subst x. rewrite Int.sub_add_l. auto.
-  replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
-    apply eval_addimm. EvalOp.
-    subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r. 
-  EvalOp.
-Qed.
-
-Theorem eval_sub_ptr_int:
-  forall le a b p x y,
-  eval_expr ge sp e m le a (Vptr p x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (sub a b) (Vptr p (Int.sub x y)).
-Proof.
-  intros until y.
+  rewrite Val.add_commut. apply eval_addimm; auto.
+  apply eval_addimm; auto.
+  subst. TrivialExists. simpl. rewrite Val.add_permut_4. auto.
+  subst. TrivialExists. simpl. rewrite Val.add_assoc. decEq; decEq. rewrite Val.add_permut. auto.
+  subst. TrivialExists. simpl. rewrite Val.add_permut_4. rewrite <- Val.add_permut. rewrite <- Val.add_assoc. auto.
+  subst. TrivialExists. simpl. rewrite shift_symbol_address. 
+    rewrite Val.add_commut. rewrite Val.add_assoc. decEq. decEq. apply Val.add_commut.
+  subst. TrivialExists. simpl. rewrite shift_symbol_address. rewrite Val.add_assoc.
+    decEq; decEq. apply Val.add_commut.
+  subst. TrivialExists. simpl. rewrite shift_symbol_address. rewrite Val.add_commut. 
+    rewrite Val.add_assoc. decEq; decEq. apply Val.add_commut.
+  subst. TrivialExists. simpl. rewrite shift_symbol_address.
+    rewrite Val.add_assoc. decEq; decEq. apply Val.add_commut.
+  subst. TrivialExists. simpl. rewrite Val.add_permut. rewrite Val.add_assoc.
+    decEq; decEq. apply Val.add_commut.
+  subst. TrivialExists.
+  subst. TrivialExists. simpl. repeat rewrite Val.add_assoc. decEq; decEq. apply Val.add_commut.
+  subst. TrivialExists. simpl. rewrite Val.add_assoc; auto.
+  TrivialExists. simpl. destruct x; destruct y; simpl; auto; rewrite Int.add_zero; auto.
+Qed.
+
+Theorem eval_sub: binary_constructor_sound sub Val.sub.
+Proof.
+  red; intros until y.
   unfold sub; case (sub_match a b); intros; InvEval.
-  rewrite Int.sub_add_opp. 
-    apply eval_addimm_ptr. assumption.
-  subst b0. replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)).
-    apply eval_addimm_ptr. EvalOp.
-    subst x; subst y.
-    repeat rewrite Int.sub_add_opp.
-    repeat rewrite Int.add_assoc. decEq. 
-    rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr.
-  subst b0. replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
-    apply eval_addimm_ptr. EvalOp.
-    subst x. rewrite Int.sub_add_l. auto.
-  replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
-    apply eval_addimm_ptr. EvalOp.
-    subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r. 
-  EvalOp.
-Qed.
-
-Theorem eval_sub_ptr_ptr:
-  forall le a b p x y,
-  eval_expr ge sp e m le a (Vptr p x) ->
-  eval_expr ge sp e m le b (Vptr p y) ->
-  eval_expr ge sp e m le (sub a b) (Vint (Int.sub x y)).
-Proof.
-  intros until y.
-  unfold sub; case (sub_match a b); intros; InvEval.
-  replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)).
-    apply eval_addimm. EvalOp. 
-    simpl; unfold eq_block. subst b0; subst b1; rewrite zeq_true. auto.
-    subst x; subst y.
-    repeat rewrite Int.sub_add_opp.
-    repeat rewrite Int.add_assoc. decEq. 
-    rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr.
-  subst b0. replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
-    apply eval_addimm. EvalOp.
-    simpl. unfold eq_block. rewrite zeq_true. auto.
-    subst x. rewrite Int.sub_add_l. auto.
-  subst b0. replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
-    apply eval_addimm. EvalOp.
-    simpl. unfold eq_block. rewrite zeq_true. auto.
-    subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r. 
-  EvalOp. simpl. unfold eq_block. rewrite zeq_true. auto.
+  rewrite Val.sub_add_opp. apply eval_addimm; auto.
+  subst. rewrite Val.sub_add_l. rewrite Val.sub_add_r. 
+    rewrite Val.add_assoc. simpl. rewrite Int.add_commut. rewrite <- Int.sub_add_opp.
+    apply eval_addimm; EvalOp.
+  subst. rewrite Val.sub_add_l. apply eval_addimm; EvalOp.
+  subst. rewrite Val.sub_add_r. apply eval_addimm; EvalOp.
+  TrivialExists.
+Qed.
+
+Theorem eval_negint: unary_constructor_sound negint (fun v => Val.sub Vzero v).
+Proof.
+  red; intros. unfold negint. TrivialExists.
 Qed.
 
 Theorem eval_shlimm:
-  forall le a n x,
-  eval_expr ge sp e m le a (Vint x) ->
-  Int.ltu n Int.iwordsize = true ->
-  eval_expr ge sp e m le (shlimm a n) (Vint (Int.shl x n)).
-Proof.
-  intros until x; unfold shlimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero).
-  intros. subst n. rewrite Int.shl_zero. auto.
-  case (shlimm_match a); intros. 
-  InvEval. EvalOp. 
-  case_eq (Int.ltu (Int.add n n1) Int.iwordsize); intros.
-  InvEval. revert H8. case_eq (Int.ltu n1 Int.iwordsize); intros; inv H8.
-  EvalOp. simpl. rewrite H2. rewrite Int.shl_shl; auto; rewrite Int.add_commut; auto.
-  EvalOp. simpl. rewrite H1; auto.
-  InvEval. subst. 
-  destruct (shift_is_scale n). 
-  EvalOp. simpl. decEq. decEq.
-  rewrite (Int.shl_mul (Int.add i n1)); auto. rewrite (Int.shl_mul n1); auto.
-  rewrite Int.mul_add_distr_l. auto.
-  EvalOp. constructor. EvalOp. simpl. eauto. constructor. simpl. rewrite H1. auto.
+  forall n, unary_constructor_sound (fun a => shlimm a n)
+                                    (fun x => Val.shl x (Vint n)).
+Proof.
+  red; intros until x.  unfold shlimm.
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shl_zero; auto.
+  destruct (shlimm_match a); intros; InvEval.
+  exists (Vint (Int.shl n1 n)); split. EvalOp. 
+  simpl. destruct (Int.ltu n Int.iwordsize); auto.
+  destruct (Int.ltu (Int.add n n1) Int.iwordsize) as []_eqn.
+  exists (Val.shl v1 (Vint (Int.add n n1))); split. EvalOp.
+  subst. destruct v1; simpl; auto. 
+  rewrite Heqb.
+  destruct (Int.ltu n1 Int.iwordsize) as []_eqn; simpl; auto.
+  destruct (Int.ltu n Int.iwordsize) as []_eqn; simpl; auto.
+  rewrite Int.add_commut. rewrite Int.shl_shl; auto. rewrite Int.add_commut; auto.
+  subst. TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. 
+  simpl. auto.
+  subst. destruct (shift_is_scale n).
+  econstructor; split. EvalOp. simpl. eauto.
+  destruct v1; simpl; auto. destruct (Int.ltu n Int.iwordsize); auto. 
+  rewrite Int.shl_mul. rewrite Int.mul_add_distr_l. rewrite (Int.shl_mul n1). auto.
+  TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. auto. 
   destruct (shift_is_scale n).
-  EvalOp. simpl. decEq. decEq.
-  rewrite Int.add_zero. symmetry. apply Int.shl_mul. 
-  EvalOp. simpl. rewrite H1; auto.
+  econstructor; split. EvalOp. simpl. eauto. 
+  destruct x; simpl; auto. destruct (Int.ltu n Int.iwordsize); auto. 
+  rewrite Int.add_zero. rewrite Int.shl_mul. auto. 
+  TrivialExists.
 Qed.
 
 Theorem eval_shruimm:
-  forall le a n x,
-  eval_expr ge sp e m le a (Vint x) ->
-  Int.ltu n Int.iwordsize = true ->
-  eval_expr ge sp e m le (shruimm a n) (Vint (Int.shru x n)).
-Proof.
-  intros until x; unfold shruimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero).
-  intros. subst n. rewrite Int.shru_zero. auto.
-  case (shruimm_match a); intros. 
-  InvEval. EvalOp. 
-  case_eq (Int.ltu (Int.add n n1) Int.iwordsize); intros.
-  InvEval. revert H8. case_eq (Int.ltu n1 Int.iwordsize); intros; inv H8.
-  EvalOp. simpl. rewrite H2. rewrite Int.shru_shru; auto; rewrite Int.add_commut; auto.
-  EvalOp. simpl. rewrite H1; auto. 
-  EvalOp. simpl. rewrite H1; auto.
+  forall n, unary_constructor_sound (fun a => shruimm a n)
+                                    (fun x => Val.shru x (Vint n)).
+Proof.
+  red; intros until x.  unfold shruimm.
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shru_zero; auto.
+  destruct (shruimm_match a); intros; InvEval.
+  exists (Vint (Int.shru n1 n)); split. EvalOp. 
+  simpl. destruct (Int.ltu n Int.iwordsize); auto.
+  destruct (Int.ltu (Int.add n n1) Int.iwordsize) as []_eqn.
+  exists (Val.shru v1 (Vint (Int.add n n1))); split. EvalOp.
+  subst. destruct v1; simpl; auto. 
+  rewrite Heqb.
+  destruct (Int.ltu n1 Int.iwordsize) as []_eqn; simpl; auto.
+  destruct (Int.ltu n Int.iwordsize) as []_eqn; simpl; auto.
+  rewrite Int.add_commut. rewrite Int.shru_shru; auto. rewrite Int.add_commut; auto.
+  subst. TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. 
+  simpl. auto.
+  TrivialExists.
 Qed.
 
 Theorem eval_shrimm:
-  forall le a n x,
-  eval_expr ge sp e m le a (Vint x) ->
-  Int.ltu n Int.iwordsize = true ->
-  eval_expr ge sp e m le (shrimm a n) (Vint (Int.shr x n)).
-Proof.
-  intros until x; unfold shrimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero).
-  intros. subst n. rewrite Int.shr_zero. auto.
-  case (shrimm_match a); intros. 
-  InvEval. EvalOp. 
-  case_eq (Int.ltu (Int.add n n1) Int.iwordsize); intros.
-  InvEval. revert H8. case_eq (Int.ltu n1 Int.iwordsize); intros; inv H8.
-  EvalOp. simpl. rewrite H2. rewrite Int.shr_shr; auto; rewrite Int.add_commut; auto.
-  EvalOp. simpl. rewrite H1; auto. 
-  EvalOp. simpl. rewrite H1; auto.
+  forall n, unary_constructor_sound (fun a => shrimm a n)
+                                    (fun x => Val.shr x (Vint n)).
+Proof.
+  red; intros until x.  unfold shrimm.
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shr_zero; auto.
+  destruct (shrimm_match a); intros; InvEval.
+  exists (Vint (Int.shr n1 n)); split. EvalOp. 
+  simpl. destruct (Int.ltu n Int.iwordsize); auto.
+  destruct (Int.ltu (Int.add n n1) Int.iwordsize) as []_eqn.
+  exists (Val.shr v1 (Vint (Int.add n n1))); split. EvalOp.
+  subst. destruct v1; simpl; auto. 
+  rewrite Heqb.
+  destruct (Int.ltu n1 Int.iwordsize) as []_eqn; simpl; auto.
+  destruct (Int.ltu n Int.iwordsize) as []_eqn; simpl; auto.
+  rewrite Int.add_commut. rewrite Int.shr_shr; auto. rewrite Int.add_commut; auto.
+  subst. TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. 
+  simpl. auto.
+  TrivialExists.
 Qed.
 
 Lemma eval_mulimm_base:
-  forall le a n x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (mulimm_base n a) (Vint (Int.mul x n)).
+  forall n, unary_constructor_sound (mulimm_base n) (fun x => Val.mul x (Vint n)).
 Proof.
-  intros; unfold mulimm_base.
+  intros; red; intros; unfold mulimm_base. 
   generalize (Int.one_bits_decomp n). 
   generalize (Int.one_bits_range n).
   destruct (Int.one_bits n).
-  intros. EvalOp. 
+  intros. TrivialExists. 
   destruct l.
   intros. rewrite H1. simpl. 
-  rewrite Int.add_zero. rewrite <- Int.shl_mul.
-  apply eval_shlimm. auto. auto with coqlib. 
+  rewrite Int.add_zero.
+  replace (Vint (Int.shl Int.one i)) with (Val.shl Vone (Vint i)). rewrite Val.shl_mul.
+  apply eval_shlimm. auto. simpl. rewrite H0; auto with coqlib.
   destruct l.
-  intros. apply eval_Elet with (Vint x). auto.
-  rewrite H1. simpl. rewrite Int.add_zero. 
-  rewrite Int.mul_add_distr_r.
-  apply eval_add. 
-  rewrite <- Int.shl_mul. apply eval_shlimm. constructor. auto. auto with coqlib.
-  rewrite <- Int.shl_mul. apply eval_shlimm. constructor. auto. auto with coqlib.
-  intros. EvalOp. 
+  intros. rewrite H1. simpl.
+  exploit (eval_shlimm i (x :: le) (Eletvar 0) x). constructor; auto. intros [v1 [A1 B1]].
+  exploit (eval_shlimm i0 (x :: le) (Eletvar 0) x). constructor; auto. intros [v2 [A2 B2]].
+  exploit eval_add. eexact A1. eexact A2. intros [v3 [A3 B3]].
+  exists v3; split. econstructor; eauto. 
+  rewrite Int.add_zero.
+  replace (Vint (Int.add (Int.shl Int.one i) (Int.shl Int.one i0)))
+     with (Val.add (Val.shl Vone (Vint i)) (Val.shl Vone (Vint i0))).
+  rewrite Val.mul_add_distr_r.
+  repeat rewrite Val.shl_mul. 
+  apply Val.lessdef_trans with (Val.add v1 v2); auto. apply Val.add_lessdef; auto. 
+  simpl. repeat rewrite H0; auto with coqlib. 
+  intros. TrivialExists. 
 Qed.
 
 Theorem eval_mulimm:
-  forall le a n x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (mulimm n a) (Vint (Int.mul x n)).
-Proof.
-  intros until x; unfold mulimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
-  subst n. rewrite Int.mul_zero. intros. EvalOp. 
-  generalize (Int.eq_spec n Int.one); case (Int.eq n Int.one); intro.
-  subst n. rewrite Int.mul_one. auto.
+  forall n, unary_constructor_sound (mulimm n) (fun x => Val.mul x (Vint n)).
+Proof.
+  intros; red; intros until x; unfold mulimm.
+  predSpec Int.eq Int.eq_spec n Int.zero. 
+  intros. exists (Vint Int.zero); split. EvalOp. 
+  destruct x; simpl; auto. subst n. rewrite Int.mul_zero. auto.
+  predSpec Int.eq Int.eq_spec n Int.one.
+  intros. exists x; split; auto.
+  destruct x; simpl; auto. subst n. rewrite Int.mul_one. auto.
   case (mulimm_match a); intros; InvEval.
-  EvalOp. rewrite Int.mul_commut. reflexivity.
-  subst. rewrite Int.mul_add_distr_l. 
-  rewrite (Int.mul_commut n n2). apply eval_addimm. apply eval_mulimm_base. auto.
-  apply eval_mulimm_base. assumption.
+  TrivialExists. simpl. rewrite Int.mul_commut; auto.
+  subst. rewrite Val.mul_add_distr_l. 
+  exploit eval_mulimm_base; eauto. instantiate (1 := n). intros [v' [A1 B1]].
+  exploit (eval_addimm (Int.mul n n2) le (mulimm_base n t2) v'). auto. intros [v'' [A2 B2]].
+  exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.add_lessdef; eauto. 
+  rewrite Val.mul_commut; auto.
+  apply eval_mulimm_base; auto.
 Qed.
 
-Theorem eval_mul:
-  forall le a b x y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (mul a b) (Vint (Int.mul x y)).
+Theorem eval_mul: binary_constructor_sound mul Val.mul.
 Proof.
-  intros until y.
+  red; intros until y.
   unfold mul; case (mul_match a b); intros; InvEval.
-  rewrite Int.mul_commut. apply eval_mulimm. auto. 
+  rewrite Val.mul_commut. apply eval_mulimm. auto. 
   apply eval_mulimm. auto.
-  EvalOp.
+  TrivialExists.
 Qed.
 
-Lemma eval_orimm:
-  forall le n a x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (orimm n a) (Vint (Int.or x n)).
+Theorem eval_andimm:
+  forall n, unary_constructor_sound (andimm n) (fun x => Val.and x (Vint n)).
 Proof.
-  intros. unfold orimm. 
-  predSpec Int.eq Int.eq_spec n Int.zero.
-  subst n. rewrite Int.or_zero. auto.
+  intros; red; intros until x. unfold andimm.
+  predSpec Int.eq Int.eq_spec n Int.zero. 
+  intros. exists (Vint Int.zero); split. EvalOp. 
+  destruct x; simpl; auto. subst n. rewrite Int.and_zero. auto.
+  predSpec Int.eq Int.eq_spec n Int.mone.
+  intros. exists x; split; auto.
+  destruct x; simpl; auto. subst n. rewrite Int.and_mone. auto.
+  case (andimm_match a); intros; InvEval.
+  TrivialExists. simpl. rewrite Int.and_commut; auto.
+  subst. TrivialExists. simpl. rewrite Val.and_assoc. rewrite Int.and_commut. auto.
+  subst. rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc. 
+  rewrite Int.and_commut. auto. compute; auto.
+  subst. rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc. 
+  rewrite Int.and_commut. auto. compute; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_and: binary_constructor_sound and Val.and.
+Proof.
+  red; intros until y; unfold and; case (and_match a b); intros; InvEval.
+  rewrite Val.and_commut. apply eval_andimm; auto.
+  apply eval_andimm; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_orimm:
+  forall n, unary_constructor_sound (orimm n) (fun x => Val.or x (Vint n)).
+Proof.
+  intros; red; intros until x. unfold orimm.
+  predSpec Int.eq Int.eq_spec n Int.zero. 
+  intros. exists x; split. auto.  
+  destruct x; simpl; auto. subst n. rewrite Int.or_zero. auto.
   predSpec Int.eq Int.eq_spec n Int.mone.
-  subst n. rewrite Int.or_mone. EvalOp.
-  EvalOp.
+  intros. exists (Vint Int.mone); split. EvalOp.
+  destruct x; simpl; auto. subst n. rewrite Int.or_mone. auto.
+  destruct (orimm_match a); intros; InvEval.
+  TrivialExists. simpl. rewrite Int.or_commut; auto.
+  subst. rewrite Val.or_assoc. simpl. rewrite Int.or_commut. TrivialExists. 
+  TrivialExists.
 Qed.
 
 Remark eval_same_expr:
@@ -501,432 +434,283 @@ Proof.
   discriminate.
 Qed.
 
-Theorem eval_or:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (or a b) (Vint (Int.or x y)).
-Proof.
-  intros until y; unfold or; case (or_match a b); intros; InvEval.
-
-  rewrite Int.or_commut. apply eval_orimm; auto.
-  apply eval_orimm; auto.
-
-  revert H7; case_eq (Int.ltu n1 Int.iwordsize); intros; inv H7.
-  revert H6; case_eq (Int.ltu n2 Int.iwordsize); intros; inv H6.
-  caseEq (Int.eq (Int.add n1 n2) Int.iwordsize
-          && same_expr_pure t1 t2); intro.
-  destruct (andb_prop _ _ H1).
-  generalize (Int.eq_spec (Int.add n1 n2) Int.iwordsize); rewrite H4; intros.
-  exploit eval_same_expr; eauto. intros [EQ1 EQ2]. inv EQ1. inv EQ2.
-  EvalOp. simpl. rewrite H0. rewrite <- Int.or_ror; auto.
-  EvalOp. econstructor. EvalOp. simpl. rewrite H; eauto.
-  econstructor. EvalOp. simpl. rewrite H0; eauto. constructor.
-  simpl. auto.
-
-  revert H7; case_eq (Int.ltu n2 Int.iwordsize); intros; inv H7.
-  revert H6; case_eq (Int.ltu n1 Int.iwordsize); intros; inv H6.
-  caseEq (Int.eq (Int.add n1 n2) Int.iwordsize
-          && same_expr_pure t1 t2); intro.
-  destruct (andb_prop _ _ H1).
-  generalize (Int.eq_spec (Int.add n1 n2) Int.iwordsize); rewrite H4; intros.
-  exploit eval_same_expr; eauto. intros [EQ1 EQ2]. inv EQ1. inv EQ2.
-  EvalOp. simpl. rewrite H. rewrite Int.or_commut. rewrite <- Int.or_ror; auto.
-  EvalOp. econstructor. EvalOp. simpl. rewrite H; eauto.
-  econstructor. EvalOp. simpl. rewrite H0; eauto. constructor.
-  simpl. auto.
+Lemma eval_or: binary_constructor_sound or Val.or.
+Proof.
+  red; intros until y; unfold or; case (or_match a b); intros.
+(* intconst *)
+  InvEval. rewrite Val.or_commut. apply eval_orimm; auto. 
+  InvEval. apply eval_orimm; auto.
+(* shlimm - shruimm *)
+  destruct (Int.eq (Int.add n1 n2) Int.iwordsize && same_expr_pure t1 t2) as []_eqn.
+  destruct (andb_prop _ _ Heqb0). 
+  generalize (Int.eq_spec (Int.add n1 n2) Int.iwordsize); rewrite H1; intros EQ.
+  InvEval. exploit eval_same_expr; eauto. intros [EQ1 EQ2]; subst. 
+  exists (Val.ror v0 (Vint n2)); split. EvalOp.
+  destruct v0; simpl; auto. 
+  destruct (Int.ltu n1 Int.iwordsize) as []_eqn; auto.
+  destruct (Int.ltu n2 Int.iwordsize) as []_eqn; auto.
+  simpl. rewrite <- Int.or_ror; auto.
+  TrivialExists. 
+(* shruimm - shlimm *) 
+  destruct (Int.eq (Int.add n1 n2) Int.iwordsize && same_expr_pure t1 t2) as []_eqn.
+  destruct (andb_prop _ _ Heqb0). 
+  generalize (Int.eq_spec (Int.add n1 n2) Int.iwordsize); rewrite H1; intros EQ.
+  InvEval. exploit eval_same_expr; eauto. intros [EQ1 EQ2]; subst. 
+  exists (Val.ror v1 (Vint n2)); split. EvalOp.
+  destruct v1; simpl; auto. 
+  destruct (Int.ltu n2 Int.iwordsize) as []_eqn; auto.
+  destruct (Int.ltu n1 Int.iwordsize) as []_eqn; auto.
+  simpl. rewrite Int.or_commut. rewrite <- Int.or_ror; auto.
+  TrivialExists. 
+(* default *)
+  TrivialExists.
+Qed.
+
+Theorem eval_xorimm:
+  forall n, unary_constructor_sound (xorimm n) (fun x => Val.xor x (Vint n)).
+Proof.
+  intros; red; intros until x. unfold xorimm.
+  predSpec Int.eq Int.eq_spec n Int.zero. 
+  intros. exists x; split. auto.  
+  destruct x; simpl; auto. subst n. rewrite Int.xor_zero. auto.
+  destruct (xorimm_match a); intros; InvEval.
+  TrivialExists. simpl. rewrite Int.xor_commut; auto.
+  subst. rewrite Val.xor_assoc. simpl. rewrite Int.xor_commut. TrivialExists. 
+  TrivialExists.
+Qed.
+
+Theorem eval_xor: binary_constructor_sound xor Val.xor.
+Proof.
+  red; intros until y; unfold xor; case (xor_match a b); intros; InvEval.
+  rewrite Val.xor_commut. apply eval_xorimm; auto.
+  apply eval_xorimm; auto.
+  TrivialExists.
+Qed.
 
-  EvalOp.
+Theorem eval_divs:
+  forall le a b x y z,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.divs x y = Some z ->
+  exists v, eval_expr ge sp e m le (divs a b) v /\ Val.lessdef z v.
+Proof.
+  intros. unfold divs. exists z; split. EvalOp. auto.
 Qed.
 
-Lemma eval_andimm:
-  forall le n a x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (andimm n a) (Vint (Int.and x n)).
+Theorem eval_divu:
+  forall le a b x y z,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.divu x y = Some z ->
+  exists v, eval_expr ge sp e m le (divu a b) v /\ Val.lessdef z v.
 Proof.
-  intros. unfold andimm. 
-  predSpec Int.eq Int.eq_spec n Int.zero.
-  subst n. rewrite Int.and_zero. EvalOp.
-  predSpec Int.eq Int.eq_spec n Int.mone.
-  subst n. rewrite Int.and_mone. auto.
-  EvalOp.
+  intros. unfold divu. exists z; split. EvalOp. auto.
 Qed.
 
-Theorem eval_and:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (and a b) (Vint (Int.and x y)).
+Theorem eval_mods:
+  forall le a b x y z,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.mods x y = Some z ->
+  exists v, eval_expr ge sp e m le (mods a b) v /\ Val.lessdef z v.
 Proof.
-  intros until y; unfold and. case (mul_match a b); intros.
-  InvEval. rewrite Int.and_commut. apply eval_andimm; auto.
-  InvEval. apply eval_andimm; auto.
-  EvalOp.
+  intros. unfold mods. exists z; split. EvalOp. auto.
 Qed.
 
-Lemma eval_xorimm:
-  forall le n a x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (xorimm n a) (Vint (Int.xor x n)).
+Theorem eval_modu:
+  forall le a b x y z,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.modu x y = Some z ->
+  exists v, eval_expr ge sp e m le (modu a b) v /\ Val.lessdef z v.
 Proof.
-  intros. unfold xorimm. 
-  predSpec Int.eq Int.eq_spec n Int.zero.
-  subst n. rewrite Int.xor_zero. auto.
-  EvalOp.
+  intros. unfold modu. exists z; split. EvalOp. auto.
 Qed.
 
-Theorem eval_xor:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (xor a b) (Vint (Int.xor x y)).
+Theorem eval_shl: binary_constructor_sound shl Val.shl.
 Proof.
-  intros until y; unfold xor. case (mul_match a b); intros.
-  InvEval. rewrite Int.xor_commut. apply eval_xorimm; auto.
-  InvEval. apply eval_xorimm; auto.
-  EvalOp.
+  red; intros until y; unfold shl; case (shl_match b); intros.
+  InvEval. apply eval_shlimm; auto.
+  TrivialExists. 
 Qed.
 
-Theorem eval_divu:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  y <> Int.zero ->
-  eval_expr ge sp e m le (divu a b) (Vint (Int.divu x y)).
+Theorem eval_shr: binary_constructor_sound shr Val.shr.
 Proof.
-  intros; unfold divu; EvalOp.
-  simpl. rewrite Int.eq_false; auto. 
+  red; intros until y; unfold shr; case (shr_match b); intros.
+  InvEval. apply eval_shrimm; auto.
+  TrivialExists. 
 Qed.
 
-Theorem eval_modu:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  y <> Int.zero ->
-  eval_expr ge sp e m le (modu a b) (Vint (Int.modu x y)).
+Theorem eval_shru: binary_constructor_sound shru Val.shru.
 Proof.
-  intros; unfold modu; EvalOp.
-  simpl. rewrite Int.eq_false; auto. 
+  red; intros until y; unfold shru; case (shru_match b); intros.
+  InvEval. apply eval_shruimm; auto.
+  TrivialExists. 
 Qed.
 
-Theorem eval_divs:
-  forall le a b x y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  y <> Int.zero ->
-  eval_expr ge sp e m le (divs a b) (Vint (Int.divs x y)).
+Theorem eval_negf: unary_constructor_sound negf Val.negf.
 Proof.
-  TrivialOp divs. simpl. 
-  predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
+  red; intros. TrivialExists. 
 Qed.
 
-Theorem eval_mods:
-  forall le a b x y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  y <> Int.zero ->
-  eval_expr ge sp e m le (mods a b) (Vint (Int.mods x y)).
+Theorem eval_absf: unary_constructor_sound absf Val.absf.
 Proof.
-  TrivialOp mods. simpl. 
-  predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
+  red; intros. TrivialExists. 
 Qed.
 
-Theorem eval_shl:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  Int.ltu y Int.iwordsize = true ->
-  eval_expr ge sp e m le (shl a b) (Vint (Int.shl x y)).
+Theorem eval_addf: binary_constructor_sound addf Val.addf.
 Proof.
-  intros until y; unfold shl; case (shift_match b); intros.
-  InvEval. apply eval_shlimm; auto.
-  EvalOp. simpl. rewrite H1. auto.
+  red; intros; TrivialExists.
+Qed.
+ 
+Theorem eval_subf: binary_constructor_sound subf Val.subf.
+Proof.
+  red; intros; TrivialExists.
 Qed.
 
-Theorem eval_shru:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  Int.ltu y Int.iwordsize = true ->
-  eval_expr ge sp e m le (shru a b) (Vint (Int.shru x y)).
+Theorem eval_mulf: binary_constructor_sound mulf Val.mulf.
 Proof.
-  intros until y; unfold shru; case (shift_match b); intros.
-  InvEval. apply eval_shruimm; auto.
-  EvalOp. simpl. rewrite H1. auto.
+  red; intros; TrivialExists.
 Qed.
 
-Theorem eval_shr:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  Int.ltu y Int.iwordsize = true ->
-  eval_expr ge sp e m le (shr a b) (Vint (Int.shr x y)).
+Theorem eval_divf: binary_constructor_sound divf Val.divf.
 Proof.
-  intros until y; unfold shr; case (shift_match b); intros.
-  InvEval. apply eval_shrimm; auto.
-  EvalOp. simpl. rewrite H1. auto.
+  red; intros; TrivialExists.
 Qed.
 
 Theorem eval_comp:
-  forall le c a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (comp c a b) (Val.of_bool(Int.cmp c x y)).
-Proof.
-  intros until y.
-  unfold comp; case (comp_match a b); intros; InvEval.
-  EvalOp. simpl. rewrite Int.swap_cmp. destruct (Int.cmp c x y); reflexivity.
-  EvalOp. simpl. destruct (Int.cmp c x y); reflexivity.
-  EvalOp. simpl. destruct (Int.cmp c x y); reflexivity.
-Qed.
-
-Theorem eval_compu_int:
-  forall le c a x b y,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  eval_expr ge sp e m le (compu c a b) (Val.of_bool(Int.cmpu c x y)).
-Proof.
-  intros until y.
-  unfold compu; case (comp_match a b); intros; InvEval.
-  EvalOp. simpl. rewrite Int.swap_cmpu. destruct (Int.cmpu c x y); reflexivity.
-  EvalOp. simpl. destruct (Int.cmpu c x y); reflexivity.
-  EvalOp. simpl. destruct (Int.cmpu c x y); reflexivity.
-Qed.
-
-Remark eval_compare_null_transf:
-  forall c x v,
-  Cminor.eval_compare_null c x = Some v ->
-  match eval_compare_null c x with
-  | Some true => Some Vtrue
-  | Some false => Some Vfalse
-  | None => None (A:=val)
-  end = Some v.
-Proof.
-  unfold Cminor.eval_compare_null, eval_compare_null; intros.
-  destruct (Int.eq x Int.zero); try discriminate. 
-  destruct c; try discriminate; auto.
-Qed.
-
-Theorem eval_compu_ptr_int:
-  forall le c a x1 x2 b y v,
-  eval_expr ge sp e m le a (Vptr x1 x2) ->
-  eval_expr ge sp e m le b (Vint y) ->
-  Cminor.eval_compare_null c y = Some v ->
-  eval_expr ge sp e m le (compu c a b) v.
-Proof.
-  intros until v.
-  unfold compu; case (comp_match a b); intros; InvEval.
-  EvalOp. simpl. apply eval_compare_null_transf; auto.
-  EvalOp. simpl. apply eval_compare_null_transf; auto.
-Qed.
-
-Remark eval_compare_null_swap:
-  forall c x,
-  Cminor.eval_compare_null (swap_comparison c) x = 
-  Cminor.eval_compare_null c x.
-Proof.
-  intros. unfold Cminor.eval_compare_null. 
-  destruct (Int.eq x Int.zero). destruct c; auto. auto.
-Qed.
-
-Theorem eval_compu_int_ptr:
-  forall le c a x b y1 y2 v,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le b (Vptr y1 y2) ->
-  Cminor.eval_compare_null c x = Some v ->
-  eval_expr ge sp e m le (compu c a b) v.
-Proof.
-  intros until v.
-  unfold compu; case (comp_match a b); intros; InvEval.
-  EvalOp. simpl. apply eval_compare_null_transf. 
-  rewrite eval_compare_null_swap; auto.
-  EvalOp. simpl. apply eval_compare_null_transf. auto.
-Qed.
-
-Theorem eval_compu_ptr_ptr:
-  forall le c a x1 x2 b y1 y2,
-  eval_expr ge sp e m le a (Vptr x1 x2) ->
-  eval_expr ge sp e m le b (Vptr y1 y2) ->
-  Mem.valid_pointer m x1 (Int.unsigned x2)
-  && Mem.valid_pointer m y1 (Int.unsigned y2) = true ->
-  x1 = y1 ->
-  eval_expr ge sp e m le (compu c a b) (Val.of_bool(Int.cmpu c x2 y2)).
-Proof.
-  intros until y2.
-  unfold compu; case (comp_match a b); intros; InvEval.
-  EvalOp. simpl. rewrite H1. subst y1. rewrite dec_eq_true. 
-  destruct (Int.cmpu c x2 y2); reflexivity.
-Qed.
-
-Theorem eval_compu_ptr_ptr_2:
-  forall le c a x1 x2 b y1 y2 v,
-  eval_expr ge sp e m le a (Vptr x1 x2) ->
-  eval_expr ge sp e m le b (Vptr y1 y2) ->
-  Mem.valid_pointer m x1 (Int.unsigned x2)
-  && Mem.valid_pointer m y1 (Int.unsigned y2) = true ->
-  x1 <> y1 ->
-  Cminor.eval_compare_mismatch c = Some v ->
-  eval_expr ge sp e m le (compu c a b) v.
-Proof.
-  intros until y2.
-  unfold compu; case (comp_match a b); intros; InvEval.
-  EvalOp. simpl. rewrite H1. rewrite dec_eq_false; auto.
-  destruct c; simpl in H3; inv H3; auto.
+  forall c, binary_constructor_sound (comp c) (Val.cmp c).
+Proof.
+  intros; red; intros until y. unfold comp; case (comp_match a b); intros; InvEval.
+  TrivialExists. simpl. rewrite Val.swap_cmp_bool. auto.
+  TrivialExists.
+  TrivialExists.
 Qed.
 
-Theorem eval_compf:
-  forall le c a x b y,
-  eval_expr ge sp e m le a (Vfloat x) ->
-  eval_expr ge sp e m le b (Vfloat y) ->
-  eval_expr ge sp e m le (compf c a b) (Val.of_bool(Float.cmp c x y)).
+Theorem eval_compu:
+  forall c, binary_constructor_sound (compu c) (Val.cmpu (Mem.valid_pointer m) c).
 Proof.
-  intros. unfold compf. EvalOp. simpl. 
-  destruct (Float.cmp c x y); reflexivity.
+  intros; red; intros until y. unfold compu; case (compu_match a b); intros; InvEval.
+  TrivialExists. simpl. rewrite Val.swap_cmpu_bool. auto.
+  TrivialExists.
+  TrivialExists.
 Qed.
 
-Theorem eval_cast8signed:
-  forall le a v,
-  eval_expr ge sp e m le a v ->
-  eval_expr ge sp e m le (cast8signed a) (Val.sign_ext 8 v).
-Proof. intros; unfold cast8signed; EvalOp. Qed.
-
-Theorem eval_cast8unsigned:
-  forall le a v,
-  eval_expr ge sp e m le a v ->
-  eval_expr ge sp e m le (cast8unsigned a) (Val.zero_ext 8 v).
-Proof. intros; unfold cast8unsigned; EvalOp. Qed.
-
-Theorem eval_cast16signed:
-  forall le a v,
-  eval_expr ge sp e m le a v ->
-  eval_expr ge sp e m le (cast16signed a) (Val.sign_ext 16 v).
-Proof. intros; unfold cast16signed; EvalOp. Qed.
+Theorem eval_compf:
+  forall c, binary_constructor_sound (compf c) (Val.cmpf c).
+Proof.
+  intros; red; intros. unfold compf. TrivialExists.
+Qed.
 
-Theorem eval_cast16unsigned:
-  forall le a v,
-  eval_expr ge sp e m le a v ->
-  eval_expr ge sp e m le (cast16unsigned a) (Val.zero_ext 16 v).
-Proof. intros; unfold cast16unsigned; EvalOp. Qed.
 
-Theorem eval_singleoffloat:
-  forall le a v,
-  eval_expr ge sp e m le a v ->
-  eval_expr ge sp e m le (singleoffloat a) (Val.singleoffloat v).
-Proof. intros; unfold singleoffloat; EvalOp. Qed.
+Theorem eval_cast8signed: unary_constructor_sound cast8signed (Val.sign_ext 8).
+Proof.
+  red; intros. unfold cast8signed. TrivialExists.
+Qed.
 
-Theorem eval_notint:
-  forall le a x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (notint a) (Vint (Int.xor x Int.mone)).
-Proof. intros; unfold notint; EvalOp. Qed.
+Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8).
+Proof.
+  red; intros until x. unfold cast8unsigned. destruct (cast8unsigned_match a); intros; InvEval.
+  subst. rewrite Val.zero_ext_and. rewrite Val.and_assoc. 
+  rewrite Int.and_commut. TrivialExists. compute; auto.
+  TrivialExists.
+Qed.
 
-Theorem eval_negint:
-  forall le a x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (negint a) (Vint (Int.neg x)).
-Proof. intros; unfold negint; EvalOp. Qed.
+Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16).
+Proof.
+  red; intros. unfold cast16signed. TrivialExists.
+Qed.
 
-Theorem eval_negf:
-  forall le a x,
-  eval_expr ge sp e m le a (Vfloat x) ->
-  eval_expr ge sp e m le (negf a) (Vfloat (Float.neg x)).
-Proof. intros; unfold negf; EvalOp. Qed.
+Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16).
+Proof.
+  red; intros until x. unfold cast16unsigned. destruct (cast16unsigned_match a); intros; InvEval.
+  subst. rewrite Val.zero_ext_and. rewrite Val.and_assoc. 
+  rewrite Int.and_commut. TrivialExists. compute; auto.
+  TrivialExists.
+Qed.
 
-Theorem eval_absf:
-  forall le a x,
-  eval_expr ge sp e m le a (Vfloat x) ->
-  eval_expr ge sp e m le (absf a) (Vfloat (Float.abs x)).
-Proof. intros; unfold absf; EvalOp. Qed.
+Theorem eval_singleoffloat: unary_constructor_sound singleoffloat Val.singleoffloat.
+Proof.
+  red; intros. unfold singleoffloat. TrivialExists.
+Qed.
 
 Theorem eval_intoffloat:
-  forall le a x n,
-  eval_expr ge sp e m le a (Vfloat x) ->
-  Float.intoffloat x = Some n ->
-  eval_expr ge sp e m le (intoffloat a) (Vint n).
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.intoffloat x = Some y ->
+  exists v, eval_expr ge sp e m le (intoffloat a) v /\ Val.lessdef y v.
 Proof.
-  intros; unfold intoffloat; EvalOp.
-  simpl. rewrite H0. auto.
+  intros; unfold intoffloat. TrivialExists. 
 Qed.
 
 Theorem eval_floatofint:
-  forall le a x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (floatofint a) (Vfloat (Float.floatofint x)).
-Proof. intros; unfold floatofint; EvalOp. Qed.
-
-Theorem eval_addf:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vfloat x) ->
-  eval_expr ge sp e m le b (Vfloat y) ->
-  eval_expr ge sp e m le (addf a b) (Vfloat (Float.add x y)).
-Proof. intros; unfold addf; EvalOp. Qed.
-
-Theorem eval_subf:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vfloat x) ->
-  eval_expr ge sp e m le b (Vfloat y) ->
-  eval_expr ge sp e m le (subf a b) (Vfloat (Float.sub x y)).
-Proof. intros; unfold subf; EvalOp. Qed.
-
-Theorem eval_mulf:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vfloat x) ->
-  eval_expr ge sp e m le b (Vfloat y) ->
-  eval_expr ge sp e m le (mulf a b) (Vfloat (Float.mul x y)).
-Proof. intros; unfold mulf; EvalOp. Qed.
-
-Theorem eval_divf:
-  forall le a x b y,
-  eval_expr ge sp e m le a (Vfloat x) ->
-  eval_expr ge sp e m le b (Vfloat y) ->
-  eval_expr ge sp e m le (divf a b) (Vfloat (Float.div x y)).
-Proof. intros; unfold divf; EvalOp. Qed.
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.floatofint x = Some y ->
+  exists v, eval_expr ge sp e m le (floatofint a) v /\ Val.lessdef y v.
+Proof.
+  intros; unfold floatofint. TrivialExists. 
+Qed.
 
 Theorem eval_intuoffloat:
-  forall le a x n,
-  eval_expr ge sp e m le a (Vfloat x) ->
-  Float.intuoffloat x = Some n ->
-  eval_expr ge sp e m le (intuoffloat a) (Vint n).
-Proof.
-  intros. unfold intuoffloat. 
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.intuoffloat x = Some y ->
+  exists v, eval_expr ge sp e m le (intuoffloat a) v /\ Val.lessdef y v.
+Proof.
+  intros. destruct x; simpl in H0; try discriminate. 
+  destruct (Float.intuoffloat f) as [n|]_eqn; simpl in H0; inv H0.
+  exists (Vint n); split; auto.
+  unfold intuoffloat. 
   econstructor. eauto. 
   set (im := Int.repr Int.half_modulus).
   set (fm := Float.floatofintu im).
-  assert (eval_expr ge sp e m (Vfloat x :: le) (Eletvar O) (Vfloat x)).
+  assert (eval_expr ge sp e m (Vfloat f :: le) (Eletvar O) (Vfloat f)).
     constructor. auto. 
-  apply eval_Econdition with (v1 := Float.cmp Clt x fm).
+  apply eval_Econdition with (v1 := Float.cmp Clt f fm).
   econstructor. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor.
   simpl. auto.
-  caseEq (Float.cmp Clt x fm); intros.
+  destruct (Float.cmp Clt f fm) as []_eqn.
   exploit Float.intuoffloat_intoffloat_1; eauto. intro EQ.
   EvalOp. simpl. rewrite EQ; auto.
   exploit Float.intuoffloat_intoffloat_2; eauto. intro EQ.
   replace n with (Int.add (Int.sub n Float.ox8000_0000) Float.ox8000_0000).
-  apply eval_addimm. eapply eval_intoffloat; eauto.
-  apply eval_subf; auto. EvalOp.
+  exploit (eval_addimm Float.ox8000_0000 (Vfloat f :: le)
+     (intoffloat
+        (subf (Eletvar 0)
+           (Eop (Ofloatconst (Float.floatofintu Float.ox8000_0000)) Enil)))).
+  unfold intoffloat, subf. 
+  EvalOp. constructor. EvalOp. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor.
+  simpl. eauto. constructor. simpl. rewrite EQ. simpl; eauto. 
+  intros [v [A B]]. simpl in B. inv B. auto.
   rewrite Int.sub_add_opp. rewrite Int.add_assoc. apply Int.add_zero. 
 Qed.
 
 Theorem eval_floatofintu:
-  forall le a x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (floatofintu a) (Vfloat (Float.floatofintu x)).
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.floatofintu x = Some y ->
+  exists v, eval_expr ge sp e m le (floatofintu a) v /\ Val.lessdef y v.
 Proof.
-  intros. unfold floatofintu. 
+  intros. destruct x; simpl in H0; try discriminate. inv H0.
+  exists (Vfloat (Float.floatofintu i)); split; auto.
   econstructor. eauto. 
   set (fm := Float.floatofintu Float.ox8000_0000).
-  assert (eval_expr ge sp e m (Vint x :: le) (Eletvar O) (Vint x)).
+  assert (eval_expr ge sp e m (Vint i :: le) (Eletvar O) (Vint i)).
     constructor. auto. 
-  apply eval_Econdition with (v1 := Int.ltu x Float.ox8000_0000).
+  apply eval_Econdition with (v1 := Int.ltu i Float.ox8000_0000).
   econstructor. constructor. eauto. constructor.
   simpl. auto.
-  caseEq (Int.ltu x Float.ox8000_0000); intros.
+  destruct (Int.ltu i Float.ox8000_0000) as []_eqn.
   rewrite Float.floatofintu_floatofint_1; auto.
-  apply eval_floatofint; auto.
-  rewrite Float.floatofintu_floatofint_2; auto.
-  fold fm. apply eval_addf. apply eval_floatofint. 
-  rewrite Int.sub_add_opp. apply eval_addimm; auto.
-  EvalOp.
+  unfold floatofint. EvalOp. 
+  exploit (eval_addimm (Int.neg Float.ox8000_0000) (Vint i :: le) (Eletvar 0)); eauto.
+  simpl. intros [v [A B]]. inv B. 
+  unfold addf. EvalOp. 
+  constructor. unfold floatofint. EvalOp. simpl; eauto. 
+  constructor. EvalOp. simpl; eauto. constructor. simpl; eauto. 
+  fold fm. rewrite Float.floatofintu_floatofint_2; auto.
+  rewrite Int.sub_add_opp. auto.
 Qed.
 
 Theorem eval_addressing: