Reorganized the development, modularizing away machine-dependent parts.

Started to merge the ARM code generator.
Started to add support for PowerPC/EABI.
Use ocamlbuild to construct executable from Caml files.


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

32 files changed, 2075 insertions, 11274 deletions

diff --git a/backend/CMlexer.mli b/backend/CMlexer.mli
new file mode 100644
index 00000000..c6afb72c
--- /dev/null
+++ b/backend/CMlexer.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 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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+val token: Lexing.lexbuf -> CMparser.token
+exception Error of string
diff --git a/backend/CMlexer.mll b/backend/CMlexer.mll
new file mode 100644
index 00000000..9854117c
--- /dev/null
+++ b/backend/CMlexer.mll
@@ -0,0 +1,132 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+{
+open Camlcoq
+open CMparser
+exception Error of string
+}
+
+let blank = [' ' '\009' '\012' '\010' '\013']
+let floatlit = 
+  ['0'-'9'] ['0'-'9' '_']* 
+  ('.' ['0'-'9' '_']* )?
+  (['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']*)?
+let ident = ['A'-'Z' 'a'-'z' '_'] ['A'-'Z' 'a'-'z' '_' '0'-'9']*
+let intlit = "-"? ( ['0'-'9']+ | "0x" ['0'-'9' 'a'-'f' 'A'-'F']+
+                               | "0o" ['0'-'7']+ | "0b" ['0'-'1']+ )
+let stringlit = "\"" [ ^ '"' ] * '"'
+
+rule token = parse
+  | blank +      { token lexbuf }
+  | "/*"         { comment lexbuf; token lexbuf }
+  | "absf" { ABSF }
+  | "alloc" { ALLOC }
+  | "&" { AMPERSAND }
+  | "&&" { AMPERSANDAMPERSAND }
+  | "!"    { BANG }
+  | "!="    { BANGEQUAL }
+  | "!=f"    { BANGEQUALF }
+  | "!=u"    { BANGEQUALU }
+  | "|"     { BAR }
+  | "||"    { BARBAR }
+  | "^"     { CARET }
+  | "case"  { CASE }
+  | ":"    { COLON }
+  | ","    { COMMA }
+  | "default" { DEFAULT }
+  | "$"    { DOLLAR }
+  | "else"    { ELSE }
+  | "="    { EQUAL }
+  | "=="    { EQUALEQUAL }
+  | "==f"    { EQUALEQUALF }
+  | "==u"    { EQUALEQUALU }
+  | "exit"    { EXIT }
+  | "extern"    { EXTERN }
+  | "float"    { FLOAT }
+  | "float32"    { FLOAT32 }
+  | "float64"    { FLOAT64 }
+  | "floatofint"    { FLOATOFINT }
+  | "floatofintu"    { FLOATOFINTU }
+  | ">"    { GREATER }
+  | ">f"    { GREATERF }
+  | ">u"    { GREATERU }
+  | ">="    { GREATEREQUAL }
+  | ">=f"    { GREATEREQUALF }
+  | ">=u"    { GREATEREQUALU }
+  | ">>"    { GREATERGREATER }
+  | ">>u"    { GREATERGREATERU }
+  | "if"    { IF }
+  | "in"    { IN }
+  | "int"    { INT }
+  | "int16s"    { INT16S }
+  | "int16u"    { INT16U }
+  | "int32"    { INT32 }
+  | "int8s"    { INT8S }
+  | "int8u"    { INT8U }
+  | "intoffloat"    { INTOFFLOAT }
+  | "intuoffloat"    { INTUOFFLOAT }
+  | "{"    { LBRACE }
+  | "{{"    { LBRACELBRACE }
+  | "["    { LBRACKET }
+  | "<"    { LESS }
+  | "<u"    { LESSU }
+  | "<f"    { LESSF }
+  | "<="    { LESSEQUAL }
+  | "<=u"    { LESSEQUALU }
+  | "<=f"    { LESSEQUALF }
+  | "<<"    { LESSLESS }
+  | "let"     { LET }
+  | "loop"    { LOOP }
+  | "("    { LPAREN }
+  | "match" { MATCH }
+  | "-"    { MINUS }
+  | "->"    { MINUSGREATER }
+  | "-f"    { MINUSF }
+  | "%"    { PERCENT }
+  | "%u"    { PERCENTU }
+  | "+"    { PLUS }
+  | "+f"    { PLUSF }
+  | "?"    { QUESTION }
+  | "}"    { RBRACE }
+  | "}}"    { RBRACERBRACE }
+  | "]"    { RBRACKET }
+  | "return"    { RETURN }
+  | ")"    { RPAREN }
+  | ";"    { SEMICOLON }
+  | "/"    { SLASH }
+  | "/f"    { SLASHF }
+  | "/u"    { SLASHU }
+  | "stack"    { STACK }
+  | "*" { STAR }
+  | "*f"    { STARF }
+  | "switch"    { SWITCH }
+  | "tailcall"  { TAILCALL }
+  | "~"    { TILDE }
+  | "var"    { VAR }
+  | "void"    { VOID }
+
+  | intlit    { INTLIT(Int32.of_string(Lexing.lexeme lexbuf)) }
+  | floatlit     { FLOATLIT(float_of_string(Lexing.lexeme lexbuf)) }
+  | stringlit { let s = Lexing.lexeme lexbuf in
+                STRINGLIT(intern_string(String.sub s 1 (String.length s - 2))) }
+  | ident    { IDENT(intern_string(Lexing.lexeme lexbuf)) }
+  | eof      { EOF }
+  | _        { raise(Error("illegal character `" ^ Char.escaped (Lexing.lexeme_char lexbuf 0) ^ "'")) }
+
+and comment = parse
+    "*/"     { () }
+  | eof      { raise(Error "unterminated comment") }
+  | _        { comment lexbuf }
diff --git a/backend/CMparser.mly b/backend/CMparser.mly
new file mode 100644
index 00000000..25fb0321
--- /dev/null
+++ b/backend/CMparser.mly
@@ -0,0 +1,541 @@
+/* *********************************************************************/
+/*                                                                     */
+/*              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.     */
+/*                                                                     */
+/* *********************************************************************/
+
+%{
+open Datatypes
+open CList
+open Camlcoq
+open BinPos
+open BinInt
+open Integers
+open AST
+open Cminor
+
+(** Naming function calls in expressions *)
+
+type rexpr =
+  | Rvar of ident
+  | Rconst of constant
+  | Runop of unary_operation * rexpr
+  | Rbinop of binary_operation * rexpr * rexpr
+  | Rload of memory_chunk * rexpr
+  | Rcondition of rexpr * rexpr * rexpr
+  | Rcall of signature * rexpr * rexpr list
+  | Ralloc of rexpr
+
+let temp_counter = ref 0
+
+let temporaries = ref []
+
+let mktemp () =
+  incr temp_counter;
+  let n = Printf.sprintf "__t%d" !temp_counter in
+  let id = intern_string n in
+  temporaries := id :: !temporaries;
+  id
+
+let convert_accu = ref []
+
+let rec convert_rexpr = function
+  | Rvar id -> Evar id
+  | Rconst c -> Econst c
+  | Runop(op, e1) -> Eunop(op, convert_rexpr e1)
+  | Rbinop(op, e1, e2) ->
+      let c1 = convert_rexpr e1 in
+      let c2 = convert_rexpr e2 in
+      Ebinop(op, c1, c2)
+  | Rload(chunk, e1) -> Eload(chunk, convert_rexpr e1)
+  | Rcondition(e1, e2, e3) ->
+      let c1 = convert_rexpr e1 in
+      let c2 = convert_rexpr e2 in
+      let c3 = convert_rexpr e3 in
+      Econdition(c1, c2, c3)
+  | Rcall(sg, e1, el) ->
+      let c1 = convert_rexpr e1 in
+      let cl = convert_rexpr_list el in
+      let t = mktemp() in
+      convert_accu := Scall(Some t, sg, c1, cl) :: !convert_accu;
+      Evar t
+  | Ralloc e1 ->
+      let c1 = convert_rexpr e1 in
+      let t = mktemp() in
+      convert_accu := Salloc(t, c1) :: !convert_accu;
+      Evar t
+
+and convert_rexpr_list = function
+  | [] -> []
+  | e1 :: el ->
+      let c1 = convert_rexpr e1 in
+      let cl = convert_rexpr_list el in
+      c1 :: cl
+
+let rec prepend_seq stmts last =
+  match stmts with
+  | [] -> last
+  | s1 :: sl -> prepend_seq sl (Sseq(s1, last))
+
+let mkeval e =
+  convert_accu := [];
+  match e with
+  | Rcall(sg, e1, el) ->
+      let c1 = convert_rexpr e1 in
+      let cl = convert_rexpr_list el in
+      prepend_seq !convert_accu (Scall(None, sg, c1, cl))
+  | _ ->
+      ignore (convert_rexpr e);
+      prepend_seq !convert_accu Sskip
+
+let mkassign id e =
+  convert_accu := [];
+  match e with
+  | Rcall(sg, e1, el) ->
+      let c1 = convert_rexpr e1 in
+      let cl = convert_rexpr_list el in
+      prepend_seq !convert_accu (Scall(Some id, sg, c1, cl))
+  | Ralloc(e1) ->
+      let c1 = convert_rexpr e1 in
+      prepend_seq !convert_accu (Salloc(id, c1))
+  | _ ->
+      let c = convert_rexpr e in
+      prepend_seq !convert_accu (Sassign(id, c))
+
+let mkstore chunk e1 e2 =
+  convert_accu := [];
+  let c1 = convert_rexpr e1 in
+  let c2 = convert_rexpr e2 in
+  prepend_seq !convert_accu (Sstore(chunk, c1, c2))
+
+let mkifthenelse e s1 s2 =
+  convert_accu := [];
+  let c = convert_rexpr e in
+  prepend_seq !convert_accu (Sifthenelse(c, s1, s2))
+
+let mkreturn_some e =
+  convert_accu := [];
+  let c = convert_rexpr e in
+  prepend_seq !convert_accu (Sreturn (Some c))
+
+let mktailcall sg e1 el =
+  convert_accu := [];
+  let c1 = convert_rexpr e1 in
+  let cl = convert_rexpr_list el in
+  prepend_seq !convert_accu (Stailcall(sg, c1, cl))
+
+(** Other constructors *)
+
+let intconst n =
+  Rconst(Ointconst(coqint_of_camlint n))
+
+let andbool e1 e2 =
+  Rcondition(e1, e2, intconst 0l)
+let orbool e1 e2 =
+  Rcondition(e1, intconst 1l, e2)
+
+let exitnum n = nat_of_camlint(Int32.pred n)
+
+let mkswitch expr (cases, dfl) =
+  convert_accu := [];
+  let c = convert_rexpr expr in
+  let rec mktable = function
+  | [] -> []
+  | (key, exit) :: rem ->
+      Coq_pair(coqint_of_camlint key, exitnum exit) :: mktable rem in
+  prepend_seq !convert_accu (Sswitch(c, mktable cases, exitnum dfl))
+
+(***
+   match (a) { case 0: s0; case 1: s1; case 2: s2; }  --->
+
+   block {
+   block {
+   block {
+   block {
+     switch(a) { case 0: exit 0; case 1: exit 1; default: exit 2; }
+   }; s0; exit 2;
+   }; s1; exit 1;
+   }; s2;
+   }
+
+   Note that matches are assumed to be exhaustive
+***)
+
+let mkmatch_aux expr cases =
+  let ncases = Int32.of_int (List.length cases) in
+  let rec mktable n = function
+    | [] -> assert false
+    | [key, action] -> []
+    | (key, action) :: rem ->
+        Coq_pair(coqint_of_camlint key, nat_of_camlint n)
+        :: mktable (Int32.succ n) rem in
+  let sw =
+    Sswitch(expr, mktable 0l cases, nat_of_camlint (Int32.pred ncases)) in
+  let rec mkblocks body n = function
+    | [] -> assert false
+    | [key, action] ->
+        Sblock(Sseq(body, action))
+    | (key, action) :: rem ->
+        mkblocks
+          (Sblock(Sseq(body, Sseq(action, Sexit (nat_of_camlint n)))))
+          (Int32.pred n)
+          rem in
+  mkblocks (Sblock sw) (Int32.pred ncases) cases
+
+let mkmatch expr cases =
+  convert_accu := [];
+  let c = convert_rexpr expr in
+  let s =
+    match cases with
+    | [] -> Sskip (* ??? *)
+    | [key, action] -> action
+    | _ -> mkmatch_aux c cases in
+  prepend_seq !convert_accu s
+
+%}
+
+%token ABSF
+%token AMPERSAND
+%token AMPERSANDAMPERSAND
+%token ALLOC
+%token BANG
+%token BANGEQUAL
+%token BANGEQUALF
+%token BANGEQUALU
+%token BAR
+%token BARBAR
+%token CARET
+%token CASE
+%token COLON
+%token COMMA
+%token DEFAULT
+%token DOLLAR
+%token ELSE
+%token EQUAL
+%token EQUALEQUAL
+%token EQUALEQUALF
+%token EQUALEQUALU
+%token EOF
+%token EXIT
+%token EXTERN
+%token FLOAT
+%token FLOAT32
+%token FLOAT64
+%token <float> FLOATLIT
+%token FLOATOFINT
+%token FLOATOFINTU
+%token GREATER
+%token GREATERF
+%token GREATERU
+%token GREATEREQUAL
+%token GREATEREQUALF
+%token GREATEREQUALU
+%token GREATERGREATER
+%token GREATERGREATERU
+%token <AST.ident> IDENT
+%token IF
+%token IN
+%token INT
+%token INT16S
+%token INT16U
+%token INT32
+%token INT8S
+%token INT8U
+%token <int32> INTLIT
+%token INTOFFLOAT
+%token INTUOFFLOAT
+%token LBRACE
+%token LBRACELBRACE
+%token LBRACKET
+%token LESS
+%token LESSU
+%token LESSF
+%token LESSEQUAL
+%token LESSEQUALU
+%token LESSEQUALF
+%token LESSLESS
+%token LET
+%token LOOP
+%token LPAREN
+%token MATCH
+%token MINUS
+%token MINUSF
+%token MINUSGREATER
+%token PERCENT
+%token PERCENTU
+%token PLUS
+%token PLUSF
+%token QUESTION
+%token RBRACE
+%token RBRACERBRACE
+%token RBRACKET
+%token RETURN
+%token RPAREN
+%token SEMICOLON
+%token SLASH
+%token SLASHF
+%token SLASHU
+%token STACK
+%token STAR
+%token STARF
+%token <AST.ident> STRINGLIT
+%token SWITCH
+%token TILDE
+%token TAILCALL
+%token VAR
+%token VOID
+
+/* Precedences from low to high */
+
+%left COMMA
+%left p_let
+%right EQUAL
+%right QUESTION COLON
+%left BARBAR
+%left AMPERSANDAMPERSAND
+%left BAR
+%left CARET
+%left AMPERSAND
+%left EQUALEQUAL BANGEQUAL LESS LESSEQUAL GREATER GREATEREQUAL EQUALEQUALU BANGEQUALU LESSU LESSEQUALU GREATERU GREATEREQUALU EQUALEQUALF BANGEQUALF LESSF LESSEQUALF GREATERF GREATEREQUALF 
+%left LESSLESS GREATERGREATER GREATERGREATERU
+%left PLUS PLUSF MINUS MINUSF
+%left STAR SLASH PERCENT STARF SLASHF SLASHU PERCENTU
+%nonassoc BANG TILDE p_uminus ABSF INTOFFLOAT INTUOFFLOAT FLOATOFINT FLOATOFINTU INT8S INT8U INT16S INT16U FLOAT32 ALLOC
+%left LPAREN
+
+/* Entry point */
+
+%start prog
+%type <Cminor.program> prog
+
+%%
+
+/* Programs */
+
+prog:
+    global_declarations proc_list EOF
+      { { prog_funct = CList.rev $2;
+          prog_main = intern_string "main";
+          prog_vars = CList.rev $1; } }
+;
+
+global_declarations:
+    /* empty */                                 { [] }
+  | global_declarations global_declaration      { $2 :: $1 }
+;
+
+global_declaration:
+    VAR STRINGLIT LBRACKET INTLIT RBRACKET
+      { Coq_pair(Coq_pair($2, [ Init_space (z_of_camlint $4) ]), ()) }
+;
+
+proc_list:
+    /* empty */                                 { [] }
+  | proc_list proc                              { $2 :: $1 }
+;
+
+/* Procedures */
+
+proc:
+    STRINGLIT LPAREN parameters RPAREN COLON signature
+    LBRACE
+      stack_declaration
+      var_declarations
+      stmt_list
+    RBRACE
+      { let tmp = !temporaries in
+        temporaries := [];
+        temp_counter := 0;
+        Coq_pair($1,
+        Internal { fn_sig = $6;
+                   fn_params = CList.rev $3;
+                   fn_vars = CList.rev (CList.app tmp $9);
+                   fn_stackspace = $8;
+                   fn_body = $10 }) }
+  | EXTERN STRINGLIT COLON signature 
+      { Coq_pair($2,
+        External { ef_id = $2;
+                   ef_sig = $4 }) }
+;
+
+signature:
+    type_ 
+               { {sig_args = []; sig_res = Some $1} }
+  | VOID
+               { {sig_args = []; sig_res = None} }
+  | type_ MINUSGREATER signature
+               { let s = $3 in {s with sig_args = $1 :: s.sig_args} }
+;
+
+parameters:
+    /* empty */                                 { [] }
+  | parameter_list                              { $1 }
+;
+
+parameter_list:
+    IDENT                                       { $1 :: [] }
+  | parameter_list COMMA IDENT                  { $3 :: $1 }
+;
+
+stack_declaration:
+    /* empty */                                 { Z0 }
+  | STACK INTLIT SEMICOLON                      { z_of_camlint $2 }
+;
+
+var_declarations:
+    /* empty */                                 { [] }
+  | var_declarations var_declaration            { CList.app $2 $1 }
+;
+
+var_declaration:
+    VAR parameter_list SEMICOLON                { $2 }
+;
+
+/* Statements */
+
+stmt:
+    expr SEMICOLON                              { mkeval $1 }
+  | IDENT EQUAL expr SEMICOLON                  { mkassign $1 $3 }
+  | memory_chunk LBRACKET expr RBRACKET EQUAL expr SEMICOLON
+                                                { mkstore $1 $3 $6 }
+  | IF LPAREN expr RPAREN stmts ELSE stmts      { mkifthenelse $3 $5 $7 }
+  | IF LPAREN expr RPAREN stmts                 { mkifthenelse $3 $5 Sskip }
+  | LOOP stmts                                  { Sloop($2) }
+  | LBRACELBRACE stmt_list RBRACERBRACE         { Sblock($2) }
+  | EXIT SEMICOLON                              { Sexit O }
+  | EXIT INTLIT SEMICOLON                       { Sexit (exitnum $2) }
+  | RETURN SEMICOLON                            { Sreturn None }
+  | RETURN expr SEMICOLON                       { mkreturn_some $2 }
+  | SWITCH LPAREN expr RPAREN LBRACE switch_cases RBRACE
+                                                { mkswitch $3 $6 }
+  | MATCH LPAREN expr RPAREN LBRACE match_cases RBRACE
+                                                { mkmatch $3 $6 }
+  | TAILCALL expr LPAREN expr_list RPAREN COLON signature SEMICOLON
+                                                { mktailcall $7 $2 $4 }
+;
+
+stmts:
+    LBRACE stmt_list RBRACE                     { $2 }
+  | stmt                                        { $1 }
+;
+
+stmt_list:
+    /* empty */                                 { Sskip }
+  | stmt stmt_list                              { Sseq($1, $2) }
+;
+
+switch_cases:
+    DEFAULT COLON EXIT INTLIT SEMICOLON
+           { ([], $4) }
+  | CASE INTLIT COLON EXIT INTLIT SEMICOLON switch_cases
+           { let (cases, dfl) = $7 in (($2, $5) :: cases, dfl) }
+;
+
+match_cases:
+    /* empty */                                 { [] }
+  | CASE INTLIT COLON stmt_list match_cases     { ($2, $4) :: $5 }
+;
+
+/* Expressions */
+
+expr:
+    LPAREN expr RPAREN                          { $2 }
+  | IDENT                                       { Rvar $1 }
+  | INTLIT                                      { intconst $1 }
+  | FLOATLIT                                    { Rconst(Ofloatconst $1) }
+  | STRINGLIT                                   { Rconst(Oaddrsymbol($1, Int.zero)) }
+  | AMPERSAND INTLIT                            { Rconst(Oaddrstack(coqint_of_camlint $2)) }
+  | MINUS expr    %prec p_uminus                { Rbinop(Osub, intconst 0l, $2) } /***FIXME***/
+  | MINUSF expr   %prec p_uminus                { Runop(Onegf, $2) }
+  | ABSF expr                                   { Runop(Oabsf, $2) }
+  | INTOFFLOAT expr                             { Runop(Ointoffloat, $2) }
+  | INTUOFFLOAT expr                            { Runop(Ointuoffloat, $2) }
+  | FLOATOFINT expr                             { Runop(Ofloatofint, $2) }
+  | FLOATOFINTU expr                            { Runop(Ofloatofintu, $2) }
+  | TILDE expr                                  { Runop(Onotint, $2) }
+  | BANG expr                                   { Runop(Onotbool, $2) }
+  | INT8S expr                                  { Runop(Ocast8signed, $2) }
+  | INT8U expr                                  { Runop(Ocast8unsigned, $2) }
+  | INT16S expr                                 { Runop(Ocast16signed, $2) }
+  | INT16U expr                                 { Runop(Ocast16unsigned, $2) }
+  | FLOAT32 expr                                { Runop(Osingleoffloat, $2) }
+  | expr PLUS expr                              { Rbinop(Oadd, $1, $3) }
+  | expr MINUS expr                             { Rbinop(Osub, $1, $3) }
+  | expr STAR expr                              { Rbinop(Omul, $1, $3) }
+  | expr SLASH expr                             { Rbinop(Odiv, $1, $3) }
+  | expr PERCENT expr                           { Rbinop(Omod, $1, $3) }
+  | expr SLASHU expr                            { Rbinop(Odivu, $1, $3) }
+  | expr PERCENTU expr                          { Rbinop(Omodu, $1, $3) }
+  | expr AMPERSAND expr                         { Rbinop(Oand, $1, $3) }
+  | expr BAR expr                               { Rbinop(Oor, $1, $3) }
+  | expr CARET expr                             { Rbinop(Oxor, $1, $3) }
+  | expr LESSLESS expr                          { Rbinop(Oshl, $1, $3) }
+  | expr GREATERGREATER expr                    { Rbinop(Oshr, $1, $3) }
+  | expr GREATERGREATERU expr                   { Rbinop(Oshru, $1, $3) }
+  | expr PLUSF expr                             { Rbinop(Oaddf, $1, $3) }
+  | expr MINUSF expr                            { Rbinop(Osubf, $1, $3) }
+  | expr STARF expr                             { Rbinop(Omulf, $1, $3) }
+  | expr SLASHF expr                            { Rbinop(Odivf, $1, $3) }
+  | expr EQUALEQUAL expr                        { Rbinop(Ocmp Ceq, $1, $3) }
+  | expr BANGEQUAL expr                         { Rbinop(Ocmp Cne, $1, $3) }
+  | expr LESS expr                              { Rbinop(Ocmp Clt, $1, $3) }
+  | expr LESSEQUAL expr                         { Rbinop(Ocmp Cle, $1, $3) }
+  | expr GREATER expr                           { Rbinop(Ocmp Cgt, $1, $3) }
+  | expr GREATEREQUAL expr                      { Rbinop(Ocmp Cge, $1, $3) }
+  | expr EQUALEQUALU expr                       { Rbinop(Ocmpu Ceq, $1, $3) }
+  | expr BANGEQUALU expr                        { Rbinop(Ocmpu Cne, $1, $3) }
+  | expr LESSU expr                             { Rbinop(Ocmpu Clt, $1, $3) }
+  | expr LESSEQUALU expr                        { Rbinop(Ocmpu Cle, $1, $3) }
+  | expr GREATERU expr                          { Rbinop(Ocmpu Cgt, $1, $3) }
+  | expr GREATEREQUALU expr                     { Rbinop(Ocmpu Cge, $1, $3) }
+  | expr EQUALEQUALF expr                       { Rbinop(Ocmpf Ceq, $1, $3) }
+  | expr BANGEQUALF expr                        { Rbinop(Ocmpf Cne, $1, $3) }
+  | expr LESSF expr                             { Rbinop(Ocmpf Clt, $1, $3) }
+  | expr LESSEQUALF expr                        { Rbinop(Ocmpf Cle, $1, $3) }
+  | expr GREATERF expr                          { Rbinop(Ocmpf Cgt, $1, $3) }
+  | expr GREATEREQUALF expr                     { Rbinop(Ocmpf Cge, $1, $3) }
+  | memory_chunk LBRACKET expr RBRACKET         { Rload($1, $3) }
+  | expr AMPERSANDAMPERSAND expr                { andbool $1 $3 }
+  | expr BARBAR expr                            { orbool $1 $3 }
+  | expr QUESTION expr COLON expr               { Rcondition($1, $3, $5) }
+  | expr LPAREN expr_list RPAREN COLON signature{ Rcall($6, $1, $3) }
+  | ALLOC expr                                  { Ralloc $2 }
+;
+
+expr_list:
+    /* empty */                                 { [] }
+  | expr_list_1                                 { $1 }
+;
+
+expr_list_1:
+    expr                     %prec COMMA        { $1 :: [] }
+  | expr COMMA expr_list_1                      { $1 :: $3 }
+;
+
+memory_chunk:
+    INT8S                                       { Mint8signed }
+  | INT8U                                       { Mint8unsigned }
+  | INT16S                                      { Mint16signed }
+  | INT16U                                      { Mint16unsigned }
+  | INT32                                       { Mint32 }
+  | INT                                         { Mint32 }
+  | FLOAT32                                     { Mfloat32 }
+  | FLOAT64                                     { Mfloat64 }
+  | FLOAT                                       { Mfloat64 }
+;
+
+/* Types */
+
+type_:
+    INT                                         { Tint }
+  | FLOAT                                       { Tfloat }
+;
diff --git a/backend/CMtypecheck.ml b/backend/CMtypecheck.ml
new file mode 100644
index 00000000..d761f759
--- /dev/null
+++ b/backend/CMtypecheck.ml
@@ -0,0 +1,370 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* A type-checker for Cminor *)
+
+open Printf
+open Datatypes
+open CList
+open Camlcoq
+open AST
+open Integers
+open Cminor
+
+exception Error of string
+
+let name_of_typ = function Tint -> "int" | Tfloat -> "float"
+
+type ty = Base of typ | Var of ty option ref
+
+let newvar () = Var (ref None)
+let tint = Base Tint
+let tfloat = Base Tfloat
+
+let ty_of_typ = function Tint -> tint | Tfloat -> tfloat
+
+let ty_of_sig_args tyl = List.map ty_of_typ tyl
+
+let rec repr t =
+  match t with
+  | Base _ -> t
+  | Var r -> match !r with None -> t | Some t' -> repr t'
+
+let unify t1 t2 =
+  match (repr t1, repr t2) with
+  | Base b1, Base b2 ->
+      if b1 <> b2 then
+        raise (Error (sprintf "Expected type %s, actual type %s\n"
+                              (name_of_typ b1) (name_of_typ b2)))
+  | Base b, Var r -> r := Some (Base b)
+  | Var r, Base b -> r := Some (Base b)
+  | Var r1, Var r2 -> r1 := Some (Var r2)
+
+let unify_list l1 l2 =
+  let ll1 = List.length l1 and ll2 = List.length l2 in
+  if ll1 <> ll2 then
+    raise (Error (sprintf "Arity mismatch: expected %d, actual %d\n" ll1 ll2));
+  List.iter2 unify l1 l2
+
+let type_var env id =
+  try
+    List.assoc id env
+  with Not_found ->
+    raise (Error (sprintf "Unbound variable %s\n" (extern_atom id)))
+
+let type_letvar env n =
+  let n = camlint_of_nat n in
+  try
+    List.nth env n
+  with Not_found ->
+    raise (Error (sprintf "Unbound let variable #%d\n" n))
+
+let name_of_comparison = function
+  | Ceq -> "eq"
+  | Cne -> "ne"
+  | Clt -> "lt"
+  | Cle -> "le"
+  | Cgt -> "gt"
+  | Cge -> "ge"
+
+let type_constant = function
+  | Ointconst _ -> tint
+  | Ofloatconst _ -> tfloat
+  | Oaddrsymbol _ -> tint
+  | Oaddrstack _ -> tint
+
+let type_unary_operation = function
+  | Ocast8signed -> tint, tint
+  | Ocast16signed -> tint, tint
+  | Ocast8unsigned -> tint, tint
+  | Ocast16unsigned -> tint, tint
+  | Onegint -> tint, tint
+  | Onotbool -> tint, tint
+  | Onotint -> tint, tint
+  | Onegf -> tfloat, tfloat
+  | Oabsf -> tfloat, tfloat
+  | Osingleoffloat -> tfloat, tfloat
+  | Ointoffloat -> tfloat, tint
+  | Ointuoffloat -> tfloat, tint
+  | Ofloatofint -> tint, tfloat
+  | Ofloatofintu -> tint, tfloat
+
+let type_binary_operation = function
+  | Oadd -> tint, tint, tint
+  | Osub -> tint, tint, tint
+  | Omul -> tint, tint, tint
+  | Odiv -> tint, tint, tint
+  | Odivu -> tint, tint, tint
+  | Omod -> tint, tint, tint
+  | Omodu -> tint, tint, tint
+  | Oand -> tint, tint, tint
+  | Oor -> tint, tint, tint
+  | Oxor -> tint, tint, tint
+  | Oshl -> tint, tint, tint
+  | Oshr -> tint, tint, tint
+  | Oshru -> tint, tint, tint
+  | Oaddf -> tfloat, tfloat, tfloat
+  | Osubf -> tfloat, tfloat, tfloat
+  | Omulf -> tfloat, tfloat, tfloat
+  | Odivf -> tfloat, tfloat, tfloat
+  | Ocmp _ -> tint, tint, tint
+  | Ocmpu _ -> tint, tint, tint
+  | Ocmpf _ -> tfloat, tfloat, tint
+
+let name_of_constant = function
+  | Ointconst n -> sprintf "intconst %ld" (camlint_of_coqint n)
+  | Ofloatconst n -> sprintf "floatconst %g" n
+  | Oaddrsymbol (s, ofs) -> sprintf "addrsymbol %s %ld" (extern_atom s) (camlint_of_coqint ofs)
+  | Oaddrstack n -> sprintf "addrstack %ld" (camlint_of_coqint n)
+
+let name_of_unary_operation = function
+  | Ocast8signed -> "cast8signed"
+  | Ocast16signed -> "cast16signed"
+  | Ocast8unsigned -> "cast8unsigned"
+  | Ocast16unsigned -> "cast16unsigned"
+  | Onegint -> "negint"
+  | Onotbool -> "notbool"
+  | Onotint -> "notint"
+  | Onegf -> "negf"
+  | Oabsf -> "absf"
+  | Osingleoffloat -> "singleoffloat"
+  | Ointoffloat -> "intoffloat"
+  | Ointuoffloat -> "intuoffloat"
+  | Ofloatofint -> "floatofint"
+  | Ofloatofintu -> "floatofintu"
+
+let name_of_binary_operation = function
+  | Oadd -> "add"
+  | Osub -> "sub"
+  | Omul -> "mul"
+  | Odiv -> "div"
+  | Odivu -> "divu"
+  | Omod -> "mod"
+  | Omodu -> "modu"
+  | Oand -> "and"
+  | Oor -> "or"
+  | Oxor -> "xor"
+  | Oshl -> "shl"
+  | Oshr -> "shr"
+  | Oshru -> "shru"
+  | Oaddf -> "addf"
+  | Osubf -> "subf"
+  | Omulf -> "mulf"
+  | Odivf -> "divf"
+  | Ocmp c -> sprintf "cmp %s" (name_of_comparison c)
+  | Ocmpu c -> sprintf "cmpu %s" (name_of_comparison c)
+  | Ocmpf c -> sprintf "cmpf %s" (name_of_comparison c)
+
+let type_chunk = function
+  | Mint8signed -> tint
+  | Mint8unsigned -> tint
+  | Mint16signed -> tint
+  | Mint16unsigned -> tint
+  | Mint32 -> tint
+  | Mfloat32 -> tfloat
+  | Mfloat64 -> tfloat
+
+let name_of_chunk = function
+  | Mint8signed -> "int8signed"
+  | Mint8unsigned -> "int8unsigned"
+  | Mint16signed -> "int16signed"
+  | Mint16unsigned -> "int16unsigned"
+  | Mint32 -> "int32"
+  | Mfloat32 -> "float32"
+  | Mfloat64 -> "float64"
+
+let rec type_expr env lenv e =
+  match e with
+  | Evar id ->
+      type_var env id
+  | Econst cst ->
+      type_constant cst
+  | Eunop(op, e1) ->
+      let te1 = type_expr env lenv e1 in
+      let (targ, tres) = type_unary_operation op in
+      begin try
+        unify targ te1
+      with Error s ->
+        raise (Error (sprintf "In application of operator %s:\n%s"
+                              (name_of_unary_operation op) s))
+      end;
+      tres
+  | Ebinop(op, e1, e2) ->
+      let te1 = type_expr env lenv e1 in
+      let te2 = type_expr env lenv e2 in
+      let (targ1, targ2, tres) = type_binary_operation op in
+      begin try
+        unify targ1 te1; unify targ2 te2
+      with Error s ->
+        raise (Error (sprintf "In application of operator %s:\n%s"
+                              (name_of_binary_operation op) s))
+      end;
+      tres
+  | Eload(chunk, e) ->
+      let te = type_expr env lenv e in
+      begin try
+        unify tint te
+      with Error s ->
+        raise (Error (sprintf "In load %s:\n%s"
+                              (name_of_chunk chunk) s))
+      end;
+      type_chunk chunk
+  | Econdition(e1, e2, e3) ->
+      type_condexpr env lenv e1;
+      let te2 = type_expr env lenv e2 in
+      let te3 = type_expr env lenv e3 in
+      begin try
+        unify te2 te3
+      with Error s ->
+        raise (Error (sprintf "In conditional expression:\n%s" s))
+      end;
+      te2
+(*
+  | Elet(e1, e2) ->
+      let te1 = type_expr env lenv e1 in
+      let te2 = type_expr env (te1 :: lenv) e2 in
+      te2
+  | Eletvar n ->
+      type_letvar lenv n
+*)
+
+and type_exprlist env lenv el =
+  match el with
+  | [] -> []
+  | e1 :: et ->
+      let te1 = type_expr env lenv e1 in
+      let tet = type_exprlist env lenv et in
+      (te1 :: tet)
+
+and type_condexpr env lenv e =
+  let te = type_expr env lenv e in
+  begin try
+    unify tint te
+  with Error s ->
+    raise (Error (sprintf "In condition:\n%s" s))
+  end
+
+let rec type_stmt env blk ret s =
+  match s with
+  | Sskip -> ()
+  | Sassign(id, e1) ->
+      let tid = type_var env id in
+      let te1 = type_expr env [] e1 in
+      begin try
+        unify tid te1
+      with Error s ->
+        raise (Error (sprintf "In assignment to %s:\n%s" (extern_atom id) s))
+      end
+  | Sstore(chunk, e1, e2) ->
+      let te1 = type_expr env [] e1 in
+      let te2 = type_expr env [] e2 in
+      begin try
+        unify tint te1;
+        unify (type_chunk chunk) te2
+      with Error s ->
+        raise (Error (sprintf "In store %s:\n%s"
+                              (name_of_chunk chunk) s))
+      end
+  | Scall(optid, sg, e1, el) ->
+      let te1 = type_expr env [] e1 in
+      let tel = type_exprlist env [] el in
+      begin try
+        unify tint te1;
+        unify_list (ty_of_sig_args sg.sig_args) tel;
+        let ty_res =
+          match sg.sig_res with
+          | None -> tint (*???*)
+          | Some t -> ty_of_typ t in
+        begin match optid with
+        | None -> ()
+        | Some id -> unify (type_var env id) ty_res
+        end
+      with Error s ->
+        raise (Error (sprintf "In call:\n%s" s))
+      end
+  | Salloc(id, e) ->
+      let tid = type_var env id in
+      let te = type_expr env [] e in
+      begin try
+        unify tint te;
+        unify tint tid
+      with Error s ->
+        raise (Error (sprintf "In alloc:\n%s" s))
+      end
+  | Sseq(s1, s2) ->
+      type_stmt env blk ret s1;
+      type_stmt env blk ret s2
+  | Sifthenelse(ce, s1, s2) ->
+      type_condexpr env [] ce;
+      type_stmt env blk ret s1;
+      type_stmt env blk ret s2
+  | Sloop s1 ->
+      type_stmt env blk ret s1
+  | Sblock s1 ->
+      type_stmt env (blk + 1) ret s1
+  | Sexit n ->
+      if camlint_of_nat n >= blk then
+        raise (Error (sprintf "Bad exit(%d)\n" (camlint_of_nat n)))
+  | Sswitch(e, cases, deflt) ->
+      unify (type_expr env [] e) tint
+  | Sreturn None ->
+      begin match ret with
+      | None -> ()
+      | Some tret -> raise (Error ("return without argument"))
+      end
+  | Sreturn (Some e) ->
+      begin match ret with
+      | None -> raise (Error "return with argument")
+      | Some tret -> 
+          begin try
+            unify (type_expr env [] e) (ty_of_typ tret)
+          with Error s ->
+            raise (Error (sprintf "In return:\n%s" s))
+          end
+      end
+  | Stailcall(sg, e1, el) ->
+      let te1 = type_expr env [] e1 in
+      let tel = type_exprlist env [] el in
+      begin try
+        unify tint te1;
+        unify_list (ty_of_sig_args sg.sig_args) tel
+      with Error s ->
+        raise (Error (sprintf "In tail call:\n%s" s))
+      end
+  | Slabel(lbl, s1) ->
+      type_stmt env blk ret s1
+  | Sgoto lbl ->
+      ()
+
+let rec env_of_vars idl =
+  match idl with
+  | [] -> []
+  | id1 :: idt -> (id1, newvar()) :: env_of_vars idt
+
+let type_function id f =
+  try
+    type_stmt
+       (env_of_vars f.fn_vars @ env_of_vars f.fn_params)
+       0 f.fn_sig.sig_res f.fn_body
+  with Error s ->
+    raise (Error (sprintf "In function %s:\n%s" (extern_atom id) s))
+
+let type_fundef (Coq_pair (id, fd)) =
+  match fd with
+  | Internal f -> type_function id f
+  | External ef -> ()
+
+let type_program p =
+  List.iter type_fundef p.prog_funct; p
diff --git a/backend/CMtypecheck.mli b/backend/CMtypecheck.mli
new file mode 100644
index 00000000..44c76544
--- /dev/null
+++ b/backend/CMtypecheck.mli
@@ -0,0 +1,19 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+exception Error of string
+
+val type_program: Cminor.program -> Cminor.program
+
diff --git a/backend/CSE.v b/backend/CSE.v
index b7e19c1b..49b84899 100644
--- a/backend/CSE.v
+++ b/backend/CSE.v
@@ -72,12 +72,9 @@ Definition eq_rhs (x y: rhs) : {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.
-  assert (forall (x y: operation), {x=y}+{x<>y}). decide equality.
+  generalize eq_operation; intro.
+  generalize eq_addressing; intro.
   assert (forall (x y: memory_chunk), {x=y}+{x<>y}). decide equality.
-  assert (forall (x y: addressing), {x=y}+{x<>y}). decide equality.
   generalize eq_valnum; intro.
   generalize eq_list_valnum; intro.
   decide equality.
diff --git a/backend/Coloringaux.ml b/backend/Coloringaux.ml
new file mode 100644
index 00000000..19efe434
--- /dev/null
+++ b/backend/Coloringaux.ml
@@ -0,0 +1,626 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+open Camlcoq
+open Datatypes
+open BinPos
+open BinInt
+open AST
+open Maps
+open Registers
+open Machregs
+open Locations
+open RTL
+open RTLtyping
+open InterfGraph
+open Conventions
+
+(* George-Appel graph coloring *)
+
+(* \subsection{Internal representation of the interference graph} *)
+
+(* To implement George-Appel coloring, we first transform the representation
+   of the interference graph, switching to the following 
+   imperative representation that is well suited to the coloring algorithm. *)
+
+(* Each node of the graph (i.e. each pseudo-register) is represented as
+   follows. *)
+
+type node =
+  { ident: reg;                         (*r register identifier *)
+    typ: typ;                           (*r its type *)
+    regclass: int;                      (*r identifier of register class *)
+    spillcost: float;                   (*r estimated cost of spilling *)
+    mutable adjlist: node list;         (*r all nodes it interferes with *)
+    mutable degree: int;                (*r number of adjacent nodes *)
+    mutable movelist: move list;        (*r list of moves it is involved in *)
+    mutable alias: node option;         (*r [Some n] if coalesced with [n] *)
+    mutable color: loc option;          (*r chosen color *)
+    mutable nstate: nodestate;          (*r in which set of nodes it is *)
+    mutable nprev: node;                (*r for double linking *)
+    mutable nnext: node                 (*r for double linking *)
+  }
+
+(* These are the possible states for nodes. *)
+
+and nodestate =
+  | Colored
+  | Initial
+  | SimplifyWorklist
+  | FreezeWorklist
+  | SpillWorklist
+  | CoalescedNodes
+  | SelectStack
+
+(* Each move (i.e. wish to be put in the same location) is represented
+   as follows. *)
+
+and move =
+  { src: node;                          (*r source of the move *)
+    dst: node;                          (*r destination of the move *)
+    mutable mstate: movestate;          (*r in which set of moves it is *)
+    mutable mprev: move;                (*r for double linking *)
+    mutable mnext: move                 (*r for double linking *)
+  }
+
+(* These are the possible states for moves *)
+
+and movestate =
+  | CoalescedMoves
+  | ConstrainedMoves
+  | FrozenMoves
+  | WorklistMoves
+  | ActiveMoves
+
+(* The algorithm manipulates partitions of the nodes and of the moves
+   according to their states, frequently moving a node or a move from
+   a state to another, and frequently enumerating all nodes or all moves
+   of a given state.  To support these operations efficiently,
+   nodes or moves having the same state are put into imperative doubly-linked
+   lists, allowing for constant-time insertion and removal, and linear-time
+   scanning.  We now define the operations over these doubly-linked lists. *)
+
+module DLinkNode = struct
+  type t = node
+  let make state =
+    let rec empty =
+      { ident = Coq_xH; typ = Tint; regclass = 0;
+        adjlist = []; degree = 0; spillcost = 0.0;
+        movelist = []; alias = None; color = None;
+        nstate = state; nprev = empty; nnext = empty }
+    in empty
+  let dummy = make Colored
+  let clear dl = dl.nnext <- dl; dl.nprev <- dl
+  let notempty dl = dl.nnext != dl
+  let insert n dl =
+    n.nstate <- dl.nstate;
+    n.nnext <- dl.nnext; n.nprev <- dl;
+    dl.nnext.nprev <- n; dl.nnext <- n
+  let remove n dl =
+    assert (n.nstate = dl.nstate);
+    n.nnext.nprev <- n.nprev; n.nprev.nnext <- n.nnext
+  let move n dl1 dl2 =
+    remove n dl1; insert n dl2
+  let pick dl =
+    let n = dl.nnext in remove n dl; n
+  let iter f dl =
+    let rec iter n = if n != dl then (f n; iter n.nnext)
+    in iter dl.nnext
+  let fold f dl accu =
+    let rec fold n accu = if n == dl then accu else fold n.nnext (f n accu)
+    in fold dl.nnext accu
+end
+
+module DLinkMove = struct
+  type t = move
+  let make state =
+    let rec empty =
+      { src = DLinkNode.dummy; dst = DLinkNode.dummy; 
+        mstate = state; mprev = empty; mnext = empty }
+    in empty
+  let dummy = make CoalescedMoves
+  let clear dl = dl.mnext <- dl; dl.mprev <- dl
+  let notempty dl = dl.mnext != dl
+  let insert m dl =
+    m.mstate <- dl.mstate;
+    m.mnext <- dl.mnext; m.mprev <- dl;
+    dl.mnext.mprev <- m; dl.mnext <- m
+  let remove m dl =
+    assert (m.mstate = dl.mstate);
+    m.mnext.mprev <- m.mprev; m.mprev.mnext <- m.mnext
+  let move m dl1 dl2 =
+    remove m dl1; insert m dl2
+  let pick dl =
+    let m = dl.mnext in remove m dl; m
+  let iter f dl =
+    let rec iter m = if m != dl then (f m; iter m.mnext)
+    in iter dl.mnext
+  let fold f dl accu =
+    let rec fold m accu = if m == dl then accu else fold m.mnext (f m accu)
+    in fold dl.mnext accu
+end
+
+(* \subsection{The George-Appel algorithm} *)
+
+(* Below is a straigthforward translation of the pseudo-code at the end
+   of the TOPLAS article by George and Appel.  Two bugs were fixed
+   and are marked as such.  Please refer to the article for explanations. *)
+
+(* Low-degree, non-move-related nodes *)
+let simplifyWorklist = DLinkNode.make SimplifyWorklist
+
+(* Low-degree, move-related nodes *)
+let freezeWorklist = DLinkNode.make FreezeWorklist
+
+(* High-degree nodes *)
+let spillWorklist = DLinkNode.make SpillWorklist
+
+(* Nodes that have been coalesced *)
+let coalescedNodes = DLinkNode.make CoalescedNodes
+
+(* Moves that have been coalesced *)
+let coalescedMoves = DLinkMove.make CoalescedMoves
+
+(* Moves whose source and destination interfere *)
+let constrainedMoves = DLinkMove.make ConstrainedMoves
+
+(* Moves that will no longer be considered for coalescing *)
+let frozenMoves = DLinkMove.make FrozenMoves
+
+(* Moves enabled for possible coalescing *)
+let worklistMoves = DLinkMove.make WorklistMoves
+
+(* Moves not yet ready for coalescing *)
+let activeMoves = DLinkMove.make ActiveMoves
+
+(* Initialization of all global data structures *)
+
+let init() =
+  DLinkNode.clear simplifyWorklist;
+  DLinkNode.clear freezeWorklist;
+  DLinkNode.clear spillWorklist;
+  DLinkNode.clear coalescedNodes;
+  DLinkMove.clear coalescedMoves;
+  DLinkMove.clear frozenMoves;
+  DLinkMove.clear worklistMoves;
+  DLinkMove.clear activeMoves
+
+(* Determine if two nodes interfere *)
+
+let interfere n1 n2 =
+  if n1.degree < n2.degree
+  then List.memq n2 n1.adjlist
+  else List.memq n1 n2.adjlist
+
+(* Add an edge to the graph.  Assume edge is not in graph already *)
+
+let addEdge n1 n2 =
+  n1.adjlist <- n2 :: n1.adjlist;
+  n1.degree  <- 1 + n1.degree;
+  n2.adjlist <- n1 :: n2.adjlist;
+  n2.degree  <- 1 + n2.degree
+
+(* Apply the given function to the relevant adjacent nodes of a node *)
+
+let iterAdjacent f n =
+  List.iter
+    (fun n ->
+      match n.nstate with
+      | SelectStack | CoalescedNodes -> ()
+      | _ -> f n)
+    n.adjlist
+
+(* Determine the moves affecting a node *)
+
+let moveIsActiveOrWorklist m =
+  match m.mstate with
+  | ActiveMoves | WorklistMoves -> true
+  | _ -> false
+
+let nodeMoves n =
+  List.filter moveIsActiveOrWorklist n.movelist
+
+(* Determine whether a node is involved in a move *)
+
+let moveRelated n =
+  List.exists moveIsActiveOrWorklist n.movelist
+
+(*i
+(* Check invariants *)
+
+let degreeInvariant n =
+  let c = ref 0 in
+  iterAdjacent (fun n -> incr c) n;
+  if !c <> n.degree then
+    fatal_error("degree invariant violated by " ^ name_of_node n)
+
+let simplifyWorklistInvariant n =
+  if n.degree < num_available_registers.(n.regclass)
+  && not (moveRelated n)
+  then ()
+  else fatal_error("simplify worklist invariant violated by " ^ name_of_node n)
+
+let freezeWorklistInvariant n =
+  if n.degree < num_available_registers.(n.regclass)
+  && moveRelated n
+  then ()
+  else fatal_error("freeze worklist invariant violated by " ^ name_of_node n)
+
+let spillWorklistInvariant n =
+  if n.degree >= num_available_registers.(n.regclass)
+  then ()
+  else fatal_error("spill worklist invariant violated by " ^ name_of_node n)
+
+let checkInvariants () =
+  DLinkNode.iter
+    (fun n -> degreeInvariant n; simplifyWorklistInvariant n)
+    simplifyWorklist;
+  DLinkNode.iter
+    (fun n -> degreeInvariant n; freezeWorklistInvariant n)
+    freezeWorklist;
+  DLinkNode.iter
+    (fun n -> degreeInvariant n; spillWorklistInvariant n)
+    spillWorklist
+i*)
+
+(* Register classes *)
+
+let class_of_type = function Tint -> 0 | Tfloat -> 1
+
+let num_register_classes = 2
+
+let caller_save_registers = [|
+  Array.of_list Conventions.int_caller_save_regs;
+  Array.of_list Conventions.float_caller_save_regs
+|]
+
+let callee_save_registers = [|
+  Array.of_list Conventions.int_callee_save_regs;
+  Array.of_list Conventions.float_callee_save_regs
+|]
+
+let num_available_registers = 
+  [| Array.length caller_save_registers.(0)
+           + Array.length callee_save_registers.(0);
+     Array.length caller_save_registers.(1)
+           + Array.length callee_save_registers.(1) |]
+
+(* Build the internal representation of the graph *)
+
+let nodeOfReg r typenv spillcosts =
+  let ty = typenv r in
+  { ident = r; typ = ty; regclass = class_of_type ty;
+    spillcost = (try float(Hashtbl.find spillcosts r) with Not_found -> 0.0);
+    adjlist = []; degree = 0; movelist = []; alias = None;
+    color = None;
+    nstate = Initial;
+    nprev = DLinkNode.dummy; nnext = DLinkNode.dummy }
+
+let nodeOfMreg mr =
+  let ty = mreg_type mr in
+  { ident = Coq_xH; typ = ty; regclass = class_of_type ty;
+    spillcost = 0.0;
+    adjlist = []; degree = 0; movelist = []; alias = None;
+    color = Some (R mr);
+    nstate = Colored;
+    nprev = DLinkNode.dummy; nnext = DLinkNode.dummy }
+
+let build g typenv spillcosts =
+  (* Associate an internal node to each pseudo-register and each location *)
+  let reg_mapping = Hashtbl.create 27
+  and mreg_mapping = Hashtbl.create 27 in
+  let find_reg_node r =
+    try
+      Hashtbl.find reg_mapping r
+    with Not_found ->
+      let n = nodeOfReg r typenv spillcosts in
+      Hashtbl.add reg_mapping r n;
+      n
+  and find_mreg_node mr =
+    try
+      Hashtbl.find mreg_mapping mr
+    with Not_found ->
+      let n = nodeOfMreg mr in
+      Hashtbl.add mreg_mapping mr n;
+      n in
+  (* Fill the adjacency lists and compute the degrees. *)
+  SetRegReg.fold
+    (fun (Coq_pair(r1, r2)) () ->
+      addEdge (find_reg_node r1) (find_reg_node r2))
+    g.interf_reg_reg ();
+  SetRegMreg.fold
+    (fun (Coq_pair(r1, mr2)) () ->
+      addEdge (find_reg_node r1) (find_mreg_node mr2))
+    g.interf_reg_mreg ();
+  (* Process the moves and insert them in worklistMoves *)
+  let add_move n1 n2 =
+    let m =
+      { src = n1; dst = n2; mstate = WorklistMoves;
+        mnext = DLinkMove.dummy; mprev = DLinkMove.dummy } in
+    n1.movelist <- m :: n1.movelist;
+    n2.movelist <- m :: n2.movelist;
+    DLinkMove.insert m worklistMoves in
+  SetRegReg.fold
+    (fun (Coq_pair(r1, r2)) () ->
+      add_move (find_reg_node r1) (find_reg_node r2))
+    g.pref_reg_reg ();
+  SetRegMreg.fold
+    (fun (Coq_pair(r1, mr2)) () ->
+      add_move (find_reg_node r1) (find_mreg_node mr2))
+    g.pref_reg_mreg ();
+  (* Initial partition of nodes into spill / freeze / simplify *)
+  Hashtbl.iter
+    (fun r n ->
+      assert (n.nstate = Initial);
+      let k = num_available_registers.(n.regclass) in
+      if n.degree >= k then
+        DLinkNode.insert n spillWorklist
+      else if moveRelated n then
+        DLinkNode.insert n freezeWorklist
+      else
+        DLinkNode.insert n simplifyWorklist)
+    reg_mapping;
+  reg_mapping
+
+(* Enable moves that have become low-degree related *)
+
+let enableMoves n =
+  List.iter
+    (fun m ->
+      if m.mstate = ActiveMoves
+      then DLinkMove.move m activeMoves worklistMoves)
+    (nodeMoves n)
+
+(* Simulate the removal of a node from the graph *)
+
+let decrementDegree n =
+  let k = num_available_registers.(n.regclass) in
+  let d = n.degree in
+  n.degree <- d - 1;
+  if d = k then begin
+    enableMoves n;
+    iterAdjacent enableMoves n;
+    if n.nstate <> Colored then begin
+      if moveRelated n
+      then DLinkNode.move n spillWorklist freezeWorklist
+      else DLinkNode.move n spillWorklist simplifyWorklist
+    end
+  end
+
+(* Simulate the effect of combining nodes [n1] and [n3] on [n2],
+   where [n2] is a node adjacent to [n3]. *)
+
+let combineEdge n1 n2 =
+  assert (n1 != n2);
+  if interfere n1 n2 then begin
+    decrementDegree n2
+  end else begin
+    n1.adjlist <- n2 :: n1.adjlist;
+    n2.adjlist <- n1 :: n2.adjlist;
+    n1.degree  <- n1.degree + 1
+  end
+
+(* Simplification of a low-degree node *)
+
+let simplify () =
+  let n = DLinkNode.pick simplifyWorklist in
+  (*i Printf.printf "Simplifying %s\n" (name_of_node n); i*)
+  n.nstate <- SelectStack;
+  iterAdjacent decrementDegree n;
+  n
+
+(* Briggs' conservative coalescing criterion *)
+
+let canConservativelyCoalesce n1 n2 =
+  let seen = ref Regset.empty in
+  let k = num_available_registers.(n1.regclass) in
+  let c = ref 0 in
+  let consider n =
+    if not (Regset.mem n.ident !seen) then begin
+      seen := Regset.add n.ident !seen;
+      if n.degree >= k then incr c
+    end in
+  iterAdjacent consider n1;
+  iterAdjacent consider n2;
+  !c < k
+
+(* Update worklists after a move was processed *)
+
+let addWorkList u =
+  if (not (u.nstate = Colored))
+  && u.degree < num_available_registers.(u.regclass)
+  && (not (moveRelated u))
+  then DLinkNode.move u freezeWorklist simplifyWorklist
+
+(* Return the canonical representative of a possibly coalesced node *)
+
+let rec getAlias n =
+  match n.alias with None -> n | Some n' -> getAlias n'
+
+(* Combine two nodes *)
+
+let combine u v =
+  (*i Printf.printf "Combining %s and %s\n" (name_of_node u) (name_of_node v); i*)
+  if v.nstate = FreezeWorklist
+  then DLinkNode.move v freezeWorklist coalescedNodes
+  else DLinkNode.move v spillWorklist coalescedNodes;
+  v.alias <- Some u;
+  u.movelist <- u.movelist @ v.movelist;
+  iterAdjacent (combineEdge u) v;  (*r original code using [decrementDegree] is buggy *)
+  enableMoves v;                   (*r added as per Appel's book erratum *)
+  if u.degree >= num_available_registers.(u.regclass)
+  && u.nstate = FreezeWorklist
+  then DLinkNode.move u freezeWorklist spillWorklist
+
+(* Attempt coalescing *)
+
+let coalesce () =
+  let m = DLinkMove.pick worklistMoves in
+  let x = getAlias m.src and y = getAlias m.dst in
+  let (u, v) = if y.nstate = Colored then (y, x) else (x, y) in
+  if u == v then begin
+    DLinkMove.insert m coalescedMoves;
+    addWorkList u
+  end else if v.nstate = Colored || interfere u v then begin
+    DLinkMove.insert m constrainedMoves;
+    addWorkList u;
+    addWorkList v
+  end else if canConservativelyCoalesce u v then begin
+    DLinkMove.insert m coalescedMoves;
+    combine u v;
+    addWorkList u
+  end else begin
+    DLinkMove.insert m activeMoves    
+  end
+
+(* Freeze moves associated with node [u] *)
+
+let freezeMoves u =
+  let au = getAlias u in
+  let freeze m =
+    let y = getAlias m.src in
+    let v = if y == au then getAlias m.dst else y in
+    DLinkMove.move m activeMoves frozenMoves;
+    if not (moveRelated v)
+    && v.degree < num_available_registers.(v.regclass)
+    && v.nstate <> Colored
+    then DLinkNode.move v freezeWorklist simplifyWorklist in
+  List.iter freeze (nodeMoves u)
+
+(* Pick a move and freeze it *)
+
+let freeze () =
+  let u = DLinkNode.pick freezeWorklist in
+  (*i Printf.printf "Freezing %s\n" (name_of_node u); i*)
+  DLinkNode.insert u simplifyWorklist;
+  freezeMoves u
+
+(* Chaitin's cost measure *)
+
+let spillCost n = n.spillcost /. float n.degree
+
+(* Spill a node *)
+
+let selectSpill () =
+  (* Find a spillable node of minimal cost *)
+  let (n, cost) =
+    DLinkNode.fold
+      (fun n (best_node, best_cost as best) ->
+        let cost = spillCost n in
+        if cost < best_cost then (n, cost) else best)
+      spillWorklist (DLinkNode.dummy, infinity) in
+  assert (n != DLinkNode.dummy);
+  DLinkNode.remove n spillWorklist;
+  (*i Printf.printf "Spilling %s\n" (name_of_node n); i*)
+  freezeMoves n;
+  n.nstate <- SelectStack;
+  iterAdjacent decrementDegree n;
+  n
+
+(* Produce the order of nodes that we'll use for coloring *)
+
+let rec nodeOrder stack =
+  (*i checkInvariants(); i*)
+  if DLinkNode.notempty simplifyWorklist then
+    (let n = simplify() in nodeOrder (n :: stack))
+  else if DLinkMove.notempty worklistMoves then
+    (coalesce(); nodeOrder stack)
+  else if DLinkNode.notempty freezeWorklist then
+    (freeze(); nodeOrder stack)
+  else if DLinkNode.notempty spillWorklist then
+    (let n = selectSpill() in nodeOrder (n :: stack))
+  else
+    stack
+
+(* Assign a color (i.e. a hardware register or a stack location)
+   to a node.  The color is chosen among the colors that are not
+   assigned to nodes with which this node interferes.  The choice
+   is guided by the following heuristics: consider first caller-save
+   hardware register of the correct type; second, callee-save registers;
+   third, a stack location.  Callee-save registers and stack locations
+   are ``expensive'' resources, so we try to minimize their number
+   by picking the smallest available callee-save register or stack location.
+   In contrast, caller-save registers are ``free'', so we pick an
+   available one pseudo-randomly. *)
+
+module Locset =
+  Set.Make(struct type t = loc let compare = compare end)
+
+let start_points = Array.make num_register_classes 0
+
+let find_reg conflicts regclass =
+  let rec find avail curr last =
+    if curr >= last then None else begin
+      let l = R avail.(curr) in
+      if Locset.mem l conflicts
+      then find avail (curr + 1) last
+      else Some l
+    end in
+  let caller_save = caller_save_registers.(regclass)
+  and callee_save = callee_save_registers.(regclass)
+  and start = start_points.(regclass) in
+  match find caller_save start (Array.length caller_save) with
+  | Some _ as res ->
+      start_points.(regclass) <-
+        (if start + 1 < Array.length caller_save then start + 1 else 0);
+      res
+  | None ->
+      match find caller_save 0 start with
+      | Some _ as res ->
+          start_points.(regclass) <-
+            (if start + 1 < Array.length caller_save then start + 1 else 0);
+          res
+      | None ->
+          find callee_save 0 (Array.length callee_save)
+
+let find_slot conflicts typ =
+  let rec find curr =
+    let l = S(Local(curr, typ)) in
+    if Locset.mem l conflicts then find (coq_Zsucc curr) else l
+  in find Z0
+
+let assign_color n =
+  let conflicts = ref Locset.empty in
+  List.iter
+    (fun n' ->
+      match (getAlias n').color with
+      | None -> ()
+      | Some l -> conflicts := Locset.add l !conflicts)
+    n.adjlist;
+  match find_reg !conflicts n.regclass with
+  | Some loc ->
+      n.color <- Some loc
+  | None ->
+      n.color <- Some (find_slot !conflicts n.typ)
+
+(* Extract the location of a node *)
+
+let location_of_node n =
+  match n.color with
+  | None -> assert false
+  | Some loc -> loc
+
+(* Estimate spilling costs - TODO *)
+
+let spill_costs f = Hashtbl.create 7
+
+(* This is the entry point for graph coloring. *)
+
+let graph_coloring (f: coq_function) (g: graph) (env: regenv) (regs: Regset.t)
+                   : (reg -> loc) =
+  init();
+  Array.fill start_points 0 num_register_classes 0;
+  let mapping = build g env (spill_costs f) in
+  List.iter assign_color (nodeOrder []);
+  fun r ->
+    try location_of_node (getAlias (Hashtbl.find mapping r))
+    with Not_found -> R IT1 (* any location *)
diff --git a/backend/Coloringaux.mli b/backend/Coloringaux.mli
new file mode 100644
index 00000000..c5070f20
--- /dev/null
+++ b/backend/Coloringaux.mli
@@ -0,0 +1,20 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+open Registers
+open Locations
+open RTL
+open RTLtyping
+open InterfGraph
+
+val graph_coloring:
+  coq_function -> graph -> regenv -> Regset.t -> (reg -> loc)
diff --git a/backend/Constprop.v b/backend/Constprop.v
deleted file mode 100644
index 75fb1486..00000000
--- a/backend/Constprop.v
+++ /dev/null
@@ -1,1093 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** Constant propagation over RTL.  This is the first of the two
-  optimizations performed at RTL level.  It proceeds by a standard
-  dataflow analysis and the corresponding code transformation. *)
-
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Globalenvs.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
-Require Import Lattice.
-Require Import Kildall.
-
-(** * 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 : Set :=
-  | 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 equip this set of approximations with a semi-lattice structure.
-  The ordering is inclusion between the sets of values denoted by
-  the approximations. *)
-
-Module Approx <: SEMILATTICE_WITH_TOP.
-  Definition t := approx.
-  Definition eq (x y: t) := (x = y).
-  Definition eq_refl: forall x, eq x x := (@refl_equal t).
-  Definition eq_sym: forall x y, eq x y -> eq y x := (@sym_equal t).
-  Definition eq_trans: forall x y z, eq x y -> eq y z -> eq x z := (@trans_equal t).
-  Lemma eq_dec: forall (x y: t), {x=y} + {x<>y}.
-  Proof.
-    decide equality.
-    apply Int.eq_dec.
-    apply Float.eq_dec.
-    apply Int.eq_dec.
-    apply ident_eq.
-  Qed.
-  Definition beq (x y: t) := if eq_dec x y then true else false.
-  Lemma beq_correct: forall x y, beq x y = true -> x = y.
-  Proof.
-    unfold beq; intros.  destruct (eq_dec x y). auto. congruence.
-  Qed.
-  Definition ge (x y: t) : Prop :=
-    x = Unknown \/ y = Novalue \/ x = y.
-  Lemma ge_refl: forall x y, eq x y -> ge x y.
-  Proof.
-    unfold eq, ge; tauto.
-  Qed.
-  Lemma ge_trans: forall x y z, ge x y -> ge y z -> ge x z.
-  Proof.
-    unfold ge; intuition congruence.
-  Qed.
-  Lemma ge_compat: forall x x' y y', eq x x' -> eq y y' -> ge x y -> ge x' y'.
-  Proof.
-    unfold eq, ge; intros; congruence.
-  Qed.
-  Definition bot := Novalue.
-  Definition top := Unknown.
-  Lemma ge_bot: forall x, ge x bot.
-  Proof.
-    unfold ge, bot; tauto.
-  Qed.
-  Lemma ge_top: forall x, ge top x.
-  Proof.
-    unfold ge, bot; tauto.
-  Qed.
-  Definition lub (x y: t) : t :=
-    if eq_dec x y then x else
-    match x, y with
-    | Novalue, _ => y
-    | _, Novalue => x
-    | _, _ => Unknown
-    end.
-  Lemma lub_commut: forall x y, eq (lub x y) (lub y x).
-  Proof.
-    unfold lub, eq; intros.
-    case (eq_dec x y); case (eq_dec y x); intros; try congruence.
-    destruct x; destruct y; auto.
-  Qed.
-  Lemma ge_lub_left: forall x y, ge (lub x y) x.
-  Proof.
-    unfold lub; intros.
-    case (eq_dec x y); intro.
-    apply ge_refl. apply eq_refl.
-    destruct x; destruct y; unfold ge; tauto.
-  Qed.
-End Approx.
-
-Module D := LPMap Approx.
-
-(** 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), Set :=
-  | 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_operation (op: operation) (vl: list approx) :=
-  match op, vl with
-  | Omove, v1::nil => v1
-  | Ointconst n, nil => I n
-  | Ofloatconst n, nil => F n
-  | Oaddrsymbol s n, nil => S s n
-  | Ocast8signed, I n1 :: nil => I(Int.sign_ext 8 n)
-  | Ocast8unsigned, I n1 :: nil => I(Int.zero_ext 8 n)
-  | Ocast16signed, I n1 :: nil => I(Int.sign_ext 16 n)
-  | Ocast16unsigned, I n1 :: nil => I(Int.zero_ext 16 n)
-  | Oadd, I n1 :: I n2 :: nil => I(Int.add n1 n2)
-  | Oadd, S s1 n1 :: I n2 :: nil => S s1 (Int.add n1 n2)
-  | Oaddimm n, I n1 :: nil => I (Int.add n1 n)
-  | Oaddimm n, S s1 n1 :: nil => S s1 (Int.add n1 n)
-  | Osub, I n1 :: I n2 :: nil => I(Int.sub n1 n2)
-  | Osub, S s1 n1 :: I n2 :: nil => S s1 (Int.sub n1 n2)
-  | Osubimm n, I n1 :: nil => I (Int.sub n n1)
-  | 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)
-  | 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)
-  | Onand, I n1 :: I n2 :: nil => I(Int.xor (Int.and n1 n2) Int.mone)
-  | Onor, I n1 :: I n2 :: nil => I(Int.xor (Int.or n1 n2) Int.mone)
-  | Onxor, I n1 :: I n2 :: nil => I(Int.xor (Int.xor n1 n2) Int.mone)
-  | Oshl, I n1 :: I n2 :: nil => if Int.ltu n2 (Int.repr 32) then I(Int.shl n1 n2) else Unknown
-  | Oshr, I n1 :: I n2 :: nil => if Int.ltu n2 (Int.repr 32) then I(Int.shr n1 n2) else Unknown
-  | Oshrimm n, I n1 :: nil => if Int.ltu n (Int.repr 32) then I(Int.shr n1 n) else Unknown
-  | Oshrximm n, I n1 :: nil => if Int.ltu n (Int.repr 32) then I(Int.shrx n1 n) else Unknown
-  | Oshru, I n1 :: I n2 :: nil => if Int.ltu n2 (Int.repr 32) then I(Int.shru n1 n2) else Unknown
-  | Orolm amount mask, I n1 :: nil => I(Int.rolm n1 amount mask)
-  | 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)
-  | Omuladdf, F n1 :: F n2 :: F n3 :: nil => F(Float.add (Float.mul n1 n2) n3)
-  | Omulsubf, F n1 :: F n2 :: F n3 :: nil => F(Float.sub (Float.mul n1 n2) n3)
-  | Osingleoffloat, F n1 :: nil => F(Float.singleoffloat n1)
-  | Ointoffloat, F n1 :: nil => I(Float.intoffloat n1)
-  | Ointuoffloat, F n1 :: nil => I(Float.intuoffloat n1)
-  | Ofloatofint, I n1 :: nil => F(Float.floatofint n1)
-  | Ofloatofintu, I n1 :: nil => F(Float.floatofintu 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), Set :=
-  | 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 s n,
-      eval_static_operation_cases (Oaddrsymbol s n) (nil)
-  | eval_static_operation_case6:
-      forall n1,
-      eval_static_operation_cases (Ocast8signed) (I n1 :: nil)
-  | eval_static_operation_case7:
-      forall n1,
-      eval_static_operation_cases (Ocast16signed) (I n1 :: nil)
-  | eval_static_operation_case8:
-      forall n1 n2,
-      eval_static_operation_cases (Oadd) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case9:
-      forall s1 n1 n2,
-      eval_static_operation_cases (Oadd) (S s1 n1 :: I n2 :: nil)
-  | eval_static_operation_case11:
-      forall n n1,
-      eval_static_operation_cases (Oaddimm n) (I n1 :: nil)
-  | eval_static_operation_case12:
-      forall n s1 n1,
-      eval_static_operation_cases (Oaddimm n) (S s1 n1 :: nil)
-  | eval_static_operation_case13:
-      forall n1 n2,
-      eval_static_operation_cases (Osub) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case14:
-      forall s1 n1 n2,
-      eval_static_operation_cases (Osub) (S s1 n1 :: I n2 :: nil)
-  | eval_static_operation_case15:
-      forall n n1,
-      eval_static_operation_cases (Osubimm n) (I n1 :: nil)
-  | eval_static_operation_case16:
-      forall n1 n2,
-      eval_static_operation_cases (Omul) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case17:
-      forall n n1,
-      eval_static_operation_cases (Omulimm n) (I n1 :: nil)
-  | eval_static_operation_case18:
-      forall n1 n2,
-      eval_static_operation_cases (Odiv) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case19:
-      forall n1 n2,
-      eval_static_operation_cases (Odivu) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case20:
-      forall n1 n2,
-      eval_static_operation_cases (Oand) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case21:
-      forall n n1,
-      eval_static_operation_cases (Oandimm n) (I n1 :: nil)
-  | eval_static_operation_case22:
-      forall n1 n2,
-      eval_static_operation_cases (Oor) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case23:
-      forall n n1,
-      eval_static_operation_cases (Oorimm n) (I n1 :: nil)
-  | eval_static_operation_case24:
-      forall n1 n2,
-      eval_static_operation_cases (Oxor) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case25:
-      forall n n1,
-      eval_static_operation_cases (Oxorimm n) (I n1 :: nil)
-  | eval_static_operation_case26:
-      forall n1 n2,
-      eval_static_operation_cases (Onand) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case27:
-      forall n1 n2,
-      eval_static_operation_cases (Onor) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case28:
-      forall n1 n2,
-      eval_static_operation_cases (Onxor) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case29:
-      forall n1 n2,
-      eval_static_operation_cases (Oshl) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case30:
-      forall n1 n2,
-      eval_static_operation_cases (Oshr) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case31:
-      forall n n1,
-      eval_static_operation_cases (Oshrimm n) (I n1 :: nil)
-  | eval_static_operation_case32:
-      forall n n1,
-      eval_static_operation_cases (Oshrximm n) (I n1 :: nil)
-  | eval_static_operation_case33:
-      forall n1 n2,
-      eval_static_operation_cases (Oshru) (I n1 :: I n2 :: nil)
-  | eval_static_operation_case34:
-      forall amount mask n1,
-      eval_static_operation_cases (Orolm amount mask) (I n1 :: nil)
-  | eval_static_operation_case35:
-      forall n1,
-      eval_static_operation_cases (Onegf) (F n1 :: nil)
-  | eval_static_operation_case36:
-      forall n1,
-      eval_static_operation_cases (Oabsf) (F n1 :: nil)
-  | eval_static_operation_case37:
-      forall n1 n2,
-      eval_static_operation_cases (Oaddf) (F n1 :: F n2 :: nil)
-  | eval_static_operation_case38:
-      forall n1 n2,
-      eval_static_operation_cases (Osubf) (F n1 :: F n2 :: nil)
-  | eval_static_operation_case39:
-      forall n1 n2,
-      eval_static_operation_cases (Omulf) (F n1 :: F n2 :: nil)
-  | eval_static_operation_case40:
-      forall n1 n2,
-      eval_static_operation_cases (Odivf) (F n1 :: F n2 :: nil)
-  | eval_static_operation_case41:
-      forall n1 n2 n3,
-      eval_static_operation_cases (Omuladdf) (F n1 :: F n2 :: F n3 :: nil)
-  | eval_static_operation_case42:
-      forall n1 n2 n3,
-      eval_static_operation_cases (Omulsubf) (F n1 :: F n2 :: F n3 :: nil)
-  | eval_static_operation_case43:
-      forall n1,
-      eval_static_operation_cases (Osingleoffloat) (F n1 :: nil)
-  | eval_static_operation_case44:
-      forall n1,
-      eval_static_operation_cases (Ointoffloat) (F n1 :: nil)
-  | eval_static_operation_case45:
-      forall n1,
-      eval_static_operation_cases (Ofloatofint) (I n1 :: nil)
-  | eval_static_operation_case46:
-      forall n1,
-      eval_static_operation_cases (Ofloatofintu) (I n1 :: nil)
-  | eval_static_operation_case47:
-      forall c vl,
-      eval_static_operation_cases (Ocmp c) (vl)
-  | eval_static_operation_case48:
-      forall n1,
-      eval_static_operation_cases (Ocast8unsigned) (I n1 :: nil)
-  | eval_static_operation_case49:
-      forall n1,
-      eval_static_operation_cases (Ocast16unsigned) (I n1 :: nil)
-  | eval_static_operation_case50:
-      forall n1,
-      eval_static_operation_cases (Ointuoffloat) (F n1 :: nil)
-  | 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
-  | Oaddrsymbol s n, nil =>
-      eval_static_operation_case4 s n
-  | Ocast8signed, I n1 :: nil =>
-      eval_static_operation_case6 n1
-  | Ocast16signed, I n1 :: nil =>
-      eval_static_operation_case7 n1
-  | Oadd, I n1 :: I n2 :: nil =>
-      eval_static_operation_case8 n1 n2
-  | Oadd, S s1 n1 :: I n2 :: nil =>
-      eval_static_operation_case9 s1 n1 n2
-  | Oaddimm n, I n1 :: nil =>
-      eval_static_operation_case11 n n1
-  | Oaddimm n, S s1 n1 :: nil =>
-      eval_static_operation_case12 n s1 n1
-  | Osub, I n1 :: I n2 :: nil =>
-      eval_static_operation_case13 n1 n2
-  | Osub, S s1 n1 :: I n2 :: nil =>
-      eval_static_operation_case14 s1 n1 n2
-  | Osubimm n, I n1 :: nil =>
-      eval_static_operation_case15 n n1
-  | Omul, I n1 :: I n2 :: nil =>
-      eval_static_operation_case16 n1 n2
-  | Omulimm n, I n1 :: nil =>
-      eval_static_operation_case17 n n1
-  | Odiv, I n1 :: I n2 :: nil =>
-      eval_static_operation_case18 n1 n2
-  | Odivu, I n1 :: I n2 :: nil =>
-      eval_static_operation_case19 n1 n2
-  | Oand, I n1 :: I n2 :: nil =>
-      eval_static_operation_case20 n1 n2
-  | Oandimm n, I n1 :: nil =>
-      eval_static_operation_case21 n n1
-  | Oor, I n1 :: I n2 :: nil =>
-      eval_static_operation_case22 n1 n2
-  | Oorimm n, I n1 :: nil =>
-      eval_static_operation_case23 n n1
-  | Oxor, I n1 :: I n2 :: nil =>
-      eval_static_operation_case24 n1 n2
-  | Oxorimm n, I n1 :: nil =>
-      eval_static_operation_case25 n n1
-  | Onand, I n1 :: I n2 :: nil =>
-      eval_static_operation_case26 n1 n2
-  | Onor, I n1 :: I n2 :: nil =>
-      eval_static_operation_case27 n1 n2
-  | Onxor, I n1 :: I n2 :: nil =>
-      eval_static_operation_case28 n1 n2
-  | Oshl, I n1 :: I n2 :: nil =>
-      eval_static_operation_case29 n1 n2
-  | Oshr, I n1 :: I n2 :: nil =>
-      eval_static_operation_case30 n1 n2
-  | Oshrimm n, I n1 :: nil =>
-      eval_static_operation_case31 n n1
-  | Oshrximm n, I n1 :: nil =>
-      eval_static_operation_case32 n n1
-  | Oshru, I n1 :: I n2 :: nil =>
-      eval_static_operation_case33 n1 n2
-  | Orolm amount mask, I n1 :: nil =>
-      eval_static_operation_case34 amount mask n1
-  | Onegf, F n1 :: nil =>
-      eval_static_operation_case35 n1
-  | Oabsf, F n1 :: nil =>
-      eval_static_operation_case36 n1
-  | Oaddf, F n1 :: F n2 :: nil =>
-      eval_static_operation_case37 n1 n2
-  | Osubf, F n1 :: F n2 :: nil =>
-      eval_static_operation_case38 n1 n2
-  | Omulf, F n1 :: F n2 :: nil =>
-      eval_static_operation_case39 n1 n2
-  | Odivf, F n1 :: F n2 :: nil =>
-      eval_static_operation_case40 n1 n2
-  | Omuladdf, F n1 :: F n2 :: F n3 :: nil =>
-      eval_static_operation_case41 n1 n2 n3
-  | Omulsubf, F n1 :: F n2 :: F n3 :: nil =>
-      eval_static_operation_case42 n1 n2 n3
-  | Osingleoffloat, F n1 :: nil =>
-      eval_static_operation_case43 n1
-  | Ointoffloat, F n1 :: nil =>
-      eval_static_operation_case44 n1
-  | Ofloatofint, I n1 :: nil =>
-      eval_static_operation_case45 n1
-  | Ofloatofintu, I n1 :: nil =>
-      eval_static_operation_case46 n1
-  | Ocmp c, vl =>
-      eval_static_operation_case47 c vl
-  | Ocast8unsigned, I n1 :: nil =>
-      eval_static_operation_case48 n1
-  | Ocast16unsigned, I n1 :: nil =>
-      eval_static_operation_case49 n1
-  | Ointuoffloat, F n1 :: nil =>
-      eval_static_operation_case50 n1
-  | 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 s n =>
-      S s n
-  | eval_static_operation_case6 n1 =>
-      I(Int.sign_ext 8 n1)
-  | eval_static_operation_case7 n1 =>
-      I(Int.sign_ext 16 n1)
-  | eval_static_operation_case8 n1 n2 =>
-      I(Int.add n1 n2)
-  | eval_static_operation_case9 s1 n1 n2 =>
-      S s1 (Int.add n1 n2)
-  | eval_static_operation_case11 n n1 =>
-      I (Int.add n1 n)
-  | eval_static_operation_case12 n s1 n1 =>
-      S s1 (Int.add n1 n)
-  | eval_static_operation_case13 n1 n2 =>
-      I(Int.sub n1 n2)
-  | eval_static_operation_case14 s1 n1 n2 =>
-      S s1 (Int.sub n1 n2)
-  | eval_static_operation_case15 n n1 =>
-      I (Int.sub n n1)
-  | eval_static_operation_case16 n1 n2 =>
-      I(Int.mul n1 n2)
-  | eval_static_operation_case17 n n1 =>
-      I(Int.mul n1 n)
-  | eval_static_operation_case18 n1 n2 =>
-      if Int.eq n2 Int.zero then Unknown else I(Int.divs n1 n2)
-  | eval_static_operation_case19 n1 n2 =>
-      if Int.eq n2 Int.zero then Unknown else I(Int.divu n1 n2)
-  | eval_static_operation_case20 n1 n2 =>
-      I(Int.and n1 n2)
-  | eval_static_operation_case21 n n1 =>
-      I(Int.and n1 n)
-  | eval_static_operation_case22 n1 n2 =>
-      I(Int.or n1 n2)
-  | eval_static_operation_case23 n n1 =>
-      I(Int.or n1 n)
-  | eval_static_operation_case24 n1 n2 =>
-      I(Int.xor n1 n2)
-  | eval_static_operation_case25 n n1 =>
-      I(Int.xor n1 n)
-  | eval_static_operation_case26 n1 n2 =>
-      I(Int.xor (Int.and n1 n2) Int.mone)
-  | eval_static_operation_case27 n1 n2 =>
-      I(Int.xor (Int.or n1 n2) Int.mone)
-  | eval_static_operation_case28 n1 n2 =>
-      I(Int.xor (Int.xor n1 n2) Int.mone)
-  | eval_static_operation_case29 n1 n2 =>
-      if Int.ltu n2 (Int.repr 32) then I(Int.shl n1 n2) else Unknown
-  | eval_static_operation_case30 n1 n2 =>
-      if Int.ltu n2 (Int.repr 32) then I(Int.shr n1 n2) else Unknown
-  | eval_static_operation_case31 n n1 =>
-      if Int.ltu n (Int.repr 32) then I(Int.shr n1 n) else Unknown
-  | eval_static_operation_case32 n n1 =>
-      if Int.ltu n (Int.repr 32) then I(Int.shrx n1 n) else Unknown
-  | eval_static_operation_case33 n1 n2 =>
-      if Int.ltu n2 (Int.repr 32) then I(Int.shru n1 n2) else Unknown
-  | eval_static_operation_case34 amount mask n1 =>
-      I(Int.rolm n1 amount mask)
-  | eval_static_operation_case35 n1 =>
-      F(Float.neg n1)
-  | eval_static_operation_case36 n1 =>
-      F(Float.abs n1)
-  | eval_static_operation_case37 n1 n2 =>
-      F(Float.add n1 n2)
-  | eval_static_operation_case38 n1 n2 =>
-      F(Float.sub n1 n2)
-  | eval_static_operation_case39 n1 n2 =>
-      F(Float.mul n1 n2)
-  | eval_static_operation_case40 n1 n2 =>
-      F(Float.div n1 n2)
-  | eval_static_operation_case41 n1 n2 n3 =>
-      F(Float.add (Float.mul n1 n2) n3)
-  | eval_static_operation_case42 n1 n2 n3 =>
-      F(Float.sub (Float.mul n1 n2) n3)
-  | eval_static_operation_case43 n1 =>
-      F(Float.singleoffloat n1)
-  | eval_static_operation_case44 n1 =>
-      I(Float.intoffloat n1)
-  | eval_static_operation_case45 n1 =>
-      F(Float.floatofint n1)
-  | eval_static_operation_case46 n1 =>
-      F(Float.floatofintu n1)
-  | eval_static_operation_case47 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_case48 n1 =>
-      I(Int.zero_ext 8 n1)
-  | eval_static_operation_case49 n1 =>
-      I(Int.zero_ext 16 n1)
-  | eval_static_operation_case50 n1 =>
-      I(Float.intuoffloat n1)
-  | eval_static_operation_default op vl =>
-      Unknown
-  end.
-
-(** The transfer function for the dataflow analysis is straightforward:
-  for [Iop] instructions, we set the approximation of the destination
-  register to the result of executing abstractly the operation;
-  for [Iload] and [Icall], we set the approximation of the destination
-  to [Unknown]. *)
-
-Definition approx_regs (rl: list reg) (approx: D.t) :=
-  List.map (fun r => D.get r approx) rl.
-
-Definition transfer (f: function) (pc: node) (before: D.t) :=
-  match f.(fn_code)!pc with
-  | None => before
-  | Some i =>
-      match i with
-      | Inop s =>
-          before
-      | Iop op args res s =>
-          let a := eval_static_operation op (approx_regs args before) in
-          D.set res a before
-      | Iload chunk addr args dst s =>
-          D.set dst Unknown before
-      | Istore chunk addr args src s =>
-          before
-      | Icall sig ros args res s =>
-          D.set res Unknown before
-      | Itailcall sig ros args =>
-          before
-      | Ialloc arg res s =>
-          D.set res Unknown before
-      | Icond cond args ifso ifnot =>
-          before
-      | Ireturn optarg =>
-          before
-      end
-  end.
-
-(** The static analysis itself is then an instantiation of Kildall's
-  generic solver for forward dataflow inequations. [analyze f]
-  returns a mapping from program points to mappings of pseudo-registers
-  to approximations.  It can fail to reach a fixpoint in a reasonable
-  number of iterations, in which case [None] is returned. *)
-
-Module DS := Dataflow_Solver(D)(NodeSetForward).
-
-Definition analyze (f: RTL.function): PMap.t D.t :=
-  match DS.fixpoint (successors f) f.(fn_nextpc) (transfer f) 
-                    ((f.(fn_entrypoint), D.top) :: nil) with
-  | None => PMap.init D.top
-  | Some res => res
-  end.
-
-(** * Code transformation *)
-
-(** ** 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 approx: D.t.
-
-Definition intval (r: reg) : option int :=
-  match D.get r approx with I n => Some n | _ => None end.
-
-Inductive cond_strength_reduction_cases: condition -> list reg -> Set :=
-  | 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 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 (Orolm n (Int.shl Int.mone 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 (Orolm (Int.sub (Int.repr 32) n) (Int.shru Int.mone 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).
-
-Inductive op_strength_reduction_cases: operation -> list reg -> Set :=
-  | op_strength_reduction_case1:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Oadd (r1 :: r2 :: nil)
-  | op_strength_reduction_case2:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Osub (r1 :: r2 :: nil)
-  | op_strength_reduction_case3:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Omul (r1 :: r2 :: nil)
-  | op_strength_reduction_case4:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Odiv (r1 :: r2 :: nil)
-  | op_strength_reduction_case5:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Odivu (r1 :: r2 :: nil)
-  | op_strength_reduction_case6:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Oand (r1 :: r2 :: nil)
-  | op_strength_reduction_case7:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Oor (r1 :: r2 :: nil)
-  | op_strength_reduction_case8:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Oxor (r1 :: r2 :: nil)
-  | op_strength_reduction_case9:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Oshl (r1 :: r2 :: nil)
-  | op_strength_reduction_case10:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Oshr (r1 :: r2 :: nil)
-  | op_strength_reduction_case11:
-      forall (r1: reg) (r2: reg),
-      op_strength_reduction_cases Oshru (r1 :: r2 :: nil)
-  | op_strength_reduction_case12:
-      forall (c: condition) (rl: list reg),
-      op_strength_reduction_cases (Ocmp c) rl
-  | 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
-  | Oadd, r1 :: r2 :: nil =>
-      op_strength_reduction_case1 r1 r2
-  | 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
-  | Oand, r1 :: r2 :: nil =>
-      op_strength_reduction_case6 r1 r2
-  | Oor, r1 :: r2 :: nil =>
-      op_strength_reduction_case7 r1 r2
-  | Oxor, r1 :: r2 :: nil =>
-      op_strength_reduction_case8 r1 r2
-  | Oshl, r1 :: r2 :: nil =>
-      op_strength_reduction_case9 r1 r2
-  | Oshr, r1 :: r2 :: nil =>
-      op_strength_reduction_case10 r1 r2
-  | Oshru, r1 :: r2 :: nil =>
-      op_strength_reduction_case11 r1 r2
-  | Ocmp c, rl =>
-      op_strength_reduction_case12 c rl
-  | op, args =>
-      op_strength_reduction_default op args
-  end.
-
-Definition op_strength_reduction (op: operation) (args: list reg) :=
-  match op_strength_reduction_match op args with
-  | op_strength_reduction_case1 r1 r2 => (* Oadd *)
-      match intval r1, intval r2 with
-      | Some n, _ => make_addimm n r2
-      | _, Some n => make_addimm n r1
-      | _, _ => (op, args)
-      end
-  | op_strength_reduction_case2 r1 r2 => (* Osub *)
-      match intval r1, intval r2 with
-      | Some n, _ => (Osubimm n, r2 :: nil)
-      | _, Some n => make_addimm (Int.neg n) r1
-      | _, _ => (op, args)
-      end
-  | op_strength_reduction_case3 r1 r2 => (* Omul *)
-      match intval r1, intval r2 with
-      | Some n, _ => make_mulimm n r2
-      | _, 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 => (Oshrximm l, r1 :: nil)
-          | 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_case6 r1 r2 => (* Oand *)
-      match intval r1, intval r2 with
-      | Some n, _ => make_andimm n r2
-      | _, Some n => make_andimm n r1
-      | _, _ => (op, args)
-      end
-  | op_strength_reduction_case7 r1 r2 => (* Oor *)
-      match intval r1, intval r2 with
-      | Some n, _ => make_orimm n r2
-      | _, Some n => make_orimm n r1
-      | _, _ => (op, args)
-      end
-  | op_strength_reduction_case8 r1 r2 => (* Oxor *)
-      match intval r1, intval r2 with
-      | Some n, _ => make_xorimm n r2
-      | _, Some n => make_xorimm n r1
-      | _, _ => (op, args)
-      end
-  | op_strength_reduction_case9 r1 r2 => (* Oshl *)
-      match intval r2 with
-      | Some n =>
-          if Int.ltu n (Int.repr 32)
-          then make_shlimm n r1
-          else (op, args)
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case10 r1 r2 => (* Oshr *)
-      match intval r2 with
-      | Some n =>
-          if Int.ltu n (Int.repr 32)
-          then make_shrimm n r1
-          else (op, args)
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case11 r1 r2 => (* Oshru *)
-      match intval r2 with
-      | Some n =>
-          if Int.ltu n (Int.repr 32)
-          then make_shruimm n r1
-          else (op, args)
-      | _ => (op, args)
-      end
-  | op_strength_reduction_case12 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.
-
-Inductive addr_strength_reduction_cases: forall (addr: addressing) (args: list reg), Set :=
-  | addr_strength_reduction_case1:
-      forall (r1: reg) (r2: reg),
-      addr_strength_reduction_cases (Aindexed2) (r1 :: r2 :: nil)
-  | addr_strength_reduction_case2:
-      forall (symb: ident) (ofs: int) (r1: reg),
-      addr_strength_reduction_cases (Abased symb ofs) (r1 :: nil)
-  | addr_strength_reduction_case3:
-      forall n r1,
-      addr_strength_reduction_cases (Aindexed n) (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
-  | Aindexed2, r1 :: r2 :: nil =>
-      addr_strength_reduction_case1 r1 r2
-  | Abased symb ofs, r1 :: nil =>
-      addr_strength_reduction_case2 symb ofs r1
-  | Aindexed n, r1 :: nil =>
-      addr_strength_reduction_case3 n 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 r1 r2 => (* Aindexed2 *)
-      match D.get r1 approx, D.get r2 approx with
-      | S symb n1, I n2 => (Aglobal symb (Int.add n1 n2), nil)
-      | S symb n1, _ => (Abased symb n1, r2 :: nil)
-      | I n1, S symb n2 => (Aglobal symb (Int.add n1 n2), nil)
-      | I n1, _ => (Aindexed n1, r2 :: nil)
-      | _, S symb n2 => (Abased symb n2, r1 :: nil)
-      | _, I n2 => (Aindexed n2, r1 :: nil)
-      | _, _ => (addr, args)
-      end
-  | addr_strength_reduction_case2 symb ofs r1 => (* Abased *)
-      match intval r1 with
-      | Some n => (Aglobal symb (Int.add ofs n), nil)
-      | _ => (addr, args)
-      end
-  | addr_strength_reduction_case3 n r1 => (* Aindexed *)
-      match D.get r1 approx with
-      | S symb ofs => (Aglobal symb (Int.add ofs n), nil)
-      | _ => (addr, args)
-      end
-  | addr_strength_reduction_default addr args => (* default *)
-      (addr, args)
-  end.
-
-End STRENGTH_REDUCTION.
-
-(** ** Code transformation *)
-
-(** The code transformation proceeds instruction by instruction.
-    Operators whose arguments are all statically known are turned
-    into ``load integer constant'', ``load float constant'' or
-    ``load symbol address'' operations.  Operators for which some
-    but not all arguments are known are subject to strength reduction,
-    and similarly for the addressing modes of load and store instructions.
-    Other instructions are unchanged. *)
-
-Definition transf_ros (approx: D.t) (ros: reg + ident) : reg + ident :=
-  match ros with
-  | inl r =>
-      match D.get r approx with
-      | S symb ofs => if Int.eq ofs Int.zero then inr _ symb else ros
-      | _ => ros
-      end
-  | inr s => ros
-  end.
-
-Definition transf_instr (approx: D.t) (instr: instruction) :=
-  match instr with
-  | Iop op args res s =>
-      match eval_static_operation op (approx_regs args approx) with
-      | I n =>
-          Iop (Ointconst n) nil res s
-      | F n =>
-          Iop (Ofloatconst n) nil res s
-      | S symb ofs =>
-          Iop (Oaddrsymbol symb ofs) nil res s
-      | _ =>
-          let (op', args') := op_strength_reduction approx op args in
-          Iop op' args' res s
-      end
-  | Iload chunk addr args dst s =>
-      let (addr', args') := addr_strength_reduction approx addr args in
-      Iload chunk addr' args' dst s      
-  | Istore chunk addr args src s =>
-      let (addr', args') := addr_strength_reduction approx addr args in
-      Istore chunk addr' args' src s      
-  | Icall sig ros args res s =>
-      Icall sig (transf_ros approx ros) args res s
-  | Itailcall sig ros args =>
-      Itailcall sig (transf_ros approx ros) args
-  | Ialloc arg res s =>
-      Ialloc arg res s
-  | Icond cond args s1 s2 =>
-      match eval_static_condition cond (approx_regs args approx) with
-      | Some b =>
-          if b then Inop s1 else Inop s2
-      | None =>
-          let (cond', args') := cond_strength_reduction approx cond args in
-          Icond cond' args' s1 s2
-      end
-  | _ =>
-      instr
-  end.
-
-Definition transf_code (approxs: PMap.t D.t) (instrs: code) : code :=
-  PTree.map (fun pc instr => transf_instr approxs!!pc instr) instrs.
-
-Lemma transf_code_wf:
-  forall f approxs,
-  (forall pc, Plt pc f.(fn_nextpc) \/ f.(fn_code)!pc = None) ->
-  (forall pc, Plt pc f.(fn_nextpc)
-      \/ (transf_code approxs f.(fn_code))!pc = None).
-Proof.
-  intros. 
-  elim (H pc); intro.
-  left; auto.
-  right. unfold transf_code. rewrite PTree.gmap. 
-  unfold option_map; rewrite H0. reflexivity.
-Qed.
-
-Definition transf_function (f: function) : function :=
-  let approxs := analyze f in
-  mkfunction
-    f.(fn_sig)
-    f.(fn_params)
-    f.(fn_stacksize)
-    (transf_code approxs f.(fn_code))
-    f.(fn_entrypoint)
-    f.(fn_nextpc)
-    (transf_code_wf f approxs f.(fn_code_wf)).
-
-Definition transf_fundef (fd: fundef) : fundef :=
-  AST.transf_fundef transf_function fd.
-
-Definition transf_program (p: program) : program :=
-  transform_program transf_fundef p.
diff --git a/backend/Constpropproof.v b/backend/Constpropproof.v
deleted file mode 100644
index e16f322e..00000000
--- a/backend/Constpropproof.v
+++ /dev/null
@@ -1,954 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** Correctness proof for constant propagation. *)
-
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Events.
-Require Import Mem.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
-Require Import Lattice.
-Require Import Kildall.
-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.
-
-Definition regs_match_approx (a: D.t) (rs: regset) : Prop :=
-  forall r, val_match_approx (D.get r a) rs#r.
-
-Lemma regs_match_approx_top:
-  forall rs, regs_match_approx D.top rs.
-Proof.
-  intros. red; intros. simpl. rewrite PTree.gempty. 
-  unfold Approx.top, val_match_approx. auto.
-Qed.
-
-Lemma val_match_approx_increasing:
-  forall a1 a2 v,
-  Approx.ge a1 a2 -> val_match_approx a2 v -> val_match_approx a1 v.
-Proof.
-  intros until v.
-  intros [A|[B|C]].
-  subst a1. simpl. auto.
-  subst a2. simpl. tauto.
-  subst a2. auto.
-Qed.
-
-Lemma regs_match_approx_increasing:
-  forall a1 a2 rs,
-  D.ge a1 a2 -> regs_match_approx a2 rs -> regs_match_approx a1 rs.
-Proof.
-  unfold D.ge, regs_match_approx. intros.
-  apply val_match_approx_increasing with (D.get r a2); auto.
-Qed.
-
-Lemma regs_match_approx_update:
-  forall ra rs a v r,
-  val_match_approx a v ->
-  regs_match_approx ra rs ->
-  regs_match_approx (D.set r a ra) (rs#r <- v).
-Proof.
-  intros; red; intros. rewrite Regmap.gsspec. 
-  case (peq r0 r); intro.
-  subst r0. rewrite D.gss. auto.
-  rewrite D.gso; auto. 
-Qed.
-
-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).
-
-Lemma approx_regs_val_list:
-  forall ra rs rl,
-  regs_match_approx ra rs ->
-  val_list_match_approx (approx_regs rl ra) rs##rl.
-Proof.
-  induction rl; simpl; intros.
-  constructor.
-  constructor. apply H. auto.
-Qed.
-
-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 m b,
-  val_list_match_approx al vl ->
-  eval_static_condition cond al = Some b ->
-  eval_condition cond vl m = 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_operation_correct:
-  forall op sp al vl m v,
-  val_list_match_approx al vl ->
-  eval_operation ge sp op vl m = Some v ->
-  val_match_approx (eval_static_operation op al) v.
-Proof.
-  intros until v.
-  unfold eval_static_operation. 
-  case (eval_static_operation_match op al); intros;
-  InvVLMA; simpl in *; FuncInv; try congruence.
-
-  destruct (Genv.find_symbol ge s). exists b. intuition congruence.
-  congruence.
-
-  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
-  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
-
-  exists b. split. auto. congruence. 
-  exists b. split. auto. 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.
-
-  subst v. unfold Int.not. congruence.
-  subst v. unfold Int.not. congruence.
-  subst v. unfold Int.not. congruence.
-
-  replace n2 with i0. destruct (Int.ltu i0 (Int.repr 32)).
-  injection H0; intro; subst v. simpl. congruence. discriminate. congruence. 
-
-  replace n2 with i0. destruct (Int.ltu i0 (Int.repr 32)).
-  injection H0; intro; subst v. simpl. congruence. discriminate. congruence. 
-
-  destruct (Int.ltu n (Int.repr 32)).
-  injection H0; intro; subst v. simpl. congruence. discriminate. 
-
-  destruct (Int.ltu n (Int.repr 32)).
-  injection H0; intro; subst v. simpl. congruence. discriminate. 
-
-  replace n2 with i0. destruct (Int.ltu i0 (Int.repr 32)).
-  injection H0; intro; subst v. simpl. congruence. discriminate. congruence. 
-
-  rewrite <- H3. replace v0 with (Vfloat n1). reflexivity. congruence.
-
-  caseEq (eval_static_condition c vl0).
-  intros. generalize (eval_static_condition_correct _ _ _ m _ H H1).
-  intro. rewrite H2 in H0. 
-  destruct b; injection H0; intro; subst v; simpl; auto.
-  intros; simpl; auto.
-
-  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
-  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
-
-  auto.
-Qed.
-
-(** The correctness of the static analysis follows from the results
-  above and the fact that the result of the static analysis is
-  a solution of the forward dataflow inequations. *)
-
-Lemma analyze_correct_1:
-  forall f pc rs pc',
-  In pc' (successors f pc) ->
-  regs_match_approx (transfer f pc (analyze f)!!pc) rs ->
-  regs_match_approx (analyze f)!!pc' rs.
-Proof.
-  intros until pc'. unfold analyze. 
-  caseEq (DS.fixpoint (successors f) (fn_nextpc f) (transfer f)
-                      ((fn_entrypoint f, D.top) :: nil)).
-  intros approxs; intros.
-  apply regs_match_approx_increasing with (transfer f pc approxs!!pc).
-  eapply DS.fixpoint_solution; eauto.
-  elim (fn_code_wf f pc); intro. auto. 
-  unfold successors in H0; rewrite H2 in H0; simpl; contradiction.
-  auto.
-  intros. rewrite PMap.gi. apply regs_match_approx_top. 
-Qed.
-
-Lemma analyze_correct_3:
-  forall f rs,
-  regs_match_approx (analyze f)!!(f.(fn_entrypoint)) rs.
-Proof.
-  intros. unfold analyze. 
-  caseEq (DS.fixpoint (successors f) (fn_nextpc f) (transfer f)
-                      ((fn_entrypoint f, D.top) :: nil)).
-  intros approxs; intros.
-  apply regs_match_approx_increasing with D.top.
-  eapply DS.fixpoint_entry; eauto. auto with coqlib.
-  apply regs_match_approx_top. 
-  intros. rewrite PMap.gi. apply regs_match_approx_top.
-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 approx: D.t.
-Variable sp: val.
-Variable rs: regset.
-Hypothesis MATCH: regs_match_approx approx rs.
-
-Lemma intval_correct:
-  forall r n,
-  intval approx r = Some n -> rs#r = Vint n.
-Proof.
-  intros until n.
-  unfold intval. caseEq (D.get r approx); intros; try discriminate.
-  generalize (MATCH r). unfold val_match_approx. rewrite H.
-  congruence. 
-Qed.
-
-Lemma cond_strength_reduction_correct:
-  forall cond args m,
-  let (cond', args') := cond_strength_reduction approx cond args in
-  eval_condition cond' rs##args' m = eval_condition cond rs##args m.
-Proof.
-  intros. unfold cond_strength_reduction.
-  case (cond_strength_reduction_match cond args); intros.
-  caseEq (intval approx r1); intros.
-  simpl. rewrite (intval_correct _ _ H). 
-  destruct (rs#r2); auto. rewrite Int.swap_cmp. auto.
-  destruct c; reflexivity.
-  caseEq (intval approx r2); intros.
-  simpl. rewrite (intval_correct _ _ H0). auto.
-  auto.
-  caseEq (intval approx r1); intros.
-  simpl. rewrite (intval_correct _ _ H). 
-  destruct (rs#r2); auto. rewrite Int.swap_cmpu. auto.
-  caseEq (intval approx r2); intros.
-  simpl. rewrite (intval_correct _ _ H0). auto.
-  auto.
-  auto.
-Qed.
-
-Lemma make_addimm_correct:
-  forall n r m v,
-  let (op, args) := make_addimm n r in
-  eval_operation ge sp Oadd (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
-Proof.
-  intros; unfold make_addimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
-  subst n. simpl in *. FuncInv. rewrite Int.add_zero in H. congruence.
-  rewrite Int.add_zero in H. congruence.
-  exact H0.
-Qed.
-  
-Lemma make_shlimm_correct:
-  forall n r m v,
-  let (op, args) := make_shlimm n r in
-  eval_operation ge sp Oshl (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
-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 *. FuncInv. caseEq (Int.ltu n (Int.repr 32)); intros.
-  rewrite H1 in H0. rewrite Int.shl_rolm in H0. auto. exact H1.
-  rewrite H1 in H0. discriminate.
-Qed.
-
-Lemma make_shrimm_correct:
-  forall n r m v,
-  let (op, args) := make_shrimm n r in
-  eval_operation ge sp Oshr (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
-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 m v,
-  let (op, args) := make_shruimm n r in
-  eval_operation ge sp Oshru (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
-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.
-  simpl in *. FuncInv. caseEq (Int.ltu n (Int.repr 32)); intros.
-  rewrite H1 in H0. rewrite Int.shru_rolm in H0. auto. exact H1.
-  rewrite H1 in H0. discriminate.
-Qed.
-
-Lemma make_mulimm_correct:
-  forall n r m v,
-  let (op, args) := make_mulimm n r in
-  eval_operation ge sp Omul (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
-Proof.
-  intros; unfold make_mulimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
-  subst n. simpl in H0. FuncInv. rewrite Int.mul_zero in H. simpl. congruence.
-  generalize (Int.eq_spec n Int.one); case (Int.eq n Int.one); intros.
-  subst n. simpl in H1. simpl. FuncInv. rewrite Int.mul_one in H0. congruence.
-  caseEq (Int.is_power2 n); intros.
-  replace (eval_operation ge sp Omul (rs # r :: Vint n :: nil) m)
-     with (eval_operation ge sp Oshl (rs # r :: Vint i :: nil) m).
-  apply make_shlimm_correct. 
-  simpl. generalize (Int.is_power2_range _ _ H1). 
-  change (Z_of_nat 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 m v,
-  let (op, args) := make_andimm n r in
-  eval_operation ge sp Oand (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
-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 m v,
-  let (op, args) := make_orimm n r in
-  eval_operation ge sp Oor (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
-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 m v,
-  let (op, args) := make_xorimm n r in
-  eval_operation ge sp Oxor (rs#r :: Vint n :: nil) m = Some v ->
-  eval_operation ge sp op rs##args m = Some v.
-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 m v,
-  let (op', args') := op_strength_reduction approx op args in
-  eval_operation ge sp op rs##args m = Some v ->
-  eval_operation ge sp op' rs##args' m = Some v.
-Proof.
-  intros; unfold op_strength_reduction;
-  case (op_strength_reduction_match op args); intros; simpl List.map.
-  (* Oadd *)
-  caseEq (intval approx r1); intros.
-  rewrite (intval_correct _ _ H). 
-  replace (eval_operation ge sp Oadd (Vint i :: rs # r2 :: nil) m)
-     with (eval_operation ge sp Oadd (rs # r2 :: Vint i :: nil) m).
-  apply make_addimm_correct. 
-  simpl. destruct rs#r2; auto. rewrite Int.add_commut; auto.
-  caseEq (intval approx r2); intros.
-  rewrite (intval_correct _ _ H0). apply make_addimm_correct.
-  assumption.
-  (* Osub *)
-  caseEq (intval approx r1); intros.
-  rewrite (intval_correct _ _ H) in H0. assumption. 
-  caseEq (intval approx r2); intros.
-  rewrite (intval_correct _ _ H0). 
-  replace (eval_operation ge sp Osub (rs # r1 :: Vint i :: nil) m)
-     with (eval_operation ge sp Oadd (rs # r1 :: Vint (Int.neg i) :: nil) m).
-  apply make_addimm_correct.
-  simpl. destruct rs#r1; auto; rewrite Int.sub_add_opp; auto. 
-  assumption.
-  (* Omul *)
-  caseEq (intval approx r1); intros.
-  rewrite (intval_correct _ _ H). 
-  replace (eval_operation ge sp Omul (Vint i :: rs # r2 :: nil) m)
-     with (eval_operation ge sp Omul (rs # r2 :: Vint i :: nil) m).
-  apply make_mulimm_correct. 
-  simpl. destruct rs#r2; auto. rewrite Int.mul_commut; auto.
-  caseEq (intval approx r2); intros.
-  rewrite (intval_correct _ _ H0). apply make_mulimm_correct.
-  assumption.
-  (* Odiv *)
-  caseEq (intval approx r2); intros.
-  caseEq (Int.is_power2 i); intros.
-  rewrite (intval_correct _ _ H) in H1.   
-  simpl in *; FuncInv. destruct (Int.eq i Int.zero). congruence.
-  change 32 with (Z_of_nat wordsize). 
-  rewrite (Int.is_power2_range _ _ H0). 
-  rewrite (Int.divs_pow2 i1 _ _ H0) in H1. auto.
-  assumption.
-  assumption.
-  (* Odivu *)
-  caseEq (intval approx r2); intros.
-  caseEq (Int.is_power2 i); intros.
-  rewrite (intval_correct _ _ H).
-  replace (eval_operation ge sp Odivu (rs # r1 :: Vint i :: nil) m)
-     with (eval_operation ge sp Oshru (rs # r1 :: Vint i0 :: nil) m).
-  apply make_shruimm_correct. 
-  simpl. destruct rs#r1; auto. 
-  change 32 with (Z_of_nat wordsize). 
-  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.
-  (* Oand *)
-  caseEq (intval approx r1); intros.
-  rewrite (intval_correct _ _ H). 
-  replace (eval_operation ge sp Oand (Vint i :: rs # r2 :: nil) m)
-     with (eval_operation ge sp Oand (rs # r2 :: Vint i :: nil) m).
-  apply make_andimm_correct. 
-  simpl. destruct rs#r2; auto. rewrite Int.and_commut; auto.
-  caseEq (intval approx r2); intros.
-  rewrite (intval_correct _ _ H0). apply make_andimm_correct.
-  assumption.
-  (* Oor *)
-  caseEq (intval approx r1); intros.
-  rewrite (intval_correct _ _ H). 
-  replace (eval_operation ge sp Oor (Vint i :: rs # r2 :: nil) m)
-     with (eval_operation ge sp Oor (rs # r2 :: Vint i :: nil) m).
-  apply make_orimm_correct. 
-  simpl. destruct rs#r2; auto. rewrite Int.or_commut; auto.
-  caseEq (intval approx r2); intros.
-  rewrite (intval_correct _ _ H0). apply make_orimm_correct.
-  assumption.
-  (* Oxor *)
-  caseEq (intval approx r1); intros.
-  rewrite (intval_correct _ _ H). 
-  replace (eval_operation ge sp Oxor (Vint i :: rs # r2 :: nil) m)
-     with (eval_operation ge sp Oxor (rs # r2 :: Vint i :: nil) m).
-  apply make_xorimm_correct. 
-  simpl. destruct rs#r2; auto. rewrite Int.xor_commut; auto.
-  caseEq (intval approx r2); intros.
-  rewrite (intval_correct _ _ H0). apply make_xorimm_correct.
-  assumption.
-  (* Oshl *)
-  caseEq (intval approx r2); intros.
-  caseEq (Int.ltu i (Int.repr 32)); intros.
-  rewrite (intval_correct _ _ H). apply make_shlimm_correct.
-  assumption.
-  assumption.
-  (* Oshr *)
-  caseEq (intval approx r2); intros.
-  caseEq (Int.ltu i (Int.repr 32)); intros.
-  rewrite (intval_correct _ _ H). apply make_shrimm_correct.
-  assumption.
-  assumption.
-  (* Oshru *)
-  caseEq (intval approx r2); intros.
-  caseEq (Int.ltu i (Int.repr 32)); intros.
-  rewrite (intval_correct _ _ H). apply make_shruimm_correct.
-  assumption.
-  assumption.
-  (* Ocmp *)
-  generalize (cond_strength_reduction_correct c rl).
-  destruct (cond_strength_reduction approx c rl).
-  simpl. intro. rewrite H. auto.
-  (* default *)
-  assumption.
-Qed.
-
-Ltac KnownApprox :=
-  match goal with
-  | MATCH: (regs_match_approx ?approx ?rs),
-    H: (D.get ?r ?approx = ?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 approx addr args in
-  eval_addressing ge sp addr' rs##args' = eval_addressing ge sp addr rs##args.
-Proof.
-  intros. 
-
-  (* Useful lemmas *)
-  assert (A0: forall r1 r2,
-    eval_addressing ge sp Aindexed2 (rs ## (r1 :: r2 :: nil)) =
-    eval_addressing ge sp Aindexed2 (rs ## (r2 :: r1 :: nil))).
-  intros. simpl. destruct (rs#r1); destruct (rs#r2); auto;
-  rewrite Int.add_commut; auto.
-
-  assert (A1: forall r1 r2 n,
-    val_match_approx (I n) rs#r2 -> 
-    eval_addressing ge sp (Aindexed n) (rs ## (r1 :: nil)) =
-    eval_addressing ge sp Aindexed2 (rs ## (r1 :: r2 :: nil))).
-  intros; simpl in *. rewrite H. auto.
-
-  assert (A2: forall r1 r2 n,
-    val_match_approx (I n) rs#r1 -> 
-    eval_addressing ge sp (Aindexed n) (rs ## (r2 :: nil)) =
-    eval_addressing ge sp Aindexed2 (rs ## (r1 :: r2 :: nil))).
-  intros. rewrite A0. apply A1. auto.
-
-  assert (A3: forall r1 r2 id ofs,
-    val_match_approx (S id ofs) rs#r1 ->
-    eval_addressing ge sp (Abased id ofs) (rs ## (r2 :: nil)) =
-    eval_addressing ge sp Aindexed2 (rs ## (r1 :: r2 :: nil))).
-  intros. elim H. intros b [A B]. simpl. rewrite A; rewrite B. auto.
-
-  assert (A4: forall r1 r2 id ofs,
-    val_match_approx (S id ofs) rs#r2 ->
-    eval_addressing ge sp (Abased id ofs) (rs ## (r1 :: nil)) =
-    eval_addressing ge sp Aindexed2 (rs ## (r1 :: r2 :: nil))).
-  intros. rewrite A0. apply A3. auto.
-
-  assert (A5: forall r1 r2 id ofs n,
-    val_match_approx (S id ofs) rs#r1 ->
-    val_match_approx (I n) rs#r2 ->
-    eval_addressing ge sp (Aglobal id (Int.add ofs n)) nil =
-    eval_addressing ge sp Aindexed2 (rs ## (r1 :: r2 :: nil))).
-  intros. elim H. intros b [A B]. simpl. rewrite A; rewrite B. 
-  simpl in H0. rewrite H0. auto.
-
-  unfold addr_strength_reduction;
-  case (addr_strength_reduction_match addr args); intros.
-
-  (* Aindexed2 *)
-  caseEq (D.get r1 approx); intros;
-  caseEq (D.get r2 approx); intros;
-  try reflexivity; KnownApprox; auto.
-  rewrite A0. rewrite Int.add_commut. apply A5; auto.
-
-  (* Abased *)
-  caseEq (intval approx r1); intros.
-  simpl; rewrite (intval_correct _ _ H). auto.
-  auto.
-
-  (* Aindexed *)
-  caseEq (D.get r1 approx); intros; auto.
-  simpl; KnownApprox. 
-  elim H0. intros b [A B]. rewrite A; rewrite B. auto.
-
-  (* default *)
-  reflexivity.
-Qed.
-
-End STRENGTH_REDUCTION.
-
-End ANALYSIS.
-
-(** * Correctness of the code transformation *)
-
-(** We now show that the transformed code after constant propagation
-  has the same semantics as the original code. *)
-
-Section PRESERVATION.
-
-Variable prog: program.
-Let tprog := transf_program prog.
-Let ge := Genv.globalenv prog.
-Let tge := Genv.globalenv tprog.
-
-Lemma symbols_preserved:
-  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof.
-  intros; unfold ge, tge, tprog, transf_program. 
-  apply Genv.find_symbol_transf.
-Qed.
-
-Lemma functions_translated:
-  forall (v: val) (f: fundef),
-  Genv.find_funct ge v = Some f ->
-  Genv.find_funct tge v = Some (transf_fundef f).
-Proof.  
-  intros.
-  exact (Genv.find_funct_transf transf_fundef H).
-Qed.
-
-Lemma function_ptr_translated:
-  forall (b: block) (f: fundef),
-  Genv.find_funct_ptr ge b = Some f ->
-  Genv.find_funct_ptr tge b = Some (transf_fundef f).
-Proof.  
-  intros. 
-  exact (Genv.find_funct_ptr_transf transf_fundef H).
-Qed.
-
-Lemma sig_function_translated:
-  forall f,
-  funsig (transf_fundef f) = funsig f.
-Proof.
-  intros. destruct f; reflexivity.
-Qed.
-
-Lemma transf_ros_correct:
-  forall ros rs f approx,
-  regs_match_approx ge approx rs ->
-  find_function ge ros rs = Some f ->
-  find_function tge (transf_ros approx ros) rs = Some (transf_fundef f).
-Proof.
-  intros until approx; intro MATCH.
-  destruct ros; simpl.
-  intro.
-  exploit functions_translated; eauto. intro FIND.  
-  caseEq (D.get r approx); intros; auto.
-  generalize (Int.eq_spec i0 Int.zero); case (Int.eq i0 Int.zero); intros; auto.
-  generalize (MATCH r). rewrite H0. intros [b [A B]].
-  rewrite <- symbols_preserved in A.
-  rewrite B in FIND. rewrite H1 in FIND. 
-  rewrite Genv.find_funct_find_funct_ptr in FIND.
-  simpl. rewrite A. auto.
-  rewrite symbols_preserved. destruct (Genv.find_symbol ge i).
-  intro. apply function_ptr_translated. auto.
-  congruence.
-Qed.
-
-(** The proof of semantic preservation is a simulation argument
-  based on diagrams of the following form:
-<<
-           st1 --------------- st2
-            |                   |
-           t|                   |t
-            |                   |
-            v                   v
-           st1'--------------- st2'
->>
-  The left vertical arrow represents a transition in the
-  original RTL code.  The top horizontal bar is the [match_states]
-  invariant between the initial state [st1] in the original RTL code
-  and an initial state [st2] in the transformed code.
-  This invariant expresses that all code fragments appearing in [st2]
-  are obtained by [transf_code] transformation of the corresponding
-  fragments in [st1].  Moreover, the values of registers in [st1]
-  must match their compile-time approximations at the current program
-  point.
-  These two parts of the diagram are the hypotheses.  In conclusions,
-  we want to prove the other two parts: the right vertical arrow,
-  which is a transition in the transformed RTL code, and the bottom
-  horizontal bar, which means that the [match_state] predicate holds
-  between the final states [st1'] and [st2']. *)
-
-Inductive match_stackframes: stackframe -> stackframe -> Prop :=
-   match_stackframe_intro:
-      forall res c sp pc rs f,
-      c = f.(RTL.fn_code) ->
-      (forall v, regs_match_approx ge (analyze f)!!pc (rs#res <- v)) ->
-    match_stackframes
-        (Stackframe res c sp pc rs)
-        (Stackframe res (transf_code (analyze f) c) sp pc rs).
-
-Inductive match_states: state -> state -> Prop :=
-  | match_states_intro:
-      forall s c sp pc rs m f s'
-           (CF: c = f.(RTL.fn_code))
-           (MATCH: regs_match_approx ge (analyze f)!!pc rs)
-           (STACKS: list_forall2 match_stackframes s s'),
-      match_states (State s c sp pc rs m)
-                   (State s' (transf_code (analyze f) c) sp pc rs m)
-  | match_states_call:
-      forall s f args m s',
-      list_forall2 match_stackframes s s' ->
-      match_states (Callstate s f args m)
-                   (Callstate s' (transf_fundef f) args m)
-  | match_states_return:
-      forall s s' v m,
-      list_forall2 match_stackframes s s' ->
-      match_states (Returnstate s v m)
-                   (Returnstate s' v m).
-
-Ltac TransfInstr :=
-  match goal with
-  | H1: (PTree.get ?pc ?c = Some ?instr), f: function |- _ =>
-      cut ((transf_code (analyze f) c)!pc = Some(transf_instr (analyze f)!!pc instr));
-      [ simpl
-      | unfold transf_code; rewrite PTree.gmap; 
-        unfold option_map; rewrite H1; reflexivity ]
-  end.
-
-(** The proof of simulation proceeds by case analysis on the transition
-  taken in the source code. *)
-
-Lemma transf_step_correct:
-  forall s1 t s2,
-  step ge s1 t s2 ->
-  forall s1' (MS: match_states s1 s1'),
-  exists s2', step tge s1' t s2' /\ match_states s2 s2'.
-Proof.
-  induction 1; intros; inv MS.
-
-  (* Inop *)
-  exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' rs m); split.
-  TransfInstr; intro. eapply exec_Inop; eauto.
-  econstructor; eauto.
-  eapply analyze_correct_1 with (pc := pc); eauto.
-  unfold successors; rewrite H; auto with coqlib.
-  unfold transfer; rewrite H. auto.
-
-  (* Iop *)
-  exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' (rs#res <- v) m); split.
-  TransfInstr. caseEq (op_strength_reduction (analyze f)!!pc op args);
-  intros op' args' OSR.
-  assert (eval_operation tge sp op' rs##args' m = Some v).
-    rewrite (eval_operation_preserved symbols_preserved). 
-    generalize (op_strength_reduction_correct ge (analyze f)!!pc sp rs
-                  MATCH op args m v).
-    rewrite OSR; simpl. auto.
-  generalize (eval_static_operation_correct ge op sp
-               (approx_regs args (analyze f)!!pc) rs##args m v
-               (approx_regs_val_list _ _ _ args MATCH) H0).
-  case (eval_static_operation op (approx_regs args (analyze f)!!pc)); intros;
-  simpl in H2;
-  eapply exec_Iop; eauto; simpl.
-  congruence.
-  congruence.
-  elim H2; intros b [A B]. rewrite symbols_preserved. 
-  rewrite A; rewrite B; auto.
-  econstructor; eauto. 
-  eapply analyze_correct_1 with (pc := pc); eauto.
-  unfold successors; rewrite H; auto with coqlib.
-  unfold transfer; rewrite H. 
-  apply regs_match_approx_update; auto. 
-  eapply eval_static_operation_correct; eauto.
-  apply approx_regs_val_list; auto.
-
-  (* Iload *)
-  caseEq (addr_strength_reduction (analyze f)!!pc addr args);
-  intros addr' args' ASR.
-  assert (eval_addressing tge sp addr' rs##args' = Some a).
-    rewrite (eval_addressing_preserved symbols_preserved). 
-    generalize (addr_strength_reduction_correct ge (analyze f)!!pc sp rs
-                  MATCH addr args).
-    rewrite ASR; simpl. congruence. 
-  TransfInstr. rewrite ASR. intro.
-  exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' (rs#dst <- v) m); split.
-  eapply exec_Iload; eauto.
-  econstructor; eauto. 
-  apply analyze_correct_1 with pc; auto. 
-  unfold successors; rewrite H; auto with coqlib.
-  unfold transfer; rewrite H. 
-  apply regs_match_approx_update; auto. simpl; auto.
-
-  (* Istore *)
-  caseEq (addr_strength_reduction (analyze f)!!pc addr args);
-  intros addr' args' ASR.
-  assert (eval_addressing tge sp addr' rs##args' = Some a).
-    rewrite (eval_addressing_preserved symbols_preserved). 
-    generalize (addr_strength_reduction_correct ge (analyze f)!!pc sp rs
-                  MATCH addr args).
-    rewrite ASR; simpl. congruence. 
-  TransfInstr. rewrite ASR. intro.
-  exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' rs m'); split.
-  eapply exec_Istore; eauto.
-  econstructor; eauto. 
-  apply analyze_correct_1 with pc; auto. 
-  unfold successors; rewrite H; auto with coqlib.
-  unfold transfer; rewrite H. auto. 
-
-  (* Icall *)
-  exploit transf_ros_correct; eauto. intro FIND'.
-  TransfInstr; intro.
-  econstructor; split.
-  eapply exec_Icall; eauto. apply sig_function_translated; auto.
-  constructor; auto. constructor; auto.
-  econstructor; eauto. 
-  intros. apply analyze_correct_1 with pc; auto.
-  unfold successors; rewrite H; auto with coqlib.
-  unfold transfer; rewrite H.
-  apply regs_match_approx_update; auto. simpl. auto.
-
-  (* Itailcall *)
-  exploit transf_ros_correct; eauto. intros FIND'.
-  TransfInstr; intro.
-  econstructor; split.
-  eapply exec_Itailcall; eauto. apply sig_function_translated; auto.
-  constructor; auto. 
-
-  (* Ialloc *)
-  TransfInstr; intro.
-  exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' (rs#res <- (Vptr b Int.zero)) m'); split.
-  eapply exec_Ialloc; eauto.
-  econstructor; eauto.
-  apply analyze_correct_1 with pc; auto. 
-  unfold successors; rewrite H; auto with coqlib.
-  unfold transfer; rewrite H. 
-  apply regs_match_approx_update; auto. simpl; auto.
-
-  (* Icond, true *)
-  exists (State s' (transf_code (analyze f) (fn_code f)) sp ifso rs m); split. 
-  caseEq (cond_strength_reduction (analyze f)!!pc cond args);
-  intros cond' args' CSR.
-  assert (eval_condition cond' rs##args' m = Some true).
-    generalize (cond_strength_reduction_correct
-                  ge (analyze f)!!pc rs MATCH cond args m).
-    rewrite CSR.  intro. congruence.
-  TransfInstr. rewrite CSR. 
-  caseEq (eval_static_condition cond (approx_regs args (analyze f)!!pc)).
-  intros b ESC. 
-  generalize (eval_static_condition_correct ge cond _ _ m _
-               (approx_regs_val_list _ _ _ args MATCH) ESC); intro.
-  replace b with true. intro; eapply exec_Inop; eauto. congruence.
-  intros. eapply exec_Icond_true; eauto.
-  econstructor; eauto.
-  apply analyze_correct_1 with pc; auto. 
-  unfold successors; rewrite H; auto with coqlib.
-  unfold transfer; rewrite H; auto.
-
-  (* Icond, false *)
-  exists (State s' (transf_code (analyze f) (fn_code f)) sp ifnot rs m); split. 
-  caseEq (cond_strength_reduction (analyze f)!!pc cond args);
-  intros cond' args' CSR.
-  assert (eval_condition cond' rs##args' m = Some false).
-    generalize (cond_strength_reduction_correct
-                  ge (analyze f)!!pc rs MATCH cond args m).
-    rewrite CSR.  intro. congruence.
-  TransfInstr. rewrite CSR. 
-  caseEq (eval_static_condition cond (approx_regs args (analyze f)!!pc)).
-  intros b ESC. 
-  generalize (eval_static_condition_correct ge cond _ _ m _
-               (approx_regs_val_list _ _ _ args MATCH) ESC); intro.
-  replace b with false. intro; eapply exec_Inop; eauto. congruence.
-  intros. eapply exec_Icond_false; eauto.
-  econstructor; eauto.
-  apply analyze_correct_1 with pc; auto. 
-  unfold successors; rewrite H; auto with coqlib.
-  unfold transfer; rewrite H; auto.
-
-  (* Ireturn *)
-  exists (Returnstate s' (regmap_optget or Vundef rs) (free m stk)); split.
-  eapply exec_Ireturn; eauto. TransfInstr; auto.
-  constructor; auto.
-
-  (* internal function *)
-  simpl. unfold transf_function.
-  econstructor; split.
-  eapply exec_function_internal; simpl; eauto.
-  simpl. econstructor; eauto.
-  apply analyze_correct_3; auto.
-
-  (* external function *)
-  simpl. econstructor; split.
-  eapply exec_function_external; eauto.
-  constructor; auto.
-
-  (* return *)
-  inv H3. inv H1. 
-  econstructor; split.
-  eapply exec_return; eauto. 
-  econstructor; eauto. 
-Qed.
-
-Lemma transf_initial_states:
-  forall st1, initial_state prog st1 ->
-  exists st2, initial_state tprog st2 /\ match_states st1 st2.
-Proof.
-  intros. inversion H.
-  exploit function_ptr_translated; eauto. intro FIND.
-  exists (Callstate nil (transf_fundef f) nil (Genv.init_mem tprog)); split.
-  econstructor; eauto.
-  replace (prog_main tprog) with (prog_main prog).
-  rewrite symbols_preserved. eauto.
-  reflexivity.
-  rewrite <- H2. apply sig_function_translated.
-  replace (Genv.init_mem tprog) with (Genv.init_mem prog).
-  constructor. constructor. auto.
-  symmetry. unfold tprog, transf_program. apply Genv.init_mem_transf. 
-Qed.
-
-Lemma transf_final_states:
-  forall st1 st2 r, 
-  match_states st1 st2 -> final_state st1 r -> final_state st2 r.
-Proof.
-  intros. inv H0. inv H. inv H4. constructor. 
-Qed.
-
-(** The preservation of the observable behavior of the program then
-  follows, using the generic preservation theorem
-  [Smallstep.simulation_step_preservation]. *)
-
-Theorem transf_program_correct:
-  forall (beh: program_behavior),
-  exec_program prog beh -> exec_program tprog beh.
-Proof.
-  unfold exec_program; intros.
-  eapply simulation_step_preservation; eauto.
-  eexact transf_initial_states.
-  eexact transf_final_states.
-  exact transf_step_correct. 
-Qed.
-
-End PRESERVATION.
diff --git a/backend/Conventions.v b/backend/Conventions.v
deleted file mode 100644
index b7d931f5..00000000
--- a/backend/Conventions.v
+++ /dev/null
@@ -1,805 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** 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 PowerPC application binary interface (ABI) in our choice
-  of callee- and caller-save registers.
-*)
-
-Definition int_caller_save_regs :=
-  R3 :: R4 :: R5 :: R6 :: R7 :: R8 :: R9 :: R10 :: nil.
-
-Definition float_caller_save_regs :=
-  F1 :: F2 :: F3 :: F4 :: F5 :: F6 :: F7 :: F8 :: F9 :: F10 :: nil.
-
-Definition int_callee_save_regs :=
-  R13 :: R14 :: R15 :: R16 :: R17 :: R18 :: R19 :: R20 :: R21 :: R22 :: 
-  R23 :: R24 :: R25 :: R26 :: R27 :: R28 :: R29 :: R30 :: R31 :: nil.
-
-Definition float_callee_save_regs :=
-  F14 :: F15 :: F16 :: F17 :: F18 :: F19 :: F20 :: F21 :: F22 :: 
-  F23 :: F24 :: F25 :: F26 :: F27 :: F28 :: F29 :: F30 :: F31 :: 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 :: FT3 :: nil.
-  
-Definition temporaries := 
-  R IT1 :: R IT2 :: R FT1 :: R FT2 :: R FT3 :: nil.
-
-(** 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
-  | R13 => 0  | R14 => 1  | R15 => 2  | R16 => 3
-  | R17 => 4  | R18 => 5  | R19 => 6  | R20 => 7
-  | R21 => 8  | R22 => 9  | R23 => 10 | R24 => 11
-  | R25 => 12 | R26 => 13 | R27 => 14 | R28 => 15
-  | R29 => 16 | R30 => 17 | R31 => 18 | _ => -1
-  end.
-
-Definition index_float_callee_save (r: mreg) :=
-  match r with
-  | F14 => 0  | F15 => 1  | F16 => 2  | F17 => 3
-  | F18 => 4  | F19 => 5  | F20 => 6  | F21 => 7
-  | F22 => 8  | F23 => 9  | F24 => 10 | F25 => 11
-  | F26 => 12 | F27 => 13 | F28 => 14 | F29 => 15
-  | F30 => 16 | F31 => 17 | _ => -1
-  end.
-
-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.
-  destruct r; simpl; intro; omegaContradiction || OrEq.
-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.
-  intros r1 r2. 
-  simpl; ElimOrEq; ElimOrEq; unfold index_float_callee_save;
-  intros; congruence.
-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.
-
-(** * Acceptable locations for register allocation *)
-
-(** The following predicate describes the locations that can be assigned
-  to an RTL pseudo-register during register allocation: a non-temporary
-  machine register or a [Local] stack slot are acceptable. *)
-
-Definition loc_acceptable (l: loc) : Prop :=
-  match l with
-  | R r => ~(In l temporaries)
-  | S (Local ofs ty) => ofs >= 0
-  | S (Incoming _ _) => False
-  | S (Outgoing _ _) => False
-  end.
-
-Definition locs_acceptable (ll: list loc) : Prop :=
-  forall l, In l ll -> loc_acceptable l.
-
-Lemma temporaries_not_acceptable:
-  forall l, loc_acceptable l -> Loc.notin l temporaries.
-Proof.
-  unfold loc_acceptable; destruct l.
-  simpl. intuition congruence.
-  destruct s; try contradiction. 
-  intro. simpl. tauto.
-Qed.
-Hint Resolve temporaries_not_acceptable: locs.
-
-Lemma locs_acceptable_disj_temporaries:
-  forall ll, locs_acceptable ll -> Loc.disjoint ll temporaries.
-Proof.
-  intros. apply Loc.notin_disjoint. intros.
-  apply temporaries_not_acceptable. auto. 
-Qed.
-
-Lemma loc_acceptable_noteq_diff:
-  forall l1 l2,
-  loc_acceptable l1 -> l1 <> l2 -> Loc.diff l1 l2.
-Proof.
-  unfold loc_acceptable, Loc.diff; destruct l1; destruct l2;
-  try (destruct s); try (destruct s0); intros; auto; try congruence.
-  case (zeq z z0); intro. 
-  compare t t0; intro.
-  subst z0; subst t0; tauto.
-  tauto. tauto.
-  contradiction. contradiction.
-Qed.
-
-Lemma loc_acceptable_notin_notin:
-  forall r ll,
-  loc_acceptable r ->
-  ~(In r ll) -> Loc.notin r ll.
-Proof.
-  induction ll; simpl; intros.
-  auto.
-  split. apply loc_acceptable_noteq_diff. assumption. 
-  apply sym_not_equal. tauto. 
-  apply IHll. assumption. tauto. 
-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 PowerPC compiler, we
-  implement the standard conventions defined in the PowerPC application
-  binary interface. *)
-
-(** ** Location of function result *)
-
-(** The result value of a function is passed back to the caller in
-  registers [R3] or [F1], 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 => R3
-  | Some Tint => R3
-  | Some Tfloat => F1
-  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 acceptable. *)
-
-Lemma loc_result_acceptable:
-  forall sig, loc_acceptable (R (loc_result sig)).
-Proof.
-  intros. unfold loc_acceptable. red.
-  unfold loc_result. destruct (sig_res sig).
-  destruct t; simpl; NotOrEq.
-  simpl; NotOrEq.
-Qed.
-
-(** The result location is a caller-save register. *)
-
-Lemma loc_result_caller_save:
-  forall (s: signature), In (R (loc_result s)) destroyed_at_call.
-Proof.
-  intros; unfold loc_result.
-  destruct (sig_res s). 
-  destruct t; simpl; OrEq.
-  simpl; OrEq.
-Qed.
-
-(** The result location is not a callee-save register. *)
-
-Lemma loc_result_not_callee_save:
-  forall (s: signature),
-  ~(In (loc_result s) int_callee_save_regs \/ In (loc_result s) float_callee_save_regs).
-Proof.
-  intros. generalize (loc_result_caller_save s).
-  generalize (int_callee_save_not_destroyed (loc_result s)).
-  generalize (float_callee_save_not_destroyed (loc_result s)).
-  tauto.
-Qed.
-
-(** ** Location of function arguments *)
-
-(** The PowerPC ABI states the following convention for passing arguments
-  to a function:
-- The first 8 integer arguments are passed in registers [R3] to [R10].
-- The first 10 float arguments are passed in registers [F1] to [F10].
-- Each float argument passed in a float register ``consumes'' two
-  integer arguments.
-- Extra arguments are passed on the stack, in [Outgoing] slots, consecutively
-  assigned (1 word for an integer argument, 2 words for a float),
-  starting at word offset 0.
-- Stack space is reserved (as unused [Outgoing] slots) for the arguments
-  that are passed in registers.
-
-These conventions are somewhat baroque, but they are mandated by the ABI.
-*)
-
-Fixpoint loc_arguments_rec
-    (tyl: list typ) (iregl: list mreg) (fregl: list mreg)
-    (ofs: Z) {struct tyl} : list loc :=
-  match tyl with
-  | nil => nil
-  | Tint :: tys =>
-      match iregl with
-      | nil =>
-          S (Outgoing ofs Tint) :: loc_arguments_rec tys nil fregl (ofs + 1)
-      | ireg :: iregs =>
-          R ireg :: loc_arguments_rec tys iregs fregl ofs
-      end
-  | Tfloat :: tys =>
-      match fregl with
-      | nil =>
-          S (Outgoing ofs Tfloat) :: loc_arguments_rec tys iregl nil (ofs + 2)
-      | freg :: fregs =>
-          R freg :: loc_arguments_rec tys (list_drop2 iregl) fregs ofs
-      end
-  end.
-
-Definition int_param_regs :=
-  R3 :: R4 :: R5 :: R6 :: R7 :: R8 :: R9 :: R10 :: nil.
-Definition float_param_regs :=
-  F1 :: F2 :: F3 :: F4 :: F5 :: F6 :: F7 :: F8 :: F9 :: F10 :: nil.
-
-(** [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) int_param_regs float_param_regs 8.
-
-(** [size_arguments s] returns the number of [Outgoing] slots used
-  to call a function with signature [s]. *)
-
-Fixpoint size_arguments_rec
-    (tyl: list typ) (iregl: list mreg) (fregl: list mreg)
-    (ofs: Z) {struct tyl} : Z :=
-  match tyl with
-  | nil => ofs
-  | Tint :: tys =>
-      match iregl with
-      | nil => size_arguments_rec tys nil fregl (ofs + 1)
-      | ireg :: iregs => size_arguments_rec tys iregs fregl ofs
-      end
-  | Tfloat :: tys =>
-      match fregl with
-      | nil => size_arguments_rec tys iregl nil (ofs + 2)
-      | freg :: fregs => size_arguments_rec tys (list_drop2 iregl) fregs ofs
-      end
-  end.
-
-Definition size_arguments (s: signature) : Z :=
-  size_arguments_rec s.(sig_args) int_param_regs float_param_regs 8.
-
-(** 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 iregl fregl ofs l,
-  In l (loc_arguments_rec tyl iregl fregl ofs) ->
-  match l with
-  | R r => In r iregl \/ In r fregl
-  | S (Outgoing ofs' ty) => ofs' >= ofs
-  | S _ => False
-  end.
-Proof.
-  induction tyl; simpl loc_arguments_rec; intros.
-  elim H.
-  destruct a. 
-  destruct iregl; elim H; intro. 
-  subst l. omega.
-  generalize (IHtyl _ _ _ _ H0). destruct l; auto. destruct s; auto. omega.
-  subst l. auto with coqlib.
-  generalize (IHtyl _ _ _ _ H0). destruct l; auto. simpl; intuition.
-  destruct fregl; elim H; intro. 
-  subst l. omega.
-  generalize (IHtyl _ _ _ _ H0). destruct l; auto. destruct s; auto. omega.
-  subst l. auto with coqlib.
-  generalize (IHtyl _ _ _ _ H0). destruct l; auto.
-  intros [A|B]. left; apply list_drop2_incl; auto. right; auto with coqlib.
-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.
-  intro H0; elim H0. simpl. unfold not. ElimOrEq; NotOrEq.
-  simpl. unfold not. ElimOrEq; NotOrEq.
-  destruct s0; try contradiction.
-  simpl. omega. 
-Qed. 
-Hint Resolve loc_arguments_acceptable: locs.
-
-(** Arguments are parwise disjoint (in the sense of [Loc.norepet]). *)
-
-Remark loc_arguments_rec_notin_reg:
-  forall tyl iregl fregl ofs r,
-  ~(In r iregl) -> ~(In r fregl) ->
-  Loc.notin (R r) (loc_arguments_rec tyl iregl fregl ofs).
-Proof.
-  induction tyl; simpl; intros.
-  auto.
-  destruct a. 
-  destruct iregl; simpl. auto.
-  simpl in H. split. apply sym_not_equal. tauto.
-  apply IHtyl. tauto. tauto.
-  destruct fregl; simpl. auto.
-  simpl in H0. split. apply sym_not_equal. tauto.
-  apply IHtyl. 
-  red; intro. apply H. apply list_drop2_incl. auto.
-  tauto.
-Qed.
-
-Remark loc_arguments_rec_notin_local:
-  forall tyl iregl fregl ofs ofs0 ty0,
-  Loc.notin (S (Local ofs0 ty0)) (loc_arguments_rec tyl iregl fregl ofs).
-Proof.
-  induction tyl; simpl; intros.
-  auto.
-  destruct a.
-  destruct iregl; simpl; auto.
-  destruct fregl; simpl; auto.
-Qed.
-
-Remark loc_arguments_rec_notin_outgoing:
-  forall tyl iregl fregl ofs ofs0 ty0,
-  ofs0 + typesize ty0 <= ofs ->
-  Loc.notin (S (Outgoing ofs0 ty0)) (loc_arguments_rec tyl iregl fregl ofs).
-Proof.
-  induction tyl; simpl; intros.
-  auto.
-  destruct a.
-  destruct iregl; simpl. 
-  split. omega. eapply IHtyl. omega.
-  auto.
-  destruct fregl; simpl. 
-  split. omega. eapply IHtyl. omega.
-  auto.
-Qed.
-
-Lemma loc_arguments_norepet:
-  forall (s: signature), Loc.norepet (loc_arguments s).
-Proof.
-  assert (forall tyl iregl fregl ofs,
-    list_norepet iregl ->
-    list_norepet fregl ->
-    list_disjoint iregl fregl ->
-    Loc.norepet (loc_arguments_rec tyl iregl fregl ofs)).
-  induction tyl; simpl; intros.
-  constructor.
-  destruct a. 
-  destruct iregl; constructor.
-  apply loc_arguments_rec_notin_outgoing. simpl; omega. auto.
-  apply loc_arguments_rec_notin_reg. inversion H. auto.
-  apply list_disjoint_notin with (m :: iregl); auto with coqlib.
-  apply IHtyl. inv H; auto. auto.
-  eapply list_disjoint_cons_left; eauto.
-  destruct fregl; constructor.
-  apply loc_arguments_rec_notin_outgoing. simpl; omega. auto.
-  apply loc_arguments_rec_notin_reg.
-  red; intro. apply (H1 m m). apply list_drop2_incl; auto. 
-  auto with coqlib. auto. inv H0; auto.
-  apply IHtyl. apply list_drop2_norepet; auto.
-  inv H0; auto. 
-  red; intros. apply H1. apply list_drop2_incl; auto. auto with coqlib.
-
-  intro. unfold loc_arguments. apply H.
-  unfold int_param_regs. NoRepet.
-  unfold float_param_regs. NoRepet.
-  red; intros x y; simpl. ElimOrEq; ElimOrEq; discriminate.
-Qed.
-
-(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)
-
-Remark size_arguments_rec_above:
-  forall tyl iregl fregl ofs0,
-  ofs0 <= size_arguments_rec tyl iregl fregl ofs0.
-Proof.
-  induction tyl; simpl; intros.
-  omega.
-  destruct a.
-  destruct iregl. apply Zle_trans with (ofs0 + 1); auto; omega. auto.
-  destruct fregl. apply Zle_trans with (ofs0 + 2); auto; omega. auto.
-Qed.
-
-Lemma size_arguments_above:
-  forall s, size_arguments s >= 0.
-Proof.
-  intros; unfold size_arguments. apply Zle_ge. apply Zle_trans with 8. omega. 
-  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.
-  assert (forall tyl iregl fregl ofs0,
-    In (S (Outgoing ofs ty)) (loc_arguments_rec tyl iregl fregl ofs0) ->
-    ofs + typesize ty <= size_arguments_rec tyl iregl fregl ofs0).
-  induction tyl; simpl; intros.
-  elim H0.
-  destruct a. destruct iregl; elim H0; intro.
-  inv H1. simpl. apply size_arguments_rec_above. auto.
-  discriminate. auto. 
-  destruct fregl; elim H0; intro.
-  inv H1. simpl. apply size_arguments_rec_above. auto.
-  discriminate. auto. 
-  unfold size_arguments. eapply H0. unfold loc_arguments in H. eauto.
-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. 
-  intro H0; elim H0; simpl; (ElimOrEq; ElimOrEq; congruence).
-  destruct s; try contradiction. intro.
-  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.
-  ElimOrEq; intuition.
-  ElimOrEq; intuition.
-Qed.
-
-(** Callee-save registers do not overlap with argument locations. *)
-
-Lemma arguments_not_preserved:
-  forall sig l,
-  Loc.notin l destroyed_at_call -> loc_acceptable l ->
-  Loc.notin l (loc_arguments sig).
-Proof.
-  intros. unfold loc_arguments. destruct l.
-  apply loc_arguments_rec_notin_reg. 
-  generalize (Loc.notin_not_in _ _ H). intro; red; intro.
-  apply H1. generalize H2. simpl. ElimOrEq; OrEq. 
-  generalize (Loc.notin_not_in _ _ H). intro; red; intro.
-  apply H1. generalize H2. simpl. ElimOrEq; OrEq. 
-  destruct s; simpl in H0; try contradiction.
-  apply loc_arguments_rec_notin_local.
-Qed.
-Hint Resolve arguments_not_preserved: locs.
-
-(** 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.
-  assert (forall tyl iregl fregl ofs,
-    List.length (loc_arguments_rec tyl iregl fregl ofs) = List.length tyl).
-  induction tyl; simpl; intros.
-  auto.
-  destruct a. 
-  destruct iregl; simpl; decEq; auto.
-  destruct fregl; simpl; decEq; auto.
-  intros. unfold loc_arguments. 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.
-  assert (forall tyl iregl fregl ofs,
-    (forall r, In r iregl -> mreg_type r = Tint) ->
-    (forall r, In r fregl -> mreg_type r = Tfloat) ->
-    List.map Loc.type (loc_arguments_rec tyl iregl fregl ofs) = tyl).
-  induction tyl; simpl; intros.
-  auto.
-  destruct a; [destruct iregl|destruct fregl]; simpl;
-  f_equal; eauto with coqlib.
-  apply IHtyl. intros. apply H. apply list_drop2_incl; auto.
-  eauto with coqlib.
-
-  intros. unfold loc_arguments. apply H. 
-  intro; simpl. ElimOrEq; reflexivity.
-  intro; simpl. ElimOrEq; reflexivity.
-Qed.
-
-(** There is no partial overlap between an argument location and an
-  acceptable location: they are either identical or disjoint. *)
-
-Lemma no_overlap_arguments:
-  forall args sg,
-  locs_acceptable args ->
-  Loc.no_overlap args (loc_arguments sg).
-Proof.
-  unfold Loc.no_overlap; intros.
-  generalize (H r H0).
-  generalize (loc_arguments_acceptable _ _ H1).
-  destruct s; destruct r; simpl.
-  intros. case (mreg_eq m0 m); intro. left; congruence. tauto.
-  intros. right; destruct s; auto.
-  intros. right. auto.
-  destruct s; try tauto. destruct s0; tauto.
-Qed.
-
-(** Decide whether a tailcall is possible. *)
-
-Definition tailcall_is_possible (sg: signature) : bool :=
-  let fix tcisp (l: list loc) :=
-    match l with
-    | nil => true
-    | R _ :: l' => tcisp l'
-    | S _ :: l' => false
-    end
-  in tcisp (loc_arguments sg).
-
-Lemma tailcall_is_possible_correct:
-  forall s, tailcall_is_possible s = true -> tailcall_possible s.
-Proof.
-  intro s. unfold tailcall_is_possible, tailcall_possible.
-  generalize (loc_arguments s). induction l; simpl; intros.
-  elim H0.
-  destruct a. 
-  destruct H0. subst l0. auto. apply IHl. auto. auto. discriminate.
-Qed.
-
-(** ** Location of function parameters *)
-
-(** A function finds the values of its parameter in the same locations
-  where its caller stored them, except that the stack-allocated arguments,
-  viewed as [Outgoing] slots by the caller, are accessed via [Incoming]
-  slots (at the same offsets and types) in the callee. *)
-
-Definition parameter_of_argument (l: loc) : loc :=
-  match l with
-  | S (Outgoing n ty) => S (Incoming n ty)
-  | _ => l
-  end.
-
-Definition loc_parameters (s: signature) :=
-  List.map parameter_of_argument (loc_arguments s).
-
-Lemma loc_parameters_type:
-  forall sig, List.map Loc.type (loc_parameters sig) = sig.(sig_args).
-Proof.
-  intros. unfold loc_parameters.
-  rewrite list_map_compose. 
-  rewrite <- loc_arguments_type.
-  apply list_map_exten.
-  intros. destruct x; simpl. auto. 
-  destruct s; reflexivity.
-Qed.
-
-Lemma loc_parameters_length:
-  forall sg, List.length (loc_parameters sg) = List.length sg.(sig_args).
-Proof.
-  intros. unfold loc_parameters. rewrite list_length_map. 
-  apply loc_arguments_length.
-Qed.
-
-Lemma loc_parameters_not_temporaries:
-  forall sig, Loc.disjoint (loc_parameters sig) temporaries.
-Proof.
-  intro; red; intros.
-  unfold loc_parameters in H. 
-  elim (list_in_map_inv _ _ _ H). intros y [EQ IN].
-  generalize (loc_arguments_not_temporaries sig y x2 IN H0).
-  subst x1. destruct x2.
-  destruct y; simpl. auto. destruct s; auto.
-  byContradiction. generalize H0. simpl. NotOrEq.
-Qed.
-
-Lemma no_overlap_parameters:
-  forall params sg,
-  locs_acceptable params ->
-  Loc.no_overlap (loc_parameters sg) params.
-Proof.
-  unfold Loc.no_overlap; intros.
-  unfold loc_parameters in H0. 
-  elim (list_in_map_inv _ _ _ H0). intros t [EQ IN].
-  rewrite EQ. 
-  generalize (loc_arguments_acceptable _ _ IN).
-  generalize (H s H1).
-  destruct s; destruct t; simpl.
-  intros. case (mreg_eq m0 m); intro. left; congruence. tauto.
-  intros. right; destruct s; simpl; auto.
-  intros; right; auto.
-  destruct s; try tauto. destruct s0; try tauto. 
-  intros; simpl. tauto.
-Qed.
-
-(** ** Location of argument and result for dynamic memory allocation *)
-
-Definition loc_alloc_argument := R3.
-Definition loc_alloc_result := R3.
diff --git a/backend/Linear.v b/backend/Linear.v
index 900b6a50..629dcc53 100644
--- a/backend/Linear.v
+++ b/backend/Linear.v
@@ -337,7 +337,7 @@ Inductive initial_state (p: program): state -> Prop :=
 
 Inductive final_state: state -> int -> Prop :=
   | final_state_intro: forall rs m r,
-      rs (R R3) = Vint r ->
+      rs (R (Conventions.loc_result (mksignature nil (Some Tint)))) = Vint r ->
       final_state (Returnstate nil rs m) r.
 
 Definition exec_program (p: program) (beh: program_behavior) : Prop :=
diff --git a/backend/Linearizeaux.ml b/backend/Linearizeaux.ml
new file mode 100644
index 00000000..2f2333fb
--- /dev/null
+++ b/backend/Linearizeaux.ml
@@ -0,0 +1,85 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+open BinPos
+open Coqlib
+open Datatypes
+open LTL
+open Lattice
+open CList
+open Maps
+open Camlcoq
+
+(* Trivial enumeration, in decreasing order of PC *)
+
+(***
+let enumerate_aux f reach =
+  positive_rec
+    Coq_nil
+    (fun pc nodes ->
+      if PMap.get pc reach
+      then Coq_cons (pc, nodes)
+      else nodes) 
+    f.fn_nextpc
+***)
+
+(* More clever enumeration that flattens basic blocks *)
+
+let rec int_of_pos = function
+  | Coq_xI p -> (int_of_pos p lsl 1) + 1
+  | Coq_xO p -> int_of_pos p lsl 1
+  | Coq_xH -> 1
+
+let rec pos_of_int n =
+  if n = 0 then assert false else
+  if n = 1 then Coq_xH else
+  if n land 1 = 0
+  then Coq_xO (pos_of_int (n lsr 1))
+  else Coq_xI (pos_of_int (n lsr 1))
+
+(* Build the enumeration *)
+
+module IntSet = Set.Make(struct type t = int let compare = compare end)
+
+let enumerate_aux f reach =
+  let enum = ref [] in
+  let emitted = Array.make (int_of_pos f.fn_nextpc) false in
+  let rec emit_block pending pc =
+    let npc = int_of_pos pc in
+    if emitted.(npc)
+    then emit_restart pending
+    else begin
+      enum := pc :: !enum;
+      emitted.(npc) <- true;
+      match PTree.get pc f.fn_code with
+      | None -> assert false
+      | Some i ->
+         match i with
+           | Lnop s -> emit_block pending s
+           | Lop (op, args, res, s) -> emit_block pending s
+           | Lload (chunk, addr, args, dst, s) -> emit_block pending s
+           | Lstore (chunk, addr, args, src, s) -> emit_block pending s
+           | Lcall (sig0, ros, args, res, s) -> emit_block pending s
+           | Ltailcall (sig0, ros, args) -> emit_restart pending
+           | Lalloc (arg, res, s) -> emit_block pending s
+           | Lcond (cond, args, ifso, ifnot) ->
+               emit_restart (IntSet.add (int_of_pos ifso)
+                             (IntSet.add (int_of_pos ifnot) pending))
+           | Lreturn optarg -> emit_restart pending
+    end
+  and emit_restart pending =
+    if not (IntSet.is_empty pending) then begin
+      let npc = IntSet.max_elt pending in
+      emit_block (IntSet.remove npc pending) (pos_of_int npc)
+    end in
+  emit_block IntSet.empty f.fn_entrypoint;
+  CList.rev !enum
diff --git a/backend/Linearizeproof.v b/backend/Linearizeproof.v
index 3451cdb5..8378332e 100644
--- a/backend/Linearizeproof.v
+++ b/backend/Linearizeproof.v
@@ -546,8 +546,9 @@ Proof.
   exploit find_label_lin_succ; eauto. inv WTI; auto. intros [c'' AT'].
   econstructor; split.
   eapply plus_left'.
-  eapply exec_Lload; eauto.
+  apply exec_Lload with a.
   rewrite <- H0. apply eval_addressing_preserved. exact symbols_preserved.
+  eauto.
   eapply add_branch_correct; eauto.
   eapply is_tail_add_branch. eapply is_tail_cons_left. 
   eapply is_tail_find_label. eauto.
@@ -562,8 +563,9 @@ Proof.
   exploit find_label_lin_succ; eauto. inv WTI; auto. intros [c'' AT'].
   econstructor; split.
   eapply plus_left'.
-  eapply exec_Lstore; eauto.
+  apply exec_Lstore with a. 
   rewrite <- H0. apply eval_addressing_preserved. exact symbols_preserved.
+  eauto.
   eapply add_branch_correct; eauto.
   eapply is_tail_add_branch. eapply is_tail_cons_left. 
   eapply is_tail_find_label. eauto.
diff --git a/backend/Locations.v b/backend/Locations.v
index b03657c0..ca2f5272 100644
--- a/backend/Locations.v
+++ b/backend/Locations.v
@@ -17,102 +17,17 @@ Require Import Coqlib.
 Require Import Maps.
 Require Import AST.
 Require Import Values.
+Require Export Machregs.
 
 (** * Representation of locations *)
 
 (** A location is either a processor register or (an abstract designation of)
   a slot in the activation record of the current function. *)
 
-(** ** 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 machine registers
-  such as the stack pointer and the condition codes. *)
-
-Inductive mreg: Set :=
-  (** Allocatable integer regs *)
-  | R3: mreg  | R4: mreg  | R5: mreg  | R6: mreg
-  | R7: mreg  | R8: mreg  | R9: mreg  | R10: mreg
-  | R13: mreg | R14: mreg | R15: mreg | R16: mreg
-  | R17: mreg | R18: mreg | R19: mreg | R20: mreg
-  | R21: mreg | R22: mreg | R23: mreg | R24: mreg
-  | R25: mreg | R26: mreg | R27: mreg | R28: mreg
-  | R29: mreg | R30: mreg | R31: mreg
-  (** Allocatable float regs *)
-  | F1: mreg  | F2: mreg  | F3: mreg  | F4: mreg
-  | F5: mreg  | F6: mreg  | F7: mreg  | F8: mreg
-  | F9: mreg  | F10: mreg | F14: mreg | F15: mreg
-  | F16: mreg | F17: mreg | F18: mreg | F19: mreg
-  | F20: mreg | F21: mreg | F22: mreg | F23: mreg
-  | F24: mreg | F25: mreg | F26: mreg | F27: mreg
-  | F28: mreg | F29: mreg | F30: mreg | F31: mreg
-  (** Integer temporaries *)
-  | IT1: mreg (* R11 *) | IT2: mreg (* R0 *)
-  (** Float temporaries *)
-  | FT1: mreg (* F11 *) | FT2: mreg (* F12 *) | FT3: mreg (* F0 *).
-
-Lemma mreg_eq: forall (r1 r2: mreg), {r1 = r2} + {r1 <> r2}.
-Proof. decide equality. Qed.
-
-Definition mreg_type (r: mreg): typ :=
-  match r with
-  | R3 => Tint  | R4 => Tint  | R5 => Tint  | R6 => Tint
-  | R7 => Tint  | R8 => Tint  | R9 => Tint  | R10 => Tint
-  | R13 => Tint | R14 => Tint | R15 => Tint | R16 => Tint
-  | R17 => Tint | R18 => Tint | R19 => Tint | R20 => Tint
-  | R21 => Tint | R22 => Tint | R23 => Tint | R24 => Tint
-  | R25 => Tint | R26 => Tint | R27 => Tint | R28 => Tint
-  | R29 => Tint | R30 => Tint | R31 => Tint
-  | F1 => Tfloat  | F2 => Tfloat  | F3 => Tfloat  | F4 => Tfloat
-  | F5 => Tfloat  | F6 => Tfloat  | F7 => Tfloat  | F8 => Tfloat
-  | F9 => Tfloat  | F10 => Tfloat | F14 => Tfloat | F15 => Tfloat
-  | F16 => Tfloat | F17 => Tfloat | F18 => Tfloat | F19 => Tfloat
-  | F20 => Tfloat | F21 => Tfloat | F22 => Tfloat | F23 => Tfloat
-  | F24 => Tfloat | F25 => Tfloat | F26 => Tfloat | F27 => Tfloat
-  | F28 => Tfloat | F29 => Tfloat | F30 => Tfloat | F31 => Tfloat
-  | IT1 => Tint | IT2 => Tint
-  | FT1 => Tfloat | FT2 => Tfloat | FT3 => Tfloat
-  end.
+(** ** Processor registers *)
 
-Open Scope positive_scope.
-
-Module IndexedMreg <: INDEXED_TYPE.
-  Definition t := mreg.
-  Definition eq := mreg_eq.
-  Definition index (r: mreg): positive :=
-    match r with
-    | R3 => 1  | R4 => 2  | R5 => 3  | R6 => 4
-    | R7 => 5  | R8 => 6  | R9 => 7  | R10 => 8
-    | R13 => 9 | R14 => 10 | R15 => 11 | R16 => 12
-    | R17 => 13 | R18 => 14 | R19 => 15 | R20 => 16
-    | R21 => 17 | R22 => 18 | R23 => 19 | R24 => 20
-    | R25 => 21 | R26 => 22 | R27 => 23 | R28 => 24
-    | R29 => 25 | R30 => 26 | R31 => 27
-    | F1 => 28  | F2 => 29  | F3 => 30  | F4 => 31
-    | F5 => 32  | F6 => 33  | F7 => 34  | F8 => 35
-    | F9 => 36  | F10 => 37 | F14 => 38 | F15 => 39
-    | F16 => 40 | F17 => 41 | F18 => 42 | F19 => 43
-    | F20 => 44 | F21 => 45 | F22 => 46 | F23 => 47
-    | F24 => 48 | F25 => 49 | F26 => 50 | F27 => 51
-    | F28 => 52 | F29 => 53 | F30 => 54 | F31 => 55
-    | IT1 => 56 | IT2 => 57
-    | FT1 => 58 | FT2 => 59 | FT3 => 60
-    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.
+(** Processor registers usable for register allocation are defined
+  in module [Machregs]. *)
 
 (** ** Slots in activation records *)
 
diff --git a/backend/Machabstr.v b/backend/Machabstr.v
index 9ef75ec8..e145c896 100644
--- a/backend/Machabstr.v
+++ b/backend/Machabstr.v
@@ -26,7 +26,7 @@ Require Import Op.
 Require Import Locations.
 Require Conventions.
 Require Import Mach.
-Require Stacking.
+Require Stacklayout.
 
 (** This file defines the "abstract" semantics for the Mach
   intermediate language, as opposed to the more concrete
@@ -134,7 +134,7 @@ Inductive extcall_arg: regset -> frame -> loc -> val -> Prop :=
   | extcall_arg_reg: forall rs fr r,
       extcall_arg rs fr (R r) (rs r)
   | extcall_arg_stack: forall rs fr ofs ty v,
-      get_slot fr ty (Int.signed (Int.repr (Stacking.fe_ofs_arg + 4 * ofs))) v ->
+      get_slot fr ty (Int.signed (Int.repr (Stacklayout.fe_ofs_arg + 4 * ofs))) v ->
       extcall_arg rs fr (S (Outgoing ofs ty)) v.
 
 Inductive extcall_args: regset -> frame -> list loc -> list val -> Prop :=
@@ -323,7 +323,7 @@ Inductive initial_state (p: program): state -> Prop :=
 
 Inductive final_state: state -> int -> Prop :=
   | final_state_intro: forall rs m r,
-      rs R3 = Vint r ->
+      rs (Conventions.loc_result (mksignature nil (Some Tint))) = Vint r ->
       final_state (Returnstate nil rs m) r.
 
 Definition exec_program (p: program) (beh: program_behavior) : Prop :=
diff --git a/backend/Machabstr2concr.v b/backend/Machabstr2concr.v
index 2dd3134f..7eae610b 100644
--- a/backend/Machabstr2concr.v
+++ b/backend/Machabstr2concr.v
@@ -27,7 +27,7 @@ Require Import Mach.
 Require Import Machtyping.
 Require Import Machabstr.
 Require Import Machconcr.
-Require Import PPCgenretaddr.
+Require Import Asmgenretaddr.
 
 (** Two semantics were defined for the Mach intermediate language:
 - The concrete semantics (file [Mach]), where the whole activation
@@ -43,7 +43,7 @@ Require Import PPCgenretaddr.
   abstract semantics, it also executes with the same behaviour in
   the concrete semantics.  This result bridges the correctness proof
   in file [Stackingproof] (which uses the abstract Mach semantics
-  as output) and that in file [PPCgenproof] (which uses the concrete
+  as output) and that in file [Asmgenproof] (which uses the concrete
   Mach semantics as input).
 *)
 
diff --git a/backend/Machconcr.v b/backend/Machconcr.v
index 5ca3cad7..41216d25 100644
--- a/backend/Machconcr.v
+++ b/backend/Machconcr.v
@@ -25,8 +25,8 @@ Require Import Op.
 Require Import Locations.
 Require Conventions.
 Require Import Mach.
-Require Stacking.
-Require PPCgenretaddr.
+Require Stacklayout.
+Require Asmgenretaddr.
 
 (** In the concrete semantics for Mach, the three stack-related Mach
   instructions are interpreted as memory accesses relative to the
@@ -45,14 +45,14 @@ In addition to this linking of activation records, the concrete
 semantics also make provisions for storing a back link at offset
 [f.(fn_link_ofs)] from the stack pointer, and a return address at
 offset [f.(fn_retaddr_ofs)].  The latter stack location will be used
-by the PPC code generated by [PPCgen] to save the return address into
+by the Asm code generated by [Asmgen] to save the return address into
 the caller at the beginning of a function, then restore it and jump to
 it at the end of a function.  The Mach concrete semantics does not
 attach any particular meaning to the pointer stored in this reserved
 location, but makes sure that it is preserved during execution of a
 function.  The [return_address_offset] predicate from module
-[PPCgenretaddr] is used to guess the value of the return address that
-the PPC code generated later will store in the reserved location.
+[Asmgenretaddr] is used to guess the value of the return address that
+the Asm code generated later will store in the reserved location.
 *)
 
 Definition chunk_of_type (ty: typ) :=
@@ -70,7 +70,7 @@ Inductive extcall_arg: regset -> mem -> val -> loc -> val -> Prop :=
   | extcall_arg_reg: forall rs m sp r,
       extcall_arg rs m sp (R r) (rs r)
   | extcall_arg_stack: forall rs m sp ofs ty v,
-      load_stack m sp ty (Int.repr (Stacking.fe_ofs_arg + 4 * ofs)) = Some v ->
+      load_stack m sp ty (Int.repr (Stacklayout.fe_ofs_arg + 4 * ofs)) = Some v ->
       extcall_arg rs m sp (S (Outgoing ofs ty)) v.
 
 Inductive extcall_args: regset -> mem -> val -> list loc -> list val -> Prop :=
@@ -90,7 +90,7 @@ Inductive stackframe: Set :=
   | Stackframe:
       forall (f: block)       (**r pointer to calling function *)
              (sp: val)        (**r stack pointer in calling function *)
-             (retaddr: val)   (**r PPC return address in calling function *)
+             (retaddr: val)   (**r Asm return address in calling function *)
              (c: code),       (**r program point in calling function *)
       stackframe.
 
@@ -174,7 +174,7 @@ Inductive step: state -> trace -> state -> Prop :=
       forall s fb sp sig ros c rs m f f' ra,
       find_function_ptr ge ros rs = Some f' ->
       Genv.find_funct_ptr ge fb = Some (Internal f) ->
-      PPCgenretaddr.return_address_offset f c ra ->
+      Asmgenretaddr.return_address_offset f c ra ->
       step (State s fb sp (Mcall sig ros :: c) rs m)
         E0 (Callstate (Stackframe fb sp (Vptr fb ra) c :: s)
                        f' rs m)
@@ -252,7 +252,7 @@ Inductive initial_state (p: program): state -> Prop :=
 
 Inductive final_state: state -> int -> Prop :=
   | final_state_intro: forall rs m r,
-      rs R3 = Vint r ->
+      rs (Conventions.loc_result (mksignature nil (Some Tint))) = Vint r ->
       final_state (Returnstate nil rs m) r.
 
 Definition exec_program (p: program) (beh: program_behavior) : Prop :=
diff --git a/backend/Op.v b/backend/Op.v
deleted file mode 100644
index 5665d725..00000000
--- a/backend/Op.v
+++ /dev/null
@@ -1,906 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** 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 PowerPC-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 Mem.
-Require Import Globalenvs.
-
-Set Implicit Arguments.
-
-(** Conditions (boolean-valued operators). *)
-
-Inductive condition : Set :=
-  | 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] *)
-
-(** Arithmetic and logical operations.  In the descriptions, [rd] is the
-  result of the operation and [r1], [r2], etc, are the arguments. *)
-
-Inductive operation : Set :=
-  | 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 *)
-  | Oaddrsymbol: ident -> int -> operation (**r [rd] is set to the the address of the symbol plus the offset *)
-  | Oaddrstack: int -> operation        (**r [rd] is set to the stack pointer plus the given offset *)
-(*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] *)
-  | Oadd: operation                     (**r [rd = r1 + r2] *)
-  | Oaddimm: int -> operation           (**r [rd = r1 + n] *)
-  | Osub: operation                     (**r [rd = r1 - r2] *)
-  | Osubimm: int -> operation           (**r [rd = n - r1] *)
-  | 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) *)
-  | 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] *)
-  | Onand: operation                    (**r [rd = ~(r1 & r2)] *)
-  | Onor: operation                     (**r [rd = ~(r1 | r2)] *)
-  | Onxor: operation                    (**r [rd = ~(r1 ^ r2)] *)
-  | Oshl: operation                     (**r [rd = r1 << r2] *)
-  | 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) *)
-  | Orolm: int -> int -> operation      (**r rotate left and mask *)
-(*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] *)
-  | Omuladdf: operation                 (**r [rd = r1 * r2 + r3] *)
-  | Omulsubf: operation                 (**r [rd = r1 * r2 - r3] *)
-  | 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)] *)
-  | Ointuoffloat: operation             (**r [rd = unsigned_int_of_float(r1)] *)
-  | Ofloatofint: operation              (**r [rd = float_of_signed_int(r1)] *)
-  | Ofloatofintu: operation             (**r [rd = float_of_unsigned_int(r1)] *)
-(*c Boolean tests: *)
-  | Ocmp: condition -> operation.       (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
-
-(** Addressing modes.  [r1], [r2], etc, are the arguments to the 
-  addressing. *)
-
-Inductive addressing: Set :=
-  | Aindexed: int -> addressing         (**r Address is [r1 + offset] *)
-  | Aindexed2: addressing               (**r Address is [r1 + r2] *)
-  | Aglobal: ident -> int -> addressing (**r Address is [symbol + offset] *)
-  | Abased: ident -> int -> addressing (**r Address is [symbol + offset + r1] *)
-  | Ainstack: int -> addressing.        (**r Address is [stack_pointer + offset] *)
-
-(** 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_condition (cond: condition) (vl: list val) (m: mem):
-               option bool :=
-  match cond, vl with
-  | Ccomp c, Vint n1 :: Vint n2 :: nil =>
-      Some (Int.cmp c n1 n2)
-  | Ccomp c, Vptr b1 n1 :: Vptr b2 n2 :: nil =>
-      if valid_pointer m b1 (Int.signed n1)
-      && valid_pointer m b2 (Int.signed n2) then
-        if eq_block b1 b2
-        then Some (Int.cmp c n1 n2)
-        else eval_compare_mismatch c
-      else None
-  | Ccomp c, Vptr b1 n1 :: Vint n2 :: nil =>
-      if Int.eq n2 Int.zero then eval_compare_mismatch c else None
-  | Ccomp c, Vint n1 :: Vptr b2 n2 :: nil =>
-      if Int.eq n1 Int.zero then eval_compare_mismatch c else None
-  | 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 =>
-      if Int.eq n Int.zero then eval_compare_mismatch c else None
-  | 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_operation
-    (F: Set) (genv: Genv.t F) (sp: val)
-    (op: operation) (vl: list val) (m: mem): option val :=
-  match op, vl with
-  | Omove, v1::nil => Some v1
-  | Ointconst n, nil => Some (Vint n)
-  | Ofloatconst n, nil => Some (Vfloat n)
-  | Oaddrsymbol s ofs, nil =>
-      match Genv.find_symbol genv s with
-      | None => None
-      | Some b => Some (Vptr b ofs)
-      end
-  | Oaddrstack ofs, nil => offset_sp sp ofs
-  | 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)
-  | Oadd, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.add n1 n2))
-  | Oadd, Vint n1 :: Vptr b2 n2 :: nil => Some (Vptr b2 (Int.add n2 n1))
-  | Oadd, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.add n1 n2))
-  | Oaddimm n, Vint n1 :: nil => Some (Vint (Int.add n1 n))
-  | Oaddimm n, Vptr b1 n1 :: nil => Some (Vptr b1 (Int.add n1 n))
-  | 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
-  | Osubimm n, Vint n1 :: nil => Some (Vint (Int.sub n n1))
-  | 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))
-  | 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))
-  | Onand, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.not (Int.and n1 n2)))
-  | Onor, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.not (Int.or n1 n2)))
-  | Onxor, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.not (Int.xor n1 n2)))
-  | Oshl, Vint n1 :: Vint n2 :: nil =>
-      if Int.ltu n2 (Int.repr 32) then Some (Vint (Int.shl n1 n2)) else None
-  | Oshr, Vint n1 :: Vint n2 :: nil =>
-      if Int.ltu n2 (Int.repr 32) then Some (Vint (Int.shr n1 n2)) else None
-  | Oshrimm n, Vint n1 :: nil =>
-      if Int.ltu n (Int.repr 32) then Some (Vint (Int.shr n1 n)) else None
-  | Oshrximm n, Vint n1 :: nil =>
-      if Int.ltu n (Int.repr 32) then Some (Vint (Int.shrx n1 n)) else None
-  | Oshru, Vint n1 :: Vint n2 :: nil =>
-      if Int.ltu n2 (Int.repr 32) then Some (Vint (Int.shru n1 n2)) else None
-  | Orolm amount mask, Vint n1 :: nil =>
-      Some (Vint (Int.rolm n1 amount mask))
-  | 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))
-  | Omuladdf, Vfloat f1 :: Vfloat f2 :: Vfloat f3 :: nil =>
-      Some (Vfloat (Float.add (Float.mul f1 f2) f3))
-  | Omulsubf, Vfloat f1 :: Vfloat f2 :: Vfloat f3 :: nil =>
-      Some (Vfloat (Float.sub (Float.mul f1 f2) f3))
-  | Osingleoffloat, v1 :: nil =>
-      Some (Val.singleoffloat v1)
-  | Ointoffloat, Vfloat f1 :: nil => 
-      Some (Vint (Float.intoffloat f1))
-  | Ointuoffloat, Vfloat f1 :: nil => 
-      Some (Vint (Float.intuoffloat f1))
-  | Ofloatofint, Vint n1 :: nil => 
-      Some (Vfloat (Float.floatofint n1))
-  | Ofloatofintu, Vint n1 :: nil => 
-      Some (Vfloat (Float.floatofintu n1))
-  | Ocmp c, _ =>
-      match eval_condition c vl m with
-      | None => None
-      | Some false => Some Vfalse
-      | Some true => Some Vtrue
-      end
-  | _, _ => None
-  end.
-
-Definition eval_addressing
-    (F: Set) (genv: Genv.t F) (sp: val)
-    (addr: addressing) (vl: list val) : option val :=
-  match addr, vl with
-  | Aindexed n, Vptr b1 n1 :: nil =>
-      Some (Vptr b1 (Int.add n1 n))
-  | Aindexed2, Vptr b1 n1 :: Vint n2 :: nil =>
-      Some (Vptr b1 (Int.add n1 n2))
-  | Aindexed2, Vint n1 :: Vptr b2 n2 :: nil =>
-      Some (Vptr b2 (Int.add n2 n1))
-  | 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
-  | Ainstack ofs, nil =>
-      offset_sp sp ofs
-  | _, _ => 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.
-
-Lemma eval_negate_condition:
-  forall (cond: condition) (vl: list val) (b: bool) (m: mem),
-  eval_condition cond vl m = Some b ->
-  eval_condition (negate_condition cond) vl m = Some (negb b).
-Proof.
-  intros. 
-  destruct cond; simpl in H; FuncInv; try subst b; simpl.
-  rewrite Int.negate_cmp. auto.
-  destruct (Int.eq i Int.zero). apply eval_negate_compare_mismatch; auto. discriminate.
-  destruct (Int.eq i0 Int.zero). apply eval_negate_compare_mismatch; auto. discriminate.
-  destruct (valid_pointer m b0 (Int.signed i) &&
-            valid_pointer m b1 (Int.signed i0)).
-  destruct (eq_block b0 b1). rewrite Int.negate_cmp. congruence.
-  apply eval_negate_compare_mismatch; auto. 
-  discriminate.
-  rewrite Int.negate_cmpu. auto.
-  rewrite Int.negate_cmp. auto.
-  destruct (Int.eq i Int.zero). apply eval_negate_compare_mismatch; auto. discriminate.
-  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: Set.
-Variable ge1: Genv.t F1.
-Variable ge2: Genv.t F2.
-Hypothesis agree_on_symbols:
-  forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s.
-
-Lemma eval_operation_preserved:
-  forall sp op vl m,
-  eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m.
-Proof.
-  intros.
-  unfold eval_operation; destruct op; try rewrite agree_on_symbols;
-  reflexivity.
-Qed.
-
-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.
-
-End GENV_TRANSF.
-
-(** [eval_condition] and [eval_operation] depend on a memory store
-    (to check pointer validity in pointer comparisons).
-    We show that their results are preserved by a change of
-    memory if this change preserves pointer validity.
-    In particular, this holds in case of a memory allocation
-    or a memory store. *)
-
-Lemma eval_condition_change_mem:
-  forall m m' c args b,
-  (forall b ofs, valid_pointer m b ofs = true -> valid_pointer m' b ofs = true) ->
-  eval_condition c args m = Some b -> eval_condition c args m' = Some b.
-Proof.
-  intros until b. intro INV. destruct c; simpl; auto.
-  destruct args; auto. destruct v; auto. destruct args; auto.
-  destruct v; auto. destruct args; auto. 
-  caseEq (valid_pointer m b0 (Int.signed i)); intro.
-  caseEq (valid_pointer m b1 (Int.signed i0)); intro.
-  simpl. rewrite (INV _ _ H). rewrite (INV _ _ H0). auto.
-  simpl; congruence. simpl; congruence.
-Qed.
-
-Lemma eval_operation_change_mem:
-  forall (F: Set) m m' (ge: Genv.t F) sp op args v,
-  (forall b ofs, valid_pointer m b ofs = true -> valid_pointer m' b ofs = true) ->
-  eval_operation ge sp op args m = Some v -> eval_operation ge sp op args m' = Some v.
-Proof.
-  intros until v; intro INV. destruct op; simpl; auto.
-  caseEq (eval_condition c args m); intros.
-  rewrite (eval_condition_change_mem _ _ _ _ INV H). auto.
-  discriminate.
-Qed.
-
-Lemma eval_condition_alloc:
-  forall m lo hi m' b c args v,
-  Mem.alloc m lo hi = (m', b) ->
-  eval_condition c args m = Some v -> eval_condition c args m' = Some v.
-Proof.
-  intros. apply eval_condition_change_mem with m; auto.
-  intros. eapply valid_pointer_alloc; eauto.
-Qed.
-
-Lemma eval_operation_alloc:
-  forall (F: Set) m lo hi m' b (ge: Genv.t F) sp op args v,
-  Mem.alloc m lo hi = (m', b) ->
-  eval_operation ge sp op args m = Some v -> eval_operation ge sp op args m' = Some v.
-Proof.
-  intros. apply eval_operation_change_mem with m; auto.
-  intros. eapply valid_pointer_alloc; eauto.
-Qed.
-
-Lemma eval_condition_store:
-  forall chunk m b ofs v' m' c args v,
-  Mem.store chunk m b ofs v' = Some m' ->
-  eval_condition c args m = Some v -> eval_condition c args m' = Some v.
-Proof.
-  intros. apply eval_condition_change_mem with m; auto.
-  intros. eapply valid_pointer_store; eauto.
-Qed.
-
-Lemma eval_operation_store:
-  forall (F: Set) chunk m b ofs v' m' (ge: Genv.t F) sp op args v,
-  Mem.store chunk m b ofs v' = Some m' ->
-  eval_operation ge sp op args m = Some v -> eval_operation ge sp op args m' = Some v.
-Proof.
-  intros. apply eval_operation_change_mem with m; auto.
-  intros. eapply valid_pointer_store; eauto.
-Qed.
-
-(** Recognition of move operations. *)
-
-Definition is_move_operation
-    (A: Set) (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: Set) (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_operation (op: operation) : list typ * typ :=
-  match op with
-  | Omove => (nil, Tint)   (* treated specially *)
-  | Ointconst _ => (nil, Tint)
-  | Ofloatconst _ => (nil, Tfloat)
-  | Oaddrsymbol _ _ => (nil, Tint)
-  | Oaddrstack _ => (nil, Tint)
-  | Ocast8signed => (Tint :: nil, Tint)
-  | Ocast8unsigned => (Tint :: nil, Tint)
-  | Ocast16signed => (Tint :: nil, Tint)
-  | Ocast16unsigned => (Tint :: nil, Tint)
-  | Oadd => (Tint :: Tint :: nil, Tint)
-  | Oaddimm _ => (Tint :: nil, Tint)
-  | Osub => (Tint :: Tint :: nil, Tint)
-  | Osubimm _ => (Tint :: nil, Tint)
-  | Omul => (Tint :: Tint :: nil, Tint)
-  | Omulimm _ => (Tint :: nil, Tint)
-  | Odiv => (Tint :: Tint :: nil, Tint)
-  | Odivu => (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)
-  | Onand => (Tint :: Tint :: nil, Tint)
-  | Onor => (Tint :: Tint :: nil, Tint)
-  | Onxor => (Tint :: Tint :: nil, Tint)
-  | Oshl => (Tint :: Tint :: nil, Tint)
-  | Oshr => (Tint :: Tint :: nil, Tint)
-  | Oshrimm _ => (Tint :: nil, Tint)
-  | Oshrximm _ => (Tint :: nil, Tint)
-  | Oshru => (Tint :: Tint :: nil, Tint)
-  | Orolm _ _ => (Tint :: nil, 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)
-  | Omuladdf => (Tfloat :: Tfloat :: Tfloat :: nil, Tfloat)
-  | Omulsubf => (Tfloat :: Tfloat :: Tfloat :: nil, Tfloat)
-  | Osingleoffloat => (Tfloat :: nil, Tfloat)
-  | Ointoffloat => (Tfloat :: nil, Tint)
-  | Ointuoffloat => (Tfloat :: nil, Tint)
-  | Ofloatofint => (Tint :: nil, Tfloat)
-  | Ofloatofintu => (Tint :: nil, Tfloat)
-  | Ocmp c => (type_of_condition c, Tint)
-  end.
-
-Definition type_of_addressing (addr: addressing) : list typ :=
-  match addr with
-  | Aindexed _ => Tint :: nil
-  | Aindexed2 => Tint :: Tint :: nil
-  | Aglobal _ _ => nil
-  | Abased _ _ => Tint :: nil
-  | Ainstack _ => nil
-  end.
-
-Definition type_of_chunk (c: memory_chunk) : typ :=
-  match c with
-  | Mint8signed => Tint
-  | Mint8unsigned => Tint
-  | Mint16signed => Tint
-  | Mint16unsigned => Tint
-  | Mint32 => Tint
-  | Mfloat32 => Tfloat
-  | Mfloat64 => Tfloat
-  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: Set.
-Variable genv: Genv.t A.
-
-Lemma type_of_operation_sound:
-  forall op vl sp v m,
-  op <> Omove ->
-  eval_operation genv sp op vl m = 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 (Genv.find_symbol genv i); simplify_eq H0; intro; subst v; exact I.
-  simpl. unfold offset_sp in H0. destruct sp; try discriminate.
-  inversion H0. exact I.
-  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.ltu i0 (Int.repr 32)).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i0 (Int.repr 32)).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i (Int.repr 32)).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i (Int.repr 32)).
-  injection H0; intro; subst v; exact I. discriminate.
-  destruct (Int.ltu i0 (Int.repr 32)).
-  injection H0; intro; subst v; exact I. discriminate.
-  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.
-  generalize (Mem.load_inv _ _ _ _ _ H0).
-  intros [X Y].  subst v.  apply H.
-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: Set.
-Variable genv: Genv.t F.
-
-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_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
-  | Oaddrsymbol s ofs, nil => find_symbol_offset s ofs
-  | Oaddrstack ofs, nil => Val.add sp (Vint ofs)
-  | 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
-  | Oadd, v1::v2::nil => Val.add v1 v2
-  | Oaddimm n, v1::nil => Val.add v1 (Vint n)
-  | Osub, v1::v2::nil => Val.sub v1 v2
-  | Osubimm n, v1::nil => Val.sub (Vint n) v1
-  | 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
-  | 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)
-  | Onand, v1::v2::nil => Val.notint(Val.and v1 v2)
-  | Onor, v1::v2::nil => Val.notint(Val.or v1 v2)
-  | Onxor, v1::v2::nil => Val.notint(Val.xor v1 v2)
-  | Oshl, v1::v2::nil => Val.shl v1 v2
-  | 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
-  | Orolm amount mask, v1::nil => Val.rolm v1 amount mask
-  | 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
-  | Omuladdf, v1::v2::v3::nil => Val.addf (Val.mulf v1 v2) v3
-  | Omulsubf, v1::v2::v3::nil => Val.subf (Val.mulf v1 v2) v3
-  | Osingleoffloat, v1::nil => Val.singleoffloat v1
-  | Ointoffloat, v1::nil => Val.intoffloat v1
-  | Ointuoffloat, v1::nil => Val.intuoffloat v1
-  | Ofloatofint, v1::nil => Val.floatofint v1
-  | Ofloatofintu, v1::nil => Val.floatofintu v1
-  | Ocmp c, _ => eval_condition_total c vl
-  | _, _ => 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, v1::v2::nil => Val.add v1 v2
-  | Aglobal s ofs, nil => find_symbol_offset s ofs
-  | Abased s ofs, v1::nil => Val.add (find_symbol_offset s ofs) v1
-  | Ainstack ofs, nil => Val.add sp (Vint ofs)
-  | _, _ => 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,
-  (if Int.eq n Int.zero then eval_compare_mismatch c else None) = Some b ->
-  (if Int.eq n Int.zero then Val.cmp_mismatch c else Vundef) = Val.of_bool b.
-Proof.
-  intros. destruct (Int.eq n Int.zero). apply eval_compare_mismatch_weaken. auto.
-  discriminate.
-Qed.
-
-Lemma eval_condition_weaken:
-  forall c vl m b,
-  eval_condition c vl m = Some b ->
-  eval_condition_total c vl = Val.of_bool b.
-Proof.
-  intros. 
-  unfold eval_condition in H; destruct c; FuncInv;
-  try subst b; try reflexivity; simpl;
-  try (apply eval_compare_null_weaken; auto).
-  destruct (valid_pointer m b0 (Int.signed i) &&
-            valid_pointer m b1 (Int.signed i0)).
-  unfold eq_block in H. destruct (zeq b0 b1).
-  congruence.
-  apply eval_compare_mismatch_weaken; auto.
-  discriminate.
-  symmetry. apply Val.notbool_negb_1. 
-  symmetry. apply Val.notbool_negb_1. 
-Qed.
-
-Lemma eval_operation_weaken:
-  forall sp op vl m v,
-  eval_operation genv sp op vl m = Some v ->
-  eval_operation_total sp op vl = v.
-Proof.
-  intros.
-  unfold eval_operation in H; destruct op; FuncInv;
-  try subst v; try reflexivity; simpl.
-  unfold find_symbol_offset. 
-  destruct (Genv.find_symbol genv i); try discriminate.
-  congruence.
-  unfold offset_sp in H. 
-  destruct sp; try discriminate. simpl. congruence.
-  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.ltu i0 (Int.repr 32)); congruence.
-  destruct (Int.ltu i0 (Int.repr 32)); congruence.
-  destruct (Int.ltu i (Int.repr 32)); congruence.
-  destruct (Int.ltu i (Int.repr 32)); congruence.
-  destruct (Int.ltu i0 (Int.repr 32)); congruence.
-  caseEq (eval_condition c vl m); intros; rewrite H0 in H.
-  replace v with (Val.of_bool b).
-  eapply eval_condition_weaken; eauto.
-  destruct b; simpl; congruence.
-  discriminate.
-Qed.
-
-Lemma eval_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); try congruence.
-  inversion H. reflexivity.
-  unfold offset_sp in H. destruct sp; simpl; congruence.
-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 and memory states. *)
-
-Section EVAL_LESSDEF.
-
-Variable F: Set.
-Variable genv: Genv.t F.
-Variables m1 m2: mem.
-Hypothesis MEM: Mem.lessdef m1 m2.
-
-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 m1 = Some b ->
-  eval_condition cond vl2 m2 = Some b.
-Proof.
-  intros. destruct cond; simpl in *; FuncInv; InvLessdef; auto.
-  generalize H0.
-  caseEq (valid_pointer m1 b0 (Int.signed i)); intro; simpl; try congruence.
-  caseEq (valid_pointer m1 b1 (Int.signed i0)); intro; simpl; try congruence.
-  rewrite (Mem.valid_pointer_lessdef _ _ _ _ MEM H1).
-  rewrite (Mem.valid_pointer_lessdef _ _ _ _ MEM H). simpl.
-  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_operation_lessdef:
-  forall sp op vl1 vl2 v1,
-  Val.lessdef_list vl1 vl2 ->
-  eval_operation genv sp op vl1 m1 = Some v1 ->
-  exists v2, eval_operation genv sp op vl2 m2 = Some v2 /\ Val.lessdef v1 v2.
-Proof.
-  intros. destruct op; simpl in *; FuncInv; InvLessdef; TrivialExists.
-  exists v2; auto.
-  destruct (Genv.find_symbol genv i); inv H0. TrivialExists.
-  exists v1; 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.ltu i0 (Int.repr 32)); inv H0; TrivialExists.
-  destruct (Int.ltu i0 (Int.repr 32)); inv H0; TrivialExists.
-  destruct (Int.ltu i (Int.repr 32)); inv H0; TrivialExists.
-  destruct (Int.ltu i (Int.repr 32)); inv H0; TrivialExists.
-  destruct (Int.ltu i0 (Int.repr 32)); inv H0; TrivialExists.
-  exists (Val.singleoffloat v2); split. auto. apply Val.singleoffloat_lessdef; auto.
-  caseEq (eval_condition c vl1 m1); intros. rewrite H1 in H0. 
-  rewrite (eval_condition_lessdef c H H1).
-  destruct b; inv H0; TrivialExists.
-  rewrite H1 in H0. discriminate.
-Qed.
-
-Lemma eval_addressing_lessdef:
-  forall sp addr vl1 vl2 v1,
-  Val.lessdef_list vl1 vl2 ->
-  eval_addressing genv sp addr vl1 = Some v1 ->
-  exists v2, eval_addressing genv sp addr vl2 = Some v2 /\ Val.lessdef v1 v2.
-Proof.
-  intros. 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.
-  exists v1; auto.
-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. *)
-
-(** For the PowerPC, there is only one binary addressing mode: [Aindexed2].
-  The corresponding operation is [Oadd]. *)
-
-Definition op_for_binary_addressing (addr: addressing) : operation := Oadd.
-
-Lemma eval_op_for_binary_addressing:
-  forall (F: Set) (ge: Genv.t F) sp addr args m v,
-  (length args >= 2)%nat ->
-  eval_addressing ge sp addr args = Some v ->
-  eval_operation ge sp (op_for_binary_addressing addr) args m = Some v.
-Proof.
-  intros.
-  unfold eval_addressing in H0; destruct addr; FuncInv; simpl in H; try omegaContradiction;
-  simpl; congruence.
-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. destruct addr; simpl in H; reflexivity || omegaContradiction.
-Qed.
diff --git a/backend/PPC.v b/backend/PPC.v
deleted file mode 100644
index e47cba01..00000000
--- a/backend/PPC.v
+++ /dev/null
@@ -1,843 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** 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 Mem.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-
-(** * Abstract syntax *)
-
-(** Integer registers, floating-point registers. *)
-
-Inductive ireg: Set :=
-  | GPR0: ireg  | GPR1: ireg  | GPR2: ireg  | GPR3: ireg
-  | GPR4: ireg  | GPR5: ireg  | GPR6: ireg  | GPR7: ireg
-  | GPR8: ireg  | GPR9: ireg  | GPR10: ireg | GPR11: ireg
-  | GPR12: ireg | GPR13: ireg | GPR14: ireg | GPR15: ireg
-  | GPR16: ireg | GPR17: ireg | GPR18: ireg | GPR19: ireg
-  | GPR20: ireg | GPR21: ireg | GPR22: ireg | GPR23: ireg
-  | GPR24: ireg | GPR25: ireg | GPR26: ireg | GPR27: ireg
-  | GPR28: ireg | GPR29: ireg | GPR30: ireg | GPR31: ireg.
-
-Inductive freg: Set :=
-  | FPR0: freg  | FPR1: freg  | FPR2: freg  | FPR3: freg
-  | FPR4: freg  | FPR5: freg  | FPR6: freg  | FPR7: freg
-  | FPR8: freg  | FPR9: freg  | FPR10: freg | FPR11: freg
-  | FPR12: freg | FPR13: freg | FPR14: freg | FPR15: freg
-  | FPR16: freg | FPR17: freg | FPR18: freg | FPR19: freg
-  | FPR20: freg | FPR21: freg | FPR22: freg | FPR23: freg
-  | FPR24: freg | FPR25: freg | FPR26: freg | FPR27: freg
-  | FPR28: freg | FPR29: freg | FPR30: freg | FPR31: 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.
-
-(** Symbolic constants.  Immediate operands to an arithmetic instruction
-  or an indexed memory access can be either integer literals
-  or the low or high 16 bits of a symbolic reference (the address
-  of a symbol plus a displacement).  These symbolic references are
-  resolved later by the linker.
-*)
-
-Inductive constant: Set :=
-  | Cint: int -> constant
-  | Csymbol_low: ident -> int -> constant
-  | Csymbol_high: ident -> int -> constant.
-
-(** A note on constants: while immediate operands to PowerPC
-  instructions must be representable in 16 bits (with
-  sign extension or left shift by 16 positions for some instructions),
-  we do not attempt to capture these restrictions in the 
-  abstract syntax nor in the semantics.  The assembler will
-  emit an error if immediate operands exceed the representable
-  range.  Of course, our PPC generator (file [PPCgen]) is
-  careful to respect this range. *)
-
-(** Bits in the condition register.  We are only interested in the
-  first 4 bits. *)
-
-Inductive crbit: Set :=
-  | CRbit_0: crbit
-  | CRbit_1: crbit
-  | CRbit_2: crbit
-  | CRbit_3: crbit.
-
-(** The instruction set.  Most instructions correspond exactly to
-  actual instructions of the PowerPC processor. See the PowerPC
-  reference manuals for more details.  Some instructions,
-  described below, are pseudo-instructions: they expand to
-  canned instruction sequences during the printing of the assembly
-  code. *)
-
-Definition label := positive.
-
-Inductive instruction : Set :=
-  | Padd: ireg -> ireg -> ireg -> instruction                 (**r integer addition *)
-  | Paddi: ireg -> ireg -> constant -> instruction            (**r add immediate *)
-  | Paddis: ireg -> ireg -> constant -> instruction           (**r add immediate high *)
-  | Paddze: ireg -> ireg -> instruction                       (**r add Carry bit *)
-  | Pallocblock: instruction                                  (**r allocate new heap block *)
-  | Pallocframe: Z -> Z -> int -> instruction                 (**r allocate new stack frame *)
-  | Pand_: ireg -> ireg -> ireg -> instruction                (**r bitwise and *)
-  | Pandc: ireg -> ireg -> ireg -> instruction                (**r bitwise and-complement *)
-  | Pandi_: ireg -> ireg -> constant -> instruction           (**r and immediate and set conditions *)
-  | Pandis_: ireg -> ireg -> constant -> instruction          (**r and immediate high and set conditions *)
-  | Pb: label -> instruction                                  (**r unconditional branch *)
-  | Pbctr: instruction                                        (**r branch to contents of register CTR *)
-  | Pbctrl: instruction                                       (**r branch to contents of CTR and link *)
-  | Pbf: crbit -> label -> instruction                        (**r branch if false *)
-  | Pbl: ident -> instruction                                 (**r branch and link *)
-  | Pbs: ident -> instruction                                 (**r branch to symbol *)
-  | Pblr: instruction                                         (**r branch to contents of register LR *)
-  | Pbt: crbit -> label -> instruction                        (**r branch if true *)
-  | Pcmplw: ireg -> ireg -> instruction                       (**r unsigned integer comparison *)
-  | Pcmplwi: ireg -> constant -> instruction                  (**r same, with immediate argument *)
-  | Pcmpw: ireg -> ireg -> instruction                        (**r signed integer comparison *)
-  | Pcmpwi: ireg -> constant -> instruction                   (**r same, with immediate argument *)
-  | Pcror: crbit -> crbit -> crbit -> instruction             (**r or between condition bits *)
-  | Pdivw: ireg -> ireg -> ireg -> instruction                (**r signed division *)
-  | Pdivwu: ireg -> ireg -> ireg -> instruction               (**r unsigned division *)
-  | Peqv: ireg -> ireg -> ireg -> instruction                 (**r bitwise not-xor *)
-  | Pextsb: ireg -> ireg -> instruction                       (**r 8-bit sign extension *)
-  | Pextsh: ireg -> ireg -> instruction                       (**r 16-bit sign extension *)
-  | Pfreeframe: int -> instruction                            (**r deallocate stack frame and restore previous frame *)
-  | Pfabs: freg -> freg -> instruction                        (**r float absolute value *)
-  | Pfadd: freg -> freg -> freg -> instruction                (**r float addition *)
-  | Pfcmpu: freg -> freg -> instruction                       (**r float comparison *)
-  | Pfcti: ireg -> freg -> instruction                        (**r float-to-signed-int conversion *)
-  | Pfctiu: ireg -> freg -> instruction                       (**r float-to-unsigned-int conversion *)
-  | Pfdiv: freg -> freg -> freg -> instruction                (**r float division *)
-  | Pfmadd: freg -> freg -> freg -> freg -> instruction       (**r float multiply-add *)
-  | Pfmr: freg -> freg -> instruction                         (**r float move *)
-  | Pfmsub: freg -> freg -> freg -> freg -> instruction       (**r float multiply-sub *)
-  | Pfmul: freg -> freg -> freg -> instruction                (**r float multiply *)
-  | Pfneg: freg -> freg -> instruction                        (**r float negation *)
-  | Pfrsp: freg -> freg -> instruction                        (**r float round to single precision *)
-  | Pfsub: freg -> freg -> freg -> instruction                (**r float subtraction *)
-  | Pictf: freg -> ireg -> instruction                        (**r int-to-float conversion *)
-  | Piuctf: freg -> ireg -> instruction                       (**r unsigned int-to-float conversion *)
-  | Plbz: ireg -> constant -> ireg -> instruction             (**r load 8-bit unsigned int *)
-  | Plbzx: ireg -> ireg -> ireg -> instruction                (**r same, with 2 index regs *)
-  | Plfd: freg -> constant -> ireg -> instruction             (**r load 64-bit float *)
-  | Plfdx: freg -> ireg -> ireg -> instruction                (**r same, with 2 index regs *)
-  | Plfs: freg -> constant -> ireg -> instruction             (**r load 32-bit float *)
-  | Plfsx: freg -> ireg -> ireg -> instruction                (**r same, with 2 index regs *)
-  | Plha: ireg -> constant -> ireg -> instruction             (**r load 16-bit signed int *)
-  | Plhax: ireg -> ireg -> ireg -> instruction                (**r same, with 2 index regs *)
-  | Plhz: ireg -> constant -> ireg -> instruction             (**r load 16-bit unsigned int *)
-  | Plhzx: ireg -> ireg -> ireg -> instruction                (**r same, with 2 index regs *)
-  | Plfi: freg -> float -> instruction                        (**r load float constant *)
-  | Plwz: ireg -> constant -> ireg -> instruction             (**r load 32-bit int *)
-  | Plwzx: ireg -> ireg -> ireg -> instruction                (**r same, with 2 index regs *)
-  | Pmfcrbit: ireg -> crbit -> instruction                    (**r move condition bit to reg *)
-  | Pmflr: ireg -> instruction                                (**r move LR to reg *)
-  | Pmr: ireg -> ireg -> instruction                          (**r integer move *)
-  | Pmtctr: ireg -> instruction                               (**r move ireg to CTR *)
-  | Pmtlr: ireg -> instruction                                (**r move ireg to LR *)
-  | Pmulli: ireg -> ireg -> constant -> instruction           (**r integer multiply immediate *)
-  | Pmullw: ireg -> ireg -> ireg -> instruction               (**r integer multiply *)
-  | Pnand: ireg -> ireg -> ireg -> instruction                (**r bitwise not-and *)
-  | Pnor: ireg -> ireg -> ireg -> instruction                 (**r bitwise not-or *)
-  | Por: ireg -> ireg -> ireg -> instruction                  (**r bitwise or *)
-  | Porc: ireg -> ireg -> ireg -> instruction                 (**r bitwise or-complement *)
-  | Pori: ireg -> ireg -> constant -> instruction             (**r or with immediate *)
-  | Poris: ireg -> ireg -> constant -> instruction            (**r or with immediate high *)
-  | Prlwinm: ireg -> ireg -> int -> int -> instruction        (**r rotate and mask *)
-  | Pslw: ireg -> ireg -> ireg -> instruction                 (**r shift left *)
-  | Psraw: ireg -> ireg -> ireg -> instruction                (**r shift right signed *)
-  | Psrawi: ireg -> ireg -> int -> instruction                (**r shift right signed immediate *)
-  | Psrw: ireg -> ireg -> ireg -> instruction                 (**r shift right unsigned *)
-  | Pstb: ireg -> constant -> ireg -> instruction             (**r store 8-bit int *)
-  | Pstbx: ireg -> ireg -> ireg -> instruction                (**r same, with 2 index regs *)
-  | Pstfd: freg -> constant -> ireg -> instruction            (**r store 64-bit float *)
-  | Pstfdx: freg -> ireg -> ireg -> instruction               (**r same, with 2 index regs *)
-  | Pstfs: freg -> constant -> ireg -> instruction            (**r store 32-bit float *)
-  | Pstfsx: freg -> ireg -> ireg -> instruction               (**r same, with 2 index regs *)
-  | Psth: ireg -> constant -> ireg -> instruction             (**r store 16-bit int *)
-  | Psthx: ireg -> ireg -> ireg -> instruction                (**r same, with 2 index regs *)
-  | Pstw: ireg -> constant -> ireg -> instruction             (**r store 32-bit int *)
-  | Pstwx: ireg -> ireg -> ireg -> instruction                (**r same, with 2 index regs *)
-  | Psubfc: ireg -> ireg -> ireg -> instruction               (**r reversed integer subtraction *)
-  | Psubfic: ireg -> ireg -> constant -> instruction          (**r integer subtraction from immediate *)
-  | Pxor: ireg -> ireg -> ireg -> instruction                 (**r bitwise xor *)
-  | Pxori: ireg -> ireg -> constant -> instruction            (**r bitwise xor with immediate *)
-  | Pxoris: ireg -> ireg -> constant -> instruction           (**r bitwise xor with immediate high *)
-  | Plabel: label -> instruction.                             (**r define a code label *)
-
-(** The pseudo-instructions are the following:
-
-- [Plabel]: define a code label at the current program point
-- [Plfi]: load a floating-point constant in a float register.
-  Expands to a float load [lfd] from an address in the constant data section
-  initialized with the floating-point constant:
-<<
-        addis   r2, 0, ha16(lbl)
-        lfd     rdst, lo16(lbl)(r2)
-        .const_data
-lbl:    .double floatcst
-        .text
->>
-  Initialized data in the constant data section are not modeled here,
-  which is why we use a pseudo-instruction for this purpose.
-- [Pfcti]: convert a float to a signed integer.  This requires a transfer
-  via memory of a 32-bit integer from a float register to an int register,
-  which our memory model cannot express.  Expands to:
-<<
-        fctiwz  f13, rsrc
-        stfdu   f13, -8(r1)
-        lwz     rdst, 4(r1)
-        addi    r1, r1, 8
->>
-- [Pfctiu]: convert a float to an unsigned integer.  The PowerPC way
-  to do this is to compare the argument against the floating-point
-  constant [2^31], subtract [2^31] if bigger, then convert to a signed
-  integer as above, then add back [2^31] if needed.  Expands to:
-<<
-        addis   r2, 0, ha16(lbl1)
-        lfd     f13, lo16(lbl1)(r2)
-        fcmpu   cr7, rsrc, f13
-        cror    30, 29, 30
-        beq     cr7, lbl2
-        fctiwz  f13, rsrc
-        stfdu   f13, -8(r1)
-        lwz     rdst, 4(r1)
-        b       lbl3
-lbl2:   fsub    f13, rsrc, f13
-        fctiwz  f13, f13
-        stfdu   f13, -8(r1)
-        lwz     rdst, 4(r1)
-        addis   rdst, rdst, 0x8000
-lbl3:   addi    r1, r1, 8
-        .const_data
-lbl1:   .long   0x41e00000, 0x00000000    # 2^31 in double precision
-        .text
->>
-- [Pictf]: convert a signed integer to a float.  This requires complicated
-  bit-level manipulations of IEEE floats through mixed float and integer 
-  arithmetic over a memory word, which our memory model and axiomatization
-  of floats cannot express.  Expands to:
-<<
-        addis   r2, 0, 0x4330
-        stwu    r2, -8(r1)
-        addis   r2, rsrc, 0x8000
-        stw     r2, 4(r1)
-        addis   r2, 0, ha16(lbl)
-        lfd     f13, lo16(lbl)(r2)
-        lfd     rdst, 0(r1)
-        addi    r1, r1, 8
-        fsub    rdst, rdst, f13
-        .const_data
-lbl:    .long   0x43300000, 0x80000000
-        .text
->>
-  (Don't worry if you do not understand this instruction sequence: intimate
-  knowledge of IEEE float arithmetic is necessary.)
-- [Piuctf]: convert an unsigned integer to a float.  The expansion is close
-  to that [Pictf], and equally obscure.
-<<
-        addis   r2, 0, 0x4330
-        stwu    r2, -8(r1)
-        stw     rsrc, 4(r1)
-        addis   r2, 0, ha16(lbl)
-        lfd     f13, lo16(lbl)(r2)
-        lfd     rdst, 0(r1)
-        addi    r1, r1, 8
-        fsub    rdst, rdst, f13
-        .const_data
-lbl:    .long   0x43300000, 0x00000000
-        .text
->>
-- [Pallocframe lo hi ofs]: in the formal semantics, this pseudo-instruction
-  allocates a memory block with bounds [lo] and [hi], stores the value
-  of register [r1] (the stack pointer, by convention) at offset [ofs]
-  in this block, and sets [r1] to a pointer to the bottom of this
-  block.  In the printed PowerPC assembly code, this allocation
-  is just a store-decrement of register [r1], assuming that [ofs = 0]:
-<<
-        stwu    r1, (lo - hi)(r1)
->>
-  This cannot be expressed in our memory model, which does not reflect
-  the fact that stack frames are adjacent and allocated/freed
-  following a stack discipline.
-- [Pfreeframe ofs]: in the formal semantics, this pseudo-instruction
-  reads the word at offset [ofs] in the block pointed by [r1] (the
-  stack pointer), frees this block, and sets [r1] to the value of the
-  word at offset [ofs].  In the printed PowerPC assembly code, this
-  freeing is just a load of register [r1] relative to [r1] itself:
-<<
-        lwz     r1, ofs(r1)
->>
-  Again, our memory model cannot comprehend that this operation
-  frees (logically) the current stack frame.
-- [Pallocheap]: in the formal semantics, this pseudo-instruction
-  allocates a heap block of size the contents of [GPR3], and leaves
-  a pointer to this block in [GPR3].  In the generated assembly code,
-  it is turned into a call to the allocation function of the run-time
-  system.
-*)
-
-Definition code := list instruction.
-Definition fundef := AST.fundef code.
-Definition program := AST.program fundef unit.
-
-(** * Operational semantics *)
-
-(** The PowerPC has a great many registers, some general-purpose, some very
-  specific.  We model only the following registers: *)
-
-Inductive preg: Set :=
-  | IR: ireg -> preg                    (**r integer registers *)
-  | FR: freg -> preg                    (**r float registers *)
-  | PC: preg                            (**r program counter *)
-  | LR: preg                            (**r link register (return address) *)
-  | CTR: preg                           (**r count register, used for some branches *)
-  | CARRY: preg                         (**r carry bit of the status register *)
-  | CR0_0: preg                         (**r bit 0 of the condition register  *)
-  | CR0_1: preg                         (**r bit 1 of the condition register  *)
-  | CR0_2: preg                         (**r bit 2 of the condition register  *)
-  | CR0_3: preg.                        (**r bit 3 of the condition register  *)
-
-Coercion IR: ireg >-> preg.
-Coercion FR: freg >-> preg.
-
-Lemma preg_eq: forall (x y: preg), {x=y} + {x<>y}.
-Proof. decide equality. apply ireg_eq. apply freg_eq. Defined.
-
-Module PregEq.
-  Definition t := preg.
-  Definition eq := preg_eq.
-End PregEq.
-
-Module Pregmap := EMap(PregEq).
-
-(** The semantics operates over a single mapping from registers
-  (type [preg]) to values.  We maintain (but do not enforce)
-  the convention that integer registers are mapped to values of
-  type [Tint], float registers to values of type [Tfloat],
-  and boolean registers ([CARRY], [CR0_0], etc) to either
-  [Vzero] or [Vone]. *)
-  
-Definition regset := Pregmap.t val.
-Definition genv := Genv.t fundef.
-
-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).
-
-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.
-
-(** Some PowerPC instructions treat register GPR0 as the integer literal 0
-  when that register is used in argument position. *)
-
-Definition gpr_or_zero (rs: regset) (r: ireg) :=
-  if ireg_eq r GPR0 then Vzero else rs#r.
-
-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.
-
-(** The four functions below axiomatize how the linker processes
-  symbolic references [symbol + offset] and splits their
-  actual values into two 16-bit halves. *)
-
-Parameter low_half: val -> val.
-Parameter high_half: val -> val.
-
-(** The fundamental property of these operations is that, when applied
-  to the address of a symbol, their results can be recombined by
-  addition, rebuilding the original address. *)
-
-Axiom low_high_half:
-  forall id ofs,
-  Val.add (low_half (symbol_offset id ofs)) (high_half (symbol_offset id ofs))
-  = symbol_offset id ofs.
-
-(** The other axioms we take is that the results of
-  the [low_half] and [high_half] functions are of type [Tint],
-  i.e. either integers, pointers or undefined values. *)
-
-Axiom low_half_type: 
-  forall v, Val.has_type (low_half v) Tint.
-Axiom high_half_type: 
-  forall v, Val.has_type (high_half v) Tint.
- 
-(** Armed with the [low_half] and [high_half] functions,
-  we can define the evaluation of a symbolic constant.
-  Note that for [const_high], integer constants
-  are shifted left by 16 bits, but not symbol addresses:
-  we assume (as in the [low_high_half] axioms above)
-  that the results of [high_half] are already shifted
-  (their 16 low bits are equal to 0). *)
-
-Definition const_low (c: constant) :=
-  match c with
-  | Cint n => Vint n
-  | Csymbol_low id ofs => low_half (symbol_offset id ofs)
-  | Csymbol_high id ofs => Vundef
-  end.
-
-Definition const_high (c: constant) :=
-  match c with
-  | Cint n => Vint (Int.shl n (Int.repr 16))
-  | Csymbol_low id ofs => Vundef
-  | Csymbol_high id ofs => high_half (symbol_offset id ofs)
-  end.
-
-(** The semantics is purely small-step and defined as a function
-  from the current state (a register set + a memory state)
-  to either [OK rs' m'] where [rs'] and [m'] are the updated register
-  set and memory state after execution of the instruction at [rs#PC],
-  or [Error] if the processor is stuck. *)
-
-Inductive outcome: Set :=
-  | OK: regset -> mem -> outcome
-  | Error: 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 goto_label (c: code) (lbl: label) (rs: regset) (m: mem) :=
-  match label_pos lbl 0 c with
-  | None => Error
-  | Some pos =>
-      match rs#PC with
-      | Vptr b ofs => OK (rs#PC <- (Vptr b (Int.repr pos))) m
-      | _ => Error
-    end
-  end.
-
-(** Auxiliaries for memory accesses, in two forms: one operand
-  (plus constant offset) or two operands. *)
-
-Definition load1 (chunk: memory_chunk) (rd: preg)
-                 (cst: constant) (r1: ireg) (rs: regset) (m: mem) :=
-  match Mem.loadv chunk m (Val.add (gpr_or_zero rs r1) (const_low cst)) with
-  | None => Error
-  | Some v => OK (nextinstr (rs#rd <- v)) m
-  end.
-
-Definition load2 (chunk: memory_chunk) (rd: preg) (r1 r2: ireg)
-                 (rs: regset) (m: mem) :=
-  match Mem.loadv chunk m (Val.add rs#r1 rs#r2) with
-  | None => Error
-  | Some v => OK (nextinstr (rs#rd <- v)) m
-  end.
-
-Definition store1 (chunk: memory_chunk) (r: preg)
-                  (cst: constant) (r1: ireg) (rs: regset) (m: mem) :=
-  match Mem.storev chunk m (Val.add (gpr_or_zero rs r1) (const_low cst)) (rs#r) with
-  | None => Error
-  | Some m' => OK (nextinstr rs) m'
-  end.
-
-Definition store2 (chunk: memory_chunk) (r: preg) (r1 r2: ireg)
-                  (rs: regset) (m: mem) :=
-  match Mem.storev chunk m (Val.add rs#r1 rs#r2) (rs#r) with
-  | None => Error
-  | Some m' => OK (nextinstr rs) m'
-  end.
-
-(** Operations over condition bits. *)
-
-Definition reg_of_crbit (bit: crbit) :=
-  match bit with
-  | CRbit_0 => CR0_0
-  | CRbit_1 => CR0_1
-  | CRbit_2 => CR0_2
-  | CRbit_3 => CR0_3
-  end.
-
-Definition compare_sint (rs: regset) (v1 v2: val) :=
-  rs#CR0_0 <- (Val.cmp Clt v1 v2)
-    #CR0_1 <- (Val.cmp Cgt v1 v2)
-    #CR0_2 <- (Val.cmp Ceq v1 v2)
-    #CR0_3 <- Vundef.
-
-Definition compare_uint (rs: regset) (v1 v2: val) :=
-  rs#CR0_0 <- (Val.cmpu Clt v1 v2)
-    #CR0_1 <- (Val.cmpu Cgt v1 v2)
-    #CR0_2 <- (Val.cmpu Ceq v1 v2)
-    #CR0_3 <- Vundef.
-
-Definition compare_float (rs: regset) (v1 v2: val) :=
-  rs#CR0_0 <- (Val.cmpf Clt v1 v2)
-    #CR0_1 <- (Val.cmpf Cgt v1 v2)
-    #CR0_2 <- (Val.cmpf Ceq v1 v2)
-    #CR0_3 <- Vundef.
-
-Definition val_cond_reg (rs: regset) :=
-  Val.or (Val.shl rs#CR0_0 (Vint (Int.repr 31)))
-  (Val.or (Val.shl rs#CR0_1 (Vint (Int.repr 30)))
-   (Val.or (Val.shl rs#CR0_2 (Vint (Int.repr 29)))
-            (Val.shl rs#CR0_3 (Vint (Int.repr 28))))).
-
-(** 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
-  | Padd rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.add rs#r1 rs#r2))) m
-  | Paddi rd r1 cst =>
-      OK (nextinstr (rs#rd <- (Val.add (gpr_or_zero rs r1) (const_low cst)))) m
-  | Paddis rd r1 cst =>
-      OK (nextinstr (rs#rd <- (Val.add (gpr_or_zero rs r1) (const_high cst)))) m
-  | Paddze rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.add rs#r1 rs#CARRY))) m
-  | Pallocblock =>
-      match rs#GPR3 with
-      | Vint n =>
-          let (m', b) := Mem.alloc m 0 (Int.signed n) in
-          OK (nextinstr (rs#GPR3 <- (Vptr b Int.zero)
-                           #LR <- (Val.add rs#PC Vone))) m'
-      | _ => Error
-      end
-  | Pallocframe lo hi ofs =>
-      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)) rs#GPR1 with
-      | None => Error
-      | Some m2 => OK (nextinstr (rs#GPR1 <- sp #GPR12 <- Vundef)) m2
-      end
-  | Pand_ rd r1 r2 =>
-      let v := Val.and rs#r1 rs#r2 in
-      OK (nextinstr (compare_sint (rs#rd <- v) v Vzero)) m
-  | Pandc rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.and rs#r1 (Val.notint rs#r2)))) m
-  | Pandi_ rd r1 cst =>
-      let v := Val.and rs#r1 (const_low cst) in
-      OK (nextinstr (compare_sint (rs#rd <- v) v Vzero)) m
-  | Pandis_ rd r1 cst =>
-      let v := Val.and rs#r1 (const_high cst) in
-      OK (nextinstr (compare_sint (rs#rd <- v) v Vzero)) m
-  | Pb lbl =>
-      goto_label c lbl rs m
-  | Pbctr =>
-      OK (rs#PC <- (rs#CTR)) m
-  | Pbctrl =>
-      OK (rs#LR <- (Val.add rs#PC Vone) #PC <- (rs#CTR)) m
-  | Pbf bit lbl =>
-      match rs#(reg_of_crbit bit) with
-      | Vint n => if Int.eq n Int.zero then goto_label c lbl rs m else OK (nextinstr rs) m
-      | _ => Error
-      end
-  | Pbl ident =>
-      OK (rs#LR <- (Val.add rs#PC Vone) #PC <- (symbol_offset ident Int.zero)) m
-  | Pbs ident =>
-      OK (rs#PC <- (symbol_offset ident Int.zero)) m
-  | Pblr =>
-      OK (rs#PC <- (rs#LR)) m
-  | Pbt bit lbl =>
-      match rs#(reg_of_crbit bit) with
-      | Vint n => if Int.eq n Int.zero then OK (nextinstr rs) m else goto_label c lbl rs m
-      | _ => Error
-      end
-  | Pcmplw r1 r2 =>
-      OK (nextinstr (compare_uint rs rs#r1 rs#r2)) m
-  | Pcmplwi r1 cst =>
-      OK (nextinstr (compare_uint rs rs#r1 (const_low cst))) m
-  | Pcmpw r1 r2 =>
-      OK (nextinstr (compare_sint rs rs#r1 rs#r2)) m
-  | Pcmpwi r1 cst =>
-      OK (nextinstr (compare_sint rs rs#r1 (const_low cst))) m
-  | Pcror bd b1 b2 =>
-      OK (nextinstr (rs#(reg_of_crbit bd) <- (Val.or rs#(reg_of_crbit b1) rs#(reg_of_crbit b2)))) m
-  | Pdivw rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.divs rs#r1 rs#r2))) m
-  | Pdivwu rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.divu rs#r1 rs#r2))) m
-  | Peqv rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.notint (Val.xor rs#r1 rs#r2)))) m
-  | Pextsb rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.sign_ext 8 rs#r1))) m
-  | Pextsh rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.sign_ext 16 rs#r1))) m
-  | Pfreeframe ofs =>
-      match Mem.loadv Mint32 m (Val.add rs#GPR1 (Vint ofs)) with
-      | None => Error
-      | Some v =>
-          match rs#GPR1 with
-          | Vptr stk ofs => OK (nextinstr (rs#GPR1 <- v)) (Mem.free m stk)
-          | _ => Error
-          end
-      end
-  | Pfabs rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.absf rs#r1))) m
-  | Pfadd rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.addf rs#r1 rs#r2))) m
-  | Pfcmpu r1 r2 =>
-      OK (nextinstr (compare_float rs rs#r1 rs#r2)) m
-  | Pfcti rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.intoffloat rs#r1) #FPR13 <- Vundef)) m
-  | Pfctiu rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.intuoffloat rs#r1) #FPR13 <- Vundef)) m
-  | Pfdiv rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.divf rs#r1 rs#r2))) m
-  | Pfmadd rd r1 r2 r3 =>
-      OK (nextinstr (rs#rd <- (Val.addf (Val.mulf rs#r1 rs#r2) rs#r3))) m
-  | Pfmr rd r1 =>
-      OK (nextinstr (rs#rd <- (rs#r1))) m
-  | Pfmsub rd r1 r2 r3 =>
-      OK (nextinstr (rs#rd <- (Val.subf (Val.mulf rs#r1 rs#r2) rs#r3))) m
-  | Pfmul rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.mulf rs#r1 rs#r2))) m
-  | Pfneg rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.negf rs#r1))) m
-  | Pfrsp rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.singleoffloat rs#r1))) m
-  | Pfsub rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.subf rs#r1 rs#r2))) m
-  | Pictf rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.floatofint rs#r1) #GPR12 <- Vundef #FPR13 <- Vundef)) m
-  | Piuctf rd r1 =>
-      OK (nextinstr (rs#rd <- (Val.floatofintu rs#r1) #GPR12 <- Vundef #FPR13 <- Vundef)) m
-  | Plbz rd cst r1 =>
-      load1 Mint8unsigned rd cst r1 rs m
-  | Plbzx rd r1 r2 =>
-      load2 Mint8unsigned rd r1 r2 rs m
-  | Plfd rd cst r1 =>
-      load1 Mfloat64 rd cst r1 rs m
-  | Plfdx rd r1 r2 =>
-      load2 Mfloat64 rd r1 r2 rs m
-  | Plfs rd cst r1 =>
-      load1 Mfloat32 rd cst r1 rs m
-  | Plfsx rd r1 r2 =>
-      load2 Mfloat32 rd r1 r2 rs m
-  | Plha rd cst r1 =>
-      load1 Mint16signed rd cst r1 rs m
-  | Plhax rd r1 r2 =>
-      load2 Mint16signed rd r1 r2 rs m
-  | Plhz rd cst r1 =>
-      load1 Mint16unsigned rd cst r1 rs m
-  | Plhzx rd r1 r2 =>
-      load2 Mint16unsigned rd r1 r2 rs m
-  | Plfi rd f =>
-      OK (nextinstr (rs#rd <- (Vfloat f) #GPR12 <- Vundef)) m
-  | Plwz rd cst r1 =>
-      load1 Mint32 rd cst r1 rs m
-  | Plwzx rd r1 r2 =>
-      load2 Mint32 rd r1 r2 rs m
-  | Pmfcrbit rd bit =>
-      OK (nextinstr (rs#rd <- (rs#(reg_of_crbit bit)))) m
-  | Pmflr rd =>
-      OK (nextinstr (rs#rd <- (rs#LR))) m
-  | Pmr rd r1 =>
-      OK (nextinstr (rs#rd <- (rs#r1))) m
-  | Pmtctr r1 =>
-      OK (nextinstr (rs#CTR <- (rs#r1))) m
-  | Pmtlr r1 =>
-      OK (nextinstr (rs#LR <- (rs#r1))) m
-  | Pmulli rd r1 cst =>
-      OK (nextinstr (rs#rd <- (Val.mul rs#r1 (const_low cst)))) m
-  | Pmullw rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.mul rs#r1 rs#r2))) m
-  | Pnand rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.notint (Val.and rs#r1 rs#r2)))) m
-  | Pnor rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.notint (Val.or rs#r1 rs#r2)))) m
-  | Por rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.or rs#r1 rs#r2))) m
-  | Porc rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.or rs#r1 (Val.notint rs#r2)))) m
-  | Pori rd r1 cst =>
-      OK (nextinstr (rs#rd <- (Val.or rs#r1 (const_low cst)))) m
-  | Poris rd r1 cst =>
-      OK (nextinstr (rs#rd <- (Val.or rs#r1 (const_high cst)))) m
-  | Prlwinm rd r1 amount mask =>
-      OK (nextinstr (rs#rd <- (Val.rolm rs#r1 amount mask))) m
-  | Pslw rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.shl rs#r1 rs#r2))) m
-  | Psraw rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.shr rs#r1 rs#r2) #CARRY <- (Val.shr_carry rs#r1 rs#r2))) m
-  | Psrawi rd r1 n =>
-      OK (nextinstr (rs#rd <- (Val.shr rs#r1 (Vint n)) #CARRY <- (Val.shr_carry rs#r1 (Vint n)))) m
-  | Psrw rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.shru rs#r1 rs#r2))) m
-  | Pstb rd cst r1 =>
-      store1 Mint8unsigned rd cst r1 rs m
-  | Pstbx rd r1 r2 =>
-      store2 Mint8unsigned rd r1 r2 rs m
-  | Pstfd rd cst r1 =>
-      store1 Mfloat64 rd cst r1 rs m
-  | Pstfdx rd r1 r2 =>
-      store2 Mfloat64 rd r1 r2 rs m
-  | Pstfs rd cst r1 =>
-      store1 Mfloat32 rd cst r1 rs m
-  | Pstfsx rd r1 r2 =>
-      store2 Mfloat32 rd r1 r2 rs m
-  | Psth rd cst r1 =>
-      store1 Mint16unsigned rd cst r1 rs m
-  | Psthx rd r1 r2 =>
-      store2 Mint16unsigned rd r1 r2 rs m
-  | Pstw rd cst r1 =>
-      store1 Mint32 rd cst r1 rs m
-  | Pstwx rd r1 r2 =>
-      store2 Mint32 rd r1 r2 rs m
-  | Psubfc rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.sub rs#r2 rs#r1) #CARRY <- Vundef)) m
-  | Psubfic rd r1 cst =>
-      OK (nextinstr (rs#rd <- (Val.sub (const_low cst) rs#r1) #CARRY <- Vundef)) m
-  | Pxor rd r1 r2 =>
-      OK (nextinstr (rs#rd <- (Val.xor rs#r1 rs#r2))) m
-  | Pxori rd r1 cst =>
-      OK (nextinstr (rs#rd <- (Val.xor rs#r1 (const_low cst)))) m
-  | Pxoris rd r1 cst =>
-      OK (nextinstr (rs#rd <- (Val.xor rs#r1 (const_high cst)))) m
-  | Plabel lbl =>
-      OK (nextinstr rs) m
-  end.
-
-(** Calling conventions for external functions.  These are compatible with
-    the calling conventions in module [Conventions], except that
-    we use PPC registers instead of locations. *)
-
-Inductive extcall_args (rs: regset) (m: mem):
-      list typ -> list ireg -> list freg -> Z -> list val -> Prop :=
-  | extcall_args_nil: forall irl frl ofs,
-      extcall_args rs m nil irl frl ofs nil
-  | extcall_args_int_reg: forall tyl ir1 irl frl ofs v1 vl,
-      v1 = rs (IR ir1) ->
-      extcall_args rs m tyl irl frl ofs vl ->
-      extcall_args rs m (Tint :: tyl) (ir1 :: irl) frl ofs (v1 :: vl)
-  | extcall_args_int_stack: forall tyl frl ofs v1 vl,
-      Mem.loadv Mint32 m (Val.add (rs (IR GPR1)) (Vint (Int.repr ofs))) = Some v1 ->
-      extcall_args rs m tyl nil frl (ofs + 4) vl ->
-      extcall_args rs m (Tint :: tyl) nil frl ofs (v1 :: vl)
-  | extcall_args_float_reg: forall tyl irl fr1 frl ofs v1 vl,
-      v1 = rs (FR fr1) ->
-      extcall_args rs m tyl (list_drop2 irl) frl ofs vl ->
-      extcall_args rs m (Tfloat :: tyl) irl (fr1 :: frl) ofs (v1 :: vl)
-  | extcall_args_float_stack: forall tyl irl ofs v1 vl,
-      Mem.loadv Mfloat64 m (Val.add (rs (IR GPR1)) (Vint (Int.repr ofs))) = Some v1 ->
-      extcall_args rs m tyl irl nil (ofs + 8) vl ->
-      extcall_args rs m (Tfloat :: tyl) irl nil ofs (v1 :: vl).
-
-Definition extcall_arguments
-    (rs: regset) (m: mem) (sg: signature) (args: list val) : Prop :=
-  extcall_args rs m
-    sg.(sig_args)
-    (GPR3 :: GPR4 :: GPR5 :: GPR6 :: GPR7 :: GPR8 :: GPR9 :: GPR10 :: nil)
-    (FPR1 :: FPR2 :: FPR3 :: FPR4 :: FPR5 :: FPR6 :: FPR7 :: FPR8 :: FPR9 :: FPR10 :: nil)
-    56 args.
-
-Definition loc_external_result (s: signature) : preg :=
-  match s.(sig_res) with
-  | None => GPR3
-  | Some Tint => GPR3
-  | Some Tfloat => FPR1
-  end.
-
-(** Execution of the instruction at [rs#PC]. *)
-
-Inductive state: Set :=
-  | 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 = OK rs' m' ->
-      step (State rs m) E0 (State rs' m')
-  | exec_step_external:
-      forall b ef args res rs m t rs',
-      rs PC = Vptr b Int.zero ->
-      Genv.find_funct_ptr ge b = Some (External ef) ->
-      event_match ef args t res ->
-      extcall_arguments rs m ef.(ef_sig) args ->
-      rs' = (rs#(loc_external_result ef.(ef_sig)) <- res
-               #PC <- (rs LR)) ->
-      step (State rs m) t (State rs' m).
-
-End RELSEM.
-
-(** Execution of whole programs. *)
-
-Inductive initial_state (p: program): state -> Prop :=
-  | initial_state_intro:
-      let ge := Genv.globalenv p in
-      let m0 := Genv.init_mem p in
-      let rs0 :=
-        (Pregmap.init Vundef)
-        # PC <- (symbol_offset ge p.(prog_main) Int.zero)
-        # LR <- Vzero
-        # GPR1 <- (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#GPR3 = 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/backend/PPCgen.v b/backend/PPCgen.v
deleted file mode 100644
index faedcb1c..00000000
--- a/backend/PPCgen.v
+++ /dev/null
@@ -1,548 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** Translation from Mach to PPC. *)
-
-Require Import Coqlib.
-Require Import Maps.
-Require Import Errors.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Mem.
-Require Import Globalenvs.
-Require Import Op.
-Require Import Locations.
-Require Import Mach.
-Require Import PPC.
-
-(** Translation of the LTL/Linear/Mach view of machine registers
-  to the PPC view.  PPC has two different types for registers
-  (integer and float) while LTL et al have only one.  The
-  [ireg_of] and [freg_of] are therefore partial in principle.
-  To keep things simpler, we make them return nonsensical
-  results when applied to a LTL register of the wrong type.
-  The proof in [PPCgenproof] will show that this never happens.
-
-  Note that no LTL register maps to [GPR12] nor [FPR13].
-  These two registers are reserved as temporaries, to be used
-  by the generated PPC code.  *)
-
-Definition ireg_of (r: mreg) : ireg :=
-  match r with
-  | R3 => GPR3  | R4 => GPR4  | R5 => GPR5  | R6 => GPR6
-  | R7 => GPR7  | R8 => GPR8  | R9 => GPR9  | R10 => GPR10
-  | R13 => GPR13 | R14 => GPR14 | R15 => GPR15 | R16 => GPR16
-  | R17 => GPR17 | R18 => GPR18 | R19 => GPR19 | R20 => GPR20
-  | R21 => GPR21 | R22 => GPR22 | R23 => GPR23 | R24 => GPR24
-  | R25 => GPR25 | R26 => GPR26 | R27 => GPR27 | R28 => GPR28
-  | R29 => GPR29 | R30 => GPR30 | R31 => GPR31
-  | IT1 => GPR11 | IT2 => GPR0
-  | _ => GPR0 (* should not happen *)
-  end.
-
-Definition freg_of (r: mreg) : freg :=
-  match r with
-  | F1 => FPR1  | F2 => FPR2  | F3 => FPR3  | F4 => FPR4
-  | F5 => FPR5  | F6 => FPR6  | F7 => FPR7  | F8 => FPR8
-  | F9 => FPR9  | F10 => FPR10 | F14 => FPR14 | F15 => FPR15
-  | F16 => FPR16 | F17 => FPR17 | F18 => FPR18 | F19 => FPR19
-  | F20 => FPR20 | F21 => FPR21 | F22 => FPR22 | F23 => FPR23
-  | F24 => FPR24 | F25 => FPR25 | F26 => FPR26 | F27 => FPR27
-  | F28 => FPR28 | F29 => FPR29 | F30 => FPR30 | F31 => FPR31
-  | FT1 => FPR0 | FT2 => FPR11 | FT3 => FPR12
-  | _ => FPR0 (* should not happen *)
-  end.
-
-(** Decomposition of integer constants.  As noted in file [PPC],
-  immediate arguments to PowerPC instructions must fit into 16 bits,
-  and are interpreted after zero extension, sign extension, or
-  left shift by 16 bits, depending on the instruction.  Integer
-  constants that do not fit must be synthesized using two
-  processor instructions.  The following functions decompose
-  arbitrary 32-bit integers into two 16-bit halves (high and low
-  halves).  They satisfy the following properties:
-- [low_u n] is an unsigned 16-bit integer;
-- [low_s n] is a signed 16-bit integer;
-- [(high_u n) << 16 | low_u n] equals [n];
-- [(high_s n) << 16 + low_s n] equals [n].
-*)
-
-Definition low_u (n: int) := Int.and n (Int.repr 65535).
-Definition high_u (n: int) := Int.shru n (Int.repr 16).
-Definition low_s (n: int) := Int.sign_ext 16 n.
-Definition high_s (n: int) := Int.shru (Int.sub n (low_s n)) (Int.repr 16).
-
-(** Smart constructors for arithmetic operations involving
-  a 32-bit integer constant.  Depending on whether the
-  constant fits in 16 bits or not, one or several instructions
-  are generated as required to perform the operation
-  and prepended to the given instruction sequence [k]. *)
-
-Definition loadimm (r: ireg) (n: int) (k: code) :=
-  if Int.eq (high_s n) Int.zero then
-    Paddi r GPR0 (Cint n) :: k
-  else if Int.eq (low_s n) Int.zero then
-    Paddis r GPR0 (Cint (high_s n)) :: k
-  else
-    Paddis r GPR0 (Cint (high_u n)) ::
-    Pori r r (Cint (low_u n)) :: k.
-
-Definition addimm_1 (r1 r2: ireg) (n: int) (k: code) :=
-  if Int.eq (high_s n) Int.zero then
-    Paddi r1 r2 (Cint n) :: k
-  else if Int.eq (low_s n) Int.zero then
-    Paddis r1 r2 (Cint (high_s n)) :: k
-  else
-    Paddis r1 r2 (Cint (high_s n)) ::
-    Paddi r1 r1 (Cint (low_s n)) :: k.
-
-Definition addimm_2 (r1 r2: ireg) (n: int) (k: code) :=
-  loadimm GPR12 n (Padd r1 r2 GPR12 :: k).
-
-Definition addimm (r1 r2: ireg) (n: int) (k: code) :=
-  if ireg_eq r1 GPR0 then
-    addimm_2 r1 r2 n k
-  else if ireg_eq r2 GPR0 then
-    addimm_2 r1 r2 n k
-  else
-    addimm_1 r1 r2 n k.
-
-Definition andimm (r1 r2: ireg) (n: int) (k: code) :=
-  if Int.eq (high_u n) Int.zero then
-    Pandi_ r1 r2 (Cint n) :: k
-  else if Int.eq (low_u n) Int.zero then
-    Pandis_ r1 r2 (Cint (high_u n)) :: k
-  else
-    loadimm GPR12 n (Pand_ r1 r2 GPR12 :: k).
-
-Definition orimm (r1 r2: ireg) (n: int) (k: code) :=
-  if Int.eq (high_u n) Int.zero then
-    Pori r1 r2 (Cint n) :: k
-  else if Int.eq (low_u n) Int.zero then
-    Poris r1 r2 (Cint (high_u n)) :: k
-  else
-    Poris r1 r2 (Cint (high_u n)) ::
-    Pori r1 r1 (Cint (low_u n)) :: k.
-
-Definition xorimm (r1 r2: ireg) (n: int) (k: code) :=
-  if Int.eq (high_u n) Int.zero then
-    Pxori r1 r2 (Cint n) :: k
-  else if Int.eq (low_u n) Int.zero then
-    Pxoris r1 r2 (Cint (high_u n)) :: k
-  else
-    Pxoris r1 r2 (Cint (high_u n)) ::
-    Pxori r1 r1 (Cint (low_u n)) :: k.
-
-(** Smart constructors for indexed loads and stores,
-  where the address is the contents of a register plus
-  an integer literal. *)
-
-Definition loadind_aux (base: ireg) (ofs: int) (ty: typ) (dst: mreg) :=
-  match ty with
-  | Tint => Plwz (ireg_of dst) (Cint ofs) base
-  | Tfloat => Plfd (freg_of dst) (Cint ofs) base
-  end.
-
-Definition loadind (base: ireg) (ofs: int) (ty: typ) (dst: mreg) (k: code) :=
-  if Int.eq (high_s ofs) Int.zero then
-    loadind_aux base ofs ty dst :: k
-  else
-    Paddis GPR12 base (Cint (high_s ofs)) ::
-    loadind_aux GPR12 (low_s ofs) ty dst :: k.
-  
-Definition storeind_aux (src: mreg) (base: ireg) (ofs: int) (ty: typ) :=
-  match ty with
-  | Tint => Pstw (ireg_of src) (Cint ofs) base
-  | Tfloat => Pstfd (freg_of src) (Cint ofs) base
-  end.
-
-Definition storeind (src: mreg) (base: ireg) (ofs: int) (ty: typ) (k: code) :=
-  if Int.eq (high_s ofs) Int.zero then
-    storeind_aux src base ofs ty :: k
-  else
-    Paddis GPR12 base (Cint (high_s ofs)) ::
-    storeind_aux src GPR12 (low_s ofs) ty :: k.
-  
-(** Constructor for a floating-point comparison.  The PowerPC has
-  a single [fcmpu] instruction to compare floats, which sets
-  bits 0, 1 and 2 of the condition register to reflect ``less'',
-  ``greater'' and ``equal'' conditions, respectively.
-  The ``less or equal'' and ``greater or equal'' conditions must be
-  synthesized by a [cror] instruction that computes the logical ``or''
-  of the corresponding two conditions. *)
-
-Definition floatcomp (cmp: comparison) (r1 r2: freg) (k: code) :=
-  Pfcmpu r1 r2 ::
-  match cmp with
-  | Cle => Pcror CRbit_3 CRbit_2 CRbit_0 :: k
-  | Cge => Pcror CRbit_3 CRbit_2 CRbit_1 :: k
-  | _ => k
-  end.
-
-(** Translation of a condition.  Prepends to [k] the instructions
-  that evaluate the condition and leave its boolean result in one of
-  the bits of the condition register.  The bit in question is
-  determined by the [crbit_for_cond] function. *)
-
-Definition transl_cond
-              (cond: condition) (args: list mreg) (k: code) :=
-  match cond, args with
-  | Ccomp c, a1 :: a2 :: nil =>
-      Pcmpw (ireg_of a1) (ireg_of a2) :: k
-  | Ccompu c, a1 :: a2 :: nil =>
-      Pcmplw (ireg_of a1) (ireg_of a2) :: k
-  | Ccompimm c n, a1 :: nil =>
-      if Int.eq (high_s n) Int.zero then
-        Pcmpwi (ireg_of a1) (Cint n) :: k
-      else
-        loadimm GPR12 n (Pcmpw (ireg_of a1) GPR12 :: k)
-  | Ccompuimm c n, a1 :: nil =>
-      if Int.eq (high_u n) Int.zero then
-        Pcmplwi (ireg_of a1) (Cint n) :: k
-      else
-        loadimm GPR12 n (Pcmplw (ireg_of a1) GPR12 :: k)
-  | Ccompf cmp, a1 :: a2 :: nil =>
-      floatcomp cmp (freg_of a1) (freg_of a2) k
-  | Cnotcompf cmp, a1 :: a2 :: nil =>
-      floatcomp cmp (freg_of a1) (freg_of a2) k
-  | Cmaskzero n, a1 :: nil =>
-      andimm GPR12 (ireg_of a1) n k
-  | Cmasknotzero n, a1 :: nil =>
-      andimm GPR12 (ireg_of a1) n k
-  | _, _ =>
-     k (**r never happens for well-typed code *)
-  end.
-
-(*  CRbit_0 = Less
-    CRbit_1 = Greater
-    CRbit_2 = Equal
-    CRbit_3 = Other *)
-
-Definition crbit_for_icmp (cmp: comparison) :=
-  match cmp with
-  | Ceq => (CRbit_2, true)
-  | Cne => (CRbit_2, false)
-  | Clt => (CRbit_0, true)
-  | Cle => (CRbit_1, false)
-  | Cgt => (CRbit_1, true)
-  | Cge => (CRbit_0, false)
-  end.
-
-Definition crbit_for_fcmp (cmp: comparison) :=
-  match cmp with
-  | Ceq => (CRbit_2, true)
-  | Cne => (CRbit_2, false)
-  | Clt => (CRbit_0, true)
-  | Cle => (CRbit_3, true)
-  | Cgt => (CRbit_1, true)
-  | Cge => (CRbit_3, true)
-  end.
-
-Definition crbit_for_cond (cond: condition) :=
-  match cond with
-  | Ccomp cmp => crbit_for_icmp cmp
-  | Ccompu cmp => crbit_for_icmp cmp
-  | Ccompimm cmp n => crbit_for_icmp cmp
-  | Ccompuimm cmp n => crbit_for_icmp cmp
-  | Ccompf cmp => crbit_for_fcmp cmp
-  | Cnotcompf cmp => let p := crbit_for_fcmp cmp in (fst p, negb (snd p))
-  | Cmaskzero n => (CRbit_2, true)
-  | Cmasknotzero n => (CRbit_2, false)
-  end.
-
-(** Translation of the arithmetic operation [r <- op(args)].
-  The corresponding instructions are prepended to [k]. *)
-
-Definition transl_op
-              (op: operation) (args: list mreg) (r: mreg) (k: code) :=
-  match op, args with
-  | Omove, a1 :: nil =>
-      match mreg_type a1 with
-      | Tint => Pmr (ireg_of r) (ireg_of a1) :: k
-      | Tfloat => Pfmr (freg_of r) (freg_of a1) :: k
-      end
-  | Ointconst n, nil =>
-      loadimm (ireg_of r) n k
-  | Ofloatconst f, nil =>
-      Plfi (freg_of r) f :: k
-  | Oaddrsymbol s ofs, nil =>
-      Paddis GPR12 GPR0 (Csymbol_high s ofs) ::
-      Paddi (ireg_of r) GPR12 (Csymbol_low s ofs) :: k
-  | Oaddrstack n, nil =>
-      addimm (ireg_of r) GPR1 n k
-  | Ocast8signed, a1 :: nil =>
-      Pextsb (ireg_of r) (ireg_of a1) :: k
-  | Ocast8unsigned, a1 :: nil =>
-      Prlwinm (ireg_of r) (ireg_of a1) Int.zero (Int.repr 255) :: k
-  | Ocast16signed, a1 :: nil =>
-      Pextsh (ireg_of r) (ireg_of a1) :: k
-  | Ocast16unsigned, a1 :: nil =>
-      Prlwinm (ireg_of r) (ireg_of a1) Int.zero (Int.repr 65535) :: k
-  | Oadd, a1 :: a2 :: nil =>
-      Padd (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Oaddimm n, a1 :: nil =>
-      addimm (ireg_of r) (ireg_of a1) n k
-  | Osub, a1 :: a2 :: nil =>
-      Psubfc (ireg_of r) (ireg_of a2) (ireg_of a1) :: k
-  | Osubimm n, a1 :: nil =>
-      if Int.eq (high_s n) Int.zero then
-        Psubfic (ireg_of r) (ireg_of a1) (Cint n) :: k
-      else
-        loadimm GPR12 n (Psubfc (ireg_of r) (ireg_of a1) GPR12 :: k)
-  | Omul, a1 :: a2 :: nil =>
-      Pmullw (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Omulimm n, a1 :: nil =>
-      if Int.eq (high_s n) Int.zero then
-        Pmulli (ireg_of r) (ireg_of a1) (Cint n) :: k
-      else
-        loadimm GPR12 n (Pmullw (ireg_of r) (ireg_of a1) GPR12 :: k)
-  | Odiv, a1 :: a2 :: nil =>
-      Pdivw (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Odivu, a1 :: a2 :: nil =>
-      Pdivwu (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Oand, a1 :: a2 :: nil =>
-      Pand_ (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Oandimm n, a1 :: nil =>
-      andimm (ireg_of r) (ireg_of a1) n k
-  | Oor, a1 :: a2 :: nil =>
-      Por (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Oorimm n, a1 :: nil =>
-      orimm (ireg_of r) (ireg_of a1) n k
-  | Oxor, a1 :: a2 :: nil =>
-      Pxor (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Oxorimm n, a1 :: nil =>
-      xorimm (ireg_of r) (ireg_of a1) n k
-  | Onand, a1 :: a2 :: nil =>
-      Pnand (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Onor, a1 :: a2 :: nil =>
-      Pnor (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Onxor, a1 :: a2 :: nil =>
-      Peqv (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Oshl, a1 :: a2 :: nil =>
-      Pslw (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Oshr, a1 :: a2 :: nil =>
-      Psraw (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Oshrimm n, a1 :: nil =>
-      Psrawi (ireg_of r) (ireg_of a1) n :: k
-  | Oshrximm n, a1 :: nil =>
-      Psrawi (ireg_of r) (ireg_of a1) n ::
-      Paddze (ireg_of r) (ireg_of r) :: k
-  | Oshru, a1 :: a2 :: nil =>
-      Psrw (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
-  | Orolm amount mask, a1 :: nil =>
-      Prlwinm (ireg_of r) (ireg_of a1) amount mask :: k
-  | Onegf, a1 :: nil =>
-      Pfneg (freg_of r) (freg_of a1) :: k
-  | Oabsf, a1 :: nil =>
-      Pfabs (freg_of r) (freg_of a1) :: k
-  | Oaddf, a1 :: a2 :: nil =>
-      Pfadd (freg_of r) (freg_of a1) (freg_of a2) :: k
-  | Osubf, a1 :: a2 :: nil =>
-      Pfsub (freg_of r) (freg_of a1) (freg_of a2) :: k
-  | Omulf, a1 :: a2 :: nil =>
-      Pfmul (freg_of r) (freg_of a1) (freg_of a2) :: k
-  | Odivf, a1 :: a2 :: nil =>
-      Pfdiv (freg_of r) (freg_of a1) (freg_of a2) :: k
-  | Omuladdf, a1 :: a2 :: a3 :: nil =>
-      Pfmadd (freg_of r) (freg_of a1) (freg_of a2) (freg_of a3) :: k
-  | Omulsubf, a1 :: a2 :: a3 :: nil =>
-      Pfmsub (freg_of r) (freg_of a1) (freg_of a2) (freg_of a3) :: k
-  | Osingleoffloat, a1 :: nil =>
-      Pfrsp (freg_of r) (freg_of a1) :: k
-  | Ointoffloat, a1 :: nil =>
-      Pfcti (ireg_of r) (freg_of a1) :: k
-  | Ointuoffloat, a1 :: nil =>
-      Pfctiu (ireg_of r) (freg_of a1) :: k
-  | Ofloatofint, a1 :: nil =>
-      Pictf (freg_of r) (ireg_of a1) :: k
-  | Ofloatofintu, a1 :: nil =>
-      Piuctf (freg_of r) (ireg_of a1) :: k
-  | Ocmp cmp, _ =>
-      let p := crbit_for_cond cmp in
-      transl_cond cmp args
-        (Pmfcrbit (ireg_of r) (fst p) ::
-         if snd p
-         then k
-         else Pxori (ireg_of r) (ireg_of r) (Cint Int.one) :: k)
-  | _, _ =>
-      k (**r never happens for well-typed code *)
-  end.
-
-(** Common code to translate [Mload] and [Mstore] instructions. *)
-
-Definition transl_load_store 
-     (mk1: constant -> ireg -> instruction)
-     (mk2: ireg -> ireg -> instruction)
-     (addr: addressing) (args: list mreg) (k: code) :=
-  match addr, args with
-  | Aindexed ofs, a1 :: nil =>
-      if ireg_eq (ireg_of a1) GPR0 then
-        Pmr GPR12 (ireg_of a1) ::
-        Paddis GPR12 GPR12 (Cint (high_s ofs)) ::
-        mk1 (Cint (low_s ofs)) GPR12 :: k
-      else if Int.eq (high_s ofs) Int.zero then
-        mk1 (Cint ofs) (ireg_of a1) :: k
-      else
-        Paddis GPR12 (ireg_of a1) (Cint (high_s ofs)) ::
-        mk1 (Cint (low_s ofs)) GPR12 :: k
-  | Aindexed2, a1 :: a2 :: nil =>
-      mk2 (ireg_of a1) (ireg_of a2) :: k
-  | Aglobal symb ofs, nil =>
-      Paddis GPR12 GPR0 (Csymbol_high symb ofs) ::
-      mk1 (Csymbol_low symb ofs) GPR12 :: k
-  | Abased symb ofs, a1 :: nil =>
-      if ireg_eq (ireg_of a1) GPR0 then
-        Pmr GPR12 (ireg_of a1) ::
-        Paddis GPR12 GPR12 (Csymbol_high symb ofs) ::
-        mk1 (Csymbol_low symb ofs) GPR12 :: k
-      else
-        Paddis GPR12 (ireg_of a1) (Csymbol_high symb ofs) ::
-        mk1 (Csymbol_low symb ofs) GPR12 :: k
-  | Ainstack ofs, nil =>
-      if Int.eq (high_s ofs) Int.zero then
-        mk1 (Cint ofs) GPR1 :: k
-      else
-        Paddis GPR12 GPR1 (Cint (high_s ofs)) ::
-        mk1 (Cint (low_s ofs)) GPR12 :: k
-  | _, _ =>
-      (* should not happen *) 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 GPR1 ofs ty dst k
-  | Msetstack src ofs ty =>
-      storeind src GPR1 ofs ty k
-  | Mgetparam ofs ty dst =>
-      Plwz GPR12 (Cint f.(fn_link_ofs)) GPR1 :: loadind GPR12 ofs ty dst k
-  | Mop op args res =>
-      transl_op op args res k
-  | Mload chunk addr args dst =>
-      match chunk with
-      | Mint8signed =>
-          transl_load_store
-            (Plbz (ireg_of dst)) (Plbzx (ireg_of dst)) addr args
-            (Pextsb (ireg_of dst) (ireg_of dst) :: k)
-      | Mint8unsigned =>
-          transl_load_store
-            (Plbz (ireg_of dst)) (Plbzx (ireg_of dst)) addr args k
-      | Mint16signed =>
-          transl_load_store
-            (Plha (ireg_of dst)) (Plhax (ireg_of dst)) addr args k
-      | Mint16unsigned =>
-          transl_load_store
-            (Plhz (ireg_of dst)) (Plhzx (ireg_of dst)) addr args k
-      | Mint32 =>
-          transl_load_store
-            (Plwz (ireg_of dst)) (Plwzx (ireg_of dst)) addr args k
-      | Mfloat32 =>
-          transl_load_store
-            (Plfs (freg_of dst)) (Plfsx (freg_of dst)) addr args k
-      | Mfloat64 =>
-          transl_load_store
-            (Plfd (freg_of dst)) (Plfdx (freg_of dst)) addr args k
-      end
-  | Mstore chunk addr args src =>
-      match chunk with
-      | Mint8signed =>
-          transl_load_store
-            (Pstb (ireg_of src)) (Pstbx (ireg_of src)) addr args k
-      | Mint8unsigned =>
-          transl_load_store
-            (Pstb (ireg_of src)) (Pstbx (ireg_of src)) addr args k
-      | Mint16signed =>
-          transl_load_store
-            (Psth (ireg_of src)) (Psthx (ireg_of src)) addr args k
-      | Mint16unsigned =>
-          transl_load_store
-            (Psth (ireg_of src)) (Psthx (ireg_of src)) addr args k
-      | Mint32 =>
-          transl_load_store
-            (Pstw (ireg_of src)) (Pstwx (ireg_of src)) addr args k
-      | Mfloat32 =>
-          transl_load_store
-            (Pstfs (freg_of src)) (Pstfsx (freg_of src)) addr args k
-      | Mfloat64 =>
-          transl_load_store
-            (Pstfd (freg_of src)) (Pstfdx (freg_of src)) addr args k
-      end
-  | Mcall sig (inl r) =>
-      Pmtctr (ireg_of r) :: Pbctrl :: k
-  | Mcall sig (inr symb) =>
-      Pbl symb :: k
-  | Mtailcall sig (inl r) =>
-      Pmtctr (ireg_of r) :: 
-      Plwz GPR12 (Cint f.(fn_retaddr_ofs)) GPR1 ::
-      Pmtlr GPR12 ::
-      Pfreeframe f.(fn_link_ofs) :: 
-      Pbctr :: k
-  | Mtailcall sig (inr symb) =>
-      Plwz GPR12 (Cint f.(fn_retaddr_ofs)) GPR1 ::
-      Pmtlr GPR12 ::
-      Pfreeframe f.(fn_link_ofs) :: 
-      Pbs symb :: k
-  | Malloc =>
-      Pallocblock :: k
-  | Mlabel lbl =>
-      Plabel lbl :: k
-  | Mgoto lbl =>
-      Pb lbl :: k
-  | Mcond cond args lbl =>
-      let p := crbit_for_cond cond in
-      transl_cond cond args
-        (if (snd p) then Pbt (fst p) lbl :: k else Pbf (fst p) lbl :: k)
-  | Mreturn =>
-      Plwz GPR12 (Cint f.(fn_retaddr_ofs)) GPR1 ::
-      Pmtlr GPR12 ::
-      Pfreeframe f.(fn_link_ofs) ::
-      Pblr :: k
-  end.
-
-Definition transl_code (f: Mach.function) (il: list Mach.instruction) :=
-  List.fold_right (transl_instr f) nil il.
-
-(** 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 transl_function (f: Mach.function) :=
-  Pallocframe (- f.(fn_framesize)) f.(fn_stacksize) f.(fn_link_ofs) ::
-  Pmflr GPR12 ::
-  Pstw GPR12 (Cint f.(fn_retaddr_ofs)) GPR1 ::
-  transl_code f f.(fn_code).
-
-Fixpoint code_size (c: code) : Z :=
-  match c with
-  | nil => 0
-  | instr :: c' => code_size c' + 1
-  end.
-
-Open Local Scope string_scope.
-
-Definition transf_function (f: Mach.function) : res PPC.code :=
-  let c := transl_function f in
-  if zlt Int.max_unsigned (code_size c)
-  then Errors.Error (msg "code size exceeded")
-  else Errors.OK c.
-
-Definition transf_fundef (f: Mach.fundef) : res PPC.fundef :=
-  transf_partial_fundef transf_function f.
-
-Definition transf_program (p: Mach.program) : res PPC.program :=
-  transform_partial_program transf_fundef p.
-
diff --git a/backend/PPCgenproof.v b/backend/PPCgenproof.v
deleted file mode 100644
index 6db8b477..00000000
--- a/backend/PPCgenproof.v
+++ /dev/null
@@ -1,1393 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** 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 Mem.
-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 PPC.
-Require Import PPCgen.
-Require Import PPCgenretaddr.
-Require Import PPCgenproof1.
-
-Section PRESERVATION.
-
-Variable prog: Mach.program.
-Variable tprog: PPC.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 f b,
-  Genv.find_funct_ptr ge b = Some (Internal f) ->
-  Genv.find_funct_ptr tge b = Some (Internal (transl_function f)).
-Proof.
-  intros. 
-  destruct (functions_translated _ _ H) as [tf [A B]].
-  rewrite A. generalize B. unfold transf_fundef, transf_partial_fundef, transf_function.
-  case (zlt Int.max_unsigned (code_size (transl_function f))); simpl; intro.
-  congruence. intro. inv B0. auto.
-Qed.
-
-Lemma functions_transl_no_overflow:
-  forall b f,
-  Genv.find_funct_ptr ge b = Some (Internal f) ->
-  code_size (transl_function f) <= Int.max_unsigned.
-Proof.
-  intros. 
-  destruct (functions_translated _ _ H) as [tf [A B]].
-  generalize B. unfold transf_fundef, transf_partial_fundef, transf_function.
-  case (zlt Int.max_unsigned (code_size (transl_function f))); simpl; intro.
-  congruence. intro; omega.
-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_size_pos:
-  forall fn, code_size fn >= 0.
-Proof.
-  induction fn; simpl; omega.
-Qed.
-
-Remark code_tail_bounds:
-  forall fn ofs i c,
-  code_tail ofs fn (i :: c) -> 0 <= ofs < code_size fn.
-Proof.
-  assert (forall ofs fn c, code_tail ofs fn c ->
-          forall i c', c = i :: c' -> 0 <= ofs < code_size fn).
-  induction 1; intros; simpl. 
-  rewrite H. simpl. generalize (code_size_pos c'). omega.
-  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,
-  code_size 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.
-
-(** [transl_code_at_pc pc fn c] holds if the code pointer [pc] points
-  within the PPC 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 -> Prop :=
-  transl_code_at_pc_intro:
-    forall b ofs f c,
-    Genv.find_funct_ptr ge b = Some (Internal f) ->
-    code_tail (Int.unsigned ofs) (transl_function f) (transl_code f c) ->
-    transl_code_at_pc (Vptr b ofs) b f c.
-
-(** 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' ->
-  code_size 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' ->
-  code_size 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 c' rs m rs' m',
-  transl_code_at_pc (rs PC) fb f c ->
-  exec_straight tge (transl_function f)
-                (transl_code f c) rs m c' rs' m' ->
-  plus step tge (State rs m) E0 (State rs' m').
-Proof.
-  intros. inversion H. subst.
-  eapply exec_straight_steps_1; eauto.
-  eapply functions_transl_no_overflow; eauto. 
-  eapply functions_transl; eauto.
-Qed.
-
-Lemma exec_straight_at:
-  forall fb f c c' rs m rs' m',
-  transl_code_at_pc (rs PC) fb f c ->
-  exec_straight tge (transl_function f)
-                (transl_code f c) rs m (transl_code f c') rs' m' ->
-  transl_code_at_pc (rs' PC) fb f c'.
-Proof.
-  intros. inversion H. subst. 
-  generalize (functions_transl_no_overflow _ _ H2). intro.
-  generalize (functions_transl _ _ H2). intro.
-  generalize (exec_straight_steps_2 _ _ _ _ _ _ _
-                H0 H4 _ _ (sym_equal H1) H5 H3).
-  intros [ofs' [PC' CT']].
-  rewrite PC'. constructor; auto.
-Qed.
-
-(** Correctness of the return addresses predicted by
-    [PPCgen.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 ofs',
-  transl_code_at_pc (Vptr b ofs) fb f c ->
-  return_address_offset f c ofs' ->
-  ofs' = ofs.
-Proof.
-  intros. inv H0. inv H. 
-  generalize (code_tail_unique _ _ _ _ H1 H7). intro. rewrite H. 
-  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 + code_size 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. 
-  generalize (code_size_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. 
-  omega.
-Qed.
-
-(** The following lemmas show that the translation from Mach to PPC
-  preserves labels, in the sense that the following diagram commutes:
-<<
-                          translation
-        Mach code ------------------------ PPC instr sequence
-            |                                          |
-            | Mach.find_label lbl       find_label lbl |
-            |                                          |
-            v                                          v
-        Mach code tail ------------------- PPC instr seq tail
-                          translation
->>
-  The proof demands many boring lemmas showing that PPC constructor
-  functions do not introduce new labels.
-*)
-
-Section TRANSL_LABEL.
-
-Variable lbl: label.
-
-Remark loadimm_label:
-  forall r n k, find_label lbl (loadimm r n k) = find_label lbl k.
-Proof.
-  intros. unfold loadimm. 
-  case (Int.eq (high_s n) Int.zero). reflexivity. 
-  case (Int.eq (low_s n) Int.zero). reflexivity.
-  reflexivity.
-Qed.
-Hint Rewrite loadimm_label: labels.
-
-Remark addimm_1_label:
-  forall r1 r2 n k, find_label lbl (addimm_1 r1 r2 n k) = find_label lbl k.
-Proof.
-  intros; unfold addimm_1. 
-  case (Int.eq (high_s n) Int.zero). reflexivity.
-  case (Int.eq (low_s n) Int.zero). reflexivity. reflexivity.
-Qed.
-Remark addimm_2_label:
-  forall r1 r2 n k, find_label lbl (addimm_2 r1 r2 n k) = find_label lbl k.
-Proof.
-  intros; unfold addimm_2. autorewrite with labels. reflexivity.
-Qed.
-Remark addimm_label:
-  forall r1 r2 n k, find_label lbl (addimm r1 r2 n k) = find_label lbl k.
-Proof.
-  intros; unfold addimm. 
-  case (ireg_eq r1 GPR0); intro. apply addimm_2_label.
-  case (ireg_eq r2 GPR0); intro. apply addimm_2_label.
-  apply addimm_1_label.
-Qed.
-Hint Rewrite addimm_label: labels.
-
-Remark andimm_label:
-  forall r1 r2 n k, find_label lbl (andimm r1 r2 n k) = find_label lbl k.
-Proof.
-  intros; unfold andimm. 
-  case (Int.eq (high_u n) Int.zero). reflexivity.
-  case (Int.eq (low_u n) Int.zero). reflexivity.
-  autorewrite with labels. reflexivity.
-Qed.
-Hint Rewrite andimm_label: labels.
-
-Remark orimm_label:
-  forall r1 r2 n k, find_label lbl (orimm r1 r2 n k) = find_label lbl k.
-Proof.
-  intros; unfold orimm. 
-  case (Int.eq (high_u n) Int.zero). reflexivity.
-  case (Int.eq (low_u n) Int.zero). reflexivity. reflexivity.
-Qed.
-Hint Rewrite orimm_label: labels.
-
-Remark xorimm_label:
-  forall r1 r2 n k, find_label lbl (xorimm r1 r2 n k) = find_label lbl k.
-Proof.
-  intros; unfold xorimm. 
-  case (Int.eq (high_u n) Int.zero). reflexivity.
-  case (Int.eq (low_u n) Int.zero). reflexivity. reflexivity.
-Qed.
-Hint Rewrite xorimm_label: labels.
-
-Remark loadind_aux_label:
-  forall base ofs ty dst k, find_label lbl (loadind_aux base ofs ty dst :: k) = find_label lbl k.
-Proof.
-  intros; unfold loadind_aux.
-  case ty; reflexivity.
-Qed.
-Remark loadind_label:
-  forall base ofs ty dst k, find_label lbl (loadind base ofs ty dst k) = find_label lbl k.
-Proof.
-  intros; unfold loadind. 
-  case (Int.eq (high_s ofs) Int.zero). apply loadind_aux_label.
-  transitivity (find_label lbl (loadind_aux GPR12 (low_s ofs) ty dst :: k)).
-  reflexivity. apply loadind_aux_label.
-Qed.
-Hint Rewrite loadind_label: labels.
-Remark storeind_aux_label:
-  forall base ofs ty dst k, find_label lbl (storeind_aux base ofs ty dst :: k) = find_label lbl k.
-Proof.
-  intros; unfold storeind_aux.
-  case dst; reflexivity.
-Qed.
-Remark storeind_label:
-  forall base ofs ty src k, find_label lbl (storeind base src ofs ty k) = find_label lbl k.
-Proof.
-  intros; unfold storeind. 
-  case (Int.eq (high_s ofs) Int.zero). apply storeind_aux_label.
-  transitivity (find_label lbl (storeind_aux base GPR12 (low_s ofs) ty :: k)).
-  reflexivity. apply storeind_aux_label.
-Qed.
-Hint Rewrite storeind_label: labels.
-Remark floatcomp_label:
-  forall cmp r1 r2 k, find_label lbl (floatcomp cmp r1 r2 k) = find_label lbl k.
-Proof.
-  intros; unfold floatcomp. destruct cmp; reflexivity.
-Qed.
-
-Remark transl_cond_label:
-  forall cond args k, find_label lbl (transl_cond cond args k) = find_label lbl k.
-Proof.
-  intros; unfold transl_cond.
-  destruct cond; (destruct args; 
-  [try reflexivity | destruct args;
-  [try reflexivity | destruct args; try reflexivity]]).
-  case (Int.eq (high_s i) Int.zero). reflexivity. 
-  autorewrite with labels; reflexivity.
-  case (Int.eq (high_u i) Int.zero). reflexivity. 
-  autorewrite with labels; reflexivity.
-  apply floatcomp_label. apply floatcomp_label.
-  apply andimm_label. apply andimm_label.
-Qed.
-Hint Rewrite transl_cond_label: labels.
-Remark transl_op_label:
-  forall op args r k, find_label lbl (transl_op op args r k) = find_label lbl k.
-Proof.
-  intros; unfold transl_op;
-  destruct op; destruct args; try (destruct args); try (destruct args); try (destruct args);
-  try reflexivity; autorewrite with labels; try reflexivity.
-  case (mreg_type m); reflexivity.
-  case (Int.eq (high_s i) Int.zero); autorewrite with labels; reflexivity.
-  case (Int.eq (high_s i) Int.zero); autorewrite with labels; reflexivity.
-  case (snd (crbit_for_cond c)); reflexivity.
-  case (snd (crbit_for_cond c)); reflexivity.
-  case (snd (crbit_for_cond c)); reflexivity.
-  case (snd (crbit_for_cond c)); reflexivity.
-  case (snd (crbit_for_cond c)); reflexivity.
-Qed.
-Hint Rewrite transl_op_label: labels.
-
-Remark transl_load_store_label:
-  forall (mk1: constant -> ireg -> instruction) (mk2: ireg -> ireg -> instruction)
-         addr args k,
-  (forall c r, is_label lbl (mk1 c r) = false) ->
-  (forall r1 r2, is_label lbl (mk2 r1 r2) = false) ->
-  find_label lbl (transl_load_store mk1 mk2 addr args k) = find_label lbl k.
-Proof.
-  intros; unfold transl_load_store.
-  destruct addr; destruct args; try (destruct args); try (destruct args);
-  try reflexivity.
-  case (ireg_eq (ireg_of m) GPR0); intro.
-  simpl. rewrite H. auto. 
-  case (Int.eq (high_s i) Int.zero). simpl; rewrite H; auto.
-  simpl; rewrite H; auto.
-  simpl; rewrite H0; auto.
-  simpl; rewrite H; auto.
-  case (ireg_eq (ireg_of m) GPR0); intro; simpl; rewrite H; auto. 
-  case (Int.eq (high_s i) Int.zero); simpl; rewrite H; auto.
-Qed.
-Hint Rewrite transl_load_store_label: labels.
-
-Lemma transl_instr_label:
-  forall f i k,
-  find_label lbl (transl_instr f i k) = 
-    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. simpl. rewrite peq_true. auto.
-  destruct i; simpl; autorewrite with labels; try reflexivity.
-  destruct m; rewrite transl_load_store_label; intros; reflexivity. 
-  destruct m; rewrite transl_load_store_label; intros; reflexivity. 
-  destruct s0; reflexivity.
-  destruct s0; reflexivity.
-  rewrite peq_false. auto. congruence.
-  case (snd (crbit_for_cond c)); reflexivity.
-Qed.
-
-Lemma transl_code_label:
-  forall f c,
-  find_label lbl (transl_code f c) = 
-    option_map (transl_code f) (Mach.find_label lbl c).
-Proof.
-  induction c; simpl; intros.
-  auto. rewrite transl_instr_label.
-  case (Mach.is_label lbl a). reflexivity.
-  auto.
-Qed.
-
-Lemma transl_find_label:
-  forall f,
-  find_label lbl (transl_function f) = 
-    option_map (transl_code f) (Mach.find_label lbl f.(fn_code)).
-Proof.
-  intros. unfold transl_function. simpl. apply transl_code_label.
-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 lbl rs m c' b ofs,
-  Genv.find_funct_ptr ge b = Some (Internal f) ->
-  rs PC = Vptr b ofs ->
-  Mach.find_label lbl f.(fn_code) = Some c' ->
-  exists rs',
-    goto_label (transl_function f) lbl rs m = OK rs' m  
-  /\ transl_code_at_pc (rs' PC) b f c'
-  /\ forall r, r <> PC -> rs'#r = rs#r.
-Proof.
-  intros. 
-  generalize (transl_find_label lbl f).
-  rewrite H1; simpl. intro.
-  generalize (label_pos_code_tail lbl (transl_function f) 0 
-                 (transl_code f c') H2).
-  intros [pos' [A [B C]]].
-  exists (rs#PC <- (Vptr b (Int.repr pos'))).
-  split. unfold goto_label. rewrite A. rewrite H0. auto.
-  split. rewrite Pregmap.gss. constructor; auto. 
-  rewrite Int.unsigned_repr. replace (pos' - 0) with pos' in B.
-  auto. omega. 
-  generalize (functions_transl_no_overflow _ _ H). 
-  omega.
-  intros. apply Pregmap.gso; auto.
-Qed.
-
-(** * Memory properties *)
-
-(** The PowerPC has no instruction for ``load 8-bit signed integer''.
-  We show that it can be synthesized as a ``load 8-bit unsigned integer''
-  followed by a sign extension. *)
-
-Remark valid_access_equiv:
-  forall chunk1 chunk2 m b ofs,
-  size_chunk chunk1 = size_chunk chunk2 ->
-  valid_access m chunk1 b ofs ->
-  valid_access m chunk2 b ofs.
-Proof.
-  intros. inv H0. rewrite H in H3. constructor; auto.
-Qed.
-
-Remark in_bounds_equiv:
-  forall chunk1 chunk2 m b ofs (A: Set) (a1 a2: A),
-  size_chunk chunk1 = size_chunk chunk2 ->
-  (if in_bounds m chunk1 b ofs then a1 else a2) =
-  (if in_bounds m chunk2 b ofs then a1 else a2).
-Proof.
-  intros. destruct (in_bounds m chunk1 b ofs).
-  rewrite in_bounds_true. auto. eapply valid_access_equiv; eauto.
-  destruct (in_bounds m chunk2 b ofs); auto.
-  elim n. eapply valid_access_equiv with (chunk1 := chunk2); eauto.
-Qed.
-
-Lemma loadv_8_signed_unsigned:
-  forall m a,
-  Mem.loadv Mint8signed m a = 
-    option_map (Val.sign_ext 8) (Mem.loadv Mint8unsigned m a).
-Proof.
-  intros. unfold Mem.loadv. destruct a; try reflexivity.
-  unfold load. rewrite (in_bounds_equiv Mint8signed Mint8unsigned).
-  destruct (in_bounds m Mint8unsigned b (Int.signed i)); auto.
-  simpl.
-  destruct (getN 0 (Int.signed i) (contents (blocks m b))); auto.
-  simpl. rewrite Int.sign_ext_zero_ext. auto. compute; auto. 
-  auto.
-Qed.
-
-(** Similarly, we show that signed 8- and 16-bit stores can be performed
-  like unsigned stores. *)
-
-Lemma storev_8_signed_unsigned:
-  forall m a v,
-  Mem.storev Mint8signed m a v = Mem.storev Mint8unsigned m a v.
-Proof.
-  intros. unfold storev. destruct a; auto.
-  unfold store. rewrite (in_bounds_equiv Mint8signed Mint8unsigned).
-  auto. auto.
-Qed.
-
-Lemma storev_16_signed_unsigned:
-  forall m a v,
-  Mem.storev Mint16signed m a v = Mem.storev Mint16unsigned m a v.
-Proof.
-  intros. unfold storev. destruct a; auto.
-  unfold store. rewrite (in_bounds_equiv Mint16signed Mint16unsigned).
-  auto. 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,
-      Genv.find_funct_ptr ge fb = Some (Internal f) ->
-      wt_function f ->
-      incl c f.(fn_code) ->
-      transl_code_at_pc ra fb f c ->
-      match_stack s ->
-      match_stack (Stackframe fb sp ra c :: s).
-
-Inductive match_states: Machconcr.state -> PPC.state -> Prop :=
-  | match_states_intro:
-      forall s fb sp c ms m rs f
-        (STACKS: match_stack s)
-        (FIND: Genv.find_funct_ptr ge fb = Some (Internal f))
-        (WTF: wt_function f)
-        (INCL: incl c f.(fn_code))
-        (AT: transl_code_at_pc (rs PC) fb f c)
-        (AG: agree ms sp rs),
-      match_states (Machconcr.State s fb sp c ms m)
-                   (PPC.State rs m)
-  | match_states_call:
-      forall s fb ms m rs
-        (STACKS: match_stack s)
-        (AG: agree ms (parent_sp s) rs)
-        (ATPC: rs PC = Vptr fb Int.zero)
-        (ATLR: rs LR = parent_ra s),
-      match_states (Machconcr.Callstate s fb ms m)
-                   (PPC.State rs m)
-  | match_states_return:
-      forall s ms m rs
-        (STACKS: match_stack s)
-        (AG: agree ms (parent_sp s) rs)
-        (ATPC: rs PC = parent_ra s),
-      match_states (Machconcr.Returnstate s ms m)
-                   (PPC.State rs m).
-
-Lemma exec_straight_steps:
-  forall s fb sp m1 f c1 rs1 c2 m2 ms2,
-  match_stack s ->
-  Genv.find_funct_ptr ge fb = Some (Internal f) ->
-  wt_function f ->
-  incl c2 f.(fn_code) ->
-  transl_code_at_pc (rs1 PC) fb f c1 ->
-  (exists rs2,
-     exec_straight tge (transl_function f) (transl_code f c1) rs1 m1 (transl_code f c2) rs2 m2
-     /\ agree ms2 sp rs2) ->
-  exists st',
-  plus step tge (State rs1 m1) E0 st' /\
-  match_states (Machconcr.State s fb sp c2 ms2 m2) st'.
-Proof.
-  intros. destruct H4 as [rs2 [A B]].
-  exists (State rs2 m2); split.
-  eapply exec_straight_exec; eauto.
-  econstructor; eauto. eapply exec_straight_at; eauto.
-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 PPC 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 with coqlib.
-  exists (nextinstr rs); split.
-  simpl. apply exec_straight_one. reflexivity. reflexivity.
-  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. 
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI. inversion WTI.
-  rewrite (sp_val _ _ _ AG) in H.
-  assert (NOTE: GPR1 <> GPR0). congruence.
-  generalize (loadind_correct tge (transl_function f) GPR1 ofs ty
-                dst (transl_code f c) rs m v H H1 NOTE).
-  intros [rs2 [EX [RES OTH]]].
-  left; eapply exec_straight_steps; eauto with coqlib.
-  simpl. exists rs2; split. auto. 
-  apply agree_exten_2 with (rs#(preg_of dst) <- v).
-  auto with ppcgen. 
-  intros. case (preg_eq r0 (preg_of dst)); intro.
-  subst r0. rewrite Pregmap.gss. auto. 
-  rewrite Pregmap.gso; auto.
-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. 
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI. inversion WTI.
-  rewrite (sp_val _ _ _ AG) in H.
-  rewrite (preg_val ms sp rs) in H; auto.
-  assert (NOTE: GPR1 <> GPR0). congruence.
-  generalize (storeind_correct tge (transl_function f) GPR1 ofs ty
-                src (transl_code f c) rs m m' H H1 NOTE).
-  intros [rs2 [EX OTH]].
-  left; eapply exec_straight_steps; eauto with coqlib.
-  exists rs2; split; auto.
-  apply agree_exten_2 with rs; auto.
-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 ms) m).
-Proof.
-  intros; red; intros; inv MS.
-  assert (f0 = f) by congruence. subst f0.
-  set (rs2 := nextinstr (rs#GPR12 <- parent)).
-  assert (EX1: exec_straight tge (transl_function f)
-                 (transl_code f (Mgetparam ofs ty dst :: c)) rs m
-                 (loadind GPR12 ofs ty dst (transl_code f c)) rs2 m).
-  simpl. apply exec_straight_one.
-  simpl. unfold load1. rewrite gpr_or_zero_not_zero; auto with ppcgen.
-  unfold const_low. rewrite <- (sp_val ms sp rs); auto.
-  unfold load_stack in H0. simpl chunk_of_type in H0. 
-  rewrite H0. reflexivity. reflexivity.
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI. inversion WTI.
-  unfold load_stack in H1. change parent with rs2#GPR12 in H1.
-  assert (NOTE: GPR12 <> GPR0). congruence.
-  generalize (loadind_correct tge (transl_function f) GPR12 ofs ty
-                dst (transl_code f c) rs2 m v H1 H3 NOTE).
-  intros [rs3 [EX2 [RES OTH]]].
-  left; eapply exec_straight_steps; eauto with coqlib.
-  exists rs3; split; simpl.
-  eapply exec_straight_trans; eauto.
-  apply agree_exten_2 with (rs2#(preg_of dst) <- v).
-  unfold rs2; auto with ppcgen.
-  intros. case (preg_eq r0 (preg_of dst)); intro.
-  subst r0. rewrite Pregmap.gss. auto. 
-  rewrite Pregmap.gso; 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 m = 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 ms) m).
-Proof.
-  intros; red; intros; inv MS.
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI.
-  left; eapply exec_straight_steps; eauto with coqlib.
-  simpl. eapply transl_op_correct; auto.
-  rewrite <- H. apply eval_operation_preserved. exact symbols_preserved.
-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 ->
-  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 ms) m).
-Proof.
-  intros; red; intros; inv MS.
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI; inversion WTI.
-  assert (eval_addressing tge sp addr ms##args = Some a).
-    rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
-  left; eapply exec_straight_steps; eauto with coqlib;
-  destruct chunk; simpl; simpl in H6;
-  (* all cases but Mint8signed *)
-  try (eapply transl_load_correct; eauto;
-       intros; simpl; unfold preg_of; rewrite H6; auto).
-  (* Mint8signed *)
-  generalize (loadv_8_signed_unsigned m a).
-  rewrite H0. 
-  caseEq (loadv Mint8unsigned m a);
-  [idtac | simpl;intros;discriminate].
-  intros v' LOAD' EQ. simpl in EQ. injection EQ. intro EQ1. clear EQ.
-  assert (X1: forall (cst : constant) (r1 : ireg) (rs1 : regset),
-    exec_instr tge (transl_function f) (Plbz (ireg_of dst) cst r1) rs1 m =
-    load1 tge Mint8unsigned (preg_of dst) cst r1 rs1 m).
-    intros. unfold preg_of; rewrite H6. reflexivity. 
-  assert (X2: forall (r1 r2 : ireg) (rs1 : regset),
-    exec_instr tge (transl_function f) (Plbzx (ireg_of dst) r1 r2) rs1 m =
-    load2 Mint8unsigned (preg_of dst) r1 r2 rs1 m).
-    intros. unfold preg_of; rewrite H6. reflexivity. 
-  generalize (transl_load_correct tge (transl_function f)
-                (Plbz (ireg_of dst)) (Plbzx (ireg_of dst))
-                Mint8unsigned addr args 
-                (Pextsb (ireg_of dst) (ireg_of dst) :: transl_code f c) 
-                ms sp rs m dst a v'
-                X1 X2 AG H3 H7 LOAD').
-  intros [rs2 [EX1 AG1]].
-  exists (nextinstr (rs2#(ireg_of dst) <- v)).
-  split. eapply exec_straight_trans. eexact EX1.
-  apply exec_straight_one. simpl. 
-  rewrite <- (ireg_val _ _ _ dst AG1);auto. rewrite Regmap.gss. 
-  rewrite EQ1. reflexivity. reflexivity. 
-  eauto with ppcgen.
-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 ->
-  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 ms m').
-Proof.
-  intros; red; intros; inv MS.
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI; inversion WTI.
-  rewrite <- (eval_addressing_preserved symbols_preserved) in H.
-  left; eapply exec_straight_steps; eauto with coqlib. 
-  destruct chunk; simpl; simpl in H6;
-  try (rewrite storev_8_signed_unsigned in H0);
-  try (rewrite storev_16_signed_unsigned in H0);
-  simpl; eapply transl_store_correct; eauto;
-  intros; unfold preg_of; rewrite H6; reflexivity.
-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.
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI. inversion WTI.
-  inv AT. 
-  assert (NOOV: code_size (transl_function f) <= Int.max_unsigned).
-    eapply functions_transl_no_overflow; eauto.
-  destruct ros; simpl in H; simpl transl_code in H7.
-  (* Indirect call *)
-  generalize (code_tail_next_int _ _ _ _ NOOV H7). intro CT1.
-  generalize (code_tail_next_int _ _ _ _ NOOV CT1). intro CT2.
-  set (rs2 := nextinstr (rs#CTR <- (ms m0))).
-  set (rs3 := rs2 #LR <- (Val.add rs2#PC Vone) #PC <- (ms m0)).
-  assert (ATPC: rs3 PC = Vptr f' Int.zero).
-    change (rs3 PC) with (ms m0). 
-    destruct (ms m0); try discriminate.
-    generalize H; predSpec Int.eq Int.eq_spec i Int.zero; intros; congruence.
-  exploit return_address_offset_correct; eauto. constructor; eauto. 
-  intro RA_EQ.
-  assert (ATLR: rs3 LR = Vptr fb ra).
-    rewrite RA_EQ.
-    change (rs3 LR) with (Val.add (Val.add (rs PC) Vone) Vone).
-    rewrite <- H5. reflexivity. 
-  assert (AG3: agree ms sp rs3). 
-    unfold rs3, rs2; auto 8 with ppcgen.
-  left; exists (State rs3 m); split.
-  apply plus_left with E0 (State rs2 m) E0. 
-    econstructor. eauto. apply functions_transl. eexact H0. 
-    eapply find_instr_tail. eauto.
-    simpl. rewrite <- (ireg_val ms sp rs); auto. 
-  apply star_one. econstructor.
-    change (rs2 PC) with (Val.add (rs PC) Vone). rewrite <- H5.
-    simpl. auto.
-    apply functions_transl. eexact H0.
-    eapply find_instr_tail. eauto.
-    simpl. reflexivity.
-  traceEq.
-  econstructor; eauto.
-  econstructor; eauto with coqlib.
-  rewrite RA_EQ. econstructor; eauto.
-  (* Direct call *)
-  generalize (code_tail_next_int _ _ _ _ NOOV H7). intro CT1.
-  set (rs2 := rs #LR <- (Val.add rs#PC Vone) #PC <- (symbol_offset tge i Int.zero)).
-  assert (ATPC: rs2 PC = Vptr f' Int.zero).
-    change (rs2 PC) with (symbol_offset tge i Int.zero).
-    unfold symbol_offset. rewrite symbols_preserved. rewrite H. auto.
-  exploit return_address_offset_correct; eauto. constructor; eauto. 
-  intro RA_EQ.
-  assert (ATLR: rs2 LR = Vptr fb ra).
-    rewrite RA_EQ.
-    change (rs2 LR) with (Val.add (rs PC) Vone).
-    rewrite <- H5. reflexivity. 
-  assert (AG2: agree ms sp rs2). 
-    unfold rs2; auto 8 with ppcgen.
-  left; exists (State rs2 m); split.
-  apply plus_one. econstructor. 
-    eauto.
-    apply functions_transl. eexact H0. 
-    eapply find_instr_tail. eauto.
-    simpl. reflexivity.
-  econstructor; eauto with coqlib.
-  econstructor; eauto with coqlib.
-  rewrite RA_EQ. econstructor; eauto.
-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),
-  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) ->
-  exec_instr_prop
-          (Machconcr.State s fb (Vptr stk soff) (Mtailcall sig ros :: c) ms m) E0
-          (Callstate s f' ms (free m stk)).
-Proof.
-  intros; red; intros; inv MS.
-  assert (f0 = f) by congruence. subst f0.
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI. inversion WTI.
-  inversion AT. subst b f0 c0.
-  assert (NOOV: code_size (transl_function f) <= Int.max_unsigned).
-    eapply functions_transl_no_overflow; eauto.
-  destruct ros; simpl in H; simpl in H9.
-  (* Indirect call *)
-  set (rs2 := nextinstr (rs#CTR <- (ms m0))).
-  set (rs3 := nextinstr (rs2#GPR12 <- (parent_ra s))).
-  set (rs4 := nextinstr (rs3#LR <- (parent_ra s))).
-  set (rs5 := nextinstr (rs4#GPR1 <- (parent_sp s))).
-  set (rs6 := rs5#PC <- (rs5 CTR)).
-  assert (exec_straight tge (transl_function f)
-            (transl_code f (Mtailcall sig (inl ident m0) :: c)) rs m 
-            (Pbctr :: transl_code f c) rs5 (free m stk)).
-  simpl. apply exec_straight_step with rs2 m. 
-  simpl. rewrite <- (ireg_val _ _ _ _ AG H6). reflexivity. reflexivity.
-  apply exec_straight_step with rs3 m.
-  simpl. unfold load1. rewrite gpr_or_zero_not_zero. unfold const_low.
-  change (rs2 GPR1) with (rs GPR1). rewrite <- (sp_val _ _ _ AG). 
-  simpl. unfold load_stack in H2. simpl in H2. rewrite H2.
-  reflexivity. discriminate. reflexivity.
-  apply exec_straight_step with rs4 m.
-  simpl. reflexivity. reflexivity.
-  apply exec_straight_one. 
-  simpl. change (rs4 GPR1) with (rs GPR1). rewrite <- (sp_val _ _ _ AG).
-  unfold load_stack in H1; simpl in H1. 
-  simpl. rewrite H1. reflexivity. reflexivity.
-  left; exists (State rs6 (free m stk)); split.
-  (* execution *)
-  eapply plus_right'. eapply exec_straight_exec; eauto.
-  econstructor.
-  change (rs5 PC) with (Val.add (Val.add (Val.add (Val.add (rs PC) Vone) Vone) Vone) Vone).
-  rewrite <- H7; simpl. eauto.
-  eapply functions_transl; eauto. 
-  eapply find_instr_tail.
-  repeat (eapply code_tail_next_int; auto). eauto. 
-  simpl. reflexivity. traceEq.
-  (* match states *)
-  econstructor; eauto.
-  assert (AG4: agree ms (Vptr stk soff) rs4).
-    unfold rs4, rs3, rs2; auto 10 with ppcgen.
-  assert (AG5: agree ms (parent_sp s) rs5).
-    unfold rs5. apply agree_nextinstr.
-    split. reflexivity. intros. inv AG4. rewrite H12. 
-    rewrite Pregmap.gso; auto with ppcgen.
-  unfold rs6; auto with ppcgen.
-  change (rs6 PC) with (ms m0). 
-  generalize H. destruct (ms m0); try congruence.
-  predSpec Int.eq Int.eq_spec i Int.zero; intros; congruence.
-  (* direct call *)
-  set (rs2 := nextinstr (rs#GPR12 <- (parent_ra s))).
-  set (rs3 := nextinstr (rs2#LR <- (parent_ra s))).
-  set (rs4 := nextinstr (rs3#GPR1 <- (parent_sp s))).
-  set (rs5 := rs4#PC <- (Vptr f' Int.zero)).
-  assert (exec_straight tge (transl_function f)
-            (transl_code f (Mtailcall sig (inr mreg i) :: c)) rs m 
-            (Pbs i :: transl_code f c) rs4 (free m stk)).
-  simpl. apply exec_straight_step with rs2 m. 
-  simpl. unfold load1. rewrite gpr_or_zero_not_zero. unfold const_low.
-  rewrite <- (sp_val _ _ _ AG). 
-  simpl. unfold load_stack in H2. simpl in H2. rewrite H2.
-  reflexivity. discriminate. reflexivity.
-  apply exec_straight_step with rs3 m.
-  simpl. reflexivity. reflexivity.
-  apply exec_straight_one. 
-  simpl. change (rs3 GPR1) with (rs GPR1). rewrite <- (sp_val _ _ _ AG).
-  unfold load_stack in H1; simpl in H1.
-  simpl. rewrite H1. reflexivity. reflexivity.
-  left; exists (State rs5 (free m stk)); split.
-  (* execution *)
-  eapply plus_right'. eapply exec_straight_exec; eauto.
-  econstructor.
-  change (rs4 PC) with (Val.add (Val.add (Val.add (rs PC) Vone) Vone) Vone).
-  rewrite <- H7; simpl. eauto.
-  eapply functions_transl; eauto. 
-  eapply find_instr_tail.
-  repeat (eapply code_tail_next_int; auto). eauto. 
-  simpl. unfold symbol_offset. rewrite symbols_preserved. rewrite H. 
-  reflexivity. traceEq.
-  (* match states *)
-  econstructor; eauto.
-  assert (AG3: agree ms (Vptr stk soff) rs3).
-    unfold rs3, rs2; auto 10 with ppcgen.
-  assert (AG4: agree ms (parent_sp s) rs4).
-    unfold rs4. apply agree_nextinstr.
-    split. reflexivity. intros. inv AG3. rewrite H12. 
-    rewrite Pregmap.gso; auto with ppcgen.
-  unfold rs5; auto with ppcgen.
-Qed.
-
-Lemma exec_Malloc_prop:
-  forall (s : list stackframe) (fb : block) (sp : val)
-         (c : list Mach.instruction) (ms : mreg -> val) (m : mem) (sz : int)
-         (m' : mem) (blk : block),
-  ms Conventions.loc_alloc_argument = Vint sz ->
-  alloc m 0 (Int.signed sz) = (m', blk) ->
-  exec_instr_prop (Machconcr.State s fb sp (Malloc :: c) ms m) E0
-         (Machconcr.State s fb sp c
-             (Regmap.set (Conventions.loc_alloc_result) (Vptr blk Int.zero) ms) m').
-Proof.
-  intros; red; intros; inv MS.
-  left; eapply exec_straight_steps; eauto with coqlib.
-  simpl. eapply transl_alloc_correct; eauto. 
-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. simpl in H3.
-  generalize (find_label_goto_label f lbl rs m _ _ _ FIND (sym_equal H1) H0).
-  intros [rs2 [GOTO [AT2 INV]]].
-  left; exists (State rs2 m); split.
-  apply plus_one. econstructor; eauto.
-  apply functions_transl; eauto.
-  eapply find_instr_tail; eauto.
-  simpl; auto.
-  econstructor; eauto.
-  eapply Mach.find_label_incl; eauto.
-  apply agree_exten_2 with rs; auto. 
-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 m = 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' ms m).
-Proof.
-  intros; red; intros; inv MS. assert (f0 = f) by congruence. subst f0.
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI. inv WTI.
-  pose (k1 := 
-         if snd (crbit_for_cond cond)
-         then Pbt (fst (crbit_for_cond cond)) lbl :: transl_code f c
-         else Pbf (fst (crbit_for_cond cond)) lbl :: transl_code f c).
-  generalize (transl_cond_correct tge (transl_function f)
-                cond args k1 ms sp rs m true H3 AG H).
-  simpl. intros [rs2 [EX [RES AG2]]].
-  inv AT. simpl in H5.
-  generalize (functions_transl _ _ H4); intro FN.
-  generalize (functions_transl_no_overflow _ _ H4); intro NOOV.
-  exploit exec_straight_steps_2; eauto. 
-  intros [ofs' [PC2 CT2]].
-  generalize (find_label_goto_label f lbl rs2 m _ _ _ FIND PC2 H1).
-  intros [rs3 [GOTO [AT3 INV3]]].
-  left; exists (State rs3 m); split.
-  eapply plus_right'. 
-  eapply exec_straight_steps_1; eauto.
-  caseEq (snd (crbit_for_cond cond)); intro ISSET; rewrite ISSET in RES.
-  econstructor; eauto.
-  eapply find_instr_tail. unfold k1 in CT2; rewrite ISSET in CT2. eauto.
-  simpl. rewrite RES. simpl. auto.
-  econstructor; eauto.
-  eapply find_instr_tail. unfold k1 in CT2; rewrite ISSET in CT2. eauto.
-  simpl. rewrite RES. simpl. auto.
-  traceEq.
-  econstructor; eauto. 
-  eapply Mach.find_label_incl; eauto.
-  apply agree_exten_2 with rs2; auto. 
-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 m = Some false ->
-  exec_instr_prop (Machconcr.State s fb sp (Mcond cond args lbl :: c) ms m) E0
-                  (Machconcr.State s fb sp c ms m).
-Proof.
-  intros; red; intros; inv MS.
-  generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
-  intro WTI. inversion WTI.
-  pose (k1 := 
-         if snd (crbit_for_cond cond)
-         then Pbt (fst (crbit_for_cond cond)) lbl :: transl_code f c
-         else Pbf (fst (crbit_for_cond cond)) lbl :: transl_code f c).
-  generalize (transl_cond_correct tge (transl_function f)
-                cond args k1 ms sp rs m false H1 AG H).
-  simpl. intros [rs2 [EX [RES AG2]]].
-  left; eapply exec_straight_steps; eauto with coqlib.
-  exists (nextinstr rs2); split.
-  simpl. eapply exec_straight_trans. eexact EX. 
-  caseEq (snd (crbit_for_cond cond)); intro ISSET; rewrite ISSET in RES.
-  unfold k1; rewrite ISSET; apply exec_straight_one. 
-  simpl. rewrite RES. reflexivity.
-  reflexivity.
-  unfold k1; rewrite ISSET; apply exec_straight_one. 
-  simpl. rewrite RES. reflexivity.
-  reflexivity.
-  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),
-  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) ->
-  exec_instr_prop (Machconcr.State s fb (Vptr stk soff) (Mreturn :: c) ms m) E0
-                  (Returnstate s ms (free m stk)).
-Proof.
-  intros; red; intros; inv MS.
-  assert (f0 = f) by congruence. subst f0.
-  set (rs2 := nextinstr (rs#GPR12 <- (parent_ra s))).
-  set (rs3 := nextinstr (rs2#LR <- (parent_ra s))).
-  set (rs4 := nextinstr (rs3#GPR1 <- (parent_sp s))).
-  set (rs5 := rs4#PC <- (parent_ra s)).
-  assert (exec_straight tge (transl_function f)
-            (transl_code f (Mreturn :: c)) rs m 
-            (Pblr :: transl_code f c) rs4 (free m stk)).
-  simpl. apply exec_straight_three with rs2 m rs3 m.
-  simpl. unfold load1. rewrite gpr_or_zero_not_zero. unfold const_low.
-  unfold load_stack in H1. simpl in H1. 
-  rewrite <- (sp_val _ _ _ AG). simpl. rewrite H1.
-  reflexivity. discriminate.
-  unfold rs3. change (parent_ra s) with rs2#GPR12. reflexivity.
-  simpl. change (rs3 GPR1) with (rs GPR1). rewrite <- (sp_val _ _ _ AG).
-  simpl. 
-  unfold load_stack in H0. simpl in H0.
-  rewrite H0. reflexivity.
-  reflexivity. reflexivity. reflexivity.
-  left; exists (State rs5 (free m stk)); split.
-  (* execution *)
-  apply plus_right' with E0 (State rs4 (free m stk)) E0.
-  eapply exec_straight_exec; eauto.
-  inv AT. econstructor.
-  change (rs4 PC) with (Val.add (Val.add (Val.add (rs PC) Vone) Vone) Vone). 
-  rewrite <- H3. simpl. eauto.
-  apply functions_transl; eauto.
-  generalize (functions_transl_no_overflow _ _ H4); intro NOOV.
-  simpl in H5. eapply find_instr_tail. 
-  eapply code_tail_next_int; auto.
-  eapply code_tail_next_int; auto.
-  eapply code_tail_next_int; eauto.
-  reflexivity. traceEq.
-  (* match states *)
-  econstructor; eauto. 
-  assert (AG3: agree ms (Vptr stk soff) rs3). 
-    unfold rs3, rs2; auto 10 with ppcgen.
-  assert (AG4: agree ms (parent_sp s) rs4).
-    split. reflexivity. intros. unfold rs4. 
-    rewrite nextinstr_inv. rewrite Pregmap.gso.
-    elim AG3; auto. auto with ppcgen. auto with ppcgen.
-  unfold rs5; auto with ppcgen.
-Qed.
-
-Hypothesis wt_prog: wt_program prog.
-
-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) ->
-  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.
-  assert (WTF: wt_function f).
-    generalize (Genv.find_funct_ptr_prop wt_fundef wt_prog H); intro TY.
-    inversion TY; auto.
-  exploit functions_transl; eauto. intro TFIND.
-  generalize (functions_transl_no_overflow _ _ H); intro NOOV.
-  set (rs2 := nextinstr (rs#GPR1 <- sp #GPR12 <- Vundef)).
-  set (rs3 := nextinstr (rs2#GPR12 <- (parent_ra s))).
-  set (rs4 := nextinstr rs3).
-  (* Execution of function prologue *)
-  assert (EXEC_PROLOGUE:
-            exec_straight tge (transl_function f)
-              (transl_function f) rs m
-              (transl_code f (fn_code f)) rs4 m3).
-  unfold transl_function at 2. 
-  apply exec_straight_three with rs2 m2 rs3 m2.
-  unfold exec_instr. rewrite H0. fold sp.
-  unfold store_stack in H1. simpl chunk_of_type in H1. 
-  rewrite <- (sp_val _ _ _ AG). rewrite H1. reflexivity.
-  simpl. change (rs2 LR) with (rs LR). rewrite ATLR. reflexivity.
-  simpl. unfold store1. rewrite gpr_or_zero_not_zero. 
-  unfold const_low. change (rs3 GPR1) with sp. change (rs3 GPR12) with (parent_ra s).
-  unfold store_stack in H2. simpl chunk_of_type in H2. rewrite H2. reflexivity.
-  discriminate. reflexivity. reflexivity. reflexivity.
-  (* Agreement at end of prologue *)
-  assert (AT4: transl_code_at_pc rs4#PC fb f f.(fn_code)).
-    change (rs4 PC) with (Val.add (Val.add (Val.add (rs PC) Vone) Vone) Vone).
-    rewrite ATPC. simpl. constructor. auto.
-    eapply code_tail_next_int; auto.
-    eapply code_tail_next_int; auto.
-    eapply code_tail_next_int; auto.
-    change (Int.unsigned Int.zero) with 0. 
-    unfold transl_function. constructor.
-  assert (AG2: agree ms sp rs2).
-    split. reflexivity. 
-    intros. unfold rs2. rewrite nextinstr_inv. 
-    repeat (rewrite Pregmap.gso). elim AG; auto.
-    auto with ppcgen. auto with ppcgen. auto with ppcgen.
-  assert (AG4: agree ms sp rs4).
-    unfold rs4, rs3; auto with ppcgen.
-  left; exists (State rs4 m3); split.
-  (* execution *)
-  eapply exec_straight_steps_1; eauto.
-  change (Int.unsigned Int.zero) with 0. constructor.
-  (* match states *)
-  econstructor; eauto with coqlib.
-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),
-  Genv.find_funct_ptr ge fb = Some (External ef) ->
-  event_match ef args t0 res ->
-  Machconcr.extcall_arguments ms m (parent_sp s) (ef_sig ef) args ->
-  ms' = Regmap.set (Conventions.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. 
-  left; exists (State (rs#(loc_external_result (ef_sig ef)) <- res #PC <- (rs LR))
-                m); split.
-  apply plus_one. eapply exec_step_external; eauto. 
-  eapply extcall_arguments_match; eauto. 
-  econstructor; eauto. 
-  rewrite loc_external_result_match. 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; auto.  
-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_Malloc_prop
-           exec_Mgoto_prop
-           exec_Mcond_true_prop
-           exec_Mcond_false_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, PPC.initial_state tprog st2 /\ match_states st1 st2.
-Proof.
-  intros. inversion H. unfold ge0 in *.
-  econstructor; split.
-  econstructor.
-  replace (symbol_offset (Genv.globalenv tprog) (prog_main tprog) Int.zero)
-     with (Vptr fb Int.zero).
-  rewrite (Genv.init_mem_transf_partial _ _ TRANSF).
-  econstructor; eauto. constructor.
-  split. auto. intros. repeat rewrite Pregmap.gso; auto with ppcgen.
-  unfold symbol_offset. 
-  rewrite (transform_partial_program_main _ _ TRANSF). 
-  rewrite symbols_preserved. unfold ge; rewrite H0. auto.
-Qed.
-
-Lemma transf_final_states:
-  forall st1 st2 r, 
-  match_states st1 st2 -> Machconcr.final_state st1 r -> PPC.final_state st2 r.
-Proof.
-  intros. inv H0. inv H. constructor. auto. 
-  rewrite (ireg_val _ _ _ R3 AG) in H1. auto. auto.
-Qed.
-
-Theorem transf_program_correct:
-  forall (beh: program_behavior),
-  Machconcr.exec_program prog beh -> PPC.exec_program tprog beh.
-Proof.
-  unfold Machconcr.exec_program, PPC.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/backend/PPCgenproof1.v b/backend/PPCgenproof1.v
deleted file mode 100644
index dd142c5b..00000000
--- a/backend/PPCgenproof1.v
+++ /dev/null
@@ -1,1686 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** Correctness proof for PPC generation: auxiliary results. *)
-
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Mem.
-Require Import Globalenvs.
-Require Import Op.
-Require Import Locations.
-Require Import Mach.
-Require Import Machconcr.
-Require Import Machtyping.
-Require Import PPC.
-Require Import PPCgen.
-Require Conventions.
-
-(** * Properties of low half/high half decomposition *)
-
-Lemma high_half_zero:
-  forall v, Val.add (high_half v) Vzero = high_half v.
-Proof.
-  intros. generalize (high_half_type v).
-  rewrite Val.add_commut. 
-  case (high_half v); simpl; intros; try contradiction.
-  auto. 
-  rewrite Int.add_commut; rewrite Int.add_zero; auto. 
-  rewrite Int.add_zero; auto. 
-Qed.
-
-Lemma low_high_u:
-  forall n, Int.or (Int.shl (high_u n) (Int.repr 16)) (low_u n) = n.
-Proof.
-  intros. unfold high_u, low_u.
-  rewrite Int.shl_rolm. rewrite Int.shru_rolm. 
-  rewrite Int.rolm_rolm. 
-  change (Int.modu (Int.add (Int.sub (Int.repr (Z_of_nat wordsize)) (Int.repr 16))
-                            (Int.repr 16))
-                   (Int.repr (Z_of_nat wordsize)))
-    with (Int.zero).
-  rewrite Int.rolm_zero. rewrite <- Int.and_or_distrib.
-  exact (Int.and_mone n).
-  reflexivity. reflexivity.
-Qed.
-
-Lemma low_high_u_xor:
-  forall n, Int.xor (Int.shl (high_u n) (Int.repr 16)) (low_u n) = n.
-Proof.
-  intros. unfold high_u, low_u.
-  rewrite Int.shl_rolm. rewrite Int.shru_rolm. 
-  rewrite Int.rolm_rolm. 
-  change (Int.modu (Int.add (Int.sub (Int.repr (Z_of_nat wordsize)) (Int.repr 16))
-                            (Int.repr 16))
-                   (Int.repr (Z_of_nat wordsize)))
-    with (Int.zero).
-  rewrite Int.rolm_zero. rewrite <- Int.and_xor_distrib.
-  exact (Int.and_mone n).
-  reflexivity. reflexivity.
-Qed.
-
-Lemma low_high_s:
-  forall n, Int.add (Int.shl (high_s n) (Int.repr 16)) (low_s n) = n.
-Proof.
-  intros. rewrite Int.shl_mul_two_p. 
-  unfold high_s. 
-  rewrite <- (Int.divu_pow2 (Int.sub n (low_s n)) (Int.repr 65536) (Int.repr 16)).
-  change (two_p (Int.unsigned (Int.repr 16))) with 65536.
-
-  assert (forall x y, y > 0 -> (x - x mod y) mod y = 0).
-  intros. apply Zmod_unique with (x / y). 
-  generalize (Z_div_mod_eq x y H). intro. rewrite Zmult_comm. omega.
-  omega.
-
-  assert (Int.modu (Int.sub n (low_s n)) (Int.repr 65536) = Int.zero).
-  unfold Int.modu, Int.zero. decEq. 
-  change (Int.unsigned (Int.repr 65536)) with 65536.
-  unfold Int.sub. 
-  assert (forall a b, Int.eqm a b -> b mod 65536 = 0 -> a mod 65536 = 0).
-  intros a b [k EQ] H1. rewrite EQ. 
-  change modulus with (65536 * 65536). 
-  rewrite Zmult_assoc. rewrite Zplus_comm. rewrite Z_mod_plus. auto.
-  omega.
-  eapply H0. apply Int.eqm_sym. apply Int.eqm_unsigned_repr. 
-  unfold low_s. unfold Int.sign_ext. 
-  change (two_p 16) with 65536. change (two_p (16-1)) with 32768. 
-  set (N := Int.unsigned n).
-  case (zlt (N mod 65536) 32768); intro.
-  apply H0 with (N - N mod 65536). auto with ints.
-  apply H. omega.
-  apply H0 with (N - (N mod 65536 - 65536)). auto with ints.
-  replace (N - (N mod 65536 - 65536))
-     with ((N - N mod 65536) + 1 * 65536).
-  rewrite Z_mod_plus. apply H. omega. omega. ring. 
-
-  assert (Int.repr 65536 <> Int.zero). compute. congruence. 
-  generalize (Int.modu_divu_Euclid (Int.sub n (low_s n)) (Int.repr 65536) H1).
-  rewrite H0. rewrite Int.add_zero. intro. rewrite <- H2. 
-  rewrite Int.sub_add_opp. rewrite Int.add_assoc. 
-  replace (Int.add (Int.neg (low_s n)) (low_s n)) with Int.zero.
-  apply Int.add_zero. symmetry. rewrite Int.add_commut. 
-  rewrite <- Int.sub_add_opp. apply Int.sub_idem.
-
-  reflexivity.
-Qed.
-
-(** * Correspondence between Mach registers and PPC registers *)
-
-Hint Extern 2 (_ <> _) => discriminate: ppcgen.
-
-(** Mapping from Mach registers to PPC registers. *)
-
-Definition preg_of (r: mreg) :=
-  match mreg_type r with
-  | Tint => IR (ireg_of r)
-  | Tfloat => FR (freg_of r)
-  end.
-
-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.
-
-(** Characterization of PPC registers that correspond to Mach registers. *)
-
-Definition is_data_reg (r: preg) : Prop :=
-  match r with
-  | IR GPR12 => False
-  | FR FPR13 => False
-  | PC => False    | LR => False    | CTR => False
-  | CR0_0 => False | CR0_1 => False | CR0_2 => False | CR0_3 => False
-  | CARRY => False
-  | _ => True
-  end.
-
-Lemma ireg_of_is_data_reg:
-  forall (r: mreg), is_data_reg (ireg_of r).
-Proof.
-  destruct r; exact I.
-Qed.
-
-Lemma freg_of_is_data_reg:
-  forall (r: mreg), is_data_reg (ireg_of r).
-Proof.
-  destruct r; exact I.
-Qed.
-
-Lemma preg_of_is_data_reg:
-  forall (r: mreg), is_data_reg (preg_of r).
-Proof.
-  destruct r; exact I.
-Qed.
-
-Lemma ireg_of_not_GPR1:
-  forall r, ireg_of r <> GPR1.
-Proof.
-  intro. case r; discriminate.
-Qed.
-Lemma ireg_of_not_GPR12:
-  forall r, ireg_of r <> GPR12.
-Proof.
-  intro. case r; discriminate.
-Qed.
-Lemma freg_of_not_FPR13:
-  forall r, freg_of r <> FPR13.
-Proof.
-  intro. case r; discriminate.
-Qed.
-Hint Resolve ireg_of_not_GPR1 ireg_of_not_GPR12 freg_of_not_FPR13: ppcgen.
-
-Lemma preg_of_not:
-  forall r1 r2, ~(is_data_reg r2) -> preg_of r1 <> r2.
-Proof.
-  intros; red; intro. subst r2. elim H. apply preg_of_is_data_reg.
-Qed.
-Hint Resolve preg_of_not: ppcgen.
-
-Lemma preg_of_not_GPR1:
-  forall r, preg_of r <> GPR1.
-Proof.
-  intro. case r; discriminate.
-Qed.
-Hint Resolve preg_of_not_GPR1: ppcgen.
-
-(** Agreement between Mach register sets and PPC register sets. *)
-
-Definition agree (ms: Mach.regset) (sp: val) (rs: PPC.regset) :=
-  rs#GPR1 = sp /\ forall r: mreg, ms r = rs#(preg_of r).
-
-Lemma preg_val:
-  forall ms sp rs r,
-  agree ms sp rs -> ms r = rs#(preg_of r).
-Proof.
-  intros. elim H. auto.
-Qed.
-  
-Lemma ireg_val:
-  forall ms sp rs r,
-  agree ms sp rs ->
-  mreg_type r = Tint ->
-  ms r = rs#(ireg_of r).
-Proof.
-  intros. elim H; intros.
-  generalize (H2 r). unfold preg_of. rewrite H0. auto.
-Qed.
-
-Lemma freg_val:
-  forall ms sp rs r,
-  agree ms sp rs ->
-  mreg_type r = Tfloat ->
-  ms r = rs#(freg_of r).
-Proof.
-  intros. elim H; intros.
-  generalize (H2 r). unfold preg_of. rewrite H0. auto.
-Qed.
-
-Lemma sp_val:
-  forall ms sp rs,
-  agree ms sp rs ->
-  sp = rs#GPR1.
-Proof.
-  intros. elim H; auto.
-Qed.
-
-Lemma agree_exten_1:
-  forall ms sp rs rs',
-  agree ms sp rs ->
-  (forall r, is_data_reg r -> rs'#r = rs#r) ->
-  agree ms sp rs'.
-Proof.
-  unfold agree; intros. elim H; intros.
-  split. rewrite H0. auto. exact I. 
-  intros. rewrite H0. auto. apply preg_of_is_data_reg.
-Qed.
-
-Lemma agree_exten_2:
-  forall ms sp rs rs',
-  agree ms sp rs ->
-  (forall r,
-     r <> IR GPR12 -> r <> FR FPR13 ->
-     r <> PC -> r <> LR -> r <> CTR ->
-     r <> CR0_0 -> r <> CR0_1 -> r <> CR0_2 -> r <> CR0_3 ->
-     r <> CARRY ->
-     rs'#r = rs#r) ->
-  agree ms sp rs'.
-Proof.
-  intros. apply agree_exten_1 with rs. auto.
-  intros. apply H0; (red; intro; subst r; elim H1).
-Qed.
-
-(** Preservation of register agreement under various assignments. *)
-
-Lemma agree_set_mreg:
-  forall ms sp rs r v,
-  agree ms sp rs ->
-  agree (Regmap.set r v ms) sp (rs#(preg_of r) <- v).
-Proof.
-  unfold agree; intros. elim H; intros; clear H.
-  split. rewrite Pregmap.gso. auto. apply sym_not_eq. apply preg_of_not_GPR1.
-  intros. unfold Regmap.set. case (RegEq.eq r0 r); intro.
-  subst r0. rewrite Pregmap.gss. auto.
-  rewrite Pregmap.gso. auto. red; intro. 
-  elim n. apply preg_of_injective; auto.
-Qed.
-Hint Resolve agree_set_mreg: ppcgen.
-
-Lemma agree_set_mireg:
-  forall ms sp rs r v,
-  agree ms sp (rs#(preg_of r) <- v) ->
-  mreg_type r = Tint ->
-  agree ms sp (rs#(ireg_of r) <- v).
-Proof.
-  intros. unfold preg_of in H. rewrite H0 in H. auto.
-Qed.
-Hint Resolve agree_set_mireg: ppcgen.
-
-Lemma agree_set_mfreg:
-  forall ms sp rs r v,
-  agree ms sp (rs#(preg_of r) <- v) ->
-  mreg_type r = Tfloat ->
-  agree ms sp (rs#(freg_of r) <- v).
-Proof.
-  intros. unfold preg_of in H. rewrite H0 in H. auto.
-Qed.
-Hint Resolve agree_set_mfreg: ppcgen.
-
-Lemma agree_set_other:
-  forall ms sp rs r v,
-  agree ms sp rs ->
-  ~(is_data_reg r) ->
-  agree ms sp (rs#r <- v).
-Proof.
-  intros. apply agree_exten_1 with rs.
-  auto. intros. apply Pregmap.gso. red; intro; subst r0; contradiction.
-Qed.
-Hint Resolve agree_set_other: ppcgen.
-
-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.
-Hint Resolve agree_nextinstr: ppcgen.
-
-Lemma agree_set_mireg_twice:
-  forall ms sp rs r v v',
-  agree ms sp rs ->
-  mreg_type r = Tint ->
-  agree (Regmap.set r v ms) sp (rs #(ireg_of r) <- v' #(ireg_of r) <- v).
-Proof.
-  intros. replace (IR (ireg_of r)) with (preg_of r). elim H; intros.
-  split. repeat (rewrite Pregmap.gso; auto with ppcgen).
-  intros. case (mreg_eq r r0); intro.
-  subst r0. rewrite Regmap.gss. rewrite Pregmap.gss. auto.
-  assert (preg_of r <> preg_of r0). 
-    red; intro. elim n. apply preg_of_injective. auto.
-  rewrite Regmap.gso; auto.
-  repeat (rewrite Pregmap.gso; auto).
-  unfold preg_of. rewrite H0. auto.
-Qed.
-Hint Resolve agree_set_mireg_twice: ppcgen.
-
-Lemma agree_set_twice_mireg:
-  forall ms sp rs r v v',
-  agree (Regmap.set r v' ms) sp rs ->
-  mreg_type r = Tint ->
-  agree (Regmap.set r v ms) sp (rs#(ireg_of r) <- v).
-Proof.
-  intros. elim H; intros.
-  split. rewrite Pregmap.gso. auto. 
-  generalize (ireg_of_not_GPR1 r); congruence.
-  intros. generalize (H2 r0). 
-  case (mreg_eq r0 r); intro.
-  subst r0. repeat rewrite Regmap.gss. unfold preg_of; rewrite H0.
-  rewrite Pregmap.gss. auto.
-  repeat rewrite Regmap.gso; auto.
-  rewrite Pregmap.gso. auto. 
-  replace (IR (ireg_of r)) with (preg_of r).
-  red; intros. elim n. apply preg_of_injective; auto.
-  unfold preg_of. rewrite H0. auto.
-Qed.
-Hint Resolve agree_set_twice_mireg: ppcgen.
-
-Lemma agree_set_commut:
-  forall ms sp rs r1 r2 v1 v2,
-  r1 <> r2 ->
-  agree ms sp ((rs#r2 <- v2)#r1 <- v1) ->
-  agree ms sp ((rs#r1 <- v1)#r2 <- v2).
-Proof.
-  intros. apply agree_exten_1 with ((rs#r2 <- v2)#r1 <- v1). auto.
-  intros. 
-  case (preg_eq r r1); intro.
-  subst r1. rewrite Pregmap.gss. rewrite Pregmap.gso. rewrite Pregmap.gss.
-  auto. auto.
-  case (preg_eq r r2); intro.
-  subst r2. rewrite Pregmap.gss. rewrite Pregmap.gso. rewrite Pregmap.gss.
-  auto. auto.
-  repeat (rewrite Pregmap.gso; auto). 
-Qed. 
-Hint Resolve agree_set_commut: ppcgen.
-
-Lemma agree_nextinstr_commut:
-  forall ms sp rs r v,
-  agree ms sp (rs#r <- v) ->
-  r <> PC ->
-  agree ms sp ((nextinstr rs)#r <- v).
-Proof.
-  intros. unfold nextinstr. apply agree_set_commut. auto. 
-  apply agree_set_other. auto. auto. 
-Qed.
-Hint Resolve agree_nextinstr_commut: ppcgen.
-
-Lemma agree_set_mireg_exten:
-  forall ms sp rs r v (rs': regset),
-  agree ms sp rs ->
-  mreg_type r = Tint ->
-  rs'#(ireg_of r) = v ->
-  (forall r', 
-     r' <> IR GPR12 -> r' <> FR FPR13 ->
-     r' <> PC -> r' <> LR -> r' <> CTR ->
-     r' <> CR0_0 -> r' <> CR0_1 -> r' <> CR0_2 -> r' <> CR0_3 ->
-     r' <> CARRY ->
-     r' <> IR (ireg_of r) -> rs'#r' = rs#r') ->
-  agree (Regmap.set r v ms) sp rs'.
-Proof.
-  intros. apply agree_exten_2 with (rs#(ireg_of r) <- v).
-  auto with ppcgen.
-  intros. unfold Pregmap.set. case (PregEq.eq r0 (ireg_of r)); intro.
-  subst r0. auto. apply H2; auto.
-Qed.
-
-(** Useful properties of the PC and GPR0 registers. *)
-
-Lemma nextinstr_inv:
-  forall r rs, r <> PC -> (nextinstr rs)#r = rs#r.
-Proof.
-  intros. unfold nextinstr. apply Pregmap.gso. auto.
-Qed.
-Hint Resolve nextinstr_inv: ppcgen.
-
-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. auto with ppcgen.
-Qed.
-Hint Resolve nextinstr_set_preg: ppcgen.
-
-Lemma gpr_or_zero_not_zero:
-  forall rs r, r <> GPR0 -> gpr_or_zero rs r = rs#r.
-Proof.
-  intros. unfold gpr_or_zero. case (ireg_eq r GPR0); tauto.
-Qed.
-Lemma gpr_or_zero_zero:
-  forall rs, gpr_or_zero rs GPR0 = Vzero.
-Proof.
-  intros. reflexivity.
-Qed.
-Hint Resolve gpr_or_zero_not_zero gpr_or_zero_zero: ppcgen.
-
-(** Connection between Mach and PPC calling conventions for external
-    functions. *)
-
-Lemma loc_external_result_match:
-  forall sg,
-  PPC.loc_external_result sg = preg_of (Conventions.loc_result sg).
-Proof.
-  intros. destruct sg as [sargs sres]. 
-  destruct sres. destruct t; reflexivity. reflexivity.
-Qed.
-
-Lemma extcall_args_match:
-  forall ms m sp rs,
-  agree ms sp rs ->
-  forall tyl iregl fregl ofs args,
-  (forall r, In r iregl -> mreg_type r = Tint) ->
-  (forall r, In r fregl -> mreg_type r = Tfloat) ->
-  Machconcr.extcall_args ms m sp (Conventions.loc_arguments_rec tyl iregl fregl ofs) args ->
-  PPC.extcall_args rs m tyl (List.map ireg_of iregl) (List.map freg_of fregl) (Stacking.fe_ofs_arg + 4 * ofs) args.
-Proof.
-  induction tyl; intros.
-  inversion H2; constructor.
-  destruct a. 
-  (* integer case *)
-  destruct iregl as [ | ir1 irl]. 
-  (* stack *)
-  inversion H2; subst; clear H2. inversion H8; subst; clear H8.
-  constructor. replace (rs GPR1) with sp. assumption. 
-  eapply sp_val; eauto. 
-  change (@nil ireg) with (ireg_of ## nil). 
-  replace (Stacking.fe_ofs_arg + 4 * ofs + 4) with (Stacking.fe_ofs_arg + 4 * (ofs + 1)) by omega. 
-  apply IHtyl; auto. 
-  (* register *)
-  inversion H2; subst; clear H2. inversion H8; subst; clear H8.
-  simpl map. econstructor. eapply ireg_val; eauto.
-  apply H0; simpl; auto. 
-  replace (4 * ofs + 4) with (4 * (ofs + 1)) by omega. 
-  apply IHtyl; auto. 
-  intros; apply H0; simpl; auto.
-  (* float case *)
-  destruct fregl as [ | fr1 frl]. 
-  (* stack *)
-  inversion H2; subst; clear H2. inversion H8; subst; clear H8.
-  constructor. replace (rs GPR1) with sp. assumption. 
-  eapply sp_val; eauto. 
-  change (@nil freg) with (freg_of ## nil). 
-  replace (Stacking.fe_ofs_arg + 4 * ofs + 8) with (Stacking.fe_ofs_arg + 4 * (ofs + 2)) by omega. 
-  apply IHtyl; auto. 
-  (* register *)
-  inversion H2; subst; clear H2. inversion H8; subst; clear H8.
-  simpl map. econstructor. eapply freg_val; eauto.
-  apply H1; simpl; auto. 
-  rewrite list_map_drop2.
-  apply IHtyl; auto. 
-  intros; apply H0. apply list_drop2_incl. auto.
-  intros; apply H1; simpl; auto.
-Qed.
-
-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.
-
-Lemma extcall_arguments_match:
-  forall ms m sp rs sg args,
-  agree ms sp rs ->
-  Machconcr.extcall_arguments ms m sp sg args ->
-  PPC.extcall_arguments rs m sg args.
-Proof.
-  unfold Machconcr.extcall_arguments, PPC.extcall_arguments; intros.
-  change (extcall_args rs m sg.(sig_args)
-    (List.map ireg_of Conventions.int_param_regs)
-    (List.map freg_of Conventions.float_param_regs)
-    (Stacking.fe_ofs_arg + 4 * 8) args).
-  eapply extcall_args_match; eauto. 
-  intro; simpl; ElimOrEq; reflexivity.  
-  intro; simpl; ElimOrEq; reflexivity.  
-Qed.
-
-(** * Execution of straight-line code *)
-
-Section STRAIGHTLINE.
-
-Variable ge: genv.
-Variable fn: code.
-
-(** Straight-line code is composed of PPC 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 = OK 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 = OK 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 = OK rs2 m2 ->
-  exec_instr ge fn i2 rs2 m2 = OK 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 = OK rs2 m2 ->
-  exec_instr ge fn i2 rs2 m2 = OK rs3 m3 ->
-  exec_instr ge fn i3 rs3 m3 = OK 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 PowerPC constructor functions *)
-
-(** Properties of comparisons. *)
-
-Lemma compare_float_spec:
-  forall rs v1 v2,
-  let rs1 := nextinstr (compare_float rs v1 v2) in
-     rs1#CR0_0 = Val.cmpf Clt v1 v2
-  /\ rs1#CR0_1 = Val.cmpf Cgt v1 v2
-  /\ rs1#CR0_2 = Val.cmpf Ceq v1 v2
-  /\ forall r', r' <> PC -> r' <> CR0_0 -> r' <> CR0_1 ->
-       r' <> CR0_2 -> r' <> CR0_3 -> rs1#r' = rs#r'.
-Proof.
-  intros. unfold rs1.
-  split. reflexivity.
-  split. reflexivity.
-  split. reflexivity.
-  intros. rewrite nextinstr_inv; auto.
-  unfold compare_float. repeat (rewrite Pregmap.gso; auto).
-Qed.
-
-Lemma compare_sint_spec:
-  forall rs v1 v2,
-  let rs1 := nextinstr (compare_sint rs v1 v2) in
-     rs1#CR0_0 = Val.cmp Clt v1 v2
-  /\ rs1#CR0_1 = Val.cmp Cgt v1 v2
-  /\ rs1#CR0_2 = Val.cmp Ceq v1 v2
-  /\ forall r', r' <> PC -> r' <> CR0_0 -> r' <> CR0_1 ->
-       r' <> CR0_2 -> r' <> CR0_3 -> rs1#r' = rs#r'.
-Proof.
-  intros. unfold rs1.
-  split. reflexivity.
-  split. reflexivity.
-  split. reflexivity.
-  intros. rewrite nextinstr_inv; auto.
-  unfold compare_sint. repeat (rewrite Pregmap.gso; auto).
-Qed.
-
-Lemma compare_uint_spec:
-  forall rs v1 v2,
-  let rs1 := nextinstr (compare_uint rs v1 v2) in
-     rs1#CR0_0 = Val.cmpu Clt v1 v2
-  /\ rs1#CR0_1 = Val.cmpu Cgt v1 v2
-  /\ rs1#CR0_2 = Val.cmpu Ceq v1 v2
-  /\ forall r', r' <> PC -> r' <> CR0_0 -> r' <> CR0_1 ->
-       r' <> CR0_2 -> r' <> CR0_3 -> rs1#r' = rs#r'.
-Proof.
-  intros. unfold rs1.
-  split. reflexivity.
-  split. reflexivity.
-  split. reflexivity.
-  intros. rewrite nextinstr_inv; auto.
-  unfold compare_uint. repeat (rewrite Pregmap.gso; auto).
-Qed.
-
-(** Loading a constant. *)
-
-Lemma loadimm_correct:
-  forall r n k rs m,
-  exists rs',
-     exec_straight (loadimm r n k) rs m  k rs' m
-  /\ rs'#r = Vint n
-  /\ forall r': preg, r' <> r -> r' <> PC -> rs'#r' = rs#r'.
-Proof.
-  intros. unfold loadimm.
-  case (Int.eq (high_s n) Int.zero).
-  (* addi *)
-  exists (nextinstr (rs#r <- (Vint n))).
-  split. apply exec_straight_one. 
-  simpl. rewrite Int.add_commut. rewrite Int.add_zero. reflexivity.
-  reflexivity. 
-  split. rewrite nextinstr_inv; auto with ppcgen.
-   apply Pregmap.gss. 
-  intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
-  (* addis *)
-  generalize (Int.eq_spec (low_s n) Int.zero); case (Int.eq (low_s n) Int.zero); intro.
-  exists (nextinstr (rs#r <- (Vint n))).
-  split. apply exec_straight_one. 
-  simpl. rewrite Int.add_commut. 
-  rewrite <- H. rewrite low_high_s. reflexivity.
-  reflexivity. 
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss. 
-  intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
-  (* addis + ori *)
-  pose (rs1 := nextinstr (rs#r <- (Vint (Int.shl (high_u n) (Int.repr 16))))).
-  exists (nextinstr (rs1#r <- (Vint n))).
-  split. eapply exec_straight_two. 
-  simpl. rewrite Int.add_commut. rewrite Int.add_zero. reflexivity.
-  simpl. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss. 
-  unfold Val.or. rewrite low_high_u. reflexivity.
-  reflexivity. reflexivity.
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss. 
-  intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-  unfold rs1. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-Qed.
-
-(** Add integer immediate. *)
-
-Lemma addimm_1_correct:
-  forall r1 r2 n k rs m,
-  r1 <> GPR0 ->
-  r2 <> GPR0 ->
-  exists rs',
-     exec_straight (addimm_1 r1 r2 n k) rs m  k rs' m
-  /\ rs'#r1 = Val.add rs#r2 (Vint n)
-  /\ forall r': preg, r' <> r1 -> r' <> PC -> rs'#r' = rs#r'.
-Proof.
-  intros. unfold addimm_1.
-  (* addi *)
-  case (Int.eq (high_s n) Int.zero).
-  exists (nextinstr (rs#r1 <- (Val.add rs#r2 (Vint n)))).
-  split. apply exec_straight_one. 
-  simpl. rewrite gpr_or_zero_not_zero; auto.
-  reflexivity. 
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss. 
-  intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto. 
-  (* addis *)
-  generalize (Int.eq_spec (low_s n) Int.zero); case (Int.eq (low_s n) Int.zero); intro.
-  exists (nextinstr (rs#r1 <- (Val.add rs#r2 (Vint n)))).
-  split. apply exec_straight_one.
-  simpl. rewrite gpr_or_zero_not_zero; auto.
-  generalize (low_high_s n). rewrite H1. rewrite Int.add_zero. intro.
-  rewrite H2. auto.
-  reflexivity.
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss. 
-  intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
-  (* addis + addi *)
-  pose (rs1 := nextinstr (rs#r1 <- (Val.add rs#r2 (Vint (Int.shl (high_s n) (Int.repr 16)))))).
-  exists (nextinstr (rs1#r1 <- (Val.add rs#r2 (Vint n)))).
-  split. apply exec_straight_two with rs1 m.
-  simpl. rewrite gpr_or_zero_not_zero; auto. 
-  simpl. rewrite gpr_or_zero_not_zero; auto.
-  unfold rs1 at 1. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
-  rewrite Val.add_assoc. simpl. rewrite low_high_s. auto.
-  reflexivity. reflexivity. 
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss. 
-  intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-  unfold rs1. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
-Qed. 
-
-Lemma addimm_2_correct:
-  forall r1 r2 n k rs m,
-  r2 <> GPR12 ->
-  exists rs',
-     exec_straight (addimm_2 r1 r2 n k) rs m  k rs' m
-  /\ rs'#r1 = Val.add rs#r2 (Vint n)
-  /\ forall r': preg, r' <> r1 -> r' <> GPR12 -> r' <> PC -> rs'#r' = rs#r'.
-Proof.
-  intros. unfold addimm_2.
-  generalize (loadimm_correct GPR12 n (Padd r1 r2 GPR12 :: k) rs m).
-  intros [rs1 [EX [RES OTHER]]].
-  exists (nextinstr (rs1#r1 <- (Val.add rs#r2 (Vint n)))).
-  split. eapply exec_straight_trans. eexact EX. 
-  apply exec_straight_one. simpl. rewrite RES. rewrite OTHER.
-  auto. congruence. discriminate.
-  reflexivity. 
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
-  intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-Qed.
-
-Lemma addimm_correct:
-  forall r1 r2 n k rs m,
-  r2 <> GPR12 ->
-  exists rs',
-     exec_straight (addimm r1 r2 n k) rs m  k rs' m
-  /\ rs'#r1 = Val.add rs#r2 (Vint n)
-  /\ forall r': preg, r' <> r1 -> r' <> GPR12 -> r' <> PC -> rs'#r' = rs#r'.
-Proof.
-  intros. unfold addimm.
-  case (ireg_eq r1 GPR0); intro.
-  apply addimm_2_correct; auto.
-  case (ireg_eq r2 GPR0); intro.
-  apply addimm_2_correct; auto.
-  generalize (addimm_1_correct r1 r2 n k rs m n0 n1).  
-  intros [rs' [EX [RES OTH]]]. exists rs'. intuition. 
-Qed.
-
-(** And integer immediate. *)
-
-Lemma andimm_correct:
-  forall r1 r2 n k (rs : regset) m,
-  r2 <> GPR12 ->
-  let v := Val.and rs#r2 (Vint n) in
-  exists rs',
-     exec_straight (andimm r1 r2 n k) rs m  k rs' m
-  /\ rs'#r1 = v
-  /\ rs'#CR0_2 = Val.cmp Ceq v Vzero
-  /\ forall r': preg,
-       r' <> r1 -> r' <> GPR12 -> r' <> PC ->
-       r' <> CR0_0 -> r' <> CR0_1 -> r' <> CR0_2 -> r' <> CR0_3 ->
-       rs'#r' = rs#r'.
-Proof.
-  intros. unfold andimm.
-  case (Int.eq (high_u n) Int.zero).
-  (* andi *)
-  exists (nextinstr (compare_sint (rs#r1 <- v) v Vzero)).
-  generalize (compare_sint_spec (rs#r1 <- v) v Vzero).
-  intros [A [B [C D]]].
-  split. apply exec_straight_one. reflexivity. reflexivity.
-  split. rewrite D; try discriminate. apply Pregmap.gss. 
-  split. auto.
-  intros. rewrite D; auto. apply Pregmap.gso; auto.
-  (* andis *)
-  generalize (Int.eq_spec (low_u n) Int.zero);
-  case (Int.eq (low_u n) Int.zero); intro.
-  exists (nextinstr (compare_sint (rs#r1 <- v) v Vzero)).
-  generalize (compare_sint_spec (rs#r1 <- v) v Vzero).
-  intros [A [B [C D]]].
-  split. apply exec_straight_one. simpl.
-  generalize (low_high_u n). rewrite H0. rewrite Int.or_zero. 
-  intro. rewrite H1. reflexivity. reflexivity.
-  split. rewrite D; try discriminate. apply Pregmap.gss. 
-  split. auto.
-  intros. rewrite D; auto. apply Pregmap.gso; auto.
-  (* loadimm + and *)
-  generalize (loadimm_correct GPR12 n (Pand_ r1 r2 GPR12 :: k) rs m).
-  intros [rs1 [EX1 [RES1 OTHER1]]].
-  exists (nextinstr (compare_sint (rs1#r1 <- v) v Vzero)).
-  generalize (compare_sint_spec (rs1#r1 <- v) v Vzero).
-  intros [A [B [C D]]].
-  split. eapply exec_straight_trans. eexact EX1. 
-  apply exec_straight_one. simpl. rewrite RES1. 
-  rewrite (OTHER1 r2). reflexivity. congruence. congruence.
-  reflexivity. 
-  split. rewrite D; try discriminate. apply Pregmap.gss. 
-  split. auto.
-  intros. rewrite D; auto. rewrite Pregmap.gso; auto.
-Qed.
-
-(** Or integer immediate. *)
-
-Lemma orimm_correct:
-  forall r1 (r2: ireg) n k (rs : regset) m,
-  let v := Val.or rs#r2 (Vint n) in
-  exists rs',
-     exec_straight (orimm r1 r2 n k) rs m  k rs' m
-  /\ rs'#r1 = v
-  /\ forall r': preg, r' <> r1 -> r' <> PC -> rs'#r' = rs#r'.
-Proof.
-  intros. unfold orimm.
-  case (Int.eq (high_u n) Int.zero).
-  (* ori *)
-  exists (nextinstr (rs#r1 <- v)).
-  split. apply exec_straight_one. reflexivity. reflexivity.
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
-  intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
-  (* oris *)
-  generalize (Int.eq_spec (low_u n) Int.zero);
-  case (Int.eq (low_u n) Int.zero); intro.
-  exists (nextinstr (rs#r1 <- v)).
-  split. apply exec_straight_one. simpl.
-  generalize (low_high_u n). rewrite H. rewrite Int.or_zero. 
-  intro. rewrite H0. reflexivity. reflexivity.
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
-  intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
-  (* oris + ori *)
-  pose (rs1 := nextinstr (rs#r1 <- (Val.or rs#r2 (Vint (Int.shl (high_u n) (Int.repr 16)))))).
-  exists (nextinstr (rs1#r1 <- v)).
-  split. apply exec_straight_two with rs1 m.
-  reflexivity. simpl. unfold rs1 at 1. 
-  rewrite nextinstr_inv; auto with ppcgen.
-  rewrite Pregmap.gss. rewrite Val.or_assoc. simpl. 
-  rewrite low_high_u. reflexivity. reflexivity. reflexivity. 
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
-  intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-  unfold rs1. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-Qed.
-
-(** Xor integer immediate. *)
-
-Lemma xorimm_correct:
-  forall r1 (r2: ireg) n k (rs : regset) m,
-  let v := Val.xor rs#r2 (Vint n) in
-  exists rs',
-     exec_straight (xorimm r1 r2 n k) rs m  k rs' m
-  /\ rs'#r1 = v
-  /\ forall r': preg, r' <> r1 -> r' <> PC -> rs'#r' = rs#r'.
-Proof.
-  intros. unfold xorimm.
-  case (Int.eq (high_u n) Int.zero).
-  (* xori *)
-  exists (nextinstr (rs#r1 <- v)).
-  split. apply exec_straight_one. reflexivity. reflexivity.
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
-  intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
-  (* xoris *)
-  generalize (Int.eq_spec (low_u n) Int.zero);
-  case (Int.eq (low_u n) Int.zero); intro.
-  exists (nextinstr (rs#r1 <- v)).
-  split. apply exec_straight_one. simpl.
-  generalize (low_high_u_xor n). rewrite H. rewrite Int.xor_zero. 
-  intro. rewrite H0. reflexivity. reflexivity.
-  split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
-  intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
-  (* xoris + xori *)
-  pose (rs1 := nextinstr (rs#r1 <- (Val.xor rs#r2 (Vint (Int.shl (high_u n) (Int.repr 16)))))).
-  exists (nextinstr (rs1#r1 <- v)).
-  split. apply exec_straight_two with rs1 m.
-  reflexivity. simpl. unfold rs1 at 1. 
-  rewrite nextinstr_inv; try discriminate. 
-  rewrite Pregmap.gss. rewrite Val.xor_assoc. simpl. 
-  rewrite low_high_u_xor. reflexivity. reflexivity. reflexivity. 
-  split. rewrite nextinstr_inv; auto with ppcgen.
-  apply Pregmap.gss.
-  intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-  unfold rs1. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-Qed.
-
-(** Indexed memory loads. *)
-
-Lemma loadind_aux_correct:
-  forall (base: ireg) ofs ty dst (rs: regset) m v,
-  Mem.loadv (chunk_of_type ty) m (Val.add rs#base (Vint ofs)) = Some v ->
-  mreg_type dst = ty ->
-  base <> GPR0 ->
-  exec_instr ge fn (loadind_aux base ofs ty dst) rs m =
-    OK (nextinstr (rs#(preg_of dst) <- v)) m.
-Proof.
-  intros. unfold loadind_aux. unfold preg_of. rewrite H0. destruct ty.
-  simpl. unfold load1. rewrite gpr_or_zero_not_zero; auto.
-  unfold const_low. simpl in H. rewrite H. auto.
-  simpl. unfold load1. rewrite gpr_or_zero_not_zero; auto.
-  unfold const_low. simpl in H. rewrite H. auto.
-Qed.
-
-Lemma loadind_correct:
-  forall (base: ireg) ofs ty dst k (rs: regset) m v,
-  Mem.loadv (chunk_of_type ty) m (Val.add rs#base (Vint ofs)) = Some v ->
-  mreg_type dst = ty ->
-  base <> GPR0 ->
-  exists rs',
-     exec_straight (loadind base ofs ty dst k) rs m k rs' m
-  /\ rs'#(preg_of dst) = v
-  /\ forall r, r <> PC -> r <> GPR12 -> r <> preg_of dst -> rs'#r = rs#r.
-Proof.
-  intros. unfold loadind.
-  assert (preg_of dst <> PC).
-    unfold preg_of. case (mreg_type dst); discriminate.
-  (* short offset *)
-  case (Int.eq (high_s ofs) Int.zero).
-  exists (nextinstr (rs#(preg_of dst) <- v)).
-  split. apply exec_straight_one. apply loadind_aux_correct; auto. 
-  unfold nextinstr. rewrite Pregmap.gss. rewrite Pregmap.gso. auto. auto.
-  split. rewrite nextinstr_inv; auto. apply Pregmap.gss.
-  intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
-  (* long offset *)
-  pose (rs1 := nextinstr (rs#GPR12 <- (Val.add rs#base (Vint (Int.shl (high_s ofs) (Int.repr 16)))))).
-  exists (nextinstr (rs1#(preg_of dst) <- v)).
-  split. apply exec_straight_two with rs1 m.
-  simpl. rewrite gpr_or_zero_not_zero; auto. 
-  apply loadind_aux_correct. 
-  unfold rs1. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss. 
-  rewrite Val.add_assoc. simpl. rewrite low_high_s. assumption.
-  auto. discriminate. reflexivity. 
-  unfold nextinstr. rewrite Pregmap.gss. rewrite Pregmap.gso. auto. auto.
-  split. rewrite nextinstr_inv; auto. apply Pregmap.gss.
-  intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-  unfold rs1. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-Qed.
-
-(** Indexed memory stores. *)
-
-Lemma storeind_aux_correct:
-  forall (base: ireg) ofs ty src (rs: regset) m m',
-  Mem.storev (chunk_of_type ty) m (Val.add rs#base (Vint ofs)) (rs#(preg_of src)) = Some m' ->
-  mreg_type src = ty ->
-  base <> GPR0 ->
-  exec_instr ge fn (storeind_aux src base ofs ty) rs m =
-    OK (nextinstr rs) m'.
-Proof.
-  intros. unfold storeind_aux. unfold preg_of in H. rewrite H0 in H. destruct ty.
-  simpl. unfold store1. rewrite gpr_or_zero_not_zero; auto.
-  unfold const_low. simpl in H. rewrite H. auto.
-  simpl. unfold store1. rewrite gpr_or_zero_not_zero; auto.
-  unfold const_low. simpl in H. rewrite H. auto.
-Qed.
-
-Lemma storeind_correct:
-  forall (base: ireg) ofs ty src k (rs: regset) m m',
-  Mem.storev (chunk_of_type ty) m (Val.add rs#base (Vint ofs)) (rs#(preg_of src)) = Some m' ->
-  mreg_type src = ty ->
-  base <> GPR0 ->
-  exists rs',
-     exec_straight (storeind src base ofs ty k) rs m k rs' m'
-  /\ forall r, r <> PC -> r <> GPR12 -> rs'#r = rs#r.
-Proof.
-  intros. unfold storeind.
-  (* short offset *)
-  case (Int.eq (high_s ofs) Int.zero).
-  exists (nextinstr rs).
-  split. apply exec_straight_one. apply storeind_aux_correct; auto. 
-  reflexivity. 
-  intros. rewrite nextinstr_inv; auto. 
-  (* long offset *)
-  pose (rs1 := nextinstr (rs#GPR12 <- (Val.add rs#base (Vint (Int.shl (high_s ofs) (Int.repr 16)))))).
-  exists (nextinstr rs1).
-  split. apply exec_straight_two with rs1 m.
-  simpl. rewrite gpr_or_zero_not_zero; auto. 
-  apply storeind_aux_correct; auto with ppcgen.
-  unfold rs1. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss. 
-  rewrite nextinstr_inv; auto with ppcgen.
-  rewrite Pregmap.gso; auto with ppcgen.
-  rewrite Val.add_assoc. simpl. rewrite low_high_s. assumption.
-  reflexivity. reflexivity.
-  intros. rewrite nextinstr_inv; auto.
-  unfold rs1. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-Qed.
-
-(** Float comparisons. *)
-
-Lemma floatcomp_correct:
-  forall cmp (r1 r2: freg) k rs m,
-  exists rs',
-     exec_straight (floatcomp cmp r1 r2 k) rs m k rs' m
-  /\ rs'#(reg_of_crbit (fst (crbit_for_fcmp cmp))) = 
-       (if snd (crbit_for_fcmp cmp)
-        then Val.cmpf cmp rs#r1 rs#r2
-        else Val.notbool (Val.cmpf cmp rs#r1 rs#r2))
-  /\ forall r', 
-       r' <> PC -> r' <> CR0_0 -> r' <> CR0_1 ->
-       r' <> CR0_2 -> r' <> CR0_3 -> rs'#r' = rs#r'.
-Proof.
-  intros. 
-  generalize (compare_float_spec rs rs#r1 rs#r2).
-  intros [A [B [C D]]].
-  set (rs1 := nextinstr (compare_float rs rs#r1 rs#r2)) in *.
-  assert ((cmp = Ceq \/ cmp = Cne \/ cmp = Clt \/ cmp = Cgt)
-          \/ (cmp = Cle \/ cmp = Cge)).
-    case cmp; tauto.
-  unfold floatcomp.  elim H; intro; clear H.
-  exists rs1.
-  split. generalize H0; intros [EQ|[EQ|[EQ|EQ]]]; subst cmp;
-  apply exec_straight_one; reflexivity.
-  split. 
-  generalize H0; intros [EQ|[EQ|[EQ|EQ]]]; subst cmp; simpl; auto. 
-  rewrite Val.negate_cmpf_eq. auto.
-  auto.
-  (* two instrs *)
-  exists (nextinstr (rs1#CR0_3 <- (Val.cmpf cmp rs#r1 rs#r2))).
-  split. elim H0; intro; subst cmp.
-  apply exec_straight_two with rs1 m.
-  reflexivity. simpl. 
-  rewrite C; rewrite A. rewrite Val.or_commut. rewrite <- Val.cmpf_le.
-  reflexivity. reflexivity. reflexivity.
-  apply exec_straight_two with rs1 m.
-  reflexivity. simpl. 
-  rewrite C; rewrite B. rewrite Val.or_commut. rewrite <- Val.cmpf_ge.
-  reflexivity. reflexivity. reflexivity.
-  split. elim H0; intro; subst cmp; simpl.
-  reflexivity.
-  reflexivity.
-  intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
-Qed.
-
-Ltac TypeInv :=
-  match goal with
-  | H: (List.map ?f ?x = nil) |- _ =>
-      destruct x; [clear H | simpl in H; discriminate]
-  | H: (List.map ?f ?x = ?hd :: ?tl) |- _ =>
-      destruct x; simpl in H;
-      [ discriminate |
-        injection H; clear H; let T := fresh "T" in (
-          intros H T; TypeInv) ]
-  | _ => idtac
-  end.
-
-(** Translation of conditions. *)
-
-Lemma transl_cond_correct_aux:
-  forall cond args k ms sp rs m,
-  map mreg_type args = type_of_condition cond ->
-  agree ms sp rs ->
-  exists rs',
-     exec_straight (transl_cond cond args k) rs m k rs' m
-  /\ rs'#(reg_of_crbit (fst (crbit_for_cond cond))) = 
-       (if snd (crbit_for_cond cond)
-        then eval_condition_total cond (map ms args)
-        else Val.notbool (eval_condition_total cond (map ms args)))
-  /\ agree ms sp rs'.
-Proof.
-  intros.  destruct cond; simpl in H; TypeInv.
-  (* Ccomp *)
-  simpl. 
-  generalize (compare_sint_spec rs ms#m0 ms#m1).
-  intros [A [B [C D]]].
-  exists (nextinstr (compare_sint rs ms#m0 ms#m1)).
-  split. apply exec_straight_one. simpl. 
-  repeat (rewrite <- (ireg_val ms sp rs); auto).
-  reflexivity.
-  split. 
-  case c; simpl; auto; rewrite <- Val.negate_cmp; simpl; auto.
-  apply agree_exten_2 with rs; auto.
-  (* Ccompu *)
-  simpl. 
-  generalize (compare_uint_spec rs ms#m0 ms#m1).
-  intros [A [B [C D]]].
-  exists (nextinstr (compare_uint rs ms#m0 ms#m1)).
-  split. apply exec_straight_one. simpl. 
-  repeat (rewrite <- (ireg_val ms sp rs); auto).
-  reflexivity.
-  split. 
-  case c; simpl; auto; rewrite <- Val.negate_cmpu; simpl; auto.
-  apply agree_exten_2 with rs; auto.
-  (* Ccompimm *)
-  simpl.
-  case (Int.eq (high_s i) Int.zero).
-  generalize (compare_sint_spec rs ms#m0 (Vint i)).
-  intros [A [B [C D]]].
-  exists (nextinstr (compare_sint rs ms#m0 (Vint i))).
-  split. apply exec_straight_one. simpl. 
-  repeat (rewrite <- (ireg_val ms sp rs); auto).
-  reflexivity.
-  split. 
-  case c; simpl; auto; rewrite <- Val.negate_cmp; simpl; auto.
-  apply agree_exten_2 with rs; auto.
-  generalize (loadimm_correct GPR12 i (Pcmpw (ireg_of m0) GPR12 :: k) rs m).
-  intros [rs1 [EX1 [RES1 OTH1]]].
-  assert (agree ms sp rs1). apply agree_exten_2 with rs; auto.
-  generalize (compare_sint_spec rs1 ms#m0 (Vint i)).
-  intros [A [B [C D]]].
-  exists (nextinstr (compare_sint rs1 ms#m0 (Vint i))).
-  split. eapply exec_straight_trans. eexact EX1.
-  apply exec_straight_one. simpl. 
-  repeat (rewrite <- (ireg_val ms sp rs1); auto). rewrite RES1.
-  reflexivity. reflexivity.
-  split. 
-  case c; simpl; auto; rewrite <- Val.negate_cmp; simpl; auto.
-  apply agree_exten_2 with rs1; auto.
-  (* Ccompuimm *)
-  simpl.
-  case (Int.eq (high_u i) Int.zero).
-  generalize (compare_uint_spec rs ms#m0 (Vint i)).
-  intros [A [B [C D]]].
-  exists (nextinstr (compare_uint rs ms#m0 (Vint i))).
-  split. apply exec_straight_one. simpl. 
-  repeat (rewrite <- (ireg_val ms sp rs); auto).
-  reflexivity.
-  split. 
-  case c; simpl; auto; rewrite <- Val.negate_cmpu; simpl; auto.
-  apply agree_exten_2 with rs; auto.
-  generalize (loadimm_correct GPR12 i (Pcmplw (ireg_of m0) GPR12 :: k) rs m).
-  intros [rs1 [EX1 [RES1 OTH1]]].
-  assert (agree ms sp rs1). apply agree_exten_2 with rs; auto.
-  generalize (compare_uint_spec rs1 ms#m0 (Vint i)).
-  intros [A [B [C D]]].
-  exists (nextinstr (compare_uint rs1 ms#m0 (Vint i))).
-  split. eapply exec_straight_trans. eexact EX1.
-  apply exec_straight_one. simpl. 
-  repeat (rewrite <- (ireg_val ms sp rs1); auto). rewrite RES1.
-  reflexivity. reflexivity.
-  split. 
-  case c; simpl; auto; rewrite <- Val.negate_cmpu; simpl; auto.
-  apply agree_exten_2 with rs1; auto.
-  (* Ccompf *)
-  simpl.
-  generalize (floatcomp_correct c (freg_of m0) (freg_of m1) k rs m).
-  intros [rs' [EX [RES OTH]]].
-  exists rs'. split. auto. 
-  split. rewrite RES. repeat (rewrite <- (freg_val ms sp rs); auto). 
-  apply agree_exten_2 with rs; auto.
-  (* Cnotcompf *)
-  simpl. 
-  generalize (floatcomp_correct c (freg_of m0) (freg_of m1) k rs m).
-  intros [rs' [EX [RES OTH]]].
-  exists rs'. split. auto. 
-  split. rewrite RES. repeat (rewrite <- (freg_val ms sp rs); auto).
-  assert (forall v1 v2, Val.notbool (Val.notbool (Val.cmpf c v1 v2)) = Val.cmpf c v1 v2).
-    intros v1 v2; unfold Val.cmpf; destruct v1; destruct v2; auto. 
-    apply Val.notbool_idem2.
-  rewrite H.
-  generalize RES. case (snd (crbit_for_fcmp c)); simpl; auto.
-  apply agree_exten_2 with rs; auto.
-  (* Cmaskzero *)
-  simpl.
-  generalize (andimm_correct GPR12 (ireg_of m0) i k rs m (ireg_of_not_GPR12 m0)).
-  intros [rs' [A [B [C D]]]].
-  exists rs'. split. assumption. 
-  split. rewrite C. rewrite <- (ireg_val ms sp rs); auto.
-  apply agree_exten_2 with rs; auto.
-  (* Cmasknotzero *)
-  simpl.
-  generalize (andimm_correct GPR12 (ireg_of m0) i k rs m (ireg_of_not_GPR12 m0)).
-  intros [rs' [A [B [C D]]]].
-  exists rs'. split. assumption. 
-  split. rewrite C. rewrite <- (ireg_val ms sp rs); auto.
-  rewrite Val.notbool_idem3. reflexivity. 
-  apply agree_exten_2 with rs; auto.
-Qed.
-
-Lemma transl_cond_correct:
-  forall cond args k ms sp rs m b,
-  map mreg_type args = type_of_condition cond ->
-  agree ms sp rs ->
-  eval_condition cond (map ms args) m = Some b ->
-  exists rs',
-     exec_straight (transl_cond cond args k) rs m k rs' m
-  /\ rs'#(reg_of_crbit (fst (crbit_for_cond cond))) = 
-       (if snd (crbit_for_cond cond)
-        then Val.of_bool b
-        else Val.notbool (Val.of_bool b))
-  /\ agree ms sp rs'.
-Proof.
-  intros. rewrite <- (eval_condition_weaken _ _ _ H1). 
-  apply transl_cond_correct_aux; auto.
-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.
-
-Lemma transl_op_correct:
-  forall op args res k ms sp rs m v,
-  wt_instr (Mop op args res) ->
-  agree ms sp rs ->
-  eval_operation ge sp op (map ms args) m = Some v ->
-  exists rs',
-     exec_straight (transl_op op args res k) rs m k rs' m
-  /\ agree (Regmap.set res v ms) sp rs'.
-Proof.
-  intros. rewrite <- (eval_operation_weaken _ _ _ _ _ H1). clear H1; clear v.
-  inversion H.
-  (* Omove *)
-  simpl. exists (nextinstr (rs#(preg_of res) <- (ms r1))).
-  split. caseEq (mreg_type r1); intro.
-  apply exec_straight_one. simpl. rewrite (ireg_val ms sp rs); auto.
-  simpl. unfold preg_of. rewrite <- H2. rewrite H5. reflexivity.
-  auto with ppcgen.
-  apply exec_straight_one. simpl. rewrite (freg_val ms sp rs); auto.
-  simpl. unfold preg_of. rewrite <- H2. rewrite H5. reflexivity.
-  auto with ppcgen.
-  auto with ppcgen.
-  (* Other instructions *)
-  clear H1; clear H2; clear H4.
-  destruct op; simpl in H5; injection H5; clear H5; intros;
-  TypeInv; simpl; try (TranslOpSimpl).
-  (* Omove again *)
-  congruence.
-  (* Ointconst *)
-  generalize (loadimm_correct (ireg_of res) i k rs m).
-  intros [rs' [A [B C]]]. 
-  exists rs'. split. auto. 
-  apply agree_set_mireg_exten with rs; auto. 
-  (* Ofloatconst *)
-  exists (nextinstr (rs#(freg_of res) <- (Vfloat f) #GPR12 <- Vundef)).
-  split. apply exec_straight_one. reflexivity. reflexivity.
-  auto with ppcgen.
-  (* Oaddrsymbol *)
-  change (find_symbol_offset ge i i0) with (symbol_offset ge i i0).
-  set (v := symbol_offset ge i i0).
-  pose (rs1 := nextinstr (rs#GPR12 <- (high_half v))).
-  exists (nextinstr (rs1#(ireg_of res) <- v)).
-  split. apply exec_straight_two with rs1 m.
-  unfold exec_instr. rewrite gpr_or_zero_zero.
-  unfold const_high. rewrite Val.add_commut. 
-  rewrite high_half_zero. reflexivity. 
-  simpl. rewrite gpr_or_zero_not_zero. 2: congruence. 
-  unfold rs1 at 1. rewrite nextinstr_inv; auto with ppcgen.
-  rewrite Pregmap.gss. 
-  fold v. rewrite Val.add_commut. unfold v. rewrite low_high_half.
-  reflexivity. reflexivity. reflexivity. 
-  unfold rs1. apply agree_nextinstr. apply agree_set_mireg; auto.
-  apply agree_set_mreg. apply agree_nextinstr.
-  apply agree_set_other. auto. simpl. tauto.
-  (* Oaddrstack *)
-  assert (GPR1 <> GPR12). discriminate.
-  generalize (addimm_correct (ireg_of res) GPR1 i k rs m H2). 
-  intros [rs' [EX [RES OTH]]].
-  exists rs'. split. auto. 
-  apply agree_set_mireg_exten with rs; auto.
-  rewrite (sp_val ms sp rs). auto. auto. 
-  (* Ocast8unsigned *)
-  exists (nextinstr (rs#(ireg_of res) <- (Val.rolm (ms m0) Int.zero (Int.repr 255)))).
-  split. apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs)); auto. reflexivity.
-  replace (Val.zero_ext 8 (ms m0))
-      with (Val.rolm (ms m0) Int.zero (Int.repr 255)).
-  auto with ppcgen. 
-  unfold Val.rolm, Val.zero_ext. destruct (ms m0); auto. 
-  rewrite Int.rolm_zero. rewrite Int.zero_ext_and. auto. compute; auto.
-  (* Ocast16unsigned *)
-  exists (nextinstr (rs#(ireg_of res) <- (Val.rolm (ms m0) Int.zero (Int.repr 65535)))).
-  split. apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs)); auto. reflexivity.
-  replace (Val.zero_ext 16 (ms m0))
-      with (Val.rolm (ms m0) Int.zero (Int.repr 65535)).
-  auto with ppcgen. 
-  unfold Val.rolm, Val.zero_ext. destruct (ms m0); auto. 
-  rewrite Int.rolm_zero. rewrite Int.zero_ext_and. auto. compute; auto.
-  (* Oaddimm *)
-  generalize (addimm_correct (ireg_of res) (ireg_of m0) i k rs m
-                            (ireg_of_not_GPR12 m0)).
-  intros [rs' [A [B C]]]. 
-  exists rs'. split. auto.
-  apply agree_set_mireg_exten with rs; auto.
-  rewrite (ireg_val ms sp rs); auto. 
-  (* Osub *)
-  exists (nextinstr (rs#(ireg_of res) <- (Val.sub (ms m0) (ms m1)) #CARRY <- Vundef)).
-  split. apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs); auto).
-  simpl. reflexivity. auto with ppcgen.
-  (* Osubimm *)
-  case (Int.eq (high_s i) Int.zero).
-  exists (nextinstr (rs#(ireg_of res) <- (Val.sub (Vint i) (ms m0)) #CARRY <- Vundef)).
-  split. apply exec_straight_one. rewrite (ireg_val ms sp rs); auto.
-  reflexivity. simpl. auto with ppcgen.
-  generalize (loadimm_correct GPR12 i (Psubfc (ireg_of res) (ireg_of m0) GPR12 :: k) rs m).
-  intros [rs1 [EX [RES OTH]]].
-  assert (agree ms sp rs1). apply agree_exten_2 with rs; auto.
-  exists (nextinstr (rs1#(ireg_of res) <- (Val.sub (Vint i) (ms m0)) #CARRY <- Vundef)).
-  split. eapply exec_straight_trans. eexact EX. 
-  apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs); auto).
-  simpl. rewrite RES. rewrite OTH. reflexivity. 
-  generalize (ireg_of_not_GPR12 m0); congruence.
-  discriminate.
-  reflexivity. simpl; auto with ppcgen.
-  (* Omulimm *)
-  case (Int.eq (high_s i) Int.zero).
-  exists (nextinstr (rs#(ireg_of res) <- (Val.mul (ms m0) (Vint i)))).
-  split. apply exec_straight_one. rewrite (ireg_val ms sp rs); auto.
-  reflexivity. auto with ppcgen.
-  generalize (loadimm_correct GPR12 i (Pmullw (ireg_of res) (ireg_of m0) GPR12 :: k) rs m).
-  intros [rs1 [EX [RES OTH]]].
-  assert (agree ms sp rs1). apply agree_exten_2 with rs; auto.
-  exists (nextinstr (rs1#(ireg_of res) <- (Val.mul (ms m0) (Vint i)))).
-  split. eapply exec_straight_trans. eexact EX. 
-  apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs); auto).
-  simpl. rewrite RES. rewrite OTH. reflexivity. 
-  generalize (ireg_of_not_GPR12 m0); congruence.
-  discriminate.
-  reflexivity. simpl; auto with ppcgen.
-  (* Oand *)
-  pose (v := Val.and (ms m0) (ms m1)).
-  pose (rs1 := rs#(ireg_of res) <- v).
-  generalize (compare_sint_spec rs1 v Vzero).
-  intros [A [B [C D]]].
-  exists (nextinstr (compare_sint rs1 v Vzero)).
-  split. apply exec_straight_one. 
-  unfold rs1, v. repeat (rewrite (ireg_val ms sp rs); auto). 
-  reflexivity.  
-  apply agree_exten_2 with rs1. unfold rs1, v; auto with ppcgen.
-  auto.
-  (* Oandimm *)
-  generalize (andimm_correct (ireg_of res) (ireg_of m0) i k rs m
-                             (ireg_of_not_GPR12 m0)).
-  intros [rs' [A [B [C D]]]]. 
-  exists rs'. split. auto. apply agree_set_mireg_exten with rs; auto.
-  rewrite (ireg_val ms sp rs); auto.
-  (* Oorimm *)
-  generalize (orimm_correct (ireg_of res) (ireg_of m0) i k rs m).
-  intros [rs' [A [B C]]]. 
-  exists rs'. split. auto. apply agree_set_mireg_exten with rs; auto.
-  rewrite (ireg_val ms sp rs); auto.
-  (* Oxorimm *)
-  generalize (xorimm_correct (ireg_of res) (ireg_of m0) i k rs m).
-  intros [rs' [A [B C]]]. 
-  exists rs'. split. auto. apply agree_set_mireg_exten with rs; auto.
-  rewrite (ireg_val ms sp rs); auto.
-  (* Oshr *)
-  exists (nextinstr (rs#(ireg_of res) <- (Val.shr (ms m0) (ms m1)) #CARRY <- (Val.shr_carry (ms m0) (ms m1)))).
-  split. apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs); auto).
-  reflexivity. auto with ppcgen.
-  (* Oshrimm *)
-  exists (nextinstr (rs#(ireg_of res) <- (Val.shr (ms m0) (Vint i)) #CARRY <- (Val.shr_carry (ms m0) (Vint i)))).
-  split. apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs); auto).
-  reflexivity. auto with ppcgen.
-  (* Oxhrximm *)
-  pose (rs1 := nextinstr (rs#(ireg_of res) <- (Val.shr (ms m0) (Vint i)) #CARRY <- (Val.shr_carry (ms m0) (Vint i)))).
-  exists (nextinstr (rs1#(ireg_of res) <- (Val.shrx (ms m0) (Vint i)))).
-  split. apply exec_straight_two with rs1 m.
-  unfold rs1; rewrite (ireg_val ms sp rs); auto.
-  simpl; unfold rs1; repeat rewrite <- (ireg_val ms sp rs); auto.
-  repeat (rewrite nextinstr_inv; try discriminate).
-  repeat rewrite Pregmap.gss. decEq. decEq. 
-  apply (f_equal3 (@Pregmap.set val)); auto.
-  rewrite Pregmap.gso. rewrite Pregmap.gss. apply Val.shrx_carry.
-  discriminate. reflexivity. reflexivity.
-  apply agree_exten_2 with (rs#(ireg_of res) <- (Val.shrx (ms m0) (Vint i))).
-  auto with ppcgen. 
-  intros. rewrite nextinstr_inv; auto. 
-  case (preg_eq (ireg_of res) r); intro.
-  subst r. repeat rewrite Pregmap.gss. auto.
-  repeat rewrite Pregmap.gso; auto.
-  unfold rs1. rewrite nextinstr_inv; auto.
-  repeat rewrite Pregmap.gso; auto.
-  (* Ointoffloat *)
-  exists (nextinstr (rs#(ireg_of res) <- (Val.intoffloat (ms m0)) #FPR13 <- Vundef)).
-  split. apply exec_straight_one. 
-  repeat (rewrite (freg_val ms sp rs); auto).
-  reflexivity. auto with ppcgen.
-  (* Ointuoffloat *)
-  exists (nextinstr (rs#(ireg_of res) <- (Val.intuoffloat (ms m0)) #FPR13 <- Vundef)).
-  split. apply exec_straight_one. 
-  repeat (rewrite (freg_val ms sp rs); auto).
-  reflexivity. auto with ppcgen.
-  (* Ofloatofint *)
-  exists (nextinstr (rs#(freg_of res) <- (Val.floatofint (ms m0)) #GPR12 <- Vundef #FPR13 <- Vundef)).
-  split. apply exec_straight_one. 
-  repeat (rewrite (ireg_val ms sp rs); auto).
-  reflexivity. auto 10 with ppcgen.
-  (* Ofloatofintu *)
-  exists (nextinstr (rs#(freg_of res) <- (Val.floatofintu (ms m0)) #GPR12 <- Vundef #FPR13 <- Vundef)).
-  split. apply exec_straight_one. 
-  repeat (rewrite (ireg_val ms sp rs); auto).
-  reflexivity. auto 10 with ppcgen.
-  (* Ocmp *)
-  set (bit := fst (crbit_for_cond c)).
-  set (isset := snd (crbit_for_cond c)).
-  set (k1 :=
-        Pmfcrbit (ireg_of res) bit ::
-        (if isset
-         then k
-         else Pxori (ireg_of res) (ireg_of res) (Cint Int.one) :: k)).
-  generalize (transl_cond_correct_aux c args k1 ms sp rs m H2 H0).
-  fold bit; fold isset. 
-  intros [rs1 [EX1 [RES1 AG1]]].
-  set (rs2 := nextinstr (rs1#(ireg_of res) <- (rs1#(reg_of_crbit bit)))).
-  destruct isset.
-  exists rs2.
-  split. apply exec_straight_trans with k1 rs1 m. assumption.
-  unfold k1. apply exec_straight_one. 
-  reflexivity. reflexivity. 
-  unfold rs2. rewrite RES1. auto with ppcgen. 
-  exists (nextinstr (rs2#(ireg_of res) <- (eval_condition_total c ms##args))).
-  split. apply exec_straight_trans with k1 rs1 m. assumption.
-  unfold k1. apply exec_straight_two with rs2 m.
-  reflexivity. simpl. 
-  replace (Val.xor (rs2 (ireg_of res)) (Vint Int.one))
-     with (eval_condition_total c ms##args).
-  reflexivity.
-  unfold rs2. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss. 
-  rewrite RES1. apply Val.notbool_xor. apply eval_condition_total_is_bool.
-  reflexivity. reflexivity. 
-  unfold rs2. auto with ppcgen. 
-Qed.
-
-Lemma transl_load_store_correct:
-  forall (mk1: constant -> ireg -> instruction) (mk2: ireg -> ireg -> instruction)
-    addr args k ms sp rs m ms' m',
-  (forall cst (r1: ireg) (rs1: regset) k,
-    eval_addressing_total ge sp addr (map ms args) = Val.add rs1#r1 (const_low ge cst) ->
-    agree ms sp rs1 ->
-    r1 <> GPR0 ->
-    exists rs',
-    exec_straight (mk1 cst r1 :: k) rs1 m k rs' m' /\
-    agree ms' sp rs') ->
-  (forall (r1 r2: ireg) (rs1: regset) k,
-    eval_addressing_total ge sp addr (map ms args) = Val.add rs1#r1 rs1#r2 ->
-    agree ms sp rs1 ->
-    exists rs',
-    exec_straight (mk2 r1 r2 :: k) rs1 m k rs' m' /\
-    agree ms' sp rs') ->
-  agree ms sp rs ->
-  map mreg_type args = type_of_addressing addr ->
-  exists rs',
-    exec_straight (transl_load_store mk1 mk2 addr args k) rs m
-                        k rs' m'
-  /\ agree ms' sp rs'.
-Proof.
-  intros. destruct addr; simpl in H2; TypeInv; simpl.
-  (* Aindexed *)
-  case (ireg_eq (ireg_of t) GPR0); intro.
-  (* Aindexed from GPR0 *)
-  set (rs1 := nextinstr (rs#GPR12 <- (ms t))).
-  set (rs2 := nextinstr (rs1#GPR12 <- (Val.add (ms t) (Vint (Int.shl (high_s i) (Int.repr 16)))))).
-  assert (ADDR: eval_addressing_total ge sp (Aindexed i) ms##(t :: nil) =
-                Val.add rs2#GPR12 (const_low ge (Cint (low_s i)))).
-    simpl. unfold rs2. rewrite nextinstr_inv. rewrite Pregmap.gss.
-    rewrite Val.add_assoc. simpl. rewrite low_high_s. auto.
-    discriminate.
-  assert (AG: agree ms sp rs2). unfold rs2, rs1; auto 6 with ppcgen.
-  assert (NOT0: GPR12 <> GPR0). discriminate.
-  generalize (H _ _ _ k ADDR AG NOT0).
-  intros [rs' [EX' AG']].
-  exists rs'. split.
-  apply exec_straight_trans with (mk1 (Cint (low_s i)) GPR12 :: k) rs2 m.
-  apply exec_straight_two with rs1 m.
-  unfold rs1. rewrite (ireg_val ms sp rs); auto.
-  unfold rs2. replace (ms t) with (rs1#GPR12). auto.
-  unfold rs1. rewrite nextinstr_inv. apply Pregmap.gss. discriminate.
-  reflexivity. reflexivity.  
-  assumption. assumption.
-  (* Aindexed short *)
-  case (Int.eq (high_s i) Int.zero).
-  assert (ADDR: eval_addressing_total ge sp (Aindexed i) ms##(t :: nil) =
-                Val.add rs#(ireg_of t) (const_low ge (Cint i))).
-    simpl. rewrite (ireg_val ms sp rs); auto.
-  generalize (H _ _ _ k ADDR H1 n). intros [rs' [EX' AG']].
-  exists rs'. split. auto. auto.
-  (* Aindexed long *)
-  set (rs1 := nextinstr (rs#GPR12 <- (Val.add (ms t) (Vint (Int.shl (high_s i) (Int.repr 16)))))).
-  assert (ADDR: eval_addressing_total ge sp (Aindexed i) ms##(t :: nil) =
-                Val.add rs1#GPR12 (const_low ge (Cint (low_s i)))).
-    simpl. unfold rs1. rewrite nextinstr_inv. rewrite Pregmap.gss.
-    rewrite Val.add_assoc. simpl. rewrite low_high_s. auto.
-    discriminate.
-  assert (AG: agree ms sp rs1). unfold rs1; auto with ppcgen.
-  assert (NOT0: GPR12 <> GPR0). discriminate.
-  generalize (H _ _ _ k ADDR AG NOT0). intros [rs' [EX' AG']].
-  exists rs'. split. apply exec_straight_step with rs1 m.
-  simpl. rewrite gpr_or_zero_not_zero; auto. 
-  rewrite <- (ireg_val ms sp rs); auto. reflexivity.
-  assumption. assumption.
-  (* Aindexed2 *)
-  apply H0. 
-  simpl. repeat (rewrite (ireg_val ms sp rs); auto). auto.
-  (* Aglobal *)
-  set (rs1 := nextinstr (rs#GPR12 <- (const_high ge (Csymbol_high i i0)))).
-  assert (ADDR: eval_addressing_total ge sp (Aglobal i i0) ms##nil =
-                Val.add rs1#GPR12 (const_low ge (Csymbol_low i i0))).
-    simpl. unfold rs1. rewrite nextinstr_inv. rewrite Pregmap.gss.
-    unfold const_high, const_low. 
-    set (v := symbol_offset ge i i0).
-    symmetry. rewrite Val.add_commut. unfold v. apply low_high_half. 
-    discriminate.
-  assert (AG: agree ms sp rs1). unfold rs1; auto with ppcgen.
-  assert (NOT0: GPR12 <> GPR0). discriminate.
-  generalize (H _ _ _ k ADDR AG NOT0). intros [rs' [EX' AG']].
-  exists rs'. split. apply exec_straight_step with rs1 m.
-  unfold exec_instr. rewrite gpr_or_zero_zero. 
-  rewrite Val.add_commut. unfold const_high. 
-  rewrite high_half_zero.
-  reflexivity. reflexivity.
-  assumption. assumption.
-  (* Abased *)
-  assert (COMMON:
-    forall (rs1: regset) r,
-    r <> GPR0 ->
-    ms t = rs1#r ->
-    agree ms sp rs1 ->
-    exists rs',
-      exec_straight
-        (Paddis GPR12 r (Csymbol_high i i0)
-         :: mk1 (Csymbol_low i i0) GPR12 :: k) rs1 m k rs' m'
-      /\ agree ms' sp rs').
-  intros. 
-  set (rs2 := nextinstr (rs1#GPR12 <- (Val.add (ms t) (const_high ge (Csymbol_high i i0))))).
-  assert (ADDR: eval_addressing_total ge sp (Abased i i0) ms##(t::nil) =
-                Val.add rs2#GPR12 (const_low ge (Csymbol_low i i0))).
-    simpl. unfold rs2. rewrite nextinstr_inv. rewrite Pregmap.gss.
-    unfold const_high. 
-    set (v := symbol_offset ge i i0).
-    rewrite Val.add_assoc. 
-    rewrite (Val.add_commut (high_half v)).
-    unfold v. rewrite low_high_half. apply Val.add_commut.
-    discriminate.
-  assert (AG: agree ms sp rs2). unfold rs2; auto with ppcgen.
-  assert (NOT0: GPR12 <> GPR0). discriminate.
-  generalize (H _ _ _ k ADDR AG NOT0). intros [rs' [EX' AG']].
-  exists rs'. split. apply exec_straight_step with rs2 m.
-  unfold exec_instr. rewrite gpr_or_zero_not_zero; auto.
-  rewrite <- H3. reflexivity. reflexivity. 
-  assumption. assumption.
-  case (ireg_eq (ireg_of t) GPR0); intro.
-  set (rs1 := nextinstr (rs#GPR12 <- (ms t))).
-  assert (R1: GPR12 <> GPR0). discriminate.
-  assert (R2: ms t = rs1 GPR12). 
-    unfold rs1. rewrite nextinstr_inv. rewrite Pregmap.gss; auto.
-    discriminate.
-  assert (R3: agree ms sp rs1). unfold rs1; auto with ppcgen.
-  generalize (COMMON rs1 GPR12 R1 R2 R3). intros [rs' [EX' AG']].
-  exists rs'. split.
-  apply exec_straight_step with rs1 m.
-  unfold rs1. rewrite (ireg_val ms sp rs); auto. reflexivity.
-  assumption. assumption.
-  apply COMMON; auto. eapply ireg_val; eauto.
-  (* Ainstack *)
-  case (Int.eq (high_s i) Int.zero).
-  apply H. simpl. rewrite (sp_val ms sp rs); auto. auto.
-  discriminate.
-  set (rs1 := nextinstr (rs#GPR12 <- (Val.add sp (Vint (Int.shl (high_s i) (Int.repr 16)))))).
-  assert (ADDR: eval_addressing_total ge sp (Ainstack i) ms##nil =
-                Val.add rs1#GPR12 (const_low ge (Cint (low_s i)))).
-    simpl. unfold rs1. rewrite nextinstr_inv. rewrite Pregmap.gss.
-    rewrite Val.add_assoc. decEq. simpl. rewrite low_high_s. auto.
-    discriminate.
-  assert (AG: agree ms sp rs1). unfold rs1; auto with ppcgen.
-  assert (NOT0: GPR12 <> GPR0). discriminate.
-  generalize (H _ _ _ k ADDR AG NOT0). intros [rs' [EX' AG']].
-  exists rs'. split. apply exec_straight_step with rs1 m.
-  simpl. rewrite gpr_or_zero_not_zero. 
-  unfold rs1. rewrite (sp_val ms sp rs). reflexivity.
-  auto. discriminate. reflexivity. assumption. assumption.
-Qed.
-
-(** Translation of memory loads. *)
-
-Lemma transl_load_correct:
-  forall (mk1: constant -> ireg -> instruction) (mk2: ireg -> ireg -> instruction)
-    chunk addr args k ms sp rs m dst a v,
-  (forall cst (r1: ireg) (rs1: regset),
-    exec_instr ge fn (mk1 cst r1) rs1 m =
-    load1 ge chunk (preg_of dst) cst r1 rs1 m) ->
-  (forall (r1 r2: ireg) (rs1: regset),
-    exec_instr ge fn (mk2 r1 r2) rs1 m =
-    load2 chunk (preg_of dst) r1 r2 rs1 m) ->
-  agree ms sp rs ->
-  map mreg_type args = type_of_addressing addr ->
-  eval_addressing ge sp addr (map ms args) = Some a ->
-  Mem.loadv chunk m a = Some v ->
-  exists rs',
-    exec_straight (transl_load_store mk1 mk2 addr args k) rs m
-                        k rs' m
-  /\ agree (Regmap.set dst v ms) sp rs'.
-Proof.
-  intros. apply transl_load_store_correct with ms.
-  intros. exists (nextinstr (rs1#(preg_of dst) <- v)). 
-  split. apply exec_straight_one. rewrite H. 
-  unfold load1. rewrite gpr_or_zero_not_zero; auto. 
-  rewrite <- (eval_addressing_weaken _ _ _ _ H3) in H4.
-  rewrite H5 in H4. rewrite H4. auto.
-  auto with ppcgen. auto with ppcgen. 
-  intros. exists (nextinstr (rs1#(preg_of dst) <- v)). 
-  split. apply exec_straight_one. rewrite H0. 
-  unfold load2. 
-  rewrite <- (eval_addressing_weaken _ _ _ _ H3) in H4.
-  rewrite H5 in H4. rewrite H4. auto.
-  auto with ppcgen. auto with ppcgen. 
-  auto. auto.
-Qed.
-
-(** Translation of memory stores. *)
-
-Lemma transl_store_correct:
-  forall (mk1: constant -> ireg -> instruction) (mk2: ireg -> ireg -> instruction)
-    chunk addr args k ms sp rs m src a m',
-  (forall cst (r1: ireg) (rs1: regset),
-    exec_instr ge fn (mk1 cst r1) rs1 m =
-    store1 ge chunk (preg_of src) cst r1 rs1 m) ->
-  (forall (r1 r2: ireg) (rs1: regset),
-    exec_instr ge fn (mk2 r1 r2) rs1 m =
-    store2 chunk (preg_of src) r1 r2 rs1 m) ->
-  agree ms sp rs ->
-  map mreg_type args = type_of_addressing addr ->
-  eval_addressing ge sp addr (map ms args) = Some a ->
-  Mem.storev chunk m a (ms src) = Some m' ->
-  exists rs',
-    exec_straight (transl_load_store mk1 mk2 addr args k) rs m
-                        k rs' m'
-  /\ agree ms sp rs'.
-Proof.
-  intros.   apply transl_load_store_correct with ms.
-  intros. exists (nextinstr rs1). 
-  split. apply exec_straight_one. rewrite H. 
-  unfold store1. rewrite gpr_or_zero_not_zero; auto. 
-  rewrite <- (eval_addressing_weaken _ _ _ _ H3) in H4.
-  rewrite H5 in H4. elim H6; intros. rewrite H9 in H4.
-  rewrite H4. auto.
-  auto with ppcgen. auto with ppcgen. 
-  intros. exists (nextinstr rs1).
-  split. apply exec_straight_one. rewrite H0. 
-  unfold store2. 
-  rewrite <- (eval_addressing_weaken _ _ _ _ H3) in H4.
-  rewrite H5 in H4. elim H6; intros. rewrite H8 in H4.
-  rewrite H4. auto.
-  auto with ppcgen. auto with ppcgen. 
-  auto. auto.
-Qed.
-
-(** Translation of allocations *)
-
-Lemma transl_alloc_correct:
-  forall ms sp rs sz m m' blk k,
-  agree ms sp rs ->
-  ms Conventions.loc_alloc_argument = Vint sz ->
-  Mem.alloc m 0 (Int.signed sz) = (m', blk) ->
-  let ms' := Regmap.set Conventions.loc_alloc_result (Vptr blk Int.zero) ms in
-  exists rs',
-    exec_straight (Pallocblock :: k) rs m k rs' m'
-  /\ agree ms' sp rs'.
-Proof.
-  intros. 
-  pose (rs' := nextinstr (rs#GPR3 <- (Vptr blk Int.zero) #LR <- (Val.add rs#PC Vone))).
-  exists rs'; split.
-  apply exec_straight_one. unfold exec_instr. 
-  generalize (preg_val _ _ _ Conventions.loc_alloc_argument H).
-  unfold preg_of; intro. simpl in H2. rewrite <- H2. rewrite H0.
-  rewrite H1. reflexivity.
-  reflexivity. 
-  unfold ms', rs'. apply agree_nextinstr. apply agree_set_other. 
-  change (IR GPR3) with (preg_of Conventions.loc_alloc_result).
-  apply agree_set_mreg. auto.
-  simpl. tauto.
-Qed.
-
-End STRAIGHTLINE.
-
diff --git a/backend/PPCgenretaddr.v b/backend/PPCgenretaddr.v
deleted file mode 100644
index eab8599e..00000000
--- a/backend/PPCgenretaddr.v
+++ /dev/null
@@ -1,188 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** Predictor for return addresses in generated PPC 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 Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Mem.
-Require Import Globalenvs.
-Require Import Op.
-Require Import Locations.
-Require Import Mach.
-Require Import PPC.
-Require Import PPCgen.
-
-(** 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 PPC code obtained by translating the
-  code of [f]. Graphically:
-<<
-     Mach function f    |--------- Mcall ---------|
-         Mach code c    |                |--------|
-                        |                 \        \
-                        |                  \        \
-                        |                   \        \
-     PPC code           |                    |--------|
-     PPC function       |--------------- Pbl ---------|
-
-                        <-------- ofs ------->
->>
-*)
-
-Inductive return_address_offset: Mach.function -> Mach.code -> int -> Prop :=
-  | return_address_offset_intro:
-      forall c f ofs,
-      code_tail ofs (transl_function f) (transl_code f c) ->
-      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.
-
-Lemma loadimm_tail:
-  forall r n k, is_tail k (loadimm r n k).
-Proof. unfold loadimm; intros; IsTail. Qed.
-Hint Resolve loadimm_tail: ppcretaddr.
-
-Lemma addimm_tail:
-  forall r1 r2 n k, is_tail k (addimm r1 r2 n k).
-Proof. unfold addimm, addimm_1, addimm_2; intros; IsTail. Qed.
-Hint Resolve addimm_tail: ppcretaddr.
-
-Lemma andimm_tail:
-  forall r1 r2 n k, is_tail k (andimm r1 r2 n k).
-Proof. unfold andimm; intros; IsTail. Qed.
-Hint Resolve andimm_tail: ppcretaddr.
-
-Lemma orimm_tail:
-  forall r1 r2 n k, is_tail k (orimm r1 r2 n k).
-Proof. unfold orimm; intros; IsTail. Qed.
-Hint Resolve orimm_tail: ppcretaddr.
-
-Lemma xorimm_tail:
-  forall r1 r2 n k, is_tail k (xorimm r1 r2 n k).
-Proof. unfold xorimm; intros; IsTail. Qed.
-Hint Resolve xorimm_tail: ppcretaddr.
-
-Lemma loadind_tail:
-  forall base ofs ty dst k, is_tail k (loadind base ofs ty dst k).
-Proof. unfold loadind; intros; IsTail. Qed.
-Hint Resolve loadind_tail: ppcretaddr.
-
-Lemma storeind_tail:
-  forall src base ofs ty k, is_tail k (storeind src base ofs ty k).
-Proof. unfold storeind; intros; IsTail. Qed.
-Hint Resolve storeind_tail: ppcretaddr.
-
-Lemma floatcomp_tail:
-  forall cmp r1 r2 k, is_tail k (floatcomp cmp r1 r2 k).
-Proof. unfold floatcomp; intros; destruct cmp; IsTail. Qed.
-Hint Resolve floatcomp_tail: ppcretaddr.
-
-Lemma transl_cond_tail:
-  forall cond args k, is_tail k (transl_cond cond args k).
-Proof. unfold transl_cond; intros; destruct cond; IsTail. Qed.
-Hint Resolve transl_cond_tail: ppcretaddr.
-
-Lemma transl_op_tail:
-  forall op args r k, is_tail k (transl_op op args r k).
-Proof. unfold transl_op; intros; destruct op; IsTail. Qed.
-Hint Resolve transl_op_tail: ppcretaddr.
-
-Lemma transl_load_store_tail:
-  forall mk1 mk2 addr args k,
-  is_tail k (transl_load_store mk1 mk2 addr args k).
-Proof. unfold transl_load_store; intros; destruct addr; IsTail. Qed.
-Hint Resolve transl_load_store_tail: ppcretaddr.
-
-Lemma transl_instr_tail:
-  forall f i k, is_tail k (transl_instr f i k).
-Proof.
-  unfold transl_instr; intros; destruct i; IsTail.
-  destruct m; IsTail.
-  destruct m; IsTail.
-  destruct s0; IsTail.
-  destruct s0; IsTail.
-Qed.
-Hint Resolve transl_instr_tail: ppcretaddr.
-
-Lemma transl_code_tail: 
-  forall f c1 c2, is_tail c1 c2 -> is_tail (transl_code f c1) (transl_code f c2).
-Proof.
-  induction 1; simpl. constructor. eapply is_tail_trans; eauto with ppcretaddr.
-Qed.
-
-Lemma return_address_exists:
-  forall f c, is_tail c f.(fn_code) ->
-  exists ra, return_address_offset f c ra.
-Proof.
-  intros. assert (is_tail (transl_code f c) (transl_function f)).
-  unfold transl_function. IsTail. apply transl_code_tail; auto.
-  destruct (is_tail_code_tail _ _ H0) as [ofs A].
-  exists (Int.repr ofs). constructor. auto.
-Qed.
-
- 
diff --git a/backend/RTLgenaux.ml b/backend/RTLgenaux.ml
new file mode 100644
index 00000000..4c1fc05c
--- /dev/null
+++ b/backend/RTLgenaux.ml
@@ -0,0 +1,72 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+open Camlcoq
+open Switch
+open CminorSel
+
+let more_likely (c: condexpr) (ifso: stmt) (ifnot: stmt) = false
+
+module IntOrd =
+  struct
+    type t = Integers.int
+    let compare x y =
+      if Integers.Int.eq x y then 0 else
+      if Integers.Int.ltu x y then -1 else 1
+  end
+
+module IntSet = Set.Make(IntOrd)
+
+let normalize_table tbl =
+  let rec norm seen = function
+  | [] -> []
+  | Datatypes.Coq_pair(key, act) :: rem ->
+      if IntSet.mem key seen
+      then norm seen rem
+      else (key, act) :: norm (IntSet.add key seen) rem
+  in norm IntSet.empty tbl
+
+let compile_switch default table =
+  let sw = Array.of_list (normalize_table table) in
+  Array.stable_sort (fun (n1, _) (n2, _) -> IntOrd.compare n1 n2) sw;
+  let rec build lo hi minval maxval =
+    match hi - lo with
+    | 0 ->
+       CTaction default
+    | 1 ->
+       let (key, act) = sw.(lo) in
+       if Integers.Int.sub maxval minval = Integers.Int.zero
+       then CTaction act
+       else CTifeq(key, act, CTaction default)
+    | 2 ->
+       let (key1, act1) = sw.(lo)
+       and (key2, act2) = sw.(lo+1) in
+       CTifeq(key1, act1,
+         if Integers.Int.sub maxval minval = Integers.Int.one
+         then CTaction act2
+         else CTifeq(key2, act2, CTaction default))
+    | 3 ->
+       let (key1, act1) = sw.(lo)
+       and (key2, act2) = sw.(lo+1)
+       and (key3, act3) = sw.(lo+2) in
+       CTifeq(key1, act1, 
+        CTifeq(key2, act2,
+          if Integers.Int.sub maxval minval = coqint_of_camlint 2l
+          then CTaction act3
+          else CTifeq(key3, act3, CTaction default)))
+    | _ ->
+       let mid = (lo + hi) / 2 in
+       let (pivot, _) = sw.(mid) in
+       CTiflt(pivot,
+              build lo mid minval (Integers.Int.sub pivot Integers.Int.one),
+              build mid hi pivot maxval)
+  in build 0 (Array.length sw) Integers.Int.zero Integers.Int.max_unsigned
diff --git a/backend/RTLtypingaux.ml b/backend/RTLtypingaux.ml
new file mode 100644
index 00000000..ff704ebe
--- /dev/null
+++ b/backend/RTLtypingaux.ml
@@ -0,0 +1,156 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Type inference for RTL *)
+
+open Datatypes
+open CList
+open Camlcoq
+open Maps
+open AST
+open Op
+open Registers
+open RTL
+
+exception Type_error of string
+
+let env = ref (PTree.empty : typ PTree.t)
+
+let set_type r ty =
+  match PTree.get r !env with
+  | None -> env := PTree.set r ty !env
+  | Some ty' -> if ty <> ty' then raise (Type_error "type mismatch")
+
+let rec set_types rl tyl =
+  match rl, tyl with
+  | [], [] -> ()
+  | r1 :: rs, ty1 :: tys -> set_type r1 ty1; set_types rs tys
+  | _, _ -> raise (Type_error "arity mismatch")
+
+(* First pass: process constraints of the form typeof(r) = ty *)
+
+let type_instr retty (Coq_pair(pc, i)) =
+  match i with
+  | Inop(_) ->
+      ()
+  | Iop(Omove, _, _, _) -> 
+      ()
+  | Iop(op, args, res, _) ->
+      let (Coq_pair(targs, tres)) = type_of_operation op in
+      set_types args targs; set_type res tres
+  | Iload(chunk, addr, args, dst, _) ->
+      set_types args (type_of_addressing addr);
+      set_type dst (type_of_chunk chunk)
+  | Istore(chunk, addr, args, src, _) ->
+      set_types args (type_of_addressing addr);
+      set_type src (type_of_chunk chunk)
+  | Icall(sg, ros, args, res, _) ->
+      begin try
+        begin match ros with
+        | Coq_inl r -> set_type r Tint
+        | Coq_inr _ -> ()
+        end;
+        set_types args sg.sig_args;
+        set_type res (match sg.sig_res with None -> Tint | Some ty -> ty)
+      with Type_error msg ->
+        let name =
+          match ros with
+          | Coq_inl _ -> "<reg>"
+          | Coq_inr id -> extern_atom id in
+        raise(Type_error (Printf.sprintf "type mismatch in Icall(%s): %s"
+                                         name msg))
+      end
+  | Itailcall(sg, ros, args) ->
+      begin try
+        begin match ros with
+        | Coq_inl r -> set_type r Tint
+        | Coq_inr _ -> ()
+        end;
+        set_types args sg.sig_args;
+        if sg.sig_res <> retty then
+          raise (Type_error "mismatch on return type")
+      with Type_error msg ->
+        let name =
+          match ros with
+          | Coq_inl _ -> "<reg>"
+          | Coq_inr id -> extern_atom id in
+        raise(Type_error (Printf.sprintf "type mismatch in Itailcall(%s): %s"
+                                         name msg))
+      end
+  | Ialloc(arg, res, _) ->
+      set_type arg Tint; set_type res Tint
+  | Icond(cond, args, _, _) ->
+      set_types args (type_of_condition cond)
+  | Ireturn(optres) ->
+      begin match optres, retty with
+      | None, None -> ()
+      | Some r, Some ty -> set_type r ty
+      | _, _ -> raise (Type_error "type mismatch in Ireturn")
+      end
+
+let type_pass1 retty instrs = 
+  List.iter (type_instr retty) instrs
+
+(* Second pass: extract move constraints typeof(r1) = typeof(r2)
+   and solve them iteratively *)
+
+let rec extract_moves = function
+  | [] -> []
+  | Coq_pair(pc, i) :: rem ->
+      match i with
+      | Iop(Omove, [r1], r2, _) ->
+          (r1, r2) :: extract_moves rem
+      | Iop(Omove, _, _, _) ->
+          raise (Type_error "wrong Omove")
+      | _ ->
+          extract_moves rem
+
+let changed = ref false
+
+let rec solve_moves = function
+  | [] -> []
+  | (r1, r2) :: rem ->
+      match (PTree.get r1 !env, PTree.get r2 !env) with
+      | Some ty1, Some ty2 ->
+          if ty1 = ty2 
+          then (changed := true; solve_moves rem)
+          else raise (Type_error "type mismatch in Omove")
+      | Some ty1, None ->
+          env := PTree.set r2 ty1 !env; changed := true; solve_moves rem
+      | None, Some ty2 ->
+          env := PTree.set r1 ty2 !env; changed := true; solve_moves rem
+      | None, None ->
+          (r1, r2) :: solve_moves rem
+
+let rec iter_solve_moves mvs =
+  changed := false;
+  let mvs' = solve_moves mvs in
+  if !changed then iter_solve_moves mvs'
+
+let type_pass2 instrs =
+  iter_solve_moves (extract_moves instrs)
+
+let typeof e r =
+  match PTree.get r e with Some ty -> ty | None -> Tint
+
+let infer_type_environment f instrs =
+  try
+    env := PTree.empty;
+    set_types f.fn_params f.fn_sig.sig_args;
+    type_pass1 f.fn_sig.sig_res instrs;
+    type_pass2 instrs;
+    let e = !env in
+    env := PTree.empty;
+    Some(typeof e)
+  with Type_error msg ->
+    Printf.eprintf "Error during RTL type inference: %s\n" msg;
+    None
diff --git a/backend/Reloadproof.v b/backend/Reloadproof.v
index 3a96d3a2..5a3acd31 100644
--- a/backend/Reloadproof.v
+++ b/backend/Reloadproof.v
@@ -1017,7 +1017,7 @@ Proof.
   intros [ls2 [A [B C]]].
   assert (exists ta, eval_addressing tge sp addr (reglist ls2 (regs_for args)) = Some ta
                      /\ Val.lessdef a ta).
-    apply eval_addressing_lessdef with (map rs args); auto.
+    apply eval_addressing_lessdef with (map rs args).
     rewrite B. eapply agree_locs; eauto. 
     rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
   destruct H1 as [ta [P Q]].
@@ -1047,7 +1047,7 @@ Proof.
   simpl in B.
   assert (exists ta, eval_addressing tge sp addr (reglist ls2 rargs) = Some ta
                      /\ Val.lessdef a ta).
-    apply eval_addressing_lessdef with (map rs args); auto.
+    apply eval_addressing_lessdef with (map rs args).
     rewrite D. eapply agree_locs; eauto. 
     rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
   destruct H1 as [ta [P Q]].
@@ -1072,7 +1072,7 @@ Proof.
     apply locs_acceptable_disj_temporaries; auto.
   assert (exists ta, eval_addressing tge sp addr (reglist ls2 (regs_for args)) = Some ta
                      /\ Val.lessdef a ta).
-    apply eval_addressing_lessdef with (map rs args); auto.
+    apply eval_addressing_lessdef with (map rs args).
     rewrite B. eapply agree_locs; eauto. 
     rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
   destruct H1 as [ta [P Q]].
diff --git a/backend/Selection.v b/backend/Selection.v
deleted file mode 100644
index 1de6ae3c..00000000
--- a/backend/Selection.v
+++ /dev/null
@@ -1,1196 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** Instruction selection *)
-
-(** 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.
-
-  Instruction selection proceeds by bottom-up rewriting over expressions.
-  The source language is Cminor and the target language is CminorSel. *)
-
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Mem.
-Require Import Globalenvs.
-Require Cminor.
-Require Import Op.
-Require Import CminorSel.
-
-Infix ":::" := Econs (at level 60, right associativity) : selection_scope.
-
-Open Local Scope selection_scope.
-
-(** * Lifting of let-bound variables *)
-
-(** Some of the instruction functions generate [Elet] constructs to
-  share the evaluation of a subexpression.  Owing to the use of de
-  Bruijn indices for let-bound variables, we need to shift de Bruijn
-  indices when an expression [b] is put in a [Elet a b] context. *)
-
-Fixpoint lift_expr (p: nat) (a: expr) {struct a}: expr :=
-  match a with
-  | Evar id => Evar id
-  | Eop op bl => Eop op (lift_exprlist p bl)
-  | Eload chunk addr bl => Eload chunk addr (lift_exprlist p bl)
-  | Econdition b c d =>
-      Econdition (lift_condexpr p b) (lift_expr p c) (lift_expr p d)
-  | Elet b c => Elet (lift_expr p b) (lift_expr (S p) c)
-  | Eletvar n =>
-      if le_gt_dec p n then Eletvar (S n) else Eletvar n
-  end
-
-with lift_condexpr (p: nat) (a: condexpr) {struct a}: condexpr :=
-  match a with
-  | CEtrue => CEtrue
-  | CEfalse => CEfalse
-  | CEcond cond bl => CEcond cond (lift_exprlist p bl)
-  | CEcondition b c d =>
-      CEcondition (lift_condexpr p b) (lift_condexpr p c) (lift_condexpr p d)
-  end
-
-with lift_exprlist (p: nat) (a: exprlist) {struct a}: exprlist :=
-  match a with
-  | Enil => Enil
-  | Econs b cl => Econs (lift_expr p b) (lift_exprlist p cl)
-  end.
-
-Definition lift (a: expr): expr := lift_expr O a.
-
-(** * Smart constructors for operators *)
-
-(** This section 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.
-*)
-
-(** ** Integer logical negation *)
-
-(** The natural way to write smart constructors is by pattern-matching
-  on their arguments, recognizing cases where cheaper operators
-  or combined operators are applicable.  For instance, integer logical
-  negation has three special cases (not-and, not-or and not-xor),
-  along with a default case that uses not-or over its arguments and itself.
-  This is written naively as follows:
-<<
-Definition notint (e: expr) :=
-  match e with
-  | Eop Oand (t1:::t2:::Enil) => Eop Onand (t1:::t2:::Enil)
-  | Eop Oor (t1:::t2:::Enil) => Eop Onor (t1:::t2:::Enil)
-  | Eop Oxor (t1:::t2:::Enil) => Eop Onxor (t1:::t2:::Enil)
-  | _ => Elet(e, Eop Onor (Eletvar O ::: Eletvar O ::: Enil)
-  end.
->>
-  However, Coq expands complex pattern-matchings like the above into
-  elementary matchings over all constructors of an inductive type,
-  resulting in much duplication of the final catch-all case.
-  Such duplications generate huge executable code and duplicate
-  cases in the correctness proofs.
-
-  To limit this duplication, we use the following trick due to
-  Yves Bertot.  We first define a dependent inductive type that
-  characterizes the expressions that match each of the 4 cases of interest.
-*)
-
-Inductive notint_cases: forall (e: expr), Set :=
-  | notint_case1:
-      forall (t1: expr) (t2: expr),
-      notint_cases (Eop Oand (t1:::t2:::Enil))
-  | notint_case2:
-      forall (t1: expr) (t2: expr),
-      notint_cases (Eop Oor (t1:::t2:::Enil))
-  | notint_case3:
-      forall (t1: expr) (t2: expr),
-      notint_cases (Eop Oxor (t1:::t2:::Enil))
-  | notint_default:
-      forall (e: expr),
-      notint_cases e.
-
-(** We then define a classification function that takes an expression
-  and return the case in which it falls.  Note that the catch-all case
-  [notint_default] does not state that it is mutually exclusive with
-  the first three, more specific cases.  The classification function
-  nonetheless chooses the specific cases in preference to the catch-all
-  case. *)
-
-Definition notint_match (e: expr) :=
-  match e as z1 return notint_cases z1 with
-  | Eop Oand (t1:::t2:::Enil) =>
-      notint_case1 t1 t2
-  | Eop Oor (t1:::t2:::Enil) =>
-      notint_case2 t1 t2
-  | Eop Oxor (t1:::t2:::Enil) =>
-      notint_case3 t1 t2
-  | e =>
-      notint_default e
-  end.
-
-(** Finally, the [notint] function we need is defined by a 4-case match
-  over the result of the classification function.  Thus, no duplication
-  of the right-hand sides of this match occur, and the proof has only
-  4 cases to consider (it proceeds by case over [notint_match e]).
-  Since the default case is not obviously exclusive with the three
-  specific cases, it is important that its right-hand side is
-  semantically correct for all possible values of [e], which is the
-  case here and for all other smart constructors. *)
-
-Definition notint (e: expr) :=
-  match notint_match e with
-  | notint_case1 t1 t2 =>
-      Eop Onand (t1:::t2:::Enil)
-  | notint_case2 t1 t2 =>
-      Eop Onor (t1:::t2:::Enil)
-  | notint_case3 t1 t2 =>
-      Eop Onxor (t1:::t2:::Enil)
-  | notint_default e =>
-      Elet e (Eop Onor (Eletvar O ::: Eletvar O ::: Enil))
-  end.
-
-(** This programming pattern will be applied systematically for the
-  other smart constructors in this file. *)
-
-(** ** 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 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 (Oaddrsymbol s m) Enil   => Eop (Oaddrsymbol s (Int.add n m)) Enil
-  | Eop (Oaddrstack m) Enil      => Eop (Oaddrstack (Int.add n m)) Enil
-  | Eop (Oaddimm m) (t ::: Enil) => Eop (Oaddimm(Int.add n m)) (t ::: Enil)
-  | _                            => Eop (Oaddimm n) (e ::: Enil)
-  end.
-*)
-
-(** Addition of an integer constant. *)
-
-Inductive addimm_cases: forall (e: expr), Set :=
-  | addimm_case1:
-      forall (m: int),
-      addimm_cases (Eop (Ointconst m) Enil)
-  | addimm_case2:
-      forall (s: ident) (m: int),
-      addimm_cases (Eop (Oaddrsymbol s m) Enil)
-  | addimm_case3:
-      forall (m: int),
-      addimm_cases (Eop (Oaddrstack m) Enil)
-  | addimm_case4:
-      forall (m: int) (t: expr),
-      addimm_cases (Eop (Oaddimm m) (t ::: Enil))
-  | 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 (Oaddrsymbol s m) Enil =>
-      addimm_case2 s m
-  | Eop (Oaddrstack m) Enil =>
-      addimm_case3 m
-  | Eop (Oaddimm m) (t ::: Enil) =>
-      addimm_case4 m t
-  | 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 s m =>
-      Eop (Oaddrsymbol s (Int.add n m)) Enil
-  | addimm_case3 m =>
-      Eop (Oaddrstack (Int.add n m)) Enil
-  | addimm_case4 m t =>
-      Eop (Oaddimm(Int.add n m)) (t ::: Enil)
-  | addimm_default e =>
-      Eop (Oaddimm 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
-  | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => addimm (Int.add n1 n2) (Eop Oadd (t1:::t2:::Enil))
-  | Eop(Oaddimm n1) (t1:::Enil)), t2 => addimm n1 (Eop Oadd (t1:::t2:::Enil))
-  | t1, Eop (Ointconst n2) Enil => addimm n2 t1
-  | t1, Eop (Oaddimm n2) (t2:::Enil) => addimm n2 (Eop Oadd (t1:::t2:::Enil))
-  | _, _ => Eop Oadd (e1:::e2:::Enil)
-  end.
-*)
-
-Inductive add_cases: forall (e1: expr) (e2: expr), Set :=
-  | add_case1:
-      forall (n1: int) (t2: expr),
-      add_cases (Eop (Ointconst n1) Enil) (t2)
-  | add_case2:
-      forall (n1: int) (t1: expr) (n2: int) (t2: expr),
-      add_cases (Eop (Oaddimm n1) (t1:::Enil)) (Eop (Oaddimm n2) (t2:::Enil))
-  | add_case3:
-      forall (n1: int) (t1: expr) (t2: expr),
-      add_cases (Eop(Oaddimm n1) (t1:::Enil)) (t2)
-  | add_case4:
-      forall (t1: expr) (n2: int),
-      add_cases (t1) (Eop (Ointconst n2) Enil)
-  | add_case5:
-      forall (t1: expr) (n2: int) (t2: expr),
-      add_cases (t1) (Eop (Oaddimm n2) (t2:::Enil))
-  | add_default:
-      forall (e1: expr) (e2: expr),
-      add_cases e1 e2.
-
-Definition add_match_aux (e1: expr) (e2: expr) :=
-  match e2 as z2 return add_cases e1 z2 with
-  | Eop (Ointconst n2) Enil =>
-      add_case4 e1 n2
-  | Eop (Oaddimm n2) (t2:::Enil) =>
-      add_case5 e1 n2 t2
-  | e2 =>
-      add_default e1 e2
-  end.
-
-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
-  | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) =>
-      add_case2 n1 t1 n2 t2
-  | Eop(Oaddimm n1) (t1:::Enil), t2 =>
-      add_case3 n1 t1 t2
-  | e1, e2 =>
-      add_match_aux e1 e2
-  end.
-
-Definition add (e1: expr) (e2: expr) :=
-  match add_match e1 e2 with
-  | add_case1 n1 t2 =>
-      addimm n1 t2
-  | add_case2 n1 t1 n2 t2 =>
-      addimm (Int.add n1 n2) (Eop Oadd (t1:::t2:::Enil))
-  | add_case3 n1 t1 t2 =>
-      addimm n1 (Eop Oadd (t1:::t2:::Enil))
-  | add_case4 t1 n2 =>
-      addimm n2 t1
-  | add_case5 t1 n2 t2 =>
-      addimm n2 (Eop Oadd (t1:::t2:::Enil))
-  | add_default e1 e2 =>
-      Eop Oadd (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 (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => addimm 
-(intsub n1 n2) (Eop Osub (t1:::t2:::Enil))
-  | Eop (Oaddimm n1) (t1:::Enil), t2 => addimm n1 (Eop Osub (t1:::t2:::Rni
-l))
-  | t1, Eop (Oaddimm 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), Set :=
-  | sub_case1:
-      forall (t1: expr) (n2: int),
-      sub_cases (t1) (Eop (Ointconst n2) Enil)
-  | sub_case2:
-      forall (n1: int) (t1: expr) (n2: int) (t2: expr),
-      sub_cases (Eop (Oaddimm n1) (t1:::Enil)) (Eop (Oaddimm n2) (t2:::Enil))
-  | sub_case3:
-      forall (n1: int) (t1: expr) (t2: expr),
-      sub_cases (Eop (Oaddimm n1) (t1:::Enil)) (t2)
-  | sub_case4:
-      forall (t1: expr) (n2: int) (t2: expr),
-      sub_cases (t1) (Eop (Oaddimm n2) (t2:::Enil))
-  | sub_default:
-      forall (e1: expr) (e2: expr),
-      sub_cases e1 e2.
-
-Definition sub_match_aux (e1: expr) (e2: expr) :=
-  match e1 as z1 return sub_cases z1 e2 with
-  | Eop (Oaddimm n1) (t1:::Enil) =>
-      sub_case3 n1 t1 e2
-  | e1 =>
-      sub_default e1 e2
-  end.
-
-Definition sub_match (e1: expr) (e2: expr) :=
-  match e2 as z2, e1 as z1 return sub_cases z1 z2 with
-  | Eop (Ointconst n2) Enil, t1 =>
-      sub_case1 t1 n2
-  | Eop (Oaddimm n2) (t2:::Enil), Eop (Oaddimm n1) (t1:::Enil) =>
-      sub_case2 n1 t1 n2 t2
-  | Eop (Oaddimm n2) (t2:::Enil), t1 =>
-      sub_case4 t1 n2 t2
-  | e2, e1 =>
-      sub_match_aux 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.
-
-(** ** Rotates and immediate shifts *)
-
-(*
-Definition rolm (e1: expr) :=
-  match e1 with
-  | Eop (Ointconst n1) Enil =>
-      Eop (Ointconst(Int.and (Int.rol n1 amount2) mask2)) Enil
-  | Eop (Orolm amount1 mask1) (t1:::Enil) =>
-      let amount := Int.and (Int.add amount1 amount2) Ox1Fl in
-      let mask := Int.and (Int.rol mask1 amount2) mask2 in
-      if Int.is_rlw_mask mask
-      then Eop (Orolm amount mask) (t1:::Enil)
-      else Eop (Orolm amount2 mask2) (e1:::Enil)
-  | _ => Eop (Orolm amount2 mask2) (e1:::Enil)
-  end
-*)
-
-Inductive rolm_cases: forall (e1: expr), Set :=
-  | rolm_case1:
-      forall (n1: int),
-      rolm_cases (Eop (Ointconst n1) Enil)
-  | rolm_case2:
-      forall (amount1: int) (mask1: int) (t1: expr),
-      rolm_cases (Eop (Orolm amount1 mask1) (t1:::Enil))
-  | rolm_default:
-      forall (e1: expr),
-      rolm_cases e1.
-
-Definition rolm_match (e1: expr) :=
-  match e1 as z1 return rolm_cases z1 with
-  | Eop (Ointconst n1) Enil =>
-      rolm_case1 n1
-  | Eop (Orolm amount1 mask1) (t1:::Enil) =>
-      rolm_case2 amount1 mask1 t1
-  | e1 =>
-      rolm_default e1
-  end.
-
-Definition rolm (e1: expr) (amount2 mask2: int) :=
-  match rolm_match e1 with
-  | rolm_case1 n1 =>
-      Eop (Ointconst(Int.and (Int.rol n1 amount2) mask2)) Enil
-  | rolm_case2 amount1 mask1 t1 =>
-      let amount := Int.and (Int.add amount1 amount2) (Int.repr 31) in
-      let mask := Int.and (Int.rol mask1 amount2) mask2 in
-      if Int.is_rlw_mask mask
-      then Eop (Orolm amount mask) (t1:::Enil)
-      else Eop (Orolm amount2 mask2) (e1:::Enil)
-  | rolm_default e1 =>
-      Eop (Orolm amount2 mask2) (e1:::Enil)
-  end.
-
-Definition shlimm (e1: expr) (n2: int) :=
-  if Int.eq n2 Int.zero then
-    e1
-  else if Int.ltu n2 (Int.repr 32) then
-    rolm e1 n2 (Int.shl Int.mone n2)
-  else
-    Eop Oshl (e1:::Eop (Ointconst n2) Enil:::Enil).
-
-Definition shruimm (e1: expr) (n2: int) :=
-  if Int.eq n2 Int.zero then
-    e1
-  else if Int.ltu n2 (Int.repr 32) then
-    rolm e1 (Int.sub (Int.repr 32) n2) (Int.shru Int.mone n2)
-  else
-    Eop Oshru (e1:::Eop (Ointconst n2) Enil:::Enil).
-
-(** ** 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
-        (Eop Oadd (shlimm (Eletvar 0) i :::
-                   shlimm (Eletvar 0) j ::: Enil))
-  | _ =>
-      Eop (Omulimm n1) (e2:::Enil)
-  end.
-
-(*
-Definition mulimm (n1: int) (e2: expr) :=
-  if Int.eq n1 Int.zero then 
-    Elet e2 (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 (Oaddimm n2) (t2:::Enil) => addimm (intmul n1 n2) (mulimm_base n1 t2)
-  | _ => mulimm_base n1 e2
-  end.
-*)
-
-Inductive mulimm_cases: forall (e2: expr), Set :=
-  | mulimm_case1:
-      forall (n2: int),
-      mulimm_cases (Eop (Ointconst n2) Enil)
-  | mulimm_case2:
-      forall (n2: int) (t2: expr),
-      mulimm_cases (Eop (Oaddimm 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 (Oaddimm 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 
-    Elet e2 (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), Set :=
-  | 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.
-
-(** ** Integer division and modulus *)
-
-Definition divs (e1: expr) (e2: expr) := Eop Odiv (e1:::e2:::Enil).
-
-Definition mod_aux (divop: operation) (e1 e2: expr) :=
-  Elet e1
-    (Elet (lift e2)
-      (Eop Osub (Eletvar 1 :::
-                 Eop Omul (Eop divop (Eletvar 1 ::: Eletvar 0 ::: Enil) :::
-                           Eletvar 0 :::
-                           Enil) :::
-                 Enil))).
-
-Definition mods := mod_aux Odiv.
-
-Inductive divu_cases: forall (e2: expr), Set :=
-  | divu_case1:
-      forall (n2: int),
-      divu_cases (Eop (Ointconst n2) Enil)
-  | divu_default:
-      forall (e2: expr),
-      divu_cases e2.
-
-Definition divu_match (e2: expr) :=
-  match e2 as z1 return divu_cases z1 with
-  | Eop (Ointconst n2) Enil =>
-      divu_case1 n2
-  | e2 =>
-      divu_default e2
-  end.
-
-Definition divu (e1: expr) (e2: expr) :=
-  match divu_match e2 with
-  | divu_case1 n2 =>
-      match Int.is_power2 n2 with
-      | Some l2 => shruimm e1 l2
-      | None    => Eop Odivu (e1:::e2:::Enil)
-      end
-  | divu_default e2 =>
-      Eop Odivu (e1:::e2:::Enil)
-  end.
-
-Definition modu (e1: expr) (e2: expr) :=
-  match divu_match e2 with
-  | divu_case1 n2 =>
-      match Int.is_power2 n2 with
-      | Some l2 => rolm e1 Int.zero (Int.sub n2 Int.one)
-      | None    => mod_aux Odivu e1 e2
-      end
-  | divu_default e2 =>
-      mod_aux Odivu e1 e2
-  end.
-
-(** ** Bitwise and, or, xor *)
-
-Definition andimm (n1: int) (e2: expr) :=
-  if Int.is_rlw_mask n1
-  then rolm e2 Int.zero n1
-  else Eop (Oandimm n1) (e2:::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 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.
-
-Inductive or_cases: forall (e1: expr) (e2: expr), Set :=
-  | or_case1:
-      forall (amount1: int) (mask1: int) (t1: expr)
-             (amount2: int) (mask2: int) (t2: expr),
-      or_cases (Eop (Orolm amount1  mask1) (t1:::Enil)) 
-               (Eop (Orolm amount2 mask2) (t2:::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 (Orolm amount1  mask1) (t1:::Enil),
-    Eop (Orolm amount2 mask2) (t2:::Enil) =>
-      or_case1 amount1 mask1 t1 amount2 mask2 t2
-  | e1, e2 =>
-      or_default e1 e2
-  end.
-
-Definition or (e1: expr) (e2: expr) :=
-  match or_match e1 e2 with
-  | or_case1 amount1 mask1 t1 amount2 mask2 t2 =>
-      if Int.eq amount1 amount2
-      && Int.is_rlw_mask (Int.or mask1 mask2)
-      && same_expr_pure t1 t2
-      then Eop (Orolm amount1 (Int.or mask1 mask2)) (t1:::Enil)
-      else Eop Oor (e1:::e2:::Enil)
-  | or_default e1 e2 =>
-      Eop Oor (e1:::e2:::Enil)
-  end.
-
-(** ** General shifts *)
-
-Inductive shift_cases: forall (e1: expr), Set :=
-  | 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.
-
-(** ** Floating-point arithmetic *)
-
-Parameter use_fused_mul : unit -> bool.
-
-(*
-Definition addf (e1: expr) (e2: expr) :=
-  match e1, e2 with
-  | Eop Omulf (t1:::t2:::Enil), t3 => Eop Omuladdf (t1:::t2:::t3:::Enil)
-  | t1, Eop Omulf (t2:::t3:::Enil) => Elet t1 (Eop Omuladdf (t2:::t3:::Rvar 0:::Enil))
-  | _, _ => Eop Oaddf (e1:::e2:::Enil)
-  end.
-*)
-
-Inductive addf_cases: forall (e1: expr) (e2: expr), Set :=
-  | addf_case1:
-      forall (t1: expr) (t2: expr) (t3: expr),
-      addf_cases (Eop Omulf (t1:::t2:::Enil)) (t3)
-  | addf_case2:
-      forall (t1: expr) (t2: expr) (t3: expr),
-      addf_cases (t1) (Eop Omulf (t2:::t3:::Enil))
-  | addf_default:
-      forall (e1: expr) (e2: expr),
-      addf_cases e1 e2.
-
-Definition addf_match_aux (e1: expr) (e2: expr) :=
-  match e2 as z2 return addf_cases e1 z2 with
-  | Eop Omulf (t2:::t3:::Enil) =>
-      addf_case2 e1 t2 t3
-  | e2 =>
-      addf_default e1 e2
-  end.
-
-Definition addf_match (e1: expr) (e2: expr) :=
-  match e1 as z1 return addf_cases z1 e2 with
-  | Eop Omulf (t1:::t2:::Enil) =>
-      addf_case1 t1 t2 e2
-  | e1 =>
-      addf_match_aux e1 e2
-  end.
-
-Definition addf (e1: expr) (e2: expr) :=
-  if use_fused_mul tt then
-    match addf_match e1 e2 with
-    | addf_case1 t1 t2 t3 =>
-        Eop Omuladdf (t1:::t2:::t3:::Enil)
-    | addf_case2 t1 t2 t3 =>
-        Eop Omuladdf (t2:::t3:::t1:::Enil)
-    | addf_default e1 e2 =>
-        Eop Oaddf (e1:::e2:::Enil)
-    end
-  else Eop Oaddf (e1:::e2:::Enil).
-
-(*
-Definition subf (e1: expr) (e2: expr) :=
-  match e1, e2 with
-  | Eop Omulfloat (t1:::t2:::Enil), t3 => Eop Omulsubf (t1:::t2:::t3:::Enil)
-  | _, _ => Eop Osubf (e1:::e2:::Enil)
-  end.
-*)
-
-Inductive subf_cases: forall (e1: expr) (e2: expr), Set :=
-  | subf_case1:
-      forall (t1: expr) (t2: expr) (t3: expr),
-      subf_cases (Eop Omulf (t1:::t2:::Enil)) (t3)
-  | subf_default:
-      forall (e1: expr) (e2: expr),
-      subf_cases e1 e2.
-
-Definition subf_match (e1: expr) (e2: expr) :=
-  match e1 as z1 return subf_cases z1 e2 with
-  | Eop Omulf (t1:::t2:::Enil) =>
-      subf_case1 t1 t2 e2
-  | e1 =>
-      subf_default e1 e2
-  end.
-
-Definition subf (e1: expr) (e2: expr) :=
-  if use_fused_mul tt then
-    match subf_match e1 e2 with
-    | subf_case1 t1 t2 t3 =>
-        Eop Omulsubf (t1:::t2:::t3:::Enil)
-    | subf_default e1 e2 =>
-        Eop Osubf (e1:::e2:::Enil)
-    end
-  else Eop Osubf (e1:::e2:::Enil).
-
-(** ** Truncations and sign extensions *)
-
-Inductive cast8signed_cases: forall (e1: expr), Set :=
-  | cast8signed_case1:
-      forall (e2: expr),
-      cast8signed_cases (Eop Ocast8signed (e2 ::: Enil))
-  | cast8signed_default:
-      forall (e1: expr),
-      cast8signed_cases e1.
-
-Definition cast8signed_match (e1: expr) :=
-  match e1 as z1 return cast8signed_cases z1 with
-  | Eop Ocast8signed (e2 ::: Enil) =>
-      cast8signed_case1 e2
-  | e1 =>
-      cast8signed_default e1
-  end.
-
-Definition cast8signed (e: expr) := 
-  match cast8signed_match e with
-  | cast8signed_case1 e1 => e
-  | cast8signed_default e1 => Eop Ocast8signed (e1 ::: Enil)
-  end.
-
-Inductive cast8unsigned_cases: forall (e1: expr), Set :=
-  | cast8unsigned_case1:
-      forall (e2: expr),
-      cast8unsigned_cases (Eop Ocast8unsigned (e2 ::: Enil))
-  | cast8unsigned_default:
-      forall (e1: expr),
-      cast8unsigned_cases e1.
-
-Definition cast8unsigned_match (e1: expr) :=
-  match e1 as z1 return cast8unsigned_cases z1 with
-  | Eop Ocast8unsigned (e2 ::: Enil) =>
-      cast8unsigned_case1 e2
-  | e1 =>
-      cast8unsigned_default e1
-  end.
-
-Definition cast8unsigned (e: expr) := 
-  match cast8unsigned_match e with
-  | cast8unsigned_case1 e1 => e
-  | cast8unsigned_default e1 => Eop Ocast8unsigned (e1 ::: Enil)
-  end.
-
-Inductive cast16signed_cases: forall (e1: expr), Set :=
-  | cast16signed_case1:
-      forall (e2: expr),
-      cast16signed_cases (Eop Ocast16signed (e2 ::: Enil))
-  | cast16signed_default:
-      forall (e1: expr),
-      cast16signed_cases e1.
-
-Definition cast16signed_match (e1: expr) :=
-  match e1 as z1 return cast16signed_cases z1 with
-  | Eop Ocast16signed (e2 ::: Enil) =>
-      cast16signed_case1 e2
-  | e1 =>
-      cast16signed_default e1
-  end.
-
-Definition cast16signed (e: expr) := 
-  match cast16signed_match e with
-  | cast16signed_case1 e1 => e
-  | cast16signed_default e1 => Eop Ocast16signed (e1 ::: Enil)
-  end.
-
-Inductive cast16unsigned_cases: forall (e1: expr), Set :=
-  | cast16unsigned_case1:
-      forall (e2: expr),
-      cast16unsigned_cases (Eop Ocast16unsigned (e2 ::: Enil))
-  | cast16unsigned_default:
-      forall (e1: expr),
-      cast16unsigned_cases e1.
-
-Definition cast16unsigned_match (e1: expr) :=
-  match e1 as z1 return cast16unsigned_cases z1 with
-  | Eop Ocast16unsigned (e2 ::: Enil) =>
-      cast16unsigned_case1 e2
-  | e1 =>
-      cast16unsigned_default e1
-  end.
-
-Definition cast16unsigned (e: expr) := 
-  match cast16unsigned_match e with
-  | cast16unsigned_case1 e1 => e
-  | cast16unsigned_default e1 => Eop Ocast16unsigned (e1 ::: Enil)
-  end.
-
-Inductive singleoffloat_cases: forall (e1: expr), Set :=
-  | singleoffloat_case1:
-      forall (e2: expr),
-      singleoffloat_cases (Eop Osingleoffloat (e2 ::: Enil))
-  | singleoffloat_default:
-      forall (e1: expr),
-      singleoffloat_cases e1.
-
-Definition singleoffloat_match (e1: expr) :=
-  match e1 as z1 return singleoffloat_cases z1 with
-  | Eop Osingleoffloat (e2 ::: Enil) =>
-      singleoffloat_case1 e2
-  | e1 =>
-      singleoffloat_default e1
-  end.
-
-Definition singleoffloat (e: expr) := 
-  match singleoffloat_match e with
-  | singleoffloat_case1 e1 => e
-  | singleoffloat_default e1 => Eop Osingleoffloat (e1 ::: Enil)
-  end.
-
-(** ** Comparisons *)
-
-Inductive comp_cases: forall (e1: expr) (e2: expr), Set :=
-  | 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).
-
-(** ** Conditional expressions *)
-
-Fixpoint negate_condexpr (e: condexpr): condexpr :=
-  match e with
-  | CEtrue => CEfalse
-  | CEfalse => CEtrue
-  | CEcond c el => CEcond (negate_condition c) el
-  | CEcondition e1 e2 e3 =>
-      CEcondition e1 (negate_condexpr e2) (negate_condexpr e3)
-  end.
-
-
-Definition is_compare_neq_zero (c: condition) : bool :=
-  match c with
-  | Ccompimm Cne n => Int.eq n Int.zero
-  | Ccompuimm Cne n => Int.eq n Int.zero
-  | _ => false
-  end.
-
-Definition is_compare_eq_zero (c: condition) : bool :=
-  match c with
-  | Ccompimm Ceq n => Int.eq n Int.zero
-  | Ccompuimm Ceq n => Int.eq n Int.zero
-  | _ => false
-  end.
-
-Fixpoint condexpr_of_expr (e: expr) : condexpr :=
-  match e with
-  | Eop (Ointconst n) Enil =>
-      if Int.eq n Int.zero then CEfalse else CEtrue
-  | Eop (Ocmp c) (e1 ::: Enil) =>
-      if is_compare_neq_zero c then
-        condexpr_of_expr e1
-      else if is_compare_eq_zero c then
-        negate_condexpr (condexpr_of_expr e1)
-      else
-        CEcond c (e1 ::: Enil)
-  | Eop (Ocmp c) el =>
-      CEcond c el
-  | Econdition ce e1 e2 =>
-      CEcondition ce (condexpr_of_expr e1) (condexpr_of_expr e2)
-  | _ =>
-      CEcond (Ccompimm Cne Int.zero) (e:::Enil)
-  end.
-
-(** ** Recognition of addressing modes for load and store operations *)
-
-(*
-Definition addressing (e: expr) :=
-  match e with
-  | Eop (Oaddrsymbol s n) Enil => (Aglobal s n, Enil)
-  | Eop (Oaddrstack n) Enil => (Ainstack n, Enil)
-  | Eop Oadd (Eop (Oaddrsymbol s n) Enil) e2 => (Abased(s, n), e2:::Enil)
-  | Eop (Oaddimm n) (e1:::Enil) => (Aindexed n, e1:::Enil)
-  | Eop Oadd (e1:::e2:::Enil) => (Aindexed2, e1:::e2:::Enil)
-  | _ => (Aindexed Int.zero, e:::Enil)
-  end.
-*)
-
-Inductive addressing_cases: forall (e: expr), Set :=
-  | addressing_case1:
-      forall (s: ident) (n: int),
-      addressing_cases (Eop (Oaddrsymbol s n) Enil)
-  | addressing_case2:
-      forall (n: int),
-      addressing_cases (Eop (Oaddrstack n) Enil)
-  | addressing_case3:
-      forall (s: ident) (n: int) (e2: expr),
-      addressing_cases
-        (Eop Oadd (Eop (Oaddrsymbol s n) Enil:::e2:::Enil))
-  | addressing_case4:
-      forall (n: int) (e1: expr),
-      addressing_cases (Eop (Oaddimm n) (e1:::Enil))
-  | addressing_case5:
-      forall (e1: expr) (e2: expr),
-      addressing_cases (Eop Oadd (e1:::e2:::Enil))
-  | addressing_default:
-      forall (e: expr),
-      addressing_cases e.
-
-Definition addressing_match (e: expr) :=
-  match e as z1 return addressing_cases z1 with
-  | Eop (Oaddrsymbol s n) Enil =>
-      addressing_case1 s n
-  | Eop (Oaddrstack n) Enil =>
-      addressing_case2 n
-  | Eop Oadd (Eop (Oaddrsymbol s n) Enil:::e2:::Enil) =>
-      addressing_case3 s n e2
-  | Eop (Oaddimm n) (e1:::Enil) =>
-      addressing_case4 n e1
-  | Eop Oadd (e1:::e2:::Enil) =>
-      addressing_case5 e1 e2
-  | e =>
-      addressing_default e
-  end.
-
-Definition addressing (e: expr) :=
-  match addressing_match e with
-  | addressing_case1 s n =>
-      (Aglobal s n, Enil)
-  | addressing_case2 n =>
-      (Ainstack n, Enil)
-  | addressing_case3 s n e2 =>
-      (Abased s n, e2:::Enil)
-  | addressing_case4 n e1 =>
-      (Aindexed n, e1:::Enil)
-  | addressing_case5 e1 e2 =>
-      (Aindexed2, e1:::e2:::Enil)
-  | addressing_default e =>
-      (Aindexed Int.zero, e:::Enil)
-  end.
-
-Definition load (chunk: memory_chunk) (e1: expr) :=
-  match addressing e1 with
-  | (mode, args) => Eload chunk mode args
-  end.
-
-Definition store (chunk: memory_chunk) (e1 e2: expr) :=
-  match addressing e1 with
-  | (mode, args) => Sstore chunk mode args e2
-  end.
-
-(** * Translation from Cminor to CminorSel *)
-
-(** Instruction selection for operator applications *)
-
-Definition sel_constant (cst: Cminor.constant) : expr :=
-  match cst with
-  | Cminor.Ointconst n => Eop (Ointconst n) Enil
-  | Cminor.Ofloatconst f => Eop (Ofloatconst f) Enil
-  | Cminor.Oaddrsymbol id ofs => Eop (Oaddrsymbol id ofs) Enil
-  | Cminor.Oaddrstack ofs => Eop (Oaddrstack ofs) Enil
-  end.
-
-Definition sel_unop (op: Cminor.unary_operation) (arg: expr) : expr :=
-  match op with
-  | Cminor.Ocast8unsigned => cast8unsigned arg 
-  | Cminor.Ocast8signed => cast8signed arg 
-  | Cminor.Ocast16unsigned => cast16unsigned arg 
-  | Cminor.Ocast16signed => cast16signed arg 
-  | Cminor.Onegint => Eop (Osubimm Int.zero) (arg ::: Enil)
-  | Cminor.Onotbool => notbool arg
-  | Cminor.Onotint => notint arg
-  | Cminor.Onegf => Eop Onegf (arg ::: Enil)
-  | Cminor.Oabsf => Eop Oabsf (arg ::: Enil)
-  | Cminor.Osingleoffloat => singleoffloat arg
-  | Cminor.Ointoffloat => Eop Ointoffloat (arg ::: Enil)
-  | Cminor.Ointuoffloat => Eop Ointuoffloat (arg ::: Enil)
-  | Cminor.Ofloatofint => Eop Ofloatofint (arg ::: Enil)
-  | Cminor.Ofloatofintu => Eop Ofloatofintu (arg ::: Enil)
-  end.
-
-Definition sel_binop (op: Cminor.binary_operation) (arg1 arg2: expr) : expr :=
-  match op with
-  | Cminor.Oadd => add arg1 arg2
-  | Cminor.Osub => sub arg1 arg2
-  | Cminor.Omul => mul arg1 arg2
-  | Cminor.Odiv => divs arg1 arg2
-  | Cminor.Odivu => divu arg1 arg2
-  | Cminor.Omod => mods arg1 arg2
-  | Cminor.Omodu => modu arg1 arg2
-  | Cminor.Oand => and arg1 arg2
-  | Cminor.Oor => or arg1 arg2
-  | Cminor.Oxor => Eop Oxor (arg1 ::: arg2 ::: Enil)
-  | Cminor.Oshl => shl arg1 arg2
-  | Cminor.Oshr => Eop Oshr (arg1 ::: arg2 ::: Enil)
-  | Cminor.Oshru => shru arg1 arg2
-  | Cminor.Oaddf => addf arg1 arg2
-  | Cminor.Osubf => subf arg1 arg2
-  | Cminor.Omulf => Eop Omulf (arg1 ::: arg2 ::: Enil)
-  | Cminor.Odivf => Eop Odivf (arg1 ::: arg2 ::: Enil)
-  | Cminor.Ocmp c => comp c arg1 arg2
-  | Cminor.Ocmpu c => compu c arg1 arg2
-  | Cminor.Ocmpf c => compf c arg1 arg2
-  end.
-
-(** Conversion from Cminor expression to Cminorsel expressions *)
-
-Fixpoint sel_expr (a: Cminor.expr) : expr :=
-  match a with
-  | Cminor.Evar id => Evar id
-  | Cminor.Econst cst => sel_constant cst
-  | Cminor.Eunop op arg => sel_unop op (sel_expr arg)
-  | Cminor.Ebinop op arg1 arg2 => sel_binop op (sel_expr arg1) (sel_expr arg2)
-  | Cminor.Eload chunk addr => load chunk (sel_expr addr)
-  | Cminor.Econdition cond ifso ifnot =>
-      Econdition (condexpr_of_expr (sel_expr cond))
-                 (sel_expr ifso) (sel_expr ifnot)
-  end.
-
-Fixpoint sel_exprlist (al: list Cminor.expr) : exprlist :=
-  match al with
-  | nil => Enil
-  | a :: bl => Econs (sel_expr a) (sel_exprlist bl)
-  end.
-
-(** Conversion from Cminor statements to Cminorsel statements. *)
-
-Fixpoint sel_stmt (s: Cminor.stmt) : stmt :=
-  match s with
-  | Cminor.Sskip => Sskip
-  | Cminor.Sassign id e => Sassign id (sel_expr e)
-  | Cminor.Sstore chunk addr rhs => store chunk (sel_expr addr) (sel_expr rhs)
-  | Cminor.Scall optid sg fn args =>
-      Scall optid sg (sel_expr fn) (sel_exprlist args)
-  | Cminor.Stailcall sg fn args => 
-      Stailcall sg (sel_expr fn) (sel_exprlist args)
-  | Cminor.Salloc id b => Salloc id (sel_expr b)
-  | Cminor.Sseq s1 s2 => Sseq (sel_stmt s1) (sel_stmt s2)
-  | Cminor.Sifthenelse e ifso ifnot =>
-      Sifthenelse (condexpr_of_expr (sel_expr e))
-                  (sel_stmt ifso) (sel_stmt ifnot)
-  | Cminor.Sloop body => Sloop (sel_stmt body)
-  | Cminor.Sblock body => Sblock (sel_stmt body)
-  | Cminor.Sexit n => Sexit n
-  | Cminor.Sswitch e cases dfl => Sswitch (sel_expr e) cases dfl
-  | Cminor.Sreturn None => Sreturn None
-  | Cminor.Sreturn (Some e) => Sreturn (Some (sel_expr e))
-  | Cminor.Slabel lbl body => Slabel lbl (sel_stmt body)
-  | Cminor.Sgoto lbl => Sgoto lbl
-  end.
-
-(** Conversion of functions and programs. *)
-
-Definition sel_function (f: Cminor.function) : function :=
-  mkfunction
-    f.(Cminor.fn_sig)
-    f.(Cminor.fn_params)
-    f.(Cminor.fn_vars)
-    f.(Cminor.fn_stackspace)
-    (sel_stmt f.(Cminor.fn_body)).
-
-Definition sel_fundef (f: Cminor.fundef) : fundef :=
-  transf_fundef sel_function f.
-
-Definition sel_program (p: Cminor.program) : program :=
-  transform_program sel_fundef p.
-
-
-
diff --git a/backend/Selectionproof.v b/backend/Selectionproof.v
deleted file mode 100644
index 6d629794..00000000
--- a/backend/Selectionproof.v
+++ /dev/null
@@ -1,1398 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*                                                                     *)
-(*  Copyright Institut National de Recherche en Informatique et en     *)
-(*  Automatique.  All rights reserved.  This file is distributed       *)
-(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** Correctness of instruction selection *)
-
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Mem.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Cminor.
-Require Import Op.
-Require Import CminorSel.
-Require Import Selection.
-
-Open Local Scope selection_scope.
-
-Section CMCONSTR.
-
-Variable ge: genv.
-Variable sp: val.
-Variable e: env.
-Variable m: mem.
-
-(** * Lifting of let-bound variables *)
-
-Inductive insert_lenv: letenv -> nat -> val -> letenv -> Prop :=
-  | insert_lenv_0:
-      forall le v,
-      insert_lenv le O v (v :: le)
-  | insert_lenv_S:
-      forall le p w le' v,
-      insert_lenv le p w le' ->
-      insert_lenv (v :: le) (S p) w (v :: le').
-
-Lemma insert_lenv_lookup1:
-  forall le p w le',
-  insert_lenv le p w le' ->
-  forall n v,
-  nth_error le n = Some v -> (p > n)%nat ->
-  nth_error le' n = Some v.
-Proof.
-  induction 1; intros.
-  omegaContradiction.
-  destruct n; simpl; simpl in H0. auto. 
-  apply IHinsert_lenv. auto. omega.
-Qed.
-
-Lemma insert_lenv_lookup2:
-  forall le p w le',
-  insert_lenv le p w le' ->
-  forall n v,
-  nth_error le n = Some v -> (p <= n)%nat ->
-  nth_error le' (S n) = Some v.
-Proof.
-  induction 1; intros.
-  simpl. assumption.
-  simpl. destruct n. omegaContradiction. 
-  apply IHinsert_lenv. exact H0. omega.
-Qed.
-
-Hint Resolve eval_Evar eval_Eop eval_Eload eval_Econdition
-             eval_Elet eval_Eletvar 
-             eval_CEtrue eval_CEfalse eval_CEcond
-             eval_CEcondition eval_Enil eval_Econs: evalexpr.
-
-Lemma eval_lift_expr:
-  forall w le a v,
-  eval_expr ge sp e m le a v ->
-  forall p le', insert_lenv le p w le' ->
-  eval_expr ge sp e m le' (lift_expr p a) v.
-Proof.
-  intro w.
-  apply (eval_expr_ind3 ge sp e m
-    (fun le a v =>
-      forall p le', insert_lenv le p w le' ->
-      eval_expr ge sp e m le' (lift_expr p a) v)
-    (fun le a v =>
-      forall p le', insert_lenv le p w le' ->
-      eval_condexpr ge sp e m le' (lift_condexpr p a) v)
-    (fun le al vl =>
-      forall p le', insert_lenv le p w le' ->
-      eval_exprlist ge sp e m le' (lift_exprlist p al) vl));
-  simpl; intros; eauto with evalexpr.
-
-  destruct v1; eapply eval_Econdition;
-  eauto with evalexpr; simpl; eauto with evalexpr.
-
-  eapply eval_Elet. eauto. apply H2. apply insert_lenv_S; auto.
-
-  case (le_gt_dec p n); intro. 
-  apply eval_Eletvar. eapply insert_lenv_lookup2; eauto.
-  apply eval_Eletvar. eapply insert_lenv_lookup1; eauto.
-
-  destruct vb1; eapply eval_CEcondition;
-  eauto with evalexpr; simpl; eauto with evalexpr.
-Qed.
-
-Lemma eval_lift:
-  forall le a v w,
-  eval_expr ge sp e m le a v ->
-  eval_expr ge sp e m (w::le) (lift a) v.
-Proof.
-  intros. unfold lift. eapply eval_lift_expr.
-  eexact H. apply insert_lenv_0. 
-Qed.
-
-Hint Resolve eval_lift: evalexpr.
-
-(** * 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 [Selection.notint] behaves as expected.  Continuing the
-  [notint] example, we show that if the expression [e]
-  evaluates to some integer value [Vint n], then [Selection.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_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.not x)).
-Proof.
-  unfold notint; intros until x; case (notint_match a); intros; InvEval.
-  EvalOp. simpl. congruence.
-  EvalOp. simpl. congruence.
-  EvalOp. simpl. congruence.
-  eapply eval_Elet. eexact H. 
-  eapply eval_Eop.
-  eapply eval_Econs. apply eval_Eletvar. simpl. reflexivity.
-  eapply eval_Econs. apply eval_Eletvar. simpl. reflexivity.
-  apply eval_Enil.  
-  simpl. rewrite Int.or_idem. 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 m = Some b).
-  generalize H6. simpl. 
-  case (eval_condition c vl m); 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.
-
-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.
-  destruct (Genv.find_symbol ge s); discriminate.
-  destruct sp; simpl in H1; discriminate.
-  subst x. rewrite Int.add_assoc. decEq; decEq; decEq. apply Int.add_commut.
-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; EvalOp; simpl.
-  destruct (Genv.find_symbol ge s). 
-  rewrite Int.add_commut. congruence.
-  discriminate.
-  destruct sp; simpl in H1; try discriminate.
-  inv H1. simpl. decEq. decEq. 
-  rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  subst. rewrite (Int.add_commut n m0). rewrite Int.add_assoc. auto.
-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. 
-  replace (Int.add x y) with (Int.add (Int.add i0 i) (Int.add n1 n2)).
-    apply eval_addimm. EvalOp.  
-    subst x; subst y. 
-    repeat rewrite Int.add_assoc. decEq. apply Int.add_permut. 
-  replace (Int.add x y) with (Int.add (Int.add i y) n1).
-    apply eval_addimm. EvalOp.
-    subst x. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  apply eval_addimm. auto.
-  replace (Int.add x y) with (Int.add (Int.add x i) n2).
-    apply eval_addimm. EvalOp.
-    subst y. rewrite Int.add_assoc. auto.
-  EvalOp.
-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.
-  replace (Int.add x y) with (Int.add (Int.add i0 i) (Int.add n1 n2)).
-    apply eval_addimm_ptr. subst b0. EvalOp. 
-    subst x; subst y.
-    repeat rewrite Int.add_assoc. decEq. apply Int.add_permut. 
-  replace (Int.add x y) with (Int.add (Int.add i y) n1).
-    apply eval_addimm_ptr. subst b0. EvalOp.
-    subst x. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  apply eval_addimm_ptr. auto.
-  replace (Int.add x y) with (Int.add (Int.add x i) n2).
-    apply eval_addimm_ptr. EvalOp.
-    subst y. rewrite Int.add_assoc. auto.
-  EvalOp.
-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.
-  replace (Int.add y x) with (Int.add (Int.add i i0) (Int.add n1 n2)).
-    apply eval_addimm_ptr. subst b0. EvalOp. 
-    subst x; subst y.
-    repeat rewrite Int.add_assoc. decEq. 
-    rewrite (Int.add_commut n1 n2). apply Int.add_permut. 
-  replace (Int.add y x) with (Int.add (Int.add y i) n1).
-    apply eval_addimm_ptr. EvalOp. 
-    subst x. repeat rewrite Int.add_assoc. auto.
-  replace (Int.add y x) with (Int.add (Int.add i x) n2).
-    apply eval_addimm_ptr. EvalOp. subst b0; reflexivity.
-    subst y. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  EvalOp.
-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.
-
-Lemma eval_rolm:
-  forall le a amount mask x,
-  eval_expr ge sp e m le a (Vint x) ->
-  eval_expr ge sp e m le (rolm a amount mask) (Vint (Int.rolm x amount mask)).
-Proof.
-  intros until x. unfold rolm; case (rolm_match a); intros; InvEval.
-  eauto with evalexpr. 
-  case (Int.is_rlw_mask (Int.and (Int.rol mask1 amount) mask)).
-  EvalOp. simpl. subst x. 
-  decEq. decEq. 
-  replace (Int.and (Int.add amount1 amount) (Int.repr 31))
-     with (Int.modu (Int.add amount1 amount) (Int.repr 32)).
-  symmetry. apply Int.rolm_rolm. 
-  change (Int.repr 31) with (Int.sub (Int.repr 32) Int.one).
-  apply Int.modu_and with (Int.repr 5). reflexivity.
-  EvalOp. econstructor. EvalOp. simpl. rewrite H. reflexivity. constructor. auto.  
-  EvalOp.
-Qed.
-
-Theorem eval_shlimm:
-  forall le a n x,
-  eval_expr ge sp e m le a (Vint x) ->
-  Int.ltu n (Int.repr 32) = true ->
-  eval_expr ge sp e m le (shlimm a n) (Vint (Int.shl x n)).
-Proof.
-  intros.  unfold shlimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
-  subst n. rewrite Int.shl_zero. auto.
-  rewrite H0.
-  replace (Int.shl x n) with (Int.rolm x n (Int.shl Int.mone n)).
-  apply eval_rolm. auto. symmetry. apply Int.shl_rolm. exact H0.
-Qed.
-
-Theorem eval_shruimm:
-  forall le a n x,
-  eval_expr ge sp e m le a (Vint x) ->
-  Int.ltu n (Int.repr 32) = true ->
-  eval_expr ge sp e m le (shruimm a n) (Vint (Int.shru x n)).
-Proof.
-  intros.  unfold shruimm.
-  generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
-  subst n. rewrite Int.shru_zero. auto.
-  rewrite H0.
-  replace (Int.shru x n) with (Int.rolm x (Int.sub (Int.repr 32) n) (Int.shru Int.mone n)).
-  apply eval_rolm. auto. symmetry. apply Int.shru_rolm. exact H0.
-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).
-  change (Z_of_nat wordsize) with 32.
-  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.
-  rewrite <- Int.shl_mul.
-  rewrite <- Int.shl_mul.
-  EvalOp. eapply eval_Econs. 
-  apply eval_shlimm. apply eval_Eletvar. simpl. reflexivity. 
-  auto with coqlib.
-  eapply eval_Econs.
-  apply eval_shlimm. apply eval_Eletvar. simpl. reflexivity.
-  auto with coqlib.
-  auto with evalexpr.
-  reflexivity.
-  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. 
-  intro. eapply eval_Elet; eauto with evalexpr. 
-  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.
-  replace (Int.mul x n) with (Int.add (Int.mul i n) (Int.mul n n2)).
-  apply eval_addimm. apply eval_mulimm_base. auto.
-  subst x. rewrite Int.mul_add_distr_l. decEq. apply Int.mul_commut.
-  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.
-
-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.
-
-Lemma eval_mod_aux:
-  forall divop semdivop,
-  (forall sp x y m,
-   y <> Int.zero ->
-   eval_operation ge sp divop (Vint x :: Vint y :: nil) m =
-   Some (Vint (semdivop x y))) ->
-  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 (mod_aux divop a b)
-   (Vint (Int.sub x (Int.mul (semdivop x y) y))).
-Proof.
-  intros; unfold mod_aux.
-  eapply eval_Elet. eexact H0. eapply eval_Elet. 
-  apply eval_lift. eexact H1.
-  eapply eval_Eop. eapply eval_Econs. 
-  eapply eval_Eletvar. simpl; reflexivity.
-  eapply eval_Econs. eapply eval_Eop. 
-  eapply eval_Econs. eapply eval_Eop.
-  eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
-  eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
-  apply eval_Enil.  
-  apply H. assumption.
-  eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
-  apply eval_Enil.  
-  simpl; reflexivity. apply eval_Enil. 
-  reflexivity.
-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.
-  intros; unfold mods. 
-  rewrite Int.mods_divs. 
-  eapply eval_mod_aux; eauto. 
-  intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero. 
-  contradiction. auto.
-Qed.
-
-Lemma eval_divu_base:
-  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 (Eop Odivu (a ::: b ::: Enil)) (Vint (Int.divu x y)).
-Proof.
-  intros. EvalOp. simpl. 
-  predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
-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 until y.
-  unfold divu; case (divu_match b); intros; InvEval.
-  caseEq (Int.is_power2 y). 
-  intros. rewrite (Int.divu_pow2 x y i H0).
-  apply eval_shruimm. auto.
-  apply Int.is_power2_range with y. auto.
-  intros. apply eval_divu_base. auto. EvalOp. auto.
-  eapply eval_divu_base; eauto.
-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 until y; unfold modu; case (divu_match b); intros; InvEval.
-  caseEq (Int.is_power2 y). 
-  intros. rewrite (Int.modu_and x y i H0).
-  rewrite <- Int.rolm_zero. apply eval_rolm. auto.
-  intro. rewrite Int.modu_divu. eapply eval_mod_aux. 
-  intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero.
-  contradiction. auto.
-  auto. EvalOp. auto. auto.
-  rewrite Int.modu_divu. eapply eval_mod_aux. 
-  intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero.
-  contradiction. auto. auto. auto. auto. auto.
-Qed.
-
-Theorem 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. case (Int.is_rlw_mask n).
-  rewrite <- Int.rolm_zero. apply eval_rolm; 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.
-  apply eval_andimm; auto.
-  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.
-
-Lemma 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.
-  caseEq (Int.eq amount1 amount2 
-          && Int.is_rlw_mask (Int.or mask1 mask2) 
-          && same_expr_pure t1 t2); intro.
-  destruct (andb_prop _ _ H1). destruct (andb_prop _ _ H4).
-  generalize (Int.eq_spec amount1 amount2). rewrite H6. intro. subst amount2.
-  exploit eval_same_expr; eauto. intros [EQ1 EQ2]. inv EQ1. inv EQ2. 
-  simpl. EvalOp. simpl. rewrite Int.or_rolm. auto.
-  simpl. apply eval_Eop with (Vint x :: Vint y :: nil).
-  econstructor. EvalOp. simpl. congruence. 
-  econstructor. EvalOp. simpl. congruence. constructor. auto.
-  EvalOp.
-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.repr 32) = 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.repr 32) = 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_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 until y; unfold addf.
-  destruct (use_fused_mul tt).
-  case (addf_match a b); intros; InvEval.
-  EvalOp. simpl. congruence.
-  EvalOp. simpl. rewrite Float.addf_commut. congruence.
-  EvalOp.
-  intros. 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 until y; unfold subf.
-  destruct (use_fused_mul tt).
-  case (subf_match a b); intros.
-  InvEval. EvalOp. simpl. congruence. 
-  EvalOp.
-  intros. EvalOp.
-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 until v; unfold cast8signed; case (cast8signed_match a); intros; InvEval.
-  EvalOp. simpl. subst v. destruct v1; simpl; auto.
-  rewrite Int.sign_ext_idem. reflexivity. compute; auto.
-  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 until v; unfold cast8unsigned; case (cast8unsigned_match a); intros; InvEval.
-  EvalOp. simpl. subst v. destruct v1; simpl; auto.
-  rewrite Int.zero_ext_idem. reflexivity. compute; auto.
-  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 until v; unfold cast16signed; case (cast16signed_match a); intros; InvEval.
-  EvalOp. simpl. subst v. destruct v1; simpl; auto.
-  rewrite Int.sign_ext_idem. reflexivity. compute; auto.
-  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 until v; unfold cast16unsigned; case (cast16unsigned_match a); intros; InvEval.
-  EvalOp. simpl. subst v. destruct v1; simpl; auto.
-  rewrite Int.zero_ext_idem. reflexivity. compute; auto.
-  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 until v; unfold singleoffloat; case (singleoffloat_match a); intros; InvEval.
-  EvalOp. simpl. subst v. destruct v1; simpl; auto. rewrite Float.singleoffloat_idem. reflexivity.
-  EvalOp.
-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.
-
-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) ->
-  (if Int.eq y Int.zero then Cminor.eval_compare_mismatch c else None) = 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. destruct (Int.eq y Int.zero); try discriminate.
-  unfold Cminor.eval_compare_mismatch in H1. unfold eval_compare_mismatch.
-  destruct c; try discriminate; auto.
-  EvalOp. simpl. destruct (Int.eq y Int.zero); try discriminate.
-  unfold Cminor.eval_compare_mismatch in H1. unfold eval_compare_mismatch.
-  destruct c; try discriminate; 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) ->
-  (if Int.eq x Int.zero then Cminor.eval_compare_mismatch c else None) = 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. destruct (Int.eq x Int.zero); try discriminate.
-  unfold Cminor.eval_compare_mismatch in H1. unfold eval_compare_mismatch.
-  destruct c; try discriminate; auto.
-  EvalOp. simpl. destruct (Int.eq x Int.zero); try discriminate.
-  unfold Cminor.eval_compare_mismatch in H1. unfold eval_compare_mismatch.
-  destruct c; try discriminate; 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) ->
-  valid_pointer m x1 (Int.signed x2) &&
-  valid_pointer m y1 (Int.signed y2) = true ->
-  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. rewrite H1. 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) ->
-  valid_pointer m x1 (Int.signed x2) &&
-  valid_pointer m y1 (Int.signed y2) = true ->
-  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 H1. rewrite dec_eq_false; auto.
-  destruct c; simpl in H3; inv H3; 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.
-
-Lemma negate_condexpr_correct:
-  forall le a b,
-  eval_condexpr ge sp e m le a b ->
-  eval_condexpr ge sp e m le (negate_condexpr a) (negb b).
-Proof.
-  induction 1; simpl.
-  constructor.
-  constructor.
-  econstructor. eauto. apply eval_negate_condition. auto.
-  econstructor. eauto. destruct vb1; auto.
-Qed. 
-
-Scheme expr_ind2 := Induction for expr Sort Prop
-  with exprlist_ind2 := Induction for exprlist Sort Prop.
-
-Fixpoint forall_exprlist (P: expr -> Prop) (el: exprlist) {struct el}: Prop :=
-  match el with
-  | Enil => True
-  | Econs e el' => P e /\ forall_exprlist P el'
-  end.
-
-Lemma expr_induction_principle:
-  forall (P: expr -> Prop),
-  (forall i : ident, P (Evar i)) ->
-  (forall (o : operation) (e : exprlist),
-     forall_exprlist P e -> P (Eop o e)) ->
-  (forall (m : memory_chunk) (a : Op.addressing) (e : exprlist),
-     forall_exprlist P e -> P (Eload m a e)) ->
-  (forall (c : condexpr) (e : expr),
-     P e -> forall e0 : expr, P e0 -> P (Econdition c e e0)) ->
-  (forall e : expr, P e -> forall e0 : expr, P e0 -> P (Elet e e0)) ->
-  (forall n : nat, P (Eletvar n)) ->
-  forall e : expr, P e.
-Proof.
-  intros. apply expr_ind2 with (P := P) (P0 := forall_exprlist P); auto.
-  simpl. auto.
-  intros. simpl. auto.
-Qed.
-
-Lemma eval_base_condition_of_expr:
-  forall le a v b,
-  eval_expr ge sp e m le a v ->
-  Val.bool_of_val v b ->
-  eval_condexpr ge sp e m le 
-                (CEcond (Ccompimm Cne Int.zero) (a ::: Enil))
-                b.
-Proof.
-  intros. 
-  eapply eval_CEcond. eauto with evalexpr. 
-  inversion H0; simpl. rewrite Int.eq_false; auto. auto. auto.
-Qed.
-
-Lemma is_compare_neq_zero_correct:
-  forall c v b,
-  is_compare_neq_zero c = true ->
-  eval_condition c (v :: nil) m = Some b ->
-  Val.bool_of_val v b.
-Proof.
-  intros.
-  destruct c; simpl in H; try discriminate;
-  destruct c; simpl in H; try discriminate;
-  generalize (Int.eq_spec i Int.zero); rewrite H; intro; subst i.
-
-  simpl in H0. destruct v; inv H0. 
-  generalize (Int.eq_spec i Int.zero). destruct (Int.eq i Int.zero); intros; simpl.
-  subst i; constructor. constructor; auto. constructor.
-
-  simpl in H0. destruct v; inv H0. 
-  generalize (Int.eq_spec i Int.zero). destruct (Int.eq i Int.zero); intros; simpl.
-  subst i; constructor. constructor; auto.
-Qed.
-
-Lemma is_compare_eq_zero_correct:
-  forall c v b,
-  is_compare_eq_zero c = true ->
-  eval_condition c (v :: nil) m = Some b ->
-  Val.bool_of_val v (negb b).
-Proof.
-  intros. apply is_compare_neq_zero_correct with (negate_condition c).
-  destruct c; simpl in H; simpl; try discriminate;
-  destruct c; simpl; try discriminate; auto.
-  apply eval_negate_condition; auto.
-Qed.
-
-Lemma eval_condition_of_expr:
-  forall a le v b,
-  eval_expr ge sp e m le a v ->
-  Val.bool_of_val v b ->
-  eval_condexpr ge sp e m le (condexpr_of_expr a) b.
-Proof.
-  intro a0; pattern a0.
-  apply expr_induction_principle; simpl; intros;
-    try (eapply eval_base_condition_of_expr; eauto; fail).
-  
-  destruct o; try (eapply eval_base_condition_of_expr; eauto; fail).
-
-  destruct e0. InvEval. 
-  inversion H1. 
-  rewrite Int.eq_false; auto. constructor.
-  subst i; rewrite Int.eq_true. constructor.
-  eapply eval_base_condition_of_expr; eauto.
-
-  inv H0. simpl in H7.
-  assert (eval_condition c vl m = Some b).
-    destruct (eval_condition c vl m); try discriminate.
-    destruct b0; inv H7; inversion H1; congruence.
-  assert (eval_condexpr ge sp e m le (CEcond c e0) b).
-    eapply eval_CEcond; eauto.
-  destruct e0; auto. destruct e1; auto.
-  simpl in H. destruct H.
-  inv H5. inv H11.
-
-  case_eq (is_compare_neq_zero c); intros.
-  eapply H; eauto.
-  apply is_compare_neq_zero_correct with c; auto.
-
-  case_eq (is_compare_eq_zero c); intros.
-  replace b with (negb (negb b)). apply negate_condexpr_correct.
-  eapply H; eauto.
-  apply is_compare_eq_zero_correct with c; auto.
-  apply negb_involutive.
-
-  auto.
-
-  inv H1. destruct v1; eauto with evalexpr.
-Qed.
-
-Lemma eval_addressing:
-  forall le a v b ofs,
-  eval_expr ge sp e m le a v ->
-  v = Vptr b ofs ->
-  match addressing 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.
-  exists (@nil val). split. eauto with evalexpr. simpl. auto.
-  exists (@nil val). split. eauto with evalexpr. simpl. auto.
-  destruct (Genv.find_symbol ge s); congruence.
-  exists (Vint i0 :: nil). split. eauto with evalexpr. 
-    simpl. destruct (Genv.find_symbol ge s). congruence. discriminate.
-  exists (Vptr b0 i :: nil). split. eauto with evalexpr. 
-    simpl. congruence.
-  exists (Vint i :: Vptr b0 i0 :: nil).
-    split. eauto with evalexpr. simpl. 
-    congruence.
-  exists (Vptr b0 i :: Vint i0 :: nil).
-    split. eauto with evalexpr. simpl. congruence.
-  exists (v :: nil). split. eauto with evalexpr. 
-    subst v. simpl. rewrite Int.add_zero. auto.
-Qed.
-
-Lemma eval_load:
-  forall le a v chunk v',
-  eval_expr ge sp e m le a v ->
-  Mem.loadv chunk m v = Some v' ->
-  eval_expr ge sp e m le (load chunk a) v'.
-Proof.
-  intros. generalize H0; destruct v; simpl; intro; try discriminate.
-  unfold load. 
-  generalize (eval_addressing _ _ _ _ _ H (refl_equal _)).
-  destruct (addressing a). intros [vl [EV EQ]]. 
-  eapply eval_Eload; eauto. 
-Qed.
-
-Lemma eval_store:
-  forall chunk a1 a2 v1 v2 f k m',
-  eval_expr ge sp e m nil a1 v1 ->
-  eval_expr ge sp e m nil a2 v2 ->
-  Mem.storev chunk m v1 v2 = Some m' ->
-  step ge (State f (store chunk a1 a2) k sp e m)
-       E0 (State f Sskip k sp e m').
-Proof.
-  intros. generalize H1; destruct v1; simpl; intro; try discriminate.
-  unfold store.
-  generalize (eval_addressing _ _ _ _ _ H (refl_equal _)).
-  destruct (addressing a1). intros [vl [EV EQ]]. 
-  eapply step_store; eauto. 
-Qed.
-
-(** * Correctness of instruction selection for operators *)
-
-(** We now prove a semantic preservation result for the [sel_unop]
-  and [sel_binop] selection functions.  The proof exploits
-  the results of the previous section. *)
-
-Lemma eval_sel_unop:
-  forall le op a1 v1 v,
-  eval_expr ge sp e m le a1 v1 ->
-  eval_unop op v1 = Some v ->
-  eval_expr ge sp e m le (sel_unop op a1) v.
-Proof.
-  destruct op; simpl; intros; FuncInv; try subst v.
-  apply eval_cast8unsigned; auto.
-  apply eval_cast8signed; auto.
-  apply eval_cast16unsigned; auto.
-  apply eval_cast16signed; auto.
-  EvalOp. 
-  generalize (Int.eq_spec i Int.zero). destruct (Int.eq i Int.zero); intro.
-  change true with (negb false). eapply eval_notbool; eauto. subst i; constructor.
-  change false with (negb true). eapply eval_notbool; eauto. constructor; auto.
-  change Vfalse with (Val.of_bool (negb true)).
-  eapply eval_notbool; eauto. constructor.
-  apply eval_notint; auto.
-  EvalOp.
-  EvalOp.
-  apply eval_singleoffloat; auto.
-  EvalOp.
-  EvalOp.
-  EvalOp.
-  EvalOp.
-Qed.
-
-Lemma eval_sel_binop:
-  forall le op a1 a2 v1 v2 v,
-  eval_expr ge sp e m le a1 v1 ->
-  eval_expr ge sp e m le a2 v2 ->
-  eval_binop op v1 v2 m = Some v ->
-  eval_expr ge sp e m le (sel_binop op a1 a2) v.
-Proof.
-  destruct op; simpl; intros; FuncInv; try subst v.
-  apply eval_add; auto.
-  apply eval_add_ptr_2; auto.
-  apply eval_add_ptr; auto.
-  apply eval_sub; auto.
-  apply eval_sub_ptr_int; auto.
-  destruct (eq_block b b0); inv H1. 
-  eapply eval_sub_ptr_ptr; eauto.
-  apply eval_mul; eauto.
-  generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
-  apply eval_divs; eauto.
-  generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
-  apply eval_divu; eauto.
-  generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
-  apply eval_mods; eauto.
-  generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
-  apply eval_modu; eauto.
-  apply eval_and; auto.
-  apply eval_or; auto.
-  EvalOp.
-  caseEq (Int.ltu i0 (Int.repr 32)); intro; rewrite H2 in H1; inv H1.
-  apply eval_shl; auto.
-  EvalOp.
-  caseEq (Int.ltu i0 (Int.repr 32)); intro; rewrite H2 in H1; inv H1.
-  apply eval_shru; auto.
-  apply eval_addf; auto.
-  apply eval_subf; auto.
-  EvalOp.
-  EvalOp.
-  apply eval_comp_int; auto.
-  eapply eval_comp_int_ptr; eauto.
-  eapply eval_comp_ptr_int; eauto.
-  generalize H1; clear H1.
-  case_eq (valid_pointer m b (Int.signed i) && valid_pointer m b0 (Int.signed i0)); intros.
-  destruct (eq_block b b0); inv H2.
-  eapply eval_comp_ptr_ptr; eauto.
-  eapply eval_comp_ptr_ptr_2; eauto.
-  discriminate.
-  eapply eval_compu; eauto.
-  eapply eval_compf; eauto.
-Qed.
-
-End CMCONSTR.
-
-(** * Semantic preservation for instruction selection. *)
-
-Section PRESERVATION.
-
-Variable prog: Cminor.program.
-Let tprog := sel_program prog.
-Let ge := Genv.globalenv prog.
-Let tge := Genv.globalenv tprog.
-
-(** Relationship between the global environments for the original
-  CminorSel program and the generated RTL program. *)
-
-Lemma symbols_preserved:
-  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof.
-  intros; unfold ge, tge, tprog, sel_program. 
-  apply Genv.find_symbol_transf.
-Qed.
-
-Lemma functions_translated:
-  forall (v: val) (f: Cminor.fundef),
-  Genv.find_funct ge v = Some f ->
-  Genv.find_funct tge v = Some (sel_fundef f).
-Proof.  
-  intros.
-  exact (Genv.find_funct_transf sel_fundef H).
-Qed.
-
-Lemma function_ptr_translated:
-  forall (b: block) (f: Cminor.fundef),
-  Genv.find_funct_ptr ge b = Some f ->
-  Genv.find_funct_ptr tge b = Some (sel_fundef f).
-Proof.  
-  intros. 
-  exact (Genv.find_funct_ptr_transf sel_fundef H).
-Qed.
-
-Lemma sig_function_translated:
-  forall f,
-  funsig (sel_fundef f) = Cminor.funsig f.
-Proof.
-  intros. destruct f; reflexivity.
-Qed.
-
-(** Semantic preservation for expressions. *)
-
-Lemma sel_expr_correct:
-  forall sp e m a v,
-  Cminor.eval_expr ge sp e m a v ->
-  forall le,
-  eval_expr tge sp e m le (sel_expr a) v.
-Proof.
-  induction 1; intros; simpl.
-  (* Evar *)
-  constructor; auto.
-  (* Econst *)
-  destruct cst; simpl; simpl in H; (econstructor; [constructor|simpl;auto]).
-  rewrite symbols_preserved. auto.
-  (* Eunop *)
-  eapply eval_sel_unop; eauto.
-  (* Ebinop *)
-  eapply eval_sel_binop; eauto.
-  (* Eload *)
-  eapply eval_load; eauto.
-  (* Econdition *)
-  econstructor; eauto. eapply eval_condition_of_expr; eauto. 
-  destruct b1; auto.
-Qed.
-
-Hint Resolve sel_expr_correct: evalexpr.
-
-Lemma sel_exprlist_correct:
-  forall sp e m a v,
-  Cminor.eval_exprlist ge sp e m a v ->
-  forall le,
-  eval_exprlist tge sp e m le (sel_exprlist a) v.
-Proof.
-  induction 1; intros; simpl; constructor; auto with evalexpr.
-Qed.
-
-Hint Resolve sel_exprlist_correct: evalexpr.
-
-(** Semantic preservation for terminating function calls and statements. *)
-
-Fixpoint sel_cont (k: Cminor.cont) : CminorSel.cont :=
-  match k with
-  | Cminor.Kstop => Kstop
-  | Cminor.Kseq s1 k1 => Kseq (sel_stmt s1) (sel_cont k1)
-  | Cminor.Kblock k1 => Kblock (sel_cont k1)
-  | Cminor.Kcall id f sp e k1 =>
-      Kcall id (sel_function f) sp e (sel_cont k1)
-  end.
-
-Inductive match_states: Cminor.state -> CminorSel.state -> Prop :=
-  | match_state: forall f s k s' k' sp e m,
-      s' = sel_stmt s ->
-      k' = sel_cont k ->
-      match_states
-        (Cminor.State f s k sp e m)
-        (State (sel_function f) s' k' sp e m)
-  | match_callstate: forall f args k k' m,
-      k' = sel_cont k ->
-      match_states
-        (Cminor.Callstate f args k m)
-        (Callstate (sel_fundef f) args k' m)
-  | match_returnstate: forall v k k' m,
-      k' = sel_cont k ->
-      match_states
-        (Cminor.Returnstate v k m)
-        (Returnstate v k' m).
-
-Remark call_cont_commut:
-  forall k, call_cont (sel_cont k) = sel_cont (Cminor.call_cont k).
-Proof.
-  induction k; simpl; auto.
-Qed.
-
-Remark find_label_commut:
-  forall lbl s k,
-  find_label lbl (sel_stmt s) (sel_cont k) =
-  option_map (fun sk => (sel_stmt (fst sk), sel_cont (snd sk)))
-             (Cminor.find_label lbl s k).
-Proof.
-  induction s; intros; simpl; auto.
-  unfold store. destruct (addressing (sel_expr e)); auto.
-  change (Kseq (sel_stmt s2) (sel_cont k))
-    with (sel_cont (Cminor.Kseq s2 k)).
-  rewrite IHs1. rewrite IHs2. 
-  destruct (Cminor.find_label lbl s1 (Cminor.Kseq s2 k)); auto.
-  rewrite IHs1. rewrite IHs2. 
-  destruct (Cminor.find_label lbl s1 k); auto.
-  change (Kseq (Sloop (sel_stmt s)) (sel_cont k))
-    with (sel_cont (Cminor.Kseq (Cminor.Sloop s) k)).
-  auto.
-  change (Kblock (sel_cont k))
-    with (sel_cont (Cminor.Kblock k)).
-  auto.
-  destruct o; auto.
-  destruct (ident_eq lbl l); auto.
-Qed.
-
-Lemma sel_step_correct:
-  forall S1 t S2, Cminor.step ge S1 t S2 ->
-  forall T1, match_states S1 T1 ->
-  exists T2, step tge T1 t T2 /\ match_states S2 T2.
-Proof.
-  induction 1; intros T1 ME; inv ME; simpl;
-  try (econstructor; split; [econstructor; eauto with evalexpr | econstructor; eauto]; fail).
-
-  (* skip call *)
-  econstructor; split. 
-  econstructor. destruct k; simpl in H; simpl; auto. 
-  rewrite <- H0; reflexivity.
-  constructor; auto.
-  (* assign *)
-  exists (State (sel_function f) Sskip (sel_cont k) sp (PTree.set id v e) m); split.
-  constructor. auto with evalexpr.
-  constructor; auto.
-  (* store *)
-  econstructor; split.
-  eapply eval_store; eauto with evalexpr.
-  constructor; auto.
-  (* Scall *)
-  econstructor; split.
-  econstructor; eauto with evalexpr.
-  apply functions_translated; eauto. 
-  apply sig_function_translated.
-  constructor; auto.
-  (* Stailcall *)
-  econstructor; split.
-  econstructor; eauto with evalexpr.
-  apply functions_translated; eauto. 
-  apply sig_function_translated.
-  constructor; auto. apply call_cont_commut.
-  (* Salloc *)
-  exists (State (sel_function f) Sskip (sel_cont k) sp (PTree.set id (Vptr b Int.zero) e) m'); split.
-  econstructor; eauto with evalexpr.
-  constructor; auto.
-  (* Sifthenelse *)
-  exists (State (sel_function f) (if b then sel_stmt s1 else sel_stmt s2) (sel_cont k) sp e m); split.
-  constructor. eapply eval_condition_of_expr; eauto with evalexpr.
-  constructor; auto. destruct b; auto.
-  (* Sreturn None *)
-  econstructor; split. 
-  econstructor. rewrite <- H; reflexivity.
-  constructor; auto. apply call_cont_commut.
-  (* Sreturn Some *)
-  econstructor; split. 
-  econstructor. simpl. auto. eauto with evalexpr. 
-  constructor; auto. apply call_cont_commut.
-  (* Sgoto *)
-  econstructor; split.
-  econstructor. simpl. rewrite call_cont_commut. rewrite find_label_commut.
-  rewrite H. simpl. reflexivity. 
-  constructor; auto.
-Qed.
-
-Lemma sel_initial_states:
-  forall S, Cminor.initial_state prog S ->
-  exists R, initial_state tprog R /\ match_states S R.
-Proof.
-  induction 1.
-  econstructor; split.
-  econstructor.
-  simpl. fold tge. rewrite symbols_preserved. eexact H.
-  apply function_ptr_translated. eauto. 
-  rewrite <- H1. apply sig_function_translated; auto.
-  unfold tprog, sel_program. rewrite Genv.init_mem_transf.
-  constructor; auto.
-Qed.
-
-Lemma sel_final_states:
-  forall S R r,
-  match_states S R -> Cminor.final_state S r -> final_state R r.
-Proof.
-  intros. inv H0. inv H. simpl. constructor.
-Qed.
-
-Theorem transf_program_correct:
-  forall (beh: program_behavior),
-  Cminor.exec_program prog beh -> CminorSel.exec_program tprog beh.
-Proof.
-  unfold CminorSel.exec_program, Cminor.exec_program; intros.
-  eapply simulation_step_preservation; eauto.
-  eexact sel_initial_states.
-  eexact sel_final_states.
-  exact sel_step_correct. 
-Qed.
-
-End PRESERVATION.
diff --git a/backend/Stacking.v b/backend/Stacking.v
index 3f08daa3..1cf010b4 100644
--- a/backend/Stacking.v
+++ b/backend/Stacking.v
@@ -24,61 +24,12 @@ Require Import Linear.
 Require Import Bounds.
 Require Import Mach.
 Require Import Conventions.
+Require Import Stacklayout.
 
 (** * Layout of activation records *)
 
-(** The general shape of activation records is as follows,
-  from bottom (lowest offsets) to top:
-- 24 reserved bytes.  The first 4 bytes hold the back pointer to the
-  activation record of the caller.  We use the 4 bytes at offset 12
-  to store the return address.  (These are reserved by the PowerPC
-  application binary interface.)  The remaining bytes are unused.
-- Space for outgoing arguments to function calls.
-- Local stack slots of integer type.
-- Saved values of integer callee-save registers used by the function.
-- One word of padding, if necessary to align the following data
-  on a 8-byte boundary.
-- 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 := 24.
-
-Record frame_env : Set := 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 oil := 24 + 4 * b.(bound_outgoing) 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 0 12
-                  oil oics b.(bound_int_callee_save)
-                  ofl ofcs b.(bound_float_callee_save).
+(** The machine- and ABI-dependent aspects of the layout are defined
+  in module [Stacklayout]. *)
 
 (** Computation the frame offset for the given component of the frame.
   The component is expressed by the following [frame_index] sum type. *)
diff --git a/backend/Stackingproof.v b/backend/Stackingproof.v
index a9187eed..e17f67a6 100644
--- a/backend/Stackingproof.v
+++ b/backend/Stackingproof.v
@@ -38,6 +38,7 @@ Require Import Mach.
 Require Import Machabstr.
 Require Import Bounds.
 Require Import Conventions.
+Require Import Stacklayout.
 Require Import Stacking.
 
 (** * Properties of frames and frame accesses *)
@@ -50,92 +51,6 @@ Proof.
   destruct ty; auto.
 Qed.
 
-(*
-Lemma get_slot_ok:
-  forall fr ty ofs,
-  24 <= ofs -> fr.(fr_low) + ofs + 4 * typesize ty <= 0 ->
-  exists v, get_slot fr ty ofs v.
-Proof.
-  intros. rewrite <- typesize_typesize in H0.
-  exists (fr.(fr_contents) ty (fr.(fr_low) + ofs)). constructor; auto. 
-Qed.
-
-Lemma set_slot_ok:
-  forall fr ty ofs v,
-  24 <= ofs -> fr.(fr_low) + ofs + 4 * typesize ty <= 0 ->
-  exists fr', set_slot fr ty ofs v fr'.
-Proof.
-  intros. rewrite <- typesize_typesize in H0.
-  econstructor. constructor; eauto.
-Qed.
-
-Lemma slot_gss: 
-  forall fr1 ty ofs v fr2,
-  set_slot fr1 ty ofs v fr2 ->
-  get_slot fr2 ty ofs v.
-Proof.
-  intros. inv H. constructor; auto.
-  simpl. destruct (typ_eq ty ty); try congruence.
-  rewrite zeq_true. auto.
-Qed.
-
-Remark frame_update_gso:
-  forall fr ty ofs v ty' ofs',
-  ofs' + 4 * typesize ty' <= ofs \/ ofs + 4 * typesize ty <= ofs' ->
-  fr_contents (update ty ofs v fr) ty' ofs' = fr_contents fr ty' ofs'.
-Proof.
-  intros.
-  generalize (typesize_pos ty); intro.
-  generalize (typesize_pos ty'); intro.
-  simpl. rewrite zeq_false. 2: omega.
-  repeat rewrite <- typesize_typesize in H.
-  destruct (zle (ofs' + AST.typesize ty') ofs). auto.
-  destruct (zle (ofs + AST.typesize ty) ofs'). auto.
-  omegaContradiction.
-Qed.
-
-Remark frame_update_overlap:
-  forall fr ty ofs v ty' ofs',
-  ofs <> ofs' ->
-  ofs' + 4 * typesize ty' > ofs -> ofs + 4 * typesize ty > ofs' ->
-  fr_contents (update ty ofs v fr) ty' ofs' = Vundef.
-Proof.
-  intros. simpl. rewrite zeq_false; auto.
-  rewrite <- typesize_typesize in H0. 
-  rewrite <- typesize_typesize in H1.
-  repeat rewrite zle_false; auto.
-Qed.
-
-Remark frame_update_mismatch:
-  forall fr ty ofs v ty',
-  ty <> ty' ->
-  fr_contents (update ty ofs v fr) ty' ofs = Vundef.
-Proof.
-  intros. simpl. rewrite zeq_true. 
-  destruct (typ_eq ty ty'); congruence.
-Qed.
-
-Lemma slot_gso:
-  forall fr1 ty ofs v fr2 ty' ofs' v',
-  set_slot fr1 ty ofs v fr2 ->
-  get_slot fr1 ty' ofs' v' ->
-  ofs' + 4 * typesize ty' <= ofs \/ ofs + 4 * typesize ty <= ofs' ->
-  get_slot fr2 ty' ofs' v'.
-Proof.
-  intros. inv H. inv H0.
-  constructor; auto.
-  symmetry. simpl fr_low. apply frame_update_gso. omega.
-Qed.
-
-Lemma slot_gi:
-  forall f ofs ty,
-  24 <= ofs -> fr_low (init_frame f) + ofs + 4 * typesize ty <= 0 ->
-  get_slot (init_frame f) ty ofs Vundef.
-Proof.
-  intros. rewrite <- typesize_typesize in H0. constructor; auto.
-Qed.
-*)
-
 Section PRESERVATION.
 
 Variable prog: Linear.program.
@@ -219,20 +134,13 @@ Definition index_diff (idx1 idx2: frame_index) : Prop :=
   | _, _ => True
   end.
 
-Remark align_float_part:
-  24 + 4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b <=
-  align (24 + 4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b) 8.
-Proof.
-  apply align_le. omega.
-Qed.
-
 Ltac AddPosProps :=
   generalize (bound_int_local_pos b); intro;
   generalize (bound_float_local_pos b); intro;
   generalize (bound_int_callee_save_pos b); intro;
   generalize (bound_float_callee_save_pos b); intro;
   generalize (bound_outgoing_pos b); intro;
-  generalize align_float_part; intro.
+  generalize (align_float_part b); intro.
 
 Lemma size_pos: fe.(fe_size) >= 0.
 Proof.
@@ -1383,10 +1291,9 @@ Lemma shift_eval_addressing:
                  (transl_addr (make_env (function_bounds f)) addr) args =
   Some v.
 Proof.
-  intros. destruct addr; auto.
-  simpl. rewrite symbols_preserved. auto.
-  simpl. rewrite symbols_preserved. auto.
-  unfold transl_addr, eval_addressing in *.
+  intros.
+  unfold transl_addr, eval_addressing in *;
+  destruct addr; try (rewrite symbols_preserved); auto.
   destruct args; try discriminate.
   apply shift_offset_sp; auto.
 Qed.
diff --git a/backend/Stackingtyping.v b/backend/Stackingtyping.v
index f3fe24f2..f1fe2cf0 100644
--- a/backend/Stackingtyping.v
+++ b/backend/Stackingtyping.v
@@ -25,6 +25,7 @@ Require Import Lineartyping.
 Require Import Mach.
 Require Import Machtyping.
 Require Import Bounds.
+Require Import Stacklayout.
 Require Import Stacking.
 Require Import Stackingproof.