Merge of the reuse-temps branch:

- Reload temporaries are marked as destroyed (set to Vundef) across
  operations in the semantics of LTL, LTLin, Linear and Mach, 
  allowing Asmgen to reuse them.
- Added IA32 port.
- Cleaned up float conversions and axiomatization of floats.



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

21 files changed, 9905 insertions, 0 deletions

diff --git a/ia32/Asm.v b/ia32/Asm.v
new file mode 100644
index 0000000..9c23d9d
--- /dev/null
+++ b/ia32/Asm.v
@@ -0,0 +1,759 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Abstract syntax and semantics for PowerPC assembly language *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memory.
+Require Import Events.
+Require Import Globalenvs.
+Require Import Smallstep.
+Require Import Locations.
+Require Import Stacklayout.
+Require Import Conventions.
+
+(** * Abstract syntax *)
+
+(** ** Registers. *)
+
+(** Integer registers. *)
+
+Inductive ireg: Type :=
+  | EAX: ireg  | EBX: ireg  | ECX: ireg  | EDX: ireg
+  | ESI: ireg  | EDI: ireg  | EBP: ireg  | ESP: ireg.
+
+(** Floating-point registers, i.e. SSE2 registers *)
+
+Inductive freg: Type :=
+  | XMM0: freg  | XMM1: freg  | XMM2: freg  | XMM3: freg
+  | XMM4: freg  | XMM5: freg  | XMM6: freg  | XMM7: freg.
+
+Lemma ireg_eq: forall (x y: ireg), {x=y} + {x<>y}.
+Proof. decide equality. Defined.
+
+Lemma freg_eq: forall (x y: freg), {x=y} + {x<>y}.
+Proof. decide equality. Defined.
+
+(** Condition bits *)
+
+Inductive crbit: Type := 
+  | ZF | CF | PF | SOF.
+
+(** All registers modeled here. *)
+
+Inductive preg: Type :=
+  | PC: preg                            (**r program counter *)
+  | IR: ireg -> preg                    (**r integer register *)
+  | FR: freg -> preg                    (**r XMM register *)
+  | ST0: preg                           (**r top of FP stack *)
+  | CR: crbit -> preg                   (**r bit of the condition register *)
+  | RA: preg.                   (**r pseudo-reg representing return address *)
+
+Coercion IR: ireg >-> preg.
+Coercion FR: freg >-> preg.
+Coercion CR: crbit >-> preg.
+
+(** ** Instruction set. *)
+
+Definition label := positive.
+
+(** General form of an addressing mode. *)
+
+Inductive addrmode: Type :=
+  | Addrmode (base: option ireg)
+             (ofs: option (ireg * int))
+             (const: int + ident * int).
+
+(** Testable conditions (for conditional jumps and more). *)
+
+Inductive testcond: Type :=
+  | Cond_e | Cond_ne
+  | Cond_b | Cond_be | Cond_ae | Cond_a
+  | Cond_l | Cond_le | Cond_ge | Cond_g
+  | Cond_p | Cond_np
+  | Cond_nep                            (**r synthetic: P or (not Z) *)
+  | Cond_enp.                           (**r synthetic: (not P) and Z *)
+
+(** Instructions.  IA32 instructions accept many combinations of
+  registers, memory references and immediate constants as arguments.
+  Here, we list the combinations that we actually use.
+  Naming conventions:
+- [r]: integer register operand
+- [f]: XMM register operand
+- [m]: memory operand
+- [i]: immediate integer operand
+- [s]: immediate symbol operand
+- [l]: immediate label operand
+- [st0]: top of floating-point stack
+- [cl]: the [CL] register
+- For two-operand instructions, the first suffix describes the result
+  (and first argument), the second suffix describes the second argument.
+*)
+
+Inductive instruction: Type :=
+  (** Moves *)
+  | Pmov_rr (rd: ireg) (r1: ireg)       (**r [mov] (32-bit int) *)
+  | Pmov_ri (rd: ireg) (n: int)
+  | Pmov_rm (rd: ireg) (a: addrmode)
+  | Pmov_mr (a: addrmode) (rs: ireg)
+  | Pmovd_fr (rd: freg) (r1: ireg)      (**r [movd] (32-bit int) *)
+  | Pmovd_rf (rd: ireg) (rd: freg)
+  | Pmovsd_ff (rd: freg) (r1: freg)     (**r [movsd] (single 64-bit float) *)
+  | Pmovsd_fi (rd: freg) (n: float)     (**r (pseudo-instruction) *)
+  | Pmovsd_fm (rd: freg) (a: addrmode)
+  | Pmovsd_mf (a: addrmode) (r1: freg)
+  | Pfld_f (r1: freg)                   (**r [fld] from XMM register (pseudo) *)
+  | Pfld_m (a: addrmode)                (**r [fld] from memory *)
+  | Pfstp_f (rd: freg)                  (**r [fstp] to XMM register (pseudo) *)
+  | Pfstp_m (a: addrmode)               (**r [fstp] to memory *)
+  (** Moves with conversion *)
+  | Pmovb_mr (a: addrmode) (rs: ireg)   (**r [mov] (8-bit int) *)
+  | Pmovw_mr (a: addrmode) (rs: ireg)   (**r [mov] (16-bit int) *)
+  | Pmovzb_rr (rd: ireg) (rs: ireg)    (**r [movzb] (8-bit zero-extension) *)
+  | Pmovzb_rm (rd: ireg) (a: addrmode)
+  | Pmovsb_rr (rd: ireg) (rs: ireg)    (**r [movsb] (8-bit sign-extension) *)
+  | Pmovsb_rm (rd: ireg) (a: addrmode)
+  | Pmovzw_rr (rd: ireg) (rs: ireg)    (**r [movzw] (16-bit zero-extension) *)
+  | Pmovzw_rm (rd: ireg) (a: addrmode)
+  | Pmovsw_rr (rd: ireg) (rs: ireg)    (**r [movsw] (16-bit sign-extension) *)
+  | Pmovsw_rm (rd: ireg) (a: addrmode)
+  | Pcvtss2sd_fm (rd: freg) (a: addrmode) (**r [cvtss2sd] (single float load) *)
+  | Pcvtsd2ss_ff (rd: freg) (r1: freg) (**r pseudo (single conversion) *)
+  | Pcvtsd2ss_mf (a: addrmode) (r1: freg) (**r [cvtsd2ss] (single float store *)
+  | Pcvttsd2si_rf (rd: ireg) (r1: freg) (**r double to signed int *)
+  | Pcvtsi2sd_fr (rd: freg) (r1: ireg)  (**r signed int to double *)
+  (** Integer arithmetic *)
+  | Plea (rd: ireg) (a: addrmode)
+  | Pneg (rd: ireg)
+  | Psub_rr (rd: ireg) (r1: ireg)
+  | Pimul_rr (rd: ireg) (r1: ireg)
+  | Pimul_ri (rd: ireg) (n: int)
+  | Pdiv (r1: ireg)
+  | Pidiv (r1: ireg)
+  | Pand_rr (rd: ireg) (r1: ireg)
+  | Pand_ri (rd: ireg) (n: int)
+  | Por_rr (rd: ireg) (r1: ireg)
+  | Por_ri (rd: ireg) (n: int)
+  | Pxor_rr (rd: ireg) (r1: ireg)
+  | Pxor_ri (rd: ireg) (n: int)
+  | Psal_rcl (rd: ireg)
+  | Psal_ri (rd: ireg) (n: int)
+  | Pshr_rcl (rd: ireg)
+  | Pshr_ri (rd: ireg) (n: int)
+  | Psar_rcl (rd: ireg)
+  | Psar_ri (rd: ireg) (n: int)
+  | Pror_ri (rd: ireg) (n: int)
+  | Pcmp_rr (r1 r2: ireg) 
+  | Pcmp_ri (r1: ireg) (n: int)
+  | Ptest_rr (r1 r2: ireg)
+  | Ptest_ri (r1: ireg) (n: int)
+  | Pcmov (c: testcond) (rd: ireg) (r1: ireg)
+  | Psetcc (c: testcond) (rd: ireg)
+  (** Floating-point arithmetic *)
+  | Paddd_ff (rd: freg) (r1: freg)
+  | Psubd_ff (rd: freg) (r1: freg)
+  | Pmuld_ff (rd: freg) (r1: freg)
+  | Pdivd_ff (rd: freg) (r1: freg)
+  | Pnegd (rd: freg)
+  | Pabsd (rd: freg)
+  | Pcomisd_ff (r1 r2: freg)
+  (** Branches and calls *)
+  | Pjmp_l (l: label)
+  | Pjmp_s (symb: ident)
+  | Pjmp_r (r: ireg)
+  | Pjcc (c: testcond)(l: label)
+  | Pjmptbl (r: ireg) (tbl: list label) (**r pseudo *)
+  | Pcall_s (symb: ident)
+  | Pcall_r (r: ireg)
+  | Pret
+  (** Pseudo-instructions *)
+  | Plabel(l: label)
+  | Pallocframe(lo hi: Z)(ofs_ra ofs_link: int)
+  | Pfreeframe(lo hi: Z)(ofs_ra ofs_link: int)
+  | Pbuiltin(ef: external_function)(args: list preg)(res: preg).
+
+Definition code := list instruction.
+Definition fundef := AST.fundef code.
+Definition program := AST.program fundef unit.
+
+(** * Operational semantics *)
+
+Lemma preg_eq: forall (x y: preg), {x=y} + {x<>y}.
+Proof. decide equality. apply ireg_eq. apply freg_eq. decide equality. Defined.
+
+Module PregEq.
+  Definition t := preg.
+  Definition eq := preg_eq.
+End PregEq.
+
+Module Pregmap := EMap(PregEq).
+
+Definition regset := Pregmap.t val.
+Definition genv := Genv.t fundef unit.
+
+Notation "a # b" := (a b) (at level 1, only parsing).
+Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level).
+
+(** Undefining some registers *)
+
+Fixpoint undef_regs (l: list preg) (rs: regset) : regset :=
+  match l with
+  | nil => rs
+  | r :: l' => undef_regs l' (rs#r <- Vundef)
+  end.
+
+Section RELSEM.
+
+(** Looking up instructions in a code sequence by position. *)
+
+Fixpoint find_instr (pos: Z) (c: code) {struct c} : option instruction :=
+  match c with
+  | nil => None
+  | i :: il => if zeq pos 0 then Some i else find_instr (pos - 1) il
+  end.
+
+(** Position corresponding to a label *)
+
+Definition is_label (lbl: label) (instr: instruction) : bool :=
+  match instr with
+  | Plabel lbl' => if peq lbl lbl' then true else false
+  | _ => false
+  end.
+
+Lemma is_label_correct:
+  forall lbl instr,
+  if is_label lbl instr then instr = Plabel lbl else instr <> Plabel lbl.
+Proof.
+  intros.  destruct instr; simpl; try discriminate.
+  case (peq lbl l); intro; congruence.
+Qed.
+
+Fixpoint label_pos (lbl: label) (pos: Z) (c: code) {struct c} : option Z :=
+  match c with
+  | nil => None
+  | instr :: c' =>
+      if is_label lbl instr then Some (pos + 1) else label_pos lbl (pos + 1) c'
+  end.
+
+Variable ge: genv.
+
+Definition symbol_offset (id: ident) (ofs: int) : val :=
+  match Genv.find_symbol ge id with
+  | Some b => Vptr b ofs
+  | None => Vundef
+  end.
+
+(** Evaluating an addressing mode *)
+
+Definition eval_addrmode (a: addrmode) (rs: regset) : val :=
+  match a with Addrmode base ofs const =>
+    Val.add (match base with
+              | None => Vzero
+              | Some r => rs r
+             end)
+    (Val.add (match ofs with
+              | None => Vzero
+              | Some(r, sc) =>
+                  if Int.eq sc Int.one then rs r else Val.mul (rs r) (Vint sc)
+              end)
+             (match const with
+              | inl ofs => Vint ofs
+              | inr(id, ofs) => symbol_offset id ofs
+              end))
+  end.
+
+(** Performing a comparison *)
+
+(** Integer comparison between x and y:
+-       ZF = 1 if x = y, 0 if x != y
+-       CF = 1 if x <u y, 0 if x >=u y
+-       SOF = 1 if x <s y, 0 if x >=s y
+-       PF is undefined
+
+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)
+     #SOF <- (Val.cmp Clt x y)
+     #PF  <- Vundef.
+
+(** Floating-point comparison between x and y:
+-       ZF = 1 if x=y or unordered, 0 if x<>y
+-       CF = 1 if x<y or unordered, 0 if x>=y
+-       PF = 1 if unordered, 0 if ordered.
+-       SOF is undefined
+*)
+
+Definition compare_floats (vx vy: val) (rs: regset) : regset :=
+  match vx, vy with
+  | Vfloat x, Vfloat y =>
+      rs #ZF  <- (Val.of_bool (negb (Float.cmp Cne x y)))
+         #CF  <- (Val.of_bool (negb (Float.cmp Cge x y)))
+         #PF  <- (Val.of_bool (negb (Float.cmp Ceq x y || Float.cmp Clt x y || Float.cmp Cgt x y)))
+         #SOF <- Vundef
+  | _, _ =>
+      undef_regs (CR ZF :: CR CF :: CR PF :: CR SOF :: nil) rs
+  end.
+
+(** Testing a condition *)
+
+Definition eval_testcond (c: testcond) (rs: regset) : option bool :=
+  match c with
+  | Cond_e =>
+      match rs ZF with
+      | Vint n => Some (Int.eq n Int.one)
+      | _ => None
+      end
+  | Cond_ne =>
+      match rs ZF with
+      | Vint n => Some (Int.eq n Int.zero)
+      | _ => None
+      end
+  | Cond_b =>
+      match rs CF with
+      | Vint n => Some (Int.eq n Int.one)
+      | _ => None
+      end
+  | Cond_be =>
+      match rs CF, rs ZF with
+      | Vint c, Vint z => Some (Int.eq c Int.one || Int.eq z Int.one)
+      | _, _ => None
+      end
+  | Cond_ae =>
+      match rs CF with
+      | Vint n => Some (Int.eq n Int.zero)
+      | _ => None
+      end
+  | Cond_a =>
+      match rs CF, rs ZF with
+      | Vint c, Vint z => Some (Int.eq c Int.zero && Int.eq z Int.zero)
+      | _, _ => None
+      end
+  | Cond_l =>
+      match rs SOF with
+      | Vint n => Some (Int.eq n Int.one)
+      | _ => None
+      end
+  | Cond_le =>
+      match rs SOF, rs ZF with
+      | Vint s, Vint z => Some (Int.eq s Int.one || Int.eq z Int.one)
+      | _, _ => None
+      end
+  | Cond_ge =>
+      match rs SOF with
+      | Vint n => Some (Int.eq n Int.zero)
+      | _ => None
+      end
+  | Cond_g =>
+      match rs SOF, rs ZF with
+      | Vint s, Vint z => Some (Int.eq s Int.zero && Int.eq z Int.zero)
+      | _, _ => None
+      end
+  | Cond_p =>
+      match rs PF with
+      | Vint n => Some (Int.eq n Int.one)
+      | _ => None
+      end
+  | Cond_np =>
+      match rs PF with
+      | Vint n => Some (Int.eq n Int.zero)
+      | _ => None
+      end
+  | Cond_nep =>
+      match rs PF, rs ZF with
+      | Vint p, Vint z => Some (Int.eq p Int.one || Int.eq z Int.zero)
+      | _, _ => None
+      end
+  | Cond_enp =>
+      match rs PF, rs ZF with
+      | Vint p, Vint z => Some (Int.eq p Int.zero && Int.eq z Int.one)
+      | _, _ => None
+      end
+  end.
+
+(** The semantics is purely small-step and defined as a function
+  from the current state (a register set + a memory state)
+  to either [Next rs' m'] where [rs'] and [m'] are the updated register
+  set and memory state after execution of the instruction at [rs#PC],
+  or [Stuck] if the processor is stuck. *)
+
+Inductive outcome: Type :=
+  | Next: regset -> mem -> outcome
+  | Stuck: outcome.
+
+(** Manipulations over the [PC] register: continuing with the next
+  instruction ([nextinstr]) or branching to a label ([goto_label]). *)
+
+Definition nextinstr (rs: regset) :=
+  rs#PC <- (Val.add rs#PC Vone).
+
+Definition nextinstr_nf (rs: regset) : regset :=
+  nextinstr (undef_regs (CR ZF :: CR CF :: CR PF :: CR SOF :: nil) rs).
+
+Definition goto_label (c: code) (lbl: label) (rs: regset) (m: mem) :=
+  match label_pos lbl 0 c with
+  | None => Stuck
+  | Some pos =>
+      match rs#PC with
+      | Vptr b ofs => Next (rs#PC <- (Vptr b (Int.repr pos))) m
+      | _ => Stuck
+    end
+  end.
+
+(** Auxiliaries for memory accesses. *)
+
+Definition exec_load (chunk: memory_chunk) (m: mem)
+                     (a: addrmode) (rs: regset) (rd: preg) :=
+  match Mem.loadv chunk m (eval_addrmode a rs) with
+  | Some v => Next (nextinstr_nf (rs#rd <- v)) m
+  | None => Stuck
+  end.
+
+Definition exec_store (chunk: memory_chunk) (m: mem)
+                      (a: addrmode) (rs: regset) (r1: preg) :=
+  match Mem.storev chunk m (eval_addrmode a rs) (rs r1) with
+  | Some m' => Next (nextinstr_nf rs) m'
+  | None => Stuck
+  end.
+
+(** Execution of a single instruction [i] in initial state
+    [rs] and [m].  Return updated state.  For instructions
+    that correspond to actual PowerPC instructions, the cases are
+    straightforward transliterations of the informal descriptions
+    given in the PowerPC reference manuals.  For pseudo-instructions,
+    refer to the informal descriptions given above.  Note that
+    we set to [Vundef] the registers used as temporaries by the
+    expansions of the pseudo-instructions, so that the PPC code
+    we generate cannot use those registers to hold values that
+    must survive the execution of the pseudo-instruction.
+*)
+
+Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome :=
+  match i with
+  (** Moves *)
+  | Pmov_rr rd r1 =>
+      Next (nextinstr (rs#rd <- (rs r1))) m
+  | Pmov_ri rd n =>
+      Next (nextinstr (rs#rd <- (Vint n))) m
+  | Pmov_rm rd a =>
+      exec_load Mint32 m a rs rd
+  | Pmov_mr a r1 =>
+      exec_store Mint32 m a rs r1
+  | Pmovd_fr rd r1 =>
+      Next (nextinstr (rs#rd <- (rs r1))) m
+  | Pmovd_rf rd r1 =>
+      Next (nextinstr (rs#rd <- (rs r1))) m
+  | Pmovsd_ff rd r1 =>
+      Next (nextinstr (rs#rd <- (rs r1))) m
+  | Pmovsd_fi rd n =>
+      Next (nextinstr (rs#rd <- (Vfloat n))) m
+  | Pmovsd_fm rd a =>
+      exec_load Mfloat64 m a rs rd
+  | Pmovsd_mf a r1 =>
+      exec_store Mfloat64 m a rs r1
+  | Pfld_f r1 =>
+      Next (nextinstr (rs#ST0 <- (rs r1))) m
+  | Pfld_m a =>
+      exec_load Mfloat64 m a rs ST0
+  | Pfstp_f rd =>
+      Next (nextinstr (rs#rd <- (rs ST0))) m
+  | Pfstp_m a =>
+      exec_store Mfloat64 m a rs ST0
+  (** Moves with conversion *)
+  | Pmovb_mr a r1 =>
+      exec_store Mint8unsigned m a rs r1
+  | Pmovw_mr a r1 =>
+      exec_store Mint16unsigned m a rs r1
+  | Pmovzb_rr rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.zero_ext 8 rs#r1))) m
+  | Pmovzb_rm rd a =>
+      exec_load Mint8unsigned m a rs rd
+  | Pmovsb_rr rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.sign_ext 8 rs#r1))) m
+  | Pmovsb_rm rd a =>
+      exec_load Mint8signed m a rs rd
+  | Pmovzw_rr rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.zero_ext 16 rs#r1))) m
+  | Pmovzw_rm rd a =>
+      exec_load Mint16unsigned m a rs rd
+  | Pmovsw_rr rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.sign_ext 16 rs#r1))) m
+  | Pmovsw_rm rd a =>
+      exec_load Mint16signed m a rs rd
+  | Pcvtss2sd_fm rd a =>
+      exec_load Mfloat32 m a rs rd
+  | Pcvtsd2ss_ff rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.singleoffloat rs#r1))) m
+  | Pcvtsd2ss_mf a r1 =>
+      exec_store Mfloat32 m a rs r1
+  | Pcvttsd2si_rf rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.intoffloat rs#r1))) m
+  | Pcvtsi2sd_fr rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.floatofint rs#r1))) m
+  (** Integer arithmetic *)
+  | Plea rd a =>
+      Next (nextinstr (rs#rd <- (eval_addrmode a rs))) m
+  | Pneg rd =>
+      Next (nextinstr_nf (rs#rd <- (Val.neg rs#rd))) m
+  | Psub_rr rd r1 =>
+      Next (nextinstr_nf (rs#rd <- (Val.sub rs#rd rs#r1))) m
+  | Pimul_rr rd r1 =>
+      Next (nextinstr_nf (rs#rd <- (Val.mul rs#rd rs#r1))) m
+  | 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
+  | 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
+  | Pand_rr rd r1 =>
+      Next (nextinstr_nf (rs#rd <- (Val.and rs#rd rs#r1))) m
+  | Pand_ri rd n =>
+      Next (nextinstr_nf (rs#rd <- (Val.and rs#rd (Vint n)))) m
+  | Por_rr rd r1 =>
+      Next (nextinstr_nf (rs#rd <- (Val.or rs#rd rs#r1))) m
+  | Por_ri rd n =>
+      Next (nextinstr_nf (rs#rd <- (Val.or rs#rd (Vint n)))) m
+  | Pxor_rr rd r1 =>
+      Next (nextinstr_nf (rs#rd <- (Val.xor rs#rd rs#r1))) m
+  | Pxor_ri rd n =>
+      Next (nextinstr_nf (rs#rd <- (Val.xor rs#rd (Vint n)))) m
+  | Psal_rcl rd =>
+      Next (nextinstr_nf (rs#rd <- (Val.shl rs#rd rs#ECX))) m
+  | Psal_ri rd n =>
+      Next (nextinstr_nf (rs#rd <- (Val.shl rs#rd (Vint n)))) m
+  | Pshr_rcl rd =>
+      Next (nextinstr_nf (rs#rd <- (Val.shru rs#rd rs#ECX))) m
+  | Pshr_ri rd n =>
+      Next (nextinstr_nf (rs#rd <- (Val.shru rs#rd (Vint n)))) m
+  | Psar_rcl rd =>
+      Next (nextinstr_nf (rs#rd <- (Val.shr rs#rd rs#ECX))) m
+  | Psar_ri rd n =>
+      Next (nextinstr_nf (rs#rd <- (Val.shr rs#rd (Vint n)))) m
+  | 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
+  | Pcmp_ri r1 n =>
+      Next (nextinstr (compare_ints (rs r1) (Vint n) rs)) m
+  | Ptest_rr r1 r2 =>
+      Next (nextinstr (compare_ints (Val.and (rs r1) (rs r2)) Vzero rs)) m
+  | Ptest_ri r1 n =>
+      Next (nextinstr (compare_ints (Val.and (rs r1) (Vint n)) Vzero rs)) 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
+      end
+  | Psetcc c rd =>
+      match eval_testcond c rs with
+      | Some true => Next (nextinstr (rs#ECX <- Vundef #EDX <- Vundef #rd <- Vtrue)) m
+      | Some false => Next (nextinstr (rs#ECX <- Vundef #EDX <- Vundef #rd <- Vfalse)) m
+      | None => Stuck
+      end
+  (** Arithmetic operations over floats *)
+  | Paddd_ff rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.addf rs#rd rs#r1))) m
+  | Psubd_ff rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.subf rs#rd rs#r1))) m
+  | Pmuld_ff rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.mulf rs#rd rs#r1))) m
+  | Pdivd_ff rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.divf rs#rd rs#r1))) m
+  | Pnegd rd =>
+      Next (nextinstr (rs#rd <- (Val.negf rs#rd))) m
+  | Pabsd rd =>
+      Next (nextinstr (rs#rd <- (Val.absf rs#rd))) m
+  | Pcomisd_ff r1 r2 =>
+      Next (nextinstr (compare_floats (rs r1) (rs r2) rs)) m
+  (** Branches and calls *)
+  | Pjmp_l lbl =>
+      goto_label c lbl rs m
+  | Pjmp_s id =>
+      Next (rs#PC <- (symbol_offset id Int.zero)) m
+  | Pjmp_r r =>
+      Next (rs#PC <- (rs r)) m
+  | Pjcc cond lbl =>
+      match eval_testcond cond rs with
+      | Some true => goto_label c lbl rs m
+      | Some false => Next (nextinstr rs) m
+      | None => Stuck
+      end
+  | Pjmptbl r tbl =>
+      match rs#r with
+      | Vint n => 
+          match list_nth_z tbl (Int.signed n) with
+          | None => Stuck
+          | Some lbl => goto_label c lbl (rs #ECX <- Vundef #EDX <- Vundef) m
+          end
+      | _ => Stuck
+      end
+  | Pcall_s id =>
+      Next (rs#RA <- (Val.add rs#PC Vone) #PC <- (symbol_offset id Int.zero)) m
+  | Pcall_r r =>
+      Next (rs#RA <- (Val.add rs#PC Vone) #PC <- (rs r)) m
+  | Pret =>
+      Next (rs#PC <- (rs#RA)) m
+  (** Pseudo-instructions *)
+  | Plabel lbl =>
+      Next (nextinstr rs) m
+  | Pallocframe lo hi ofs_ra ofs_link =>
+      let (m1, stk) := Mem.alloc m lo hi in
+      let sp := Vptr stk (Int.repr lo) in
+      match Mem.storev Mint32 m1 (Val.add sp (Vint ofs_link)) rs#ESP with
+      | None => Stuck
+      | Some m2 =>
+          match Mem.storev Mint32 m2 (Val.add sp (Vint ofs_ra)) rs#RA with
+          | None => Stuck
+          | Some m3 => Next (nextinstr (rs#ESP <- sp)) m3
+          end
+      end
+  | Pfreeframe lo hi ofs_ra ofs_link =>
+      match Mem.loadv Mint32 m (Val.add rs#ESP (Vint ofs_ra)) with
+      | None => Stuck
+      | Some ra =>
+          match Mem.loadv Mint32 m (Val.add rs#ESP (Vint ofs_link)) with
+          | None => Stuck
+          | Some sp =>
+              match rs#ESP with
+              | Vptr stk ofs =>
+                  match Mem.free m stk lo hi with
+                  | None => Stuck
+                  | Some m' => Next (nextinstr (rs#ESP <- sp #RA <- ra)) m'
+                  end
+              | _ => Stuck
+              end
+          end
+      end
+  | Pbuiltin ef args res =>
+      Stuck                             (**r treated specially below *)
+  end.
+
+(** Translation of the LTL/Linear/Mach view of machine registers
+  to the Asm view.  *)
+
+Definition preg_of (r: mreg) : preg :=
+  match r with
+  | AX => IR EAX
+  | BX => IR EBX
+  | SI => IR ESI
+  | DI => IR EDI
+  | BP => IR EBP
+  | X0 => FR XMM0
+  | X1 => FR XMM1
+  | X2 => FR XMM2
+  | X3 => FR XMM3
+  | X4 => FR XMM4
+  | X5 => FR XMM5
+  | IT1 => IR EDX
+  | IT2 => IR ECX
+  | FT1 => FR XMM6
+  | FT2 => FR XMM7
+  | FP0 => ST0
+  end.
+
+(** Extract the values of the arguments of an external call.
+    We exploit the calling conventions from module [Conventions], except that
+    we use machine registers instead of locations. *)
+
+Inductive extcall_arg (rs: regset) (m: mem): loc -> val -> Prop :=
+  | extcall_arg_reg: forall r,
+      extcall_arg rs m (R r) (rs (preg_of r))
+  | extcall_arg_int_stack: forall ofs bofs v,
+      bofs = Stacklayout.fe_ofs_arg + 4 * ofs ->
+      Mem.loadv Mint32 m (Val.add (rs (IR ESP)) (Vint (Int.repr bofs))) = Some v ->
+      extcall_arg rs m (S (Outgoing ofs Tint)) v
+  | extcall_arg_float_stack: forall ofs bofs v,
+      bofs = Stacklayout.fe_ofs_arg + 4 * ofs ->
+      Mem.loadv Mfloat64 m (Val.add (rs (IR ESP)) (Vint (Int.repr bofs))) = Some v ->
+      extcall_arg rs m (S (Outgoing ofs Tfloat)) v.
+
+Inductive extcall_args (rs: regset) (m: mem): list loc -> list val -> Prop :=
+  | extcall_args_nil:
+      extcall_args rs m nil nil
+  | extcall_args_cons: forall l1 ll v1 vl,
+      extcall_arg rs m l1 v1 -> extcall_args rs m ll vl ->
+      extcall_args rs m (l1 :: ll) (v1 :: vl).
+
+Definition extcall_arguments
+    (rs: regset) (m: mem) (sg: signature) (args: list val) : Prop :=
+  extcall_args rs m (loc_arguments sg) args.
+
+Definition loc_external_result (sg: signature) : preg :=
+  preg_of (loc_result sg).
+
+(** Execution of the instruction at [rs#PC]. *)
+
+Inductive state: Type :=
+  | State: regset -> mem -> state.
+
+Inductive step: state -> trace -> state -> Prop :=
+  | exec_step_internal:
+      forall b ofs c i rs m rs' m',
+      rs PC = Vptr b ofs ->
+      Genv.find_funct_ptr ge b = Some (Internal c) ->
+      find_instr (Int.unsigned ofs) c = Some i ->
+      exec_instr c i rs m = Next rs' m' ->
+      step (State rs m) E0 (State rs' m')
+  | exec_step_builtin:
+      forall b ofs c ef args res rs m t v m',
+      rs PC = Vptr b ofs ->
+      Genv.find_funct_ptr ge b = Some (Internal c) ->
+      find_instr (Int.unsigned ofs) c = Some (Pbuiltin ef args res) ->
+      external_call ef ge (map rs args) m t v m' ->
+      step (State rs m) t
+           (State (nextinstr_nf(rs #EDX <- Vundef #ECX <- Vundef
+                                #XMM6 <- Vundef #XMM7 <- Vundef
+                                #ST0 <- Vundef
+                                #res <- v)) m')
+  | exec_step_external:
+      forall b ef args res rs m t rs' m',
+      rs PC = Vptr b Int.zero ->
+      Genv.find_funct_ptr ge b = Some (External ef) ->
+      external_call ef ge args m t res m' ->
+      extcall_arguments rs m ef.(ef_sig) args ->
+      rs' = (rs#(loc_external_result ef.(ef_sig)) <- res
+               #PC <- (rs RA)) ->
+      step (State rs m) t (State rs' m').
+
+End RELSEM.
+
+(** Execution of whole programs. *)
+
+Inductive initial_state (p: program): state -> Prop :=
+  | initial_state_intro: forall m0,
+      Genv.init_mem p = Some m0 ->
+      let ge := Genv.globalenv p in
+      let rs0 :=
+        (Pregmap.init Vundef)
+        # PC <- (symbol_offset ge p.(prog_main) Int.zero)
+        # RA <- Vzero
+        # ESP <- (Vptr Mem.nullptr Int.zero) in
+      initial_state p (State rs0 m0).
+
+Inductive final_state: state -> int -> Prop :=
+  | final_state_intro: forall rs m r,
+      rs#PC = Vzero ->
+      rs#EAX = Vint r ->
+      final_state (State rs m) r.
+      
+Definition exec_program (p: program) (beh: program_behavior) : Prop :=
+  program_behaves step (initial_state p) final_state (Genv.globalenv p) beh.
+
diff --git a/ia32/Asmgen.v b/ia32/Asmgen.v
new file mode 100644
index 0000000..70929ff
--- /dev/null
+++ b/ia32/Asmgen.v
@@ -0,0 +1,505 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Translation from Mach to IA32 Asm. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Errors.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memory.
+Require Import Globalenvs.
+Require Import Op.
+Require Import Locations.
+Require Import Mach.
+Require Import Asm.
+
+Open Local Scope string_scope.
+Open Local Scope error_monad_scope.
+
+(** The code generation functions take advantage of several characteristics of the [Mach] code generated by earlier passes of the compiler:
+- Argument and result registers are of the correct type.
+- For two-address instructions, the result and the first argument
+  are in the same register.  (True by construction in [RTLgen], and preserved by [Reload].)
+- The first argument register is never [ECX] (a.k.a. [IT2]) nor [XMM7]
+  (a.k.a [FT2]).
+- The top of the floating-point stack ([ST0], a.k.a. [FP0]) can only
+  appear in [mov] instructions, but never in arithmetic instructions.
+
+All these properties are true by construction, but it is painful to track them statically.  Instead, we recheck them during code generation and fail if they do not hold.
+*)
+
+(** Extracting integer or float registers. *)
+
+Definition ireg_of (r: mreg) : res ireg :=
+  match preg_of r with IR mr => OK mr | _ => Error(msg "Asmgen.ireg_of") end.
+
+Definition freg_of (r: mreg) : res freg :=
+  match preg_of r with FR mr => OK mr | _ => Error(msg "Asmgen.freg_of") end.
+
+(** Smart constructors for various operations. *)
+
+Definition mk_mov (rd rs: preg) (k: code) : res code :=
+  match rd, rs with
+  | IR rd, IR rs => OK (Pmov_rr rd rs :: k)
+  | FR rd, FR rs => OK (Pmovsd_ff rd rs :: k)
+  | ST0, FR rs => OK (Pfld_f rs :: k)
+  | FR rd, ST0 => OK (Pfstp_f rd :: k)
+  | _, _ => Error(msg "Asmgen.mk_mov")
+  end.
+
+Definition mk_shift (shift_instr: ireg -> instruction)
+                    (r1 r2: ireg) (k: code) : res code :=
+  if ireg_eq r2 ECX then
+    OK (shift_instr r1 :: k)
+  else
+    do x <- assertion (negb (ireg_eq r1 ECX));
+    OK (Pmov_rr ECX r2 :: shift_instr r1 :: k).
+
+Definition mk_div (div_instr: ireg -> instruction)
+                  (r1 r2: ireg) (k: code) : res code :=
+  if ireg_eq r1 EAX then
+    if ireg_eq r2 EDX then
+      OK (Pmov_rr ECX EDX :: div_instr ECX :: k)
+    else
+      OK (div_instr r2 :: k)
+  else
+    do x <- assertion (negb (ireg_eq r1 ECX));
+    if ireg_eq r2 EAX then
+      OK (Pmov_rr ECX EAX :: Pmov_rr EAX r1 ::
+          div_instr ECX ::
+          Pmov_rr r1 EAX :: Pmov_rr EAX ECX :: k)
+    else
+      OK (Pmovd_fr XMM7 EAX :: Pmov_rr ECX r2 :: Pmov_rr EAX r1 ::
+          div_instr ECX ::
+          Pmov_rr r2 ECX :: Pmov_rr r1 EAX :: Pmovd_rf EAX XMM7 :: k).
+
+Definition mk_mod (div_instr: ireg -> instruction)
+                  (r1 r2: ireg) (k: code) : res code :=
+  if ireg_eq r1 EAX then
+    if ireg_eq r2 EDX then
+      OK (Pmov_rr ECX EDX :: div_instr ECX :: Pmov_rr EAX EDX :: k)
+    else
+      OK (div_instr r2 :: Pmov_rr EAX EDX :: k)
+  else
+    do x <- assertion (negb (ireg_eq r1 ECX));
+    if ireg_eq r2 EDX then
+      OK (Pmovd_fr XMM7 EAX :: Pmov_rr ECX EDX :: Pmov_rr EAX r1 ::
+          div_instr ECX ::
+          Pmov_rr r1 EDX :: Pmovd_rf EAX XMM7 :: k)
+    else
+      OK (Pmovd_fr XMM7 EAX :: Pmov_rr ECX r2 :: Pmov_rr EAX r1 ::
+          div_instr ECX ::
+          Pmov_rr r2 ECX :: Pmov_rr r1 EDX :: Pmovd_rf EAX XMM7 :: k).
+
+Definition mk_shrximm (r: ireg) (n: int) (k: code) : res code :=
+  do x <- assertion (negb (ireg_eq r ECX));
+  let p := Int.sub (Int.shl Int.one n) Int.one in
+  OK (Ptest_rr r r ::
+      Plea ECX (Addrmode (Some r) None (inl _ p)) ::
+      Pcmov Cond_l r ECX ::
+      Psar_ri r n :: k).
+
+Definition low_ireg (r: ireg) : bool :=
+  match r with
+  | EAX | EBX | ECX | EDX => true
+  | ESI | EDI | EBP | ESP => false
+  end.
+
+Definition mk_intconv (mk: ireg -> ireg -> instruction) (rd rs: ireg) (k: code) :=
+  if low_ireg rs then
+    OK (mk rd rs :: k)
+  else
+    OK (Pmov_rr EDX rs :: mk rd EDX :: k).
+
+Definition mk_smallstore (sto: addrmode -> ireg ->instruction) 
+                         (addr: addrmode) (rs: ireg) (k: code) :=
+  if low_ireg rs then
+    OK (sto addr rs :: k)
+  else
+    OK (Plea ECX addr :: Pmov_rr EDX rs ::
+        sto (Addrmode (Some ECX) None (inl _ Int.zero)) EDX :: k).
+
+(** Accessing slots in the stack frame.  *)
+
+Definition loadind (base: ireg) (ofs: int) (ty: typ) (dst: mreg) (k: code) :=
+  match ty with
+  | Tint =>
+      do r <- ireg_of dst;
+      OK (Pmov_rm r (Addrmode (Some base) None (inl _ ofs)) :: k)
+  | Tfloat =>
+      match preg_of dst with
+      | FR r => OK (Pmovsd_fm r (Addrmode (Some base) None (inl _ ofs)) :: k)
+      | ST0  => OK (Pfld_m (Addrmode (Some base) None (inl _ ofs)) :: k)
+      | _ => Error (msg "Asmgen.loadind")
+      end
+  end.
+
+Definition storeind (src: mreg) (base: ireg) (ofs: int) (ty: typ) (k: code) :=
+  match ty with
+  | Tint =>
+      do r <- ireg_of src;
+      OK (Pmov_mr (Addrmode (Some base) None (inl _ ofs)) r :: k)
+  | Tfloat =>
+      match preg_of src with
+      | FR r => OK (Pmovsd_mf (Addrmode (Some base) None (inl _ ofs)) r :: k)
+      | ST0  => OK (Pfstp_m (Addrmode (Some base) None (inl _ ofs)) :: k)
+      | _ => Error (msg "Asmgen.loadind")
+      end
+  end.
+
+(** Translation of addressing modes *)
+
+Definition transl_addressing (a: addressing) (args: list mreg): res addrmode :=
+  match a, args with
+  | Aindexed n, a1 :: nil =>
+      do r1 <- ireg_of a1; OK(Addrmode (Some r1) None (inl _ n))
+  | Aindexed2 n, a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK(Addrmode (Some r1) (Some(r2, Int.one)) (inl _ n))
+  | Ascaled sc n, a1 :: nil =>
+      do r1 <- ireg_of a1; OK(Addrmode None (Some(r1, sc)) (inl _ n))
+  | Aindexed2scaled sc n, a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK(Addrmode (Some r1) (Some(r2, sc)) (inl _ n))
+  | Aglobal id ofs, nil =>
+      OK(Addrmode None None (inr _ (id, ofs)))
+  | Abased id ofs, a1 :: nil =>
+      do r1 <- ireg_of a1; OK(Addrmode (Some r1) None (inr _ (id, ofs)))
+  | Abasedscaled sc id ofs, a1 :: nil =>
+      do r1 <- ireg_of a1; OK(Addrmode None (Some(r1, sc)) (inr _ (id, ofs)))
+  | Ainstack n, nil =>
+      OK(Addrmode (Some ESP) None (inl _ n))
+  | _, _ =>
+      Error(msg "Asmgen.transl_addressing")
+  end.
+
+(** Floating-point comparison.  We swap the operands in some cases
+   to simplify the handling of the unordered case. *)
+
+Definition floatcomp (cmp: comparison) (r1 r2: freg) : instruction :=
+  match cmp with
+  | Clt | Cle => Pcomisd_ff r2 r1
+  | Ceq | Cne | Cgt | Cge => Pcomisd_ff r1 r2
+  end.
+
+(** Translation of a condition.  Prepends to [k] the instructions
+  that evaluate the condition and leave its boolean result in bits
+  of the condition register. *)
+
+Definition transl_cond
+              (cond: condition) (args: list mreg) (k: code) : res code :=
+  match cond, args with
+  | Ccomp c, a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2; OK (Pcmp_rr r1 r2 :: k)
+  | Ccompu c, a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2; OK (Pcmp_rr r1 r2 :: k)
+  | Ccompimm c n, a1 :: nil =>
+      do r1 <- ireg_of a1; OK (Pcmp_ri r1 n :: k)
+  | Ccompuimm c n, a1 :: nil =>
+      do r1 <- ireg_of a1;
+      OK (if Int.eq_dec n Int.zero then Ptest_rr r1 r1 :: k else Pcmp_ri r1 n :: k)
+  | Ccompf cmp, a1 :: a2 :: nil =>
+      do r1 <- freg_of a1; do r2 <- freg_of a2; OK (floatcomp cmp r1 r2 :: k)
+  | Cnotcompf cmp, a1 :: a2 :: nil =>
+      do r1 <- freg_of a1; do r2 <- freg_of a2; OK (floatcomp cmp r1 r2 :: k)
+  | Cmaskzero n, a1 :: nil =>
+      do r1 <- ireg_of a1; OK (Ptest_ri r1 n :: k)
+  | Cmasknotzero n, a1 :: nil =>
+      do r1 <- ireg_of a1; OK (Ptest_ri r1 n :: k)
+  | _, _ =>
+     Error(msg "Asmgen.transl_cond")
+  end.
+
+(** What processor condition to test for a given Mach condition. *)
+
+Definition testcond_for_signed_comparison (cmp: comparison) :=
+  match cmp with
+  | Ceq => Cond_e
+  | Cne => Cond_ne
+  | Clt => Cond_l
+  | Cle => Cond_le
+  | Cgt => Cond_g
+  | Cge => Cond_ge
+  end.
+
+Definition testcond_for_unsigned_comparison (cmp: comparison) :=
+  match cmp with
+  | Ceq => Cond_e
+  | Cne => Cond_ne
+  | Clt => Cond_b
+  | Cle => Cond_be
+  | Cgt => Cond_a
+  | Cge => Cond_ae
+  end.
+
+Definition testcond_for_condition (cond: condition) : testcond :=
+  match cond with
+  | Ccomp c => testcond_for_signed_comparison c
+  | Ccompu c => testcond_for_unsigned_comparison c
+  | Ccompimm c n => testcond_for_signed_comparison c
+  | Ccompuimm c n => testcond_for_unsigned_comparison c
+  | Ccompf c =>
+      match c with
+      | Ceq => Cond_enp
+      | Cne => Cond_nep
+      | Clt => Cond_a
+      | Cle => Cond_ae
+      | Cgt => Cond_a
+      | Cge => Cond_ae
+      end
+  | Cnotcompf c =>
+      match c with
+      | Ceq => Cond_nep
+      | Cne => Cond_enp
+      | Clt => Cond_be
+      | Cle => Cond_b
+      | Cgt => Cond_be
+      | Cge => Cond_b
+      end
+  | Cmaskzero n => Cond_e
+  | Cmasknotzero n => Cond_ne
+  end.
+
+(** Translation of the arithmetic operation [r <- op(args)].
+  The corresponding instructions are prepended to [k]. *)
+
+Definition transl_op
+             (op: operation) (args: list mreg) (res: mreg) (k: code) : Errors.res code :=
+  match op, args with
+  | Omove, a1 :: nil =>
+      mk_mov (preg_of res) (preg_of a1) k
+  | Ointconst n, nil =>
+      do r <- ireg_of res; OK (Pmov_ri r n :: k)
+  | Ofloatconst f, nil =>
+      do r <- freg_of res; OK (Pmovsd_fi r f :: k)
+  | Ocast8signed, a1 :: nil =>
+      do r1 <- ireg_of a1; do r <- ireg_of res; mk_intconv Pmovsb_rr r r1 k
+  | Ocast8unsigned, a1 :: nil =>
+      do r1 <- ireg_of a1; do r <- ireg_of res; mk_intconv Pmovzb_rr r r1 k
+  | Ocast16signed, a1 :: nil =>
+      do r1 <- ireg_of a1; do r <- ireg_of res; mk_intconv Pmovsw_rr r r1 k
+  | Ocast16unsigned, a1 :: nil =>
+      do r1 <- ireg_of a1; do r <- ireg_of res; mk_intconv Pmovzw_rr r r1 k
+  | Oneg, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; OK (Pneg r :: k)
+  | Osub, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; OK (Psub_rr r r2 :: k)
+  | Omul, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; OK (Pimul_rr r r2 :: k)
+  | Omulimm n, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; OK (Pimul_ri r n :: k)
+  | Odiv, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; mk_div Pidiv r r2 k
+  | Odivu, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; mk_div Pdiv r r2 k
+  | Omod, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; mk_mod Pidiv r r2 k
+  | Omodu, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; mk_mod Pdiv r r2 k
+  | Oand, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; OK (Pand_rr r r2 :: k)
+  | Oandimm n, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; OK (Pand_ri r n :: k)
+  | Oor, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; OK (Por_rr r r2 :: k)
+  | Oorimm n, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; OK (Por_ri r n :: k)
+  | Oxor, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; OK (Pxor_rr r r2 :: k)
+  | Oxorimm n, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; OK (Pxor_ri r n :: k)
+  | Oshl, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; mk_shift Psal_rcl r r2 k
+  | Oshlimm n, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; OK (Psal_ri r n :: k)
+  | Oshr, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; mk_shift Psar_rcl r r2 k
+  | Oshrimm n, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; OK (Psar_ri r n :: k)
+  | Oshru, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2; mk_shift Pshr_rcl r r2 k
+  | Oshruimm n, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; OK (Pshr_ri r n :: k)
+  | Oshrximm n, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; mk_shrximm r n k
+  | Ororimm n, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- ireg_of res; OK (Pror_ri r n :: k)
+  | Olea addr, _ =>
+      do am <- transl_addressing addr args; do r <- ireg_of res;
+      OK (Plea r am :: k)
+  | Onegf, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- freg_of res; OK (Pnegd r :: k)
+  | Oabsf, a1 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- freg_of res; OK (Pabsd r :: k)
+  | Oaddf, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- freg_of res; do r2 <- freg_of a2; OK (Paddd_ff r r2 :: k)
+  | Osubf, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- freg_of res; do r2 <- freg_of a2; OK (Psubd_ff r r2 :: k)
+  | Omulf, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- freg_of res; do r2 <- freg_of a2; OK (Pmuld_ff r r2 :: k)
+  | Odivf, a1 :: a2 :: nil =>
+      do x <- assertion (mreg_eq a1 res);
+      do r <- freg_of res; do r2 <- freg_of a2; OK (Pdivd_ff r r2 :: k)
+  | Osingleoffloat, a1 :: nil =>
+      do r <- freg_of res; do r1 <- freg_of a1; OK (Pcvtsd2ss_ff r r1 :: k)
+  | Ointoffloat, a1 :: nil =>
+      do r <- ireg_of res; do r1 <- freg_of a1; OK (Pcvttsd2si_rf r r1 :: k)
+  | Ofloatofint, a1 :: nil =>
+      do r <- freg_of res; do r1 <- ireg_of a1; OK (Pcvtsi2sd_fr r r1 :: k)
+  | Ocmp c, args =>
+      do r <- ireg_of res;
+      transl_cond c args (Psetcc (testcond_for_condition c) r :: k)
+  | _, _ =>
+      Error(msg "Asmgen.transl_op")
+  end.
+
+(** Translation of memory loads and stores *)
+
+Definition transl_load (chunk: memory_chunk)
+                       (addr: addressing) (args: list mreg) (dest: mreg)
+                       (k: code) : res code :=
+  do am <- transl_addressing addr args;
+  match chunk with
+  | Mint8unsigned =>
+      do r <- ireg_of dest; OK(Pmovzb_rm r am :: k)
+  | Mint8signed =>
+      do r <- ireg_of dest; OK(Pmovsb_rm r am :: k)
+  | Mint16unsigned =>
+      do r <- ireg_of dest; OK(Pmovzw_rm r am :: k)
+  | Mint16signed =>
+      do r <- ireg_of dest; OK(Pmovsw_rm r am :: k)
+  | Mint32 =>
+      do r <- ireg_of dest; OK(Pmov_rm r am :: k)
+  | Mfloat32 =>
+      do r <- freg_of dest; OK(Pcvtss2sd_fm r am :: k)
+  | Mfloat64 =>
+      do r <- freg_of dest; OK(Pmovsd_fm r am :: k)
+  end.
+
+Definition transl_store (chunk: memory_chunk)
+                        (addr: addressing) (args: list mreg) (src: mreg)
+                        (k: code) : res code :=
+  do am <- transl_addressing addr args;
+  match chunk with
+  | Mint8unsigned | Mint8signed =>
+      do r <- ireg_of src; mk_smallstore Pmovb_mr am r k
+  | Mint16unsigned | Mint16signed =>
+      do r <- ireg_of src; mk_smallstore Pmovw_mr am r k
+  | Mint32 =>
+      do r <- ireg_of src; OK(Pmov_mr am r :: k)
+  | Mfloat32 =>
+      do r <- freg_of src; OK(Pcvtsd2ss_mf am r :: k)
+  | Mfloat64 =>
+      do r <- freg_of src; OK(Pmovsd_mf am r :: k)
+  end.
+
+(** Translation of a Mach instruction. *)
+
+Definition transl_instr (f: Mach.function) (i: Mach.instruction) (k: code) :=
+  match i with
+  | Mgetstack ofs ty dst =>
+      loadind ESP ofs ty dst k
+  | Msetstack src ofs ty =>
+      storeind src ESP ofs ty k
+  | Mgetparam ofs ty dst =>
+      do k1 <- loadind EDX ofs ty dst k;
+      loadind ESP f.(fn_link_ofs) Tint IT1 k1
+  | Mop op args res =>
+      transl_op op args res k
+  | Mload chunk addr args dst =>
+      transl_load chunk addr args dst k
+  | Mstore chunk addr args src =>
+      transl_store chunk addr args src k
+  | Mcall sig (inl reg) =>
+      do r <- ireg_of reg; OK (Pcall_r r :: k)
+  | Mcall sig (inr symb) =>
+      OK (Pcall_s symb :: k)
+  | Mtailcall sig (inl reg) =>
+      do r <- ireg_of reg; 
+      OK (Pfreeframe (-f .(fn_framesize)) f.(fn_stacksize) 
+                     f.(fn_retaddr_ofs) f.(fn_link_ofs) :: 
+          Pjmp_r r :: k)
+  | Mtailcall sig (inr symb) =>
+      OK (Pfreeframe (-f .(fn_framesize)) f.(fn_stacksize) 
+                     f.(fn_retaddr_ofs) f.(fn_link_ofs) :: 
+          Pjmp_s symb :: k)
+  | Mlabel lbl =>
+      OK(Plabel lbl :: k)
+  | Mgoto lbl =>
+      OK(Pjmp_l lbl :: k)
+  | Mcond cond args lbl =>
+      transl_cond cond args (Pjcc (testcond_for_condition cond) lbl :: k)
+  | Mjumptable arg tbl =>
+      do r <- ireg_of arg; OK (Pjmptbl r tbl :: k)
+  | Mreturn =>
+      OK (Pfreeframe (-f .(fn_framesize)) f.(fn_stacksize) 
+                     f.(fn_retaddr_ofs) f.(fn_link_ofs) :: 
+          Pret :: k)
+  | Mbuiltin ef args res =>
+      OK (Pbuiltin ef (List.map preg_of args) (preg_of res) :: k)
+  end.
+
+Fixpoint transl_code (f: Mach.function) (il: list Mach.instruction) :=
+  match il with
+  | nil => OK nil
+  | i1 :: il' => do k <- transl_code f il'; transl_instr f i1 k
+  end.
+
+(** Translation of a whole function.  Note that we must check
+  that the generated code contains less than [2^32] instructions,
+  otherwise the offset part of the [PC] code pointer could wrap
+  around, leading to incorrect executions. *)
+
+Definition transf_function (f: Mach.function) : res Asm.code :=
+  do c <- transl_code f f.(fn_code);
+  if zlt (list_length_z c) Int.max_unsigned 
+  then OK (Pallocframe (- f.(fn_framesize)) f.(fn_stacksize)
+                       f.(fn_retaddr_ofs) f.(fn_link_ofs) :: c)
+  else Error (msg "code size exceeded").
+
+Definition transf_fundef (f: Mach.fundef) : res Asm.fundef :=
+  transf_partial_fundef transf_function f.
+
+Definition transf_program (p: Mach.program) : res Asm.program :=
+  transform_partial_program transf_fundef p.
+
diff --git a/ia32/Asmgenproof.v b/ia32/Asmgenproof.v
new file mode 100644
index 0000000..ddf2769
--- /dev/null
+++ b/ia32/Asmgenproof.v
@@ -0,0 +1,1229 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Correctness proof for PPC generation: main proof. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Errors.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memory.
+Require Import Events.
+Require Import Globalenvs.
+Require Import Smallstep.
+Require Import Op.
+Require Import Locations.
+Require Import Mach.
+Require Import Machconcr.
+Require Import Machtyping.
+Require Import Conventions.
+Require Import Asm.
+Require Import Asmgen.
+Require Import Asmgenretaddr.
+Require Import Asmgenproof1.
+
+Section PRESERVATION.
+
+Variable prog: Mach.program.
+Variable tprog: Asm.program.
+Hypothesis TRANSF: transf_program prog = Errors.OK tprog.
+
+Let ge := Genv.globalenv prog.
+Let tge := Genv.globalenv tprog.
+
+Lemma symbols_preserved:
+  forall id, Genv.find_symbol tge id = Genv.find_symbol ge id.
+Proof.
+  intros. unfold ge, tge. 
+  apply Genv.find_symbol_transf_partial with transf_fundef.
+  exact TRANSF. 
+Qed.
+
+Lemma functions_translated:
+  forall b f,
+  Genv.find_funct_ptr ge b = Some f ->
+  exists tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = Errors.OK tf.
+Proof
+  (Genv.find_funct_ptr_transf_partial transf_fundef _ TRANSF).
+
+Lemma functions_transl:
+  forall fb f tf,
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  transf_function f = OK tf ->
+  Genv.find_funct_ptr tge fb = Some (Internal tf).
+Proof.
+  intros. exploit functions_translated; eauto. intros [tf' [A B]].
+  monadInv B. rewrite H0 in EQ; inv EQ; auto. 
+Qed.
+
+Lemma varinfo_preserved:
+  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
+Proof.
+  intros. unfold ge, tge. 
+  apply Genv.find_var_info_transf_partial with transf_fundef.
+  exact TRANSF. 
+Qed.
+
+(** * Properties of control flow *)
+
+Lemma find_instr_in:
+  forall c pos i,
+  find_instr pos c = Some i -> In i c.
+Proof.
+  induction c; simpl. intros; discriminate.
+  intros until i. case (zeq pos 0); intros.
+  left; congruence. right; eauto.
+Qed.
+
+Lemma find_instr_tail:
+  forall c1 i c2 pos,
+  code_tail pos c1 (i :: c2) ->
+  find_instr pos c1 = Some i.
+Proof.
+  induction c1; simpl; intros.
+  inv H.
+  destruct (zeq pos 0). subst pos.
+  inv H. auto. generalize (code_tail_pos _ _ _ H4). intro. omegaContradiction.
+  inv H. congruence. replace (pos0 + 1 - 1) with pos0 by omega.
+  eauto.
+Qed.
+
+Remark code_tail_bounds:
+  forall fn ofs i c,
+  code_tail ofs fn (i :: c) -> 0 <= ofs < list_length_z fn.
+Proof.
+  assert (forall ofs fn c, code_tail ofs fn c ->
+          forall i c', c = i :: c' -> 0 <= ofs < list_length_z fn).
+  induction 1; intros; simpl. 
+  rewrite H. rewrite list_length_z_cons. generalize (list_length_z_pos c'). omega.
+  rewrite list_length_z_cons. generalize (IHcode_tail _ _ H0). omega.
+  eauto.
+Qed.
+
+Lemma code_tail_next:
+  forall fn ofs i c,
+  code_tail ofs fn (i :: c) ->
+  code_tail (ofs + 1) fn c.
+Proof.
+  assert (forall ofs fn c, code_tail ofs fn c ->
+          forall i c', c = i :: c' -> code_tail (ofs + 1) fn c').
+  induction 1; intros.
+  subst c. constructor. constructor.
+  constructor. eauto.
+  eauto.
+Qed.
+
+Lemma code_tail_next_int:
+  forall fn ofs i c,
+  list_length_z fn <= Int.max_unsigned ->
+  code_tail (Int.unsigned ofs) fn (i :: c) ->
+  code_tail (Int.unsigned (Int.add ofs Int.one)) fn c.
+Proof.
+  intros. rewrite Int.add_unsigned.
+  change (Int.unsigned Int.one) with 1.
+  rewrite Int.unsigned_repr. apply code_tail_next with i; auto.
+  generalize (code_tail_bounds _ _ _ _ H0). omega. 
+Qed.
+
+Lemma transf_function_no_overflow:
+  forall f tf,
+  transf_function f = OK tf -> list_length_z tf <= Int.max_unsigned.
+Proof.
+  intros. monadInv H. destruct (zlt (list_length_z x) Int.max_unsigned); monadInv EQ0.
+  rewrite list_length_z_cons. omega. 
+Qed.
+
+(** [transl_code_at_pc pc fn c] holds if the code pointer [pc] points
+  within the IA32 code generated by translating Mach function [fn],
+  and [c] is the tail of the generated code at the position corresponding
+  to the code pointer [pc]. *)
+
+Inductive transl_code_at_pc: val -> block -> Mach.function -> Mach.code ->
+                                             Asm.code -> Asm.code -> Prop :=
+  transl_code_at_pc_intro:
+    forall b ofs f c tf tc,
+    Genv.find_funct_ptr ge b = Some (Internal f) ->
+    transf_function f = OK tf ->
+    transl_code f c = OK tc ->
+    code_tail (Int.unsigned ofs) tf tc ->
+    transl_code_at_pc (Vptr b ofs) b f c tf tc.
+
+(** The following lemmas show that straight-line executions
+  (predicate [exec_straight]) correspond to correct PPC executions
+  (predicate [exec_steps]) under adequate [transl_code_at_pc] hypotheses. *)
+
+Lemma exec_straight_steps_1:
+  forall fn c rs m c' rs' m',
+  exec_straight tge fn c rs m c' rs' m' ->
+  list_length_z fn <= Int.max_unsigned ->
+  forall b ofs,
+  rs#PC = Vptr b ofs ->
+  Genv.find_funct_ptr tge b = Some (Internal fn) ->
+  code_tail (Int.unsigned ofs) fn c ->
+  plus step tge (State rs m) E0 (State rs' m').
+Proof.
+  induction 1; intros.
+  apply plus_one.
+  econstructor; eauto. 
+  eapply find_instr_tail. eauto.
+  eapply plus_left'.
+  econstructor; eauto. 
+  eapply find_instr_tail. eauto.
+  apply IHexec_straight with b (Int.add ofs Int.one). 
+  auto. rewrite H0. rewrite H3. reflexivity.
+  auto. 
+  apply code_tail_next_int with i; auto.
+  traceEq.
+Qed.
+    
+Lemma exec_straight_steps_2:
+  forall fn c rs m c' rs' m',
+  exec_straight tge fn c rs m c' rs' m' ->
+  list_length_z fn <= Int.max_unsigned ->
+  forall b ofs,
+  rs#PC = Vptr b ofs ->
+  Genv.find_funct_ptr tge b = Some (Internal fn) ->
+  code_tail (Int.unsigned ofs) fn c ->
+  exists ofs',
+     rs'#PC = Vptr b ofs'
+  /\ code_tail (Int.unsigned ofs') fn c'.
+Proof.
+  induction 1; intros.
+  exists (Int.add ofs Int.one). split.
+  rewrite H0. rewrite H2. auto.
+  apply code_tail_next_int with i1; auto.
+  apply IHexec_straight with (Int.add ofs Int.one).
+  auto. rewrite H0. rewrite H3. reflexivity. auto. 
+  apply code_tail_next_int with i; auto.
+Qed.
+
+Lemma exec_straight_exec:
+  forall fb f c tf tc c' rs m rs' m',
+  transl_code_at_pc (rs PC) fb f c tf tc ->
+  exec_straight tge tf tc rs m c' rs' m' ->
+  plus step tge (State rs m) E0 (State rs' m').
+Proof.
+  intros. inv H.
+  eapply exec_straight_steps_1; eauto.
+  eapply transf_function_no_overflow; eauto.
+  eapply functions_transl; eauto. 
+Qed.
+
+Lemma exec_straight_at:
+  forall fb f c tf tc c' tc' rs m rs' m',
+  transl_code_at_pc (rs PC) fb f c tf tc ->
+  transl_code f c' = OK tc' ->
+  exec_straight tge tf tc rs m tc' rs' m' ->
+  transl_code_at_pc (rs' PC) fb f c' tf tc'.
+Proof.
+  intros. inv H. 
+  exploit exec_straight_steps_2; eauto. 
+  eapply transf_function_no_overflow; eauto.
+  eapply functions_transl; eauto.
+  intros [ofs' [PC' CT']].
+  rewrite PC'. constructor; auto.
+Qed.
+
+(** Correctness of the return addresses predicted by
+    [Asmgen.return_address_offset]. *)
+
+Remark code_tail_no_bigger:
+  forall pos c1 c2, code_tail pos c1 c2 -> (length c2 <= length c1)%nat.
+Proof.
+  induction 1; simpl; omega.
+Qed.
+
+Remark code_tail_unique:
+  forall fn c pos pos',
+  code_tail pos fn c -> code_tail pos' fn c -> pos = pos'.
+Proof.
+  induction fn; intros until pos'; intros ITA CT; inv ITA; inv CT; auto.
+  generalize (code_tail_no_bigger _ _ _ H3); simpl; intro; omega.
+  generalize (code_tail_no_bigger _ _ _ H3); simpl; intro; omega.
+  f_equal. eauto.
+Qed.
+
+Lemma return_address_offset_correct:
+  forall b ofs fb f c tf tc ofs',
+  transl_code_at_pc (Vptr b ofs) fb f c tf tc ->
+  return_address_offset f c ofs' ->
+  ofs' = ofs.
+Proof.
+  intros. inv H0. inv H. 
+  exploit code_tail_unique. eexact H11. eapply H1; eauto. intro.
+  subst ofs0. apply Int.repr_unsigned.
+Qed.
+
+(** The [find_label] function returns the code tail starting at the
+  given label.  A connection with [code_tail] is then established. *)
+
+Fixpoint find_label (lbl: label) (c: code) {struct c} : option code :=
+  match c with
+  | nil => None
+  | instr :: c' =>
+      if is_label lbl instr then Some c' else find_label lbl c'
+  end.
+
+Lemma label_pos_code_tail:
+  forall lbl c pos c',
+  find_label lbl c = Some c' ->
+  exists pos',
+  label_pos lbl pos c = Some pos' 
+  /\ code_tail (pos' - pos) c c'
+  /\ pos < pos' <= pos + list_length_z c.
+Proof.
+  induction c. 
+  simpl; intros. discriminate.
+  simpl; intros until c'.
+  case (is_label lbl a).
+  intro EQ; injection EQ; intro; subst c'.
+  exists (pos + 1). split. auto. split.
+  replace (pos + 1 - pos) with (0 + 1) by omega. constructor. constructor. 
+  rewrite list_length_z_cons. generalize (list_length_z_pos c). omega. 
+  intros. generalize (IHc (pos + 1) c' H). intros [pos' [A [B C]]].
+  exists pos'. split. auto. split.
+  replace (pos' - pos) with ((pos' - (pos + 1)) + 1) by omega.
+  constructor. auto. 
+  rewrite list_length_z_cons. omega.
+Qed.
+
+(** The following lemmas show that the translation from Mach to Asm
+  preserves labels, in the sense that the following diagram commutes:
+<<
+                          translation
+        Mach code ------------------------ Asm instr sequence
+            |                                          |
+            | Mach.find_label lbl       find_label lbl |
+            |                                          |
+            v                                          v
+        Mach code tail ------------------- Asm instr seq tail
+                          translation
+>>
+  The proof demands many boring lemmas showing that Asm constructor
+  functions do not introduce new labels.
+*)
+
+Section TRANSL_LABEL.
+
+Variable lbl: label.
+
+Remark mk_mov_label:
+  forall rd rs k c, mk_mov rd rs k = OK c -> find_label lbl c = find_label lbl k.
+Proof.
+  unfold mk_mov; intros. 
+  destruct rd; try discriminate; destruct rs; inv H; auto.
+Qed.
+
+Remark mk_shift_label:
+  forall f r1 r2 k c, mk_shift f r1 r2 k = OK c -> 
+  (forall r, is_label lbl (f r) = false) ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  unfold mk_shift; intros.
+  destruct (ireg_eq r2 ECX); monadInv H; simpl; rewrite H0; auto.
+Qed.
+
+Remark mk_div_label:
+  forall f r1 r2 k c, mk_div f r1 r2 k = OK c -> 
+  (forall r, is_label lbl (f r) = false) ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  unfold mk_div; intros.
+  destruct (ireg_eq r1 EAX).
+  destruct (ireg_eq r2 EDX); monadInv H; simpl; rewrite H0; auto.
+  destruct (ireg_eq r2 EAX); monadInv H; simpl; rewrite H0; auto.
+Qed.
+
+Remark mk_mod_label:
+  forall f r1 r2 k c, mk_mod f r1 r2 k = OK c -> 
+  (forall r, is_label lbl (f r) = false) ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  unfold mk_mod; intros.
+  destruct (ireg_eq r1 EAX).
+  destruct (ireg_eq r2 EDX); monadInv H; simpl; rewrite H0; auto.
+  destruct (ireg_eq r2 EDX); monadInv H; simpl; rewrite H0; auto.
+Qed.
+
+Remark mk_shrximm_label:
+  forall r n k c, mk_shrximm r n k = OK c -> find_label lbl c = find_label lbl k.
+Proof.
+  intros. monadInv H; auto.
+Qed.
+
+Remark mk_intconv_label:
+  forall f r1 r2 k c, mk_intconv f r1 r2 k = OK c -> 
+  (forall r r', is_label lbl (f r r') = false) ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  unfold mk_intconv; intros. destruct (low_ireg r2); inv H; simpl; rewrite H0; auto.
+Qed.
+
+Remark mk_smallstore_label:
+  forall f addr r k c, mk_smallstore f addr r k = OK c -> 
+  (forall r addr, is_label lbl (f r addr) = false) ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  unfold mk_smallstore; intros. destruct (low_ireg r); monadInv H; simpl; rewrite H0; auto.
+Qed.
+
+Remark loadind_label:
+  forall base ofs ty dst k c,
+  loadind base ofs ty dst k = OK c ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  unfold loadind; intros. destruct ty. 
+  monadInv H; auto. 
+  destruct (preg_of dst); inv H; auto.
+Qed.
+
+Remark storeind_label:
+  forall base ofs ty src k c,
+  storeind src base ofs ty k = OK c ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  unfold storeind; intros. destruct ty. 
+  monadInv H; auto. 
+  destruct (preg_of src); inv H; auto.
+Qed.
+
+Ltac ArgsInv :=
+  match goal with
+  | [ H: Error _ = OK _ |- _ ] => discriminate
+  | [ H: match ?args with nil => _ | _ :: _ => _ end = OK _ |- _ ] => destruct args; ArgsInv
+  | [ H: bind _ _ = OK _ |- _ ] => monadInv H; ArgsInv
+  | _ => idtac
+  end.
+
+Remark transl_cond_label:
+  forall cond args k c,
+  transl_cond cond args k = OK c ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  unfold transl_cond; intros. 
+  destruct cond; ArgsInv; auto. 
+  destruct (Int.eq_dec i Int.zero); auto.
+  destruct c0; auto.
+  destruct c0; auto.
+Qed.
+
+
+Remark transl_op_label:
+  forall op args r k c,
+  transl_op op args r k = OK c ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  unfold transl_op; intros. destruct op; ArgsInv; auto. 
+  eapply mk_mov_label; eauto.
+  eapply mk_intconv_label; eauto.
+  eapply mk_intconv_label; eauto.
+  eapply mk_intconv_label; eauto.
+  eapply mk_intconv_label; eauto.
+  eapply mk_div_label; eauto.
+  eapply mk_div_label; eauto.
+  eapply mk_mod_label; eauto.
+  eapply mk_mod_label; eauto.
+  eapply mk_shift_label; eauto.
+  eapply mk_shift_label; eauto.
+  eapply mk_shrximm_label; eauto.
+  eapply mk_shift_label; eauto.
+  eapply trans_eq. eapply transl_cond_label; eauto. auto.
+Qed.
+
+Remark transl_load_label:
+  forall chunk addr args dest k c,
+  transl_load chunk addr args dest k = OK c ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  intros. monadInv H. destruct chunk; monadInv EQ0; auto. 
+Qed.
+
+Remark transl_store_label:
+  forall chunk addr args src k c,
+  transl_store chunk addr args src k = OK c ->
+  find_label lbl c = find_label lbl k.
+Proof.
+  intros. monadInv H. destruct chunk; monadInv EQ0; auto; eapply mk_smallstore_label; eauto.
+Qed.
+
+Lemma transl_instr_label:
+  forall f i k c,
+  transl_instr f i k = OK c ->
+  find_label lbl c = if Mach.is_label lbl i then Some k else find_label lbl k.
+Proof.
+  intros. generalize (Mach.is_label_correct lbl i). 
+  case (Mach.is_label lbl i); intro.
+  subst i. monadInv H. simpl. rewrite peq_true. auto.
+Opaque loadind.
+  destruct i; simpl in H. 
+  eapply loadind_label; eauto.
+  eapply storeind_label; eauto.
+  monadInv H. eapply trans_eq; eapply loadind_label; eauto.
+  eapply transl_op_label; eauto.
+  eapply transl_load_label; eauto.
+  eapply transl_store_label; eauto.
+  destruct s0; monadInv H; auto.
+  destruct s0; monadInv H; auto. 
+  monadInv H; auto.
+  inv H; simpl. destruct (peq lbl l). congruence. auto. 
+  monadInv H; auto.
+  eapply trans_eq. eapply transl_cond_label; eauto. auto. 
+  monadInv H; auto.
+  monadInv H; auto.
+Qed.
+
+Lemma transl_code_label:
+  forall f c tc,
+  transl_code f c = OK tc ->
+  match Mach.find_label lbl c with
+  | None => find_label lbl tc = None
+  | Some c' => exists tc', find_label lbl tc = Some tc' /\ transl_code f c' = OK tc'
+  end.
+Proof.
+  induction c; simpl; intros.
+  inv H. auto.
+  monadInv H. rewrite (transl_instr_label _ _ _ _ EQ0). 
+  destruct (Mach.is_label lbl a). exists x; auto. apply IHc. auto. 
+Qed.
+
+Lemma transl_find_label:
+  forall f tf,
+  transf_function f = OK tf ->
+  match Mach.find_label lbl f.(fn_code) with
+  | None => find_label lbl tf = None
+  | Some c => exists tc, find_label lbl tf = Some tc /\ transl_code f c = OK tc
+  end.
+Proof.
+  intros. monadInv H. destruct (zlt (list_length_z x) Int.max_unsigned); inv EQ0.
+  simpl. apply transl_code_label; auto. 
+Qed.
+
+End TRANSL_LABEL.
+
+(** A valid branch in a piece of Mach code translates to a valid ``go to''
+  transition in the generated PPC code. *)
+
+Lemma find_label_goto_label:
+  forall f tf lbl rs m c' b ofs,
+  Genv.find_funct_ptr ge b = Some (Internal f) ->
+  transf_function f = OK tf ->
+  rs PC = Vptr b ofs ->
+  Mach.find_label lbl f.(fn_code) = Some c' ->
+  exists tc', exists rs',
+    goto_label tf lbl rs m = Next rs' m  
+  /\ transl_code_at_pc (rs' PC) b f c' tf tc'
+  /\ forall r, r <> PC -> rs'#r = rs#r.
+Proof.
+  intros. exploit (transl_find_label lbl f tf); eauto. rewrite H2. 
+  intros [tc [A B]].
+  exploit label_pos_code_tail; eauto. instantiate (1 := 0).
+  intros [pos' [P [Q R]]].
+  exists tc; exists (rs#PC <- (Vptr b (Int.repr pos'))).
+  split. unfold goto_label. rewrite P. rewrite H1. auto.
+  split. rewrite Pregmap.gss. constructor; auto. 
+  rewrite Int.unsigned_repr. replace (pos' - 0) with pos' in Q.
+  auto. omega.
+  generalize (transf_function_no_overflow _ _ H0). omega.
+  intros. apply Pregmap.gso; auto.
+Qed.
+
+(** * Proof of semantic preservation *)
+
+(** Semantic preservation is proved using simulation diagrams
+  of the following form.
+<<
+           st1 --------------- st2
+            |                   |
+           t|                  *|t
+            |                   |
+            v                   v
+           st1'--------------- st2'
+>>
+  The invariant is the [match_states] predicate below, which includes:
+- The PPC code pointed by the PC register is the translation of
+  the current Mach code sequence.
+- Mach register values and PPC register values agree.
+*)
+
+Inductive match_stack: list Machconcr.stackframe -> Prop :=
+  | match_stack_nil:
+      match_stack nil
+  | match_stack_cons: forall fb sp ra c s f tf tc,
+      Genv.find_funct_ptr ge fb = Some (Internal f) ->
+      transl_code_at_pc ra fb f c tf tc ->
+      sp <> Vundef -> ra <> Vundef ->
+      match_stack s ->
+      match_stack (Stackframe fb sp ra c :: s).
+
+Inductive match_states: Machconcr.state -> Asm.state -> Prop :=
+  | match_states_intro:
+      forall s fb sp c ms m m' rs f tf tc
+        (STACKS: match_stack s)
+        (FIND: Genv.find_funct_ptr ge fb = Some (Internal f))
+        (MEXT: Mem.extends m m')
+        (AT: transl_code_at_pc (rs PC) fb f c tf tc)
+        (AG: agree ms sp rs),
+      match_states (Machconcr.State s fb sp c ms m)
+                   (Asm.State rs m')
+  | match_states_call:
+      forall s fb ms m m' rs
+        (STACKS: match_stack s)
+        (MEXT: Mem.extends m m')
+        (AG: agree ms (parent_sp s) rs)
+        (ATPC: rs PC = Vptr fb Int.zero)
+        (ATLR: rs RA = parent_ra s),
+      match_states (Machconcr.Callstate s fb ms m)
+                   (Asm.State rs m')
+  | match_states_return:
+      forall s ms m m' rs
+        (STACKS: match_stack s)
+        (MEXT: Mem.extends m m')
+        (AG: agree ms (parent_sp s) rs)
+        (ATPC: rs PC = parent_ra s),
+      match_states (Machconcr.Returnstate s ms m)
+                   (Asm.State rs m').
+
+Lemma exec_straight_steps:
+  forall s fb f rs1 i c tf tc m1' m2 m2' sp ms2,
+  match_stack s ->
+  Mem.extends m2 m2' ->
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  transl_code_at_pc (rs1 PC) fb f (i :: c) tf tc ->
+  (forall k c, transl_instr f i k = OK c ->
+   exists rs2, exec_straight tge tf c rs1 m1' k rs2 m2' /\ agree ms2 sp rs2) ->
+  exists st',
+  plus step tge (State rs1 m1') E0 st' /\
+  match_states (Machconcr.State s fb sp c ms2 m2) st'.
+Proof.
+  intros. inversion H2. subst. monadInv H7. 
+  exploit H3; eauto. intros [rs2 [A B]]. 
+  exists (State rs2 m2'); split.
+  eapply exec_straight_exec; eauto. 
+  econstructor; eauto. eapply exec_straight_at; eauto.
+Qed.
+
+Lemma parent_sp_def: forall s, match_stack s -> parent_sp s <> Vundef.
+Proof. induction 1; simpl. congruence. auto. Qed.
+
+Lemma parent_ra_def: forall s, match_stack s -> parent_ra s <> Vundef.
+Proof. induction 1; simpl. unfold Vzero. congruence. auto. Qed.
+
+Lemma lessdef_parent_sp:
+  forall s v,
+  match_stack s -> Val.lessdef (parent_sp s) v -> v = parent_sp s.
+Proof.
+  intros. inv H0. auto. exploit parent_sp_def; eauto. tauto.
+Qed.
+
+Lemma lessdef_parent_ra:
+  forall s v,
+  match_stack s -> Val.lessdef (parent_ra s) v -> v = parent_ra s.
+Proof.
+  intros. inv H0. auto. exploit parent_ra_def; eauto. tauto.
+Qed.
+
+(** We need to show that, in the simulation diagram, we cannot
+  take infinitely many Mach transitions that correspond to zero
+  transitions on the PPC side.  Actually, all Mach transitions
+  correspond to at least one Asm transition, except the
+  transition from [Machconcr.Returnstate] to [Machconcr.State].
+  So, the following integer measure will suffice to rule out
+  the unwanted behaviour. *)
+
+Definition measure (s: Machconcr.state) : nat :=
+  match s with
+  | Machconcr.State _ _ _ _ _ _ => 0%nat
+  | Machconcr.Callstate _ _ _ _ => 0%nat
+  | Machconcr.Returnstate _ _ _ => 1%nat
+  end.
+
+(** We show the simulation diagram by case analysis on the Mach transition
+  on the left.  Since the proof is large, we break it into one lemma
+  per transition. *)
+
+Definition exec_instr_prop (s1: Machconcr.state) (t: trace) (s2: Machconcr.state) : Prop :=
+  forall s1' (MS: match_states s1 s1'),
+  (exists s2', plus step tge s1' t s2' /\ match_states s2 s2')
+  \/ (measure s2 < measure s1 /\ t = E0 /\ match_states s2 s1')%nat.
+
+
+Lemma exec_Mlabel_prop:
+  forall (s : list stackframe) (fb : block) (sp : val)
+         (lbl : Mach.label) (c : list Mach.instruction) (ms : Mach.regset)
+         (m : mem),
+  exec_instr_prop (Machconcr.State s fb sp (Mlabel lbl :: c) ms m) E0
+                  (Machconcr.State s fb sp c ms m).
+Proof.
+  intros; red; intros; inv MS.
+  left; eapply exec_straight_steps; eauto; intros. 
+  monadInv H. econstructor; split. apply exec_straight_one. simpl; eauto. auto. 
+  apply agree_nextinstr; auto.
+Qed.
+
+Lemma exec_Mgetstack_prop:
+  forall (s : list stackframe) (fb : block) (sp : val) (ofs : int)
+         (ty : typ) (dst : mreg) (c : list Mach.instruction)
+         (ms : Mach.regset) (m : mem) (v : val),
+  load_stack m sp ty ofs = Some v ->
+  exec_instr_prop (Machconcr.State s fb sp (Mgetstack ofs ty dst :: c) ms m) E0
+                  (Machconcr.State s fb sp c (Regmap.set dst v ms) m).
+Proof.
+  intros; red; intros; inv MS.
+  unfold load_stack in H.
+  exploit Mem.loadv_extends; eauto. intros [v' [A B]].
+  rewrite (sp_val _ _ _ AG) in A.
+  left; eapply exec_straight_steps; eauto. intros. simpl in H0. 
+  exploit loadind_correct; eauto. intros [rs' [P [Q R]]].
+  exists rs'; split. eauto. eapply agree_set_mreg; eauto. congruence.
+Qed.
+
+Lemma exec_Msetstack_prop:
+  forall (s : list stackframe) (fb : block) (sp : val) (src : mreg)
+         (ofs : int) (ty : typ) (c : list Mach.instruction)
+         (ms : mreg -> val) (m m' : mem),
+  store_stack m sp ty ofs (ms src) = Some m' ->
+  exec_instr_prop (Machconcr.State s fb sp (Msetstack src ofs ty :: c) ms m) E0
+                  (Machconcr.State s fb sp c ms m').
+Proof.
+  intros; red; intros; inv MS.
+  unfold store_stack in H.
+  assert (Val.lessdef (ms src) (rs (preg_of src))). eapply preg_val; eauto.
+  exploit Mem.storev_extends; eauto. intros [m2' [A B]]. 
+  rewrite (sp_val _ _ _ AG) in A.
+  left; eapply exec_straight_steps; eauto. intros. simpl in H1.
+  exploit storeind_correct; eauto. intros [rs' [P Q]].
+  exists rs'; split. eauto. eapply agree_exten; eauto. 
+Qed.
+
+Lemma exec_Mgetparam_prop:
+  forall (s : list stackframe) (fb : block) (f: Mach.function) (sp parent : val)
+         (ofs : int) (ty : typ) (dst : mreg) (c : list Mach.instruction)
+         (ms : Mach.regset) (m : mem) (v : val),
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  load_stack m sp Tint f.(fn_link_ofs) = Some parent ->
+  load_stack m parent ty ofs = Some v ->
+  exec_instr_prop (Machconcr.State s fb sp (Mgetparam ofs ty dst :: c) ms m) E0
+                  (Machconcr.State s fb sp c (Regmap.set dst v (Regmap.set IT1 Vundef ms)) m).
+Proof.
+  intros; red; intros; inv MS.
+  assert (f0 = f) by congruence. subst f0.
+  unfold load_stack in *. 
+  exploit Mem.loadv_extends. eauto. eexact H0. auto. 
+  intros [parent' [A B]]. rewrite (sp_val _ _ _ AG) in A.
+  assert (parent' = parent). inv B. auto. simpl in H1. congruence.
+  subst parent'.
+  exploit Mem.loadv_extends. eauto. eexact H1. auto. 
+  intros [v' [C D]].
+Opaque loadind.
+  left; eapply exec_straight_steps; eauto; intros. monadInv H2.
+  exploit loadind_correct. eexact EQ0. eauto. intros [rs1 [P [Q R]]]. simpl in Q.
+  exploit loadind_correct. eexact EQ. instantiate (2 := rs1). rewrite Q. eauto.
+  intros [rs2 [S [T U]]]. 
+  exists rs2; split. eapply exec_straight_trans; eauto.
+  eapply agree_set_mreg. eapply agree_set_mreg; eauto. congruence. auto. 
+Qed.
+
+Lemma exec_Mop_prop:
+  forall (s : list stackframe) (fb : block) (sp : val) (op : operation)
+         (args : list mreg) (res : mreg) (c : list Mach.instruction)
+         (ms : mreg -> val) (m : mem) (v : val),
+  eval_operation ge sp op ms ## args = Some v ->
+  exec_instr_prop (Machconcr.State s fb sp (Mop op args res :: c) ms m) E0
+                  (Machconcr.State s fb sp c (Regmap.set res v (undef_op op ms)) m).
+Proof.
+  intros; red; intros; inv MS.
+  assert (eval_operation tge sp op ms##args = Some v). 
+    rewrite <- H. apply eval_operation_preserved. exact symbols_preserved.
+  exploit eval_operation_lessdef. eapply preg_vals; eauto. eexact H0.
+  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]]]. 
+  exists rs2; split. eauto.
+  rewrite <- Q in B.
+  unfold undef_op.
+  destruct op; try (eapply agree_set_undef_mreg; eauto). eapply agree_set_mreg; eauto.
+Qed.
+
+Lemma exec_Mload_prop:
+  forall (s : list stackframe) (fb : block) (sp : val)
+         (chunk : memory_chunk) (addr : addressing) (args : list mreg)
+         (dst : mreg) (c : list Mach.instruction) (ms : mreg -> val)
+         (m : mem) (a v : val),
+  eval_addressing ge sp addr ms ## args = Some a ->
+  Mem.loadv chunk m a = Some v ->
+  exec_instr_prop (Machconcr.State s fb sp (Mload chunk addr args dst :: c) ms m)
+               E0 (Machconcr.State s fb sp c (Regmap.set dst v (undef_temps ms)) m).
+Proof.
+  intros; red; intros; inv MS.
+  assert (eval_addressing tge sp addr ms##args = Some a). 
+    rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
+  exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1.
+  intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A.
+  exploit Mem.loadv_extends; eauto. intros [v' [C D]].
+  left; eapply exec_straight_steps; eauto; intros. simpl in H2. 
+  exploit transl_load_correct; eauto. intros [rs2 [P [Q R]]]. 
+  exists rs2; split. eauto. eapply agree_set_undef_mreg; eauto. congruence.
+Qed.
+
+Lemma exec_Mstore_prop:
+  forall (s : list stackframe) (fb : block) (sp : val)
+         (chunk : memory_chunk) (addr : addressing) (args : list mreg)
+         (src : mreg) (c : list Mach.instruction) (ms : mreg -> val)
+         (m m' : mem) (a : val),
+  eval_addressing ge sp addr ms ## args = Some a ->
+  Mem.storev chunk m a (ms src) = Some m' ->
+  exec_instr_prop (Machconcr.State s fb sp (Mstore chunk addr args src :: c) ms m) E0
+                  (Machconcr.State s fb sp c (undef_temps ms) m').
+Proof.
+  intros; red; intros; inv MS.
+  assert (eval_addressing tge sp addr ms##args = Some a). 
+    rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
+  exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1.
+  intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A.
+  assert (Val.lessdef (ms src) (rs (preg_of src))). eapply preg_val; eauto.
+  exploit Mem.storev_extends; eauto. intros [m2' [C D]].
+  left; eapply exec_straight_steps; eauto; intros. simpl in H3. 
+  exploit transl_store_correct; eauto. intros [rs2 [P Q]]. 
+  exists rs2; split. eauto. eapply agree_exten_temps; eauto. 
+Qed.
+
+Lemma exec_Mcall_prop:
+  forall (s : list stackframe) (fb : block) (sp : val)
+         (sig : signature) (ros : mreg + ident) (c : Mach.code)
+         (ms : Mach.regset) (m : mem) (f : function) (f' : block)
+         (ra : int),
+  find_function_ptr ge ros ms = Some f' ->
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  return_address_offset f c ra ->
+  exec_instr_prop (Machconcr.State s fb sp (Mcall sig ros :: c) ms m) E0
+                  (Callstate (Stackframe fb sp (Vptr fb ra) c :: s) f' ms m).
+Proof.
+  intros; red; intros; inv MS.
+  assert (f0 = f) by congruence. subst f0.
+  inv AT. 
+  assert (NOOV: list_length_z tf <= Int.max_unsigned).
+    eapply transf_function_no_overflow; eauto.
+  destruct ros as [rf|fid]; simpl in H; monadInv H5.
+  (* Indirect call *)
+  assert (DEST: ms rf = Vptr f' Int.zero).
+    destruct (ms rf); try discriminate.
+    generalize (Int.eq_spec i Int.zero); destruct (Int.eq i Int.zero); congruence.
+  clear H.
+  generalize (code_tail_next_int _ _ _ _ NOOV H6). intro CT1.
+  assert (TCA: transl_code_at_pc (Vptr fb (Int.add ofs Int.one)) fb f c tf x).
+    econstructor; eauto. 
+  exploit return_address_offset_correct; eauto. intros; subst ra.
+  left; econstructor; split.
+  apply plus_one. eapply exec_step_internal. eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto. 
+  simpl. eauto. 
+  constructor; auto. 
+  econstructor; eauto. eapply agree_sp_def; eauto. congruence.
+  simpl. eapply agree_exten; eauto. intros. repeat rewrite Pregmap.gso; auto with ppcgen.
+  exploit ireg_val; eauto. rewrite DEST. intros LD. inv LD. auto.
+  rewrite <- H2. auto. 
+  (* Direct call *)
+  generalize (code_tail_next_int _ _ _ _ NOOV H6). intro CT1.
+  assert (TCA: transl_code_at_pc (Vptr fb (Int.add ofs Int.one)) fb f c tf x).
+    econstructor; eauto. 
+  exploit return_address_offset_correct; eauto. intros; subst ra.
+  left; econstructor; split.
+  apply plus_one. eapply exec_step_internal. eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto. 
+  simpl. unfold symbol_offset. rewrite symbols_preserved. rewrite H. eauto.
+  constructor; auto. 
+  econstructor; eauto. eapply agree_sp_def; eauto. congruence.
+  simpl. eapply agree_exten; eauto. intros. repeat rewrite Pregmap.gso; auto with ppcgen.
+  rewrite <- H2. auto.
+Qed.
+
+Lemma agree_change_sp:
+  forall ms sp rs sp',
+  agree ms sp rs -> sp' <> Vundef ->
+  agree ms sp' (rs#ESP <- sp').
+Proof.
+  intros. inv H. split. apply Pregmap.gss. auto. 
+  intros. rewrite Pregmap.gso; auto with ppcgen.
+Qed.
+
+Lemma exec_Mtailcall_prop:
+  forall (s : list stackframe) (fb stk : block) (soff : int)
+         (sig : signature) (ros : mreg + ident) (c : list Mach.instruction)
+         (ms : Mach.regset) (m : mem) (f: Mach.function) (f' : block) m',
+  find_function_ptr ge ros ms = Some f' ->
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  load_stack m (Vptr stk soff) Tint f.(fn_link_ofs) = Some (parent_sp s) ->
+  load_stack m (Vptr stk soff) Tint f.(fn_retaddr_ofs) = Some (parent_ra s) ->
+  Mem.free m stk (- f.(fn_framesize)) f.(fn_stacksize) = Some m' ->
+  exec_instr_prop
+          (Machconcr.State s fb (Vptr stk soff) (Mtailcall sig ros :: c) ms m) E0
+          (Callstate s f' ms m').
+Proof.
+  intros; red; intros; inv MS.
+  assert (f0 = f) by congruence. subst f0.
+  inv AT. 
+  assert (NOOV: list_length_z tf <= Int.max_unsigned).
+    eapply transf_function_no_overflow; eauto.
+  rewrite (sp_val _ _ _ AG) in *. unfold load_stack in *.
+  exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [parent' [A B]]. 
+  exploit lessdef_parent_sp; eauto. intros. subst parent'. clear B.
+  exploit Mem.loadv_extends. eauto. eexact H2. auto. simpl. intros [ra' [C D]].
+  exploit lessdef_parent_ra; eauto. intros. subst ra'. clear D.
+  exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. 
+  destruct ros as [rf|fid]; simpl in H; monadInv H7.
+  (* Indirect call *)
+  assert (DEST: ms rf = Vptr f' Int.zero).
+    destruct (ms rf); try discriminate.
+    generalize (Int.eq_spec i Int.zero); destruct (Int.eq i Int.zero); congruence.
+  clear H.
+  generalize (code_tail_next_int _ _ _ _ NOOV H8). intro CT1.
+  left; econstructor; split.
+  eapply plus_left. eapply exec_step_internal. eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto. 
+  simpl. rewrite C. rewrite A. rewrite <- (sp_val _ _ _ AG). rewrite E. eauto.
+  apply star_one. eapply exec_step_internal. 
+  transitivity (Val.add rs#PC Vone). auto. rewrite <- H4. simpl. eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto. 
+  simpl. eauto. traceEq.
+  constructor; auto.
+  apply agree_set_other; auto. apply agree_nextinstr. apply agree_set_other; auto.
+  eapply agree_change_sp; eauto. eapply parent_sp_def; eauto.
+  rewrite Pregmap.gss. rewrite nextinstr_inv; auto with ppcgen.
+  repeat rewrite Pregmap.gso; auto with ppcgen. 
+  exploit ireg_val; eauto. rewrite DEST. intros LD. inv LD. auto.
+  generalize (preg_of_not_ESP rf). rewrite (ireg_of_eq _ _ EQ1). congruence.
+  (* Direct call *)
+  generalize (code_tail_next_int _ _ _ _ NOOV H8). intro CT1.
+  left; econstructor; split.
+  eapply plus_left. eapply exec_step_internal. eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto. 
+  simpl. rewrite C. rewrite A. rewrite <- (sp_val _ _ _ AG). rewrite E. eauto.
+  apply star_one. eapply exec_step_internal. 
+  transitivity (Val.add rs#PC Vone). auto. rewrite <- H4. simpl. eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto. 
+  simpl. eauto. traceEq.
+  constructor; auto.
+  apply agree_set_other; auto. apply agree_nextinstr. apply agree_set_other; auto.
+  eapply agree_change_sp; eauto. eapply parent_sp_def; eauto.
+  rewrite Pregmap.gss. unfold symbol_offset. rewrite symbols_preserved. rewrite H. auto.
+Qed.
+
+Lemma exec_Mgoto_prop:
+  forall (s : list stackframe) (fb : block) (f : function) (sp : val)
+         (lbl : Mach.label) (c : list Mach.instruction) (ms : Mach.regset)
+         (m : mem) (c' : Mach.code),
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  Mach.find_label lbl (fn_code f) = Some c' ->
+  exec_instr_prop (Machconcr.State s fb sp (Mgoto lbl :: c) ms m) E0
+                  (Machconcr.State s fb sp c' ms m).
+Proof.
+  intros; red; intros; inv MS.
+  assert (f0 = f) by congruence. subst f0.
+  inv AT. monadInv H4. 
+  exploit find_label_goto_label; eauto. intros [tc' [rs' [GOTO [AT2 INV]]]].
+  left; exists (State rs' m'); split.
+  apply plus_one. econstructor; eauto.
+  eapply functions_transl; eauto.
+  eapply find_instr_tail; eauto.
+  simpl; eauto.
+  econstructor; eauto.
+  eapply agree_exten; eauto with ppcgen.
+Qed.
+
+Lemma exec_Mbuiltin_prop:
+  forall (s : list stackframe) (f : block) (sp : val)
+         (ms : Mach.regset) (m : mem) (ef : external_function)
+         (args : list mreg) (res : mreg) (b : list Mach.instruction)
+         (t : trace) (v : val) (m' : mem),
+  external_call ef ge ms ## args m t v m' ->
+  exec_instr_prop (Machconcr.State s f sp (Mbuiltin ef args res :: b) ms m) t
+                  (Machconcr.State s f sp b (Regmap.set res v (undef_temps ms)) m').
+Proof.
+  intros; red; intros; inv MS.
+  inv AT. monadInv H3. 
+  exploit functions_transl; eauto. intro FN.
+  generalize (transf_function_no_overflow _ _ H2); intro NOOV.
+  exploit external_call_mem_extends; eauto. eapply preg_vals; eauto.
+  intros [vres' [m2' [A [B [C D]]]]].
+  left. econstructor; split. apply plus_one. 
+  eapply exec_step_builtin. eauto. eauto.
+  eapply find_instr_tail; eauto.
+  eapply external_call_symbols_preserved; eauto.
+  exact symbols_preserved. exact varinfo_preserved.
+  econstructor; eauto.
+  instantiate (2 := tf); instantiate (1 := x).
+  unfold nextinstr_nf, nextinstr. rewrite Pregmap.gss.
+  simpl undef_regs. repeat rewrite Pregmap.gso; auto with ppcgen. 
+  rewrite <- H0. simpl. constructor; auto.
+  eapply code_tail_next_int; eauto.
+  apply agree_nextinstr_nf. eapply agree_set_undef_mreg; eauto. 
+  rewrite Pregmap.gss. auto. 
+  intros. repeat rewrite Pregmap.gso; auto with ppcgen. 
+Qed.
+
+Lemma exec_Mcond_true_prop:
+  forall (s : list stackframe) (fb : block) (f : function) (sp : val)
+         (cond : condition) (args : list mreg) (lbl : Mach.label)
+         (c : list Mach.instruction) (ms : mreg -> val) (m : mem)
+         (c' : Mach.code),
+  eval_condition cond ms ## args = Some true ->
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  Mach.find_label lbl (fn_code f) = Some c' ->
+  exec_instr_prop (Machconcr.State s fb sp (Mcond cond args lbl :: c) ms m) E0
+                  (Machconcr.State s fb sp c' (undef_temps ms) m).
+Proof.
+  intros; red; intros; inv MS. assert (f0 = f) by congruence. subst f0.
+  exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. intros EC.
+  inv AT. monadInv H5.
+  exploit transl_cond_correct; eauto. intros [rs' [A [B C]]].
+  generalize (functions_transl _ _ _ FIND H4); intro FN.
+  generalize (transf_function_no_overflow _ _ H4); intro NOOV.
+  exploit exec_straight_steps_2; eauto. 
+  intros [ofs' [PC2 CT2]].
+  exploit find_label_goto_label; eauto. 
+  intros [tc' [rs3 [GOTO [AT3 INV3]]]].
+  left; exists (State rs3 m'); split.
+  eapply plus_right'. 
+  eapply exec_straight_steps_1; eauto.
+  econstructor; eauto.
+  eapply find_instr_tail. eauto. simpl. rewrite B. eauto. traceEq.
+  econstructor; eauto. 
+  eapply agree_exten_temps; eauto. intros. rewrite INV3; auto with ppcgen.
+Qed.
+
+Lemma exec_Mcond_false_prop:
+  forall (s : list stackframe) (fb : block) (sp : val)
+         (cond : condition) (args : list mreg) (lbl : Mach.label)
+         (c : list Mach.instruction) (ms : mreg -> val) (m : mem),
+  eval_condition cond ms ## args = Some false ->
+  exec_instr_prop (Machconcr.State s fb sp (Mcond cond args lbl :: c) ms m) E0
+                  (Machconcr.State s fb sp c (undef_temps ms) m).
+Proof.
+  intros; red; intros; inv MS.
+  exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. intros EC.
+  left; eapply exec_straight_steps; eauto. intros. simpl in H0. 
+  exploit transl_cond_correct; eauto. intros [rs' [A [B C]]].
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. 
+  apply exec_straight_one. simpl. rewrite B. eauto. auto. 
+  apply agree_nextinstr. eapply agree_exten_temps; eauto. 
+Qed.
+
+Lemma exec_Mjumptable_prop:
+  forall (s : list stackframe) (fb : block) (f : function) (sp : val)
+         (arg : mreg) (tbl : list Mach.label) (c : list Mach.instruction)
+         (rs : mreg -> val) (m : mem) (n : int) (lbl : Mach.label)
+         (c' : Mach.code),
+  rs arg = Vint n ->
+  list_nth_z tbl (Int.signed n) = Some lbl ->
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  Mach.find_label lbl (fn_code f) = Some c' ->
+  exec_instr_prop
+    (Machconcr.State s fb sp (Mjumptable arg tbl :: c) rs m) E0
+    (Machconcr.State s fb sp c' (undef_temps rs) m).
+Proof.
+  intros; red; intros; inv MS.
+  assert (f0 = f) by congruence. subst f0.
+  inv AT. monadInv H6. 
+  exploit functions_transl; eauto. intro FN.
+  generalize (transf_function_no_overflow _ _ H5); intro NOOV.
+  exploit find_label_goto_label. eauto. eauto. instantiate (2 := rs0#ECX <- Vundef #EDX <- Vundef). 
+  rewrite Pregmap.gso; auto with ppcgen. rewrite Pregmap.gso; auto with ppcgen. eauto. eauto. 
+  intros [tc' [rs' [A [B C]]]].
+  exploit ireg_val; eauto. rewrite H. intros LD; inv LD.
+  left; econstructor; split.
+  apply plus_one. econstructor; eauto. 
+  eapply find_instr_tail; eauto. 
+  simpl. rewrite <- H9. unfold Mach.label in H0; unfold label; rewrite H0. eauto.
+  econstructor; eauto. 
+  eapply agree_exten_temps; eauto. intros. rewrite C; auto with ppcgen. 
+  repeat rewrite Pregmap.gso; auto with ppcgen. 
+Qed.
+
+Lemma exec_Mreturn_prop:
+  forall (s : list stackframe) (fb stk : block) (soff : int)
+         (c : list Mach.instruction) (ms : Mach.regset) (m : mem) (f: Mach.function) m',
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  load_stack m (Vptr stk soff) Tint f.(fn_link_ofs) = Some (parent_sp s) ->
+  load_stack m (Vptr stk soff) Tint f.(fn_retaddr_ofs) = Some (parent_ra s) ->
+  Mem.free m stk (- f.(fn_framesize)) f.(fn_stacksize) = Some m' ->
+  exec_instr_prop (Machconcr.State s fb (Vptr stk soff) (Mreturn :: c) ms m) E0
+                  (Returnstate s ms m').
+Proof.
+  intros; red; intros; inv MS.
+  assert (f0 = f) by congruence. subst f0.
+  inv AT. 
+  assert (NOOV: list_length_z tf <= Int.max_unsigned).
+    eapply transf_function_no_overflow; eauto.
+  rewrite (sp_val _ _ _ AG) in *. unfold load_stack in *.
+  exploit Mem.loadv_extends. eauto. eexact H0. auto. simpl. intros [parent' [A B]]. 
+  exploit lessdef_parent_sp; eauto. intros. subst parent'. clear B.
+  exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [ra' [C D]].
+  exploit lessdef_parent_ra; eauto. intros. subst ra'. clear D.
+  exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. 
+  monadInv H6.
+  exploit code_tail_next_int; eauto. intro CT1.
+  left; econstructor; split.
+  eapply plus_left. eapply exec_step_internal. eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto. 
+  simpl. rewrite C. rewrite A. rewrite <- (sp_val _ _ _ AG). rewrite E. eauto.
+  apply star_one. eapply exec_step_internal. 
+  transitivity (Val.add rs#PC Vone). auto. rewrite <- H3. simpl. eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto. 
+  simpl. eauto. traceEq.
+  constructor; auto.
+  apply agree_set_other; auto. apply agree_nextinstr. apply agree_set_other; auto.
+  eapply agree_change_sp; eauto. eapply parent_sp_def; eauto.
+Qed.
+
+Lemma exec_function_internal_prop:
+  forall (s : list stackframe) (fb : block) (ms : Mach.regset)
+         (m : mem) (f : function) (m1 m2 m3 : mem) (stk : block),
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  Mem.alloc m (- fn_framesize f) (fn_stacksize f) = (m1, stk) ->
+  let sp := Vptr stk (Int.repr (- fn_framesize f)) in
+  store_stack m1 sp Tint f.(fn_link_ofs) (parent_sp s) = Some m2 ->
+  store_stack m2 sp Tint f.(fn_retaddr_ofs) (parent_ra s) = Some m3 ->
+  exec_instr_prop (Machconcr.Callstate s fb ms m) E0
+                  (Machconcr.State s fb sp (fn_code f) ms m3).
+Proof.
+  intros; red; intros; inv MS.
+  exploit functions_translated; eauto. intros [tf [A B]]. monadInv B.
+  generalize EQ; intros EQ'. monadInv EQ'. 
+  destruct (zlt (list_length_z x0) Int.max_unsigned); inversion EQ1. clear EQ1.
+  unfold store_stack in *. 
+  exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. 
+  intros [m1' [C D]].
+  exploit Mem.storev_extends. eauto. eexact H1. eauto. eauto. 
+  intros [m2' [E F]].
+  exploit Mem.storev_extends. eexact F. eauto. eauto. eauto. 
+  intros [m3' [P Q]].
+  left; econstructor; split.
+  apply plus_one. econstructor; eauto. 
+  rewrite <- H4; simpl. eauto. 
+  simpl. rewrite C. simpl in E. rewrite (sp_val _ _ _ AG) in E. rewrite E.
+  rewrite ATLR. simpl in P. rewrite P. eauto. 
+  econstructor; eauto. 
+  unfold nextinstr. rewrite Pregmap.gss. rewrite Pregmap.gso; auto with ppcgen. 
+  rewrite ATPC. simpl. constructor; eauto.
+  subst x. eapply code_tail_next_int. rewrite list_length_z_cons. omega. 
+  constructor. 
+  apply agree_nextinstr. eapply agree_change_sp; eauto. congruence. 
+Qed.
+
+Lemma exec_function_external_prop:
+  forall (s : list stackframe) (fb : block) (ms : Mach.regset)
+         (m : mem) (t0 : trace) (ms' : RegEq.t -> val)
+         (ef : external_function) (args : list val) (res : val) (m': mem),
+  Genv.find_funct_ptr ge fb = Some (External ef) ->
+  external_call ef ge args m t0 res m' ->
+  Machconcr.extcall_arguments ms m (parent_sp s) (ef_sig ef) args ->
+  ms' = Regmap.set (loc_result (ef_sig ef)) res ms ->
+  exec_instr_prop (Machconcr.Callstate s fb ms m)
+               t0 (Machconcr.Returnstate s ms' m').
+Proof.
+  intros; red; intros; inv MS.
+  exploit functions_translated; eauto.
+  intros [tf [A B]]. simpl in B. inv B.
+  exploit extcall_arguments_match; eauto. 
+  intros [args' [C D]].
+  exploit external_call_mem_extends; eauto.
+  intros [res' [m2' [P [Q [R S]]]]].
+  left; econstructor; split.
+  apply plus_one. eapply exec_step_external; eauto. 
+  eapply external_call_symbols_preserved; eauto. 
+  exact symbols_preserved. exact varinfo_preserved.
+  econstructor; eauto.
+  unfold loc_external_result.
+  eapply agree_set_mreg; eauto. 
+  rewrite Pregmap.gso; auto with ppcgen. rewrite Pregmap.gss. auto. 
+  intros. repeat rewrite Pregmap.gso; auto with ppcgen.
+Qed.
+
+Lemma exec_return_prop:
+  forall (s : list stackframe) (fb : block) (sp ra : val)
+         (c : Mach.code) (ms : Mach.regset) (m : mem),
+  exec_instr_prop (Machconcr.Returnstate (Stackframe fb sp ra c :: s) ms m) E0
+                  (Machconcr.State s fb sp c ms m).
+Proof.
+  intros; red; intros; inv MS. inv STACKS. simpl in *.
+  right. split. omega. split. auto. 
+  econstructor; eauto. rewrite ATPC; eauto.  
+Qed.
+
+Theorem transf_instr_correct:
+  forall s1 t s2, Machconcr.step ge s1 t s2 ->
+  exec_instr_prop s1 t s2.
+Proof
+  (Machconcr.step_ind ge exec_instr_prop
+           exec_Mlabel_prop
+           exec_Mgetstack_prop
+           exec_Msetstack_prop
+           exec_Mgetparam_prop
+           exec_Mop_prop
+           exec_Mload_prop
+           exec_Mstore_prop
+           exec_Mcall_prop
+           exec_Mtailcall_prop
+           exec_Mbuiltin_prop
+           exec_Mgoto_prop
+           exec_Mcond_true_prop
+           exec_Mcond_false_prop
+           exec_Mjumptable_prop
+           exec_Mreturn_prop
+           exec_function_internal_prop
+           exec_function_external_prop
+           exec_return_prop).
+
+Lemma transf_initial_states:
+  forall st1, Machconcr.initial_state prog st1 ->
+  exists st2, Asm.initial_state tprog st2 /\ match_states st1 st2.
+Proof.
+  intros. inversion H. unfold ge0 in *.
+  econstructor; split.
+  econstructor.
+  eapply Genv.init_mem_transf_partial; eauto.
+  replace (symbol_offset (Genv.globalenv tprog) (prog_main tprog) Int.zero)
+     with (Vptr fb Int.zero).
+  econstructor; eauto. constructor. apply Mem.extends_refl.
+  split. auto. unfold parent_sp; congruence.
+  intros. repeat rewrite Pregmap.gso; auto with ppcgen.
+  destruct r; simpl; congruence.
+  unfold symbol_offset. 
+  rewrite (transform_partial_program_main _ _ TRANSF). 
+  rewrite symbols_preserved. unfold ge; rewrite H1. auto.
+Qed.
+
+Lemma transf_final_states:
+  forall st1 st2 r, 
+  match_states st1 st2 -> Machconcr.final_state st1 r -> Asm.final_state st2 r.
+Proof.
+  intros. inv H0. inv H. constructor. auto. 
+  compute in H1. 
+  generalize (preg_val _ _ _ AX AG). rewrite H1. intros LD; inv LD. auto.
+Qed.
+
+Theorem transf_program_correct:
+  forall (beh: program_behavior), not_wrong beh ->
+  Machconcr.exec_program prog beh -> Asm.exec_program tprog beh.
+Proof.
+  unfold Machconcr.exec_program, Asm.exec_program; intros.
+  eapply simulation_star_preservation with (measure := measure); eauto.
+  eexact transf_initial_states.
+  eexact transf_final_states.
+  exact transf_instr_correct. 
+Qed.
+
+End PRESERVATION.
diff --git a/ia32/Asmgenproof1.v b/ia32/Asmgenproof1.v
new file mode 100644
index 0000000..498bb4e
--- /dev/null
+++ b/ia32/Asmgenproof1.v
@@ -0,0 +1,1436 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Correctness proof for IA32 generation: auxiliary results. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Errors.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memory.
+Require Import Globalenvs.
+Require Import Op.
+Require Import Locations.
+Require Import Mach.
+Require Import Machconcr.
+Require Import Machtyping.
+Require Import Asm.
+Require Import Asmgen.
+Require Import Conventions.
+
+Open Local Scope error_monad_scope.
+
+(** * Correspondence between Mach registers and IA32 registers *)
+
+Hint Extern 2 (_ <> _) => congruence: ppcgen.
+
+Lemma preg_of_injective:
+  forall r1 r2, preg_of r1 = preg_of r2 -> r1 = r2.
+Proof.
+  destruct r1; destruct r2; simpl; intros; reflexivity || discriminate.
+Qed.
+
+Lemma preg_of_not_ESP:
+  forall r, preg_of r <> ESP.
+Proof.
+  destruct r; simpl; congruence.
+Qed.
+
+Lemma preg_of_not_PC:
+  forall r, preg_of r <> PC.
+Proof.
+  destruct r; simpl; congruence.
+Qed.
+
+Hint Resolve preg_of_not_ESP preg_of_not_PC: ppcgen.
+
+Lemma ireg_of_eq:
+  forall r r', ireg_of r = OK r' -> preg_of r = IR r'.
+Proof.
+  unfold ireg_of; intros. destruct (preg_of r); inv H; auto.
+Qed.
+
+Lemma freg_of_eq:
+  forall r r', freg_of r = OK r' -> preg_of r = FR r'.
+Proof.
+  unfold freg_of; intros. destruct (preg_of r); inv H; auto.
+Qed.
+
+(** Agreement between Mach register sets and IA32 register sets. *)
+
+Record agree (ms: Mach.regset) (sp: val) (rs: Asm.regset) : Prop := mkagree {
+  agree_sp: rs#ESP = sp;
+  agree_sp_def: sp <> Vundef;
+  agree_mregs: forall r: mreg, Val.lessdef (ms r) (rs#(preg_of r))
+}.
+
+Lemma preg_val:
+  forall ms sp rs r,
+  agree ms sp rs -> Val.lessdef (ms r) rs#(preg_of r).
+Proof.
+  intros. destruct H. auto.
+Qed.
+
+Lemma preg_vals:
+  forall ms sp rs, agree ms sp rs ->
+  forall l, Val.lessdef_list (map ms l) (map rs (map preg_of l)).
+Proof.
+  induction l; simpl. constructor. constructor. eapply preg_val; eauto. auto.
+Qed.
+
+Lemma ireg_val:
+  forall ms sp rs r r',
+  agree ms sp rs ->
+  ireg_of r = OK r' ->
+  Val.lessdef (ms r) rs#r'.
+Proof.
+  intros. rewrite <- (ireg_of_eq _ _ H0). eapply preg_val; eauto.
+Qed.
+
+Lemma freg_val:
+  forall ms sp rs r r',
+  agree ms sp rs ->
+  freg_of r = OK r' ->
+  Val.lessdef (ms r) (rs#r').
+Proof.
+  intros. rewrite <- (freg_of_eq _ _ H0). eapply preg_val; eauto.
+Qed.
+
+Lemma sp_val:
+  forall ms sp rs,
+  agree ms sp rs ->
+  sp = rs#ESP.
+Proof.
+  intros. destruct H; auto.
+Qed.
+
+Hint Resolve preg_val ireg_val freg_val sp_val: ppcgen.
+
+Definition important_preg (r: preg) : bool :=
+  match r with
+  | PC => false
+  | IR _ => true
+  | FR _ => true
+  | ST0 => true
+  | CR _ => false
+  | RA => false
+  end.
+
+Lemma preg_of_important:
+  forall r, important_preg (preg_of r) = true.
+Proof.
+  intros. destruct r; reflexivity.
+Qed.
+
+Lemma important_diff:
+  forall r r',
+  important_preg r = true -> important_preg r' = false -> r <> r'.
+Proof.
+  congruence.
+Qed.
+Hint Resolve important_diff: ppcgen.
+
+Lemma agree_exten:
+  forall ms sp rs rs',
+  agree ms sp rs ->
+  (forall r, important_preg r = true -> rs'#r = rs#r) ->
+  agree ms sp rs'.
+Proof.
+  intros. destruct H. split. 
+  rewrite H0; auto. auto.
+  intros. rewrite H0; auto. apply preg_of_important.
+Qed.
+
+(** Preservation of register agreement under various assignments. *)
+
+Lemma agree_set_mreg:
+  forall ms sp rs r v rs',
+  agree ms sp rs ->
+  Val.lessdef v (rs'#(preg_of r)) ->
+  (forall r', important_preg r' = true -> r' <> preg_of r -> rs'#r' = rs#r') ->
+  agree (Regmap.set r v ms) sp rs'.
+Proof.
+  intros. destruct H. split.
+  rewrite H1; auto. apply sym_not_equal. apply preg_of_not_ESP.
+  auto.
+  intros. unfold Regmap.set. destruct (RegEq.eq r0 r). congruence. 
+  rewrite H1. auto. apply preg_of_important.
+  red; intros; elim n. eapply preg_of_injective; eauto.
+Qed.
+
+Lemma agree_set_other:
+  forall ms sp rs r v,
+  agree ms sp rs ->
+  important_preg r = false ->
+  agree ms sp (rs#r <- v).
+Proof.
+  intros. apply agree_exten with rs. auto.
+  intros. apply Pregmap.gso. congruence.
+Qed.
+
+Lemma agree_nextinstr:
+  forall ms sp rs,
+  agree ms sp rs -> agree ms sp (nextinstr rs).
+Proof.
+  intros. unfold nextinstr. apply agree_set_other. auto. auto.
+Qed.
+
+Lemma agree_undef_unimportant_regs:
+  forall ms sp rl rs,
+  agree ms sp rs ->
+  (forall r, In r rl -> important_preg r = false) ->
+  agree ms sp (undef_regs rl rs).
+Proof.
+  induction rl; simpl; intros. auto.
+  apply IHrl. apply agree_exten with rs; auto.
+  intros. apply Pregmap.gso. red; intros; subst.
+  assert (important_preg a = false) by auto. congruence.
+  intros. apply H0; auto.
+Qed.
+
+Lemma agree_nextinstr_nf:
+  forall ms sp rs,
+  agree ms sp rs -> agree ms sp (nextinstr_nf rs).
+Proof.
+  intros. unfold nextinstr_nf. apply agree_nextinstr. 
+  apply agree_undef_unimportant_regs. auto.
+  intro. simpl. ElimOrEq; auto.
+Qed.
+
+Definition nontemp_preg (r: preg) : bool :=
+  match r with
+  | PC => false
+  | IR ECX => false
+  | IR EDX => false
+  | IR _ => true
+  | FR XMM6 => false
+  | FR XMM7 => false
+  | FR _ => true
+  | ST0 => false
+  | CR _ => false
+  | RA => false
+  end.
+
+Lemma nontemp_diff:
+  forall r r',
+  nontemp_preg r = true -> nontemp_preg r' = false -> r <> r'.
+Proof.
+  congruence.
+Qed.
+
+Hint Resolve nontemp_diff: ppcgen.
+
+Remark undef_regs_1:
+  forall l ms r, ms r = Vundef -> Mach.undef_regs l ms r = Vundef.
+Proof.
+  induction l; simpl; intros. auto. apply IHl. unfold Regmap.set.
+  destruct (RegEq.eq r a); congruence.
+Qed.
+
+Remark undef_regs_2:
+  forall l ms r, In r l -> Mach.undef_regs l ms r = Vundef.
+Proof.
+  induction l; simpl; intros. contradiction. 
+  destruct H. subst. apply undef_regs_1. apply Regmap.gss.
+  auto.
+Qed.
+
+Remark undef_regs_3:
+  forall l ms r, ~In r l -> Mach.undef_regs l ms r = ms r.
+Proof.
+  induction l; simpl; intros. auto.
+  rewrite IHl. apply Regmap.gso. intuition. intuition.
+Qed.
+
+Lemma agree_exten_temps:
+  forall ms sp rs rs',
+  agree ms sp rs ->
+  (forall r, nontemp_preg r = true -> rs'#r = rs#r) ->
+  agree (undef_temps ms) sp rs'.
+Proof.
+  intros. destruct H. split. 
+  rewrite H0; auto. auto. 
+  intros. unfold undef_temps. 
+  destruct (In_dec mreg_eq r (int_temporaries ++ float_temporaries)).
+  rewrite undef_regs_2; auto. 
+  rewrite undef_regs_3; auto. rewrite H0; auto.
+  simpl in n. destruct r; auto; intuition.
+Qed.
+
+Lemma agree_set_undef_mreg:
+  forall ms sp rs r v rs',
+  agree ms sp rs ->
+  Val.lessdef v (rs'#(preg_of r)) ->
+  (forall r', nontemp_preg r' = true -> r' <> preg_of r -> rs'#r' = rs#r') ->
+  agree (Regmap.set r v (undef_temps ms)) sp rs'.
+Proof.
+  intros. apply agree_set_mreg with (rs'#(preg_of r) <- (rs#(preg_of r))); auto.
+  eapply agree_exten_temps; eauto. 
+  intros. unfold Pregmap.set. destruct (PregEq.eq r0 (preg_of r)). 
+  congruence. auto. 
+  intros. rewrite Pregmap.gso; auto. 
+Qed.
+
+(** Useful properties of the PC register. *)
+
+Lemma nextinstr_inv:
+  forall r rs,
+  r <> PC ->
+  (nextinstr rs)#r = rs#r.
+Proof.
+  intros. unfold nextinstr. apply Pregmap.gso. red; intro; subst. auto.
+Qed.
+
+Lemma nextinstr_inv2:
+  forall r rs,
+  nontemp_preg r = true ->
+  (nextinstr rs)#r = rs#r.
+Proof.
+  intros. apply nextinstr_inv. red; intro; subst; discriminate.
+Qed.
+
+Lemma nextinstr_set_preg:
+  forall rs m v,
+  (nextinstr (rs#(preg_of m) <- v))#PC = Val.add rs#PC Vone.
+Proof.
+  intros. unfold nextinstr. rewrite Pregmap.gss. 
+  rewrite Pregmap.gso. auto. apply sym_not_eq. apply preg_of_not_PC. 
+Qed.
+
+Lemma nextinstr_nf_inv:
+  forall r rs, 
+  match r with PC => False | CR _ => False | _ => True end ->
+  (nextinstr_nf rs)#r = rs#r.
+Proof.
+  intros. unfold nextinstr_nf. rewrite nextinstr_inv. 
+  simpl. repeat rewrite Pregmap.gso; auto.
+  red; intro; subst; contradiction.
+  red; intro; subst; contradiction.
+  red; intro; subst; contradiction.
+  red; intro; subst; contradiction.
+  red; intro; subst; contradiction.
+Qed.
+
+Lemma nextinstr_nf_inv1:
+  forall r rs,
+  important_preg r = true -> (nextinstr_nf rs)#r = rs#r.
+Proof.
+  intros. apply nextinstr_nf_inv. unfold important_preg in H. 
+  destruct r; auto; congruence.
+Qed.
+
+Lemma nextinstr_nf_inv2:
+  forall r rs, 
+  nontemp_preg r = true -> (nextinstr_nf rs)#r = rs#r.
+Proof.
+  intros. apply nextinstr_nf_inv. unfold nontemp_preg in H. 
+  destruct r; auto; congruence.
+Qed.
+
+Lemma nextinstr_nf_set_preg:
+  forall rs m v,
+  (nextinstr_nf (rs#(preg_of m) <- v))#PC = Val.add rs#PC Vone.
+Proof.
+  intros. unfold nextinstr_nf.
+  transitivity (nextinstr (rs#(preg_of m) <- v) PC). auto.
+  apply nextinstr_set_preg.
+Qed.
+
+(** Connection between Mach and Asm calling conventions for external
+    functions. *)
+
+Lemma extcall_arg_match:
+  forall ms sp rs m m' l v,
+  agree ms sp rs ->
+  Machconcr.extcall_arg ms m sp l v ->
+  Mem.extends m m' ->
+  exists v', Asm.extcall_arg rs m' l v' /\ Val.lessdef v v'.
+Proof.
+  intros. inv H0.
+  exists (rs#(preg_of r)); split. constructor. eauto with ppcgen.
+  unfold load_stack in H2. 
+  exploit Mem.loadv_extends; eauto. intros [v' [A B]].
+  rewrite (sp_val _ _ _ H) in A. 
+  exists v'; split; auto. destruct ty; econstructor; eauto.
+Qed.
+
+Lemma extcall_args_match:
+  forall ms sp rs m m', agree ms sp rs -> Mem.extends m m' ->
+  forall ll vl,
+  Machconcr.extcall_args ms m sp ll vl ->
+  exists vl', Asm.extcall_args rs m' ll vl' /\ Val.lessdef_list vl vl'.
+Proof.
+  induction 3.
+  exists (@nil val); split; constructor.
+  exploit extcall_arg_match; eauto. intros [v1' [A B]].
+  exploit IHextcall_args; eauto. intros [vl' [C D]].
+  exists(v1' :: vl'); split. constructor; auto. constructor; auto.
+Qed.
+
+Lemma extcall_arguments_match:
+  forall ms m sp rs sg args m',
+  agree ms sp rs ->
+  Machconcr.extcall_arguments ms m sp sg args ->
+  Mem.extends m m' ->
+  exists args', Asm.extcall_arguments rs m' sg args' /\ Val.lessdef_list args args'.
+Proof.
+  unfold Machconcr.extcall_arguments, Asm.extcall_arguments; intros.
+  eapply extcall_args_match; eauto.
+Qed.
+
+(** * Execution of straight-line code *)
+
+Section STRAIGHTLINE.
+
+Variable ge: genv.
+Variable fn: code.
+
+(** Straight-line code is composed of processor instructions that execute
+  in sequence (no branches, no function calls and returns).
+  The following inductive predicate relates the machine states
+  before and after executing a straight-line sequence of instructions.
+  Instructions are taken from the first list instead of being fetched
+  from memory. *)
+
+Inductive exec_straight: code -> regset -> mem -> 
+                         code -> regset -> mem -> Prop :=
+  | exec_straight_one:
+      forall i1 c rs1 m1 rs2 m2,
+      exec_instr ge fn i1 rs1 m1 = Next rs2 m2 ->
+      rs2#PC = Val.add rs1#PC Vone ->
+      exec_straight (i1 :: c) rs1 m1 c rs2 m2
+  | exec_straight_step:
+      forall i c rs1 m1 rs2 m2 c' rs3 m3,
+      exec_instr ge fn i rs1 m1 = Next rs2 m2 ->
+      rs2#PC = Val.add rs1#PC Vone ->
+      exec_straight c rs2 m2 c' rs3 m3 ->
+      exec_straight (i :: c) rs1 m1 c' rs3 m3.
+
+Lemma exec_straight_trans:
+  forall c1 rs1 m1 c2 rs2 m2 c3 rs3 m3,
+  exec_straight c1 rs1 m1 c2 rs2 m2 ->
+  exec_straight c2 rs2 m2 c3 rs3 m3 ->
+  exec_straight c1 rs1 m1 c3 rs3 m3.
+Proof.
+  induction 1; intros.
+  apply exec_straight_step with rs2 m2; auto.
+  apply exec_straight_step with rs2 m2; auto.
+Qed.
+
+Lemma exec_straight_two:
+  forall i1 i2 c rs1 m1 rs2 m2 rs3 m3,
+  exec_instr ge fn i1 rs1 m1 = Next rs2 m2 ->
+  exec_instr ge fn i2 rs2 m2 = Next rs3 m3 ->
+  rs2#PC = Val.add rs1#PC Vone ->
+  rs3#PC = Val.add rs2#PC Vone ->
+  exec_straight (i1 :: i2 :: c) rs1 m1 c rs3 m3.
+Proof.
+  intros. apply exec_straight_step with rs2 m2; auto.
+  apply exec_straight_one; auto.
+Qed.
+
+Lemma exec_straight_three:
+  forall i1 i2 i3 c rs1 m1 rs2 m2 rs3 m3 rs4 m4,
+  exec_instr ge fn i1 rs1 m1 = Next rs2 m2 ->
+  exec_instr ge fn i2 rs2 m2 = Next rs3 m3 ->
+  exec_instr ge fn i3 rs3 m3 = Next rs4 m4 ->
+  rs2#PC = Val.add rs1#PC Vone ->
+  rs3#PC = Val.add rs2#PC Vone ->
+  rs4#PC = Val.add rs3#PC Vone ->
+  exec_straight (i1 :: i2 :: i3 :: c) rs1 m1 c rs4 m4.
+Proof.
+  intros. apply exec_straight_step with rs2 m2; auto.
+  eapply exec_straight_two; eauto.
+Qed.
+
+(** * Correctness of IA32 constructor functions *)
+
+(** Smart constructor for moves. *)
+
+Lemma mk_mov_correct:
+  forall rd rs k c rs1 m,
+  mk_mov rd rs k = OK c ->
+  exists rs2,
+     exec_straight c rs1 m k rs2 m
+  /\ rs2#rd = rs1#rs
+  /\ forall r, important_preg r = true -> r <> rd -> rs2#r = rs1#r.
+Proof.
+  unfold mk_mov; intros. 
+  destruct rd; try (monadInv H); destruct rs; monadInv H.
+(* mov *)
+  econstructor. split. apply exec_straight_one. simpl. eauto. auto. 
+  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+  intros. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gso. auto. 
+(* movd *)
+  econstructor. split. apply exec_straight_one. simpl. eauto. auto. 
+  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+  intros. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gso. auto. 
+(* getfp0 *)
+  econstructor. split. apply exec_straight_one. simpl. eauto. auto. 
+  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+  intros. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gso; auto.
+(* setfp0 *)
+  econstructor. split. apply exec_straight_one. simpl. eauto. auto. 
+  split. auto. 
+  intros. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gso. auto. 
+Qed.
+
+(** Smart constructor for shifts *)
+
+Ltac SRes :=
+  match goal with
+  | [ |- nextinstr _ _ = _ ] => rewrite nextinstr_inv; [auto | auto with ppcgen]
+  | [ |- nextinstr_nf _ _ = _ ] => rewrite nextinstr_nf_inv; [auto | auto with ppcgen]
+  | [ |- Pregmap.get ?x (Pregmap.set ?x _ _) = _ ] => rewrite Pregmap.gss; auto
+  | [ |- Pregmap.set ?x _ _ ?x = _ ] => rewrite Pregmap.gss; auto
+  | [ |- Pregmap.get _ (Pregmap.set _ _ _) = _ ] => rewrite Pregmap.gso; [auto | auto with ppcgen]
+  | [ |- Pregmap.set _ _ _ _ = _ ] => rewrite Pregmap.gso; [auto | auto with ppcgen]
+  end.
+
+Ltac SOther :=
+  match goal with
+  | [ |- nextinstr _ _ = _ ] => rewrite nextinstr_inv; [auto | auto with ppcgen]
+  | [ |- nextinstr_nf _ _ = _ ] => rewrite nextinstr_nf_inv2; [auto | auto with ppcgen]
+  | [ |- Pregmap.get ?x (Pregmap.set ?x _ _) = _ ] => rewrite Pregmap.gss; auto
+  | [ |- Pregmap.set ?x _ _ ?x = _ ] => rewrite Pregmap.gss; auto
+  | [ |- Pregmap.get _ (Pregmap.set _ _ _) = _ ] => rewrite Pregmap.gso; [auto | auto with ppcgen]
+  | [ |- Pregmap.set _ _ _ _ = _ ] => rewrite Pregmap.gso; [auto | auto with ppcgen]
+  end.
+
+Lemma mk_shift_correct:
+  forall sinstr ssem r1 r2 k c rs1 m,
+  mk_shift sinstr r1 r2 k = OK c ->
+  (forall r c rs m,
+   exec_instr ge c (sinstr r) rs m = Next (nextinstr_nf (rs#r <- (ssem rs#r rs#ECX))) m) ->
+  exists rs2,
+     exec_straight c rs1 m k rs2 m
+  /\ rs2#r1 = ssem rs1#r1 rs1#r2
+  /\ forall r, nontemp_preg r = true -> r <> r1 -> rs2#r = rs1#r.
+Proof.
+  unfold mk_shift; intros. 
+  destruct (ireg_eq r2 ECX); monadInv H. 
+(* fast case *)
+  econstructor. split. apply exec_straight_one. apply H0. auto. 
+  split. repeat SRes.
+  intros. repeat SOther.
+(* general case *)
+  monadInv EQ.
+  econstructor. split. eapply exec_straight_two. simpl; eauto. apply H0. 
+  auto. auto. 
+  split. repeat SRes. repeat rewrite nextinstr_inv; auto with ppcgen.
+  rewrite Pregmap.gss. decEq. rewrite Pregmap.gso; auto. congruence.
+  intros. repeat SOther.
+Qed.
+
+(** Smart constructor for division *)
+
+
+Lemma mk_div_correct:
+  forall mkinstr dsem msem r1 r2 k c rs1 m,
+  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) ->
+  exists rs2,
+     exec_straight c rs1 m k rs2 m
+  /\ rs2#r1 = dsem rs1#r1 rs1#r2
+  /\ 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.
+  split. SRes. 
+  intros. repeat SOther. 
+(* r1=EAX r2<>EDX *)
+  econstructor. split. eapply exec_straight_one. apply H0. auto.
+  split. repeat SRes. decEq. apply Pregmap.gso. congruence. 
+  intros. repeat SOther. 
+(* r1 <> EAX *)
+  monadInv H. monadInv EQ. destruct (ireg_eq r2 EAX); monadInv EQ0.
+(* r1 <> EAX, r1 <> ECX, r2 = EAX *)
+  set (rs2 := nextinstr (rs1#ECX <- (rs1#EAX))).
+  set (rs3 := nextinstr (rs2#EAX <- (rs2#r1))).
+  set (rs4 := nextinstr_nf (rs3#EAX <- (dsem rs3#EAX (rs3#EDX <- Vundef)#ECX) 
+                               #EDX <- (msem rs3#EAX (rs3#EDX <- Vundef)#ECX))).
+  set (rs5 := nextinstr (rs4#r1 <- (rs4#EAX))).
+  set (rs6 := nextinstr (rs5#EAX <- (rs5#ECX))).
+  exists rs6. split. apply exec_straight_step with rs2 m; auto.
+  apply exec_straight_step with rs3 m; auto.
+  apply exec_straight_step with rs4 m; auto. apply H0.
+  apply exec_straight_step with rs5 m; auto.
+  apply exec_straight_one; auto.
+  split. unfold rs6. SRes. unfold rs5. repeat SRes.
+  unfold rs4. repeat SRes. decEq.
+  unfold rs3. repeat SRes. unfold rs2. repeat SRes. 
+  intros. unfold rs6. SOther.
+  unfold Pregmap.set. destruct (PregEq.eq r EAX). subst r.
+  unfold rs5. repeat SOther.
+  unfold rs5. repeat SOther. unfold rs4. repeat SOther. 
+  unfold rs3. repeat SOther. unfold rs2. repeat SOther. 
+(* r1 <> EAX, r1 <> ECX, r2 <> EAX *)
+  set (rs2 := nextinstr (rs1#XMM7 <- (rs1#EAX))).
+  set (rs3 := nextinstr (rs2#ECX <- (rs2#r2))).
+  set (rs4 := nextinstr (rs3#EAX <- (rs3#r1))).
+  set (rs5 := nextinstr_nf (rs4#EAX <- (dsem rs4#EAX (rs4#EDX <- Vundef)#ECX) 
+                               #EDX <- (msem rs4#EAX (rs4#EDX <- Vundef)#ECX))).
+  set (rs6 := nextinstr (rs5#r2 <- (rs5#ECX))).
+  set (rs7 := nextinstr (rs6#r1 <- (rs6#EAX))).
+  set (rs8 := nextinstr (rs7#EAX <- (rs7#XMM7))).
+  exists rs8. split. apply exec_straight_step with rs2 m; auto.
+  apply exec_straight_step with rs3 m; auto.
+  apply exec_straight_step with rs4 m; auto.
+  apply exec_straight_step with rs5 m; auto. apply H0. 
+  apply exec_straight_step with rs6 m; auto.
+  apply exec_straight_step with rs7 m; auto.
+  apply exec_straight_one; auto.
+  split. unfold rs8. SRes. unfold rs7. repeat SRes.
+  unfold rs6. repeat SRes. unfold rs5. repeat SRes. 
+  decEq. unfold rs4. repeat SRes. unfold rs3. repeat SRes. 
+   intros. unfold rs8. SOther.
+  unfold Pregmap.set. destruct (PregEq.eq r EAX). subst r. auto.
+  unfold rs7. repeat SOther. unfold rs6. SOther.
+  unfold Pregmap.set. destruct (PregEq.eq r r2). subst r. auto. 
+  unfold rs5. repeat SOther. unfold rs4. repeat SOther.
+  unfold rs3. repeat SOther. unfold rs2. repeat SOther.
+Qed.
+
+(** Smart constructor for modulus *)
+
+Lemma mk_mod_correct:
+  forall mkinstr dsem msem r1 r2 k c rs1 m,
+  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) ->
+  exists rs2,
+     exec_straight c rs1 m k rs2 m
+  /\ rs2#r1 = msem rs1#r1 rs1#r2
+  /\ 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.
+  split. SRes. 
+  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. 
+  intros. repeat SOther. 
+(* r1 <> EAX *)
+  monadInv H. monadInv EQ. destruct (ireg_eq r2 EDX); monadInv EQ0.
+(* r1 <> EAX, r1 <> ECX, r2 = EDX *)
+  set (rs2 := nextinstr (rs1#XMM7 <- (rs1#EAX))).
+  set (rs3 := nextinstr (rs2#ECX <- (rs2#EDX))).
+  set (rs4 := nextinstr (rs3#EAX <- (rs3#r1))).
+  set (rs5 := nextinstr_nf (rs4#EAX <- (dsem rs4#EAX (rs4#EDX <- Vundef)#ECX) 
+                               #EDX <- (msem rs4#EAX (rs4#EDX <- Vundef)#ECX))).
+  set (rs6 := nextinstr (rs5#r1 <- (rs5#EDX))).
+  set (rs7 := nextinstr (rs6#EAX <- (rs6#XMM7))).
+  exists rs7. split. apply exec_straight_step with rs2 m; auto.
+  apply exec_straight_step with rs3 m; auto.
+  apply exec_straight_step with rs4 m; auto.
+  apply exec_straight_step with rs5 m; auto. apply H0. 
+  apply exec_straight_step with rs6 m; auto.
+  apply exec_straight_one; auto.
+  split. unfold rs7. repeat SRes. unfold rs6. repeat SRes.
+  unfold rs5. repeat SRes. decEq.
+  unfold rs4. repeat SRes. unfold rs3. repeat SRes. 
+  intros. unfold rs7. SOther.
+  unfold Pregmap.set. destruct (PregEq.eq r EAX). subst r.
+  unfold rs6. repeat SOther.
+  unfold rs6. repeat SOther.
+  unfold rs5. repeat SOther. unfold rs4. repeat SOther. 
+  unfold rs3. repeat SOther. unfold rs2. repeat SOther. 
+(* r1 <> EAX, r1 <> ECX, r2 <> EDX *)
+  set (rs2 := nextinstr (rs1#XMM7 <- (rs1#EAX))).
+  set (rs3 := nextinstr (rs2#ECX <- (rs2#r2))).
+  set (rs4 := nextinstr (rs3#EAX <- (rs3#r1))).
+  set (rs5 := nextinstr_nf (rs4#EAX <- (dsem rs4#EAX (rs4#EDX <- Vundef)#ECX) 
+                               #EDX <- (msem rs4#EAX (rs4#EDX <- Vundef)#ECX))).
+  set (rs6 := nextinstr (rs5#r2 <- (rs5#ECX))).
+  set (rs7 := nextinstr (rs6#r1 <- (rs6#EDX))).
+  set (rs8 := nextinstr (rs7#EAX <- (rs7#XMM7))).
+  exists rs8. split. apply exec_straight_step with rs2 m; auto.
+  apply exec_straight_step with rs3 m; auto.
+  apply exec_straight_step with rs4 m; auto.
+  apply exec_straight_step with rs5 m; auto. apply H0. 
+  apply exec_straight_step with rs6 m; auto.
+  apply exec_straight_step with rs7 m; auto.
+  apply exec_straight_one; auto.
+  split. unfold rs8. SRes. unfold rs7. repeat SRes.
+  unfold rs6. repeat SRes. unfold rs5. repeat SRes. 
+  decEq. unfold rs4. repeat SRes. unfold rs3. repeat SRes. 
+   intros. unfold rs8. SOther.
+  unfold Pregmap.set. destruct (PregEq.eq r EAX). subst r. auto.
+  unfold rs7. repeat SOther. unfold rs6. SOther.
+  unfold Pregmap.set. destruct (PregEq.eq r r2). subst r. auto. 
+  unfold rs5. repeat SOther. unfold rs4. repeat SOther.
+  unfold rs3. repeat SOther. unfold rs2. repeat SOther.
+Qed.
+
+(** Smart constructor for [shrx] *)
+
+Lemma mk_shrximm_correct:
+  forall r1 n k c (rs1: regset) x m,
+  mk_shrximm r1 n k = OK c ->
+  rs1#r1 = Vint x ->
+  Int.ltu n (Int.repr 31) = true ->
+  exists rs2,
+     exec_straight c rs1 m k rs2 m
+  /\ rs2#r1 = Vint (Int.shrx x n)
+  /\ forall r, nontemp_preg r = true -> r <> r1 -> rs2#r = rs1#r.
+Proof.
+  unfold mk_shrximm; intros. monadInv H. monadInv EQ.
+  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 (rs3 := nextinstr (rs2#ECX <- (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. 
+  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 rs3 m. simpl. 
+  change (rs2 r1) with (rs1 r1). rewrite H0. 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. 
+  unfold rs4. destruct (Int.lt x Int.zero); 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 H2. auto.
+  rewrite H. unfold Val.shr. rewrite H2. 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. 
+  unfold compare_ints. repeat SOther. 
+Qed.
+
+(** Smart constructor for integer conversions *)
+
+Lemma mk_intconv_correct:
+  forall mk sem rd rs k c rs1 m,
+  mk_intconv mk rd rs k = OK c ->
+  (forall c rd rs r m,
+   exec_instr ge c (mk rd rs) r m = Next (nextinstr (r#rd <- (sem r#rs))) m) ->
+  exists rs2,
+     exec_straight c rs1 m k rs2 m
+  /\ rs2#rd = sem rs1#rs
+  /\ forall r, nontemp_preg r = true -> r <> rd -> rs2#r = rs1#r.
+Proof.
+  unfold mk_intconv; intros. destruct (low_ireg rs); monadInv H.
+  econstructor. split. apply exec_straight_one. rewrite H0. eauto. auto. 
+  split. repeat SRes.
+  intros. repeat SOther.
+  econstructor. split. eapply exec_straight_two. 
+  simpl. eauto. apply H0. auto. auto. 
+  split. repeat SRes. 
+  intros. repeat SOther. 
+Qed.
+
+(** Smart constructor for small stores *)
+
+Lemma mk_smallstore_correct:
+  forall chunk sto addr r k c rs1 m1 m2,
+  mk_smallstore sto addr r k = OK c ->
+  Mem.storev chunk m1 (eval_addrmode ge addr rs1) (rs1 r) = Some m2 ->
+  (forall c r addr rs m,
+   exec_instr ge c (sto addr r) rs m = exec_store ge chunk m addr rs r) ->
+  exists rs2,
+     exec_straight c rs1 m1 k rs2 m2
+  /\ forall r, nontemp_preg r = true -> rs2#r = rs1#r.
+Proof.
+  unfold mk_smallstore; intros. 
+  remember (low_ireg r) as low. destruct low; monadInv H.
+(* low reg *)
+  econstructor; split. apply exec_straight_one. rewrite H1. 
+  unfold exec_store. rewrite H0. eauto. auto. 
+  intros. SOther.
+(* high reg *)
+  assert (r <> ECX). red; intros; subst r; discriminate. 
+  set (rs2 := nextinstr (rs1#ECX <- (eval_addrmode ge addr rs1))).
+  set (rs3 := nextinstr (rs2#EDX <- (rs1 r))).
+  econstructor; split.
+  apply exec_straight_three with rs2 m1 rs3 m1. 
+  simpl. auto. 
+  simpl. replace (rs2 r) with (rs1 r). auto. symmetry. unfold rs2. repeat SRes. 
+  rewrite H1. unfold exec_store. simpl. rewrite Int.add_zero. 
+  change (rs3 EDX) with (rs1 r).
+  change (rs3 ECX) with (eval_addrmode ge addr rs1).
+  replace (Val.add (eval_addrmode ge addr rs1) (Vint Int.zero))
+     with (eval_addrmode ge addr rs1).
+  rewrite H0. eauto.
+  destruct (eval_addrmode ge addr rs1); simpl in H0; try discriminate.
+  simpl. rewrite Int.add_zero; auto. 
+  auto. auto. auto. 
+  intros. repeat SOther. unfold rs3. repeat SOther. unfold rs2. repeat SOther.
+Qed.
+
+(** Accessing slots in the stack frame *)
+
+Lemma loadind_correct:
+  forall (base: ireg) ofs ty dst k (rs: regset) c m v,
+  loadind base ofs ty dst k = OK c ->
+  Mem.loadv (chunk_of_type ty) m (Val.add rs#base (Vint ofs)) = Some v ->
+  exists rs',
+     exec_straight c rs m k rs' m
+  /\ rs'#(preg_of dst) = v
+  /\ forall r, important_preg r = true -> r <> preg_of dst -> rs'#r = rs#r.
+Proof.
+  unfold loadind; intros.
+  set (addr := Addrmode (Some base) None (inl (ident * int) ofs)) in *.
+  assert (eval_addrmode ge addr rs = Val.add rs#base (Vint ofs)).
+    unfold addr. simpl. rewrite Int.add_commut; rewrite Int.add_zero; auto. 
+  destruct ty; simpl in H0.
+  (* int *)
+  monadInv H.
+  rewrite (ireg_of_eq _ _ EQ). econstructor.
+  split. apply exec_straight_one. simpl. unfold exec_load. rewrite H1. rewrite H0.
+  eauto. auto. 
+  split. repeat SRes. 
+  intros. rewrite nextinstr_nf_inv1; auto. SOther.
+  (* float *)
+  exists (nextinstr_nf (rs#(preg_of dst) <- v)).
+  split. destruct (preg_of dst); inv H; apply exec_straight_one; simpl; auto.
+  unfold exec_load. rewrite H1; rewrite H0; auto. 
+  unfold exec_load. rewrite H1; rewrite H0; auto. 
+  split. rewrite nextinstr_nf_inv1. SRes. apply preg_of_important.
+  intros. rewrite nextinstr_nf_inv1; auto. SOther.
+Qed.
+
+Lemma storeind_correct:
+  forall (base: ireg) ofs ty src k (rs: regset) c m m',
+  storeind src base ofs ty k = OK c ->
+  Mem.storev (chunk_of_type ty) m (Val.add rs#base (Vint ofs)) (rs#(preg_of src)) = Some m' ->
+  exists rs',
+     exec_straight c rs m k rs' m'
+  /\ forall r, important_preg r = true -> rs'#r = rs#r.
+Proof.
+  unfold storeind; intros.
+  set (addr := Addrmode (Some base) None (inl (ident * int) ofs)) in *.
+  assert (eval_addrmode ge addr rs = Val.add rs#base (Vint ofs)).
+    unfold addr. simpl. rewrite Int.add_commut; rewrite Int.add_zero; auto. 
+  destruct ty; simpl in H0.
+  (* int *)
+  monadInv H.
+  rewrite (ireg_of_eq _ _ EQ) in H0. econstructor.
+  split. apply exec_straight_one. simpl. unfold exec_store. rewrite H1. rewrite H0.
+  eauto. auto. 
+  intros. apply nextinstr_nf_inv1; auto. 
+  (* float *)
+  destruct (preg_of src); inv H.
+  econstructor; split. apply exec_straight_one.
+  simpl. unfold exec_store. rewrite H1; rewrite H0. eauto. auto.
+  intros. apply nextinstr_nf_inv1; auto.
+  econstructor; split. apply exec_straight_one.
+  simpl. unfold exec_store. rewrite H1; rewrite H0. eauto. auto.
+  intros. apply nextinstr_nf_inv1; auto.
+Qed.
+
+(** Translation of addressing modes *)
+
+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.
+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.
+    subst i. rewrite Int.mul_one. auto. auto.
+  unfold transl_addressing; intros.
+  destruct addr; repeat (destruct args; try discriminate); simpl in H0.
+(* indexed *)
+  monadInv H. rewrite (ireg_of_eq _ _ EQ) in H0. simpl.
+  destruct (rs x); inv H0; simpl. rewrite A; auto. 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.
+(* scaled *)
+  monadInv H. rewrite (ireg_of_eq _ _ EQ) in H0. simpl.
+  destruct (rs x); inv H0; simpl.
+  rewrite B. simpl. rewrite A. 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.
+(* global *)
+  inv H. simpl. unfold symbol_offset. destruct (Genv.find_symbol ge i); inv H0.
+  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.
+(* 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.
+(* instack *)
+  inv H; simpl. unfold offset_sp in H0. 
+  destruct (rs ESP); inv H0. 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
+  /\ rs'#SOF = Val.cmp Clt v1 v2
+  /\ (forall r, nontemp_preg r = true -> rs'#r = rs#r).
+Proof.
+  intros. unfold rs'; unfold compare_ints.
+  split. auto. 
+  split. auto.
+  split. auto.
+  intros. repeat SOther. 
+Qed.
+
+Lemma int_signed_eq:
+  forall x y, Int.eq x y = zeq (Int.signed x) (Int.signed y).
+Proof.
+  intros. unfold Int.eq. unfold proj_sumbool. 
+  destruct (zeq (Int.unsigned x) (Int.unsigned y));
+  destruct (zeq (Int.signed x) (Int.signed y)); auto.
+  elim n. unfold Int.signed. rewrite e; auto.
+  elim n. apply Int.eqm_small_eq; auto with ints. 
+  eapply Int.eqm_trans. apply Int.eqm_sym. apply Int.eqm_signed_unsigned.
+  rewrite e. apply Int.eqm_signed_unsigned. 
+Qed.
+
+Lemma int_not_lt:
+  forall x y, negb (Int.lt y x) = (Int.lt x y || Int.eq x y).
+Proof.
+  intros. unfold Int.lt. rewrite int_signed_eq. unfold proj_sumbool.
+  destruct (zlt (Int.signed y) (Int.signed x)).
+  rewrite zlt_false. rewrite zeq_false. auto. omega. omega.
+  destruct (zeq (Int.signed x) (Int.signed y)). 
+  rewrite zlt_false. auto. omega. 
+  rewrite zlt_true. auto. omega.
+Qed.
+
+Lemma int_lt_not:
+  forall x y, Int.lt y x = negb (Int.lt x y) && negb (Int.eq x y).
+Proof.
+  intros. rewrite <- negb_orb. rewrite <- int_not_lt. rewrite negb_involutive. auto.
+Qed.
+
+Lemma int_not_ltu:
+  forall x y, negb (Int.ltu y x) = (Int.ltu x y || Int.eq x y).
+Proof.
+  intros. unfold Int.ltu, Int.eq.
+  destruct (zlt (Int.unsigned y) (Int.unsigned x)).
+  rewrite zlt_false. rewrite zeq_false. auto. omega. omega.
+  destruct (zeq (Int.unsigned x) (Int.unsigned y)). 
+  rewrite zlt_false. auto. omega. 
+  rewrite zlt_true. auto. omega.
+Qed.
+
+Lemma int_ltu_not:
+  forall x y, Int.ltu y x = negb (Int.ltu x y) && negb (Int.eq x y).
+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,
+  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_signed_comparison_correct_pi:
+  forall c blk n1 n2 rs b,
+  eval_compare_null c n2 = Some b ->
+  eval_testcond (testcond_for_signed_comparison c)
+                (nextinstr (compare_ints (Vptr blk n1) (Vint n2) rs)) = 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 [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_signed_comparison_correct_ip:
+  forall c blk n1 n2 rs b,
+  eval_compare_null c n1 = Some b ->
+  eval_testcond (testcond_for_signed_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_signed_comparison_correct_pp:
+  forall c b1 n1 b2 n2 rs b,
+  (if eq_block b1 b2 then Some (Int.cmp c n1 n2) else eval_compare_mismatch c) = Some b ->
+  eval_testcond (testcond_for_signed_comparison c)
+                (nextinstr (compare_ints (Vptr b1 n1) (Vptr b2 n2) rs)) =
+  Some b.
+Proof.
+  intros. 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.lt n1 n2); auto.
+  discriminate.
+  destruct (zeq b1 b2). inversion H. 
+  rewrite int_not_lt. destruct (Int.lt n1 n2); destruct (Int.eq n1 n2); auto.
+  discriminate.
+  destruct (zeq b1 b2). inversion H. 
+  rewrite (int_lt_not n1 n2). destruct (Int.lt n1 n2); destruct (Int.eq n1 n2); auto.
+  discriminate.
+  destruct (zeq b1 b2). inversion H. destruct (Int.lt n1 n2); auto.
+  discriminate.
+Qed.
+
+Lemma testcond_for_unsigned_comparison_correct:
+  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).
+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.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.
+Qed.
+
+Lemma compare_floats_spec:
+  forall rs n1 n2,
+  let rs' := nextinstr (compare_floats (Vfloat n1) (Vfloat n2) rs) in
+     rs'#ZF = Val.of_bool (negb (Float.cmp Cne n1 n2))
+  /\ rs'#CF = Val.of_bool (negb (Float.cmp Cge n1 n2))
+  /\ rs'#PF = Val.of_bool (negb (Float.cmp Ceq n1 n2 || Float.cmp Clt n1 n2 || Float.cmp Cgt n1 n2))
+  /\ (forall r, nontemp_preg r = true -> rs'#r = rs#r).
+Proof.
+  intros. unfold rs'; unfold compare_floats.
+  split. auto. 
+  split. auto.
+  split. auto.
+  intros. repeat SOther. 
+Qed.
+
+Definition swap_floats (c: comparison) (n1 n2: float) : float :=
+  match c with
+  | Clt | Cle => n2
+  | Ceq | Cne | Cgt | Cge => n1
+  end.
+
+Lemma testcond_for_float_comparison_correct:
+  forall c n1 n2 rs,
+  eval_testcond (testcond_for_condition (Ccompf c))
+                (nextinstr (compare_floats (Vfloat (swap_floats c n1 n2))
+                                           (Vfloat (swap_floats c n2 n1)) rs)) =
+  Some(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_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.
+
+Lemma testcond_for_neg_float_comparison_correct:
+  forall c n1 n2 rs,
+  eval_testcond (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_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.
+
+Lemma transl_cond_correct:
+  forall cond args k c rs m b,
+  transl_cond cond args k = OK c ->
+  eval_condition cond (map rs (map preg_of args)) = Some b ->
+  exists rs',
+     exec_straight c rs m k rs' m
+  /\ eval_testcond (testcond_for_condition cond) rs' = Some b
+  /\ 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.
+  econstructor. split. apply exec_straight_one. simpl. eauto. auto.
+  split. simpl in H0. FuncInv.
+  subst b. apply testcond_for_signed_comparison_correct_ii. 
+  apply testcond_for_signed_comparison_correct_ip; auto. 
+  apply testcond_for_signed_comparison_correct_pi; auto.
+  apply testcond_for_signed_comparison_correct_pp; auto.
+  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.
+  econstructor. split. apply exec_straight_one. simpl. eauto. auto.
+  split. simpl in H0. FuncInv.
+  subst b. apply testcond_for_unsigned_comparison_correct. 
+  intros. unfold compare_ints. repeat SOther.
+(* compimm *)
+  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. apply testcond_for_signed_comparison_correct_ii. 
+  apply testcond_for_signed_comparison_correct_pi; auto.
+  intros. unfold compare_ints. repeat SOther.
+(* compuimm *)
+  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. apply testcond_for_unsigned_comparison_correct.
+  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)).
+  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.
+(* 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)).
+  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.
+(* maskzero *)
+  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. 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.
+  intros. unfold compare_ints. repeat SOther.
+(* masknotzero *)
+  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. 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.
+  intros. unfold compare_ints. repeat SOther.
+Qed.
+
+(** Translation of arithmetic operations. *)
+
+(*
+Ltac TranslOpSimpl :=
+  match goal with
+  | |- exists rs' : regset,
+         exec_straight ?c ?rs ?m ?k rs' ?m /\
+         agree (Regmap.set ?res ?v ?ms) ?sp rs'  =>
+    (exists (nextinstr (rs#(ireg_of res) <- v));
+     split; 
+     [ apply exec_straight_one;
+       [ repeat (rewrite (ireg_val ms sp rs); auto); reflexivity
+       | reflexivity ]
+     | auto with ppcgen ])
+  ||
+    (exists (nextinstr (rs#(freg_of res) <- v));
+     split; 
+     [ apply exec_straight_one;
+       [ repeat (rewrite (freg_val ms sp rs); auto); reflexivity
+       | reflexivity ]
+     | auto with ppcgen ])
+  end.
+*)
+
+Ltac ArgsInv :=
+  match goal with
+  | [ H: Error _ = OK _ |- _ ] => discriminate
+  | [ H: match ?args with nil => _ | _ :: _ => _ end = OK _ |- _ ] => destruct args; ArgsInv
+  | [ H: bind _ _ = OK _ |- _ ] => monadInv H; ArgsInv
+  | [ H: assertion _ = OK _ |- _ ] => monadInv H; subst; ArgsInv
+  | [ H: ireg_of _ = OK _ |- _ ] => simpl in *; rewrite (ireg_of_eq _ _ H) in *; clear H; ArgsInv
+  | [ H: freg_of _ = OK _ |- _ ] => simpl in *; rewrite (freg_of_eq _ _ H) in *; clear H; ArgsInv
+  | _ => idtac
+  end.
+
+Ltac TranslOp :=
+  econstructor; split;
+  [ apply exec_straight_one; [ simpl; eauto | auto ] 
+  | split; [ repeat SRes | intros; repeat SOther ]].
+
+(* Move elsewhere *)
+
+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)) = Some v ->
+  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 | _ => 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).
+(* move *)
+  exploit mk_mov_correct; eauto. intros [rs2 [A [B C]]]. 
+  exists rs2. split. eauto. split. simpl. auto. auto.
+(* cast8signed *)
+  eapply mk_intconv_correct; eauto.
+(* cast8unsigned *)
+  eapply mk_intconv_correct; eauto. 
+(* cast16signed *)
+  eapply mk_intconv_correct; eauto.
+(* cast16unsigned *)
+  eapply mk_intconv_correct; eauto.
+(* div *)
+  eapply mk_div_correct; eauto. intros. simpl. eauto. 
+(* divu *)
+  eapply mk_div_correct; eauto. intros. simpl. eauto. 
+(* mod *)
+  eapply mk_mod_correct; eauto. intros. simpl. eauto. 
+(* modu *)
+  eapply mk_mod_correct; eauto. intros. simpl. eauto. 
+(* shl *)
+  eapply mk_shift_correct; eauto. 
+(* shr *)
+  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. 
+(* shru *)
+  eapply mk_shift_correct; eauto.
+(* lea *)
+  exploit transl_addressing_mode_correct; eauto. intros EA.
+  rewrite (eval_addressing_weaken _ _ _ _ EV). rewrite <- EA. 
+  TranslOp.
+(* condition *)
+  remember (eval_condition c0 rs ## (preg_of ## args)) as ob. destruct ob; inv EV. 
+  rewrite (eval_condition_weaken _ _ (sym_equal Heqob)). 
+  exploit transl_cond_correct; eauto. intros [rs2 [P [Q R]]].
+  exists (nextinstr (rs2#ECX <- Vundef #EDX <- Vundef #x <- v)).
+  split. eapply exec_straight_trans. eauto. 
+  apply exec_straight_one. simpl. rewrite Q. destruct b; inv H0; auto. auto.
+  split. repeat SRes. destruct b; inv H0; auto. 
+  intros. repeat SOther. 
+Qed.
+
+(** Translation of memory loads. *)
+
+Lemma transl_load_correct:
+  forall chunk addr args dest k c (rs: regset) m a v,
+  transl_load chunk addr args dest k = OK c ->
+  eval_addressing ge (rs#ESP) addr (map rs (map preg_of args)) = Some a ->
+  Mem.loadv chunk m a = Some v ->
+  exists rs',
+     exec_straight c rs m k rs' m
+  /\ rs'#(preg_of dest) = v
+  /\ forall r, nontemp_preg r = true -> r <> preg_of dest -> rs'#r = rs#r.
+Proof.
+  unfold transl_load; intros. monadInv H. 
+  exploit transl_addressing_mode_correct; eauto. intro EA.
+  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.
+  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.
+  exists rs2. split. 
+  destruct chunk; ArgsInv; apply exec_straight_one; simpl; auto.
+  split. unfold rs2. rewrite nextinstr_nf_inv1. SRes. apply preg_of_important.
+  intros. unfold rs2. repeat SOther. 
+Qed.
+
+Lemma transl_store_correct:
+  forall chunk addr args src k c (rs: regset) m a m',
+  transl_store chunk addr args src k = OK c ->
+  eval_addressing ge (rs#ESP) addr (map rs (map preg_of args)) = Some a ->
+  Mem.storev chunk m a (rs (preg_of src)) = Some m' ->
+  exists rs',
+     exec_straight c rs m k rs' m'
+  /\ 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.
+(* int8signed *)
+  eapply mk_smallstore_correct; eauto.
+  intros. simpl. unfold exec_store.
+  destruct (eval_addrmode ge addr0 rs0); simpl; auto. rewrite Mem.store_signed_unsigned_8; auto.
+(* int8unsigned *)
+  eapply mk_smallstore_correct; eauto.
+(* int16signed *)
+  eapply mk_smallstore_correct; eauto.
+  intros. simpl. unfold exec_store.
+  destruct (eval_addrmode ge addr0 rs0); simpl; auto. rewrite Mem.store_signed_unsigned_16; auto.
+(* int16unsigned *)
+  eapply mk_smallstore_correct; eauto.
+(* int32 *)
+  econstructor; split.
+  apply exec_straight_one. simpl. unfold exec_store. rewrite H1. eauto. auto.
+  intros. SOther.
+(* float32 *)
+  econstructor; split.
+  apply exec_straight_one. simpl. unfold exec_store. rewrite H1. eauto. auto.
+  intros. SOther.
+(* float64 *)
+  econstructor; split.
+  apply exec_straight_one. simpl. unfold exec_store. rewrite H1. eauto. auto.
+  intros. SOther.
+Qed.
+
+End STRAIGHTLINE.
+
diff --git a/ia32/Asmgenretaddr.v b/ia32/Asmgenretaddr.v
new file mode 100644
index 0000000..048f5a2
--- /dev/null
+++ b/ia32/Asmgenretaddr.v
@@ -0,0 +1,244 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Predictor for return addresses in generated IA32 code.
+
+    The [return_address_offset] predicate defined here is used in the
+    concrete semantics for Mach (module [Machconcr]) to determine the
+    return addresses that are stored in activation records. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Errors.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memory.
+Require Import Globalenvs.
+Require Import Op.
+Require Import Locations.
+Require Import Mach.
+Require Import Asm.
+Require Import Asmgen.
+
+(** The ``code tail'' of an instruction list [c] is the list of instructions
+  starting at PC [pos]. *)
+
+Inductive code_tail: Z -> code -> code -> Prop :=
+  | code_tail_0: forall c,
+      code_tail 0 c c
+  | code_tail_S: forall pos i c1 c2,
+      code_tail pos c1 c2 ->
+      code_tail (pos + 1) (i :: c1) c2.
+
+Lemma code_tail_pos:
+  forall pos c1 c2, code_tail pos c1 c2 -> pos >= 0.
+Proof.
+  induction 1. omega. omega.
+Qed.
+
+(** Consider a Mach function [f] and a sequence [c] of Mach instructions
+  representing the Mach code that remains to be executed after a
+  function call returns.  The predicate [return_address_offset f c ofs]
+  holds if [ofs] is the integer offset of the PPC instruction
+  following the call in the Asm code obtained by translating the
+  code of [f]. Graphically:
+<<
+     Mach function f    |--------- Mcall ---------|
+         Mach code c    |                |--------|
+                        |                 \        \
+                        |                  \        \
+                        |                   \        \
+     Asm code           |                    |--------|
+     Asm function       |------------- Pcall ---------|
+
+                        <-------- ofs ------->
+>>
+*)
+
+Inductive return_address_offset: Mach.function -> Mach.code -> int -> Prop :=
+  | return_address_offset_intro:
+      forall f c ofs,
+      (forall tf tc,
+       transf_function f = OK tf ->
+       transl_code f c = OK tc ->
+       code_tail ofs tf tc) ->
+      return_address_offset f c (Int.repr ofs).
+
+(** We now show that such an offset always exists if the Mach code [c]
+  is a suffix of [f.(fn_code)].  This holds because the translation
+  from Mach to PPC is compositional: each Mach instruction becomes
+  zero, one or several PPC instructions, but the order of instructions
+  is preserved. *)
+
+Lemma is_tail_code_tail:
+  forall c1 c2, is_tail c1 c2 -> exists ofs, code_tail ofs c2 c1.
+Proof.
+  induction 1. exists 0; constructor.
+  destruct IHis_tail as [ofs CT]. exists (ofs + 1); constructor; auto.
+Qed.
+
+Hint Resolve is_tail_refl: ppcretaddr.
+
+(*
+Ltac IsTail :=
+  auto with ppcretaddr;
+  match goal with
+  | [ |- is_tail _ (_ :: _) ] => constructor; IsTail
+  | [ |- is_tail _ (match ?x with true => _ | false => _ end) ] => destruct x; IsTail
+  | [ |- is_tail _ (match ?x with left _ => _ | right _ => _ end) ] => destruct x; IsTail
+  | [ |- is_tail _ (match ?x with nil => _ | _ :: _ => _ end) ] => destruct x; IsTail
+  | [ |- is_tail _ (match ?x with Tint => _ | Tfloat => _ end) ] => destruct x; IsTail
+  | [ |- is_tail _ (?f _ _ _ _ _ _ ?k) ] => apply is_tail_trans with k; IsTail
+  | [ |- is_tail _ (?f _ _ _ _ _ ?k) ] => apply is_tail_trans with k; IsTail
+  | [ |- is_tail _ (?f _ _ _ _ ?k) ] => apply is_tail_trans with k; IsTail
+  | [ |- is_tail _ (?f _ _ _ ?k) ] => apply is_tail_trans with k; IsTail
+  | [ |- is_tail _ (?f _ _ ?k) ] => apply is_tail_trans with k; IsTail
+  | _ => idtac
+  end.
+*)
+Ltac IsTail :=
+  eauto with ppcretaddr;
+  match goal with
+  | [ |- is_tail _ (_ :: _) ] => constructor; IsTail
+  | [ H: Error _ = OK _ |- _ ] => discriminate
+  | [ H: OK _ = OK _ |- _ ] => inversion H; subst; IsTail
+  | [ H: bind _ _ = OK _ |- _ ] => monadInv H; IsTail
+  | [ H: (if ?x then _ else _) = OK _ |- _ ] => destruct x; IsTail
+  | [ H: match ?x with nil => _ | _ :: _ => _ end = OK _ |- _ ] => destruct x; IsTail
+  | _ => idtac
+  end.
+
+Lemma mk_mov_tail:
+  forall rd rs k c, mk_mov rd rs k = OK c -> is_tail k c.
+Proof.
+  unfold mk_mov; intros. destruct rd; IsTail; destruct rs; IsTail.
+Qed.
+
+Lemma mk_shift_tail:
+  forall si r1 r2 k c, mk_shift si r1 r2 k = OK c -> is_tail k c.
+Proof.
+  unfold mk_shift; intros; IsTail.
+Qed.
+
+Lemma mk_div_tail:
+  forall di r1 r2 k c, mk_div di r1 r2 k = OK c -> is_tail k c.
+Proof.
+  unfold mk_div; intros; IsTail.
+Qed.
+
+Lemma mk_mod_tail:
+  forall di r1 r2 k c, mk_mod di r1 r2 k = OK c -> is_tail k c.
+Proof.
+  unfold mk_mod; intros; IsTail.
+Qed.
+
+Lemma mk_shrximm_tail:
+  forall r n k c, mk_shrximm r n k = OK c -> is_tail k c.
+Proof.
+  unfold mk_shrximm; intros; IsTail.
+Qed.
+
+Lemma mk_intconv_tail:
+  forall mk rd rs k c, mk_intconv mk rd rs k = OK c -> is_tail k c.
+Proof.
+  unfold mk_intconv; intros; IsTail.
+Qed.
+
+Lemma mk_smallstore_tail:
+  forall sto addr rs k c, mk_smallstore sto addr rs k = OK c -> is_tail k c.
+Proof.
+  unfold mk_smallstore; intros; IsTail.
+Qed.
+
+Lemma loadind_tail:
+  forall base ofs ty dst k c, loadind base ofs ty dst k = OK c -> is_tail k c.
+Proof.
+  unfold loadind; intros. destruct ty; IsTail. destruct (preg_of dst); IsTail.
+Qed.
+
+Lemma storeind_tail:
+  forall src base ofs ty k c, storeind src base ofs ty k = OK c -> is_tail k c.
+Proof.
+  unfold storeind; intros. destruct ty; IsTail. destruct (preg_of src); IsTail.
+Qed.
+
+Hint Resolve mk_mov_tail mk_shift_tail mk_div_tail mk_mod_tail mk_shrximm_tail
+             mk_intconv_tail mk_smallstore_tail loadind_tail storeind_tail : ppcretaddr.
+
+Lemma transl_cond_tail:
+  forall cond args k c, transl_cond cond args k = OK c -> is_tail k c.
+Proof.
+  unfold transl_cond; intros. destruct cond; IsTail; destruct (Int.eq_dec i Int.zero); IsTail.
+Qed.
+
+Lemma transl_op_tail:
+  forall op args res k c, transl_op op args res k = OK c -> is_tail k c.
+Proof.
+  unfold transl_op; intros. destruct op; IsTail. 
+  eapply is_tail_trans. 2: eapply transl_cond_tail; eauto. IsTail.
+Qed.
+
+Lemma transl_load_tail:
+  forall chunk addr args dest k c, transl_load chunk addr args dest k = OK c -> is_tail k c.
+Proof.
+  unfold transl_load; intros. IsTail. destruct chunk; IsTail. 
+Qed.
+
+Lemma transl_store_tail:
+  forall chunk addr args src k c, transl_store chunk addr args src k = OK c -> is_tail k c.
+Proof.
+  unfold transl_store; intros. IsTail. destruct chunk; IsTail. 
+Qed.
+
+Lemma transl_instr_tail:
+  forall f i k c, transl_instr f i k = OK c -> is_tail k c.
+Proof.
+  unfold transl_instr; intros. destruct i; IsTail.
+  eapply is_tail_trans; eapply loadind_tail; eauto.
+  eapply transl_op_tail; eauto.
+  eapply transl_load_tail; eauto.
+  eapply transl_store_tail; eauto.
+  destruct s0; IsTail.
+  destruct s0; IsTail.
+  eapply is_tail_trans. 2: eapply transl_cond_tail; eauto. IsTail.
+Qed.
+ 
+Lemma transl_code_tail: 
+  forall f c1 c2, is_tail c1 c2 ->
+  forall tc1 tc2, transl_code f c1 = OK tc1 -> transl_code f c2 = OK tc2 ->
+  is_tail tc1 tc2.
+Proof.
+  induction 1; simpl; intros.
+  replace tc2 with tc1 by congruence. constructor.
+  IsTail. apply is_tail_trans with x. eauto. eapply transl_instr_tail; eauto.
+Qed.
+
+Lemma return_address_exists:
+  forall f c, is_tail c f.(fn_code) ->
+  exists ra, return_address_offset f c ra.
+Proof.
+  intros.
+  caseEq (transf_function f). intros tf TF. 
+  caseEq (transl_code f c). intros tc TC.  
+  assert (is_tail tc tf). 
+  unfold transf_function in TF. monadInv TF. 
+  destruct (zlt (list_length_z x) Int.max_unsigned); monadInv EQ0.
+  IsTail. eapply transl_code_tail; eauto. 
+  destruct (is_tail_code_tail _ _ H0) as [ofs A].
+  exists (Int.repr ofs). constructor; intros. congruence. 
+  intros. exists (Int.repr 0). constructor; intros; congruence.
+  intros. exists (Int.repr 0). constructor; intros; congruence.
+Qed.
+
+ 
diff --git a/ia32/CBuiltins.ml b/ia32/CBuiltins.ml
new file mode 100644
index 0000000..d077fe5
--- /dev/null
+++ b/ia32/CBuiltins.ml
@@ -0,0 +1,28 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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 GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Processor-dependent builtin C functions *)
+
+open Cparser
+open C
+
+let builtins = {
+  Builtins.typedefs = [];
+  Builtins.functions = [
+    (* Float arithmetic *)
+    "__builtin_fsqrt",
+      (TFloat(FDouble, []), [TFloat(FDouble, [])], false);
+  ]
+}
diff --git a/ia32/ConstpropOp.v b/ia32/ConstpropOp.v
new file mode 100644
index 0000000..7dfa046
--- /dev/null
+++ b/ia32/ConstpropOp.v
@@ -0,0 +1,1010 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Static analysis and strength reduction for operators 
+  and conditions.  This is the machine-dependent part of [Constprop]. *)
+
+Require Import Coqlib.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Op.
+Require Import Registers.
+
+(** * Static analysis *)
+
+(** To each pseudo-register at each program point, the static analysis 
+  associates a compile-time approximation taken from the following set. *)
+
+Inductive approx : Type :=
+  | Novalue: approx      (** No value possible, code is unreachable. *)
+  | Unknown: approx      (** All values are possible,
+                             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.
+                         (** The value is the address of the given global
+                             symbol plus the given integer offset. *)
+
+(** We now define the abstract interpretations of conditions and operators
+  over this set of approximations.  For instance, the abstract interpretation
+  of the operator [Oaddf] applied to two expressions [a] and [b] is
+  [F(Float.add f g)] if [a] and [b] have static approximations [Vfloat f]
+  and [Vfloat g] respectively, and [Unknown] otherwise.
+
+  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
+  duplication of cases in proofs. *)
+
+(*
+Definition 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)
+  | Ccompimm c n, I n1 :: nil => Some(Int.cmp c n1 n)
+  | Ccompuimm c n, I n1 :: nil => Some(Int.cmpu c n1 n)
+  | 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))
+  | _, _ => 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.
+
+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
+  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 =>
+      Some(Int.cmp c n1 n2)
+  | eval_static_condition_case2 c n1 n2 =>
+      Some(Int.cmpu c n1 n2)
+  | eval_static_condition_case3 c n n1 =>
+      Some(Int.cmp c n1 n)
+  | eval_static_condition_case4 c n n1 =>
+      Some(Int.cmpu c n1 n)
+  | eval_static_condition_case5 c n1 n2 =>
+      Some(Float.cmp c n1 n2)
+  | eval_static_condition_case6 c n1 n2 =>
+      Some(negb(Float.cmp c n1 n2))
+  | eval_static_condition_case7 n n1 =>
+      Some(Int.eq (Int.and n1 n) Int.zero)
+  | eval_static_condition_case8 n n1 =>
+      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
+  | Aindexed n, I n1::nil => I (Int.add n1 n)
+  | Aindexed n, S id ofs::nil => S id (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)
+  | 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))
+  | _, _ => 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.
+
+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
+  end.
+
+Definition eval_static_addressing (addr: addressing) (vl: list approx) :=
+  match eval_static_addressing_match addr vl with
+  | eval_static_addressing_case1 n n1 =>
+      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 =>
+      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 =>
+      I (Int.add (Int.mul n1 sc) n)
+  | eval_static_addressing_case7 sc n n1 n2 =>
+      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_default addr vl =>
+      Unknown
+  end.
+
+(*
+Definition eval_static_operation (op: operation) (vl: list approx) :=
+  match op, vl with
+  | Omove, v1::nil => v1
+  | Ointconst n, nil => I n
+  | Ofloatconst n, nil => F n
+  | Ocast8signed, I n1 :: nil => I(Int.sign_ext 8 n1)
+  | Ocast8unsigned, I n1 :: nil => I(Int.zero_ext 8 n1)
+  | Ocast16signed, I n1 :: nil => I(Int.sign_ext 16 n1)
+  | 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)
+  | 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)
+  | Odivu, I n1 :: I n2 :: nil => if Int.eq n2 Int.zero then Unknown else I(Int.divu n1 n2)
+  | Omod, I n1 :: I n2 :: nil => if Int.eq n2 Int.zero then Unknown else I(Int.mods n1 n2)
+  | Omodu, I n1 :: I n2 :: nil => if Int.eq n2 Int.zero then Unknown else I(Int.modu n1 n2)
+  | Oand, I n1 :: I n2 :: nil => I(Int.and n1 n2)
+  | Oandimm n, I n1 :: nil => I(Int.and n1 n)
+  | Oor, I n1 :: I n2 :: nil => I(Int.or n1 n2)
+  | Oorimm n, I n1 :: nil => I(Int.or n1 n)
+  | Oxor, I n1 :: I n2 :: nil => I(Int.xor n1 n2)
+  | Oxorimm n, I n1 :: nil => I(Int.xor n1 n)
+  | Oshl, I n1 :: I n2 :: nil => if Int.ltu n2 Int.iwordsize then I(Int.shl n1 n2) else Unknown
+  | 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
+  | 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
+  | Olea mode, vl => eval_static_addressing mode vl
+  | Onegf, F n1 :: nil => F(Float.neg n1)
+  | Oabsf, F n1 :: nil => F(Float.abs n1)
+  | Oaddf, F n1 :: F n2 :: nil => F(Float.add n1 n2)
+  | Osubf, F n1 :: F n2 :: nil => F(Float.sub n1 n2)
+  | 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 => I(Float.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
+  | _, _ => 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.
+
+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
+  end.
+
+Definition eval_static_operation (op: operation) (vl: list approx) :=
+  match eval_static_operation_match op vl with
+  | eval_static_operation_case1 v1 =>
+      v1
+  | eval_static_operation_case2 n =>
+      I n
+  | eval_static_operation_case3 n =>
+      F n
+  | eval_static_operation_case4 n1 =>
+      I(Int.sign_ext 8 n1)
+  | eval_static_operation_case5 n1 =>
+      I(Int.zero_ext 8 n1)
+  | eval_static_operation_case6 n1 =>
+      I(Int.sign_ext 16 n1)
+  | eval_static_operation_case7 n1 =>
+      I(Int.zero_ext 16 n1)
+  | eval_static_operation_case8 n1 =>
+      I(Int.neg n1)
+  | eval_static_operation_case9 n1 n2 =>
+      I(Int.sub n1 n2)
+  | eval_static_operation_case10 s1 n1 n2 =>
+      S s1 (Int.sub n1 n2)
+  | eval_static_operation_case11 n1 n2 =>
+      I(Int.mul n1 n2)
+  | eval_static_operation_case12 n n1 =>
+      I(Int.mul n1 n)
+  | eval_static_operation_case13 n1 n2 =>
+      if Int.eq n2 Int.zero then Unknown else I(Int.divs n1 n2)
+  | eval_static_operation_case14 n1 n2 =>
+      if Int.eq n2 Int.zero then Unknown else I(Int.divu n1 n2)
+  | eval_static_operation_case15 n1 n2 =>
+      if Int.eq n2 Int.zero then Unknown else I(Int.mods n1 n2)
+  | eval_static_operation_case16 n1 n2 =>
+      if Int.eq n2 Int.zero then Unknown else I(Int.modu n1 n2)
+  | eval_static_operation_case17 n1 n2 =>
+      I(Int.and n1 n2)
+  | eval_static_operation_case18 n n1 =>
+      I(Int.and n1 n)
+  | eval_static_operation_case19 n1 n2 =>
+      I(Int.or n1 n2)
+  | eval_static_operation_case20 n n1 =>
+      I(Int.or n1 n)
+  | eval_static_operation_case21 n1 n2 =>
+      I(Int.xor n1 n2)
+  | eval_static_operation_case22 n n1 =>
+      I(Int.xor n1 n)
+  | eval_static_operation_case23 n1 n2 =>
+      if Int.ltu n2 Int.iwordsize then I(Int.shl n1 n2) else Unknown
+  | eval_static_operation_case24 n n1 =>
+      if Int.ltu n Int.iwordsize then I(Int.shl n1 n) else Unknown
+  | eval_static_operation_case25 n1 n2 =>
+      if Int.ltu n2 Int.iwordsize then I(Int.shr n1 n2) else Unknown
+  | eval_static_operation_case26 n n1 =>
+      if Int.ltu n Int.iwordsize then I(Int.shr n1 n) else Unknown
+  | eval_static_operation_case27 n n1 =>
+      if Int.ltu n (Int.repr 31) then I(Int.shrx n1 n) else Unknown
+  | eval_static_operation_case28 n1 n2 =>
+      if Int.ltu n2 Int.iwordsize then I(Int.shru n1 n2) else Unknown
+  | eval_static_operation_case29 n n1 =>
+      if Int.ltu n Int.iwordsize then I(Int.shru n1 n) else Unknown
+  | eval_static_operation_case30 n n1 =>
+      if Int.ltu n Int.iwordsize then I(Int.ror n1 n) else Unknown
+  | eval_static_operation_case31 mode vl =>
+      eval_static_addressing mode vl
+  | eval_static_operation_case32 n1 =>
+      F(Float.neg n1)
+  | eval_static_operation_case33 n1 =>
+      F(Float.abs n1)
+  | eval_static_operation_case34 n1 n2 =>
+      F(Float.add n1 n2)
+  | eval_static_operation_case35 n1 n2 =>
+      F(Float.sub n1 n2)
+  | eval_static_operation_case36 n1 n2 =>
+      F(Float.mul n1 n2)
+  | eval_static_operation_case37 n1 n2 =>
+      F(Float.div n1 n2)
+  | eval_static_operation_case38 n1 =>
+      F(Float.singleoffloat n1)
+  | eval_static_operation_case39 n1 =>
+      I(Float.intoffloat n1)
+  | eval_static_operation_case41 n1 =>
+      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_default op vl =>
+      Unknown
+  end.
+
+(** * Operator strength reduction *)
+
+(** We now define auxiliary functions for strength reduction of
+  operators and addressing modes: replacing an operator with a cheaper
+  one if some of its arguments are statically known.  These are again
+  large pattern-matchings expressed in indirect style. *)
+
+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
+  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 =>
+      (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 *)
+  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
+  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 =>
+      (addr, args)
+  end.
+
+Definition make_addimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero
+  then (Omove, r :: nil)
+  else (Oaddimm n, r :: nil).
+
+Definition make_shlimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero
+  then (Omove, r :: nil)
+  else (Oshlimm n, r :: nil).
+
+Definition make_shrimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero
+  then (Omove, r :: nil)
+  else (Oshrimm n, r :: nil).
+
+Definition make_shruimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero
+  then (Omove, r :: nil)
+  else (Oshruimm n, r :: nil).
+
+Definition make_mulimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero then
+    (Ointconst Int.zero, nil)
+  else if Int.eq n Int.one then
+    (Omove, r :: nil)
+  else
+    match Int.is_power2 n with
+    | Some l => make_shlimm l r
+    | None => (Omulimm n, r :: nil)
+    end.
+
+Definition make_andimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero
+  then (Ointconst Int.zero, nil)
+  else if Int.eq n Int.mone then (Omove, r :: nil)
+  else (Oandimm n, r :: nil).
+
+Definition make_orimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero then (Omove, r :: nil)
+  else if Int.eq n Int.mone then (Ointconst Int.mone, nil)
+  else (Oorimm n, r :: nil).
+
+Definition make_xorimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero
+  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 *)
+  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
+  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
+      (Olea addr', args')
+  | op_strength_reduction_case15 c args =>
+      (* Ocmp *)
+      let (c', args') := cond_strength_reduction c args in
+      (Ocmp c', args')
+  | op_strength_reduction_default op args =>
+      (* default *)
+      (op, args)
+  end.
+
+End STRENGTH_REDUCTION.
diff --git a/ia32/ConstpropOpproof.v b/ia32/ConstpropOpproof.v
new file mode 100644
index 0000000..ea90446
--- /dev/null
+++ b/ia32/ConstpropOpproof.v
@@ -0,0 +1,497 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Correctness proof for constant propagation (processor-dependent part). *)
+
+Require Import Coqlib.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memory.
+Require Import Globalenvs.
+Require Import Op.
+Require Import Registers.
+Require Import RTL.
+Require Import ConstpropOp.
+Require Import Constprop.
+
+(** * Correctness of the static analysis *)
+
+Section ANALYSIS.
+
+Variable ge: genv.
+
+(** We first show that the dataflow analysis is correct with respect
+  to the dynamic semantics: the approximations (sets of values) 
+  of a register at a program point predicted by the static analysis
+  are a superset of the values actually encountered during concrete
+  executions.  We formalize this correspondence between run-time values and
+  compile-time approximations by the following predicate. *)
+
+Definition val_match_approx (a: approx) (v: val) : Prop :=
+  match a with
+  | 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
+  | _ => False
+  end.
+
+Inductive val_list_match_approx: list approx -> list val -> Prop :=
+  | vlma_nil:
+      val_list_match_approx nil nil
+  | vlma_cons:
+      forall a al v vl,
+      val_match_approx a v ->
+      val_list_match_approx al vl ->
+      val_list_match_approx (a :: al) (v :: vl).
+
+Ltac SimplVMA :=
+  match goal with
+  | H: (val_match_approx (I _) ?v) |- _ =>
+      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
+  | _ =>
+      idtac
+  end.
+
+Ltac InvVLMA :=
+  match goal with
+  | H: (val_list_match_approx nil ?vl) |- _ =>
+      inversion H
+  | H: (val_list_match_approx (?a :: ?al) ?vl) |- _ =>
+      inversion H; SimplVMA; InvVLMA
+  | _ =>
+      idtac
+  end.
+
+(** We then show that [eval_static_operation] is a correct abstract
+  interpretations of [eval_operation]: if the concrete arguments match
+  the given approximations, the concrete results match the
+  approximations returned by [eval_static_operation]. *)
+
+Lemma eval_static_condition_correct:
+  forall cond al vl b,
+  val_list_match_approx al vl ->
+  eval_static_condition cond al = Some b ->
+  eval_condition cond vl = Some b.
+Proof.
+  intros until b.
+  unfold eval_static_condition. 
+  case (eval_static_condition_match cond al); intros;
+  InvVLMA; simpl; congruence.
+Qed.
+
+Lemma eval_static_addressing_correct:
+  forall addr sp 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.
+Qed.
+
+Lemma eval_static_operation_correct:
+  forall op sp al vl v,
+  val_list_match_approx al vl ->
+  eval_operation ge sp op vl = Some v ->
+  val_match_approx (eval_static_operation op al) v.
+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.
+
+  eapply eval_static_addressing_correct; eauto.
+
+  rewrite <- H3. replace v0 with (Vfloat n1). reflexivity. congruence.
+
+  caseEq (eval_static_condition c vl0).
+  intros. generalize (eval_static_condition_correct _ _ _ _ H H1).
+  intro. rewrite H2 in H0. 
+  destruct b; injection H0; intro; subst v; simpl; auto.
+  intros; simpl; auto.
+
+  auto.
+Qed.
+
+(** * Correctness of strength reduction *)
+
+(** We now show that strength reduction over operators and addressing
+  modes preserve semantics: the strength-reduced operations and
+  addressings evaluate to the same values as the original ones if the
+  actual arguments match the static approximations used for strength
+  reduction. *)
+
+Section STRENGTH_REDUCTION.
+
+Variable app: reg -> approx.
+Variable sp: val.
+Variable rs: regset.
+Hypothesis MATCH: forall r, val_match_approx (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.
+
+Lemma cond_strength_reduction_correct:
+  forall cond args,
+  let (cond', args') := cond_strength_reduction app cond args in
+  eval_condition cond' rs##args' = eval_condition cond rs##args.
+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.
+  destruct c; reflexivity.
+  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.
+  caseEq (intval app r2); intros.
+  simpl. rewrite (intval_correct _ _ H0). auto.
+  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
+  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.
+
+  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) = Some v ->
+  eval_operation ge sp op rs##args = Some 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.
+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) = Some v ->
+  eval_operation ge sp op rs##args = Some 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.
+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) = Some v ->
+  eval_operation ge sp op rs##args = Some 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.
+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) = Some v ->
+  eval_operation ge sp op rs##args = Some 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))
+     with (eval_operation ge sp Oshl (rs # r :: Vint i :: nil)).
+  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.
+Qed.
+
+Lemma make_andimm_correct:
+  forall n r v,
+  let (op, args) := make_andimm n r in
+  eval_operation ge sp Oand (rs#r :: Vint n :: nil) = Some v ->
+  eval_operation ge sp op rs##args = Some 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.
+Qed.
+
+Lemma make_orimm_correct:
+  forall n r v,
+  let (op, args) := make_orimm n r in
+  eval_operation ge sp Oor (rs#r :: Vint n :: nil) = Some v ->
+  eval_operation ge sp op rs##args = Some 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.
+Qed.
+
+Lemma make_xorimm_correct:
+  forall n r v,
+  let (op, args) := make_xorimm n r in
+  eval_operation ge sp Oxor (rs#r :: Vint n :: nil) = Some v ->
+  eval_operation ge sp op rs##args = Some 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.
+Qed.
+
+Lemma op_strength_reduction_correct:
+  forall op args v,
+  let (op', args') := op_strength_reduction app op args in
+  eval_operation ge sp op rs##args = Some v ->
+  eval_operation ge sp op' rs##args' = Some v.
+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))
+     with (eval_operation ge sp Oshru (rs # r1 :: Vint i0 :: nil)).
+  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.
+Qed.
+
+End STRENGTH_REDUCTION.
+
+End ANALYSIS.
+
diff --git a/ia32/Machregs.v b/ia32/Machregs.v
new file mode 100644
index 0000000..9935efa
--- /dev/null
+++ b/ia32/Machregs.v
@@ -0,0 +1,76 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+
+(** ** Machine registers *)
+
+(** The following type defines the machine registers that can be referenced
+  as locations.  These include:
+- Integer registers that can be allocated to RTL pseudo-registers ([Rxx]).
+- Floating-point registers that can be allocated to RTL pseudo-registers 
+  ([Fxx]).
+- Two integer registers, not allocatable, reserved as temporaries for
+  spilling and reloading ([IT1, IT2]).
+- Two float registers, not allocatable, reserved as temporaries for
+  spilling and reloading ([FT1, FT2]).
+
+  The type [mreg] does not include special-purpose or reserved
+  machine registers such as the stack pointer and the condition codes. *)
+
+Inductive mreg: Type :=
+  (** Allocatable integer regs *)
+  | AX: mreg | BX: mreg | SI: mreg | DI: mreg | BP: mreg
+  (** Allocatable float regs *)
+  | X0: mreg | X1: mreg | X2: mreg | X3: mreg | X4: mreg | X5: mreg
+  (** Integer temporaries *)
+  | IT1: mreg (* DX *) | IT2: mreg (* CX *)
+  (** Float temporaries *)
+  | FT1: mreg (* X6 *) | FT2: mreg (* X7 *) | FP0: mreg (* top of FP stack *).
+
+Lemma mreg_eq: forall (r1 r2: mreg), {r1 = r2} + {r1 <> r2}.
+Proof. decide equality. Qed.
+
+Definition mreg_type (r: mreg): typ :=
+  match r with
+  | AX => Tint | BX => Tint | SI => Tint | DI => Tint | BP => Tint
+  (** Allocatable float regs *)
+  | X0 => Tfloat | X1 => Tfloat | X2 => Tfloat
+  | X3 => Tfloat | X4 => Tfloat | X5 => Tfloat
+  (** Integer temporaries *)
+  | IT1 => Tint | IT2 => Tint
+  (** Float temporaries *)
+  | FT1 => Tfloat | FT2 => Tfloat | FP0 => Tfloat
+  end.
+
+Open Scope positive_scope.
+
+Module IndexedMreg <: INDEXED_TYPE.
+  Definition t := mreg.
+  Definition eq := mreg_eq.
+  Definition index (r: mreg): positive :=
+    match r with
+    | AX => 1 | BX => 2 | SI => 3 | DI => 4 | BP => 5
+    | X0 => 6 | X1 => 7 | X2 => 8
+    | X3 => 9 | X4 => 10 | X5 => 11
+    | IT1 => 12 | IT2 => 13
+    | FT1 => 14 | FT2 => 15 | FP0 => 16
+    end.
+  Lemma index_inj:
+    forall r1 r2, index r1 = index r2 -> r1 = r2.
+  Proof.
+    destruct r1; destruct r2; simpl; intro; discriminate || reflexivity.
+  Qed.
+End IndexedMreg.
+
diff --git a/ia32/Machregsaux.ml b/ia32/Machregsaux.ml
new file mode 100644
index 0000000..7d6df90
--- /dev/null
+++ b/ia32/Machregsaux.ml
@@ -0,0 +1,40 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Auxiliary functions on machine registers *)
+
+open Machregs
+
+let register_names = [
+  ("AX", AX); ("BX", BX); ("SI", SI); ("DI", DI); ("BP", BP);
+  ("XMM0", X0); ("XMM1", X1); ("XMM2", X2); ("XMM3", X3);
+  ("XMM4", X4); ("XMM5", X5);
+  ("DX", IT1); ("CX", IT2);
+  ("XMM6", FT1); ("XMM7", FT2); ("ST0", FP0)
+]
+
+let name_of_register r =
+  let rec rev_assoc = function
+  | [] -> None
+  | (a, b) :: rem -> if b = r then Some a else rev_assoc rem
+  in rev_assoc register_names
+
+let register_by_name s =
+  try
+    Some(List.assoc (String.uppercase s) register_names)
+  with Not_found ->
+    None
+
+let can_reserve_register r =
+  List.mem r Conventions1.int_callee_save_regs
+  || List.mem r Conventions1.float_callee_save_regs
+
diff --git a/ia32/Machregsaux.mli b/ia32/Machregsaux.mli
new file mode 100644
index 0000000..4cd7902
--- /dev/null
+++ b/ia32/Machregsaux.mli
@@ -0,0 +1,17 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Auxiliary functions on machine registers *)
+
+val name_of_register: Machregs.mreg -> string option
+val register_by_name: string -> Machregs.mreg option
+val can_reserve_register: Machregs.mreg -> bool
diff --git a/ia32/Op.v b/ia32/Op.v
new file mode 100644
index 0000000..ea28845
--- /dev/null
+++ b/ia32/Op.v
@@ -0,0 +1,974 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Operators and addressing modes.  The abstract syntax and dynamic
+  semantics for the CminorSel, RTL, LTL and Mach languages depend on the
+  following types, defined in this library:
+- [condition]:  boolean conditions for conditional branches;
+- [operation]: arithmetic and logical operations;
+- [addressing]: addressing modes for load and store operations.
+
+  These types are IA32-specific and correspond roughly to what the 
+  processor can compute in one instruction.  In other terms, these
+  types reflect the state of the program after instruction selection.
+  For a processor-independent set of operations, see the abstract
+  syntax and dynamic semantics of the Cminor language.
+*)
+
+Require Import Coqlib.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memdata.
+Require Import Memory.
+Require Import Globalenvs.
+
+Set Implicit Arguments.
+
+(** Conditions (boolean-valued operators). *)
+
+Inductive condition : Type :=
+  | Ccomp: comparison -> condition      (**r signed integer comparison *)
+  | Ccompu: comparison -> condition     (**r unsigned integer comparison *)
+  | Ccompimm: comparison -> int -> condition (**r signed integer comparison with a constant *)
+  | Ccompuimm: comparison -> int -> condition  (**r unsigned integer comparison with a constant *)
+  | Ccompf: comparison -> condition     (**r floating-point comparison *)
+  | Cnotcompf: comparison -> condition  (**r negation of a floating-point comparison *)
+  | Cmaskzero: int -> condition         (**r test [(arg & constant) == 0] *)
+  | Cmasknotzero: int -> condition.     (**r test [(arg & constant) != 0] *)
+
+(** Addressing modes.  [r1], [r2], etc, are the arguments to the 
+  addressing. *)
+
+Inductive addressing: Type :=
+  | Aindexed: int -> addressing         (**r Address is [r1 + offset] *)
+  | Aindexed2: int -> addressing        (**r Address is [r1 + r2 + offset] *)
+  | Ascaled: int -> int -> addressing   (**r Address is [r1 * scale + offset] *)
+  | Aindexed2scaled: int -> int -> addressing
+                                   (**r Address is [r1 + r2 * scale + offset] *)
+  | Aglobal: ident -> int -> addressing (**r Address is [symbol + offset] *)
+  | Abased: ident -> int -> addressing  (**r Address is [symbol + offset + r1] *)
+  | Abasedscaled: int -> ident -> int -> addressing  (**r Address is [symbol + offset + r1 * scale] *)
+  | Ainstack: int -> addressing.        (**r Address is [stack_pointer + offset] *)
+
+(** Arithmetic and logical operations.  In the descriptions, [rd] is the
+  result of the operation and [r1], [r2], etc, are the arguments. *)
+
+Inductive operation : Type :=
+  | Omove: operation                    (**r [rd = r1] *)
+  | Ointconst: int -> operation         (**r [rd] is set to the given integer constant *)
+  | Ofloatconst: float -> operation     (**r [rd] is set to the given float constant *)
+(*c Integer arithmetic: *)
+  | Ocast8signed: operation             (**r [rd] is 8-bit sign extension of [r1] *)
+  | Ocast8unsigned: operation           (**r [rd] is 8-bit zero extension of [r1] *)
+  | Ocast16signed: operation            (**r [rd] is 16-bit sign extension of [r1] *)
+  | Ocast16unsigned: operation          (**r [rd] is 16-bit zero extension of [r1] *)
+  | Oneg: operation                     (**r [rd = - r1] *)
+  | Osub: operation                     (**r [rd = r1 - r2] *)
+  | Omul: operation                     (**r [rd = r1 * r2] *)
+  | Omulimm: int -> operation           (**r [rd = r1 * n] *)
+  | Odiv: operation                     (**r [rd = r1 / r2] (signed) *)
+  | Odivu: operation                    (**r [rd = r1 / r2] (unsigned) *)
+  | Omod: operation                     (**r [rd = r1 % r2] (signed) *)
+  | Omodu: operation                    (**r [rd = r1 % r2] (unsigned) *)
+  | Oand: operation                     (**r [rd = r1 & r2] *)
+  | Oandimm: int -> operation           (**r [rd = r1 & n] *)
+  | Oor: operation                      (**r [rd = r1 | r2] *)
+  | Oorimm: int -> operation            (**r [rd = r1 | n] *)
+  | Oxor: operation                     (**r [rd = r1 ^ r2] *)
+  | Oxorimm: int -> operation           (**r [rd = r1 ^ n] *)
+  | Oshl: operation                     (**r [rd = r1 << r2] *)
+  | Oshlimm: int -> operation           (**r [rd = r1 << n] *)
+  | Oshr: operation                     (**r [rd = r1 >> r2] (signed) *)
+  | Oshrimm: int -> operation           (**r [rd = r1 >> n] (signed) *)
+  | Oshrximm: int -> operation          (**r [rd = r1 / 2^n] (signed) *)
+  | Oshru: operation                    (**r [rd = r1 >> r2] (unsigned) *)
+  | Oshruimm: int -> operation          (**r [rd = r1 >> n] (unsigned) *)
+  | Ororimm: int -> operation           (**r rotate right immediate *)
+  | Olea: addressing -> operation       (**r effective address *)
+(*c Floating-point arithmetic: *)
+  | Onegf: operation                    (**r [rd = - r1] *)
+  | Oabsf: operation                    (**r [rd = abs(r1)] *)
+  | Oaddf: operation                    (**r [rd = r1 + r2] *)
+  | Osubf: operation                    (**r [rd = r1 - r2] *)
+  | Omulf: operation                    (**r [rd = r1 * r2] *)
+  | Odivf: operation                    (**r [rd = r1 / r2] *)
+  | Osingleoffloat: operation           (**r [rd] is [r1] truncated to single-precision float *)
+(*c Conversions between int and float: *)
+  | Ointoffloat: operation              (**r [rd = signed_int_of_float(r1)] *)
+  | Ofloatofint: operation              (**r [rd = float_of_signed_int(r1)] *)
+(*c Boolean tests: *)
+  | Ocmp: condition -> operation.       (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
+
+(** Derived operators. *)
+
+Definition Oaddrsymbol (id: ident) (ofs: int) : operation := Olea (Aglobal id ofs).
+Definition Oaddimm (n: int) : operation := Olea (Aindexed n).
+
+(** Comparison functions (used in module [CSE]). *)
+
+Definition eq_addressing (x y: addressing) : {x=y} + {x<>y}.
+Proof.
+  generalize Int.eq_dec; intro.
+  assert (forall (x y: ident), {x=y}+{x<>y}). exact peq.
+  decide equality.
+Qed.
+
+Definition eq_operation (x y: operation): {x=y} + {x<>y}.
+Proof.
+  generalize Int.eq_dec; intro.
+  generalize Float.eq_dec; intro.
+  assert (forall (x y: ident), {x=y}+{x<>y}). exact peq.
+  assert (forall (x y: comparison), {x=y}+{x<>y}). decide equality.
+  assert (forall (x y: condition), {x=y}+{x<>y}). decide equality.
+  decide equality.
+  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. *)
+
+Definition eval_compare_mismatch (c: comparison) : option bool :=
+  match c with Ceq => Some false | Cne => Some true | _ => None end.
+
+Definition eval_compare_null (c: comparison) (n: int) : option bool :=
+  if Int.eq n Int.zero then eval_compare_mismatch c else None.
+
+Definition eval_condition (cond: condition) (vl: list val):
+               option bool :=
+  match cond, vl with
+  | Ccomp c, Vint n1 :: Vint n2 :: nil =>
+      Some (Int.cmp c n1 n2)
+  | Ccomp c, Vptr b1 n1 :: Vptr b2 n2 :: nil =>
+      if eq_block b1 b2
+      then Some (Int.cmp c n1 n2)
+      else eval_compare_mismatch c
+  | Ccomp c, Vptr b1 n1 :: Vint n2 :: nil =>
+      eval_compare_null c n2
+  | Ccomp c, Vint n1 :: Vptr b2 n2 :: nil =>
+      eval_compare_null c n1
+  | Ccompu c, Vint n1 :: Vint n2 :: nil =>
+      Some (Int.cmpu c n1 n2)
+  | Ccompimm c n, Vint n1 :: nil =>
+      Some (Int.cmp c n1 n)
+  | Ccompimm c n, Vptr b1 n1 :: nil =>
+      eval_compare_null c n
+  | Ccompuimm c n, Vint n1 :: nil =>
+      Some (Int.cmpu c n1 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
+  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)))
+  | 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
+  | Ainstack ofs, nil =>
+      offset_sp sp ofs
+  | _, _ => None
+  end.
+
+Definition eval_operation
+    (F V: Type) (genv: Genv.t F V) (sp: val)
+    (op: operation) (vl: list val): option val :=
+  match op, vl with
+  | Omove, v1::nil => Some v1
+  | Ointconst n, nil => Some (Vint n)
+  | Ofloatconst n, nil => Some (Vfloat n)
+  | Ocast8signed, v1 :: nil => Some (Val.sign_ext 8 v1)
+  | 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 => 
+      Some (Vint (Float.intoffloat f1))
+  | Ofloatofint, Vint n1 :: nil => 
+      Some (Vfloat (Float.floatofint n1))
+  | Ocmp c, _ =>
+      match eval_condition c vl with
+      | None => None
+      | Some false => Some Vfalse
+      | Some true => Some Vtrue
+      end
+  | _, _ => 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 _) |- _ =>
+      destruct x; simpl in H; try discriminate; FuncInv
+  | H: (match ?v with Vundef => _ | Vint _ => _ | Vfloat _ => _ | Vptr _ _ => _ end = Some _) |- _ =>
+      destruct v; simpl in H; try discriminate; FuncInv
+  | H: (Some _ = Some _) |- _ =>
+      injection H; intros; clear H; 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),
+  eval_condition cond vl = Some b ->
+  eval_condition (negate_condition cond) vl = Some (negb b).
+Proof.
+  intros. 
+  destruct cond; simpl in H; FuncInv; try subst b; simpl.
+  rewrite Int.negate_cmp. auto.
+  apply eval_negate_compare_null; auto.
+  apply eval_negate_compare_null; auto.
+  destruct (eq_block b0 b1). rewrite Int.negate_cmp. congruence.
+  apply eval_negate_compare_mismatch; auto. 
+  rewrite Int.negate_cmpu. auto.
+  rewrite Int.negate_cmp. auto.
+  apply eval_negate_compare_null; auto.
+  rewrite Int.negate_cmpu. 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,
+  eval_operation ge2 sp op vl = eval_operation ge1 sp op vl.
+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. *)
+
+Definition type_of_condition (c: condition) : list typ :=
+  match c with
+  | Ccomp _ => Tint :: Tint :: nil
+  | Ccompu _ => Tint :: Tint :: nil
+  | Ccompimm _ _ => Tint :: nil
+  | Ccompuimm _ _ => Tint :: nil
+  | Ccompf _ => Tfloat :: Tfloat :: nil
+  | Cnotcompf _ => Tfloat :: Tfloat :: nil
+  | Cmaskzero _ => Tint :: nil
+  | Cmasknotzero _ => Tint :: nil
+  end.
+
+Definition type_of_addressing (addr: addressing) : list typ :=
+  match addr with
+  | Aindexed _ => Tint :: nil
+  | Aindexed2 _ => Tint :: Tint :: nil
+  | Ascaled _ _ => Tint :: nil
+  | Aindexed2scaled _ _ => Tint :: Tint :: nil
+  | Aglobal _ _ => nil
+  | Abased _ _ => Tint :: nil
+  | Abasedscaled _ _ _ => Tint :: nil
+  | Ainstack _ => nil
+  end.
+
+Definition type_of_operation (op: operation) : list typ * typ :=
+  match op with
+  | Omove => (nil, Tint)   (* treated specially *)
+  | Ointconst _ => (nil, Tint)
+  | Ofloatconst _ => (nil, Tfloat)
+  | Ocast8signed => (Tint :: nil, Tint)
+  | Ocast8unsigned => (Tint :: nil, Tint)
+  | Ocast16signed => (Tint :: nil, Tint)
+  | Ocast16unsigned => (Tint :: nil, Tint)
+  | Oneg => (Tint :: nil, Tint)
+  | Osub => (Tint :: Tint :: nil, Tint)
+  | Omul => (Tint :: Tint :: nil, Tint)
+  | Omulimm _ => (Tint :: nil, Tint)
+  | Odiv => (Tint :: Tint :: nil, Tint)
+  | Odivu => (Tint :: Tint :: nil, Tint)
+  | Omod => (Tint :: Tint :: nil, Tint)
+  | Omodu => (Tint :: Tint :: nil, Tint)
+  | Oand => (Tint :: Tint :: nil, Tint)
+  | Oandimm _ => (Tint :: nil, Tint)
+  | Oor => (Tint :: Tint :: nil, Tint)
+  | Oorimm _ => (Tint :: nil, Tint)
+  | Oxor => (Tint :: Tint :: nil, Tint)
+  | Oxorimm _ => (Tint :: nil, Tint)
+  | Oshl => (Tint :: Tint :: nil, Tint)
+  | Oshlimm _ => (Tint :: nil, Tint)
+  | Oshr => (Tint :: Tint :: nil, Tint)
+  | Oshrimm _ => (Tint :: nil, Tint)
+  | Oshrximm _ => (Tint :: nil, Tint)
+  | Oshru => (Tint :: Tint :: nil, Tint)
+  | Oshruimm _ => (Tint :: nil, Tint)
+  | Ororimm _ => (Tint :: nil, Tint)
+  | Olea addr => (type_of_addressing addr, Tint)
+  | Onegf => (Tfloat :: nil, Tfloat)
+  | Oabsf => (Tfloat :: nil, Tfloat)
+  | Oaddf => (Tfloat :: Tfloat :: nil, Tfloat)
+  | Osubf => (Tfloat :: Tfloat :: nil, Tfloat)
+  | Omulf => (Tfloat :: Tfloat :: nil, Tfloat)
+  | Odivf => (Tfloat :: Tfloat :: nil, Tfloat)
+  | Osingleoffloat => (Tfloat :: nil, Tfloat)
+  | Ointoffloat => (Tfloat :: nil, Tint)
+  | Ofloatofint => (Tint :: nil, Tfloat)
+  | Ocmp c => (type_of_condition c, Tint)
+  end.
+
+(** Weak type soundness results for [eval_operation]:
+  the result values, when defined, are always of the type predicted
+  by [type_of_operation]. *)
+
+Section SOUNDNESS.
+
+Variable A V: Type.
+Variable genv: Genv.t A V.
+
+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.
+Qed.
+
+Lemma type_of_operation_sound:
+  forall op vl sp v,
+  op <> Omove ->
+  eval_operation genv sp op vl = Some v ->
+  Val.has_type v (snd (type_of_operation op)).
+Proof.
+  intros.
+  destruct op; simpl in H0; FuncInv; try subst v; try exact I.
+  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 (eval_condition c vl). 
+  destruct b; injection H0; intro; subst v; exact I.
+  discriminate.
+Qed.
+
+Lemma type_of_chunk_correct:
+  forall chunk m addr v,
+  Mem.loadv chunk m addr = Some v ->
+  Val.has_type v (type_of_chunk chunk).
+Proof.
+  intro chunk.
+  assert (forall v, Val.has_type (Val.load_result chunk v) (type_of_chunk chunk)).
+  destruct v; destruct chunk; exact I.
+  intros until v. unfold Mem.loadv. 
+  destruct addr; intros; try discriminate.
+  eapply Mem.load_type; eauto.
+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 [PPCgen]. *)
+
+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.
+
+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
+  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,
+  eval_condition c vl = 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).
+  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,
+  eval_operation genv sp op vl = 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.
+  caseEq (eval_condition c vl); 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).
+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.
+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,
+  Val.lessdef_list vl1 vl2 ->
+  eval_condition cond vl1 = Some b ->
+  eval_condition cond vl2 = Some b.
+Proof.
+  intros. destruct cond; simpl in *; FuncInv; InvLessdef; auto.
+Qed.
+
+Ltac TrivialExists :=
+  match goal with
+  | [ |- exists v2, Some ?v1 = Some v2 /\ Val.lessdef ?v1 v2 ] =>
+      exists v1; split; [auto | constructor]
+  | _ => idtac
+  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,
+  Val.lessdef_list vl1 vl2 ->
+  eval_operation genv sp op vl1 = Some v1 ->
+  exists v2, eval_operation genv sp op vl2 = Some v2 /\ Val.lessdef v1 v2.
+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 H0. TrivialExists.
+  destruct (Int.eq i0 Int.zero); inv H0; TrivialExists.
+  destruct (Int.eq i0 Int.zero); inv H0; TrivialExists.
+  destruct (Int.eq i0 Int.zero); inv H0; TrivialExists.
+  destruct (Int.eq i0 Int.zero); inv H0; TrivialExists.
+  destruct (Int.ltu i0 Int.iwordsize); inv H0; TrivialExists.
+  destruct (Int.ltu i Int.iwordsize); inv H0; TrivialExists.
+  destruct (Int.ltu i0 Int.iwordsize); inv H0; TrivialExists.
+  destruct (Int.ltu i Int.iwordsize); inv H0; TrivialExists.
+  destruct (Int.ltu i (Int.repr 31)); inv H0; TrivialExists.
+  destruct (Int.ltu i0 Int.iwordsize); inv H0; TrivialExists.
+  destruct (Int.ltu i Int.iwordsize); inv H0; TrivialExists.
+  destruct (Int.ltu i Int.iwordsize); inv H0; TrivialExists.
+  eapply eval_addressing_lessdef; eauto.
+  exists (Val.singleoffloat v2); split. auto. apply Val.singleoffloat_lessdef; auto.
+  caseEq (eval_condition c vl1); intros. rewrite H1 in H0. 
+  rewrite (eval_condition_lessdef c H H1).
+  destruct b; inv H0; TrivialExists.
+  rewrite H1 in H0. discriminate.
+Qed.
+
+End EVAL_LESSDEF.
+
+(** 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
+  it runs out of temporary registers. *)
+
+Definition op_for_binary_addressing (addr: addressing) : operation := Olea addr.
+
+Lemma eval_op_for_binary_addressing:
+  forall (F V: Type) (ge: Genv.t F V) sp addr args v,
+  (length args >= 2)%nat ->
+  eval_addressing ge sp addr args = Some v ->
+  eval_operation ge sp (op_for_binary_addressing addr) args = Some v.
+Proof.
+  intros. simpl. auto.
+Qed.
+
+Lemma type_op_for_binary_addressing:
+  forall addr,
+  (length (type_of_addressing addr) >= 2)%nat ->
+  type_of_operation (op_for_binary_addressing addr) = (type_of_addressing addr, Tint).
+Proof.
+  intros. simpl. auto.
+Qed.
+
+(** Two-address operations.  Return [true] if the first argument and
+  the result must be in the same location. *)
+
+Definition two_address_op (op: operation) : bool :=
+  match op with
+  | Omove => false
+  | Ointconst _ => false
+  | Ofloatconst _ => false
+  | Ocast8signed => false
+  | Ocast8unsigned => false
+  | Ocast16signed => false
+  | Ocast16unsigned => false
+  | Oneg => true
+  | Osub => true
+  | Omul => true
+  | Omulimm _ => true
+  | Odiv => true
+  | Odivu => true
+  | Omod => true
+  | Omodu => true
+  | Oand => true
+  | Oandimm _ => true
+  | Oor => true
+  | Oorimm _ => true
+  | Oxor => true
+  | Oxorimm _ => true
+  | Oshl => true
+  | Oshlimm _ => true
+  | Oshr => true
+  | Oshrimm _ => true
+  | Oshrximm _ => true
+  | Oshru => true
+  | Oshruimm _ => true
+  | Ororimm _ => true
+  | Olea addr => false
+  | Onegf => true
+  | Oabsf => true
+  | Oaddf => true
+  | Osubf => true
+  | Omulf => true
+  | Odivf => true
+  | Osingleoffloat => false
+  | Ointoffloat => false
+  | Ofloatofint => false
+  | Ocmp c => false
+  end.
+
+(** Operations that are so cheap to recompute that CSE should not factor them out. *)
+
+Definition is_trivial_op (op: operation) : bool :=
+  match op with
+  | Omove => true
+  | Ointconst _ => true
+  | Olea (Aglobal _ _) => true
+  | Olea (Ainstack _) => true
+  | _ => false
+  end.
+
+(** Shifting stack-relative references.  This is used in [Stacking]. *)
+
+Definition shift_stack_addressing (delta: int) (addr: addressing) :=
+  match addr with
+  | Ainstack ofs => Ainstack (Int.add delta ofs)
+  | _ => addr
+  end.
+
+Definition shift_stack_operation (delta: int) (op: operation) :=
+  match op with
+  | Olea addr => Olea (shift_stack_addressing delta addr)
+  | _ => op
+  end.
+
+Lemma shift_stack_eval_addressing:
+  forall (F V: Type) (ge: Genv.t F V) sp addr args delta,
+  eval_addressing ge (Val.sub sp (Vint delta)) (shift_stack_addressing delta addr) args =
+  eval_addressing ge sp addr args.
+Proof.
+  intros. destruct addr; simpl; auto. 
+  destruct args; auto. unfold offset_sp. destruct sp; simpl; auto. 
+  decEq. decEq. rewrite <- Int.add_assoc. decEq. 
+  rewrite Int.sub_add_opp. rewrite Int.add_assoc.
+  rewrite (Int.add_commut (Int.neg delta)). rewrite <- Int.sub_add_opp. 
+  rewrite Int.sub_idem. apply Int.add_zero. 
+Qed.
+
+Lemma shift_stack_eval_operation:
+  forall (F V: Type) (ge: Genv.t F V) sp op args delta,
+  eval_operation ge (Val.sub sp (Vint delta)) (shift_stack_operation delta op) args =
+  eval_operation ge sp op args.
+Proof.
+  intros. destruct op; simpl; auto.
+  apply shift_stack_eval_addressing. 
+Qed.
+
+Lemma type_shift_stack_addressing:
+  forall delta addr, type_of_addressing (shift_stack_addressing delta addr) = type_of_addressing addr.
+Proof.
+  intros. destruct addr; auto. 
+Qed.
+
+Lemma type_shift_stack_operation:
+  forall delta op, type_of_operation (shift_stack_operation delta op) = type_of_operation op.
+Proof.
+  intros. destruct op; auto. simpl. decEq. apply type_shift_stack_addressing. 
+Qed.
+
+
+
diff --git a/ia32/PrintAsm.ml b/ia32/PrintAsm.ml
new file mode 100644
index 0000000..e75032c
--- /dev/null
+++ b/ia32/PrintAsm.ml
@@ -0,0 +1,625 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Printing IA32 assembly code in asm syntax *)
+
+open Printf
+open Datatypes
+open Camlcoq
+open AST
+open Asm
+
+(* Recognition of target ABI and asm syntax *)
+
+type target = ELF | AOUT | MacOS
+
+let target = 
+  match Configuration.system with
+  | "macosx" -> MacOS
+  | "linux"  -> ELF
+  | "bsd"    -> ELF
+  | "cygwin" -> AOUT
+  | _        -> invalid_arg ("System " ^ Configuration.system ^ " not supported")
+
+(* On-the-fly label renaming *)
+
+let next_label = ref 100
+
+let new_label() =
+  let lbl = !next_label in incr next_label; lbl
+
+let current_function_labels = (Hashtbl.create 39 : (label, int) Hashtbl.t)
+
+let transl_label lbl =
+  try
+    Hashtbl.find current_function_labels lbl
+  with Not_found ->
+    let lbl' = new_label() in
+    Hashtbl.add current_function_labels lbl lbl';
+    lbl'
+
+(* Basic printing functions *)
+
+let coqint oc n =
+  fprintf oc "%ld" (camlint_of_coqint n)
+
+let raw_symbol oc s =
+  match target with
+  | ELF -> fprintf oc "%s" s
+  | MacOS | AOUT -> fprintf oc "_%s" s
+
+let re_variadic_stub = Str.regexp "\\(.*\\)\\$[if]*$"
+
+let symbol oc symb =
+  let s = extern_atom symb in
+  if Str.string_match re_variadic_stub s 0
+  then raw_symbol oc (Str.matched_group 1 s)
+  else raw_symbol oc s
+
+let symbol_offset oc (symb, ofs) =
+  symbol oc symb;
+  if ofs <> 0l then fprintf oc " + %ld" ofs
+
+let label oc lbl =
+  match target with
+  | ELF -> fprintf oc ".L%d" lbl
+  | MacOS | AOUT -> fprintf oc "L%d" lbl
+
+let comment = "#"
+
+let int_reg_name = function
+  | EAX -> "%eax"  | EBX -> "%ebx"  | ECX -> "%ecx"  | EDX -> "%edx"
+  | ESI -> "%esi"  | EDI -> "%edi"  | EBP -> "%ebp"  | ESP -> "%esp"
+
+let int8_reg_name = function
+  | EAX -> "%al"  | EBX -> "%bl"  | ECX -> "%cl"  | EDX -> "%dl"
+  | _ -> assert false
+
+let int16_reg_name = function
+  | EAX -> "%ax"  | EBX -> "%bx"  | ECX -> "%cx"  | EDX -> "%dx"
+  | _ -> assert false
+
+let float_reg_name = function
+  | XMM0 -> "%xmm0"  | XMM1 -> "%xmm1"  | XMM2 -> "%xmm2"  | XMM3 -> "%xmm3"
+  | XMM4 -> "%xmm4"  | XMM5 -> "%xmm5"  | XMM6 -> "%xmm6"  | XMM7 -> "%xmm7"
+
+let ireg oc r = output_string oc (int_reg_name r)
+let ireg8 oc r = output_string oc (int8_reg_name r)
+let ireg16 oc r = output_string oc (int16_reg_name r)
+let freg oc r = output_string oc (float_reg_name r)
+
+let addressing oc (Addrmode(base, shift, cst)) =
+  begin match cst with
+  | Coq_inl n ->
+      let n = camlint_of_coqint n in
+      fprintf oc "%ld" n
+  | Coq_inr(Coq_pair(id, ofs)) -> 
+      let ofs = camlint_of_coqint ofs in
+      if ofs = 0l
+      then symbol oc id
+      else fprintf oc "(%a + %ld)" symbol id ofs
+  end;
+  begin match base, shift with
+  | None, None -> ()
+  | Some r1, None -> fprintf oc "(%a)" ireg r1
+  | None, Some(Coq_pair(r2,sc)) -> fprintf oc "(,%a,%a)" ireg r2 coqint sc
+  | Some r1, Some(Coq_pair(r2,sc)) -> fprintf oc "(%a,%a,%a)" ireg r1 ireg r2 coqint sc
+  end
+
+let name_of_condition = function
+  | Cond_e -> "e" | Cond_ne -> "ne"
+  | Cond_b -> "b" | Cond_be -> "be" | Cond_ae -> "ae" | Cond_a -> "a"
+  | Cond_l -> "l" | Cond_le -> "le" | Cond_ge -> "ge" | Cond_g -> "g"
+  | Cond_p -> "p" | Cond_np -> "np" 
+  | Cond_nep | Cond_enp -> assert false (* treated specially *)
+
+let section oc name =
+  fprintf oc "	%s\n" name
+
+(* Names of sections *)
+
+let (text, data, const_data, float_literal, jumptable_literal) =
+  match target with
+  | ELF ->
+      (".text",
+       ".data",
+       ".section	.rodata",
+       ".section	.rodata.cst8,\"a\",@progbits",
+       ".text")
+  | MacOS ->
+      (".text",
+       ".data",
+       ".const",
+       ".const_data",
+       ".text")
+  | AOUT ->
+      (".text",
+       ".data",
+       ".section	.rdata,\"dr\"",
+       ".section	.rdata,\"dr\"",
+       ".text")
+
+(* SP adjustment to allocate or free a stack frame *)
+
+let stack_alignment =
+  match target with
+  | ELF | AOUT -> 8               (* minimum is 4, 8 is better for perfs *)
+  | MacOS -> 16                   (* mandatory *)
+
+let int32_align n a =
+  if n >= 0l
+  then Int32.logand (Int32.add n (Int32.of_int (a-1))) (Int32.of_int (-a))
+  else Int32.logand n (Int32.of_int (-a))
+
+let sp_adjustment lo hi =
+  let lo = camlint_of_coqint lo and hi = camlint_of_coqint hi in
+  let sz = Int32.sub hi lo in
+(* Enforce stack alignment, noting that 4 bytes are already allocated
+   by the call *)
+  let sz = Int32.sub (int32_align (Int32.add sz 4l) stack_alignment) 4l in
+  assert (sz >= 0l);
+  sz
+
+(* Base-2 log of a Caml integer *)
+
+let rec log2 n =
+  assert (n > 0);
+  if n = 1 then 0 else 1 + log2 (n lsr 1)
+
+(* Emit a align directive *)
+
+let print_align oc n =
+  match target with
+  | ELF          -> fprintf oc "	.align	%d\n" n
+  | AOUT | MacOS -> fprintf oc "	.align	%d\n" (log2 n)
+
+let need_masks = ref false
+
+(* Built-in functions *)
+
+(* Built-ins.  They come in two flavors: 
+   - inlined by the compiler: take their arguments in arbitrary
+     registers; preserve all registers except ECX, EDX, XMM6 and XMM7
+   - inlined while printing asm code; take their arguments in
+     locations dictated by the calling conventions; preserve
+     callee-save regs only. *)
+
+let print_builtin_inlined oc name args res =
+  fprintf oc "%s begin builtin %s\n" comment name;
+  begin match name, args, res with
+  (* Volatile reads *)
+  | "__builtin_volatile_read_int8unsigned", [IR addr], IR res ->
+      fprintf oc "	movzbl	0(%a), %a\n" ireg addr ireg res
+  | "__builtin_volatile_read_int8signed", [IR addr], IR res ->
+      fprintf oc "	movsbl	0(%a), %a\n" ireg addr ireg res
+  | "__builtin_volatile_read_int16unsigned", [IR addr], IR res ->
+      fprintf oc "	movzwl	0(%a), %a\n" ireg addr ireg res
+  | "__builtin_volatile_read_int16signed", [IR addr], IR res ->
+      fprintf oc "	movswl	0(%a), %a\n" ireg addr ireg res
+  | ("__builtin_volatile_read_int32"|"__builtin_volatile_read_pointer"), [IR addr], IR res ->
+      fprintf oc "	movl	0(%a), %a\n" ireg addr ireg res
+  | "__builtin_volatile_read_float32", [IR addr], FR res ->
+      fprintf oc "	cvtss2sd 0(%a), %a\n" ireg addr freg res
+  | "__builtin_volatile_read_float64", [IR addr], FR res ->
+      fprintf oc "	movsd	0(%a), %a\n" ireg addr freg res
+  (* Volatile writes *)
+  | ("__builtin_volatile_write_int8unsigned"|"__builtin_volatile_write_int8signed"), [IR addr; IR src], _ ->
+      if Asmgen.low_ireg src then
+        fprintf oc "	movb	%a, 0(%a)\n" ireg8 src ireg addr
+      else begin
+        fprintf oc "	movl	%a, %%ecx\n" ireg src;
+        fprintf oc "	movb	%%cl, 0(%a)\n" ireg addr
+      end
+  | ("__builtin_volatile_write_int16unsigned"|"__builtin_volatile_write_int16signed"), [IR addr; IR src], _ ->
+      if Asmgen.low_ireg src then
+        fprintf oc "	movw	%a, 0(%a)\n" ireg16 src ireg addr
+      else begin
+        fprintf oc "	movl	%a, %%ecx\n" ireg src;
+        fprintf oc "	movw	%%cx, 0(%a)\n" ireg addr
+      end
+  | ("__builtin_volatile_write_int32"|"__builtin_volatile_write_pointer"), [IR addr; IR src], _ ->
+      fprintf oc "	movl	%a, 0(%a)\n" ireg src ireg addr
+  | "__builtin_volatile_write_float32", [IR addr; FR src], _ ->
+      fprintf oc "	cvtsd2ss %a, %%xmm7\n" freg src;
+      fprintf oc "	movss	%%xmm7, 0(%a)\n" ireg addr
+  | "__builtin_volatile_write_float64", [IR addr; FR src], _ ->
+      fprintf oc "	movsd	%a, 0(%a)\n" freg src ireg addr
+  (* Float arithmetic *)
+  | "__builtin_fabs", [FR a1], FR res ->
+      need_masks := true;
+      if a1 <> res then
+        fprintf oc "	movsd	%a, %a\n" freg a1 freg res;
+      fprintf oc "	andpd	%a, %a\n" raw_symbol "__absd_mask" freg res
+  | "__builtin_fsqrt", [FR a1], FR res ->
+      fprintf oc "	sqrtsd	%a, %a\n" freg a1 freg res
+  (* Also: fmax, fmin *)
+  | _ ->
+      invalid_arg ("unrecognized builtin " ^ name)
+  end;
+  fprintf oc "%s end builtin %s\n" comment name
+
+let re_builtin_function = Str.regexp "__builtin_"
+
+let is_builtin_function s =
+  Str.string_match re_builtin_function (extern_atom s) 0
+
+let print_builtin_function oc s =
+  fprintf oc "%s begin builtin function %s\n" comment (extern_atom s);
+  (* arguments: on stack, starting at offset 0 *)
+  (* result: EAX or ST0 *)
+  begin match extern_atom s with
+  (* Block copy *)
+  | "__builtin_memcpy" ->
+      fprintf oc "	movl	%%esi, %%eax\n";
+      fprintf oc "	movl	%%edi, %%edx\n";
+      fprintf oc "	movl	0(%%esp), %%edi\n";
+      fprintf oc "	movl	4(%%esp), %%esi\n";
+      fprintf oc "	movl	8(%%esp), %%ecx\n";
+      fprintf oc "	rep movsb\n";
+      fprintf oc "	movl	%%eax, %%esi\n";
+      fprintf oc "	movl	%%edx, %%edi\n"
+  | "__builtin_memcpy_words" ->
+      fprintf oc "	movl	%%esi, %%eax\n";
+      fprintf oc "	movl	%%edi, %%edx\n";
+      fprintf oc "	movl	0(%%esp), %%edi\n";
+      fprintf oc "	movl	4(%%esp), %%esi\n";
+      fprintf oc "	movl	8(%%esp), %%ecx\n";
+      fprintf oc "	shr	$2, %%ecx\n";
+      fprintf oc "	rep movsl\n";
+      fprintf oc "	movl	%%eax, %%esi\n";
+      fprintf oc "	movl	%%edx, %%edi\n"
+  (* Catch-all *)
+  | s ->
+      invalid_arg ("unrecognized builtin function " ^ s)
+  end;
+  fprintf oc "%s end builtin function %s\n" comment (extern_atom s)
+
+(* Printing of instructions *)
+
+module Labelset = Set.Make(struct type t = label let compare = compare end)
+
+let float_literals : (int * int64) list ref = ref []
+let jumptables : (int * label list) list ref = ref []
+
+(* Reminder on AT&T syntax: op source, dest *)
+
+let print_instruction oc labels = function
+  (* Moves *)
+  | Pmov_rr(rd, r1) ->
+      fprintf oc "	movl	%a, %a\n" ireg r1 ireg rd
+  | Pmov_ri(rd, n) ->
+      let n = camlint_of_coqint n in
+      if n = 0l then
+        fprintf oc "	xorl	%a, %a\n" ireg rd ireg rd
+      else
+        fprintf oc "	movl	$%ld, %a\n" n ireg rd
+  | Pmov_rm(rd, a) ->
+      fprintf oc "	movl	%a, %a\n" addressing a ireg rd
+  | Pmov_mr(a, r1) ->
+      fprintf oc "	movl	%a, %a\n" ireg r1 addressing a
+  | Pmovd_fr(rd, r1) ->
+      fprintf oc "	movd	%a, %a\n" ireg r1 freg rd
+  | Pmovd_rf(rd, r1) ->
+      fprintf oc "	movd	%a, %a\n" freg r1 ireg rd
+  | Pmovsd_ff(rd, r1) ->
+      fprintf oc "	movsd	%a, %a\n" freg r1 freg rd
+  | Pmovsd_fi(rd, n) ->
+      let b = Int64.bits_of_float n in
+      if b = 0L then (* +0.0 *)
+        fprintf oc "	xorpd	%a, %a %s +0.0\n" freg rd freg rd comment
+      else begin
+        let lbl = new_label() in
+        fprintf oc "	movsd	%a, %a %s %.18g\n" label lbl freg rd comment n;
+        float_literals := (lbl, b) :: !float_literals
+      end
+  | Pmovsd_fm(rd, a) ->
+      fprintf oc "	movsd	%a, %a\n" addressing a freg rd
+  | Pmovsd_mf(a, r1) ->
+      fprintf oc "	movsd	%a, %a\n" freg r1 addressing a
+  | Pfld_f(r1) ->
+      fprintf oc "	subl	$8, %%esp\n";
+      fprintf oc "	movsd	%a, 0(%%esp)\n" freg r1;
+      fprintf oc "	fldl	0(%%esp)\n";
+      fprintf oc "	addl	$8, %%esp\n"
+  | Pfld_m(a) ->
+      fprintf oc "	fldl	%a\n" addressing a
+  | Pfstp_f(rd) ->
+      fprintf oc "	subl	$8, %%esp\n";
+      fprintf oc "	fstpl	0(%%esp)\n";
+      fprintf oc "	movsd	0(%%esp), %a\n" freg rd;
+      fprintf oc "	addl	$8, %%esp\n"
+  | Pfstp_m(a) ->
+      fprintf oc "	fstpl	%a\n" addressing a
+  (** Moves with conversion *)
+  | Pmovb_mr(a, r1) ->
+      fprintf oc "	movb	%a, %a\n" ireg8 r1 addressing a
+  | Pmovw_mr(a, r1) ->
+      fprintf oc "	movw	%a, %a\n" ireg16 r1 addressing a
+  | Pmovzb_rr(rd, r1) ->
+      fprintf oc "	movzbl	%a, %a\n" ireg8 r1 ireg rd
+  | Pmovzb_rm(rd, a) ->
+      fprintf oc "	movzbl	%a, %a\n" addressing a ireg rd
+  | Pmovsb_rr(rd, r1) ->
+      fprintf oc "	movsbl	%a, %a\n" ireg8 r1 ireg rd
+  | Pmovsb_rm(rd, a) ->
+      fprintf oc "	movsbl	%a, %a\n" addressing a ireg rd
+  | Pmovzw_rr(rd, r1) ->
+      fprintf oc "	movzwl	%a, %a\n" ireg16 r1 ireg rd
+  | Pmovzw_rm(rd, a) ->
+      fprintf oc "	movzwl	%a, %a\n" addressing a ireg rd
+  | Pmovsw_rr(rd, r1) ->
+      fprintf oc "	movswl	%a, %a\n" ireg16 r1 ireg rd
+  | Pmovsw_rm(rd, a) ->
+      fprintf oc "	movswl	%a, %a\n" addressing a ireg rd
+  | Pcvtss2sd_fm(rd, a) ->
+      fprintf oc "	cvtss2sd %a, %a\n" addressing a freg rd
+  | Pcvtsd2ss_ff(rd, r1) ->
+      fprintf oc "	cvtsd2ss %a, %a\n" freg r1 freg rd;
+      fprintf oc "	cvtss2sd %a, %a\n" freg rd freg rd
+  | Pcvtsd2ss_mf(a, r1) ->
+      fprintf oc "	cvtsd2ss %a, %%xmm7\n" freg r1;
+      fprintf oc "	movss	%%xmm7, %a\n" addressing a
+  | Pcvttsd2si_rf(rd, r1) ->
+      fprintf oc "	cvttsd2si %a, %a\n" freg r1 ireg rd
+  | Pcvtsi2sd_fr(rd, r1) ->
+      fprintf oc "	cvtsi2sd %a, %a\n" ireg r1 freg rd
+  (** Arithmetic and logical operations over integers *)
+  | Plea(rd, a) ->
+      fprintf oc "	leal	%a, %a\n" addressing a ireg rd
+  | Pneg(rd) ->
+      fprintf oc "	negl	%a\n" ireg rd
+  | Psub_rr(rd, r1) ->
+      fprintf oc "	subl	%a, %a\n" ireg r1 ireg rd
+  | Pimul_rr(rd, r1) ->
+      fprintf oc "	imull	%a, %a\n" ireg r1 ireg rd
+  | Pimul_ri(rd, n) ->
+      fprintf oc "	imull	$%a, %a\n" coqint n ireg rd
+  | Pdiv(r1) ->
+      fprintf oc "	xorl	%%edx, %%edx\n";
+      fprintf oc "	divl	%a\n" ireg r1
+  | Pidiv(r1) ->
+      fprintf oc "	cltd\n";
+      fprintf oc "	idivl	%a\n" ireg r1
+  | Pand_rr(rd, r1) ->
+      fprintf oc "	andl	%a, %a\n" ireg r1 ireg rd
+  | Pand_ri(rd, n) ->
+      fprintf oc "	andl	$%a, %a\n" coqint n ireg rd
+  | Por_rr(rd, r1) ->
+      fprintf oc "	orl	%a, %a\n" ireg r1 ireg rd
+  | Por_ri(rd, n) ->
+      fprintf oc "	orl	$%a, %a\n" coqint n ireg rd
+  | Pxor_rr(rd, r1) ->
+      fprintf oc "	xorl	%a, %a\n" ireg r1 ireg rd
+  | Pxor_ri(rd, n) ->
+      fprintf oc "	xorl	$%a, %a\n" coqint n ireg rd
+  | Psal_rcl(rd) ->
+      fprintf oc "	sall	%%cl, %a\n" ireg rd
+  | Psal_ri(rd, n) ->
+      fprintf oc "	sall	$%a, %a\n" coqint n ireg rd
+  | Pshr_rcl(rd) ->
+      fprintf oc "	shrl	%%cl, %a\n" ireg rd
+  | Pshr_ri(rd, n) ->
+      fprintf oc "	shrl	$%a, %a\n" coqint n ireg rd
+  | Psar_rcl(rd) ->
+      fprintf oc "	sarl	%%cl, %a\n" ireg rd
+  | Psar_ri(rd, n) ->
+      fprintf oc "	sarl	$%a, %a\n" coqint n ireg rd
+  | Pror_ri(rd, n) ->
+      fprintf oc "	rorl	$%a, %a\n" coqint n ireg rd
+  | Pcmp_rr(r1, r2) ->
+      fprintf oc "	cmpl	%a, %a\n" ireg r2 ireg r1
+  | Pcmp_ri(r1, n) ->
+      fprintf oc "	cmpl	$%a, %a\n" coqint n ireg r1
+  | Ptest_rr(r1, r2) ->
+      fprintf oc "	testl	%a, %a\n" ireg r2 ireg r1
+  | Ptest_ri(r1, n) ->
+      fprintf oc "	testl	$%a, %a\n" coqint n ireg r1
+  | Pcmov(c, rd, r1) ->
+      assert (c <> Cond_nep && c <> Cond_enp);
+      fprintf oc "	cmov%s	%a, %a\n" (name_of_condition c) ireg r1 ireg rd
+  | Psetcc(c, rd) ->
+      begin match c with
+      | Cond_nep ->
+          fprintf oc "	setne	%%cl\n";
+          fprintf oc "	setp	%%dl\n";
+          fprintf oc "	orb	%%dl, %%cl\n"
+      | Cond_enp ->
+          fprintf oc "	sete	%%cl\n";
+          fprintf oc "	setnp	%%dl\n";
+          fprintf oc "	andb	%%dl, %%cl\n"
+      | _ ->
+          fprintf oc "	set%s	%%cl\n" (name_of_condition c)
+      end;
+      fprintf oc "	movzbl	%%cl, %a\n" ireg rd
+  (** Arithmetic operations over floats *)
+  | Paddd_ff(rd, r1) ->
+      fprintf oc "	addsd	%a, %a\n" freg r1 freg rd
+  | Psubd_ff(rd, r1) ->
+      fprintf oc "	subsd	%a, %a\n" freg r1 freg rd
+  | Pmuld_ff(rd, r1) ->
+      fprintf oc "	mulsd	%a, %a\n" freg r1 freg rd
+  | Pdivd_ff(rd, r1) ->
+      fprintf oc "	divsd	%a, %a\n" freg r1 freg rd
+  | Pnegd (rd) ->
+      need_masks := true;
+      fprintf oc "	xorpd	%a, %a\n" raw_symbol "__negd_mask" freg rd
+  | Pabsd (rd) ->
+      need_masks := true;
+      fprintf oc "	andpd	%a, %a\n" raw_symbol "__absd_mask" freg rd
+  | Pcomisd_ff(r1, r2) ->
+      fprintf oc "	comisd	%a, %a\n" freg r2 freg r1
+  (** Branches and calls *)
+  | Pjmp_l(l) ->
+      fprintf oc "	jmp	%a\n" label (transl_label l)
+  | Pjmp_s(f) ->
+      if not (is_builtin_function f) then
+        fprintf oc "	jmp	%a\n" symbol f
+      else begin
+        print_builtin_function oc f;
+        fprintf oc "	ret\n"
+      end
+  | Pjmp_r(r) ->
+      fprintf oc "	jmp	*%a\n" ireg r
+  | Pjcc(c, l) ->
+      let l = transl_label l in
+      begin match c with
+      | Cond_nep ->
+          fprintf oc "	jp	%a\n" label l;
+          fprintf oc "	jne	%a\n" label l
+      | Cond_enp ->
+          let l' = new_label() in
+          fprintf oc "	jp	%a\n" label l';
+          fprintf oc "	je	%a\n" label l;
+          fprintf oc "%a:\n" label l'
+      | _ ->
+          fprintf oc "	j%s	%a\n" (name_of_condition c) label l
+      end
+  | Pjmptbl(r, tbl) ->
+      let l = new_label() in
+      fprintf oc "	jmp	*%a(, %a, 4)\n" label l ireg r;
+      jumptables := (l, tbl) :: !jumptables
+  | Pcall_s(f) ->
+      if not (is_builtin_function f) then
+        fprintf oc "	call	%a\n" symbol f
+      else
+        print_builtin_function oc f
+  | Pcall_r(r) ->
+      fprintf oc "	call	*%a\n" ireg r
+  | Pret ->
+      fprintf oc "	ret\n"
+  (** Pseudo-instructions *)
+  | Plabel(l) ->
+      if Labelset.mem l labels then
+        fprintf oc "%a:\n" label (transl_label l)
+  | Pallocframe(lo, hi, ofs_ra, ofs_link) ->
+      let sz = sp_adjustment lo hi in
+      let ofs_link = camlint_of_coqint ofs_link in
+      fprintf oc "	subl	$%ld, %%esp\n" sz;
+      fprintf oc "	leal	%ld(%%esp), %%edx\n" (Int32.add sz 4l);
+      fprintf oc "	movl	%%edx, %ld(%%esp)\n" ofs_link
+  | Pfreeframe(lo, hi, ofs_ra, ofs_link) ->
+      let sz = sp_adjustment lo hi in
+      fprintf oc "	addl	$%ld, %%esp\n" sz
+  | Pbuiltin(ef, args, res) ->
+      print_builtin_inlined oc (extern_atom ef.ef_id) args res
+
+let print_literal oc (lbl, n) =
+  fprintf oc "%a:	.quad	0x%Lx\n" label lbl n
+
+let print_jumptable oc (lbl, tbl) =
+  fprintf oc "%a:" label lbl;
+  List.iter
+    (fun l -> fprintf oc "	.long	%a\n" label (transl_label l))
+    tbl
+
+let rec labels_of_code accu = function
+  | [] ->
+      accu
+  | (Pjmp_l lbl | Pjcc(_, lbl)) :: c ->
+      labels_of_code (Labelset.add lbl accu) c
+  | Pjmptbl(_, tbl) :: c ->
+      labels_of_code (List.fold_right Labelset.add tbl accu) c
+  | _ :: c ->
+      labels_of_code accu c
+
+let print_function oc name code =
+  Hashtbl.clear current_function_labels;
+  float_literals := [];
+  jumptables := [];
+  section oc text;
+  print_align oc 16;
+  if not (C2C.atom_is_static name) then
+    fprintf oc "	.globl %a\n" symbol name;
+  fprintf oc "%a:\n" symbol name;
+  List.iter (print_instruction oc (labels_of_code Labelset.empty code)) code;
+  if target = ELF then begin
+    fprintf oc "	.type	%a, @function\n" symbol name;
+    fprintf oc "	.size	%a, . - %a\n" symbol name symbol name
+  end;
+  if !float_literals <> [] then begin
+    section oc float_literal;
+    print_align oc 8;
+    List.iter (print_literal oc) !float_literals;
+    float_literals := []
+  end;
+  if !jumptables <> [] then begin
+    section oc jumptable_literal;
+    print_align oc 4;
+    List.iter (print_jumptable oc) !jumptables;
+    jumptables := []
+  end
+
+let print_fundef oc (Coq_pair(name, defn)) =
+  match defn with
+  | Internal code -> print_function oc name code
+  | External ef -> ()
+
+let print_init oc = function
+  | Init_int8 n ->
+      fprintf oc "	.byte	%ld\n" (camlint_of_coqint n)
+  | Init_int16 n ->
+      fprintf oc "	.short	%ld\n" (camlint_of_coqint n)
+  | Init_int32 n ->
+      fprintf oc "	.long	%ld\n" (camlint_of_coqint n)
+  | Init_float32 n ->
+      fprintf oc "	.long	%ld %s %.18g\n" (Int32.bits_of_float n) comment n
+  | Init_float64 n ->
+      fprintf oc "	.quad	%Ld %s %.18g\n" (Int64.bits_of_float n) comment n
+  | Init_space n ->
+      let n = camlint_of_z n in
+      if n > 0l then fprintf oc "	.space	%ld\n" n
+  | Init_addrof(symb, ofs) ->
+      fprintf oc "	.long	%a\n" 
+                 symbol_offset (symb, camlint_of_coqint ofs)
+
+let print_init_data oc name id =
+  if Str.string_match PrintCsyntax.re_string_literal (extern_atom name) 0
+  && List.for_all (function Init_int8 _ -> true | _ -> false) id
+  then
+    fprintf oc "	.ascii	\"%s\"\n" (PrintCsyntax.string_of_init id)
+  else
+    List.iter (print_init oc) id
+
+let print_var oc (Coq_pair(name, v)) =
+  match v.gvar_init with
+  | [] -> ()
+  | _  ->
+      let sec =
+        if v.gvar_readonly then const_data else data
+      and align =
+        match C2C.atom_alignof name with
+        | Some a -> a
+        | None -> 8 (* 8-alignment is a safe default *)
+      in
+      section oc sec;
+      print_align oc align;
+      if not (C2C.atom_is_static name) then
+        fprintf oc "	.globl	%a\n" symbol name;
+      fprintf oc "%a:\n" symbol name;
+      print_init_data oc name v.gvar_init;
+      if target = ELF then begin
+        fprintf oc "	.type	%a, @object\n" symbol name;
+        fprintf oc "	.size	%a, . - %a\n" symbol name symbol name
+      end
+
+let print_program oc p =
+  need_masks := false;
+  List.iter (print_var oc) p.prog_vars;
+  List.iter (print_fundef oc) p.prog_funct;
+  if !need_masks then begin
+    section oc float_literal;
+    print_align oc 16;
+    fprintf oc "%a:	.quad   0x8000000000000000, 0\n"
+               raw_symbol "__negd_mask";
+    fprintf oc "%a:	.quad   0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF\n"
+               raw_symbol "__absd_mask"
+  end
diff --git a/ia32/PrintAsm.mli b/ia32/PrintAsm.mli
new file mode 100644
index 0000000..aefe3a0
--- /dev/null
+++ b/ia32/PrintAsm.mli
@@ -0,0 +1,13 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+val print_program: out_channel -> Asm.program -> unit
diff --git a/ia32/PrintOp.ml b/ia32/PrintOp.ml
new file mode 100644
index 0000000..6e6ef3c
--- /dev/null
+++ b/ia32/PrintOp.ml
@@ -0,0 +1,105 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Pretty-printing of operators, conditions, addressing modes *)
+
+open Format
+open Camlcoq
+open Integers
+open Op
+
+let comparison_name = function
+  | Ceq -> "=="
+  | Cne -> "!="
+  | Clt -> "<"
+  | Cle -> "<="
+  | Cgt -> ">"
+  | Cge -> ">="
+
+let print_condition reg pp = function
+  | (Ccomp c, [r1;r2]) ->
+      fprintf pp "%a %ss %a" reg r1 (comparison_name c) reg r2
+  | (Ccompu c, [r1;r2]) ->
+      fprintf pp "%a %su %a" reg r1 (comparison_name c) reg r2
+  | (Ccompimm(c, n), [r1]) ->
+      fprintf pp "%a %ss %ld" reg r1 (comparison_name c) (camlint_of_coqint n)
+  | (Ccompuimm(c, n), [r1]) ->
+      fprintf pp "%a %su %ld" reg r1 (comparison_name c) (camlint_of_coqint n)
+  | (Ccompf c, [r1;r2]) ->
+      fprintf pp "%a %sf %a" reg r1 (comparison_name c) reg r2
+  | (Cnotcompf c, [r1;r2]) ->
+      fprintf pp "%a not(%sf) %a" reg r1 (comparison_name c) reg r2
+  | (Cmaskzero n, [r1]) ->
+      fprintf pp "%a & 0x%lx == 0" reg r1 (camlint_of_coqint n)
+  | (Cmasknotzero n, [r1]) ->
+      fprintf pp "%a & 0x%lx != 0" reg r1 (camlint_of_coqint n)
+  | _ ->
+      fprintf pp "<bad condition>"
+
+let print_addressing reg pp = function
+  | Aindexed n, [r1] ->
+      fprintf pp "%a + %ld" reg r1 (camlint_of_coqint n)
+  | Aindexed2 n, [r1; r2] ->
+      fprintf pp "%a + %a + %ld" reg r1 reg r2 (camlint_of_coqint n)
+  | Ascaled(sc,n), [r1] ->
+      fprintf pp "%a * %ld + %ld" reg r1 (camlint_of_coqint sc) (camlint_of_coqint n)
+  | Aindexed2scaled(sc, n), [r1; r2] ->
+      fprintf pp "%a + %a * %ld + %ld" reg r1 reg r2 (camlint_of_coqint sc) (camlint_of_coqint n)
+  | Aglobal(id, ofs), [] -> fprintf pp "%s + %ld" (extern_atom id) (camlint_of_coqint ofs)
+  | Abased(id, ofs), [r1] -> fprintf pp "%s + %ld + %a" (extern_atom id) (camlint_of_coqint ofs) reg r1
+  | Abasedscaled(sc,id, ofs), [r1] -> fprintf pp "%s + %ld + %a * %ld" (extern_atom id) (camlint_of_coqint ofs) reg r1 (camlint_of_coqint sc)
+  | Ainstack ofs, [] -> fprintf pp "stack(%ld)" (camlint_of_coqint ofs)
+  | _ -> fprintf pp "<bad addressing>"
+
+let print_operation reg pp = function
+  | Omove, [r1] -> reg pp r1
+  | Ointconst n, [] -> fprintf pp "%ld" (camlint_of_coqint n)
+  | Ofloatconst n, [] -> fprintf pp "%F" n
+  | Ocast8signed, [r1] -> fprintf pp "int8signed(%a)" reg r1
+  | Ocast8unsigned, [r1] -> fprintf pp "int8unsigned(%a)" reg r1
+  | Ocast16signed, [r1] -> fprintf pp "int16signed(%a)" reg r1
+  | Ocast16unsigned, [r1] -> fprintf pp "int16unsigned(%a)" reg r1
+  | Osub, [r1;r2] -> fprintf pp "%a - %a" reg r1 reg r2
+  | Omul, [r1;r2] -> fprintf pp "%a * %a" reg r1 reg r2
+  | Omulimm n, [r1] -> fprintf pp "%a * %ld" reg r1 (camlint_of_coqint n)
+  | Odiv, [r1;r2] -> fprintf pp "%a /s %a" reg r1 reg r2
+  | Odivu, [r1;r2] -> fprintf pp "%a /u %a" reg r1 reg r2
+  | Omod, [r1;r2] -> fprintf pp "%a %%s %a" reg r1 reg r2
+  | Omodu, [r1;r2] -> fprintf pp "%a %%u %a" reg r1 reg r2
+  | Oand, [r1;r2] -> fprintf pp "%a & %a" reg r1 reg r2
+  | Oandimm n, [r1] -> fprintf pp "%a & %ld" reg r1 (camlint_of_coqint n)
+  | Oor, [r1;r2] -> fprintf pp "%a | %a" reg r1 reg r2
+  | Oorimm n, [r1] ->  fprintf pp "%a | %ld" reg r1 (camlint_of_coqint n)
+  | Oxor, [r1;r2] -> fprintf pp "%a ^ %a" reg r1 reg r2
+  | Oxorimm n, [r1] -> fprintf pp "%a ^ %ld" reg r1 (camlint_of_coqint n)
+  | Oshl, [r1;r2] -> fprintf pp "%a << %a" reg r1 reg r2
+  | Oshlimm n, [r1] -> fprintf pp "%a << %ld" reg r1 (camlint_of_coqint n)
+  | Oshr, [r1;r2] -> fprintf pp "%a >>s %a" reg r1 reg r2
+  | Oshrimm n, [r1] -> fprintf pp "%a >>s %ld" reg r1 (camlint_of_coqint n)
+  | Oshrximm n, [r1] -> fprintf pp "%a >>x %ld" reg r1 (camlint_of_coqint n)
+  | Oshru, [r1;r2] -> fprintf pp "%a >>u %a" reg r1 reg r2
+  | Oshruimm n, [r1] -> fprintf pp "%a >>u %ld" reg r1 (camlint_of_coqint n)
+  | Ororimm n, [r1] -> fprintf pp "%a ror %ld" reg r1 (camlint_of_coqint n)
+  | Olea addr, args -> print_addressing reg pp (addr, args)
+  | Onegf, [r1] -> fprintf pp "negf(%a)" reg r1
+  | Oabsf, [r1] -> fprintf pp "absf(%a)" reg r1
+  | Oaddf, [r1;r2] -> fprintf pp "%a +f %a" reg r1 reg r2
+  | Osubf, [r1;r2] -> fprintf pp "%a -f %a" reg r1 reg r2
+  | Omulf, [r1;r2] -> fprintf pp "%a *f %a" reg r1 reg r2
+  | Odivf, [r1;r2] -> fprintf pp "%a /f %a" reg r1 reg r2
+  | Osingleoffloat, [r1] -> fprintf pp "singleoffloat(%a)" reg r1
+  | Ointoffloat, [r1] -> fprintf pp "intoffloat(%a)" reg r1
+  | Ofloatofint, [r1] -> fprintf pp "floatofint(%a)" reg r1
+  | Ocmp c, args -> print_condition reg pp (c, args)
+  | _ -> fprintf pp "<bad operator>"
+
+
diff --git a/ia32/SelectOp.v b/ia32/SelectOp.v
new file mode 100644
index 0000000..4a4d9e1
--- /dev/null
+++ b/ia32/SelectOp.v
@@ -0,0 +1,839 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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 (Ccompimm 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/SelectOpproof.v b/ia32/SelectOpproof.v
new file mode 100644
index 0000000..59fed01
--- /dev/null
+++ b/ia32/SelectOpproof.v
@@ -0,0 +1,935 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Correctness of instruction selection for operators *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memory.
+Require Import Events.
+Require Import Globalenvs.
+Require Import Smallstep.
+Require Import Cminor.
+Require Import Op.
+Require Import CminorSel.
+Require Import SelectOp.
+
+Open Local Scope cminorsel_scope.
+
+Section CMCONSTR.
+
+Variable ge: genv.
+Variable sp: val.
+Variable e: env.
+Variable m: mem.
+
+(** * Useful lemmas and tactics *)
+
+(** The following are trivial lemmas and custom tactics that help
+  perform backward (inversion) and forward reasoning over the evaluation
+  of operator applications. *)  
+
+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) _) |- _ ] =>
+      inv H; InvEval1
+  | [ H: (eval_expr _ _ _ _ _ (Eop _ (_ ::: Enil)) _) |- _ ] =>
+      inv H; InvEval1
+  | [ H: (eval_expr _ _ _ _ _ (Eop _ (_ ::: _ ::: Enil)) _) |- _ ] =>
+      inv H; InvEval1
+  | [ H: (eval_exprlist _ _ _ _ _ Enil _) |- _ ] =>
+      inv H; InvEval1
+  | [ H: (eval_exprlist _ _ _ _ _ (_ ::: _) _) |- _ ] =>
+      inv H; InvEval1
+  | _ =>
+      idtac
+  end.
+
+Ltac InvEval2 :=
+  match goal with
+  | [ H: (eval_operation _ _ _ nil = Some _) |- _ ] =>
+      simpl in H; inv H
+  | [ H: (eval_operation _ _ _ (_ :: nil) = Some _) |- _ ] =>
+      simpl in H; FuncInv
+  | [ H: (eval_operation _ _ _ (_ :: _ :: nil) = Some _) |- _ ] =>
+      simpl in H; FuncInv
+  | [ H: (eval_operation _ _ _ (_ :: _ :: _ :: nil) = Some _) |- _ ] =>
+      simpl in H; FuncInv
+  | _ =>
+      idtac
+  end.
+
+Ltac InvEval := InvEval1; InvEval2; InvEval2.
+
+(** * Correctness of the smart constructors *)
+
+(** We now show that the code generated by "smart constructor" functions
+  such as [SelectOp.notint] behaves as expected.  Continuing the
+  [notint] example, we show that if the expression [e]
+  evaluates to some integer value [Vint n], then [SelectOp.notint e]
+  evaluates to a value [Vint (Int.not n)] which is indeed the integer
+  negation of the value of [e].
+
+  All proofs follow a common pattern:
+- Reasoning by case over the result of the classification functions
+  (such as [add_match] for integer addition), gathering additional
+  information on the shape of the argument expressions in the non-default
+  cases.
+- Inversion of the evaluations of the arguments, exploiting the additional
+  information thus gathered.
+- Equational reasoning over the arithmetic operations performed,
+  using the lemmas from the [Int] and [Float] modules.
+- Construction of an evaluation derivation for the expression returned
+  by the smart constructor.
+*)
+
+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).
+Proof.
+  intros. unfold addrsymbol. econstructor. constructor. 
+  simpl. rewrite H. 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)).
+Proof.
+  intros. unfold addrstack. econstructor. constructor. 
+  simpl. unfold offset_sp. rewrite H. 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.
+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)).
+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.
+
+  inv H. eapply eval_Eop; eauto.
+  simpl. assert (eval_condition c vl = 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.
+
+  inv H. eapply eval_Econdition; eauto. 
+  destruct v1; eauto.
+Qed.
+
+Lemma eval_offset_addressing:
+  forall addr n args v,
+  eval_addressing ge sp addr args = Some v ->
+  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.
+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.
+  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.
+  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.
+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.
+  destruct (shift_is_scale n).
+  EvalOp. simpl. decEq. decEq.
+  rewrite Int.add_zero. symmetry. apply Int.shl_mul. 
+  EvalOp. simpl. rewrite H1; auto.
+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.
+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.
+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)).
+Proof.
+  intros; unfold mulimm_base.
+  generalize (Int.one_bits_decomp n). 
+  generalize (Int.one_bits_range n).
+  destruct (Int.one_bits n).
+  intros. EvalOp. 
+  destruct l.
+  intros. rewrite H1. simpl. 
+  rewrite Int.add_zero. rewrite <- Int.shl_mul.
+  apply eval_shlimm. auto. 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. 
+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.
+  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.
+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)).
+Proof.
+  intros until y.
+  unfold mul; case (mul_match a b); intros; InvEval.
+  rewrite Int.mul_commut. apply eval_mulimm. auto. 
+  apply eval_mulimm. auto.
+  EvalOp.
+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)).
+Proof.
+  intros. unfold orimm. 
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  subst n. rewrite Int.or_zero. auto.
+  predSpec Int.eq Int.eq_spec n Int.mone.
+  subst n. rewrite Int.or_mone. EvalOp.
+  EvalOp.
+Qed.
+
+Remark eval_same_expr:
+  forall a1 a2 le v1 v2,
+  same_expr_pure a1 a2 = true ->
+  eval_expr ge sp e m le a1 v1 ->
+  eval_expr ge sp e m le a2 v2 ->
+  a1 = a2 /\ v1 = v2.
+Proof.
+  intros until v2.
+  destruct a1; simpl; try (intros; discriminate). 
+  destruct a2; simpl; try (intros; discriminate).
+  case (ident_eq i i0); intros.
+  subst i0. inversion H0. inversion H1. split. auto. congruence. 
+  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.
+
+  EvalOp.
+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)).
+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.
+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)).
+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.
+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)).
+Proof.
+  intros. unfold xorimm. 
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  subst n. rewrite Int.xor_zero. auto.
+  EvalOp.
+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)).
+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.
+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)).
+Proof.
+  intros; unfold divu; EvalOp.
+  simpl. rewrite Int.eq_false; auto. 
+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)).
+Proof.
+  intros; unfold modu; EvalOp.
+  simpl. rewrite Int.eq_false; auto. 
+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)).
+Proof.
+  TrivialOp divs. simpl. 
+  predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
+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)).
+Proof.
+  TrivialOp mods. simpl. 
+  predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
+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)).
+Proof.
+  intros until y; unfold shl; case (shift_match b); intros.
+  InvEval. apply eval_shlimm; auto.
+  EvalOp. simpl. rewrite H1. auto.
+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)).
+Proof.
+  intros until y; unfold shru; case (shift_match b); intros.
+  InvEval. apply eval_shruimm; auto.
+  EvalOp. simpl. rewrite H1. auto.
+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)).
+Proof.
+  intros until y; unfold shr; case (shift_match b); intros.
+  InvEval. apply eval_shrimm; auto.
+  EvalOp. simpl. rewrite H1. auto.
+Qed.
+
+Theorem eval_comp_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 (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.
+
+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_comp_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 (comp c a b) v.
+Proof.
+  intros until v.
+  unfold comp; 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_comp_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 (comp c a b) v.
+Proof.
+  intros until v.
+  unfold comp; 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_comp_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) ->
+  x1 = y1 ->
+  eval_expr ge sp e m le (comp c a b) (Val.of_bool(Int.cmp c x2 y2)).
+Proof.
+  intros until y2.
+  unfold comp; case (comp_match a b); intros; InvEval.
+  EvalOp. simpl. subst y1. rewrite dec_eq_true. 
+  destruct (Int.cmp c x2 y2); reflexivity.
+Qed.
+
+Theorem eval_comp_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) ->
+  x1 <> y1 ->
+  Cminor.eval_compare_mismatch c = Some v ->
+  eval_expr ge sp e m le (comp c a b) v.
+Proof.
+  intros until y2.
+  unfold comp; case (comp_match a b); intros; InvEval.
+  EvalOp. simpl. rewrite dec_eq_false; auto.
+  destruct c; simpl in H2; inv H2; auto.
+Qed.
+
+Theorem eval_compu:
+  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.
+
+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)).
+Proof.
+  intros. unfold compf. EvalOp. simpl. 
+  destruct (Float.cmp c x y); reflexivity.
+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_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_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_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_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_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_intoffloat:
+  forall le a x,
+  eval_expr ge sp e m le a (Vfloat x) ->
+  eval_expr ge sp e m le (intoffloat a) (Vint (Float.intoffloat x)).
+Proof. intros; unfold intoffloat; EvalOp. 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.
+
+Theorem eval_intuoffloat:
+  forall le a x,
+  eval_expr ge sp e m le a (Vfloat x) ->
+  eval_expr ge sp e m le (intuoffloat a) (Vint (Float.intuoffloat x)).
+Proof.
+  intros. 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)).
+    constructor. auto. 
+  apply eval_Econdition with (v1 := Float.cmp Clt x fm).
+  econstructor. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor.
+  simpl. auto.
+  caseEq (Float.cmp Clt x fm); intros.
+  rewrite Float.intuoffloat_intoffloat_1; auto.
+  EvalOp.
+  rewrite Float.intuoffloat_intoffloat_2; auto.
+  fold im. apply eval_addimm. apply eval_intoffloat. apply eval_subf; auto. EvalOp.
+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)).
+Proof.
+  intros. unfold floatofintu. 
+  econstructor. eauto. 
+  set (fm := Float.floatofintu Float.ox8000_0000).
+  assert (eval_expr ge sp e m (Vint x :: le) (Eletvar O) (Vint x)).
+    constructor. auto. 
+  apply eval_Econdition with (v1 := Int.ltu x Float.ox8000_0000).
+  econstructor. constructor. eauto. constructor.
+  simpl. auto.
+  caseEq (Int.ltu x Float.ox8000_0000); intros.
+  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.
+Qed.
+
+Theorem eval_addressing:
+  forall le chunk a v b ofs,
+  eval_expr ge sp e m le a v ->
+  v = Vptr b ofs ->
+  match addressing chunk a with (mode, args) =>
+    exists vl,
+    eval_exprlist ge sp e m le args vl /\ 
+    eval_addressing ge sp mode vl = Some v
+  end.
+Proof.
+  intros until v. unfold addressing; case (addressing_match a); intros; InvEval.
+  inv H. exists vl; auto.
+  exists (v :: nil); split. constructor; auto. constructor. subst; simpl. rewrite Int.add_zero; auto. 
+Qed.
+
+End CMCONSTR.
diff --git a/ia32/extractionMachdep.v b/ia32/extractionMachdep.v
new file mode 100644
index 0000000..435dce2
--- /dev/null
+++ b/ia32/extractionMachdep.v
@@ -0,0 +1,14 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Additional extraction directives specific to the IA32 port *)
+
diff --git a/ia32/standard/CPragmas.ml b/ia32/standard/CPragmas.ml
new file mode 100644
index 0000000..f48064c
--- /dev/null
+++ b/ia32/standard/CPragmas.ml
@@ -0,0 +1,28 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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 GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Platform-dependent handling of pragmas *)
+
+(* No pragmas supported on PowerPC/MacOS *)
+
+let initialize () = ()
+
+(* PowerPC-specific: say if an atom is in a small data area *)
+
+let atom_is_small_data a ofs = false
+
+(* PowerPC-specific: determine section to use for a particular symbol *)
+
+let section_for_atom a init = None
diff --git a/ia32/standard/Conventions1.v b/ia32/standard/Conventions1.v
new file mode 100644
index 0000000..a2d7aba
--- /dev/null
+++ b/ia32/standard/Conventions1.v
@@ -0,0 +1,455 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Function calling conventions and other conventions regarding the use of 
+    machine registers and stack slots. *)
+
+Require Import Coqlib.
+Require Import AST.
+Require Import Locations.
+
+(** * Classification of machine registers *)
+
+(** Machine registers (type [mreg] in module [Locations]) are divided in
+  the following groups:
+- Temporaries used for spilling, reloading, and parallel move operations.
+- Allocatable registers, that can be assigned to RTL pseudo-registers.
+  These are further divided into:
+-- Callee-save registers, whose value is preserved across a function call.
+-- Caller-save registers that can be modified during a function call.
+
+  We follow the x86-32 application binary interface (ABI) in our choice
+  of callee- and caller-save registers.
+*)
+
+Definition int_caller_save_regs := AX :: nil.
+
+Definition float_caller_save_regs := X0 :: X1 :: X2 :: X3 :: X4 :: X5 :: nil.
+
+Definition int_callee_save_regs := BX :: SI :: DI :: BP :: nil.
+
+Definition float_callee_save_regs : list mreg := nil.
+
+Definition destroyed_at_call_regs :=
+  int_caller_save_regs ++ float_caller_save_regs.
+
+Definition destroyed_at_call :=
+  List.map R destroyed_at_call_regs.
+
+Definition int_temporaries := IT1 :: IT2 :: nil.
+
+Definition float_temporaries := FT1 :: FT2 :: FP0 :: nil.
+  
+Definition temporaries := 
+  R IT1 :: R IT2 :: R FT1 :: R FT2 :: R FP0 :: nil.
+
+Definition dummy_int_reg := AX.     (**r Used in [Coloring]. *)
+Definition dummy_float_reg := X0.   (**r Used in [Coloring]. *)
+
+(** The [index_int_callee_save] and [index_float_callee_save] associate
+  a unique positive integer to callee-save registers.  This integer is
+  used in [Stacking] to determine where to save these registers in
+  the activation record if they are used by the current function. *)
+
+Definition index_int_callee_save (r: mreg) :=
+  match r with
+  | BX => 1 | SI => 2 | DI => 3 | BP => 4 | _ => -1
+  end.
+
+Definition index_float_callee_save (r: mreg) := -1.
+
+Ltac ElimOrEq :=
+  match goal with
+  |  |- (?x = ?y) \/ _ -> _ =>
+       let H := fresh in
+       (intro H; elim H; clear H;
+        [intro H; rewrite <- H; clear H | ElimOrEq])
+  |  |- False -> _ =>
+       let H := fresh in (intro H; contradiction)
+  end.
+
+Ltac OrEq :=
+  match goal with
+  | |- (?x = ?x) \/ _ => left; reflexivity
+  | |- (?x = ?y) \/ _ => right; OrEq
+  | |- False => fail
+  end.
+
+Ltac NotOrEq :=
+  match goal with
+  | |- (?x = ?y) \/ _ -> False =>
+       let H := fresh in (
+       intro H; elim H; clear H; [intro; discriminate | NotOrEq])
+  | |- False -> False =>
+       contradiction
+  end.
+
+Lemma index_int_callee_save_pos:
+  forall r, In r int_callee_save_regs -> index_int_callee_save r >= 0.
+Proof.
+  intro r. simpl; ElimOrEq; unfold index_int_callee_save; omega.
+Qed.
+
+Lemma index_float_callee_save_pos:
+  forall r, In r float_callee_save_regs -> index_float_callee_save r >= 0.
+Proof.
+  intro r. simpl; ElimOrEq; unfold index_float_callee_save; omega.
+Qed.
+
+Lemma index_int_callee_save_pos2:
+  forall r, index_int_callee_save r >= 0 -> In r int_callee_save_regs.
+Proof.
+  destruct r; simpl; intro; omegaContradiction || OrEq.
+Qed.
+
+Lemma index_float_callee_save_pos2:
+  forall r, index_float_callee_save r >= 0 -> In r float_callee_save_regs.
+Proof.
+  unfold index_float_callee_save; intros. omegaContradiction.
+Qed.
+
+Lemma index_int_callee_save_inj:
+  forall r1 r2, 
+  In r1 int_callee_save_regs ->
+  In r2 int_callee_save_regs ->
+  r1 <> r2 ->
+  index_int_callee_save r1 <> index_int_callee_save r2.
+Proof.
+  intros r1 r2. 
+  simpl; ElimOrEq; ElimOrEq; unfold index_int_callee_save;
+  intros; congruence.
+Qed.
+
+Lemma index_float_callee_save_inj:
+  forall r1 r2, 
+  In r1 float_callee_save_regs ->
+  In r2 float_callee_save_regs ->
+  r1 <> r2 ->
+  index_float_callee_save r1 <> index_float_callee_save r2.
+Proof.
+  simpl; intros. contradiction.
+Qed.
+
+(** The following lemmas show that
+    (temporaries, destroyed at call, integer callee-save, float callee-save)
+    is a partition of the set of machine registers. *)
+
+Lemma int_float_callee_save_disjoint:
+  list_disjoint int_callee_save_regs float_callee_save_regs.
+Proof.
+  red; intros r1 r2. simpl; ElimOrEq; ElimOrEq; discriminate.
+Qed.
+
+Lemma register_classification:
+  forall r, 
+  (In (R r) temporaries \/ In (R r) destroyed_at_call) \/
+  (In r int_callee_save_regs \/ In r float_callee_save_regs).
+Proof.
+  destruct r; 
+  try (left; left; simpl; OrEq);
+  try (left; right; simpl; OrEq);
+  try (right; left; simpl; OrEq);
+  try (right; right; simpl; OrEq).
+Qed.
+
+Lemma int_callee_save_not_destroyed:
+  forall r, 
+    In (R r) temporaries \/ In (R r) destroyed_at_call ->
+    ~(In r int_callee_save_regs).
+Proof.
+  intros; red; intros. elim H.
+  generalize H0. simpl; ElimOrEq; NotOrEq.
+  generalize H0. simpl; ElimOrEq; NotOrEq.
+Qed.
+
+Lemma float_callee_save_not_destroyed:
+  forall r, 
+    In (R r) temporaries \/ In (R r) destroyed_at_call ->
+    ~(In r float_callee_save_regs).
+Proof.
+  intros; red; intros. elim H.
+  generalize H0. simpl; ElimOrEq; NotOrEq.
+  generalize H0. simpl; ElimOrEq; NotOrEq.
+Qed.
+
+Lemma int_callee_save_type:
+  forall r, In r int_callee_save_regs -> mreg_type r = Tint.
+Proof.
+  intro. simpl; ElimOrEq; reflexivity.
+Qed.
+
+Lemma float_callee_save_type:
+  forall r, In r float_callee_save_regs -> mreg_type r = Tfloat.
+Proof.
+  intro. simpl; ElimOrEq; reflexivity.
+Qed.
+
+Ltac NoRepet :=
+  match goal with
+  | |- list_norepet nil =>
+      apply list_norepet_nil
+  | |- list_norepet (?a :: ?b) =>
+      apply list_norepet_cons; [simpl; intuition discriminate | NoRepet]
+  end.
+
+Lemma int_callee_save_norepet:
+  list_norepet int_callee_save_regs.
+Proof.
+  unfold int_callee_save_regs; NoRepet.
+Qed.
+
+Lemma float_callee_save_norepet:
+  list_norepet float_callee_save_regs.
+Proof.
+  unfold float_callee_save_regs; NoRepet.
+Qed.
+
+(** * Function calling conventions *)
+
+(** The functions in this section determine the locations (machine registers
+  and stack slots) used to communicate arguments and results between the
+  caller and the callee during function calls.  These locations are functions
+  of the signature of the function and of the call instruction.  
+  Agreement between the caller and the callee on the locations to use
+  is guaranteed by our dynamic semantics for Cminor and RTL, which demand 
+  that the signature of the call instruction is identical to that of the
+  called function.
+
+  Calling conventions are largely arbitrary: they must respect the properties
+  proved in this section (such as no overlapping between the locations
+  of function arguments), but this leaves much liberty in choosing actual
+  locations.  To ensure binary interoperability of code generated by our
+  compiler with libraries compiled by another compiler, we
+  implement the standard x86 conventions. *)
+
+(** ** Location of function result *)
+
+(** The result value of a function is passed back to the caller in
+  registers [AX] or [FP0], depending on the type of the returned value.
+  We treat a function without result as a function with one integer result. *)
+
+Definition loc_result (s: signature) : mreg :=
+  match s.(sig_res) with
+  | None => AX
+  | Some Tint => AX
+  | Some Tfloat => FP0
+  end.
+
+(** The result location has the type stated in the signature. *)
+
+Lemma loc_result_type:
+  forall sig,
+  mreg_type (loc_result sig) =
+  match sig.(sig_res) with None => Tint | Some ty => ty end.
+Proof.
+  intros; unfold loc_result.
+  destruct (sig_res sig). 
+  destruct t; reflexivity.
+  reflexivity.
+Qed.
+
+(** The result location is a caller-save register or a temporary *)
+
+Lemma loc_result_caller_save:
+  forall (s: signature), 
+  In (R (loc_result s)) destroyed_at_call \/ In (R (loc_result s)) temporaries.
+Proof.
+  intros; unfold loc_result.
+  destruct (sig_res s).
+  destruct t. left; simpl; OrEq. right; simpl; OrEq.
+  left; simpl; OrEq.
+Qed.
+
+(** ** Location of function arguments *)
+
+(** All arguments are passed on stack. (Snif.) *)
+
+Fixpoint loc_arguments_rec
+    (tyl: list typ) (ofs: Z) {struct tyl} : list loc :=
+  match tyl with
+  | nil => nil
+  | Tint :: tys => S (Outgoing ofs Tint) :: loc_arguments_rec tys (ofs + 1)
+  | Tfloat :: tys => S (Outgoing ofs Tfloat) :: loc_arguments_rec tys (ofs + 2)
+  end.
+
+(** [loc_arguments s] returns the list of locations where to store arguments
+  when calling a function with signature [s].  *)
+
+Definition loc_arguments (s: signature) : list loc :=
+  loc_arguments_rec s.(sig_args) 0.
+
+(** [size_arguments s] returns the number of [Outgoing] slots used
+  to call a function with signature [s]. *)
+
+Fixpoint size_arguments_rec
+    (tyl: list typ) (ofs: Z) {struct tyl} : Z :=
+  match tyl with
+  | nil => ofs
+  | Tint :: tys => size_arguments_rec tys (ofs + 1)
+  | Tfloat :: tys => size_arguments_rec tys (ofs + 2)
+  end.
+
+Definition size_arguments (s: signature) : Z :=
+  size_arguments_rec s.(sig_args) 0.
+
+(** A tail-call is possible for a signature if the corresponding
+    arguments are all passed in registers. *)
+
+Definition tailcall_possible (s: signature) : Prop :=
+  forall l, In l (loc_arguments s) ->
+  match l with R _ => True | S _ => False end.
+
+(** Argument locations are either non-temporary registers or [Outgoing] 
+  stack slots at nonnegative offsets. *)
+
+Definition loc_argument_acceptable (l: loc) : Prop :=
+  match l with
+  | R r => ~(In l temporaries)
+  | S (Outgoing ofs ty) => ofs >= 0
+  | _ => False
+  end.
+
+Remark loc_arguments_rec_charact:
+  forall tyl ofs l,
+  In l (loc_arguments_rec tyl ofs) ->
+  match l with
+  | S (Outgoing ofs' ty) => ofs' >= ofs
+  | _ => False
+  end.
+Proof.
+  induction tyl; simpl loc_arguments_rec; intros.
+  elim H.
+  destruct a; simpl in H; destruct H.
+  subst l. omega.
+  generalize (IHtyl _ _ H). destruct l; auto. destruct s; auto. omega. 
+  subst l. omega.
+  generalize (IHtyl _ _ H). destruct l; auto. destruct s; auto. omega. 
+Qed.
+
+Lemma loc_arguments_acceptable:
+  forall (s: signature) (r: loc),
+  In r (loc_arguments s) -> loc_argument_acceptable r.
+Proof.
+  unfold loc_arguments; intros.
+  generalize (loc_arguments_rec_charact  _ _ _ H).
+  destruct r; tauto.
+Qed.
+Hint Resolve loc_arguments_acceptable: locs.
+
+(** Arguments are parwise disjoint (in the sense of [Loc.norepet]). *)
+
+Remark loc_arguments_rec_notin_local:
+  forall tyl ofs ofs0 ty0,
+  Loc.notin (S (Local ofs0 ty0)) (loc_arguments_rec tyl ofs).
+Proof.
+  induction tyl; simpl; intros.
+  auto.
+  destruct a; simpl; auto.
+Qed.
+
+Remark loc_arguments_rec_notin_outgoing:
+  forall tyl ofs ofs0 ty0,
+  ofs0 + typesize ty0 <= ofs ->
+  Loc.notin (S (Outgoing ofs0 ty0)) (loc_arguments_rec tyl ofs).
+Proof.
+  induction tyl; simpl; intros.
+  auto.
+  destruct a.
+  split. simpl. omega. apply IHtyl. omega. 
+  split. simpl. omega. apply IHtyl. omega. 
+Qed.
+
+Lemma loc_arguments_norepet:
+  forall (s: signature), Loc.norepet (loc_arguments s).
+Proof.
+  intros. unfold loc_arguments. generalize (sig_args s) 0.
+  induction l; simpl; intros.
+  constructor.
+  destruct a; constructor.
+  apply loc_arguments_rec_notin_outgoing. simpl; omega. auto.
+  apply loc_arguments_rec_notin_outgoing. simpl; omega. auto.
+Qed.
+
+(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)
+
+Remark size_arguments_rec_above:
+  forall tyl ofs0, ofs0 <= size_arguments_rec tyl ofs0.
+Proof.
+  induction tyl; simpl; intros.
+  omega.
+  destruct a.
+  apply Zle_trans with (ofs0 + 1); auto; omega.
+  apply Zle_trans with (ofs0 + 2); auto; omega.
+Qed.
+
+Lemma size_arguments_above:
+  forall s, size_arguments s >= 0.
+Proof.
+  intros; unfold size_arguments. apply Zle_ge.  
+  apply size_arguments_rec_above.
+Qed.
+
+Lemma loc_arguments_bounded:
+  forall (s: signature) (ofs: Z) (ty: typ),
+  In (S (Outgoing ofs ty)) (loc_arguments s) ->
+  ofs + typesize ty <= size_arguments s.
+Proof.
+  intros until ty. unfold loc_arguments, size_arguments. generalize (sig_args s) 0.
+  induction l; simpl; intros.
+  elim H.
+  destruct a; simpl in H; destruct H.
+  inv H. apply size_arguments_rec_above.
+  auto.
+  inv H. apply size_arguments_rec_above.
+  auto.
+Qed.
+
+(** Temporary registers do not overlap with argument locations. *)
+
+Lemma loc_arguments_not_temporaries:
+  forall sig, Loc.disjoint (loc_arguments sig) temporaries.
+Proof.
+  intros; red; intros x1 x2 H.
+  generalize (loc_arguments_rec_charact _ _ _ H).
+  destruct x1. tauto. destruct s; intuition.
+  revert H1. simpl; ElimOrEq; auto.
+Qed.
+Hint Resolve loc_arguments_not_temporaries: locs.
+
+(** Argument registers are caller-save. *)
+
+Lemma arguments_caller_save:
+  forall sig r,
+  In (R r) (loc_arguments sig) -> In (R r) destroyed_at_call.
+Proof.
+  unfold loc_arguments; intros.
+  elim (loc_arguments_rec_charact _ _ _ H); simpl.
+Qed.
+
+(** Argument locations agree in number with the function signature. *)
+
+Lemma loc_arguments_length:
+  forall sig,
+  List.length (loc_arguments sig) = List.length sig.(sig_args).
+Proof.
+  intros. unfold loc_arguments. generalize (sig_args sig) 0.
+  induction l; simpl; intros. auto. destruct a; simpl; decEq; auto.
+Qed.
+
+(** Argument locations agree in types with the function signature. *)
+
+Lemma loc_arguments_type:
+  forall sig, List.map Loc.type (loc_arguments sig) = sig.(sig_args).
+Proof.
+  intros. unfold loc_arguments. generalize (sig_args sig) 0. 
+  induction l; simpl; intros. auto. destruct a; simpl; decEq; auto.
+Qed.
diff --git a/ia32/standard/Stacklayout.v b/ia32/standard/Stacklayout.v
new file mode 100644
index 0000000..135aba1
--- /dev/null
+++ b/ia32/standard/Stacklayout.v
@@ -0,0 +1,76 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Machine- and ABI-dependent layout information for activation records. *)
+
+Require Import Coqlib.
+Require Import Bounds.
+
+(** The general shape of activation records is as follows,
+  from bottom (lowest offsets) to top:
+- Space for outgoing arguments to function calls.
+- Back link to parent frame
+- Return address (formally; it's actually pushed elsewhere)
+- Local stack slots of integer type.
+- Saved values of integer callee-save registers used by the function.
+- Local stack slots of float type.
+- Saved values of float callee-save registers used by the function.
+- Space for the stack-allocated data declared in Cminor.
+
+To facilitate some of the proofs, the Cminor stack-allocated data
+starts at offset 0; the preceding areas in the activation record
+therefore have negative offsets.  This part (with negative offsets)
+is called the ``frame'', by opposition with the ``Cminor stack data''
+which is the part with positive offsets.
+
+The [frame_env] compilation environment records the positions of
+the boundaries between areas in the frame part.
+*)
+
+Definition fe_ofs_arg := 0.
+
+Record frame_env : Type := mk_frame_env {
+  fe_size: Z;
+  fe_ofs_link: Z;
+  fe_ofs_retaddr: Z;
+  fe_ofs_int_local: Z;
+  fe_ofs_int_callee_save: Z;
+  fe_num_int_callee_save: Z;
+  fe_ofs_float_local: Z;
+  fe_ofs_float_callee_save: Z;
+  fe_num_float_callee_save: Z
+}.
+
+(** Computation of the frame environment from the bounds of the current
+  function. *)
+
+Definition make_env (b: bounds) :=
+  let olink := 4 * b.(bound_outgoing) in  (* back link *)
+  let oretaddr := olink + 4 in            (* return address *)
+  let oil := oretaddr + 4 in              (* integer locals *)
+  let oics := oil + 4 * b.(bound_int_local) in (* integer callee-saves *)
+  let oendi := oics + 4 * b.(bound_int_callee_save) in
+  let ofl := align oendi 8 in             (* float locals *)
+  let ofcs := ofl + 8 * b.(bound_float_local) in (* float callee-saves *)
+  let sz := ofcs + 8 * b.(bound_float_callee_save) in (* total frame size *)
+  mk_frame_env sz olink oretaddr
+                  oil oics b.(bound_int_callee_save)
+                  ofl ofcs b.(bound_float_callee_save).
+
+
+Remark align_float_part:
+  forall b,
+  4 * bound_outgoing b + 4 + 4 + 4 * bound_int_local b + 4 * bound_int_callee_save b <=
+  align (4 * bound_outgoing b + 4 + 4 + 4 * bound_int_local b + 4 * bound_int_callee_save b) 8.
+Proof.
+  intros. apply align_le. omega.
+Qed.