Merge pull request #1 from Lionel-Rieg/v3.7-velus

V3.7 velus

307 files changed, 28881 insertions, 7791 deletions

diff --git a/.gitattributes b/.gitattributes
new file mode 100644
index 00000000..02ab53c1
--- /dev/null
+++ b/.gitattributes
@@ -0,0 +1,3 @@
+# Files that should be ignored by Github linguist
+test/* linguist-vendored
+doc/* linguist-documentation
diff --git a/.gitignore b/.gitignore
index f33b2173..da883cff 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,7 @@
 # Object files, in general
 *.vo
+*.vok
+*.vos
 *.glob
 *.o
 *.a
@@ -40,6 +42,9 @@
 /riscV/ConstpropOp.v
 /riscV/SelectOp.v
 /riscV/SelectLong.v
+/aarch64/ConstpropOp.v
+/aarch64/SelectOp.v
+/aarch64/SelectLong.v
 /backend/SelectDiv.v
 /backend/SplitLong.v
 /cparser/Parser.v
diff --git a/Changelog b/Changelog
index e5e701d0..8cf4e548 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,103 @@
+Release 3.7, 2020-03-31
+=======================
+
+ISO C conformance:
+- Functions declared `extern` then implemented `inline` remain `extern`
+- The type of a wide char constant is `wchar_t`, not `int`
+- Support vertical tabs and treat them as whitespace
+- Define the semantics of `free(NULL)`
+
+Bug fixing:
+- Take sign into account for conversions from 32-bit integers to 64-bit pointers
+- PowerPC: more precise determination of small data accesses
+- AArch64: when addressing global variables, check for correct alignment
+- PowerPC, ARM: double rounding error in int64->float32 conversions
+
+ABI conformance:
+- x86, AArch64: re-normalize values of small integer types returned by
+  function calls
+- PowerPC: `float` arguments passed on stack are passed in 64-bit format
+- RISC-V: use the new ELF psABI instead of the old ABI from ISA 2.1
+
+Usability and diagnostics:
+- Unknown builtin functions trigger a specific error message
+- Improved error messages
+
+Coq formalization:
+- Revised modeling of the PowerPC/EREF `isel` instruction
+- Weaker `ec_readonly` condition over external calls
+  (permissions can be dropped on read-only locations)
+
+Coq and OCaml development:
+- Compatibility with Coq version 8.10.1, 8.10.2, 8.11.0
+- Compatibility with OCaml 4.10 and up
+- Compatibility with Menhir 20200123 and up
+- Coq versions prior to 8.8.0 are no longer supported
+- OCaml versions prior to 4.05.0 are no longer supported
+
+
+Release 3.6, 2019-09-17
+=======================
+
+New features and optimizations:
+- New port targeting the AArch64 architecture: ARMv8 in 64-bit mode.
+- New optimization: if-conversion.  Some `if`/`else` statements
+  and `a ? b : c` conditional expressions are compiled to branchless
+  conditional move instructions, when supported by the target processor
+- New optimization flag: `-Obranchless`, to favor the generation of
+  branchless instruction sequences, even if probably slower than branches.
+- Built-in functions can now be given a formal semantics within
+  CompCert, instead of being treated as I/O interactions.
+  Currently, `__builtin_fsqrt` and `__builtin_bswap*` have semantics.
+- Extend constant propagation and CSE optimizations to built-in
+  functions that have known semantics.
+- New "polymorphic" built-in function: `__builtin_sel(a,b,c)`.
+  Similar to `a ? b : c` but `b` and `c` are always evaluated,
+  and a branchless conditional move instruction is produced if possible.
+- x86 64 bits: faster, branchless instruction sequences are produced
+  for conversions between `double` and `unsigned int`.
+- `__builtin_bswap64` is now available for all platforms.
+
+Usability and diagnostics:
+- Improved the DWARF debug information generated in -g mode.
+- Added options -fcommon and -fno-common to control the generation
+  of "common" declarations for uninitialized global.
+- Check for reserved keywords `_Complex` and `_Imaginary`.
+- Reject function declarations with multiple `void` parameters.
+- Define macros `__COMPCERT_MAJOR__`, `__COMPCERT_MINOR__`, and
+  `__COMPCERT_VERSION__` with CompCert's version number. (#284)
+- Prepend `$(DESTDIR)` to the installation target. (#169)
+- Extended inline asm: print register names according to the
+  types of the corresponding arguments (e.g. for x86_64,
+  `%eax` if int and `%rax` if long).
+
+Bug fixing:
+- Introduce distinct scopes for iteration and selection statements,
+  as required by ISO C99.
+- Handle dependencies in sequences of declarations
+  (e.g. `int * x, sz = sizeof(x);`).  (#267)
+- Corrected the check for overflow in integer literals.
+- On x86, __builtin_fma was producing wrong code in some cases.
+- `float` arguments to `__builtin_annot` and `__builtin_ais_annot`
+  were uselessly promoted to type `double`.
+
+Coq formalization and development:
+- Improved C parser based on Menhir version 20190626:
+  fewer run-time checks, faster validation, no axioms. (#276)
+- Compatibility with Coq versions 8.9.1 and 8.10.0.
+- Compatibility with OCaml versions 4.08.0 and 4.08.1.
+- Updated to Flocq version 3.1.
+- Revised the construction of NaN payloads in processor descriptions
+  so as to accommodate FMA.
+- Removed some definitions and lemmas from lib/Coqlib.v, using Coq's
+  standard library instead.
+
+The clightgen tool:
+- Fix normalization of Clight `switch` statements. (#285)
+- Add more tracing options: `-dprepro`, `-dall`. (#298)
+- Fix the output of `-dclight`. (#314)
+
+
 Release 3.5, 2019-02-27
 =======================
 
diff --git a/LICENSE b/LICENSE
index 5c7d7294..5a7ae79f 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,6 +1,6 @@
 All files in this distribution are part of the CompCert verified compiler.
 
-The CompCert verified compiler is Copyright by Institut National de 
+The CompCert verified compiler is Copyright by Institut National de
 Recherche en Informatique et en Automatique (INRIA) and
 AbsInt Angewandte Informatik GmbH.
 
@@ -9,12 +9,12 @@ INRIA Non-Commercial License Agreement given below or under the terms
 of a Software Usage Agreement of AbsInt Angewandte Informatik GmbH.
 The latter is a separate contract document.
 
-The INRIA Non-Commercial License Agreement is a non-free license that 
-grants you the right to use the CompCert verified compiler for 
-educational, research or evaluation purposes only, but prohibits 
+The INRIA Non-Commercial License Agreement is a non-free license that
+grants you the right to use the CompCert verified compiler for
+educational, research or evaluation purposes only, but prohibits
 any commercial use.
 
-For commercial use you need a Software Usage Agreement from 
+For commercial use you need a Software Usage Agreement from
 AbsInt Angewandte Informatik GmbH.
 
 The following files in this distribution are dual-licensed both under
@@ -38,7 +38,7 @@ option) any later version:
   cfrontend/Ctyping.v
   cfrontend/PrintClight.ml
   cfrontend/PrintCsyntax.ml
-  
+
   backend/Cminor.v
   backend/PrintCminor.ml
 
@@ -46,7 +46,7 @@ option) any later version:
 
   all files in the exportclight/ directory
 
-  the Archi.v, CBuiltins.ml, and extractionMachdep.v files 
+  the Archi.v, CBuiltins.ml, and extractionMachdep.v files
   in directories arm, powerpc, riscV, x86, x86_32, x86_64
 
   extraction/extraction.v
@@ -64,11 +64,14 @@ non-commercial contexts, subject to the terms of the GNU General
 Public License.
 
 The files contained in the flocq/ directory and its subdirectories are
-taken from the Flocq project, http://flocq.gforge.inria.fr/
-These files are Copyright 2010-2017 INRIA and distributed under the
-terms of the GNU Lesser General Public Licence, either version 3 of
-the licence, or (at your option) any later version.  A copy of the GNU
-Lesser General Public Licence version 3 is included below.
+taken from the Flocq project, http://flocq.gforge.inria.fr/. The files
+contained in the MenhirLib directory are taken from the Menhir
+project, http://gallium.inria.fr/~fpottier/menhir/. The files from the
+Flocq project and the files in the MenhirLib directory are Copyright
+2010-2019 INRIA and distributed under the terms of the GNU Lesser
+General Public Licence, either version 3 of the licence, or (at your
+option) any later version. A copy of the GNU Lesser General Public
+Licence version 3 is included below.
 
 The files contained in the runtime/ directory and its subdirectories
 are Copyright 2013-2017 INRIA and distributed under the terms of the BSD
diff --git a/Makefile b/Makefile
index 5a9701aa..af069e3f 100644
--- a/Makefile
+++ b/Makefile
@@ -23,12 +23,14 @@ endif
 
 DIRS=lib common $(ARCHDIRS) backend cfrontend driver \
   flocq/Core flocq/Prop flocq/Calc flocq/IEEE754 \
-  exportclight cparser cparser/MenhirLib
+  exportclight MenhirLib cparser
 
-RECDIRS=lib common $(ARCHDIRS) backend cfrontend driver flocq exportclight cparser
+RECDIRS=lib common $(ARCHDIRS) backend cfrontend driver flocq exportclight \
+  MenhirLib cparser
 
 COQINCLUDES=$(foreach d, $(RECDIRS), -R $(d) compcert.$(d))
 
+COQCOPTS ?= -w -undeclared-scope
 COQC="$(COQBIN)coqc" -q $(COQINCLUDES) $(COQCOPTS)
 COQDEP="$(COQBIN)coqdep" $(COQINCLUDES)
 COQDOC="$(COQBIN)coqdoc"
@@ -53,7 +55,7 @@ FLOCQ=\
 # General-purpose libraries (in lib/)
 
 VLIB=Axioms.v Coqlib.v Intv.v Maps.v Heaps.v Lattice.v Ordered.v \
-  Iteration.v Integers.v Archi.v Fappli_IEEE_extra.v Floats.v \
+  Iteration.v Zbits.v Integers.v Archi.v IEEE754_extra.v Floats.v \
   Parmov.v UnionFind.v Wfsimpl.v \
   Postorder.v FSetAVLplus.v IntvSets.v Decidableplus.v BoolEqual.v
 
@@ -62,12 +64,12 @@ VLIB=Axioms.v Coqlib.v Intv.v Maps.v Heaps.v Lattice.v Ordered.v \
 COMMON=Errors.v AST.v Linking.v \
   Events.v Globalenvs.v Memdata.v Memtype.v Memory.v \
   Values.v Smallstep.v Behaviors.v Switch.v Determinism.v Unityping.v \
-  Separation.v
+  Separation.v Builtins0.v Builtins1.v Builtins.v
 
 # Back-end modules (in backend/, $(ARCH)/)
 
 BACKEND=\
-  Cminor.v Op.v CminorSel.v \
+  Cminor.v Cminortyping.v Op.v CminorSel.v \
   SelectOp.v SelectDiv.v SplitLong.v SelectLong.v Selection.v \
   SelectOpproof.v SelectDivproof.v SplitLongproof.v \
   SelectLongproof.v Selectionproof.v \
@@ -103,16 +105,16 @@ CFRONTEND=Ctypes.v Cop.v Csyntax.v Csem.v Ctyping.v Cstrategy.v Cexec.v \
   Cshmgen.v Cshmgenproof.v \
   Csharpminor.v Cminorgen.v Cminorgenproof.v
 
-# LR(1) parser validator
-
-PARSERVALIDATOR=Alphabet.v Interpreter_complete.v Interpreter.v \
-  Validator_complete.v Automaton.v Interpreter_correct.v Main.v \
-  Validator_safe.v Grammar.v Interpreter_safe.v Tuples.v
-
 # Parser
 
 PARSER=Cabs.v Parser.v
 
+# MenhirLib
+
+MENHIRLIB=Alphabet.v Automaton.v Grammar.v Interpreter_complete.v \
+  Interpreter_correct.v Interpreter.v Main.v Validator_complete.v \
+  Validator_safe.v Validator_classes.v
+
 # Putting everything together (in driver/)
 
 DRIVER=Compopts.v Compiler.v Complements.v
@@ -120,7 +122,7 @@ DRIVER=Compopts.v Compiler.v Complements.v
 # All source files
 
 FILES=$(VLIB) $(COMMON) $(BACKEND) $(CFRONTEND) $(DRIVER) $(FLOCQ) \
-  $(PARSERVALIDATOR) $(PARSER)
+  $(MENHIRLIB) $(PARSER)
 
 # Generated source files
 
@@ -141,7 +143,6 @@ ifeq ($(CLIGHTGEN),true)
 	$(MAKE) clightgen
 endif
 
-
 proof: $(FILES:.v=.vo)
 
 # Turn off some warnings for compiling Flocq
@@ -225,7 +226,7 @@ driver/Version.ml: VERSION
 
 cparser/Parser.v: cparser/Parser.vy
 	@rm -f $@
-	$(MENHIR) $(MENHIR_FLAGS) --coq cparser/Parser.vy
+	$(MENHIR) --coq --coq-lib-path compcert.MenhirLib --coq-no-version-check cparser/Parser.vy
 	@chmod a-w $@
 
 depend: $(GENERATED) depend1
@@ -235,29 +236,29 @@ depend1: $(FILES) exportclight/Clightdefs.v
 	@$(COQDEP) $^ > .depend
 
 install:
-	install -d $(BINDIR)
-	install -m 0755 ./ccomp $(BINDIR)
-	install -d $(SHAREDIR)
-	install -m 0644 ./compcert.ini $(SHAREDIR)
-	install -d $(MANDIR)/man1
-	install -m 0644 ./doc/ccomp.1 $(MANDIR)/man1
+	install -d $(DESTDIR)$(BINDIR)
+	install -m 0755 ./ccomp $(DESTDIR)$(BINDIR)
+	install -d $(DESTDIR)$(SHAREDIR)
+	install -m 0644 ./compcert.ini $(DESTDIR)$(SHAREDIR)
+	install -d $(DESTDIR)$(MANDIR)/man1
+	install -m 0644 ./doc/ccomp.1 $(DESTDIR)$(MANDIR)/man1
 	$(MAKE) -C runtime install
 ifeq ($(CLIGHTGEN),true)
-	install -m 0755 ./clightgen $(BINDIR)
+	install -m 0755 ./clightgen $(DESTDIR)$(BINDIR)
 endif
 ifeq ($(INSTALL_COQDEV),true)
-	install -d $(COQDEVDIR)
+	install -d $(DESTDIR)$(COQDEVDIR)
 	for d in $(DIRS); do \
-          install -d $(COQDEVDIR)/$$d && \
-          install -m 0644 $$d/*.vo $(COQDEVDIR)/$$d/; \
+          install -d $(DESTDIR)$(COQDEVDIR)/$$d && \
+          install -m 0644 $$d/*.vo $(DESTDIR)$(COQDEVDIR)/$$d/; \
 	done
-	install -m 0644 ./VERSION $(COQDEVDIR)
-	@(echo "To use, pass the following to coq_makefile or add the following to _CoqProject:"; echo "-R $(COQDEVDIR) compcert") > $(COQDEVDIR)/README
+	install -m 0644 ./VERSION $(DESTDIR)$(COQDEVDIR)
+	@(echo "To use, pass the following to coq_makefile or add the following to _CoqProject:"; echo "-R $(COQDEVDIR) compcert") > $(DESTDIR)$(COQDEVDIR)/README
 endif
 
 
 clean:
-	rm -f $(patsubst %, %/*.vo, $(DIRS))
+	rm -f $(patsubst %, %/*.vo*, $(DIRS))
 	rm -f $(patsubst %, %/.*.aux, $(DIRS))
 	rm -rf doc/html doc/*.glob
 	rm -f driver/Version.ml
diff --git a/Makefile.extr b/Makefile.extr
index a1c2ef7c..5948bfc6 100644
--- a/Makefile.extr
+++ b/Makefile.extr
@@ -50,12 +50,12 @@ INCLUDES=$(patsubst %,-I %, $(DIRS))
 # Control of warnings:
 
 WARNINGS=-w +a-4-9-27 -strict-sequence -safe-string -warn-error +a #Deprication returns with ocaml 4.03
-extraction/%.cmx: WARNINGS +=-w -20-27-32..34-39-41-44..45
-extraction/%.cmo: WARNINGS +=-w -20-27-32..34-39-41-44..45
+extraction/%.cmx: WARNINGS +=-w -20-27-32..34-39-41-44..45-60-67
+extraction/%.cmo: WARNINGS +=-w -20-27-32..34-39-41-44..45-60-67
 cparser/pre_parser.cmx: WARNINGS += -w -41
 cparser/pre_parser.cmo: WARNINGS += -w -41
 
-COMPFLAGS+=-g $(INCLUDES) $(MENHIR_INCLUDES) $(WARNINGS)
+COMPFLAGS+=-g $(INCLUDES) -I "$(MENHIR_DIR)" $(WARNINGS)
 
 # Using .opt compilers if available
 
diff --git a/Makefile.menhir b/Makefile.menhir
index 98bfc750..7909b2f6 100644
--- a/Makefile.menhir
+++ b/Makefile.menhir
@@ -41,7 +41,11 @@ MENHIR_FLAGS = -v --no-stdlib -la 1
 # Using Menhir in --table mode requires MenhirLib.
 
 ifeq ($(MENHIR_TABLE),true)
-  MENHIR_LIBS = menhirLib.cmx
+  ifeq ($(wildcard $(MENHIR_DIR)/menhirLib.cmxa),)
+    MENHIR_LIBS = menhirLib.cmx
+  else
+    MENHIR_LIBS = menhirLib.cmxa
+  endif
 else
   MENHIR_LIBS =
 endif
diff --git a/MenhirLib/Alphabet.v b/MenhirLib/Alphabet.v
new file mode 100644
index 00000000..29070e3d
--- /dev/null
+++ b/MenhirLib/Alphabet.v
@@ -0,0 +1,247 @@
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
+
+From Coq Require Import Omega List Syntax Relations RelationClasses.
+
+Local Obligation Tactic := intros.
+
+(** A comparable type is equiped with a [compare] function, that define an order
+   relation. **)
+Class Comparable (A:Type) := {
+  compare : A -> A -> comparison;
+  compare_antisym : forall x y, CompOpp (compare x y) = compare y x;
+  compare_trans :  forall x y z c,
+    (compare x y) = c -> (compare y z) = c -> (compare x z) = c
+}.
+
+Theorem compare_refl {A:Type} (C: Comparable A) :
+  forall x, compare x x = Eq.
+Proof.
+intros.
+pose proof (compare_antisym x x).
+destruct (compare x x); intuition; try discriminate.
+Qed.
+
+(** The corresponding order is a strict order. **)
+Definition comparableLt {A:Type} (C: Comparable A) : relation A :=
+  fun x y => compare x y = Lt.
+
+Instance ComparableLtStrictOrder {A:Type} (C: Comparable A) :
+  StrictOrder (comparableLt C).
+Proof.
+apply Build_StrictOrder.
+unfold Irreflexive, Reflexive, complement, comparableLt.
+intros.
+pose proof H.
+rewrite <- compare_antisym in H.
+rewrite H0 in H.
+discriminate H.
+unfold Transitive, comparableLt.
+intros x y z.
+apply compare_trans.
+Qed.
+
+(** nat is comparable. **)
+Program Instance natComparable : Comparable nat :=
+  { compare := Nat.compare }.
+Next Obligation.
+symmetry.
+destruct (Nat.compare x y)  as [] eqn:?.
+rewrite Nat.compare_eq_iff in Heqc.
+destruct Heqc.
+rewrite Nat.compare_eq_iff.
+trivial.
+rewrite <- nat_compare_lt in *.
+rewrite <- nat_compare_gt in *.
+trivial.
+rewrite <- nat_compare_lt in *.
+rewrite <- nat_compare_gt in *.
+trivial.
+Qed.
+Next Obligation.
+destruct c.
+rewrite Nat.compare_eq_iff in *; destruct H; assumption.
+rewrite <- nat_compare_lt in *.
+apply (Nat.lt_trans _ _ _ H H0).
+rewrite <- nat_compare_gt in *.
+apply (gt_trans _ _ _ H H0).
+Qed.
+
+(** A pair of comparable is comparable. **)
+Program Instance PairComparable {A:Type} (CA:Comparable A) {B:Type} (CB:Comparable B) :
+  Comparable (A*B) :=
+  { compare := fun x y =>
+      let (xa, xb) := x in let (ya, yb) := y in
+      match compare xa ya return comparison with
+        | Eq => compare xb yb
+        | x => x
+      end }.
+Next Obligation.
+destruct x, y.
+rewrite <- (compare_antisym a a0).
+rewrite <- (compare_antisym b b0).
+destruct (compare a a0); intuition.
+Qed.
+Next Obligation.
+destruct x, y, z.
+destruct (compare a a0) as [] eqn:?, (compare a0 a1) as [] eqn:?;
+try (rewrite <- H0 in H; discriminate);
+try (destruct (compare a a1) as [] eqn:?;
+  try (rewrite <- compare_antisym in Heqc0;
+         rewrite CompOpp_iff in Heqc0;
+         rewrite (compare_trans _ _ _  _ Heqc0 Heqc2) in Heqc1;
+         discriminate);
+  try (rewrite <- compare_antisym in Heqc1;
+         rewrite CompOpp_iff in Heqc1;
+         rewrite (compare_trans _ _ _ _ Heqc2 Heqc1) in Heqc0;
+         discriminate);
+  assumption);
+rewrite (compare_trans _ _ _ _ Heqc0 Heqc1);
+try assumption.
+apply (compare_trans _ _ _ _ H H0).
+Qed.
+
+(** Special case of comparable, where equality is Leibniz equality. **)
+Class ComparableLeibnizEq {A:Type} (C: Comparable A) :=
+  compare_eq : forall x y, compare x y = Eq -> x = y.
+
+(** Boolean equality for a [Comparable]. **)
+Definition compare_eqb {A:Type} {C:Comparable A} (x y:A) :=
+  match compare x y with
+    | Eq => true
+    | _ => false
+  end.
+
+Theorem compare_eqb_iff {A:Type} {C:Comparable A} {U:ComparableLeibnizEq C} :
+  forall x y, compare_eqb x y = true <-> x = y.
+Proof.
+unfold compare_eqb.
+intuition.
+apply compare_eq.
+destruct (compare x y); intuition; discriminate.
+destruct H.
+rewrite compare_refl; intuition.
+Qed.
+
+Instance NComparableLeibnizEq : ComparableLeibnizEq natComparable := Nat.compare_eq.
+
+(** A pair of ComparableLeibnizEq is ComparableLeibnizEq **)
+Instance PairComparableLeibnizEq
+  {A:Type} {CA:Comparable A} (UA:ComparableLeibnizEq CA)
+  {B:Type} {CB:Comparable B} (UB:ComparableLeibnizEq CB) :
+    ComparableLeibnizEq (PairComparable CA CB).
+Proof.
+intros x y; destruct x, y; simpl.
+pose proof (compare_eq a a0); pose proof (compare_eq b b0).
+destruct (compare a a0); try discriminate.
+intuition.
+destruct H2, H0.
+reflexivity.
+Qed.
+
+(** An [Finite] type is a type with the list of all elements. **)
+Class Finite (A:Type) := {
+  all_list : list A;
+  all_list_forall : forall x:A, In x all_list
+}.
+
+(** An alphabet is both [ComparableLeibnizEq] and [Finite]. **)
+Class Alphabet (A:Type) := {
+  AlphabetComparable :> Comparable A;
+  AlphabetComparableLeibnizEq :> ComparableLeibnizEq AlphabetComparable;
+  AlphabetFinite :> Finite A
+}.
+
+(** The [Numbered] class provides a conveniant way to build [Alphabet] instances,
+   with a good computationnal complexity. It is mainly a injection from it to
+   [positive] **)
+Class Numbered (A:Type) := {
+  inj : A -> positive;
+  surj : positive -> A;
+  surj_inj_compat : forall x, surj (inj x) = x;
+  inj_bound : positive;
+  inj_bound_spec : forall x, (inj x < Pos.succ inj_bound)%positive
+}.
+
+Program Instance NumberedAlphabet {A:Type} (N:Numbered A) : Alphabet A :=
+  { AlphabetComparable := {| compare := fun x y => Pos.compare (inj x) (inj y) |};
+    AlphabetFinite :=
+      {| all_list := fst (Pos.iter
+                           (fun '(l, p) => (surj p::l, Pos.succ p))
+                           ([], 1%positive) inj_bound) |} }.
+Next Obligation. simpl. now rewrite <- Pos.compare_antisym. Qed.
+Next Obligation.
+  match goal with c : comparison |- _ => destruct c end.
+  - rewrite Pos.compare_eq_iff in *. congruence.
+  - rewrite Pos.compare_lt_iff in *. eauto using Pos.lt_trans.
+  - rewrite Pos.compare_gt_iff in *. eauto using Pos.lt_trans.
+Qed.
+Next Obligation.
+  intros x y. unfold compare. intros Hxy.
+  assert (Hxy' : inj x = inj y).
+  (* We do not use [Pos.compare_eq_iff] directly to make sure the
+     proof is executable. *)
+  { destruct (Pos.eq_dec (inj x) (inj y)) as [|[]]; [now auto|].
+    now apply Pos.compare_eq_iff. }
+  (* Using rewrite here leads to non-executable proofs. *)
+  transitivity (surj (inj x)).
+  { apply eq_sym, surj_inj_compat. }
+  transitivity (surj (inj y)); cycle 1.
+  { apply surj_inj_compat. }
+  apply f_equal, Hxy'.
+Defined.
+Next Obligation.
+  rewrite <-(surj_inj_compat x).
+  generalize (inj_bound_spec x). generalize (inj x). clear x. intros x.
+  match goal with |- ?Hx -> In ?s (fst ?p) =>
+    assert ((Hx -> In s (fst p)) /\ snd p = Pos.succ inj_bound); [|now intuition] end.
+  rewrite Pos.lt_succ_r.
+  induction inj_bound as [|y [IH1 IH2]] using Pos.peano_ind;
+    (split; [intros Hx|]); simpl.
+  - rewrite (Pos.le_antisym _ _ Hx); auto using Pos.le_1_l.
+  - auto.
+  - rewrite Pos.iter_succ. destruct Pos.iter; simpl in *. subst.
+    rewrite Pos.le_lteq in Hx. destruct Hx as [?%Pos.lt_succ_r| ->]; now auto.
+  - rewrite Pos.iter_succ. destruct Pos.iter. simpl in IH2. subst. reflexivity.
+Qed.
+
+(** Definitions of [FSet]/[FMap] from [Comparable] **)
+Require Import OrderedTypeAlt.
+Require FSetAVL.
+Require FMapAVL.
+Import OrderedType.
+
+Module Type ComparableM.
+  Parameter t : Type.
+  Declare Instance tComparable : Comparable t.
+End ComparableM.
+
+Module OrderedTypeAlt_from_ComparableM (C:ComparableM) <: OrderedTypeAlt.
+  Definition t := C.t.
+  Definition compare : t -> t -> comparison := compare.
+
+  Infix "?=" := compare (at level 70, no associativity).
+
+  Lemma compare_sym x y : (y?=x) = CompOpp (x?=y).
+  Proof. exact (Logic.eq_sym (compare_antisym x y)). Qed.
+  Lemma compare_trans c x y z :
+    (x?=y) = c -> (y?=z) = c -> (x?=z) = c.
+  Proof.
+  apply compare_trans.
+  Qed.
+End OrderedTypeAlt_from_ComparableM.
+
+Module OrderedType_from_ComparableM (C:ComparableM) <: OrderedType.
+  Module Alt := OrderedTypeAlt_from_ComparableM C.
+  Include (OrderedType_from_Alt Alt).
+End OrderedType_from_ComparableM.
diff --git a/cparser/MenhirLib/Automaton.v b/MenhirLib/Automaton.v
index fc995298..d5a19f35 100644
--- a/cparser/MenhirLib/Automaton.v
+++ b/MenhirLib/Automaton.v
@@ -1,23 +1,20 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
 
 Require Grammar.
-Require Import Orders.
 Require Export Alphabet.
-Require Export List.
-Require Export Syntax.
+From Coq Require Import Orders.
+From Coq Require Export List Syntax.
 
 Module Type AutInit.
   (** The grammar of the automaton. **)
@@ -102,9 +99,9 @@ Module Types(Import Init:AutInit).
                  T term = last_symb_of_non_init_state s -> lookahead_action term
   | Reduce_act: production -> lookahead_action term
   | Fail_act: lookahead_action term.
-  Arguments Shift_act [term].
-  Arguments Reduce_act [term].
-  Arguments Fail_act [term].
+  Arguments Shift_act {term}.
+  Arguments Reduce_act {term}.
+  Arguments Fail_act {term}.
 
   Inductive action :=
   | Default_reduce_act: production -> action
diff --git a/MenhirLib/Grammar.v b/MenhirLib/Grammar.v
new file mode 100644
index 00000000..a371318b
--- /dev/null
+++ b/MenhirLib/Grammar.v
@@ -0,0 +1,162 @@
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
+
+From Coq Require Import List Syntax Orders.
+Require Import Alphabet.
+
+(** The terminal non-terminal alphabets of the grammar. **)
+Module Type Alphs.
+  Parameters terminal nonterminal : Type.
+  Declare Instance TerminalAlph: Alphabet terminal.
+  Declare Instance NonTerminalAlph: Alphabet nonterminal.
+End Alphs.
+
+(** Definition of the alphabet of symbols, given the alphabet of terminals
+    and the alphabet of non terminals **)
+Module Symbol(Import A:Alphs).
+
+  Inductive symbol :=
+    | T: terminal -> symbol
+    | NT: nonterminal -> symbol.
+
+  Program Instance SymbolAlph : Alphabet symbol :=
+    { AlphabetComparable := {| compare := fun x y =>
+        match x, y return comparison with
+          | T _, NT _ => Gt
+          | NT _, T _ => Lt
+          | T x, T y => compare x y
+          | NT x, NT y => compare x y
+        end |};
+      AlphabetFinite := {| all_list :=
+        map T all_list++map NT all_list |} }.
+  Next Obligation.
+    destruct x; destruct y; intuition; apply compare_antisym.
+  Qed.
+  Next Obligation.
+    destruct x; destruct y; destruct z; intuition; try discriminate.
+    apply (compare_trans _ t0); intuition.
+    apply (compare_trans _ n0); intuition.
+  Qed.
+  Next Obligation.
+    intros x y.
+    destruct x; destruct y; try discriminate; intros.
+    rewrite (compare_eq t t0); now intuition.
+    rewrite (compare_eq n n0); now intuition.
+  Defined.
+  Next Obligation.
+    rewrite in_app_iff.
+    destruct x; [left | right]; apply in_map; apply all_list_forall.
+  Qed.
+
+End Symbol.
+
+(** A curryfied function with multiple parameters **)
+Definition arrows_right: Type -> list Type -> Type :=
+  fold_right (fun A B => A -> B).
+
+Module Type T.
+  Include Alphs <+ Symbol.
+
+  (** [symbol_semantic_type] maps a symbols to the type of its semantic
+     values. **)
+  Parameter symbol_semantic_type: symbol -> Type.
+
+  (** The type of productions identifiers **)
+  Parameter production : Type.
+  Declare Instance ProductionAlph : Alphabet production.
+
+  (** Accessors for productions: left hand side, right hand side,
+     and semantic action. The semantic actions are given in the form
+     of curryfied functions, that take arguments in the reverse order. **)
+  Parameter prod_lhs: production -> nonterminal.
+  (* The RHS of a production is given in reversed order, so that symbols  *)
+  Parameter prod_rhs_rev: production -> list symbol.
+  Parameter prod_action:
+    forall p:production,
+      arrows_right
+        (symbol_semantic_type (NT (prod_lhs p)))
+        (map symbol_semantic_type (prod_rhs_rev p)).
+
+  (** Tokens are the atomic elements of the input stream: they contain
+     a terminal and a semantic value of the type corresponding to this
+     terminal. *)
+  Parameter token : Type.
+  Parameter token_term : token -> terminal.
+  Parameter token_sem :
+    forall tok : token, symbol_semantic_type (T (token_term tok)).
+End T.
+
+Module Defs(Import G:T).
+
+  (** The semantics of a grammar is defined in two stages. First, we
+    define the notion of parse tree, which represents one way of
+    recognizing a word with a head symbol. Semantic values are stored
+    at the leaves.
+
+      This notion is defined in two mutually recursive flavours:
+    either for a single head symbol, or for a list of head symbols. *)
+  Inductive parse_tree:
+    forall (head_symbol:symbol) (word:list token), Type :=
+
+  (** Parse tree for a terminal symbol. *)
+  | Terminal_pt:
+    forall (tok:token), parse_tree (T (token_term tok)) [tok]
+
+  (** Parse tree for a non-terminal symbol.  *)
+  | Non_terminal_pt:
+    forall (prod:production) {word:list token},
+      parse_tree_list (prod_rhs_rev prod) word ->
+      parse_tree (NT (prod_lhs prod)) word
+
+  (* Note : the list head_symbols_rev is reversed. *)
+  with parse_tree_list:
+    forall (head_symbols_rev:list symbol) (word:list token), Type :=
+
+  | Nil_ptl: parse_tree_list [] []
+
+  | Cons_ptl:
+    forall {head_symbolsq:list symbol} {wordq:list token},
+      parse_tree_list head_symbolsq wordq ->
+
+    forall {head_symbolt:symbol} {wordt:list token},
+      parse_tree head_symbolt wordt ->
+
+      parse_tree_list (head_symbolt::head_symbolsq) (wordq++wordt).
+
+  (** We can now finish the definition of the semantics of a grammar,
+    by giving the semantic value assotiated with a parse tree. *)
+  Fixpoint pt_sem {head_symbol word} (tree:parse_tree head_symbol word) :
+    symbol_semantic_type head_symbol :=
+    match tree with
+    | Terminal_pt tok => token_sem tok
+    | Non_terminal_pt prod ptl => ptl_sem ptl (prod_action prod)
+    end
+  with ptl_sem {A head_symbols word} (tree:parse_tree_list head_symbols word) :
+    arrows_right A (map symbol_semantic_type head_symbols) -> A :=
+    match tree with
+    | Nil_ptl => fun act => act
+    | Cons_ptl q t => fun act => ptl_sem q (act (pt_sem t))
+    end.
+
+  Fixpoint pt_size {head_symbol word} (tree:parse_tree head_symbol word) :=
+    match tree with
+      | Terminal_pt _ => 1
+      | Non_terminal_pt _ l => S (ptl_size l)
+    end
+  with ptl_size {head_symbols word} (tree:parse_tree_list head_symbols word) :=
+    match tree with
+      | Nil_ptl => 0
+      | Cons_ptl q t =>
+         pt_size t + ptl_size q
+    end.
+End Defs.
diff --git a/MenhirLib/Interpreter.v b/MenhirLib/Interpreter.v
new file mode 100644
index 00000000..568597ba
--- /dev/null
+++ b/MenhirLib/Interpreter.v
@@ -0,0 +1,453 @@
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
+
+From Coq Require Import List Syntax.
+From Coq.ssr Require Import ssreflect.
+Require Automaton.
+Require Import Alphabet Grammar Validator_safe.
+
+Module Make(Import A:Automaton.T).
+Module Import ValidSafe := Validator_safe.Make A.
+
+(** A few helpers for dependent types. *)
+
+(** Decidable propositions. *)
+Class Decidable (P : Prop) := decide : {P} + {~P}.
+Arguments decide _ {_}.
+
+(** A [Comparable] type has decidable equality. *)
+Instance comparable_decidable_eq T `{ComparableLeibnizEq T} (x y : T) :
+  Decidable (x = y).
+Proof.
+  unfold Decidable.
+  destruct (compare x y) eqn:EQ; [left; apply compare_eq; intuition | ..];
+    right; intros ->; by rewrite compare_refl in EQ.
+Defined.
+
+Instance list_decidable_eq T :
+  (forall x y : T, Decidable (x = y)) ->
+  (forall l1 l2 : list T, Decidable (l1 = l2)).
+Proof. unfold Decidable. decide equality. Defined.
+
+Ltac subst_existT :=
+  repeat
+    match goal with
+    | _ => progress subst
+    | H : @existT ?A ?P ?x ?y1 = @existT ?A ?P ?x ?y2 |- _ =>
+      let DEC := fresh in
+      assert (DEC : forall u1 u2 : A, Decidable (u1 = u2)) by apply _;
+      apply Eqdep_dec.inj_pair2_eq_dec in H; [|by apply DEC];
+      clear DEC
+    end.
+
+(** The interpreter is written using dependent types. In order to
+  avoid reducing proof terms while executing the parser, we thunk all
+  the propositions behind an arrow.
+  Note that thunkP is still in Prop so that it is erased by
+  extraction.
+ *)
+Definition thunkP (P : Prop) : Prop := True -> P.
+
+(** Sometimes, we actually need a reduced proof in a program (for
+  example when using an equality to cast a value). In that case,
+  instead of reducing the proof we already have, we reprove the
+  assertion by using decidability. *)
+Definition reprove {P} `{Decidable P} (p : thunkP P) : P :=
+  match decide P with
+  | left p => p
+  | right np => False_ind _ (np (p I))
+  end.
+
+(** Combination of reprove with eq_rect. *)
+Definition cast {T : Type} (F : T -> Type) {x y : T} (eq : thunkP (x = y))
+                {DEC : unit -> Decidable (x = y)}:
+                F x -> F y :=
+  fun a => eq_rect x F a y (@reprove _ (DEC ()) eq).
+
+Lemma cast_eq T F (x : T) (eq : thunkP (x = x)) `{forall x y, Decidable (x = y)} a :
+  cast F eq a = a.
+Proof. by rewrite /cast -Eqdep_dec.eq_rect_eq_dec. Qed.
+
+(** Input buffers and operations on them. **)
+CoInductive buffer : Type :=
+  Buf_cons { buf_head : token; buf_tail : buffer }.
+
+Delimit Scope buffer_scope with buf.
+Bind Scope buffer_scope with buffer.
+
+Infix "::" := Buf_cons (at level 60, right associativity) : buffer_scope.
+
+(** Concatenation of a list and an input buffer **)
+Fixpoint app_buf (l:list token) (buf:buffer) :=
+  match l with
+    | nil => buf
+    | cons t q => (t :: app_buf q buf)%buf
+  end.
+Infix "++" := app_buf (at level 60, right associativity) : buffer_scope.
+
+Lemma app_buf_assoc (l1 l2:list token) (buf:buffer) :
+  (l1 ++ (l2 ++ buf) = (l1 ++ l2) ++ buf)%buf.
+Proof. induction l1 as [|?? IH]=>//=. rewrite IH //. Qed.
+
+(** The type of a non initial state: the type of semantic values associated
+   with the last symbol of this state. *)
+Definition noninitstate_type state :=
+  symbol_semantic_type (last_symb_of_non_init_state state).
+
+(** The stack of the automaton : it can be either nil or contains a non
+    initial state, a semantic value for the symbol associted with this state,
+    and a nested stack. **)
+Definition stack := list (sigT noninitstate_type). (* eg. list {state & state_type state} *)
+
+Section Interpreter.
+
+Hypothesis safe: safe.
+
+(* Properties of the automaton deduced from safety validation. *)
+Proposition shift_head_symbs: shift_head_symbs.
+Proof. pose proof safe; unfold ValidSafe.safe in H; intuition. Qed.
+Proposition goto_head_symbs: goto_head_symbs.
+Proof. pose proof safe; unfold ValidSafe.safe in H; intuition. Qed.
+Proposition shift_past_state: shift_past_state.
+Proof. pose proof safe; unfold ValidSafe.safe in H; intuition. Qed.
+Proposition goto_past_state: goto_past_state.
+Proof. pose proof safe; unfold ValidSafe.safe in H; intuition. Qed.
+Proposition reduce_ok: reduce_ok.
+Proof. pose proof safe; unfold ValidSafe.safe in H; intuition. Qed.
+
+Variable init : initstate.
+
+(** The top state of a stack **)
+Definition state_of_stack (stack:stack): state :=
+  match stack with
+    | [] => init
+    | existT _ s _::_ => s
+  end.
+
+(** The stack of states of an automaton stack **)
+Definition state_stack_of_stack (stack:stack) :=
+  (List.map
+    (fun cell:sigT noninitstate_type => singleton_state_pred (projT1 cell))
+    stack ++ [singleton_state_pred init])%list.
+
+(** The stack of symbols of an automaton stack **)
+Definition symb_stack_of_stack (stack:stack) :=
+  List.map
+    (fun cell:sigT noninitstate_type => last_symb_of_non_init_state (projT1 cell))
+    stack.
+
+(** The stack invariant : it basically states that the assumptions on the
+    states are true. **)
+Inductive stack_invariant: stack -> Prop :=
+  | stack_invariant_constr:
+    forall stack,
+      prefix      (head_symbs_of_state (state_of_stack stack))
+                  (symb_stack_of_stack stack) ->
+      prefix_pred (head_states_of_state (state_of_stack stack))
+                  (state_stack_of_stack stack) ->
+      stack_invariant_next stack ->
+      stack_invariant stack
+with stack_invariant_next: stack -> Prop :=
+  | stack_invariant_next_nil:
+      stack_invariant_next []
+  | stack_invariant_next_cons:
+    forall state_cur st stack_rec,
+      stack_invariant stack_rec ->
+      stack_invariant_next (existT _ state_cur st::stack_rec).
+
+(** [pop] pops some symbols from the stack. It returns the popped semantic
+    values using [sem_popped] as an accumulator and discards the popped
+    states.**)
+Fixpoint pop (symbols_to_pop:list symbol) {A:Type} (stk:stack) :
+  thunkP (prefix symbols_to_pop (symb_stack_of_stack stk)) ->
+  forall (action:arrows_right A (map symbol_semantic_type symbols_to_pop)),
+    stack * A.
+unshelve refine
+  (match symbols_to_pop
+      return
+         (thunkP (prefix symbols_to_pop (symb_stack_of_stack stk))) ->
+         forall (action:arrows_right A (map _ symbols_to_pop)), stack * A
+   with
+     | [] => fun _ action => (stk, action)
+     | t::q => fun Hp action =>
+       match stk
+          return thunkP (prefix (t::q) (symb_stack_of_stack stk)) -> stack * A
+       with
+         | existT _ state_cur sem::stack_rec => fun Hp =>
+           let sem_conv := cast symbol_semantic_type _ sem in
+           pop q _ stack_rec _ (action sem_conv)
+         | [] => fun Hp => False_rect _ _
+       end Hp
+   end).
+Proof.
+  - simpl in Hp. clear -Hp. abstract (intros _ ; specialize (Hp I); now inversion Hp).
+  - clear -Hp. abstract (specialize (Hp I); now inversion Hp).
+  - simpl in Hp. clear -Hp. abstract (intros _ ; specialize (Hp I); now inversion Hp).
+Defined.
+
+(* Equivalent declarative specification for pop, so that we avoid
+   (part of) the dependent types nightmare. *)
+Inductive pop_spec {A:Type} :
+    forall (symbols_to_pop:list symbol) (stk : stack)
+           (action : arrows_right A (map symbol_semantic_type symbols_to_pop))
+           (stk' : stack) (sem : A),
+      Prop :=
+  | Nil_pop_spec stk sem : pop_spec [] stk sem stk sem
+  | Cons_pop_spec symbols_to_pop st stk action sem stk' res :
+      pop_spec symbols_to_pop stk (action sem) stk' res ->
+      pop_spec (last_symb_of_non_init_state st::symbols_to_pop)
+               (existT _ st sem :: stk) action stk' res.
+
+Lemma pop_spec_ok {A:Type} symbols_to_pop stk Hp action stk' res:
+  pop symbols_to_pop stk Hp action = (stk', res) <->
+  pop_spec (A:=A) symbols_to_pop stk action stk' res.
+Proof.
+  revert stk Hp action.
+  induction symbols_to_pop as [|t symbols_to_pop IH]=>stk Hp action /=.
+  - split.
+    + intros [= <- <-]. constructor.
+    + intros H. inversion H. by subst_existT.
+  - destruct stk as [|[st sem]]=>/=; [by destruct pop_subproof0|].
+    remember (pop_subproof t symbols_to_pop stk st Hp) as EQ eqn:eq. clear eq.
+    generalize EQ. revert Hp action. rewrite <-(EQ I)=>Hp action ?.
+    rewrite cast_eq. rewrite IH. split.
+    + intros. by constructor.
+    + intros H. inversion H. by subst_existT.
+Qed.
+
+
+Lemma pop_preserves_invariant symbols_to_pop stk Hp A action :
+  stack_invariant stk ->
+  stack_invariant (fst (pop symbols_to_pop stk Hp (A:=A) action)).
+Proof.
+  revert stk Hp A action. induction symbols_to_pop as [|t q IH]=>//=.
+  intros stk Hp A action Hi.
+  destruct Hi as [stack Hp' Hpp [|state st stk']].
+  - destruct pop_subproof0.
+  - now apply IH.
+Qed.
+
+Lemma pop_state_valid symbols_to_pop stk Hp A action lpred :
+  prefix_pred lpred (state_stack_of_stack stk) ->
+  let stk' := fst (pop symbols_to_pop stk Hp (A:=A) action) in
+  state_valid_after_pop (state_of_stack stk') symbols_to_pop lpred.
+Proof.
+  revert stk Hp A action lpred. induction symbols_to_pop as [|t q IH]=>/=.
+  - intros stk Hp A a lpred Hpp. destruct lpred as [|pred lpred]; constructor.
+    inversion Hpp as [|? lpred' ? pred' Himpl Hpp' eq1 eq2]; subst.
+    specialize (Himpl (state_of_stack stk)).
+    destruct (pred' (state_of_stack stk)) as [] eqn:Heqpred'=>//.
+    destruct stk as [|[]]; simpl in *.
+    + inversion eq2; subst; clear eq2.
+      unfold singleton_state_pred in Heqpred'.
+      now rewrite compare_refl in Heqpred'; discriminate.
+    + inversion eq2; subst; clear eq2.
+      unfold singleton_state_pred in Heqpred'.
+      now rewrite compare_refl in Heqpred'; discriminate.
+  - intros stk Hp A a lpred Hpp. destruct stk as [|[] stk]=>//=.
+    + destruct pop_subproof0.
+    + destruct lpred as [|pred lpred]; [by constructor|].
+      constructor. apply IH. by inversion Hpp.
+Qed.
+
+(** [step_result] represents the result of one step of the automaton : it can
+    fail, accept or progress. [Fail_sr] means that the input is incorrect.
+    [Accept_sr] means that this is the last step of the automaton, and it
+    returns the semantic value of the input word. [Progress_sr] means that
+    some progress has been made, but new steps are needed in order to accept
+    a word.
+
+    For [Accept_sr] and [Progress_sr], the result contains the new input buffer.
+
+    [Fail_sr] means that the input word is rejected by the automaton. It is
+    different to [Err] (from the error monad), which mean that the automaton is
+    bogus and has perfomed a forbidden action. **)
+Inductive step_result :=
+  | Fail_sr: step_result
+  | Accept_sr: symbol_semantic_type (NT (start_nt init)) -> buffer -> step_result
+  | Progress_sr: stack -> buffer -> step_result.
+
+(** [reduce_step] does a reduce action :
+   - pops some elements from the stack
+   - execute the action of the production
+   - follows the goto for the produced non terminal symbol **)
+Definition reduce_step stk prod (buffer : buffer)
+        (Hval : thunkP (valid_for_reduce (state_of_stack stk) prod))
+        (Hi : thunkP (stack_invariant stk))
+  : step_result.
+refine
+  ((let '(stk', sem) as ss := pop (prod_rhs_rev prod) stk _ (prod_action prod)
+      return thunkP (state_valid_after_pop (state_of_stack (fst ss)) _
+                               (head_states_of_state (state_of_stack stk))) -> _
+    in fun Hval' =>
+    match goto_table (state_of_stack stk') (prod_lhs prod) as goto
+      return (thunkP (goto = None ->
+                      match state_of_stack stk' with
+                      | Init i => prod_lhs prod = start_nt i
+                      | Ninit _ => False
+                      end)) -> _
+    with
+    | Some (exist _ state_new e) => fun _ =>
+      let sem := eq_rect _ _ sem _ e in
+      Progress_sr (existT noninitstate_type state_new sem::stk') buffer
+    | None => fun Hval =>
+      let sem := cast symbol_semantic_type _ sem in
+      Accept_sr sem buffer
+    end (fun _ => _))
+   (fun _ => pop_state_valid _ _ _ _ _ _ _)).
+Proof.
+  - clear -Hi Hval.
+    abstract (intros _; destruct Hi=>//; eapply prefix_trans; [by apply Hval|eassumption]).
+  - clear -Hval.
+    abstract (intros _; f_equal; specialize (Hval I eq_refl); destruct stk' as [|[]]=>//).
+  - simpl in Hval'. clear -Hval Hval'.
+    abstract (move : Hval => /(_ I) [_ /(_ _ (Hval' I))] Hval2 Hgoto; by rewrite Hgoto in Hval2).
+  - clear -Hi. abstract by destruct Hi.
+Defined.
+
+Lemma reduce_step_stack_invariant_preserved stk prod buffer Hv Hi stk' buffer':
+  reduce_step stk prod buffer Hv Hi = Progress_sr stk' buffer' ->
+  stack_invariant stk'.
+Proof.
+  unfold reduce_step.
+  match goal with
+  | |- context [pop ?symbols_to_pop stk ?Hp ?action] =>
+    assert (Hi':=pop_preserves_invariant symbols_to_pop stk Hp _ action (Hi I));
+    generalize (pop_state_valid symbols_to_pop stk Hp _ action)
+  end.
+  destruct pop as [stk0 sem]=>/=. simpl in Hi'. intros Hv'.
+  assert (Hgoto1:=goto_head_symbs (state_of_stack stk0) (prod_lhs prod)).
+  assert (Hgoto2:=goto_past_state (state_of_stack stk0) (prod_lhs prod)).
+  match goal with | |- context [fun _ : True => ?X] => generalize X end.
+  destruct goto_table as [[state_new e]|] eqn:EQgoto=>//.
+  intros _ [= <- <-]. constructor=>/=.
+  - constructor. eapply prefix_trans. apply Hgoto1. by destruct Hi'.
+  - unfold state_stack_of_stack; simpl; constructor.
+    + intros ?. by destruct singleton_state_pred.
+    + eapply prefix_pred_trans. apply Hgoto2. by destruct Hi'.
+  - by constructor.
+Qed.
+
+(** One step of parsing. **)
+Definition step stk buffer (Hi : thunkP (stack_invariant stk)): step_result :=
+  match action_table (state_of_stack stk) as a return
+    thunkP
+      match a return Prop with
+      | Default_reduce_act prod => _
+      | Lookahead_act awt => forall t : terminal,
+        match awt t with
+        | Reduce_act p => _
+        | _ => True
+        end
+      end -> _
+  with
+  | Default_reduce_act prod => fun Hv =>
+    reduce_step stk prod buffer Hv Hi
+  | Lookahead_act awt => fun Hv =>
+    match buf_head buffer with
+    | tok =>
+      match awt (token_term tok) as a return
+        thunkP match a return Prop with Reduce_act p => _ | _ => _ end -> _
+      with
+      | Shift_act state_new e => fun _ =>
+        let sem_conv := eq_rect _ symbol_semantic_type (token_sem tok) _ e in
+        Progress_sr (existT noninitstate_type state_new sem_conv::stk)
+                    (buf_tail buffer)
+      | Reduce_act prod => fun Hv =>
+        reduce_step stk prod buffer Hv Hi
+      | Fail_act => fun _ =>
+        Fail_sr
+      end (fun _ => Hv I (token_term tok))
+    end
+  end (fun _ => reduce_ok _).
+
+Lemma step_stack_invariant_preserved stk buffer Hi stk' buffer':
+  step stk buffer Hi = Progress_sr stk' buffer' ->
+  stack_invariant stk'.
+Proof.
+  unfold step.
+  generalize (reduce_ok (state_of_stack stk))=>Hred.
+  assert (Hshift1 := shift_head_symbs (state_of_stack stk)).
+  assert (Hshift2 := shift_past_state (state_of_stack stk)).
+  destruct action_table as [prod|awt]=>/=.
+  - eauto using reduce_step_stack_invariant_preserved.
+  - set (term := token_term (buf_head buffer)).
+    generalize (Hred term). clear Hred. intros Hred.
+    specialize (Hshift1 term). specialize (Hshift2 term).
+    destruct (awt term) as [state_new e|prod|]=>//.
+    + intros [= <- <-]. constructor=>/=.
+      * constructor. eapply prefix_trans. apply Hshift1. by destruct Hi.
+      * unfold state_stack_of_stack; simpl; constructor.
+        -- intros ?. by destruct singleton_state_pred.
+        -- eapply prefix_pred_trans. apply Hshift2. by destruct Hi.
+      * constructor; by apply Hi.
+    + eauto using reduce_step_stack_invariant_preserved.
+Qed.
+
+(** The parsing use a [nat] fuel parameter [log_n_steps], so that we
+    do not have to prove terminaison, which is difficult.
+
+    Note that [log_n_steps] is *not* the fuel in the conventionnal
+    sense: this parameter contains the logarithm (in base 2) of the
+    number of steps to perform. Hence, a value of, e.g., 50 will
+    usually be enough to ensure termination. *)
+Fixpoint parse_fix stk buffer (log_n_steps : nat) (Hi : thunkP (stack_invariant stk)):
+  { sr : step_result |
+    forall stk' buffer', sr = Progress_sr stk' buffer' -> stack_invariant stk' } :=
+  match log_n_steps with
+  | O => exist _ (step stk buffer Hi)
+                 (step_stack_invariant_preserved _ _ Hi)
+  | S log_n_steps =>
+    match parse_fix stk buffer log_n_steps Hi with
+    | exist _ (Progress_sr stk buffer) Hi' =>
+      parse_fix stk buffer log_n_steps (fun _ => Hi' _ buffer eq_refl)
+    | sr => sr
+    end
+  end.
+
+(** The final result of a parsing is either a failure (the automaton
+    has rejected the input word), either a timeout (the automaton has
+    spent all the given [2^log_n_steps]), either a parsed semantic value
+    with a rest of the input buffer.
+
+    Note that we do not make parse_result depend on start_nt for the
+    result type, so that this inductive is extracted without the use
+    of Obj.t in OCaml.  **)
+Inductive parse_result {A : Type} :=
+  | Fail_pr: parse_result
+  | Timeout_pr: parse_result
+  | Parsed_pr: A -> buffer -> parse_result.
+Global Arguments parse_result _ : clear implicits.
+
+Definition parse (buffer : buffer) (log_n_steps : nat):
+  parse_result (symbol_semantic_type (NT (start_nt init))).
+refine (match proj1_sig (parse_fix [] buffer log_n_steps _) with
+        | Fail_sr => Fail_pr
+        | Accept_sr sem buffer' => Parsed_pr sem buffer'
+        | Progress_sr _ _ => Timeout_pr
+        end).
+Proof.
+  abstract (repeat constructor; intros; by destruct singleton_state_pred).
+Defined.
+
+End Interpreter.
+
+Arguments Fail_sr {init}.
+Arguments Accept_sr {init} _ _.
+Arguments Progress_sr {init} _ _.
+
+End Make.
+
+Module Type T(A:Automaton.T).
+  Include (Make A).
+End T.
diff --git a/MenhirLib/Interpreter_complete.v b/MenhirLib/Interpreter_complete.v
new file mode 100644
index 00000000..ec69592b
--- /dev/null
+++ b/MenhirLib/Interpreter_complete.v
@@ -0,0 +1,825 @@
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
+
+From Coq Require Import List Syntax Arith.
+From Coq.ssr Require Import ssreflect.
+Require Import Alphabet Grammar.
+Require Automaton Interpreter Validator_complete.
+
+Module Make(Import A:Automaton.T) (Import Inter:Interpreter.T A).
+Module Import Valid := Validator_complete.Make A.
+
+(** * Completeness Proof **)
+
+Section Completeness_Proof.
+
+Hypothesis safe: Inter.ValidSafe.safe.
+Hypothesis complete: complete.
+
+(* Properties of the automaton deduced from completeness validation. *)
+Proposition nullable_stable: nullable_stable.
+Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
+Proposition first_stable: first_stable.
+Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
+Proposition start_future: start_future.
+Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
+Proposition terminal_shift: terminal_shift.
+Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
+Proposition end_reduce: end_reduce.
+Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
+Proposition start_goto: start_goto.
+Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
+Proposition non_terminal_goto: non_terminal_goto.
+Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
+Proposition non_terminal_closed: non_terminal_closed.
+Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
+
+(** If the nullable predicate has been validated, then it is correct. **)
+Lemma nullable_correct head word :
+  word = [] -> parse_tree head word -> nullable_symb head = true
+with nullable_correct_list heads word :
+  word = [] ->
+  parse_tree_list heads word -> nullable_word heads = true.
+Proof.
+  - destruct 2=>//. assert (Hnull := nullable_stable prod).
+    erewrite nullable_correct_list in Hnull; eauto.
+  - intros Hword. destruct 1=>//=. destruct (app_eq_nil _ _ Hword).
+    eauto using andb_true_intro.
+Qed.
+
+(** Auxiliary lemma for first_correct.  *)
+Lemma first_word_set_app t word1 word2 :
+  TerminalSet.In t (first_word_set (word1 ++ word2)) <->
+  TerminalSet.In t (first_word_set word1) \/
+  TerminalSet.In t (first_word_set word2) /\ nullable_word (rev word1) = true.
+Proof.
+  induction word1 as [|s word1 IH]=>/=.
+  - split; [tauto|]. move=>[/TerminalSet.empty_1 ?|[? _]]//.
+  - rewrite /nullable_word forallb_app /=. destruct nullable_symb=>/=.
+    + rewrite Bool.andb_true_r. split.
+      * move=>/TerminalSet.union_1. rewrite IH.
+        move=>[?|[?|[??]]]; auto using TerminalSet.union_2, TerminalSet.union_3.
+      * destruct IH.
+        move=>[/TerminalSet.union_1 [?|?]|[??]];
+        auto using TerminalSet.union_2, TerminalSet.union_3.
+    + rewrite Bool.andb_false_r. by intuition.
+Qed.
+
+(** If the first predicate has been validated, then it is correct. **)
+Lemma first_correct head word t q :
+  word = t::q ->
+  parse_tree head word ->
+  TerminalSet.In (token_term t) (first_symb_set head)
+with first_correct_list heads word t q :
+  word = t::q ->
+  parse_tree_list heads word ->
+  TerminalSet.In (token_term t) (first_word_set (rev' heads)).
+Proof.
+  - intros Hword. destruct 1=>//.
+    + inversion Hword. subst. apply TerminalSet.singleton_2, compare_refl.
+    + eapply first_stable. eauto.
+  - intros Hword. destruct 1 as [|symq wordq ptl symt wordt pt]=>//=.
+    rewrite /rev' -rev_alt /= first_word_set_app /= rev_involutive rev_alt.
+    destruct wordq; [right|left].
+    + destruct nullable_symb; eauto using TerminalSet.union_2, nullable_correct_list.
+    + inversion Hword. subst. fold (rev' symq). eauto.
+Qed.
+
+(** A PTL is compatible with a stack if the top of the stack contains
+  data representing to this PTL. *)
+Fixpoint ptl_stack_compat {symbs word}
+         (stk0 : stack) (ptl : parse_tree_list symbs word) (stk : stack) : Prop :=
+  match ptl with
+  | Nil_ptl => stk0 = stk
+  | @Cons_ptl _ _ ptl sym _ pt =>
+    match stk with
+    | [] => False
+    | existT _ _ sem::stk =>
+      ptl_stack_compat stk0 ptl stk /\
+      exists e,
+        sem = eq_rect _ symbol_semantic_type (pt_sem pt) _ e
+    end
+  end.
+
+(** .. and when a PTL is compatible with a stack, then calling the pop
+  function return the semantic value of this PTL. *)
+Lemma pop_stack_compat_pop_spec {A symbs word}
+    (ptl:parse_tree_list symbs word) (stk:stack) (stk0:stack) action :
+  ptl_stack_compat stk0 ptl stk ->
+  pop_spec symbs stk action stk0 (ptl_sem (A:=A) ptl action).
+Proof.
+  revert stk. induction ptl=>stk /= Hstk.
+  - subst. constructor.
+  - destruct stk as [|[st sem] stk]=>//. destruct Hstk as [Hstk [??]]. subst.
+    simpl. constructor. eauto.
+Qed.
+
+Variable init: initstate.
+
+(** In order to prove compleness, we first fix a word to be parsed
+  together with the content of the parser at the end of the parsing. *)
+Variable full_word: list token.
+Variable buffer_end: buffer.
+
+(** Completeness is proved by following the traversal of the parse
+  tree which is performed by the parser. Each step of parsing
+  correspond to one step of traversal. In order to represent the state
+  of the traversal, we define the notion of "dotted" parse tree, which
+  is a parse tree with one dot on one of its node. The place of the
+  dot represents the place of the next action to be executed.
+
+  Such a dotted parse tree is decomposed into two part: a "regular"
+  parse tree, which is the parse tree placed under the dot, and a
+  "parse tree zipper", which is the part of the parse tree placed
+  above the dot. Therefore, a parse tree zipper is a parse tree with a
+  hole. Moreover, for easier manipulation, a parse tree zipper is
+  represented "upside down". That is, the root of the parse tree is
+  actually a leaf of the zipper, while the root of the zipper is the
+  hole.
+ *)
+Inductive pt_zipper:
+  forall (hole_symb:symbol) (hole_word:list token), Type :=
+| Top_ptz:
+  pt_zipper (NT (start_nt init)) full_word
+| Cons_ptl_ptz:
+  forall {head_symbolsq:list symbol} {wordq:list token},
+    parse_tree_list head_symbolsq wordq ->
+
+  forall {head_symbolt:symbol} {wordt:list token},
+
+    ptl_zipper (head_symbolt::head_symbolsq) (wordq++wordt) ->
+    pt_zipper head_symbolt wordt
+with ptl_zipper:
+  forall (hole_symbs:list symbol) (hole_word:list token), Type :=
+| Non_terminal_pt_ptlz:
+  forall {p:production} {word:list token},
+    pt_zipper (NT (prod_lhs p)) word ->
+    ptl_zipper (prod_rhs_rev p) word
+
+| Cons_ptl_ptlz:
+  forall {head_symbolsq:list symbol} {wordq:list token},
+
+  forall {head_symbolt:symbol} {wordt:list token},
+    parse_tree head_symbolt wordt ->
+
+  ptl_zipper (head_symbolt::head_symbolsq) (wordq++wordt) ->
+
+  ptl_zipper head_symbolsq wordq.
+
+(** A dotted parse tree is the combination of a parse tree zipper with
+  a parse tree. It can be intwo flavors, depending on which is the next
+  action to be executed (shift or reduce). *)
+Inductive pt_dot: Type :=
+| Reduce_ptd: forall {prod word},
+    parse_tree_list (prod_rhs_rev prod) word ->
+    pt_zipper (NT (prod_lhs prod)) word ->
+    pt_dot
+| Shift_ptd: forall (tok : token) {symbolsq wordq},
+    parse_tree_list symbolsq wordq ->
+    ptl_zipper (T (token_term tok)::symbolsq) (wordq++[tok]) ->
+    pt_dot.
+
+(** We can compute the full semantic value of a parse tree when
+  represented as a dotted ptd. *)
+
+Fixpoint ptlz_sem {hole_symbs hole_word}
+         (ptlz:ptl_zipper hole_symbs hole_word) :
+         (forall A, arrows_right A (map symbol_semantic_type hole_symbs) -> A) ->
+         (symbol_semantic_type (NT (start_nt init))) :=
+  match ptlz with
+  | @Non_terminal_pt_ptlz prod _ ptz =>
+    fun k => ptz_sem ptz (k _ (prod_action prod))
+  | Cons_ptl_ptlz pt ptlz =>
+    fun k => ptlz_sem ptlz (fun _ f => k _ (f (pt_sem pt)))
+  end
+with ptz_sem {hole_symb hole_word}
+             (ptz:pt_zipper hole_symb hole_word):
+  symbol_semantic_type hole_symb -> symbol_semantic_type (NT (start_nt init)) :=
+  match ptz with
+  | Top_ptz => fun sem => sem
+  | Cons_ptl_ptz ptl ptlz =>
+    fun sem => ptlz_sem ptlz (fun _ f => ptl_sem ptl (f sem))
+  end.
+
+Definition ptd_sem (ptd : pt_dot) :=
+  match ptd with
+  | @Reduce_ptd prod _ ptl ptz =>
+    ptz_sem ptz (ptl_sem ptl (prod_action prod))
+  | Shift_ptd tok ptl ptlz =>
+    ptlz_sem ptlz (fun _ f => ptl_sem ptl (f (token_sem tok)))
+  end.
+
+(** The buffer associated with a dotted parse tree corresponds to the
+  buffer left to be read by the parser when at the state represented
+  by the dotted parse tree. *)
+Fixpoint ptlz_buffer {hole_symbs hole_word}
+         (ptlz:ptl_zipper hole_symbs hole_word): buffer :=
+  match ptlz with
+  | Non_terminal_pt_ptlz ptz =>
+    ptz_buffer ptz
+  | @Cons_ptl_ptlz _ _ _ wordt _ ptlz' =>
+    wordt ++ ptlz_buffer ptlz'
+  end
+with ptz_buffer {hole_symb hole_word}
+                (ptz:pt_zipper hole_symb hole_word): buffer :=
+  match ptz with
+  | Top_ptz => buffer_end
+  | Cons_ptl_ptz _ ptlz =>
+    ptlz_buffer ptlz
+  end.
+
+Definition ptd_buffer (ptd:pt_dot) :=
+  match ptd with
+  | Reduce_ptd _ ptz => ptz_buffer ptz
+  | @Shift_ptd tok _ wordq _ ptlz => (tok::ptlz_buffer ptlz)%buf
+  end.
+
+(** We are now ready to define the main invariant of the proof of
+  completeness: we need to specify when a stack is compatible with a
+  dotted parse tree. Informally, a stack is compatible with a dotted
+  parse tree when it is the concatenation stack fragments which are
+  compatible with each of the partially recognized productions
+  appearing in the parse tree zipper. Moreover, the head of each of
+  these stack fragment contains a state which has an item predicted by
+  the corresponding zipper.
+
+  More formally, the compatibility relation first needs the following
+  auxiliary definitions: *)
+Fixpoint ptlz_prod {hole_symbs hole_word}
+         (ptlz:ptl_zipper hole_symbs hole_word): production :=
+  match ptlz with
+  | @Non_terminal_pt_ptlz prod _ _ => prod
+  | Cons_ptl_ptlz _ ptlz' => ptlz_prod ptlz'
+  end.
+
+Fixpoint ptlz_future {hole_symbs hole_word}
+  (ptlz:ptl_zipper hole_symbs hole_word): list symbol :=
+  match ptlz with
+  | Non_terminal_pt_ptlz _ => []
+  | @Cons_ptl_ptlz _ _ s _ _ ptlz' => s::ptlz_future ptlz'
+  end.
+
+Fixpoint ptlz_lookahead {hole_symbs hole_word}
+  (ptlz:ptl_zipper hole_symbs hole_word) : terminal :=
+  match ptlz with
+  | Non_terminal_pt_ptlz ptz => token_term (buf_head (ptz_buffer ptz))
+  | Cons_ptl_ptlz _ ptlz' => ptlz_lookahead ptlz'
+  end.
+
+Fixpoint ptz_stack_compat {hole_symb hole_word}
+         (stk : stack) (ptz : pt_zipper hole_symb hole_word) : Prop :=
+  match ptz with
+  | Top_ptz => stk = []
+  | Cons_ptl_ptz ptl ptlz =>
+    exists stk0,
+      state_has_future (state_of_stack init stk) (ptlz_prod ptlz)
+                       (hole_symb::ptlz_future ptlz) (ptlz_lookahead ptlz) /\
+      ptl_stack_compat stk0 ptl stk /\
+      ptlz_stack_compat stk0 ptlz
+  end
+with ptlz_stack_compat {hole_symbs hole_word}
+     (stk : stack) (ptlz : ptl_zipper hole_symbs hole_word) : Prop :=
+  match ptlz with
+  | Non_terminal_pt_ptlz ptz => ptz_stack_compat stk ptz
+  | Cons_ptl_ptlz _ ptlz => ptlz_stack_compat stk ptlz
+  end.
+
+Definition ptd_stack_compat (ptd:pt_dot) (stk:stack): Prop :=
+  match ptd with
+  | @Reduce_ptd prod _ ptl ptz =>
+    exists stk0,
+      state_has_future (state_of_stack init stk) prod []
+                       (token_term (buf_head (ptz_buffer ptz))) /\
+      ptl_stack_compat stk0 ptl stk /\
+      ptz_stack_compat stk0 ptz
+  | Shift_ptd tok ptl ptlz =>
+    exists stk0,
+      state_has_future (state_of_stack init stk) (ptlz_prod ptlz)
+                       (T (token_term tok) :: ptlz_future ptlz) (ptlz_lookahead ptlz) /\
+      ptl_stack_compat stk0 ptl stk /\
+      ptlz_stack_compat stk0 ptlz
+  end.
+
+Lemma ptz_stack_compat_cons_state_has_future {symbsq wordq symbt wordt} stk
+      (ptl : parse_tree_list symbsq wordq)
+      (ptlz : ptl_zipper (symbt :: symbsq) (wordq ++ wordt)) :
+  ptz_stack_compat stk (Cons_ptl_ptz ptl ptlz) ->
+  state_has_future (state_of_stack init stk) (ptlz_prod ptlz)
+                   (symbt::ptlz_future ptlz) (ptlz_lookahead ptlz).
+Proof. move=>[stk0 [? [? ?]]] //. Qed.
+
+Lemma ptlz_future_ptlz_prod hole_symbs hole_word
+      (ptlz:ptl_zipper hole_symbs hole_word) :
+  rev_append (ptlz_future ptlz) hole_symbs = prod_rhs_rev (ptlz_prod ptlz).
+Proof. induction ptlz=>//=. Qed.
+
+Lemma ptlz_future_first {symbs word} (ptlz : ptl_zipper symbs word) :
+  TerminalSet.In (token_term (buf_head (ptlz_buffer ptlz)))
+    (first_word_set (ptlz_future ptlz)) \/
+  token_term (buf_head (ptlz_buffer ptlz)) = ptlz_lookahead ptlz /\
+  nullable_word (ptlz_future ptlz) = true.
+Proof.
+  induction ptlz as [|??? [|tok] pt ptlz IH]; [by auto| |]=>/=.
+  - rewrite (nullable_correct _ _ eq_refl pt).
+    destruct IH as [|[??]]; [left|right]=>/=; auto using TerminalSet.union_3.
+  - left. destruct nullable_symb; eauto using TerminalSet.union_2, first_correct.
+Qed.
+
+(** We now want to define what is the next dotted parse tree which is
+  to be handled after one action. Such dotted parse is built in two
+  steps: Not only we have to perform the action by completing the
+  parse tree, but we also have to prepare for the following step by
+  moving the dot down to place it in front of the next action to be
+  performed.
+*)
+Fixpoint build_pt_dot_from_pt {symb word}
+         (pt : parse_tree symb word) (ptz : pt_zipper symb word)
+  : pt_dot :=
+  match pt in parse_tree symb word
+    return pt_zipper symb word -> pt_dot
+  with
+  | Terminal_pt tok =>
+    fun ptz =>
+      let X :=
+          match ptz in pt_zipper symb word
+            return match symb with T term => True | NT _ => False end ->
+                   { symbsq : list symbol &
+                     { wordq : list token &
+                       (parse_tree_list symbsq wordq *
+                        ptl_zipper (symb :: symbsq) (wordq ++ word))%type } }
+          with
+          | Top_ptz => fun F => False_rect _ F
+          | Cons_ptl_ptz ptl ptlz => fun _ =>
+            existT _ _ (existT _ _ (ptl, ptlz))
+          end I
+      in
+      Shift_ptd tok (fst (projT2 (projT2 X))) (snd (projT2 (projT2 X)))
+  | Non_terminal_pt prod ptl => fun ptz =>
+    let is_notnil :=
+      match ptl in parse_tree_list w _
+        return option (match w return Prop with [] => False | _ => True end)
+      with
+      | Nil_ptl => None
+      | _ => Some I
+      end
+    in
+    match is_notnil with
+    | None => Reduce_ptd ptl ptz
+    | Some H => build_pt_dot_from_pt_rec ptl H (Non_terminal_pt_ptlz ptz)
+    end
+  end ptz
+with build_pt_dot_from_pt_rec {symbs word}
+       (ptl : parse_tree_list symbs word)
+       (Hsymbs : match symbs with [] => False | _ => True end)
+       (ptlz : ptl_zipper symbs word)
+  : pt_dot :=
+  match ptl in parse_tree_list symbs word
+    return match symbs with [] => False | _ => True end ->
+           ptl_zipper symbs word ->
+           pt_dot
+  with
+  | Nil_ptl => fun Hsymbs _ => False_rect _ Hsymbs
+  | Cons_ptl ptl' pt => fun _ =>
+    match ptl' in parse_tree_list symbsq wordq
+      return parse_tree_list symbsq wordq ->
+             ptl_zipper (_ :: symbsq) (wordq ++ _) ->
+             pt_dot
+    with
+    | Nil_ptl => fun _ ptlz =>
+      build_pt_dot_from_pt pt (Cons_ptl_ptz Nil_ptl ptlz)
+    | _ => fun ptl' ptlz =>
+      build_pt_dot_from_pt_rec ptl' I (Cons_ptl_ptlz pt ptlz)
+    end ptl'
+  end Hsymbs ptlz.
+
+Definition build_pt_dot_from_ptl {symbs word}
+         (ptl : parse_tree_list symbs word)
+         (ptlz : ptl_zipper symbs word)
+  : pt_dot :=
+  match ptlz in ptl_zipper symbs word
+    return parse_tree_list symbs word -> pt_dot
+  with
+  | Non_terminal_pt_ptlz ptz => fun ptl =>
+    Reduce_ptd ptl ptz
+  | Cons_ptl_ptlz pt ptlz => fun ptl =>
+    build_pt_dot_from_pt pt (Cons_ptl_ptz ptl ptlz)
+  end ptl.
+
+Definition next_ptd (ptd:pt_dot) : option pt_dot :=
+  match ptd with
+  | Shift_ptd tok ptl ptlz =>
+    Some (build_pt_dot_from_ptl (Cons_ptl ptl (Terminal_pt tok)) ptlz)
+  | Reduce_ptd ptl ptz =>
+    match ptz in pt_zipper symb word
+      return parse_tree symb word -> _
+    with
+    | Top_ptz => fun _ => None
+    | Cons_ptl_ptz ptl' ptlz => fun pt =>
+      Some (build_pt_dot_from_ptl (Cons_ptl ptl' pt) ptlz)
+    end (Non_terminal_pt _ ptl)
+  end.
+
+Fixpoint next_ptd_iter (ptd:pt_dot) (log_n_steps:nat) : option pt_dot :=
+  match log_n_steps with
+  | O => next_ptd ptd
+  | S log_n_steps =>
+    match next_ptd_iter ptd log_n_steps with
+    | None => None
+    | Some ptd => next_ptd_iter ptd log_n_steps
+    end
+  end.
+
+(** We prove that these functions behave well w.r.t. semantic values. *)
+Lemma sem_build_from_pt {symb word}
+      (pt : parse_tree symb word) (ptz : pt_zipper symb word)  :
+  ptz_sem ptz (pt_sem pt)
+  = ptd_sem (build_pt_dot_from_pt pt ptz)
+with sem_build_from_pt_rec {symbs word}
+     (ptl : parse_tree_list symbs word) (ptlz : ptl_zipper symbs word)
+     Hsymbs :
+  ptlz_sem ptlz (fun _ f => ptl_sem ptl f)
+  = ptd_sem (build_pt_dot_from_pt_rec ptl Hsymbs ptlz).
+Proof.
+  - destruct pt as [tok|prod word ptl]=>/=.
+    + revert ptz. generalize [tok].
+      generalize (token_sem tok). generalize I.
+      change True with (match T (token_term tok) with T _ => True | NT _ => False end) at 1.
+      generalize (T (token_term tok)) => symb HT sem word ptz. by destruct ptz.
+    + match goal with
+      | |- context [match ?X with Some H => _ | None => _ end] => destruct X=>//
+      end.
+      by rewrite -sem_build_from_pt_rec.
+  - destruct ptl; [contradiction|].
+    specialize (sem_build_from_pt_rec _ _ ptl)=>/=. destruct ptl.
+    + by rewrite -sem_build_from_pt.
+    + by rewrite -sem_build_from_pt_rec.
+Qed.
+
+Lemma sem_build_from_ptl {symbs word}
+      (ptl : parse_tree_list symbs word) (ptlz : ptl_zipper symbs word) :
+  ptlz_sem ptlz (fun _ f => ptl_sem ptl f)
+  = ptd_sem (build_pt_dot_from_ptl ptl ptlz).
+Proof. destruct ptlz=>//=. by rewrite -sem_build_from_pt. Qed.
+
+Lemma sem_next_ptd (ptd : pt_dot) :
+  match next_ptd ptd with
+  | None => True
+  | Some ptd' => ptd_sem ptd = ptd_sem ptd'
+  end.
+Proof.
+  destruct ptd as [prod word ptl ptz|tok symbs word ptl ptlz] =>/=.
+  - change (ptl_sem ptl (prod_action prod))
+      with (pt_sem (Non_terminal_pt prod ptl)).
+    generalize (Non_terminal_pt prod ptl). clear ptl.
+    destruct ptz as [|?? ptl ?? ptlz]=>// pt. by rewrite -sem_build_from_ptl.
+  - by rewrite -sem_build_from_ptl.
+Qed.
+
+Lemma sem_next_ptd_iter (ptd : pt_dot) (log_n_steps : nat) :
+  match next_ptd_iter ptd log_n_steps with
+  | None => True
+  | Some ptd' => ptd_sem ptd = ptd_sem ptd'
+  end.
+Proof.
+  revert ptd.
+  induction log_n_steps as [|log_n_steps IH]; [by apply sem_next_ptd|]=>/= ptd.
+  assert (IH1 := IH ptd). destruct next_ptd_iter as [ptd'|]=>//.
+  specialize (IH ptd'). destruct next_ptd_iter=>//. congruence.
+Qed.
+
+(** We prove that these functions behave well w.r.t. xxx_buffer. *)
+Lemma ptd_buffer_build_from_pt {symb word}
+      (pt : parse_tree symb word) (ptz : pt_zipper symb word) :
+  (word ++ ptz_buffer ptz)%buf = ptd_buffer (build_pt_dot_from_pt pt ptz)
+with ptd_buffer_build_from_pt_rec {symbs word}
+     (ptl : parse_tree_list symbs word) (ptlz : ptl_zipper symbs word)
+     Hsymbs :
+  (word ++ ptlz_buffer ptlz)%buf = ptd_buffer (build_pt_dot_from_pt_rec ptl Hsymbs ptlz).
+Proof.
+  - destruct pt as [tok|prod word ptl]=>/=.
+    + f_equal. revert ptz. generalize [tok].
+      generalize (token_sem tok). generalize I.
+      change True with (match T (token_term tok) with T _ => True | NT _ => False end) at 1.
+      generalize (T (token_term tok)) => symb HT sem word ptz. by destruct ptz.
+    + match goal with
+      | |- context [match ?X with Some H => _ | None => _ end] => destruct X eqn:EQ
+      end.
+      * by rewrite -ptd_buffer_build_from_pt_rec.
+      * rewrite [X in (X ++ _)%buf](_ : word = []) //. clear -EQ. by destruct ptl.
+  - destruct ptl as [|?? ptl ?? pt]; [contradiction|].
+    specialize (ptd_buffer_build_from_pt_rec _ _ ptl).
+    destruct ptl.
+    + by rewrite /= -ptd_buffer_build_from_pt.
+    + by rewrite -ptd_buffer_build_from_pt_rec //= app_buf_assoc.
+Qed.
+
+Lemma ptd_buffer_build_from_ptl {symbs word}
+      (ptl : parse_tree_list symbs word) (ptlz : ptl_zipper symbs word) :
+  ptlz_buffer ptlz = ptd_buffer (build_pt_dot_from_ptl ptl ptlz).
+Proof.
+  destruct ptlz as [|???? pt]=>//=. by rewrite -ptd_buffer_build_from_pt.
+Qed.
+
+(** We prove that these functions behave well w.r.t. xxx_stack_compat. *)
+Lemma ptd_stack_compat_build_from_pt {symb word}
+      (pt : parse_tree symb word) (ptz : pt_zipper symb word)
+      (stk: stack) :
+  ptz_stack_compat stk ptz ->
+  ptd_stack_compat (build_pt_dot_from_pt pt ptz) stk
+with ptd_stack_compat_build_from_pt_rec {symbs word}
+     (ptl : parse_tree_list symbs word) (ptlz : ptl_zipper symbs word)
+     (stk : stack) Hsymbs :
+  ptlz_stack_compat stk ptlz ->
+  state_has_future (state_of_stack init stk) (ptlz_prod ptlz)
+                   (rev' (prod_rhs_rev (ptlz_prod ptlz))) (ptlz_lookahead ptlz) ->
+  ptd_stack_compat (build_pt_dot_from_pt_rec ptl Hsymbs ptlz) stk.
+Proof.
+  - intros Hstk. destruct pt as [tok|prod word ptl]=>/=.
+    + revert ptz Hstk. generalize [tok]. generalize (token_sem tok). generalize I.
+      change True with (match T (token_term tok) with T _ => True | NT _ => False end) at 1.
+      generalize (T (token_term tok)) => symb HT sem word ptz. by destruct ptz.
+    + assert (state_has_future (state_of_stack init stk) prod
+               (rev' (prod_rhs_rev prod)) (token_term (buf_head (ptz_buffer ptz)))).
+      { revert ptz Hstk. remember (NT (prod_lhs prod)) eqn:EQ=>ptz.
+        destruct ptz as [|?? ptl0 ?? ptlz0].
+        - intros ->. apply start_future. congruence.
+        - subst. intros (stk0 & Hfut & _). apply non_terminal_closed in Hfut.
+          specialize (Hfut prod eq_refl).
+          destruct (ptlz_future_first ptlz0) as [Hfirst|[Hfirst Hnull]].
+          + destruct Hfut as [_ Hfut]. auto.
+          + destruct Hfut as [Hfut _]. by rewrite Hnull -Hfirst in Hfut. }
+      match goal with
+      | |- context [match ?X with Some H => _ | None => _ end] => destruct X eqn:EQ
+      end.
+      * by apply ptd_stack_compat_build_from_pt_rec.
+      * exists stk. destruct ptl=>//.
+  - intros Hstk Hfut. destruct ptl as [|?? ptl ?? pt]; [contradiction|].
+    specialize (ptd_stack_compat_build_from_pt_rec _ _ ptl). destruct ptl.
+    + eapply ptd_stack_compat_build_from_pt=>//. exists stk.
+      split; [|split]=>//; [].
+      by rewrite -ptlz_future_ptlz_prod rev_append_rev /rev' -rev_alt
+                 rev_app_distr rev_involutive in Hfut.
+    + by apply ptd_stack_compat_build_from_pt_rec.
+Qed.
+
+Lemma ptd_stack_compat_build_from_ptl {symbs word}
+      (ptl : parse_tree_list symbs word) (ptlz : ptl_zipper symbs word)
+      (stk stk0: stack) :
+  ptlz_stack_compat stk0 ptlz ->
+  ptl_stack_compat stk0 ptl stk ->
+  state_has_future (state_of_stack init stk) (ptlz_prod ptlz)
+                   (ptlz_future ptlz) (ptlz_lookahead ptlz) ->
+  ptd_stack_compat (build_pt_dot_from_ptl ptl ptlz) stk.
+Proof.
+  intros Hstk0 Hstk Hfut. destruct ptlz=>/=.
+  - eauto.
+  - apply ptd_stack_compat_build_from_pt=>/=. eauto.
+Qed.
+
+(** We can now proceed by proving that the invariant is preserved by
+  each step of parsing. We also prove that each step of parsing
+  follows next_ptd.
+
+  We start with reduce steps: *)
+Lemma reduce_step_next_ptd (prod : production) (word : list token)
+      (ptl : parse_tree_list (prod_rhs_rev prod) word)
+      (ptz : pt_zipper (NT (prod_lhs prod)) word)
+      (stk : stack)
+      Hval Hi :
+  ptd_stack_compat (Reduce_ptd ptl ptz) stk ->
+  match next_ptd (Reduce_ptd ptl ptz) with
+  | None =>
+    reduce_step init stk prod (ptz_buffer ptz) Hval Hi =
+      Accept_sr (ptd_sem (Reduce_ptd ptl ptz)) buffer_end
+  | Some ptd =>
+    exists stk',
+      reduce_step init stk prod (ptz_buffer ptz) Hval Hi =
+        Progress_sr stk' (ptd_buffer ptd) /\
+      ptd_stack_compat ptd stk'
+  end.
+Proof.
+  intros (stk0 & _ & Hstk & Hstk0).
+  apply pop_stack_compat_pop_spec with (action := prod_action prod) in Hstk.
+  rewrite <-pop_spec_ok with (Hp := reduce_step_subproof init stk prod Hval Hi) in Hstk.
+  unfold reduce_step.
+  match goal with
+  | |- context [pop_state_valid init ?A stk ?B ?C ?D ?E ?F] =>
+    generalize (pop_state_valid init A stk B C D E F)
+  end.
+  rewrite Hstk /=. intros Hv.
+  generalize (reduce_step_subproof1 init stk prod Hval stk0 (fun _ : True => Hv)).
+  clear Hval Hstk Hi Hv stk.
+  assert (Hgoto := fun fut prod' =>
+    non_terminal_goto (state_of_stack init stk0) prod' (NT (prod_lhs prod)::fut)).
+  simpl in Hgoto.
+  destruct goto_table as [[st Hst]|] eqn:Hgoto'.
+  - intros _.
+    assert (match ptz with Top_ptz => False | _ => True end).
+    { revert ptz Hst Hstk0 Hgoto'.
+      generalize (eq_refl (NT (prod_lhs prod))).
+      generalize (NT (prod_lhs prod)) at 1 3 5.
+      intros nt Hnt ptz. destruct ptz=>//. injection Hnt=> <- /= Hst -> /= Hg.
+      assert (Hsg := start_goto init). by rewrite Hg in Hsg. }
+    clear Hgoto'.
+
+    change (ptl_sem ptl (prod_action prod))
+      with (pt_sem (Non_terminal_pt prod ptl)).
+    generalize (Non_terminal_pt prod ptl). clear ptl.
+    destruct ptz as [|?? ptl ? ? ptlz]=>// pt.
+
+    subst=>/=. eexists _. split.
+    + f_equal. apply ptd_buffer_build_from_ptl.
+    + destruct Hstk0 as (stk0' & Hfut & Hstk0' & Hstk0).
+      apply (ptd_stack_compat_build_from_ptl _ _ _ stk0'); auto; [].
+      split=>//. by exists eq_refl.
+  - intros Hv. generalize (reduce_step_subproof0 _ prod _ (fun _ => Hv)).
+    intros EQnt. clear Hv Hgoto'.
+
+    change (ptl_sem ptl (prod_action prod))
+      with (pt_sem (Non_terminal_pt prod ptl)).
+    generalize (Non_terminal_pt prod ptl). clear ptl. destruct ptz.
+    + intros pt. f_equal. by rewrite cast_eq.
+    + edestruct Hgoto. eapply ptz_stack_compat_cons_state_has_future, Hstk0.
+Qed.
+
+Lemma step_next_ptd (ptd : pt_dot) (stk : stack) Hi :
+  ptd_stack_compat ptd stk ->
+  match next_ptd ptd with
+  | None =>
+    step safe init stk (ptd_buffer ptd) Hi =
+      Accept_sr (ptd_sem ptd) buffer_end
+  | Some ptd' =>
+    exists stk',
+      step safe init stk (ptd_buffer ptd) Hi =
+        Progress_sr stk' (ptd_buffer ptd') /\
+      ptd_stack_compat ptd' stk'
+  end.
+Proof.
+  intros Hstk. unfold step.
+  generalize (reduce_ok safe (state_of_stack init stk)).
+  destruct ptd as [prod word ptl ptz|tok symbs word ptl ptlz].
+  - assert (Hfut : state_has_future (state_of_stack init stk) prod []
+                                    (token_term (buf_head (ptz_buffer ptz)))).
+    { destruct Hstk as (? & ? & ?)=>//. }
+    assert (Hact := end_reduce _ _ _ _ Hfut).
+    destruct action_table as [?|awt]=>Hval /=.
+    + subst. by apply reduce_step_next_ptd.
+    + set (term := token_term (buf_head (ptz_buffer ptz))) in *.
+      generalize (Hval term). clear Hval. destruct (awt term)=>//. subst.
+      intros Hval. by apply reduce_step_next_ptd.
+  - destruct Hstk as (stk0 & Hfut & Hstk & Hstk0).
+    assert (Hact := terminal_shift _ _ _ _ Hfut). simpl in Hact. clear Hfut.
+    destruct action_table as [?|awt]=>//= /(_ (token_term tok)).
+    destruct awt as [st' EQ| |]=>// _. eexists. split.
+    + f_equal. rewrite -ptd_buffer_build_from_ptl //.
+    + apply (ptd_stack_compat_build_from_ptl _ _ _ stk0); simpl; eauto.
+Qed.
+
+(** We prove the completeness of the parser main loop. *)
+Lemma parse_fix_next_ptd_iter (ptd : pt_dot) (stk : stack) (log_n_steps : nat) Hi :
+  ptd_stack_compat ptd stk ->
+  match next_ptd_iter ptd log_n_steps with
+  | None =>
+    proj1_sig (parse_fix safe init stk (ptd_buffer ptd) log_n_steps Hi) =
+      Accept_sr (ptd_sem ptd) buffer_end
+  | Some ptd' =>
+    exists stk',
+      proj1_sig (parse_fix safe init stk (ptd_buffer ptd) log_n_steps Hi) =
+        Progress_sr stk' (ptd_buffer ptd') /\
+      ptd_stack_compat ptd' stk'
+  end.
+Proof.
+  revert ptd stk Hi.
+  induction log_n_steps as [|log_n_steps IH]; [by apply step_next_ptd|].
+  move => /= ptd stk Hi Hstk. assert (IH1 := IH ptd stk Hi Hstk).
+  assert (EQsem := sem_next_ptd_iter ptd log_n_steps).
+  destruct parse_fix as [sr Hi']. simpl in IH1.
+  destruct next_ptd_iter as [ptd'|].
+  - rewrite EQsem. destruct IH1 as (stk' & -> & Hstk'). by apply IH.
+  - by subst.
+Qed.
+
+(** The parser is defined by recursion over a fuel parameter. In the
+  completeness proof, we need to predict how much fuel is going to be
+  needed in order to prove that enough fuel gives rise to a successful
+  parsing.
+
+  To do so, of a dotted parse tree, which is the number of actions
+  left to be executed before complete parsing when the current state
+  is represented by the dotted parse tree. *)
+Fixpoint ptlz_cost {hole_symbs hole_word}
+         (ptlz:ptl_zipper hole_symbs hole_word) :=
+  match ptlz with
+  | Non_terminal_pt_ptlz ptz => ptz_cost ptz
+  | Cons_ptl_ptlz pt ptlz' => pt_size pt + ptlz_cost ptlz'
+  end
+with ptz_cost {hole_symb hole_word} (ptz:pt_zipper hole_symb hole_word) :=
+  match ptz with
+  | Top_ptz => 0
+  | Cons_ptl_ptz ptl ptlz' => 1 + ptlz_cost ptlz'
+  end.
+
+Definition ptd_cost (ptd:pt_dot) :=
+  match ptd with
+  | Reduce_ptd ptl ptz => ptz_cost ptz
+  | Shift_ptd _ ptl ptlz => 1 + ptlz_cost ptlz
+  end.
+
+Lemma ptd_cost_build_from_pt {symb word}
+      (pt : parse_tree symb word) (ptz : pt_zipper symb word) :
+  pt_size pt + ptz_cost ptz = S (ptd_cost (build_pt_dot_from_pt pt ptz))
+with ptd_cost_build_from_pt_rec {symbs word}
+     (ptl : parse_tree_list symbs word) (ptlz : ptl_zipper symbs word)
+     Hsymbs :
+  ptl_size ptl + ptlz_cost ptlz = ptd_cost (build_pt_dot_from_pt_rec ptl Hsymbs ptlz).
+Proof.
+  - destruct pt as [tok|prod word ptl']=>/=.
+    + revert ptz. generalize [tok]. generalize (token_sem tok). generalize I.
+      change True with (match T (token_term tok) with T _ => True | NT _ => False end) at 1.
+      generalize (T (token_term tok)) => symb HT sem word ptz. by destruct ptz.
+    + match goal with
+      | |- context [match ?X with Some H => _ | None => _ end] => destruct X eqn:EQ
+      end.
+      * rewrite -ptd_cost_build_from_pt_rec /= plus_n_Sm //.
+      * simpl. by destruct ptl'.
+  - destruct ptl as [|?? ptl ?? pt]; [contradiction|].
+    specialize (ptd_cost_build_from_pt_rec _ _ ptl). destruct ptl.
+    + apply eq_add_S. rewrite -ptd_cost_build_from_pt /=. ring.
+    + rewrite -ptd_cost_build_from_pt_rec //=. ring.
+Qed.
+
+Lemma ptd_cost_build_from_ptl {symbs word}
+      (ptl : parse_tree_list symbs word) (ptlz : ptl_zipper symbs word) :
+  ptlz_cost ptlz = ptd_cost (build_pt_dot_from_ptl ptl ptlz).
+Proof.
+  destruct ptlz=>//. apply eq_add_S. rewrite -ptd_cost_build_from_pt /=. ring.
+Qed.
+
+Lemma next_ptd_cost ptd:
+  match next_ptd ptd with
+  | None => ptd_cost ptd = 0
+  | Some ptd' => ptd_cost ptd = S (ptd_cost ptd')
+  end.
+Proof.
+  destruct ptd as [prod word ptl ptz|tok symbq wordq ptl ptlz] =>/=.
+  - generalize (Non_terminal_pt prod ptl). clear ptl.
+    destruct ptz as [|?? ptl ?? ptlz]=>// pt. by rewrite -ptd_cost_build_from_ptl.
+  - by rewrite -ptd_cost_build_from_ptl.
+Qed.
+
+Lemma next_ptd_iter_cost ptd log_n_steps :
+  match next_ptd_iter ptd log_n_steps with
+  | None => ptd_cost ptd < 2^log_n_steps
+  | Some ptd' => ptd_cost ptd = 2^log_n_steps + ptd_cost ptd'
+  end.
+Proof.
+  revert ptd. induction log_n_steps as [|log_n_steps IH]=>ptd /=.
+  - assert (Hptd := next_ptd_cost ptd). destruct next_ptd=>//. by rewrite Hptd.
+  - rewrite Nat.add_0_r. assert (IH1 := IH ptd). destruct next_ptd_iter as [ptd'|].
+    + specialize (IH ptd'). destruct next_ptd_iter as [ptd''|].
+      * by rewrite IH1 IH -!plus_assoc.
+      * rewrite IH1. by apply plus_lt_compat_l.
+    + by apply lt_plus_trans.
+Qed.
+
+(** We now prove the top-level parsing function. The only thing that
+  is left to be done is the initialization. To do so, we define the
+  initial dotted parse tree, depending on a full (top-level) parse tree. *)
+
+Variable full_pt : parse_tree (NT (start_nt init)) full_word.
+
+Theorem parse_complete log_n_steps:
+  match parse safe init (full_word ++ buffer_end) log_n_steps with
+  | Parsed_pr sem buff =>
+    sem = pt_sem full_pt /\ buff = buffer_end /\ pt_size full_pt <= 2^log_n_steps
+  | Timeout_pr => 2^log_n_steps < pt_size full_pt
+  | Fail_pr => False
+  end.
+Proof.
+  assert (Hstk : ptd_stack_compat (build_pt_dot_from_pt full_pt Top_ptz) []) by
+      by apply ptd_stack_compat_build_from_pt.
+  unfold parse.
+  assert (Hparse := parse_fix_next_ptd_iter _ _ log_n_steps (parse_subproof init) Hstk).
+  rewrite -ptd_buffer_build_from_pt -sem_build_from_pt /= in Hparse.
+  assert (Hcost := next_ptd_iter_cost (build_pt_dot_from_pt full_pt Top_ptz) log_n_steps).
+  destruct next_ptd_iter.
+  - destruct Hparse as (? & -> & ?). apply (f_equal S) in Hcost.
+    rewrite -ptd_cost_build_from_pt Nat.add_0_r in Hcost. rewrite Hcost.
+    apply le_lt_n_Sm, le_plus_l.
+  - rewrite Hparse. split; [|split]=>//. apply lt_le_S in Hcost.
+    by rewrite -ptd_cost_build_from_pt Nat.add_0_r in Hcost.
+Qed.
+
+End Completeness_Proof.
+
+End Make.
diff --git a/MenhirLib/Interpreter_correct.v b/MenhirLib/Interpreter_correct.v
new file mode 100644
index 00000000..1325f610
--- /dev/null
+++ b/MenhirLib/Interpreter_correct.v
@@ -0,0 +1,175 @@
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
+
+From Coq Require Import List Syntax.
+Require Import Alphabet.
+Require Grammar Automaton Interpreter.
+From Coq.ssr Require Import ssreflect.
+
+Module Make(Import A:Automaton.T) (Import Inter:Interpreter.T A).
+
+(** * Correctness of the interpreter **)
+
+(** We prove that, in any case, if the interpreter accepts returning a
+    semantic value, then this is a semantic value of the input **)
+
+Section Init.
+
+Variable init:initstate.
+
+(** [word_has_stack_semantics] relates a word with a stack, stating that the
+    word is a concatenation of words that have the semantic values stored in
+    the stack. **)
+Inductive word_has_stack_semantics:
+  forall (word:list token) (stack:stack), Prop :=
+  | Nil_stack_whss: word_has_stack_semantics [] []
+  | Cons_stack_whss:
+    forall (wordq:list token) (stackq:stack),
+      word_has_stack_semantics wordq stackq ->
+
+    forall (wordt:list token) (s:noninitstate)
+           (pt:parse_tree (last_symb_of_non_init_state s) wordt),
+
+    word_has_stack_semantics
+       (wordq++wordt) (existT noninitstate_type s (pt_sem pt)::stackq).
+
+(** [pop] preserves the invariant **)
+Lemma pop_spec_ptl A symbols_to_pop action word_stk stk (res : A) stk' :
+  pop_spec symbols_to_pop stk action stk' res ->
+  word_has_stack_semantics word_stk stk ->
+  exists word_stk' word_res (ptl:parse_tree_list symbols_to_pop word_res),
+    (word_stk' ++ word_res = word_stk)%list /\
+    word_has_stack_semantics word_stk' stk' /\
+    ptl_sem ptl action = res.
+Proof.
+  intros Hspec. revert word_stk.
+  induction Hspec as [stk sem|symbols_to_pop st stk action sem stk' res Hspec IH];
+    intros word_stk Hword_stk.
+  - exists word_stk, [], Nil_ptl. rewrite -app_nil_end. eauto.
+  - inversion Hword_stk. subst_existT.
+    edestruct IH as (word_stk' & word_res & ptl & ? & Hword_stk'' & ?); [eassumption|].
+    subst. eexists word_stk', (word_res ++ _)%list, (Cons_ptl ptl _).
+    split; [|split]=>//. rewrite app_assoc //.
+Qed.
+
+(** [reduce_step] preserves the invariant **)
+Lemma reduce_step_invariant (stk:stack) (prod:production) Hv Hi word buffer :
+  word_has_stack_semantics word stk ->
+  match reduce_step init stk prod buffer Hv Hi with
+  | Accept_sr sem buffer_new =>
+    exists pt : parse_tree (NT (start_nt init)) word,
+    buffer = buffer_new /\ pt_sem pt = sem
+  | Progress_sr stk' buffer_new =>
+    buffer = buffer_new /\ word_has_stack_semantics word stk'
+  | Fail_sr => True
+  end.
+Proof.
+  intros Hword_stk. unfold reduce_step.
+  match goal with
+  | |- context [pop_state_valid init ?stp stk ?x1 ?x2 ?x3 ?x4 ?x5] =>
+    generalize (pop_state_valid init stp stk x1 x2 x3 x4 x5)
+  end.
+  destruct pop as [stk' sem] eqn:Hpop=>/= Hv'.
+  apply pop_spec_ok in Hpop. apply pop_spec_ptl with (word_stk := word) in Hpop=>//.
+  destruct Hpop as (word1 & word2 & ptl & <- & Hword1 & <-).
+  generalize (reduce_step_subproof1 init stk prod Hv stk' (fun _ : True => Hv')).
+  destruct goto_table as [[st' EQ]|].
+  - intros _. split=>//.
+    change (ptl_sem ptl (prod_action prod)) with (pt_sem (Non_terminal_pt prod ptl)).
+    generalize (Non_terminal_pt prod ptl). rewrite ->EQ. intros pt. by constructor.
+  - intros Hstk'. destruct Hword1; [|by destruct Hstk'].
+    generalize (reduce_step_subproof0 init prod [] (fun _ : True => Hstk')).
+    simpl in Hstk'. rewrite -Hstk' // => EQ. rewrite cast_eq.
+    exists (Non_terminal_pt prod ptl). by split.
+Qed.
+
+(** [step] preserves the invariant **)
+Lemma step_invariant stk word buffer safe Hi :
+  word_has_stack_semantics word stk ->
+  match step safe init stk buffer Hi with
+  | Accept_sr sem buffer_new =>
+    exists word_new (pt:parse_tree (NT (start_nt init)) word_new),
+      (word ++ buffer = word_new ++ buffer_new)%buf /\
+      pt_sem pt = sem
+  | Progress_sr stk_new buffer_new =>
+    exists word_new,
+      (word ++ buffer = word_new ++ buffer_new)%buf /\
+      word_has_stack_semantics word_new stk_new
+  | Fail_sr => True
+  end.
+Proof.
+  intros Hword_stk. unfold step.
+  generalize (reduce_ok safe (state_of_stack init stk)).
+  destruct action_table as [prod|awt].
+  - intros Hv.
+    apply (reduce_step_invariant stk prod (fun _ => Hv) Hi word buffer) in Hword_stk.
+    destruct reduce_step=>//.
+    + destruct Hword_stk as (pt & <- & <-); eauto.
+    + destruct Hword_stk as [<- ?]; eauto.
+  - destruct buffer as [tok buffer]=>/=.
+    move=> /(_ (token_term tok)) Hv. destruct (awt (token_term tok)) as [st EQ|prod|]=>//.
+    + eexists _. split; [by apply app_buf_assoc with (l2 := [_])|].
+      change (token_sem tok) with (pt_sem (Terminal_pt tok)).
+      generalize (Terminal_pt tok). generalize [tok].
+      rewrite -> EQ=>word' pt /=. by constructor.
+    + apply (reduce_step_invariant stk prod (fun _ => Hv) Hi word (tok::buffer))
+        in Hword_stk.
+      destruct reduce_step=>//.
+      * destruct Hword_stk as (pt & <- & <-); eauto.
+      * destruct Hword_stk as [<- ?]; eauto.
+Qed.
+
+(** [step] preserves the invariant **)
+Lemma parse_fix_invariant stk word buffer safe log_n_steps Hi :
+  word_has_stack_semantics word stk ->
+  match proj1_sig (parse_fix safe init stk buffer log_n_steps Hi) with
+  | Accept_sr sem buffer_new =>
+    exists word_new (pt:parse_tree (NT (start_nt init)) word_new),
+      (word ++ buffer = word_new ++ buffer_new)%buf /\
+      pt_sem pt = sem
+  | Progress_sr stk_new buffer_new =>
+    exists word_new,
+      (word ++ buffer = word_new ++ buffer_new)%buf /\
+      word_has_stack_semantics word_new stk_new
+  | Fail_sr => True
+  end.
+Proof.
+  revert stk word buffer Hi.
+  induction log_n_steps as [|log_n_steps IH]=>/= stk word buffer Hi Hstk;
+    [by apply step_invariant|].
+  assert (IH1 := IH stk word buffer Hi Hstk).
+  destruct parse_fix as [[] Hi']=>/=; try by apply IH1.
+  destruct IH1 as (word' & -> & Hstk')=>//. by apply IH.
+Qed.
+
+(** The interpreter is correct : if it returns a semantic value, then the input
+    word has this semantic value.
+**)
+Theorem parse_correct safe buffer log_n_steps:
+  match parse safe init buffer log_n_steps with
+  | Parsed_pr sem buffer_new =>
+    exists word_new (pt:parse_tree (NT (start_nt init)) word_new),
+      buffer = (word_new ++ buffer_new)%buf /\
+      pt_sem pt = sem
+  | _ => True
+  end.
+Proof.
+  unfold parse.
+  assert (Hparse := parse_fix_invariant [] [] buffer safe log_n_steps
+                                        (parse_subproof init)).
+  destruct proj1_sig=>//. apply Hparse. constructor.
+Qed.
+
+End Init.
+
+End Make.
diff --git a/MenhirLib/Main.v b/MenhirLib/Main.v
new file mode 100644
index 00000000..f6158074
--- /dev/null
+++ b/MenhirLib/Main.v
@@ -0,0 +1,79 @@
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
+
+Require Grammar Automaton Interpreter_correct Interpreter_complete.
+From Coq Require Import Syntax Arith.
+
+Module Make(Export Aut:Automaton.T).
+Export Aut.Gram.
+Export Aut.GramDefs.
+
+Module Import Inter := Interpreter.Make Aut.
+Module Correct := Interpreter_correct.Make Aut Inter.
+Module Complete := Interpreter_complete.Make Aut Inter.
+
+Definition complete_validator:unit->bool := Complete.Valid.is_complete.
+Definition safe_validator:unit->bool := ValidSafe.is_safe.
+Definition parse (safe:safe_validator ()=true) init log_n_steps buffer :
+  parse_result (symbol_semantic_type (NT (start_nt init))):=
+  parse (ValidSafe.safe_is_validator safe) init buffer log_n_steps.
+
+(** Correction theorem. **)
+Theorem parse_correct
+  (safe:safe_validator ()= true) init log_n_steps buffer:
+  match parse safe init log_n_steps buffer with
+    | Parsed_pr sem buffer_new =>
+      exists word (pt : parse_tree (NT (start_nt init)) word),
+        buffer = (word ++ buffer_new)%buf /\
+        pt_sem pt = sem
+    | _ => True
+  end.
+Proof. apply Correct.parse_correct. Qed.
+
+(** Completeness theorem. **)
+Theorem parse_complete
+  (safe:safe_validator () = true) init log_n_steps word buffer_end:
+  complete_validator () = true ->
+  forall tree:parse_tree (NT (start_nt init)) word,
+  match parse safe init log_n_steps (word ++ buffer_end) with
+  | Fail_pr => False
+  | Parsed_pr sem_res buffer_end_res =>
+    sem_res = pt_sem tree /\ buffer_end_res = buffer_end /\
+    pt_size tree <= 2^log_n_steps
+  | Timeout_pr => 2^log_n_steps < pt_size tree
+  end.
+Proof.
+  intros. now apply Complete.parse_complete, Complete.Valid.complete_is_validator.
+Qed.
+
+(** Unambiguity theorem. **)
+Theorem unambiguity:
+  safe_validator () = true -> complete_validator () = true -> inhabited token ->
+  forall init word,
+  forall (tree1 tree2:parse_tree (NT (start_nt init)) word),
+    pt_sem tree1 = pt_sem tree2.
+Proof.
+  intros Hsafe Hcomp [tok] init word tree1 tree2.
+  pose (buf_end := cofix buf_end := (tok :: buf_end)%buf).
+  assert (Hcomp1 := parse_complete Hsafe init (pt_size tree1) word buf_end
+                                   Hcomp tree1).
+  assert (Hcomp2 := parse_complete Hsafe init (pt_size tree1) word buf_end
+                                   Hcomp tree2).
+  destruct parse.
+  - destruct Hcomp1.
+  - exfalso. eapply PeanoNat.Nat.lt_irrefl. etransitivity; [|apply Hcomp1].
+    eapply Nat.pow_gt_lin_r. constructor.
+  - destruct Hcomp1 as [-> _], Hcomp2 as [-> _]. reflexivity.
+Qed.
+
+End Make.
diff --git a/MenhirLib/Validator_classes.v b/MenhirLib/Validator_classes.v
new file mode 100644
index 00000000..d8063123
--- /dev/null
+++ b/MenhirLib/Validator_classes.v
@@ -0,0 +1,75 @@
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
+
+From Coq Require Import List.
+From Coq.ssr Require Import ssreflect.
+Require Import Alphabet.
+
+Class IsValidator (P : Prop) (b : bool) :=
+  is_validator : b = true -> P.
+Hint Mode IsValidator + - : typeclass_instances.
+
+Instance is_validator_true : IsValidator True true.
+Proof. done. Qed.
+
+Instance is_validator_false : IsValidator False false.
+Proof. done. Qed.
+
+Instance is_validator_eq_true b :
+  IsValidator (b = true) b.
+Proof. done. Qed.
+
+Instance is_validator_and P1 b1 P2 b2 `{IsValidator P1 b1} `{IsValidator P2 b2}:
+  IsValidator (P1 /\ P2) (if b1 then b2 else false).
+Proof. by split; destruct b1, b2; apply is_validator. Qed.
+
+Instance is_validator_comparable_leibniz_eq A (C:Comparable A) (x y : A) :
+  ComparableLeibnizEq C ->
+  IsValidator (x = y) (compare_eqb x y).
+Proof. intros ??. by apply compare_eqb_iff. Qed.
+
+Instance is_validator_comparable_eq_impl A `(Comparable A) (x y : A) P b :
+  IsValidator P b ->
+  IsValidator (x = y -> P) (if compare_eqb x y then b else true).
+Proof.
+  intros Hval Val ->. rewrite /compare_eqb compare_refl in Val. auto.
+Qed.
+
+Lemma is_validator_forall_finite A P b `(Finite A) :
+  (forall (x : A), IsValidator (P x) (b x)) ->
+  IsValidator (forall (x : A), P x) (forallb b all_list).
+Proof.
+  move=> ? /forallb_forall Hb ?.
+  apply is_validator, Hb, all_list_forall.
+Qed.
+
+(* We do not use an instance directly here, because we need somehow to
+   force Coq to instantiate b with a lambda. *)
+Hint Extern 2 (IsValidator (forall x : ?A, _) _) =>
+    eapply (is_validator_forall_finite _ _ (fun (x:A) => _))
+  : typeclass_instances.
+
+(* Hint for synthetizing pattern-matching. *)
+Hint Extern 2 (IsValidator (match ?u with _ => _ end) ?b0) =>
+    let b := fresh "b" in
+    unshelve notypeclasses refine (let b : bool := _ in _);
+      [destruct u; intros; shelve|];    (* Synthetize `match .. with` in the validator. *)
+    unify b b0;
+    unfold b; destruct u; clear b
+  : typeclass_instances.
+
+(* Hint for unfolding definitions. This is necessary because many
+  hints for IsValidator use [Hint Extern], which do not automatically
+  unfold identifiers. *)
+Hint Extern 100 (IsValidator ?X _) => unfold X
+  : typeclass_instances.
diff --git a/MenhirLib/Validator_complete.v b/MenhirLib/Validator_complete.v
new file mode 100644
index 00000000..ebb74500
--- /dev/null
+++ b/MenhirLib/Validator_complete.v
@@ -0,0 +1,394 @@
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
+
+From Coq Require Import List Syntax Derive.
+From Coq.ssr Require Import ssreflect.
+Require Automaton.
+Require Import Alphabet Validator_classes.
+
+Module Make(Import A:Automaton.T).
+
+(** We instantiate some sets/map. **)
+Module TerminalComparableM <: ComparableM.
+  Definition t := terminal.
+  Instance tComparable : Comparable t := _.
+End TerminalComparableM.
+Module TerminalOrderedType := OrderedType_from_ComparableM TerminalComparableM.
+Module StateProdPosComparableM <: ComparableM.
+  Definition t := (state*production*nat)%type.
+  Instance tComparable : Comparable t := _.
+End StateProdPosComparableM.
+Module StateProdPosOrderedType :=
+  OrderedType_from_ComparableM StateProdPosComparableM.
+
+Module TerminalSet := FSetAVL.Make TerminalOrderedType.
+Module StateProdPosMap := FMapAVL.Make StateProdPosOrderedType.
+
+(** Nullable predicate for symbols and list of symbols. **)
+Definition nullable_symb (symbol:symbol) :=
+  match symbol with
+  | NT nt => nullable_nterm nt
+  | _ => false
+  end.
+
+Definition nullable_word (word:list symbol) :=
+  forallb nullable_symb word.
+
+(** First predicate for non terminal, symbols and list of symbols, given as FSets. **)
+Definition first_nterm_set (nterm:nonterminal) :=
+  fold_left (fun acc t => TerminalSet.add t acc)
+    (first_nterm nterm) TerminalSet.empty.
+
+Definition first_symb_set (symbol:symbol) :=
+  match symbol with
+  | NT nt => first_nterm_set nt
+  | T t => TerminalSet.singleton t
+  end.
+
+Fixpoint first_word_set (word:list symbol) :=
+  match word with
+  | [] => TerminalSet.empty
+  | t::q =>
+    if nullable_symb t then
+      TerminalSet.union (first_symb_set t) (first_word_set q)
+    else
+      first_symb_set t
+  end.
+
+(** Small helper for finding the part of an item that is after the dot. **)
+Definition future_of_prod prod dot_pos : list symbol :=
+  (fix loop n lst :=
+    match n with
+    | O => lst
+    | S x => match loop x lst with [] => [] | _::q => q end
+    end)
+  dot_pos (rev' (prod_rhs_rev prod)).
+
+(** We build a fast map to store all the items of all the states. **)
+Definition items_map (_:unit): StateProdPosMap.t TerminalSet.t :=
+  fold_left (fun acc state =>
+    fold_left (fun acc item =>
+      let key := (state, prod_item item, dot_pos_item item) in
+        let data := fold_left (fun acc t => TerminalSet.add t acc)
+          (lookaheads_item item) TerminalSet.empty
+        in
+        let old :=
+          match StateProdPosMap.find key acc with
+          | Some x => x | None => TerminalSet.empty
+          end
+        in
+        StateProdPosMap.add key (TerminalSet.union data old) acc
+    ) (items_of_state state) acc
+  ) all_list (StateProdPosMap.empty TerminalSet.t).
+
+(** We need to avoid computing items_map each time we need it. To that
+  purpose, we declare a typeclass specifying that some map is equal to
+  items_map. *)
+Class IsItemsMap m := is_items_map : m = items_map ().
+
+(** Accessor. **)
+Definition find_items_map items_map state prod dot_pos : TerminalSet.t :=
+  match StateProdPosMap.find (state, prod, dot_pos) items_map with
+  | None => TerminalSet.empty
+  | Some x => x
+  end.
+
+Definition state_has_future state prod (fut:list symbol) (lookahead:terminal) :=
+  exists dot_pos:nat,
+    fut = future_of_prod prod dot_pos /\
+    TerminalSet.In lookahead (find_items_map (items_map ()) state prod dot_pos).
+
+(** Iterator over items. **)
+Definition forallb_items items_map (P:state -> production -> nat -> TerminalSet.t -> bool): bool:=
+  StateProdPosMap.fold (fun key set acc =>
+    match key with (st, p, pos) => (acc && P st p pos set)%bool end
+  ) items_map true.
+
+(** Typeclass instances for synthetizing the validator. *)
+
+Instance is_validator_subset S1 S2 :
+  IsValidator (TerminalSet.Subset S1 S2) (TerminalSet.subset S1 S2).
+Proof. intros ?. by apply TerminalSet.subset_2. Qed.
+
+(* While the specification of the validator always quantify over
+   possible lookahead tokens individually, the validator usually
+   handles lookahead sets directly instead, for better performances.
+
+   For instance, the validator for [state_has_future], which speaks
+   about one single lookahead token is a subset operation:
+*)
+Lemma is_validator_state_has_future_subset st prod pos lookahead lset im fut :
+  TerminalSet.In lookahead lset ->
+  fut = future_of_prod prod pos ->
+  IsItemsMap im ->
+  IsValidator (state_has_future st prod fut lookahead)
+              (TerminalSet.subset lset (find_items_map im st prod pos)).
+Proof.
+  intros ? -> -> HSS%TerminalSet.subset_2. exists pos. split=>//. by apply HSS.
+Qed.
+(* We do not declare this lemma as an instance, and use [Hint Extern]
+   instead, because the typeclass mechanism has trouble instantiating
+   some evars if we do not explicitely call [eassumption]. *)
+Hint Extern 2 (IsValidator (state_has_future _ _ _ _) _) =>
+  eapply is_validator_state_has_future_subset; [eassumption|eassumption || reflexivity|]
+: typeclass_instances.
+
+(* As said previously, we manipulate lookahead terminal sets instead of
+  lookahead individually. Hence, when we quantify over a lookahead set
+  in the specification, we do not do anything in the executable
+  validator.
+
+  This instance is used for [non_terminal_closed]. *)
+Instance is_validator_forall_lookahead_set lset P b:
+  (forall lookahead, TerminalSet.In lookahead lset -> IsValidator (P lookahead) b) ->
+  IsValidator (forall lookahead, TerminalSet.In lookahead lset -> P lookahead) b.
+Proof. unfold IsValidator. firstorder. Qed.
+
+
+(* Dually, we sometimes still need to explicitelly iterate over a
+  lookahead set. This is what this lemma allows.
+  Used only in [end_reduce]. *)
+Lemma is_validator_iterate_lset P b lookahead lset :
+  TerminalSet.In lookahead lset ->
+  IsValidator P (b lookahead) ->
+  IsValidator P (TerminalSet.fold (fun lookahead acc =>
+    if acc then b lookahead else false) lset true).
+Proof.
+  intros Hlset%TerminalSet.elements_1 Hval Val. apply Hval.
+  revert Val. rewrite TerminalSet.fold_1. generalize true at 1. clear -Hlset.
+  induction Hlset as [? l <-%compare_eq|? l ? IH]=> /= b' Val.
+  - destruct (b lookahead). by destruct b'. exfalso. by induction l; destruct b'.
+  - eauto.
+Qed.
+Hint Extern 100 (IsValidator _ _) =>
+  match goal with
+  | H : TerminalSet.In ?lookahead ?lset |- _ =>
+    eapply (is_validator_iterate_lset _ (fun lookahead => _) _ _ H); clear H
+  end
+: typeclass_instances.
+
+(* We often quantify over all the items of all the states of the
+   automaton. This lemma and the accompanying [Hint Resolve]
+   declaration allow generating the corresponding executable
+   validator.
+
+   Note that it turns out that, in all the uses of this pattern, the
+   first thing we do for each item is pattern-matching over the
+   future. This lemma also embbed this pattern-matching, which makes
+   it possible to get the hypothesis [fut' = future_of_prod prod (S pos)]
+   in the non-nil branch.
+
+   Moreover, note, again, that while the specification quantifies over
+   lookahead terminals individually, the code provides lookahead sets
+   instead. *)
+Lemma is_validator_forall_items P1 b1 P2 b2 im :
+  IsItemsMap im ->
+
+  (forall st prod lookahead lset pos,
+      TerminalSet.In lookahead lset ->
+      [] = future_of_prod prod pos ->
+      IsValidator (P1 st prod lookahead) (b1 st prod pos lset)) ->
+
+  (forall st prod pos lookahead lset s fut',
+      TerminalSet.In lookahead lset ->
+      fut' = future_of_prod prod (S pos) ->
+      IsValidator (P2 st prod lookahead s fut') (b2 st prod pos lset s fut')) ->
+
+  IsValidator (forall st prod fut lookahead,
+                  state_has_future st prod fut lookahead ->
+                  match fut with
+                  | [] => P1 st prod lookahead
+                  | s :: fut' => P2 st prod lookahead s fut'
+                  end)
+              (forallb_items im (fun st prod pos lset =>
+                 match future_of_prod prod pos with
+                 | [] => b1 st prod pos lset
+                 | s :: fut' => b2 st prod pos lset s fut'
+                 end)).
+Proof.
+  intros -> Hval1 Hval2 Val st prod fut lookahead (pos & -> & Hlookahead).
+  rewrite /forallb_items StateProdPosMap.fold_1 in Val.
+  assert (match future_of_prod prod pos with
+          | [] => b1 st prod pos (find_items_map (items_map ()) st prod pos)
+          | s :: fut' => b2 st prod pos (find_items_map (items_map ()) st prod pos) s fut'
+          end = true).
+  - unfold find_items_map in *.
+    assert (Hfind := @StateProdPosMap.find_2 _ (items_map ()) (st, prod, pos)).
+    destruct StateProdPosMap.find as [lset|]; [|by edestruct (TerminalSet.empty_1); eauto].
+    specialize (Hfind _ eq_refl). apply StateProdPosMap.elements_1 in Hfind.
+    revert Val. generalize true at 1.
+    induction Hfind as [[? ?] l [?%compare_eq ?]|??? IH]=>?.
+    + simpl in *; subst.
+      match goal with |- _ -> ?X = true => destruct X end; [done|].
+      rewrite Bool.andb_false_r. clear. induction l as [|[[[??]?]?] l IH]=>//.
+    + apply IH.
+  - destruct future_of_prod eqn:EQ. by eapply Hval1; eauto.
+    eapply Hval2 with (pos := pos); eauto; [].
+    revert EQ. unfold future_of_prod=>-> //.
+Qed.
+(* We need a hint for expplicitely instantiating b1 and b2 with lambdas. *)
+Hint Extern 0 (IsValidator
+                 (forall st prod fut lookahead,
+                     state_has_future st prod fut lookahead -> _)
+                 _) =>
+    eapply (is_validator_forall_items _ (fun st prod pos lset => _)
+                                      _ (fun st prod pos lset s fut' => _))
+  : typeclass_instances.
+
+(* Used in [start_future] only. *)
+Instance is_validator_forall_state_has_future im st prod :
+  IsItemsMap im ->
+  IsValidator
+    (forall look, state_has_future st prod (rev' (prod_rhs_rev prod)) look)
+    (let lookaheads := find_items_map im st prod 0 in
+     forallb (fun t => TerminalSet.mem t lookaheads) all_list).
+Proof.
+  move=> -> /forallb_forall Val look.
+  specialize (Val look (all_list_forall _)). exists 0. split=>//.
+  by apply TerminalSet.mem_2.
+Qed.
+
+(** * Validation for completeness **)
+
+(** The nullable predicate is a fixpoint : it is correct. **)
+Definition nullable_stable :=
+  forall p:production,
+    if nullable_word (prod_rhs_rev p) then
+      nullable_nterm (prod_lhs p) = true
+    else True.
+
+(** The first predicate is a fixpoint : it is correct. **)
+Definition first_stable:=
+  forall (p:production),
+    TerminalSet.Subset (first_word_set (rev' (prod_rhs_rev p)))
+                       (first_nterm_set (prod_lhs p)).
+
+(** The initial state has all the S=>.u items, where S is the start non-terminal **)
+Definition start_future :=
+  forall (init:initstate) (p:production),
+    prod_lhs p = start_nt init ->
+  forall (t:terminal),
+    state_has_future init p (rev' (prod_rhs_rev p)) t.
+
+(** If a state contains an item of the form A->_.av[[b]], where a is a
+    terminal, then reading an a does a [Shift_act], to a state containing
+    an item of the form A->_.v[[b]]. **)
+Definition terminal_shift :=
+  forall (s1:state) prod fut lookahead,
+    state_has_future s1 prod fut lookahead ->
+    match fut with
+    | T t::q =>
+      match action_table s1 with
+      | Lookahead_act awp =>
+        match awp t with
+        | Shift_act s2 _ =>
+          state_has_future s2 prod q lookahead
+        | _ => False
+        end
+      | _ => False
+      end
+    | _ => True
+    end.
+
+(** If a state contains an item of the form A->_.[[a]], then either we do a
+    [Default_reduce_act] of the corresponding production, either a is a
+    terminal (ie. there is a lookahead terminal), and reading a does a
+    [Reduce_act] of the corresponding production. **)
+Definition end_reduce :=
+  forall (s:state) prod fut lookahead,
+    state_has_future s prod fut lookahead ->
+    match fut with
+    | [] =>
+      match action_table s with
+      | Default_reduce_act p => p = prod
+      | Lookahead_act awt =>
+        match awt lookahead with
+        | Reduce_act p => p = prod
+        | _ => False
+        end
+      end
+    | _ => True
+    end.
+
+Definition is_end_reduce items_map :=
+  forallb_items items_map (fun s prod pos lset =>
+    match future_of_prod prod pos with
+    | [] =>
+      match action_table s with
+      | Default_reduce_act p => compare_eqb p prod
+      | Lookahead_act awt =>
+        TerminalSet.fold (fun lookahead acc =>
+          match awt lookahead with
+          | Reduce_act p => (acc && compare_eqb p prod)%bool
+          | _ => false
+          end) lset true
+      end
+    | _ => true
+    end).
+
+(** If a state contains an item of the form A->_.Bv[[b]], where B is a
+    non terminal, then the goto table says we have to go to a state containing
+    an item of the form A->_.v[[b]]. **)
+Definition non_terminal_goto :=
+  forall (s1:state) prod fut lookahead,
+    state_has_future s1 prod fut lookahead ->
+    match fut with
+    | NT nt::q =>
+      match goto_table s1 nt with
+      | Some (exist _ s2 _) =>
+        state_has_future s2 prod q lookahead
+      | None => False
+      end
+    | _ => True
+    end.
+
+Definition start_goto :=
+  forall (init:initstate),
+    match goto_table init (start_nt init) with
+    | None => True
+    | Some _ => False
+    end.
+
+(** Closure property of item sets : if a state contains an item of the form
+    A->_.Bv[[b]], then for each production B->u and each terminal a of
+    first(vb), the state contains an item of the form B->_.u[[a]] **)
+Definition non_terminal_closed :=
+  forall s1 prod fut lookahead,
+    state_has_future s1 prod fut lookahead ->
+    match fut with
+    | NT nt::q =>
+      forall p, prod_lhs p = nt ->
+        (if nullable_word q then
+           state_has_future s1 p (future_of_prod p 0) lookahead
+         else True) /\
+        (forall lookahead2,
+           TerminalSet.In lookahead2 (first_word_set q) ->
+             state_has_future s1 p (future_of_prod p 0) lookahead2)
+      | _ => True
+    end.
+
+(** The automaton is complete **)
+Definition complete :=
+  nullable_stable /\ first_stable /\ start_future /\ terminal_shift
+  /\ end_reduce /\ non_terminal_goto /\ start_goto /\ non_terminal_closed.
+
+Derive is_complete_0
+SuchThat (forall im, IsItemsMap im -> IsValidator complete (is_complete_0 im))
+As complete_0_is_validator.
+Proof. intros im. subst is_complete_0. instantiate (1:=fun im => _). apply _. Qed.
+
+Definition is_complete (_:unit) := is_complete_0 (items_map ()).
+Lemma complete_is_validator : IsValidator complete (is_complete ()).
+Proof. by apply complete_0_is_validator. Qed.
+
+End Make.
diff --git a/MenhirLib/Validator_safe.v b/MenhirLib/Validator_safe.v
new file mode 100644
index 00000000..628d2009
--- /dev/null
+++ b/MenhirLib/Validator_safe.v
@@ -0,0 +1,234 @@
+(****************************************************************************)
+(*                                                                          *)
+(*                                   Menhir                                 *)
+(*                                                                          *)
+(*           Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud         *)
+(*                                                                          *)
+(*  Copyright Inria. All rights reserved. This file is distributed under    *)
+(*  the terms of the GNU Lesser General Public License as published by the  *)
+(*  Free Software Foundation, either version 3 of the License, or (at your  *)
+(*  option) any later version, as described in the file LICENSE.            *)
+(*                                                                          *)
+(****************************************************************************)
+
+From Coq Require Import List Syntax Derive.
+From Coq.ssr Require Import ssreflect.
+Require Automaton.
+Require Import Alphabet Validator_classes.
+
+Module Make(Import A:Automaton.T).
+
+(** The singleton predicate for states **)
+Definition singleton_state_pred (state:state) :=
+  (fun state' => match compare state state' with Eq => true |_ => false end).
+
+(** [past_state_of_non_init_state], extended for all states. **)
+Definition past_state_of_state (state:state) :=
+  match state with
+  | Init _ => []
+  | Ninit nis => past_state_of_non_init_state nis
+  end.
+
+(** Concatenations of last and past **)
+Definition head_symbs_of_state (state:state) :=
+  match state with
+  | Init _ => []
+  | Ninit s =>
+    last_symb_of_non_init_state s::past_symb_of_non_init_state s
+  end.
+Definition head_states_of_state (state:state) :=
+  singleton_state_pred state::past_state_of_state state.
+
+(** * Validation for correctness **)
+
+(** Prefix predicate between two lists of symbols. **)
+Inductive prefix: list symbol -> list symbol -> Prop :=
+| prefix_nil: forall l, prefix [] l
+| prefix_cons: forall l1 l2 x, prefix l1 l2 -> prefix (x::l1) (x::l2).
+
+(** [prefix] is transitive **)
+Lemma prefix_trans:
+  forall (l1 l2 l3:list symbol), prefix l1 l2 -> prefix l2 l3 -> prefix l1 l3.
+Proof.
+  intros l1 l2 l3 H1 H2. revert l3 H2.
+  induction H1; [now constructor|]. inversion 1. subst. constructor. eauto.
+Qed.
+
+Fixpoint is_prefix (l1 l2:list symbol) :=
+  match l1, l2 with
+  | [], _ => true
+  | t1::q1, t2::q2 => (compare_eqb t1 t2 && is_prefix q1 q2)%bool
+  | _::_, [] => false
+  end.
+
+Instance prefix_is_validator l1 l2 : IsValidator (prefix l1 l2) (is_prefix l1 l2).
+Proof.
+  revert l2. induction l1 as [|x1 l1 IH]=>l2 Hpref.
+  - constructor.
+  - destruct l2 as [|x2 l2]=>//.
+    move: Hpref=> /andb_prop [/compare_eqb_iff -> /IH ?]. by constructor.
+Qed.
+
+(** If we shift, then the known top symbols of the destination state is
+    a prefix of the known top symbols of the source state, with the new
+    symbol added. **)
+Definition shift_head_symbs :=
+  forall s,
+    match action_table s with
+    | Lookahead_act awp => forall t,
+        match awp t with
+        | Shift_act s2 _ =>
+          prefix (past_symb_of_non_init_state s2) (head_symbs_of_state s)
+        | _ => True
+        end
+    | _ => True
+    end.
+
+(** When a goto happens, then the known top symbols of the destination state
+    is a prefix of the known top symbols of the source state, with the new
+    symbol added. **)
+Definition goto_head_symbs :=
+  forall s nt,
+    match goto_table s nt with
+    | Some (exist _ s2 _) =>
+      prefix (past_symb_of_non_init_state s2) (head_symbs_of_state s)
+    | None => True
+    end.
+
+(** We have to say the same kind of checks for the assumptions about the
+    states stack. However, theses assumptions are predicates. So we define
+    a notion of "prefix" over predicates lists, that means, basically, that
+    an assumption entails another **)
+Inductive prefix_pred: list (state->bool) -> list (state->bool) -> Prop :=
+  | prefix_pred_nil: forall l, prefix_pred [] l
+  | prefix_pred_cons: forall l1 l2 f1 f2,
+     (forall x, implb (f2 x) (f1 x) = true) ->
+     prefix_pred l1 l2 -> prefix_pred (f1::l1) (f2::l2).
+
+(** [prefix_pred] is transitive **)
+Lemma prefix_pred_trans:
+  forall (l1 l2 l3:list (state->bool)),
+  prefix_pred l1 l2 -> prefix_pred l2 l3 -> prefix_pred l1 l3.
+Proof.
+  intros l1 l2 l3 H1 H2. revert l3 H2.
+  induction H1 as [|l1 l2 f1 f2 Hf2f1]; [now constructor|].
+  intros l3. inversion 1 as [|??? f3 Hf3f2]. subst. constructor; [|now eauto].
+  intros x. specialize (Hf3f2 x). specialize (Hf2f1 x).
+  repeat destruct (_ x); auto.
+Qed.
+
+Fixpoint is_prefix_pred (l1 l2:list (state->bool)) :=
+  match l1, l2 with
+  | [], _ => true
+  | f1::q1, f2::q2 =>
+    (forallb (fun x => implb (f2 x) (f1 x)) all_list
+      && is_prefix_pred q1 q2)%bool
+  | _::_, [] => false
+  end.
+
+Instance prefix_pred_is_validator l1 l2 :
+  IsValidator (prefix_pred l1 l2) (is_prefix_pred l1 l2).
+Proof.
+  revert l2. induction l1 as [|x1 l1 IH]=>l2 Hpref.
+  - constructor.
+  - destruct l2 as [|x2 l2]=>//.
+    move: Hpref=> /andb_prop [/forallb_forall ? /IH ?].
+    constructor; auto using all_list_forall.
+Qed.
+
+(** The assumptions about state stack is conserved when we shift **)
+Definition shift_past_state :=
+  forall s,
+    match action_table s with
+    | Lookahead_act awp => forall t,
+        match awp t with
+        | Shift_act s2 _ =>
+          prefix_pred (past_state_of_non_init_state s2)
+                      (head_states_of_state s)
+        | _ => True
+        end
+    | _ => True
+    end.
+
+(** The assumptions about state stack is conserved when we do a goto **)
+Definition goto_past_state :=
+  forall s nt,
+    match goto_table s nt with
+    | Some (exist _ s2 _) =>
+      prefix_pred (past_state_of_non_init_state s2)
+                  (head_states_of_state s)
+    | None => True
+    end.
+
+(** What states are possible after having popped these symbols from the
+    stack, given the annotation of the current state ? **)
+Inductive state_valid_after_pop (s:state):
+  list symbol -> list (state -> bool) -> Prop :=
+  | state_valid_after_pop_nil1:
+    forall p pl, p s = true -> state_valid_after_pop s [] (p::pl)
+  | state_valid_after_pop_nil2:
+    forall sl, state_valid_after_pop s sl []
+  | state_valid_after_pop_cons:
+    forall st sq p pl, state_valid_after_pop s sq pl ->
+      state_valid_after_pop s (st::sq) (p::pl).
+
+Fixpoint is_state_valid_after_pop (state:state) (to_pop:list symbol) annot :=
+  match annot, to_pop with
+  | [], _ => true
+  | p::_, [] => p state
+  | p::pl, s::sl => is_state_valid_after_pop state sl pl
+  end.
+
+Instance impl_is_state_valid_after_pop_is_validator state sl pl P b :
+  IsValidator P b ->
+  IsValidator (state_valid_after_pop state sl pl -> P)
+              (if is_state_valid_after_pop state sl pl then b else true).
+Proof.
+  destruct (is_state_valid_after_pop _ sl pl) eqn:EQ.
+  - intros ???. by eapply is_validator.
+  - intros _ _ Hsvap. exfalso. induction Hsvap=>//; [simpl in EQ; congruence|].
+    by destruct sl.
+Qed.
+
+(** A state is valid for reducing a production when :
+      - The assumptions on the state are such that we will find the right hand
+        side of the production on the stack.
+      - We will be able to do a goto after having popped the right hand side.
+**)
+Definition valid_for_reduce (state:state) prod :=
+    prefix (prod_rhs_rev prod) (head_symbs_of_state state) /\
+    forall state_new,
+    state_valid_after_pop state_new
+      (prod_rhs_rev prod) (head_states_of_state state) ->
+    match goto_table state_new (prod_lhs prod) with
+    | None =>
+      match state_new with
+      | Init i => prod_lhs prod = start_nt i
+      | Ninit _ => False
+      end
+    | _ => True
+    end.
+
+(** All the states that does a reduce are valid for reduction **)
+Definition reduce_ok :=
+  forall s,
+    match action_table s with
+    | Lookahead_act awp =>
+      forall t, match awp t with
+                | Reduce_act p => valid_for_reduce s p
+                | _ => True
+                end
+    | Default_reduce_act p => valid_for_reduce s p
+    end.
+
+(** The automaton is safe **)
+Definition safe :=
+  shift_head_symbs /\ goto_head_symbs /\ shift_past_state /\
+  goto_past_state /\ reduce_ok.
+
+Derive is_safe
+SuchThat (IsValidator safe (is_safe ()))
+As safe_is_validator.
+Proof. subst is_safe. instantiate (1:=fun _ => _). apply _. Qed.
+
+End Make.
diff --git a/VERSION b/VERSION
index d4563a62..b60e8d9b 100644
--- a/VERSION
+++ b/VERSION
@@ -1,3 +1,3 @@
-version=3.5
+version=3.7
 buildnr=
 tag=
diff --git a/aarch64/Archi.v b/aarch64/Archi.v
new file mode 100644
index 00000000..aef4ab77
--- /dev/null
+++ b/aarch64/Archi.v
@@ -0,0 +1,88 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Architecture-dependent parameters for AArch64 *)
+
+Require Import ZArith List.
+(*From Flocq*)
+Require Import Binary Bits.
+
+Definition ptr64 := true.
+
+Definition big_endian := false.
+
+Definition align_int64 := 8%Z.
+Definition align_float64 := 8%Z.
+
+Definition splitlong := false.
+
+Lemma splitlong_ptr32: splitlong = true -> ptr64 = false.
+Proof.
+  unfold splitlong, ptr64; congruence.
+Qed.
+
+Definition default_nan_64 := (false, iter_nat 51 _ xO xH).
+Definition default_nan_32 := (false, iter_nat 22 _ xO xH).
+
+(** Choose the first signaling NaN, if any;
+    otherwise choose the first NaN;
+    otherwise use default. *)
+
+Definition choose_nan (is_signaling: positive -> bool) 
+                      (default: bool * positive)
+                      (l0: list (bool * positive)) : bool * positive :=
+  let fix choose_snan (l1: list (bool * positive)) :=
+    match l1 with
+    | nil =>
+        match l0 with nil => default | n :: _ => n end
+    | ((s, p) as n) :: l1 =>
+        if is_signaling p then n else choose_snan l1
+    end
+  in choose_snan l0.
+
+Lemma choose_nan_idem: forall is_signaling default n,
+  choose_nan is_signaling default (n :: n :: nil) =
+  choose_nan is_signaling default (n :: nil).
+Proof.
+  intros. destruct n as [s p]; unfold choose_nan; simpl.
+  destruct (is_signaling p); auto. 
+Qed.
+
+Definition choose_nan_64 :=
+  choose_nan (fun p => negb (Pos.testbit p 51)) default_nan_64.
+
+Definition choose_nan_32 :=
+  choose_nan (fun p => negb (Pos.testbit p 22)) default_nan_32.
+
+Lemma choose_nan_64_idem: forall n,
+  choose_nan_64 (n :: n :: nil) = choose_nan_64 (n :: nil).
+Proof. intros; apply choose_nan_idem. Qed.
+
+Lemma choose_nan_32_idem: forall n,
+  choose_nan_32 (n :: n :: nil) = choose_nan_32 (n :: nil).
+Proof. intros; apply choose_nan_idem. Qed.
+
+Definition fma_order {A: Type} (x y z: A) := (z, x, y).
+
+Definition fma_invalid_mul_is_nan := true.
+
+Definition float_of_single_preserves_sNaN := false.
+
+Global Opaque ptr64 big_endian splitlong
+              default_nan_64 choose_nan_64
+              default_nan_32 choose_nan_32
+              fma_order fma_invalid_mul_is_nan
+              float_of_single_preserves_sNaN.
+
+(** Whether to generate position-independent code or not *)
+
+Parameter pic_code: unit -> bool.
diff --git a/aarch64/Asm.v b/aarch64/Asm.v
new file mode 100644
index 00000000..47cd3051
--- /dev/null
+++ b/aarch64/Asm.v
@@ -0,0 +1,1312 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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 AArch64 assembly language *)
+
+Require Import Coqlib Zbits Maps.
+Require Import AST Integers Floats.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Locations Conventions.
+Require Stacklayout.
+
+(** * Abstract syntax *)
+
+(** Integer registers, floating-point registers. *)
+
+(** In assembly files, [Xn] denotes the full 64-bit register
+    and [Wn] the low 32 bits of [Xn]. *)
+
+Inductive ireg: Type :=
+  | X0  | X1  | X2  | X3  | X4  | X5  |  X6  | X7
+  | X8  | X9  | X10 | X11 | X12 | X13 |  X14 | X15
+  | X16 | X17 | X18 | X19 | X20 | X21 |  X22 | X23
+  | X24 | X25 | X26 | X27 | X28 | X29 |  X30.
+
+Inductive ireg0: Type :=
+  | RR0 (r: ireg) | XZR.
+
+Inductive iregsp: Type :=
+  | RR1 (r: ireg) | XSP.
+
+Coercion RR0: ireg >-> ireg0.
+Coercion RR1: ireg >-> iregsp.
+
+Lemma ireg_eq: forall (x y: ireg), {x=y} + {x<>y}.
+Proof. decide equality. Defined.
+
+(** In assembly files, [Dn] denotes the low 64-bit of a vector register,
+    and [Sn] the low 32 bits. *)
+
+Inductive freg: Type :=
+  | D0  | D1  | D2  | D3  | D4  | D5  |  D6  | D7
+  | D8  | D9  | D10 | D11 | D12 | D13 |  D14 | D15
+  | D16 | D17 | D18 | D19 | D20 | D21 |  D22 | D23
+  | D24 | D25 | D26 | D27 | D28 | D29 |  D30 | D31.
+
+Lemma freg_eq: forall (x y: freg), {x=y} + {x<>y}.
+Proof. decide equality. Defined.
+
+(** Bits in the condition register. *)
+
+Inductive crbit: Type :=
+  | CN: crbit    (**r negative *)
+  | CZ: crbit    (**r zero *)
+  | CC: crbit    (**r carry *)
+  | CV: crbit.   (**r overflow *)
+
+Lemma crbit_eq: forall (x y: crbit), {x=y} + {x<>y}.
+Proof. decide equality. Defined.
+
+(** We model the following registers of the ARM architecture. *)
+
+Inductive preg: Type :=
+  | IR: ireg -> preg   (**r 64- or 32-bit integer registers *)
+  | FR: freg -> preg   (**r double- or single-precision float registers *)
+  | CR: crbit -> preg  (**r bits in the condition register *)
+  | SP: preg           (**r register X31 used as stack pointer *)
+  | PC: preg.          (**r program counter *)
+
+Coercion IR: ireg >-> preg.
+Coercion FR: freg >-> preg.
+Coercion CR: crbit >-> preg.
+
+Lemma preg_eq: forall (x y: preg), {x=y} + {x<>y}.
+Proof. decide equality. apply ireg_eq. apply freg_eq. apply crbit_eq. Defined.
+
+Module PregEq.
+  Definition t := preg.
+  Definition eq := preg_eq.
+End PregEq.
+
+Module Pregmap := EMap(PregEq).
+
+Definition preg_of_iregsp (r: iregsp) : preg :=
+  match r with RR1 r => IR r | XSP => SP end.
+
+Coercion preg_of_iregsp: iregsp >-> preg.
+
+(** Conventional name for return address ([RA]) *)
+
+Notation "'RA'" := X30 (only parsing) : asm.
+
+(** The instruction set.  Most instructions correspond exactly to
+  actual AArch64 instructions. See the ARM 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 isize: Type :=
+  | W                                                (**r 32-bit integer operation *)
+  | X.                                               (**r 64-bit integer operation *)
+
+Inductive fsize: Type :=
+  | S                                                (**r 32-bit, single-precision FP operation *)
+  | D.                                               (**r 64-bit, double-precision FP operation *)
+
+Inductive testcond : Type :=
+  | TCeq: testcond    (**r equal *)
+  | TCne: testcond    (**r not equal *)
+  | TChs: testcond    (**r unsigned higher or same *)
+  | TClo: testcond    (**r unsigned lower *)
+  | TCmi: testcond    (**r negative *)
+  | TCpl: testcond    (**r positive *)
+  | TChi: testcond    (**r unsigned higher *)
+  | TCls: testcond    (**r unsigned lower or same *)
+  | TCge: testcond    (**r signed greater or equal *)
+  | TClt: testcond    (**r signed less than *)
+  | TCgt: testcond    (**r signed greater *)
+  | TCle: testcond.   (**r signed less than or equal *)
+
+Inductive addressing: Type :=
+  | ADimm (base: iregsp) (n: int64)                  (**r base plus immediate offset *)
+  | ADreg (base: iregsp) (r: ireg)                   (**r base plus reg *)
+  | ADlsl (base: iregsp) (r: ireg) (n: int)          (**r base plus reg LSL n *)
+  | ADsxt (base: iregsp) (r: ireg) (n: int)          (**r base plus SIGN-EXT(reg) LSL n *)
+  | ADuxt (base: iregsp) (r: ireg) (n: int)          (**r base plus ZERO-EXT(reg) LSL n *)
+  | ADadr (base: iregsp) (id: ident) (ofs: ptrofs)   (**r base plus low address of [id + ofs] *)
+  | ADpostincr (base: iregsp) (n: int64).            (**r base plus offset; base is updated after *)
+
+Inductive shift_op: Type :=
+  | SOnone
+  | SOlsl (n: int)
+  | SOlsr (n: int)
+  | SOasr (n: int)
+  | SOror (n: int).
+
+Inductive extend_op: Type :=
+  | EOsxtb (n: int)
+  | EOsxth (n: int)
+  | EOsxtw (n: int)
+  | EOuxtb (n: int)
+  | EOuxth (n: int)
+  | EOuxtw (n: int)
+  | EOuxtx (n: int).
+
+Inductive instruction: Type :=
+  (** Branches *)
+  | Pb (lbl: label)                                                   (**r branch *)
+  | Pbc (c: testcond) (lbl: label)                                    (**r conditional branch *)
+  | Pbl (id: ident) (sg: signature)                                   (**r jump to function and link *)
+  | Pbs (id: ident) (sg: signature)                                   (**r jump to function *)
+  | Pblr (r: ireg) (sg: signature)                                    (**r indirect jump and link *)
+  | Pbr (r: ireg) (sg: signature)                                     (**r indirect jump *)
+  | Pret (r: ireg)                                                    (**r return *)
+  | Pcbnz (sz: isize) (r: ireg) (lbl: label)                          (**r branch if not zero *)
+  | Pcbz (sz: isize) (r: ireg) (lbl: label)                           (**r branch if zero *)
+  | Ptbnz (sz: isize) (r: ireg) (n: int) (lbl: label)                 (**r branch if bit n is not zero *)
+  | Ptbz (sz: isize) (r: ireg) (n: int) (lbl: label)                  (**r branch if bit n is zero *)
+  (** Memory loads and stores *)
+  | Pldrw (rd: ireg) (a: addressing)                                  (**r load int32 *)
+  | Pldrw_a (rd: ireg) (a: addressing)                                (**r load int32 as any32 *)
+  | Pldrx (rd: ireg) (a: addressing)                                  (**r load int64 *)
+  | Pldrx_a (rd: ireg) (a: addressing)                                (**r load int64 as any64 *)
+  | Pldrb (sz: isize) (rd: ireg) (a: addressing)                      (**r load int8, zero-extend *)
+  | Pldrsb (sz: isize) (rd: ireg) (a: addressing)                     (**r load int8, sign-extend *)
+  | Pldrh (sz: isize) (rd: ireg) (a: addressing)                      (**r load int16, zero-extend *)
+  | Pldrsh (sz: isize) (rd: ireg) (a: addressing)                     (**r load int16, sign-extend *)
+  | Pldrzw (rd: ireg) (a: addressing)                                 (**r load int32, zero-extend to int64 *)
+  | Pldrsw (rd: ireg) (a: addressing)                                 (**r load int32, sign-extend to int64 *)
+  | Pldp (rd1 rd2: ireg) (a: addressing)                               (**r load two int64 *)
+  | Pstrw (rs: ireg) (a: addressing)                                  (**r store int32 *)
+  | Pstrw_a (rs: ireg) (a: addressing)                                (**r store int32 as any32 *)
+  | Pstrx (rs: ireg) (a: addressing)                                  (**r store int64 *)
+  | Pstrx_a (rs: ireg) (a: addressing)                                (**r store int64 as any64 *)
+  | Pstrb (rs: ireg) (a: addressing)                                  (**r store int8 *)
+  | Pstrh (rs: ireg) (a: addressing)                                  (**r store int16 *)
+  | Pstp (rs1 rs2: ireg) (a: addressing)                              (**r store two int64 *)
+  (** Integer arithmetic, immediate *)
+  | Paddimm (sz: isize) (rd: iregsp) (r1: iregsp) (n: Z)              (**r addition *)
+  | Psubimm (sz: isize) (rd: iregsp) (r1: iregsp) (n: Z)              (**r subtraction *)
+  | Pcmpimm (sz: isize) (r1: ireg) (n: Z)                             (**r compare *)
+  | Pcmnimm (sz: isize) (r1: ireg) (n: Z)                             (**r compare negative *)
+  (** Move integer register *)
+  | Pmov (rd: iregsp) (r1: iregsp)
+  (** Logical, immediate *)
+  | Pandimm (sz: isize) (rd: ireg) (r1: ireg0) (n: Z)                 (**r and *)
+  | Peorimm (sz: isize) (rd: ireg) (r1: ireg0) (n: Z)                 (**r xor *)
+  | Porrimm (sz: isize) (rd: ireg) (r1: ireg0) (n: Z)                 (**r or *)
+  | Ptstimm (sz: isize) (r1: ireg) (n: Z)                             (**r and, then set flags *)
+  (** Move wide immediate *)
+  | Pmovz (sz: isize) (rd: ireg) (n: Z) (pos: Z)                      (**r move [n << pos] to [rd] *)
+  | Pmovn (sz: isize) (rd: ireg) (n: Z) (pos: Z)                      (**r move [NOT(n << pos)] to [rd] *)
+  | Pmovk (sz: isize) (rd: ireg) (n: Z) (pos: Z)                      (**r insert 16 bits of [n] at [pos] in rd *)
+  (** PC-relative addressing *)
+  | Padrp (rd: ireg) (id: ident) (ofs: ptrofs)                        (**r set [rd] to high address of [id + ofs] *)
+  | Paddadr (rd: ireg) (r1: ireg) (id: ident) (ofs: ptrofs)           (**r add the low address of [id + ofs] *)
+  (** Bit-field operations *)
+  | Psbfiz (sz: isize) (rd: ireg) (r1: ireg) (r: int) (s: Z)          (**r sign extend and shift left *)
+  | Psbfx (sz: isize) (rd: ireg) (r1: ireg) (r: int) (s: Z)           (**r shift right and sign extend *)
+  | Pubfiz (sz: isize) (rd: ireg) (r1: ireg) (r: int) (s: Z)          (**r zero extend and shift left *)
+  | Pubfx (sz: isize) (rd: ireg) (r1: ireg) (r: int) (s: Z)           (**r shift right and zero extend *)
+  (** Integer arithmetic, shifted register *)
+  | Padd (sz: isize) (rd: ireg) (r1: ireg0) (r2: ireg) (s: shift_op)  (**r addition *)
+  | Psub (sz: isize) (rd: ireg) (r1: ireg0) (r2: ireg) (s: shift_op)  (**r subtraction *)
+  | Pcmp (sz: isize) (r1: ireg0) (r2: ireg) (s: shift_op)             (**r compare *)
+  | Pcmn (sz: isize) (r1: ireg0) (r2: ireg) (s: shift_op)             (**r compare negative *)
+  (** Integer arithmetic, extending register *)
+  | Paddext (rd: iregsp) (r1: iregsp) (r2: ireg) (x: extend_op)       (**r int64-int32 add *)
+  | Psubext (rd: iregsp) (r1: iregsp) (r2: ireg) (x: extend_op)       (**r int64-int32 sub *)
+  | Pcmpext (r1: ireg) (r2: ireg) (x: extend_op)                      (**r int64-int32 cmp *)
+  | Pcmnext (r1: ireg) (r2: ireg) (x: extend_op)                      (**r int64-int32 cmn *)
+  (** Logical, shifted register *)
+  | Pand (sz: isize) (rd: ireg) (r1: ireg0) (r2: ireg) (s: shift_op)  (**r and *)
+  | Pbic (sz: isize) (rd: ireg) (r1: ireg0) (r2: ireg) (s: shift_op)  (**r and-not *)
+  | Peon (sz: isize) (rd: ireg) (r1: ireg0) (r2: ireg) (s: shift_op)  (**r xor-not *)
+  | Peor (sz: isize) (rd: ireg) (r1: ireg0) (r2: ireg) (s: shift_op)  (**r xor *)
+  | Porr (sz: isize) (rd: ireg) (r1: ireg0) (r2: ireg) (s: shift_op)  (**r or *)
+  | Porn (sz: isize) (rd: ireg) (r1: ireg0) (r2: ireg) (s: shift_op)  (**r or-not *)
+  | Ptst (sz: isize) (r1: ireg0) (r2: ireg) (s: shift_op)             (**r and, then set flags *)
+  (** Variable shifts *)
+  | Pasrv (sz: isize) (rd: ireg) (r1 r2: ireg)                        (**r arithmetic right shift *)
+  | Plslv (sz: isize) (rd: ireg) (r1 r2: ireg)                        (**r left shift *)
+  | Plsrv (sz: isize) (rd: ireg) (r1 r2: ireg)                        (**r logical right shift *)
+  | Prorv (sz: isize) (rd: ireg) (r1 r2: ireg)                        (**r rotate right *)
+  (** Bit operations *)
+  | Pcls (sz: isize) (rd r1: ireg)                                    (**r count leading sign bits *)
+  | Pclz (sz: isize) (rd r1: ireg)                                    (**r count leading zero bits *)
+  | Prev (sz: isize) (rd r1: ireg)                                    (**r reverse bytes *)
+  | Prev16 (sz: isize) (rd r1: ireg)                                  (**r reverse bytes in each 16-bit word *)
+  (** Conditional data processing *)
+  | Pcsel (rd: ireg) (r1 r2: ireg) (c: testcond)                      (**r int conditional move *)
+  | Pcset (rd: ireg) (c: testcond)                                    (**r set to 1/0 if cond is true/false *)
+(*
+  | Pcsetm (rd: ireg) (c: testcond)                                   (**r set to -1/0 if cond is true/false *)
+*)
+  (** Integer multiply/divide *)
+  | Pmadd (sz: isize) (rd: ireg) (r1 r2: ireg) (r3: ireg0)            (**r multiply-add *)
+  | Pmsub (sz: isize) (rd: ireg) (r1 r2: ireg) (r3: ireg0)            (**r multiply-sub *)
+  | Psmulh (rd: ireg) (r1 r2: ireg)                                   (**r signed multiply high *)
+  | Pumulh (rd: ireg) (r1 r2: ireg)                                   (**r unsigned multiply high *)
+  | Psdiv (sz: isize) (rd: ireg) (r1 r2: ireg)                        (**r signed division *)
+  | Pudiv (sz: isize) (rd: ireg) (r1 r2: ireg)                        (**r unsigned division *)
+  (** Floating-point loads and stores *)
+  | Pldrs (rd: freg) (a: addressing)                                  (**r load float32 (single precision) *)
+  | Pldrd (rd: freg) (a: addressing)                                  (**r load float64 (double precision) *)
+  | Pldrd_a (rd: freg) (a: addressing)                                (**r load float64 as any64 *)
+  | Pstrs (rs: freg) (a: addressing)                                  (**r store float32 *)
+  | Pstrd (rs: freg) (a: addressing)                                  (**r store float64 *)
+  | Pstrd_a (rs: freg) (a: addressing)                                (**r store float64 as any64 *)
+  (** Floating-point move *)
+  | Pfmov (rd r1: freg)
+  | Pfmovimms (rd: freg) (f: float32)                                 (**r load float32 constant *)
+  | Pfmovimmd (rd: freg) (f: float)                                   (**r load float64 constant *)
+  | Pfmovi (fsz: fsize) (rd: freg) (r1: ireg0)                        (**r copy int reg to FP reg *)
+  (** Floating-point conversions *)
+  | Pfcvtds (rd r1: freg)                                             (**r convert float32 to float64 *)
+  | Pfcvtsd (rd r1: freg)                                             (**r convert float64 to float32 *)
+  | Pfcvtzs (isz: isize) (fsz: fsize) (rd: ireg) (r1: freg)           (**r convert float to signed int *)
+  | Pfcvtzu (isz: isize) (fsz: fsize) (rd: ireg) (r1: freg)           (**r convert float to unsigned int *)
+  | Pscvtf (fsz: fsize) (isz: isize) (rd: freg) (r1: ireg)            (**r convert signed int to float *)
+  | Pucvtf (fsz: fsize) (isz: isize) (rd: freg) (r1: ireg)            (**r convert unsigned int to float *)
+  (** Floating-point arithmetic *)
+  | Pfabs (sz: fsize) (rd r1: freg)                                   (**r absolute value *)
+  | Pfneg (sz: fsize) (rd r1: freg)                                   (**r negation *)
+  | Pfsqrt (sz: fsize) (rd r1: freg)                                  (**r square root *)
+  | Pfadd (sz: fsize) (rd r1 r2: freg)                                (**r addition *)
+  | Pfdiv (sz: fsize) (rd r1 r2: freg)                                (**r division *)
+  | Pfmul (sz: fsize) (rd r1 r2: freg)                                (**r multiplication *)
+  | Pfnmul (sz: fsize) (rd r1 r2: freg)                               (**r multiply-negate *)
+  | Pfsub (sz: fsize) (rd r1 r2: freg)                                (**r subtraction *)
+  | Pfmadd (sz: fsize) (rd r1 r2 r3: freg)                            (**r [rd = r3 + r1 * r2] *)
+  | Pfmsub (sz: fsize) (rd r1 r2 r3: freg)                            (**r [rd = r3 - r1 * r2] *)
+  | Pfnmadd (sz: fsize) (rd r1 r2 r3: freg)                           (**r [rd = - r3 - r1 * r2] *)
+  | Pfnmsub (sz: fsize) (rd r1 r2 r3: freg)                           (**r [rd = - r3 + r1 * r2] *)
+  (** Floating-point comparison *)
+  | Pfcmp (sz: fsize) (r1 r2: freg)                                   (**r compare [r1] and [r2] *)
+  | Pfcmp0 (sz: fsize) (r1: freg)                                     (**r compare [r1] and [+0.0] *)
+  (** Floating-point conditional select *)
+  | Pfsel (rd r1 r2: freg) (cond: testcond)
+  (** Pseudo-instructions *)
+  | Pallocframe (sz: Z) (linkofs: ptrofs)                             (**r allocate new stack frame *)
+  | Pfreeframe (sz: Z) (linkofs: ptrofs)                              (**r deallocate stack frame and restore previous frame *)
+  | Plabel (lbl: label)                                               (**r define a code label *)
+  | Ploadsymbol (rd: ireg) (id: ident)                                (**r load the address of [id] *)
+  | Pcvtsw2x (rd: ireg) (r1: ireg)                                    (**r sign-extend 32-bit int to 64-bit *)
+  | Pcvtuw2x (rd: ireg) (r1: ireg)                                    (**r zero-extend 32-bit int to 64-bit *)
+  | Pcvtx2w (rd: ireg)                                                (**r retype a 64-bit int as a 32-bit int *)
+  | Pbtbl (r1: ireg) (tbl: list label)                                (**r N-way branch through a jump table *)
+  | Pbuiltin (ef: external_function)
+             (args: list (builtin_arg preg)) (res: builtin_res preg)  (**r built-in function (pseudo) *)
+  | Pnop                                                              (**r no operation *)
+  | Pcfi_adjust (ofs: int)                                            (**r .cfi_adjust debug directive *)
+  | Pcfi_rel_offset (ofs: int)                                        (**r .cfi_rel_offset debug directive *)
+.
+
+Definition code := list instruction.
+Record function : Type := mkfunction { fn_sig: signature; fn_code: code }.
+Definition fundef := AST.fundef function.
+Definition program := AST.program fundef unit.
+
+(** * Operational semantics *)
+
+(** 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 condition bits to either [Vzero] or [Vone]. *)
+
+Definition regset := Pregmap.t val.
+Definition genv := Genv.t fundef unit.
+
+(** The value of an [ireg0] is either the value of the integer register,
+    or 0. *)
+
+Definition ir0w (rs: regset) (r: ireg0) : val :=
+  match r with RR0 r => rs (IR r) | XZR => Vint Int.zero end.
+Definition ir0x (rs: regset) (r: ireg0) : val :=
+  match r with RR0 r => rs (IR r) | XZR => Vlong Int64.zero end.
+
+(** Concise notations for accessing and updating the values of registers. *)
+
+Notation "a # b" := (a b) (at level 1, only parsing) : asm.
+Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level) : asm.
+Notation "a ## b" := (ir0w a b) (at level 1, only parsing) : asm.
+Notation "a ### b" := (ir0x a b) (at level 1, only parsing) : asm.
+
+Open Scope asm.
+
+(** Undefining some registers *)
+
+Fixpoint undef_regs (l: list preg) (rs: regset) : regset :=
+  match l with
+  | nil => rs
+  | r :: l' => undef_regs l' (rs#r <- Vundef)
+  end.
+
+(** Undefining the condition codes *)
+
+Definition undef_flags (rs: regset) : regset :=
+  fun r => match r with CR _ => Vundef | _ => rs r end.
+
+(** Assigning a register pair *)
+
+Definition set_pair (p: rpair preg) (v: val) (rs: regset) : regset :=
+  match p with
+  | One r => rs#r <- v
+  | Twolong rhi rlo => rs#rhi <- (Val.hiword v) #rlo <- (Val.loword v)
+  end.
+
+(** Assigning the result of a builtin *)
+
+Fixpoint set_res (res: builtin_res preg) (v: val) (rs: regset) : regset :=
+  match res with
+  | BR r => rs#r <- v
+  | BR_none => rs
+  | BR_splitlong hi lo => set_res lo (Val.loword v) (set_res hi (Val.hiword v) rs)
+  end.
+
+(** The two functions below axiomatize how the linker processes
+  symbolic references [symbol + offset].  It computes the
+  difference between the address and the PC, and splits it into:
+  - 12 low bits usable as an offset in an addressing mode;
+  - 21 high bits usable as argument to the ADRP instruction.
+
+  In CompCert's model, we cannot really describe PC-relative addressing,
+  but we can claim that the address of [symbol + offset] decomposes
+  as the sum of
+  - a low part, usable as an offset in an addressing mode;
+  - a high part, usable as argument to the ADRP instruction. *)
+
+Parameter symbol_low: genv -> ident -> ptrofs -> val.
+Parameter symbol_high: genv -> ident -> ptrofs -> val.
+
+Axiom symbol_high_low:
+  forall (ge: genv) (id: ident) (ofs: ptrofs),
+  Val.addl (symbol_high ge id ofs) (symbol_low ge id ofs) = Genv.symbol_address ge id ofs.
+
+Section RELSEM.
+
+Variable ge: genv.
+
+(** 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. destruct (peq lbl lbl0); 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.
+
+(** The semantics is purely small-step and defined as a function
+  from the current state (a register set + a memory state)
+  to either [Next rs' m'] where [rs'] and [m'] are the updated register
+  set and memory state after execution of the instruction at [rs#PC],
+  or [Stuck] if the processor is stuck. *)
+
+Inductive outcome: Type :=
+  | Next: regset -> mem -> outcome
+  | Stuck: outcome.
+
+(** Manipulations over the [PC] register: continuing with the next
+  instruction ([nextinstr]) or branching to a label ([goto_label]). *)
+
+Definition nextinstr (rs: regset) :=
+  rs#PC <- (Val.offset_ptr rs#PC Ptrofs.one).
+
+Definition goto_label (f: function) (lbl: label) (rs: regset) (m: mem) :=
+  match label_pos lbl 0 (fn_code f) with
+  | None => Stuck
+  | Some pos =>
+      match rs#PC with
+      | Vptr b ofs => Next (rs#PC <- (Vptr b (Ptrofs.repr pos))) m
+      | _ => Stuck
+    end
+  end.
+
+(** Testing a condition *)
+
+Definition eval_testcond (c: testcond) (rs: regset) : option bool :=
+  match c with
+  | TCeq =>                             (**r equal *)
+      match rs#CZ with
+      | Vint n => Some (Int.eq n Int.one)
+      | _ => None
+      end
+  | TCne =>                             (**r not equal *)
+      match rs#CZ with
+      | Vint n => Some (Int.eq n Int.zero)
+      | _ => None
+      end
+  | TClo =>                             (**r unsigned less than  *)
+      match rs#CC with
+      | Vint n => Some (Int.eq n Int.zero)
+      | _ => None
+      end
+  | TCls =>                             (**r unsigned less or equal *)
+      match rs#CC, rs#CZ with
+      | Vint c, Vint z => Some (Int.eq c Int.zero || Int.eq z Int.one)
+      | _, _ => None
+      end
+  | TChs =>                             (**r unsigned greater or equal *)
+      match rs#CC with
+      | Vint n => Some (Int.eq n Int.one)
+      | _ => None
+      end
+  | TChi =>                             (**r unsigned greater *)
+      match rs#CC, rs#CZ with
+      | Vint c, Vint z => Some (Int.eq c Int.one && Int.eq z Int.zero)
+      | _, _ => None
+      end
+  | TClt =>                             (**r signed less than *)
+      match rs#CV, rs#CN with
+      | Vint o, Vint s => Some (Int.eq (Int.xor o s) Int.one)
+      | _, _ => None
+      end
+  | TCle =>                             (**r signed less or equal *)
+      match rs#CV, rs#CN, rs#CZ with
+      | Vint o, Vint s, Vint z => Some (Int.eq (Int.xor o s) Int.one || Int.eq z Int.one)
+      | _, _, _ => None
+      end
+  | TCge =>                             (**r signed greater or equal *)
+      match rs#CV, rs#CN with
+      | Vint o, Vint s => Some (Int.eq (Int.xor o s) Int.zero)
+      | _, _ => None
+      end
+  | TCgt =>                             (**r signed greater *)
+      match rs#CV, rs#CN, rs#CZ with
+      | Vint o, Vint s, Vint z => Some (Int.eq (Int.xor o s) Int.zero && Int.eq z Int.zero)
+      | _, _, _ => None
+      end
+  | TCpl =>                             (**r positive *)
+      match rs#CN with
+      | Vint n => Some (Int.eq n Int.zero)
+      | _ => None
+      end
+  | TCmi =>                             (**r negative *)
+      match rs#CN with
+      | Vint n => Some (Int.eq n Int.one)
+      | _ => None
+      end
+  end.
+
+(** Integer "is zero?" test *)
+
+Definition eval_testzero (sz: isize) (v: val) (m: mem): option bool :=
+  match sz with
+  | W => Val.cmpu_bool (Mem.valid_pointer m) Ceq v (Vint Int.zero)
+  | X => Val.cmplu_bool (Mem.valid_pointer m) Ceq v (Vlong Int64.zero)
+  end.
+
+(** Integer "bit is set?" test *)
+
+Definition eval_testbit (sz: isize) (v: val) (n: int): option bool :=
+  match sz with
+  | W => Val.cmp_bool Cne (Val.and v (Vint (Int.shl Int.one n))) (Vint Int.zero)
+  | X => Val.cmpl_bool Cne (Val.andl v (Vlong (Int64.shl' Int64.one n))) (Vlong Int64.zero)
+  end.
+
+(** Evaluating an addressing mode *)
+
+Definition eval_addressing (a: addressing) (rs: regset): val :=
+  match a with
+  | ADimm base n => Val.addl rs#base (Vlong n)
+  | ADreg base r => Val.addl rs#base rs#r
+  | ADlsl base r n => Val.addl rs#base (Val.shll rs#r (Vint n))
+  | ADsxt base r n => Val.addl rs#base (Val.shll (Val.longofint rs#r) (Vint n))
+  | ADuxt base r n => Val.addl rs#base (Val.shll (Val.longofintu rs#r) (Vint n))
+  | ADadr base id ofs => Val.addl rs#base (symbol_low ge id ofs)
+  | ADpostincr base n => Vundef (* not modeled yet *)
+  end.
+
+(** Auxiliaries for memory accesses *)
+
+Definition exec_load (chunk: memory_chunk) (transf: val -> val)
+                     (a: addressing) (r: preg) (rs: regset) (m: mem) :=
+  match Mem.loadv chunk m (eval_addressing a rs) with
+  | None => Stuck
+  | Some v => Next (nextinstr (rs#r <- (transf v))) m
+  end.
+
+Definition exec_store (chunk: memory_chunk)
+                      (a: addressing) (v: val)
+                      (rs: regset) (m: mem) :=
+  match Mem.storev chunk m (eval_addressing a rs) v with
+  | None => Stuck
+  | Some m' => Next (nextinstr rs) m'
+  end.
+
+(** Comparisons *)
+
+Definition compare_int (rs: regset) (v1 v2: val) (m: mem) :=
+  rs#CN <- (Val.negative (Val.sub v1 v2))
+    #CZ <- (Val.cmpu (Mem.valid_pointer m) Ceq v1 v2)
+    #CC <- (Val.cmpu (Mem.valid_pointer m) Cge v1 v2)
+    #CV <- (Val.sub_overflow v1 v2).
+
+Definition compare_long (rs: regset) (v1 v2: val) (m: mem) :=
+  rs#CN <- (Val.negativel (Val.subl v1 v2))
+    #CZ <- (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Ceq v1 v2))
+    #CC <- (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Cge v1 v2))
+    #CV <- (Val.subl_overflow v1 v2).
+
+(** Semantics of [fcmp] instructions:
+<<
+==	N=0 Z=1 C=1 V=0
+<	N=1 Z=0 C=0 V=0
+>	N=0 Z=0 C=1 V=0
+unord	N=0 Z=0 C=1 V=1
+>>
+*)
+
+Definition compare_float (rs: regset) (v1 v2: val) :=
+  match v1, v2 with
+  | Vfloat f1, Vfloat f2 =>
+      rs#CN <- (Val.of_bool (Float.cmp Clt f1 f2))
+        #CZ <- (Val.of_bool (Float.cmp Ceq f1 f2))
+        #CC <- (Val.of_bool (negb (Float.cmp Clt f1 f2)))
+        #CV <- (Val.of_bool (negb (Float.ordered f1 f2)))
+  | _, _ =>
+      rs#CN <- Vundef
+        #CZ <- Vundef
+        #CC <- Vundef
+        #CV <- Vundef
+  end.
+
+Definition compare_single (rs: regset) (v1 v2: val) :=
+  match v1, v2 with
+  | Vsingle f1, Vsingle f2 =>
+      rs#CN <- (Val.of_bool (Float32.cmp Clt f1 f2))
+        #CZ <- (Val.of_bool (Float32.cmp Ceq f1 f2))
+        #CC <- (Val.of_bool (negb (Float32.cmp Clt f1 f2)))
+        #CV <- (Val.of_bool (negb (Float32.ordered f1 f2)))
+  | _, _ =>
+      rs#CN <- Vundef
+        #CZ <- Vundef
+        #CC <- Vundef
+        #CV <- Vundef
+  end.
+
+(** Insertion of bits into an integer *)
+
+Definition insert_in_int (x: val) (y: Z) (pos: Z) (len: Z) : val :=
+  match x with
+  | Vint n => Vint (Int.repr (Zinsert (Int.unsigned n) y pos len))
+  | _ => Vundef
+  end.
+
+Definition insert_in_long (x: val) (y: Z) (pos: Z) (len: Z) : val :=
+  match x with
+  | Vlong n => Vlong (Int64.repr (Zinsert (Int64.unsigned n) y pos len))
+  | _ => Vundef
+  end.
+
+(** Evaluation of shifted operands *)
+
+Definition eval_shift_op_int (v: val) (s: shift_op): val :=
+  match s with
+  | SOnone => v
+  | SOlsl n => Val.shl v (Vint n)
+  | SOlsr n => Val.shru v (Vint n)
+  | SOasr n => Val.shr v (Vint n)
+  | SOror n => Val.ror v (Vint n)
+  end.
+
+Definition eval_shift_op_long (v: val) (s: shift_op): val :=
+  match s with
+  | SOnone => v
+  | SOlsl n => Val.shll v (Vint n)
+  | SOlsr n => Val.shrlu v (Vint n)
+  | SOasr n => Val.shrl v (Vint n)
+  | SOror n => Val.rorl v (Vint n)
+  end.
+
+(** Evaluation of sign- or zero- extended operands *)
+
+Definition eval_extend (v: val) (x: extend_op): val :=
+  match x with
+  | EOsxtb n => Val.shll (Val.longofint (Val.sign_ext 8 v)) (Vint n)
+  | EOsxth n => Val.shll (Val.longofint (Val.sign_ext 16 v)) (Vint n)
+  | EOsxtw n => Val.shll (Val.longofint v) (Vint n)
+  | EOuxtb n => Val.shll (Val.longofintu (Val.zero_ext 8 v)) (Vint n)
+  | EOuxth n => Val.shll (Val.longofintu (Val.zero_ext 16 v)) (Vint n)
+  | EOuxtw n => Val.shll (Val.longofintu v) (Vint n)
+  | EOuxtx n => Val.shll v (Vint n)
+  end.
+
+(** Bit-level conversion from integers to FP numbers *)
+
+Definition float32_of_bits (v: val): val :=
+  match v with
+  | Vint n => Vsingle (Float32.of_bits n)
+  | _ => Vundef
+  end.
+
+Definition float64_of_bits (v: val): val :=
+  match v with
+  | Vlong n => Vfloat (Float.of_bits n)
+  | _ => Vundef
+  end.
+
+(** Execution of a single instruction [i] in initial state
+    [rs] and [m].  Return updated state.  For instructions
+    that correspond to actual AArch64 instructions, the cases are
+    straightforward transliterations of the informal descriptions
+    given in the ARMv8 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 code we
+    generate cannot use those registers to hold values that must
+    survive the execution of the pseudo-instruction.
+*)
+
+Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : outcome :=
+  match i with
+  (** Branches *)
+  | Pb lbl =>
+      goto_label f lbl rs m
+  | Pbc cond lbl =>
+      match eval_testcond cond rs with
+      | Some true => goto_label f lbl rs m
+      | Some false => Next (nextinstr rs) m
+      | None => Stuck
+      end
+  | Pbl id sg =>
+      Next (rs#RA <- (Val.offset_ptr rs#PC Ptrofs.one) #PC <- (Genv.symbol_address ge id Ptrofs.zero)) m
+  | Pbs id sg =>
+      Next (rs#PC <- (Genv.symbol_address ge id Ptrofs.zero)) m
+  | Pblr r sg =>
+      Next (rs#RA <- (Val.offset_ptr rs#PC Ptrofs.one) #PC <- (rs#r)) m
+  | Pbr r sg =>
+      Next (rs#PC <- (rs#r)) m
+  | Pret r =>
+      Next (rs#PC <- (rs#r)) m
+  | Pcbnz sz r lbl =>
+      match eval_testzero sz rs#r m with
+      | Some true => Next (nextinstr rs) m
+      | Some false => goto_label f lbl rs m
+      | None => Stuck
+      end
+  | Pcbz sz r lbl =>
+      match eval_testzero sz rs#r m with
+      | Some true => goto_label f lbl rs m
+      | Some false => Next (nextinstr rs) m
+      | None => Stuck
+      end
+  | Ptbnz sz r n lbl =>
+      match eval_testbit sz rs#r n with
+      | Some true => goto_label f lbl rs m
+      | Some false => Next (nextinstr rs) m
+      | None => Stuck
+      end
+  | Ptbz sz r n lbl =>
+      match eval_testbit sz rs#r n with
+      | Some true => Next (nextinstr rs) m
+      | Some false => goto_label f lbl rs m
+      | None => Stuck
+      end
+  (** Memory loads and stores *)
+  | Pldrw rd a =>
+      exec_load Mint32 (fun v => v) a rd rs m
+  | Pldrw_a rd a =>
+      exec_load Many32 (fun v => v) a rd rs m
+  | Pldrx rd a =>
+      exec_load Mint64 (fun v => v) a rd rs m
+  | Pldrx_a rd a =>
+      exec_load Many64 (fun v => v) a rd rs m
+  | Pldrb W rd a =>
+      exec_load Mint8unsigned (fun v => v) a rd rs m
+  | Pldrb X rd a =>
+      exec_load Mint8unsigned Val.longofintu a rd rs m
+  | Pldrsb W rd a =>
+      exec_load Mint8signed (fun v => v) a rd rs m
+  | Pldrsb X rd a =>
+      exec_load Mint8signed Val.longofint a rd rs m
+  | Pldrh W rd a =>
+      exec_load Mint16unsigned (fun v => v) a rd rs m
+  | Pldrh X rd a =>
+      exec_load Mint16unsigned Val.longofintu a rd rs m
+  | Pldrsh W rd a =>
+      exec_load Mint16signed (fun v => v) a rd rs m
+  | Pldrsh X rd a =>
+      exec_load Mint16signed Val.longofint a rd rs m
+  | Pldrzw rd a =>
+      exec_load Mint32 Val.longofintu a rd rs m
+  | Pldrsw rd a =>
+      exec_load Mint32 Val.longofint a rd rs m
+  | Pstrw r a =>
+      exec_store Mint32 a rs#r rs m
+  | Pstrw_a r a =>
+      exec_store Many32 a rs#r rs m
+  | Pstrx r a =>
+      exec_store Mint64 a rs#r rs m
+  | Pstrx_a r a =>
+      exec_store Many64 a rs#r rs m
+  | Pstrb r a =>
+      exec_store Mint8unsigned a rs#r rs m
+  | Pstrh r a =>
+      exec_store Mint16unsigned a rs#r rs m
+  (** Integer arithmetic, immediate *)
+  | Paddimm W rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.add rs#r1 (Vint (Int.repr n))))) m
+  | Paddimm X rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.addl rs#r1 (Vlong (Int64.repr n))))) m
+  | Psubimm W rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.sub rs#r1 (Vint (Int.repr n))))) m
+  | Psubimm X rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.subl rs#r1 (Vlong (Int64.repr n))))) m
+  | Pcmpimm W r1 n =>
+      Next (nextinstr (compare_int rs rs#r1 (Vint (Int.repr n)) m)) m
+  | Pcmpimm X r1 n =>
+      Next (nextinstr (compare_long rs rs#r1 (Vlong (Int64.repr n)) m)) m
+  | Pcmnimm W r1 n =>
+      Next (nextinstr (compare_int rs rs#r1 (Vint (Int.neg (Int.repr n))) m)) m
+  | Pcmnimm X r1 n =>
+      Next (nextinstr (compare_long rs rs#r1 (Vlong (Int64.neg (Int64.repr n))) m)) m
+  (** Move integer register *)
+  | Pmov rd r1 =>
+      Next (nextinstr (rs#rd <- (rs#r1))) m
+  (** Logical, immediate *)
+  | Pandimm W rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.and rs##r1 (Vint (Int.repr n))))) m
+  | Pandimm X rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.andl rs###r1 (Vlong (Int64.repr n))))) m
+  | Peorimm W rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.xor rs##r1 (Vint (Int.repr n))))) m
+  | Peorimm X rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.xorl rs###r1 (Vlong (Int64.repr n))))) m
+  | Porrimm W rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.or rs##r1 (Vint (Int.repr n))))) m
+  | Porrimm X rd r1 n =>
+      Next (nextinstr (rs#rd <- (Val.orl rs###r1 (Vlong (Int64.repr n))))) m
+  | Ptstimm W r1 n =>
+      Next (nextinstr (compare_int rs (Val.and rs#r1 (Vint (Int.repr n))) (Vint Int.zero) m)) m
+  | Ptstimm X r1 n =>
+      Next (nextinstr (compare_long rs (Val.andl rs#r1 (Vlong (Int64.repr n))) (Vlong Int64.zero) m)) m
+  (** Move wide immediate *)
+  | Pmovz W rd n pos =>
+      Next (nextinstr (rs#rd <- (Vint (Int.repr (Z.shiftl n pos))))) m
+  | Pmovz X rd n pos =>
+      Next (nextinstr (rs#rd <- (Vlong (Int64.repr (Z.shiftl n pos))))) m
+  | Pmovn W rd n pos =>
+      Next (nextinstr (rs#rd <- (Vint (Int.repr (Z.lnot (Z.shiftl n pos)))))) m
+  | Pmovn X rd n pos =>
+      Next (nextinstr (rs#rd <- (Vlong (Int64.repr (Z.lnot (Z.shiftl n pos)))))) m
+  | Pmovk W rd n pos =>
+      Next (nextinstr (rs#rd <- (insert_in_int rs#rd n pos 16))) m
+  | Pmovk X rd n pos =>
+      Next (nextinstr (rs#rd <- (insert_in_long rs#rd n pos 16))) m
+  (** PC-relative addressing *)
+  | Padrp rd id ofs =>
+      Next (nextinstr (rs#rd <- (symbol_high ge id ofs))) m
+  | Paddadr rd r1 id ofs =>
+      Next (nextinstr (rs#rd <- (Val.addl rs#r1 (symbol_low ge id ofs)))) m
+  (** Bit-field operations *)
+  | Psbfiz W rd r1 r s =>
+      Next (nextinstr (rs#rd <- (Val.shl (Val.sign_ext s rs#r1) (Vint r)))) m
+  | Psbfiz X rd r1 r s =>
+      Next (nextinstr (rs#rd <- (Val.shll (Val.sign_ext_l s rs#r1) (Vint r)))) m
+  | Psbfx W rd r1 r s =>
+      Next (nextinstr (rs#rd <- (Val.sign_ext s (Val.shr rs#r1 (Vint r))))) m
+  | Psbfx X rd r1 r s =>
+      Next (nextinstr (rs#rd <- (Val.sign_ext_l s (Val.shrl rs#r1 (Vint r))))) m
+  | Pubfiz W rd r1 r s =>
+      Next (nextinstr (rs#rd <- (Val.shl (Val.zero_ext s rs#r1) (Vint r)))) m
+  | Pubfiz X rd r1 r s =>
+      Next (nextinstr (rs#rd <- (Val.shll (Val.zero_ext_l s rs#r1) (Vint r)))) m
+  | Pubfx W rd r1 r s =>
+      Next (nextinstr (rs#rd <- (Val.zero_ext s (Val.shru rs#r1 (Vint r))))) m
+  | Pubfx X rd r1 r s =>
+      Next (nextinstr (rs#rd <- (Val.zero_ext_l s (Val.shrlu rs#r1 (Vint r))))) m
+  (** Integer arithmetic, shifted register *)
+  | Padd W rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.add rs##r1 (eval_shift_op_int rs#r2 s)))) m
+  | Padd X rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.addl rs###r1 (eval_shift_op_long rs#r2 s)))) m
+  | Psub W rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.sub rs##r1 (eval_shift_op_int rs#r2 s)))) m
+  | Psub X rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.subl rs###r1 (eval_shift_op_long rs#r2 s)))) m
+  | Pcmp W r1 r2 s =>
+      Next (nextinstr (compare_int rs rs##r1 (eval_shift_op_int rs#r2 s) m)) m
+  | Pcmp X r1 r2 s =>
+      Next (nextinstr (compare_long rs rs###r1 (eval_shift_op_long rs#r2 s) m)) m
+  | Pcmn W r1 r2 s =>
+      Next (nextinstr (compare_int rs rs##r1 (Val.neg (eval_shift_op_int rs#r2 s)) m)) m
+  | Pcmn X r1 r2 s =>
+      Next (nextinstr (compare_long rs rs###r1 (Val.negl (eval_shift_op_long rs#r2 s)) m)) m
+  (** Integer arithmetic, extending register *)
+  | Paddext rd r1 r2 x =>
+      Next (nextinstr (rs#rd <- (Val.addl rs#r1 (eval_extend rs#r2 x)))) m
+  | Psubext rd r1 r2 x =>
+      Next (nextinstr (rs#rd <- (Val.subl rs#r1 (eval_extend rs#r2 x)))) m
+  | Pcmpext r1 r2 x =>
+      Next (nextinstr (compare_long rs rs#r1 (eval_extend rs#r2 x) m)) m
+  | Pcmnext r1 r2 x =>
+      Next (nextinstr (compare_long rs rs#r1 (Val.negl (eval_extend rs#r2 x)) m)) m
+  (** Logical, shifted register *)
+  | Pand W rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.and rs##r1 (eval_shift_op_int rs#r2 s)))) m
+  | Pand X rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.andl rs###r1 (eval_shift_op_long rs#r2 s)))) m
+  | Pbic W rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.and rs##r1 (Val.notint (eval_shift_op_int rs#r2 s))))) m
+  | Pbic X rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.andl rs###r1 (Val.notl (eval_shift_op_long rs#r2 s))))) m
+  | Peon W rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.xor rs##r1 (Val.notint (eval_shift_op_int rs#r2 s))))) m
+  | Peon X rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.xorl rs###r1 (Val.notl (eval_shift_op_long rs#r2 s))))) m
+  | Peor W rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.xor rs##r1 (eval_shift_op_int rs#r2 s)))) m
+  | Peor X rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.xorl rs###r1 (eval_shift_op_long rs#r2 s)))) m
+  | Porr W rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.or rs##r1 (eval_shift_op_int rs#r2 s)))) m
+  | Porr X rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.orl rs###r1 (eval_shift_op_long rs#r2 s)))) m
+  | Porn W rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.or rs##r1 (Val.notint (eval_shift_op_int rs#r2 s))))) m
+  | Porn X rd r1 r2 s =>
+      Next (nextinstr (rs#rd <- (Val.orl rs###r1 (Val.notl (eval_shift_op_long rs#r2 s))))) m
+  | Ptst W r1 r2 s =>
+      Next (nextinstr (compare_int rs (Val.and rs##r1 (eval_shift_op_int rs#r2 s)) (Vint Int.zero) m)) m
+  | Ptst X r1 r2 s =>
+      Next (nextinstr (compare_long rs (Val.andl rs###r1 (eval_shift_op_long rs#r2 s)) (Vlong Int64.zero) m)) m
+  (** Variable shifts *)
+  | Pasrv W rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.shr rs#r1 rs#r2))) m
+  | Pasrv X rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.shrl rs#r1 rs#r2))) m
+  | Plslv W rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.shl rs#r1 rs#r2))) m
+  | Plslv X rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.shll rs#r1 rs#r2))) m
+  | Plsrv W rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.shru rs#r1 rs#r2))) m
+  | Plsrv X rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.shrlu rs#r1 rs#r2))) m
+  | Prorv W rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.ror rs#r1 rs#r2))) m
+  | Prorv X rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.rorl rs#r1 rs#r2))) m
+  (** Conditional data processing *)
+  | Pcsel rd r1 r2 cond =>
+      let v :=
+        match eval_testcond cond rs with
+        | Some true => rs#r1
+        | Some false => rs#r2
+        | None => Vundef
+        end in
+      Next (nextinstr (rs#rd <- v)) m
+  | Pcset rd cond =>
+      let v :=
+        match eval_testcond cond rs with
+        | Some true => Vint Int.one
+        | Some false => Vint Int.zero
+        | None => Vundef
+        end in
+      Next (nextinstr (rs#rd <- v)) m
+  (** Integer multiply/divide *)
+  | Pmadd W rd r1 r2 r3 =>
+      Next (nextinstr (rs#rd <- (Val.add rs##r3 (Val.mul rs#r1 rs#r2)))) m
+  | Pmadd X rd r1 r2 r3 =>
+      Next (nextinstr (rs#rd <- (Val.addl rs###r3 (Val.mull rs#r1 rs#r2)))) m
+  | Pmsub W rd r1 r2 r3 =>
+      Next (nextinstr (rs#rd <- (Val.sub rs##r3 (Val.mul rs#r1 rs#r2)))) m
+  | Pmsub X rd r1 r2 r3 =>
+      Next (nextinstr (rs#rd <- (Val.subl rs###r3 (Val.mull rs#r1 rs#r2)))) m
+  | Psmulh rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.mullhs rs#r1 rs#r2))) m
+  | Pumulh rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.mullhu rs#r1 rs#r2))) m
+  | Psdiv W rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.divs rs#r1 rs#r2)))) m
+  | Psdiv X rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.divls rs#r1 rs#r2)))) m
+  | Pudiv W rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.divu rs#r1 rs#r2)))) m
+  | Pudiv X rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.divlu rs#r1 rs#r2)))) m
+  (** Floating-point loads and stores *)
+  | Pldrs rd a =>
+      exec_load Mfloat32 (fun v => v) a rd rs m
+  | Pldrd rd a =>
+      exec_load Mfloat64 (fun v => v) a rd rs m
+  | Pldrd_a rd a =>
+      exec_load Many64 (fun v => v) a rd rs m
+  | Pstrs r a =>
+      exec_store Mfloat32 a rs#r rs m
+  | Pstrd r a =>
+      exec_store Mfloat64 a rs#r rs m
+  | Pstrd_a r a =>
+      exec_store Many64 a rs#r rs m
+  (** Floating-point move *)
+  | Pfmov rd r1 =>
+      Next (nextinstr (rs#rd <- (rs#r1))) m
+  | Pfmovimms rd f =>
+      Next (nextinstr (rs#rd <- (Vsingle f))) m
+  | Pfmovimmd rd f =>
+      Next (nextinstr (rs#rd <- (Vfloat f))) m
+  | Pfmovi S rd r1 =>
+      Next (nextinstr (rs#rd <- (float32_of_bits rs##r1))) m
+  | Pfmovi D rd r1 =>
+      Next (nextinstr (rs#rd <- (float64_of_bits rs###r1))) m
+  (** Floating-point conversions *)
+  | Pfcvtds rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.floatofsingle rs#r1))) m
+  | Pfcvtsd rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.singleoffloat rs#r1))) m
+  | Pfcvtzs W S rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.intofsingle rs#r1)))) m
+  | Pfcvtzs W D rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.intoffloat rs#r1)))) m
+  | Pfcvtzs X S rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.longofsingle rs#r1)))) m
+  | Pfcvtzs X D rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.longoffloat rs#r1)))) m
+  | Pfcvtzu W S rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.intuofsingle rs#r1)))) m
+  | Pfcvtzu W D rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.intuoffloat rs#r1)))) m
+  | Pfcvtzu X S rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.longuofsingle rs#r1)))) m
+  | Pfcvtzu X D rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.longuoffloat rs#r1)))) m
+  | Pscvtf S W rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.singleofint rs#r1)))) m
+  | Pscvtf D W rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.floatofint rs#r1)))) m
+  | Pscvtf S X rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.singleoflong rs#r1)))) m
+  | Pscvtf D X rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.floatoflong rs#r1)))) m
+  | Pucvtf S W rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.singleofintu rs#r1)))) m
+  | Pucvtf D W rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.floatofintu rs#r1)))) m
+  | Pucvtf S X rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.singleoflongu rs#r1)))) m
+  | Pucvtf D X rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.maketotal (Val.floatoflongu rs#r1)))) m
+  (** Floating-point arithmetic *)
+  | Pfabs S rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.absfs rs#r1))) m
+  | Pfabs D rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.absf rs#r1))) m
+  | Pfneg S rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.negfs rs#r1))) m
+  | Pfneg D rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.negf rs#r1))) m
+  | Pfadd S rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.addfs rs#r1 rs#r2))) m
+  | Pfadd D rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.addf rs#r1 rs#r2))) m
+  | Pfdiv S rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.divfs rs#r1 rs#r2))) m
+  | Pfdiv D rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.divf rs#r1 rs#r2))) m
+  | Pfmul S rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.mulfs rs#r1 rs#r2))) m
+  | Pfmul D rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.mulf rs#r1 rs#r2))) m
+  | Pfnmul S rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.negfs (Val.mulfs rs#r1 rs#r2)))) m
+  | Pfnmul D rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.negf (Val.mulf rs#r1 rs#r2)))) m
+  | Pfsub S rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.subfs rs#r1 rs#r2))) m
+  | Pfsub D rd r1 r2 =>
+      Next (nextinstr (rs#rd <- (Val.subf rs#r1 rs#r2))) m
+  (** Floating-point comparison *)
+  | Pfcmp S r1 r2 =>
+      Next (nextinstr (compare_single rs rs#r1 rs#r2)) m
+  | Pfcmp D r1 r2 =>
+      Next (nextinstr (compare_float rs rs#r1 rs#r2)) m
+  | Pfcmp0 S r1 =>
+      Next (nextinstr (compare_single rs rs#r1 (Vsingle Float32.zero))) m
+  | Pfcmp0 D r1 =>
+      Next (nextinstr (compare_float rs rs#r1 (Vfloat Float.zero))) m
+  (** Floating-point conditional select *)
+  | Pfsel rd r1 r2 cond =>
+      let v :=
+        match eval_testcond cond rs with
+        | Some true => rs#r1
+        | Some false => rs#r2
+        | None => Vundef
+        end in
+      Next (nextinstr (rs#rd <- v)) m
+  (** Pseudo-instructions *)
+  | Pallocframe sz pos =>
+      let (m1, stk) := Mem.alloc m 0 sz in
+      let sp := (Vptr stk Ptrofs.zero) in
+      match Mem.storev Mint64 m1 (Val.offset_ptr sp pos) rs#SP with
+      | None => Stuck
+      | Some m2 => Next (nextinstr (rs #X29 <- (rs#SP) #SP <- sp #X16 <- Vundef)) m2
+      end
+  | Pfreeframe sz pos =>
+      match Mem.loadv Mint64 m (Val.offset_ptr rs#SP pos) with
+      | None => Stuck
+      | Some v =>
+          match rs#SP with
+          | Vptr stk ofs =>
+              match Mem.free m stk 0 sz with
+              | None => Stuck
+              | Some m' => Next (nextinstr (rs#SP <- v #X16 <- Vundef)) m'
+              end
+          | _ => Stuck
+          end
+      end
+  | Plabel lbl =>
+      Next (nextinstr rs) m
+  | Ploadsymbol rd id =>
+      Next (nextinstr (rs#rd <- (Genv.symbol_address ge id Ptrofs.zero))) m
+  | Pcvtsw2x rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.longofint rs#r1))) m
+  | Pcvtuw2x rd r1 =>
+      Next (nextinstr (rs#rd <- (Val.longofintu rs#r1))) m
+  | Pcvtx2w rd =>
+      Next (nextinstr (rs#rd <- (Val.loword rs#rd))) m
+  | Pbtbl r tbl =>
+      match (rs#X16 <- Vundef)#r with
+      | Vint n =>
+          match list_nth_z tbl (Int.unsigned n) with
+          | None => Stuck
+          | Some lbl => goto_label f lbl (rs#X16 <- Vundef #X17 <- Vundef) m
+          end
+      | _ => Stuck
+      end
+  | Pbuiltin ef args res => Stuck    (**r treated specially below *)
+  (** The following instructions and directives are not generated directly
+      by Asmgen, so we do not model them. *)
+  | Pldp _ _ _
+  | Pstp _ _ _
+  | Pcls _ _ _
+  | Pclz _ _ _
+  | Prev _ _ _
+  | Prev16 _ _ _
+  | Pfsqrt _ _ _
+  | Pfmadd _ _ _ _ _
+  | Pfmsub _ _ _ _ _
+  | Pfnmadd _ _ _ _ _
+  | Pfnmsub _ _ _ _ _
+  | Pnop
+  | Pcfi_adjust _ 
+  | Pcfi_rel_offset _ =>
+      Stuck
+  end.
+
+(** Translation of the LTL/Linear/Mach view of machine registers
+  to the AArch64 view.  Note that no LTL register maps to [X16],
+  [X18], nor [X30].
+  [X18] is reserved as the platform register and never used by the
+  code generated by CompCert.
+  [X30] is used for the return address, and can also be used as temporary.
+  [X16] can be used as temporary. *)
+
+Definition preg_of (r: mreg) : preg :=
+  match r with
+  | R0 => X0   | R1 => X1   | R2 => X2   | R3 => X3
+  | R4 => X4   | R5 => X5   | R6 => X6   | R7 => X7
+  | R8 => X8   | R9 => X9   | R10 => X10 | R11 => X11
+  | R12 => X12 | R13 => X13 | R14 => X14 | R15 => X15
+  | R17 => X17 | R19 => X19
+  | R20 => X20 | R21 => X21 | R22 => X22 | R23 => X23
+  | R24 => X24 | R25 => X25 | R26 => X26 | R27 => X27
+  | R28 => X28 | R29 => X29
+  | F0 => D0   | F1 => D1   | F2 => D2   | F3 => D3
+  | F4 => D4   | F5 => D5   | F6 => D6   | F7 => D7
+  | F8 => D8   | F9 => D9   | F10 => D10 | F11 => D11
+  | F12 => D12 | F13 => D13 | F14 => D14 | F15 => D15
+  | F16 => D16 | F17 => D17 | F18 => D18 | F19 => D19
+  | F20 => D20 | F21 => D21 | F22 => D22 | F23 => D23
+  | F24 => D24 | F25 => D25 | F26 => D26 | F27 => D27
+  | F28 => D28 | F29 => D29 | F30 => D30 | F31 => D31
+  end.
+
+(** Undefine all registers except SP and callee-save registers *)
+
+Definition undef_caller_save_regs (rs: regset) : regset :=
+  fun r =>
+    if preg_eq r SP
+    || In_dec preg_eq r (List.map preg_of (List.filter is_callee_save all_mregs))
+    then rs r
+    else Vundef.
+
+(** Extract the values of the arguments of an external call.
+    We exploit the calling conventions from module [Conventions], except that
+    we use AArch64 registers instead of locations. *)
+
+Inductive extcall_arg (rs: regset) (m: mem): loc -> val -> Prop :=
+  | extcall_arg_reg: forall r,
+      extcall_arg rs m (R r) (rs (preg_of r))
+  | extcall_arg_stack: forall ofs ty bofs v,
+      bofs = Stacklayout.fe_ofs_arg + 4 * ofs ->
+      Mem.loadv (chunk_of_type ty) m
+                (Val.offset_ptr rs#SP (Ptrofs.repr bofs)) = Some v ->
+      extcall_arg rs m (Locations.S Outgoing ofs ty) v.
+
+Inductive extcall_arg_pair (rs: regset) (m: mem): rpair loc -> val -> Prop :=
+  | extcall_arg_one: forall l v,
+      extcall_arg rs m l v ->
+      extcall_arg_pair rs m (One l) v
+  | extcall_arg_twolong: forall hi lo vhi vlo,
+      extcall_arg rs m hi vhi ->
+      extcall_arg rs m lo vlo ->
+      extcall_arg_pair rs m (Twolong hi lo) (Val.longofwords vhi vlo).
+
+Definition extcall_arguments
+    (rs: regset) (m: mem) (sg: signature) (args: list val) : Prop :=
+  list_forall2 (extcall_arg_pair rs m) (loc_arguments sg) args.
+
+Definition loc_external_result (sg: signature) : rpair preg :=
+  map_rpair preg_of (loc_result sg).
+
+(** Execution of the instruction at [rs#PC]. *)
+
+Inductive state: Type :=
+  | State: regset -> mem -> state.
+
+Inductive step: state -> trace -> state -> Prop :=
+  | exec_step_internal:
+      forall b ofs f i rs m rs' m',
+      rs PC = Vptr b ofs ->
+      Genv.find_funct_ptr ge b = Some (Internal f) ->
+      find_instr (Ptrofs.unsigned ofs) f.(fn_code) = Some i ->
+      exec_instr f i rs m = Next rs' m' ->
+      step (State rs m) E0 (State rs' m')
+  | exec_step_builtin:
+      forall b ofs f ef args res rs m vargs t vres rs' m',
+      rs PC = Vptr b ofs ->
+      Genv.find_funct_ptr ge b = Some (Internal f) ->
+      find_instr (Ptrofs.unsigned ofs) f.(fn_code) = Some (Pbuiltin ef args res) ->
+      eval_builtin_args ge rs rs#SP m args vargs ->
+      external_call ef ge vargs m t vres m' ->
+      rs' = nextinstr
+              (set_res res vres
+                (undef_regs (map preg_of (destroyed_by_builtin ef)) rs)) ->
+      step (State rs m) t (State rs' m')
+  | exec_step_external:
+      forall b ef args res rs m t rs' m',
+      rs PC = Vptr b Ptrofs.zero ->
+      Genv.find_funct_ptr ge b = Some (External ef) ->
+      external_call ef ge args m t res m' ->
+      extcall_arguments rs m (ef_sig ef) args ->
+      rs' = (set_pair (loc_external_result (ef_sig ef)) res (undef_caller_save_regs rs)) #PC <- (rs RA) ->
+      step (State rs m) t (State rs' m').
+
+End RELSEM.
+
+(** Execution of whole programs. *)
+
+Inductive initial_state (p: program): state -> Prop :=
+  | initial_state_intro: forall m0,
+      Genv.init_mem p = Some m0 ->
+      let ge := Genv.globalenv p in
+      let rs0 :=
+        (Pregmap.init Vundef)
+        # PC <- (Genv.symbol_address ge p.(prog_main) Ptrofs.zero)
+        # RA <- Vnullptr
+        # SP <- Vnullptr in
+      initial_state p (State rs0 m0).
+
+Inductive final_state: state -> int -> Prop :=
+  | final_state_intro: forall rs m r,
+      rs#PC = Vnullptr ->
+      rs#X0 = Vint r ->
+      final_state (State rs m) r.
+
+Definition semantics (p: program) :=
+  Semantics step (initial_state p) final_state (Genv.globalenv p).
+
+(** Determinacy of the [Asm] semantics. *)
+
+Remark extcall_arguments_determ:
+  forall rs m sg args1 args2,
+  extcall_arguments rs m sg args1 -> extcall_arguments rs m sg args2 -> args1 = args2.
+Proof.
+  intros until m.
+  assert (A: forall l v1 v2,
+             extcall_arg rs m l v1 -> extcall_arg rs m l v2 -> v1 = v2).
+  { intros. inv H; inv H0; congruence. }
+  assert (B: forall p v1 v2,
+             extcall_arg_pair rs m p v1 -> extcall_arg_pair rs m p v2 -> v1 = v2).
+  { intros. inv H; inv H0.
+    eapply A; eauto.
+    f_equal; eapply A; eauto. }
+  assert (C: forall ll vl1, list_forall2 (extcall_arg_pair rs m) ll vl1 ->
+             forall vl2, list_forall2 (extcall_arg_pair rs m) ll vl2 -> vl1 = vl2).
+  {
+    induction 1; intros vl2 EA; inv EA.
+    auto.
+    f_equal; eauto. }
+  intros. eapply C; eauto.
+Qed.
+
+Lemma semantics_determinate: forall p, determinate (semantics p).
+Proof.
+Ltac Equalities :=
+  match goal with
+  | [ H1: ?a = ?b, H2: ?a = ?c |- _ ] =>
+      rewrite H1 in H2; inv H2; Equalities
+  | _ => idtac
+  end.
+  intros; constructor; simpl; intros.
+- (* determ *)
+  inv H; inv H0; Equalities.
+  split. constructor. auto.
+  discriminate.
+  discriminate.
+  assert (vargs0 = vargs) by (eapply eval_builtin_args_determ; eauto). subst vargs0.
+  exploit external_call_determ. eexact H5. eexact H11. intros [A B].
+  split. auto. intros. destruct B; auto. subst. auto.
+  assert (args0 = args) by (eapply extcall_arguments_determ; eauto). subst args0.
+  exploit external_call_determ. eexact H3. eexact H8. intros [A B].
+  split. auto. intros. destruct B; auto. subst. auto.
+- (* trace length *)
+  red; intros. inv H; simpl.
+  omega.
+  eapply external_call_trace_length; eauto.
+  eapply external_call_trace_length; eauto.
+- (* initial states *)
+  inv H; inv H0. f_equal. congruence.
+- (* final no step *)
+  inv H. red; intros; red; intros. inv H; rewrite H0 in *; discriminate.
+- (* final states *)
+  inv H; inv H0. congruence.
+Qed.
+
+(** Classification functions for processor registers (used in Asmgenproof). *)
+
+Definition data_preg (r: preg) : bool :=
+  match r with
+  | IR X16 => false
+  | IR X30 => false
+  | IR _ => true
+  | FR _ => true
+  | CR _ => false
+  | SP => true
+  | PC => false
+  end.
diff --git a/aarch64/AsmToJSON.ml b/aarch64/AsmToJSON.ml
new file mode 100644
index 00000000..b7cfc152
--- /dev/null
+++ b/aarch64/AsmToJSON.ml
@@ -0,0 +1,24 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Functions to serialize AArch64 Asm to JSON *)
+
+(* Dummy function *)
+
+let destination: string option ref = ref None
+
+let sdump_folder = ref ""
+
+let print_if prog sourcename =
+  ()
+
+let pp_mnemonics pp = ()
diff --git a/aarch64/Asmexpand.ml b/aarch64/Asmexpand.ml
new file mode 100644
index 00000000..471ad501
--- /dev/null
+++ b/aarch64/Asmexpand.ml
@@ -0,0 +1,453 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Expanding built-ins and some pseudo-instructions by rewriting
+   of the AArch64 assembly code. *)
+
+open Asm
+open Asmexpandaux
+open AST
+open Camlcoq
+module Ptrofs = Integers.Ptrofs
+
+exception Error of string
+
+(* Useful constants *)
+
+let _0  = Z.zero
+let _1  = Z.one
+let _2  = Z.of_sint 2
+let _4  = Z.of_sint 4
+let _8  = Z.of_sint 8
+let _16  = Z.of_sint 16
+let _m1 = Z.of_sint (-1)
+
+(* Emit instruction sequences that set or offset a register by a constant. *)
+
+let expand_loadimm32 (dst: ireg) n =
+  List.iter emit (Asmgen.loadimm32 dst n [])
+
+let expand_addimm64 (dst: iregsp) (src: iregsp) n =
+  List.iter emit (Asmgen.addimm64 dst src n [])
+
+let expand_storeptr (src: ireg) (base: iregsp) ofs =
+  List.iter emit (Asmgen.storeptr src base ofs [])
+
+(* Handling of varargs *)
+
+(* Determine the number of int registers, FP registers, and stack locations
+   used to pass the fixed parameters. *)
+
+let rec next_arg_locations ir fr stk = function
+  | [] ->
+      (ir, fr, stk)
+  | (Tint | Tlong | Tany32 | Tany64) :: l ->
+      if ir < 8
+      then next_arg_locations (ir + 1) fr stk l
+      else next_arg_locations ir fr (stk + 8) l
+  | (Tfloat | Tsingle) :: l ->
+      if fr < 8
+      then next_arg_locations ir (fr + 1) stk l
+      else next_arg_locations ir fr (stk + 8) l
+
+(* Allocate memory on the stack and use it to save the registers
+   used for parameter passing.  As an optimization, do not save
+   the registers used to pass the fixed parameters. *)
+
+let int_param_regs = [| X0; X1; X2; X3; X4; X5; X6; X7 |]
+let float_param_regs = [| D0; D1; D2; D3; D4; D5; D6; D7 |]
+let size_save_register_area = 8*8 + 8*16
+
+let save_parameter_registers ir fr =
+  emit (Psubimm(X, XSP, XSP, Z.of_uint size_save_register_area));
+  let i = ref ir in
+  while !i < 8 do
+    let pos = 8*16 + !i*8 in
+    if !i land 1 = 0 then begin
+      emit (Pstp(int_param_regs.(!i), int_param_regs.(!i + 1),
+                 ADimm(XSP, Z.of_uint pos)));
+      i := !i + 2
+    end else begin
+      emit (Pstrx(int_param_regs.(!i), ADimm(XSP, Z.of_uint pos)));
+      i := !i + 1
+    end
+  done;
+  for i = fr to 7 do
+    let pos = i*16 in
+    emit (Pstrd(float_param_regs.(i), ADimm(XSP, Z.of_uint pos)))
+  done
+
+(* Initialize a va_list as per va_start.
+   Register r points to the following struct:
+
+   typedef struct __va_list {
+     void *__stack;             // next stack parameter
+     void *__gr_top;            // top of the save area for int regs
+     void *__vr_top;            // top of the save area for float regs
+     int__gr_offs;              // offset from gr_top to next int reg
+     int__vr_offs;              // offset from gr_top to next FP reg
+   }
+*)
+
+let current_function_stacksize = ref 0L
+
+let expand_builtin_va_start r =
+  if not (is_current_function_variadic ()) then
+    invalid_arg "Fatal error: va_start used in non-vararg function";
+  let (ir, fr, stk) =
+    next_arg_locations 0 0 0 (get_current_function_args ()) in
+  let stack_ofs = Int64.(add !current_function_stacksize (of_int stk))
+  and gr_top_ofs = !current_function_stacksize
+  and vr_top_ofs = Int64.(sub !current_function_stacksize 64L)
+  and gr_offs = - ((8 - ir) * 8)
+  and vr_offs = - ((8 - fr) * 16) in
+  (* va->__stack = sp + stack_ofs *)
+  expand_addimm64 (RR1 X16) XSP (coqint_of_camlint64 stack_ofs);
+  emit (Pstrx(X16, ADimm(RR1 r, coqint_of_camlint64 0L)));
+  (* va->__gr_top = sp + gr_top_ofs *)
+  if gr_top_ofs <> stack_ofs then
+    expand_addimm64 (RR1 X16) XSP (coqint_of_camlint64 gr_top_ofs);
+  emit (Pstrx(X16, ADimm(RR1 r, coqint_of_camlint64 8L)));
+  (* va->__vr_top = sp + vr_top_ofs *)
+  expand_addimm64 (RR1 X16) XSP (coqint_of_camlint64 vr_top_ofs);
+  emit (Pstrx(X16, ADimm(RR1 r, coqint_of_camlint64 16L)));
+  (* va->__gr_offs = gr_offs *)
+  expand_loadimm32 X16 (coqint_of_camlint (Int32.of_int gr_offs));
+  emit (Pstrw(X16, ADimm(RR1 r, coqint_of_camlint64 24L)));
+  (* va->__vr_offs = vr_offs *)
+  expand_loadimm32 X16 (coqint_of_camlint (Int32.of_int vr_offs));
+  emit (Pstrw(X16, ADimm(RR1 r, coqint_of_camlint64 28L)))
+
+(* Handling of annotations *)
+
+let expand_annot_val kind txt targ args res =
+  emit (Pbuiltin (EF_annot(kind,txt,[targ]), args, BR_none));
+  match args, res with
+  | [BA(IR src)], BR(IR dst) ->
+     if dst <> src then emit (Pmov (RR1 dst, RR1 src))
+  | [BA(FR src)], BR(FR dst) ->
+     if dst <> src then emit (Pfmov (dst, src))
+  | _, _ ->
+     raise (Error "ill-formed __builtin_annot_val")
+
+(* Handling of memcpy *)
+
+(* We assume unaligned memory accesses are efficient.  Hence we use
+   memory accesses as wide as we can, up to 16 bytes.
+   Temporary registers used: x15 x16 x17 x29 x30. *)
+
+let offset_in_range ofs =
+  (* The 512 upper bound comes from ldp/stp.  Single-register load/store
+     instructions support bigger offsets. *)
+  let ofs = Z.to_int64 ofs in 0L <= ofs && ofs < 512L
+  
+let memcpy_small_arg sz arg tmp =
+  match arg with
+  | BA (IR r) ->
+      (RR1 r, _0)
+  | BA_addrstack ofs ->
+      if offset_in_range ofs
+      && offset_in_range (Ptrofs.add ofs (Ptrofs.repr (Z.of_uint sz)))
+      then (XSP, ofs)
+      else begin expand_addimm64 (RR1 tmp) XSP ofs; (RR1 tmp, _0) end
+  | _ ->
+      assert false
+
+let expand_builtin_memcpy_small sz al src dst =
+  let (tsrc, tdst) =
+    if dst <> BA (IR X17) then (X17, X29) else (X29, X17) in
+  let (rsrc, osrc) = memcpy_small_arg sz src tsrc in
+  let (rdst, odst) = memcpy_small_arg sz dst tdst in
+  let rec copy osrc odst sz =
+    if sz >= 16 then begin
+      emit (Pldp(X16, X30, ADimm(rsrc, osrc)));
+      emit (Pstp(X16, X30, ADimm(rdst, odst)));
+      copy (Ptrofs.add osrc _16) (Ptrofs.add odst _16) (sz - 16)
+    end
+    else if sz >= 8 then begin
+      emit (Pldrx(X16, ADimm(rsrc, osrc)));
+      emit (Pstrx(X16, ADimm(rdst, odst)));
+      copy (Ptrofs.add osrc _8) (Ptrofs.add odst _8) (sz - 8)
+    end
+    else if sz >= 4 then begin
+      emit (Pldrw(X16, ADimm(rsrc, osrc)));
+      emit (Pstrw(X16, ADimm(rdst, odst)));
+      copy (Ptrofs.add osrc _4) (Ptrofs.add odst _4) (sz - 4)
+    end
+    else if sz >= 2 then begin
+      emit (Pldrh(W, X16, ADimm(rsrc, osrc)));
+      emit (Pstrh(X16, ADimm(rdst, odst)));
+      copy (Ptrofs.add osrc _2) (Ptrofs.add odst _2) (sz - 2)
+    end
+    else if sz >= 1 then begin
+      emit (Pldrb(W, X16, ADimm(rsrc, osrc)));
+      emit (Pstrb(X16, ADimm(rdst, odst)));
+      copy (Ptrofs.add osrc _1) (Ptrofs.add odst _1) (sz - 1)
+    end
+  in copy osrc odst sz
+
+let memcpy_big_arg arg tmp =
+  match arg with
+  | BA (IR r) -> emit (Pmov(RR1 tmp, RR1 r))
+  | BA_addrstack ofs -> expand_addimm64 (RR1 tmp) XSP ofs
+  | _ -> assert false
+
+let expand_builtin_memcpy_big sz al src dst =
+  assert (sz >= 16);
+  memcpy_big_arg src X30;
+  memcpy_big_arg dst X29;
+  let lbl = new_label () in
+  expand_loadimm32 X15 (Z.of_uint (sz / 16));
+  emit (Plabel lbl);
+  emit (Pldp(X16, X17, ADpostincr(RR1 X30, _16)));
+  emit (Pstp(X16, X17, ADpostincr(RR1 X29, _16)));
+  emit (Psubimm(W, RR1 X15, RR1 X15, _1));
+  emit (Pcbnz(W, X15, lbl));
+  if sz mod 16 >= 8 then begin
+    emit (Pldrx(X16, ADpostincr(RR1 X30, _8)));
+    emit (Pstrx(X16, ADpostincr(RR1 X29, _8)))
+  end;
+  if sz mod 8 >= 4 then begin
+    emit (Pldrw(X16, ADpostincr(RR1 X30, _4)));
+    emit (Pstrw(X16, ADpostincr(RR1 X29, _4)))
+  end;
+  if sz mod 4 >= 2 then begin
+    emit (Pldrh(W, X16, ADpostincr(RR1 X30, _2)));
+    emit (Pstrh(X16, ADpostincr(RR1 X29, _2)))
+  end;
+  if sz mod 2 >= 1 then begin
+    emit (Pldrb(W, X16, ADpostincr(RR1 X30, _1)));
+    emit (Pstrb(X16, ADpostincr(RR1 X29, _1)))
+  end
+
+let expand_builtin_memcpy  sz al args =
+  let (dst, src) =
+    match args with [d; s] -> (d, s) | _ -> assert false in
+  if sz < 64
+  then expand_builtin_memcpy_small sz al src dst
+  else expand_builtin_memcpy_big sz al src dst
+
+(* Handling of volatile reads and writes *)
+
+let expand_builtin_vload_common chunk base ofs res =
+  let addr = ADimm(base, ofs) in
+  match chunk, res with
+  | Mint8unsigned, BR(IR res) ->
+     emit (Pldrb(W, res, addr))
+  | Mint8signed, BR(IR res) ->
+     emit (Pldrsb(W, res, addr))
+  | Mint16unsigned, BR(IR res) ->
+     emit (Pldrh(W, res, addr))
+  | Mint16signed, BR(IR res) ->
+     emit (Pldrsh(W, res, addr))
+  | Mint32, BR(IR res) ->
+     emit (Pldrw(res, addr))
+  | Mint64, BR(IR res) ->
+     emit (Pldrx(res, addr))
+  | Mfloat32, BR(FR res) ->
+     emit (Pldrs(res, addr))
+  | Mfloat64, BR(FR res) ->
+     emit (Pldrd(res, addr))
+  | _ ->
+     assert false
+
+let expand_builtin_vload chunk args res =
+  match args with
+  | [BA(IR addr)] ->
+      expand_builtin_vload_common chunk (RR1 addr) _0 res
+  | [BA_addrstack ofs] ->
+      if offset_in_range (Z.add ofs (Memdata.size_chunk chunk)) then
+        expand_builtin_vload_common chunk XSP ofs res
+      else begin
+        expand_addimm64 (RR1 X16) XSP ofs; (* X16 <- SP + ofs *)
+        expand_builtin_vload_common chunk (RR1 X16) _0 res
+      end
+  | [BA_addptr(BA(IR addr), BA_long ofs)] ->
+      if offset_in_range (Z.add ofs (Memdata.size_chunk chunk)) then
+        expand_builtin_vload_common chunk (RR1 addr) ofs res
+      else begin
+        expand_addimm64 (RR1 X16) (RR1 addr) ofs; (* X16 <- addr + ofs *)
+        expand_builtin_vload_common chunk (RR1 X16) _0 res
+      end
+  | _ ->
+      assert false
+
+let expand_builtin_vstore_common chunk base ofs src =
+  let addr = ADimm(base, ofs) in
+  match chunk, src with
+  | (Mint8signed | Mint8unsigned), BA(IR src) ->
+     emit (Pstrb(src, addr))
+  | (Mint16signed | Mint16unsigned), BA(IR src) ->
+     emit (Pstrh(src, addr))
+  | Mint32, BA(IR src) ->
+     emit (Pstrw(src, addr))
+  | Mint64, BA(IR src) ->
+     emit (Pstrx(src, addr))
+  | Mfloat32, BA(FR src) ->
+     emit (Pstrs(src, addr))
+  | Mfloat64, BA(FR src) ->
+     emit (Pstrd(src, addr))
+  | _ ->
+     assert false
+
+let expand_builtin_vstore chunk args =
+  match args with
+  | [BA(IR addr); src] ->
+      expand_builtin_vstore_common chunk (RR1 addr) _0 src
+  | [BA_addrstack ofs; src] ->
+      if offset_in_range (Z.add ofs (Memdata.size_chunk chunk)) then
+        expand_builtin_vstore_common chunk XSP ofs src
+      else begin
+        expand_addimm64 (RR1 X16) XSP ofs; (* X16 <- SP + ofs *)
+        expand_builtin_vstore_common chunk (RR1 X16) _0 src
+      end
+  | [BA_addptr(BA(IR addr), BA_long ofs); src] ->
+      if offset_in_range (Z.add ofs (Memdata.size_chunk chunk)) then
+        expand_builtin_vstore_common chunk (RR1 addr) ofs src
+      else begin
+        expand_addimm64 (RR1 X16) (RR1 addr) ofs; (* X16 <- addr + ofs *)
+        expand_builtin_vstore_common chunk (RR1 X16) _0 src
+      end
+  | _ ->
+      assert false
+
+(* Handling of compiler-inlined builtins *)
+
+let expand_builtin_inline name args res =
+  match name, args, res with
+  (* Synchronization *)
+  | "__builtin_membar", [], _ ->
+     ()
+  | "__builtin_nop", [], _ ->
+     emit Pnop
+  (* Byte swap *)
+  | ("__builtin_bswap" | "__builtin_bswap32"), [BA(IR a1)], BR(IR res) ->
+     emit (Prev(W, res, a1))
+  | "__builtin_bswap64", [BA(IR a1)], BR(IR res) ->
+     emit (Prev(X, res, a1))
+  | "__builtin_bswap16", [BA(IR a1)], BR(IR res) ->
+     emit (Prev16(W, res, a1));
+     emit (Pandimm(W, res, RR0 res, Z.of_uint 0xFFFF))
+  (* Count leading zeros and leading sign bits *)
+  | "__builtin_clz",  [BA(IR a1)], BR(IR res) ->
+     emit (Pclz(W, res, a1))
+  | ("__builtin_clzl" | "__builtin_clzll"),  [BA(IR a1)], BR(IR res) ->
+     emit (Pclz(X, res, a1)) 
+  | "__builtin_cls",  [BA(IR a1)], BR(IR res) ->
+     emit (Pcls(W, res, a1))
+  | ("__builtin_clsl" | "__builtin_clsll"),  [BA(IR a1)], BR(IR res) ->
+     emit (Pcls(X, res, a1))
+ (* Float arithmetic *)
+  | "__builtin_fabs",  [BA(FR a1)], BR(FR res) ->
+     emit (Pfabs(D, res, a1))
+  | "__builtin_fsqrt",  [BA(FR a1)], BR(FR res) ->
+     emit (Pfsqrt(D, res, a1))
+  | "__builtin_fmadd", [BA(FR a1); BA(FR a2); BA(FR a3)], BR(FR res) ->
+      emit (Pfmadd(D, res, a1, a2, a3))
+  | "__builtin_fmsub", [BA(FR a1); BA(FR a2); BA(FR a3)], BR(FR res) ->
+      emit (Pfmsub(D, res, a1, a2, a3))
+  | "__builtin_fnmadd", [BA(FR a1); BA(FR a2); BA(FR a3)], BR(FR res) ->
+      emit (Pfnmadd(D, res, a1, a2, a3))
+  | "__builtin_fnmsub", [BA(FR a1); BA(FR a2); BA(FR a3)], BR(FR res) ->
+      emit (Pfnmsub(D, res, a1, a2, a3))
+  (* Vararg *)
+  | "__builtin_va_start", [BA(IR a)], _ ->
+      expand_builtin_va_start a
+  (* Catch-all *)
+  | _ ->
+     raise (Error ("unrecognized builtin " ^ name))
+
+(* Expansion of instructions *)
+
+let expand_instruction instr =
+  match instr with
+  | Pallocframe (sz, ofs) ->
+      emit (Pmov (RR1 X29, XSP));
+      if is_current_function_variadic() then begin
+        let (ir, fr, _) =
+          next_arg_locations 0 0 0 (get_current_function_args ()) in
+        save_parameter_registers ir fr;
+        current_function_stacksize :=
+          Int64.(add (Z.to_int64 sz) (of_int size_save_register_area))
+      end else begin
+        current_function_stacksize := Z.to_int64 sz
+      end;
+      expand_addimm64 XSP XSP (Ptrofs.repr (Z.neg sz));
+      expand_storeptr X29 XSP ofs
+  | Pfreeframe (sz, ofs) ->
+      expand_addimm64 XSP XSP (coqint_of_camlint64 !current_function_stacksize)
+  | Pcvtx2w rd ->
+      (* no code generated, the upper 32 bits of rd will be ignored *)
+      ()
+  | Pbuiltin (ef,args,res) ->
+     begin match ef with
+     | EF_builtin (name,sg) ->
+        expand_builtin_inline (camlstring_of_coqstring name) args res
+     | EF_vload chunk ->
+        expand_builtin_vload chunk args res
+     | EF_vstore chunk ->
+        expand_builtin_vstore chunk args
+     | EF_annot_val (kind,txt,targ) ->
+        expand_annot_val kind txt targ args res
+     | EF_memcpy(sz, al) ->
+        expand_builtin_memcpy (Z.to_int sz) (Z.to_int al) args
+     | EF_annot _ | EF_debug _ | EF_inline_asm _ ->
+        emit instr
+     | _ ->
+        assert false
+     end
+  | _ ->
+     emit instr
+
+let int_reg_to_dwarf = function
+  | X0 -> 0 | X1 -> 1 | X2 -> 2 | X3 -> 3 | X4 -> 4
+  | X5 -> 5 | X6 -> 6 | X7 -> 7 | X8 -> 8 | X9 -> 9
+  | X10 -> 10 | X11 -> 11 | X12 -> 12 | X13 -> 13 | X14 -> 14
+  | X15 -> 15 | X16 -> 16 | X17 -> 17 | X18 -> 18 | X19 -> 19
+  | X20 -> 20 | X21 -> 21 | X22 -> 22 | X23 -> 23 | X24 -> 24
+  | X25 -> 25 | X26 -> 26 | X27 -> 27 | X28 -> 28 | X29 -> 29
+  | X30 -> 30
+
+let float_reg_to_dwarf = function
+  | D0 -> 64 | D1 -> 65 | D2 -> 66 | D3 -> 67 | D4 -> 68
+  | D5 -> 69 | D6 -> 70 | D7 -> 71 | D8 -> 72 | D9 -> 73
+  | D10 -> 74 | D11 -> 75 | D12 -> 76 | D13 -> 77 | D14 -> 78
+  | D15 -> 79 | D16 -> 80 | D17 -> 81 | D18 -> 82 | D19 -> 83
+  | D20 -> 84 | D21 -> 85 | D22 -> 86 | D23 -> 87 | D24 -> 88
+  | D25 -> 89 | D26 -> 90 | D27 -> 91 | D28 -> 92 | D29 -> 93
+  | D30 -> 94 | D31 -> 95
+
+let preg_to_dwarf = function
+   | IR r -> int_reg_to_dwarf r
+   | FR r -> float_reg_to_dwarf r
+   | SP -> 31
+   | _ -> assert false
+
+let expand_function id fn =
+  try
+    set_current_function fn;
+    expand id (* sp= *) 31 preg_to_dwarf expand_instruction fn.fn_code;
+    Errors.OK (get_current_function ())
+  with Error s ->
+    Errors.Error (Errors.msg (coqstring_of_camlstring s))
+
+let expand_fundef id = function
+  | Internal f ->
+      begin match expand_function id f with
+      | Errors.OK tf -> Errors.OK (Internal tf)
+      | Errors.Error msg -> Errors.Error msg
+      end
+  | External ef ->
+      Errors.OK (External ef)
+
+let expand_program (p: Asm.program) : Asm.program Errors.res =
+  AST.transform_partial_program2 expand_fundef (fun id v -> Errors.OK v) p
diff --git a/aarch64/Asmgen.v b/aarch64/Asmgen.v
new file mode 100644
index 00000000..875f3fd1
--- /dev/null
+++ b/aarch64/Asmgen.v
@@ -0,0 +1,1156 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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 AArch64. *)
+
+Require Import Recdef Coqlib Zwf Zbits.
+Require Import Errors AST Integers Floats Op.
+Require Import Locations Mach Asm.
+
+Local Open Scope string_scope.
+Local Open Scope list_scope.
+Local Open Scope error_monad_scope.
+
+(** Alignment check for symbols *)
+
+Parameter symbol_is_aligned : ident -> Z -> bool.
+(** [symbol_is_aligned id sz] checks whether the symbol [id] is [sz] aligned *)
+
+(** Extracting integer or float registers. *)
+
+Definition ireg_of (r: mreg) : res ireg :=
+  match preg_of r with IR mr => OK mr | _ => Error(msg "Asmgen.ireg_of") end.
+
+Definition freg_of (r: mreg) : res freg :=
+  match preg_of r with FR mr => OK mr | _ => Error(msg "Asmgen.freg_of") end.
+
+(** Recognition of immediate arguments for logical integer operations.*)
+
+(** Valid immediate arguments are repetitions of a bit pattern [B]
+  of length [e] = 2, 4, 8, 16, 32 or 64.
+  The bit pattern [B] must be of the form [0*1*0*] or [1*0*1*]
+  but must not be all zeros or all ones. *)
+
+(** The following automaton recognizes [0*1*0*|1*0*1*].
+<<
+               0          1          0
+              / \        / \        / \
+              \ /        \ /        \ /
+        -0--> [B] --1--> [D] --0--> [F]
+       /
+     [A]
+       \
+        -1--> [C] --0--> [E] --1--> [G]
+              / \        / \        / \
+              \ /        \ /        \ /
+               1          0          1
+>>
+*)
+
+Module Automaton.
+
+Inductive state : Type := SA | SB | SC | SD | SE | SF | SG | Sbad.
+
+Definition start := SA.
+
+Definition next (s: state) (b: bool) :=
+  match s, b with
+    | SA,false => SB      | SA,true => SC
+    | SB,false => SB      | SB,true => SD
+    | SC,false => SE      | SC,true => SC
+    | SD,false => SF      | SD,true => SD
+    | SE,false => SE      | SE,true => SG
+    | SF,false => SF      | SF,true => Sbad
+    | SG,false => Sbad    | SG,true => SG
+    | Sbad,_ => Sbad
+  end.
+
+Definition accepting (s: state) :=
+  match s with
+  | SA | SB | SC | SD | SE | SF | SG => true
+  | Sbad => false
+  end.
+
+Fixpoint run (len: nat) (s: state) (x: Z) : bool :=
+  match len with
+  | Datatypes.O => accepting s
+  | Datatypes.S len => run len (next s (Z.odd x)) (Z.div2 x)
+  end.
+
+End Automaton.
+
+(** The following function determines the candidate length [e],
+    ensuring that [x] is a repetition [BB...B] 
+    of a bit pattern [B] of length [e]. *)
+
+Definition logical_imm_length (x: Z) (sixtyfour: bool) : nat :=
+  (** [test n] checks that the low [2n] bits of [x] are of the
+      form [BB], that is, two occurrences of the same [n] bits *)
+  let test (n: Z) : bool :=
+    Z.eqb (Zzero_ext n x) (Zzero_ext n (Z.shiftr x n)) in
+  (** If [test n] fails, we know that the candidate length [e] is
+      at least [2n].  Hence we test with decreasing values of [n]:
+      32, 16, 8, 4, 2. *)
+  if sixtyfour && negb (test 32) then 64%nat
+  else if negb (test 16) then 32%nat
+  else if negb (test 8) then 16%nat
+  else if negb (test 4) then 8%nat
+  else if negb (test 2) then 4%nat
+  else 2%nat.
+
+(** A valid logical immediate is 
+- neither [0] nor [-1];
+- composed of a repetition [BBBBB] of a bit-pattern [B] of length [e]
+- the low [e] bits of the number, that is, [B], match [0*1*0*] or [1*0*1*].
+*)
+
+Definition is_logical_imm32 (x: int) : bool :=
+  negb (Int.eq x Int.zero) && negb (Int.eq x Int.mone) &&
+  Automaton.run (logical_imm_length (Int.unsigned x) false)
+                Automaton.start (Int.unsigned x).
+
+Definition is_logical_imm64 (x: int64) : bool :=
+  negb (Int64.eq x Int64.zero) && negb (Int64.eq x Int64.mone) &&
+  Automaton.run (logical_imm_length (Int64.unsigned x) true)
+                Automaton.start (Int64.unsigned x).
+
+(** Arithmetic immediates are 12-bit unsigned numbers, possibly shifted left 12 bits *)
+
+Definition is_arith_imm32 (x: int) : bool :=
+  Int.eq x (Int.zero_ext 12 x)
+  || Int.eq x (Int.shl (Int.zero_ext 12 (Int.shru x (Int.repr 12))) (Int.repr 12)).
+
+Definition is_arith_imm64 (x: int64) : bool :=
+  Int64.eq x (Int64.zero_ext 12 x)
+  || Int64.eq x (Int64.shl (Int64.zero_ext 12 (Int64.shru x (Int64.repr 12))) (Int64.repr 12)).
+
+(** Decompose integer literals into 16-bit fragments *)
+
+Fixpoint decompose_int (N: nat) (n p: Z) {struct N} : list (Z * Z) :=
+  match N with
+  | Datatypes.O => nil
+  | Datatypes.S N =>
+    let frag := Zzero_ext 16 (Z.shiftr n p) in
+    if Z.eqb frag 0 then
+      decompose_int N n (p + 16)
+    else
+      (frag, p) :: decompose_int N (Z.ldiff n (Z.shiftl 65535 p)) (p + 16)
+  end.
+
+Definition negate_decomposition (l: list (Z * Z)) :=
+  List.map (fun np => (Z.lxor (fst np) 65535, snd np)) l.
+
+Definition loadimm_k (sz: isize) (rd: ireg) (l: list (Z * Z)) (k: code) : code :=
+  List.fold_right (fun np k => Pmovk sz rd (fst np) (snd np) :: k) k l.
+
+Definition loadimm_z (sz: isize) (rd: ireg) (l: list (Z * Z)) (k: code) : code :=
+  match l with
+  | nil => Pmovz sz rd 0 0 :: k
+  | (n1, p1) :: l => Pmovz sz rd n1 p1 :: loadimm_k sz rd l k
+  end.
+
+Definition loadimm_n (sz: isize) (rd: ireg) (l: list (Z * Z)) (k: code) : code :=
+  match l with
+  | nil => Pmovn sz rd 0 0 :: k
+  | (n1, p1) :: l => Pmovn sz rd n1 p1 :: loadimm_k sz rd (negate_decomposition l) k
+  end.
+
+Definition loadimm (sz: isize) (rd: ireg) (n: Z) (k: code) : code :=
+  let N := match sz with W => 2%nat | X => 4%nat end in
+  let dz := decompose_int N n 0 in
+  let dn := decompose_int N (Z.lnot n) 0 in
+  if Nat.leb (List.length dz) (List.length dn)
+  then loadimm_z sz rd dz k
+  else loadimm_n sz rd dn k.
+
+Definition loadimm32 (rd: ireg) (n: int) (k: code) : code :=
+  if is_logical_imm32 n
+  then Porrimm W rd XZR (Int.unsigned n) :: k
+  else loadimm W rd (Int.unsigned n) k.
+
+Definition loadimm64 (rd: ireg) (n: int64) (k: code) : code :=
+  if is_logical_imm64 n
+  then Porrimm X rd XZR (Int64.unsigned n) :: k
+  else loadimm X rd (Int64.unsigned n) k.
+
+(** Add immediate *)
+
+Definition addimm_aux (insn: iregsp -> iregsp -> Z -> instruction)
+                        (rd r1: iregsp) (n: Z) (k: code) :=
+  let nlo := Zzero_ext 12 n in
+  let nhi := n - nlo in
+  if Z.eqb nhi 0 then
+    insn rd r1 nlo :: k
+  else if Z.eqb nlo 0 then
+    insn rd r1 nhi :: k
+  else
+    insn rd r1 nhi :: insn rd rd nlo :: k.
+
+Definition addimm32 (rd r1: ireg) (n: int) (k: code) : code :=
+  let m := Int.neg n in
+  if Int.eq n (Int.zero_ext 24 n) then
+    addimm_aux (Paddimm W) rd r1 (Int.unsigned n) k
+  else if Int.eq m (Int.zero_ext 24 m) then
+    addimm_aux (Psubimm W) rd r1 (Int.unsigned m) k
+  else if Int.lt n Int.zero then
+    loadimm32 X16 m (Psub W rd r1 X16 SOnone :: k)
+  else
+    loadimm32 X16 n (Padd W rd r1 X16 SOnone :: k).
+
+Definition addimm64 (rd r1: iregsp) (n: int64) (k: code) : code :=
+  let m := Int64.neg n in
+  if Int64.eq n (Int64.zero_ext 24 n) then
+    addimm_aux (Paddimm X) rd r1 (Int64.unsigned n) k
+  else if Int64.eq m (Int64.zero_ext 24 m) then
+    addimm_aux (Psubimm X) rd r1 (Int64.unsigned m) k
+  else if Int64.lt n Int64.zero then
+    loadimm64 X16 m (Psubext rd r1 X16 (EOuxtx Int.zero) :: k)
+  else
+    loadimm64 X16 n (Paddext rd r1 X16 (EOuxtx Int.zero) :: k).
+
+(** Logical immediate *)
+
+Definition logicalimm32
+              (insn1: ireg -> ireg0 -> Z -> instruction)
+              (insn2: ireg -> ireg0 -> ireg -> shift_op -> instruction)
+              (rd r1: ireg) (n: int) (k: code) : code :=
+  if is_logical_imm32 n
+  then insn1 rd r1 (Int.unsigned n) :: k
+  else loadimm32 X16 n (insn2 rd r1 X16 SOnone :: k).
+
+Definition logicalimm64
+              (insn1: ireg -> ireg0 -> Z -> instruction)
+              (insn2: ireg -> ireg0 -> ireg -> shift_op -> instruction)
+              (rd r1: ireg) (n: int64) (k: code) : code :=
+  if is_logical_imm64 n
+  then insn1 rd r1 (Int64.unsigned n) :: k
+  else loadimm64 X16 n (insn2 rd r1 X16 SOnone :: k).
+
+(** Sign- or zero-extended arithmetic *)
+
+Definition transl_extension (ex: extension) (a: int) : extend_op :=
+  match ex with Xsgn32 => EOsxtw a | Xuns32 => EOuxtw a end.
+
+Definition move_extended_base
+              (rd: ireg) (r1: ireg) (ex: extension) (k: code) : code :=
+  match ex with
+  | Xsgn32 => Pcvtsw2x rd r1 :: k
+  | Xuns32 => Pcvtuw2x rd r1 :: k
+  end.
+
+Definition move_extended
+              (rd: ireg) (r1: ireg) (ex: extension) (a: int) (k: code) : code :=
+  if Int.eq a Int.zero then
+    move_extended_base rd r1 ex k
+  else
+    move_extended_base rd r1 ex (Padd X rd XZR rd (SOlsl a) :: k).
+
+Definition arith_extended 
+              (insnX: iregsp -> iregsp -> ireg -> extend_op -> instruction)
+              (insnS: ireg -> ireg0 -> ireg -> shift_op -> instruction)
+              (rd r1 r2: ireg) (ex: extension) (a: int) (k: code) : code :=
+  if Int.ltu a (Int.repr 5) then
+    insnX rd r1 r2 (transl_extension ex a) :: k
+  else
+    move_extended_base X16 r2 ex (insnS rd r1 X16 (SOlsl a) :: k).
+
+(** Extended right shift *)
+
+Definition shrx32 (rd r1: ireg) (n: int) (k: code) : code :=
+  if Int.eq n Int.zero then
+    Pmov rd r1 :: k
+  else
+    Porr W X16 XZR r1 (SOasr (Int.repr 31)) ::
+    Padd W X16 r1 X16 (SOlsr (Int.sub Int.iwordsize n)) ::
+    Porr W rd XZR X16 (SOasr n) :: k.
+
+Definition shrx64 (rd r1: ireg) (n: int) (k: code) : code :=
+  if Int.eq n Int.zero then
+    Pmov rd r1 :: k
+  else
+    Porr X X16 XZR r1 (SOasr (Int.repr 63)) ::
+    Padd X X16 r1 X16 (SOlsr (Int.sub Int64.iwordsize' n)) ::
+    Porr X rd XZR X16 (SOasr n) :: k.
+
+(** Load the address [id + ofs] in [rd] *)
+
+Definition loadsymbol (rd: ireg) (id: ident) (ofs: ptrofs) (k: code) : code :=
+  if Archi.pic_code tt then
+    if Ptrofs.eq ofs Ptrofs.zero then
+      Ploadsymbol rd id :: k
+    else
+      Ploadsymbol rd id :: addimm64 rd rd (Ptrofs.to_int64 ofs) k
+  else
+    Padrp rd id ofs :: Paddadr rd rd id ofs :: k.
+
+(** Translate a shifted operand *)
+
+Definition transl_shift (s: Op.shift) (a: int): Asm.shift_op :=
+  match s with
+  | Slsl => SOlsl a
+  | Slsr => SOlsr a
+  | Sasr => SOasr a
+  | Sror => SOror a
+  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 | Ccompu c), a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pcmp W r1 r2 SOnone :: k)
+  | (Ccompshift c s a | Ccompushift c s a), a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pcmp W r1 r2 (transl_shift s a) :: k)
+  | (Ccompimm c n | Ccompuimm c n), a1 :: nil =>
+      do r1 <- ireg_of a1;
+      OK (if is_arith_imm32 n then
+            Pcmpimm W r1 (Int.unsigned n) :: k
+          else if is_arith_imm32 (Int.neg n) then
+            Pcmnimm W r1 (Int.unsigned (Int.neg n)) :: k
+          else
+            loadimm32 X16 n (Pcmp W r1 X16 SOnone :: k))
+  | (Cmaskzero n | Cmasknotzero n), a1 :: nil =>
+      do r1 <- ireg_of a1;
+      OK (if is_logical_imm32 n then
+            Ptstimm W r1 (Int.unsigned n) :: k
+          else
+            loadimm32 X16 n (Ptst W r1 X16 SOnone :: k))
+  | (Ccompl c | Ccomplu c), a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pcmp X r1 r2 SOnone :: k)
+  | (Ccomplshift c s a | Ccomplushift c s a), a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pcmp X r1 r2 (transl_shift s a) :: k)
+  | (Ccomplimm c n | Ccompluimm c n), a1 :: nil =>
+      do r1 <- ireg_of a1;
+      OK (if is_arith_imm64 n then
+            Pcmpimm X r1 (Int64.unsigned n) :: k
+          else if is_arith_imm64 (Int64.neg n) then
+            Pcmnimm X r1 (Int64.unsigned (Int64.neg n)) :: k
+          else
+            loadimm64 X16 n (Pcmp X r1 X16 SOnone :: k))
+  | (Cmasklzero n | Cmasklnotzero n), a1 :: nil =>
+      do r1 <- ireg_of a1;
+      OK (if is_logical_imm64 n then
+            Ptstimm X r1 (Int64.unsigned n) :: k
+          else
+            loadimm64 X16 n (Ptst X r1 X16 SOnone :: k))
+  | Ccompf cmp, a1 :: a2 :: nil =>
+      do r1 <- freg_of a1; do r2 <- freg_of a2;
+      OK (Pfcmp D r1 r2 :: k)
+  | Cnotcompf cmp, a1 :: a2 :: nil =>
+      do r1 <- freg_of a1; do r2 <- freg_of a2;
+      OK (Pfcmp D r1 r2 :: k)
+  | Ccompfzero cmp, a1 :: nil =>
+      do r1 <- freg_of a1;
+      OK (Pfcmp0 D r1 :: k)
+  | Cnotcompfzero cmp, a1 :: nil =>
+      do r1 <- freg_of a1;
+      OK (Pfcmp0 D r1 :: k)
+  | Ccompfs cmp, a1 :: a2 :: nil =>
+      do r1 <- freg_of a1; do r2 <- freg_of a2;
+      OK (Pfcmp S r1 r2 :: k)
+  | Cnotcompfs cmp, a1 :: a2 :: nil =>
+      do r1 <- freg_of a1; do r2 <- freg_of a2;
+      OK (Pfcmp S r1 r2 :: k)
+  | Ccompfszero cmp, a1 :: nil =>
+      do r1 <- freg_of a1;
+      OK (Pfcmp0 S r1 :: k)
+  | Cnotcompfszero cmp, a1 :: nil =>
+      do r1 <- freg_of a1;
+      OK (Pfcmp0 S r1 :: k)
+  | _, _ =>
+      Error(msg "Asmgen.transl_cond")
+  end.
+
+Definition cond_for_signed_cmp (cmp: comparison) :=
+  match cmp with
+  | Ceq => TCeq
+  | Cne => TCne
+  | Clt => TClt
+  | Cle => TCle
+  | Cgt => TCgt
+  | Cge => TCge
+  end.
+
+Definition cond_for_unsigned_cmp (cmp: comparison) :=
+  match cmp with
+  | Ceq => TCeq
+  | Cne => TCne
+  | Clt => TClo
+  | Cle => TCls
+  | Cgt => TChi
+  | Cge => TChs
+  end.
+
+Definition cond_for_float_cmp (cmp: comparison) :=
+  match cmp with
+  | Ceq => TCeq
+  | Cne => TCne
+  | Clt => TCmi
+  | Cle => TCls
+  | Cgt => TCgt
+  | Cge => TCge
+  end.
+
+Definition cond_for_float_not_cmp (cmp: comparison) :=
+  match cmp with
+  | Ceq => TCne
+  | Cne => TCeq
+  | Clt => TCpl
+  | Cle => TChi
+  | Cgt => TCle
+  | Cge => TClt
+  end.
+
+Definition cond_for_cond (cond: condition) :=
+  match cond with
+  | Ccomp cmp => cond_for_signed_cmp cmp
+  | Ccompu cmp => cond_for_unsigned_cmp cmp
+  | Ccompshift cmp s a => cond_for_signed_cmp cmp
+  | Ccompushift cmp s a => cond_for_unsigned_cmp cmp
+  | Ccompimm cmp n => cond_for_signed_cmp cmp
+  | Ccompuimm cmp n => cond_for_unsigned_cmp cmp
+  | Cmaskzero n => TCeq
+  | Cmasknotzero n => TCne
+  | Ccompl cmp => cond_for_signed_cmp cmp
+  | Ccomplu cmp => cond_for_unsigned_cmp cmp
+  | Ccomplshift cmp s a => cond_for_signed_cmp cmp
+  | Ccomplushift cmp s a => cond_for_unsigned_cmp cmp
+  | Ccomplimm cmp n => cond_for_signed_cmp cmp
+  | Ccompluimm cmp n => cond_for_unsigned_cmp cmp
+  | Cmasklzero n => TCeq
+  | Cmasklnotzero n => TCne
+  | Ccompf cmp => cond_for_float_cmp cmp
+  | Cnotcompf cmp => cond_for_float_not_cmp cmp
+  | Ccompfzero cmp => cond_for_float_cmp cmp
+  | Cnotcompfzero cmp => cond_for_float_not_cmp cmp
+  | Ccompfs cmp => cond_for_float_cmp cmp
+  | Cnotcompfs cmp => cond_for_float_not_cmp cmp
+  | Ccompfszero cmp => cond_for_float_cmp cmp
+  | Cnotcompfszero cmp => cond_for_float_not_cmp cmp
+  end.
+
+(** Translation of a conditional branch.  Prepends to [k] the instructions
+  that evaluate the condition and ranch to [lbl] if it holds.
+  We recognize some conditional branches that can be implemented
+  without setting then testing condition flags.  *)
+
+Definition transl_cond_branch_default
+              (c: condition) (args: list mreg) (lbl: label) (k: code) :=
+  transl_cond c args (Pbc (cond_for_cond c) lbl :: k).
+ 
+Definition transl_cond_branch
+              (c: condition) (args: list mreg) (lbl: label) (k: code) :=
+  match args, c with
+  | a1 :: nil, (Ccompimm Cne n | Ccompuimm Cne n) =>
+      if Int.eq n Int.zero
+      then (do r1 <- ireg_of a1; OK (Pcbnz W r1 lbl :: k))
+      else transl_cond_branch_default c args lbl k
+  | a1 :: nil, (Ccompimm Ceq n | Ccompuimm Ceq n) =>
+      if Int.eq n Int.zero
+      then (do r1 <- ireg_of a1; OK (Pcbz W r1 lbl :: k))
+      else transl_cond_branch_default c args lbl k
+  | a1 :: nil, (Ccomplimm Cne n | Ccompluimm Cne n) =>
+      if Int64.eq n Int64.zero
+      then (do r1 <- ireg_of a1; OK (Pcbnz X r1 lbl :: k))
+      else transl_cond_branch_default c args lbl k
+  | a1 :: nil, (Ccomplimm Ceq n | Ccompluimm Ceq n) =>
+      if Int64.eq n Int64.zero
+      then (do r1 <- ireg_of a1; OK (Pcbz X r1 lbl :: k))
+      else transl_cond_branch_default c args lbl k
+  | a1 :: nil, Cmaskzero n =>
+      match Int.is_power2 n with
+      | Some bit => do r1 <- ireg_of a1; OK (Ptbz W r1 bit lbl :: k)
+      | None => transl_cond_branch_default c args lbl k
+      end
+  | a1 :: nil, Cmasknotzero n =>
+      match Int.is_power2 n with
+      | Some bit => do r1 <- ireg_of a1; OK (Ptbnz W r1 bit lbl :: k)
+      | None => transl_cond_branch_default c args lbl k
+      end
+  | a1 :: nil, Cmasklzero n =>
+      match Int64.is_power2' n with
+      | Some bit => do r1 <- ireg_of a1; OK (Ptbz X r1 bit lbl :: k)
+      | None => transl_cond_branch_default c args lbl k
+      end
+  | a1 :: nil, Cmasklnotzero n =>
+      match Int64.is_power2' n with
+      | Some bit => do r1 <- ireg_of a1; OK (Ptbnz X r1 bit lbl :: k)
+      | None => transl_cond_branch_default c args lbl k
+      end
+  | _, _ =>
+      transl_cond_branch_default c args lbl k
+  end.
+  
+(** Translation of the arithmetic operation [res <- op(args)].
+    The corresponding instructions are prepended to [k]. *)
+
+Definition transl_op
+              (op: operation) (args: list mreg) (res: mreg) (k: code) :=
+  match op, args with
+  | Omove, a1 :: nil =>
+      match preg_of res, preg_of a1 with
+      | IR r, IR a => OK (Pmov r a :: k)
+      | FR r, FR a => OK (Pfmov r a :: k)
+      |  _  ,  _   => Error(msg "Asmgen.Omove")
+      end
+  | Ointconst n, nil =>
+      do rd <- ireg_of res;
+      OK (loadimm32 rd n k)
+  | Olongconst n, nil =>
+      do rd <- ireg_of res;
+      OK (loadimm64 rd n k)
+  | Ofloatconst f, nil =>
+      do rd <- freg_of res;
+      OK (if Float.eq_dec f Float.zero
+          then Pfmovi D rd XZR :: k
+          else Pfmovimmd rd f :: k)
+  | Osingleconst f, nil =>
+      do rd <- freg_of res;
+      OK (if Float32.eq_dec f Float32.zero
+          then Pfmovi S rd XZR :: k
+          else Pfmovimms rd f :: k)
+  | Oaddrsymbol id ofs, nil =>
+      do rd <- ireg_of res;
+      OK (loadsymbol rd id ofs k)
+  | Oaddrstack ofs, nil =>
+      do rd <- ireg_of res;
+      OK (addimm64 rd XSP (Ptrofs.to_int64 ofs) k)
+(** 32-bit integer arithmetic *)
+  | Oshift s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Porr W rd XZR r1 (transl_shift s a) :: k)
+  | Oadd, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Padd W rd r1 r2 SOnone :: k)
+  | Oaddshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Padd W rd r1 r2 (transl_shift s a) :: k)
+  | Oaddimm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (addimm32 rd r1 n k)
+  | Oneg, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psub W rd XZR r1 SOnone :: k)
+  | Onegshift s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psub W rd XZR r1 (transl_shift s a) :: k)
+  | Osub, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Psub W rd r1 r2 SOnone :: k)
+  | Osubshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Psub W rd r1 r2 (transl_shift s a) :: k)
+  | Omul, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pmadd W rd r1 r2 XZR :: k)
+  | Omuladd, a1 :: a2 :: a3 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2; do r3 <- ireg_of a3;
+      OK (Pmadd W rd r2 r3 r1 :: k)
+  | Omulsub, a1 :: a2 :: a3 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2; do r3 <- ireg_of a3;
+      OK (Pmsub W rd r2 r3 r1 :: k)
+  | Odiv, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Psdiv W rd r1 r2 :: k)
+  | Odivu, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pudiv W rd r1 r2 :: k)
+  | Oand, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pand W rd r1 r2 SOnone :: k)
+  | Oandshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pand W rd r1 r2 (transl_shift s a) :: k)
+  | Oandimm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (logicalimm32 (Pandimm W) (Pand W) rd r1 n k)      
+  | Oor, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Porr W rd r1 r2 SOnone :: k)
+  | Oorshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Porr W rd r1 r2 (transl_shift s a) :: k)
+  | Oorimm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (logicalimm32 (Porrimm W) (Porr W) rd r1 n k)      
+  | Oxor, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Peor W rd r1 r2 SOnone :: k)
+  | Oxorshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Peor W rd r1 r2 (transl_shift s a) :: k)
+  | Oxorimm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (logicalimm32 (Peorimm W) (Peor W) rd r1 n k)      
+  | Onot, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Porn W rd XZR r1 SOnone :: k)
+  | Onotshift s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Porn W rd XZR r1 (transl_shift s a) :: k)
+  | Obic, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pbic W rd r1 r2 SOnone :: k)
+  | Obicshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pbic W rd r1 r2 (transl_shift s a) :: k)
+  | Oorn, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Porn W rd r1 r2 SOnone :: k)
+  | Oornshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Porn W rd r1 r2 (transl_shift s a) :: k)
+  | Oeqv, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Peon W rd r1 r2 SOnone :: k)
+  | Oeqvshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Peon W rd r1 r2 (transl_shift s a) :: k)
+  | Oshl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Plslv W rd r1 r2 :: k)
+  | Oshr, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pasrv W rd r1 r2 :: k)
+  | Oshru, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Plsrv W rd r1 r2 :: k)
+  | Oshrximm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (shrx32 rd r1 n k)
+  | Ozext s, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Pubfiz W rd r1 Int.zero s :: k)
+  | Osext s, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psbfiz W rd r1 Int.zero s :: k)
+  | Oshlzext s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Pubfiz W rd r1 a (Z.min s (Int.zwordsize - Int.unsigned a)) :: k)
+  | Oshlsext s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psbfiz W rd r1 a (Z.min s (Int.zwordsize - Int.unsigned a)) :: k)
+  | Ozextshr a s, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Pubfx W rd r1 a (Z.min s (Int.zwordsize - Int.unsigned a)) :: k)
+  | Osextshr a s, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psbfx W rd r1 a (Z.min s (Int.zwordsize - Int.unsigned a)) :: k)
+(** 64-bit integer arithmetic *)
+  | Oshiftl s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Porr X rd XZR r1 (transl_shift s a) :: k)
+  | Oextend x a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (move_extended rd r1 x a k)
+  (* [Omakelong] and [Ohighlong] should not occur *)
+  | Olowlong, a1 :: nil => 
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      assertion (ireg_eq rd r1);
+      OK (Pcvtx2w rd :: k)
+  | Oaddl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Padd X rd r1 r2 SOnone :: k)
+  | Oaddlshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Padd X rd r1 r2 (transl_shift s a) :: k)
+  | Oaddlext x a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (arith_extended Paddext (Padd X) rd r1 r2 x a k)
+  | Oaddlimm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (addimm64 rd r1 n k)
+  | Onegl, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psub X rd XZR r1 SOnone :: k)
+  | Oneglshift s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psub X rd XZR r1 (transl_shift s a) :: k)
+  | Osubl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Psub X rd r1 r2 SOnone :: k)
+  | Osublshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Psub X rd r1 r2 (transl_shift s a) :: k)
+  | Osublext x a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (arith_extended Psubext (Psub X) rd r1 r2 x a k)
+  | Omull, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pmadd X rd r1 r2 XZR :: k)
+  | Omulladd, a1 :: a2 :: a3 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2; do r3 <- ireg_of a3;
+      OK (Pmadd X rd r2 r3 r1 :: k)
+  | Omullsub, a1 :: a2 :: a3 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2; do r3 <- ireg_of a3;
+      OK (Pmsub X rd r2 r3 r1 :: k)
+  | Omullhs, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Psmulh rd r1 r2 :: k)
+  | Omullhu, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pumulh rd r1 r2 :: k)
+  | Odivl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Psdiv X rd r1 r2 :: k)
+  | Odivlu, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pudiv X rd r1 r2 :: k)
+  | Oandl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pand X rd r1 r2 SOnone :: k)
+  | Oandlshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pand X rd r1 r2 (transl_shift s a) :: k)
+  | Oandlimm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (logicalimm64 (Pandimm X) (Pand X) rd r1 n k)      
+  | Oorl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Porr X rd r1 r2 SOnone :: k)
+  | Oorlshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Porr X rd r1 r2 (transl_shift s a) :: k)
+  | Oorlimm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (logicalimm64 (Porrimm X) (Porr X) rd r1 n k)      
+  | Oxorl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Peor X rd r1 r2 SOnone :: k)
+  | Oxorlshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Peor X rd r1 r2 (transl_shift s a) :: k)
+  | Oxorlimm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (logicalimm64 (Peorimm X) (Peor X) rd r1 n k)      
+  | Onotl, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Porn X rd XZR r1 SOnone :: k)
+  | Onotlshift s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Porn X rd XZR r1 (transl_shift s a) :: k)
+  | Obicl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pbic X rd r1 r2 SOnone :: k)
+  | Obiclshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pbic X rd r1 r2 (transl_shift s a) :: k)
+  | Oornl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Porn X rd r1 r2 SOnone :: k)
+  | Oornlshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Porn X rd r1 r2 (transl_shift s a) :: k)
+  | Oeqvl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Peon X rd r1 r2 SOnone :: k)
+  | Oeqvlshift s a, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Peon X rd r1 r2 (transl_shift s a) :: k)
+  | Oshll, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Plslv X rd r1 r2 :: k)
+  | Oshrl, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Pasrv X rd r1 r2 :: k)
+  | Oshrlu, a1 :: a2 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (Plsrv X rd r1 r2 :: k)
+  | Oshrlximm n, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (shrx64 rd r1 n k)
+  | Ozextl s, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Pubfiz X rd r1 Int.zero s :: k)
+  | Osextl s, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psbfiz X rd r1 Int.zero s :: k)
+  | Oshllzext s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Pubfiz X rd r1 a (Z.min s (Int64.zwordsize - Int.unsigned a)) :: k)
+  | Oshllsext s a, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psbfiz X rd r1 a (Z.min s (Int64.zwordsize - Int.unsigned a)) :: k)
+  | Ozextshrl a s, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Pubfx X rd r1 a (Z.min s (Int64.zwordsize - Int.unsigned a)) :: k)
+  | Osextshrl a s, a1 :: nil =>
+      do rd <- ireg_of res; do r1 <- ireg_of a1;
+      OK (Psbfx X rd r1 a (Z.min s (Int64.zwordsize - Int.unsigned a)) :: k)
+(** 64-bit floating-point arithmetic *)
+  | Onegf, a1 :: nil =>
+      do rd <- freg_of res; do rs <- freg_of a1;
+      OK (Pfneg D rd rs :: k)
+  | Oabsf, a1 :: nil =>
+      do rd <- freg_of res; do rs <- freg_of a1;
+      OK (Pfabs D rd rs :: k)
+  | Oaddf, a1 :: a2 :: nil =>
+      do rd <- freg_of res; do rs1 <- freg_of a1; do rs2 <- freg_of a2;
+      OK (Pfadd D rd rs1 rs2 :: k)
+  | Osubf, a1 :: a2 :: nil =>
+      do rd <- freg_of res; do rs1 <- freg_of a1; do rs2 <- freg_of a2;
+      OK (Pfsub D rd rs1 rs2 :: k)
+  | Omulf, a1 :: a2 :: nil =>
+      do rd <- freg_of res; do rs1 <- freg_of a1; do rs2 <- freg_of a2;
+      OK (Pfmul D rd rs1 rs2 :: k)
+  | Odivf, a1 :: a2 :: nil =>
+      do rd <- freg_of res; do rs1 <- freg_of a1; do rs2 <- freg_of a2;
+      OK (Pfdiv D rd rs1 rs2 :: k)
+(** 32-bit floating-point arithmetic *)
+  | Onegfs, a1 :: nil =>
+      do rd <- freg_of res; do rs <- freg_of a1;
+      OK (Pfneg S rd rs :: k)
+  | Oabsfs, a1 :: nil =>
+      do rd <- freg_of res; do rs <- freg_of a1;
+      OK (Pfabs S rd rs :: k)
+  | Oaddfs, a1 :: a2 :: nil =>
+      do rd <- freg_of res; do rs1 <- freg_of a1; do rs2 <- freg_of a2;
+      OK (Pfadd S rd rs1 rs2 :: k)
+  | Osubfs, a1 :: a2 :: nil =>
+      do rd <- freg_of res; do rs1 <- freg_of a1; do rs2 <- freg_of a2;
+      OK (Pfsub S rd rs1 rs2 :: k)
+  | Omulfs, a1 :: a2 :: nil =>
+      do rd <- freg_of res; do rs1 <- freg_of a1; do rs2 <- freg_of a2;
+      OK (Pfmul S rd rs1 rs2 :: k)
+  | Odivfs, a1 :: a2 :: nil =>
+      do rd <- freg_of res; do rs1 <- freg_of a1; do rs2 <- freg_of a2;
+      OK (Pfdiv S rd rs1 rs2 :: k)
+  | Osingleoffloat, a1 :: nil =>
+      do rd <- freg_of res; do rs <- freg_of a1;
+      OK (Pfcvtsd rd rs :: k)
+  | Ofloatofsingle, a1 :: nil =>
+      do rd <- freg_of res; do rs <- freg_of a1;
+      OK (Pfcvtds rd rs :: k)
+(** Conversions between int and float *)
+  | Ointoffloat, a1 :: nil =>
+      do rd <- ireg_of res; do rs <- freg_of a1;
+      OK (Pfcvtzs W D rd rs :: k)
+  | Ointuoffloat, a1 :: nil =>
+      do rd <- ireg_of res; do rs <- freg_of a1;
+      OK (Pfcvtzu W D rd rs :: k)
+  | Ofloatofint, a1 :: nil =>
+      do rd <- freg_of res; do rs <- ireg_of a1;
+      OK (Pscvtf D W rd rs :: k)
+  | Ofloatofintu, a1 :: nil =>
+      do rd <- freg_of res; do rs <- ireg_of a1;
+      OK (Pucvtf D W rd rs :: k)
+  | Ointofsingle, a1 :: nil =>
+      do rd <- ireg_of res; do rs <- freg_of a1;
+      OK (Pfcvtzs W S rd rs :: k)
+  | Ointuofsingle, a1 :: nil =>
+      do rd <- ireg_of res; do rs <- freg_of a1;
+      OK (Pfcvtzu W S rd rs :: k)
+  | Osingleofint, a1 :: nil =>
+      do rd <- freg_of res; do rs <- ireg_of a1;
+      OK (Pscvtf S W rd rs :: k)
+  | Osingleofintu, a1 :: nil =>
+      do rd <- freg_of res; do rs <- ireg_of a1;
+      OK (Pucvtf S W rd rs :: k)
+  | Olongoffloat, a1 :: nil =>
+      do rd <- ireg_of res; do rs <- freg_of a1;
+      OK (Pfcvtzs X D rd rs :: k)
+  | Olonguoffloat, a1 :: nil =>
+      do rd <- ireg_of res; do rs <- freg_of a1;
+      OK (Pfcvtzu X D rd rs :: k)
+  | Ofloatoflong, a1 :: nil =>
+      do rd <- freg_of res; do rs <- ireg_of a1;
+      OK (Pscvtf D X rd rs :: k)
+  | Ofloatoflongu, a1 :: nil =>
+      do rd <- freg_of res; do rs <- ireg_of a1;
+      OK (Pucvtf D X rd rs :: k)
+  | Olongofsingle, a1 :: nil =>
+      do rd <- ireg_of res; do rs <- freg_of a1;
+      OK (Pfcvtzs X S rd rs :: k)
+  | Olonguofsingle, a1 :: nil =>
+      do rd <- ireg_of res; do rs <- freg_of a1;
+      OK (Pfcvtzu X S rd rs :: k)
+  | Osingleoflong, a1 :: nil =>
+      do rd <- freg_of res; do rs <- ireg_of a1;
+      OK (Pscvtf S X rd rs :: k)
+  | Osingleoflongu, a1 :: nil =>
+      do rd <- freg_of res; do rs <- ireg_of a1;
+      OK (Pucvtf S X rd rs :: k)
+(** Boolean tests *)
+  | Ocmp c, _ =>
+      do rd <- ireg_of res;
+      transl_cond c args (Pcset rd (cond_for_cond c) :: k)
+(** Conditional move *)
+  | Osel cmp ty, a1 :: a2 :: args =>
+      match preg_of res with
+      | IR r => 
+          do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+          transl_cond cmp args (Pcsel r r1 r2 (cond_for_cond cmp) :: k)
+      | FR r =>
+          do r1 <- freg_of a1; do r2 <- freg_of a2;
+          transl_cond cmp args (Pfsel r r1 r2 (cond_for_cond cmp) :: k)
+      | _ =>
+          Error(msg "Asmgen.Osel")
+      end
+  | _, _ =>
+      Error(msg "Asmgen.transl_op")
+  end.
+
+(** Translation of addressing modes *)
+
+Definition offset_representable (sz: Z) (ofs: int64) : bool :=
+  let isz := Int64.repr sz in
+  (** either unscaled 9-bit signed *)
+  Int64.eq ofs (Int64.sign_ext 9 ofs) ||
+  (** or scaled 12-bit unsigned *)
+  (Int64.eq (Int64.modu ofs isz) Int64.zero
+   && Int64.ltu ofs (Int64.shl isz (Int64.repr 12))).
+ 
+Definition transl_addressing (sz: Z) (addr: Op.addressing) (args: list mreg)
+                             (insn: Asm.addressing -> instruction) (k: code) : res code :=
+  match addr, args with
+  | Aindexed ofs, a1 :: nil =>
+      do r1 <- ireg_of a1;
+       if offset_representable sz ofs then
+        OK (insn (ADimm r1 ofs) :: k)
+      else
+        OK (loadimm64 X16 ofs (insn (ADreg r1 X16) :: k))
+  | Aindexed2, a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      OK (insn (ADreg r1 r2) :: k)
+  | Aindexed2shift a, a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      if Int.eq a Int.zero then
+        OK (insn (ADreg r1 r2) :: k)
+      else if Int.eq (Int.shl Int.one a) (Int.repr sz) then
+        OK (insn (ADlsl r1 r2 a) :: k)
+      else
+        OK (Padd X X16 r1 r2 (SOlsl a) :: insn (ADimm X16 Int64.zero) :: k)
+  | Aindexed2ext x a, a1 :: a2 :: nil =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+      if Int.eq a Int.zero || Int.eq (Int.shl Int.one a) (Int.repr sz) then
+        OK (insn (match x with Xsgn32 => ADsxt r1 r2 a
+                             | Xuns32 => ADuxt r1 r2 a end) :: k)
+      else
+        OK (arith_extended Paddext (Padd X) X16 r1 r2 x a
+                           (insn (ADimm X16 Int64.zero) :: k))
+  | Aglobal id ofs, nil =>
+      assertion (negb (Archi.pic_code tt));
+      if Ptrofs.eq (Ptrofs.modu ofs (Ptrofs.repr sz)) Ptrofs.zero && symbol_is_aligned id sz
+      then OK (Padrp X16 id ofs :: insn (ADadr X16 id ofs) :: k)
+      else OK (loadsymbol X16 id ofs (insn (ADimm X16 Int64.zero) :: k))
+  | Ainstack ofs, nil =>
+      let ofs := Ptrofs.to_int64 ofs in
+      if offset_representable sz ofs then
+        OK (insn (ADimm XSP ofs) :: k)
+      else
+        OK (loadimm64 X16 ofs (insn (ADreg XSP X16) :: k))
+  | _, _ =>
+      Error(msg "Asmgen.transl_addressing")
+  end.
+
+(** Translation of loads and stores *)
+
+Definition transl_load (chunk: memory_chunk) (addr: Op.addressing)
+                       (args: list mreg) (dst: mreg) (k: code) : res code :=
+  match chunk with
+  | Mint8unsigned =>
+      do rd <- ireg_of dst; transl_addressing 1 addr args (Pldrb W rd) k
+  | Mint8signed =>
+      do rd <- ireg_of dst; transl_addressing 1 addr args (Pldrsb W rd) k
+  | Mint16unsigned =>
+      do rd <- ireg_of dst; transl_addressing 2 addr args (Pldrh W rd) k
+  | Mint16signed =>
+      do rd <- ireg_of dst; transl_addressing 2 addr args (Pldrsh W rd) k
+  | Mint32 =>
+      do rd <- ireg_of dst; transl_addressing 4 addr args (Pldrw rd) k
+  | Mint64 =>
+      do rd <- ireg_of dst; transl_addressing 8 addr args (Pldrx rd) k
+  | Mfloat32 =>
+      do rd <- freg_of dst; transl_addressing 4 addr args (Pldrs rd) k
+  | Mfloat64 =>
+      do rd <- freg_of dst; transl_addressing 8 addr args (Pldrd rd) k
+  | Many32 =>
+      do rd <- ireg_of dst; transl_addressing 4 addr args (Pldrw_a rd) k
+  | Many64 =>
+      do rd <- ireg_of dst; transl_addressing 8 addr args (Pldrx_a rd) k
+  end.
+
+Definition transl_store (chunk: memory_chunk) (addr: Op.addressing)
+                        (args: list mreg) (src: mreg) (k: code) : res code :=
+  match chunk with
+  | Mint8unsigned | Mint8signed =>
+      do r1 <- ireg_of src; transl_addressing 1 addr args (Pstrb r1) k
+  | Mint16unsigned | Mint16signed =>
+      do r1 <- ireg_of src; transl_addressing 2 addr args (Pstrh r1) k
+  | Mint32 =>
+      do r1 <- ireg_of src; transl_addressing 4 addr args (Pstrw r1) k
+  | Mint64 =>
+      do r1 <- ireg_of src; transl_addressing 8 addr args (Pstrx r1) k
+  | Mfloat32 =>
+      do r1 <- freg_of src; transl_addressing 4 addr args (Pstrs r1) k
+  | Mfloat64 =>
+      do r1 <- freg_of src; transl_addressing 8 addr args (Pstrd r1) k
+  | Many32 =>
+      do r1 <- ireg_of src; transl_addressing 4 addr args (Pstrw_a r1) k
+  | Many64 =>
+      do r1 <- ireg_of src; transl_addressing 8 addr args (Pstrx_a r1) k
+  end.
+
+(** Register-indexed loads and stores *)
+
+Definition indexed_memory_access (insn: Asm.addressing -> instruction)
+                                 (sz: Z) (base: iregsp) (ofs: ptrofs) (k: code) :=
+  let ofs := Ptrofs.to_int64 ofs in
+  if offset_representable sz ofs
+  then insn (ADimm base ofs) :: k
+  else loadimm64 X16 ofs (insn (ADreg base X16) :: k).
+
+Definition loadind (base: iregsp) (ofs: ptrofs) (ty: typ) (dst: mreg) (k: code) :=
+  match ty, preg_of dst with
+  | Tint,    IR rd => OK (indexed_memory_access (Pldrw rd) 4 base ofs k)
+  | Tlong,   IR rd => OK (indexed_memory_access (Pldrx rd) 8 base ofs k)
+  | Tsingle, FR rd => OK (indexed_memory_access (Pldrs rd) 4 base ofs k)
+  | Tfloat,  FR rd => OK (indexed_memory_access (Pldrd rd) 8 base ofs k)
+  | Tany32,  IR rd => OK (indexed_memory_access (Pldrw_a rd) 4 base ofs k)
+  | Tany64,  IR rd => OK (indexed_memory_access (Pldrx_a rd) 8 base ofs k)
+  | Tany64,  FR rd => OK (indexed_memory_access (Pldrd_a rd) 8 base ofs k)
+  | _, _           => Error (msg "Asmgen.loadind")
+  end.
+
+Definition storeind (src: mreg) (base: iregsp) (ofs: ptrofs) (ty: typ) (k: code) :=
+  match ty, preg_of src with
+  | Tint,    IR rd => OK (indexed_memory_access (Pstrw rd) 4 base ofs k)
+  | Tlong,   IR rd => OK (indexed_memory_access (Pstrx rd) 8 base ofs k)
+  | Tsingle, FR rd => OK (indexed_memory_access (Pstrs rd) 4 base ofs k)
+  | Tfloat,  FR rd => OK (indexed_memory_access (Pstrd rd) 8 base ofs k)
+  | Tany32,  IR rd => OK (indexed_memory_access (Pstrw_a rd) 4 base ofs k)
+  | Tany64,  IR rd => OK (indexed_memory_access (Pstrx_a rd) 8 base ofs k)
+  | Tany64,  FR rd => OK (indexed_memory_access (Pstrd_a rd) 8 base ofs k)
+  | _, _           => Error (msg "Asmgen.storeind")
+  end.
+
+Definition loadptr (base: iregsp) (ofs: ptrofs) (dst: ireg) (k: code) :=
+  indexed_memory_access (Pldrx dst) 8 base ofs k.
+
+Definition storeptr (src: ireg) (base: iregsp) (ofs: ptrofs) (k: code) :=
+  indexed_memory_access (Pstrx src) 8 base ofs k.
+
+(** Function epilogue *)
+
+Definition make_epilogue (f: Mach.function) (k: code) :=
+  loadptr XSP f.(fn_retaddr_ofs) RA
+    (Pfreeframe f.(fn_stacksize) f.(fn_link_ofs) :: k).
+  
+(** Translation of a Mach instruction. *)
+
+Definition transl_instr (f: Mach.function) (i: Mach.instruction)
+                        (r29_is_parent: bool) (k: code) : res code :=
+  match i with
+  | Mgetstack ofs ty dst =>
+      loadind XSP ofs ty dst k
+  | Msetstack src ofs ty =>
+      storeind src XSP ofs ty k
+  | Mgetparam ofs ty dst =>
+      (* load via the frame pointer if it is valid *)
+      do c <- loadind X29 ofs ty dst k;
+      OK (if r29_is_parent then c else loadptr XSP f.(fn_link_ofs) X29 c)
+  | Mop op args res =>
+      transl_op op args res k
+  | Mload chunk addr args dst =>
+      transl_load chunk addr args dst k
+  | Mstore chunk addr args src =>
+      transl_store chunk addr args src k
+  | Mcall sig (inl r) =>
+      do r1 <- ireg_of r; OK (Pblr r1 sig :: k)
+  | Mcall sig (inr symb) =>
+      OK (Pbl symb sig :: k)
+  | Mtailcall sig (inl r) =>
+      do r1 <- ireg_of r;
+      OK (make_epilogue f (Pbr r1 sig :: k))
+  | Mtailcall sig (inr symb) =>
+      OK (make_epilogue f (Pbs symb sig :: k))
+  | Mbuiltin ef args res =>
+      OK (Pbuiltin ef (List.map (map_builtin_arg preg_of) args) (map_builtin_res preg_of res) :: k)
+  | Mlabel lbl =>
+      OK (Plabel lbl :: k)
+  | Mgoto lbl =>
+      OK (Pb lbl :: k)
+  | Mcond cond args lbl =>
+      transl_cond_branch cond args lbl k
+  | Mjumptable arg tbl =>
+      do r <- ireg_of arg;
+      OK (Pbtbl r tbl :: k)
+  | Mreturn =>
+      OK (make_epilogue f (Pret RA :: k))
+  end.
+
+(** Translation of a code sequence *)
+
+Definition it1_is_parent (before: bool) (i: Mach.instruction) : bool :=
+  match i with
+  | Msetstack src ofs ty => before
+  | Mgetparam ofs ty dst => negb (mreg_eq dst R29)
+  | Mop op args res => before && negb (mreg_eq res R29)
+  | _ => false
+  end.
+
+(** This is the naive definition that we no longer use because it
+  is not tail-recursive.  It is kept as specification. *)
+
+Fixpoint transl_code (f: Mach.function) (il: list Mach.instruction) (it1p: bool) :=
+  match il with
+  | nil => OK nil
+  | i1 :: il' =>
+      do k <- transl_code f il' (it1_is_parent it1p i1);
+      transl_instr f i1 it1p k
+  end.
+
+(** This is an equivalent definition in continuation-passing style
+  that runs in constant stack space. *)
+
+Fixpoint transl_code_rec (f: Mach.function) (il: list Mach.instruction)
+                         (it1p: bool) (k: code -> res code) :=
+  match il with
+  | nil => k nil
+  | i1 :: il' =>
+      transl_code_rec f il' (it1_is_parent it1p i1)
+        (fun c1 => do c2 <- transl_instr f i1 it1p c1; k c2)
+  end.
+
+Definition transl_code' (f: Mach.function) (il: list Mach.instruction) (it1p: bool) :=
+  transl_code_rec f il it1p (fun c => OK c).
+
+(** 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) :=
+  do c <- transl_code' f f.(Mach.fn_code) true;
+  OK (mkfunction f.(Mach.fn_sig)
+        (Pallocframe f.(fn_stacksize) f.(fn_link_ofs) ::
+         storeptr RA XSP f.(fn_retaddr_ofs) c)).
+
+Definition transf_function (f: Mach.function) : res Asm.function :=
+  do tf <- transl_function f;
+  if zlt Ptrofs.max_unsigned (list_length_z tf.(fn_code))
+  then Error (msg "code size exceeded")
+  else OK tf.
+
+Definition transf_fundef (f: Mach.fundef) : res Asm.fundef :=
+  transf_partial_fundef transf_function f.
+
+Definition transf_program (p: Mach.program) : res Asm.program :=
+  transform_partial_program transf_fundef p.
diff --git a/aarch64/Asmgenproof.v b/aarch64/Asmgenproof.v
new file mode 100644
index 00000000..eeff1956
--- /dev/null
+++ b/aarch64/Asmgenproof.v
@@ -0,0 +1,1026 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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 AArch64 code generation. *)
+
+Require Import Coqlib Errors.
+Require Import Integers Floats AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Op Locations Mach Conventions Asm.
+Require Import Asmgen Asmgenproof0 Asmgenproof1.
+
+Definition match_prog (p: Mach.program) (tp: Asm.program) :=
+  match_program (fun _ f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transf_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. eapply match_transform_partial_program; eauto.
+Qed.
+
+Section PRESERVATION.
+
+Variable prog: Mach.program.
+Variable tprog: Asm.program.
+Hypothesis TRANSF: match_prog prog tprog.
+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 (Genv.find_symbol_match TRANSF).
+
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
+
+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 = OK tf.
+Proof (Genv.find_funct_ptr_transf_partial TRANSF).
+
+Lemma functions_transl:
+  forall fb f tf,
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  transf_function f = OK tf ->
+  Genv.find_funct_ptr tge fb = Some (Internal tf).
+Proof.
+  intros. exploit functions_translated; eauto. intros [tf' [A B]].
+  monadInv B. rewrite H0 in EQ; inv EQ; auto.
+Qed.
+
+(** * Properties of control flow *)
+
+Lemma transf_function_no_overflow:
+  forall f tf,
+  transf_function f = OK tf -> list_length_z tf.(fn_code) <= Ptrofs.max_unsigned.
+Proof.
+  intros. monadInv H. destruct (zlt Ptrofs.max_unsigned (list_length_z x.(fn_code))); inv EQ0.
+  omega.
+Qed.
+
+Lemma exec_straight_exec:
+  forall fb f c ep tf tc c' rs m rs' m',
+  transl_code_at_pc ge (rs PC) fb f c ep tf tc ->
+  exec_straight tge tf tc rs m c' rs' m' ->
+  plus step tge (State rs m) E0 (State rs' m').
+Proof.
+  intros. inv H.
+  eapply exec_straight_steps_1; eauto.
+  eapply transf_function_no_overflow; eauto.
+  eapply functions_transl; eauto.
+Qed.
+
+Lemma exec_straight_at:
+  forall fb f c ep tf tc c' ep' tc' rs m rs' m',
+  transl_code_at_pc ge (rs PC) fb f c ep tf tc ->
+  transl_code f c' ep' = OK tc' ->
+  exec_straight tge tf tc rs m tc' rs' m' ->
+  transl_code_at_pc ge (rs' PC) fb f c' ep' tf tc'.
+Proof.
+  intros. inv H.
+  exploit exec_straight_steps_2; eauto.
+  eapply transf_function_no_overflow; eauto.
+  eapply functions_transl; eauto.
+  intros [ofs' [PC' CT']].
+  rewrite PC'. constructor; auto.
+Qed.
+
+(** The following lemmas show that the translation from Mach to Asm
+  preserves labels, in the sense that the following diagram commutes:
+<<
+                          translation
+        Mach code ------------------------ Asm instr sequence
+            |                                          |
+            | Mach.find_label lbl       find_label lbl |
+            |                                          |
+            v                                          v
+        Mach code tail ------------------- Asm instr seq tail
+                          translation
+>>
+  The proof demands many boring lemmas showing that Asm constructor
+  functions do not introduce new labels.
+*)
+
+Section TRANSL_LABEL.
+
+Remark loadimm_z_label: forall sz rd l k, tail_nolabel k (loadimm_z sz rd l k).
+Proof. 
+  intros; destruct l as [ | [n1 p1] l]; simpl; TailNoLabel.
+  induction l as [ | [n p] l]; simpl; TailNoLabel.
+Qed.
+
+Remark loadimm_n_label: forall sz rd l k, tail_nolabel k (loadimm_n sz rd l k).
+Proof. 
+  intros; destruct l as [ | [n1 p1] l]; simpl; TailNoLabel.
+  induction l as [ | [n p] l]; simpl; TailNoLabel.
+Qed.
+
+Remark loadimm_label: forall sz rd n k, tail_nolabel k (loadimm sz rd n k).
+Proof.
+  unfold loadimm; intros. destruct Nat.leb; [apply loadimm_z_label|apply loadimm_n_label].
+Qed.
+Hint Resolve loadimm_label: labels.
+
+Remark loadimm32_label: forall r n k, tail_nolabel k (loadimm32 r n k).
+Proof.
+  unfold loadimm32; intros. destruct (is_logical_imm32 n); TailNoLabel.
+Qed.
+Hint Resolve loadimm32_label: labels.
+
+Remark loadimm64_label: forall r n k, tail_nolabel k (loadimm64 r n k).
+Proof.
+  unfold loadimm64; intros. destruct (is_logical_imm64 n); TailNoLabel.
+Qed.
+Hint Resolve loadimm64_label: labels.
+
+Remark addimm_aux: forall insn rd r1 n k,
+  (forall rd r1 n, nolabel (insn rd r1 n)) ->
+  tail_nolabel k (addimm_aux insn rd r1 n k).
+Proof.
+  unfold addimm_aux; intros. 
+  destruct Z.eqb. TailNoLabel. destruct Z.eqb; TailNoLabel.
+Qed.
+
+Remark addimm32_label: forall rd r1 n k, tail_nolabel k (addimm32 rd r1 n k).
+Proof.
+  unfold addimm32; intros. 
+  destruct Int.eq. apply addimm_aux; intros; red; auto.
+  destruct Int.eq. apply addimm_aux; intros; red; auto.
+  destruct Int.lt; eapply tail_nolabel_trans; TailNoLabel.
+Qed.
+Hint Resolve addimm32_label: labels.
+
+Remark addimm64_label: forall rd r1 n k, tail_nolabel k (addimm64 rd r1 n k).
+Proof.
+  unfold addimm64; intros. 
+  destruct Int64.eq. apply addimm_aux; intros; red; auto.
+  destruct Int64.eq. apply addimm_aux; intros; red; auto.
+  destruct Int64.lt; eapply tail_nolabel_trans; TailNoLabel.
+Qed.
+Hint Resolve addimm64_label: labels.
+
+Remark logicalimm32_label: forall insn1 insn2 rd r1 n k,
+  (forall rd r1 n, nolabel (insn1 rd r1 n)) ->
+  (forall rd r1 r2 s, nolabel (insn2 rd r1 r2 s)) ->
+  tail_nolabel k (logicalimm32 insn1 insn2 rd r1 n k).
+Proof.
+  unfold logicalimm32; intros.
+  destruct (is_logical_imm32 n). TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+Qed.
+
+Remark logicalimm64_label: forall insn1 insn2 rd r1 n k,
+  (forall rd r1 n, nolabel (insn1 rd r1 n)) ->
+  (forall rd r1 r2 s, nolabel (insn2 rd r1 r2 s)) ->
+  tail_nolabel k (logicalimm64 insn1 insn2 rd r1 n k).
+Proof.
+  unfold logicalimm64; intros.
+  destruct (is_logical_imm64 n). TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+Qed.
+
+Remark move_extended_label: forall rd r1 ex a k, tail_nolabel k (move_extended rd r1 ex a k).
+Proof.
+  unfold move_extended, move_extended_base; intros. destruct Int.eq, ex; TailNoLabel.
+Qed.
+Hint Resolve move_extended_label: labels.
+
+Remark arith_extended_label: forall insnX insnS rd r1 r2 ex a k,
+  (forall rd r1 r2 x, nolabel (insnX rd r1 r2 x)) ->
+  (forall rd r1 r2 s, nolabel (insnS rd r1 r2 s)) ->
+  tail_nolabel k (arith_extended insnX insnS rd r1 r2 ex a k).
+Proof.
+  unfold arith_extended; intros. destruct Int.ltu.
+  TailNoLabel.
+  destruct ex; simpl; TailNoLabel.
+Qed.
+
+Remark loadsymbol_label: forall r id ofs k, tail_nolabel k (loadsymbol r id ofs k).
+Proof.
+  intros; unfold loadsymbol.
+  destruct (Archi.pic_code tt); TailNoLabel. destruct Ptrofs.eq; TailNoLabel.
+Qed. 
+Hint Resolve loadsymbol_label: labels.
+
+Remark transl_cond_label: forall cond args k c,
+  transl_cond cond args k = OK c -> tail_nolabel k c.
+Proof.
+  unfold transl_cond; intros; destruct cond; TailNoLabel.
+- destruct is_arith_imm32; TailNoLabel. destruct is_arith_imm32; TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+- destruct is_arith_imm32; TailNoLabel. destruct is_arith_imm32; TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+- destruct is_logical_imm32; TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+- destruct is_logical_imm32; TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+- destruct is_arith_imm64; TailNoLabel. destruct is_arith_imm64; TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+- destruct is_arith_imm64; TailNoLabel. destruct is_arith_imm64; TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+- destruct is_logical_imm64; TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+- destruct is_logical_imm64; TailNoLabel. eapply tail_nolabel_trans; TailNoLabel.
+Qed.
+
+Remark transl_cond_branch_default_label: forall cond args lbl k c,
+  transl_cond_branch_default cond args lbl k = OK c -> tail_nolabel k c.
+Proof.
+  unfold transl_cond_branch_default; intros. 
+  eapply tail_nolabel_trans; [eapply transl_cond_label;eauto|TailNoLabel].
+Qed.
+Hint Resolve transl_cond_branch_default_label: labels.
+
+Remark transl_cond_branch_label: forall cond args lbl k c,
+  transl_cond_branch cond args lbl k = OK c -> tail_nolabel k c.
+Proof.
+  unfold transl_cond_branch; intros; destruct args; TailNoLabel; destruct cond; TailNoLabel.
+- destruct c0; TailNoLabel.
+- destruct c0; TailNoLabel.
+- destruct (Int.is_power2 n); TailNoLabel.
+- destruct (Int.is_power2 n); TailNoLabel.
+- destruct c0; TailNoLabel.
+- destruct c0; TailNoLabel.
+- destruct (Int64.is_power2' n); TailNoLabel.
+- destruct (Int64.is_power2' n); TailNoLabel.
+Qed.
+
+Remark transl_op_label:
+  forall op args r k c,
+  transl_op op args r k = OK c -> tail_nolabel k c.
+Proof.
+  unfold transl_op; intros; destruct op; TailNoLabel.
+- destruct (preg_of r); try discriminate; destruct (preg_of m); inv H; TailNoLabel.
+- destruct (Float.eq_dec n Float.zero); TailNoLabel.
+- destruct (Float32.eq_dec n Float32.zero); TailNoLabel.
+- apply logicalimm32_label; unfold nolabel; auto.
+- apply logicalimm32_label; unfold nolabel; auto.
+- apply logicalimm32_label; unfold nolabel; auto.
+- unfold shrx32. destruct Int.eq; TailNoLabel.
+- apply arith_extended_label; unfold nolabel; auto.
+- apply arith_extended_label; unfold nolabel; auto.
+- apply logicalimm64_label; unfold nolabel; auto.
+- apply logicalimm64_label; unfold nolabel; auto.
+- apply logicalimm64_label; unfold nolabel; auto.
+- unfold shrx64. destruct Int.eq; TailNoLabel.
+- eapply tail_nolabel_trans. eapply transl_cond_label; eauto. TailNoLabel.
+- destruct (preg_of r); try discriminate; TailNoLabel;
+  (eapply tail_nolabel_trans; [eapply transl_cond_label; eauto | TailNoLabel]).
+Qed.
+
+Remark transl_addressing_label:
+  forall sz addr args insn k c,
+  transl_addressing sz addr args insn k = OK c ->
+  (forall ad, nolabel (insn ad)) ->
+  tail_nolabel k c.
+Proof.
+  unfold transl_addressing; intros; destruct addr; TailNoLabel;
+  eapply tail_nolabel_trans; TailNoLabel.
+  eapply tail_nolabel_trans. apply arith_extended_label; unfold nolabel; auto. TailNoLabel.
+Qed.
+
+Remark transl_load_label:
+  forall chunk addr args dst k c,
+  transl_load chunk addr args dst k = OK c -> tail_nolabel k c.
+Proof.
+  unfold transl_load; intros; destruct chunk; TailNoLabel; eapply transl_addressing_label; eauto; unfold nolabel; auto.
+Qed.
+
+Remark transl_store_label:
+  forall chunk addr args src k c,
+  transl_store chunk addr args src k = OK c -> tail_nolabel k c.
+Proof.
+  unfold transl_store; intros; destruct chunk; TailNoLabel; eapply transl_addressing_label; eauto; unfold nolabel; auto.
+Qed.
+
+Remark indexed_memory_access_label:
+  forall insn sz base ofs k,
+  (forall ad, nolabel (insn ad)) ->
+  tail_nolabel k (indexed_memory_access insn sz base ofs k).
+Proof.
+  unfold indexed_memory_access; intros. destruct offset_representable.
+  TailNoLabel.
+  eapply tail_nolabel_trans; TailNoLabel.
+Qed.
+
+Remark loadind_label:
+  forall base ofs ty dst k c,
+  loadind base ofs ty dst k = OK c -> tail_nolabel k c.
+Proof.
+  unfold loadind; intros.
+  destruct ty, (preg_of dst); inv H; apply indexed_memory_access_label; intros; exact I.
+Qed.
+
+Remark storeind_label:
+  forall src base ofs ty k c,
+  storeind src base ofs ty k = OK c -> tail_nolabel k c.
+Proof.
+  unfold storeind; intros.
+  destruct ty, (preg_of src); inv H; apply indexed_memory_access_label; intros; exact I.
+Qed.
+
+Remark loadptr_label:
+  forall base ofs dst k, tail_nolabel k (loadptr base ofs dst k).
+Proof.
+  intros. apply indexed_memory_access_label. unfold nolabel; auto.
+Qed.
+
+Remark storeptr_label:
+  forall src base ofs k, tail_nolabel k (storeptr src base ofs k).
+Proof.
+  intros. apply indexed_memory_access_label. unfold nolabel; auto.
+Qed.
+
+Remark make_epilogue_label:
+  forall f k, tail_nolabel k (make_epilogue f k).
+Proof.
+  unfold make_epilogue; intros. eapply tail_nolabel_trans. apply loadptr_label. TailNoLabel.
+Qed.
+
+Lemma transl_instr_label:
+  forall f i ep k c,
+  transl_instr f i ep k = OK c ->
+  match i with Mlabel lbl => c = Plabel lbl :: k | _ => tail_nolabel k c end.
+Proof.
+  unfold transl_instr; intros; destruct i; TailNoLabel.
+- eapply loadind_label; eauto.
+- eapply storeind_label; eauto.
+- destruct ep. eapply loadind_label; eauto.
+  eapply tail_nolabel_trans. apply loadptr_label. eapply loadind_label; eauto. 
+- eapply transl_op_label; eauto.
+- eapply transl_load_label; eauto. 
+- eapply transl_store_label; eauto.
+- destruct s0; monadInv H; TailNoLabel.
+- destruct s0; monadInv H; (eapply tail_nolabel_trans; [eapply make_epilogue_label|TailNoLabel]).
+- eapply transl_cond_branch_label; eauto.
+- eapply tail_nolabel_trans; [eapply make_epilogue_label|TailNoLabel].
+Qed.
+
+Lemma transl_instr_label':
+  forall lbl f i ep k c,
+  transl_instr f i ep k = OK c ->
+  find_label lbl c = if Mach.is_label lbl i then Some k else find_label lbl k.
+Proof.
+  intros. exploit transl_instr_label; eauto.
+  destruct i; try (intros [A B]; apply B).
+  intros. subst c. simpl. auto.
+Qed.
+
+Lemma transl_code_label:
+  forall lbl f c ep tc,
+  transl_code f c ep = OK tc ->
+  match Mach.find_label lbl c with
+  | None => find_label lbl tc = None
+  | Some c' => exists tc', find_label lbl tc = Some tc' /\ transl_code f c' false = OK tc'
+  end.
+Proof.
+  induction c; simpl; intros.
+  inv H. auto.
+  monadInv H. rewrite (transl_instr_label' lbl _ _ _ _ _ EQ0).
+  generalize (Mach.is_label_correct lbl a).
+  destruct (Mach.is_label lbl a); intros.
+  subst a. simpl in EQ. exists x; auto.
+  eapply IHc; eauto.
+Qed.
+
+Lemma transl_find_label:
+  forall lbl f tf,
+  transf_function f = OK tf ->
+  match Mach.find_label lbl f.(Mach.fn_code) with
+  | None => find_label lbl tf.(fn_code) = None
+  | Some c => exists tc, find_label lbl tf.(fn_code) = Some tc /\ transl_code f c false = OK tc
+  end.
+Proof.
+  intros. monadInv H. destruct (zlt Ptrofs.max_unsigned (list_length_z x.(fn_code))); inv EQ0.
+  monadInv EQ. rewrite transl_code'_transl_code in EQ0. unfold fn_code. 
+  simpl. destruct (storeptr_label X30 XSP (fn_retaddr_ofs f) x) as [A B]; rewrite B. 
+  eapply transl_code_label; eauto.
+Qed.
+
+End TRANSL_LABEL.
+
+(** A valid branch in a piece of Mach code translates to a valid ``go to''
+  transition in the generated Asm code. *)
+
+Lemma find_label_goto_label:
+  forall f tf lbl rs m c' b ofs,
+  Genv.find_funct_ptr ge b = Some (Internal f) ->
+  transf_function f = OK tf ->
+  rs PC = Vptr b ofs ->
+  Mach.find_label lbl f.(Mach.fn_code) = Some c' ->
+  exists tc', exists rs',
+     goto_label tf lbl rs m = Next rs' m
+  /\ transl_code_at_pc ge (rs' PC) b f c' false tf tc'
+  /\ forall r, r <> PC -> rs'#r = rs#r.
+Proof.
+  intros. exploit (transl_find_label lbl f tf); eauto. rewrite H2.
+  intros [tc [A B]].
+  exploit label_pos_code_tail; eauto. instantiate (1 := 0).
+  intros [pos' [P [Q R]]].
+  exists tc; exists (rs#PC <- (Vptr b (Ptrofs.repr pos'))).
+  split. unfold goto_label. rewrite P. rewrite H1. auto.
+  split. rewrite Pregmap.gss. constructor; auto.
+  rewrite Ptrofs.unsigned_repr. replace (pos' - 0) with pos' in Q.
+  auto. omega.
+  generalize (transf_function_no_overflow _ _ H0). omega.
+  intros. apply Pregmap.gso; auto.
+Qed.
+
+(** Existence of return addresses *)
+
+Lemma return_address_exists:
+  forall f sg ros c, is_tail (Mcall sg ros :: c) f.(Mach.fn_code) ->
+  exists ra, return_address_offset f c ra.
+Proof.
+  intros. eapply Asmgenproof0.return_address_exists; eauto.
+- intros. exploit transl_instr_label; eauto.
+  destruct i; try (intros [A B]; apply A). intros. subst c0. repeat constructor.
+- intros. monadInv H0.
+  destruct (zlt Ptrofs.max_unsigned (list_length_z x.(fn_code))); inv EQ0. monadInv EQ.
+  rewrite transl_code'_transl_code in EQ0.
+  exists x; exists true; split; auto. unfold fn_code.
+  constructor. apply (storeptr_label X30 XSP (fn_retaddr_ofs f0) x).
+- exact transf_function_no_overflow.
+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 Asm code pointed by the PC register is the translation of
+  the current Mach code sequence.
+- Mach register values and Asm register values agree.
+*)
+
+Inductive match_states: Mach.state -> Asm.state -> Prop :=
+  | match_states_intro:
+      forall s fb sp c ep ms m m' rs f tf tc
+        (STACKS: match_stack ge s)
+        (FIND: Genv.find_funct_ptr ge fb = Some (Internal f))
+        (MEXT: Mem.extends m m')
+        (AT: transl_code_at_pc ge (rs PC) fb f c ep tf tc)
+        (AG: agree ms sp rs)
+        (DXP: ep = true -> rs#X29 = parent_sp s),
+      match_states (Mach.State s fb sp c ms m)
+                   (Asm.State rs m')
+  | match_states_call:
+      forall s fb ms m m' rs
+        (STACKS: match_stack ge s)
+        (MEXT: Mem.extends m m')
+        (AG: agree ms (parent_sp s) rs)
+        (ATPC: rs PC = Vptr fb Ptrofs.zero)
+        (ATLR: rs RA = parent_ra s),
+      match_states (Mach.Callstate s fb ms m)
+                   (Asm.State rs m')
+  | match_states_return:
+      forall s ms m m' rs
+        (STACKS: match_stack ge s)
+        (MEXT: Mem.extends m m')
+        (AG: agree ms (parent_sp s) rs)
+        (ATPC: rs PC = parent_ra s),
+      match_states (Mach.Returnstate s ms m)
+                   (Asm.State rs m').
+
+Lemma exec_straight_steps:
+  forall s fb f rs1 i c ep tf tc m1' m2 m2' sp ms2,
+  match_stack ge s ->
+  Mem.extends m2 m2' ->
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  transl_code_at_pc ge (rs1 PC) fb f (i :: c) ep tf tc ->
+  (forall k c (TR: transl_instr f i ep k = OK c),
+   exists rs2,
+       exec_straight tge tf c rs1 m1' k rs2 m2'
+    /\ agree ms2 sp rs2
+    /\ (it1_is_parent ep i = true -> rs2#X29 = parent_sp s)) ->
+  exists st',
+  plus step tge (State rs1 m1') E0 st' /\
+  match_states (Mach.State s fb sp c ms2 m2) st'.
+Proof.
+  intros. inversion H2. subst. monadInv H7.
+  exploit H3; eauto. intros [rs2 [A [B C]]].
+  exists (State rs2 m2'); split.
+  eapply exec_straight_exec; eauto.
+  econstructor; eauto. eapply exec_straight_at; eauto.
+Qed.
+
+Lemma exec_straight_steps_goto:
+  forall s fb f rs1 i c ep tf tc m1' m2 m2' sp ms2 lbl c',
+  match_stack ge s ->
+  Mem.extends m2 m2' ->
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  Mach.find_label lbl f.(Mach.fn_code) = Some c' ->
+  transl_code_at_pc ge (rs1 PC) fb f (i :: c) ep tf tc ->
+  it1_is_parent ep i = false ->
+  (forall k c (TR: transl_instr f i ep k = OK c),
+   exists jmp, exists k', exists rs2,
+       exec_straight tge tf c rs1 m1' (jmp :: k') rs2 m2'
+    /\ agree ms2 sp rs2
+    /\ exec_instr tge tf jmp rs2 m2' = goto_label tf lbl rs2 m2') ->
+  exists st',
+  plus step tge (State rs1 m1') E0 st' /\
+  match_states (Mach.State s fb sp c' ms2 m2) st'.
+Proof.
+  intros. inversion H3. subst. monadInv H9.
+  exploit H5; eauto. intros [jmp [k' [rs2 [A [B C]]]]].
+  generalize (functions_transl _ _ _ H7 H8); intro FN.
+  generalize (transf_function_no_overflow _ _ H8); intro NOOV.
+  exploit exec_straight_steps_2; eauto.
+  intros [ofs' [PC2 CT2]].
+  exploit find_label_goto_label; eauto.
+  intros [tc' [rs3 [GOTO [AT' OTH]]]].
+  exists (State rs3 m2'); split.
+  eapply plus_right'.
+  eapply exec_straight_steps_1; eauto.
+  econstructor; eauto.
+  eapply find_instr_tail. eauto.
+  rewrite C. eexact GOTO.
+  traceEq.
+  econstructor; eauto.
+  apply agree_exten with rs2; auto with asmgen.
+  congruence.
+Qed.
+
+Lemma exec_straight_opt_steps_goto:
+  forall s fb f rs1 i c ep tf tc m1' m2 m2' sp ms2 lbl c',
+  match_stack ge s ->
+  Mem.extends m2 m2' ->
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
+  Mach.find_label lbl f.(Mach.fn_code) = Some c' ->
+  transl_code_at_pc ge (rs1 PC) fb f (i :: c) ep tf tc ->
+  it1_is_parent ep i = false ->
+  (forall k c (TR: transl_instr f i ep k = OK c),
+   exists jmp, exists k', exists rs2,
+       exec_straight_opt tge tf c rs1 m1' (jmp :: k') rs2 m2'
+    /\ agree ms2 sp rs2
+    /\ exec_instr tge tf jmp rs2 m2' = goto_label tf lbl rs2 m2') ->
+  exists st',
+  plus step tge (State rs1 m1') E0 st' /\
+  match_states (Mach.State s fb sp c' ms2 m2) st'.
+Proof.
+  intros. inversion H3. subst. monadInv H9.
+  exploit H5; eauto. intros [jmp [k' [rs2 [A [B C]]]]].
+  generalize (functions_transl _ _ _ H7 H8); intro FN.
+  generalize (transf_function_no_overflow _ _ H8); intro NOOV.
+  inv A.
+- exploit find_label_goto_label; eauto.
+  intros [tc' [rs3 [GOTO [AT' OTH]]]].
+  exists (State rs3 m2'); split.
+  apply plus_one. econstructor; eauto.
+  eapply find_instr_tail. eauto.
+  rewrite C. eexact GOTO.
+  econstructor; eauto.
+  apply agree_exten with rs2; auto with asmgen.
+  congruence.
+- exploit exec_straight_steps_2; eauto.
+  intros [ofs' [PC2 CT2]].
+  exploit find_label_goto_label; eauto.
+  intros [tc' [rs3 [GOTO [AT' OTH]]]].
+  exists (State rs3 m2'); split.
+  eapply plus_right'.
+  eapply exec_straight_steps_1; eauto.
+  econstructor; eauto.
+  eapply find_instr_tail. eauto.
+  rewrite C. eexact GOTO.
+  traceEq.
+  econstructor; eauto.
+  apply agree_exten with rs2; auto with asmgen.
+  congruence.
+Qed.
+
+(** We need to show that, in the simulation diagram, we cannot
+  take infinitely many Mach transitions that correspond to zero
+  transitions on the Asm side.  Actually, all Mach transitions
+  correspond to at least one Asm transition, except the
+  transition from [Machsem.Returnstate] to [Machsem.State].
+  So, the following integer measure will suffice to rule out
+  the unwanted behaviour. *)
+
+Definition measure (s: Mach.state) : nat :=
+  match s with
+  | Mach.State _ _ _ _ _ _ => 0%nat
+  | Mach.Callstate _ _ _ _ => 0%nat
+  | Mach.Returnstate _ _ _ => 1%nat
+  end.
+
+Remark preg_of_not_X29: forall r, negb (mreg_eq r R29) = true -> IR X29 <> preg_of r.
+Proof.
+  intros. change (IR X29) with (preg_of R29). red; intros.
+  exploit preg_of_injective; eauto. intros; subst r; discriminate.
+Qed.
+
+Lemma sp_val': forall ms sp rs, agree ms sp rs -> sp = rs XSP.
+Proof.
+  intros. eapply sp_val; eauto. 
+Qed. 
+
+(** This is the simulation diagram.  We prove it by case analysis on the Mach transition. *)
+
+Theorem step_simulation:
+  forall S1 t S2, Mach.step return_address_offset ge S1 t S2 ->
+  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.
+Proof.
+  induction 1; intros; inv MS.
+
+- (* Mlabel *)
+  left; eapply exec_straight_steps; eauto; intros.
+  monadInv TR. econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split. apply agree_nextinstr; auto. simpl; congruence.
+
+- (* Mgetstack *)
+  unfold load_stack in H.
+  exploit Mem.loadv_extends; eauto. intros [v' [A B]].
+  rewrite (sp_val _ _ _ AG) in A.
+  left; eapply exec_straight_steps; eauto. intros. simpl in TR.
+  exploit loadind_correct; eauto with asmgen. intros [rs' [P [Q R]]].
+  exists rs'; split. eauto.
+  split. eapply agree_set_mreg; eauto with asmgen. congruence.
+  simpl; congruence.
+
+- (* Msetstack *)
+  unfold store_stack in H.
+  assert (Val.lessdef (rs src) (rs0 (preg_of src))) by (eapply preg_val; eauto).
+  exploit Mem.storev_extends; eauto. intros [m2' [A B]].
+  left; eapply exec_straight_steps; eauto.
+  rewrite (sp_val _ _ _ AG) in A. intros. simpl in TR.
+  exploit storeind_correct; eauto with asmgen. intros [rs' [P Q]].
+  exists rs'; split. eauto.
+  split. eapply agree_undef_regs; eauto with asmgen.
+  simpl; intros. rewrite Q; auto with asmgen.
+
+- (* Mgetparam *)
+  assert (f0 = f) by congruence; subst f0.
+  unfold load_stack in *.
+  exploit Mem.loadv_extends. eauto. eexact H0. auto.
+  intros [parent' [A B]]. rewrite (sp_val' _ _ _ AG) in A.
+  exploit lessdef_parent_sp; eauto. clear B; intros B; subst parent'.
+  exploit Mem.loadv_extends. eauto. eexact H1. auto.
+  intros [v' [C D]].
+Opaque loadind.
+  left; eapply exec_straight_steps; eauto; intros. monadInv TR. 
+  destruct ep.
+(* X30 contains parent *)
+  exploit loadind_correct. eexact EQ.
+  instantiate (2 := rs0). simpl; rewrite DXP; eauto. simpl; congruence.
+  intros [rs1 [P [Q R]]].
+  exists rs1; split. eauto.
+  split. eapply agree_set_mreg. eapply agree_set_mreg; eauto. congruence. auto with asmgen.
+  simpl; intros. rewrite R; auto with asmgen.
+  apply preg_of_not_X29; auto.
+(* X30 does not contain parent *)
+  exploit loadptr_correct. eexact A. simpl; congruence. intros [rs1 [P [Q R]]].
+  exploit loadind_correct. eexact EQ. instantiate (2 := rs1). simpl; rewrite Q. eauto. simpl; congruence.
+  intros [rs2 [S [T U]]].
+  exists rs2; split. eapply exec_straight_trans; eauto.
+  split. eapply agree_set_mreg. eapply agree_set_mreg. eauto. eauto.
+  instantiate (1 := rs1#X29 <- (rs2#X29)). intros.
+  rewrite Pregmap.gso; auto with asmgen.
+  congruence.
+  intros. unfold Pregmap.set. destruct (PregEq.eq r' X29). congruence. auto with asmgen.
+  simpl; intros. rewrite U; auto with asmgen.
+  apply preg_of_not_X29; auto.
+
+- (* Mop *)
+  assert (eval_operation tge sp op (map rs args) m = Some v).
+  { rewrite <- H. apply eval_operation_preserved. exact symbols_preserved. }
+  exploit eval_operation_lessdef. eapply preg_vals; eauto. eauto. eexact H0.
+  intros [v' [A B]]. rewrite (sp_val _ _ _ AG) in A.
+  left; eapply exec_straight_steps; eauto; intros. simpl in TR.
+  exploit transl_op_correct; eauto. intros [rs2 [P [Q R]]].
+  exists rs2; split. eauto. split.
+  apply agree_set_undef_mreg with rs0; auto. 
+  apply Val.lessdef_trans with v'; auto.
+  simpl; intros. InvBooleans. 
+  rewrite R; auto. apply preg_of_not_X29; auto.
+Local Transparent destroyed_by_op.
+  destruct op; try exact I; simpl; congruence.
+
+- (* Mload *)
+  assert (Op.eval_addressing tge sp addr (map rs args) = Some a).
+  { rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. }
+  exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1.
+  intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A.
+  exploit Mem.loadv_extends; eauto. intros [v' [C D]].
+  left; eapply exec_straight_steps; eauto; intros. simpl in TR.
+  exploit transl_load_correct; eauto. intros [rs2 [P [Q R]]].
+  exists rs2; split. eauto.
+  split. eapply agree_set_undef_mreg; eauto. congruence.
+  simpl; congruence.
+
+- (* Mstore *)
+  assert (Op.eval_addressing tge sp addr (map rs args) = Some a).
+  { rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. }
+  exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1.
+  intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A.
+  assert (Val.lessdef (rs src) (rs0 (preg_of src))) by (eapply preg_val; eauto).
+  exploit Mem.storev_extends; eauto. intros [m2' [C D]].
+  left; eapply exec_straight_steps; eauto.
+  intros. simpl in TR. exploit transl_store_correct; eauto. intros [rs2 [P Q]].
+  exists rs2; split. eauto.
+  split. eapply agree_undef_regs; eauto with asmgen.
+  simpl; congruence.
+
+- (* Mcall *)
+  assert (f0 = f) by congruence.  subst f0.
+  inv AT.
+  assert (NOOV: list_length_z tf.(fn_code) <= Ptrofs.max_unsigned).
+  { eapply transf_function_no_overflow; eauto. }
+  destruct ros as [rf|fid]; simpl in H; monadInv H5.
++ (* Indirect call *)
+  assert (rs rf = Vptr f' Ptrofs.zero).
+  { destruct (rs rf); try discriminate.
+    revert H; predSpec Ptrofs.eq Ptrofs.eq_spec i Ptrofs.zero; intros; congruence. }
+  assert (rs0 x0 = Vptr f' Ptrofs.zero).
+  { exploit ireg_val; eauto. rewrite H5; intros LD; inv LD; auto. }
+  generalize (code_tail_next_int _ _ _ _ NOOV H6). intro CT1.
+  assert (TCA: transl_code_at_pc ge (Vptr fb (Ptrofs.add ofs Ptrofs.one)) fb f c false tf x).
+  {  econstructor; eauto. }
+  exploit return_address_offset_correct; eauto. intros; subst ra.
+  left; econstructor; split.
+  apply plus_one. eapply exec_step_internal. Simpl. rewrite <- H2; simpl; eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto.
+  simpl. eauto.
+  econstructor; eauto.
+  econstructor; eauto.
+  eapply agree_sp_def; eauto.
+  simpl. eapply agree_exten; eauto. intros. Simpl.
+  Simpl. rewrite <- H2. auto.
++ (* Direct call *)
+  generalize (code_tail_next_int _ _ _ _ NOOV H6). intro CT1.
+  assert (TCA: transl_code_at_pc ge (Vptr fb (Ptrofs.add ofs Ptrofs.one)) fb f c false tf x).
+    econstructor; eauto.
+  exploit return_address_offset_correct; eauto. intros; subst ra.
+  left; econstructor; split.
+  apply plus_one. eapply exec_step_internal. eauto.
+  eapply functions_transl; eauto. eapply find_instr_tail; eauto.
+  simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. eauto.
+  econstructor; eauto.
+  econstructor; eauto.
+  eapply agree_sp_def; eauto.
+  simpl. eapply agree_exten; eauto. intros. Simpl.
+  Simpl. rewrite <- H2. auto.
+
+- (* Mtailcall *)
+  assert (f0 = f) by congruence.  subst f0.
+  inversion AT; subst.
+  assert (NOOV: list_length_z tf.(fn_code) <= Ptrofs.max_unsigned).
+  { eapply transf_function_no_overflow; eauto. }
+  exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [parent' [A B]].
+  destruct ros as [rf|fid]; simpl in H; monadInv H7.
++ (* Indirect call *)
+  assert (rs rf = Vptr f' Ptrofs.zero).
+  { destruct (rs rf); try discriminate.
+    revert H; predSpec Ptrofs.eq Ptrofs.eq_spec i Ptrofs.zero; intros; congruence. }
+  assert (rs0 x0 = Vptr f' Ptrofs.zero).
+  { exploit ireg_val; eauto. rewrite H7; intros LD; inv LD; auto. }
+  exploit make_epilogue_correct; eauto. intros (rs1 & m1 & U & V & W & X & Y & Z). 
+  exploit exec_straight_steps_2; eauto using functions_transl.                      
+  intros (ofs' & P & Q).
+  left; econstructor; split.
+  (* execution *)
+  eapply plus_right'. eapply exec_straight_exec; eauto.
+  econstructor. eexact P. eapply functions_transl; eauto. eapply find_instr_tail. eexact Q.
+  simpl. reflexivity.
+  traceEq.
+  (* match states *)
+  econstructor; eauto.
+  apply agree_set_other; auto with asmgen.
+  Simpl. rewrite Z by (rewrite <- (ireg_of_eq _ _ EQ1); eauto with asmgen). assumption. 
++ (* Direct call *)
+  exploit make_epilogue_correct; eauto. intros (rs1 & m1 & U & V & W & X & Y & Z). 
+  exploit exec_straight_steps_2; eauto using functions_transl.                      
+  intros (ofs' & P & Q).
+  left; econstructor; split.
+  (* execution *)
+  eapply plus_right'. eapply exec_straight_exec; eauto.
+  econstructor. eexact P. eapply functions_transl; eauto. eapply find_instr_tail. eexact Q.
+  simpl. reflexivity.
+  traceEq.
+  (* match states *)
+  econstructor; eauto.
+  apply agree_set_other; auto with asmgen.
+  Simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. auto.
+
+- (* Mbuiltin *)
+  inv AT. monadInv H4.
+  exploit functions_transl; eauto. intro FN.
+  generalize (transf_function_no_overflow _ _ H3); intro NOOV.
+  exploit builtin_args_match; eauto. intros [vargs' [P Q]].
+  exploit external_call_mem_extends; eauto.
+  intros [vres' [m2' [A [B [C D]]]]].
+  left. econstructor; split. apply plus_one.
+  eapply exec_step_builtin. eauto. eauto.
+  eapply find_instr_tail; eauto.
+  erewrite <- sp_val by eauto.
+  eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
+  eauto.
+  econstructor; eauto.
+  instantiate (2 := tf); instantiate (1 := x).
+  unfold nextinstr. rewrite Pregmap.gss.
+  rewrite set_res_other. rewrite undef_regs_other_2.
+  rewrite <- H1. simpl. econstructor; eauto.
+  eapply code_tail_next_int; eauto.
+  rewrite preg_notin_charact. intros. auto with asmgen.
+  auto with asmgen.
+  apply agree_nextinstr. eapply agree_set_res; auto.
+  eapply agree_undef_regs; eauto. intros. rewrite undef_regs_other_2; auto.
+  congruence.
+
+- (* Mgoto *)
+  assert (f0 = f) by congruence. subst f0.
+  inv AT. monadInv H4.
+  exploit find_label_goto_label; eauto. intros [tc' [rs' [GOTO [AT2 INV]]]].
+  left; exists (State rs' m'); split.
+  apply plus_one. econstructor; eauto.
+  eapply functions_transl; eauto.
+  eapply find_instr_tail; eauto.
+  simpl; eauto.
+  econstructor; eauto.
+  eapply agree_exten; eauto with asmgen.
+  congruence.
+
+- (* Mcond true *)
+  assert (f0 = f) by congruence. subst f0.
+  exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros EC.
+  left; eapply exec_straight_opt_steps_goto; eauto.
+  intros. simpl in TR.
+  exploit transl_cond_branch_correct; eauto. intros (rs' & jmp & A & B & C).
+  exists jmp; exists k; exists rs'.
+  split. eexact A. 
+  split. apply agree_exten with rs0; auto with asmgen.
+  exact B. 
+
+- (* Mcond false *)
+  exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros EC.
+  left; eapply exec_straight_steps; eauto. intros. simpl in TR.
+  exploit transl_cond_branch_correct; eauto. intros (rs' & jmp & A & B & C).
+  econstructor; split.
+  eapply exec_straight_opt_right. eexact A. apply exec_straight_one. eexact B. auto.
+  split. apply agree_exten with rs0; auto. intros. Simpl.
+  simpl; congruence.
+
+- (* Mjumptable *)
+  assert (f0 = f) by congruence. subst f0.
+  inv AT. monadInv H6.
+  exploit functions_transl; eauto. intro FN.
+  generalize (transf_function_no_overflow _ _ H5); intro NOOV.
+  exploit find_label_goto_label. eauto. eauto.
+  instantiate (2 := rs0#X16 <- Vundef #X17 <- Vundef).
+  Simpl. eauto.
+  eauto.
+  intros [tc' [rs' [A [B C]]]].
+  exploit ireg_val; eauto. rewrite H. intros LD; inv LD.
+  left; econstructor; split.
+  apply plus_one. econstructor; eauto.
+  eapply find_instr_tail; eauto.
+  simpl. Simpl. rewrite <- H9. unfold Mach.label in H0; unfold label; rewrite H0. eexact A.
+  econstructor; eauto.
+  eapply agree_undef_regs; eauto.
+  simpl. intros. rewrite C; auto with asmgen. Simpl.
+  congruence.
+
+- (* Mreturn *)
+  assert (f0 = f) by congruence. subst f0.
+  inversion AT; subst. simpl in H6; monadInv H6.
+  assert (NOOV: list_length_z tf.(fn_code) <= Ptrofs.max_unsigned).
+    eapply transf_function_no_overflow; eauto.
+  exploit make_epilogue_correct; eauto. intros (rs1 & m1 & U & V & W & X & Y & Z).
+  exploit exec_straight_steps_2; eauto using functions_transl.                      
+  intros (ofs' & P & Q).
+  left; econstructor; split.
+  (* execution *)
+  eapply plus_right'. eapply exec_straight_exec; eauto.
+  econstructor. eexact P. eapply functions_transl; eauto. eapply find_instr_tail. eexact Q.
+  simpl. reflexivity.
+  traceEq.
+  (* match states *)
+  econstructor; eauto.
+  apply agree_set_other; auto with asmgen.
+
+- (* internal function *)
+
+  exploit functions_translated; eauto. intros [tf [A B]]. monadInv B.
+  generalize EQ; intros EQ'. monadInv EQ'.
+  destruct (zlt Ptrofs.max_unsigned (list_length_z x0.(fn_code))); inversion EQ1. clear EQ1. subst x0.
+  unfold store_stack in *.
+  exploit Mem.alloc_extends. eauto. eauto. apply Z.le_refl. apply Z.le_refl.
+  intros [m1' [C D]].
+  exploit Mem.storev_extends. eexact D. eexact H1. eauto. eauto.
+  intros [m2' [F G]].
+  simpl chunk_of_type in F.
+  exploit Mem.storev_extends. eexact G. eexact H2. eauto. eauto.
+  intros [m3' [P Q]].
+  change (chunk_of_type Tptr) with Mint64 in *.
+  (* Execution of function prologue *)
+  monadInv EQ0. rewrite transl_code'_transl_code in EQ1.
+  set (tfbody := Pallocframe (fn_stacksize f) (fn_link_ofs f) ::
+                 storeptr RA XSP (fn_retaddr_ofs f) x0) in *.
+  set (tf := {| fn_sig := Mach.fn_sig f; fn_code := tfbody |}) in *.
+  set (rs2 := nextinstr (rs0#X29 <- (parent_sp s) #SP <- sp #X16 <- Vundef)).
+  exploit (storeptr_correct tge tf XSP (fn_retaddr_ofs f) RA x0 m2' m3' rs2).
+    simpl preg_of_iregsp. change (rs2 X30) with (rs0 X30). rewrite ATLR. 
+    change (rs2 X2) with sp. eexact P. 
+    simpl; congruence. congruence.
+  intros (rs3 & U & V).
+  assert (EXEC_PROLOGUE:
+            exec_straight tge tf
+              tf.(fn_code) rs0 m'
+              x0 rs3 m3').
+  { change (fn_code tf) with tfbody; unfold tfbody.
+    apply exec_straight_step with rs2 m2'.
+    unfold exec_instr. rewrite C. fold sp.
+    rewrite <- (sp_val _ _ _ AG). rewrite F. reflexivity.
+    reflexivity. 
+    eexact U. }
+  exploit exec_straight_steps_2; eauto using functions_transl. omega. constructor.
+  intros (ofs' & X & Y).                    
+  left; exists (State rs3 m3'); split.
+  eapply exec_straight_steps_1; eauto. omega. constructor.
+  econstructor; eauto.
+  rewrite X; econstructor; eauto. 
+  apply agree_exten with rs2; eauto with asmgen.
+  unfold rs2. 
+  apply agree_nextinstr. apply agree_set_other; auto with asmgen.
+  apply agree_change_sp with (parent_sp s). 
+  apply agree_undef_regs with rs0. auto.
+Local Transparent destroyed_at_function_entry. simpl.
+  simpl; intros; Simpl.
+  unfold sp; congruence.
+  intros. rewrite V by auto with asmgen. reflexivity.
+
+- (* external function *)
+  exploit functions_translated; eauto.
+  intros [tf [A B]]. simpl in B. inv B.
+  exploit extcall_arguments_match; eauto.
+  intros [args' [C D]].
+  exploit external_call_mem_extends; eauto.
+  intros [res' [m2' [P [Q [R S]]]]].
+  left; econstructor; split.
+  apply plus_one. eapply exec_step_external; eauto.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
+  econstructor; eauto.
+  unfold loc_external_result. apply agree_set_other; auto. apply agree_set_pair; auto.
+  apply agree_undef_caller_save_regs; auto. 
+
+- (* return *)
+  inv STACKS. simpl in *.
+  right. split. omega. split. auto.
+  rewrite <- ATPC in H5.
+  econstructor; eauto. congruence.
+Qed.
+
+Lemma transf_initial_states:
+  forall st1, Mach.initial_state prog st1 ->
+  exists st2, Asm.initial_state tprog st2 /\ match_states st1 st2.
+Proof.
+  intros. inversion H. unfold ge0 in *.
+  econstructor; split.
+  econstructor.
+  eapply (Genv.init_mem_transf_partial TRANSF); eauto.
+  replace (Genv.symbol_address (Genv.globalenv tprog) (prog_main tprog) Ptrofs.zero)
+     with (Vptr fb Ptrofs.zero).
+  econstructor; eauto.
+  constructor.
+  apply Mem.extends_refl.
+  split. auto. simpl. unfold Vnullptr; destruct Archi.ptr64; congruence.
+  intros. rewrite Regmap.gi. auto.
+  unfold Genv.symbol_address.
+  rewrite (match_program_main TRANSF).
+  rewrite symbols_preserved.
+  unfold ge; rewrite H1. auto.
+Qed.
+
+Lemma transf_final_states:
+  forall st1 st2 r,
+  match_states st1 st2 -> Mach.final_state st1 r -> Asm.final_state st2 r.
+Proof.
+  intros. inv H0. inv H. constructor. assumption.
+  compute in H1. inv H1.
+  generalize (preg_val _ _ _ R0 AG). rewrite H2. intros LD; inv LD. auto.
+Qed.
+
+Theorem transf_program_correct:
+  forward_simulation (Mach.semantics return_address_offset prog) (Asm.semantics tprog).
+Proof.
+  eapply forward_simulation_star with (measure := measure).
+  apply senv_preserved.
+  eexact transf_initial_states.
+  eexact transf_final_states.
+  exact step_simulation.
+Qed.
+
+End PRESERVATION.
diff --git a/aarch64/Asmgenproof1.v b/aarch64/Asmgenproof1.v
new file mode 100644
index 00000000..6d44bcc8
--- /dev/null
+++ b/aarch64/Asmgenproof1.v
@@ -0,0 +1,1836 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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 AArch64 code generation: auxiliary results. *)
+
+Require Import Recdef Coqlib Zwf Zbits.
+Require Import Maps Errors AST Integers Floats Values Memory Globalenvs.
+Require Import Op Locations Mach Asm Conventions.
+Require Import Asmgen.
+Require Import Asmgenproof0.
+
+Local Transparent Archi.ptr64.
+
+(** Properties of registers *)
+
+Lemma preg_of_iregsp_not_PC: forall r, preg_of_iregsp r <> PC.
+Proof.
+  destruct r; simpl; congruence.
+Qed.
+Hint Resolve preg_of_iregsp_not_PC: asmgen.
+
+Lemma preg_of_not_X16: forall r, preg_of r <> X16.
+Proof.
+  destruct r; simpl; congruence.
+Qed.
+
+Lemma ireg_of_not_X16: forall r x, ireg_of r = OK x -> x <> X16.
+Proof.
+  unfold ireg_of; intros. destruct (preg_of r) eqn:E; inv H.
+  red; intros; subst x. elim (preg_of_not_X16 r); auto.
+Qed.
+
+Lemma ireg_of_not_X16': forall r x, ireg_of r = OK x -> IR x <> IR X16.
+Proof.
+  intros. apply ireg_of_not_X16 in H. congruence.
+Qed.
+
+Hint Resolve preg_of_not_X16 ireg_of_not_X16 ireg_of_not_X16': asmgen.
+
+(** Useful simplification tactic *)
+
+
+Ltac Simplif :=
+  ((rewrite nextinstr_inv by eauto with asmgen)
+  || (rewrite nextinstr_inv1 by eauto with asmgen)
+  || (rewrite Pregmap.gss)
+  || (rewrite nextinstr_pc)
+  || (rewrite Pregmap.gso by eauto with asmgen)); auto with asmgen.
+
+Ltac Simpl := repeat Simplif.
+
+(** * Correctness of ARM constructor functions *)
+
+Section CONSTRUCTORS.
+
+Variable ge: genv.
+Variable fn: function.
+
+(** Decomposition of integer literals *)
+
+Inductive wf_decomposition: list (Z * Z) -> Prop :=
+  | wf_decomp_nil:
+      wf_decomposition nil
+  | wf_decomp_cons: forall m n p l,
+      n = Zzero_ext 16 m -> 0 <= p -> wf_decomposition l ->
+      wf_decomposition ((n, p) :: l).
+
+Lemma decompose_int_wf:
+  forall N n p, 0 <= p -> wf_decomposition (decompose_int N n p).
+Proof.
+Local Opaque Zzero_ext.
+  induction N as [ | N]; simpl; intros.
+- constructor.
+- set (frag := Zzero_ext 16 (Z.shiftr n p)) in *. destruct (Z.eqb frag 0).
++ apply IHN. omega.
++ econstructor. reflexivity. omega. apply IHN; omega. 
+Qed.
+
+Fixpoint recompose_int (accu: Z) (l: list (Z * Z)) : Z :=
+  match l with
+  | nil => accu
+  | (n, p) :: l => recompose_int (Zinsert accu n p 16) l
+  end.
+
+Lemma decompose_int_correct:
+  forall N n p accu,
+  0 <= p ->
+  (forall i, p <= i -> Z.testbit accu i = false) ->
+  (forall i, 0 <= i < p + Z.of_nat N * 16 ->
+   Z.testbit (recompose_int accu (decompose_int N n p)) i =
+   if zlt i p then Z.testbit accu i else Z.testbit n i).
+Proof.
+  induction N as [ | N]; intros until accu; intros PPOS ABOVE i RANGE.
+- simpl. rewrite zlt_true; auto. xomega.
+- rewrite inj_S in RANGE. simpl.
+  set (frag := Zzero_ext 16 (Z.shiftr n p)).
+  assert (FRAG: forall i, p <= i < p + 16 -> Z.testbit n i = Z.testbit frag (i - p)).
+  { unfold frag; intros. rewrite Zzero_ext_spec by omega. rewrite zlt_true by omega.
+    rewrite Z.shiftr_spec by omega. f_equal; omega. }
+  destruct (Z.eqb_spec frag 0).
++ rewrite IHN.
+* destruct (zlt i p). rewrite zlt_true by omega. auto.
+  destruct (zlt i (p + 16)); auto.
+  rewrite ABOVE by omega. rewrite FRAG by omega. rewrite e, Z.testbit_0_l. auto.
+* omega.
+* intros; apply ABOVE; omega.
+* xomega.
++ simpl. rewrite IHN.
+* destruct (zlt i (p + 16)).
+** rewrite Zinsert_spec by omega. unfold proj_sumbool.
+   rewrite zlt_true by omega.
+   destruct (zlt i p).
+   rewrite zle_false by omega. auto.
+   rewrite zle_true by omega. simpl. symmetry; apply FRAG; omega.
+** rewrite Z.ldiff_spec, Z.shiftl_spec by omega.
+   change 65535 with (two_p 16 - 1). rewrite Ztestbit_two_p_m1 by omega.
+   rewrite zlt_false by omega. rewrite zlt_false by omega. apply andb_true_r. 
+* omega.
+* intros. rewrite Zinsert_spec by omega. unfold proj_sumbool.
+  rewrite zle_true by omega. rewrite zlt_false by omega. simpl.
+  apply ABOVE. omega.
+* xomega.
+Qed.
+
+Corollary decompose_int_eqmod: forall N n,
+  eqmod (two_power_nat (N * 16)%nat) (recompose_int 0 (decompose_int N n 0)) n.
+Proof.
+  intros; apply eqmod_same_bits; intros.
+  rewrite decompose_int_correct. apply zlt_false; omega. 
+  omega. intros; apply Z.testbit_0_l. xomega.
+Qed.
+
+Corollary decompose_notint_eqmod: forall N n,
+  eqmod (two_power_nat (N * 16)%nat)
+        (Z.lnot (recompose_int 0 (decompose_int N (Z.lnot n) 0))) n.
+Proof.
+  intros; apply eqmod_same_bits; intros.
+  rewrite Z.lnot_spec, decompose_int_correct.
+  rewrite zlt_false by omega. rewrite Z.lnot_spec by omega. apply negb_involutive.
+  omega. intros; apply Z.testbit_0_l. xomega. omega.
+Qed.
+
+Lemma negate_decomposition_wf:
+  forall l, wf_decomposition l -> wf_decomposition (negate_decomposition l).
+Proof.
+  induction 1; simpl; econstructor; auto.
+  instantiate (1 := (Z.lnot m)).
+  apply equal_same_bits; intros.
+  rewrite H. change 65535 with (two_p 16 - 1).
+  rewrite Z.lxor_spec, !Zzero_ext_spec, Z.lnot_spec, Ztestbit_two_p_m1 by omega.
+  destruct (zlt i 16).
+  apply xorb_true_r.
+  auto.
+Qed.
+
+Lemma Zinsert_eqmod:
+  forall n x1 x2 y p l, 0 <= p -> 0 <= l ->
+  eqmod (two_power_nat n) x1 x2 ->
+  eqmod (two_power_nat n) (Zinsert x1 y p l) (Zinsert x2 y p l).
+Proof.
+  intros. apply eqmod_same_bits; intros. rewrite ! Zinsert_spec by omega.
+  destruct (zle p i && zlt i (p + l)); auto.
+  apply same_bits_eqmod with n; auto.
+Qed.
+
+Lemma Zinsert_0_l:
+  forall y p l,
+  0 <= p -> 0 <= l ->
+  Z.shiftl (Zzero_ext l y) p = Zinsert 0 (Zzero_ext l y) p l.
+Proof.
+  intros. apply equal_same_bits; intros.
+  rewrite Zinsert_spec by omega. unfold proj_sumbool.
+  destruct (zlt i p); [rewrite zle_false by omega|rewrite zle_true by omega]; simpl.
+- rewrite Z.testbit_0_l, Z.shiftl_spec_low by auto. auto.
+- rewrite Z.shiftl_spec by omega. 
+  destruct (zlt i (p + l)); auto.
+  rewrite Zzero_ext_spec, zlt_false, Z.testbit_0_l by omega. auto.
+Qed.
+
+Lemma recompose_int_negated:
+  forall l, wf_decomposition l ->
+  forall accu, recompose_int (Z.lnot accu) (negate_decomposition l) = Z.lnot (recompose_int accu l).
+Proof.
+  induction 1; intros accu; simpl.
+- auto.
+- rewrite <- IHwf_decomposition. f_equal. apply equal_same_bits; intros. 
+  rewrite Z.lnot_spec, ! Zinsert_spec, Z.lxor_spec, Z.lnot_spec by omega.
+  unfold proj_sumbool.
+  destruct (zle p i); simpl; auto.
+  destruct (zlt i (p + 16)); simpl; auto.
+  change 65535 with (two_p 16 - 1).
+  rewrite Ztestbit_two_p_m1 by omega. rewrite zlt_true by omega.
+  apply xorb_true_r. 
+Qed.
+
+Lemma exec_loadimm_k_w:
+  forall (rd: ireg) k m l,
+  wf_decomposition l ->
+  forall (rs: regset) accu,
+  rs#rd = Vint (Int.repr accu) ->
+  exists rs',
+     exec_straight_opt ge fn (loadimm_k W rd l k) rs m k rs' m
+  /\ rs'#rd = Vint (Int.repr (recompose_int accu l))
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  induction 1; intros rs accu ACCU; simpl.
+- exists rs; split. apply exec_straight_opt_refl. auto.
+- destruct (IHwf_decomposition
+                (nextinstr (rs#rd <- (insert_in_int rs#rd n p 16)))
+                (Zinsert accu n p 16))
+  as (rs' & P & Q & R).
+  Simpl. rewrite ACCU. simpl. f_equal. apply Int.eqm_samerepr. 
+  apply Zinsert_eqmod. auto. omega. apply Int.eqm_sym; apply Int.eqm_unsigned_repr.
+  exists rs'; split.
+  eapply exec_straight_opt_step_opt. simpl; eauto. auto. exact P.
+  split. exact Q. intros; Simpl. rewrite R by auto. Simpl.
+Qed.
+
+Lemma exec_loadimm_z_w:
+  forall rd l k rs m,
+  wf_decomposition l ->
+  exists rs',
+     exec_straight ge fn (loadimm_z W rd l k) rs m k rs' m
+  /\ rs'#rd = Vint (Int.repr (recompose_int 0 l))
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold loadimm_z; destruct 1.
+- econstructor; split.
+  apply exec_straight_one. simpl; eauto. auto.
+  split. Simpl.
+  intros; Simpl.
+- set (accu0 := Zinsert 0 n p 16).
+  set (rs1 := nextinstr (rs#rd <- (Vint (Int.repr accu0)))).
+  destruct (exec_loadimm_k_w rd k m l H1 rs1 accu0) as (rs2 & P & Q & R); auto.
+  unfold rs1; Simpl.
+  exists rs2; split.
+  eapply exec_straight_opt_step; eauto.
+  simpl. unfold rs1. do 5 f_equal. unfold accu0. rewrite H. apply Zinsert_0_l; omega.
+  reflexivity.
+  split. exact Q. 
+  intros. rewrite R by auto. unfold rs1; Simpl.
+Qed.
+
+Lemma exec_loadimm_n_w:
+  forall rd l k rs m,
+  wf_decomposition l ->
+  exists rs',
+     exec_straight ge fn (loadimm_n W rd l k) rs m k rs' m
+  /\ rs'#rd = Vint (Int.repr (Z.lnot (recompose_int 0 l)))
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold loadimm_n; destruct 1.
+- econstructor; split.
+  apply exec_straight_one. simpl; eauto. auto.
+  split. Simpl. 
+  intros; Simpl.
+- set (accu0 := Z.lnot (Zinsert 0 n p 16)).
+  set (rs1 := nextinstr (rs#rd <- (Vint (Int.repr accu0)))).
+  destruct (exec_loadimm_k_w rd k m (negate_decomposition l) 
+                                    (negate_decomposition_wf l H1)
+                                    rs1 accu0) as (rs2 & P & Q & R).
+  unfold rs1; Simpl.
+  exists rs2; split.
+  eapply exec_straight_opt_step; eauto.
+  simpl. unfold rs1. do 5 f_equal.
+  unfold accu0. f_equal. rewrite H. apply Zinsert_0_l; omega.
+  reflexivity.  
+  split. unfold accu0 in Q; rewrite recompose_int_negated in Q by auto. exact Q.
+  intros. rewrite R by auto. unfold rs1; Simpl.
+Qed.
+
+Lemma exec_loadimm32:
+  forall rd n k rs m,
+  exists rs',
+     exec_straight ge fn (loadimm32 rd n k) rs m k rs' m
+  /\ rs'#rd = Vint n
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold loadimm32, loadimm; intros.
+  destruct (is_logical_imm32 n).
+- econstructor; split.
+  apply exec_straight_one. simpl; eauto. auto.
+  split. Simpl. rewrite Int.repr_unsigned, Int.or_zero_l; auto.
+  intros; Simpl.
+- set (dz := decompose_int 2%nat (Int.unsigned n) 0).
+  set (dn := decompose_int 2%nat (Z.lnot (Int.unsigned n)) 0).
+  assert (A: Int.repr (recompose_int 0 dz) = n).
+  { transitivity (Int.repr (Int.unsigned n)).
+    apply Int.eqm_samerepr. apply decompose_int_eqmod. 
+    apply Int.repr_unsigned. }
+  assert (B: Int.repr (Z.lnot (recompose_int 0 dn)) = n).
+  { transitivity (Int.repr (Int.unsigned n)).
+    apply Int.eqm_samerepr. apply decompose_notint_eqmod. 
+    apply Int.repr_unsigned. }
+  destruct Nat.leb.
++ rewrite <- A. apply exec_loadimm_z_w. apply decompose_int_wf; omega.
++ rewrite <- B. apply exec_loadimm_n_w. apply decompose_int_wf; omega.
+Qed.
+
+Lemma exec_loadimm_k_x:
+  forall (rd: ireg) k m l,
+  wf_decomposition l ->
+  forall (rs: regset) accu,
+  rs#rd = Vlong (Int64.repr accu) ->
+  exists rs',
+     exec_straight_opt ge fn (loadimm_k X rd l k) rs m k rs' m
+  /\ rs'#rd = Vlong (Int64.repr (recompose_int accu l))
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  induction 1; intros rs accu ACCU; simpl.
+- exists rs; split. apply exec_straight_opt_refl. auto.
+- destruct (IHwf_decomposition
+                (nextinstr (rs#rd <- (insert_in_long rs#rd n p 16)))
+                (Zinsert accu n p 16))
+  as (rs' & P & Q & R).
+  Simpl. rewrite ACCU. simpl. f_equal. apply Int64.eqm_samerepr. 
+  apply Zinsert_eqmod. auto. omega. apply Int64.eqm_sym; apply Int64.eqm_unsigned_repr.
+  exists rs'; split.
+  eapply exec_straight_opt_step_opt. simpl; eauto. auto. exact P.
+  split. exact Q. intros; Simpl. rewrite R by auto. Simpl.
+Qed.
+
+Lemma exec_loadimm_z_x:
+  forall rd l k rs m,
+  wf_decomposition l ->
+  exists rs',
+     exec_straight ge fn (loadimm_z X rd l k) rs m k rs' m
+  /\ rs'#rd = Vlong (Int64.repr (recompose_int 0 l))
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold loadimm_z; destruct 1.
+- econstructor; split.
+  apply exec_straight_one. simpl; eauto. auto.
+  split. Simpl.
+  intros; Simpl.
+- set (accu0 := Zinsert 0 n p 16).
+  set (rs1 := nextinstr (rs#rd <- (Vlong (Int64.repr accu0)))).
+  destruct (exec_loadimm_k_x rd k m l H1 rs1 accu0) as (rs2 & P & Q & R); auto.
+  unfold rs1; Simpl.
+  exists rs2; split.
+  eapply exec_straight_opt_step; eauto.
+  simpl. unfold rs1. do 5 f_equal. unfold accu0. rewrite H. apply Zinsert_0_l; omega.
+  reflexivity.
+  split. exact Q. 
+  intros. rewrite R by auto. unfold rs1; Simpl.
+Qed.
+
+Lemma exec_loadimm_n_x:
+  forall rd l k rs m,
+  wf_decomposition l ->
+  exists rs',
+     exec_straight ge fn (loadimm_n X rd l k) rs m k rs' m
+  /\ rs'#rd = Vlong (Int64.repr (Z.lnot (recompose_int 0 l)))
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold loadimm_n; destruct 1.
+- econstructor; split.
+  apply exec_straight_one. simpl; eauto. auto.
+  split. Simpl. 
+  intros; Simpl.
+- set (accu0 := Z.lnot (Zinsert 0 n p 16)).
+  set (rs1 := nextinstr (rs#rd <- (Vlong (Int64.repr accu0)))).
+  destruct (exec_loadimm_k_x rd k m (negate_decomposition l) 
+                                    (negate_decomposition_wf l H1)
+                                    rs1 accu0) as (rs2 & P & Q & R).
+  unfold rs1; Simpl.
+  exists rs2; split.
+  eapply exec_straight_opt_step; eauto.
+  simpl. unfold rs1. do 5 f_equal.
+  unfold accu0. f_equal. rewrite H. apply Zinsert_0_l; omega.
+  reflexivity.  
+  split. unfold accu0 in Q; rewrite recompose_int_negated in Q by auto. exact Q.
+  intros. rewrite R by auto. unfold rs1; Simpl.
+Qed.
+
+Lemma exec_loadimm64:
+  forall rd n k rs m,
+  exists rs',
+     exec_straight ge fn (loadimm64 rd n k) rs m k rs' m
+  /\ rs'#rd = Vlong n
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold loadimm64, loadimm; intros.
+  destruct (is_logical_imm64 n).
+- econstructor; split.
+  apply exec_straight_one. simpl; eauto. auto.
+  split. Simpl. rewrite Int64.repr_unsigned, Int64.or_zero_l; auto.
+  intros; Simpl.
+- set (dz := decompose_int 4%nat (Int64.unsigned n) 0).
+  set (dn := decompose_int 4%nat (Z.lnot (Int64.unsigned n)) 0).
+  assert (A: Int64.repr (recompose_int 0 dz) = n).
+  { transitivity (Int64.repr (Int64.unsigned n)).
+    apply Int64.eqm_samerepr. apply decompose_int_eqmod. 
+    apply Int64.repr_unsigned. }
+  assert (B: Int64.repr (Z.lnot (recompose_int 0 dn)) = n).
+  { transitivity (Int64.repr (Int64.unsigned n)).
+    apply Int64.eqm_samerepr. apply decompose_notint_eqmod. 
+    apply Int64.repr_unsigned. }
+  destruct Nat.leb.
++ rewrite <- A. apply exec_loadimm_z_x. apply decompose_int_wf; omega.
++ rewrite <- B. apply exec_loadimm_n_x. apply decompose_int_wf; omega.
+Qed.
+
+(** Add immediate *)
+
+Lemma exec_addimm_aux_32:
+  forall (insn: iregsp -> iregsp -> Z -> instruction) (sem: val -> val -> val),
+  (forall rd r1 n rs m,
+    exec_instr ge fn (insn rd r1 n) rs m =
+      Next (nextinstr (rs#rd <- (sem rs#r1 (Vint (Int.repr n))))) m) ->
+  (forall v n1 n2, sem (sem v (Vint n1)) (Vint n2) = sem v (Vint (Int.add n1 n2))) ->
+  forall rd r1 n k rs m,
+  exists rs',
+     exec_straight ge fn (addimm_aux insn rd r1 (Int.unsigned n) k) rs m k rs' m
+  /\ rs'#rd = sem rs#r1 (Vint n)
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  intros insn sem SEM ASSOC; intros. unfold addimm_aux.
+  set (nlo := Zzero_ext 12 (Int.unsigned n)). set (nhi := Int.unsigned n - nlo).
+  assert (E: Int.unsigned n = nhi + nlo) by (unfold nhi; omega).
+  rewrite <- (Int.repr_unsigned n).
+  destruct (Z.eqb_spec nhi 0); [|destruct (Z.eqb_spec nlo 0)].
+- econstructor; split. apply exec_straight_one. apply SEM. Simpl. 
+  split. Simpl. do 3 f_equal; omega.
+  intros; Simpl.
+- econstructor; split. apply exec_straight_one. apply SEM. Simpl. 
+  split. Simpl. do 3 f_equal; omega.
+  intros; Simpl.
+- econstructor; split. eapply exec_straight_two.
+  apply SEM. apply SEM. Simpl. Simpl.
+  split. Simpl. rewrite ASSOC. do 2 f_equal. apply Int.eqm_samerepr.
+  rewrite E. auto with ints.
+  intros; Simpl.
+Qed.
+
+Lemma exec_addimm32:
+  forall rd r1 n k rs m,
+  r1 <> X16 ->
+  exists rs',
+     exec_straight ge fn (addimm32 rd r1 n k) rs m k rs' m
+  /\ rs'#rd = Val.add rs#r1 (Vint n)
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  intros. unfold addimm32. set (nn := Int.neg n).
+  destruct (Int.eq n (Int.zero_ext 24 n)); [| destruct (Int.eq nn (Int.zero_ext 24 nn))].
+- apply exec_addimm_aux_32 with (sem := Val.add). auto. intros; apply Val.add_assoc. 
+- rewrite <- Val.sub_opp_add.
+  apply exec_addimm_aux_32 with (sem := Val.sub). auto.
+  intros. rewrite ! Val.sub_add_opp, Val.add_assoc. rewrite Int.neg_add_distr. auto.
+- destruct (Int.lt n Int.zero).
++ rewrite <- Val.sub_opp_add; fold nn.
+  edestruct (exec_loadimm32 X16 nn) as (rs1 & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. eapply exec_straight_one. simpl; eauto. auto.
+  split. Simpl. rewrite B, C; eauto with asmgen.
+  intros; Simpl.
++ edestruct (exec_loadimm32 X16 n) as (rs1 & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. eapply exec_straight_one. simpl; eauto. auto.
+  split. Simpl. rewrite B, C; eauto with asmgen.
+  intros; Simpl.
+Qed.
+
+Lemma exec_addimm_aux_64:
+  forall (insn: iregsp -> iregsp -> Z -> instruction) (sem: val -> val -> val),
+  (forall rd r1 n rs m,
+    exec_instr ge fn (insn rd r1 n) rs m =
+      Next (nextinstr (rs#rd <- (sem rs#r1 (Vlong (Int64.repr n))))) m) ->
+  (forall v n1 n2, sem (sem v (Vlong n1)) (Vlong n2) = sem v (Vlong (Int64.add n1 n2))) ->
+  forall rd r1 n k rs m,
+  exists rs',
+     exec_straight ge fn (addimm_aux insn rd r1 (Int64.unsigned n) k) rs m k rs' m
+  /\ rs'#rd = sem rs#r1 (Vlong n)
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  intros insn sem SEM ASSOC; intros. unfold addimm_aux.
+  set (nlo := Zzero_ext 12 (Int64.unsigned n)). set (nhi := Int64.unsigned n - nlo).
+  assert (E: Int64.unsigned n = nhi + nlo) by (unfold nhi; omega).
+  rewrite <- (Int64.repr_unsigned n).
+  destruct (Z.eqb_spec nhi 0); [|destruct (Z.eqb_spec nlo 0)].
+- econstructor; split. apply exec_straight_one. apply SEM. Simpl. 
+  split. Simpl. do 3 f_equal; omega.
+  intros; Simpl.
+- econstructor; split. apply exec_straight_one. apply SEM. Simpl. 
+  split. Simpl. do 3 f_equal; omega.
+  intros; Simpl.
+- econstructor; split. eapply exec_straight_two.
+  apply SEM. apply SEM. Simpl. Simpl.
+  split. Simpl. rewrite ASSOC. do 2 f_equal. apply Int64.eqm_samerepr.
+  rewrite E. auto with ints.
+  intros; Simpl.
+Qed.
+
+Lemma exec_addimm64:
+  forall rd r1 n k rs m,
+  preg_of_iregsp r1 <> X16 ->
+  exists rs',
+     exec_straight ge fn (addimm64 rd r1 n k) rs m k rs' m
+  /\ rs'#rd = Val.addl rs#r1 (Vlong n)
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  intros. 
+  unfold addimm64. set (nn := Int64.neg n).
+  destruct (Int64.eq n (Int64.zero_ext 24 n)); [| destruct (Int64.eq nn (Int64.zero_ext 24 nn))].
+- apply exec_addimm_aux_64 with (sem := Val.addl). auto. intros; apply Val.addl_assoc. 
+- rewrite <- Val.subl_opp_addl.
+  apply exec_addimm_aux_64 with (sem := Val.subl). auto.
+  intros. rewrite ! Val.subl_addl_opp, Val.addl_assoc. rewrite Int64.neg_add_distr. auto.
+- destruct (Int64.lt n Int64.zero).
++ rewrite <- Val.subl_opp_addl; fold nn.
+  edestruct (exec_loadimm64 X16 nn) as (rs1 & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. eapply exec_straight_one. simpl; eauto. Simpl. 
+  split. Simpl. rewrite B, C; eauto with asmgen. simpl. rewrite Int64.shl'_zero. auto.
+  intros; Simpl.
++ edestruct (exec_loadimm64 X16 n) as (rs1 & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. eapply exec_straight_one. simpl; eauto. Simpl. 
+  split. Simpl. rewrite B, C; eauto with asmgen. simpl. rewrite Int64.shl'_zero. auto.
+  intros; Simpl.
+Qed.
+
+(** Logical immediate *)
+
+Lemma exec_logicalimm32:
+  forall (insn1: ireg -> ireg0 -> Z -> instruction)
+         (insn2: ireg -> ireg0 -> ireg -> shift_op -> instruction)
+         (sem: val -> val -> val),
+  (forall rd r1 n rs m,
+    exec_instr ge fn (insn1 rd r1 n) rs m =
+      Next (nextinstr (rs#rd <- (sem rs##r1 (Vint (Int.repr n))))) m) ->
+  (forall rd r1 r2 s rs m,
+    exec_instr ge fn (insn2 rd r1 r2 s) rs m =
+      Next (nextinstr (rs#rd <- (sem rs##r1 (eval_shift_op_int rs#r2 s)))) m) ->
+  forall rd r1 n k rs m,
+  r1 <> X16 ->
+  exists rs',
+     exec_straight ge fn (logicalimm32 insn1 insn2 rd r1 n k) rs m k rs' m
+  /\ rs'#rd = sem rs#r1 (Vint n)
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  intros until sem; intros SEM1 SEM2; intros. unfold logicalimm32.
+  destruct (is_logical_imm32 n).
+- econstructor; split. 
+  apply exec_straight_one. apply SEM1. reflexivity. 
+  split. Simpl. rewrite Int.repr_unsigned; auto. intros; Simpl.
+- edestruct (exec_loadimm32 X16 n) as (rs1 & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A.  
+  apply exec_straight_one. apply SEM2. reflexivity.
+  split. Simpl. f_equal; auto. apply C; auto with asmgen.
+  intros; Simpl. 
+Qed.
+
+Lemma exec_logicalimm64:
+  forall (insn1: ireg -> ireg0 -> Z -> instruction)
+         (insn2: ireg -> ireg0 -> ireg -> shift_op -> instruction)
+         (sem: val -> val -> val),
+  (forall rd r1 n rs m,
+    exec_instr ge fn (insn1 rd r1 n) rs m =
+      Next (nextinstr (rs#rd <- (sem rs###r1 (Vlong (Int64.repr n))))) m) ->
+  (forall rd r1 r2 s rs m,
+    exec_instr ge fn (insn2 rd r1 r2 s) rs m =
+      Next (nextinstr (rs#rd <- (sem rs###r1 (eval_shift_op_long rs#r2 s)))) m) ->
+  forall rd r1 n k rs m,
+  r1 <> X16 ->
+  exists rs',
+     exec_straight ge fn (logicalimm64 insn1 insn2 rd r1 n k) rs m k rs' m
+  /\ rs'#rd = sem rs#r1 (Vlong n)
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  intros until sem; intros SEM1 SEM2; intros. unfold logicalimm64.
+  destruct (is_logical_imm64 n).
+- econstructor; split. 
+  apply exec_straight_one. apply SEM1. reflexivity. 
+  split. Simpl. rewrite Int64.repr_unsigned. auto. intros; Simpl.
+- edestruct (exec_loadimm64 X16 n) as (rs1 & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A.  
+  apply exec_straight_one. apply SEM2. reflexivity.
+  split. Simpl. f_equal; auto. apply C; auto with asmgen.
+  intros; Simpl. 
+Qed.
+
+(** Load address of symbol *)
+
+Lemma exec_loadsymbol: forall rd s ofs k rs m,
+  rd <> X16 \/ Archi.pic_code tt = false ->
+  exists rs',
+     exec_straight ge fn (loadsymbol rd s ofs k) rs m k rs' m
+  /\ rs'#rd = Genv.symbol_address ge s ofs
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold loadsymbol; intros. destruct (Archi.pic_code tt).
+- predSpec Ptrofs.eq Ptrofs.eq_spec ofs Ptrofs.zero.
++ subst ofs. econstructor; split.
+  apply exec_straight_one; [simpl; eauto | reflexivity].
+  split. Simpl. intros; Simpl.
++ exploit exec_addimm64. instantiate (1 := rd). simpl. destruct H; congruence.
+  intros (rs1 & A & B & C).
+  econstructor; split.
+  econstructor. simpl; eauto. auto. eexact A. 
+  split. simpl in B; rewrite B. Simpl. 
+  rewrite <- Genv.shift_symbol_address_64 by auto.
+  rewrite Ptrofs.add_zero_l, Ptrofs.of_int64_to_int64 by auto. auto.
+  intros. rewrite C by auto. Simpl.
+- econstructor; split.
+  eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto.
+  split. Simpl. rewrite symbol_high_low; auto. 
+  intros; Simpl.
+Qed.
+
+(** Shifted operands *)
+
+Remark transl_shift_not_none:
+  forall s a, transl_shift s a <> SOnone.
+Proof.
+  destruct s; intros; simpl; congruence.
+Qed.
+
+Remark or_zero_eval_shift_op_int:
+  forall v s, s <> SOnone -> Val.or (Vint Int.zero) (eval_shift_op_int v s) = eval_shift_op_int v s.
+Proof.
+  intros; destruct s; try congruence; destruct v; auto; simpl;
+  destruct (Int.ltu n Int.iwordsize); auto; rewrite Int.or_zero_l; auto.
+Qed.
+
+Remark or_zero_eval_shift_op_long:
+  forall v s, s <> SOnone -> Val.orl (Vlong Int64.zero) (eval_shift_op_long v s) = eval_shift_op_long v s.
+Proof.
+  intros; destruct s; try congruence; destruct v; auto; simpl;
+  destruct (Int.ltu n Int64.iwordsize'); auto; rewrite Int64.or_zero_l; auto.
+Qed.
+
+Remark add_zero_eval_shift_op_long:
+  forall v s, s <> SOnone -> Val.addl (Vlong Int64.zero) (eval_shift_op_long v s) = eval_shift_op_long v s.
+Proof.
+  intros; destruct s; try congruence; destruct v; auto; simpl;
+  destruct (Int.ltu n Int64.iwordsize'); auto; rewrite Int64.add_zero_l; auto.
+Qed.
+
+Lemma transl_eval_shift: forall s v (a: amount32),
+  eval_shift_op_int v (transl_shift s a) = eval_shift s v a.
+Proof.
+  intros. destruct s; simpl; auto.
+Qed.
+
+Lemma transl_eval_shift': forall s v (a: amount32),
+  Val.or (Vint Int.zero) (eval_shift_op_int v (transl_shift s a)) = eval_shift s v a.
+Proof.
+  intros. rewrite or_zero_eval_shift_op_int by (apply transl_shift_not_none).
+  apply transl_eval_shift.
+Qed.
+
+Lemma transl_eval_shiftl: forall s v (a: amount64),
+  eval_shift_op_long v (transl_shift s a) = eval_shiftl s v a.
+Proof.
+  intros. destruct s; simpl; auto.
+Qed.
+
+Lemma transl_eval_shiftl': forall s v (a: amount64),
+  Val.orl (Vlong Int64.zero) (eval_shift_op_long v (transl_shift s a)) = eval_shiftl s v a.
+Proof.
+  intros. rewrite or_zero_eval_shift_op_long by (apply transl_shift_not_none).
+  apply transl_eval_shiftl.
+Qed.
+
+Lemma transl_eval_shiftl'': forall s v (a: amount64),
+  Val.addl (Vlong Int64.zero) (eval_shift_op_long v (transl_shift s a)) = eval_shiftl s v a.
+Proof.
+  intros. rewrite add_zero_eval_shift_op_long by (apply transl_shift_not_none).
+  apply transl_eval_shiftl.
+Qed.
+
+(** Zero- and Sign- extensions *)
+
+Lemma exec_move_extended_base: forall rd r1 ex k rs m,
+  exists rs',
+     exec_straight ge fn (move_extended_base rd r1 ex k) rs m k rs' m
+  /\ rs' rd = match ex with Xsgn32 => Val.longofint rs#r1 | Xuns32 => Val.longofintu rs#r1 end
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold move_extended_base; destruct ex; econstructor;
+  (split; [apply exec_straight_one; [simpl;eauto|auto] | split; [Simpl|intros;Simpl]]).
+Qed.
+
+Lemma exec_move_extended: forall rd r1 ex (a: amount64) k rs m,
+  exists rs',
+     exec_straight ge fn (move_extended rd r1 ex a k) rs m k rs' m
+  /\ rs' rd = Op.eval_extend ex rs#r1 a
+  /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold move_extended; intros. predSpec Int.eq Int.eq_spec a Int.zero.
+- exploit (exec_move_extended_base rd r1 ex). intros (rs' & A & B & C).
+  exists rs'; split. eexact A. split. unfold Op.eval_extend. rewrite H. rewrite B.
+  destruct ex, (rs r1); simpl; auto; rewrite Int64.shl'_zero; auto.
+  auto.
+- Local Opaque Val.addl.
+  exploit (exec_move_extended_base rd r1 ex). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. apply exec_straight_one.
+  unfold exec_instr. change (SOlsl a) with (transl_shift Slsl a). rewrite transl_eval_shiftl''. eauto. auto.
+  split. Simpl. rewrite B. auto. 
+  intros; Simpl.
+Qed.
+
+Lemma exec_arith_extended:
+  forall (sem: val -> val -> val)
+         (insnX: iregsp -> iregsp -> ireg -> extend_op -> instruction)
+         (insnS: ireg -> ireg0 -> ireg -> shift_op -> instruction),
+  (forall rd r1 r2 x rs m,
+    exec_instr ge fn (insnX rd r1 r2 x) rs m =
+      Next (nextinstr (rs#rd <- (sem rs#r1 (eval_extend rs#r2 x)))) m) ->
+  (forall rd r1 r2 s rs m,
+    exec_instr ge fn (insnS rd r1 r2 s) rs m =
+      Next (nextinstr (rs#rd <- (sem rs###r1 (eval_shift_op_long rs#r2 s)))) m) ->
+  forall (rd r1 r2: ireg) (ex: extension) (a: amount64) (k: code) rs m,
+  r1 <> X16 ->
+  exists rs',
+     exec_straight ge fn (arith_extended insnX insnS rd r1 r2 ex a k) rs m k rs' m
+  /\ rs'#rd = sem rs#r1 (Op.eval_extend ex rs#r2 a)
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  intros sem insnX insnS EX ES; intros. unfold arith_extended. destruct (Int.ltu a (Int.repr 5)).
+- econstructor; split. 
+  apply exec_straight_one. rewrite EX; eauto. auto.
+  split. Simpl. f_equal. destruct ex; auto.
+  intros; Simpl.
+- exploit (exec_move_extended_base X16 r2 ex). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. apply exec_straight_one. 
+  rewrite ES. eauto. auto.
+  split. Simpl. unfold ir0x. rewrite C by eauto with asmgen. f_equal. 
+  rewrite B. destruct ex; auto.
+  intros; Simpl.
+Qed. 
+
+(** Extended right shift *)
+
+Lemma exec_shrx32: forall (rd r1: ireg) (n: int) k v (rs: regset) m,
+  Val.shrx rs#r1 (Vint n) = Some v ->
+  r1 <> X16 ->
+  exists rs',
+     exec_straight ge fn (shrx32 rd r1 n k) rs m k rs' m
+  /\ rs'#rd = v
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold shrx32; intros. apply Val.shrx_shr_2 in H.
+  destruct (Int.eq n Int.zero) eqn:E.
+- econstructor; split. apply exec_straight_one; [simpl;eauto|auto]. 
+  split. Simpl. subst v; auto. intros; Simpl.
+- econstructor; split. eapply exec_straight_three.
+  unfold exec_instr. rewrite or_zero_eval_shift_op_int by congruence. eauto.
+  simpl; eauto.
+  unfold exec_instr. rewrite or_zero_eval_shift_op_int by congruence. eauto.
+  auto. auto. auto.
+  split. subst v; Simpl. intros; Simpl.
+Qed.
+ 
+Lemma exec_shrx64: forall (rd r1: ireg) (n: int) k v (rs: regset) m,
+  Val.shrxl rs#r1 (Vint n) = Some v ->
+  r1 <> X16 ->
+  exists rs',
+     exec_straight ge fn (shrx64 rd r1 n k) rs m k rs' m
+  /\ rs'#rd = v
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r.
+Proof.
+  unfold shrx64; intros. apply Val.shrxl_shrl_2 in H.
+  destruct (Int.eq n Int.zero) eqn:E.
+- econstructor; split. apply exec_straight_one; [simpl;eauto|auto]. 
+  split. Simpl. subst v; auto. intros; Simpl.
+- econstructor; split. eapply exec_straight_three.
+  unfold exec_instr. rewrite or_zero_eval_shift_op_long by congruence. eauto.
+  simpl; eauto.
+  unfold exec_instr. rewrite or_zero_eval_shift_op_long by congruence. eauto.
+  auto. auto. auto.
+  split. subst v; Simpl. intros; Simpl.
+Qed.
+
+(** Condition bits *)
+
+Lemma compare_int_spec: forall rs v1 v2 m,
+  let rs' := compare_int rs v1 v2 m in
+     rs'#CN = (Val.negative (Val.sub v1 v2))
+  /\ rs'#CZ = (Val.cmpu (Mem.valid_pointer m) Ceq v1 v2)
+  /\ rs'#CC = (Val.cmpu (Mem.valid_pointer m) Cge v1 v2)
+  /\ rs'#CV = (Val.sub_overflow v1 v2).
+Proof.
+  intros; unfold rs'; auto.
+Qed.
+
+Lemma eval_testcond_compare_sint: forall c v1 v2 b rs m,
+  Val.cmp_bool c v1 v2 = Some b ->
+  eval_testcond (cond_for_signed_cmp c) (compare_int rs v1 v2 m) = Some b.
+Proof.
+  intros. generalize (compare_int_spec rs v1 v2 m). 
+  set (rs' := compare_int rs v1 v2 m). intros (B & C & D & E).
+  unfold eval_testcond; rewrite B, C, D, E.
+  destruct v1; try discriminate; destruct v2; try discriminate.
+  simpl in H; inv H.
+  unfold Val.cmpu; simpl. destruct c; simpl.
+- destruct (Int.eq i i0); auto.
+- destruct (Int.eq i i0); auto.
+- rewrite Int.lt_sub_overflow. destruct (Int.lt i i0); auto.
+- rewrite Int.lt_sub_overflow, Int.not_lt.
+  destruct (Int.eq i i0), (Int.lt i i0); auto.
+- rewrite Int.lt_sub_overflow, (Int.lt_not i). 
+  destruct (Int.eq i i0), (Int.lt i i0); auto.
+- rewrite Int.lt_sub_overflow. destruct (Int.lt i i0); auto.
+Qed.
+
+Lemma eval_testcond_compare_uint: forall c v1 v2 b rs m,
+  Val.cmpu_bool (Mem.valid_pointer m) c v1 v2 = Some b ->
+  eval_testcond (cond_for_unsigned_cmp c) (compare_int rs v1 v2 m) = Some b.
+Proof.
+  intros. generalize (compare_int_spec rs v1 v2 m). 
+  set (rs' := compare_int rs v1 v2 m). intros (B & C & D & E).
+  unfold eval_testcond; rewrite B, C, D, E.
+  destruct v1; try discriminate; destruct v2; try discriminate.
+  simpl in H; inv H.
+  unfold Val.cmpu; simpl. destruct c; simpl.
+- destruct (Int.eq i i0); auto.
+- destruct (Int.eq i i0); auto.
+- destruct (Int.ltu i i0); auto.
+- rewrite (Int.not_ltu i). destruct (Int.eq i i0), (Int.ltu i i0); auto.
+- rewrite (Int.ltu_not i). destruct (Int.eq i i0), (Int.ltu i i0); auto.
+- destruct (Int.ltu i i0); auto.
+Qed.
+
+Lemma compare_long_spec: forall rs v1 v2 m,
+  let rs' := compare_long rs v1 v2 m in
+     rs'#CN = (Val.negativel (Val.subl v1 v2))
+  /\ rs'#CZ = (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Ceq v1 v2))
+  /\ rs'#CC = (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Cge v1 v2))
+  /\ rs'#CV = (Val.subl_overflow v1 v2).
+Proof.
+  intros; unfold rs'; auto.
+Qed.
+
+Remark int64_sub_overflow:
+  forall x y,
+  Int.xor (Int.repr (Int64.unsigned (Int64.sub_overflow x y Int64.zero)))
+          (Int.repr (Int64.unsigned (Int64.negative (Int64.sub x y)))) =
+  (if Int64.lt x y then Int.one else Int.zero).
+Proof.
+  intros.
+  transitivity (Int.repr (Int64.unsigned (if Int64.lt x y then Int64.one else Int64.zero))).
+  rewrite <- (Int64.lt_sub_overflow x y).
+  unfold Int64.sub_overflow, Int64.negative.
+  set (s := Int64.signed x - Int64.signed y - Int64.signed Int64.zero).
+  destruct (zle Int64.min_signed s && zle s Int64.max_signed);
+  destruct (Int64.lt (Int64.sub x y) Int64.zero);
+  auto.
+  destruct (Int64.lt x y); auto.
+Qed.
+
+Lemma eval_testcond_compare_slong: forall c v1 v2 b rs m,
+  Val.cmpl_bool c v1 v2 = Some b ->
+  eval_testcond (cond_for_signed_cmp c) (compare_long rs v1 v2 m) = Some b.
+Proof.
+  intros. generalize (compare_long_spec rs v1 v2 m). 
+  set (rs' := compare_long rs v1 v2 m). intros (B & C & D & E).
+  unfold eval_testcond; rewrite B, C, D, E.
+  destruct v1; try discriminate; destruct v2; try discriminate.
+  simpl in H; inv H.
+  unfold Val.cmplu; simpl. destruct c; simpl.
+- destruct (Int64.eq i i0); auto.
+- destruct (Int64.eq i i0); auto.
+- rewrite int64_sub_overflow. destruct (Int64.lt i i0); auto.
+- rewrite int64_sub_overflow, Int64.not_lt.
+  destruct (Int64.eq i i0), (Int64.lt i i0); auto.
+- rewrite int64_sub_overflow, (Int64.lt_not i). 
+  destruct (Int64.eq i i0), (Int64.lt i i0); auto.
+- rewrite int64_sub_overflow. destruct (Int64.lt i i0); auto.
+Qed.
+
+Lemma eval_testcond_compare_ulong: forall c v1 v2 b rs m,
+  Val.cmplu_bool (Mem.valid_pointer m) c v1 v2 = Some b ->
+  eval_testcond (cond_for_unsigned_cmp c) (compare_long rs v1 v2 m) = Some b.
+Proof.
+  intros. generalize (compare_long_spec rs v1 v2 m). 
+  set (rs' := compare_long rs v1 v2 m). intros (B & C & D & E).
+  unfold eval_testcond; rewrite B, C, D, E; unfold Val.cmplu.
+  destruct v1; try discriminate; destruct v2; try discriminate; simpl in H.
+- (* int-int *)
+  inv H. destruct c; simpl.
++ destruct (Int64.eq i i0); auto.
++ destruct (Int64.eq i i0); auto.
++ destruct (Int64.ltu i i0); auto.
++ rewrite (Int64.not_ltu i). destruct (Int64.eq i i0), (Int64.ltu i i0); auto.
++ rewrite (Int64.ltu_not i). destruct (Int64.eq i i0), (Int64.ltu i i0); auto.
++ destruct (Int64.ltu i i0); auto.
+- (* int-ptr *)
+  simpl.
+  destruct (Int64.eq i Int64.zero &&
+            (Mem.valid_pointer m b0 (Ptrofs.unsigned i0)
+              || Mem.valid_pointer m b0 (Ptrofs.unsigned i0 - 1))); try discriminate.
+  destruct c; simpl in H; inv H; reflexivity.
+- (* ptr-int *)
+  simpl.
+  destruct (Int64.eq i0 Int64.zero &&
+            (Mem.valid_pointer m b0 (Ptrofs.unsigned i)
+              || Mem.valid_pointer m b0 (Ptrofs.unsigned i - 1))); try discriminate.
+  destruct c; simpl in H; inv H; reflexivity.
+- (* ptr-ptr *)
+  simpl. 
+  destruct (eq_block b0 b1).
++ destruct ((Mem.valid_pointer m b0 (Ptrofs.unsigned i)
+             || Mem.valid_pointer m b0 (Ptrofs.unsigned i - 1)) &&
+            (Mem.valid_pointer m b1 (Ptrofs.unsigned i0)
+             || Mem.valid_pointer m b1 (Ptrofs.unsigned i0 - 1)));
+  inv H.
+  destruct c; simpl.
+* destruct (Ptrofs.eq i i0); auto.
+* destruct (Ptrofs.eq i i0); auto.
+* destruct (Ptrofs.ltu i i0); auto.
+* rewrite (Ptrofs.not_ltu i). destruct (Ptrofs.eq i i0), (Ptrofs.ltu i i0); auto.
+* rewrite (Ptrofs.ltu_not i). destruct (Ptrofs.eq i i0), (Ptrofs.ltu i i0); auto.
+* destruct (Ptrofs.ltu i i0); auto.
++ destruct (Mem.valid_pointer m b0 (Ptrofs.unsigned i) &&
+            Mem.valid_pointer m b1 (Ptrofs.unsigned i0)); try discriminate.
+  destruct c; simpl in H; inv H; reflexivity.
+Qed.
+
+Lemma compare_float_spec: forall rs f1 f2,
+  let rs' := compare_float rs (Vfloat f1) (Vfloat f2) in
+     rs'#CN = (Val.of_bool (Float.cmp Clt f1 f2))
+  /\ rs'#CZ = (Val.of_bool (Float.cmp Ceq f1 f2))
+  /\ rs'#CC = (Val.of_bool (negb (Float.cmp Clt f1 f2)))
+  /\ rs'#CV = (Val.of_bool (negb (Float.ordered f1 f2))).
+Proof.
+  intros; auto.
+Qed.
+
+Lemma eval_testcond_compare_float: forall c v1 v2 b rs,
+  Val.cmpf_bool c v1 v2 = Some b ->
+  eval_testcond (cond_for_float_cmp c) (compare_float rs v1 v2) = Some b.
+Proof.
+  intros. destruct v1; try discriminate; destruct v2; simpl in H; inv H. 
+  generalize (compare_float_spec rs f f0). 
+  set (rs' := compare_float rs (Vfloat f) (Vfloat f0)).
+  intros (B & C & D & E).
+  unfold eval_testcond; rewrite B, C, D, E.
+Local Transparent Float.cmp Float.ordered.
+  unfold Float.cmp, Float.ordered;
+  destruct c; destruct (Float.compare f f0) as [[]|]; reflexivity.
+Qed.
+
+Lemma eval_testcond_compare_not_float: forall c v1 v2 b rs,
+  option_map negb (Val.cmpf_bool c v1 v2) = Some b ->
+  eval_testcond (cond_for_float_not_cmp c) (compare_float rs v1 v2) = Some b.
+Proof.
+  intros. destruct v1; try discriminate; destruct v2; simpl in H; inv H.
+  generalize (compare_float_spec rs f f0). 
+  set (rs' := compare_float rs (Vfloat f) (Vfloat f0)).
+  intros (B & C & D & E).
+  unfold eval_testcond; rewrite B, C, D, E.
+Local Transparent Float.cmp Float.ordered.
+  unfold Float.cmp, Float.ordered;
+  destruct c; destruct (Float.compare f f0) as [[]|]; reflexivity.
+Qed.
+
+Lemma compare_single_spec: forall rs f1 f2,
+  let rs' := compare_single rs (Vsingle f1) (Vsingle f2) in
+     rs'#CN = (Val.of_bool (Float32.cmp Clt f1 f2))
+  /\ rs'#CZ = (Val.of_bool (Float32.cmp Ceq f1 f2))
+  /\ rs'#CC = (Val.of_bool (negb (Float32.cmp Clt f1 f2)))
+  /\ rs'#CV = (Val.of_bool (negb (Float32.ordered f1 f2))).
+Proof.
+  intros; auto.
+Qed.
+
+Lemma eval_testcond_compare_single: forall c v1 v2 b rs,
+  Val.cmpfs_bool c v1 v2 = Some b ->
+  eval_testcond (cond_for_float_cmp c) (compare_single rs v1 v2) = Some b.
+Proof.
+  intros. destruct v1; try discriminate; destruct v2; simpl in H; inv H. 
+  generalize (compare_single_spec rs f f0). 
+  set (rs' := compare_single rs (Vsingle f) (Vsingle f0)).
+  intros (B & C & D & E).
+  unfold eval_testcond; rewrite B, C, D, E.
+Local Transparent Float32.cmp Float32.ordered.
+  unfold Float32.cmp, Float32.ordered;
+  destruct c; destruct (Float32.compare f f0) as [[]|]; reflexivity.
+Qed.
+
+Lemma eval_testcond_compare_not_single: forall c v1 v2 b rs,
+  option_map negb (Val.cmpfs_bool c v1 v2) = Some b ->
+  eval_testcond (cond_for_float_not_cmp c) (compare_single rs v1 v2) = Some b.
+Proof.
+  intros. destruct v1; try discriminate; destruct v2; simpl in H; inv H.
+  generalize (compare_single_spec rs f f0). 
+  set (rs' := compare_single rs (Vsingle f) (Vsingle f0)).
+  intros (B & C & D & E).
+  unfold eval_testcond; rewrite B, C, D, E.
+Local Transparent Float32.cmp Float32.ordered.
+  unfold Float32.cmp, Float32.ordered;
+  destruct c; destruct (Float32.compare f f0) as [[]|]; reflexivity.
+Qed.
+
+Remark compare_float_inv: forall rs v1 v2 r,
+  match r with CR _ => False | _ => True end ->
+  (nextinstr (compare_float rs v1 v2))#r = (nextinstr rs)#r.
+Proof.
+  intros; unfold compare_float.
+  destruct r; try contradiction; destruct v1; auto; destruct v2; auto.
+Qed.
+
+Remark compare_single_inv: forall rs v1 v2 r,
+  match r with CR _ => False | _ => True end ->
+  (nextinstr (compare_single rs v1 v2))#r = (nextinstr rs)#r.
+Proof.
+  intros; unfold compare_single.
+  destruct r; try contradiction; destruct v1; auto; destruct v2; auto.
+Qed.
+
+(** Translation of conditionals *)
+
+Ltac ArgsInv :=
+  repeat (match goal with
+  | [ H: Error _ = OK _ |- _ ] => discriminate
+  | [ H: match ?args with nil => _ | _ :: _ => _ end = OK _ |- _ ] => destruct args
+  | [ H: bind _ _ = OK _ |- _ ] => monadInv H
+  | [ H: match _ with left _ => _ | right _ => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv
+  | [ H: match _ with true => _ | false => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv
+  end);
+  subst;
+  repeat (match goal with
+  | [ H: ireg_of _ = OK _ |- _ ] => simpl in *; rewrite (ireg_of_eq _ _ H) in *
+  | [ H: freg_of _ = OK _ |- _ ] => simpl in *; rewrite (freg_of_eq _ _ H) in *
+  end).
+
+Lemma transl_cond_correct:
+  forall cond args k c rs m,
+  transl_cond cond args k = OK c ->
+  exists rs',
+     exec_straight ge fn c rs m k rs' m
+  /\ (forall b,
+      eval_condition cond (map rs (map preg_of args)) m = Some b ->
+      eval_testcond (cond_for_cond cond) rs' = Some b)
+  /\ forall r, data_preg r = true -> rs'#r = rs#r.
+Proof.
+  intros until m; intros TR. destruct cond; simpl in TR; ArgsInv.
+- (* Ccomp *)
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. apply eval_testcond_compare_sint; auto. 
+  destruct r; reflexivity || discriminate.
+- (* Ccompu *)
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. apply eval_testcond_compare_uint; auto. 
+  destruct r; reflexivity || discriminate.
+- (* Ccompimm *)
+  destruct (is_arith_imm32 n); [|destruct (is_arith_imm32 (Int.neg n))].
++ econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite Int.repr_unsigned. apply eval_testcond_compare_sint; auto. 
+  destruct r; reflexivity || discriminate.
++ econstructor; split.
+  apply exec_straight_one. simpl. rewrite Int.repr_unsigned, Int.neg_involutive. eauto. auto.
+  split; intros. apply eval_testcond_compare_sint; auto. 
+  destruct r; reflexivity || discriminate.
++ exploit (exec_loadimm32 X16 n). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. apply exec_straight_one.
+  simpl. rewrite B, C by eauto with asmgen. eauto. auto.
+  split; intros. apply eval_testcond_compare_sint; auto. 
+  transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen.
+- (* Ccompuimm *)
+  destruct (is_arith_imm32 n); [|destruct (is_arith_imm32 (Int.neg n))].
++ econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite Int.repr_unsigned. apply eval_testcond_compare_uint; auto. 
+  destruct r; reflexivity || discriminate.
++ econstructor; split.
+  apply exec_straight_one. simpl. rewrite Int.repr_unsigned, Int.neg_involutive. eauto. auto.
+  split; intros. apply eval_testcond_compare_uint; auto. 
+  destruct r; reflexivity || discriminate.
++ exploit (exec_loadimm32 X16 n). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. apply exec_straight_one.
+  simpl. rewrite B, C by eauto with asmgen. eauto. auto.
+  split; intros. apply eval_testcond_compare_uint; auto. 
+  transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen.
+- (* Ccompshift *)
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite transl_eval_shift. apply eval_testcond_compare_sint; auto. 
+  destruct r; reflexivity || discriminate.
+- (* Ccompushift *)
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite transl_eval_shift. apply eval_testcond_compare_uint; auto. 
+  destruct r; reflexivity || discriminate.
+- (* Cmaskzero *)
+  destruct (is_logical_imm32 n).
++ econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite Int.repr_unsigned. apply (eval_testcond_compare_sint Ceq); auto.
+  destruct r; reflexivity || discriminate.
++ exploit (exec_loadimm32 X16 n). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A.
+  apply exec_straight_one. simpl. rewrite B, C by eauto with asmgen. eauto. auto.
+  split; intros. apply (eval_testcond_compare_sint Ceq); auto.
+  transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen.
+- (* Cmasknotzero *)
+  destruct (is_logical_imm32 n).
++ econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite Int.repr_unsigned. apply (eval_testcond_compare_sint Cne); auto.
+  destruct r; reflexivity || discriminate.
++ exploit (exec_loadimm32 X16 n). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A.
+  apply exec_straight_one. simpl. rewrite B, C by eauto with asmgen. eauto. auto.
+  split; intros. apply (eval_testcond_compare_sint Cne); auto.
+  transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen.
+- (* Ccompl *)
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. apply eval_testcond_compare_slong; auto. 
+  destruct r; reflexivity || discriminate.
+- (* Ccomplu *)
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. apply eval_testcond_compare_ulong; auto. 
+  destruct r; reflexivity || discriminate.
+- (* Ccomplimm *)
+  destruct (is_arith_imm64 n); [|destruct (is_arith_imm64 (Int64.neg n))].
++ econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite Int64.repr_unsigned. apply eval_testcond_compare_slong; auto. 
+  destruct r; reflexivity || discriminate.
++ econstructor; split.
+  apply exec_straight_one. simpl. rewrite Int64.repr_unsigned, Int64.neg_involutive. eauto. auto.
+  split; intros. apply eval_testcond_compare_slong; auto. 
+  destruct r; reflexivity || discriminate.
++ exploit (exec_loadimm64 X16 n). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. apply exec_straight_one.
+  simpl. rewrite B, C by eauto with asmgen. eauto. auto.
+  split; intros. apply eval_testcond_compare_slong; auto. 
+  transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen.
+- (* Ccompluimm *)
+  destruct (is_arith_imm64 n); [|destruct (is_arith_imm64 (Int64.neg n))].
++ econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite Int64.repr_unsigned. apply eval_testcond_compare_ulong; auto. 
+  destruct r; reflexivity || discriminate.
++ econstructor; split.
+  apply exec_straight_one. simpl. rewrite Int64.repr_unsigned, Int64.neg_involutive. eauto. auto.
+  split; intros. apply eval_testcond_compare_ulong; auto. 
+  destruct r; reflexivity || discriminate.
++ exploit (exec_loadimm64 X16 n). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. apply exec_straight_one.
+  simpl. rewrite B, C by eauto with asmgen. eauto. auto.
+  split; intros. apply eval_testcond_compare_ulong; auto. 
+  transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen.
+- (* Ccomplshift *)
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite transl_eval_shiftl. apply eval_testcond_compare_slong; auto. 
+  destruct r; reflexivity || discriminate.
+- (* Ccomplushift *)
+  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite transl_eval_shiftl. apply eval_testcond_compare_ulong; auto. 
+  destruct r; reflexivity || discriminate.
+- (* Cmasklzero *)
+  destruct (is_logical_imm64 n).
++ econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite Int64.repr_unsigned. apply (eval_testcond_compare_slong Ceq); auto.
+  destruct r; reflexivity || discriminate.
++ exploit (exec_loadimm64 X16 n). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A.
+  apply exec_straight_one. simpl. rewrite B, C by eauto with asmgen. eauto. auto.
+  split; intros. apply (eval_testcond_compare_slong Ceq); auto.
+  transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen.
+- (* Cmasknotzero *)
+  destruct (is_logical_imm64 n).
++ econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+  split; intros. rewrite Int64.repr_unsigned. apply (eval_testcond_compare_slong Cne); auto.
+  destruct r; reflexivity || discriminate.
++ exploit (exec_loadimm64 X16 n). intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A.
+  apply exec_straight_one. simpl. rewrite B, C by eauto with asmgen. eauto. auto.
+  split; intros. apply (eval_testcond_compare_slong Cne); auto.
+  transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen.
+- (* Ccompf *)
+  econstructor; split. apply exec_straight_one. simpl; eauto.
+  rewrite compare_float_inv; auto.
+  split; intros. apply eval_testcond_compare_float; auto.
+  destruct r; discriminate || rewrite compare_float_inv; auto.
+- (* Cnotcompf *)
+  econstructor; split. apply exec_straight_one. simpl; eauto.
+  rewrite compare_float_inv; auto.
+  split; intros. apply eval_testcond_compare_not_float; auto.
+  destruct r; discriminate || rewrite compare_float_inv; auto.
+- (* Ccompfzero *)
+  econstructor; split. apply exec_straight_one. simpl; eauto.
+  rewrite compare_float_inv; auto.
+  split; intros. apply eval_testcond_compare_float; auto.
+  destruct r; discriminate || rewrite compare_float_inv; auto.
+- (* Cnotcompfzero *)
+  econstructor; split. apply exec_straight_one. simpl; eauto.
+  rewrite compare_float_inv; auto.
+  split; intros. apply eval_testcond_compare_not_float; auto.
+  destruct r; discriminate || rewrite compare_float_inv; auto.
+- (* Ccompfs *)
+  econstructor; split. apply exec_straight_one. simpl; eauto.
+  rewrite compare_single_inv; auto.
+  split; intros. apply eval_testcond_compare_single; auto.
+  destruct r; discriminate || rewrite compare_single_inv; auto.
+- (* Cnotcompfs *)
+  econstructor; split. apply exec_straight_one. simpl; eauto.
+  rewrite compare_single_inv; auto.
+  split; intros. apply eval_testcond_compare_not_single; auto.
+  destruct r; discriminate || rewrite compare_single_inv; auto.
+- (* Ccompfszero *)
+  econstructor; split. apply exec_straight_one. simpl; eauto.
+  rewrite compare_single_inv; auto.
+  split; intros. apply eval_testcond_compare_single; auto.
+  destruct r; discriminate || rewrite compare_single_inv; auto.
+- (* Cnotcompfszero *)
+  econstructor; split. apply exec_straight_one. simpl; eauto.
+  rewrite compare_single_inv; auto.
+  split; intros. apply eval_testcond_compare_not_single; auto.
+  destruct r; discriminate || rewrite compare_single_inv; auto.
+Qed.
+
+(** Translation of conditional branches *)
+
+Lemma transl_cond_branch_correct:
+  forall cond args lbl k c rs m b,
+  transl_cond_branch cond args lbl k = OK c ->
+  eval_condition cond (map rs (map preg_of args)) m = Some b ->
+  exists rs' insn,
+     exec_straight_opt ge fn c rs m (insn :: k) rs' m
+  /\ exec_instr ge fn insn rs' m =
+         (if b then goto_label fn lbl rs' m else Next (nextinstr rs') m)
+  /\ forall r, data_preg r = true -> rs'#r = rs#r.
+Proof.
+  intros until b; intros TR EV.
+  assert (DFL:
+    transl_cond_branch_default cond args lbl k = OK c ->
+    exists rs' insn,
+       exec_straight_opt ge fn c rs m (insn :: k) rs' m
+    /\ exec_instr ge fn insn rs' m =
+         (if b then goto_label fn lbl rs' m else Next (nextinstr rs') m)
+    /\ forall r, data_preg r = true -> rs'#r = rs#r).
+  {
+    unfold transl_cond_branch_default; intros.
+    exploit transl_cond_correct; eauto. intros (rs' & A & B & C).
+    exists rs', (Pbc (cond_for_cond cond) lbl); split.
+    apply exec_straight_opt_intro. eexact A.
+    split; auto. simpl. rewrite (B b) by auto. auto. 
+  }
+Local Opaque transl_cond transl_cond_branch_default.
+  destruct args as [ | a1 args]; simpl in TR; auto.
+  destruct args as [ | a2 args]; simpl in TR; auto.
+  destruct cond; simpl in TR; auto.
+- (* Ccompimm *)
+  destruct c0; auto; destruct (Int.eq n Int.zero) eqn:N0; auto; 
+  apply Int.same_if_eq in N0; subst n; ArgsInv.
++ (* Ccompimm Cne 0 *)
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl. destruct (rs x); simpl in EV; inv EV. simpl. auto.
++ (* Ccompimm Ceq 0 *)
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl. destruct (rs x); simpl in EV; inv EV. simpl. destruct (Int.eq i Int.zero); auto.
+- (* Ccompuimm *)
+  destruct c0; auto; destruct (Int.eq n Int.zero) eqn:N0; auto;
+  apply Int.same_if_eq in N0; subst n; ArgsInv.
++ (* Ccompuimm Cne 0 *)
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl. rewrite EV. auto.
++ (* Ccompuimm Ceq 0 *)
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl. rewrite (Val.negate_cmpu_bool (Mem.valid_pointer m) Cne), EV. destruct b; auto.
+- (* Cmaskzero *)
+  destruct (Int.is_power2 n) as [bit|] eqn:P2; auto. ArgsInv.
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl.
+  erewrite <- Int.mul_pow2, Int.mul_commut, Int.mul_one by eauto.
+  rewrite (Val.negate_cmp_bool Ceq), EV. destruct b; auto.
+- (* Cmasknotzero *)
+  destruct (Int.is_power2 n) as [bit|] eqn:P2; auto. ArgsInv.
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl.
+  erewrite <- Int.mul_pow2, Int.mul_commut, Int.mul_one by eauto.
+  rewrite EV. auto.
+- (* Ccomplimm *)
+  destruct c0; auto; destruct (Int64.eq n Int64.zero) eqn:N0; auto; 
+  apply Int64.same_if_eq in N0; subst n; ArgsInv.
++ (* Ccomplimm Cne 0 *)
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl. destruct (rs x); simpl in EV; inv EV. simpl. auto.
++ (* Ccomplimm Ceq 0 *)
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl. destruct (rs x); simpl in EV; inv EV. simpl. destruct (Int64.eq i Int64.zero); auto.
+- (* Ccompluimm *)
+  destruct c0; auto; destruct (Int64.eq n Int64.zero) eqn:N0; auto;
+  apply Int64.same_if_eq in N0; subst n; ArgsInv.
++ (* Ccompluimm Cne 0 *)
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl. rewrite EV. auto.
++ (* Ccompluimm Ceq 0 *)
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl. rewrite (Val.negate_cmplu_bool (Mem.valid_pointer m) Cne), EV. destruct b; auto.
+- (* Cmasklzero *)
+  destruct (Int64.is_power2' n) as [bit|] eqn:P2; auto. ArgsInv.
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl.
+  erewrite <- Int64.mul_pow2', Int64.mul_commut, Int64.mul_one by eauto.
+  rewrite (Val.negate_cmpl_bool Ceq), EV. destruct b; auto.
+- (* Cmasklnotzero *)
+  destruct (Int64.is_power2' n) as [bit|] eqn:P2; auto. ArgsInv.
+  do 2 econstructor; split.
+  apply exec_straight_opt_refl.
+  split; auto. simpl.
+  erewrite <- Int64.mul_pow2', Int64.mul_commut, Int64.mul_one by eauto.
+  rewrite EV. auto.
+Qed.
+
+(** Translation of arithmetic operations *)
+
+Ltac SimplEval H :=
+  match type of H with
+  | Some _ = None _ => discriminate
+  | Some _ = Some _ => inv H
+  | ?a = Some ?b => let A := fresh in assert (A: Val.maketotal a = b) by (rewrite H; reflexivity)
+end.
+
+Ltac TranslOpSimpl :=
+  econstructor; split;
+  [ apply exec_straight_one; [simpl; eauto | reflexivity]
+  | split; [ rewrite ? transl_eval_shift, ? transl_eval_shiftl;
+             apply Val.lessdef_same; Simpl; fail
+           | intros; Simpl; fail ] ].
+
+Ltac TranslOpBase :=
+  econstructor; split;
+  [ apply exec_straight_one; [simpl; eauto | reflexivity]
+  | split; [ rewrite ? transl_eval_shift, ? transl_eval_shiftl; Simpl
+           | intros; Simpl; fail ] ].
+
+Lemma transl_op_correct:
+  forall op args res k (rs: regset) m v c,
+  transl_op op args res k = OK c ->
+  eval_operation ge (rs#SP) op (map rs (map preg_of args)) m = Some v ->
+  exists rs',
+     exec_straight ge fn c rs m k rs' m
+  /\ Val.lessdef v rs'#(preg_of res)
+  /\ forall r, data_preg r = true -> r <> preg_of res -> preg_notin r (destroyed_by_op op) -> rs' r = rs r.
+Proof.
+Local Opaque Int.eq Int64.eq Val.add Val.addl Int.zwordsize Int64.zwordsize.
+  intros until c; intros TR EV.
+  unfold transl_op in TR; destruct op; ArgsInv; simpl in EV; SimplEval EV; try TranslOpSimpl.
+- (* move *)
+  destruct (preg_of res) eqn:RR; try discriminate; destruct (preg_of m0) eqn:R1; inv TR.
++ TranslOpSimpl.
++ TranslOpSimpl.
+- (* intconst *)
+  exploit exec_loadimm32. intros (rs' & A & B & C).
+  exists rs'; split. eexact A. split. rewrite B; auto. intros; auto with asmgen.
+- (* longconst *)
+  exploit exec_loadimm64. intros (rs' & A & B & C).
+  exists rs'; split. eexact A. split. rewrite B; auto. intros; auto with asmgen.
+- (* floatconst *)
+  destruct (Float.eq_dec n Float.zero).
++ subst n. TranslOpSimpl. 
++ TranslOpSimpl.
+- (* singleconst *)
+  destruct (Float32.eq_dec n Float32.zero).
++ subst n. TranslOpSimpl. 
++ TranslOpSimpl.
+- (* loadsymbol *)
+  exploit (exec_loadsymbol x id ofs). eauto with asmgen. intros (rs' & A & B & C).
+  exists rs'; split. eexact A. split. rewrite B; auto. auto.
+- (* addrstack *)
+  exploit (exec_addimm64 x XSP (Ptrofs.to_int64 ofs)). simpl; eauto with asmgen.
+  intros (rs' & A & B & C).
+  exists rs'; split. eexact A. split. simpl in B; rewrite B.
+Local Transparent Val.addl.
+  destruct (rs SP); simpl; auto. rewrite Ptrofs.of_int64_to_int64 by auto. auto.
+  auto.
+- (* shift *)
+  rewrite <- transl_eval_shift'. TranslOpSimpl.
+- (* addimm *)
+  exploit (exec_addimm32 x x0 n). eauto with asmgen. intros (rs' & A & B & C).
+  exists rs'; split. eexact A. split. rewrite B; auto. auto.
+- (* mul *)
+  TranslOpBase.
+Local Transparent Val.add.
+  destruct (rs x0); auto; destruct (rs x1); auto. simpl. rewrite Int.add_zero_l; auto.
+- (* andimm *)
+  exploit (exec_logicalimm32 (Pandimm W) (Pand W)). 
+  intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen.
+  intros (rs' & A & B & C). 
+  exists rs'; split. eexact A. split. rewrite B; auto. auto.
+- (* orimm *)
+  exploit (exec_logicalimm32 (Porrimm W) (Porr W)). 
+  intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen.
+  intros (rs' & A & B & C). 
+  exists rs'; split. eexact A. split. rewrite B; auto. auto.
+- (* xorimm *)
+  exploit (exec_logicalimm32 (Peorimm W) (Peor W)). 
+  intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen.
+  intros (rs' & A & B & C). 
+  exists rs'; split. eexact A. split. rewrite B; auto. auto.
+- (* not *)
+  TranslOpBase.
+  destruct (rs x0); auto. simpl. rewrite Int.or_zero_l; auto.
+- (* notshift *)
+  TranslOpBase.
+  destruct (eval_shift s (rs x0) a); auto. simpl. rewrite Int.or_zero_l; auto.
+- (* shrx *)
+  exploit (exec_shrx32 x x0 n); eauto with asmgen. intros (rs' & A & B & C).
+  econstructor; split. eexact A. split. rewrite B; auto. auto.
+- (* zero-ext *)
+  TranslOpBase.
+  destruct (rs x0); auto; simpl. rewrite Int.shl_zero. auto.
+- (* sign-ext *)
+  TranslOpBase.
+  destruct (rs x0); auto; simpl. rewrite Int.shl_zero. auto.
+- (* shlzext *)
+  TranslOpBase.
+  destruct (rs x0); simpl; auto. rewrite <- Int.shl_zero_ext_min; auto using a32_range.
+- (* shlsext *)
+  TranslOpBase.
+  destruct (rs x0); simpl; auto. rewrite <- Int.shl_sign_ext_min; auto using a32_range.
+- (* zextshr *)
+  TranslOpBase.
+  destruct (rs x0); simpl; auto. rewrite ! a32_range; simpl. rewrite <- Int.zero_ext_shru_min; auto using a32_range.
+- (* sextshr *)
+  TranslOpBase.
+  destruct (rs x0); simpl; auto. rewrite ! a32_range; simpl. rewrite <- Int.sign_ext_shr_min; auto using a32_range.
+- (* shiftl *)
+  rewrite <- transl_eval_shiftl'. TranslOpSimpl.
+- (* extend *)
+  exploit (exec_move_extended x0 x1 x a k). intros (rs' & A & B & C).
+  econstructor; split. eexact A. 
+  split. rewrite B; auto. eauto with asmgen.
+- (* addext *)
+  exploit (exec_arith_extended Val.addl Paddext (Padd X)).
+  auto. auto. instantiate (1 := x1). eauto with asmgen. intros (rs' & A & B & C).
+  econstructor; split. eexact A. split. rewrite B; auto. auto.
+- (* addlimm *)
+  exploit (exec_addimm64 x x0 n). simpl. generalize (ireg_of_not_X16 _ _ EQ1). congruence.
+  intros (rs' & A & B & C).
+  exists rs'; split. eexact A. split. simpl in B; rewrite B; auto. auto.
+- (* subext *)
+  exploit (exec_arith_extended Val.subl Psubext (Psub X)).
+  auto. auto. instantiate (1 := x1). eauto with asmgen. intros (rs' & A & B & C).
+  econstructor; split. eexact A. split. rewrite B; auto. auto.
+- (* mull *)
+  TranslOpBase.
+  destruct (rs x0); auto; destruct (rs x1); auto. simpl. rewrite Int64.add_zero_l; auto.
+- (* andlimm *)
+  exploit (exec_logicalimm64 (Pandimm X) (Pand X)). 
+  intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen.
+  intros (rs' & A & B & C). 
+  exists rs'; split. eexact A. split. rewrite B; auto. auto.
+- (* orlimm *)
+  exploit (exec_logicalimm64 (Porrimm X) (Porr X)). 
+  intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen.
+  intros (rs' & A & B & C). 
+  exists rs'; split. eexact A. split. rewrite B; auto. auto.
+- (* xorlimm *)
+  exploit (exec_logicalimm64 (Peorimm X) (Peor X)). 
+  intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen.
+  intros (rs' & A & B & C). 
+  exists rs'; split. eexact A. split. rewrite B; auto. auto.
+- (* notl *)
+  TranslOpBase.
+  destruct (rs x0); auto. simpl. rewrite Int64.or_zero_l; auto.
+- (* notlshift *)
+  TranslOpBase.
+  destruct (eval_shiftl s (rs x0) a); auto. simpl. rewrite Int64.or_zero_l; auto.
+- (* shrx *)
+  exploit (exec_shrx64 x x0 n); eauto with asmgen. intros (rs' & A & B & C).
+  econstructor; split. eexact A. split. rewrite B; auto. auto.
+- (* zero-ext-l *)
+  TranslOpBase.
+  destruct (rs x0); auto; simpl. rewrite Int64.shl'_zero. auto.
+- (* sign-ext-l *)
+  TranslOpBase.
+  destruct (rs x0); auto; simpl. rewrite Int64.shl'_zero. auto.
+- (* shllzext *)
+  TranslOpBase.
+  destruct (rs x0); simpl; auto. rewrite <- Int64.shl'_zero_ext_min; auto using a64_range.
+- (* shllsext *)
+  TranslOpBase.
+  destruct (rs x0); simpl; auto. rewrite <- Int64.shl'_sign_ext_min; auto using a64_range.
+- (* zextshrl *)
+  TranslOpBase.
+  destruct (rs x0); simpl; auto. rewrite ! a64_range; simpl. rewrite <- Int64.zero_ext_shru'_min; auto using a64_range.
+- (* sextshrl *)
+  TranslOpBase.
+  destruct (rs x0); simpl; auto. rewrite ! a64_range; simpl. rewrite <- Int64.sign_ext_shr'_min; auto using a64_range.
+- (* condition *)
+  exploit (transl_cond_correct cond args); eauto. intros (rs' & A & B & C).
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto.
+  split. Simpl. destruct (eval_condition cond (map rs (map preg_of args)) m) as [b|]; simpl in *.
+  rewrite (B b) by auto. auto. 
+  auto.
+  intros; Simpl.
+- (* select *)
+  destruct (preg_of res) eqn:RES; monadInv TR.
+  + (* integer *)
+    generalize (ireg_of_eq _ _ EQ) (ireg_of_eq _ _ EQ1); intros E1 E2; rewrite E1, E2.
+    exploit (transl_cond_correct cond args); eauto. intros (rs' & A & B & C).
+    econstructor; split.
+    eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto.
+    split. Simpl. destruct (eval_condition cond (map rs (map preg_of args)) m) as [b|]; simpl in *.
+    rewrite (B b) by auto. rewrite !C. apply Val.lessdef_normalize.
+    rewrite <- E2; auto with asmgen. rewrite <- E1; auto with asmgen.
+    auto.
+    intros; Simpl.
+  + (* FP *)
+    generalize (freg_of_eq _ _ EQ) (freg_of_eq _ _ EQ1); intros E1 E2; rewrite E1, E2.
+    exploit (transl_cond_correct cond args); eauto. intros (rs' & A & B & C).
+    econstructor; split.
+    eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto.
+    split. Simpl. destruct (eval_condition cond (map rs (map preg_of args)) m) as [b|]; simpl in *.
+    rewrite (B b) by auto. rewrite !C. apply Val.lessdef_normalize.
+    rewrite <- E2; auto with asmgen. rewrite <- E1; auto with asmgen.
+    auto.
+    intros; Simpl.
+Qed.
+
+(** Translation of addressing modes, loads, stores *)
+
+Lemma transl_addressing_correct:
+  forall sz addr args (insn: Asm.addressing -> instruction) k (rs: regset) m c b o,
+  transl_addressing sz addr args insn k = OK c ->
+  Op.eval_addressing ge (rs#SP) addr (map rs (map preg_of args)) = Some (Vptr b o) ->
+  exists ad rs',
+     exec_straight_opt ge fn c rs m (insn ad :: k) rs' m
+  /\ Asm.eval_addressing ge ad rs' = Vptr b o
+  /\ forall r, data_preg r = true -> rs' r = rs r.
+Proof.
+  intros until o; intros TR EV.
+  unfold transl_addressing in TR; destruct addr; ArgsInv; SimplEval EV.
+- (* Aindexed *)
+  destruct (offset_representable sz ofs); inv EQ0.
++ econstructor; econstructor; split. apply exec_straight_opt_refl.
+  auto.
++ exploit (exec_loadimm64 X16 ofs). intros (rs' & A & B & C).
+  econstructor; exists rs'; split. apply exec_straight_opt_intro; eexact A.
+  split. simpl. rewrite B, C by eauto with asmgen. auto.
+  eauto with asmgen.
+- (* Aindexed2 *)
+  econstructor; econstructor; split. apply exec_straight_opt_refl.
+  auto.
+- (* Aindexed2shift *)
+  destruct (Int.eq a Int.zero) eqn:E; [|destruct (Int.eq (Int.shl Int.one a) (Int.repr sz))]; inv EQ2.
++ apply Int.same_if_eq in E. rewrite E.
+  econstructor; econstructor; split. apply exec_straight_opt_refl.
+  split; auto. simpl.
+  rewrite Val.addl_commut in H0. destruct (rs x0); try discriminate.
+  unfold Val.shll. rewrite Int64.shl'_zero. auto.
++ econstructor; econstructor; split. apply exec_straight_opt_refl.
+  auto. 
++ econstructor; econstructor; split.
+  apply exec_straight_opt_intro. apply exec_straight_one. simpl; eauto. auto.
+  split. simpl. Simpl. rewrite H0. simpl. rewrite Ptrofs.add_zero. auto.
+  intros; Simpl.
+- (* Aindexed2ext *)
+  destruct (Int.eq a Int.zero || Int.eq (Int.shl Int.one a) (Int.repr sz)); inv EQ2.
++ econstructor; econstructor; split. apply exec_straight_opt_refl.
+  split; auto. destruct x; auto.
++ exploit (exec_arith_extended Val.addl Paddext (Padd X)); auto.
+  instantiate (1 := x0). eauto with asmgen.
+  intros (rs' & A & B & C).
+  econstructor; exists rs'; split.
+  apply exec_straight_opt_intro. eexact A. 
+  split. simpl. rewrite B. rewrite Val.addl_assoc. f_equal.
+  unfold Op.eval_extend; destruct x, (rs x1); simpl; auto; rewrite ! a64_range;
+  simpl; rewrite Int64.add_zero; auto.
+  intros. apply C; eauto with asmgen.
+- (* Aglobal *)
+  destruct (Ptrofs.eq (Ptrofs.modu ofs (Ptrofs.repr sz)) Ptrofs.zero && symbol_is_aligned id sz); inv TR.
++ econstructor; econstructor; split.
+  apply exec_straight_opt_intro. apply exec_straight_one. simpl; eauto. auto.
+  split. simpl. Simpl. rewrite symbol_high_low. simpl in EV. congruence.
+  intros; Simpl.
++ exploit (exec_loadsymbol X16 id ofs). auto. intros (rs' & A & B & C).
+  econstructor; exists rs'; split.
+  apply exec_straight_opt_intro. eexact A.
+  split. simpl. 
+  rewrite B. rewrite <- Genv.shift_symbol_address_64, Ptrofs.add_zero by auto. 
+  simpl in EV. congruence. 
+  auto with asmgen.
+- (* Ainstrack *)
+  assert (E: Val.addl (rs SP) (Vlong (Ptrofs.to_int64 ofs)) = Vptr b o).
+  { simpl in EV. inv EV. destruct (rs SP); simpl in H1; inv H1. simpl. 
+    rewrite Ptrofs.of_int64_to_int64 by auto. auto. }   
+  destruct (offset_representable sz (Ptrofs.to_int64 ofs)); inv TR.
++ econstructor; econstructor; split. apply exec_straight_opt_refl.
+  auto.
++ exploit (exec_loadimm64 X16 (Ptrofs.to_int64 ofs)). intros (rs' & A & B & C).
+  econstructor; exists rs'; split.
+  apply exec_straight_opt_intro. eexact A.
+  split. simpl. rewrite B, C by eauto with asmgen. auto.
+  auto with asmgen.
+Qed.
+
+Lemma transl_load_correct:
+  forall chunk addr args dst k c (rs: regset) m vaddr v,
+  transl_load chunk addr args dst k = OK c ->
+  Op.eval_addressing ge (rs#SP) addr (map rs (map preg_of args)) = Some vaddr ->
+  Mem.loadv chunk m vaddr = Some v ->
+  exists rs',
+     exec_straight ge fn c rs m k rs' m
+  /\ rs'#(preg_of dst) = v
+  /\ forall r, data_preg r = true -> r <> preg_of dst -> rs' r = rs r.
+Proof.
+  intros. destruct vaddr; try discriminate. 
+  assert (A: exists sz insn,
+                transl_addressing sz addr args insn k = OK c
+             /\ (forall ad rs', exec_instr ge fn (insn ad) rs' m =
+                              exec_load ge chunk (fun v => v) ad (preg_of dst) rs' m)).
+  {
+    destruct chunk; monadInv H;
+    try rewrite (ireg_of_eq _ _ EQ); try rewrite (freg_of_eq _ _ EQ);
+    do 2 econstructor; (split; [eassumption|auto]).
+  }
+  destruct A as (sz & insn & B & C).
+  exploit transl_addressing_correct. eexact B. eexact H0. intros (ad & rs' & P & Q & R).
+  assert (X: exec_load ge chunk (fun v => v) ad (preg_of dst) rs' m =
+             Next (nextinstr (rs'#(preg_of dst) <- v)) m).
+  { unfold exec_load. rewrite Q, H1. auto. }
+  econstructor; split.
+  eapply exec_straight_opt_right. eexact P.
+  apply exec_straight_one. rewrite C, X; eauto. Simpl. 
+  split. Simpl. intros; Simpl.
+Qed.
+
+Lemma transl_store_correct:
+  forall chunk addr args src k c (rs: regset) m vaddr m',
+  transl_store chunk addr args src k = OK c ->
+  Op.eval_addressing ge (rs#SP) addr (map rs (map preg_of args)) = Some vaddr ->
+  Mem.storev chunk m vaddr rs#(preg_of src) = Some m' ->
+  exists rs',
+     exec_straight ge fn c rs m k rs' m'
+  /\ forall r, data_preg r = true -> rs' r = rs r.
+Proof.
+  intros. destruct vaddr; try discriminate. 
+  set (chunk' := match chunk with Mint8signed => Mint8unsigned
+                                | Mint16signed => Mint16unsigned
+                                | _ => chunk end).
+  assert (A: exists sz insn,
+                transl_addressing sz addr args insn k = OK c
+             /\ (forall ad rs', exec_instr ge fn (insn ad) rs' m =
+                              exec_store ge chunk' ad rs'#(preg_of src) rs' m)).
+  {
+    unfold chunk'; destruct chunk; monadInv H;
+    try rewrite (ireg_of_eq _ _ EQ); try rewrite (freg_of_eq _ _ EQ);
+    do 2 econstructor; (split; [eassumption|auto]).
+  }
+  destruct A as (sz & insn & B & C).
+  exploit transl_addressing_correct. eexact B. eexact H0. intros (ad & rs' & P & Q & R).
+  assert (X: Mem.storev chunk' m (Vptr b i) rs#(preg_of src) = Some m').
+  { rewrite <- H1. unfold chunk'. destruct chunk; auto; simpl; symmetry.
+    apply Mem.store_signed_unsigned_8.
+    apply Mem.store_signed_unsigned_16. }
+  assert (Y: exec_store ge chunk' ad rs'#(preg_of src) rs' m =
+             Next (nextinstr rs') m').
+  { unfold exec_store. rewrite Q, R, X by auto with asmgen. auto. }
+  econstructor; split.
+  eapply exec_straight_opt_right. eexact P.
+  apply exec_straight_one. rewrite C, Y; eauto. Simpl. 
+  intros; Simpl.
+Qed.
+
+(** Translation of indexed memory accesses *)
+
+Lemma indexed_memory_access_correct: forall insn sz (base: iregsp) ofs k (rs: regset) m b i,
+  preg_of_iregsp base <> IR X16 ->
+  Val.offset_ptr rs#base ofs = Vptr b i ->
+  exists ad rs',
+     exec_straight_opt ge fn (indexed_memory_access insn sz base ofs k) rs m (insn ad :: k) rs' m
+  /\ Asm.eval_addressing ge ad rs' = Vptr b i
+  /\ forall r, r <> PC -> r <> X16 -> rs' r = rs r.
+Proof.
+  unfold indexed_memory_access; intros.
+  assert (Val.addl rs#base (Vlong (Ptrofs.to_int64 ofs)) = Vptr b i).
+  { destruct (rs base); try discriminate. simpl in *. rewrite Ptrofs.of_int64_to_int64 by auto. auto. }
+  destruct offset_representable.
+- econstructor; econstructor; split. apply exec_straight_opt_refl. auto. 
+- exploit (exec_loadimm64 X16); eauto. intros (rs' & A & B & C).
+  econstructor; econstructor; split. apply exec_straight_opt_intro; eexact A.
+  split. simpl. rewrite B, C by eauto with asmgen. auto. auto.
+Qed.
+
+Lemma loadptr_correct: forall (base: iregsp) ofs dst k m v (rs: regset),
+  Mem.loadv Mint64 m (Val.offset_ptr rs#base ofs) = Some v ->
+  preg_of_iregsp base <> IR X16 ->
+  exists rs',
+     exec_straight ge fn (loadptr base ofs dst k) rs m k rs' m
+  /\ rs'#dst = v
+  /\ forall r, r <> PC -> r <> X16 -> r <> dst -> rs' r = rs r.
+Proof.
+  intros. 
+  destruct (Val.offset_ptr rs#base ofs) eqn:V; try discriminate.
+  exploit indexed_memory_access_correct; eauto. intros (ad & rs' & A & B & C). 
+  econstructor; split.
+  eapply exec_straight_opt_right. eexact A.
+  apply exec_straight_one. simpl. unfold exec_load. rewrite B, H. eauto. auto.
+  split. Simpl. intros; Simpl.
+Qed.
+
+Lemma storeptr_correct: forall (base: iregsp) ofs (src: ireg) k m m' (rs: regset),
+  Mem.storev Mint64 m (Val.offset_ptr rs#base ofs) rs#src = Some m' ->
+  preg_of_iregsp base <> IR X16 ->
+  src <> X16 ->
+  exists rs',
+     exec_straight ge fn (storeptr src base ofs k) rs m k rs' m'
+  /\ forall r, r <> PC -> r <> X16 -> rs' r = rs r.
+Proof.
+  intros. 
+  destruct (Val.offset_ptr rs#base ofs) eqn:V; try discriminate.
+  exploit indexed_memory_access_correct; eauto. intros (ad & rs' & A & B & C). 
+  econstructor; split.
+  eapply exec_straight_opt_right. eexact A.
+  apply exec_straight_one. simpl. unfold exec_store. rewrite B, C, H by eauto with asmgen. eauto. auto.
+  intros; Simpl.
+Qed.
+
+Lemma loadind_correct: forall (base: iregsp) ofs ty dst k c (rs: regset) m v,
+  loadind base ofs ty dst k = OK c ->
+  Mem.loadv (chunk_of_type ty) m (Val.offset_ptr rs#base ofs) = Some v ->
+  preg_of_iregsp base <> IR X16 ->
+  exists rs',
+     exec_straight ge fn c rs m k rs' m
+  /\ rs'#(preg_of dst) = v
+  /\ forall r, data_preg r = true -> r <> preg_of dst -> rs' r = rs r.
+Proof.
+  intros. 
+  destruct (Val.offset_ptr rs#base ofs) eqn:V; try discriminate.
+  assert (X: exists sz insn,
+                c = indexed_memory_access insn sz base ofs k
+             /\ (forall ad rs', exec_instr ge fn (insn ad) rs' m =
+                              exec_load ge (chunk_of_type ty) (fun v => v) ad (preg_of dst) rs' m)).
+  {
+    unfold loadind in H; destruct ty; destruct (preg_of dst); inv H; do 2 econstructor; eauto.
+  }
+  destruct X as (sz & insn & EQ & SEM). subst c.
+  exploit indexed_memory_access_correct; eauto. intros (ad & rs' & A & B & C). 
+  econstructor; split.
+  eapply exec_straight_opt_right. eexact A.
+  apply exec_straight_one. rewrite SEM. unfold exec_load. rewrite B, H0. eauto. Simpl.
+  split. Simpl. intros; Simpl.
+Qed.
+
+Lemma storeind_correct: forall (base: iregsp) ofs ty src k c (rs: regset) m m',
+  storeind src base ofs ty k = OK c ->
+  Mem.storev (chunk_of_type ty) m (Val.offset_ptr rs#base ofs) rs#(preg_of src) = Some m' ->
+  preg_of_iregsp base <> IR X16 ->
+  exists rs',
+     exec_straight ge fn c rs m k rs' m'
+  /\ forall r, data_preg r = true -> rs' r = rs r.
+Proof.
+  intros. 
+  destruct (Val.offset_ptr rs#base ofs) eqn:V; try discriminate.
+  assert (X: exists sz insn,
+                c = indexed_memory_access insn sz base ofs k
+             /\ (forall ad rs', exec_instr ge fn (insn ad) rs' m =
+                              exec_store ge (chunk_of_type ty) ad rs'#(preg_of src) rs' m)).
+  {
+    unfold storeind in H; destruct ty; destruct (preg_of src); inv H; do 2 econstructor; eauto.
+  }
+  destruct X as (sz & insn & EQ & SEM). subst c.
+  exploit indexed_memory_access_correct; eauto. intros (ad & rs' & A & B & C). 
+  econstructor; split.
+  eapply exec_straight_opt_right. eexact A.
+  apply exec_straight_one. rewrite SEM.
+  unfold exec_store. rewrite B, C, H0 by eauto with asmgen. eauto.
+  Simpl.
+  intros; Simpl.
+Qed.
+
+Lemma make_epilogue_correct:
+  forall ge0 f m stk soff cs m' ms rs k tm,
+  load_stack m (Vptr stk soff) Tptr f.(fn_link_ofs) = Some (parent_sp cs) ->
+  load_stack m (Vptr stk soff) Tptr f.(fn_retaddr_ofs) = Some (parent_ra cs) ->
+  Mem.free m stk 0 f.(fn_stacksize) = Some m' ->
+  agree ms (Vptr stk soff) rs ->
+  Mem.extends m tm ->
+  match_stack ge0 cs ->
+  exists rs', exists tm',
+     exec_straight ge fn (make_epilogue f k) rs tm k rs' tm'
+  /\ agree ms (parent_sp cs) rs'
+  /\ Mem.extends m' tm'
+  /\ rs'#RA = parent_ra cs
+  /\ rs'#SP = parent_sp cs
+  /\ (forall r, r <> PC -> r <> SP -> r <> X30 -> r <> X16 -> rs'#r = rs#r).
+Proof.
+  intros until tm; intros LP LRA FREE AG MEXT MCS.
+  exploit Mem.loadv_extends. eauto. eexact LP. auto. simpl. intros (parent' & LP' & LDP').
+  exploit Mem.loadv_extends. eauto. eexact LRA. auto. simpl. intros (ra' & LRA' & LDRA').
+  exploit lessdef_parent_sp; eauto. intros EQ; subst parent'; clear LDP'.
+  exploit lessdef_parent_ra; eauto. intros EQ; subst ra'; clear LDRA'.
+  exploit Mem.free_parallel_extends; eauto. intros (tm' & FREE' & MEXT').
+  unfold make_epilogue. 
+  exploit (loadptr_correct XSP (fn_retaddr_ofs f)).
+    instantiate (2 := rs). simpl. rewrite <- (sp_val _ _ _ AG). simpl. eexact LRA'. simpl; congruence.
+  intros (rs1 & A1 & B1 & C1).
+  econstructor; econstructor; split.
+  eapply exec_straight_trans. eexact A1. apply exec_straight_one. simpl. 
+    simpl; rewrite (C1 SP) by auto with asmgen. rewrite <- (sp_val _ _ _ AG). simpl; rewrite LP'. 
+    rewrite FREE'. eauto. auto. 
+  split. apply agree_nextinstr. apply agree_set_other; auto.
+  apply agree_change_sp with (Vptr stk soff).
+  apply agree_exten with rs; auto. intros; apply C1; auto with asmgen.
+  eapply parent_sp_def; eauto.
+  split. auto.
+  split. Simpl. 
+  split. Simpl. 
+  intros. Simpl.
+Qed.
+
+End CONSTRUCTORS.
\ No newline at end of file
diff --git a/cparser/Builtins.mli b/aarch64/Builtins1.v
index 7f9d78a9..53c83d7e 100644
--- a/cparser/Builtins.mli
+++ b/aarch64/Builtins1.v
@@ -2,7 +2,7 @@
 (*                                                                     *)
 (*              The Compcert verified compiler                         *)
 (*                                                                     *)
-(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
 (*                                                                     *)
 (*  Copyright Institut National de Recherche en Informatique et en     *)
 (*  Automatique.  All rights reserved.  This file is distributed       *)
@@ -13,13 +13,21 @@
 (*                                                                     *)
 (* *********************************************************************)
 
-val environment: unit -> Env.t
-val identifiers: unit -> C.ident list
-val declarations: unit -> C.globdecl list
+(** Platform-specific built-in functions *)
 
-type t = {
-  typedefs: (string * C.typ) list;
-  functions: (string * (C.typ * C.typ list * bool)) list
-}
+Require Import String Coqlib.
+Require Import AST Integers Floats Values.
+Require Import Builtins0.
 
-val set: t -> unit
+Inductive platform_builtin : Type := .
+
+Local Open Scope string_scope.
+
+Definition platform_builtin_table : list (string * platform_builtin) :=
+  nil.
+
+Definition platform_builtin_sig (b: platform_builtin) : signature :=
+  match b with end.
+
+Definition platform_builtin_sem (b: platform_builtin) : builtin_sem (sig_res (platform_builtin_sig b)) :=
+  match b with end.
diff --git a/aarch64/CBuiltins.ml b/aarch64/CBuiltins.ml
new file mode 100644
index 00000000..fdc1372d
--- /dev/null
+++ b/aarch64/CBuiltins.ml
@@ -0,0 +1,72 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Processor-dependent builtin C functions *)
+
+open C
+
+(* va_list is a struct of size 32 and alignment 8, passed by reference *)
+
+let va_list_type = TArray(TInt(IULong, []), Some 4L, [])
+let size_va_list = 32
+let va_list_scalar = false
+
+let builtins = {
+  builtin_typedefs = [
+    "__builtin_va_list", va_list_type
+  ];
+  builtin_functions = [
+    (* Synchronization *)
+    "__builtin_fence",
+      (TVoid [], [], false);
+    (* Integer arithmetic *)
+    "__builtin_bswap64",
+      (TInt(IULongLong, []), [TInt(IULongLong, [])], false);
+    "__builtin_clz",
+      (TInt(IInt, []), [TInt(IUInt, [])], false);
+    "__builtin_clzl",
+      (TInt(IInt, []), [TInt(IULong, [])], false);
+    "__builtin_clzll",
+      (TInt(IInt, []), [TInt(IULongLong, [])], false);
+    "__builtin_cls",
+      (TInt(IInt, []), [TInt(IInt, [])], false);
+    "__builtin_clsl",
+      (TInt(IInt, []), [TInt(ILong, [])], false);
+    "__builtin_clsll",
+      (TInt(IInt, []), [TInt(ILongLong, [])], false);
+    (* Float arithmetic *)
+    "__builtin_fmadd",
+      (TFloat(FDouble, []),
+       [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])],
+       false);
+    "__builtin_fmsub",
+      (TFloat(FDouble, []),
+       [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])],
+       false);
+    "__builtin_fnmadd",
+      (TFloat(FDouble, []),
+       [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])],
+       false);
+    "__builtin_fnmsub",
+      (TFloat(FDouble, []),
+       [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])],
+       false);
+    "__builtin_fmax",
+      (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, [])], false);
+    "__builtin_fmin",
+      (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, [])], false);
+  ]
+}
+
+(* Expand memory references inside extended asm statements.  Used in C2C. *)
+
+let asm_mem_argument arg = Printf.sprintf "[%s]" arg
diff --git a/aarch64/CombineOp.v b/aarch64/CombineOp.v
new file mode 100644
index 00000000..4d78c9a0
--- /dev/null
+++ b/aarch64/CombineOp.v
@@ -0,0 +1,137 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Recognition of combined operations, addressing modes and conditions
+  during the [CSE] phase. *)
+
+Require Import Coqlib.
+Require Import AST Integers.
+Require Import Op.
+Require Import CSEdomain.
+
+Section COMBINE.
+
+Variable get: valnum -> option rhs.
+
+Function combine_compimm_ne_0 (x: valnum) : option(condition * list valnum) :=
+  match get x with
+  | Some(Op (Ocmp c) ys) => Some (c, ys)
+  | _ => None
+  end.
+
+Function combine_compimm_eq_0 (x: valnum) : option(condition * list valnum) :=
+  match get x with
+  | Some(Op (Ocmp c) ys) => Some (negate_condition c, ys)
+  | _ => None
+  end.
+
+Function combine_compimm_eq_1 (x: valnum) : option(condition * list valnum) :=
+  match get x with
+  | Some(Op (Ocmp c) ys) => Some (c, ys)
+  | _ => None
+  end.
+
+Function combine_compimm_ne_1 (x: valnum) : option(condition * list valnum) :=
+  match get x with
+  | Some(Op (Ocmp c) ys) => Some (negate_condition c, ys)
+  | _ => None
+  end.
+
+Function combine_cond (cond: condition) (args: list valnum) : option(condition * list valnum) :=
+  match cond, args with
+  | Ccompimm Cne n, x::nil =>
+      if Int.eq_dec n Int.zero then combine_compimm_ne_0 x
+      else if Int.eq_dec n Int.one then combine_compimm_ne_1 x
+      else None
+  | Ccompimm Ceq n, x::nil =>
+      if Int.eq_dec n Int.zero then combine_compimm_eq_0 x
+      else if Int.eq_dec n Int.one then combine_compimm_eq_1 x
+      else None
+  | Ccompuimm Cne n, x::nil =>
+      if Int.eq_dec n Int.zero then combine_compimm_ne_0 x
+      else if Int.eq_dec n Int.one then combine_compimm_ne_1 x
+      else None
+  | Ccompuimm Ceq n, x::nil =>
+      if Int.eq_dec n Int.zero then combine_compimm_eq_0 x
+      else if Int.eq_dec n Int.one then combine_compimm_eq_1 x
+      else None
+  | _, _ => None
+  end.
+
+Function combine_addr (addr: addressing) (args: list valnum) : option(addressing * list valnum) :=
+  match addr, args with
+  | Aindexed n, x::nil =>
+      match get x with
+      | Some(Op (Oaddlimm m) ys) =>
+          Some(Aindexed (Int64.add m n), ys)
+      | _ => None
+      end
+  | _, _ => None
+  end.
+
+Function combine_op (op: operation) (args: list valnum) : option(operation * list valnum) :=
+  match op, args with
+  | Oaddimm n, x :: nil =>
+      match get x with
+      | Some(Op (Oaddimm m) ys) => Some(Oaddimm (Int.add m n), ys)
+      | _ => None
+      end
+  | Oandimm n, x :: nil =>
+      match get x with
+      | Some(Op (Oandimm m) ys) =>
+          Some(let p := Int.and m n in
+               if Int.eq p m then (Omove, x :: nil) else (Oandimm p, ys))
+      | _ => None
+      end
+  | Oorimm n, x :: nil =>
+      match get x with
+      | Some(Op (Oorimm m) ys) => Some(Oorimm (Int.or m n), ys)
+      | _ => None
+      end
+  | Oxorimm n, x :: nil =>
+      match get x with
+      | Some(Op (Oxorimm m) ys) => Some(Oxorimm (Int.xor m n), ys)
+      | _ => None
+      end
+  | Oaddlimm n, x :: nil =>
+      match get x with
+      | Some(Op (Oaddlimm m) ys) => Some(Oaddlimm (Int64.add m n), ys)
+      | _ => None
+      end
+  | Oandlimm n, x :: nil =>
+      match get x with
+      | Some(Op (Oandlimm m) ys) =>
+          Some(let p := Int64.and m n in
+               if Int64.eq p m then (Omove, x :: nil) else (Oandlimm p, ys))
+      | _ => None
+      end
+  | Oorlimm n, x :: nil =>
+      match get x with
+      | Some(Op (Oorlimm m) ys) => Some(Oorlimm (Int64.or m n), ys)
+      | _ => None
+      end
+  | Oxorlimm n, x :: nil =>
+      match get x with
+      | Some(Op (Oxorlimm m) ys) => Some(Oxorlimm (Int64.xor m n), ys)
+      | _ => None
+      end
+  | Ocmp cond, _ =>
+      match combine_cond cond args with
+      | Some(cond', args') => Some(Ocmp cond', args')
+      | None => None
+      end
+  | _, _ => None
+  end.
+
+End COMBINE.
+
+
diff --git a/aarch64/CombineOpproof.v b/aarch64/CombineOpproof.v
new file mode 100644
index 00000000..7d13b964
--- /dev/null
+++ b/aarch64/CombineOpproof.v
@@ -0,0 +1,161 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+Require Import FunInd.
+Require Import Coqlib.
+Require Import AST Integers Values Memory.
+Require Import Op Registers RTL.
+Require Import CSEdomain.
+Require Import CombineOp.
+
+Section COMBINE.
+
+Variable ge: genv.
+Variable sp: val.
+Variable m: mem.
+Variable get: valnum -> option rhs.
+Variable valu: valnum -> val.
+Hypothesis get_sound: forall v rhs, get v = Some rhs -> rhs_eval_to valu ge sp m rhs (valu v).
+
+Lemma get_op_sound:
+  forall v op vl, get v = Some (Op op vl) -> eval_operation ge sp op (map valu vl) m = Some (valu v).
+Proof.
+  intros. exploit get_sound; eauto. intros REV; inv REV; auto.
+Qed.
+
+Ltac UseGetSound :=
+  match goal with
+  | [ H: get _ = Some _ |- _ ] =>
+      let x := fresh "EQ" in (generalize (get_op_sound _ _ _ H); intros x; simpl in x; FuncInv)
+  end.
+
+Lemma combine_compimm_ne_0_sound:
+  forall x cond args,
+  combine_compimm_ne_0 get x = Some(cond, args) ->
+  eval_condition cond (map valu args) m = Val.cmp_bool Cne (valu x) (Vint Int.zero) /\
+  eval_condition cond (map valu args) m = Val.cmpu_bool (Mem.valid_pointer m) Cne (valu x) (Vint Int.zero).
+Proof.
+  intros until args. functional induction (combine_compimm_ne_0 get x); intros EQ; inv EQ.
+  (* of cmp *)
+  UseGetSound. rewrite <- H.
+  destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto.
+Qed.
+
+Lemma combine_compimm_eq_0_sound:
+  forall x cond args,
+  combine_compimm_eq_0 get x = Some(cond, args) ->
+  eval_condition cond (map valu args) m = Val.cmp_bool Ceq (valu x) (Vint Int.zero) /\
+  eval_condition cond (map valu args) m = Val.cmpu_bool (Mem.valid_pointer m) Ceq (valu x) (Vint Int.zero).
+Proof.
+  intros until args. functional induction (combine_compimm_eq_0 get x); intros EQ; inv EQ.
+  (* of cmp *)
+  UseGetSound. rewrite <- H.
+  rewrite eval_negate_condition.
+  destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto.
+Qed.
+
+Lemma combine_compimm_eq_1_sound:
+  forall x cond args,
+  combine_compimm_eq_1 get x = Some(cond, args) ->
+  eval_condition cond (map valu args) m = Val.cmp_bool Ceq (valu x) (Vint Int.one) /\
+  eval_condition cond (map valu args) m = Val.cmpu_bool (Mem.valid_pointer m) Ceq (valu x) (Vint Int.one).
+Proof.
+  intros until args. functional induction (combine_compimm_eq_1 get x); intros EQ; inv EQ.
+  (* of cmp *)
+  UseGetSound. rewrite <- H.
+  destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto.
+Qed.
+
+Lemma combine_compimm_ne_1_sound:
+  forall x cond args,
+  combine_compimm_ne_1 get x = Some(cond, args) ->
+  eval_condition cond (map valu args) m = Val.cmp_bool Cne (valu x) (Vint Int.one) /\
+  eval_condition cond (map valu args) m = Val.cmpu_bool (Mem.valid_pointer m) Cne (valu x) (Vint Int.one).
+Proof.
+  intros until args. functional induction (combine_compimm_ne_1 get x); intros EQ; inv EQ.
+  (* of cmp *)
+  UseGetSound. rewrite <- H.
+  rewrite eval_negate_condition.
+  destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto.
+Qed.
+
+Theorem combine_cond_sound:
+  forall cond args cond' args',
+  combine_cond get cond args = Some(cond', args') ->
+  eval_condition cond' (map valu args') m = eval_condition cond (map valu args) m.
+Proof.
+  intros. functional inversion H; subst.
+  (* compimm ne zero *)
+  - simpl; eapply combine_compimm_ne_0_sound; eauto.
+  (* compimm ne one *)
+  - simpl; eapply combine_compimm_ne_1_sound; eauto.
+  (* compimm eq zero *)
+  - simpl; eapply combine_compimm_eq_0_sound; eauto.
+  (* compimm eq one *)
+  - simpl; eapply combine_compimm_eq_1_sound; eauto.
+  (* compuimm ne zero *)
+  - simpl; eapply combine_compimm_ne_0_sound; eauto.
+  (* compuimm ne one *)
+  - simpl; eapply combine_compimm_ne_1_sound; eauto.
+  (* compuimm eq zero *)
+  - simpl; eapply combine_compimm_eq_0_sound; eauto.
+  (* compuimm eq one *)
+  - simpl; eapply combine_compimm_eq_1_sound; eauto.
+Qed.
+
+Theorem combine_addr_sound:
+  forall addr args addr' args',
+  combine_addr get addr args = Some(addr', args') ->
+  eval_addressing ge sp addr' (map valu args') = eval_addressing ge sp addr (map valu args).
+Proof.
+  intros. functional inversion H; subst.
+- (* indexed - addimml *)
+  UseGetSound. simpl. rewrite <- H0. rewrite Val.addl_assoc. auto. 
+Qed.
+
+Theorem combine_op_sound:
+  forall op args op' args',
+  combine_op get op args = Some(op', args') ->
+  eval_operation ge sp op' (map valu args') m = eval_operation ge sp op (map valu args) m.
+Proof.
+  intros. functional inversion H; subst.
+  (* addimm - addimm *)
+  - UseGetSound. FuncInv. simpl.
+    rewrite <- H0. rewrite Val.add_assoc. auto.
+  (* andimm - andimm *)
+  - UseGetSound; simpl.
+    generalize (Int.eq_spec p m0); rewrite H7; intros.
+    rewrite <- H0. rewrite Val.and_assoc. simpl. fold p. rewrite H1. auto.
+  - UseGetSound; simpl.
+    rewrite <- H0. rewrite Val.and_assoc. auto.
+  (* orimm - orimm *)
+  - UseGetSound. simpl. rewrite <- H0. rewrite Val.or_assoc. auto.
+  (* xorimm - xorimm *)
+  - UseGetSound. simpl. rewrite <- H0. rewrite Val.xor_assoc. auto.
+  (* addlimm - addlimm *)
+  - UseGetSound. FuncInv. simpl.
+    rewrite <- H0. rewrite Val.addl_assoc. auto.
+  (* andlimm - andlimm *)
+  - UseGetSound; simpl.
+    generalize (Int64.eq_spec p m0); rewrite H7; intros.
+    rewrite <- H0. rewrite Val.andl_assoc. simpl. fold p. rewrite H1. auto.
+  - UseGetSound; simpl.
+    rewrite <- H0. rewrite Val.andl_assoc. auto.
+  (* orlimm - orlimm *)
+  - UseGetSound. simpl. rewrite <- H0. rewrite Val.orl_assoc. auto.
+  (* xorlimm - xorlimm *)
+  - UseGetSound. simpl. rewrite <- H0. rewrite Val.xorl_assoc. auto.
+  (* cmp *)
+  - simpl. decEq; decEq. eapply combine_cond_sound; eauto.
+Qed.
+
+End COMBINE.
diff --git a/aarch64/ConstpropOp.vp b/aarch64/ConstpropOp.vp
new file mode 100644
index 00000000..c0a2c6bf
--- /dev/null
+++ b/aarch64/ConstpropOp.vp
@@ -0,0 +1,401 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Strength reduction for operators and conditions.
+    This is the machine-dependent part of [Constprop]. *)
+
+Require Archi.
+Require Import Coqlib Compopts.
+Require Import AST Integers Floats.
+Require Import Op Registers.
+Require Import ValueDomain ValueAOp.
+
+(** * Converting known values to constants *)
+
+Definition const_for_result (a: aval) : option operation :=
+  match a with
+  | I n => Some(Ointconst n)
+  | L n => Some(Olongconst n)
+  | F n => if Compopts.generate_float_constants tt then Some(Ofloatconst n) else None
+  | FS n => if Compopts.generate_float_constants tt then Some(Osingleconst n) else None
+  | Ptr(Gl id ofs) => Some(Oaddrsymbol id ofs)
+  | Ptr(Stk ofs) => Some(Oaddrstack ofs)
+  | _ => None
+  end.
+
+(** * Operator strength reduction *)
+
+Definition eval_static_shift (s: shift) (v: int) (n: amount32) : int :=
+  match s with
+  | Slsl => Int.shl v n
+  | Slsr => Int.shru v n
+  | Sasr => Int.shr v n
+  | Sror => Int.ror v n
+  end.
+
+Definition eval_static_shiftl (s: shift) (v: int64) (n: amount64) : int64 :=
+  match s with
+  | Slsl => Int64.shl' v n
+  | Slsr => Int64.shru' v n
+  | Sasr => Int64.shr' v n
+  | Sror => Int64.ror v (Int64.repr (Int.unsigned n))
+  end.
+
+Definition eval_static_extend (x: extension) (v: int) (n: amount64) : int64 :=
+  Int64.shl' (match x with Xsgn32 => Int64.repr (Int.signed v)
+                         | Xuns32 => Int64.repr (Int.unsigned v) end)
+             n.
+
+Nondetfunction cond_strength_reduction 
+              (cond: condition) (args: list reg) (vl: list aval) :=
+  match cond, args, vl with
+  | Ccomp c, r1 :: r2 :: nil, I n1 :: v2 :: nil =>
+      (Ccompimm (swap_comparison c) n1, r2 :: nil)
+  | Ccomp c, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
+      (Ccompimm c n2, r1 :: nil)
+  | Ccompu c, r1 :: r2 :: nil, I n1 :: v2 :: nil =>
+      (Ccompuimm (swap_comparison c) n1, r2 :: nil)
+  | Ccompu c, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
+      (Ccompuimm c n2, r1 :: nil)
+  | Ccompshift c s a, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
+      (Ccompimm c (eval_static_shift s n2 a), r1 :: nil)
+  | Ccompushift c s a, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
+      (Ccompuimm c (eval_static_shift s n2 a), r1 :: nil)
+  | Ccompl c, r1 :: r2 :: nil, L n1 :: v2 :: nil =>
+      (Ccomplimm (swap_comparison c) n1, r2 :: nil)
+  | Ccompl c, r1 :: r2 :: nil, v1 :: L n2 :: nil =>
+      (Ccomplimm c n2, r1 :: nil)
+  | Ccomplu c, r1 :: r2 :: nil, L n1 :: v2 :: nil =>
+      (Ccompluimm (swap_comparison c) n1, r2 :: nil)
+  | Ccomplu c, r1 :: r2 :: nil, v1 :: L n2 :: nil =>
+      (Ccompluimm c n2, r1 :: nil)
+  | Ccomplshift c s a, r1 :: r2 :: nil, v1 :: L n2 :: nil =>
+      (Ccomplimm c (eval_static_shiftl s n2 a), r1 :: nil)
+  | Ccomplushift c s a, r1 :: r2 :: nil, v1 :: L n2 :: nil =>
+      (Ccompluimm c (eval_static_shiftl s n2 a), r1 :: nil)
+  | Ccompf c, r1 :: r2 :: nil, F n1 :: v2 :: nil =>
+      if Float.eq_dec n1 Float.zero
+      then (Ccompfzero (swap_comparison c), r2 :: nil)
+      else (cond, args)
+  | Ccompf c, r1 :: r2 :: nil, v1 :: F n2 :: nil =>
+      if Float.eq_dec n2 Float.zero
+      then (Ccompfzero c, r1 :: nil)
+      else (cond, args)
+  | Cnotcompf c, r1 :: r2 :: nil, F n1 :: v2 :: nil =>
+      if Float.eq_dec n1 Float.zero
+      then (Cnotcompfzero (swap_comparison c), r2 :: nil)
+      else (cond, args)
+  | Cnotcompf c, r1 :: r2 :: nil, v1 :: F n2 :: nil =>
+      if Float.eq_dec n2 Float.zero
+      then (Cnotcompfzero c, r1 :: nil)
+      else (cond, args)
+  | Ccompfs c, r1 :: r2 :: nil, FS n1 :: v2 :: nil =>
+      if Float32.eq_dec n1 Float32.zero
+      then (Ccompfszero (swap_comparison c), r2 :: nil)
+      else (cond, args)
+  | Ccompfs c, r1 :: r2 :: nil, v1 :: FS n2 :: nil =>
+      if Float32.eq_dec n2 Float32.zero
+      then (Ccompfszero c, r1 :: nil)
+      else (cond, args)
+  | Cnotcompfs c, r1 :: r2 :: nil, FS n1 :: v2 :: nil =>
+      if Float32.eq_dec n1 Float32.zero
+      then (Cnotcompfszero (swap_comparison c), r2 :: nil)
+      else (cond, args)
+  | Cnotcompfs c, r1 :: r2 :: nil, v1 :: FS n2 :: nil =>
+      if Float32.eq_dec n2 Float32.zero
+      then (Cnotcompfszero c, r1 :: nil)
+      else (cond, args)
+  | _, _, _ => 
+      (cond, args)
+  end.
+
+Definition make_cmp_base (c: condition) (args: list reg) (vl: list aval) :=
+  let (c', args') := cond_strength_reduction c args vl in (Ocmp c', args').
+
+Definition make_cmp_imm_eq (c: condition) (args: list reg) (vl: list aval) 
+                           (n: int) (r1: reg) (v1: aval) :=
+  if Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1) then (Omove, r1 :: nil)
+  else if Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1) then (Oxorimm Int.one, r1 :: nil)
+  else make_cmp_base c args vl.
+
+Definition make_cmp_imm_ne (c: condition) (args: list reg) (vl: list aval) 
+                           (n: int) (r1: reg) (v1: aval) :=
+  if Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1) then (Omove, r1 :: nil)
+  else if Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1) then (Oxorimm Int.one, r1 :: nil)
+  else make_cmp_base c args vl.
+
+Nondetfunction make_cmp (c: condition) (args: list reg) (vl: list aval) :=
+  match c, args, vl with
+  | Ccompimm Ceq n, r1 :: nil, v1 :: nil =>
+      make_cmp_imm_eq c args vl n r1 v1
+  | Ccompimm Cne n, r1 :: nil, v1 :: nil =>
+      make_cmp_imm_ne c args vl n r1 v1
+  | Ccompuimm Ceq n, r1 :: nil, v1 :: nil =>
+      make_cmp_imm_eq c args vl n r1 v1
+  | Ccompuimm Cne n, r1 :: nil, v1 :: nil =>
+      make_cmp_imm_ne c args vl n r1 v1
+  | _, _, _ =>
+      make_cmp_base c args vl
+  end.
+
+Definition make_select (c: condition) (ty: typ)
+                       (r1 r2: reg) (args: list reg) (vl: list aval) :=
+  match resolve_branch (eval_static_condition c vl) with
+  | Some b => (Omove, (if b then r1 else r2) :: nil)
+  | None =>
+      let (c', args') := cond_strength_reduction c args vl in
+      (Osel c' ty, r1 :: r2 :: 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) (r1 r2: reg) :=
+  if Int.eq n Int.zero then (Omove, r1 :: nil)
+  else if Int.ltu n Int.iwordsize then (Oshift Slsl (mk_amount32 n), r1 :: nil)
+  else (Oshl, r1 :: r2 :: nil).
+
+Definition make_shrimm (n: int) (r1 r2: reg) :=
+  if Int.eq n Int.zero then (Omove, r1 :: nil)
+  else if Int.ltu n Int.iwordsize then (Oshift Sasr (mk_amount32 n), r1 :: nil)
+  else (Oshr, r1 :: r2 :: nil).
+
+Definition make_shruimm (n: int) (r1 r2: reg) :=
+  if Int.eq n Int.zero then (Omove, r1 :: nil)
+  else if Int.ltu n Int.iwordsize then (Oshift Slsr (mk_amount32 n), r1 :: nil)
+  else (Oshru, r1 :: r2 :: nil).
+
+Definition make_mulimm (n: int) (r1 r2: reg) :=
+  if Int.eq n Int.zero then
+    (Ointconst Int.zero, nil)
+  else if Int.eq n Int.one then
+    (Omove, r1 :: nil)
+  else
+    match Int.is_power2 n with
+    | Some l => (Oshift Slsl (mk_amount32 l), r1 :: nil)
+    | None => (Omul, r1 :: r2 :: nil)
+    end.
+
+Definition make_andimm (n: int) (r: reg) (a: aval) :=
+  if Int.eq n Int.zero then (Ointconst Int.zero, nil)
+  else if Int.eq n Int.mone then (Omove, r :: nil)
+  else if match a with Uns _ m => Int.eq (Int.zero_ext m (Int.not n)) Int.zero
+                     | _ => false end
+  then (Omove, r :: nil)
+  else (Oandimm n, r :: nil).
+
+Definition make_orimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero then (Omove, r :: nil)
+  else if Int.eq n Int.mone then (Ointconst Int.mone, nil)
+  else (Oorimm n, r :: nil).
+
+Definition make_xorimm (n: int) (r: reg) :=
+  if Int.eq n Int.zero then (Omove, r :: nil)
+  else (Oxorimm n, r :: nil).
+
+Definition make_divimm n (r1 r2: reg) :=
+  if Int.eq n Int.one then
+    (Omove, r1 :: nil)
+  else
+    match Int.is_power2 n with
+    | Some l => if Int.ltu l (Int.repr 31)
+                then (Oshrximm l, r1 :: nil)
+                else (Odiv, r1 :: r2 :: nil)
+    | None   => (Odiv, r1 :: r2 :: nil)
+    end.
+
+Definition make_divuimm n (r1 r2: reg) :=
+  if Int.eq n Int.one then
+    (Omove, r1 :: nil)
+  else
+    match Int.is_power2 n with
+    | Some l => (Oshift Slsr (mk_amount32 l), r1 :: nil)
+    | None   => (Odivu, r1 :: r2 :: nil)
+    end.
+
+Definition make_addlimm (n: int64) (r: reg) :=
+  if Int64.eq n Int64.zero
+  then (Omove, r :: nil)
+  else (Oaddlimm n, r :: nil).
+
+Definition make_shllimm (n: int) (r1 r2: reg) :=
+  if Int.eq n Int.zero then (Omove, r1 :: nil)
+  else if Int.ltu n Int64.iwordsize' then (Oshiftl Slsl (mk_amount64 n), r1 :: nil)
+  else (Oshll, r1 :: r2 :: nil).
+
+Definition make_shrlimm (n: int) (r1 r2: reg) :=
+  if Int.eq n Int.zero then (Omove, r1 :: nil)
+  else if Int.ltu n Int64.iwordsize' then (Oshiftl Sasr (mk_amount64 n), r1 :: nil)
+  else (Oshrl, r1 :: r2 :: nil).
+
+Definition make_shrluimm (n: int) (r1 r2: reg) :=
+  if Int.eq n Int.zero then (Omove, r1 :: nil)
+  else if Int.ltu n Int64.iwordsize' then (Oshiftl Slsr (mk_amount64 n), r1 :: nil)
+  else (Oshrlu, r1 :: r2 :: nil).
+
+Definition make_mullimm (n: int64) (r1 r2: reg) :=
+  if Int64.eq n Int64.zero then
+    (Olongconst Int64.zero, nil)
+  else if Int64.eq n Int64.one then
+    (Omove, r1 :: nil)
+  else
+    match Int64.is_power2' n with
+    | Some l => (Oshiftl Slsl (mk_amount64 l), r1 :: nil)
+    | None => (Omull, r1 :: r2 :: nil)
+    end.
+
+Definition make_andlimm (n: int64) (r: reg) (a: aval) :=
+  if Int64.eq n Int64.zero then (Olongconst Int64.zero, nil)
+  else if Int64.eq n Int64.mone then (Omove, r :: nil)
+  else (Oandlimm n, r :: nil).
+
+Definition make_orlimm (n: int64) (r: reg) :=
+  if Int64.eq n Int64.zero then (Omove, r :: nil)
+  else if Int64.eq n Int64.mone then (Olongconst Int64.mone, nil)
+  else (Oorlimm n, r :: nil).
+
+Definition make_xorlimm (n: int64) (r: reg) :=
+  if Int64.eq n Int64.zero then (Omove, r :: nil)
+  else (Oxorlimm n, r :: nil).
+
+Definition make_divlimm n (r1 r2: reg) :=
+  match Int64.is_power2' n with
+  | Some l => if Int.ltu l (Int.repr 63)
+              then (Oshrlximm l, r1 :: nil)
+              else (Odivl, r1 :: r2 :: nil)
+  | None   => (Odivl, r1 :: r2 :: nil)
+  end.
+
+Definition make_divluimm n (r1 r2: reg) :=
+  match Int64.is_power2' n with
+  | Some l => (Oshiftl Slsr (mk_amount64 l), r1 :: nil)
+  | None   => (Odivlu, r1 :: r2 :: nil)
+  end.
+
+Definition make_mulfimm (n: float) (r r1 r2: reg) :=
+  if Float.eq_dec n (Float.of_int (Int.repr 2))
+  then (Oaddf, r :: r :: nil)
+  else (Omulf, r1 :: r2 :: nil).
+
+Definition make_mulfsimm (n: float32) (r r1 r2: reg) :=
+  if Float32.eq_dec n (Float32.of_int (Int.repr 2))
+  then (Oaddfs, r :: r :: nil)
+  else (Omulfs, r1 :: r2 :: nil).
+
+Definition make_zext (s: Z) (r: reg) (a: aval) :=
+  if vincl a (Uns Ptop s) then (Omove, r :: nil) else (Ozext s, r :: nil).
+
+Definition make_sext (s: Z) (r: reg) (a: aval) :=
+  if vincl a (Sgn Ptop s) then (Omove, r :: nil) else (Osext s, r :: nil).
+
+Nondetfunction op_strength_reduction 
+              (op: operation) (args: list reg) (vl: list aval) :=
+  match op, args, vl with
+  | Oadd, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_addimm n1 r2
+  | Oadd, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm n2 r1
+  | Oaddshift s a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (eval_static_shift s n2 a) r1
+  | Osub, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (Int.neg n2) r1
+  | Osubshift s a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (Int.neg (eval_static_shift s n2 a)) r1
+  | Omul, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_mulimm n1 r2 r1
+  | Omul, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_mulimm n2 r1 r2
+  | Odiv, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_divimm n2 r1 r2
+  | Odivu, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_divuimm n2 r1 r2
+  | Oand, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_andimm n1 r2 v2
+  | Oand, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm n2 r1 v1
+  | Oandshift s a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm (eval_static_shift s n2 a) r1 v1
+  | Oandimm n, r1 :: nil, v1 :: nil => make_andimm n r1 v1
+  | Oor, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_orimm n1 r2
+  | Oor, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_orimm n2 r1
+  | Oorshift s a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_orimm (eval_static_shift s n2 a) r1
+  | Oxor, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_xorimm n1 r2
+  | Oxor, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_xorimm n2 r1
+  | Oxorshift s a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_xorimm (eval_static_shift s n2 a) r1
+  | Obic, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm (Int.not n2) r1 v1
+  | Obicshift s a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm (Int.not (eval_static_shift s n2 a)) r1 v1
+  | Oorn, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_orimm (Int.not n2) r1
+  | Oornshift s a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_orimm (Int.not (eval_static_shift s n2 a)) r1
+  | Oeqv, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_xorimm (Int.not n2) r1
+  | Oeqvshift s a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_xorimm (Int.not (eval_static_shift s n2 a)) r1
+  | Oshl, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shlimm n2 r1 r2
+  | Oshr, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shrimm n2 r1 r2
+  | Oshru, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shruimm n2 r1 r2
+  | Ozext s, r1 :: nil, v1 :: nil => make_zext s r1 v1
+  | Osext s, r1 :: nil, v1 :: nil => make_sext s r1 v1
+
+  | Oaddl, r1 :: r2 :: nil, L n1 :: v2 :: nil => make_addlimm n1 r2
+  | Oaddl, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_addlimm n2 r1
+  | Oaddlshift s a, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_addlimm (eval_static_shiftl s n2 a) r1
+  | Oaddlext x a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addlimm (eval_static_extend x n2 a) r1
+  | Osubl, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_addlimm (Int64.neg n2) r1
+  | Osublshift s a, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_addlimm (Int64.neg (eval_static_shiftl s n2 a)) r1
+  | Osublext x a, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addlimm (Int64.neg (eval_static_extend x n2 a)) r1
+  | Omull, r1 :: r2 :: nil, L n1 :: v2 :: nil => make_mullimm n1 r2 r1
+  | Omull, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_mullimm n2 r1 r2
+  | Odivl, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_divlimm n2 r1 r2
+  | Odivlu, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_divluimm n2 r1 r2
+  | Oandl, r1 :: r2 :: nil, L n1 :: v2 :: nil => make_andlimm n1 r2 v2
+  | Oandl, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_andlimm n2 r1 v1
+  | Oandlshift s a, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_andlimm (eval_static_shiftl s n2 a) r1 v1
+  | Oandlimm n, r1 :: nil, v1 :: nil => make_andlimm n r1 v1
+  | Oorl, r1 :: r2 :: nil, L n1 :: v2 :: nil => make_orlimm n1 r2
+  | Oorl, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_orlimm n2 r1
+  | Oorlshift s a, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_orlimm (eval_static_shiftl s n2 a) r1
+  | Oxorl, r1 :: r2 :: nil, L n1 :: v2 :: nil => make_xorlimm n1 r2
+  | Oxorl, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_xorlimm n2 r1
+  | Oxorlshift s a, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_xorlimm (eval_static_shiftl s n2 a) r1
+  | Obicl, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_andlimm (Int64.not n2) r1 v1
+  | Obiclshift s a, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_andlimm (Int64.not (eval_static_shiftl s n2 a)) r1 v1
+  | Oornl, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_orlimm (Int64.not n2) r1
+  | Oornlshift s a, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_orlimm (Int64.not (eval_static_shiftl s n2 a)) r1
+  | Oeqvl, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_xorlimm (Int64.not n2) r1
+  | Oeqvlshift s a, r1 :: r2 :: nil, v1 :: L n2 :: nil => make_xorlimm (Int64.not (eval_static_shiftl s n2 a)) r1
+  | Oshll, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shllimm n2 r1 r2
+  | Oshrl, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shrlimm n2 r1 r2
+  | Oshrlu, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shrluimm n2 r1 r2
+  | Ocmp c, args, vl => make_cmp c args vl
+  | Osel c ty, r1 :: r2 :: args, v1 :: v2 :: vl => make_select c ty r1 r2 args vl
+  | Omulf, r1 :: r2 :: nil, v1 :: F n2 :: nil => make_mulfimm n2 r1 r1 r2
+  | Omulf, r1 :: r2 :: nil, F n1 :: v2 :: nil => make_mulfimm n1 r2 r1 r2
+  | Omulfs, r1 :: r2 :: nil, v1 :: FS n2 :: nil => make_mulfsimm n2 r1 r1 r2
+  | Omulfs, r1 :: r2 :: nil, FS n1 :: v2 :: nil => make_mulfsimm n1 r2 r1 r2
+  | _, _, _ => (op, args)
+  end.
+
+Nondetfunction addr_strength_reduction
+                (addr: addressing) (args: list reg) (vl: list aval) :=
+  match addr, args, vl with
+  | Aindexed n, r1 :: nil, Ptr(Gl symb n1) :: nil =>
+      (Aglobal symb (Ptrofs.add n1 (Ptrofs.of_int64 n)), nil)
+  | Aindexed n, r1 :: nil, Ptr(Stk n1) :: nil =>
+      (Ainstack (Ptrofs.add n1 (Ptrofs.of_int64 n)), nil)
+  | Aindexed2, r1 :: r2 :: nil, Ptr(Stk n1) :: L n2 :: nil =>
+      (Ainstack (Ptrofs.add n1 (Ptrofs.of_int64 n2)), nil)
+  | Aindexed2, r1 :: r2 :: nil, L n1 :: Ptr(Stk n2) :: nil =>
+      (Ainstack (Ptrofs.add (Ptrofs.of_int64 n1) n2), nil)
+  | Aindexed2, r1 :: r2 :: nil, L n1 :: v2 :: nil =>
+      (Aindexed n1, r2 :: nil)
+  | Aindexed2, r1 :: r2 :: nil, v1 :: L n2 :: nil =>
+      (Aindexed n2, r1 :: nil)
+  | Aindexed2shift a, r1 :: r2 :: nil, Ptr(Stk n1) :: L n2 :: nil =>
+      (Ainstack (Ptrofs.add n1 (Ptrofs.of_int64 (Int64.shl' n2 a))), nil)
+  | Aindexed2shift a, r1 :: r2 :: nil, v1 :: L n2 :: nil =>
+      (Aindexed (Int64.shl' n2 a), r1 :: nil)
+  | Aindexed2ext x a, r1 :: r2 :: nil, Ptr(Stk n1) :: I n2 :: nil =>
+      (Ainstack (Ptrofs.add n1 (Ptrofs.of_int64 (eval_static_extend x n2 a))), nil)
+  | Aindexed2ext x a, r1 :: r2 :: nil, v1 :: I n2 :: nil =>
+      (Aindexed (eval_static_extend x n2 a), r1 :: nil)
+  | _, _, _ =>
+      (addr, args)
+  end.
+
diff --git a/aarch64/ConstpropOpproof.v b/aarch64/ConstpropOpproof.v
new file mode 100644
index 00000000..deab7cd4
--- /dev/null
+++ b/aarch64/ConstpropOpproof.v
@@ -0,0 +1,838 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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 operator strength reduction. *)
+
+Require Import Coqlib Compopts.
+Require Import Integers Floats Values Memory Globalenvs Events.
+Require Import Op Registers RTL ValueDomain ValueAOp ValueAnalysis.
+Require Import ConstpropOp.
+
+Local Transparent Archi.ptr64.
+
+Section STRENGTH_REDUCTION.
+
+Variable bc: block_classification.
+Variable ge: genv.
+Hypothesis GENV: genv_match bc ge.
+Variable sp: block.
+Hypothesis STACK: bc sp = BCstack.
+Variable ae: AE.t.
+Variable e: regset.
+Variable m: mem.
+Hypothesis MATCH: ematch bc e ae.
+
+Lemma match_G:
+  forall r id ofs,
+  AE.get r ae = Ptr(Gl id ofs) -> Val.lessdef e#r (Genv.symbol_address ge id ofs).
+Proof.
+  intros. apply vmatch_ptr_gl with bc; auto. rewrite <- H. apply MATCH.
+Qed.
+
+Lemma match_S:
+  forall r ofs,
+  AE.get r ae = Ptr(Stk ofs) -> Val.lessdef e#r (Vptr sp ofs).
+Proof.
+  intros. apply vmatch_ptr_stk with bc; auto. rewrite <- H. apply MATCH.
+Qed.
+
+Ltac InvApproxRegs :=
+  match goal with
+  | [ H: _ :: _ = _ :: _ |- _ ] =>
+        injection H; clear H; intros; InvApproxRegs
+  | [ H: ?v = AE.get ?r ae |- _ ] =>
+        generalize (MATCH r); rewrite <- H; clear H; intro; InvApproxRegs
+  | _ => idtac
+  end.
+
+Ltac SimplVM :=
+  match goal with
+  | [ H: vmatch _ ?v (I ?n) |- _ ] =>
+      let E := fresh in
+      assert (E: v = Vint n) by (inversion H; auto);
+      rewrite E in *; clear H; SimplVM
+  | [ H: vmatch _ ?v (L ?n) |- _ ] =>
+      let E := fresh in
+      assert (E: v = Vlong n) by (inversion H; auto);
+      rewrite E in *; clear H; SimplVM
+  | [ H: vmatch _ ?v (F ?n) |- _ ] =>
+      let E := fresh in
+      assert (E: v = Vfloat n) by (inversion H; auto);
+      rewrite E in *; clear H; SimplVM
+  | [ H: vmatch _ ?v (FS ?n) |- _ ] =>
+      let E := fresh in
+      assert (E: v = Vsingle n) by (inversion H; auto);
+      rewrite E in *; clear H; SimplVM
+  | [ H: vmatch _ ?v (Ptr(Gl ?id ?ofs)) |- _ ] =>
+      let E := fresh in
+      assert (E: Val.lessdef v (Genv.symbol_address ge id ofs)) by (eapply vmatch_ptr_gl; eauto);
+      clear H; SimplVM
+  | [ H: vmatch _ ?v (Ptr(Stk ?ofs)) |- _ ] =>
+      let E := fresh in
+      assert (E: Val.lessdef v (Vptr sp ofs)) by (eapply vmatch_ptr_stk; eauto);
+      clear H; SimplVM
+  | _ => idtac
+  end.
+
+Lemma const_for_result_correct:
+  forall a op v,
+  const_for_result a = Some op ->
+  vmatch bc v a ->
+  exists v', eval_operation ge (Vptr sp Ptrofs.zero) op nil m = Some v' /\ Val.lessdef v v'.
+Proof.
+  unfold const_for_result; intros; destruct a; inv H; SimplVM.
+- (* integer *)
+  exists (Vint n); auto.
+- (* long *)
+  exists (Vlong n); auto.
+- (* float *)
+  destruct (Compopts.generate_float_constants tt); inv H2. exists (Vfloat f); auto.
+- (* single *)
+  destruct (Compopts.generate_float_constants tt); inv H2. exists (Vsingle f); auto.
+- (* pointer *)
+  destruct p; try discriminate; SimplVM.
+  + (* global *)
+    inv H2. exists (Genv.symbol_address ge id ofs); auto.
+  + (* stack *)
+    inv H2. exists (Vptr sp ofs); split; auto. simpl. rewrite Ptrofs.add_zero_l; auto.
+Qed.
+
+Lemma eval_static_shift_correct: forall s v a,
+  eval_shift s (Vint v) a = Vint (eval_static_shift s v a).
+Proof.
+  intros; destruct s; simpl; rewrite ? a32_range; auto.
+Qed.
+
+Lemma eval_static_shiftl_correct: forall s v a,
+  eval_shiftl s (Vlong v) a = Vlong (eval_static_shiftl s v a).
+Proof.
+  intros; destruct s; simpl; rewrite ? a64_range; auto.
+Qed.
+
+Lemma eval_static_extend_correct: forall x v a,
+  eval_extend x (Vint v) a = Vlong (eval_static_extend x v a).
+Proof.
+  unfold eval_extend, eval_static_extend; intros; destruct x; simpl; rewrite ? a64_range; auto.
+Qed.
+
+Lemma cond_strength_reduction_correct:
+  forall cond args vl,
+  vl = map (fun r => AE.get r ae) args ->
+  let (cond', args') := cond_strength_reduction cond args vl in
+  eval_condition cond' e##args' m = eval_condition cond e##args m.
+Proof.
+  intros until vl. unfold cond_strength_reduction.
+  case (cond_strength_reduction_match cond args vl); simpl; intros; InvApproxRegs; SimplVM.
+- apply Val.swap_cmp_bool.
+- auto.
+- apply Val.swap_cmpu_bool.
+- auto.
+- rewrite eval_static_shift_correct; auto.
+- rewrite eval_static_shift_correct; auto.
+- apply Val.swap_cmpl_bool.
+- auto.
+- apply Val.swap_cmplu_bool.
+- auto.
+- rewrite eval_static_shiftl_correct; auto.
+- rewrite eval_static_shiftl_correct; auto.
+- destruct (Float.eq_dec n1 Float.zero).
+  subst n1. simpl. destruct (e#r2); simpl; auto. rewrite Float.cmp_swap. auto.
+  simpl. rewrite H1; auto.
+- destruct (Float.eq_dec n2 Float.zero).
+  subst n2. simpl. auto.
+  simpl. rewrite H1; auto.
+- destruct (Float.eq_dec n1 Float.zero).
+  subst n1. simpl. destruct (e#r2); simpl; auto. rewrite Float.cmp_swap. auto.
+  simpl. rewrite H1; auto.
+- destruct (Float.eq_dec n2 Float.zero); simpl; auto.
+  subst n2; auto.
+  rewrite H1; auto.
+- destruct (Float32.eq_dec n1 Float32.zero).
+  subst n1. simpl. destruct (e#r2); simpl; auto. rewrite Float32.cmp_swap. auto.
+  simpl. rewrite H1; auto.
+- destruct (Float32.eq_dec n2 Float32.zero).
+  subst n2. simpl. auto.
+  simpl. rewrite H1; auto.
+- destruct (Float32.eq_dec n1 Float32.zero).
+  subst n1. simpl. destruct (e#r2); simpl; auto. rewrite Float32.cmp_swap. auto.
+  simpl. rewrite H1; auto.
+- destruct (Float32.eq_dec n2 Float32.zero); simpl; auto.
+  subst n2; auto.
+  rewrite H1; auto.
+- auto.
+Qed.
+
+Lemma make_cmp_base_correct:
+  forall c args vl,
+  vl = map (fun r => AE.get r ae) args ->
+  let (op', args') := make_cmp_base c args vl in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op' e##args' m = Some v
+         /\ Val.lessdef (Val.of_optbool (eval_condition c e##args m)) v.
+Proof.
+  intros. unfold make_cmp_base.
+  generalize (cond_strength_reduction_correct c args vl H).
+  destruct (cond_strength_reduction c args vl) as [c' args']. intros EQ.
+  econstructor; split. simpl; eauto. rewrite EQ. auto.
+Qed.
+
+Lemma make_cmp_correct:
+  forall c args vl,
+  vl = map (fun r => AE.get r ae) args ->
+  let (op', args') := make_cmp c args vl in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op' e##args' m = Some v
+         /\ Val.lessdef (Val.of_optbool (eval_condition c e##args m)) v.
+Proof.
+  intros c args vl.
+  assert (Y: forall r, vincl (AE.get r ae) (Uns Ptop 1) = true ->
+             e#r = Vundef \/ e#r = Vint Int.zero \/ e#r = Vint Int.one).
+  { intros. apply vmatch_Uns_1 with bc Ptop. eapply vmatch_ge. eapply vincl_ge; eauto. apply MATCH. }
+  unfold make_cmp. case (make_cmp_match c args vl); intros.
+- unfold make_cmp_imm_eq.
+  destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1.
++ simpl in H; inv H. InvBooleans. subst n.
+  exists (e#r1); split; auto. simpl.
+  exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto.
++ destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0.
+* simpl in H; inv H. InvBooleans. subst n.
+  exists (Val.xor e#r1 (Vint Int.one)); split; auto. simpl.
+  exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto.
+* apply make_cmp_base_correct; auto.
+- unfold make_cmp_imm_ne.
+  destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0.
++ simpl in H; inv H. InvBooleans. subst n.
+  exists (e#r1); split; auto. simpl.
+  exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto.
++ destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1.
+* simpl in H; inv H. InvBooleans. subst n.
+  exists (Val.xor e#r1 (Vint Int.one)); split; auto. simpl.
+  exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto.
+* apply make_cmp_base_correct; auto.
+- unfold make_cmp_imm_eq.
+  destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1.
++ simpl in H; inv H. InvBooleans. subst n.
+  exists (e#r1); split; auto. simpl.
+  exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto.
++ destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0.
+* simpl in H; inv H. InvBooleans. subst n.
+  exists (Val.xor e#r1 (Vint Int.one)); split; auto. simpl.
+  exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto.
+* apply make_cmp_base_correct; auto.
+- unfold make_cmp_imm_ne.
+  destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0.
++ simpl in H; inv H. InvBooleans. subst n.
+  exists (e#r1); split; auto. simpl.
+  exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto.
++ destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1.
+* simpl in H; inv H. InvBooleans. subst n.
+  exists (Val.xor e#r1 (Vint Int.one)); split; auto. simpl.
+  exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto.
+* apply make_cmp_base_correct; auto.
+- apply make_cmp_base_correct; auto.
+Qed.
+
+Lemma make_select_correct:
+  forall c ty r1 r2 args vl,
+  vl = map (fun r => AE.get r ae) args ->
+  let (op', args') := make_select c ty r1 r2 args vl in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op' e##args' m = Some v
+         /\ Val.lessdef (Val.select (eval_condition c e##args m) e#r1 e#r2 ty) v.
+Proof.
+  unfold make_select; intros.
+  destruct (resolve_branch (eval_static_condition c vl)) as [b|] eqn:RB.
+- exists (if b then e#r1 else e#r2); split.
++ simpl. destruct b; auto.
++ destruct (eval_condition c e##args m) as [b'|] eqn:EC; simpl; auto.
+  assert (b = b').
+  { eapply resolve_branch_sound; eauto. 
+    rewrite <- EC. apply eval_static_condition_sound with bc. 
+    subst vl. exact (aregs_sound _ _ _ args MATCH). }
+  subst b'. apply Val.lessdef_normalize.
+- generalize (cond_strength_reduction_correct c args vl H).
+  destruct (cond_strength_reduction c args vl) as [cond' args']; intros EQ.
+  econstructor; split. simpl; eauto. rewrite EQ; auto.
+Qed.
+
+Lemma make_addimm_correct:
+  forall n r,
+  let (op, args) := make_addimm n r in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.add e#r (Vint n)) v.
+Proof.
+  intros. unfold make_addimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros.
+  subst. exists (e#r); split; auto.
+  destruct (e#r); simpl; rewrite ?Int.add_zero; auto.
+  exists (Val.add e#r (Vint n)); split; auto.
+Qed.
+
+Lemma make_shlimm_correct:
+  forall n r1 r2,
+  e#r2 = Vint n ->
+  let (op, args) := make_shlimm n r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.shl e#r1 (Vint n)) v.
+Proof.
+Local Opaque mk_amount32.
+  intros; unfold make_shlimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (e#r1); split; auto. destruct (e#r1); simpl; auto. rewrite Int.shl_zero. auto.
+  destruct (Int.ltu n Int.iwordsize) eqn:L.
+  econstructor; split. simpl. eauto. rewrite mk_amount32_eq; auto.
+  econstructor; split. simpl. eauto. rewrite H; auto.
+Qed.
+
+Lemma make_shrimm_correct:
+  forall n r1 r2,
+  e#r2 = Vint n ->
+  let (op, args) := make_shrimm n r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.shr e#r1 (Vint n)) v.
+Proof.
+  intros; unfold make_shrimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (e#r1); split; auto. destruct (e#r1); simpl; auto. rewrite Int.shr_zero. auto.
+  destruct (Int.ltu n Int.iwordsize) eqn:L.
+  econstructor; split. simpl. eauto. rewrite mk_amount32_eq; auto.
+  econstructor; split. simpl. eauto. rewrite H; auto.
+Qed.
+
+Lemma make_shruimm_correct:
+  forall n r1 r2,
+  e#r2 = Vint n ->
+  let (op, args) := make_shruimm n r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.shru e#r1 (Vint n)) v.
+Proof.
+  intros; unfold make_shruimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (e#r1); split; auto. destruct (e#r1); simpl; auto. rewrite Int.shru_zero. auto.
+  destruct (Int.ltu n Int.iwordsize) eqn:L.
+  econstructor; split. simpl. eauto. rewrite mk_amount32_eq; auto.
+  econstructor; split. simpl. eauto. rewrite H; auto.
+Qed.
+
+Lemma make_mulimm_correct:
+  forall n r1 r2,
+  e#r2 = Vint n ->
+  let (op, args) := make_mulimm n r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.mul e#r1 (Vint n)) v.
+Proof.
+  intros; unfold make_mulimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (Vint Int.zero); split; auto. destruct (e#r1); simpl; auto. rewrite Int.mul_zero; auto.
+  predSpec Int.eq Int.eq_spec n Int.one; intros. subst.
+  exists (e#r1); split; auto. destruct (e#r1); simpl; auto. rewrite Int.mul_one; auto.
+  destruct (Int.is_power2 n) eqn:?; intros.
+  rewrite (Val.mul_pow2 e#r1 _ _ Heqo). econstructor; split. simpl; eauto.
+  rewrite mk_amount32_eq; auto. eapply Int.is_power2_range; eauto.
+  econstructor; split; eauto. simpl. rewrite H; auto.
+Qed.
+
+Lemma make_divimm_correct:
+  forall n r1 r2 v,
+  Val.divs e#r1 e#r2 = Some v ->
+  e#r2 = Vint n ->
+  let (op, args) := make_divimm n r1 r2 in
+  exists w, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some w /\ Val.lessdef v w.
+Proof.
+  intros; unfold make_divimm.
+  predSpec Int.eq Int.eq_spec n Int.one; intros. subst. rewrite H0 in H.
+  destruct (e#r1) eqn:?;
+    try (rewrite Val.divs_one in H; exists (Vint i); split; simpl; try rewrite Heqv0; auto);
+    inv H; auto.
+  destruct (Int.is_power2 n) eqn:?.
+  destruct (Int.ltu i (Int.repr 31)) eqn:?.
+  exists v; split; auto. simpl. eapply Val.divs_pow2; eauto. congruence.
+  exists v; auto.
+  exists v; auto.
+Qed.
+
+Lemma make_divuimm_correct:
+  forall n r1 r2 v,
+  Val.divu e#r1 e#r2 = Some v ->
+  e#r2 = Vint n ->
+  let (op, args) := make_divuimm n r1 r2 in
+  exists w, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some w /\ Val.lessdef v w.
+Proof.
+  intros; unfold make_divuimm.
+  predSpec Int.eq Int.eq_spec n Int.one; intros. subst. rewrite H0 in H.
+  destruct (e#r1) eqn:?;
+    try (rewrite Val.divu_one in H; exists (Vint i); split; simpl; try rewrite Heqv0; auto);
+    inv H; auto.
+  destruct (Int.is_power2 n) eqn:?.
+  econstructor; split. simpl; eauto.
+  rewrite mk_amount32_eq by (eapply Int.is_power2_range; eauto).
+  rewrite H0 in H. erewrite Val.divu_pow2 by eauto. auto.
+  exists v; auto.
+Qed.
+
+Lemma make_andimm_correct:
+  forall n r x,
+  vmatch bc e#r x ->
+  let (op, args) := make_andimm n r x in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.and e#r (Vint n)) v.
+Proof.
+  intros; unfold make_andimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros.
+  subst n. exists (Vint Int.zero); split; auto. destruct (e#r); simpl; auto. rewrite Int.and_zero; auto.
+  predSpec Int.eq Int.eq_spec n Int.mone; intros.
+  subst n. exists (e#r); split; auto. destruct (e#r); simpl; auto. rewrite Int.and_mone; auto.
+  destruct (match x with Uns _ k => Int.eq (Int.zero_ext k (Int.not n)) Int.zero
+                       | _ => false end) eqn:UNS.
+  destruct x; try congruence.
+  exists (e#r); split; auto.
+  inv H; auto. simpl. replace (Int.and i n) with i; auto.
+  generalize (Int.eq_spec (Int.zero_ext n0 (Int.not n)) Int.zero); rewrite UNS; intro EQ.
+  Int.bit_solve. destruct (zlt i0 n0).
+  replace (Int.testbit n i0) with (negb (Int.testbit Int.zero i0)).
+  rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto.
+  rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto.
+  rewrite Int.bits_not by auto. apply negb_involutive.
+  rewrite H6 by auto. auto.
+  econstructor; split; eauto. auto.
+Qed.
+
+Lemma make_orimm_correct:
+  forall n r,
+  let (op, args) := make_orimm n r in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.or e#r (Vint n)) v.
+Proof.
+  intros; unfold make_orimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros.
+  subst n. exists (e#r); split; auto. destruct (e#r); simpl; auto. rewrite Int.or_zero; auto.
+  predSpec Int.eq Int.eq_spec n Int.mone; intros.
+  subst n. exists (Vint Int.mone); split; auto. destruct (e#r); simpl; auto. rewrite Int.or_mone; auto.
+  econstructor; split; eauto. auto.
+Qed.
+
+Lemma make_xorimm_correct:
+  forall n r,
+  let (op, args) := make_xorimm n r in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.xor e#r (Vint n)) v.
+Proof.
+  intros; unfold make_xorimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros.
+  subst n. exists (e#r); split; auto. destruct (e#r); simpl; auto. rewrite Int.xor_zero; auto.
+  predSpec Int.eq Int.eq_spec n Int.mone; intros.
+  subst n. exists (Val.notint e#r); split; auto.
+  econstructor; split; eauto. auto.
+Qed.
+
+Lemma make_addlimm_correct:
+  forall n r,
+  let (op, args) := make_addlimm n r in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.addl e#r (Vlong n)) v.
+Proof.
+  intros. unfold make_addlimm.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero; intros.
+  subst. exists (e#r); split; auto.
+  destruct (e#r); simpl; auto; rewrite ? Int64.add_zero, ? Ptrofs.add_zero; auto.
+  exists (Val.addl e#r (Vlong n)); split; auto.
+Qed.
+
+Lemma make_shllimm_correct:
+  forall n r1 r2,
+  e#r2 = Vint n ->
+  let (op, args) := make_shllimm n r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.shll e#r1 (Vint n)) v.
+Proof.
+Local Opaque mk_amount64.
+  intros; unfold make_shllimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (e#r1); split; auto. destruct (e#r1); simpl; auto.
+  unfold Int64.shl'. rewrite Z.shiftl_0_r, Int64.repr_unsigned. auto.
+  destruct (Int.ltu n Int64.iwordsize') eqn:L.
+  econstructor; split. simpl. eauto. rewrite mk_amount64_eq; auto.
+  econstructor; split. simpl. eauto. rewrite H; auto.
+Qed.
+
+Lemma make_shrlimm_correct:
+  forall n r1 r2,
+  e#r2 = Vint n ->
+  let (op, args) := make_shrlimm n r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.shrl e#r1 (Vint n)) v.
+Proof.
+  intros; unfold make_shrlimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (e#r1); split; auto. destruct (e#r1); simpl; auto.
+  unfold Int64.shr'. rewrite Z.shiftr_0_r, Int64.repr_signed. auto.
+  destruct (Int.ltu n Int64.iwordsize') eqn:L.
+  econstructor; split. simpl. eauto. rewrite mk_amount64_eq; auto.
+  econstructor; split. simpl. eauto. rewrite H; auto.
+Qed.
+
+Lemma make_shrluimm_correct:
+  forall n r1 r2,
+  e#r2 = Vint n ->
+  let (op, args) := make_shrluimm n r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.shrlu e#r1 (Vint n)) v.
+Proof.
+  intros; unfold make_shrluimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; intros. subst.
+  exists (e#r1); split; auto. destruct (e#r1); simpl; auto.
+  unfold Int64.shru'. rewrite Z.shiftr_0_r, Int64.repr_unsigned. auto.
+  destruct (Int.ltu n Int64.iwordsize') eqn:L.
+  econstructor; split. simpl. eauto. rewrite mk_amount64_eq; auto.
+  econstructor; split. simpl. eauto. rewrite H; auto.
+Qed.
+
+Lemma make_mullimm_correct:
+  forall n r1 r2,
+  e#r2 = Vlong n ->
+  let (op, args) := make_mullimm n r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.mull e#r1 (Vlong n)) v.
+Proof.
+  intros; unfold make_mullimm.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero; intros. subst.
+  exists (Vlong Int64.zero); split; auto. destruct (e#r1); simpl; auto. rewrite Int64.mul_zero; auto.
+  predSpec Int64.eq Int64.eq_spec n Int64.one; intros. subst.
+  exists (e#r1); split; auto. destruct (e#r1); simpl; auto. rewrite Int64.mul_one; auto.
+  destruct (Int64.is_power2' n) eqn:?; intros.
+  econstructor; split. simpl; eauto. 
+  rewrite mk_amount64_eq by (eapply Int64.is_power2'_range; eauto).
+  destruct (e#r1); simpl; auto.
+  erewrite Int64.is_power2'_range by eauto.
+  erewrite Int64.mul_pow2' by eauto. auto.
+  econstructor; split; eauto. simpl; rewrite H; auto.
+Qed.
+
+Lemma make_divlimm_correct:
+  forall n r1 r2 v,
+  Val.divls e#r1 e#r2 = Some v ->
+  e#r2 = Vlong n ->
+  let (op, args) := make_divlimm n r1 r2 in
+  exists w, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some w /\ Val.lessdef v w.
+Proof.
+  intros; unfold make_divlimm.
+  destruct (Int64.is_power2' n) eqn:?. destruct (Int.ltu i (Int.repr 63)) eqn:?.
+  rewrite H0 in H. econstructor; split. simpl; eauto. eapply Val.divls_pow2; eauto. auto.
+  exists v; auto.
+  exists v; auto.
+Qed.
+
+Lemma make_divluimm_correct:
+  forall n r1 r2 v,
+  Val.divlu e#r1 e#r2 = Some v ->
+  e#r2 = Vlong n ->
+  let (op, args) := make_divluimm n r1 r2 in
+  exists w, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some w /\ Val.lessdef v w.
+Proof.
+  intros; unfold make_divluimm.
+  destruct (Int64.is_power2' n) eqn:?.
+  econstructor; split. simpl; eauto.
+  rewrite mk_amount64_eq by (eapply Int64.is_power2'_range; eauto).
+  rewrite H0 in H. destruct (e#r1); inv H. destruct (Int64.eq n Int64.zero); inv H2.
+  simpl.
+  erewrite Int64.is_power2'_range by eauto.    
+  erewrite Int64.divu_pow2' by eauto.  auto. 
+  exists v; auto.
+Qed.
+
+Lemma make_andlimm_correct:
+  forall n r x,
+  let (op, args) := make_andlimm n r x in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.andl e#r (Vlong n)) v.
+Proof.
+  intros; unfold make_andlimm.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero; intros.
+  subst n. exists (Vlong Int64.zero); split; auto. destruct (e#r); simpl; auto. rewrite Int64.and_zero; auto.
+  predSpec Int64.eq Int64.eq_spec n Int64.mone; intros.
+  subst n. exists (e#r); split; auto. destruct (e#r); simpl; auto. rewrite Int64.and_mone; auto.
+  econstructor; split; eauto. auto.
+Qed.
+
+Lemma make_orlimm_correct:
+  forall n r,
+  let (op, args) := make_orlimm n r in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.orl e#r (Vlong n)) v.
+Proof.
+  intros; unfold make_orlimm.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero; intros.
+  subst n. exists (e#r); split; auto. destruct (e#r); simpl; auto. rewrite Int64.or_zero; auto.
+  predSpec Int64.eq Int64.eq_spec n Int64.mone; intros.
+  subst n. exists (Vlong Int64.mone); split; auto. destruct (e#r); simpl; auto. rewrite Int64.or_mone; auto.
+  econstructor; split; eauto. auto.
+Qed.
+
+Lemma make_xorlimm_correct:
+  forall n r,
+  let (op, args) := make_xorlimm n r in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.xorl e#r (Vlong n)) v.
+Proof.
+  intros; unfold make_xorlimm.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero; intros.
+  subst n. exists (e#r); split; auto. destruct (e#r); simpl; auto. rewrite Int64.xor_zero; auto.
+  predSpec Int64.eq Int64.eq_spec n Int64.mone; intros.
+  subst n. exists (Val.notl e#r); split; auto.
+  econstructor; split; eauto. auto.
+Qed.
+
+Lemma make_mulfimm_correct:
+  forall n r1 r2,
+  e#r2 = Vfloat n ->
+  let (op, args) := make_mulfimm n r1 r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.mulf e#r1 e#r2) v.
+Proof.
+  intros; unfold make_mulfimm.
+  destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros.
+  simpl. econstructor; split. eauto. rewrite H; subst n.
+  destruct (e#r1); simpl; auto. rewrite Float.mul2_add; auto.
+  simpl. econstructor; split; eauto.
+Qed.
+
+Lemma make_mulfimm_correct_2:
+  forall n r1 r2,
+  e#r1 = Vfloat n ->
+  let (op, args) := make_mulfimm n r2 r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.mulf e#r1 e#r2) v.
+Proof.
+  intros; unfold make_mulfimm.
+  destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros.
+  simpl. econstructor; split. eauto. rewrite H; subst n.
+  destruct (e#r2); simpl; auto. rewrite Float.mul2_add; auto.
+  rewrite Float.mul_commut; auto.
+  simpl. econstructor; split; eauto.
+Qed.
+
+Lemma make_mulfsimm_correct:
+  forall n r1 r2,
+  e#r2 = Vsingle n ->
+  let (op, args) := make_mulfsimm n r1 r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.mulfs e#r1 e#r2) v.
+Proof.
+  intros; unfold make_mulfsimm.
+  destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros.
+  simpl. econstructor; split. eauto. rewrite H; subst n.
+  destruct (e#r1); simpl; auto. rewrite Float32.mul2_add; auto.
+  simpl. econstructor; split; eauto.
+Qed.
+
+Lemma make_mulfsimm_correct_2:
+  forall n r1 r2,
+  e#r1 = Vsingle n ->
+  let (op, args) := make_mulfsimm n r2 r1 r2 in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.mulfs e#r1 e#r2) v.
+Proof.
+  intros; unfold make_mulfsimm.
+  destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros.
+  simpl. econstructor; split. eauto. rewrite H; subst n.
+  destruct (e#r2); simpl; auto. rewrite Float32.mul2_add; auto.
+  rewrite Float32.mul_commut; auto.
+  simpl. econstructor; split; eauto.
+Qed.
+
+Lemma make_zext_correct:
+  forall s r x,
+  vmatch bc e#r x ->
+  let (op, args) := make_zext s r x in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.zero_ext s e#r) v.
+Proof.
+  intros; unfold make_zext. destruct (vincl x (Uns Ptop s)) eqn:INCL.
+- exists e#r; split; auto.
+  assert (V: vmatch bc e#r (Uns Ptop s)).
+  { eapply vmatch_ge; eauto. apply vincl_ge; auto. }
+  inv V; simpl; auto. rewrite is_uns_zero_ext in H4 by auto. rewrite H4; auto.
+- econstructor; split; simpl; eauto.
+Qed.
+
+Lemma make_sext_correct:
+  forall s r x,
+  vmatch bc e#r x ->
+  let (op, args) := make_sext s r x in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v /\ Val.lessdef (Val.sign_ext s e#r) v.
+Proof.
+  intros; unfold make_sext. destruct (vincl x (Sgn Ptop s)) eqn:INCL.
+- exists e#r; split; auto.
+  assert (V: vmatch bc e#r (Sgn Ptop s)).
+  { eapply vmatch_ge; eauto. apply vincl_ge; auto. }
+  inv V; simpl; auto. rewrite is_sgn_sign_ext in H4 by auto. rewrite H4; auto.
+- econstructor; split; simpl; eauto.
+Qed.
+
+Lemma op_strength_reduction_correct:
+  forall op args vl v,
+  vl = map (fun r => AE.get r ae) args ->
+  eval_operation ge (Vptr sp Ptrofs.zero) op e##args m = Some v ->
+  let (op', args') := op_strength_reduction op args vl in
+  exists w, eval_operation ge (Vptr sp Ptrofs.zero) op' e##args' m = Some w /\ Val.lessdef v w.
+Proof.
+  intros until v; unfold op_strength_reduction;
+  case (op_strength_reduction_match op args vl); simpl; intros.
+- (* add 1 *)
+  rewrite Val.add_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_addimm_correct; auto.
+- (* add 2 *)
+  InvApproxRegs; SimplVM; inv H0. apply make_addimm_correct; auto.
+- (* addshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shift_correct. apply make_addimm_correct; auto.
+- (* sub *)
+  InvApproxRegs; SimplVM; inv H0. rewrite Val.sub_add_opp. apply make_addimm_correct; auto.
+- (* subshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shift_correct, Val.sub_add_opp. apply make_addimm_correct; auto.
+- (* mul 1 *)
+  rewrite Val.mul_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_mulimm_correct; auto.
+- (* mul 2*)
+  InvApproxRegs; SimplVM; inv H0. apply make_mulimm_correct; auto.
+- (* divs *)
+  assert (e#r2 = Vint n2). clear H0. InvApproxRegs; SimplVM; auto.
+  apply make_divimm_correct; auto.
+- (* divu *)
+  assert (e#r2 = Vint n2). clear H0. InvApproxRegs; SimplVM; auto.
+  apply make_divuimm_correct; auto.
+- (* and 1 *)
+  rewrite Val.and_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_andimm_correct; auto.
+- (* and 2 *)
+  InvApproxRegs; SimplVM; inv H0. apply make_andimm_correct; auto.
+- (* andshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shift_correct. apply make_andimm_correct; auto.
+- (* andimm *)
+  inv H; inv H0. apply make_andimm_correct; auto.
+- (* or 1 *)
+  rewrite Val.or_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_orimm_correct; auto.
+- (* or 2 *)
+  InvApproxRegs; SimplVM; inv H0. apply make_orimm_correct; auto.
+- (* orshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shift_correct. apply make_orimm_correct; auto.
+- (* xor 1 *)
+  rewrite Val.xor_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_xorimm_correct; auto.
+- (* xor 2 *)
+  InvApproxRegs; SimplVM; inv H0. apply make_xorimm_correct; auto.
+- (* xorshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shift_correct. apply make_xorimm_correct; auto.
+- (* bic *)
+  InvApproxRegs; SimplVM; inv H0. apply make_andimm_correct; auto.
+- (* bicshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shift_correct. apply make_andimm_correct; auto.
+- (* orn *)
+  InvApproxRegs; SimplVM; inv H0. apply make_orimm_correct; auto.
+- (* ornshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shift_correct. apply make_orimm_correct; auto.
+- (* eor *)
+  InvApproxRegs; SimplVM; inv H0. apply make_xorimm_correct; auto.
+- (* eorshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shift_correct. apply make_xorimm_correct; auto.
+- (* shl *)
+  InvApproxRegs; SimplVM; inv H0. apply make_shlimm_correct; auto.
+- (* shr *)
+  InvApproxRegs; SimplVM; inv H0. apply make_shrimm_correct; auto.
+- (* shru *)
+  InvApproxRegs; SimplVM; inv H0. apply make_shruimm_correct; auto.
+- (* zext *)
+  InvApproxRegs; SimplVM; inv H0. apply make_zext_correct; auto.
+- (* sext *)
+  InvApproxRegs; SimplVM; inv H0. apply make_sext_correct; auto.
+- (* addl 1 *)
+  rewrite Val.addl_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_addlimm_correct; auto.
+- (* addl 2 *)
+  InvApproxRegs; SimplVM; inv H0. apply make_addlimm_correct; auto.
+- (* addshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shiftl_correct. apply make_addlimm_correct; auto.
+- (* addext *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_extend_correct. apply make_addlimm_correct; auto.
+- (* subl *)
+  InvApproxRegs; SimplVM; inv H0. rewrite Val.subl_addl_opp. apply make_addlimm_correct; auto.
+- (* sublshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shiftl_correct, Val.subl_addl_opp. apply make_addlimm_correct; auto.
+- (* sublextend *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_extend_correct, Val.subl_addl_opp. apply make_addlimm_correct; auto.
+- (* mull 1 *)
+  rewrite Val.mull_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_mullimm_correct; auto.
+- (* mull 2 *)
+  InvApproxRegs; SimplVM; inv H0. apply make_mullimm_correct; auto.
+- (* divl *)
+  assert (e#r2 = Vlong n2). clear H0. InvApproxRegs; SimplVM; auto.
+  apply make_divlimm_correct; auto.
+- (* divlu *)
+  assert (e#r2 = Vlong n2). clear H0. InvApproxRegs; SimplVM; auto.
+  apply make_divluimm_correct; auto.
+- (* andl 1 *)
+  rewrite Val.andl_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_andlimm_correct; auto.
+- (* andl 2 *)
+  InvApproxRegs; SimplVM; inv H0. apply make_andlimm_correct; auto.
+- (* andlshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shiftl_correct. apply make_andlimm_correct; auto.
+- (* andlimm *)
+  inv H; inv H0. apply make_andlimm_correct; auto.
+- (* orl 1 *)
+  rewrite Val.orl_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_orlimm_correct; auto.
+- (* orl 2 *)
+  InvApproxRegs; SimplVM; inv H0. apply make_orlimm_correct; auto.
+- (* orlshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shiftl_correct. apply make_orlimm_correct; auto.
+- (* xorl 1 *)
+  rewrite Val.xorl_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_xorlimm_correct; auto.
+- (* xorl 2 *)
+  InvApproxRegs; SimplVM; inv H0. apply make_xorlimm_correct; auto.
+- (* xorlshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shiftl_correct. apply make_xorlimm_correct; auto.
+- (* bicl *)
+  InvApproxRegs; SimplVM; inv H0. apply make_andlimm_correct; auto.
+- (* biclshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shiftl_correct. apply make_andlimm_correct; auto.
+- (* ornl *)
+  InvApproxRegs; SimplVM; inv H0. apply make_orlimm_correct; auto.
+- (* ornlshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shiftl_correct. apply make_orlimm_correct; auto.
+- (* eorl *)
+  InvApproxRegs; SimplVM; inv H0. apply make_xorlimm_correct; auto.
+- (* eorlshift *)
+  InvApproxRegs; SimplVM; inv H0. rewrite eval_static_shiftl_correct. apply make_xorlimm_correct; auto.
+- (* shll *)
+  InvApproxRegs; SimplVM; inv H0. apply make_shllimm_correct; auto.
+- (* shrl *)
+  InvApproxRegs; SimplVM; inv H0. apply make_shrlimm_correct; auto.
+- (* shrlu *)
+  InvApproxRegs; SimplVM; inv H0. apply make_shrluimm_correct; auto.
+- (* cond *)
+  inv H0. apply make_cmp_correct; auto.
+- (* select *)
+  inv H0. apply make_select_correct; congruence.
+- (* mulf 1 *)
+  InvApproxRegs; SimplVM; inv H0. rewrite <- H2. apply make_mulfimm_correct; auto.
+- (* mulf 2 *)
+  InvApproxRegs; SimplVM; inv H0. fold (Val.mulf (Vfloat n1) e#r2).
+  rewrite <- H2. apply make_mulfimm_correct_2; auto.
+- (* mulfs 1 *)
+  InvApproxRegs; SimplVM; inv H0. rewrite <- H2. apply make_mulfsimm_correct; auto.
+- (* mulfs 2 *)
+  InvApproxRegs; SimplVM; inv H0. fold (Val.mulfs (Vsingle n1) e#r2).
+  rewrite <- H2. apply make_mulfsimm_correct_2; auto.
+- (* default *)
+  exists v; auto.
+Qed.
+
+Lemma addr_strength_reduction_correct:
+  forall addr args vl res,
+  vl = map (fun r => AE.get r ae) args ->
+  eval_addressing ge (Vptr sp Ptrofs.zero) addr e##args = Some res ->
+  let (addr', args') := addr_strength_reduction addr args vl in
+  exists res', eval_addressing ge (Vptr sp Ptrofs.zero) addr' e##args' = Some res' /\ Val.lessdef res res'.
+Proof.
+  intros until res. unfold addr_strength_reduction.
+  destruct (addr_strength_reduction_match addr args vl); simpl;
+  intros VL EA; InvApproxRegs; SimplVM; try (inv EA).
+- econstructor; split; eauto. inv H0; simpl; auto. rewrite H2.
+  unfold Genv.symbol_address. destruct (Genv.find_symbol ge symb); auto.
+- rewrite Ptrofs.add_zero_l. econstructor; split; eauto.
+  inv H0; auto. rewrite H2; auto.
+- rewrite Ptrofs.add_zero_l. econstructor; split; eauto. 
+  inv H; auto. rewrite H3; auto.
+- rewrite Ptrofs.add_zero_l. econstructor; split; eauto. 
+  inv H0; auto. rewrite H3. rewrite Ptrofs.add_commut; auto.
+- econstructor; split; eauto. rewrite Val.addl_commut. auto.
+- econstructor; split; eauto.
+- rewrite Ptrofs.add_zero_l. rewrite a64_range. econstructor; split; eauto.
+  inv H; auto. rewrite H3; auto.
+- rewrite a64_range. econstructor; split; eauto.
+- rewrite Ptrofs.add_zero_l, eval_static_extend_correct.
+  econstructor; split; eauto. inv H; auto. rewrite H3; auto.
+- rewrite eval_static_extend_correct. 
+  econstructor; split; eauto.
+- exists res; auto.
+Qed.
+
+End STRENGTH_REDUCTION.
diff --git a/aarch64/Conventions1.v b/aarch64/Conventions1.v
new file mode 100644
index 00000000..efda835d
--- /dev/null
+++ b/aarch64/Conventions1.v
@@ -0,0 +1,285 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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 Decidableplus.
+Require Import AST Events Locations.
+Require Archi.
+
+(** * Classification of machine registers *)
+
+(** Machine registers (type [mreg] in module [Locations]) are divided in:
+- 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 Procedure Call Standard for the ARM 64-bit Architecture
+  (AArch64) document: R19-R28 and F8-F15 are callee-save. *)
+
+Definition is_callee_save (r: mreg): bool :=
+  match r with
+  | R0  | R1  | R2  | R3  | R4  | R5  | R6  | R7 => false
+  | R8  | R9  | R10 | R11 | R12 | R13 | R14 | R15 => false
+  | R17 => false
+  | R19 | R20 | R21 |  R22 | R23 => true
+  | R24 | R25 | R26 | R27 | R28 => true
+  | R29 => false
+  | F0  | F1  | F2  | F3  | F4  | F5  | F6  | F7 => false
+  | F8  | F9  | F10 | F11 | F12 | F13 | F14 | F15 => true
+  | F16 | F17 | F18 | F19 | F20 | F21 | F22 | F23 => false
+  | F24 | F25 | F26 | F27 | F28 | F29 | F30 | F31 => false
+  end.
+
+Definition int_caller_save_regs :=
+     R0  :: R1  :: R2  :: R3  :: R4  :: R5  :: R6  :: R7
+  :: R8  :: R9  :: R10 :: R11 :: R12 :: R13 :: R14 :: R15
+  :: R17 :: R29 :: nil.
+
+Definition float_caller_save_regs :=
+     F0  :: F1  :: F2  :: F3  :: F4  :: F5  :: F6  :: F7
+  :: F16 :: F17 :: F18 :: F19 :: F20 :: F21 :: F22 :: F23
+  :: F24 :: F25 :: F26 :: F27 :: F28 :: F29 :: F30 :: F31 :: nil.
+
+Definition int_callee_save_regs :=
+     R19 :: R20 :: R21 ::  R22 :: R23
+  :: R24 :: R25 :: R26 :: R27 :: R28 :: nil.
+
+Definition float_callee_save_regs :=
+     F8  :: F9  :: F10 :: F11 :: F12 :: F13 :: F14 :: F15 :: nil.
+
+Definition destroyed_at_call :=
+  List.filter (fun r => negb (is_callee_save r)) all_mregs.
+
+Definition dummy_int_reg := R0.     (**r Used in [Coloring]. *)
+Definition dummy_float_reg := F0.   (**r Used in [Coloring]. *)
+
+Definition callee_save_type := mreg_type.
+  
+Definition is_float_reg (r: mreg): bool :=
+  match r with
+  | R0  | R1  | R2  | R3  | R4  | R5  | R6  | R7
+  | R8  | R9  | R10 | R11 | R12 | R13 | R14 | R15
+  | R17 | R19 | R20 | R21 |  R22 | R23
+  | R24 | R25 | R26 | R27 | R28
+  | R29 => false
+  | F0  | F1  | F2  | F3  | F4  | F5  | F6  | F7
+  | F8  | F9  | F10 | F11 | F12 | F13 | F14 | F15
+  | F16 | F17 | F18 | F19 | F20 | F21 | F22 | F23
+  | F24 | F25 | F26 | F27 | F28 | F29 | F30 | F31 => true
+  end.
+
+(** * 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.  *)
+
+(** ** Location of function result *)
+
+(** The result value of a function is passed back to the caller in
+  registers [R0] or [F0], 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) : rpair mreg :=
+  match proj_sig_res s with
+  | Tint | Tlong | Tany32 | Tany64 => One R0
+  | Tfloat | Tsingle => One F0
+  end.
+
+(** The result registers have types compatible with that given in the signature. *)
+
+Lemma loc_result_type:
+  forall sig,
+  subtype (proj_sig_res sig) (typ_rpair mreg_type (loc_result sig)) = true.
+Proof.
+  intros. unfold loc_result. destruct (proj_sig_res sig); auto.
+Qed.
+
+(** The result locations are caller-save registers *)
+
+Lemma loc_result_caller_save:
+  forall (s: signature),
+  forall_rpair (fun r => is_callee_save r = false) (loc_result s).
+Proof.
+  intros.
+  unfold loc_result. destruct (proj_sig_res s); simpl; auto.
+Qed.
+
+(** If the result is in a pair of registers, those registers are distinct and have type [Tint] at least. *)
+
+Lemma loc_result_pair:
+  forall sg,
+  match loc_result sg with
+  | One _ => True
+  | Twolong r1 r2 =>
+        r1 <> r2 /\ proj_sig_res sg = Tlong
+     /\ subtype Tint (mreg_type r1) = true /\ subtype Tint (mreg_type r2) = true
+     /\ Archi.ptr64 = false
+  end.
+Proof.
+  intros; unfold loc_result; destruct (proj_sig_res sg); exact I.
+Qed.
+
+(** The location of the result depends only on the result part of the signature *)
+
+Lemma loc_result_exten:
+  forall s1 s2, s1.(sig_res) = s2.(sig_res) -> loc_result s1 = loc_result s2.
+Proof.
+  intros. unfold loc_result, proj_sig_res. rewrite H; auto.
+Qed.
+
+(** ** Location of function arguments *)
+
+(**
+- The first 8 integer arguments are passed in registers [R0...R7].
+- The first 8 FP arguments are passed in registers [F0...F7].
+- Extra arguments are passed on the stack, in [Outgoing] slots of size
+  64 bits (2 words), consecutively assigned, starting at word offset 0.
+**)
+
+Definition int_param_regs :=
+  R0  :: R1  :: R2  :: R3  :: R4  :: R5  :: R6  :: R7 :: nil.
+
+Definition float_param_regs :=
+  F0  :: F1  :: F2  :: F3  :: F4  :: F5  :: F6  :: F7 :: nil.
+
+Fixpoint loc_arguments_rec
+     (tyl: list typ) (ir fr ofs: Z) {struct tyl} : list (rpair loc) :=
+  match tyl with
+  | nil => nil
+  | (Tint | Tlong | Tany32 | Tany64) as ty :: tys =>
+      match list_nth_z int_param_regs ir with
+      | None =>
+          One (S Outgoing ofs ty) :: loc_arguments_rec tys ir fr (ofs + 2)
+      | Some ireg =>
+          One (R ireg) :: loc_arguments_rec tys (ir + 1) fr ofs
+      end
+  | (Tfloat | Tsingle) as ty :: tys =>
+      match list_nth_z float_param_regs fr with
+      | None =>
+          One (S Outgoing ofs ty) :: loc_arguments_rec tys ir fr (ofs + 2)
+      | Some freg =>
+          One (R freg) :: loc_arguments_rec tys ir (fr + 1) ofs
+      end
+  end.
+
+(** [loc_arguments s] returns the list of locations where to store arguments
+  when calling a function with signature [s].  *)
+
+Definition loc_arguments (s: signature) : list (rpair loc) :=
+  loc_arguments_rec s.(sig_args) 0 0 0.
+
+(** Argument locations are either caller-save registers or [Outgoing]
+  stack slots at nonnegative offsets. *)
+
+Definition loc_argument_acceptable (l: loc) : Prop :=
+  match l with
+  | R r => is_callee_save r = false
+  | S Outgoing ofs ty => ofs >= 0 /\ (typealign ty | ofs)
+  | _ => False
+  end.
+
+Definition loc_argument_charact (ofs: Z) (l: loc) : Prop :=
+  match l with
+  | R r => In r int_param_regs \/ In r float_param_regs
+  | S Outgoing ofs' ty => ofs' >= ofs /\ (2 | ofs')
+  | _ => False
+  end.
+
+Remark loc_arguments_rec_charact:
+  forall tyl ir fr ofs p,
+  In p (loc_arguments_rec tyl ir fr ofs) -> (2 | ofs) -> forall_rpair (loc_argument_charact ofs) p.
+Proof.
+  assert (X: forall ofs1 ofs2 l, loc_argument_charact ofs2 l -> ofs1 <= ofs2 -> loc_argument_charact ofs1 l).
+  { destruct l; simpl; intros; auto. destruct sl; auto. intuition omega. }
+  assert (Y: forall ofs1 ofs2 p, forall_rpair (loc_argument_charact ofs2) p -> ofs1 <= ofs2 -> forall_rpair (loc_argument_charact ofs1) p).
+  { destruct p; simpl; intuition eauto. }
+  assert (Z: forall ofs, (2 | ofs) -> (2 | ofs + 2)).
+  { intros. apply Z.divide_add_r; auto. apply Z.divide_refl. }
+Opaque list_nth_z.
+  induction tyl; simpl loc_arguments_rec; intros.
+- contradiction.
+- assert (A: forall ty, In p
+      match list_nth_z int_param_regs ir with
+      | Some ireg => One (R ireg) :: loc_arguments_rec tyl (ir + 1) fr ofs
+      | None => One (S Outgoing ofs ty) :: loc_arguments_rec tyl ir fr (ofs + 2)
+      end ->
+      forall_rpair (loc_argument_charact ofs) p).
+  { intros. destruct (list_nth_z int_param_regs ir) as [r|] eqn:E; destruct H1.
+    subst. left. eapply list_nth_z_in; eauto.
+    eapply IHtyl; eauto.
+    subst. split. omega. assumption.
+    eapply Y; eauto. omega. }
+  assert (B: forall ty, In p
+      match list_nth_z float_param_regs fr with
+      | Some ireg => One (R ireg) :: loc_arguments_rec tyl ir (fr + 1) ofs
+      | None => One (S Outgoing ofs ty) :: loc_arguments_rec tyl ir fr (ofs + 2)
+      end ->
+      forall_rpair (loc_argument_charact ofs) p).
+  { intros. destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H1.
+    subst. right. eapply list_nth_z_in; eauto.
+    eapply IHtyl; eauto.
+    subst. split. omega. assumption.
+    eapply Y; eauto. omega. }
+  destruct a; eauto.
+Qed.
+
+Lemma loc_arguments_acceptable:
+  forall (s: signature) (p: rpair loc),
+  In p (loc_arguments s) -> forall_rpair loc_argument_acceptable p.
+Proof.
+  unfold loc_arguments; intros.
+  assert (A: forall r, In r int_param_regs -> is_callee_save r = false) by decide_goal.
+  assert (B: forall r, In r float_param_regs -> is_callee_save r = false) by decide_goal.
+  assert (X: forall l, loc_argument_charact 0 l -> loc_argument_acceptable l).
+  { unfold loc_argument_charact, loc_argument_acceptable.
+    destruct l as [r | [] ofs ty]; auto.  intros [C|C]; auto.
+    intros [C D]. split; auto. apply Z.divide_trans with 2; auto.
+    exists (2 / typealign ty); destruct ty; reflexivity.
+  }
+  exploit loc_arguments_rec_charact; eauto using Z.divide_0_r.
+  unfold forall_rpair; destruct p; intuition auto.
+Qed.
+
+Hint Resolve loc_arguments_acceptable: locs.
+
+Lemma loc_arguments_main:
+  loc_arguments signature_main = nil.
+Proof.
+  unfold loc_arguments; reflexivity.
+Qed.
+
+(** ** Normalization of function results *)
+
+(** According to the AAPCS64 ABI specification, "padding bits" in the return
+    value of a function have unpredictable values and must be ignored.
+    Consequently, we force normalization of return values of small integer
+    types (8- and 16-bit integers), so that the top bits (the "padding bits")
+    are proper sign- or zero-extensions of the small integer value. *)
+
+Definition return_value_needs_normalization (t: rettype) : bool :=
+  match t with
+  | Tint8signed | Tint8unsigned | Tint16signed | Tint16unsigned => true
+  | _ => false
+  end.
diff --git a/aarch64/Machregs.v b/aarch64/Machregs.v
new file mode 100644
index 00000000..b2a2308e
--- /dev/null
+++ b/aarch64/Machregs.v
@@ -0,0 +1,210 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+Require Import String.
+Require Import Coqlib Decidableplus Maps.
+Require Import AST Op.
+
+(** ** Machine registers *)
+
+(** Integer register 16 is reserved as temporary and for call veeners.
+    Integer register 18 is reserved as the platform register.
+    Integer register 30 is reserved for the return address. *)
+
+Inductive mreg: Type :=
+  (** Allocatable integer regs *)
+  | R0  | R1  | R2  | R3  | R4  | R5  | R6  | R7
+  | R8  | R9  | R10 | R11 | R12 | R13 | R14 | R15
+  | R17 | R19 | R20 | R21 |  R22 | R23
+  | R24 | R25 | R26 | R27 | R28 | R29
+  (** Allocatable floating-point regs *)
+  | F0  | F1  | F2  | F3  | F4  | F5  | F6  | F7
+  | F8  | F9  | F10 | F11 | F12 | F13 | F14 | F15
+  | F16 | F17 | F18 | F19 | F20 | F21 | F22 | F23
+  | F24 | F25 | F26 | F27 | F28 | F29 | F30 | F31.
+
+Lemma mreg_eq: forall (r1 r2: mreg), {r1 = r2} + {r1 <> r2}.
+Proof. decide equality. Defined.
+Global Opaque mreg_eq.
+
+Definition all_mregs :=
+     R0  :: R1  :: R2  :: R3  :: R4  :: R5  ::  R6  :: R7
+  :: R8  :: R9  :: R10 :: R11 :: R12 :: R13 ::  R14 :: R15
+  :: R17 :: R19 :: R20 :: R21 ::  R22 :: R23
+  :: R24 :: R25 :: R26 :: R27 :: R28 :: R29
+  :: F0  :: F1  :: F2  :: F3  :: F4  :: F5  ::  F6  :: F7
+  :: F8  :: F9  :: F10 :: F11 :: F12 :: F13 ::  F14 :: F15
+  :: F16 :: F17 :: F18 :: F19 :: F20 :: F21 ::  F22 :: F23
+  :: F24 :: F25 :: F26 :: F27 :: F28 :: F29 ::  F30 :: F31
+  :: nil.
+
+Lemma all_mregs_complete:
+  forall (r: mreg), In r all_mregs.
+Proof.
+  assert (forall r, proj_sumbool (In_dec mreg_eq r all_mregs) = true) by (destruct r; reflexivity).
+  intros. specialize (H r). InvBooleans. auto.
+Qed.
+
+Instance Decidable_eq_mreg : forall (x y: mreg), Decidable (eq x y) := Decidable_eq mreg_eq.
+
+Instance Finite_mreg : Finite mreg := {
+  Finite_elements := all_mregs;
+  Finite_elements_spec := all_mregs_complete
+}.
+
+Definition mreg_type (r: mreg): typ := Tany64.
+
+Open Scope positive_scope.
+
+Module IndexedMreg <: INDEXED_TYPE.
+  Definition t := mreg.
+  Definition eq := mreg_eq.
+  Definition index (r: mreg): positive :=
+    match r with
+    | R0 => 1   | R1 => 2   | R2 => 3   | R3 => 4
+    | R4 => 5   | R5 => 6   | R6 => 7   | R7 => 8
+    | R8 => 9   | R9 => 10  | R10 => 11 | R11 => 12
+    | R12 => 13 | R13 => 14 | R14 => 15 | R15 => 16
+    | R17 => 17 | R19 => 19
+    | R20 => 20 | R21 => 21 | R22 => 22 | R23 => 23
+    | R24 => 24 | R25 => 25 | R26 => 26 | R27 => 27
+    | R28 => 28 | R29 => 29
+    | F0 => 32  | F1 => 33  | F2 => 34  | F3 => 35
+    | F4 => 36  | F5 => 37  | F6 => 38  | F7 => 39
+    | F8 => 40  | F9 => 41  | F10 => 42 | F11 => 43
+    | F12 => 44 | F13 => 45 | F14 => 46 | F15 => 47
+    | F16 => 48 | F17 => 49 | F18 => 50 | F19 => 51
+    | F20 => 52 | F21 => 53 | F22 => 54 | F23 => 55
+    | F24 => 56 | F25 => 57 | F26 => 58 | F27 => 59
+    | F28 => 60 | F29 => 61 | F30 => 62 | F31 => 63
+    end.
+  Lemma index_inj:
+    forall r1 r2, index r1 = index r2 -> r1 = r2.
+  Proof.
+    decide_goal.
+  Qed.
+End IndexedMreg.
+
+Definition is_stack_reg (r: mreg) : bool := false.
+
+(** ** Names of registers *)
+
+Local Open Scope string_scope.
+
+Definition register_names :=
+     ("X0", R0)  :: ("X1", R1)  :: ("X2", R2)  :: ("X3", R3)
+  :: ("X4", R4)  :: ("X5", R5)  :: ("X6", R6)  :: ("X7", R7)
+  :: ("X8", R8)  :: ("X9", R9)  :: ("X10", R10) :: ("X11", R11)
+  :: ("X12", R12) :: ("X13", R13) :: ("X14", R14) :: ("X15", R15)
+  :: ("X17", R17) :: ("X19", R19)
+  :: ("X20", R20) :: ("X21", R21) :: ("X22", R22) :: ("X23", R23)
+  :: ("X24", R24) :: ("X25", R25) :: ("X26", R26) :: ("X27", R27)
+  :: ("X28", R28) :: ("X29", R29)
+  :: ("D0", F0)  :: ("D1", F1)  :: ("D2", F2)  :: ("D3", F3)
+  :: ("D4", F4)  :: ("D5", F5)  :: ("D6", F6)  :: ("D7", F7)
+  :: ("D8", F8)  :: ("D9", F9)  :: ("D10", F10) :: ("D11", F11)
+  :: ("D12", F12) :: ("D13", F13) :: ("D14", F14) :: ("D15", F15)
+  :: ("D16", F16) :: ("D17", F17) :: ("D18", F18) :: ("D19", F19)
+  :: ("D20", F20) :: ("D21", F21) :: ("D22", F22) :: ("D23", F23)
+  :: ("D24", F24) :: ("D25", F25) :: ("D26", F26) :: ("D27", F27)
+  :: ("D28", F28) :: ("D29", F29) :: ("D30", F30) :: ("D31", F31)
+  :: nil.
+
+Definition register_by_name (s: string) : option mreg :=
+  let fix assoc (l: list (string * mreg)) : option mreg :=
+    match l with
+    | nil => None
+    | (s1, r1) :: l' => if string_dec s s1 then Some r1 else assoc l'
+    end
+  in assoc register_names.
+
+(** ** Destroyed registers, preferred registers *)
+
+Definition destroyed_by_op (op: operation): list mreg :=
+  match op with
+  | Oshrximm _ | Oshrlximm _ => R17 :: nil
+  | _ => nil
+  end.
+
+Definition destroyed_by_load (chunk: memory_chunk) (addr: addressing): list mreg :=
+  nil.
+
+Definition destroyed_by_store (chunk: memory_chunk) (addr: addressing): list mreg := nil.
+
+Definition destroyed_by_cond (cond: condition): list mreg := nil.
+
+Definition destroyed_by_jumptable: list mreg := R17 :: nil.
+
+Fixpoint destroyed_by_clobber (cl: list string): list mreg :=
+  match cl with
+  | nil => nil
+  | c1 :: cl =>
+      match register_by_name c1 with
+      | Some r => r :: destroyed_by_clobber cl
+      | None   => destroyed_by_clobber cl
+      end
+  end.
+
+Definition destroyed_by_builtin (ef: external_function): list mreg :=
+  match ef with
+  | EF_memcpy sz al => R15 :: R17 :: R29 :: nil
+  | EF_inline_asm txt sg clob => destroyed_by_clobber clob
+  | _ => nil
+  end.
+
+Definition destroyed_by_setstack (ty: typ): list mreg := nil.
+
+Definition destroyed_at_function_entry: list mreg := R29 :: nil.
+
+Definition destroyed_at_indirect_call: list mreg := nil.
+
+Definition temp_for_parent_frame: mreg := R29.
+
+Definition mregs_for_operation (op: operation): list (option mreg) * option mreg :=
+  (nil, None).
+
+Definition mregs_for_builtin (ef: external_function): list (option mreg) * list(option mreg) :=
+  (nil, nil).
+
+Global Opaque
+    destroyed_by_op destroyed_by_load destroyed_by_store
+    destroyed_by_cond destroyed_by_jumptable destroyed_by_builtin
+    destroyed_by_setstack destroyed_at_function_entry temp_for_parent_frame
+    destroyed_at_indirect_call
+    mregs_for_operation mregs_for_builtin.
+
+(** Two-address operations.  Return [true] if the first argument and
+  the result must be in the same location *and* are unconstrained
+  by [mregs_for_operation].  There is one for AArch64: [Olowlong],
+  which is actually a no-operation in the generated asm code. *)
+
+Definition two_address_op (op: operation) : bool := 
+  match op with
+  | Olowlong => true
+  | _ => false
+  end.
+
+Global Opaque two_address_op.
+
+(* Constraints on constant propagation for builtins *)
+
+Definition builtin_constraints (ef: external_function) :
+                                       list builtin_arg_constraint :=
+  match ef with
+  | EF_vload _ => OK_addressing :: nil
+  | EF_vstore _ => OK_addressing :: OK_default :: nil
+  | EF_memcpy _ _ => OK_addrstack :: OK_addrstack :: nil
+  | EF_annot kind txt targs => map (fun _ => OK_all) targs
+  | EF_debug kind txt targs => map (fun _ => OK_all) targs
+  | _ => nil
+  end.
+
diff --git a/aarch64/Machregsaux.ml b/aarch64/Machregsaux.ml
new file mode 100644
index 00000000..d7f10b9b
--- /dev/null
+++ b/aarch64/Machregsaux.ml
@@ -0,0 +1,35 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Auxiliary functions on machine registers *)
+
+open Camlcoq
+open Machregs
+
+let register_names : (mreg, string) Hashtbl.t = Hashtbl.create 31
+
+let _ =
+  List.iter
+    (fun (s, r) -> Hashtbl.add register_names r (camlstring_of_coqstring s))
+    Machregs.register_names
+
+let is_scratch_register s =
+  s = "X16" || s = "x16" || s = "X30" || s = "x30"
+
+
+let name_of_register r =
+  try Some (Hashtbl.find register_names r) with Not_found -> None
+
+let register_by_name s =
+  Machregs.register_by_name (coqstring_uppercase_ascii_of_camlstring s)
+
+let can_reserve_register r = Conventions1.is_callee_save r
diff --git a/aarch64/NeedOp.v b/aarch64/NeedOp.v
new file mode 100644
index 00000000..8fcab9e1
--- /dev/null
+++ b/aarch64/NeedOp.v
@@ -0,0 +1,253 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+Require Import Coqlib.
+Require Import AST Integers Floats.
+Require Import Values Memory Globalenvs.
+Require Import Op RTL.
+Require Import NeedDomain.
+
+(** Neededness analysis for AArch64 operators *)
+
+Definition needs_of_shift (s: shift) (a: amount32) (nv: nval) :=
+  match s with
+  | Slsl => shlimm nv a
+  | Sasr => shrimm nv a
+  | Slsr => shruimm nv a
+  | Sror => ror nv a
+  end.
+
+Definition zero_ext' (s: Z) (nv: nval) :=
+  if zle 0 s then zero_ext s nv else default nv.
+Definition sign_ext' (s: Z) (nv: nval) :=
+  if zlt 0 s then sign_ext s nv else default nv.
+
+Definition op1 (nv: nval) := nv :: nil.
+Definition op2 (nv: nval) := nv :: nv :: nil.
+Definition op1shift (s: shift) (a: amount32) (nv: nval) :=
+  needs_of_shift s a nv :: nil.
+Definition op2shift (s: shift) (a: amount32) (nv: nval) :=
+  nv :: needs_of_shift s a nv :: nil.
+
+Definition needs_of_condition (cond: condition): list nval := nil.
+
+Definition needs_of_operation (op: operation) (nv: nval): list nval :=
+  match op with
+  | Omove => nv :: nil
+  | Ointconst _ => nil
+  | Olongconst _ => nil
+  | Ofloatconst _ => nil
+  | Osingleconst _ => nil
+  | Oaddrsymbol _ _ => nil
+  | Oaddrstack _ => nil
+  | Oshift s a => op1shift s a nv
+  | Oadd | Osub | Omul => op2 (modarith nv)
+  | Oaddshift s a | Osubshift s a => op2shift s a (modarith nv)
+  | Oaddimm _ => op1 (modarith nv)
+  | Oneg => op1 (modarith nv)
+  | Onegshift s a => op1shift s a (modarith nv)
+  | Omuladd | Omulsub => 
+      let n := modarith nv in n :: n :: n :: nil
+  | Odiv | Odivu => op2 (default nv)
+  | Oand | Oor | Oxor => op2 (bitwise nv)
+  | Oandshift s a | Oorshift s a | Oxorshift s a =>  op2shift s a (bitwise nv)
+  | Oandimm  n => op1 (andimm nv n)
+  | Oorimm n => op1 (orimm nv n)
+  | Oxorimm n => op1 (bitwise nv)
+  | Onot => op1 (bitwise nv)
+  | Onotshift s a => needs_of_shift s a (bitwise nv) :: nil
+  | Obic | Oorn | Oeqv => 
+      let n := bitwise nv in n :: bitwise n :: nil
+  | Obicshift s a | Oornshift s a | Oeqvshift s a =>
+      let n := bitwise nv in n :: needs_of_shift s a (bitwise n) :: nil
+  | Oshl | Oshr | Oshru => op2 (default nv)
+  | Oshrximm _ => op1 (default nv)
+  | Ozext s => op1 (zero_ext' s nv)
+  | Osext s => op1 (sign_ext' s nv)
+  | Oshlzext s a => op1 (zero_ext' s (shlimm nv a))
+  | Oshlsext s a => op1 (sign_ext' s (shlimm nv a))
+  | Ozextshr a s => op1 (shruimm (zero_ext' s nv) a)
+  | Osextshr a s => op1 (shrimm (sign_ext' s nv) a)
+
+  | Oshiftl _ _ | Oextend _ _ => op1 (default nv)
+  | Omakelong  | Olowlong  | Ohighlong => op1 (default nv)
+  | Oaddl | Osubl | Omull => op2 (default nv)
+  | Oaddlshift _ _ | Oaddlext _ _ | Osublshift _ _ | Osublext _ _ => op2 (default nv)
+  | Oaddlimm _ => op1 (default nv)
+  | Onegl => op1 (default nv)
+  | Oneglshift _ _ => op1 (default nv)
+  | Omulladd | Omullsub => let n := default nv in n :: n :: n :: nil
+  | Omullhs | Omullhu | Odivl | Odivlu => op2 (default nv)
+  | Oandl | Oorl | Oxorl | Obicl | Oornl | Oeqvl => op2 (default nv)
+  | Oandlshift _ _ | Oorlshift _ _  | Oxorlshift _ _
+  | Obiclshift _ _ | Oornlshift _ _ | Oeqvlshift _ _ => op2 (default nv)
+  | Oandlimm _ | Oorlimm _ | Oxorlimm _ => op1 (default nv)
+  | Onotl => op1 (default nv)
+  | Onotlshift _ _ => op1 (default nv)
+  | Oshll | Oshrl | Oshrlu => op2 (default nv)
+  | Oshrlximm _ => op1 (default nv)
+  | Ozextl _ | Osextl _
+  | Oshllzext _ _ | Oshllsext _ _ | Ozextshrl _ _ | Osextshrl _ _ => op1 (default nv)
+  | Onegf | Oabsf => op1 (default nv)
+  | Oaddf | Osubf | Omulf | Odivf => op2 (default nv)
+  | Onegfs | Oabsfs => op1 (default nv)
+  | Oaddfs | Osubfs | Omulfs | Odivfs => op2 (default nv)
+  | Ofloatofsingle | Osingleoffloat => op1 (default nv)
+  | Ointoffloat | Ointuoffloat | Ofloatofint | Ofloatofintu => op1 (default nv)
+  | Olongoffloat | Olonguoffloat | Ofloatoflong | Ofloatoflongu => op1 (default nv)
+  | Ointofsingle | Ointuofsingle | Osingleofint | Osingleofintu => op1 (default nv)
+  | Olongofsingle | Olonguofsingle | Osingleoflong | Osingleoflongu => op1 (default nv)
+  | Ocmp c => needs_of_condition c
+  | Osel c ty => nv :: nv :: needs_of_condition c
+  end.
+
+Definition operation_is_redundant (op: operation) (nv: nval): bool :=
+  match op with
+  | Ozext s => zle 0 s && zero_ext_redundant s nv
+  | Osext s => zlt 0 s && sign_ext_redundant s nv
+  | Oandimm n => andimm_redundant nv n
+  | Oorimm n => orimm_redundant nv n
+  | _ => false
+  end.
+
+Ltac InvAgree :=
+  match goal with
+  | [H: vagree_list nil _ _ |- _ ] => inv H; InvAgree
+  | [H: vagree_list (_::_) _ _ |- _ ] => inv H; InvAgree
+  | _ => idtac
+  end.
+
+Ltac TrivialExists :=
+  match goal with
+  | [ |- exists v, Some ?x = Some v /\ _ ] => exists x; split; auto
+  | _ => idtac
+  end.
+
+Lemma shift_sound:
+  forall v w s a x,
+  vagree v w (needs_of_shift s a x) ->
+  vagree (eval_shift s v a) (eval_shift s w a) x.
+Proof.
+  intros until x; destruct s; simpl; intros.
+- apply shlimm_sound; auto.
+- apply shruimm_sound; auto.
+- apply shrimm_sound; auto.
+- apply ror_sound; auto.
+Qed.
+
+Lemma zero_ext'_sound:
+  forall v w x n,
+  vagree v w (zero_ext' n x) ->
+  vagree (Val.zero_ext n v) (Val.zero_ext n w) x.
+Proof.
+  unfold zero_ext'; intros. destruct (zle 0 n).
+- apply zero_ext_sound; auto.
+- assert (E: x = Nothing \/ Val.lessdef v w) by (destruct x; auto).
+  destruct E. subst x; simpl; auto. apply vagree_lessdef; apply Val.zero_ext_lessdef; auto.
+Qed.
+
+Lemma sign_ext'_sound:
+  forall v w x n,
+  vagree v w (sign_ext' n x) ->
+  vagree (Val.sign_ext n v) (Val.sign_ext n w) x.
+Proof.
+  unfold sign_ext'; intros. destruct (zlt 0 n).
+- apply sign_ext_sound; auto.
+- assert (E: x = Nothing \/ Val.lessdef v w) by (destruct x; auto).
+  destruct E. subst x; simpl; auto. apply vagree_lessdef; apply Val.sign_ext_lessdef; auto.
+Qed.
+
+Section SOUNDNESS.
+
+Variable ge: genv.
+Variable sp: block.
+Variables m m': mem.
+Hypothesis PERM: forall b ofs k p, Mem.perm m b ofs k p -> Mem.perm m' b ofs k p.
+
+Lemma needs_of_condition_sound:
+  forall cond args b args',
+  eval_condition cond args m = Some b ->
+  vagree_list args args' (needs_of_condition cond) ->
+  eval_condition cond args' m' = Some b.
+Proof.
+  intros. unfold needs_of_condition in H0.
+  eapply default_needs_of_condition_sound; eauto.
+Qed.
+
+Lemma needs_of_operation_sound:
+  forall op args v nv args',
+  eval_operation ge (Vptr sp Ptrofs.zero) op args m = Some v ->
+  vagree_list args args' (needs_of_operation op nv) ->
+  nv <> Nothing ->
+  exists v',
+     eval_operation ge (Vptr sp Ptrofs.zero) op args' m' = Some v'
+  /\ vagree v v' nv.
+Proof.
+  unfold needs_of_operation; intros; destruct op; try (eapply default_needs_of_operation_sound; eauto; fail);
+  simpl in *; FuncInv; InvAgree; TrivialExists.
+- apply shift_sound; auto.
+- apply add_sound; auto.
+- apply add_sound; auto using shift_sound.
+- apply add_sound; auto with na.
+- apply neg_sound; auto.
+- apply neg_sound; auto using shift_sound.
+- apply sub_sound; auto.
+- apply sub_sound; auto using shift_sound.
+- apply mul_sound; auto.
+- apply add_sound; auto. apply mul_sound; rewrite modarith_idem; auto. 
+- apply sub_sound; auto. apply mul_sound; rewrite modarith_idem; auto. 
+- apply and_sound; auto.
+- apply and_sound; auto using shift_sound.
+- apply andimm_sound; auto.
+- apply or_sound; auto.
+- apply or_sound; auto using shift_sound.
+- apply orimm_sound; auto.
+- apply xor_sound; auto.
+- apply xor_sound; auto using shift_sound.
+- apply xor_sound; auto with na.
+- apply notint_sound; auto.
+- apply notint_sound; auto using shift_sound.
+- apply and_sound; auto. apply notint_sound; rewrite bitwise_idem; auto.
+- apply and_sound; auto. apply notint_sound; rewrite bitwise_idem; auto using shift_sound.
+- apply or_sound; auto. apply notint_sound; rewrite bitwise_idem; auto.
+- apply or_sound; auto. apply notint_sound; rewrite bitwise_idem; auto using shift_sound.
+- apply xor_sound; auto. apply notint_sound; rewrite bitwise_idem; auto.
+- apply xor_sound; auto. apply notint_sound; rewrite bitwise_idem; auto using shift_sound.
+- apply zero_ext'_sound; auto.
+- apply sign_ext'_sound; auto.
+- apply shlimm_sound; apply zero_ext'_sound; auto.
+- apply shlimm_sound; apply sign_ext'_sound; auto.
+- apply zero_ext'_sound; apply shruimm_sound; auto.
+- apply sign_ext'_sound; apply shrimm_sound; auto.
+- destruct (eval_condition cond args m) as [b|] eqn:EC.
+  erewrite needs_of_condition_sound by eauto.
+  apply select_sound; auto.
+  simpl; auto with na.
+Qed.
+
+Lemma operation_is_redundant_sound:
+  forall op nv arg1 args v arg1' args',
+  operation_is_redundant op nv = true ->
+  eval_operation ge (Vptr sp Ptrofs.zero) op (arg1 :: args) m = Some v ->
+  vagree_list (arg1 :: args) (arg1' :: args') (needs_of_operation op nv) ->
+  vagree v arg1' nv.
+Proof.
+  intros. destruct op; simpl in *; try discriminate; inv H1; FuncInv; subst.
+- apply andimm_redundant_sound; auto.
+- apply orimm_redundant_sound; auto.
+- InvBooleans. unfold zero_ext' in H5; rewrite zle_true in H5 by auto. 
+  apply zero_ext_redundant_sound; auto.
+- InvBooleans. unfold sign_ext' in H5; rewrite zlt_true in H5 by auto. 
+  apply sign_ext_redundant_sound; auto.
+Qed.
+
+End SOUNDNESS.
diff --git a/aarch64/Op.v b/aarch64/Op.v
new file mode 100644
index 00000000..a7483d56
--- /dev/null
+++ b/aarch64/Op.v
@@ -0,0 +1,1778 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  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 processor-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 Axioms Coqlib BoolEqual.
+Require Import AST Integers Floats Values Memory Globalenvs Events.
+
+Set Implicit Arguments.
+Local Transparent Archi.ptr64.
+
+(** Shift amounts *)
+
+Record amount32 : Type := {
+  a32_amount :> int;
+  a32_range  : Int.ltu a32_amount Int.iwordsize = true }.
+
+Record amount64 : Type := {
+  a64_amount :> int;
+  a64_range  : Int.ltu a64_amount Int64.iwordsize' = true }.
+
+(** Shifted operands *)
+
+Inductive shift : Type :=
+  | Slsl                                (**r left shift *)
+  | Slsr                                (**r right unsigned shift *)
+  | Sasr                                (**r right signed shift *)
+  | Sror.                               (**r rotate right *)
+
+(** Sign- or zero-extended operands *)
+
+Inductive extension : Type :=
+  | Xsgn32                              (**r from signed 32-bit integer to 64-bit integer *)
+  | Xuns32.                             (**r from unsigned 32-bit integer to 64-bit integer *)
+
+(** Conditions (boolean-valued operators). *)
+
+Inductive condition: Type :=
+(** Tests over 32-bit integers *)
+  | Ccomp (c: comparison)                               (**r signed comparison *)
+  | Ccompu (c: comparison)                              (**r unsigned comparison *)
+  | Ccompimm (c: comparison) (n: int)                   (**r signed comparison with constant *)
+  | Ccompuimm (c: comparison) (n: int)                  (**r unsigned comparison with constant *)
+  | Ccompshift (c: comparison) (s: shift) (a: amount32) (**r signed comparison with shift *)
+  | Ccompushift (c: comparison) (s: shift) (a: amount32)(**r unsigned comparison width shift *)
+  | Cmaskzero (n: int)                                  (**r test [(arg & n) == 0] *)
+  | Cmasknotzero (n: int)                               (**r test [(arg & n) != 0] *)
+(** Tests over 64-bit integers *)
+  | Ccompl (c: comparison)                              (**r signed comparison *)
+  | Ccomplu (c: comparison)                             (**r unsigned comparison *)
+  | Ccomplimm (c: comparison) (n: int64)                (**r signed comparison with constant *)
+  | Ccompluimm (c: comparison) (n: int64)               (**r unsigned comparison with constant *)
+  | Ccomplshift (c: comparison) (s: shift) (a: amount64)(**r signed comparison with shift *)
+  | Ccomplushift (c: comparison) (s: shift) (a: amount64)(**r unsigned comparison width shift *)
+  | Cmasklzero (n: int64)                               (**r test [(arg & n) == 0] *)
+  | Cmasklnotzero (n: int64)                            (**r test [(arg & n) != 0] *)
+(** Tests over 64-bit floating-point numbers *)
+  | Ccompf (c: comparison)                              (**r FP comparison *)
+  | Cnotcompf (c: comparison)                           (**r negation of an FP comparison *)
+  | Ccompfzero (c: comparison)                          (**r comparison with 0.0 *)
+  | Cnotcompfzero (c: comparison)                       (**r negation of comparison with 0.0 *)
+(** Tests over 32-bit floating-point numbers *)
+  | Ccompfs (c: comparison)                             (**r FP comparison *)
+  | Cnotcompfs (c: comparison)                          (**r negation of an FP comparison *)
+  | Ccompfszero (c: comparison)                         (**r equal to 0.0 *)
+  | Cnotcompfszero (c: comparison).                     (**r not equal to 0.0 *)
+
+(** Arithmetic and logical operations.  In the descriptions, [rd] is the
+  result of the operation and [r1], [r2], etc, are the arguments. *)
+
+Inductive operation : Type :=
+  | Omove                                               (**r [rd = r1] *)
+  | Ointconst (n: int)                                  (**r [rd] is set to the given integer constant *)
+  | Olongconst (n: int64)                               (**r [rd] is set to the given integer constant *)
+  | Ofloatconst (n: float)                              (**r [rd] is set to the given float constant *)
+  | Osingleconst (n: float32)                           (**r [rd] is set to the given float constant *)
+  | Oaddrsymbol (id: ident) (ofs: ptrofs)               (**r [rd] is set to the address of the symbol plus the given offset *)
+  | Oaddrstack (ofs: ptrofs)                            (**r [rd] is set to the stack pointer plus the given offset *)
+(** 32-bit integer arithmetic *)
+  | Oshift (s: shift) (a: amount32)                     (**r shift or rotate by immediate quantity *)
+  | Oadd                                                (**r [rd = r1 + r2] *)
+  | Oaddshift (s: shift) (a: amount32)                  (**r [rd = r1 + shifted r2] *)
+  | Oaddimm (n: int)                                    (**r [rd = r1 + n] *)
+  | Oneg                                                (**r [rd = - r1]   *)                     
+  | Onegshift (s: shift) (a: amount32)                  (**r [rd = - shifted r1] *)
+  | Osub                                                (**r [rd = r1 - r2] *)
+  | Osubshift (s: shift) (a: amount32)                  (**r [rd = r1 - shifted r2] *)
+  | Omul                                                (**r [rd = r1 * r2] *)
+  | Omuladd                                             (**r [rd = r1 + r2 * r3] *)
+  | Omulsub                                             (**r [rd = r1 - r2 * r3] *)
+  | Odiv                                                (**r [rd = r1 / r2] (signed) *)
+  | Odivu                                               (**r [rd = r1 / r2] (unsigned) *)
+  | Oand                                                (**r [rd = r1 & r2] *)
+  | Oandshift (s: shift) (a: amount32)                  (**r [rd = r1 & shifted r2] *)
+  | Oandimm (n: int)                                    (**r [rd = r1 & n] *)
+  | Oor                                                 (**r [rd = r1 | r2] *)
+  | Oorshift (s: shift) (a: amount32)                   (**r [rd = r1 | shifted r2] *)
+  | Oorimm (n: int)                                     (**r [rd = r1 | n] *)
+  | Oxor                                                (**r [rd = r1 ^ r2] *)
+  | Oxorshift (s: shift) (a: amount32)                  (**r [rd = r1 ^ shifted r2] *)
+  | Oxorimm (n: int)                                    (**r [rd = r1 ^ n] *)
+  | Onot                                                (**r [rd = ~r1] *)
+  | Onotshift (s: shift) (a: amount32)                  (**r [rd = ~ shifted r1] *)
+  | Obic                                                (**r [rd = r1 & ~r2] *)
+  | Obicshift (s: shift) (a: amount32)                  (**r [rd = r1 ^ ~ shifted r2] *)
+  | Oorn                                                (**r [rd = r1 | ~r2] *)
+  | Oornshift (s: shift) (a: amount32)                  (**r [rd = r1 | ~ shifted r2] *)
+  | Oeqv                                                (**r [rd = r1 ^ ~r2] *)
+  | Oeqvshift (s: shift) (a: amount32)                  (**r [rd = r1 | ~ shifted r2] *)
+  | Oshl                                                (**r [rd = r1 << r2] *)
+  | Oshr                                                (**r [rd = r1 >> r2] (signed) *)
+  | Oshru                                               (**r [rd = r1 >> r2] (unsigned) *)
+  | Oshrximm (n: int)                                   (**r [rd = r1 / 2^n] (signed) *)
+  | Ozext (s: Z)                                        (**r [rd = zero_ext(r1,s)] *)
+  | Osext (s: Z)                                        (**r [rd = sign_ext(r1,s)] *)
+  | Oshlzext (s: Z) (a: amount32)                       (**r [rd = zero_ext(r1,s) << a] *)
+  | Oshlsext (s: Z) (a: amount32)                       (**r [rd = sign_ext(r1,s) << a] *)
+  | Ozextshr (a: amount32) (s: Z)                       (**r [rd = zero_ext(r1 >> a, s)] *)
+  | Osextshr (a: amount32) (s: Z)                       (**r [rd = sign_ext(r1 >> a, s)] *)
+(** 64-bit integer arithmetic *)
+  | Oshiftl (s: shift) (a: amount64)                    (**r shift or rotate by immediate quantity *)
+  | Oextend (x: extension) (a: amount64)                (**r convert from 32 to 64 bits and shift *)
+  | Omakelong                                           (**r [rd = r1 << 32 | r2] *)
+  | Olowlong                                            (**r [rd = low-word(r1)] *)
+  | Ohighlong                                           (**r [rd = high-word(r1)] *)
+  | Oaddl                                               (**r [rd = r1 + r2] *)
+  | Oaddlshift (s: shift) (a: amount64)                 (**r [rd = r1 + shifted r2] *)
+  | Oaddlext (x: extension) (a: amount64)               (**r [rd = r1 + shifted, converted r2] *)
+  | Oaddlimm (n: int64)                                 (**r [rd = r1 + n] *)
+  | Onegl                                               (**r [rd = - r1]   *)                     
+  | Oneglshift (s: shift) (a: amount64)                 (**r [rd = - shifted r1] *)
+  | Osubl                                               (**r [rd = r1 - r2] *)
+  | Osublshift (s: shift) (a: amount64)                 (**r [rd = r1 - shifted r2] *)
+  | Osublext (x: extension) (a: amount64)               (**r [rd = r1 - shifted, converted r2] *)
+  | Omull                                               (**r [rd = r1 * r2] *)
+  | Omulladd                                            (**r [rd = r1 + r2 * r3] *)
+  | Omullsub                                            (**r [rd = r1 - r2 * r3] *)
+  | Omullhs                                             (**r [rd = high part of r1 * r2 (signed)] *)
+  | Omullhu                                             (**r [rd = high part of r1 * r2 (unsigned)] *)
+  | Odivl                                               (**r [rd = r1 / r2] (signed) *)
+  | Odivlu                                              (**r [rd = r1 / r2] (unsigned) *)
+  | Oandl                                               (**r [rd = r1 & r2] *)
+  | Oandlshift (s: shift) (a: amount64)                 (**r [rd = r1 & shifted r2] *)
+  | Oandlimm (n: int64)                                 (**r [rd = r1 & n] *)
+  | Oorl                                                (**r [rd = r1 | r2] *)
+  | Oorlshift (s: shift) (a: amount64)                  (**r [rd = r1 | shifted r2] *)
+  | Oorlimm (n: int64)                                  (**r [rd = r1 | n] *)
+  | Oxorl                                               (**r [rd = r1 ^ r2] *)
+  | Oxorlshift (s: shift) (a: amount64)                 (**r [rd = r1 ^ shifted r2] *)
+  | Oxorlimm (n: int64)                                 (**r [rd = r1 ^ n] *)
+  | Onotl                                               (**r [rd = ~r1] *)
+  | Onotlshift (s: shift) (a: amount64)                 (**r [rd = ~ shifted r1] *)
+  | Obicl                                               (**r [rd = r1 & ~r2] *)
+  | Obiclshift (s: shift) (a: amount64)                 (**r [rd = r1 ^ ~ shifted r2] *)
+  | Oornl                                               (**r [rd = r1 | ~r2] *)
+  | Oornlshift (s: shift) (a: amount64)                 (**r [rd = r1 | ~ shifted r2] *)
+  | Oeqvl                                               (**r [rd = r1 ^ ~r2] *)
+  | Oeqvlshift (s: shift) (a: amount64)                 (**r [rd = r1 | ~ shifted r2] *)
+  | Oshll                                               (**r [rd = r1 << r2] *)
+  | Oshrl                                               (**r [rd = r1 >> r2] (signed) *)
+  | Oshrlu                                              (**r [rd = r1 >> r2] (unsigned) *)
+  | Oshrlximm (n: int)                                  (**r [rd = r1 / 2^n] (signed) *)
+  | Ozextl (s: Z)                                       (**r [rd = zero_ext(r1,s)] *)
+  | Osextl (s: Z)                                       (**r [rd = sign_ext(r1,s)] *)
+  | Oshllzext (s: Z) (a: amount64)                      (**r [rd = zero_ext(r1,s) << a] *)
+  | Oshllsext (s: Z) (a: amount64)                      (**r [rd = sign_ext(r1,s) << a] *)
+  | Ozextshrl (a: amount64) (s: Z)                      (**r [rd = zero_ext(r1 >> a, s)] *)
+  | Osextshrl (a: amount64) (s: Z)                      (**r [rd = sign_ext(r1 >> a, s)] *)
+(** 64-bit floating-point arithmetic *)
+  | Onegf                                               (**r [rd = - r1] *)
+  | Oabsf                                               (**r [rd = abs(r1)] *)
+  | Oaddf                                               (**r [rd = r1 + r2] *)
+  | Osubf                                               (**r [rd = r1 - r2] *)
+  | Omulf                                               (**r [rd = r1 * r2] *)
+  | Odivf                                               (**r [rd = r1 / r2] *)
+(** 32-bit floating-point arithmetic *)
+  | Onegfs                                              (**r [rd = - r1] *)
+  | Oabsfs                                              (**r [rd = abs(r1)] *)
+  | Oaddfs                                              (**r [rd = r1 + r2] *)
+  | Osubfs                                              (**r [rd = r1 - r2] *)
+  | Omulfs                                              (**r [rd = r1 * r2] *)
+  | Odivfs                                              (**r [rd = r1 / r2] *)
+  | Osingleoffloat                                      (**r [rd] is [r1] truncated to single-precision float *)
+  | Ofloatofsingle                                      (**r [rd] is [r1] extended to double-precision float *)
+(** Conversions between int and float *)
+  | Ointoffloat                                         (**r [rd = signed_int_of_float64(r1)] *)
+  | Ointuoffloat                                        (**r [rd = unsigned_int_of_float64(r1)] *)
+  | Ofloatofint                                         (**r [rd = float64_of_signed_int(r1)] *)
+  | Ofloatofintu                                        (**r [rd = float64_of_unsigned_int(r1)] *)
+  | Ointofsingle                                        (**r [rd = signed_int_of_float32(r1)] *)
+  | Ointuofsingle                                       (**r [rd = unsigned_int_of_float32(r1)] *)
+  | Osingleofint                                        (**r [rd = float32_of_signed_int(r1)] *)
+  | Osingleofintu                                       (**r [rd = float32_of_unsigned_int(r1)] *)
+  | Olongoffloat                                        (**r [rd = signed_long_of_float64(r1)] *)
+  | Olonguoffloat                                       (**r [rd = unsigned_long_of_float64(r1)] *)
+  | Ofloatoflong                                        (**r [rd = float64_of_signed_long(r1)] *)
+  | Ofloatoflongu                                       (**r [rd = float64_of_unsigned_long(r1)] *)
+  | Olongofsingle                                       (**r [rd = signed_long_of_float32(r1)] *)
+  | Olonguofsingle                                      (**r [rd = unsigned_long_of_float32(r1)] *)
+  | Osingleoflong                                       (**r [rd = float32_of_signed_long(r1)] *)
+  | Osingleoflongu                                      (**r [rd = float32_of_unsigned_int(r1)] *)
+(** Boolean tests *)
+  | Ocmp (cond: condition)                              (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
+  | Osel (cond: condition) (ty: typ).                   (**r [rd = rs1] if condition holds, [rd = rs2] otherwise. *)
+
+(** Addressing modes.  [r1], [r2], etc, are the arguments to the addressing. *)
+
+Inductive addressing: Type :=
+  | Aindexed (ofs: int64)                               (**r Address is [r1 + offset] *)
+  | Aindexed2                                           (**r Address is [r1 + r2] *)
+  | Aindexed2shift (a: amount64)                        (**r Address is [r1 + r2 << a] *)
+  | Aindexed2ext (x: extension) (a: amount64)           (**r Address is [r1 + sign-or-zero-ext(r2) << a] *)
+  | Aglobal (id: ident) (ofs: ptrofs)                   (**r Address is [global + offset] *)
+  | Ainstack (ofs: ptrofs).                             (**r Address is [stack_pointer + offset] *)
+
+(** Comparison functions (used in modules [CSE] and [Allocation]). *)
+
+Definition eq_amount32 (x y: amount32): {x=y} + {x<>y}.
+Proof.
+  destruct x as [x Px], y as [y Py].
+  destruct (Int.eq_dec x y).
+- subst y. assert (Px = Py) by (apply proof_irr). subst Py. left; auto.
+- right; congruence.
+Defined.
+
+Definition eq_amount64 (x y: amount64): {x=y} + {x<>y}.
+Proof.
+  destruct x as [x Px], y as [y Py].
+  destruct (Int.eq_dec x y).
+- subst y. assert (Px = Py) by (apply proof_irr). subst Py. left; auto.
+- right; congruence.
+Defined.
+
+Definition eq_shift (x y: shift): {x=y} + {x<>y}.
+Proof.
+  decide equality.
+Defined.
+
+Definition eq_extension (x y: extension): {x=y} + {x<>y}.
+Proof.
+  decide equality.
+Defined.
+
+Definition eq_condition (x y: condition) : {x=y} + {x<>y}.
+Proof.
+  assert (forall (x y: comparison), {x=y}+{x<>y}) by decide equality.
+  generalize Int.eq_dec Int64.eq_dec eq_shift eq_amount32 eq_amount64; intro.
+  decide equality.
+Defined.
+
+Definition eq_addressing (x y: addressing) : {x=y} + {x<>y}.
+Proof.
+  generalize ident_eq Int64.eq_dec Ptrofs.eq_dec eq_extension eq_amount64; intros.
+  decide equality.
+Defined.
+
+Definition eq_operation: forall (x y: operation), {x=y} + {x<>y}.
+Proof.
+  intros.
+  generalize Int.eq_dec Int64.eq_dec Ptrofs.eq_dec Float.eq_dec Float32.eq_dec
+             zeq ident_eq eq_shift eq_extension eq_amount32 eq_amount64
+             typ_eq eq_condition; 
+  decide equality.
+Defined.
+
+(** Alternative:
+
+Definition beq_operation: forall (x y: operation), bool.
+Proof.
+  generalize Int.eq_dec Int64.eq_dec Ptrofs.eq_dec Float.eq_dec Float32.eq_dec
+             zeq ident_eq eq_shift eq_extension eq_amount32 eq_amount64
+             eq_condition typ_eq; boolean_equality.
+Defined.
+
+Definition eq_operation: forall (x y: operation), {x=y} + {x<>y}.
+Proof.
+  decidable_equality_from beq_operation.
+Defined.
+*)
+
+(** * Evaluation functions *)
+
+(** Evaluation of conditions, operators and addressing modes applied
+  to lists of values.  Return [None] when the computation can trigger an
+  error, e.g. integer division by zero.  [eval_condition] returns a boolean,
+  [eval_operation] and [eval_addressing] return a value. *)
+
+Definition eval_shift (s: shift) (v: val) (n: amount32) : val :=
+  match s with
+  | Slsl => Val.shl v (Vint n)
+  | Slsr => Val.shru v (Vint n)
+  | Sasr => Val.shr v (Vint n)
+  | Sror => Val.ror v (Vint n)
+  end.
+
+Definition eval_shiftl (s: shift) (v: val) (n: amount64) : val :=
+  match s with
+  | Slsl => Val.shll v (Vint n)
+  | Slsr => Val.shrlu v (Vint n)
+  | Sasr => Val.shrl v (Vint n)
+  | Sror => Val.rorl v (Vint n)
+  end.
+
+Definition eval_extend (x: extension) (v: val) (n: amount64) : val :=
+  Val.shll
+    (match x with
+      | Xsgn32 => Val.longofint v
+      | Xuns32 => Val.longofintu v
+     end)
+    (Vint n).
+
+Definition eval_condition (cond: condition) (vl: list val) (m: mem): option bool :=
+  match cond, vl with
+  | Ccomp c, v1 :: v2 :: nil => Val.cmp_bool c v1 v2
+  | Ccompu c, v1 :: v2 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 v2
+  | Ccompimm c n, v1 :: nil => Val.cmp_bool c v1 (Vint n)
+  | Ccompuimm c n, v1 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 (Vint n)
+  | Ccompshift c s a, v1 :: v2 :: nil => Val.cmp_bool c v1 (eval_shift s v2 a)
+  | Ccompushift c s a, v1 :: v2 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 (eval_shift s v2 a)
+  | Cmaskzero n, v1 :: nil => Val.cmp_bool Ceq (Val.and v1 (Vint n)) (Vint Int.zero)
+  | Cmasknotzero n, v1 :: nil => Val.cmp_bool Cne (Val.and v1 (Vint n)) (Vint Int.zero)
+
+  | Ccompl c, v1 :: v2 :: nil => Val.cmpl_bool c v1 v2
+  | Ccomplu c, v1 :: v2 :: nil => Val.cmplu_bool (Mem.valid_pointer m) c v1 v2
+  | Ccomplimm c n, v1 :: nil => Val.cmpl_bool c v1 (Vlong n)
+  | Ccompluimm c n, v1 :: nil => Val.cmplu_bool (Mem.valid_pointer m) c v1 (Vlong n)
+  | Ccomplshift c s a, v1 :: v2 :: nil => Val.cmpl_bool c v1 (eval_shiftl s v2 a)
+  | Ccomplushift c s a, v1 :: v2 :: nil => Val.cmplu_bool (Mem.valid_pointer m) c v1 (eval_shiftl s v2 a)
+  | Cmasklzero n, v1 :: nil => Val.cmpl_bool Ceq (Val.andl v1 (Vlong n)) (Vlong Int64.zero)
+  | Cmasklnotzero n, v1 :: nil => Val.cmpl_bool Cne (Val.andl v1 (Vlong n)) (Vlong Int64.zero)
+
+  | Ccompf c, v1 :: v2 :: nil => Val.cmpf_bool c v1 v2
+  | Cnotcompf c, v1 :: v2 :: nil => option_map negb (Val.cmpf_bool c v1 v2)
+  | Ccompfzero c, v1 :: nil => Val.cmpf_bool c v1 (Vfloat Float.zero)
+  | Cnotcompfzero c, v1 :: nil => option_map negb (Val.cmpf_bool c v1 (Vfloat Float.zero))
+
+  | Ccompfs c, v1 :: v2 :: nil => Val.cmpfs_bool c v1 v2
+  | Cnotcompfs c, v1 :: v2 :: nil => option_map negb (Val.cmpfs_bool c v1 v2)
+  | Ccompfszero c, v1 :: nil => Val.cmpfs_bool c v1 (Vsingle Float32.zero)
+  | Cnotcompfszero c, v1 :: nil => option_map negb (Val.cmpfs_bool c v1 (Vsingle Float32.zero))
+
+  | _, _ => None
+  end.
+
+Definition eval_operation
+    (F V: Type) (genv: Genv.t F V) (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)
+  | Olongconst n, nil => Some (Vlong n)
+  | Ofloatconst n, nil => Some (Vfloat n)
+  | Osingleconst n, nil => Some (Vsingle n)
+  | Oaddrsymbol s ofs, nil => Some (Genv.symbol_address genv s ofs)
+  | Oaddrstack ofs, nil => Some (Val.offset_ptr sp ofs)
+
+  | Oshift s a, v1 :: nil => Some (eval_shift s v1 a)
+  | Oadd, v1 :: v2 :: nil => Some (Val.add v1 v2)
+  | Oaddshift s a, v1 :: v2 :: nil => Some (Val.add v1 (eval_shift s v2 a))
+  | Oaddimm n, v1 :: nil => Some (Val.add v1 (Vint n))
+  | Oneg, v1 :: nil => Some (Val.neg v1)
+  | Onegshift s a, v1 :: nil => Some (Val.neg (eval_shift s v1 a))
+  | Osub, v1 :: v2 :: nil => Some (Val.sub v1 v2)
+  | Osubshift s a, v1 :: v2 :: nil => Some (Val.sub v1 (eval_shift s v2 a))
+  | Omul, v1 :: v2 :: nil => Some (Val.mul v1 v2)
+  | Omuladd, v1 :: v2 :: v3 :: nil => Some (Val.add v1 (Val.mul v2 v3))
+  | Omulsub, v1 :: v2 :: v3 :: nil => Some (Val.sub v1 (Val.mul v2 v3))
+  | Odiv, v1 :: v2 :: nil => Val.divs v1 v2
+  | Odivu, v1 :: v2 :: nil => Val.divu v1 v2
+  | Oand, v1 :: v2 :: nil => Some (Val.and v1 v2)
+  | Oandshift s a, v1 :: v2 :: nil => Some (Val.and v1 (eval_shift s v2 a))
+  | Oandimm n, v1 :: nil => Some (Val.and v1 (Vint n))
+  | Oor, v1 :: v2 :: nil => Some (Val.or v1 v2)
+  | Oorshift s a, v1 :: v2 :: nil => Some (Val.or v1 (eval_shift s v2 a))
+  | Oorimm n, v1 :: nil => Some (Val.or v1 (Vint n))
+  | Oxor, v1 :: v2 :: nil => Some (Val.xor v1 v2)
+  | Oxorshift s a, v1 :: v2 :: nil => Some (Val.xor v1 (eval_shift s v2 a))
+  | Oxorimm n, v1 :: nil => Some (Val.xor v1 (Vint n))
+  | Onot, v1 :: nil => Some (Val.notint v1)
+  | Onotshift s a, v1 :: nil => Some (Val.notint (eval_shift s v1 a))
+  | Obic, v1 :: v2 :: nil => Some (Val.and v1 (Val.notint v2))
+  | Obicshift s a, v1 :: v2 :: nil => Some (Val.and v1 (Val.notint (eval_shift s v2 a)))
+  | Oorn, v1 :: v2 :: nil => Some (Val.or v1 (Val.notint v2))
+  | Oornshift s a, v1 :: v2 :: nil => Some (Val.or v1 (Val.notint (eval_shift s v2 a)))
+  | Oeqv, v1 :: v2 :: nil => Some (Val.xor v1 (Val.notint v2))
+  | Oeqvshift s a, v1 :: v2 :: nil => Some (Val.xor v1 (Val.notint (eval_shift s v2 a)))
+  | Oshl, v1 :: v2 :: nil => Some (Val.shl v1 v2)
+  | Oshr, v1 :: v2 :: nil => Some (Val.shr v1 v2)
+  | Oshru, v1 :: v2 :: nil => Some (Val.shru v1 v2)
+  | Oshrximm n, v1::nil => Val.shrx v1 (Vint n)
+  | Ozext s, v1 :: nil => Some (Val.zero_ext s v1)
+  | Osext s, v1 :: nil => Some (Val.sign_ext s v1)
+  | Oshlzext s a, v1 :: nil => Some (Val.shl (Val.zero_ext s v1) (Vint a))
+  | Oshlsext s a, v1 :: nil => Some (Val.shl (Val.sign_ext s v1) (Vint a))
+  | Ozextshr a s, v1 :: nil => Some (Val.zero_ext s (Val.shru v1 (Vint a)))
+  | Osextshr a s, v1 :: nil => Some (Val.sign_ext s (Val.shr v1 (Vint a)))
+
+  | Oshiftl s a, v1 :: nil => Some (eval_shiftl s v1 a)
+  | Oextend x a, v1 :: nil => Some (eval_extend x v1 a)
+  | Omakelong, v1::v2::nil => Some (Val.longofwords v1 v2)
+  | Olowlong, v1::nil => Some (Val.loword v1)
+  | Ohighlong, v1::nil => Some (Val.hiword v1)
+  | Oaddl, v1 :: v2 :: nil => Some (Val.addl v1 v2)
+  | Oaddlshift s a, v1 :: v2 :: nil => Some (Val.addl v1 (eval_shiftl s v2 a))
+  | Oaddlext x a, v1 :: v2 :: nil => Some (Val.addl v1 (eval_extend x v2 a))
+  | Oaddlimm n, v1 :: nil => Some (Val.addl v1 (Vlong n))
+  | Onegl, v1 :: nil => Some (Val.negl v1)
+  | Oneglshift s a, v1 :: nil => Some (Val.negl (eval_shiftl s v1 a))
+  | Osubl, v1 :: v2 :: nil => Some (Val.subl v1 v2)
+  | Osublshift s a, v1 :: v2 :: nil => Some (Val.subl v1 (eval_shiftl s v2 a))
+  | Osublext x a, v1 :: v2 :: nil => Some (Val.subl v1 (eval_extend x v2 a))
+  | Omull, v1 :: v2 :: nil => Some (Val.mull v1 v2)
+  | Omulladd, v1 :: v2 :: v3 :: nil => Some (Val.addl v1 (Val.mull v2 v3))
+  | Omullsub, v1 :: v2 :: v3 :: nil => Some (Val.subl v1 (Val.mull v2 v3))
+  | Omullhs, v1::v2::nil => Some (Val.mullhs v1 v2)
+  | Omullhu, v1::v2::nil => Some (Val.mullhu v1 v2)
+  | Odivl, v1 :: v2 :: nil => Val.divls v1 v2
+  | Odivlu, v1 :: v2 :: nil => Val.divlu v1 v2
+  | Oandl, v1 :: v2 :: nil => Some (Val.andl v1 v2)
+  | Oandlshift s a, v1 :: v2 :: nil => Some (Val.andl v1 (eval_shiftl s v2 a))
+  | Oandlimm n, v1 :: nil => Some (Val.andl v1 (Vlong n))
+  | Oorl, v1 :: v2 :: nil => Some (Val.orl v1 v2)
+  | Oorlshift s a, v1 :: v2 :: nil => Some (Val.orl v1 (eval_shiftl s v2 a))
+  | Oorlimm n, v1 :: nil => Some (Val.orl v1 (Vlong n))
+  | Oxorl, v1 :: v2 :: nil => Some (Val.xorl v1 v2)
+  | Oxorlshift s a, v1 :: v2 :: nil => Some (Val.xorl v1 (eval_shiftl s v2 a))
+  | Oxorlimm n, v1 :: nil => Some (Val.xorl v1 (Vlong n))
+  | Onotl, v1 :: nil => Some (Val.notl v1)
+  | Onotlshift s a, v1 :: nil => Some (Val.notl (eval_shiftl s v1 a))
+  | Obicl, v1 :: v2 :: nil => Some (Val.andl v1 (Val.notl v2))
+  | Obiclshift s a, v1 :: v2 :: nil => Some (Val.andl v1 (Val.notl (eval_shiftl s v2 a)))
+  | Oornl, v1 :: v2 :: nil => Some (Val.orl v1 (Val.notl v2))
+  | Oornlshift s a, v1 :: v2 :: nil => Some (Val.orl v1 (Val.notl (eval_shiftl s v2 a)))
+  | Oeqvl, v1 :: v2 :: nil => Some (Val.xorl v1 (Val.notl v2))
+  | Oeqvlshift s a, v1 :: v2 :: nil => Some (Val.xorl v1 (Val.notl (eval_shiftl s v2 a)))
+  | Oshll, v1 :: v2 :: nil => Some (Val.shll v1 v2)
+  | Oshrl, v1 :: v2 :: nil => Some (Val.shrl v1 v2)
+  | Oshrlu, v1 :: v2 :: nil => Some (Val.shrlu v1 v2)
+  | Oshrlximm n, v1::nil => Val.shrxl v1 (Vint n)
+  | Ozextl s, v1 :: nil => Some (Val.zero_ext_l s v1)
+  | Osextl s, v1 :: nil => Some (Val.sign_ext_l s v1)
+  | Oshllzext s a, v1 :: nil => Some (Val.shll (Val.zero_ext_l s v1) (Vint a))
+  | Oshllsext s a, v1 :: nil => Some (Val.shll (Val.sign_ext_l s v1) (Vint a))
+  | Ozextshrl a s, v1 :: nil => Some (Val.zero_ext_l s (Val.shrlu v1 (Vint a)))
+  | Osextshrl a s, v1 :: nil => Some (Val.sign_ext_l s (Val.shrl v1 (Vint a)))
+
+  | Onegf, v1::nil => Some (Val.negf v1)
+  | Oabsf, v1::nil => Some (Val.absf v1)
+  | Oaddf, v1::v2::nil => Some (Val.addf v1 v2)
+  | Osubf, v1::v2::nil => Some (Val.subf v1 v2)
+  | Omulf, v1::v2::nil => Some (Val.mulf v1 v2)
+  | Odivf, v1::v2::nil => Some (Val.divf v1 v2)
+
+  | Onegfs, v1::nil => Some (Val.negfs v1)
+  | Oabsfs, v1::nil => Some (Val.absfs v1)
+  | Oaddfs, v1::v2::nil => Some (Val.addfs v1 v2)
+  | Osubfs, v1::v2::nil => Some (Val.subfs v1 v2)
+  | Omulfs, v1::v2::nil => Some (Val.mulfs v1 v2)
+  | Odivfs, v1::v2::nil => Some (Val.divfs v1 v2)
+
+  | Osingleoffloat, v1::nil => Some (Val.singleoffloat v1)
+  | Ofloatofsingle, v1::nil => Some (Val.floatofsingle 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
+  | Ointofsingle, v1::nil => Val.intofsingle v1
+  | Ointuofsingle, v1::nil => Val.intuofsingle v1
+  | Osingleofint, v1::nil => Val.singleofint v1
+  | Osingleofintu, v1::nil => Val.singleofintu v1
+  | Olongoffloat, v1::nil => Val.longoffloat v1
+  | Olonguoffloat, v1::nil => Val.longuoffloat v1
+  | Ofloatoflong, v1::nil => Val.floatoflong v1
+  | Ofloatoflongu, v1::nil => Val.floatoflongu v1
+  | Olongofsingle, v1::nil => Val.longofsingle v1
+  | Olonguofsingle, v1::nil => Val.longuofsingle v1
+  | Osingleoflong, v1::nil => Val.singleoflong v1
+  | Osingleoflongu, v1::nil => Val.singleoflongu v1
+
+  | Ocmp c, _ => Some (Val.of_optbool (eval_condition c vl m))
+  | Osel c ty, v1::v2::vl => Some(Val.select (eval_condition c vl m) v1 v2 ty)
+  | _, _ => None
+  end.
+
+Definition eval_addressing
+    (F V: Type) (genv: Genv.t F V) (sp: val)
+    (addr: addressing) (vl: list val) : option val :=
+  match addr, vl with
+  | Aindexed n, v1 :: nil => Some (Val.addl v1 (Vlong n))
+  | Aindexed2, v1 :: v2 :: nil => Some (Val.addl v1 v2)
+  | Aindexed2shift a, v1 :: v2 :: nil => Some (Val.addl v1 (Val.shll v2 (Vint a)))
+  | Aindexed2ext x a, v1 :: v2 :: nil => Some (Val.addl v1 (eval_extend x v2 a))
+  | Aglobal s ofs, nil => Some (Genv.symbol_address genv s ofs)
+  | Ainstack n, nil => Some (Val.offset_ptr sp n)
+  | _, _ => None
+  end.
+
+Remark eval_addressing_Ainstack:
+  forall (F V: Type) (genv: Genv.t F V) sp ofs,
+  eval_addressing genv sp (Ainstack ofs) nil = Some (Val.offset_ptr sp ofs).
+Proof.
+  intros. reflexivity.
+Qed.
+
+Remark eval_addressing_Ainstack_inv:
+  forall (F V: Type) (genv: Genv.t F V) sp ofs vl v,
+  eval_addressing genv sp (Ainstack ofs) vl = Some v -> vl = nil /\ v = Val.offset_ptr sp ofs.
+Proof.
+  unfold eval_addressing; intros; destruct vl; inv H; auto.
+Qed.
+
+Ltac FuncInv :=
+  match goal with
+  | H: (match ?x with nil => _ | _ :: _ => _ end = Some _) |- _ =>
+      destruct x; simpl in H; FuncInv
+  | H: (match ?v with Vundef => _ | Vint _ => _ | Vfloat _ => _ | Vptr _ _ => _ end = Some _) |- _ =>
+      destruct v; simpl in H; FuncInv
+  | H: (if Archi.ptr64 then _ else _) = Some _ |- _ =>
+      change Archi.ptr64 with true in H; simpl in H; FuncInv
+  | H: (Some _ = Some _) |- _ =>
+      injection H; intros; clear H; FuncInv
+  | H: (None = Some _) |- _ =>
+      discriminate H
+  | _ =>
+      idtac
+  end.
+
+(** * 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
+  | Ccompshift _ _ _ => Tint :: Tint :: nil
+  | Ccompushift _ _ _ => Tint :: Tint :: nil
+  | Cmaskzero _ => Tint :: nil
+  | Cmasknotzero _ => Tint :: nil
+  | Ccompl _ => Tlong :: Tlong :: nil
+  | Ccomplu _ => Tlong :: Tlong :: nil
+  | Ccomplimm _ _ => Tlong :: nil
+  | Ccompluimm _ _ => Tlong :: nil
+  | Ccomplshift _ _ _ => Tlong :: Tlong :: nil
+  | Ccomplushift _ _ _ => Tlong :: Tlong :: nil
+  | Cmasklzero _ => Tlong :: nil
+  | Cmasklnotzero _ => Tlong :: nil
+  | Ccompf _ => Tfloat :: Tfloat :: nil
+  | Cnotcompf _ => Tfloat :: Tfloat :: nil
+  | Ccompfzero _ => Tfloat :: nil
+  | Cnotcompfzero _ => Tfloat :: nil
+  | Ccompfs _ => Tsingle :: Tsingle :: nil
+  | Cnotcompfs _ => Tsingle :: Tsingle :: nil
+  | Ccompfszero _ => Tsingle :: nil
+  | Cnotcompfszero _ => Tsingle :: nil
+  end.
+
+Definition type_of_operation (op: operation) : list typ * typ :=
+  match op with
+  | Omove => (nil, Tint)   (* treated specially *)
+  | Ointconst _ => (nil, Tint)
+  | Olongconst _ => (nil, Tlong)
+  | Ofloatconst f => (nil, Tfloat)
+  | Osingleconst f => (nil, Tsingle)
+  | Oaddrsymbol _ _ => (nil, Tptr)
+  | Oaddrstack _ => (nil, Tptr)
+
+  | Oshift _ _ => (Tint :: nil, Tint)
+  | Oadd => (Tint :: Tint :: nil, Tint)
+  | Oaddshift _ _ => (Tint :: Tint :: nil, Tint)
+  | Oaddimm _ => (Tint :: nil, Tint)
+  | Oneg => (Tint :: nil, Tint)
+  | Onegshift _ _ => (Tint :: nil, Tint)
+  | Osub => (Tint :: Tint :: nil, Tint)
+  | Osubshift _ _ => (Tint :: Tint :: nil, Tint)
+  | Omul => (Tint :: Tint :: nil, Tint)
+  | Omuladd => (Tint :: Tint :: Tint :: nil, Tint)
+  | Omulsub => (Tint :: Tint :: Tint :: nil, Tint)
+  | Odiv => (Tint :: Tint :: nil, Tint)
+  | Odivu => (Tint :: Tint :: nil, Tint)
+  | Oand => (Tint :: Tint :: nil, Tint)
+  | Oandshift _ _ => (Tint :: Tint :: nil, Tint)
+  | Oandimm _ => (Tint :: nil, Tint)
+  | Oor => (Tint :: Tint :: nil, Tint)
+  | Oorshift _ _ => (Tint :: Tint :: nil, Tint)
+  | Oorimm _ => (Tint :: nil, Tint)
+  | Oxor => (Tint :: Tint :: nil, Tint)
+  | Oxorshift _ _ => (Tint :: Tint :: nil, Tint)
+  | Oxorimm _ => (Tint :: nil, Tint)
+  | Onot => (Tint :: nil, Tint)
+  | Onotshift _ _ => (Tint :: nil, Tint)
+  | Obic => (Tint :: Tint :: nil, Tint)
+  | Obicshift _ _ => (Tint :: Tint :: nil, Tint)
+  | Oorn => (Tint :: Tint :: nil, Tint)
+  | Oornshift _ _ => (Tint :: Tint :: nil, Tint)
+  | Oeqv => (Tint :: Tint :: nil, Tint)
+  | Oeqvshift _ _ => (Tint :: Tint :: nil, Tint)
+  | Oshl => (Tint :: Tint :: nil, Tint)
+  | Oshr => (Tint :: Tint :: nil, Tint)
+  | Oshru => (Tint :: Tint :: nil, Tint)
+  | Oshrximm _ => (Tint :: nil, Tint)
+  | Ozext _ => (Tint :: nil, Tint)
+  | Osext _ => (Tint :: nil, Tint)
+  | Oshlzext _ _ => (Tint :: nil, Tint)
+  | Oshlsext _ _ => (Tint :: nil, Tint)
+  | Ozextshr _ _ => (Tint :: nil, Tint)
+  | Osextshr _ _ => (Tint :: nil, Tint)
+
+  | Oshiftl _ _ => (Tlong :: nil, Tlong)
+  | Oextend _ _ => (Tint :: nil, Tlong)
+  | Omakelong => (Tint :: Tint :: nil, Tlong)
+  | Olowlong => (Tlong :: nil, Tint)
+  | Ohighlong => (Tlong :: nil, Tint)
+  | Oaddl => (Tlong :: Tlong :: nil, Tlong)
+  | Oaddlshift _ _ => (Tlong :: Tlong :: nil, Tlong) 
+  | Oaddlext _ _ => (Tlong :: Tint :: nil, Tlong)
+  | Oaddlimm _ => (Tlong :: nil, Tlong)
+  | Onegl => (Tlong :: nil, Tlong)
+  | Oneglshift _ _ => (Tlong :: nil, Tlong)
+  | Osubl => (Tlong :: Tlong :: nil, Tlong)
+  | Osublshift _ _ => (Tlong :: Tlong :: nil, Tlong)
+  | Osublext _ _ => (Tlong :: Tint :: nil, Tlong)
+  | Omull => (Tlong :: Tlong :: nil, Tlong)
+  | Omulladd => (Tlong :: Tlong :: Tlong :: nil, Tlong)
+  | Omullsub => (Tlong :: Tlong :: Tlong :: nil, Tlong)
+  | Omullhs => (Tlong :: Tlong :: nil, Tlong)
+  | Omullhu => (Tlong :: Tlong :: nil, Tlong)
+  | Odivl => (Tlong :: Tlong :: nil, Tlong)
+  | Odivlu => (Tlong :: Tlong :: nil, Tlong)
+  | Oandl => (Tlong :: Tlong :: nil, Tlong)
+  | Oandlshift _ _ => (Tlong :: Tlong :: nil, Tlong)
+  | Oandlimm _ => (Tlong :: nil, Tlong)
+  | Oorl => (Tlong :: Tlong :: nil, Tlong)
+  | Oorlshift _ _ => (Tlong :: Tlong :: nil, Tlong)
+  | Oorlimm _ => (Tlong :: nil, Tlong)
+  | Oxorl => (Tlong :: Tlong :: nil, Tlong)
+  | Oxorlshift _ _ => (Tlong :: Tlong :: nil, Tlong)
+  | Oxorlimm _ => (Tlong :: nil, Tlong)
+  | Onotl => (Tlong :: nil, Tlong)
+  | Onotlshift _ _ => (Tlong :: nil, Tlong)
+  | Obicl => (Tlong :: Tlong :: nil, Tlong)
+  | Obiclshift _ _ => (Tlong :: Tlong :: nil, Tlong)
+  | Oornl => (Tlong :: Tlong :: nil, Tlong)
+  | Oornlshift _ _ => (Tlong :: Tlong :: nil, Tlong)
+  | Oeqvl => (Tlong :: Tlong :: nil, Tlong)
+  | Oeqvlshift _ _ => (Tlong :: Tlong :: nil, Tlong)
+  | Oshll => (Tlong :: Tint :: nil, Tlong)
+  | Oshrl => (Tlong :: Tint :: nil, Tlong)
+  | Oshrlu => (Tlong :: Tint :: nil, Tlong)
+  | Oshrlximm _ => (Tlong :: nil, Tlong)
+  | Ozextl _ => (Tlong :: nil, Tlong)
+  | Osextl _ => (Tlong :: nil, Tlong)
+  | Oshllzext _ _ => (Tlong :: nil, Tlong)
+  | Oshllsext _ _ => (Tlong :: nil, Tlong)
+  | Ozextshrl _ _ => (Tlong :: nil, Tlong)
+  | Osextshrl _ _ => (Tlong :: nil, Tlong)
+
+  | 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)
+
+  | Onegfs => (Tsingle :: nil, Tsingle)
+  | Oabsfs => (Tsingle :: nil, Tsingle)
+  | Oaddfs => (Tsingle :: Tsingle :: nil, Tsingle)
+  | Osubfs => (Tsingle :: Tsingle :: nil, Tsingle)
+  | Omulfs => (Tsingle :: Tsingle :: nil, Tsingle)
+  | Odivfs => (Tsingle :: Tsingle :: nil, Tsingle)
+  | Osingleoffloat => (Tfloat :: nil, Tsingle)
+  | Ofloatofsingle => (Tsingle :: nil, Tfloat)
+
+  | Ointoffloat => (Tfloat :: nil, Tint)
+  | Ointuoffloat => (Tfloat :: nil, Tint)
+  | Ofloatofint => (Tint :: nil, Tfloat)
+  | Ofloatofintu => (Tint :: nil, Tfloat)
+  | Ointofsingle => (Tsingle :: nil, Tint)
+  | Ointuofsingle => (Tsingle :: nil, Tint)
+  | Osingleofint => (Tint :: nil, Tsingle)
+  | Osingleofintu => (Tint :: nil, Tsingle)
+  | Olongoffloat => (Tfloat :: nil, Tlong)
+  | Olonguoffloat => (Tfloat :: nil, Tlong)
+  | Ofloatoflong => (Tlong :: nil, Tfloat)
+  | Ofloatoflongu => (Tlong :: nil, Tfloat)
+  | Olongofsingle => (Tsingle :: nil, Tlong)
+  | Olonguofsingle => (Tsingle :: nil, Tlong)
+  | Osingleoflong => (Tlong :: nil, Tsingle)
+  | Osingleoflongu => (Tlong :: nil, Tsingle)
+
+  | Ocmp c => (type_of_condition c, Tint)
+  | Osel c ty => (ty :: ty :: type_of_condition c, ty)
+  end.
+
+Definition type_of_addressing (addr: addressing) : list typ :=
+  match addr with
+  | Aindexed _ => Tptr :: nil
+  | Aindexed2 => Tptr :: Tlong :: nil
+  | Aindexed2shift _ => Tptr :: Tlong :: nil
+  | Aindexed2ext _ _ => Tptr :: Tint :: nil
+  | Aglobal _ _ => nil
+  | Ainstack _ => nil
+  end.
+
+(** Weak type soundness results for [eval_operation]:
+  the result values, when defined, are always of the type predicted
+  by [type_of_operation]. *)
+
+Section SOUNDNESS.
+
+Variable A V: Type.
+Variable genv: Genv.t A V.
+
+Remark type_add:
+  forall v1 v2, Val.has_type (Val.add v1 v2) Tint.
+Proof.
+  intros. unfold Val.has_type, Val.add. destruct v1, v2; simpl; auto.
+Qed.
+
+Remark type_sub:
+  forall v1 v2, Val.has_type (Val.sub v1 v2) Tint.
+Proof.
+  intros. unfold Val.has_type, Val.add. destruct v1, v2; simpl; auto.
+Qed.
+
+Remark type_addl:
+  forall v1 v2, Val.has_type (Val.addl v1 v2) Tlong.
+Proof.
+  intros. unfold Val.has_type, Val.addl. destruct v1, v2; simpl; auto.
+Qed.
+
+Remark type_subl:
+  forall v1 v2, Val.has_type (Val.subl v1 v2) Tlong.
+Proof.
+  intros. unfold Val.has_type, Val.addl. destruct v1, v2; simpl; auto.
+  destruct (eq_block b b0); auto.
+Qed.
+
+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 with (try exact I; try reflexivity; auto using Val.Vptr_has_type).
+  intros.
+  destruct op; simpl; simpl in H0; FuncInv; subst; simpl.
+  (* move *)
+  - congruence.
+  (* intconst, longconst, floatconst, singleconst *)
+  - exact I.
+  - exact I.
+  - exact I.
+  - exact I.
+  (* addrsymbol *)
+  - unfold Genv.symbol_address. destruct (Genv.find_symbol genv id)...
+  (* addrstack *)
+  - destruct sp...
+  (* 32-bit integer operations *)
+  - destruct s, v0; try exact I; simpl; rewrite a32_range...
+  - apply type_add.
+  - apply type_add.
+  - apply type_add.
+  - destruct v0...
+  - destruct (eval_shift s v0 a)...
+  - apply type_sub.
+  - apply type_sub.
+  - destruct v0... destruct v1...
+  - apply type_add.
+  - apply type_sub.
+  - destruct v0; destruct v1; simpl in *; inv H0.
+    destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2...
+  - destruct v0; destruct v1; simpl in *; inv H0.
+    destruct (Int.eq i0 Int.zero); inv H2...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shift s v1 a)...
+  - destruct v0...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shift s v1 a)...
+  - destruct v0...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shift s v1 a)...
+  - destruct v0...
+  - destruct v0...
+  - destruct (eval_shift s v0 a)...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shift s v1 a)...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shift s v1 a)...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shift s v1 a)...
+  - destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
+  - destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
+  - destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
+  - destruct v0; simpl in H0; try discriminate. destruct (Int.ltu n (Int.repr 31)); inv H0...
+  - destruct v0...
+  - destruct v0...
+  - destruct (Val.zero_ext s v0)... simpl; rewrite a32_range... 
+  - destruct (Val.sign_ext s v0)... simpl; rewrite a32_range...
+  - destruct (Val.shru v0 (Vint a))... 
+  - destruct (Val.shr v0 (Vint a))...
+  (* 64-bit integer operations *)
+  - destruct s, v0; try exact I; simpl; rewrite a64_range...
+  - unfold eval_extend. destruct (match x with
+     | Xsgn32 => Val.longofint v0
+     | Xuns32 => Val.longofintu v0
+     end)...
+    simpl; rewrite a64_range...
+  - destruct v0... destruct v1...
+  - destruct v0...
+  - destruct v0...
+  - apply type_addl.
+  - apply type_addl.
+  - apply type_addl.
+  - apply type_addl.
+  - destruct v0...
+  - destruct (eval_shiftl s v0 a)...
+  - apply type_subl.
+  - apply type_subl.
+  - apply type_subl.
+  - destruct v0... destruct v1...
+  - apply type_addl.
+  - apply type_subl.
+  - destruct v0... destruct v1...
+  - destruct v0... destruct v1...
+  - destruct v0; destruct v1; simpl in *; inv H0.
+    destruct (Int64.eq i0 Int64.zero || Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq i0 Int64.mone); inv H2...
+  - destruct v0; destruct v1; simpl in *; inv H0.
+    destruct (Int64.eq i0 Int64.zero); inv H2...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shiftl s v1 a)...
+  - destruct v0...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shiftl s v1 a)...
+  - destruct v0...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shiftl s v1 a)...
+  - destruct v0...
+  - destruct v0...
+  - destruct (eval_shiftl s v0 a)...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shiftl s v1 a)...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shiftl s v1 a)...
+  - destruct v0... destruct v1...
+  - destruct v0... destruct (eval_shiftl s v1 a)...
+  - destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int64.iwordsize')...
+  - destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int64.iwordsize')...
+  - destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int64.iwordsize')...
+  - destruct v0; simpl in H0; try discriminate. destruct (Int.ltu n (Int.repr 63)); inv H0...
+  - destruct v0...
+  - destruct v0...
+  - destruct (Val.zero_ext_l s v0)... simpl; rewrite a64_range... 
+  - destruct (Val.sign_ext_l s v0)... simpl; rewrite a64_range...
+  - destruct (Val.shrlu v0 (Vint a))... 
+  - destruct (Val.shrl v0 (Vint a))...
+
+  (* 64-bit FP *)
+  - destruct v0...
+  - destruct v0...
+  - destruct v0; destruct v1...
+  - destruct v0; destruct v1...
+  - destruct v0; destruct v1...
+  - destruct v0; destruct v1...
+  (* 32-bit FP *)
+  - destruct v0...
+  - destruct v0...
+  - destruct v0; destruct v1...
+  - destruct v0; destruct v1...
+  - destruct v0; destruct v1...
+  - destruct v0; destruct v1...
+  (* singleoffloat, floatofsingle *)
+  - destruct v0...
+  - destruct v0...
+  (* intoffloat, intuoffloat *)
+  - destruct v0; simpl in H0; inv H0. destruct (Float.to_int f); inv H2...
+  - destruct v0; simpl in H0; inv H0. destruct (Float.to_intu f); inv H2...
+  (* floatofint, floatofintu *)
+  - destruct v0; simpl in H0; inv H0...
+  - destruct v0; simpl in H0; inv H0...
+  (* intofsingle, intuofsingle *)
+  - destruct v0; simpl in H0; inv H0. destruct (Float32.to_int f); inv H2...
+  - destruct v0; simpl in H0; inv H0. destruct (Float32.to_intu f); inv H2...
+  (* singleofint, singleofintu *)
+  - destruct v0; simpl in H0; inv H0...
+  - destruct v0; simpl in H0; inv H0...
+  (* longoffloat, longuoffloat *)
+  - destruct v0; simpl in H0; inv H0. destruct (Float.to_long f); inv H2...
+  - destruct v0; simpl in H0; inv H0. destruct (Float.to_longu f); inv H2...
+  (* floatoflong, floatoflongu *)
+  - destruct v0; simpl in H0; inv H0...
+  - destruct v0; simpl in H0; inv H0...
+  (* longofsingle, longuofsingle *)
+  - destruct v0; simpl in H0; inv H0. destruct (Float32.to_long f); inv H2...
+  - destruct v0; simpl in H0; inv H0. destruct (Float32.to_longu f); inv H2...
+  (* singleoflong, singleoflongu *)
+  - destruct v0; simpl in H0; inv H0...
+  - destruct v0; simpl in H0; inv H0...
+  (* cmp *)
+  - destruct (eval_condition cond vl m) as [[]|]...
+  - unfold Val.select. destruct (eval_condition cond vl m). apply Val.normalize_type. exact I.
+Qed.
+
+End SOUNDNESS.
+
+(** * Manipulating and transforming operations *)
+
+(** Constructing shift amounts *)
+
+Section SHIFT_AMOUNT.
+
+Variable l: Z.
+Hypothesis l_range: 0 <= l < 32.
+Variable N: int.
+Hypothesis N_eq: Int.unsigned N = two_p l.
+
+Remark mk_amount_range:
+  forall n, Int.ltu (Int.zero_ext l n) N = true.
+Proof.
+  intros; unfold Int.ltu. apply zlt_true. rewrite N_eq. apply (Int.zero_ext_range l n). assumption.
+Qed.
+
+Remark mk_amount_eq:
+  forall n, Int.ltu n N = true -> Int.zero_ext l n = n.
+Proof.
+  intros.
+  transitivity (Int.repr (Int.unsigned (Int.zero_ext l n))).
+  symmetry; apply Int.repr_unsigned.
+  transitivity (Int.repr (Int.unsigned n)).
+  f_equal. rewrite Int.zero_ext_mod. apply Int.ltu_inv in H. rewrite N_eq in H. 
+  apply Z.mod_small. assumption. assumption.
+  apply Int.repr_unsigned.
+Qed.
+
+End SHIFT_AMOUNT.
+
+Program Definition mk_amount32 (n: int): amount32 :=
+  {| a32_amount := Int.zero_ext 5 n |}.
+Next Obligation.
+  apply mk_amount_range. omega. reflexivity.
+Qed.
+
+Lemma mk_amount32_eq: forall n,
+  Int.ltu n Int.iwordsize = true -> a32_amount (mk_amount32 n) = n.
+Proof.
+  intros. eapply mk_amount_eq; eauto. omega. reflexivity.
+Qed.
+
+Program Definition mk_amount64 (n: int): amount64 :=
+  {| a64_amount := Int.zero_ext 6 n |}.
+Next Obligation.
+  apply mk_amount_range. omega. reflexivity.
+Qed.
+
+Lemma mk_amount64_eq: forall n,
+  Int.ltu n Int64.iwordsize' = true -> a64_amount (mk_amount64 n) = n.
+Proof.
+  intros. eapply mk_amount_eq; eauto. omega. reflexivity.
+Qed.
+ 
+(** Recognition of move operations. *)
+
+Definition is_move_operation
+    (A: Type) (op: operation) (args: list A) : option A :=
+  match op, args with
+  | Omove, arg :: nil => Some arg
+  | _, _ => None
+  end.
+
+Lemma is_move_operation_correct:
+  forall (A: Type) (op: operation) (args: list A) (a: A),
+  is_move_operation op args = Some a ->
+  op = Omove /\ args = a :: nil.
+Proof.
+  intros until a. unfold is_move_operation; destruct op;
+  try (intros; discriminate).
+  destruct args. intros; discriminate.
+  destruct args. intros. intuition congruence.
+  intros; discriminate.
+Qed.
+
+(** [negate_condition cond] returns a condition that is logically
+  equivalent to the negation of [cond]. *)
+
+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
+  | Ccompshift c s a => Ccompshift (negate_comparison c) s a
+  | Ccompushift c s a => Ccompushift (negate_comparison c) s a
+  | Cmaskzero n => Cmasknotzero n
+  | Cmasknotzero n => Cmaskzero n
+  | Ccompl c => Ccompl (negate_comparison c)
+  | Ccomplu c => Ccomplu (negate_comparison c)
+  | Ccomplimm c n => Ccomplimm (negate_comparison c) n
+  | Ccompluimm c n => Ccompluimm (negate_comparison c) n
+  | Ccomplshift c s a => Ccomplshift (negate_comparison c) s a
+  | Ccomplushift c s a => Ccomplushift (negate_comparison c) s a
+  | Cmasklzero n => Cmasklnotzero n
+  | Cmasklnotzero n => Cmasklzero n
+  | Ccompf c => Cnotcompf c
+  | Cnotcompf c => Ccompf c
+  | Ccompfzero c => Cnotcompfzero c
+  | Cnotcompfzero c => Ccompfzero c
+  | Ccompfs c => Cnotcompfs c
+  | Cnotcompfs c => Ccompfs c
+  | Ccompfszero c => Cnotcompfszero c
+  | Cnotcompfszero c => Ccompfszero c
+  end.
+
+Lemma eval_negate_condition:
+  forall cond vl m,
+  eval_condition (negate_condition cond) vl m = option_map negb (eval_condition cond vl m).
+Proof.
+  intros. destruct cond; simpl.
+  repeat (destruct vl; auto). apply Val.negate_cmp_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmpu_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmp_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmpu_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmp_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmpu_bool.
+  repeat (destruct vl; auto). apply (Val.negate_cmp_bool Ceq).
+  repeat (destruct vl; auto). apply (Val.negate_cmp_bool Cne).
+  repeat (destruct vl; auto). apply Val.negate_cmpl_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmplu_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmpl_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmplu_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmpl_bool.
+  repeat (destruct vl; auto). apply Val.negate_cmplu_bool.
+  repeat (destruct vl; auto). apply (Val.negate_cmpl_bool Ceq).
+  repeat (destruct vl; auto). apply (Val.negate_cmpl_bool Cne).
+  repeat (destruct vl; auto).
+  repeat (destruct vl; auto). destruct (Val.cmpf_bool c v v0) as [[]|]; auto.
+  repeat (destruct vl; auto).
+  repeat (destruct vl; auto). destruct (Val.cmpf_bool c v (Vfloat Float.zero)) as [[]|]; auto.
+  repeat (destruct vl; auto).
+  repeat (destruct vl; auto). destruct (Val.cmpfs_bool c v v0) as [[]|]; auto.
+  repeat (destruct vl; auto).
+  repeat (destruct vl; auto). destruct (Val.cmpfs_bool c v (Vsingle Float32.zero)) as [[]|]; auto.
+Qed.
+
+(** Shifting stack-relative references.  This is used in [Stacking]. *)
+
+Definition shift_stack_addressing (delta: Z) (addr: addressing) :=
+  match addr with
+  | Ainstack ofs => Ainstack (Ptrofs.add ofs (Ptrofs.repr delta))
+  | _ => addr
+  end.
+
+Definition shift_stack_operation (delta: Z) (op: operation) :=
+  match op with
+  | Oaddrstack ofs => Oaddrstack (Ptrofs.add ofs (Ptrofs.repr delta))
+  | _ => op
+  end.
+
+Lemma type_shift_stack_addressing:
+  forall delta addr, type_of_addressing (shift_stack_addressing delta addr) = type_of_addressing addr.
+Proof.
+  intros. destruct addr; auto.
+Qed.
+
+Lemma type_shift_stack_operation:
+  forall delta op, type_of_operation (shift_stack_operation delta op) = type_of_operation op.
+Proof.
+  intros. destruct op; auto.
+Qed.
+
+Lemma eval_shift_stack_addressing:
+  forall F V (ge: Genv.t F V) sp addr vl delta,
+  eval_addressing ge (Vptr sp Ptrofs.zero) (shift_stack_addressing delta addr) vl =
+  eval_addressing ge (Vptr sp (Ptrofs.repr delta)) addr vl.
+Proof.
+  intros. destruct addr; simpl; auto. destruct vl; auto.
+  rewrite Ptrofs.add_zero_l, Ptrofs.add_commut; auto.
+Qed.
+
+Lemma eval_shift_stack_operation:
+  forall F V (ge: Genv.t F V) sp op vl m delta,
+  eval_operation ge (Vptr sp Ptrofs.zero) (shift_stack_operation delta op) vl m =
+  eval_operation ge (Vptr sp (Ptrofs.repr delta)) op vl m.
+Proof.
+  intros. destruct op; simpl; auto. destruct vl; auto.
+  rewrite Ptrofs.add_zero_l, Ptrofs.add_commut; auto.
+Qed.
+
+(** Offset an addressing mode [addr] by a quantity [delta], so that
+  it designates the pointer [delta] bytes past the pointer designated
+  by [addr].  May be undefined, in which case [None] is returned. *)
+
+Definition offset_addressing (addr: addressing) (delta: Z) : option addressing :=
+  match addr with
+  | Aindexed n => Some(Aindexed (Int64.add n (Int64.repr delta)))
+  | Aindexed2 => None
+  | Aindexed2shift _ => None
+  | Aindexed2ext _ _ => None
+  | Aglobal id n => Some(Aglobal id (Ptrofs.add n (Ptrofs.repr delta)))
+  | Ainstack n => Some(Ainstack (Ptrofs.add n (Ptrofs.repr delta)))
+  end.
+
+Lemma eval_offset_addressing:
+  forall (F V: Type) (ge: Genv.t F V) sp addr args delta addr' v,
+  offset_addressing addr delta = Some addr' ->
+  eval_addressing ge sp addr args = Some v ->
+  Archi.ptr64 = false ->
+  eval_addressing ge sp addr' args = Some(Val.add v (Vint (Int.repr delta))).
+Proof.
+  intros. discriminate. 
+Qed.
+
+(** Operations that are so cheap to recompute that CSE should not factor them out. *)
+
+Definition is_trivial_op (op: operation) : bool :=
+  match op with
+  | Omove => true
+  | Ointconst n => Int.eq (Int.sign_ext 16 n) n
+  | Olongconst n => Int64.eq (Int64.sign_ext 16 n) n
+  | Oaddrstack _ => true
+  | _ => false
+  end.
+
+(** Operations that depend on the memory state. *)
+
+Definition cond_depends_on_memory (c: condition) : bool :=
+  match c with
+  | Ccomplu _ | Ccompluimm _ _ | Ccomplushift _ _ _ => true
+  | _ => false
+  end.
+
+Lemma cond_depends_on_memory_correct:
+  forall c args m1 m2,
+  cond_depends_on_memory c = false ->
+  eval_condition c args m1 = eval_condition c args m2.
+Proof.
+  intros; destruct c; simpl; discriminate || reflexivity.
+Qed.
+
+Definition op_depends_on_memory (op: operation) : bool :=
+  match op with
+  | Ocmp c => cond_depends_on_memory c
+  | Osel c yu => cond_depends_on_memory c
+  | _ => false
+  end.
+
+Lemma op_depends_on_memory_correct:
+  forall (F V: Type) (ge: Genv.t F V) sp op args m1 m2,
+  op_depends_on_memory op = false ->
+  eval_operation ge sp op args m1 = eval_operation ge sp op args m2.
+Proof.
+  intros. destruct op; auto.
+  simpl. rewrite (cond_depends_on_memory_correct cond args m1 m2 H). auto.
+  simpl. destruct args; auto. destruct args; auto.
+  rewrite (cond_depends_on_memory_correct cond args m1 m2 H). auto.
+Qed.
+
+(** Global variables mentioned in an operation or addressing mode *)
+
+Definition globals_addressing (addr: addressing) : list ident :=
+  match addr with
+  | Aglobal s ofs => s :: nil
+  | _ => nil
+  end.
+
+Definition globals_operation (op: operation) : list ident :=
+  match op with
+  | Oaddrsymbol s ofs => s :: nil
+  | _ => nil
+  end.
+
+(** * Invariance and compatibility properties. *)
+
+(** [eval_operation] and [eval_addressing] depend on a global environment
+  for resolving references to global symbols.  We show that they give
+  the same results if a global environment is replaced by another that
+  assigns the same addresses to the same symbols. *)
+
+Section GENV_TRANSF.
+
+Variable F1 F2 V1 V2: Type.
+Variable ge1: Genv.t F1 V1.
+Variable ge2: Genv.t F2 V2.
+Hypothesis agree_on_symbols:
+  forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s.
+
+Lemma eval_addressing_preserved:
+  forall sp addr vl,
+  eval_addressing ge2 sp addr vl = eval_addressing ge1 sp addr vl.
+Proof.
+  intros.
+  unfold eval_addressing; destruct addr; auto. destruct vl; auto. 
+  unfold Genv.symbol_address. rewrite agree_on_symbols; auto.
+Qed.
+
+Lemma eval_operation_preserved:
+  forall sp op vl m,
+  eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m.
+Proof.
+  intros.
+  unfold eval_operation; destruct op; auto. destruct vl; auto.
+  unfold Genv.symbol_address. rewrite agree_on_symbols; auto.
+Qed.
+
+End GENV_TRANSF.
+
+(** Compatibility of the evaluation functions with value injections. *)
+
+Section EVAL_COMPAT.
+
+Variable F1 F2 V1 V2: Type.
+Variable ge1: Genv.t F1 V1.
+Variable ge2: Genv.t F2 V2.
+Variable f: meminj.
+
+Variable m1: mem.
+Variable m2: mem.
+
+Hypothesis valid_pointer_inj:
+  forall b1 ofs b2 delta,
+  f b1 = Some(b2, delta) ->
+  Mem.valid_pointer m1 b1 (Ptrofs.unsigned ofs) = true ->
+  Mem.valid_pointer m2 b2 (Ptrofs.unsigned (Ptrofs.add ofs (Ptrofs.repr delta))) = true.
+
+Hypothesis weak_valid_pointer_inj:
+  forall b1 ofs b2 delta,
+  f b1 = Some(b2, delta) ->
+  Mem.weak_valid_pointer m1 b1 (Ptrofs.unsigned ofs) = true ->
+  Mem.weak_valid_pointer m2 b2 (Ptrofs.unsigned (Ptrofs.add ofs (Ptrofs.repr delta))) = true.
+
+Hypothesis weak_valid_pointer_no_overflow:
+  forall b1 ofs b2 delta,
+  f b1 = Some(b2, delta) ->
+  Mem.weak_valid_pointer m1 b1 (Ptrofs.unsigned ofs) = true ->
+  0 <= Ptrofs.unsigned ofs + Ptrofs.unsigned (Ptrofs.repr delta) <= Ptrofs.max_unsigned.
+
+Hypothesis valid_different_pointers_inj:
+  forall b1 ofs1 b2 ofs2 b1' delta1 b2' delta2,
+  b1 <> b2 ->
+  Mem.valid_pointer m1 b1 (Ptrofs.unsigned ofs1) = true ->
+  Mem.valid_pointer m1 b2 (Ptrofs.unsigned ofs2) = true ->
+  f b1 = Some (b1', delta1) ->
+  f b2 = Some (b2', delta2) ->
+  b1' <> b2' \/
+  Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta1)) <> Ptrofs.unsigned (Ptrofs.add ofs2 (Ptrofs.repr delta2)).
+
+Ltac InvInject :=
+  match goal with
+  | [ H: Val.inject _ (Vint _) _ |- _ ] =>
+      inv H; InvInject
+  | [ H: Val.inject _ (Vfloat _) _ |- _ ] =>
+      inv H; InvInject
+  | [ H: Val.inject _ (Vptr _ _) _ |- _ ] =>
+      inv H; InvInject
+  | [ H: Val.inject_list _ nil _ |- _ ] =>
+      inv H; InvInject
+  | [ H: Val.inject_list _ (_ :: _) _ |- _ ] =>
+      inv H; InvInject
+  | _ => idtac
+  end.
+
+Lemma eval_shift_inject:
+  forall v1 v2 s a,
+  Val.inject f v1 v2 -> Val.inject f (eval_shift s v1 a) (eval_shift s v2 a).
+Proof.
+  intros; inv H; destruct s; simpl; auto; rewrite a32_range; auto.
+Qed.
+
+Lemma eval_shiftl_inject:
+  forall v1 v2 s a,
+  Val.inject f v1 v2 -> Val.inject f (eval_shiftl s v1 a) (eval_shiftl s v2 a).
+Proof.
+  intros; inv H; destruct s; simpl; auto; rewrite a64_range; auto.
+Qed.
+
+Lemma eval_extend_inject:
+  forall v1 v2 x a,
+  Val.inject f v1 v2 -> Val.inject f (eval_extend x v1 a) (eval_extend x v2 a).
+Proof.
+  unfold eval_extend; intros; inv H; destruct x; simpl; auto; rewrite a64_range; auto.
+Qed.
+
+Lemma eval_condition_inj:
+  forall cond vl1 vl2 b,
+  Val.inject_list f vl1 vl2 ->
+  eval_condition cond vl1 m1 = Some b ->
+  eval_condition cond vl2 m2 = Some b.
+Proof.
+  intros. destruct cond; simpl in H0; FuncInv; InvInject; simpl; auto.
+(* 32-bit integers *)
+- inv H3; inv H2; simpl in H0; inv H0; auto.
+- eauto 3 using Val.cmpu_bool_inject, Mem.valid_pointer_implies.
+- inv H3; simpl in H0; inv H0; auto.
+- eauto 3 using Val.cmpu_bool_inject, Mem.valid_pointer_implies.
+- revert H0. generalize (eval_shift_inject s a H2); intros J; inv H3; inv J; simpl; congruence.
+- eauto 3 using Val.cmpu_bool_inject, Mem.valid_pointer_implies, eval_shift_inject.
+- inv H3; inv H0; auto.
+- inv H3; inv H0; auto.
+(* 64-bit integers *)
+- inv H3; inv H2; simpl in H0; inv H0; auto.
+- eauto 3 using Val.cmplu_bool_inject, Mem.valid_pointer_implies.
+- inv H3; simpl in H0; inv H0; auto.
+- eauto 3 using Val.cmplu_bool_inject, Mem.valid_pointer_implies.
+- revert H0. generalize (eval_shiftl_inject s a H2); intros J; inv H3; inv J; simpl; congruence.
+- eauto 3 using Val.cmplu_bool_inject, Mem.valid_pointer_implies, eval_shiftl_inject.
+- inv H3; inv H0; auto.
+- inv H3; inv H0; auto.
+(* 64-bit floats *)
+- inv H3; inv H2; simpl in H0; inv H0; auto.
+- inv H3; inv H2; simpl in H0; inv H0; auto.
+- inv H3; simpl in H0; inv H0; auto.
+- inv H3; simpl in H0; inv H0; auto.
+(* 32-bit floats *)
+- inv H3; inv H2; simpl in H0; inv H0; auto.
+- inv H3; inv H2; simpl in H0; inv H0; auto.
+- inv H3; simpl in H0; inv H0; auto.
+- inv H3; simpl in H0; inv H0; auto.
+Qed.
+
+Ltac TrivialExists :=
+  match goal with
+  | [ |- exists v2, Some ?v1 = Some v2 /\ Val.inject _ _ v2 ] =>
+      exists v1; split; auto
+  | _ => idtac
+  end.
+
+Lemma eval_operation_inj:
+  forall op sp1 vl1 sp2 vl2 v1,
+  (forall id ofs,
+      In id (globals_operation op) ->
+      Val.inject f (Genv.symbol_address ge1 id ofs) (Genv.symbol_address ge2 id ofs)) ->
+  Val.inject f sp1 sp2 ->
+  Val.inject_list f vl1 vl2 ->
+  eval_operation ge1 sp1 op vl1 m1 = Some v1 ->
+  exists v2, eval_operation ge2 sp2 op vl2 m2 = Some v2 /\ Val.inject f v1 v2.
+Proof.
+  intros until v1; intros GL; intros. destruct op; simpl in H1; simpl; FuncInv; InvInject; TrivialExists.
+  (* addrsymbol *)
+  - apply GL; simpl; auto.
+  (* addrstack *)
+  - apply Val.offset_ptr_inject; auto. 
+  (* shift *)
+  - apply eval_shift_inject; auto.
+  (* add *)
+  - apply Val.add_inject; auto.
+  - apply Val.add_inject; auto using eval_shift_inject.
+  - apply Val.add_inject; auto.
+  (* neg, sub *)
+  - inv H4; simpl; auto.
+  - generalize (eval_shift_inject s a H4); intros J; inv J; simpl; auto.
+  - apply Val.sub_inject; auto.
+  - apply Val.sub_inject; auto using eval_shift_inject.
+  (* mul, muladd, mulsub *)
+  - inv H4; inv H2; simpl; auto.
+  - apply Val.add_inject; auto. inv H2; inv H3; simpl; auto.
+  - apply Val.sub_inject; auto. inv H2; inv H3; simpl; auto.
+  (* div, divu *)
+  - inv H4; inv H3; simpl in H1; inv H1. simpl.
+    destruct (Int.eq i0 Int.zero
+              || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2.
+    TrivialExists.
+  - inv H4; inv H3; simpl in H1; inv H1. simpl.
+    destruct (Int.eq i0 Int.zero); inv H2. TrivialExists.
+  (* and*)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shift_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  - inv H4; simpl; auto.
+  (* or *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shift_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  - inv H4; simpl; auto.
+  (* xor *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shift_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  - inv H4; simpl; auto.
+  (* not *)
+  - inv H4; simpl; auto.
+  - generalize (eval_shift_inject s a H4); intros J; inv J; simpl; auto.
+  (* bic *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shift_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  (* nor *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shift_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  (* eqv *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shift_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  (* shl *)
+  - inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto.
+  (* shr *)
+  - inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto.
+  (* shru *)
+  - inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto.
+  (* shrx *)
+  - inv H4; simpl in H1; try discriminate. simpl.
+    destruct (Int.ltu n (Int.repr 31)); inv H1. TrivialExists.
+  (* shift-ext *)
+  - inv H4; simpl; auto.
+  - inv H4; simpl; auto.
+  - inv H4; simpl; auto; rewrite a32_range; auto.
+  - inv H4; simpl; auto; rewrite a32_range; auto.
+  - inv H4; simpl; auto; rewrite a32_range; simpl; auto.
+  - inv H4; simpl; auto; rewrite a32_range; simpl; auto.
+
+  (* shiftl *)
+  - apply eval_shiftl_inject; auto.
+  (* extend *)
+  - apply eval_extend_inject; auto.
+  (* makelong, low, high *)
+  - inv H4; inv H2; simpl; auto.
+  - inv H4; simpl; auto.
+  - inv H4; simpl; auto.
+  (* addl *)
+  - apply Val.addl_inject; auto.
+  - apply Val.addl_inject; auto using eval_shiftl_inject.
+  - apply Val.addl_inject; auto using eval_extend_inject.
+  - apply Val.addl_inject; auto.
+  (* negl, subl *)
+  - inv H4; simpl; auto.
+  - generalize (eval_shiftl_inject s a H4); intros J; inv J; simpl; auto.
+  - apply Val.subl_inject; auto.
+  - apply Val.subl_inject; auto using eval_shiftl_inject.
+  - apply Val.subl_inject; auto using eval_extend_inject.
+  (* mull, mulladd, mullsub, mullhs, mullhu *)
+  - inv H4; inv H2; simpl; auto.
+  - apply Val.addl_inject; auto. inv H2; inv H3; simpl; auto.
+  - apply Val.subl_inject; auto. inv H2; inv H3; simpl; auto.
+  - inv H4; inv H2; simpl; auto.
+  - inv H4; inv H2; simpl; auto.
+  (* divl, divlu *)
+  - inv H4; inv H3; simpl in H1; inv H1. simpl.
+    destruct (Int64.eq i0 Int64.zero
+              || Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq i0 Int64.mone); inv H2.
+    TrivialExists.
+  - inv H4; inv H3; simpl in H1; inv H1. simpl.
+    destruct (Int64.eq i0 Int64.zero); inv H2. TrivialExists.
+  (* andl *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shiftl_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  - inv H4; simpl; auto.
+  (* orl *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shiftl_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  - inv H4; simpl; auto.
+  (* xorl *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shiftl_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  - inv H4; simpl; auto.
+  (* notl *)
+  - inv H4; simpl; auto.
+  - generalize (eval_shiftl_inject s a H4); intros J; inv J; simpl; auto.
+  (* bicl *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shiftl_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  (* norl *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shiftl_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  (* eqvl *)
+  - inv H4; inv H2; simpl; auto. 
+  - generalize (eval_shiftl_inject s a H2); intros J; inv H4; inv J; simpl; auto.
+  (* shll *)
+  - inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int64.iwordsize'); auto.
+  (* shrl *)
+  - inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int64.iwordsize'); auto.
+  (* shrlu *)
+  - inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int64.iwordsize'); auto.
+  (* shrlx *)
+  - inv H4; simpl in H1; try discriminate. simpl.
+    destruct (Int.ltu n (Int.repr 63)); inv H1. TrivialExists.
+  (* shift-ext *)
+  - inv H4; simpl; auto.
+  - inv H4; simpl; auto.
+  - inv H4; simpl; auto; rewrite a64_range; auto.
+  - inv H4; simpl; auto; rewrite a64_range; auto.
+  - inv H4; simpl; auto; rewrite a64_range; simpl; auto.
+  - inv H4; simpl; auto; rewrite a64_range; simpl; auto.
+
+  (* negf, absf *)
+  - inv H4; simpl; auto.
+  - inv H4; simpl; auto.
+  (* addf, subf *)
+  - inv H4; inv H2; simpl; auto.
+  - inv H4; inv H2; simpl; auto.
+  (* mulf, divf *)
+  - inv H4; inv H2; simpl; auto.
+  - inv H4; inv H2; simpl; auto.
+  (* negfs, absfs *)
+  - inv H4; simpl; auto.
+  - inv H4; simpl; auto.
+  (* addfs, subfs *)
+  - inv H4; inv H2; simpl; auto.
+  - inv H4; inv H2; simpl; auto.
+  (* mulfs, divfs *)
+  - inv H4; inv H2; simpl; auto.
+  - inv H4; inv H2; simpl; auto.
+  (* singleoffloat, floatofsingle *)
+  - inv H4; simpl; auto.
+  - inv H4; simpl; auto.
+  (* intoffloat, intuoffloat *)
+  - inv H4; simpl in H1; inv H1. simpl. destruct (Float.to_int f0); simpl in H2; inv H2.
+    exists (Vint i); auto.
+  - inv H4; simpl in H1; inv H1. simpl. destruct (Float.to_intu f0); simpl in H2; inv H2.
+    exists (Vint i); auto.
+  (* floatofint, floatofintu *)
+  - inv H4; simpl in H1; inv H1. simpl. TrivialExists.
+  - inv H4; simpl in H1; inv H1. simpl. TrivialExists.
+  (* intofsingle, intuofsingle *)
+  - inv H4; simpl in H1; inv H1. simpl. destruct (Float32.to_int f0); simpl in H2; inv H2.
+    exists (Vint i); auto.
+  - inv H4; simpl in H1; inv H1. simpl. destruct (Float32.to_intu f0); simpl in H2; inv H2.
+    exists (Vint i); auto.
+  (* singleofint, singleofintu *)
+  - inv H4; simpl in H1; inv H1. simpl. TrivialExists.
+  - inv H4; simpl in H1; inv H1. simpl. TrivialExists.
+  (* longoffloat, longuoffloat *)
+  - inv H4; simpl in H1; inv H1. simpl. destruct (Float.to_long f0); simpl in H2; inv H2.
+    exists (Vlong i); auto.
+  - inv H4; simpl in H1; inv H1. simpl. destruct (Float.to_longu f0); simpl in H2; inv H2.
+    exists (Vlong i); auto.
+  (* floatoflong, floatoflongu *)
+  - inv H4; simpl in H1; inv H1. simpl. TrivialExists.
+  - inv H4; simpl in H1; inv H1. simpl. TrivialExists.
+  (* longofsingle, longuofsingle *)
+  - inv H4; simpl in H1; inv H1. simpl. destruct (Float32.to_long f0); simpl in H2; inv H2.
+    exists (Vlong i); auto.
+  - inv H4; simpl in H1; inv H1. simpl. destruct (Float32.to_longu f0); simpl in H2; inv H2.
+    exists (Vlong i); auto.
+  (* singleoflong, singleoflongu *)
+  - inv H4; simpl in H1; inv H1. simpl. TrivialExists.
+  - inv H4; simpl in H1; inv H1. simpl. TrivialExists.
+  (* cmp, sel *)
+  - subst v1. destruct (eval_condition cond vl1 m1) eqn:?.
+    exploit eval_condition_inj; eauto. intros EQ; rewrite EQ.
+    destruct b; simpl; constructor.
+    simpl; constructor.
+  - apply Val.select_inject; auto.  
+    destruct (eval_condition cond vl1 m1) eqn:?; auto.
+    right; symmetry; eapply eval_condition_inj; eauto.
+Qed.
+
+Lemma eval_addressing_inj:
+  forall addr sp1 vl1 sp2 vl2 v1,
+  (forall id ofs,
+      In id (globals_addressing addr) ->
+      Val.inject f (Genv.symbol_address ge1 id ofs) (Genv.symbol_address ge2 id ofs)) ->
+  Val.inject f sp1 sp2 ->
+  Val.inject_list f vl1 vl2 ->
+  eval_addressing ge1 sp1 addr vl1 = Some v1 ->
+  exists v2, eval_addressing ge2 sp2 addr vl2 = Some v2 /\ Val.inject f v1 v2.
+Proof.
+  intros. destruct addr; simpl in H2; simpl; FuncInv; InvInject; TrivialExists.
+- apply Val.addl_inject; auto.
+- apply Val.addl_inject; auto.
+- apply Val.addl_inject; auto. inv H3; simpl; auto; rewrite a64_range; auto.
+- apply Val.addl_inject; auto using eval_extend_inject.
+- apply H; simpl; auto.
+- apply Val.offset_ptr_inject; auto. 
+Qed.
+
+End EVAL_COMPAT.
+
+(** Compatibility of the evaluation functions with the ``is less defined'' relation over values. *)
+
+Section EVAL_LESSDEF.
+
+Variable F V: Type.
+Variable genv: Genv.t F V.
+
+Remark valid_pointer_extends:
+  forall m1 m2, Mem.extends m1 m2 ->
+  forall b1 ofs b2 delta,
+  Some(b1, 0) = Some(b2, delta) ->
+  Mem.valid_pointer m1 b1 (Ptrofs.unsigned ofs) = true ->
+  Mem.valid_pointer m2 b2 (Ptrofs.unsigned (Ptrofs.add ofs (Ptrofs.repr delta))) = true.
+Proof.
+  intros. inv H0. rewrite Ptrofs.add_zero. eapply Mem.valid_pointer_extends; eauto.
+Qed.
+
+Remark weak_valid_pointer_extends:
+  forall m1 m2, Mem.extends m1 m2 ->
+  forall b1 ofs b2 delta,
+  Some(b1, 0) = Some(b2, delta) ->
+  Mem.weak_valid_pointer m1 b1 (Ptrofs.unsigned ofs) = true ->
+  Mem.weak_valid_pointer m2 b2 (Ptrofs.unsigned (Ptrofs.add ofs (Ptrofs.repr delta))) = true.
+Proof.
+  intros. inv H0. rewrite Ptrofs.add_zero. eapply Mem.weak_valid_pointer_extends; eauto.
+Qed.
+
+Remark weak_valid_pointer_no_overflow_extends:
+  forall m1 b1 ofs b2 delta,
+  Some(b1, 0) = Some(b2, delta) ->
+  Mem.weak_valid_pointer m1 b1 (Ptrofs.unsigned ofs) = true ->
+  0 <= Ptrofs.unsigned ofs + Ptrofs.unsigned (Ptrofs.repr delta) <= Ptrofs.max_unsigned.
+Proof.
+  intros. inv H. rewrite Z.add_0_r. apply Ptrofs.unsigned_range_2.
+Qed.
+
+Remark valid_different_pointers_extends:
+  forall m1 b1 ofs1 b2 ofs2 b1' delta1 b2' delta2,
+  b1 <> b2 ->
+  Mem.valid_pointer m1 b1 (Ptrofs.unsigned ofs1) = true ->
+  Mem.valid_pointer m1 b2 (Ptrofs.unsigned ofs2) = true ->
+  Some(b1, 0) = Some (b1', delta1) ->
+  Some(b2, 0) = Some (b2', delta2) ->
+  b1' <> b2' \/
+  Ptrofs.unsigned(Ptrofs.add ofs1 (Ptrofs.repr delta1)) <> Ptrofs.unsigned(Ptrofs.add ofs2 (Ptrofs.repr delta2)).
+Proof.
+  intros. inv H2; inv H3. auto.
+Qed.
+
+Lemma eval_condition_lessdef:
+  forall cond vl1 vl2 b m1 m2,
+  Val.lessdef_list vl1 vl2 ->
+  Mem.extends m1 m2 ->
+  eval_condition cond vl1 m1 = Some b ->
+  eval_condition cond vl2 m2 = Some b.
+Proof.
+  intros. eapply eval_condition_inj with (f := fun b => Some(b, 0)) (m1 := m1).
+  apply valid_pointer_extends; auto.
+  apply weak_valid_pointer_extends; auto.
+  apply weak_valid_pointer_no_overflow_extends.
+  apply valid_different_pointers_extends; auto.
+  rewrite <- val_inject_list_lessdef. eauto. auto.
+Qed.
+
+Lemma eval_operation_lessdef:
+  forall sp op vl1 vl2 v1 m1 m2,
+  Val.lessdef_list vl1 vl2 ->
+  Mem.extends m1 m2 ->
+  eval_operation genv sp op vl1 m1 = Some v1 ->
+  exists v2, eval_operation genv sp op vl2 m2 = Some v2 /\ Val.lessdef v1 v2.
+Proof.
+  intros. rewrite val_inject_list_lessdef in H.
+  assert (exists v2 : val,
+          eval_operation genv sp op vl2 m2 = Some v2
+          /\ Val.inject (fun b => Some(b, 0)) v1 v2).
+  eapply eval_operation_inj with (m1 := m1) (sp1 := sp).
+  apply valid_pointer_extends; auto.
+  apply weak_valid_pointer_extends; auto.
+  apply weak_valid_pointer_no_overflow_extends.
+  apply valid_different_pointers_extends; auto.
+  intros. apply val_inject_lessdef. auto.
+  apply val_inject_lessdef; auto.
+  eauto.
+  auto.
+  destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto.
+Qed.
+
+Lemma eval_addressing_lessdef:
+  forall sp addr vl1 vl2 v1,
+  Val.lessdef_list vl1 vl2 ->
+  eval_addressing genv sp addr vl1 = Some v1 ->
+  exists v2, eval_addressing genv sp addr vl2 = Some v2 /\ Val.lessdef v1 v2.
+Proof.
+  intros. rewrite val_inject_list_lessdef in H.
+  assert (exists v2 : val,
+          eval_addressing genv sp addr vl2 = Some v2
+          /\ Val.inject (fun b => Some(b, 0)) v1 v2).
+  eapply eval_addressing_inj with (sp1 := sp).
+  intros. rewrite <- val_inject_lessdef; auto.
+  rewrite <- val_inject_lessdef; auto.
+  eauto. auto.
+  destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto.
+Qed.
+
+End EVAL_LESSDEF.
+
+(** Compatibility of the evaluation functions with memory injections. *)
+
+Section EVAL_INJECT.
+
+Variable F V: Type.
+Variable genv: Genv.t F V.
+Variable f: meminj.
+Hypothesis globals: meminj_preserves_globals genv f.
+Variable sp1: block.
+Variable sp2: block.
+Variable delta: Z.
+Hypothesis sp_inj: f sp1 = Some(sp2, delta).
+
+Remark symbol_address_inject:
+  forall id ofs, Val.inject f (Genv.symbol_address genv id ofs) (Genv.symbol_address genv id ofs).
+Proof.
+  intros. unfold Genv.symbol_address. destruct (Genv.find_symbol genv id) eqn:?; auto.
+  exploit (proj1 globals); eauto. intros.
+  econstructor; eauto. rewrite Ptrofs.add_zero; auto.
+Qed.
+
+Lemma eval_condition_inject:
+  forall cond vl1 vl2 b m1 m2,
+  Val.inject_list f vl1 vl2 ->
+  Mem.inject f m1 m2 ->
+  eval_condition cond vl1 m1 = Some b ->
+  eval_condition cond vl2 m2 = Some b.
+Proof.
+  intros. eapply eval_condition_inj with (f := f) (m1 := m1); eauto.
+  intros; eapply Mem.valid_pointer_inject_val; eauto.
+  intros; eapply Mem.weak_valid_pointer_inject_val; eauto.
+  intros; eapply Mem.weak_valid_pointer_inject_no_overflow; eauto.
+  intros; eapply Mem.different_pointers_inject; eauto.
+Qed.
+
+Lemma eval_addressing_inject:
+  forall addr vl1 vl2 v1,
+  Val.inject_list f vl1 vl2 ->
+  eval_addressing genv (Vptr sp1 Ptrofs.zero) addr vl1 = Some v1 ->
+  exists v2,
+     eval_addressing genv (Vptr sp2 Ptrofs.zero) (shift_stack_addressing delta addr) vl2 = Some v2
+  /\ Val.inject f v1 v2.
+Proof.
+  intros.
+  rewrite eval_shift_stack_addressing.
+  eapply eval_addressing_inj with (sp1 := Vptr sp1 Ptrofs.zero); eauto.
+  intros. apply symbol_address_inject.
+  econstructor; eauto. rewrite Ptrofs.add_zero_l; auto. 
+Qed.
+
+Lemma eval_operation_inject:
+  forall op vl1 vl2 v1 m1 m2,
+  Val.inject_list f vl1 vl2 ->
+  Mem.inject f m1 m2 ->
+  eval_operation genv (Vptr sp1 Ptrofs.zero) op vl1 m1 = Some v1 ->
+  exists v2,
+     eval_operation genv (Vptr sp2 Ptrofs.zero) (shift_stack_operation delta op) vl2 m2 = Some v2
+  /\ Val.inject f v1 v2.
+Proof.
+  intros.
+  rewrite eval_shift_stack_operation. simpl.
+  eapply eval_operation_inj with (sp1 := Vptr sp1 Ptrofs.zero) (m1 := m1); eauto.
+  intros; eapply Mem.valid_pointer_inject_val; eauto.
+  intros; eapply Mem.weak_valid_pointer_inject_val; eauto.
+  intros; eapply Mem.weak_valid_pointer_inject_no_overflow; eauto.
+  intros; eapply Mem.different_pointers_inject; eauto.
+  intros. apply symbol_address_inject.
+  econstructor; eauto. rewrite Ptrofs.add_zero_l; auto. 
+Qed.
+
+End EVAL_INJECT.
+
+(** * Handling of builtin arguments *)
+
+Definition builtin_arg_ok_1
+       (A: Type) (ba: builtin_arg A) (c: builtin_arg_constraint) :=
+  match c, ba with
+  | OK_all, _ => true
+  | OK_const, (BA_int _ | BA_long _ | BA_float _ | BA_single _) => true
+  | OK_addrstack, BA_addrstack _ => true
+  | OK_addressing, BA_addrstack _ => true
+  | OK_addressing, BA_addptr (BA _) (BA_int _) => true
+  | OK_addressing, BA_addptr (BA _) (BA_long _) => true
+  | _, _ => false
+  end.
+
+Definition builtin_arg_ok
+       (A: Type) (ba: builtin_arg A) (c: builtin_arg_constraint) :=
+  match ba with
+  | (BA _ | BA_splitlong (BA _) (BA _)) => true
+  | _ => builtin_arg_ok_1 ba c
+  end.  
diff --git a/aarch64/PrintOp.ml b/aarch64/PrintOp.ml
new file mode 100644
index 00000000..2d45e446
--- /dev/null
+++ b/aarch64/PrintOp.ml
@@ -0,0 +1,247 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Pretty-printing of operators, conditions, addressing modes *)
+
+open Printf
+open Camlcoq
+open Integers
+open Op
+
+let comparison_name = function
+  | Ceq -> "=="
+  | Cne -> "!="
+  | Clt -> "<"
+  | Cle -> "<="
+  | Cgt -> ">"
+  | Cge -> ">="
+
+let shift pp (s, a) =
+  match s with
+  | Slsl -> fprintf pp "<< %ld" (camlint_of_coqint a)
+  | Slsr -> fprintf pp ">>u %ld" (camlint_of_coqint a)
+  | Sasr -> fprintf pp ">>s %ld" (camlint_of_coqint a)
+  | Sror -> fprintf pp "ror %ld" (camlint_of_coqint a)
+
+let shiftl pp (s, a) =
+  match s with
+  | Slsl -> fprintf pp "<<l %ld" (camlint_of_coqint a)
+  | Slsr -> fprintf pp ">>lu %ld" (camlint_of_coqint a)
+  | Sasr -> fprintf pp ">>ls %ld" (camlint_of_coqint a)
+  | Sror -> fprintf pp "rorl %ld" (camlint_of_coqint a)
+
+let extend_name = function
+  | Xsgn32 -> "sext"
+  | Xuns32 -> "zext"
+
+let print_condition reg pp = function
+  | (Ccomp c, [r1;r2]) ->
+      fprintf pp "%a %ss %a" reg r1 (comparison_name c) reg r2
+  | (Ccompu c, [r1;r2]) ->
+      fprintf pp "%a %su %a" reg r1 (comparison_name c) reg r2
+  | (Ccompimm(c, n), [r1]) ->
+      fprintf pp "%a %ss %ld" reg r1 (comparison_name c) (camlint_of_coqint n)
+  | (Ccompuimm(c, n), [r1]) ->
+      fprintf pp "%a %su %ld" reg r1 (comparison_name c) (camlint_of_coqint n)
+  | (Ccompshift(c, s, a), [r1;r2]) ->
+      fprintf pp "%a %ss %a %a" reg r1 (comparison_name c) reg r2 shift (s, a)
+  | (Ccompushift(c, s, a), [r1;r2]) ->
+      fprintf pp "%a %su %a %a" reg r1 (comparison_name c) reg r2 shift (s, a)
+  | (Cmaskzero n, [r1]) ->
+      fprintf pp "%a & 0x%lx == 0" reg r1 (camlint_of_coqint n)
+  | (Cmasknotzero n, [r1]) ->
+      fprintf pp "%a & 0x%lx != 0" reg r1 (camlint_of_coqint n)
+  | (Ccompl c, [r1;r2]) ->
+      fprintf pp "%a %sls %a" reg r1 (comparison_name c) reg r2
+  | (Ccomplu c, [r1;r2]) ->
+      fprintf pp "%a %slu %a" reg r1 (comparison_name c) reg r2
+  | (Ccomplimm(c, n), [r1]) ->
+      fprintf pp "%a %sls %Ld" reg r1 (comparison_name c) (camlint64_of_coqint n)
+  | (Ccompluimm(c, n), [r1]) ->
+      fprintf pp "%a %slu %Ld" reg r1 (comparison_name c) (camlint64_of_coqint n)
+  | (Ccomplshift(c, s, a), [r1;r2]) ->
+      fprintf pp "%a %sls %a %a" reg r1 (comparison_name c) reg r2 shift (s, a)
+  | (Ccomplushift(c, s, a), [r1;r2]) ->
+      fprintf pp "%a %slu %a %a" reg r1 (comparison_name c) reg r2 shift (s, a)
+  | (Cmasklzero n, [r1]) ->
+      fprintf pp "%a &l 0x%Lx == 0" reg r1 (camlint64_of_coqint n)
+  | (Cmasklnotzero n, [r1]) ->
+      fprintf pp "%a &l 0x%Lx != 0" reg r1 (camlint64_of_coqint n)
+  | (Ccompf c, [r1;r2]) ->
+      fprintf pp "%a %sf %a" reg r1 (comparison_name c) reg r2
+  | (Cnotcompf c, [r1;r2]) ->
+      fprintf pp "%a not(%sf) %a" reg r1 (comparison_name c) reg r2
+  | (Ccompfzero c, [r1]) ->
+      fprintf pp "%a %sf 0.0" reg r1 (comparison_name c)
+  | (Cnotcompfzero c, [r1]) ->
+      fprintf pp "%a not(%sf) 0.0" reg r1 (comparison_name c)
+  | (Ccompfs c, [r1;r2]) ->
+      fprintf pp "%a %sfs %a" reg r1 (comparison_name c) reg r2
+  | (Cnotcompfs c, [r1;r2]) ->
+      fprintf pp "%a not(%sfs) %a" reg r1 (comparison_name c) reg r2
+  | (Ccompfszero c, [r1]) ->
+      fprintf pp "%a %sfs 0.0" reg r1 (comparison_name c)
+  | (Cnotcompfszero c, [r1]) ->
+      fprintf pp "%a not(%sfs) 0.0" reg r1 (comparison_name c)
+  | _ ->
+      fprintf pp "<bad condition>"
+
+let print_operation reg pp = function
+  | Omove, [r1] -> reg pp r1
+  | Ointconst n, [] -> fprintf pp "%ld" (camlint_of_coqint n)
+  | Olongconst n, [] -> fprintf pp "%LdL" (camlint64_of_coqint n)
+  | Ofloatconst n, [] -> fprintf pp "%F" (camlfloat_of_coqfloat n)
+  | Osingleconst n, [] -> fprintf pp "%Ff" (camlfloat_of_coqfloat32 n)
+  | Oaddrsymbol(id, ofs), [] ->
+      fprintf pp "\"%s\" + %Ld" (extern_atom id) (camlint64_of_ptrofs ofs)
+  | Oaddrstack ofs, [] ->
+      fprintf pp "stack(%Ld)" (camlint64_of_ptrofs ofs)
+(* 32-bit integer arithmetic *)
+  | Oshift(s, a), [r1] -> fprintf pp "%a %a" reg r1 shift (s,a)
+  | Oadd, [r1;r2] -> fprintf pp "%a + %a" reg r1 reg r2
+  | Oaddshift(s, a), [r1;r2] -> fprintf pp "%a + %a %a" reg r1 reg r2 shift (s,a)
+  | Oaddimm n, [r1] -> fprintf pp "%a + %ld" reg r1 (camlint_of_coqint n)
+  | Oneg, [r1] -> fprintf pp "- %a" reg r1
+  | Onegshift(s, a), [r1] -> fprintf pp "- (%a %a)" reg r1 shift (s,a)
+  | Osub, [r1;r2] -> fprintf pp "%a - %a" reg r1 reg r2
+  | Osubshift(s, a), [r1;r2] -> fprintf pp "%a - %a %a" reg r1 reg r2 shift (s,a)
+  | Omul, [r1;r2] -> fprintf pp "%a * %a" reg r1 reg r2
+  | Omuladd, [r1;r2;r3] -> fprintf pp "%a + %a * %a" reg r3 reg r1 reg r2
+  | Omulsub, [r1;r2;r3] -> fprintf pp "%a - %a * %a" reg r3 reg r1 reg r2
+  | Odiv, [r1;r2] -> fprintf pp "%a /s %a" reg r1 reg r2
+  | Odivu, [r1;r2] -> fprintf pp "%a /u %a" reg r1 reg r2
+  | Oand, [r1;r2] -> fprintf pp "%a & %a" reg r1 reg r2
+  | Oandshift(s, a), [r1;r2] -> fprintf pp "%a & %a %a" reg r1 reg r2 shift (s,a)
+  | Oandimm n, [r1] -> fprintf pp "%a & %ld" reg r1 (camlint_of_coqint n)
+  | Oor, [r1;r2] -> fprintf pp "%a | %a" reg r1 reg r2
+  | Oorshift(s, a), [r1;r2] -> fprintf pp "%a | %a %a" reg r1 reg r2 shift (s,a)
+  | Oorimm n, [r1] ->  fprintf pp "%a | %ld" reg r1 (camlint_of_coqint n)
+  | Oxor, [r1;r2] -> fprintf pp "%a ^ %a" reg r1 reg r2
+  | Oxorshift(s, a), [r1;r2] -> fprintf pp "%a ^ %a %a" reg r1 reg r2 shift (s,a)
+  | Oxorimm n, [r1] -> fprintf pp "%a ^ %ld" reg r1 (camlint_of_coqint n)
+  | Onot, [r1] -> fprintf pp "~ %a" reg r1
+  | Onotshift(s, a), [r1] -> fprintf pp "~ (%a %a)" reg r1 shift (s,a)
+  | Obic, [r1;r2] -> fprintf pp "%a & ~ %a" reg r1 reg r2
+  | Obicshift(s, a), [r1;r2] -> fprintf pp "%a & ~ %a %a" reg r1 reg r2 shift (s,a)
+  | Oorn, [r1;r2] -> fprintf pp "%a | ~ %a" reg r1 reg r2
+  | Oornshift(s, a), [r1;r2] -> fprintf pp "%a | ~ %a %a" reg r1 reg r2 shift (s,a)
+  | Oeqv, [r1;r2] -> fprintf pp "%a ^ ~ %a" reg r1 reg r2
+  | Oeqvshift(s, a), [r1;r2] -> fprintf pp "%a ^ ~ %a %a" reg r1 reg r2 shift (s,a)
+  | Oshl, [r1;r2] -> fprintf pp "%a << %a" reg r1 reg r2
+  | Oshr, [r1;r2] -> fprintf pp "%a >>s %a" reg r1 reg r2
+  | Oshru, [r1;r2] -> fprintf pp "%a >>u %a" reg r1 reg r2
+  | Oshrximm n, [r1] -> fprintf pp "%a >>x %ld" reg r1 (camlint_of_coqint n)
+  | Ozext s, [r1] -> fprintf pp "zext(%d, %a)" (Z.to_int s) reg r1
+  | Osext s, [r1] -> fprintf pp "sext(%d, %a)" (Z.to_int s) reg r1
+  | Oshlzext(s, a), [r1] -> fprintf pp "zext(%d, %a) << %ld" (Z.to_int s) reg r1 (camlint_of_coqint a)
+  | Oshlsext(s, a), [r1] -> fprintf pp "sext(%d, %a) << %ld" (Z.to_int s) reg r1 (camlint_of_coqint a)
+  | Ozextshr(a, s), [r1] -> fprintf pp "zext(%d, %a >>u %ld)" (Z.to_int s) reg r1 (camlint_of_coqint a)
+  | Osextshr(a, s), [r1] -> fprintf pp "sext(%d, %a >>s %ld)" (Z.to_int s) reg r1 (camlint_of_coqint a)
+(* 64-bit integer arithmetic *)
+  | Oshiftl(s, a), [r1] -> fprintf pp "%a %a" reg r1 shiftl (s,a)
+  | Oextend(x, a), [r1] -> fprintf pp "%s(32, %a) <<l %ld" (extend_name x) reg r1 (camlint_of_coqint a)
+  | Omakelong, [r1;r2] -> fprintf pp "makelong(%a,%a)" reg r1 reg r2
+  | Olowlong, [r1] -> fprintf pp "lowlong(%a)" reg r1
+  | Ohighlong, [r1] -> fprintf pp "highlong(%a)" reg r1
+  | Oaddl, [r1;r2] -> fprintf pp "%a +l %a" reg r1 reg r2
+  | Oaddlshift(s, a), [r1;r2] -> fprintf pp "%a +l %a %a" reg r1 reg r2 shiftl (s,a)
+  | Oaddlext(x, a), [r1;r2] -> fprintf pp "%a +l %s(%a) << %ld" reg r1 (extend_name x) reg r2 (camlint_of_coqint a)
+  | Oaddlimm n, [r1] -> fprintf pp "%a +l %Ld" reg r1 (camlint64_of_coqint n)
+  | Onegl, [r1] -> fprintf pp "-l %a" reg r1
+  | Oneglshift(s, a), [r1] -> fprintf pp "-l (%a %a)" reg r1 shiftl (s,a)
+  | Osubl, [r1;r2] -> fprintf pp "%a -l %a" reg r1 reg r2
+  | Osublext(x, a), [r1;r2] -> fprintf pp "%a +l %s(%a) << %ld" reg r1 (extend_name x) reg r2 (camlint_of_coqint a)
+  | Osublshift(s, a), [r1;r2] -> fprintf pp "%a -l %a %a" reg r1 reg r2 shiftl (s,a)
+  | Omull, [r1;r2] -> fprintf pp "%a *l %a" reg r1 reg r2
+  | Omulladd, [r1;r2;r3] -> fprintf pp "%a +l %a *l %a" reg r3 reg r1 reg r2
+  | Omullsub, [r1;r2;r3] -> fprintf pp "%a -l %a *l %a" reg r3 reg r1 reg r2
+  | Omullhs, [r1;r2] -> fprintf pp "%a *hls %a" reg r1 reg r2
+  | Omullhu, [r1;r2] -> fprintf pp "%a *hlu %a" reg r1 reg r2
+  | Odivl, [r1;r2] -> fprintf pp "%a /ls %a" reg r1 reg r2
+  | Odivlu, [r1;r2] -> fprintf pp "%a /lu %a" reg r1 reg r2
+  | Oandl, [r1;r2] -> fprintf pp "%a &l %a" reg r1 reg r2
+  | Oandlshift(s, a), [r1;r2] -> fprintf pp "%a &l %a %a" reg r1 reg r2 shiftl (s,a)
+  | Oandlimm n, [r1] -> fprintf pp "%a &l %Ld" reg r1 (camlint64_of_coqint n)
+  | Oorl, [r1;r2] -> fprintf pp "%a |l %a" reg r1 reg r2
+  | Oorlshift(s, a), [r1;r2] -> fprintf pp "%a |l %a %a" reg r1 reg r2 shiftl (s,a)
+  | Oorlimm n, [r1] ->  fprintf pp "%a |l %Ld" reg r1 (camlint64_of_coqint n)
+  | Oxorl, [r1;r2] -> fprintf pp "%a ^l %a" reg r1 reg r2
+  | Oxorlshift(s, a), [r1;r2] -> fprintf pp "%a ^l %a %a" reg r1 reg r2 shiftl (s,a)
+  | Oxorlimm n, [r1] -> fprintf pp "%a ^l %Ld" reg r1 (camlint64_of_coqint n)
+  | Onotl, [r1] -> fprintf pp "~l %a" reg r1
+  | Onotlshift(s, a), [r1] -> fprintf pp "~l (%a %a)" reg r1 shiftl (s,a)
+  | Obicl, [r1;r2] -> fprintf pp "%a &l ~l %a" reg r1 reg r2
+  | Obiclshift(s, a), [r1;r2] -> fprintf pp "%a &l ~l %a %a" reg r1 reg r2 shiftl (s,a)
+  | Oornl, [r1;r2] -> fprintf pp "%a |l ~l %a" reg r1 reg r2
+  | Oornlshift(s, a), [r1;r2] -> fprintf pp "%a |l ~l %a %a" reg r1 reg r2 shiftl (s,a)
+  | Oeqvl, [r1;r2] -> fprintf pp "%a ^l ~l %a" reg r1 reg r2
+  | Oeqvlshift(s, a), [r1;r2] -> fprintf pp "%a ^l ~l %a %a" reg r1 reg r2 shift (s,a)
+  | Oshll, [r1;r2] -> fprintf pp "%a <<l %a" reg r1 reg r2
+  | Oshrl, [r1;r2] -> fprintf pp "%a >>ls %a" reg r1 reg r2
+  | Oshrlu, [r1;r2] -> fprintf pp "%a >>lu %a" reg r1 reg r2
+  | Oshrlximm n, [r1] -> fprintf pp "%a >>lx %ld" reg r1 (camlint_of_coqint n)
+  | Ozextl s, [r1] -> fprintf pp "zextl(%d, %a)" (Z.to_int s) reg r1
+  | Osextl s, [r1] -> fprintf pp "sextl(%d, %a)" (Z.to_int s) reg r1
+  | Oshllzext(s, a), [r1] -> fprintf pp "zextl(%d, %a) <<l %ld" (Z.to_int s) reg r1 (camlint_of_coqint a)
+  | Oshllsext(s, a), [r1] -> fprintf pp "sextl(%d, %a) <<l %ld" (Z.to_int s) reg r1 (camlint_of_coqint a)
+  | Ozextshrl(a, s), [r1] -> fprintf pp "zextl(%d, %a >>lu %ld)" (Z.to_int s) reg r1 (camlint_of_coqint a)
+  | Osextshrl(a, s), [r1] -> fprintf pp "sextl(%d, %a >>ls %ld)" (Z.to_int s) reg r1 (camlint_of_coqint a)
+(* 64-bit floating-point arithmetic *)
+  | Onegf, [r1] -> fprintf pp "negf(%a)" reg r1
+  | Oabsf, [r1] -> fprintf pp "absf(%a)" reg r1
+  | Oaddf, [r1;r2] -> fprintf pp "%a +f %a" reg r1 reg r2
+  | Osubf, [r1;r2] -> fprintf pp "%a -f %a" reg r1 reg r2
+  | Omulf, [r1;r2] -> fprintf pp "%a *f %a" reg r1 reg r2
+  | Odivf, [r1;r2] -> fprintf pp "%a /f %a" reg r1 reg r2
+(* 32-bit floating-point arithmetic *)
+  | Onegfs, [r1] -> fprintf pp "negfs(%a)" reg r1
+  | Oabsfs, [r1] -> fprintf pp "absfs(%a)" reg r1
+  | Oaddfs, [r1;r2] -> fprintf pp "%a +fs %a" reg r1 reg r2
+  | Osubfs, [r1;r2] -> fprintf pp "%a -fs %a" reg r1 reg r2
+  | Omulfs, [r1;r2] -> fprintf pp "%a *fs %a" reg r1 reg r2
+  | Odivfs, [r1;r2] -> fprintf pp "%a /fs %a" reg r1 reg r2
+  | Osingleoffloat, [r1] -> fprintf pp "singleoffloat(%a)" reg r1
+  | Ofloatofsingle, [r1] -> fprintf pp "floatofsingle(%a)" reg r1
+(* Conversions between int and float *)
+  | Ointoffloat, [r1] -> fprintf pp "intoffloat(%a)" reg r1
+  | Ointuoffloat, [r1] -> fprintf pp "intuoffloat(%a)" reg r1
+  | Ofloatofint, [r1] -> fprintf pp "floatofint(%a)" reg r1
+  | Ofloatofintu, [r1] -> fprintf pp "floatofintu(%a)" reg r1
+  | Olongoffloat, [r1] -> fprintf pp "longoffloat(%a)" reg r1
+  | Olonguoffloat, [r1] -> fprintf pp "longuoffloat(%a)" reg r1
+  | Ofloatoflong, [r1] -> fprintf pp "floatoflong(%a)" reg r1
+  | Ofloatoflongu, [r1] -> fprintf pp "floatoflongu(%a)" reg r1
+  | Ointofsingle, [r1] -> fprintf pp "intofsingle(%a)" reg r1
+  | Ointuofsingle, [r1] -> fprintf pp "intuofsingle(%a)" reg r1
+  | Osingleofint, [r1] -> fprintf pp "singleofint(%a)" reg r1
+  | Osingleofintu, [r1] -> fprintf pp "singleofintu(%a)" reg r1
+  | Olongofsingle, [r1] -> fprintf pp "longofsingle(%a)" reg r1
+  | Olonguofsingle, [r1] -> fprintf pp "longuofsingle(%a)" reg r1
+  | Osingleoflong, [r1] -> fprintf pp "singleoflong(%a)" reg r1
+  | Osingleoflongu, [r1] -> fprintf pp "singleoflongu(%a)" reg r1
+(* Boolean tests *)
+  | Ocmp c, args -> print_condition reg pp (c, args)
+  | Osel (c, ty), r1::r2::args ->
+      fprintf pp "%a ?%s %a : %a"
+         (print_condition reg) (c, args)
+         (PrintAST.name_of_type ty) reg r1 reg r2
+  | _ -> fprintf pp "<bad operator>"
+
+let print_addressing reg pp = function
+  | Aindexed n, [r1] -> fprintf pp "%a + %Ld" reg r1 (camlint64_of_coqint n)
+  | Aindexed2, [r1; r2] -> fprintf pp "%a + %a" reg r1 reg r2
+  | Aindexed2shift a, [r1; r2] -> fprintf pp "%a + %a << %ld" reg r1 reg r2 (camlint_of_coqint a)
+  | Aindexed2ext(x, a), [r1; r2] -> fprintf pp "%a + %s(%a) << %ld" reg r1 (extend_name x) reg r2 (camlint_of_coqint a)
+  | Aglobal(id, ofs), [] ->
+      fprintf pp "\"%s\" + %Ld" (extern_atom id) (camlint64_of_ptrofs ofs)
+  | Ainstack ofs, [] -> fprintf pp "stack(%Ld)" (camlint64_of_ptrofs ofs)
+  | _ -> fprintf pp "<bad addressing>"
diff --git a/aarch64/SelectLong.vp b/aarch64/SelectLong.vp
new file mode 100644
index 00000000..ddf6e212
--- /dev/null
+++ b/aarch64/SelectLong.vp
@@ -0,0 +1,478 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Instruction selection for 64-bit integer operations *)
+
+Require Import Coqlib Zbits.
+Require Import Compopts AST Integers Floats.
+Require Import Op CminorSel SelectOp.
+
+Local Open Scope cminorsel_scope.
+
+(** ** Constants **)
+
+Definition longconst (n: int64) : expr :=
+  Eop (Olongconst n) Enil.
+
+(** ** Conversions *)
+
+Nondetfunction intoflong (e: expr) :=
+  match e with
+  | Eop (Olongconst n) Enil => Eop (Ointconst (Int.repr (Int64.unsigned n))) Enil
+  | _ =>  Eop Olowlong (e ::: Enil)
+  end.
+
+Nondetfunction longofint (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => longconst (Int64.repr (Int.signed n))
+  | _ =>  Eop (Oextend Xsgn32 (mk_amount64 Int.zero)) (e ::: Enil)
+  end.
+
+Nondetfunction longofintu (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => longconst (Int64.repr (Int.unsigned n))
+  | _ =>  Eop (Oextend Xuns32 (mk_amount64 Int.zero)) (e ::: Enil)
+  end.
+
+(** ** Integer addition and pointer addition *)
+
+Nondetfunction addlimm (n: int64) (e: expr) :=
+  if Int64.eq n Int64.zero then e else
+  match e with
+  | Eop (Olongconst m) Enil => longconst (Int64.add n m)
+  | Eop (Oaddrsymbol s m) Enil => Eop (Oaddrsymbol s (Ptrofs.add (Ptrofs.of_int64 n) m)) Enil
+  | Eop (Oaddrstack m) Enil => Eop (Oaddrstack (Ptrofs.add (Ptrofs.of_int64 n) m)) Enil
+  | Eop (Oaddlimm m) (t ::: Enil) => Eop (Oaddlimm(Int64.add n m)) (t ::: Enil)
+  | _ => Eop (Oaddlimm n) (e ::: Enil)
+  end.
+
+Nondetfunction addl (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Olongconst n1) Enil, t2 => addlimm n1 t2
+  | t1, Eop (Olongconst n2) Enil => addlimm n2 t1
+  | Eop (Oaddlimm n1) (t1:::Enil), Eop (Oaddlimm n2) (t2:::Enil) =>
+      addlimm (Int64.add n1 n2) (Eop Oaddl (t1:::t2:::Enil))
+  | Eop (Oaddlimm n1) (t1:::Enil), Eop (Oaddrstack n2) Enil =>
+      Eop Oaddl (Eop (Oaddrstack (Ptrofs.add (Ptrofs.of_int64 n1) n2)) Enil ::: t1 ::: Enil)
+  | Eop (Oaddrstack n1) Enil, Eop (Oaddlimm n2) (t2:::Enil) =>
+      Eop Oaddl (Eop (Oaddrstack (Ptrofs.add n1 (Ptrofs.of_int64 n2))) Enil ::: t2 ::: Enil)
+  | Eop (Oaddlimm n1) (t1:::Enil), t2 =>
+      addlimm n1 (Eop Oaddl (t1:::t2:::Enil))
+  | t1, Eop (Oaddlimm n2) (t2:::Enil) =>
+      addlimm n2 (Eop Oaddl (t1:::t2:::Enil))
+  | Eop (Oshiftl s a) (t1:::Enil), t2 ?? arith_shift s =>
+      Eop (Oaddlshift s a) (t2 ::: t1 ::: Enil)
+  | t1, Eop (Oshiftl s a) (t2:::Enil) ?? arith_shift s =>
+      Eop (Oaddlshift s a) (t1 ::: t2 ::: Enil)
+  | Eop (Oextend x a) (t1:::Enil), t2 =>
+      Eop (Oaddlext x a) (t2 ::: t1 ::: Enil)
+  | t1, Eop (Oextend x a) (t2:::Enil) =>
+      Eop (Oaddlext x a) (t1 ::: t2 ::: Enil)
+  | Eop Omull (t1:::t2:::Enil), t3 =>
+      Eop Omulladd (t3:::t1:::t2:::Enil)
+  | t1, Eop Omull (t2:::t3:::Enil) =>
+      Eop Omulladd (t1:::t2:::t3:::Enil)
+  | _, _ => Eop Oaddl (e1:::e2:::Enil)
+  end.
+
+(** ** Opposite *)
+
+Nondetfunction negl (e: expr) :=
+  match e with
+  | Eop (Olongconst n) Enil => Eop (Olongconst (Int64.neg n)) Enil
+  | Eop (Oshiftl s a) (t1:::Enil) ?? arith_shift s => Eop (Oneglshift s a) (t1:::Enil)
+  | _ =>  Eop Onegl (e ::: Enil)
+  end.
+
+(** ** Integer and pointer subtraction *)
+
+Nondetfunction subl (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | t1, Eop (Olongconst n2) Enil =>
+      addlimm (Int64.neg n2) t1
+  | Eop (Oaddlimm n1) (t1:::Enil), Eop (Oaddlimm n2) (t2:::Enil) =>
+      addlimm (Int64.sub n1 n2) (Eop Osubl (t1:::t2:::Enil))
+  | Eop (Oaddlimm n1) (t1:::Enil), t2 =>
+      addlimm n1 (Eop Osubl (t1:::t2:::Enil))
+  | t1, Eop (Oaddlimm n2) (t2:::Enil) =>
+      addlimm (Int64.neg n2) (Eop Osubl (t1:::t2:::Enil))
+  | t1, Eop (Oshiftl s a) (t2:::Enil) ?? arith_shift s =>
+      Eop (Osublshift s a) (t1:::t2::: Enil)
+  | t1, Eop (Oextend x a) (t2:::Enil) =>
+      Eop (Osublext x a) (t1 ::: t2 ::: Enil)
+  | t1, Eop Omull (t2:::t3:::Enil) =>
+      Eop Omullsub (t1:::t2:::t3:::Enil)
+  | _, _ => Eop Osubl (e1:::e2:::Enil)
+  end.
+
+(** ** Immediate shift left *)
+
+Definition shllimm_base (e1: expr) (n: int) :=
+  Eop (Oshiftl Slsl (mk_amount64 n)) (e1 ::: Enil).
+
+Nondetfunction shllimm (e1: expr) (n: int) :=
+  if Int.eq n Int.zero then
+    e1
+  else if negb (Int.ltu n Int64.iwordsize') then
+    Eop Oshll (e1 ::: Eop (Ointconst n) Enil ::: Enil)
+  else match e1 with
+    | Eop (Olongconst n1) Enil =>
+        Eop (Olongconst (Int64.shl' n1 n)) Enil
+    | Eop (Oshiftl Slsl a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int64.iwordsize'
+        then shllimm_base t1 (Int.add a n)
+        else shllimm_base e1 n
+    | Eop (Ozextl s) (t1:::Enil) =>
+        Eop (Oshllzext s (mk_amount64 n)) (t1:::Enil)
+    | Eop (Osextl s) (t1:::Enil) =>
+        Eop (Oshllsext s (mk_amount64 n)) (t1:::Enil)
+    | Eop (Oshllzext s a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int64.iwordsize'
+        then Eop (Oshllzext s (mk_amount64 (Int.add a n))) (t1:::Enil)
+        else shllimm_base e1 n
+    | Eop (Oshllsext s a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int64.iwordsize'
+        then Eop (Oshllsext s (mk_amount64 (Int.add a n))) (t1:::Enil)
+        else shllimm_base e1 n
+    | Eop (Oextend x a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int64.iwordsize'
+        then Eop (Oextend x (mk_amount64 (Int.add a n))) (t1:::Enil)
+        else shllimm_base e1 n
+    | _ =>
+        shllimm_base e1 n
+  end.
+
+(** ** Immediate shift right (logical) *)
+
+Definition shrluimm_base (e1: expr) (n: int) :=
+  Eop (Oshiftl Slsr (mk_amount64 n)) (e1 ::: Enil).
+
+Nondetfunction shrluimm (e1: expr) (n: int) :=
+  if Int.eq n Int.zero then
+    e1
+  else if negb (Int.ltu n Int64.iwordsize') then
+    Eop Oshrlu (e1 ::: Eop (Ointconst n) Enil ::: Enil)
+  else match e1 with
+    | Eop (Olongconst n1) Enil =>
+        Eop (Olongconst (Int64.shru' n1 n)) Enil
+    | Eop (Oshiftl Slsl a) (t1:::Enil) =>
+        if Int.ltu n a
+        then Eop (Oshllzext (Int64.zwordsize - Int.unsigned a) (mk_amount64 (Int.sub a n))) (t1:::Enil)
+        else Eop (Ozextshrl (mk_amount64 (Int.sub n a)) (Int64.zwordsize - Int.unsigned n)) (t1:::Enil)
+    | Eop (Oshiftl Slsr a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int64.iwordsize'
+        then shrluimm_base t1 (Int.add a n)
+        else shrluimm_base e1 n
+    | Eop (Ozextl s) (t1:::Enil) =>
+        if zlt (Int.unsigned n) s
+        then Eop (Ozextshrl (mk_amount64 n) (s - Int.unsigned n)) (t1:::Enil)
+        else Eop (Olongconst Int64.zero) Enil
+    | _ =>
+        shrluimm_base e1 n
+    end.
+
+(** ** Immediate shift right (arithmetic) *)
+
+Definition shrlimm_base (e1: expr) (n: int) :=
+  Eop (Oshiftl Sasr (mk_amount64 n)) (e1 ::: Enil).
+
+Nondetfunction shrlimm (e1: expr) (n: int) :=
+  if Int.eq n Int.zero then
+    e1
+  else if negb (Int.ltu n Int64.iwordsize') then
+    Eop Oshrl (e1 ::: Eop (Ointconst n) Enil ::: Enil)
+  else match e1 with
+    | Eop (Olongconst n1) Enil =>
+        Eop (Olongconst (Int64.shr' n1 n)) Enil
+    | Eop (Oshiftl Slsl a) (t1:::Enil) =>
+        if Int.ltu n a
+        then Eop (Oshllsext (Int64.zwordsize - Int.unsigned a) (mk_amount64 (Int.sub a n))) (t1:::Enil)
+        else Eop (Osextshrl (mk_amount64 (Int.sub n a)) (Int64.zwordsize - Int.unsigned n)) (t1:::Enil)
+    | Eop (Oshiftl Sasr a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int64.iwordsize'
+        then shrlimm_base t1 (Int.add a n)
+        else shrlimm_base e1 n
+    | Eop (Osextl s) (t1:::Enil) =>
+        if zlt (Int.unsigned n) s && zlt s Int64.zwordsize
+        then Eop (Osextshrl (mk_amount64 n) (s - Int.unsigned n)) (t1:::Enil)
+        else shrlimm_base e1 n
+    | _ =>
+        shrlimm_base e1 n
+    end.
+
+(** ** Integer multiply *)
+
+Definition mullimm_base (n1: int64) (e2: expr) :=
+  match Int64.one_bits' n1 with
+  | i :: nil =>
+      shllimm e2 i
+  | i :: j :: nil =>
+      Elet e2 (addl (shllimm (Eletvar 0) i) (shllimm (Eletvar 0) j))
+  | _ =>
+      Eop Omull (Eop (Olongconst n1) Enil ::: e2 ::: Enil)
+  end.
+
+Nondetfunction mullimm (n1: int64) (e2: expr) :=
+  if Int64.eq n1 Int64.zero then Eop (Olongconst Int64.zero) Enil
+  else if Int64.eq n1 Int64.one then e2
+  else match e2 with
+  | Eop (Olongconst n2) Enil => Eop (Olongconst (Int64.mul n1 n2)) Enil
+  | Eop (Oaddlimm n2) (t2:::Enil) => addlimm (Int64.mul n1 n2) (mullimm_base n1 t2)
+  | _ => mullimm_base n1 e2
+  end.
+
+Nondetfunction mull (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Olongconst n1) Enil, t2 => mullimm n1 t2
+  | t1, Eop (Olongconst n2) Enil => mullimm n2 t1
+  | _, _ => Eop Omull (e1:::e2:::Enil)
+  end.
+
+Definition mullhs (e1: expr) (n2: int64) :=
+  Eop Omullhs (e1 ::: longconst n2 ::: Enil).
+
+Definition mullhu (e1: expr) (n2: int64) :=
+  Eop Omullhu (e1 ::: longconst n2 ::: Enil).
+
+(** ** Integer conversions *)
+
+Nondetfunction zero_ext_l (sz: Z) (e: expr) :=
+  match e with
+  | Eop (Olongconst n) Enil => Eop (Olongconst (Int64.zero_ext sz n)) Enil
+  | Eop (Oshiftl Slsr a) (t1:::Enil) => Eop (Ozextshrl a sz) (t1:::Enil)
+  | Eop (Oshiftl Slsl a) (t1:::Enil) =>
+      if zlt (Int.unsigned a) sz
+      then Eop (Oshllzext (sz - Int.unsigned a) a) (t1:::Enil)
+      else Eop (Ozextl sz) (e:::Enil)
+  | _ => Eop (Ozextl sz) (e:::Enil)
+  end.
+
+(** ** Bitwise not *)
+
+Nondetfunction notl (e: expr) :=
+  match e with
+  | Eop (Olongconst n) Enil => Eop (Olongconst (Int64.not n)) Enil
+  | Eop (Oshiftl s a) (t1:::Enil) => Eop (Onotlshift s a) (t1:::Enil)
+  | Eop Onotl (t1:::Enil) => t1
+  | Eop (Onotlshift s a) (t1:::Enil) => Eop (Oshiftl s a) (t1:::Enil)
+  | Eop Obicl (t1:::t2:::Enil) => Eop Oornl (t2:::t1:::Enil)
+  | Eop Oornl (t1:::t2:::Enil) => Eop Obicl (t2:::t1:::Enil)
+  | Eop Oxorl (t1:::t2:::Enil) => Eop Oeqvl (t1:::t2:::Enil)
+  | Eop Oeqvl (t1:::t2:::Enil) => Eop Oxorl (t1:::t2:::Enil)
+  | _ => Eop Onotl (e:::Enil)
+  end.
+
+(** ** Bitwise and *)
+
+Definition andlimm_base (n1: int64) (e2: expr) :=
+  if Int64.eq n1 Int64.zero then Eop (Olongconst Int64.zero) Enil else
+  if Int64.eq n1 Int64.mone then e2 else
+  match Z_is_power2m1 (Int64.unsigned n1) with
+  | Some s => zero_ext_l s e2
+  | None => Eop (Oandlimm n1) (e2 ::: Enil)
+  end.
+
+Nondetfunction andlimm (n1: int64) (e2: expr) :=
+  match e2 with
+  | Eop (Olongconst n2) Enil => Eop (Olongconst (Int64.and n1 n2)) Enil
+  | Eop (Oandlimm n2) (t2:::Enil) => andlimm_base (Int64.and n1 n2) t2
+  | Eop (Ozextl s) (t2:::Enil) =>
+      if zle 0 s
+      then andlimm_base (Int64.and n1 (Int64.repr (two_p s - 1))) t2
+      else andlimm_base n1 e2
+  | _ => andlimm_base n1 e2
+  end.
+
+Nondetfunction andl (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Olongconst n1) Enil, t2 => andlimm n1 t2
+  | t1, Eop (Olongconst n2) Enil => andlimm n2 t1
+  | Eop Onotl (t1:::Enil), t2 => Eop Obicl (t2:::t1:::Enil)
+  | t1, Eop Onotl (t2:::Enil) => Eop Obicl (t1:::t2:::Enil)
+  | Eop (Onotlshift s a) (t1:::Enil), t2 => Eop (Obiclshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Onotlshift s a) (t2:::Enil) => Eop (Obiclshift s a) (t1:::t2:::Enil)
+  | Eop (Oshiftl s a) (t1:::Enil), t2 => Eop (Oandlshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Oshiftl s a) (t2:::Enil) => Eop (Oandlshift s a) (t1:::t2:::Enil)
+  | _, _ => Eop Oandl (e1:::e2:::Enil)
+  end.
+
+(** ** Bitwise or *)
+
+Nondetfunction orlimm (n1: int64) (e2: expr) :=
+  if Int64.eq n1 Int64.zero then e2
+  else if Int64.eq n1 Int64.mone then Eop (Olongconst Int64.mone) Enil
+  else match e2 with
+  | Eop (Olongconst n2) Enil => Eop (Olongconst (Int64.or n1 n2)) Enil
+  | Eop (Oorlimm n2) (t2:::Enil) => Eop (Oorlimm (Int64.or n1 n2)) (t2:::Enil)
+  | _ => Eop (Oorlimm n1) (e2:::Enil)
+  end.
+
+Nondetfunction orl (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Olongconst n1) Enil, t2 => orlimm n1 t2
+  | t1, Eop (Olongconst n2) Enil => orlimm n2 t1
+  | Eop Onotl (t1:::Enil), t2 => Eop Oornl (t2:::t1:::Enil)
+  | t1, Eop Onotl (t2:::Enil) => Eop Oornl (t1:::t2:::Enil)
+  | Eop (Onotlshift s a) (t1:::Enil), t2 => Eop (Oornlshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Onotlshift s a) (t2:::Enil) => Eop (Oornlshift s a) (t1:::t2:::Enil)
+  | Eop (Oshiftl Slsl a1) (t1:::Enil), Eop (Oshiftl Slsr a2) (t2:::Enil) =>
+      if Int.eq (Int.add a1 a2) Int64.iwordsize' && same_expr_pure t1 t2
+      then Eop (Oshiftl Sror a2) (t2:::Enil)
+      else Eop (Oorlshift Slsr a2) (Eop (Oshiftl Slsl a1) (t1:::Enil):::t2:::Enil)
+  | Eop (Oshiftl Slsr a1) (t1:::Enil), Eop (Oshiftl Slsl a2) (t2:::Enil) =>
+      if Int.eq (Int.add a2 a1) Int64.iwordsize' && same_expr_pure t1 t2
+      then Eop (Oshiftl Sror a1) (t1:::Enil)
+      else Eop (Oorlshift Slsl a2) (Eop (Oshiftl Slsr a1) (t1:::Enil):::t2:::Enil)
+  | Eop (Oshiftl s a) (t1:::Enil), t2 => Eop (Oorlshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Oshiftl s a) (t2:::Enil) => Eop (Oorlshift s a) (t1:::t2:::Enil)
+  | _, _ => Eop Oorl (e1:::e2:::Enil)
+  end.
+
+(** ** Bitwise xor *)
+
+Definition xorlimm_base (n1: int64) (e2: expr) :=
+  if Int64.eq n1 Int64.zero then e2 else
+  if Int64.eq n1 Int64.mone then notl e2 else
+  Eop (Oxorlimm n1) (e2:::Enil).  
+
+Nondetfunction xorlimm (n1: int64) (e2: expr) :=
+  match e2 with
+  | Eop (Olongconst n2) Enil => Eop (Olongconst (Int64.xor n1 n2)) Enil
+  | Eop (Oxorlimm n2) (t2:::Enil) => xorlimm_base (Int64.xor n1 n2) t2
+  | _ => xorlimm_base n1 e2
+  end.
+
+Nondetfunction xorl (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Olongconst n1) Enil, t2 => xorlimm n1 t2
+  | t1, Eop (Olongconst n2) Enil => xorlimm n2 t1
+  | Eop Onotl (t1:::Enil), t2 => Eop Oeqvl (t2:::t1:::Enil)
+  | t1, Eop Onotl (t2:::Enil) => Eop Oeqvl (t1:::t2:::Enil)
+  | Eop (Onotlshift s a) (t1:::Enil), t2 => Eop (Oeqvlshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Onotlshift s a) (t2:::Enil) => Eop (Oeqvlshift s a) (t1:::t2:::Enil)
+  | Eop (Oshiftl s a) (t1:::Enil), t2 => Eop (Oxorlshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Oshiftl s a) (t2:::Enil) => Eop (Oxorlshift s a) (t1:::t2:::Enil)
+  | _, _ => Eop Oxorl (e1:::e2:::Enil)
+  end.
+
+(** ** Integer division and modulus *)
+
+Definition modl_aux (divop: operation) (e1 e2: expr) :=
+  Elet e1
+    (Elet (lift e2)
+      (Eop Omullsub (Eletvar 1 :::
+                     Eop divop (Eletvar 1 ::: Eletvar 0 ::: Enil) :::
+                     Eletvar 0 :::
+                     Enil))).
+
+Definition divls_base (e1: expr) (e2: expr) := Eop Odivl (e1:::e2:::Enil).
+Definition modls_base := modl_aux Odivl.
+Definition divlu_base (e1: expr) (e2: expr) := Eop Odivlu (e1:::e2:::Enil).
+Definition modlu_base := modl_aux Odivlu.
+
+Definition shrxlimm (e1: expr) (n2: int) :=
+  if Int.eq n2 Int.zero then e1 else Eop (Oshrlximm n2) (e1:::Enil).
+
+(** ** General shifts *)
+
+Nondetfunction shll (e1: expr) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => shllimm e1 n2
+  | _ => Eop Oshll (e1:::e2:::Enil)
+  end.
+
+Nondetfunction shrl (e1: expr) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => shrlimm e1 n2
+  | _ => Eop Oshrl (e1:::e2:::Enil)
+  end.
+
+Nondetfunction shrlu (e1: expr) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => shrluimm e1 n2
+  | _ => Eop Oshrlu (e1:::e2:::Enil)
+  end.
+
+(** ** Comparisons *)
+
+Nondetfunction complimm (default: comparison -> int64 -> condition)
+                        (sem: comparison -> int64 -> int64 -> bool)
+                        (c: comparison) (e1: expr) (n2: int64) :=
+  match c, e1 with
+  | c, Eop (Olongconst n1) Enil =>
+      Eop (Ointconst (if sem c n1 n2 then Int.one else Int.zero)) Enil
+  | Ceq, Eop (Oandlimm m) (t1:::Enil) =>
+      if Int64.eq n2 Int64.zero
+      then Eop (Ocmp (Cmasklzero m)) (t1:::Enil)
+      else Eop (Ocmp (default c n2)) (e1:::Enil)
+  | Cne, Eop (Oandlimm m) (t1:::Enil) =>
+      if Int64.eq n2 Int64.zero
+      then Eop (Ocmp (Cmasklnotzero m)) (t1:::Enil)
+      else Eop (Ocmp (default c n2)) (e1:::Enil)
+  | _, _ =>
+      Eop (Ocmp (default c n2)) (e1:::Enil)
+  end.
+
+Nondetfunction cmpl (c: comparison) (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Olongconst n1) Enil, t2 =>
+      complimm Ccomplimm Int64.cmp (swap_comparison c) t2 n1
+  | t1, Eop (Olongconst n2) Enil =>
+      complimm Ccomplimm Int64.cmp c t1 n2
+  | Eop (Oshiftl s a) (t1:::Enil), t2 ?? arith_shift s =>
+      Eop (Ocmp (Ccomplshift (swap_comparison c) s a)) (t2:::t1:::Enil)
+  | t1, Eop (Oshiftl s a) (t2:::Enil) ?? arith_shift s =>
+      Eop (Ocmp (Ccomplshift c s a)) (t1:::t2:::Enil)
+  | _, _ =>
+      Eop (Ocmp (Ccompl c)) (e1:::e2:::Enil)
+  end.
+
+Nondetfunction cmplu (c: comparison) (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Olongconst n1) Enil, t2 =>
+      complimm Ccompluimm Int64.cmpu (swap_comparison c) t2 n1
+  | t1, Eop (Olongconst n2) Enil =>
+      complimm Ccompluimm Int64.cmpu c t1 n2
+  | Eop (Oshiftl s a) (t1:::Enil), t2 ?? arith_shift s =>
+      Eop (Ocmp (Ccomplushift (swap_comparison c) s a)) (t2:::t1:::Enil)
+  | t1, Eop (Oshiftl s a) (t2:::Enil) ?? arith_shift s =>
+      Eop (Ocmp (Ccomplushift c s a)) (t1:::t2:::Enil)
+  | _, _ =>
+      Eop (Ocmp (Ccomplu c)) (e1:::e2:::Enil)
+  end.
+
+(** ** Floating-point conversions *)
+
+Definition longoffloat (e: expr) :=
+  Eop Olongoffloat (e:::Enil).
+
+Definition longuoffloat (e: expr) :=
+  Eop Olonguoffloat (e:::Enil).
+
+Definition floatoflong (e: expr) := 
+  Eop Ofloatoflong (e:::Enil).
+
+Definition floatoflongu (e: expr) := 
+  Eop Ofloatoflongu (e:::Enil).
+
+Definition longofsingle (e: expr) := 
+  Eop Olongofsingle (e:::Enil).
+
+Definition longuofsingle (e: expr) := 
+  Eop Olonguofsingle (e:::Enil).
+
+Definition singleoflong (e: expr) := 
+  Eop Osingleoflong (e:::Enil).
+
+Definition singleoflongu (e: expr) := 
+  Eop Osingleoflongu (e:::Enil).
+
diff --git a/aarch64/SelectLongproof.v b/aarch64/SelectLongproof.v
new file mode 100644
index 00000000..b051369c
--- /dev/null
+++ b/aarch64/SelectLongproof.v
@@ -0,0 +1,764 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Correctness of instruction selection for 64-bit integer operators *)
+
+Require Import Coqlib Zbits.
+Require Import AST Integers Floats Values Memory Globalenvs.
+Require Import Cminor Op CminorSel.
+Require Import SelectOp SelectLong SelectOpproof.
+
+Local Open Scope cminorsel_scope.
+Local Transparent Archi.ptr64.
+
+(** * Correctness of the smart constructors *)
+
+Section CMCONSTR.
+
+Variable ge: genv.
+Variable sp: val.
+Variable e: env.
+Variable m: mem.
+
+Definition unary_constructor_sound (cstr: expr -> expr) (sem: val -> val) : Prop :=
+  forall le a x,
+  eval_expr ge sp e m le a x ->
+  exists v, eval_expr ge sp e m le (cstr a) v /\ Val.lessdef (sem x) v.
+
+Definition binary_constructor_sound (cstr: expr -> expr -> expr) (sem: val -> val -> val) : Prop :=
+  forall le a x b y,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  exists v, eval_expr ge sp e m le (cstr a b) v /\ Val.lessdef (sem x y) v.
+
+Definition partial_unary_constructor_sound (cstr: expr -> expr) (sem: val -> option val) : Prop :=
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  sem x = Some y ->
+  exists v, eval_expr ge sp e m le (cstr a) v /\ Val.lessdef y v.
+
+Definition partial_binary_constructor_sound (cstr: expr -> expr -> expr) (sem: val -> val -> option val) : Prop :=
+  forall le a x b y z,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  sem x y = Some z ->
+  exists v, eval_expr ge sp e m le (cstr a b) v /\ Val.lessdef z v.
+
+(** ** Constants *)
+
+Theorem eval_longconst:
+  forall le n, eval_expr ge sp e m le (longconst n) (Vlong n).
+Proof.
+  intros; EvalOp.
+Qed.
+
+(** ** Conversions *)
+
+Theorem eval_intoflong: unary_constructor_sound intoflong Val.loword.
+Proof.
+  unfold intoflong; red; intros until x; destruct (intoflong_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_longofintu: unary_constructor_sound longofintu Val.longofintu.
+Proof.
+  unfold longofintu; red; intros until x; destruct (longofintu_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists. simpl. unfold eval_extend. rewrite mk_amount64_eq by reflexivity.
+  destruct x; simpl; auto. rewrite Int64.shl'_zero. auto.
+Qed.
+
+Theorem eval_longofint: unary_constructor_sound longofint Val.longofint.
+Proof.
+  unfold longofint; red; intros until x; destruct (longofint_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists. simpl. unfold eval_extend. rewrite mk_amount64_eq by reflexivity.
+  destruct x; simpl; auto. rewrite Int64.shl'_zero. auto.
+Qed.
+
+(** ** Addition, opposite, subtraction *)
+
+Theorem eval_addlimm:
+  forall n, unary_constructor_sound (addlimm n) (fun x => Val.addl x (Vlong n)).
+Proof.
+  red; unfold addlimm; intros until x.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero.
+- subst n. intros. exists x; split; auto.
+  destruct x; simpl; auto.
+  rewrite Int64.add_zero; auto.
+  rewrite Ptrofs.add_zero; auto.
+- case (addlimm_match a); intros; InvEval; subst.
++ rewrite Int64.add_commut; TrivialExists.
++ TrivialExists. simpl. rewrite Ptrofs.add_commut, Genv.shift_symbol_address_64; auto.
++ econstructor; split. EvalOp. destruct sp; simpl; auto. 
+  rewrite Ptrofs.add_assoc, (Ptrofs.add_commut m0); auto.
++ rewrite Val.addl_assoc, Int64.add_commut; TrivialExists.  
++ TrivialExists.
+Qed.
+
+Theorem eval_addl: binary_constructor_sound addl Val.addl.
+Proof.
+  red; intros until y.
+  unfold addl; case (addl_match a b); intros; InvEval; subst.
+- rewrite Val.addl_commut. apply eval_addlimm; auto.
+- apply eval_addlimm; auto.
+- replace (Val.addl (Val.addl v1 (Vlong n1)) (Val.addl v0 (Vlong n2)))
+     with (Val.addl (Val.addl v1 v0) (Val.addl (Vlong n1) (Vlong n2))).
+  apply eval_addlimm. EvalOp.
+  repeat rewrite Val.addl_assoc. decEq. apply Val.addl_permut.
+- TrivialExists. simpl. 
+  rewrite Val.addl_commut, Val.addl_assoc. f_equal; f_equal. 
+  destruct sp; simpl; auto. rewrite Ptrofs.add_assoc, (Ptrofs.add_commut n2). auto.
+- TrivialExists. simpl.
+  rewrite <- (Val.addl_commut v1), <- (Val.addl_commut (Val.addl v1 (Vlong n2))).
+  rewrite Val.addl_assoc. f_equal; f_equal.
+  destruct sp; simpl; auto. rewrite Ptrofs.add_assoc. auto.
+- replace (Val.addl (Val.addl v1 (Vlong n1)) y)
+     with (Val.addl (Val.addl v1 y) (Vlong n1)).
+  apply eval_addlimm. EvalOp.
+  repeat rewrite Val.addl_assoc. decEq. apply Val.addl_commut.
+- rewrite <- Val.addl_assoc. apply eval_addlimm. EvalOp.
+- rewrite Val.addl_commut. TrivialExists.
+- TrivialExists.
+- rewrite Val.addl_commut. TrivialExists.
+- TrivialExists.
+- rewrite Val.addl_commut. TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_negl: unary_constructor_sound negl (fun v => Val.subl (Vlong Int64.zero) v).
+Proof.
+  red; intros until x; unfold negl. case (negl_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_subl: binary_constructor_sound subl Val.subl.
+Proof.
+  red; intros until y; unfold subl; case (subl_match a b); intros; InvEval; subst.
+- rewrite Val.subl_addl_opp. apply eval_addlimm; auto.
+- rewrite Val.subl_addl_l. rewrite Val.subl_addl_r.
+  rewrite Val.addl_assoc. simpl. rewrite Int64.add_commut. rewrite <- Int64.sub_add_opp.
+  apply eval_addlimm; EvalOp.
+- rewrite Val.subl_addl_l. apply eval_addlimm; EvalOp.
+- rewrite Val.subl_addl_r. apply eval_addlimm; EvalOp.
+- TrivialExists.
+- TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+(** ** Immediate shifts *)
+
+Remark eval_shllimm_base: forall le a n x,
+  eval_expr ge sp e m le a x ->
+  Int.ltu n Int64.iwordsize' = true ->
+  eval_expr ge sp e m le (shllimm_base a n) (Val.shll x (Vint n)).
+Proof.
+Local Opaque mk_amount64.
+  unfold shlimm_base; intros; EvalOp. simpl. rewrite mk_amount64_eq by auto. auto.
+Qed.
+
+Theorem eval_shllimm:
+  forall n, unary_constructor_sound (fun a => shllimm a n)
+                                    (fun x => Val.shll x (Vint n)).
+Proof.
+  red; intros until x; unfold shllimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; [| destruct (Int.ltu n Int64.iwordsize') eqn:L]; simpl.
+- intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int64.shl'_zero; auto.
+- destruct (shllimm_match a); intros; InvEval; subst.
++ TrivialExists. simpl; rewrite L; auto.
++ destruct (Int.ltu (Int.add a n) Int64.iwordsize') eqn:L2.
+* econstructor; split. eapply eval_shllimm_base; eauto.
+  destruct v1; simpl; auto. rewrite a64_range; simpl. rewrite L, L2. 
+  rewrite Int64.shl'_shl'; auto using a64_range.
+* econstructor; split; [|eauto]. apply eval_shllimm_base; auto. EvalOp.
++ TrivialExists. simpl. rewrite mk_amount64_eq; auto.
++ TrivialExists. simpl. rewrite mk_amount64_eq; auto.
++ destruct (Int.ltu (Int.add a n) Int64.iwordsize') eqn:L2.
+* TrivialExists. simpl. rewrite mk_amount64_eq by auto. 
+  destruct (Val.zero_ext_l s v1); simpl; auto.
+  rewrite a64_range; simpl; rewrite L, L2.
+  rewrite Int64.shl'_shl'; auto using a64_range.
+* econstructor; split. eapply eval_shllimm_base; eauto. EvalOp; simpl; eauto. auto.
++ destruct (Int.ltu (Int.add a n) Int64.iwordsize') eqn:L2.
+* TrivialExists. simpl. rewrite mk_amount64_eq by auto. 
+  destruct (Val.sign_ext_l s v1); simpl; auto.
+  rewrite a64_range; simpl; rewrite L, L2.
+  rewrite Int64.shl'_shl'; auto using a64_range.
+* econstructor; split. eapply eval_shllimm_base; eauto. EvalOp; simpl; eauto. auto.
++ destruct (Int.ltu (Int.add a n) Int64.iwordsize') eqn:L2.
+* TrivialExists. simpl. unfold eval_extend. rewrite mk_amount64_eq by auto. 
+  destruct (match x0 with Xsgn32 => Val.longofint v1 | Xuns32 => Val.longofintu v1 end); simpl; auto.
+  rewrite a64_range; simpl; rewrite L, L2.
+  rewrite Int64.shl'_shl'; auto using a64_range.
+* econstructor; split. eapply eval_shllimm_base; eauto. EvalOp; simpl; eauto. auto.
++ econstructor; eauto using eval_shllimm_base.
+- intros; TrivialExists.
+Qed.
+
+Remark eval_shrluimm_base: forall le a n x,
+  eval_expr ge sp e m le a x ->
+  Int.ltu n Int64.iwordsize' = true ->
+  eval_expr ge sp e m le (shrluimm_base a n) (Val.shrlu x (Vint n)).
+Proof.
+  unfold shrluimm_base; intros; EvalOp. simpl. rewrite mk_amount64_eq by auto. auto.
+Qed.
+
+Remark sub_shift_amount:
+  forall y z,
+  Int.ltu y Int64.iwordsize' = true -> Int.ltu z Int64.iwordsize' = true -> Int.unsigned y <= Int.unsigned z ->
+  Int.ltu (Int.sub z y) Int64.iwordsize' = true.
+Proof.
+  intros. unfold Int.ltu; apply zlt_true.
+  apply Int.ltu_inv in H. apply Int.ltu_inv in H0.
+  change (Int.unsigned Int64.iwordsize') with Int64.zwordsize in *.
+  unfold Int.sub; rewrite Int.unsigned_repr. omega.
+  assert (Int64.zwordsize < Int.max_unsigned) by reflexivity. omega.
+Qed.
+
+Theorem eval_shrluimm:
+  forall n, unary_constructor_sound (fun a => shrluimm a n)
+                                    (fun x => Val.shrlu x (Vint n)).
+Proof.
+Local Opaque Int64.zwordsize.
+  red; intros until x; unfold shrluimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; [| destruct (Int.ltu n Int64.iwordsize') eqn:L]; simpl.
+- intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int64.shru'_zero; auto.
+- destruct (shrluimm_match a); intros; InvEval; subst.
++ TrivialExists. simpl; rewrite L; auto.
++ destruct (Int.ltu n a) eqn:L2.
+* assert (L3: Int.ltu (Int.sub a n) Int64.iwordsize' = true).
+  { apply sub_shift_amount; auto using a64_range.
+    apply Int.ltu_inv in L2. omega. }
+  econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite mk_amount64_eq, L3, a64_range by auto.
+  simpl. rewrite L. rewrite Int64.shru'_shl', L2 by auto using a64_range. auto.
+* assert (L3: Int.ltu (Int.sub n a) Int64.iwordsize' = true).
+  { apply sub_shift_amount; auto using a64_range.
+    unfold Int.ltu in L2. destruct zlt in L2; discriminate || omega. }
+  econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite mk_amount64_eq, L3, a64_range by auto.
+  simpl. rewrite L. rewrite Int64.shru'_shl', L2 by auto using a64_range. auto.
++ destruct (Int.ltu (Int.add a n) Int64.iwordsize') eqn:L2.
+* econstructor; split. eapply eval_shrluimm_base; eauto.
+  destruct v1; simpl; auto. rewrite a64_range; simpl. rewrite L, L2. 
+  rewrite Int64.shru'_shru'; auto using a64_range.
+* econstructor; split; [|eauto]. apply eval_shrluimm_base; auto. EvalOp.
++ destruct (zlt (Int.unsigned n) s).
+* econstructor; split. EvalOp. rewrite mk_amount64_eq by auto.
+  destruct v1; simpl; auto. rewrite ! L; simpl.
+  set (s' := s - Int.unsigned n).
+  replace s with (s' + Int.unsigned n) by (unfold s'; omega).
+  rewrite Int64.shru'_zero_ext. auto. unfold s'; omega.
+* econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite ! L; simpl.
+  rewrite Int64.shru'_zero_ext_0 by omega. auto. 
++ econstructor; eauto using eval_shrluimm_base.
+- intros; TrivialExists.
+Qed.
+
+Remark eval_shrlimm_base: forall le a n x,
+  eval_expr ge sp e m le a x ->
+  Int.ltu n Int64.iwordsize' = true ->
+  eval_expr ge sp e m le (shrlimm_base a n) (Val.shrl x (Vint n)).
+Proof.
+  unfold shrlimm_base; intros; EvalOp. simpl. rewrite mk_amount64_eq by auto. auto.
+Qed.
+
+Theorem eval_shrlimm:
+  forall n, unary_constructor_sound (fun a => shrlimm a n)
+                                    (fun x => Val.shrl x (Vint n)).
+Proof.
+  red; intros until x; unfold shrlimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; [| destruct (Int.ltu n Int64.iwordsize') eqn:L]; simpl.
+- intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int64.shr'_zero; auto.
+- destruct (shrlimm_match a); intros; InvEval; subst.
++ TrivialExists. simpl; rewrite L; auto.
++ destruct (Int.ltu n a) eqn:L2.
+* assert (L3: Int.ltu (Int.sub a n) Int64.iwordsize' = true).
+  { apply sub_shift_amount; auto using a64_range.
+    apply Int.ltu_inv in L2. omega. }
+  econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite mk_amount64_eq, L3, a64_range by auto.
+  simpl. rewrite L. rewrite Int64.shr'_shl', L2 by auto using a64_range. auto.
+* assert (L3: Int.ltu (Int.sub n a) Int64.iwordsize' = true).
+  { apply sub_shift_amount; auto using a64_range.
+    unfold Int.ltu in L2. destruct zlt in L2; discriminate || omega. }
+  econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite mk_amount64_eq, L3, a64_range by auto.
+  simpl. rewrite L. rewrite Int64.shr'_shl', L2 by auto using a64_range. auto.
++ destruct (Int.ltu (Int.add a n) Int64.iwordsize') eqn:L2.
+* econstructor; split. eapply eval_shrlimm_base; eauto.
+  destruct v1; simpl; auto. rewrite a64_range; simpl. rewrite L, L2. 
+  rewrite Int64.shr'_shr'; auto using a64_range.
+* econstructor; split; [|eauto]. apply eval_shrlimm_base; auto. EvalOp.
++ destruct (zlt (Int.unsigned n) s && zlt s Int64.zwordsize) eqn:E.
+* InvBooleans. econstructor; split. EvalOp. rewrite mk_amount64_eq by auto.
+  destruct v1; simpl; auto. rewrite ! L; simpl.
+  set (s' := s - Int.unsigned n).
+  replace s with (s' + Int.unsigned n) by (unfold s'; omega).
+  rewrite Int64.shr'_sign_ext. auto. unfold s'; omega. unfold s'; omega.
+* econstructor; split; [|eauto]. apply eval_shrlimm_base; auto. EvalOp.
++ econstructor; eauto using eval_shrlimm_base.
+- intros; TrivialExists.
+Qed.
+
+(** ** Multiplication *)
+
+Lemma eval_mullimm_base:
+  forall n, unary_constructor_sound (mullimm_base n) (fun x => Val.mull x (Vlong n)).
+Proof.
+  intros; red; intros; unfold mullimm_base.
+  assert (DFL: exists v, eval_expr ge sp e m le (Eop Omull (Eop (Olongconst n) Enil ::: a ::: Enil)) v /\ Val.lessdef (Val.mull x (Vlong n)) v).
+  { rewrite Val.mull_commut; TrivialExists. } 
+  generalize (Int64.one_bits'_decomp n); generalize (Int64.one_bits'_range n);
+  destruct (Int64.one_bits' n) as [ | i [ | j []]]; intros P Q.
+- apply DFL.
+- replace (Val.mull x (Vlong n)) with (Val.shll x (Vint i)).
+  apply eval_shllimm; auto.
+  simpl in Q. destruct x; auto; simpl. rewrite P by auto with coqlib.
+  rewrite Q, Int64.add_zero, Int64.shl'_mul. auto.
+- exploit (eval_shllimm i (x :: le) (Eletvar 0) x). constructor; auto. intros [v1 [A1 B1]].
+  exploit (eval_shllimm j (x :: le) (Eletvar 0) x). constructor; auto. intros [v2 [A2 B2]].
+  exploit (eval_addl (x :: le)). eexact A1. eexact A2. intros [v [A B]].
+  exists v; split. econstructor; eauto.
+  simpl in Q. rewrite Q, Int64.add_zero. eapply Val.lessdef_trans; [|eexact B].
+  eapply Val.lessdef_trans; [|eapply Val.addl_lessdef; eauto].
+  destruct x; simpl; auto; rewrite ! P by auto with coqlib.
+  rewrite Int64.mul_add_distr_r, <- ! Int64.shl'_mul. auto.
+- apply DFL.
+Qed.
+
+Theorem eval_mullimm:
+  forall n, unary_constructor_sound (mullimm n) (fun x => Val.mull x (Vlong n)).
+Proof.
+  intros; red; intros until x; unfold mullimm.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero.
+  intros. exists (Vlong Int64.zero); split. EvalOp.
+  destruct x; simpl; auto. subst n. rewrite Int64.mul_zero. auto.
+  predSpec Int64.eq Int64.eq_spec n Int64.one.
+  intros. exists x; split; auto.
+  destruct x; simpl; auto. subst n. rewrite Int64.mul_one. auto.
+  case (mullimm_match a); intros; InvEval; subst.
+- TrivialExists. simpl. rewrite Int64.mul_commut; auto.
+- rewrite Val.mull_addl_distr_l.
+  exploit eval_mullimm_base; eauto. instantiate (1 := n). intros [v' [A1 B1]].
+  exploit (eval_addlimm (Int64.mul n n2) le (mullimm_base n t2) v'). auto. intros [v'' [A2 B2]].
+  exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.addl_lessdef; eauto.
+  rewrite Val.mull_commut; auto.
+- apply eval_mullimm_base; auto.
+Qed.
+
+Theorem eval_mull: binary_constructor_sound mull Val.mull.
+Proof.
+  red; intros until y; unfold mull; case (mull_match a b); intros; InvEval; subst.
+- rewrite Val.mull_commut. apply eval_mullimm; auto.
+- apply eval_mullimm; auto.
+- TrivialExists.
+Qed.
+
+Theorem eval_mullhu: 
+  forall n, unary_constructor_sound (fun a => mullhu a n) (fun v => Val.mullhu v (Vlong n)).
+Proof.
+  unfold mullhu; red; intros; TrivialExists.
+Qed.
+
+Theorem eval_mullhs: 
+  forall n, unary_constructor_sound (fun a => mullhs a n) (fun v => Val.mullhs v (Vlong n)).
+Proof.
+  unfold mullhs; red; intros; TrivialExists.
+Qed.
+
+(** Integer conversions *)
+
+Theorem eval_zero_ext_l:
+  forall sz, 0 <= sz -> unary_constructor_sound (zero_ext_l sz) (Val.zero_ext_l sz).
+Proof.
+  intros; red; intros until x; unfold zero_ext_l; case (zero_ext_l_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists.
+- destruct (zlt (Int.unsigned a0) sz).
++ econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite a64_range; simpl.
+  apply Val.lessdef_same. f_equal. rewrite Int64.shl'_zero_ext by omega. f_equal. omega.
++ TrivialExists.
+- TrivialExists.
+Qed.
+
+(** Bitwise not, and, or, xor *)
+
+Theorem eval_notl: unary_constructor_sound notl Val.notl.
+Proof.
+  assert (INV: forall v, Val.lessdef (Val.notl (Val.notl v)) v).
+  { destruct v; auto. simpl; rewrite Int64.not_involutive; auto. } 
+  unfold notl; red; intros until x; case (notl_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists.
+- exists v1; auto.
+- exists (eval_shiftl s v1 a0); split; auto. EvalOp.
+- econstructor; split. EvalOp. 
+  destruct v1; simpl; auto; destruct v0; simpl; auto.
+  rewrite Int64.not_and_or_not, Int64.not_involutive, Int64.or_commut. auto.
+- econstructor; split. EvalOp. 
+  destruct v1; simpl; auto; destruct v0; simpl; auto.
+  rewrite Int64.not_or_and_not, Int64.not_involutive, Int64.and_commut. auto.
+- econstructor; split. EvalOp.
+  destruct v1; simpl; auto; destruct v0; simpl; auto.
+  unfold Int64.not; rewrite ! Int64.xor_assoc. auto.
+- econstructor; split. EvalOp.
+  destruct v1; simpl; auto; destruct v0; simpl; auto.
+  unfold Int64.not; rewrite ! Int64.xor_assoc, Int64.xor_idem, Int64.xor_zero. auto.
+- TrivialExists.
+Qed.
+
+Lemma eval_andlimm_base:
+  forall n, unary_constructor_sound (andlimm_base n) (fun x => Val.andl x (Vlong n)).
+Proof.
+  intros; red; intros. unfold andlimm_base.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero.
+  exists (Vlong Int64.zero); split. EvalOp.
+  destruct x; simpl; auto. subst n. rewrite Int64.and_zero. auto.
+  predSpec Int64.eq Int64.eq_spec n Int64.mone.
+  exists x; split; auto.
+  subst. destruct x; simpl; auto. rewrite Int64.and_mone; auto.
+  destruct (Z_is_power2m1 (Int64.unsigned n)) as [s|] eqn:P.
+  assert (0 <= s) by (eapply Z_is_power2m1_nonneg; eauto).
+  rewrite <- (Int64.repr_unsigned n), (Z_is_power2m1_sound _ _ P), <- Val.zero_ext_andl by auto.
+  apply eval_zero_ext_l; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_andlimm:
+  forall n, unary_constructor_sound (andlimm n) (fun x => Val.andl x (Vlong n)).
+Proof.
+  intros; red; intros until x. unfold andlimm.
+  case (andlimm_match a); intros; InvEval; subst.
+- rewrite Int64.and_commut; TrivialExists.
+- rewrite Val.andl_assoc, Int64.and_commut. apply eval_andlimm_base; auto.
+- destruct (zle 0 s).
++ replace (Val.zero_ext_l s v1) with (Val.andl v1 (Vlong (Int64.repr (two_p s - 1)))).
+  rewrite Val.andl_assoc, Int64.and_commut.
+  apply eval_andlimm_base; auto.
+  destruct v1; simpl; auto. rewrite Int64.zero_ext_and by auto. auto. 
++ apply eval_andlimm_base. EvalOp.
+- apply eval_andlimm_base; auto.
+Qed.
+
+Theorem eval_andl: binary_constructor_sound andl Val.andl.
+Proof.
+  red; intros until y; unfold andl; case (andl_match a b); intros; InvEval; subst.
+- rewrite Val.andl_commut; apply eval_andlimm; auto.
+- apply eval_andlimm; auto.
+- rewrite Val.andl_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.andl_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.andl_commut; TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_orlimm:
+  forall n, unary_constructor_sound (orlimm n) (fun x => Val.orl x (Vlong n)).
+Proof.
+  intros; red; intros until x. unfold orlimm.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero.
+  intros. subst. exists x; split; auto.
+  destruct x; simpl; auto. rewrite Int64.or_zero; auto.
+  predSpec Int64.eq Int64.eq_spec n Int64.mone.
+  intros. exists (Vlong Int64.mone); split. EvalOp.
+  destruct x; simpl; auto. subst n. rewrite Int64.or_mone. auto.
+  destruct (orlimm_match a); intros; InvEval; subst.
+- rewrite Int64.or_commut; TrivialExists.
+- rewrite Val.orl_assoc, Int64.or_commut; TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_orl: binary_constructor_sound orl Val.orl.
+Proof.
+  red; intros until y; unfold orl; case (orl_match a b); intros; InvEval; subst.
+- rewrite Val.orl_commut. apply eval_orlimm; auto.
+- apply eval_orlimm; auto.
+- rewrite Val.orl_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.orl_commut; TrivialExists.
+- TrivialExists.
+- (* shl - shru *)
+  destruct (Int.eq (Int.add a1 a2) Int64.iwordsize' && same_expr_pure t1 t2) eqn:?.
++ InvBooleans. apply Int.same_if_eq in H.
+  exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst.
+  econstructor; split. EvalOp.
+  destruct v0; simpl; auto. rewrite ! a64_range. simpl. rewrite <- Int64.or_ror'; auto using a64_range.
++ TrivialExists.
+- (* shru - shl *)
+  destruct (Int.eq (Int.add a2 a1) Int64.iwordsize' && same_expr_pure t1 t2) eqn:?.
++ InvBooleans. apply Int.same_if_eq in H.
+  exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst.
+  econstructor; split. EvalOp.
+  destruct v0; simpl; auto. rewrite ! a64_range. simpl.
+  rewrite Int64.or_commut, <- Int64.or_ror'; auto using a64_range.
++ TrivialExists.
+- rewrite Val.orl_commut; TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Lemma eval_xorlimm_base:
+  forall n, unary_constructor_sound (xorlimm_base n) (fun x => Val.xorl x (Vlong n)).
+Proof.
+  intros; red; intros. unfold xorlimm_base.
+  predSpec Int64.eq Int64.eq_spec n Int64.zero.
+  intros. exists x; split. auto.
+  destruct x; simpl; auto. subst n. rewrite Int64.xor_zero. auto.
+  predSpec Int64.eq Int64.eq_spec n Int64.mone.
+  subst n. change (Val.xorl x (Vlong Int64.mone)) with (Val.notl x). apply eval_notl; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_xorlimm:
+  forall n, unary_constructor_sound (xorlimm n) (fun x => Val.xorl x (Vlong n)).
+Proof.
+  intros; red; intros until x. unfold xorlimm.
+  destruct (xorlimm_match a); intros; InvEval; subst.
+- rewrite Int64.xor_commut; TrivialExists.
+- rewrite Val.xorl_assoc; simpl. rewrite (Int64.xor_commut n2). apply eval_xorlimm_base; auto.
+- apply eval_xorlimm_base; auto.
+Qed.
+
+Theorem eval_xorl: binary_constructor_sound xorl Val.xorl.
+Proof.
+  red; intros until y; unfold xorl; case (xorl_match a b); intros; InvEval; subst.
+- rewrite Val.xorl_commut; apply eval_xorlimm; auto.
+- apply eval_xorlimm; auto.
+- rewrite Val.xorl_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.xorl_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.xorl_commut; TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+(** ** Integer division and modulus *)
+
+Theorem eval_divls_base: partial_binary_constructor_sound divls_base Val.divls.
+Proof.
+  red; intros; unfold divls_base; TrivialExists.
+Qed.
+
+Theorem eval_modls_base: partial_binary_constructor_sound modls_base Val.modls.
+Proof.
+  red; intros; unfold modls_base, modl_aux.
+  exploit Val.modls_divls; eauto. intros (q & A & B). subst z.
+  TrivialExists. repeat (econstructor; eauto with evalexpr). exact A.
+Qed.
+
+Theorem eval_divlu_base: partial_binary_constructor_sound divlu_base Val.divlu.
+Proof.
+  red; intros; unfold divlu_base; TrivialExists.
+Qed.
+
+Theorem eval_modlu_base: partial_binary_constructor_sound modlu_base Val.modlu.
+Proof.
+  red; intros; unfold modlu_base, modl_aux.
+  exploit Val.modlu_divlu; eauto. intros (q & A & B). subst z.
+  TrivialExists. repeat (econstructor; eauto with evalexpr). exact A.
+Qed.
+
+Theorem eval_shrxlimm:
+  forall le a n x z,
+  eval_expr ge sp e m le a x ->
+  Val.shrxl x (Vint n) = Some z ->
+  exists v, eval_expr ge sp e m le (shrxlimm a n) v /\ Val.lessdef z v.
+Proof.
+  intros; unfold shrxlimm. 
+  predSpec Int.eq Int.eq_spec n Int.zero.
+- subst n. exists x; split; auto.
+  destruct x; simpl in H0; try discriminate.
+  change (Int.ltu Int.zero (Int.repr 63)) with true in H0; inv H0.
+  rewrite Int64.shrx'_zero. auto.
+- TrivialExists.
+Qed.
+
+(** General shifts *)
+
+Theorem eval_shll: binary_constructor_sound shll Val.shll.
+Proof.
+  red; intros until y; unfold shll; case (shll_match b); intros.
+  InvEval. apply eval_shllimm; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_shrl: binary_constructor_sound shrl Val.shrl.
+Proof.
+  red; intros until y; unfold shrl; case (shrl_match b); intros.
+  InvEval. apply eval_shrlimm; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_shrlu: binary_constructor_sound shrlu Val.shrlu.
+Proof.
+  red; intros until y; unfold shrlu; case (shrlu_match b); intros.
+  InvEval. apply eval_shrluimm; auto.
+  TrivialExists.
+Qed.
+
+(** Comparisons *)
+
+Remark option_map_of_bool_inv: forall ov w,
+  option_map Val.of_bool ov = Some w -> Val.of_optbool ov = w.
+Proof.
+  intros. destruct ov; inv H; auto.
+Qed.
+
+Section COMP_IMM.
+
+Variable default: comparison -> int64 -> condition.
+Variable intsem: comparison -> int64 -> int64 -> bool.
+Variable sem: comparison -> val -> val -> option val.
+
+Hypothesis sem_int: forall c x y, 
+  sem c (Vlong x) (Vlong y) = Some (Val.of_bool (intsem c x y)).
+Hypothesis sem_undef: forall c v,
+  sem c Vundef v = None.
+Hypothesis sem_eq: forall x y,
+  sem Ceq (Vlong x) (Vlong y) = Some (Val.of_bool (Int64.eq x y)).
+Hypothesis sem_ne: forall x y,
+  sem Cne (Vlong x) (Vlong y) = Some (Val.of_bool (negb (Int64.eq x y))).
+Hypothesis sem_default: forall c v n,
+  sem c v (Vlong n) = option_map Val.of_bool (eval_condition (default c n) (v :: nil) m).
+
+Lemma eval_complimm_default: forall le a x c n2 v,
+  sem c x (Vlong n2) = Some v ->
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le (Eop (Ocmp (default c n2)) (a:::Enil)) v.
+Proof.
+  intros. EvalOp. simpl. rewrite sem_default in H. apply option_map_of_bool_inv in H.
+  congruence.
+Qed.
+
+Lemma eval_complimm:
+  forall le c a n2 x v,
+  eval_expr ge sp e m le a x ->
+  sem c x (Vlong n2) = Some v ->
+  eval_expr ge sp e m le (complimm default intsem c a n2) v.
+Proof.
+  intros until x; unfold complimm; case (complimm_match c a); intros; InvEval; subst.
+- (* constant *)
+  rewrite sem_int in H0; inv H0. EvalOp. destruct (intsem c0 n1 n2); auto.
+- (* mask zero *)
+  predSpec Int64.eq Int64.eq_spec n2 Int64.zero.
++ subst n2. destruct v1; simpl in H0; rewrite ? sem_undef, ? sem_eq in H0; inv H0.
+  EvalOp.
++ eapply eval_complimm_default; eauto. EvalOp. 
+- (* mask not zero *)
+  predSpec Int64.eq Int64.eq_spec n2 Int64.zero.
++ subst n2. destruct v1; simpl in H0; rewrite ? sem_undef, ? sem_ne in H0; inv H0.
+  EvalOp.
++ eapply eval_complimm_default; eauto. EvalOp.
+- (* default *)
+  eapply eval_complimm_default; eauto.
+Qed.
+
+Hypothesis sem_swap:
+  forall c x y, sem (swap_comparison c) x y = sem c y x.
+
+Lemma eval_complimm_swap:
+  forall le c a n2 x v,
+  eval_expr ge sp e m le a x ->
+  sem c (Vlong n2) x = Some v ->
+  eval_expr ge sp e m le (complimm default intsem (swap_comparison c) a n2) v.
+Proof.
+  intros. eapply eval_complimm; eauto. rewrite sem_swap; auto.
+Qed.
+
+End COMP_IMM.
+
+Theorem eval_cmpl:
+  forall c le a x b y v,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.cmpl c x y = Some v ->
+  eval_expr ge sp e m le (cmpl c a b) v.
+Proof.
+  intros until y; unfold cmpl; case (cmpl_match a b); intros; InvEval; subst.
+- apply eval_complimm_swap with (sem := Val.cmpl) (x := y); auto.
+  intros; unfold Val.cmpl; rewrite Val.swap_cmpl_bool; auto. 
+- apply eval_complimm with (sem := Val.cmpl) (x := x); auto.
+- EvalOp. simpl. rewrite Val.swap_cmpl_bool. apply option_map_of_bool_inv in H1. congruence.
+- EvalOp. simpl. apply option_map_of_bool_inv in H1. congruence.
+- EvalOp. simpl. apply option_map_of_bool_inv in H1. congruence.
+Qed.
+
+Theorem eval_cmplu:
+  forall c le a x b y v,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.cmplu (Mem.valid_pointer m) c x y = Some v ->
+  eval_expr ge sp e m le (cmplu c a b) v.
+Proof.
+  intros until y; unfold cmplu; case (cmplu_match a b); intros; InvEval; subst.
+- apply eval_complimm_swap with (sem := Val.cmplu (Mem.valid_pointer m)) (x := y); auto.
+  intros; unfold Val.cmplu; rewrite Val.swap_cmplu_bool; auto. 
+- apply eval_complimm with (sem := Val.cmplu (Mem.valid_pointer m)) (x := x); auto.
+- EvalOp. simpl. rewrite Val.swap_cmplu_bool. apply option_map_of_bool_inv in H1. congruence.
+- EvalOp. simpl. apply option_map_of_bool_inv in H1. congruence.
+- EvalOp. simpl. apply option_map_of_bool_inv in H1. congruence.
+Qed.
+
+
+(** Floating-point conversions *)
+
+Theorem eval_longoffloat: partial_unary_constructor_sound longoffloat Val.longoffloat.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_longuoffloat: partial_unary_constructor_sound longuoffloat Val.longuoffloat.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_floatoflong: partial_unary_constructor_sound floatoflong Val.floatoflong.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_floatoflongu: partial_unary_constructor_sound floatoflongu Val.floatoflongu.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_longofsingle: partial_unary_constructor_sound longofsingle Val.longofsingle.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_longuofsingle: partial_unary_constructor_sound longuofsingle Val.longuofsingle.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_singleoflong: partial_unary_constructor_sound singleoflong Val.singleoflong.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_singleoflongu: partial_unary_constructor_sound singleoflongu Val.singleoflongu.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+End CMCONSTR.
diff --git a/aarch64/SelectOp.vp b/aarch64/SelectOp.vp
new file mode 100644
index 00000000..5bd96987
--- /dev/null
+++ b/aarch64/SelectOp.vp
@@ -0,0 +1,566 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Instruction selection for operators *)
+
+Require Import Coqlib Zbits.
+Require Import Compopts AST Integers Floats Builtins.
+Require Import Op CminorSel.
+
+Local Open Scope cminorsel_scope.
+
+(** "ror" shifted operands are not supported by arithmetic operations *)
+
+Definition arith_shift (s: shift) :=
+  match s with Sror => false | _ => true end.
+
+(** ** Constants **)
+
+Definition addrsymbol (id: ident) (ofs: ptrofs) :=
+  Eop (Oaddrsymbol id ofs) Enil.
+
+Definition addrstack (ofs: ptrofs) :=
+  Eop (Oaddrstack ofs) Enil.
+
+(** ** Integer addition *)
+
+Nondetfunction addimm (n: int) (e: expr) :=
+  if Int.eq n Int.zero then e else
+  match e with
+  | Eop (Ointconst m) Enil => Eop (Ointconst (Int.add n m)) Enil
+  | Eop (Oaddimm m) (t ::: Enil) => Eop (Oaddimm(Int.add n m)) (t ::: Enil)
+  | _ => Eop (Oaddimm n) (e ::: Enil)
+  end.
+
+Nondetfunction add (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => addimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => addimm n2 t1
+  | Eop (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 (Oaddimm n2) (t2:::Enil) =>
+      addimm n2 (Eop Oadd (t1:::t2:::Enil))
+  | Eop (Oshift s a) (t1:::Enil), t2 ?? arith_shift s =>
+      Eop (Oaddshift s a) (t2 ::: t1 ::: Enil)
+  | t1, Eop (Oshift s a) (t2:::Enil) ?? arith_shift s =>
+      Eop (Oaddshift s a) (t1 ::: t2 ::: Enil)
+  | Eop Omul (t1:::t2:::Enil), t3 =>
+      Eop Omuladd (t3:::t1:::t2:::Enil)
+  | t1, Eop Omul (t2:::t3:::Enil) =>
+      Eop Omuladd (t1:::t2:::t3:::Enil)
+  | _, _ => Eop Oadd (e1:::e2:::Enil)
+  end.
+
+(** ** Opposite *)
+
+Nondetfunction negint (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => Eop (Ointconst (Int.neg n)) Enil
+  | Eop (Oshift s a) (t1:::Enil) ?? arith_shift s => Eop (Onegshift s a) (t1:::Enil)
+  | _ =>  Eop Oneg (e ::: Enil)
+  end.
+
+(** ** Integer and pointer subtraction *)
+
+Nondetfunction sub (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | t1, Eop (Ointconst n2) Enil =>
+      addimm (Int.neg n2) t1
+  | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) =>
+      addimm (Int.sub n1 n2) (Eop Osub (t1:::t2:::Enil))
+  | Eop (Oaddimm n1) (t1:::Enil), t2 =>
+      addimm n1 (Eop Osub (t1:::t2:::Enil))
+  | t1, Eop (Oaddimm n2) (t2:::Enil) =>
+      addimm (Int.neg n2) (Eop Osub (t1:::t2:::Enil))
+  | t1, Eop (Oshift s a) (t2:::Enil) ?? arith_shift s =>
+      Eop (Osubshift s a) (t1:::t2::: Enil)
+  | t1, Eop Omul (t2:::t3:::Enil) =>
+      Eop Omulsub (t1:::t2:::t3:::Enil)
+  | _, _ => Eop Osub (e1:::e2:::Enil)
+  end.
+
+(** ** Immediate shift left *)
+
+Definition shlimm_base (e1: expr) (n: int) :=
+  Eop (Oshift Slsl (mk_amount32 n)) (e1 ::: Enil).
+
+Nondetfunction shlimm (e1: expr) (n: int) :=
+  if Int.eq n Int.zero then
+    e1
+  else if negb (Int.ltu n Int.iwordsize) then
+    Eop Oshl (e1 ::: Eop (Ointconst n) Enil ::: Enil)
+  else match e1 with
+    | Eop (Ointconst n1) Enil =>
+        Eop (Ointconst (Int.shl n1 n)) Enil
+    | Eop (Oshift Slsl a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int.iwordsize
+        then shlimm_base t1 (Int.add a n)
+        else shlimm_base e1 n
+    | Eop (Ozext s) (t1:::Enil) =>
+        Eop (Oshlzext s (mk_amount32 n)) (t1:::Enil)
+    | Eop (Osext s) (t1:::Enil) =>
+        Eop (Oshlsext s (mk_amount32 n)) (t1:::Enil)
+    | Eop (Oshlzext s a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int.iwordsize
+        then Eop (Oshlzext s (mk_amount32 (Int.add a n))) (t1:::Enil)
+        else shlimm_base e1 n
+    | Eop (Oshlsext s a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int.iwordsize
+        then Eop (Oshlsext s (mk_amount32 (Int.add a n))) (t1:::Enil)
+        else shlimm_base e1 n
+    | _ =>
+        shlimm_base e1 n
+  end.
+
+(** ** Immediate shift right (logical) *)
+
+Definition shruimm_base (e1: expr) (n: int) :=
+  Eop (Oshift Slsr (mk_amount32 n)) (e1 ::: Enil).
+
+Nondetfunction shruimm (e1: expr) (n: int) :=
+  if Int.eq n Int.zero then
+    e1
+  else if negb (Int.ltu n Int.iwordsize) then
+    Eop Oshru (e1 ::: Eop (Ointconst n) Enil ::: Enil)
+  else match e1 with
+    | Eop (Ointconst n1) Enil =>
+        Eop (Ointconst (Int.shru n1 n)) Enil
+    | Eop (Oshift Slsl a) (t1:::Enil) =>
+        if Int.ltu n a
+        then Eop (Oshlzext (Int.zwordsize - Int.unsigned a) (mk_amount32 (Int.sub a n))) (t1:::Enil)
+        else Eop (Ozextshr (mk_amount32 (Int.sub n a)) (Int.zwordsize - Int.unsigned n)) (t1:::Enil)
+    | Eop (Oshift Slsr a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int.iwordsize
+        then shruimm_base t1 (Int.add a n)
+        else shruimm_base e1 n
+    | Eop (Ozext s) (t1:::Enil) =>
+        if zlt (Int.unsigned n) s
+        then Eop (Ozextshr (mk_amount32 n) (s - Int.unsigned n)) (t1:::Enil)
+        else Eop (Ointconst Int.zero) Enil
+    | _ =>
+        shruimm_base e1 n
+    end.
+
+(** ** Immediate shift right (arithmetic) *)
+
+Definition shrimm_base (e1: expr) (n: int) :=
+  Eop (Oshift Sasr (mk_amount32 n)) (e1 ::: Enil).
+
+Nondetfunction shrimm (e1: expr) (n: int) :=
+  if Int.eq n Int.zero then
+    e1
+  else if negb (Int.ltu n Int.iwordsize) then
+    Eop Oshr (e1 ::: Eop (Ointconst n) Enil ::: Enil)
+  else match e1 with
+    | Eop (Ointconst n1) Enil =>
+        Eop (Ointconst (Int.shr n1 n)) Enil
+    | Eop (Oshift Slsl a) (t1:::Enil) =>
+        if Int.ltu n a
+        then Eop (Oshlsext (Int.zwordsize - Int.unsigned a) (mk_amount32 (Int.sub a n))) (t1:::Enil)
+        else Eop (Osextshr (mk_amount32 (Int.sub n a)) (Int.zwordsize - Int.unsigned n)) (t1:::Enil)
+    | Eop (Oshift Sasr a) (t1:::Enil) =>
+        if Int.ltu (Int.add a n) Int.iwordsize
+        then shrimm_base t1 (Int.add a n)
+        else shrimm_base e1 n
+    | Eop (Osext s) (t1:::Enil) =>
+        if zlt (Int.unsigned n) s && zlt s Int.zwordsize
+        then Eop (Osextshr (mk_amount32 n) (s - Int.unsigned n)) (t1:::Enil)
+        else shrimm_base e1 n
+    | _ =>
+        shrimm_base e1 n
+    end.
+
+(** ** Integer multiply *)
+
+Definition mulimm_base (n1: int) (e2: expr) :=
+  match Int.one_bits n1 with
+  | i :: nil =>
+      shlimm e2 i
+  | i :: j :: nil =>
+      Elet e2 (add (shlimm (Eletvar 0) i) (shlimm (Eletvar 0) j))
+  | _ =>
+      Eop Omul (Eop (Ointconst n1) Enil ::: e2 ::: Enil)
+  end.
+
+Nondetfunction mulimm (n1: int) (e2: expr) :=
+  if Int.eq n1 Int.zero then Eop (Ointconst Int.zero) Enil
+  else if Int.eq n1 Int.one then e2
+  else match e2 with
+  | Eop (Ointconst n2) Enil => Eop (Ointconst (Int.mul n1 n2)) Enil
+  | Eop (Oaddimm n2) (t2:::Enil) => addimm (Int.mul n1 n2) (mulimm_base n1 t2)
+  | _ => mulimm_base n1 e2
+  end.
+
+Nondetfunction mul (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => mulimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => mulimm n2 t1
+  | _, _ => Eop Omul (e1:::e2:::Enil)
+  end.
+
+Definition mulhs (e1: expr) (e2: expr) :=
+  Eop Olowlong
+    (Eop (Oshiftl Sasr (mk_amount64 (Int.repr 32)))
+       (Eop Omull (Eop (Oextend Xsgn32 (mk_amount64 Int.zero)) (e1 ::: Enil) :::
+                   Eop (Oextend Xsgn32 (mk_amount64 Int.zero)) (e2 ::: Enil) ::: Enil) ::: Enil)
+        ::: Enil).
+
+Definition mulhu (e1: expr) (e2: expr) :=
+  Eop Olowlong
+    (Eop (Oshiftl Slsr (mk_amount64 (Int.repr 32)))
+       (Eop Omull (Eop (Oextend Xuns32 (mk_amount64 Int.zero)) (e1 ::: Enil) :::
+                   Eop (Oextend Xuns32 (mk_amount64 Int.zero)) (e2 ::: Enil) ::: Enil) ::: Enil)
+        ::: Enil).
+
+(** ** Integer conversions *)
+
+Nondetfunction zero_ext (sz: Z) (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => Eop (Ointconst (Int.zero_ext sz n)) Enil
+  | Eop (Oshift Slsr a) (t1:::Enil) => Eop (Ozextshr a sz) (t1:::Enil)
+  | Eop (Oshift Slsl a) (t1:::Enil) =>
+      if zlt (Int.unsigned a) sz
+      then Eop (Oshlzext (sz - Int.unsigned a) a) (t1:::Enil)
+      else Eop (Ozext sz) (e:::Enil)
+  | _ => Eop (Ozext sz) (e:::Enil)
+  end.
+
+Nondetfunction sign_ext (sz: Z) (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => Eop (Ointconst (Int.sign_ext sz n)) Enil
+  | Eop (Oshift Sasr a) (t1:::Enil) => Eop (Osextshr a sz) (t1:::Enil)
+  | Eop (Oshift Slsl a) (t1:::Enil) =>
+      if zlt (Int.unsigned a) sz
+      then Eop (Oshlsext (sz - Int.unsigned a) a) (t1:::Enil)
+      else Eop (Osext sz) (e:::Enil)
+  | _ => Eop (Osext sz) (e:::Enil)
+  end.
+
+Definition cast8unsigned (e: expr) := zero_ext 8 e.
+Definition cast8signed (e: expr) := sign_ext 8 e.
+Definition cast16unsigned (e: expr) := zero_ext 16 e.
+Definition cast16signed (e: expr) := sign_ext 16 e.
+
+(** ** Bitwise not *)
+
+Nondetfunction notint (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => Eop (Ointconst (Int.not n)) Enil
+  | Eop (Oshift s a) (t1:::Enil) => Eop (Onotshift s a) (t1:::Enil)
+  | Eop Onot (t1:::Enil) => t1
+  | Eop (Onotshift s a) (t1:::Enil) => Eop (Oshift s a) (t1:::Enil)
+  | Eop Obic (t1:::t2:::Enil) => Eop Oorn (t2:::t1:::Enil)
+  | Eop Oorn (t1:::t2:::Enil) => Eop Obic (t2:::t1:::Enil)
+  | Eop Oxor (t1:::t2:::Enil) => Eop Oeqv (t1:::t2:::Enil)
+  | Eop Oeqv (t1:::t2:::Enil) => Eop Oxor (t1:::t2:::Enil)
+  | _ => Eop Onot (e:::Enil)
+  end.
+
+(** ** Bitwise and *)
+
+Definition andimm_base (n1: int) (e2: expr) :=
+  if Int.eq n1 Int.zero then Eop (Ointconst Int.zero) Enil else
+  if Int.eq n1 Int.mone then e2 else
+  match Z_is_power2m1 (Int.unsigned n1) with
+  | Some s => zero_ext s e2
+  | None => Eop (Oandimm n1) (e2 ::: Enil)
+  end.
+
+Nondetfunction andimm (n1: int) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => Eop (Ointconst (Int.and n1 n2)) Enil
+  | Eop (Oandimm n2) (t2:::Enil) => andimm_base (Int.and n1 n2) t2
+  | Eop (Ozext s) (t2:::Enil) =>
+      if zle 0 s
+      then andimm_base (Int.and n1 (Int.repr (two_p s - 1))) t2
+      else andimm_base n1 e2
+  | _ => andimm_base n1 e2
+  end.
+
+Nondetfunction and (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => andimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => andimm n2 t1
+  | Eop Onot (t1:::Enil), t2 => Eop Obic (t2:::t1:::Enil)
+  | t1, Eop Onot (t2:::Enil) => Eop Obic (t1:::t2:::Enil)
+  | Eop (Onotshift s a) (t1:::Enil), t2 => Eop (Obicshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Onotshift s a) (t2:::Enil) => Eop (Obicshift s a) (t1:::t2:::Enil)
+  | Eop (Oshift s a) (t1:::Enil), t2 => Eop (Oandshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Oshift s a) (t2:::Enil) => Eop (Oandshift s a) (t1:::t2:::Enil)
+  | _, _ => Eop Oand (e1:::e2:::Enil)
+  end.
+
+(** ** Bitwise or *)
+
+Nondetfunction orimm (n1: int) (e2: expr) :=
+  if Int.eq n1 Int.zero then e2
+  else if Int.eq n1 Int.mone then Eop (Ointconst Int.mone) Enil
+  else match e2 with
+  | Eop (Ointconst n2) Enil => Eop (Ointconst (Int.or n1 n2)) Enil
+  | Eop (Oorimm n2) (t2:::Enil) => Eop (Oorimm (Int.or n1 n2)) (t2:::Enil)
+  | _ => Eop (Oorimm n1) (e2:::Enil)
+  end.
+
+Definition same_expr_pure (e1 e2: expr) :=
+  match e1, e2 with
+  | Evar v1, Evar v2 => if ident_eq v1 v2 then true else false
+  | _, _ => false
+  end.
+
+Nondetfunction or (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => orimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => orimm n2 t1
+  | Eop Onot (t1:::Enil), t2 => Eop Oorn (t2:::t1:::Enil)
+  | t1, Eop Onot (t2:::Enil) => Eop Oorn (t1:::t2:::Enil)
+  | Eop (Onotshift s a) (t1:::Enil), t2 => Eop (Oornshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Onotshift s a) (t2:::Enil) => Eop (Oornshift s a) (t1:::t2:::Enil)
+  | Eop (Oshift Slsl a1) (t1:::Enil), Eop (Oshift Slsr a2) (t2:::Enil) =>
+      if Int.eq (Int.add a1 a2) Int.iwordsize && same_expr_pure t1 t2
+      then Eop (Oshift Sror a2) (t2:::Enil)
+      else Eop (Oorshift Slsr a2) (Eop (Oshift Slsl a1) (t1:::Enil):::t2:::Enil)
+  | Eop (Oshift Slsr a1) (t1:::Enil), Eop (Oshift Slsl a2) (t2:::Enil) =>
+      if Int.eq (Int.add a2 a1) Int.iwordsize && same_expr_pure t1 t2
+      then Eop (Oshift Sror a1) (t1:::Enil)
+      else Eop (Oorshift Slsl a2) (Eop (Oshift Slsr a1) (t1:::Enil):::t2:::Enil)
+  | Eop (Oshift s a) (t1:::Enil), t2 => Eop (Oorshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Oshift s a) (t2:::Enil) => Eop (Oorshift s a) (t1:::t2:::Enil)
+  | _, _ => Eop Oor (e1:::e2:::Enil)
+  end.
+
+(** ** Bitwise xor *)
+
+Definition xorimm_base (n1: int) (e2: expr) :=
+  if Int.eq n1 Int.zero then e2 else
+  if Int.eq n1 Int.mone then notint e2 else
+  Eop (Oxorimm n1) (e2:::Enil).  
+
+Nondetfunction xorimm (n1: int) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => Eop (Ointconst (Int.xor n1 n2)) Enil
+  | Eop (Oxorimm n2) (t2:::Enil) => xorimm_base (Int.xor n1 n2) t2
+  | _ => xorimm_base n1 e2
+  end.
+
+Nondetfunction xor (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 => xorimm n1 t2
+  | t1, Eop (Ointconst n2) Enil => xorimm n2 t1
+  | Eop Onot (t1:::Enil), t2 => Eop Oeqv (t2:::t1:::Enil)
+  | t1, Eop Onot (t2:::Enil) => Eop Oeqv (t1:::t2:::Enil)
+  | Eop (Onotshift s a) (t1:::Enil), t2 => Eop (Oeqvshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Onotshift s a) (t2:::Enil) => Eop (Oeqvshift s a) (t1:::t2:::Enil)
+  | Eop (Oshift s a) (t1:::Enil), t2 => Eop (Oxorshift s a) (t2:::t1:::Enil)
+  | t1, Eop (Oshift s a) (t2:::Enil) => Eop (Oxorshift s a) (t1:::t2:::Enil)
+  | _, _ => Eop Oxor (e1:::e2:::Enil)
+  end.
+
+(** ** Integer division and modulus *)
+
+Definition mod_aux (divop: operation) (e1 e2: expr) :=
+  Elet e1
+    (Elet (lift e2)
+      (Eop Omulsub (Eletvar 1 :::
+                    Eop divop (Eletvar 1 ::: Eletvar 0 ::: Enil) :::
+                    Eletvar 0 :::
+                    Enil))).
+
+Definition divs_base (e1: expr) (e2: expr) := Eop Odiv (e1:::e2:::Enil).
+Definition mods_base := mod_aux Odiv.
+Definition divu_base (e1: expr) (e2: expr) := Eop Odivu (e1:::e2:::Enil).
+Definition modu_base := mod_aux Odivu.
+
+Definition shrximm (e1: expr) (n2: int) :=
+  if Int.eq n2 Int.zero then e1 else Eop (Oshrximm n2) (e1:::Enil).
+
+(** ** General shifts *)
+
+Nondetfunction shl (e1: expr) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => shlimm e1 n2
+  | _ => Eop Oshl (e1:::e2:::Enil)
+  end.
+
+Nondetfunction shr (e1: expr) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => shrimm e1 n2
+  | _ => Eop Oshr (e1:::e2:::Enil)
+  end.
+
+Nondetfunction shru (e1: expr) (e2: expr) :=
+  match e2 with
+  | Eop (Ointconst n2) Enil => shruimm e1 n2
+  | _ => Eop Oshru (e1:::e2:::Enil)
+  end.
+
+(** ** Floating-point arithmetic *)
+
+Definition negf (e: expr) :=  Eop Onegf (e ::: Enil).
+Definition absf (e: expr) :=  Eop Oabsf (e ::: Enil).
+Definition addf (e1 e2: expr) :=  Eop Oaddf (e1 ::: e2 ::: Enil).
+Definition subf (e1 e2: expr) :=  Eop Osubf (e1 ::: e2 ::: Enil).
+Definition mulf (e1 e2: expr) :=  Eop Omulf (e1 ::: e2 ::: Enil).
+
+Definition negfs (e: expr) :=  Eop Onegfs (e ::: Enil).
+Definition absfs (e: expr) :=  Eop Oabsfs (e ::: Enil).
+Definition addfs (e1 e2: expr) :=  Eop Oaddfs (e1 ::: e2 ::: Enil).
+Definition subfs (e1 e2: expr) :=  Eop Osubfs (e1 ::: e2 ::: Enil).
+Definition mulfs (e1 e2: expr) :=  Eop Omulfs (e1 ::: e2 ::: Enil).
+
+(** ** Comparisons *)
+
+Nondetfunction compimm (default: comparison -> int -> condition)
+                       (sem: comparison -> int -> int -> bool)
+                       (c: comparison) (e1: expr) (n2: int) :=
+  match c, e1 with
+  | c, Eop (Ointconst n1) Enil =>
+      Eop (Ointconst (if sem c n1 n2 then Int.one else Int.zero)) Enil
+  | Ceq, Eop (Ocmp c) el =>
+      if Int.eq_dec n2 Int.zero then
+        Eop (Ocmp (negate_condition c)) el
+      else if Int.eq_dec n2 Int.one then
+        Eop (Ocmp c) el
+      else
+        Eop (Ointconst Int.zero) Enil
+  | Cne, Eop (Ocmp c) el =>
+      if Int.eq_dec n2 Int.zero then
+        Eop (Ocmp c) el
+      else if Int.eq_dec n2 Int.one then
+        Eop (Ocmp (negate_condition c)) el
+      else
+        Eop (Ointconst Int.one) Enil
+  | Ceq, Eop (Oandimm m) (t1:::Enil) =>
+      if Int.eq n2 Int.zero
+      then Eop (Ocmp (Cmaskzero m)) (t1:::Enil)
+      else Eop (Ocmp (default c n2)) (e1:::Enil)
+  | Cne, Eop (Oandimm m) (t1:::Enil) =>
+      if Int.eq n2 Int.zero
+      then Eop (Ocmp (Cmasknotzero m)) (t1:::Enil)
+      else Eop (Ocmp (default c n2)) (e1:::Enil)
+  | _, _ =>
+      Eop (Ocmp (default c n2)) (e1:::Enil)
+  end.
+
+Nondetfunction comp (c: comparison) (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 =>
+      compimm Ccompimm Int.cmp (swap_comparison c) t2 n1
+  | t1, Eop (Ointconst n2) Enil =>
+      compimm Ccompimm Int.cmp c t1 n2
+  | Eop (Oshift s a) (t1:::Enil), t2 ?? arith_shift s =>
+      Eop (Ocmp (Ccompshift (swap_comparison c) s a)) (t2:::t1:::Enil)
+  | t1, Eop (Oshift s a) (t2:::Enil) ?? arith_shift s =>
+      Eop (Ocmp (Ccompshift c s a)) (t1:::t2:::Enil)
+  | _, _ =>
+      Eop (Ocmp (Ccomp c)) (e1:::e2:::Enil)
+  end.
+
+Nondetfunction compu (c: comparison) (e1: expr) (e2: expr) :=
+  match e1, e2 with
+  | Eop (Ointconst n1) Enil, t2 =>
+      compimm Ccompuimm Int.cmpu (swap_comparison c) t2 n1
+  | t1, Eop (Ointconst n2) Enil =>
+      compimm Ccompuimm Int.cmpu c t1 n2
+  | Eop (Oshift s a) (t1:::Enil), t2 ?? arith_shift s =>
+      Eop (Ocmp (Ccompushift (swap_comparison c) s a)) (t2:::t1:::Enil)
+  | t1, Eop (Oshift s a) (t2:::Enil) ?? arith_shift s =>
+      Eop (Ocmp (Ccompushift c s a)) (t1:::t2:::Enil)
+  | _, _ =>
+      Eop (Ocmp (Ccompu c)) (e1:::e2:::Enil)
+  end.
+
+Definition compf (c: comparison) (e1: expr) (e2: expr) :=
+  Eop (Ocmp (Ccompf c)) (e1:::e2:::Enil).
+
+Definition compfs (c: comparison) (e1: expr) (e2: expr) :=
+  Eop (Ocmp (Ccompfs c)) (e1:::e2:::Enil).
+
+(** ** Floating-point conversions *)
+
+Definition intoffloat  (e: expr) := Eop Ointoffloat (e ::: Enil).
+Definition intuoffloat (e: expr) := Eop Ointuoffloat (e ::: Enil).
+
+Nondetfunction floatofintu (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => Eop (Ofloatconst (Float.of_intu n)) Enil
+  | _ => Eop Ofloatofintu (e ::: Enil)
+  end.
+
+Nondetfunction floatofint (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => Eop (Ofloatconst (Float.of_int n)) Enil
+  | _ => Eop Ofloatofint (e ::: Enil)
+  end.
+
+Definition intofsingle (e: expr) := Eop Ointofsingle (e ::: Enil).
+Definition intuofsingle (e: expr) := Eop Ointuofsingle (e ::: Enil).
+
+Nondetfunction singleofint (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => Eop (Osingleconst (Float32.of_int n)) Enil
+  | _ => Eop Osingleofint (e ::: Enil)
+  end.
+
+Nondetfunction singleofintu (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => Eop (Osingleconst (Float32.of_intu n)) Enil
+  | _ => Eop Osingleofintu (e ::: Enil)
+  end.
+
+Definition singleoffloat (e: expr) := Eop Osingleoffloat (e ::: Enil).
+Definition floatofsingle (e: expr) := Eop Ofloatofsingle (e ::: Enil).
+
+(** ** Selection *)
+
+Definition select (ty: typ) (cond: condition) (args: exprlist) (e1 e2: expr) :=
+  if match ty with
+     | Tint => true
+     | Tlong => true
+     | Tfloat => true
+     | Tsingle => true
+     | _ => false
+     end
+  then Some (Eop (Osel cond ty) (e1 ::: e2 ::: args))
+  else None.
+
+(** ** Recognition of addressing modes for load and store operations *)
+
+Nondetfunction addressing (chunk: memory_chunk) (e: expr) :=
+  match e with
+  | Eop (Oaddrstack n) Enil => (Ainstack n, Enil)
+  | Eop (Oaddrsymbol id ofs) Enil => (Aglobal id ofs, Enil)
+  | Eop (Oaddlimm n) (e1:::Enil) => (Aindexed n, e1:::Enil)
+  | Eop (Oaddlshift Slsl a) (e1:::e2:::Enil) => (Aindexed2shift a, e1:::e2:::Enil)
+  | Eop (Oaddlext x a) (e1:::e2:::Enil) => (Aindexed2ext x a, e1:::e2:::Enil)
+  | Eop Oaddl (e1:::e2:::Enil) => (Aindexed2, e1:::e2:::Enil)
+  | _ => (Aindexed Int64.zero, e:::Enil)
+  end.
+
+(** ** Arguments of builtins *)
+
+Nondetfunction builtin_arg (e: expr) :=
+  match e with
+  | Eop (Ointconst n) Enil => BA_int n
+  | Eop (Olongconst n) Enil => BA_long n
+  | Eop (Oaddrsymbol id ofs) Enil => BA_addrglobal id ofs
+  | Eop (Oaddrstack ofs) Enil => BA_addrstack ofs
+  | Eload chunk (Ainstack ofs) Enil => BA_loadstack chunk ofs
+  | Eop (Oaddlimm n) (e1:::Enil) => BA_addptr (BA e1) (BA_long n)
+  | _ => BA e
+  end.
+
+(** Platform-specific known builtins *)
+
+Definition platform_builtin (b: platform_builtin) (args: exprlist) : option expr :=
+  None.
diff --git a/aarch64/SelectOpproof.v b/aarch64/SelectOpproof.v
new file mode 100644
index 00000000..b78a5ed8
--- /dev/null
+++ b/aarch64/SelectOpproof.v
@@ -0,0 +1,1070 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Correctness of instruction selection for operators *)
+
+Require Import Coqlib Zbits.
+Require Import AST Integers Floats Values Memory Builtins Globalenvs.
+Require Import Cminor Op CminorSel.
+Require Import SelectOp.
+
+Local Open Scope cminorsel_scope.
+Local Transparent Archi.ptr64.
+
+(** * 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 := 
+  eauto with evalexpr;
+  match goal with
+  | [ |- eval_expr _ _ _ _ _ _ _ ] => eapply eval_Eop; [EvalOp|try reflexivity; auto]
+  | [ |- eval_exprlist _ _ _ _ _ _ _ ] => econstructor; EvalOp
+  | _ => idtac
+  end.
+
+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.
+
+Ltac TrivialExists :=
+  match goal with
+  | [ |- exists v, _ /\ Val.lessdef ?a v ] => exists a; split; [EvalOp | auto]
+  end.
+
+(** * Correctness of the smart constructors *)
+
+Section CMCONSTR.
+
+Variable ge: genv.
+Variable sp: val.
+Variable e: env.
+Variable m: mem.
+
+(** 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.
+*)
+
+Definition unary_constructor_sound (cstr: expr -> expr) (sem: val -> val) : Prop :=
+  forall le a x,
+  eval_expr ge sp e m le a x ->
+  exists v, eval_expr ge sp e m le (cstr a) v /\ Val.lessdef (sem x) v.
+
+Definition binary_constructor_sound (cstr: expr -> expr -> expr) (sem: val -> val -> val) : Prop :=
+  forall le a x b y,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  exists v, eval_expr ge sp e m le (cstr a b) v /\ Val.lessdef (sem x y) v.
+
+(** ** Constants *)
+
+Theorem eval_addrsymbol:
+  forall le id ofs,
+  exists v, eval_expr ge sp e m le (addrsymbol id ofs) v /\ Val.lessdef (Genv.symbol_address ge id ofs) v.
+Proof.
+  intros. unfold addrsymbol. TrivialExists.
+Qed.
+
+Theorem eval_addrstack:
+  forall le ofs,
+  exists v, eval_expr ge sp e m le (addrstack ofs) v /\ Val.lessdef (Val.offset_ptr sp ofs) v.
+Proof.
+  intros. unfold addrstack. TrivialExists.
+Qed.
+
+(** ** Addition, opposite, subtraction *)
+
+Theorem eval_addimm:
+  forall n, unary_constructor_sound (addimm n) (fun x => Val.add x (Vint n)).
+Proof.
+  red; unfold addimm; intros until x.
+  predSpec Int.eq Int.eq_spec n Int.zero.
+- subst n. intros. exists x; split; auto.
+  destruct x; simpl; auto. rewrite Int.add_zero; auto.
+- case (addimm_match a); intros; InvEval; simpl; TrivialExists; simpl.
++ rewrite Int.add_commut. auto.
++ subst x. rewrite Val.add_assoc. rewrite Int.add_commut. auto.
+Qed.
+
+Theorem eval_add: binary_constructor_sound add Val.add.
+Proof.
+  red; intros until y.
+  unfold add; case (add_match a b); intros; InvEval; subst.
+- rewrite Val.add_commut. apply eval_addimm; auto.
+- apply eval_addimm; auto.
+- replace (Val.add (Val.add v1 (Vint n1)) (Val.add v0 (Vint n2)))
+     with (Val.add (Val.add v1 v0) (Val.add (Vint n1) (Vint n2))).
+  apply eval_addimm. EvalOp.
+  repeat rewrite Val.add_assoc. decEq. apply Val.add_permut.
+- replace (Val.add (Val.add v1 (Vint n1)) y)
+     with (Val.add (Val.add v1 y) (Vint n1)).
+  apply eval_addimm. EvalOp.
+  repeat rewrite Val.add_assoc. decEq. apply Val.add_commut.
+- rewrite <- Val.add_assoc. apply eval_addimm. EvalOp.
+- rewrite Val.add_commut. TrivialExists.
+- TrivialExists.
+- rewrite Val.add_commut. TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_negint: unary_constructor_sound negint (fun v => Val.sub Vzero v).
+Proof.
+  red; intros until x; unfold negint. case (negint_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_sub: binary_constructor_sound sub Val.sub.
+Proof.
+  red; intros until y; unfold sub; case (sub_match a b); intros; InvEval; subst.
+- rewrite Val.sub_add_opp. apply eval_addimm; auto.
+- rewrite Val.sub_add_l. rewrite Val.sub_add_r.
+  rewrite Val.add_assoc. simpl. rewrite Int.add_commut. rewrite <- Int.sub_add_opp.
+  apply eval_addimm; EvalOp.
+- rewrite Val.sub_add_l. apply eval_addimm; EvalOp.
+- rewrite Val.sub_add_r. apply eval_addimm; EvalOp.
+- TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+(** ** Immediate shifts *)
+
+Remark eval_shlimm_base: forall le a n x,
+  eval_expr ge sp e m le a x ->
+  Int.ltu n Int.iwordsize = true ->
+  eval_expr ge sp e m le (shlimm_base a n) (Val.shl x (Vint n)).
+Proof.
+Local Opaque mk_amount32.
+  unfold shlimm_base; intros; EvalOp. simpl. rewrite mk_amount32_eq by auto. auto.
+Qed.
+
+Theorem eval_shlimm:
+  forall n, unary_constructor_sound (fun a => shlimm a n)
+                                    (fun x => Val.shl x (Vint n)).
+Proof.
+  red; intros until x; unfold shlimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; [| destruct (Int.ltu n Int.iwordsize) eqn:L]; simpl.
+- intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shl_zero; auto.
+- destruct (shlimm_match a); intros; InvEval; subst.
++ TrivialExists. simpl; rewrite L; auto.
++ destruct (Int.ltu (Int.add a n) Int.iwordsize) eqn:L2.
+* econstructor; split. eapply eval_shlimm_base; eauto.
+  destruct v1; simpl; auto. rewrite a32_range; simpl. rewrite L, L2. 
+  rewrite Int.shl_shl; auto using a32_range.
+* econstructor; split; [|eauto]. apply eval_shlimm_base; auto. EvalOp.
++ TrivialExists. simpl. rewrite mk_amount32_eq; auto.
++ TrivialExists. simpl. rewrite mk_amount32_eq; auto.
++ destruct (Int.ltu (Int.add a n) Int.iwordsize) eqn:L2.
+* TrivialExists. simpl. rewrite mk_amount32_eq by auto. 
+  destruct (Val.zero_ext s v1); simpl; auto.
+  rewrite a32_range; simpl; rewrite L, L2.
+  rewrite Int.shl_shl; auto using a32_range.
+* econstructor; split. eapply eval_shlimm_base; eauto. EvalOp; simpl; eauto. auto.
++ destruct (Int.ltu (Int.add a n) Int.iwordsize) eqn:L2.
+* TrivialExists. simpl. rewrite mk_amount32_eq by auto. 
+  destruct (Val.sign_ext s v1); simpl; auto.
+  rewrite a32_range; simpl; rewrite L, L2.
+  rewrite Int.shl_shl; auto using a32_range.
+* econstructor; split. eapply eval_shlimm_base; eauto. EvalOp; simpl; eauto. auto.
++ econstructor; eauto using eval_shlimm_base.
+- intros; TrivialExists.
+Qed.
+
+Remark eval_shruimm_base: forall le a n x,
+  eval_expr ge sp e m le a x ->
+  Int.ltu n Int.iwordsize = true ->
+  eval_expr ge sp e m le (shruimm_base a n) (Val.shru x (Vint n)).
+Proof.
+  unfold shruimm_base; intros; EvalOp. simpl. rewrite mk_amount32_eq by auto. auto.
+Qed.
+
+Remark sub_shift_amount:
+  forall y z,
+  Int.ltu y Int.iwordsize = true -> Int.ltu z Int.iwordsize = true -> Int.unsigned y <= Int.unsigned z ->
+  Int.ltu (Int.sub z y) Int.iwordsize = true.
+Proof.
+  intros. unfold Int.ltu; apply zlt_true. rewrite Int.unsigned_repr_wordsize.
+  apply Int.ltu_iwordsize_inv in H. apply Int.ltu_iwordsize_inv in H0.
+  unfold Int.sub; rewrite Int.unsigned_repr. omega.
+  generalize Int.wordsize_max_unsigned; omega.
+Qed.
+
+Theorem eval_shruimm:
+  forall n, unary_constructor_sound (fun a => shruimm a n)
+                                    (fun x => Val.shru x (Vint n)).
+Proof.
+Local Opaque Int.zwordsize.
+  red; intros until x; unfold shruimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; [| destruct (Int.ltu n Int.iwordsize) eqn:L]; simpl.
+- intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shru_zero; auto.
+- destruct (shruimm_match a); intros; InvEval; subst.
++ TrivialExists. simpl; rewrite L; auto.
++ destruct (Int.ltu n a) eqn:L2.
+* assert (L3: Int.ltu (Int.sub a n) Int.iwordsize = true).
+  { apply sub_shift_amount; auto using a32_range.
+    apply Int.ltu_inv in L2. omega. }
+  econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite mk_amount32_eq, L3, a32_range by auto.
+  simpl. rewrite L. rewrite Int.shru_shl, L2 by auto using a32_range. auto.
+* assert (L3: Int.ltu (Int.sub n a) Int.iwordsize = true).
+  { apply sub_shift_amount; auto using a32_range.
+    unfold Int.ltu in L2. destruct zlt in L2; discriminate || omega. }
+  econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite mk_amount32_eq, L3, a32_range by auto.
+  simpl. rewrite L. rewrite Int.shru_shl, L2 by auto using a32_range. auto.
++ destruct (Int.ltu (Int.add a n) Int.iwordsize) eqn:L2.
+* econstructor; split. eapply eval_shruimm_base; eauto.
+  destruct v1; simpl; auto. rewrite a32_range; simpl. rewrite L, L2. 
+  rewrite Int.shru_shru; auto using a32_range.
+* econstructor; split; [|eauto]. apply eval_shruimm_base; auto. EvalOp.
++ destruct (zlt (Int.unsigned n) s).
+* econstructor; split. EvalOp. rewrite mk_amount32_eq by auto.
+  destruct v1; simpl; auto. rewrite ! L; simpl.
+  set (s' := s - Int.unsigned n).
+  replace s with (s' + Int.unsigned n) by (unfold s'; omega).
+  rewrite Int.shru_zero_ext. auto. unfold s'; omega.
+* econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite ! L; simpl.
+  rewrite Int.shru_zero_ext_0 by omega. auto. 
++ econstructor; eauto using eval_shruimm_base.
+- intros; TrivialExists.
+Qed.
+
+Remark eval_shrimm_base: forall le a n x,
+  eval_expr ge sp e m le a x ->
+  Int.ltu n Int.iwordsize = true ->
+  eval_expr ge sp e m le (shrimm_base a n) (Val.shr x (Vint n)).
+Proof.
+  unfold shrimm_base; intros; EvalOp. simpl. rewrite mk_amount32_eq by auto. auto.
+Qed.
+
+Theorem eval_shrimm:
+  forall n, unary_constructor_sound (fun a => shrimm a n)
+                                    (fun x => Val.shr x (Vint n)).
+Proof.
+  red; intros until x; unfold shrimm.
+  predSpec Int.eq Int.eq_spec n Int.zero; [| destruct (Int.ltu n Int.iwordsize) eqn:L]; simpl.
+- intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shr_zero; auto.
+- destruct (shrimm_match a); intros; InvEval; subst.
++ TrivialExists. simpl; rewrite L; auto.
++ destruct (Int.ltu n a) eqn:L2.
+* assert (L3: Int.ltu (Int.sub a n) Int.iwordsize = true).
+  { apply sub_shift_amount; auto using a32_range.
+    apply Int.ltu_inv in L2. omega. }
+  econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite mk_amount32_eq, L3, a32_range by auto.
+  simpl. rewrite L. rewrite Int.shr_shl, L2 by auto using a32_range. auto.
+* assert (L3: Int.ltu (Int.sub n a) Int.iwordsize = true).
+  { apply sub_shift_amount; auto using a32_range.
+    unfold Int.ltu in L2. destruct zlt in L2; discriminate || omega. }
+  econstructor; split. EvalOp.
+  destruct v1; simpl; auto. rewrite mk_amount32_eq, L3, a32_range by auto.
+  simpl. rewrite L. rewrite Int.shr_shl, L2 by auto using a32_range. auto.
++ destruct (Int.ltu (Int.add a n) Int.iwordsize) eqn:L2.
+* econstructor; split. eapply eval_shrimm_base; eauto.
+  destruct v1; simpl; auto. rewrite a32_range; simpl. rewrite L, L2. 
+  rewrite Int.shr_shr; auto using a32_range.
+* econstructor; split; [|eauto]. apply eval_shrimm_base; auto. EvalOp.
++ destruct (zlt (Int.unsigned n) s && zlt s Int.zwordsize) eqn:E.
+* InvBooleans. econstructor; split. EvalOp. rewrite mk_amount32_eq by auto.
+  destruct v1; simpl; auto. rewrite ! L; simpl.
+  set (s' := s - Int.unsigned n).
+  replace s with (s' + Int.unsigned n) by (unfold s'; omega).
+  rewrite Int.shr_sign_ext. auto. unfold s'; omega. unfold s'; omega.
+* econstructor; split; [|eauto]. apply eval_shrimm_base; auto. EvalOp.
++ econstructor; eauto using eval_shrimm_base. 
+- intros; TrivialExists.
+Qed.
+
+(** ** Multiplication *)
+
+Lemma eval_mulimm_base:
+  forall n, unary_constructor_sound (mulimm_base n) (fun x => Val.mul x (Vint n)).
+Proof.
+  intros; red; intros; unfold mulimm_base.
+  assert (DFL: exists v, eval_expr ge sp e m le (Eop Omul (Eop (Ointconst n) Enil ::: a ::: Enil)) v /\ Val.lessdef (Val.mul x (Vint n)) v).
+  { rewrite Val.mul_commut; TrivialExists. } 
+  generalize (Int.one_bits_decomp n); generalize (Int.one_bits_range n);
+  destruct (Int.one_bits n) as [ | i [ | j []]]; intros P Q.
+- apply DFL.
+- replace (Val.mul x (Vint n)) with (Val.shl x (Vint i)).
+  apply eval_shlimm; auto.
+  simpl in Q. rewrite <- Val.shl_mul, Q, Int.add_zero. simpl. rewrite P by auto with coqlib. auto.
+- exploit (eval_shlimm i (x :: le) (Eletvar 0) x). constructor; auto. intros [v1 [A1 B1]].
+  exploit (eval_shlimm j (x :: le) (Eletvar 0) x). constructor; auto. intros [v2 [A2 B2]].
+  exploit (eval_add (x :: le)). eexact A1. eexact A2. intros [v [A B]].
+  exists v; split. econstructor; eauto.
+  simpl in Q. rewrite Q, Int.add_zero.
+  replace (Vint (Int.add (Int.shl Int.one i) (Int.shl Int.one j)))
+     with (Val.add (Val.shl Vone (Vint i)) (Val.shl Vone (Vint j))).
+  rewrite Val.mul_add_distr_r.
+  repeat rewrite Val.shl_mul. eapply Val.lessdef_trans; [|eauto]. apply Val.add_lessdef; auto.
+  simpl. repeat rewrite P by auto with coqlib. auto.
+- apply DFL.
+Qed.
+
+Theorem eval_mulimm:
+  forall n, unary_constructor_sound (mulimm n) (fun x => Val.mul x (Vint n)).
+Proof.
+  intros; red; intros until x; unfold mulimm.
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  intros. exists (Vint Int.zero); split. EvalOp.
+  destruct x; simpl; auto. subst n. rewrite Int.mul_zero. auto.
+  predSpec Int.eq Int.eq_spec n Int.one.
+  intros. exists x; split; auto.
+  destruct x; simpl; auto. subst n. rewrite Int.mul_one. auto.
+  case (mulimm_match a); intros; InvEval; subst.
+- TrivialExists. simpl. rewrite Int.mul_commut; auto.
+- rewrite Val.mul_add_distr_l.
+  exploit eval_mulimm_base; eauto. instantiate (1 := n). intros [v' [A1 B1]].
+  exploit (eval_addimm (Int.mul n n2) le (mulimm_base n t2) v'). auto. intros [v'' [A2 B2]].
+  exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.add_lessdef; eauto.
+  rewrite Val.mul_commut; auto.
+- apply eval_mulimm_base; auto.
+Qed.
+
+Theorem eval_mul: binary_constructor_sound mul Val.mul.
+Proof.
+  red; intros until y; unfold mul; case (mul_match a b); intros; InvEval; subst.
+- rewrite Val.mul_commut. apply eval_mulimm; auto.
+- apply eval_mulimm; auto.
+- TrivialExists.
+Qed.
+
+Theorem eval_mulhs: binary_constructor_sound mulhs Val.mulhs.
+Proof.
+  unfold mulhs; red; intros. econstructor; split. EvalOp.
+  unfold eval_shiftl, eval_extend. rewrite ! mk_amount64_eq by auto.
+  destruct x; simpl; auto. destruct y; simpl; auto.
+  change (Int.ltu Int.zero Int64.iwordsize') with true; simpl.
+  rewrite ! Int64.shl'_zero.  
+  change (Int.ltu (Int.repr 32) Int64.iwordsize') with true; simpl.
+  apply Val.lessdef_same. f_equal. 
+  transitivity (Int.repr (Z.shiftr (Int.signed i * Int.signed i0) 32)).
+  unfold Int.mulhs; f_equal. rewrite Zshiftr_div_two_p by omega. reflexivity.
+  apply Int.same_bits_eq; intros n N.
+  change Int.zwordsize with 32 in *.
+  assert (N1: 0 <= n < 64) by omega.
+  rewrite Int64.bits_loword by auto.
+  rewrite Int64.bits_shr' by auto.
+  change (Int.unsigned (Int.repr 32)) with 32. change Int64.zwordsize with 64.
+  rewrite zlt_true by omega.
+  rewrite Int.testbit_repr by auto. 
+  unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; omega).
+  transitivity (Z.testbit (Int.signed i * Int.signed i0) (n + 32)).
+  rewrite Z.shiftr_spec by omega. auto.
+  apply Int64.same_bits_eqm. apply Int64.eqm_mult; apply Int64.eqm_unsigned_repr. 
+  change Int64.zwordsize with 64; omega.
+Qed.
+
+Theorem eval_mulhu: binary_constructor_sound mulhu Val.mulhu.
+Proof.
+  unfold mulhu; red; intros. econstructor; split. EvalOp.
+  unfold eval_shiftl, eval_extend. rewrite ! mk_amount64_eq by auto.
+  destruct x; simpl; auto. destruct y; simpl; auto.
+  change (Int.ltu Int.zero Int64.iwordsize') with true; simpl.
+  rewrite ! Int64.shl'_zero.
+  change (Int.ltu (Int.repr 32) Int64.iwordsize') with true; simpl.
+  apply Val.lessdef_same. f_equal. 
+  transitivity (Int.repr (Z.shiftr (Int.unsigned i * Int.unsigned i0) 32)).
+  unfold Int.mulhu; f_equal. rewrite Zshiftr_div_two_p by omega. reflexivity.
+  apply Int.same_bits_eq; intros n N.
+  change Int.zwordsize with 32 in *.
+  assert (N1: 0 <= n < 64) by omega.
+  rewrite Int64.bits_loword by auto.
+  rewrite Int64.bits_shru' by auto.
+  change (Int.unsigned (Int.repr 32)) with 32. change Int64.zwordsize with 64.
+  rewrite zlt_true by omega.
+  rewrite Int.testbit_repr by auto. 
+  unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; omega).
+  transitivity (Z.testbit (Int.unsigned i * Int.unsigned i0) (n + 32)).
+  rewrite Z.shiftr_spec by omega. auto.
+  apply Int64.same_bits_eqm. apply Int64.eqm_mult; apply Int64.eqm_unsigned_repr. 
+  change Int64.zwordsize with 64; omega.
+Qed.
+
+(** Integer conversions *)
+
+Theorem eval_zero_ext:
+  forall sz, 0 <= sz -> unary_constructor_sound (zero_ext sz) (Val.zero_ext sz).
+Proof.
+  intros; red; intros until x; unfold zero_ext; case (zero_ext_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists.
+- destruct (zlt (Int.unsigned a0) sz).
++ econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite a32_range; simpl.
+  apply Val.lessdef_same. f_equal. rewrite Int.shl_zero_ext by omega. f_equal. omega.
++ TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_sign_ext:
+  forall sz, 0 < sz -> unary_constructor_sound (sign_ext sz) (Val.sign_ext sz).
+Proof.
+  intros; red; intros until x; unfold sign_ext; case (sign_ext_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists.
+- destruct (zlt (Int.unsigned a0) sz).
++ econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite a32_range; simpl.
+  apply Val.lessdef_same. f_equal. rewrite Int.shl_sign_ext by omega. f_equal. omega.
++ TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_cast8signed: unary_constructor_sound cast8signed (Val.sign_ext 8).
+Proof.
+  apply eval_sign_ext; omega. 
+Qed.
+
+Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8).
+Proof.
+  apply eval_zero_ext; omega.
+Qed.
+
+Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16).
+Proof.
+  apply eval_sign_ext; omega. 
+Qed.
+
+Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16).
+Proof.
+  apply eval_zero_ext; omega.
+Qed.
+
+(** Bitwise not, and, or, xor *)
+
+Theorem eval_notint: unary_constructor_sound notint Val.notint.
+Proof.
+  assert (INV: forall v, Val.lessdef (Val.notint (Val.notint v)) v).
+  { destruct v; auto. simpl; rewrite Int.not_involutive; auto. } 
+  unfold notint; red; intros until x; case (notint_match a); intros; InvEval; subst.
+- TrivialExists.
+- TrivialExists.
+- exists v1; auto.
+- exists (eval_shift s v1 a0); split; auto. EvalOp.
+- econstructor; split. EvalOp. 
+  destruct v1; simpl; auto; destruct v0; simpl; auto.
+  rewrite Int.not_and_or_not, Int.not_involutive, Int.or_commut. auto.
+- econstructor; split. EvalOp. 
+  destruct v1; simpl; auto; destruct v0; simpl; auto.
+  rewrite Int.not_or_and_not, Int.not_involutive, Int.and_commut. auto.
+- econstructor; split. EvalOp. 
+  rewrite ! Val.not_xor, Val.xor_assoc; auto.
+- econstructor; split. EvalOp.
+  destruct v1; simpl; auto; destruct v0; simpl; auto.
+  unfold Int.not; rewrite ! Int.xor_assoc, Int.xor_idem, Int.xor_zero. auto.
+- TrivialExists.
+Qed.
+
+Lemma eval_andimm_base:
+  forall n, unary_constructor_sound (andimm_base n) (fun x => Val.and x (Vint n)).
+Proof.
+  intros; red; intros. unfold andimm_base.
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  exists (Vint Int.zero); split. EvalOp.
+  destruct x; simpl; auto. subst n. rewrite Int.and_zero. auto.
+  predSpec Int.eq Int.eq_spec n Int.mone.
+  exists x; split; auto.
+  subst. destruct x; simpl; auto. rewrite Int.and_mone; auto.
+  destruct (Z_is_power2m1 (Int.unsigned n)) as [s|] eqn:P.
+  assert (0 <= s) by (eapply Z_is_power2m1_nonneg; eauto).
+  rewrite <- (Int.repr_unsigned n), (Z_is_power2m1_sound _ _ P), <- Val.zero_ext_and by auto.
+  apply eval_zero_ext; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_andimm:
+  forall n, unary_constructor_sound (andimm n) (fun x => Val.and x (Vint n)).
+Proof.
+  intros; red; intros until x. unfold andimm.
+  case (andimm_match a); intros; InvEval; subst.
+- rewrite Int.and_commut; TrivialExists.
+- rewrite Val.and_assoc, Int.and_commut. apply eval_andimm_base; auto.
+- destruct (zle 0 s).
++ rewrite Val.zero_ext_and, Val.and_assoc, Int.and_commut by auto. 
+  apply eval_andimm_base; auto.
++ apply eval_andimm_base. EvalOp.
+- apply eval_andimm_base; auto.
+Qed.
+
+Theorem eval_and: binary_constructor_sound and Val.and.
+Proof.
+  red; intros until y; unfold and; case (and_match a b); intros; InvEval; subst.
+- rewrite Val.and_commut; apply eval_andimm; auto.
+- apply eval_andimm; auto.
+- rewrite Val.and_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.and_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.and_commut; TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_orimm:
+  forall n, unary_constructor_sound (orimm n) (fun x => Val.or x (Vint n)).
+Proof.
+  intros; red; intros until x. unfold orimm.
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  intros. subst. exists x; split; auto.
+  destruct x; simpl; auto. rewrite Int.or_zero; auto.
+  predSpec Int.eq Int.eq_spec n Int.mone.
+  intros. exists (Vint Int.mone); split. EvalOp.
+  destruct x; simpl; auto. subst n. rewrite Int.or_mone. auto.
+  destruct (orimm_match a); intros; InvEval; subst.
+- rewrite Int.or_commut; TrivialExists.
+- rewrite Val.or_assoc, Int.or_commut; TrivialExists.
+- TrivialExists.
+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. destruct a1; try discriminate. destruct a2; try discriminate.
+  simpl in H; destruct (ident_eq i i0); inv H.
+  split. auto. inv H0; inv H1; congruence.
+Qed.
+
+Theorem eval_or: binary_constructor_sound or Val.or.
+Proof.
+  red; intros until y; unfold or; case (or_match a b); intros; InvEval; subst.
+- rewrite Val.or_commut. apply eval_orimm; auto.
+- apply eval_orimm; auto.
+- rewrite Val.or_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.or_commut; TrivialExists.
+- TrivialExists.
+- (* shl - shru *)
+  destruct (Int.eq (Int.add a1 a2) Int.iwordsize && same_expr_pure t1 t2) eqn:?.
++ InvBooleans. apply Int.same_if_eq in H.
+  exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst.
+  econstructor; split. EvalOp.
+  destruct v0; simpl; auto. rewrite ! a32_range. simpl. rewrite <- Int.or_ror; auto using a32_range.
++ TrivialExists.
+- (* shru - shl *)
+  destruct (Int.eq (Int.add a2 a1) Int.iwordsize && same_expr_pure t1 t2) eqn:?.
++ InvBooleans. apply Int.same_if_eq in H.
+  exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst.
+  econstructor; split. EvalOp.
+  destruct v0; simpl; auto. rewrite ! a32_range. simpl.
+  rewrite Int.or_commut, <- Int.or_ror; auto using a32_range.
++ TrivialExists.
+- rewrite Val.or_commut; TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Lemma eval_xorimm_base:
+  forall n, unary_constructor_sound (xorimm_base n) (fun x => Val.xor x (Vint n)).
+Proof.
+  intros; red; intros. unfold xorimm_base.
+  predSpec Int.eq Int.eq_spec n Int.zero.
+  intros. exists x; split. auto.
+  destruct x; simpl; auto. subst n. rewrite Int.xor_zero. auto.
+  predSpec Int.eq Int.eq_spec n Int.mone.
+  subst n. rewrite <- Val.not_xor. apply eval_notint; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_xorimm:
+  forall n, unary_constructor_sound (xorimm n) (fun x => Val.xor x (Vint n)).
+Proof.
+  intros; red; intros until x. unfold xorimm.
+  destruct (xorimm_match a); intros; InvEval; subst.
+- rewrite Int.xor_commut; TrivialExists.
+- rewrite Val.xor_assoc; simpl. rewrite (Int.xor_commut n2). apply eval_xorimm_base; auto.
+- apply eval_xorimm_base; auto.
+Qed.
+
+Theorem eval_xor: binary_constructor_sound xor Val.xor.
+Proof.
+  red; intros until y; unfold xor; case (xor_match a b); intros; InvEval; subst.
+- rewrite Val.xor_commut; apply eval_xorimm; auto.
+- apply eval_xorimm; auto.
+- rewrite Val.xor_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.xor_commut; TrivialExists.
+- TrivialExists.
+- rewrite Val.xor_commut; TrivialExists.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+(** ** Integer division and modulus *)
+
+Theorem eval_divs_base:
+  forall le a b x y z,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.divs x y = Some z ->
+  exists v, eval_expr ge sp e m le (divs_base a b) v /\ Val.lessdef z v.
+Proof.
+  intros; unfold divs_base; TrivialExists.
+Qed.
+
+Theorem eval_mods_base:
+  forall le a b x y z,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.mods x y = Some z ->
+  exists v, eval_expr ge sp e m le (mods_base a b) v /\ Val.lessdef z v.
+Proof.
+  intros; unfold mods_base, mod_aux.
+  exploit Val.mods_divs; eauto. intros (q & A & B). subst z.
+  TrivialExists. repeat (econstructor; eauto with evalexpr). exact A.
+Qed.
+
+Theorem eval_divu_base:
+  forall le a x b y z,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.divu x y = Some z ->
+  exists v, eval_expr ge sp e m le (divu_base a b) v /\ Val.lessdef z v.
+Proof.
+  intros; unfold divu_base; TrivialExists.
+Qed.
+
+Theorem eval_modu_base:
+  forall le a x b y z,
+  eval_expr ge sp e m le a x ->
+  eval_expr ge sp e m le b y ->
+  Val.modu x y = Some z ->
+  exists v, eval_expr ge sp e m le (modu_base a b) v /\ Val.lessdef z v.
+Proof.
+  intros; unfold modu_base, mod_aux.
+  exploit Val.modu_divu; eauto. intros (q & A & B). subst z.
+  TrivialExists. repeat (econstructor; eauto with evalexpr). exact A.
+Qed.
+
+Theorem eval_shrximm:
+  forall le a n x z,
+  eval_expr ge sp e m le a x ->
+  Val.shrx x (Vint n) = Some z ->
+  exists v, eval_expr ge sp e m le (shrximm a n) v /\ Val.lessdef z v.
+Proof.
+  intros; unfold shrximm. 
+  predSpec Int.eq Int.eq_spec n Int.zero.
+- subst n. exists x; split; auto.
+  destruct x; simpl in H0; try discriminate.
+  change (Int.ltu Int.zero (Int.repr 31)) with true in H0; inv H0.
+  rewrite Int.shrx_zero by (compute; auto). auto.
+- TrivialExists.
+Qed.
+
+(** General shifts *)
+
+Theorem eval_shl: binary_constructor_sound shl Val.shl.
+Proof.
+  red; intros until y; unfold shl; case (shl_match b); intros.
+  InvEval. apply eval_shlimm; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_shr: binary_constructor_sound shr Val.shr.
+Proof.
+  red; intros until y; unfold shr; case (shr_match b); intros.
+  InvEval. apply eval_shrimm; auto.
+  TrivialExists.
+Qed.
+
+Theorem eval_shru: binary_constructor_sound shru Val.shru.
+Proof.
+  red; intros until y; unfold shru; case (shru_match b); intros.
+  InvEval. apply eval_shruimm; auto.
+  TrivialExists.
+Qed.
+
+(** Floating-point operations *)
+
+Theorem eval_negf: unary_constructor_sound negf Val.negf.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_absf: unary_constructor_sound absf Val.absf.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_addf: binary_constructor_sound addf Val.addf.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_subf: binary_constructor_sound subf Val.subf.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_mulf: binary_constructor_sound mulf Val.mulf.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_negfs: unary_constructor_sound negfs Val.negfs.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_absfs: unary_constructor_sound absfs Val.absfs.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_addfs: binary_constructor_sound addfs Val.addfs.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_subfs: binary_constructor_sound subfs Val.subfs.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_mulfs: binary_constructor_sound mulfs Val.mulfs.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Section COMP_IMM.
+
+Variable default: comparison -> int -> condition.
+Variable intsem: comparison -> int -> int -> bool.
+Variable sem: comparison -> val -> val -> val.
+
+Hypothesis sem_int: forall c x y, sem c (Vint x) (Vint y) = Val.of_bool (intsem c x y).
+Hypothesis sem_undef: forall c v, sem c Vundef v = Vundef.
+Hypothesis sem_eq: forall x y, sem Ceq (Vint x) (Vint y) = Val.of_bool (Int.eq x y).
+Hypothesis sem_ne: forall x y, sem Cne (Vint x) (Vint y) = Val.of_bool (negb (Int.eq x y)).
+Hypothesis sem_default: forall c v n, sem c v (Vint n) = Val.of_optbool (eval_condition (default c n) (v :: nil) m).
+
+Lemma eval_compimm:
+  forall le c a n2 x,
+  eval_expr ge sp e m le a x ->
+  exists v, eval_expr ge sp e m le (compimm default intsem c a n2) v
+         /\ Val.lessdef (sem c x (Vint n2)) v.
+Proof.
+  intros until x.
+  unfold compimm; case (compimm_match c a); intros; InvEval; subst.
+- (* constant *)
+  rewrite sem_int. TrivialExists. simpl. destruct (intsem c0 n1 n2); auto.
+- (* eq cmp *)
+  inv H. simpl in H5. inv H5.
+  destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists.
+  simpl. rewrite eval_negate_condition.
+  destruct (eval_condition c0 vl m); simpl.
+  unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_eq; auto.
+  rewrite sem_undef; auto.
+  destruct (Int.eq_dec n2 Int.one). subst n2. TrivialExists.
+  simpl. destruct (eval_condition c0 vl m); simpl.
+  unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_eq; auto.
+  rewrite sem_undef; auto.
+  exists (Vint Int.zero); split. EvalOp.
+  destruct (eval_condition c0 vl m); simpl.
+  unfold Vtrue, Vfalse. destruct b; rewrite sem_eq; rewrite Int.eq_false; auto.
+  rewrite sem_undef; auto.
+- (* ne cmp *)
+  inv H. simpl in H5. inv H5.
+  destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists.
+  simpl. destruct (eval_condition c0 vl m); simpl.
+  unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_ne; auto.
+  rewrite sem_undef; auto.
+  destruct (Int.eq_dec n2 Int.one). subst n2. TrivialExists.
+  simpl. rewrite eval_negate_condition. destruct (eval_condition c0 vl m); simpl.
+  unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_ne; auto.
+  rewrite sem_undef; auto.
+  exists (Vint Int.one); split. EvalOp.
+  destruct (eval_condition c0 vl m); simpl.
+  unfold Vtrue, Vfalse. destruct b; rewrite sem_ne; rewrite Int.eq_false; auto.
+  rewrite sem_undef; auto.
+- (* mask zero *)
+  predSpec Int.eq Int.eq_spec n2 Int.zero.
++ subst n2. econstructor; split. EvalOp. simpl. 
+  destruct v1; simpl; try (rewrite sem_undef; auto).
+  rewrite sem_eq. destruct (Int.eq (Int.and i m0) Int.zero); auto.
++ TrivialExists. simpl. rewrite sem_default. auto.
+- (* mask not zero *)
+  predSpec Int.eq Int.eq_spec n2 Int.zero.
++ subst n2. econstructor; split. EvalOp. simpl. 
+  destruct v1; simpl; try (rewrite sem_undef; auto).
+  rewrite sem_ne. destruct (Int.eq (Int.and i m0) Int.zero); auto.
++ TrivialExists. simpl. rewrite sem_default. auto.
+- (* default *)
+  TrivialExists. simpl. rewrite sem_default. auto.
+Qed.
+
+Hypothesis sem_swap:
+  forall c x y, sem (swap_comparison c) x y = sem c y x.
+
+Lemma eval_compimm_swap:
+  forall le c a n2 x,
+  eval_expr ge sp e m le a x ->
+  exists v, eval_expr ge sp e m le (compimm default intsem (swap_comparison c) a n2) v
+         /\ Val.lessdef (sem c (Vint n2) x) v.
+Proof.
+  intros. rewrite <- sem_swap. eapply eval_compimm; eauto.
+Qed.
+
+End COMP_IMM.
+
+Theorem eval_comp:
+  forall c, binary_constructor_sound (comp c) (Val.cmp c).
+Proof.
+  intros; red; intros until y. unfold comp; case (comp_match a b); intros; InvEval; subst.
+- eapply eval_compimm_swap; eauto.
+  intros. unfold Val.cmp. rewrite Val.swap_cmp_bool; auto.
+- eapply eval_compimm; eauto.
+- TrivialExists. simpl. rewrite Val.swap_cmp_bool. auto.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_compu:
+  forall c, binary_constructor_sound (compu c) (Val.cmpu (Mem.valid_pointer m) c).
+Proof.
+  intros; red; intros until y. unfold compu; case (compu_match a b); intros; InvEval; subst.
+- eapply eval_compimm_swap; eauto.
+  intros. unfold Val.cmpu. rewrite Val.swap_cmpu_bool; auto.
+- eapply eval_compimm; eauto.
+- TrivialExists. simpl. rewrite Val.swap_cmpu_bool. auto.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_compf:
+  forall c, binary_constructor_sound (compf c) (Val.cmpf c).
+Proof.
+  intros; red; intros. unfold compf. TrivialExists.
+Qed.
+
+Theorem eval_compfs:
+  forall c, binary_constructor_sound (compfs c) (Val.cmpfs c).
+Proof.
+  intros; red; intros. unfold compfs. TrivialExists.
+Qed.
+
+(** Floating-point conversions *)
+
+Theorem eval_singleoffloat: unary_constructor_sound singleoffloat Val.singleoffloat.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_floatofsingle: unary_constructor_sound floatofsingle Val.floatofsingle.
+Proof.
+  red; intros; TrivialExists.
+Qed.
+
+Theorem eval_intoffloat:
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.intoffloat x = Some y ->
+  exists v, eval_expr ge sp e m le (intoffloat a) v /\ Val.lessdef y v.
+Proof.
+  intros; TrivialExists.
+Qed.
+
+Theorem eval_floatofint:
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.floatofint x = Some y ->
+  exists v, eval_expr ge sp e m le (floatofint a) v /\ Val.lessdef y v.
+Proof.
+  intros until y; unfold floatofint. case (floatofint_match a); intros; InvEval.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_intuoffloat:
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.intuoffloat x = Some y ->
+  exists v, eval_expr ge sp e m le (intuoffloat a) v /\ Val.lessdef y v.
+Proof.
+  intros; TrivialExists.
+Qed.
+
+Theorem eval_floatofintu:
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.floatofintu x = Some y ->
+  exists v, eval_expr ge sp e m le (floatofintu a) v /\ Val.lessdef y v.
+Proof.
+  intros until y; unfold floatofintu. case (floatofintu_match a); intros; InvEval.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_intofsingle:
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.intofsingle x = Some y ->
+  exists v, eval_expr ge sp e m le (intofsingle a) v /\ Val.lessdef y v.
+Proof.
+  intros; TrivialExists.
+Qed.
+
+Theorem eval_singleofint:
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.singleofint x = Some y ->
+  exists v, eval_expr ge sp e m le (singleofint a) v /\ Val.lessdef y v.
+Proof.
+  intros until y; unfold singleofint. case (singleofint_match a); intros; InvEval.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+Theorem eval_intuofsingle:
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.intuofsingle x = Some y ->
+  exists v, eval_expr ge sp e m le (intuofsingle a) v /\ Val.lessdef y v.
+Proof.
+  intros; TrivialExists.
+Qed.
+
+Theorem eval_singleofintu:
+  forall le a x y,
+  eval_expr ge sp e m le a x ->
+  Val.singleofintu x = Some y ->
+  exists v, eval_expr ge sp e m le (singleofintu a) v /\ Val.lessdef y v.
+Proof.
+  intros until y; unfold singleofintu. case (singleofintu_match a); intros; InvEval.
+- TrivialExists.
+- TrivialExists.
+Qed.
+
+(** Selection *)
+
+Theorem eval_select:
+  forall le ty cond al vl a1 v1 a2 v2 a b,
+  select ty cond al a1 a2 = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  eval_expr ge sp e m le a1 v1 ->
+  eval_expr ge sp e m le a2 v2 ->
+  eval_condition cond vl m = Some b ->
+  exists v, 
+     eval_expr ge sp e m le a v
+  /\ Val.lessdef (Val.select (Some b) v1 v2 ty) v.
+Proof.
+  unfold select; intros.
+  destruct (match ty with Tint | Tlong | Tfloat | Tsingle => true | _ => false end); inv H.
+  rewrite <- H3; TrivialExists. 
+Qed.
+
+(** Addressing modes *)
+
+Theorem eval_addressing:
+  forall le chunk a v b ofs,
+  eval_expr ge sp e m le a v ->
+  v = Vptr b ofs ->
+  match addressing chunk a with (mode, args) =>
+    exists vl,
+    eval_exprlist ge sp e m le args vl /\
+    eval_addressing ge sp mode vl = Some v
+  end.
+Proof.
+  intros until v. unfold addressing; case (addressing_match a); intros; InvEval.
+- econstructor; split. EvalOp. simpl; auto.
+- econstructor; split. EvalOp. simpl; auto.
+- econstructor; split. EvalOp. simpl. 
+  destruct v1; try discriminate. rewrite <- H; auto.
+- econstructor; split. EvalOp. simpl. congruence.
+- econstructor; split. EvalOp. simpl. congruence.
+- econstructor; split. EvalOp. simpl. congruence.
+- econstructor; split. EvalOp. simpl. rewrite H0. simpl. rewrite Ptrofs.add_zero; auto.
+Qed.
+
+(** Builtins *)
+
+Theorem eval_builtin_arg:
+  forall a v,
+  eval_expr ge sp e m nil a v ->
+  CminorSel.eval_builtin_arg ge sp e m (builtin_arg a) v.
+Proof.
+  intros until v. unfold builtin_arg; case (builtin_arg_match a); intros; InvEval.
+- constructor.
+- constructor.
+- constructor.
+- constructor.
+- inv H. InvEval. simpl in H6. inv H6. constructor; auto.
+- subst v. repeat constructor; auto.
+- constructor; auto. 
+Qed.
+
+(** Platform-specific known builtins *)
+
+Theorem eval_platform_builtin:
+  forall bf al a vl v le,
+  platform_builtin bf al = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  platform_builtin_sem bf vl = Some v ->
+  exists v', eval_expr ge sp e m le a v' /\ Val.lessdef v v'.
+Proof.
+  intros. discriminate.
+Qed.
+
+End CMCONSTR.
diff --git a/aarch64/Stacklayout.v b/aarch64/Stacklayout.v
new file mode 100644
index 00000000..86ba9f45
--- /dev/null
+++ b/aarch64/Stacklayout.v
@@ -0,0 +1,140 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Machine- and ABI-dependent layout information for activation records. *)
+
+Require Import Coqlib.
+Require Import AST Memory Separation.
+Require Import Bounds.
+
+Local Open Scope sep_scope.
+
+(** The general shape of activation records is as follows,
+  from bottom (lowest offsets) to top:
+- Space for outgoing arguments to function calls.
+- Back link to parent frame
+- Return address
+- Saved values of callee-save registers used by the function.
+- Local stack slots.
+- Space for the stack-allocated data declared in Cminor.
+
+The stack pointer is kept 16-aligned.
+*)
+
+Definition fe_ofs_arg := 0.
+
+Definition make_env (b: bounds) : frame_env :=
+  let olink := align (4 * b.(bound_outgoing)) 8 in  (* back link *)
+  let oretaddr := olink + 8 in                      (* return address *)
+  let ocs := oretaddr + 8 in                        (* callee-saves *)
+  let ol :=  align (size_callee_save_area b ocs) 8 in (* locals *)
+  let ostkdata := align (ol + 4 * b.(bound_local)) 8 in (* stack data *)
+  let sz := align (ostkdata + b.(bound_stack_data)) 16 in
+  {| fe_size := sz;
+     fe_ofs_link := olink;
+     fe_ofs_retaddr := oretaddr;
+     fe_ofs_local := ol;
+     fe_ofs_callee_save := ocs;
+     fe_stack_data := ostkdata;
+     fe_used_callee_save := b.(used_callee_save) |}.
+
+Lemma frame_env_separated:
+  forall b sp m P,
+  let fe := make_env b in
+  m |= range sp 0 (fe_stack_data fe) ** range sp (fe_stack_data fe + bound_stack_data b) (fe_size fe) ** P ->
+  m |= range sp (fe_ofs_local fe) (fe_ofs_local fe + 4 * bound_local b)
+       ** range sp fe_ofs_arg (fe_ofs_arg + 4 * bound_outgoing b)
+       ** range sp (fe_ofs_link fe) (fe_ofs_link fe + size_chunk Mptr)
+       ** range sp (fe_ofs_retaddr fe) (fe_ofs_retaddr fe + size_chunk Mptr)
+       ** range sp (fe_ofs_callee_save fe) (size_callee_save_area b (fe_ofs_callee_save fe))
+       ** P.
+Proof.
+Local Opaque Z.add Z.mul sepconj range.
+  intros; simpl.
+  set (olink := align (4 * b.(bound_outgoing)) 8).
+  set (oretaddr := olink + 8).
+  set (ocs := oretaddr + 8).
+  set (ol :=  align (size_callee_save_area b ocs) 8).
+  set (ostkdata := align (ol + 4 * b.(bound_local)) 8).
+  change (size_chunk Mptr) with 8.
+  generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros.
+  assert (0 <= 4 * b.(bound_outgoing)) by omega.
+  assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; omega).
+  assert (olink + 8 <= oretaddr) by (unfold oretaddr; omega).
+  assert (oretaddr + 8 <= ocs) by (unfold ocs; omega).
+  assert (ocs <= size_callee_save_area b ocs) by (apply size_callee_save_area_incr). 
+  assert (size_callee_save_area b ocs <= ol) by (apply align_le; omega).
+  assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; omega).
+(* Reorder as:
+     outgoing
+     back link
+     retaddr
+     callee-save
+     local *)
+  rewrite sep_swap12.
+  rewrite sep_swap23.
+  rewrite sep_swap34.
+  rewrite sep_swap45.
+(* Apply range_split and range_split2 repeatedly *)
+  unfold fe_ofs_arg.
+  apply range_split_2. fold olink; omega. omega.
+  apply range_split. omega.
+  apply range_split. omega.
+  apply range_split_2. fold ol. omega. omega.
+  apply range_drop_right with ostkdata. omega.
+  eapply sep_drop2. eexact H.
+Qed.
+
+Lemma frame_env_range:
+  forall b,
+  let fe := make_env b in
+  0 <= fe_stack_data fe /\ fe_stack_data fe + bound_stack_data b <= fe_size fe.
+Proof.
+  intros; simpl.
+  set (olink := align (4 * b.(bound_outgoing)) 8).
+  set (oretaddr := olink + 8).
+  set (ocs := oretaddr + 8).
+  set (ol :=  align (size_callee_save_area b ocs) 8).
+  set (ostkdata := align (ol + 4 * b.(bound_local)) 8).
+  generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros.
+  assert (0 <= 4 * b.(bound_outgoing)) by omega.
+  assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; omega).
+  assert (olink + 8 <= oretaddr) by (unfold oretaddr; omega).
+  assert (oretaddr + 8 <= ocs) by (unfold ocs; omega).
+  assert (ocs <= size_callee_save_area b ocs) by (apply size_callee_save_area_incr). 
+  assert (size_callee_save_area b ocs <= ol) by (apply align_le; omega).
+  assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; omega).
+  split. omega. apply align_le. omega. 
+Qed.
+
+Lemma frame_env_aligned:
+  forall b,
+  let fe := make_env b in
+     (8 | fe_ofs_arg)
+  /\ (8 | fe_ofs_local fe)
+  /\ (8 | fe_stack_data fe)
+  /\ (align_chunk Mptr | fe_ofs_link fe)
+  /\ (align_chunk Mptr | fe_ofs_retaddr fe).
+Proof.
+  intros; simpl.
+  set (olink := align (4 * b.(bound_outgoing)) 8).
+  set (oretaddr := olink + 8).
+  set (ocs := oretaddr + 8).
+  set (ol :=  align (size_callee_save_area b ocs) 8).
+  set (ostkdata := align (ol + 4 * b.(bound_local)) 8).
+  change (align_chunk Mptr) with 8.
+  split. apply Z.divide_0_r.
+  split. apply align_divides; omega.
+  split. apply align_divides; omega.
+  split. apply align_divides; omega.
+  apply Z.divide_add_r. apply align_divides; omega. apply Z.divide_refl.
+Qed.
diff --git a/aarch64/TargetPrinter.ml b/aarch64/TargetPrinter.ml
new file mode 100644
index 00000000..e54673dd
--- /dev/null
+++ b/aarch64/TargetPrinter.ml
@@ -0,0 +1,592 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Printing AArch64 assembly code in asm syntax *)
+
+open Printf
+open Camlcoq
+open Sections
+open AST
+open Asm
+open AisAnnot
+open PrintAsmaux
+open Fileinfo
+
+(* Recognition of FP numbers that are supported by the fmov #imm instructions:
+   "a normalized binary floating point encoding with 1 sign bit,
+    4 bits of fraction and a 3-bit exponent"
+*)
+
+let is_immediate_float64 bits =
+  let exp = (Int64.(to_int (shift_right_logical bits 52)) land 0x7FF) - 1023 in
+  let mant = Int64.logand bits 0xF_FFFF_FFFF_FFFFL in
+  exp >= -3 && exp <= 4 && Int64.logand mant 0xF_0000_0000_0000L = mant
+
+let is_immediate_float32 bits =
+  let exp = (Int32.(to_int (shift_right_logical bits 23)) land 0xFF) - 127 in
+  let mant = Int32.logand bits 0x7F_FFFFl in
+  exp >= -3 && exp <= 4 && Int32.logand mant 0x78_0000l = mant
+
+(* Module containing the printing functions *)
+
+module Target : TARGET =
+  struct
+
+(* Basic printing functions *)
+
+    let comment = "//"
+
+    let symbol        = elf_symbol
+    let symbol_offset = elf_symbol_offset
+    let label         = elf_label
+
+    let print_label oc lbl = label oc (transl_label lbl)
+
+    let intsz oc (sz, n) =
+      match sz with X -> coqint64 oc n | W -> coqint oc n
+
+    let xreg_name = function
+    | X0 -> "x0"   | X1 -> "x1"   | X2 -> "x2"   | X3 -> "x3"
+    | X4 -> "x4"   | X5 -> "x5"   | X6 -> "x6"   | X7 -> "x7"
+    | X8 -> "x8"   | X9 -> "x9"   | X10 -> "x10" | X11 -> "x11"
+    | X12 -> "x12" | X13 -> "x13" | X14 -> "x14" | X15 -> "x15"
+    | X16 -> "x16" | X17 -> "x17" | X18 -> "x18" | X19 -> "x19"
+    | X20 -> "x20" | X21 -> "x21" | X22 -> "x22" | X23 -> "x23"
+    | X24 -> "x24" | X25 -> "x25" | X26 -> "x26" | X27 -> "x27"
+    | X28 -> "x28" | X29 -> "x29" | X30 -> "x30"
+
+    let wreg_name = function
+    | X0 -> "w0"   | X1 -> "w1"   | X2 -> "w2"   | X3 -> "w3"
+    | X4 -> "w4"   | X5 -> "w5"   | X6 -> "w6"   | X7 -> "w7"
+    | X8 -> "w8"   | X9 -> "w9"   | X10 -> "w10" | X11 -> "w11"
+    | X12 -> "w12" | X13 -> "w13" | X14 -> "w14" | X15 -> "w15"
+    | X16 -> "w16" | X17 -> "w17" | X18 -> "w18" | X19 -> "w19"
+    | X20 -> "w20" | X21 -> "w21" | X22 -> "w22" | X23 -> "w23"
+    | X24 -> "w24" | X25 -> "w25" | X26 -> "w26" | X27 -> "w27"
+    | X28 -> "w28" | X29 -> "w29" | X30 -> "w30"
+
+    let xreg0_name = function RR0 r -> xreg_name r | XZR -> "xzr"
+    let wreg0_name = function RR0 r -> wreg_name r | XZR -> "wzr"
+
+    let xregsp_name = function RR1 r -> xreg_name r | XSP -> "sp"
+    let wregsp_name = function RR1 r -> wreg_name r | XSP -> "wsp"
+
+    let dreg_name = function
+    | D0 -> "d0"   | D1 -> "d1"   | D2 -> "d2"   | D3 -> "d3"
+    | D4 -> "d4"   | D5 -> "d5"   | D6 -> "d6"   | D7 -> "d7"
+    | D8 -> "d8"   | D9 -> "d9"   | D10 -> "d10" | D11 -> "d11"
+    | D12 -> "d12" | D13 -> "d13" | D14 -> "d14" | D15 -> "d15"
+    | D16 -> "d16" | D17 -> "d17" | D18 -> "d18" | D19 -> "d19"
+    | D20 -> "d20" | D21 -> "d21" | D22 -> "d22" | D23 -> "d23"
+    | D24 -> "d24" | D25 -> "d25" | D26 -> "d26" | D27 -> "d27"
+    | D28 -> "d28" | D29 -> "d29" | D30 -> "d30" | D31 -> "d31"
+
+    let sreg_name = function
+    | D0 -> "s0"   | D1 -> "s1"   | D2 -> "s2"   | D3 -> "s3"
+    | D4 -> "s4"   | D5 -> "s5"   | D6 -> "s6"   | D7 -> "s7"
+    | D8 -> "s8"   | D9 -> "s9"   | D10 -> "s10" | D11 -> "s11"
+    | D12 -> "s12" | D13 -> "s13" | D14 -> "s14" | D15 -> "s15"
+    | D16 -> "s16" | D17 -> "s17" | D18 -> "s18" | D19 -> "s19"
+    | D20 -> "s20" | D21 -> "s21" | D22 -> "s22" | D23 -> "s23"
+    | D24 -> "s24" | D25 -> "s25" | D26 -> "s26" | D27 -> "s27"
+    | D28 -> "s28" | D29 -> "s29" | D30 -> "s30" | D31 -> "s31"
+
+    let xreg oc r = output_string oc (xreg_name r)
+    let wreg oc r = output_string oc (wreg_name r)
+    let ireg oc (sz, r) =
+      output_string oc (match sz with X -> xreg_name r | W -> wreg_name r)
+
+    let xreg0 oc r = output_string oc (xreg0_name r)
+    let wreg0 oc r = output_string oc (wreg0_name r)
+    let ireg0 oc (sz, r) =
+      output_string oc (match sz with X -> xreg0_name r | W -> wreg0_name r)
+
+    let xregsp oc r = output_string oc (xregsp_name r)
+    let iregsp oc (sz, r) =
+      output_string oc (match sz with X -> xregsp_name r | W -> wregsp_name r)
+
+    let dreg oc r = output_string oc (dreg_name r)
+    let sreg oc r = output_string oc (sreg_name r)
+    let freg oc (sz, r) =
+      output_string oc (match sz with D -> dreg_name r | S -> sreg_name r)
+
+    let preg_asm oc ty = function
+      | IR r -> if ty = Tint then wreg oc r else xreg oc r
+      | FR r -> if ty = Tsingle then sreg oc r else dreg oc r
+      | _    -> assert false
+
+    let preg_annot = function
+      | IR r -> xreg_name r
+      | FR r -> dreg_name r
+      | _ -> assert false
+
+(* Names of sections *)
+
+    let name_of_section = function
+      | Section_text         -> ".text"
+      | Section_data i | Section_small_data i ->
+          if i then ".data" else common_section ()
+      | Section_const i | Section_small_const i ->
+          if i || (not !Clflags.option_fcommon) then ".section	.rodata" else "COMM"
+      | Section_string       -> ".section	.rodata"
+      | Section_literal      -> ".section	.rodata"
+      | Section_jumptable    -> ".section	.rodata"
+      | Section_debug_info _ -> ".section	.debug_info,\"\",%progbits"
+      | Section_debug_loc    -> ".section	.debug_loc,\"\",%progbits"
+      | Section_debug_abbrev -> ".section	.debug_abbrev,\"\",%progbits"
+      | Section_debug_line _ -> ".section	.debug_line,\"\",%progbits"
+      | Section_debug_ranges -> ".section	.debug_ranges,\"\",%progbits"
+      | Section_debug_str    -> ".section	.debug_str,\"MS\",%progbits,1"
+      | Section_user(s, wr, ex) ->
+          sprintf ".section	\"%s\",\"a%s%s\",%%progbits"
+            s (if wr then "w" else "") (if ex then "x" else "")
+      | Section_ais_annotation -> sprintf ".section	\"__compcert_ais_annotations\",\"\",@note"
+
+    let section oc sec =
+      fprintf oc "	%s\n" (name_of_section sec)
+
+(* Associate labels to floating-point constants and to symbols. *)
+
+    let emit_constants oc lit =
+      if exists_constants () then begin
+         section oc lit;
+         if Hashtbl.length literal64_labels > 0 then
+           begin
+             fprintf oc "	.balign 8\n";
+             Hashtbl.iter
+               (fun bf lbl -> fprintf oc "%a:	.quad	0x%Lx\n" label lbl bf)
+               literal64_labels
+           end;
+         if Hashtbl.length literal32_labels > 0 then
+           begin
+             fprintf oc "	.balign	4\n";
+             Hashtbl.iter
+               (fun bf lbl ->
+                  fprintf oc "%a:	.long	0x%lx\n" label lbl bf)
+               literal32_labels
+           end;
+         reset_literals ()
+      end
+
+(* Emit .file / .loc debugging directives *)
+
+    let print_file_line oc file line =
+      print_file_line oc comment file line
+
+(* Name of testable condition *)
+
+    let condition_name = function
+      | TCeq -> "eq"
+      | TCne -> "ne"
+      | TChs -> "hs"
+      | TClo -> "lo"
+      | TCmi -> "mi"
+      | TCpl -> "pl"
+      | TChi -> "hi"
+      | TCls -> "ls"
+      | TCge -> "ge"
+      | TClt -> "lt"
+      | TCgt -> "gt"
+      | TCle -> "le"
+
+(* Print an addressing mode *)
+
+    let addressing oc = function
+    | ADimm(base, n) -> fprintf oc "[%a, #%a]" xregsp base coqint64 n
+    | ADreg(base, r) -> fprintf oc "[%a, %a]" xregsp base xreg r
+    | ADlsl(base, r, n) -> fprintf oc "[%a, %a, lsl #%a]" xregsp base xreg r coqint n
+    | ADsxt(base, r, n) -> fprintf oc "[%a, %a, sxtw #%a]" xregsp base wreg r coqint n
+    | ADuxt(base, r, n) -> fprintf oc "[%a, %a, uxtw #%a]" xregsp base wreg r coqint n
+    | ADadr(base, id, ofs) -> fprintf oc "[%a, #:lo12:%a]" xregsp base symbol_offset (id, ofs)
+    | ADpostincr(base, n) -> fprintf oc "[%a], #%a" xregsp base coqint64 n
+
+(* Print a shifted operand *)
+    let shiftop oc = function
+    | SOnone -> ()
+    | SOlsl n -> fprintf oc ", lsl #%a" coqint n
+    | SOlsr n -> fprintf oc ", lsr #%a" coqint n
+    | SOasr n -> fprintf oc ", asr #%a" coqint n
+    | SOror n -> fprintf oc ", ror #%a" coqint n
+
+(* Print a sign- or zero-extended operand *)
+    let extendop oc = function
+    | EOsxtb n -> fprintf oc ", sxtb #%a" coqint n
+    | EOsxth n -> fprintf oc ", sxth #%a" coqint n
+    | EOsxtw n -> fprintf oc ", sxtw #%a" coqint n
+    | EOuxtb n -> fprintf oc ", uxtb #%a" coqint n
+    | EOuxth n -> fprintf oc ", uxth #%a" coqint n
+    | EOuxtw n -> fprintf oc ", uxtw #%a" coqint n
+    | EOuxtx n -> fprintf oc ", uxtx #%a" coqint n
+
+(* Printing of instructions *)
+    let print_instruction oc = function
+    (* Branches *)
+    | Pb lbl ->
+        fprintf oc "	b	%a\n" print_label lbl
+    | Pbc(c, lbl) ->
+        fprintf oc "	b.%s	%a\n" (condition_name c) print_label lbl
+    | Pbl(id, sg) ->
+        fprintf oc "	bl	%a\n" symbol id
+    | Pbs(id, sg) ->
+        fprintf oc "	b	%a\n" symbol id
+    | Pblr(r, sg) ->
+        fprintf oc "	blr	%a\n" xreg r
+    | Pbr(r, sg) ->
+        fprintf oc "	br	%a\n" xreg r
+    | Pret r ->
+        fprintf oc "	ret	%a\n" xreg r
+    | Pcbnz(sz, r, lbl) ->
+        fprintf oc "	cbnz	%a, %a\n" ireg (sz, r) print_label lbl
+    | Pcbz(sz, r, lbl) ->
+        fprintf oc "	cbz	%a, %a\n" ireg (sz, r) print_label lbl
+    | Ptbnz(sz, r, n, lbl) ->
+        fprintf oc "	tbnz	%a, #%a, %a\n" ireg (sz, r) coqint n print_label lbl
+    | Ptbz(sz, r, n, lbl) ->
+        fprintf oc "	tbz	%a, #%a, %a\n" ireg (sz, r) coqint n print_label lbl
+    (* Memory loads and stores *)
+    | Pldrw(rd, a) | Pldrw_a(rd, a) ->
+        fprintf oc "	ldr	%a, %a\n" wreg rd addressing a
+    | Pldrx(rd, a) | Pldrx_a(rd, a) ->
+        fprintf oc "	ldr	%a, %a\n" xreg rd addressing a
+    | Pldrb(sz, rd, a) ->
+        fprintf oc "	ldrb	%a, %a\n" wreg rd addressing a
+    | Pldrsb(sz, rd, a) ->
+        fprintf oc "	ldrsb	%a, %a\n" ireg (sz, rd) addressing a
+    | Pldrh(sz, rd, a) ->
+        fprintf oc "	ldrh	%a, %a\n" wreg rd addressing a
+    | Pldrsh(sz, rd, a) ->
+        fprintf oc "	ldrsh	%a, %a\n" ireg (sz, rd) addressing a
+    | Pldrzw(rd, a) ->
+        fprintf oc "	ldr	%a, %a\n" wreg rd addressing a
+        (* the upper 32 bits of Xrd are set to 0, performing zero-extension *)
+    | Pldrsw(rd, a) ->
+        fprintf oc "	ldrsw	%a, %a\n" xreg rd addressing a
+    | Pldp(rd1, rd2, a) ->
+        fprintf oc "	ldp	%a, %a, %a\n" xreg rd1 xreg rd2 addressing a
+    | Pstrw(rs, a) | Pstrw_a(rs, a) ->
+        fprintf oc "	str	%a, %a\n" wreg rs addressing a
+    | Pstrx(rs, a) | Pstrx_a(rs, a) ->
+        fprintf oc "	str	%a, %a\n" xreg rs addressing a
+    | Pstrb(rs, a) ->
+        fprintf oc "	strb	%a, %a\n" wreg rs addressing a
+    | Pstrh(rs, a) ->
+        fprintf oc "	strh	%a, %a\n" wreg rs addressing a
+    | Pstp(rs1, rs2, a) ->
+        fprintf oc "	stp	%a, %a, %a\n" xreg rs1 xreg rs2 addressing a
+    (* Integer arithmetic, immediate *)
+    | Paddimm(sz, rd, r1, n) ->
+        fprintf oc "	add	%a, %a, #%a\n" iregsp (sz, rd) iregsp (sz, r1) intsz (sz, n)
+    | Psubimm(sz, rd, r1, n) ->
+        fprintf oc "	sub	%a, %a, #%a\n" iregsp (sz, rd) iregsp (sz, r1) intsz (sz, n)
+    | Pcmpimm(sz, r1, n) ->
+        fprintf oc "	cmp	%a, #%a\n" ireg (sz, r1) intsz (sz, n)
+    | Pcmnimm(sz, r1, n) ->
+        fprintf oc "	cmn	%a, #%a\n" ireg (sz, r1) intsz (sz, n)
+    (* Move integer register *)
+    | Pmov(rd, r1) ->
+        fprintf oc "	mov	%a, %a\n" xregsp rd xregsp r1
+    (* Logical, immediate *)
+    | Pandimm(sz, rd, r1, n) ->
+        fprintf oc "	and	%a, %a, #%a\n" ireg (sz, rd) ireg0 (sz, r1) intsz (sz, n)
+    | Peorimm(sz, rd, r1, n) ->
+        fprintf oc "	eor	%a, %a, #%a\n" ireg (sz, rd) ireg0 (sz, r1) intsz (sz, n)
+    | Porrimm(sz, rd, r1, n) ->
+        fprintf oc "	orr	%a, %a, #%a\n" ireg (sz, rd) ireg0 (sz, r1) intsz (sz, n)
+    | Ptstimm(sz, r1, n) ->
+        fprintf oc "	tst	%a, #%a\n" ireg (sz, r1) intsz (sz, n)
+    (* Move wide immediate *)
+    | Pmovz(sz, rd, n, pos) ->
+        fprintf oc "	movz	%a, #%d, lsl #%d\n" ireg (sz, rd) (Z.to_int n) (Z.to_int pos)
+    | Pmovn(sz, rd, n, pos) ->
+        fprintf oc "	movn	%a, #%d, lsl #%d\n" ireg (sz, rd) (Z.to_int n) (Z.to_int pos)
+    | Pmovk(sz, rd, n, pos) ->
+        fprintf oc "	movk	%a, #%d, lsl #%d\n" ireg (sz, rd) (Z.to_int n) (Z.to_int pos)
+    (* PC-relative addressing *)
+    | Padrp(rd, id, ofs) ->
+        fprintf oc "	adrp	%a, %a\n" xreg rd symbol_offset (id, ofs)
+    | Paddadr(rd, r1, id, ofs) ->
+        fprintf oc "	add	%a, %a, #:lo12:%a\n" xreg rd xreg r1 symbol_offset (id, ofs)
+    (* Bit-field operations *)
+    | Psbfiz(sz, rd, r1, r, s) ->
+        fprintf oc "	sbfiz	%a, %a, %a, %d\n" ireg (sz, rd) ireg (sz, r1) coqint r (Z.to_int s)
+    | Psbfx(sz, rd, r1, r, s) ->
+        fprintf oc "	sbfx	%a, %a, %a, %d\n" ireg (sz, rd) ireg (sz, r1) coqint r (Z.to_int s)
+    | Pubfiz(sz, rd, r1, r, s) ->
+        fprintf oc "	ubfiz	%a, %a, %a, %d\n" ireg (sz, rd) ireg (sz, r1) coqint r (Z.to_int s)
+    | Pubfx(sz, rd, r1, r, s) ->
+        fprintf oc "	ubfx	%a, %a, %a, %d\n" ireg (sz, rd) ireg (sz, r1) coqint r (Z.to_int s)
+    (* Integer arithmetic, shifted register *)
+    | Padd(sz, rd, r1, r2, s) ->
+        fprintf oc "	add	%a, %a, %a%a\n" ireg (sz, rd) ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    | Psub(sz, rd, r1, r2, s) ->
+        fprintf oc "	sub	%a, %a, %a%a\n" ireg (sz, rd) ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    | Pcmp(sz, r1, r2, s) ->
+        fprintf oc "	cmp	%a, %a%a\n" ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    | Pcmn(sz, r1, r2, s) ->
+        fprintf oc "	cmn	%a, %a%a\n" ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    (* Integer arithmetic, extending register *)
+    | Paddext(rd, r1, r2, x) ->
+        fprintf oc "	add	%a, %a, %a%a\n" xregsp rd xregsp r1 wreg r2 extendop x
+    | Psubext(rd, r1, r2, x) ->
+        fprintf oc "	sub	%a, %a, %a%a\n" xregsp rd xregsp r1 wreg r2 extendop x
+    | Pcmpext(r1, r2, x) ->
+        fprintf oc "	cmp	%a, %a%a\n" xreg r1 wreg r2 extendop x
+    | Pcmnext(r1, r2, x) ->
+        fprintf oc "	cmn	%a, %a%a\n" xreg r1 wreg r2 extendop x
+    (* Logical, shifted register *)
+    | Pand(sz, rd, r1, r2, s) ->
+        fprintf oc "	and	%a, %a, %a%a\n" ireg (sz, rd) ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    | Pbic(sz, rd, r1, r2, s) ->
+        fprintf oc "	bic	%a, %a, %a%a\n" ireg (sz, rd) ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    | Peon(sz, rd, r1, r2, s) ->
+        fprintf oc "	eon	%a, %a, %a%a\n" ireg (sz, rd) ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    | Peor(sz, rd, r1, r2, s) ->
+        fprintf oc "	eor	%a, %a, %a%a\n" ireg (sz, rd) ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    | Porr(sz, rd, r1, r2, s) ->
+        fprintf oc "	orr	%a, %a, %a%a\n" ireg (sz, rd) ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    | Porn(sz, rd, r1, r2, s) ->
+        fprintf oc "	orn	%a, %a, %a%a\n" ireg (sz, rd) ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    | Ptst(sz, r1, r2, s) ->
+        fprintf oc "	tst	%a, %a%a\n" ireg0 (sz, r1) ireg (sz, r2) shiftop s
+    (* Variable shifts *)
+    | Pasrv(sz, rd, r1, r2) ->
+        fprintf oc "	asr	%a, %a, %a\n" ireg (sz, rd) ireg (sz, r1) ireg (sz, r2)
+    | Plslv(sz, rd, r1, r2) ->
+        fprintf oc "	lsl	%a, %a, %a\n" ireg (sz, rd) ireg (sz, r1) ireg (sz, r2)
+    | Plsrv(sz, rd, r1, r2) ->
+        fprintf oc "	lsr	%a, %a, %a\n" ireg (sz, rd) ireg (sz, r1) ireg (sz, r2)
+    | Prorv(sz, rd, r1, r2) ->
+        fprintf oc "	ror	%a, %a, %a\n" ireg (sz, rd) ireg (sz, r1) ireg (sz, r2)
+    (* Bit operations *)
+    | Pcls(sz, rd, r1) ->
+        fprintf oc "	cls	%a, %a\n" ireg (sz, rd) ireg (sz, r1)
+    | Pclz(sz, rd, r1) ->
+        fprintf oc "	clz	%a, %a\n" ireg (sz, rd) ireg (sz, r1)
+    | Prev(sz, rd, r1) ->
+        fprintf oc "	rev	%a, %a\n" ireg (sz, rd) ireg (sz, r1)
+    | Prev16(sz, rd, r1) ->
+        fprintf oc "	rev16	%a, %a\n" ireg (sz, rd) ireg (sz, r1)
+    (* Conditional data processing *)
+    | Pcsel(rd, r1, r2, c) ->
+        fprintf oc "	csel	%a, %a, %a, %s\n" xreg rd xreg r1 xreg r2 (condition_name c)
+    | Pcset(rd, c) ->
+        fprintf oc "	cset	%a, %s\n" xreg rd (condition_name c)
+    (* Integer multiply/divide *)
+    | Pmadd(sz, rd, r1, r2, r3) ->
+        fprintf oc "	madd	%a, %a, %a, %a\n" ireg (sz, rd) ireg (sz, r1) ireg (sz, r2) ireg0 (sz, r3)
+    | Pmsub(sz, rd, r1, r2, r3) ->
+        fprintf oc "	msub	%a, %a, %a, %a\n" ireg (sz, rd) ireg (sz, r1) ireg (sz, r2) ireg0 (sz, r3)
+    | Psmulh(rd, r1, r2) ->
+        fprintf oc "	smulh	%a, %a, %a\n" xreg rd xreg r1 xreg r2
+    | Pumulh(rd, r1, r2) ->
+        fprintf oc "	umulh	%a, %a, %a\n" xreg rd xreg r1 xreg r2
+    | Psdiv(sz, rd, r1, r2) ->
+        fprintf oc "	sdiv	%a, %a, %a\n" ireg (sz, rd) ireg (sz, r1) ireg (sz, r2)
+    | Pudiv(sz, rd, r1, r2) ->
+        fprintf oc "	udiv	%a, %a, %a\n" ireg (sz, rd) ireg (sz, r1) ireg (sz, r2)
+    (* Floating-point loads and stores *)
+    | Pldrs(rd, a) ->
+        fprintf oc "	ldr	%a, %a\n" sreg rd addressing a
+    | Pldrd(rd, a) | Pldrd_a(rd, a) ->
+        fprintf oc "	ldr	%a, %a\n" dreg rd addressing a
+    | Pstrs(rd, a) ->
+        fprintf oc "	str	%a, %a\n" sreg rd addressing a
+    | Pstrd(rd, a) | Pstrd_a(rd, a) ->
+        fprintf oc "	str	%a, %a\n" dreg rd addressing a
+    (* Floating-point move *)
+    | Pfmov(rd, r1) ->
+        fprintf oc "	fmov	%a, %a\n" dreg rd dreg r1
+    | Pfmovimmd(rd, f) ->
+        let d = camlint64_of_coqint (Floats.Float.to_bits f) in
+        if is_immediate_float64 d then
+          fprintf oc "	fmov	%a, #%.7f\n" dreg rd (Int64.float_of_bits d)
+        else begin
+          let lbl = label_literal64 d in
+          fprintf oc "	adrp	x16, %a\n" label lbl;
+          fprintf oc "	ldr	%a, [x16, #:lo12:%a] %s %.18g\n" dreg rd label lbl comment (Int64.float_of_bits d)
+        end
+    | Pfmovimms(rd, f) ->
+        let d = camlint_of_coqint (Floats.Float32.to_bits f) in
+        if is_immediate_float32 d then
+          fprintf oc "	fmov	%a, #%.7f\n" sreg rd (Int32.float_of_bits d)
+        else begin
+          let lbl = label_literal32 d in
+          fprintf oc "	adrp	x16, %a\n" label lbl;
+          fprintf oc "	ldr	%a, [x16, #:lo12:%a] %s %.18g\n" sreg rd label lbl comment (Int32.float_of_bits d)
+        end
+    | Pfmovi(D, rd, r1) ->
+        fprintf oc "	fmov	%a, %a\n" dreg rd xreg0 r1
+    | Pfmovi(S, rd, r1) ->
+        fprintf oc "	fmov	%a, %a\n" sreg rd wreg0 r1
+    (* Floating-point conversions *)
+    | Pfcvtds(rd, r1) ->
+        fprintf oc "	fcvt	%a, %a\n" dreg rd sreg r1 
+    | Pfcvtsd(rd, r1) ->
+        fprintf oc "	fcvt	%a, %a\n" sreg rd dreg r1 
+    | Pfcvtzs(isz, fsz, rd, r1) ->
+        fprintf oc "	fcvtzs  %a, %a\n" ireg (isz, rd) freg (fsz, r1)
+    | Pfcvtzu(isz, fsz, rd, r1) ->
+        fprintf oc "	fcvtzu  %a, %a\n" ireg (isz, rd) freg (fsz, r1)
+    | Pscvtf(fsz, isz, rd, r1) ->
+        fprintf oc "	scvtf	%a, %a\n" freg (fsz, rd) ireg (isz, r1)
+    | Pucvtf(fsz, isz, rd, r1) ->
+        fprintf oc "	ucvtf	%a, %a\n" freg (fsz, rd) ireg (isz, r1)
+    (* Floating-point arithmetic *)
+    | Pfabs(sz, rd, r1) ->
+        fprintf oc "	fabs	%a, %a\n" freg (sz, rd) freg (sz, r1)
+    | Pfneg(sz, rd, r1) ->
+        fprintf oc "	fneg	%a, %a\n" freg (sz, rd) freg (sz, r1)
+    | Pfsqrt(sz, rd, r1) ->
+        fprintf oc "	fsqrt	%a, %a\n" freg (sz, rd) freg (sz, r1)
+    | Pfadd(sz, rd, r1, r2) ->
+        fprintf oc "	fadd	%a, %a, %a\n" freg (sz, rd) freg (sz, r1) freg (sz, r2)
+    | Pfdiv(sz, rd, r1, r2) ->
+        fprintf oc "	fdiv	%a, %a, %a\n" freg (sz, rd) freg (sz, r1) freg (sz, r2)
+    | Pfmul(sz, rd, r1, r2) ->
+        fprintf oc "	fmul	%a, %a, %a\n" freg (sz, rd) freg (sz, r1) freg (sz, r2)
+    | Pfnmul(sz, rd, r1, r2) ->
+        fprintf oc "	fnmul	%a, %a, %a\n" freg (sz, rd) freg (sz, r1) freg (sz, r2)
+    | Pfsub(sz, rd, r1, r2) ->
+        fprintf oc "	fsub	%a, %a, %a\n" freg (sz, rd) freg (sz, r1) freg (sz, r2)
+    | Pfmadd(sz, rd, r1, r2, r3) ->
+        fprintf oc "	fmadd	%a, %a, %a, %a\n" freg (sz, rd) freg (sz, r1) freg (sz, r2) freg (sz, r3)
+    | Pfmsub(sz, rd, r1, r2, r3) ->
+        fprintf oc "	fmsub	%a, %a, %a, %a\n" freg (sz, rd) freg (sz, r1) freg (sz, r2) freg (sz, r3)
+    | Pfnmadd(sz, rd, r1, r2, r3) ->
+        fprintf oc "	fnmadd	%a, %a, %a, %a\n" freg (sz, rd) freg (sz, r1) freg (sz, r2) freg (sz, r3)
+    | Pfnmsub(sz, rd, r1, r2, r3) ->
+        fprintf oc "	fnmsub	%a, %a, %a, %a\n" freg (sz, rd) freg (sz, r1) freg (sz, r2) freg (sz, r3)
+    (* Floating-point comparison *)
+    | Pfcmp(sz, r1, r2) ->
+        fprintf oc "	fcmp	%a, %a\n" freg (sz, r1) freg (sz, r2)
+    | Pfcmp0(sz, r1) ->
+        fprintf oc "	fcmp	%a, #0.0\n" freg (sz, r1)
+    (* Floating-point conditional select *)
+    | Pfsel(rd, r1, r2, c) ->
+        fprintf oc "	fcsel	%a, %a, %a, %s\n" dreg rd dreg r1 dreg r2 (condition_name c)
+    (* No-op *)
+    | Pnop ->
+        fprintf oc "	nop\n"
+    (* Pseudo-instructions expanded in Asmexpand *)
+    | Pallocframe(sz, linkofs) -> assert false
+    | Pfreeframe(sz, linkofs) -> assert false
+    | Pcvtx2w rd -> assert false
+    (* Pseudo-instructions not yet expanded *)
+    | Plabel lbl ->
+        fprintf oc "%a:\n" print_label lbl
+    | Ploadsymbol(rd, id) ->
+        fprintf oc "	adrp	%a, :got:%a\n" xreg rd symbol id;
+        fprintf oc "	ldr	%a, [%a, #:got_lo12:%a]\n" xreg rd xreg rd symbol id
+    | Pcvtsw2x(rd, r1) ->
+        fprintf oc "	sxtw	%a, %a\n" xreg rd wreg r1
+    | Pcvtuw2x(rd, r1) ->
+        fprintf oc "	uxtw	%a, %a\n" xreg rd wreg r1
+    | Pbtbl(r1, tbl) ->
+        let lbl = new_label() in
+        fprintf oc "	adr	x16, %a\n" label lbl;
+        fprintf oc "	add	x16, x16, %a, uxtw #2\n" wreg r1;
+        fprintf oc "	br	x16\n";
+        fprintf oc "%a:" label lbl;
+        List.iter (fun l -> fprintf oc "	b	%a\n" print_label l) tbl
+    | Pcfi_adjust sz ->
+        cfi_adjust oc (camlint_of_coqint sz)
+    | Pcfi_rel_offset ofs ->
+        cfi_rel_offset oc "lr" (camlint_of_coqint ofs)
+    | Pbuiltin(ef, args, res) ->
+        begin match ef with
+          | EF_annot(kind,txt, targs) ->
+            begin match (P.to_int kind) with
+              | 1 -> let annot = annot_text preg_annot "sp" (camlstring_of_coqstring txt) args  in
+                fprintf oc "%s annotation: %S\n" comment annot
+              | 2 -> let lbl = new_label () in
+                fprintf oc "%a:\n" label lbl;
+                add_ais_annot lbl preg_annot "sp" (camlstring_of_coqstring txt) args
+              | _ -> assert false
+            end
+         | EF_debug(kind, txt, targs) ->
+             print_debug_info comment print_file_line preg_annot "sp" oc
+                              (P.to_int kind) (extern_atom txt) args
+         | EF_inline_asm(txt, sg, clob) ->
+             fprintf oc "%s begin inline assembly\n\t" comment;
+             print_inline_asm preg_asm oc (camlstring_of_coqstring txt) sg args res;
+             fprintf oc "%s end inline assembly\n" comment
+         | _ ->
+             assert false
+        end
+
+    let get_section_names name =
+      let (text, lit) =
+        match C2C.atom_sections name with
+        | t :: l :: _ -> (t, l)
+        | _    -> (Section_text, Section_literal) in
+      text,lit,Section_jumptable
+
+    let print_align oc alignment =
+      fprintf oc "	.balign %d\n" alignment
+
+    let print_jumptable oc jmptbl =
+      let print_tbl oc (lbl, tbl) =
+        fprintf oc "%a:\n" label lbl;
+        List.iter
+          (fun l -> fprintf oc "	.long	%a - %a\n"
+                               print_label l label lbl)
+          tbl in
+      if !jumptables <> [] then
+        begin
+          section oc jmptbl;
+          fprintf oc "	.balign 4\n";
+          List.iter (print_tbl oc) !jumptables;
+          jumptables := []
+        end
+
+    let print_fun_info = elf_print_fun_info
+
+    let print_optional_fun_info _ = ()
+
+    let print_var_info = elf_print_var_info
+
+    let print_comm_symb oc sz name align =
+      if C2C.atom_is_static name then
+        fprintf oc "	.local	%a\n" symbol name;
+        fprintf oc "	.comm	%a, %s, %d\n"
+        symbol name
+        (Z.to_string sz)
+        align
+
+    let print_instructions oc fn =
+      current_function_sig := fn.fn_sig;
+      List.iter (print_instruction oc) fn.fn_code
+
+(* Data *)
+
+    let address = ".quad"
+
+    let print_prologue oc =
+      if !Clflags.option_g then begin
+        section oc Section_text;
+      end
+
+    let print_epilogue oc =
+      if !Clflags.option_g then begin
+        Debug.compute_gnu_file_enum (fun f -> ignore (print_file oc f));
+        section oc Section_text;
+      end
+
+    let default_falignment = 2
+
+    let cfi_startproc oc = ()
+    let cfi_endproc oc = ()
+
+  end
+
+let sel_target () =
+  (module Target:TARGET)
diff --git a/aarch64/ValueAOp.v b/aarch64/ValueAOp.v
new file mode 100644
index 00000000..e0d98c85
--- /dev/null
+++ b/aarch64/ValueAOp.v
@@ -0,0 +1,319 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+Require Import Coqlib Compopts.
+Require Import AST Integers Floats Values Memory Globalenvs.
+Require Import Op RTL ValueDomain.
+
+(** Value analysis for AArch64 operators *)
+
+Definition eval_static_shift (s: shift) (v: aval) (n: amount32) : aval :=
+  match s with
+  | Slsl => shl v (I n)
+  | Slsr => shru v (I n)
+  | Sasr => shr v (I n)
+  | Sror => ror v (I n)
+  end.
+
+Definition eval_static_shiftl (s: shift) (v: aval) (n: amount64) : aval :=
+  match s with
+  | Slsl => shll v (I n)
+  | Slsr => shrlu v (I n)
+  | Sasr => shrl v (I n)
+  | Sror => rorl v (I n)
+  end.
+
+Definition eval_static_extend (x: extension) (v: aval) (n: amount64) : aval :=
+  shll (match x with Xsgn32 => longofint v | Xuns32 => longofintu v end) (I n).
+
+Definition eval_static_condition (cond: condition) (vl: list aval): abool :=
+  match cond, vl with
+  | Ccomp c, v1 :: v2 :: nil => cmp_bool c v1 v2
+  | Ccompu c, v1 :: v2 :: nil => cmpu_bool c v1 v2
+  | Ccompimm c n, v1 :: nil => cmp_bool c v1 (I n)
+  | Ccompuimm c n, v1 :: nil => cmpu_bool c v1 (I n)
+  | Ccompshift c s a, v1 :: v2 :: nil => cmp_bool c v1 (eval_static_shift s v2 a)
+  | Ccompushift c s a, v1 :: v2 :: nil => cmpu_bool c v1 (eval_static_shift s v2 a)
+  | Cmaskzero m, v1 :: nil => maskzero v1 m
+  | Cmasknotzero m, v1 :: nil => cnot (maskzero v1 m)
+  | Ccompl c, v1 :: v2 :: nil => cmpl_bool c v1 v2
+  | Ccomplu c, v1 :: v2 :: nil => cmplu_bool c v1 v2
+  | Ccomplimm c n, v1 :: nil => cmpl_bool c v1 (L n)
+  | Ccompluimm c n, v1 :: nil => cmplu_bool c v1 (L n)
+  | Ccomplshift c s a, v1 :: v2 :: nil => cmpl_bool c v1 (eval_static_shiftl s v2 a)
+  | Ccomplushift c s a, v1 :: v2 :: nil => cmplu_bool c v1 (eval_static_shiftl s v2 a)
+  | Cmasklzero m, v1 :: nil => cmpl_bool Ceq (andl v1 (L m)) (L Int64.zero)
+  | Cmasklnotzero m, v1 :: nil => cmpl_bool Cne (andl v1 (L m)) (L Int64.zero)
+  | Ccompf c, v1 :: v2 :: nil => cmpf_bool c v1 v2
+  | Cnotcompf c, v1 :: v2 :: nil => cnot (cmpf_bool c v1 v2)
+  | Ccompfzero c, v1 :: nil => cmpf_bool c v1 (F Float.zero)
+  | Cnotcompfzero c, v1 :: nil => cnot (cmpf_bool c v1 (F Float.zero))
+  | Ccompfs c, v1 :: v2 :: nil => cmpfs_bool c v1 v2
+  | Cnotcompfs c, v1 :: v2 :: nil => cnot (cmpfs_bool c v1 v2)
+  | Ccompfszero c, v1 :: nil => cmpfs_bool c v1 (FS Float32.zero)
+  | Cnotcompfszero c, v1 :: nil => cnot (cmpfs_bool c v1 (FS Float32.zero))
+  | _, _ => Bnone
+  end.
+
+Definition eval_static_addressing (addr: addressing) (vl: list aval): aval :=
+  match addr, vl with
+  | Aindexed n, v1 :: nil => addl v1 (L n)
+  | Aindexed2, v1 :: v2 :: nil => addl v1 v2
+  | Aindexed2shift a, v1 :: v2 :: nil => addl v1 (shll v2 (I a))
+  | Aindexed2ext x a, v1 :: v2 :: nil => addl v1 (eval_static_extend x v2 a)
+  | Aglobal s ofs, nil => Ptr (Gl s ofs)
+  | Ainstack ofs, nil => Ptr (Stk ofs)
+  | _, _ => Vbot
+  end.
+
+Definition eval_static_operation (op: operation) (vl: list aval): aval :=
+  match op, vl with
+  | Omove, v1::nil => v1
+  | Ointconst n, nil => I n
+  | Olongconst n, nil => L n
+  | Ofloatconst n, nil => if propagate_float_constants tt then F n else ntop
+  | Osingleconst n, nil => if propagate_float_constants tt then FS n else ntop
+  | Oaddrsymbol id ofs, nil => Ptr (Gl id ofs)
+  | Oaddrstack ofs, nil => Ptr (Stk ofs)
+
+  | Oshift s a, v1::nil => eval_static_shift s v1 a  
+  | Oadd, v1::v2::nil => add v1 v2
+  | Oaddshift s a, v1::v2::nil => add v1 (eval_static_shift s v2 a)
+  | Oaddimm n, v1::nil => add v1 (I n)
+  | Oneg, v1::nil => neg v1
+  | Onegshift s a, v1::nil => neg (eval_static_shift s v1 a)
+  | Osub, v1::v2::nil => sub v1 v2
+  | Osubshift s a, v1::v2::nil => sub v1 (eval_static_shift s v2 a)
+  | Omul, v1::v2::nil => mul v1 v2
+  | Omuladd, v1::v2::v3::nil => add v1 (mul v2 v3)
+  | Omulsub, v1::v2::v3::nil => sub v1 (mul v2 v3)
+  | Odiv, v1::v2::nil => divs v1 v2
+  | Odivu, v1::v2::nil => divu v1 v2
+  | Oand, v1::v2::nil => and v1 v2
+  | Oandshift s a, v1::v2::nil => and v1 (eval_static_shift s v2 a)
+  | Oandimm n, v1::nil => and v1 (I n)
+  | Oor, v1::v2::nil => or v1 v2
+  | Oorshift s a, v1::v2::nil => or v1 (eval_static_shift s v2 a)
+  | Oorimm n, v1::nil => or v1 (I n)
+  | Oxor, v1::v2::nil => xor v1 v2
+  | Oxorshift s a, v1::v2::nil => xor v1 (eval_static_shift s v2 a)
+  | Oxorimm n, v1::nil => xor v1 (I n)
+  | Onot, v1::nil => notint v1
+  | Onotshift s a, v1::nil => notint (eval_static_shift s v1 a)
+  | Obic, v1::v2::nil => and v1 (notint v2)
+  | Obicshift s a, v1::v2::nil => and v1 (notint (eval_static_shift s v2 a))
+  | Oorn, v1::v2::nil => or v1 (notint v2)
+  | Oornshift s a, v1::v2::nil => or v1 (notint (eval_static_shift s v2 a))
+  | Oeqv, v1::v2::nil => xor v1 (notint v2)
+  | Oeqvshift s a, v1::v2::nil => xor v1 (notint (eval_static_shift s v2 a))
+  | Oshl, v1::v2::nil => shl v1 v2
+  | Oshr, v1::v2::nil => shr v1 v2
+  | Oshru, v1::v2::nil => shru v1 v2
+  | Oshrximm n, v1::nil => shrx v1 (I n)
+  | Ozext s, v1::nil => zero_ext s v1
+  | Osext s, v1::nil => sign_ext s v1
+  | Oshlzext s a, v1::nil => shl (zero_ext s v1) (I a)
+  | Oshlsext s a, v1::nil => shl (sign_ext s v1) (I a)
+  | Ozextshr a s, v1::nil => zero_ext s (shru v1 (I a))
+  | Osextshr a s, v1::nil => sign_ext s (shr v1 (I a))
+
+  | Oshiftl s a, v1::nil => eval_static_shiftl s v1 a  
+  | Oextend x a, v1::nil => eval_static_extend x v1 a
+  | Omakelong, v1::v2::nil => longofwords v1 v2
+  | Olowlong, v1::nil => loword v1
+  | Ohighlong, v1::nil => hiword v1
+  | Oaddl, v1::v2::nil => addl v1 v2
+  | Oaddlshift s a, v1::v2::nil => addl v1 (eval_static_shiftl s v2 a)
+  | Oaddlext x a, v1::v2::nil => addl v1 (eval_static_extend x v2 a)
+  | Oaddlimm n, v1::nil => addl v1 (L n)
+  | Onegl, v1::nil => negl v1
+  | Oneglshift s a, v1::nil => negl (eval_static_shiftl s v1 a)
+  | Osubl, v1::v2::nil => subl v1 v2
+  | Osublshift s a, v1::v2::nil => subl v1 (eval_static_shiftl s v2 a)
+  | Osublext x a, v1::v2::nil => subl v1 (eval_static_extend x v2 a)
+  | Omull, v1::v2::nil => mull v1 v2
+  | Omulladd, v1::v2::v3::nil => addl v1 (mull v2 v3)
+  | Omullsub, v1::v2::v3::nil => subl v1 (mull v2 v3)
+  | Omullhs, v1::v2::nil => mullhs v1 v2
+  | Omullhu, v1::v2::nil => mullhu v1 v2
+  | Odivl, v1::v2::nil => divls v1 v2
+  | Odivlu, v1::v2::nil => divlu v1 v2
+  | Oandl, v1::v2::nil => andl v1 v2
+  | Oandlshift s a, v1::v2::nil => andl v1 (eval_static_shiftl s v2 a)
+  | Oandlimm n, v1::nil => andl v1 (L n)
+  | Oorl, v1::v2::nil => orl v1 v2
+  | Oorlshift s a, v1::v2::nil => orl v1 (eval_static_shiftl s v2 a)
+  | Oorlimm n, v1::nil => orl v1 (L n)
+  | Oxorl, v1::v2::nil => xorl v1 v2
+  | Oxorlshift s a, v1::v2::nil => xorl v1 (eval_static_shiftl s v2 a)
+  | Oxorlimm n, v1::nil => xorl v1 (L n)
+  | Onotl, v1::nil => notl v1
+  | Onotlshift s a, v1::nil => notl (eval_static_shiftl s v1 a)
+  | Obicl, v1::v2::nil => andl v1 (notl v2)
+  | Obiclshift s a, v1::v2::nil => andl v1 (notl (eval_static_shiftl s v2 a))
+  | Oornl, v1::v2::nil => orl v1 (notl v2)
+  | Oornlshift s a, v1::v2::nil => orl v1 (notl (eval_static_shiftl s v2 a))
+  | Oeqvl, v1::v2::nil => xorl v1 (notl v2)
+  | Oeqvlshift s a, v1::v2::nil => xorl v1 (notl (eval_static_shiftl s v2 a))
+  | Oshll, v1::v2::nil => shll v1 v2
+  | Oshrl, v1::v2::nil => shrl v1 v2
+  | Oshrlu, v1::v2::nil => shrlu v1 v2
+  | Oshrlximm n, v1::nil => shrxl v1 (I n)
+  | Ozextl s, v1::nil => zero_ext_l s v1
+  | Osextl s, v1::nil => sign_ext_l s v1
+  | Oshllzext s a, v1::nil => shll (zero_ext_l s v1) (I a)
+  | Oshllsext s a, v1::nil => shll (sign_ext_l s v1) (I a)
+  | Ozextshrl a s, v1::nil => zero_ext_l s (shrlu v1 (I a))
+  | Osextshrl a s, v1::nil => sign_ext_l s (shrl v1 (I a))
+
+  | Onegf, v1::nil => negf v1
+  | Oabsf, v1::nil => absf v1
+  | Oaddf, v1::v2::nil => addf v1 v2
+  | Osubf, v1::v2::nil => subf v1 v2
+  | Omulf, v1::v2::nil => mulf v1 v2
+  | Odivf, v1::v2::nil => divf v1 v2
+
+  | Onegfs, v1::nil => negfs v1
+  | Oabsfs, v1::nil => absfs v1
+  | Oaddfs, v1::v2::nil => addfs v1 v2
+  | Osubfs, v1::v2::nil => subfs v1 v2
+  | Omulfs, v1::v2::nil => mulfs v1 v2
+  | Odivfs, v1::v2::nil => divfs v1 v2
+
+  | Osingleoffloat, v1::nil => singleoffloat v1
+  | Ofloatofsingle, v1::nil => floatofsingle v1
+  | Ointoffloat, v1::nil => intoffloat v1
+  | Ointuoffloat, v1::nil => intuoffloat v1
+  | Ofloatofint, v1::nil => floatofint v1
+  | Ofloatofintu, v1::nil => floatofintu v1
+  | Ointofsingle, v1::nil => intofsingle v1
+  | Ointuofsingle, v1::nil => intuofsingle v1
+  | Osingleofint, v1::nil => singleofint v1
+  | Osingleofintu, v1::nil => singleofintu v1
+  | Olongoffloat, v1::nil => longoffloat v1
+  | Olonguoffloat, v1::nil => longuoffloat v1
+  | Ofloatoflong, v1::nil => floatoflong v1
+  | Ofloatoflongu, v1::nil => floatoflongu v1
+  | Olongofsingle, v1::nil => longofsingle v1
+  | Olonguofsingle, v1::nil => longuofsingle v1
+  | Osingleoflong, v1::nil => singleoflong v1
+  | Osingleoflongu, v1::nil => singleoflongu v1
+
+  | Ocmp c, _ => of_optbool (eval_static_condition c vl)
+  | Osel c ty, v1::v2::vl => select (eval_static_condition c vl) v1 v2
+
+  | _, _ => Vbot
+  end.
+
+Section SOUNDNESS.
+
+Variable bc: block_classification.
+Variable ge: genv.
+Hypothesis GENV: genv_match bc ge.
+Variable sp: block.
+Hypothesis STACK: bc sp = BCstack.
+
+Ltac InvHyps :=
+  match goal with
+  | [H: None = Some _ |- _ ] => discriminate
+  | [H: Some _ = Some _ |- _] => inv H
+  | [H1: match ?vl with nil => _ | _ :: _ => _ end = Some _ ,
+     H2: list_forall2 _ ?vl _ |- _ ] => inv H2; InvHyps
+  | _ => idtac
+  end.
+
+Lemma eval_static_shift_sound: forall v av s n,
+  vmatch bc v av -> vmatch bc (eval_shift s v n) (eval_static_shift s av n).
+Proof.
+  intros. unfold eval_shift, eval_static_shift; destruct s; auto with va.
+Qed.
+
+Lemma eval_static_shiftl_sound: forall v av s n,
+  vmatch bc v av -> vmatch bc (eval_shiftl s v n) (eval_static_shiftl s av n).
+Proof.
+  intros. unfold eval_shiftl, eval_static_shiftl; destruct s; auto with va.
+Qed.
+
+Lemma eval_static_extend_sound: forall v av x n,
+  vmatch bc v av -> vmatch bc (eval_extend x v n) (eval_static_extend x av n).
+Proof.
+  intros. unfold eval_extend, eval_static_extend; destruct x; auto with va.
+Qed.
+
+Hint Resolve eval_static_shift_sound eval_static_shiftl_sound eval_static_extend_sound: va.
+
+Theorem eval_static_condition_sound:
+  forall cond vargs m aargs,
+  list_forall2 (vmatch bc) vargs aargs ->
+  cmatch (eval_condition cond vargs m) (eval_static_condition cond aargs).
+Proof.
+  intros until aargs; intros VM. inv VM.
+  destruct cond; auto with va.
+  inv H0.
+  destruct cond; simpl; eauto with va.
+  replace (Val.cmp_bool Ceq (Val.and a1 (Vint n)) (Vint Int.zero))
+     with (Val.maskzero_bool a1 n) by (destruct a1; auto).
+  eauto with va.
+  replace (Val.cmp_bool Cne (Val.and a1 (Vint n)) (Vint Int.zero))
+     with (option_map negb (Val.maskzero_bool a1 n)) by (destruct a1; auto).
+  eauto with va.
+  inv H2.
+  destruct cond; simpl; eauto with va.
+  destruct cond; auto with va.
+Qed.
+
+Lemma symbol_address_sound:
+  forall id ofs,
+  vmatch bc (Genv.symbol_address ge id ofs) (Ptr (Gl id ofs)).
+Proof.
+  intros; apply symbol_address_sound; apply GENV.
+Qed.
+
+Lemma symbol_address_sound_2:
+  forall id ofs,
+  vmatch bc (Genv.symbol_address ge id ofs) (Ifptr (Gl id ofs)).
+Proof.
+  intros. unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) as [b|] eqn:F.
+  constructor. constructor. apply GENV; auto.
+  constructor.
+Qed.
+
+Hint Resolve symbol_address_sound symbol_address_sound_2: va.
+
+Theorem eval_static_addressing_sound:
+  forall addr vargs vres aargs,
+  eval_addressing ge (Vptr sp Ptrofs.zero) addr vargs = Some vres ->
+  list_forall2 (vmatch bc) vargs aargs ->
+  vmatch bc vres (eval_static_addressing addr aargs).
+Proof.
+  unfold eval_addressing, eval_static_addressing; intros;
+  destruct addr; InvHyps; eauto with va.
+  rewrite Ptrofs.add_zero_l; eauto with va.
+Qed.
+
+Theorem eval_static_operation_sound:
+  forall op vargs m vres aargs,
+  eval_operation ge (Vptr sp Ptrofs.zero) op vargs m = Some vres ->
+  list_forall2 (vmatch bc) vargs aargs ->
+  vmatch bc vres (eval_static_operation op aargs).
+Proof.
+  unfold eval_operation, eval_static_operation; intros;
+  destruct op; InvHyps; eauto with va.
+  destruct (propagate_float_constants tt); constructor.
+  destruct (propagate_float_constants tt); constructor.
+  rewrite Ptrofs.add_zero_l; eauto with va.
+  apply of_optbool_sound. eapply eval_static_condition_sound; eauto.
+  apply select_sound; eauto using eval_static_condition_sound.
+Qed.
+
+End SOUNDNESS.
+
diff --git a/aarch64/extractionMachdep.v b/aarch64/extractionMachdep.v
new file mode 100644
index 00000000..e82056e2
--- /dev/null
+++ b/aarch64/extractionMachdep.v
@@ -0,0 +1,24 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*         Xavier Leroy, Collège de France and INRIA Paris             *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Additional extraction directives specific to the AArch64 port *)
+
+Require Archi Asm.
+
+(* Archi *)
+
+Extract Constant Archi.pic_code => "fun () -> false".  (* for the time being *)
+
+(* Asm *)
+Extract Constant Asm.symbol_low => "fun _ _ _ -> assert false".
+Extract Constant Asm.symbol_high => "fun _ _ _ -> assert false".
+Extract Constant Asmgen.symbol_is_aligned => "C2C.atom_is_aligned".
diff --git a/arm/Archi.v b/arm/Archi.v
index 39a424ec..16d6c71d 100644
--- a/arm/Archi.v
+++ b/arm/Archi.v
@@ -16,7 +16,7 @@
 
 (** Architecture-dependent parameters for ARM *)
 
-Require Import ZArith.
+Require Import ZArith List.
 (*From Flocq*)
 Require Import Binary Bits.
 
@@ -34,30 +34,57 @@ Proof.
   unfold splitlong, ptr64; congruence.
 Qed.
 
-Definition default_nan_64 : { x : binary64 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 53 1024 false (iter_nat 51 _ xO xH) (eq_refl true)) (eq_refl true).
+Definition default_nan_64 := (false, iter_nat 51 _ xO xH).
+Definition default_nan_32 := (false, iter_nat 22 _ xO xH).
+
+(** Choose the first signaling NaN, if any;
+    otherwise choose the first NaN;
+    otherwise use default. *)
+
+Definition choose_nan (is_signaling: positive -> bool) 
+                      (default: bool * positive)
+                      (l0: list (bool * positive)) : bool * positive :=
+  let fix choose_snan (l1: list (bool * positive)) :=
+    match l1 with
+    | nil =>
+        match l0 with nil => default | n :: _ => n end
+    | ((s, p) as n) :: l1 =>
+        if is_signaling p then n else choose_snan l1
+    end
+  in choose_snan l0.
+
+Lemma choose_nan_idem: forall is_signaling default n,
+  choose_nan is_signaling default (n :: n :: nil) =
+  choose_nan is_signaling default (n :: nil).
+Proof.
+  intros. destruct n as [s p]; unfold choose_nan; simpl.
+  destruct (is_signaling p); auto. 
+Qed.
+
+Definition choose_nan_64 :=
+  choose_nan (fun p => negb (Pos.testbit p 51)) default_nan_64.
+
+Definition choose_nan_32 :=
+  choose_nan (fun p => negb (Pos.testbit p 22)) default_nan_32.
 
-Definition choose_binop_pl_64 (pl1 pl2 : positive) :=
-  (** Choose second NaN if pl2 is sNaN but pl1 is qNan.
-      In all other cases, choose first NaN *)
-  (Pos.testbit pl1 51 && negb (Pos.testbit pl2 51))%bool.
+Lemma choose_nan_64_idem: forall n,
+  choose_nan_64 (n :: n :: nil) = choose_nan_64 (n :: nil).
+Proof. intros; apply choose_nan_idem. Qed.
 
-Definition default_nan_32 : { x : binary32 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 24 128 false (iter_nat 22 _ xO xH) (eq_refl true)) (eq_refl true).
+Lemma choose_nan_32_idem: forall n,
+  choose_nan_32 (n :: n :: nil) = choose_nan_32 (n :: nil).
+Proof. intros; apply choose_nan_idem. Qed.
 
-Definition choose_binop_pl_32 (pl1 pl2 : positive) :=
-  (** Choose second NaN if pl2 is sNaN but pl1 is qNan.
-      In all other cases, choose first NaN *)
-  (Pos.testbit pl1 22 && negb (Pos.testbit pl2 22))%bool.
+Definition fma_order {A: Type} (x y z: A) := (z, x, y).
 
-Definition fpu_returns_default_qNaN := false.
+Definition fma_invalid_mul_is_nan := true.
 
 Definition float_of_single_preserves_sNaN := false.
 
 Global Opaque ptr64 big_endian splitlong
-              default_nan_64 choose_binop_pl_64
-              default_nan_32 choose_binop_pl_32
-              fpu_returns_default_qNaN
+              default_nan_64 choose_nan_64
+              default_nan_32 choose_nan_32
+              fma_order fma_invalid_mul_is_nan
               float_of_single_preserves_sNaN.
 
 (** Which ABI to use: either the standard ARM EABI with floats passed
diff --git a/arm/Asm.v b/arm/Asm.v
index e6d1b4fc..194074ac 100644
--- a/arm/Asm.v
+++ b/arm/Asm.v
@@ -220,6 +220,7 @@ Inductive instruction : Type :=
   | Plabel: label -> instruction                    (**r define a code label *)
   | Ploadsymbol: ireg -> ident -> ptrofs -> instruction (**r load the address of a symbol *)
   | Pmovite: testcond -> ireg -> shift_op -> shift_op -> instruction (**r integer conditional move *)
+  | Pfmovite: testcond -> freg -> freg -> freg -> instruction (**r FP conditional move *)
   | Pbtbl: ireg -> list label -> instruction       (**r N-way branch through a jump table *)
   | Pbuiltin: external_function -> list (builtin_arg preg) -> builtin_res preg -> instruction (**r built-in function (pseudo) *)
   | Padc: ireg -> ireg -> shift_op -> instruction     (**r add with carry *)
@@ -783,6 +784,14 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out
         | None => Vundef
         end in
       Next (nextinstr (rs#r1 <- v)) m
+  | Pfmovite cond r1 ifso ifnot =>
+      let v :=
+        match eval_testcond cond rs with
+        | Some true => rs#ifso
+        | Some false => rs#ifnot
+        | None => Vundef
+        end in
+      Next (nextinstr (rs#r1 <- v)) m
   | Pbtbl r tbl =>
       match rs#r with
       | Vint n =>
diff --git a/arm/AsmToJSON.ml b/arm/AsmToJSON.ml
index 3874e141..e850fed6 100644
--- a/arm/AsmToJSON.ml
+++ b/arm/AsmToJSON.ml
@@ -19,21 +19,25 @@ open BinNums
 open Camlcoq
 open Json
 
-let mnemonic_names = [ "Padc"; "Padd"; "Padds"; "Pand";"Pannot"; "Pasr"; "Pb"; "Pbc"; "Pbic"; "Pblreg";
-                       "Pblsymb"; "Pbne"; "Pbreg"; "Pbsymb"; "Pbtbl"; "Pclz"; "Pcmp"; "Pcmn"; "Pconstants"; "Pfcpy_iif";
-                       "Pfcpy_fii"; "Pfcpy_fi"; "Pfcpy_sf"; "Pflid_lbl"; "Pflis_lbl"; "Pdmb"; "Pdsb"; "Peor"; "Pfabsd";
-                       "Pfabss"; "Pfaddd"; "Pfadds"; "Pfcmpd"; "Pfcmps"; "Pfcmpzd"; "Pfcmpzs";
-                       "Pfcpyd"; "Pfcpy_fs"; "Pfcpy_if";"Pfcvtds"; "Pfcvtsd"; "Pfdivd"; "Pfdivs"; "Pfldd";
-                       "Pflid"; "Pflds"; "Pflid_imm"; "Pflis_imm"; "Pfmuld"; "Pfmuls"; "Pfnegd";
-                       "Pfnegs"; "Pfsitod"; "Pfsitos"; "Pfsqrt"; "Pfstd";
-                       "Pfsts"; "Pfsubd"; "Pfsubs"; "Pftosizd"; "Pftosizs"; "Pftouizd";
-                       "Pftouizs"; "Pfuitod"; "Pfuitos"; "Pinlineasm"; "Pisb"; "Plabel"; "Pldr";
-                       "Ploadsymbol_lbl"; "Pldr_p"; "Pldrb"; "Pldrb_p"; "Pldrh"; "Pldrh_p"; "Pldrsb";
-                       "Pldrsh"; "Plsl"; "Plsr"; "Pmla"; "Pmov"; "Pmovite";
-                       "Pmovt"; "Pmovw"; "Pmul"; "Pmvn";  "Ploadsymbol_imm"; "Pnop"; "Porr";
-                       "Ppush"; "Prev"; "Prev16"; "Prsb"; "Prsbs"; "Prsc"; "Psbc"; "Psbfx"; "Psdiv"; "Psmull";
-                       "Pstr"; "Pstr_p"; "Pstrb"; "Pstrb_p"; "Pstrh"; "Pstrh_p"; "Psub"; "Psubs"; "Pudiv";
-                       "Pumull" ]
+module StringSet = Set.Make(String)
+
+let mnemonic_names = StringSet.of_list
+    [ "Padc"; "Padd"; "Padds"; "Pand";"Pannot"; "Pasr"; "Pb"; "Pbc"; "Pbic";
+      "Pblreg"; "Pblsymb"; "Pbne"; "Pbreg"; "Pbsymb"; "Pbtbl"; "Pclz"; "Pcmp";
+      "Pcmn"; "Pconstants"; "Pfcpy_iif"; "Pfcpy_fii"; "Pfcpy_fi"; "Pfcpy_sf";
+      "Pflid_lbl"; "Pflis_lbl"; "Pdmb"; "Pdsb"; "Peor"; "Pfabsd"; "Pfabss";
+      "Pfaddd"; "Pfadds"; "Pfcmpd"; "Pfcmps"; "Pfcmpzd"; "Pfcmpzs"; "Pfcpyd";
+      "Pfcpy_fs"; "Pfcpy_if";"Pfcvtds"; "Pfcvtsd"; "Pfdivd"; "Pfdivs"; "Pfldd";
+      "Pflid"; "Pflds"; "Pflid_imm"; "Pflis_imm"; "Pfmuld"; "Pfmuls"; "Pfnegd";
+      "Pfnegs"; "Pfsitod"; "Pfsitos"; "Pfsqrt"; "Pfstd"; "Pfsts"; "Pfsubd";
+      "Pfsubs"; "Pftosizd"; "Pftosizs"; "Pftouizd"; "Pftouizs"; "Pfuitod";
+      "Pfuitos"; "Pinlineasm"; "Pisb"; "Plabel"; "Pldr"; "Ploadsymbol_lbl";
+      "Pldr_p"; "Pldrb"; "Pldrb_p"; "Pldrh"; "Pldrh_p"; "Pldrsb"; "Pldrsh";
+      "Plsl"; "Plsr"; "Pmla"; "Pmov"; "Pmovite"; "Pfmovite"; "Pmovt"; "Pmovw";
+      "Pmul"; "Pmvn";  "Ploadsymbol_imm"; "Pnop"; "Porr"; "Ppush"; "Prev";
+      "Prev16"; "Prsb"; "Prsbs"; "Prsc"; "Psbc"; "Psbfx"; "Psdiv"; "Psmull";
+      "Pstr"; "Pstr_p"; "Pstrb"; "Pstrb_p"; "Pstrh"; "Pstrh_p"; "Psub"; "Psubs";
+      "Pudiv";"Pumull" ]
 
 type instruction_arg =
   | ALabel of positive
@@ -143,7 +147,7 @@ let pp_instructions pp ic =
       | _ -> true) ic in
 
   let instruction pp n args =
-    assert (List.mem n mnemonic_names);
+    assert (StringSet.mem n mnemonic_names);
     pp_jobject_start pp;
     pp_jmember ~first:true pp "Instruction Name" pp_jstring n;
     pp_jmember pp "Args" (pp_jarray pp_arg) args;
@@ -259,7 +263,8 @@ let pp_instructions pp ic =
     | Pmla(r1, r2, r3, r4) -> instruction pp "Pmla" [Ireg r1; Ireg r2; Ireg r3; Ireg r4]
     | Pmov(r1, so) -> instruction pp "Pmov" [Ireg r1; Shift so]
     | Pmovite(cond, r1, so1, so2) -> instruction pp "Pmovite" [Ireg r1; Condition (TargetPrinter.condition_name cond); Shift so1; Condition (TargetPrinter.neg_condition_name cond); Shift so2]
-    | Pmovt(r1, n) -> instruction pp "Pmovt" [Ireg r1; Long n]
+    | Pfmovite(cond, r1, r2, r3) -> instruction pp "Pfmovite" [DFreg r1; Condition (TargetPrinter.condition_name cond); DFreg r2; Condition (TargetPrinter.neg_condition_name cond); DFreg r3] 
+   | Pmovt(r1, n) -> instruction pp "Pmovt" [Ireg r1; Long n]
     | Pmovw(r1, n) -> instruction pp "Pmovw" [Ireg r1; Long n]
     | Pmul(r1, r2, r3) -> instruction pp "Pmul" [Ireg r1; Ireg r2; Ireg r3]
     | Pmvn(r1, so) -> instruction pp "Pmvn" [Ireg r1; Shift so]
@@ -312,8 +317,8 @@ let print_if prog sourcename =
   | Some f ->
     let f = Filename.concat !sdump_folder f in
     let oc = open_out_bin f in
-    JsonAST.pp_ast (Format.formatter_of_out_channel oc) pp_instructions prog sourcename;
+    JsonAST.pp_ast oc pp_instructions prog sourcename;
     close_out oc
 
 let pp_mnemonics pp =
-  JsonAST.pp_mnemonics pp mnemonic_names
+  JsonAST.pp_mnemonics pp (StringSet.elements mnemonic_names)
diff --git a/arm/Asmexpand.ml b/arm/Asmexpand.ml
index d9424d11..89aab5c7 100644
--- a/arm/Asmexpand.ml
+++ b/arm/Asmexpand.ml
@@ -18,7 +18,7 @@ open Asm
 open Asmexpandaux
 open AST
 open Camlcoq
-open Integers
+open! Integers
 
 exception Error of string
 
@@ -304,6 +304,11 @@ let expand_builtin_va_start r =
 let expand_builtin_inline name args res =
   match name, args, res with
   (* Integer arithmetic *)
+  | "__builtin_bswap64" , [BA_splitlong(BA(IR ah), BA(IR al))],
+                          BR_splitlong(BR(IR rh), BR(IR rl)) ->
+     expand_int64_arith (rl = al) rl (fun rl ->
+        emit (Prev (rl, ah));
+        emit (Prev (rh, al)))
   | ("__builtin_bswap" | "__builtin_bswap32"), [BA(IR a1)], BR(IR res) ->
      emit (Prev (res, a1))
   | "__builtin_bswap16", [BA(IR a1)], BR(IR res) ->
diff --git a/arm/Asmgen.v b/arm/Asmgen.v
index f12ea870..1a1e7f2f 100644
--- a/arm/Asmgen.v
+++ b/arm/Asmgen.v
@@ -555,6 +555,19 @@ Definition transl_op
       do r <- ireg_of res;
       transl_cond cmp args
         (Pmovite (cond_for_cond cmp) r (SOimm Int.one) (SOimm Int.zero) :: k)
+  | Osel cmp ty, a1 :: a2 :: args =>
+      match preg_of res with
+      | IR r => 
+          do r1 <- ireg_of a1; do r2 <- ireg_of a2;
+          transl_cond cmp args
+            (Pmovite (cond_for_cond cmp) r (SOreg r1) (SOreg r2) :: k)
+      | FR r =>
+          do r1 <- freg_of a1; do r2 <- freg_of a2;
+          transl_cond cmp args
+            (Pfmovite (cond_for_cond cmp) r r1 r2 :: k)
+      | _ =>
+          Error(msg "Asmgen.Osel")
+      end
   | _, _ =>
       Error(msg "Asmgen.transl_op")
   end.
diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v
index 2c001f45..25f91d23 100644
--- a/arm/Asmgenproof.v
+++ b/arm/Asmgenproof.v
@@ -270,6 +270,7 @@ Opaque Int.eq.
   destruct Archi.thumb2_support; TailNoLabel.
   eapply tail_nolabel_trans; TailNoLabel.
   eapply tail_nolabel_trans. eapply transl_cond_label; eauto. TailNoLabel.
+  destruct (preg_of r); monadInv H; (eapply tail_nolabel_trans; [eapply transl_cond_label; eauto|TailNoLabel]).
 Qed.
 
 Remark transl_memory_access_label:
diff --git a/arm/Asmgenproof1.v b/arm/Asmgenproof1.v
index 98cd5eea..807e069d 100644
--- a/arm/Asmgenproof1.v
+++ b/arm/Asmgenproof1.v
@@ -16,6 +16,7 @@ Require Import Coqlib.
 Require Import Errors.
 Require Import Maps.
 Require Import AST.
+Require Import Zbits.
 Require Import Integers.
 Require Import Floats.
 Require Import Values.
@@ -355,7 +356,7 @@ Proof.
   rewrite Int.and_assoc. change 65535 with (two_p 16 - 1). rewrite Int.and_idem.
   apply Int.same_bits_eq; intros.
   rewrite Int.bits_or, Int.bits_and, Int.bits_shl, Int.testbit_repr by auto.
-  rewrite Int.Ztestbit_two_p_m1 by omega. change (Int.unsigned (Int.repr 16)) with 16.
+  rewrite Ztestbit_two_p_m1 by omega. change (Int.unsigned (Int.repr 16)) with 16.
   destruct (zlt i 16).
   rewrite andb_true_r, orb_false_r; auto.
   rewrite andb_false_r; simpl. rewrite Int.bits_shru by omega.
@@ -1188,7 +1189,7 @@ Lemma transl_op_correct_same:
   forall op args res k c (rs: regset) m v,
   transl_op op args res k = OK c ->
   eval_operation ge rs#IR13 op (map rs (map preg_of args)) m = Some v ->
-  match op with Ocmp _ => False | Oaddrstack _ => False | _ => True end ->
+  match op with Ocmp _ => False | Osel _ _ => False | Oaddrstack _ => False | _ => True end ->
   exists rs',
      exec_straight ge fn c rs m k rs' m
   /\ rs'#(preg_of res) = v
@@ -1332,6 +1333,8 @@ Transparent destroyed_by_op.
   intuition Simpl.
   (* Ocmp *)
   contradiction.
+  (* Osel *)
+  contradiction.
 Qed.
 
 Lemma transl_op_correct:
@@ -1368,6 +1371,27 @@ Proof.
   split; intros; Simpl.
   destruct (eval_condition c0 rs ## (preg_of ## args) m) as [b|]; simpl; auto.
   destruct B as [B1 B2]; rewrite B1. destruct b; auto.
+- (* Osel *)
+  clear SAME. simpl in H.  ArgsInv. simpl in H0; inv H0.
+  assert (D1: data_preg (preg_of m0) = true) by auto with asmgen.
+  assert (D2: data_preg (preg_of m1) = true) by auto with asmgen.
+  destruct (preg_of res) eqn:RES; monadInv H.
++ inv EQ2. rewrite (ireg_of_eq _ _ EQ), (ireg_of_eq _ _ EQ1) in *.
+  exploit transl_cond_correct; eauto. instantiate (1 := rs). instantiate (1 := m). intros [rs1 [A [B C]]].
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto.
+  split; intros; Simpl.
+  rewrite ! C by auto.
+  destruct (eval_condition c0 rs ## (preg_of ## args) m) as [b|]; simpl; auto.
+  destruct B as [B1 B2]; rewrite B1. destruct b; apply Val.lessdef_normalize.
++ inv EQ2. rewrite (freg_of_eq _ _ EQ), (freg_of_eq _ _ EQ1) in *.
+  exploit transl_cond_correct; eauto. instantiate (1 := rs). instantiate (1 := m). intros [rs1 [A [B C]]].
+  econstructor; split.
+  eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto.
+  split; intros; Simpl.
+  rewrite ! C by auto.
+  destruct (eval_condition c0 rs ## (preg_of ## args) m) as [b|]; simpl; auto.
+  destruct B as [B1 B2]; rewrite B1. destruct b; apply Val.lessdef_normalize.
 Qed.
 
 (** Translation of loads and stores. *)
diff --git a/arm/Builtins1.v b/arm/Builtins1.v
new file mode 100644
index 00000000..53c83d7e
--- /dev/null
+++ b/arm/Builtins1.v
@@ -0,0 +1,33 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Platform-specific built-in functions *)
+
+Require Import String Coqlib.
+Require Import AST Integers Floats Values.
+Require Import Builtins0.
+
+Inductive platform_builtin : Type := .
+
+Local Open Scope string_scope.
+
+Definition platform_builtin_table : list (string * platform_builtin) :=
+  nil.
+
+Definition platform_builtin_sig (b: platform_builtin) : signature :=
+  match b with end.
+
+Definition platform_builtin_sem (b: platform_builtin) : builtin_sem (sig_res (platform_builtin_sig b)) :=
+  match b with end.
diff --git a/arm/CBuiltins.ml b/arm/CBuiltins.ml
index ec4f4aaa..d6a1ea35 100644
--- a/arm/CBuiltins.ml
+++ b/arm/CBuiltins.ml
@@ -18,10 +18,10 @@
 open C
 
 let builtins = {
-  Builtins.typedefs = [
+  builtin_typedefs = [
     "__builtin_va_list", TPtr(TVoid [], [])
   ];
-  Builtins.functions = [
+  builtin_functions = [
     (* Integer arithmetic *)
     "__builtin_clz",
       (TInt(IInt, []), [TInt(IUInt, [])], false);
diff --git a/arm/ConstpropOp.vp b/arm/ConstpropOp.vp
index d62240ef..8555d3aa 100644
--- a/arm/ConstpropOp.vp
+++ b/arm/ConstpropOp.vp
@@ -20,7 +20,7 @@ Require Import Integers.
 Require Import Floats.
 Require Import Op.
 Require Import Registers.
-Require Import ValueDomain.
+Require Import ValueDomain ValueAOp.
 
 (** * Converting known values to constants *)
 
@@ -131,6 +131,15 @@ Nondetfunction make_cmp (c: condition) (args: list reg) (vl: list aval) :=
       make_cmp_base c args vl
   end.
 
+Definition make_select (c: condition) (ty: typ)
+                       (r1 r2: reg) (args: list reg) (vl: list aval) :=
+  match resolve_branch (eval_static_condition c vl) with
+  | Some b => (Omove, (if b then r1 else r2) :: nil)
+  | None =>
+      let (c', args') := cond_strength_reduction c args vl in
+      (Osel c' ty, r1 :: r2 :: args')
+  end.
+
 Definition make_addimm (n: int) (r: reg) :=
   if Int.eq n Int.zero
   then (Omove, r :: nil)
@@ -284,6 +293,7 @@ Nondetfunction op_strength_reduction
   | Oshr, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shrimm n2 r1 r2
   | Oshru, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shruimm n2 r1 r2
   | Ocmp c, args, vl => make_cmp c args vl
+  | Osel c ty, r1 :: r2 :: args, v1 :: v2 :: vl => make_select c ty r1 r2 args vl
   | Omulf, r1 :: r2 :: nil, v1 :: F n2 :: nil => make_mulfimm n2 r1 r1 r2
   | Omulf, r1 :: r2 :: nil, F n1 :: v2 :: nil => make_mulfimm n1 r2 r1 r2
   | Omulfs, r1 :: r2 :: nil, v1 :: FS n2 :: nil => make_mulfsimm n2 r1 r1 r2
diff --git a/arm/ConstpropOpproof.v b/arm/ConstpropOpproof.v
index 079ba2be..a4f5c29c 100644
--- a/arm/ConstpropOpproof.v
+++ b/arm/ConstpropOpproof.v
@@ -24,7 +24,7 @@ Require Import Events.
 Require Import Op.
 Require Import Registers.
 Require Import RTL.
-Require Import ValueDomain.
+Require Import ValueDomain ValueAOp ValueAnalysis.
 Require Import ConstpropOp.
 
 Local Transparent Archi.ptr64.
@@ -234,6 +234,28 @@ Proof.
 - apply make_cmp_base_correct; auto.
 Qed.
 
+Lemma make_select_correct:
+  forall c ty r1 r2 args vl,
+  vl = map (fun r => AE.get r ae) args ->
+  let (op', args') := make_select c ty r1 r2 args vl in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op' rs##args' m = Some v
+         /\ Val.lessdef (Val.select (eval_condition c rs##args m) rs#r1 rs#r2 ty) v.
+Proof.
+  unfold make_select; intros.
+  destruct (resolve_branch (eval_static_condition c vl)) as [b|] eqn:RB.
+- exists (if b then rs#r1 else rs#r2); split.
++ simpl. destruct b; auto.
++ destruct (eval_condition c rs##args m) as [b'|] eqn:EC; simpl; auto.
+  assert (b = b').
+  { eapply resolve_branch_sound; eauto. 
+    rewrite <- EC. apply eval_static_condition_sound with bc. 
+    subst vl. exact (aregs_sound _ _ _ args MATCH). }
+  subst b'. apply Val.lessdef_normalize.
+- generalize (cond_strength_reduction_correct c args vl H).
+  destruct (cond_strength_reduction c args vl) as [cond' args']; intros EQ.
+  econstructor; split. simpl; eauto. rewrite EQ; auto.
+Qed.
+
 Lemma make_addimm_correct:
   forall n r,
   let (op, args) := make_addimm n r in
@@ -616,6 +638,8 @@ Proof.
   InvApproxRegs; SimplVM. inv H0. apply make_shruimm_correct; auto.
 (* cmp *)
   inv H0. apply make_cmp_correct; auto.
+(* select *)
+  inv H0. apply make_select_correct; congruence.
 (* mulf *)
   InvApproxRegs; SimplVM; inv H0. rewrite <- H2. apply make_mulfimm_correct; auto.
   InvApproxRegs; SimplVM; inv H0. fold (Val.mulf (Vfloat n1) rs#r2).
diff --git a/arm/Conventions1.v b/arm/Conventions1.v
index c5277e8d..fe49a781 100644
--- a/arm/Conventions1.v
+++ b/arm/Conventions1.v
@@ -104,13 +104,12 @@ Definition is_float_reg (r: mreg): bool :=
   representation with a single LDM instruction. *)
 
 Definition loc_result (s: signature) : rpair mreg :=
-  match s.(sig_res) with
-  | None => One R0
-  | Some (Tint | Tany32) => One R0
-  | Some (Tfloat | Tsingle | Tany64) => One F0
-  | Some Tlong => if Archi.big_endian
-                  then Twolong R0 R1
-                  else Twolong R1 R0
+  match proj_sig_res s with
+  | Tint | Tany32 => One R0
+  | Tfloat | Tsingle | Tany64 => One F0
+  | Tlong => if Archi.big_endian
+             then Twolong R0 R1
+             else Twolong R1 R0
   end.
 
 (** The result registers have types compatible with that given in the signature. *)
@@ -119,7 +118,7 @@ Lemma loc_result_type:
   forall sig,
   subtype (proj_sig_res sig) (typ_rpair mreg_type (loc_result sig)) = true.
 Proof.
-  intros. unfold proj_sig_res, loc_result. destruct (sig_res sig) as [[]|]; destruct Archi.big_endian; auto.
+  intros. unfold loc_result. destruct (proj_sig_res sig); destruct Archi.big_endian; auto.
 Qed.
 
 (** The result locations are caller-save registers *)
@@ -129,7 +128,7 @@ Lemma loc_result_caller_save:
   forall_rpair (fun r => is_callee_save r = false) (loc_result s).
 Proof.
   intros.
-  unfold loc_result. destruct (sig_res s) as [[]|]; destruct Archi.big_endian; simpl; auto.
+  unfold loc_result. destruct (proj_sig_res s); destruct Archi.big_endian; simpl; auto.
 Qed.
 
 (** If the result is in a pair of registers, those registers are distinct and have type [Tint] at least. *)
@@ -139,14 +138,13 @@ Lemma loc_result_pair:
   match loc_result sg with
   | One _ => True
   | Twolong r1 r2 =>
-        r1 <> r2 /\ sg.(sig_res) = Some Tlong
+        r1 <> r2 /\ proj_sig_res sg = Tlong
      /\ subtype Tint (mreg_type r1) = true /\ subtype Tint (mreg_type r2) = true
      /\ Archi.ptr64 = false
   end.
 Proof.
-  intros; unfold loc_result; destruct (sig_res sg) as [[]|]; destruct Archi.big_endian; auto.
-  intuition congruence.
-  intuition congruence.
+  intros; unfold loc_result; destruct (proj_sig_res sg); auto.
+  destruct Archi.big_endian; intuition congruence.
 Qed.
 
 (** The location of the result depends only on the result part of the signature *)
@@ -154,7 +152,7 @@ Qed.
 Lemma loc_result_exten:
   forall s1 s2, s1.(sig_res) = s2.(sig_res) -> loc_result s1 = loc_result s2.
 Proof.
-  intros. unfold loc_result. rewrite H; auto.
+  intros. unfold loc_result, proj_sig_res. rewrite H; auto.
 Qed.
 
 (** ** Location of function arguments *)
@@ -271,48 +269,6 @@ Definition loc_arguments (s: signature) : list (rpair loc) :=
       else loc_arguments_hf s.(sig_args) 0 0 0
   end.
 
-(** [size_arguments s] returns the number of [Outgoing] slots used
-  to call a function with signature [s]. *)
-
-Fixpoint size_arguments_hf (tyl: list typ) (ir fr ofs: Z) {struct tyl} : Z :=
-  match tyl with
-  | nil => ofs
-  | (Tint|Tany32) :: tys =>
-      if zlt ir 4
-      then size_arguments_hf tys (ir + 1) fr ofs
-      else size_arguments_hf tys ir fr (ofs + 1)
-  | (Tfloat|Tany64) :: tys =>
-      if zlt fr 8
-      then size_arguments_hf tys ir (fr + 1) ofs
-      else size_arguments_hf tys ir fr (align ofs 2 + 2)
-  | Tsingle :: tys =>
-      if zlt fr 8
-      then size_arguments_hf tys ir (fr + 1) ofs
-      else size_arguments_hf tys ir fr (ofs + 1)
-  | Tlong :: tys =>
-      let ir := align ir 2 in
-      if zlt ir 4
-      then size_arguments_hf tys (ir + 2) fr ofs
-      else size_arguments_hf tys ir fr (align ofs 2 + 2)
-  end.
-
-Fixpoint size_arguments_sf (tyl: list typ) (ofs: Z) {struct tyl} : Z :=
-  match tyl with
-  | nil => Z.max 0 ofs
-  | (Tint | Tsingle | Tany32) :: tys => size_arguments_sf tys (ofs + 1)
-  | (Tfloat | Tlong | Tany64) :: tys => size_arguments_sf tys (align ofs 2 + 2)
-  end.
-
-Definition size_arguments (s: signature) : Z :=
-  match Archi.abi with
-  | Archi.Softfloat =>
-      size_arguments_sf s.(sig_args) (-4)
-  | Archi.Hardfloat =>
-      if s.(sig_cc).(cc_vararg)
-      then size_arguments_sf s.(sig_args) (-4)
-      else size_arguments_hf s.(sig_args) 0 0 0
-  end.
-
 (** Argument locations are either non-temporary registers or [Outgoing]
   stack slots at nonnegative offsets. *)
 
@@ -473,173 +429,15 @@ Qed.
 
 Hint Resolve loc_arguments_acceptable: locs.
 
-(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)
-
-Remark size_arguments_hf_above:
-  forall tyl ir fr ofs0,
-  ofs0 <= size_arguments_hf tyl ir fr ofs0.
-Proof.
-  induction tyl; simpl; intros.
-  omega.
-  destruct a.
-  destruct (zlt ir 4); eauto. apply Z.le_trans with (ofs0 + 1); auto; omega.
-  destruct (zlt fr 8); eauto.
-  apply Z.le_trans with (align ofs0 2). apply align_le; omega.
-  apply Z.le_trans with (align ofs0 2 + 2); auto; omega.
-  set (ir' := align ir 2).
-  destruct (zlt ir' 4); eauto.
-  apply Z.le_trans with (align ofs0 2). apply align_le; omega.
-  apply Z.le_trans with (align ofs0 2 + 2); auto; omega.
-  destruct (zlt fr 8); eauto.
-  apply Z.le_trans with (ofs0 + 1); eauto. omega.
-  destruct (zlt ir 4); eauto. apply Z.le_trans with (ofs0 + 1); auto; omega.
-  destruct (zlt fr 8); eauto.
-  apply Z.le_trans with (align ofs0 2). apply align_le; omega.
-  apply Z.le_trans with (align ofs0 2 + 2); auto; omega.
-Qed.
-
-Remark size_arguments_sf_above:
-  forall tyl ofs0,
-  Z.max 0 ofs0 <= size_arguments_sf tyl ofs0.
-Proof.
-  induction tyl; simpl; intros.
-  omega.
-  destruct a; (eapply Z.le_trans; [idtac|eauto]).
-  xomega.
-  assert (ofs0 <= align ofs0 2) by (apply align_le; omega). xomega.
-  assert (ofs0 <= align ofs0 2) by (apply align_le; omega). xomega.
-  xomega.
-  xomega.
-  assert (ofs0 <= align ofs0 2) by (apply align_le; omega). xomega.
-Qed.
-
-Lemma size_arguments_above:
-  forall s, size_arguments s >= 0.
-Proof.
-  intros; unfold size_arguments. apply Z.le_ge.
-  assert (0 <= size_arguments_sf (sig_args s) (-4)).
-  { change 0 with (Z.max 0 (-4)). apply size_arguments_sf_above. }
-  assert (0 <= size_arguments_hf (sig_args s) 0 0 0).
-  { apply size_arguments_hf_above. }
-  destruct Archi.abi; [ | destruct (cc_vararg (sig_cc s)) ]; auto.
-Qed.
-
-Lemma loc_arguments_hf_bounded:
-  forall ofs ty tyl ir fr ofs0,
-  In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments_hf tyl ir fr ofs0)) ->
-  ofs + typesize ty <= size_arguments_hf tyl ir fr ofs0.
-Proof.
-  induction tyl; simpl; intros.
-  elim H.
-  destruct a.
-- (* int *)
-  destruct (zlt ir 4); destruct H.
-  discriminate.
-  eauto.
-  inv H. apply size_arguments_hf_above.
-  eauto.
-- (* float *)
-  destruct (zlt fr 8); destruct H.
-  discriminate.
-  eauto.
-  inv H. apply size_arguments_hf_above.
-  eauto.
-- (* long *)
-  destruct (zlt (align ir 2) 4).
-  destruct H. discriminate. destruct H. discriminate. eauto.
-  destruct Archi.big_endian.
-  destruct H. inv H.
-  eapply Z.le_trans. 2: apply size_arguments_hf_above. simpl; omega.
-  destruct H. inv H.
-  rewrite <- Z.add_assoc. simpl. apply size_arguments_hf_above.
-  eauto.
-  destruct H. inv H.
-  rewrite <- Z.add_assoc. simpl. apply size_arguments_hf_above.
-  destruct H. inv H.
-  eapply Z.le_trans. 2: apply size_arguments_hf_above. simpl; omega.
-  eauto.
-- (* float *)
-  destruct (zlt fr 8); destruct H.
-  discriminate.
-  eauto.
-  inv H. apply size_arguments_hf_above.
-  eauto.
-- (* any32 *)
-  destruct (zlt ir 4); destruct H.
-  discriminate.
-  eauto.
-  inv H. apply size_arguments_hf_above.
-  eauto.
-- (* any64 *)
-  destruct (zlt fr 8); destruct H.
-  discriminate.
-  eauto.
-  inv H. apply size_arguments_hf_above.
-  eauto.
-Qed.
-
-Lemma loc_arguments_sf_bounded:
-  forall ofs ty tyl ofs0,
-  In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments_sf tyl ofs0)) ->
-  Z.max 0 (ofs + typesize ty) <= size_arguments_sf tyl ofs0.
-Proof.
-  induction tyl; simpl; intros.
-  elim H.
-  destruct a.
-- (* int *)
-  destruct H.
-  destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above.
-  eauto.
-- (* float *)
-  destruct H.
-  destruct (zlt (align ofs0 2) 0); inv H. apply size_arguments_sf_above.
-  eauto.
-- (* long *)
-  destruct H.
-  destruct Archi.big_endian.
-  destruct (zlt (align ofs0 2) 0); inv H.
-  eapply Z.le_trans. 2: apply size_arguments_sf_above. simpl; xomega.
-  destruct (zlt (align ofs0 2) 0); inv H.
-  rewrite <- Z.add_assoc. simpl. apply size_arguments_sf_above.
-  destruct H.
-  destruct Archi.big_endian.
-  destruct (zlt (align ofs0 2) 0); inv H.
-  rewrite <- Z.add_assoc. simpl. apply size_arguments_sf_above.
-  destruct (zlt (align ofs0 2) 0); inv H.
-  eapply Z.le_trans. 2: apply size_arguments_sf_above. simpl; xomega.
-  eauto.
-- (* float *)
-  destruct H.
-  destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above.
-  eauto.
-- (* any32 *)
-  destruct H.
-  destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above.
-  eauto.
-- (* any64 *)
-  destruct H.
-  destruct (zlt (align ofs0 2) 0); inv H. apply size_arguments_sf_above.
-  eauto.
-Qed.
-
-Lemma loc_arguments_bounded:
-  forall (s: signature) (ofs: Z) (ty: typ),
-  In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments s)) ->
-  ofs + typesize ty <= size_arguments s.
-Proof.
-  unfold loc_arguments, size_arguments; intros.
-  assert (In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments_sf (sig_args s) (-4))) ->
-          ofs + typesize ty <= size_arguments_sf (sig_args s) (-4)).
-  { intros. eapply Z.le_trans. 2: eapply loc_arguments_sf_bounded; eauto. xomega. }
-  assert (In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments_hf (sig_args s) 0 0 0)) ->
-          ofs + typesize ty <= size_arguments_hf (sig_args s) 0 0 0).
-  { intros. eapply loc_arguments_hf_bounded; eauto. }
-  destruct Archi.abi; [ | destruct (cc_vararg (sig_cc s)) ]; eauto.
-Qed.
-
 Lemma loc_arguments_main:
   loc_arguments signature_main = nil.
 Proof.
   unfold loc_arguments.
   destruct Archi.abi; reflexivity.
 Qed.
+
+(** ** Normalization of function results *)
+
+(** No normalization needed. *)
+
+Definition return_value_needs_normalization (t: rettype) := false.
diff --git a/arm/NeedOp.v b/arm/NeedOp.v
index dee7cae1..c70c7e40 100644
--- a/arm/NeedOp.v
+++ b/arm/NeedOp.v
@@ -83,6 +83,7 @@ Definition needs_of_operation (op: operation) (nv: nval): list nval :=
   | Omakelong => op2 (default nv)
   | Olowlong | Ohighlong => op1 (default nv)
   | Ocmp c => needs_of_condition c
+  | Osel c ty => nv :: nv :: needs_of_condition c
   end.
 
 Definition operation_is_redundant (op: operation) (nv: nval): bool :=
@@ -183,6 +184,10 @@ Proof.
 - apply notint_sound; auto.
 - apply notint_sound. apply needs_of_shift_sound; auto.
 - apply needs_of_shift_sound; auto.
+- destruct (eval_condition c args m) as [b|] eqn:EC.
+  erewrite needs_of_condition_sound by eauto.
+  apply select_sound; auto.
+  simpl; auto with na.
 Qed.
 
 Lemma operation_is_redundant_sound:
diff --git a/arm/Op.v b/arm/Op.v
index 60c214d0..cc90e043 100644
--- a/arm/Op.v
+++ b/arm/Op.v
@@ -140,7 +140,9 @@ Inductive operation : Type :=
   | Olowlong: operation                 (**r [rd = low-word(r1)] *)
   | Ohighlong: operation                (**r [rd = high-word(r1)] *)
 (*c Boolean tests: *)
-  | Ocmp: condition -> operation.       (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
+  | Ocmp: condition -> operation        (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
+  | Osel: condition -> typ -> operation.
+                                        (**r [rd = rs1] if condition holds, [rd = rs2] otherwise. *)
 
 (** Addressing modes.  [r1], [r2], etc, are the arguments to the
   addressing. *)
@@ -174,7 +176,7 @@ Defined.
 
 Definition eq_operation (x y: operation): {x=y} + {x<>y}.
 Proof.
-  generalize Int.eq_dec Ptrofs.eq_dec ident_eq; intros.
+  generalize Int.eq_dec Ptrofs.eq_dec ident_eq typ_eq; intros.
   generalize Float.eq_dec Float32.eq_dec; intros.
   generalize eq_shift; intro.
   generalize eq_condition; intro.
@@ -294,6 +296,7 @@ Definition eval_operation
   | Olowlong, v1::nil => Some(Val.loword v1)
   | Ohighlong, v1::nil => Some(Val.hiword v1)
   | Ocmp c, _ => Some(Val.of_optbool (eval_condition c vl m))
+  | Osel c ty, v1::v2::vl => Some(Val.select (eval_condition c vl m) v1 v2 ty)
   | _, _ => None
   end.
 
@@ -419,6 +422,7 @@ Definition type_of_operation (op: operation) : list typ * typ :=
   | Olowlong => (Tlong :: nil, Tint)
   | Ohighlong => (Tlong :: nil, Tint)
   | Ocmp c => (type_of_condition c, Tint)
+  | Osel c ty => (ty :: ty :: type_of_condition c, ty)
   end.
 
 Definition type_of_addressing (addr: addressing) : list typ :=
@@ -511,6 +515,7 @@ Proof with (try exact I; try reflexivity).
   destruct v0...
   destruct v0...
   destruct (eval_condition c vl m)... destruct b...
+  unfold Val.select. destruct (eval_condition c vl m). apply Val.normalize_type. exact I.
 Qed.
 
 End SOUNDNESS.
@@ -532,7 +537,7 @@ Lemma mk_shift_amount_eq:
   forall n, Int.ltu n Int.iwordsize = true -> s_amount (mk_shift_amount n) = n.
 Proof.
   intros; simpl. unfold Int.modu. transitivity (Int.repr (Int.unsigned n)).
-  decEq. apply Zmod_small. apply Int.ltu_inv; auto.
+  decEq. apply Z.mod_small. apply Int.ltu_inv; auto.
   apply Int.repr_unsigned.
 Qed.
 
@@ -682,19 +687,37 @@ Definition is_trivial_op (op: operation) : bool :=
 
 (** Operations that depend on the memory state. *)
 
+Definition condition_depends_on_memory (c: condition) : bool :=
+  match c with
+  | Ccompu _ | Ccompushift _ _| Ccompuimm _ _ => true
+  | _ => false
+  end.
+
 Definition op_depends_on_memory (op: operation) : bool :=
   match op with
-  | Ocmp (Ccompu _ | Ccompushift _ _| Ccompuimm _ _) => true
+  | Ocmp c => condition_depends_on_memory c
+  | Osel c ty => condition_depends_on_memory c
   | _ => false
   end.
 
+Lemma condition_depends_on_memory_correct:
+  forall c args m1 m2,
+  condition_depends_on_memory c = false ->
+  eval_condition c args m1 = eval_condition c args m2.
+Proof.
+  intros. destruct c; simpl; auto; discriminate.
+Qed.
+
 Lemma op_depends_on_memory_correct:
   forall (F V: Type) (ge: Genv.t F V) sp op args m1 m2,
   op_depends_on_memory op = false ->
   eval_operation ge sp op args m1 = eval_operation ge sp op args m2.
 Proof.
-  intros until m2. destruct op; simpl; try congruence.
-  intros. destruct c; simpl; auto; congruence.
+  intros until m2. destruct op; simpl; try congruence; intros C.
+- f_equal; f_equal; apply condition_depends_on_memory_correct; auto.
+- destruct args; auto. destruct args; auto.
+  rewrite (condition_depends_on_memory_correct c args m1 m2 C).
+  auto.
 Qed.
 
 (** Global variables mentioned in an operation or addressing mode *)
@@ -929,6 +952,10 @@ Proof.
   exploit eval_condition_inj; eauto. intros EQ; rewrite EQ.
   destruct b; simpl; constructor.
   simpl; constructor.
+
+  apply Val.select_inject; auto.  
+  destruct (eval_condition c vl1 m1) eqn:?; auto.
+  right; symmetry; eapply eval_condition_inj; eauto.
 Qed.
 
 Lemma eval_addressing_inj:
diff --git a/arm/PrintOp.ml b/arm/PrintOp.ml
index 642fff80..d74acf3f 100644
--- a/arm/PrintOp.ml
+++ b/arm/PrintOp.ml
@@ -129,6 +129,10 @@ let print_operation reg pp = function
   | Olowlong, [r1] -> fprintf pp "lowlong(%a)" reg r1
   | Ohighlong, [r1] -> fprintf pp "highlong(%a)" reg r1
   | Ocmp c, args -> print_condition reg pp (c, args)
+  | Osel (c, ty), r1::r2::args ->
+      fprintf pp "%a ?%s %a : %a"
+         (print_condition reg) (c, args)
+         (PrintAST.name_of_type ty) reg r1 reg r2
   | _ -> fprintf pp "<bad operator>"
 
 let print_addressing reg pp = function
diff --git a/arm/SelectOp.vp b/arm/SelectOp.vp
index c361df65..1220abc4 100644
--- a/arm/SelectOp.vp
+++ b/arm/SelectOp.vp
@@ -38,11 +38,8 @@
 
 Require Import Coqlib.
 Require Import Compopts.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Op.
-Require Import CminorSel.
+Require Import AST Integers Floats Builtins.
+Require Import Op CminorSel.
 
 Local Open Scope cminorsel_scope.
 
@@ -382,6 +379,16 @@ Definition compf (c: comparison) (e1: expr) (e2: expr) :=
 Definition compfs (c: comparison) (e1: expr) (e2: expr) :=
   Eop (Ocmp (Ccompfs c)) (e1 ::: e2 ::: Enil).
 
+Definition select (ty: typ) (cond: condition) (args: exprlist) (e1 e2: expr) :=
+  if match ty with
+     | Tint => true
+     | Tfloat => true
+     | Tsingle => true
+     | _ => false
+     end
+  then Some (Eop (Osel cond ty) (e1 ::: e2 ::: args))
+  else None.
+
 (** ** Integer conversions *)
 
 Definition cast8unsigned (e: expr) := andimm (Int.repr 255) e.
@@ -508,3 +515,8 @@ Nondetfunction builtin_arg (e: expr) :=
   | Eop (Oaddimm n) (e1:::Enil) => BA_addptr (BA e1) (BA_int n)
   | _ => BA e
   end.
+
+(** Platform-specific known builtins *)
+
+Definition platform_builtin (b: platform_builtin) (args: exprlist) : option expr :=
+  None.
diff --git a/arm/SelectOpproof.v b/arm/SelectOpproof.v
index d4aac9b6..70f8f191 100644
--- a/arm/SelectOpproof.v
+++ b/arm/SelectOpproof.v
@@ -13,16 +13,9 @@
 (** Correctness of instruction selection for operators *)
 
 Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Cminor.
-Require Import Op.
-Require Import CminorSel.
+Require Import AST Integers Floats.
+Require Import Values Memory Builtins Globalenvs.
+Require Import Cminor Op CminorSel.
 Require Import SelectOp.
 
 Local Open Scope cminorsel_scope.
@@ -735,6 +728,22 @@ Proof.
   intros; red; intros. unfold compfs. TrivialExists.
 Qed.
 
+Theorem eval_select:
+  forall le ty cond al vl a1 v1 a2 v2 a b,
+  select ty cond al a1 a2 = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  eval_expr ge sp e m le a1 v1 ->
+  eval_expr ge sp e m le a2 v2 ->
+  eval_condition cond vl m = Some b ->
+  exists v, 
+     eval_expr ge sp e m le a v
+  /\ Val.lessdef (Val.select (Some b) v1 v2 ty) v.
+Proof.
+  unfold select; intros.
+  destruct (match ty with Tint | Tfloat | Tsingle => true | _ => false end); inv H.
+  rewrite <- H3; TrivialExists. 
+Qed.
+
 Theorem eval_cast8signed: unary_constructor_sound cast8signed (Val.sign_ext 8).
 Proof.
   red; intros until x. unfold cast8signed; case (cast8signed_match a); intros.
@@ -745,7 +754,7 @@ Qed.
 Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8).
 Proof.
   red; intros until x. unfold cast8unsigned.
-  rewrite Val.zero_ext_and. apply eval_andimm. compute; auto.
+  rewrite Val.zero_ext_and. apply eval_andimm. omega.
 Qed.
 
 Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16).
@@ -758,7 +767,7 @@ Qed.
 Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16).
 Proof.
   red; intros until x. unfold cast8unsigned.
-  rewrite Val.zero_ext_and. apply eval_andimm. compute; auto.
+  rewrite Val.zero_ext_and. apply eval_andimm. omega.
 Qed.
 
 Theorem eval_singleoffloat: unary_constructor_sound singleoffloat Val.singleoffloat.
@@ -893,4 +902,16 @@ Proof.
 - constructor; auto.
 Qed.
 
+(** Platform-specific known builtins *)
+
+Theorem eval_platform_builtin:
+  forall bf al a vl v le,
+  platform_builtin bf al = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  platform_builtin_sem bf vl = Some v ->
+  exists v', eval_expr ge sp e m le a v' /\ Val.lessdef v v'.
+Proof.
+  intros. discriminate.
+Qed.
+
 End CMCONSTR.
diff --git a/arm/Stacklayout.v b/arm/Stacklayout.v
index 462d83ad..8e91f14b 100644
--- a/arm/Stacklayout.v
+++ b/arm/Stacklayout.v
@@ -64,7 +64,7 @@ Lemma frame_env_separated:
        ** range sp (fe_ofs_callee_save fe) (size_callee_save_area b (fe_ofs_callee_save fe))
        ** P.
 Proof.
-Local Opaque Z.add Z.mul sepconj range.
+Local Opaque Z.add Z.mul sepconj range'.
   intros; simpl.
   set (olink := 4 * b.(bound_outgoing));
   set (ora := olink + 4);
diff --git a/arm/TargetPrinter.ml b/arm/TargetPrinter.ml
index bf37b0e4..03e06a65 100644
--- a/arm/TargetPrinter.ml
+++ b/arm/TargetPrinter.ml
@@ -113,9 +113,9 @@ struct
   let freg_single oc r = output_string oc (single_float_reg_name r)
   let freg_param_single oc r = output_string oc (single_param_reg_name r)
 
-  let preg oc = function
+  let preg_asm oc ty = function
     | IR r -> ireg oc r
-    | FR r -> freg oc r
+    | FR r -> if ty = Tsingle then freg_single oc r else freg oc r
     | _    -> assert false
 
   (* In Thumb2 mode, some arithmetic instructions have shorter encodings
@@ -148,9 +148,9 @@ struct
   let name_of_section = function
     | Section_text -> ".text"
     | Section_data i | Section_small_data i ->
-      if i then ".data" else "COMM"
+      if i then ".data" else common_section ()
     | Section_const i | Section_small_const i ->
-      if i then ".section	.rodata" else "COMM"
+      if i || (not !Clflags.option_fcommon) then ".section	.rodata" else "COMM"
     | Section_string -> ".section	.rodata"
     | Section_literal -> ".text"
     | Section_jumptable -> ".text"
@@ -443,6 +443,12 @@ struct
         (condition_name cond) ireg r1 shift_op ifso;
       fprintf oc "	mov%s	%a, %a\n"
         (neg_condition_name cond) ireg r1 shift_op ifnot
+    | Pfmovite(cond, r1, ifso, ifnot) ->
+      fprintf oc "	ite	%s\n" (condition_name cond);
+      fprintf oc "	vmov%s.f64	%a, %a\n"
+        (condition_name cond) freg r1 freg ifso;
+      fprintf oc "	vmov%s.f64	%a, %a\n"
+        (neg_condition_name cond) freg r1 freg ifnot
     | Pbtbl(r, tbl) ->
       if !Clflags.option_mthumb then begin
         fprintf oc "	lsl	r14, %a, #2\n" ireg r;
@@ -474,7 +480,7 @@ struct
             (P.to_int kind) (extern_atom txt) args
         | EF_inline_asm(txt, sg, clob) ->
           fprintf oc "%s begin inline assembly\n\t" comment;
-          print_inline_asm preg oc (camlstring_of_coqstring txt) sg args res;
+          print_inline_asm preg_asm oc (camlstring_of_coqstring txt) sg args res;
           fprintf oc "%s end inline assembly\n" comment
         | _ ->
           assert false
diff --git a/arm/ValueAOp.v b/arm/ValueAOp.v
index e19ddd6d..a3fd9d7d 100644
--- a/arm/ValueAOp.v
+++ b/arm/ValueAOp.v
@@ -127,6 +127,7 @@ Definition eval_static_operation (op: operation) (vl: list aval): aval :=
   | Olowlong, v1::nil => loword v1
   | Ohighlong, v1::nil => hiword v1
   | Ocmp c, _ => of_optbool (eval_static_condition c vl)
+  | Osel c ty, v1::v2::vl => select (eval_static_condition c vl) v1 v2
   | _, _ => Vbot
   end.
 
@@ -205,6 +206,7 @@ Proof.
   rewrite Ptrofs.add_zero_l; eauto with va.
   fold (Val.sub (Vint i) a1). auto with va.
   apply of_optbool_sound. eapply eval_static_condition_sound; eauto.
+  apply select_sound; auto. eapply eval_static_condition_sound; eauto.
 Qed.
 
 End SOUNDNESS.
diff --git a/backend/Allocation.v b/backend/Allocation.v
index cf62295d..08e0a4f4 100644
--- a/backend/Allocation.v
+++ b/backend/Allocation.v
@@ -36,7 +36,7 @@ Require Import Op Registers RTL Locations Conventions RTLtyping LTL.
 - a [Lbranch s] instruction.
 
   The [block_shape] type below describes all possible cases of structural
-  maching between an RTL instruction and an LTL basic block.
+  matching between an RTL instruction and an LTL basic block.
 *)
 
 Inductive move: Type :=
@@ -734,11 +734,11 @@ Function add_equations_args (rl: list reg) (tyl: list typ) (ll: list (rpair loc)
 (** [add_equations_res] is similar but is specialized to the case where
   there is only one pseudo-register. *)
 
-Function add_equations_res (r: reg) (oty: option typ) (p: rpair mreg) (e: eqs) : option eqs :=
-  match p, oty with
+Function add_equations_res (r: reg) (ty: typ) (p: rpair mreg) (e: eqs) : option eqs :=
+  match p, ty with
   | One mr, _ =>
       Some (add_equation (Eq Full r (R mr)) e)
-  | Twolong mr1 mr2, Some Tlong =>
+  | Twolong mr1 mr2, Tlong =>
       if Archi.ptr64 then None else
       Some (add_equation (Eq Low r (R mr2)) (add_equation (Eq High r (R mr1)) e))
   | _, _ =>
@@ -1084,7 +1084,7 @@ Definition transfer_aux (f: RTL.function) (env: regenv)
   | BStailcall sg ros args mv1 ros' =>
       let args' := loc_arguments sg in
       assertion (tailcall_is_possible sg);
-      assertion (opt_typ_eq sg.(sig_res) f.(RTL.fn_sig).(sig_res));
+      assertion (rettype_eq sg.(sig_res) f.(RTL.fn_sig).(sig_res));
       assertion (ros_compatible_tailcall ros');
       do e1 <- add_equation_ros ros ros' empty_eqs;
       do e2 <- add_equations_args args (sig_args sg) args' e1;
@@ -1114,7 +1114,7 @@ Definition transfer_aux (f: RTL.function) (env: regenv)
       track_moves env mv empty_eqs
   | BSreturn (Some arg) mv =>
       let arg' := loc_result (RTL.fn_sig f) in
-      do e1 <- add_equations_res arg (sig_res (RTL.fn_sig f)) arg' empty_eqs;
+      do e1 <- add_equations_res arg (proj_sig_res (RTL.fn_sig f)) arg' empty_eqs;
       track_moves env mv e1
   end.
 
diff --git a/backend/Allocproof.v b/backend/Allocproof.v
index 1804f46b..51755912 100644
--- a/backend/Allocproof.v
+++ b/backend/Allocproof.v
@@ -1301,10 +1301,10 @@ Proof.
 Qed.
 
 Lemma add_equations_res_lessdef:
-  forall r oty l e e' rs ls,
-  add_equations_res r oty l e = Some e' ->
+  forall r ty l e e' rs ls,
+  add_equations_res r ty l e = Some e' ->
   satisf rs ls e' ->
-  Val.has_type rs#r (match oty with Some ty => ty | None => Tint end) ->
+  Val.has_type rs#r ty ->
   Val.lessdef rs#r (Locmap.getpair (map_rpair R l) ls).
 Proof.
   intros. functional inversion H; simpl.
@@ -1892,7 +1892,7 @@ Qed.
 
 Inductive match_stackframes: list RTL.stackframe -> list LTL.stackframe -> signature -> Prop :=
   | match_stackframes_nil: forall sg,
-      sg.(sig_res) = Some Tint ->
+      sg.(sig_res) = Tint ->
       match_stackframes nil nil sg
   | match_stackframes_cons:
       forall res f sp pc rs s tf bb ls ts sg an e env
@@ -2425,13 +2425,13 @@ Proof.
                           (return_regs (parent_locset ts) ls1))
   with (Locmap.getpair (map_rpair R (loc_result (RTL.fn_sig f))) ls1).
   eapply add_equations_res_lessdef; eauto.
-  rewrite H13. apply WTRS.
+  rewrite <- H14. apply WTRS.
   generalize (loc_result_caller_save (RTL.fn_sig f)).
   destruct (loc_result (RTL.fn_sig f)); simpl.
   intros A; rewrite A; auto.
   intros [A B]; rewrite A, B; auto.
   apply return_regs_agree_callee_save.
-  unfold proj_sig_res. rewrite <- H11; rewrite H13. apply WTRS.
+  rewrite <- H11, <- H14. apply WTRS.
 
 (* internal function *)
 - monadInv FUN. simpl in *.
@@ -2463,7 +2463,8 @@ Proof.
   simpl. destruct (loc_result (ef_sig ef)) eqn:RES; simpl.
   rewrite Locmap.gss; auto.
   generalize (loc_result_pair (ef_sig ef)); rewrite RES; intros (A & B & C & D & E).
-  exploit external_call_well_typed; eauto. unfold proj_sig_res; rewrite B. intros WTRES'.
+  assert (WTRES': Val.has_type v' Tlong).
+  { rewrite <- B. eapply external_call_well_typed; eauto. }
   rewrite Locmap.gss. rewrite Locmap.gso by (red; auto). rewrite Locmap.gss.
   rewrite val_longofwords_eq_1 by auto. auto.
   red; intros. rewrite (AG l H0).
diff --git a/backend/Asmexpandaux.ml b/backend/Asmexpandaux.ml
index f5c76925..0530abe4 100644
--- a/backend/Asmexpandaux.ml
+++ b/backend/Asmexpandaux.ml
@@ -96,7 +96,7 @@ let translate_annot sp preg_to_dwarf annot =
   | a::_ -> aux a)
 
 let builtin_nop =
-  let signature ={sig_args = []; sig_res = None; sig_cc = cc_default} in
+  let signature ={sig_args = []; sig_res = Tvoid; sig_cc = cc_default} in
   let name = coqstring_of_camlstring "__builtin_nop" in
   Pbuiltin(EF_builtin(name,signature),[],BR_none)
 
diff --git a/backend/Asmexpandaux.mli b/backend/Asmexpandaux.mli
index d80b4aec..e2320418 100644
--- a/backend/Asmexpandaux.mli
+++ b/backend/Asmexpandaux.mli
@@ -22,7 +22,7 @@ val emit: instruction -> unit
 val new_label: unit -> label
   (* Compute a fresh label *)
 val is_current_function_variadic: unit -> bool
-  (* Test wether the current function is a variadic function *)
+  (* Test whether the current function is a variadic function *)
 val get_current_function_args: unit -> typ list
   (* Get the types of the current function arguments *)
 val get_current_function_sig: unit -> signature
@@ -33,4 +33,4 @@ val get_current_function: unit -> coq_function
   (* Get the current function *)
 val expand: positive -> int -> (preg -> int) -> (instruction -> unit) -> instruction list -> unit
   (* Expand the instruction sequence of a function. Takes the function id, the register number of the stackpointer, a
-     function to get the dwarf mapping of varibale names and for the expansion of simple instructions *)
+     function to get the dwarf mapping of variable names and for the expansion of simple instructions *)
diff --git a/backend/Asmgenproof0.v b/backend/Asmgenproof0.v
index 70c4323c..3638c465 100644
--- a/backend/Asmgenproof0.v
+++ b/backend/Asmgenproof0.v
@@ -897,6 +897,55 @@ Proof.
   apply code_tail_next_int with i; auto.
 Qed.
 
+(** A variant that supports zero steps of execution *)
+
+Inductive exec_straight_opt: code -> regset -> mem -> code -> regset -> mem -> Prop :=
+  | exec_straight_opt_refl: forall c rs m,
+      exec_straight_opt c rs m c rs m
+  | exec_straight_opt_intro: forall c1 rs1 m1 c2 rs2 m2,
+      exec_straight c1 rs1 m1 c2 rs2 m2 ->
+      exec_straight_opt c1 rs1 m1 c2 rs2 m2.
+
+Lemma exec_straight_opt_left:
+  forall c3 rs3 m3 c1 rs1 m1 c2 rs2 m2,
+  exec_straight c1 rs1 m1 c2 rs2 m2 ->
+  exec_straight_opt c2 rs2 m2 c3 rs3 m3 ->
+  exec_straight c1 rs1 m1 c3 rs3 m3.
+Proof.
+  destruct 2; intros. auto. eapply exec_straight_trans; eauto. 
+Qed.
+
+Lemma exec_straight_opt_right:
+  forall c3 rs3 m3 c1 rs1 m1 c2 rs2 m2,
+  exec_straight_opt c1 rs1 m1 c2 rs2 m2 ->
+  exec_straight c2 rs2 m2 c3 rs3 m3 ->
+  exec_straight c1 rs1 m1 c3 rs3 m3.
+Proof.
+  destruct 1; intros. auto. eapply exec_straight_trans; eauto. 
+Qed.
+
+Lemma exec_straight_opt_step:
+  forall i c rs1 m1 rs2 m2 c' rs3 m3,
+  exec_instr ge fn i rs1 m1 = Next rs2 m2 ->
+  rs2#PC = Val.offset_ptr rs1#PC Ptrofs.one ->
+  exec_straight_opt c rs2 m2 c' rs3 m3 ->
+  exec_straight (i :: c) rs1 m1 c' rs3 m3.
+Proof.
+  intros. inv H1. 
+- apply exec_straight_one; auto.
+- eapply exec_straight_step; eauto.
+Qed.
+
+Lemma exec_straight_opt_step_opt:
+  forall i c rs1 m1 rs2 m2 c' rs3 m3,
+  exec_instr ge fn i rs1 m1 = Next rs2 m2 ->
+  rs2#PC = Val.offset_ptr rs1#PC Ptrofs.one ->
+  exec_straight_opt c rs2 m2 c' rs3 m3 ->
+  exec_straight_opt (i :: c) rs1 m1 c' rs3 m3.
+Proof.
+  intros. apply exec_straight_opt_intro. eapply exec_straight_opt_step; eauto.
+Qed.
+
 End STRAIGHTLINE.
 
 (** * Properties of the Mach call stack *)
diff --git a/backend/CSE.v b/backend/CSE.v
index 6d3f6f33..ecfa1f9e 100644
--- a/backend/CSE.v
+++ b/backend/CSE.v
@@ -14,7 +14,7 @@
   proceeds by value numbering over extended basic blocks. *)
 
 Require Import Coqlib Maps Errors Integers Floats Lattice Kildall.
-Require Import AST Linking.
+Require Import AST Linking Builtins.
 Require Import Values Memory.
 Require Import Op Registers RTL.
 Require Import ValueDomain ValueAnalysis CSEdomain CombineOp.
@@ -444,10 +444,10 @@ Module Solver := BBlock_solver(Numbering).
   ([EF_external], [EF_runtime], [EF_malloc], [EF_free]).
 - Forget equations involving loads but keep equations over registers.
   This is appropriate for builtins that can modify memory,
-  e.g. volatile stores, or [EF_builtin]
+  e.g. volatile stores, or [EF_builtin] for unknown builtin functions.
 - Keep all equations, taking advantage of the fact that neither memory
-  nor registers are modified.  This is appropriate for annotations
-  and for volatile loads.
+  nor registers are modified.  This is appropriate for annotations,
+  volatile loads, and known builtin functions.
 *)
 
 Definition transfer (f: function) (approx: PMap.t VA.t) (pc: node) (before: numbering) :=
@@ -473,8 +473,13 @@ Definition transfer (f: function) (approx: PMap.t VA.t) (pc: node) (before: numb
           match ef with
           | EF_external _ _ | EF_runtime _ _ | EF_malloc | EF_free | EF_inline_asm _ _ _ =>
               empty_numbering
-          | EF_builtin _ _ | EF_vstore _ =>
+          | EF_vstore _ =>
               set_res_unknown (kill_all_loads before) res
+          | EF_builtin name sg =>
+              match lookup_builtin_function name sg with
+              | Some bf => set_res_unknown before res
+              | None    => set_res_unknown (kill_all_loads before) res
+              end
           | EF_memcpy sz al =>
               match args with
               | dst :: src :: nil =>
diff --git a/backend/CSEproof.v b/backend/CSEproof.v
index d6bde348..03c7ecfc 100644
--- a/backend/CSEproof.v
+++ b/backend/CSEproof.v
@@ -14,7 +14,7 @@
 
 Require Import Coqlib Maps Errors Integers Floats Lattice Kildall.
 Require Import AST Linking.
-Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Values Memory Builtins Events Globalenvs Smallstep.
 Require Import Op Registers RTL.
 Require Import ValueDomain ValueAOp ValueAnalysis.
 Require Import CSEdomain CombineOp CombineOpproof CSE.
@@ -544,7 +544,7 @@ Lemma kill_loads_after_storebytes_holds:
   bc sp = BCstack ->
   ematch bc rs ae ->
   approx = VA.State ae am ->
-  length bytes = nat_of_Z sz -> sz >= 0 ->
+  length bytes = Z.to_nat sz -> sz >= 0 ->
   numbering_holds valu ge (Vptr sp Ptrofs.zero) rs m'
                            (kill_loads_after_storebytes approx n dst sz).
 Proof.
@@ -557,7 +557,7 @@ Proof.
   simpl.
   rewrite negb_false_iff in H8.
   eapply Mem.load_storebytes_other. eauto.
-  rewrite H6. rewrite nat_of_Z_eq by auto.
+  rewrite H6. rewrite Z2Nat.id by omega.
   eapply pdisjoint_sound. eauto.
   unfold aaddressing. apply match_aptr_of_aval. eapply eval_static_addressing_sound; eauto.
   erewrite <- regs_valnums_sound by eauto. eauto with va.
@@ -598,9 +598,9 @@ Proof.
   exploit Mem.storebytes_split; eauto. intros (m2 & SB2 & SB3).
   clear SB23.
   assert (L1: Z.of_nat (length bytes1) = n1).
-  { erewrite Mem.loadbytes_length by eauto. apply nat_of_Z_eq. unfold n1; omega. }
+  { erewrite Mem.loadbytes_length by eauto. apply Z2Nat.id. unfold n1; omega. }
   assert (L2: Z.of_nat (length bytes2) = n2).
-  { erewrite Mem.loadbytes_length by eauto. apply nat_of_Z_eq. unfold n2; omega. }
+  { erewrite Mem.loadbytes_length by eauto. apply Z2Nat.id. unfold n2; omega. }
   rewrite L1 in *. rewrite L2 in *.
   assert (LB': Mem.loadbytes m2 b2 (ofs2 + n1) n2 = Some bytes2).
   { rewrite <- L2. eapply Mem.loadbytes_storebytes_same; eauto. }
@@ -1129,7 +1129,9 @@ Proof.
   { exists valu. apply set_res_unknown_holds. eapply kill_all_loads_hold; eauto. }
   destruct ef.
   + apply CASE1.
-  + apply CASE3.
+  + destruct (lookup_builtin_function name sg) as [bf|] eqn:LK.
+    ++ apply CASE2. simpl in H1; red in H1; rewrite LK in H1; inv H1. auto.
+    ++ apply CASE3.
   + apply CASE1.
   + apply CASE2; inv H1; auto.
   + apply CASE3.
diff --git a/backend/Cminor.v b/backend/Cminor.v
index 11941da3..91a4c104 100644
--- a/backend/Cminor.v
+++ b/backend/Cminor.v
@@ -591,6 +591,70 @@ Proof.
   red; intros; inv H; simpl; try omega; eapply external_call_trace_length; eauto.
 Qed.
 
+(** This semantics is determinate. *)
+
+Lemma eval_expr_determ:
+  forall ge sp e m a v, eval_expr ge sp e m a v ->
+  forall v', eval_expr ge sp e m a v' -> v' = v.
+Proof.
+  induction 1; intros v' E'; inv E'.
+- congruence.
+- congruence.
+- assert (v0 = v1) by eauto. congruence.
+- assert (v0 = v1) by eauto. assert (v3 = v2) by eauto. congruence.
+- assert (vaddr0 = vaddr) by eauto. congruence.
+Qed.
+
+Lemma eval_exprlist_determ:
+  forall ge sp e m al vl, eval_exprlist ge sp e m al vl ->
+  forall vl', eval_exprlist ge sp e m al vl' -> vl' = vl.
+Proof.
+  induction 1; intros vl' E'; inv E'.
+  - auto.
+  - f_equal; eauto using eval_expr_determ.
+Qed.
+
+Ltac Determ :=
+  try congruence;
+  match goal with
+  | [ |- match_traces _ E0 E0 /\ (_ -> _) ]  =>
+          split; [constructor|intros _; Determ]
+  | [ H: is_call_cont ?k |- _ ] =>
+          contradiction || (clear H; Determ)
+  | [ H1: eval_expr _ _ _ _ ?a ?v1, H2: eval_expr _ _ _ _ ?a ?v2 |- _ ] =>
+          assert (v1 = v2) by (eapply eval_expr_determ; eauto);
+          clear H1 H2; Determ
+  | [ H1: eval_exprlist _ _ _ _ ?a ?v1, H2: eval_exprlist _ _ _ _ ?a ?v2 |- _ ] =>
+          assert (v1 = v2) by (eapply eval_exprlist_determ; eauto);
+          clear H1 H2; Determ
+  | _ => idtac
+  end.
+
+Lemma semantics_determinate:
+  forall (p: program), determinate (semantics p).
+Proof.
+  intros. constructor; set (ge := Genv.globalenv p); simpl; intros.
+- (* determ *)
+  inv H; inv H0; Determ.
+  + subst vargs0. exploit external_call_determ. eexact H2. eexact H13.
+    intros (A & B). split; intros; auto.
+    apply B in H; destruct H; congruence.
+  + subst v0. assert (b0 = b) by (inv H2; inv H13; auto). subst b0; auto.
+  + assert (n0 = n) by (inv H2; inv H14; auto). subst n0; auto.
+  + exploit external_call_determ. eexact H1. eexact H7.
+    intros (A & B). split; intros; auto.
+    apply B in H; destruct H; congruence.
+- (* single event *)
+  red; simpl. destruct 1; simpl; try omega;
+  eapply external_call_trace_length; eauto.
+- (* initial states *)
+  inv H; inv H0. unfold ge0, ge1 in *. congruence.
+- (* nostep final state *)
+  red; intros; red; intros. inv H; inv H0.
+- (* final states *)
+  inv H; inv H0; auto.
+Qed.
+
 (** * Alternate operational semantics (big-step) *)
 
 (** We now define another semantics for Cminor without [goto] that follows
@@ -612,12 +676,24 @@ Definition outcome_block (out: outcome) : outcome :=
   | out => out
   end.
 
+(*
+Definition outcome_result_value
+    (out: outcome) (retsig: rettype) (vres: val) : Prop :=
+  match out with
+  | Out_normal => vres = Vundef
+  | Out_return None => vres = Vundef
+  | Out_return (Some v) => retsig <> Tvoid /\ vres = v
+  | Out_tailcall_return v => vres = v
+  | _ => False
+  end.
+*)
+
 Definition outcome_result_value
-    (out: outcome) (retsig: option typ) (vres: val) : Prop :=
+    (out: outcome) (vres: val) : Prop :=
   match out with
   | Out_normal => vres = Vundef
   | Out_return None => vres = Vundef
-  | Out_return (Some v) => retsig <> None /\ vres = v
+  | Out_return (Some v) => vres = v
   | Out_tailcall_return v => vres = v
   | _ => False
   end.
@@ -647,7 +723,7 @@ Inductive eval_funcall:
       Mem.alloc m 0 f.(fn_stackspace) = (m1, sp) ->
       set_locals f.(fn_vars) (set_params vargs f.(fn_params)) = e ->
       exec_stmt f (Vptr sp Ptrofs.zero) e m1 f.(fn_body) t e2 m2 out ->
-      outcome_result_value out f.(fn_sig).(sig_res) vres ->
+      outcome_result_value out vres ->
       outcome_free_mem out m2 sp f.(fn_stackspace) m3 ->
       eval_funcall m (Internal f) vargs t m3 vres
   | eval_funcall_external:
@@ -931,7 +1007,7 @@ Proof.
   subst vres. replace k with (call_cont k') by congruence.
   apply star_one. apply step_return_0; auto.
   (* Out_return Some *)
-  destruct H3. subst vres.
+  subst vres.
   replace k with (call_cont k') by congruence.
   apply star_one. eapply step_return_1; eauto.
   (* Out_tailcall_return *)
diff --git a/backend/Cminortyping.v b/backend/Cminortyping.v
new file mode 100644
index 00000000..92ec45f2
--- /dev/null
+++ b/backend/Cminortyping.v
@@ -0,0 +1,803 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+Require Import Coqlib Maps Errors.
+Require Import AST Integers Floats Values Memory Globalenvs Events Smallstep.
+Require Import Cminor.
+Require Import Unityping.
+
+Local Open Scope string_scope.
+Local Open Scope error_monad_scope.
+
+(** * Type inference algorithm *)
+
+Definition type_constant (c: constant) : typ :=
+  match c with
+  | Ointconst _ => Tint
+  | Ofloatconst _ => Tfloat
+  | Osingleconst _ => Tsingle
+  | Olongconst _ => Tlong
+  | Oaddrsymbol _ _ => Tptr
+  | Oaddrstack _ => Tptr
+  end.
+
+Definition type_unop (op: unary_operation) : typ * typ :=
+  match op with
+  | Ocast8unsigned | Ocast8signed | Ocast16unsigned | Ocast16signed
+  | Onegint | Onotint => (Tint, Tint)
+  | Onegf | Oabsf => (Tfloat, Tfloat)
+  | Onegfs | Oabsfs => (Tsingle, Tsingle)
+  | Osingleoffloat => (Tfloat, Tsingle)
+  | Ofloatofsingle => (Tsingle, Tfloat)
+  | Ointoffloat | Ointuoffloat => (Tfloat, Tint)
+  | Ofloatofint | Ofloatofintu => (Tint, Tfloat)
+  | Ointofsingle | Ointuofsingle => (Tsingle, Tint)
+  | Osingleofint | Osingleofintu => (Tint, Tsingle)
+  | Onegl | Onotl => (Tlong, Tlong)
+  | Ointoflong => (Tlong, Tint)
+  | Olongofint | Olongofintu => (Tint, Tlong)
+  | Olongoffloat | Olonguoffloat => (Tfloat, Tlong)
+  | Ofloatoflong | Ofloatoflongu => (Tlong, Tfloat)
+  | Olongofsingle | Olonguofsingle => (Tsingle, Tlong)
+  | Osingleoflong | Osingleoflongu => (Tlong, Tsingle)
+  end.
+
+Definition type_binop (op: binary_operation) : typ * typ * typ :=
+  match op with
+  | Oadd  | Osub  | Omul  | Odiv  | Odivu  | Omod  | Omodu
+  | Oand  | Oor   | Oxor  | Oshl  | Oshr   | Oshru => (Tint, Tint, Tint)
+  | Oaddf | Osubf | Omulf | Odivf  => (Tfloat, Tfloat, Tfloat)
+  | Oaddfs| Osubfs| Omulfs| Odivfs => (Tsingle, Tsingle, Tsingle)
+  | Oaddl | Osubl | Omull | Odivl | Odivlu | Omodl | Omodlu
+  | Oandl | Oorl  | Oxorl => (Tlong, Tlong, Tlong)
+  | Oshll | Oshrl | Oshrlu => (Tlong, Tint, Tlong)
+  | Ocmp _ | Ocmpu _ => (Tint, Tint, Tint)
+  | Ocmpf _ => (Tfloat, Tfloat, Tint)
+  | Ocmpfs _ => (Tsingle, Tsingle, Tint)
+  | Ocmpl _ | Ocmplu _ => (Tlong, Tlong, Tint)
+  end.
+
+Module RTLtypes <: TYPE_ALGEBRA.
+
+Definition t := typ.
+Definition eq := typ_eq.
+Definition default := Tint.
+
+End RTLtypes.
+
+Module S := UniSolver(RTLtypes).
+
+Definition expect (e: S.typenv) (t1 t2: typ) : res S.typenv :=
+  if typ_eq t1 t2 then OK e else Error (msg "type mismatch").
+
+Fixpoint type_expr (e: S.typenv) (a: expr) (t: typ) : res S.typenv :=
+  match a with
+  | Evar id => S.set e id t
+  | Econst c => expect e (type_constant c) t
+  | Eunop op a1 =>
+      let '(targ1, tres) := type_unop op in
+      do e1 <- type_expr e a1 targ1;
+      expect e1 tres t
+  | Ebinop op a1 a2 =>
+      let '(targ1, targ2, tres) := type_binop op in
+      do e1 <- type_expr e a1 targ1;
+      do e2 <- type_expr e1 a2 targ2;
+      expect e2 tres t
+  | Eload chunk a1 =>
+      do e1 <- type_expr e a1 Tptr;
+      expect e1 (type_of_chunk chunk) t
+  end.
+
+Fixpoint type_exprlist (e: S.typenv) (al: list expr) (tl: list typ) : res S.typenv :=
+  match al, tl with
+  | nil, nil => OK e
+  | a :: al, t :: tl => do e1 <- type_expr e a t; type_exprlist e1 al tl
+  | _, _ => Error (msg "arity mismatch")
+  end.
+
+Definition type_assign (e: S.typenv) (id: ident) (a: expr) : res S.typenv :=
+  match a with
+  | Evar id' =>
+      do (changed, e1) <- S.move e id id'; OK e1
+  | Econst c =>
+      S.set e id (type_constant c)
+  | Eunop op a1 =>
+      let '(targ1, tres) := type_unop op in
+      do e1 <- type_expr e a1 targ1;
+      S.set e1 id tres
+  | Ebinop op a1 a2 =>
+      let '(targ1, targ2, tres) := type_binop op in
+      do e1 <- type_expr e a1 targ1;
+      do e2 <- type_expr e1 a2 targ2;
+      S.set e2 id tres
+  | Eload chunk a1 =>
+      do e1 <- type_expr e a1 Tptr;
+      S.set e1 id (type_of_chunk chunk)
+  end.
+
+Definition opt_set (e: S.typenv) (optid: option ident) (ty: typ) : res S.typenv :=
+  match optid with
+  | None => OK e
+  | Some id => S.set e id ty
+  end.
+
+Fixpoint type_stmt (tret: rettype) (e: S.typenv) (s: stmt) : res S.typenv :=
+  match s with
+  | Sskip => OK e
+  | Sassign id a => type_assign e id a
+  | Sstore chunk a1 a2 =>
+      do e1 <- type_expr e a1 Tptr; type_expr e1 a2 (type_of_chunk chunk)
+  | Scall optid sg fn args =>
+      do e1 <- type_expr e fn Tptr;
+      do e2 <- type_exprlist e1 args sg.(sig_args);
+      opt_set e2 optid (proj_sig_res sg)
+  | Stailcall sg fn args =>
+      assertion (rettype_eq sg.(sig_res) tret);
+      do e1 <- type_expr e fn Tptr;
+      type_exprlist e1 args sg.(sig_args)
+  | Sbuiltin optid ef args =>
+      let sg := ef_sig ef in
+      do e1 <- type_exprlist e args sg.(sig_args);
+      opt_set e1 optid (proj_sig_res sg)
+  | Sseq s1 s2 =>
+      do e1 <- type_stmt tret e s1; type_stmt tret e1 s2
+  | Sifthenelse a s1 s2 =>
+      do e1 <- type_expr e a Tint;
+      do e2 <- type_stmt tret e1 s1;
+      type_stmt tret e2 s2
+  | Sloop s1 =>
+      type_stmt tret e s1
+  | Sblock s1 =>
+      type_stmt tret e s1
+  | Sexit n =>
+      OK e
+  | Sswitch sz a tbl dfl =>
+      type_expr e a (if sz then Tlong else Tint)
+  | Sreturn opta =>
+      match opta with
+      | None => OK e
+      | Some a => type_expr e a (proj_rettype tret)
+(*
+          if rettype_eq tret Tvoid
+          then Error (msg "inconsistent return")
+          else type_expr e a (proj_rettype tret)
+*)
+      end
+  | Slabel lbl s1 =>
+      type_stmt tret e s1
+  | Sgoto lbl =>
+      OK e
+  end.
+
+Definition typenv := ident -> typ.
+
+Definition type_function (f: function) : res typenv :=
+  do e1 <- S.set_list S.initial f.(fn_params) f.(fn_sig).(sig_args);
+  do e2 <- type_stmt f.(fn_sig).(sig_res) e1 f.(fn_body);
+  S.solve e2.
+
+(** * Relational specification of the type system *)
+
+Section SPEC.
+
+Variable env: ident -> typ.
+Variable tret: rettype.
+
+Inductive wt_expr: expr -> typ -> Prop :=
+  | wt_Evar: forall id,
+      wt_expr (Evar id) (env id)
+  | wt_Econst: forall c,
+      wt_expr (Econst c) (type_constant c)
+  | wt_Eunop: forall op a1 targ1 tres,
+      type_unop op = (targ1, tres) ->
+      wt_expr a1 targ1 ->
+      wt_expr (Eunop op a1) tres
+  | wt_Ebinop: forall op a1 a2 targ1 targ2 tres,
+      type_binop op = (targ1, targ2, tres) ->
+      wt_expr a1 targ1 -> wt_expr a2 targ2 ->
+      wt_expr (Ebinop op a1 a2) tres
+  | wt_Eload: forall chunk a1,
+      wt_expr a1 Tptr ->
+      wt_expr (Eload chunk a1) (type_of_chunk chunk).
+
+Definition wt_opt_assign (optid: option ident) (ty: rettype) : Prop :=
+  match optid with
+  | Some id => proj_rettype ty = env id
+  | _ => True
+  end.
+
+Inductive wt_stmt: stmt -> Prop :=
+  | wt_Sskip:
+      wt_stmt Sskip
+  | wt_Sassign: forall id a,
+      wt_expr a (env id) ->
+      wt_stmt (Sassign id a)
+  | wt_Sstore: forall chunk a1 a2,
+      wt_expr a1 Tptr -> wt_expr a2 (type_of_chunk chunk) ->
+      wt_stmt (Sstore chunk a1 a2)
+  | wt_Scall: forall optid sg a1 al,
+      wt_expr a1 Tptr -> list_forall2 wt_expr al sg.(sig_args) ->
+      wt_opt_assign optid sg.(sig_res) ->
+      wt_stmt (Scall optid sg a1 al)
+  | wt_Stailcall: forall sg a1 al,
+      wt_expr a1 Tptr -> list_forall2 wt_expr al sg.(sig_args) ->
+      sg.(sig_res) = tret ->
+      wt_stmt (Stailcall sg a1 al)
+  | wt_Sbuiltin: forall optid ef al,
+      list_forall2 wt_expr al (ef_sig ef).(sig_args) ->
+      wt_opt_assign optid (ef_sig ef).(sig_res) ->
+      wt_stmt (Sbuiltin optid ef al)
+  | wt_Sseq: forall s1 s2,
+      wt_stmt s1 -> wt_stmt s2 ->
+      wt_stmt (Sseq s1 s2)
+  | wt_Sifthenelse: forall a s1 s2,
+      wt_expr a Tint -> wt_stmt s1 -> wt_stmt s2 ->
+      wt_stmt (Sifthenelse a s1 s2)
+  | wt_Sloop: forall s1,
+      wt_stmt s1 ->
+      wt_stmt (Sloop s1)
+  | wt_Sblock: forall s1,
+      wt_stmt s1 ->
+      wt_stmt (Sblock s1)
+  | wt_Sexit: forall n,
+      wt_stmt (Sexit n)
+  | wt_Sswitch: forall (sz: bool) a tbl dfl,
+      wt_expr a (if sz then Tlong else Tint) ->
+      wt_stmt (Sswitch sz a tbl dfl)
+  | wt_Sreturn_none:
+      wt_stmt (Sreturn None)
+  | wt_Sreturn_some: forall a,
+      wt_expr a (proj_rettype tret) ->
+      wt_stmt (Sreturn (Some a))
+  | wt_Slabel: forall lbl s1,
+      wt_stmt s1 ->
+      wt_stmt (Slabel lbl s1)
+  | wt_Sgoto: forall lbl,
+      wt_stmt (Sgoto lbl).
+
+End SPEC.
+
+Inductive wt_function (env: typenv) (f: function) : Prop :=
+  wt_function_intro:
+    type_function f = OK env ->     (**r to ensure uniqueness of [env] *)
+    List.map env f.(fn_params) = f.(fn_sig).(sig_args) ->
+    wt_stmt env f.(fn_sig).(sig_res) f.(fn_body) ->
+    wt_function env f.
+
+Inductive wt_fundef: fundef -> Prop :=
+  | wt_fundef_internal: forall env f,
+      wt_function env f ->
+      wt_fundef (Internal f)
+  | wt_fundef_external: forall ef,
+      wt_fundef (External ef).
+
+Definition wt_program (p: program): Prop :=
+  forall i f, In (i, Gfun f) (prog_defs p) -> wt_fundef f.
+
+(** * Soundness of type inference *)
+
+Lemma expect_incr: forall te e t1 t2 e',
+  expect e t1 t2 = OK e' -> S.satisf te e' -> S.satisf te e.
+Proof.
+  unfold expect; intros. destruct (typ_eq t1 t2); inv H; auto.
+Qed.
+Hint Resolve expect_incr: ty.
+
+Lemma expect_sound: forall e t1 t2 e',
+  expect e t1 t2 = OK e' -> t1 = t2.
+Proof.
+  unfold expect; intros. destruct (typ_eq t1 t2); inv H; auto.
+Qed.
+
+Lemma type_expr_incr: forall te a t e e',
+  type_expr e a t = OK e' -> S.satisf te e' -> S.satisf te e.
+Proof.
+  induction a; simpl; intros until e'; intros T SAT; try (monadInv T); eauto with ty.
+- destruct (type_unop u) as [targ1 tres]; monadInv T; eauto with ty.
+- destruct (type_binop b) as [[targ1 targ2] tres]; monadInv T; eauto with ty.
+Qed.
+Hint Resolve type_expr_incr: ty.
+
+Lemma type_expr_sound: forall te a t e e',
+    type_expr e a t = OK e' -> S.satisf te e' -> wt_expr te a t.
+Proof.
+  induction a; simpl; intros until e'; intros T SAT; try (monadInv T).
+- erewrite <- S.set_sound by eauto. constructor.
+- erewrite <- expect_sound by eauto. constructor.
+- destruct (type_unop u) as [targ1 tres] eqn:TU; monadInv T.
+  erewrite <- expect_sound by eauto. econstructor; eauto with ty.
+- destruct (type_binop b) as [[targ1 targ2] tres] eqn:TB; monadInv T.
+  erewrite <- expect_sound by eauto. econstructor; eauto with ty.
+- erewrite <- expect_sound by eauto. econstructor; eauto with ty.
+Qed.
+
+Lemma type_exprlist_incr: forall te al tl e e',
+  type_exprlist e al tl = OK e' -> S.satisf te e' -> S.satisf te e.
+Proof.
+  induction al; destruct tl; simpl; intros until e'; intros T SAT; monadInv T; eauto with ty.
+Qed.
+Hint Resolve type_exprlist_incr: ty.
+
+Lemma type_exprlist_sound: forall te al tl e e',
+    type_exprlist e al tl = OK e' -> S.satisf te e' -> list_forall2 (wt_expr te) al tl.
+Proof.
+  induction al; destruct tl; simpl; intros until e'; intros T SAT; monadInv T.
+- constructor.
+- constructor; eauto using type_expr_sound with ty.
+Qed.
+
+Lemma type_assign_incr: forall te id a e e',
+    type_assign e id a = OK e' -> S.satisf te e' -> S.satisf te e.
+Proof.
+  induction a; simpl; intros until e'; intros T SAT; try (monadInv T); eauto with ty.
+- destruct (type_unop u) as [targ1 tres]; monadInv T; eauto with ty.
+- destruct (type_binop b) as [[targ1 targ2] tres]; monadInv T; eauto with ty.
+Qed.
+Hint Resolve type_assign_incr: ty.
+
+Lemma type_assign_sound: forall te id a e e',
+    type_assign e id a = OK e' -> S.satisf te e' -> wt_expr te a (te id).
+Proof.
+  induction a; simpl; intros until e'; intros T SAT; try (monadInv T).
+- erewrite S.move_sound by eauto. constructor.
+- erewrite S.set_sound by eauto. constructor.
+- destruct (type_unop u) as [targ1 tres] eqn:TU; monadInv T.
+  erewrite S.set_sound by eauto. econstructor; eauto using type_expr_sound with ty.
+- destruct (type_binop b) as [[targ1 targ2] tres] eqn:TB; monadInv T.
+  erewrite S.set_sound by eauto. econstructor; eauto using type_expr_sound with ty.
+- erewrite S.set_sound by eauto. econstructor; eauto using type_expr_sound with ty.
+Qed.
+
+Lemma opt_set_incr: forall te optid optty e e',
+    opt_set e optid optty = OK e' -> S.satisf te e' -> S.satisf te e.
+Proof.
+  unfold opt_set; intros. destruct optid, optty; try (monadInv H); eauto with ty.
+Qed.
+Hint Resolve opt_set_incr: ty.
+
+Lemma opt_set_sound: forall te optid sg e e',
+    opt_set e optid (proj_sig_res sg) = OK e' -> S.satisf te e' ->
+    wt_opt_assign te optid sg.(sig_res).
+Proof.
+  unfold opt_set; intros; red. destruct optid.
+- erewrite S.set_sound by eauto. auto.
+- inv H. auto.
+Qed.
+
+Lemma type_stmt_incr: forall te tret s e e',
+    type_stmt tret e s = OK e' -> S.satisf te e' -> S.satisf te e.
+Proof.
+  induction s; simpl; intros e1 e2 T SAT; try (monadInv T); eauto with ty.
+- destruct tret, o; try (monadInv T); eauto with ty.
+Qed.
+Hint Resolve type_stmt_incr: ty.
+
+Lemma type_stmt_sound: forall te tret s e e',
+    type_stmt tret e s = OK e' -> S.satisf te e' -> wt_stmt te tret s.
+Proof.
+  induction s; simpl; intros e1 e2 T SAT; try (monadInv T).
+- constructor.
+- constructor; eauto using type_assign_sound.
+- constructor; eauto using type_expr_sound with ty.
+- constructor; eauto using type_expr_sound, type_exprlist_sound, opt_set_sound with ty.
+- constructor; eauto using type_expr_sound, type_exprlist_sound with ty.
+- constructor; eauto using type_exprlist_sound, opt_set_sound with ty.
+- constructor; eauto with ty.
+- constructor; eauto using type_expr_sound with ty.
+- constructor; eauto.
+- constructor; eauto.
+- constructor.
+- constructor; eauto using type_expr_sound with ty.
+- destruct o; try (monadInv T); econstructor; eauto using type_expr_sound with ty.
+- constructor; eauto.
+- constructor.
+Qed.
+
+Theorem type_function_sound: forall f env,
+  type_function f = OK env -> wt_function env f.
+Proof.
+  intros. generalize H; unfold type_function; intros T; monadInv T.
+  assert (S.satisf env x0) by (apply S.solve_sound; auto).
+  constructor; eauto using S.set_list_sound, type_stmt_sound with ty.
+Qed.
+
+(** * Semantic soundness of the type system *)
+
+Definition wt_env (env: typenv) (e: Cminor.env) : Prop :=
+  forall id v, e!id = Some v -> Val.has_type v (env id).
+
+Definition def_env (f: function) (e: Cminor.env) : Prop :=
+  forall id, In id f.(fn_params) \/ In id f.(fn_vars) -> exists v, e!id = Some v.
+
+Inductive wt_cont_call: cont -> rettype -> Prop :=
+  | wt_cont_Kstop:
+      wt_cont_call Kstop Tint
+  | wt_cont_Kcall: forall optid f sp e k tret env
+        (WT_FN: wt_function env f)
+        (WT_CONT: wt_cont env f.(fn_sig).(sig_res) k)
+        (WT_ENV: wt_env env e)
+        (DEF_ENV: def_env f e)
+        (WT_DEST: wt_opt_assign env optid tret),
+      wt_cont_call (Kcall optid f sp e k) tret
+
+with wt_cont: typenv -> rettype -> cont -> Prop :=
+  | wt_cont_Kseq: forall env tret s k,
+      wt_stmt env tret s ->
+      wt_cont env tret k ->
+      wt_cont env tret (Kseq s k)
+  | wt_cont_Kblock: forall env tret k,
+      wt_cont env tret k ->
+      wt_cont env tret (Kblock k)
+  | wt_cont_other: forall env tret k,
+      wt_cont_call k tret ->
+      wt_cont env tret k.
+
+Inductive wt_state: state -> Prop :=
+  | wt_normal_state: forall f s k sp e m env
+        (WT_FN: wt_function env f)
+        (WT_STMT: wt_stmt env f.(fn_sig).(sig_res) s)
+        (WT_CONT: wt_cont env f.(fn_sig).(sig_res) k)
+        (WT_ENV: wt_env env e)
+        (DEF_ENV: def_env f e),
+      wt_state (State f s k sp e m)
+  | wt_call_state: forall f args k m
+        (WT_FD: wt_fundef f)
+        (WT_ARGS: Val.has_type_list args (funsig f).(sig_args))
+        (WT_CONT: wt_cont_call k (funsig f).(sig_res)),
+      wt_state (Callstate f args k m)
+  | wt_return_state: forall v k m tret
+        (WT_RES: Val.has_type v (proj_rettype tret))
+        (WT_CONT: wt_cont_call k tret),
+      wt_state (Returnstate v k m).
+
+Lemma wt_is_call_cont:
+  forall env tret k, wt_cont env tret k -> is_call_cont k -> wt_cont_call k tret.
+Proof.
+  destruct 1; intros ICC; contradiction || auto.
+Qed.
+
+Lemma call_cont_wt:
+  forall env tret k, wt_cont env tret k -> wt_cont_call (call_cont k) tret.
+Proof.
+  induction 1; simpl; auto. inversion H; subst; auto.
+Qed.
+
+Lemma wt_env_assign: forall env id e v,
+  wt_env env e -> Val.has_type v (env id) -> wt_env env (PTree.set id v e).
+Proof.
+  intros; red; intros. rewrite PTree.gsspec in H1; destruct (peq id0 id).
+- congruence.
+- auto.
+Qed.
+
+Lemma def_env_assign: forall f e id v,
+  def_env f e -> def_env f (PTree.set id v e).
+Proof.
+  intros; red; intros i IN. rewrite PTree.gsspec. destruct (peq i id).
+  exists v; auto.
+  auto.
+Qed.
+
+Lemma wt_env_set_params: forall env il vl,
+  Val.has_type_list vl (map env il) -> wt_env env (set_params vl il).
+Proof.
+  induction il as [ | i il]; destruct vl as [ | vl]; simpl; intros; try contradiction.
+- red; intros. rewrite PTree.gempty in H0; discriminate.
+- destruct H. apply wt_env_assign; auto.
+Qed.
+
+Lemma def_set_params: forall id il vl,
+  In id il -> exists v, PTree.get id (set_params vl il) = Some v.
+Proof.
+  induction il as [ | i il]; simpl; intros.
+- contradiction.
+- destruct vl as [ | v vl]; rewrite PTree.gsspec; destruct (peq id i).
+  econstructor; eauto.
+  apply IHil; intuition congruence.
+  econstructor; eauto.
+  apply IHil; intuition congruence.
+Qed.
+
+Lemma wt_env_set_locals: forall env il e,
+  wt_env env e -> wt_env env (set_locals il e).
+Proof.
+  induction il as [ | i il]; simpl; intros.
+- auto.
+- apply wt_env_assign; auto. exact I.
+Qed.
+
+Lemma def_set_locals: forall id il e,
+  (exists v, PTree.get id e = Some v) \/ In id il ->
+  exists v, PTree.get id (set_locals il e) = Some v.
+Proof.
+  induction il as [ | i il]; simpl; intros.
+- tauto.
+- rewrite PTree.gsspec; destruct (peq id i).
+  econstructor; eauto.
+  apply IHil; intuition congruence.
+Qed.
+
+Lemma wt_find_label: forall env tret lbl s k,
+  wt_stmt env tret s -> wt_cont env tret k ->
+  match find_label lbl s k with
+  | Some (s', k') => wt_stmt env tret s' /\ wt_cont env tret k'
+  | None => True
+  end.
+Proof.
+  induction s; intros k WS WK; simpl; auto.
+- inv WS. assert (wt_cont env tret (Kseq s2 k)) by (constructor; auto).
+  specialize (IHs1 _ H1 H). destruct (find_label lbl s1 (Kseq s2 k)).
+  auto. apply IHs2; auto.
+- inv WS. specialize (IHs1 _ H3 WK). destruct (find_label lbl s1 k).
+  auto. apply IHs2; auto.
+- inversion WS; subst. apply IHs; auto. constructor; auto.
+- inv WS. apply IHs; auto. constructor; auto.
+- inv WS. destruct (ident_eq lbl l). auto. apply IHs; auto.
+Qed.
+
+Section SUBJECT_REDUCTION.
+
+Variable p: program.
+
+Hypothesis wt_p: wt_program p.
+
+Let ge := Genv.globalenv p.
+
+Ltac VHT :=
+  match goal with
+  | [ |- Val.has_type (if Archi.ptr64 then _ else _) _] => unfold Val.has_type; destruct Archi.ptr64 eqn:?; VHT
+  | [ |- Val.has_type (match ?v with _ => _ end) _] => destruct v; VHT
+  | [ |- Val.has_type (Vptr _ _) Tptr ] => apply Val.Vptr_has_type
+  | [ |- Val.has_type _ _ ] => exact I
+  | [ |- Val.has_type (?f _ _ _ _ _) _ ] => unfold f; VHT
+  | [ |- Val.has_type (?f _ _ _ _) _ ] => unfold f; VHT
+  | [ |- Val.has_type (?f _ _) _ ] => unfold f; VHT
+  | [ |- Val.has_type (?f _ _ _) _ ] => unfold f; VHT
+  | [ |- Val.has_type (?f _) _ ] => unfold f; VHT
+  | [ |- True ] => exact I
+  | [ |- ?x = ?x ] => reflexivity
+  | _ => idtac
+  end.
+
+Ltac VHT' :=
+  match goal with
+  | [ H: None = Some _ |- _ ] => discriminate
+  | [ H: Some _ = Some _ |- _ ] => inv H; VHT
+  | [ H: match ?x with _ => _ end = Some _ |- _ ] => destruct x; VHT'
+  | [ H: ?f _ _ _ _ = Some _ |- _ ] => unfold f in H; VHT'
+  | [ H: ?f _ _ _ = Some _ |- _ ] => unfold f in H; VHT'
+  | [ H: ?f _ _ = Some _ |- _ ] => unfold f in H; VHT'
+  | [ H: ?f _ = Some _ |- _ ] => unfold f in H; VHT'
+  | _ => idtac
+  end.
+
+Lemma type_constant_sound: forall sp cst v,
+  eval_constant ge sp cst = Some v ->
+  Val.has_type v (type_constant cst).
+Proof.
+  intros until v; intros EV. destruct cst; simpl in *; inv EV; VHT.
+Qed.
+
+Lemma type_unop_sound: forall op v1 v,
+  eval_unop op v1 = Some v -> Val.has_type v (snd (type_unop op)).
+Proof.
+  unfold eval_unop; intros op v1 v EV; destruct op; simpl; VHT'.
+Qed.
+
+Lemma type_binop_sound: forall op v1 v2 m v,
+  eval_binop op v1 v2 m = Some v -> Val.has_type v (snd (type_binop op)).
+Proof.
+  unfold eval_binop; intros op v1 v2 m v EV; destruct op; simpl; VHT';
+  destruct (eq_block b b0); VHT.
+Qed.
+
+Lemma wt_eval_expr: forall env sp e m a v,
+  eval_expr ge sp e m a v ->
+  forall t,
+  wt_expr env a t ->
+  wt_env env e ->
+  Val.has_type v t.
+Proof.
+  induction 1; intros t WT ENV.
+- inv WT. apply ENV; auto.
+- inv WT. eapply type_constant_sound; eauto.
+- inv WT. replace t with (snd (type_unop op)) by (rewrite H3; auto). eapply type_unop_sound; eauto.
+- inv WT. replace t with (snd (type_binop op)) by (rewrite H5; auto). eapply type_binop_sound; eauto.
+- inv WT. destruct vaddr; try discriminate. eapply Mem.load_type; eauto.
+Qed.
+
+Lemma wt_eval_exprlist: forall env sp e m al vl,
+  eval_exprlist ge sp e m al vl ->
+  forall tl,
+  list_forall2 (wt_expr env) al tl ->
+  wt_env env e ->
+  Val.has_type_list vl tl.
+Proof.
+  induction 1; intros tl WT ENV; inv WT; simpl.
+- auto.
+- split. eapply wt_eval_expr; eauto. eauto.
+Qed.
+
+Lemma wt_find_funct: forall v fd,
+  Genv.find_funct ge v = Some fd -> wt_fundef fd.
+Proof.
+  intros. eapply Genv.find_funct_prop; eauto.
+Qed.
+
+Lemma subject_reduction:
+  forall st1 t st2, step ge st1 t st2 ->
+  forall (WT: wt_state st1), wt_state st2.
+Proof.
+  destruct 1; intros; inv WT.
+- inv WT_CONT. econstructor; eauto. inv H.
+- inv WT_CONT. econstructor; eauto. inv H.
+- econstructor; eauto using wt_is_call_cont. exact I.
+- inv WT_STMT. econstructor; eauto using wt_Sskip.
+  apply wt_env_assign; auto. eapply wt_eval_expr; eauto.
+  apply def_env_assign; auto.
+- econstructor; eauto using wt_Sskip.
+- inv WT_STMT. econstructor; eauto.
+  eapply wt_find_funct; eauto.
+  eapply wt_eval_exprlist; eauto.
+  econstructor; eauto.
+- inv WT_STMT. econstructor; eauto.
+  eapply wt_find_funct; eauto.
+  eapply wt_eval_exprlist; eauto.
+  rewrite H8; eapply call_cont_wt; eauto.
+- inv WT_STMT. exploit external_call_well_typed; eauto. intros TRES.
+  econstructor; eauto using wt_Sskip.
+  destruct optid; auto. apply wt_env_assign; auto. rewrite <- H5; auto.
+  destruct optid; auto. apply def_env_assign; auto.
+- inv WT_STMT. econstructor; eauto. econstructor; eauto.
+- inv WT_STMT. destruct b; econstructor; eauto.
+- inv WT_STMT. econstructor; eauto. econstructor; eauto. constructor; auto.
+- inv WT_STMT. econstructor; eauto. econstructor; eauto.
+- inv WT_CONT. econstructor; eauto. inv H.
+- inv WT_CONT. econstructor; eauto using wt_Sskip. inv H.
+- inv WT_CONT. econstructor; eauto using wt_Sexit. inv H.
+- econstructor; eauto using wt_Sexit.
+- inv WT_STMT. econstructor; eauto using call_cont_wt. exact I.
+- inv WT_STMT. econstructor; eauto using call_cont_wt.
+  eapply wt_eval_expr; eauto.
+- inv WT_STMT. econstructor; eauto.
+- inversion WT_FN; subst.
+  assert (WT_CK: wt_cont env (sig_res (fn_sig f)) (call_cont k)).
+  { constructor. eapply call_cont_wt; eauto. }
+  generalize (wt_find_label _ _ lbl _ _ H2 WT_CK).
+  rewrite H. intros [WT_STMT' WT_CONT']. econstructor; eauto.
+- inv WT_FD. inversion H1; subst. econstructor; eauto.
+  constructor; auto.
+  apply wt_env_set_locals. apply wt_env_set_params. rewrite H2; auto.
+  red; intros. apply def_set_locals. destruct H4; auto. left; apply def_set_params; auto.
+- exploit external_call_well_typed; eauto. intros.
+  econstructor; eauto.
+- inv WT_CONT. econstructor; eauto using wt_Sskip.
+  red in WT_DEST.
+  destruct optid. rewrite WT_DEST in WT_RES. apply wt_env_assign; auto. assumption.
+  destruct optid. apply def_env_assign; auto. assumption.
+Qed.
+
+Lemma subject_reduction_star:
+  forall st1 t st2, star step ge st1 t st2 ->
+  forall (WT: wt_state st1), wt_state st2.
+Proof.
+  induction 1; eauto using subject_reduction.
+Qed.
+
+Lemma wt_initial_state:
+  forall S, initial_state p S -> wt_state S.
+Proof.
+  intros. inv H. constructor. eapply Genv.find_funct_ptr_prop; eauto.
+  rewrite H3; constructor.
+  rewrite H3; constructor.
+Qed.
+
+End SUBJECT_REDUCTION.
+
+(** * Safe expressions *)
+
+(** Function parameters and declared local variables are always defined
+  throughout the execution of a function.  The following [known_idents]
+  data structure represents the set of those variables, with efficient membership. *)
+
+Definition known_idents := PTree.t unit.
+
+Definition is_known (ki: known_idents) (id: ident) :=
+  match ki!id with Some _ => true | None => false end.
+
+Definition known_id (f: function) : known_idents :=
+  let add (ki: known_idents) (id: ident) := PTree.set id tt ki in
+  List.fold_left add f.(fn_vars)
+      (List.fold_left add f.(fn_params) (PTree.empty unit)).
+
+(** A Cminor expression is safe if it always evaluates to a value,
+    never causing a run-time error. *)
+
+Definition safe_unop (op: unary_operation) : bool :=
+  match op with
+  | Ointoffloat | Ointuoffloat | Ofloatofint | Ofloatofintu => false
+  | Ointofsingle | Ointuofsingle | Osingleofint | Osingleofintu => false
+  | Olongoffloat | Olonguoffloat | Ofloatoflong | Ofloatoflongu => false
+  | Olongofsingle | Olonguofsingle | Osingleoflong | Osingleoflongu => false
+  | _ => true
+  end.
+
+Definition safe_binop (op: binary_operation) : bool :=
+  match op with
+  | Odiv | Odivu | Omod | Omodu => false
+  | Odivl | Odivlu | Omodl | Omodlu => false
+  | Ocmpl _ | Ocmplu _ => false
+  | _ => true
+  end.
+
+Fixpoint safe_expr (ki: known_idents) (a: expr) : bool :=
+  match a with
+  | Evar v => is_known ki v
+  | Econst c => true
+  | Eunop op e1 => safe_unop op && safe_expr ki e1
+  | Ebinop op e1 e2 => safe_binop op && safe_expr ki e1 && safe_expr ki e2
+  | Eload chunk e => false
+  end.
+
+(** Soundness of [known_id]. *)
+
+Lemma known_id_sound_1:
+  forall f id x, (known_id f)!id = Some x -> In id f.(fn_params) \/ In id f.(fn_vars).
+Proof.
+  unfold known_id.
+  set (add := fun (ki: known_idents) (id: ident) => PTree.set id tt ki).
+  intros.
+  assert (REC: forall l ki, (fold_left add l ki)!id = Some x -> In id l \/ ki!id = Some x).
+  { induction l as [ | i l ]; simpl; intros.
+    - auto.
+    - apply IHl in H0. destruct H0; auto. unfold add in H0; rewrite PTree.gsspec in H0.
+      destruct (peq id i); auto. }
+  apply REC in H. destruct H; auto. apply REC in H. destruct H; auto.
+  rewrite PTree.gempty in H; discriminate.
+Qed.
+
+Lemma known_id_sound_2:
+  forall f id, is_known (known_id f) id = true -> In id f.(fn_params) \/ In id f.(fn_vars).
+Proof.
+  unfold is_known; intros. destruct (known_id f)!id eqn:E; try discriminate.
+  eapply known_id_sound_1; eauto.
+Qed.
+
+(** Expressions that satisfy [safe_expr] always evaluate to a value. *)
+
+Lemma eval_safe_expr:
+  forall ge f sp e m a,
+  def_env f e ->
+  safe_expr (known_id f) a = true ->
+  exists v, eval_expr ge sp e m a v.
+Proof.
+  induction a; simpl; intros.
+  - apply known_id_sound_2 in H0.
+    destruct (H i H0) as [v E].
+    exists v; constructor; auto.
+  - destruct (eval_constant ge sp c) as [v|] eqn:E.
+    exists v; constructor; auto.
+    destruct c; discriminate.
+  - InvBooleans. destruct IHa as [v1 E1]; auto.
+    destruct (eval_unop u v1) as [v|] eqn:E.
+    exists v; econstructor; eauto.
+    destruct u; discriminate.
+  - InvBooleans.
+    destruct IHa1 as [v1 E1]; auto.
+    destruct IHa2 as [v2 E2]; auto.
+    destruct (eval_binop b v1 v2 m) as [v|] eqn:E.
+    exists v; econstructor; eauto.
+    destruct b; discriminate.
+  - discriminate.
+Qed.
+
+
diff --git a/backend/Constprop.v b/backend/Constprop.v
index d8211ffe..4aab7677 100644
--- a/backend/Constprop.v
+++ b/backend/Constprop.v
@@ -15,7 +15,7 @@
   and the corresponding code rewriting. *)
 
 Require Import Coqlib Maps Integers Floats Lattice Kildall.
-Require Import AST Linking.
+Require Import AST Linking Builtins.
 Require Compopts Machregs.
 Require Import Op Registers RTL.
 Require Import Liveness ValueDomain ValueAOp ValueAnalysis.
@@ -139,6 +139,30 @@ Definition builtin_strength_reduction
   | _ => builtin_args_strength_reduction ae al (Machregs.builtin_constraints ef)
   end.
 
+(*
+Definition transf_builtin
+             (ae: AE.t) (am: amem) (rm: romem)
+             (ef: external_function)
+             (args: list (builtin_arg reg)) (res: builtin_res reg) (s: node) :=
+  let dfl := Ibuiltin ef (builtin_strength_reduction ae ef args) res s in
+  match ef, res with
+  | EF_builtin name sg, BR rd =>
+      match lookup_builtin_function name sg with
+      | Some bf => 
+          match eval_static_builtin_function ae am rm bf args with
+          | Some a =>
+              match const_for_result a with
+              | Some cop => Iop cop nil rd s
+              | None => dfl
+              end
+          | None => dfl
+          end
+      | None => dfl
+      end
+  | _, _ => dfl
+  end.
+*)
+
 Definition transf_instr (f: function) (an: PMap.t VA.t) (rm: romem)
                         (pc: node) (instr: instruction) :=
   match an!!pc with
@@ -176,7 +200,23 @@ Definition transf_instr (f: function) (an: PMap.t VA.t) (rm: romem)
       | Itailcall sig ros args =>
           Itailcall sig (transf_ros ae ros) args
       | Ibuiltin ef args res s =>
-          Ibuiltin ef (builtin_strength_reduction ae ef args) res s
+          let dfl := Ibuiltin ef (builtin_strength_reduction ae ef args) res s in
+          match ef, res with
+          | EF_builtin name sg, BR rd =>
+              match lookup_builtin_function name sg with
+              | Some bf => 
+                  match eval_static_builtin_function ae am rm bf args with
+                  | Some a =>
+                      match const_for_result a with
+                      | Some cop => Iop cop nil rd s
+                      | None => dfl
+                      end
+                 | None => dfl
+                 end
+             | None => dfl
+             end
+          | _, _ => dfl
+          end
       | Icond cond args s1 s2 =>
           let aargs := aregs ae args in
           match resolve_branch (eval_static_condition cond aargs) with
diff --git a/backend/Constpropproof.v b/backend/Constpropproof.v
index e28519ca..a5d08a0f 100644
--- a/backend/Constpropproof.v
+++ b/backend/Constpropproof.v
@@ -14,7 +14,7 @@
 
 Require Import Coqlib Maps Integers Floats Lattice Kildall.
 Require Import AST Linking.
-Require Import Values Events Memory Globalenvs Smallstep.
+Require Import Values Builtins Events Memory Globalenvs Smallstep.
 Require Compopts Machregs.
 Require Import Op Registers RTL.
 Require Import Liveness ValueDomain ValueAOp ValueAnalysis.
@@ -474,19 +474,41 @@ Proof.
 - (* Ibuiltin *)
   rename pc'0 into pc. TransfInstr; intros.
 Opaque builtin_strength_reduction.
-  exploit builtin_strength_reduction_correct; eauto. intros (vargs' & P & Q).
-  exploit (@eval_builtin_args_lessdef _ ge (fun r => rs#r) (fun r => rs'#r)).
+  set (dfl := Ibuiltin ef (builtin_strength_reduction ae ef args) res pc') in *.
+  set (rm := romem_for cu) in *.
+  assert (DFL: (fn_code (transf_function rm f))!pc = Some dfl ->
+          exists (n2 : nat) (s2' : state),
+            step tge
+             (State s' (transf_function rm f) (Vptr sp0 Ptrofs.zero) pc rs' m'0) t s2' /\
+            match_states n2
+             (State s f (Vptr sp0 Ptrofs.zero) pc' (regmap_setres res vres rs) m') s2').
+  {
+    exploit builtin_strength_reduction_correct; eauto. intros (vargs' & P & Q).
+    exploit (@eval_builtin_args_lessdef _ ge (fun r => rs#r) (fun r => rs'#r)).
     apply REGS. eauto. eexact P.
-  intros (vargs'' & U & V).
-  exploit external_call_mem_extends; eauto.
-  intros [v' [m2' [A [B [C D]]]]].
+    intros (vargs'' & U & V).
+    exploit external_call_mem_extends; eauto.
+    intros (v' & m2' & A & B & C & D).
+    econstructor; econstructor; split.
+    eapply exec_Ibuiltin; eauto.
+    eapply eval_builtin_args_preserved. eexact symbols_preserved. eauto.
+    eapply external_call_symbols_preserved; eauto. apply senv_preserved.
+    eapply match_states_succ; eauto.
+    apply set_res_lessdef; auto.
+  }
+  destruct ef; auto.
+  destruct res; auto.
+  destruct (lookup_builtin_function name sg) as [bf|] eqn:LK; auto.
+  destruct (eval_static_builtin_function ae am rm bf args) as [a|] eqn:ES; auto.
+  destruct (const_for_result a) as [cop|] eqn:CR; auto.
+  clear DFL. simpl in H1; red in H1; rewrite LK in H1; inv H1.
+  exploit const_for_result_correct; eauto. 
+  eapply eval_static_builtin_function_sound; eauto.
+  intros (v' & A & B).
   left; econstructor; econstructor; split.
-  eapply exec_Ibuiltin; eauto.
-  eapply eval_builtin_args_preserved. eexact symbols_preserved. eauto.
-  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
+  eapply exec_Iop; eauto.
   eapply match_states_succ; eauto.
-  apply set_res_lessdef; auto.
-
+  apply set_reg_lessdef; auto.
 - (* Icond, preserved *)
   rename pc'0 into pc. TransfInstr.
   set (ac := eval_static_condition cond (aregs ae args)).
diff --git a/backend/Conventions.v b/backend/Conventions.v
index 989bfa05..14ffb587 100644
--- a/backend/Conventions.v
+++ b/backend/Conventions.v
@@ -34,6 +34,73 @@ Proof.
   apply IHpl; auto.
 Qed.
 
+(** ** Stack size of function arguments *)
+
+(** [size_arguments s] returns the number of [Outgoing] slots used
+  to call a function with signature [s]. *)
+
+Definition max_outgoing_1 (accu: Z) (l: loc) : Z :=
+  match l with
+  | S Outgoing ofs ty => Z.max accu (ofs + typesize ty)
+  | _ => accu
+  end.
+
+Definition max_outgoing_2 (accu: Z) (rl: rpair loc) : Z :=
+  match rl with
+  | One l => max_outgoing_1 accu l
+  | Twolong l1 l2 => max_outgoing_1 (max_outgoing_1 accu l1) l2
+  end.
+
+Definition size_arguments (s: signature) : Z :=
+  List.fold_left max_outgoing_2 (loc_arguments s) 0.
+
+(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)
+
+Remark fold_max_outgoing_above:
+  forall l n, fold_left max_outgoing_2 l n >= n.
+Proof.
+  assert (A: forall n l, max_outgoing_1 n l >= n).
+  { intros; unfold max_outgoing_1. destruct l as [_ | []]; xomega. }
+  induction l; simpl; intros. 
+  - omega.
+  - eapply Zge_trans. eauto.
+    destruct a; simpl. apply A. eapply Zge_trans; eauto.
+Qed.
+
+Lemma size_arguments_above:
+  forall s, size_arguments s >= 0.
+Proof.
+  intros. apply fold_max_outgoing_above.
+Qed.
+
+Lemma loc_arguments_bounded:
+  forall (s: signature) (ofs: Z) (ty: typ),
+  In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments s)) ->
+  ofs + typesize ty <= size_arguments s.
+Proof.
+  intros until ty.
+  assert (A: forall n l, n <= max_outgoing_1 n l).
+  { intros; unfold max_outgoing_1. destruct l as [_ | []]; xomega. }
+  assert (B: forall p n,
+             In (S Outgoing ofs ty) (regs_of_rpair p) ->
+             ofs + typesize ty <= max_outgoing_2 n p).
+  { intros. destruct p; simpl in H; intuition; subst; simpl.
+  - xomega.
+  - eapply Z.le_trans. 2: apply A. xomega.
+  - xomega. }
+  assert (C: forall l n,
+             In (S Outgoing ofs ty) (regs_of_rpairs l) ->
+             ofs + typesize ty <= fold_left max_outgoing_2 l n).
+  { induction l; simpl; intros.
+  - contradiction.
+  - rewrite in_app_iff in H. destruct H.
+  + eapply Z.le_trans. eapply B; eauto.
+    apply Z.ge_le. apply fold_max_outgoing_above.
+  + apply IHl; auto.
+  }
+  apply C. 
+Qed.
+
 (** ** Location of function parameters *)
 
 (** A function finds the values of its parameter in the same locations
@@ -128,8 +195,6 @@ Definition callee_save_loc (l: loc) :=
   | S sl ofs ty => sl <> Outgoing
   end.
 
-Hint Unfold callee_save_loc.
-
 Definition agree_callee_save (ls1 ls2: Locmap.t) : Prop :=
   forall l, callee_save_loc l -> ls1 l = ls2 l.
 
diff --git a/backend/Deadcodeproof.v b/backend/Deadcodeproof.v
index 199ac922..2edc0395 100644
--- a/backend/Deadcodeproof.v
+++ b/backend/Deadcodeproof.v
@@ -106,7 +106,7 @@ Local Transparent Mem.loadbytes.
   unfold Mem.loadbytes; intros. destruct H.
   destruct (Mem.range_perm_dec m1 b ofs (ofs + n) Cur Readable); inv H0.
   rewrite pred_dec_true. econstructor; split; eauto.
-  apply GETN. intros. rewrite nat_of_Z_max in H.
+  apply GETN. intros. rewrite Z_to_nat_max in H.
   assert (ofs <= i < ofs + n) by xomega.
   apply ma_memval0; auto.
   red; intros; eauto.
@@ -966,7 +966,7 @@ Ltac UseTransfer :=
   intros. eapply nlive_remove; eauto.
   unfold adst, vanalyze; rewrite AN; eapply aaddr_arg_sound_1; eauto.
   erewrite Mem.loadbytes_length in H1 by eauto.
-  rewrite nat_of_Z_eq in H1 by omega. auto.
+  rewrite Z2Nat.id in H1 by omega. auto.
   eauto.
   intros (tm' & A & B).
   econstructor; split.
@@ -993,7 +993,7 @@ Ltac UseTransfer :=
   intros (bc & A & B & C).
   intros. eapply nlive_contains; eauto.
   erewrite Mem.loadbytes_length in H0 by eauto.
-  rewrite nat_of_Z_eq in H0 by omega. auto.
+  rewrite Z2Nat.id in H0 by omega. auto.
 + (* annot *)
   destruct (transfer_builtin_args (kill_builtin_res res ne, nm) _x2) as (ne1, nm1) eqn:TR.
   InvSoundState.
diff --git a/backend/IRC.ml b/backend/IRC.ml
index 43955897..b359da35 100644
--- a/backend/IRC.ml
+++ b/backend/IRC.ml
@@ -240,7 +240,8 @@ type graph = {
 let class_of_type = function
   | Tint | Tlong -> 0
   | Tfloat | Tsingle -> 1
-  | Tany32 | Tany64 -> assert false
+  | Tany32 -> 0
+  | Tany64 -> if Archi.ptr64 then 0 else 1
 
 let class_of_reg r =
   if Conventions1.is_float_reg r then 1 else 0
diff --git a/backend/Inliningaux.ml b/backend/Inliningaux.ml
index 842e0c93..2e83eb0c 100644
--- a/backend/Inliningaux.ml
+++ b/backend/Inliningaux.ml
@@ -16,7 +16,7 @@ open FSetAVL
 open Maps
 open Op
 open Ordered
-open !RTL
+open! RTL
 
 module PSet = Make(OrderedPositive)
 
diff --git a/backend/Inliningproof.v b/backend/Inliningproof.v
index 2dcb8956..cc84b1cc 100644
--- a/backend/Inliningproof.v
+++ b/backend/Inliningproof.v
@@ -744,7 +744,7 @@ Lemma match_stacks_free_right:
   match_stacks F m m1' stk stk' sp.
 Proof.
   intros. eapply match_stacks_invariant; eauto.
-  intros. eapply Mem.perm_free_1; eauto.
+  intros. eapply Mem.perm_free_1; eauto with ordered_type.
   intros. eapply Mem.perm_free_3; eauto.
 Qed.
 
@@ -755,13 +755,13 @@ Proof.
   assert (2 <= sz -> (2 | n)). intros.
     destruct (zle sz 1). omegaContradiction.
     destruct (zle sz 2). auto.
-    destruct (zle sz 4). apply Zdivides_trans with 4; auto. exists 2; auto.
-    apply Zdivides_trans with 8; auto. exists 4; auto.
+    destruct (zle sz 4). apply Z.divide_trans with 4; auto. exists 2; auto.
+    apply Z.divide_trans with 8; auto. exists 4; auto.
   assert (4 <= sz -> (4 | n)). intros.
     destruct (zle sz 1). omegaContradiction.
     destruct (zle sz 2). omegaContradiction.
     destruct (zle sz 4). auto.
-    apply Zdivides_trans with 8; auto. exists 2; auto.
+    apply Z.divide_trans with 8; auto. exists 2; auto.
   assert (8 <= sz -> (8 | n)). intros.
     destruct (zle sz 1). omegaContradiction.
     destruct (zle sz 2). omegaContradiction.
@@ -1043,7 +1043,7 @@ Proof.
   eapply match_stacks_bound with (bound := sp').
   eapply match_stacks_invariant; eauto.
     intros. eapply Mem.perm_free_3; eauto.
-    intros. eapply Mem.perm_free_1; eauto.
+    intros. eapply Mem.perm_free_1; eauto with ordered_type.
     intros. eapply Mem.perm_free_3; eauto.
   erewrite Mem.nextblock_free; eauto. red in VB; xomega.
   eapply agree_val_regs; eauto.
@@ -1135,7 +1135,7 @@ Proof.
   eapply match_stacks_bound with (bound := sp').
   eapply match_stacks_invariant; eauto.
     intros. eapply Mem.perm_free_3; eauto.
-    intros. eapply Mem.perm_free_1; eauto.
+    intros. eapply Mem.perm_free_1; eauto with ordered_type.
     intros. eapply Mem.perm_free_3; eauto.
   erewrite Mem.nextblock_free; eauto. red in VB; xomega.
   destruct or; simpl. apply agree_val_reg; auto. auto.
@@ -1182,7 +1182,7 @@ Proof.
     subst b1. rewrite D in H8; inv H8. eelim Plt_strict; eauto.
     intros. eapply Mem.perm_alloc_1; eauto.
     intros. exploit Mem.perm_alloc_inv. eexact A. eauto.
-    rewrite dec_eq_false; auto.
+    rewrite dec_eq_false; auto with ordered_type.
   auto. auto. auto. eauto. auto.
   rewrite H5. apply agree_regs_init_regs. eauto. auto. inv H1; auto. congruence. auto.
   eapply Mem.valid_new_block; eauto.
@@ -1249,7 +1249,7 @@ Proof.
     eapply external_call_nextblock; eauto.
     auto. auto.
 
-- (* return fron noninlined function *)
+- (* return from noninlined function *)
   inv MS0.
 + (* normal case *)
   left; econstructor; split.
diff --git a/backend/Json.ml b/backend/Json.ml
index b8f66c08..bd4d6ff9 100644
--- a/backend/Json.ml
+++ b/backend/Json.ml
@@ -10,7 +10,6 @@
 (*                                                                     *)
 (* *********************************************************************)
 
-open Format
 open Camlcoq
 
 
@@ -18,16 +17,21 @@ open Camlcoq
 
 (* Print a string as json string *)
 let pp_jstring oc s =
-  fprintf oc "\"%s\"" s
+  output_string oc "\"";
+  output_string oc s;
+  output_string oc "\""
 
 (* Print a bool as json bool *)
-let pp_jbool oc = fprintf oc "%B"
+let pp_jbool oc b = output_string oc (string_of_bool b)
 
 (* Print an int as json int *)
-let pp_jint oc = fprintf oc "%d"
+let pp_jint oc i = output_string oc (string_of_int i)
 
 (* Print an int32 as json int *)
-let pp_jint32 oc = fprintf oc "%ld"
+let pp_jint32 oc i = output_string oc (Int32.to_string i)
+
+(* Print an int64 as json int *)
+let pp_jint64 oc i = output_string oc (Int64.to_string i)
 
 (* Print optional value *)
 let pp_jopt pp_elem oc = function
@@ -36,15 +40,19 @@ let pp_jopt pp_elem oc = function
 
 (* Print opening and closing curly braces for json dictionaries *)
 let pp_jobject_start pp =
-  fprintf pp "@[<v 1>{"
+  output_string pp "\n{"
 
 let pp_jobject_end pp =
-  fprintf pp "@;<0 -1>}@]"
+  output_string pp "}"
 
 (* Print a member of a json dictionary *)
 let pp_jmember ?(first=false) pp name pp_mem mem =
-  let sep = if first then "" else "," in
-  fprintf pp "%s@ \"%s\": %a" sep name pp_mem mem
+  if not first then output_string pp ",";
+  output_string pp " ";
+  pp_jstring pp name;
+  output_string pp " :";
+  pp_mem pp mem;
+  output_string pp "\n"
 
 (* Print singleton object *)
 let pp_jsingle_object pp name pp_mem mem =
@@ -54,29 +62,31 @@ let pp_jsingle_object pp name pp_mem mem =
 
 (* Print a list as json array *)
 let pp_jarray elem pp l =
-  match l with
-  | []  ->  fprintf pp "[]";
+  let pp_sep () = output_string pp ", " in
+  output_string pp "[";
+  begin match l with
+  | []  -> ()
   | hd::tail ->
-    fprintf pp "@[<v 1>[";
-    fprintf pp "%a" elem hd;
-    List.iter (fun l -> fprintf pp ",@ %a" elem l) tail;
-  fprintf pp "@;<0 -1>]@]"
+    elem pp hd;
+    List.iter (fun l -> pp_sep (); elem pp l) tail;
+  end;
+  output_string pp "]"
 
 (* Helper functions for printing coq integer and floats *)
 let pp_int pp i =
-  fprintf pp "%ld" (camlint_of_coqint i)
+  pp_jint32 pp (camlint_of_coqint i)
 
 let pp_int64 pp i =
-  fprintf pp "%Ld" (camlint64_of_coqint i)
+  pp_jint64 pp (camlint64_of_coqint i)
 
 let pp_float32 pp f =
-  fprintf pp "%ld" (camlint_of_coqint (Floats.Float32.to_bits f))
+  pp_jint32 pp (camlint_of_coqint (Floats.Float32.to_bits f))
 
 let pp_float64 pp f =
-  fprintf pp "%Ld" (camlint64_of_coqint (Floats.Float.to_bits f))
+  pp_jint64 pp (camlint64_of_coqint (Floats.Float.to_bits f))
 
 let pp_z pp z =
-  fprintf pp "%s" (Z.to_string z)
+  output_string pp (Z.to_string z)
 
 (* Helper functions for printing assembler constructs *)
 let pp_atom pp a =
@@ -106,4 +116,4 @@ let reset_id () =
 
 let pp_id_const pp () =
   let i = next_id () in
-  pp_jsingle_object pp "Integer" (fun pp i -> fprintf pp "%d" i) i
+  pp_jsingle_object pp "Integer" pp_jint i
diff --git a/backend/JsonAST.ml b/backend/JsonAST.ml
index 3469bdc6..8905e252 100644
--- a/backend/JsonAST.ml
+++ b/backend/JsonAST.ml
@@ -15,7 +15,6 @@ open Asm
 open AST
 open C2C
 open Json
-open Format
 open Sections
 
 
@@ -54,8 +53,8 @@ let pp_section pp sec =
   | Section_ais_annotation -> () (* There should be no info in the debug sections *)
 
 let pp_int_opt pp = function
-  | None -> fprintf pp "0"
-  | Some i -> fprintf pp "%d" i
+  | None -> output_string pp "0"
+  | Some i -> pp_jint pp i
 
 let pp_fundef pp_inst pp (name,fn) =
   let alignment = atom_alignof name
@@ -119,19 +118,18 @@ let pp_program pp pp_inst prog =
   pp_jobject_end pp
 
 let pp_mnemonics pp mnemonic_names =
-  let mnemonic_names = List.sort (String.compare) mnemonic_names in
-  let new_line pp () = pp_print_string pp "\n" in
-  pp_print_list ~pp_sep:new_line pp_print_string pp mnemonic_names
+  let new_line pp () = Format.pp_print_string pp "\n" in
+  Format.pp_print_list ~pp_sep:new_line Format.pp_print_string pp mnemonic_names
 
-let jdump_magic_number = "CompCertJDUMP" ^ Version.version
+let jdump_magic_number = "CompCertJDUMPRelease: " ^ Version.version
 
 let pp_ast pp pp_inst ast sourcename =
    let get_args () =
     let buf = Buffer.create 100 in
     Buffer.add_string buf Sys.executable_name;
-    for i = 1 to (Array.length  !Commandline.argv - 1) do
+    for i = 1 to (Array.length  Commandline.argv - 1) do
       Buffer.add_string buf " ";
-      Buffer.add_string buf (Responsefile.gnu_quote !Commandline.argv.(i));
+      Buffer.add_string buf (Responsefile.gnu_quote Commandline.argv.(i));
     done;
     Buffer.contents buf in
     let dump_compile_info pp () =
@@ -153,4 +151,4 @@ let pp_ast pp pp_inst ast sourcename =
     pp_jmember pp "Compilation Unit" pp_jstring sourcename;
     pp_jmember pp "Asm Ast" (fun pp prog -> pp_program pp pp_inst prog) ast;
     pp_jobject_end pp;
-    Format.pp_print_flush pp ()
+    flush pp
diff --git a/backend/JsonAST.mli b/backend/JsonAST.mli
index 7afdce51..c32439e4 100644
--- a/backend/JsonAST.mli
+++ b/backend/JsonAST.mli
@@ -13,4 +13,4 @@
 
 
 val pp_mnemonics : Format.formatter -> string list -> unit
-val pp_ast : Format.formatter -> (Format.formatter  -> Asm.code -> unit) -> (Asm.coq_function AST.fundef, 'a) AST.program  -> string -> unit
+val pp_ast : out_channel -> (out_channel  -> Asm.code -> unit) -> (Asm.coq_function AST.fundef, 'a) AST.program  -> string -> unit
diff --git a/backend/Linearizeaux.ml b/backend/Linearizeaux.ml
index 46d5c3f1..902724e0 100644
--- a/backend/Linearizeaux.ml
+++ b/backend/Linearizeaux.ml
@@ -106,7 +106,7 @@ let flatten_blocks blks =
   let cmp_minpc (mpc1, _) (mpc2, _) =
     if mpc1 = mpc2 then 0 else if mpc1 > mpc2 then -1 else 1
   in
-    List.flatten (List.map Pervasives.snd (List.sort cmp_minpc blks))
+    List.flatten (List.map snd (List.sort cmp_minpc blks))
 
 (* Build the enumeration *)
 
diff --git a/backend/Lineartyping.v b/backend/Lineartyping.v
index fc163719..0e3b7c8e 100644
--- a/backend/Lineartyping.v
+++ b/backend/Lineartyping.v
@@ -39,7 +39,7 @@ Definition slot_valid (sl: slot) (ofs: Z) (ty: typ): bool :=
   | Outgoing => zle 0 ofs
   | Incoming => In_dec Loc.eq (S Incoming ofs ty) (regs_of_rpairs (loc_parameters funct.(fn_sig)))
   end
-  && Zdivide_dec (typealign ty) ofs (typealign_pos ty).
+  && Zdivide_dec (typealign ty) ofs.
 
 Definition slot_writable (sl: slot) : bool :=
   match sl with
@@ -321,7 +321,7 @@ Local Opaque mreg_type.
   + (* other ops *)
     destruct (type_of_operation op) as [ty_args ty_res] eqn:TYOP. InvBooleans.
     econstructor; eauto.
-    apply wt_setreg; auto. eapply Val.has_subtype; eauto.
+    apply wt_setreg. eapply Val.has_subtype; eauto.
     change ty_res with (snd (ty_args, ty_res)). rewrite <- TYOP. eapply type_of_operation_sound; eauto.
     red; intros; subst op. simpl in ISMOVE.
     destruct args; try discriminate. destruct args; discriminate.
diff --git a/backend/NeedDomain.v b/backend/NeedDomain.v
index d431f3d8..3c2d8e20 100644
--- a/backend/NeedDomain.v
+++ b/backend/NeedDomain.v
@@ -16,6 +16,7 @@ Require Import Coqlib.
 Require Import Maps.
 Require Import IntvSets.
 Require Import AST.
+Require Import Zbits.
 Require Import Integers.
 Require Import Floats.
 Require Import Values.
@@ -300,13 +301,13 @@ Proof.
   rewrite Int.bits_ror.
   replace (((i - Int.unsigned amount) mod Int.zwordsize + Int.unsigned amount)
    mod Int.zwordsize) with i. auto.
-  apply Int.eqmod_small_eq with Int.zwordsize; auto.
-  apply Int.eqmod_trans with ((i - Int.unsigned amount) + Int.unsigned amount).
-  apply Int.eqmod_refl2; omega.
-  eapply Int.eqmod_trans. 2: apply Int.eqmod_mod; auto.
-  apply Int.eqmod_add.
-  apply Int.eqmod_mod; auto.
-  apply Int.eqmod_refl.
+  apply eqmod_small_eq with Int.zwordsize; auto.
+  apply eqmod_trans with ((i - Int.unsigned amount) + Int.unsigned amount).
+  apply eqmod_refl2; omega.
+  eapply eqmod_trans. 2: apply eqmod_mod; auto.
+  apply eqmod_add.
+  apply eqmod_mod; auto.
+  apply eqmod_refl.
   apply Z_mod_lt; auto.
   apply Z_mod_lt; auto.
 Qed.
@@ -324,16 +325,16 @@ Qed.
 
 Lemma eqmod_iagree:
   forall m x y,
-  Int.eqmod (two_p (Int.size m)) x y ->
+  eqmod (two_p (Int.size m)) x y ->
   iagree (Int.repr x) (Int.repr y) m.
 Proof.
-  intros. set (p := nat_of_Z (Int.size m)).
+  intros. set (p := Z.to_nat (Int.size m)).
   generalize (Int.size_range m); intros RANGE.
-  assert (EQ: Int.size m = Z.of_nat p). { symmetry; apply nat_of_Z_eq. omega. }
+  assert (EQ: Int.size m = Z.of_nat p). { symmetry; apply Z2Nat.id. omega. }
   rewrite EQ in H; rewrite <- two_power_nat_two_p in H.
   red; intros. rewrite ! Int.testbit_repr by auto.
   destruct (zlt i (Int.size m)).
-  eapply Int.same_bits_eqmod; eauto. omega.
+  eapply same_bits_eqmod; eauto. omega.
   assert (Int.testbit m i = false) by (eapply Int.bits_size_2; omega).
   congruence.
 Qed.
@@ -343,13 +344,13 @@ Definition complete_mask (m: int) := Int.zero_ext (Int.size m) Int.mone.
 Lemma iagree_eqmod:
   forall x y m,
   iagree x y (complete_mask m) ->
-  Int.eqmod (two_p (Int.size m)) (Int.unsigned x) (Int.unsigned y).
+  eqmod (two_p (Int.size m)) (Int.unsigned x) (Int.unsigned y).
 Proof.
-  intros. set (p := nat_of_Z (Int.size m)).
+  intros. set (p := Z.to_nat (Int.size m)).
   generalize (Int.size_range m); intros RANGE.
-  assert (EQ: Int.size m = Z.of_nat p). { symmetry; apply nat_of_Z_eq. omega. }
+  assert (EQ: Int.size m = Z.of_nat p). { symmetry; apply Z2Nat.id. omega. }
   rewrite EQ; rewrite <- two_power_nat_two_p.
-  apply Int.eqmod_same_bits. intros. apply H. omega.
+  apply eqmod_same_bits. intros. apply H. omega.
   unfold complete_mask. rewrite Int.bits_zero_ext by omega.
   rewrite zlt_true by omega. rewrite Int.bits_mone by omega. auto.
 Qed.
@@ -362,7 +363,7 @@ Proof.
 + assert (Int.unsigned m <> 0).
   { red; intros; elim n. rewrite <- (Int.repr_unsigned m). rewrite H; auto. }
   assert (0 < Int.size m).
-  { apply Int.Zsize_pos'. generalize (Int.unsigned_range m); omega. }
+  { apply Zsize_pos'. generalize (Int.unsigned_range m); omega. }
   generalize (Int.size_range m); intros.
   f_equal. apply Int.bits_size_4. tauto.
   rewrite Int.bits_zero_ext by omega. rewrite zlt_true by omega.
@@ -593,7 +594,8 @@ Proof.
 Qed.
 
 (** Modular arithmetic operations: add, mul, opposite.
-    (But not subtraction because of the pointer - pointer case. *)
+    Also subtraction, but only on 64-bit targets, otherwise
+    the pointer - pointer case does not fit. *)
 
 Definition modarith (x: nval) :=
   match x with
@@ -610,7 +612,20 @@ Proof.
   unfold modarith; intros. destruct x; simpl in *.
 - auto.
 - unfold Val.add; InvAgree.
-  apply eqmod_iagree. apply Int.eqmod_add; apply iagree_eqmod; auto.
+  apply eqmod_iagree. apply eqmod_add; apply iagree_eqmod; auto.
+- inv H; auto. inv H0; auto. destruct w1; auto.
+Qed.
+
+Lemma sub_sound:
+  forall v1 w1 v2 w2 x,
+  vagree v1 w1 (modarith x) -> vagree v2 w2 (modarith x) ->
+  Archi.ptr64 = true ->
+  vagree (Val.sub v1 v2) (Val.sub w1 w2) x.
+Proof.
+  unfold modarith; intros. destruct x; simpl in *.
+- auto.
+- unfold Val.sub; rewrite H1; InvAgree.
+  apply eqmod_iagree. apply eqmod_sub; apply iagree_eqmod; auto.
 - inv H; auto. inv H0; auto. destruct w1; auto.
 Qed.
 
@@ -626,7 +641,7 @@ Lemma mul_sound:
 Proof.
   unfold mul, add; intros. destruct x; simpl in *.
 - auto.
-- unfold Val.mul; InvAgree. apply eqmod_iagree. apply Int.eqmod_mult; apply iagree_eqmod; auto.
+- unfold Val.mul; InvAgree. apply eqmod_iagree. apply eqmod_mult; apply iagree_eqmod; auto.
 - inv H; auto. inv H0; auto. destruct w1; auto.
 Qed.
 
@@ -638,7 +653,7 @@ Proof.
   intros; destruct x; simpl in *.
 - auto.
 - unfold Val.neg; InvAgree.
-  apply eqmod_iagree. apply Int.eqmod_neg. apply iagree_eqmod; auto.
+  apply eqmod_iagree. apply eqmod_neg. apply iagree_eqmod; auto.
 - inv H; simpl; auto.
 Qed.
 
@@ -679,7 +694,7 @@ Definition sign_ext (n: Z) (x: nval) :=
 Lemma sign_ext_sound:
   forall v w x n,
   vagree v w (sign_ext n x) ->
-  0 < n < Int.zwordsize ->
+  0 < n ->
   vagree (Val.sign_ext n v) (Val.sign_ext n w) x.
 Proof.
   unfold sign_ext; intros. destruct x; simpl in *.
@@ -785,6 +800,34 @@ Proof.
   inv H0. rewrite iagree_and_eq in H. rewrite H. auto.
 Qed.
 
+(** The needs of a select *)
+
+Lemma normalize_sound:
+  forall v w x ty,
+  vagree v w x ->
+  vagree (Val.normalize v ty) (Val.normalize w ty) x.
+Proof.
+  intros. destruct x; simpl in *. 
+- auto.
+- unfold Val.normalize. destruct v. 
+  auto.
+  destruct w; try contradiction. destruct ty; auto.
+  destruct ty; auto.
+  destruct ty; auto.
+  destruct ty; auto.
+  destruct ty; destruct Archi.ptr64; auto.
+- apply Val.normalize_lessdef; auto.
+Qed.
+
+Lemma select_sound:
+  forall ob v1 v2 w1 w2 ty x,
+  vagree v1 w1 x -> vagree v2 w2 x ->
+  vagree (Val.select ob v1 v2 ty) (Val.select ob w1 w2 ty) x.
+Proof.
+  unfold Val.select; intros. destruct ob as [b|]; auto with na.
+  apply normalize_sound. destruct b; auto.
+Qed.
+
 (** The default abstraction: if the result is unused, the arguments are
   unused; otherwise, the arguments are needed in full. *)
 
@@ -860,7 +903,8 @@ Lemma default_needs_of_operation_sound:
   eval_operation ge (Vptr sp Ptrofs.zero) op args1 m1 = Some v1 ->
   vagree_list args1 args2 nil
   \/ vagree_list args1 args2 (default nv :: nil)
-  \/ vagree_list args1 args2 (default nv :: default nv :: nil) ->
+  \/ vagree_list args1 args2 (default nv :: default nv :: nil)
+  \/ vagree_list args1 args2 (default nv :: default nv :: default nv :: nil) ->
   nv <> Nothing ->
   exists v2,
      eval_operation ge (Vptr sp Ptrofs.zero) op args2 m2 = Some v2
@@ -872,7 +916,8 @@ Proof.
   {
     destruct H0. auto with na.
     destruct H0. inv H0; constructor; auto with na.
-    inv H0; constructor; auto with na. inv H8; constructor; auto with na.
+    destruct H0. inv H0. constructor. inv H8; constructor; auto with na. 
+    inv H0; constructor; auto with na. inv H8; constructor; auto with na. inv H9; constructor; auto with na.
   }
   exploit (@eval_operation_inj _ _ _ _ ge ge inject_id).
   eassumption. auto. auto. auto.
diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml
index 92d465d5..155f5e55 100644
--- a/backend/PrintAsm.ml
+++ b/backend/PrintAsm.ml
@@ -13,7 +13,6 @@
 
 open AST
 open Camlcoq
-open DwarfPrinter
 open PrintAsmaux
 open Printf
 open Sections
@@ -40,6 +39,7 @@ module Printer(Target:TARGET) =
 
     let print_function oc name fn =
       Hashtbl.clear current_function_labels;
+      Debug.symbol_printed (extern_atom name);
       let (text, lit, jmptbl) = Target.get_section_names name in
       Target.section oc text;
       let alignment =
@@ -117,7 +117,7 @@ module Printer(Target:TARGET) =
       match v.gvar_init with
       | [] -> ()
       | _  ->
-          Debug.variable_printed (extern_atom name);
+          Debug.symbol_printed (extern_atom name);
           let sec =
             match C2C.atom_sections name with
             | [s] -> s
@@ -176,7 +176,7 @@ module Printer(Target:TARGET) =
         let address = Target.address
       end
 
-    module DebugPrinter = DwarfPrinter (DwarfTarget)
+    module DebugPrinter = DwarfPrinter.DwarfPrinter (DwarfTarget)
   end
 
 let print_program oc p =
diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml
index f9ed569f..d82e6f84 100644
--- a/backend/PrintAsmaux.ml
+++ b/backend/PrintAsmaux.ml
@@ -99,7 +99,7 @@ let exists_constants () =
 
 let current_function_stacksize = ref 0l
 let current_function_sig =
-  ref { sig_args = []; sig_res = None; sig_cc = cc_default }
+  ref { sig_args = []; sig_res = Tvoid; sig_cc = cc_default }
 
 (* Functions for printing of symbol names *)
 let elf_symbol oc symb =
@@ -245,14 +245,15 @@ let print_debug_info comment print_line preg_string sp_name oc kind txt args =
 
 (** Inline assembly *)
 
-let print_asm_argument print_preg oc modifier = function
-  | BA r -> print_preg oc r
+let print_asm_argument print_preg oc modifier typ = function 
+  | BA r -> print_preg oc typ r
   | BA_splitlong(BA hi, BA lo) ->
       begin match modifier with
-      | "R" -> print_preg oc hi
-      | "Q" -> print_preg oc lo
-      |  _  -> fprintf oc "%a:%a" print_preg hi print_preg lo
-                  (* Probably not what was intended *)
+      | "R" -> print_preg oc Tint hi
+      | "Q" -> print_preg oc Tint lo
+      |  _  -> print_preg oc Tint hi; fprintf oc ":"; print_preg oc Tint lo
+               (* This case (printing a split long in full) should never
+                  happen because of the checks done in ExtendedAsm.ml *)
       end
   | _ -> failwith "bad asm argument"
 
@@ -265,8 +266,10 @@ let re_asm_param_1 = Str.regexp "%%\\|%[QR]?[0-9]+"
 let re_asm_param_2 = Str.regexp "%\\([QR]?\\)\\([0-9]+\\)"
 
 let print_inline_asm print_preg oc txt sg args res =
-  let operands =
-    if sg.sig_res = None then args else builtin_arg_of_res res :: args in
+  let (operands, ty_operands) =
+    match sg.sig_res with
+    | Tvoid -> (args, sg.sig_args)
+    | tres -> (builtin_arg_of_res res :: args, proj_rettype tres :: sg.sig_args) in
   let print_fragment = function
   | Str.Text s ->
       output_string oc s
@@ -277,7 +280,9 @@ let print_inline_asm print_preg oc txt sg args res =
       let modifier = Str.matched_group 1 s
       and number = int_of_string (Str.matched_group 2 s) in
       try
-        print_asm_argument print_preg oc modifier (List.nth operands number)
+        print_asm_argument print_preg oc modifier
+                           (List.nth ty_operands number)
+                           (List.nth operands number)
       with Failure _ ->
         fprintf oc "<bad parameter %s>" s in
   List.iter print_fragment (Str.full_split re_asm_param_1 txt);
@@ -289,12 +294,20 @@ let print_inline_asm print_preg oc txt sg args res =
 let print_version_and_options oc comment =
   let version_string =
     if Version.buildnr <> "" && Version.tag <> "" then
-      sprintf "%s, Build: %s, Tag: %s" Version.version Version.buildnr Version.tag
+      sprintf "Release: %s, Build: %s, Tag: %s" Version.version Version.buildnr Version.tag
     else
       Version.version in
   fprintf oc "%s File generated by CompCert %s\n" comment version_string;
   fprintf oc "%s Command line:" comment;
-  for i = 1 to Array.length Sys.argv - 1 do
-    fprintf oc " %s" Sys.argv.(i)
+  for i = 1 to Array.length Commandline.argv - 1 do
+    fprintf oc " %s" Commandline.argv.(i)
   done;
   fprintf oc "\n"
+(** Get the name of the common section if it is used otherwise the given section
+    name, with bss as default *)
+
+let common_section ?(sec = ".bss") () =
+  if !Clflags.option_fcommon then
+    "COMM"
+  else
+    sec
diff --git a/backend/PrintCminor.ml b/backend/PrintCminor.ml
index f68c1267..c9a6d399 100644
--- a/backend/PrintCminor.ml
+++ b/backend/PrintCminor.ml
@@ -16,7 +16,7 @@
 (** Pretty-printer for Cminor *)
 
 open Format
-open Camlcoq
+open! Camlcoq
 open Integers
 open AST
 open PrintAST
@@ -193,9 +193,7 @@ let print_sig p sg =
   List.iter
     (fun t -> fprintf p "%s ->@ " (name_of_type t))
     sg.sig_args;
-  match sg.sig_res with
-  | None -> fprintf p "void"
-  | Some ty -> fprintf p "%s" (name_of_type ty)
+  fprintf p "%s" (name_of_rettype sg.sig_res)
 
 let rec just_skips s =
   match s with
diff --git a/backend/PrintLTL.ml b/backend/PrintLTL.ml
index d0557073..1c449e74 100644
--- a/backend/PrintLTL.ml
+++ b/backend/PrintLTL.ml
@@ -112,7 +112,7 @@ let print_function pp id f =
   fprintf pp "%s() {\n" (extern_atom id);
   let instrs =
     List.sort
-      (fun (pc1, _) (pc2, _) -> Pervasives.compare pc2 pc1)
+      (fun (pc1, _) (pc2, _) -> compare pc2 pc1)
       (List.rev_map
         (fun (pc, i) -> (P.to_int pc, i))
         (PTree.elements f.fn_code)) in
diff --git a/backend/PrintLTLin.ml b/backend/PrintLTLin.ml
deleted file mode 100644
index 4e8efd16..00000000
--- a/backend/PrintLTLin.ml
+++ /dev/null
@@ -1,115 +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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** Pretty-printer for LTLin code *)
-
-open Format
-open Camlcoq
-open Datatypes
-open Maps
-open AST
-open Integers
-open Locations
-open Machregsaux
-open LTLin
-open PrintAST
-open PrintOp
-
-let reg pp loc =
-  match loc with
-  | R r ->
-      begin match name_of_register r with
-      | Some s -> fprintf pp "%s" s
-      | None -> fprintf pp "<unknown reg>"
-      end
-  | S (Local(ofs, ty)) ->
-      fprintf pp "local(%s,%ld)" (name_of_type ty) (camlint_of_coqint ofs)
-  | S (Incoming(ofs, ty)) ->
-      fprintf pp "incoming(%s,%ld)" (name_of_type ty) (camlint_of_coqint ofs)
-  | S (Outgoing(ofs, ty)) ->
-      fprintf pp "outgoing(%s,%ld)" (name_of_type ty) (camlint_of_coqint ofs)
-
-let rec regs pp = function
-  | [] -> ()
-  | [r] -> reg pp r
-  | r1::rl -> fprintf pp "%a, %a" reg r1 regs rl
-
-let ros pp = function
-  | Coq_inl r -> reg pp r
-  | Coq_inr s -> fprintf pp "\"%s\"" (extern_atom s)
-
-let print_instruction pp i =
-  match i with
-  | Lop(op, args, res) ->
-      fprintf pp "%a = %a@ "
-         reg res (PrintOp.print_operation reg) (op, args)
-  | Lload(chunk, addr, args, dst) ->
-      fprintf pp "%a = %s[%a]@ "
-         reg dst (name_of_chunk chunk)
-         (PrintOp.print_addressing reg) (addr, args)
-  | Lstore(chunk, addr, args, src) ->
-      fprintf pp "%s[%a] = %a@ "
-         (name_of_chunk chunk)
-         (PrintOp.print_addressing reg) (addr, args)
-         reg src
-  | Lcall(sg, fn, args, res) ->
-      fprintf pp "%a = %a(%a)@ "
-        reg res ros fn regs args
-  | Ltailcall(sg, fn, args) ->
-      fprintf pp "tailcall %a(%a)@ "
-        ros fn regs args
-  | Lbuiltin(ef, args, res) ->
-      fprintf pp "%a = builtin %s(%a)@ "
-        reg res (name_of_external ef) regs args
-  | Llabel lbl ->
-      fprintf pp "%ld:@ " (P.to_int32 lbl)
-  | Lgoto lbl ->
-      fprintf pp "goto %ld@ " (P.to_int32 lbl)
-  | Lcond(cond, args, lbl) ->
-      fprintf pp "if (%a) goto %ld@ "
-        (PrintOp.print_condition reg) (cond, args)
-        (P.to_int32 lbl)
-  | Ljumptable(arg, tbl) ->
-      let tbl = Array.of_list tbl in
-      fprintf pp "@[<v 2>jumptable (%a)" reg arg;
-      for i = 0 to Array.length tbl - 1 do
-        fprintf pp "@ case %d: goto %ld" i (P.to_int32 tbl.(i))
-      done;
-      fprintf pp "@]@ "
-  | Lreturn None ->
-      fprintf pp "return@ "
-  | Lreturn (Some arg) ->
-      fprintf pp "return %a@ " reg arg
-
-let print_function pp id f =
-  fprintf pp "@[<v 2>%s(%a) {@ " (extern_atom id) regs f.fn_params;
-  List.iter (print_instruction pp) f.fn_code;
-  fprintf pp "@;<0 -2>}@]@."
-
-let print_globdef pp (id, gd) =
-  match gd with
-  | Gfun(Internal f) -> print_function pp id f
-  | _ -> ()
-
-let print_program pp prog =
-  List.iter (print_globdef pp) prog.prog_defs
-
-let destination : string option ref = ref None
-
-let print_if prog =
-  match !destination with
-  | None -> ()
-  | Some f ->
-      let oc = open_out f in
-      let pp = formatter_of_out_channel oc in
-      print_program pp prog;
-      close_out oc
diff --git a/backend/PrintRTL.ml b/backend/PrintRTL.ml
index ba336b0a..841540b6 100644
--- a/backend/PrintRTL.ml
+++ b/backend/PrintRTL.ml
@@ -93,7 +93,7 @@ let print_function pp id f =
   fprintf pp "%s(%a) {\n" (extern_atom id) regs f.fn_params;
   let instrs =
     List.sort
-      (fun (pc1, _) (pc2, _) -> Pervasives.compare pc2 pc1)
+      (fun (pc1, _) (pc2, _) -> compare pc2 pc1)
       (List.rev_map
         (fun (pc, i) -> (P.to_int pc, i))
         (PTree.elements f.fn_code)) in
diff --git a/backend/PrintXTL.ml b/backend/PrintXTL.ml
index cc1f7d49..6432682a 100644
--- a/backend/PrintXTL.ml
+++ b/backend/PrintXTL.ml
@@ -138,7 +138,7 @@ let print_function pp ?alloc ?live f =
   fprintf pp "f() {\n";
   let instrs =
     List.sort
-      (fun (pc1, _) (pc2, _) -> Pervasives.compare pc2 pc1)
+      (fun (pc1, _) (pc2, _) -> compare pc2 pc1)
       (List.map
         (fun (pc, i) -> (P.to_int pc, i))
         (PTree.elements f.fn_code)) in
diff --git a/backend/RTLgen.v b/backend/RTLgen.v
index 9d7a8506..f7280c9e 100644
--- a/backend/RTLgen.v
+++ b/backend/RTLgen.v
@@ -410,12 +410,11 @@ Fixpoint convert_builtin_args {A: Type} (al: list (builtin_arg expr)) (rl: list
       a1' :: convert_builtin_args al rl1
   end.
 
-Definition convert_builtin_res (map: mapping) (oty: option typ) (r: builtin_res ident) : mon (builtin_res reg) :=
-  match r, oty with
-  | BR id, _ => do r <- find_var map id; ret (BR r)
-  | BR_none, None => ret BR_none
-  | BR_none, Some _ => do r <- new_reg; ret (BR r)
-  | _, _ => error (Errors.msg "RTLgen: bad builtin_res")
+Definition convert_builtin_res (map: mapping) (ty: rettype) (r: builtin_res ident) : mon (builtin_res reg) :=
+  match r with
+  | BR id => do r <- find_var map id; ret (BR r)
+  | BR_none => if rettype_eq ty Tvoid then ret BR_none else (do r <- new_reg; ret (BR r))
+  | _ => error (Errors.msg "RTLgen: bad builtin_res")
   end.
 
 (** Translation of an expression.  [transl_expr map a rd nd]
@@ -667,10 +666,7 @@ Fixpoint reserve_labels (s: stmt) (ms: labelmap * state)
 (** Translation of a CminorSel function. *)
 
 Definition ret_reg (sig: signature) (rd: reg) : option reg :=
-  match sig.(sig_res) with
-  | None => None
-  | Some ty => Some rd
-  end.
+  if rettype_eq sig.(sig_res) Tvoid then None else Some rd.
 
 Definition transl_fun (f: CminorSel.function) (ngoto: labelmap): mon (node * list reg) :=
   do (rparams, map1) <- add_vars init_mapping f.(CminorSel.fn_params);
diff --git a/backend/RTLgenspec.v b/backend/RTLgenspec.v
index 17022a7d..72693f63 100644
--- a/backend/RTLgenspec.v
+++ b/backend/RTLgenspec.v
@@ -639,8 +639,8 @@ Lemma new_reg_return_ok:
   map_valid map s1 ->
   return_reg_ok s2 map (ret_reg sig r).
 Proof.
-  intros. unfold ret_reg. destruct (sig_res sig); constructor.
-  eauto with rtlg. eauto with rtlg.
+  intros. unfold ret_reg.
+  destruct (rettype_eq (sig_res sig) Tvoid); constructor; eauto with rtlg.
 Qed.
 
 (** * Relational specification of the translation *)
@@ -1224,9 +1224,9 @@ Lemma convert_builtin_res_charact:
 Proof.
   destruct res; simpl; intros.
 - monadInv TR. constructor.  unfold find_var in EQ. destruct (map_vars map)!x; inv EQ; auto.
-- destruct oty; monadInv TR.
-+ constructor. eauto with rtlg.
+- destruct (rettype_eq oty Tvoid); monadInv TR.
 + constructor.
++ constructor. eauto with rtlg.
 - monadInv TR.
 Qed.
 
@@ -1350,7 +1350,7 @@ Proof.
   intros [C D].
   eapply tr_function_intro; eauto with rtlg.
   eapply transl_stmt_charact; eauto with rtlg.
-  unfold ret_reg. destruct (sig_res (CminorSel.fn_sig f)).
-  constructor. eauto with rtlg. eauto with rtlg.
+  unfold ret_reg. destruct (rettype_eq (sig_res (CminorSel.fn_sig f)) Tvoid).
   constructor.
+  constructor; eauto with rtlg.
 Qed.
diff --git a/backend/RTLtyping.v b/backend/RTLtyping.v
index 8336d1bf..5b8646ea 100644
--- a/backend/RTLtyping.v
+++ b/backend/RTLtyping.v
@@ -151,11 +151,12 @@ Inductive wt_instr : instruction -> Prop :=
       list_length_z tbl * 4 <= Int.max_unsigned ->
       wt_instr (Ijumptable arg tbl)
   | wt_Ireturn_none:
-      funct.(fn_sig).(sig_res) = None ->
+      funct.(fn_sig).(sig_res) = Tvoid ->
       wt_instr (Ireturn None)
   | wt_Ireturn_some:
       forall arg ty,
-      funct.(fn_sig).(sig_res) = Some ty ->
+      funct.(fn_sig).(sig_res) <> Tvoid ->
+      env arg = proj_sig_res funct.(fn_sig) ->
       env arg = ty ->
       wt_instr (Ireturn (Some arg)).
 
@@ -298,7 +299,7 @@ Definition type_instr (e: S.typenv) (i: instruction) : res S.typenv :=
   | Itailcall sig ros args =>
       do e1 <- type_ros e ros;
       do e2 <- S.set_list e1 args sig.(sig_args);
-      if opt_typ_eq sig.(sig_res) f.(fn_sig).(sig_res) then
+      if rettype_eq sig.(sig_res) f.(fn_sig).(sig_res) then
         if tailcall_is_possible sig
         then OK e2
         else Error(msg "tailcall not possible")
@@ -323,9 +324,9 @@ Definition type_instr (e: S.typenv) (i: instruction) : res S.typenv :=
       then OK e1
       else Error(msg "jumptable too big")
   | Ireturn optres =>
-      match optres, f.(fn_sig).(sig_res) with
-      | None, None => OK e
-      | Some r, Some t => S.set e r t
+      match optres, rettype_eq f.(fn_sig).(sig_res) Tvoid with
+      | None, left _ => OK e
+      | Some r, right _ => S.set e r (proj_sig_res f.(fn_sig))
       | _, _ => Error(msg "bad return")
       end
   end.
@@ -468,7 +469,7 @@ Proof.
   destruct l; try discriminate. destruct l; monadInv EQ0. eauto with ty.
   destruct (type_of_operation o) as [targs tres] eqn:TYOP. monadInv EQ0. eauto with ty.
 - (* tailcall *)
-  destruct (opt_typ_eq (sig_res s) (sig_res (fn_sig f))); try discriminate.
+  destruct (rettype_eq (sig_res s) (sig_res (fn_sig f))); try discriminate.
   destruct (tailcall_is_possible s) eqn:TCIP; inv EQ2.
   eauto with ty.
 - (* builtin *)
@@ -477,7 +478,8 @@ Proof.
   destruct (zle (list_length_z l * 4) Int.max_unsigned); inv EQ2.
   eauto with ty.
 - (* return *)
-  simpl in H. destruct o as [r|] eqn: RET; destruct (sig_res (fn_sig f)) as [t|] eqn: RES; try discriminate.
+  simpl in H.
+  destruct o as [r|] eqn: RET; destruct (rettype_eq (sig_res (fn_sig f)) Tvoid); try discriminate.
   eauto with ty.
   inv H; auto with ty.
 Qed.
@@ -519,7 +521,7 @@ Proof.
   eapply S.set_sound; eauto with ty.
   eauto with ty.
 - (* tailcall *)
-  destruct (opt_typ_eq (sig_res s) (sig_res (fn_sig f))); try discriminate.
+  destruct (rettype_eq (sig_res s) (sig_res (fn_sig f))); try discriminate.
   destruct (tailcall_is_possible s) eqn:TCIP; inv EQ2.
   constructor.
   eapply type_ros_sound; eauto with ty.
@@ -543,8 +545,9 @@ Proof.
   eapply check_successors_sound; eauto.
   auto.
 - (* return *)
-  simpl in H. destruct o as [r|] eqn: RET; destruct (sig_res (fn_sig f)) as [t|] eqn: RES; try discriminate.
-  econstructor. eauto. eapply S.set_sound; eauto with ty.
+  simpl in H.
+  destruct o as [r|] eqn: RET; destruct (rettype_eq (sig_res (fn_sig f)) Tvoid); try discriminate.
+  econstructor. auto. eapply S.set_sound; eauto with ty. eauto.
   inv H. constructor. auto.
 Qed.
 
@@ -721,9 +724,9 @@ Proof.
   rewrite check_successor_complete by auto; simpl.
   apply IHtbl0; intros; auto.
 - (* return none *)
-  rewrite H0. exists e; auto.
+  rewrite H0, dec_eq_true. exists e; auto.
 - (* return some *)
-  rewrite H0. apply S.set_complete; auto.
+  rewrite dec_eq_false by auto. apply S.set_complete; auto.
 Qed.
 
 Lemma type_code_complete:
@@ -872,7 +875,7 @@ Qed.
 
 Inductive wt_stackframes: list stackframe -> signature -> Prop :=
   | wt_stackframes_nil: forall sg,
-      sg.(sig_res) = Some Tint ->
+      sg.(sig_res) = Tint ->
       wt_stackframes nil sg
   | wt_stackframes_cons:
       forall s res f sp pc rs env sg,
@@ -964,13 +967,13 @@ Proof.
   econstructor; eauto.
   (* Ireturn *)
   econstructor; eauto.
-  inv WTI; simpl. auto. unfold proj_sig_res; rewrite H2. auto.
+  inv WTI; simpl. auto. rewrite <- H3. auto.
   (* internal function *)
   simpl in *. inv H5.
   econstructor; eauto.
   inv H1. apply wt_init_regs; auto. rewrite wt_params0. auto.
   (* external function *)
-  econstructor; eauto. simpl.
+  econstructor; eauto.
   eapply external_call_well_typed; eauto.
   (* return *)
   inv H1. econstructor; eauto.
diff --git a/backend/SelectDivproof.v b/backend/SelectDivproof.v
index 9e24857a..c57d3652 100644
--- a/backend/SelectDivproof.v
+++ b/backend/SelectDivproof.v
@@ -12,7 +12,7 @@
 
 (** Correctness of instruction selection for integer division *)
 
-Require Import Zquot Coqlib.
+Require Import Zquot Coqlib Zbits.
 Require Import AST Integers Floats Values Memory Globalenvs Events.
 Require Import Cminor Op CminorSel.
 Require Import SelectOp SelectOpproof SplitLong SplitLongproof SelectLong SelectLongproof SelectDiv.
@@ -57,13 +57,13 @@ Proof.
     apply Z.mul_nonneg_nonneg; omega.
   assert (k * n <= two_p (N + l) - two_p l).
     apply Z.le_trans with (two_p l * n).
-    apply Zmult_le_compat_r. omega. omega.
+    apply Z.mul_le_mono_nonneg_r; omega.
     replace (N + l) with (l + N) by omega.
     rewrite two_p_is_exp.
     replace (two_p l * two_p N - two_p l)
        with (two_p l * (two_p N - 1))
          by ring.
-    apply Zmult_le_compat_l. omega. exploit (two_p_gt_ZERO l). omega. omega.
+    apply Z.mul_le_mono_nonneg_l. omega. exploit (two_p_gt_ZERO l). omega. omega.
     omega. omega.
   assert (0 <= two_p (N + l) * r).
     apply Z.mul_nonneg_nonneg.
@@ -72,7 +72,7 @@ Proof.
   assert (two_p (N + l) * r <= two_p (N + l) * d - two_p (N + l)).
     replace (two_p (N + l) * d - two_p (N + l))
        with (two_p (N + l) * (d - 1)) by ring.
-    apply Zmult_le_compat_l.
+    apply Z.mul_le_mono_nonneg_l. 
     omega.
     exploit (two_p_gt_ZERO (N + l)). omega. omega.
   assert (0 <= m * n - two_p (N + l) * q).
@@ -138,13 +138,13 @@ Proof.
   rewrite H2.
   assert (k * n <= two_p (N + l)).
     rewrite Z.add_comm. rewrite two_p_is_exp; try omega.
-    apply Z.le_trans with (two_p l * n). apply Zmult_le_compat_r. omega. omega.
-    apply Zmult_le_compat_l. omega. exploit (two_p_gt_ZERO l). omega. omega.
+    apply Z.le_trans with (two_p l * n). apply Z.mul_le_mono_nonneg_r; omega.
+    apply Z.mul_le_mono_nonneg_l. omega. exploit (two_p_gt_ZERO l). omega. omega.
   assert (two_p (N + l) * r <= two_p (N + l) * d - two_p (N + l)).
     replace (two_p (N + l) * d - two_p (N + l))
        with (two_p (N + l) * (d - 1))
          by ring.
-    apply Zmult_le_compat_l. omega. exploit (two_p_gt_ZERO (N + l)). omega. omega.
+    apply Z.mul_le_mono_nonneg_l. exploit (two_p_gt_ZERO (N + l)). omega. omega. omega.
   omega.
 Qed.
 
@@ -246,10 +246,11 @@ Proof.
   unfold Int.max_signed; omega.
   apply Zdiv_interval_1. generalize Int.min_signed_neg; omega. apply Int.half_modulus_pos.
   apply Int.modulus_pos.
-  split. apply Z.le_trans with (Int.min_signed * m). apply Zmult_le_compat_l_neg. omega. generalize Int.min_signed_neg; omega.
-  apply Zmult_le_compat_r. unfold n; generalize (Int.signed_range x); tauto. tauto.
+  split. apply Z.le_trans with (Int.min_signed * m). 
+  apply Z.mul_le_mono_nonpos_l. generalize Int.min_signed_neg; omega. omega.
+  apply Z.mul_le_mono_nonneg_r. omega. unfold n; generalize (Int.signed_range x); tauto.
   apply Z.le_lt_trans with (Int.half_modulus * m).
-  apply Zmult_le_compat_r. generalize (Int.signed_range x); unfold n, Int.max_signed; omega. tauto.
+  apply Z.mul_le_mono_nonneg_r. tauto. generalize (Int.signed_range x); unfold n, Int.max_signed; omega.
   apply Zmult_lt_compat_l. generalize Int.half_modulus_pos; omega. tauto.
   assert (32 < Int.max_unsigned) by (compute; auto). omega.
   unfold Int.lt; fold n. rewrite Int.signed_zero. destruct (zlt n 0); apply Int.eqm_unsigned_repr.
@@ -290,7 +291,7 @@ Proof.
   apply Int.eqm_sym. eapply Int.eqm_trans. apply Int.eqm_signed_unsigned.
   apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl2.
   apply (f_equal (fun x => n * x / Int.modulus)).
-  rewrite Int.signed_repr_eq. rewrite Zmod_small by assumption.
+  rewrite Int.signed_repr_eq. rewrite Z.mod_small by assumption.
   apply zlt_false. assumption.
 Qed.
 
@@ -377,7 +378,7 @@ Qed.
 Remark int64_shr'_div_two_p:
   forall x y, Int64.shr' x y = Int64.repr (Int64.signed x / two_p (Int.unsigned y)).
 Proof.
-  intros; unfold Int64.shr'. rewrite Int64.Zshiftr_div_two_p; auto. generalize (Int.unsigned_range y); omega.
+  intros; unfold Int64.shr'. rewrite Zshiftr_div_two_p; auto. generalize (Int.unsigned_range y); omega.
 Qed.
 
 Lemma divls_mul_shift_gen:
@@ -400,8 +401,9 @@ Proof.
   unfold Int64.max_signed; omega.
   apply Zdiv_interval_1. generalize Int64.min_signed_neg; omega. apply Int64.half_modulus_pos.
   apply Int64.modulus_pos.
-  split. apply Z.le_trans with (Int64.min_signed * m). apply Zmult_le_compat_l_neg. omega. generalize Int64.min_signed_neg; omega.
-  apply Zmult_le_compat_r. unfold n; generalize (Int64.signed_range x); tauto. tauto.
+  split. apply Z.le_trans with (Int64.min_signed * m).
+  apply Z.mul_le_mono_nonpos_l. generalize Int64.min_signed_neg; omega. omega.
+  apply Z.mul_le_mono_nonneg_r. tauto. unfold n; generalize (Int64.signed_range x); tauto.
   apply Z.le_lt_trans with (Int64.half_modulus * m).
   apply Zmult_le_compat_r. generalize (Int64.signed_range x); unfold n, Int64.max_signed; omega. tauto.
   apply Zmult_lt_compat_l. generalize Int64.half_modulus_pos; omega. tauto.
@@ -444,14 +446,14 @@ Proof.
   apply Int64.eqm_sym. eapply Int64.eqm_trans. apply Int64.eqm_signed_unsigned.
   apply Int64.eqm_unsigned_repr_l. apply Int64.eqm_refl2.
   apply (f_equal (fun x => n * x / Int64.modulus)).
-  rewrite Int64.signed_repr_eq. rewrite Zmod_small by assumption.
+  rewrite Int64.signed_repr_eq. rewrite Z.mod_small by assumption.
   apply zlt_false. assumption.
 Qed.
 
 Remark int64_shru'_div_two_p:
   forall x y, Int64.shru' x y = Int64.repr (Int64.unsigned x / two_p (Int.unsigned y)).
 Proof.
-  intros; unfold Int64.shru'. rewrite Int64.Zshiftr_div_two_p; auto. generalize (Int.unsigned_range y); omega.
+  intros; unfold Int64.shru'. rewrite Zshiftr_div_two_p; auto. generalize (Int.unsigned_range y); omega.
 Qed.
 
 Theorem divlu_mul_shift:
@@ -761,8 +763,8 @@ Lemma eval_divlu_mull:
 Proof.
   intros. unfold divlu_mull. exploit (divlu_mul_shift x); eauto. intros [A B].
   assert (A0: eval_expr ge sp e m le (Eletvar O) (Vlong x)) by (constructor; auto).
-  exploit eval_mullhu. eauto. eexact A0. instantiate (1 := Int64.repr M). intros (v1 & A1 & B1).
-  exploit eval_shrluimm. eauto. eexact A1. instantiate (1 := Int.repr p). intros (v2 & A2 & B2).
+  exploit eval_mullhu. try apply HELPERS. eexact A0. instantiate (1 := Int64.repr M). intros (v1 & A1 & B1).
+  exploit eval_shrluimm. try apply HELPERS. eexact A1. instantiate (1 := Int.repr p). intros (v2 & A2 & B2).
   simpl in B1; inv B1. simpl in B2. replace (Int.ltu (Int.repr p) Int64.iwordsize') with true in B2. inv B2.
   rewrite B. assumption.
   unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true; auto. tauto.
@@ -832,17 +834,17 @@ Proof.
   intros. unfold divls_mull.
   assert (A0: eval_expr ge sp e m le (Eletvar O) (Vlong x)).
   { constructor; auto. }
-  exploit eval_mullhs. eauto. eexact A0. instantiate (1 := Int64.repr M).  intros (v1 & A1 & B1).
-  exploit eval_addl; auto; try apply HELPERS. eexact A1. eexact A0. intros (v2 & A2 & B2).
-  exploit eval_shrluimm. eauto. eexact A0. instantiate (1 := Int.repr 63). intros (v3 & A3 & B3).
+  exploit eval_mullhs. try apply HELPERS. eexact A0. instantiate (1 := Int64.repr M).  intros (v1 & A1 & B1).
+  exploit eval_addl. auto. eexact A1. eexact A0. intros (v2 & A2 & B2).
+  exploit eval_shrluimm. try apply HELPERS. eexact A0. instantiate (1 := Int.repr 63). intros (v3 & A3 & B3).
   set (a4 := if zlt M Int64.half_modulus
              then mullhs (Eletvar 0) (Int64.repr M)
              else addl (mullhs (Eletvar 0) (Int64.repr M)) (Eletvar 0)).
   set (v4 := if zlt M Int64.half_modulus then v1 else v2).
   assert (A4: eval_expr ge sp e m le a4 v4).
   { unfold a4, v4; destruct (zlt M Int64.half_modulus); auto. }
-  exploit eval_shrlimm. eauto. eexact A4. instantiate (1 := Int.repr p). intros (v5 & A5 & B5).
-  exploit eval_addl; auto; try apply HELPERS. eexact A5. eexact A3. intros (v6 & A6 & B6).
+  exploit eval_shrlimm. try apply HELPERS. eexact A4. instantiate (1 := Int.repr p). intros (v5 & A5 & B5).
+  exploit eval_addl. auto. eexact A5. eexact A3. intros (v6 & A6 & B6).
   assert (RANGE: forall x, 0 <= x < 64 -> Int.ltu (Int.repr x) Int64.iwordsize' = true).
   { intros. unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true by tauto. auto.
     assert (64 < Int.max_unsigned) by (compute; auto). omega. }
@@ -946,8 +948,7 @@ Proof.
   intros until y. unfold divf. destruct (divf_match b); intros.
 - unfold divfimm. destruct (Float.exact_inverse n2) as [n2' | ] eqn:EINV.
   + inv H0. inv H4. simpl in H6. inv H6. econstructor; split.
-    EvalOp. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor.
-    simpl; eauto.
+    repeat (econstructor; eauto). 
     destruct x; simpl; auto. erewrite Float.div_mul_inverse; eauto.
   + TrivialExists.
 - TrivialExists.
@@ -962,8 +963,7 @@ Proof.
   intros until y. unfold divfs. destruct (divfs_match b); intros.
 - unfold divfsimm. destruct (Float32.exact_inverse n2) as [n2' | ] eqn:EINV.
   + inv H0. inv H4. simpl in H6. inv H6. econstructor; split.
-    EvalOp. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor.
-    simpl; eauto.
+    repeat (econstructor; eauto). 
     destruct x; simpl; auto. erewrite Float32.div_mul_inverse; eauto.
   + TrivialExists.
 - TrivialExists.
diff --git a/backend/Selection.v b/backend/Selection.v
index 4520cb0c..c9771d99 100644
--- a/backend/Selection.v
+++ b/backend/Selection.v
@@ -24,9 +24,9 @@
 
 Require String.
 Require Import Coqlib Maps.
-Require Import AST Errors Integers Globalenvs Switch.
+Require Import AST Errors Integers Globalenvs Builtins Switch.
 Require Cminor.
-Require Import Op CminorSel.
+Require Import Op CminorSel Cminortyping.
 Require Import SelectOp SplitLong SelectLong SelectDiv.
 Require Machregs.
 
@@ -43,6 +43,12 @@ Function condexpr_of_expr (e: expr) : condexpr :=
   | _ => CEcond (Ccompuimm Cne Int.zero) (e ::: Enil)
   end.
 
+Function condition_of_expr (e: expr) : condition * exprlist :=
+  match e with
+  | Eop (Ocmp c) el => (c, el)
+  | _ => (Ccompuimm Cne Int.zero, e ::: Enil)
+  end.
+
 (** Conversion of loads and stores *)
 
 Definition load (chunk: memory_chunk) (e1: expr) :=
@@ -156,6 +162,13 @@ Definition sel_binop (op: Cminor.binary_operation) (arg1 arg2: expr) : expr :=
   | Cminor.Ocmplu c => cmplu c arg1 arg2
   end.
 
+Definition sel_select (ty: typ) (cnd ifso ifnot: expr) : expr :=
+   let (cond, args) := condition_of_expr cnd in
+   match SelectOp.select ty cond args ifso ifnot with
+   | Some a => a
+   | None => Econdition (condexpr_of_expr cnd) ifso ifnot
+   end.
+
 (** Conversion from Cminor expression to Cminorsel expressions *)
 
 Fixpoint sel_expr (a: Cminor.expr) : expr :=
@@ -173,6 +186,10 @@ Fixpoint sel_exprlist (al: list Cminor.expr) : exprlist :=
   | a :: bl => Econs (sel_expr a) (sel_exprlist bl)
   end.
 
+Definition sel_select_opt (ty: typ) (arg1 arg2 arg3: Cminor.expr) : option expr :=
+  let (cond, args) := condition_of_expr (sel_expr arg1) in
+  SelectOp.select ty cond args (sel_expr arg2) (sel_expr arg3).
+
 (** Recognition of immediate calls and calls to built-in functions
     that should be inlined *)
 
@@ -221,6 +238,43 @@ Definition sel_builtin_res (optid: option ident) : builtin_res ident :=
   | Some id => BR id
   end.
 
+(** Known builtin functions *)
+
+Function sel_known_builtin (bf: builtin_function) (args: exprlist) :=
+  match bf, args with
+  | BI_platform b, _ =>
+      SelectOp.platform_builtin b args
+  | BI_standard (BI_select ty), a1 ::: a2 ::: a3 ::: Enil =>
+      Some (sel_select ty a1 a2 a3)
+  | BI_standard BI_fabs, a1 ::: Enil =>
+      Some (SelectOp.absf a1)
+  | _, _ =>
+      None
+  end.
+
+(** Builtin functions in general *)
+
+Definition sel_builtin_default (optid: option ident) (ef: external_function)
+                               (args: list Cminor.expr) :=
+  Sbuiltin (sel_builtin_res optid) ef
+           (sel_builtin_args args (Machregs.builtin_constraints ef)).
+
+Definition sel_builtin (optid: option ident) (ef: external_function)
+                               (args: list Cminor.expr) :=
+  match optid, ef with
+  | Some id, EF_builtin name sg =>
+      match lookup_builtin_function name sg with
+      | Some bf =>
+          match sel_known_builtin bf (sel_exprlist args) with
+          | Some a => Sassign id a
+          | None => sel_builtin_default optid ef args
+          end
+      | None => sel_builtin_default optid ef args
+      end
+  | _, _ =>
+      sel_builtin_default optid ef args
+  end.
+
 (** Conversion of Cminor [switch] statements to decision trees. *)
 
 Parameter compile_switch: Z -> nat -> table -> comptree.
@@ -267,9 +321,63 @@ Definition sel_switch_long :=
     (fun arg ofs => subl arg (longconst (Int64.repr ofs)))
     lowlong.
 
+(** "If conversion": conversion of certain if-then-else statements
+  into branchless conditional move instructions. *)
+
+(** Recognition of "then" and "else" statements that support if-conversion.
+  Basically we are interested in assignments to local variables [id = e].
+  However the front-end may have put [skip] statements around these
+  assignments. *)
+
+Inductive stmt_class : Type :=
+  | SCskip
+  | SCassign (id: ident) (a: Cminor.expr)
+  | SCother.
+
+Function classify_stmt (s: Cminor.stmt) : stmt_class :=
+  match s with
+  | Cminor.Sskip => SCskip
+  | Cminor.Sassign id a => SCassign id a
+  | Cminor.Sseq Cminor.Sskip s => classify_stmt s
+  | Cminor.Sseq s Cminor.Sskip => classify_stmt s
+  | _ => SCother
+  end.
+
+(** External heuristic to limit the amount of if-conversion performed.
+    Arguments are: the condition, the "then" and the "else" expressions,
+    and the type at which selection is done. *)
+
+Parameter if_conversion_heuristic:
+  Cminor.expr -> Cminor.expr -> Cminor.expr -> AST.typ -> bool.
+
+Definition if_conversion_base
+      (ki: known_idents) (env: typenv)
+      (cond: Cminor.expr) (id: ident) (ifso ifnot:  Cminor.expr) : option stmt :=
+  let ty := env id in
+  if is_known ki id
+  && safe_expr ki ifso && safe_expr ki ifnot
+  && if_conversion_heuristic cond ifso ifnot ty
+  then option_map
+         (fun sel => Sassign id sel)
+         (sel_select_opt ty cond ifso ifnot)
+  else None.
+
+Definition if_conversion
+      (ki: known_idents) (env: typenv)
+      (cond: Cminor.expr) (ifso ifnot: Cminor.stmt) : option stmt :=
+  match classify_stmt ifso, classify_stmt ifnot with
+  | SCskip, SCassign id a =>
+      if_conversion_base ki env cond id (Cminor.Evar id) a
+  | SCassign id a, SCskip =>
+      if_conversion_base ki env cond id a (Cminor.Evar id)
+  | SCassign id1 a1, SCassign id2 a2 =>
+      if ident_eq id1 id2 then if_conversion_base ki env cond id1 a1 a2 else None
+  | _, _ => None
+  end.
+
 (** Conversion from Cminor statements to Cminorsel statements. *)
 
-Fixpoint sel_stmt (s: Cminor.stmt) : res stmt :=
+Fixpoint sel_stmt (ki: known_idents) (env: typenv) (s: Cminor.stmt) : res stmt :=
   match s with
   | Cminor.Sskip => OK Sskip
   | Cminor.Sassign id e => OK (Sassign id (sel_expr e))
@@ -278,28 +386,29 @@ Fixpoint sel_stmt (s: Cminor.stmt) : res stmt :=
       OK (match classify_call fn with
       | Call_default => Scall optid sg (inl _ (sel_expr fn)) (sel_exprlist args)
       | Call_imm id  => Scall optid sg (inr _ id) (sel_exprlist args)
-      | Call_builtin ef => Sbuiltin (sel_builtin_res optid) ef
-                                    (sel_builtin_args args
-                                       (Machregs.builtin_constraints ef))
+      | Call_builtin ef => sel_builtin optid ef args
       end)
   | Cminor.Sbuiltin optid ef args =>
-      OK (Sbuiltin (sel_builtin_res optid) ef
-                   (sel_builtin_args args (Machregs.builtin_constraints ef)))
+      OK (sel_builtin optid ef args)
   | Cminor.Stailcall sg fn args =>
       OK (match classify_call fn with
       | Call_imm id  => Stailcall sg (inr _ id) (sel_exprlist args)
       | _            => Stailcall sg (inl _ (sel_expr fn)) (sel_exprlist args)
       end)
   | Cminor.Sseq s1 s2 =>
-      do s1' <- sel_stmt s1; do s2' <- sel_stmt s2;
+      do s1' <- sel_stmt ki env s1; do s2' <- sel_stmt ki env s2;
       OK (Sseq s1' s2')
   | Cminor.Sifthenelse e ifso ifnot =>
-      do ifso' <- sel_stmt ifso; do ifnot' <- sel_stmt ifnot;
-      OK (Sifthenelse (condexpr_of_expr (sel_expr e)) ifso' ifnot')
+      match if_conversion ki env e ifso ifnot with
+      | Some s => OK s
+      | None =>
+          do ifso' <- sel_stmt ki env ifso; do ifnot' <- sel_stmt ki env ifnot;
+          OK (Sifthenelse (condexpr_of_expr (sel_expr e)) ifso' ifnot')
+      end
   | Cminor.Sloop body =>
-      do body' <- sel_stmt body; OK (Sloop body')
+      do body' <- sel_stmt ki env body; OK (Sloop body')
   | Cminor.Sblock body =>
-      do body' <- sel_stmt body; OK (Sblock body')
+      do body' <- sel_stmt ki env body; OK (Sblock body')
   | Cminor.Sexit n => OK (Sexit n)
   | Cminor.Sswitch false e cases dfl =>
       let t := compile_switch Int.modulus dfl cases in
@@ -314,7 +423,7 @@ Fixpoint sel_stmt (s: Cminor.stmt) : res stmt :=
   | Cminor.Sreturn None => OK (Sreturn None)
   | Cminor.Sreturn (Some e) => OK (Sreturn (Some (sel_expr e)))
   | Cminor.Slabel lbl body =>
-      do body' <- sel_stmt body; OK (Slabel lbl body')
+      do body' <- sel_stmt ki env body; OK (Slabel lbl body')
   | Cminor.Sgoto lbl => OK (Sgoto lbl)
   end.
 
@@ -322,8 +431,15 @@ End SELECTION.
 
 (** Conversion of functions. *)
 
+Definition known_id (f: Cminor.function) : known_idents :=
+  let add (ki: known_idents) (id: ident) := PTree.set id tt ki in
+  List.fold_left add f.(Cminor.fn_vars)
+      (List.fold_left add f.(Cminor.fn_params) (PTree.empty unit)).
+
 Definition sel_function (dm: PTree.t globdef) (hf: helper_functions) (f: Cminor.function) : res function :=
-  do body' <- sel_stmt dm f.(Cminor.fn_body);
+  let ki := known_id f in
+  do env <- Cminortyping.type_function f;
+  do body' <- sel_stmt dm ki env f.(Cminor.fn_body);
   OK (mkfunction
         f.(Cminor.fn_sig)
         f.(Cminor.fn_params)
diff --git a/backend/Selectionaux.ml b/backend/Selectionaux.ml
new file mode 100644
index 00000000..8acae8f2
--- /dev/null
+++ b/backend/Selectionaux.ml
@@ -0,0 +1,115 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
+(*                                                                     *)
+(*  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 AST
+open Cminor
+
+(* Heuristics to guide if conversion *)
+
+(* Estimate a cost for evaluating a safe expression.
+   Unsafe operators need not be estimated.
+   Basic integer operations (add, and, ...) have cost 1 by convention.
+   The other costs are rough estimates. *)
+
+let cost_unop = function
+  | Ocast8unsigned | Ocast8signed
+  | Ocast16unsigned | Ocast16signed
+  | Onegint | Onotint -> 1
+  | Onegf | Oabsf -> 1
+  | Onegfs | Oabsfs -> 1
+  | Osingleoffloat | Ofloatofsingle -> 2
+  | Ointoffloat | Ointuoffloat
+  | Ofloatofint | Ofloatofintu
+  | Ointofsingle | Ointuofsingle
+  | Osingleofint | Osingleofintu -> assert false
+  | Onegl | Onotl -> if Archi.splitlong then 2 else 1
+  | Ointoflong | Olongofint | Olongofintu -> 1
+  | Olongoffloat | Olonguoffloat
+  | Ofloatoflong | Ofloatoflongu
+  | Olongofsingle | Olonguofsingle
+  | Osingleoflong | Osingleoflongu -> assert false
+
+let cost_binop = function
+  | Oadd  | Osub -> 1
+  | Omul -> 2
+  | Odiv  | Odivu | Omod  | Omodu -> assert false
+  | Oand  | Oor   | Oxor  | Oshl  | Oshr  | Oshru -> 1
+  | Oaddf | Osubf | Omulf -> 2
+  | Odivf -> 10
+  | Oaddfs| Osubfs| Omulfs -> 2
+  | Odivfs -> 10
+  | Oaddl | Osubl -> if Archi.splitlong then 3 else 1
+  | Omull -> if Archi.splitlong then 6 else 2
+  | Odivl | Odivlu | Omodl | Omodlu -> assert false
+  | Oandl | Oorl  | Oxorl -> if Archi.splitlong then 2 else 1
+  | Oshll | Oshrl | Oshrlu -> if Archi.splitlong then 4 else 1
+  | Ocmp _ | Ocmpu _ -> 2
+  | Ocmpf _ | Ocmpfs _ -> 2
+  | Ocmpl _ | Ocmplu _ -> assert false
+
+let rec cost_expr = function
+  | Evar _ -> 0
+  | Econst _ -> 1
+  | Eunop(op, e1) -> cost_unop op + cost_expr e1
+  | Ebinop(op, e1, e2) -> cost_binop op + cost_expr e1 + cost_expr e2
+  | Eload(_, e1) -> assert false
+
+(* Does the target architecture support an efficient "conditional move"
+   at the given type? *)
+
+let fast_cmove ty =
+  match Configuration.arch, Configuration.model with
+  | "aarch64", _ ->
+      (match ty with Tint | Tlong | Tfloat | Tsingle -> true | _ -> false)
+  | "arm", _ ->
+      (match ty with Tint | Tfloat | Tsingle -> true | _ -> false)
+  | "powerpc", "e5500" -> 
+      (match ty with Tint -> true | Tlong -> true | _ -> false)
+  | "powerpc", _ -> false
+  | "riscV", _ -> false
+  | "x86", _ -> 
+      (match ty with Tint -> true | Tlong -> Archi.ptr64 | _ -> false)
+  | _, _ ->
+      assert false
+
+(* The if-conversion heuristic depend on the
+   -fif-conversion and -Obranchless flags.
+
+With [-fno-if-conversion] or [-0O], if-conversion is turned off entirely.
+With [-Obranchless], if-conversion is performed whenever semantically
+correct, regardless of how much it could cost.
+Otherwise (and by default), optimization is performed when it seems beneficial.
+
+If-conversion seems beneficial if:
+- the target architecture supports an efficient "conditional move" instruction
+  (not an emulation that takes several instructions)
+- the total cost the "then" and "else" branches is not too high
+- the cost difference between the "then" and "else" branches is low enough.
+
+Intuition: on a modern processor, the "then" and the "else" branches
+can generally be computed in parallel, there is enough ILP for that.
+So, the bad case is if the most taken branch is much cheaper than the
+other branch.  Another bad case is if both branches are big: since the
+code for one branch precedes entirely the code for the other branch,
+if the first branch contains a lot of instructions,
+dynamic reordering of instructions will not look ahead far enough
+to execute instructions from the other branch in parallel with
+instructions from the first branch.
+*)
+
+let if_conversion_heuristic cond ifso ifnot ty =
+  if not !Clflags.option_fifconversion then false else
+  if !Clflags.option_Obranchless then true else
+  if not (fast_cmove ty) then false else
+  let c1 = cost_expr ifso and c2 = cost_expr ifnot in
+  c1 + c2 <= 24 && abs (c1 - c2) <= 8
+
diff --git a/backend/Selectionproof.v b/backend/Selectionproof.v
index afc470b3..8a3aaae6 100644
--- a/backend/Selectionproof.v
+++ b/backend/Selectionproof.v
@@ -14,8 +14,9 @@
 
 Require Import FunInd.
 Require Import Coqlib Maps.
-Require Import AST Linking Errors Integers Values Memory Events Globalenvs Smallstep.
-Require Import Switch Cminor Op CminorSel.
+Require Import AST Linking Errors Integers.
+Require Import Values Memory Builtins Events Globalenvs Smallstep.
+Require Import Switch Cminor Op CminorSel Cminortyping.
 Require Import SelectOp SelectDiv SplitLong SelectLong Selection.
 Require Import SelectOpproof SelectDivproof SplitLongproof SelectLongproof.
 
@@ -119,6 +120,16 @@ Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 Hypothesis TRANSF: match_prog prog tprog.
 
+Lemma wt_prog : wt_program prog.
+Proof.
+  red; intros. destruct TRANSF as [A _].
+  exploit list_forall2_in_left; eauto.
+  intros ((i' & gd') & B & (C & D)). simpl in *. inv D. 
+  destruct H2 as (hf & P & Q). destruct f; monadInv Q.
+- monadInv EQ. econstructor; apply type_function_sound; eauto.
+- constructor.
+Qed.
+
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
 Proof (Genv.find_symbol_match TRANSF).
@@ -202,6 +213,22 @@ Proof.
   simpl. inv H0. auto.
 Qed.
 
+Lemma eval_condition_of_expr:
+  forall a le v b,
+  eval_expr tge sp e m le a v ->
+  Val.bool_of_val v b ->
+  exists vl,
+     eval_exprlist tge sp e m le (snd (condition_of_expr a)) vl
+  /\ eval_condition (fst (condition_of_expr a)) vl m = Some b.
+Proof.
+  intros a; functional induction (condition_of_expr a); intros; simpl.
+- inv H. exists vl; split; auto.
+  simpl in H6. inv H6. apply Val.bool_of_val_of_optbool in H0. auto.
+- exists (v :: nil); split.
+  constructor; auto; constructor.
+  inv H0; simpl; auto.
+Qed.
+
 Lemma eval_load:
   forall le a v chunk v',
   eval_expr tge sp e m le a v ->
@@ -324,6 +351,52 @@ Proof.
   exists v; split; auto. eapply eval_cmplu; eauto.
 Qed.
 
+Lemma eval_sel_select:
+  forall le a1 a2 a3 v1 v2 v3 b ty,
+  eval_expr tge sp e m le a1 v1 ->
+  eval_expr tge sp e m le a2 v2 ->
+  eval_expr tge sp e m le a3 v3 ->
+  Val.bool_of_val v1 b ->
+  exists v, eval_expr tge sp e m le (sel_select ty a1 a2 a3) v
+        /\  Val.lessdef (Val.select (Some b) v2 v3 ty) v.
+Proof.
+  unfold sel_select; intros.
+  specialize (eval_condition_of_expr _ _ _ _ H H2). 
+  destruct (condition_of_expr a1) as [cond args]; simpl fst; simpl snd. intros (vl & A & B).
+  destruct (select ty cond args a2 a3) as [a|] eqn:SEL.
+- eapply eval_select; eauto. 
+- exists (if b then v2 else v3); split.
+  econstructor; eauto. eapply eval_condexpr_of_expr; eauto. destruct b; auto.
+  apply Val.lessdef_normalize.
+Qed.
+
+(** Known built-in functions *)
+
+Lemma eval_sel_known_builtin:
+  forall bf args a vl v le,
+  sel_known_builtin bf args = Some a ->
+  eval_exprlist tge sp e m le args vl ->
+  builtin_function_sem bf vl = Some v ->
+  exists v', eval_expr tge sp e m le a v' /\ Val.lessdef v v'.
+Proof.
+  intros until le; intros SEL ARGS SEM.
+  destruct bf as [bf|bf]; simpl in SEL.
+- destruct bf; try discriminate.
++ (* select *)
+  inv ARGS; try discriminate. inv H0; try discriminate. inv H2; try discriminate. inv H3; try discriminate.
+  inv SEL.
+  simpl in SEM. destruct v1; inv SEM.
+  replace (Val.normalize (if Int.eq i Int.zero then v2 else v0) t)
+     with (Val.select (Some (negb (Int.eq i Int.zero))) v0 v2 t)
+       by (destruct (Int.eq i Int.zero); reflexivity).
+  eapply eval_sel_select; eauto. constructor.
++ (* fabs *)
+  inv ARGS; try discriminate. inv H0; try discriminate.
+  inv SEL.  
+  simpl in SEM; inv SEM. apply eval_absf; auto.
+- eapply eval_platform_builtin; eauto.
+Qed.
+
 End CMCONSTR.
 
 (** Recognition of calls to built-in functions *)
@@ -506,7 +579,7 @@ Proof.
   unfold Int.sub. rewrite Int.unsigned_repr_eq. f_equal. f_equal.
   apply Int.unsigned_repr. unfold Int.max_unsigned; omega.
 - intros until i0; intros EVAL R. exists v; split; auto.
-  inv R. rewrite Zmod_small by (apply Int.unsigned_range). constructor.
+  inv R. rewrite Z.mod_small by (apply Int.unsigned_range). constructor.
 - constructor.
 - apply Int.unsigned_range.
 Qed.
@@ -698,6 +771,29 @@ Proof.
   exists (v1' :: vl'); split; auto. constructor; eauto.
 Qed.
 
+Lemma sel_select_opt_correct:
+  forall ty cond a1 a2 a sp e m vcond v1 v2 b e' m' le,
+  sel_select_opt ty cond a1 a2 = Some a ->
+  Cminor.eval_expr ge sp e m cond vcond ->
+  Cminor.eval_expr ge sp e m a1 v1 ->
+  Cminor.eval_expr ge sp e m a2 v2 ->
+  Val.bool_of_val vcond b ->
+  env_lessdef e e' -> Mem.extends m m' ->
+  exists v', eval_expr tge sp e' m' le a v' /\ Val.lessdef (Val.select (Some b) v1 v2 ty) v'.
+Proof.
+  unfold sel_select_opt; intros. 
+  destruct (condition_of_expr (sel_expr cond)) as [cnd args] eqn:C.
+  exploit sel_expr_correct. eexact H0. eauto. eauto. intros (vcond' & EVC & LDC).
+  exploit sel_expr_correct. eexact H1. eauto. eauto. intros (v1' & EV1 & LD1).
+  exploit sel_expr_correct. eexact H2. eauto. eauto. intros (v2' & EV2 & LD2).
+  assert (Val.bool_of_val vcond' b) by (inv H3; inv LDC; constructor).
+  exploit eval_condition_of_expr. eexact EVC. eauto. rewrite C. intros (vargs' & EVARGS & EVCOND).
+  exploit eval_select; eauto. intros (v' & X & Y). 
+  exists v'; split; eauto. 
+  eapply Val.lessdef_trans; [|eexact Y].
+  apply Val.select_lessdef; auto.
+Qed.
+
 Lemma sel_builtin_arg_correct:
   forall sp e e' m m' a v c,
   env_lessdef e e' -> Mem.extends m m' ->
@@ -741,37 +837,219 @@ Proof.
   intros. destruct oid; simpl; auto. apply set_var_lessdef; auto.
 Qed.
 
+Lemma sel_builtin_default_correct:
+  forall optid ef al sp e1 m1 vl t v m2 e1' m1' f k,
+  Cminor.eval_exprlist ge sp e1 m1 al vl ->
+  external_call ef ge vl m1 t v m2 ->
+  env_lessdef e1 e1' -> Mem.extends m1 m1' ->
+  exists e2' m2',
+     step tge (State f (sel_builtin_default optid ef al) k sp e1' m1')
+            t (State f Sskip k sp e2' m2')
+  /\ env_lessdef (set_optvar optid v e1) e2'
+  /\ Mem.extends m2 m2'.
+Proof.
+  intros. unfold sel_builtin_default.
+  exploit sel_builtin_args_correct; eauto. intros (vl' & A & B).
+  exploit external_call_mem_extends; eauto. intros (v' & m2' & D & E & F & _).
+  econstructor; exists m2'; split.
+  econstructor. eexact A. eapply external_call_symbols_preserved. eexact senv_preserved. eexact D.
+  split; auto. apply sel_builtin_res_correct; auto.
+Qed. 
+
+Lemma sel_builtin_correct:
+  forall optid ef al sp e1 m1 vl t v m2 e1' m1' f k,
+  Cminor.eval_exprlist ge sp e1 m1 al vl ->
+  external_call ef ge vl m1 t v m2 ->
+  env_lessdef e1 e1' -> Mem.extends m1 m1' ->
+  exists e2' m2',
+     step tge (State f (sel_builtin optid ef al) k sp e1' m1')
+            t (State f Sskip k sp e2' m2')
+  /\ env_lessdef (set_optvar optid v e1) e2'
+  /\ Mem.extends m2 m2'.
+Proof.
+  intros. 
+  exploit sel_exprlist_correct; eauto. intros (vl' & A & B).
+  exploit external_call_mem_extends; eauto. intros (v' & m2' & D & E & F & _).
+  unfold sel_builtin.
+  destruct optid as [id|]; eauto using sel_builtin_default_correct.
+  destruct ef; eauto using sel_builtin_default_correct.
+  destruct (lookup_builtin_function name sg) as [bf|] eqn:LKUP; eauto using sel_builtin_default_correct.
+  destruct (sel_known_builtin bf (sel_exprlist al)) as [a|] eqn:SKB; eauto using sel_builtin_default_correct.
+  simpl in D. red in D. rewrite LKUP in D. inv D.
+  exploit eval_sel_known_builtin; eauto. intros (v'' & U & V).
+  econstructor; exists m2'; split.
+  econstructor. eexact U.
+  split; auto. apply set_var_lessdef; auto. apply Val.lessdef_trans with v'; auto.
+Qed.
+
+(** If-conversion *)
+
+Lemma classify_stmt_sound_1:
+  forall f sp e m s k,
+  classify_stmt s = SCskip ->
+  star Cminor.step ge (Cminor.State f s k sp e m) E0 (Cminor.State f Cminor.Sskip k sp e m).
+Proof.
+  intros until s; functional induction (classify_stmt s); intros; try discriminate.
+  - apply star_refl.
+  - eapply star_trans; eauto. eapply star_two. constructor. constructor.
+    traceEq. traceEq.
+  - eapply star_left. constructor.
+    eapply star_right. eauto. constructor.
+    traceEq. traceEq.
+Qed.
+
+Lemma classify_stmt_sound_2:
+  forall f sp e m a id v,
+  Cminor.eval_expr ge sp e m a v ->
+  forall s k,
+  classify_stmt s = SCassign id a ->
+  star Cminor.step ge (Cminor.State f s k sp e m) E0 (Cminor.State f Cminor.Sskip k sp (PTree.set id v e) m).
+Proof.
+  intros until s; functional induction (classify_stmt s); intros; try discriminate.
+  - inv H0. apply star_one. constructor; auto.
+  - eapply star_trans; eauto. eapply star_two. constructor. constructor.
+    traceEq. traceEq.
+  - eapply star_left. constructor.
+    eapply star_right. eauto. constructor.
+    traceEq. traceEq.
+Qed.
+
+Lemma classify_stmt_wt:
+  forall env tyret id a s,
+  classify_stmt s = SCassign id a ->
+  wt_stmt env tyret s ->
+  wt_expr env a (env id).
+Proof.
+  intros until s; functional induction (classify_stmt s); intros CL WT;
+  try discriminate.
+- inv CL; inv WT; auto.
+- inv WT; eauto.
+- inv WT; eauto.
+Qed.
+
+Lemma eval_select_safe_exprs:
+  forall a1 a2 f env ty e e' m m' sp cond vb b id s,
+  safe_expr (known_id f) a1 = true ->
+  safe_expr (known_id f) a2 = true ->
+  option_map (fun sel => Sassign id sel) (sel_select_opt ty cond a1 a2) = Some s ->
+  Cminor.eval_expr ge sp e m cond vb -> Val.bool_of_val vb b ->
+  wt_expr env a1 ty ->
+  wt_expr env a2 ty ->
+  def_env f e -> wt_env env e ->
+  Cminor.eval_expr ge sp e m cond vb -> Val.bool_of_val vb b ->
+  env_lessdef e e' -> Mem.extends m m' ->
+  exists a' v1 v2 v',
+     s = Sassign id a'
+  /\ Cminor.eval_expr ge sp e m a1 v1
+  /\ Cminor.eval_expr ge sp e m a2 v2
+  /\ eval_expr tge sp e' m' nil a' v'
+  /\ Val.lessdef (if b then v1 else v2) v'.
+Proof.
+  intros.
+  destruct (sel_select_opt ty cond a1 a2) as [a'|] eqn:SSO; simpl in H1; inv H1.
+  destruct (eval_safe_expr ge f sp e m a1) as (v1 & EV1); auto.
+  destruct (eval_safe_expr ge f sp e m a2) as (v2 & EV2); auto.
+  assert (TY1: Val.has_type v1 ty) by (eapply wt_eval_expr; eauto).
+  assert (TY2: Val.has_type v2 ty) by (eapply wt_eval_expr; eauto).
+  exploit sel_select_opt_correct; eauto. intros (v' & EV' & LD).
+  exists a', v1, v2, v'; intuition eauto.
+  apply Val.lessdef_trans with (Val.select (Some b) v1 v2 ty).
+  simpl. rewrite Val.normalize_idem; auto. destruct b; auto.
+  assumption.
+Qed. 
+
+Lemma if_conversion_correct:
+  forall f env tyret cond ifso ifnot s vb b k f' k' sp e m e' m',
+  if_conversion (known_id f) env cond ifso ifnot = Some s ->
+  def_env f e -> wt_env env e ->
+  wt_stmt env tyret ifso ->
+  wt_stmt env tyret ifnot ->
+  Cminor.eval_expr ge sp e m cond vb -> Val.bool_of_val vb b ->
+  env_lessdef e e' -> Mem.extends m m' ->
+  let s0 := if b then ifso else ifnot in
+  exists e1 e1',
+     step tge (State f' s k' sp e' m') E0 (State f' Sskip k' sp e1' m')
+  /\ star Cminor.step ge (Cminor.State f s0 k sp e m) E0 (Cminor.State f Cminor.Sskip k sp e1 m)
+  /\ env_lessdef e1 e1'.
+Proof.
+  unfold if_conversion; intros until m'; intros IFC DE WTE WT1 WT2 EVC BOV ELD MEXT.
+  set (s0 := if b then ifso else ifnot). set (ki := known_id f) in *.
+  destruct (classify_stmt ifso) eqn:IFSO; try discriminate;
+  destruct (classify_stmt ifnot) eqn:IFNOT; try discriminate;
+  unfold if_conversion_base in IFC.
+- destruct (is_known ki id && safe_expr ki (Cminor.Evar id) && safe_expr ki a
+            && if_conversion_heuristic cond (Cminor.Evar id) a (env id)) eqn:B; inv IFC.
+  InvBooleans.
+  exploit (eval_select_safe_exprs (Cminor.Evar id) a); eauto.
+  constructor. eapply classify_stmt_wt; eauto.
+  intros (a' & v1 & v2 & v' & A & B & C & D & E).
+  exists (PTree.set id (if b then v1 else v2) e), (PTree.set id v' e').
+  split. subst s. constructor; auto.
+  split. unfold s0; destruct b. 
+  rewrite PTree.gsident by (inv B; auto). apply classify_stmt_sound_1; auto.
+  eapply classify_stmt_sound_2; eauto.
+  apply set_var_lessdef; auto.
+- destruct (is_known ki id && safe_expr ki a && safe_expr ki (Cminor.Evar id)
+            && if_conversion_heuristic cond a (Cminor.Evar id) (env id)) eqn:B; inv IFC.
+  InvBooleans.
+  exploit (eval_select_safe_exprs a (Cminor.Evar id)); eauto.
+  eapply classify_stmt_wt; eauto. constructor. 
+  intros (a' & v1 & v2 & v' & A & B & C & D & E).
+  exists (PTree.set id (if b then v1 else v2) e), (PTree.set id v' e').
+  split. subst s. constructor; auto.
+  split. unfold s0; destruct b. 
+  eapply classify_stmt_sound_2; eauto.
+  rewrite PTree.gsident by (inv C; auto). apply classify_stmt_sound_1; auto.
+  apply set_var_lessdef; auto.
+- destruct (ident_eq id id0); try discriminate. subst id0.
+  destruct (is_known ki id && safe_expr ki a && safe_expr ki a0
+            && if_conversion_heuristic cond a a0 (env id)) eqn:B; inv IFC.
+  InvBooleans.
+  exploit (eval_select_safe_exprs a a0); eauto.
+  eapply classify_stmt_wt; eauto. eapply classify_stmt_wt; eauto.
+  intros (a' & v1 & v2 & v' & A & B & C & D & E).
+  exists (PTree.set id (if b then v1 else v2) e), (PTree.set id v' e').
+  split. subst s. constructor; auto.
+  split. unfold s0; destruct b; eapply classify_stmt_sound_2; eauto.
+  apply set_var_lessdef; auto.
+Qed.
+
 End EXPRESSIONS.
 
 (** Semantic preservation for functions and statements. *)
 
-Inductive match_cont: Cminor.program -> helper_functions -> Cminor.cont -> CminorSel.cont -> Prop :=
-  | match_cont_stop: forall cunit hf,
-      match_cont cunit hf Cminor.Kstop Kstop
-  | match_cont_seq: forall cunit hf s s' k k',
-      sel_stmt (prog_defmap cunit) s = OK s' ->
-      match_cont cunit hf k k' ->
-      match_cont cunit hf (Cminor.Kseq s k) (Kseq s' k')
-  | match_cont_block: forall cunit hf k k',
-      match_cont cunit hf k k' ->
-      match_cont cunit hf (Cminor.Kblock k) (Kblock k')
-  | match_cont_call: forall cunit' hf' cunit hf id f sp e k f' e' k',
+Inductive match_cont: Cminor.program -> helper_functions -> known_idents -> typenv -> Cminor.cont -> CminorSel.cont -> Prop :=
+  | match_cont_seq: forall cunit hf ki env s s' k k',
+      sel_stmt (prog_defmap cunit) ki env s = OK s' ->
+      match_cont cunit hf ki env k k' ->
+      match_cont cunit hf ki env (Cminor.Kseq s k) (Kseq s' k')
+  | match_cont_block: forall cunit hf ki env k k',
+      match_cont cunit hf ki env k k' ->
+      match_cont cunit hf ki env (Cminor.Kblock k) (Kblock k')
+  | match_cont_other: forall cunit hf ki env k k',
+      match_call_cont k k' ->
+      match_cont cunit hf ki env k k'
+
+with match_call_cont: Cminor.cont -> CminorSel.cont -> Prop :=
+  | match_cont_stop:
+      match_call_cont Cminor.Kstop Kstop
+  | match_cont_call: forall cunit hf env id f sp e k f' e' k',
       linkorder cunit prog ->
       helper_functions_declared cunit hf ->
       sel_function (prog_defmap cunit) hf f = OK f' ->
-      match_cont cunit hf k k' -> env_lessdef e e' ->
-      match_cont cunit' hf' (Cminor.Kcall id f sp e k) (Kcall id f' sp e' k').
-
-Definition match_call_cont (k: Cminor.cont) (k': CminorSel.cont) : Prop :=
-  forall cunit hf, match_cont cunit hf k k'.
+      type_function f = OK env ->
+      match_cont cunit hf (known_id f) env k k' ->
+      env_lessdef e e' ->
+      match_call_cont (Cminor.Kcall id f sp e k) (Kcall id f' sp e' k').
 
 Inductive match_states: Cminor.state -> CminorSel.state -> Prop :=
-  | match_state: forall cunit hf f f' s k s' k' sp e m e' m'
+  | match_state: forall cunit hf f f' s k s' k' sp e m e' m' env
         (LINK: linkorder cunit prog)
         (HF: helper_functions_declared cunit hf)
         (TF: sel_function (prog_defmap cunit) hf f = OK f')
-        (TS: sel_stmt (prog_defmap cunit) s = OK s')
-        (MC: match_cont cunit hf k k')
+        (TYF: type_function f = OK env)
+        (TS: sel_stmt (prog_defmap cunit) (known_id f) env s = OK s')
+        (MC: match_cont cunit hf (known_id f) env k k')
         (LD: env_lessdef e e')
         (ME: Mem.extends m m'),
       match_states
@@ -793,48 +1071,49 @@ Inductive match_states: Cminor.state -> CminorSel.state -> Prop :=
       match_states
         (Cminor.Returnstate v k m)
         (Returnstate v' k' m')
-  | match_builtin_1: forall cunit hf ef args args' optid f sp e k m al f' e' k' m'
+  | match_builtin_1: forall cunit hf ef args optid f sp e k m al f' e' k' m' env
         (LINK: linkorder cunit prog)
         (HF: helper_functions_declared cunit hf)
         (TF: sel_function (prog_defmap cunit) hf f = OK f')
-        (MC: match_cont cunit hf k k')
-        (LDA: Val.lessdef_list args args')
+        (TYF: type_function f = OK env)
+        (MC: match_cont cunit hf (known_id f) env k k')
+        (EA: Cminor.eval_exprlist ge sp e m al args)
         (LDE: env_lessdef e e')
-        (ME: Mem.extends m m')
-        (EA: list_forall2 (CminorSel.eval_builtin_arg tge sp e' m') al args'),
+        (ME: Mem.extends m m'),
       match_states
         (Cminor.Callstate (External ef) args (Cminor.Kcall optid f sp e k) m)
-        (State f' (Sbuiltin (sel_builtin_res optid) ef al) k' sp e' m')
-  | match_builtin_2: forall cunit hf v v' optid f sp e k m f' e' m' k'
+        (State f' (sel_builtin optid ef al) k' sp e' m')
+  | match_builtin_2: forall cunit hf v v' optid f sp e k m f' e' m' k' env
         (LINK: linkorder cunit prog)
         (HF: helper_functions_declared cunit hf)
         (TF: sel_function (prog_defmap cunit) hf f = OK f')
-        (MC: match_cont cunit hf k k')
+        (TYF: type_function f = OK env)
+        (MC: match_cont cunit hf (known_id f) env k k')
         (LDV: Val.lessdef v v')
-        (LDE: env_lessdef e e')
+        (LDE: env_lessdef (set_optvar optid v e) e')
         (ME: Mem.extends m m'),
       match_states
         (Cminor.Returnstate v (Cminor.Kcall optid f sp e k) m)
-        (State f' Sskip k' sp (set_builtin_res (sel_builtin_res optid) v' e') m').
+        (State f' Sskip k' sp e' m').
 
 Remark call_cont_commut:
-  forall cunit hf k k', match_cont cunit hf k k' -> match_call_cont (Cminor.call_cont k) (call_cont k').
+  forall cunit hf ki env k k',
+  match_cont cunit hf ki env k k' -> match_call_cont (Cminor.call_cont k) (call_cont k').
 Proof.
-  induction 1; simpl; auto; red; intros.
-- constructor.
-- eapply match_cont_call with (hf := hf); eauto.
+  induction 1; simpl; auto. inversion H; subst; auto.
 Qed.
 
 Remark match_is_call_cont:
-  forall cunit hf k k', match_cont cunit hf k k' -> Cminor.is_call_cont k -> match_call_cont k k'.
+  forall cunit hf ki env k k',
+  match_cont cunit ki env hf k k' -> Cminor.is_call_cont k ->
+  match_call_cont k k' /\ is_call_cont k'.
 Proof.
-  destruct 1; intros; try contradiction; red; intros.
-- constructor.
-- eapply match_cont_call with (hf := hf); eauto.
+  destruct 1; intros; try contradiction. split; auto. inv H; auto.
 Qed.
 
+(*
 Remark match_call_cont_cont:
-  forall k k', match_call_cont k k' -> exists cunit hf, match_cont cunit hf k k'.
+  forall k k', match_call_cont k k' -> exists cunit hf ki env, match_cont cunit hf ki env k k'.
 Proof.
   intros. simple refine (let cunit : Cminor.program := _ in _).
   econstructor. apply nil. apply nil. apply xH.
@@ -842,14 +1121,66 @@ Proof.
   econstructor; apply xH.
   exists cunit, hf; auto.
 Qed.
+*)
+
+Definition nolabel (s: Cminor.stmt) : Prop :=
+  forall lbl k, Cminor.find_label lbl s k = None.
+Definition nolabel' (s: stmt) : Prop :=
+  forall lbl k, find_label lbl s k = None.
+
+Lemma classify_stmt_nolabel:
+  forall s, classify_stmt s <> SCother -> nolabel s.
+Proof.
+  intros s. functional induction (classify_stmt s); intros.
+- red; auto.
+- red; auto.
+- apply IHs0 in H. red; intros; simpl. apply H.
+- apply IHs0 in H. red; intros; simpl. rewrite H; auto.
+- congruence.
+Qed.
+
+Lemma if_conversion_base_nolabel: forall (hf: helper_functions) ki env a id a1 a2 s,
+  if_conversion_base ki env a id a1 a2 = Some s ->
+  nolabel' s.
+Proof.
+  unfold if_conversion_base; intros.
+  destruct (is_known ki id && safe_expr ki a1 && safe_expr ki a2 &&
+            if_conversion_heuristic a a1 a2 (env id)); try discriminate.
+  destruct (sel_select_opt (env id) a a1 a2); inv H. 
+  red; auto.
+Qed.
+
+Lemma if_conversion_nolabel: forall (hf: helper_functions) ki env a s1 s2 s,
+    if_conversion ki env a s1 s2 = Some s ->
+    nolabel s1 /\ nolabel s2 /\ nolabel' s.
+Proof.
+  unfold if_conversion; intros.
+  Ltac conclude :=
+    split; [apply classify_stmt_nolabel;congruence
+           |split; [apply classify_stmt_nolabel;congruence
+                   |eapply if_conversion_base_nolabel; eauto]].
+  destruct (classify_stmt s1) eqn:C1; try discriminate;
+  destruct (classify_stmt s2) eqn:C2; try discriminate.
+  conclude.
+  conclude.
+  destruct (ident_eq id id0). conclude. discriminate.
+Qed.
+
+Remark sel_builtin_nolabel:
+  forall (hf: helper_functions) optid ef args, nolabel' (sel_builtin optid ef args).
+Proof.
+  unfold sel_builtin; intros; red; intros.
+  destruct optid; auto. destruct ef; auto. destruct lookup_builtin_function; auto.
+  destruct sel_known_builtin; auto. 
+Qed. 
 
 Remark find_label_commut:
-  forall cunit hf lbl s k s' k',
-  match_cont cunit hf k k' ->
-  sel_stmt (prog_defmap cunit) s = OK s' ->
+  forall cunit hf ki env lbl s k s' k',
+  match_cont cunit hf ki env k k' ->
+  sel_stmt (prog_defmap cunit) ki env s = OK s' ->
   match Cminor.find_label lbl s k, find_label lbl s' k' with
   | None, None => True
-  | Some(s1, k1), Some(s1', k1') => sel_stmt (prog_defmap cunit) s1 = OK s1' /\ match_cont cunit hf k1 k1'
+  | Some(s1, k1), Some(s1', k1') => sel_stmt (prog_defmap cunit) ki env s1 = OK s1' /\ match_cont cunit hf ki env k1 k1'
   | _, _ => False
   end.
 Proof.
@@ -858,14 +1189,21 @@ Proof.
   unfold store. destruct (addressing m (sel_expr e)); simpl; auto.
 (* call *)
   destruct (classify_call (prog_defmap cunit) e); simpl; auto.
+  rewrite sel_builtin_nolabel; auto.
 (* tailcall *)
   destruct (classify_call (prog_defmap cunit) e); simpl; auto.
+(* builtin *)
+  rewrite sel_builtin_nolabel; auto.
 (* seq *)
   exploit (IHs1 (Cminor.Kseq s2 k)). constructor; eauto. eauto.
   destruct (Cminor.find_label lbl s1 (Cminor.Kseq s2 k)) as [[sx kx] | ];
   destruct (find_label lbl x (Kseq x0 k')) as [[sy ky] | ];
   intuition. apply IHs2; auto.
 (* ifthenelse *)
+  destruct (if_conversion ki env e s1 s2) as [s|] eqn:IFC.
+  inv SE. exploit if_conversion_nolabel; eauto. intros (A & B & C).
+  rewrite A, B, C. auto.
+  monadInv SE; simpl.
   exploit (IHs1 k); eauto.
   destruct (Cminor.find_label lbl s1 k) as [[sx kx] | ];
   destruct (find_label lbl x k') as [[sy ky] | ];
@@ -895,20 +1233,22 @@ Definition measure (s: Cminor.state) : nat :=
 
 Lemma sel_step_correct:
   forall S1 t S2, Cminor.step ge S1 t S2 ->
-  forall T1, match_states S1 T1 ->
+  forall T1, match_states S1 T1 -> wt_state S1 ->
   (exists T2, step tge T1 t T2 /\ match_states S2 T2)
-  \/ (measure S2 < measure S1 /\ t = E0 /\ match_states S2 T1)%nat.
+  \/ (measure S2 < measure S1 /\ t = E0 /\ match_states S2 T1)%nat
+  \/ (exists S3 T2, star Cminor.step ge S2 E0 S3 /\ step tge T1 t T2 /\ match_states S3 T2).
 Proof.
-  induction 1; intros T1 ME; inv ME; try (monadInv TS).
+  induction 1; intros T1 ME WTS; inv ME; try (monadInv TS).
 - (* skip seq *)
   inv MC. left; econstructor; split. econstructor. econstructor; eauto.
+  inv H.
 - (* skip block *)
   inv MC. left; econstructor; split. econstructor. econstructor; eauto.
+  inv H.
 - (* skip call *)
   exploit Mem.free_parallel_extends; eauto. intros [m2' [A B]].
   left; econstructor; split.
-  econstructor. inv MC; simpl in H; simpl; auto.
-  eauto.
+  econstructor. eapply match_is_call_cont; eauto.
   erewrite stackspace_function_translated; eauto.
   econstructor; eauto. eapply match_is_call_cont; eauto.
 - (* assign *)
@@ -917,8 +1257,8 @@ Proof.
   econstructor; eauto.
   econstructor; eauto. apply set_var_lessdef; auto.
 - (* store *)
-  exploit sel_expr_correct. eauto. eauto. eexact H. eauto. eauto. intros [vaddr' [A B]].
-  exploit sel_expr_correct. eauto. eauto. eexact H0. eauto. eauto. intros [v' [C D]].
+  exploit sel_expr_correct. try apply LINK. try apply HF. eexact H. eauto. eauto. intros [vaddr' [A B]].
+  exploit sel_expr_correct. try apply LINK. try apply HF. eexact H0. eauto. eauto. intros [v' [C D]].
   exploit Mem.storev_extends; eauto. intros [m2' [P Q]].
   left; econstructor; split.
   eapply eval_store; eauto.
@@ -934,7 +1274,7 @@ Proof.
   econstructor; eauto. econstructor; eauto.
   eapply sig_function_translated; eauto.
   eapply match_callstate with (cunit := cunit'); eauto.
-  red; intros. eapply match_cont_call with (cunit := cunit) (hf := hf); eauto.
+  eapply match_cont_call with (cunit := cunit) (hf := hf); eauto.
 + (* direct *)
   intros [b [U V]].
   exploit sel_exprlist_correct; eauto. intros [vargs' [C D]].
@@ -944,12 +1284,10 @@ Proof.
   subst vf. econstructor; eauto. rewrite symbols_preserved; eauto.
   eapply sig_function_translated; eauto.
   eapply match_callstate with (cunit := cunit'); eauto.
-  red; intros; eapply match_cont_call with (cunit := cunit) (hf := hf); eauto.
+  eapply match_cont_call with (cunit := cunit) (hf := hf); eauto.
 + (* turned into Sbuiltin *)
   intros EQ. subst fd.
-  exploit sel_builtin_args_correct; eauto. intros [vargs' [C D]].
-  right; split. simpl. omega. split. auto.
-  econstructor; eauto.
+  right; left; split. simpl; omega. split; auto. econstructor; eauto.
 - (* Stailcall *)
   exploit Mem.free_parallel_extends; eauto. intros [m2' [P Q]].
   erewrite <- stackspace_function_translated in P by eauto.
@@ -966,18 +1304,20 @@ Proof.
   eapply match_callstate with (cunit := cunit'); eauto.
   eapply call_cont_commut; eauto.
 - (* Sbuiltin *)
-  exploit sel_builtin_args_correct; eauto. intros [vargs' [P Q]].
-  exploit external_call_mem_extends; eauto.
-  intros [vres' [m2 [A [B [C D]]]]].
-  left; econstructor; split.
-  econstructor. eauto. eapply external_call_symbols_preserved; eauto. apply senv_preserved.
-  econstructor; eauto. apply sel_builtin_res_correct; auto.
+  exploit sel_builtin_correct; eauto. intros (e2' & m2' & P & Q & R).
+  left; econstructor; split. eexact P. econstructor; eauto.
 - (* Seq *)
   left; econstructor; split.
   constructor.
   econstructor; eauto. constructor; auto.
 - (* Sifthenelse *)
-  exploit sel_expr_correct; eauto. intros [v' [A B]].
+  simpl in TS. destruct (if_conversion (known_id f) env a s1 s2) as [s|] eqn:IFC; monadInv TS.
++ inv WTS. inv WT_FN. assert (env0 = env) by congruence. subst env0. inv WT_STMT.
+  exploit if_conversion_correct; eauto.
+  set (s0 := if b then s1 else s2). intros (e1 & e1' & A & B & C).
+  right; right. econstructor; econstructor.
+  split. eexact B. split. eexact A. econstructor; eauto. 
++ exploit sel_expr_correct; eauto. intros [v' [A B]].
   assert (Val.bool_of_val v' b). inv B. auto. inv H0.
   left; exists (State f' (if b then x else x0) k' sp e' m'); split.
   econstructor; eauto. eapply eval_condexpr_of_expr; eauto.
@@ -989,10 +1329,13 @@ Proof.
   left; econstructor; split. constructor. econstructor; eauto. constructor; auto.
 - (* Sexit seq *)
   inv MC. left; econstructor; split. constructor. econstructor; eauto.
+  inv H.
 - (* Sexit0 block *)
   inv MC. left; econstructor; split. constructor. econstructor; eauto.
+  inv H.
 - (* SexitS block *)
   inv MC. left; econstructor; split. constructor. econstructor; eauto.
+  inv H.
 - (* Sswitch *)
   inv H0; simpl in TS.
 + set (ct := compile_switch Int.modulus default cases) in *.
@@ -1023,10 +1366,10 @@ Proof.
 - (* Slabel *)
   left; econstructor; split. constructor. econstructor; eauto.
 - (* Sgoto *)
-  assert (sel_stmt (prog_defmap cunit) (Cminor.fn_body f) = OK (fn_body f')).
-  { monadInv TF; simpl; auto. }
-  exploit (find_label_commut cunit hf lbl (Cminor.fn_body f) (Cminor.call_cont k)).
-    eapply call_cont_commut; eauto. eauto.
+  assert (sel_stmt (prog_defmap cunit) (known_id f) env (Cminor.fn_body f) = OK (fn_body f')).
+  { monadInv TF; simpl. congruence. }
+  exploit (find_label_commut cunit hf (known_id f) env lbl (Cminor.fn_body f) (Cminor.call_cont k)).
+    apply match_cont_other. eapply call_cont_commut; eauto. eauto.
   rewrite H.
   destruct (find_label lbl (fn_body f') (call_cont k'0))
   as [[s'' k'']|] eqn:?; intros; try contradiction.
@@ -1035,13 +1378,15 @@ Proof.
   econstructor; eauto.
   econstructor; eauto.
 - (* internal function *)
-  destruct TF as (hf & HF & TF). specialize (MC cunit hf).
+  destruct TF as (hf & HF & TF). 
   monadInv TF. generalize EQ; intros TF; monadInv TF.
   exploit Mem.alloc_extends. eauto. eauto. apply Z.le_refl. apply Z.le_refl.
   intros [m2' [A B]].
   left; econstructor; split.
   econstructor; simpl; eauto.
-  econstructor; simpl; eauto. apply set_locals_lessdef. apply set_params_lessdef; auto.
+  econstructor; simpl; eauto.
+  apply match_cont_other; auto.
+  apply set_locals_lessdef. apply set_params_lessdef; auto.
 - (* external call *)
   destruct TF as (hf & HF & TF).
   monadInv TF.
@@ -1051,20 +1396,15 @@ Proof.
   econstructor. eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto.
 - (* external call turned into a Sbuiltin *)
-  exploit external_call_mem_extends; eauto.
-  intros [vres' [m2 [A [B [C D]]]]].
-  left; econstructor; split.
-  econstructor. eauto. eapply external_call_symbols_preserved; eauto. apply senv_preserved.
-  econstructor; eauto.
+  exploit sel_builtin_correct; eauto. intros (e2' & m2' & P & Q & R).
+  left; econstructor; split. eexact P. econstructor; eauto.
 - (* return *)
-  apply match_call_cont_cont in MC. destruct MC as (cunit0 & hf0 & MC).
   inv MC.
   left; econstructor; split.
   econstructor.
   econstructor; eauto. destruct optid; simpl; auto. apply set_var_lessdef; auto.
 - (* return of an external call turned into a Sbuiltin *)
-  right; split. simpl; omega. split. auto. econstructor; eauto.
-  apply sel_builtin_res_correct; auto.
+  right; left; split. simpl; omega. split. auto. econstructor; eauto.
 Qed.
 
 Lemma sel_initial_states:
@@ -1079,26 +1419,35 @@ Proof.
   rewrite (match_program_main TRANSF). fold tge. rewrite symbols_preserved. eauto.
   eexact A.
   rewrite <- H2. eapply sig_function_translated; eauto.
-  econstructor; eauto. red; intros; constructor. apply Mem.extends_refl.
+  econstructor; eauto. constructor. apply Mem.extends_refl.
 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.
-  apply match_call_cont_cont in MC. destruct MC as (cunit0 & hf0 & MC).
-  inv MC. inv LD. constructor.
+  intros. inv H0. inv H. inv MC. inv LD. constructor.
 Qed.
 
 Theorem transf_program_correct:
   forward_simulation (Cminor.semantics prog) (CminorSel.semantics tprog).
 Proof.
-  apply forward_simulation_opt with (match_states := match_states) (measure := measure).
-  apply senv_preserved.
-  apply sel_initial_states; auto.
-  apply sel_final_states; auto.
-  apply sel_step_correct; auto.
+  set (MS := fun S T => match_states S T /\ wt_state S).
+  apply forward_simulation_determ_star with (match_states := MS) (measure := measure).
+- apply Cminor.semantics_determinate.
+- apply senv_preserved.
+- intros. exploit sel_initial_states; eauto. intros (T & P & Q). 
+  exists T; split; auto; split; auto. eapply wt_initial_state. eexact wt_prog. auto. 
+- intros. destruct H. eapply sel_final_states; eauto.
+- intros S1 t S2 A T1 [B C].
+  assert (wt_state S2) by (eapply subject_reduction; eauto using wt_prog).
+  unfold MS.
+  exploit sel_step_correct; eauto.
+  intros [(T2 & D & E) | [(D & E & F) | (S3 & T2 & D & E & F)]].
++ exists S2, T2. intuition auto using star_refl, plus_one.
++ subst t. exists S2, T1. intuition auto using star_refl.
++ assert (wt_state S3) by (eapply subject_reduction_star; eauto using wt_prog).
+  exists S3, T2. intuition auto using plus_one.
 Qed.
 
 End PRESERVATION.
diff --git a/backend/SplitLong.vp b/backend/SplitLong.vp
index de954482..694bb0e2 100644
--- a/backend/SplitLong.vp
+++ b/backend/SplitLong.vp
@@ -43,13 +43,13 @@ Class helper_functions := mk_helper_functions {
   i64_smulh: ident;                     (**r signed multiply high *)
 }.
 
-Definition sig_l_l := mksignature (Tlong :: nil) (Some Tlong) cc_default.
-Definition sig_l_f := mksignature (Tlong :: nil) (Some Tfloat) cc_default.
-Definition sig_l_s := mksignature (Tlong :: nil) (Some Tsingle) cc_default.
-Definition sig_f_l := mksignature (Tfloat :: nil) (Some Tlong) cc_default.
-Definition sig_ll_l := mksignature (Tlong :: Tlong :: nil) (Some Tlong) cc_default.
-Definition sig_li_l := mksignature (Tlong :: Tint :: nil) (Some Tlong) cc_default.
-Definition sig_ii_l := mksignature (Tint :: Tint :: nil) (Some Tlong) cc_default.
+Definition sig_l_l := mksignature (Tlong :: nil) Tlong cc_default.
+Definition sig_l_f := mksignature (Tlong :: nil) Tfloat cc_default.
+Definition sig_l_s := mksignature (Tlong :: nil) Tsingle cc_default.
+Definition sig_f_l := mksignature (Tfloat :: nil) Tlong cc_default.
+Definition sig_ll_l := mksignature (Tlong :: Tlong :: nil) Tlong cc_default.
+Definition sig_li_l := mksignature (Tlong :: Tint :: nil) Tlong cc_default.
+Definition sig_ii_l := mksignature (Tint :: Tint :: nil) Tlong cc_default.
 
 Section SELECT.
 
diff --git a/backend/SplitLongproof.v b/backend/SplitLongproof.v
index f1e8b590..18c1f18d 100644
--- a/backend/SplitLongproof.v
+++ b/backend/SplitLongproof.v
@@ -15,42 +15,13 @@
 Require Import String.
 Require Import Coqlib Maps.
 Require Import AST Errors Integers Floats.
-Require Import Values Memory Globalenvs Events Cminor Op CminorSel.
+Require Import Values Memory Globalenvs Builtins Events Cminor Op CminorSel.
 Require Import SelectOp SelectOpproof SplitLong.
 
 Local Open Scope cminorsel_scope.
 Local Open Scope string_scope.
 
-(** * Axiomatization of the helper functions *)
-
-Definition external_implements (name: string) (sg: signature) (vargs: list val) (vres: val) : Prop :=
-  forall F V (ge: Genv.t F V) m,
-  external_call (EF_runtime name sg) ge vargs m E0 vres m.
-
-Definition builtin_implements (name: string) (sg: signature) (vargs: list val) (vres: val) : Prop :=
-  forall F V (ge: Genv.t F V) m,
-  external_call (EF_builtin name sg) ge vargs m E0 vres m.
-
-Axiom i64_helpers_correct :
-    (forall x z, Val.longoffloat x = Some z -> external_implements "__compcert_i64_dtos" sig_f_l (x::nil) z)
- /\ (forall x z, Val.longuoffloat x = Some z -> external_implements "__compcert_i64_dtou" sig_f_l (x::nil) z)
- /\ (forall x z, Val.floatoflong x = Some z -> external_implements "__compcert_i64_stod" sig_l_f (x::nil) z)
- /\ (forall x z, Val.floatoflongu x = Some z -> external_implements "__compcert_i64_utod" sig_l_f (x::nil) z)
- /\ (forall x z, Val.singleoflong x = Some z -> external_implements "__compcert_i64_stof" sig_l_s (x::nil) z)
- /\ (forall x z, Val.singleoflongu x = Some z -> external_implements "__compcert_i64_utof" sig_l_s (x::nil) z)
- /\ (forall x, builtin_implements "__builtin_negl" sig_l_l (x::nil) (Val.negl x))
- /\ (forall x y, builtin_implements "__builtin_addl" sig_ll_l (x::y::nil) (Val.addl x y))
- /\ (forall x y, builtin_implements "__builtin_subl" sig_ll_l (x::y::nil) (Val.subl x y))
- /\ (forall x y, builtin_implements "__builtin_mull" sig_ii_l (x::y::nil) (Val.mull' x y))
- /\ (forall x y z, Val.divls x y = Some z -> external_implements "__compcert_i64_sdiv" sig_ll_l (x::y::nil) z)
- /\ (forall x y z, Val.divlu x y = Some z -> external_implements "__compcert_i64_udiv" sig_ll_l (x::y::nil) z)
- /\ (forall x y z, Val.modls x y = Some z -> external_implements "__compcert_i64_smod" sig_ll_l (x::y::nil) z)
- /\ (forall x y z, Val.modlu x y = Some z -> external_implements "__compcert_i64_umod" sig_ll_l (x::y::nil) z)
- /\ (forall x y, external_implements "__compcert_i64_shl" sig_li_l (x::y::nil) (Val.shll x y))
- /\ (forall x y, external_implements "__compcert_i64_shr" sig_li_l (x::y::nil) (Val.shrlu x y))
- /\ (forall x y, external_implements "__compcert_i64_sar" sig_li_l (x::y::nil) (Val.shrl x y))
- /\ (forall x y, external_implements "__compcert_i64_umulh" sig_ll_l (x::y::nil) (Val.mullhu x y))
- /\ (forall x y, external_implements "__compcert_i64_smulh" sig_ll_l (x::y::nil) (Val.mullhs x y)).
+(** * Properties of the helper functions *)
 
 Definition helper_declared {F V: Type} (p: AST.program (AST.fundef F) V) (id: ident) (name: string) (sg: signature) : Prop :=
   (prog_defmap p)!id = Some (Gfun (External (EF_runtime name sg))).
@@ -84,60 +55,67 @@ Variable sp: val.
 Variable e: env.
 Variable m: mem.
 
-Ltac UseHelper := decompose [Logic.and] i64_helpers_correct; eauto.
 Ltac DeclHelper := red in HELPERS; decompose [Logic.and] HELPERS; eauto.
 
 Lemma eval_helper:
-  forall le id name sg args vargs vres,
+  forall bf le id name sg args vargs vres,
   eval_exprlist ge sp e m le args vargs ->
   helper_declared prog id name sg  ->
-  external_implements name sg vargs vres ->
+  lookup_builtin_function name sg = Some bf ->
+  builtin_function_sem bf vargs = Some vres ->
   eval_expr ge sp e m le (Eexternal id sg args) vres.
 Proof.
   intros.
   red in H0. apply Genv.find_def_symbol in H0. destruct H0 as (b & P & Q).
   rewrite <- Genv.find_funct_ptr_iff in Q.
-  econstructor; eauto.
+  econstructor; eauto. 
+  simpl. red. rewrite H1. constructor; auto.
 Qed.
 
 Corollary eval_helper_1:
-  forall le id name sg arg1 varg1 vres,
+  forall bf le id name sg arg1 varg1 vres,
   eval_expr ge sp e m le arg1 varg1 ->
   helper_declared prog id name sg  ->
-  external_implements name sg (varg1::nil) vres ->
+  lookup_builtin_function name sg = Some bf ->
+  builtin_function_sem bf (varg1 :: nil) = Some vres ->
   eval_expr ge sp e m le (Eexternal id sg (arg1 ::: Enil)) vres.
 Proof.
   intros. eapply eval_helper; eauto. constructor; auto. constructor.
 Qed.
 
 Corollary eval_helper_2:
-  forall le id name sg arg1 arg2 varg1 varg2 vres,
+  forall bf le id name sg arg1 arg2 varg1 varg2 vres,
   eval_expr ge sp e m le arg1 varg1 ->
   eval_expr ge sp e m le arg2 varg2 ->
   helper_declared prog id name sg  ->
-  external_implements name sg (varg1::varg2::nil) vres ->
+  lookup_builtin_function name sg = Some bf ->
+  builtin_function_sem bf (varg1 :: varg2 :: nil) = Some vres ->
   eval_expr ge sp e m le (Eexternal id sg (arg1 ::: arg2 ::: Enil)) vres.
 Proof.
   intros. eapply eval_helper; eauto. constructor; auto. constructor; auto. constructor.
 Qed.
 
 Remark eval_builtin_1:
-  forall le id sg arg1 varg1 vres,
+  forall bf le id sg arg1 varg1 vres,
   eval_expr ge sp e m le arg1 varg1 ->
-  builtin_implements id sg (varg1::nil) vres ->
+  lookup_builtin_function id sg = Some bf ->
+  builtin_function_sem bf (varg1 :: nil) = Some vres ->
   eval_expr ge sp e m le (Ebuiltin (EF_builtin id sg) (arg1 ::: Enil)) vres.
 Proof.
-  intros. econstructor. econstructor. eauto. constructor. apply H0.
+  intros. econstructor. econstructor. eauto. constructor.
+  simpl. red. rewrite H0. constructor. auto.
 Qed.
 
 Remark eval_builtin_2:
-  forall le id sg arg1 arg2 varg1 varg2 vres,
+  forall bf le id sg arg1 arg2 varg1 varg2 vres,
   eval_expr ge sp e m le arg1 varg1 ->
   eval_expr ge sp e m le arg2 varg2 ->
-  builtin_implements id sg (varg1::varg2::nil) vres ->
+  lookup_builtin_function id sg = Some bf ->
+  builtin_function_sem bf (varg1 :: varg2 :: nil) = Some vres ->
   eval_expr ge sp e m le (Ebuiltin (EF_builtin id sg) (arg1 ::: arg2 ::: Enil)) vres.
 Proof.
-  intros. econstructor. constructor; eauto. constructor; eauto. constructor. apply H1.
+  intros. econstructor. constructor; eauto. constructor; eauto. constructor.
+  simpl. red. rewrite H1. constructor. auto.
 Qed.
 
 Definition unary_constructor_sound (cstr: expr -> expr) (sem: val -> val) : Prop :=
@@ -386,9 +364,10 @@ Qed.
 Theorem eval_negl: unary_constructor_sound negl Val.negl.
 Proof.
   unfold negl; red; intros. destruct (is_longconst a) eqn:E.
-  econstructor; split. apply eval_longconst.
+- econstructor; split. apply eval_longconst.
   exploit is_longconst_sound; eauto. intros EQ; subst x. simpl. auto.
-  econstructor; split. eapply eval_builtin_1; eauto. UseHelper. auto.
+- exists (Val.negl x); split; auto.
+  eapply (eval_builtin_1 (BI_standard BI_negl)); eauto.
 Qed.
 
 Theorem eval_notl: unary_constructor_sound notl Val.notl.
@@ -410,7 +389,7 @@ Theorem eval_longoffloat:
   exists v, eval_expr ge sp e m le (longoffloat a) v /\ Val.lessdef y v.
 Proof.
   intros; unfold longoffloat. econstructor; split.
-  eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto.
+  eapply (eval_helper_1 (BI_standard BI_i64_dtos)); eauto. DeclHelper. auto. auto.
 Qed.
 
 Theorem eval_longuoffloat:
@@ -420,7 +399,7 @@ Theorem eval_longuoffloat:
   exists v, eval_expr ge sp e m le (longuoffloat a) v /\ Val.lessdef y v.
 Proof.
   intros; unfold longuoffloat. econstructor; split.
-  eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto.
+  eapply (eval_helper_1 (BI_standard BI_i64_dtou)); eauto. DeclHelper. auto. auto.
 Qed.
 
 Theorem eval_floatoflong:
@@ -429,8 +408,9 @@ Theorem eval_floatoflong:
   Val.floatoflong x = Some y ->
   exists v, eval_expr ge sp e m le (floatoflong a) v /\ Val.lessdef y v.
 Proof.
-  intros; unfold floatoflong. econstructor; split.
-  eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto.
+  intros; unfold floatoflong. exists y; split; auto.
+  eapply (eval_helper_1 (BI_standard BI_i64_stod)); eauto. DeclHelper. auto.
+  simpl. destruct x; simpl in H0; inv H0; auto.
 Qed.
 
 Theorem eval_floatoflongu:
@@ -439,8 +419,9 @@ Theorem eval_floatoflongu:
   Val.floatoflongu x = Some y ->
   exists v, eval_expr ge sp e m le (floatoflongu a) v /\ Val.lessdef y v.
 Proof.
-  intros; unfold floatoflongu. econstructor; split.
-  eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto.
+  intros; unfold floatoflongu. exists y; split; auto.
+  eapply (eval_helper_1 (BI_standard BI_i64_utod)); eauto. DeclHelper. auto.
+  simpl. destruct x; simpl in H0; inv H0; auto.
 Qed.
 
 Theorem eval_longofsingle:
@@ -477,8 +458,9 @@ Theorem eval_singleoflong:
   Val.singleoflong x = Some y ->
   exists v, eval_expr ge sp e m le (singleoflong a) v /\ Val.lessdef y v.
 Proof.
-  intros; unfold singleoflong. econstructor; split.
-  eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto.
+  intros; unfold singleoflong. exists y; split; auto.
+  eapply (eval_helper_1 (BI_standard BI_i64_stof)); eauto. DeclHelper. auto.
+  simpl. destruct x; simpl in H0; inv H0; auto.
 Qed.
 
 Theorem eval_singleoflongu:
@@ -487,8 +469,9 @@ Theorem eval_singleoflongu:
   Val.singleoflongu x = Some y ->
   exists v, eval_expr ge sp e m le (singleoflongu a) v /\ Val.lessdef y v.
 Proof.
-  intros; unfold singleoflongu. econstructor; split.
-  eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto.
+  intros; unfold singleoflongu. exists y; split; auto.
+  eapply (eval_helper_1 (BI_standard BI_i64_utof)); eauto. DeclHelper. auto.
+  simpl. destruct x; simpl in H0; inv H0; auto.
 Qed.
 
 Theorem eval_andl: binary_constructor_sound andl Val.andl.
@@ -615,7 +598,9 @@ Proof.
     simpl. erewrite <- Int64.decompose_shl_2. instantiate (1 := Int64.hiword i).
     rewrite Int64.ofwords_recompose. auto. auto.
   + (* n >= 64 *)
-    econstructor; split. eapply eval_helper_2; eauto. EvalOp. DeclHelper. UseHelper. auto.
+    econstructor; split.
+    eapply eval_helper_2; eauto. EvalOp. DeclHelper. reflexivity. reflexivity.
+    auto.
 Qed.
 
 Theorem eval_shll: binary_constructor_sound shll Val.shll.
@@ -626,7 +611,7 @@ Proof.
   exploit is_intconst_sound; eauto. intros EQ; subst y; clear H0.
   eapply eval_shllimm; eauto.
 - (* General case *)
-  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto.
+  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. reflexivity. reflexivity. auto.
 Qed.
 
 Lemma eval_shrluimm:
@@ -660,7 +645,9 @@ Proof.
     simpl. erewrite <- Int64.decompose_shru_2. instantiate (1 := Int64.loword i).
     rewrite Int64.ofwords_recompose. auto. auto.
   + (* n >= 64 *)
-    econstructor; split. eapply eval_helper_2; eauto. EvalOp. DeclHelper. UseHelper. auto.
+    econstructor; split.
+    eapply eval_helper_2; eauto. EvalOp. DeclHelper. reflexivity. reflexivity.
+    auto.
 Qed.
 
 Theorem eval_shrlu: binary_constructor_sound shrlu Val.shrlu.
@@ -671,7 +658,7 @@ Proof.
   exploit is_intconst_sound; eauto. intros EQ; subst y; clear H0.
   eapply eval_shrluimm; eauto.
 - (* General case *)
-  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto.
+  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. reflexivity. reflexivity. auto.
 Qed.
 
 Lemma eval_shrlimm:
@@ -709,7 +696,9 @@ Proof.
     erewrite <- Int64.decompose_shr_2. instantiate (1 := Int64.loword i).
     rewrite Int64.ofwords_recompose. auto. auto.
   + (* n >= 64 *)
-    econstructor; split. eapply eval_helper_2; eauto. EvalOp. DeclHelper. UseHelper. auto.
+    econstructor; split.
+    eapply eval_helper_2; eauto. EvalOp. DeclHelper. reflexivity. reflexivity.
+    auto.
 Qed.
 
 Theorem eval_shrl: binary_constructor_sound shrl Val.shrl.
@@ -720,7 +709,7 @@ Proof.
   exploit is_intconst_sound; eauto. intros EQ; subst y; clear H0.
   eapply eval_shrlimm; eauto.
 - (* General case *)
-  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto.
+  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. reflexivity. reflexivity. auto.
 Qed.
 
 Theorem eval_addl: Archi.ptr64 = false -> binary_constructor_sound addl Val.addl.
@@ -730,7 +719,7 @@ Proof.
   assert (DEFAULT:
     exists v, eval_expr ge sp e m le default v /\ Val.lessdef (Val.addl x y) v).
   {
-    econstructor; split. eapply eval_builtin_2; eauto. UseHelper. auto.
+    econstructor; split. eapply eval_builtin_2; eauto. reflexivity. reflexivity. auto.
   }
   destruct (is_longconst a) as [p|] eqn:LC1;
   destruct (is_longconst b) as [q|] eqn:LC2.
@@ -753,7 +742,7 @@ Proof.
   assert (DEFAULT:
     exists v, eval_expr ge sp e m le default v /\ Val.lessdef (Val.subl x y) v).
   {
-    econstructor; split. eapply eval_builtin_2; eauto. UseHelper. auto.
+    econstructor; split. eapply eval_builtin_2; eauto. reflexivity. reflexivity. auto.
   }
   destruct (is_longconst a) as [p|] eqn:LC1;
   destruct (is_longconst b) as [q|] eqn:LC2.
@@ -784,7 +773,7 @@ Proof.
   exploit eval_add. eexact E2. eexact E3. intros [v5 [E5 L5]].
   exploit eval_add. eexact E5. eexact E4. intros [v6 [E6 L6]].
   exists (Val.longofwords v6 (Val.loword p)); split.
-  EvalOp. eapply eval_builtin_2; eauto. UseHelper.
+  EvalOp. eapply eval_builtin_2; eauto. reflexivity. reflexivity. 
   intros. unfold le1, p in *; subst; simpl in *.
   inv L3. inv L4. inv L5. simpl in L6. inv L6.
   simpl. f_equal. symmetry. apply Int64.decompose_mul.
@@ -832,14 +821,14 @@ Theorem eval_mullhu:
   forall n, unary_constructor_sound (fun a => mullhu a n) (fun v => Val.mullhu v (Vlong n)).
 Proof.
   unfold mullhu; intros; red; intros. econstructor; split; eauto.
-  eapply eval_helper_2; eauto. apply eval_longconst. DeclHelper; eauto. UseHelper.
+  eapply eval_helper_2; eauto. apply eval_longconst. DeclHelper. reflexivity. reflexivity.
 Qed.
 
 Theorem eval_mullhs:
   forall n, unary_constructor_sound (fun a => mullhs a n) (fun v => Val.mullhs v (Vlong n)).
 Proof.
   unfold mullhs; intros; red; intros. econstructor; split; eauto.
-  eapply eval_helper_2; eauto. apply eval_longconst. DeclHelper; eauto. UseHelper.
+  eapply eval_helper_2; eauto. apply eval_longconst. DeclHelper. reflexivity. reflexivity.
 Qed.
 
 Theorem eval_shrxlimm:
@@ -881,7 +870,7 @@ Theorem eval_divlu_base:
   exists v, eval_expr ge sp e m le (divlu_base a b) v /\ Val.lessdef z v.
 Proof.
   intros; unfold divlu_base.
-  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto.
+  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. reflexivity. eassumption. auto.
 Qed.
 
 Theorem eval_modlu_base:
@@ -892,7 +881,7 @@ Theorem eval_modlu_base:
   exists v, eval_expr ge sp e m le (modlu_base a b) v /\ Val.lessdef z v.
 Proof.
   intros; unfold modlu_base.
-  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto.
+  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. reflexivity. eassumption. auto.
 Qed.
 
 Theorem eval_divls_base:
@@ -903,7 +892,7 @@ Theorem eval_divls_base:
   exists v, eval_expr ge sp e m le (divls_base a b) v /\ Val.lessdef z v.
 Proof.
   intros; unfold divls_base.
-  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto.
+  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. reflexivity. eassumption. auto.
 Qed.
 
 Theorem eval_modls_base:
@@ -914,7 +903,7 @@ Theorem eval_modls_base:
   exists v, eval_expr ge sp e m le (modls_base a b) v /\ Val.lessdef z v.
 Proof.
   intros; unfold modls_base.
-  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto.
+  econstructor; split. eapply eval_helper_2; eauto. DeclHelper. reflexivity. eassumption. auto.
 Qed.
 
 Remark decompose_cmpl_eq_zero:
diff --git a/backend/Stackingproof.v b/backend/Stackingproof.v
index ffd9b227..d8b81689 100644
--- a/backend/Stackingproof.v
+++ b/backend/Stackingproof.v
@@ -149,7 +149,7 @@ Lemma contains_get_stack:
 Proof.
   intros. unfold load_stack.
   replace (Val.offset_ptr (Vptr sp Ptrofs.zero) (Ptrofs.repr ofs)) with (Vptr sp (Ptrofs.repr ofs)).
-  eapply loadv_rule; eauto.
+  eapply loadv_rule; eauto using perm_F_any.
   simpl. rewrite Ptrofs.add_zero_l; auto.
 Qed.
 
@@ -171,7 +171,7 @@ Lemma contains_set_stack:
 Proof.
   intros. unfold store_stack.
   replace (Val.offset_ptr (Vptr sp Ptrofs.zero) (Ptrofs.repr ofs)) with (Vptr sp (Ptrofs.repr ofs)).
-  eapply storev_rule; eauto.
+  eapply storev_rule; eauto using perm_F_any.
   simpl. rewrite Ptrofs.add_zero_l; auto.
 Qed.
 
@@ -936,7 +936,7 @@ Local Opaque mreg_type.
   apply range_drop_left with (mid := pos1) in SEP; [ | omega ].
   apply range_split with (mid := pos1 + sz) in SEP; [ | omega ].
   unfold sz at 1 in SEP. rewrite <- size_type_chunk in SEP.
-  apply range_contains in SEP; auto.
+  apply range_contains in SEP; auto with mem.
   exploit (contains_set_stack (fun v' => Val.inject j (ls (R r)) v') (rs r)).
   eexact SEP.
   apply load_result_inject; auto. apply wt_ls.
@@ -1087,14 +1087,14 @@ Local Opaque b fe.
   apply (frame_env_separated b) in SEP. replace (make_env b) with fe in SEP by auto.
   (* Store of parent *)
   rewrite sep_swap3 in SEP.
-  apply (range_contains Mptr) in SEP; [|tauto].
+  apply range_contains in SEP;[|apply perm_F_any|tauto].
   exploit (contains_set_stack (fun v' => v' = parent) parent (fun _ => True) m2' Tptr).
   rewrite chunk_of_Tptr; eexact SEP. apply Val.load_result_same; auto.
   clear SEP; intros (m3' & STORE_PARENT & SEP).
   rewrite sep_swap3 in SEP.
   (* Store of return address *)
   rewrite sep_swap4 in SEP.
-  apply (range_contains Mptr) in SEP; [|tauto].
+  apply range_contains in SEP; [|apply perm_F_any|tauto].
   exploit (contains_set_stack (fun v' => v' = ra) ra (fun _ => True) m3' Tptr).
   rewrite chunk_of_Tptr; eexact SEP. apply Val.load_result_same; auto.
   clear SEP; intros (m4' & STORE_RETADDR & SEP).
diff --git a/backend/Tailcall.v b/backend/Tailcall.v
index 939abeea..b7a62d74 100644
--- a/backend/Tailcall.v
+++ b/backend/Tailcall.v
@@ -82,7 +82,7 @@ Definition transf_instr (f: function) (pc: node) (instr: instruction) :=
   | Icall sig ros args res s =>
       if is_return niter f s res
       && tailcall_is_possible sig
-      && opt_typ_eq sig.(sig_res) f.(fn_sig).(sig_res)
+      && rettype_eq sig.(sig_res) f.(fn_sig).(sig_res)
       then Itailcall sig ros args
       else instr
   | _ => instr
diff --git a/backend/Tailcallproof.v b/backend/Tailcallproof.v
index 06e314f3..9ec89553 100644
--- a/backend/Tailcallproof.v
+++ b/backend/Tailcallproof.v
@@ -157,12 +157,10 @@ Lemma transf_instr_charact:
   transf_instr_spec f instr (transf_instr f pc instr).
 Proof.
   intros. unfold transf_instr. destruct instr; try constructor.
-  caseEq (is_return niter f n r && tailcall_is_possible s &&
-          opt_typ_eq (sig_res s) (sig_res (fn_sig f))); intros.
-  destruct (andb_prop _ _ H0). destruct (andb_prop _ _ H1).
-  eapply transf_instr_tailcall; eauto.
-  eapply is_return_charact; eauto.
-  constructor.
+  destruct (is_return niter f n r && tailcall_is_possible s &&
+            rettype_eq (sig_res s) (sig_res (fn_sig f))) eqn:B.
+- InvBooleans. eapply transf_instr_tailcall; eauto. eapply is_return_charact; eauto.
+- constructor.
 Qed.
 
 Lemma transf_instr_lookup:
diff --git a/backend/Unusedglob.v b/backend/Unusedglob.v
index 916e111b..8ac7c4ce 100644
--- a/backend/Unusedglob.v
+++ b/backend/Unusedglob.v
@@ -107,7 +107,7 @@ Definition used_globals (p: program) (pm: prog_map) : option IS.t :=
 
 (** * Elimination of unreferenced global definitions *)
 
-(** We also eliminate multiple definitions of the same global name, keeping ony
+(** We also eliminate multiple definitions of the same global name, keeping only
   the last definition (in program definition order). *)
 
 Fixpoint filter_globdefs (used: IS.t) (accu defs: list (ident * globdef fundef unit)) :=
diff --git a/backend/Unusedglobproof.v b/backend/Unusedglobproof.v
index d5f871a0..680daba7 100644
--- a/backend/Unusedglobproof.v
+++ b/backend/Unusedglobproof.v
@@ -1160,10 +1160,10 @@ Local Transparent Mem.loadbytes.
   generalize (S1 NO). unfold Mem.loadbytes. destruct Mem.range_perm_dec; intros E1; inv E1.
   generalize (S2 NO). unfold Mem.loadbytes. destruct Mem.range_perm_dec; intros E2; inv E2.
   rewrite Z.add_0_r.
-  apply Mem_getN_forall2 with (p := 0) (n := nat_of_Z (init_data_list_size (gvar_init v))).
+  apply Mem_getN_forall2 with (p := 0) (n := Z.to_nat (init_data_list_size (gvar_init v))).
   rewrite H3, H4. apply bytes_of_init_inject. auto.
   omega.
-  rewrite nat_of_Z_eq by (apply init_data_list_size_pos). omega.
+  rewrite Z2Nat.id by (apply Z.ge_le; apply init_data_list_size_pos). omega.
 Qed.
 
 Lemma init_mem_inj_2:
diff --git a/backend/ValueAnalysis.v b/backend/ValueAnalysis.v
index 1f80c293..b0ce019c 100644
--- a/backend/ValueAnalysis.v
+++ b/backend/ValueAnalysis.v
@@ -13,7 +13,7 @@
 Require Import FunInd.
 Require Import Coqlib Maps Integers Floats Lattice Kildall.
 Require Import Compopts AST Linking.
-Require Import Values Memory Globalenvs Events.
+Require Import Values Memory Globalenvs Builtins Events.
 Require Import Registers Op RTL.
 Require Import ValueDomain ValueAOp Liveness.
 
@@ -78,6 +78,15 @@ Definition transfer_builtin_default
   let (av, am') := analyze_call am (map (abuiltin_arg ae am rm) args) in
   VA.State (set_builtin_res res av ae) am'.
 
+Definition eval_static_builtin_function
+              (ae: aenv) (am: amem) (rm: romem)
+              (bf: builtin_function) (args: list (builtin_arg reg)) :=
+  match builtin_function_sem bf
+                 (map val_of_aval (map (abuiltin_arg ae am rm) args)) with
+  | Some v => aval_of_val v
+  | None => None
+  end.
+
 Definition transfer_builtin
               (ae: aenv) (am: amem) (rm: romem) (ef: external_function)
               (args: list (builtin_arg reg)) (res: builtin_res reg) :=
@@ -105,6 +114,15 @@ Definition transfer_builtin
   | EF_annot_val _ _ _, v :: nil =>
       let av := abuiltin_arg ae am rm v in
       VA.State (set_builtin_res res av ae) am
+  | EF_builtin name sg, _ =>
+      match lookup_builtin_function name sg with
+      | Some bf => 
+          match eval_static_builtin_function ae am rm bf args with
+          | Some av => VA.State (set_builtin_res res av ae) am
+          | None => transfer_builtin_default ae am rm args res
+          end
+      | None => transfer_builtin_default ae am rm args res
+      end
   | _, _ =>
       transfer_builtin_default ae am rm args res
   end.
@@ -372,6 +390,31 @@ Proof.
   intros. destruct res; simpl; auto. apply ematch_update; auto.
 Qed.
 
+Lemma eval_static_builtin_function_sound:
+  forall bc ge rs sp m ae rm am (bf: builtin_function) al vl v va,
+  ematch bc rs ae ->
+  romatch bc m rm ->
+  mmatch bc m am ->
+  genv_match bc ge ->
+  bc sp = BCstack ->
+  eval_builtin_args ge (fun r => rs#r) (Vptr sp Ptrofs.zero) m al vl ->
+  eval_static_builtin_function ae am rm bf al = Some va ->
+  builtin_function_sem bf vl = Some v ->
+  vmatch bc v va.
+Proof.
+  unfold eval_static_builtin_function; intros.
+  exploit abuiltin_args_sound; eauto. 
+  set (vla := map (abuiltin_arg ae am rm) al) in *. intros VMA.
+  destruct (builtin_function_sem bf (map val_of_aval vla)) as [v0|] eqn:A; try discriminate.
+  assert (LD: Val.lessdef v0 v).
+  { apply val_inject_lessdef.
+    exploit (bs_inject _ (builtin_function_sem bf)). 
+    apply val_inject_list_lessdef. eapply list_val_of_aval_sound; eauto.
+    rewrite A, H6; simpl. auto.
+  }
+  inv LD. apply aval_of_val_sound; auto. discriminate.
+Qed.
+
 (** ** Constructing block classifications *)
 
 Definition bc_nostack (bc: block_classification) : Prop :=
@@ -996,9 +1039,8 @@ Proof.
   red; simpl; intros. destruct (plt b (Mem.nextblock m)).
   exploit RO; eauto. intros (R & P & Q).
   split; auto.
-  split. apply bmatch_incr with bc; auto. apply bmatch_inv with m; auto.
-  intros. eapply Mem.loadbytes_unchanged_on_1. eapply external_call_readonly; eauto.
-  auto. intros; red. apply Q.
+  split. apply bmatch_incr with bc; auto. apply bmatch_ext with m; auto.
+  intros. eapply external_call_readonly with (m2 := m'); eauto.
   intros; red; intros; elim (Q ofs).
   eapply external_call_max_perm with (m2 := m'); eauto.
   destruct (j' b); congruence.
@@ -1105,10 +1147,10 @@ Proof.
 - constructor.
 - assert (Plt sp bound') by eauto with va.
   eapply sound_stack_public_call; eauto. apply IHsound_stack; intros.
-  apply INV. xomega. rewrite SAME; auto. xomega. auto. auto.
+  apply INV. xomega. rewrite SAME; auto with ordered_type. xomega. auto. auto.
 - assert (Plt sp bound') by eauto with va.
   eapply sound_stack_private_call; eauto. apply IHsound_stack; intros.
-  apply INV. xomega. rewrite SAME; auto. xomega. auto. auto.
+  apply INV. xomega. rewrite SAME; auto with ordered_type. xomega. auto. auto.
   apply bmatch_ext with m; auto. intros. apply INV. xomega. auto. auto. auto.
 Qed.
 
@@ -1319,7 +1361,7 @@ Proof.
   apply sound_stack_exten with bc.
   apply sound_stack_inv with m. auto.
   intros. apply Q. red. eapply Plt_trans; eauto.
-  rewrite C; auto.
+  rewrite C; auto with ordered_type.
   exact AA.
 * (* public builtin call *)
   exploit anonymize_stack; eauto.
@@ -1338,11 +1380,18 @@ Proof.
   apply sound_stack_exten with bc.
   apply sound_stack_inv with m. auto.
   intros. apply Q. red. eapply Plt_trans; eauto.
-  rewrite C; auto.
+  rewrite C; auto with ordered_type.
   exact AA.
   }
   unfold transfer_builtin in TR.
   destruct ef; auto.
++ (* builtin function *)
+  destruct (lookup_builtin_function name sg) as [bf|] eqn:LK; auto.
+  destruct (eval_static_builtin_function ae am rm bf args) as [av|] eqn:ES; auto.
+  simpl in H1. red in H1. rewrite LK in H1. inv H1.
+  eapply sound_succ_state; eauto. simpl; auto.
+  apply set_builtin_res_sound; auto.
+  eapply eval_static_builtin_function_sound; eauto.
 + (* volatile load *)
   inv H0; auto. inv H3; auto. inv H1.
   exploit abuiltin_arg_sound; eauto. intros VM1.
diff --git a/backend/ValueDomain.v b/backend/ValueDomain.v
index e7e44e29..c132ce7c 100644
--- a/backend/ValueDomain.v
+++ b/backend/ValueDomain.v
@@ -11,9 +11,9 @@
 (* *********************************************************************)
 
 Require Import FunInd.
-Require Import Zwf Coqlib Maps Integers Floats Lattice.
+Require Import Zwf Coqlib Maps Zbits Integers Floats Lattice.
 Require Import Compopts AST.
-Require Import Values Memory Globalenvs Events.
+Require Import Values Memory Globalenvs Builtins Events.
 Require Import Registers RTL.
 
 (** The abstract domains for value analysis *)
@@ -1492,12 +1492,12 @@ Proof.
   inv H; auto with va.
 - apply vmatch_uns. red; intros. rewrite Int.bits_rol by auto.
   generalize (Int.unsigned_range n); intros.
-  rewrite Zmod_small by omega.
+  rewrite Z.mod_small by omega.
   apply H1. omega. omega.
 - destruct (zlt n0 Int.zwordsize); auto with va.
   apply vmatch_sgn. red; intros. rewrite ! Int.bits_rol by omega.
   generalize (Int.unsigned_range n); intros.
-  rewrite ! Zmod_small by omega.
+  rewrite ! Z.mod_small by omega.
   rewrite H1 by omega. symmetry. rewrite H1 by omega. auto.
 - destruct (zlt n0 Int.zwordsize); auto with va.
 Qed.
@@ -1670,7 +1670,7 @@ Proof.
   assert (UNS: forall i j, j <> Int.zero -> is_uns (usize j) (Int.modu i j)).
   {
     intros. apply is_uns_mon with (usize (Int.modu i j)); auto with va.
-    unfold usize, Int.size. apply Int.Zsize_monotone.
+    unfold usize, Int.size. apply Zsize_monotone.
     generalize (Int.unsigned_range_2 j); intros RANGE.
     assert (Int.unsigned j <> 0).
     { red; intros; elim H. rewrite <- (Int.repr_unsigned j). rewrite H0. auto. }
@@ -2093,6 +2093,7 @@ Proof.
 Qed.
 
 Definition sign_ext (nbits: Z) (v: aval) :=
+  if zle nbits 0 then Uns (provenance v) 0 else
   match v with
   | I i => I (Int.sign_ext nbits i)
   | Uns p n => if zlt n nbits then Uns p n else sgn p nbits
@@ -2101,20 +2102,39 @@ Definition sign_ext (nbits: Z) (v: aval) :=
   end.
 
 Lemma sign_ext_sound:
-  forall nbits v x, 0 < nbits -> vmatch v x -> vmatch (Val.sign_ext nbits v) (sign_ext nbits x).
+  forall nbits v x, vmatch v x -> vmatch (Val.sign_ext nbits v) (sign_ext nbits x).
 Proof.
   assert (DFL: forall p nbits i, 0 < nbits -> vmatch (Vint (Int.sign_ext nbits i)) (sgn p nbits)).
   {
     intros. apply vmatch_sgn. apply is_sign_ext_sgn; auto with va.
   }
-  intros. inv H0; simpl; auto with va.
-- destruct (zlt n nbits); eauto with va.
+  intros. unfold sign_ext. destruct (zle nbits 0).
+- destruct v; simpl; auto with va. constructor. omega. 
+  rewrite Int.sign_ext_below by auto. red; intros; apply Int.bits_zero.
+- inv H; simpl; auto with va.
++ destruct (zlt n nbits); eauto with va.
   constructor; auto. eapply is_sign_ext_uns; eauto with va.
-- destruct (zlt n nbits); auto with va.
-- apply vmatch_sgn. apply is_sign_ext_sgn; auto with va.
++ destruct (zlt n nbits); auto with va.
++ apply vmatch_sgn. apply is_sign_ext_sgn; auto with va.
   apply Z.min_case; auto with va.
 Qed.
 
+Definition zero_ext_l (s: Z) := unop_long (Int64.zero_ext s).
+
+Lemma zero_ext_l_sound:
+  forall s v x, vmatch v x -> vmatch (Val.zero_ext_l s v) (zero_ext_l s x).
+Proof.
+  intros s. exact (unop_long_sound (Int64.zero_ext s)).
+Qed.
+
+Definition sign_ext_l (s: Z) := unop_long (Int64.sign_ext s).
+
+Lemma sign_ext_l_sound:
+  forall s v x, vmatch v x -> vmatch (Val.sign_ext_l s v) (sign_ext_l s x).
+Proof.
+  intros s. exact (unop_long_sound (Int64.sign_ext s)).
+Qed.
+
 Definition longofint (v: aval) :=
   match v with
   | I i => L (Int64.repr (Int.signed i))
@@ -2824,6 +2844,64 @@ Proof.
   intros. inv H; simpl in H0; congruence.
 Qed.
 
+(** Select either returns one of its arguments, or Vundef. *)
+
+Definition add_undef (x: aval) :=
+  match x with
+  | Vbot => ntop
+  | I i =>
+      if Int.lt i Int.zero
+      then sgn Pbot (ssize i)
+      else uns Pbot (usize i)
+  | L _ | F _ | FS _ => ntop
+  | _ => x
+  end.
+
+Lemma add_undef_sound:
+  forall v x, vmatch v x -> vmatch v (add_undef x).
+Proof.
+  destruct 1; simpl; auto with va.
+  destruct (Int.lt i Int.zero).
+  apply vmatch_sgn; apply is_sgn_ssize.
+  apply vmatch_uns; apply is_uns_usize.
+Qed.
+
+Lemma add_undef_undef:
+  forall x, vmatch Vundef (add_undef x).
+Proof.
+  destruct x; simpl; auto with va.
+  destruct (Int.lt n Int.zero); auto with va.
+Qed.
+
+Lemma add_undef_normalize:
+  forall v x ty, vmatch v x -> vmatch (Val.normalize v ty) (add_undef x).
+Proof.
+  intros. destruct (Val.lessdef_normalize v ty);
+  auto using add_undef_sound, add_undef_undef.
+Qed.
+
+Definition select (ab: abool) (x y: aval) :=
+  match ab with
+  | Bnone => ntop
+  | Just b | Maybe b => add_undef (if b then x else y)
+  | Btop => add_undef (vlub x y)
+  end.
+
+Lemma select_sound:
+  forall ob v w ab x y ty,
+  cmatch ob ab -> vmatch v x -> vmatch w y ->
+  vmatch (Val.select ob v w ty) (select ab x y).
+Proof.
+  unfold Val.select, select; intros. inv H.
+- auto with va.
+- apply add_undef_normalize; destruct b; auto.
+- apply add_undef_undef.
+- apply add_undef_normalize; destruct b; auto.
+- destruct ob as [b|]. 
++ apply add_undef_normalize. destruct b; [apply vmatch_lub_l|apply vmatch_lub_r]; auto.
++ apply add_undef_undef.
+Qed.
+
 (** Normalization at load time *)
 
 Definition vnormalize (chunk: memory_chunk) (v: aval) :=
@@ -2980,7 +3058,47 @@ Proof with (auto using provenance_monotone with va).
 - destruct (zlt n 16)...
 Qed.
 
-(** Abstracting memory blocks *)
+(** Analysis of known builtin functions.  All we have is a dynamic semantics
+  as a function [list val -> option val], but we can still perform 
+  some constant propagation. *)
+
+Definition val_of_aval (a: aval) : val :=
+  match a with
+  | I n => Vint n
+  | L n => Vlong n
+  | F f => Vfloat f
+  | FS f => Vsingle f
+  | _ => Vundef
+  end.
+
+Definition aval_of_val (v: val) : option aval :=
+  match v with
+  | Vint n => Some (I n)
+  | Vlong n => Some (L n)
+  | Vfloat f => Some (F f)
+  | Vsingle f => Some (FS f)
+  | _ => None
+  end.
+
+Lemma val_of_aval_sound:
+  forall v a, vmatch v a -> Val.lessdef (val_of_aval a) v.
+Proof.
+  destruct 1; simpl; auto.
+Qed.
+
+Corollary list_val_of_aval_sound:
+  forall vl al, list_forall2 vmatch vl al -> Val.lessdef_list (map val_of_aval al) vl.
+Proof.
+  induction 1; simpl; constructor; auto using val_of_aval_sound.
+Qed.
+
+Lemma aval_of_val_sound:
+  forall v a, aval_of_val v = Some a -> vmatch v a. 
+Proof.
+  intros v a E; destruct v; simpl in E; inv E; constructor.
+Qed.
+
+(** * Abstracting memory blocks *)
 
 Inductive acontent : Type :=
  | ACval (chunk: memory_chunk) (av: aval).
@@ -3134,7 +3252,7 @@ Proof.
     omega.
     intros (bytes1 & bytes2 & LOAD1 & LOAD2 & CONCAT).
     subst bytes.
-    exploit Mem.loadbytes_length. eexact LOAD1. change (nat_of_Z 1) with 1%nat. intros LENGTH1.
+    exploit Mem.loadbytes_length. eexact LOAD1. change (Z.to_nat 1) with 1%nat. intros LENGTH1.
     rewrite in_app_iff in IN. destruct IN.
   * destruct bytes1; try discriminate. destruct bytes1; try discriminate.
     simpl in H. destruct H; try contradiction. subst m0.
@@ -3492,7 +3610,7 @@ Qed.
 Lemma ablock_storebytes_sound:
   forall m b ofs bytes m' p ab sz,
   Mem.storebytes m b ofs bytes = Some m' ->
-  length bytes = nat_of_Z sz ->
+  length bytes = Z.to_nat sz ->
   (forall b' ofs' q i, In (Fragment (Vptr b' ofs') q i) bytes -> pmatch b' ofs' p) ->
   bmatch m b ab ->
   bmatch m' b (ablock_storebytes ab p ofs sz).
@@ -3509,7 +3627,7 @@ Proof.
   exploit ablock_storebytes_contents; eauto. intros [A B].
   assert (Mem.load chunk' m b ofs' = Some v').
   { rewrite <- LOAD'; symmetry. eapply Mem.load_storebytes_other; eauto.
-    rewrite U. rewrite LENGTH. rewrite nat_of_Z_max. right; omega. }
+    rewrite U. rewrite LENGTH. rewrite Z_to_nat_max. right; omega. }
   exploit BM2; eauto. unfold ablock_load. rewrite A. rewrite COMPAT. auto.
 Qed.
 
@@ -3992,7 +4110,7 @@ Theorem storebytes_sound:
   Mem.storebytes m b (Ptrofs.unsigned ofs) bytes = Some m' ->
   mmatch m am ->
   pmatch b ofs p ->
-  length bytes = nat_of_Z sz ->
+  length bytes = Z.to_nat sz ->
   (forall b' ofs' qt i, In (Fragment (Vptr b' ofs') qt i) bytes -> pmatch b' ofs' q) ->
   mmatch m' (storebytes am p sz q).
 Proof.
@@ -4614,6 +4732,7 @@ Hint Resolve cnot_sound symbol_address_sound
        negfs_sound absfs_sound
        addfs_sound subfs_sound mulfs_sound divfs_sound
        zero_ext_sound sign_ext_sound longofint_sound longofintu_sound
+       zero_ext_l_sound sign_ext_l_sound
        singleoffloat_sound floatofsingle_sound
        intoffloat_sound intuoffloat_sound floatofint_sound floatofintu_sound
        intofsingle_sound intuofsingle_sound singleofint_sound singleofintu_sound
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml
index 206ba421..7f796fe3 100644
--- a/cfrontend/C2C.ml
+++ b/cfrontend/C2C.ml
@@ -33,6 +33,7 @@ type inline_status =
 
 type atom_info =
   { a_storage: C.storage;              (* storage class *)
+    a_size: int64 option;              (* size in bytes *)
     a_alignment: int option;           (* alignment *)
     a_sections: Sections.section_name list; (* in which section to put it *)
       (* 1 section for data, 3 sections (code/lit/jumptbl) for functions *)
@@ -61,15 +62,25 @@ let atom_alignof a =
   with Not_found ->
     None
 
+let atom_is_aligned a sz =
+  match atom_alignof a with
+  | None -> false
+  | Some align -> align mod (Z.to_int sz) = 0
+
 let atom_sections a =
   try
     (Hashtbl.find decl_atom a).a_sections
   with Not_found ->
     []
 
-let atom_is_small_data a ofs =
+let atom_is_small_data a ofs  =
   try
-    (Hashtbl.find decl_atom a).a_access = Sections.Access_near
+    let info = Hashtbl.find decl_atom a in
+    info.a_access = Sections.Access_near
+    && (match info.a_size with
+        | None -> false
+        | Some sz ->
+            let ofs = camlint64_of_ptrofs ofs in 0L <= ofs && ofs < sz)
   with Not_found ->
     false
 
@@ -109,7 +120,7 @@ let atom_location a =
 
 let comp_env : composite_env ref = ref Maps.PTree.empty
 
-(** Hooks -- overriden in machine-dependent CPragmas module *)
+(** Hooks -- overridden in machine-dependent CPragmas module *)
 
 let process_pragma_hook = ref (fun (_: string) -> false)
 
@@ -155,13 +166,15 @@ let ais_annot_functions =
     []
 
 let builtins_generic = {
-  Builtins.typedefs = [];
-  Builtins.functions =
+  builtin_typedefs = [];
+  builtin_functions =
     ais_annot_functions
       @
     [
     (* Integer arithmetic *)
-    "__builtin_bswap",
+    "__builtin_bswap64",
+    (TInt(IULongLong, []), [TInt(IULongLong, [])], false);
+      "__builtin_bswap",
     (TInt(IUInt, []), [TInt(IUInt, [])], false);
     "__builtin_bswap32",
       (TInt(IUInt, []), [TInt(IUInt, [])], false);
@@ -181,6 +194,11 @@ let builtins_generic = {
             TInt(IULong, []);
             TInt(IULong, [])],
           false);
+    (* Selection *)
+    "__builtin_sel",
+        (TVoid [],
+           [TInt(C.IBool, [])],
+           true);
     (* Annotations *)
     "__builtin_annot",
         (TVoid [],
@@ -300,9 +318,12 @@ let builtins_generic = {
 
 (* Add processor-dependent builtins *)
 
-let builtins =
-  Builtins.({ typedefs = builtins_generic.typedefs @ CBuiltins.builtins.typedefs;
-    functions = builtins_generic.Builtins.functions @ CBuiltins.builtins.functions })
+let builtins = {
+  builtin_typedefs =
+    builtins_generic.builtin_typedefs @ CBuiltins.builtins.builtin_typedefs;
+  builtin_functions =
+    builtins_generic.builtin_functions @ CBuiltins.builtins.builtin_functions
+}
 
 (** ** The known attributes *)
 
@@ -337,6 +358,7 @@ let name_for_string_literal s =
     Hashtbl.add decl_atom id
       { a_storage = C.Storage_static;
         a_alignment = Some 1;
+        a_size = Some (Int64.of_int (String.length s + 1));
         a_sections = [Sections.for_stringlit()];
         a_access = Sections.Access_default;
         a_inline = No_specifier;
@@ -364,9 +386,12 @@ let name_for_wide_string_literal s =
     incr stringNum;
     let name = Printf.sprintf "__stringlit_%d" !stringNum in
     let id = intern_string name in
+    let wchar_size = Machine.((!config).sizeof_wchar) in
     Hashtbl.add decl_atom id
       { a_storage = C.Storage_static;
-        a_alignment = Some Machine.((!config).sizeof_wchar);
+        a_alignment = Some wchar_size;
+        a_size = Some (Int64.(mul (of_int (List.length s + 1))
+                                  (of_int wchar_size)));
         a_sections = [Sections.for_stringlit()];
         a_access = Sections.Access_default;
         a_inline = No_specifier;
@@ -596,6 +621,12 @@ and convertParams env = function
     | [] -> Tnil
     | (id, ty) :: rem -> Tcons(convertTyp env ty, convertParams env rem)
 
+(* Convert types for the arguments to a function call.  The types for
+   fixed arguments are taken from the function prototype.  The types
+   for other arguments (variable-argument function or unprototyped K&R
+   functions) are taken from the types of the function arguments,
+   after default argument conversion. *)
+
 let rec convertTypArgs env tl el =
   match tl, el with
   | _, [] -> Tnil
@@ -605,6 +636,20 @@ let rec convertTypArgs env tl el =
   | (id, t1) :: tl, e1 :: el ->
       Tcons(convertTyp env t1, convertTypArgs env tl el)
 
+(* Convert types for the arguments to inline asm statements and to
+   the special built-in functions __builtin_annot, __builtin_ais_annot_
+   and __builtin_debug.  The types are taken from the types of the
+   arguments, after performing the usual unary conversions.
+   Hence char becomes int but float remains float and is not promoted
+   to double.  The goal is to preserve the representation of the arguments
+   and avoid inserting compiled code to convert the arguments. *)
+
+let rec convertTypAnnotArgs env = function
+  | [] -> Tnil
+  | e1 :: el ->
+      Tcons(convertTyp env (Cutil.unary_conversion env e1.etyp),
+            convertTypAnnotArgs env el)
+
 let convertField env f =
   if f.fld_bitfield <> None then
     unsupported "bit field in struct or union (consider adding option [-fbitfields])";
@@ -845,7 +890,7 @@ let rec convertExpr env e =
         | {edesc = C.EVar id} :: args2 -> (id.name, args2)
         | _::args2 -> error "argument 2 of '__builtin_debug' must be either a string literal or a variable"; ("", args2)
         | [] -> assert false (* catched earlier *) in
-      let targs2 = convertTypArgs env [] args2 in
+      let targs2 = convertTypAnnotArgs env args2 in
       Ebuiltin(
          AST.EF_debug(P.of_int64 kind, intern_string text,
                  typlist_of_typelist targs2),
@@ -854,7 +899,7 @@ let rec convertExpr env e =
   | C.ECall({edesc = C.EVar {name = "__builtin_annot"}}, args) ->
       begin match args with
       | {edesc = C.EConst(CStr txt)} :: args1 ->
-          let targs1 = convertTypArgs env [] args1 in
+          let targs1 = convertTypAnnotArgs env args1 in
           Ebuiltin(
              AST.EF_annot(P.of_int 1,coqstring_of_camlstring txt, typlist_of_typelist targs1),
             targs1, convertExprList env args1, convertTyp env e.etyp)
@@ -882,7 +927,7 @@ let rec convertExpr env e =
         let file,line = !currentLocation in
         let fun_name = !currentFunction in
         let loc_string = Printf.sprintf "# file:%s line:%d function:%s\n" file line fun_name in
-        let targs1 = convertTypArgs env [] args1 in
+        let targs1 = convertTypAnnotArgs env args1 in
         AisAnnot.validate_ais_annot env !currentLocation txt args1;
           Ebuiltin(
              AST.EF_annot(P.of_int 2,coqstring_of_camlstring (loc_string ^ txt), typlist_of_typelist targs1),
@@ -918,6 +963,10 @@ let rec convertExpr env e =
                Econs(va_list_ptr dst, Econs(va_list_ptr src, Enil)),
                Tvoid)
 
+  | C.ECall({edesc = C.EVar {name = "__builtin_sel"}}, [arg1; arg2; arg3]) ->
+      ewrap (Ctyping.eselection (convertExpr env arg1)
+                                (convertExpr env arg2) (convertExpr env arg3))
+
   | C.ECall({edesc = C.EVar {name = "printf"}}, args)
     when !Clflags.option_interp ->
       let targs = convertTypArgs env [] args
@@ -983,14 +1032,14 @@ let convertAsm loc env txt outputs inputs clobber =
     match output' with None -> TVoid [] | Some e -> e.etyp in
   (* Build the Ebuiltin expression *)
   let e =
-    let tinputs = convertTypArgs env [] inputs' in
+    let tinputs = convertTypAnnotArgs env inputs' in
     let toutput = convertTyp env ty_res in
     Ebuiltin( AST.EF_inline_asm(coqstring_of_camlstring txt',
                            signature_of_type tinputs toutput  AST.cc_default,
                            clobber'),
              tinputs,
              convertExprList env inputs',
-             convertTyp env ty_res) in
+             toutput) in
   (* Add an assignment to the output, if any *)
   match output' with
   | None -> e
@@ -1184,7 +1233,8 @@ let convertFundef loc env fd =
   Hashtbl.add decl_atom id'
     { a_storage = fd.fd_storage;
       a_alignment = None;
-      a_sections = Sections.for_function env id' fd.fd_attrib;
+      a_size = None;
+      a_sections = Sections.for_function env loc id' fd.fd_attrib;
       a_access = Sections.Access_default;
       a_inline = inline;
       a_loc = loc };
@@ -1213,7 +1263,7 @@ let convertFundecl env (sto, id, ty, optinit) =
     if id.name = "free" then AST.EF_free else
     if Str.string_match re_runtime id.name 0 then  AST.EF_runtime(id'', sg) else
     if Str.string_match re_builtin id.name 0
-    && List.mem_assoc id.name builtins.Builtins.functions
+    && List.mem_assoc id.name builtins.builtin_functions
     then AST.EF_builtin(id'', sg)
     else AST.EF_external(id'', sg) in
   (id',  AST.Gfun(Ctypes.External(ef, args, res, cconv)))
@@ -1261,7 +1311,7 @@ let convertGlobvar loc env (sto, id, ty, optinit) =
     | Some i ->
         convertInitializer env ty i in
   let (section, access) =
-    Sections.for_variable env id' ty (optinit <> None) in
+    Sections.for_variable env loc id' ty (optinit <> None) in
   if Z.gt sz (Z.of_uint64 0xFFFF_FFFFL) then
     error "'%s' is too big (%s bytes)"
                    id.name (Z.to_string sz);
@@ -1270,6 +1320,7 @@ let convertGlobvar loc env (sto, id, ty, optinit) =
   Hashtbl.add decl_atom id'
     { a_storage = sto;
       a_alignment = Some (Z.to_int al);
+      a_size = Some (Z.to_int64 sz);
       a_sections = [section];
       a_access = access;
       a_inline = No_specifier;
@@ -1412,7 +1463,7 @@ let convertProgram p =
   Hashtbl.clear decl_atom;
   Hashtbl.clear stringTable;
   Hashtbl.clear wstringTable;
-  let p = cleanupGlobals (Builtins.declarations() @ p) in
+  let p = cleanupGlobals (Env.initial_declarations() @ p) in
   try
     let env = translEnv Env.empty p in
     let typs = convertCompositedefs env [] p in
diff --git a/cfrontend/Cexec.v b/cfrontend/Cexec.v
index 823d2542..b08c3ad7 100644
--- a/cfrontend/Cexec.v
+++ b/cfrontend/Cexec.v
@@ -16,7 +16,7 @@ Require Import FunInd.
 Require Import Axioms Classical.
 Require Import String Coqlib Decidableplus.
 Require Import Errors Maps Integers Floats.
-Require Import AST Values Memory Events Globalenvs Determinism.
+Require Import AST Values Memory Events Globalenvs Builtins Determinism.
 Require Import Ctypes Cop Csyntax Csem.
 Require Cstrategy.
 
@@ -292,7 +292,6 @@ Remark check_assign_copy:
   { assign_copy_ok ty b ofs b' ofs' } + {~ assign_copy_ok ty b ofs b' ofs' }.
 Proof with try (right; intuition omega).
   intros. unfold assign_copy_ok.
-  assert (alignof_blockcopy ge ty > 0) by apply alignof_blockcopy_pos.
   destruct (Zdivide_dec (alignof_blockcopy ge ty) (Ptrofs.unsigned ofs')); auto...
   destruct (Zdivide_dec (alignof_blockcopy ge ty) (Ptrofs.unsigned ofs)); auto...
   assert (Y: {b' <> b \/
@@ -461,6 +460,14 @@ Definition do_ef_free
       check (zlt 0 (Ptrofs.unsigned sz));
       do m' <- Mem.free m b (Ptrofs.unsigned lo - size_chunk Mptr) (Ptrofs.unsigned lo + Ptrofs.unsigned sz);
       Some(w, E0, Vundef, m')
+  | Vint n :: nil =>
+      if Int.eq_dec n Int.zero && negb Archi.ptr64
+      then Some(w, E0, Vundef, m)
+      else None
+  | Vlong n :: nil =>
+      if Int64.eq_dec n Int64.zero && Archi.ptr64
+      then Some(w, E0, Vundef, m)
+      else None
   | _ => None
   end.
 
@@ -502,12 +509,19 @@ Definition do_ef_debug (kind: positive) (text: ident) (targs: list typ)
        (w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
   Some(w, E0, Vundef, m).
 
+Definition do_builtin_or_external (name: string) (sg: signature)
+       (w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
+  match lookup_builtin_function name sg with
+  | Some bf => match builtin_function_sem bf vargs with Some v => Some(w, E0, v, m) | None => None end
+  | None    => do_external_function name sg ge w vargs m
+  end.
+
 Definition do_external (ef: external_function):
        world -> list val -> mem -> option (world * trace * val * mem) :=
   match ef with
   | EF_external name sg => do_external_function name sg ge
-  | EF_builtin name sg => do_external_function name sg ge
-  | EF_runtime name sg => do_external_function name sg ge
+  | EF_builtin name sg => do_builtin_or_external name sg
+  | EF_runtime name sg => do_builtin_or_external name sg
   | EF_vload chunk => do_ef_volatile_load chunk
   | EF_vstore chunk => do_ef_volatile_store chunk
   | EF_malloc => do_ef_malloc
@@ -524,50 +538,65 @@ Lemma do_ef_external_sound:
   do_external ef w vargs m = Some(w', t, vres, m') ->
   external_call ef ge vargs m t vres m' /\ possible_trace w t w'.
 Proof with try congruence.
+  intros until m'.
   assert (SIZE: forall v sz, do_alloc_size v = Some sz -> v = Vptrofs sz).
   { intros until sz; unfold Vptrofs; destruct v; simpl; destruct Archi.ptr64 eqn:SF; 
     intros EQ; inv EQ; f_equal; symmetry; eauto with ptrofs. }
-  intros until m'.
+  assert (BF_EX: forall name sg,
+    do_builtin_or_external name sg w vargs m = Some (w', t, vres, m') ->
+    builtin_or_external_sem name sg ge vargs m t vres m' /\ possible_trace w t w').
+  { unfold do_builtin_or_external, builtin_or_external_sem; intros. 
+    destruct (lookup_builtin_function name sg ) as [bf|].
+  - destruct (builtin_function_sem bf vargs) as [vres1|] eqn:BF; inv H.
+    split. constructor; auto. constructor.
+  - eapply do_external_function_sound; eauto.
+  }
   destruct ef; simpl.
-(* EF_external *)
-  eapply do_external_function_sound; eauto.
-(* EF_builtin *)
+- (* EF_external *)
   eapply do_external_function_sound; eauto.
-(* EF_runtime *)
-  eapply do_external_function_sound; eauto.
-(* EF_vload *)
+- (* EF_builtin *)
+  eapply BF_EX; eauto.
+- (* EF_runtime *)
+  eapply BF_EX; eauto.
+- (* EF_vload *)
   unfold do_ef_volatile_load. destruct vargs... destruct v... destruct vargs...
   mydestr. destruct p as [[w'' t''] v]; mydestr.
   exploit do_volatile_load_sound; eauto. intuition. econstructor; eauto.
-  auto.
-(* EF_vstore *)
+- (* EF_vstore *)
   unfold do_ef_volatile_store. destruct vargs... destruct v... destruct vargs... destruct vargs...
   mydestr. destruct p as [[w'' t''] m'']. mydestr.
   exploit do_volatile_store_sound; eauto. intuition. econstructor; eauto.
-  auto.
-(* EF_malloc *)
+- (* EF_malloc *)
   unfold do_ef_malloc. destruct vargs... destruct vargs... mydestr.
   destruct (Mem.alloc m (- size_chunk Mptr) (Ptrofs.unsigned i)) as [m1 b] eqn:?. mydestr.
   split. apply SIZE in Heqo. subst v. econstructor; eauto. constructor.
-(* EF_free *)
-  unfold do_ef_free. destruct vargs... destruct v... destruct vargs...
-  mydestr. split. apply SIZE in Heqo0. econstructor; eauto. congruence. omega. constructor.
-(* EF_memcpy *)
+- (* EF_free *)
+  unfold do_ef_free. destruct vargs... destruct v... 
++ destruct vargs... mydestr; InvBooleans; subst i.
+  replace (Vint Int.zero) with Vnullptr. split; constructor.
+  apply negb_true_iff in H0. unfold Vnullptr; rewrite H0; auto.
++ destruct vargs... mydestr; InvBooleans; subst i.
+  replace (Vlong Int64.zero) with Vnullptr. split; constructor.
+  unfold Vnullptr; rewrite H0; auto.
++ destruct vargs... mydestr.
+  split. apply SIZE in Heqo0. econstructor; eauto. congruence. omega.
+  constructor.
+- (* EF_memcpy *)
   unfold do_ef_memcpy. destruct vargs... destruct v... destruct vargs...
   destruct v... destruct vargs... mydestr. 
   apply Decidable_sound in Heqb1. red in Heqb1.
   split. econstructor; eauto; tauto. constructor.
-(* EF_annot *)
+- (* EF_annot *)
   unfold do_ef_annot. mydestr.
   split. constructor. apply list_eventval_of_val_sound; auto.
   econstructor. constructor; eauto. constructor.
-(* EF_annot_val *)
+- (* EF_annot_val *)
   unfold do_ef_annot_val. destruct vargs... destruct vargs... mydestr.
   split. constructor. apply eventval_of_val_sound; auto.
   econstructor. constructor; eauto. constructor.
-(* EF_inline_asm *)
+- (* EF_inline_asm *)
   eapply do_inline_assembly_sound; eauto.
-(* EF_debug *)
+- (* EF_debug *)
   unfold do_ef_debug. mydestr. split; constructor.
 Qed.
 
@@ -576,42 +605,52 @@ Lemma do_ef_external_complete:
   external_call ef ge vargs m t vres m' -> possible_trace w t w' ->
   do_external ef w vargs m = Some(w', t, vres, m').
 Proof.
+  intros.
   assert (SIZE: forall n, do_alloc_size (Vptrofs n) = Some n).
   { unfold Vptrofs, do_alloc_size; intros; destruct Archi.ptr64 eqn:SF. 
     rewrite Ptrofs.of_int64_to_int64; auto.
     rewrite Ptrofs.of_int_to_int; auto. }
-  intros. destruct ef; simpl in *.
-(* EF_external *)
-  eapply do_external_function_complete; eauto.
-(* EF_builtin *)
-  eapply do_external_function_complete; eauto.
-(* EF_runtime *)
+  assert (BF_EX: forall name sg,
+    builtin_or_external_sem name sg ge vargs m t vres m' ->
+    do_builtin_or_external name sg w vargs m = Some (w', t, vres, m')).
+  { unfold do_builtin_or_external, builtin_or_external_sem; intros.
+    destruct (lookup_builtin_function name sg) as [bf|].
+  - inv H1. inv H0. rewrite H2. auto.
+  - eapply do_external_function_complete; eauto.
+  }
+  destruct ef; simpl in *.
+- (* EF_external *)
   eapply do_external_function_complete; eauto.
-(* EF_vload *)
+- (* EF_builtin *)
+  eapply BF_EX; eauto.
+- (* EF_runtime *)
+  eapply BF_EX; eauto.
+- (* EF_vload *)
   inv H; unfold do_ef_volatile_load.
   exploit do_volatile_load_complete; eauto. intros EQ; rewrite EQ; auto.
-(* EF_vstore *)
+- (* EF_vstore *)
   inv H; unfold do_ef_volatile_store.
   exploit do_volatile_store_complete; eauto. intros EQ; rewrite EQ; auto.
-(* EF_malloc *)
+- (* EF_malloc *)
   inv H; unfold do_ef_malloc.
   inv H0. erewrite SIZE by eauto. rewrite H1, H2. auto.
-(* EF_free *)
+- (* EF_free *)
   inv H; unfold do_ef_free.
-  inv H0. rewrite H1. erewrite SIZE by eauto. rewrite zlt_true. rewrite H3. auto. omega.
-(* EF_memcpy *)
++ inv H0. rewrite H1. erewrite SIZE by eauto. rewrite zlt_true. rewrite H3. auto. omega.
++ inv H0. unfold Vnullptr; destruct Archi.ptr64; auto.
+- (* EF_memcpy *)
   inv H; unfold do_ef_memcpy.
   inv H0. rewrite Decidable_complete. rewrite H7; rewrite H8; auto.
   red. tauto.
-(* EF_annot *)
+- (* EF_annot *)
   inv H; unfold do_ef_annot. inv H0. inv H6. inv H4.
   rewrite (list_eventval_of_val_complete _ _ _ H1). auto.
-(* EF_annot_val *)
+- (* EF_annot_val *)
   inv H; unfold do_ef_annot_val. inv H0. inv H6. inv H4.
   rewrite (eventval_of_val_complete _ _ _ H1). auto.
-(* EF_inline_asm *)
+- (* EF_inline_asm *)
   eapply do_inline_assembly_complete; eauto.
-(* EF_debug *)
+- (* EF_debug *)
   inv H. inv H0. reflexivity.
 Qed.
 
@@ -1100,8 +1139,8 @@ Proof.
   induction 1; intros; constructor; eauto.
 Qed.
 
-Hint Constructors context contextlist.
-Hint Resolve context_compose contextlist_compose.
+Local Hint Constructors context contextlist : core.
+Local Hint Resolve context_compose contextlist_compose : core.
 
 Definition reduction_ok (k: kind) (a: expr) (m: mem) (rd: reduction) : Prop :=
   match k, rd with
@@ -1667,8 +1706,9 @@ Proof.
   change (In (f (C0, rd)) (map f res2)). apply in_map; auto.
 Qed.
 
-Hint Resolve reducts_incl_val reducts_incl_loc reducts_incl_listval
-             reducts_incl_incontext reducts_incl_incontext2_left reducts_incl_incontext2_right.
+Local Hint Resolve reducts_incl_val reducts_incl_loc reducts_incl_listval
+                   reducts_incl_incontext reducts_incl_incontext2_left
+                   reducts_incl_incontext2_right : core.
 
 Lemma step_expr_context:
   forall from to C, context from to C ->
@@ -2053,7 +2093,7 @@ Ltac myinv :=
   | _ => idtac
   end.
 
-Hint Extern 3 => exact I.
+Local Hint Extern 3 => exact I : core.
 
 Theorem do_step_sound:
   forall w S rule t S',
diff --git a/cfrontend/Clight.v b/cfrontend/Clight.v
index 7a4c49a2..8ab29fe9 100644
--- a/cfrontend/Clight.v
+++ b/cfrontend/Clight.v
@@ -84,7 +84,7 @@ Definition typeof (e: expr) : type :=
 (** ** Statements *)
 
 (** Clight statements are similar to those of Compcert C, with the addition
-  of assigment (of a rvalue to a lvalue), assignment to a temporary,
+  of assignment (of a rvalue to a lvalue), assignment to a temporary,
   and function call (with assignment of the result to a temporary).
   The three C loops are replaced by a single infinite loop [Sloop s1
   s2] that executes [s1] then [s2] repeatedly.  A [continue] in [s1]
diff --git a/cfrontend/ClightBigstep.v b/cfrontend/ClightBigstep.v
index 92457586..2bccf60a 100644
--- a/cfrontend/ClightBigstep.v
+++ b/cfrontend/ClightBigstep.v
@@ -74,6 +74,8 @@ Definition outcome_result_value (out: outcome) (t: type) (v: val) (m: mem): Prop
   [t] is the trace of input/output events performed during this
   evaluation. *)
 
+Variable function_entry: function -> list val -> mem -> env -> temp_env -> mem -> Prop.
+
 Inductive exec_stmt: env -> temp_env -> mem -> statement -> trace -> temp_env -> mem -> outcome -> Prop :=
   | exec_Sskip:   forall e le m,
       exec_stmt e le m Sskip
@@ -163,14 +165,12 @@ Inductive exec_stmt: env -> temp_env -> mem -> statement -> trace -> temp_env ->
   by the call.  *)
 
 with eval_funcall: mem -> fundef -> list val -> trace -> mem -> val -> Prop :=
-  | eval_funcall_internal: forall le m f vargs t e m1 m2 m3 out vres m4,
-      alloc_variables ge empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
-      list_norepet (var_names f.(fn_params) ++ var_names f.(fn_vars)) ->
-      bind_parameters ge e m1 f.(fn_params) vargs m2 ->
-      exec_stmt e (create_undef_temps f.(fn_temps)) m2 f.(fn_body) t le m3 out ->
-      outcome_result_value out f.(fn_return) vres m3 ->
-      Mem.free_list m3 (blocks_of_env ge e) = Some m4 ->
-      eval_funcall m (Internal f) vargs t m4 vres
+  | eval_funcall_internal: forall m f vargs t e le1 le2 m1 m2 out vres m3,
+      function_entry f vargs m e le1 m1 ->
+      exec_stmt e le1 m1 f.(fn_body) t le2 m2 out ->
+      outcome_result_value out f.(fn_return) vres m2 ->
+      Mem.free_list m2 (blocks_of_env ge e) = Some m3 ->
+      eval_funcall m (Internal f) vargs t m3 vres
   | eval_funcall_external: forall m ef targs tres cconv vargs t vres m',
       external_call ef ge vargs m t vres m' ->
       eval_funcall m (External ef targs tres cconv) vargs t m' vres.
@@ -231,17 +231,19 @@ CoInductive execinf_stmt: env -> temp_env -> mem -> statement -> traceinf -> Pro
     [fd] on arguments [args] diverges, with observable trace [t]. *)
 
 with evalinf_funcall: mem -> fundef -> list val -> traceinf -> Prop :=
-  | evalinf_funcall_internal: forall m f vargs t e m1 m2,
-      alloc_variables ge empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
-      list_norepet (var_names f.(fn_params) ++ var_names f.(fn_vars)) ->
-      bind_parameters ge e m1 f.(fn_params) vargs m2 ->
-      execinf_stmt e (create_undef_temps f.(fn_temps)) m2 f.(fn_body) t ->
+  | evalinf_funcall_internal: forall m f vargs t e m1 le1,
+      function_entry f vargs m e le1 m1 ->
+      execinf_stmt e le1 m1 f.(fn_body) t ->
       evalinf_funcall m (Internal f) vargs t.
 
 End BIGSTEP.
 
 (** Big-step execution of a whole program.  *)
 
+Section ENTRY.
+
+Variable function_entry: genv -> function -> list val -> mem -> env -> temp_env -> mem -> Prop.
+
 Inductive bigstep_program_terminates (p: program): trace -> int -> Prop :=
   | bigstep_program_terminates_intro: forall b f m0 m1 t r,
       let ge := globalenv p in
@@ -249,7 +251,7 @@ Inductive bigstep_program_terminates (p: program): trace -> int -> Prop :=
       Genv.find_symbol ge p.(prog_main) = Some b ->
       Genv.find_funct_ptr ge b = Some f ->
       type_of_fundef f = Tfunction Tnil type_int32s cc_default ->
-      eval_funcall ge m0 f nil t m1 (Vint r) ->
+      eval_funcall ge (function_entry ge) m0 f nil t m1 (Vint r) ->
       bigstep_program_terminates p t r.
 
 Inductive bigstep_program_diverges (p: program): traceinf -> Prop :=
@@ -259,12 +261,14 @@ Inductive bigstep_program_diverges (p: program): traceinf -> Prop :=
       Genv.find_symbol ge p.(prog_main) = Some b ->
       Genv.find_funct_ptr ge b = Some f ->
       type_of_fundef f = Tfunction Tnil type_int32s cc_default ->
-      evalinf_funcall ge m0 f nil t ->
+      evalinf_funcall ge (function_entry ge) m0 f nil t ->
       bigstep_program_diverges p t.
 
 Definition bigstep_semantics (p: program) :=
   Bigstep_semantics (bigstep_program_terminates p) (bigstep_program_diverges p).
 
+End ENTRY.
+
 (** * Implication from big-step semantics to transition semantics *)
 
 Section BIGSTEP_TO_TRANSITIONS.
@@ -296,18 +300,31 @@ Proof.
   destruct k; simpl; intros; contradiction || auto.
 Qed.
 
+Variable function_entry: genv -> function -> list val -> mem -> env -> temp_env -> mem -> Prop.
+
+Definition exec_stmt_fe (ge: genv) := exec_stmt ge (function_entry ge).
+Definition eval_funcall_fe (ge: genv) := eval_funcall ge (function_entry ge).
+Definition execinf_stmt_fe (ge: genv) := execinf_stmt ge (function_entry ge).
+Definition evalinf_funcall_fe (ge: genv) := evalinf_funcall ge (function_entry ge).
+Definition bigstep_semantics_fe := bigstep_semantics function_entry.
+
+Definition step_fe (ge: genv) := step ge (function_entry ge).
+Definition semantics_fe (p: program) :=
+  let ge := globalenv p in
+  Semantics_gen step_fe (initial_state p) final_state ge ge.
+
 Lemma exec_stmt_eval_funcall_steps:
   (forall e le m s t le' m' out,
-   exec_stmt ge e le m s t le' m' out ->
+   exec_stmt_fe ge e le m s t le' m' out ->
    forall f k, exists S,
-   star step1 ge (State f s k e le m) t S
+   star step_fe ge (State f s k e le m) t S
    /\ outcome_state_match e le' m' f k out S)
 /\
   (forall m fd args t m' res,
-   eval_funcall ge m fd args t m' res ->
+   eval_funcall_fe ge m fd args t m' res ->
    forall k,
    is_call_cont k ->
-   star step1 ge (Callstate fd args k m) t (Returnstate res k m')).
+   star step_fe ge (Callstate fd args k m) t (Returnstate res k m')).
 Proof.
   apply exec_stmt_funcall_ind; intros.
 
@@ -450,23 +467,23 @@ Proof.
   unfold S2. inv B1; simpl; econstructor; eauto.
 
 (* call internal *)
-  destruct (H3 f k) as [S1 [A1 B1]].
-  eapply star_left. eapply step_internal_function; eauto. econstructor; eauto.
+  destruct (H1 f k) as [S1 [A1 B1]].
+  eapply star_left. eapply step_internal_function; eauto.
   eapply star_right. eexact A1.
    inv B1; simpl in H4; try contradiction.
   (* Out_normal *)
   assert (fn_return f = Tvoid /\ vres = Vundef).
     destruct (fn_return f); auto || contradiction.
-  destruct H7. subst vres. apply step_skip_call; auto.
+  destruct H5. subst vres. apply step_skip_call; auto.
   (* Out_return None *)
   assert (fn_return f = Tvoid /\ vres = Vundef).
     destruct (fn_return f); auto || contradiction.
-  destruct H8. subst vres.
-  rewrite <- (is_call_cont_call_cont k H6). rewrite <- H7.
+  destruct H6. subst vres.
+  rewrite <- (is_call_cont_call_cont k H4). rewrite <- H5.
   apply step_return_0; auto.
   (* Out_return Some *)
-  destruct H4.
-  rewrite <- (is_call_cont_call_cont k H6). rewrite <- H7.
+  destruct H2.
+  rewrite <- (is_call_cont_call_cont k H4). rewrite <- H5.
   eapply step_return_1; eauto.
   reflexivity. traceEq.
 
@@ -476,31 +493,31 @@ Qed.
 
 Lemma exec_stmt_steps:
    forall e le m s t le' m' out,
-   exec_stmt ge e le m s t le' m' out ->
+   exec_stmt_fe ge e le m s t le' m' out ->
    forall f k, exists S,
-   star step1 ge (State f s k e le m) t S
+   star step_fe ge (State f s k e le m) t S
    /\ outcome_state_match e le' m' f k out S.
 Proof (proj1 exec_stmt_eval_funcall_steps).
 
 Lemma eval_funcall_steps:
    forall m fd args t m' res,
-   eval_funcall ge m fd args t m' res ->
+   eval_funcall_fe ge m fd args t m' res ->
    forall k,
    is_call_cont k ->
-   star step1 ge (Callstate fd args k m) t (Returnstate res k m').
+   star step_fe ge (Callstate fd args k m) t (Returnstate res k m').
 Proof (proj2 exec_stmt_eval_funcall_steps).
 
 Definition order (x y: unit) := False.
 
 Lemma evalinf_funcall_forever:
   forall m fd args T k,
-  evalinf_funcall ge m fd args T ->
-  forever_N step1 order ge tt (Callstate fd args k m) T.
+  evalinf_funcall_fe ge m fd args T ->
+  forever_N step_fe order ge tt (Callstate fd args k m) T.
 Proof.
   cofix CIH_FUN.
   assert (forall e le m s T f k,
-          execinf_stmt ge e le m s T ->
-          forever_N step1 order ge tt (State f s k e le m) T).
+          execinf_stmt_fe ge e le m s T ->
+          forever_N step_fe order ge tt (State f s k e le m) T).
   cofix CIH_STMT.
   intros. inv H.
 
@@ -559,13 +576,13 @@ Proof.
 (* call internal *)
   intros. inv H0.
   eapply forever_N_plus.
-  eapply plus_one. econstructor; eauto. econstructor; eauto.
+  eapply plus_one. econstructor; eauto.
   apply H; eauto.
   traceEq.
 Qed.
 
 Theorem bigstep_semantics_sound:
-  bigstep_sound (bigstep_semantics prog) (semantics1 prog).
+  bigstep_sound (bigstep_semantics_fe prog) (semantics_fe prog).
 Proof.
   constructor; simpl; intros.
 (* termination *)
diff --git a/cfrontend/Cminorgenproof.v b/cfrontend/Cminorgenproof.v
index ffafc5d2..5acb996d 100644
--- a/cfrontend/Cminorgenproof.v
+++ b/cfrontend/Cminorgenproof.v
@@ -923,7 +923,7 @@ Remark inj_offset_aligned_block:
   Mem.inj_offset_aligned (align stacksize (block_alignment sz)) sz.
 Proof.
   intros; red; intros.
-  apply Zdivides_trans with (block_alignment sz).
+  apply Z.divide_trans with (block_alignment sz).
   unfold align_chunk.  unfold block_alignment.
   generalize Z.divide_1_l; intro.
   generalize Z.divide_refl; intro.
diff --git a/cfrontend/Cop.v b/cfrontend/Cop.v
index c395a2cb..143e87a3 100644
--- a/cfrontend/Cop.v
+++ b/cfrontend/Cop.v
@@ -140,8 +140,8 @@ Definition classify_cast (tfrom tto: type) : classify_cast_cases :=
   | Tfloat F64 _, Tfloat F32 _ => cast_case_s2f
   | Tfloat F32 _, Tfloat F64 _ => cast_case_f2s
   (* To pointer types *)
-  | Tpointer _ _, Tint _ _ _ =>
-      if Archi.ptr64 then cast_case_i2l Unsigned else cast_case_pointer
+  | Tpointer _ _, Tint _ si _ =>
+      if Archi.ptr64 then cast_case_i2l si else cast_case_pointer
   | Tpointer _ _, Tlong _ _ =>
       if Archi.ptr64 then cast_case_pointer else cast_case_l2i I32 Unsigned
   | Tpointer _ _, (Tpointer _ _ | Tarray _ _ _ | Tfunction _ _ _) => cast_case_pointer
@@ -1131,7 +1131,7 @@ Qed.
 Remark val_inject_vptrofs: forall n, Val.inject f (Vptrofs n) (Vptrofs n).
 Proof. intros. unfold Vptrofs. destruct Archi.ptr64; auto. Qed.
 
-Hint Resolve val_inject_vtrue val_inject_vfalse val_inject_of_bool val_inject_vptrofs.
+Local Hint Resolve val_inject_vtrue val_inject_vfalse val_inject_of_bool val_inject_vptrofs : core.
 
 Ltac TrivialInject :=
   match goal with
@@ -1517,7 +1517,7 @@ Inductive val_casted: val -> type -> Prop :=
   | val_casted_void: forall v,
       val_casted v Tvoid.
 
-Hint Constructors val_casted.
+Local Hint Constructors val_casted : core.
 
 Remark cast_int_int_idem:
   forall sz sg i, cast_int_int sz sg (cast_int_int sz sg i) = cast_int_int sz sg i.
@@ -1580,6 +1580,27 @@ Proof.
   intros. apply cast_val_casted. eapply cast_val_is_casted; eauto.
 Qed.
 
+(** Moreover, casted values belong to the machine type corresponding to the
+    C type. *)
+
+Lemma val_casted_has_type:
+  forall v ty, val_casted v ty -> ty <> Tvoid -> Val.has_type v (typ_of_type ty).
+Proof.
+  intros. inv H; simpl typ_of_type.
+- exact I.
+- exact I.
+- exact I.
+- exact I.
+- apply Val.Vptr_has_type.
+- red; unfold Tptr; rewrite H1; auto.
+- red; unfold Tptr; rewrite H1; auto.
+- red; unfold Tptr; rewrite H1; auto.
+- red; unfold Tptr; rewrite H1; auto.
+- apply Val.Vptr_has_type.
+- apply Val.Vptr_has_type.
+- congruence.
+Qed.
+
 (** Relation with the arithmetic conversions of ISO C99, section 6.3.1 *)
 
 Module ArithConv.
diff --git a/cfrontend/Csem.v b/cfrontend/Csem.v
index 0c3e00de..6d2b470f 100644
--- a/cfrontend/Csem.v
+++ b/cfrontend/Csem.v
@@ -15,19 +15,9 @@
 
 (** Dynamic semantics for the Compcert C language *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import AST.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Ctypes.
-Require Import Cop.
-Require Import Csyntax.
+Require Import Coqlib Errors Maps.
+Require Import Integers Floats Values AST Memory Builtins Events Globalenvs.
+Require Import Ctypes Cop Csyntax.
 Require Import Smallstep.
 
 (** * Operational semantics *)
@@ -437,6 +427,59 @@ Definition not_stuck (e: expr) (m: mem) : Prop :=
   forall k C e' ,
   context k RV C -> e = C e' -> imm_safe k e' m.
 
+(** ** Derived forms. *)
+
+(** The following are admissible reduction rules for some derived forms
+  of the CompCert C language.  They help showing that the derived forms
+  make sense. *)
+
+Lemma red_selection:
+  forall v1 ty1 v2 ty2 v3 ty3 ty m b v2' v3',
+  ty <> Tvoid ->
+  bool_val v1 ty1 m = Some b ->
+  sem_cast v2 ty2 ty m = Some v2' ->
+  sem_cast v3 ty3 ty m = Some v3' ->
+  rred (Eselection (Eval v1 ty1) (Eval v2 ty2) (Eval v3 ty3) ty) m
+    E0 (Eval (if b then v2' else v3') ty) m.
+Proof.
+  intros. unfold Eselection.
+  set (t := typ_of_type ty).
+  set (sg := mksignature (AST.Tint :: t :: t :: nil) t cc_default).
+  assert (LK: lookup_builtin_function "__builtin_sel"%string sg = Some (BI_standard (BI_select t))).
+  { unfold sg, t; destruct ty as   [ | ? ? ? | ? | [] ? | ? ? | ? ? ? | ? ? ? | ? ? | ? ? ];
+    simpl; unfold Tptr; destruct Archi.ptr64; reflexivity. }
+  set (v' := if b then v2' else v3').
+  assert (C: val_casted v' ty).
+  { unfold v'; destruct b; eapply cast_val_is_casted; eauto. }
+  assert (EQ: Val.normalize v' t = v').
+  { apply Val.normalize_idem. apply val_casted_has_type; auto. }
+  econstructor.
+- constructor. rewrite cast_bool_bool_val, H0. eauto.
+  constructor. eauto.
+  constructor. eauto.
+  constructor.
+- red. red. rewrite LK. constructor. simpl. rewrite <- EQ.
+  destruct b; auto.
+Qed.
+
+Lemma ctx_selection_1:
+  forall k C r2 r3 ty, context k RV C -> context k RV (fun x => Eselection (C x) r2 r3 ty).
+Proof.
+  intros. apply ctx_builtin. constructor; auto.
+Qed.
+
+Lemma ctx_selection_2:
+  forall k r1 C r3 ty, context k RV C -> context k RV (fun x => Eselection r1 (C x) r3 ty).
+Proof.
+  intros. apply ctx_builtin. constructor; constructor; auto.
+Qed.
+
+Lemma ctx_selection_3:
+  forall k r1 r2 C ty, context k RV C -> context k RV (fun x => Eselection r1 r2 (C x) ty).
+Proof.
+  intros. apply ctx_builtin. constructor; constructor; constructor; auto.
+Qed.
+
 End EXPR.
 
 (** ** Transition semantics. *)
diff --git a/cfrontend/Cshmgen.v b/cfrontend/Cshmgen.v
index 792a73f9..5bd12d00 100644
--- a/cfrontend/Cshmgen.v
+++ b/cfrontend/Cshmgen.v
@@ -23,6 +23,7 @@
 Require Import Coqlib Maps Errors Integers Floats.
 Require Import AST Linking.
 Require Import Ctypes Cop Clight Cminor Csharpminor.
+Require Import Conventions1.
 
 Local Open Scope string_scope.
 Local Open Scope error_monad_scope.
@@ -558,6 +559,34 @@ Fixpoint typlist_of_arglist (al: list Clight.expr) (tyl: typelist)
       typ_of_type (default_argument_conversion (typeof a1)) :: typlist_of_arglist a2 Tnil
   end.
 
+(** Translate a function call.
+    Depending on the ABI, it may be necessary to normalize the value
+    returned by casting it to the return type of the function.
+    For example, in the x86 ABI, a return value of type "char" is
+    returned in register AL, leaving the top 24 bits of EAX
+    unspecified.  Hence, a cast to type "char" is needed to sign- or
+    zero-extend the returned integer before using it. *)
+
+Definition make_normalization (t: type) (a: expr) :=
+  match t with
+  | Tint IBool _ _ => Eunop Ocast8unsigned a
+  | Tint I8 Signed _ => Eunop Ocast8signed a
+  | Tint I8 Unsigned _ => Eunop Ocast8unsigned a
+  | Tint I16 Signed _ => Eunop Ocast16signed a
+  | Tint I16 Unsigned _ => Eunop Ocast16unsigned a
+  | _ => a
+  end.
+
+Definition make_funcall (x: option ident) (tres: type) (sg: signature)
+                      (fn: expr) (args: list expr): stmt :=
+  match x, return_value_needs_normalization sg.(sig_res) with
+  | Some id, true =>
+      Sseq (Scall x sg fn args)
+           (Sset id (make_normalization tres (Evar id)))
+  | _, _ =>
+      Scall x sg fn args
+  end.
+
 (** * Translation of statements *)
 
 (** [transl_statement nbrk ncnt s] returns a Csharpminor statement
@@ -601,10 +630,10 @@ Fixpoint transl_statement (ce: composite_env) (tyret: type) (nbrk ncnt: nat)
       | fun_case_f args res cconv =>
           do tb <- transl_expr ce b;
           do tcl <- transl_arglist ce cl args;
-          OK(Scall x {| sig_args := typlist_of_arglist cl args;
-                        sig_res  := opttyp_of_type res;
-                        sig_cc   := cconv |}
-                   tb tcl)
+          let sg := {| sig_args := typlist_of_arglist cl args;
+                       sig_res  := rettype_of_type res;
+                       sig_cc   := cconv |} in
+          OK (make_funcall x res sg tb tcl)
       | _ => Error(msg "Cshmgen.transl_stmt(call)")
       end
   | Clight.Sbuiltin x ef tyargs bl =>
@@ -667,7 +696,7 @@ Definition transl_var (ce: composite_env) (v: ident * type) :=
 
 Definition signature_of_function (f: Clight.function) :=
   {| sig_args := map typ_of_type (map snd (Clight.fn_params f));
-     sig_res  := opttyp_of_type (Clight.fn_return f);
+     sig_res  := rettype_of_type (Clight.fn_return f);
      sig_cc   := Clight.fn_callconv f |}.
 
 Definition transl_function (ce: composite_env) (f: Clight.function) : res function :=
diff --git a/cfrontend/Cshmgenproof.v b/cfrontend/Cshmgenproof.v
index 09e31cb2..1ceb8e4d 100644
--- a/cfrontend/Cshmgenproof.v
+++ b/cfrontend/Cshmgenproof.v
@@ -15,7 +15,7 @@
 Require Import Coqlib Errors Maps Integers Floats.
 Require Import AST Linking.
 Require Import Values Events Memory Globalenvs Smallstep.
-Require Import Ctypes Cop Clight Cminor Csharpminor.
+Require Import Ctypes Ctyping Cop Clight Cminor Csharpminor.
 Require Import Cshmgen.
 
 (** * Relational specification of the transformation *)
@@ -996,6 +996,26 @@ Proof.
   eapply make_memcpy_correct with (b := b) (v := Vptr b' ofs'); eauto.
 Qed.
 
+Lemma make_normalization_correct:
+  forall e le m a v t,
+  eval_expr ge e le m a v ->
+  wt_val v t ->
+  eval_expr ge e le m (make_normalization t a) v.
+Proof.
+  intros. destruct t; simpl; auto. inv H0.
+- destruct i; simpl in H3.
+  + destruct s; econstructor; eauto; simpl; congruence.
+  + destruct s; econstructor; eauto; simpl; congruence.
+  + auto.
+  + econstructor; eauto; simpl; congruence.
+- auto.
+- destruct i.
+  + destruct s; econstructor; eauto. 
+  + destruct s; econstructor; eauto.
+  + auto.
+  + econstructor; eauto.
+Qed.
+
 End CONSTRUCTORS.
 
 (** * Basic preservation invariants *)
@@ -1360,7 +1380,16 @@ Inductive match_cont: composite_env -> type -> nat -> nat -> Clight.cont -> Csha
       match_cont cu.(prog_comp_env) (Clight.fn_return f) nbrk' ncnt' k tk ->
       match_cont ce tyret nbrk ncnt
                  (Clight.Kcall id f e le k)
-                 (Kcall id tf te le tk).
+                 (Kcall id tf te le tk)
+  | match_Kcall_normalize: forall ce tyret nbrk ncnt nbrk' ncnt' f e k id a tf te le tk cu,
+      linkorder cu prog ->
+      transl_function cu.(prog_comp_env) f = OK tf ->
+      match_env e te ->
+      match_cont cu.(prog_comp_env) (Clight.fn_return f) nbrk' ncnt' k tk ->
+      (forall v e le m, wt_val v tyret -> le!id = Some v -> eval_expr tge e le m a v) ->
+      match_cont ce tyret nbrk ncnt
+                 (Clight.Kcall (Some id) f e le k)
+                 (Kcall (Some id) tf te le (Kseq (Sset id a) tk)).
 
 Inductive match_states: Clight.state -> Csharpminor.state -> Prop :=
   | match_state:
@@ -1377,14 +1406,15 @@ Inductive match_states: Clight.state -> Csharpminor.state -> Prop :=
       forall fd args k m tfd tk targs tres cconv cu ce
           (LINK: linkorder cu prog)
           (TR: match_fundef cu fd tfd)
-          (MK: match_cont ce Tvoid 0%nat 0%nat k tk)
+          (MK: match_cont ce tres 0%nat 0%nat k tk)
           (ISCC: Clight.is_call_cont k)
           (TY: type_of_fundef fd = Tfunction targs tres cconv),
       match_states (Clight.Callstate fd args k m)
                    (Callstate tfd args tk m)
   | match_returnstate:
-      forall res k m tk ce
-          (MK: match_cont ce Tvoid 0%nat 0%nat k tk),
+      forall res tres k m tk ce
+          (MK: match_cont ce tres 0%nat 0%nat k tk)
+          (WT: wt_val res tres),
       match_states (Clight.Returnstate res k m)
                    (Returnstate res tk m).
 
@@ -1442,7 +1472,9 @@ Proof.
 - (* set *)
   auto.
 - (* call *)
-  simpl in TR. destruct (classify_fun (typeof e)); monadInv TR. auto.
+  simpl in TR. destruct (classify_fun (typeof e)); monadInv TR.
+  unfold make_funcall.
+  destruct o; auto; destruct Conventions1.return_value_needs_normalization; auto.
 - (* builtin *)
   auto.
 - (* seq *)
@@ -1500,24 +1532,26 @@ End FIND_LABEL.
 (** Properties of call continuations *)
 
 Lemma match_cont_call_cont:
-  forall ce' tyret' nbrk' ncnt' ce tyret nbrk ncnt k tk,
+  forall ce' nbrk' ncnt' ce tyret nbrk ncnt k tk,
   match_cont ce tyret nbrk ncnt k tk ->
-  match_cont ce' tyret' nbrk' ncnt' (Clight.call_cont k) (call_cont tk).
+  match_cont ce' tyret nbrk' ncnt' (Clight.call_cont k) (call_cont tk).
 Proof.
   induction 1; simpl; auto.
-  constructor.
-  econstructor; eauto.
+- apply match_Kstop.
+- eapply match_Kcall; eauto.
+- eapply match_Kcall_normalize; eauto.
 Qed.
 
 Lemma match_cont_is_call_cont:
-  forall ce tyret nbrk ncnt k tk ce' tyret' nbrk' ncnt',
+  forall ce tyret nbrk ncnt k tk ce' nbrk' ncnt',
   match_cont ce tyret nbrk ncnt k tk ->
   Clight.is_call_cont k ->
-  match_cont ce' tyret' nbrk' ncnt' k tk /\ is_call_cont tk.
+  match_cont ce' tyret nbrk' ncnt' k tk /\ is_call_cont tk.
 Proof.
   intros. inv H; simpl in H0; try contradiction; simpl.
-  split; auto; constructor.
-  split; auto; econstructor; eauto.
+  split; auto; apply match_Kstop.
+  split; auto; eapply match_Kcall; eauto.
+  split; auto; eapply match_Kcall_normalize; eauto.
 Qed.
 
 (** The simulation proof *)
@@ -1549,19 +1583,44 @@ Proof.
 
 - (* call *)
   revert TR. simpl. case_eq (classify_fun (typeof a)); try congruence.
-  intros targs tres cc CF TR. monadInv TR. inv MTR.
+  intros targs tres cc CF TR. monadInv TR.
   exploit functions_translated; eauto. intros (cu' & tfd & FIND & TFD & LINK').
   rewrite H in CF. simpl in CF. inv CF.
-  econstructor; split.
-  apply plus_one. econstructor; eauto.
-  eapply transl_expr_correct with (cunit := cu); eauto.
-  eapply transl_arglist_correct with (cunit := cu); eauto.
-  erewrite typlist_of_arglist_eq by eauto.
-  eapply transl_fundef_sig1; eauto.
-  rewrite H3. auto.
-  econstructor; eauto.
-  eapply match_Kcall with (ce := prog_comp_env cu') (cu := cu); eauto.
-  simpl. auto.
+  set (sg := {| sig_args := typlist_of_arglist al targs;
+                sig_res := rettype_of_type tres;
+                sig_cc := cc |}) in *.
+  assert (SIG: funsig tfd = sg).
+  { unfold sg; erewrite typlist_of_arglist_eq by eauto.
+    eapply transl_fundef_sig1; eauto. rewrite H3; auto. }
+  assert (EITHER: tk' = tk /\ ts' = Scall optid sg x x0
+               \/ exists id, optid = Some id /\
+                  tk' = tk /\ ts' = Sseq (Scall optid sg x x0)
+                                         (Sset id (make_normalization tres (Evar id)))).
+  { unfold make_funcall in MTR.
+    destruct optid. destruct Conventions1.return_value_needs_normalization.
+    inv MTR. right; exists i; auto.
+    inv MTR; auto.
+    inv MTR; auto. }
+  destruct EITHER as [(EK & ES) | (id & EI & EK & ES)]; rewrite EK, ES.
+  + (* without normalization of return value *)
+    econstructor; split.
+    apply plus_one. eapply step_call; eauto.
+    eapply transl_expr_correct with (cunit := cu); eauto.
+    eapply transl_arglist_correct with (cunit := cu); eauto.
+    econstructor; eauto.
+    eapply match_Kcall with (ce := prog_comp_env cu') (cu := cu); eauto.
+    exact I.
+  + (* with normalization of return value *)
+    subst optid.
+    econstructor; split.
+    eapply plus_two. apply step_seq. eapply step_call; eauto. 
+    eapply transl_expr_correct with (cunit := cu); eauto.
+    eapply transl_arglist_correct with (cunit := cu); eauto.
+    traceEq.
+    econstructor; eauto.
+    eapply match_Kcall_normalize  with (ce := prog_comp_env cu') (cu := cu); eauto.
+    intros. eapply make_normalization_correct; eauto. constructor; eauto.
+    exact I.
 
 - (* builtin *)
   monadInv TR. inv MTR.
@@ -1658,6 +1717,7 @@ Proof.
   eapply match_env_free_blocks; eauto.
   eapply match_returnstate with (ce := prog_comp_env cu); eauto.
   eapply match_cont_call_cont. eauto.
+  constructor.
 
 - (* return some *)
   monadInv TR. inv MTR.
@@ -1667,6 +1727,7 @@ Proof.
   eapply match_env_free_blocks; eauto.
   eapply match_returnstate with (ce := prog_comp_env cu); eauto.
   eapply match_cont_call_cont. eauto.
+  apply wt_val_casted. eapply cast_val_is_casted; eauto.
 
 - (* skip call *)
   monadInv TR. inv MTR.
@@ -1675,6 +1736,7 @@ Proof.
   apply plus_one. apply step_skip_call. auto.
   eapply match_env_free_blocks; eauto.
   eapply match_returnstate with (ce := prog_comp_env cu); eauto.
+  constructor.
 
 - (* switch *)
   monadInv TR.
@@ -1738,20 +1800,33 @@ Proof.
   simpl. econstructor; eauto.
   unfold transl_function. rewrite EQ; simpl. rewrite EQ1; simpl. auto.
   constructor.
+  replace (fn_return f) with tres. eassumption.
+  simpl in TY. unfold type_of_function in TY. congruence. 
 
 - (* external function *)
   inv TR.
   exploit match_cont_is_call_cont; eauto. intros [A B].
   econstructor; split.
-  apply plus_one. constructor. eauto.
+  apply plus_one. constructor.
   eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   eapply match_returnstate with (ce := ce); eauto.
+  apply has_rettype_wt_val. 
+  replace (rettype_of_type tres0) with (sig_res (ef_sig ef)).
+  eapply external_call_well_typed_gen; eauto.
+  rewrite H5. simpl. simpl in TY. congruence.
 
 - (* returnstate *)
   inv MK.
-  econstructor; split.
-  apply plus_one. constructor.
-  econstructor; eauto. simpl; reflexivity. constructor.
+  + (* without normalization *)
+    econstructor; split.
+    apply plus_one. constructor.
+    econstructor; eauto. simpl; reflexivity. constructor.
+  + (* with normalization *)
+    econstructor; split.
+    eapply plus_three. econstructor. econstructor. constructor.
+    simpl. apply H13. eauto. apply PTree.gss.
+    traceEq.
+    simpl. rewrite PTree.set2. econstructor; eauto. simpl; reflexivity. constructor.
 Qed.
 
 Lemma transl_initial_states:
diff --git a/cfrontend/Cstrategy.v b/cfrontend/Cstrategy.v
index 28c8eeb8..c235031f 100644
--- a/cfrontend/Cstrategy.v
+++ b/cfrontend/Cstrategy.v
@@ -222,7 +222,7 @@ Proof.
   induction 1; constructor; auto.
 Qed.
 
-Hint Resolve leftcontext_context.
+Local Hint Resolve leftcontext_context : core.
 
 (** Strategy for reducing expressions. We reduce the leftmost innermost
   non-simple subexpression, evaluating its arguments (which are necessarily
@@ -398,8 +398,8 @@ Proof.
   induction 1; intros; constructor; eauto.
 Qed.
 
-Hint Constructors context contextlist.
-Hint Resolve context_compose contextlist_compose.
+Local Hint Constructors context contextlist : core.
+Local Hint Resolve context_compose contextlist_compose : core.
 
 (** * Safe executions. *)
 
@@ -975,7 +975,7 @@ Proof.
   apply extensionality; intros. f_equal. f_equal. apply exprlist_app_assoc.
 Qed.
 
-Hint Resolve contextlist'_head contextlist'_tail.
+Local Hint Resolve contextlist'_head contextlist'_tail : core.
 
 Lemma eval_simple_list_steps:
   forall rl vl, eval_simple_list' rl vl ->
@@ -1049,7 +1049,7 @@ Scheme expr_ind2 := Induction for expr Sort Prop
   with exprlist_ind2 := Induction for exprlist Sort Prop.
 Combined Scheme expr_expr_list_ind from expr_ind2, exprlist_ind2.
 
-Hint Constructors leftcontext leftcontextlist.
+Local Hint Constructors leftcontext leftcontextlist : core.
 
 Lemma decompose_expr:
   (forall a from C,
diff --git a/cfrontend/Csyntax.v b/cfrontend/Csyntax.v
index 914328be..e3e2c1e9 100644
--- a/cfrontend/Csyntax.v
+++ b/cfrontend/Csyntax.v
@@ -41,7 +41,7 @@ Inductive expr : Type :=
                                            (**r binary arithmetic operation *)
   | Ecast (r: expr) (ty: type)                        (**r type cast [(ty)r] *)
   | Eseqand (r1 r2: expr) (ty: type)       (**r sequential "and" [r1 && r2] *)
-  | Eseqor (r1 r2: expr) (ty: type)        (**r sequential "or" [r1 && r2] *)
+  | Eseqor (r1 r2: expr) (ty: type)        (**r sequential "or" [r1 || r2] *)
   | Econdition (r1 r2 r3: expr) (ty: type)  (**r conditional [r1 ? r2 : r3] *)
   | Esizeof (ty': type) (ty: type)                      (**r size of a type *)
   | Ealignof (ty': type) (ty: type)        (**r natural alignment of a type *)
@@ -100,6 +100,18 @@ Definition Epreincr (id: incr_or_decr) (l: expr) (ty: type) :=
   Eassignop (match id with Incr => Oadd | Decr => Osub end)
             l (Eval (Vint Int.one) type_int32s) (typeconv ty) ty.
 
+(** Selection is a conditional expression that always evaluates both arms
+  and can be implemented by "conditional move" instructions.
+  It is expressed as an invocation of a builtin function. *)
+
+Definition Eselection (r1 r2 r3: expr) (ty: type) :=
+  let t := typ_of_type ty in
+  let sg := mksignature (AST.Tint :: t :: t :: nil) t cc_default in
+  Ebuiltin (EF_builtin "__builtin_sel"%string sg)
+           (Tcons type_bool (Tcons ty (Tcons ty Tnil)))
+           (Econs r1 (Econs r2 (Econs r3 Enil)))
+           ty.
+
 (** Extract the type part of a type-annotated expression. *)
 
 Definition typeof (a: expr) : type :=
diff --git a/cfrontend/Ctypes.v b/cfrontend/Ctypes.v
index bfc5daa9..664a60c5 100644
--- a/cfrontend/Ctypes.v
+++ b/cfrontend/Ctypes.v
@@ -732,8 +732,21 @@ Definition typ_of_type (t: type) : AST.typ :=
   | Tpointer _ _ | Tarray _ _ _ | Tfunction _ _ _ | Tstruct _ _ | Tunion _ _ => AST.Tptr
   end.
 
-Definition opttyp_of_type (t: type) : option AST.typ :=
-  if type_eq t Tvoid then None else Some (typ_of_type t).
+Definition rettype_of_type (t: type) : AST.rettype :=
+  match t with
+  | Tvoid => AST.Tvoid
+  | Tint I32 _ _ => AST.Tint
+  | Tint I8 Signed _ => AST.Tint8signed
+  | Tint I8 Unsigned _ => AST.Tint8unsigned
+  | Tint I16 Signed _ => AST.Tint16signed
+  | Tint I16 Unsigned _ => AST.Tint16unsigned
+  | Tint IBool _ _ => AST.Tint8unsigned
+  | Tlong _ _ => AST.Tlong
+  | Tfloat F32 _ => AST.Tsingle
+  | Tfloat F64 _ => AST.Tfloat
+  | Tpointer _ _ => AST.Tptr
+  | Tarray _ _ _ | Tfunction _ _ _ | Tstruct _ _ | Tunion _ _ => AST.Tvoid
+  end.
 
 Fixpoint typlist_of_typelist (tl: typelist) : list AST.typ :=
   match tl with
@@ -742,7 +755,7 @@ Fixpoint typlist_of_typelist (tl: typelist) : list AST.typ :=
   end.
 
 Definition signature_of_type (args: typelist) (res: type) (cc: calling_convention): signature :=
-  mksignature (typlist_of_typelist args) (opttyp_of_type res) cc.
+  mksignature (typlist_of_typelist args) (rettype_of_type res) cc.
 
 (** * Construction of the composite environment *)
 
diff --git a/cfrontend/Ctyping.v b/cfrontend/Ctyping.v
index ba1d34fb..00fcf8ab 100644
--- a/cfrontend/Ctyping.v
+++ b/cfrontend/Ctyping.v
@@ -18,7 +18,7 @@
 Require Import String.
 Require Import Coqlib Maps Integers Floats Errors.
 Require Import AST Linking.
-Require Import Values Memory Globalenvs Events.
+Require Import Values Memory Globalenvs Builtins Events.
 Require Import Ctypes Cop Csyntax Csem.
 
 Local Open Scope error_monad_scope.
@@ -392,13 +392,17 @@ Inductive wt_rvalue : expr -> Prop :=
       classify_fun (typeof r1) = fun_case_f tyargs tyres cconv ->
       wt_arguments rargs tyargs ->
       wt_rvalue (Ecall r1 rargs tyres)
-  | wt_Ebuiltin: forall ef tyargs rargs,
+  | wt_Ebuiltin: forall ef tyargs rargs ty,
       wt_exprlist rargs ->
       wt_arguments rargs tyargs ->
-      (* This is specialized to builtins returning void, the only
-         case generated by C2C. *)
-      sig_res (ef_sig ef) = None ->
-      wt_rvalue (Ebuiltin ef tyargs rargs Tvoid)
+      (* This typing rule is specialized to the builtin invocations generated
+         by C2C, which are either __builtin_sel or builtins returning void. *)
+         (ty = Tvoid /\ sig_res (ef_sig ef) = AST.Tvoid)
+      \/ (tyargs = Tcons type_bool (Tcons ty (Tcons ty Tnil))
+          /\ let t := typ_of_type ty in
+             let sg := mksignature (AST.Tint :: t :: t :: nil) t cc_default in
+             ef = EF_builtin "__builtin_sel"%string sg) ->
+      wt_rvalue (Ebuiltin ef tyargs rargs ty)
   | wt_Eparen: forall r tycast ty,
       wt_rvalue r ->
       wt_cast (typeof r) tycast -> subtype tycast ty ->
@@ -517,11 +521,20 @@ Fixpoint bind_globdef (e: typenv) (l: list (ident * globdef fundef type)) : type
   | (id, Gvar v) :: l => bind_globdef (PTree.set id v.(gvar_info) e) l
   end.
 
+Inductive wt_fundef (ce: composite_env) (e: typenv) : fundef -> Prop :=
+  | wt_fundef_internal: forall f,
+      wt_function ce e f ->
+      wt_fundef ce e (Internal f)
+  | wt_fundef_external: forall ef targs tres cc,
+      (ef_sig ef).(sig_res) = rettype_of_type tres ->
+      wt_fundef ce e (External ef targs tres cc).
+
 Inductive wt_program : program -> Prop :=
   | wt_program_intro: forall p,
       let e := bind_globdef (PTree.empty _) p.(prog_defs) in
-      (forall id f, In (id, Gfun (Internal f)) p.(prog_defs) ->
-         wt_function p.(prog_comp_env) e f) ->
+      (forall id fd,
+         In (id, Gfun fd) p.(prog_defs) ->
+         wt_fundef p.(prog_comp_env) e fd) ->
       wt_program p.
 
 Hint Constructors wt_val wt_rvalue wt_lvalue wt_stmt wt_lblstmts: ty.
@@ -741,10 +754,16 @@ Definition ebuiltin (ef: external_function) (tyargs: typelist) (args: exprlist)
   do x1 <- check_rvals args;
   do x2 <- check_arguments args tyargs;
   if type_eq tyres Tvoid
-  && opt_typ_eq (sig_res (ef_sig ef)) None
+  && AST.rettype_eq (sig_res (ef_sig ef)) AST.Tvoid
   then OK (Ebuiltin ef tyargs args tyres)
   else Error (msg "builtin: wrong type decoration").
 
+Definition eselection (r1 r2 r3: expr) : res expr :=
+  do x1 <- check_rval r1; do x2 <- check_rval r2; do x3 <- check_rval r3;
+  do y1 <- check_bool (typeof r1);
+  do ty <- type_conditional (typeof r2) (typeof r3);
+  OK (Eselection r1 r2 r3 ty).
+
 Definition sdo (a: expr) : res statement :=
   do x <- check_rval a; OK (Sdo a).
 
@@ -905,7 +924,8 @@ Definition retype_function (ce: composite_env) (e: typenv) (f: function) : res f
 Definition retype_fundef (ce: composite_env) (e: typenv) (fd: fundef) : res fundef :=
   match fd with
   | Internal f => do f' <- retype_function ce e f; OK (Internal f')
-  | External id args res cc => OK fd
+  | External ef args res cc =>
+      assertion (rettype_eq (ef_sig ef).(sig_res) (rettype_of_type res)); OK fd
   end.
 
 Definition typecheck_program (p: program) : res program :=
@@ -977,10 +997,20 @@ Proof.
           classify_cast (Tint i s a) t2 <> cast_case_default).
   {
     unfold classify_cast. destruct t2; try congruence. destruct f; congruence.
+    destruct Archi.ptr64; congruence.
   }
   destruct i; auto.
 Qed.
 
+Lemma wt_bool_cast:
+  forall ty, wt_bool ty -> wt_cast ty type_bool.
+Proof.
+  unfold wt_bool, wt_cast; unfold classify_bool; intros.
+  destruct ty; simpl in *; try congruence;
+  try (destruct Archi.ptr64; congruence).
+  destruct f; congruence.
+Qed.
+
 Lemma wt_cast_int:
   forall i1 s1 a1 i2 s2 a2, wt_cast (Tint i1 s1 a1) (Tint i2 s2 a2).
 Proof.
@@ -1221,10 +1251,21 @@ Lemma ebuiltin_sound:
 Proof.
   intros. monadInv H.
   destruct (type_eq tyres Tvoid); simpl in EQ2; try discriminate.
-  destruct (opt_typ_eq (sig_res (ef_sig ef)) None); inv EQ2.
+  destruct (rettype_eq (sig_res (ef_sig ef)) AST.Tvoid); inv EQ2.
   econstructor; eauto. eapply check_arguments_sound; eauto.
 Qed.
 
+Lemma eselection_sound:
+  forall r1 r2 r3 a, eselection r1 r2 r3 = OK a ->
+  wt_expr ce e r1 -> wt_expr ce e r2 -> wt_expr ce e r3 -> wt_expr ce e a.
+Proof.
+  intros. monadInv H. apply type_conditional_cast in EQ3. destruct EQ3.
+  eapply wt_Ebuiltin.
+  repeat (constructor; eauto with ty).
+  repeat (constructor; eauto with ty). apply wt_bool_cast; eauto with ty.
+  right; auto.
+Qed.
+
 Lemma sdo_sound:
   forall a s, sdo a = OK s -> wt_expr ce e a -> wt_stmt ce e rt s.
 Proof.
@@ -1342,6 +1383,14 @@ Proof.
   intros. monadInv H. constructor; simpl. eapply retype_stmt_sound; eauto.
 Qed.
 
+Lemma retype_fundef_sound:
+  forall ce e fd fd', retype_fundef ce e fd = OK fd' -> wt_fundef ce e fd'.
+Proof.
+  intros. destruct fd; monadInv H.
+- constructor; eapply retype_function_sound; eauto.
+- constructor; auto.
+Qed.
+
 Theorem typecheck_program_sound:
   forall p p', typecheck_program p = OK p' -> wt_program p'.
 Proof.
@@ -1364,11 +1413,11 @@ Proof.
     inv H1. simpl. auto.
   }
   rewrite ENVS.
-  intros id f. revert MATCH; generalize (prog_defs p) (AST.prog_defs tp).
+  intros id fd. revert MATCH; generalize (prog_defs p) (AST.prog_defs tp).
   induction 1; simpl; intros.
   contradiction.
   destruct H0; auto. subst b1; inv H. simpl in H1. inv H1. 
-  destruct f1; monadInv H4. eapply retype_function_sound; eauto.
+  eapply retype_fundef_sound; eauto.
 Qed.
 
 (** * Subject reduction *)
@@ -1632,15 +1681,6 @@ Proof.
   destruct f; discriminate.
 Qed.
 
-Lemma wt_bool_cast:
-  forall ty, wt_bool ty -> wt_cast ty type_bool.
-Proof.
-  unfold wt_bool, wt_cast; unfold classify_bool; intros.
-  destruct ty; simpl in *; try congruence;
-  try (destruct Archi.ptr64; congruence).
-  destruct f; congruence.
-Qed.
-
 Lemma wt_cast_self:
   forall t1 t2, wt_cast t1 t2 -> wt_cast t2 t2.
 Proof.
@@ -1689,6 +1729,26 @@ Proof.
   inv H; auto.
 Qed.
 
+Lemma has_rettype_wt_val:
+  forall v ty,
+  Val.has_rettype v (rettype_of_type ty) -> wt_val v ty.
+Proof.
+  unfold rettype_of_type, Val.has_rettype, Val.has_type; destruct ty; intros.
+- destruct v; contradiction || constructor.
+- destruct i.
+  + destruct s; destruct v; try contradiction; constructor; red; auto.
+  + destruct s; destruct v; try contradiction; constructor; red; auto.
+  + destruct v; try contradiction; constructor; auto.
+  + destruct v; try contradiction; constructor; red; auto.
+- destruct v; try contradiction; constructor; auto.
+- destruct f; destruct v; try contradiction; constructor.
+- unfold Tptr in *; destruct v; destruct Archi.ptr64 eqn:P64; try contradiction; constructor; auto.
+- destruct v; contradiction || constructor.
+- destruct v; contradiction || constructor.
+- destruct v; contradiction || constructor.
+- destruct v; contradiction || constructor.
+Qed.
+
 Lemma wt_rred:
   forall ge tenv a m t a' m',
   rred ge a m t a' m' -> wt_rvalue ge tenv a -> wt_rvalue ge tenv a'.
@@ -1725,7 +1785,27 @@ Proof.
   constructor; auto.
 - (* comma *) auto.
 - (* paren *) inv H3. constructor. apply H5. eapply pres_sem_cast; eauto.
-- (* builtin *) subst. auto with ty.
+- (* builtin *) subst. destruct H7 as [(A & B) | (A & B)].
++ subst ty. auto with ty.
++ simpl in B. set (T := typ_of_type ty) in *. 
+  set (sg := mksignature (AST.Tint :: T :: T :: nil) T cc_default) in *.
+  assert (LK: lookup_builtin_function "__builtin_sel"%string sg = Some (BI_standard (BI_select T))).
+  { unfold sg, T; destruct ty as   [ | ? ? ? | ? | [] ? | ? ? | ? ? ? | ? ? ? | ? ? | ? ? ];
+    simpl; unfold Tptr; destruct Archi.ptr64; reflexivity. }
+  subst ef. red in H0. red in H0. rewrite LK in H0. inv H0. 
+  inv H. inv H8. inv H9. inv H10. simpl in H1.
+  assert (A: val_casted v1 type_bool) by (eapply cast_val_is_casted; eauto).
+  inv A. 
+  set (v' := if Int.eq n Int.zero then v4 else v2) in *.
+  constructor.
+  destruct (type_eq ty Tvoid).
+  subst. constructor.
+  inv H1.
+  assert (C: val_casted v' ty).
+  { unfold v'; destruct (Int.eq n Int.zero); eapply cast_val_is_casted; eauto. }
+  assert (EQ: Val.normalize v' T = v').
+  { apply Val.normalize_idem. apply val_casted_has_type; auto. }
+  rewrite EQ. apply wt_val_casted; auto.
 Qed.
 
 Lemma wt_lred:
@@ -1767,8 +1847,8 @@ with wt_subexprlist:
   wt_exprlist cenv tenv (C a) ->
   wt_expr_kind cenv tenv from a.
 Proof.
-  destruct 1; intros WT; auto; inv WT; eauto.
-  destruct 1; intros WT; inv WT; eauto.
+- destruct 1; intros WT; auto; inv WT; eauto.
+- destruct 1; intros WT; inv WT; eauto.
 Qed.
 
 Lemma typeof_context:
@@ -1854,12 +1934,6 @@ Hypothesis WTPROG: wt_program prog.
 Let ge := globalenv prog.
 Let gtenv := bind_globdef (PTree.empty _) prog.(prog_defs).
 
-Hypothesis WT_EXTERNAL:
-  forall id ef args res cc vargs m t vres m',
-  In (id, Gfun (External ef args res cc)) prog.(prog_defs) ->
-  external_call ef ge vargs m t vres m' ->
-  wt_val vres res.
-
 Inductive wt_expr_cont: typenv -> function -> cont -> Prop :=
   | wt_Kdo: forall te f k,
       wt_stmt_cont te f k ->
@@ -1958,12 +2032,6 @@ Proof.
   induction 1; simpl; auto; econstructor; eauto.
 Qed.
 
-Definition wt_fundef (fd: fundef) :=
-  match fd with
-  | Internal f => wt_function ge gtenv f
-  | External ef targs tres cc => True
-  end.
-
 Definition fundef_return (fd: fundef) : type :=
   match fd with
   | Internal f => f.(fn_return)
@@ -1971,10 +2039,10 @@ Definition fundef_return (fd: fundef) : type :=
   end.
 
 Lemma wt_find_funct:
-  forall v fd, Genv.find_funct ge v = Some fd -> wt_fundef fd.
+  forall v fd, Genv.find_funct ge v = Some fd -> wt_fundef ge gtenv fd.
 Proof.
   intros. apply Genv.find_funct_prop with (p := prog) (v := v); auto.
-  intros. inv WTPROG. destruct f; simpl; auto. apply H1 with id; auto.
+  intros. inv WTPROG. apply H1 with id; auto.
 Qed.
 
 Inductive wt_state: state -> Prop :=
@@ -1990,7 +2058,7 @@ Inductive wt_state: state -> Prop :=
       wt_state (ExprState f r k e m)
   | wt_call_state: forall b fd vargs k m
         (WTK: wt_call_cont k (fundef_return fd))
-        (WTFD: wt_fundef fd)
+        (WTFD: wt_fundef ge gtenv fd)
         (FIND: Genv.find_funct ge b = Some fd),
       wt_state (Callstate fd vargs k m)
   | wt_return_state: forall v k m ty
@@ -2047,7 +2115,6 @@ Qed.
 
 End WT_FIND_LABEL.
 
-
 Lemma preservation_estep:
   forall S t S', estep ge S t S' -> wt_state S -> wt_state S'.
 Proof.
@@ -2122,9 +2189,10 @@ Proof.
 - inv WTS; eauto with ty.
 - exploit wt_find_label. eexact WTB. eauto. eapply call_cont_wt'; eauto.
   intros [A B]. eauto with ty.
-- simpl in WTFD; inv WTFD. econstructor; eauto. apply wt_call_cont_stmt_cont; auto.
-- exploit (Genv.find_funct_inversion prog); eauto. intros (id & A).
-  econstructor; eauto.
+- inv WTFD. inv H3. econstructor; eauto. apply wt_call_cont_stmt_cont; auto.
+- inv WTFD. econstructor; eauto.
+  apply has_rettype_wt_val. simpl; rewrite <- H1.
+  eapply external_call_well_typed_gen; eauto.
 - inv WTK. eauto with ty.
 Qed.
 
@@ -2139,7 +2207,7 @@ Theorem wt_initial_state:
 Proof.
   intros. inv H. econstructor. constructor.
   apply Genv.find_funct_ptr_prop with (p := prog) (b := b); auto.
-  intros. inv WTPROG. destruct f0; simpl; auto. apply H4 with id; auto.
+  intros. inv WTPROG. apply H4 with id; auto.
   instantiate (1 := (Vptr b Ptrofs.zero)). rewrite Genv.find_funct_find_funct_ptr. auto.
 Qed.
 
diff --git a/cfrontend/PrintClight.ml b/cfrontend/PrintClight.ml
index ca378c11..7d4c47e5 100644
--- a/cfrontend/PrintClight.ml
+++ b/cfrontend/PrintClight.ml
@@ -23,9 +23,14 @@ open Cop
 open PrintCsyntax
 open Clight
 
-(* Naming temporaries *)
+(* Naming temporaries.
+   Some temporaries are obtained by lifting variables in SimplLocals.
+   For these we use a meaningful name "$var", as found in the table of
+   atoms.  Other temporaries are generated during SimplExpr, and are
+   not in the table of atoms.  We print them as "$NNN" (a unique
+   integer). *)
 
-let temp_name (id: AST.ident) = "$" ^ Z.to_string (Z.Zpos id)
+let temp_name (id: AST.ident) = (* "$" ^ Z.to_string (Z.Zpos id) *)extern_atom id
 
 (* Declarator (identifier + type) -- reuse from PrintCsyntax *)
 
@@ -236,10 +241,20 @@ and print_stmt_for p s =
   | _ ->
       fprintf p "({ %a })" print_stmt s
 
-let print_function p id f =
+(* There are two versions of Clight, Clight1 and Clight2, that differ
+   only in the meaning of function parameters:
+ - in Clight1, function parameters are variables
+ - in Clight2, function parameters are temporaries.
+*)
+
+type clight_version = Clight1 | Clight2
+
+let name_param = function Clight1 -> extern_atom | Clight2 -> temp_name
+
+let print_function ver p id f =
   fprintf p "%s@ "
-            (name_cdecl (name_function_parameters (extern_atom id)
-                                                  f.fn_params f.fn_callconv)
+            (name_cdecl (name_function_parameters (name_param ver)
+                                 (extern_atom id) f.fn_params f.fn_callconv)
                         f.fn_return);
   fprintf p "@[<v 2>{@ ";
   List.iter
@@ -253,12 +268,12 @@ let print_function p id f =
   print_stmt p f.fn_body;
   fprintf p "@;<0 -2>}@]@ @ "
 
-let print_fundef p id fd =
+let print_fundef ver p id fd =
   match fd with
   | Ctypes.External(_, _, _, _) ->
       ()
   | Internal f ->
-      print_function p id f
+      print_function ver p id f
 
 let print_fundecl p id fd =
   match fd with
@@ -271,9 +286,9 @@ let print_fundecl p id fd =
       fprintf p "%s;@ "
                 (name_cdecl (extern_atom id) (Clight.type_of_function f))
 
-let print_globdef p (id, gd) =
+let print_globdef var p (id, gd) =
   match gd with
-  | AST.Gfun f -> print_fundef p id f
+  | AST.Gfun f -> print_fundef var p id f
   | AST.Gvar v -> print_globvar p id v  (* from PrintCsyntax *)
 
 let print_globdecl p (id, gd) =
@@ -281,20 +296,29 @@ let print_globdecl p (id, gd) =
   | AST.Gfun f -> print_fundecl p id f
   | AST.Gvar v -> ()
 
-let print_program p prog =
+let print_program ver p prog =
   fprintf p "@[<v 0>";
   List.iter (declare_composite p) prog.prog_types;
   List.iter (define_composite p) prog.prog_types;
   List.iter (print_globdecl p) prog.prog_defs;
-  List.iter (print_globdef p) prog.prog_defs;
+  List.iter (print_globdef ver p) prog.prog_defs;
   fprintf p "@]@."
 
 let destination : string option ref = ref None
 
-let print_if prog =
+let print_if_gen ver prog =
   match !destination with
   | None -> ()
   | Some f ->
       let oc = open_out f in
-      print_program (formatter_of_out_channel oc) prog;
+      print_program ver (formatter_of_out_channel oc) prog;
       close_out oc
+
+(* print_if is called from driver/Compiler.v between the SimplExpr
+   and SimplLocals passes.  It receives Clight1 syntax. *)
+let print_if prog = print_if_gen Clight1 prog
+
+(* print_if_2 is called from clightgen/Clightgen.ml, after the
+   SimplLocals pass.  It receives Clight2 syntax. *)
+let print_if_2 prog = print_if_gen Clight2 prog
+
diff --git a/cfrontend/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml
index 3a44796c..03dc5837 100644
--- a/cfrontend/PrintCsyntax.ml
+++ b/cfrontend/PrintCsyntax.ml
@@ -19,7 +19,7 @@ open Format
 open Camlcoq
 open Values
 open AST
-open Ctypes
+open! Ctypes
 open Cop
 open Csyntax
 
@@ -85,7 +85,7 @@ let name_optid id =
 
 let rec name_cdecl id ty =
   match ty with
-  | Tvoid ->
+  | Ctypes.Tvoid ->
       "void" ^ name_optid id
   | Ctypes.Tint(sz, sg, a) ->
       name_inttype sz sg ^ attributes a ^ name_optid id
@@ -391,7 +391,7 @@ and print_stmt_for p s =
   | _ ->
       fprintf p "({ %a })" print_stmt s
 
-let name_function_parameters fun_name params cconv =
+let name_function_parameters name_param fun_name params cconv =
   let b = Buffer.create 20 in
   Buffer.add_string b fun_name;
   Buffer.add_char b '(';
@@ -404,7 +404,7 @@ let name_function_parameters fun_name params cconv =
           if cconv.cc_vararg then Buffer.add_string b ",..."
       | (id, ty) :: rem ->
           if not first then Buffer.add_string b ", ";
-          Buffer.add_string b (name_cdecl (extern_atom id) ty);
+          Buffer.add_string b (name_cdecl (name_param id) ty);
           add_params false rem in
       add_params true params
   end;
@@ -413,8 +413,8 @@ let name_function_parameters fun_name params cconv =
 
 let print_function p id f =
   fprintf p "%s@ "
-            (name_cdecl (name_function_parameters (extern_atom id)
-                                                  f.fn_params f.fn_callconv)
+            (name_cdecl (name_function_parameters extern_atom
+                             (extern_atom id) f.fn_params f.fn_callconv)
                         f.fn_return);
   fprintf p "@[<v 2>{@ ";
   List.iter
diff --git a/cfrontend/SimplExprspec.v b/cfrontend/SimplExprspec.v
index 37e2cd96..e7d57a1c 100644
--- a/cfrontend/SimplExprspec.v
+++ b/cfrontend/SimplExprspec.v
@@ -687,7 +687,7 @@ Hint Resolve gensym_within within_widen contained_widen
              in_eq in_cons
              Ple_trans Ple_refl: gensym.
 
-Hint Resolve dest_for_val_below dest_for_effect_below.
+Local Hint Resolve dest_for_val_below dest_for_effect_below : core.
 
 (** ** Correctness of the translation functions *)
 
diff --git a/cfrontend/SimplLocalsproof.v b/cfrontend/SimplLocalsproof.v
index 26d3d347..2dd34389 100644
--- a/cfrontend/SimplLocalsproof.v
+++ b/cfrontend/SimplLocalsproof.v
@@ -1055,7 +1055,7 @@ Proof.
   assert (RPDST: Mem.range_perm m bdst (Ptrofs.unsigned odst) (Ptrofs.unsigned odst + sizeof tge ty) Cur Nonempty).
     replace (sizeof tge ty) with (Z.of_nat (List.length bytes)).
     eapply Mem.range_perm_implies. eapply Mem.storebytes_range_perm; eauto. auto with mem.
-    rewrite LEN. apply nat_of_Z_eq. omega.
+    rewrite LEN. apply Z2Nat.id. omega.
   assert (PSRC: Mem.perm m bsrc (Ptrofs.unsigned osrc) Cur Nonempty).
     apply RPSRC. omega.
   assert (PDST: Mem.perm m bdst (Ptrofs.unsigned odst) Cur Nonempty).
diff --git a/common/AST.v b/common/AST.v
index 145f4919..fcbf0b34 100644
--- a/common/AST.v
+++ b/common/AST.v
@@ -45,9 +45,6 @@ Lemma typ_eq: forall (t1 t2: typ), {t1=t2} + {t1<>t2}.
 Proof. decide equality. Defined.
 Global Opaque typ_eq.
 
-Definition opt_typ_eq: forall (t1 t2: option typ), {t1=t2} + {t1<>t2}
-                     := option_eq typ_eq.
-
 Definition list_typ_eq: forall (l1 l2: list typ), {l1=l2} + {l1<>l2}
                      := list_eq_dec typ_eq.
 
@@ -91,10 +88,34 @@ Fixpoint subtype_list (tyl1 tyl2: list typ) : bool :=
   | _, _ => false
   end.
 
+(** To describe the values returned by functions, we use the more precise
+    types below. *)
+
+Inductive rettype : Type :=
+  | Tret (t: typ)                       (**r like type [t] *)
+  | Tint8signed                         (**r 8-bit signed integer *)
+  | Tint8unsigned                       (**r 8-bit unsigned integer *)
+  | Tint16signed                        (**r 16-bit signed integer *)
+  | Tint16unsigned                      (**r 16-bit unsigned integer *)
+  | Tvoid.                              (**r no value returned *)
+
+Coercion Tret: typ >-> rettype.
+
+Lemma rettype_eq: forall (t1 t2: rettype), {t1=t2} + {t1<>t2}.
+Proof. generalize typ_eq; decide equality. Defined.
+Global Opaque rettype_eq.
+
+Fixpoint proj_rettype (r: rettype) : typ :=
+  match r with
+  | Tret t => t
+  | Tint8signed | Tint8unsigned | Tint16signed | Tint16unsigned => Tint
+  | Tvoid => Tint
+  end.
+
 (** Additionally, function definitions and function calls are annotated
   by function signatures indicating:
 - the number and types of arguments;
-- the type of the returned value, if any;
+- the type of the returned value;
 - additional information on which calling convention to use.
 
 These signatures are used in particular to determine appropriate
@@ -117,24 +138,20 @@ Global Opaque calling_convention_eq.
 
 Record signature : Type := mksignature {
   sig_args: list typ;
-  sig_res: option typ;
+  sig_res: rettype;
   sig_cc: calling_convention
 }.
 
-Definition proj_sig_res (s: signature) : typ :=
-  match s.(sig_res) with
-  | None => Tint
-  | Some t => t
-  end.
+Definition proj_sig_res (s: signature) : typ := proj_rettype s.(sig_res).
 
 Definition signature_eq: forall (s1 s2: signature), {s1=s2} + {s1<>s2}.
 Proof.
-  generalize opt_typ_eq, list_typ_eq, calling_convention_eq; decide equality.
+  generalize rettype_eq, list_typ_eq, calling_convention_eq; decide equality.
 Defined.
 Global Opaque signature_eq.
 
 Definition signature_main :=
-  {| sig_args := nil; sig_res := Some Tint; sig_cc := cc_default |}.
+  {| sig_args := nil; sig_res := Tint; sig_cc := cc_default |}.
 
 (** Memory accesses (load and store instructions) are annotated by
   a ``memory chunk'' indicating the type, size and signedness of the
@@ -177,6 +194,28 @@ Definition type_of_chunk (c: memory_chunk) : typ :=
 Lemma type_of_Mptr: type_of_chunk Mptr = Tptr.
 Proof. unfold Mptr, Tptr; destruct Archi.ptr64; auto. Qed.
 
+(** Same, as a return type. *)
+
+Definition rettype_of_chunk (c: memory_chunk) : rettype :=
+  match c with
+  | Mint8signed => Tint8signed
+  | Mint8unsigned => Tint8unsigned
+  | Mint16signed => Tint16signed
+  | Mint16unsigned => Tint16unsigned
+  | Mint32 => Tint
+  | Mint64 => Tlong
+  | Mfloat32 => Tsingle
+  | Mfloat64 => Tfloat
+  | Many32 => Tany32
+  | Many64 => Tany64
+  end.
+
+Lemma proj_rettype_of_chunk:
+  forall chunk, proj_rettype (rettype_of_chunk chunk) = type_of_chunk chunk.
+Proof.
+  destruct chunk; auto.
+Qed.
+
 (** The chunk that is appropriate to store and reload a value of
   the given type, without losing information. *)
 
@@ -432,12 +471,12 @@ Inductive external_function : Type :=
      (** A function from the run-time library.  Behaves like an
          external, but must not be redefined. *)
   | EF_vload (chunk: memory_chunk)
-     (** A volatile read operation.  If the adress given as first argument
+     (** A volatile read operation.  If the address given as first argument
          points within a volatile global variable, generate an
          event and return the value found in this event.  Otherwise,
          produce no event and behave like a regular memory load. *)
   | EF_vstore (chunk: memory_chunk)
-     (** A volatile store operation.   If the adress given as first argument
+     (** A volatile store operation.   If the address given as first argument
          points within a volatile global variable, generate an event.
          Otherwise, produce no event and behave like a regular memory store. *)
   | EF_malloc
@@ -477,15 +516,15 @@ Definition ef_sig (ef: external_function): signature :=
   | EF_external name sg => sg
   | EF_builtin name sg => sg
   | EF_runtime name sg => sg
-  | EF_vload chunk => mksignature (Tptr :: nil) (Some (type_of_chunk chunk)) cc_default
-  | EF_vstore chunk => mksignature (Tptr :: type_of_chunk chunk :: nil) None cc_default
-  | EF_malloc => mksignature (Tptr :: nil) (Some Tptr) cc_default
-  | EF_free => mksignature (Tptr :: nil) None cc_default
-  | EF_memcpy sz al => mksignature (Tptr :: Tptr :: nil) None cc_default
-  | EF_annot kind text targs => mksignature targs None cc_default
-  | EF_annot_val kind text targ => mksignature (targ :: nil) (Some targ) cc_default
+  | EF_vload chunk => mksignature (Tptr :: nil) (rettype_of_chunk chunk) cc_default
+  | EF_vstore chunk => mksignature (Tptr :: type_of_chunk chunk :: nil) Tvoid cc_default
+  | EF_malloc => mksignature (Tptr :: nil) Tptr cc_default
+  | EF_free => mksignature (Tptr :: nil) Tvoid cc_default
+  | EF_memcpy sz al => mksignature (Tptr :: Tptr :: nil) Tvoid cc_default
+  | EF_annot kind text targs => mksignature targs Tvoid cc_default
+  | EF_annot_val kind text targ => mksignature (targ :: nil) targ cc_default
   | EF_inline_asm text sg clob => sg
-  | EF_debug kind text targs => mksignature targs None cc_default
+  | EF_debug kind text targs => mksignature targs Tvoid cc_default
   end.
 
 (** Whether an external function should be inlined by the compiler. *)
diff --git a/common/Builtins.v b/common/Builtins.v
new file mode 100644
index 00000000..476b541e
--- /dev/null
+++ b/common/Builtins.v
@@ -0,0 +1,58 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Known built-in functions *)
+
+Require Import String Coqlib.
+Require Import AST Integers Floats Values.
+Require Export Builtins0 Builtins1.
+
+Inductive builtin_function : Type :=
+  | BI_standard (b: standard_builtin)
+  | BI_platform (b: platform_builtin).
+
+Definition builtin_function_sig (b: builtin_function) : signature :=
+  match b with
+  | BI_standard b => standard_builtin_sig b
+  | BI_platform b => platform_builtin_sig b
+  end.
+
+Definition builtin_function_sem (b: builtin_function) : builtin_sem (sig_res (builtin_function_sig b)) :=
+  match b with
+  | BI_standard b => standard_builtin_sem b
+  | BI_platform b => platform_builtin_sem b
+  end.
+
+Definition lookup_builtin_function (name: string) (sg: signature) : option builtin_function :=
+  match lookup_builtin standard_builtin_sig name sg standard_builtin_table with
+  | Some b => Some (BI_standard b)
+  | None => 
+  match lookup_builtin platform_builtin_sig name sg platform_builtin_table with
+  | Some b => Some (BI_platform b)
+  | None => None
+  end end.
+
+Lemma lookup_builtin_function_sig:
+  forall name sg b, lookup_builtin_function name sg = Some b -> builtin_function_sig b = sg.
+Proof.
+  unfold lookup_builtin_function; intros.
+  destruct (lookup_builtin standard_builtin_sig name sg standard_builtin_table) as [bs|] eqn:E.
+  inv H. simpl. eapply lookup_builtin_sig; eauto.
+  destruct (lookup_builtin platform_builtin_sig name sg platform_builtin_table) as [bp|] eqn:E'.
+  inv H. simpl. eapply lookup_builtin_sig; eauto.
+  discriminate.
+Qed.
+
+
diff --git a/common/Builtins0.v b/common/Builtins0.v
new file mode 100644
index 00000000..8da98314
--- /dev/null
+++ b/common/Builtins0.v
@@ -0,0 +1,531 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Associating semantics to built-in functions *)
+
+Require Import String Coqlib.
+Require Import AST Integers Floats Values Memdata.
+
+(** This module provides definitions and mechanisms to associate semantics
+  with names of built-in functions.
+
+  This module is independent of the target architecture.  Each target
+  provides a [Builtins1] module that lists the built-ins semantics
+  appropriate for the target.
+*)
+
+Definition val_opt_has_rettype (ov: option val) (t: rettype) : Prop :=
+  match ov with Some v => Val.has_rettype v t | None => True end.
+
+Definition val_opt_inject (j: meminj) (ov ov': option val) : Prop :=
+  match ov, ov' with
+  | None, _ => True
+  | Some v, Some v' => Val.inject j v v'
+  | _, None => False
+  end.
+
+(** The semantics of a built-in function is a partial function
+  from list of values to values.  
+  It must agree with the return type stated in the signature,
+  and be compatible with value injections.
+*)
+
+Record builtin_sem (tret: rettype) : Type := mkbuiltin {
+  bs_sem :> list val -> option val;
+  bs_well_typed: forall vl, 
+    val_opt_has_rettype (bs_sem vl) tret;
+  bs_inject: forall j vl vl',
+    Val.inject_list j vl vl' -> val_opt_inject j (bs_sem vl) (bs_sem vl')
+}.
+
+(** Builtin functions can be created from functions over values, such as those
+  from the [Values.Val] module.  Proofs of well-typedness and compatibility with
+  injections must be provided. The constructor functions have names
+- [mkbuiltin_vNt] for a [t]otal function of [N] arguments that are [v]alues, or
+- [mkbuiltin_vNp] for a [p]artial function of [N] arguments that are [v]alues.
+*)
+
+Local Unset Program Cases.
+
+Program Definition mkbuiltin_v1t 
+     (tret: rettype) (f: val -> val)
+     (WT: forall v1, Val.has_rettype (f v1) tret)
+     (INJ: forall j v1 v1', Val.inject j v1 v1' -> Val.inject j (f v1) (f v1')) :=
+  mkbuiltin tret (fun vl => match vl with v1 :: nil => Some (f v1) | _ => None end) _ _.
+Next Obligation.
+  red; destruct vl; auto. destruct vl; auto.
+Qed.
+Next Obligation.
+  red; inv H; auto. inv H1; auto. 
+Qed.
+
+Program Definition mkbuiltin_v2t 
+     (tret: rettype) (f: val -> val -> val)
+     (WT: forall v1 v2, Val.has_rettype (f v1 v2) tret)
+     (INJ: forall j v1 v1' v2 v2',
+           Val.inject j v1 v1' -> Val.inject j v2 v2' ->
+           Val.inject j (f v1 v2) (f v1' v2')) :=
+  mkbuiltin tret (fun vl => match vl with v1 :: v2 :: nil => Some (f v1 v2) | _ => None end) _ _.
+Next Obligation.
+  red; destruct vl; auto. destruct vl; auto. destruct vl; auto.
+Qed.
+Next Obligation.
+  red; inv H; auto. inv H1; auto. inv H2; auto.
+Qed.
+
+Program Definition mkbuiltin_v3t 
+     (tret: rettype) (f: val -> val -> val -> val)
+     (WT: forall v1 v2 v3, Val.has_rettype (f v1 v2 v3) tret)
+     (INJ: forall j v1 v1' v2 v2' v3 v3',
+           Val.inject j v1 v1' -> Val.inject j v2 v2' -> Val.inject j v3 v3' ->
+           Val.inject j (f v1 v2 v3) (f v1' v2' v3')) :=
+  mkbuiltin tret (fun vl => match vl with v1 :: v2 :: v3 :: nil => Some (f v1 v2 v3) | _ => None end) _ _.
+Next Obligation.
+  red; destruct vl; auto. destruct vl; auto. destruct vl; auto. destruct vl; auto.
+Qed.
+Next Obligation.
+  red; inv H; auto. inv H1; auto. inv H2; auto. inv H3; auto.
+Qed.
+
+Program Definition mkbuiltin_v1p
+     (tret: rettype) (f: val -> option val)
+     (WT: forall v1, val_opt_has_rettype (f v1) tret)
+     (INJ: forall j v1 v1',
+        Val.inject j v1 v1' -> val_opt_inject j (f v1) (f v1')) :=
+  mkbuiltin tret (fun vl => match vl with v1 :: nil => f v1 | _ => None end) _ _.
+Next Obligation.
+  red; destruct vl; auto. destruct vl; auto. apply WT.
+Qed.
+Next Obligation.
+  red; inv H; auto. inv H1; auto. apply INJ; auto. 
+Qed.
+
+Program Definition mkbuiltin_v2p
+     (tret: rettype) (f: val -> val -> option val)
+     (WT: forall v1 v2, val_opt_has_rettype (f v1 v2) tret)
+     (INJ: forall j v1 v1' v2 v2',
+        Val.inject j v1 v1' -> Val.inject j v2 v2' ->
+        val_opt_inject j (f v1 v2) (f v1' v2')) :=
+  mkbuiltin tret (fun vl => match vl with v1 :: v2 :: nil => f v1 v2 | _ => None end)  _ _.
+Next Obligation.
+  red; destruct vl; auto. destruct vl; auto. destruct vl; auto. apply WT.
+Qed.
+Next Obligation.
+  red; inv H; auto. inv H1; auto. inv H2; auto. apply INJ; auto. 
+Qed.
+
+(** For numerical functions, involving only integers and floating-point numbers
+  but no pointer values, we can automate the proofs of well-typedness and
+  of compatibility with injections. *)
+
+(** First we define a mapping from syntactic Cminor types ([Tint], [Tfloat], etc) to semantic Coq types. *)
+
+Definition valty (t: typ) : Type :=
+  match t with
+  | Tint => int
+  | Tlong => int64
+  | Tfloat => float
+  | Tsingle => float32
+  | Tany32 | Tany64 => Empty_set (**r no clear semantic meaning *)
+  end.
+
+(** We can inject and project between the numerical type [valty t] and the type [val]. *)
+
+Definition inj_num (t: typ) : valty t -> val :=
+  match t with
+  | Tint => Vint
+  | Tlong => Vlong
+  | Tfloat => Vfloat
+  | Tsingle => Vsingle
+  | Tany32 | Tany64 => fun _ => Vundef
+  end.
+
+Definition proj_num {A: Type} (t: typ) (k0: A) (v: val): (valty t -> A) -> A :=
+  match t with
+  | Tint => fun k1 => match v with Vint n => k1 n | _ => k0 end
+  | Tlong => fun k1 => match v with Vlong n => k1 n | _ => k0 end
+  | Tfloat => fun k1 => match v with Vfloat n => k1 n | _ => k0 end
+  | Tsingle => fun k1 => match v with Vsingle n => k1 n | _ => k0 end
+  | Tany32 | Tany64 => fun k1 => k0
+  end.
+
+Lemma inj_num_wt: forall t x, Val.has_type (inj_num t x) t.
+Proof.
+  destruct t; intros; exact I.
+Qed.
+
+Lemma inj_num_inject: forall j t x, Val.inject j (inj_num t x) (inj_num t x).
+Proof.
+  destruct t; intros; constructor.
+Qed.
+
+Lemma inj_num_opt_wt: forall t x, val_opt_has_rettype (option_map (inj_num t) x) t.
+Proof.
+  intros. destruct x; simpl. apply inj_num_wt. auto. 
+Qed.
+
+Lemma inj_num_opt_inject: forall j t x,
+  val_opt_inject j (option_map (inj_num t) x) (option_map (inj_num t) x).
+Proof.
+  destruct x; simpl. apply inj_num_inject. auto.
+Qed.
+
+Lemma proj_num_wt:
+  forall tres t k1 v,
+  (forall x, Val.has_type (k1 x) tres) ->
+  Val.has_type (proj_num t Vundef v k1) tres.
+Proof.
+  intros. destruct t; simpl; destruct v; auto; exact I.
+Qed.
+
+Lemma proj_num_inject:
+  forall j t k1 v k1' v',
+  (forall x, Val.inject j (k1 x) (k1' x)) ->
+  Val.inject j v v' -> 
+  Val.inject j (proj_num t Vundef v k1) (proj_num t Vundef v' k1').
+Proof.
+  intros. destruct t; simpl; inv H0; auto.
+Qed.
+
+Lemma proj_num_opt_wt:
+  forall (tres: typ) t k0 k1 v,
+  k0 = None \/ k0 = Some Vundef ->
+  (forall x, val_opt_has_rettype (k1 x) tres) ->
+  val_opt_has_rettype (proj_num t k0 v k1) tres.
+Proof.
+  intros.
+  assert (val_opt_has_rettype k0 tres). { destruct H; subst k0; exact I. }
+  destruct t; simpl; destruct v; auto.
+Qed.
+
+Lemma proj_num_opt_inject:
+  forall j k0 t k1 v k1' v',
+  (forall ov, val_opt_inject j k0 ov) ->
+  (forall x, val_opt_inject j (k1 x) (k1' x)) ->
+  Val.inject j v v' -> 
+  val_opt_inject j (proj_num t k0 v k1) (proj_num t k0 v' k1').
+Proof.
+  intros. destruct t; simpl; inv H1; auto.
+Qed.
+
+(** Wrapping numerical functions as built-ins.  The constructor functions
+  have names
+- [mkbuiltin_nNt] for a [t]otal function of [N] numbers, or
+- [mkbuiltin_vNp] for a [p]artial function of [N] numbers.
+ *)
+
+Program Definition mkbuiltin_n1t 
+    (targ1: typ) (tres: typ)
+    (f: valty targ1 -> valty tres) :=
+  mkbuiltin_v1t tres
+    (fun v1 => proj_num targ1 Vundef v1 (fun x => inj_num tres (f x)))
+    _ _.
+Next Obligation.
+  auto using proj_num_wt, inj_num_wt.
+Qed.
+Next Obligation.
+  auto using proj_num_inject, inj_num_inject.
+Qed.
+
+Program Definition mkbuiltin_n2t 
+    (targ1 targ2: typ) (tres: typ)
+    (f: valty targ1 -> valty targ2 -> valty tres) :=
+  mkbuiltin_v2t tres
+    (fun v1 v2 =>
+       proj_num targ1 Vundef v1 (fun x1 =>
+       proj_num targ2 Vundef v2 (fun x2 => inj_num tres (f x1 x2))))
+    _ _.
+Next Obligation.
+  auto using proj_num_wt, inj_num_wt.
+Qed.
+Next Obligation.
+  auto using proj_num_inject, inj_num_inject.
+Qed.
+
+Program Definition mkbuiltin_n3t 
+    (targ1 targ2 targ3: typ) (tres: typ)
+    (f: valty targ1 -> valty targ2 -> valty targ3 -> valty tres) :=
+  mkbuiltin_v3t tres
+    (fun v1 v2 v3 =>
+       proj_num targ1 Vundef v1 (fun x1 =>
+       proj_num targ2 Vundef v2 (fun x2 =>
+       proj_num targ3 Vundef v3 (fun x3 => inj_num tres (f x1 x2 x3)))))
+    _ _.
+Next Obligation.
+  auto using proj_num_wt, inj_num_wt.
+Qed.
+Next Obligation.
+  auto using proj_num_inject, inj_num_inject.
+Qed.
+
+Program Definition mkbuiltin_n1p
+    (targ1: typ) (tres: typ)
+    (f: valty targ1 -> option (valty tres)) :=
+  mkbuiltin_v1p tres
+    (fun v1 => proj_num targ1 None v1 (fun x => option_map (inj_num tres) (f x)))
+    _ _.
+Next Obligation.
+  auto using proj_num_opt_wt, inj_num_opt_wt.
+Qed.
+Next Obligation.
+  apply proj_num_opt_inject; auto. intros; red; auto. intros; apply inj_num_opt_inject.
+Qed.
+
+Program Definition mkbuiltin_n2p
+    (targ1 targ2: typ) (tres: typ)
+    (f: valty targ1 -> valty targ2 -> option (valty tres)) :=
+  mkbuiltin_v2p tres
+    (fun v1 v2 =>
+      proj_num targ1 None v1 (fun x1 =>
+      proj_num targ2 None v2 (fun x2 => option_map (inj_num tres) (f x1 x2))))
+    _ _.
+Next Obligation.
+  auto using proj_num_opt_wt, inj_num_opt_wt.
+Qed.
+Next Obligation.
+  apply proj_num_opt_inject; auto. intros; red; auto. intros.
+  apply proj_num_opt_inject; auto. intros; red; auto. intros.
+  apply inj_num_opt_inject.
+Qed.
+
+(** Looking up builtins by name and signature *)
+
+Section LOOKUP.
+
+Context {A: Type} (sig_of: A -> signature).
+
+Fixpoint lookup_builtin (name: string) (sg: signature) (l: list (string * A)) : option A :=
+  match l with
+  | nil => None
+  | (n, b) :: l =>
+      if string_dec name n && signature_eq sg (sig_of b)
+      then Some b
+      else lookup_builtin name sg l
+  end.
+
+Lemma lookup_builtin_sig: forall name sg b l,
+  lookup_builtin name sg l = Some b -> sig_of b = sg.
+Proof.
+  induction l as [ | [n b'] l ]; simpl; intros.
+- discriminate.
+- destruct (string_dec name n && signature_eq sg (sig_of b')) eqn:E.
++ InvBooleans. congruence.
++ auto.
+Qed.
+
+End LOOKUP.
+
+(** The standard, platform-independent built-ins *)
+
+Inductive standard_builtin : Type :=
+  | BI_select (t: typ)
+  | BI_fabs
+  | BI_fsqrt
+  | BI_negl
+  | BI_addl
+  | BI_subl
+  | BI_mull
+  | BI_i16_bswap
+  | BI_i32_bswap
+  | BI_i64_bswap
+  | BI_i64_umulh
+  | BI_i64_smulh
+  | BI_i64_sdiv
+  | BI_i64_udiv
+  | BI_i64_smod
+  | BI_i64_umod
+  | BI_i64_shl
+  | BI_i64_shr
+  | BI_i64_sar
+  | BI_i64_dtos
+  | BI_i64_dtou
+  | BI_i64_stod
+  | BI_i64_utod
+  | BI_i64_stof
+  | BI_i64_utof.
+
+Local Open Scope string_scope.
+
+Definition standard_builtin_table : list (string * standard_builtin) :=
+    ("__builtin_sel", BI_select Tint)
+ :: ("__builtin_sel", BI_select Tlong)
+ :: ("__builtin_sel", BI_select Tfloat)
+ :: ("__builtin_sel", BI_select Tsingle)
+ :: ("__builtin_fabs", BI_fabs)
+ :: ("__builtin_fsqrt", BI_fsqrt)
+ :: ("__builtin_negl", BI_negl)
+ :: ("__builtin_addl", BI_addl)
+ :: ("__builtin_subl", BI_subl)
+ :: ("__builtin_mull", BI_mull)
+ :: ("__builtin_bswap16", BI_i16_bswap)
+ :: ("__builtin_bswap", BI_i32_bswap)
+ :: ("__builtin_bswap32", BI_i32_bswap)
+ :: ("__builtin_bswap64", BI_i64_bswap)
+ :: ("__compcert_i64_umulh", BI_i64_umulh)
+ :: ("__compcert_i64_smulh", BI_i64_smulh)
+ :: ("__compcert_i64_sdiv", BI_i64_sdiv)
+ :: ("__compcert_i64_udiv", BI_i64_udiv)
+ :: ("__compcert_i64_smod", BI_i64_smod)
+ :: ("__compcert_i64_umod", BI_i64_umod)
+ :: ("__compcert_i64_shl", BI_i64_shl)
+ :: ("__compcert_i64_shr", BI_i64_shr)
+ :: ("__compcert_i64_sar", BI_i64_sar)
+ :: ("__compcert_i64_dtos", BI_i64_dtos)
+ :: ("__compcert_i64_dtou", BI_i64_dtou)
+ :: ("__compcert_i64_stod", BI_i64_stod)
+ :: ("__compcert_i64_utod", BI_i64_utod)
+ :: ("__compcert_i64_stof", BI_i64_stof)
+ :: ("__compcert_i64_utof", BI_i64_utof)
+ :: nil.
+
+Definition standard_builtin_sig (b: standard_builtin) : signature :=
+  match b with
+  | BI_select t =>
+      mksignature (Tint :: t :: t :: nil) t cc_default
+  | BI_fabs | BI_fsqrt =>
+      mksignature (Tfloat :: nil) Tfloat cc_default
+  | BI_negl =>
+      mksignature (Tlong :: nil) Tlong cc_default
+  | BI_addl | BI_subl | BI_i64_umulh| BI_i64_smulh 
+  | BI_i64_sdiv | BI_i64_udiv | BI_i64_smod | BI_i64_umod =>
+      mksignature (Tlong :: Tlong :: nil) Tlong cc_default
+  | BI_mull =>
+      mksignature (Tint :: Tint :: nil) Tlong cc_default
+  | BI_i32_bswap =>
+      mksignature (Tint :: nil) Tint cc_default
+  | BI_i64_bswap =>
+      mksignature (Tlong :: nil) Tlong cc_default
+  | BI_i16_bswap =>
+      mksignature (Tint :: nil) Tint cc_default
+  | BI_i64_shl  | BI_i64_shr | BI_i64_sar =>
+      mksignature (Tlong :: Tint :: nil) Tlong cc_default
+  | BI_i64_dtos | BI_i64_dtou =>
+      mksignature (Tfloat :: nil) Tlong cc_default
+  | BI_i64_stod | BI_i64_utod =>
+      mksignature (Tlong :: nil) Tfloat cc_default
+  | BI_i64_stof | BI_i64_utof =>
+      mksignature (Tlong :: nil) Tsingle cc_default
+  end.
+
+Program Definition standard_builtin_sem (b: standard_builtin) : builtin_sem (sig_res (standard_builtin_sig b)) :=
+  match b with
+  | BI_select t =>
+      mkbuiltin t 
+       (fun vargs => match vargs with
+          | Vint n :: v1 :: v2 :: nil => Some (Val.normalize (if Int.eq n Int.zero then v2 else v1) t)
+          | _ => None
+        end) _ _
+  | BI_fabs => mkbuiltin_n1t Tfloat Tfloat Float.abs
+  | BI_fsqrt => mkbuiltin_n1t Tfloat Tfloat Float.sqrt
+  | BI_negl => mkbuiltin_n1t Tlong Tlong Int64.neg
+  | BI_addl => mkbuiltin_v2t Tlong Val.addl _ _ 
+  | BI_subl => mkbuiltin_v2t Tlong Val.subl _ _
+  | BI_mull => mkbuiltin_v2t Tlong Val.mull' _ _
+  | BI_i16_bswap =>
+    mkbuiltin_n1t Tint Tint
+                  (fun n => Int.repr (decode_int (List.rev (encode_int 2%nat (Int.unsigned n)))))
+  | BI_i32_bswap =>
+    mkbuiltin_n1t Tint Tint
+                  (fun n => Int.repr (decode_int (List.rev (encode_int 4%nat (Int.unsigned n)))))
+  | BI_i64_bswap =>
+    mkbuiltin_n1t Tlong Tlong
+                  (fun n => Int64.repr (decode_int (List.rev (encode_int 8%nat (Int64.unsigned n)))))
+  | BI_i64_umulh => mkbuiltin_n2t Tlong Tlong Tlong Int64.mulhu
+  | BI_i64_smulh => mkbuiltin_n2t Tlong Tlong Tlong Int64.mulhs
+  | BI_i64_sdiv => mkbuiltin_v2p Tlong Val.divls _ _
+  | BI_i64_udiv => mkbuiltin_v2p Tlong Val.divlu _ _
+  | BI_i64_smod => mkbuiltin_v2p Tlong Val.modls _ _
+  | BI_i64_umod => mkbuiltin_v2p Tlong Val.modlu _ _
+  | BI_i64_shl => mkbuiltin_v2t Tlong Val.shll _ _
+  | BI_i64_shr => mkbuiltin_v2t Tlong Val.shrlu _ _
+  | BI_i64_sar => mkbuiltin_v2t Tlong Val.shrl _ _
+  | BI_i64_dtos => mkbuiltin_n1p Tfloat Tlong Float.to_long
+  | BI_i64_dtou => mkbuiltin_n1p Tfloat Tlong Float.to_longu
+  | BI_i64_stod => mkbuiltin_n1t Tlong Tfloat Float.of_long
+  | BI_i64_utod => mkbuiltin_n1t Tlong Tfloat Float.of_longu
+  | BI_i64_stof => mkbuiltin_n1t Tlong Tsingle Float32.of_long
+  | BI_i64_utof => mkbuiltin_n1t Tlong Tsingle Float32.of_longu
+  end.
+Next Obligation. 
+  red. destruct vl; auto. destruct v; auto. 
+  destruct vl; auto. destruct vl; auto. destruct vl; auto.
+  apply Val.normalize_type.
+Qed.
+Next Obligation.
+  red. inv H; auto. inv H0; auto. inv H1; auto. inv H0; auto. inv H2; auto.
+  apply Val.normalize_inject. destruct (Int.eq i Int.zero); auto.
+Qed.
+Next Obligation.
+  unfold Val.addl, Val.has_type; destruct v1; auto; destruct v2; auto; destruct Archi.ptr64; auto.
+Qed.
+Next Obligation.
+  apply Val.addl_inject; auto.
+Qed.   
+Next Obligation.
+  unfold Val.subl, Val.has_type, negb; destruct v1; auto; destruct v2; auto;
+  destruct Archi.ptr64; auto; destruct (eq_block b0 b1); auto.
+Qed.
+Next Obligation.
+  apply Val.subl_inject; auto.
+Qed.
+Next Obligation.
+  unfold Val.mull', Val.has_type; destruct v1; simpl; auto; destruct v2; auto.
+Qed.
+Next Obligation.
+  inv H; simpl; auto. inv H0; auto.
+Qed.
+Next Obligation.
+  red. destruct v1; simpl; auto. destruct v2; auto. destruct orb; exact I.
+Qed.
+Next Obligation.
+  red. inv H; simpl; auto. inv H0; auto. destruct orb; auto.
+Qed.
+Next Obligation.
+  red. destruct v1; simpl; auto. destruct v2; auto. destruct Int64.eq; exact I.
+Qed.
+Next Obligation.
+  red. inv H; simpl; auto. inv H0; auto. destruct Int64.eq; auto.
+Qed.
+Next Obligation.
+  red. destruct v1; simpl; auto. destruct v2; auto. destruct orb; exact I.
+Qed.
+Next Obligation.
+  red. inv H; simpl; auto. inv H0; auto. destruct orb; auto.
+Qed.
+Next Obligation.
+  red. destruct v1; simpl; auto. destruct v2; auto. destruct Int64.eq; exact I.
+Qed.
+Next Obligation.
+  red. inv H; simpl; auto. inv H0; auto. destruct Int64.eq; auto.
+Qed.
+Next Obligation.
+  red. destruct v1; simpl; auto. destruct v2; auto. destruct Int.ltu; auto.
+Qed.
+Next Obligation.
+  inv H; simpl; auto. inv H0; auto. destruct Int.ltu; auto.
+Qed.
+Next Obligation.
+  red. destruct v1; simpl; auto. destruct v2; auto. destruct Int.ltu; auto.
+Qed.
+Next Obligation.
+  inv H; simpl; auto. inv H0; auto. destruct Int.ltu; auto.
+Qed.
+Next Obligation.
+  red. destruct v1; simpl; auto. destruct v2; auto. destruct Int.ltu; auto.
+Qed.
+Next Obligation.
+  inv H; simpl; auto. inv H0; auto. destruct Int.ltu; auto.
+Qed.
+
diff --git a/common/Errors.v b/common/Errors.v
index 28933313..6807735a 100644
--- a/common/Errors.v
+++ b/common/Errors.v
@@ -164,7 +164,7 @@ Ltac monadInv1 H :=
   | (match ?X with left _ => _ | right _ => assertion_failed end = OK _) =>
       destruct X; [try (monadInv1 H) | discriminate]
   | (match (negb ?X) with true => _ | false => assertion_failed end = OK _) =>
-      destruct X as [] eqn:?; [discriminate | try (monadInv1 H)]
+      destruct X as [] eqn:?; simpl negb in H; [discriminate | try (monadInv1 H)]
   | (match ?X with true => _ | false => assertion_failed end = OK _) =>
       destruct X as [] eqn:?; [try (monadInv1 H) | discriminate]
   | (mmap ?F ?L = OK ?M) =>
diff --git a/common/Events.v b/common/Events.v
index b2335b96..28bb992a 100644
--- a/common/Events.v
+++ b/common/Events.v
@@ -24,6 +24,7 @@ Require Import Floats.
 Require Import Values.
 Require Import Memory.
 Require Import Globalenvs.
+Require Import Builtins.
 
 (** * Events and traces *)
 
@@ -622,7 +623,7 @@ Record extcall_properties (sem: extcall_sem) (sg: signature) : Prop :=
   ec_well_typed:
     forall ge vargs m1 t vres m2,
     sem ge vargs m1 t vres m2 ->
-    Val.has_type vres (proj_sig_res sg);
+    Val.has_rettype vres sg.(sig_res);
 
 (** The semantics is invariant under change of global environment that preserves symbols. *)
   ec_symbols_preserved:
@@ -648,9 +649,12 @@ Record extcall_properties (sem: extcall_sem) (sg: signature) : Prop :=
 (** External call cannot modify memory unless they have [Max, Writable]
    permissions. *)
   ec_readonly:
-    forall ge vargs m1 t vres m2,
+    forall ge vargs m1 t vres m2 b ofs n bytes,
     sem ge vargs m1 t vres m2 ->
-    Mem.unchanged_on (loc_not_writable m1) m1 m2;
+    Mem.valid_block m1 b ->
+    Mem.loadbytes m2 b ofs n = Some bytes ->
+    (forall i, ofs <= i < ofs + n -> ~Mem.perm m1 b i Max Writable) ->
+    Mem.loadbytes m1 b ofs n = Some bytes;
 
 (** External calls must commute with memory extensions, in the
   following sense. *)
@@ -770,12 +774,12 @@ Qed.
 Lemma volatile_load_ok:
   forall chunk,
   extcall_properties (volatile_load_sem chunk)
-                     (mksignature (Tptr :: nil) (Some (type_of_chunk chunk)) cc_default).
+                     (mksignature (Tptr :: nil) (rettype_of_chunk chunk) cc_default).
 Proof.
   intros; constructor; intros.
 (* well typed *)
-- unfold proj_sig_res; simpl. inv H. inv H0. apply Val.load_result_type.
-  eapply Mem.load_type; eauto.
+- inv H. inv H0. apply Val.load_result_rettype.
+  eapply Mem.load_rettype; eauto.
 (* symbols *)
 - inv H0. constructor. eapply volatile_load_preserved; eauto.
 (* valid blocks *)
@@ -783,7 +787,7 @@ Proof.
 (* max perms *)
 - inv H; auto.
 (* readonly *)
-- inv H. apply Mem.unchanged_on_refl.
+- inv H; auto.
 (* mem extends *)
 - inv H. inv H1. inv H6. inv H4.
   exploit volatile_load_extends; eauto. intros [v' [A B]].
@@ -832,14 +836,27 @@ Proof.
   rewrite C; auto.
 Qed.
 
+Lemma unchanged_on_readonly:
+  forall m1 m2 b ofs n bytes,
+  Mem.unchanged_on (loc_not_writable m1) m1 m2 ->
+  Mem.valid_block m1 b ->
+  Mem.loadbytes m2 b ofs n = Some bytes ->
+  (forall i, ofs <= i < ofs + n -> ~Mem.perm m1 b i Max Writable) ->
+  Mem.loadbytes m1 b ofs n = Some bytes.
+Proof.
+  intros.
+  rewrite <- H1. symmetry.
+  apply Mem.loadbytes_unchanged_on_1 with (P := loc_not_writable m1); auto.
+Qed.
+
 Lemma volatile_store_readonly:
   forall ge chunk1 m1 b1 ofs1 v t m2,
   volatile_store ge chunk1 m1 b1 ofs1 v t m2 ->
   Mem.unchanged_on (loc_not_writable m1) m1 m2.
 Proof.
   intros. inv H.
-  apply Mem.unchanged_on_refl.
-  eapply Mem.store_unchanged_on; eauto.
+- apply Mem.unchanged_on_refl.
+- eapply Mem.store_unchanged_on; eauto.
   exploit Mem.store_valid_access_3; eauto. intros [P Q].
   intros. unfold loc_not_writable. red; intros. elim H2.
   apply Mem.perm_cur_max. apply P. auto.
@@ -921,7 +938,7 @@ Qed.
 Lemma volatile_store_ok:
   forall chunk,
   extcall_properties (volatile_store_sem chunk)
-                     (mksignature (Tptr :: type_of_chunk chunk :: nil) None cc_default).
+                     (mksignature (Tptr :: type_of_chunk chunk :: nil) Tvoid cc_default).
 Proof.
   intros; constructor; intros.
 (* well typed *)
@@ -933,7 +950,7 @@ Proof.
 (* perms *)
 - inv H. inv H2. auto. eauto with mem.
 (* readonly *)
-- inv H. eapply volatile_store_readonly; eauto.
+- inv H. eapply unchanged_on_readonly; eauto. eapply volatile_store_readonly; eauto.
 (* mem extends*)
 - inv H. inv H1. inv H6. inv H7. inv H4.
   exploit volatile_store_extends; eauto. intros [m2' [A [B C]]].
@@ -966,7 +983,7 @@ Inductive extcall_malloc_sem (ge: Senv.t):
 
 Lemma extcall_malloc_ok:
   extcall_properties extcall_malloc_sem
-                     (mksignature (Tptr :: nil) (Some Tptr) cc_default).
+                     (mksignature (Tptr :: nil) Tptr cc_default).
 Proof.
   assert (UNCHANGED:
     forall (P: block -> Z -> Prop) m lo hi v m' b m'',
@@ -983,7 +1000,7 @@ Proof.
   }
   constructor; intros.
 (* well typed *)
-- inv H. unfold proj_sig_res, Tptr; simpl. destruct Archi.ptr64; auto.
+- inv H. simpl. unfold Tptr; destruct Archi.ptr64; auto.
 (* symbols preserved *)
 - inv H0; econstructor; eauto.
 (* valid block *)
@@ -993,7 +1010,7 @@ Proof.
   rewrite dec_eq_false. auto.
   apply Mem.valid_not_valid_diff with m1; eauto with mem.
 (* readonly *)
-- inv H. eapply UNCHANGED; eauto.
+- inv H. eapply unchanged_on_readonly; eauto. 
 (* mem extends *)
 - inv H. inv H1. inv H7.
   assert (SZ: v2 = Vptrofs sz).
@@ -1044,38 +1061,43 @@ Qed.
 
 Inductive extcall_free_sem (ge: Senv.t):
               list val -> mem -> trace -> val -> mem -> Prop :=
-  | extcall_free_sem_intro: forall b lo sz m m',
+  | extcall_free_sem_ptr: forall b lo sz m m',
       Mem.load Mptr m b (Ptrofs.unsigned lo - size_chunk Mptr) = Some (Vptrofs sz) ->
       Ptrofs.unsigned sz > 0 ->
       Mem.free m b (Ptrofs.unsigned lo - size_chunk Mptr) (Ptrofs.unsigned lo + Ptrofs.unsigned sz) = Some m' ->
-      extcall_free_sem ge (Vptr b lo :: nil) m E0 Vundef m'.
+      extcall_free_sem ge (Vptr b lo :: nil) m E0 Vundef m'
+  | extcall_free_sem_null: forall m,
+      extcall_free_sem ge (Vnullptr :: nil) m E0 Vundef m.
 
 Lemma extcall_free_ok:
   extcall_properties extcall_free_sem
-                     (mksignature (Tptr :: nil) None cc_default).
+                     (mksignature (Tptr :: nil) Tvoid cc_default).
 Proof.
   constructor; intros.
 (* well typed *)
-- inv H. unfold proj_sig_res. simpl. auto.
+- inv H; simpl; auto.
 (* symbols preserved *)
 - inv H0; econstructor; eauto.
 (* valid block *)
-- inv H. eauto with mem.
+- inv H; eauto with mem.
 (* perms *)
-- inv H. eapply Mem.perm_free_3; eauto.
+- inv H; eauto using Mem.perm_free_3.
 (* readonly *)
-- inv H. eapply Mem.free_unchanged_on; eauto.
-  intros. red; intros. elim H3.
+- eapply unchanged_on_readonly; eauto. inv H.
++ eapply Mem.free_unchanged_on; eauto.
+  intros. red; intros. elim H6.
   apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem.
   eapply Mem.free_range_perm; eauto.
++ apply Mem.unchanged_on_refl.
 (* mem extends *)
-- inv H. inv H1. inv H8. inv H6.
+- inv H.
++ inv H1. inv H8. inv H6.
   exploit Mem.load_extends; eauto. intros [v' [A B]].
   assert (v' = Vptrofs sz).
   { unfold Vptrofs in *; destruct Archi.ptr64; inv B; auto. }
   subst v'.
   exploit Mem.free_parallel_extends; eauto. intros [m2' [C D]].
-  exists Vundef; exists m2'; intuition.
+  exists Vundef; exists m2'; intuition auto.
   econstructor; eauto.
   eapply Mem.free_unchanged_on; eauto.
   unfold loc_out_of_bounds; intros.
@@ -1083,8 +1105,14 @@ Proof.
   { apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem.
     eapply Mem.free_range_perm. eexact H4. eauto. }
   tauto.
++ inv H1. inv H5. replace v2 with Vnullptr.
+  exists Vundef; exists m1'; intuition auto.
+  constructor.
+  apply Mem.unchanged_on_refl.
+  unfold Vnullptr in *; destruct Archi.ptr64; inv H3; auto.
 (* mem inject *)
-- inv H0. inv H2. inv H7. inv H9.
+- inv H0.
++ inv H2. inv H7. inv H9.
   exploit Mem.load_inject; eauto. intros [v' [A B]].
   assert (v' = Vptrofs sz).
   { unfold Vptrofs in *; destruct Archi.ptr64; inv B; auto. }
@@ -1098,7 +1126,7 @@ Proof.
   intro EQ.
   exploit Mem.free_parallel_inject; eauto. intros (m2' & C & D).
   exists f, Vundef, m2'; split.
-  apply extcall_free_sem_intro with (sz := sz) (m' := m2').
+  apply extcall_free_sem_ptr with (sz := sz) (m' := m2').
     rewrite EQ. rewrite <- A. f_equal. omega.
     auto. auto.
     rewrite ! EQ. rewrite <- C. f_equal; omega.
@@ -1111,14 +1139,19 @@ Proof.
     apply P. omega.
   split. auto.
   red; intros. congruence.
++ inv H2. inv H6. replace v' with Vnullptr.
+  exists f, Vundef, m1'; intuition auto using Mem.unchanged_on_refl.
+  constructor.
+  red; intros; congruence.
+  unfold Vnullptr in *; destruct Archi.ptr64; inv H4; auto.
 (* trace length *)
 - inv H; simpl; omega.
 (* receptive *)
-- assert (t1 = t2). inv H; inv H0; auto. subst t2.
+- assert (t1 = t2) by (inv H; inv H0; auto). subst t2.
   exists vres1; exists m1; auto.
 (* determ *)
-- inv H; inv H0.
-  assert (EQ1: Vptrofs sz0 = Vptrofs sz) by congruence.
+- inv H; inv H0; try (unfold Vnullptr in *; destruct Archi.ptr64; discriminate).
++ assert (EQ1: Vptrofs sz0 = Vptrofs sz) by congruence.
   assert (EQ2: sz0 = sz).
   { unfold Vptrofs in EQ1; destruct Archi.ptr64 eqn:SF.
     rewrite <- (Ptrofs.of_int64_to_int64 SF sz0), <- (Ptrofs.of_int64_to_int64 SF sz). congruence.
@@ -1126,6 +1159,7 @@ Proof.
   }
   subst sz0.
   split. constructor. intuition congruence.
++ split. constructor. intuition auto.
 Qed.
 
 (** ** Semantics of [memcpy] operations. *)
@@ -1146,11 +1180,11 @@ Inductive extcall_memcpy_sem (sz al: Z) (ge: Senv.t):
 Lemma extcall_memcpy_ok:
   forall sz al,
   extcall_properties (extcall_memcpy_sem sz al)
-                     (mksignature (Tptr :: Tptr :: nil) None cc_default).
+                     (mksignature (Tptr :: Tptr :: nil) Tvoid cc_default).
 Proof.
   intros. constructor.
 - (* return type *)
-  intros. inv H. constructor.
+  intros. inv H. exact I.
 - (* change of globalenv *)
   intros. inv H0. econstructor; eauto.
 - (* valid blocks *)
@@ -1158,8 +1192,9 @@ Proof.
 - (* perms *)
   intros. inv H. eapply Mem.perm_storebytes_2; eauto.
 - (* readonly *)
-  intros. inv H. eapply Mem.storebytes_unchanged_on; eauto.
-  intros; red; intros. elim H8.
+  intros. inv H. eapply unchanged_on_readonly; eauto. 
+  eapply Mem.storebytes_unchanged_on; eauto.
+  intros; red; intros. elim H11.
   apply Mem.perm_cur_max. eapply Mem.storebytes_range_perm; eauto.
 - (* extensions *)
   intros. inv H.
@@ -1208,7 +1243,7 @@ Proof.
   assert (RPDST: Mem.range_perm m1 bdst (Ptrofs.unsigned odst) (Ptrofs.unsigned odst + sz) Cur Nonempty).
     replace sz with (Z.of_nat (length bytes)).
     eapply Mem.range_perm_implies. eapply Mem.storebytes_range_perm; eauto. auto with mem.
-    rewrite LEN. apply nat_of_Z_eq. omega.
+    rewrite LEN. apply Z2Nat.id. omega.
   assert (PSRC: Mem.perm m1 bsrc (Ptrofs.unsigned osrc) Cur Nonempty).
     apply RPSRC. omega.
   assert (PDST: Mem.perm m1 bdst (Ptrofs.unsigned odst) Cur Nonempty).
@@ -1257,7 +1292,7 @@ Inductive extcall_annot_sem (text: string) (targs: list typ) (ge: Senv.t):
 Lemma extcall_annot_ok:
   forall text targs,
   extcall_properties (extcall_annot_sem text targs)
-                     (mksignature targs None cc_default).
+                     (mksignature targs Tvoid cc_default).
 Proof.
   intros; constructor; intros.
 (* well typed *)
@@ -1270,7 +1305,7 @@ Proof.
 (* perms *)
 - inv H; auto.
 (* readonly *)
-- inv H. apply Mem.unchanged_on_refl.
+- inv H; auto.
 (* mem extends *)
 - inv H.
   exists Vundef; exists m1'; intuition.
@@ -1302,11 +1337,11 @@ Inductive extcall_annot_val_sem (text: string) (targ: typ) (ge: Senv.t):
 Lemma extcall_annot_val_ok:
   forall text targ,
   extcall_properties (extcall_annot_val_sem text targ)
-                     (mksignature (targ :: nil) (Some targ) cc_default).
+                     (mksignature (targ :: nil) targ cc_default).
 Proof.
   intros; constructor; intros.
 (* well typed *)
-- inv H. unfold proj_sig_res; simpl. eapply eventval_match_type; eauto.
+- inv H. eapply eventval_match_type; eauto.
 (* symbols *)
 - destruct H as (A & B & C). inv H0. econstructor; eauto.
   eapply eventval_match_preserved; eauto.
@@ -1315,7 +1350,7 @@ Proof.
 (* perms *)
 - inv H; auto.
 (* readonly *)
-- inv H. apply Mem.unchanged_on_refl.
+- inv H; auto.
 (* mem extends *)
 - inv H. inv H1. inv H6.
   exists v2; exists m1'; intuition.
@@ -1346,7 +1381,7 @@ Inductive extcall_debug_sem (ge: Senv.t):
 Lemma extcall_debug_ok:
   forall targs,
   extcall_properties extcall_debug_sem
-                     (mksignature targs None cc_default).
+                     (mksignature targs Tvoid cc_default).
 Proof.
   intros; constructor; intros.
 (* well typed *)
@@ -1358,7 +1393,7 @@ Proof.
 (* perms *)
 - inv H; auto.
 (* readonly *)
-- inv H. apply Mem.unchanged_on_refl.
+- inv H; auto.
 (* mem extends *)
 - inv H.
   exists Vundef; exists m1'; intuition.
@@ -1377,12 +1412,68 @@ Proof.
   split. constructor. auto.
 Qed.
 
+(** ** Semantics of known built-in functions. *)
+
+(** Some built-in functions and runtime support functions have known semantics
+  as defined in the [Builtin] modules.
+  These built-in functions have no observable effects and do not access memory. *)
+
+Inductive known_builtin_sem (bf: builtin_function) (ge: Senv.t):
+              list val -> mem -> trace -> val -> mem -> Prop :=
+  | known_builtin_sem_intro: forall vargs vres m,
+      builtin_function_sem bf vargs = Some vres ->
+      known_builtin_sem bf ge vargs m E0 vres m.
+
+Lemma known_builtin_ok: forall bf,
+  extcall_properties (known_builtin_sem bf) (builtin_function_sig bf).
+Proof.
+  intros. set (bsem := builtin_function_sem bf). constructor; intros.
+(* well typed *)
+- inv H.
+  specialize (bs_well_typed  _ bsem vargs).
+  unfold val_opt_has_rettype, bsem; rewrite H0.
+  auto.
+(* symbols *)
+- inv H0. econstructor; eauto.
+(* valid blocks *)
+- inv H; auto.
+(* perms *)
+- inv H; auto.
+(* readonly *)
+- inv H; auto.
+(* mem extends *)
+- inv H. fold bsem in H2. apply val_inject_list_lessdef in H1.
+  specialize (bs_inject _ bsem _ _ _ H1).
+  unfold val_opt_inject; rewrite H2; intros.
+  destruct (bsem vargs') as [vres'|] eqn:?; try contradiction.
+  exists vres', m1'; intuition auto using Mem.extends_refl, Mem.unchanged_on_refl.
+  constructor; auto.
+  apply val_inject_lessdef; auto.
+(* mem injects *)
+- inv H0. fold bsem in H3.
+  specialize (bs_inject _ bsem _ _ _ H2).
+  unfold val_opt_inject; rewrite H3; intros.
+  destruct (bsem vargs') as [vres'|] eqn:?; try contradiction.
+  exists f, vres', m1'; intuition auto using Mem.extends_refl, Mem.unchanged_on_refl.
+  constructor; auto.
+  red; intros; congruence.
+(* trace length *)
+- inv H; simpl; omega.
+(* receptive *)
+- inv H; inv H0. exists vres1, m1; constructor; auto. 
+(* determ *)
+- inv H; inv H0.
+  split. constructor. intuition congruence. 
+Qed.
+
 (** ** Semantics of external functions. *)
 
-(** For functions defined outside the program ([EF_external],
-  [EF_builtin] and [EF_runtime]), we do not define their
-  semantics, but only assume that it satisfies
-  [extcall_properties]. *)
+(** For functions defined outside the program ([EF_external]),
+  we do not define their semantics, but only assume that it satisfies
+  [extcall_properties].
+  We do the same for built-in functions and runtime support functions that
+  are not described in [Builtins].
+*)
 
 Parameter external_functions_sem: String.string -> signature -> extcall_sem.
 
@@ -1398,6 +1489,22 @@ Axiom inline_assembly_properties:
 
 (** ** Combined semantics of external calls *)
 
+Definition builtin_or_external_sem name sg :=
+  match lookup_builtin_function name sg with
+  | Some bf => known_builtin_sem bf
+  | None => external_functions_sem name sg
+  end.
+
+Lemma builtin_or_external_sem_ok: forall name sg,
+  extcall_properties (builtin_or_external_sem name sg) sg.
+Proof.
+  unfold builtin_or_external_sem; intros. 
+  destruct (lookup_builtin_function name sg) as [bf|] eqn:L.
+- exploit lookup_builtin_function_sig; eauto. intros EQ; subst sg.
+  apply known_builtin_ok.
+- apply external_functions_properties.
+Qed.
+
 (** Combining the semantics given above for the various kinds of external calls,
   we define the predicate [external_call] that relates:
 - the external function being invoked
@@ -1412,8 +1519,8 @@ This predicate is used in the semantics of all CompCert languages. *)
 Definition external_call (ef: external_function): extcall_sem :=
   match ef with
   | EF_external name sg  => external_functions_sem name sg
-  | EF_builtin name sg   => external_functions_sem name sg
-  | EF_runtime name sg   => external_functions_sem name sg
+  | EF_builtin name sg   => builtin_or_external_sem name sg
+  | EF_runtime name sg   => builtin_or_external_sem name sg
   | EF_vload chunk       => volatile_load_sem chunk
   | EF_vstore chunk      => volatile_store_sem chunk
   | EF_malloc            => extcall_malloc_sem
@@ -1431,8 +1538,8 @@ Theorem external_call_spec:
 Proof.
   intros. unfold external_call, ef_sig; destruct ef.
   apply external_functions_properties.
-  apply external_functions_properties.
-  apply external_functions_properties.
+  apply builtin_or_external_sem_ok.
+  apply builtin_or_external_sem_ok.
   apply volatile_load_ok.
   apply volatile_store_ok.
   apply extcall_malloc_ok.
@@ -1444,7 +1551,7 @@ Proof.
   apply extcall_debug_ok.
 Qed.
 
-Definition external_call_well_typed ef := ec_well_typed (external_call_spec ef).
+Definition external_call_well_typed_gen ef := ec_well_typed (external_call_spec ef).
 Definition external_call_symbols_preserved ef := ec_symbols_preserved (external_call_spec ef).
 Definition external_call_valid_block ef := ec_valid_block (external_call_spec ef).
 Definition external_call_max_perm ef := ec_max_perm (external_call_spec ef).
@@ -1455,6 +1562,16 @@ Definition external_call_trace_length ef := ec_trace_length (external_call_spec
 Definition external_call_receptive ef := ec_receptive (external_call_spec ef).
 Definition external_call_determ ef := ec_determ (external_call_spec ef).
 
+(** Corollary of [external_call_well_typed_gen]. *)
+
+Lemma external_call_well_typed:
+  forall ef ge vargs m1 t vres m2,
+  external_call ef ge vargs m1 t vres m2 ->
+  Val.has_type vres (proj_sig_res (ef_sig ef)).
+Proof.
+  intros. apply Val.has_proj_rettype. eapply external_call_well_typed_gen; eauto.
+Qed.
+
 (** Corollary of [external_call_valid_block]. *)
 
 Lemma external_call_nextblock:
diff --git a/common/Globalenvs.v b/common/Globalenvs.v
index d37fbd46..462a4ec1 100644
--- a/common/Globalenvs.v
+++ b/common/Globalenvs.v
@@ -22,10 +22,8 @@
   Global environments, along with the initial memory state at the beginning
   of program execution, are built from the program of interest, as follows:
 - A distinct memory address is assigned to each function of the program.
-  These function addresses use negative numbers to distinguish them from
-  addresses of memory blocks.  The associations of function name to function
-  address and function address to function description are recorded in
-  the global environment.
+  The associations of function name to function address and function address
+  to function description are recorded in the global environment.
 - For each global variable, a memory block is allocated and associated to
   the name of the variable.
 
diff --git a/common/Memdata.v b/common/Memdata.v
index a9ed48b4..f3016efe 100644
--- a/common/Memdata.v
+++ b/common/Memdata.v
@@ -17,6 +17,7 @@
 (** In-memory representation of values. *)
 
 Require Import Coqlib.
+Require Import Zbits.
 Require Archi.
 Require Import AST.
 Require Import Integers.
@@ -50,7 +51,7 @@ Proof.
 Qed.
 
 Definition size_chunk_nat (chunk: memory_chunk) : nat :=
-  nat_of_Z(size_chunk chunk).
+  Z.to_nat(size_chunk chunk).
 
 Lemma size_chunk_conv:
   forall chunk, size_chunk chunk = Z.of_nat (size_chunk_nat chunk).
@@ -258,21 +259,21 @@ Lemma decode_encode_int_4:
   forall x, Int.repr (decode_int (encode_int 4 (Int.unsigned x))) = x.
 Proof.
   intros. rewrite decode_encode_int. transitivity (Int.repr (Int.unsigned x)).
-  decEq. apply Zmod_small. apply Int.unsigned_range. apply Int.repr_unsigned.
+  decEq. apply Z.mod_small. apply Int.unsigned_range. apply Int.repr_unsigned.
 Qed.
 
 Lemma decode_encode_int_8:
   forall x, Int64.repr (decode_int (encode_int 8 (Int64.unsigned x))) = x.
 Proof.
   intros. rewrite decode_encode_int. transitivity (Int64.repr (Int64.unsigned x)).
-  decEq. apply Zmod_small. apply Int64.unsigned_range. apply Int64.repr_unsigned.
+  decEq. apply Z.mod_small. apply Int64.unsigned_range. apply Int64.repr_unsigned.
 Qed.
 
 (** A length-[n] encoding depends only on the low [8*n] bits of the integer. *)
 
 Lemma bytes_of_int_mod:
   forall n x y,
-  Int.eqmod (two_p (Z.of_nat n * 8)) x y ->
+  eqmod (two_p (Z.of_nat n * 8)) x y ->
   bytes_of_int n x = bytes_of_int n y.
 Proof.
   induction n.
@@ -284,7 +285,7 @@ Proof.
   intro EQM.
   simpl; decEq.
   apply Byte.eqm_samerepr. red.
-  eapply Int.eqmod_divides; eauto. apply Z.divide_factor_r.
+  eapply eqmod_divides; eauto. apply Z.divide_factor_r.
   apply IHn.
   destruct EQM as [k EQ]. exists k. rewrite EQ.
   rewrite <- Z_div_plus_full_l. decEq. change (two_p 8) with 256. ring. omega.
@@ -292,7 +293,7 @@ Qed.
 
 Lemma encode_int_8_mod:
   forall x y,
-  Int.eqmod (two_p 8) x y ->
+  eqmod (two_p 8) x y ->
   encode_int 1%nat x = encode_int 1%nat y.
 Proof.
   intros. unfold encode_int. decEq. apply bytes_of_int_mod. auto.
@@ -300,7 +301,7 @@ Qed.
 
 Lemma encode_int_16_mod:
   forall x y,
-  Int.eqmod (two_p 16) x y ->
+  eqmod (two_p 16) x y ->
   encode_int 2%nat x = encode_int 2%nat y.
 Proof.
   intros. unfold encode_int. decEq. apply bytes_of_int_mod. auto.
@@ -546,18 +547,26 @@ Proof.
   destruct v1; auto.
 Qed.
 
-Lemma decode_val_type:
+Lemma decode_val_rettype:
   forall chunk cl,
-  Val.has_type (decode_val chunk cl) (type_of_chunk chunk).
+  Val.has_rettype (decode_val chunk cl) (rettype_of_chunk chunk).
 Proof.
   intros. unfold decode_val.
   destruct (proj_bytes cl).
-  destruct chunk; simpl; auto.
-Local Opaque Val.load_result.
+- destruct chunk; simpl; rewrite ? Int.sign_ext_idem, ? Int.zero_ext_idem by omega; auto.
+- Local Opaque Val.load_result.
   destruct chunk; simpl;
   (exact I || apply Val.load_result_type || destruct Archi.ptr64; (exact I || apply Val.load_result_type)).
 Qed.
 
+Lemma decode_val_type:
+  forall chunk cl,
+  Val.has_type (decode_val chunk cl) (type_of_chunk chunk).
+Proof.
+  intros. rewrite <- proj_rettype_of_chunk.
+  apply Val.has_proj_rettype. apply decode_val_rettype.
+Qed.
+
 Lemma encode_val_int8_signed_unsigned:
   forall v, encode_val Mint8signed v = encode_val Mint8unsigned v.
 Proof.
@@ -606,11 +615,9 @@ Lemma decode_val_cast:
   | _ => True
   end.
 Proof.
-  unfold decode_val; intros; destruct chunk; auto; destruct (proj_bytes l); auto.
-  unfold Val.sign_ext. rewrite Int.sign_ext_idem; auto. omega.
-  unfold Val.zero_ext. rewrite Int.zero_ext_idem; auto. omega.
-  unfold Val.sign_ext. rewrite Int.sign_ext_idem; auto. omega.
-  unfold Val.zero_ext. rewrite Int.zero_ext_idem; auto. omega.
+  intros. 
+  assert (A: Val.has_rettype v (rettype_of_chunk chunk)) by apply decode_val_rettype.
+  destruct chunk; auto; simpl in A; destruct v; try contradiction; simpl; congruence.
 Qed.
 
 (** Pointers cannot be forged. *)
diff --git a/common/Memory.v b/common/Memory.v
index 2cf1c3ab..9f9934c2 100644
--- a/common/Memory.v
+++ b/common/Memory.v
@@ -284,7 +284,7 @@ Lemma valid_access_dec:
 Proof.
   intros.
   destruct (range_perm_dec m b ofs (ofs + size_chunk chunk) Cur p).
-  destruct (Zdivide_dec (align_chunk chunk) ofs (align_chunk_pos chunk)).
+  destruct (Zdivide_dec (align_chunk chunk) ofs).
   left; constructor; auto.
   right; red; intro V; inv V; contradiction.
   right; red; intro V; inv V; contradiction.
@@ -460,7 +460,7 @@ Definition loadv (chunk: memory_chunk) (m: mem) (addr: val) : option val :=
 
 Definition loadbytes (m: mem) (b: block) (ofs n: Z): option (list memval) :=
   if range_perm_dec m b ofs (ofs + n) Cur Readable
-  then Some (getN (nat_of_Z n) ofs (m.(mem_contents)#b))
+  then Some (getN (Z.to_nat n) ofs (m.(mem_contents)#b))
   else None.
 
 (** Memory stores. *)
@@ -682,6 +682,15 @@ Proof.
   apply decode_val_type.
 Qed.
 
+Theorem load_rettype:
+  forall m chunk b ofs v,
+  load chunk m b ofs = Some v ->
+  Val.has_rettype v (rettype_of_chunk chunk).
+Proof.
+  intros. exploit load_result; eauto; intros. rewrite H0.
+  apply decode_val_rettype.
+Qed.
+
 Theorem load_cast:
   forall m chunk b ofs v,
   load chunk m b ofs = Some v ->
@@ -780,7 +789,7 @@ Qed.
 Theorem loadbytes_length:
   forall m b ofs n bytes,
   loadbytes m b ofs n = Some bytes ->
-  length bytes = nat_of_Z n.
+  length bytes = Z.to_nat n.
 Proof.
   unfold loadbytes; intros.
   destruct (range_perm_dec m b ofs (ofs + n) Cur Readable); try congruence.
@@ -791,7 +800,7 @@ Theorem loadbytes_empty:
   forall m b ofs n,
   n <= 0 -> loadbytes m b ofs n = Some nil.
 Proof.
-  intros. unfold loadbytes. rewrite pred_dec_true. rewrite nat_of_Z_neg; auto.
+  intros. unfold loadbytes. rewrite pred_dec_true. rewrite Z_to_nat_neg; auto.
   red; intros. omegaContradiction.
 Qed.
 
@@ -816,8 +825,8 @@ Proof.
   unfold loadbytes; intros.
   destruct (range_perm_dec m b ofs (ofs + n1) Cur Readable); try congruence.
   destruct (range_perm_dec m b (ofs + n1) (ofs + n1 + n2) Cur Readable); try congruence.
-  rewrite pred_dec_true. rewrite nat_of_Z_plus; auto.
-  rewrite getN_concat. rewrite nat_of_Z_eq; auto.
+  rewrite pred_dec_true. rewrite Z2Nat.inj_add by omega.
+  rewrite getN_concat. rewrite Z2Nat.id by omega.
   congruence.
   red; intros.
   assert (ofs0 < ofs + n1 \/ ofs0 >= ofs + n1) by omega.
@@ -836,8 +845,8 @@ Proof.
   unfold loadbytes; intros.
   destruct (range_perm_dec m b ofs (ofs + (n1 + n2)) Cur Readable);
   try congruence.
-  rewrite nat_of_Z_plus in H; auto. rewrite getN_concat in H.
-  rewrite nat_of_Z_eq in H; auto.
+  rewrite Z2Nat.inj_add in H by omega. rewrite getN_concat in H.
+  rewrite Z2Nat.id in H by omega.
   repeat rewrite pred_dec_true.
   econstructor; econstructor.
   split. reflexivity. split. reflexivity. congruence.
@@ -887,11 +896,11 @@ Proof.
   intros (bytes1 & bytes2 & LB1 & LB2 & APP).
   change 4 with (size_chunk Mint32) in LB1.
   exploit loadbytes_load. eexact LB1.
-  simpl. apply Zdivides_trans with 8; auto. exists 2; auto.
+  simpl. apply Z.divide_trans with 8; auto. exists 2; auto.
   intros L1.
   change 4 with (size_chunk Mint32) in LB2.
   exploit loadbytes_load. eexact LB2.
-  simpl. apply Z.divide_add_r. apply Zdivides_trans with 8; auto. exists 2; auto. exists 1; auto.
+  simpl. apply Z.divide_add_r. apply Z.divide_trans with 8; auto. exists 2; auto. exists 1; auto.
   intros L2.
   exists (decode_val Mint32 (if Archi.big_endian then bytes1 else bytes2));
   exists (decode_val Mint32 (if Archi.big_endian then bytes2 else bytes1)).
@@ -1106,7 +1115,7 @@ Proof.
   assert (valid_access m2 chunk b ofs Readable) by eauto with mem.
   unfold loadbytes. rewrite pred_dec_true. rewrite store_mem_contents; simpl.
   rewrite PMap.gss.
-  replace (nat_of_Z (size_chunk chunk)) with (length (encode_val chunk v)).
+  replace (Z.to_nat (size_chunk chunk)) with (length (encode_val chunk v)).
   rewrite getN_setN_same. auto.
   rewrite encode_val_length. auto.
   apply H.
@@ -1127,10 +1136,10 @@ Proof.
   rewrite PMap.gsspec. destruct (peq b' b). subst b'.
   destruct H. congruence.
   destruct (zle n 0) as [z | n0].
-  rewrite (nat_of_Z_neg _ z). auto.
+  rewrite (Z_to_nat_neg _ z). auto.
   destruct H. omegaContradiction.
   apply getN_setN_outside. rewrite encode_val_length. rewrite <- size_chunk_conv.
-  rewrite nat_of_Z_eq. auto. omega.
+  rewrite Z2Nat.id. auto. omega.
   auto.
   red; intros. eauto with mem.
   rewrite pred_dec_false. auto.
@@ -1523,7 +1532,7 @@ Proof.
   destruct (range_perm_dec m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writable);
   try discriminate.
   rewrite pred_dec_true.
-  decEq. inv STORE2; simpl. rewrite PMap.gss. rewrite nat_of_Z_of_nat.
+  decEq. inv STORE2; simpl. rewrite PMap.gss. rewrite Nat2Z.id.
   apply getN_setN_same.
   red; eauto with mem.
 Qed.
@@ -1539,7 +1548,7 @@ Proof.
   rewrite pred_dec_true.
   rewrite storebytes_mem_contents. decEq.
   rewrite PMap.gsspec. destruct (peq b' b). subst b'.
-  apply getN_setN_disjoint. rewrite nat_of_Z_eq; auto. intuition congruence.
+  apply getN_setN_disjoint. rewrite Z2Nat.id by omega. intuition congruence.
   auto.
   red; auto with mem.
   apply pred_dec_false.
@@ -1644,9 +1653,9 @@ Proof.
   rewrite encode_val_length in SB2. simpl in SB2.
   exists m1; split.
   apply storebytes_store. exact SB1.
-  simpl. apply Zdivides_trans with 8; auto. exists 2; auto.
+  simpl. apply Z.divide_trans with 8; auto. exists 2; auto.
   apply storebytes_store. exact SB2.
-  simpl. apply Z.divide_add_r. apply Zdivides_trans with 8; auto. exists 2; auto. exists 1; auto.
+  simpl. apply Z.divide_add_r. apply Z.divide_trans with 8; auto. exists 2; auto. exists 1; auto.
 Qed.
 
 Theorem storev_int64_split:
@@ -1867,7 +1876,7 @@ Proof.
   unfold loadbytes; intros. destruct (range_perm_dec m2 b ofs (ofs + n) Cur Readable); inv H.
   revert H0.
   injection ALLOC; intros A B. rewrite <- A; rewrite <- B; simpl. rewrite PMap.gss.
-  generalize (nat_of_Z n) ofs. induction n0; simpl; intros.
+  generalize (Z.to_nat n) ofs. induction n0; simpl; intros.
   contradiction.
   rewrite ZMap.gi in H0. destruct H0; eauto.
 Qed.
@@ -2342,13 +2351,13 @@ Lemma loadbytes_inj:
 Proof.
   intros. unfold loadbytes in *.
   destruct (range_perm_dec m1 b1 ofs (ofs + len) Cur Readable); inv H0.
-  exists (getN (nat_of_Z len) (ofs + delta) (m2.(mem_contents)#b2)).
+  exists (getN (Z.to_nat len) (ofs + delta) (m2.(mem_contents)#b2)).
   split. apply pred_dec_true.
   replace (ofs + delta + len) with ((ofs + len) + delta) by omega.
   eapply range_perm_inj; eauto with mem.
   apply getN_inj; auto.
-  destruct (zle 0 len). rewrite nat_of_Z_eq; auto. omega.
-  rewrite nat_of_Z_neg. simpl. red; intros; omegaContradiction. omega.
+  destruct (zle 0 len). rewrite Z2Nat.id by omega. auto.
+  rewrite Z_to_nat_neg by omega. simpl. red; intros; omegaContradiction.
 Qed.
 
 (** Preservation of stores. *)
@@ -4340,7 +4349,7 @@ Proof.
 + unfold loadbytes. destruct H.
   destruct (range_perm_dec m b ofs (ofs + n) Cur Readable).
   rewrite pred_dec_true. f_equal.
-  apply getN_exten. intros. rewrite nat_of_Z_eq in H by omega.
+  apply getN_exten. intros. rewrite Z2Nat.id in H by omega.
   apply unchanged_on_contents0; auto.
   red; intros. apply unchanged_on_perm0; auto.
   rewrite pred_dec_false. auto.
diff --git a/common/Memtype.v b/common/Memtype.v
index 03dc1499..ca9c6f1f 100644
--- a/common/Memtype.v
+++ b/common/Memtype.v
@@ -300,6 +300,11 @@ Axiom load_type:
   load chunk m b ofs = Some v ->
   Val.has_type v (type_of_chunk chunk).
 
+Axiom load_rettype:
+  forall m chunk b ofs v,
+  load chunk m b ofs = Some v ->
+  Val.has_rettype v (rettype_of_chunk chunk).
+
 (** For a small integer or float type, the value returned by [load]
   is invariant under the corresponding cast. *)
 Axiom load_cast:
@@ -358,7 +363,7 @@ Axiom load_loadbytes:
 Axiom loadbytes_length:
   forall m b ofs n bytes,
   loadbytes m b ofs n = Some bytes ->
-  length bytes = nat_of_Z n.
+  length bytes = Z.to_nat n.
 
 Axiom loadbytes_empty:
   forall m b ofs n,
diff --git a/common/PrintAST.ml b/common/PrintAST.ml
index e477957a..cf3a17d5 100644
--- a/common/PrintAST.ml
+++ b/common/PrintAST.ml
@@ -27,6 +27,14 @@ let name_of_type = function
   | Tany32 -> "any32"
   | Tany64 -> "any64"
 
+let name_of_rettype = function
+  | Tret t -> name_of_type t
+  | Tvoid -> "void"
+  | Tint8signed -> "int8s"
+  | Tint8unsigned -> "int8u"
+  | Tint16signed -> "int16s"
+  | Tint16unsigned -> "int16u"
+
 let name_of_chunk = function
   | Mint8signed -> "int8s"
   | Mint8unsigned -> "int8u"
diff --git a/common/Sections.ml b/common/Sections.ml
index 30be9e69..839128a5 100644
--- a/common/Sections.ml
+++ b/common/Sections.ml
@@ -160,9 +160,22 @@ let gcc_section name readonly exec =
     sec_writable = not readonly; sec_executable = exec;
     sec_access = Access_default }
 
+(* Check and extract whether a section was given as attribute *)
+
+let get_attr_section loc attr =
+  match Cutil.find_custom_attributes ["section"; "__section__"] attr with
+  | [] -> None
+  | [[C.AString name]] -> Some name
+  | [[_]] ->
+    Diagnostics.error loc "'section' attribute requires a string";
+    None
+  | _ ->
+    Diagnostics.error loc "ambiguous 'section' attribute";
+    None
+
 (* Determine section for a variable definition *)
 
-let for_variable env id ty init =
+let for_variable env loc id ty init =
   let attr = Cutil.attributes_of_type env ty in
   let readonly = List.mem C.AConst attr && not(List.mem C.AVolatile attr) in
   let si =
@@ -170,11 +183,11 @@ let for_variable env id ty init =
       (* 1- Section explicitly associated with #use_section *)
       Hashtbl.find use_section_table id
     with Not_found ->
-      match Cutil.find_custom_attributes ["section"; "__section__"] attr with
-      | [[C.AString name]] ->
+      match get_attr_section loc attr with
+      | Some name ->
         (* 2- Section given as an attribute, gcc-style *)
         gcc_section name readonly false
-      | _ ->
+      | None ->
         (* 3- Default section appropriate for size and const-ness *)
         let size =
           match Cutil.sizeof env ty with Some sz -> sz | None -> max_int in
@@ -190,17 +203,17 @@ let for_variable env id ty init =
 
 (* Determine sections for a function definition *)
 
-let for_function env id attr =
+let for_function env loc id attr =
   let si_code =
     try
       (* 1- Section explicitly associated with #use_section *)
       Hashtbl.find use_section_table id
     with Not_found ->
-      match Cutil.find_custom_attributes ["section"; "__section__"] attr with
-      | [[C.AString name]] ->
+      match get_attr_section loc attr with
+      | Some name ->
           (* 2- Section given as an attribute, gcc-style *)
           gcc_section name true true
-      | _ ->
+      | None ->
           (* 3- Default section *)
           try
             Hashtbl.find current_section_table "CODE"
diff --git a/common/Sections.mli b/common/Sections.mli
index bc97814d..d9fd9239 100644
--- a/common/Sections.mli
+++ b/common/Sections.mli
@@ -46,7 +46,7 @@ val define_section:
          -> ?writable:bool -> ?executable:bool -> ?access:access_mode -> unit -> unit
 val use_section_for: AST.ident -> string -> bool
 
-val for_variable: Env.t -> AST.ident -> C.typ -> bool ->
+val for_variable: Env.t -> C.location -> AST.ident -> C.typ -> bool ->
                                           section_name * access_mode
-val for_function: Env.t -> AST.ident -> C.attributes -> section_name list
+val for_function: Env.t -> C.location -> AST.ident -> C.attributes -> section_name list
 val for_stringlit: unit -> section_name
diff --git a/common/Separation.v b/common/Separation.v
index a9642d72..9aee633f 100644
--- a/common/Separation.v
+++ b/common/Separation.v
@@ -29,7 +29,7 @@
   frame rule; instead, a weak form of the frame rule is provided
   by the lemmas that help us reason about the logical assertions. *)
 
-Require Import Setoid Program.Basics.
+Require Import Setoid Morphisms Program.Basics.
 Require Import Coqlib Decidableplus.
 Require Import AST Integers Values Memory Events Globalenvs.
 
@@ -113,7 +113,36 @@ Proof.
   intros P Q [[A B] [C D]]. split; auto.
 Qed.
 
-Hint Resolve massert_imp_refl massert_eqv_refl.
+Instance massert_imp_eqv_Proper:
+  Proper (massert_eqv ==> massert_eqv ==> iff) massert_imp.
+Proof.
+  intros p q Hpq r s Hrs.
+  split; destruct 1 as [HR1 HR2];
+    constructor; intros;
+      apply Hrs || apply Hpq;
+      apply HR1 || apply HR2;
+      apply Hpq || apply Hrs;
+      assumption.
+Qed.
+
+Hint Resolve massert_imp_refl massert_eqv_refl : core.
+
+Instance footprint_massert_imp_Proper:
+  Proper (massert_imp --> eq ==> eq ==> Basics.impl) m_footprint.
+Proof.
+  destruct 1. repeat intro. subst. intuition.
+Qed.
+
+Instance footprint_massert_eqv_Proper:
+  Proper (massert_eqv ==> eq ==> eq ==> iff) m_footprint.
+Proof.
+  intros P Q HPQ b' b Hbeq ofs' ofs Hoeq.
+  subst.
+  destruct HPQ as [HPQ HQP].
+  split; intro HH.
+  now rewrite HQP.
+  now rewrite HPQ.
+Qed.
 
 (** * Separating conjunction *)
 
@@ -143,6 +172,21 @@ Proof.
 - intuition auto.
 Qed.
 
+Add Morphism disjoint_footprint
+    with signature massert_eqv ==> massert_eqv ==> iff
+    as disjoint_footprint_morph_1.
+Proof.
+  intros p q Hpq r s Hrs.
+  unfold disjoint_footprint.
+  split; intro HH; intros b ofs Hf1 Hf2.
+  - rewrite <-Hpq in Hf1.
+    rewrite <-Hrs in Hf2.
+    now specialize (HH _ _ Hf1 Hf2).
+  - rewrite Hpq in Hf1.
+    rewrite Hrs in Hf2.
+    now specialize (HH _ _ Hf1 Hf2).
+Qed.
+
 Add Morphism sepconj
   with signature massert_eqv ==> massert_eqv ==> massert_eqv
   as sepconj_morph_2.
@@ -161,6 +205,15 @@ Proof.
   intros. rewrite <- H0, <- H1; auto.
 Qed.
 
+Lemma sep_imp':
+  forall P P' Q Q',
+    massert_imp P P' ->
+    massert_imp Q Q' ->
+    massert_imp (P ** Q) (P' ** Q').
+Proof.
+  intros * HP HQ. rewrite HP, HQ. reflexivity.
+Qed.
+
 Lemma sep_comm_1:
   forall P Q,  massert_imp (P ** Q) (Q ** P).
 Proof.
@@ -240,15 +293,17 @@ Proof.
 Qed.
 
 Lemma sep_drop:
-  forall P Q m, m |= P ** Q -> m |= Q.
+  forall P Q, massert_imp (P ** Q) Q.
 Proof.
-  simpl; intros. tauto.
+  constructor.
+  - simpl; intros. tauto.
+  - intros. now constructor 2.
 Qed.
 
 Lemma sep_drop2:
-  forall P Q R m, m |= P ** Q ** R -> m |= P ** R.
+  forall P Q R, massert_imp (P ** Q ** R) (P ** R).
 Proof.
-  intros. rewrite sep_swap in H. eapply sep_drop; eauto.
+  intros. rewrite sep_swap, sep_drop. reflexivity.
 Qed.
 
 Lemma sep_proj1:
@@ -259,7 +314,9 @@ Qed.
 
 Lemma sep_proj2:
   forall P Q m, m |= P ** Q -> m |= Q.
-Proof sep_drop.
+Proof.
+  apply sep_drop.
+Qed.
 
 Definition sep_pick1 := sep_proj1.
 
@@ -315,19 +372,40 @@ Proof.
   simpl; intros. intuition auto. red; simpl; tauto.
 Qed.
 
-(** A range of bytes, with full permissions and unspecified contents. *)
+Lemma sep_pure':
+  forall P m, m |= pure P <-> P.
+Proof.
+  simpl; intros. intuition auto. 
+Qed.
+
+(** A range of bytes with given permissions unspecified contents *)
 
-Program Definition range (b: block) (lo hi: Z) : massert := {|
+Program Definition range' (p: permission) (b: block) (lo hi: Z) : massert := {|
   m_pred := fun m =>
        0 <= lo /\ hi <= Ptrofs.modulus
-    /\ (forall i k p, lo <= i < hi -> Mem.perm m b i k p);
+    /\ (forall i k, lo <= i < hi -> Mem.perm m b i k p);
   m_footprint := fun b' ofs' => b' = b /\ lo <= ofs' < hi
 |}.
 Next Obligation.
   split; auto. split; auto. intros. eapply Mem.perm_unchanged_on; eauto. simpl; auto.
 Qed.
 Next Obligation.
-  apply Mem.perm_valid_block with ofs Cur Freeable; auto.
+  eapply Mem.perm_valid_block with ofs Cur _; auto.
+Qed.
+
+Notation range := (range' Freeable).
+Notation range_w := (range' Writable).
+
+Lemma range'_imp:
+  forall p p' b lo hi,
+    perm_order p p' ->
+    massert_imp (range' p b lo hi) (range' p' b lo hi).
+Proof.
+  constructor; auto.
+  destruct 1 as (Hlo & Hhi & Hperm).
+  repeat split; auto.
+  intros i k Hoff.
+  eapply Mem.perm_implies; eauto.
 Qed.
 
 Lemma alloc_rule:
@@ -346,47 +424,95 @@ Proof.
   eelim Mem.fresh_block_alloc; eauto. eapply (m_valid P); eauto.
 Qed.
 
+Lemma free_rule:
+forall P m b lo hi,
+  m |= range b lo hi ** P ->
+  exists m',
+    Mem.free m b lo hi = Some m' /\ m' |= P.
+Proof.
+  intros P m b lo hi Hr.
+  destruct Hr as ((Hlo & Hhi & Hperm) & HP & Hdj).
+  assert (Mem.range_perm m b lo hi Cur Freeable) as Hrp
+    by (intros ? ?; now apply Hperm).
+  apply Mem.range_perm_free in Hrp.
+  destruct Hrp as (m2 & Hfree).
+  exists m2.
+  split; [assumption|].
+  apply Mem.free_unchanged_on with (P:=m_footprint P) in Hfree.
+  now apply m_invar with (1:=HP) (2:=Hfree).
+  intros i Hr HfP.
+  apply Hdj with (2:=HfP).
+  now split.
+Qed.
+
+Lemma range_split':
+  forall p b lo hi mid,
+    lo <= mid <= hi ->
+    massert_eqv (range' p b lo hi)
+                (range' p b lo mid ** range' p b mid hi).
+Proof.
+  intros * HR.
+  constructor; constructor.
+  - intros m HH.
+    inversion HH as [Hlo [Hhi Hperm]].
+    split; constructor; repeat split.
+    + assumption.
+    + omega.
+    + intros. apply Hperm. omega.
+    + omega.
+    + exact Hhi.
+    + intros. apply Hperm. omega.
+    + red; simpl; intros; omega.
+  - intros. simpl in *. intuition.
+  - intros m HH.
+    inversion_clear HH as [Hlm [Hmh Hdisj]].
+    inversion_clear Hlm as [Hlo [Hmid Hperm]].
+    inversion_clear Hmh as [Hmid' [Hhi Hperm']].
+    constructor; repeat split.
+    + assumption.
+    + assumption.
+    + intros i k Hi.
+      destruct (Z.lt_ge_cases i mid); intuition.
+  - intros * Hfoot. simpl in *.
+    destruct (Z.lt_ge_cases ofs mid); intuition.
+Qed.
+
 Lemma range_split:
-  forall b lo hi P mid m,
+  forall p b lo hi P mid m,
   lo <= mid <= hi ->
-  m |= range b lo hi ** P ->
-  m |= range b lo mid ** range b mid hi ** P.
+  m |= range' p b lo hi ** P ->
+  m |= range' p b lo mid ** range' p b mid hi ** P.
 Proof.
-  intros. rewrite <- sep_assoc. eapply sep_imp; eauto.
-  split; simpl; intros.
-- intuition auto.
-+ omega.
-+ apply H5; omega.
-+ omega.
-+ apply H5; omega.
-+ red; simpl; intros; omega.
-- intuition omega.
+  intros.
+  rewrite <-sep_assoc.
+  rewrite range_split' with (1:=H) in H0.
+  assumption.
 Qed.
 
 Lemma range_drop_left:
-  forall b lo hi P mid m,
+  forall p b lo hi P mid m,
   lo <= mid <= hi ->
-  m |= range b lo hi ** P ->
-  m |= range b mid hi ** P.
+  m |= range' p b lo hi ** P ->
+  m |= range' p b mid hi ** P.
 Proof.
-  intros. apply sep_drop with (range b lo mid). apply range_split; auto.
+  intros. apply sep_drop with (range' p b lo mid). apply range_split; auto.
 Qed.
 
 Lemma range_drop_right:
-  forall b lo hi P mid m,
+  forall p b lo hi P mid m,
   lo <= mid <= hi ->
-  m |= range b lo hi ** P ->
-  m |= range b lo mid ** P.
+  m |= range' p b lo hi ** P ->
+  m |= range' p b lo mid ** P.
 Proof.
-  intros. apply sep_drop2 with (range b mid hi). apply range_split; auto.
+  intros. apply sep_drop2 with (range' p b mid hi). apply range_split; auto.
 Qed.
 
 Lemma range_split_2:
-  forall b lo hi P mid al m,
+  forall p b lo hi P mid al m,
   lo <= align mid al <= hi ->
   al > 0 ->
-  m |= range b lo hi ** P ->
-  m |= range b lo mid ** range b (align mid al) hi ** P.
+  m |= range' p b lo hi ** P ->
+  m |= range' p b lo mid ** range' p b (align mid al) hi ** P.
 Proof.
   intros. rewrite <- sep_assoc. eapply sep_imp; eauto.
   assert (mid <= align mid al) by (apply align_le; auto).
@@ -401,67 +527,89 @@ Proof.
 Qed.
 
 Lemma range_preserved:
-  forall m m' b lo hi,
-  m |= range b lo hi ->
+  forall p m m' b lo hi,
+  m |= range' p b lo hi ->
   (forall i k p, lo <= i < hi -> Mem.perm m b i k p -> Mem.perm m' b i k p) ->
-  m' |= range b lo hi.
+  m' |= range' p b lo hi.
 Proof.
   intros. destruct H as (A & B & C). simpl; intuition auto.
 Qed.
 
-(** A memory area that contains a value sastifying a given predicate *)
+(** A memory area that contains a value satisfying a given predicate. *)
 
-Program Definition contains (chunk: memory_chunk) (b: block) (ofs: Z) (spec: val -> Prop) : massert := {|
+Program Definition contains' (p: permission) (chunk: memory_chunk) (b: block) (ofs: Z) (spec: val -> Prop) : massert := {|
   m_pred := fun m =>
-       0 <= ofs <= Ptrofs.max_unsigned
-    /\ Mem.valid_access m chunk b ofs Freeable
+       0 <= ofs /\ ofs + size_chunk chunk <= Ptrofs.modulus
+    /\ Mem.valid_access m chunk b ofs p
     /\ exists v, Mem.load chunk m b ofs = Some v /\ spec v;
   m_footprint := fun b' ofs' => b' = b /\ ofs <= ofs' < ofs + size_chunk chunk
 |}.
 Next Obligation.
-  rename H2 into v. split;[|split].
+  rename H3 into v. split;[|split;[|split]].
+- auto.
 - auto.
-- destruct H1; split; auto. red; intros; eapply Mem.perm_unchanged_on; eauto. simpl; auto.
+- destruct H2; split; auto. red; intros; eapply Mem.perm_unchanged_on; eauto. simpl; auto.
 - exists v. split; auto. eapply Mem.load_unchanged_on; eauto. simpl; auto.
 Qed.
 Next Obligation.
   eauto with mem.
 Qed.
 
+Notation contains := (contains' Freeable).
+Notation contains_w := (contains' Writable).
+
+Lemma contains'_imp:
+  forall p p' chunk b ofs spec,
+    perm_order p p' ->
+    massert_imp (contains' p chunk b ofs spec) (contains' p' chunk b ofs spec).
+Proof.
+  constructor; auto.
+  inversion 1 as (Hlo & Hhi & Hac & v & Hload & Hspec).
+  eapply Mem.valid_access_implies in Hac; eauto.
+  repeat (split; eauto).
+Qed.
+  
 Lemma contains_no_overflow:
-  forall spec m chunk b ofs,
-  m |= contains chunk b ofs spec ->
+  forall p spec m chunk b ofs,
+  m |= contains' p chunk b ofs spec ->
   0 <= ofs <= Ptrofs.max_unsigned.
 Proof.
-  intros. simpl in H. tauto.
+  intros. simpl in H.
+  destruct H as (H1 & H2 & H3).
+  split; [assumption|].
+  generalize (size_chunk_pos chunk).
+  unfold Ptrofs.max_unsigned. omega.
 Qed.
 
 Lemma load_rule:
-  forall spec m chunk b ofs,
-  m |= contains chunk b ofs spec ->
+  forall p spec m chunk b ofs,
+  perm_order p Readable ->
+  m |= contains' p chunk b ofs spec ->
   exists v, Mem.load chunk m b ofs = Some v /\ spec v.
 Proof.
-  intros. destruct H as (D & E & v & F & G).
+  intros * Hp Hc. destruct Hc as (D & E & F & v & G & H).
   exists v; auto.
 Qed.
 
 Lemma loadv_rule:
-  forall spec m chunk b ofs,
-  m |= contains chunk b ofs spec ->
+  forall p spec m chunk b ofs,
+  perm_order p Readable ->
+  m |= contains' p chunk b ofs spec ->
   exists v, Mem.loadv chunk m (Vptr b (Ptrofs.repr ofs)) = Some v /\ spec v.
 Proof.
-  intros. exploit load_rule; eauto. intros (v & A & B). exists v; split; auto.
+  intros. exploit load_rule; eauto with mem. intros (v & A & B). exists v; split; auto.
   simpl. rewrite Ptrofs.unsigned_repr; auto. eapply contains_no_overflow; eauto.
 Qed.
 
 Lemma store_rule:
-  forall chunk m b ofs v (spec1 spec: val -> Prop) P,
-  m |= contains chunk b ofs spec1 ** P ->
+  forall p chunk m b ofs v (spec1 spec: val -> Prop) P,
+  perm_order p Writable ->
+  m |= contains' p chunk b ofs spec1 ** P ->
   spec (Val.load_result chunk v) ->
   exists m',
-  Mem.store chunk m b ofs v = Some m' /\ m' |= contains chunk b ofs spec ** P.
+  Mem.store chunk m b ofs v = Some m' /\ m' |= contains' p chunk b ofs spec ** P.
 Proof.
-  intros. destruct H as (A & B & C). destruct A as (D & E & v0 & F & G).
+  intros * Hp Hc Hs. destruct Hc as (A & B & C). destruct A as (D & E & v0 & F & G).
   assert (H: Mem.valid_access m chunk b ofs Writable) by eauto with mem.
   destruct (Mem.valid_access_store _ _ _ _ v H) as [m' STORE].
   exists m'; split; auto. simpl. intuition auto.
@@ -473,64 +621,132 @@ Proof.
 Qed.
 
 Lemma storev_rule:
-  forall chunk m b ofs v (spec1 spec: val -> Prop) P,
-  m |= contains chunk b ofs spec1 ** P ->
+  forall p chunk m b ofs v (spec1 spec: val -> Prop) P,
+  perm_order p Writable ->
+  m |= contains' p chunk b ofs spec1 ** P ->
   spec (Val.load_result chunk v) ->
   exists m',
-  Mem.storev chunk m (Vptr b (Ptrofs.repr ofs)) v = Some m' /\ m' |= contains chunk b ofs spec ** P.
+  Mem.storev chunk m (Vptr b (Ptrofs.repr ofs)) v = Some m' /\ m' |= contains' p chunk b ofs spec ** P.
 Proof.
   intros. exploit store_rule; eauto. intros (m' & A & B). exists m'; split; auto.
   simpl. rewrite Ptrofs.unsigned_repr; auto. eapply contains_no_overflow. eapply sep_pick1; eauto.
 Qed.
 
-Lemma range_contains:
-  forall chunk b ofs P m,
-  m |= range b ofs (ofs + size_chunk chunk) ** P ->
-  (align_chunk chunk | ofs) ->
-  m |= contains chunk b ofs (fun v => True) ** P.
+Lemma storev_rule2:
+  forall p chunk m m' b ofs v (spec1 spec: val -> Prop) P,
+    perm_order p Writable ->
+    m |= contains' p chunk b ofs spec1 ** P ->
+    spec (Val.load_result chunk v) ->
+    Memory.Mem.storev chunk m (Vptr b (Ptrofs.repr ofs)) v = Some m' ->
+    m' |= contains' p chunk b ofs spec ** P.
 Proof.
-  intros. destruct H as (A & B & C). destruct A as (D & E & F).
-  split; [|split].
-- assert (Mem.valid_access m chunk b ofs Freeable).
+  intros * Hp Hm Hspec Hstore.
+  eapply storev_rule with (2:=Hm) in Hspec; eauto.
+  destruct Hspec as [m'' [Hmem Hspec]].
+  rewrite Hmem in Hstore. injection Hstore.
+  intro; subst. assumption.
+Qed.
+
+Lemma range_contains':
+  forall p chunk b ofs,
+    perm_order p Readable ->
+    (align_chunk chunk | ofs) ->
+    massert_imp (range' p b ofs (ofs + size_chunk chunk))
+                (contains' p chunk b ofs (fun v => True)).
+Proof.
+  intros. constructor.
+  intros * Hr. destruct Hr as (D & E & F).
+  assert (Mem.valid_access m chunk b ofs p).
   { split; auto. red; auto. }
-  split. generalize (size_chunk_pos chunk). unfold Ptrofs.max_unsigned. omega.
-  split. auto.
-+ destruct (Mem.valid_access_load m chunk b ofs) as [v LOAD].
+  split; [|split].
+- generalize (size_chunk_pos chunk). omega.
+- assumption.
+- split; [assumption|].
+  destruct (Mem.valid_access_load m chunk b ofs) as [v LOAD].
   eauto with mem.
   exists v; auto.
 - auto.
-- auto.
+Qed.
+
+Lemma range_contains:
+  forall p chunk b ofs P m,
+  perm_order p Readable ->
+  m |= range' p b ofs (ofs + size_chunk chunk) ** P ->
+  (align_chunk chunk | ofs) ->
+  m |= contains' p chunk b ofs (fun v => True) ** P.
+Proof.
+  intros * Hp Hr Hc.
+  rewrite range_contains' in Hr; assumption.
+Qed.
+
+Lemma contains_range':
+  forall p chunk b ofs spec,
+    massert_imp (contains' p chunk b ofs spec)
+                (range' p b ofs (ofs + size_chunk chunk)).
+Proof.
+  intros.
+  split.
+- intros. destruct H as (A & B & C & D).
+  split; [|split]; try assumption.
+  destruct C as (C1 & C2).
+  intros i k Hr.
+  specialize (C1 _ Hr).
+  eauto with mem.
+- trivial.
+Qed.
+
+Lemma contains_range:
+  forall p chunk b ofs spec P m,
+  m |= contains' p chunk b ofs spec ** P ->
+  m |= range' p b ofs (ofs + size_chunk chunk) ** P.
+Proof.
+  intros.
+  rewrite contains_range' in H; assumption.
 Qed.
 
 Lemma contains_imp:
-  forall (spec1 spec2: val -> Prop) chunk b ofs,
+  forall p (spec1 spec2: val -> Prop) chunk b ofs,
   (forall v, spec1 v -> spec2 v) ->
-  massert_imp (contains chunk b ofs spec1) (contains chunk b ofs spec2).
+  massert_imp (contains' p chunk b ofs spec1) (contains' p chunk b ofs spec2).
 Proof.
   intros; split; simpl; intros.
 - intuition auto. destruct H4 as (v & A & B). exists v; auto.
 - auto.
 Qed.
 
-(** A memory area that contains a given value *)
+(** A memory area that contains a given value. *)
 
-Definition hasvalue (chunk: memory_chunk) (b: block) (ofs: Z) (v: val) : massert :=
-  contains chunk b ofs (fun v' => v' = v).
+Definition hasvalue' (p: permission) (chunk: memory_chunk) (b: block) (ofs: Z) (v: val) : massert :=
+  contains' p chunk b ofs (fun v' => v' = v).
+
+Notation hasvalue := (hasvalue' Freeable).
+Notation hasvalue_w := (hasvalue' Writable).
+
+Lemma hasvalue'_imp:
+  forall p p' chunk b ofs v,
+    perm_order p p' ->
+    massert_imp (hasvalue' p chunk b ofs v) (hasvalue' p' chunk b ofs v).
+Proof.
+  constructor; auto.
+  now apply contains'_imp.
+Qed.
 
 Lemma store_rule':
-  forall chunk m b ofs v (spec1: val -> Prop) P,
-  m |= contains chunk b ofs spec1 ** P ->
+  forall p chunk m b ofs v (spec1: val -> Prop) P,
+  perm_order p Writable ->
+  m |= contains' p chunk b ofs spec1 ** P ->
   exists m',
-  Mem.store chunk m b ofs v = Some m' /\ m' |= hasvalue chunk b ofs (Val.load_result chunk v) ** P.
+  Mem.store chunk m b ofs v = Some m' /\ m' |= hasvalue' p chunk b ofs (Val.load_result chunk v) ** P.
 Proof.
   intros. eapply store_rule; eauto.
 Qed.
 
 Lemma storev_rule':
-  forall chunk m b ofs v (spec1: val -> Prop) P,
-  m |= contains chunk b ofs spec1 ** P ->
+  forall p chunk m b ofs v (spec1: val -> Prop) P,
+  perm_order p Writable ->
+  m |= contains' p chunk b ofs spec1 ** P ->
   exists m',
-  Mem.storev chunk m (Vptr b (Ptrofs.repr ofs)) v = Some m' /\ m' |= hasvalue chunk b ofs (Val.load_result chunk v) ** P.
+  Mem.storev chunk m (Vptr b (Ptrofs.repr ofs)) v = Some m' /\ m' |= hasvalue' p chunk b ofs (Val.load_result chunk v) ** P.
 Proof.
   intros. eapply storev_rule; eauto.
 Qed.
@@ -702,7 +918,7 @@ Proof.
 - intros. assert (0 <= ofs < sz2) by (eapply Mem.perm_alloc_3; eauto). omega.
 - intros. apply Mem.perm_implies with Freeable; auto with mem.
   eapply Mem.perm_alloc_2; eauto. xomega.
-- red; intros. apply Zdivides_trans with 8; auto.
+- red; intros. apply Z.divide_trans with 8; auto.
   exists (8 / align_chunk chunk). destruct chunk; reflexivity.
 - intros. elim FRESH2. eapply Mem.valid_block_inject_2; eauto.
 - intros (j' & INJ' & J1 & J2 & J3).
diff --git a/common/Smallstep.v b/common/Smallstep.v
index c269013b..27ad0a2d 100644
--- a/common/Smallstep.v
+++ b/common/Smallstep.v
@@ -872,6 +872,14 @@ Proof.
   intros. eapply sd_determ; eauto.
 Qed.
 
+Lemma sd_determ_3:
+  forall s t s1 s2,
+  Step L s t s1 -> Step L s E0 s2 -> t = E0 /\ s1 = s2.
+Proof.
+  intros. exploit (sd_determ DET). eexact H. eexact H0.
+  intros [A B]. inv A. auto.
+Qed.
+
 Lemma star_determinacy:
   forall s t s', Star L s t s' ->
   forall s'', Star L s t s'' -> Star L s' E0 s'' \/ Star L s'' E0 s'.
@@ -895,6 +903,171 @@ Qed.
 
 End DETERMINACY.
 
+(** Extra simulation diagrams for determinate languages. *)
+
+Section FORWARD_SIMU_DETERM.
+
+Variable L1: semantics.
+Variable L2: semantics.
+
+Hypothesis L1det: determinate L1.
+
+Variable index: Type.
+Variable order: index -> index -> Prop.
+Hypothesis wf_order: well_founded order.
+
+Variable match_states: index -> state L1 -> state L2 -> Prop.
+
+Hypothesis match_initial_states:
+  forall s1, initial_state L1 s1 ->
+  exists i s2, initial_state L2 s2 /\ match_states i s1 s2.
+
+Hypothesis match_final_states:
+  forall i s1 s2 r,
+  match_states i s1 s2 ->
+  final_state L1 s1 r ->
+  final_state L2 s2 r.
+
+Hypothesis simulation:
+  forall s1 t s1', Step L1 s1 t s1' ->
+  forall i s2, match_states i s1 s2 ->
+  exists s1'' i' s2',
+      Star L1 s1' E0 s1''
+   /\ (Plus L2 s2 t s2' \/ (Star L2 s2 t s2' /\ order i' i))
+   /\ match_states i' s1'' s2'.
+
+Hypothesis public_preserved:
+  forall id, Senv.public_symbol (symbolenv L2) id = Senv.public_symbol (symbolenv L1) id.
+
+Inductive match_states_later: index * nat -> state L1 -> state L2 -> Prop :=
+| msl_now: forall i s1 s2,
+    match_states i s1 s2 -> match_states_later (i, O) s1 s2
+| msl_later: forall i n s1 s1' s2,
+    Step L1 s1 E0 s1' -> match_states_later (i, n) s1' s2 -> match_states_later (i, S n) s1 s2.
+
+Lemma star_match_states_later:
+  forall s1 s1', Star L1 s1 E0 s1' ->
+  forall i s2, match_states i s1' s2 ->
+  exists n, match_states_later (i, n) s1 s2.
+Proof.
+  intros s10 s10' STAR0. pattern s10, s10'; eapply star_E0_ind; eauto.
+  - intros s1 i s2 M. exists O; constructor; auto.
+  - intros s1 s1' s1'' STEP IH i s2 M.
+    destruct (IH i s2 M) as (n & MS).
+    exists (S n); econstructor; eauto.
+Qed.
+
+Lemma forward_simulation_determ: forward_simulation L1 L2.
+Proof.
+  apply Forward_simulation with (order0 := lex_ord order lt) (match_states0 := match_states_later);
+  constructor.
+- apply wf_lex_ord. apply wf_order. apply lt_wf.
+- intros. exploit match_initial_states; eauto. intros (i & s2 & A & B).
+  exists (i, O), s2; auto using msl_now.
+- intros. inv H.
+  + eapply match_final_states; eauto.
+  + eelim (sd_final_nostep L1det); eauto.
+- intros s1 t s1' A; destruct 1.
+  + exploit simulation; eauto. intros (s1'' & i' & s2' & B & C & D).
+    exploit star_match_states_later; eauto. intros (n & E).
+    exists (i', n), s2'; split; auto.
+    destruct C as [P | [P Q]]; auto using lex_ord_left.
+  + exploit sd_determ_3. eauto. eexact A. eauto. intros [P Q]; subst t s1'0.
+    exists (i, n), s2; split; auto.
+    right; split. apply star_refl. apply lex_ord_right. omega.
+- exact public_preserved.
+Qed.
+
+End FORWARD_SIMU_DETERM.
+
+(** A few useful special cases. *)
+
+Section FORWARD_SIMU_DETERM_DIAGRAMS.
+
+Variable L1: semantics.
+Variable L2: semantics.
+
+Hypothesis L1det: determinate L1.
+
+Variable match_states: state L1 -> state L2 -> Prop.
+
+Hypothesis public_preserved:
+  forall id, Senv.public_symbol (symbolenv L2) id = Senv.public_symbol (symbolenv L1) id.
+
+Hypothesis match_initial_states:
+  forall s1, initial_state L1 s1 ->
+  exists s2, initial_state L2 s2 /\ match_states s1 s2.
+
+Hypothesis match_final_states:
+  forall s1 s2 r,
+  match_states s1 s2 ->
+  final_state L1 s1 r ->
+  final_state L2 s2 r.
+
+Section SIMU_DETERM_STAR.
+
+Variable measure: state L1 -> nat.
+
+Hypothesis simulation:
+  forall s1 t s1', Step L1 s1 t s1' ->
+  forall s2, match_states s1 s2 ->
+  exists s1'' s2',
+      Star L1 s1' E0 s1''
+   /\ (Plus L2 s2 t s2' \/ (Star L2 s2 t s2' /\ measure s1'' < measure s1))%nat
+   /\ match_states s1'' s2'.
+
+Lemma forward_simulation_determ_star: forward_simulation L1 L2.
+Proof.
+  apply forward_simulation_determ with
+    (match_states := fun i s1 s2 => i = s1 /\ match_states s1 s2)
+    (order := ltof _ measure).
+- assumption.
+- apply well_founded_ltof.
+- intros. exploit match_initial_states; eauto. intros (s2 & A & B). 
+  exists s1, s2; auto.
+- intros. destruct H. eapply match_final_states; eauto.
+- intros. destruct H0; subst i. 
+  exploit simulation; eauto. intros (s1'' & s2' & A & B & C).
+  exists s1'', s1'', s2'. auto.
+- assumption.
+Qed.
+
+End SIMU_DETERM_STAR.
+
+Section SIMU_DETERM_PLUS.
+
+Hypothesis simulation:
+  forall s1 t s1', Step L1 s1 t s1' ->
+  forall s2, match_states s1 s2 ->
+  exists s1'' s2', Star L1 s1' E0 s1'' /\ Plus L2 s2 t s2' /\ match_states s1'' s2'.
+
+Lemma forward_simulation_determ_plus: forward_simulation L1 L2.
+Proof.
+  apply forward_simulation_determ_star with (measure := fun _ => O).
+  intros. exploit simulation; eauto. intros (s1'' & s2' & A & B & C).
+  exists s1'', s2'; auto.
+Qed.
+
+End SIMU_DETERM_PLUS.
+
+Section SIMU_DETERM_ONE.
+
+Hypothesis simulation:
+  forall s1 t s1', Step L1 s1 t s1' ->
+  forall s2, match_states s1 s2 ->
+  exists s1'' s2', Star L1 s1' E0 s1'' /\ Step L2 s2 t s2' /\ match_states s1'' s2'.
+
+Lemma forward_simulation_determ_one: forward_simulation L1 L2.
+Proof.
+  apply forward_simulation_determ_plus.
+  intros. exploit simulation; eauto. intros (s1'' & s2' & A & B & C).
+  exists s1'', s2'; auto using plus_one.
+Qed.
+
+End SIMU_DETERM_ONE.
+
+End FORWARD_SIMU_DETERM_DIAGRAMS.
+
 (** * Backward simulations between two transition semantics. *)
 
 Definition safe (L: semantics) (s: state L) : Prop :=
diff --git a/common/Switch.v b/common/Switch.v
index 0ef91d60..5a6d4c63 100644
--- a/common/Switch.v
+++ b/common/Switch.v
@@ -288,10 +288,10 @@ Lemma validate_jumptable_correct:
 Proof.
   intros.
   rewrite (validate_jumptable_correct_rec cases tbl ofs); auto.
-- f_equal. f_equal. rewrite Zmod_small. omega.
+- f_equal. f_equal. rewrite Z.mod_small. omega.
   destruct (zle ofs v). omega.
   assert (M: ((v - ofs) + 1 * modulus) mod modulus = (v - ofs) + modulus).
-  { rewrite Zmod_small. omega. omega. }
+  { rewrite Z.mod_small. omega. omega. }
   rewrite Z_mod_plus in M by auto. rewrite M in H0. omega.
 - generalize (Z_mod_lt (v - ofs) modulus modulus_pos). omega.
 Qed.
@@ -331,7 +331,7 @@ Proof.
   rewrite (split_between_prop v _ _ _ _ _ _ EQ).
   assert (0 <= (v - ofs) mod modulus < modulus) by (apply Z_mod_lt; omega).
   destruct (zlt ((v - ofs) mod modulus) sz).
-  rewrite Zmod_small by omega. eapply validate_jumptable_correct; eauto.
+  rewrite Z.mod_small by omega. eapply validate_jumptable_correct; eauto.
   eapply IHt; eauto.
 Qed.
 
diff --git a/common/Values.v b/common/Values.v
index a20dd567..68a2054b 100644
--- a/common/Values.v
+++ b/common/Values.v
@@ -132,6 +132,40 @@ Proof.
   simpl in *. InvBooleans. destruct H0. split; auto. eapply has_subtype; eauto.
 Qed.
 
+Definition has_type_dec (v: val) (t: typ) : { has_type v t } + { ~ has_type v t }.
+Proof.
+  unfold has_type; destruct v.
+- auto.
+- destruct t; auto.
+- destruct t; auto.
+- destruct t; auto.
+- destruct t; auto.
+- destruct t. 
+  apply bool_dec.
+  auto.
+  apply bool_dec.
+  auto.
+  apply bool_dec.
+  auto.
+Defined.
+
+Definition has_rettype (v: val) (r: rettype) : Prop :=
+  match r, v with
+  | Tret t, _ => has_type v t
+  | Tint8signed, Vint n => n = Int.sign_ext 8 n
+  | Tint8unsigned, Vint n => n = Int.zero_ext 8 n
+  | Tint16signed, Vint n => n = Int.sign_ext 16 n
+  | Tint16unsigned, Vint n => n = Int.zero_ext 16 n
+  | _, Vundef => True
+  | _, _ => False
+  end.
+
+Lemma has_proj_rettype: forall v r,
+  has_rettype v r -> has_type v (proj_rettype r).
+Proof.
+  destruct r; simpl; intros; auto; destruct v; try contradiction; exact I.
+Qed.
+
 (** Truth values.  Non-zero integers are treated as [True].
   The integer 0 (also used to represent the null pointer) is [False].
   Other values are neither true nor false. *)
@@ -766,6 +800,18 @@ Definition rolml (v: val) (amount: int) (mask: int64): val :=
   | _ => Vundef
   end.
 
+Definition zero_ext_l (nbits: Z) (v: val) : val :=
+  match v with
+  | Vlong n => Vlong(Int64.zero_ext nbits n)
+  | _ => Vundef
+  end.
+
+Definition sign_ext_l (nbits: Z) (v: val) : val :=
+  match v with
+  | Vlong n => Vlong(Int64.sign_ext nbits n)
+  | _ => Vundef
+  end.
+
 (** Comparisons *)
 
 Section COMPARISONS.
@@ -898,6 +944,55 @@ Definition offset_ptr (v: val) (delta: ptrofs) : val :=
   | _ => Vundef
   end.
 
+(** Normalize a value to the given type, turning it into Vundef if it does not
+    match the type. *)
+
+Definition normalize (v: val) (ty: typ) : val :=
+  match v, ty with
+  | Vundef, _ => Vundef
+  | Vint _, Tint => v
+  | Vlong _, Tlong => v
+  | Vfloat _, Tfloat => v
+  | Vsingle _, Tsingle => v
+  | Vptr _ _, (Tint | Tany32) => if Archi.ptr64 then Vundef else v
+  | Vptr _ _, Tlong => if Archi.ptr64 then v else Vundef
+  | (Vint _ | Vsingle _), Tany32 => v
+  | _, Tany64 => v
+  | _, _ => Vundef
+  end.
+
+Lemma normalize_type:
+  forall v ty, has_type (normalize v ty) ty.
+Proof.
+  intros; destruct v; simpl.
+- auto.
+- destruct ty; exact I.
+- destruct ty; exact I.
+- destruct ty; exact I.
+- destruct ty; exact I.
+- unfold has_type; destruct ty, Archi.ptr64; auto.
+Qed.
+
+Lemma normalize_idem:
+  forall v ty, has_type v ty -> normalize v ty = v.
+Proof.
+  unfold has_type, normalize; intros. destruct v.
+- auto.
+- destruct ty; intuition auto.
+- destruct ty; intuition auto.
+- destruct ty; intuition auto.
+- destruct ty; intuition auto.
+- destruct ty, Archi.ptr64; intuition congruence.
+Qed.
+
+(** Select between two values based on the result of a comparison. *)
+
+Definition select (cmp: option bool) (v1 v2: val) (ty: typ) :=
+  match cmp with
+  | Some b => normalize (if b then v1 else v2) ty
+  | None => Vundef
+  end.
+
 (** [load_result] reflects the effect of storing a value with a given
   memory chunk, then reading it back with the same chunk.  Depending
   on the chunk and the type of the value, some normalization occurs.
@@ -925,10 +1020,24 @@ Definition load_result (chunk: memory_chunk) (v: val) :=
   | _, _ => Vundef
   end.
 
+Lemma load_result_rettype:
+  forall chunk v, has_rettype (load_result chunk v) (rettype_of_chunk chunk).
+Proof.
+  intros. unfold has_rettype; destruct chunk; destruct v; simpl; auto.
+- rewrite Int.sign_ext_idem by omega; auto.
+- rewrite Int.zero_ext_idem by omega; auto.
+- rewrite Int.sign_ext_idem by omega; auto.
+- rewrite Int.zero_ext_idem by omega; auto.
+- destruct Archi.ptr64 eqn:SF; simpl; auto.
+- destruct Archi.ptr64 eqn:SF; simpl; auto.
+- destruct Archi.ptr64 eqn:SF; simpl; auto.
+Qed.
+
 Lemma load_result_type:
   forall chunk v, has_type (load_result chunk v) (type_of_chunk chunk).
 Proof.
-  intros. unfold has_type; destruct chunk; destruct v; simpl; auto; destruct Archi.ptr64 eqn:SF; simpl; auto.
+  intros. rewrite <- proj_rettype_of_chunk. apply has_proj_rettype.
+  apply load_result_rettype.
 Qed.
 
 Lemma load_result_same:
@@ -1832,10 +1941,18 @@ Qed.
 
 Lemma zero_ext_and:
   forall n v,
-  0 < n < Int.zwordsize ->
+  0 <= n ->
   Val.zero_ext n v = Val.and v (Vint (Int.repr (two_p n - 1))).
 Proof.
-  intros. destruct v; simpl; auto. decEq. apply Int.zero_ext_and; auto. omega.
+  intros. destruct v; simpl; auto. decEq. apply Int.zero_ext_and; auto.
+Qed.
+
+Lemma zero_ext_andl:
+  forall n v,
+  0 <= n ->
+  Val.zero_ext_l n v = Val.andl v (Vlong (Int64.repr (two_p n - 1))).
+Proof.
+  intros. destruct v; simpl; auto. decEq. apply Int64.zero_ext_and; auto.
 Qed.
 
 Lemma rolm_lt_zero:
@@ -1883,7 +2000,7 @@ Inductive lessdef_list: list val -> list val -> Prop :=
       lessdef v1 v2 -> lessdef_list vl1 vl2 ->
       lessdef_list (v1 :: vl1) (v2 :: vl2).
 
-Hint Resolve lessdef_refl lessdef_undef lessdef_list_nil lessdef_list_cons.
+Hint Resolve lessdef_refl lessdef_undef lessdef_list_nil lessdef_list_cons : core.
 
 Lemma lessdef_list_inv:
   forall vl1 vl2, lessdef_list vl1 vl2 -> vl1 = vl2 \/ In Vundef vl1.
@@ -2044,6 +2161,36 @@ Proof.
   intros. destruct v; simpl; auto. f_equal. apply Ptrofs.add_assoc.
 Qed.
 
+Lemma lessdef_normalize:
+  forall v ty, lessdef (normalize v ty) v.
+Proof.
+  intros. destruct v; simpl.
+  - auto.
+  - destruct ty; auto.
+  - destruct ty; auto.
+  - destruct ty; auto.
+  - destruct ty; auto.
+  - destruct ty, Archi.ptr64; auto.
+Qed.
+
+Lemma normalize_lessdef:
+  forall v v' ty, lessdef v v' -> lessdef (normalize v ty) (normalize v' ty).
+Proof.
+  intros. inv H; auto.
+Qed.
+
+Lemma select_lessdef:
+  forall ob ob' v1 v1' v2 v2' ty,
+  ob = None \/ ob = ob' ->
+  lessdef v1 v1' -> lessdef v2 v2' ->
+  lessdef (select ob v1 v2 ty) (select ob' v1' v2' ty).
+Proof.
+  intros; unfold select. destruct H.
+- subst ob; auto.
+- subst ob'; destruct ob as [b|]; auto.
+  apply normalize_lessdef. destruct b; auto.
+Qed.
+
 (** * Values and memory injections *)
 
 (** A memory injection [f] is a function from addresses to either [None]
@@ -2078,7 +2225,7 @@ Inductive inject (mi: meminj): val -> val -> Prop :=
   | val_inject_undef: forall v,
       inject mi Vundef v.
 
-Hint Constructors inject.
+Hint Constructors inject : core.
 
 Inductive inject_list (mi: meminj): list val -> list val-> Prop:=
   | inject_list_nil :
@@ -2087,7 +2234,7 @@ Inductive inject_list (mi: meminj): list val -> list val-> Prop:=
       inject mi v v' -> inject_list mi vl vl'->
       inject_list mi (v :: vl) (v' :: vl').
 
-Hint Resolve inject_list_nil inject_list_cons.
+Hint Resolve inject_list_nil inject_list_cons : core.
 
 Lemma inject_ptrofs:
   forall mi i, inject mi (Vptrofs i) (Vptrofs i).
@@ -2095,7 +2242,7 @@ Proof.
   unfold Vptrofs; intros. destruct Archi.ptr64; auto.
 Qed.
 
-Hint Resolve inject_ptrofs.
+Hint Resolve inject_ptrofs : core.
 
 Section VAL_INJ_OPS.
 
@@ -2328,6 +2475,36 @@ Proof.
   intros. unfold Val.hiword; inv H; auto.
 Qed.
 
+Lemma normalize_inject:
+  forall v v' ty, inject f v v' -> inject f (normalize v ty) (normalize v' ty).
+Proof.
+  intros. inv H.
+- destruct ty; constructor.
+- destruct ty; constructor.
+- destruct ty; constructor.
+- destruct ty; constructor.
+- simpl. destruct ty.
++ destruct Archi.ptr64; econstructor; eauto.
++ auto.
++ destruct Archi.ptr64; econstructor; eauto.
++ auto.
++ destruct Archi.ptr64; econstructor; eauto.
++ econstructor; eauto.
+- constructor.
+Qed.
+
+Lemma select_inject:
+  forall ob ob' v1 v1' v2 v2' ty,
+  ob = None \/ ob = ob' ->
+  inject f v1 v1' -> inject f v2 v2' ->
+  inject f (select ob v1 v2 ty) (select ob' v1' v2' ty).
+Proof.
+  intros; unfold select. destruct H.
+- subst ob; auto.
+- subst ob'; destruct ob as [b|]; auto.
+  apply normalize_inject. destruct b; auto.
+Qed.
+
 End VAL_INJ_OPS.
 
 End Val.
@@ -2368,7 +2545,7 @@ Proof.
   constructor. eapply val_inject_incr; eauto. auto.
 Qed.
 
-Hint Resolve inject_incr_refl val_inject_incr val_inject_list_incr.
+Hint Resolve inject_incr_refl val_inject_incr val_inject_list_incr : core.
 
 Lemma val_inject_lessdef:
   forall v1 v2, Val.lessdef v1 v2 <-> Val.inject (fun b => Some(b, 0)) v1 v2.
diff --git a/configure b/configure
index bb4ef1a6..6bd7ed0e 100755
--- a/configure
+++ b/configure
@@ -55,10 +55,12 @@ Supported targets:
   x86_64-macosx        (x86 64 bits, MacOS X)
   rv32-linux           (RISC-V 32 bits, Linux)
   rv64-linux           (RISC-V 64 bits, Linux)
+  aarch64-linux        (AArch64, i.e. ARMv8 in 64-bit mode, Linux)
   manual               (edit configuration file by hand)
 
 For x86 targets, the "x86_32-" prefix can also be written "ia32-" or "i386-".
 For x86 targets, the "x86_64-" prefix can also be written "amd64-".
+For AArch64 targets, the "aarch64-" prefix can also be written "arm64-".
 
 For PowerPC targets, the "ppc-" prefix can be refined into:
   ppc64-               PowerPC 64 bits
@@ -175,6 +177,8 @@ case "$target" in
       arch="riscV"; model="32"; endianness="little"; bitsize=32;;
   rv64-*)
       arch="riscV"; model="64"; endianness="little"; bitsize=64;;
+  aarch64-*|arm64-*)
+      arch="aarch64"; model="default"; endianness="little"; bitsize=64;;
   manual)
       ;;
   "")
@@ -428,6 +432,29 @@ if test "$arch" = "riscV"; then
   system="linux"
 fi
 
+#
+# AArch64 (ARMv8 64 bits) Target Configuration
+#
+if test "$arch" = "aarch64"; then
+  case "$target" in
+    linux)
+        abi="standard"
+        casm="${toolprefix}gcc"
+        casm_options="-c"
+        cc="${toolprefix}gcc"
+        clinker="${toolprefix}gcc"
+        clinker_options=""
+        cprepro="${toolprefix}gcc"
+        cprepro_options="-std=c99 -U__GNUC__ -E"
+        libmath="-lm"
+        system="linux";;
+    *)
+        echo "Error: invalid eabi/system '$target' for architecture AArch64." 1>&2
+        echo "$usage" 1>&2
+        exit 2;;
+  esac
+fi
+
 
 #
 # Finalize Target Configuration
@@ -503,43 +530,38 @@ missingtools=false
 echo "Testing Coq... " | tr -d '\n'
 coq_ver=$(${COQBIN}coqc -v 2>/dev/null | sed -n -e 's/The Coq Proof Assistant, version \([^ ]*\).*$/\1/p')
 case "$coq_ver" in
-  8.7.0|8.7.1|8.7.2|8.8.0|8.8.1|8.8.2|8.9.0)
+  8.8.0|8.8.1|8.8.2|8.9.0|8.9.1|8.10.0|8.10.1|8.10.2|8.11.0)
         echo "version $coq_ver -- good!";;
   ?*)
         echo "version $coq_ver -- UNSUPPORTED"
         if $ignore_coq_version; then
             echo "Warning: this version of Coq is unsupported, proceed at your own risks."
         else
-            echo "Error: CompCert requires one of the following Coq versions: 8.9.0, 8.8.2, 8.8.1, 8.8.0, 8.7.2, 8.7.1, 8.7.0"
+            echo "Error: CompCert requires one of the following Coq versions: 8.11.0, 8.10.2, 8.10.1, 8.10.0, 8.9.1, 8.9.0, 8.8.2, 8.8.1, 8.8.0"
             missingtools=true
         fi;;
   "")
         echo "NOT FOUND"
-        echo "Error: make sure Coq version 8.9.0 is installed."
+        echo "Error: make sure Coq version 8.9.1 is installed."
         missingtools=true;;
 esac
 
 echo "Testing OCaml... " | tr -d '\n'
 ocaml_ver=`ocamlopt -version 2>/dev/null`
 case "$ocaml_ver" in
-  4.00.*|4.01.*)
+  4.00.*|4.01.*| 4.02.*|4.03.*|4.04.*)
         echo "version $ocaml_ver -- UNSUPPORTED"
-        echo "Error: CompCert requires OCaml version 4.02 or later."
+        echo "Error: CompCert requires OCaml version 4.05 or later."
         missingtools=true;;
-  4.02.*|4.03.*|4.04.*)
-      echo "version $ocaml_ver -- good!"
-      echo "WARNING: some Intel processors of the Skylake and Kaby Lake generations"
-      echo "have a hardware bug that can be triggered by this version of OCaml."
-      echo "To avoid this risk, it is recommended to use OCaml 4.05 or later.";;
-  4.0*)
+  4.*)
         echo "version $ocaml_ver -- good!";;
   ?.*)
         echo "version $ocaml_ver -- UNSUPPORTED"
-        echo "Error: CompCert requires OCaml version 4.02 or later."
+        echo "Error: CompCert requires OCaml version 4.05 or later."
         missingtools=true;;
   *)
         echo "NOT FOUND"
-        echo "Error: make sure OCaml version 4.02 or later is installed."
+        echo "Error: make sure OCaml version 4.05 or later is installed."
         missingtools=true;;
 esac
 
@@ -553,29 +575,23 @@ else
   ocaml_opt_comp=false
 fi
 
-MENHIR_REQUIRED=20161201
-MENHIR_NEW_API=20180530
-MENHIR_MAX=20181113
-menhir_flags=''
+MENHIR_REQUIRED=20190626
 echo "Testing Menhir... " | tr -d '\n'
 menhir_ver=`menhir --version 2>/dev/null | sed -n -e 's/^.*version \([0-9]*\).*$/\1/p'`
 case "$menhir_ver" in
   20[0-9][0-9][0-9][0-9][0-9][0-9])
-      if test "$menhir_ver" -ge $MENHIR_REQUIRED -a "$menhir_ver" -le $MENHIR_MAX; then
+      if test "$menhir_ver" -ge $MENHIR_REQUIRED; then
           echo "version $menhir_ver -- good!"
-          menhir_include_dir=`menhir --suggest-menhirLib`
-          if test -z "$menhir_include_dir"; then
+          menhir_dir=$(menhir --suggest-menhirLib | tr -d '\r' | tr '\\' '/')
+          if test -z "$menhir_dir"; then
               echo "Error: cannot determine the location of the Menhir API library."
               echo "This can be due to an incorrect Menhir package."
               echo "Consider using the OPAM package for Menhir."
               missingtools=true
           fi
-          if test "$menhir_ver" -ge $MENHIR_NEW_API; then
-              menhir_flags="--coq-lib-path compcert.cparser.MenhirLib"
-          fi
       else
           echo "version $menhir_ver -- UNSUPPORTED"
-          echo "Error: CompCert requires a version of Menhir between $MENHIR_REQUIRED and $MENHIR_MAX, included."
+          echo "Error: CompCert requires a version greater or equal to $MENHIR_REQUIRED."
           missingtools=true
       fi;;
   *)
@@ -639,7 +655,8 @@ echo "-R lib compcert.lib \
 -R driver compcert.driver \
 -R flocq compcert.flocq \
 -R exportclight compcert.exportclight \
--R cparser compcert.cparser" > _CoqProject
+-R cparser compcert.cparser \
+-R MenhirLib compcert.MenhirLib" > _CoqProject
 case $arch in
     x86)
         echo "-R x86_${bitsize} compcert.x86_${bitsize}" >> _CoqProject
@@ -660,8 +677,7 @@ MANDIR=$sharedir/man
 SHAREDIR=$sharedir
 COQDEVDIR=$coqdevdir
 OCAML_OPT_COMP=$ocaml_opt_comp
-MENHIR_INCLUDES=-I "$menhir_include_dir"
-MENHIR_FLAGS=$menhir_flags
+MENHIR_DIR=$menhir_dir
 COMPFLAGS=-bin-annot
 EOF
 
@@ -696,6 +712,8 @@ cat >> Makefile.config <<'EOF'
 # ARCH=powerpc
 # ARCH=arm
 # ARCH=x86
+# ARCH=riscV
+# ARCH=aarch6
 ARCH=
 
 # Hardware variant
@@ -709,23 +727,24 @@ ARCH=
 # MODEL=armv7m      # for ARM
 # MODEL=32sse2      # for x86 in 32-bit mode
 # MODEL=64          # for x86 in 64-bit mode
+# MODEL=default     # for others
 MODEL=
 
 # Target ABI
 # ABI=eabi          # for PowerPC / Linux and other SVR4 or EABI platforms
 # ABI=eabi          # for ARM
 # ABI=hardfloat     # for ARM
-# ABI=standard      # for x86
+# ABI=standard      # for others
 ABI=
 
 # Target bit width
-# BITSIZE=64        # for x86 in 64-bit mode
+# BITSIZE=64        # for x86 in 64-bit mode, RiscV in 64-bit mode, AArch64
 # BITSIZE=32        # otherwise
 BITSIZE=
 
 # Target endianness
 # ENDIANNESS=big     # for ARM or PowerPC
-# ENDIANNESS=little  # for ARM or x86
+# ENDIANNESS=little  # for ARM or x86 or RiscV or AArch64
 ENDIANNESS=
 
 # Target operating system and development environment
@@ -734,7 +753,7 @@ ENDIANNESS=
 # SYSTEM=linux
 # SYSTEM=diab
 #
-# Possible choices for ARM:
+# Possible choices for ARM, AArch64, RiscV:
 # SYSTEM=linux
 #
 # Possible choices for x86:
diff --git a/coq b/coq
index 0b04a8c7..fcf744fd 100755
--- a/coq
+++ b/coq
@@ -12,4 +12,4 @@ make -q ${1}o || {
    done)
 }
 
-"${COQBIN}coqide" $INCLUDES $1 && make ${1}o
+"${COQBIN}coqide" -async-proofs off $INCLUDES $1 && make ${1}o
diff --git a/cparser/Builtins.ml b/cparser/Builtins.ml
deleted file mode 100644
index 8eb1abfd..00000000
--- a/cparser/Builtins.ml
+++ /dev/null
@@ -1,54 +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 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(* Compiler built-ins *)
-
-open C
-open Cutil
-
-let env = ref Env.empty
-let idents = ref []
-let decls = ref []
-
-let environment () = !env
-let identifiers () = !idents
-let declarations () = List.rev !decls
-
-let add_typedef (s, ty) =
-  let (id, env') = Env.enter_typedef !env s ty in
-  env := env';
-  idents := id :: !idents;
-  decls := {gdesc = Gtypedef(id, ty); gloc = no_loc} :: !decls
-
-let add_function (s, (res, args, va)) =
-  let ty =
-    TFun(res,
-         Some (List.map (fun ty -> (Env.fresh_ident "", ty)) args),
-         va, []) in
-  let (id, env') = Env.enter_ident !env s Storage_extern ty in
-  env := env';
-  idents := id :: !idents;
-  decls := {gdesc = Gdecl(Storage_extern, id, ty, None); gloc = no_loc} :: !decls
-
-type t = {
-  typedefs: (string * C.typ) list;
-  functions: (string * (C.typ * C.typ list * bool)) list
-}
-
-let set blt =
-  env := Env.empty;
-  idents := [];
-  List.iter add_typedef blt.typedefs;
-  List.iter add_function blt.functions
diff --git a/cparser/C.mli b/cparser/C.mli
index cc8d4065..15717565 100644
--- a/cparser/C.mli
+++ b/cparser/C.mli
@@ -264,3 +264,10 @@ and globdecl_desc =
   | Gpragma of string                   (* #pragma directive *)
 
 type program = globdecl list
+
+(** Builtin types and functions *)
+
+type builtins = {
+  builtin_typedefs: (string * typ) list;
+  builtin_functions: (string * (typ * typ list * bool)) list
+}
diff --git a/cparser/Cabs.v b/cparser/Cabs.v
index 5865ab69..5f12e8a1 100644
--- a/cparser/Cabs.v
+++ b/cparser/Cabs.v
@@ -20,7 +20,7 @@ Parameter string : Type.
 (* OCaml's int64 type, used to represent individual characters in literals. *)
 Parameter char_code : Type.
 (* Context information. *)
-Parameter cabsloc : Type.
+Parameter loc : Type.
 
 Record floatInfo := {
   isHex_FI:bool;
@@ -51,7 +51,7 @@ Inductive typeSpecifier := (* Merge all specifiers into one type *)
    * They also have a list of __attribute__s that appeared between the
    * keyword and the type name (definitions only) *)
   | Tstruct_union : structOrUnion -> option string -> option (list field_group) -> list attribute -> typeSpecifier
-  | Tenum : option string -> option (list (string * option expression * cabsloc)) -> list attribute -> typeSpecifier
+  | Tenum : option string -> option (list (string * option expression * loc)) -> list attribute -> typeSpecifier
 
 with storage :=
   AUTO | STATIC | EXTERN | REGISTER | TYPEDEF
@@ -87,18 +87,18 @@ with decl_type :=
  | PROTO_OLD : decl_type -> list string -> decl_type
 
 with parameter :=
-  | PARAM : list spec_elem -> option string -> decl_type -> list attribute -> cabsloc -> parameter
+  | PARAM : list spec_elem -> option string -> decl_type -> list attribute -> loc -> parameter
 
 (* The optional expression is the bitfield *)
 with field_group :=
-  | Field_group : list spec_elem -> list (option name * option expression) -> cabsloc -> field_group
+  | Field_group : list spec_elem -> list (option name * option expression) -> loc -> field_group
 
 (* The decl_type is in the order in which they are printed. Only the name of
  * the declared identifier is pulled out. *)
 (* e.g: in "int *x", "*x" is the declarator; "x" will be pulled out as *)
 (* the string, and decl_type will be PTR([], JUSTBASE) *)
 with name :=
-  | Name : string -> decl_type -> list attribute -> cabsloc -> name
+  | Name : string -> decl_type -> list attribute -> loc -> name
 
 (* A variable declarator ("name") with an initializer *)
 with init_name :=
@@ -161,9 +161,9 @@ with initwhat :=
   | ATINDEX_INIT : expression -> initwhat
 
 with attribute :=
-  | GCC_ATTR : list gcc_attribute -> cabsloc -> attribute
-  | PACKED_ATTR : list expression -> cabsloc -> attribute
-  | ALIGNAS_ATTR : list expression -> cabsloc -> attribute
+  | GCC_ATTR : list gcc_attribute -> loc -> attribute
+  | PACKED_ATTR : list expression -> loc -> attribute
+  | ALIGNAS_ATTR : list expression -> loc -> attribute
 
 with gcc_attribute :=
   | GCC_ATTR_EMPTY
@@ -194,31 +194,31 @@ Definition asm_flag := (bool * list char_code)%type.
 ** Declaration definition (at toplevel)
 *)
 Inductive definition :=
- | FUNDEF : list spec_elem -> name -> list definition -> statement -> cabsloc -> definition
- | DECDEF : init_name_group -> cabsloc -> definition  (* global variable(s), or function prototype *)
- | PRAGMA : string -> cabsloc -> definition
+ | FUNDEF : list spec_elem -> name -> list definition -> statement -> loc -> definition
+ | DECDEF : init_name_group -> loc -> definition  (* global variable(s), or function prototype *)
+ | PRAGMA : string -> loc -> definition
 
 (*
 ** statements
 *)
 
 with statement :=
- | NOP : cabsloc -> statement
- | COMPUTATION : expression -> cabsloc -> statement
- | BLOCK : list statement -> cabsloc -> statement
- | If : expression -> statement -> option statement -> cabsloc -> statement
- | WHILE : expression -> statement -> cabsloc -> statement
- | DOWHILE : expression -> statement -> cabsloc -> statement
- | FOR : option for_clause -> option expression -> option expression -> statement -> cabsloc -> statement
- | BREAK : cabsloc -> statement
- | CONTINUE : cabsloc -> statement
- | RETURN : option expression -> cabsloc -> statement
- | SWITCH : expression -> statement -> cabsloc -> statement
- | CASE : expression -> statement -> cabsloc -> statement
- | DEFAULT : statement -> cabsloc -> statement
- | LABEL : string -> statement -> cabsloc -> statement
- | GOTO : string -> cabsloc -> statement
- | ASM : list cvspec -> bool -> list char_code -> list asm_operand -> list asm_operand -> list asm_flag -> cabsloc -> statement
+ | NOP : loc -> statement
+ | COMPUTATION : expression -> loc -> statement
+ | BLOCK : list statement -> loc -> statement
+ | If : expression -> statement -> option statement -> loc -> statement
+ | WHILE : expression -> statement -> loc -> statement
+ | DOWHILE : expression -> statement -> loc -> statement
+ | FOR : option for_clause -> option expression -> option expression -> statement -> loc -> statement
+ | BREAK : loc -> statement
+ | CONTINUE : loc -> statement
+ | RETURN : option expression -> loc -> statement
+ | SWITCH : expression -> statement -> loc -> statement
+ | CASE : expression -> statement -> loc -> statement
+ | DEFAULT : statement -> loc -> statement
+ | LABEL : string -> statement -> loc -> statement
+ | GOTO : string -> loc -> statement
+ | ASM : list cvspec -> bool -> list char_code -> list asm_operand -> list asm_operand -> list asm_flag -> loc -> statement
  | DEFINITION : definition -> statement (*definition or declaration of a variable or type*)
 
 with for_clause :=
diff --git a/cparser/Cabshelper.ml b/cparser/Cabshelper.ml
index 958f242c..22f3b3c7 100644
--- a/cparser/Cabshelper.ml
+++ b/cparser/Cabshelper.ml
@@ -16,11 +16,6 @@
 
 open Cabs
 
-let cabslu = {lineno = -10;
-	      filename = "cabs loc unknown";
-	      byteno = -10;
-              ident = 0}
-
 (*********** HELPER FUNCTIONS **********)
 
 let rec isStatic = function
@@ -44,13 +39,13 @@ let rec isTypedef = function
   | _ :: rest -> isTypedef rest
 
 
-let get_definitionloc (d : definition) : cabsloc =
+let get_definitionloc (d : definition) : loc =
   match d with
   | FUNDEF(_, _, _, _, l) -> l
   | DECDEF(_, l) -> l
   | PRAGMA(_, l) -> l
 
-let get_statementloc (s : statement) : cabsloc =
+let get_statementloc (s : statement) : loc =
 begin
   match s with
   | NOP(loc) -> loc
@@ -72,8 +67,8 @@ begin
   | ASM(_,_,_,_,_,_,loc) -> loc
 end
 
-let string_of_cabsloc l =
+let string_of_loc l =
   Printf.sprintf "%s:%d" l.filename l.lineno
 
-let format_cabsloc pp l =
+let format_loc pp l =
   Format.fprintf pp "%s:%d" l.filename l.lineno
diff --git a/cparser/Ceval.ml b/cparser/Ceval.ml
index 58dea5f4..ecf83779 100644
--- a/cparser/Ceval.ml
+++ b/cparser/Ceval.ml
@@ -271,7 +271,7 @@ let constant_expr env ty e =
   try
     match unroll env ty, cast env ty (expr env e) with
     | TInt(ik, _), I n -> Some(CInt(n, ik, ""))
-    | TPtr(_, _), I n -> Some(CInt(n, IInt, ""))
+    | TPtr(_, _), I n -> Some(CInt(n, ptr_t_ikind (), ""))
     | (TArray(_, _, _) | TPtr(_, _)), S s -> Some(CStr s)
     | (TArray(_, _, _) | TPtr(_, _)), WS s -> Some(CWStr s)
     | TEnum(_, _), I n -> Some(CInt(n, enum_ikind, ""))
diff --git a/cparser/Checks.ml b/cparser/Checks.ml
index a30cde7d..17caf19a 100644
--- a/cparser/Checks.ml
+++ b/cparser/Checks.ml
@@ -18,44 +18,68 @@ open Diagnostics
 open Cutil
 open Env
 
-let unknown_attrs loc attrs =
-  let unknown attr =
-    let attr_class = class_of_attribute attr in
-    if attr_class = Attr_unknown then
-      warning loc Unknown_attribute
-        "unknown attribute '%s' ignored" (name_of_attribute attr) in
-  List.iter unknown attrs
+(* AST traversal functions *)
 
-let unknown_attrs_typ env loc ty =
-  let attr = attributes_of_type env ty in
-  unknown_attrs loc attr
+let fold_over_stmt_loc ~(expr: 'a -> location -> exp -> 'a)
+    ~(decl: 'a -> location -> decl -> 'a)
+    (a: 'a) (s: stmt) : 'a =
+  let rec fold a s =
+    match s.sdesc with
+    | Sskip -> a
+    | Sbreak -> a
+    | Scontinue -> a
+    | Slabeled(_, s1) -> fold a s1
+    | Sgoto _ -> a
+    | Sreturn None -> a
+    | Sreturn (Some e) -> expr a s.sloc e
+    | Sasm(_, _, outs, ins, _) -> asm_operands (asm_operands a s.sloc outs) s.sloc ins
+    | Sdo e -> expr a s.sloc e
+    | Sif (e, s1, s2) -> fold (fold (expr a s.sloc e) s1) s2
+    | Sseq (s1, s2) -> fold (fold a s1) s2
+    | Sfor (s1, e, s2, s3) -> fold (fold (expr (fold a s1) s.sloc e) s2) s3
+    | Swhile(e, s1) -> fold (expr a s.sloc e) s1
+    | Sdowhile (s1, e) -> expr (fold a s1) s.sloc e
+    | Sswitch (e, s1) -> fold (expr a s.sloc e) s1
+    | Sblock sl -> List.fold_left fold a sl
+    | Sdecl d -> decl a s.sloc d
+  and asm_operands a loc l =
+    List.fold_left (fun a (_, _, e) -> expr a loc e) a l
+  in fold a s
 
-let unknown_attrs_decl env loc (sto, id, ty, init) =
-  unknown_attrs_typ env loc ty
+let iter_over_stmt_loc
+    ?(expr = fun loc e -> ())
+    ?(decl = fun loc decl -> ())
+    (s: stmt) : unit =
+  fold_over_stmt_loc ~expr: (fun () loc e -> expr loc e)
+    ~decl: (fun () loc d -> decl loc d)
+    () s
+
+let fold_over_stmt ~(expr: 'a -> exp -> 'a)
+    ~(decl: 'a -> location -> decl -> 'a)
+    (a: 'a) (s: stmt) : 'a =
+  fold_over_stmt_loc ~expr:(fun a _ e -> expr a e) ~decl:decl a s
+
+let iter_over_stmt ?(expr = fun e -> ())
+    ?(decl = fun loc decl -> ())
+    (s:stmt) : unit =
+  fold_over_stmt_loc ~expr:(fun () _ e -> expr e)
+    ~decl:(fun () loc d -> decl loc d) () s
+
+let fold_over_init ~(expr: 'a -> exp -> 'a) (a: 'a) (i: init) : 'a =
+  let rec fold a = function
+  | Init_single e -> expr a e
+  | Init_array il -> List.fold_left fold a il
+  | Init_struct (_, sl) -> List.fold_left (fun a (_,i) -> fold a i) a sl
+  | Init_union (_, _, ui) -> fold a ui
+  in fold a i
 
-let rec unknown_attrs_stmt env s =
-  match s.sdesc with
-  | Sskip
-  | Sbreak
-  | Scontinue
-  | Slabeled _
-  | Sgoto _
-  | Sreturn _
-  | Sasm _
-  | Sdo _ -> ()
-  | Sif (_,s1,s2)
-  | Sseq (s1,s2) ->
-    unknown_attrs_stmt env s1;
-    unknown_attrs_stmt env s2
-  | Sfor (s1,e,s2,s3) ->
-    unknown_attrs_stmt env s1;
-    unknown_attrs_stmt env s2;
-    unknown_attrs_stmt env s3
-  | Swhile(_,s)
-  | Sdowhile (s,_)
-  | Sswitch (_,s) -> unknown_attrs_stmt env s
-  | Sblock sl -> List.iter (unknown_attrs_stmt env) sl
-  | Sdecl d -> unknown_attrs_decl env s.sloc d
+let iter_over_init ~(expr: exp -> unit) (i:init) : unit =
+  fold_over_init ~expr:(fun () e -> expr e) () i
+
+let fold_over_decl ~(expr: 'a -> exp -> 'a) (a: 'a) loc (sto, id, ty, init) : 'a=
+  match init with
+  | Some i -> fold_over_init ~expr a i
+  | None -> a
 
 let traverse_program
     ?(decl = fun env loc d -> ())
@@ -93,7 +117,27 @@ let traverse_program
           pragma env g.gloc s;
           env in
       traverse env gl in
-  traverse (Builtins.environment ()) p
+  traverse (Env.initial ()) p
+
+(* Unknown attributes warning *)
+
+let unknown_attrs loc attrs =
+  let unknown attr =
+    let attr_class = class_of_attribute attr in
+    if attr_class = Attr_unknown then
+      warning loc Unknown_attribute
+        "unknown attribute '%s' ignored" (name_of_attribute attr) in
+  List.iter unknown attrs
+
+let unknown_attrs_typ env loc ty =
+  let attr = attributes_of_type env ty in
+  unknown_attrs loc attr
+
+let unknown_attrs_decl env loc (sto, id, ty, init) =
+  unknown_attrs_typ env loc ty
+
+let unknown_attrs_stmt env s =
+  iter_over_stmt ~decl:(unknown_attrs_decl env) s
 
 let unknown_attrs_program p =
   let decl env loc d =
@@ -122,6 +166,7 @@ let unknown_attrs_program p =
     ~enum:enum
     p
 
+(* Unused variables and parameters warning *)
 
 let rec vars_used_expr env e =
   match e.edesc with
@@ -143,83 +188,21 @@ let rec vars_used_expr env e =
     let env = vars_used_expr env e in
     List.fold_left vars_used_expr env p
 
-and vars_used_init env = function
-  | Init_single e -> vars_used_expr env e
-  | Init_array al -> List.fold_left vars_used_init env al
-  | Init_struct (_,sl) -> List.fold_left (fun env (_,i) -> vars_used_init env i) env sl
-  | Init_union (_,_,ui) -> vars_used_init env ui
-
-let rec vars_used_stmt env s =
-  match s.sdesc with
-  | Sbreak
-  | Scontinue
-  | Sgoto _
-  | Sreturn None
-  | Sskip -> env
-  | Sreturn (Some e)
-  | Sdo e -> (vars_used_expr env e)
-  | Sseq (s1,s2) ->
-    let env = vars_used_stmt env s1 in
-    vars_used_stmt env s2
-  | Sif (e,s1,s2) ->
-    let env = vars_used_expr env e in
-    let env = vars_used_stmt env s1 in
-    vars_used_stmt env s2
-  | Sfor (s1,e,s2,s3) ->
-    let env = vars_used_expr env e in
-    let env = vars_used_stmt env s1 in
-    let env = vars_used_stmt env s2 in
-    vars_used_stmt env s3
-  | Sswitch (e,s)
-  | Swhile (e,s)
-  | Sdowhile (s,e) ->
-    let env = vars_used_expr env e in
-    vars_used_stmt env s
-  | Sblock sl -> List.fold_left vars_used_stmt env sl
-  | Sdecl (sto,id,ty,init) ->
-    let env = match init with
-      | Some init ->vars_used_init env init
-      | None -> env in
-    env
-  | Slabeled (lbl,s) -> vars_used_stmt env s
-  | Sasm (attr,str,op,op2,constr) ->
-    let vars_asm_op env (_,_,e) =
-      vars_used_expr env e in
-    let env = List.fold_left vars_asm_op env op in
-    let env = List.fold_left vars_asm_op env op2 in
-    env
-
-let unused_variable env used loc (id,ty) =
+and vars_used_init env init =
+  fold_over_init ~expr:vars_used_expr env init
+
+let vars_used_stmt env s =
+  fold_over_stmt ~expr: vars_used_expr
+    ~decl: (fold_over_decl ~expr: vars_used_expr) env s
+
+let unused_variable env used loc (id, ty) =
   let attr = attributes_of_type env ty in
   let unused_attr = find_custom_attributes ["unused";"__unused__"] attr <> [] in
   if not ((IdentSet.mem id used) || unused_attr) then
     warning loc Unused_variable "unused variable '%s'" id.name
 
-let rec unused_variables_stmt env used s =
-  match s.sdesc with
-  | Sbreak
-  | Scontinue
-  | Sgoto _
-  | Sreturn _
-  | Sskip
-  | Sasm _
-  | Sdo _ -> ()
-  | Sseq (s1,s2)
-  | Sif (_,s1,s2) ->
-    unused_variables_stmt env used s1;
-    unused_variables_stmt env used s2
-  | Sfor (s1,e,s2,s3) ->
-    unused_variables_stmt env used s1;
-    unused_variables_stmt env used s2;
-    unused_variables_stmt env used s3
-  | Slabeled (_,s)
-  | Sswitch (_,s)
-  | Swhile (_,s)
-  | Sdowhile (s,_) ->
-    unused_variables_stmt env used s
-  | Sblock sl -> List.iter (unused_variables_stmt env used) sl
-  | Sdecl (sto,id,ty,init) ->
-    unused_variable env used s.sloc (id,ty)
+let unused_variables_stmt env used s =
+  iter_over_stmt ~decl:(fun loc (sto, id, ty, init) -> unused_variable env used loc (id,ty)) s
 
 let unused_variables p =
   let fundef env loc fd =
@@ -229,3 +212,166 @@ let unused_variables p =
   traverse_program
     ~fundef:fundef
     p
+
+(* Warning for conditionals that cannot be transformed into linear code *)
+
+(* Compute the set of local variables that do not have their address taken *)
+
+let rec non_stack_locals_expr vars e =
+  match e.edesc with
+  | ECast (_,e) -> non_stack_locals_expr vars e
+  | EUnop (Oaddrof,e) ->
+    begin match e.edesc with
+    | EVar id ->
+      IdentSet.remove id vars
+    | _ -> vars
+    end
+  | EUnop (Oderef, e) ->
+    (* Special optimization *(& ...) is removed in SimplExpr *)
+    begin match e.edesc with
+      | EUnop (Oaddrof,e) -> non_stack_locals_expr vars e
+      | _ -> non_stack_locals_expr vars e
+    end
+  | EUnop (_, e) ->
+    non_stack_locals_expr vars e
+  | EBinop (_,e1,e2,_) ->
+    let vars = non_stack_locals_expr vars e1 in
+    non_stack_locals_expr vars e2
+  | EConditional (e1,e2,e3) ->
+    let vars = non_stack_locals_expr vars e1 in
+    let vars = non_stack_locals_expr vars e2 in
+    non_stack_locals_expr vars e3
+  | ECompound (_,init) -> non_stack_locals_init vars init
+  | ECall (e,p) ->
+    let vars = non_stack_locals_expr vars e in
+    List.fold_left non_stack_locals_expr vars p
+  | _ -> vars
+
+and non_stack_locals_init vars init =
+  fold_over_init ~expr:non_stack_locals_expr vars init
+
+let add_vars env vars (id,ty) =
+  let volatile = List.mem AVolatile (attributes_of_type env ty) in
+  if not volatile then
+    IdentSet.add id vars
+  else
+    vars
+
+let non_stack_locals_stmt env vars s =
+  let decl vars loc (sto, id, ty, init) =
+    let vars = match init with
+      | Some init -> non_stack_locals_init vars init
+      | None -> vars in
+    add_vars env vars (id,ty) in
+  fold_over_stmt ~expr:non_stack_locals_expr ~decl:decl
+    vars s
+
+(* Check whether an expression is safe and can be always evaluated *)
+
+let safe_cast env tfrom tto =
+  match unroll env tfrom, unroll env tto with
+  | (TInt _ | TPtr _ | TArray _ | TFun _ | TEnum _),
+    (TInt _ | TPtr _ | TEnum _) -> true
+  | TFloat _, TFloat _ -> true
+  | _, _ -> equal_types env tfrom tto
+
+let safe_expr vars env e =
+  let rec expr e =
+    match e.edesc with
+    | EConst _ | ESizeof _ | EAlignof _   | ECompound _  -> true
+    | EVar id -> (IdentSet.mem id vars) || not (is_scalar_type env e.etyp)
+    | ECast (ty, e) ->
+      safe_cast env e.etyp ty && expr e
+    | EUnop (op, e) ->
+      unop op  e
+    | EBinop (op, e1, e2, ty) ->
+      binop op e1  e2
+    | EConditional _  -> false
+    | ECall _ -> false
+  and binop op e1 e2 =
+    let is_long_long_type ty =
+      match unroll env ty with
+      | TInt (ILongLong, _)
+      | TInt (IULongLong, _) -> true
+      | _ -> false in
+    match op with
+    | Oadd | Osub | Omul | Oand | Oor | Oxor | Oshl | Oshr ->
+      expr e1 && expr e2
+    | Oeq | One | Olt | Ogt | Ole | Oge ->
+      let not_long_long = not (is_long_long_type e1.etyp) && not (is_long_long_type e2.etyp) in
+      not_long_long && expr e1 && expr e2
+    | _ -> false
+  (* x.f if f has array or struct or union type *)
+  and unop  op e =
+    match op with
+    | Ominus | Onot | Olognot | Oplus -> expr e
+    | Oaddrof ->
+      begin match e.edesc with
+        (* skip &*e *)
+        | EUnop (Oderef, e) -> expr e
+        (* skip &(e.f) *)
+        | EUnop (Odot f, e) -> expr e
+        | _ -> expr e
+      end
+    (* skip *&e *)
+    | Oderef ->
+      begin match e.edesc with
+        | EUnop (Oaddrof,e) -> expr e
+        | _ -> false
+      end
+    (* e.f is okay if f has array or composite type *)
+    | Odot m ->
+      let fld = field_of_dot_access env e.etyp m in
+      (is_array_type env fld.fld_typ || is_composite_type env fld.fld_typ) && expr e
+    | _ -> false in
+  expr e
+
+(* Check expressions if they contain conditionals that cannot be transformed in
+   linear code. The inner_cond parameter is used to mimic the translation of short
+   circuit logical or and logical and as well as conditional to if statements in
+   SimplExpr. *)
+
+let rec non_linear_cond_expr inner_cond vars env loc e =
+  match e.edesc with
+  | EConst _ | ESizeof _ | EAlignof _ | EVar _ -> ()
+  | ECast (_ , e) | EUnop (_, e)-> non_linear_cond_expr false vars env loc e
+  | EBinop (op, e1, e2, ty) ->
+    let inner_cond = match op with
+      | Ocomma -> inner_cond
+      | Ologand | Ologor -> true
+      | _ -> false
+    in
+    non_linear_cond_expr false vars env loc e1;
+    non_linear_cond_expr inner_cond vars env loc e2
+  | EConditional (c, e1, e2) ->
+    let can_cast = safe_cast env e1.etyp e.etyp && safe_cast env e2.etyp e.etyp in
+    if not can_cast || inner_cond || not (safe_expr vars env e1) || not (safe_expr vars env e2) then
+      warning loc Non_linear_cond_expr "conditional expression may not be linearized";
+    non_linear_cond_expr true vars env loc e1;
+    non_linear_cond_expr true vars env loc e2;
+  | ECompound (ty, init) -> non_linear_cond_init vars env loc init
+  | ECall (e, params) ->
+    non_linear_cond_expr false vars env loc e;
+    List.iter (non_linear_cond_expr false vars env loc) params
+
+and non_linear_cond_init vars env loc init =
+  iter_over_init ~expr:(non_linear_cond_expr false vars env loc) init
+
+let non_linear_cond_stmt vars env s =
+  let decl loc (sto, id, ty, init) =
+    match init with
+    | None -> ()
+    | Some init -> non_linear_cond_init vars env loc init in
+  iter_over_stmt_loc ~expr:(non_linear_cond_expr false vars env) ~decl:decl s
+
+let non_linear_conditional p =
+  if active_warning Non_linear_cond_expr && !Clflags.option_Obranchless then begin
+    let fundef env loc fd =
+      let vars = List.fold_left (add_vars env) IdentSet.empty fd.fd_params in
+      let vars = non_stack_locals_stmt env vars fd.fd_body in
+      non_linear_cond_stmt vars env fd.fd_body;
+    in
+    traverse_program
+      ~fundef:fundef
+      p
+  end
diff --git a/cparser/Checks.mli b/cparser/Checks.mli
index 4d61a5b8..cfd7b04d 100644
--- a/cparser/Checks.mli
+++ b/cparser/Checks.mli
@@ -16,3 +16,5 @@
 val unknown_attrs_program: C.program -> unit
 
 val unused_variables: C.program -> unit
+
+val non_linear_conditional : C.program -> unit
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index cf67015a..3467c092 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -29,7 +29,7 @@ let no_loc = ("", -1)
 
 module Ident = struct
   type t = ident
-  let compare id1 id2 = Pervasives.compare id1.stamp id2.stamp
+  let compare id1 id2 = compare id1.stamp id2.stamp
 end
 
 module IdentSet = Set.Make(Ident)
@@ -821,6 +821,11 @@ let is_composite_type env t =
   | TStruct _ | TUnion _ -> true
   | _ -> false
 
+let is_array_type env t =
+  match unroll env t with
+  | TArray _ -> true
+  | _ -> false
+
 let is_function_type env t =
   match unroll env t with
   | TFun _ -> true
@@ -831,6 +836,12 @@ let is_anonymous_composite = function
   | TUnion (id,_) -> id.C.name = ""
   | _ -> false
 
+let is_anonymous_type = function
+  | TEnum (id,_)
+  | TStruct (id,_)
+  | TUnion (id,_) -> id.C.name = ""
+  | _ -> false
+
 let is_function_pointer_type env t =
   match unroll env t with
   | TPtr (ty, _) -> is_function_type env ty
@@ -947,7 +958,7 @@ let binary_conversion env t1 t2 =
       end
   | _, _ -> assert false
 
-(* Conversion on function arguments (with protoypes) *)
+(* Conversion on function arguments (with prototypes) *)
 
 let argument_conversion env t =
   (* Arrays and functions degrade automatically to pointers *)
diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli
index 5a1e9af3..2ddee78c 100644
--- a/cparser/Cutil.mli
+++ b/cparser/Cutil.mli
@@ -166,12 +166,16 @@ val is_scalar_type : Env.t -> typ -> bool
   (* Is type integer, float or pointer? *)
 val is_composite_type : Env.t -> typ -> bool
   (* Is type a struct or union? *)
+val is_array_type : Env.t -> typ -> bool
+  (* Is type an array type? *)
 val is_function_type : Env.t -> typ -> bool
   (* Is type a function type? (not pointer to function) *)
 val is_function_pointer_type : Env.t -> typ -> bool
   (* Is type a pointer to function type? *)
 val is_anonymous_composite : typ -> bool
   (* Is type an anonymous composite? *)
+val is_anonymous_type : typ -> bool
+  (* Is the type an anonymous composite or enum *)
 val is_qualified_array : typ -> bool
   (* Does the type contain a qualified array type (e.g. int[const 5])? *)
 val pointer_arithmetic_ok : Env.t -> typ -> bool
diff --git a/cparser/Diagnostics.ml b/cparser/Diagnostics.ml
index 172affab..7957375c 100644
--- a/cparser/Diagnostics.ml
+++ b/cparser/Diagnostics.ml
@@ -18,6 +18,10 @@
 open Format
 open Commandline
 
+(* Ensure that the error formatter is flushed at exit *)
+let _ =
+  at_exit (pp_print_flush err_formatter)
+
 (* Should errors be treated as fatal *)
 let error_fatal = ref false
 
@@ -28,7 +32,7 @@ let max_error = ref 0
 let diagnostics_show_option = ref true
 
 (* Test if color diagnostics are available by testing if stderr is a tty
-   and if the environment varibale TERM is set
+   and if the environment variable TERM is set
 *)
 let color_diagnostics =
   let term = try Sys.getenv "TERM" with Not_found -> "" in
@@ -98,31 +102,48 @@ type warning_type =
   | Flexible_array_extensions
   | Tentative_incomplete_static
   | Reduced_alignment
+  | Non_linear_cond_expr
+
+(* List of all warnings with default status.
+   "true" means the warning is active by default.
+   "false" means the warning is off by default. *)
+let all_warnings =
+  [ (Unnamed, true);
+    (Unknown_attribute, true);
+    (Zero_length_array, false);
+    (Celeven_extension, false);
+    (Gnu_empty_struct, true);
+    (Missing_declarations, true);
+    (Constant_conversion, true);
+    (Int_conversion, true);
+    (Varargs, true);
+    (Implicit_function_declaration, true);
+    (Pointer_type_mismatch, true);
+    (Compare_distinct_pointer_types, true);
+    (Implicit_int, true);
+    (Main_return_type, true);
+    (Invalid_noreturn, true);
+    (Return_type, true);
+    (Literal_range, true);
+    (Unknown_pragmas, false);
+    (CompCert_conformance, false);
+    (Inline_asm_sdump, true);
+    (Unused_variable, false);
+    (Unused_parameter, false);
+    (Wrong_ais_parameter, true);
+    (Unused_ais_parameter, true);
+    (Ignored_attributes, true);
+    (Extern_after_definition, true);
+    (Static_in_inline, true);
+    (Flexible_array_extensions, false);
+    (Tentative_incomplete_static, false);
+    (Reduced_alignment, false);
+    (Non_linear_cond_expr, false);
+  ]
 
 (* List of active warnings *)
-let active_warnings: warning_type list ref = ref [
-  Unnamed;
-  Unknown_attribute;
-  Gnu_empty_struct;
-  Missing_declarations;
-  Constant_conversion;
-  Int_conversion;
-  Varargs;
-  Implicit_function_declaration;
-  Pointer_type_mismatch;
-  Compare_distinct_pointer_types;
-  Implicit_int;
-  Main_return_type;
-  Invalid_noreturn;
-  Return_type;
-  Literal_range;
-  Inline_asm_sdump;
-  Wrong_ais_parameter;
-  Unused_ais_parameter;
-  Ignored_attributes;
-  Extern_after_definition;
-  Static_in_inline;
-]
+let active_warnings: warning_type list ref =
+  ref (List.map fst (List.filter snd all_warnings))
 
 (* List of errors treated as warning *)
 let error_warnings: warning_type list ref = ref []
@@ -159,6 +180,7 @@ let string_of_warning = function
   | Flexible_array_extensions -> "flexible-array-extensions"
   | Tentative_incomplete_static -> "tentative-incomplete-static"
   | Reduced_alignment -> "reduced-alignment"
+  | Non_linear_cond_expr -> "non-linear-cond-expr"
 
 (* Activate the given warning *)
 let activate_warning w () =
@@ -182,74 +204,14 @@ let warning_not_as_error w () =
 
 (* Activate all warnings *)
 let wall () =
-  active_warnings:=[
-    Unnamed;
-    Unknown_attribute;
-    Zero_length_array;
-    Celeven_extension;
-    Gnu_empty_struct;
-    Missing_declarations;
-    Constant_conversion;
-    Int_conversion;
-    Varargs;
-    Implicit_function_declaration;
-    Pointer_type_mismatch;
-    Compare_distinct_pointer_types;
-    Implicit_int;
-    Main_return_type;
-    Invalid_noreturn;
-    Return_type;
-    Literal_range;
-    Unknown_pragmas;
-    CompCert_conformance;
-    Inline_asm_sdump;
-    Unused_variable;
-    Unused_parameter;
-    Wrong_ais_parameter;
-    Ignored_attributes;
-    Extern_after_definition;
-    Static_in_inline;
-    Flexible_array_extensions;
-    Tentative_incomplete_static;
-    Reduced_alignment;
-  ]
+  active_warnings:= List.map fst all_warnings
 
 let wnothing () =
   active_warnings :=[]
 
 (* Make all warnings an error *)
 let werror () =
-  error_warnings:=[
-    Unnamed;
-    Unknown_attribute;
-    Zero_length_array;
-    Celeven_extension;
-    Gnu_empty_struct;
-    Missing_declarations;
-    Constant_conversion;
-    Int_conversion;
-    Varargs;
-    Implicit_function_declaration;
-    Pointer_type_mismatch;
-    Compare_distinct_pointer_types;
-    Implicit_int;
-    Main_return_type;
-    Invalid_noreturn;
-    Return_type;
-    Literal_range;
-    Unknown_pragmas;
-    CompCert_conformance;
-    Inline_asm_sdump;
-    Unused_variable;
-    Wrong_ais_parameter;
-    Unused_ais_parameter;
-    Ignored_attributes;
-    Extern_after_definition;
-    Static_in_inline;
-    Flexible_array_extensions;
-    Tentative_incomplete_static;
-    Reduced_alignment;
-  ]
+  error_warnings:= List.map fst all_warnings
 
 (* Generate the warning key for the message *)
 let key_of_warning w =
@@ -403,36 +365,7 @@ let error_option w =
    Exact ("-Wno-error="^key), Unit ( warning_not_as_error w)]
 
 let warning_options =
-  error_option Unnamed @
-  error_option Unknown_attribute @
-  error_option Zero_length_array @
-  error_option Celeven_extension @
-  error_option Gnu_empty_struct @
-  error_option Missing_declarations @
-  error_option Constant_conversion @
-  error_option Int_conversion @
-  error_option Varargs @
-  error_option Implicit_function_declaration @
-  error_option Pointer_type_mismatch @
-  error_option Compare_distinct_pointer_types @
-  error_option Implicit_int @
-  error_option Main_return_type @
-  error_option Invalid_noreturn @
-  error_option Return_type @
-  error_option Literal_range @
-  error_option Unknown_pragmas @
-  error_option CompCert_conformance @
-  error_option Inline_asm_sdump @
-  error_option Unused_variable @
-  error_option Unused_parameter @
-  error_option Wrong_ais_parameter @
-  error_option Unused_ais_parameter @
-  error_option Ignored_attributes @
-  error_option Extern_after_definition @
-  error_option Static_in_inline @
-  error_option Flexible_array_extensions @
-  error_option Tentative_incomplete_static @
-  error_option Reduced_alignment @
+  List.concat (List.map (fun (w, active) -> error_option w) all_warnings) @
   [Exact ("-Wfatal-errors"), Set error_fatal;
    Exact ("-fdiagnostics-color"), Ignore; (* Either output supports it or no color *)
    Exact ("-fno-diagnostics-color"), Unset color_diagnostics;
@@ -469,7 +402,7 @@ let raise_on_errors () =
 let crash exn =
   if Version.buildnr <> "" && Version.tag <> "" then begin
     let backtrace = Printexc.get_backtrace () in
-    eprintf "%tThis is CompCert, %s, Build:%s, Tag:%s%t\n"
+    eprintf "%tThis is CompCert, Release %s, Build:%s, Tag:%s%t\n"
       bc Version.version Version.buildnr Version.tag rsc;
     eprintf "Backtrace (please include this in your support request):\n%s"
       backtrace;
@@ -488,3 +421,6 @@ let crash exn =
 let no_loc = ("", -1)
 
 let file_loc file = (file,-10)
+
+let active_warning ty =
+  fst (classify_warning ty) <> SuppressedMsg
diff --git a/cparser/Diagnostics.mli b/cparser/Diagnostics.mli
index ded8019f..0f0a0ea5 100644
--- a/cparser/Diagnostics.mli
+++ b/cparser/Diagnostics.mli
@@ -22,22 +22,22 @@ exception Abort
   (** Exception raised upon fatal errors *)
 
 val check_errors : unit -> unit
-  (** Check whether errors occured and raise abort if an error occured *)
+  (** Check whether errors occurred and raise abort if an error occurred *)
 
 type warning_type =
   | Unnamed                        (** warnings which cannot be turned off *)
   | Unknown_attribute              (** usage of unsupported/unknown attributes *)
-  | Zero_length_array              (** gnu extension for zero lenght arrays *)
+  | Zero_length_array              (** gnu extension for zero length arrays *)
   | Celeven_extension              (** C11 features *)
   | Gnu_empty_struct               (** gnu extension for empty struct *)
-  | Missing_declarations           (** declation which do not declare anything *)
+  | Missing_declarations           (** declaration which do not declare anything *)
   | Constant_conversion            (** dangerous constant conversions *)
   | Int_conversion                 (** pointer <-> int conversions *)
   | Varargs                        (** promotable vararg argument *)
   | Implicit_function_declaration  (** deprecated implicit function declaration *)
   | Pointer_type_mismatch          (** pointer type mismatch in ?: operator *)
   | Compare_distinct_pointer_types (** comparison between different pointer types *)
-  | Implicit_int                   (** implict int parameter or return type *)
+  | Implicit_int                   (** implicit int parameter or return type *)
   | Main_return_type               (** wrong return type for main *)
   | Invalid_noreturn               (** noreturn function containing return *)
   | Return_type                    (** void return in non-void function *)
@@ -55,6 +55,7 @@ type warning_type =
   | Flexible_array_extensions      (** usange of structs with flexible arrays in structs and arrays *)
   | Tentative_incomplete_static    (** static tentative definition with incomplete type *)
   | Reduced_alignment              (** alignment reduction *)
+  | Non_linear_cond_expr           (** condition that cannot be linearized *)
 
 val warning  : (string * int) -> warning_type -> ('a, Format.formatter, unit, unit, unit, unit) format6 -> 'a
 (** [warning (f,c) w fmt arg1 ... argN] formats the arguments [arg1] to [argN] as warining according to
@@ -95,3 +96,6 @@ val file_loc : string -> string * int
 
 val error_summary : unit -> unit
 (** Print a summary containing the numbers of errors encountered *)
+
+val active_warning : warning_type -> bool
+(** Test whether a warning is active to avoid costly checks *)
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index a3915dc4..73a80c6f 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -21,7 +21,7 @@ open Machine
 open Cabs
 open C
 open Diagnostics
-open !Cutil
+open! Cutil
 
 (** * Utility functions *)
 
@@ -39,7 +39,16 @@ let warning loc =
 let print_typ env fmt ty =
   match ty with
   | TNamed _  ->
-      Format.fprintf fmt "'%a' (aka '%a')" Cprint.typ_raw ty Cprint.typ_raw (unroll env ty)
+    Format.fprintf fmt "'%a'" Cprint.typ_raw ty;
+    let ty' = unroll env ty in
+    if not (is_anonymous_type ty')
+    then Format.fprintf fmt " (aka '%a')" Cprint.typ_raw ty'
+  | TStruct (id,_) when id.C.name = "" ->
+    Format.fprintf fmt "'struct <anonymous>'"
+  | TUnion (id,_) when id.C.name = "" ->
+    Format.fprintf fmt "'union <anonymous>'"
+  | TEnum (id,_) when id.C.name = "" ->
+    Format.fprintf fmt "'enum <anonymous>'"
   | _ -> Format.fprintf fmt "'%a'" Cprint.typ_raw ty
 
 let pp_field fmt id =
@@ -172,7 +181,7 @@ let combine_toplevel_definitions loc env s old_sto old_ty sto ty =
 	error loc "static declaration of '%s' follows non-static declaration" s;
         sto
     | Storage_static,_ -> Storage_static (* Static stays static *)
-    | Storage_extern,_ -> sto
+    | Storage_extern,_ -> if is_function_type env new_ty then Storage_extern else sto
     | Storage_default,Storage_extern ->
       if is_global_defined s && is_function_type env ty then
         warning loc Extern_after_definition "this extern declaration follows a non-extern definition and is ignored";
@@ -258,7 +267,7 @@ let enter_or_refine_function loc env id sto ty =
 
 (* Forward declarations *)
 
-let elab_expr_f : (cabsloc -> Env.t -> Cabs.expression -> C.exp * Env.t) ref
+let elab_expr_f : (Cabs.loc -> Env.t -> Cabs.expression -> C.exp * Env.t) ref
   = ref (fun _ _ _ -> assert false)
 
 let elab_funbody_f : (C.typ -> bool -> bool -> Env.t -> statement -> C.stmt) ref
@@ -411,11 +420,12 @@ let elab_char_constant loc wide chars =
     warning loc Unnamed "character constant too long for its type";
   (* C99 6.4.4.4 item 10: single character -> represent at type char
      or wchar_t *)
-  Ceval.normalize_int v
+  let k =
     (if List.length chars = 1 then
        if wide then wchar_ikind() else IChar
      else
-       IInt)
+       IInt) in
+  (Ceval.normalize_int v k, k)
 
 let elab_string_literal loc wide chars =
   let nbits = if wide then 8 * !config.sizeof_wchar else 8 in
@@ -443,7 +453,7 @@ let elab_constant loc = function
       let (v, fk) = elab_float_constant f in
       CFloat(v, fk)
   | CONST_CHAR(wide, s) ->
-      CInt(elab_char_constant loc wide s, IInt, "")
+      CInt(fst (elab_char_constant loc wide s), IInt, "")
   | CONST_STRING(wide, s) ->
       elab_string_literal loc wide s
 
@@ -836,7 +846,7 @@ and elab_type_declarator ?(fundef = false) loc env ty = function
   | Cabs.PROTO(d, (params, vararg)) ->
       elab_return_type loc env ty;
       let (ty, a) = get_nontype_attrs env ty in
-      let (params', env') = elab_parameters env params in
+      let (params', env') = elab_parameters loc env params in
       (* For a function declaration (fundef = false), the scope introduced
          to treat parameters ends here, so we discard the extended
          environment env' returned by elab_parameters.
@@ -862,13 +872,15 @@ and elab_type_declarator ?(fundef = false) loc env ty = function
 
 (* Elaboration of parameters in a prototype *)
 
-and elab_parameters env params =
+and elab_parameters loc env params =
   (* Prototype introduces a new scope *)
   let (vars, env) = mmap elab_parameter (Env.new_scope env) params in
   (* Catch special case f(t) where t is void or a typedef to void *)
   match vars with
     | [ ( {C.name=""}, t) ] when is_void_type env t -> [],env
-    | _ -> vars,env
+    | _ -> if List.exists (fun (id, t) -> id.C.name = "" && is_void_type env t) vars then
+        error loc "'void' must be the only parameter";
+      (vars, env)
 
 (* Elaboration of a function parameter *)
 
@@ -941,31 +953,7 @@ and elab_name_group loc env  (spec, namelist) =
     ((id, add_attributes_type a ty), env1) in
   (mmap elab_one_name env' namelist, sto)
 
-(* Elaboration of an init-name group *)
 
-and elab_init_name_group loc env (spec, namelist) =
-  let (sto, inl, noret, tydef, bty, env') =
-    elab_specifier ~only:(namelist=[]) loc env spec in
-  if noret && tydef then
-    error loc "'_Noreturn' can only appear on functions";
-  let elab_one_name env (Init_name (Name (id, decl, attr, loc), init)) =
-    let ((ty, _), env1) =
-      elab_type_declarator loc env bty decl in
-    let a = elab_attributes env attr in
-    let has_fun_typ = is_function_type env ty in
-    if inl && not has_fun_typ then
-      error loc "'inline' can only appear on functions";
-    let a' =
-      if noret then begin
-        warning loc Celeven_extension "_Noreturn functions are a C11 extension";
-        if not has_fun_typ then
-          error loc "'_Noreturn' can only appear on functions";
-        add_attributes [Attr("noreturn",[])] a
-      end else a in
-    if has_std_alignas env ty && has_fun_typ then
-      error loc "alignment specified for function '%s'" id;
-    ((id, add_attributes_type a' ty, init), env1) in
-  (mmap elab_one_name env' namelist, sto, tydef)
 
 (* Elaboration of a field group *)
 
@@ -1078,7 +1066,7 @@ and elab_struct_or_union_info kind loc env members attrs =
   | fld :: rem ->
       if wrap incomplete_type loc env' fld.fld_typ then
         (* Must be fatal otherwise we get problems constructing the init *)
-        fatal_error loc "member '%a' has incomplete type" pp_field fld.fld_name;
+        fatal_error loc "member '%a' has incomplete type %a" pp_field fld.fld_name (print_typ env) fld.fld_typ;
       if wrap contains_flex_array_mem loc env' fld.fld_typ && kind = Struct then
         warning loc Flexible_array_extensions "%a may not be used as a struct member due to flexible array member" (print_typ env) fld.fld_typ;
       check_reduced_alignment loc env' fld.fld_typ;
@@ -1633,7 +1621,7 @@ end;
 try
   elab_item (I.top env root ty_root) ie []
 with No_default_init ->
-  error loc "variable has incomplete type %a" Cprint.typ ty_root;
+  error loc "variable has incomplete type %a" (print_typ env) ty_root;
   raise Exit
 
 (* Elaboration of a top-level initializer *)
@@ -1708,7 +1696,7 @@ let elab_expr ctx loc env a =
         error "arithmetic on a pointer to an incomplete type %a in binary '%c'" (print_typ env) ty s
   in
 
-  let check_static_var id sto ty =
+  let check_static_var env id sto ty =
     if ctx.ctx_nonstatic_inline
     && sto = Storage_static
     && List.mem AConst (attributes_of_type env ty)
@@ -1722,7 +1710,7 @@ let elab_expr ctx loc env a =
   | VARIABLE s ->
       begin match wrap Env.lookup_ident loc env s with
         | (id, Env.II_ident(sto, ty)) ->
-          check_static_var id sto ty;
+          check_static_var env id sto ty;
           { edesc = EVar id; etyp = ty },env
       | (id, Env.II_enum v) ->
           { edesc = EConst(CEnum(id, v)); etyp = TInt(enum_ikind, []) },env
@@ -1824,13 +1812,54 @@ let elab_expr ctx loc env a =
           (print_typ env) ty (print_typ env) ty'  (print_typ env) ty'  (print_typ env) ty;
       { edesc = ECall(ident, [b2; b3]); etyp = ty },env
 
+  | CALL((VARIABLE "__builtin_sel" as a0), al) ->
+      begin match al with
+      | [a1; a2; a3] ->
+          let b0,env = elab env a0 in
+          let b1,env = elab env a1 in
+          let b2,env = elab env a2 in
+          let b3,env = elab env a3 in
+          if not (is_scalar_type env b1.etyp) then
+            error "first argument of '__builtin_sel' is not a scalar type (invalid %a)"
+               (print_typ env) b1.etyp;
+          let tyres =
+            match pointer_decay env b2.etyp, pointer_decay env b3.etyp with
+            | (TInt _ | TFloat _ | TEnum _), (TInt _ | TFloat _ | TEnum _) ->
+                binary_conversion env b2.etyp b3.etyp
+            | (TPtr(ty1, a1) as pty1), (TPtr(ty2, a2)  as pty2) ->
+                if is_void_type env ty1 || is_void_type env ty2 then
+                  TPtr(TVoid (add_attributes a1 a2), [])
+                else begin
+                  match combine_types AttrIgnoreAll env pty1 pty2 with
+                  | None ->
+                      warning Pointer_type_mismatch "the second and third arguments of '__builtin_sel' have incompatible pointer types (%a and %a)"
+                     (print_typ env) pty1  (print_typ env) pty2;
+                     (* tolerance *)
+                     TPtr(TVoid (add_attributes a1 a2), [])
+                  | Some ty -> ty
+                end
+            | _, _ ->
+                fatal_error "wrong types (%a and %a) for the second and third arguments of '__builtin_sel'"
+                  (print_typ env) b2.etyp (print_typ env) b3.etyp
+
+            in
+          { edesc = ECall(b0, [b1; b2; b3]); etyp = tyres }, env
+      | _ ->
+          fatal_error "'__builtin_sel' expect 3 arguments"
+      end
+
   | CALL(a1, al) ->
       let b1,env =
         (* Catch the old-style usage of calling a function without
            having declared it *)
         match a1 with
         | VARIABLE n when not (Env.ident_is_bound env n) ->
-            warning Implicit_function_declaration "implicit declaration of function '%s' is invalid in C99" n;
+            let is_builtin = String.length n > 10
+                           && String.sub n 0 10 = "__builtin_" in
+            if is_builtin then
+              error "use of unknown builtin '%s'" n
+            else
+              warning Implicit_function_declaration "implicit declaration of function '%s' is invalid in C99" n;
             let ty = TFun(TInt(IInt, []), None, false, []) in
             (* Check against other definitions and enter in env *)
             let (id, sto, env, ty, linkage) =
@@ -1839,7 +1868,7 @@ let elab_expr ctx loc env a =
             emit_elab ~linkage env loc (Gdecl(sto, id, ty, None));
             { edesc = EVar id; etyp = ty },env
         | _ -> elab env a1 in
-      let bl = mmap elab env al in
+      let (bl, env) = mmap elab env al in
       (* Extract type information *)
       let (res, args, vararg) =
         match unroll env b1.etyp with
@@ -1854,14 +1883,19 @@ let elab_expr ctx loc env a =
       (* Type-check the arguments against the prototype *)
       let bl',env =
         match args with
-        | None -> bl
-        | Some proto -> elab_arguments 1 bl proto vararg in
+        | None ->
+          List.iter (fun arg ->
+              let arg_typ = argument_conversion env arg.etyp in
+              if incomplete_type env arg_typ then
+                error "argument type %a is incomplete" (print_typ env) arg.etyp;
+            ) bl; (bl,env)
+        | Some proto -> elab_arguments 1 (bl, env) proto vararg in
       { edesc = ECall(b1, bl'); etyp = res },env
 
   | UNARY(POSINCR, a1) ->
-      elab_pre_post_incr_decr Opostincr "increment" a1
+      elab_pre_post_incr_decr env Opostincr "increment" a1
   | UNARY(POSDECR, a1) ->
-      elab_pre_post_incr_decr Opostdecr "decrement" a1
+      elab_pre_post_incr_decr env Opostdecr "decrement" a1
 
 (* 6.5.4 Cast operators *)
 
@@ -1890,6 +1924,8 @@ let elab_expr ctx loc env a =
 
   | CAST ((spec, dcl), ie) ->
       let (ty, env) = elab_type loc env spec dcl in
+      if not (is_array_type env ty) && incomplete_type env ty then
+        fatal_error "ill-formed compound literal with incomplete type %a" (print_typ env) ty;
       begin match elab_initializer loc env "<compound literal>" ty ie with
       | (ty', Some i) -> { edesc = ECompound(ty', i); etyp = ty' },env
       | (ty', None)   -> fatal_error "ill-formed compound literal"
@@ -2020,20 +2056,20 @@ let elab_expr ctx loc env a =
       end
 
   | UNARY(PREINCR, a1) ->
-      elab_pre_post_incr_decr Opreincr "increment" a1
+      elab_pre_post_incr_decr env Opreincr "increment" a1
   | UNARY(PREDECR, a1) ->
-      elab_pre_post_incr_decr Opredecr "decrement" a1
+      elab_pre_post_incr_decr env Opredecr "decrement" a1
 
 (* 6.5.5 to 6.5.12  Binary operator expressions *)
 
   | BINARY(MUL, a1, a2) ->
-      elab_binary_arithmetic "*" Omul a1 a2
+      elab_binary_arithmetic env "*" Omul a1 a2
 
   | BINARY(DIV, a1, a2) ->
-      elab_binary_arithmetic "/" Odiv a1 a2
+      elab_binary_arithmetic env "/" Odiv a1 a2
 
   | BINARY(MOD, a1, a2) ->
-      elab_binary_integer "%" Omod a1 a2
+      elab_binary_integer env "%" Omod a1 a2
 
   | BINARY(ADD, a1, a2) ->
       let b1,env = elab env a1 in
@@ -2083,37 +2119,37 @@ let elab_expr ctx loc env a =
       { edesc = EBinop(Osub, b1, b2, tyop); etyp = tyres },env
 
   | BINARY(SHL, a1, a2) ->
-      elab_shift "<<" Oshl a1 a2
+      elab_shift env "<<" Oshl a1 a2
 
   | BINARY(SHR, a1, a2) ->
-      elab_shift ">>" Oshr a1 a2
+      elab_shift env ">>" Oshr a1 a2
 
   | BINARY(EQ, a1, a2) ->
-      elab_comparison Oeq a1 a2
+      elab_comparison env Oeq a1 a2
   | BINARY(NE, a1, a2) ->
-      elab_comparison One a1 a2
+      elab_comparison env One a1 a2
   | BINARY(LT, a1, a2) ->
-      elab_comparison Olt a1 a2
+      elab_comparison env Olt a1 a2
   | BINARY(GT, a1, a2) ->
-      elab_comparison Ogt a1 a2
+      elab_comparison env Ogt a1 a2
   | BINARY(LE, a1, a2) ->
-      elab_comparison Ole a1 a2
+      elab_comparison env Ole a1 a2
   | BINARY(GE, a1, a2) ->
-      elab_comparison Oge a1 a2
+      elab_comparison env Oge a1 a2
 
   | BINARY(BAND, a1, a2) ->
-      elab_binary_integer "&" Oand a1 a2
+     elab_binary_integer env "&" Oand a1 a2
   | BINARY(BOR, a1, a2) ->
-      elab_binary_integer "|" Oor a1 a2
+     elab_binary_integer env "|" Oor a1 a2
   | BINARY(XOR, a1, a2) ->
-      elab_binary_integer "^" Oxor a1 a2
+     elab_binary_integer env "^" Oxor a1 a2
 
 (* 6.5.13 and 6.5.14 Logical operator expressions *)
 
   | BINARY(AND, a1, a2) ->
-      elab_logical_operator "&&" Ologand a1 a2
+      elab_logical_operator env "&&" Ologand a1 a2
   | BINARY(OR, a1, a2) ->
-      elab_logical_operator "||" Ologor a1 a2
+      elab_logical_operator env "||" Ologor a1 a2
 
 (* 6.5.15 Conditional expressions *)
   | QUESTION(a1, a2, a3) ->
@@ -2229,7 +2265,7 @@ let elab_expr ctx loc env a =
       { edesc = EBinop (Ocomma, b1, b2, ty2); etyp = ty2 },env
 
 (* Elaboration of pre- or post- increment/decrement *)
-  and elab_pre_post_incr_decr op msg a1 =
+  and elab_pre_post_incr_decr env op msg a1 =
     let b1,env = elab env a1 in
     if not (is_modifiable_lvalue env b1) then
       error "expression is not assignable";
@@ -2238,7 +2274,7 @@ let elab_expr ctx loc env a =
     { edesc = EUnop(op, b1); etyp = b1.etyp },env
 
 (* Elaboration of binary operators over integers *)
-  and elab_binary_integer msg op a1 a2 =
+  and elab_binary_integer env msg op a1 a2 =
     let b1,env = elab env a1 in
     let b2,env = elab env a2 in
     if not ((is_integer_type env b1.etyp) && (is_integer_type env b2.etyp)) then
@@ -2248,7 +2284,7 @@ let elab_expr ctx loc env a =
     { edesc = EBinop(op, b1, b2, tyres); etyp = tyres },env
 
 (* Elaboration of binary operators over arithmetic types *)
-  and elab_binary_arithmetic msg op a1 a2 =
+  and elab_binary_arithmetic env msg op a1 a2 =
     let b1,env = elab env a1 in
     let b2,env = elab env a2 in
     if not ((is_arith_type env b1.etyp) && (is_arith_type env b2.etyp)) then
@@ -2258,7 +2294,7 @@ let elab_expr ctx loc env a =
     { edesc = EBinop(op, b1, b2, tyres); etyp = tyres },env
 
 (* Elaboration of shift operators *)
-  and elab_shift msg op a1 a2 =
+  and elab_shift env msg op a1 a2 =
     let b1,env = elab env a1 in
     let b2,env = elab env a2 in
     if not ((is_integer_type env b1.etyp) && (is_integer_type env b2.etyp)) then
@@ -2268,7 +2304,7 @@ let elab_expr ctx loc env a =
     { edesc = EBinop(op, b1, b2, tyres); etyp = tyres },env
 
 (* Elaboration of comparisons *)
-  and elab_comparison op a1 a2 =
+  and elab_comparison env op a1 a2 =
       let b1,env = elab env a1 in
       let b2,env = elab env a2 in
       let resdesc =
@@ -2305,7 +2341,7 @@ let elab_expr ctx loc env a =
       { edesc = resdesc; etyp = TInt(IInt, []) },env
 
 (* Elaboration of && and || *)
-  and elab_logical_operator msg op a1 a2 =
+  and elab_logical_operator env msg op a1 a2 =
     let b1,env = elab env a1 in
     let b2,env = elab env a2 in
     if not ((is_scalar_type env b1.etyp) && (is_scalar_type env b2.etyp)) then
@@ -2373,113 +2409,106 @@ let __func__type_and_init s =
 
 (* Elaboration of top-level and local definitions *)
 
-let enter_typedefs loc env sto dl =
-  if sto <> Storage_default then
-    error loc "non-default storage class on 'typedef' definition";
-  if dl = [] then
-    warning loc Missing_declarations "typedef requires a name";
-  List.fold_left (fun env (s, ty, init) ->
-    if init <> NO_INIT then
-      error loc "initializer in typedef";
-    if has_std_alignas env ty then
-      error loc "alignment specified for typedef '%s'" s;
-    List.iter
-      (fun a -> match class_of_attribute a with
-                | Attr_object | Attr_struct ->
-                    error loc "attribute '%s' not allowed in 'typedef'"
-                              (name_of_attribute a)
-                | _ -> ())
-      (attributes_of_type_no_expand ty);
-    match previous_def Env.lookup_typedef env s with
-    | Some (s',ty') when Env.in_current_scope env s' ->
-        if equal_types env ty ty' then begin
-          warning loc Celeven_extension "redefinition of typedef '%s' is a C11 extension" s;
-          env
-        end else begin
-          error loc "typedef redefinition with different types (%a vs %a)"
-            (print_typ env) ty (print_typ env) ty';
-          env
-        end
-    | _ ->
-        if redef Env.lookup_ident env s then
-          error loc "redefinition of '%s' as different kind of symbol" s;
-        let (id, env') = Env.enter_typedef env s ty in
-        check_reduced_alignment loc env' ty;
-        emit_elab env loc (Gtypedef(id, ty));
-        env') env dl
-
-let enter_decdefs local nonstatic_inline loc env sto dl =
-  (* Sanity checks on storage class *)
-  if (sto = Storage_auto || sto = Storage_register) && not local then
-    fatal_error loc "illegal storage class %s on file-scoped variable"
-                    (name_of_storage_class sto);
-  if sto <> Storage_default && dl = [] then
-    warning loc Missing_declarations "declaration does not declare anything";
-  let enter_decdef (decls, env) (s, ty, init) =
-    let isfun = is_function_type env ty in
-    if sto = Storage_register && has_std_alignas env ty then
-      error loc "alignment specified for 'register' object '%s'" s;
-    if sto = Storage_extern && init <> NO_INIT then
-      error loc "'extern' declaration variable has an initializer";
-    if local && isfun then begin
-      match sto with
-      | Storage_static ->
-          error loc "function declared in block scope cannot have 'static' storage class"
-      | Storage_auto | Storage_register ->
-          error loc "illegal storage class %s on function"
-                    (name_of_storage_class sto)
-      | _ -> ()
-    end;
-    if is_qualified_array ty then
-      error loc "type qualifier used in array declarator outside of function prototype";
-    (* Local variable declarations with default storage are treated as 'auto'.
-       Local function declarations with default storage remain with
-       default storage. *)
-    let sto1 =
-      if local && sto = Storage_default && not isfun
-      then Storage_auto
-      else sto in
-    (* enter ident in environment with declared type, because
-       initializer can refer to the ident *)
-    let (id, sto', env1, ty, linkage) =
-      enter_or_refine_ident local loc env s sto1 ty in
-    if init <> NO_INIT && not local then
-      add_global_define loc s;
-    if not isfun && is_void_type env ty then
-      fatal_error loc "'%s' has incomplete type" s;
-    (* process the initializer *)
-    let (ty', init') = elab_initializer loc env1 s ty init in
-    (* update environment with refined type *)
-    let env2 = Env.add_ident env1 id sto' ty' in
-    (* check for incomplete type *)
-    if not isfun && wrap incomplete_type loc env ty' then
-      if not local && sto' = Storage_static then begin
-        warning loc Tentative_incomplete_static "tentative static definition with incomplete type";
-      end else if local && sto' <> Storage_extern then
-        error loc "variable has incomplete type %a" (print_typ env) ty';
-    (* check if alignment is reduced *)
-    check_reduced_alignment loc env ty';
-    (* check for static variables in nonstatic inline functions *)
-    if local && nonstatic_inline
-             && sto' = Storage_static
-             && not (List.mem AConst (attributes_of_type env ty')) then
-      warning loc Static_in_inline "non-constant static local variable '%s' in inline function may be different in different files" s;
-    if local && not isfun && sto' <> Storage_extern && sto' <> Storage_static then
-      (* Local definition *)
-      ((sto', id, ty', init') :: decls, env2)
+let enter_typedef loc env sto (s, ty, init) =
+  if init <> NO_INIT then
+    error loc "initializer in typedef";
+  if has_std_alignas env ty then
+    error loc "alignment specified for typedef '%s'" s;
+  List.iter
+    (fun a -> match class_of_attribute a with
+       | Attr_object | Attr_struct ->
+         error loc "attribute '%s' not allowed in 'typedef'"
+           (name_of_attribute a)
+       | _ -> ())
+    (attributes_of_type_no_expand ty);
+  match previous_def Env.lookup_typedef env s with
+  | Some (s',ty') when Env.in_current_scope env s' ->
+    if equal_types env ty ty' then begin
+      warning loc Celeven_extension "redefinition of typedef '%s' is a C11 extension" s;
+      env
+    end
     else begin
-      (* Global definition *)
-      emit_elab ~linkage env2 loc (Gdecl(sto', id, ty', init'));
-      (* Make sure the initializer is constant. *)
-      begin match init' with
+      error loc "redefinition of typedef '%s' with different type (%a vs %a)"
+        s (print_typ env) ty (print_typ env) ty';
+      env
+    end
+  | _ ->
+    if redef Env.lookup_ident env s then
+      error loc "redefinition of '%s' as different kind of symbol" s;
+    let (id, env') = Env.enter_typedef env s ty in
+    check_reduced_alignment loc env' ty;
+    emit_elab env loc (Gtypedef(id, ty));
+    env'
+
+let enter_decdef local nonstatic_inline loc sto (decls, env) (s, ty, init) =
+  let isfun = is_function_type env ty in
+  let has_init = init <> NO_INIT in
+  if sto = Storage_register && has_std_alignas env ty then
+    error loc "alignment specified for 'register' object '%s'" s;
+  if sto = Storage_extern && has_init then
+    error loc "'extern' declaration variable has an initializer";
+  if local && isfun then begin
+    match sto with
+    | Storage_static ->
+      error loc "function declared in block scope cannot have 'static' storage class"
+    | Storage_auto | Storage_register ->
+      error loc "illegal storage class %s on function"
+        (name_of_storage_class sto)
+    | _ -> ()
+  end;
+  if is_qualified_array ty then
+    error loc "type qualifier used in array declarator outside of function prototype";
+  (* Local variable declarations with default storage are treated as 'auto'.
+     Local function declarations with default storage remain with
+     default storage. *)
+  let sto1 =
+    if local && sto = Storage_default && not isfun
+    then Storage_auto
+    else sto in
+  (* enter ident in environment with declared type, because
+     initializer can refer to the ident *)
+  let (id, sto', env1, ty, linkage) =
+    enter_or_refine_ident local loc env s sto1 ty in
+  if has_init && not local then
+    add_global_define loc s;
+  (* check if the type is void or incomplete and the declaration is initialized *)
+  if not isfun then begin
+    let incomplete_init = not (is_array_type env1 ty) && wrap incomplete_type loc env1 ty && has_init in
+    if is_void_type env1 ty || incomplete_init then
+      fatal_error loc "variable '%s' has incomplete type %a" s (print_typ env) ty;
+  end;
+  (* process the initializer *)
+  let (ty', init') = elab_initializer loc env1 s ty init in
+  (* update environment with refined type *)
+  let env2 = Env.add_ident env1 id sto' ty' in
+  (* check for incomplete type *)
+  if not isfun && wrap incomplete_type loc env ty' then
+    if not local && sto' = Storage_static then begin
+      warning loc Tentative_incomplete_static "tentative static definition with incomplete type";
+    end
+    else if local && sto' <> Storage_extern then
+      error loc "variable '%s' has incomplete type %a" s (print_typ env) ty';
+  (* check if alignment is reduced *)
+  check_reduced_alignment loc env ty';
+  (* check for static variables in nonstatic inline functions *)
+  if local && nonstatic_inline
+     && sto' = Storage_static
+     && not (List.mem AConst (attributes_of_type env ty')) then
+    warning loc Static_in_inline "non-constant static local variable '%s' in inline function may be different in different files" s;
+  if local && not isfun && sto' <> Storage_extern && sto' <> Storage_static then
+    (* Local definition *)
+    ((sto', id, ty', init') :: decls, env2)
+  else begin
+    (* Global definition *)
+    emit_elab ~linkage env2 loc (Gdecl(sto', id, ty', init'));
+    (* Make sure the initializer is constant. *)
+    begin match init' with
       | Some i when not (Ceval.is_constant_init env2 i) ->
-          error loc "initializer is not a compile-time constant"
+        error loc "initializer is not a compile-time constant"
       | _ -> ()
-      end;
-      (decls, env2)
-    end in
-  let (decls, env') = List.fold_left enter_decdef ([], env) dl in
-  (List.rev decls, env')
+    end;
+    (decls, env2)
+  end
 
 (* Processing of K&R-style function definitions.  Synopsis:
       T f(X1, ..., Xn)
@@ -2652,10 +2681,10 @@ let elab_fundef genv spec name defs body loc =
      and additionally they should have an identifier. In both cases a fatal
      error is raised in order to avoid problems at later places. *)
   let add_param env (id, ty) =
-    if wrap incomplete_type loc env ty then
-      fatal_error loc "parameter has incomplete type";
     if id.C.name = "" then
       fatal_error loc "parameter name omitted";
+    if wrap incomplete_type loc env ty then
+      fatal_error loc "parameter '%s' has incomplete type %a" id.C.name (print_typ env) ty;
     Env.add_ident env id Storage_default ty
   in
   (* Enter parameters and extra declarations in the local environment.
@@ -2663,7 +2692,7 @@ let elab_fundef genv spec name defs body loc =
      For prototyped functions this has been done by [elab_fundef_name]
      already, but some parameter may have been shadowed by the
      function name, while it should be the other way around, e.g.
-     [int f(int f) { return f+1; }], with [f] refering to the
+     [int f(int f) { return f+1; }], with [f] referring to the
      parameter [f] and not to the function [f] within the body of the
      function. *)
   let lenv =
@@ -2735,6 +2764,51 @@ let elab_fundef genv spec name defs body loc =
   genv
 
 (* Definitions *)
+let elab_decdef (for_loop: bool) (local: bool) (nonstatic_inline: bool)
+                (env: Env.t) ((spec, namelist): Cabs.init_name_group)
+                (loc: Cabs.loc) : decl list * Env.t =
+  let (sto, inl, noret, tydef, bty, env') =
+    elab_specifier ~only:(namelist=[]) loc env spec in
+  (* Sanity checks on storage class *)
+  if tydef then begin
+    if sto <> Storage_default then
+      error loc "non-default storage class on 'typedef' definition";
+    if namelist = [] then
+      warning loc Missing_declarations "typedef requires a name";
+  end else begin
+    if (sto = Storage_auto || sto = Storage_register) && not local then
+      fatal_error loc "illegal storage class %s on file-scoped variable"
+        (name_of_storage_class sto);
+    if sto <> Storage_default && namelist = [] then
+      warning loc Missing_declarations "declaration does not declare anything";
+  end;
+  let elab_one_name (decls, env) (Init_name (Name (id, decl, attr, loc), init)) =
+    let ((ty, _), env1) =
+      elab_type_declarator loc env bty decl in
+    let a = elab_attributes env attr in
+    let has_fun_typ = is_function_type env ty in
+    if for_loop && (has_fun_typ || sto = Storage_extern || sto = Storage_static || tydef) then
+      error loc "declaration of non-local variable in 'for' loop" ;
+    if has_fun_typ then begin
+      if noret then
+        warning loc Celeven_extension "_Noreturn functions are a C11 extension";
+    end else begin
+      if inl then
+        error loc "'inline' can only appear on functions";
+      if noret then
+        error loc "'_Noreturn' can only appear on functions";
+    end;
+    let a' = if noret then add_attributes [Attr ("noreturn", [])] a else a in
+    if has_std_alignas env ty && has_fun_typ then
+      error loc "alignment specified for function '%s'" id;
+    let decl = (id, add_attributes_type a' ty, init) in
+    if tydef then
+      (decls, enter_typedef loc env1 sto decl)
+    else
+      enter_decdef local nonstatic_inline loc sto (decls, env1) decl
+  in
+  let (decls, env') = List.fold_left elab_one_name ([],env') namelist in
+  (List.rev decls, env')
 
 let elab_definition (for_loop: bool) (local: bool) (nonstatic_inline: bool)
                     (env: Env.t) (def: Cabs.definition)
@@ -2749,18 +2823,7 @@ let elab_definition (for_loop: bool) (local: bool) (nonstatic_inline: bool)
 
   (* "int x = 12, y[10], *z" *)
   | DECDEF(init_name_group, loc) ->
-      let ((dl, env1), sto, tydef) =
-        elab_init_name_group loc env init_name_group in
-      if for_loop then begin
-        let fun_declaration = List.exists (fun (_, ty, _) -> is_function_type env ty) dl in
-        if fun_declaration || sto = Storage_extern || sto = Storage_static || tydef then
-          error loc "declaration of non-local variable in 'for' loop" ;
-      end;
-      if tydef then
-        let env2 = enter_typedefs loc env1 sto dl
-        in ([], env2)
-      else
-        enter_decdefs local nonstatic_inline loc env1 sto dl
+    elab_decdef for_loop local nonstatic_inline env init_name_group loc
 
   (* pragma *)
   | PRAGMA(s, loc) ->
@@ -2887,48 +2950,49 @@ let rec elab_stmt env ctx s =
 (* 6.8.4 Conditional statements *)
 
   | If(a, s1, s2, loc) ->
-      let a',env = elab_expr ctx loc env a in
-      if not (is_scalar_type env a'.etyp) then
+      let a',env' = elab_expr ctx loc (Env.new_scope env) a in
+      if not (is_scalar_type env' a'.etyp) then
         error loc "controlling expression of 'if' does not have scalar type (%a invalid)"
-          (print_typ env) a'.etyp;
-      let s1',env = elab_stmt env ctx s1 in
-      let s2',env =
+          (print_typ env') a'.etyp;
+      let s1' = elab_stmt_new_scope env' ctx s1 in
+      let s2' =
         match s2 with
-          | None -> sskip,env
-          | Some s2 -> elab_stmt env ctx s2
+          | None -> sskip
+          | Some s2 -> elab_stmt_new_scope env' ctx s2
       in
       { sdesc = Sif(a', s1', s2'); sloc = elab_loc loc },env
 
 (* 6.8.5 Iterative statements *)
 
   | WHILE(a, s1, loc) ->
-      let a',env = elab_expr ctx loc env a in
-      if not (is_scalar_type env a'.etyp) then
+      let a',env' = elab_expr ctx loc (Env.new_scope env) a in
+      if not (is_scalar_type env' a'.etyp) then
         error loc "controlling expression of 'while' does not have scalar type (%a invalid)"
-          (print_typ env) a'.etyp;
-      let s1',env = elab_stmt env (ctx_loop ctx) s1 in
+          (print_typ env') a'.etyp;
+      let s1' = elab_stmt_new_scope env' (ctx_loop ctx) s1 in
       { sdesc = Swhile(a', s1'); sloc = elab_loc loc },env
 
   | DOWHILE(a, s1, loc) ->
-      let s1',env = elab_stmt env (ctx_loop ctx) s1 in
-      let a',env = elab_expr ctx loc env a in
-      if not (is_scalar_type env a'.etyp) then
+      let s1' = elab_stmt_new_scope env (ctx_loop ctx) s1 in
+      let a',env' = elab_expr ctx loc (Env.new_scope env) a in
+      if not (is_scalar_type env' a'.etyp) then
         error loc "controlling expression of 'while' does not have scalar type (%a invalid)"
-          (print_typ env) a'.etyp;
+          (print_typ env') a'.etyp;
       { sdesc = Sdowhile(s1', a'); sloc = elab_loc loc },env
 
   | FOR(fc, a2, a3, s1, loc) ->
+      let env' = Env.new_scope env in
       let (a1', env_decls, decls') =
         match fc with
         | Some (FC_EXP a1) ->
-            let a1,env = elab_for_expr ctx loc env (Some a1) in
+            let a1,env = elab_for_expr ctx loc env' (Some a1) in
             (a1, env, None)
         | None ->
-            let a1,env = elab_for_expr ctx loc env None in
+            let a1,env = elab_for_expr ctx loc env' None in
             (a1, env, None)
         | Some (FC_DECL def) ->
             let (dcl, env') = elab_definition true true ctx.ctx_nonstatic_inline
-                                              (Env.new_scope env) def in
+                                              env' def in
             let loc = elab_loc (Cabshelper.get_definitionloc def) in
             (sskip, env',
              Some(List.map (fun d -> {sdesc = Sdecl d; sloc = loc}) dcl)) in
@@ -2940,7 +3004,7 @@ let rec elab_stmt env ctx s =
       if not (is_scalar_type env_test a2'.etyp) then
         error loc "controlling expression of 'for' does not have scalar type (%a invalid)" (print_typ env) a2'.etyp;
       let a3',env_for = elab_for_expr ctx loc env_test a3 in
-      let s1',env_body = elab_stmt env_for (ctx_loop ctx) s1 in
+      let s1' = elab_stmt_new_scope env_for (ctx_loop ctx) s1 in
       let sfor = { sdesc = Sfor(a1', a2', a3', s1'); sloc = elab_loc loc } in
       begin match decls' with
       | None -> sfor,env
@@ -2949,11 +3013,11 @@ let rec elab_stmt env ctx s =
 
 (* 6.8.4 Switch statement *)
   | SWITCH(a, s1, loc) ->
-      let a',env = elab_expr ctx loc env a in
-      if not (is_integer_type env a'.etyp) then
+      let a',env' = elab_expr ctx loc (Env.new_scope env) a in
+      if not (is_integer_type env' a'.etyp) then
         error loc "controlling expression of 'switch' does not have integer type (%a invalid)"
-          (print_typ env) a'.etyp;
-      let s1',env = elab_stmt env (ctx_switch ctx) s1 in
+          (print_typ env') a'.etyp;
+      let s1' = elab_stmt_new_scope env' (ctx_switch ctx) s1 in
       check_switch_cases s1';
       { sdesc = Sswitch(a', s1'); sloc = elab_loc loc },env
 
@@ -3027,6 +3091,10 @@ let rec elab_stmt env ctx s =
   | DEFINITION def ->
       error (Cabshelper.get_definitionloc def) "ill-placed definition";
       sskip,env
+(* Elaborate a statement as a block whose scope is a strict subset of the scope
+   of its enclosing block. *)
+and elab_stmt_new_scope env ctx s =
+  fst (elab_stmt (Env.new_scope env) ctx s)
 
 and elab_block loc env ctx b =
   let b',_ = elab_block_body (Env.new_scope env) ctx b in
@@ -3079,10 +3147,11 @@ let _ = elab_funbody_f := elab_funbody
 
 let elab_file prog =
   reset();
-  let env = Builtins.environment () in
+  let env = Env.initial () in
   let elab_def env d = snd (elab_definition false false false env d) in
   ignore (List.fold_left elab_def env prog);
   let p = elaborated_program () in
   Checks.unused_variables p;
   Checks.unknown_attrs_program p;
+  Checks.non_linear_conditional p;
   p
diff --git a/cparser/Elab.mli b/cparser/Elab.mli
index f701e8c5..68e33d06 100644
--- a/cparser/Elab.mli
+++ b/cparser/Elab.mli
@@ -18,8 +18,8 @@ val elab_file : Cabs.definition list -> C.program
      definitions as produced by the parser into a program in C abstract
      syntax. *)
 
-val elab_int_constant : Cabs.cabsloc -> string -> int64 * C.ikind
+val elab_int_constant : Cabs.loc -> string -> int64 * C.ikind
 val elab_float_constant : Cabs.floatInfo -> C.float_cst * C.fkind
-val elab_char_constant : Cabs.cabsloc -> bool -> int64 list -> int64
+val elab_char_constant : Cabs.loc -> bool -> int64 list -> int64 * C.ikind
   (* These auxiliary functions are exported so that they can be reused
      in other projects that deal with C-style source languages. *)
diff --git a/cparser/Env.ml b/cparser/Env.ml
index 5fa4571a..4723a725 100644
--- a/cparser/Env.ml
+++ b/cparser/Env.ml
@@ -276,6 +276,46 @@ let add_enum env id info =
 let add_types env_old env_new =
   { env_new with env_ident = env_old.env_ident;env_scope = env_old.env_scope;}
 
+(* Initial environment describing the built-in types and functions *)
+
+module Init = struct
+
+let env = ref empty
+let idents = ref []
+let decls = ref []
+
+let no_loc = ("", -1)
+
+let add_typedef (s, ty) =
+  let (id, env') = enter_typedef !env s ty in
+  env := env';
+  idents := id :: !idents;
+  decls := {gdesc = Gtypedef(id, ty); gloc = no_loc} :: !decls
+
+let add_function (s, (res, args, va)) =
+  let ty =
+    TFun(res,
+         Some (List.map (fun ty -> (fresh_ident "", ty)) args),
+         va, []) in
+  let (id, env') = enter_ident !env s Storage_extern ty in
+  env := env';
+  idents := id :: !idents;
+  decls :=
+    {gdesc = Gdecl(Storage_extern, id, ty, None); gloc = no_loc} :: !decls
+
+end
+
+let initial () = !Init.env
+let initial_identifiers () = !Init.idents
+let initial_declarations () = List.rev !Init.decls
+
+let set_builtins blt =
+  Init.env := empty;
+  Init.idents := [];
+  Init.decls := [];
+  List.iter Init.add_typedef blt.builtin_typedefs;
+  List.iter Init.add_function blt.builtin_functions
+
 (* Error reporting *)
 
 open Printf
diff --git a/cparser/Env.mli b/cparser/Env.mli
index 7ea2c514..1baab68f 100644
--- a/cparser/Env.mli
+++ b/cparser/Env.mli
@@ -77,3 +77,10 @@ val add_typedef : t -> C.ident -> typedef_info -> t
 val add_enum : t -> C.ident -> enum_info -> t
 
 val add_types : t -> t -> t
+
+(* Initial environment describing the builtin types and functions *)
+
+val initial: unit -> t
+val initial_identifiers: unit -> C.ident list
+val initial_declarations: unit -> C.globdecl list
+val set_builtins: C.builtins -> unit
diff --git a/cparser/GCC.ml b/cparser/GCC.ml
index 010d12f3..458e51d3 100644
--- a/cparser/GCC.ml
+++ b/cparser/GCC.ml
@@ -38,10 +38,10 @@ let intPtrType = TPtr(TInt(IInt, []), [])
 let sizeType() = TInt(size_t_ikind(), [])
 
 let builtins = {
-  Builtins.typedefs = [
+  builtin_typedefs = [
   "__builtin_va_list", voidPtrType
 ];
-  Builtins.functions = [
+  builtin_functions = [
   "__builtin___fprintf_chk",  (intType, [ voidPtrType; intType; charConstPtrType ], true) (* first argument is really FILE*, not void*, but we don't want to build in the definition for FILE *);
   "__builtin___memcpy_chk",  (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType(); sizeType() ], false);
   "__builtin___memmove_chk",  (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType(); sizeType() ], false);
diff --git a/cparser/Lexer.mll b/cparser/Lexer.mll
index b2a668f0..e44a330f 100644
--- a/cparser/Lexer.mll
+++ b/cparser/Lexer.mll
@@ -20,14 +20,21 @@ open Pre_parser_aux
 
 module SSet = Set.Make(String)
 
-let lexicon : (string, Cabs.cabsloc -> token) Hashtbl.t = Hashtbl.create 17
+let lexicon : (string, Cabs.loc -> token) Hashtbl.t = Hashtbl.create 17
 let ignored_keywords : SSet.t ref = ref SSet.empty
 
+let reserved_keyword loc id =
+  Diagnostics.fatal_error (loc.Cabs.filename, loc.Cabs.lineno)
+    "illegal use of reserved keyword `%s'" id
+
 let () =
   List.iter (fun (key, builder) -> Hashtbl.add lexicon key builder)
-    [ ("_Alignas", fun loc -> ALIGNAS loc);
+    [ 
+      ("_Alignas", fun loc -> ALIGNAS loc);
       ("_Alignof", fun loc -> ALIGNOF loc);
       ("_Bool", fun loc -> UNDERSCORE_BOOL loc);
+      ("_Complex", fun loc -> reserved_keyword loc "_Complex");
+      ("_Imaginary", fun loc -> reserved_keyword loc "_Imaginary");
       ("__alignof", fun loc -> ALIGNOF loc);
       ("__alignof__", fun loc -> ALIGNOF loc);
       ("__asm", fun loc -> ASM loc);
@@ -170,7 +177,7 @@ let identifier_nondigit =
 let identifier = identifier_nondigit (identifier_nondigit|digit)*
 
 (* Whitespaces *)
-let whitespace_char_no_newline = [' ' '\t' '\012' '\r']
+let whitespace_char_no_newline = [' ' '\t'  '\011' '\012' '\r']
 
 (* Integer constants *)
 let nonzero_digit = ['1'-'9']
@@ -427,10 +434,7 @@ and singleline_comment = parse
   | _      { singleline_comment lexbuf }
 
 {
-  open Streams
-  open Specif
-  open Parser
-  open !Aut.GramDefs
+  open Parser.MenhirLibParser.Inter
 
   (* This is the main entry point to the lexer. *)
 
@@ -456,8 +460,8 @@ and singleline_comment = parse
         curr_id := None;
         let loc = currentLoc lexbuf in
         let token =
-          if SSet.mem id !types_context then TYPEDEF_NAME (id, ref TypedefId, loc)
-          else VAR_NAME (id, ref VarId, loc)
+          if SSet.mem id !types_context then Pre_parser.TYPEDEF_NAME (id, ref TypedefId, loc)
+          else Pre_parser.VAR_NAME (id, ref VarId, loc)
         in
         Queue.push token tokens;
         token
@@ -490,133 +494,129 @@ and singleline_comment = parse
   (* [tokens_stream filename text] runs the pre_parser and produces a stream
      of (appropriately classified) tokens. *)
 
-  let tokens_stream filename text : token coq_Stream =
+  let tokens_stream filename text : buffer =
     let tokens = Queue.create () in
     let buffer = ref ErrorReports.Zero in
     invoke_pre_parser filename text (lexer tokens buffer) buffer;
-    let rec compute_token_stream () =
-      let loop t v =
-        Cons (Coq_existT (t, Obj.magic v), Lazy.from_fun compute_token_stream)
-      in
+    let rec compute_buffer () =
+      let loop t = Buf_cons (t, Lazy.from_fun compute_buffer) in
       match Queue.pop tokens with
-      | ADD_ASSIGN loc -> loop ADD_ASSIGN't loc
-      | AND loc -> loop AND't loc
-      | ANDAND loc -> loop ANDAND't loc
-      | AND_ASSIGN loc -> loop AND_ASSIGN't loc
-      | AUTO loc -> loop AUTO't loc
-      | BANG loc -> loop BANG't loc
-      | BAR loc -> loop BAR't loc
-      | BARBAR loc -> loop BARBAR't loc
-      | UNDERSCORE_BOOL loc -> loop UNDERSCORE_BOOL't loc
-      | BREAK loc -> loop BREAK't loc
-      | BUILTIN_VA_ARG loc -> loop BUILTIN_VA_ARG't loc
-      | BUILTIN_OFFSETOF loc -> loop BUILTIN_OFFSETOF't loc
-      | CASE loc -> loop CASE't loc
-      | CHAR loc -> loop CHAR't loc
-      | COLON loc -> loop COLON't loc
-      | COMMA loc -> loop COMMA't loc
-      | CONST loc -> loop CONST't loc
-      | CONSTANT (cst, loc) -> loop CONSTANT't (cst, loc)
-      | CONTINUE loc -> loop CONTINUE't loc
-      | DEC loc -> loop DEC't loc
-      | DEFAULT loc -> loop DEFAULT't loc
-      | DIV_ASSIGN loc -> loop DIV_ASSIGN't loc
-      | DO loc -> loop DO't loc
-      | DOT loc -> loop DOT't loc
-      | DOUBLE loc -> loop DOUBLE't loc
-      | ELLIPSIS loc -> loop ELLIPSIS't loc
-      | ELSE loc -> loop ELSE't loc
-      | ENUM loc -> loop ENUM't loc
-      | EOF -> loop EOF't ()
-      | EQ loc -> loop EQ't loc
-      | EQEQ loc -> loop EQEQ't loc
-      | EXTERN loc -> loop EXTERN't loc
-      | FLOAT loc -> loop FLOAT't loc
-      | FOR loc -> loop FOR't loc
-      | GEQ loc -> loop GEQ't loc
-      | GOTO loc -> loop GOTO't loc
-      | GT loc -> loop GT't loc
-      | HAT loc -> loop HAT't loc
-      | IF loc -> loop IF't loc
-      | INC loc -> loop INC't loc
-      | INLINE loc -> loop INLINE't loc
-      | INT loc -> loop INT't loc
-      | LBRACE loc -> loop LBRACE't loc
-      | LBRACK loc -> loop LBRACK't loc
-      | LEFT loc -> loop LEFT't loc
-      | LEFT_ASSIGN loc -> loop LEFT_ASSIGN't loc
-      | LEQ loc -> loop LEQ't loc
-      | LONG loc -> loop LONG't loc
-      | LPAREN loc -> loop LPAREN't loc
-      | LT loc -> loop LT't loc
-      | MINUS loc -> loop MINUS't loc
-      | MOD_ASSIGN loc -> loop MOD_ASSIGN't loc
-      | MUL_ASSIGN loc -> loop MUL_ASSIGN't loc
-      | NEQ loc -> loop NEQ't loc
-      | NORETURN loc -> loop NORETURN't loc
-      | OR_ASSIGN loc -> loop OR_ASSIGN't loc
-      | PACKED loc -> loop PACKED't loc
-      | PERCENT loc -> loop PERCENT't loc
-      | PLUS loc -> loop PLUS't loc
-      | PTR loc -> loop PTR't loc
-      | QUESTION loc -> loop QUESTION't loc
-      | RBRACE loc -> loop RBRACE't loc
-      | RBRACK loc -> loop RBRACK't loc
-      | REGISTER loc -> loop REGISTER't loc
-      | RESTRICT loc -> loop RESTRICT't loc
-      | RETURN loc -> loop RETURN't loc
-      | RIGHT loc -> loop RIGHT't loc
-      | RIGHT_ASSIGN loc -> loop RIGHT_ASSIGN't loc
-      | RPAREN loc -> loop RPAREN't loc
-      | SEMICOLON loc -> loop SEMICOLON't loc
-      | SHORT loc -> loop SHORT't loc
-      | SIGNED loc -> loop SIGNED't loc
-      | SIZEOF loc -> loop SIZEOF't loc
-      | SLASH loc -> loop SLASH't loc
-      | STAR loc -> loop STAR't loc
-      | STATIC loc -> loop STATIC't loc
-      | STRING_LITERAL (wide, str, loc) ->
+      | Pre_parser.ADD_ASSIGN loc -> loop (Parser.ADD_ASSIGN loc)
+      | Pre_parser.AND loc -> loop (Parser.AND loc)
+      | Pre_parser.ANDAND loc -> loop (Parser.ANDAND loc)
+      | Pre_parser.AND_ASSIGN loc -> loop (Parser.AND_ASSIGN loc)
+      | Pre_parser.AUTO loc -> loop (Parser.AUTO loc)
+      | Pre_parser.BANG loc -> loop (Parser.BANG loc)
+      | Pre_parser.BAR loc -> loop (Parser.BAR loc)
+      | Pre_parser.BARBAR loc -> loop (Parser.BARBAR loc)
+      | Pre_parser.UNDERSCORE_BOOL loc -> loop (Parser.UNDERSCORE_BOOL loc)
+      | Pre_parser.BREAK loc -> loop (Parser.BREAK loc)
+      | Pre_parser.BUILTIN_VA_ARG loc -> loop (Parser.BUILTIN_VA_ARG loc)
+      | Pre_parser.BUILTIN_OFFSETOF loc -> loop (Parser.BUILTIN_OFFSETOF loc)
+      | Pre_parser.CASE loc -> loop (Parser.CASE loc)
+      | Pre_parser.CHAR loc -> loop (Parser.CHAR loc)
+      | Pre_parser.COLON loc -> loop (Parser.COLON loc)
+      | Pre_parser.COMMA loc -> loop (Parser.COMMA loc)
+      | Pre_parser.CONST loc -> loop (Parser.CONST loc)
+      | Pre_parser.CONSTANT (cst, loc) -> loop (Parser.CONSTANT (cst, loc))
+      | Pre_parser.CONTINUE loc -> loop (Parser.CONTINUE loc)
+      | Pre_parser.DEC loc -> loop (Parser.DEC loc)
+      | Pre_parser.DEFAULT loc -> loop (Parser.DEFAULT loc)
+      | Pre_parser.DIV_ASSIGN loc -> loop (Parser.DIV_ASSIGN loc)
+      | Pre_parser.DO loc -> loop (Parser.DO loc)
+      | Pre_parser.DOT loc -> loop (Parser.DOT loc)
+      | Pre_parser.DOUBLE loc -> loop (Parser.DOUBLE loc)
+      | Pre_parser.ELLIPSIS loc -> loop (Parser.ELLIPSIS loc)
+      | Pre_parser.ELSE loc -> loop (Parser.ELSE loc)
+      | Pre_parser.ENUM loc -> loop (Parser.ENUM loc)
+      | Pre_parser.EOF -> loop (Parser.EOF ())
+      | Pre_parser.EQ loc -> loop (Parser.EQ loc)
+      | Pre_parser.EQEQ loc -> loop (Parser.EQEQ loc)
+      | Pre_parser.EXTERN loc -> loop (Parser.EXTERN loc)
+      | Pre_parser.FLOAT loc -> loop (Parser.FLOAT loc)
+      | Pre_parser.FOR loc -> loop (Parser.FOR loc)
+      | Pre_parser.GEQ loc -> loop (Parser.GEQ loc)
+      | Pre_parser.GOTO loc -> loop (Parser.GOTO loc)
+      | Pre_parser.GT loc -> loop (Parser.GT loc)
+      | Pre_parser.HAT loc -> loop (Parser.HAT loc)
+      | Pre_parser.IF loc -> loop (Parser.IF_ loc)
+      | Pre_parser.INC loc -> loop (Parser.INC loc)
+      | Pre_parser.INLINE loc -> loop (Parser.INLINE loc)
+      | Pre_parser.INT loc -> loop (Parser.INT loc)
+      | Pre_parser.LBRACE loc -> loop (Parser.LBRACE loc)
+      | Pre_parser.LBRACK loc -> loop (Parser.LBRACK loc)
+      | Pre_parser.LEFT loc -> loop (Parser.LEFT loc)
+      | Pre_parser.LEFT_ASSIGN loc -> loop (Parser.LEFT_ASSIGN loc)
+      | Pre_parser.LEQ loc -> loop (Parser.LEQ loc)
+      | Pre_parser.LONG loc -> loop (Parser.LONG loc)
+      | Pre_parser.LPAREN loc -> loop (Parser.LPAREN loc)
+      | Pre_parser.LT loc -> loop (Parser.LT loc)
+      | Pre_parser.MINUS loc -> loop (Parser.MINUS loc)
+      | Pre_parser.MOD_ASSIGN loc -> loop (Parser.MOD_ASSIGN loc)
+      | Pre_parser.MUL_ASSIGN loc -> loop (Parser.MUL_ASSIGN loc)
+      | Pre_parser.NEQ loc -> loop (Parser.NEQ loc)
+      | Pre_parser.NORETURN loc -> loop (Parser.NORETURN loc)
+      | Pre_parser.OR_ASSIGN loc -> loop (Parser.OR_ASSIGN loc)
+      | Pre_parser.PACKED loc -> loop (Parser.PACKED loc)
+      | Pre_parser.PERCENT loc -> loop (Parser.PERCENT loc)
+      | Pre_parser.PLUS loc -> loop (Parser.PLUS loc)
+      | Pre_parser.PTR loc -> loop (Parser.PTR loc)
+      | Pre_parser.QUESTION loc -> loop (Parser.QUESTION loc)
+      | Pre_parser.RBRACE loc -> loop (Parser.RBRACE loc)
+      | Pre_parser.RBRACK loc -> loop (Parser.RBRACK loc)
+      | Pre_parser.REGISTER loc -> loop (Parser.REGISTER loc)
+      | Pre_parser.RESTRICT loc -> loop (Parser.RESTRICT loc)
+      | Pre_parser.RETURN loc -> loop (Parser.RETURN loc)
+      | Pre_parser.RIGHT loc -> loop (Parser.RIGHT loc)
+      | Pre_parser.RIGHT_ASSIGN loc -> loop (Parser.RIGHT_ASSIGN loc)
+      | Pre_parser.RPAREN loc -> loop (Parser.RPAREN loc)
+      | Pre_parser.SEMICOLON loc -> loop (Parser.SEMICOLON loc)
+      | Pre_parser.SHORT loc -> loop (Parser.SHORT loc)
+      | Pre_parser.SIGNED loc -> loop (Parser.SIGNED loc)
+      | Pre_parser.SIZEOF loc -> loop (Parser.SIZEOF loc)
+      | Pre_parser.SLASH loc -> loop (Parser.SLASH loc)
+      | Pre_parser.STAR loc -> loop (Parser.STAR loc)
+      | Pre_parser.STATIC loc -> loop (Parser.STATIC loc)
+      | Pre_parser.STRING_LITERAL (wide, str, loc) ->
           (* Merge consecutive string literals *)
           let rec doConcat wide str =
-            try
-              match Queue.peek tokens with
-              | STRING_LITERAL (wide', str', loc) ->
-                  ignore (Queue.pop tokens);
-                  let (wide'', str'') = doConcat wide' str' in
-                  if str'' <> []
-                  then (wide || wide'', str @ str'')
-                  else (wide, str)
-              | _ ->
-                  (wide, str)
-            with Queue.Empty -> (wide, str) in
-          let (wide', str') = doConcat wide str in
-          loop STRING_LITERAL't ((wide', str'), loc)
-      | STRUCT loc -> loop STRUCT't loc
-      | SUB_ASSIGN loc -> loop SUB_ASSIGN't loc
-      | SWITCH loc -> loop SWITCH't loc
-      | TILDE loc -> loop TILDE't loc
-      | TYPEDEF loc -> loop TYPEDEF't loc
-      | TYPEDEF_NAME (id, typ, loc)
-      | VAR_NAME (id, typ, loc) ->
-          let terminal = match !typ with
-            | VarId -> VAR_NAME't
-            | TypedefId -> TYPEDEF_NAME't
-            | OtherId -> OTHER_NAME't
+            match Queue.peek tokens with
+            | Pre_parser.STRING_LITERAL (wide', str', loc) ->
+               ignore (Queue.pop tokens);
+               let (wide'', str'') = doConcat wide' str' in
+               if str'' <> []
+               then (wide || wide'', str @ str'')
+               else (wide, str)
+            | _ -> (wide, str)
+            | exception Queue.Empty -> (wide, str)
           in
-          loop terminal (id, loc)
-      | UNION loc -> loop UNION't loc
-      | UNSIGNED loc -> loop UNSIGNED't loc
-      | VOID loc -> loop VOID't loc
-      | VOLATILE loc -> loop VOLATILE't loc
-      | WHILE loc -> loop WHILE't loc
-      | XOR_ASSIGN loc -> loop XOR_ASSIGN't loc
-      | ALIGNAS loc -> loop ALIGNAS't loc
-      | ALIGNOF loc -> loop ALIGNOF't loc
-      | ATTRIBUTE loc -> loop ATTRIBUTE't loc
-      | ASM loc -> loop ASM't loc
-      | PRAGMA (s, loc) -> loop PRAGMA't (s, loc)
-      | PRE_NAME _ -> assert false
+          let (wide', str') = doConcat wide str in
+          loop (Parser.STRING_LITERAL ((wide', str'), loc))
+      | Pre_parser.STRUCT loc -> loop (Parser.STRUCT loc)
+      | Pre_parser.SUB_ASSIGN loc -> loop (Parser.SUB_ASSIGN loc)
+      | Pre_parser.SWITCH loc -> loop (Parser.SWITCH loc)
+      | Pre_parser.TILDE loc -> loop (Parser.TILDE loc)
+      | Pre_parser.TYPEDEF loc -> loop (Parser.TYPEDEF loc)
+      | Pre_parser.TYPEDEF_NAME (id, typ, loc)
+      | Pre_parser.VAR_NAME (id, typ, loc) ->
+          begin match !typ with
+          | VarId -> loop (Parser.VAR_NAME (id, loc))
+          | TypedefId -> loop (Parser.TYPEDEF_NAME (id, loc))
+          | OtherId -> loop (Parser.OTHER_NAME (id, loc))
+          end
+      | Pre_parser.UNION loc -> loop (Parser.UNION loc)
+      | Pre_parser.UNSIGNED loc -> loop (Parser.UNSIGNED loc)
+      | Pre_parser.VOID loc -> loop (Parser.VOID loc)
+      | Pre_parser.VOLATILE loc -> loop (Parser.VOLATILE loc)
+      | Pre_parser.WHILE loc -> loop (Parser.WHILE loc)
+      | Pre_parser.XOR_ASSIGN loc -> loop (Parser.XOR_ASSIGN loc)
+      | Pre_parser.ALIGNAS loc -> loop (Parser.ALIGNAS loc)
+      | Pre_parser.ALIGNOF loc -> loop (Parser.ALIGNOF loc)
+      | Pre_parser.ATTRIBUTE loc -> loop (Parser.ATTRIBUTE loc)
+      | Pre_parser.ASM loc -> loop (Parser.ASM loc)
+      | Pre_parser.PRAGMA (s, loc) -> loop (Parser.PRAGMA (s, loc))
+      | Pre_parser.PRE_NAME _ -> assert false
     in
-    Lazy.from_fun compute_token_stream
+    Lazy.from_fun compute_buffer
 
 }
diff --git a/cparser/Machine.ml b/cparser/Machine.ml
index 089f2483..97bedb3b 100644
--- a/cparser/Machine.ml
+++ b/cparser/Machine.ml
@@ -237,6 +237,11 @@ let rv64 =
                    struct_passing_style = SP_ref_callee; (* Wrong *)
                    struct_return_style = SR_ref } (* to check *)
 
+let aarch64 =
+  { i32lpll64 with name = "aarch64";
+                   struct_passing_style = SP_ref_callee; (* Wrong *)
+                   struct_return_style = SR_ref } (* Wrong *)
+
 (* Add GCC extensions re: sizeof and alignof *)
 
 let gcc_extensions c =
diff --git a/cparser/Machine.mli b/cparser/Machine.mli
index 8971e2a3..ca7de17b 100644
--- a/cparser/Machine.mli
+++ b/cparser/Machine.mli
@@ -86,6 +86,7 @@ val arm_littleendian : t
 val arm_bigendian : t
 val rv32 : t
 val rv64 : t
+val aarch64 : t
 
 val gcc_extensions : t -> t
 val compcert_interpreter : t -> t
diff --git a/cparser/MenhirLib/Alphabet.v b/cparser/MenhirLib/Alphabet.v
deleted file mode 100644
index a13f69b0..00000000
--- a/cparser/MenhirLib/Alphabet.v
+++ /dev/null
@@ -1,320 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Import Int31.
-Require Import Cyclic31.
-Require Import Omega.
-Require Import List.
-Require Import Syntax.
-Require Import Relations.
-Require Import RelationClasses.
-
-Local Obligation Tactic := intros.
-
-(** A comparable type is equiped with a [compare] function, that define an order
-   relation. **)
-Class Comparable (A:Type) := {
-  compare : A -> A -> comparison;
-  compare_antisym : forall x y, CompOpp (compare x y) = compare y x;
-  compare_trans :  forall x y z c,
-    (compare x y) = c -> (compare y z) = c -> (compare x z) = c
-}.
-
-Theorem compare_refl {A:Type} (C: Comparable A) :
-  forall x, compare x x = Eq.
-Proof.
-intros.
-pose proof (compare_antisym x x).
-destruct (compare x x); intuition; try discriminate.
-Qed.
-
-(** The corresponding order is a strict order. **)
-Definition comparableLt {A:Type} (C: Comparable A) : relation A :=
-  fun x y => compare x y = Lt.
-
-Instance ComparableLtStrictOrder {A:Type} (C: Comparable A) :
-  StrictOrder (comparableLt C).
-Proof.
-apply Build_StrictOrder.
-unfold Irreflexive, Reflexive, complement, comparableLt.
-intros.
-pose proof H.
-rewrite <- compare_antisym in H.
-rewrite H0 in H.
-discriminate H.
-unfold Transitive, comparableLt.
-intros x y z.
-apply compare_trans.
-Qed.
-
-(** nat is comparable. **)
-Program Instance natComparable : Comparable nat :=
-  { compare := Nat.compare }.
-Next Obligation.
-symmetry.
-destruct (Nat.compare x y)  as [] eqn:?.
-rewrite Nat.compare_eq_iff in Heqc.
-destruct Heqc.
-rewrite Nat.compare_eq_iff.
-trivial.
-rewrite <- nat_compare_lt in *.
-rewrite <- nat_compare_gt in *.
-trivial.
-rewrite <- nat_compare_lt in *.
-rewrite <- nat_compare_gt in *.
-trivial.
-Qed.
-Next Obligation.
-destruct c.
-rewrite Nat.compare_eq_iff in *; destruct H; assumption.
-rewrite <- nat_compare_lt in *.
-apply (Nat.lt_trans _ _ _ H H0).
-rewrite <- nat_compare_gt in *.
-apply (gt_trans _ _ _ H H0).
-Qed.
-
-(** A pair of comparable is comparable. **)
-Program Instance PairComparable {A:Type} (CA:Comparable A) {B:Type} (CB:Comparable B) :
-  Comparable (A*B) :=
-  { compare := fun x y =>
-      let (xa, xb) := x in let (ya, yb) := y in
-      match compare xa ya return comparison with
-        | Eq => compare xb yb
-        | x => x
-      end }.
-Next Obligation.
-destruct x, y.
-rewrite <- (compare_antisym a a0).
-rewrite <- (compare_antisym b b0).
-destruct (compare a a0); intuition.
-Qed.
-Next Obligation.
-destruct x, y, z.
-destruct (compare a a0) as [] eqn:?, (compare a0 a1) as [] eqn:?;
-try (rewrite <- H0 in H; discriminate);
-try (destruct (compare a a1) as [] eqn:?;
-  try (rewrite <- compare_antisym in Heqc0;
-         rewrite CompOpp_iff in Heqc0;
-         rewrite (compare_trans _ _ _  _ Heqc0 Heqc2) in Heqc1;
-         discriminate);
-  try (rewrite <- compare_antisym in Heqc1;
-         rewrite CompOpp_iff in Heqc1;
-         rewrite (compare_trans _ _ _ _ Heqc2 Heqc1) in Heqc0;
-         discriminate);
-  assumption);
-rewrite (compare_trans _ _ _ _ Heqc0 Heqc1);
-try assumption.
-apply (compare_trans _ _ _ _ H H0).
-Qed.
-
-(** Special case of comparable, where equality is usual equality. **)
-Class ComparableUsualEq {A:Type} (C: Comparable A) :=
-  compare_eq : forall x y, compare x y = Eq -> x = y.
-
-(** Boolean equality for a [Comparable]. **)
-Definition compare_eqb {A:Type} {C:Comparable A} (x y:A) :=
-  match compare x y with
-    | Eq => true
-    | _ => false
-  end.
-
-Theorem compare_eqb_iff {A:Type} {C:Comparable A} {U:ComparableUsualEq C} :
-  forall x y, compare_eqb x y = true <-> x = y.
-Proof.
-unfold compare_eqb.
-intuition.
-apply compare_eq.
-destruct (compare x y); intuition; discriminate.
-destruct H.
-rewrite compare_refl; intuition.
-Qed.
-
-(** [Comparable] provides a decidable equality. **)
-Definition compare_eqdec {A:Type} {C:Comparable A} {U:ComparableUsualEq C} (x y:A):
-  {x = y} + {x <> y}.
-Proof.
-destruct (compare x y) as [] eqn:?; [left; apply compare_eq; intuition | ..];
-  right; intro; destruct H; rewrite compare_refl in Heqc; discriminate.
-Defined.
-
-Instance NComparableUsualEq : ComparableUsualEq natComparable := Nat.compare_eq.
-
-(** A pair of ComparableUsualEq is ComparableUsualEq **)
-Instance PairComparableUsualEq
-  {A:Type} {CA:Comparable A} (UA:ComparableUsualEq CA)
-  {B:Type} {CB:Comparable B} (UB:ComparableUsualEq CB) :
-    ComparableUsualEq (PairComparable CA CB).
-Proof.
-intros x y; destruct x, y; simpl.
-pose proof (compare_eq a a0); pose proof (compare_eq b b0).
-destruct (compare a a0); try discriminate.
-intuition.
-destruct H2, H0.
-reflexivity.
-Qed.
-
-(** An [Finite] type is a type with the list of all elements. **)
-Class Finite (A:Type) := {
-  all_list : list A;
-  all_list_forall : forall x:A, In x all_list
-}.
-
-(** An alphabet is both [ComparableUsualEq] and [Finite]. **)
-Class Alphabet (A:Type) := {
-  AlphabetComparable :> Comparable A;
-  AlphabetComparableUsualEq :> ComparableUsualEq AlphabetComparable;
-  AlphabetFinite :> Finite A
-}.
-
-(** The [Numbered] class provides a conveniant way to build [Alphabet] instances,
-   with a good computationnal complexity. It is mainly a injection from it to
-   [Int31] **)
-Class Numbered (A:Type) := {
-  inj : A -> int31;
-  surj : int31 -> A;
-  surj_inj_compat : forall x, surj (inj x) = x;
-  inj_bound : int31;
-  inj_bound_spec : forall x, (phi (inj x) < phi inj_bound)%Z
-}.
-
-Program Instance NumberedAlphabet {A:Type} (N:Numbered A) : Alphabet A :=
-  { AlphabetComparable :=
-      {| compare := fun x y => compare31 (inj x) (inj y) |};
-    AlphabetFinite :=
-      {| all_list := fst (iter_int31 inj_bound _
-        (fun p => (cons (surj (snd p)) (fst p), incr (snd p))) ([], 0%int31)) |} }.
-Next Obligation. apply Zcompare_antisym. Qed.
-Next Obligation.
-destruct c. unfold compare31 in *.
-rewrite Z.compare_eq_iff in *. congruence.
-eapply Zcompare_Lt_trans. apply H. apply H0.
-eapply Zcompare_Gt_trans. apply H. apply H0.
-Qed.
-Next Obligation.
-intros x y H. unfold compare, compare31 in H.
-rewrite Z.compare_eq_iff in *.
-rewrite <- surj_inj_compat, <- phi_inv_phi with (inj y), <- H.
-rewrite phi_inv_phi, surj_inj_compat; reflexivity.
-Qed.
-Next Obligation.
-rewrite iter_int31_iter_nat.
-pose proof (inj_bound_spec x).
-match goal with |- In x (fst ?p) => destruct p as [] eqn:? end.
-replace inj_bound with i in H.
-revert l i Heqp x H.
-induction (Z.abs_nat (phi inj_bound)); intros.
-inversion Heqp; clear Heqp; subst.
-rewrite spec_0 in H. pose proof (phi_bounded (inj x)). omega.
-simpl in Heqp.
-destruct nat_rect; specialize (IHn _ _ (eq_refl _) x); simpl in *.
-inversion Heqp. subst. clear Heqp.
-rewrite phi_incr in H.
-pose proof (phi_bounded i0).
-pose proof (phi_bounded (inj x)).
-destruct (Z_lt_le_dec (Z.succ (phi i0)) (2 ^ Z.of_nat size)%Z).
-rewrite Zmod_small in H by omega.
-apply Zlt_succ_le, Zle_lt_or_eq in H.
-destruct H; simpl; auto. left.
-rewrite <- surj_inj_compat, <- phi_inv_phi with (inj x), H, phi_inv_phi; reflexivity.
-replace (Z.succ (phi i0)) with (2 ^ Z.of_nat size)%Z in H by omega.
-rewrite Z_mod_same_full in H.
-exfalso; omega.
-rewrite <- phi_inv_phi with i, <- phi_inv_phi with inj_bound; f_equal.
-pose proof (phi_bounded inj_bound); pose proof (phi_bounded i).
-rewrite <- Z.abs_eq with (phi i), <- Z.abs_eq with (phi inj_bound) by omega.
-clear H H0 H1.
-do 2 rewrite <- Zabs2Nat.id_abs.
-f_equal.
-revert l i Heqp.
-assert (Z.abs_nat (phi inj_bound) < Z.abs_nat (2^31)).
-apply Zabs_nat_lt, phi_bounded.
-induction (Z.abs_nat (phi inj_bound)); intros.
-inversion Heqp; reflexivity.
-inversion Heqp; clear H1 H2 Heqp.
-match goal with |- _ (_ (_ (snd ?p))) = _ => destruct p end.
-pose proof (phi_bounded i0).
-erewrite <- IHn, <- Zabs2Nat.inj_succ in H |- *; eauto; try omega.
-rewrite phi_incr, Zmod_small; intuition; try omega.
-apply inj_lt in H.
-pose proof Z.le_le_succ_r.
-do 2 rewrite Zabs2Nat.id_abs, Z.abs_eq in H; now eauto.
-Qed.
-
-(** Previous class instances for [option A] **)
-Program Instance OptionComparable {A:Type} (C:Comparable A) : Comparable (option A) :=
-  { compare := fun x y =>
-      match x, y return comparison with
-        | None, None => Eq
-        | None, Some _ => Lt
-        | Some _, None => Gt
-        | Some x, Some y => compare x y
-      end }.
-Next Obligation.
-destruct x, y; intuition.
-apply compare_antisym.
-Qed.
-Next Obligation.
-destruct x, y, z; try now intuition;
-try (rewrite <- H in H0; discriminate).
-apply (compare_trans _ _ _ _ H H0).
-Qed.
-
-Instance OptionComparableUsualEq {A:Type} {C:Comparable A} (U:ComparableUsualEq C) :
-  ComparableUsualEq (OptionComparable C).
-Proof.
-intros x y.
-destruct x, y; intuition; try discriminate.
-rewrite (compare_eq a a0); intuition.
-Qed.
-
-Program Instance OptionFinite {A:Type} (E:Finite A) : Finite (option A) :=
-  { all_list := None :: map Some all_list }.
-Next Obligation.
-destruct x; intuition.
-right.
-apply in_map.
-apply all_list_forall.
-Defined.
-
-(** Definitions of [FSet]/[FMap] from [Comparable] **)
-Require Import OrderedTypeAlt.
-Require FSetAVL.
-Require FMapAVL.
-Import OrderedType.
-
-Module Type ComparableM.
-  Parameter t : Type.
-  Declare Instance tComparable : Comparable t.
-End ComparableM.
-
-Module OrderedTypeAlt_from_ComparableM (C:ComparableM) <: OrderedTypeAlt.
-  Definition t := C.t.
-  Definition compare : t -> t -> comparison := compare.
-
-  Infix "?=" := compare (at level 70, no associativity).
-
-  Lemma compare_sym x y : (y?=x) = CompOpp (x?=y).
-  Proof. exact (Logic.eq_sym (compare_antisym x y)). Qed.
-  Lemma compare_trans c x y z :
-    (x?=y) = c -> (y?=z) = c -> (x?=z) = c.
-  Proof.
-  apply compare_trans.
-  Qed.
-End OrderedTypeAlt_from_ComparableM.
-
-Module OrderedType_from_ComparableM (C:ComparableM) <: OrderedType.
-  Module Alt := OrderedTypeAlt_from_ComparableM C.
-  Include (OrderedType_from_Alt Alt).
-End OrderedType_from_ComparableM.
diff --git a/cparser/MenhirLib/Grammar.v b/cparser/MenhirLib/Grammar.v
deleted file mode 100644
index 8e427cd9..00000000
--- a/cparser/MenhirLib/Grammar.v
+++ /dev/null
@@ -1,166 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Import List.
-Require Import Syntax.
-Require Import Alphabet.
-Require Import Orders.
-Require Tuples.
-
-(** The terminal non-terminal alphabets of the grammar. **)
-Module Type Alphs.
-  Parameters terminal nonterminal : Type.
-  Declare Instance TerminalAlph: Alphabet terminal.
-  Declare Instance NonTerminalAlph: Alphabet nonterminal.
-End Alphs.
-
-(** Definition of the alphabet of symbols, given the alphabet of terminals
-    and the alphabet of non terminals **)
-Module Symbol(Import A:Alphs).
-
-  Inductive symbol :=
-    | T: terminal -> symbol
-    | NT: nonterminal -> symbol.
-
-  Program Instance SymbolAlph : Alphabet symbol :=
-    { AlphabetComparable := {| compare := fun x y =>
-        match x, y return comparison with
-          | T _, NT _ => Gt
-          | NT _, T _ => Lt
-          | T x, T y => compare x y
-          | NT x, NT y => compare x y
-        end |};
-      AlphabetFinite := {| all_list :=
-        map T all_list++map NT all_list |} }.
-  Next Obligation.
-  destruct x; destruct y; intuition; apply compare_antisym.
-  Qed.
-  Next Obligation.
-  destruct x; destruct y; destruct z; intuition; try discriminate.
-  apply (compare_trans _ t0); intuition.
-  apply (compare_trans _ n0); intuition.
-  Qed.
-  Next Obligation.
-  intros x y.
-  destruct x; destruct y; try discriminate; intros.
-  rewrite (compare_eq t t0); intuition.
-  rewrite (compare_eq n n0); intuition.
-  Qed.
-  Next Obligation.
-  rewrite in_app_iff.
-  destruct x; [left | right]; apply in_map; apply all_list_forall.
-  Qed.
-
-End Symbol.
-
-Module Type T.
-  Export Tuples.
-
-  Include Alphs <+ Symbol.
-
-  (** [symbol_semantic_type] maps a symbols to the type of its semantic
-     values. **)
-  Parameter symbol_semantic_type: symbol -> Type.
-
-  (** The type of productions identifiers **)
-  Parameter production : Type.
-  Declare Instance ProductionAlph : Alphabet production.
-
-  (** Accessors for productions: left hand side, right hand side,
-     and semantic action. The semantic actions are given in the form
-     of curryfied functions, that take arguments in the reverse order. **)
-  Parameter prod_lhs: production -> nonterminal.
-  Parameter prod_rhs_rev: production -> list symbol.
-  Parameter prod_action:
-    forall p:production,
-      arrows_left
-        (map symbol_semantic_type (rev (prod_rhs_rev p)))
-        (symbol_semantic_type (NT (prod_lhs p))).
-
-End T.
-
-Module Defs(Import G:T).
-
-  (** A token is a terminal and a semantic value for this terminal. **)
-  Definition token := {t:terminal & symbol_semantic_type (T t)}.
-
-  (** A grammar creates a relation between word of tokens and semantic values.
-     This relation is parametrized by the head symbol. It defines the
-     "semantics" of the grammar. This relation is defined by a notion of
-     parse tree. **)
-  Inductive parse_tree:
-    forall (head_symbol:symbol) (word:list token)
-      (semantic_value:symbol_semantic_type head_symbol), Type :=
-
-  (** A single token has its semantic value as semantic value, for the
-     corresponding terminal as head symbol. **)
-  | Terminal_pt:
-    forall (t:terminal) (sem:symbol_semantic_type (T t)),
-      parse_tree (T t)
-      [existT (fun t => symbol_semantic_type (T t)) t sem] sem
-
-  (** Given a production, if a word has a list of semantic values for the
-     right hand side as head symbols, then this word has the semantic value
-     given by the semantic action of the production for the left hand side
-     as head symbol.**)
-  | Non_terminal_pt:
-    forall {p:production} {word:list token}
-      {semantic_values:tuple (map symbol_semantic_type (rev (prod_rhs_rev p)))},
-      parse_tree_list (rev (prod_rhs_rev p)) word semantic_values ->
-      parse_tree (NT (prod_lhs p)) word (uncurry (prod_action p) semantic_values)
-
-  (** Basically the same relation as before, but for list of head symbols (ie.
-     We are building a forest of syntax trees. It is mutually recursive with the
-     previous relation **)
-  with parse_tree_list:
-    forall (head_symbols:list symbol) (word:list token)
-      (semantic_values:tuple (map symbol_semantic_type head_symbols)),
-      Type :=
-
-  (** The empty word has [()] as semantic for [[]] as head symbols list **)
-  | Nil_ptl: parse_tree_list [] [] ()
-
-  (** The cons of the semantic value for one head symbol and for a list of head
-     symbols **)
-  | Cons_ptl:
-  (** The semantic for the head **)
-    forall {head_symbolt:symbol} {wordt:list token}
-      {semantic_valuet:symbol_semantic_type head_symbolt},
-      parse_tree head_symbolt wordt semantic_valuet ->
-
-  (** and the semantic for the tail **)
-    forall {head_symbolsq:list symbol} {wordq:list token}
-      {semantic_valuesq:tuple (map symbol_semantic_type head_symbolsq)},
-      parse_tree_list head_symbolsq wordq semantic_valuesq ->
-
-  (** give the semantic of the cons **)
-      parse_tree_list
-        (head_symbolt::head_symbolsq)
-        (wordt++wordq)
-        (semantic_valuet, semantic_valuesq).
-
-
-  Fixpoint pt_size {head_symbol word sem} (tree:parse_tree head_symbol word sem) :=
-    match tree with
-      | Terminal_pt _ _ => 1
-      | Non_terminal_pt l => S (ptl_size l)
-    end
-  with ptl_size {head_symbols word sems} (tree:parse_tree_list head_symbols word sems) :=
-    match tree with
-      | Nil_ptl => 0
-      | Cons_ptl t q =>
-         pt_size t + ptl_size q
-    end.
-End Defs.
diff --git a/cparser/MenhirLib/Interpreter.v b/cparser/MenhirLib/Interpreter.v
deleted file mode 100644
index 4ac02693..00000000
--- a/cparser/MenhirLib/Interpreter.v
+++ /dev/null
@@ -1,228 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Import Streams.
-Require Import List.
-Require Import Syntax.
-Require Automaton.
-Require Import Alphabet.
-
-Module Make(Import A:Automaton.T).
-
-(** The error monad **)
-Inductive result (A:Type) :=
-  | Err: result A
-  | OK: A -> result A.
-
-Arguments Err [A].
-Arguments OK [A].
-
-Definition bind {A B: Type} (f: result A) (g: A -> result B): result B :=
-  match f with
-    | OK x => g x
-    | Err => Err
-  end.
-
-Definition bind2 {A B C: Type} (f: result (A * B)) (g: A -> B -> result C):
-  result C :=
-  match f with
-    | OK (x, y) => g x y
-    | Err => Err
-  end.
-
-Notation "'do' X <- A ; B" := (bind A (fun X => B))
-  (at level 200, X ident, A at level 100, B at level 200).
-
-Notation "'do' ( X , Y ) <- A ; B" := (bind2 A (fun X Y => B))
-  (at level 200, X ident, Y ident, A at level 100, B at level 200).
-
-(** Some operations on streams **)
-
-(** Concatenation of a list and a stream **)
-Fixpoint app_str {A:Type} (l:list A) (s:Stream A) :=
-  match l with
-    | nil => s
-    | cons t q => Cons t (app_str q s)
-  end.
-
-Infix "++" := app_str (right associativity, at level 60).
-
-Lemma app_str_app_assoc {A:Type} (l1 l2:list A) (s:Stream A) :
-  l1 ++ (l2 ++ s) = (l1 ++ l2) ++ s.
-Proof.
-induction l1.
-reflexivity.
-simpl.
-rewrite IHl1.
-reflexivity.
-Qed.
-
-(** The type of a non initial state: the type of semantic values associated
-   with the last symbol of this state. *)
-Definition noninitstate_type state :=
-  symbol_semantic_type (last_symb_of_non_init_state state).
-
-(** The stack of the automaton : it can be either nil or contains a non
-    initial state, a semantic value for the symbol associted with this state,
-    and a nested stack. **)
-Definition stack := list (sigT noninitstate_type). (* eg. list {state & state_type state} *)
-
-Section Init.
-
-Variable init : initstate.
-
-(** The top state of a stack **)
-Definition state_of_stack (stack:stack): state :=
-  match stack with
-    | [] => init
-    | existT _ s _::_ => s
-  end.
-
-(** [pop] pops some symbols from the stack. It returns the popped semantic
-    values using [sem_popped] as an accumulator and discards the popped
-    states.**)
-Fixpoint pop (symbols_to_pop:list symbol) (stack_cur:stack):
-  forall {A:Type} (action:arrows_right A (map symbol_semantic_type symbols_to_pop)),
-    result (stack * A) :=
-  match symbols_to_pop return forall {A:Type} (action:arrows_right A (map _ symbols_to_pop)), result (stack * A) with
-    | [] => fun A action => OK (stack_cur, action)
-    | t::q => fun A action =>
-      match stack_cur with
-        | existT _ state_cur sem::stack_rec =>
-          match compare_eqdec (last_symb_of_non_init_state state_cur) t with
-            | left e =>
-              let sem_conv := eq_rect _ symbol_semantic_type sem _ e in
-              pop q stack_rec (action sem_conv)
-            | right _ => Err
-          end
-        | [] => Err
-      end
-  end.
-
-(** [step_result] represents the result of one step of the automaton : it can
-    fail, accept or progress. [Fail_sr] means that the input is incorrect.
-    [Accept_sr] means that this is the last step of the automaton, and it
-    returns the semantic value of the input word. [Progress_sr] means that
-    some progress has been made, but new steps are needed in order to accept
-    a word.
-
-    For [Accept_sr] and [Progress_sr], the result contains the new input buffer.
-
-    [Fail_sr] means that the input word is rejected by the automaton. It is
-    different to [Err] (from the error monad), which mean that the automaton is
-    bogus and has perfomed a forbidden action. **)
-Inductive step_result :=
-  | Fail_sr: step_result
-  | Accept_sr: symbol_semantic_type (NT (start_nt init)) -> Stream token -> step_result
-  | Progress_sr: stack -> Stream token -> step_result.
-
-Program Definition prod_action':
-  forall p,
-    arrows_right (symbol_semantic_type (NT (prod_lhs p)))
-      (map symbol_semantic_type (prod_rhs_rev p)):=
-      fun p =>
-        eq_rect _ (fun x => x) (prod_action p) _ _.
-Next Obligation.
-unfold arrows_left, arrows_right; simpl.
-rewrite <- fold_left_rev_right, <- map_rev, rev_involutive.
-reflexivity.
-Qed.
-
-(** [reduce_step] does a reduce action :
-   - pops some elements from the stack
-   - execute the action of the production
-   - follows the goto for the produced non terminal symbol **)
-Definition reduce_step stack_cur production buffer: result step_result :=
-  do (stack_new, sem) <-
-    pop (prod_rhs_rev production) stack_cur (prod_action' production);
-  match goto_table (state_of_stack stack_new) (prod_lhs production) with
-    | Some (exist _ state_new e) =>
-      let sem := eq_rect _ _ sem _ e in
-      OK (Progress_sr (existT noninitstate_type state_new sem::stack_new) buffer)
-    | None =>
-      match stack_new with
-        | [] =>
-          match compare_eqdec (prod_lhs production) (start_nt init) with
-            | left e =>
-              let sem := eq_rect _ (fun nt => symbol_semantic_type (NT nt)) sem _ e in
-              OK (Accept_sr sem buffer)
-            | right _ => Err
-          end
-        | _::_ => Err
-      end
-  end.
-
-(** One step of parsing. **)
-Definition step stack_cur buffer: result step_result :=
-  match action_table (state_of_stack stack_cur) with
-    | Default_reduce_act production =>
-      reduce_step stack_cur production buffer
-    | Lookahead_act awt =>
-      match Streams.hd buffer with
-        | existT _ term sem =>
-          match awt term with
-            | Shift_act state_new e =>
-              let sem_conv := eq_rect _ symbol_semantic_type sem _ e in
-              OK (Progress_sr (existT noninitstate_type state_new sem_conv::stack_cur)
-                              (Streams.tl buffer))
-            | Reduce_act production =>
-              reduce_step stack_cur production buffer
-            | Fail_action =>
-              OK Fail_sr
-          end
-      end
-  end.
-
-(** The parsing use a [nat] parameter [n_steps], so that we do not have to prove
-    terminaison, which is difficult. So the result of a parsing is either
-    a failure (the automaton has rejected the input word), either a timeout
-    (the automaton has spent all the given [n_steps]), either a parsed semantic
-    value with a rest of the input buffer.
-**)
-Inductive parse_result :=
-  | Fail_pr: parse_result
-  | Timeout_pr: parse_result
-  | Parsed_pr: symbol_semantic_type (NT (start_nt init)) -> Stream token -> parse_result.
-
-Fixpoint parse_fix stack_cur buffer n_steps: result parse_result:=
-  match n_steps with
-    | O => OK Timeout_pr
-    | S it =>
-      do r <- step stack_cur buffer;
-      match r with
-        | Fail_sr => OK Fail_pr
-        | Accept_sr t buffer_new => OK (Parsed_pr t buffer_new)
-        | Progress_sr s buffer_new => parse_fix s buffer_new it
-      end
-  end.
-
-Definition parse buffer n_steps: result parse_result :=
-  parse_fix [] buffer n_steps.
-
-End Init.
-
-Arguments Fail_sr [init].
-Arguments Accept_sr [init] _ _.
-Arguments Progress_sr [init] _ _.
-
-Arguments Fail_pr [init].
-Arguments Timeout_pr [init].
-Arguments Parsed_pr [init] _ _.
-
-End Make.
-
-Module Type T(A:Automaton.T).
-  Include (Make A).
-End T.
diff --git a/cparser/MenhirLib/Interpreter_complete.v b/cparser/MenhirLib/Interpreter_complete.v
deleted file mode 100644
index 2e64b8da..00000000
--- a/cparser/MenhirLib/Interpreter_complete.v
+++ /dev/null
@@ -1,686 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Import Streams.
-Require Import ProofIrrelevance.
-Require Import Equality.
-Require Import List.
-Require Import Syntax.
-Require Import Alphabet.
-Require Import Arith.
-Require Grammar.
-Require Automaton.
-Require Interpreter.
-Require Validator_complete.
-
-Module Make(Import A:Automaton.T) (Import Inter:Interpreter.T A).
-Module Import Valid := Validator_complete.Make A.
-
-(** * Completeness Proof **)
-
-Section Completeness_Proof.
-
-Hypothesis complete: complete.
-
-Proposition nullable_stable: nullable_stable.
-Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
-Proposition first_stable: first_stable.
-Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
-Proposition start_future: start_future.
-Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
-Proposition terminal_shift: terminal_shift.
-Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
-Proposition end_reduce: end_reduce.
-Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
-Proposition start_goto: start_goto.
-Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
-Proposition non_terminal_goto: non_terminal_goto.
-Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
-Proposition non_terminal_closed: non_terminal_closed.
-Proof. pose proof complete; unfold Valid.complete in H; intuition. Qed.
-
-(** If the nullable predicate has been validated, then it is correct. **)
-Lemma nullable_correct:
-  forall head sem word, word = [] ->
-    parse_tree head word sem -> nullable_symb head = true
-with nullable_correct_list:
-  forall heads sems word, word = [] ->
-    parse_tree_list heads word sems -> nullable_word heads = true.
-Proof with eauto.
-intros.
-destruct X.
-congruence.
-apply nullable_stable...
-intros.
-destruct X; simpl...
-apply andb_true_intro.
-apply app_eq_nil in H; destruct H; split...
-Qed.
-
-(** If the first predicate has been validated, then it is correct. **)
-Lemma first_correct:
-  forall head sem word t q, word = t::q ->
-  parse_tree head word sem ->
-  TerminalSet.In (projT1 t) (first_symb_set head)
-with first_correct_list:
-  forall heads sems word t q, word = t::q ->
-  parse_tree_list heads word sems ->
-  TerminalSet.In (projT1 t) (first_word_set heads).
-Proof with eauto.
-intros.
-destruct X.
-inversion H; subst.
-apply TerminalSet.singleton_2, compare_refl...
-apply first_stable...
-intros.
-destruct X.
-congruence.
-simpl.
-case_eq wordt; intros.
-erewrite nullable_correct...
-apply TerminalSet.union_3.
-subst...
-rewrite H0 in *; inversion H; destruct H2.
-destruct (nullable_symb head_symbolt)...
-apply TerminalSet.union_2...
-Qed.
-
-Variable init: initstate.
-Variable full_word: list token.
-Variable buffer_end: Stream token.
-Variable full_sem: symbol_semantic_type (NT (start_nt init)).
-
-Inductive pt_zipper:
-  forall (hole_symb:symbol) (hole_word:list token)
-         (hole_sem:symbol_semantic_type hole_symb), Type :=
-| Top_ptz:
-  pt_zipper (NT (start_nt init)) (full_word) (full_sem)
-| Cons_ptl_ptz:
-  forall {head_symbolt:symbol}
-    {wordt:list token}
-    {semantic_valuet:symbol_semantic_type head_symbolt},
-
-  forall {head_symbolsq:list symbol}
-    {wordq:list token}
-    {semantic_valuesq:tuple (map symbol_semantic_type head_symbolsq)},
-    parse_tree_list head_symbolsq wordq semantic_valuesq ->
-
-    ptl_zipper (head_symbolt::head_symbolsq) (wordt++wordq)
-      (semantic_valuet,semantic_valuesq) ->
-
-    pt_zipper head_symbolt wordt semantic_valuet
-with ptl_zipper:
-  forall (hole_symbs:list symbol) (hole_word:list token)
-         (hole_sems:tuple (map symbol_semantic_type hole_symbs)), Type :=
-| Non_terminal_pt_ptlz:
-  forall {p:production} {word:list token}
-    {semantic_values:tuple (map symbol_semantic_type (rev (prod_rhs_rev p)))},
-    pt_zipper (NT (prod_lhs p)) word (uncurry (prod_action p) semantic_values) ->
-    ptl_zipper (rev (prod_rhs_rev p)) word semantic_values
-
-| Cons_ptl_ptlz:
-  forall {head_symbolt:symbol}
-    {wordt:list token}
-    {semantic_valuet:symbol_semantic_type head_symbolt},
-    parse_tree head_symbolt wordt semantic_valuet ->
-
-  forall {head_symbolsq:list symbol}
-    {wordq:list token}
-    {semantic_valuesq:tuple (map symbol_semantic_type head_symbolsq)},
-
-  ptl_zipper (head_symbolt::head_symbolsq) (wordt++wordq)
-    (semantic_valuet,semantic_valuesq) ->
-
-  ptl_zipper head_symbolsq wordq semantic_valuesq.
-
-Fixpoint ptlz_cost {hole_symbs hole_word hole_sems}
-  (ptlz:ptl_zipper hole_symbs hole_word hole_sems) :=
-  match ptlz with
-    | Non_terminal_pt_ptlz ptz =>
-      ptz_cost ptz
-    | Cons_ptl_ptlz pt ptlz' =>
-      ptlz_cost ptlz'
-  end
-with ptz_cost {hole_symb hole_word hole_sem}
-  (ptz:pt_zipper hole_symb hole_word hole_sem) :=
-  match ptz with
-    | Top_ptz => 0
-    | Cons_ptl_ptz ptl ptlz' =>
-      1 + ptl_size ptl + ptlz_cost ptlz'
-  end.
-
-Inductive pt_dot: Type :=
-| Reduce_ptd: ptl_zipper [] [] () -> pt_dot
-| Shift_ptd:
-  forall (term:terminal) (sem: symbol_semantic_type (T term))
-    {symbolsq wordq semsq},
-    parse_tree_list symbolsq wordq semsq ->
-    ptl_zipper (T term::symbolsq) (existT (fun t => symbol_semantic_type (T t)) term sem::wordq) (sem, semsq) ->
-    pt_dot.
-
-Definition ptd_cost (ptd:pt_dot) :=
-  match ptd with
-    | Reduce_ptd ptlz => ptlz_cost ptlz
-    | Shift_ptd _ _ ptl ptlz => 1 + ptl_size ptl + ptlz_cost ptlz
-  end.
-
-Fixpoint ptlz_buffer {hole_symbs hole_word hole_sems}
-  (ptlz:ptl_zipper hole_symbs hole_word hole_sems): Stream token :=
-  match ptlz with
-    | Non_terminal_pt_ptlz ptz =>
-      ptz_buffer ptz
-    | Cons_ptl_ptlz _ ptlz' =>
-      ptlz_buffer ptlz'
-  end
-with ptz_buffer {hole_symb hole_word hole_sem}
-  (ptz:pt_zipper hole_symb hole_word hole_sem): Stream token :=
-  match ptz with
-    | Top_ptz => buffer_end
-    | @Cons_ptl_ptz _ _ _ _ wordq _ ptl ptlz' =>
-      wordq++ptlz_buffer ptlz'
-  end.
-
-Definition ptd_buffer (ptd:pt_dot) :=
-  match ptd with
-    | Reduce_ptd ptlz => ptlz_buffer ptlz
-    | @Shift_ptd term sem _ wordq _ _ ptlz =>
-      Cons (existT (fun t => symbol_semantic_type (T t)) term sem)
-           (wordq ++ ptlz_buffer ptlz)
-  end.
-
-Fixpoint ptlz_prod {hole_symbs hole_word hole_sems}
-  (ptlz:ptl_zipper hole_symbs hole_word hole_sems): production :=
-  match ptlz with
-    | @Non_terminal_pt_ptlz prod _ _ _ => prod
-    | Cons_ptl_ptlz _ ptlz' =>
-      ptlz_prod ptlz'
-  end.
-
-Fixpoint ptlz_past {hole_symbs hole_word hole_sems}
-  (ptlz:ptl_zipper hole_symbs hole_word hole_sems): list symbol :=
-  match ptlz with
-    | Non_terminal_pt_ptlz _ => []
-    | @Cons_ptl_ptlz s _ _ _ _ _ _ ptlz' => s::ptlz_past ptlz'
-  end.
-
-Lemma ptlz_past_ptlz_prod:
-  forall hole_symbs hole_word hole_sems
-    (ptlz:ptl_zipper hole_symbs hole_word hole_sems),
-  rev_append hole_symbs (ptlz_past ptlz) = prod_rhs_rev (ptlz_prod ptlz).
-Proof.
-fix ptlz_past_ptlz_prod 4.
-destruct ptlz; simpl.
-rewrite <- rev_alt, rev_involutive; reflexivity.
-apply (ptlz_past_ptlz_prod _ _ _ ptlz).
-Qed.
-
-Definition ptlz_state_compat {hole_symbs hole_word hole_sems}
-  (ptlz:ptl_zipper hole_symbs hole_word hole_sems)
-  (state:state): Prop :=
-  state_has_future state (ptlz_prod ptlz) hole_symbs
-    (projT1 (Streams.hd (ptlz_buffer ptlz))).
-
-Fixpoint ptlz_stack_compat {hole_symbs hole_word hole_sems}
-  (ptlz:ptl_zipper hole_symbs hole_word hole_sems)
-  (stack:stack): Prop :=
-  ptlz_state_compat ptlz (state_of_stack init stack) /\
-  match ptlz with
-    | Non_terminal_pt_ptlz ptz =>
-      ptz_stack_compat ptz stack
-    | @Cons_ptl_ptlz _ _ sem _ _ _ _ ptlz' =>
-      match stack with
-        | [] => False
-        | existT _ _ sem'::stackq =>
-          ptlz_stack_compat ptlz' stackq /\
-          sem ~= sem'
-      end
-  end
-with ptz_stack_compat {hole_symb hole_word hole_sem}
-  (ptz:pt_zipper hole_symb hole_word hole_sem)
-  (stack:stack): Prop :=
-  match ptz with
-    | Top_ptz => stack = []
-    | Cons_ptl_ptz _ ptlz' =>
-      ptlz_stack_compat ptlz' stack
-  end.
-
-Lemma ptlz_stack_compat_ptlz_state_compat:
-  forall hole_symbs hole_word hole_sems
-    (ptlz:ptl_zipper hole_symbs hole_word hole_sems)
-    (stack:stack),
-    ptlz_stack_compat ptlz stack -> ptlz_state_compat ptlz (state_of_stack init stack).
-Proof.
-destruct ptlz; simpl; intuition.
-Qed.
-
-Definition ptd_stack_compat (ptd:pt_dot) (stack:stack): Prop :=
-  match ptd with
-    | Reduce_ptd ptlz => ptlz_stack_compat ptlz stack
-    | Shift_ptd _ _ _ ptlz => ptlz_stack_compat ptlz stack
-  end.
-
-Fixpoint build_pt_dot {hole_symbs hole_word hole_sems}
-    (ptl:parse_tree_list hole_symbs hole_word hole_sems)
-    (ptlz:ptl_zipper hole_symbs hole_word hole_sems)
-    :pt_dot :=
-  match ptl in parse_tree_list hole_symbs hole_word hole_sems
-    return ptl_zipper hole_symbs hole_word hole_sems -> _
-  with
-    | Nil_ptl => fun ptlz =>
-      Reduce_ptd ptlz
-    | Cons_ptl pt ptl' =>
-      match pt in parse_tree hole_symb hole_word hole_sem
-        return ptl_zipper (hole_symb::_) (hole_word++_) (hole_sem,_) -> _
-      with
-        | Terminal_pt term sem => fun ptlz =>
-          Shift_ptd term sem ptl' ptlz
-        | Non_terminal_pt ptl'' => fun ptlz =>
-          build_pt_dot ptl''
-            (Non_terminal_pt_ptlz (Cons_ptl_ptz ptl' ptlz))
-      end
-  end ptlz.
-
-Lemma build_pt_dot_cost:
-  forall hole_symbs hole_word hole_sems
-    (ptl:parse_tree_list hole_symbs hole_word hole_sems)
-    (ptlz:ptl_zipper hole_symbs hole_word hole_sems),
-    ptd_cost (build_pt_dot ptl ptlz) = ptl_size ptl + ptlz_cost ptlz.
-Proof.
-fix build_pt_dot_cost 4.
-destruct ptl; intros.
-reflexivity.
-destruct p.
-reflexivity.
-simpl; rewrite build_pt_dot_cost.
-simpl; rewrite <- plus_n_Sm, Nat.add_assoc; reflexivity.
-Qed.
-
-Lemma build_pt_dot_buffer:
-  forall hole_symbs hole_word hole_sems
-    (ptl:parse_tree_list hole_symbs hole_word hole_sems)
-    (ptlz:ptl_zipper hole_symbs hole_word hole_sems),
-    ptd_buffer (build_pt_dot ptl ptlz) = hole_word ++ ptlz_buffer ptlz.
-Proof.
-fix build_pt_dot_buffer 4.
-destruct ptl; intros.
-reflexivity.
-destruct p.
-reflexivity.
-simpl; rewrite build_pt_dot_buffer.
-apply app_str_app_assoc.
-Qed.
-
-Lemma ptd_stack_compat_build_pt_dot:
-  forall hole_symbs hole_word hole_sems
-    (ptl:parse_tree_list hole_symbs hole_word hole_sems)
-    (ptlz:ptl_zipper hole_symbs hole_word hole_sems)
-    (stack:stack),
-  ptlz_stack_compat ptlz stack ->
-  ptd_stack_compat (build_pt_dot ptl ptlz) stack.
-Proof.
-fix ptd_stack_compat_build_pt_dot 4.
-destruct ptl; intros.
-eauto.
-destruct p.
-eauto.
-simpl.
-apply ptd_stack_compat_build_pt_dot.
-split.
-apply ptlz_stack_compat_ptlz_state_compat, non_terminal_closed in H.
-apply H; clear H; eauto.
-destruct wordq.
-right; split.
-eauto.
-eapply nullable_correct_list; eauto.
-left.
-eapply first_correct_list; eauto.
-eauto.
-Qed.
-
-Program Fixpoint pop_ptlz {hole_symbs hole_word hole_sems}
-  (ptl:parse_tree_list hole_symbs hole_word hole_sems)
-  (ptlz:ptl_zipper hole_symbs hole_word hole_sems):
-    { word:_ & { sem:_ &
-      (pt_zipper (NT (prod_lhs (ptlz_prod ptlz))) word sem *
-       parse_tree (NT (prod_lhs (ptlz_prod ptlz))) word sem)%type } } :=
-  match ptlz in ptl_zipper hole_symbs hole_word hole_sems
-    return parse_tree_list hole_symbs hole_word hole_sems ->
-    { word:_ & { sem:_ &
-      (pt_zipper (NT (prod_lhs (ptlz_prod ptlz))) word sem *
-       parse_tree (NT (prod_lhs (ptlz_prod ptlz))) word sem)%type } }
-  with
-    | @Non_terminal_pt_ptlz prod word sem ptz => fun ptl =>
-      let sem := uncurry (prod_action prod) sem in
-      existT _ word (existT _ sem (ptz, Non_terminal_pt ptl))
-    | Cons_ptl_ptlz pt ptlz' => fun ptl =>
-      pop_ptlz (Cons_ptl pt ptl) ptlz'
-  end ptl.
-
-Lemma pop_ptlz_cost:
-  forall hole_symbs hole_word hole_sems
-    (ptl:parse_tree_list hole_symbs hole_word hole_sems)
-    (ptlz:ptl_zipper hole_symbs hole_word hole_sems),
-  let 'existT _ word (existT _ sem (ptz, pt)) := pop_ptlz ptl ptlz in
-  ptlz_cost ptlz = ptz_cost ptz.
-Proof.
-fix pop_ptlz_cost 5.
-destruct ptlz.
-reflexivity.
-simpl; apply pop_ptlz_cost.
-Qed.
-
-Lemma pop_ptlz_buffer:
-  forall hole_symbs hole_word hole_sems
-    (ptl:parse_tree_list hole_symbs hole_word hole_sems)
-    (ptlz:ptl_zipper hole_symbs hole_word hole_sems),
-  let 'existT _ word (existT _ sem (ptz, pt)) := pop_ptlz ptl ptlz in
-  ptlz_buffer ptlz = ptz_buffer ptz.
-Proof.
-fix pop_ptlz_buffer 5.
-destruct ptlz.
-reflexivity.
-simpl; apply pop_ptlz_buffer.
-Qed.
-
-Lemma pop_ptlz_pop_stack_compat_converter:
-  forall A hole_symbs hole_word hole_sems (ptlz:ptl_zipper hole_symbs hole_word hole_sems),
-  arrows_left (map symbol_semantic_type (rev (prod_rhs_rev (ptlz_prod ptlz)))) A =
-  arrows_left (map symbol_semantic_type hole_symbs)
-    (arrows_right A (map symbol_semantic_type (ptlz_past ptlz))).
-Proof.
-intros.
-rewrite <- ptlz_past_ptlz_prod.
-unfold arrows_right, arrows_left.
-rewrite rev_append_rev, map_rev, map_app, map_rev, <- fold_left_rev_right, rev_involutive, fold_right_app.
-rewrite fold_left_rev_right.
-reflexivity.
-Qed.
-
-Lemma pop_ptlz_pop_stack_compat:
-  forall hole_symbs hole_word hole_sems
-    (ptl:parse_tree_list hole_symbs hole_word hole_sems)
-    (ptlz:ptl_zipper hole_symbs hole_word hole_sems)
-    (stack:stack),
-
-    ptlz_stack_compat ptlz stack ->
-
-    let action' :=
-      eq_rect _ (fun x=>x) (prod_action (ptlz_prod ptlz)) _
-      (pop_ptlz_pop_stack_compat_converter _ _ _ _ _)
-    in
-    let 'existT _ word (existT _ sem (ptz, pt)) := pop_ptlz ptl ptlz in
-      match pop (ptlz_past ptlz) stack (uncurry action' hole_sems) with
-        | OK (stack', sem') =>
-           ptz_stack_compat ptz stack' /\ sem = sem'
-        | Err => True
-      end.
-Proof.
-Opaque AlphabetComparable AlphabetComparableUsualEq.
-fix pop_ptlz_pop_stack_compat 5.
-destruct ptlz. intros; simpl.
-split.
-apply H.
-eapply (f_equal (fun X => uncurry X semantic_values)).
-apply JMeq_eq, JMeq_sym, JMeq_eqrect with (P:=fun x => x).
-simpl; intros; destruct stack0.
-destruct (proj2 H).
-simpl in H; destruct H.
-destruct s as (state, sem').
-destruct H0.
-specialize (pop_ptlz_pop_stack_compat _ _ _ (Cons_ptl p ptl) ptlz _ H0).
-destruct (pop_ptlz (Cons_ptl p ptl) ptlz) as [word [sem []]].
-destruct (compare_eqdec (last_symb_of_non_init_state state) head_symbolt); intuition.
-eapply JMeq_sym, JMeq_trans, JMeq_sym, JMeq_eq in H1; [|apply JMeq_eqrect with (e:=e)].
-rewrite <- H1.
-simpl in pop_ptlz_pop_stack_compat.
-erewrite proof_irrelevance with (p1:=pop_ptlz_pop_stack_compat_converter _ _ _ _ _).
-apply pop_ptlz_pop_stack_compat.
-Transparent AlphabetComparable AlphabetComparableUsualEq.
-Qed.
-
-Definition next_ptd (ptd:pt_dot): option pt_dot :=
-  match ptd with
-    | Shift_ptd term sem ptl ptlz =>
-      Some (build_pt_dot ptl (Cons_ptl_ptlz (Terminal_pt term sem) ptlz))
-    | Reduce_ptd ptlz =>
-      let 'existT _ _ (existT _ _ (ptz, pt)) := pop_ptlz Nil_ptl ptlz in
-      match ptz in pt_zipper sym _ _ return parse_tree sym _ _ -> _ with
-        | Top_ptz => fun pt => None
-        | Cons_ptl_ptz ptl ptlz' =>
-          fun pt => Some (build_pt_dot ptl (Cons_ptl_ptlz pt ptlz'))
-      end pt
-  end.
-
-Lemma next_ptd_cost:
-  forall ptd,
-    match next_ptd ptd with
-      | None => ptd_cost ptd = 0
-      | Some ptd' => ptd_cost ptd = S (ptd_cost ptd')
-    end.
-Proof.
-destruct ptd. unfold next_ptd.
-pose proof (pop_ptlz_cost _ _ _ Nil_ptl p).
-destruct (pop_ptlz Nil_ptl p) as [word[sem[[]]]].
-assumption.
-rewrite build_pt_dot_cost.
-assumption.
-simpl; rewrite build_pt_dot_cost; reflexivity.
-Qed.
-
-Lemma reduce_step_next_ptd:
-  forall (ptlz:ptl_zipper [] [] ()) (stack:stack),
-    ptlz_stack_compat ptlz stack ->
-    match reduce_step init stack (ptlz_prod ptlz) (ptlz_buffer ptlz) with
-      | OK Fail_sr =>
-        False
-      | OK (Accept_sr sem buffer) =>
-        sem = full_sem /\ buffer = buffer_end /\ next_ptd (Reduce_ptd ptlz) = None
-      | OK (Progress_sr stack buffer) =>
-        match next_ptd (Reduce_ptd ptlz) with
-          | None => False
-          | Some ptd =>
-            ptd_stack_compat ptd stack /\ buffer = ptd_buffer ptd
-        end
-      | Err =>
-        True
-    end.
-Proof.
-intros.
-unfold reduce_step, next_ptd.
-apply pop_ptlz_pop_stack_compat with (ptl:=Nil_ptl) in H.
-pose proof (pop_ptlz_buffer _ _ _ Nil_ptl ptlz).
-destruct (pop_ptlz Nil_ptl ptlz) as [word [sem [ptz pt]]].
-rewrite H0; clear H0.
-revert H.
-match goal with
-  |- match ?p1 with Err => _ | OK _ => _ end -> match bind2 ?p2 _ with Err => _ | OK _ => _ end =>
-  replace p1 with p2; [destruct p2 as [|[]];  intros|]
-end.
-assumption.
-simpl.
-destruct H; subst.
-generalize dependent s0.
-generalize (prod_lhs (ptlz_prod ptlz)); clear ptlz stack0.
-dependent destruction ptz; intros.
-simpl in H; subst; simpl.
-pose proof start_goto; unfold Valid.start_goto in H; rewrite H.
-destruct (compare_eqdec (start_nt init) (start_nt init)); intuition.
-apply JMeq_eq, JMeq_eqrect with (P:=fun nt => symbol_semantic_type (NT nt)).
-pose proof (ptlz_stack_compat_ptlz_state_compat _ _ _ _ _ H).
-apply non_terminal_goto in H0.
-destruct (goto_table (state_of_stack init s) n) as [[]|]; intuition.
-apply ptd_stack_compat_build_pt_dot; simpl; intuition.
-symmetry; apply JMeq_eqrect with (P:=symbol_semantic_type).
-symmetry; apply build_pt_dot_buffer.
-destruct s; intuition.
-simpl in H; apply ptlz_stack_compat_ptlz_state_compat in H.
-destruct (H0 _ _ _ H eq_refl).
-generalize (pop_ptlz_pop_stack_compat_converter (symbol_semantic_type (NT (prod_lhs (ptlz_prod ptlz)))) _ _ _ ptlz).
-pose proof (ptlz_past_ptlz_prod _ _ _ ptlz); simpl in H.
-rewrite H; clear H.
-intro; f_equal; simpl.
-apply JMeq_eq.
-etransitivity.
-apply JMeq_eqrect with (P:=fun x => x).
-symmetry.
-apply JMeq_eqrect with (P:=fun x => x).
-Qed.
-
-Lemma step_next_ptd:
-  forall (ptd:pt_dot) (stack:stack),
-    ptd_stack_compat ptd stack ->
-    match step init stack (ptd_buffer ptd) with
-      | OK Fail_sr =>
-        False
-      | OK (Accept_sr sem buffer) =>
-        sem = full_sem /\ buffer = buffer_end /\ next_ptd ptd = None
-      | OK (Progress_sr stack buffer) =>
-        match next_ptd ptd with
-          | None => False
-          | Some ptd =>
-            ptd_stack_compat ptd stack /\ buffer = ptd_buffer ptd
-        end
-      | Err =>
-        True
-    end.
-Proof.
-intros.
-destruct ptd.
-pose proof (ptlz_stack_compat_ptlz_state_compat _ _ _ _ _ H).
-apply end_reduce in H0.
-unfold step.
-destruct (action_table (state_of_stack init stack0)).
-rewrite H0 by reflexivity.
-apply reduce_step_next_ptd; assumption.
-simpl; destruct (Streams.hd (ptlz_buffer p)); simpl in H0.
-destruct (l x); intuition; rewrite H1.
-apply reduce_step_next_ptd; assumption.
-pose proof (ptlz_stack_compat_ptlz_state_compat _ _ _ _ _ H).
-apply terminal_shift in H0.
-unfold step.
-destruct (action_table (state_of_stack init stack0)); intuition.
-simpl; destruct (Streams.hd (ptlz_buffer p0)) as [] eqn:?.
-destruct (l term); intuition.
-apply ptd_stack_compat_build_pt_dot; simpl; intuition.
-unfold ptlz_state_compat; simpl; destruct Heqt; assumption.
-symmetry; apply JMeq_eqrect with (P:=symbol_semantic_type).
-rewrite build_pt_dot_buffer; reflexivity.
-Qed.
-
-Lemma parse_fix_complete:
-  forall (ptd:pt_dot) (stack:stack) (n_steps:nat),
-    ptd_stack_compat ptd stack ->
-    match parse_fix init stack (ptd_buffer ptd) n_steps with
-      | OK (Parsed_pr sem_res buffer_end_res) =>
-        sem_res = full_sem /\ buffer_end_res = buffer_end /\
-         S (ptd_cost ptd) <= n_steps
-      | OK Fail_pr => False
-      | OK Timeout_pr => n_steps < S (ptd_cost ptd)
-      | Err => True
-    end.
-Proof.
-fix parse_fix_complete 3.
-destruct n_steps; intros; simpl.
-apply Nat.lt_0_succ.
-apply step_next_ptd in H.
-pose proof (next_ptd_cost ptd).
-destruct (step init stack0 (ptd_buffer ptd)) as [|[]]; simpl; intuition.
-rewrite H3 in H0; rewrite H0.
-apply le_n_S, Nat.le_0_l.
-destruct (next_ptd ptd); intuition; subst.
-eapply parse_fix_complete with (n_steps:=n_steps) in H1.
-rewrite H0.
-destruct (parse_fix init s (ptd_buffer p) n_steps) as [|[]]; try assumption.
-apply lt_n_S; assumption.
-destruct H1 as [H1 []]; split; [|split]; try assumption.
-apply le_n_S; assumption.
-Qed.
-
-Variable full_pt: parse_tree (NT (start_nt init)) full_word full_sem.
-
-Definition init_ptd :=
-  match full_pt in parse_tree head full_word full_sem return
-    pt_zipper head full_word full_sem ->
-    match head return Type with | T _ => unit | NT _ => pt_dot end
-  with
-    | Terminal_pt _ _ => fun _ => ()
-    | Non_terminal_pt ptl =>
-      fun top => build_pt_dot ptl (Non_terminal_pt_ptlz top)
-  end Top_ptz.
-
-Lemma init_ptd_compat:
-  ptd_stack_compat init_ptd [].
-Proof.
-unfold init_ptd.
-assert (ptz_stack_compat Top_ptz []) by reflexivity.
-pose proof (start_future init); revert H0.
-generalize dependent Top_ptz.
-generalize dependent full_word.
-generalize full_sem.
-generalize (start_nt init).
-dependent destruction full_pt0.
-intros.
-apply ptd_stack_compat_build_pt_dot; simpl; intuition.
-apply H0; reflexivity.
-Qed.
-
-Lemma init_ptd_cost:
-  S (ptd_cost init_ptd) = pt_size full_pt.
-Proof.
-unfold init_ptd.
-assert (ptz_cost Top_ptz = 0) by reflexivity.
-generalize dependent Top_ptz.
-generalize dependent full_word.
-generalize full_sem.
-generalize (start_nt init).
-dependent destruction full_pt0.
-intros.
-rewrite build_pt_dot_cost; simpl.
-rewrite H, Nat.add_0_r; reflexivity.
-Qed.
-
-Lemma init_ptd_buffer:
-  ptd_buffer init_ptd = full_word ++ buffer_end.
-Proof.
-unfold init_ptd.
-assert (ptz_buffer Top_ptz = buffer_end) by reflexivity.
-generalize dependent Top_ptz.
-generalize dependent full_word.
-generalize full_sem.
-generalize (start_nt init).
-dependent destruction full_pt0.
-intros.
-rewrite build_pt_dot_buffer; simpl.
-rewrite H; reflexivity.
-Qed.
-
-Theorem parse_complete n_steps:
-  match parse init (full_word ++ buffer_end) n_steps with
-    | OK (Parsed_pr sem_res buffer_end_res) =>
-      sem_res = full_sem /\ buffer_end_res = buffer_end /\
-       pt_size full_pt <= n_steps
-    | OK Fail_pr => False
-    | OK Timeout_pr => n_steps < pt_size full_pt
-    | Err => True
-  end.
-Proof.
-pose proof (parse_fix_complete init_ptd [] n_steps init_ptd_compat).
-rewrite init_ptd_buffer, init_ptd_cost in H.
-apply H.
-Qed.
-
-End Completeness_Proof.
-
-End Make.
diff --git a/cparser/MenhirLib/Interpreter_correct.v b/cparser/MenhirLib/Interpreter_correct.v
deleted file mode 100644
index 1263d4e3..00000000
--- a/cparser/MenhirLib/Interpreter_correct.v
+++ /dev/null
@@ -1,228 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Import Streams.
-Require Import List.
-Require Import Syntax.
-Require Import Equality.
-Require Import Alphabet.
-Require Grammar.
-Require Automaton.
-Require Interpreter.
-
-Module Make(Import A:Automaton.T) (Import Inter:Interpreter.T A).
-
-(** * Correctness of the interpreter **)
-
-(** We prove that, in any case, if the interpreter accepts returning a
-    semantic value, then this is a semantic value of the input **)
-
-Section Init.
-
-Variable init:initstate.
-
-(** [word_has_stack_semantics] relates a word with a state, stating that the
-    word is a concatenation of words that have the semantic values stored in
-    the stack. **)
-Inductive word_has_stack_semantics:
-  forall (word:list token) (stack:stack), Prop :=
-  | Nil_stack_whss: word_has_stack_semantics [] []
-  | Cons_stack_whss:
-    forall (wordq:list token) (stackq:stack),
-      word_has_stack_semantics wordq stackq ->
-
-    forall (wordt:list token) (s:noninitstate)
-           (semantic_valuet:_),
-      inhabited (parse_tree (last_symb_of_non_init_state s) wordt semantic_valuet) ->
-
-    word_has_stack_semantics
-       (wordq++wordt) (existT noninitstate_type s semantic_valuet::stackq).
-
-Lemma pop_invariant_converter:
-  forall A symbols_to_pop symbols_popped,
-  arrows_left (map symbol_semantic_type (rev_append symbols_to_pop symbols_popped)) A =
-  arrows_left (map symbol_semantic_type symbols_popped)
-    (arrows_right A (map symbol_semantic_type symbols_to_pop)).
-Proof.
-intros.
-unfold arrows_right, arrows_left.
-rewrite rev_append_rev, map_app, map_rev, fold_left_app.
-apply f_equal.
-rewrite <- fold_left_rev_right, rev_involutive.
-reflexivity.
-Qed.
-
-(** [pop] preserves the invariant **)
-Lemma pop_invariant:
-  forall (symbols_to_pop symbols_popped:list symbol)
-         (stack_cur:stack)
-         (A:Type)
-         (action:arrows_left (map symbol_semantic_type (rev_append symbols_to_pop symbols_popped)) A),
-  forall word_stack word_popped,
-  forall sem_popped,
-    word_has_stack_semantics word_stack stack_cur ->
-    inhabited (parse_tree_list symbols_popped word_popped sem_popped) ->
-    let action' := eq_rect _ (fun x=>x) action _ (pop_invariant_converter _ _ _) in
-    match pop symbols_to_pop stack_cur (uncurry action' sem_popped) with
-      | OK (stack_new, sem) =>
-          exists word1res word2res sem_full,
-            (word_stack = word1res ++ word2res)%list /\
-            word_has_stack_semantics word1res stack_new /\
-            sem = uncurry action sem_full /\
-            inhabited (
-              parse_tree_list (rev_append symbols_to_pop symbols_popped) (word2res++word_popped) sem_full)
-      | Err => True
-    end.
-Proof.
-induction symbols_to_pop; intros; unfold pop; fold pop.
-exists word_stack, ([]:list token), sem_popped; intuition.
-f_equal.
-apply JMeq_eq, JMeq_eqrect with (P:=(fun x => x)).
-destruct stack_cur as [|[]]; eauto.
-destruct (compare_eqdec (last_symb_of_non_init_state x) a); eauto.
-destruct e; simpl.
-dependent destruction H.
-destruct H0, H1. apply (Cons_ptl X), inhabits in X0.
-specialize (IHsymbols_to_pop _ _ _ action0 _ _ _ H X0).
-match goal with
-  IHsymbols_to_pop:match ?p1 with Err => _ | OK _ => _ end |- match ?p2 with Err => _ | OK _ => _ end =>
-    replace p2 with p1; [destruct p1 as [|[]]|]; intuition
-end.
-destruct IHsymbols_to_pop as [word1res [word2res [sem_full []]]]; intuition; subst.
-exists word1res.
-eexists.
-exists sem_full.
-intuition.
-rewrite <- app_assoc; assumption.
-simpl; f_equal; f_equal.
-apply JMeq_eq.
-etransitivity.
-apply JMeq_eqrect with (P:=(fun x => x)).
-symmetry.
-apply JMeq_eqrect with (P:=(fun x => x)).
-Qed.
-
-(** [reduce_step] preserves the invariant **)
-Lemma reduce_step_invariant (stack:stack) (prod:production):
-  forall word buffer, word_has_stack_semantics word stack ->
-  match reduce_step init stack prod buffer with
-    | OK (Accept_sr sem buffer_new) =>
-      buffer = buffer_new /\
-      inhabited (parse_tree (NT (start_nt init)) word sem)
-    | OK (Progress_sr stack_new buffer_new) =>
-      buffer = buffer_new /\
-      word_has_stack_semantics word stack_new
-    | Err | OK Fail_sr => True
-  end.
-Proof with eauto.
-intros.
-unfold reduce_step.
-pose proof (pop_invariant (prod_rhs_rev prod) [] stack (symbol_semantic_type (NT (prod_lhs prod)))).
-revert H0.
-generalize (pop_invariant_converter (symbol_semantic_type (NT (prod_lhs prod))) (prod_rhs_rev prod) []).
-rewrite <- rev_alt.
-intros.
-specialize (H0 (prod_action prod) _ [] () H (inhabits Nil_ptl)).
-match goal with H0:let action' := ?a in _ |- _ => replace a with (prod_action' prod) in H0 end.
-simpl in H0.
-destruct (pop (prod_rhs_rev prod) stack (prod_action' prod)) as [|[]]; intuition.
-destruct H0 as [word1res [word2res [sem_full]]]; intuition.
-destruct H4; apply Non_terminal_pt, inhabits in X.
-match goal with X:inhabited (parse_tree _ _ ?u) |- _ => replace u with s0 in X end.
-clear sem_full H2.
-simpl; destruct (goto_table (state_of_stack init s) (prod_lhs prod)) as [[]|]; intuition; subst.
-rewrite app_nil_r in X; revert s0 X; rewrite e0; intro; simpl.
-constructor...
-destruct s; intuition.
-destruct (compare_eqdec (prod_lhs prod) (start_nt init)); intuition.
-rewrite app_nil_r in X.
-rewrite <- e0.
-inversion H0.
-destruct X; constructor...
-apply JMeq_eq.
-etransitivity.
-apply JMeq_eqrect with (P:=(fun x => x)).
-symmetry.
-apply JMeq_eqrect with (P:=(fun x => x)).
-Qed.
-
-(** [step] preserves the invariant **)
-Lemma step_invariant (stack:stack) (buffer:Stream token):
-  forall buffer_tmp,
-  (exists word_old,
-    buffer = word_old ++ buffer_tmp /\
-    word_has_stack_semantics word_old stack) ->
-  match step init stack buffer_tmp with
-    | OK (Accept_sr sem buffer_new) =>
-      exists word_new,
-        buffer = word_new ++ buffer_new /\
-        inhabited (parse_tree (NT (start_nt init)) word_new sem)
-    | OK (Progress_sr stack_new buffer_new) =>
-      exists word_new,
-        buffer = word_new ++ buffer_new /\
-        word_has_stack_semantics word_new stack_new
-    | Err | OK Fail_sr => True
-  end.
-Proof with eauto.
-intros.
-destruct H, H.
-unfold step.
-destruct (action_table (state_of_stack init stack)).
-pose proof (reduce_step_invariant stack p x buffer_tmp).
-destruct (reduce_step init stack p buffer_tmp) as [|[]]; intuition; subst...
-destruct buffer_tmp.
-unfold Streams.hd.
-destruct t.
-destruct (l x0); intuition.
-exists (x ++ [existT (fun t => symbol_semantic_type (T t)) x0 s])%list.
-split.
-now rewrite <- app_str_app_assoc; intuition.
-apply Cons_stack_whss; intuition.
-destruct e; simpl.
-now exact (inhabits (Terminal_pt _ _)).
-match goal with |- (match reduce_step init stack p ?buff with Err => _ | OK _ => _ end) =>
-  pose proof (reduce_step_invariant stack p x buff);
-  destruct (reduce_step init stack p buff) as [|[]]; intuition; subst
-end...
-Qed.
-
-(** The interpreter is correct : if it returns a semantic value, then the input
-    word has this semantic value.
-**)
-Theorem parse_correct buffer n_steps:
-  match parse init buffer n_steps with
-    | OK (Parsed_pr sem buffer_new) =>
-      exists word_new,
-        buffer = word_new ++ buffer_new /\
-        inhabited (parse_tree (NT (start_nt init)) word_new sem)
-    | _ => True
-  end.
-Proof.
-unfold parse.
-assert (exists w, buffer = w ++ buffer /\ word_has_stack_semantics w []).
-exists ([]:list token); intuition.
-now apply Nil_stack_whss.
-revert H.
-generalize ([]:stack), buffer at 2 3.
-induction n_steps; simpl; intuition.
-pose proof (step_invariant _ _ _ H).
-destruct (step init s buffer0); simpl; intuition.
-destruct s0; intuition.
-apply IHn_steps; intuition.
-Qed.
-
-End Init.
-
-End Make.
diff --git a/cparser/MenhirLib/Interpreter_safe.v b/cparser/MenhirLib/Interpreter_safe.v
deleted file mode 100644
index a1aa35b8..00000000
--- a/cparser/MenhirLib/Interpreter_safe.v
+++ /dev/null
@@ -1,275 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Import Streams.
-Require Import Equality.
-Require Import List.
-Require Import Syntax.
-Require Import Alphabet.
-Require Grammar.
-Require Automaton.
-Require Validator_safe.
-Require Interpreter.
-
-Module Make(Import A:Automaton.T) (Import Inter:Interpreter.T A).
-Module Import Valid := Validator_safe.Make A.
-
-(** * A correct automaton does not crash **)
-
-Section Safety_proof.
-
-Hypothesis safe: safe.
-
-Proposition shift_head_symbs: shift_head_symbs.
-Proof. pose proof safe; unfold Valid.safe in H; intuition. Qed.
-Proposition goto_head_symbs: goto_head_symbs.
-Proof. pose proof safe; unfold Valid.safe in H; intuition. Qed.
-Proposition shift_past_state: shift_past_state.
-Proof. pose proof safe; unfold Valid.safe in H; intuition. Qed.
-Proposition goto_past_state: goto_past_state.
-Proof. pose proof safe; unfold Valid.safe in H; intuition. Qed.
-Proposition reduce_ok: reduce_ok.
-Proof. pose proof safe; unfold Valid.safe in H; intuition. Qed.
-
-(** We prove that a correct automaton won't crash : the interpreter will
-    not return [Err] **)
-
-Variable init : initstate.
-
-(** The stack of states of an automaton stack **)
-Definition state_stack_of_stack (stack:stack) :=
-  (List.map
-    (fun cell:sigT noninitstate_type => singleton_state_pred (projT1 cell))
-    stack ++ [singleton_state_pred init])%list.
-
-(** The stack of symbols of an automaton stack **)
-Definition symb_stack_of_stack (stack:stack) :=
-  List.map
-    (fun cell:sigT noninitstate_type => last_symb_of_non_init_state (projT1 cell))
-    stack.
-
-(** The stack invariant : it basically states that the assumptions on the
-    states are true. **)
-Inductive stack_invariant: stack -> Prop :=
-  | stack_invariant_constr:
-    forall stack,
-      prefix      (head_symbs_of_state (state_of_stack init stack))
-                  (symb_stack_of_stack stack) ->
-      prefix_pred (head_states_of_state (state_of_stack init stack))
-                  (state_stack_of_stack stack) ->
-      stack_invariant_next stack ->
-      stack_invariant stack
-with stack_invariant_next: stack -> Prop :=
-  | stack_invariant_next_nil:
-      stack_invariant_next []
-  | stack_invariant_next_cons:
-    forall state_cur st stack_rec,
-      stack_invariant stack_rec ->
-      stack_invariant_next (existT _ state_cur st::stack_rec).
-
-(** [pop] conserves the stack invariant and does not crash
-     under the assumption that we can pop at this place.
-     Moreover, after a pop, the top state of the stack is allowed. **)
-Lemma pop_stack_invariant_conserved
-  (symbols_to_pop:list symbol) (stack_cur:stack) A action:
-  stack_invariant stack_cur ->
-  prefix symbols_to_pop (head_symbs_of_state (state_of_stack init stack_cur)) ->
-  match pop symbols_to_pop stack_cur (A:=A) action with
-    | OK (stack_new, _) =>
-      stack_invariant stack_new /\
-      state_valid_after_pop
-        (state_of_stack init stack_new) symbols_to_pop
-        (head_states_of_state (state_of_stack init stack_cur))
-    | Err => False
-  end.
-Proof with eauto.
-  intros.
-  pose proof H.
-  destruct H.
-  revert H H0 H1 H2 H3.
-  generalize (head_symbs_of_state (state_of_stack init stack0)).
-  generalize (head_states_of_state (state_of_stack init stack0)).
-  revert stack0 A action.
-  induction symbols_to_pop; intros.
-  - split...
-    destruct l; constructor.
-    inversion H2; subst.
-    specialize (H7 (state_of_stack init stack0)).
-    destruct (f2 (state_of_stack init stack0)) as [] eqn:? ...
-    destruct stack0 as [|[]]; simpl in *.
-    + inversion H6; subst.
-      unfold singleton_state_pred in Heqb0.
-      now rewrite compare_refl in Heqb0; discriminate.
-    + inversion H6; subst.
-      unfold singleton_state_pred in Heqb0.
-      now rewrite compare_refl in Heqb0; discriminate.
-  - destruct stack0 as [|[]]; unfold pop.
-    + inversion H0; subst.
-      now inversion H.
-    + fold pop.
-      destruct (compare_eqdec (last_symb_of_non_init_state x) a).
-      * inversion H0; subst. clear H0.
-        inversion H; subst. clear H.
-        dependent destruction H3; simpl.
-        assert (prefix_pred (List.tl l) (state_stack_of_stack stack0)).
-        unfold tl; destruct l; [constructor | inversion H2]...
-        pose proof H. destruct H3.
-        specialize (IHsymbols_to_pop stack0 A (action0 n) _ _ H4 H7 H H0 H6).
-        revert IHsymbols_to_pop.
-        fold (noninitstate_type x); generalize (pop symbols_to_pop stack0 (action0 n)).
-        destruct r as [|[]]; intuition...
-        destruct l; constructor...
-      * apply n0.
-        inversion H0; subst.
-        inversion H; subst...
-Qed.
-
-(** [prefix] is associative **)
-Lemma prefix_ass:
-  forall (l1 l2 l3:list symbol), prefix l1 l2 -> prefix l2 l3 -> prefix l1 l3.
-Proof.
-induction l1; intros.
-constructor.
-inversion H; subst.
-inversion H0; subst.
-constructor; eauto.
-Qed.
-
-(** [prefix_pred] is associative **)
-Lemma prefix_pred_ass:
-  forall (l1 l2 l3:list (state->bool)),
-  prefix_pred l1 l2 -> prefix_pred l2 l3 -> prefix_pred l1 l3.
-Proof.
-induction l1; intros.
-constructor.
-inversion H; subst.
-inversion H0; subst.
-constructor; eauto.
-intro.
-specialize (H3 x).
-specialize (H4 x).
-destruct (f0 x); simpl in *; intuition.
-rewrite H4 in H3; intuition.
-Qed.
-
-(** If we have the right to reduce at this state, then the stack invariant
-   is conserved by [reduce_step] and [reduce_step] does not crash. **)
-Lemma reduce_step_stack_invariant_conserved stack prod buff:
-  stack_invariant stack ->
-  valid_for_reduce (state_of_stack init stack) prod ->
-  match reduce_step init stack prod buff with
-    | OK (Fail_sr | Accept_sr _ _) => True
-    | OK (Progress_sr stack_new _) => stack_invariant stack_new
-    | Err => False
-  end.
-Proof with eauto.
-unfold valid_for_reduce.
-intuition.
-unfold reduce_step.
-pose proof (pop_stack_invariant_conserved (prod_rhs_rev prod) stack _ (prod_action' prod)).
-destruct (pop (prod_rhs_rev prod) stack (prod_action' prod)) as [|[]].
-apply H0...
-destruct H0...
-pose proof (goto_head_symbs (state_of_stack init s) (prod_lhs prod)).
-pose proof (goto_past_state (state_of_stack init s) (prod_lhs prod)).
-unfold bind2.
-destruct H0.
-specialize (H2 _ H3)...
-destruct (goto_table (state_of_stack init stack0) (prod_lhs prod)) as [[]|].
-constructor.
-simpl.
-constructor.
-eapply prefix_ass...
-unfold state_stack_of_stack; simpl; constructor.
-intro; destruct (singleton_state_pred x x0); reflexivity.
-eapply prefix_pred_ass...
-constructor...
-constructor...
-destruct stack0 as [|[]]...
-destruct (compare_eqdec (prod_lhs prod) (start_nt init))...
-apply n, H2, eq_refl.
-apply H2, eq_refl.
-Qed.
-
-(** If the automaton is safe, then the stack invariant is conserved by
-    [step] and [step] does not crash. **)
-Lemma step_stack_invariant_conserved (stack:stack) buffer:
-  stack_invariant stack ->
-  match step init stack buffer with
-    | OK (Fail_sr | Accept_sr _ _) => True
-    | OK (Progress_sr stack_new _) => stack_invariant stack_new
-    | Err => False
-  end.
-Proof with eauto.
-intro.
-unfold step.
-pose proof (shift_head_symbs (state_of_stack init stack)).
-pose proof (shift_past_state (state_of_stack init stack)).
-pose proof (reduce_ok (state_of_stack init stack)).
-destruct (action_table (state_of_stack init stack)).
-apply reduce_step_stack_invariant_conserved...
-destruct buffer as [[]]; simpl.
-specialize (H0 x); specialize (H1 x); specialize (H2 x).
-destruct (l x)...
-destruct H.
-constructor.
-unfold state_of_stack.
-constructor.
-eapply prefix_ass...
-unfold state_stack_of_stack; simpl; constructor.
-intro; destruct (singleton_state_pred s0 x0)...
-eapply prefix_pred_ass...
-constructor...
-constructor...
-apply reduce_step_stack_invariant_conserved...
-Qed.
-
-(** If the automaton is safe, then it does not crash **)
-Theorem parse_no_err buffer n_steps:
-  parse init buffer n_steps <> Err.
-Proof with eauto.
-unfold parse.
-assert (stack_invariant []).
-constructor.
-constructor.
-unfold state_stack_of_stack; simpl; constructor.
-intro; destruct (singleton_state_pred init x)...
-constructor.
-constructor.
-revert H.
-generalize buffer ([]:stack).
-induction n_steps; simpl.
-now discriminate.
-intros.
-pose proof (step_stack_invariant_conserved s buffer0 H).
-destruct (step init s buffer0) as [|[]]; simpl...
-discriminate.
-discriminate.
-Qed.
-
-(** A version of [parse] that uses safeness in order to return a
-   [parse_result], and not a [result parse_result] : we have proven that
-   parsing does not return [Err]. **)
-Definition parse_with_safe (buffer:Stream token) (n_steps:nat):
-  parse_result init.
-Proof with eauto.
-pose proof (parse_no_err buffer n_steps).
-destruct (parse init buffer n_steps)...
-congruence.
-Defined.
-
-End Safety_proof.
-
-End Make.
diff --git a/cparser/MenhirLib/Main.v b/cparser/MenhirLib/Main.v
deleted file mode 100644
index 1a17e988..00000000
--- a/cparser/MenhirLib/Main.v
+++ /dev/null
@@ -1,92 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Grammar.
-Require Automaton.
-Require Interpreter_safe.
-Require Interpreter_correct.
-Require Interpreter_complete.
-Require Import Syntax.
-
-Module Make(Export Aut:Automaton.T).
-Export Aut.Gram.
-Export Aut.GramDefs.
-
-Module Import Inter := Interpreter.Make Aut.
-Module Safe := Interpreter_safe.Make Aut Inter.
-Module Correct := Interpreter_correct.Make Aut Inter.
-Module Complete := Interpreter_complete.Make Aut Inter.
-
-Definition complete_validator:unit->bool := Complete.Valid.is_complete.
-Definition safe_validator:unit->bool := Safe.Valid.is_safe.
-Definition parse (safe:safe_validator ()=true) init n_steps buffer : parse_result init:=
-  Safe.parse_with_safe (Safe.Valid.is_safe_correct safe) init buffer n_steps.
-
-(** Correction theorem. **)
-Theorem parse_correct
-  (safe:safe_validator ()= true) init n_steps buffer:
-  match parse safe init n_steps buffer with
-    | Parsed_pr sem buffer_new =>
-      exists word,
-        buffer = word ++ buffer_new /\ inhabited (parse_tree (NT (start_nt init)) word sem)
-    | _ => True
-  end.
-Proof.
-unfold parse, Safe.parse_with_safe.
-pose proof (Correct.parse_correct init buffer n_steps).
-generalize (Safe.parse_no_err (Safe.Valid.is_safe_correct safe) init buffer n_steps).
-destruct (Inter.parse init buffer n_steps); intros.
-now destruct (n (eq_refl _)).
-now destruct p; trivial.
-Qed.
-
-(** Completeness theorem. **)
-Theorem parse_complete
-  (safe:safe_validator () = true) init n_steps word buffer_end sem:
-  complete_validator () = true ->
-  forall tree:parse_tree (NT (start_nt init)) word sem,
-  match parse safe init n_steps (word ++ buffer_end) with
-    | Fail_pr => False
-    | Parsed_pr sem_res buffer_end_res =>
-      sem_res = sem /\ buffer_end_res = buffer_end /\ pt_size tree <= n_steps
-    | Timeout_pr => n_steps < pt_size tree
-  end.
-Proof.
-intros.
-unfold parse, Safe.parse_with_safe.
-pose proof (Complete.parse_complete (Complete.Valid.is_complete_correct H) init _ buffer_end _ tree n_steps).
-generalize (Safe.parse_no_err (Safe.Valid.is_safe_correct safe) init (word ++ buffer_end) n_steps).
-destruct (Inter.parse init (word ++ buffer_end) n_steps); intros.
-now destruct (n eq_refl).
-now exact H0.
-Qed.
-
-(** Unambiguity theorem. **)
-Theorem unambiguity:
-  safe_validator () = true -> complete_validator () = true -> inhabited token ->
-  forall init word,
-  forall sem1 (tree1:parse_tree (NT (start_nt init)) word sem1),
-  forall sem2 (tree2:parse_tree (NT (start_nt init)) word sem2),
-  sem1 = sem2.
-Proof.
-intros.
-destruct H1.
-pose proof (parse_complete H init (pt_size tree1) word (Streams.const X) sem1) H0 tree1.
-pose proof (parse_complete H init (pt_size tree1) word (Streams.const X) sem2) H0 tree2.
-destruct (parse H init (pt_size tree1) (word ++ Streams.const X)); intuition.
-rewrite <- H3, H1; reflexivity.
-Qed.
-
-End Make.
diff --git a/cparser/MenhirLib/Tuples.v b/cparser/MenhirLib/Tuples.v
deleted file mode 100644
index 3fd2ec03..00000000
--- a/cparser/MenhirLib/Tuples.v
+++ /dev/null
@@ -1,49 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Import List.
-Require Import Coq.Program.Syntax.
-Require Import Equality.
-
-(** A curryfied function with multiple parameters **)
-Definition arrows_left: list Type -> Type -> Type :=
-  fold_left (fun A B => B -> A).
-
-(** A curryfied function with multiple parameters **)
-Definition arrows_right: Type -> list Type -> Type :=
-  fold_right (fun A B => A -> B).
-
-(** A tuple is a heterogeneous list. For convenience, we use pairs. **)
-Fixpoint tuple (types : list Type) : Type :=
-  match types with
-  | nil => unit
-  | t::q => prod t (tuple q)
-  end.
-
-Fixpoint uncurry {args:list Type} {res:Type}:
-  arrows_left args res -> tuple args -> res :=
-  match args return forall res, arrows_left args res -> tuple args -> res with
-    | [] => fun _ f _ => f
-    | t::q => fun res f p => let (d, t) := p in
-      (@uncurry q _ f t) d
-  end res.
-
-Lemma JMeq_eqrect:
-  forall (U:Type) (a b:U) (P:U -> Type) (x:P a) (e:a=b),
-    eq_rect a P x b e ~= x.
-Proof.
-destruct e.
-reflexivity.
-Qed.
diff --git a/cparser/MenhirLib/Validator_complete.v b/cparser/MenhirLib/Validator_complete.v
deleted file mode 100644
index a9823278..00000000
--- a/cparser/MenhirLib/Validator_complete.v
+++ /dev/null
@@ -1,542 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Automaton.
-Require Import Alphabet.
-Require Import List.
-Require Import Syntax.
-
-Module Make(Import A:Automaton.T).
-
-(** We instantiate some sets/map. **)
-Module TerminalComparableM <: ComparableM.
-  Definition t := terminal.
-  Instance tComparable : Comparable t := _.
-End TerminalComparableM.
-Module TerminalOrderedType := OrderedType_from_ComparableM TerminalComparableM.
-Module StateProdPosComparableM <: ComparableM.
-  Definition t := (state*production*nat)%type.
-  Instance tComparable : Comparable t := _.
-End StateProdPosComparableM.
-Module StateProdPosOrderedType :=
-  OrderedType_from_ComparableM StateProdPosComparableM.
-
-Module TerminalSet := FSetAVL.Make TerminalOrderedType.
-Module StateProdPosMap := FMapAVL.Make StateProdPosOrderedType.
-
-(** Nullable predicate for symbols and list of symbols. **)
-Definition nullable_symb (symbol:symbol) :=
-  match symbol with
-    | NT nt => nullable_nterm nt
-    | _ => false
-  end.
-
-Definition nullable_word (word:list symbol) :=
-  forallb nullable_symb word.
-
-(** First predicate for non terminal, symbols and list of symbols, given as FSets. **)
-Definition first_nterm_set (nterm:nonterminal) :=
-  fold_left (fun acc t => TerminalSet.add t acc)
-    (first_nterm nterm) TerminalSet.empty.
-
-Definition first_symb_set (symbol:symbol) :=
-  match symbol with
-    | NT nt => first_nterm_set nt
-    | T t => TerminalSet.singleton t
-  end.
-
-Fixpoint first_word_set (word:list symbol) :=
-  match word with
-    | [] => TerminalSet.empty
-    | t::q =>
-      if nullable_symb t then
-        TerminalSet.union (first_symb_set t) (first_word_set q)
-        else
-          first_symb_set t
-  end.
-
-(** Small helper for finding the part of an item that is after the dot. **)
-Definition future_of_prod prod dot_pos : list symbol :=
-  (fix loop n lst :=
-    match n with
-      | O => lst
-      | S x => match loop x lst with [] => [] | _::q => q end
-    end)
-  dot_pos (rev' (prod_rhs_rev prod)).
-
-(** We build a fast map to store all the items of all the states. **)
-Definition items_map (_:unit): StateProdPosMap.t TerminalSet.t :=
-  fold_left (fun acc state =>
-    fold_left (fun acc item =>
-      let key := (state, prod_item item, dot_pos_item item) in
-        let data := fold_left (fun acc t => TerminalSet.add t acc)
-          (lookaheads_item item) TerminalSet.empty
-        in
-        let old :=
-          match StateProdPosMap.find key acc with
-            | Some x => x | None => TerminalSet.empty
-          end
-        in
-        StateProdPosMap.add key (TerminalSet.union data old) acc
-    ) (items_of_state state) acc
-  ) all_list (StateProdPosMap.empty TerminalSet.t).
-
-(** Accessor. **)
-Definition find_items_map items_map state prod dot_pos : TerminalSet.t :=
-  match StateProdPosMap.find (state, prod, dot_pos) items_map with
-    | None => TerminalSet.empty
-    | Some x => x
-  end.
-
-Definition state_has_future state prod (fut:list symbol) (lookahead:terminal) :=
-  exists dot_pos:nat,
-    fut = future_of_prod prod dot_pos /\
-    TerminalSet.In lookahead (find_items_map (items_map ()) state prod dot_pos).
-
-(** Iterator over items. **)
-Definition forallb_items items_map (P:state -> production -> nat -> TerminalSet.t -> bool): bool:=
-  StateProdPosMap.fold (fun key set acc =>
-    match key with (st, p, pos) => (acc && P st p pos set)%bool end
-  ) items_map true.
-
-Lemma forallb_items_spec :
-  forall p, forallb_items (items_map ()) p = true ->
-  forall st prod fut lookahead, state_has_future st prod fut lookahead ->
-  forall P:state -> production -> list symbol -> terminal -> Prop,
-  (forall st prod pos set lookahead,
-    TerminalSet.In lookahead set -> p st prod pos set = true ->
-      P st prod (future_of_prod prod pos) lookahead) ->
-   P st prod fut lookahead.
-Proof.
-intros.
-unfold forallb_items in H.
-rewrite StateProdPosMap.fold_1 in H.
-destruct H0; destruct H0.
-specialize (H1 st prod x _ _ H2).
-destruct H0.
-apply H1.
-unfold find_items_map in *.
-pose proof (@StateProdPosMap.find_2 _ (items_map ()) (st, prod, x)).
-destruct (StateProdPosMap.find (st, prod, x) (items_map ())); [ |destruct (TerminalSet.empty_1 H2)].
-specialize (H0 _ (eq_refl _)).
-pose proof (StateProdPosMap.elements_1 H0).
-revert H.
-generalize true at 1.
-induction H3.
-destruct H.
-destruct y.
-simpl in H3; destruct H3.
-pose proof (compare_eq (st, prod, x) k H).
-destruct H3.
-simpl.
-generalize (p st prod x t).
-induction l; simpl; intros.
-rewrite Bool.andb_true_iff in H3.
-intuition.
-destruct a; destruct k; destruct p0.
-simpl in H3.
-replace (b0 && b && p s p0 n t0)%bool with (b0 && p s p0 n t0 && b)%bool in H3.
-apply (IHl _ _ H3).
-destruct b, b0, (p s p0 n t0); reflexivity.
-intro.
-apply IHInA.
-Qed.
-
-(** * Validation for completeness **)
-
-(** The nullable predicate is a fixpoint : it is correct. **)
-Definition nullable_stable:=
-  forall p:production,
-    nullable_word (rev (prod_rhs_rev p)) = true ->
-    nullable_nterm (prod_lhs p) = true.
-
-Definition is_nullable_stable (_:unit) :=
-  forallb (fun p:production =>
-    implb (nullable_word (rev' (prod_rhs_rev p))) (nullable_nterm (prod_lhs p)))
-    all_list.
-
-Property is_nullable_stable_correct :
-  is_nullable_stable () = true -> nullable_stable.
-Proof.
-unfold is_nullable_stable, nullable_stable.
-intros.
-rewrite forallb_forall in H.
-specialize (H p (all_list_forall p)).
-unfold rev' in H; rewrite <- rev_alt in H.
-rewrite H0 in H; intuition.
-Qed.
-
-(** The first predicate is a fixpoint : it is correct. **)
-Definition first_stable:=
-  forall (p:production),
-    TerminalSet.Subset (first_word_set (rev (prod_rhs_rev p)))
-                       (first_nterm_set (prod_lhs p)).
-
-Definition is_first_stable (_:unit) :=
-  forallb (fun p:production =>
-    TerminalSet.subset (first_word_set (rev' (prod_rhs_rev p)))
-                       (first_nterm_set (prod_lhs p)))
-    all_list.
-
-Property is_first_stable_correct :
-  is_first_stable () = true -> first_stable.
-Proof.
-unfold is_first_stable, first_stable.
-intros.
-rewrite forallb_forall in H.
-specialize (H p (all_list_forall p)).
-unfold rev' in H; rewrite <- rev_alt in H.
-apply TerminalSet.subset_2; intuition.
-Qed.
-
-(** The initial state has all the S=>.u items, where S is the start non-terminal **)
-Definition start_future :=
-  forall (init:initstate) (t:terminal) (p:production),
-    prod_lhs p = start_nt init ->
-    state_has_future init p (rev (prod_rhs_rev p)) t.
-
-Definition is_start_future items_map :=
-  forallb (fun init =>
-    forallb (fun prod =>
-      if compare_eqb (prod_lhs prod) (start_nt init) then
-        let lookaheads := find_items_map items_map init prod 0 in
-          forallb (fun t => TerminalSet.mem t lookaheads) all_list
-        else
-          true) all_list) all_list.
-
-Property is_start_future_correct :
-  is_start_future (items_map ()) = true -> start_future.
-Proof.
-unfold is_start_future, start_future.
-intros.
-rewrite forallb_forall in H.
-specialize (H init (all_list_forall _)).
-rewrite forallb_forall in H.
-specialize (H p (all_list_forall _)).
-rewrite <- compare_eqb_iff in H0.
-rewrite H0 in H.
-rewrite forallb_forall in H.
-specialize (H t (all_list_forall _)).
-exists 0.
-split.
-apply rev_alt.
-apply TerminalSet.mem_2; eauto.
-Qed.
-
-(** If a state contains an item of the form A->_.av[[b]], where a is a
-    terminal, then reading an a does a [Shift_act], to a state containing
-    an item of the form A->_.v[[b]]. **)
-Definition terminal_shift :=
-  forall (s1:state) prod fut lookahead,
-    state_has_future s1 prod fut lookahead ->
-    match fut with
-      | T t::q =>
-        match action_table s1 with
-          | Lookahead_act awp =>
-            match awp t with
-              | Shift_act s2 _ =>
-                state_has_future s2 prod q lookahead
-              | _ => False
-            end
-          | _ => False
-        end
-      | _ => True
-    end.
-
-Definition is_terminal_shift items_map :=
-  forallb_items items_map (fun s1 prod pos lset =>
-    match future_of_prod prod pos with
-      | T t::_ =>
-        match action_table s1 with
-          | Lookahead_act awp =>
-            match awp t with
-              | Shift_act s2 _ =>
-                TerminalSet.subset lset (find_items_map items_map s2 prod (S pos))
-              | _ => false
-            end
-          | _ => false
-        end
-      | _ => true
-    end).
-
-Property is_terminal_shift_correct :
-  is_terminal_shift (items_map ()) = true -> terminal_shift.
-Proof.
-unfold is_terminal_shift, terminal_shift.
-intros.
-apply (forallb_items_spec _ H _ _ _ _ H0 (fun _ _ fut look => _)).
-intros.
-destruct (future_of_prod prod0 pos) as [|[]] eqn:?; intuition.
-destruct (action_table st); intuition.
-destruct (l0 t); intuition.
-exists (S pos).
-split.
-unfold future_of_prod in *.
-rewrite Heql; reflexivity.
-apply (TerminalSet.subset_2 H2); intuition.
-Qed.
-
-(** If a state contains an item of the form A->_.[[a]], then either we do a
-    [Default_reduce_act] of the corresponding production, either a is a
-    terminal (ie. there is a lookahead terminal), and reading a does a
-    [Reduce_act] of the corresponding production. **)
-Definition end_reduce :=
-  forall (s:state) prod fut lookahead,
-    state_has_future s prod fut lookahead ->
-    fut = [] ->
-    match action_table s with
-      | Default_reduce_act p => p = prod
-      | Lookahead_act awt =>
-        match awt lookahead with
-          | Reduce_act p => p = prod
-          | _ => False
-        end
-    end.
-
-Definition is_end_reduce items_map :=
-  forallb_items items_map (fun s prod pos lset =>
-    match future_of_prod prod pos with
-      | [] =>
-        match action_table s with
-          | Default_reduce_act p => compare_eqb p prod
-          | Lookahead_act awt =>
-            TerminalSet.fold (fun lookahead acc =>
-              match awt lookahead with
-                | Reduce_act p => (acc && compare_eqb p prod)%bool
-                | _ => false
-              end) lset true
-        end
-        | _ => true
-      end).
-
-Property is_end_reduce_correct :
-  is_end_reduce (items_map ()) = true -> end_reduce.
-Proof.
-unfold is_end_reduce, end_reduce.
-intros.
-revert H1.
-apply (forallb_items_spec _ H _ _ _ _ H0 (fun st prod fut look => _ ->
-                                            match action_table st with
-                                              | Default_reduce_act p => p = prod
-                                              | _ => _
-                                            end)).
-intros.
-rewrite H3 in H2.
-destruct (action_table st); intuition.
-apply compare_eqb_iff; intuition.
-rewrite TerminalSet.fold_1 in H2.
-revert H2.
-generalize true at 1.
-pose proof (TerminalSet.elements_1 H1).
-induction H2.
-pose proof (compare_eq _ _ H2).
-destruct H4.
-simpl.
-assert (fold_left
-     (fun (a : bool) (e : TerminalSet.elt) =>
-       match l e with
-         | Shift_act _ _ => false
-         | Reduce_act p => (a && compare_eqb p prod0)%bool
-         | Fail_act => false
-       end) l0 false = true -> False).
-induction l0; intuition.
-apply IHl0.
-simpl in H4.
-destruct (l a); intuition.
-destruct (l lookahead0); intuition.
-apply compare_eqb_iff.
-destruct (compare_eqb p prod0); intuition.
-destruct b; intuition.
-simpl; intros.
-eapply IHInA; eauto.
-Qed.
-
-(** If a state contains an item of the form A->_.Bv[[b]], where B is a
-    non terminal, then the goto table says we have to go to a state containing
-    an item of the form A->_.v[[b]]. **)
-Definition non_terminal_goto :=
-  forall (s1:state) prod fut lookahead,
-    state_has_future s1 prod fut lookahead ->
-    match fut with
-      | NT nt::q =>
-        match goto_table s1 nt with
-          | Some (exist _ s2 _) =>
-            state_has_future s2 prod q lookahead
-          | None =>
-            forall prod fut lookahead,
-            state_has_future s1 prod fut lookahead ->
-            match fut with
-              | NT nt'::_ => nt <> nt'
-              | _ => True
-            end
-        end
-      | _ => True
-    end.
-
-Definition is_non_terminal_goto items_map :=
-  forallb_items items_map (fun s1 prod pos lset =>
-    match future_of_prod prod pos with
-      | NT nt::_ =>
-        match goto_table s1 nt with
-          | Some (exist _ s2 _) =>
-            TerminalSet.subset lset (find_items_map items_map s2 prod (S pos))
-          | None => forallb_items items_map (fun s1' prod' pos' _ =>
-            (implb (compare_eqb s1 s1')
-            match future_of_prod prod' pos' with
-              | NT nt' :: _ => negb (compare_eqb nt nt')
-              | _ => true
-            end)%bool)
-        end
-      | _ => true
-    end).
-
-Property is_non_terminal_goto_correct :
-  is_non_terminal_goto (items_map ()) = true -> non_terminal_goto.
-Proof.
-unfold is_non_terminal_goto, non_terminal_goto.
-intros.
-apply (forallb_items_spec _ H _ _ _ _ H0 (fun st prod fut look =>
-                                            match fut with
-                                              | NT nt :: q =>
-                                                match goto_table st nt with
-                                                  | Some _ => _
-                                                  | None =>
-                                                    forall p f l, state_has_future st p f l -> (_:Prop)
-                                                end
-                                              | _ => _
-                                            end)).
-intros.
-destruct (future_of_prod prod0 pos) as [|[]] eqn:?; intuition.
-destruct (goto_table st n) as [[]|].
-exists (S pos).
-split.
-unfold future_of_prod in *.
-rewrite Heql; reflexivity.
-apply (TerminalSet.subset_2 H2); intuition.
-intros.
-remember st in H2; revert Heqs.
-apply (forallb_items_spec _ H2 _ _ _ _ H3 (fun st' prod fut look => s = st' -> match fut return Prop with [] => _ | _ => _ end)); intros.
-rewrite <- compare_eqb_iff in H6; rewrite H6 in H5.
-destruct (future_of_prod prod1 pos0) as [|[]]; intuition.
-rewrite <- compare_eqb_iff in H7; rewrite H7 in H5.
-discriminate.
-Qed.
-
-Definition start_goto :=
-  forall (init:initstate), goto_table init (start_nt init) = None.
-
-Definition is_start_goto (_:unit) :=
-  forallb (fun (init:initstate) =>
-    match goto_table init (start_nt init) with
-      | Some _ => false
-      | None => true
-    end) all_list.
-
-Definition is_start_goto_correct:
-  is_start_goto () = true -> start_goto.
-Proof.
-unfold is_start_goto, start_goto.
-rewrite forallb_forall.
-intros.
-specialize (H init (all_list_forall _)).
-destruct (goto_table init (start_nt init)); congruence.
-Qed.
-
-(** Closure property of item sets : if a state contains an item of the form
-    A->_.Bv[[b]], then for each production B->u and each terminal a of
-    first(vb), the state contains an item of the form B->_.u[[a]] **)
-Definition non_terminal_closed :=
-  forall (s1:state) prod fut lookahead,
-    state_has_future s1 prod fut lookahead ->
-    match fut with
-      | NT nt::q =>
-        forall (p:production) (lookahead2:terminal),
-          prod_lhs p = nt ->
-          TerminalSet.In lookahead2 (first_word_set q) \/
-          lookahead2 = lookahead /\ nullable_word q = true ->
-            state_has_future s1 p (rev (prod_rhs_rev p)) lookahead2
-      | _ => True
-    end.
-
-Definition is_non_terminal_closed items_map :=
-  forallb_items items_map (fun s1 prod pos lset =>
-    match future_of_prod prod pos with
-        | NT nt::q =>
-          forallb (fun p =>
-            if compare_eqb (prod_lhs p) nt then
-              let lookaheads := find_items_map items_map s1 p 0 in
-              (implb (nullable_word q) (TerminalSet.subset lset lookaheads)) &&
-              TerminalSet.subset (first_word_set q) lookaheads
-            else true
-          )%bool all_list
-        | _ => true
-    end).
-
-Property is_non_terminal_closed_correct:
-  is_non_terminal_closed (items_map ()) = true -> non_terminal_closed.
-Proof.
-unfold is_non_terminal_closed, non_terminal_closed.
-intros.
-apply (forallb_items_spec _ H _ _ _ _ H0 (fun st prod fut look =>
-                                            match fut with
-                                              | NT nt :: q => forall p l, _ -> _ -> state_has_future st _ _ _
-                                              | _ => _
-                                            end)).
-intros.
-destruct (future_of_prod prod0 pos); intuition.
-destruct s; eauto; intros.
-rewrite forallb_forall in H2.
-specialize (H2 p (all_list_forall p)).
-rewrite <- compare_eqb_iff in H3.
-rewrite H3 in H2.
-rewrite Bool.andb_true_iff in H2.
-destruct H2.
-exists 0.
-split.
-apply rev_alt.
-destruct H4 as [|[]]; subst.
-apply (TerminalSet.subset_2 H5); intuition.
-rewrite H6 in H2.
-apply (TerminalSet.subset_2 H2); intuition.
-Qed.
-
-(** The automaton is complete **)
-Definition complete :=
-  nullable_stable /\ first_stable /\ start_future /\ terminal_shift
-  /\ end_reduce /\ non_terminal_goto /\ start_goto /\ non_terminal_closed.
-
-Definition is_complete (_:unit) :=
-  let items_map := items_map () in
-  (is_nullable_stable () && is_first_stable () && is_start_future items_map &&
-    is_terminal_shift items_map && is_end_reduce items_map && is_start_goto () &&
-    is_non_terminal_goto items_map && is_non_terminal_closed items_map)%bool.
-
-Property is_complete_correct:
-  is_complete () = true -> complete.
-Proof.
-unfold is_complete, complete.
-repeat rewrite Bool.andb_true_iff.
-intuition.
-apply is_nullable_stable_correct; assumption.
-apply is_first_stable_correct; assumption.
-apply is_start_future_correct; assumption.
-apply is_terminal_shift_correct; assumption.
-apply is_end_reduce_correct; assumption.
-apply is_non_terminal_goto_correct; assumption.
-apply is_start_goto_correct; assumption.
-apply is_non_terminal_closed_correct; assumption.
-Qed.
-
-End Make.
diff --git a/cparser/MenhirLib/Validator_safe.v b/cparser/MenhirLib/Validator_safe.v
deleted file mode 100644
index 183d661b..00000000
--- a/cparser/MenhirLib/Validator_safe.v
+++ /dev/null
@@ -1,414 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Jacques-Henri Jourdan, 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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-Require Automaton.
-Require Import Alphabet.
-Require Import List.
-Require Import Syntax.
-
-Module Make(Import A:Automaton.T).
-
-(** The singleton predicate for states **)
-Definition singleton_state_pred (state:state) :=
-  (fun state' => match compare state state' with Eq => true |_ => false end).
-
-(** [past_state_of_non_init_state], extended for all states. **)
-Definition past_state_of_state (state:state) :=
-  match state with
-    | Init _ => []
-    | Ninit nis => past_state_of_non_init_state nis
-  end.
-
-(** Concatenations of last and past **)
-Definition head_symbs_of_state (state:state) :=
-  match state with
-    | Init _ => []
-    | Ninit s =>
-      last_symb_of_non_init_state s::past_symb_of_non_init_state s
-  end.
-Definition head_states_of_state (state:state) :=
-  singleton_state_pred state::past_state_of_state state.
-
-(** * Validation for correctness **)
-
-(** Prefix predicate between two lists of symbols. **)
-Inductive prefix: list symbol -> list symbol -> Prop :=
-  | prefix_nil: forall l, prefix [] l
-  | prefix_cons: forall l1 l2 x, prefix l1 l2 -> prefix (x::l1) (x::l2).
-
-Fixpoint is_prefix (l1 l2:list symbol):=
-  match l1, l2 with
-    | [], _ => true
-    | t1::q1, t2::q2 => (compare_eqb t1 t2 && is_prefix q1 q2)%bool
-    | _::_, [] => false
-  end.
-
-Property is_prefix_correct (l1 l2:list symbol):
-  is_prefix l1 l2 = true -> prefix l1 l2.
-Proof.
-revert l2.
-induction l1; intros.
-apply prefix_nil.
-unfold is_prefix in H.
-destruct l2; intuition; try discriminate.
-rewrite Bool.andb_true_iff in H.
-destruct H.
-rewrite compare_eqb_iff in H.
-destruct H.
-apply prefix_cons.
-apply IHl1; intuition.
-Qed.
-
-(** If we shift, then the known top symbols of the destination state is
-    a prefix of the known top symbols of the source state, with the new
-    symbol added. **)
-Definition shift_head_symbs :=
-  forall s,
-    match action_table s with
-      | Lookahead_act awp =>
-        forall t, match awp t with
-          | Shift_act s2 _ =>
-            prefix (past_symb_of_non_init_state s2) (head_symbs_of_state s)
-          | _ => True
-        end
-      | _ => True
-    end.
-
-Definition is_shift_head_symbs (_:unit) :=
-  forallb (fun s:state =>
-    match action_table s with
-      | Lookahead_act awp =>
-        forallb (fun t =>
-          match awp t with
-            | Shift_act s2 _ =>
-              is_prefix (past_symb_of_non_init_state s2) (head_symbs_of_state s)
-            | _ => true
-          end)
-          all_list
-      | _ => true
-    end)
-    all_list.
-
-Property is_shift_head_symbs_correct:
-  is_shift_head_symbs () = true -> shift_head_symbs.
-Proof.
-unfold is_shift_head_symbs, shift_head_symbs.
-intros.
-rewrite forallb_forall in H.
-specialize (H s (all_list_forall s)).
-destruct (action_table s); intuition.
-rewrite forallb_forall in H.
-specialize (H t (all_list_forall t)).
-destruct (l t); intuition.
-apply is_prefix_correct; intuition.
-Qed.
-
-(** When a goto happens, then the known top symbols of the destination state
-    is a prefix of the known top symbols of the source state, with the new
-    symbol added. **)
-Definition goto_head_symbs :=
-  forall s nt,
-    match goto_table s nt with
-      | Some (exist _ s2 _) =>
-        prefix (past_symb_of_non_init_state s2) (head_symbs_of_state s)
-      | None => True
-    end.
-
-Definition is_goto_head_symbs (_:unit) :=
-  forallb (fun s:state =>
-    forallb (fun nt =>
-      match goto_table s nt with
-        | Some (exist _ s2 _) =>
-          is_prefix (past_symb_of_non_init_state s2) (head_symbs_of_state s)
-        | None => true
-      end)
-      all_list)
-    all_list.
-
-Property is_goto_head_symbs_correct:
-  is_goto_head_symbs () = true -> goto_head_symbs.
-Proof.
-unfold is_goto_head_symbs, goto_head_symbs.
-intros.
-rewrite forallb_forall in H.
-specialize (H s (all_list_forall s)).
-rewrite forallb_forall in H.
-specialize (H nt (all_list_forall nt)).
-destruct (goto_table s nt); intuition.
-destruct s0.
-apply is_prefix_correct; intuition.
-Qed.
-
-(** We have to say the same kind of checks for the assumptions about the
-    states stack. However, theses assumptions are predicates. So we define
-    a notion of "prefix" over predicates lists, that means, basically, that
-    an assumption entails another **)
-Inductive prefix_pred: list (state->bool) -> list (state->bool) -> Prop :=
-  | prefix_pred_nil: forall l, prefix_pred [] l
-  | prefix_pred_cons: forall l1 l2 f1 f2,
-     (forall x, implb (f2 x) (f1 x) = true) ->
-     prefix_pred l1 l2 -> prefix_pred (f1::l1) (f2::l2).
-
-Fixpoint is_prefix_pred (l1 l2:list (state->bool)) :=
-  match l1, l2 with
-    | [], _ => true
-    | f1::q1, f2::q2 =>
-      (forallb (fun x => implb (f2 x) (f1 x)) all_list
-        && is_prefix_pred q1 q2)%bool
-    | _::_, [] => false
-  end.
-
-Property is_prefix_pred_correct (l1 l2:list (state->bool)) :
-  is_prefix_pred l1 l2 = true -> prefix_pred l1 l2.
-Proof.
-revert l2.
-induction l1.
-intros.
-apply prefix_pred_nil.
-intros.
-destruct l2; intuition; try discriminate.
-unfold is_prefix_pred in H.
-rewrite Bool.andb_true_iff in H.
-rewrite forallb_forall in H.
-apply prefix_pred_cons; intuition.
-apply H0.
-apply all_list_forall.
-Qed.
-
-(** The assumptions about state stack is conserved when we shift **)
-Definition shift_past_state :=
-  forall s,
-    match action_table s with
-      | Lookahead_act awp =>
-        forall t, match awp t with
-          | Shift_act s2 _ =>
-            prefix_pred (past_state_of_non_init_state s2)
-                        (head_states_of_state s)
-          | _ => True
-        end
-      | _ => True
-    end.
-
-Definition is_shift_past_state (_:unit) :=
-  forallb (fun s:state =>
-    match action_table s with
-      | Lookahead_act awp =>
-        forallb (fun t =>
-          match awp t with
-            | Shift_act s2 _ =>
-              is_prefix_pred
-                (past_state_of_non_init_state s2) (head_states_of_state s)
-            | _ => true
-          end)
-          all_list
-      | _ => true
-    end)
-    all_list.
-
-Property is_shift_past_state_correct:
- is_shift_past_state () = true -> shift_past_state.
-Proof.
-unfold is_shift_past_state, shift_past_state.
-intros.
-rewrite forallb_forall in H.
-specialize (H s (all_list_forall s)).
-destruct (action_table s); intuition.
-rewrite forallb_forall in H.
-specialize (H t (all_list_forall t)).
-destruct (l t); intuition.
-apply is_prefix_pred_correct; intuition.
-Qed.
-
-(** The assumptions about state stack is conserved when we do a goto **)
-Definition goto_past_state :=
-  forall s nt,
-    match goto_table s nt with
-      | Some (exist _ s2 _) =>
-        prefix_pred (past_state_of_non_init_state s2)
-                    (head_states_of_state s)
-      | None => True
-    end.
-
-Definition is_goto_past_state (_:unit) :=
-  forallb (fun s:state =>
-    forallb (fun nt =>
-      match goto_table s nt with
-        | Some (exist _ s2 _) =>
-          is_prefix_pred
-            (past_state_of_non_init_state s2) (head_states_of_state s)
-        | None => true
-      end)
-      all_list)
-    all_list.
-
-Property is_goto_past_state_correct :
-  is_goto_past_state () = true -> goto_past_state.
-Proof.
-unfold is_goto_past_state, goto_past_state.
-intros.
-rewrite forallb_forall in H.
-specialize (H s (all_list_forall s)).
-rewrite forallb_forall in H.
-specialize (H nt (all_list_forall nt)).
-destruct (goto_table s nt); intuition.
-destruct s0.
-apply is_prefix_pred_correct; intuition.
-Qed.
-
-(** What states are possible after having popped these symbols from the
-    stack, given the annotation of the current state ? **)
-Inductive state_valid_after_pop (s:state):
-  list symbol -> list (state -> bool) -> Prop :=
-  | state_valid_after_pop_nil1:
-    forall p pl, p s = true -> state_valid_after_pop s [] (p::pl)
-  | state_valid_after_pop_nil2:
-    forall sl, state_valid_after_pop s sl []
-  | state_valid_after_pop_cons:
-    forall st sq p pl, state_valid_after_pop s sq pl ->
-      state_valid_after_pop s (st::sq) (p::pl).
-
-Fixpoint is_state_valid_after_pop
-  (state:state) (to_pop:list symbol) annot :=
-  match annot, to_pop with
-    | [], _ => true
-    | p::_, [] => p state
-    | p::pl, s::sl => is_state_valid_after_pop state sl pl
-  end.
-
-Property is_state_valid_after_pop_complete state sl pl :
-  state_valid_after_pop state sl pl -> is_state_valid_after_pop state sl pl = true.
-Proof.
-intro.
-induction H; intuition.
-destruct sl; intuition.
-Qed.
-
-(** A state is valid for reducing a production when :
-      - The assumptions on the state are such that we will find the right hand
-        side of the production on the stack.
-      - We will be able to do a goto after having popped the right hand side.
-**)
-Definition valid_for_reduce (state:state) prod :=
-    prefix (prod_rhs_rev prod) (head_symbs_of_state state) /\
-    forall state_new,
-    state_valid_after_pop state_new
-      (prod_rhs_rev prod) (head_states_of_state state) ->
-    goto_table state_new (prod_lhs prod) = None ->
-    match state_new with
-      | Init i => prod_lhs prod = start_nt i
-      | Ninit _ => False
-    end.
-
-Definition is_valid_for_reduce (state:state) prod:=
-  (is_prefix (prod_rhs_rev prod) (head_symbs_of_state state) &&
-   forallb (fun state_new =>
-     if is_state_valid_after_pop state_new (prod_rhs_rev prod)
-                                           (head_states_of_state state) then
-       match goto_table state_new (prod_lhs prod) with
-         | Some _ => true
-         | None =>
-           match state_new with
-             | Init i => compare_eqb (prod_lhs prod) (start_nt i)
-             | Ninit _ => false
-           end
-       end
-     else
-       true)
-     all_list)%bool.
-
-Property is_valid_for_reduce_correct (state:state) prod:
-  is_valid_for_reduce state prod = true -> valid_for_reduce state prod.
-Proof.
-unfold is_valid_for_reduce, valid_for_reduce.
-intros.
-rewrite Bool.andb_true_iff in H.
-split.
-apply is_prefix_correct.
-intuition.
-intros.
-rewrite forallb_forall in H.
-destruct H.
-specialize (H2 state_new (all_list_forall state_new)).
-rewrite is_state_valid_after_pop_complete, H1 in H2.
-destruct state_new; intuition.
-rewrite compare_eqb_iff in H2; intuition.
-intuition.
-Qed.
-
-(** All the states that does a reduce are valid for reduction **)
-Definition reduce_ok :=
-  forall s,
-    match action_table s with
-      | Lookahead_act awp =>
-        forall t, match awp t with
-          | Reduce_act p => valid_for_reduce s p
-          | _ => True
-        end
-      | Default_reduce_act p => valid_for_reduce s p
-    end.
-
-Definition is_reduce_ok (_:unit) :=
-  forallb (fun s =>
-    match action_table s with
-      | Lookahead_act awp =>
-        forallb (fun t =>
-          match awp t with
-            | Reduce_act p => is_valid_for_reduce s p
-            | _ => true
-          end)
-          all_list
-      | Default_reduce_act p => is_valid_for_reduce s p
-    end)
-    all_list.
-
-Property is_reduce_ok_correct :
-  is_reduce_ok () = true -> reduce_ok.
-Proof.
-unfold is_reduce_ok, reduce_ok.
-intros.
-rewrite forallb_forall in H.
-specialize (H s (all_list_forall s)).
-destruct (action_table s).
-apply is_valid_for_reduce_correct; intuition.
-intro.
-rewrite forallb_forall in H.
-specialize (H t (all_list_forall t)).
-destruct (l t); intuition.
-apply is_valid_for_reduce_correct; intuition.
-Qed.
-
-(** The automaton is safe **)
-Definition safe :=
-  shift_head_symbs /\ goto_head_symbs /\ shift_past_state /\
-  goto_past_state /\ reduce_ok.
-
-Definition is_safe (_:unit) :=
-  (is_shift_head_symbs () && is_goto_head_symbs () && is_shift_past_state () &&
-    is_goto_past_state () && is_reduce_ok ())%bool.
-
-Property is_safe_correct:
-  is_safe () = true -> safe.
-Proof.
-unfold safe, is_safe.
-repeat rewrite Bool.andb_true_iff.
-intuition.
-apply is_shift_head_symbs_correct; assumption.
-apply is_goto_head_symbs_correct; assumption.
-apply is_shift_past_state_correct; assumption.
-apply is_goto_past_state_correct; assumption.
-apply is_reduce_ok_correct; assumption.
-Qed.
-
-End Make.
diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml
index 3c27f3a9..4c70c7ae 100644
--- a/cparser/PackedStructs.ml
+++ b/cparser/PackedStructs.ml
@@ -418,4 +418,4 @@ let program p =
     | _ -> false
     end;
   Hashtbl.clear byteswapped_fields;
-  transf_globdecls (Builtins.environment()) [] p
+  transf_globdecls (Env.initial()) [] p
diff --git a/cparser/Parse.ml b/cparser/Parse.ml
index 154e3dcf..29245083 100644
--- a/cparser/Parse.ml
+++ b/cparser/Parse.ml
@@ -56,22 +56,21 @@ let preprocessed_file transfs name sourcefile =
   let text = read_file sourcefile in
   let p =
       let t = parse_transformations transfs in
-      let rec inf = Datatypes.S inf in
+      let log_fuel = Camlcoq.Nat.of_int 50 in
       let ast : Cabs.definition list =
-        Obj.magic
           (match Timing.time "Parsing"
               (* The call to Lexer.tokens_stream results in the pre
                  parsing of the entire file. This is non-negligeabe,
                  so we cannot use Timing.time2 *)
               (fun () ->
-                Parser.translation_unit_file inf (Lexer.tokens_stream name text)) ()
+                Parser.translation_unit_file log_fuel (Lexer.tokens_stream name text)) ()
            with
-             | Parser.Parser.Inter.Fail_pr ->
+           | Parser.MenhirLibParser.Inter.Fail_pr ->
                  (* Theoretically impossible : implies inconsistencies
                     between grammars. *)
-               Diagnostics.fatal_error Diagnostics.no_loc "internal error while parsing"
-             | Parser.Parser.Inter.Timeout_pr -> assert false
-             | Parser.Parser.Inter.Parsed_pr (ast, _ ) -> ast) in
+              Diagnostics.fatal_error Diagnostics.no_loc "internal error while parsing"
+           | Parser.MenhirLibParser.Inter.Timeout_pr -> assert false
+           | Parser.MenhirLibParser.Inter.Parsed_pr (ast, _ ) -> ast) in
       let p1 = Timing.time "Elaboration" Elab.elab_file ast in
       Diagnostics.check_errors ();
       Timing.time2 "Emulations" transform_program t p1 name in
diff --git a/cparser/Parser.vy b/cparser/Parser.vy
index 79e3793d..03bfa590 100644
--- a/cparser/Parser.vy
+++ b/cparser/Parser.vy
@@ -15,96 +15,99 @@
 
 %{
 
-Require Import Cabs.
 Require Import List.
+Require Cabs.
 
 %}
 
-%token<string * cabsloc> VAR_NAME TYPEDEF_NAME OTHER_NAME
-%token<string * cabsloc> PRAGMA
-%token<bool * list char_code * cabsloc> STRING_LITERAL
-%token<constant * cabsloc> CONSTANT
-%token<cabsloc> SIZEOF PTR INC DEC LEFT RIGHT LEQ GEQ EQEQ EQ NEQ LT GT
+%token<Cabs.string * Cabs.loc> VAR_NAME TYPEDEF_NAME OTHER_NAME
+%token<Cabs.string * Cabs.loc> PRAGMA
+%token<bool * list Cabs.char_code * Cabs.loc> STRING_LITERAL
+%token<Cabs.constant * Cabs.loc> CONSTANT
+%token<Cabs.loc> SIZEOF PTR INC DEC LEFT RIGHT LEQ GEQ EQEQ EQ NEQ LT GT
   ANDAND BARBAR PLUS MINUS STAR TILDE BANG SLASH PERCENT HAT BAR QUESTION
   COLON AND ALIGNOF
 
-%token<cabsloc> MUL_ASSIGN DIV_ASSIGN MOD_ASSIGN ADD_ASSIGN SUB_ASSIGN
+%token<Cabs.loc> MUL_ASSIGN DIV_ASSIGN MOD_ASSIGN ADD_ASSIGN SUB_ASSIGN
   LEFT_ASSIGN RIGHT_ASSIGN AND_ASSIGN XOR_ASSIGN OR_ASSIGN
 
-%token<cabsloc> LPAREN RPAREN LBRACK RBRACK LBRACE RBRACE DOT COMMA
-  SEMICOLON ELLIPSIS TYPEDEF EXTERN STATIC RESTRICT AUTO REGISTER INLINE NORETURN
-  CHAR SHORT INT LONG SIGNED UNSIGNED FLOAT DOUBLE CONST VOLATILE VOID
+%token<Cabs.loc> LPAREN RPAREN LBRACK RBRACK LBRACE RBRACE DOT COMMA
+  SEMICOLON ELLIPSIS TYPEDEF EXTERN STATIC RESTRICT AUTO REGISTER INLINE
+  NORETURN CHAR SHORT INT LONG SIGNED UNSIGNED FLOAT DOUBLE CONST VOLATILE VOID
   STRUCT UNION ENUM UNDERSCORE_BOOL PACKED ALIGNAS ATTRIBUTE ASM
 
-%token<cabsloc> CASE DEFAULT IF ELSE SWITCH WHILE DO FOR GOTO CONTINUE BREAK
+%token<Cabs.loc> CASE DEFAULT IF_ ELSE SWITCH WHILE DO FOR GOTO CONTINUE BREAK
   RETURN BUILTIN_VA_ARG BUILTIN_OFFSETOF
 
 %token EOF
 
-%type<expression * cabsloc> primary_expression postfix_expression
+%type<Cabs.expression * Cabs.loc> primary_expression postfix_expression
   unary_expression cast_expression multiplicative_expression additive_expression
   shift_expression relational_expression equality_expression AND_expression
   exclusive_OR_expression inclusive_OR_expression logical_AND_expression
   logical_OR_expression conditional_expression assignment_expression
   constant_expression expression
-%type<unary_operator * cabsloc> unary_operator
-%type<binary_operator> assignment_operator
-%type<list expression (* Reverse order *)> argument_expression_list
-%type<definition> declaration
-%type<list spec_elem * cabsloc> declaration_specifiers
-%type<list spec_elem> declaration_specifiers_typespec_opt
-%type<list init_name (* Reverse order *)> init_declarator_list
-%type<init_name> init_declarator
-%type<storage * cabsloc> storage_class_specifier
-%type<typeSpecifier * cabsloc> type_specifier struct_or_union_specifier enum_specifier
-%type<structOrUnion * cabsloc> struct_or_union
-%type<list field_group (* Reverse order *)> struct_declaration_list
-%type<field_group> struct_declaration
-%type<list spec_elem * cabsloc> specifier_qualifier_list
-%type<list (option name * option expression) (* Reverse order *)> struct_declarator_list
-%type<option name * option expression> struct_declarator
-%type<list (string * option expression * cabsloc) (* Reverse order *)> enumerator_list
-%type<string * option expression * cabsloc> enumerator
-%type<string * cabsloc> enumeration_constant
-%type<cvspec * cabsloc> type_qualifier type_qualifier_noattr
-%type<funspec * cabsloc> function_specifier
-%type<name> declarator declarator_noattrend direct_declarator
-%type<(decl_type -> decl_type) * cabsloc> pointer
-%type<list cvspec (* Reverse order *)> type_qualifier_list
-%type<list parameter * bool> parameter_type_list
-%type<list parameter (* Reverse order *)> parameter_list
-%type<parameter> parameter_declaration
-%type<list spec_elem * decl_type> type_name
-%type<decl_type> abstract_declarator direct_abstract_declarator
-%type<init_expression> c_initializer
-%type<list (list initwhat * init_expression) (* Reverse order *)> initializer_list
-%type<list initwhat> designation
-%type<list initwhat (* Reverse order *)> designator_list
-%type<initwhat> designator
-%type<statement> statement_dangerous statement_safe
+%type<Cabs.unary_operator * Cabs.loc> unary_operator
+%type<Cabs.binary_operator> assignment_operator
+%type<list Cabs.expression (* Reverse order *)> argument_expression_list
+%type<Cabs.definition> declaration
+%type<list Cabs.spec_elem * Cabs.loc> declaration_specifiers
+%type<list Cabs.spec_elem> declaration_specifiers_typespec_opt
+%type<list Cabs.init_name (* Reverse order *)> init_declarator_list
+%type<Cabs.init_name> init_declarator
+%type<Cabs.storage * Cabs.loc> storage_class_specifier
+%type<Cabs.typeSpecifier * Cabs.loc> type_specifier struct_or_union_specifier enum_specifier
+%type<Cabs.structOrUnion * Cabs.loc> struct_or_union
+%type<list Cabs.field_group (* Reverse order *)> struct_declaration_list
+%type<Cabs.field_group> struct_declaration
+%type<list Cabs.spec_elem * Cabs.loc> specifier_qualifier_list
+%type<list (option Cabs.name * option Cabs.expression) (* Reverse order *)>
+  struct_declarator_list
+%type<option Cabs.name * option Cabs.expression> struct_declarator
+%type<list (Cabs.string * option Cabs.expression * Cabs.loc) (* Reverse order *)>
+  enumerator_list
+%type<Cabs.string * option Cabs.expression * Cabs.loc> enumerator
+%type<Cabs.string * Cabs.loc> enumeration_constant
+%type<Cabs.cvspec * Cabs.loc> type_qualifier type_qualifier_noattr
+%type<Cabs.funspec * Cabs.loc> function_specifier
+%type<Cabs.name> declarator declarator_noattrend direct_declarator
+%type<(Cabs.decl_type -> Cabs.decl_type) * Cabs.loc> pointer
+%type<list Cabs.cvspec (* Reverse order *)> type_qualifier_list
+%type<list Cabs.parameter * bool> parameter_type_list
+%type<list Cabs.parameter (* Reverse order *)> parameter_list
+%type<Cabs.parameter> parameter_declaration
+%type<list Cabs.spec_elem * Cabs.decl_type> type_name
+%type<Cabs.decl_type> abstract_declarator direct_abstract_declarator
+%type<Cabs.init_expression> c_initializer
+%type<list (list Cabs.initwhat * Cabs.init_expression) (* Reverse order *)>
+  initializer_list
+%type<list Cabs.initwhat> designation
+%type<list Cabs.initwhat (* Reverse order *)> designator_list
+%type<Cabs.initwhat> designator
+%type<Cabs.statement> statement_dangerous statement_safe
   labeled_statement(statement_safe) labeled_statement(statement_dangerous)
   iteration_statement(statement_safe) iteration_statement(statement_dangerous)
   compound_statement
-%type<list statement (* Reverse order *)> block_item_list
-%type<statement> block_item expression_statement selection_statement_dangerous
+%type<list Cabs.statement (* Reverse order *)> block_item_list
+%type<Cabs.statement> block_item expression_statement selection_statement_dangerous
   selection_statement_safe jump_statement asm_statement
-%type<list definition (* Reverse order *)> translation_unit
-%type<definition> external_declaration function_definition
-%type<list definition> declaration_list
-%type<attribute * cabsloc> attribute_specifier
-%type<list attribute> attribute_specifier_list
-%type<gcc_attribute> gcc_attribute
-%type<list gcc_attribute> gcc_attribute_list
-%type<gcc_attribute_word> gcc_attribute_word
-%type<list string (* Reverse order *)> identifier_list
-%type<list asm_flag> asm_flags
-%type<option string> asm_op_name
-%type<asm_operand> asm_operand
-%type<list asm_operand> asm_operands asm_operands_ne
-%type<list asm_operand * list asm_operand * list asm_flag> asm_arguments
-%type<list cvspec> asm_attributes
-
-%start<list definition> translation_unit_file
+%type<list Cabs.definition (* Reverse order *)> translation_unit
+%type<Cabs.definition> external_declaration function_definition
+%type<list Cabs.definition> declaration_list
+%type<Cabs.attribute * Cabs.loc> attribute_specifier
+%type<list Cabs.attribute> attribute_specifier_list
+%type<Cabs.gcc_attribute> gcc_attribute
+%type<list Cabs.gcc_attribute> gcc_attribute_list
+%type<Cabs.gcc_attribute_word> gcc_attribute_word
+%type<list Cabs.string (* Reverse order *)> identifier_list
+%type<list Cabs.asm_flag> asm_flags
+%type<option Cabs.string> asm_op_name
+%type<Cabs.asm_operand> asm_operand
+%type<list Cabs.asm_operand> asm_operands asm_operands_ne
+%type<list Cabs.asm_operand * list Cabs.asm_operand * list Cabs.asm_flag> asm_arguments
+%type<list Cabs.cvspec> asm_attributes
+
+%start<list Cabs.definition> translation_unit_file
 %%
 
 (* Actual grammar *)
@@ -112,12 +115,12 @@ Require Import List.
 (* 6.5.1 *)
 primary_expression:
 | var = VAR_NAME
-    { (VARIABLE (fst var), snd var) }
+    { (Cabs.VARIABLE (fst var), snd var) }
 | cst = CONSTANT
-    { (CONSTANT (fst cst), snd cst) }
+    { (Cabs.CONSTANT (fst cst), snd cst) }
 | str = STRING_LITERAL
     { let '((wide, chars), loc) := str in
-      (CONSTANT (CONST_STRING wide chars), loc) }
+      (Cabs.CONSTANT (Cabs.CONST_STRING wide chars), loc) }
 | loc = LPAREN expr = expression RPAREN
     { (fst expr, loc)}
 
@@ -126,29 +129,30 @@ postfix_expression:
 | expr = primary_expression
     { expr }
 | expr = postfix_expression LBRACK index = expression RBRACK
-    { (INDEX (fst expr) (fst index), snd expr) }
+    { (Cabs.INDEX (fst expr) (fst index), snd expr) }
 | expr = postfix_expression LPAREN args = argument_expression_list RPAREN
-    { (CALL (fst expr) (rev' args), snd expr) }
+    { (Cabs.CALL (fst expr) (rev' args), snd expr) }
 | expr = postfix_expression LPAREN RPAREN
-    { (CALL (fst expr) [], snd expr) }
+    { (Cabs.CALL (fst expr) [], snd expr) }
 | loc = BUILTIN_VA_ARG LPAREN expr = assignment_expression COMMA ty = type_name RPAREN
-    { (BUILTIN_VA_ARG (fst expr) ty, loc) }
+    { (Cabs.BUILTIN_VA_ARG (fst expr) ty, loc) }
 | expr = postfix_expression DOT mem = OTHER_NAME
-    { (MEMBEROF (fst expr) (fst mem), snd expr) }
+    { (Cabs.MEMBEROF (fst expr) (fst mem), snd expr) }
 | expr = postfix_expression PTR mem = OTHER_NAME
-    { (MEMBEROFPTR (fst expr) (fst mem), snd expr) }
+    { (Cabs.MEMBEROFPTR (fst expr) (fst mem), snd expr) }
 | expr = postfix_expression INC
-    { (UNARY POSINCR (fst expr), snd expr) }
+    { (Cabs.UNARY Cabs.POSINCR (fst expr), snd expr) }
 | expr = postfix_expression DEC
-    { (UNARY POSDECR (fst expr), snd expr) }
+    { (Cabs.UNARY Cabs.POSDECR (fst expr), snd expr) }
 | loc = LPAREN typ = type_name RPAREN LBRACE init = initializer_list RBRACE
-    { (CAST typ (COMPOUND_INIT (rev' init)), loc) }
+    { (Cabs.CAST typ (Cabs.COMPOUND_INIT (rev' init)), loc) }
 | loc = LPAREN typ = type_name RPAREN LBRACE init = initializer_list COMMA RBRACE
-    { (CAST typ (COMPOUND_INIT (rev' init)), loc) }
-| loc = BUILTIN_OFFSETOF LPAREN typ = type_name COMMA id = OTHER_NAME mems = designator_list RPAREN
-    { (BUILTIN_OFFSETOF typ ((INFIELD_INIT (fst id))::(rev mems)), loc) }
+    { (Cabs.CAST typ (Cabs.COMPOUND_INIT (rev' init)), loc) }
+| loc = BUILTIN_OFFSETOF LPAREN typ = type_name COMMA id = OTHER_NAME
+  mems = designator_list RPAREN
+    { (Cabs.BUILTIN_OFFSETOF typ ((Cabs.INFIELD_INIT (fst id))::(rev mems)), loc) }
 | loc = BUILTIN_OFFSETOF LPAREN typ = type_name COMMA mem = OTHER_NAME RPAREN
-    { (BUILTIN_OFFSETOF typ [INFIELD_INIT (fst mem)], loc) }
+    { (Cabs.BUILTIN_OFFSETOF typ [Cabs.INFIELD_INIT (fst mem)], loc) }
 
 (* Semantic value is in reverse order. *)
 argument_expression_list:
@@ -162,170 +166,171 @@ unary_expression:
 | expr = postfix_expression
     { expr }
 | loc = INC expr = unary_expression
-    { (UNARY PREINCR (fst expr), loc) }
+    { (Cabs.UNARY Cabs.PREINCR (fst expr), loc) }
 | loc = DEC expr = unary_expression
-    { (UNARY PREDECR (fst expr), loc) }
+    { (Cabs.UNARY Cabs.PREDECR (fst expr), loc) }
 | op = unary_operator expr = cast_expression
-    { (UNARY (fst op) (fst expr), snd op) }
+    { (Cabs.UNARY (fst op) (fst expr), snd op) }
 | loc = SIZEOF expr = unary_expression
-    { (EXPR_SIZEOF (fst expr), loc) }
+    { (Cabs.EXPR_SIZEOF (fst expr), loc) }
 | loc = SIZEOF LPAREN typ = type_name RPAREN
-    { (TYPE_SIZEOF typ, loc) }
+    { (Cabs.TYPE_SIZEOF typ, loc) }
 (* Non-standard *)
 | loc = ALIGNOF LPAREN typ = type_name RPAREN
-    { (ALIGNOF typ, loc) }
+    { (Cabs.ALIGNOF typ, loc) }
 
 unary_operator:
 | loc = AND
-    { (ADDROF, loc) }
+    { (Cabs.ADDROF, loc) }
 | loc = STAR
-    { (MEMOF, loc) }
+    { (Cabs.MEMOF, loc) }
 | loc = PLUS
-    { (PLUS, loc) }
+    { (Cabs.PLUS, loc) }
 | loc = MINUS
-    { (MINUS, loc) }
+    { (Cabs.MINUS, loc) }
 | loc = TILDE
-    { (BNOT, loc) }
+    { (Cabs.BNOT, loc) }
 | loc = BANG
-    { (NOT, loc) }
+    { (Cabs.NOT, loc) }
 
 (* 6.5.4 *)
 cast_expression:
 | expr = unary_expression
     { expr }
 | loc = LPAREN typ = type_name RPAREN expr = cast_expression
-    { (CAST typ (SINGLE_INIT (fst expr)), loc) }
+    { (Cabs.CAST typ (Cabs.SINGLE_INIT (fst expr)), loc) }
 
 (* 6.5.5 *)
 multiplicative_expression:
 | expr = cast_expression
     { expr }
 | expr1 = multiplicative_expression STAR expr2 = cast_expression
-    { (BINARY MUL (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.MUL (fst expr1) (fst expr2), snd expr1) }
 | expr1 = multiplicative_expression SLASH expr2 = cast_expression
-    { (BINARY DIV (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.DIV (fst expr1) (fst expr2), snd expr1) }
 | expr1 = multiplicative_expression PERCENT expr2 = cast_expression
-    { (BINARY MOD (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.MOD (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.6 *)
 additive_expression:
 | expr = multiplicative_expression
     { expr }
 | expr1 = additive_expression PLUS expr2 = multiplicative_expression
-    { (BINARY ADD (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.ADD (fst expr1) (fst expr2), snd expr1) }
 | expr1 = additive_expression MINUS expr2 = multiplicative_expression
-    { (BINARY SUB (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.SUB (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.7 *)
 shift_expression:
 | expr = additive_expression
     { expr }
 | expr1 = shift_expression LEFT expr2 = additive_expression
-    { (BINARY SHL (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.SHL (fst expr1) (fst expr2), snd expr1) }
 | expr1 = shift_expression RIGHT expr2 = additive_expression
-    { (BINARY SHR (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.SHR (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.8 *)
 relational_expression:
 | expr = shift_expression
     { expr }
 | expr1 = relational_expression LT expr2 = shift_expression
-    { (BINARY LT (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.LT (fst expr1) (fst expr2), snd expr1) }
 | expr1 = relational_expression GT expr2 = shift_expression
-    { (BINARY GT (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.GT (fst expr1) (fst expr2), snd expr1) }
 | expr1 = relational_expression LEQ expr2 = shift_expression
-    { (BINARY LE (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.LE (fst expr1) (fst expr2), snd expr1) }
 | expr1 = relational_expression GEQ expr2 = shift_expression
-    { (BINARY GE (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.GE (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.9 *)
 equality_expression:
 | expr = relational_expression
     { expr }
 | expr1 = equality_expression EQEQ expr2 = relational_expression
-    { (BINARY EQ (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.EQ (fst expr1) (fst expr2), snd expr1) }
 | expr1 = equality_expression NEQ expr2 = relational_expression
-    { (BINARY NE (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.NE (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.10 *)
 AND_expression:
 | expr = equality_expression
     { expr }
 | expr1 = AND_expression AND expr2 = equality_expression
-    { (BINARY BAND (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.BAND (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.11 *)
 exclusive_OR_expression:
 | expr = AND_expression
     { expr }
 | expr1 = exclusive_OR_expression HAT expr2 = AND_expression
-    { (BINARY XOR (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.XOR (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.12 *)
 inclusive_OR_expression:
 | expr = exclusive_OR_expression
     { expr }
 | expr1 = inclusive_OR_expression BAR expr2 = exclusive_OR_expression
-    { (BINARY BOR (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.BOR (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.13 *)
 logical_AND_expression:
 | expr = inclusive_OR_expression
     { expr }
 | expr1 = logical_AND_expression ANDAND expr2 = inclusive_OR_expression
-    { (BINARY AND (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.AND (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.14 *)
 logical_OR_expression:
 | expr = logical_AND_expression
     { expr }
 | expr1 = logical_OR_expression BARBAR expr2 = logical_AND_expression
-    { (BINARY OR (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.OR (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.5.15 *)
 conditional_expression:
 | expr = logical_OR_expression
     { expr }
-| expr1 = logical_OR_expression QUESTION expr2 = expression COLON expr3 = conditional_expression
-    { (QUESTION (fst expr1) (fst expr2) (fst expr3), snd expr1) }
+| expr1 = logical_OR_expression QUESTION expr2 = expression COLON
+  expr3 = conditional_expression
+    { (Cabs.QUESTION (fst expr1) (fst expr2) (fst expr3), snd expr1) }
 
 (* 6.5.16 *)
 assignment_expression:
 | expr = conditional_expression
     { expr }
 | expr1 = unary_expression op = assignment_operator expr2 = assignment_expression
-    { (BINARY op (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY op (fst expr1) (fst expr2), snd expr1) }
 
 assignment_operator:
 | EQ
-    { ASSIGN  }
+    { Cabs.ASSIGN  }
 | MUL_ASSIGN
-    { MUL_ASSIGN }
+    { Cabs.MUL_ASSIGN }
 | DIV_ASSIGN
-    { DIV_ASSIGN }
+    { Cabs.DIV_ASSIGN }
 | MOD_ASSIGN
-    { MOD_ASSIGN }
+    { Cabs.MOD_ASSIGN }
 | ADD_ASSIGN
-    { ADD_ASSIGN }
+    { Cabs.ADD_ASSIGN }
 | SUB_ASSIGN
-    { SUB_ASSIGN }
+    { Cabs.SUB_ASSIGN }
 | LEFT_ASSIGN
-    { SHL_ASSIGN }
+    { Cabs.SHL_ASSIGN }
 | RIGHT_ASSIGN
-    { SHR_ASSIGN }
+    { Cabs.SHR_ASSIGN }
 | XOR_ASSIGN
-    { XOR_ASSIGN }
+    { Cabs.XOR_ASSIGN }
 | OR_ASSIGN
-    { BOR_ASSIGN }
+    { Cabs.BOR_ASSIGN }
 | AND_ASSIGN
-    { BAND_ASSIGN }
+    { Cabs.BAND_ASSIGN }
 
 (* 6.5.17 *)
 expression:
 | expr = assignment_expression
     { expr }
 | expr1 = expression COMMA expr2 = assignment_expression
-    { (BINARY COMMA (fst expr1) (fst expr2), snd expr1) }
+    { (Cabs.BINARY Cabs.COMMA (fst expr1) (fst expr2), snd expr1) }
 
 (* 6.6 *)
 constant_expression:
@@ -335,19 +340,19 @@ constant_expression:
 (* 6.7 *)
 declaration:
 | decspec = declaration_specifiers decls = init_declarator_list SEMICOLON
-    { DECDEF (fst decspec, rev' decls) (snd decspec) }
+    { Cabs.DECDEF (fst decspec, rev' decls) (snd decspec) }
 | decspec = declaration_specifiers SEMICOLON
-    { DECDEF (fst decspec, []) (snd decspec) }
+    { Cabs.DECDEF (fst decspec, []) (snd decspec) }
 
 declaration_specifiers_typespec_opt:
 | storage = storage_class_specifier rest = declaration_specifiers_typespec_opt
-    { SpecStorage (fst storage)::rest }
+    { Cabs.SpecStorage (fst storage)::rest }
 | typ = type_specifier rest = declaration_specifiers_typespec_opt
-    { SpecType (fst typ)::rest }
+    { Cabs.SpecType (fst typ)::rest }
 | qual = type_qualifier rest = declaration_specifiers_typespec_opt
-    { SpecCV (fst qual)::rest }
+    { Cabs.SpecCV (fst qual)::rest }
 | func = function_specifier rest = declaration_specifiers_typespec_opt
-    { SpecFunction (fst func)::rest }
+    { Cabs.SpecFunction (fst func)::rest }
 | /* empty */
     { [] }
 
@@ -357,16 +362,16 @@ declaration_specifiers_typespec_opt:
    specifier. *)
 declaration_specifiers:
 | storage = storage_class_specifier rest = declaration_specifiers
-    { (SpecStorage (fst storage)::fst rest, snd storage) }
+    { (Cabs.SpecStorage (fst storage)::fst rest, snd storage) }
 | typ = type_specifier rest = declaration_specifiers_typespec_opt
-    { (SpecType (fst typ)::rest, snd typ) }
+    { (Cabs.SpecType (fst typ)::rest, snd typ) }
 (* We have to inline type_qualifier in order to avoid a conflict. *)
 | qual = type_qualifier_noattr rest = declaration_specifiers
-    { (SpecCV (fst qual)::fst rest, snd qual) }
+    { (Cabs.SpecCV (fst qual)::fst rest, snd qual) }
 | attr = attribute_specifier rest = declaration_specifiers
-    { (SpecCV (CV_ATTR (fst attr))::fst rest, snd attr) }
+    { (Cabs.SpecCV (Cabs.CV_ATTR (fst attr))::fst rest, snd attr) }
 | func = function_specifier rest = declaration_specifiers
-    { (SpecFunction (fst func)::fst rest, snd func) }
+    { (Cabs.SpecFunction (fst func)::fst rest, snd func) }
 
 init_declarator_list:
 | init = init_declarator
@@ -376,71 +381,71 @@ init_declarator_list:
 
 init_declarator:
 | name = declarator
-    { Init_name name NO_INIT }
+    { Cabs.Init_name name Cabs.NO_INIT }
 | name = declarator EQ init = c_initializer
-    { Init_name name init }
+    { Cabs.Init_name name init }
 
 (* 6.7.1 *)
 storage_class_specifier:
 | loc = TYPEDEF
-    { (TYPEDEF, loc) }
+    { (Cabs.TYPEDEF, loc) }
 | loc = EXTERN
-    { (EXTERN, loc) }
+    { (Cabs.EXTERN, loc) }
 | loc = STATIC
-    { (STATIC, loc) }
+    { (Cabs.STATIC, loc) }
 | loc = AUTO
-    { (AUTO, loc) }
+    { (Cabs.AUTO, loc) }
 | loc = REGISTER
-    { (REGISTER, loc) }
+    { (Cabs.REGISTER, loc) }
 
 (* 6.7.2 *)
 type_specifier:
 | loc = VOID
-    { (Tvoid, loc) }
+    { (Cabs.Tvoid, loc) }
 | loc = CHAR
-    { (Tchar, loc) }
+    { (Cabs.Tchar, loc) }
 | loc = SHORT
-    { (Tshort, loc) }
+    { (Cabs.Tshort, loc) }
 | loc = INT
-    { (Tint, loc) }
+    { (Cabs.Tint, loc) }
 | loc = LONG
-    { (Tlong, loc) }
+    { (Cabs.Tlong, loc) }
 | loc = FLOAT
-    { (Tfloat, loc) }
+    { (Cabs.Tfloat, loc) }
 | loc = DOUBLE
-    { (Tdouble, loc) }
+    { (Cabs.Tdouble, loc) }
 | loc = SIGNED
-    { (Tsigned, loc) }
+    { (Cabs.Tsigned, loc) }
 | loc = UNSIGNED
-    { (Tunsigned, loc) }
+    { (Cabs.Tunsigned, loc) }
 | loc = UNDERSCORE_BOOL
-    { (T_Bool, loc) }
+    { (Cabs.T_Bool, loc) }
 | spec = struct_or_union_specifier
     { spec }
 | spec = enum_specifier
     { spec }
 | id = TYPEDEF_NAME
-    { (Tnamed (fst id), snd id) }
+    { (Cabs.Tnamed (fst id), snd id) }
 
 (* 6.7.2.1 *)
 struct_or_union_specifier:
 | str_uni = struct_or_union attrs = attribute_specifier_list id = OTHER_NAME
   LBRACE decls = struct_declaration_list RBRACE
-    { (Tstruct_union (fst str_uni) (Some (fst id)) (Some (rev' decls)) attrs,
+    { (Cabs.Tstruct_union (fst str_uni) (Some (fst id)) (Some (rev' decls)) attrs,
        snd str_uni) }
 | str_uni = struct_or_union attrs = attribute_specifier_list
   LBRACE decls = struct_declaration_list RBRACE
-    { (Tstruct_union (fst str_uni) None (Some (rev' decls)) attrs,
+    { (Cabs.Tstruct_union (fst str_uni) None (Some (rev' decls)) attrs,
        snd str_uni) }
 | str_uni = struct_or_union attrs = attribute_specifier_list id = OTHER_NAME
-    { (Tstruct_union (fst str_uni) (Some (fst id)) None attrs,
+    { (Cabs.Tstruct_union (fst str_uni) (Some (fst id)) None attrs,
        snd str_uni) }
 
 struct_or_union:
 | loc = STRUCT
-    { (STRUCT, loc) }
+    { (Cabs.STRUCT, loc) }
 | loc = UNION
-    { (UNION, loc) }
+    { (Cabs.UNION, loc) }
 
 struct_declaration_list:
 | (* empty *)
@@ -450,20 +455,20 @@ struct_declaration_list:
 
 struct_declaration:
 | decspec = specifier_qualifier_list decls = struct_declarator_list SEMICOLON
-    { Field_group (fst decspec) (rev' decls) (snd decspec) }
+    { Cabs.Field_group (fst decspec) (rev' decls) (snd decspec) }
 (* Extension to C99 grammar needed to parse some GNU header files. *)
 | decspec = specifier_qualifier_list SEMICOLON
-    { Field_group (fst decspec) [(None,None)] (snd decspec) }
+    { Cabs.Field_group (fst decspec) [(None,None)] (snd decspec) }
 
 specifier_qualifier_list:
 | typ = type_specifier rest = specifier_qualifier_list
-    { (SpecType (fst typ)::fst rest, snd typ) }
+    { (Cabs.SpecType (fst typ)::fst rest, snd typ) }
 | typ = type_specifier
-    { ([SpecType (fst typ)], snd typ) }
+    { ([Cabs.SpecType (fst typ)], snd typ) }
 | qual = type_qualifier rest = specifier_qualifier_list
-    { (SpecCV (fst qual)::fst rest, snd qual) }
+    { (Cabs.SpecCV (fst qual)::fst rest, snd qual) }
 | qual = type_qualifier
-    { ([SpecCV (fst qual)], snd qual) }
+    { ([Cabs.SpecCV (fst qual)], snd qual) }
 
 struct_declarator_list:
 | decl = struct_declarator
@@ -483,18 +488,18 @@ struct_declarator:
 enum_specifier:
 | loc = ENUM attrs = attribute_specifier_list name = OTHER_NAME
   LBRACE enum_list = enumerator_list RBRACE
-    { (Tenum (Some (fst name)) (Some (rev' enum_list)) attrs, loc) }
+    { (Cabs.Tenum (Some (fst name)) (Some (rev' enum_list)) attrs, loc) }
 | loc = ENUM attrs = attribute_specifier_list
   LBRACE enum_list = enumerator_list RBRACE
-    { (Tenum None (Some (rev' enum_list)) attrs, loc) }
+    { (Cabs.Tenum None (Some (rev' enum_list)) attrs, loc) }
 | loc = ENUM attrs = attribute_specifier_list name = OTHER_NAME
   LBRACE enum_list = enumerator_list COMMA RBRACE
-    { (Tenum (Some (fst name)) (Some (rev' enum_list)) attrs, loc) }
+    { (Cabs.Tenum (Some (fst name)) (Some (rev' enum_list)) attrs, loc) }
 | loc = ENUM attrs = attribute_specifier_list
   LBRACE enum_list = enumerator_list COMMA RBRACE
-    { (Tenum None (Some (rev' enum_list)) attrs, loc) }
+    { (Cabs.Tenum None (Some (rev' enum_list)) attrs, loc) }
 | loc = ENUM attrs = attribute_specifier_list name = OTHER_NAME
-    { (Tenum (Some (fst name)) None attrs, loc) }
+    { (Cabs.Tenum (Some (fst name)) None attrs, loc) }
 
 enumerator_list:
 | enum = enumerator
@@ -515,18 +520,18 @@ enumeration_constant:
 (* 6.7.3 *)
 type_qualifier_noattr:
 | loc = CONST
-    { (CV_CONST, loc) }
+    { (Cabs.CV_CONST, loc) }
 | loc = RESTRICT
-    { (CV_RESTRICT, loc) }
+    { (Cabs.CV_RESTRICT, loc) }
 | loc = VOLATILE
-    { (CV_VOLATILE, loc) }
+    { (Cabs.CV_VOLATILE, loc) }
 
 type_qualifier:
 | qual = type_qualifier_noattr
     { qual }
 (* Non-standard *)
 | attr = attribute_specifier
-    { (CV_ATTR (fst attr), snd attr) }
+    { (Cabs.CV_ATTR (fst attr), snd attr) }
 
 (* Non-standard *)
 
@@ -538,13 +543,13 @@ attribute_specifier_list:
 
 attribute_specifier:
 | loc = ATTRIBUTE LPAREN LPAREN attr = gcc_attribute_list RPAREN RPAREN
-    { (GCC_ATTR (rev' attr) loc, loc) }
+    { (Cabs.GCC_ATTR (rev' attr) loc, loc) }
 | loc = PACKED LPAREN args = argument_expression_list RPAREN
-    { (PACKED_ATTR (rev' args) loc, loc) }
+    { (Cabs.PACKED_ATTR (rev' args) loc, loc) }
 | loc = ALIGNAS LPAREN args = argument_expression_list RPAREN
-    { (ALIGNAS_ATTR (rev' args) loc, loc) }
+    { (Cabs.ALIGNAS_ATTR (rev' args) loc, loc) }
 | loc = ALIGNAS LPAREN typ = type_name RPAREN
-    { (ALIGNAS_ATTR [ALIGNOF typ] loc, loc) }
+    { (Cabs.ALIGNAS_ATTR [Cabs.ALIGNOF typ] loc, loc) }
 
 gcc_attribute_list:
 | a = gcc_attribute
@@ -554,80 +559,81 @@ gcc_attribute_list:
 
 gcc_attribute:
 | /* empty */
-    { GCC_ATTR_EMPTY }
+    { Cabs.GCC_ATTR_EMPTY }
 | w = gcc_attribute_word
-    { GCC_ATTR_NOARGS w }
+    { Cabs.GCC_ATTR_NOARGS w }
 | w = gcc_attribute_word LPAREN RPAREN
-    { GCC_ATTR_ARGS w [] }
+    { Cabs.GCC_ATTR_ARGS w [] }
 | w = gcc_attribute_word LPAREN args = argument_expression_list RPAREN
-    { GCC_ATTR_ARGS w (rev' args) }
+    { Cabs.GCC_ATTR_ARGS w (rev' args) }
 
 gcc_attribute_word:
 | i = OTHER_NAME
-    { GCC_ATTR_IDENT (fst i) }
+    { Cabs.GCC_ATTR_IDENT (fst i) }
 | CONST
-    { GCC_ATTR_CONST }
+    { Cabs.GCC_ATTR_CONST }
 | PACKED
-    { GCC_ATTR_PACKED }
+    { Cabs.GCC_ATTR_PACKED }
 
 (* 6.7.4 *)
 function_specifier:
 | loc = INLINE
-   { (INLINE, loc) }
+   { (Cabs.INLINE, loc) }
 | loc = NORETURN
-  { (NORETURN, loc)}
+  { (Cabs.NORETURN, loc)}
 
 (* 6.7.5 *)
 declarator:
 | decl = declarator_noattrend attrs = attribute_specifier_list
-    { match decl with Name name typ attr loc =>
-        Name name typ (List.app attr attrs) loc end }
+    { let 'Cabs.Name name typ attr loc := decl in
+      Cabs.Name name typ (List.app attr attrs) loc }
 
 declarator_noattrend:
 | decl = direct_declarator
     { decl }
 | pt = pointer decl = direct_declarator
-    { match decl with Name name typ attr _ =>
-        Name name ((fst pt) typ) attr (snd pt) end }
+    { let 'Cabs.Name name typ attr _ := decl in
+      Cabs.Name name ((fst pt) typ) attr (snd pt) }
 
 direct_declarator:
 | id = VAR_NAME
-    { Name (fst id) JUSTBASE [] (snd id) }
+    { Cabs.Name (fst id) Cabs.JUSTBASE [] (snd id) }
 | LPAREN decl = declarator RPAREN
     { decl }
-| decl = direct_declarator LBRACK quallst = type_qualifier_list expr = assignment_expression RBRACK
-    { match decl with Name name typ attr loc =>
-        Name name (ARRAY typ (rev' quallst) (Some (fst expr))) attr loc end }
+| decl = direct_declarator LBRACK quallst = type_qualifier_list
+  expr = assignment_expression RBRACK
+    { let 'Cabs.Name name typ attr loc := decl in
+      Cabs.Name name (Cabs.ARRAY typ (rev' quallst) (Some (fst expr))) attr loc }
 | decl = direct_declarator LBRACK expr = assignment_expression RBRACK
-    { match decl with Name name typ attr loc =>
-        Name name (ARRAY typ [] (Some (fst expr))) attr loc end }
+    { let 'Cabs.Name name typ attr loc := decl in
+      Cabs.Name name (Cabs.ARRAY typ [] (Some (fst expr))) attr loc }
 | decl = direct_declarator LBRACK quallst = type_qualifier_list RBRACK
-    { match decl with Name name typ attr loc =>
-        Name name (ARRAY typ (rev' quallst) None) attr loc end }
+    { let 'Cabs.Name name typ attr loc := decl in
+      Cabs.Name name (Cabs.ARRAY typ (rev' quallst) None) attr loc }
 | decl = direct_declarator LBRACK RBRACK
-    { match decl with Name name typ attr loc =>
-        Name name (ARRAY typ [] None) attr loc end }
+    { let 'Cabs.Name name typ attr loc := decl in
+      Cabs.Name name (Cabs.ARRAY typ [] None) attr loc }
 (*| direct_declarator LBRACK ... STATIC ... RBRACK
 | direct_declarator LBRACK STAR RBRACK*)
 | decl = direct_declarator LPAREN params = parameter_type_list RPAREN
-    { match decl with Name name typ attr loc =>
-        Name name (PROTO typ params) attr loc end }
+    { let 'Cabs.Name name typ attr loc := decl in
+      Cabs.Name name (Cabs.PROTO typ params) attr loc }
 | decl = direct_declarator LPAREN RPAREN
-    { match decl with Name name typ attr loc =>
-        Name name (PROTO_OLD typ []) attr loc end }
+    { let 'Cabs.Name name typ attr loc := decl in
+      Cabs.Name name (Cabs.PROTO_OLD typ []) attr loc }
 | decl = direct_declarator LPAREN params = identifier_list RPAREN
-    { match decl with Name name typ attr loc =>
-        Name name (PROTO_OLD typ (rev' params)) attr loc end }
+    { let 'Cabs.Name name typ attr loc := decl in
+      Cabs.Name name (Cabs.PROTO_OLD typ (rev' params)) attr loc }
 
 pointer:
 | loc = STAR
-    { (fun typ => PTR [] typ, loc) }
+    { (fun typ => Cabs.PTR [] typ, loc) }
 | loc = STAR quallst = type_qualifier_list
-    { (fun typ => PTR (rev' quallst) typ, loc) }
+    { (fun typ => Cabs.PTR (rev' quallst) typ, loc) }
 | loc = STAR pt = pointer
-    { (fun typ => PTR [] ((fst pt) typ), loc) }
+    { (fun typ => Cabs.PTR [] ((fst pt) typ), loc) }
 | loc = STAR quallst = type_qualifier_list pt = pointer
-    { (fun typ => PTR (rev' quallst) ((fst pt) typ), loc) }
+    { (fun typ => Cabs.PTR (rev' quallst) ((fst pt) typ), loc) }
 
 type_qualifier_list:
 | qual = type_qualifier
@@ -649,12 +655,12 @@ parameter_list:
 
 parameter_declaration:
 | specs = declaration_specifiers decl = declarator
-    { match decl with Name name typ attr _ =>
-        PARAM (fst specs) (Some name) typ attr (snd specs) end }
+    { match decl with Cabs.Name name typ attr _ =>
+        Cabs.PARAM (fst specs) (Some name) typ attr (snd specs) end }
 | specs = declaration_specifiers decl = abstract_declarator
-    { PARAM (fst specs) None decl [] (snd specs) }
+    { Cabs.PARAM (fst specs) None decl [] (snd specs) }
 | specs = declaration_specifiers
-    { PARAM (fst specs) None JUSTBASE [] (snd specs) }
+    { Cabs.PARAM (fst specs) None Cabs.JUSTBASE [] (snd specs) }
 
 identifier_list:
 | id = VAR_NAME
@@ -665,13 +671,13 @@ identifier_list:
 (* 6.7.6 *)
 type_name:
 | specqual = specifier_qualifier_list
-    { (fst specqual, JUSTBASE) }
+    { (fst specqual, Cabs.JUSTBASE) }
 | specqual = specifier_qualifier_list typ = abstract_declarator
     { (fst specqual, typ) }
 
 abstract_declarator:
 | pt = pointer
-    { (fst pt) JUSTBASE }
+    { (fst pt) Cabs.JUSTBASE }
 | pt = pointer typ = direct_abstract_declarator
     { (fst pt) typ }
 | typ = direct_abstract_declarator
@@ -680,41 +686,42 @@ abstract_declarator:
 direct_abstract_declarator:
 | LPAREN typ = abstract_declarator RPAREN
     { typ }
-| typ = direct_abstract_declarator LBRACK cvspec = type_qualifier_list expr = assignment_expression RBRACK
-    { ARRAY typ cvspec (Some (fst expr)) }
+| typ = direct_abstract_declarator LBRACK cvspec = type_qualifier_list
+  expr = assignment_expression RBRACK
+    { Cabs.ARRAY typ cvspec (Some (fst expr)) }
 | LBRACK cvspec = type_qualifier_list expr = assignment_expression RBRACK
-    { ARRAY JUSTBASE cvspec (Some (fst expr)) }
+    { Cabs.ARRAY Cabs.JUSTBASE cvspec (Some (fst expr)) }
 | typ = direct_abstract_declarator LBRACK expr = assignment_expression RBRACK
-    { ARRAY typ [] (Some (fst expr)) }
+    { Cabs.ARRAY typ [] (Some (fst expr)) }
 | LBRACK expr = assignment_expression RBRACK
-    { ARRAY JUSTBASE [] (Some (fst expr)) }
+    { Cabs.ARRAY Cabs.JUSTBASE [] (Some (fst expr)) }
 | typ = direct_abstract_declarator LBRACK cvspec = type_qualifier_list RBRACK
-    { ARRAY typ cvspec None }
+    { Cabs.ARRAY typ cvspec None }
 | LBRACK cvspec = type_qualifier_list RBRACK
-    { ARRAY JUSTBASE cvspec None }
+    { Cabs.ARRAY Cabs.JUSTBASE cvspec None }
 | typ = direct_abstract_declarator LBRACK RBRACK
-    { ARRAY typ [] None }
+    { Cabs.ARRAY typ [] None }
 | LBRACK RBRACK
-    { ARRAY JUSTBASE [] None }
+    { Cabs.ARRAY Cabs.JUSTBASE [] None }
 (*| direct_abstract_declarator? LBRACK STAR RBRACK*)
 (*| direct_abstract_declarator? LBRACK ... STATIC ... RBRACK*)
 | typ = direct_abstract_declarator LPAREN params = parameter_type_list RPAREN
-    { PROTO typ params }
+    { Cabs.PROTO typ params }
 | LPAREN params = parameter_type_list RPAREN
-    { PROTO JUSTBASE params }
+    { Cabs.PROTO Cabs.JUSTBASE params }
 | typ = direct_abstract_declarator LPAREN RPAREN
-    { PROTO typ ([], false) }
+    { Cabs.PROTO typ ([], false) }
 | LPAREN RPAREN
-    { PROTO JUSTBASE ([], false) }
+    { Cabs.PROTO Cabs.JUSTBASE ([], false) }
 
 (* 6.7.8 *)
 c_initializer:
 | expr = assignment_expression
-    { SINGLE_INIT (fst expr) }
+    { Cabs.SINGLE_INIT (fst expr) }
 | LBRACE init = initializer_list RBRACE
-    { COMPOUND_INIT (rev' init) }
+    { Cabs.COMPOUND_INIT (rev' init) }
 | LBRACE init = initializer_list COMMA RBRACE
-    { COMPOUND_INIT (rev' init) }
+    { Cabs.COMPOUND_INIT (rev' init) }
 
 initializer_list:
 | design = designation init = c_initializer
@@ -738,9 +745,9 @@ designator_list:
 
 designator:
 | LBRACK expr = constant_expression RBRACK
-    { ATINDEX_INIT (fst expr) }
+    { Cabs.ATINDEX_INIT (fst expr) }
 | DOT id = OTHER_NAME
-    { INFIELD_INIT (fst id) }
+    { Cabs.INFIELD_INIT (fst id) }
 
 (* 6.8 *)
 statement_dangerous:
@@ -768,18 +775,18 @@ statement_safe:
 (* 6.8.1 *)
 labeled_statement(last_statement):
 | lbl = OTHER_NAME COLON stmt = last_statement
-    { LABEL (fst lbl) stmt (snd lbl) }
+    { Cabs.LABEL (fst lbl) stmt (snd lbl) }
 | loc = CASE expr = constant_expression COLON stmt = last_statement
-    { CASE (fst expr) stmt loc }
+    { Cabs.CASE (fst expr) stmt loc }
 | loc = DEFAULT COLON stmt = last_statement
-    { DEFAULT stmt loc }
+    { Cabs.DEFAULT stmt loc }
 
 (* 6.8.2 *)
 compound_statement:
 | loc = LBRACE lst = block_item_list RBRACE
-    { BLOCK (rev' lst) loc }
+    { Cabs.BLOCK (rev' lst) loc }
 | loc = LBRACE RBRACE
-    { BLOCK [] loc }
+    { Cabs.BLOCK [] loc }
 
 block_item_list:
 | stmt = block_item
@@ -789,93 +796,103 @@ block_item_list:
 
 block_item:
 | decl = declaration
-    { DEFINITION decl }
+    { Cabs.DEFINITION decl }
 | stmt = statement_dangerous
     { stmt }
 (* Non-standard *)
 | p = PRAGMA
-    { DEFINITION (PRAGMA (fst p) (snd p)) }
+    { Cabs.DEFINITION (Cabs.PRAGMA (fst p) (snd p)) }
 
 (* 6.8.3 *)
 expression_statement:
 | expr = expression SEMICOLON
-    { COMPUTATION (fst expr) (snd expr) }
+    { Cabs.COMPUTATION (fst expr) (snd expr) }
 | loc = SEMICOLON
-    { NOP loc }
+    { Cabs.NOP loc }
 
 (* 6.8.4 *)
 selection_statement_dangerous:
-| loc = IF LPAREN expr = expression RPAREN stmt = statement_dangerous
-    { If (fst expr) stmt None loc }
-| loc = IF LPAREN expr = expression RPAREN stmt1 = statement_safe ELSE stmt2 = statement_dangerous
-    { If (fst expr) stmt1 (Some stmt2) loc }
+| loc = IF_ LPAREN expr = expression RPAREN stmt = statement_dangerous
+    { Cabs.If (fst expr) stmt None loc }
+| loc = IF_ LPAREN expr = expression RPAREN stmt1 = statement_safe ELSE
+  stmt2 = statement_dangerous
+    { Cabs.If (fst expr) stmt1 (Some stmt2) loc }
 | loc = SWITCH LPAREN expr = expression RPAREN stmt = statement_dangerous
-    { SWITCH (fst expr) stmt loc }
+    { Cabs.SWITCH (fst expr) stmt loc }
 
 selection_statement_safe:
-| loc = IF LPAREN expr = expression RPAREN stmt1 = statement_safe ELSE stmt2 = statement_safe
-    { If (fst expr) stmt1 (Some stmt2) loc }
+| loc = IF_ LPAREN expr = expression RPAREN stmt1 = statement_safe ELSE
+  stmt2 = statement_safe
+    { Cabs.If (fst expr) stmt1 (Some stmt2) loc }
 | loc = SWITCH LPAREN expr = expression RPAREN stmt = statement_safe
-    { SWITCH (fst expr) stmt loc }
+    { Cabs.SWITCH (fst expr) stmt loc }
 
 (* 6.8.5 *)
 iteration_statement(last_statement):
 | loc = WHILE LPAREN expr = expression RPAREN stmt = last_statement
-    { WHILE (fst expr) stmt loc }
+    { Cabs.WHILE (fst expr) stmt loc }
 | loc = DO stmt = statement_dangerous WHILE LPAREN expr = expression RPAREN SEMICOLON
-    { DOWHILE (fst expr) stmt loc }
-| loc = FOR LPAREN expr1 = expression SEMICOLON expr2 = expression SEMICOLON expr3 = expression RPAREN stmt = last_statement
-    { FOR (Some (FC_EXP (fst expr1))) (Some (fst expr2)) (Some (fst expr3)) stmt loc }
-| loc = FOR LPAREN decl1 = declaration expr2 = expression SEMICOLON expr3 = expression RPAREN stmt = last_statement
-    { FOR (Some (FC_DECL decl1)) (Some (fst expr2)) (Some (fst expr3)) stmt loc }
-| loc = FOR LPAREN SEMICOLON expr2 = expression SEMICOLON expr3 = expression RPAREN stmt = last_statement
-    { FOR None (Some (fst expr2)) (Some (fst expr3)) stmt loc }
-| loc = FOR LPAREN expr1 = expression SEMICOLON SEMICOLON expr3 = expression RPAREN stmt = last_statement
-    { FOR (Some (FC_EXP (fst expr1))) None (Some (fst expr3)) stmt loc }
-| loc = FOR LPAREN decl1 = declaration SEMICOLON expr3 = expression RPAREN stmt = last_statement
-    { FOR (Some (FC_DECL decl1)) None (Some (fst expr3)) stmt loc }
+    { Cabs.DOWHILE (fst expr) stmt loc }
+| loc = FOR LPAREN expr1 = expression SEMICOLON expr2 = expression SEMICOLON
+  expr3 = expression RPAREN stmt = last_statement
+    { Cabs.FOR (Some (Cabs.FC_EXP (fst expr1))) (Some (fst expr2)) (Some (fst expr3)) stmt loc }
+| loc = FOR LPAREN decl1 = declaration expr2 = expression SEMICOLON
+  expr3 = expression RPAREN stmt = last_statement
+    { Cabs.FOR (Some (Cabs.FC_DECL decl1)) (Some (fst expr2)) (Some (fst expr3)) stmt loc }
+| loc = FOR LPAREN SEMICOLON expr2 = expression SEMICOLON expr3 = expression RPAREN 
+  stmt = last_statement
+    { Cabs.FOR None (Some (fst expr2)) (Some (fst expr3)) stmt loc }
+| loc = FOR LPAREN expr1 = expression SEMICOLON SEMICOLON expr3 = expression RPAREN
+  stmt = last_statement
+    { Cabs.FOR (Some (Cabs.FC_EXP (fst expr1))) None (Some (fst expr3)) stmt loc }
+| loc = FOR LPAREN decl1 = declaration SEMICOLON expr3 = expression RPAREN
+  stmt = last_statement
+    { Cabs.FOR (Some (Cabs.FC_DECL decl1)) None (Some (fst expr3)) stmt loc }
 | loc = FOR LPAREN SEMICOLON SEMICOLON expr3 = expression RPAREN stmt = last_statement
-    { FOR None None (Some (fst expr3)) stmt loc }
-| loc = FOR LPAREN expr1 = expression SEMICOLON expr2 = expression SEMICOLON RPAREN stmt = last_statement
-    { FOR (Some (FC_EXP (fst expr1))) (Some (fst expr2)) None stmt loc }
-| loc = FOR LPAREN decl1 = declaration expr2 = expression SEMICOLON RPAREN stmt = last_statement
-    { FOR (Some (FC_DECL decl1)) (Some (fst expr2)) None stmt loc }
+    { Cabs.FOR None None (Some (fst expr3)) stmt loc }
+| loc = FOR LPAREN expr1 = expression SEMICOLON expr2 = expression SEMICOLON RPAREN
+  stmt = last_statement
+    { Cabs.FOR (Some (Cabs.FC_EXP (fst expr1))) (Some (fst expr2)) None stmt loc }
+| loc = FOR LPAREN decl1 = declaration expr2 = expression SEMICOLON RPAREN
+  stmt = last_statement
+    { Cabs.FOR (Some (Cabs.FC_DECL decl1)) (Some (fst expr2)) None stmt loc }
 | loc = FOR LPAREN SEMICOLON expr2 = expression SEMICOLON RPAREN stmt = last_statement
-    { FOR None (Some (fst expr2)) None stmt loc }
+    { Cabs.FOR None (Some (fst expr2)) None stmt loc }
 | loc = FOR LPAREN expr1 = expression SEMICOLON SEMICOLON RPAREN stmt = last_statement
-    { FOR (Some (FC_EXP (fst expr1))) None None stmt loc }
+    { Cabs.FOR (Some (Cabs.FC_EXP (fst expr1))) None None stmt loc }
 | loc = FOR LPAREN decl1 = declaration SEMICOLON RPAREN stmt = last_statement
-    { FOR (Some (FC_DECL decl1)) None None stmt loc }
+    { Cabs.FOR (Some (Cabs.FC_DECL decl1)) None None stmt loc }
 | loc = FOR LPAREN SEMICOLON SEMICOLON RPAREN stmt = last_statement
-    { FOR None None None stmt loc }
+    { Cabs.FOR None None None stmt loc }
 
 (* 6.8.6 *)
 jump_statement:
 | loc = GOTO id = OTHER_NAME SEMICOLON
-    { GOTO (fst id) loc }
+    { Cabs.GOTO (fst id) loc }
 | loc = CONTINUE SEMICOLON
-    { CONTINUE loc }
+    { Cabs.CONTINUE loc }
 | loc = BREAK SEMICOLON
-    { BREAK loc }
+    { Cabs.BREAK loc }
 | loc = RETURN expr = expression SEMICOLON
-    { RETURN (Some (fst expr)) loc }
+    { Cabs.RETURN (Some (fst expr)) loc }
 | loc = RETURN SEMICOLON
-    { RETURN None loc }
+    { Cabs.RETURN None loc }
 
 (* Non-standard *)
 asm_statement:
-| loc = ASM attr = asm_attributes LPAREN template = STRING_LITERAL args = asm_arguments RPAREN SEMICOLON
+| loc = ASM attr = asm_attributes LPAREN template = STRING_LITERAL args = asm_arguments
+  RPAREN SEMICOLON
     { let '(wide, chars, _) := template in
       let '(outputs, inputs, flags) := args in
-      ASM attr wide chars outputs inputs flags loc }
+      Cabs.ASM attr wide chars outputs inputs flags loc }
 
 asm_attributes:
 | /* empty */
      { [] }
 | CONST attr = asm_attributes
-     { CV_CONST :: attr }
+     { Cabs.CV_CONST :: attr }
 | VOLATILE attr = asm_attributes
-     { CV_VOLATILE :: attr }
+     { Cabs.CV_VOLATILE :: attr }
 
 asm_arguments:
 | /* empty */
@@ -897,7 +914,7 @@ asm_operands_ne:
 
 asm_operand:
 | n = asm_op_name cstr = STRING_LITERAL LPAREN e = expression RPAREN
-    { let '(wide, s, loc) := cstr in ASMOPERAND n wide s (fst e) }
+    { let '(wide, s, loc) := cstr in Cabs.ASMOPERAND n wide s (fst e) }
 
 asm_op_name:
 | /* empty */                         { None }
@@ -934,7 +951,7 @@ external_declaration:
     { def }
 (* Non-standard *)
 | p = PRAGMA
-    { PRAGMA (fst p) (snd p) }
+    { Cabs.PRAGMA (fst p) (snd p) }
 
 
 (* 6.9.1 *)
@@ -943,11 +960,11 @@ function_definition:
   decl = declarator_noattrend
   dlist = declaration_list
   stmt = compound_statement
-   { FUNDEF (fst specs) decl (List.rev' dlist) stmt (snd specs) }
+   { Cabs.FUNDEF (fst specs) decl (List.rev' dlist) stmt (snd specs) }
 | specs = declaration_specifiers
   decl = declarator
   stmt = compound_statement
-    { FUNDEF (fst specs) decl [] stmt (snd specs) }
+    { Cabs.FUNDEF (fst specs) decl [] stmt (snd specs) }
 
 declaration_list:
 | d = declaration
diff --git a/cparser/Rename.ml b/cparser/Rename.ml
index eb31eaf0..64412194 100644
--- a/cparser/Rename.ml
+++ b/cparser/Rename.ml
@@ -246,7 +246,7 @@ let rec globdecls env accu = function
 (* Reserve names of builtins *)
 
 let reserve_builtins () =
-  List.fold_left enter_public empty_env (Builtins.identifiers())
+  List.fold_left enter_public empty_env (Env.initial_identifiers())
 
 (* Reserve global declarations with public visibility *)
 
diff --git a/cparser/Transform.ml b/cparser/Transform.ml
index 0a2ce3bb..349a3155 100644
--- a/cparser/Transform.ml
+++ b/cparser/Transform.ml
@@ -227,4 +227,4 @@ let program
       in
         transf_globdecls env' ({g with gdesc = desc'} :: accu) gl
 
-  in transf_globdecls (Builtins.environment()) [] p
+  in transf_globdecls (Env.initial()) [] p
diff --git a/cparser/Unblock.ml b/cparser/Unblock.ml
index da8049a5..d25f70c6 100644
--- a/cparser/Unblock.ml
+++ b/cparser/Unblock.ml
@@ -340,7 +340,6 @@ and unblock_block env ctx ploc = function
 
 let unblock_fundef env f =
   local_variables := [];
-  next_scope_id := 0;
   curr_fun_id:= f.fd_name.stamp;
   (* TODO: register the parameters as being declared in function scope *)
   let body = unblock_stmt env [] no_loc f.fd_body in
@@ -398,5 +397,6 @@ let rec unblock_glob env accu = function
 (* Entry point *)
 
 let program p =
+  next_scope_id := 0;
   {gloc = no_loc; gdesc = Gdecl(Storage_extern, debug_id, debug_ty, None)} ::
-  unblock_glob (Builtins.environment()) [] p
+  unblock_glob (Env.initial()) [] p
diff --git a/cparser/handcrafted.messages b/cparser/handcrafted.messages
index 95077739..6d972439 100644
--- a/cparser/handcrafted.messages
+++ b/cparser/handcrafted.messages
@@ -4477,7 +4477,7 @@ translation_unit_file: VOID PRE_NAME TYPEDEF_NAME PACKED LPAREN CONSTANT RPAREN
 ##
 
 # We have just parsed a list of attribute specifiers, but we cannot
-# print it because it is not available. We do not know wether it is
+# print it because it is not available. We do not know whether it is
 # part of the declaration or whether it is part of the first K&R parameter
 # declaration.
 
@@ -4599,7 +4599,7 @@ translation_unit_file: PACKED LPAREN BUILTIN_OFFSETOF XOR_ASSIGN
 ##
 
 Ill-formed __builtin_offsetof.
-At this point, an opening paranthesis '(' is expected.
+At this point, an opening parenthesis '(' is expected.
 
 #------------------------------------------------------------------------------
 
diff --git a/cparser/pre_parser.mly b/cparser/pre_parser.mly
index 71eaf419..669ecf5e 100644
--- a/cparser/pre_parser.mly
+++ b/cparser/pre_parser.mly
@@ -43,13 +43,13 @@
 %}
 
 %token<string> PRE_NAME
-%token<string * Pre_parser_aux.identifier_type ref * Cabs.cabsloc>
+%token<string * Pre_parser_aux.identifier_type ref * Cabs.loc>
   VAR_NAME TYPEDEF_NAME
-%token<Cabs.constant * Cabs.cabsloc> CONSTANT
-%token<bool * int64 list * Cabs.cabsloc> STRING_LITERAL
-%token<string * Cabs.cabsloc> PRAGMA
+%token<Cabs.constant * Cabs.loc> CONSTANT
+%token<bool * int64 list * Cabs.loc> STRING_LITERAL
+%token<string * Cabs.loc> PRAGMA
 
-%token<Cabs.cabsloc> SIZEOF PTR INC DEC LEFT RIGHT LEQ GEQ EQEQ EQ NEQ LT GT
+%token<Cabs.loc> SIZEOF PTR INC DEC LEFT RIGHT LEQ GEQ EQEQ EQ NEQ LT GT
   ANDAND BARBAR PLUS MINUS STAR TILDE BANG SLASH PERCENT HAT BAR QUESTION
   COLON AND MUL_ASSIGN DIV_ASSIGN MOD_ASSIGN ADD_ASSIGN SUB_ASSIGN LEFT_ASSIGN
   RIGHT_ASSIGN AND_ASSIGN XOR_ASSIGN OR_ASSIGN LPAREN RPAREN LBRACK RBRACK
diff --git a/debug/Debug.ml b/debug/Debug.ml
index 168df5a0..812f57cc 100644
--- a/debug/Debug.ml
+++ b/debug/Debug.ml
@@ -47,7 +47,7 @@ type implem =
       exists_section: section_name -> bool;
       remove_unused: ident -> unit;
       remove_unused_function: ident -> unit;
-      variable_printed: string -> unit;
+      symbol_printed: string -> unit;
       add_diab_info: section_name -> int -> int -> int -> unit;
    }
 
@@ -79,7 +79,7 @@ let default_implem =
    exists_section = (fun _ -> true);
    remove_unused = (fun _ -> ());
    remove_unused_function = (fun _ -> ());
-   variable_printed = (fun _ -> ());
+   symbol_printed = (fun _ -> ());
    add_diab_info = (fun _ _ _ _ -> ());
 }
 
@@ -111,5 +111,5 @@ let compute_diab_file_enum end_l entry_l line_e = !implem.compute_diab_file_enum
 let compute_gnu_file_enum f = !implem.compute_gnu_file_enum f
 let remove_unused ident = !implem.remove_unused ident
 let remove_unused_function ident = !implem.remove_unused_function ident
-let variable_printed ident = !implem.variable_printed ident
+let symbol_printed ident = !implem.symbol_printed ident
 let add_diab_info sec line_start debug_info low_pc = !implem.add_diab_info sec line_start debug_info low_pc
diff --git a/debug/Debug.mli b/debug/Debug.mli
index 3869a056..60e2f9bc 100644
--- a/debug/Debug.mli
+++ b/debug/Debug.mli
@@ -46,7 +46,7 @@ type implem =
      exists_section: section_name -> bool;
      remove_unused: ident -> unit;
      remove_unused_function: ident -> unit;
-     variable_printed: string -> unit;
+     symbol_printed: string -> unit;
      add_diab_info: section_name ->  int -> int -> int -> unit;
    }
 
@@ -80,5 +80,5 @@ val compute_gnu_file_enum: (string -> unit) -> unit
 val exists_section: section_name -> bool
 val remove_unused: ident -> unit
 val remove_unused_function: ident -> unit
-val variable_printed: string -> unit
+val symbol_printed: string -> unit
 val add_diab_info: section_name ->  int -> int  -> int -> unit
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index e3f5d98e..f9684355 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -123,7 +123,7 @@ let insert_type ty =
           | TNamed (id,_) ->
               let typ = try
                 let _,t =
-                  List.find (fun a -> fst a = id.name) CBuiltins.builtins.Builtins.typedefs in
+                  List.find (fun a -> fst a = id.name) CBuiltins.builtins.builtin_typedefs in
                 Some (attr_aux t)
               with Not_found -> None in
               let t = {
@@ -223,7 +223,7 @@ let name_to_definition: (string,int) Hashtbl.t = Hashtbl.create 7
 (* Mapping from atom to debug id *)
 let atom_to_definition: (atom, int) Hashtbl.t = Hashtbl.create 7
 
-(* Various lookup functions for defintions *)
+(* Various lookup functions for definitions *)
 let find_gvar_stamp id =
   let id = (Hashtbl.find stamp_to_definition id) in
   let var = Hashtbl.find definitions id in
@@ -342,7 +342,7 @@ let insert_global_declaration env dec =
           replace_var id ({var with gvar_declaration = false;})
         end
       end else begin
-        (* Implict declarations need special handling *)
+        (* Implicit declarations need special handling *)
         let id' = try Hashtbl.find name_to_definition id.name with Not_found ->
           let id' = next_id () in
           Hashtbl.add name_to_definition id.name id';id' in
@@ -553,7 +553,10 @@ let close_scope atom s_id lbl =
         | a::rest -> a,rest
         | _ -> assert false (* We must have an opening scope *)
       end in
-    let new_r = ({last_r with end_addr = Some lbl;})::rest in
+    let new_r = if last_r.start_addr = Some lbl then
+        rest
+      else
+        ({last_r with end_addr = Some lbl;})::rest in
     Hashtbl.replace scope_ranges s_id new_r
   with Not_found -> ()
 
@@ -632,12 +635,12 @@ let compute_gnu_file_enum f =
 
 let all_files_iter f = StringSet.iter f !all_files
 
-let printed_vars: StringSet.t ref = ref StringSet.empty
+let printed_symbols: StringSet.t ref = ref StringSet.empty
 
-let is_variable_printed id = StringSet.mem id !printed_vars
+let is_symbol_printed id = StringSet.mem id !printed_symbols
 
-let variable_printed id =
-  printed_vars := StringSet.add id !printed_vars
+let symbol_printed id =
+  printed_symbols := StringSet.add id !printed_symbols
 
 let init name =
   id := 0;
@@ -660,7 +663,7 @@ let init name =
   Hashtbl.reset scope_ranges;
   Hashtbl.reset label_translation;
   all_files := StringSet.singleton name;
-  printed_vars := StringSet.empty
+  printed_symbols := StringSet.empty
 
 let default_debug =
   {
@@ -690,6 +693,6 @@ let default_debug =
    exists_section = exists_section;
    remove_unused = remove_unused;
    remove_unused_function = remove_unused_function;
-   variable_printed = variable_printed;
+   symbol_printed = symbol_printed;
    add_diab_info = (fun _ _ _ _ -> ());
  }
diff --git a/debug/DebugInformation.mli b/debug/DebugInformation.mli
index 8905d8bf..0cf34756 100644
--- a/debug/DebugInformation.mli
+++ b/debug/DebugInformation.mli
@@ -23,7 +23,7 @@ val get_type: int -> debug_types
 
 val fold_types: (int -> debug_types -> 'a -> 'a) -> 'a -> 'a
 
-val is_variable_printed: string -> bool
+val is_symbol_printed: string -> bool
 
 val variable_location: atom -> atom -> var_location
 
diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml
index a45fff0c..2cb8c7d9 100644
--- a/debug/DwarfPrinter.ml
+++ b/debug/DwarfPrinter.ml
@@ -241,9 +241,12 @@ module DwarfPrinter(Target: DWARF_TARGET):
       let abbrev = !curr_abbrev in
       incr curr_abbrev;abbrev
 
-    (* Mapping from abbreviation string to abbreviaton id *)
+    (* Mapping from abbreviation string to abbreviation id *)
     let abbrev_mapping: (string,int) Hashtbl.t = Hashtbl.create 7
 
+    (* Mapping from abbreviation range id to label *)
+    let range_labels : (int, int) Hashtbl.t = Hashtbl.create 7
+
     (* Look up the id of the abbreviation and add it if it is missing *)
     let get_abbrev entity has_sibling =
       let abbrev_string = abbrev_string_of_entity entity has_sibling in
@@ -265,7 +268,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
     (* Print the debug_abbrev section using the previous computed abbreviations*)
     let print_abbrev oc =
       let abbrevs = Hashtbl.fold (fun s i acc -> (s,i)::acc) abbrev_mapping [] in
-      let abbrevs = List.sort (fun (_,a) (_,b) -> Pervasives.compare a b) abbrevs in
+      let abbrevs = List.sort (fun (_,a) (_,b) -> compare a b) abbrevs in
       section oc Section_debug_abbrev;
       print_label oc !abbrev_start_addr;
       List.iter (fun (s,id) ->
@@ -439,8 +442,11 @@ module DwarfPrinter(Target: DWARF_TARGET):
       | Pc_pair (l,h) ->
           print_addr oc "DW_AT_low_pc" l;
           print_addr oc "DW_AT_high_pc" h
-      | Offset i -> fprintf oc "	.4byte		%a+0x%d%a\n"
-            label !debug_ranges_addr i print_comment "DW_AT_ranges"
+      | Offset i ->
+        let lbl = new_label () in
+        Hashtbl.add range_labels i lbl;
+        fprintf oc "	.4byte		%a%a\n"
+          label lbl print_comment "DW_AT_ranges"
       | _ -> ()
 
     let print_compilation_unit oc tag =
@@ -596,8 +602,13 @@ module DwarfPrinter(Target: DWARF_TARGET):
       print_sleb128 oc "" 0;
       print_label oc debug_end (* End of the debug section *)
 
-    let print_location_entry oc c_low l =
+    let print_location_entry oc needs_base c_low l =
       print_label oc (loc_to_label l.loc_id);
+      (* If we have multiple ranges per compilation unit we need to specify a base address for the location *)
+      if needs_base then begin
+        fprintf oc "	%s		-1\n" address;
+        fprintf oc "	%s		%a\n" address label c_low;
+      end;
       List.iter (fun (b,e,loc) ->
         fprintf oc "	%s		%a-%a\n" address label b label c_low;
         fprintf oc "	%s		%a-%a\n" address label e label c_low;
@@ -615,11 +626,11 @@ module DwarfPrinter(Target: DWARF_TARGET):
       fprintf oc "	%s	0\n" address
 
 
-    let print_location_list oc (c_low,l) =
-      let f =  match c_low with
-      | Some s -> print_location_entry oc s
-      | None -> print_location_entry_abs oc in
-     List.iter f l
+    let print_location_list oc needs_base l =
+      let f l =  match l.loc_sec_begin  with
+        | Some s -> print_location_entry oc needs_base s l
+        | None -> print_location_entry_abs oc l in
+      List.iter f l
 
     let list_opt l f =
       match l with
@@ -629,29 +640,38 @@ module DwarfPrinter(Target: DWARF_TARGET):
     let print_diab_entries oc entries =
       let abbrev_start = new_label () in
       abbrev_start_addr := abbrev_start;
-      List.iter (fun e -> compute_abbrev e.entry) entries;
+      List.iter (fun e -> compute_abbrev e.diab_entry) entries;
       print_abbrev oc;
       List.iter (fun e ->
         let name = if e.section_name <> ".text" then Some e.section_name else None in
         section oc (Section_debug_info name);
-        print_debug_info oc e.start_label e.line_label e.entry) entries;
-      if List.exists (fun e -> match e.dlocs with _,[] -> false | _,_ -> true) entries then begin
+        print_debug_info oc e.start_label e.line_label e.diab_entry) entries;
+      if List.exists (fun e -> match e.diab_locs with [] -> false | _ -> true) entries then begin
         section oc Section_debug_loc;
-        List.iter (fun e -> print_location_list oc e.dlocs) entries
+        List.iter (fun e -> print_location_list oc false e.diab_locs) entries
       end
 
     let print_ranges oc r =
+      let print_range_entry = function
+        | AddressRange l ->
+          List.iter (fun (b,e) ->
+              fprintf oc "	%s		%a\n" address label b;
+              fprintf oc "	%s		%a\n" address label e) l;
+        | OffsetRange (start, l) ->
+          List.iter (fun (b,e) ->
+              fprintf oc "	%s		%a-%a\n" address label b label start;
+              fprintf oc "	%s		%a-%a\n" address label e label start) l
+      in
       section oc Section_debug_ranges;
       print_label oc !debug_ranges_addr;
-      List.iter (fun l ->
-        List.iter (fun (b,e) ->
-          fprintf oc "	%s		%a\n" address label b;
-          fprintf oc "	%s		%a\n" address label e) l;
-        fprintf oc "	%s	0\n" address;
-        fprintf oc "	%s	0\n" address) r
-
-    let print_gnu_entries oc cp (lpc,loc) s r =
-      compute_abbrev cp;
+      List.iter (fun (lbl,l) ->
+          print_label oc (Hashtbl.find range_labels lbl);
+          print_range_entry l;
+          fprintf oc "	%s	0\n" address;
+          fprintf oc "	%s	0\n" address)  r
+
+    let print_gnu_entries oc entries =
+      compute_abbrev entries.gnu_entry;
       let line_start = new_label ()
       and start = new_label ()
       and  abbrev_start = new_label ()
@@ -659,18 +679,18 @@ module DwarfPrinter(Target: DWARF_TARGET):
       debug_ranges_addr := range_label;
       abbrev_start_addr := abbrev_start;
       section oc (Section_debug_info None);
-      print_debug_info oc start line_start cp;
+      print_debug_info oc start line_start entries.gnu_entry;
       print_abbrev oc;
-      list_opt loc (fun () ->
+      list_opt entries.gnu_locs (fun () ->
         section oc Section_debug_loc;
-        print_location_list oc (lpc,loc));
-      list_opt r (fun () ->
-        print_ranges oc r);
+        print_location_list oc entries.several_secs entries.gnu_locs);
+      list_opt entries.range_table (fun () ->
+        print_ranges oc entries.range_table);
       section oc (Section_debug_line None);
       print_label oc line_start;
-      list_opt s (fun () ->
+      list_opt entries.string_table (fun () ->
         section oc Section_debug_str;
-        let s = List.sort (fun (a,_) (b,_) -> Pervasives.compare a b) s in
+        let s = List.sort (fun (a,_) (b,_) -> compare a b) entries.string_table in
         List.iter (fun (id,s) ->
           print_label oc (loc_to_label id);
           fprintf oc "	.asciz		%S\n" s) s)
@@ -679,9 +699,10 @@ module DwarfPrinter(Target: DWARF_TARGET):
     (* Print the debug info and abbrev section *)
     let print_debug oc debug =
       Hashtbl.clear abbrev_mapping;
+      Hashtbl.clear range_labels;
       Hashtbl.clear loc_labels;
       match debug with
       | Diab entries -> print_diab_entries oc entries
-      | Gnu (cp,loc,s,r) -> print_gnu_entries oc cp loc s r
+      | Gnu entries -> print_gnu_entries oc entries
 
   end
diff --git a/debug/DwarfPrinter.mli b/debug/DwarfPrinter.mli
index e1e10601..78dc05fb 100644
--- a/debug/DwarfPrinter.mli
+++ b/debug/DwarfPrinter.mli
@@ -12,7 +12,7 @@
 
 open DwarfTypes
 
-module DwarfPrinter: functor (Target: DWARF_TARGET) ->
+module DwarfPrinter: DWARF_TARGET ->
   sig
     val print_debug: out_channel -> debug_entries -> unit
   end
diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli
index 23aba448..567c65cd 100644
--- a/debug/DwarfTypes.mli
+++ b/debug/DwarfTypes.mli
@@ -266,15 +266,19 @@ type dw_entry =
 
 (* The type for the location list. *)
 type location_entry =
-    {
-     loc:     (address * address * location_value) list;
-     loc_id:  reference;
-   }
-type dw_locations = constant option * location_entry list
+  {
+    loc:     (address * address * location_value) list;
+    loc_id:  reference;
+    loc_sec_begin :  address option;
+  }
+
+type dw_locations = location_entry list
 
-type range_entry = (address * address) list
+type range_entry =
+  | AddressRange  of (address * address) list
+  | OffsetRange of reference * (address * address) list
 
-type dw_ranges = range_entry list
+type dw_ranges = (int * range_entry) list
 
 type dw_string = (int * string) list
 
@@ -283,13 +287,20 @@ type diab_entry =
      section_name: string;
      start_label:  int;
      line_label:   int;
-     entry:        dw_entry;
-     dlocs:        dw_locations;
+     diab_entry:   dw_entry;
+     diab_locs:    dw_locations;
    }
 
 type diab_entries =  diab_entry list
 
-type gnu_entries = dw_entry * dw_locations * dw_string * dw_ranges
+type gnu_entries =
+  {
+    string_table: dw_string;
+    range_table:  dw_ranges;
+    gnu_locs:     dw_locations;
+    gnu_entry:    dw_entry;
+    several_secs: bool;
+  }
 
 type debug_entries =
   | Diab of diab_entries
diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml
index ee568042..6c1d0846 100644
--- a/debug/Dwarfgen.ml
+++ b/debug/Dwarfgen.ml
@@ -72,7 +72,9 @@ let up_locs acc loc =
   {acc with locs = loc@acc.locs;}
 
 let up_ranges acc r =
-  {acc with ranges = r;}
+  let off, old_r = acc.ranges in
+  let new_r = (off +1 ), (off, r):: old_r in
+  (Offset off), {acc with ranges = new_r;}
 
 let empty_accu =
   {
@@ -90,6 +92,8 @@ module Dwarfgenaux (Target: TARGET) =
 
     let subrange_type : int option ref = ref None
 
+    let current_section_start : int option ref = ref None
+
     let encoding_of_ikind = function
       | IBool -> DW_ATE_boolean
       | IChar ->
@@ -340,7 +344,7 @@ module Dwarfgenaux (Target: TARGET) =
 
     let global_variable_to_entry acc id v =
       let loc = match v.gvar_atom with
-      | Some a when is_variable_printed (extern_atom a) ->
+      | Some a when is_symbol_printed (extern_atom a) ->
           Some (LocSymbol a)
       | _ -> None in
       let var = {
@@ -404,7 +408,7 @@ module Dwarfgenaux (Target: TARGET) =
                   and lo = translate_label f_id lo in
                   hi,lo,range_entry_loc i.var_loc) l in
                 let id = next_id () in
-                Some (LocRef id),[{loc = l;loc_id = id;}]
+                Some (LocRef id),[{loc_sec_begin = !current_section_start; loc = l;loc_id = id;}]
           end
         with Not_found -> None,[]
       else
@@ -424,7 +428,7 @@ module Dwarfgenaux (Target: TARGET) =
       let acc = up_locs (up_typs acc p.formal_parameter_type) loc_list in
       new_entry (next_id ()) (DW_TAG_formal_parameter p),acc
 
-    let scope_range f_id id (o,dwr) =
+    let scope_range f_id id acc =
       try
         let r = get_scope_ranges id in
         let lbl l h = match l,h with
@@ -435,19 +439,22 @@ module Dwarfgenaux (Target: TARGET) =
         | _ -> raise Not_found in
         begin
           match r with
-          | [] -> Empty,(o,dwr)
+          | [] -> Empty,acc
           | [a] ->
               let l,h = lbl a.start_addr a.end_addr in
-              Pc_pair (l,h),(o,dwr)
+              Pc_pair (l,h), acc
           | a::rest ->
               if !Clflags.option_gdwarf > 2 then
                 let r = List.map (fun e -> lbl e.start_addr e.end_addr) r in
-                (Offset o), (o + 2 + 4 * (List.length r),r::dwr)
-              else
+                let r = match !current_section_start with
+                  | None -> AddressRange r
+                  | Some s -> OffsetRange (s, r) in
+                up_ranges acc r
+             else
                 let l,h = lbl (List.hd (List.rev rest)).start_addr a.end_addr in
-                Pc_pair (l,h),(o,dwr)
+                Pc_pair (l,h), acc
         end
-      with Not_found -> Empty,(o,dwr)
+      with Not_found -> Empty, acc
 
     let rec local_variable_to_entry f_id acc v id =
       match v.lvar_atom with
@@ -466,11 +473,10 @@ module Dwarfgenaux (Target: TARGET) =
           Some (new_entry id (DW_TAG_variable var)),acc
 
     and scope_to_entry f_id acc sc id =
-      let r,dwr = scope_range f_id id acc.ranges in
+      let r, acc = scope_range f_id id acc in
       let scope = {
         lexical_block_range = r;
       } in
-      let acc = up_ranges acc dwr in
       let vars,acc = mmap_opt (local_to_entry  f_id) acc sc.scope_variables in
       let entry = new_entry id (DW_TAG_lexical_block scope) in
       add_children entry vars,acc
@@ -490,7 +496,7 @@ module Dwarfgenaux (Target: TARGET) =
           | Scope sc -> mmap_opt (local_to_entry f_id) acc sc.scope_variables
           | _ -> assert false)
 
-    let function_to_entry acc id f =
+    let function_to_entry sec_name acc id f =
       let r = match f.fun_low_pc, f.fun_high_pc with
       | Some l,Some h -> Pc_pair (l,h)
       | _ -> Empty in
@@ -503,8 +509,13 @@ module Dwarfgenaux (Target: TARGET) =
         subprogram_range = r;
       } in
       let f_id = get_opt_val f.fun_atom in
+      let start_sec =
+        try
+          Some (section_start (sec_name f_id))
+        with Not_found -> None in
+      current_section_start := start_sec;
       let acc = match f.fun_return_type with Some s -> up_typs acc s | None -> acc in
-      let f_entry =  new_entry id (DW_TAG_subprogram f_tag) in
+      let f_entry = new_entry id (DW_TAG_subprogram f_tag) in
       let children,acc =
         if !Clflags.option_gdepth > 1 then
           let params,acc = mmap (function_parameter_to_entry f_id) acc f.fun_parameter in
@@ -514,10 +525,14 @@ module Dwarfgenaux (Target: TARGET) =
           [],acc in
       add_children f_entry (children),acc
 
-    let definition_to_entry acc id t =
+    let definition_to_entry sec_name acc id t =
       match t with
-      | GlobalVariable g -> global_variable_to_entry acc id g
-      | Function f -> function_to_entry acc id f
+      | GlobalVariable g -> Some (global_variable_to_entry acc id g)
+      | Function f ->
+        if is_symbol_printed f.fun_name then
+          Some (function_to_entry sec_name acc id f)
+        else
+          None
 
   end
 
@@ -529,20 +544,21 @@ let diab_file_loc sec (f,l)  =
 let prod_name =
   let version_string =
     if Version.buildnr <> "" && Version.tag <> "" then
-      Printf.sprintf "%s, Build: %s, Tag: %s" Version.version Version.buildnr Version.tag
+      Printf.sprintf "Release: %s, Build: %s, Tag: %s" Version.version Version.buildnr Version.tag
     else
       Version.version in
   Printf.sprintf "AbsInt Angewandte Informatik GmbH:CompCert Version %s:(%s,%s,%s,%s)"
     version_string Configuration.arch Configuration.system Configuration.abi Configuration.model
 
-let diab_gen_compilation_section s defs acc =
+let diab_gen_compilation_section sec_name s defs acc =
   let module Gen = Dwarfgenaux(struct
     let file_loc = diab_file_loc s
     let string_entry s =  Simple_string s
   end) in
   let defs,accu = List.fold_left (fun (acc,bcc) (id,t) ->
-    let t,bcc = Gen.definition_to_entry bcc id t in
-    t::acc,bcc) ([],empty_accu) defs in
+      match Gen.definition_to_entry sec_name bcc id t with
+      | Some (t,bcc) -> t::acc,bcc
+      | None -> acc,bcc) ([],empty_accu) defs in
   let low_pc = section_start s
   and line_start,debug_start = diab_additional_section s
   and high_pc = section_end s in
@@ -558,8 +574,8 @@ let diab_gen_compilation_section s defs acc =
     section_name = s;
     start_label = debug_start;
     line_label = line_start;
-    entry = cp;
-    dlocs = Some low_pc,accu.locs;
+    diab_entry = cp;
+    diab_locs = accu.locs;
   }::acc
 
 let gen_diab_debug_info sec_name var_section : debug_entries =
@@ -569,7 +585,7 @@ let gen_diab_debug_info sec_name var_section : debug_entries =
     | Function f -> sec_name (get_opt_val f.fun_atom) in
     let old = try StringMap.find s acc with Not_found -> [] in
     StringMap.add s ((id,t)::old) acc) StringMap.empty in
-  let entries = StringMap.fold diab_gen_compilation_section defs [] in
+  let entries = StringMap.fold (diab_gen_compilation_section sec_name) defs [] in
   Diab entries
 
 let gnu_file_loc (f,l) =
@@ -579,7 +595,7 @@ let string_table: (string,int) Hashtbl.t = Hashtbl.create 7
 
 let gnu_string_entry s =
   if (String.length s < 4 && Configuration.system <> "macosx") (* macosx needs debug_str *)
-  || Configuration.system = "cygwin" then (*Cygwin does not use the debug_str seciton*)
+  || Configuration.system = "cygwin" then (*Cygwin does not use the debug_str section*)
     Simple_string s
   else
     try
@@ -592,30 +608,32 @@ let gnu_string_entry s =
 
 let gen_gnu_debug_info sec_name var_section : debug_entries =
   Hashtbl.clear string_table;
-  let r,dwr,low_pc =
-    try if !Clflags.option_gdwarf > 3 then
+  let r,accu,low_pc =
+    try if !Clflags.option_gdwarf > 2 then
         let pcs  = fold_section_start (fun s low acc ->
           (low,section_end s)::acc) [] in
         match pcs with
-        | [] ->  Empty,(0,[]),None
-        | [(l,h)] ->   Pc_pair (l,h),(0,[]),Some l
-        | _ -> Offset 0,(2 + 4 * (List.length pcs),[pcs]),None
+        | [] ->  Empty, empty_accu, None
+        | [(l,h)] ->   Pc_pair (l,h), empty_accu, Some l
+        | _ ->
+          let off, acc = up_ranges empty_accu (AddressRange pcs) in
+          off, acc, None
     else
         let l = section_start ".text"
         and h = section_end ".text" in
-        Pc_pair(l,h),(0,[]),Some l
-    with Not_found ->  Empty,(0,[]),None in
-  let accu = up_ranges empty_accu dwr in
+        Pc_pair(l,h), empty_accu,Some l
+    with Not_found ->  Empty ,empty_accu, None in
   let module Gen = Dwarfgenaux (struct
     let file_loc = gnu_file_loc
     let string_entry = gnu_string_entry
   end) in
-  let defs,accu,sec = fold_definitions (fun  id t (acc,bcc,sec) ->
+  let defs,accu,sec = fold_definitions (fun id t (acc,bcc,sec) ->
     let s = match t with
     | GlobalVariable _ -> var_section
     | Function f -> sec_name (get_opt_val f.fun_atom) in
-    let t,bcc = Gen.definition_to_entry bcc id t in
-    t::acc,bcc,StringSet.add s sec) ([],accu,StringSet.empty) in
+    match Gen.definition_to_entry sec_name bcc id t with
+    | Some (t,bcc) -> t::acc,bcc,StringSet.add s sec
+    | None -> acc, bcc, sec) ([],accu,StringSet.empty) in
   let types = Gen.gen_types accu.typs in
   let cp = {
     compile_unit_name = gnu_string_entry !file_name;
@@ -625,6 +643,12 @@ let gen_gnu_debug_info sec_name var_section : debug_entries =
   } in
   let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in
   let cp = add_children cp (types@defs) in
-  let loc_pc = if StringSet.cardinal sec > 1 then None else low_pc in
   let string_table = Hashtbl.fold (fun s i acc -> (i,s)::acc) string_table [] in
-  Gnu (cp,(loc_pc,accu.locs),string_table,snd accu.ranges)
+  let cp = {
+    string_table = string_table;
+    range_table = snd accu.ranges;
+    gnu_locs = accu.locs;
+    gnu_entry = cp;
+    several_secs = StringSet.cardinal sec > 1}
+  in
+  Gnu cp
diff --git a/doc/ccomp.1 b/doc/ccomp.1
index 374bd2e7..89e8c823 100644
--- a/doc/ccomp.1
+++ b/doc/ccomp.1
@@ -125,7 +125,8 @@ Enabled by default.
 .TP
 .B \-O0
 Turn off most optimizations.
-Synonymous to \fB\-fno\-const\-prop\fP \fB\-fno\-cse\fP \fB\-fno\-redundancy\fP \fB\-fno\-tailcalls\fP.
+Synonymous to \fB\-fno\-const\-prop\fP \fB\-fno\-cse\fP \fB\-fno\-if\-conversion\fP
+\fB\-fno\-inline\fP \fB\-fno\-redundancy\fP \fB\-fno\-tailcalls\fP.
 .
 .TP
 .BR \-O1 ", " \-O2 ", " \-O3
@@ -136,6 +137,13 @@ Synonymous for \fB\-O\fP.
 Optimize for code size in preference to code speed.
 .
 .TP
+.B \-Obranchless
+Optimize to generate fewer conditional branches and use branch-free
+instruction sequences instead.  When \fB-fif\-conversion\fP is
+enabled, the conversion is peformed aggressively even if the resulting
+code is less performant.
+.
+.TP
 .BR \-fconst\-prop ", " \-fno\-const\-prop
 Turn on/off global constant propagation.
 Enabled by default.
@@ -146,6 +154,11 @@ Turn on/off common subexpression elimination.
 Enabled by default.
 .
 .TP
+.BR \-fif\-conversion ", " \-fno\-if\-conversion
+Turn on/off generation of conditional moves.
+Enabled by default.
+.
+.TP
 .BR \-finline ", " \-fno\-inline
 Turn on/off inlining of functions.
 Enabled by default.
@@ -180,6 +193,12 @@ Set alignment of function entry points to <n> bytes.
 The default alignment is 16 bytes for x86 targets and 4 bytes for ARM and PowerPC.
 .
 .TP
+.BR \-fcommon ", " \-fno\-common
+Turn on/off placement of global variables defined without an initializer (tentative definitions) in the common section.
+Disabling the use of the common section inhibits merging of tentative definitions by the linker and may lead to multiple-definition errors.
+Enabled by default.
+.
+.TP
 .BR \-ffpu ", " \-fno\-fpu
 Turn on/off use of FP registers for some integer operations.
 Enabled by default.
@@ -191,12 +210,12 @@ Code Generation Options (PowerPC)
 .TP
 .B \-falign\-branch\-targets <n>
 Set alignment of branch targets to <n> bytes.
-The default alignment is 0 bytes, which deactivates alignment of branch targets.
+By default alignment of branch targets is deactivated.
 .
 .TP
 .B \-falign\-cond\-branches <n>
-Set alignment of conditional branches to <n> bytes.
-The default alignment is 0 bytes, which deactivates alignment of conditional branch targets.
+Set alignment of conditional branch instructions to <n> bytes.
+By default alignment of conditional branches is deactivated.
 .
 .SS
 Code Generation Options (PowerPC with Diab Backend)
@@ -424,9 +443,14 @@ Wrong return type for main.
 Enabled by default.
 .sp
 \fImissing\-declarations\fP:
-Declations which do not declare anything.
+Declarations which do not declare anything.
 Enabled by default.
 .sp
+\fInon\-linear\-cond\-expr\fP:
+Conditional expression that may not be optimized to branchless code.
+Only issued in \fB-Obranchless\fP mode.
+Disabled by default.
+.sp
 \fIpointer\-type\-mismatch\fP:
 Use of incompatible pointer types in conditional expressions.
 Enabled by default.
@@ -461,7 +485,7 @@ Disabled by default.
 .sp
 \fIunused\-variable\fP:
 Unused local variables.
-Enabled by default.
+Disabled by default.
 .sp
 \fIvarargs\fP:
 Promotable vararg arguments.
diff --git a/doc/index.html b/doc/index.html
index edb3accd..5f4ac5e1 100644
--- a/doc/index.html
+++ b/doc/index.html
@@ -24,7 +24,7 @@ a:active {color : Red; text-decoration : underline; }
 
 <H1 align="center">The CompCert verified compiler</H1>
 <H2 align="center">Commented Coq development</H2>
-<H3 align="center">Version 3.5, 2019-02-27</H3>
+<H3 align="center">Version 3.7, 2020-03-31</H3>
 
 <H2>Introduction</H2>
 
@@ -101,6 +101,8 @@ See also: <A HREF="html/compcert.common.Memdata.html">Memdata</A> (in-memory rep
 <LI> <A HREF="html/compcert.common.Determinism.html">Determinism</A>: determinism properties of small-step semantics.
 <LI> <A HREF="html/compcert.powerpc.Op.html"><I>Op</I></A>: operators, addressing modes and their
 semantics.
+<LI> <A HREF="html/compcert.common.Builtins.html">Builtins</A>: semantics of built-in functions. <BR>
+See also: <A HREF="html/compcert.common.Builtins0.html">Builtins0</A> (target-independent part), <A HREF="html/compcert.powerpc.Builtins1.html"><I>Builtins1</I></A> (target-dependent part).
 <LI> <A HREF="html/compcert.common.Unityping.html">Unityping</A>: a solver for atomic unification constraints.
 </UL>
 
@@ -180,7 +182,8 @@ code.
 </TR>
 
 <TR valign="top">
-  <TD>Recognition of operators<br>and addressing modes</TD>
+  <TD>Recognition of operators<br>and addressing modes;<br>
+      if-conversion</TD>
   <TD>Cminor to CminorSel</TD>
   <TD><A HREF="html/compcert.backend.Selection.html">Selection</A><br>
       <A HREF="html/compcert.powerpc.SelectOp.html"><I>SelectOp</I></A><br>
@@ -338,7 +341,8 @@ See also: <A HREF="html/compcert.powerpc.NeedOp.html"><I>NeedOp</I></A>: process
 
 The <A HREF="html/compcert.cfrontend.Ctyping.html">type system of CompCert C</A> is fully formalized.  For some intermediate languages of the back-end, simpler type systems are used to statically capture well-formedness conditions.
 <UL>
-<LI> <A HREF="html/compcert.cfrontend.Ctyping.html">Ctyping</A>: typing for CompCert C + type-checking functions.
+<LI> <A HREF="html/compcert.cfrontend.Ctyping.html">Ctyping</A>: typing for 
+        CompCert C + type-checking functions.
 <LI> <A HREF="html/compcert.backend.RTLtyping.html">RTLtyping</A>: typing for RTL + type
 reconstruction.
 <LI> <A HREF="html/compcert.backend.Lineartyping.html">Lineartyping</A>: typing for Linear.
diff --git a/driver/Clflags.ml b/driver/Clflags.ml
index a886ee9b..2db9399f 100644
--- a/driver/Clflags.ml
+++ b/driver/Clflags.ml
@@ -27,10 +27,13 @@ let option_ftailcalls = ref true
 let option_fconstprop = ref true
 let option_fcse = ref true
 let option_fredundancy = ref true
+let option_fifconversion = ref true
+let option_Obranchless = ref false
 let option_falignfunctions = ref (None: int option)
 let option_falignbranchtargets = ref 0
 let option_faligncondbranchs = ref 0
 let option_finline_asm = ref false
+let option_fcommon = ref true
 let option_mthumb = ref (Configuration.model = "armv7m")
 let option_Osize = ref false
 let option_finline = ref true
diff --git a/driver/Commandline.ml b/driver/Commandline.ml
index 75ca1683..672ed834 100644
--- a/driver/Commandline.ml
+++ b/driver/Commandline.ml
@@ -16,7 +16,6 @@
 (* Parsing of command-line flags and arguments *)
 
 open Printf
-open Responsefile
 
 type pattern =
   | Exact of string
@@ -114,14 +113,15 @@ let parse_array spec argv first last =
     end
   in parse first
 
-let argv : string array ref = ref [||]
+let argv =
+  try
+    Responsefile.expandargv Sys.argv
+  with Responsefile.Error msg | Sys_error msg ->
+    eprintf "Error while processing the command line: %s\n" msg;
+    exit 2
 
 let parse_cmdline spec =
-  try
-    argv := expandargv Sys.argv;
-    parse_array spec !argv 1 (Array.length !argv - 1)
-  with Responsefile.Error s ->
-    raise (CmdError s)
+  parse_array spec argv 1 (Array.length argv - 1)
 
 let long_int_action key s =
   let ls = String.length s
diff --git a/driver/Commandline.mli b/driver/Commandline.mli
index e1b917f2..8bb6f18f 100644
--- a/driver/Commandline.mli
+++ b/driver/Commandline.mli
@@ -39,11 +39,11 @@ type action =
    patterns are tried in the order in which they appear in the list. *)
 
 exception CmdError of string
-(** Raise by [parse_cmdline] when an error occured *)
+(** Raise by [parse_cmdline] when an error occurred *)
 
 val parse_cmdline: (pattern * action) list -> unit
-(** [parse_cmdline actions] parses the commandline and performs all [actions].
-    Raises [CmdError] if an error occurred.
+(** [parse_cmdline actions] parses the command line (after @-file expansion)
+    and performs all [actions].  Raises [CmdError] if an error occurred.
 *)
 
 val longopt_int: string -> (int -> unit) -> pattern * action
@@ -51,5 +51,5 @@ val longopt_int: string -> (int -> unit) -> pattern * action
     options of the form [key=<n>] and calls [fn] with the integer argument
 *)
 
-val argv: string array ref
+val argv: string array
 (** [argv] contains the complete command line after @-file expandsion *)
diff --git a/driver/CommonOptions.ml b/driver/CommonOptions.ml
index 58dd4007..c151ecf2 100644
--- a/driver/CommonOptions.ml
+++ b/driver/CommonOptions.ml
@@ -14,9 +14,9 @@ open Clflags
 open Commandline
 
 (* The version string for [tool_name] *)
-let version_string tool_name=
+let version_string tool_name =
   if Version.buildnr <> "" && Version.tag <> "" then
-    Printf.sprintf "The CompCert %s, %s, Build: %s, Tag: %s\n" tool_name Version.version Version.buildnr Version.tag
+    Printf.sprintf "The CompCert %s, Release: %s, Build: %s, Tag: %s\n" tool_name Version.version Version.buildnr Version.tag
   else
     Printf.sprintf "The CompCert %s, version %s\n" tool_name Version.version
 
diff --git a/driver/Configuration.ml b/driver/Configuration.ml
index 972fd295..2188acf0 100644
--- a/driver/Configuration.ml
+++ b/driver/Configuration.ml
@@ -13,11 +13,11 @@
 open Printf
 
 let search_argv key =
-  let len = Array.length Sys.argv in
+  let len = Array.length Commandline.argv in
   let res: string option ref = ref None in
   for i = 1 to len - 2 do
-    if Sys.argv.(i) = key then
-      res := Some Sys.argv.(i + 1);
+    if Commandline.argv.(i) = key then
+      res := Some Commandline.argv.(i + 1);
   done;
   !res
 
@@ -123,7 +123,7 @@ let get_bool_config key =
 
 let arch =
   match get_config_string "arch" with
-  | "powerpc"|"arm"|"x86"|"riscV" as a -> a
+  | "powerpc"|"arm"|"x86"|"riscV"|"aarch64" as a -> a
   | v -> bad_config "arch" [v]
 let model = get_config_string "model"
 let abi = get_config_string "abi"
diff --git a/driver/Driver.ml b/driver/Driver.ml
index 8ab8557c..be1252f9 100644
--- a/driver/Driver.ml
+++ b/driver/Driver.ml
@@ -187,6 +187,8 @@ Processing options:
   -O0            Do not optimize the compiled code
   -O1 -O2 -O3    Synonymous for -O
   -Os            Optimize for code size in preference to code speed
+  -Obranchless   Optimize to generate fewer conditional branches; try to produce
+                 branch-free instruction sequences as much as possible
   -ftailcalls    Optimize function calls in tail position [on]
   -fconst-prop   Perform global constant propagation  [on]
   -ffloat-const-prop <n>  Control constant propagation of floats
@@ -196,6 +198,7 @@ Processing options:
   -finline       Perform inlining of functions [on]
   -finline-functions-called-once Integrate functions only required by their
                  single caller [on]
+  -fif-conversion Perform if-conversion (generation of conditional moves) [on]
 Code generation options: (use -fno-<opt> to turn off -f<opt>)
   -ffpu          Use FP registers for some integer operations [on]
   -fsmall-data <n>  Set maximal size <n> for allocation in small data area
@@ -203,6 +206,7 @@ Code generation options: (use -fno-<opt> to turn off -f<opt>)
   -falign-functions <n>  Set alignment (in bytes) of function entry points
   -falign-branch-targets <n>  Set alignment (in bytes) of branch targets
   -falign-cond-branches <n>  Set alignment (in bytes) of conditional branches
+  -fcommon       Put uninitialized globals in the common section [on].
 |} ^
  target_help ^
  toolchain_help ^
@@ -249,7 +253,8 @@ let dump_mnemonics destfile =
   exit 0
 
 let optimization_options = [
-  option_ftailcalls; option_fconstprop; option_fcse; option_fredundancy; option_finline_functions_called_once;
+  option_ftailcalls; option_fifconversion; option_fconstprop; option_fcse;
+  option_fredundancy; option_finline; option_finline_functions_called_once;
 ]
 
 let set_all opts () = List.iter (fun r -> r := true) opts
@@ -262,6 +267,10 @@ let num_input_files = ref 0
 let cmdline_actions =
   let f_opt name ref =
     [Exact("-f" ^ name), Set ref; Exact("-fno-" ^ name), Unset ref] in
+  let check_align n =
+    if n <= 0 || ((n land (n - 1)) <> 0) then
+      error no_loc "requested alignment %d is not a power of 2" n
+    in
   [
 (* Getting help *)
   Exact "-help", Unit print_usage_and_exit;
@@ -294,12 +303,14 @@ let cmdline_actions =
   Exact "-O", Unit (set_all optimization_options);
   _Regexp "-O[123]$", Unit (set_all optimization_options);
   Exact "-Os", Set option_Osize;
+  Exact "-Obranchless", Set option_Obranchless;
   Exact "-fsmall-data", Integer(fun n -> option_small_data := n);
   Exact "-fsmall-const", Integer(fun n -> option_small_const := n);
-  Exact "-ffloat-const-prop", Integer(fun n -> option_ffloatconstprop := n);
-  Exact "-falign-functions", Integer(fun n -> option_falignfunctions := Some n);
-  Exact "-falign-branch-targets", Integer(fun n -> option_falignbranchtargets := n);
-  Exact "-falign-cond-branches", Integer(fun n -> option_faligncondbranchs := n);] @
+  Exact "-ffloat-const-prop", Integer(fun n -> option_ffloatconstprop := n); 
+  Exact "-falign-functions", Integer(fun n -> check_align n; option_falignfunctions := Some n);
+  Exact "-falign-branch-targets", Integer(fun n -> check_align n; option_falignbranchtargets := n);
+  Exact "-falign-cond-branches", Integer(fun n -> check_align n; option_faligncondbranchs := n);] @
+      f_opt "common" option_fcommon @
 (* Target processor options *)
   (if Configuration.arch = "arm" then
     if Configuration.model = "armv6" then
@@ -358,6 +369,7 @@ let cmdline_actions =
 (* Optimization options *)
 (* -f options: come in -f and -fno- variants *)
   @ f_opt "tailcalls" option_ftailcalls
+  @ f_opt "if-conversion" option_fifconversion
   @ f_opt "const-prop" option_fconstprop
   @ f_opt "cse" option_fcse
   @ f_opt "redundancy" option_fredundancy
diff --git a/driver/Frontend.ml b/driver/Frontend.ml
index 929d9fd7..74791247 100644
--- a/driver/Frontend.ml
+++ b/driver/Frontend.ml
@@ -116,9 +116,10 @@ let init () =
     | "riscV"   -> if Configuration.model = "64"
                    then Machine.rv64
                    else Machine.rv32
+    | "aarch64" -> Machine.aarch64
     | _         -> assert false
   end;
-  Builtins.set C2C.builtins;
+  Env.set_builtins C2C.builtins;
   Cutil.declare_attributes C2C.attributes;
   CPragmas.initialize()
 
@@ -131,7 +132,7 @@ let gnu_prepro_opt_key key s =
 let gnu_prepro_opt s =
   prepro_options := s::!prepro_options
 
-(* Add gnu preprocessor option s and the implict -E *)
+(* Add gnu preprocessor option s and the implicit -E *)
 let gnu_prepro_opt_e s =
   prepro_options := s :: !prepro_options;
   option_E := true
@@ -171,7 +172,7 @@ let prepro_actions = [
   @ (if Configuration.gnu_toolchain then gnu_prepro_actions else [])
 
 let gnu_prepro_help =
-{|  -M            Ouput a rule suitable for make describing the
+{|  -M            Output a rule suitable for make describing the
                  dependencies of the main source file
   -MM            Like -M but do not mention system header files
   -MF <file>     Specifies file <file> as output file for -M or -MM
diff --git a/driver/Interp.ml b/driver/Interp.ml
index 6760e76c..d4286779 100644
--- a/driver/Interp.ml
+++ b/driver/Interp.ml
@@ -15,12 +15,12 @@
 open Format
 open Camlcoq
 open AST
-open Integers
+open! Integers
 open Values
 open Memory
 open Globalenvs
 open Events
-open Ctypes
+open! Ctypes
 open Csyntax
 open Csem
 
@@ -145,7 +145,7 @@ let print_state p (prog, ge, s) =
 let compare_mem m1 m2 =
   (* assumes nextblocks were already compared equal *)
   (* should permissions be taken into account? *)
-  Pervasives.compare m1.Mem.mem_contents m2.Mem.mem_contents
+  compare m1.Mem.mem_contents m2.Mem.mem_contents
 
 (* Comparing continuations *)
 
diff --git a/exportclight/Clightgen.ml b/exportclight/Clightgen.ml
index 1eb4fe03..f7279a5e 100644
--- a/exportclight/Clightgen.ml
+++ b/exportclight/Clightgen.ml
@@ -45,12 +45,7 @@ let compile_c_ast sourcename csyntax ofile =
     | Errors.Error msg ->
       fatal_error loc "%a" print_error msg in
   (* Dump Clight in C syntax if requested *)
-  if !option_dclight then begin
-    let ofile = Filename.chop_suffix sourcename ".c" ^ ".light.c" in
-    let oc = open_out ofile in
-    PrintClight.print_program (Format.formatter_of_out_channel oc) clight;
-    close_out oc
-  end;
+  PrintClight.print_if_2 clight;
   (* Print Clight in Coq syntax *)
   let oc = open_out ofile in
   ExportClight.print_program (Format.formatter_of_out_channel oc)
@@ -60,6 +55,12 @@ let compile_c_ast sourcename csyntax ofile =
 (* From C source to Clight *)
 
 let compile_c_file sourcename ifile ofile =
+  let set_dest dst opt ext =
+    dst := if !opt then Some (output_filename sourcename ".c" ext)
+      else None in
+  set_dest Cprint.destination option_dparse ".parsed.c";
+  set_dest PrintCsyntax.destination option_dcmedium ".compcert.c";
+  set_dest PrintClight.destination option_dclight ".light.c";
   compile_c_ast sourcename (parse_c_file sourcename ifile) ofile
 
 let output_filename sourcename suff =
@@ -74,7 +75,10 @@ let process_c_file sourcename =
   if !option_E then begin
     preprocess sourcename "-"
   end else begin
-    let preproname = Driveraux.tmp_file ".i" in
+    let preproname = if !option_dprepro then
+        Driveraux.output_filename sourcename ".c" ".i"
+      else
+        Driveraux.tmp_file ".i" in
     preprocess sourcename preproname;
     compile_c_file sourcename preproname ofile
   end
@@ -100,9 +104,11 @@ Processing options:
 prepro_help ^
 language_support_help ^
 {|Tracing options:
+  -dprepro       Save C file after preprocessing in <file>.i
   -dparse        Save C file after parsing and elaboration in <file>.parsed.c
   -dc            Save generated Compcert C in <file>.compcert.c
   -dclight       Save generated Clight in <file>.light.c
+  -dall          Save all generated intermediate files in <file>.<ext>
 |} ^
   general_help ^
   warning_help
@@ -142,9 +148,16 @@ let cmdline_actions =
 (* Preprocessing options *)
   @ prepro_actions @
 (* Tracing options *)
- [ Exact "-dparse", Set option_dparse;
-  Exact "-dc", Set option_dcmedium;
-  Exact "-dclight", Set option_dclight;]
+  [ Exact "-dprepro", Set option_dprepro;
+   Exact "-dparse", Set option_dparse;
+   Exact "-dc", Set option_dcmedium;
+   Exact "-dclight", Set option_dclight;
+   Exact "-dall", Self (fun _ ->
+       option_dprepro := true;
+       option_dparse := true;
+       option_dcmedium := true;
+       option_dclight := true;);
+ ]
   @ general_options
 (* Diagnostic options *)
   @ warning_options
diff --git a/exportclight/ExportClight.ml b/exportclight/ExportClight.ml
index b124586a..c9d6fced 100644
--- a/exportclight/ExportClight.ml
+++ b/exportclight/ExportClight.ml
@@ -18,7 +18,7 @@
 open Format
 open Camlcoq
 open AST
-open Ctypes
+open! Ctypes
 open Cop
 open Clight
 
@@ -221,6 +221,14 @@ let asttype p t =
       | AST.Tany32 -> "AST.Tany32"
       | AST.Tany64 -> "AST.Tany64")
 
+let astrettype p = function
+  | AST.Tret t -> asttype p t
+  | AST.Tvoid -> fprintf p "AST.Tvoid"
+  | AST.Tint8signed -> fprintf p "AST.Tint8signed"
+  | AST.Tint8unsigned -> fprintf p "AST.Tint8unsigned"
+  | AST.Tint16signed -> fprintf p "AST.Tint16signed"
+  | AST.Tint16unsigned -> fprintf p "AST.Tint16unsigned"
+
 let name_of_chunk = function
   | Mint8signed -> "Mint8signed"
   | Mint8unsigned -> "Mint8unsigned"
@@ -236,7 +244,7 @@ let name_of_chunk = function
 let signatur p sg =
   fprintf p "@[<hov 2>(mksignature@ %a@ %a@ %a)@]"
      (print_list asttype) sg.sig_args
-     (print_option asttype) sg.sig_res
+     astrettype sg.sig_res
      callconv sg.sig_cc
 
 let assertions = ref ([]: (string * typ list) list)
@@ -381,7 +389,7 @@ and lblstmts p = function
               (print_option coqZ) lbl stmt s lblstmts ls
 
 let print_function p (id, f) =
-  fprintf p "Definition f_%s := {|@ " (extern_atom id);
+  fprintf p "Definition f_%s := {|@ " (sanitize (extern_atom id));
   fprintf p "  fn_return := %a;@ " typ f.fn_return;
   fprintf p "  fn_callconv := %a;@ " callconv f.fn_callconv;
   fprintf p "  fn_params := %a;@ " (print_list (print_pair ident typ)) f.fn_params;
@@ -402,7 +410,7 @@ let init_data p = function
   | Init_addrof(id,ofs) -> fprintf p "Init_addrof %a %a" ident id coqptrofs ofs
 
 let print_variable p (id, v) =
-  fprintf p "Definition v_%s := {|@ " (extern_atom id);
+  fprintf p "Definition v_%s := {|@ " (sanitize (extern_atom id));
   fprintf p "  gvar_info := %a;@ " typ v.gvar_info;
   fprintf p "  gvar_init := %a;@ " (print_list init_data) v.gvar_init;
   fprintf p "  gvar_readonly := %B;@ " v.gvar_readonly;
@@ -417,12 +425,12 @@ let print_globdef p (id, gd) =
 
 let print_ident_globdef p = function
   | (id, Gfun(Ctypes.Internal f)) ->
-      fprintf p "(%a, Gfun(Internal f_%s))" ident id (extern_atom id)
+      fprintf p "(%a, Gfun(Internal f_%s))" ident id (sanitize (extern_atom id))
   | (id, Gfun(Ctypes.External(ef, targs, tres, cc))) ->
       fprintf p "@[<hov 2>(%a,@ @[<hov 2>Gfun(External %a@ %a@ %a@ %a))@]@]"
         ident id external_function ef typlist targs typ tres callconv cc
   | (id, Gvar v) ->
-      fprintf p "(%a, Gvar v_%s)" ident id (extern_atom id)
+      fprintf p "(%a, Gvar v_%s)" ident id (sanitize (extern_atom id))
 
 (* Composite definitions *)
 
diff --git a/extraction/extraction.v b/extraction/extraction.v
index 15a64d89..521c0cdd 100644
--- a/extraction/extraction.v
+++ b/extraction/extraction.v
@@ -34,7 +34,6 @@ Require Clight.
 Require Compiler.
 Require Parser.
 Require Initializers.
-Require Int31.
 
 (* Standard lib *)
 Require Import ExtrOcamlBasic.
@@ -72,6 +71,7 @@ Extract Constant Iteration.GenIter.iterate =>
 (* Selection *)
 
 Extract Constant Selection.compile_switch => "Switchaux.compile_switch".
+Extract Constant Selection.if_conversion_heuristic => "Selectionaux.if_conversion_heuristic".
 
 (* RTLgen *)
 Extract Constant RTLgen.more_likely => "RTLgenaux.more_likely".
@@ -127,7 +127,7 @@ Extract Constant Compiler.time  => "Timing.time_coq".
 (*Extraction Inline Compiler.apply_total Compiler.apply_partial.*)
 
 (* Cabs *)
-Extract Constant Cabs.cabsloc =>
+Extract Constant Cabs.loc =>
 "{ lineno : int;
    filename: string;
    byteno: int;
@@ -136,15 +136,6 @@ Extract Constant Cabs.cabsloc =>
 Extract Inlined Constant Cabs.string => "String.t".
 Extract Constant Cabs.char_code => "int64".
 
-(* Int31 *)
-Extract Inductive Int31.digits => "bool" [ "false" "true" ].
-Extract Inductive Int31.int31 => "int" [ "Camlcoq.Int31.constr" ] "Camlcoq.Int31.destr".
-Extract Constant Int31.twice => "Camlcoq.Int31.twice".
-Extract Constant Int31.twice_plus_one => "Camlcoq.Int31.twice_plus_one".
-Extract Constant Int31.compare31 => "Camlcoq.Int31.compare".
-Extract Constant Int31.On => "0".
-Extract Constant Int31.In => "1".
-
 (* Processor-specific extraction directives *)
 
 Load extractionMachdep.
@@ -171,9 +162,10 @@ Separate Extraction
    Cexec.do_initial_state Cexec.do_step Cexec.at_final_state
    Ctypes.merge_attributes Ctypes.remove_attributes Ctypes.build_composite_env
    Initializers.transl_init Initializers.constval
-   Csyntax.Eindex Csyntax.Epreincr
+   Csyntax.Eindex Csyntax.Epreincr Csyntax.Eselection
    Ctyping.typecheck_program
    Ctyping.epostincr Ctyping.epostdecr Ctyping.epreincr Ctyping.epredecr
+   Ctyping.eselection
    Ctypes.make_program
    Clight.type_of_function
    Conventions1.callee_save_type Conventions1.is_float_reg
diff --git a/flocq/IEEE754/Binary.v b/flocq/IEEE754/Binary.v
index 0ec3a297..ac38c761 100644
--- a/flocq/IEEE754/Binary.v
+++ b/flocq/IEEE754/Binary.v
@@ -1839,6 +1839,127 @@ now rewrite <- cond_Zopp_negb.
 now destruct y as [ | | | ].
 Qed.
 
+(** Fused Multiply-Add *)
+
+Definition Bfma_szero m (x y z: binary_float) : bool :=
+  let s_xy := xorb (Bsign x) (Bsign y) in  (* sign of product x*y *)
+  if Bool.eqb s_xy (Bsign z) then s_xy
+  else match m with mode_DN => true | _ => false end.
+
+Definition Bfma fma_nan m (x y z: binary_float) :=
+  match x, y with
+  | B754_nan _ _ _, _ | _, B754_nan _ _ _
+  | B754_infinity _, B754_zero _
+  | B754_zero _, B754_infinity _ =>
+      (* Multiplication produces NaN *)
+      build_nan (fma_nan x y z)
+  | B754_infinity sx, B754_infinity sy
+  | B754_infinity sx, B754_finite sy _ _ _
+  | B754_finite sx _ _ _, B754_infinity sy =>
+      let s := xorb sx sy in
+      (* Multiplication produces infinity with sign [s] *)
+      match z with
+      | B754_nan _ _ _ => build_nan (fma_nan x y z)
+      | B754_infinity sz =>
+          if Bool.eqb s sz then z else build_nan (fma_nan x y z)
+      | _ => B754_infinity s
+      end
+  | B754_finite sx _ _ _, B754_zero sy
+  | B754_zero sx, B754_finite sy _ _ _
+  | B754_zero sx, B754_zero sy =>
+      (* Multiplication produces zero *)
+      match z with
+      | B754_nan _ _ _ => build_nan (fma_nan x y z)
+      | B754_zero _ => B754_zero (Bfma_szero m x y z)
+      | _ => z
+      end
+  | B754_finite sx mx ex _, B754_finite sy my ey _ =>
+      (* Multiplication produces a finite, non-zero result *)
+      match z with
+      | B754_nan _ _ _ => build_nan (fma_nan x y z)
+      | B754_infinity sz => z
+      | B754_zero _ =>
+         let X := Float radix2 (cond_Zopp sx (Zpos mx)) ex in
+         let Y := Float radix2 (cond_Zopp sy (Zpos my)) ey in
+         let '(Float _ mr er) := Fmult X Y in
+         binary_normalize m mr er (Bfma_szero m x y z)
+      | B754_finite sz mz ez _ =>
+         let X := Float radix2 (cond_Zopp sx (Zpos mx)) ex in
+         let Y := Float radix2 (cond_Zopp sy (Zpos my)) ey in
+         let Z := Float radix2 (cond_Zopp sz (Zpos mz)) ez in
+         let '(Float _ mr er) := Fplus (Fmult X Y) Z in
+         binary_normalize m mr er (Bfma_szero m x y z)
+      end
+  end.
+
+Theorem Bfma_correct:
+  forall fma_nan m x y z,
+  let res := (B2R x * B2R y + B2R z)%R in
+  is_finite x = true ->
+  is_finite y = true ->
+  is_finite z = true ->
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) res)) (bpow radix2 emax) then
+    B2R (Bfma fma_nan m x y z) = round radix2 fexp (round_mode m) res /\
+    is_finite (Bfma fma_nan m x y z) = true /\
+    Bsign (Bfma fma_nan m x y z) =
+      match Rcompare res 0 with
+        | Eq => Bfma_szero m x y z
+        | Lt => true
+        | Gt => false
+      end
+  else
+    B2FF (Bfma fma_nan m x y z) = binary_overflow m (Rlt_bool res 0).
+Proof.
+  intros. pattern (Bfma fma_nan m x y z).
+  match goal with |- ?p ?x => set (PROP := p) end.
+  set (szero := Bfma_szero m x y z).
+  assert (BINORM: forall mr er, F2R (Float radix2 mr er) = res ->
+       PROP (binary_normalize m mr er szero)).
+  { intros mr er E.
+    specialize (binary_normalize_correct m mr er szero).
+    change (FLT_exp (3 - emax - prec) prec) with fexp. rewrite E. tauto.
+  }
+  set (add_zero :=
+    match z with
+    | B754_nan _ _ _ => build_nan (fma_nan x y z)
+    | B754_zero sz => B754_zero szero
+    | _ => z
+    end).
+  assert (ADDZERO: B2R x = 0%R \/ B2R y = 0%R -> PROP add_zero).
+  {
+    intros Z.
+    assert (RES: res = B2R z).
+    { unfold res. destruct Z as [E|E]; rewrite E, ?Rmult_0_l, ?Rmult_0_r, Rplus_0_l; auto. }
+    unfold PROP, add_zero; destruct z as [ sz | sz | sz plz | sz mz ez Bz]; try discriminate.
+  - simpl in RES; rewrite RES; rewrite round_0 by apply valid_rnd_round_mode.
+    rewrite Rlt_bool_true. split. reflexivity. split. reflexivity.
+    rewrite Rcompare_Eq by auto. reflexivity.
+    rewrite Rabs_R0; apply bpow_gt_0.
+  - rewrite RES, round_generic, Rlt_bool_true.
+    split. reflexivity. split. reflexivity.
+    unfold B2R. destruct sz.
+    rewrite Rcompare_Lt. auto. apply F2R_lt_0. reflexivity.
+    rewrite Rcompare_Gt. auto. apply F2R_gt_0. reflexivity.
+    apply abs_B2R_lt_emax. apply valid_rnd_round_mode. apply generic_format_B2R.
+  }
+  destruct x as [ sx | sx | sx plx | sx mx ex Bx];
+  destruct y as [ sy | sy | sy ply | sy my ey By];
+  try discriminate.
+- apply ADDZERO; auto.
+- apply ADDZERO; auto.
+- apply ADDZERO; auto.
+- destruct z as [ sz | sz | sz plz | sz mz ez Bz]; try discriminate; unfold Bfma.
++ set (X := Float radix2 (cond_Zopp sx (Zpos mx)) ex).
+  set (Y := Float radix2 (cond_Zopp sy (Zpos my)) ey).
+  destruct (Fmult X Y) as [mr er] eqn:FRES.
+  apply BINORM. unfold res. rewrite <- FRES, F2R_mult, Rplus_0_r. auto.
++ set (X := Float radix2 (cond_Zopp sx (Zpos mx)) ex).
+  set (Y := Float radix2 (cond_Zopp sy (Zpos my)) ey).
+  set (Z := Float radix2 (cond_Zopp sz (Zpos mz)) ez).
+  destruct (Fplus (Fmult X Y) Z) as [mr er] eqn:FRES.
+  apply BINORM. unfold res. rewrite <- FRES, F2R_plus, F2R_mult. auto.
+Qed.
+
 (** Division *)
 
 Definition Fdiv_core_binary m1 e1 m2 e2 :=
diff --git a/flocq/Prop/Div_sqrt_error.v b/flocq/Prop/Div_sqrt_error.v
index 76c7af95..79220438 100644
--- a/flocq/Prop/Div_sqrt_error.v
+++ b/flocq/Prop/Div_sqrt_error.v
@@ -366,7 +366,7 @@ unfold Rdiv; apply (Rplus_le_reg_r (/ sqrt (1 + 2 * u_ro))); ring_simplify.
 apply (Rmult_le_reg_r (sqrt (1 + 4 * u_ro) * sqrt (1 + 2 * u_ro))).
 { apply Rmult_lt_0_compat; apply sqrt_lt_R0; lra. }
 field_simplify; [|split; apply Rgt_not_eq, Rlt_gt, sqrt_lt_R0; lra].
-unfold Rdiv; rewrite Rinv_1, !Rmult_1_r.
+try unfold Rdiv; rewrite ?Rinv_1, ?Rmult_1_r.
 apply Rsqr_incr_0_var; [|now apply Rmult_le_pos; apply sqrt_pos].
 rewrite <-sqrt_mult; [|lra|lra].
 rewrite Rsqr_sqrt; [|apply Rmult_le_pos; lra].
@@ -409,7 +409,7 @@ assert (Pu_ro := u_ro_pos beta prec).
 apply (Rmult_le_reg_r (sqrt (1 + 2 * u_ro) * (1 + u_ro))).
 { apply Rmult_lt_0_compat; [apply sqrt_lt_R0|]; lra. }
 field_simplify; [|lra|intro H; apply sqrt_eq_0 in H; lra].
-unfold Rdiv, Rminus; rewrite Rinv_1, !Rmult_1_r, !Rplus_assoc.
+try unfold Rdiv; unfold Rminus; rewrite ?Rinv_1, ?Rmult_1_r, !Rplus_assoc.
 rewrite <-(Rplus_0_r (sqrt _ * _)) at 2; apply Rplus_le_compat_l.
 apply (Rplus_le_reg_r (1 + u_ro)); ring_simplify.
 rewrite <-(sqrt_square (_ + 1)); [|lra]; apply sqrt_le_1_alt.
diff --git a/flocq/Prop/Relative.v b/flocq/Prop/Relative.v
index b936f2f7..5f87bd84 100644
--- a/flocq/Prop/Relative.v
+++ b/flocq/Prop/Relative.v
@@ -566,7 +566,7 @@ assert (H : (Rabs ((rx - x) / x) <= u_ro / (1 + u_ro))%R).
     now rewrite (Rabs_Rinv _ Nzx); apply Rinv_le. }
   apply (Rmult_le_reg_r ((ufpx + Rabs (rx - x)) * (1 + u_ro))).
   { apply Rmult_lt_0_compat; lra. }
-  field_simplify; [unfold Rdiv; rewrite Rinv_1, !Rmult_1_r| |]; lra. }
+  field_simplify; [try unfold Rdiv; rewrite ?Rinv_1, ?Rmult_1_r| |]; lra. }
 revert H; unfold Rdiv; rewrite Rabs_mult, (Rabs_Rinv _ Nzx); intro H.
 apply (Rmult_le_reg_r (/ Rabs x)); [now apply Rinv_0_lt_compat, Rabs_pos_lt|].
 now apply (Rle_trans _ _ _ H); right; field; split; [apply Rabs_no_R0|lra].
diff --git a/lib/BoolEqual.v b/lib/BoolEqual.v
index c9e7bad5..e8c1d831 100644
--- a/lib/BoolEqual.v
+++ b/lib/BoolEqual.v
@@ -106,8 +106,8 @@ Ltac bool_eq_refl_case :=
   end.
 
 Ltac bool_eq_refl :=
-  let H := fresh "Hrec" in let x := fresh "x" in
-  fix H 1; intros x; destruct x; simpl; bool_eq_refl_case.
+  let Hrec := fresh "Hrec" in let x := fresh "x" in
+  fix Hrec 1; intros x; destruct x; simpl; bool_eq_refl_case.
 
 Lemma false_not_true:
   forall (P: Prop), false = true -> P.
@@ -124,7 +124,6 @@ Qed.
 
 Ltac bool_eq_sound_case :=
   match goal with
-  | [ H: false = true |- _ ] => exact (false_not_true _ H)
   | [ H: _ && _ = true |- _ ] => apply andb_prop in H; destruct H; bool_eq_sound_case
   | [ H: proj_sumbool ?a = true |- _ ] => apply proj_sumbool_true in H; bool_eq_sound_case
   | [ |- ?C ?x1 ?x2 ?x3 ?x4 = ?C ?y1 ?y2 ?y3 ?y4 ] => apply f_equal4; auto
@@ -137,7 +136,9 @@ Ltac bool_eq_sound_case :=
 
 Ltac bool_eq_sound :=
   let Hrec := fresh "Hrec" in let x := fresh "x" in let y := fresh "y" in
-  fix Hrec 1; intros x y; destruct x, y; simpl; intro; bool_eq_sound_case.
+  let H := fresh "EQ" in
+  fix Hrec 1; intros x y; destruct x, y; intro H;
+  try (apply (false_not_true _ H)); simpl in H; bool_eq_sound_case.
 
 Lemma dec_eq_from_bool_eq:
   forall (A: Type) (f: A -> A -> bool)
diff --git a/lib/Camlcoq.ml b/lib/Camlcoq.ml
index d94e3582..66322efb 100644
--- a/lib/Camlcoq.ml
+++ b/lib/Camlcoq.ml
@@ -335,54 +335,3 @@ let coqfloat32_of_camlfloat f =
   Float32.of_bits(coqint_of_camlint(Int32.bits_of_float f))
 let camlfloat_of_coqfloat32 f =
   Int32.float_of_bits(camlint_of_coqint(Float32.to_bits f))
-
-(* Int31 *)
-
-module Int31 = struct
-
-(*
-let constr (b30,b29,b28,b27,b26,b25,b24,
-            b23,b22,b21,b20,b19,b18,b17,b16,
-            b15,b14,b13,b12,b11,b10,b9,b8,
-            b7,b6,b5,b4,b3,b2,b1,b0) =
-  let f i b accu = if b then accu + (1 lsl i) else accu in
-  f 30 b30 (f 29 b29 (f 28 b28 (f 27 b27 (f 26 b26 (f 25 b25 (f 24 b24
-  (f 23 b23 (f 22 b22 (f 21 b21 (f 20 b20 (f 19 b19 (f 18 b18 (f 17 b17 (f 16 b16
-  (f 15 b15 (f 14 b14 (f 13 b13 (f 12 b12 (f 11 b11 (f 10 b10 (f 9 b9 (f 8 b8
-  (f 7 b7 (f 6 b6 (f 5 b5 (f 4 b4 (f 3 b3 (f 2 b2 (f 1 b1 (f 0 b0 0))))))))))))))))))))))))))))))
-*)
-
-let constr (b30,b29,b28,b27,b26,b25,b24,
-            b23,b22,b21,b20,b19,b18,b17,b16,
-            b15,b14,b13,b12,b11,b10,b9,b8,
-            b7,b6,b5,b4,b3,b2,b1,b0) =
-  let f i b = if b then 1 lsl i else 0 in
-  f 30 b30 + f 29 b29 + f 28 b28 + f 27 b27 + f 26 b26 + f 25 b25 + f 24 b24 +
-  f 23 b23 + f 22 b22 + f 21 b21 + f 20 b20 + f 19 b19 + f 18 b18 + f 17 b17 + f 16 b16 +
-  f 15 b15 + f 14 b14 + f 13 b13 + f 12 b12 + f 11 b11 + f 10 b10 + f 9 b9 + f 8 b8 +
-  f 7 b7 + f 6 b6 + f 5 b5 + f 4 b4 + f 3 b3 + f 2 b2 + f 1 b1 + f 0 b0
-
-let destr f n =
-  let b i = n land (1 lsl i) <> 0 in
-  f (b 30) (b 29) (b 28) (b 27) (b 26) (b 25) (b 24)
-    (b 23) (b 22) (b 21) (b 20) (b 19) (b 18) (b 17) (b 16)
-    (b 15) (b 14) (b 13) (b 12) (b 11) (b 10) (b 9) (b 8)
-    (b 7) (b 6) (b 5) (b 4) (b 3) (b 2) (b 1) (b 0)
-
-let twice n =
-  (n lsl 1) land 0x7FFFFFFF
-
-let twice_plus_one n =
-  ((n lsl 1) land 0x7FFFFFFF) lor 1
-
-let compare (x:int) (y:int) =
-  if x = y then Datatypes.Eq
-  else begin
-    let sx = x < 0 and sy = y < 0 in
-    if sx = sy then
-      (if x < y then Datatypes.Lt else Datatypes.Gt)
-    else
-      (if sx then Datatypes.Gt else Datatypes.Lt)
-  end
-
-end
diff --git a/lib/Coqlib.v b/lib/Coqlib.v
index 3b8e5b3b..02c5d07f 100644
--- a/lib/Coqlib.v
+++ b/lib/Coqlib.v
@@ -411,42 +411,12 @@ Qed.
 
 (** Properties of Euclidean division and modulus. *)
 
-Lemma Zdiv_small:
-  forall x y, 0 <= x < y -> x / y = 0.
-Proof.
-  intros. assert (y > 0). omega.
-  assert (forall a b,
-    0 <= a < y ->
-    0 <= y * b + a < y ->
-    b = 0).
-  intros.
-  assert (b = 0 \/ b > 0 \/ (-b) > 0). omega.
-  elim H3; intro.
-  auto.
-  elim H4; intro.
-  assert (y * b >= y * 1). apply Zmult_ge_compat_l. omega. omega.
-  omegaContradiction.
-  assert (y * (-b) >= y * 1). apply Zmult_ge_compat_l. omega. omega.
-  rewrite <- Zopp_mult_distr_r in H6. omegaContradiction.
-  apply H1 with (x mod y).
-  apply Z_mod_lt. auto.
-  rewrite <- Z_div_mod_eq. auto. auto.
-Qed.
-
-Lemma Zmod_small:
-  forall x y, 0 <= x < y -> x mod y = x.
-Proof.
-  intros. assert (y > 0). omega.
-  generalize (Z_div_mod_eq x y H0).
-  rewrite (Zdiv_small x y H). omega.
-Qed.
-
 Lemma Zmod_unique:
   forall x y a b,
   x = a * y + b -> 0 <= b < y -> x mod y = b.
 Proof.
   intros. subst x. rewrite Z.add_comm.
-  rewrite Z_mod_plus. apply Zmod_small. auto. omega.
+  rewrite Z_mod_plus. apply Z.mod_small. auto. omega.
 Qed.
 
 Lemma Zdiv_unique:
@@ -461,30 +431,7 @@ Lemma Zdiv_Zdiv:
   forall a b c,
   b > 0 -> c > 0 -> (a / b) / c = a / (b * c).
 Proof.
-  intros.
-  generalize (Z_div_mod_eq a b H). generalize (Z_mod_lt a b H). intros.
-  generalize (Z_div_mod_eq (a/b) c H0). generalize (Z_mod_lt (a/b) c H0). intros.
-  set (q1 := a / b) in *. set (r1 := a mod b) in *.
-  set (q2 := q1 / c) in *. set (r2 := q1 mod c) in *.
-  symmetry. apply Zdiv_unique with (r2 * b + r1).
-  rewrite H2. rewrite H4. ring.
-  split.
-  assert (0 <= r2 * b). apply Z.mul_nonneg_nonneg. omega. omega. omega.
-  assert ((r2 + 1) * b <= c * b).
-  apply Zmult_le_compat_r. omega. omega.
-  replace ((r2 + 1) * b) with (r2 * b + b) in H5 by ring.
-  replace (c * b) with (b * c) in H5 by ring.
-  omega.
-Qed.
-
-Lemma Zmult_le_compat_l_neg :
-  forall n m p:Z, n >= m -> p <= 0 -> p * n <= p * m.
-Proof.
-  intros.
-  assert ((-p) * n >= (-p) * m). apply Zmult_ge_compat_l. auto. omega.
-  replace (p * n) with (- ((-p) * n)) by ring.
-  replace (p * m) with (- ((-p) * m)) by ring.
-  omega.
+  intros. apply Z.div_div; omega.
 Qed.
 
 Lemma Zdiv_interval_1:
@@ -516,9 +463,9 @@ Proof.
   intros.
   assert (lo <= a / b < hi+1).
   apply Zdiv_interval_1. omega. omega. auto.
-  assert (lo * b <= lo * 1). apply Zmult_le_compat_l_neg. omega. omega.
+  assert (lo * b <= lo * 1) by (apply Z.mul_le_mono_nonpos_l; omega).
   replace (lo * 1) with lo in H3 by ring.
-  assert ((hi + 1) * 1 <= (hi + 1) * b). apply Zmult_le_compat_l. omega. omega.
+  assert ((hi + 1) * 1 <= (hi + 1) * b) by (apply Z.mul_le_mono_nonneg_l; omega).
   replace ((hi + 1) * 1) with (hi + 1) in H4 by ring.
   omega.
   omega.
@@ -529,42 +476,11 @@ Lemma Zmod_recombine:
   a > 0 -> b > 0 ->
   x mod (a * b) = ((x/b) mod a) * b + (x mod b).
 Proof.
-  intros.
-  set (xb := x/b).
-  apply Zmod_unique with (xb/a).
-  generalize (Z_div_mod_eq x b H0); fold xb; intro EQ1.
-  generalize (Z_div_mod_eq xb a H); intro EQ2.
-  rewrite EQ2 in EQ1.
-  eapply eq_trans. eexact EQ1. ring.
-  generalize (Z_mod_lt x b H0). intro.
-  generalize (Z_mod_lt xb a H). intro.
-  assert (0 <= xb mod a * b <= a * b - b).
-    split. apply Z.mul_nonneg_nonneg; omega.
-    replace (a * b - b) with ((a - 1) * b) by ring.
-    apply Zmult_le_compat; omega.
-  omega.
+  intros. rewrite (Z.mul_comm a b). rewrite Z.rem_mul_r by omega. ring. 
 Qed.
 
 (** Properties of divisibility. *)
 
-Lemma Zdivides_trans:
-  forall x y z, (x | y) -> (y | z) -> (x | z).
-Proof.
-  intros x y z [a A] [b B]; subst. exists (a*b); ring.
-Qed.
-
-Definition Zdivide_dec:
-  forall (p q: Z), p > 0 -> { (p|q) } + { ~(p|q) }.
-Proof.
-  intros. destruct (zeq (Z.modulo q p) 0).
-  left. exists (q / p).
-  transitivity (p * (q / p) + (q mod p)). apply Z_div_mod_eq; auto.
-  transitivity (p * (q / p)). omega. ring.
-  right; red; intros. elim n. apply Z_div_exact_1; auto.
-  inv H0. rewrite Z_div_mult; auto. ring.
-Defined.
-Global Opaque Zdivide_dec.
-
 Lemma Zdivide_interval:
   forall a b c,
   0 < c -> 0 <= a < b -> (c | a) -> (c | b) -> 0 <= a <= b - c.
@@ -577,43 +493,20 @@ Qed.
 
 (** Conversion from [Z] to [nat]. *)
 
-Definition nat_of_Z: Z -> nat := Z.to_nat.
-
-Lemma nat_of_Z_of_nat:
-  forall n, nat_of_Z (Z.of_nat n) = n.
-Proof.
-  exact Nat2Z.id.
-Qed.
-
-Lemma nat_of_Z_max:
-  forall z, Z.of_nat (nat_of_Z z) = Z.max z 0.
-Proof.
-  intros. unfold Z.max. destruct z; simpl; auto.
-  change (Z.of_nat (Z.to_nat (Zpos p)) = Zpos p).
-  apply Z2Nat.id. compute; intuition congruence.
-Qed.
-
-Lemma nat_of_Z_eq:
-  forall z, z >= 0 -> Z.of_nat (nat_of_Z z) = z.
-Proof.
-  unfold nat_of_Z; intros. apply Z2Nat.id. omega.
-Qed.
-
-Lemma nat_of_Z_neg:
-  forall n, n <= 0 -> nat_of_Z n = O.
+Lemma Z_to_nat_neg:
+  forall n, n <= 0 -> Z.to_nat n = O.
 Proof.
   destruct n; unfold Z.le; simpl; auto. congruence.
 Qed.
 
-Lemma nat_of_Z_plus:
-  forall p q,
-  p >= 0 -> q >= 0 ->
-  nat_of_Z (p + q) = (nat_of_Z p + nat_of_Z q)%nat.
+Lemma Z_to_nat_max:
+  forall z, Z.of_nat (Z.to_nat z) = Z.max z 0.
 Proof.
-  unfold nat_of_Z; intros. apply Z2Nat.inj_add; omega.
+  intros. destruct (zle 0 z).
+- rewrite Z2Nat.id by auto. xomega.
+- rewrite Z_to_nat_neg by omega. xomega.
 Qed.
 
-
 (** Alignment: [align n amount] returns the smallest multiple of [amount]
   greater than or equal to [n]. *)
 
diff --git a/lib/Floats.v b/lib/Floats.v
index 3ce8f4b4..13350dd0 100644
--- a/lib/Floats.v
+++ b/lib/Floats.v
@@ -16,15 +16,15 @@
 
 (** Formalization of floating-point numbers, using the Flocq library. *)
 
-Require Import Coqlib.
-Require Import Integers.
+Require Import Coqlib Zbits Integers.
 (*From Flocq*)
 Require Import Binary Bits Core.
-Require Import Fappli_IEEE_extra.
+Require Import IEEE754_extra.
 Require Import Program.
 Require Archi.
 
 Close Scope R_scope.
+Open Scope Z_scope.
 
 Definition float := binary64. (**r the type of IEE754 double-precision FP numbers *)
 Definition float32 := binary32. (**r the type of IEE754 single-precision FP numbers *)
@@ -94,21 +94,53 @@ Proof.
   destruct x as [[]|]; simpl; intros; discriminate.
 Qed.
 
-(** Relation between number of bits and base-2 logarithm *)
+(** Normalization of NaN payloads *)
 
-Lemma digits2_log2:
-  forall p, Z.pos (Digits.digits2_pos p) = Z.succ (Z.log2 (Z.pos p)).
+Lemma normalized_nan: forall prec n p,
+  Z.of_nat n = prec - 1 -> 1 < prec ->
+  nan_pl prec (Z.to_pos (P_mod_two_p p n)) = true.
 Proof.
-  assert (E: forall p, Digits.digits2_pos p = Pos.size p).
-  { induction p; simpl; rewrite ?IHp; auto. }
-  intros p. rewrite E.
-  destruct p; simpl; rewrite ?Pos.add_1_r; reflexivity.
+  intros. unfold nan_pl. apply Z.ltb_lt. rewrite Digits.Zpos_digits2_pos.
+  set (p' := P_mod_two_p p n).
+  assert (A: 0 <= p' < 2 ^ Z.of_nat n).
+  { rewrite <- two_power_nat_equiv; apply P_mod_two_p_range. }
+  assert (B: Digits.Zdigits radix2 p' <= prec - 1).
+  { apply Digits.Zdigits_le_Zpower. rewrite <- H. rewrite Z.abs_eq; tauto. }
+  destruct (zeq p' 0).
+- rewrite e. simpl; auto.
+- rewrite Z2Pos.id by omega. omega.
 Qed.
 
+(** Transform a Nan payload to a quiet Nan payload. *)
+
+Definition quiet_nan_64_payload (p: positive) :=
+  Z.to_pos (P_mod_two_p (Pos.lor p ((iter_nat xO 51 1%positive))) 52%nat).
+
+Lemma quiet_nan_64_proof: forall p, nan_pl 53 (quiet_nan_64_payload p) = true.
+Proof. intros; apply normalized_nan; auto; omega. Qed.
+
+Definition quiet_nan_64 (sp: bool * positive) : {x :float | is_nan _ _ x = true} :=
+  let (s, p) := sp in
+  exist _ (B754_nan 53 1024 s (quiet_nan_64_payload p) (quiet_nan_64_proof p)) (eq_refl true).
+
+Definition default_nan_64 := quiet_nan_64 Archi.default_nan_64.
+
+Definition quiet_nan_32_payload (p: positive) :=
+  Z.to_pos (P_mod_two_p (Pos.lor p ((iter_nat xO 22 1%positive))) 23%nat).
+
+Lemma quiet_nan_32_proof: forall p, nan_pl 24 (quiet_nan_32_payload p) = true.
+Proof. intros; apply normalized_nan; auto; omega. Qed.
+
+Definition quiet_nan_32 (sp: bool * positive) : {x :float32 | is_nan _ _ x = true} :=
+  let (s, p) := sp in
+  exist _ (B754_nan 24 128 s (quiet_nan_32_payload p) (quiet_nan_32_proof p)) (eq_refl true).
+
+Definition default_nan_32 := quiet_nan_32 Archi.default_nan_32.
+
 Local Notation __ := (eq_refl Datatypes.Lt).
 
-Local Hint Extern 1 (Prec_gt_0 _) => exact (eq_refl Datatypes.Lt).
-Local Hint Extern 1 (_ < _) => exact (eq_refl Datatypes.Lt).
+Local Hint Extern 1 (Prec_gt_0 _) => exact (eq_refl Datatypes.Lt) : core.
+Local Hint Extern 1 (_ < _) => exact (eq_refl Datatypes.Lt) : core.
 
 (** * Double-precision FP numbers *)
 
@@ -119,68 +151,44 @@ Module Float.
 (** The following definitions are not part of the IEEE754 standard but
     apply to all architectures supported by CompCert. *)
 
-(** Transform a Nan payload to a quiet Nan payload. *)
-
-Lemma transform_quiet_nan_proof (p : positive) :
-  nan_pl 53 p = true ->
-  nan_pl 53 (Pos.lor p (iter_nat xO 51 1%positive)) = true.
-Proof.
-  unfold nan_pl. intros K.
-  simpl. rewrite Z.ltb_lt, digits2_log2 in *.
-  change (Z.pos (Pos.lor p 2251799813685248)) with (Z.lor (Z.pos p) 2251799813685248%Z).
-  rewrite Z.log2_lor by xomega.
-  now apply Z.max_case.
-Qed.
-
-Definition transform_quiet_nan s p H : {x :float | is_nan _ _ x = true} :=
-  exist _ (B754_nan 53 1024 s _ (transform_quiet_nan_proof p H)) (eq_refl true).
-
 (** Nan payload operations for single <-> double conversions. *)
 
+Definition expand_nan_payload (p: positive) := Pos.shiftl_nat p 29.
+
 Lemma expand_nan_proof (p : positive) :
   nan_pl 24 p = true ->
-  nan_pl 53 (Pos.shiftl_nat p 29) = true.
+  nan_pl 53 (expand_nan_payload p) = true.
 Proof.
-  unfold nan_pl. intros K.
+  unfold nan_pl, expand_nan_payload. intros K.
   rewrite Z.ltb_lt in *.
   unfold Pos.shiftl_nat, nat_rect, Digits.digits2_pos.
   fold (Digits.digits2_pos p).
   zify; omega.
 Qed.
 
-Definition expand_nan s p H : {x | is_nan 53 1024 x = true} :=
-  exist _ (B754_nan 53 1024 s _ (expand_nan_proof p H)) (eq_refl true).
+Definition expand_nan s p H : {x | is_nan _ _ x = true} :=
+  exist _ (B754_nan 53 1024 s (expand_nan_payload p) (expand_nan_proof p H)) (eq_refl true).
 
 Definition of_single_nan (f : float32) : { x : float | is_nan _ _ x = true } :=
   match f with
   | B754_nan s p H =>
     if Archi.float_of_single_preserves_sNaN
     then expand_nan s p H
-    else transform_quiet_nan s _ (expand_nan_proof p H)
-  | _ => Archi.default_nan_64
+    else quiet_nan_64 (s, expand_nan_payload p)
+  | _ => default_nan_64
   end.
 
-Lemma reduce_nan_proof (p : positive) :
-  nan_pl 53 p = true ->
-  nan_pl 24 (Pos.shiftr_nat p 29) = true.
-Proof.
-  unfold nan_pl. intros K.
-  rewrite Z.ltb_lt in *.
-  unfold Pos.shiftr_nat, nat_rect.
-  assert (H : forall x, Digits.digits2_pos (Pos.div2 x) = (Digits.digits2_pos x - 1)%positive)
-    by (destruct x; simpl; auto; rewrite Pplus_one_succ_r, Pos.add_sub; auto).
-  rewrite !H, !Pos2Z.inj_sub_max.
-  repeat (apply Z.max_lub_lt; [reflexivity |apply Z.lt_sub_lt_add_l]).
-  exact K.
-Qed.
-
-Definition reduce_nan s p H : {x : float32 | is_nan _ _ x = true} :=
-  exist _ (B754_nan 24 128 s _ (reduce_nan_proof p H)) (eq_refl true).
+Definition reduce_nan_payload (p: positive) :=
+  (* The [quiet_nan_64_payload p] before the right shift is redundant with
+     the [quiet_nan_32_payload p] performed after, in [to_single_nan].
+     However the former ensures that the result of the right shift is
+     not 0 and therefore representable as a positive. *)
+  Pos.shiftr_nat (quiet_nan_64_payload p) 29.
 
 Definition to_single_nan (f : float) : { x : float32 | is_nan _ _ x = true } :=
   match f with
-  | B754_nan s p H => reduce_nan s _ (transform_quiet_nan_proof p H)
-  | _ => Archi.default_nan_32
+  | B754_nan s p H => quiet_nan_32 (s, reduce_nan_payload p)
+  | _ => default_nan_32
   end.
 
 (** NaN payload operations for opposite and absolute value. *)
@@ -188,33 +196,62 @@ Definition to_single_nan (f : float) : { x : float32 | is_nan _ _ x = true } :=
 Definition neg_nan (f : float) : { x : float | is_nan _ _ x = true } :=
   match f with
   | B754_nan s p H => exist _ (B754_nan 53 1024 (negb s) p H) (eq_refl true)
-  | _ => Archi.default_nan_64
+  | _ => default_nan_64
   end.
 
 Definition abs_nan (f : float) : { x : float | is_nan _ _ x = true } :=
   match f with
   | B754_nan s p H => exist _ (B754_nan 53 1024 false p H) (eq_refl true)
-  | _ => Archi.default_nan_64
+  | _ => default_nan_64
   end.
 
-(** The NaN payload operations for two-argument arithmetic operations
-   are not part of the IEEE754 standard, but all architectures of
-   Compcert share a similar NaN behavior, parameterized by:
-- a "default" payload which occurs when an operation generates a NaN from
-  non-NaN arguments;
-- a choice function determining which of the payload arguments to choose,
-  when an operation is given two NaN arguments. *)
+(** When an arithmetic operation returns a NaN, the sign and payload
+  of this NaN are not fully specified by the IEEE standard, and vary
+  among the architectures supported by CompCert.  However, the following
+  behavior applies to all the supported architectures: the payload is either
+- a default payload, independent of the arguments, or
+- the payload of one of the NaN arguments, if any.
+
+For each supported architecture, the functions [Archi.choose_nan_64]
+and [Archi.choose_nan_32] determine the payload of the result as a
+function of the payloads of the NaN arguments.
+
+Additionally, signaling NaNs are converted to quiet NaNs, as required by the standard.
+*)
+
+Definition cons_pl (x: float) (l: list (bool * positive)) :=
+  match x with B754_nan s p _ => (s, p) :: l | _ => l end.
 
-Definition binop_nan (x y : float) : {x : float | is_nan 53 1024 x = true} :=
-  if Archi.fpu_returns_default_qNaN then Archi.default_nan_64 else
+Definition unop_nan (x: float) : {x : float | is_nan _ _ x = true} :=
+  quiet_nan_64 (Archi.choose_nan_64 (cons_pl x [])).
+
+Definition binop_nan (x y: float) : {x : float | is_nan _ _ x = true} :=
+  quiet_nan_64 (Archi.choose_nan_64 (cons_pl x (cons_pl y []))).
+
+(** For fused multiply-add, the order in which arguments are examined
+  to select a NaN payload varies across platforms.  E.g. in [fma x y z],
+  x86 considers [x] first, then [y], then [z], while ARM considers [z] first,
+  then [x], then [y].  The corresponding permutation is defined
+  for each target, as function [Archi.fma_order]. *)
+
+Definition fma_nan_1 (x y z: float) : {x : float | is_nan _ _ x = true} :=
+  let '(a, b, c) := Archi.fma_order x y z in
+  quiet_nan_64 (Archi.choose_nan_64 (cons_pl a (cons_pl b (cons_pl c [])))).
+
+(** One last wrinkle for fused multiply-add: [fma zero infinity nan]
+  can return either the quiesced [nan], or the default NaN arising out
+  of the invalid operation [zero * infinity].  Of our target platforms,
+  only ARM honors the latter case.  The choice between the default NaN
+  and [nan] is done as in the case of two-argument arithmetic operations. *)
+
+Definition fma_nan (x y z: float) : {x : float | is_nan _ _ x = true} :=
   match x, y with
-  | B754_nan s1 pl1 H1, B754_nan s2 pl2 H2 =>
-      if Archi.choose_binop_pl_64 pl1 pl2
-      then transform_quiet_nan s2 pl2 H2
-      else transform_quiet_nan s1 pl1 H1
-  | B754_nan s1 pl1 H1, _ => transform_quiet_nan s1 pl1 H1
-  | _, B754_nan s2 pl2 H2 => transform_quiet_nan s2 pl2 H2
-  | _, _ => Archi.default_nan_64
+  | B754_infinity _, B754_zero _ | B754_zero _, B754_infinity _ =>
+      if Archi.fma_invalid_mul_is_nan
+      then quiet_nan_64 (Archi.choose_nan_64 (Archi.default_nan_64 :: cons_pl z []))
+      else fma_nan_1 x y z
+  | _, _ =>
+      fma_nan_1 x y z
   end.
 
 (** ** Operations over double-precision floats *)
@@ -227,6 +264,8 @@ Definition eq_dec: forall (f1 f2: float), {f1 = f2} + {f1 <> f2} := Beq_dec _ _.
 
 Definition neg: float -> float := Bopp _ _ neg_nan. (**r opposite (change sign) *)
 Definition abs: float -> float := Babs _ _ abs_nan. (**r absolute value (set sign to [+]) *)
+Definition sqrt: float -> float :=
+  Bsqrt 53 1024 __ __ unop_nan mode_NE.  (**r square root *)
 Definition add: float -> float -> float :=
   Bplus 53 1024 __ __ binop_nan mode_NE. (**r addition *)
 Definition sub: float -> float -> float :=
@@ -235,6 +274,8 @@ Definition mul: float -> float -> float :=
   Bmult 53 1024 __ __ binop_nan mode_NE. (**r multiplication *)
 Definition div: float -> float -> float :=
   Bdiv 53 1024 __ __ binop_nan mode_NE. (**r division *)
+Definition fma: float -> float -> float -> float :=
+  Bfma 53 1024 __ __ fma_nan mode_NE. (**r fused multiply-add [x * y + z] *)
 Definition compare (f1 f2: float) : option Datatypes.comparison := (**r general comparison *)
   Bcompare 53 1024 f1 f2.
 Definition cmp (c:comparison) (f1 f2: float) : bool := (**r Boolean comparison *)
@@ -302,19 +343,15 @@ Ltac smart_omega :=
 Theorem add_commut:
   forall x y, is_nan _ _ x = false \/ is_nan _ _ y = false -> add x y = add y x.
 Proof.
-  intros. apply Bplus_commut. unfold binop_nan.
-  destruct Archi.fpu_returns_default_qNaN. easy.
-  destruct x, y; try reflexivity.
-  now destruct H.
+  intros. apply Bplus_commut.
+  destruct x, y; try reflexivity; now destruct H.
 Qed.
 
 Theorem mul_commut:
   forall x y, is_nan _ _ x = false \/ is_nan _ _ y = false -> mul x y = mul y x.
 Proof.
-  intros. apply Bmult_commut. unfold binop_nan.
-  destruct Archi.fpu_returns_default_qNaN. easy.
-  destruct x, y; try reflexivity.
-  now destruct H.
+  intros. apply Bmult_commut.
+  destruct x, y; try reflexivity; now destruct H.
 Qed.
 
 (** Multiplication by 2 is diagonal addition. *)
@@ -324,9 +361,8 @@ Theorem mul2_add:
 Proof.
   intros. apply Bmult2_Bplus.
   intros x y Hx Hy. unfold binop_nan.
-  destruct Archi.fpu_returns_default_qNaN. easy.
-  destruct x as [| |sx px Nx|]; try discriminate.
-  now destruct y, Archi.choose_binop_pl_64.
+  destruct x; try discriminate. simpl. rewrite Archi.choose_nan_64_idem. 
+  destruct y; reflexivity || discriminate.
 Qed.
 
 (** Divisions that can be turned into multiplication by an inverse. *)
@@ -338,9 +374,8 @@ Theorem div_mul_inverse:
 Proof.
   intros. apply Bdiv_mult_inverse. 2: easy.
   intros x0 y0 z0 Hx Hy Hz. unfold binop_nan.
-  destruct Archi.fpu_returns_default_qNaN. easy.
-  destruct x0 as [| |sx px Nx|]; try discriminate.
-  now destruct y0, z0.
+  destruct x0; try discriminate.
+  destruct y0, z0; reflexivity || discriminate.
 Qed.
 
 (** Properties of comparisons. *)
@@ -414,6 +449,7 @@ Qed.
   to emulate the former.)   *)
 
 Definition ox8000_0000 := Int.repr Int.half_modulus.  (**r [0x8000_0000] *)
+Definition ox7FFF_FFFF := Int.repr Int.max_signed.    (**r [0x7FFF_FFFF] *)
 
 Theorem of_intu_of_int_1:
   forall x,
@@ -444,6 +480,46 @@ Proof.
   compute_this (Int.unsigned ox8000_0000); smart_omega.
 Qed.
 
+Theorem of_intu_of_int_3:
+  forall x,
+  of_intu x = sub (of_int (Int.and x ox7FFF_FFFF)) (of_int (Int.and x ox8000_0000)).
+Proof.
+  intros.
+  set (hi := Int.and x ox8000_0000).
+  set (lo := Int.and x ox7FFF_FFFF).
+  assert (R: forall n, integer_representable 53 1024 (Int.signed n)).
+  { intros. pose proof (Int.signed_range n).
+    apply integer_representable_n; auto; smart_omega. }
+  unfold sub, of_int. rewrite BofZ_minus by auto. unfold of_intu. f_equal.
+  assert (E: Int.add hi lo = x).
+  { unfold hi, lo. rewrite Int.add_is_or. 
+  - rewrite <- Int.and_or_distrib. apply Int.and_mone.
+  - rewrite Int.and_assoc. rewrite (Int.and_commut ox8000_0000). rewrite Int.and_assoc.
+    change (Int.and ox7FFF_FFFF ox8000_0000) with Int.zero. rewrite ! Int.and_zero; auto.
+  }
+  assert (RNG: 0 <= Int.unsigned lo < two_p 31).
+  { unfold lo. change ox7FFF_FFFF with (Int.repr (two_p 31 - 1)). rewrite <- Int.zero_ext_and by omega.
+    apply Int.zero_ext_range. compute_this Int.zwordsize. omega. }
+  assert (B: forall i, 0 <= i < Int.zwordsize -> Int.testbit ox8000_0000 i = if zeq i 31 then true else false).
+  { intros; unfold Int.testbit. change (Int.unsigned ox8000_0000) with (2^31).
+    destruct (zeq i 31). subst i; auto. apply Z.pow2_bits_false; auto. } 
+  assert (EITHER: hi = Int.zero \/ hi = ox8000_0000).
+  { unfold hi; destruct (Int.testbit x 31) eqn:B31; [right|left];
+    Int.bit_solve; rewrite B by auto.
+  - destruct (zeq i 31). subst i; rewrite B31; auto. apply andb_false_r.
+  - destruct (zeq i 31). subst i; rewrite B31; auto. apply andb_false_r.
+  }
+  assert (SU: - Int.signed hi = Int.unsigned hi).
+  { destruct EITHER as [EQ|EQ]; rewrite EQ; reflexivity. }
+  unfold Z.sub; rewrite SU, <- E. 
+  unfold Int.add; rewrite Int.unsigned_repr, Int.signed_eq_unsigned. omega.
+  - assert (Int.max_signed = two_p 31 - 1) by reflexivity. omega.
+  - assert (Int.unsigned hi = 0 \/ Int.unsigned hi = two_p 31)
+    by (destruct EITHER as [EQ|EQ]; rewrite EQ; [left|right]; reflexivity).
+    assert (Int.max_unsigned = two_p 31 + two_p 31 - 1) by reflexivity.
+    omega.
+Qed.
+
 Theorem to_intu_to_int_1:
   forall x n,
   cmp Clt x (of_intu ox8000_0000) = true ->
@@ -919,44 +995,39 @@ End Float.
 
 Module Float32.
 
-(** ** NaN payload manipulations *)
-
-Lemma transform_quiet_nan_proof (p : positive) :
-  nan_pl 24 p = true ->
-  nan_pl 24 (Pos.lor p (iter_nat xO 22 1%positive)) = true.
-Proof.
-  unfold nan_pl. intros K.
-  simpl. rewrite Z.ltb_lt, digits2_log2 in *.
-  change (Z.pos (Pos.lor p 4194304)) with (Z.lor (Z.pos p) 4194304%Z).
-  rewrite Z.log2_lor by xomega.
-  now apply Z.max_case.
-Qed.
-
-Definition transform_quiet_nan s p H : {x : float32 | is_nan _ _ x = true} :=
-  exist _ (B754_nan 24 128 s _ (transform_quiet_nan_proof p H)) (eq_refl true).
-
 Definition neg_nan (f : float32) : { x : float32 | is_nan _ _ x = true } :=
   match f with
   | B754_nan s p H => exist _ (B754_nan 24 128 (negb s) p H) (eq_refl true)
-  | _ => Archi.default_nan_32
+  | _ => default_nan_32
   end.
 
 Definition abs_nan (f : float32) : { x : float32 | is_nan _ _ x = true } :=
   match f with
   | B754_nan s p H => exist _ (B754_nan 24 128 false p H) (eq_refl true)
-  | _ => Archi.default_nan_32
+  | _ => default_nan_32
   end.
 
-Definition binop_nan (x y : float32) : {x : float32 | is_nan _ _ x = true} :=
-  if Archi.fpu_returns_default_qNaN then Archi.default_nan_32 else
+Definition cons_pl (x: float32) (l: list (bool * positive)) :=
+  match x with B754_nan s p _ => (s, p) :: l | _ => l end.
+
+Definition unop_nan (x: float32) : {x : float32 | is_nan _ _ x = true} :=
+  quiet_nan_32 (Archi.choose_nan_32 (cons_pl x [])).
+
+Definition binop_nan (x y: float32) : {x : float32 | is_nan _ _ x = true} :=
+  quiet_nan_32 (Archi.choose_nan_32 (cons_pl x (cons_pl y []))).
+
+Definition fma_nan_1 (x y z: float32) : {x : float32 | is_nan _ _ x = true} :=
+  let '(a, b, c) := Archi.fma_order x y z in
+  quiet_nan_32 (Archi.choose_nan_32 (cons_pl a (cons_pl b (cons_pl c [])))).
+
+Definition fma_nan (x y z: float32) : {x : float32 | is_nan _ _ x = true} :=
   match x, y with
-  | B754_nan s1 pl1 H1, B754_nan s2 pl2 H2 =>
-      if Archi.choose_binop_pl_32 pl1 pl2
-      then transform_quiet_nan s2 pl2 H2
-      else transform_quiet_nan s1 pl1 H1
-  | B754_nan s1 pl1 H1, _ => transform_quiet_nan s1 pl1 H1
-  | _, B754_nan s2 pl2 H2 => transform_quiet_nan s2 pl2 H2
-  | _, _ => Archi.default_nan_32
+  | B754_infinity _, B754_zero _ | B754_zero _, B754_infinity _ =>
+      if Archi.fma_invalid_mul_is_nan
+      then quiet_nan_32 (Archi.choose_nan_32 (Archi.default_nan_32 :: cons_pl z []))
+      else fma_nan_1 x y z
+  | _, _ =>
+      fma_nan_1 x y z
   end.
 
 (** ** Operations over single-precision floats *)
@@ -969,6 +1040,8 @@ Definition eq_dec: forall (f1 f2: float32), {f1 = f2} + {f1 <> f2} := Beq_dec _
 
 Definition neg: float32 -> float32 := Bopp _ _ neg_nan. (**r opposite (change sign) *)
 Definition abs: float32 -> float32 := Babs _ _ abs_nan. (**r absolute value (set sign to [+]) *)
+Definition sqrt: float32 -> float32 :=
+  Bsqrt 24 128 __ __ unop_nan mode_NE.  (**r square root *)
 Definition add: float32 -> float32 -> float32 :=
   Bplus 24 128 __ __ binop_nan mode_NE. (**r addition *)
 Definition sub: float32 -> float32 -> float32 :=
@@ -977,6 +1050,8 @@ Definition mul: float32 -> float32 -> float32 :=
   Bmult 24 128 __ __ binop_nan mode_NE. (**r multiplication *)
 Definition div: float32 -> float32 -> float32 :=
   Bdiv 24 128 __ __ binop_nan mode_NE. (**r division *)
+Definition fma: float32 -> float32 -> float32 -> float32 :=
+  Bfma 24 128 __ __ fma_nan mode_NE. (**r fused multiply-add [x * y + z] *)
 Definition compare (f1 f2: float32) : option Datatypes.comparison := (**r general comparison *)
   Bcompare 24 128 f1 f2.
 Definition cmp (c:comparison) (f1 f2: float32) : bool := (**r comparison *)
@@ -1024,19 +1099,15 @@ Definition of_bits (b: int): float32 := b32_of_bits (Int.unsigned b).
 Theorem add_commut:
   forall x y, is_nan _ _ x = false \/ is_nan _ _ y = false -> add x y = add y x.
 Proof.
-  intros. apply Bplus_commut. unfold binop_nan.
-  destruct Archi.fpu_returns_default_qNaN. easy.
-  destruct x, y; try reflexivity.
-  now destruct H.
+  intros. apply Bplus_commut. 
+  destruct x, y; try reflexivity; now destruct H.
 Qed.
 
 Theorem mul_commut:
   forall x y, is_nan _ _ x = false \/ is_nan _ _ y = false -> mul x y = mul y x.
 Proof.
-  intros. apply Bmult_commut. unfold binop_nan.
-  destruct Archi.fpu_returns_default_qNaN. easy.
-  destruct x, y; try reflexivity.
-  now destruct H.
+  intros. apply Bmult_commut.
+  destruct x, y; try reflexivity; now destruct H.
 Qed.
 
 (** Multiplication by 2 is diagonal addition. *)
@@ -1046,9 +1117,8 @@ Theorem mul2_add:
 Proof.
   intros. apply Bmult2_Bplus.
   intros x y Hx Hy. unfold binop_nan.
-  destruct Archi.fpu_returns_default_qNaN. easy.
-  destruct x as [| |sx px Nx|]; try discriminate.
-  now destruct y, Archi.choose_binop_pl_32.
+  destruct x; try discriminate. simpl. rewrite Archi.choose_nan_32_idem. 
+  destruct y; reflexivity || discriminate.
 Qed.
 
 (** Divisions that can be turned into multiplication by an inverse. *)
@@ -1060,9 +1130,8 @@ Theorem div_mul_inverse:
 Proof.
   intros. apply Bdiv_mult_inverse. 2: easy.
   intros x0 y0 z0 Hx Hy Hz. unfold binop_nan.
-  destruct Archi.fpu_returns_default_qNaN. easy.
-  destruct x0 as [| |sx px Nx|]; try discriminate.
-  now destruct y0, z0.
+  destruct x0; try discriminate.
+  destruct y0, z0; reflexivity || discriminate.
 Qed.
 
 (** Properties of comparisons. *)
@@ -1218,15 +1287,15 @@ Proof.
   set (m := n mod 2^p + (2^p-1)) in *.
   assert (C: m / 2^p = if zeq (n mod 2^p) 0 then 0 else 1).
   { unfold m. destruct (zeq (n mod 2^p) 0).
-    rewrite e. apply Zdiv_small. omega.
-    eapply Zdiv_unique with (n mod 2^p - 1). ring. omega. }
+    rewrite e. apply Z.div_small. omega.
+    eapply Coqlib.Zdiv_unique with (n mod 2^p - 1). ring. omega. }
   assert (D: Z.testbit m p = if zeq (n mod 2^p) 0 then false else true).
   { destruct (zeq (n mod 2^p) 0).
     apply Z.testbit_false; auto. rewrite C; auto.
     apply Z.testbit_true; auto. rewrite C; auto. }
   assert (E: forall i, p < i -> Z.testbit m i = false).
   { intros. apply Z.testbit_false. omega.
-    replace (m / 2^i) with 0. auto. symmetry. apply Zdiv_small.
+    replace (m / 2^i) with 0. auto. symmetry. apply Z.div_small.
     unfold m. split. omega. apply Z.lt_le_trans with (2 * 2^p). omega.
     change 2 with (2^1) at 1. rewrite <- (Zpower_plus radix2) by omega.
     apply Zpower_le. omega. }
@@ -1356,9 +1425,9 @@ Proof.
   rewrite Int64.testbit_repr by auto. f_equal. f_equal. unfold Int64.and.
   change (Int64.unsigned (Int64.repr 2047)) with 2047.
   change 2047 with (Z.ones 11). rewrite ! Z.land_ones by omega.
-  rewrite Int64.unsigned_repr. apply Int64.eqmod_mod_eq.
+  rewrite Int64.unsigned_repr. apply eqmod_mod_eq.
   apply Z.lt_gt. apply (Zpower_gt_0 radix2); omega.
-  apply Int64.eqmod_divides with (2^64). apply Int64.eqm_signed_unsigned.
+  apply eqmod_divides with (2^64). apply Int64.eqm_signed_unsigned.
   exists (2^(64-11)); auto.
   exploit (Z_mod_lt (Int64.unsigned n) (2^11)). compute; auto.
   assert (2^11 < Int64.max_unsigned) by (compute; auto). omega.
diff --git a/lib/Heaps.v b/lib/Heaps.v
index 9fa07a1d..85343998 100644
--- a/lib/Heaps.v
+++ b/lib/Heaps.v
@@ -256,14 +256,14 @@ Proof.
   eapply gt_heap_trans with y; eauto. red; auto.
 - intuition.
   eapply lt_heap_trans; eauto. red; auto.
-  eapply gt_heap_trans; eauto. red; auto.
+  eapply gt_heap_trans; eauto. red; auto with ordered_type.
 - intuition. eapply gt_heap_trans; eauto. red; auto.
 - rewrite e3 in *; simpl in *. intuition.
   eapply lt_heap_trans with y; eauto. red; auto.
   eapply gt_heap_trans; eauto. red; auto.
 - intuition.
   eapply lt_heap_trans with y; eauto. red; auto.
-  eapply gt_heap_trans; eauto. red; auto.
+  eapply gt_heap_trans; eauto. red; auto with ordered_type.
   eapply gt_heap_trans with x; eauto. red; auto.
 - rewrite e3 in *; simpl in *; intuition.
   eapply gt_heap_trans; eauto. red; auto.
@@ -308,7 +308,7 @@ Proof.
   intros. unfold insert.
   case_eq (partition x h). intros a b EQ; simpl.
   assert (E.eq y x \/ ~E.eq y x).
-    destruct (E.compare y x); auto.
+    destruct (E.compare y x); auto with ordered_type.
     right; red; intros. elim (E.lt_not_eq l). apply E.eq_sym; auto.
   destruct H0.
   tauto.
diff --git a/lib/Fappli_IEEE_extra.v b/lib/IEEE754_extra.v
index c23149be..c23149be 100644
--- a/lib/Fappli_IEEE_extra.v
+++ b/lib/IEEE754_extra.v
diff --git a/lib/Integers.v b/lib/Integers.v
index 4b75e71e..8990c78d 100644
--- a/lib/Integers.v
+++ b/lib/Integers.v
@@ -16,7 +16,7 @@
 (** Formalizations of machine integers modulo $2^N$ #2<sup>N</sup>#. *)
 
 Require Import Eqdep_dec Zquot Zwf.
-Require Import Coqlib.
+Require Import Coqlib Zbits.
 Require Archi.
 
 (** * Comparisons *)
@@ -91,6 +91,8 @@ Proof.
   generalize modulus_gt_one; omega.
 Qed.
 
+Hint Resolve modulus_pos: ints.
+
 (** * Representation of machine integers *)
 
 (** A machine integer (type [int]) is represented as a Coq arbitrary-precision
@@ -101,17 +103,6 @@ Record int: Type := mkint { intval: Z; intrange: -1 < intval < modulus }.
 
 (** Fast normalization modulo [2^wordsize] *)
 
-Fixpoint P_mod_two_p (p: positive) (n: nat) {struct n} : Z :=
-  match n with
-  | O => 0
-  | S m =>
-      match p with
-      | xH => 1
-      | xO q => Z.double (P_mod_two_p q m)
-      | xI q => Z.succ_double (P_mod_two_p q m)
-      end
-  end.
-
 Definition Z_mod_modulus (x: Z) : Z :=
   match x with
   | Z0 => 0
@@ -119,51 +110,9 @@ Definition Z_mod_modulus (x: Z) : Z :=
   | Zneg p => let r := P_mod_two_p p wordsize in if zeq r 0 then 0 else modulus - r
   end.
 
-Lemma P_mod_two_p_range:
-  forall n p, 0 <= P_mod_two_p p n < two_power_nat n.
-Proof.
-  induction n; simpl; intros.
-  - rewrite two_power_nat_O. omega.
-  - rewrite two_power_nat_S. destruct p.
-    + generalize (IHn p). rewrite Z.succ_double_spec. omega.
-    + generalize (IHn p). rewrite Z.double_spec. omega.
-    + generalize (two_power_nat_pos n). omega.
-Qed.
-
-Lemma P_mod_two_p_eq:
-  forall n p, P_mod_two_p p n = (Zpos p) mod (two_power_nat n).
-Proof.
-  assert (forall n p, exists y, Zpos p = y * two_power_nat n + P_mod_two_p p n).
-  {
-    induction n; simpl; intros.
-    - rewrite two_power_nat_O. exists (Zpos p). ring.
-    - rewrite two_power_nat_S. destruct p.
-      + destruct (IHn p) as [y EQ]. exists y.
-        change (Zpos p~1) with (2 * Zpos p + 1). rewrite EQ.
-        rewrite Z.succ_double_spec. ring.
-      + destruct (IHn p) as [y EQ]. exists y.
-        change (Zpos p~0) with (2 * Zpos p). rewrite EQ.
-        rewrite (Z.double_spec (P_mod_two_p p n)). ring.
-      + exists 0; omega.
-  }
-  intros.
-  destruct (H n p) as [y EQ].
-  symmetry. apply Zmod_unique with y. auto. apply P_mod_two_p_range.
-Qed.
-
 Lemma Z_mod_modulus_range:
   forall x, 0 <= Z_mod_modulus x < modulus.
-Proof.
-  intros; unfold Z_mod_modulus.
-  destruct x.
-  - generalize modulus_pos; intuition.
-  - apply P_mod_two_p_range.
-  - set (r := P_mod_two_p p wordsize).
-    assert (0 <= r < modulus) by apply P_mod_two_p_range.
-    destruct (zeq r 0).
-    + generalize modulus_pos; intuition.
-    + Psatz.lia.
-Qed.
+Proof (Z_mod_two_p_range wordsize).
 
 Lemma Z_mod_modulus_range':
   forall x, -1 < Z_mod_modulus x < modulus.
@@ -173,22 +122,7 @@ Qed.
 
 Lemma Z_mod_modulus_eq:
   forall x, Z_mod_modulus x = x mod modulus.
-Proof.
-  intros. unfold Z_mod_modulus. destruct x.
-  - rewrite Zmod_0_l. auto.
-  - apply P_mod_two_p_eq.
-  - generalize (P_mod_two_p_range wordsize p) (P_mod_two_p_eq wordsize p).
-    fold modulus. intros A B.
-    exploit (Z_div_mod_eq (Zpos p) modulus). apply modulus_pos. intros C.
-    set (q := Zpos p / modulus) in *.
-    set (r := P_mod_two_p p wordsize) in *.
-    rewrite <- B in C.
-    change (Z.neg p) with (- (Z.pos p)). destruct (zeq r 0).
-    + symmetry. apply Zmod_unique with (-q). rewrite C; rewrite e. Psatz.lia.
-      intuition.
-    + symmetry. apply Zmod_unique with (-q - 1). rewrite C. Psatz.lia.
-      intuition.
-Qed.
+Proof (Z_mod_two_p_eq wordsize).
 
 (** The [unsigned] and [signed] functions return the Coq integer corresponding
   to the given machine integer, interpreted as unsigned or signed
@@ -323,63 +257,20 @@ Definition shr_carry (x y: int) : int :=
 
 (** Zero and sign extensions *)
 
-Definition Zshiftin (b: bool) (x: Z) : Z :=
-  if b then Z.succ_double x else Z.double x.
-
-(** In pseudo-code:
-<<
-    Fixpoint Zzero_ext (n: Z) (x: Z) : Z :=
-      if zle n 0 then
-        0
-      else
-        Zshiftin (Z.odd x) (Zzero_ext (Z.pred n) (Z.div2 x)).
-    Fixpoint Zsign_ext (n: Z) (x: Z) : Z :=
-      if zle n 1 then
-        if Z.odd x then -1 else 0
-      else
-        Zshiftin (Z.odd x) (Zzero_ext (Z.pred n) (Z.div2 x)).
->>
-  We encode this [nat]-like recursion using the [Z.iter] iteration
-  function, in order to make the [Zzero_ext] and [Zsign_ext]
-  functions efficiently executable within Coq.
-*)
-
-Definition Zzero_ext (n: Z) (x: Z) : Z :=
-  Z.iter n
-    (fun rec x => Zshiftin (Z.odd x) (rec (Z.div2 x)))
-    (fun x => 0)
-    x.
-
-Definition Zsign_ext (n: Z) (x: Z) : Z :=
-  Z.iter (Z.pred n)
-    (fun rec x => Zshiftin (Z.odd x) (rec (Z.div2 x)))
-    (fun x => if Z.odd x then -1 else 0)
-    x.
-
 Definition zero_ext (n: Z) (x: int) : int := repr (Zzero_ext n (unsigned x)).
-
 Definition sign_ext (n: Z) (x: int) : int := repr (Zsign_ext n (unsigned x)).
 
 (** Decomposition of a number as a sum of powers of two. *)
 
-Fixpoint Z_one_bits (n: nat) (x: Z) (i: Z) {struct n}: list Z :=
-  match n with
-  | O => nil
-  | S m =>
-      if Z.odd x
-      then i :: Z_one_bits m (Z.div2 x) (i+1)
-      else Z_one_bits m (Z.div2 x) (i+1)
-  end.
-
 Definition one_bits (x: int) : list int :=
   List.map repr (Z_one_bits wordsize (unsigned x) 0).
 
 (** Recognition of powers of two. *)
 
 Definition is_power2 (x: int) : option int :=
-  match Z_one_bits wordsize (unsigned x) 0 with
-  | i :: nil => Some (repr i)
-  | _ => None
+  match Z_is_power2 (unsigned x) with
+  | Some i => Some (repr i)
+  | None => None
   end.
 
 (** Comparisons. *)
@@ -503,101 +394,7 @@ Qed.
 
 (** ** Modulo arithmetic *)
 
-(** We define and state properties of equality and arithmetic modulo a
-  positive integer. *)
-
-Section EQ_MODULO.
-
-Variable modul: Z.
-Hypothesis modul_pos: modul > 0.
-
-Definition eqmod (x y: Z) : Prop := exists k, x = k * modul + y.
-
-Lemma eqmod_refl: forall x, eqmod x x.
-Proof.
-  intros; red. exists 0. omega.
-Qed.
-
-Lemma eqmod_refl2: forall x y, x = y -> eqmod x y.
-Proof.
-  intros. subst y. apply eqmod_refl.
-Qed.
-
-Lemma eqmod_sym: forall x y, eqmod x y -> eqmod y x.
-Proof.
-  intros x y [k EQ]; red. exists (-k). subst x. ring.
-Qed.
-
-Lemma eqmod_trans: forall x y z, eqmod x y -> eqmod y z -> eqmod x z.
-Proof.
-  intros x y z [k1 EQ1] [k2 EQ2]; red.
-  exists (k1 + k2). subst x; subst y. ring.
-Qed.
-
-Lemma eqmod_small_eq:
-  forall x y, eqmod x y -> 0 <= x < modul -> 0 <= y < modul -> x = y.
-Proof.
-  intros x y [k EQ] I1 I2.
-  generalize (Zdiv_unique _ _ _ _ EQ I2). intro.
-  rewrite (Zdiv_small x modul I1) in H. subst k. omega.
-Qed.
-
-Lemma eqmod_mod_eq:
-  forall x y, eqmod x y -> x mod modul = y mod modul.
-Proof.
-  intros x y [k EQ]. subst x.
-  rewrite Z.add_comm. apply Z_mod_plus. auto.
-Qed.
-
-Lemma eqmod_mod:
-  forall x, eqmod x (x mod modul).
-Proof.
-  intros; red. exists (x / modul).
-  rewrite Z.mul_comm. apply Z_div_mod_eq. auto.
-Qed.
-
-Lemma eqmod_add:
-  forall a b c d, eqmod a b -> eqmod c d -> eqmod (a + c) (b + d).
-Proof.
-  intros a b c d [k1 EQ1] [k2 EQ2]; red.
-  subst a; subst c. exists (k1 + k2). ring.
-Qed.
-
-Lemma eqmod_neg:
-  forall x y, eqmod x y -> eqmod (-x) (-y).
-Proof.
-  intros x y [k EQ]; red. exists (-k). rewrite EQ. ring.
-Qed.
-
-Lemma eqmod_sub:
-  forall a b c d, eqmod a b -> eqmod c d -> eqmod (a - c) (b - d).
-Proof.
-  intros a b c d [k1 EQ1] [k2 EQ2]; red.
-  subst a; subst c. exists (k1 - k2). ring.
-Qed.
-
-Lemma eqmod_mult:
-  forall a b c d, eqmod a c -> eqmod b d -> eqmod (a * b) (c * d).
-Proof.
-  intros a b c d [k1 EQ1] [k2 EQ2]; red.
-  subst a; subst b.
-  exists (k1 * k2 * modul + c * k2 + k1 * d).
-  ring.
-Qed.
-
-End EQ_MODULO.
-
-Lemma eqmod_divides:
-  forall n m x y, eqmod n x y -> Z.divide m n -> eqmod m x y.
-Proof.
-  intros. destruct H as [k1 EQ1]. destruct H0 as [k2 EQ2].
-  exists (k1*k2). rewrite <- Z.mul_assoc. rewrite <- EQ2. auto.
-Qed.
-
-(** We then specialize these definitions to equality modulo
-  $2^{wordsize}$ #2<sup>wordsize</sup>#. *)
-
-Hint Resolve modulus_pos: ints.
+(** [eqm] is equality modulo $2^{wordsize}$ #2<sup>wordsize</sup>#. *)
 
 Definition eqm := eqmod modulus.
 
@@ -643,6 +440,19 @@ Lemma eqm_mult:
 Proof (eqmod_mult modulus).
 Hint Resolve eqm_mult: ints.
 
+Lemma eqm_same_bits:
+  forall x y,
+  (forall i, 0 <= i < zwordsize -> Z.testbit x i = Z.testbit y i) ->
+  eqm x y.
+Proof (eqmod_same_bits wordsize).
+
+Lemma same_bits_eqm:
+  forall x y i,
+  eqm x y ->
+  0 <= i < zwordsize ->
+  Z.testbit x i = Z.testbit y i.
+Proof (same_bits_eqmod wordsize).
+
 (** ** Properties of the coercions between [Z] and [int] *)
 
 Lemma eqm_samerepr: forall x y, eqm x y -> repr x = repr y.
@@ -712,7 +522,7 @@ Theorem repr_unsigned:
   forall i, repr (unsigned i) = i.
 Proof.
   destruct i; simpl. unfold repr. apply mkint_eq.
-  rewrite Z_mod_modulus_eq. apply Zmod_small; omega.
+  rewrite Z_mod_modulus_eq. apply Z.mod_small; omega.
 Qed.
 Hint Resolve repr_unsigned: ints.
 
@@ -735,7 +545,7 @@ Theorem unsigned_repr:
   forall z, 0 <= z <= max_unsigned -> unsigned (repr z) = z.
 Proof.
   intros. rewrite unsigned_repr_eq.
-  apply Zmod_small. unfold max_unsigned in H. omega.
+  apply Z.mod_small. unfold max_unsigned in H. omega.
 Qed.
 Hint Resolve unsigned_repr: ints.
 
@@ -782,7 +592,7 @@ Qed.
 
 Theorem unsigned_one: unsigned one = 1.
 Proof.
-  unfold one; rewrite unsigned_repr_eq. apply Zmod_small. split. omega.
+  unfold one; rewrite unsigned_repr_eq. apply Z.mod_small. split. omega.
   unfold modulus. replace wordsize with (S(Init.Nat.pred wordsize)).
   rewrite two_power_nat_S. generalize (two_power_nat_pos (Init.Nat.pred wordsize)).
   omega.
@@ -793,7 +603,7 @@ Theorem unsigned_mone: unsigned mone = modulus - 1.
 Proof.
   unfold mone; rewrite unsigned_repr_eq.
   replace (-1) with ((modulus - 1) + (-1) * modulus).
-  rewrite Z_mod_plus_full. apply Zmod_small.
+  rewrite Z_mod_plus_full. apply Z.mod_small.
   generalize modulus_pos. omega. omega.
 Qed.
 
@@ -825,7 +635,7 @@ Qed.
 Theorem unsigned_repr_wordsize:
   unsigned iwordsize = zwordsize.
 Proof.
-  unfold iwordsize; rewrite unsigned_repr_eq. apply Zmod_small.
+  unfold iwordsize; rewrite unsigned_repr_eq. apply Z.mod_small.
   generalize wordsize_pos wordsize_max_unsigned; unfold max_unsigned; omega.
 Qed.
 
@@ -858,6 +668,11 @@ Proof.
   intros. generalize (eq_spec x y); case (eq x y); intros; congruence.
 Qed.
 
+Theorem same_if_eq: forall x y, eq x y = true -> x = y.
+Proof.
+  intros. generalize (eq_spec x y); rewrite H; auto.
+Qed.
+
 Theorem eq_signed:
   forall x y, eq x y = if zeq (signed x) (signed y) then true else false.
 Proof.
@@ -1304,298 +1119,6 @@ Qed.
 
 (** ** Bit-level properties *)
 
-(** ** Properties of bit-level operations over [Z] *)
-
-Remark Ztestbit_0: forall n, Z.testbit 0 n = false.
-Proof Z.testbit_0_l.
-
-Remark Ztestbit_1: forall n, Z.testbit 1 n = zeq n 0.
-Proof.
-  intros. destruct n; simpl; auto.
-Qed.
-
-Remark Ztestbit_m1: forall n, 0 <= n -> Z.testbit (-1) n = true.
-Proof.
-  intros. destruct n; simpl; auto.
-Qed.
-
-Remark Zshiftin_spec:
-  forall b x, Zshiftin b x = 2 * x + (if b then 1 else 0).
-Proof.
-  unfold Zshiftin; intros. destruct b.
-  - rewrite Z.succ_double_spec. omega.
-  - rewrite Z.double_spec. omega.
-Qed.
-
-Remark Zshiftin_inj:
-  forall b1 x1 b2 x2,
-  Zshiftin b1 x1 = Zshiftin b2 x2 -> b1 = b2 /\ x1 = x2.
-Proof.
-  intros. rewrite !Zshiftin_spec in H.
-  destruct b1; destruct b2.
-  split; [auto|omega].
-  omegaContradiction.
-  omegaContradiction.
-  split; [auto|omega].
-Qed.
-
-Remark Zdecomp:
-  forall x, x = Zshiftin (Z.odd x) (Z.div2 x).
-Proof.
-  intros. destruct x; simpl.
-  - auto.
-  - destruct p; auto.
-  - destruct p; auto. simpl. rewrite Pos.pred_double_succ. auto.
-Qed.
-
-Remark Ztestbit_shiftin:
-  forall b x n,
-  0 <= n ->
-  Z.testbit (Zshiftin b x) n = if zeq n 0 then b else Z.testbit x (Z.pred n).
-Proof.
-  intros. rewrite Zshiftin_spec. destruct (zeq n 0).
-  - subst n. destruct b.
-    + apply Z.testbit_odd_0.
-    + rewrite Z.add_0_r. apply Z.testbit_even_0.
-  - assert (0 <= Z.pred n) by omega.
-    set (n' := Z.pred n) in *.
-    replace n with (Z.succ n') by (unfold n'; omega).
-    destruct b.
-    + apply Z.testbit_odd_succ; auto.
-    + rewrite Z.add_0_r. apply Z.testbit_even_succ; auto.
-Qed.
-
-Remark Ztestbit_shiftin_base:
-  forall b x, Z.testbit (Zshiftin b x) 0 = b.
-Proof.
-  intros. rewrite Ztestbit_shiftin. apply zeq_true. omega.
-Qed.
-
-Remark Ztestbit_shiftin_succ:
-  forall b x n, 0 <= n -> Z.testbit (Zshiftin b x) (Z.succ n) = Z.testbit x n.
-Proof.
-  intros. rewrite Ztestbit_shiftin. rewrite zeq_false. rewrite Z.pred_succ. auto.
-  omega. omega.
-Qed.
-
-Remark Ztestbit_eq:
-  forall n x, 0 <= n ->
-  Z.testbit x n = if zeq n 0 then Z.odd x else Z.testbit (Z.div2 x) (Z.pred n).
-Proof.
-  intros. rewrite (Zdecomp x) at 1. apply Ztestbit_shiftin; auto.
-Qed.
-
-Remark Ztestbit_base:
-  forall x, Z.testbit x 0 = Z.odd x.
-Proof.
-  intros. rewrite Ztestbit_eq. apply zeq_true. omega.
-Qed.
-
-Remark Ztestbit_succ:
-  forall n x, 0 <= n -> Z.testbit x (Z.succ n) = Z.testbit (Z.div2 x) n.
-Proof.
-  intros. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ. auto.
-  omega. omega.
-Qed.
-
-Lemma eqmod_same_bits:
-  forall n x y,
-  (forall i, 0 <= i < Z.of_nat n -> Z.testbit x i = Z.testbit y i) ->
-  eqmod (two_power_nat n) x y.
-Proof.
-  induction n; intros.
-  - change (two_power_nat 0) with 1. exists (x-y); ring.
-  - rewrite two_power_nat_S.
-    assert (eqmod (two_power_nat n) (Z.div2 x) (Z.div2 y)).
-      apply IHn. intros. rewrite <- !Ztestbit_succ. apply H. rewrite Nat2Z.inj_succ; omega.
-      omega. omega.
-  destruct H0 as [k EQ].
-  exists k. rewrite (Zdecomp x). rewrite (Zdecomp y).
-  replace (Z.odd y) with (Z.odd x).
-  rewrite EQ. rewrite !Zshiftin_spec. ring.
-  exploit (H 0). rewrite Nat2Z.inj_succ; omega.
-  rewrite !Ztestbit_base. auto.
-Qed.
-
-Lemma eqm_same_bits:
-  forall x y,
-  (forall i, 0 <= i < zwordsize -> Z.testbit x i = Z.testbit y i) ->
-  eqm x y.
-Proof (eqmod_same_bits wordsize).
-
-Lemma same_bits_eqmod:
-  forall n x y i,
-  eqmod (two_power_nat n) x y -> 0 <= i < Z.of_nat n ->
-  Z.testbit x i = Z.testbit y i.
-Proof.
-  induction n; intros.
-  - simpl in H0. omegaContradiction.
-  - rewrite Nat2Z.inj_succ in H0. rewrite two_power_nat_S in H.
-    rewrite !(Ztestbit_eq i); intuition.
-    destruct H as [k EQ].
-    assert (EQ': Zshiftin (Z.odd x) (Z.div2 x) =
-                 Zshiftin (Z.odd y) (k * two_power_nat n + Z.div2 y)).
-    {
-      rewrite (Zdecomp x) in EQ. rewrite (Zdecomp y) in EQ.
-      rewrite EQ. rewrite !Zshiftin_spec. ring.
-    }
-    exploit Zshiftin_inj; eauto. intros [A B].
-    destruct (zeq i 0).
-    + auto.
-    + apply IHn. exists k; auto. omega.
-Qed.
-
-Lemma same_bits_eqm:
-  forall x y i,
-  eqm x y ->
-  0 <= i < zwordsize ->
-  Z.testbit x i = Z.testbit y i.
-Proof (same_bits_eqmod wordsize).
-
-Remark two_power_nat_infinity:
-  forall x, 0 <= x -> exists n, x < two_power_nat n.
-Proof.
-  intros x0 POS0; pattern x0; apply natlike_ind; auto.
-  exists O. compute; auto.
-  intros. destruct H0 as [n LT]. exists (S n). rewrite two_power_nat_S.
-  generalize (two_power_nat_pos n). omega.
-Qed.
-
-Lemma equal_same_bits:
-  forall x y,
-  (forall i, 0 <= i -> Z.testbit x i = Z.testbit y i) ->
-  x = y.
-Proof.
-  intros.
-  set (z := if zlt x y then y - x else x - y).
-  assert (0 <= z).
-    unfold z; destruct (zlt x y); omega.
-  exploit (two_power_nat_infinity z); auto. intros [n LT].
-  assert (eqmod (two_power_nat n) x y).
-    apply eqmod_same_bits. intros. apply H. tauto.
-  assert (eqmod (two_power_nat n) z 0).
-    unfold z. destruct (zlt x y).
-    replace 0 with (y - y) by omega. apply eqmod_sub. apply eqmod_refl. auto.
-    replace 0 with (x - x) by omega. apply eqmod_sub. apply eqmod_refl. apply eqmod_sym; auto.
-  assert (z = 0).
-    apply eqmod_small_eq with (two_power_nat n). auto. omega. generalize (two_power_nat_pos n); omega.
-  unfold z in H3. destruct (zlt x y); omega.
-Qed.
-
-Lemma Z_one_complement:
-  forall i, 0 <= i ->
-  forall x, Z.testbit (-x-1) i = negb (Z.testbit x i).
-Proof.
-  intros i0 POS0. pattern i0. apply Zlt_0_ind; auto.
-  intros i IND POS x.
-  rewrite (Zdecomp x). set (y := Z.div2 x).
-  replace (- Zshiftin (Z.odd x) y - 1)
-     with (Zshiftin (negb (Z.odd x)) (- y - 1)).
-  rewrite !Ztestbit_shiftin; auto.
-  destruct (zeq i 0). auto. apply IND. omega.
-  rewrite !Zshiftin_spec. destruct (Z.odd x); simpl negb; ring.
-Qed.
-
-Lemma Ztestbit_above:
-  forall n x i,
-  0 <= x < two_power_nat n ->
-  i >= Z.of_nat n ->
-  Z.testbit x i = false.
-Proof.
-  induction n; intros.
-  - change (two_power_nat 0) with 1 in H.
-    replace x with 0 by omega.
-    apply Z.testbit_0_l.
-  - rewrite Nat2Z.inj_succ in H0. rewrite Ztestbit_eq. rewrite zeq_false.
-    apply IHn. rewrite two_power_nat_S in H. rewrite (Zdecomp x) in H.
-    rewrite Zshiftin_spec in H. destruct (Z.odd x); omega.
-    omega. omega. omega.
-Qed.
-
-Lemma Ztestbit_above_neg:
-  forall n x i,
-  -two_power_nat n <= x < 0 ->
-  i >= Z.of_nat n ->
-  Z.testbit x i = true.
-Proof.
-  intros. set (y := -x-1).
-  assert (Z.testbit y i = false).
-    apply Ztestbit_above with n.
-    unfold y; omega. auto.
-  unfold y in H1. rewrite Z_one_complement in H1.
-  change true with (negb false). rewrite <- H1. rewrite negb_involutive; auto.
-  omega.
-Qed.
-
-Lemma Zsign_bit:
-  forall n x,
-  0 <= x < two_power_nat (S n) ->
-  Z.testbit x (Z.of_nat n) = if zlt x (two_power_nat n) then false else true.
-Proof.
-  induction n; intros.
-  - change (two_power_nat 1) with 2 in H.
-    assert (x = 0 \/ x = 1) by omega.
-    destruct H0; subst x; reflexivity.
-  - rewrite Nat2Z.inj_succ. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ.
-    rewrite IHn. rewrite two_power_nat_S.
-    destruct (zlt (Z.div2 x) (two_power_nat n)); rewrite (Zdecomp x); rewrite Zshiftin_spec.
-    rewrite zlt_true. auto. destruct (Z.odd x); omega.
-    rewrite zlt_false. auto. destruct (Z.odd x); omega.
-    rewrite (Zdecomp x) in H; rewrite Zshiftin_spec in H.
-    rewrite two_power_nat_S in H. destruct (Z.odd x); omega.
-    omega. omega.
-Qed.
-
-Lemma Zshiftin_ind:
-  forall (P: Z -> Prop),
-  P 0 ->
-  (forall b x, 0 <= x -> P x -> P (Zshiftin b x)) ->
-  forall x, 0 <= x -> P x.
-Proof.
-  intros. destruct x.
-  - auto.
-  - induction p.
-    + change (P (Zshiftin true (Z.pos p))). auto.
-    + change (P (Zshiftin false (Z.pos p))). auto.
-    + change (P (Zshiftin true 0)). apply H0. omega. auto.
-  - compute in H1. intuition congruence.
-Qed.
-
-Lemma Zshiftin_pos_ind:
-  forall (P: Z -> Prop),
-  P 1 ->
-  (forall b x, 0 < x -> P x -> P (Zshiftin b x)) ->
-  forall x, 0 < x -> P x.
-Proof.
-  intros. destruct x; simpl in H1; try discriminate.
-  induction p.
-    + change (P (Zshiftin true (Z.pos p))). auto.
-    + change (P (Zshiftin false (Z.pos p))). auto.
-    + auto.
-Qed.
-
-Lemma Ztestbit_le:
-  forall x y,
-  0 <= y ->
-  (forall i, 0 <= i -> Z.testbit x i = true -> Z.testbit y i = true) ->
-  x <= y.
-Proof.
-  intros x y0 POS0; revert x; pattern y0; apply Zshiftin_ind; auto; intros.
-  - replace x with 0. omega. apply equal_same_bits; intros.
-    rewrite Ztestbit_0. destruct (Z.testbit x i) as [] eqn:E; auto.
-    exploit H; eauto. rewrite Ztestbit_0. auto.
-  - assert (Z.div2 x0 <= x).
-    { apply H0. intros. exploit (H1 (Z.succ i)).
-        omega. rewrite Ztestbit_succ; auto. rewrite Ztestbit_shiftin_succ; auto.
-    }
-    rewrite (Zdecomp x0). rewrite !Zshiftin_spec.
-    destruct (Z.odd x0) as [] eqn:E1; destruct b as [] eqn:E2; try omega.
-    exploit (H1 0). omega. rewrite Ztestbit_base; auto.
-    rewrite Ztestbit_shiftin_base. congruence.
-Qed.
-
-(** ** Bit-level reasoning over type [int] *)
-
 Definition testbit (x: int) (i: Z) : bool := Z.testbit (unsigned x) i.
 
 Lemma testbit_repr:
@@ -1621,6 +1144,12 @@ Proof.
   intros. apply Ztestbit_above with wordsize; auto. apply unsigned_range.
 Qed.
 
+Lemma bits_below:
+  forall x i, i < 0 -> testbit x i = false.
+Proof.
+  intros. apply Z.testbit_neg_r; auto.
+Qed.
+
 Lemma bits_zero:
   forall i, testbit zero i = false.
 Proof.
@@ -1894,7 +1423,7 @@ Proof.
   rewrite bits_or; auto. rewrite H0; auto.
 Qed.
 
-(** Properties of bitwise complement.*)
+(** ** Properties of bitwise complement.*)
 
 Theorem not_involutive:
   forall (x: int), not (not x) = x.
@@ -2013,7 +1542,7 @@ Proof.
   rewrite xor_idem. rewrite unsigned_one, unsigned_zero; auto.
 Qed.
 
-(** Connections between [add] and bitwise logical operations. *)
+(** ** Connections between [add] and bitwise logical operations. *)
 
 Lemma Z_add_is_or:
   forall i, 0 <= i ->
@@ -2464,7 +1993,7 @@ Proof.
   - rewrite andb_false_r; auto.
   - generalize (unsigned_range n); intros.
     rewrite bits_mone. rewrite andb_true_r. f_equal.
-    symmetry. apply Zmod_small. omega.
+    symmetry. apply Z.mod_small. omega.
     omega.
 Qed.
 
@@ -2491,7 +2020,7 @@ Theorem rol_zero:
   rol x zero = x.
 Proof.
   bit_solve. f_equal. rewrite unsigned_zero. rewrite Z.sub_0_r.
-  apply Zmod_small; auto.
+  apply Z.mod_small; auto.
 Qed.
 
 Lemma bitwise_binop_rol:
@@ -2616,65 +2145,31 @@ Proof.
   rewrite !testbit_repr; auto.
   rewrite !Z.lor_spec. rewrite orb_comm. f_equal; apply same_bits_eqm; auto.
   - apply eqm_unsigned_repr_r. apply eqm_refl2. f_equal.
-    rewrite Zmod_small; auto.
+    rewrite Z.mod_small; auto.
     assert (unsigned (add y z) = zwordsize).
       rewrite H1. apply unsigned_repr_wordsize.
     unfold add in H5. rewrite unsigned_repr in H5.
     omega.
     generalize two_wordsize_max_unsigned; omega.
   - apply eqm_unsigned_repr_r. apply eqm_refl2. f_equal.
-    apply Zmod_small; auto.
+    apply Z.mod_small; auto.
 Qed.
 
-(** ** Properties of [Z_one_bits] and [is_power2]. *)
+(** ** Properties of [is_power2]. *)
 
-Fixpoint powerserie (l: list Z): Z :=
-  match l with
-  | nil => 0
-  | x :: xs => two_p x + powerserie xs
-  end.
-
-Lemma Z_one_bits_powerserie:
-  forall x, 0 <= x < modulus -> x = powerserie (Z_one_bits wordsize x 0).
-Proof.
-  assert (forall n x i,
-    0 <= i ->
-    0 <= x < two_power_nat n ->
-    x * two_p i = powerserie (Z_one_bits n x i)).
-  {
-  induction n; intros.
-  simpl. rewrite two_power_nat_O in H0.
-  assert (x = 0) by omega. subst x. omega.
-  rewrite two_power_nat_S in H0. simpl Z_one_bits.
-  rewrite (Zdecomp x) in H0. rewrite Zshiftin_spec in H0.
-  assert (EQ: Z.div2 x * two_p (i + 1) = powerserie (Z_one_bits n (Z.div2 x) (i + 1))).
-    apply IHn. omega.
-    destruct (Z.odd x); omega.
-  rewrite two_p_is_exp in EQ. change (two_p 1) with 2 in EQ.
-  rewrite (Zdecomp x) at 1. rewrite Zshiftin_spec.
-  destruct (Z.odd x); simpl powerserie; rewrite <- EQ; ring.
-  omega. omega.
-  }
-  intros. rewrite <- H. change (two_p 0) with 1. omega.
-  omega. exact H0.
-Qed.
-
-Lemma Z_one_bits_range:
-  forall x i, In i (Z_one_bits wordsize x 0) -> 0 <= i < zwordsize.
+Remark is_power2_inv:
+  forall n logn,
+  is_power2 n = Some logn ->
+  Z_is_power2 (unsigned n) = Some (unsigned logn) /\ 0 <= unsigned logn < zwordsize.
 Proof.
-  assert (forall n x i j,
-    In j (Z_one_bits n x i) -> i <= j < i + Z.of_nat n).
-  {
-  induction n; simpl In.
-  tauto.
-  intros x i j. rewrite Nat2Z.inj_succ.
-  assert (In j (Z_one_bits n (Z.div2 x) (i + 1)) -> i <= j < i + Z.succ (Z.of_nat n)).
-    intros. exploit IHn; eauto. omega.
-  destruct (Z.odd x); simpl.
-  intros [A|B]. subst j. omega. auto.
-  auto.
-  }
-  intros. generalize (H wordsize x 0 i H0). fold zwordsize; omega.
+  unfold is_power2; intros.
+  destruct (Z_is_power2 (unsigned n)) as [i|] eqn:E; inv H.
+  assert (0 <= i < zwordsize).
+  { apply Z_is_power2_range with (unsigned n). 
+    generalize wordsize_pos; omega.
+    rewrite <- modulus_power. apply unsigned_range.
+    auto. }
+  rewrite unsigned_repr; auto. generalize wordsize_max_unsigned; omega.
 Qed.
 
 Lemma is_power2_rng:
@@ -2682,16 +2177,7 @@ Lemma is_power2_rng:
   is_power2 n = Some logn ->
   0 <= unsigned logn < zwordsize.
 Proof.
-  intros n logn. unfold is_power2.
-  generalize (Z_one_bits_range (unsigned n)).
-  destruct (Z_one_bits wordsize (unsigned n) 0).
-  intros; discriminate.
-  destruct l.
-  intros. injection H0; intro; subst logn; clear H0.
-  assert (0 <= z < zwordsize).
-  apply H. auto with coqlib.
-  rewrite unsigned_repr. auto. generalize wordsize_max_unsigned; omega.
-  intros; discriminate.
+  intros. apply (is_power2_inv n logn); auto.
 Qed.
 
 Theorem is_power2_range:
@@ -2707,18 +2193,8 @@ Lemma is_power2_correct:
   is_power2 n = Some logn ->
   unsigned n = two_p (unsigned logn).
 Proof.
-  intros n logn. unfold is_power2.
-  generalize (Z_one_bits_powerserie (unsigned n) (unsigned_range n)).
-  generalize (Z_one_bits_range (unsigned n)).
-  destruct (Z_one_bits wordsize (unsigned n) 0).
-  intros; discriminate.
-  destruct l.
-  intros. simpl in H0. injection H1; intros; subst logn; clear H1.
-  rewrite unsigned_repr. replace (two_p z) with (two_p z + 0).
-  auto. omega. elim (H z); intros.
-  generalize wordsize_max_unsigned; omega.
-  auto with coqlib.
-  intros; discriminate.
+  intros. apply is_power2_inv in H. destruct H as [P Q].
+  apply Z_is_power2_sound in P. tauto.
 Qed.
 
 Remark two_p_range:
@@ -2733,34 +2209,12 @@ Proof.
   unfold max_unsigned, modulus. omega.
 Qed.
 
-Remark Z_one_bits_zero:
-  forall n i, Z_one_bits n 0 i = nil.
-Proof.
-  induction n; intros; simpl; auto.
-Qed.
-
-Remark Z_one_bits_two_p:
-  forall n x i,
-  0 <= x < Z.of_nat n ->
-  Z_one_bits n (two_p x) i = (i + x) :: nil.
-Proof.
-  induction n; intros; simpl. simpl in H. omegaContradiction.
-  rewrite Nat2Z.inj_succ in H.
-  assert (x = 0 \/ 0 < x) by omega. destruct H0.
-  subst x; simpl. decEq. omega. apply Z_one_bits_zero.
-  assert (Z.odd (two_p x) = false /\ Z.div2 (two_p x) = two_p (x-1)).
-    apply Zshiftin_inj. rewrite <- Zdecomp. rewrite !Zshiftin_spec.
-    rewrite <- two_p_S. rewrite Z.add_0_r. f_equal; omega. omega.
-  destruct H1 as [A B]; rewrite A; rewrite B.
-  rewrite IHn. f_equal; omega. omega.
-Qed.
-
 Lemma is_power2_two_p:
   forall n, 0 <= n < zwordsize ->
   is_power2 (repr (two_p n)) = Some (repr n).
 Proof.
   intros. unfold is_power2. rewrite unsigned_repr.
-  rewrite Z_one_bits_two_p. auto. auto.
+  rewrite Z_is_power2_complete by omega; auto.
   apply two_p_range. auto.
 Qed.
 
@@ -2768,19 +2222,6 @@ Qed.
 
 (** Left shifts and multiplications by powers of 2. *)
 
-Lemma Zshiftl_mul_two_p:
-  forall x n, 0 <= n -> Z.shiftl x n = x * two_p n.
-Proof.
-  intros. destruct n; simpl.
-  - omega.
-  - pattern p. apply Pos.peano_ind.
-    + change (two_power_pos 1) with 2. simpl. ring.
-    + intros. rewrite Pos.iter_succ. rewrite H0.
-      rewrite Pplus_one_succ_l. rewrite two_power_pos_is_exp.
-      change (two_power_pos 1) with 2. ring.
-  - compute in H. congruence.
-Qed.
-
 Lemma shl_mul_two_p:
   forall x y,
   shl x y = mul x (repr (two_p (unsigned y))).
@@ -2840,21 +2281,6 @@ Qed.
 
 (** Unsigned right shifts and unsigned divisions by powers of 2. *)
 
-Lemma Zshiftr_div_two_p:
-  forall x n, 0 <= n -> Z.shiftr x n = x / two_p n.
-Proof.
-  intros. destruct n; unfold Z.shiftr; simpl.
-  - rewrite Zdiv_1_r. auto.
-  - pattern p. apply Pos.peano_ind.
-    + change (two_power_pos 1) with 2. simpl. apply Zdiv2_div.
-    + intros. rewrite Pos.iter_succ. rewrite H0.
-      rewrite Pplus_one_succ_l. rewrite two_power_pos_is_exp.
-      change (two_power_pos 1) with 2.
-      rewrite Zdiv2_div. rewrite Z.mul_comm. apply Zdiv_Zdiv.
-      rewrite two_power_pos_nat. apply two_power_nat_pos. omega.
-  - compute in H. congruence.
-Qed.
-
 Lemma shru_div_two_p:
   forall x y,
   shru x y = repr (unsigned x / two_p (unsigned y)).
@@ -2897,43 +2323,6 @@ Qed.
 
 (** Unsigned modulus over [2^n] is masking with [2^n-1]. *)
 
-Lemma Ztestbit_mod_two_p:
-  forall n x i,
-  0 <= n -> 0 <= i ->
-  Z.testbit (x mod (two_p n)) i = if zlt i n then Z.testbit x i else false.
-Proof.
-  intros n0 x i N0POS. revert x i; pattern n0; apply natlike_ind; auto.
-  - intros. change (two_p 0) with 1. rewrite Zmod_1_r. rewrite Z.testbit_0_l.
-    rewrite zlt_false; auto. omega.
-  - intros. rewrite two_p_S; auto.
-    replace (x0 mod (2 * two_p x))
-       with (Zshiftin (Z.odd x0) (Z.div2 x0 mod two_p x)).
-    rewrite Ztestbit_shiftin; auto. rewrite (Ztestbit_eq i x0); auto. destruct (zeq i 0).
-    + rewrite zlt_true; auto. omega.
-    + rewrite H0. destruct (zlt (Z.pred i) x).
-      * rewrite zlt_true; auto. omega.
-      * rewrite zlt_false; auto. omega.
-      * omega.
-    + rewrite (Zdecomp x0) at 3. set (x1 := Z.div2 x0). symmetry.
-      apply Zmod_unique with (x1 / two_p x).
-      rewrite !Zshiftin_spec. rewrite Z.add_assoc. f_equal.
-      transitivity (2 * (two_p x * (x1 / two_p x) + x1 mod two_p x)).
-      f_equal. apply Z_div_mod_eq. apply two_p_gt_ZERO; auto.
-      ring.
-      rewrite Zshiftin_spec. exploit (Z_mod_lt x1 (two_p x)). apply two_p_gt_ZERO; auto.
-      destruct (Z.odd x0); omega.
-Qed.
-
-Corollary Ztestbit_two_p_m1:
-  forall n i, 0 <= n -> 0 <= i ->
-  Z.testbit (two_p n - 1) i = if zlt i n then true else false.
-Proof.
-  intros. replace (two_p n - 1) with ((-1) mod (two_p n)).
-  rewrite Ztestbit_mod_two_p; auto. destruct (zlt i n); auto. apply Ztestbit_m1; auto.
-  apply Zmod_unique with (-1). ring.
-  exploit (two_p_gt_ZERO n). auto. omega.
-Qed.
-
 Theorem modu_and:
   forall x n logn,
   is_power2 n = Some logn ->
@@ -2955,21 +2344,6 @@ Qed.
 
 (** ** Properties of [shrx] (signed division by a power of 2) *)
 
-Lemma Zquot_Zdiv:
-  forall x y,
-  y > 0 ->
-  Z.quot x y = if zlt x 0 then (x + y - 1) / y else x / y.
-Proof.
-  intros. destruct (zlt x 0).
-  - symmetry. apply Zquot_unique_full with ((x + y - 1) mod y - (y - 1)).
-     + red. right; split. omega.
-       exploit (Z_mod_lt (x + y - 1) y); auto.
-       rewrite Z.abs_eq. omega. omega.
-     + transitivity ((y * ((x + y - 1) / y) + (x + y - 1) mod y) - (y-1)).
-       rewrite <- Z_div_mod_eq. ring. auto. ring.
-  - apply Zquot_Zdiv_pos; omega.
-Qed.
-
 Theorem shrx_zero:
   forall x, zwordsize > 1 -> shrx x zero = x.
 Proof.
@@ -3048,17 +2422,6 @@ Proof.
   bit_solve. destruct (zlt (i + unsigned (sub iwordsize y)) zwordsize); auto.
 Qed.
 
-Lemma Zdiv_shift:
-  forall x y, y > 0 ->
-  (x + (y - 1)) / y = x / y + if zeq (Z.modulo x y) 0 then 0 else 1.
-Proof.
-  intros. generalize (Z_div_mod_eq x y H). generalize (Z_mod_lt x y H).
-  set (q := x / y). set (r := x mod y). intros.
-  destruct (zeq r 0).
-  apply Zdiv_unique with (y - 1). rewrite H1. rewrite e. ring. omega.
-  apply Zdiv_unique with (r - 1). rewrite H1. ring. omega.
-Qed.
-
 Theorem shrx_carry:
   forall x y,
   ltu y (repr (zwordsize - 1)) = true ->
@@ -3149,51 +2512,6 @@ Qed.
 
 (** ** Properties of integer zero extension and sign extension. *)
 
-Lemma Ziter_base:
-  forall (A: Type) n (f: A -> A) x, n <= 0 -> Z.iter n f x = x.
-Proof.
-  intros. unfold Z.iter. destruct n; auto. compute in H. elim H; auto.
-Qed.
-
-Lemma Ziter_succ:
-  forall (A: Type) n (f: A -> A) x,
-  0 <= n -> Z.iter (Z.succ n) f x = f (Z.iter n f x).
-Proof.
-  intros. destruct n; simpl.
-  - auto.
-  - rewrite Pos.add_1_r. apply Pos.iter_succ.
-  - compute in H. elim H; auto.
-Qed.
-
-Lemma Znatlike_ind:
-  forall (P: Z -> Prop),
-  (forall n, n <= 0 -> P n) ->
-  (forall n, 0 <= n -> P n -> P (Z.succ n)) ->
-  forall n, P n.
-Proof.
-  intros. destruct (zle 0 n).
-  apply natlike_ind; auto. apply H; omega.
-  apply H. omega.
-Qed.
-
-Lemma Zzero_ext_spec:
-  forall n x i, 0 <= i ->
-  Z.testbit (Zzero_ext n x) i = if zlt i n then Z.testbit x i else false.
-Proof.
-  unfold Zzero_ext. induction n using Znatlike_ind.
-  - intros. rewrite Ziter_base; auto.
-    rewrite zlt_false. rewrite Ztestbit_0; auto. omega.
-  - intros. rewrite Ziter_succ; auto.
-    rewrite Ztestbit_shiftin; auto.
-    rewrite (Ztestbit_eq i x); auto.
-    destruct (zeq i 0).
-    + subst i. rewrite zlt_true; auto. omega.
-    + rewrite IHn. destruct (zlt (Z.pred i) n).
-      rewrite zlt_true; auto. omega.
-      rewrite zlt_false; auto. omega.
-      omega.
-Qed.
-
 Lemma bits_zero_ext:
   forall n x i, 0 <= i ->
   testbit (zero_ext n x) i = if zlt i n then testbit x i else false.
@@ -3203,42 +2521,12 @@ Proof.
   rewrite !bits_above; auto. destruct (zlt i n); auto.
 Qed.
 
-Lemma Zsign_ext_spec:
-  forall n x i, 0 <= i -> 0 < n ->
-  Z.testbit (Zsign_ext n x) i = Z.testbit x (if zlt i n then i else n - 1).
-Proof.
-  intros n0 x i I0 N0.
-  revert x i I0. pattern n0. apply Zlt_lower_bound_ind with (z := 1).
-  - unfold Zsign_ext. intros.
-    destruct (zeq x 1).
-    + subst x; simpl.
-      replace (if zlt i 1 then i else 0) with 0.
-      rewrite Ztestbit_base.
-      destruct (Z.odd x0).
-      apply Ztestbit_m1; auto.
-      apply Ztestbit_0.
-      destruct (zlt i 1); omega.
-    + set (x1 := Z.pred x). replace x1 with (Z.succ (Z.pred x1)).
-      rewrite Ziter_succ. rewrite Ztestbit_shiftin.
-      destruct (zeq i 0).
-      * subst i. rewrite zlt_true. rewrite Ztestbit_base; auto. omega.
-      * rewrite H. unfold x1. destruct (zlt (Z.pred i) (Z.pred x)).
-        rewrite zlt_true. rewrite (Ztestbit_eq i x0); auto. rewrite zeq_false; auto. omega.
-        rewrite zlt_false. rewrite (Ztestbit_eq (x - 1) x0). rewrite zeq_false; auto.
-        omega. omega. omega. unfold x1; omega. omega.
-      * omega.
-      * unfold x1; omega.
-      * omega.
-  - omega.
-Qed.
-
 Lemma bits_sign_ext:
-  forall n x i, 0 <= i < zwordsize -> 0 < n ->
+  forall n x i, 0 <= i < zwordsize ->
   testbit (sign_ext n x) i = testbit x (if zlt i n then i else n - 1).
 Proof.
   intros. unfold sign_ext.
-  rewrite testbit_repr; auto. rewrite Zsign_ext_spec. destruct (zlt i n); auto.
-  omega. auto.
+  rewrite testbit_repr; auto. apply Zsign_ext_spec. omega. 
 Qed.
 
 Hint Rewrite bits_zero_ext bits_sign_ext: ints.
@@ -3250,12 +2538,24 @@ Proof.
   rewrite bits_zero_ext. apply zlt_true. omega. omega.
 Qed.
 
+Theorem zero_ext_below:
+  forall n x, n <= 0 -> zero_ext n x = zero.
+Proof.
+  intros. bit_solve. destruct (zlt i n); auto. apply bits_below; omega. omega.
+Qed.
+
 Theorem sign_ext_above:
   forall n x, n >= zwordsize -> sign_ext n x = x.
 Proof.
   intros. apply same_bits_eq; intros.
   unfold sign_ext; rewrite testbit_repr; auto.
-  rewrite Zsign_ext_spec. rewrite zlt_true. auto. omega. omega. omega.
+  rewrite Zsign_ext_spec. rewrite zlt_true. auto. omega. omega.
+Qed.
+
+Theorem sign_ext_below:
+  forall n x, n <= 0 -> sign_ext n x = zero.
+Proof.
+  intros. bit_solve. apply bits_below. destruct (zlt i n); omega.
 Qed.
 
 Theorem zero_ext_and:
@@ -3292,7 +2592,7 @@ Proof.
 Qed.
 
 Theorem sign_ext_widen:
-  forall x n n', 0 < n  <= n' ->
+  forall x n n', 0 < n <= n' ->
   sign_ext n' (sign_ext n x) = sign_ext n x.
 Proof.
   intros. destruct (zlt n' zwordsize).
@@ -3300,9 +2600,8 @@ Proof.
   auto.
   rewrite (zlt_false _ i n).
   destruct (zlt (n' - 1) n); f_equal; omega.
-  omega. omega.
+  omega.
   destruct (zlt i n'); omega.
-  omega. omega.
   apply sign_ext_above; auto.
 Qed.
 
@@ -3316,7 +2615,6 @@ Proof.
   auto.
   rewrite !zlt_false. auto. omega. omega. omega.
   destruct (zlt i n'); omega.
-  omega.
   apply sign_ext_above; auto.
 Qed.
 
@@ -3336,9 +2634,7 @@ Theorem sign_ext_narrow:
 Proof.
   intros. destruct (zlt n zwordsize).
   bit_solve. destruct (zlt i n); f_equal; apply zlt_true; omega.
-  omega.
   destruct (zlt i n); omega.
-  omega. omega.
   rewrite (sign_ext_above n'). auto. omega.
 Qed.
 
@@ -3350,7 +2646,7 @@ Proof.
   bit_solve.
   destruct (zlt i n); auto.
   rewrite zlt_true; auto. omega.
-  omega. omega. omega.
+  omega. omega.
   rewrite sign_ext_above; auto.
 Qed.
 
@@ -3365,7 +2661,7 @@ Theorem sign_ext_idem:
 Proof.
   intros. apply sign_ext_widen. omega.
 Qed.
-
+ 
 Theorem sign_ext_zero_ext:
   forall n x, 0 < n -> sign_ext n (zero_ext n x) = sign_ext n x.
 Proof.
@@ -3393,42 +2689,93 @@ Proof.
   rewrite <- (sign_ext_zero_ext n y H). congruence.
 Qed.
 
-Theorem zero_ext_shru_shl:
+Theorem shru_shl:
+  forall x y z, ltu y iwordsize = true -> ltu z iwordsize = true ->
+  shru (shl x y) z =
+  if ltu z y then shl (zero_ext (zwordsize - unsigned y) x) (sub y z)
+             else zero_ext (zwordsize - unsigned z) (shru x (sub z y)).
+Proof.
+  intros. apply ltu_iwordsize_inv in H; apply ltu_iwordsize_inv in H0.
+  unfold ltu. set (Y := unsigned y) in *; set (Z := unsigned z) in *.
+  apply same_bits_eq; intros. rewrite bits_shru by auto. fold Z.
+  destruct (zlt Z Y).
+- assert (A: unsigned (sub y z) = Y - Z).
+  { apply unsigned_repr. generalize wordsize_max_unsigned; omega. }
+  symmetry; rewrite bits_shl, A by omega.
+  destruct (zlt (i + Z) zwordsize).
++ rewrite bits_shl by omega. fold Y.
+  destruct (zlt i (Y - Z)); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto.
+  rewrite bits_zero_ext by omega. rewrite zlt_true by omega. f_equal; omega.
++ rewrite bits_zero_ext by omega. rewrite ! zlt_false by omega. auto.
+- assert (A: unsigned (sub z y) = Z - Y).
+  { apply unsigned_repr. generalize wordsize_max_unsigned; omega. }
+  rewrite bits_zero_ext, bits_shru, A by omega.
+  destruct (zlt (i + Z) zwordsize); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto.
+  rewrite bits_shl by omega. fold Y.
+  destruct (zlt (i + Z) Y).
++ rewrite zlt_false by omega. auto.
++ rewrite zlt_true by omega. f_equal; omega.
+Qed.
+
+Corollary zero_ext_shru_shl:
   forall n x,
   0 < n < zwordsize ->
   let y := repr (zwordsize - n) in
   zero_ext n x = shru (shl x y) y.
 Proof.
   intros.
-  assert (unsigned y = zwordsize - n).
-    unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega.
-  apply same_bits_eq; intros.
-  rewrite bits_zero_ext.
-  rewrite bits_shru; auto.
-  destruct (zlt i n).
-  rewrite zlt_true. rewrite bits_shl. rewrite zlt_false. f_equal. omega.
-  omega. omega. omega.
-  rewrite zlt_false. auto. omega.
-  omega.
-Qed.
-
-Theorem sign_ext_shr_shl:
+  assert (A: unsigned y = zwordsize - n).
+  { unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega. }
+  assert (B: ltu y iwordsize = true).
+  { unfold ltu; rewrite A, unsigned_repr_wordsize. apply zlt_true; omega. }
+  rewrite shru_shl by auto. unfold ltu; rewrite zlt_false by omega.
+  rewrite sub_idem, shru_zero. f_equal. rewrite A; omega.
+Qed.
+
+Theorem shr_shl:
+  forall x y z, ltu y iwordsize = true -> ltu z iwordsize = true ->
+  shr (shl x y) z =
+  if ltu z y then shl (sign_ext (zwordsize - unsigned y) x) (sub y z)
+             else sign_ext (zwordsize - unsigned z) (shr x (sub z y)).
+Proof.
+  intros. apply ltu_iwordsize_inv in H; apply ltu_iwordsize_inv in H0.
+  unfold ltu. set (Y := unsigned y) in *; set (Z := unsigned z) in *.
+  apply same_bits_eq; intros. rewrite bits_shr by auto. fold Z.
+  rewrite bits_shl by (destruct (zlt (i + Z) zwordsize); omega). fold Y.
+  destruct (zlt Z Y).
+- assert (A: unsigned (sub y z) = Y - Z).
+  { apply unsigned_repr. generalize wordsize_max_unsigned; omega. }
+  rewrite bits_shl, A by omega.
+  destruct (zlt i (Y - Z)).
++ apply zlt_true. destruct (zlt (i + Z) zwordsize); omega.
++ rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); omega).
+  rewrite bits_sign_ext by omega. f_equal. 
+  destruct (zlt (i + Z) zwordsize).
+  rewrite zlt_true by omega. omega.
+  rewrite zlt_false by omega. omega.
+- assert (A: unsigned (sub z y) = Z - Y).
+  { apply unsigned_repr. generalize wordsize_max_unsigned; omega. }
+  rewrite bits_sign_ext by omega.
+  rewrite bits_shr by (destruct (zlt i (zwordsize - Z)); omega).
+  rewrite A. rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); omega).
+  f_equal. destruct (zlt i (zwordsize - Z)).
++ rewrite ! zlt_true by omega. omega.
++ rewrite ! zlt_false by omega. rewrite zlt_true by omega. omega.
+Qed.
+
+Corollary sign_ext_shr_shl:
   forall n x,
   0 < n < zwordsize ->
   let y := repr (zwordsize - n) in
   sign_ext n x = shr (shl x y) y.
 Proof.
   intros.
-  assert (unsigned y = zwordsize - n).
-    unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega.
-  apply same_bits_eq; intros.
-  rewrite bits_sign_ext.
-  rewrite bits_shr; auto.
-  destruct (zlt i n).
-  rewrite zlt_true. rewrite bits_shl. rewrite zlt_false. f_equal. omega.
-  omega. omega. omega.
-  rewrite zlt_false. rewrite bits_shl. rewrite zlt_false. f_equal. omega.
-  omega. omega. omega. omega. omega.
+  assert (A: unsigned y = zwordsize - n).
+  { unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega. }
+  assert (B: ltu y iwordsize = true).
+  { unfold ltu; rewrite A, unsigned_repr_wordsize. apply zlt_true; omega. }
+  rewrite shr_shl by auto. unfold ltu; rewrite zlt_false by omega.
+  rewrite sub_idem, shr_zero. f_equal. rewrite A; omega.
 Qed.
 
 (** [zero_ext n x] is the unique integer congruent to [x] modulo [2^n]
@@ -3488,7 +2835,7 @@ Proof.
   apply eqmod_same_bits; intros.
   rewrite H0 in H1. rewrite H0.
   fold (testbit (sign_ext n x) i). rewrite bits_sign_ext.
-  rewrite zlt_true. auto. omega. omega. omega.
+  rewrite zlt_true. auto. omega. omega.
 Qed.
 
 Lemma eqmod_sign_ext:
@@ -3503,6 +2850,132 @@ Proof.
   apply eqmod_sign_ext'; auto.
 Qed.
 
+(** Combinations of shifts and zero/sign extensions *)
+
+Lemma shl_zero_ext:
+  forall n m x, 0 <= n ->
+  shl (zero_ext n x) m = zero_ext (n + unsigned m) (shl x m).
+Proof.
+  intros. apply same_bits_eq; intros.
+  rewrite bits_zero_ext, ! bits_shl by omega.
+  destruct (zlt i (unsigned m)).
+- rewrite zlt_true by omega; auto.
+- rewrite bits_zero_ext by omega.
+  destruct (zlt (i - unsigned m) n); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto.
+Qed.
+
+Lemma shl_sign_ext:
+  forall n m x, 0 < n ->
+  shl (sign_ext n x) m = sign_ext (n + unsigned m) (shl x m).
+Proof.
+  intros. generalize (unsigned_range m); intros.
+  apply same_bits_eq; intros.
+  rewrite bits_sign_ext, ! bits_shl by omega.
+  destruct (zlt i (n + unsigned m)).
+- rewrite bits_shl by auto. destruct (zlt i (unsigned m)); auto.
+  rewrite bits_sign_ext by omega. f_equal. apply zlt_true. omega.
+- rewrite zlt_false by omega. rewrite bits_shl by omega. rewrite zlt_false by omega.
+  rewrite bits_sign_ext by omega. f_equal. rewrite zlt_false by omega. omega.
+Qed.
+
+Lemma shru_zero_ext:
+  forall n m x, 0 <= n ->
+  shru (zero_ext (n + unsigned m) x) m = zero_ext n (shru x m).
+Proof.
+  intros. bit_solve.
+- destruct (zlt (i + unsigned m) zwordsize).
+* destruct (zlt i n); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto.
+* destruct (zlt i n); auto.
+- generalize (unsigned_range m); omega.
+- omega.
+Qed.
+
+Lemma shru_zero_ext_0:
+  forall n m x, n <= unsigned m ->
+  shru (zero_ext n x) m = zero.
+Proof.
+  intros. bit_solve.
+- destruct (zlt (i + unsigned m) zwordsize); auto.
+  apply zlt_false. omega.
+- generalize (unsigned_range m); omega.
+Qed.
+
+Lemma shr_sign_ext:
+  forall n m x, 0 < n -> n + unsigned m < zwordsize ->
+  shr (sign_ext (n + unsigned m) x) m = sign_ext n (shr x m).
+Proof.
+  intros. generalize (unsigned_range m); intros.
+  apply same_bits_eq; intros.
+  rewrite bits_sign_ext, bits_shr by auto.
+  rewrite bits_sign_ext, bits_shr.
+- f_equal.
+  destruct (zlt i n), (zlt (i + unsigned m) zwordsize).
++ apply zlt_true; omega.
++ apply zlt_true; omega.
++ rewrite zlt_false by omega. rewrite zlt_true by omega. omega.
++ rewrite zlt_false by omega. rewrite zlt_true by omega. omega.
+- destruct (zlt i n); omega.
+- destruct (zlt (i + unsigned m) zwordsize); omega.
+Qed.
+
+Lemma zero_ext_shru_min:
+  forall s x n, ltu n iwordsize = true ->
+  zero_ext s (shru x n) = zero_ext (Z.min s (zwordsize - unsigned n)) (shru x n).
+Proof.
+  intros. apply ltu_iwordsize_inv in H.
+  apply Z.min_case_strong; intros; auto.
+  bit_solve; try omega.
+  destruct (zlt i (zwordsize - unsigned n)).
+  rewrite zlt_true by omega. auto.
+  destruct (zlt i s); auto. rewrite zlt_false by omega; auto.
+Qed.
+
+Lemma sign_ext_shr_min:
+  forall s x n, ltu n iwordsize = true ->
+  sign_ext s (shr x n) = sign_ext (Z.min s (zwordsize - unsigned n)) (shr x n).
+Proof.
+  intros. apply ltu_iwordsize_inv in H.
+  rewrite Z.min_comm. 
+  destruct (Z.min_spec (zwordsize - unsigned n) s) as [[A B] | [A B]]; rewrite B; auto.
+  apply same_bits_eq; intros. rewrite ! bits_sign_ext by auto.
+  destruct (zlt i (zwordsize - unsigned n)). 
+  rewrite zlt_true by omega. auto.
+  assert (C: testbit (shr x n) (zwordsize - unsigned n - 1) = testbit x (zwordsize - 1)).
+  { rewrite bits_shr by omega. rewrite zlt_true by omega. f_equal; omega. }
+  rewrite C. destruct (zlt i s); rewrite bits_shr by omega.
+  rewrite zlt_false by omega. auto.
+  rewrite zlt_false by omega. auto.
+Qed.
+
+Lemma shl_zero_ext_min:
+  forall s x n, ltu n iwordsize = true ->
+  shl (zero_ext s x) n = shl (zero_ext (Z.min s (zwordsize - unsigned n)) x) n.
+Proof.
+  intros. apply ltu_iwordsize_inv in H.
+  apply Z.min_case_strong; intros; auto.
+  apply same_bits_eq; intros. rewrite ! bits_shl by auto.
+  destruct (zlt i (unsigned n)); auto.
+  rewrite ! bits_zero_ext by omega.
+  destruct (zlt (i - unsigned n) s).
+  rewrite zlt_true by omega; auto.
+  rewrite zlt_false by omega; auto.
+Qed.
+
+Lemma shl_sign_ext_min:
+  forall s x n, ltu n iwordsize = true ->
+  shl (sign_ext s x) n = shl (sign_ext (Z.min s (zwordsize - unsigned n)) x) n.
+Proof.
+  intros. apply ltu_iwordsize_inv in H.
+  rewrite Z.min_comm. 
+  destruct (Z.min_spec (zwordsize - unsigned n) s) as [[A B] | [A B]]; rewrite B; auto.
+  apply same_bits_eq; intros. rewrite ! bits_shl by auto.
+  destruct (zlt i (unsigned n)); auto.
+  rewrite ! bits_sign_ext by omega. f_equal.
+  destruct (zlt (i - unsigned n) s).
+  rewrite zlt_true by omega; auto.
+  omegaContradiction.
+Qed.
+
 (** ** Properties of [one_bits] (decomposition in sum of powers of two) *)
 
 Theorem one_bits_range:
@@ -3533,7 +3006,7 @@ Proof.
   auto with ints. decEq. apply Z_one_bits_powerserie.
   auto with ints.
   unfold one_bits.
-  generalize (Z_one_bits_range (unsigned x)).
+  generalize (Z_one_bits_range wordsize (unsigned x)).
   generalize (Z_one_bits wordsize (unsigned x) 0).
   induction l.
   intros; reflexivity.
@@ -3541,7 +3014,8 @@ Proof.
   apply eqm_add. rewrite shl_mul_two_p. rewrite mul_commut.
   rewrite mul_one. apply eqm_unsigned_repr_r.
   rewrite unsigned_repr. auto with ints.
-  generalize (H a (in_eq _ _)). generalize wordsize_max_unsigned. omega.
+  generalize (H a (in_eq _ _)). change (Z.of_nat wordsize) with zwordsize.
+  generalize wordsize_max_unsigned. omega.
   auto with ints.
   intros; apply H; auto with coqlib.
 Qed.
@@ -3741,8 +3215,7 @@ Proof.
   intros. rewrite <- negb_orb. rewrite <- not_ltu. rewrite negb_involutive. auto.
 Qed.
 
-
-(** Non-overlapping test *)
+(** ** Non-overlapping test *)
 
 Definition no_overlap (ofs1: int) (sz1: Z) (ofs2: int) (sz2: Z) : bool :=
   let x1 := unsigned ofs1 in let x2 := unsigned ofs2 in
@@ -3768,94 +3241,10 @@ Proof.
   intros [C|C] [D|D]; omega.
 Qed.
 
-(** Size of integers, in bits. *)
-
-Definition Zsize (x: Z) : Z :=
-  match x with
-  | Zpos p => Zpos (Pos.size p)
-  | _ => 0
-  end.
+(** ** Size of integers, in bits. *)
 
 Definition size (x: int) : Z := Zsize (unsigned x).
 
-Remark Zsize_pos: forall x, 0 <= Zsize x.
-Proof.
-  destruct x; simpl. omega. compute; intuition congruence. omega.
-Qed.
-
-Remark Zsize_pos': forall x, 0 < x -> 0 < Zsize x.
-Proof.
-  destruct x; simpl; intros; try discriminate. compute; auto.
-Qed.
-
-Lemma Zsize_shiftin:
-  forall b x, 0 < x -> Zsize (Zshiftin b x) = Z.succ (Zsize x).
-Proof.
-  intros. destruct x; compute in H; try discriminate.
-  destruct b.
-  change (Zshiftin true (Zpos p)) with (Zpos (p~1)).
-  simpl. f_equal. rewrite Pos.add_1_r; auto.
-  change (Zshiftin false (Zpos p)) with (Zpos (p~0)).
-  simpl. f_equal. rewrite Pos.add_1_r; auto.
-Qed.
-
-Lemma Ztestbit_size_1:
-  forall x, 0 < x -> Z.testbit x (Z.pred (Zsize x)) = true.
-Proof.
-  intros x0 POS0; pattern x0; apply Zshiftin_pos_ind; auto.
-  intros. rewrite Zsize_shiftin; auto.
-  replace (Z.pred (Z.succ (Zsize x))) with (Z.succ (Z.pred (Zsize x))) by omega.
-  rewrite Ztestbit_shiftin_succ. auto. generalize (Zsize_pos' x H); omega.
-Qed.
-
-Lemma Ztestbit_size_2:
-  forall x, 0 <= x -> forall i, i >= Zsize x -> Z.testbit x i = false.
-Proof.
-  intros x0 POS0. destruct (zeq x0 0).
-  - subst x0; intros. apply Ztestbit_0.
-  - pattern x0; apply Zshiftin_pos_ind.
-    + simpl. intros. change 1 with (Zshiftin true 0). rewrite Ztestbit_shiftin.
-      rewrite zeq_false. apply Ztestbit_0. omega. omega.
-    + intros. rewrite Zsize_shiftin in H1; auto.
-      generalize (Zsize_pos' _ H); intros.
-      rewrite Ztestbit_shiftin. rewrite zeq_false. apply H0. omega.
-      omega. omega.
-    + omega.
-Qed.
-
-Lemma Zsize_interval_1:
-  forall x, 0 <= x -> 0 <= x < two_p (Zsize x).
-Proof.
-  intros.
-  assert (x = x mod (two_p (Zsize x))).
-    apply equal_same_bits; intros.
-    rewrite Ztestbit_mod_two_p; auto.
-    destruct (zlt i (Zsize x)). auto. apply Ztestbit_size_2; auto.
-    apply Zsize_pos; auto.
-  rewrite H0 at 1. rewrite H0 at 3. apply Z_mod_lt. apply two_p_gt_ZERO. apply Zsize_pos; auto.
-Qed.
-
-Lemma Zsize_interval_2:
-  forall x n, 0 <= n -> 0 <= x < two_p n -> n >= Zsize x.
-Proof.
-  intros. set (N := Z.to_nat n).
-  assert (Z.of_nat N = n) by (apply Z2Nat.id; auto).
-  rewrite <- H1 in H0. rewrite <- two_power_nat_two_p in H0.
-  destruct (zeq x 0).
-  subst x; simpl; omega.
-  destruct (zlt n (Zsize x)); auto.
-  exploit (Ztestbit_above N x (Z.pred (Zsize x))). auto. omega.
-  rewrite Ztestbit_size_1. congruence. omega.
-Qed.
-
-Lemma Zsize_monotone:
-  forall x y, 0 <= x <= y -> Zsize x <= Zsize y.
-Proof.
-  intros. apply Z.ge_le. apply Zsize_interval_2. apply Zsize_pos.
-  exploit (Zsize_interval_1 y). omega.
-  omega.
-Qed.
-
 Theorem size_zero: size zero = 0.
 Proof.
   unfold size; rewrite unsigned_zero; auto.
@@ -3933,10 +3322,11 @@ Proof.
   assert (0 <= Z.min (size a) (size b)).
     generalize (size_range a) (size_range b). zify; omega.
   apply bits_size_3. auto. intros.
-  rewrite bits_and. zify. subst z z0. destruct H1.
-  rewrite (bits_size_2 a). auto. omega.
-  rewrite (bits_size_2 b). apply andb_false_r. omega.
-  omega.
+  rewrite bits_and by omega.
+  rewrite andb_false_iff.
+  generalize (bits_size_2 a i).
+  generalize (bits_size_2 b i).
+  zify; intuition.
 Qed.
 
 Corollary and_interval:
@@ -4305,6 +3695,190 @@ Proof.
   unfold shr, shr'; rewrite <- A; auto.
 Qed.
 
+Theorem shru'_shl':
+  forall x y z, Int.ltu y iwordsize' = true -> Int.ltu z iwordsize' = true ->
+  shru' (shl' x y) z =
+  if Int.ltu z y then shl' (zero_ext (zwordsize - Int.unsigned y) x) (Int.sub y z)
+                 else zero_ext (zwordsize - Int.unsigned z) (shru' x (Int.sub z y)).
+Proof.
+  intros. apply Int.ltu_inv in H; apply Int.ltu_inv in H0.
+  change (Int.unsigned iwordsize') with zwordsize in *.
+  unfold Int.ltu. set (Y := Int.unsigned y) in *; set (Z := Int.unsigned z) in *.
+  apply same_bits_eq; intros. rewrite bits_shru' by auto. fold Z.
+  destruct (zlt Z Y).
+- assert (A: Int.unsigned (Int.sub y z) = Y - Z).
+  { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. omega. }
+  symmetry; rewrite bits_shl', A by omega.
+  destruct (zlt (i + Z) zwordsize).
++ rewrite bits_shl' by omega. fold Y.
+  destruct (zlt i (Y - Z)); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto.
+  rewrite bits_zero_ext by omega. rewrite zlt_true by omega. f_equal; omega.
++ rewrite bits_zero_ext by omega. rewrite ! zlt_false by omega. auto.
+- assert (A: Int.unsigned (Int.sub z y) = Z - Y).
+  { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. omega. }
+  rewrite bits_zero_ext, bits_shru', A by omega.
+  destruct (zlt (i + Z) zwordsize); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto.
+  rewrite bits_shl' by omega. fold Y.
+  destruct (zlt (i + Z) Y).
++ rewrite zlt_false by omega. auto.
++ rewrite zlt_true by omega. f_equal; omega.
+Qed.
+
+Theorem shr'_shl':
+  forall x y z, Int.ltu y iwordsize' = true -> Int.ltu z iwordsize' = true ->
+  shr' (shl' x y) z =
+  if Int.ltu z y then shl' (sign_ext (zwordsize - Int.unsigned y) x) (Int.sub y z)
+                 else sign_ext (zwordsize - Int.unsigned z) (shr' x (Int.sub z y)).
+Proof.
+  intros. apply Int.ltu_inv in H; apply Int.ltu_inv in H0.
+  change (Int.unsigned iwordsize') with zwordsize in *.
+  unfold Int.ltu. set (Y := Int.unsigned y) in *; set (Z := Int.unsigned z) in *.
+  apply same_bits_eq; intros. rewrite bits_shr' by auto. fold Z.
+  rewrite bits_shl' by (destruct (zlt (i + Z) zwordsize); omega). fold Y.
+  destruct (zlt Z Y).
+- assert (A: Int.unsigned (Int.sub y z) = Y - Z).
+  { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. omega. }
+  rewrite bits_shl', A by omega.
+  destruct (zlt i (Y - Z)).
++ apply zlt_true. destruct (zlt (i + Z) zwordsize); omega.
++ rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); omega).
+  rewrite bits_sign_ext by omega. f_equal. 
+  destruct (zlt (i + Z) zwordsize).
+  rewrite zlt_true by omega. omega.
+  rewrite zlt_false by omega. omega.
+- assert (A: Int.unsigned (Int.sub z y) = Z - Y).
+  { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. omega. }
+  rewrite bits_sign_ext by omega.
+  rewrite bits_shr' by (destruct (zlt i (zwordsize - Z)); omega).
+  rewrite A. rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); omega).
+  f_equal. destruct (zlt i (zwordsize - Z)).
++ rewrite ! zlt_true by omega. omega.
++ rewrite ! zlt_false by omega. rewrite zlt_true by omega. omega.
+Qed.
+
+Lemma shl'_zero_ext:
+  forall n m x, 0 <= n ->
+  shl' (zero_ext n x) m = zero_ext (n + Int.unsigned m) (shl' x m).
+Proof.
+  intros. apply same_bits_eq; intros.
+  rewrite bits_zero_ext, ! bits_shl' by omega.
+  destruct (zlt i (Int.unsigned m)).
+- rewrite zlt_true by omega; auto.
+- rewrite bits_zero_ext by omega.
+  destruct (zlt (i - Int.unsigned m) n); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto.
+Qed.
+
+Lemma shl'_sign_ext:
+  forall n m x, 0 < n ->
+  shl' (sign_ext n x) m = sign_ext (n + Int.unsigned m) (shl' x m).
+Proof.
+  intros. generalize (Int.unsigned_range m); intros.
+  apply same_bits_eq; intros.
+  rewrite bits_sign_ext, ! bits_shl' by omega.
+  destruct (zlt i (n + Int.unsigned m)).
+- rewrite bits_shl' by auto. destruct (zlt i (Int.unsigned m)); auto.
+  rewrite bits_sign_ext by omega. f_equal. apply zlt_true. omega.
+- rewrite zlt_false by omega. rewrite bits_shl' by omega. rewrite zlt_false by omega.
+  rewrite bits_sign_ext by omega. f_equal. rewrite zlt_false by omega. omega.
+Qed.
+
+Lemma shru'_zero_ext:
+  forall n m x, 0 <= n ->
+  shru' (zero_ext (n + Int.unsigned m) x) m = zero_ext n (shru' x m).
+Proof.
+  intros. generalize (Int.unsigned_range m); intros.
+  bit_solve; [|omega]. rewrite bits_shru', bits_zero_ext, bits_shru' by omega.
+  destruct (zlt (i + Int.unsigned m) zwordsize).
+* destruct (zlt i n); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto.
+* destruct (zlt i n); auto.
+Qed.
+
+Lemma shru'_zero_ext_0:
+  forall n m x, n <= Int.unsigned m ->
+  shru' (zero_ext n x) m = zero.
+Proof.
+  intros. generalize (Int.unsigned_range m); intros.
+  bit_solve. rewrite bits_shru', bits_zero_ext by omega.
+  destruct (zlt (i + Int.unsigned m) zwordsize); auto.
+  apply zlt_false. omega.
+Qed.
+
+Lemma shr'_sign_ext:
+  forall n m x, 0 < n -> n + Int.unsigned m < zwordsize ->
+  shr' (sign_ext (n + Int.unsigned m) x) m = sign_ext n (shr' x m).
+Proof.
+  intros. generalize (Int.unsigned_range m); intros.
+  apply same_bits_eq; intros.
+  rewrite bits_sign_ext, bits_shr' by auto.
+  rewrite bits_sign_ext, bits_shr'.
+- f_equal.
+  destruct (zlt i n), (zlt (i + Int.unsigned m) zwordsize).
++ apply zlt_true; omega.
++ apply zlt_true; omega.
++ rewrite zlt_false by omega. rewrite zlt_true by omega. omega.
++ rewrite zlt_false by omega. rewrite zlt_true by omega. omega.
+- destruct (zlt i n); omega.
+- destruct (zlt (i + Int.unsigned m) zwordsize); omega.
+Qed.
+
+Lemma zero_ext_shru'_min:
+  forall s x n, Int.ltu n iwordsize' = true ->
+  zero_ext s (shru' x n) = zero_ext (Z.min s (zwordsize - Int.unsigned n)) (shru' x n).
+Proof.
+  intros. apply Int.ltu_inv in H. change (Int.unsigned iwordsize') with zwordsize in H.
+  apply Z.min_case_strong; intros; auto.
+  bit_solve; try omega. rewrite ! bits_shru' by omega. 
+  destruct (zlt i (zwordsize - Int.unsigned n)).
+  rewrite zlt_true by omega. auto.
+  destruct (zlt i s); auto. rewrite zlt_false by omega; auto.
+Qed.
+
+Lemma sign_ext_shr'_min:
+  forall s x n, Int.ltu n iwordsize' = true ->
+  sign_ext s (shr' x n) = sign_ext (Z.min s (zwordsize - Int.unsigned n)) (shr' x n).
+Proof.
+  intros. apply Int.ltu_inv in H. change (Int.unsigned iwordsize') with zwordsize in H.
+  rewrite Z.min_comm. 
+  destruct (Z.min_spec (zwordsize - Int.unsigned n) s) as [[A B] | [A B]]; rewrite B; auto.
+  apply same_bits_eq; intros. rewrite ! bits_sign_ext by auto.
+  destruct (zlt i (zwordsize - Int.unsigned n)). 
+  rewrite zlt_true by omega. auto.
+  assert (C: testbit (shr' x n) (zwordsize - Int.unsigned n - 1) = testbit x (zwordsize - 1)).
+  { rewrite bits_shr' by omega. rewrite zlt_true by omega. f_equal; omega. }
+  rewrite C. destruct (zlt i s); rewrite bits_shr' by omega.
+  rewrite zlt_false by omega. auto.
+  rewrite zlt_false by omega. auto.
+Qed.
+
+Lemma shl'_zero_ext_min:
+  forall s x n, Int.ltu n iwordsize' = true ->
+  shl' (zero_ext s x) n = shl' (zero_ext (Z.min s (zwordsize - Int.unsigned n)) x) n.
+Proof.
+  intros. apply Int.ltu_inv in H. change (Int.unsigned iwordsize') with zwordsize in H.
+  apply Z.min_case_strong; intros; auto.
+  apply same_bits_eq; intros. rewrite ! bits_shl' by auto.
+  destruct (zlt i (Int.unsigned n)); auto.
+  rewrite ! bits_zero_ext by omega.
+  destruct (zlt (i - Int.unsigned n) s).
+  rewrite zlt_true by omega; auto.
+  rewrite zlt_false by omega; auto.
+Qed.
+
+Lemma shl'_sign_ext_min:
+  forall s x n, Int.ltu n iwordsize' = true ->
+  shl' (sign_ext s x) n = shl' (sign_ext (Z.min s (zwordsize - Int.unsigned n)) x) n.
+Proof.
+  intros. apply Int.ltu_inv in H. change (Int.unsigned iwordsize') with zwordsize in H.
+  rewrite Z.min_comm. 
+  destruct (Z.min_spec (zwordsize - Int.unsigned n) s) as [[A B] | [A B]]; rewrite B; auto.
+  apply same_bits_eq; intros. rewrite ! bits_shl' by auto.
+  destruct (zlt i (Int.unsigned n)); auto.
+  rewrite ! bits_sign_ext by omega. f_equal.
+  destruct (zlt (i - Int.unsigned n) s).
+  rewrite zlt_true by omega; auto.
+  omegaContradiction.
+Qed.
+
 (** Powers of two with exponents given as 32-bit ints *)
 
 Definition one_bits' (x: int) : list Int.int :=
@@ -4321,7 +3895,7 @@ Theorem one_bits'_range:
 Proof.
   intros.
   destruct (list_in_map_inv _ _ _ H) as [i0 [EQ IN]].
-  exploit Z_one_bits_range; eauto. intros R.
+  exploit Z_one_bits_range; eauto. fold zwordsize. intros R.
   unfold Int.ltu. rewrite EQ. rewrite Int.unsigned_repr.
   change (Int.unsigned iwordsize') with zwordsize. apply zlt_true. omega.
   assert (zwordsize < Int.max_unsigned) by reflexivity. omega.
@@ -4380,7 +3954,7 @@ Lemma is_power2'_correct:
 Proof.
   unfold is_power2'; intros.
   destruct (Z_one_bits wordsize (unsigned n) 0) as [ | i [ | ? ?]] eqn:B; inv H.
-  rewrite (Z_one_bits_powerserie (unsigned n)) by (apply unsigned_range).
+  rewrite (Z_one_bits_powerserie wordsize (unsigned n)) by (apply unsigned_range).
   rewrite Int.unsigned_repr. rewrite B; simpl. omega.
   assert (0 <= i < zwordsize).
   { apply Z_one_bits_range with (unsigned n). rewrite B; auto with coqlib. }
diff --git a/lib/IntvSets.v b/lib/IntvSets.v
index 78c20cc5..b97d9882 100644
--- a/lib/IntvSets.v
+++ b/lib/IntvSets.v
@@ -102,7 +102,7 @@ Proof.
   simpl. rewrite IHok. tauto.
   destruct (zlt h0 l).
   simpl. tauto.
-  rewrite IHok. intuition.
+  rewrite IHok. intuition idtac.
   assert (l0 <= x < h0 \/ l <= x < h) by xomega. tauto.
   left; xomega.
   left; xomega.
diff --git a/lib/Maps.v b/lib/Maps.v
index cfb866ba..9e44a7fe 100644
--- a/lib/Maps.v
+++ b/lib/Maps.v
@@ -190,7 +190,7 @@ Module PTree <: TREE.
     | Leaf : tree A
     | Node : tree A -> option A -> tree A -> tree A.
 
-  Arguments Leaf [A].
+  Arguments Leaf {A}.
   Arguments Node [A].
   Scheme tree_ind := Induction for tree Sort Prop.
 
diff --git a/lib/Ordered.v b/lib/Ordered.v
index bcf24cbd..1adbd330 100644
--- a/lib/Ordered.v
+++ b/lib/Ordered.v
@@ -21,6 +21,8 @@ Require Import Coqlib.
 Require Import Maps.
 Require Import Integers.
 
+Create HintDb ordered_type.
+
 (** The ordered type of positive numbers *)
 
 Module OrderedPositive <: OrderedType.
@@ -173,17 +175,17 @@ Definition eq (x y: t) :=
 
 Lemma eq_refl : forall x : t, eq x x.
 Proof.
-  intros; split; auto.
+  intros; split; auto with ordered_type.
 Qed.
 
 Lemma eq_sym : forall x y : t, eq x y -> eq y x.
 Proof.
-  unfold eq; intros. intuition auto.
+  unfold eq; intros. intuition auto with ordered_type.
 Qed.
 
 Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z.
 Proof.
-  unfold eq; intros. intuition eauto.
+  unfold eq; intros. intuition eauto with ordered_type.
 Qed.
 
 Definition lt (x y: t) :=
@@ -201,7 +203,7 @@ Proof.
   case (A.compare (fst x) (fst z)); intro.
   assumption.
   generalize (A.lt_not_eq H2); intro. elim H5.
-  apply A.eq_trans with (fst z). auto. auto.
+  apply A.eq_trans with (fst z). auto. auto with ordered_type.
   generalize (@A.lt_not_eq (fst z) (fst y)); intro.
   elim H5. apply A.lt_trans with (fst x); auto.
   apply A.eq_sym; auto.
diff --git a/lib/Zbits.v b/lib/Zbits.v
new file mode 100644
index 00000000..27586aff
--- /dev/null
+++ b/lib/Zbits.v
@@ -0,0 +1,1101 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Additional operations and proofs about binary integers,
+    on top of the ZArith standard library. *)
+
+Require Import Psatz Zquot.
+Require Import Coqlib.
+
+(** ** Modulo arithmetic *)
+
+(** We define and state properties of equality and arithmetic modulo a
+  positive integer. *)
+
+Section EQ_MODULO.
+
+Variable modul: Z.
+Hypothesis modul_pos: modul > 0.
+
+Definition eqmod (x y: Z) : Prop := exists k, x = k * modul + y.
+
+Lemma eqmod_refl: forall x, eqmod x x.
+Proof.
+  intros; red. exists 0. omega.
+Qed.
+
+Lemma eqmod_refl2: forall x y, x = y -> eqmod x y.
+Proof.
+  intros. subst y. apply eqmod_refl.
+Qed.
+
+Lemma eqmod_sym: forall x y, eqmod x y -> eqmod y x.
+Proof.
+  intros x y [k EQ]; red. exists (-k). subst x. ring.
+Qed.
+
+Lemma eqmod_trans: forall x y z, eqmod x y -> eqmod y z -> eqmod x z.
+Proof.
+  intros x y z [k1 EQ1] [k2 EQ2]; red.
+  exists (k1 + k2). subst x; subst y. ring.
+Qed.
+
+Lemma eqmod_small_eq:
+  forall x y, eqmod x y -> 0 <= x < modul -> 0 <= y < modul -> x = y.
+Proof.
+  intros x y [k EQ] I1 I2.
+  generalize (Zdiv_unique _ _ _ _ EQ I2). intro.
+  rewrite (Z.div_small x modul I1) in H. subst k. omega.
+Qed.
+
+Lemma eqmod_mod_eq:
+  forall x y, eqmod x y -> x mod modul = y mod modul.
+Proof.
+  intros x y [k EQ]. subst x.
+  rewrite Z.add_comm. apply Z_mod_plus. auto.
+Qed.
+
+Lemma eqmod_mod:
+  forall x, eqmod x (x mod modul).
+Proof.
+  intros; red. exists (x / modul).
+  rewrite Z.mul_comm. apply Z_div_mod_eq. auto.
+Qed.
+
+Lemma eqmod_add:
+  forall a b c d, eqmod a b -> eqmod c d -> eqmod (a + c) (b + d).
+Proof.
+  intros a b c d [k1 EQ1] [k2 EQ2]; red.
+  subst a; subst c. exists (k1 + k2). ring.
+Qed.
+
+Lemma eqmod_neg:
+  forall x y, eqmod x y -> eqmod (-x) (-y).
+Proof.
+  intros x y [k EQ]; red. exists (-k). rewrite EQ. ring.
+Qed.
+
+Lemma eqmod_sub:
+  forall a b c d, eqmod a b -> eqmod c d -> eqmod (a - c) (b - d).
+Proof.
+  intros a b c d [k1 EQ1] [k2 EQ2]; red.
+  subst a; subst c. exists (k1 - k2). ring.
+Qed.
+
+Lemma eqmod_mult:
+  forall a b c d, eqmod a c -> eqmod b d -> eqmod (a * b) (c * d).
+Proof.
+  intros a b c d [k1 EQ1] [k2 EQ2]; red.
+  subst a; subst b.
+  exists (k1 * k2 * modul + c * k2 + k1 * d).
+  ring.
+Qed.
+
+End EQ_MODULO.
+
+Lemma eqmod_divides:
+  forall n m x y, eqmod n x y -> Z.divide m n -> eqmod m x y.
+Proof.
+  intros. destruct H as [k1 EQ1]. destruct H0 as [k2 EQ2].
+  exists (k1*k2). rewrite <- Z.mul_assoc. rewrite <- EQ2. auto.
+Qed.
+
+(** ** Fast normalization modulo [2^n] *)
+
+Fixpoint P_mod_two_p (p: positive) (n: nat) {struct n} : Z :=
+  match n with
+  | O => 0
+  | S m =>
+      match p with
+      | xH => 1
+      | xO q => Z.double (P_mod_two_p q m)
+      | xI q => Z.succ_double (P_mod_two_p q m)
+      end
+  end.
+
+Definition Z_mod_two_p (x: Z) (n: nat) : Z :=
+  match x with
+  | Z0 => 0
+  | Zpos p => P_mod_two_p p n
+  | Zneg p => let r := P_mod_two_p p n in if zeq r 0 then 0 else two_power_nat n - r
+  end.
+
+Lemma P_mod_two_p_range:
+  forall n p, 0 <= P_mod_two_p p n < two_power_nat n.
+Proof.
+  induction n; simpl; intros.
+  - rewrite two_power_nat_O. omega.
+  - rewrite two_power_nat_S. destruct p.
+    + generalize (IHn p). rewrite Z.succ_double_spec. omega.
+    + generalize (IHn p). rewrite Z.double_spec. omega.
+    + generalize (two_power_nat_pos n). omega.
+Qed.
+
+Lemma P_mod_two_p_eq:
+  forall n p, P_mod_two_p p n = (Zpos p) mod (two_power_nat n).
+Proof.
+  assert (forall n p, exists y, Zpos p = y * two_power_nat n + P_mod_two_p p n).
+  {
+    induction n; simpl; intros.
+    - rewrite two_power_nat_O. exists (Zpos p). ring.
+    - rewrite two_power_nat_S. destruct p.
+      + destruct (IHn p) as [y EQ]. exists y.
+        change (Zpos p~1) with (2 * Zpos p + 1). rewrite EQ.
+        rewrite Z.succ_double_spec. ring.
+      + destruct (IHn p) as [y EQ]. exists y.
+        change (Zpos p~0) with (2 * Zpos p). rewrite EQ.
+        rewrite (Z.double_spec (P_mod_two_p p n)). ring.
+      + exists 0; omega.
+  }
+  intros.
+  destruct (H n p) as [y EQ].
+  symmetry. apply Zmod_unique with y. auto. apply P_mod_two_p_range.
+Qed.
+
+Lemma Z_mod_two_p_range:
+  forall n x, 0 <= Z_mod_two_p x n < two_power_nat n.
+Proof.
+  intros; unfold Z_mod_two_p. generalize (two_power_nat_pos n); intros.
+  destruct x.
+  - intuition.
+  - apply P_mod_two_p_range.
+  - set (r := P_mod_two_p p n).
+    assert (0 <= r < two_power_nat n) by apply P_mod_two_p_range.
+    destruct (zeq r 0).
+    + intuition.
+    + Psatz.lia.
+Qed.
+
+Lemma Z_mod_two_p_eq:
+  forall n x, Z_mod_two_p x n = x mod (two_power_nat n).
+Proof.
+  intros. unfold Z_mod_two_p. generalize (two_power_nat_pos n); intros.
+  destruct x.
+  - rewrite Zmod_0_l. auto.
+  - apply P_mod_two_p_eq.
+  - generalize (P_mod_two_p_range n p) (P_mod_two_p_eq n p). intros A B.
+    exploit (Z_div_mod_eq (Zpos p) (two_power_nat n)); auto. intros C.
+    set (q := Zpos p / two_power_nat n) in *.
+    set (r := P_mod_two_p p n) in *.
+    rewrite <- B in C.
+    change (Z.neg p) with (- (Z.pos p)). destruct (zeq r 0).
+    + symmetry. apply Zmod_unique with (-q). rewrite C; rewrite e. Psatz.lia.
+      intuition.
+    + symmetry. apply Zmod_unique with (-q - 1). rewrite C. Psatz.lia.
+      intuition.
+Qed.
+
+(** ** Bit-level operations and properties *)
+
+(** Shift [x] left by one and insert [b] as the low bit of the result. *)
+
+Definition Zshiftin (b: bool) (x: Z) : Z :=
+  if b then Z.succ_double x else Z.double x.
+
+Remark Ztestbit_0: forall n, Z.testbit 0 n = false.
+Proof Z.testbit_0_l.
+
+Remark Ztestbit_1: forall n, Z.testbit 1 n = zeq n 0.
+Proof.
+  intros. destruct n; simpl; auto.
+Qed.
+
+Remark Ztestbit_m1: forall n, 0 <= n -> Z.testbit (-1) n = true.
+Proof.
+  intros. destruct n; simpl; auto.
+Qed.
+
+Remark Zshiftin_spec:
+  forall b x, Zshiftin b x = 2 * x + (if b then 1 else 0).
+Proof.
+  unfold Zshiftin; intros. destruct b.
+  - rewrite Z.succ_double_spec. omega.
+  - rewrite Z.double_spec. omega.
+Qed.
+
+Remark Zshiftin_inj:
+  forall b1 x1 b2 x2,
+  Zshiftin b1 x1 = Zshiftin b2 x2 -> b1 = b2 /\ x1 = x2.
+Proof.
+  intros. rewrite !Zshiftin_spec in H.
+  destruct b1; destruct b2.
+  split; [auto|omega].
+  omegaContradiction.
+  omegaContradiction.
+  split; [auto|omega].
+Qed.
+
+Remark Zdecomp:
+  forall x, x = Zshiftin (Z.odd x) (Z.div2 x).
+Proof.
+  intros. destruct x; simpl.
+  - auto.
+  - destruct p; auto.
+  - destruct p; auto. simpl. rewrite Pos.pred_double_succ. auto.
+Qed.
+
+Remark Ztestbit_shiftin:
+  forall b x n,
+  0 <= n ->
+  Z.testbit (Zshiftin b x) n = if zeq n 0 then b else Z.testbit x (Z.pred n).
+Proof.
+  intros. rewrite Zshiftin_spec. destruct (zeq n 0).
+  - subst n. destruct b.
+    + apply Z.testbit_odd_0.
+    + rewrite Z.add_0_r. apply Z.testbit_even_0.
+  - assert (0 <= Z.pred n) by omega.
+    set (n' := Z.pred n) in *.
+    replace n with (Z.succ n') by (unfold n'; omega).
+    destruct b.
+    + apply Z.testbit_odd_succ; auto.
+    + rewrite Z.add_0_r. apply Z.testbit_even_succ; auto.
+Qed.
+
+Remark Ztestbit_shiftin_base:
+  forall b x, Z.testbit (Zshiftin b x) 0 = b.
+Proof.
+  intros. rewrite Ztestbit_shiftin. apply zeq_true. omega.
+Qed.
+
+Remark Ztestbit_shiftin_succ:
+  forall b x n, 0 <= n -> Z.testbit (Zshiftin b x) (Z.succ n) = Z.testbit x n.
+Proof.
+  intros. rewrite Ztestbit_shiftin. rewrite zeq_false. rewrite Z.pred_succ. auto.
+  omega. omega.
+Qed.
+
+Lemma Zshiftin_ind:
+  forall (P: Z -> Prop),
+  P 0 ->
+  (forall b x, 0 <= x -> P x -> P (Zshiftin b x)) ->
+  forall x, 0 <= x -> P x.
+Proof.
+  intros. destruct x.
+  - auto.
+  - induction p.
+    + change (P (Zshiftin true (Z.pos p))). auto.
+    + change (P (Zshiftin false (Z.pos p))). auto.
+    + change (P (Zshiftin true 0)). apply H0. omega. auto.
+  - compute in H1. intuition congruence.
+Qed.
+
+Lemma Zshiftin_pos_ind:
+  forall (P: Z -> Prop),
+  P 1 ->
+  (forall b x, 0 < x -> P x -> P (Zshiftin b x)) ->
+  forall x, 0 < x -> P x.
+Proof.
+  intros. destruct x; simpl in H1; try discriminate.
+  induction p.
+    + change (P (Zshiftin true (Z.pos p))). auto.
+    + change (P (Zshiftin false (Z.pos p))). auto.
+    + auto.
+Qed.
+
+(** ** Bit-wise decomposition ([Z.testbit]) *)
+
+Remark Ztestbit_eq:
+  forall n x, 0 <= n ->
+  Z.testbit x n = if zeq n 0 then Z.odd x else Z.testbit (Z.div2 x) (Z.pred n).
+Proof.
+  intros. rewrite (Zdecomp x) at 1. apply Ztestbit_shiftin; auto.
+Qed.
+
+Remark Ztestbit_base:
+  forall x, Z.testbit x 0 = Z.odd x.
+Proof.
+  intros. rewrite Ztestbit_eq. apply zeq_true. omega.
+Qed.
+
+Remark Ztestbit_succ:
+  forall n x, 0 <= n -> Z.testbit x (Z.succ n) = Z.testbit (Z.div2 x) n.
+Proof.
+  intros. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ. auto.
+  omega. omega.
+Qed.
+
+Lemma eqmod_same_bits:
+  forall n x y,
+  (forall i, 0 <= i < Z.of_nat n -> Z.testbit x i = Z.testbit y i) ->
+  eqmod (two_power_nat n) x y.
+Proof.
+  induction n; intros.
+  - change (two_power_nat 0) with 1. exists (x-y); ring.
+  - rewrite two_power_nat_S.
+    assert (eqmod (two_power_nat n) (Z.div2 x) (Z.div2 y)).
+      apply IHn. intros. rewrite <- !Ztestbit_succ. apply H. rewrite Nat2Z.inj_succ; omega.
+      omega. omega.
+  destruct H0 as [k EQ].
+  exists k. rewrite (Zdecomp x). rewrite (Zdecomp y).
+  replace (Z.odd y) with (Z.odd x).
+  rewrite EQ. rewrite !Zshiftin_spec. ring.
+  exploit (H 0). rewrite Nat2Z.inj_succ; omega.
+  rewrite !Ztestbit_base. auto.
+Qed.
+
+Lemma same_bits_eqmod:
+  forall n x y i,
+  eqmod (two_power_nat n) x y -> 0 <= i < Z.of_nat n ->
+  Z.testbit x i = Z.testbit y i.
+Proof.
+  induction n; intros.
+  - simpl in H0. omegaContradiction.
+  - rewrite Nat2Z.inj_succ in H0. rewrite two_power_nat_S in H.
+    rewrite !(Ztestbit_eq i); intuition.
+    destruct H as [k EQ].
+    assert (EQ': Zshiftin (Z.odd x) (Z.div2 x) =
+                 Zshiftin (Z.odd y) (k * two_power_nat n + Z.div2 y)).
+    {
+      rewrite (Zdecomp x) in EQ. rewrite (Zdecomp y) in EQ.
+      rewrite EQ. rewrite !Zshiftin_spec. ring.
+    }
+    exploit Zshiftin_inj; eauto. intros [A B].
+    destruct (zeq i 0).
+    + auto.
+    + apply IHn. exists k; auto. omega.
+Qed.
+
+Lemma equal_same_bits:
+  forall x y,
+  (forall i, 0 <= i -> Z.testbit x i = Z.testbit y i) ->
+  x = y.
+Proof Z.bits_inj'.
+
+Lemma Z_one_complement:
+  forall i, 0 <= i ->
+  forall x, Z.testbit (-x-1) i = negb (Z.testbit x i).
+Proof.
+  intros i0 POS0. pattern i0. apply Zlt_0_ind; auto.
+  intros i IND POS x.
+  rewrite (Zdecomp x). set (y := Z.div2 x).
+  replace (- Zshiftin (Z.odd x) y - 1)
+     with (Zshiftin (negb (Z.odd x)) (- y - 1)).
+  rewrite !Ztestbit_shiftin; auto.
+  destruct (zeq i 0). auto. apply IND. omega.
+  rewrite !Zshiftin_spec. destruct (Z.odd x); simpl negb; ring.
+Qed.
+
+Lemma Ztestbit_above:
+  forall n x i,
+  0 <= x < two_power_nat n ->
+  i >= Z.of_nat n ->
+  Z.testbit x i = false.
+Proof.
+  induction n; intros.
+  - change (two_power_nat 0) with 1 in H.
+    replace x with 0 by omega.
+    apply Z.testbit_0_l.
+  - rewrite Nat2Z.inj_succ in H0. rewrite Ztestbit_eq. rewrite zeq_false.
+    apply IHn. rewrite two_power_nat_S in H. rewrite (Zdecomp x) in H.
+    rewrite Zshiftin_spec in H. destruct (Z.odd x); omega.
+    omega. omega. omega.
+Qed.
+
+Lemma Ztestbit_above_neg:
+  forall n x i,
+  -two_power_nat n <= x < 0 ->
+  i >= Z.of_nat n ->
+  Z.testbit x i = true.
+Proof.
+  intros. set (y := -x-1).
+  assert (Z.testbit y i = false).
+    apply Ztestbit_above with n.
+    unfold y; omega. auto.
+  unfold y in H1. rewrite Z_one_complement in H1.
+  change true with (negb false). rewrite <- H1. rewrite negb_involutive; auto.
+  omega.
+Qed.
+
+Lemma Zsign_bit:
+  forall n x,
+  0 <= x < two_power_nat (S n) ->
+  Z.testbit x (Z.of_nat n) = if zlt x (two_power_nat n) then false else true.
+Proof.
+  induction n; intros.
+  - change (two_power_nat 1) with 2 in H.
+    assert (x = 0 \/ x = 1) by omega.
+    destruct H0; subst x; reflexivity.
+  - rewrite Nat2Z.inj_succ. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ.
+    rewrite IHn. rewrite two_power_nat_S.
+    destruct (zlt (Z.div2 x) (two_power_nat n)); rewrite (Zdecomp x); rewrite Zshiftin_spec.
+    rewrite zlt_true. auto. destruct (Z.odd x); omega.
+    rewrite zlt_false. auto. destruct (Z.odd x); omega.
+    rewrite (Zdecomp x) in H; rewrite Zshiftin_spec in H.
+    rewrite two_power_nat_S in H. destruct (Z.odd x); omega.
+    omega. omega.
+Qed.
+
+Lemma Ztestbit_le:
+  forall x y,
+  0 <= y ->
+  (forall i, 0 <= i -> Z.testbit x i = true -> Z.testbit y i = true) ->
+  x <= y.
+Proof.
+  intros x y0 POS0; revert x; pattern y0; apply Zshiftin_ind; auto; intros.
+  - replace x with 0. omega. apply equal_same_bits; intros.
+    rewrite Ztestbit_0. destruct (Z.testbit x i) as [] eqn:E; auto.
+    exploit H; eauto. rewrite Ztestbit_0. auto.
+  - assert (Z.div2 x0 <= x).
+    { apply H0. intros. exploit (H1 (Z.succ i)).
+        omega. rewrite Ztestbit_succ; auto. rewrite Ztestbit_shiftin_succ; auto.
+    }
+    rewrite (Zdecomp x0). rewrite !Zshiftin_spec.
+    destruct (Z.odd x0) as [] eqn:E1; destruct b as [] eqn:E2; try omega.
+    exploit (H1 0). omega. rewrite Ztestbit_base; auto.
+    rewrite Ztestbit_shiftin_base. congruence.
+Qed.
+
+Lemma Ztestbit_mod_two_p:
+  forall n x i,
+  0 <= n -> 0 <= i ->
+  Z.testbit (x mod (two_p n)) i = if zlt i n then Z.testbit x i else false.
+Proof.
+  intros n0 x i N0POS. revert x i; pattern n0; apply natlike_ind; auto.
+  - intros. change (two_p 0) with 1. rewrite Zmod_1_r. rewrite Z.testbit_0_l.
+    rewrite zlt_false; auto. omega.
+  - intros. rewrite two_p_S; auto.
+    replace (x0 mod (2 * two_p x))
+       with (Zshiftin (Z.odd x0) (Z.div2 x0 mod two_p x)).
+    rewrite Ztestbit_shiftin; auto. rewrite (Ztestbit_eq i x0); auto. destruct (zeq i 0).
+    + rewrite zlt_true; auto. omega.
+    + rewrite H0. destruct (zlt (Z.pred i) x).
+      * rewrite zlt_true; auto. omega.
+      * rewrite zlt_false; auto. omega.
+      * omega.
+    + rewrite (Zdecomp x0) at 3. set (x1 := Z.div2 x0). symmetry.
+      apply Zmod_unique with (x1 / two_p x).
+      rewrite !Zshiftin_spec. rewrite Z.add_assoc. f_equal.
+      transitivity (2 * (two_p x * (x1 / two_p x) + x1 mod two_p x)).
+      f_equal. apply Z_div_mod_eq. apply two_p_gt_ZERO; auto.
+      ring.
+      rewrite Zshiftin_spec. exploit (Z_mod_lt x1 (two_p x)). apply two_p_gt_ZERO; auto.
+      destruct (Z.odd x0); omega.
+Qed.
+
+Corollary Ztestbit_two_p_m1:
+  forall n i, 0 <= n -> 0 <= i ->
+  Z.testbit (two_p n - 1) i = if zlt i n then true else false.
+Proof.
+  intros. replace (two_p n - 1) with ((-1) mod (two_p n)).
+  rewrite Ztestbit_mod_two_p; auto. destruct (zlt i n); auto. apply Ztestbit_m1; auto.
+  apply Zmod_unique with (-1). ring.
+  exploit (two_p_gt_ZERO n). auto. omega.
+Qed.
+
+Corollary Ztestbit_neg_two_p:
+  forall n i, 0 <= n -> 0 <= i ->
+  Z.testbit (- (two_p n)) i = if zlt i n then false else true.
+Proof.
+  intros. 
+  replace (- two_p n) with (- (two_p n - 1) - 1) by omega. 
+  rewrite Z_one_complement by auto.
+  rewrite Ztestbit_two_p_m1 by auto. 
+  destruct (zlt i n); auto.
+Qed.
+
+Lemma Z_add_is_or:
+  forall i, 0 <= i ->
+  forall x y,
+  (forall j, 0 <= j <= i -> Z.testbit x j && Z.testbit y j = false) ->
+  Z.testbit (x + y) i = Z.testbit x i || Z.testbit y i.
+Proof.
+  intros i0 POS0. pattern i0. apply Zlt_0_ind; auto.
+  intros i IND POS x y EXCL.
+  rewrite (Zdecomp x) in *. rewrite (Zdecomp y) in *.
+  transitivity (Z.testbit (Zshiftin (Z.odd x || Z.odd y) (Z.div2 x + Z.div2 y)) i).
+  - f_equal. rewrite !Zshiftin_spec.
+    exploit (EXCL 0). omega. rewrite !Ztestbit_shiftin_base. intros.
+Opaque Z.mul.
+    destruct (Z.odd x); destruct (Z.odd y); simpl in *; discriminate || ring.
+  - rewrite !Ztestbit_shiftin; auto.
+    destruct (zeq i 0).
+    + auto.
+    + apply IND. omega. intros.
+      exploit (EXCL (Z.succ j)). omega.
+      rewrite !Ztestbit_shiftin_succ. auto.
+      omega. omega.
+Qed.
+
+(** ** Zero and sign extensions *)
+
+(** In pseudo-code:
+<<
+    Fixpoint Zzero_ext (n: Z) (x: Z) : Z :=
+      if zle n 0 then
+        0
+      else
+        Zshiftin (Z.odd x) (Zzero_ext (Z.pred n) (Z.div2 x)).
+    Fixpoint Zsign_ext (n: Z) (x: Z) : Z :=
+      if zle n 1 then
+        if Z.odd x then -1 else 0
+      else
+        Zshiftin (Z.odd x) (Zzero_ext (Z.pred n) (Z.div2 x)).
+>>
+  We encode this [nat]-like recursion using the [Z.iter] iteration
+  function, in order to make the [Zzero_ext] and [Zsign_ext]
+  functions efficiently executable within Coq.
+*)
+
+Definition Zzero_ext (n: Z) (x: Z) : Z :=
+  Z.iter n
+    (fun rec x => Zshiftin (Z.odd x) (rec (Z.div2 x)))
+    (fun x => 0)
+    x.
+
+Definition Zsign_ext (n: Z) (x: Z) : Z :=
+  Z.iter (Z.pred n)
+    (fun rec x => Zshiftin (Z.odd x) (rec (Z.div2 x)))
+    (fun x => if Z.odd x && zlt 0 n then -1 else 0)
+    x.
+
+Lemma Ziter_base:
+  forall (A: Type) n (f: A -> A) x, n <= 0 -> Z.iter n f x = x.
+Proof.
+  intros. unfold Z.iter. destruct n; auto. compute in H. elim H; auto.
+Qed.
+
+Lemma Ziter_succ:
+  forall (A: Type) n (f: A -> A) x,
+  0 <= n -> Z.iter (Z.succ n) f x = f (Z.iter n f x).
+Proof.
+  intros. destruct n; simpl.
+  - auto.
+  - rewrite Pos.add_1_r. apply Pos.iter_succ.
+  - compute in H. elim H; auto.
+Qed.
+
+Lemma Znatlike_ind:
+  forall (P: Z -> Prop),
+  (forall n, n <= 0 -> P n) ->
+  (forall n, 0 <= n -> P n -> P (Z.succ n)) ->
+  forall n, P n.
+Proof.
+  intros. destruct (zle 0 n).
+  apply natlike_ind; auto. apply H; omega.
+  apply H. omega.
+Qed.
+
+Lemma Zzero_ext_spec:
+  forall n x i, 0 <= i ->
+  Z.testbit (Zzero_ext n x) i = if zlt i n then Z.testbit x i else false.
+Proof.
+  unfold Zzero_ext. induction n using Znatlike_ind.
+  - intros. rewrite Ziter_base; auto.
+    rewrite zlt_false. rewrite Ztestbit_0; auto. omega.
+  - intros. rewrite Ziter_succ; auto.
+    rewrite Ztestbit_shiftin; auto.
+    rewrite (Ztestbit_eq i x); auto.
+    destruct (zeq i 0).
+    + subst i. rewrite zlt_true; auto. omega.
+    + rewrite IHn. destruct (zlt (Z.pred i) n).
+      rewrite zlt_true; auto. omega.
+      rewrite zlt_false; auto. omega.
+      omega.
+Qed.
+
+Lemma Zsign_ext_spec:
+  forall n x i, 0 <= i ->
+  Z.testbit (Zsign_ext n x) i = Z.testbit x (if zlt i n then i else n - 1).
+Proof.
+  intros n0 x i I0. unfold Zsign_ext. 
+  unfold proj_sumbool; destruct (zlt 0 n0) as [N0|N0]; simpl.
+- revert x i I0. pattern n0. apply Zlt_lower_bound_ind with (z := 1); [ | omega ].
+  unfold Zsign_ext. intros.
+  destruct (zeq x 1).
+  + subst x; simpl.
+    replace (if zlt i 1 then i else 0) with 0.
+    rewrite Ztestbit_base.
+    destruct (Z.odd x0); [ apply Ztestbit_m1; auto | apply Ztestbit_0 ].
+    destruct (zlt i 1); omega.
+  + set (x1 := Z.pred x). replace x1 with (Z.succ (Z.pred x1)) by omega.
+    rewrite Ziter_succ by (unfold x1; omega). rewrite Ztestbit_shiftin by auto.
+    destruct (zeq i 0).
+    * subst i. rewrite zlt_true. rewrite Ztestbit_base; auto. omega.
+    * rewrite H by (unfold x1; omega).
+      unfold x1; destruct (zlt (Z.pred i) (Z.pred x)).
+      ** rewrite zlt_true by omega.
+         rewrite (Ztestbit_eq i x0) by omega.
+         rewrite zeq_false by omega. auto.
+      ** rewrite zlt_false by omega.
+         rewrite (Ztestbit_eq (x - 1) x0) by omega.
+         rewrite zeq_false by omega. auto.
+- rewrite Ziter_base by omega. rewrite andb_false_r. 
+  rewrite Z.testbit_0_l, Z.testbit_neg_r. auto.
+  destruct (zlt i n0); omega.
+Qed.
+
+(** [Zzero_ext n x] is [x modulo 2^n] *)
+
+Lemma Zzero_ext_mod:
+  forall n x, 0 <= n -> Zzero_ext n x = x mod (two_p n).
+Proof.
+  intros. apply equal_same_bits; intros.
+  rewrite Zzero_ext_spec, Ztestbit_mod_two_p by auto. auto.
+Qed.
+
+(** [Zzero_ext n x] is the unique integer congruent to [x] modulo [2^n] in the range [0...2^n-1]. *)
+
+Lemma Zzero_ext_range:
+  forall n x, 0 <= n -> 0 <= Zzero_ext n x < two_p n.
+Proof.
+  intros. rewrite Zzero_ext_mod; auto. apply Z_mod_lt. apply two_p_gt_ZERO. omega.
+Qed.
+
+Lemma eqmod_Zzero_ext:
+  forall n x, 0 <= n -> eqmod (two_p n) (Zzero_ext n x) x.
+Proof.
+  intros. rewrite Zzero_ext_mod; auto. apply eqmod_sym. apply eqmod_mod.
+  apply two_p_gt_ZERO. omega.
+Qed.
+
+(** Relation between [Zsign_ext n x] and (Zzero_ext n x] *)
+
+Lemma Zsign_ext_zero_ext:
+  forall n, 0 <= n -> forall x,
+  Zsign_ext n x = Zzero_ext n x - (if Z.testbit x (n - 1) then two_p n else 0).
+Proof.
+  intros. apply equal_same_bits; intros.
+  rewrite Zsign_ext_spec by auto.
+  destruct (Z.testbit x (n - 1)) eqn:SIGNBIT.
+- set (n' := - two_p n). 
+  replace (Zzero_ext n x - two_p n) with (Zzero_ext n x + n') by (unfold n'; omega).
+  rewrite Z_add_is_or; auto. 
+  rewrite Zzero_ext_spec by auto. unfold n'; rewrite Ztestbit_neg_two_p by omega.
+  destruct (zlt i n). rewrite orb_false_r; auto. auto.
+  intros. rewrite Zzero_ext_spec by omega. unfold n'; rewrite Ztestbit_neg_two_p by omega.
+  destruct (zlt j n); auto using andb_false_r.
+- replace (Zzero_ext n x - 0) with (Zzero_ext n x) by omega.
+  rewrite Zzero_ext_spec by auto.
+  destruct (zlt i n); auto.
+Qed.
+
+(** [Zsign_ext n x] is the unique integer congruent to [x] modulo [2^n]
+    in the range [-2^(n-1)...2^(n-1) - 1]. *)
+
+Lemma Zsign_ext_range:
+  forall n x, 0 < n -> -two_p (n-1) <= Zsign_ext n x < two_p (n-1).
+Proof.
+  intros.
+  assert (A: 0 <= Zzero_ext n x < two_p n) by (apply Zzero_ext_range; omega).
+  assert (B: Z.testbit (Zzero_ext n x) (n - 1) =
+             if zlt (Zzero_ext n x) (two_p (n - 1)) then false else true).
+  { set (N := Z.to_nat (n - 1)).
+    generalize (Zsign_bit N (Zzero_ext n x)). 
+    rewrite ! two_power_nat_two_p.
+    rewrite inj_S.  unfold N; rewrite Z2Nat.id by omega.
+    intros X; apply X.  replace (Z.succ (n - 1)) with n by omega. exact A. 
+  }
+  assert (C: two_p n = 2 * two_p (n - 1)).
+  { rewrite <- two_p_S by omega. f_equal; omega. }
+  rewrite Zzero_ext_spec, zlt_true in B by omega.
+  rewrite Zsign_ext_zero_ext by omega. rewrite B.
+  destruct (zlt (Zzero_ext n x) (two_p (n - 1))); omega.
+Qed.
+
+Lemma eqmod_Zsign_ext:
+  forall n x, 0 <= n ->
+  eqmod (two_p n) (Zsign_ext n x) x.
+Proof.
+  intros. rewrite Zsign_ext_zero_ext by auto. 
+  apply eqmod_trans with (x - 0). 
+  apply eqmod_sub. 
+  apply eqmod_Zzero_ext; omega.
+  exists (if Z.testbit x (n - 1) then 1 else 0). destruct (Z.testbit x (n - 1)); ring.
+  apply eqmod_refl2; omega.
+Qed.
+
+(** ** Decomposition of a number as a sum of powers of two. *)
+
+Fixpoint Z_one_bits (n: nat) (x: Z) (i: Z) {struct n}: list Z :=
+  match n with
+  | O => nil
+  | S m =>
+      if Z.odd x
+      then i :: Z_one_bits m (Z.div2 x) (i+1)
+      else Z_one_bits m (Z.div2 x) (i+1)
+  end.
+
+Fixpoint powerserie (l: list Z): Z :=
+  match l with
+  | nil => 0
+  | x :: xs => two_p x + powerserie xs
+  end.
+
+Lemma Z_one_bits_powerserie:
+  forall n x, 0 <= x < two_power_nat n -> x = powerserie (Z_one_bits n x 0).
+Proof.
+  assert (forall n x i,
+    0 <= i ->
+    0 <= x < two_power_nat n ->
+    x * two_p i = powerserie (Z_one_bits n x i)).
+  {
+  induction n; intros.
+  simpl. rewrite two_power_nat_O in H0.
+  assert (x = 0) by omega. subst x. omega.
+  rewrite two_power_nat_S in H0. simpl Z_one_bits.
+  rewrite (Zdecomp x) in H0. rewrite Zshiftin_spec in H0.
+  assert (EQ: Z.div2 x * two_p (i + 1) = powerserie (Z_one_bits n (Z.div2 x) (i + 1))).
+    apply IHn. omega.
+    destruct (Z.odd x); omega.
+  rewrite two_p_is_exp in EQ. change (two_p 1) with 2 in EQ.
+  rewrite (Zdecomp x) at 1. rewrite Zshiftin_spec.
+  destruct (Z.odd x); simpl powerserie; rewrite <- EQ; ring.
+  omega. omega.
+  }
+  intros. rewrite <- H. change (two_p 0) with 1. omega.
+  omega. exact H0.
+Qed.
+
+Lemma Z_one_bits_range:
+  forall n x i, In i (Z_one_bits n x 0) -> 0 <= i < Z.of_nat n.
+Proof.
+  assert (forall n x i j,
+    In j (Z_one_bits n x i) -> i <= j < i + Z.of_nat n).
+  {
+  induction n; simpl In.
+  tauto.
+  intros x i j. rewrite Nat2Z.inj_succ.
+  assert (In j (Z_one_bits n (Z.div2 x) (i + 1)) -> i <= j < i + Z.succ (Z.of_nat n)).
+    intros. exploit IHn; eauto. omega.
+  destruct (Z.odd x); simpl.
+  intros [A|B]. subst j. omega. auto.
+  auto.
+  }
+  intros. generalize (H n x 0 i H0). omega.
+Qed.
+
+Remark Z_one_bits_zero:
+  forall n i, Z_one_bits n 0 i = nil.
+Proof.
+  induction n; intros; simpl; auto.
+Qed.
+
+Remark Z_one_bits_two_p:
+  forall n x i,
+  0 <= x < Z.of_nat n ->
+  Z_one_bits n (two_p x) i = (i + x) :: nil.
+Proof.
+  induction n; intros; simpl. simpl in H. omegaContradiction.
+  rewrite Nat2Z.inj_succ in H.
+  assert (x = 0 \/ 0 < x) by omega. destruct H0.
+  subst x; simpl. decEq. omega. apply Z_one_bits_zero.
+  assert (Z.odd (two_p x) = false /\ Z.div2 (two_p x) = two_p (x-1)).
+    apply Zshiftin_inj. rewrite <- Zdecomp. rewrite !Zshiftin_spec.
+    rewrite <- two_p_S. rewrite Z.add_0_r. f_equal; omega. omega.
+  destruct H1 as [A B]; rewrite A; rewrite B.
+  rewrite IHn. f_equal; omega. omega.
+Qed.
+
+(** ** Recognition of powers of two *)
+
+Fixpoint P_is_power2 (p: positive) : bool :=
+  match p with
+  | xH => true
+  | xO q => P_is_power2 q
+  | xI q => false
+  end.
+
+Definition Z_is_power2 (x: Z) : option Z :=
+  match x with
+  | Z0 => None
+  | Zpos p => if P_is_power2 p then Some (Z.log2 x) else None
+  | Zneg _ => None
+  end.
+
+Remark P_is_power2_sound:
+  forall p, P_is_power2 p = true -> Z.pos p = two_p (Z.log2 (Z.pos p)).
+Proof.
+  induction p; simpl P_is_power2; intros.
+- discriminate.
+- change (Z.pos p~0) with (2 * Z.pos p).  apply IHp in H.
+  rewrite Z.log2_double by xomega. rewrite two_p_S.  congruence.
+  apply Z.log2_nonneg.
+- reflexivity.
+Qed.
+
+Lemma Z_is_power2_nonneg:
+  forall x i, Z_is_power2 x = Some i -> 0 <= i.
+Proof.
+  unfold Z_is_power2; intros. destruct x; try discriminate.
+  destruct (P_is_power2 p) eqn:P; try discriminate.
+  replace i with (Z.log2 (Z.pos p)) by congruence. apply Z.log2_nonneg.
+Qed.
+ 
+Lemma Z_is_power2_sound:
+  forall x i, Z_is_power2 x = Some i -> x = two_p i /\ i = Z.log2 x.
+Proof.
+  unfold Z_is_power2; intros. destruct x; try discriminate.
+  destruct (P_is_power2 p) eqn:P; try discriminate.
+  apply P_is_power2_sound in P. rewrite P; split; congruence.
+Qed.
+
+Corollary Z_is_power2_range:
+  forall n x i,
+  0 <= n -> 0 <= x < two_p n -> Z_is_power2 x = Some i -> 0 <= i < n.
+Proof.
+  intros.
+  assert (x <> 0) by (red; intros; subst x; discriminate).
+  apply Z_is_power2_sound in H1. destruct H1 as [P Q]. subst i.
+  split. apply Z.log2_nonneg. apply Z.log2_lt_pow2. omega. rewrite <- two_p_equiv; tauto.
+Qed.
+
+Lemma Z_is_power2_complete:
+  forall i, 0 <= i -> Z_is_power2 (two_p i) = Some i.
+Proof.
+Opaque Z.log2.
+  assert (A: forall x i, Z_is_power2 x = Some i -> Z_is_power2 (2 * x) = Some (Z.succ i)).
+  { destruct x; simpl; intros; try discriminate.
+    change (2 * Z.pos p) with (Z.pos (xO p)); simpl.
+    destruct (P_is_power2 p); inv H. rewrite <- Z.log2_double by xomega. auto.
+  }
+  induction i using Znatlike_ind; intros.
+- replace i with 0 by omega. reflexivity.
+- rewrite two_p_S by omega. apply A. apply IHi; omega.
+Qed.
+
+Definition Z_is_power2m1 (x: Z) : option Z := Z_is_power2 (Z.succ x).
+
+Lemma Z_is_power2m1_nonneg:
+  forall x i, Z_is_power2m1 x = Some i -> 0 <= i.
+Proof.
+  unfold Z_is_power2m1; intros. eapply Z_is_power2_nonneg; eauto.
+Qed.
+
+Lemma Z_is_power2m1_sound:
+  forall x i, Z_is_power2m1 x = Some i -> x = two_p i - 1.
+Proof.
+  unfold Z_is_power2m1; intros. apply Z_is_power2_sound in H. omega.
+Qed.
+
+Lemma Z_is_power2m1_complete:
+  forall i, 0 <= i -> Z_is_power2m1 (two_p i - 1) = Some i.
+Proof.
+  intros. unfold Z_is_power2m1. replace (Z.succ (two_p i - 1)) with (two_p i) by omega.
+  apply Z_is_power2_complete; auto.
+Qed.
+
+Lemma Z_is_power2m1_range:
+  forall n x i,
+  0 <= n -> 0 <= x < two_p n -> Z_is_power2m1 x = Some i -> 0 <= i <= n.
+Proof.
+  intros. destruct (zeq x (two_p n - 1)).
+- subst x. rewrite Z_is_power2m1_complete in H1 by auto. inv H1; omega.
+- unfold Z_is_power2m1 in H1. apply (Z_is_power2_range n (Z.succ x) i) in H1; omega.
+Qed.
+
+(** ** Relation between bitwise operations and multiplications / divisions by powers of 2 *)
+
+(** Left shifts and multiplications by powers of 2. *)
+
+Lemma Zshiftl_mul_two_p:
+  forall x n, 0 <= n -> Z.shiftl x n = x * two_p n.
+Proof.
+  intros. destruct n; simpl.
+  - omega.
+  - pattern p. apply Pos.peano_ind.
+    + change (two_power_pos 1) with 2. simpl. ring.
+    + intros. rewrite Pos.iter_succ. rewrite H0.
+      rewrite Pplus_one_succ_l. rewrite two_power_pos_is_exp.
+      change (two_power_pos 1) with 2. ring.
+  - compute in H. congruence.
+Qed.
+
+(** Right shifts and divisions by powers of 2. *)
+
+Lemma Zshiftr_div_two_p:
+  forall x n, 0 <= n -> Z.shiftr x n = x / two_p n.
+Proof.
+  intros. destruct n; unfold Z.shiftr; simpl.
+  - rewrite Zdiv_1_r. auto.
+  - pattern p. apply Pos.peano_ind.
+    + change (two_power_pos 1) with 2. simpl. apply Zdiv2_div.
+    + intros. rewrite Pos.iter_succ. rewrite H0.
+      rewrite Pplus_one_succ_l. rewrite two_power_pos_is_exp.
+      change (two_power_pos 1) with 2.
+      rewrite Zdiv2_div. rewrite Z.mul_comm. apply Zdiv_Zdiv.
+      rewrite two_power_pos_nat. apply two_power_nat_pos. omega.
+  - compute in H. congruence.
+Qed.
+
+(** ** Properties of [shrx] (signed division by a power of 2) *)
+
+Lemma Zquot_Zdiv:
+  forall x y,
+  y > 0 ->
+  Z.quot x y = if zlt x 0 then (x + y - 1) / y else x / y.
+Proof.
+  intros. destruct (zlt x 0).
+  - symmetry. apply Zquot_unique_full with ((x + y - 1) mod y - (y - 1)).
+     + red. right; split. omega.
+       exploit (Z_mod_lt (x + y - 1) y); auto.
+       rewrite Z.abs_eq. omega. omega.
+     + transitivity ((y * ((x + y - 1) / y) + (x + y - 1) mod y) - (y-1)).
+       rewrite <- Z_div_mod_eq. ring. auto. ring.
+  - apply Zquot_Zdiv_pos; omega.
+Qed.
+
+Lemma Zdiv_shift:
+  forall x y, y > 0 ->
+  (x + (y - 1)) / y = x / y + if zeq (Z.modulo x y) 0 then 0 else 1.
+Proof.
+  intros. generalize (Z_div_mod_eq x y H). generalize (Z_mod_lt x y H).
+  set (q := x / y). set (r := x mod y). intros.
+  destruct (zeq r 0).
+  apply Zdiv_unique with (y - 1). rewrite H1. rewrite e. ring. omega.
+  apply Zdiv_unique with (r - 1). rewrite H1. ring. omega.
+Qed.
+
+(** ** Size of integers, in bits. *)
+
+Definition Zsize (x: Z) : Z :=
+  match x with
+  | Zpos p => Zpos (Pos.size p)
+  | _ => 0
+  end.
+
+Remark Zsize_pos: forall x, 0 <= Zsize x.
+Proof.
+  destruct x; simpl. omega. compute; intuition congruence. omega.
+Qed.
+
+Remark Zsize_pos': forall x, 0 < x -> 0 < Zsize x.
+Proof.
+  destruct x; simpl; intros; try discriminate. compute; auto.
+Qed.
+
+Lemma Zsize_shiftin:
+  forall b x, 0 < x -> Zsize (Zshiftin b x) = Z.succ (Zsize x).
+Proof.
+  intros. destruct x; compute in H; try discriminate.
+  destruct b.
+  change (Zshiftin true (Zpos p)) with (Zpos (p~1)).
+  simpl. f_equal. rewrite Pos.add_1_r; auto.
+  change (Zshiftin false (Zpos p)) with (Zpos (p~0)).
+  simpl. f_equal. rewrite Pos.add_1_r; auto.
+Qed.
+
+Lemma Ztestbit_size_1:
+  forall x, 0 < x -> Z.testbit x (Z.pred (Zsize x)) = true.
+Proof.
+  intros x0 POS0; pattern x0; apply Zshiftin_pos_ind; auto.
+  intros. rewrite Zsize_shiftin; auto.
+  replace (Z.pred (Z.succ (Zsize x))) with (Z.succ (Z.pred (Zsize x))) by omega.
+  rewrite Ztestbit_shiftin_succ. auto. generalize (Zsize_pos' x H); omega.
+Qed.
+
+Lemma Ztestbit_size_2:
+  forall x, 0 <= x -> forall i, i >= Zsize x -> Z.testbit x i = false.
+Proof.
+  intros x0 POS0. destruct (zeq x0 0).
+  - subst x0; intros. apply Ztestbit_0.
+  - pattern x0; apply Zshiftin_pos_ind.
+    + simpl. intros. change 1 with (Zshiftin true 0). rewrite Ztestbit_shiftin.
+      rewrite zeq_false. apply Ztestbit_0. omega. omega.
+    + intros. rewrite Zsize_shiftin in H1; auto.
+      generalize (Zsize_pos' _ H); intros.
+      rewrite Ztestbit_shiftin. rewrite zeq_false. apply H0. omega.
+      omega. omega.
+    + omega.
+Qed.
+
+Lemma Zsize_interval_1:
+  forall x, 0 <= x -> 0 <= x < two_p (Zsize x).
+Proof.
+  intros.
+  assert (x = x mod (two_p (Zsize x))).
+    apply equal_same_bits; intros.
+    rewrite Ztestbit_mod_two_p; auto.
+    destruct (zlt i (Zsize x)). auto. apply Ztestbit_size_2; auto.
+    apply Zsize_pos; auto.
+  rewrite H0 at 1. rewrite H0 at 3. apply Z_mod_lt. apply two_p_gt_ZERO. apply Zsize_pos; auto.
+Qed.
+
+Lemma Zsize_interval_2:
+  forall x n, 0 <= n -> 0 <= x < two_p n -> n >= Zsize x.
+Proof.
+  intros. set (N := Z.to_nat n).
+  assert (Z.of_nat N = n) by (apply Z2Nat.id; auto).
+  rewrite <- H1 in H0. rewrite <- two_power_nat_two_p in H0.
+  destruct (zeq x 0).
+  subst x; simpl; omega.
+  destruct (zlt n (Zsize x)); auto.
+  exploit (Ztestbit_above N x (Z.pred (Zsize x))). auto. omega.
+  rewrite Ztestbit_size_1. congruence. omega.
+Qed.
+
+Lemma Zsize_monotone:
+  forall x y, 0 <= x <= y -> Zsize x <= Zsize y.
+Proof.
+  intros. apply Z.ge_le. apply Zsize_interval_2. apply Zsize_pos.
+  exploit (Zsize_interval_1 y). omega.
+  omega.
+Qed.
+
+(** ** Bit insertion, bit extraction *)
+
+(** Extract and optionally sign-extend bits [from...from+len-1] of [x] *)
+Definition Zextract_u (x: Z) (from: Z) (len: Z) : Z :=
+  Zzero_ext len (Z.shiftr x from).
+
+Definition Zextract_s (x: Z) (from: Z) (len: Z) : Z :=
+  Zsign_ext len (Z.shiftr x from).
+
+Lemma Zextract_u_spec:
+  forall x from len i,
+  0 <= from -> 0 <= len -> 0 <= i ->
+  Z.testbit (Zextract_u x from len) i =
+  if zlt i len then Z.testbit x (from + i) else false.
+Proof.
+  unfold Zextract_u; intros. rewrite Zzero_ext_spec, Z.shiftr_spec by auto.
+  rewrite Z.add_comm. auto.
+Qed.
+
+Lemma Zextract_s_spec:
+  forall x from len i,
+  0 <= from -> 0 < len -> 0 <= i ->
+  Z.testbit (Zextract_s x from len) i =
+  Z.testbit x (from + (if zlt i len then i else len - 1)).
+Proof.
+  unfold Zextract_s; intros. rewrite Zsign_ext_spec by auto. rewrite Z.shiftr_spec.
+  rewrite Z.add_comm. auto.
+  destruct (zlt i len); omega.
+Qed.
+
+(** Insert bits [0...len-1] of [y] into bits [to...to+len-1] of [x] *)
+
+Definition Zinsert (x y: Z) (to: Z) (len: Z) : Z :=
+  let mask := Z.shiftl (two_p len - 1) to in
+  Z.lor (Z.land (Z.shiftl y to) mask) (Z.ldiff x mask).
+
+Lemma Zinsert_spec:
+  forall x y to len i,
+  0 <= to -> 0 <= len -> 0 <= i ->
+  Z.testbit (Zinsert x y to len) i =
+    if zle to i && zlt i (to + len)
+    then Z.testbit y (i - to)
+    else Z.testbit x i.
+Proof.
+  unfold Zinsert; intros. set (mask := two_p len - 1).
+  assert (M: forall j, 0 <= j -> Z.testbit mask j = if zlt j len then true else false).
+  { intros; apply Ztestbit_two_p_m1; auto. }
+  rewrite Z.lor_spec, Z.land_spec, Z.ldiff_spec by auto. 
+  destruct (zle to i).
+- rewrite ! Z.shiftl_spec by auto. rewrite ! M by omega. 
+  unfold proj_sumbool; destruct (zlt (i - to) len); simpl;
+  rewrite andb_true_r, andb_false_r.
++ rewrite zlt_true by omega. apply orb_false_r.
++ rewrite zlt_false by omega; auto.
+- rewrite ! Z.shiftl_spec_low by omega. simpl. apply andb_true_r.
+Qed.
diff --git a/pg b/pg
index 28926baa..398d618f 100755
--- a/pg
+++ b/pg
@@ -1,10 +1,7 @@
 #!/bin/sh
-# Start Proof General with the right -I options
+# Start Proof General with the right Coq version
 # Use the Makefile to rebuild dependencies if needed
-# Recompile the modified file after coqide editing
-
-PWD=`pwd`
-INCLUDES=`make print-includes`
+# Recompile the modified file after editing
 
 make -q ${1}o || {
   make -n ${1}o | grep -v "\\b${1}\\b" | \
@@ -15,16 +12,5 @@ make -q ${1}o || {
 
 COQPROGNAME="${COQBIN}coqtop"
 
-COQPROGARGS=""
-for arg in $INCLUDES; do
-  case "$arg" in
-    -I|-R|-as|compcert*)
-      COQPROGARGS="$COQPROGARGS \"$arg\"";;
-    *)
-      COQPROGARGS="$COQPROGARGS \"$PWD/$arg\"";;
-  esac
-done
-
-emacs --eval "(setq coq-prog-name \"$COQPROGNAME\")" \
- --eval "(setq coq-prog-args '($COQPROGARGS))" $1 \
+emacs --eval "(setq coq-prog-name \"$COQPROGNAME\")" $1 \
 && make ${1}o
diff --git a/powerpc/Archi.v b/powerpc/Archi.v
index d792e4fe..10f38391 100644
--- a/powerpc/Archi.v
+++ b/powerpc/Archi.v
@@ -16,7 +16,7 @@
 
 (** Architecture-dependent parameters for PowerPC *)
 
-Require Import ZArith.
+Require Import ZArith List.
 (*From Flocq*)
 Require Import Binary Bits.
 
@@ -30,6 +30,10 @@ Definition align_float64 := 8%Z.
 (** Can we use the 64-bit extensions to the PowerPC architecture? *)
 Parameter ppc64 : bool.
 
+(** Should single-precision FP arguments passed on stack be passed 
+    as singles or use double FP format. *)
+Parameter single_passed_as_single : bool.
+
 Definition splitlong := negb ppc64.
 
 Lemma splitlong_ptr32: splitlong = true -> ptr64 = false.
@@ -37,24 +41,33 @@ Proof.
   reflexivity.
 Qed.
 
-Definition default_nan_64 : { x : binary64 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 53 1024 false (iter_nat 51 _ xO xH) (eq_refl true)) (eq_refl true).
+Definition default_nan_64 := (false, iter_nat 51 _ xO xH).
+Definition default_nan_32 := (false, iter_nat 22 _ xO xH).
+
+(* Always choose the first NaN argument, if any *)
+
+Definition choose_nan_64 (l: list (bool * positive)) : bool * positive :=
+  match l with nil => default_nan_64 | n :: _ => n end.
+
+Definition choose_nan_32 (l: list (bool * positive)) : bool * positive :=
+  match l with nil => default_nan_32 | n :: _ => n end.
 
-Definition choose_binop_pl_64 (pl1 pl2 : positive) :=
-  false.                        (**r always choose first NaN *)
+Lemma choose_nan_64_idem: forall n,
+  choose_nan_64 (n :: n :: nil) = choose_nan_64 (n :: nil).
+Proof. auto. Qed.
 
-Definition default_nan_32 : { x : binary32 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 24 128 false (iter_nat 22 _ xO xH) (eq_refl true)) (eq_refl true).
+Lemma choose_nan_32_idem: forall n,
+  choose_nan_32 (n :: n :: nil) = choose_nan_32 (n :: nil).
+Proof. auto. Qed.
 
-Definition choose_binop_pl_32 (pl1 pl2 : positive) :=
-  false.                        (**r always choose first NaN *)
+Definition fma_order {A: Type} (x y z: A) := (x, z, y).
 
-Definition fpu_returns_default_qNaN := false.
+Definition fma_invalid_mul_is_nan := false.
 
 Definition float_of_single_preserves_sNaN := true.
 
 Global Opaque ptr64 big_endian splitlong
-              default_nan_64 choose_binop_pl_64
-              default_nan_32 choose_binop_pl_32
-              fpu_returns_default_qNaN
+              default_nan_64 choose_nan_64
+              default_nan_32 choose_nan_32
+              fma_order fma_invalid_mul_is_nan
               float_of_single_preserves_sNaN.
diff --git a/powerpc/Asm.v b/powerpc/Asm.v
index ad24f563..4fb38ff8 100644
--- a/powerpc/Asm.v
+++ b/powerpc/Asm.v
@@ -231,6 +231,7 @@ Inductive instruction : Type :=
   | Pfres: freg -> freg -> instruction                        (**r approximate inverse *)
   | Pfsel: freg -> freg -> freg -> freg -> instruction        (**r FP conditional move *)
   | Pisel: ireg -> ireg -> ireg -> crbit -> instruction       (**r integer select *)
+  | Pfsel_gen: freg -> freg -> freg -> crbit -> instruction   (**r floating point select *)
   | Pisync: instruction                                       (**r ISYNC barrier *)
   | Picbi: ireg -> ireg -> instruction                        (**r instruction cache invalidate *)
   | Picbtls: int -> ireg -> ireg -> instruction               (**r instruction cache block touch and lock set *)
@@ -860,6 +861,20 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out
       Next (nextinstr (rs#rd <- (Val.subf rs#r1 rs#r2))) m
   | Pfsubs rd r1 r2 =>
       Next (nextinstr (rs#rd <- (Val.subfs rs#r1 rs#r2))) m
+  | Pisel rd r1 r2 bit =>
+      let v :=
+          match rs#(reg_of_crbit bit) with
+          | Vint n => if Int.eq n Int.zero then rs#r2 else (gpr_or_zero rs r1)
+          | _ => Vundef
+          end in
+      Next (nextinstr (rs #rd <- v #GPR0 <- Vundef)) m
+  | Pfsel_gen rd r1 r2 bit =>
+      let v :=
+          match rs#(reg_of_crbit bit) with
+          | Vint n => if Int.eq n Int.zero then rs#r2 else rs#r1
+          | _ => Vundef
+          end in
+      Next (nextinstr (rs #rd <- v #GPR0 <- Vundef)) m
   | Plbz rd cst r1 =>
       load1 Mint8unsigned rd cst r1 rs m
   | Plbzx rd r1 r2 =>
@@ -1073,7 +1088,6 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out
   | Pfrsqrte _ _
   | Pfres _ _
   | Pfsel _ _ _ _
-  | Pisel _ _ _ _
   | Plwarx _ _ _
   | Plwbrx _ _ _
   | Picbi _ _
diff --git a/powerpc/AsmToJSON.ml b/powerpc/AsmToJSON.ml
index ee3eaca8..f4d4285a 100644
--- a/powerpc/AsmToJSON.ml
+++ b/powerpc/AsmToJSON.ml
@@ -17,12 +17,10 @@ open AST
 open BinNums
 open Camlcoq
 open Json
-open Format
 open JsonAST
 
 let pp_reg pp t n =
-  let s = sprintf "%s%s" t n in
-  pp_jsingle_object pp "Register" pp_jstring s
+  pp_jsingle_object pp "Register" pp_jstring (t ^ n)
 
 let pp_ireg pp reg =
   pp_reg pp "r" (TargetPrinter.int_reg_name reg)
@@ -31,8 +29,8 @@ let pp_freg pp reg =
   pp_reg pp "f" (TargetPrinter.float_reg_name reg)
 
 let preg_annot = function
-  | IR r -> sprintf "r%s" (TargetPrinter.int_reg_name r)
-  | FR r -> sprintf "f%s" (TargetPrinter.float_reg_name r)
+  | IR r -> "r" ^ (TargetPrinter.int_reg_name r)
+  | FR r -> "f" ^ (TargetPrinter.float_reg_name r)
   | _    -> assert false
 
 let pp_constant pp c =
@@ -86,28 +84,31 @@ let pp_arg pp = function
   | Atom a -> pp_atom_constant pp a
   | String s -> pp_jsingle_object pp "String" pp_jstring s
 
-let mnemonic_names  =["Padd"; "Paddc"; "Padde"; "Paddi"; "Paddic"; "Paddis"; "Paddze"; "Pand_";
-                      "Pandc"; "Pandi_"; "Pandis_"; "Pannot"; "Pb"; "Pbctr"; "Pbctrl"; "Pbdnz";
-                      "Pbf"; "Pbl"; "Pblr"; "Pbs"; "Pbt"; "Pbtbl"; "Pcmpb"; "Pcmpd"; "Pcmpdi";
-                      "Pcmpld"; "Pcmpldi"; "Pcmplw"; "Pcmplwi"; "Pcmpw"; "Pcmpwi"; "Pcntlzd";
-                      "Pcntlzw"; "Pcreqv"; "Pcror"; "Pcrxor"; "Pdcbf"; "Pdcbi"; "Pdcbt";
-                      "Pdcbtls"; "Pdcbtst"; "Pdcbz"; "Pdivd"; "Pdivdu"; "Pdivw"; "Pdivwu";
-                      "Peieio"; "Peqv"; "Pextsb"; "Pextsh"; "Pextsw"; "Pfabs"; "Pfadd"; "Pfadds";
-                      "Pfcfid"; "Pfcmpu"; "Pfctidz"; "Pfctiw"; "Pfctiwz"; "Pfdiv"; "Pfdivs";
-                      "Pfmadd"; "Pfmr"; "Pfmsub"; "Pfmul"; "Pfmuls"; "Pfneg"; "Pfnmadd";
-                      "Pfnmsub"; "Pfres"; "Pfrsp"; "Pfrsqrte"; "Pfsel"; "Pfsqrt"; "Pfsub";
-                      "Pfsubs"; "Picbi"; "Picbtls"; "Pinlineasm"; "Pisel"; "Pisync"; "Plabel";
-                      "Plbz"; "Plbzx"; "Pld"; "Pldbrx"; "Pldi"; "Pldx"; "Plfd"; "Plfdx"; "Plfi"; "Plfis";
-                      "Plfs"; "Plfsx"; "Plha"; "Plhax"; "Plhbrx"; "Plhz"; "Plhzx"; "Plwarx";
-                      "Plwbrx"; "Plwsync"; "Plwz"; "Plwzu"; "Plwzx"; "Pmbar"; "Pmfcr"; "Pmflr";
-                      "Pmfspr"; "Pmr"; "Pmtctr"; "Pmtlr"; "Pmtspr"; "Pmulhd"; "Pmulhdu"; "Pmulhw";
-                      "Pmulhwu"; "Pmulld"; "Pmulli"; "Pmullw"; "Pnand"; "Pnor"; "Por"; "Porc";
-                      "Pori"; "Poris"; "Prldicl"; "Prldimi"; "Prldinm"; "Prlwimi"; "Prlwinm";
-                      "Psld"; "Pslw"; "Psrad"; "Psradi"; "Psraw"; "Psrawi"; "Psrd"; "Psrw";
-                      "Pstb"; "Pstbx"; "Pstd"; "Pstdbrx"; "Pstdu"; "Pstdx"; "Pstfd"; "Pstfdu"; "Pstfdx";
-                      "Pstfs"; "Pstfsx"; "Psth"; "Psthbrx"; "Psthx"; "Pstw"; "Pstwbrx"; "Pstwcx_";
-                      "Pstwu"; "Pstwux"; "Pstwx"; "Psubfc"; "Psubfe"; "Psubfic"; "Psubfze";
-                      "Psync"; "Ptrap"; "Pxor"; "Pxori"; "Pxoris"]
+module StringSet = Set.Make(String)
+
+let mnemonic_names = StringSet.of_list
+    ["Padd"; "Paddc"; "Padde"; "Paddi"; "Paddic"; "Paddis"; "Paddze"; "Pand_";
+     "Pandc"; "Pandi_"; "Pandis_"; "Pannot"; "Pb"; "Pbctr"; "Pbctrl"; "Pbdnz";
+     "Pbf"; "Pbl"; "Pblr"; "Pbs"; "Pbt"; "Pbtbl"; "Pcmpb"; "Pcmpd"; "Pcmpdi";
+     "Pcmpld"; "Pcmpldi"; "Pcmplw"; "Pcmplwi"; "Pcmpw"; "Pcmpwi"; "Pcntlzd";
+     "Pcntlzw"; "Pcreqv"; "Pcror"; "Pcrxor"; "Pdcbf"; "Pdcbi"; "Pdcbt";
+     "Pdcbtls"; "Pdcbtst"; "Pdcbz"; "Pdivd"; "Pdivdu"; "Pdivw"; "Pdivwu";
+     "Peieio"; "Peqv"; "Pextsb"; "Pextsh"; "Pextsw"; "Pfabs"; "Pfadd"; "Pfadds";
+     "Pfcfid"; "Pfcmpu"; "Pfctidz"; "Pfctiw"; "Pfctiwz"; "Pfdiv"; "Pfdivs";
+     "Pfmadd"; "Pfmr"; "Pfmsub"; "Pfmul"; "Pfmuls"; "Pfneg"; "Pfnmadd";
+     "Pfnmsub"; "Pfres"; "Pfrsp"; "Pfrsqrte"; "Pfsel"; "Pfsqrt"; "Pfsub";
+     "Pfsubs"; "Picbi"; "Picbtls"; "Pinlineasm"; "Pisel"; "Pisync"; "Plabel";
+     "Plbz"; "Plbzx"; "Pld"; "Pldbrx"; "Pldi"; "Pldx"; "Plfd"; "Plfdx"; "Plfi";
+     "Plfis"; "Plfs"; "Plfsx"; "Plha"; "Plhax"; "Plhbrx"; "Plhz"; "Plhzx";
+     "Plwarx"; "Plwbrx"; "Plwsync"; "Plwz"; "Plwzu"; "Plwzx"; "Pmbar"; "Pmfcr";
+     "Pmflr"; "Pmfspr"; "Pmr"; "Pmtctr"; "Pmtlr"; "Pmtspr"; "Pmulhd"; "Pmulhdu";
+     "Pmulhw"; "Pmulhwu"; "Pmulld"; "Pmulli"; "Pmullw"; "Pnand"; "Pnor"; "Por";
+     "Porc"; "Pori"; "Poris"; "Prldicl"; "Prldimi"; "Prldinm"; "Prlwimi";
+     "Prlwinm"; "Psld"; "Pslw"; "Psrad"; "Psradi"; "Psraw"; "Psrawi"; "Psrd";
+     "Psrw"; "Pstb"; "Pstbx"; "Pstd"; "Pstdbrx"; "Pstdu"; "Pstdx"; "Pstfd";
+     "Pstfdu"; "Pstfdx"; "Pstfs"; "Pstfsx"; "Psth"; "Psthbrx"; "Psthx"; "Pstw";
+     "Pstwbrx"; "Pstwcx_"; "Pstwu"; "Pstwux"; "Pstwx"; "Psubfc"; "Psubfe";
+     "Psubfic"; "Psubfze"; "Psync"; "Ptrap"; "Pxor"; "Pxori"; "Pxoris"]
 
 let pp_instructions pp ic =
   let ic = List.filter (fun s -> match s with
@@ -126,7 +127,7 @@ let pp_instructions pp ic =
       | Pcfi_rel_offset _ -> false
       | _ -> true) ic in
   let instruction pp n args =
-    assert (List.mem n mnemonic_names);
+    assert (StringSet.mem n mnemonic_names);
     pp_jobject_start pp;
     pp_jmember ~first:true pp "Instruction Name" pp_jstring n;
     pp_jmember pp "Args" (pp_jarray pp_arg) args;
@@ -228,6 +229,7 @@ let pp_instructions pp ic =
   | Pfres (fr1,fr2) -> instruction pp "Pfres" [Freg fr1; Freg fr2]
   | Pfsel (fr1,fr2,fr3,fr4) -> instruction pp "Pfsel" [Freg fr1; Freg fr2; Freg fr3; Freg fr4]
   | Pisel (ir1,ir2,ir3,cr) ->  instruction pp "Pisel" [Ireg ir1; Ireg ir2; Ireg ir3; Crbit cr]
+  | Pfsel_gen _ -> assert false (* Should not occur *)
   | Picbi (ir1,ir2) -> instruction pp "Picbi" [Ireg ir1; Ireg ir2]
   | Picbtls (n,ir1,ir2) -> instruction pp "Picbtls" [Constant (Cint n);Ireg ir1; Ireg ir2]
   | Pisync -> instruction pp "Pisync" []
@@ -250,7 +252,7 @@ let pp_instructions pp ic =
   | Plhbrx (ir1,ir2,ir3) -> instruction pp "Plhbrx" [Ireg ir1; Ireg ir2; Ireg ir3]
   | Plhz (ir1,c,ir2) -> instruction pp "Plhz" [Ireg ir1; Constant c; Ireg ir2]
   | Plhzx (ir1,ir2,ir3) -> instruction pp "Plhzx" [Ireg ir1; Ireg ir2; Ireg ir3]
-  | Pldi (ir,c) -> instruction pp "Pldi" [Ireg ir; Long c] (* FIXME Cint is too small, we need Clong *)
+  | Pldi (ir,c) -> instruction pp "Pldi" [Ireg ir; Long c]
   | Plmake _ (* Should not occur *)
   | Pllo _ (* Should not occur *)
   | Plhi _ -> assert false (* Should not occur *)
@@ -384,8 +386,8 @@ let print_if prog sourcename =
   | Some f ->
     let f = Filename.concat !sdump_folder f in
     let oc = open_out_bin f in
-    pp_ast (formatter_of_out_channel oc) pp_instructions prog sourcename;
+    pp_ast oc pp_instructions prog sourcename;
     close_out oc
 
 let pp_mnemonics pp =
-  pp_mnemonics pp mnemonic_names
+  pp_mnemonics pp (StringSet.elements mnemonic_names)
diff --git a/powerpc/Asmexpand.ml b/powerpc/Asmexpand.ml
index 49a0d237..ce88778c 100644
--- a/powerpc/Asmexpand.ml
+++ b/powerpc/Asmexpand.ml
@@ -14,7 +14,7 @@
    of the PPC assembly code. *)
 
 open Camlcoq
-open Integers
+open! Integers
 open AST
 open Asm
 open Asmexpandaux
@@ -30,20 +30,22 @@ let eref =
 
 (* Useful constants and helper functions *)
 
-let _0 = Integers.Int.zero
-let _1 = Integers.Int.one
+let _0 = Int.zero
+let _1 = Int.one
 let _2 = coqint_of_camlint 2l
 let _4 = coqint_of_camlint 4l
 let _6 = coqint_of_camlint 6l
 let _8 = coqint_of_camlint 8l
+let _16 = coqint_of_camlint 16l
 let _31 = coqint_of_camlint 31l
 let _32 = coqint_of_camlint 32l
 let _64 = coqint_of_camlint 64l
 let _m1 = coqint_of_camlint (-1l)
 let _m4 = coqint_of_camlint (-4l)
 let _m8 = coqint_of_camlint (-8l)
+let _m16 = coqint_of_camlint (-16l)
 
-let _0L = Integers.Int64.zero
+let _0L = Int64.zero
 let _32L = coqint_of_camlint64 32L
 let _64L = coqint_of_camlint64 64L
 let _m1L = coqint_of_camlint64 (-1L)
@@ -56,6 +58,15 @@ let emit_loadimm r n =
 let emit_addimm rd rs n =
   List.iter emit (Asmgen.addimm rd rs n [])
 
+(* Numbering of bits in the CR register *)
+
+let num_crbit = function
+  | CRbit_0 -> 0
+  | CRbit_1 -> 1
+  | CRbit_2 -> 2
+  | CRbit_3 -> 3
+  | CRbit_6 -> 6
+
 (* Handling of annotations *)
 
 let expand_annot_val kind txt targ args res =
@@ -77,8 +88,6 @@ let expand_annot_val kind txt targ args res =
    So, use 64-bit accesses only if alignment >= 4.
    Note that lfd and stfd cannot trap on ill-formed floats. *)
 
-
-
 let offset_in_range ofs =
   Int.eq (Asmgen.high_s ofs) _0
 
@@ -410,10 +419,21 @@ let expand_builtin_va_start r =
 let expand_int64_arith conflict rl fn =
   if conflict then (fn GPR0; emit (Pmr(rl, GPR0))) else fn rl
 
-(* Expansion of integer conditional moves (__builtin_*sel) *)
+(* Expansion of integer conditional moves (__builtin_*sel and Pisel) *)
 (* The generated code works equally well with 32-bit integer registers
    and with 64-bit integer registers. *)
 
+let expand_integer_cond_move_1 a2 a3 res =
+  (* GPR0 is -1 (all ones) if condition is true, 0 if it is false *)
+  if res <> a3 then begin
+    emit (Pand_ (res, a2, GPR0));
+    emit (Pandc (GPR0, a3, GPR0))
+  end else begin
+    emit (Pandc (res, a3, GPR0));
+    emit (Pand_ (GPR0, a2, GPR0))
+  end;
+  emit (Por (res, res, GPR0))
+
 let expand_integer_cond_move a1 a2 a3 res =
   if a2 = a3 then
     emit (Pmr (res, a2))
@@ -423,15 +443,37 @@ let expand_integer_cond_move a1 a2 a3 res =
   end else begin
     (* a1 has type _Bool, hence it is 0 or 1 *)
     emit (Psubfic (GPR0, a1, Cint _0));
-    (* r0 = -1 (all ones) if a1 is true, r0 = 0 if a1 is false *)
-    if res <> a3 then begin
-      emit (Pand_ (res, a2, GPR0));
-      emit (Pandc (GPR0, a3, GPR0))
-    end else begin
-      emit (Pandc (res, a3, GPR0));
-      emit (Pand_ (GPR0, a2, GPR0))
-    end;
-    emit (Por (res, res, GPR0))
+    expand_integer_cond_move_1 a2 a3 res
+  end
+
+
+(* Expansion of floating point conditional moves (Pfcmove) *)
+
+let expand_float_cond_move bit a2 a3 res =
+  emit (Pmfcr GPR0);
+  emit (Prlwinm(GPR0, GPR0, Z.of_uint (4 + num_crbit bit), _8));
+  emit (Pstfdu (a3, Cint (_m16), GPR1));
+  emit (Pcfi_adjust _16);
+  emit (Pstfd (a2, Cint (_8), GPR1));
+  emit (Plfdx (res, GPR1, GPR0));
+  emit (Paddi (GPR1, GPR1, (Cint _16)));
+  emit (Pcfi_adjust _m16)
+
+
+
+(* Symmetrically, we emulate the "isel" instruction on PPC processors
+   that do not have it. *)
+
+let expand_isel bit a2 a3 res =
+  if a2 = a3 then
+    emit (Pmr (res, a2))
+  else if eref then
+    emit (Pisel (res, a2, a3, bit))
+  else begin
+    emit (Pmfcr GPR0);
+    emit (Prlwinm(GPR0, GPR0, Z.of_uint (1 + num_crbit bit), _1));
+    emit (Psubfic (GPR0, GPR0, Cint _0));
+    expand_integer_cond_move_1 a2 a3 res
   end
 
 (* Convert integer constant into GPR with corresponding number *)
@@ -512,6 +554,26 @@ let expand_builtin_inline name args res =
       emit (Plabel lbl2)
   | "__builtin_cmpb",  [BA(IR a1); BA(IR a2)], BR(IR res) ->
       emit (Pcmpb (res,a1,a2))
+  |  "__builtin_bswap64", [BA_splitlong(BA(IR ah), BA(IR al))],
+                          BR_splitlong(BR(IR rh), BR(IR rl))->
+      assert (not Archi.ppc64);
+      emit (Pstwu(ah, Cint _m8, GPR1));
+      emit (Pcfi_adjust _8);
+      emit (Pstwu(al, Cint _m8, GPR1));
+      emit (Pcfi_adjust _8);
+      emit (Plwbrx(rh, GPR0, GPR1));
+      emit (Paddi(GPR1, GPR1, Cint _8));
+      emit (Pcfi_adjust _m8);
+      emit (Plwbrx(rl, GPR0, GPR1));
+      emit (Paddi(GPR1, GPR1, Cint _8));
+      emit (Pcfi_adjust _m8)
+  |  "__builtin_bswap64", [BA(IR a1)], BR(IR res) ->
+      assert (Archi.ppc64);
+      emit (Pstdu(a1, Cint _m8, GPR1));
+      emit (Pcfi_adjust _8);
+      emit (Pldbrx(res, GPR0, GPR1));
+      emit (Paddi(GPR1, GPR1, Cint _8));
+      emit (Pcfi_adjust _m8)
   | ("__builtin_bswap" | "__builtin_bswap32"), [BA(IR a1)], BR(IR res) ->
       emit (Pstwu(a1, Cint _m8, GPR1));
       emit (Pcfi_adjust _8);
@@ -772,13 +834,6 @@ let set_cr6 sg =
 
 (* Expand instructions *)
 
-let num_crbit = function
-  | CRbit_0 -> 0
-  | CRbit_1 -> 1
-  | CRbit_2 -> 2
-  | CRbit_3 -> 3
-  | CRbit_6 -> 6
-
 let expand_instruction instr =
   match instr with
   | Pallocframe(sz, ofs,retofs) ->
@@ -797,7 +852,7 @@ let expand_instruction instr =
       if variadic then begin
         emit (Pmflr GPR0);
         emit (Pbl(intern_string "__compcert_va_saveregs",
-                  {sig_args = []; sig_res = None; sig_cc = cc_default}));
+                  {sig_args = []; sig_res = Tvoid; sig_cc = cc_default}));
         emit (Pmtlr GPR0)
       end;
       current_function_stacksize := sz;
@@ -874,6 +929,10 @@ let expand_instruction instr =
       emit (Pcfi_adjust _m8);
   | Pfxdp(r1, r2) ->
       if r1 <> r2 then emit(Pfmr(r1, r2))
+  | Pisel(rd, r1, r2, bit) ->
+      expand_isel bit r1 r2 rd
+  | Pfsel_gen (rd, r1, r2, bit) ->
+      expand_float_cond_move bit r1 r2 rd
   | Plmake(r1, rhi, rlo) ->
       if r1 = rlo then
         emit (Prldimi(r1, rhi, _32L, upper32))
diff --git a/powerpc/Asmgen.v b/powerpc/Asmgen.v
index 8c296f0a..a686414a 100644
--- a/powerpc/Asmgen.v
+++ b/powerpc/Asmgen.v
@@ -125,17 +125,35 @@ Definition rolm (r1 r2: ireg) (amount mask: int) (k: code) :=
 Definition low64_u (n: int64) := Int64.zero_ext 16 n.
 Definition low64_s (n: int64) := Int64.sign_ext 16 n.
 
-Definition loadimm64 (r: ireg) (n: int64) (k: code) :=
+Definition loadimm64_32s (r: ireg) (n: int64) (k: code) :=
   let lo_u := low64_u n in
   let lo_s := low64_s n in
-  let hi_s := Int64.sign_ext 16 (Int64.shr n (Int64.repr 16)) in
+  let hi_s := low64_s (Int64.shr n (Int64.repr 16)) in
   if Int64.eq n lo_s then
     Paddi64 r GPR0 n :: k
-  else if Int64.eq n (Int64.or (Int64.shl hi_s (Int64.repr 16)) lo_u) then
-    Paddis64 r GPR0 hi_s :: Pori64 r r lo_u :: k
+  else
+    Paddis64 r GPR0 hi_s :: Pori64 r r lo_u :: k.
+
+Definition loadimm64 (r: ireg) (n: int64) (k: code) :=
+  if Int64.eq n (Int64.sign_ext 32 n) then
+    loadimm64_32s r n k
   else
     Pldi r n :: k.
 
+(** [loadimm64_notemp] is a variant of [loadimm64] that uses no temporary
+  register.  The code it produces is larger and slower than the code
+  produced by [loadimm64], but it is sometimes useful to preserve all registers
+  except the destination. *)
+
+Definition loadimm64_notemp (r: ireg) (n: int64) (k: code) :=
+  if Int64.eq n (Int64.sign_ext 32 n) then
+    loadimm64_32s r n k
+  else
+    loadimm64_32s r (Int64.shru n (Int64.repr 32))
+     (Prldinm r r (Int.repr 32) (Int64.shl Int64.mone (Int64.repr 32)) ::
+      Poris64 r r (low64_u (Int64.shru n (Int64.repr 16))) ::
+      Pori64 r r (low64_u n) :: k).
+
 Definition opimm64 (insn2: ireg -> ireg -> ireg -> instruction)
                    (insn1: ireg -> ireg -> int64 -> instruction)
                    (r1 r2: ireg) (n: int64) (ok: bool) (k: code) :=
@@ -261,18 +279,14 @@ Definition transl_cond
       do r1 <- ireg_of a1;
       if Int64.eq n (low64_s n) then
         OK (Pcmpdi r1 n :: k)
-      else if ireg_eq r1 GPR12 then
-        OK (Pmr GPR0 GPR12 :: loadimm64 GPR12 n (Pcmpd GPR0 GPR12 :: k))
       else
-        OK (loadimm64 GPR0 n (Pcmpd r1 GPR0 :: k))
+        OK (loadimm64_notemp GPR0 n (Pcmpd r1 GPR0 :: k))
   | Ccompluimm c n, a1 :: nil =>
       do r1 <- ireg_of a1;
       if Int64.eq n (low64_u n) then
         OK (Pcmpldi r1 n :: k)
-      else if ireg_eq r1 GPR12 then
-        OK (Pmr GPR0 GPR12 :: loadimm64 GPR12 n (Pcmpld GPR0 GPR12 :: k))
       else
-        OK (loadimm64 GPR0 n (Pcmpld r1 GPR0 :: k))
+        OK (loadimm64_notemp GPR0 n (Pcmpld r1 GPR0 :: k))
   | _, _ =>
       Error(msg "Asmgen.transl_cond")
   end.
@@ -390,6 +404,28 @@ Definition transl_cond_op
          else Pxori r' r' (Cint Int.one) :: k)
   end.
 
+(** Translation of a select operation *)
+
+Definition transl_select_op
+              (cond: condition) (args: list mreg) (r1 r2 rd: ireg) (k: code) :=
+  if ireg_eq r1 r2 then
+    OK (Pmr rd r1 :: k)
+  else
+   (let p := crbit_for_cond cond in
+    let r1' := if snd p then r1 else r2 in
+    let r2' := if snd p then r2 else r1 in
+    transl_cond cond args (Pisel rd r1' r2' (fst p) :: k)).
+
+Definition transl_fselect_op
+              (cond: condition) (args: list mreg) (r1 r2 rd: freg) (k: code) :=
+  if freg_eq r1 r2 then
+    OK (Pfmr rd r1 :: k)
+  else
+   (let p := crbit_for_cond cond in
+    let r1' := if snd p then r1 else r2 in
+    let r2' := if snd p then r2 else r1 in
+    transl_cond cond args (Pfsel_gen rd r1' r2' (fst p) :: k)).
+
 (** Translation of the arithmetic operation [r <- op(args)].
   The corresponding instructions are prepended to [k]. *)
 
@@ -596,6 +632,17 @@ Definition transl_op
       do r1 <- ireg_of a1; do r <- ireg_of res; OK (Plhi r r1 :: k)
   | Ocmp cmp, _ =>
       transl_cond_op cmp args res k
+  | Osel cmp ty, a1 :: a2 :: args =>
+      match preg_of res with
+      | IR r1 =>
+      do r1 <- ireg_of a1; do r2 <- ireg_of a2; do r <- ireg_of res;
+      transl_select_op cmp args r1 r2 r k
+      | FR r =>
+      do r1 <- freg_of a1; do r2 <- freg_of a2; do r <- freg_of res;
+      transl_fselect_op cmp args r1 r2 r k
+      | _ =>
+        Error (msg "Asmgen.Osel")
+      end
 (*c PPC64 operations *)
   | Olongconst n, nil =>
       do r <- ireg_of res; OK (loadimm64 r n k)
diff --git a/powerpc/Asmgenproof.v b/powerpc/Asmgenproof.v
index 8ad28aea..d653633c 100644
--- a/powerpc/Asmgenproof.v
+++ b/powerpc/Asmgenproof.v
@@ -179,14 +179,28 @@ Proof.
 Qed.
 Hint Resolve rolm_label: labels.
 
+Remark loadimm64_32s_label:
+  forall r n k, tail_nolabel k (loadimm64_32s r n k).
+Proof.
+  unfold loadimm64_32s; intros. destruct Int64.eq; TailNoLabel.
+Qed.
+Hint Resolve loadimm64_32s_label: labels.
+
 Remark loadimm64_label:
   forall r n k, tail_nolabel k (loadimm64 r n k).
 Proof.
-  unfold loadimm64; intros.
-  destruct Int64.eq. TailNoLabel. destruct Int64.eq; TailNoLabel.
+  unfold loadimm64; intros. destruct Int64.eq; TailNoLabel.
 Qed.
 Hint Resolve loadimm64_label: labels.
 
+Remark loadimm64_notemp_label:
+  forall r n k, tail_nolabel k (loadimm64_notemp r n k).
+Proof.
+  unfold loadimm64_notemp; intros. destruct Int64.eq; TailNoLabel.
+  eapply tail_nolabel_trans; TailNoLabel.
+Qed.
+Hint Resolve loadimm64_notemp_label: labels.
+
 Remark loadind_label:
   forall base ofs ty dst k c,
   loadind base ofs ty dst k = OK c -> tail_nolabel k c.
@@ -234,6 +248,24 @@ Proof.
   destruct (snd (crbit_for_cond c0)); TailNoLabel.
 Qed.
 
+Remark transl_select_op_label:
+  forall cond args r1 r2 rd k c,
+  transl_select_op cond args r1 r2 rd k = OK c -> tail_nolabel k c.
+Proof.
+  unfold transl_select_op; intros. destruct (ireg_eq r1 r2).
+  TailNoLabel.
+  eapply tail_nolabel_trans. eapply transl_cond_label; eauto.  TailNoLabel.
+Qed.
+
+Remark transl_fselect_op_label:
+  forall cond args r1 r2 rd k c,
+  transl_fselect_op cond args r1 r2 rd k = OK c -> tail_nolabel k c.
+Proof.
+  unfold transl_fselect_op; intros. destruct (freg_eq r1 r2).
+  TailNoLabel.
+  eapply tail_nolabel_trans. eapply transl_cond_label; eauto.  TailNoLabel.
+Qed.
+
 Remark transl_op_label:
   forall op args r k c,
   transl_op op args r k = OK c -> tail_nolabel k c.
@@ -261,6 +293,7 @@ Opaque Int.eq.
   destruct Int64.eq. TailNoLabel.
   destruct ireg_eq; [apply tail_nolabel_cons; unfold nolabel;auto|]; eapply tail_nolabel_trans; TailNoLabel.
 - eapply transl_cond_op_label; eauto.
+- destruct (preg_of r); monadInv H. eapply transl_select_op_label; eauto. eapply transl_fselect_op_label; eauto.
 Qed.
 
 Remark transl_memory_access_label:
diff --git a/powerpc/Asmgenproof1.v b/powerpc/Asmgenproof1.v
index c18757b2..20cf9c1d 100644
--- a/powerpc/Asmgenproof1.v
+++ b/powerpc/Asmgenproof1.v
@@ -16,6 +16,7 @@ Require Import Coqlib.
 Require Import Errors.
 Require Import Maps.
 Require Import AST.
+Require Import Zbits.
 Require Import Integers.
 Require Import Floats.
 Require Import Values.
@@ -80,13 +81,13 @@ Proof.
     unfold Int.modu, Int.zero. decEq.
     change 0 with (0 mod 65536).
     change (Int.unsigned (Int.repr 65536)) with 65536.
-    apply Int.eqmod_mod_eq. omega.
-    unfold x, low_s. eapply Int.eqmod_trans.
-    apply Int.eqmod_divides with Int.modulus.
+    apply eqmod_mod_eq. omega.
+    unfold x, low_s. eapply eqmod_trans.
+    apply  eqmod_divides with Int.modulus.
     unfold Int.sub. apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl.
     exists 65536. compute; auto.
     replace 0 with (Int.unsigned n - Int.unsigned n) by omega.
-    apply Int.eqmod_sub. apply Int.eqmod_refl. apply Int.eqmod_sign_ext'.
+    apply eqmod_sub. apply eqmod_refl. apply Int.eqmod_sign_ext'.
     compute; auto.
   rewrite H0 in H. rewrite Int.add_zero in H.
   rewrite <- H. unfold x. rewrite Int.sub_add_opp. rewrite Int.add_assoc.
@@ -531,6 +532,40 @@ Qed.
 
 (** Load int64 constant. *)
 
+Lemma loadimm64_32s_correct:
+  forall r n k rs m,
+  exists rs',
+     exec_straight ge fn (loadimm64_32s r n k) rs m  k rs' m
+  /\ rs'#r = Vlong (Int64.sign_ext 32 n)
+  /\ forall r': preg, r' <> r -> r' <> PC -> rs'#r' = rs#r'.
+Proof.
+  unfold loadimm64_32s; intros. predSpec Int64.eq Int64.eq_spec n (low64_s n).
+  - econstructor; split; [|split].
+    + apply exec_straight_one. simpl; eauto. auto.
+    + Simpl. rewrite Int64.add_zero_l. rewrite H. unfold low64_s.
+      rewrite Int64.sign_ext_widen by omega. auto.
+    + intros; Simpl.
+  - econstructor; split; [|split].
+    + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto.
+    + Simpl. simpl. f_equal. rewrite Int64.add_zero_l.
+      apply Int64.same_bits_eq; intros.  assert (Int64.zwordsize = 64) by auto.
+      rewrite Int64.bits_or, Int64.bits_shl by auto.
+      unfold low64_s, low64_u.
+      rewrite Int64.bits_zero_ext by omega.
+      change (Int64.unsigned (Int64.repr 16)) with 16.
+      destruct (zlt i 16).
+      * rewrite Int64.bits_sign_ext by omega. rewrite zlt_true by omega. auto.
+      * rewrite ! Int64.bits_sign_ext by omega. rewrite orb_false_r.
+        destruct (zlt i 32).
+        ** rewrite zlt_true by omega. rewrite Int64.bits_shr by omega.
+           change (Int64.unsigned (Int64.repr 16)) with 16.
+           rewrite zlt_true by omega. f_equal; omega.
+        ** rewrite zlt_false by omega. rewrite Int64.bits_shr by omega.
+           change (Int64.unsigned (Int64.repr 16)) with 16.
+           reflexivity.
+    + intros; Simpl.
+Qed.
+
 Lemma loadimm64_correct:
   forall r n k rs m,
   exists rs',
@@ -539,20 +574,78 @@ Lemma loadimm64_correct:
   /\ forall r': preg, r' <> r -> r' <> GPR12 -> r' <> PC -> rs'#r' = rs#r'.
 Proof.
   intros. unfold loadimm64.
-  set (hi_s := Int64.sign_ext 16 (Int64.shr n (Int64.repr 16))).
-  set (hi' := Int64.shl hi_s (Int64.repr 16)).
-  destruct (Int64.eq n (low64_s n)).
-  (* addi *)
-  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
-  rewrite Int64.add_zero_l. intuition Simpl.
-  (* addis + ori *)
-  predSpec Int64.eq Int64.eq_spec n (Int64.or hi' (low64_u n)).
-  econstructor; split. eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto.
-  split. Simpl. rewrite Int64.add_zero_l. simpl; f_equal; auto.
-  intros. Simpl.
-  (* ldi *)
-  econstructor; split. apply exec_straight_one. simpl; eauto. auto.
-  intuition Simpl.
+  predSpec Int64.eq Int64.eq_spec n (Int64.sign_ext 32 n).
+  - destruct (loadimm64_32s_correct r n k rs m) as (rs' & A & B & C).
+    exists rs'; intuition auto. congruence.
+  - econstructor; split. apply exec_straight_one. simpl; eauto. auto.
+    intuition Simpl.
+Qed.
+
+(** Alternate load int64 immediate *)
+
+Lemma loadimm64_notemp_correct:
+  forall r n k rs m,
+  exists rs',
+     exec_straight ge fn (loadimm64_notemp r n k) rs m  k rs' m
+  /\ rs'#r = Vlong n
+  /\ forall r': preg, r' <> r -> r' <> PC -> rs'#r' = rs#r'.
+Proof.
+  intros. unfold loadimm64_notemp.
+  predSpec Int64.eq Int64.eq_spec n (Int64.sign_ext 32 n).
+- destruct (loadimm64_32s_correct r n k rs m) as (rs' & A & B & C).
+  exists rs'; intuition auto. congruence.
+- set (n2 := Int64.shru n (Int64.repr 32)).
+  set (n1 := Int64.zero_ext 16 (Int64.shru n (Int64.repr 16))).
+  set (n0 := Int64.zero_ext 16 n).
+  set (mi := Int64.shl n1 (Int64.repr 16)).
+  set (hi := Int64.shl (Int64.sign_ext 32 n2) (Int64.repr 32)).
+  assert (HI: forall i, 0 <= i < Int64.zwordsize ->
+              Int64.testbit hi i = if zlt i 32 then false else Int64.testbit n i).
+  { intros. unfold hi. assert (Int64.zwordsize = 64) by auto.
+    rewrite Int64.bits_shl by auto.
+    change (Int64.unsigned (Int64.repr 32)) with 32.
+    destruct (zlt i 32); auto.
+    rewrite Int64.bits_sign_ext by omega.
+    rewrite zlt_true by omega.
+    unfold n2. rewrite Int64.bits_shru by omega.
+    change (Int64.unsigned (Int64.repr 32)) with 32.
+    rewrite zlt_true by omega. f_equal; omega.
+  }
+  assert (MI: forall i, 0 <= i < Int64.zwordsize ->
+              Int64.testbit mi i =
+              if zlt i 16 then false
+              else if zlt i 32 then Int64.testbit n i else false).
+  { intros. unfold mi. assert (Int64.zwordsize = 64) by auto.
+    rewrite Int64.bits_shl by auto.
+    change (Int64.unsigned (Int64.repr 16)) with 16.
+    destruct (zlt i 16); auto.
+    unfold n1. rewrite Int64.bits_zero_ext by omega.
+    rewrite Int64.bits_shru by omega.
+    destruct (zlt i 32).
+    rewrite zlt_true by omega.
+    change (Int64.unsigned (Int64.repr 16)) with 16.
+    rewrite zlt_true by omega. f_equal; omega.
+    rewrite zlt_false by omega. auto.
+  }
+  assert (EQ: Int64.or (Int64.or hi mi) n0 = n).
+  { apply Int64.same_bits_eq; intros.
+    rewrite ! Int64.bits_or by auto.
+    unfold n0; rewrite Int64.bits_zero_ext by omega.
+    rewrite HI, MI by auto.
+    destruct (zlt i 16).
+    rewrite zlt_true by omega. auto.
+    destruct (zlt i 32); rewrite ! orb_false_r; auto.
+  }
+  edestruct (loadimm64_32s_correct r n2) as (rs' & A & B & C).
+  econstructor; split; [|split].
+  + eapply exec_straight_trans. eexact A.
+    eapply exec_straight_three.
+    simpl. rewrite B. simpl; auto.
+    simpl; auto.
+    simpl; auto.
+    reflexivity. reflexivity. reflexivity.
+  + Simpl. simpl. f_equal. rewrite <- Int64.shl_rolm by auto. exact EQ.
+  + intros; Simpl.
 Qed.
 
 (** Add int64 immediate. *)
@@ -889,7 +982,7 @@ Lemma transl_cond_correct_1:
        (if snd (crbit_for_cond cond)
         then Val.of_optbool (eval_condition cond (map rs (map preg_of args)) m)
         else Val.notbool (Val.of_optbool (eval_condition cond (map rs (map preg_of args)) m)))
-  /\ forall r, important_preg r = true  -> preg_notin r (destroyed_by_cond cond) ->  rs'#r = rs#r.
+  /\ forall r, important_preg r = true -> rs'#r = rs#r.
 Proof.
   intros.
 Opaque Int.eq.
@@ -991,20 +1084,12 @@ Opaque Int.eq.
   auto with asmgen.
 - (* Ccomplimm *)
   rewrite <- Val.notbool_negb_3. rewrite <- Val.negate_cmpl_bool.
-  destruct (Int64.eq i (low64_s i)); [|destruct (ireg_eq x GPR12)]; inv EQ0.
+  destruct (Int64.eq i (low64_s i)); inv EQ0.
 + destruct (compare_slong_spec rs (rs x) (Vlong i)) as [A [B [C D]]].
   econstructor; split.
   apply exec_straight_one. simpl; reflexivity. reflexivity.
   split. case c0; simpl; auto. auto with asmgen.
-+ destruct (loadimm64_correct GPR12 i (Pcmpd GPR0 GPR12 :: k) (nextinstr (rs#GPR0 <- (rs#GPR12))) m) as [rs1 [EX1 [RES1 OTH1]]].
-  destruct (compare_slong_spec rs1 (rs GPR12) (Vlong i)) as [A [B [C D]]].
-  assert (SAME: rs1 GPR0 = rs GPR12) by (apply OTH1; eauto with asmgen).
-  econstructor; split.
-  eapply exec_straight_step. simpl;reflexivity. reflexivity.
-  eapply exec_straight_trans. eexact EX1. eapply exec_straight_one. simpl;reflexivity. reflexivity.
-  split. rewrite RES1, SAME. destruct c0; simpl; auto.
-  simpl; intros. rewrite RES1, SAME. rewrite D by eauto with asmgen. rewrite OTH1 by eauto with asmgen. Simpl.
-+ destruct (loadimm64_correct GPR0 i (Pcmpd x GPR0 :: k) rs m) as [rs1 [EX1 [RES1 OTH1]]].
++ destruct (loadimm64_notemp_correct GPR0 i (Pcmpd x GPR0 :: k) rs m) as [rs1 [EX1 [RES1 OTH1]]].
   destruct (compare_slong_spec rs1 (rs x) (Vlong i)) as [A [B [C D]]].
   assert (SAME: rs1 x = rs x) by (apply OTH1; eauto with asmgen).
   econstructor; split.
@@ -1013,20 +1098,12 @@ Opaque Int.eq.
   simpl; intros. rewrite RES1, SAME. rewrite D; eauto with asmgen.
 - (* Ccompluimm *)
   rewrite <- Val.notbool_negb_3. rewrite <- Val.negate_cmplu_bool.
-  destruct (Int64.eq i (low64_u i)); [|destruct (ireg_eq x GPR12)]; inv EQ0.
+  destruct (Int64.eq i (low64_u i)); inv EQ0.
 + destruct (compare_ulong_spec rs m (rs x) (Vlong i)) as [A [B [C D]]].
   econstructor; split.
   apply exec_straight_one. simpl; reflexivity. reflexivity.
   split. case c0; simpl; auto. auto with asmgen.
-+ destruct (loadimm64_correct GPR12 i (Pcmpld GPR0 GPR12 :: k) (nextinstr (rs#GPR0 <- (rs#GPR12))) m) as [rs1 [EX1 [RES1 OTH1]]].
-  destruct (compare_ulong_spec rs1 m (rs GPR12) (Vlong i)) as [A [B [C D]]].
-  assert (SAME: rs1 GPR0 = rs GPR12) by (apply OTH1; eauto with asmgen).
-  econstructor; split.
-  eapply exec_straight_step. simpl;reflexivity. reflexivity.
-  eapply exec_straight_trans. eexact EX1. eapply exec_straight_one. simpl;reflexivity. reflexivity.
-  split. rewrite RES1, SAME. destruct c0; simpl; auto.
-  simpl; intros. rewrite RES1, SAME. rewrite D by eauto with asmgen. rewrite OTH1 by eauto with asmgen. Simpl.
-+ destruct (loadimm64_correct GPR0 i (Pcmpld x GPR0 :: k) rs m) as [rs1 [EX1 [RES1 OTH1]]].
++ destruct (loadimm64_notemp_correct GPR0 i (Pcmpld x GPR0 :: k) rs m) as [rs1 [EX1 [RES1 OTH1]]].
   destruct (compare_ulong_spec rs1 m (rs x) (Vlong i)) as [A [B [C D]]].
   assert (SAME: rs1 x = rs x) by (apply OTH1; eauto with asmgen).
   econstructor; split.
@@ -1045,7 +1122,7 @@ Lemma transl_cond_correct_2:
        (if snd (crbit_for_cond cond)
         then Val.of_bool b
         else Val.notbool (Val.of_bool b))
-  /\ forall r, important_preg r = true -> preg_notin r (destroyed_by_cond cond)  -> rs'#r = rs#r.
+  /\ forall r, important_preg r = true -> rs'#r = rs#r.
 Proof.
   intros.
   replace (Val.of_bool b)
@@ -1072,7 +1149,8 @@ Proof.
   exploit transl_cond_correct_2. eauto.
     eapply eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto.
   intros [rs' [A [B C]]].
-  exists rs'; split. eauto. split. auto. apply agree_undef_regs with rs; auto. intros r D.
+  exists rs'; split. eauto. split. auto.
+  apply agree_undef_regs with rs; auto. intros r D E.
   apply C. apply important_data_preg_1; auto.
 Qed.
 
@@ -1180,6 +1258,66 @@ Proof.
   intuition Simpl.
   rewrite RES1. destruct (eval_condition c rs ## (preg_of ## rl) m). destruct b; auto. auto.
 Qed.
+  
+Lemma transl_select_op_correct:
+  forall cond args ty r1 r2 rd k rs m c,
+  transl_select_op cond args r1 r2 rd k = OK c ->
+  important_preg rd = true -> important_preg r1 = true -> important_preg r2 = true ->
+  exists rs',
+  exec_straight ge fn c rs m k rs' m
+  /\ Val.lessdef (Val.select (eval_condition cond (map rs (map preg_of args)) m) rs#r1 rs#r2 ty) rs'#rd
+  /\ forall r, important_preg r = true  -> r <> rd -> rs'#r = rs#r.
+Proof.
+  intros until c.  intros TR IMP1 IMP2 IMP3.
+  unfold transl_select_op in TR.
+  destruct (ireg_eq r1 r2).
+  - inv TR. econstructor; split; [|split].
+    + apply exec_straight_one. simpl; eauto. auto.
+    + Simpl. destruct (eval_condition cond rs ## (preg_of ## args) m) as [[]|]; simpl; auto using Val.lessdef_normalize.
+    + intros; Simpl.
+  - destruct (transl_cond_correct_1 cond args _ rs m _ TR) as (rs1 & A & B & C).
+    set (bit := fst (crbit_for_cond cond)) in *.
+    set (dir := snd (crbit_for_cond cond)) in *.
+    set (ob := eval_condition cond rs##(preg_of##args) m) in *.
+    econstructor; split; [|split].
+    + eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto.
+      reflexivity.
+    + Simpl.
+      rewrite <- (C r1), <- (C r2) by auto.
+      rewrite B, gpr_or_zero_not_zero.
+      destruct dir; destruct ob as [[]|]; simpl; auto using Val.lessdef_normalize.
+      destruct dir; intros e; subst; discriminate.
+    + intros. Simpl.
+Qed.
+
+Lemma transl_fselect_op_correct:
+  forall cond args ty r1 r2 rd k rs m c,
+  transl_fselect_op cond args r1 r2 rd k = OK c ->
+  important_preg rd = true -> important_preg r1 = true -> important_preg r2 = true ->
+  exists rs',
+  exec_straight ge fn c rs m k rs' m
+  /\ Val.lessdef (Val.select (eval_condition cond (map rs (map preg_of args)) m) rs#r1 rs#r2 ty) rs'#rd
+  /\ forall r, important_preg r = true  -> r <> rd -> rs'#r = rs#r.
+Proof.
+  intros until c.  intros TR IMP1 IMP2 IMP3.
+  unfold transl_fselect_op in TR.
+  destruct (freg_eq r1 r2).
+  - inv TR. econstructor; split; [|split].
+    + apply exec_straight_one. simpl; eauto. auto.
+    + Simpl. destruct (eval_condition cond rs ## (preg_of ## args) m) as [[]|]; simpl; auto using Val.lessdef_normalize.
+    + intros; Simpl.
+  - destruct (transl_cond_correct_1 cond args _ rs m _ TR) as (rs1 & A & B & C).
+    set (bit := fst (crbit_for_cond cond)) in *.
+    set (dir := snd (crbit_for_cond cond)) in *.
+    set (ob := eval_condition cond rs##(preg_of##args) m) in *.
+    econstructor; split; [|split].
+    + eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto.
+      reflexivity.
+    + Simpl.
+      rewrite <- (C r1), <- (C r2) by auto.
+      rewrite B. destruct dir; destruct ob as [[]|]; simpl; auto using Val.lessdef_normalize.
+    + intros. Simpl.
+Qed.
 
 (** Translation of arithmetic operations. *)
 
@@ -1377,6 +1515,18 @@ Opaque Val.add.
   (* Ocmp *)
 - destruct (transl_cond_op_correct c0 args res k rs m c) as [rs' [A [B C]]]; auto.
   exists rs'; auto with asmgen.
+  (* Osel *)
+- assert (X: forall mr r, ireg_of mr = OK r -> important_preg r = true).
+  { intros. apply ireg_of_eq in H0. apply important_data_preg_1. rewrite <- H0.
+    auto with asmgen. }
+  assert (Y: forall mr r, freg_of mr = OK r -> important_preg r = true).
+  { intros. apply freg_of_eq in H0. apply important_data_preg_1. rewrite <- H0.
+    auto with asmgen. }
+  destruct (preg_of res) eqn:RES; monadInv H; rewrite <- RES.
+  + rewrite (ireg_of_eq _ _ EQ), (ireg_of_eq _ _ EQ0), (ireg_of_eq _ _ EQ1) in *.
+    destruct (transl_select_op_correct _ _ t _ _ _ _ rs m _ EQ3) as (rs' & A & B & C); eauto.
+  + rewrite (freg_of_eq _ _ EQ), (freg_of_eq _ _ EQ0), (freg_of_eq _ _ EQ1) in *.
+  destruct (transl_fselect_op_correct _ _ t _ _ _ _ rs m _ EQ3) as (rs' & A & B & C); eauto.
 Qed.
 
 Lemma transl_op_correct:
diff --git a/powerpc/Builtins1.v b/powerpc/Builtins1.v
new file mode 100644
index 00000000..53c83d7e
--- /dev/null
+++ b/powerpc/Builtins1.v
@@ -0,0 +1,33 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Platform-specific built-in functions *)
+
+Require Import String Coqlib.
+Require Import AST Integers Floats Values.
+Require Import Builtins0.
+
+Inductive platform_builtin : Type := .
+
+Local Open Scope string_scope.
+
+Definition platform_builtin_table : list (string * platform_builtin) :=
+  nil.
+
+Definition platform_builtin_sig (b: platform_builtin) : signature :=
+  match b with end.
+
+Definition platform_builtin_sem (b: platform_builtin) : builtin_sem (sig_res (platform_builtin_sig b)) :=
+  match b with end.
diff --git a/powerpc/CBuiltins.ml b/powerpc/CBuiltins.ml
index 11b7aef9..e29a41f1 100644
--- a/powerpc/CBuiltins.ml
+++ b/powerpc/CBuiltins.ml
@@ -18,11 +18,11 @@
 open C
 
 let builtins = {
-  Builtins.typedefs = [
+  builtin_typedefs = [
     "__builtin_va_list",
     TArray(TInt(IUInt, []), Some 3L, [])
   ];
-  Builtins.functions = [
+  builtin_functions = [
     (* Integer arithmetic *)
     "__builtin_mulhw",
       (TInt(IInt, []), [TInt(IInt, []); TInt(IInt, [])], false);
diff --git a/powerpc/ConstpropOp.vp b/powerpc/ConstpropOp.vp
index 2d492b66..8e90a849 100644
--- a/powerpc/ConstpropOp.vp
+++ b/powerpc/ConstpropOp.vp
@@ -16,13 +16,14 @@
 Require Import Coqlib Compopts.
 Require Import AST Integers Floats.
 Require Import Op Registers.
-Require Import ValueDomain.
+Require Import ValueDomain ValueAOp.
 
 (** * Converting known values to constants *)
 
 Definition const_for_result (a: aval) : option operation :=
   match a with
   | I n => Some(Ointconst n)
+  | L n => if Archi.ppc64 then Some (Olongconst n) else None
   | F n => if Compopts.generate_float_constants tt then Some(Ofloatconst n) else None
   | FS n => if Compopts.generate_float_constants tt then Some(Osingleconst n) else None
   | Ptr(Gl id ofs) => Some (Oaddrsymbol id ofs)
@@ -95,6 +96,15 @@ Nondetfunction make_cmp (c: condition) (args: list reg) (vl: list aval) :=
       make_cmp_base c args vl
   end.
 
+Definition make_select (c: condition) (ty: typ)
+                       (r1 r2: reg) (args: list reg) (vl: list aval) :=
+  match resolve_branch (eval_static_condition c vl) with
+  | Some b => (Omove, (if b then r1 else r2) :: nil)
+  | None =>
+      let (c', args') := cond_strength_reduction c args vl in
+      (Osel c' ty, r1 :: r2 :: args')
+  end.
+
 Definition make_addimm (n: int) (r: reg) :=
   if Int.eq n Int.zero
   then (Omove, r :: nil)
@@ -303,6 +313,7 @@ Nondetfunction op_strength_reduction
   | Oshrl, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shrlimm n2 r1 r2
   | Oshrlu, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shrluimm n2 r1 r2
   | Ocmp c, args, vl => make_cmp c args vl
+  | Osel c ty, r1 :: r2 :: args, v1 :: v2 :: vl => make_select c ty r1 r2 args vl
   | Omulf, r1 :: r2 :: nil, v1 :: F n2 :: nil => make_mulfimm n2 r1 r1 r2
   | Omulf, r1 :: r2 :: nil, F n1 :: v2 :: nil => make_mulfimm n1 r2 r1 r2
   | Omulfs, r1 :: r2 :: nil, v1 :: FS n2 :: nil => make_mulfsimm n2 r1 r1 r2
diff --git a/powerpc/ConstpropOpproof.v b/powerpc/ConstpropOpproof.v
index fe061e5b..8687b056 100644
--- a/powerpc/ConstpropOpproof.v
+++ b/powerpc/ConstpropOpproof.v
@@ -14,7 +14,7 @@
 
 Require Import Coqlib Compopts.
 Require Import Integers Floats Values Memory Globalenvs Events.
-Require Import Op Registers RTL ValueDomain.
+Require Import Op Registers RTL ValueDomain ValueAOp ValueAnalysis.
 Require Import ConstpropOp.
 
 Local Transparent Archi.ptr64.
@@ -101,6 +101,8 @@ Proof.
   destruct a; inv H; SimplVM.
 - (* integer *)
   exists (Vint n); auto.
+- (* long *)
+  destruct (Archi.ppc64); inv H2. exists (Vlong n); auto.
 - (* float *)
   destruct (generate_float_constants tt); inv H2. exists (Vfloat f); auto.
 - (* single *)
@@ -211,6 +213,28 @@ Proof.
 - apply make_cmp_base_correct; auto.
 Qed.
 
+Lemma make_select_correct:
+  forall c ty r1 r2 args vl,
+  vl = map (fun r => AE.get r ae) args ->
+  let (op', args') := make_select c ty r1 r2 args vl in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op' rs##args' m = Some v
+         /\ Val.lessdef (Val.select (eval_condition c rs##args m) rs#r1 rs#r2 ty) v.
+Proof.
+  unfold make_select; intros.
+  destruct (resolve_branch (eval_static_condition c vl)) as [b|] eqn:RB.
+- exists (if b then rs#r1 else rs#r2); split.
++ simpl. destruct b; auto.
++ destruct (eval_condition c rs##args m) as [b'|] eqn:EC; simpl; auto.
+  assert (b = b').
+  { eapply resolve_branch_sound; eauto. 
+    rewrite <- EC. apply eval_static_condition_sound with bc. 
+    subst vl. exact (aregs_sound _ _ _ args MATCH). }
+  subst b'. apply Val.lessdef_normalize.
+- generalize (cond_strength_reduction_correct c args vl H).
+  destruct (cond_strength_reduction c args vl) as [cond' args']; intros EQ.
+  econstructor; split. simpl; eauto. rewrite EQ; auto.
+Qed.
+
 Lemma make_addimm_correct:
   forall n r,
   let (op, args) := make_addimm n r in
@@ -715,6 +739,8 @@ Proof.
   InvApproxRegs; SimplVM; inv H0. apply make_shrluimm_correct; auto.
 (* cmp *)
   inv H0. apply make_cmp_correct; auto.
+(* select *)
+  inv H0. apply make_select_correct; congruence.
 (* mulf *)
   InvApproxRegs; SimplVM; inv H0. rewrite <- H2. apply make_mulfimm_correct; auto.
   InvApproxRegs; SimplVM; inv H0. fold (Val.mulf (Vfloat n1) rs#r2).
diff --git a/powerpc/Conventions1.v b/powerpc/Conventions1.v
index 1de55c1a..5c9cbd4f 100644
--- a/powerpc/Conventions1.v
+++ b/powerpc/Conventions1.v
@@ -117,18 +117,16 @@ Definition dummy_float_reg := F0.   (**r Used in [Coloring]. *)
   We treat a function without result as a function with one integer result. *)
 
 Definition loc_result_32 (s: signature) : rpair mreg :=
-  match s.(sig_res) with
-  | None => One R3
-  | Some (Tint | Tany32) => One R3
-  | Some (Tfloat | Tsingle | Tany64) => One F1
-  | Some Tlong => Twolong R3 R4
+  match proj_sig_res s with
+  | Tint | Tany32 => One R3
+  | Tfloat | Tsingle | Tany64 => One F1
+  | Tlong => Twolong R3 R4
   end.
 
 Definition loc_result_64 (s: signature) : rpair mreg :=
-  match s.(sig_res) with
-  | None => One R3
-  | Some (Tint | Tlong | Tany32 | Tany64) => One R3
-  | Some (Tfloat | Tsingle) => One F1
+  match proj_sig_res s with
+  | Tint | Tlong | Tany32 | Tany64 => One R3
+  | Tfloat | Tsingle => One F1
   end.
 
 Definition loc_result :=
@@ -140,8 +138,8 @@ Lemma loc_result_type:
   forall sig,
   subtype (proj_sig_res sig) (typ_rpair mreg_type (loc_result sig)) = true.
 Proof.
-  intros. unfold proj_sig_res, loc_result, loc_result_32, loc_result_64, mreg_type.
-  destruct Archi.ptr64 eqn:?; destruct (sig_res sig) as [[]|]; destruct Archi.ppc64; simpl; auto.
+  intros. unfold loc_result, loc_result_32, loc_result_64, mreg_type.
+  destruct Archi.ptr64 eqn:?; destruct (proj_sig_res sig); destruct Archi.ppc64; simpl; auto.
 Qed.
 
 (** The result locations are caller-save registers *)
@@ -151,7 +149,7 @@ Lemma loc_result_caller_save:
   forall_rpair (fun r => is_callee_save r = false) (loc_result s).
 Proof.
   intros. unfold loc_result, loc_result_32, loc_result_64, is_callee_save;
-  destruct Archi.ptr64; destruct (sig_res s) as [[]|]; simpl; auto.
+  destruct Archi.ptr64; destruct (proj_sig_res s); simpl; auto.
 Qed.
 
 (** If the result is in a pair of registers, those registers are distinct and have type [Tint] at least. *)
@@ -161,13 +159,13 @@ Lemma loc_result_pair:
   match loc_result sg with
   | One _ => True
   | Twolong r1 r2 =>
-        r1 <> r2 /\ sg.(sig_res) = Some Tlong
+        r1 <> r2 /\ proj_sig_res sg = Tlong
      /\ subtype Tint (mreg_type r1) = true /\ subtype Tint (mreg_type r2) = true
      /\ Archi.ptr64 = false
   end.
 Proof.
   intros; unfold loc_result, loc_result_32, loc_result_64, mreg_type;
-  destruct Archi.ptr64; destruct (sig_res sg) as [[]|]; destruct Archi.ppc64; simpl; auto.
+  destruct Archi.ptr64; destruct (proj_sig_res sg); destruct Archi.ppc64; simpl; auto.
   split; auto. congruence.
   split; auto. congruence.
 Qed.
@@ -177,7 +175,7 @@ Qed.
 Lemma loc_result_exten:
   forall s1 s2, s1.(sig_res) = s2.(sig_res) -> loc_result s1 = loc_result s2.
 Proof.
-  intros. unfold loc_result, loc_result_32, loc_result_64.
+  intros. unfold loc_result, loc_result_32, loc_result_64, proj_sig_res.
   destruct Archi.ptr64; rewrite H; auto.
 Qed.
 
@@ -210,7 +208,16 @@ Fixpoint loc_arguments_rec
       | Some ireg =>
           One (R ireg) :: loc_arguments_rec tys (ir + 1) fr ofs
       end
-  | (Tfloat | Tsingle | Tany64) as ty :: tys =>
+  | Tsingle as ty :: tys =>
+      match list_nth_z float_param_regs fr with
+      | None =>
+          let ty := if Archi.single_passed_as_single then Tsingle else Tany64 in
+          let ofs := align ofs (typesize ty) in
+          One (S Outgoing ofs ty) :: loc_arguments_rec tys ir fr (ofs + (typesize ty))
+      | Some freg =>
+          One (R freg) :: loc_arguments_rec tys ir (fr + 1) ofs
+      end
+  | (Tfloat | Tany64) as ty :: tys =>
       match list_nth_z float_param_regs fr with
       | None =>
           let ofs := align ofs 2 in
@@ -238,33 +245,6 @@ Fixpoint loc_arguments_rec
 Definition loc_arguments (s: signature) : list (rpair loc) :=
   loc_arguments_rec s.(sig_args) 0 0 0.
 
-(** [size_arguments s] returns the number of [Outgoing] slots used
-  to call a function with signature [s]. *)
-
-Fixpoint size_arguments_rec (tyl: list typ) (ir fr ofs: Z) {struct tyl} : Z :=
-  match tyl with
-  | nil => ofs
-  | (Tint | Tany32) :: tys =>
-      match list_nth_z int_param_regs ir with
-      | None => size_arguments_rec tys ir fr (ofs + 1)
-      | Some ireg => size_arguments_rec tys (ir + 1) fr ofs
-      end
-  | (Tfloat | Tsingle | Tany64) :: tys =>
-      match list_nth_z float_param_regs fr with
-      | None => size_arguments_rec tys ir fr (align ofs 2 + 2)
-      | Some freg => size_arguments_rec tys ir (fr + 1) ofs
-      end
-  | Tlong :: tys =>
-      let ir := align ir 2 in
-      match list_nth_z int_param_regs ir, list_nth_z int_param_regs (ir + 1) with
-      | Some r1, Some r2 => size_arguments_rec tys (ir + 2) fr ofs
-      | _, _ => size_arguments_rec tys ir fr (align ofs 2 + 2)
-      end
-  end.
-
-Definition size_arguments (s: signature) : Z :=
-  size_arguments_rec s.(sig_args) 0 0 0.
-
 (** Argument locations are either caller-save registers or [Outgoing]
   stack slots at nonnegative offsets. *)
 
@@ -324,12 +304,14 @@ Opaque list_nth_z.
   apply align_divides; omega. apply Z.divide_1_l. apply Z.divide_1_l.
   eapply Y; eauto. omega.
 - (* single *)
+  assert (ofs <= align ofs 1) by (apply align_le; omega).
   assert (ofs <= align ofs 2) by (apply align_le; omega).
   destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H.
   subst. right. eapply list_nth_z_in; eauto.
   eapply IHtyl; eauto.
-  subst. split. omega. apply Z.divide_1_l.
-  eapply Y; eauto. omega.
+  subst. split. destruct Archi.single_passed_as_single; simpl; omega.
+  destruct Archi.single_passed_as_single; simpl; apply Z.divide_1_l.
+  eapply Y; eauto. destruct Archi.single_passed_as_single; simpl; omega.
 - (* any32 *)
   destruct (list_nth_z int_param_regs ir) as [r|] eqn:E; destruct H.
   subst. left. eapply list_nth_z_in; eauto.
@@ -361,107 +343,14 @@ Qed.
 
 Hint Resolve loc_arguments_acceptable: locs.
 
-(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)
-
-Remark size_arguments_rec_above:
-  forall tyl ir fr ofs0,
-  ofs0 <= size_arguments_rec tyl ir fr ofs0.
-Proof.
-  induction tyl; simpl; intros.
-  omega.
-  destruct a.
-  destruct (list_nth_z int_param_regs ir); eauto. apply Z.le_trans with (ofs0 + 1); auto; omega.
-  destruct (list_nth_z float_param_regs fr); eauto.
-  apply Z.le_trans with (align ofs0 2). apply align_le; omega.
-  apply Z.le_trans with (align ofs0 2 + 2); auto; omega.
-  set (ir' := align ir 2).
-  destruct (list_nth_z int_param_regs ir'); eauto.
-  destruct (list_nth_z int_param_regs (ir' + 1)); eauto.
-  apply Z.le_trans with (align ofs0 2). apply align_le; omega.
-  apply Z.le_trans with (align ofs0 2 + 2); auto; omega.
-  apply Z.le_trans with (align ofs0 2). apply align_le; omega.
-  apply Z.le_trans with (align ofs0 2 + 2); auto; omega.
-  destruct (list_nth_z float_param_regs fr); eauto.
-  apply Z.le_trans with (align ofs0 2). apply align_le; omega.
-  apply Z.le_trans with (align ofs0 2 + 2); auto; omega.
-  destruct (list_nth_z int_param_regs ir); eauto. apply Z.le_trans with (ofs0 + 1); auto; omega.
-  destruct (list_nth_z float_param_regs fr); eauto.
-  apply Z.le_trans with (align ofs0 2). apply align_le; omega.
-  apply Z.le_trans with (align ofs0 2 + 2); auto; omega.
-Qed.
-
-Lemma size_arguments_above:
-  forall s, size_arguments s >= 0.
-Proof.
-  intros; unfold size_arguments. apply Z.le_ge.
-  apply size_arguments_rec_above.
-Qed.
-
-Lemma loc_arguments_bounded:
-  forall (s: signature) (ofs: Z) (ty: typ),
-  In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments s)) ->
-  ofs + typesize ty <= size_arguments s.
-Proof.
-  intros.
-  assert (forall tyl ir fr ofs0,
-    In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments_rec tyl ir fr ofs0)) ->
-    ofs + typesize ty <= size_arguments_rec tyl ir fr ofs0).
-{
-  induction tyl; simpl; intros.
-  elim H0.
-  destruct a.
-- (* int *)
-  destruct (list_nth_z int_param_regs ir); destruct H0.
-  congruence.
-  eauto.
-  inv H0. apply size_arguments_rec_above.
-  eauto.
-- (* float *)
-  destruct (list_nth_z float_param_regs fr); destruct H0.
-  congruence.
-  eauto.
-  inv H0. apply size_arguments_rec_above. eauto.
-- (* long *)
-  set (ir' := align ir 2) in *.
-  assert (DFL:
-    In (S Outgoing ofs ty) (regs_of_rpairs
-                             ((if Archi.ptr64
-                               then One (S Outgoing (align ofs0 2) Tlong)
-                               else Twolong (S Outgoing (align ofs0 2) Tint)
-                                            (S Outgoing (align ofs0 2 + 1) Tint))
-                          :: loc_arguments_rec tyl ir' fr (align ofs0 2 + 2))) ->
-    ofs + typesize ty <= size_arguments_rec tyl ir' fr (align ofs0 2 + 2)).
-  { destruct Archi.ptr64; intros IN.
-  - destruct IN. inv H1. apply size_arguments_rec_above. auto.
-  - destruct IN. inv H1. transitivity (align ofs0 2 + 2). simpl; omega. apply size_arguments_rec_above.
-    destruct H1. inv H1. transitivity (align ofs0 2 + 2). simpl; omega. apply size_arguments_rec_above.
-    auto. }
-  destruct (list_nth_z int_param_regs ir'); auto.
-  destruct (list_nth_z int_param_regs (ir' + 1)); auto.
-  destruct H0. congruence. destruct H0. congruence. eauto.
-- (* single *)
-  destruct (list_nth_z float_param_regs fr); destruct H0.
-  congruence.
-  eauto.
-  inv H0. transitivity (align ofs0 2 + 2). simpl; omega. apply size_arguments_rec_above.
-  eauto.
-- (* any32 *)
-  destruct (list_nth_z int_param_regs ir); destruct H0.
-  congruence.
-  eauto.
-  inv H0. apply size_arguments_rec_above.
-  eauto.
-- (* any64 *)
-  destruct (list_nth_z float_param_regs fr); destruct H0.
-  congruence.
-  eauto.
-  inv H0. apply size_arguments_rec_above. eauto.
-  }
-  eauto.
-Qed.
-
 Lemma loc_arguments_main:
   loc_arguments signature_main = nil.
 Proof.
   reflexivity.
 Qed.
+
+(** ** Normalization of function results *)
+
+(** No normalization needed. *)
+
+Definition return_value_needs_normalization (t: rettype) := false.
diff --git a/powerpc/Machregs.v b/powerpc/Machregs.v
index 53d99e2f..e7c8758b 100644
--- a/powerpc/Machregs.v
+++ b/powerpc/Machregs.v
@@ -159,11 +159,7 @@ Definition register_by_name (s: string) : option mreg :=
 
 (** ** Destroyed registers, preferred registers *)
 
-Definition destroyed_by_cond (cond: condition): list mreg :=
-  match cond with
-  | Ccomplimm _ _ | Ccompluimm _ _ => R12 :: nil
-  | _ => nil
-  end.
+Definition destroyed_by_cond (cond: condition): list mreg := nil.
 
 Definition destroyed_by_op (op: operation): list mreg :=
   match op with
diff --git a/powerpc/NeedOp.v b/powerpc/NeedOp.v
index 9a579cc5..5ea09bd8 100644
--- a/powerpc/NeedOp.v
+++ b/powerpc/NeedOp.v
@@ -65,6 +65,7 @@ Definition needs_of_operation (op: operation) (nv: nval): list nval :=
   | Ofloatofwords | Omakelong => op2 (default nv)
   | Olowlong | Ohighlong => op1 (default nv)
   | Ocmp c => needs_of_condition c
+  | Osel c ty => nv :: nv :: needs_of_condition c
   end.
 
 Definition operation_is_redundant (op: operation) (nv: nval): bool :=
@@ -147,6 +148,10 @@ Proof.
   erewrite needs_of_condition_sound by eauto.
   subst v; simpl. auto with na.
   subst v; auto with na.
+- destruct (eval_condition c args m) as [b|] eqn:EC.
+  erewrite needs_of_condition_sound by eauto.
+  apply select_sound; auto.
+  simpl; auto with na.
 Qed.
 
 Lemma operation_is_redundant_sound:
diff --git a/powerpc/Op.v b/powerpc/Op.v
index e6f942c1..0f082c1f 100644
--- a/powerpc/Op.v
+++ b/powerpc/Op.v
@@ -150,8 +150,9 @@ Inductive operation : Type :=
   | Olowlong: operation                 (**r [rd = low-word(r1)] *)
   | Ohighlong: operation                (**r [rd = high-word(r1)] *)
 (*c Boolean tests: *)
-  | Ocmp: condition -> operation.       (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
-
+  | Ocmp: condition -> operation        (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
+  | Osel: condition -> typ -> operation.
+                                        (**r [rd = rs1] if condition holds, [rd = rs2] otherwise. *)
 
 (** Addressing modes.  [r1], [r2], etc, are the arguments to the
   addressing. *)
@@ -173,7 +174,7 @@ Proof.
 Defined.
 
 Definition beq_operation: forall (x y: operation), bool.
-  generalize Int.eq_dec Int64.eq_dec Ptrofs.eq_dec ident_eq Float.eq_dec Float32.eq_dec  eq_condition; boolean_equality.
+  generalize Int.eq_dec Int64.eq_dec Ptrofs.eq_dec ident_eq Float.eq_dec Float32.eq_dec typ_eq eq_condition; boolean_equality.
 Defined.
 
 Definition eq_operation (x y: operation): {x=y} + {x<>y}.
@@ -306,6 +307,7 @@ Definition eval_operation
   | Olowlong, v1::nil => Some(Val.loword v1)
   | Ohighlong, v1::nil => Some(Val.hiword v1)
   | Ocmp c, _ => Some(Val.of_optbool (eval_condition c vl m))
+  | Osel c ty, v1::v2::vl => Some(Val.select (eval_condition c vl m) v1 v2 ty)
   | _, _ => None
   end.
 
@@ -455,6 +457,7 @@ Definition type_of_operation (op: operation) : list typ * typ :=
   | Olowlong => (Tlong :: nil, Tint)
   | Ohighlong => (Tlong :: nil, Tint)
   | Ocmp c => (type_of_condition c, Tint)
+  | Osel c ty => (ty :: ty :: type_of_condition c, ty)
   end.
 
 Definition type_of_addressing (addr: addressing) : list typ :=
@@ -575,6 +578,7 @@ Proof with (try exact I; try reflexivity).
   destruct v0...
   destruct v0...
   destruct (eval_condition c vl m); simpl... destruct b...
+  unfold Val.select. destruct (eval_condition c vl m). apply Val.normalize_type. exact I.
 Qed.
 
 End SOUNDNESS.
@@ -727,22 +731,40 @@ Definition is_trivial_op (op: operation) : bool :=
 
 (** Operations that depend on the memory state. *)
 
+Definition condition_depends_on_memory (c: condition) : bool :=
+  match c with
+  | Ccompu _ => true
+  | Ccompuimm _ _ => true
+  | Ccomplu _ => Archi.ppc64
+  | Ccompluimm _ _ => Archi.ppc64
+  | _ => false
+  end.
+
 Definition op_depends_on_memory (op: operation) : bool :=
   match op with
-  | Ocmp (Ccompu _) => true
-  | Ocmp (Ccompuimm _ _) => true
-  | Ocmp (Ccomplu _) => Archi.ppc64
-  | Ocmp (Ccompluimm _ _) => Archi.ppc64
+  | Ocmp c => condition_depends_on_memory c
+  | Osel c ty => condition_depends_on_memory c
   | _ => false
   end.
 
+Lemma condition_depends_on_memory_correct:
+  forall c args m1 m2,
+  condition_depends_on_memory c = false ->
+  eval_condition c args m1 = eval_condition c args m2.
+Proof.
+  intros. destruct c; simpl; auto; discriminate.
+Qed.
+
 Lemma op_depends_on_memory_correct:
   forall (F V: Type) (ge: Genv.t F V) sp op args m1 m2,
   op_depends_on_memory op = false ->
   eval_operation ge sp op args m1 = eval_operation ge sp op args m2.
 Proof.
-  intros until m2. destruct op; simpl; try congruence. unfold eval_condition.
-  destruct c; simpl; auto; try discriminate.
+  intros until m2. destruct op; simpl; try congruence; intros C.
+- f_equal; f_equal; apply condition_depends_on_memory_correct; auto.
+- destruct args; auto. destruct args; auto.
+  rewrite (condition_depends_on_memory_correct c args m1 m2 C).
+  auto.
 Qed.
 
 (** Global variables mentioned in an operation or addressing mode *)
@@ -989,6 +1011,9 @@ Proof.
   exploit eval_condition_inj; eauto. intros EQ; rewrite EQ.
   destruct b; simpl; constructor.
   simpl; constructor.
+  apply Val.select_inject; auto.  
+  destruct (eval_condition c vl1 m1) eqn:?; auto.
+  right; symmetry; eapply eval_condition_inj; eauto.
 Qed.
 
 Lemma eval_addressing_inj:
diff --git a/powerpc/PrintOp.ml b/powerpc/PrintOp.ml
index cffaafdb..8d7f17ab 100644
--- a/powerpc/PrintOp.ml
+++ b/powerpc/PrintOp.ml
@@ -110,6 +110,10 @@ let print_operation reg pp = function
   | Olowlong, [r1] -> fprintf pp "lowlong(%a)" reg r1
   | Ohighlong, [r1] -> fprintf pp "highlong(%a)" reg r1
   | Ocmp c, args -> print_condition reg pp (c, args)
+  | Osel (c, ty), r1::r2::args ->
+      fprintf pp "%a ?%s %a : %a"
+         (print_condition reg) (c, args)
+         (PrintAST.name_of_type ty) reg r1 reg r2
   | Olongconst n, [] -> fprintf pp "%LdL" (camlint64_of_coqint n)
   | Ocast32signed, [r1] -> fprintf pp "int32signed(%a)" reg r1
   | Ocast32unsigned, [r1] -> fprintf pp "int32unsigned(%a)" reg r1
diff --git a/powerpc/SelectLongproof.v b/powerpc/SelectLongproof.v
index a214d131..f16c967e 100644
--- a/powerpc/SelectLongproof.v
+++ b/powerpc/SelectLongproof.v
@@ -12,7 +12,7 @@
 
 (** Correctness of instruction selection for 64-bit integer operations *)
 
-Require Import String Coqlib Maps Integers Floats Errors.
+Require Import String Coqlib Maps Zbits Integers Floats Errors.
 Require Archi.
 Require Import AST Values Memory Globalenvs Events.
 Require Import Cminor Op CminorSel.
@@ -221,11 +221,11 @@ Proof.
   change (Int64.unsigned Int64.iwordsize) with 64.
   f_equal.
   rewrite Int.unsigned_repr. 
-  apply Int.eqmod_mod_eq. omega. 
-  apply Int.eqmod_trans with a.
-  apply Int.eqmod_divides with Int.modulus. apply Int.eqm_sym. apply Int.eqm_unsigned_repr.
+  apply eqmod_mod_eq. omega. 
+  apply eqmod_trans with a.
+  apply eqmod_divides with Int.modulus. apply Int.eqm_sym. apply Int.eqm_unsigned_repr.
   exists (two_p (32-6)); auto.
-  apply Int.eqmod_divides with Int64.modulus. apply Int64.eqm_unsigned_repr.
+  apply eqmod_divides with Int64.modulus. apply Int64.eqm_unsigned_repr.
   exists (two_p (64-6)); auto.
   assert (0 <= Int.unsigned (Int.repr a) mod 64 < 64) by (apply Z_mod_lt; omega).
   assert (64 < Int.max_unsigned) by (compute; auto).
diff --git a/powerpc/SelectOp.vp b/powerpc/SelectOp.vp
index d2ca408a..ba6612e8 100644
--- a/powerpc/SelectOp.vp
+++ b/powerpc/SelectOp.vp
@@ -38,11 +38,9 @@
 
 Require Import Coqlib.
 Require Import Compopts.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Op.
-Require Import CminorSel.
+Require Import AST Integers Floats Builtins.
+Require Import Op CminorSel.
+Require Archi.
 
 Local Open Scope cminorsel_scope.
 
@@ -516,6 +514,19 @@ Definition singleofintu (e: expr) :=
 Definition singleoffloat (e: expr) := Eop Osingleoffloat (e ::: Enil).
 Definition floatofsingle (e: expr) := Eop Ofloatofsingle (e ::: Enil).
 
+(** ** Selection *)
+
+Definition select (ty: typ) (cond: condition) (args: exprlist) (e1 e2: expr) :=
+  if match ty with
+     | Tint => true
+     | Tfloat => true
+     | Tsingle => true
+     | Tlong => Archi.ppc64
+     | _ => false
+     end
+  then Some (Eop (Osel cond ty) (e1 ::: e2 ::: args))
+  else None.
+
 (** ** Recognition of addressing modes for load and store operations *)
 
 Definition can_use_Aindexed2 (chunk: memory_chunk): bool :=
@@ -552,3 +563,8 @@ Nondetfunction builtin_arg (e: expr) :=
   | Eop Oadd (e1:::e2:::Enil) => BA_addptr (BA e1) (BA e2)
   | _ => BA e
   end.
+
+(** Platform-specific known builtins *)
+
+Definition platform_builtin (b: platform_builtin) (args: exprlist) : option expr :=
+  None.
diff --git a/powerpc/SelectOpproof.v b/powerpc/SelectOpproof.v
index 5f87d9b9..c3eda068 100644
--- a/powerpc/SelectOpproof.v
+++ b/powerpc/SelectOpproof.v
@@ -13,17 +13,10 @@
 (** Correctness of instruction selection for operators *)
 
 Require Import Coqlib.
-Require Import Maps.
+Require Import AST Integers Floats.
+Require Import Values Memory Builtins Globalenvs.
+Require Import Cminor Op CminorSel.
 Require Import Compopts.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Cminor.
-Require Import Op.
-Require Import CminorSel.
 Require Import SelectOp.
 
 Local Open Scope cminorsel_scope.
@@ -812,7 +805,7 @@ Qed.
 Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8).
 Proof.
   red; intros. unfold cast8unsigned.
-  rewrite Val.zero_ext_and. apply eval_andimm; auto. compute; auto.
+  rewrite Val.zero_ext_and. apply eval_andimm; auto. omega.
 Qed.
 
 Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16).
@@ -825,7 +818,7 @@ Qed.
 Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16).
 Proof.
   red; intros. unfold cast16unsigned.
-  rewrite Val.zero_ext_and. apply eval_andimm; auto. compute; auto.
+  rewrite Val.zero_ext_and. apply eval_andimm; auto. omega.
 Qed.
 
 Theorem eval_singleoffloat: unary_constructor_sound singleoffloat Val.singleoffloat.
@@ -1000,6 +993,27 @@ Proof.
   exists (Val.singleoffloat v); split. EvalOp. inv D; auto.
 Qed.
 
+Theorem eval_select:
+  forall le ty cond al vl a1 v1 a2 v2 a b,
+  select ty cond al a1 a2 = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  eval_expr ge sp e m le a1 v1 ->
+  eval_expr ge sp e m le a2 v2 ->
+  eval_condition cond vl m = Some b ->
+
+  exists v,
+     eval_expr ge sp e m le a v
+  /\ Val.lessdef (Val.select (Some b) v1 v2 ty) v.
+Proof.
+  unfold select; intros.
+  destruct (match ty with Tint => true | Tfloat => true | Tsingle => true | Tlong => Archi.ppc64 | _ => false end); inv H.
+  exists (Val.select (Some b) v1 v2 ty); split.
+  apply eval_Eop with (v1 :: v2 :: vl).
+  constructor; auto. constructor; auto.
+  simpl. rewrite H3; auto.
+  auto.
+Qed.
+
 Theorem eval_addressing:
   forall le chunk a v b ofs,
   eval_expr ge sp e m le a v ->
@@ -1044,4 +1058,16 @@ Proof.
 - constructor; auto.
 Qed.
 
+(** Platform-specific known builtins *)
+
+Theorem eval_platform_builtin:
+  forall bf al a vl v le,
+  platform_builtin bf al = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  platform_builtin_sem bf vl = Some v ->
+  exists v', eval_expr ge sp e m le a v' /\ Val.lessdef v v'.
+Proof.
+  intros. discriminate.
+Qed.
+
 End CMCONSTR.
diff --git a/powerpc/Stacklayout.v b/powerpc/Stacklayout.v
index cb3806bd..d5539b70 100644
--- a/powerpc/Stacklayout.v
+++ b/powerpc/Stacklayout.v
@@ -68,7 +68,7 @@ Lemma frame_env_separated:
        ** range sp (fe_ofs_callee_save fe) (size_callee_save_area b (fe_ofs_callee_save fe))
        ** P.
 Proof.
-Local Opaque Z.add Z.mul sepconj range.
+Local Opaque Z.add Z.mul sepconj range'.
   intros; simpl.
   set (ol := align (8 + 4 * b.(bound_outgoing)) 8).
   set (ora := ol + 4 * b.(bound_local)).
diff --git a/powerpc/TargetPrinter.ml b/powerpc/TargetPrinter.ml
index c1aaa55d..0f608d25 100644
--- a/powerpc/TargetPrinter.ml
+++ b/powerpc/TargetPrinter.ml
@@ -118,13 +118,22 @@ module Linux_System : SYSTEM =
     let name_of_section = function
       | Section_text -> ".text"
       | Section_data i ->
-          if i then ".data" else "COMM"
+          if i then
+            ".data"
+          else
+            common_section ~sec:".section	.bss" ()
       | Section_small_data i ->
-          if i then ".section	.sdata,\"aw\",@progbits" else "COMM"
+          if i then
+            ".section	.sdata,\"aw\",@progbits"
+          else
+            common_section ~sec:".section	.sbss,\"aw\",@nobits" ()
       | Section_const i ->
-          if i then ".rodata" else "COMM"
+          if i || (not !Clflags.option_fcommon) then ".rodata" else "COMM"
       | Section_small_const i ->
-          if i then ".section	.sdata2,\"a\",@progbits" else "COMM"
+          if i || (not !Clflags.option_fcommon) then
+            ".section	.sdata2,\"a\",@progbits"
+          else
+            "COMM"
       | Section_string -> ".rodata"
       | Section_literal -> ".section	.rodata.cst8,\"aM\",@progbits,8"
       | Section_jumptable -> ".text"
@@ -209,7 +218,7 @@ module Diab_System : SYSTEM =
 
     let name_of_section = function
       | Section_text -> ".text"
-      | Section_data i -> if i then ".data" else "COMM"
+      | Section_data i -> if i then ".data" else common_section ()
       | Section_small_data i -> if i then ".sdata" else ".sbss"
       | Section_const _ -> ".text"
       | Section_small_const _ -> ".sdata2"
@@ -331,7 +340,7 @@ module Target (System : SYSTEM):TARGET =
     let ireg_or_zero oc r =
       if r = GPR0 then output_string oc "0" else ireg oc r
 
-    let preg oc = function
+    let preg_asm oc ty = function
       | IR r -> ireg oc r
       | FR r -> freg oc r
       | _    -> assert false
@@ -604,6 +613,7 @@ module Target (System : SYSTEM):TARGET =
           fprintf oc "	fsel	%a, %a, %a, %a\n" freg r1 freg r2 freg r3 freg r4
       | Pisel (r1,r2,r3,cr) ->
           fprintf oc "	isel	%a, %a, %a, %a\n" ireg r1 ireg r2 ireg r3 crbit cr
+      | Pfsel_gen _ -> assert false
       | Picbi (r1,r2) ->
           fprintf oc "	icbi	%a, %a\n" ireg r1 ireg r2
       | Picbtls (n,r1,r2) ->
@@ -853,7 +863,7 @@ module Target (System : SYSTEM):TARGET =
                                (P.to_int kind) (extern_atom txt) args
           | EF_inline_asm(txt, sg, clob) ->
               fprintf oc "%s begin inline assembly\n\t" comment;
-              print_inline_asm preg oc (camlstring_of_coqstring txt) sg args res;
+              print_inline_asm preg_asm oc (camlstring_of_coqstring txt) sg args res;
               fprintf oc "%s end inline assembly\n" comment
           | _ ->
               assert false
diff --git a/powerpc/ValueAOp.v b/powerpc/ValueAOp.v
index f7f65e9e..a270d857 100644
--- a/powerpc/ValueAOp.v
+++ b/powerpc/ValueAOp.v
@@ -141,6 +141,7 @@ Definition eval_static_operation (op: operation) (vl: list aval): aval :=
   | Olowlong, v1::nil => loword v1
   | Ohighlong, v1::nil => hiword v1
   | Ocmp c, _ => of_optbool (eval_static_condition c vl)
+  | Osel c ty, v1::v2::vl => select (eval_static_condition c vl) v1 v2
   | _, _ => Vbot
   end.
 
@@ -211,6 +212,7 @@ Proof.
   apply rolml_sound; auto.
   apply floatofwords_sound; auto.
   apply of_optbool_sound. eapply eval_static_condition_sound; eauto.
+  apply select_sound; auto. eapply eval_static_condition_sound; eauto.
 Qed.
 
 End SOUNDNESS.
diff --git a/powerpc/extractionMachdep.v b/powerpc/extractionMachdep.v
index 7482435f..a3e945bf 100644
--- a/powerpc/extractionMachdep.v
+++ b/powerpc/extractionMachdep.v
@@ -34,3 +34,6 @@ Extract Constant Archi.ppc64 =>
    | ""e5500"" -> true
    | _ -> false
    end".
+
+(* Choice of passing of single *)
+Extract Constant Archi.single_passed_as_single => "Configuration.gnu_toolchain".
diff --git a/riscV/Archi.v b/riscV/Archi.v
index 3758d686..61d129d0 100644
--- a/riscV/Archi.v
+++ b/riscV/Archi.v
@@ -16,7 +16,7 @@
 
 (** Architecture-dependent parameters for RISC-V *)
 
-Require Import ZArith.
+Require Import ZArith List.
 (*From Flocq*)
 Require Import Binary Bits.
 
@@ -40,26 +40,33 @@ Qed.
    except the MSB, a.k.a. the quiet bit."
    Exceptions are operations manipulating signs. *)
 
-Definition default_nan_64 : { x : binary64 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 53 1024 false (iter_nat 51 _ xO xH) (eq_refl true)) (eq_refl true).
+Definition default_nan_64 := (false, iter_nat 51 _ xO xH).
+Definition default_nan_32 := (false, iter_nat 22 _ xO xH).
 
-Definition choose_binop_pl_64 (pl1 pl2 : positive) :=
-  false.                        (**r irrelevant *)
+Definition choose_nan_64 (l: list (bool * positive)) : bool * positive :=
+  default_nan_64.
 
-Definition default_nan_32 : { x : binary32 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 24 128 false (iter_nat 22 _ xO xH) (eq_refl true)) (eq_refl true).
+Definition choose_nan_32 (l: list (bool * positive)) : bool * positive :=
+  default_nan_32.
 
-Definition choose_binop_pl_32 (pl1 pl2 : positive) :=
-  false.                        (**r irrelevant *)
+Lemma choose_nan_64_idem: forall n,
+  choose_nan_64 (n :: n :: nil) = choose_nan_64 (n :: nil).
+Proof. auto. Qed.
 
-Definition fpu_returns_default_qNaN := true.
+Lemma choose_nan_32_idem: forall n,
+  choose_nan_32 (n :: n :: nil) = choose_nan_32 (n :: nil).
+Proof. auto. Qed.
+
+Definition fma_order {A: Type} (x y z: A) := (x, y, z).
+
+Definition fma_invalid_mul_is_nan := false.
 
 Definition float_of_single_preserves_sNaN := false.
 
 Global Opaque ptr64 big_endian splitlong
-              default_nan_64 choose_binop_pl_64
-              default_nan_32 choose_binop_pl_32
-              fpu_returns_default_qNaN
+              default_nan_64 choose_nan_64
+              default_nan_32 choose_nan_32
+              fma_order fma_invalid_mul_is_nan
               float_of_single_preserves_sNaN.
 
 (** Whether to generate position-independent code or not *)
diff --git a/riscV/Asm.v b/riscV/Asm.v
index 1d8fda11..dc410a3b 100644
--- a/riscV/Asm.v
+++ b/riscV/Asm.v
@@ -369,7 +369,7 @@ lbl:
 - [Ploadfi rd fval]: similar to [Ploadli] but loads a double FP constant fval
   into a float register rd.
 
-- [Ploadsi rd fval]: similar to [Ploadli] but loads a singe FP constant fval
+- [Ploadsi rd fval]: similar to [Ploadli] but loads a single FP constant fval
   into a float register rd.
 
 - [Pallocframe sz pos]: in the formal semantics, this
diff --git a/riscV/Asmexpand.ml b/riscV/Asmexpand.ml
index 3e734747..7e36abf8 100644
--- a/riscV/Asmexpand.ml
+++ b/riscV/Asmexpand.ml
@@ -23,7 +23,7 @@ open Asm
 open Asmexpandaux
 open AST
 open Camlcoq
-open !Integers
+open! Integers
 
 exception Error of string
 
@@ -63,44 +63,44 @@ let expand_storeind_ptr src base ofs =
 let int_param_regs   = [| X10; X11; X12; X13; X14; X15; X16; X17 |]
 let float_param_regs = [| F10; F11; F12; F13; F14; F15; F16; F17 |]
 
-let rec fixup_variadic_call pos tyl =
-  if pos < 8 then
+let rec fixup_variadic_call ri rf tyl =
+  if ri < 8 then
     match tyl with
     | [] ->
         ()
     | (Tint | Tany32) :: tyl ->
-        fixup_variadic_call (pos + 1) tyl
+        fixup_variadic_call (ri + 1) rf tyl
     | Tsingle :: tyl ->
-        let rs =float_param_regs.(pos)
-        and rd = int_param_regs.(pos) in
+        let rs = float_param_regs.(rf)
+        and rd = int_param_regs.(ri) in
         emit (Pfmvxs(rd, rs));
-        fixup_variadic_call (pos + 1) tyl
+        fixup_variadic_call (ri + 1) (rf + 1) tyl
     | Tlong :: tyl ->
-        let pos' = if Archi.ptr64 then pos + 1 else align pos 2 + 2 in
-        fixup_variadic_call pos' tyl
+        let ri' = if Archi.ptr64 then ri + 1 else align ri 2 + 2 in
+        fixup_variadic_call ri' rf tyl
     | (Tfloat | Tany64) :: tyl ->
         if Archi.ptr64 then begin
-          let rs = float_param_regs.(pos)
-          and rd = int_param_regs.(pos) in
+          let rs = float_param_regs.(rf)
+          and rd = int_param_regs.(ri) in
           emit (Pfmvxd(rd, rs));
-          fixup_variadic_call (pos + 1) tyl
+          fixup_variadic_call (ri + 1) (rf + 1) tyl
         end else begin
-          let pos = align pos 2 in
-          if pos < 8 then begin
-            let rs = float_param_regs.(pos)
-            and rd1 = int_param_regs.(pos)
-            and rd2 = int_param_regs.(pos + 1) in
+          let ri = align ri 2 in
+          if ri < 8 then begin
+            let rs = float_param_regs.(rf)
+            and rd1 = int_param_regs.(ri)
+            and rd2 = int_param_regs.(ri + 1) in
             emit (Paddiw(X2, X X2, Integers.Int.neg _16));
             emit (Pfsd(rs, X2, Ofsimm _0));
             emit (Plw(rd1, X2, Ofsimm _0));
             emit (Plw(rd2, X2, Ofsimm _4));
             emit (Paddiw(X2, X X2, _16));
-            fixup_variadic_call (pos + 2) tyl
+            fixup_variadic_call (ri + 2) (rf + 1) tyl
           end
         end
         
 let fixup_call sg =
-  if sg.sig_cc.cc_vararg then fixup_variadic_call 0 sg.sig_args
+  if sg.sig_cc.cc_vararg then fixup_variadic_call 0 0 sg.sig_args
 
 (* Handling of annotations *)
 
@@ -483,7 +483,7 @@ let expand_instruction instr =
       emit (Pmv (X30, X2));
       if sg.sig_cc.cc_vararg then begin
         let n = arguments_size sg in
-        let extra_sz = if n >= 8 then 0 else align 16 ((8 - n) * wordsize) in
+        let extra_sz = if n >= 8 then 0 else align ((8 - n) * wordsize) 16 in
         let full_sz = Z.add sz (Z.of_uint extra_sz) in
         expand_addptrofs X2 X2 (Ptrofs.repr (Z.neg full_sz));
         expand_storeind_ptr X30 X2 ofs;
@@ -501,7 +501,7 @@ let expand_instruction instr =
      let extra_sz =
       if sg.sig_cc.cc_vararg then begin
         let n = arguments_size sg in
-        if n >= 8 then 0 else align 16 ((8 - n) * wordsize)
+        if n >= 8 then 0 else align ((8 - n) * wordsize) 16
       end else 0 in
      expand_addptrofs X2 X2 (Ptrofs.repr (Z.add sz (Z.of_uint extra_sz)))
 
diff --git a/riscV/Asmgenproof1.v b/riscV/Asmgenproof1.v
index 7f070c12..c20c4e49 100644
--- a/riscV/Asmgenproof1.v
+++ b/riscV/Asmgenproof1.v
@@ -16,7 +16,7 @@
 (* *********************************************************************)
 
 Require Import Coqlib Errors Maps.
-Require Import AST Integers Floats Values Memory Globalenvs.
+Require Import AST Zbits Integers Floats Values Memory Globalenvs.
 Require Import Op Locations Mach Conventions.
 Require Import Asm Asmgen Asmgenproof0.
 
@@ -33,16 +33,16 @@ Proof.
   predSpec Int.eq Int.eq_spec n lo.
 - auto.
 - set (m := Int.sub n lo).
-  assert (A: Int.eqmod (two_p 12) (Int.unsigned lo) (Int.unsigned n)) by (apply Int.eqmod_sign_ext'; compute; auto).
-  assert (B: Int.eqmod (two_p 12) (Int.unsigned n - Int.unsigned  lo) 0).
+  assert (A: eqmod (two_p 12) (Int.unsigned lo) (Int.unsigned n)) by (apply Int.eqmod_sign_ext'; compute; auto).
+  assert (B: eqmod (two_p 12) (Int.unsigned n - Int.unsigned  lo) 0).
   { replace 0 with (Int.unsigned n - Int.unsigned n) by omega.
-    auto using Int.eqmod_sub, Int.eqmod_refl. }
-  assert (C: Int.eqmod (two_p 12) (Int.unsigned m) 0).
-  { apply Int.eqmod_trans with (Int.unsigned n - Int.unsigned lo); auto.
-    apply Int.eqmod_divides with Int.modulus. apply Int.eqm_sym; apply Int.eqm_unsigned_repr.
+    auto using eqmod_sub, eqmod_refl. }
+  assert (C: eqmod (two_p 12) (Int.unsigned m) 0).
+  { apply eqmod_trans with (Int.unsigned n - Int.unsigned lo); auto.
+    apply eqmod_divides with Int.modulus. apply Int.eqm_sym; apply Int.eqm_unsigned_repr.
     exists (two_p (32-12)); auto. }
   assert (D: Int.modu m (Int.repr 4096) = Int.zero).
-  { apply Int.eqmod_mod_eq in C. unfold Int.modu. 
+  { apply eqmod_mod_eq in C. unfold Int.modu. 
     change (Int.unsigned (Int.repr 4096)) with (two_p 12). rewrite C. 
     reflexivity.
     apply two_p_gt_ZERO; omega. }
@@ -400,22 +400,6 @@ Ltac ArgsInv :=
   | [ H: freg_of _ = OK _ |- _ ] => simpl in *; rewrite (freg_of_eq _ _ H) in *
   end).
 
-Inductive exec_straight_opt: code -> regset -> mem -> code -> regset -> mem -> Prop :=
-  | exec_straight_opt_refl: forall c rs m,
-      exec_straight_opt c rs m c rs m
-  | exec_straight_opt_intro: forall c1 rs1 m1 c2 rs2 m2,
-      exec_straight ge fn c1 rs1 m1 c2 rs2 m2 ->
-      exec_straight_opt c1 rs1 m1 c2 rs2 m2.
-
-Remark exec_straight_opt_right:
-  forall c3 rs3 m3 c1 rs1 m1 c2 rs2 m2,
-  exec_straight_opt c1 rs1 m1 c2 rs2 m2 ->
-  exec_straight ge fn c2 rs2 m2 c3 rs3 m3 ->
-  exec_straight ge fn c1 rs1 m1 c3 rs3 m3.
-Proof.
-  destruct 1; intros. auto. eapply exec_straight_trans; eauto. 
-Qed.
-
 Lemma transl_cbranch_correct_1:
   forall cond args lbl k c m ms b sp rs m',
   transl_cbranch cond args lbl k = OK c ->
@@ -423,7 +407,7 @@ Lemma transl_cbranch_correct_1:
   agree ms sp rs ->
   Mem.extends m m' ->
   exists rs', exists insn,
-     exec_straight_opt c rs m' (insn :: k) rs' m'
+     exec_straight_opt ge fn c rs m' (insn :: k) rs' m'
   /\ exec_instr ge fn insn rs' m' = eval_branch fn lbl rs' m' (Some b)
   /\ forall r, r <> PC -> r <> X31 -> rs'#r = rs#r.
 Proof.
@@ -518,7 +502,7 @@ Lemma transl_cbranch_correct_true:
   agree ms sp rs ->
   Mem.extends m m' ->
   exists rs', exists insn,
-     exec_straight_opt c rs m' (insn :: k) rs' m'
+     exec_straight_opt ge fn c rs m' (insn :: k) rs' m'
   /\ exec_instr ge fn insn rs' m' = goto_label fn lbl rs' m'
   /\ forall r, r <> PC -> r <> X31 -> rs'#r = rs#r.
 Proof.
@@ -1108,7 +1092,7 @@ Lemma indexed_memory_access_correct:
   forall mk_instr base ofs k rs m,
   base <> X31 ->
   exists base' ofs' rs',
-     exec_straight_opt (indexed_memory_access mk_instr base ofs k) rs m
+     exec_straight_opt ge fn (indexed_memory_access mk_instr base ofs k) rs m
                        (mk_instr base' ofs' :: k) rs' m
   /\ Val.offset_ptr rs'#base' (eval_offset ge ofs') = Val.offset_ptr rs#base ofs
   /\ forall r, r <> PC -> r <> X31 -> rs'#r = rs#r.
@@ -1258,7 +1242,7 @@ Lemma transl_memory_access_correct:
   transl_memory_access mk_instr addr args k = OK c ->
   eval_addressing ge rs#SP addr (map rs (map preg_of args)) = Some v ->
   exists base ofs rs',
-     exec_straight_opt c rs m (mk_instr base ofs :: k) rs' m
+     exec_straight_opt ge fn c rs m (mk_instr base ofs :: k) rs' m
   /\ Val.offset_ptr rs'#base (eval_offset ge ofs) = v
   /\ forall r, r <> PC -> r <> X31 -> rs'#r = rs#r.
 Proof.
diff --git a/riscV/Builtins1.v b/riscV/Builtins1.v
new file mode 100644
index 00000000..53c83d7e
--- /dev/null
+++ b/riscV/Builtins1.v
@@ -0,0 +1,33 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Platform-specific built-in functions *)
+
+Require Import String Coqlib.
+Require Import AST Integers Floats Values.
+Require Import Builtins0.
+
+Inductive platform_builtin : Type := .
+
+Local Open Scope string_scope.
+
+Definition platform_builtin_table : list (string * platform_builtin) :=
+  nil.
+
+Definition platform_builtin_sig (b: platform_builtin) : signature :=
+  match b with end.
+
+Definition platform_builtin_sem (b: platform_builtin) : builtin_sem (sig_res (platform_builtin_sig b)) :=
+  match b with end.
diff --git a/riscV/CBuiltins.ml b/riscV/CBuiltins.ml
index 0c981d11..a2087cb7 100644
--- a/riscV/CBuiltins.ml
+++ b/riscV/CBuiltins.ml
@@ -18,16 +18,13 @@
 open C
 
 let builtins = {
-  Builtins.typedefs = [
+  builtin_typedefs = [
     "__builtin_va_list", TPtr(TVoid [], [])
   ];
-  Builtins.functions = [
+  builtin_functions = [
     (* Synchronization *)
     "__builtin_fence",
       (TVoid [], [], false);
-    (* Integer arithmetic *)
-    "__builtin_bswap64",
-      (TInt(IULongLong, []), [TInt(IULongLong, [])], false);
     (* Float arithmetic *)
     "__builtin_fmadd",
       (TFloat(FDouble, []),
diff --git a/riscV/Conventions1.v b/riscV/Conventions1.v
index df7ddfd2..17326139 100644
--- a/riscV/Conventions1.v
+++ b/riscV/Conventions1.v
@@ -105,7 +105,9 @@ Definition is_float_reg (r: mreg) :=
   of function arguments), but this leaves much liberty in choosing actual
   locations.  To ensure binary interoperability of code generated by our
   compiler with libraries compiled by another compiler, we
-  implement the standard RISC-V conventions.  *)
+  implement the standard RISC-V conventions as found here:
+  https://github.com/riscv/riscv-elf-psabi-doc/blob/master/riscv-elf.md
+*)
 
 (** ** Location of function result *)
 
@@ -115,11 +117,10 @@ Definition is_float_reg (r: mreg) :=
   with one integer result. *)
 
 Definition loc_result (s: signature) : rpair mreg :=
-  match s.(sig_res) with
-  | None => One R10
-  | Some (Tint | Tany32) => One R10
-  | Some (Tfloat | Tsingle | Tany64) => One F10
-  | Some Tlong => if Archi.ptr64 then One R10 else Twolong R11 R10
+  match proj_sig_res s with
+  | Tint | Tany32 => One R10
+  | Tfloat | Tsingle | Tany64 => One F10
+  | Tlong => if Archi.ptr64 then One R10 else Twolong R11 R10
   end.
 
 (** The result registers have types compatible with that given in the signature. *)
@@ -128,8 +129,8 @@ Lemma loc_result_type:
   forall sig,
   subtype (proj_sig_res sig) (typ_rpair mreg_type (loc_result sig)) = true.
 Proof.
-  intros. unfold proj_sig_res, loc_result, mreg_type;
-  destruct (sig_res sig) as [[]|]; auto; destruct Archi.ptr64; auto.
+  intros. unfold loc_result, mreg_type;
+  destruct (proj_sig_res sig); auto; destruct Archi.ptr64; auto.
 Qed.
 
 (** The result locations are caller-save registers *)
@@ -139,7 +140,7 @@ Lemma loc_result_caller_save:
   forall_rpair (fun r => is_callee_save r = false) (loc_result s).
 Proof.
   intros. unfold loc_result, is_callee_save;
-  destruct (sig_res s) as [[]|]; simpl; auto; destruct Archi.ptr64; simpl; auto.
+  destruct (proj_sig_res s); simpl; auto; destruct Archi.ptr64; simpl; auto.
 Qed.
 
 (** If the result is in a pair of registers, those registers are distinct and have type [Tint] at least. *)
@@ -149,13 +150,13 @@ Lemma loc_result_pair:
   match loc_result sg with
   | One _ => True
   | Twolong r1 r2 =>
-       r1 <> r2 /\ sg.(sig_res) = Some Tlong
+       r1 <> r2 /\ proj_sig_res sg = Tlong
     /\ subtype Tint (mreg_type r1) = true /\ subtype Tint (mreg_type r2) = true 
     /\ Archi.ptr64 = false
   end.
 Proof.
   intros.
-  unfold loc_result; destruct (sig_res sg) as [[]|]; auto.
+  unfold loc_result; destruct (proj_sig_res sg); auto.
   unfold mreg_type; destruct Archi.ptr64; auto.
   split; auto. congruence.
 Qed.
@@ -165,43 +166,37 @@ Qed.
 Lemma loc_result_exten:
   forall s1 s2, s1.(sig_res) = s2.(sig_res) -> loc_result s1 = loc_result s2.
 Proof.
-  intros. unfold loc_result. rewrite H; auto.  
+  intros. unfold loc_result, proj_sig_res. rewrite H; auto.  
 Qed.
 
 (** ** Location of function arguments *)
 
-(** The RISC-V ABI states the following convention for passing arguments
+(** The RISC-V ABI states the following conventions for passing arguments
   to a function:
 
-- Arguments are passed in registers when possible.
-
-- Up to eight integer registers (ai: int_param_regs) and up to eight
-  floating-point registers (fai: float_param_regs) are used for this
-  purpose.
-
-- If the arguments to a function are conceptualized as fields of a C
-  struct, each with pointer alignment, the argument registers are a
-  shadow of the first eight pointer-words of that struct. If argument
-  i < 8 is a floating-point type, it is passed in floating-point
-  register fa_i; otherwise, it is passed in integer register a_i.
-
-- When primitive arguments twice the size of a pointer-word are passed
-  on the stack, they are naturally aligned. When they are passed in the
-  integer registers, they reside in an aligned even-odd register pair,
-  with the even register holding the least-significant bits.
-
-- Floating-point arguments to variadic functions (except those that
-  are explicitly named in the parameter list) are passed in integer
-  registers.
-
-- The portion of the conceptual struct that is not passed in argument
-  registers is passed on the stack. The stack pointer sp points to the
-  first argument not passed in a register.
-
-The bit about variadic functions doesn't quite fit CompCert's model.
-We do our best by passing the FP arguments in registers, as usual,
-and reserving the corresponding integer registers, so that fixup
-code can be introduced in the Asmexpand pass.
+- RV64, not variadic: pass the first 8 integer arguments in
+  integer registers (a1...a8: int_param_regs), the first 8 FP arguments
+  in FP registers (fa1...fa8: float_param_regs), and the remaining
+  arguments on the stack, in 8-byte slots.
+
+- RV32, not variadic: same, but arguments of 64-bit integer type
+  are passed in two consecutive integer registers (a(i), a(i+1))
+  or in a(8) and on a 32-bit word on the stack.  Stack-allocated
+  arguments are aligned to their natural alignment.
+
+- RV64, variadic: pass the first 8 arguments in integer registers
+  (a1...a8), including FP arguments; pass the remaining arguments on
+  the stack, in 8-byte slots.
+
+- RV32, variadic: same, but arguments of 64-bit types (integers as well
+  as floats) are passed in two consecutive aligned integer registers
+  (a(2i), a(2i+1)).  
+
+The passing of FP arguments to variadic functions in integer registers
+doesn't quite fit CompCert's model.  We do our best by passing the FP
+arguments in registers, as usual, and reserving the corresponding
+integer registers, so that fixup code can be introduced in the
+Asmexpand pass.
 *)
 
 Definition int_param_regs :=
@@ -209,80 +204,84 @@ Definition int_param_regs :=
 Definition float_param_regs :=
   F10 :: F11 :: F12 :: F13 :: F14 :: F15 :: F16 :: F17 :: nil.
 
-Definition one_arg (regs: list mreg) (rn: Z) (ofs: Z) (ty: typ)
-                           (rec: Z -> Z -> list (rpair loc)) :=
-  match list_nth_z regs rn with
+Definition int_arg (ri rf ofs: Z) (ty: typ)
+                   (rec: Z -> Z -> Z -> list (rpair loc)) :=
+  match list_nth_z int_param_regs ri with
   | Some r =>
-      One(R r) :: rec (rn + 1) ofs
+      One(R r) :: rec (ri + 1) rf ofs
   | None   =>
-      let ofs := align ofs (typealign ty) in
-      One(S Outgoing ofs ty) :: rec rn (ofs + (if Archi.ptr64 then 2 else typesize ty))
+      let ofs := align ofs (typesize ty) in
+      One(S Outgoing ofs ty)
+      :: rec ri rf (ofs + (if Archi.ptr64 then 2 else typesize ty))
   end.
 
-Definition two_args (regs: list mreg) (rn: Z) (ofs: Z)
-                    (rec: Z -> Z -> list (rpair loc)) :=
-  let rn := align rn 2 in
-  match list_nth_z regs rn, list_nth_z regs (rn + 1) with
-  | Some r1, Some r2 =>
-      Twolong (R r2) (R r1) :: rec (rn + 2) ofs
-  | _, _ =>
-      let ofs := align ofs 2 in
-      Twolong (S Outgoing (ofs + 1) Tint) (S Outgoing ofs Tint) ::
-      rec rn (ofs + 2)
+Definition float_arg (va: bool) (ri rf ofs: Z) (ty: typ)
+                     (rec: Z -> Z -> Z -> list (rpair loc)) :=
+  match list_nth_z float_param_regs rf with
+  | Some r =>
+      if va then
+       (let ri' :=  (* reserve 1 or 2 aligned integer registers *)
+          if Archi.ptr64 || zeq (typesize ty) 1 then ri + 1 else align ri 2 + 2 in
+        if zle ri' 8 then
+            (* we have enough integer registers, put argument in FP reg
+               and fixup code will put it in one or two integer regs *)
+            One (R r) :: rec ri' (rf + 1) ofs
+        else
+            (* we are out of integer registers, pass argument on stack *)
+            let ofs := align ofs (typesize ty) in
+            One(S Outgoing ofs ty)
+            :: rec ri' rf (ofs + (if Archi.ptr64 then 2 else typesize ty)))
+      else
+        One (R r) :: rec ri (rf + 1) ofs
+  | None   =>
+      let ofs := align ofs (typesize ty) in
+      One(S Outgoing ofs ty)
+      :: rec ri rf (ofs + (if Archi.ptr64 then 2 else typesize ty))
   end.
 
-Definition hybrid_arg (regs: list mreg) (rn: Z) (ofs: Z) (ty: typ)
-                      (rec: Z -> Z -> list (rpair loc)) :=
-  let rn := align rn 2 in
-  match list_nth_z regs rn with
-  | Some r =>
-      One (R r) :: rec (rn + 2) ofs
-  | None =>
+Definition split_long_arg (va: bool) (ri rf ofs: Z)
+                          (rec: Z -> Z -> Z -> list (rpair loc)) :=
+  let ri := if va then align ri 2 else ri in
+  match list_nth_z int_param_regs ri, list_nth_z int_param_regs (ri + 1) with
+  | Some r1, Some r2 =>
+      Twolong (R r2) (R r1) :: rec (ri + 2) rf ofs
+  | Some r1, None =>
+      Twolong (S Outgoing ofs Tint) (R r1) :: rec (ri + 1) rf (ofs + 1)
+  | None, _ =>
       let ofs := align ofs 2 in
-      One (S Outgoing ofs ty) :: rec rn (ofs + 2)
+      Twolong (S Outgoing (ofs + 1) Tint) (S Outgoing ofs Tint) ::
+      rec ri rf (ofs + 2)
   end.
 
 Fixpoint loc_arguments_rec (va: bool)
-    (tyl: list typ) (r ofs: Z) {struct tyl} : list (rpair loc) :=
+    (tyl: list typ) (ri rf ofs: Z) {struct tyl} : list (rpair loc) :=
   match tyl with
   | nil => nil
   | (Tint | Tany32) as ty :: tys =>
-      one_arg int_param_regs r ofs ty (loc_arguments_rec va tys)
+      (* pass in one integer register or on stack *)
+      int_arg ri rf ofs ty (loc_arguments_rec va tys)
   | Tsingle as ty :: tys =>
-      one_arg float_param_regs r ofs ty (loc_arguments_rec va tys)
+      (* pass in one FP register or on stack.
+         If vararg, reserve 1 integer register. *)
+      float_arg va ri rf ofs ty (loc_arguments_rec va tys)
   | Tlong as ty :: tys =>
-      if Archi.ptr64
-      then one_arg int_param_regs r ofs ty (loc_arguments_rec va tys)
-      else two_args int_param_regs r ofs  (loc_arguments_rec va tys)
+      if Archi.ptr64 then
+        (* pass in one integer register or on stack *)
+        int_arg ri rf ofs ty (loc_arguments_rec va tys)
+      else
+        (* pass in register pair or on stack; align register pair if vararg *)
+        split_long_arg va ri rf ofs(loc_arguments_rec va tys)
   | (Tfloat | Tany64) as ty :: tys =>
-      if va && negb Archi.ptr64
-      then hybrid_arg float_param_regs r ofs ty (loc_arguments_rec va tys)
-      else one_arg float_param_regs r ofs ty (loc_arguments_rec va tys)
+      (* pass in one FP register or on stack.
+         If vararg, reserve 1 or 2 integer registers. *)
+      float_arg va ri rf ofs ty (loc_arguments_rec va tys)
   end.
 
 (** [loc_arguments s] returns the list of locations where to store arguments
   when calling a function with signature [s].  *)
 
 Definition loc_arguments (s: signature) : list (rpair loc) :=
-  loc_arguments_rec s.(sig_cc).(cc_vararg) s.(sig_args) 0 0.
-
-(** [size_arguments s] returns the number of [Outgoing] slots used
-  to call a function with signature [s]. *)
-
-Definition max_outgoing_1 (accu: Z) (l: loc) : Z :=
-  match l with
-  | S Outgoing ofs ty => Z.max accu (ofs + typesize ty)
-  | _ => accu
-  end.
-
-Definition max_outgoing_2 (accu: Z) (rl: rpair loc) : Z :=
-  match rl with
-  | One l => max_outgoing_1 accu l
-  | Twolong l1 l2 => max_outgoing_1 (max_outgoing_1 accu l1) l2
-  end.
-
-Definition size_arguments (s: signature) : Z :=
-  List.fold_left max_outgoing_2 (loc_arguments s) 0.
+  loc_arguments_rec s.(sig_cc).(cc_vararg) s.(sig_args) 0 0 0.
 
 (** Argument locations are either non-temporary registers or [Outgoing]
   stack slots at nonnegative offsets. *)
@@ -295,90 +294,87 @@ Definition loc_argument_acceptable (l: loc) : Prop :=
   end.
 
 Lemma loc_arguments_rec_charact:
-  forall va tyl rn ofs p,
+  forall va tyl ri rf ofs p,
   ofs >= 0 ->
-  In p (loc_arguments_rec va tyl rn ofs) -> forall_rpair loc_argument_acceptable p.
+  In p (loc_arguments_rec va tyl ri rf ofs) -> forall_rpair loc_argument_acceptable p.
 Proof.
   set (OK := fun (l: list (rpair loc)) =>
              forall p, In p l -> forall_rpair loc_argument_acceptable p).
-  set (OKF := fun (f: Z -> Z -> list (rpair loc)) =>
-              forall rn ofs, ofs >= 0 -> OK (f rn ofs)).
-  set (OKREGS := fun (l: list mreg) => forall r, In r l -> is_callee_save r = false).
-  assert (AL: forall ofs ty, ofs >= 0 -> align ofs (typealign ty) >= 0).
+  set (OKF := fun (f: Z -> Z -> Z -> list (rpair loc)) =>
+              forall ri rf ofs, ofs >= 0 -> OK (f ri rf ofs)).
+  assert (CSI: forall r, In r int_param_regs -> is_callee_save r = false).
+  { decide_goal. }
+  assert (CSF: forall r, In r float_param_regs -> is_callee_save r = false).
+  { decide_goal. }
+  assert (AL: forall ofs ty, ofs >= 0 -> align ofs (typesize ty) >= 0).
   { intros. 
-    assert (ofs <= align ofs (typealign ty)) by (apply align_le; apply typealign_pos).
+    assert (ofs <= align ofs (typesize ty)) by (apply align_le; apply typesize_pos).
     omega. }
+  assert (ALD: forall ofs ty, ofs >= 0 -> (typealign ty | align ofs (typesize ty))).
+  { intros. eapply Z.divide_trans. apply typealign_typesize.
+    apply align_divides. apply typesize_pos. }
   assert (SK: (if Archi.ptr64 then 2 else 1) > 0).
   { destruct Archi.ptr64; omega. }
   assert (SKK: forall ty, (if Archi.ptr64 then 2 else typesize ty) > 0).
   { intros. destruct Archi.ptr64. omega. apply typesize_pos.  }
-  assert (A: forall regs rn ofs ty f,
-             OKREGS regs -> OKF f -> ofs >= 0 -> OK (one_arg regs rn ofs ty f)).
-  { intros until f; intros OR OF OO; red; unfold one_arg; intros.
-    destruct (list_nth_z regs rn) as [r|] eqn:NTH; destruct H.
-  - subst p; simpl. apply OR. eapply list_nth_z_in; eauto. 
+  assert (A: forall ri rf ofs ty f,
+             OKF f -> ofs >= 0 -> OK (int_arg ri rf ofs ty f)).
+  { intros until f; intros OF OO; red; unfold int_arg; intros.
+    destruct (list_nth_z int_param_regs ri) as [r|] eqn:NTH; destruct H.
+  - subst p; simpl. apply CSI. eapply list_nth_z_in; eauto. 
   - eapply OF; eauto. 
   - subst p; simpl. auto using align_divides, typealign_pos.
   - eapply OF; [idtac|eauto].
     generalize (AL ofs ty OO) (SKK ty); omega.
   }
-  assert (B: forall regs rn ofs f,
-             OKREGS regs -> OKF f -> ofs >= 0 -> OK (two_args regs rn ofs f)).
-  { intros until f; intros OR OF OO; unfold two_args.
-    set (rn' := align rn 2).
+  assert (B: forall va ri rf ofs ty f,
+             OKF f -> ofs >= 0 -> OK (float_arg va ri rf ofs ty f)).
+  { intros until f; intros OF OO; red; unfold float_arg; intros.
+    destruct (list_nth_z float_param_regs rf) as [r|] eqn:NTH.
+  - set (ri' := if Archi.ptr64 || zeq (typesize ty) 1 then ri + 1 else align ri 2 + 2) in *.
+    destruct va; [destruct (zle ri' 8)|idtac]; destruct H.
+    + subst p; simpl. apply CSF. eapply list_nth_z_in; eauto.
+    + eapply OF; eauto.
+    + subst p; repeat split; auto.
+    + eapply OF; [idtac|eauto]. generalize (AL ofs ty OO) (SKK ty); omega.
+    + subst p; simpl. apply CSF. eapply list_nth_z_in; eauto.
+    + eapply OF; eauto.
+  - destruct H.
+    + subst p; repeat split; auto.
+    + eapply OF; [idtac|eauto]. generalize (AL ofs ty OO) (SKK ty); omega.
+  }
+  assert (C: forall va ri rf ofs f,
+             OKF f -> ofs >= 0 -> OK (split_long_arg va ri rf ofs f)).
+  { intros until f; intros OF OO; unfold split_long_arg.
+    set (ri' := if va then align ri 2 else ri).
     set (ofs' := align ofs 2).
     assert (OO': ofs' >= 0) by (apply (AL ofs Tlong); auto).
-    assert (DFL: OK (Twolong (S Outgoing (ofs' + 1) Tint) (S Outgoing ofs' Tint)
-                     :: f rn' (ofs' + 2))).
-    { red; simpl; intros. destruct H.
-    - subst p; simpl. 
-      repeat split; auto using Z.divide_1_l. omega.
-    - eapply OF; [idtac|eauto]. omega.
-    }
-    destruct (list_nth_z regs rn') as [r1|] eqn:NTH1;
-    destruct (list_nth_z regs (rn' + 1)) as [r2|] eqn:NTH2;
-    try apply DFL.
-    red; simpl; intros; destruct H.
-  - subst p; simpl. split; apply OR; eauto using list_nth_z_in.  
-  - eapply OF; [idtac|eauto]. auto.
+    destruct (list_nth_z int_param_regs ri') as [r1|] eqn:NTH1;
+    [destruct (list_nth_z int_param_regs (ri'+1)) as [r2|] eqn:NTH2 | idtac].
+  - red; simpl; intros; destruct H.
+    + subst p; split; apply CSI; eauto using list_nth_z_in.
+    + eapply OF; [idtac|eauto]. omega.
+  - red; simpl; intros; destruct H.
+    + subst p; split. split; auto using Z.divide_1_l. apply CSI; eauto using list_nth_z_in.
+    + eapply OF; [idtac|eauto]. omega.
+  - red; simpl; intros; destruct H.
+    + subst p; repeat split; auto using Z.divide_1_l. omega. 
+    + eapply OF; [idtac|eauto]. omega.
   }
-  assert (C: forall regs rn ofs ty f,
-             OKREGS regs -> OKF f -> ofs >= 0 -> typealign ty = 1 -> OK (hybrid_arg regs rn ofs ty f)).
-  { intros until f; intros OR OF OO OTY; unfold hybrid_arg; red; intros.
-    set (rn' := align rn 2) in *.
-    destruct (list_nth_z regs rn') as [r|] eqn:NTH; destruct H.
-  - subst p; simpl. apply OR. eapply list_nth_z_in; eauto. 
-  - eapply OF; eauto. 
-  - subst p; simpl. rewrite OTY. split. apply (AL ofs Tlong OO). apply Z.divide_1_l. 
-  - eapply OF; [idtac|eauto]. generalize (AL ofs Tlong OO); simpl; omega.
-  }
-  assert (D: OKREGS int_param_regs).
-  { red. decide_goal. }
-  assert (E: OKREGS float_param_regs).
-  { red. decide_goal. }
-
-  cut (forall va tyl rn ofs, ofs >= 0 -> OK (loc_arguments_rec va tyl rn ofs)).
+  cut (forall va tyl ri rf ofs, ofs >= 0 -> OK (loc_arguments_rec va tyl ri rf ofs)).
   unfold OK. eauto.
   induction tyl as [ | ty1 tyl]; intros until ofs; intros OO; simpl.
 - red; simpl; tauto.
 - destruct ty1.
 + (* int *) apply A; auto.
-+ (* float *) 
-  destruct (va && negb Archi.ptr64).
-  apply C; auto.
-  apply A; auto.
++ (* float *) apply B; auto.
 + (* long *)
   destruct Archi.ptr64.
   apply A; auto.
-  apply B; auto.
-+ (* single *)
-  apply A; auto.
-+ (* any32 *)
-  apply A; auto.
-+ (* any64 *)
-  destruct (va && negb Archi.ptr64).
   apply C; auto.
-  apply A; auto.
++ (* single *) apply B; auto.
++ (* any32 *) apply A; auto.
++ (* any64 *) apply B; auto.
 Qed.
 
 Lemma loc_arguments_acceptable:
@@ -388,54 +384,14 @@ Proof.
   unfold loc_arguments; intros. eapply loc_arguments_rec_charact; eauto. omega.
 Qed.
 
-(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)
-
-Remark fold_max_outgoing_above:
-  forall l n, fold_left max_outgoing_2 l n >= n.
-Proof.
-  assert (A: forall n l, max_outgoing_1 n l >= n).
-  { intros; unfold max_outgoing_1. destruct l as [_ | []]; xomega. }
-  induction l; simpl; intros. 
-  - omega.
-  - eapply Zge_trans. eauto.
-    destruct a; simpl. apply A. eapply Zge_trans; eauto.
-Qed.
-
-Lemma size_arguments_above:
-  forall s, size_arguments s >= 0.
-Proof.
-  intros. apply fold_max_outgoing_above.
-Qed.
-
-Lemma loc_arguments_bounded:
-  forall (s: signature) (ofs: Z) (ty: typ),
-  In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments s)) ->
-  ofs + typesize ty <= size_arguments s.
-Proof.
-  intros until ty.
-  assert (A: forall n l, n <= max_outgoing_1 n l).
-  { intros; unfold max_outgoing_1. destruct l as [_ | []]; xomega. }
-  assert (B: forall p n,
-             In (S Outgoing ofs ty) (regs_of_rpair p) ->
-             ofs + typesize ty <= max_outgoing_2 n p).
-  { intros. destruct p; simpl in H; intuition; subst; simpl.
-  - xomega.
-  - eapply Z.le_trans. 2: apply A. xomega.
-  - xomega. }
-  assert (C: forall l n,
-             In (S Outgoing ofs ty) (regs_of_rpairs l) ->
-             ofs + typesize ty <= fold_left max_outgoing_2 l n).
-  { induction l; simpl; intros.
-  - contradiction.
-  - rewrite in_app_iff in H. destruct H.
-  + eapply Z.le_trans. eapply B; eauto. apply Z.ge_le. apply fold_max_outgoing_above.
-  + apply IHl; auto.
-  }
-  apply C. 
-Qed.
-
 Lemma loc_arguments_main:
   loc_arguments signature_main = nil.
 Proof.
   reflexivity.
 Qed.
+
+(** ** Normalization of function results *)
+
+(** No normalization needed. *)
+
+Definition return_value_needs_normalization (t: rettype) := false.
diff --git a/riscV/SelectOp.vp b/riscV/SelectOp.vp
index bb8af2ed..99806006 100644
--- a/riscV/SelectOp.vp
+++ b/riscV/SelectOp.vp
@@ -44,11 +44,8 @@
 Require Archi.
 Require Import Coqlib.
 Require Import Compopts.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Op.
-Require Import CminorSel.
+Require Import AST Integers Floats Builtins.
+Require Import Op CminorSel.
 
 Local Open Scope cminorsel_scope.
 
@@ -420,6 +417,12 @@ Definition singleofintu (e: expr) := Eop Osingleofintu (e ::: Enil).
 Definition singleoffloat (e: expr) := Eop Osingleoffloat (e ::: Enil).
 Definition floatofsingle (e: expr) := Eop Ofloatofsingle (e ::: Enil).
 
+(** ** Selection *)
+
+Definition select (ty: typ) (cond: condition) (args: exprlist) (e1 e2: expr)
+   : option expr
+   := None.
+ 
 (** ** Recognition of addressing modes for load and store operations *)
 
 Nondetfunction addressing (chunk: memory_chunk) (e: expr) :=
@@ -448,3 +451,8 @@ Nondetfunction builtin_arg (e: expr) :=
       if Archi.ptr64 then BA_addptr (BA e1) (BA_long n) else BA e
   | _ => BA e
   end.
+
+(** Platform-specific known builtins *)
+
+Definition platform_builtin (b: platform_builtin) (args: exprlist) : option expr :=
+  None.
diff --git a/riscV/SelectOpproof.v b/riscV/SelectOpproof.v
index 90f077db..593be1ed 100644
--- a/riscV/SelectOpproof.v
+++ b/riscV/SelectOpproof.v
@@ -17,17 +17,10 @@
 
 (** Correctness of instruction selection for operators *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Cminor.
-Require Import Op.
-Require Import CminorSel.
+Require Import Coqlib Zbits.
+Require Import AST Integers Floats.
+Require Import Values Memory Builtins Globalenvs.
+Require Import Cminor Op CminorSel.
 Require Import SelectOp.
 
 Local Open Scope cminorsel_scope.
@@ -372,7 +365,7 @@ Proof.
   change (Int.ltu (Int.repr 32) Int64.iwordsize') with true; simpl.
   apply Val.lessdef_same. f_equal. 
   transitivity (Int.repr (Z.shiftr (Int.signed i * Int.signed i0) 32)).
-  unfold Int.mulhs; f_equal. rewrite Int.Zshiftr_div_two_p by omega. reflexivity.
+  unfold Int.mulhs; f_equal. rewrite Zshiftr_div_two_p by omega. reflexivity.
   apply Int.same_bits_eq; intros n N.
   change Int.zwordsize with 32 in *.
   assert (N1: 0 <= n < 64) by omega.
@@ -400,7 +393,7 @@ Proof.
   change (Int.ltu (Int.repr 32) Int64.iwordsize') with true; simpl.
   apply Val.lessdef_same. f_equal. 
   transitivity (Int.repr (Z.shiftr (Int.unsigned i * Int.unsigned i0) 32)).
-  unfold Int.mulhu; f_equal. rewrite Int.Zshiftr_div_two_p by omega. reflexivity.
+  unfold Int.mulhu; f_equal. rewrite Zshiftr_div_two_p by omega. reflexivity.
   apply Int.same_bits_eq; intros n N.
   change Int.zwordsize with 32 in *.
   assert (N1: 0 <= n < 64) by omega.
@@ -770,7 +763,7 @@ Qed.
 Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8).
 Proof.
   red; intros until x. unfold cast8unsigned.
-  rewrite Val.zero_ext_and. apply eval_andimm. compute; auto.
+  rewrite Val.zero_ext_and. apply eval_andimm. omega.
 Qed.
 
 Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16).
@@ -783,7 +776,7 @@ Qed.
 Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16).
 Proof.
   red; intros until x. unfold cast8unsigned.
-  rewrite Val.zero_ext_and. apply eval_andimm. compute; auto.
+  rewrite Val.zero_ext_and. apply eval_andimm. omega.
 Qed.
 
 Theorem eval_intoffloat:
@@ -872,6 +865,20 @@ Proof.
   red; intros. unfold floatofsingle. TrivialExists.
 Qed.
 
+Theorem eval_select:
+  forall le ty cond al vl a1 v1 a2 v2 a b,
+  select ty cond al a1 a2 = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  eval_expr ge sp e m le a1 v1 ->
+  eval_expr ge sp e m le a2 v2 ->
+  eval_condition cond vl m = Some b ->
+  exists v, 
+     eval_expr ge sp e m le a v
+  /\ Val.lessdef (Val.select (Some b) v1 v2 ty) v.
+Proof.
+  unfold select; intros; discriminate.
+Qed.
+
 Theorem eval_addressing:
   forall le chunk a v b ofs,
   eval_expr ge sp e m le a v ->
@@ -922,4 +929,16 @@ Proof.
 - constructor; auto.
 Qed.
 
+(** Platform-specific known builtins *)
+
+Theorem eval_platform_builtin:
+  forall bf al a vl v le,
+  platform_builtin bf al = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  platform_builtin_sem bf vl = Some v ->
+  exists v', eval_expr ge sp e m le a v' /\ Val.lessdef v v'.
+Proof.
+  intros. discriminate.
+Qed.
+
 End CMCONSTR.
diff --git a/riscV/TargetPrinter.ml b/riscV/TargetPrinter.ml
index 19704bad..64bcea4c 100644
--- a/riscV/TargetPrinter.ml
+++ b/riscV/TargetPrinter.ml
@@ -93,7 +93,7 @@ module Target : TARGET =
       | X0 -> output_string oc "x0"
       | X r -> ireg oc r
 
-    let preg oc = function
+    let preg_asm oc ty = function
       | IR r -> ireg oc r
       | FR r -> freg oc r
       | _    -> assert false
@@ -108,9 +108,9 @@ module Target : TARGET =
     let name_of_section = function
       | Section_text         -> ".text"
       | Section_data i | Section_small_data i ->
-          if i then ".data" else "COMM"
+          if i then ".data" else common_section ()
       | Section_const i | Section_small_const i ->
-          if i then ".section	.rodata" else "COMM"
+          if i || (not !Clflags.option_fcommon) then ".section	.rodata" else "COMM"
       | Section_string       -> ".section	.rodata"
       | Section_literal      -> ".section	.rodata"
       | Section_jumptable    -> ".section	.rodata"
@@ -582,7 +582,7 @@ module Target : TARGET =
                                (P.to_int kind) (extern_atom txt) args
           | EF_inline_asm(txt, sg, clob) ->
               fprintf oc "%s begin inline assembly\n\t" comment;
-              print_inline_asm preg oc (camlstring_of_coqstring txt) sg args res;
+              print_inline_asm preg_asm oc (camlstring_of_coqstring txt) sg args res;
               fprintf oc "%s end inline assembly\n" comment
           | _ ->
               assert false
diff --git a/runtime/Makefile b/runtime/Makefile
index 27ad6e8c..6777995d 100644
--- a/runtime/Makefile
+++ b/runtime/Makefile
@@ -22,6 +22,8 @@ ifeq ($(ARCH),x86_64)
 OBJS=i64_dtou.o i64_utod.o i64_utof.o vararg.o
 else ifeq ($(ARCH),powerpc64)
 OBJS=i64_dtou.o i64_stof.o i64_utod.o i64_utof.o vararg.o
+else ifeq ($(ARCH),aarch64)
+OBJS=vararg.o
 else
 OBJS=i64_dtos.o i64_dtou.o i64_sar.o i64_sdiv.o i64_shl.o \
   i64_shr.o i64_smod.o i64_stod.o i64_stof.o \
@@ -70,16 +72,16 @@ clean::
 
 ifeq ($(strip $(HAS_RUNTIME_LIB)),true)
 install::
-	install -d $(LIBDIR)
-	install -m 0644 $(LIB) $(LIBDIR)
+	install -d $(DESTDIR)$(LIBDIR)
+	install -m 0644 $(LIB) $(DESTDIR)$(LIBDIR)
 else
 install::
 endif
 
 ifeq ($(strip $(HAS_STANDARD_HEADERS)),true)
 install::
-	install -d $(LIBDIR)/include
-	install -m 0644 $(INCLUDES) $(LIBDIR)/include
+	install -d $(DESTDIR)$(LIBDIR)/include
+	install -m 0644 $(INCLUDES) $(DESTDIR)$(LIBDIR)/include
 else
 install::
 endif
diff --git a/runtime/aarch64/sysdeps.h b/runtime/aarch64/sysdeps.h
new file mode 100644
index 00000000..0cee9ae3
--- /dev/null
+++ b/runtime/aarch64/sysdeps.h
@@ -0,0 +1,45 @@
+// *****************************************************************
+//
+//               The Compcert verified compiler
+//
+//           Xavier Leroy, Collège de France and INRIA Paris
+//
+// Copyright (c) Institut National de Recherche en Informatique et
+//  en Automatique.
+//	
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions are met:
+//     * Redistributions of source code must retain the above copyright
+//       notice, this list of conditions and the following disclaimer.
+//     * Redistributions in binary form must reproduce the above copyright
+//       notice, this list of conditions and the following disclaimer in the
+//       documentation and/or other materials provided with the distribution.
+//     * Neither the name of the <organization> nor the
+//       names of its contributors may be used to endorse or promote products
+//       derived from this software without specific prior written permission.
+//
+// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+// A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT
+// HOLDER> BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+// EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+// PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+// PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+// LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+// NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+//
+// *********************************************************************
+
+// System dependencies
+
+#define FUNCTION(f) \
+	.text; \
+        .balign 16; \
+	.globl f; \
+f:
+
+#define ENDFUNCTION(f) \
+	.type f, @function; .size f, . - f
+
diff --git a/runtime/aarch64/vararg.S b/runtime/aarch64/vararg.S
new file mode 100644
index 00000000..b7347d65
--- /dev/null
+++ b/runtime/aarch64/vararg.S
@@ -0,0 +1,109 @@
+// *****************************************************************
+//
+//               The Compcert verified compiler
+//
+//           Xavier Leroy, Collège de France and INRIA Paris
+//
+// Copyright (c) Institut National de Recherche en Informatique et
+//  en Automatique.
+//	
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions are met:
+//     * Redistributions of source code must retain the above copyright
+//       notice, this list of conditions and the following disclaimer.
+//     * Redistributions in binary form must reproduce the above copyright
+//       notice, this list of conditions and the following disclaimer in the
+//       documentation and/or other materials provided with the distribution.
+//     * Neither the name of the <organization> nor the
+//       names of its contributors may be used to endorse or promote products
+//       derived from this software without specific prior written permission.
+//
+// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+// A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT
+// HOLDER> BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+// EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+// PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+// PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+// LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+// NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+//
+// *********************************************************************
+
+// Helper functions for variadic functions <stdarg.h>.  AArch64 version.
+
+#include "sysdeps.h"	
+
+// typedef struct __va_list {
+//   void *__stack;             // next stack parameter
+//   void *__gr_top;            // top of the save area for int regs
+//   void *__vr_top;            // top of the save area for float regs
+//   int__gr_offs;              // offset from gr_top to next int reg
+//   int__vr_offs;              // offset from gr_top to next FP reg
+// }
+// typedef struct __va_list va_list;   // struct passed by reference
+// unsigned int __compcert_va_int32(va_list * ap);
+// unsigned long long __compcert_va_int64(va_list * ap);
+// double __compcert_va_float64(va_list * ap);
+
+FUNCTION(__compcert_va_int32)
+        ldr     w1, [x0, #24]   // w1 = gr_offs
+        cbz     w1, 1f
+  // gr_offs is not zero: load from int save area and update gr_offs
+        ldr     x2, [x0, #8]    // x2 = gr_top
+        ldr     w2, [x2, w1, sxtw] // w2 = the next integer
+        add     w1, w1, #8
+        str     w1, [x0, #24]   // update gr_offs
+        mov     w0, w2
+	ret
+  // gr_offs is zero: load from stack save area and update stack pointer
+1:      ldr     x1, [x0, #0]    // x1 = stack
+        ldr     w2, [x1, #0]    // w2 = the next integer
+        add     x1, x1, #8
+        str     x1, [x0, #0]    // update stack
+        mov     w0, w2
+	ret
+ENDFUNCTION(__compcert_va_int32)
+
+FUNCTION(__compcert_va_int64)
+        ldr     w1, [x0, #24]   // w1 = gr_offs
+        cbz     w1, 1f
+  // gr_offs is not zero: load from int save area and update gr_offs
+        ldr     x2, [x0, #8]    // x2 = gr_top
+        ldr     x2, [x2, w1, sxtw] // w2 = the next long integer
+        add     w1, w1, #8
+        str     w1, [x0, #24]   // update gr_offs
+        mov     x0, x2
+	ret
+  // gr_offs is zero: load from stack save area and update stack pointer
+1:      ldr     x1, [x0, #0]    // x1 = stack
+        ldr     x2, [x1, #0]    // w2 = the next long integer
+        add     x1, x1, #8
+        str     x1, [x0, #0]    // update stack
+        mov     x0, x2
+	ret
+ENDFUNCTION(__compcert_va_int64)
+
+FUNCTION(__compcert_va_float64)
+        ldr     w1, [x0, #28]   // w1 = vr_offs
+        cbz     w1, 1f
+  // vr_offs is not zero: load from float save area and update vr_offs
+        ldr     x2, [x0, #16]   // x2 = vr_top
+        ldr     d0, [x2, w1, sxtw] // d0 = the next float
+        add     w1, w1, #16
+        str     w1, [x0, #28]   // update vr_offs
+	ret
+  // gr_offs is zero: load from stack save area and update stack pointer
+1:      ldr     x1, [x0, #0]    // x1 = stack
+        ldr     d0, [x1, #0]    // d0 = the next float
+        add     x1, x1, #8
+        str     x1, [x0, #0]    // update stack
+	ret
+ENDFUNCTION(__compcert_va_float64)
+
+// Right now we pass structs by reference.  This is not ABI conformant.
+FUNCTION(__compcert_va_composite)
+	b	__compcert_va_int64
+ENDFUNCTION(__compcert_va_composite)
diff --git a/runtime/arm/i64_stof.S b/runtime/arm/i64_stof.S
index bcfa471c..11e00a2a 100644
--- a/runtime/arm/i64_stof.S
+++ b/runtime/arm/i64_stof.S
@@ -39,12 +39,11 @@
 @@@ Conversion from signed 64-bit integer to single float
 
 FUNCTION(__compcert_i64_stof)
-    @ Check whether -2^53 <= X < 2^53
-        ASR r2, Reg0HI, #21
-        ASR r3, Reg0HI, #31     @ (r2,r3) = X >> 53
+   @ Check whether -2^53 <= X < 2^53
+        ASR r2, Reg0HI, #21     @ r2 = high 32 bits of X >> 53
+   @ -2^53 <= X < 2^53 iff r2 is -1 or 0, that is, iff r2 + 1 is 0 or 1
         adds r2, r2, #1
-        adc r3, r3, #0          @ (r2,r3) = X >> 53 + 1
-        cmp r3, #2
+        cmp r2, #2
         blo 1f
    @ X is large enough that double rounding can occur.
    @ Avoid it by nudging X away from the points where double rounding
diff --git a/runtime/powerpc/i64_stof.s b/runtime/powerpc/i64_stof.s
index 97fa6bb8..ea23a1c8 100644
--- a/runtime/powerpc/i64_stof.s
+++ b/runtime/powerpc/i64_stof.s
@@ -43,20 +43,19 @@
 __compcert_i64_stof:
 	mflr r9
    # Check whether -2^53 <= X < 2^53	
-        srawi r5, r3, 31
-        srawi r6, r3, 21        # (r5,r6) = X >> 53
-        addic r6, r6, 1
-        addze r5, r5            # (r5,r6) = (X >> 53) + 1
+        srawi r5, r3, 21        # r5 = high 32 bits of X >> 53
+   # -2^53 <= X < 2^53 iff r5 is -1 or 0, that is, iff r5 + 1 is 0 or 1
+        addi r5, r5, 1
         cmplwi r5, 2
         blt 1f
    # X is large enough that double rounding can occur.
    # Avoid it by nudging X away from the points where double rounding
    # occurs (the "round to odd" technique)
-        rlwinm r0, r4, 0, 21, 31 # extract bits 0 to 11 of X
-        addi r0, r0, 0x7FF      # r0 = (X & 0x7FF) + 0x7FF
-   # bit 12 of r0 is 0 if all low 12 bits of X are 0, 1 otherwise
-   # bits 13-31 of r0 are 0
-        or r4, r4, r0           # correct bit number 12 of X
+        rlwinm r5, r4, 0, 21, 31 # extract bits 0 to 11 of X
+        addi r5, r5, 0x7FF      # r5 = (X & 0x7FF) + 0x7FF
+   # bit 12 of r5 is 0 if all low 12 bits of X are 0, 1 otherwise
+   # bits 13-31 of r5 are 0
+        or r4, r4, r5           # correct bit number 12 of X
         rlwinm r4, r4, 0, 0, 20 # set to 0 bits 0 to 11 of X
    # Convert to double, then round to single	
 1:      bl __compcert_i64_stod
diff --git a/runtime/powerpc/i64_utof.s b/runtime/powerpc/i64_utof.s
index cdb2f867..4a2a172b 100644
--- a/runtime/powerpc/i64_utof.s
+++ b/runtime/powerpc/i64_utof.s
@@ -48,11 +48,11 @@ __compcert_i64_utof:
    # X is large enough that double rounding can occur.
    # Avoid it by nudging X away from the points where double rounding
    # occurs (the "round to odd" technique)
-        rlwinm r0, r4, 0, 21, 31 # extract bits 0 to 11 of X
-        addi r0, r0, 0x7FF      # r0 = (X & 0x7FF) + 0x7FF
-   # bit 12 of r0 is 0 if all low 12 bits of X are 0, 1 otherwise
-   # bits 13-31 of r0 are 0
-        or r4, r4, r0           # correct bit number 12 of X
+        rlwinm r5, r4, 0, 21, 31 # extract bits 0 to 11 of X
+        addi r5, r5, 0x7FF      # r5 = (X & 0x7FF) + 0x7FF
+   # bit 12 of r5 is 0 if all low 12 bits of X are 0, 1 otherwise
+   # bits 13-31 of r5 are 0
+        or r4, r4, r5           # correct bit number 12 of X
         rlwinm r4, r4, 0, 0, 20 # set to 0 bits 0 to 11 of X
    # Convert to double, then round to single	
 1:      bl __compcert_i64_utod
diff --git a/runtime/powerpc64/i64_utof.s b/runtime/powerpc64/i64_utof.s
index cdb2f867..4a2a172b 100644
--- a/runtime/powerpc64/i64_utof.s
+++ b/runtime/powerpc64/i64_utof.s
@@ -48,11 +48,11 @@ __compcert_i64_utof:
    # X is large enough that double rounding can occur.
    # Avoid it by nudging X away from the points where double rounding
    # occurs (the "round to odd" technique)
-        rlwinm r0, r4, 0, 21, 31 # extract bits 0 to 11 of X
-        addi r0, r0, 0x7FF      # r0 = (X & 0x7FF) + 0x7FF
-   # bit 12 of r0 is 0 if all low 12 bits of X are 0, 1 otherwise
-   # bits 13-31 of r0 are 0
-        or r4, r4, r0           # correct bit number 12 of X
+        rlwinm r5, r4, 0, 21, 31 # extract bits 0 to 11 of X
+        addi r5, r5, 0x7FF      # r5 = (X & 0x7FF) + 0x7FF
+   # bit 12 of r5 is 0 if all low 12 bits of X are 0, 1 otherwise
+   # bits 13-31 of r5 are 0
+        or r4, r4, r5           # correct bit number 12 of X
         rlwinm r4, r4, 0, 0, 20 # set to 0 bits 0 to 11 of X
    # Convert to double, then round to single	
 1:      bl __compcert_i64_utod
diff --git a/test/c/Makefile b/test/c/Makefile
index 51a8f105..4b521bb5 100644
--- a/test/c/Makefile
+++ b/test/c/Makefile
@@ -7,8 +7,7 @@ CFLAGS=-O1 -Wall
 
 LIBS=$(LIBMATH)
 
-TIME=xtime -o /dev/null -mintime 2.0     # Xavier's hack
-#TIME=time >/dev/null                    # Otherwise
+TIME=ocaml unix.cma ../../tools/xtime.ml -o /dev/null -mintime 2.0 -minruns 4
 
 PROGS=fib integr qsort fft fftsp fftw sha1 sha3 aes almabench \
   lists binarytrees fannkuch knucleotide mandelbrot nbody \
@@ -48,12 +47,12 @@ test_gcc:
 
 bench_gcc:
 	@for i in $(PROGS); do \
-	   echo -n "$$i: "; $(TIME) ./$$i.gcc; \
+	   $(TIME) -name $$i -- ./$$i.gcc; \
          done
 
 bench:
 	@for i in $(PROGS); do \
-	   echo -n "$$i: "; $(TIME) ./$$i.compcert; \
+	   $(TIME) -name $$i -- ./$$i.compcert; \
          done
 
 clean:
diff --git a/test/c/aes.c b/test/c/aes.c
index 0aa02595..16f02e47 100644
--- a/test/c/aes.c
+++ b/test/c/aes.c
@@ -27,6 +27,7 @@
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
+#include "../endian.h"
 
 #define MAXKC	(256/32)
 #define MAXKB	(256/8)
@@ -36,15 +37,6 @@ typedef unsigned char	u8;
 typedef unsigned short	u16;
 typedef unsigned int	u32;
 
-#if defined(__ppc__) || defined(__PPC__) || defined(__ARMEB__)
-#define ARCH_BIG_ENDIAN
-#elif defined(__i386__) || defined(__x86_64__) || defined(__ARMEL__) \
-   || defined(__riscv)
-#undef ARCH_BIG_ENDIAN
-#else
-#error "unknown endianness"
-#endif
-
 #ifdef ARCH_BIG_ENDIAN
 #define GETU32(pt) (*(u32 *)(pt))
 #define PUTU32(ct,st) (*(u32 *)(ct) = (st))
diff --git a/test/c/chomp.c b/test/c/chomp.c
index c88cef5c..728e7a01 100644
--- a/test/c/chomp.c
+++ b/test/c/chomp.c
@@ -106,7 +106,7 @@ void dump_play(struct _play *play) /* and for the entire game tree */
 int get_value(int *data) /* get the value (0 or 1) for a specific _data */
 {
   struct _play *search;
-  search = game_tree; /* start at the begginig */
+  search = game_tree; /* start at the beginning */
   while (! equal_data(search -> state,data)) /* until you find a match */
       search = search -> next; /* take next element */
   return search -> value; /* return its value */
@@ -138,7 +138,7 @@ void show_list(struct _list *list) /* show the entire list of moves */
     }
 }
 
-void show_play(struct _play *play) /* to diplay the whole tree */
+void show_play(struct _play *play) /* to display the whole tree */
 {
   while (play != NULL)
     {
@@ -154,7 +154,7 @@ void show_play(struct _play *play) /* to diplay the whole tree */
 int in_wanted(int *data) /* checks if the current _data is in the wanted list */
 {
   struct _list *current;
-  current = wanted; /* start at the begginig */
+  current = wanted; /* start at the beginning */
   while (current != NULL) /* unitl the last one */
     {
       if (equal_data(current -> data,data)) break; /* break if found */
diff --git a/test/clightgen/issue319.c b/test/clightgen/issue319.c
new file mode 100644
index 00000000..be9f3f7e
--- /dev/null
+++ b/test/clightgen/issue319.c
@@ -0,0 +1,12 @@
+/* Dollar signs in identifiers */
+
+int c$d = 42;
+
+int a$b(int x$$) {
+  return c$d + x$$;
+}
+
+int main(int argc, const char *argv[])
+{
+  return a$b(6);
+}
diff --git a/test/compression/Makefile b/test/compression/Makefile
index 2e14e646..e8f3cf4d 100644
--- a/test/compression/Makefile
+++ b/test/compression/Makefile
@@ -3,7 +3,7 @@ include ../../Makefile.config
 CC=../../ccomp 
 CFLAGS=$(CCOMPOPTS) -U__GNUC__ -stdlib ../../runtime -dclight -dasm
 LIBS=
-TIME=xtime -o /dev/null -mintime 1.0
+TIME=ocaml unix.cma ../../tools/xtime.ml -mintime 2.0 -minruns 2
 
 EXE=arcode lzw lzss
 
@@ -48,8 +48,7 @@ test:
 bench:
 	@rm -f $(TESTCOMPR)
 	@for i in $(EXE); do \
-          echo -n "$$i: "; \
-          $(TIME) sh -c "./$$i -c -i $(TESTFILE) -o $(TESTCOMPR) && ./$$i -d -i $(TESTCOMPR) -o /dev/null"; \
+          $(TIME) -name $$i -- sh -c "./$$i -c -i $(TESTFILE) -o $(TESTCOMPR) && ./$$i -d -i $(TESTCOMPR) -o /dev/null"; \
          done
 	@rm -f $(TESTCOMPR)
 
diff --git a/test/endian.h b/test/endian.h
new file mode 100644
index 00000000..8be2850c
--- /dev/null
+++ b/test/endian.h
@@ -0,0 +1,8 @@
+#if defined(__ppc__) || defined(__PPC__) || defined(__ARMEB__)
+#define ARCH_BIG_ENDIAN
+#elif defined(__i386__) || defined(__x86_64__) || defined(__ARMEL__) \
+   || defined(__riscv) || defined(__aarch64__)
+#undef ARCH_BIG_ENDIAN
+#else
+#error "unknown endianness"
+#endif
diff --git a/test/raytracer/Makefile b/test/raytracer/Makefile
index 8f6541a1..24461bd1 100644
--- a/test/raytracer/Makefile
+++ b/test/raytracer/Makefile
@@ -3,7 +3,7 @@ include ../../Makefile.config
 CC=../../ccomp 
 CFLAGS=$(CCOMPOPTS) -stdlib ../../runtime -dparse -dclight -dasm -fstruct-return
 LIBS=$(LIBMATH)
-TIME=xtime
+TIME=ocaml unix.cma ../../tools/xtime.ml -mintime 2.0 -minruns 4
 
 OBJS=memory.o gmllexer.o gmlparser.o eval.o \
   arrays.o vector.o matrix.o object.o intersect.o surface.o light.o \
@@ -30,4 +30,4 @@ test:
         fi
 
 bench:
-	@echo -n "raytracer: "; $(TIME) sh -c './render < kal.gml'
+	@$(TIME) -name raytracer -- sh -c './render < kal.gml'
diff --git a/test/regression/Makefile b/test/regression/Makefile
index 760ee570..8e8d8762 100644
--- a/test/regression/Makefile
+++ b/test/regression/Makefile
@@ -10,13 +10,13 @@ LIBS=$(LIBMATH)
 # Can run, both in compiled mode and in interpreter mode,
 # and have reference output in Results
 
-TESTS=int32 int64 floats floats-basics \
+TESTS=int32 int64 floats floats-basics floats-lit \
   expr1 expr6 funptr2 initializers initializers2 initializers3 \
   volatile1 volatile2 volatile3 volatile4 \
   funct3 expr5 struct7 struct8 struct11 struct12 casts1 casts2 char1 \
   sizeof1 sizeof2 binops bool for1 for2 switch switch2 compound \
   decl1 interop1 bitfields9 ptrs3 \
-  parsing krfun
+  parsing krfun ifconv
 
 # Can run, but only in compiled mode, and have reference output in Results
 
diff --git a/test/regression/Results/builtins-aarch64 b/test/regression/Results/builtins-aarch64
new file mode 100644
index 00000000..c70432d8
--- /dev/null
+++ b/test/regression/Results/builtins-aarch64
@@ -0,0 +1,15 @@
+bswap(12345678) = 78563412
+bswap16(1234) = 3412
+bswap64(123456789abcdef0) = f0debc9a78563412
+clz(12345678) = 3
+clzll(12345678) = 35
+clzll(1234567812345678) = 3
+cls(1234567) = 10
+cls(-9999) = 17
+clsll(1234567) = 42
+clsll(-9999) = 49
+fsqrt(3.141590) = 1.772453
+fmadd(3.141590, 2.718000, 1.414000) = 9.952842
+fmsub(3.141590, 2.718000, 1.414000) = -7.124842
+fnmadd(3.141590, 2.718000, 1.414000) = -9.952842
+fnmsub(3.141590, 2.718000, 1.414000) = 7.124842
diff --git a/test/regression/Results/floats-lit b/test/regression/Results/floats-lit
new file mode 100644
index 00000000..6cde72fb
--- /dev/null
+++ b/test/regression/Results/floats-lit
@@ -0,0 +1,2 @@
+--- Double-precision test
+--- Single-precision test
diff --git a/test/regression/Results/ifconv b/test/regression/Results/ifconv
new file mode 100644
index 00000000..38019fe6
--- /dev/null
+++ b/test/regression/Results/ifconv
@@ -0,0 +1,26 @@
+test1(0,1,12,34) = 12
+test1(1,0,45,67) = 67
+test2(0,1,12,34) = 12
+test2(1,0,45,67) = 67
+test3(0,1,12,34) = 12
+test3(1,0,45,67) = 67
+test4(0,1,12,34) = 12
+test4(1,0,45,67) = 67
+test5(0,1,12) = 13
+test5(1,0,45) = 44
+test6(NULL) = 0
+test6(&i) = 1244
+test7(1,0) = -1
+test7(-100,4) = -25
+test8(0) = 0
+test8(1) = -72
+ltest1(-1, 0, 123LL, 456LL) = 124
+ltest1(1, 0, 123LL, 456LL) = 114
+dmax(0.0, 3.14) = 3.140000
+dmax(1.0, -2.718) = 1.000000
+dabs(1.0) = 1.000000
+dabs(-2.718) = 2.718000
+smin(0.0, 3.14) = 0.000000
+smin(1.0, -2.718) = -2.718000
+sdoz(1.0, 0.5) = 0.500000
+sdoz(0.0, 3.14) = 0.000000
diff --git a/test/regression/Results/int64 b/test/regression/Results/int64
index af444cf6..ae8a3cc1 100644
--- a/test/regression/Results/int64
+++ b/test/regression/Results/int64
@@ -335,6 +335,48 @@ utof x = 0
 stof x = 0
 
 x = 0
+y = 52ce6b4000000063
+-x = 0
+x + y = 52ce6b4000000063
+x - y = ad3194bfffffff9d
+x * y = 0
+x /u y = 0
+x %u y = 0
+x /s y = 0
+x %s y = 0
+x /u y2 = 0
+x %u y2 = 0
+x /s y3 = 0
+x %s y3 = 0
+x /u 3 = 0
+x %u 3 = 0
+x /s 3 = 0
+x %s 3 = 0
+x /u 5 = 0
+x %u 5 = 0
+x /s 5 = 0
+x %s 5 = 0
+x /u 11 = 0
+x %u 11 = 0
+x /s 11 = 0
+x %s 11 = 0
+~x = ffffffffffffffff
+x & y = 0
+x | y = 52ce6b4000000063
+x ^ y = 52ce6b4000000063
+x << i = 0
+x >>u i = 0
+x >>s i = 0
+x cmpu y = lt
+x cmps y = lt
+utod x = 0
+dtou f = 0
+stod x = 0
+dtos f = 0
+utof x = 0
+stof x = 0
+
+x = 0
 y = 14057b7ef767814f
 -x = 0
 x + y = 14057b7ef767814f
@@ -755,6 +797,48 @@ utof x = 3f800000
 stof x = 3f800000
 
 x = 1
+y = 52ce6b4000000063
+-x = ffffffffffffffff
+x + y = 52ce6b4000000064
+x - y = ad3194bfffffff9e
+x * y = 52ce6b4000000063
+x /u y = 0
+x %u y = 1
+x /s y = 0
+x %s y = 1
+x /u y2 = 0
+x %u y2 = 1
+x /s y3 = 0
+x %s y3 = 1
+x /u 3 = 0
+x %u 3 = 1
+x /s 3 = 0
+x %s 3 = 1
+x /u 5 = 0
+x %u 5 = 1
+x /s 5 = 0
+x %s 5 = 1
+x /u 11 = 0
+x %u 11 = 1
+x /s 11 = 0
+x %s 11 = 1
+~x = fffffffffffffffe
+x & y = 1
+x | y = 52ce6b4000000063
+x ^ y = 52ce6b4000000062
+x << i = 800000000
+x >>u i = 0
+x >>s i = 0
+x cmpu y = lt
+x cmps y = lt
+utod x = 3ff0000000000000
+dtou f = 0
+stod x = 3ff0000000000000
+dtos f = 0
+utof x = 3f800000
+stof x = 3f800000
+
+x = 1
 y = 9af678222e728119
 -x = ffffffffffffffff
 x + y = 9af678222e72811a
@@ -1175,6 +1259,48 @@ utof x = 5f800000
 stof x = bf800000
 
 x = ffffffffffffffff
+y = 52ce6b4000000063
+-x = 1
+x + y = 52ce6b4000000062
+x - y = ad3194bfffffff9c
+x * y = ad3194bfffffff9d
+x /u y = 3
+x %u y = 794be3ffffffed6
+x /s y = 0
+x %s y = ffffffffffffffff
+x /u y2 = 3176fe836
+x %u y2 = 3683607f
+x /s y3 = 0
+x %s y3 = ffffffffffffffff
+x /u 3 = 5555555555555555
+x %u 3 = 0
+x /s 3 = 0
+x %s 3 = ffffffffffffffff
+x /u 5 = 3333333333333333
+x %u 5 = 0
+x /s 5 = 0
+x %s 5 = ffffffffffffffff
+x /u 11 = 1745d1745d1745d1
+x %u 11 = 4
+x /s 11 = 0
+x %s 11 = ffffffffffffffff
+~x = 0
+x & y = 52ce6b4000000063
+x | y = ffffffffffffffff
+x ^ y = ad3194bfffffff9c
+x << i = fffffff800000000
+x >>u i = 1fffffff
+x >>s i = ffffffffffffffff
+x cmpu y = gt
+x cmps y = lt
+utod x = 43f0000000000000
+dtou f = 68db8bac710cb
+stod x = bff0000000000000
+dtos f = 0
+utof x = 5f800000
+stof x = bf800000
+
+x = ffffffffffffffff
 y = 62354cda6226d1f3
 -x = 1
 x + y = 62354cda6226d1f2
@@ -1595,6 +1721,48 @@ utof x = 4f000000
 stof x = 4f000000
 
 x = 7fffffff
+y = 52ce6b4000000063
+-x = ffffffff80000001
+x + y = 52ce6b4080000062
+x - y = ad3194c07fffff9c
+x * y = ad3194f17fffff9d
+x /u y = 0
+x %u y = 7fffffff
+x /s y = 0
+x %s y = 7fffffff
+x /u y2 = 1
+x %u y2 = 2d3194bf
+x /s y3 = 1
+x %s y3 = 2d3194bf
+x /u 3 = 2aaaaaaa
+x %u 3 = 1
+x /s 3 = 2aaaaaaa
+x %s 3 = 1
+x /u 5 = 19999999
+x %u 5 = 2
+x /s 5 = 19999999
+x %s 5 = 2
+x /u 11 = ba2e8ba
+x %u 11 = 1
+x /s 11 = ba2e8ba
+x %s 11 = 1
+~x = ffffffff80000000
+x & y = 63
+x | y = 52ce6b407fffffff
+x ^ y = 52ce6b407fffff9c
+x << i = fffffff800000000
+x >>u i = 0
+x >>s i = 0
+x cmpu y = lt
+x cmps y = lt
+utod x = 41dfffffffc00000
+dtou f = 346dc
+stod x = 41dfffffffc00000
+dtos f = 346dc
+utof x = 4f000000
+stof x = 4f000000
+
+x = 7fffffff
 y = 144093704fadba5d
 -x = ffffffff80000001
 x + y = 14409370cfadba5c
@@ -2015,6 +2183,48 @@ utof x = 4f000000
 stof x = 4f000000
 
 x = 80000000
+y = 52ce6b4000000063
+-x = ffffffff80000000
+x + y = 52ce6b4080000063
+x - y = ad3194c07fffff9d
+x * y = 3180000000
+x /u y = 0
+x %u y = 80000000
+x /s y = 0
+x %s y = 80000000
+x /u y2 = 1
+x %u y2 = 2d3194c0
+x /s y3 = 1
+x %s y3 = 2d3194c0
+x /u 3 = 2aaaaaaa
+x %u 3 = 2
+x /s 3 = 2aaaaaaa
+x %s 3 = 2
+x /u 5 = 19999999
+x %u 5 = 3
+x /s 5 = 19999999
+x %s 5 = 3
+x /u 11 = ba2e8ba
+x %u 11 = 2
+x /s 11 = ba2e8ba
+x %s 11 = 2
+~x = ffffffff7fffffff
+x & y = 0
+x | y = 52ce6b4080000063
+x ^ y = 52ce6b4080000063
+x << i = 0
+x >>u i = 0
+x >>s i = 0
+x cmpu y = lt
+x cmps y = lt
+utod x = 41e0000000000000
+dtou f = 346dc
+stod x = 41e0000000000000
+dtos f = 346dc
+utof x = 4f000000
+stof x = 4f000000
+
+x = 80000000
 y = 7b985bc1e7bce4d7
 -x = ffffffff80000000
 x + y = 7b985bc267bce4d7
@@ -2435,6 +2645,48 @@ utof x = 5f000000
 stof x = 5f000000
 
 x = 7fffffffffffffff
+y = 52ce6b4000000063
+-x = 8000000000000001
+x + y = d2ce6b4000000062
+x - y = 2d3194bfffffff9c
+x * y = 2d3194bfffffff9d
+x /u y = 1
+x %u y = 2d3194bfffffff9c
+x /s y = 1
+x %s y = 2d3194bfffffff9c
+x /u y2 = 18bb7f41b
+x %u y2 = 1b41b03f
+x /s y3 = 18bb7f41b
+x %s y3 = 1b41b03f
+x /u 3 = 2aaaaaaaaaaaaaaa
+x %u 3 = 1
+x /s 3 = 2aaaaaaaaaaaaaaa
+x %s 3 = 1
+x /u 5 = 1999999999999999
+x %u 5 = 2
+x /s 5 = 1999999999999999
+x %s 5 = 2
+x /u 11 = ba2e8ba2e8ba2e8
+x %u 11 = 7
+x /s 11 = ba2e8ba2e8ba2e8
+x %s 11 = 7
+~x = 8000000000000000
+x & y = 52ce6b4000000063
+x | y = 7fffffffffffffff
+x ^ y = 2d3194bfffffff9c
+x << i = fffffff800000000
+x >>u i = fffffff
+x >>s i = fffffff
+x cmpu y = gt
+x cmps y = gt
+utod x = 43e0000000000000
+dtou f = 346dc5d638865
+stod x = 43e0000000000000
+dtos f = 346dc5d638865
+utof x = 5f000000
+stof x = 5f000000
+
+x = 7fffffffffffffff
 y = a220229ec164ffe1
 -x = 8000000000000001
 x + y = 2220229ec164ffe0
@@ -2855,6 +3107,48 @@ utof x = 5f000000
 stof x = df000000
 
 x = 8000000000000000
+y = 52ce6b4000000063
+-x = 8000000000000000
+x + y = d2ce6b4000000063
+x - y = 2d3194bfffffff9d
+x * y = 8000000000000000
+x /u y = 1
+x %u y = 2d3194bfffffff9d
+x /s y = ffffffffffffffff
+x %s y = d2ce6b4000000063
+x /u y2 = 18bb7f41b
+x %u y2 = 1b41b040
+x /s y3 = fffffffe74480be5
+x %s y3 = ffffffffe4be4fc0
+x /u 3 = 2aaaaaaaaaaaaaaa
+x %u 3 = 2
+x /s 3 = d555555555555556
+x %s 3 = fffffffffffffffe
+x /u 5 = 1999999999999999
+x %u 5 = 3
+x /s 5 = e666666666666667
+x %s 5 = fffffffffffffffd
+x /u 11 = ba2e8ba2e8ba2e8
+x %u 11 = 8
+x /s 11 = f45d1745d1745d18
+x %s 11 = fffffffffffffff8
+~x = 7fffffffffffffff
+x & y = 0
+x | y = d2ce6b4000000063
+x ^ y = d2ce6b4000000063
+x << i = 0
+x >>u i = 10000000
+x >>s i = fffffffff0000000
+x cmpu y = gt
+x cmps y = lt
+utod x = 43e0000000000000
+dtou f = 346dc5d638865
+stod x = c3e0000000000000
+dtos f = fffcb923a29c779b
+utof x = 5f000000
+stof x = df000000
+
+x = 8000000000000000
 y = c73aa0d9a415dfb
 -x = 8000000000000000
 x + y = 8c73aa0d9a415dfb
@@ -3275,6 +3569,48 @@ utof x = 4f800000
 stof x = 4f800000
 
 x = 100000003
+y = 52ce6b4000000063
+-x = fffffffefffffffd
+x + y = 52ce6b4100000066
+x - y = ad3194c0ffffffa0
+x * y = f86b422300000129
+x /u y = 0
+x %u y = 100000003
+x /s y = 0
+x %s y = 100000003
+x /u y2 = 3
+x %u y2 = 794be43
+x /s y3 = 3
+x %s y3 = 794be43
+x /u 3 = 55555556
+x %u 3 = 1
+x /s 3 = 55555556
+x %s 3 = 1
+x /u 5 = 33333333
+x %u 5 = 4
+x /s 5 = 33333333
+x %s 5 = 4
+x /u 11 = 1745d174
+x %u 11 = 7
+x /s 11 = 1745d174
+x %s 11 = 7
+~x = fffffffefffffffc
+x & y = 3
+x | y = 52ce6b4100000063
+x ^ y = 52ce6b4100000060
+x << i = 1800000000
+x >>u i = 0
+x >>s i = 0
+x cmpu y = lt
+x cmps y = lt
+utod x = 41f0000000300000
+dtou f = 68db8
+stod x = 41f0000000300000
+dtos f = 68db8
+utof x = 4f800000
+stof x = 4f800000
+
+x = 100000003
 y = e9bcd26890f095a5
 -x = fffffffefffffffd
 x + y = e9bcd26990f095a8
@@ -3358,47 +3694,467 @@ dtos f = 14bb101261e18
 utof x = 5e4a72c9
 stof x = 5e4a72c9
 
-x = 8362aa9340fe215f
-y = f986342416ec8002
--x = 7c9d556cbf01dea1
-x + y = 7ce8deb757eaa161
-x - y = 89dc766f2a11a15d
-x * y = e4a2b426803fc2be
+x = 52ce6b4000000063
+y = 0
+-x = ad3194bfffffff9d
+x + y = 52ce6b4000000063
+x - y = 52ce6b4000000063
+x * y = 0
 x /u y = 0
-x %u y = 8362aa9340fe215f
-x /s y = 13
-x %s y = fe6ccbe58d70a139
-x /u y2 = 86cb918b
-x %u y2 = 910b6dd3
-x /s y3 = 133e437097
-x %s y3 = fffffffffe99a023
-x /u 3 = 2bcb8e3115aa0b1f
-x %u 3 = 2
-x /s 3 = d67638dbc054b5cb
-x %s 3 = fffffffffffffffe
-x /u 5 = 1a46eeea4032d379
-x %u 5 = 2
-x /s 5 = e713bbb70cffa047
-x %s 5 = fffffffffffffffc
-x /u 11 = bf1b26a7a45a5f1
-x %u 11 = 4
-x /s 11 = f4abe0f61d2e6020
-x %s 11 = ffffffffffffffff
-~x = 7c9d556cbf01dea0
-x & y = 8102200000ec0002
-x | y = fbe6beb756fea15f
-x ^ y = 7ae49eb75612a15d
-x << i = d8aaa4d03f8857c
-x >>u i = 20d8aaa4d03f8857
-x >>s i = e0d8aaa4d03f8857
+x %u y = 0
+x /s y = 0
+x %s y = 0
+x /u y2 = 0
+x %u y2 = 0
+x /s y3 = 0
+x %s y3 = 0
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 0
+x | y = 52ce6b4000000063
+x ^ y = 52ce6b4000000063
+x << i = 52ce6b4000000063
+x >>u i = 52ce6b4000000063
+x >>s i = 52ce6b4000000063
+x cmpu y = gt
+x cmps y = gt
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = 52ce6b4000000063
+y = 1
+-x = ad3194bfffffff9d
+x + y = 52ce6b4000000064
+x - y = 52ce6b4000000062
+x * y = 52ce6b4000000063
+x /u y = 52ce6b4000000063
+x %u y = 0
+x /s y = 52ce6b4000000063
+x %s y = 0
+x /u y2 = 0
+x %u y2 = 0
+x /s y3 = 0
+x %s y3 = 0
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 1
+x | y = 52ce6b4000000063
+x ^ y = 52ce6b4000000062
+x << i = a59cd680000000c6
+x >>u i = 296735a000000031
+x >>s i = 296735a000000031
+x cmpu y = gt
+x cmps y = gt
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = 52ce6b4000000063
+y = ffffffffffffffff
+-x = ad3194bfffffff9d
+x + y = 52ce6b4000000062
+x - y = 52ce6b4000000064
+x * y = ad3194bfffffff9d
+x /u y = 0
+x %u y = 52ce6b4000000063
+x /s y = ad3194bfffffff9d
+x %s y = 0
+x /u y2 = 52ce6b40
+x %u y2 = 52ce6ba3
+x /s y3 = ad3194bfffffff9d
+x %s y3 = 0
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 52ce6b4000000063
+x | y = ffffffffffffffff
+x ^ y = ad3194bfffffff9c
+x << i = 8000000000000000
+x >>u i = 0
+x >>s i = 0
+x cmpu y = lt
+x cmps y = gt
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = 52ce6b4000000063
+y = 7fffffff
+-x = ad3194bfffffff9d
+x + y = 52ce6b4080000062
+x - y = 52ce6b3f80000064
+x * y = ad3194f17fffff9d
+x /u y = a59cd681
+x %u y = 259cd6e4
+x /s y = a59cd681
+x %s y = 259cd6e4
+x /u y2 = 0
+x %u y2 = 0
+x /s y3 = 0
+x %s y3 = 0
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 63
+x | y = 52ce6b407fffffff
+x ^ y = 52ce6b407fffff9c
+x << i = 8000000000000000
+x >>u i = 0
+x >>s i = 0
+x cmpu y = gt
+x cmps y = gt
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = 52ce6b4000000063
+y = 80000000
+-x = ad3194bfffffff9d
+x + y = 52ce6b4080000063
+x - y = 52ce6b3f80000063
+x * y = 3180000000
+x /u y = a59cd680
+x %u y = 63
+x /s y = a59cd680
+x %s y = 63
+x /u y2 = 0
+x %u y2 = 0
+x /s y3 = 0
+x %s y3 = 0
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 0
+x | y = 52ce6b4080000063
+x ^ y = 52ce6b4080000063
+x << i = 52ce6b4000000063
+x >>u i = 52ce6b4000000063
+x >>s i = 52ce6b4000000063
+x cmpu y = gt
+x cmps y = gt
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = 52ce6b4000000063
+y = 7fffffffffffffff
+-x = ad3194bfffffff9d
+x + y = d2ce6b4000000062
+x - y = d2ce6b4000000064
+x * y = 2d3194bfffffff9d
+x /u y = 0
+x %u y = 52ce6b4000000063
+x /s y = 0
+x %s y = 52ce6b4000000063
+x /u y2 = a59cd681
+x %u y2 = 259cd6e4
+x /s y3 = a59cd681
+x %s y3 = 259cd6e4
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 52ce6b4000000063
+x | y = 7fffffffffffffff
+x ^ y = 2d3194bfffffff9c
+x << i = 8000000000000000
+x >>u i = 0
+x >>s i = 0
 x cmpu y = lt
 x cmps y = lt
-utod x = 43e06c5552681fc4
-dtou f = 35d0c262d14d7
-stod x = c3df27555b2fc078
-dtos f = fffccf536b66040d
-utof x = 5f0362ab
-stof x = def93aab
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = 52ce6b4000000063
+y = 8000000000000000
+-x = ad3194bfffffff9d
+x + y = d2ce6b4000000063
+x - y = d2ce6b4000000063
+x * y = 8000000000000000
+x /u y = 0
+x %u y = 52ce6b4000000063
+x /s y = 0
+x %s y = 52ce6b4000000063
+x /u y2 = a59cd680
+x %u y2 = 63
+x /s y3 = ffffffff5a632980
+x %s y3 = 63
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 0
+x | y = d2ce6b4000000063
+x ^ y = d2ce6b4000000063
+x << i = 52ce6b4000000063
+x >>u i = 52ce6b4000000063
+x >>s i = 52ce6b4000000063
+x cmpu y = lt
+x cmps y = gt
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = 52ce6b4000000063
+y = 100000003
+-x = ad3194bfffffff9d
+x + y = 52ce6b4100000066
+x - y = 52ce6b3f00000060
+x * y = f86b422300000129
+x /u y = 52ce6b3f
+x %u y = 794bea6
+x /s y = 52ce6b3f
+x %s y = 794bea6
+x /u y2 = 52ce6b4000000063
+x %u y2 = 0
+x /s y3 = 52ce6b4000000063
+x %s y3 = 0
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 3
+x | y = 52ce6b4100000063
+x ^ y = 52ce6b4100000060
+x << i = 96735a0000000318
+x >>u i = a59cd680000000c
+x >>s i = a59cd680000000c
+x cmpu y = gt
+x cmps y = gt
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = 52ce6b4000000063
+y = 52ce6b4000000063
+-x = ad3194bfffffff9d
+x + y = a59cd680000000c6
+x - y = 0
+x * y = ba6f38000002649
+x /u y = 1
+x %u y = 0
+x /s y = 1
+x %s y = 0
+x /u y2 = 100000000
+x %u y2 = 63
+x /s y3 = 100000000
+x %s y3 = 63
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 52ce6b4000000063
+x | y = 52ce6b4000000063
+x ^ y = 0
+x << i = 31800000000
+x >>u i = a59cd68
+x >>s i = a59cd68
+x cmpu y = eq
+x cmps y = eq
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = 52ce6b4000000063
+y = 8362aa9340fe215f
+-x = ad3194bfffffff9d
+x + y = d63115d340fe21c2
+x - y = cf6bc0acbf01df04
+x * y = 8f1503b22246e7bd
+x /u y = 0
+x %u y = 52ce6b4000000063
+x /s y = 0
+x %s y = 52ce6b4000000063
+x /u y2 = a158656f
+x %u y2 = 5640ba6
+x /s y3 = ffffffff55e35d11
+x %s y3 = 5f2245a0
+x /u 3 = 1b9a23c000000021
+x %u 3 = 0
+x /s 3 = 1b9a23c000000021
+x %s 3 = 0
+x /u 5 = 108faf0ccccccce0
+x %u 5 = 3
+x /s 5 = 108faf0ccccccce0
+x %s 5 = 3
+x /u 11 = 7872105d1745d20
+x %u 11 = 3
+x /s 11 = 7872105d1745d20
+x %s 11 = 3
+~x = ad3194bfffffff9c
+x & y = 2422a0000000043
+x | y = d3eeebd340fe217f
+x ^ y = d1acc1d340fe213c
+x << i = 3180000000
+x >>u i = a59cd680
+x >>s i = a59cd680
+x cmpu y = lt
+x cmps y = gt
+utod x = 43d4b39ad0000000
+dtou f = 21eadf559b3d0
+stod x = 43d4b39ad0000000
+dtos f = 21eadf559b3d0
+utof x = 5ea59cd7
+stof x = 5ea59cd7
+
+x = f986342416ec8002
+y = 52ce6b4000000063
+-x = 679cbdbe9137ffe
+x + y = 4c549f6416ec8065
+x - y = a6b7c8e416ec7f9f
+x * y = b9230074dd7580c6
+x /u y = 3
+x %u y = 11af26416ec7ed9
+x /s y = 0
+x %s y = f986342416ec8002
+x /u y2 = 3036abea3
+x %u y2 = 164b642
+x /s y3 = ffffffffebfad66d
+x %s y3 = ffffffffcae155c2
+x /u 3 = 532cbc0c07a42aab
+x %u 3 = 1
+x /s 3 = fdd766b6b24ed556
+x %s 3 = 0
+x /u 5 = 31e7a40737c8e666
+x %u 5 = 4
+x /s 5 = feb470d40495b334
+x %s 5 = fffffffffffffffe
+x /u 11 = 16af1c0347e6f45d
+x %u 11 = 3
+x /s 11 = ff694a8eeacfae8c
+x %s 11 = fffffffffffffffe
+~x = 679cbdbe9137ffd
+x & y = 5086200000000002
+x | y = fbce7f6416ec8063
+x ^ y = ab485f6416ec8061
+x << i = b764001000000000
+x >>u i = 1f30c684
+x >>s i = ffffffffff30c684
+x cmpu y = gt
+x cmps y = lt
+utod x = 43ef30c68482dd90
+dtou f = 6634832136daf
+stod x = c399e72f6fa44e00
+dtos f = ffffd58f774c5ce4
+utof x = 5f798634
+stof x = dccf397b
 
 x = 368083376ba4ffa9
 y = 6912b247b79a4904
@@ -7558,3 +8314,45 @@ dtos f = b3fdf698d581
 utof x = 5ddbb784
 stof x = 5ddbb784
 
+x = ca9a47c1649d27a7
+y = d56d650045e652aa
+-x = 3565b83e9b62d859
+x + y = a007acc1aa837a51
+x - y = f52ce2c11eb6d4fd
+x * y = 630e3c88ca19d2e6
+x /u y = 0
+x %u y = ca9a47c1649d27a7
+x /s y = 1
+x %s y = f52ce2c11eb6d4fd
+x /u y2 = f3042098
+x %u y2 = 6b092fa7
+x /s y3 = 141176486
+x %s y3 = ffffffffdee649a7
+x /u 3 = 4388c295cc34628d
+x %u 3 = 0
+x /s 3 = ee336d4076df0d38
+x %s 3 = ffffffffffffffff
+x /u 5 = 2885418d141f6e54
+x %u 5 = 3
+x /s 5 = f5520e59e0ec3b22
+x %s 5 = fffffffffffffffd
+x /u 11 = 126b1dcbc3541ae0
+x %u 11 = 7
+x /s 11 = fb254c57663cd510
+x %s 11 = fffffffffffffff7
+~x = 3565b83e9b62d858
+x & y = c0084500448402a2
+x | y = dfff67c165ff77af
+x ^ y = 1ff722c1217b750d
+x << i = 749e9c0000000000
+x >>u i = 32a691
+x >>s i = fffffffffff2a691
+x cmpu y = lt
+x cmps y = lt
+utod x = 43e95348f82c93a5
+dtou f = 52fc6dac31674
+stod x = c3cab2dc1f4db16c
+dtos f = fffea20e1ffc05aa
+utof x = 5f4a9a48
+stof x = de5596e1
+
diff --git a/test/regression/Results/interop1 b/test/regression/Results/interop1
index 990dfe9d..6e32c1cb 100644
--- a/test/regression/Results/interop1
+++ b/test/regression/Results/interop1
@@ -1,4 +1,8 @@
 --- CompCert calling native:
+si8u: 177
+si8s: -79
+si16u: 64305
+si16s: -1231
 s1: { a = 'a' }
 s2: { a = 'a', b = 'b' }
 s3: { a = 'a', b = 'b', c = ' c' }
@@ -44,6 +48,10 @@ ru6: { a = 55555, b = 666 }
 ru7: { a = -10001, b = -789, c = 'z' }
 ru8: { a = 'x', b = 12345 }
 --- native calling CompCert:
+si8u: 177
+si8s: -79
+si16u: 64305
+si16s: -1231
 s1: { a = 'a' }
 s2: { a = 'a', b = 'b' }
 s3: { a = 'a', b = 'b', c = ' c' }
diff --git a/test/regression/builtins-aarch64.c b/test/regression/builtins-aarch64.c
new file mode 100644
index 00000000..2cfa2d09
--- /dev/null
+++ b/test/regression/builtins-aarch64.c
@@ -0,0 +1,47 @@
+/* Fun with builtin functions */
+
+#include <stdio.h>
+
+int main(int argc, char ** argv)
+{
+  unsigned int x = 0x12345678;
+  unsigned int y = 0xDEADBEEF;
+  unsigned long long xx = 0x1234567812345678ULL;
+  unsigned long long yy = 0x1234567800000000ULL;
+  unsigned long long zz = 0x123456789ABCDEF0ULL;
+  unsigned z;
+  double a = 3.14159;
+  double b = 2.718;
+  double c = 1.414;
+  unsigned short s = 0x1234;
+  signed int u = 1234567;
+  signed int v = -9999;
+
+  printf("bswap(%x) = %x\n", x, __builtin_bswap(x));
+  printf("bswap16(%x) = %x\n", s, __builtin_bswap16(s));
+  printf("bswap64(%llx) = %llx\n", zz, __builtin_bswap64(zz));
+  printf("clz(%x) = %d\n", x, __builtin_clz(x));
+  printf("clzll(%llx) = %d\n", (unsigned long long) x, __builtin_clzll(x));
+  printf("clzll(%llx) = %d\n", xx, __builtin_clzll(xx));
+  printf("cls(%d) = %d\n", u, __builtin_cls(u));
+  printf("cls(%d) = %d\n", v, __builtin_cls(v));
+  printf("clsll(%lld) = %d\n", (signed long long) u, __builtin_clsll(u));
+  printf("clsll(%lld) = %d\n", (signed long long) v, __builtin_clsll(v));
+
+  printf("fsqrt(%f) = %f\n", a, __builtin_fsqrt(a));
+  printf("fmadd(%f, %f, %f) = %f\n", a, b, c, __builtin_fmadd(a, b, c));
+  printf("fmsub(%f, %f, %f) = %f\n", a, b, c, __builtin_fmsub(a, b, c));
+  printf("fnmadd(%f, %f, %f) = %f\n", a, b, c, __builtin_fnmadd(a, b, c));
+  printf("fnmsub(%f, %f, %f) = %f\n", a, b, c, __builtin_fnmsub(a, b, c));
+
+  /* Make sure that ignoring the result of a builtin
+     doesn't cause an internal error */
+  (void) __builtin_bswap(x);
+  (void) __builtin_fsqrt(a);
+  return 0;
+}
+
+
+  
+
+
diff --git a/test/regression/builtins-arm.c b/test/regression/builtins-arm.c
index 709343ce..d06e8e5e 100644
--- a/test/regression/builtins-arm.c
+++ b/test/regression/builtins-arm.c
@@ -2,14 +2,15 @@
 
 #include <stdio.h>
 
+unsigned int x = 0x12345678;
+unsigned int y = 0xDEADBEEF;
+unsigned long long xx = 0x1234567812345678ULL;
+double a = 3.14159;
+unsigned short s = 0x1234;
+
 int main(int argc, char ** argv)
 {
-  unsigned int x = 0x12345678;
-  unsigned int y = 0xDEADBEEF;
-  unsigned long long xx = 0x1234567812345678ULL;
   unsigned z;
-  double a = 3.14159;
-  unsigned short s = 0x1234;
 
   printf("bswap(%x) = %x\n", x, __builtin_bswap(x));
   printf("bswap16(%x) = %x\n", s, __builtin_bswap16(s));
diff --git a/test/regression/builtins-powerpc.c b/test/regression/builtins-powerpc.c
index 23e9d191..8fd5818b 100644
--- a/test/regression/builtins-powerpc.c
+++ b/test/regression/builtins-powerpc.c
@@ -9,16 +9,17 @@ char * check_relative_error(double exact, double actual, double precision)
   return fabs(relative_error) <= precision ? "OK" : "ERROR";
 }
 
+unsigned int x = 0x12345678;
+unsigned int y = 0xDEADBEEF;
+unsigned long long xx = 0x1234567812345678ULL;
+double a = 3.14159;
+double b = 2.718;
+double c = 1.414;
+unsigned short s = 0x1234;
+
 int main(int argc, char ** argv)
 {
-  unsigned int x = 0x12345678;
-  unsigned int y = 0xDEADBEEF;
-  unsigned long long xx = 0x1234567812345678ULL;
   unsigned z;
-  double a = 3.14159;
-  double b = 2.718;
-  double c = 1.414;
-  unsigned short s = 0x1234;
 
   printf("mulhw(%x, %x) = %x\n", x, y, __builtin_mulhw(x, y));
   printf("mulhwu(%x, %x) = %x\n", x, y, __builtin_mulhwu(x, y));
diff --git a/test/regression/builtins-riscV.c b/test/regression/builtins-riscV.c
index a302a6c4..c34fdf2c 100644
--- a/test/regression/builtins-riscV.c
+++ b/test/regression/builtins-riscV.c
@@ -2,15 +2,15 @@
 
 #include <stdio.h>
 
+unsigned int x = 0x12345678;
+unsigned short s = 0x1234;
+unsigned long long zz = 0x123456789ABCDEF0ULL;
+double a = 3.14159;
+double b = 2.718;
+double c = 1.414;
+
 int main(int argc, char ** argv)
 {
-  unsigned int x = 0x12345678;
-  unsigned short s = 0x1234;
-  unsigned long long zz = 0x123456789ABCDEF0ULL;
-  double a = 3.14159;
-  double b = 2.718;
-  double c = 1.414;
-
   printf("bswap16(%x) = %x\n", s, __builtin_bswap16(s));
   printf("bswap32(%x) = %x\n", x, __builtin_bswap32(x));
   printf("bswap64(%llx) = %llx\n", zz, __builtin_bswap64(zz));
diff --git a/test/regression/builtins-x86.c b/test/regression/builtins-x86.c
index 1ba213e7..6233f9fd 100644
--- a/test/regression/builtins-x86.c
+++ b/test/regression/builtins-x86.c
@@ -2,18 +2,19 @@
 
 #include <stdio.h>
 
+unsigned int x = 0x12345678;
+unsigned int y = 0xDEADBEEF;
+unsigned long long xx = 0x1234567812345678ULL;
+unsigned long long yy = 0x1234567800000000ULL;
+unsigned long long zz = 0x123456789ABCDEF0ULL;
+double a = 3.14159;
+double b = 2.718;
+double c = 1.414;
+unsigned short s = 0x1234;
+
 int main(int argc, char ** argv)
 {
-  unsigned int x = 0x12345678;
-  unsigned int y = 0xDEADBEEF;
-  unsigned long long xx = 0x1234567812345678ULL;
-  unsigned long long yy = 0x1234567800000000ULL;
-  unsigned long long zz = 0x123456789ABCDEF0ULL;
   unsigned z;
-  double a = 3.14159;
-  double b = 2.718;
-  double c = 1.414;
-  unsigned short s = 0x1234;
 
   printf("bswap(%x) = %x\n", x, __builtin_bswap(x));
   printf("bswap16(%x) = %x\n", s, __builtin_bswap16(s));
diff --git a/test/regression/extasm.c b/test/regression/extasm.c
index babc57f1..297178d1 100644
--- a/test/regression/extasm.c
+++ b/test/regression/extasm.c
@@ -5,14 +5,16 @@ int clobbers(int x, int z)
 {
   int y;
   asm("TEST0 out:%0 in:%1" : "=r"(y) : "r"(x) : "cc"
-#if defined(__x86_64__)
+#if defined(ARCH_x86) && defined(MODEL_64)
       , "rax", "rdx", "rbx"
-#elif defined(__i386__)
+#elif defined(ARCH_x86) && !defined(MODEL_64)
       , "eax", "edx", "ebx"
-#elif defined(__arm__)
+#elif defined(ARCH_arm)
       , "r0", "r1", "r4"
-#elif defined(__PPC__)
+#elif defined(ARCH_powerpc)
       , "r0", "r3", "r4", "r31"
+#elif defined(ARCH_aarch64)
+      , "x0", "x1", "x16", "x29", "x30"
 #endif
 );
   return y + z;
@@ -21,7 +23,8 @@ int clobbers(int x, int z)
 #if (defined(ARCH_x86) && defined(MODEL_64)) \
  || (defined(ARCH_riscV) && defined(MODEL_64)) \
  || (defined(ARCH_powerpc) && defined(MODEL_ppc64)) \
- || (defined(ARCH_powerpc) && defined(MODEL_e5500))
+ || (defined(ARCH_powerpc) && defined(MODEL_e5500)) \
+ || defined(ARCH_aarch64)
 #define SIXTYFOUR
 #else
 #undef SIXTYFOUR
@@ -33,6 +36,7 @@ int main()
   void * y;
   long long z;
   double f;
+  float sf;
   char c[16];
 
   /* No inputs, no outputs */
@@ -72,6 +76,15 @@ int main()
 #ifdef FAILURES
   asm("FAIL4 a:%[a]" : "=r"(x) : [z]"i"(0));
 #endif
+  /* One argument of each type */
+  asm("TEST15 int32 %0" : : "r" (x));
+#ifdef SIXTYFOUR
+  asm("TEST15 int64 %0" : : "r" (z));
+#else
+  asm("TEST15 int64 %Q0 / %R0" : : "r" (z));
+#endif
+  asm("TEST15 float64 %0" : : "r" (f));
+  asm("TEST15 float32 %0" : : "r" (sf));
   /* Various failures */
 #ifdef FAILURES
   asm("FAIL5 out:%0,%1" : "=r"(x), "=r"(y));
diff --git a/test/regression/floats-basics.c b/test/regression/floats-basics.c
index a7ba3623..876a0d42 100644
--- a/test/regression/floats-basics.c
+++ b/test/regression/floats-basics.c
@@ -1,18 +1,10 @@
-#include<stdio.h>
-#include<stdlib.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "../endian.h"
 
 #define STR_EXPAND(tok) #tok
 #define STR(tok) STR_EXPAND(tok)
 
-#if defined(__ppc__) || defined(__PPC__) || defined(__ARMEB__)
-#define ARCH_BIG_ENDIAN
-#elif defined(__i386__) || defined(__x86_64__) || defined(__ARMEL__) \
-   || defined(__riscv)
-#undef ARCH_BIG_ENDIAN
-#else
-#error "unknown endianness"
-#endif
-
 union converter64 {
   double dbl;
   struct {
diff --git a/test/regression/floats-lit.c b/test/regression/floats-lit.c
new file mode 100644
index 00000000..a1098faf
--- /dev/null
+++ b/test/regression/floats-lit.c
@@ -0,0 +1,559 @@
+#include <stdio.h>
+
+int error = 0;
+
+void dbl(double x, unsigned long long bits)
+{
+  union { double d; unsigned long long i; } u;
+  u.d = x;
+  if (u.i != bits) {
+    printf("Error: expected 0x%016llx, got 0x%016llx\n", bits, u.i);
+    error = 1;
+  }
+}
+
+void sng(float x, unsigned int bits)
+{
+  union { float f; unsigned int i; } u;
+  u.f = x;
+  if (u.i != bits) {
+    printf("Error: expected 0x%08x, got 0x%08x\n", bits, u.i);
+    error = 1;
+  }
+}
+
+void testdbl(void)
+{
+  printf("--- Double-precision test\n");
+  dbl(0.0, 0ULL);
+  dbl((-0.0), 0x8000000000000000ULL);
+  // The following are the "fmov immediate" of aarch64
+  // They include +1.0 and -1.0
+  dbl(0x1p-3, 0x3fc0000000000000ULL);
+  dbl(0x1.1p-3, 0x3fc1000000000000ULL);
+  dbl(0x1.2p-3, 0x3fc2000000000000ULL);
+  dbl(0x1.3p-3, 0x3fc3000000000000ULL);
+  dbl(0x1.4p-3, 0x3fc4000000000000ULL);
+  dbl(0x1.5p-3, 0x3fc5000000000000ULL);
+  dbl(0x1.6p-3, 0x3fc6000000000000ULL);
+  dbl(0x1.7p-3, 0x3fc7000000000000ULL);
+  dbl(0x1.8p-3, 0x3fc8000000000000ULL);
+  dbl(0x1.9p-3, 0x3fc9000000000000ULL);
+  dbl(0x1.ap-3, 0x3fca000000000000ULL);
+  dbl(0x1.bp-3, 0x3fcb000000000000ULL);
+  dbl(0x1.cp-3, 0x3fcc000000000000ULL);
+  dbl(0x1.dp-3, 0x3fcd000000000000ULL);
+  dbl(0x1.ep-3, 0x3fce000000000000ULL);
+  dbl(0x1.fp-3, 0x3fcf000000000000ULL);
+  dbl(0x1p-2, 0x3fd0000000000000ULL);
+  dbl(0x1.1p-2, 0x3fd1000000000000ULL);
+  dbl(0x1.2p-2, 0x3fd2000000000000ULL);
+  dbl(0x1.3p-2, 0x3fd3000000000000ULL);
+  dbl(0x1.4p-2, 0x3fd4000000000000ULL);
+  dbl(0x1.5p-2, 0x3fd5000000000000ULL);
+  dbl(0x1.6p-2, 0x3fd6000000000000ULL);
+  dbl(0x1.7p-2, 0x3fd7000000000000ULL);
+  dbl(0x1.8p-2, 0x3fd8000000000000ULL);
+  dbl(0x1.9p-2, 0x3fd9000000000000ULL);
+  dbl(0x1.ap-2, 0x3fda000000000000ULL);
+  dbl(0x1.bp-2, 0x3fdb000000000000ULL);
+  dbl(0x1.cp-2, 0x3fdc000000000000ULL);
+  dbl(0x1.dp-2, 0x3fdd000000000000ULL);
+  dbl(0x1.ep-2, 0x3fde000000000000ULL);
+  dbl(0x1.fp-2, 0x3fdf000000000000ULL);
+  dbl(0x1p-1, 0x3fe0000000000000ULL);
+  dbl(0x1.1p-1, 0x3fe1000000000000ULL);
+  dbl(0x1.2p-1, 0x3fe2000000000000ULL);
+  dbl(0x1.3p-1, 0x3fe3000000000000ULL);
+  dbl(0x1.4p-1, 0x3fe4000000000000ULL);
+  dbl(0x1.5p-1, 0x3fe5000000000000ULL);
+  dbl(0x1.6p-1, 0x3fe6000000000000ULL);
+  dbl(0x1.7p-1, 0x3fe7000000000000ULL);
+  dbl(0x1.8p-1, 0x3fe8000000000000ULL);
+  dbl(0x1.9p-1, 0x3fe9000000000000ULL);
+  dbl(0x1.ap-1, 0x3fea000000000000ULL);
+  dbl(0x1.bp-1, 0x3feb000000000000ULL);
+  dbl(0x1.cp-1, 0x3fec000000000000ULL);
+  dbl(0x1.dp-1, 0x3fed000000000000ULL);
+  dbl(0x1.ep-1, 0x3fee000000000000ULL);
+  dbl(0x1.fp-1, 0x3fef000000000000ULL);
+  dbl(0x1p+0, 0x3ff0000000000000ULL);
+  dbl(0x1.1p+0, 0x3ff1000000000000ULL);
+  dbl(0x1.2p+0, 0x3ff2000000000000ULL);
+  dbl(0x1.3p+0, 0x3ff3000000000000ULL);
+  dbl(0x1.4p+0, 0x3ff4000000000000ULL);
+  dbl(0x1.5p+0, 0x3ff5000000000000ULL);
+  dbl(0x1.6p+0, 0x3ff6000000000000ULL);
+  dbl(0x1.7p+0, 0x3ff7000000000000ULL);
+  dbl(0x1.8p+0, 0x3ff8000000000000ULL);
+  dbl(0x1.9p+0, 0x3ff9000000000000ULL);
+  dbl(0x1.ap+0, 0x3ffa000000000000ULL);
+  dbl(0x1.bp+0, 0x3ffb000000000000ULL);
+  dbl(0x1.cp+0, 0x3ffc000000000000ULL);
+  dbl(0x1.dp+0, 0x3ffd000000000000ULL);
+  dbl(0x1.ep+0, 0x3ffe000000000000ULL);
+  dbl(0x1.fp+0, 0x3fff000000000000ULL);
+  dbl(0x1p+1, 0x4000000000000000ULL);
+  dbl(0x1.1p+1, 0x4001000000000000ULL);
+  dbl(0x1.2p+1, 0x4002000000000000ULL);
+  dbl(0x1.3p+1, 0x4003000000000000ULL);
+  dbl(0x1.4p+1, 0x4004000000000000ULL);
+  dbl(0x1.5p+1, 0x4005000000000000ULL);
+  dbl(0x1.6p+1, 0x4006000000000000ULL);
+  dbl(0x1.7p+1, 0x4007000000000000ULL);
+  dbl(0x1.8p+1, 0x4008000000000000ULL);
+  dbl(0x1.9p+1, 0x4009000000000000ULL);
+  dbl(0x1.ap+1, 0x400a000000000000ULL);
+  dbl(0x1.bp+1, 0x400b000000000000ULL);
+  dbl(0x1.cp+1, 0x400c000000000000ULL);
+  dbl(0x1.dp+1, 0x400d000000000000ULL);
+  dbl(0x1.ep+1, 0x400e000000000000ULL);
+  dbl(0x1.fp+1, 0x400f000000000000ULL);
+  dbl(0x1p+2, 0x4010000000000000ULL);
+  dbl(0x1.1p+2, 0x4011000000000000ULL);
+  dbl(0x1.2p+2, 0x4012000000000000ULL);
+  dbl(0x1.3p+2, 0x4013000000000000ULL);
+  dbl(0x1.4p+2, 0x4014000000000000ULL);
+  dbl(0x1.5p+2, 0x4015000000000000ULL);
+  dbl(0x1.6p+2, 0x4016000000000000ULL);
+  dbl(0x1.7p+2, 0x4017000000000000ULL);
+  dbl(0x1.8p+2, 0x4018000000000000ULL);
+  dbl(0x1.9p+2, 0x4019000000000000ULL);
+  dbl(0x1.ap+2, 0x401a000000000000ULL);
+  dbl(0x1.bp+2, 0x401b000000000000ULL);
+  dbl(0x1.cp+2, 0x401c000000000000ULL);
+  dbl(0x1.dp+2, 0x401d000000000000ULL);
+  dbl(0x1.ep+2, 0x401e000000000000ULL);
+  dbl(0x1.fp+2, 0x401f000000000000ULL);
+  dbl(0x1p+3, 0x4020000000000000ULL);
+  dbl(0x1.1p+3, 0x4021000000000000ULL);
+  dbl(0x1.2p+3, 0x4022000000000000ULL);
+  dbl(0x1.3p+3, 0x4023000000000000ULL);
+  dbl(0x1.4p+3, 0x4024000000000000ULL);
+  dbl(0x1.5p+3, 0x4025000000000000ULL);
+  dbl(0x1.6p+3, 0x4026000000000000ULL);
+  dbl(0x1.7p+3, 0x4027000000000000ULL);
+  dbl(0x1.8p+3, 0x4028000000000000ULL);
+  dbl(0x1.9p+3, 0x4029000000000000ULL);
+  dbl(0x1.ap+3, 0x402a000000000000ULL);
+  dbl(0x1.bp+3, 0x402b000000000000ULL);
+  dbl(0x1.cp+3, 0x402c000000000000ULL);
+  dbl(0x1.dp+3, 0x402d000000000000ULL);
+  dbl(0x1.ep+3, 0x402e000000000000ULL);
+  dbl(0x1.fp+3, 0x402f000000000000ULL);
+  dbl(0x1p+4, 0x4030000000000000ULL);
+  dbl(0x1.1p+4, 0x4031000000000000ULL);
+  dbl(0x1.2p+4, 0x4032000000000000ULL);
+  dbl(0x1.3p+4, 0x4033000000000000ULL);
+  dbl(0x1.4p+4, 0x4034000000000000ULL);
+  dbl(0x1.5p+4, 0x4035000000000000ULL);
+  dbl(0x1.6p+4, 0x4036000000000000ULL);
+  dbl(0x1.7p+4, 0x4037000000000000ULL);
+  dbl(0x1.8p+4, 0x4038000000000000ULL);
+  dbl(0x1.9p+4, 0x4039000000000000ULL);
+  dbl(0x1.ap+4, 0x403a000000000000ULL);
+  dbl(0x1.bp+4, 0x403b000000000000ULL);
+  dbl(0x1.cp+4, 0x403c000000000000ULL);
+  dbl(0x1.dp+4, 0x403d000000000000ULL);
+  dbl(0x1.ep+4, 0x403e000000000000ULL);
+  dbl(0x1.fp+4, 0x403f000000000000ULL);
+  dbl((-0x1p-3), 0xbfc0000000000000ULL);
+  dbl((-0x1.1p-3), 0xbfc1000000000000ULL);
+  dbl((-0x1.2p-3), 0xbfc2000000000000ULL);
+  dbl((-0x1.3p-3), 0xbfc3000000000000ULL);
+  dbl((-0x1.4p-3), 0xbfc4000000000000ULL);
+  dbl((-0x1.5p-3), 0xbfc5000000000000ULL);
+  dbl((-0x1.6p-3), 0xbfc6000000000000ULL);
+  dbl((-0x1.7p-3), 0xbfc7000000000000ULL);
+  dbl((-0x1.8p-3), 0xbfc8000000000000ULL);
+  dbl((-0x1.9p-3), 0xbfc9000000000000ULL);
+  dbl((-0x1.ap-3), 0xbfca000000000000ULL);
+  dbl((-0x1.bp-3), 0xbfcb000000000000ULL);
+  dbl((-0x1.cp-3), 0xbfcc000000000000ULL);
+  dbl((-0x1.dp-3), 0xbfcd000000000000ULL);
+  dbl((-0x1.ep-3), 0xbfce000000000000ULL);
+  dbl((-0x1.fp-3), 0xbfcf000000000000ULL);
+  dbl((-0x1p-2), 0xbfd0000000000000ULL);
+  dbl((-0x1.1p-2), 0xbfd1000000000000ULL);
+  dbl((-0x1.2p-2), 0xbfd2000000000000ULL);
+  dbl((-0x1.3p-2), 0xbfd3000000000000ULL);
+  dbl((-0x1.4p-2), 0xbfd4000000000000ULL);
+  dbl((-0x1.5p-2), 0xbfd5000000000000ULL);
+  dbl((-0x1.6p-2), 0xbfd6000000000000ULL);
+  dbl((-0x1.7p-2), 0xbfd7000000000000ULL);
+  dbl((-0x1.8p-2), 0xbfd8000000000000ULL);
+  dbl((-0x1.9p-2), 0xbfd9000000000000ULL);
+  dbl((-0x1.ap-2), 0xbfda000000000000ULL);
+  dbl((-0x1.bp-2), 0xbfdb000000000000ULL);
+  dbl((-0x1.cp-2), 0xbfdc000000000000ULL);
+  dbl((-0x1.dp-2), 0xbfdd000000000000ULL);
+  dbl((-0x1.ep-2), 0xbfde000000000000ULL);
+  dbl((-0x1.fp-2), 0xbfdf000000000000ULL);
+  dbl((-0x1p-1), 0xbfe0000000000000ULL);
+  dbl((-0x1.1p-1), 0xbfe1000000000000ULL);
+  dbl((-0x1.2p-1), 0xbfe2000000000000ULL);
+  dbl((-0x1.3p-1), 0xbfe3000000000000ULL);
+  dbl((-0x1.4p-1), 0xbfe4000000000000ULL);
+  dbl((-0x1.5p-1), 0xbfe5000000000000ULL);
+  dbl((-0x1.6p-1), 0xbfe6000000000000ULL);
+  dbl((-0x1.7p-1), 0xbfe7000000000000ULL);
+  dbl((-0x1.8p-1), 0xbfe8000000000000ULL);
+  dbl((-0x1.9p-1), 0xbfe9000000000000ULL);
+  dbl((-0x1.ap-1), 0xbfea000000000000ULL);
+  dbl((-0x1.bp-1), 0xbfeb000000000000ULL);
+  dbl((-0x1.cp-1), 0xbfec000000000000ULL);
+  dbl((-0x1.dp-1), 0xbfed000000000000ULL);
+  dbl((-0x1.ep-1), 0xbfee000000000000ULL);
+  dbl((-0x1.fp-1), 0xbfef000000000000ULL);
+  dbl((-0x1p+0), 0xbff0000000000000ULL);
+  dbl((-0x1.1p+0), 0xbff1000000000000ULL);
+  dbl((-0x1.2p+0), 0xbff2000000000000ULL);
+  dbl((-0x1.3p+0), 0xbff3000000000000ULL);
+  dbl((-0x1.4p+0), 0xbff4000000000000ULL);
+  dbl((-0x1.5p+0), 0xbff5000000000000ULL);
+  dbl((-0x1.6p+0), 0xbff6000000000000ULL);
+  dbl((-0x1.7p+0), 0xbff7000000000000ULL);
+  dbl((-0x1.8p+0), 0xbff8000000000000ULL);
+  dbl((-0x1.9p+0), 0xbff9000000000000ULL);
+  dbl((-0x1.ap+0), 0xbffa000000000000ULL);
+  dbl((-0x1.bp+0), 0xbffb000000000000ULL);
+  dbl((-0x1.cp+0), 0xbffc000000000000ULL);
+  dbl((-0x1.dp+0), 0xbffd000000000000ULL);
+  dbl((-0x1.ep+0), 0xbffe000000000000ULL);
+  dbl((-0x1.fp+0), 0xbfff000000000000ULL);
+  dbl((-0x1p+1), 0xc000000000000000ULL);
+  dbl((-0x1.1p+1), 0xc001000000000000ULL);
+  dbl((-0x1.2p+1), 0xc002000000000000ULL);
+  dbl((-0x1.3p+1), 0xc003000000000000ULL);
+  dbl((-0x1.4p+1), 0xc004000000000000ULL);
+  dbl((-0x1.5p+1), 0xc005000000000000ULL);
+  dbl((-0x1.6p+1), 0xc006000000000000ULL);
+  dbl((-0x1.7p+1), 0xc007000000000000ULL);
+  dbl((-0x1.8p+1), 0xc008000000000000ULL);
+  dbl((-0x1.9p+1), 0xc009000000000000ULL);
+  dbl((-0x1.ap+1), 0xc00a000000000000ULL);
+  dbl((-0x1.bp+1), 0xc00b000000000000ULL);
+  dbl((-0x1.cp+1), 0xc00c000000000000ULL);
+  dbl((-0x1.dp+1), 0xc00d000000000000ULL);
+  dbl((-0x1.ep+1), 0xc00e000000000000ULL);
+  dbl((-0x1.fp+1), 0xc00f000000000000ULL);
+  dbl((-0x1p+2), 0xc010000000000000ULL);
+  dbl((-0x1.1p+2), 0xc011000000000000ULL);
+  dbl((-0x1.2p+2), 0xc012000000000000ULL);
+  dbl((-0x1.3p+2), 0xc013000000000000ULL);
+  dbl((-0x1.4p+2), 0xc014000000000000ULL);
+  dbl((-0x1.5p+2), 0xc015000000000000ULL);
+  dbl((-0x1.6p+2), 0xc016000000000000ULL);
+  dbl((-0x1.7p+2), 0xc017000000000000ULL);
+  dbl((-0x1.8p+2), 0xc018000000000000ULL);
+  dbl((-0x1.9p+2), 0xc019000000000000ULL);
+  dbl((-0x1.ap+2), 0xc01a000000000000ULL);
+  dbl((-0x1.bp+2), 0xc01b000000000000ULL);
+  dbl((-0x1.cp+2), 0xc01c000000000000ULL);
+  dbl((-0x1.dp+2), 0xc01d000000000000ULL);
+  dbl((-0x1.ep+2), 0xc01e000000000000ULL);
+  dbl((-0x1.fp+2), 0xc01f000000000000ULL);
+  dbl((-0x1p+3), 0xc020000000000000ULL);
+  dbl((-0x1.1p+3), 0xc021000000000000ULL);
+  dbl((-0x1.2p+3), 0xc022000000000000ULL);
+  dbl((-0x1.3p+3), 0xc023000000000000ULL);
+  dbl((-0x1.4p+3), 0xc024000000000000ULL);
+  dbl((-0x1.5p+3), 0xc025000000000000ULL);
+  dbl((-0x1.6p+3), 0xc026000000000000ULL);
+  dbl((-0x1.7p+3), 0xc027000000000000ULL);
+  dbl((-0x1.8p+3), 0xc028000000000000ULL);
+  dbl((-0x1.9p+3), 0xc029000000000000ULL);
+  dbl((-0x1.ap+3), 0xc02a000000000000ULL);
+  dbl((-0x1.bp+3), 0xc02b000000000000ULL);
+  dbl((-0x1.cp+3), 0xc02c000000000000ULL);
+  dbl((-0x1.dp+3), 0xc02d000000000000ULL);
+  dbl((-0x1.ep+3), 0xc02e000000000000ULL);
+  dbl((-0x1.fp+3), 0xc02f000000000000ULL);
+  dbl((-0x1p+4), 0xc030000000000000ULL);
+  dbl((-0x1.1p+4), 0xc031000000000000ULL);
+  dbl((-0x1.2p+4), 0xc032000000000000ULL);
+  dbl((-0x1.3p+4), 0xc033000000000000ULL);
+  dbl((-0x1.4p+4), 0xc034000000000000ULL);
+  dbl((-0x1.5p+4), 0xc035000000000000ULL);
+  dbl((-0x1.6p+4), 0xc036000000000000ULL);
+  dbl((-0x1.7p+4), 0xc037000000000000ULL);
+  dbl((-0x1.8p+4), 0xc038000000000000ULL);
+  dbl((-0x1.9p+4), 0xc039000000000000ULL);
+  dbl((-0x1.ap+4), 0xc03a000000000000ULL);
+  dbl((-0x1.bp+4), 0xc03b000000000000ULL);
+  dbl((-0x1.cp+4), 0xc03c000000000000ULL);
+  dbl((-0x1.dp+4), 0xc03d000000000000ULL);
+  dbl((-0x1.ep+4), 0xc03e000000000000ULL);
+  dbl((-0x1.fp+4), 0xc03f000000000000ULL);
+}
+
+void testsng(void)
+{
+  printf("--- Single-precision test\n");
+  sng(0x0p+0, 0x0U);
+  sng(-0x0p+0, 0x80000000U);
+  sng(0x1p-3, 0x3e000000U);
+  sng(0x1.1p-3, 0x3e080000U);
+  sng(0x1.2p-3, 0x3e100000U);
+  sng(0x1.3p-3, 0x3e180000U);
+  sng(0x1.4p-3, 0x3e200000U);
+  sng(0x1.5p-3, 0x3e280000U);
+  sng(0x1.6p-3, 0x3e300000U);
+  sng(0x1.7p-3, 0x3e380000U);
+  sng(0x1.8p-3, 0x3e400000U);
+  sng(0x1.9p-3, 0x3e480000U);
+  sng(0x1.ap-3, 0x3e500000U);
+  sng(0x1.bp-3, 0x3e580000U);
+  sng(0x1.cp-3, 0x3e600000U);
+  sng(0x1.dp-3, 0x3e680000U);
+  sng(0x1.ep-3, 0x3e700000U);
+  sng(0x1.fp-3, 0x3e780000U);
+  sng(0x1p-2, 0x3e800000U);
+  sng(0x1.1p-2, 0x3e880000U);
+  sng(0x1.2p-2, 0x3e900000U);
+  sng(0x1.3p-2, 0x3e980000U);
+  sng(0x1.4p-2, 0x3ea00000U);
+  sng(0x1.5p-2, 0x3ea80000U);
+  sng(0x1.6p-2, 0x3eb00000U);
+  sng(0x1.7p-2, 0x3eb80000U);
+  sng(0x1.8p-2, 0x3ec00000U);
+  sng(0x1.9p-2, 0x3ec80000U);
+  sng(0x1.ap-2, 0x3ed00000U);
+  sng(0x1.bp-2, 0x3ed80000U);
+  sng(0x1.cp-2, 0x3ee00000U);
+  sng(0x1.dp-2, 0x3ee80000U);
+  sng(0x1.ep-2, 0x3ef00000U);
+  sng(0x1.fp-2, 0x3ef80000U);
+  sng(0x1p-1, 0x3f000000U);
+  sng(0x1.1p-1, 0x3f080000U);
+  sng(0x1.2p-1, 0x3f100000U);
+  sng(0x1.3p-1, 0x3f180000U);
+  sng(0x1.4p-1, 0x3f200000U);
+  sng(0x1.5p-1, 0x3f280000U);
+  sng(0x1.6p-1, 0x3f300000U);
+  sng(0x1.7p-1, 0x3f380000U);
+  sng(0x1.8p-1, 0x3f400000U);
+  sng(0x1.9p-1, 0x3f480000U);
+  sng(0x1.ap-1, 0x3f500000U);
+  sng(0x1.bp-1, 0x3f580000U);
+  sng(0x1.cp-1, 0x3f600000U);
+  sng(0x1.dp-1, 0x3f680000U);
+  sng(0x1.ep-1, 0x3f700000U);
+  sng(0x1.fp-1, 0x3f780000U);
+  sng(0x1p+0, 0x3f800000U);
+  sng(0x1.1p+0, 0x3f880000U);
+  sng(0x1.2p+0, 0x3f900000U);
+  sng(0x1.3p+0, 0x3f980000U);
+  sng(0x1.4p+0, 0x3fa00000U);
+  sng(0x1.5p+0, 0x3fa80000U);
+  sng(0x1.6p+0, 0x3fb00000U);
+  sng(0x1.7p+0, 0x3fb80000U);
+  sng(0x1.8p+0, 0x3fc00000U);
+  sng(0x1.9p+0, 0x3fc80000U);
+  sng(0x1.ap+0, 0x3fd00000U);
+  sng(0x1.bp+0, 0x3fd80000U);
+  sng(0x1.cp+0, 0x3fe00000U);
+  sng(0x1.dp+0, 0x3fe80000U);
+  sng(0x1.ep+0, 0x3ff00000U);
+  sng(0x1.fp+0, 0x3ff80000U);
+  sng(0x1p+1, 0x40000000U);
+  sng(0x1.1p+1, 0x40080000U);
+  sng(0x1.2p+1, 0x40100000U);
+  sng(0x1.3p+1, 0x40180000U);
+  sng(0x1.4p+1, 0x40200000U);
+  sng(0x1.5p+1, 0x40280000U);
+  sng(0x1.6p+1, 0x40300000U);
+  sng(0x1.7p+1, 0x40380000U);
+  sng(0x1.8p+1, 0x40400000U);
+  sng(0x1.9p+1, 0x40480000U);
+  sng(0x1.ap+1, 0x40500000U);
+  sng(0x1.bp+1, 0x40580000U);
+  sng(0x1.cp+1, 0x40600000U);
+  sng(0x1.dp+1, 0x40680000U);
+  sng(0x1.ep+1, 0x40700000U);
+  sng(0x1.fp+1, 0x40780000U);
+  sng(0x1p+2, 0x40800000U);
+  sng(0x1.1p+2, 0x40880000U);
+  sng(0x1.2p+2, 0x40900000U);
+  sng(0x1.3p+2, 0x40980000U);
+  sng(0x1.4p+2, 0x40a00000U);
+  sng(0x1.5p+2, 0x40a80000U);
+  sng(0x1.6p+2, 0x40b00000U);
+  sng(0x1.7p+2, 0x40b80000U);
+  sng(0x1.8p+2, 0x40c00000U);
+  sng(0x1.9p+2, 0x40c80000U);
+  sng(0x1.ap+2, 0x40d00000U);
+  sng(0x1.bp+2, 0x40d80000U);
+  sng(0x1.cp+2, 0x40e00000U);
+  sng(0x1.dp+2, 0x40e80000U);
+  sng(0x1.ep+2, 0x40f00000U);
+  sng(0x1.fp+2, 0x40f80000U);
+  sng(0x1p+3, 0x41000000U);
+  sng(0x1.1p+3, 0x41080000U);
+  sng(0x1.2p+3, 0x41100000U);
+  sng(0x1.3p+3, 0x41180000U);
+  sng(0x1.4p+3, 0x41200000U);
+  sng(0x1.5p+3, 0x41280000U);
+  sng(0x1.6p+3, 0x41300000U);
+  sng(0x1.7p+3, 0x41380000U);
+  sng(0x1.8p+3, 0x41400000U);
+  sng(0x1.9p+3, 0x41480000U);
+  sng(0x1.ap+3, 0x41500000U);
+  sng(0x1.bp+3, 0x41580000U);
+  sng(0x1.cp+3, 0x41600000U);
+  sng(0x1.dp+3, 0x41680000U);
+  sng(0x1.ep+3, 0x41700000U);
+  sng(0x1.fp+3, 0x41780000U);
+  sng(0x1p+4, 0x41800000U);
+  sng(0x1.1p+4, 0x41880000U);
+  sng(0x1.2p+4, 0x41900000U);
+  sng(0x1.3p+4, 0x41980000U);
+  sng(0x1.4p+4, 0x41a00000U);
+  sng(0x1.5p+4, 0x41a80000U);
+  sng(0x1.6p+4, 0x41b00000U);
+  sng(0x1.7p+4, 0x41b80000U);
+  sng(0x1.8p+4, 0x41c00000U);
+  sng(0x1.9p+4, 0x41c80000U);
+  sng(0x1.ap+4, 0x41d00000U);
+  sng(0x1.bp+4, 0x41d80000U);
+  sng(0x1.cp+4, 0x41e00000U);
+  sng(0x1.dp+4, 0x41e80000U);
+  sng(0x1.ep+4, 0x41f00000U);
+  sng(0x1.fp+4, 0x41f80000U);
+  sng(-0x1p-3, 0xbe000000U);
+  sng(-0x1.1p-3, 0xbe080000U);
+  sng(-0x1.2p-3, 0xbe100000U);
+  sng(-0x1.3p-3, 0xbe180000U);
+  sng(-0x1.4p-3, 0xbe200000U);
+  sng(-0x1.5p-3, 0xbe280000U);
+  sng(-0x1.6p-3, 0xbe300000U);
+  sng(-0x1.7p-3, 0xbe380000U);
+  sng(-0x1.8p-3, 0xbe400000U);
+  sng(-0x1.9p-3, 0xbe480000U);
+  sng(-0x1.ap-3, 0xbe500000U);
+  sng(-0x1.bp-3, 0xbe580000U);
+  sng(-0x1.cp-3, 0xbe600000U);
+  sng(-0x1.dp-3, 0xbe680000U);
+  sng(-0x1.ep-3, 0xbe700000U);
+  sng(-0x1.fp-3, 0xbe780000U);
+  sng(-0x1p-2, 0xbe800000U);
+  sng(-0x1.1p-2, 0xbe880000U);
+  sng(-0x1.2p-2, 0xbe900000U);
+  sng(-0x1.3p-2, 0xbe980000U);
+  sng(-0x1.4p-2, 0xbea00000U);
+  sng(-0x1.5p-2, 0xbea80000U);
+  sng(-0x1.6p-2, 0xbeb00000U);
+  sng(-0x1.7p-2, 0xbeb80000U);
+  sng(-0x1.8p-2, 0xbec00000U);
+  sng(-0x1.9p-2, 0xbec80000U);
+  sng(-0x1.ap-2, 0xbed00000U);
+  sng(-0x1.bp-2, 0xbed80000U);
+  sng(-0x1.cp-2, 0xbee00000U);
+  sng(-0x1.dp-2, 0xbee80000U);
+  sng(-0x1.ep-2, 0xbef00000U);
+  sng(-0x1.fp-2, 0xbef80000U);
+  sng(-0x1p-1, 0xbf000000U);
+  sng(-0x1.1p-1, 0xbf080000U);
+  sng(-0x1.2p-1, 0xbf100000U);
+  sng(-0x1.3p-1, 0xbf180000U);
+  sng(-0x1.4p-1, 0xbf200000U);
+  sng(-0x1.5p-1, 0xbf280000U);
+  sng(-0x1.6p-1, 0xbf300000U);
+  sng(-0x1.7p-1, 0xbf380000U);
+  sng(-0x1.8p-1, 0xbf400000U);
+  sng(-0x1.9p-1, 0xbf480000U);
+  sng(-0x1.ap-1, 0xbf500000U);
+  sng(-0x1.bp-1, 0xbf580000U);
+  sng(-0x1.cp-1, 0xbf600000U);
+  sng(-0x1.dp-1, 0xbf680000U);
+  sng(-0x1.ep-1, 0xbf700000U);
+  sng(-0x1.fp-1, 0xbf780000U);
+  sng(-0x1p+0, 0xbf800000U);
+  sng(-0x1.1p+0, 0xbf880000U);
+  sng(-0x1.2p+0, 0xbf900000U);
+  sng(-0x1.3p+0, 0xbf980000U);
+  sng(-0x1.4p+0, 0xbfa00000U);
+  sng(-0x1.5p+0, 0xbfa80000U);
+  sng(-0x1.6p+0, 0xbfb00000U);
+  sng(-0x1.7p+0, 0xbfb80000U);
+  sng(-0x1.8p+0, 0xbfc00000U);
+  sng(-0x1.9p+0, 0xbfc80000U);
+  sng(-0x1.ap+0, 0xbfd00000U);
+  sng(-0x1.bp+0, 0xbfd80000U);
+  sng(-0x1.cp+0, 0xbfe00000U);
+  sng(-0x1.dp+0, 0xbfe80000U);
+  sng(-0x1.ep+0, 0xbff00000U);
+  sng(-0x1.fp+0, 0xbff80000U);
+  sng(-0x1p+1, 0xc0000000U);
+  sng(-0x1.1p+1, 0xc0080000U);
+  sng(-0x1.2p+1, 0xc0100000U);
+  sng(-0x1.3p+1, 0xc0180000U);
+  sng(-0x1.4p+1, 0xc0200000U);
+  sng(-0x1.5p+1, 0xc0280000U);
+  sng(-0x1.6p+1, 0xc0300000U);
+  sng(-0x1.7p+1, 0xc0380000U);
+  sng(-0x1.8p+1, 0xc0400000U);
+  sng(-0x1.9p+1, 0xc0480000U);
+  sng(-0x1.ap+1, 0xc0500000U);
+  sng(-0x1.bp+1, 0xc0580000U);
+  sng(-0x1.cp+1, 0xc0600000U);
+  sng(-0x1.dp+1, 0xc0680000U);
+  sng(-0x1.ep+1, 0xc0700000U);
+  sng(-0x1.fp+1, 0xc0780000U);
+  sng(-0x1p+2, 0xc0800000U);
+  sng(-0x1.1p+2, 0xc0880000U);
+  sng(-0x1.2p+2, 0xc0900000U);
+  sng(-0x1.3p+2, 0xc0980000U);
+  sng(-0x1.4p+2, 0xc0a00000U);
+  sng(-0x1.5p+2, 0xc0a80000U);
+  sng(-0x1.6p+2, 0xc0b00000U);
+  sng(-0x1.7p+2, 0xc0b80000U);
+  sng(-0x1.8p+2, 0xc0c00000U);
+  sng(-0x1.9p+2, 0xc0c80000U);
+  sng(-0x1.ap+2, 0xc0d00000U);
+  sng(-0x1.bp+2, 0xc0d80000U);
+  sng(-0x1.cp+2, 0xc0e00000U);
+  sng(-0x1.dp+2, 0xc0e80000U);
+  sng(-0x1.ep+2, 0xc0f00000U);
+  sng(-0x1.fp+2, 0xc0f80000U);
+  sng(-0x1p+3, 0xc1000000U);
+  sng(-0x1.1p+3, 0xc1080000U);
+  sng(-0x1.2p+3, 0xc1100000U);
+  sng(-0x1.3p+3, 0xc1180000U);
+  sng(-0x1.4p+3, 0xc1200000U);
+  sng(-0x1.5p+3, 0xc1280000U);
+  sng(-0x1.6p+3, 0xc1300000U);
+  sng(-0x1.7p+3, 0xc1380000U);
+  sng(-0x1.8p+3, 0xc1400000U);
+  sng(-0x1.9p+3, 0xc1480000U);
+  sng(-0x1.ap+3, 0xc1500000U);
+  sng(-0x1.bp+3, 0xc1580000U);
+  sng(-0x1.cp+3, 0xc1600000U);
+  sng(-0x1.dp+3, 0xc1680000U);
+  sng(-0x1.ep+3, 0xc1700000U);
+  sng(-0x1.fp+3, 0xc1780000U);
+  sng(-0x1p+4, 0xc1800000U);
+  sng(-0x1.1p+4, 0xc1880000U);
+  sng(-0x1.2p+4, 0xc1900000U);
+  sng(-0x1.3p+4, 0xc1980000U);
+  sng(-0x1.4p+4, 0xc1a00000U);
+  sng(-0x1.5p+4, 0xc1a80000U);
+  sng(-0x1.6p+4, 0xc1b00000U);
+  sng(-0x1.7p+4, 0xc1b80000U);
+  sng(-0x1.8p+4, 0xc1c00000U);
+  sng(-0x1.9p+4, 0xc1c80000U);
+  sng(-0x1.ap+4, 0xc1d00000U);
+  sng(-0x1.bp+4, 0xc1d80000U);
+  sng(-0x1.cp+4, 0xc1e00000U);
+  sng(-0x1.dp+4, 0xc1e80000U);
+  sng(-0x1.ep+4, 0xc1f00000U);
+  sng(-0x1.fp+4, 0xc1f80000U);
+}
+
+
+int main()
+{
+  testdbl();
+  testsng();
+  return error;
+}
diff --git a/test/regression/floats.c b/test/regression/floats.c
index 84c4e062..58c202ae 100644
--- a/test/regression/floats.c
+++ b/test/regression/floats.c
@@ -1,17 +1,9 @@
-#include<stdio.h>
+#include <stdio.h>
+#include "../endian.h"
 
 #define STR_EXPAND(tok) #tok
 #define STR(tok) STR_EXPAND(tok)
 
-#if defined(__ppc__) || defined(__PPC__) || defined(__ARMEB__)
-#define ARCH_BIG_ENDIAN
-#elif defined(__i386__) || defined(__x86_64__) || defined(__ARMEL__) \
-   || defined(__riscv)
-#undef ARCH_BIG_ENDIAN
-#else
-#error "unknown endianness"
-#endif
-
 union converter64 {
   double dbl;
   struct {
diff --git a/test/regression/ifconv.c b/test/regression/ifconv.c
new file mode 100644
index 00000000..e12a394c
--- /dev/null
+++ b/test/regression/ifconv.c
@@ -0,0 +1,149 @@
+#include <stdio.h>
+
+/* Several equivalent forms that should be turned into cmov */
+
+int test1(int x, int y, int a, int b)
+{
+  return x < y ? a : b;
+}
+
+int test2(int x, int y, int a, int b)
+{
+  int r;
+  if (x < y) { r = a; } else { r = b; }
+  return r;
+}
+
+int test3(int x, int y, int a, int b)
+{
+  int r = b;
+  if (x < y) { r = a; }
+  return r;
+}
+
+int test4(int x, int y, int a, int b)
+{
+  int r = a;
+  if (x < y) { /*skip*/; } else { r = b; }
+  return r;
+}
+
+/* A more advanced example */
+
+int test5(int x, int y, int a)
+{
+  return x < y ? a + 1 : a - 1;
+}
+
+/* Unsafe operations should not be turned into cmov */
+
+int test6(int * p)
+{
+  return p == NULL ? 0 : *p + 10;
+}
+
+int test7(int a, int b)
+{
+  return b == 0 ? -1 : a / b;
+}
+
+/* Very large operations should not be turned into cmov */
+
+int test8(int a)
+{
+  return a == 0 ? 0 : a*a*a*a - 2*a*a*a + 10*a*a + 42*a - 123;
+}
+
+/* Some examples with 64-bit integers */
+
+long long ltest1(int x, int y, long long a, long long b)
+{
+  return x < y ? a + 1 : b >> 2;
+}
+
+/* Some examples with floating-point */
+
+double dmax(double x, double y)
+{
+  return x >= y ? x : y;
+}
+
+double dabs(double x)
+{
+  return x < 0.0 ? -x : x;
+}
+
+float smin(float x, float y)
+{
+  return x <= y ? x : y;
+}
+
+float sdoz(float x, float y)
+{
+  return x >= y ? x - y : 0.0f;
+}
+
+/* Examples where constant propagation should take place */
+
+int constprop1(int x)
+{
+  int n = 0;
+  return n ? x : 42;
+}
+
+int constprop2(int x)
+{
+  int n = 1;
+  return n ? x : 42;
+}
+
+int constprop3(int x, int y)
+{
+  int n = 0;
+  return x < n ? y - 1 : y + 1;
+}
+
+/* Test harness */
+
+#define TESTI(call) printf(#call " = %d\n", call)
+#define TESTL(call) printf(#call " = %lld\n", call)
+#define TESTF(call) printf(#call " = %f\n", call)
+
+
+int main()
+{
+  int i = 1234;
+  TESTI(test1(0,1,12,34));
+  TESTI(test1(1,0,45,67));
+  TESTI(test2(0,1,12,34));
+  TESTI(test2(1,0,45,67));
+  TESTI(test3(0,1,12,34));
+  TESTI(test3(1,0,45,67));
+  TESTI(test4(0,1,12,34));
+  TESTI(test4(1,0,45,67));
+  TESTI(test5(0,1,12));
+  TESTI(test5(1,0,45));
+  TESTI(test6(NULL));
+  TESTI(test6(&i));
+  TESTI(test7(1,0));
+  TESTI(test7(-100,4));
+  TESTI(test8(0));
+  TESTI(test8(1));
+
+  TESTL(ltest1(-1, 0, 123LL, 456LL));
+  TESTL(ltest1(1, 0, 123LL, 456LL));
+
+  TESTF(dmax(0.0, 3.14));
+  TESTF(dmax(1.0, -2.718));
+
+  TESTF(dabs(1.0));
+  TESTF(dabs(-2.718));
+
+  TESTF(smin(0.0, 3.14));
+  TESTF(smin(1.0, -2.718));
+
+  TESTF(sdoz(1.0, 0.5));
+  TESTF(sdoz(0.0, 3.14));
+
+  return 0;
+}
diff --git a/test/regression/int64.c b/test/regression/int64.c
index d9785e95..0da9602d 100644
--- a/test/regression/int64.c
+++ b/test/regression/int64.c
@@ -103,7 +103,8 @@ u64 special_values[] = {
   0x80000000LLU,
   0x7FFFFFFFFFFFFFFFLLU,
   0x8000000000000000LLU,
-  0x100000003LLU
+  0x100000003LLU,
+  0x52ce6b4000000063LLU
 };
 
 #define NUM_SPECIAL_VALUES (sizeof(special_values) / sizeof(u64))
diff --git a/test/regression/interop1.c b/test/regression/interop1.c
index a39f449c..6836b89e 100644
--- a/test/regression/interop1.c
+++ b/test/regression/interop1.c
@@ -195,6 +195,17 @@ RETURN(ru6,U6,init_U6)
 RETURN(ru7,U7,init_U7)
 RETURN(ru8,U8,init_U8)
 
+/* Returning small integers */
+
+#define SMALLINT(name,ty) \
+extern ty THEM(name)(int); \
+ty US(name)(int x) { return x * x; }
+
+SMALLINT(si8u, unsigned char)
+SMALLINT(si8s, signed char)
+SMALLINT(si16u, unsigned short)
+SMALLINT(si16s, signed short)
+
 /* Test function, calling the functions compiled by the other compiler */
 
 #define CALLPRINT(name,ty,init) \
@@ -207,6 +218,10 @@ RETURN(ru8,U8,init_U8)
 extern void THEM(test) (void);
 void US(test) (void)
 {
+  printf("si8u: %d\n", THEM(si8u)(12345));
+  printf("si8s: %d\n", THEM(si8s)(12345));
+  printf("si16u: %d\n", THEM(si16u)(1234567));
+  printf("si16s: %d\n", THEM(si16s)(1234567));
   CALLPRINT(s1,S1,init_S1)
   CALLPRINT(s2,S2,init_S2)
   CALLPRINT(s3,S3,init_S3)
diff --git a/test/spass/Makefile b/test/spass/Makefile
index 0e89d6d1..d512ea95 100644
--- a/test/spass/Makefile
+++ b/test/spass/Makefile
@@ -24,11 +24,10 @@ clean:
 test:
 	$(SIMU) ./spass small_problem.dfg | grep 'Proof found'
 
-TIME=xtime -o /dev/null     # Xavier's hack
-#TIME=time >/dev/null       # Otherwise
+TIME=ocaml unix.cma ../../tools/xtime.ml -o /dev/null -mintime 5.0
 
 bench:
-	@echo -n "spass: "; $(TIME) ./spass problem.dfg
+	@$(TIME) -name spass -- ./spass problem.dfg
 
 depend:
 	gcc -MM $(SRCS) > .depend
diff --git a/tools/ndfun.ml b/tools/ndfun.ml
index 2b8bcb19..b6a87ede 100644
--- a/tools/ndfun.ml
+++ b/tools/ndfun.ml
@@ -41,7 +41,9 @@ let trim s =
 let str_match n re s =
   if not (Str.string_match re s 0) then [||] else begin
     let res = Array.make (n+1) "" in
-    for i = 1 to n do res.(i) <- Str.matched_group i s done;
+    for i = 1 to n do
+      res.(i) <- (try Str.matched_group i s with Not_found -> "")
+    done;
     for i = 1 to n do res.(i) <- trim res.(i) done;
     res
   end
@@ -87,6 +89,11 @@ let match_temps args =
 let parenpats p =
   "(" ^ Str.global_replace re_comma ") (" p ^ ")"
 
+(* "foo, bar, gee" -> "_ _ _" *)
+
+let underscores_for s =
+  Str.global_replace re_arg "_" (remove_commas s)
+
 (* Extract the bound variables in a pattern.  Heuristic: any identifier
    that starts with a lowercase letter and is not "nil". *)
 
@@ -123,7 +130,7 @@ let re_nd = Str.regexp(
 
 let re_split_cases = Str.regexp "|"
 
-let re_case = Str.regexp "\\(.*\\)=>\\(.*\\)"
+let re_case = Str.regexp "\\([^?]*\\)\\(\\?\\?\\(.*\\)\\)?=>\\(.*\\)"
 
 let re_default_pat = Str.regexp "[ _,]*$"
 
@@ -165,16 +172,20 @@ let transl_ndfun filename lineno s =
   (* Adding each case *)
   let numcase = ref 0 in
   let transl_case s =
-    let res = str_match 2 re_case s in
+    let res = str_match 4 re_case s in
     if Array.length res = 0 then
       error filename lineno ("ill-formed case: " ^ s);
-    let patlist = res.(1) and rhs = res.(2) in
+    let patlist = res.(1) and guard = res.(3) and rhs = res.(4) in
     let bv = boundvarspat patlist in
     if not (Str.string_match re_default_pat patlist 0) then begin
       incr numcase;
       bprintf a "  | %s_case%d: forall %s, %s_cases %s\n"
           name !numcase bv name (parenpats patlist);
-      bprintf b "  | %s => %s_case%d %s\n" patlist name !numcase bv;
+      if guard = "" then
+        bprintf b "  | %s => %s_case%d %s\n" patlist name !numcase bv
+      else
+        bprintf b "  | %s => if %s then %s_case%d %s else %s_default %s\n"
+                  patlist guard name !numcase bv name (underscores_for args);
       bprintf c "  | %s_case%d %s => (* %s *) \n" name !numcase bv patlist;
       bprintf c "      %s\n" rhs
     end else begin
diff --git a/tools/xtime.ml b/tools/xtime.ml
new file mode 100644
index 00000000..fbb25a49
--- /dev/null
+++ b/tools/xtime.ml
@@ -0,0 +1,101 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(* Timing the execution of a command, with more options than the
+   standard Unix "time" utility. *)
+
+open Printf
+
+let outfile = ref ""
+let errfile = ref ""
+let command_name = ref ""
+let num_runs = ref 1
+let min_runs = ref 0
+let min_time = ref 0.0
+let print_sys = ref false
+
+let error fmt =
+  eprintf "Error: "; kfprintf (fun _ -> exit 2) stderr fmt
+
+let open_file out dfl =
+  if out = ""
+  then dfl
+  else Unix.(openfile out [O_WRONLY; O_CREAT; O_TRUNC] 0o666)
+
+let close_file out fd =
+  if out <> "" then Unix.close fd
+  
+let run1 (cmd, args) =
+  let fd_out = open_file !outfile Unix.stdout in
+  let fd_err = open_file !errfile Unix.stderr in
+  let pid =
+    Unix.create_process cmd (Array.of_list (cmd :: args))
+                        Unix.stdin fd_out fd_err in
+  close_file !outfile fd_out;
+  close_file !errfile fd_err;
+  let (_, st) = Unix.waitpid [] pid in
+  match st with
+  | Unix.WEXITED 127 -> error "cannot execute '%s'\n" cmd
+  | Unix.WSIGNALED signo -> error "terminated by signal %d\n" signo
+  | _ -> ()
+
+let run (cmd, arg) =
+  let rec repeat n =
+    run1 (cmd, arg);
+    if (!min_time > 0.0 && Unix.((times()).tms_cutime) < !min_time)
+    || (!min_runs > 0 && n < !min_runs)
+    || n < !num_runs
+    then repeat (n + 1)
+    else n in
+  let n = repeat 1 in
+  let ts = Unix.times() in
+  let cmdname = if !command_name <> "" then !command_name else cmd in
+  if !print_sys then
+    Printf.printf "%.3f usr + %.3f sys %s\n"
+                  (ts.Unix.tms_cutime /. float n)
+                  (ts.Unix.tms_cstime /. float n)
+                  cmdname
+  else
+    Printf.printf "%.3f %s\n"
+                  (ts.Unix.tms_cutime /. float n)
+                  cmdname
+
+let _ =
+  let cmd_and_args = ref [] in
+  Arg.parse [
+    "-o", Arg.Set_string outfile,
+      " <file>  Redirect standard output of command to <file>";
+    "-e", Arg.Set_string outfile,
+      " <file>  Redirect standard error of command to <file>";
+    "-name", Arg.Set_string command_name,
+      " <name>  Name of command to report along with the time";
+    "-repeat", Arg.Int (fun n -> num_runs := n),
+      " <N>  Run the command N times";
+    "-mintime", Arg.Float (fun f -> min_time := f),
+      " <T>  Repeatedly run the command for a total duration of at least T seconds";
+    "-minruns", Arg.Int (fun n -> num_runs := n),
+      " <N>  Run the command at least N times (to be used in conjunction with -mintime)";
+    "-sys", Arg.Set print_sys,
+      "  Print system time (spent in the OS) in addition to user time (spent in the command)";
+    "--", Arg.Rest (fun s -> cmd_and_args := s :: !cmd_and_args),
+      " <executable> <arguments>   Specify the executable to time, with its arguments"
+  ]
+  (fun s -> raise (Arg.Bad (sprintf "Don't know what to do with '%s'" s)))
+  "Usage: xtime [options] -- <executable> [arguments].\n\nOptions are:";
+  match List.rev !cmd_and_args with
+  | [] ->
+      error "No command to execute\n"
+  | cmd :: args ->
+      Unix.handle_unix_error run (cmd, args)
diff --git a/x86/Asm.v b/x86/Asm.v
index 32235c2d..58e28c40 100644
--- a/x86/Asm.v
+++ b/x86/Asm.v
@@ -851,11 +851,12 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out
   | Ptestq_ri r1 n =>
       Next (nextinstr (compare_longs (Val.andl (rs r1) (Vlong n)) (Vlong Int64.zero) rs m)) m
   | Pcmov c rd r1 =>
-      match eval_testcond c rs with
-      | Some true => Next (nextinstr (rs#rd <- (rs#r1))) m
-      | Some false => Next (nextinstr rs) m
-      | None => Next (nextinstr (rs#rd <- Vundef)) m
-      end
+      let v :=
+        match eval_testcond c rs with
+        | Some b => if b then rs#r1 else rs#rd
+        | None   => Vundef
+      end in
+      Next (nextinstr (rs#rd <- v)) m
   | Psetcc c rd =>
       Next (nextinstr (rs#rd <- (Val.of_optbool (eval_testcond c rs)))) m
   (** Arithmetic operations over double-precision floats *)
diff --git a/x86/Asmexpand.ml b/x86/Asmexpand.ml
index 16426ce3..b8353046 100644
--- a/x86/Asmexpand.ml
+++ b/x86/Asmexpand.ml
@@ -251,7 +251,7 @@ let expand_builtin_va_start_32 r =
     invalid_arg "Fatal error: va_start used in non-vararg function";
   let ofs =
     Int32.(add (add !PrintAsmaux.current_function_stacksize 4l)
-               (mul 4l (Z.to_int32 (Conventions1.size_arguments
+               (mul 4l (Z.to_int32 (Conventions.size_arguments
                                       (get_current_function_sig ()))))) in
   emit (Pleal (RAX, linear_addr RSP (Z.of_uint32 ofs)));
   emit (Pmovl_mr (linear_addr r _0z, RAX))
@@ -506,7 +506,7 @@ let expand_instruction instr =
          (* Save the registers *)
          emit (Pleaq (R10, linear_addr RSP (Z.of_uint save_regs)));
          emit (Pcall_s (intern_string "__compcert_va_saveregs",
-                        {sig_args = []; sig_res = None; sig_cc = cc_default}))
+                        {sig_args = []; sig_res = Tvoid; sig_cc = cc_default}))
        end;
        (* Stack chaining *)
        let fullsz = sz + 8 in
diff --git a/x86/Asmgen.v b/x86/Asmgen.v
index dedbfbe6..73e3263e 100644
--- a/x86/Asmgen.v
+++ b/x86/Asmgen.v
@@ -305,6 +305,35 @@ Definition mk_jcc (cond: extcond) (lbl: label) (k: code) :=
   | Cond_or c1 c2 => Pjcc c1 lbl :: Pjcc c2 lbl :: k
   end.
 
+Definition negate_testcond (c: testcond) : testcond :=
+  match c with
+  | Cond_e => Cond_ne  | Cond_ne => Cond_e
+  | Cond_b => Cond_ae  | Cond_be => Cond_a
+  | Cond_ae => Cond_b  | Cond_a => Cond_be
+  | Cond_l => Cond_ge  | Cond_le => Cond_g
+  | Cond_ge => Cond_l  | Cond_g => Cond_le
+  | Cond_p => Cond_np  | Cond_np => Cond_p
+  end.
+
+Definition mk_sel (cond: extcond) (rd r2: ireg) (k: code) :=
+  match cond with
+  | Cond_base c =>
+      OK (Pcmov (negate_testcond c) rd r2 :: k)
+  | Cond_and c1 c2 =>
+      OK (Pcmov (negate_testcond c1) rd r2 ::
+          Pcmov (negate_testcond c2) rd r2 :: k)
+  | Cond_or c1 c2 =>
+      Error (msg "Asmgen.mk_sel")    (**r should never happen, see [SelectOp.select] *)
+  end.
+
+Definition transl_sel
+      (cond: condition) (args: list mreg) (rd r2: ireg) (k: code) : res code :=
+  if ireg_eq rd r2 then
+    OK (Pmov_rr rd r2 :: k)    (* must generate one instruction... *)
+  else
+    do k1 <- mk_sel (testcond_for_condition cond) rd r2 k;
+    transl_cond cond args k1.
+
 (** Translation of the arithmetic operation [r <- op(args)].
   The corresponding instructions are prepended to [k]. *)
 
@@ -597,6 +626,10 @@ Definition transl_op
   | Ocmp c, args =>
       do r <- ireg_of res;
       transl_cond c args (mk_setcc (testcond_for_condition c) r k)
+  | Osel c ty, a1 :: a2 :: args =>
+      assertion (mreg_eq a1 res);
+      do r <- ireg_of res; do r2 <- ireg_of a2;
+      transl_sel c args r r2 k
   | _, _ =>
       Error(msg "Asmgen.transl_op")
   end.
diff --git a/x86/Asmgenproof.v b/x86/Asmgenproof.v
index 3aa87a4c..f1fd41e3 100644
--- a/x86/Asmgenproof.v
+++ b/x86/Asmgenproof.v
@@ -194,6 +194,14 @@ Proof.
   intros. destruct xc; simpl; TailNoLabel.
 Qed.
 
+Remark mk_sel_label:
+  forall xc rd r2 k c,
+  mk_sel xc rd r2 k = OK c ->
+  tail_nolabel k c.
+Proof.
+  unfold mk_sel; intros; destruct xc; inv H; TailNoLabel.
+Qed.
+
 Remark transl_cond_label:
   forall cond args k c,
   transl_cond cond args k = OK c ->
@@ -221,6 +229,9 @@ Proof.
   destruct (Float32.eq_dec n Float32.zero); TailNoLabel.
   destruct (normalize_addrmode_64 x) as [am' [delta|]]; TailNoLabel.
   eapply tail_nolabel_trans. eapply transl_cond_label; eauto. eapply mk_setcc_label.
+  unfold transl_sel in EQ2. destruct (ireg_eq x x0); monadInv EQ2.
+  TailNoLabel.
+  eapply tail_nolabel_trans. eapply transl_cond_label; eauto. eapply mk_sel_label; eauto.
 Qed.
 
 Remark transl_load_label:
@@ -706,7 +717,7 @@ Opaque loadind.
   intros. simpl in TR.
   destruct (transl_cond_correct tge tf cond args _ _ rs0 m' TR)
   as [rs' [A [B C]]].
-  rewrite EC in B.
+  rewrite EC in B. destruct B as [B _].
   destruct (testcond_for_condition cond); simpl in *.
 (* simple jcc *)
   exists (Pjcc c1 lbl); exists k; exists rs'.
@@ -744,7 +755,7 @@ Opaque loadind.
   left; eapply exec_straight_steps; eauto. intros. simpl in TR.
   destruct (transl_cond_correct tge tf cond args _ _ rs0 m' TR)
   as [rs' [A [B C]]].
-  rewrite EC in B.
+  rewrite EC in B. destruct B as [B _].
   destruct (testcond_for_condition cond); simpl in *.
 (* simple jcc *)
   econstructor; split.
diff --git a/x86/Asmgenproof1.v b/x86/Asmgenproof1.v
index 904debdc..fd88954e 100644
--- a/x86/Asmgenproof1.v
+++ b/x86/Asmgenproof1.v
@@ -208,7 +208,8 @@ Proof.
   set (x' := Int.add x tnm1).
   set (rs2 := nextinstr (compare_ints (Vint x) (Vint Int.zero) rs1 m)).
   set (rs3 := nextinstr (rs2#RCX <- (Vint x'))).
-  set (rs4 := nextinstr (if Int.lt x Int.zero then rs3#RAX <- (Vint x') else rs3)).
+  set (v' := if Int.lt x Int.zero then Vint x' else Vint x).
+  set (rs4 := nextinstr (rs3#RAX <- v')).
   set (rs5 := nextinstr_nf (rs4#RAX <- (Val.shr rs4#RAX (Vint n)))).
   assert (rs3#RAX = Vint x). unfold rs3. Simplifs.
   assert (rs3#RCX = Vint x'). unfold rs3. Simplifs.
@@ -218,13 +219,12 @@ Proof.
   change (rs2 RAX) with (rs1 RAX). rewrite A. simpl.
   rewrite Int.repr_unsigned. rewrite Int.add_zero_l. auto. auto.
   apply exec_straight_step with rs4 m. simpl.
-  rewrite Int.lt_sub_overflow. unfold rs4. destruct (Int.lt x Int.zero); simpl; auto.
-  unfold rs4. destruct (Int.lt x Int.zero); simpl; auto.
+  rewrite Int.lt_sub_overflow. unfold rs4, v'. rewrite H, H0. destruct (Int.lt x Int.zero); simpl; auto.
+  auto.
   apply exec_straight_one. auto. auto.
   split. unfold rs5. Simplifs. unfold rs4. rewrite nextinstr_inv; auto with asmgen.
-  destruct (Int.lt x Int.zero). rewrite Pregmap.gss. rewrite A; auto. rewrite A; rewrite H; auto.
+  rewrite Pregmap.gss. unfold v'. rewrite A. reflexivity.
   intros. unfold rs5. Simplifs. unfold rs4. Simplifs.
-  transitivity (rs3#r). destruct (Int.lt x Int.zero). Simplifs. auto.
   unfold rs3. Simplifs. unfold rs2. Simplifs.
   unfold compare_ints. Simplifs.
 Qed.
@@ -913,6 +913,7 @@ Lemma transl_cond_correct:
   /\ match eval_condition cond (map rs (map preg_of args)) m with
      | None => True
      | Some b => eval_extcond (testcond_for_condition cond) rs' = Some b
+              /\ eval_extcond (testcond_for_condition (negate_condition cond)) rs' = Some (negb b)
      end
   /\ forall r, data_preg r = true -> rs'#r = rs r.
 Proof.
@@ -921,58 +922,78 @@ Proof.
 - (* comp *)
   simpl. rewrite (ireg_of_eq _ _ EQ). rewrite (ireg_of_eq _ _ EQ1).
   econstructor. split. apply exec_straight_one. simpl. eauto. auto.
-  split. destruct (Val.cmp_bool c0 (rs x) (rs x0)) eqn:?; auto.
+  split. destruct (Val.cmp_bool c0 (rs x) (rs x0)) eqn:?; auto. split.
+  eapply testcond_for_signed_comparison_32_correct; eauto.
   eapply testcond_for_signed_comparison_32_correct; eauto.
+  rewrite Val.negate_cmp_bool, Heqo; auto.
   intros. unfold compare_ints. Simplifs.
 - (* compu *)
   simpl. rewrite (ireg_of_eq _ _ EQ). rewrite (ireg_of_eq _ _ EQ1).
   econstructor. split. apply exec_straight_one. simpl. eauto. auto.
-  split. destruct (Val.cmpu_bool (Mem.valid_pointer m) c0 (rs x) (rs x0)) eqn:?; auto.
+  split. destruct (Val.cmpu_bool (Mem.valid_pointer m) c0 (rs x) (rs x0)) eqn:?; auto. split.
   eapply testcond_for_unsigned_comparison_32_correct; eauto.
+  eapply testcond_for_unsigned_comparison_32_correct; eauto.
+  rewrite Val.negate_cmpu_bool, Heqo; auto.
   intros. unfold compare_ints. Simplifs.
 - (* compimm *)
   simpl. rewrite (ireg_of_eq _ _ EQ). destruct (Int.eq_dec n Int.zero).
   econstructor; split. apply exec_straight_one. simpl; eauto. auto.
-  split. destruct (rs x); simpl; auto. subst. rewrite Int.and_idem.
+  split. destruct (rs x); simpl; auto. subst. rewrite Int.and_idem. split.
+  eapply testcond_for_signed_comparison_32_correct; eauto.
   eapply testcond_for_signed_comparison_32_correct; eauto.
+  rewrite Val.negate_cmp_bool; auto.
   intros. unfold compare_ints. Simplifs.
   econstructor; split. apply exec_straight_one. simpl; eauto. auto.
-  split. destruct (Val.cmp_bool c0 (rs x) (Vint n)) eqn:?; auto.
+  split. destruct (Val.cmp_bool c0 (rs x) (Vint n)) eqn:?; auto. split.
   eapply testcond_for_signed_comparison_32_correct; eauto.
+  eapply testcond_for_signed_comparison_32_correct; eauto.
+  rewrite Val.negate_cmp_bool, Heqo; auto.
   intros. unfold compare_ints. Simplifs.
 - (* compuimm *)
   simpl. rewrite (ireg_of_eq _ _ EQ).
   econstructor. split. apply exec_straight_one. simpl. eauto. auto.
-  split. destruct (Val.cmpu_bool (Mem.valid_pointer m) c0 (rs x) (Vint n)) eqn:?; auto.
+  split. destruct (Val.cmpu_bool (Mem.valid_pointer m) c0 (rs x) (Vint n)) eqn:?; auto; split.
+  eapply testcond_for_unsigned_comparison_32_correct; eauto.
   eapply testcond_for_unsigned_comparison_32_correct; eauto.
+  rewrite Val.negate_cmpu_bool, Heqo; auto.
   intros. unfold compare_ints. Simplifs.
 - (* compl *)
   simpl. rewrite (ireg_of_eq _ _ EQ). rewrite (ireg_of_eq _ _ EQ1).
   econstructor. split. apply exec_straight_one. simpl. eauto. auto.
-  split. destruct (Val.cmpl_bool c0 (rs x) (rs x0)) eqn:?; auto.
+  split. destruct (Val.cmpl_bool c0 (rs x) (rs x0)) eqn:?; auto. split.
   eapply testcond_for_signed_comparison_64_correct; eauto.
+  eapply testcond_for_signed_comparison_64_correct; eauto.
+  rewrite Val.negate_cmpl_bool, Heqo; auto.
   intros. unfold compare_longs. Simplifs.
 - (* complu *)
   simpl. rewrite (ireg_of_eq _ _ EQ). rewrite (ireg_of_eq _ _ EQ1).
   econstructor. split. apply exec_straight_one. simpl. eauto. auto.
-  split. destruct (Val.cmplu_bool (Mem.valid_pointer m) c0 (rs x) (rs x0)) eqn:?; auto.
+  split. destruct (Val.cmplu_bool (Mem.valid_pointer m) c0 (rs x) (rs x0)) eqn:?; auto. split.
+  eapply testcond_for_unsigned_comparison_64_correct; eauto.
   eapply testcond_for_unsigned_comparison_64_correct; eauto.
+  rewrite Val.negate_cmplu_bool, Heqo; auto.
   intros. unfold compare_longs. Simplifs.
 - (* compimm *)
   simpl. rewrite (ireg_of_eq _ _ EQ). destruct (Int64.eq_dec n Int64.zero).
   econstructor; split. apply exec_straight_one. simpl; eauto. auto.
-  split. destruct (rs x); simpl; auto. subst. rewrite Int64.and_idem.
+  split. destruct (rs x); simpl; auto. subst. rewrite Int64.and_idem. split.
   eapply testcond_for_signed_comparison_64_correct; eauto.
+  eapply testcond_for_signed_comparison_64_correct; eauto.
+  rewrite Val.negate_cmpl_bool; auto.
   intros. unfold compare_longs. Simplifs.
   econstructor; split. apply exec_straight_one. simpl; eauto. auto.
-  split. destruct (Val.cmpl_bool c0 (rs x) (Vlong n)) eqn:?; auto.
+  split. destruct (Val.cmpl_bool c0 (rs x) (Vlong n)) eqn:?; auto. split.
+  eapply testcond_for_signed_comparison_64_correct; eauto.
   eapply testcond_for_signed_comparison_64_correct; eauto.
+  rewrite Val.negate_cmpl_bool, Heqo; auto.
   intros. unfold compare_longs. Simplifs.
 - (* compuimm *)
   simpl. rewrite (ireg_of_eq _ _ EQ).
   econstructor. split. apply exec_straight_one. simpl. eauto. auto.
-  split. destruct (Val.cmplu_bool (Mem.valid_pointer m) c0 (rs x) (Vlong n)) eqn:?; auto.
+  split. destruct (Val.cmplu_bool (Mem.valid_pointer m) c0 (rs x) (Vlong n)) eqn:?; auto. split.
   eapply testcond_for_unsigned_comparison_64_correct; eauto.
+  eapply testcond_for_unsigned_comparison_64_correct; eauto.
+  rewrite Val.negate_cmplu_bool, Heqo; auto.
   intros. unfold compare_longs. Simplifs.
 - (* compf *)
   simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1).
@@ -981,7 +1002,9 @@ Proof.
   destruct c0; simpl; auto.
   unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats_inv; auto with asmgen.
   split. destruct (rs x); destruct (rs x0); simpl; auto.
-  repeat rewrite swap_floats_commut. apply testcond_for_float_comparison_correct.
+  repeat rewrite swap_floats_commut. split.
+  apply testcond_for_float_comparison_correct.
+  apply testcond_for_neg_float_comparison_correct.
   intros. Simplifs. apply compare_floats_inv; auto with asmgen.
 - (* notcompf *)
   simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1).
@@ -990,7 +1013,9 @@ Proof.
   destruct c0; simpl; auto.
   unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats_inv; auto with asmgen.
   split. destruct (rs x); destruct (rs x0); simpl; auto.
-  repeat rewrite swap_floats_commut. apply testcond_for_neg_float_comparison_correct.
+  repeat rewrite swap_floats_commut. split.
+  apply testcond_for_neg_float_comparison_correct.
+  rewrite negb_involutive. apply testcond_for_float_comparison_correct.
   intros. Simplifs. apply compare_floats_inv; auto with asmgen.
 - (* compfs *)
   simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1).
@@ -999,7 +1024,9 @@ Proof.
   destruct c0; simpl; auto.
   unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats32_inv; auto with asmgen.
   split. destruct (rs x); destruct (rs x0); simpl; auto.
-  repeat rewrite swap_floats_commut. apply testcond_for_float32_comparison_correct.
+  repeat rewrite swap_floats_commut. split.
+  apply testcond_for_float32_comparison_correct.
+  apply testcond_for_neg_float32_comparison_correct.
   intros. Simplifs. apply compare_floats32_inv; auto with asmgen.
 - (* notcompfs *)
   simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1).
@@ -1008,7 +1035,9 @@ Proof.
   destruct c0; simpl; auto.
   unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats32_inv; auto with asmgen.
   split. destruct (rs x); destruct (rs x0); simpl; auto.
-  repeat rewrite swap_floats_commut. apply testcond_for_neg_float32_comparison_correct.
+  repeat rewrite swap_floats_commut. split.
+  apply testcond_for_neg_float32_comparison_correct.
+  rewrite negb_involutive. apply testcond_for_float32_comparison_correct.
   intros. Simplifs. apply compare_floats32_inv; auto with asmgen.
 - (* maskzero *)
   simpl. rewrite (ireg_of_eq _ _ EQ).
@@ -1133,6 +1162,94 @@ Proof.
   intuition Simplifs.
 Qed.
 
+Definition negate_extcond (xc: extcond) : extcond :=
+  match xc with
+  | Cond_base c => Cond_base (negate_testcond c)
+  | Cond_and c1 c2 => Cond_or (negate_testcond c1) (negate_testcond c2)
+  | Cond_or c1 c2 => Cond_and (negate_testcond c1) (negate_testcond c2)
+  end.
+
+Remark negate_testcond_for_condition:
+  forall cond,
+  negate_extcond (testcond_for_condition cond) = testcond_for_condition (negate_condition cond).
+Proof.
+  intros. destruct cond; try destruct c; reflexivity.
+Qed.
+
+Lemma mk_sel_correct:
+  forall xc ty rd r2 k c ob rs m,
+  mk_sel xc rd r2 k = OK c ->
+  rd <> r2 ->
+  match ob with
+  | Some b => eval_extcond xc rs = Some b /\ eval_extcond (negate_extcond xc) rs = Some (negb b)
+  | None => True
+  end ->
+  exists rs',
+     exec_straight ge fn c rs m k rs' m
+  /\ Val.lessdef (Val.select ob rs#rd rs#r2 ty) rs'#rd
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs r.
+Proof.
+  intros. destruct xc; monadInv H; simpl in H1.
+- econstructor; split.
+  eapply exec_straight_one. reflexivity. reflexivity.
+  set (v :=  match eval_testcond (negate_testcond c0) rs with
+     | Some true => rs r2
+     | Some false => rs rd
+     | None => Vundef
+     end).
+  split. rewrite nextinstr_inv, Pregmap.gss by eauto with asmgen.
+  destruct ob; simpl; auto. destruct H1 as [_ B]; unfold v; rewrite B. 
+  destruct b; apply Val.lessdef_normalize.
+  intros; Simplifs.
+- econstructor; split.
+  eapply exec_straight_two. 
+  reflexivity. reflexivity. reflexivity. reflexivity.
+  set (v1 :=  match eval_testcond (negate_testcond c1) rs with
+     | Some true => rs r2
+     | Some false => rs rd
+     | None => Vundef
+     end).
+  rewrite eval_testcond_nextinstr, eval_testcond_set_ireg. 
+  set (v2 :=  match eval_testcond (negate_testcond c2) rs with
+     | Some true => nextinstr rs # rd <- v1 r2
+     | Some false => nextinstr rs # rd <- v1 rd
+     | None => Vundef
+     end).
+  split. rewrite nextinstr_inv, Pregmap.gss by eauto with asmgen.
+  destruct ob; simpl; auto.
+  destruct H1 as [_ B]. 
+  destruct (eval_testcond (negate_testcond c1) rs) as [b1|]; try discriminate.
+  destruct (eval_testcond (negate_testcond c2) rs) as [b2|]; try discriminate.
+  inv B. apply negb_sym in H1. subst b.
+  replace v2 with (if b2 then rs#r2 else v1).
+  unfold v1. destruct b1, b2; apply Val.lessdef_normalize.
+  unfold v2. destruct b2; symmetry; Simplifs.
+  intros; Simplifs.
+Qed.
+
+Lemma transl_sel_correct:
+  forall ty cond args rd r2 k c rs m,
+  transl_sel cond args rd r2 k = OK c ->
+  exists rs',
+     exec_straight ge fn c rs m k rs' m
+  /\ Val.lessdef (Val.select (eval_condition cond (map rs (map preg_of args)) m) rs#rd rs#r2 ty) rs'#rd
+  /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs r.
+Proof.
+  unfold transl_sel; intros. destruct (ireg_eq rd r2); monadInv H. 
+- econstructor; split. 
+  apply exec_straight_one; reflexivity.
+  split. rewrite nextinstr_inv, Pregmap.gss by auto with asmgen. 
+  destruct eval_condition as [[]|]; simpl; auto using Val.lessdef_normalize.
+  intros; Simplifs.
+- destruct (transl_cond_correct _ _ _ _ rs m EQ0) as (rs1 & A & B & C).
+  rewrite <- negate_testcond_for_condition in B.
+  destruct (mk_sel_correct _ ty _ _ _ _ _ rs1 m EQ n B) as (rs2 & D & E & F).
+  exists rs2; split. 
+  eapply exec_straight_trans; eauto. 
+  split. rewrite ! C in E by auto with asmgen. exact E.
+  intros. rewrite F; auto.
+Qed.
+
 (** Translation of arithmetic operations. *)
 
 Ltac ArgsInv :=
@@ -1142,7 +1259,9 @@ Ltac ArgsInv :=
   | [ H: bind _ _ = OK _ |- _ ] => monadInv H; ArgsInv
   | [ H: match _ with left _ => _ | right _ => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv
   | [ H: match _ with true => _ | false => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv
-  | [ H: ireg_of _ = OK _ |- _ ] => simpl in *; rewrite (ireg_of_eq _ _ H) in *; clear H; ArgsInv
+  | [ H: ireg_of _ = OK _ |- _ ] => simpl in *; rewrite (ireg_of_eq _ _ H) in *; 
+                                    let X := fresh "EQ" in generalize (ireg_of_eq _ _ H); intros X;
+                                    clear H; ArgsInv
   | [ H: freg_of _ = OK _ |- _ ] => simpl in *; rewrite (freg_of_eq _ _ H) in *; clear H; ArgsInv
   | _ => idtac
   end.
@@ -1334,9 +1453,12 @@ Transparent destroyed_by_op.
   exists rs3.
   split. eapply exec_straight_trans. eexact P. eexact S.
   split. rewrite T. destruct (eval_condition cond rs ## (preg_of ## args) m).
-  rewrite Q. auto.
+  destruct Q as [Q _]. rewrite Q. auto.
   simpl; auto.
   intros. transitivity (rs2 r); auto.
+(* selection *)
+  rewrite EQ1. exploit transl_sel_correct; eauto. intros (rs' & A & B & C).
+  exists rs'; split. eexact A. eauto.
 Qed.
 
 (** Translation of memory loads. *)
diff --git a/x86/Builtins1.v b/x86/Builtins1.v
new file mode 100644
index 00000000..f1d60961
--- /dev/null
+++ b/x86/Builtins1.v
@@ -0,0 +1,54 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, Collège de France and Inria Paris            *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Platform-specific built-in functions *)
+
+Require Import String Coqlib.
+Require Import AST Integers Floats Values.
+Require Import Builtins0.
+
+Inductive platform_builtin : Type :=
+  | BI_fmin
+  | BI_fmax.
+
+Local Open Scope string_scope.
+
+Definition platform_builtin_table : list (string * platform_builtin) :=
+     ("__builtin_fmin", BI_fmin)
+  :: ("__builtin_fmax", BI_fmax)
+  :: nil.
+
+Definition platform_builtin_sig (b: platform_builtin) : signature :=
+  match b with
+  | BI_fmin | BI_fmax =>
+      mksignature (Tfloat :: Tfloat :: nil) Tfloat cc_default
+  end.
+
+Definition platform_builtin_sem (b: platform_builtin) : builtin_sem (sig_res (platform_builtin_sig b)) :=
+  match b with
+  | BI_fmin =>
+      mkbuiltin_n2t Tfloat Tfloat Tfloat
+        (fun f1 f2 => match Float.compare f1 f2 with
+                      | Some Eq | Some Lt => f1
+                      | Some Gt | None => f2
+                      end)
+  | BI_fmax =>
+      mkbuiltin_n2t Tfloat Tfloat Tfloat
+        (fun f1 f2 => match Float.compare f1 f2 with
+                      | Some Eq | Some Gt => f1
+                      | Some Lt | None => f2
+                      end)
+  end.
+
diff --git a/x86/CBuiltins.ml b/x86/CBuiltins.ml
index 69a2eb64..e7f714c7 100644
--- a/x86/CBuiltins.ml
+++ b/x86/CBuiltins.ml
@@ -26,13 +26,11 @@ let (va_list_type, va_list_scalar, size_va_list) =
     (TPtr(TVoid [], []), true, 4)
 
 let builtins = {
-  Builtins.typedefs = [
+  builtin_typedefs = [
     "__builtin_va_list", va_list_type;
   ];
-  Builtins.functions = [
+  builtin_functions = [
     (* Integer arithmetic *)
-    "__builtin_bswap64",
-      (TInt(IULongLong, []), [TInt(IULongLong, [])], false);
     "__builtin_clz",
       (TInt(IInt, []), [TInt(IUInt, [])], false);
     "__builtin_clzl",
@@ -75,9 +73,6 @@ let builtins = {
       (TVoid [], [TPtr(TInt(IUShort, []), []); TInt(IUShort, [])], false);
     "__builtin_write32_reversed",
       (TVoid [], [TPtr(TInt(IUInt, []), []); TInt(IUInt, [])], false);
-    (* no operation *)
-    "__builtin_nop",
-      (TVoid [], [], false);
   ]
 }
 
diff --git a/x86/ConstpropOp.vp b/x86/ConstpropOp.vp
index f59b9dba..ada8d54a 100644
--- a/x86/ConstpropOp.vp
+++ b/x86/ConstpropOp.vp
@@ -16,7 +16,7 @@
 Require Import Coqlib Compopts.
 Require Import AST Integers Floats.
 Require Import Op Registers.
-Require Import ValueDomain.
+Require Import ValueDomain ValueAOp.
 
 (** * Converting known values to constants *)
 
@@ -98,6 +98,15 @@ Nondetfunction make_cmp (c: condition) (args: list reg) (vl: list aval) :=
       make_cmp_base c args vl
   end.
 
+Definition make_select (c: condition) (ty: typ)
+                       (r1 r2: reg) (args: list reg) (vl: list aval) :=
+  match resolve_branch (eval_static_condition c vl) with
+  | Some b => (Omove, (if b then r1 else r2) :: nil)
+  | None =>
+      let (c', args') := cond_strength_reduction c args vl in
+      (Osel c' ty, r1 :: r2 :: args')
+  end.
+
 (** For addressing modes, we need to distinguish
 - reductions that produce pointers (i.e. that produce [Aglobal], [Ainstack], [Abased] and [Abasedscaled] addressing modes), which are valid only if the pointer size is right;
 - other reductions (producing [Aindexed] or [Aindexed2] modes), which are valid independently of the pointer size.
@@ -416,6 +425,7 @@ Nondetfunction op_strength_reduction
       let (addr', args') := addr_strength_reduction_64 addr args vl in
       (Oleal addr', args')
   | Ocmp c, args, vl => make_cmp c args vl
+  | Osel c ty, r1 :: r2 :: args, v1 :: v2 :: vl => make_select c ty r1 r2 args vl
   | Omulf, r1 :: r2 :: nil, v1 :: F n2 :: nil => make_mulfimm n2 r1 r1 r2
   | Omulf, r1 :: r2 :: nil, F n1 :: v2 :: nil => make_mulfimm n1 r2 r1 r2
   | Omulfs, r1 :: r2 :: nil, v1 :: FS n2 :: nil => make_mulfsimm n2 r1 r1 r2
diff --git a/x86/ConstpropOpproof.v b/x86/ConstpropOpproof.v
index 3bb0f3cd..6d2df9c1 100644
--- a/x86/ConstpropOpproof.v
+++ b/x86/ConstpropOpproof.v
@@ -14,7 +14,7 @@
 
 Require Import Coqlib Compopts.
 Require Import Integers Floats Values Memory Globalenvs Events.
-Require Import Op Registers RTL ValueDomain.
+Require Import Op Registers RTL ValueDomain ValueAOp ValueAnalysis.
 Require Import ConstpropOp.
 
 Section STRENGTH_REDUCTION.
@@ -371,6 +371,28 @@ Proof.
 - apply make_cmp_base_correct; auto.
 Qed.
 
+Lemma make_select_correct:
+  forall c ty r1 r2 args vl,
+  vl = map (fun r => AE.get r ae) args ->
+  let (op', args') := make_select c ty r1 r2 args vl in
+  exists v, eval_operation ge (Vptr sp Ptrofs.zero) op' e##args' m = Some v
+         /\ Val.lessdef (Val.select (eval_condition c e##args m) e#r1 e#r2 ty) v.
+Proof.
+  unfold make_select; intros.
+  destruct (resolve_branch (eval_static_condition c vl)) as [b|] eqn:RB.
+- exists (if b then e#r1 else e#r2); split.
++ simpl. destruct b; auto.
++ destruct (eval_condition c e##args m) as [b'|] eqn:EC; simpl; auto.
+  assert (b = b').
+  { eapply resolve_branch_sound; eauto. 
+    rewrite <- EC. apply eval_static_condition_sound with bc. 
+    subst vl. exact (aregs_sound _ _ _ args MATCH). }
+  subst b'. apply Val.lessdef_normalize.
+- generalize (cond_strength_reduction_correct c args vl H).
+  destruct (cond_strength_reduction c args vl) as [cond' args']; intros EQ.
+  econstructor; split. simpl; eauto. rewrite EQ; auto.
+Qed.
+
 Lemma make_addimm_correct:
   forall n r,
   let (op, args) := make_addimm n r in
@@ -905,6 +927,8 @@ Proof.
   auto.
 (* cond *)
   inv H0. apply make_cmp_correct; auto.
+(* select *)
+  inv H0. apply make_select_correct; congruence.
 (* mulf *)
   InvApproxRegs; SimplVM; inv H0. rewrite <- H2. apply make_mulfimm_correct; auto.
   InvApproxRegs; SimplVM; inv H0. fold (Val.mulf (Vfloat n1) e#r2).
diff --git a/x86/Conventions1.v b/x86/Conventions1.v
index 646c4afb..fdd94239 100644
--- a/x86/Conventions1.v
+++ b/x86/Conventions1.v
@@ -99,22 +99,20 @@ Definition is_float_reg (r: mreg) :=
   function with one integer result. *)
 
 Definition loc_result_32 (s: signature) : rpair mreg :=
-  match s.(sig_res) with
-  | None => One AX
-  | Some (Tint | Tany32) => One AX
-  | Some (Tfloat | Tsingle) => One FP0
-  | Some Tany64 => One X0
-  | Some Tlong => Twolong DX AX
+  match proj_sig_res s with
+  | Tint | Tany32 => One AX
+  | Tfloat | Tsingle => One FP0
+  | Tany64 => One X0
+  | Tlong => Twolong DX AX
   end.
 
 (** In 64 bit mode, he result value of a function is passed back to
   the caller in registers [AX] or [X0]. *)
 
 Definition loc_result_64 (s: signature) : rpair mreg :=
-  match s.(sig_res) with
-  | None => One AX
-  | Some (Tint | Tlong | Tany32 | Tany64) => One AX
-  | Some (Tfloat | Tsingle) => One X0
+  match proj_sig_res s with
+  | Tint | Tlong | Tany32 | Tany64 => One AX
+  | Tfloat | Tsingle => One X0
   end.
 
 Definition loc_result :=
@@ -126,8 +124,8 @@ Lemma loc_result_type:
   forall sig,
   subtype (proj_sig_res sig) (typ_rpair mreg_type (loc_result sig)) = true.
 Proof.
-  intros. unfold proj_sig_res, loc_result, loc_result_32, loc_result_64, mreg_type;
-  destruct Archi.ptr64; destruct (sig_res sig) as [[]|]; auto.
+  intros. unfold loc_result, loc_result_32, loc_result_64, mreg_type;
+  destruct Archi.ptr64; destruct (proj_sig_res sig); auto.
 Qed.
 
 (** The result locations are caller-save registers *)
@@ -137,7 +135,7 @@ Lemma loc_result_caller_save:
   forall_rpair (fun r => is_callee_save r = false) (loc_result s).
 Proof.
   intros. unfold loc_result, loc_result_32, loc_result_64, is_callee_save;
-  destruct Archi.ptr64; destruct (sig_res s) as [[]|]; simpl; auto.
+  destruct Archi.ptr64; destruct (proj_sig_res s); simpl; auto.
 Qed.
 
 (** If the result is in a pair of registers, those registers are distinct and have type [Tint] at least. *)
@@ -147,14 +145,14 @@ Lemma loc_result_pair:
   match loc_result sg with
   | One _ => True
   | Twolong r1 r2 =>
-       r1 <> r2 /\ sg.(sig_res) = Some Tlong
+       r1 <> r2 /\ proj_sig_res sg = Tlong
     /\ subtype Tint (mreg_type r1) = true /\ subtype Tint (mreg_type r2) = true
     /\ Archi.ptr64 = false
   end.
 Proof.
   intros. 
   unfold loc_result, loc_result_32, loc_result_64, mreg_type;
-  destruct Archi.ptr64; destruct (sig_res sg) as [[]|]; auto.
+  destruct Archi.ptr64; destruct (proj_sig_res sg); auto.
   split; auto. congruence.
 Qed.
 
@@ -163,7 +161,7 @@ Qed.
 Lemma loc_result_exten:
   forall s1 s2, s1.(sig_res) = s2.(sig_res) -> loc_result s1 = loc_result s2.
 Proof.
-  intros. unfold loc_result, loc_result_32, loc_result_64.
+  intros. unfold loc_result, loc_result_32, loc_result_64, proj_sig_res.
   destruct Archi.ptr64; rewrite H; auto.
 Qed.
 
@@ -222,36 +220,6 @@ Definition loc_arguments (s: signature) : list (rpair loc) :=
   then loc_arguments_64 s.(sig_args) 0 0 0
   else loc_arguments_32 s.(sig_args) 0.
 
-(** [size_arguments s] returns the number of [Outgoing] slots used
-  to call a function with signature [s]. *)
-
-Fixpoint size_arguments_32
-    (tyl: list typ) (ofs: Z) {struct tyl} : Z :=
-  match tyl with
-  | nil => ofs
-  | ty :: tys => size_arguments_32 tys (ofs + typesize ty)
-  end.
-
-Fixpoint size_arguments_64 (tyl: list typ) (ir fr ofs: Z) {struct tyl} : Z :=
-  match tyl with
-  | nil => ofs
-  | (Tint | Tlong | Tany32 | Tany64) :: tys =>
-      match list_nth_z int_param_regs ir with
-      | None => size_arguments_64 tys ir fr (ofs + 2)
-      | Some ireg => size_arguments_64 tys (ir + 1) fr ofs
-      end
-  | (Tfloat | Tsingle) :: tys =>
-      match list_nth_z float_param_regs fr with
-      | None => size_arguments_64 tys ir fr (ofs + 2)
-      | Some freg => size_arguments_64 tys ir (fr + 1) ofs
-      end
-  end.
-
-Definition size_arguments (s: signature) : Z :=
-  if Archi.ptr64
-  then size_arguments_64 s.(sig_args) 0 0 0
-  else size_arguments_32 s.(sig_args) 0.
-
 (** Argument locations are either caller-save registers or [Outgoing]
   stack slots at nonnegative offsets. *)
 
@@ -353,123 +321,22 @@ Qed.
 
 Hint Resolve loc_arguments_acceptable: locs.
 
-(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)
-
-Remark size_arguments_32_above:
-  forall tyl ofs0, ofs0 <= size_arguments_32 tyl ofs0.
+Lemma loc_arguments_main:
+  loc_arguments signature_main = nil.
 Proof.
-  induction tyl; simpl; intros.
-  omega.
-  apply Z.le_trans with (ofs0 + typesize a); auto.
-  generalize (typesize_pos a); omega.
+  unfold loc_arguments; destruct Archi.ptr64; reflexivity.
 Qed.
 
-Remark size_arguments_64_above:
-  forall tyl ir fr ofs0,
-  ofs0 <= size_arguments_64 tyl ir fr ofs0.
-Proof.
-  induction tyl; simpl; intros.
-  omega.
-  assert (A: ofs0 <=
-    match list_nth_z int_param_regs ir with
-    | Some _ => size_arguments_64 tyl (ir + 1) fr ofs0
-    | None => size_arguments_64 tyl ir fr (ofs0 + 2)
-    end).
-  { destruct (list_nth_z int_param_regs ir); eauto.
-    apply Z.le_trans with (ofs0 + 2); auto. omega. }
-  assert (B: ofs0 <=
-    match list_nth_z float_param_regs fr with
-    | Some _ => size_arguments_64 tyl ir (fr + 1) ofs0
-    | None => size_arguments_64 tyl ir fr (ofs0 + 2)
-    end).
-  { destruct (list_nth_z float_param_regs fr); eauto.
-    apply Z.le_trans with (ofs0 + 2); auto. omega. }
-  destruct a; auto.
-Qed.
+(** ** Normalization of function results *)
 
-Lemma size_arguments_above:
-  forall s, size_arguments s >= 0.
-Proof.
-  intros; unfold size_arguments. apply Z.le_ge.
-  destruct Archi.ptr64; [apply size_arguments_64_above|apply size_arguments_32_above].
-Qed.
+(** In the x86 ABI, a return value of type "char" is returned in
+    register AL, leaving the top 24 bits of EAX unspecified.
+    Likewise, a return value of type "short" is returned in register
+    AH, leaving the top 16 bits of EAX unspecified.  Hence, return
+    values of small integer types need re-normalization after calls. *)
 
-Lemma loc_arguments_32_bounded:
-  forall ofs ty tyl ofs0,
-  In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments_32 tyl ofs0)) ->
-  ofs + typesize ty <= size_arguments_32 tyl ofs0.
-Proof.
-  induction tyl as [ | t l]; simpl; intros x IN.
-- contradiction.
-- rewrite in_app_iff in IN; destruct IN as [IN|IN].
-+ apply Z.le_trans with (x + typesize t); [|apply size_arguments_32_above].
-  Ltac decomp :=
-  match goal with
-  | [ H: _ \/ _ |- _ ] => destruct H; decomp
-  | [ H: S _ _ _ = S _ _ _ |- _ ] => inv H
-  | [ H: False |- _ ] => contradiction
+Definition return_value_needs_normalization (t: rettype) : bool :=
+  match t with
+  | Tint8signed | Tint8unsigned | Tint16signed | Tint16unsigned => true
+  | _ => false
   end.
-  destruct t; simpl in IN; decomp; simpl; omega.
-+ apply IHl; auto.
-Qed.
-
-Lemma loc_arguments_64_bounded:
-  forall ofs ty tyl ir fr ofs0,
-  In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments_64 tyl ir fr ofs0)) ->
-  ofs + typesize ty <= size_arguments_64 tyl ir fr ofs0.
-Proof.
-  induction tyl; simpl; intros.
-  contradiction.
-  assert (T: forall ty0, typesize ty0 <= 2).
-  { destruct ty0; simpl; omega. }
-  assert (A: forall ty0,
-             In (S Outgoing ofs ty) (regs_of_rpairs
-              match list_nth_z int_param_regs ir with
-              | Some ireg =>
-                  One (R ireg) :: loc_arguments_64 tyl (ir + 1) fr ofs0
-              | None => One (S Outgoing ofs0 ty0) :: loc_arguments_64 tyl ir fr (ofs0 + 2)
-              end) ->
-             ofs + typesize ty <=
-             match list_nth_z int_param_regs ir with
-             | Some _ => size_arguments_64 tyl (ir + 1) fr ofs0
-             | None => size_arguments_64 tyl ir fr (ofs0 + 2)
-             end).
-  { intros. destruct (list_nth_z int_param_regs ir); simpl in H0; destruct H0.
-  - discriminate.
-  - eapply IHtyl; eauto.
-  - inv H0. apply Z.le_trans with (ofs + 2). specialize (T ty). omega. apply size_arguments_64_above.
-  - eapply IHtyl; eauto. }
-  assert (B: forall ty0,
-             In (S Outgoing ofs ty) (regs_of_rpairs
-              match list_nth_z float_param_regs fr with
-              | Some ireg =>
-                  One (R ireg) :: loc_arguments_64 tyl ir (fr + 1) ofs0
-              | None => One (S Outgoing ofs0 ty0) :: loc_arguments_64 tyl ir fr (ofs0 + 2)
-              end) ->
-             ofs + typesize ty <=
-             match list_nth_z float_param_regs fr with
-             | Some _ => size_arguments_64 tyl ir (fr + 1) ofs0
-             | None => size_arguments_64 tyl ir fr (ofs0 + 2)
-             end).
-  { intros. destruct (list_nth_z float_param_regs fr); simpl in H0; destruct H0.
-  - discriminate.
-  - eapply IHtyl; eauto.
-  - inv H0. apply Z.le_trans with (ofs + 2). specialize (T ty). omega. apply size_arguments_64_above.
-  - eapply IHtyl; eauto. }
-  destruct a; eauto.
-Qed.
-
-Lemma loc_arguments_bounded:
-  forall (s: signature) (ofs: Z) (ty: typ),
-  In (S Outgoing ofs ty) (regs_of_rpairs (loc_arguments s)) ->
-  ofs + typesize ty <= size_arguments s.
-Proof.
-  unfold loc_arguments, size_arguments; intros.
-  destruct Archi.ptr64; eauto using loc_arguments_32_bounded, loc_arguments_64_bounded.
-Qed.
-
-Lemma loc_arguments_main:
-  loc_arguments signature_main = nil.
-Proof.
-  unfold loc_arguments; destruct Archi.ptr64; reflexivity.
-Qed.
diff --git a/x86/Machregs.v b/x86/Machregs.v
index bdf492ed..6f3064b8 100644
--- a/x86/Machregs.v
+++ b/x86/Machregs.v
@@ -351,6 +351,7 @@ Definition two_address_op (op: operation) : bool :=
   | Olongofsingle => false
   | Osingleoflong => false
   | Ocmp c => false
+  | Osel c op => true
   end.
 
 (* Constraints on constant propagation for builtins *)
diff --git a/x86/NeedOp.v b/x86/NeedOp.v
index 68ecc745..d9a58fbb 100644
--- a/x86/NeedOp.v
+++ b/x86/NeedOp.v
@@ -120,6 +120,7 @@ Definition needs_of_operation (op: operation) (nv: nval): list nval :=
   | Ointoffloat | Ofloatofint | Ointofsingle | Osingleofint => op1 (default nv)
   | Olongoffloat | Ofloatoflong | Olongofsingle | Osingleoflong => op1 (default nv)
   | Ocmp c => needs_of_condition c
+  | Osel c ty => nv :: nv :: needs_of_condition c
   end.
 
 Definition operation_is_redundant (op: operation) (nv: nval): bool :=
@@ -231,6 +232,10 @@ Proof.
   erewrite needs_of_condition_sound by eauto.
   subst v; simpl. auto with na.
   subst v; auto with na.
+- destruct (eval_condition c args m) as [b|] eqn:EC.
+  erewrite needs_of_condition_sound by eauto.
+  apply select_sound; auto.
+  simpl; auto with na.
 Qed.
 
 Lemma operation_is_redundant_sound:
diff --git a/x86/Op.v b/x86/Op.v
index 79c84ca2..16d75426 100644
--- a/x86/Op.v
+++ b/x86/Op.v
@@ -167,7 +167,9 @@ Inductive operation : Type :=
   | Olongofsingle            (**r [rd = signed_long_of_float32(r1)] *)
   | Osingleoflong            (**r [rd = float32_of_signed_long(r1)] *)
 (*c Boolean tests: *)
-  | Ocmp (cond: condition).  (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
+  | Ocmp (cond: condition)  (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
+  | Osel: condition -> typ -> operation.
+                             (**r [rd = rs1] if condition holds, [rd = rs2] otherwise. *)
 
 (** Comparison functions (used in modules [CSE] and [Allocation]). *)
 
@@ -186,7 +188,7 @@ Defined.
 
 Definition beq_operation: forall (x y: operation), bool.
 Proof.
-  generalize Int.eq_dec Int64.eq_dec Float.eq_dec Float32.eq_dec ident_eq eq_addressing eq_condition; boolean_equality.
+  generalize Int.eq_dec Int64.eq_dec Float.eq_dec Float32.eq_dec ident_eq typ_eq eq_addressing eq_condition; boolean_equality.
 Defined.
 
 Definition eq_operation: forall (x y: operation), {x=y} + {x<>y}.
@@ -407,6 +409,7 @@ Definition eval_operation
   | Olongofsingle, v1::nil => Val.longofsingle v1
   | Osingleoflong, v1::nil => Val.singleoflong v1
   | Ocmp c, _ => Some(Val.of_optbool (eval_condition c vl m))
+  | Osel c ty, v1::v2::vl => Some(Val.select (eval_condition c vl m) v1 v2 ty)
   | _, _ => None
   end.
 
@@ -578,6 +581,7 @@ Definition type_of_operation (op: operation) : list typ * typ :=
   | Olongofsingle => (Tsingle :: nil, Tlong)
   | Osingleoflong => (Tlong :: nil, Tsingle)
   | Ocmp c => (type_of_condition c, Tint)
+  | Osel c ty => (ty :: ty :: type_of_condition c, ty)
   end.
 
 (** Weak type soundness results for [eval_operation]:
@@ -735,6 +739,7 @@ Proof with (try exact I; try reflexivity).
   destruct v0; simpl in H0; inv H0. destruct (Float32.to_long f); inv H2...
   destruct v0; simpl in H0; inv H0...
   destruct (eval_condition cond vl m); simpl... destruct b...
+  unfold Val.select. destruct (eval_condition c vl m). apply Val.normalize_type. exact I.
 Qed.
 
 End SOUNDNESS.
@@ -958,23 +963,42 @@ Definition is_trivial_op (op: operation) : bool :=
 
 (** Operations that depend on the memory state. *)
 
+Definition condition_depends_on_memory (c: condition) : bool :=
+  match c with
+  | Ccompu _ => negb Archi.ptr64
+  | Ccompuimm _ _ => negb Archi.ptr64
+  | Ccomplu _ => Archi.ptr64
+  | Ccompluimm _ _ => Archi.ptr64
+  | _ => false
+  end.
+
 Definition op_depends_on_memory (op: operation) : bool :=
   match op with
-  | Ocmp (Ccompu _) => negb Archi.ptr64
-  | Ocmp (Ccompuimm _ _) => negb Archi.ptr64
-  | Ocmp (Ccomplu _) => Archi.ptr64
-  | Ocmp (Ccompluimm _ _) => Archi.ptr64
+  | Ocmp c => condition_depends_on_memory c
+  | Osel c ty => condition_depends_on_memory c
   | _ => false
   end.
 
+Lemma condition_depends_on_memory_correct:
+  forall c args m1 m2,
+  condition_depends_on_memory c = false ->
+  eval_condition c args m1 = eval_condition c args m2.
+Proof.
+  intros until m2. 
+  destruct c; simpl; intros SF; auto; rewrite ? negb_false_iff in SF;
+  unfold Val.cmpu_bool, Val.cmplu_bool; rewrite SF; reflexivity.
+Qed.
+
 Lemma op_depends_on_memory_correct:
   forall (F V: Type) (ge: Genv.t F V) sp op args m1 m2,
   op_depends_on_memory op = false ->
   eval_operation ge sp op args m1 = eval_operation ge sp op args m2.
 Proof.
-  intros until m2. destruct op; simpl; try congruence.
-  destruct cond; simpl; intros SF; auto; rewrite ? negb_false_iff in SF;
-  unfold Val.cmpu_bool, Val.cmplu_bool; rewrite SF; reflexivity.
+  intros until m2. destruct op; simpl; try congruence; intros C.
+- f_equal; f_equal; apply condition_depends_on_memory_correct; auto.
+- destruct args; auto. destruct args; auto.
+  rewrite (condition_depends_on_memory_correct c args m1 m2 C).
+  auto.
 Qed.
 
 (** Global variables mentioned in an operation or addressing mode *)
@@ -1290,6 +1314,9 @@ Proof.
   exploit eval_condition_inj; eauto. intros EQ; rewrite EQ.
   destruct b; simpl; constructor.
   simpl; constructor.
+  apply Val.select_inject; auto.  
+  destruct (eval_condition c vl1 m1) eqn:?; auto.
+  right; symmetry; eapply eval_condition_inj; eauto.
 Qed.
 
 End EVAL_COMPAT.
diff --git a/x86/PrintOp.ml b/x86/PrintOp.ml
index faa5bb5f..6aa4d450 100644
--- a/x86/PrintOp.ml
+++ b/x86/PrintOp.ml
@@ -164,6 +164,10 @@ let print_operation reg pp = function
   | Olongofsingle, [r1] -> fprintf pp "longofsingle(%a)" reg r1
   | Osingleoflong, [r1] -> fprintf pp "singleoflong(%a)" reg r1
   | Ocmp c, args -> print_condition reg pp (c, args)
+  | Osel (c, ty), r1::r2::args ->
+      fprintf pp "%a ?%s %a : %a"
+         (print_condition reg) (c, args)
+         (PrintAST.name_of_type ty) reg r1 reg r2
   | _ -> fprintf pp "<bad operator>"
 
 
diff --git a/x86/SelectOp.vp b/x86/SelectOp.vp
index a1583600..31be8c32 100644
--- a/x86/SelectOp.vp
+++ b/x86/SelectOp.vp
@@ -38,8 +38,9 @@
 
 Require Import Coqlib.
 Require Import Compopts.
-Require Import AST Integers Floats.
+Require Import AST Integers Floats Builtins.
 Require Import Op CminorSel.
+Require Archi.
 
 Local Open Scope cminorsel_scope.
 
@@ -456,7 +457,35 @@ Nondetfunction cast16signed (e: expr) :=
       Eop Ocast16signed (e ::: Enil)
   end.
 
-(** Floating-point conversions *)
+(** ** Selection *)
+
+Definition select_supported (ty: typ) : bool :=
+  match ty with
+  | Tint => true
+  | Tlong => Archi.ptr64
+  | _ => false
+  end.
+
+(** [Asmgen.mk_sel] cannot always handle the conditions that are
+    implemented as a "and" of two processor flags.  However it can
+    handle the negation of those conditions, which are implemented
+    as an "or".  So, for the risky conditions we just take their
+    negation and swap the two arguments of the [select]. *)
+
+Definition select_swap (cond: condition) :=
+  match cond with
+  | Ccompf Cne | Ccompfs Cne | Cnotcompf Ceq | Cnotcompfs Ceq => true
+  | _ => false
+  end.
+
+Definition select (ty: typ) (cond: condition) (args: exprlist) (e1 e2: expr) :=
+  if select_supported ty then
+    if select_swap cond
+    then Some (Eop (Osel (negate_condition cond) ty) (e2 ::: e1 ::: args))
+    else Some (Eop (Osel cond ty) (e1 ::: e2 ::: args))
+  else None.
+
+(** ** Floating-point conversions *)
 
 Definition singleoffloat (e: expr) := Eop Osingleoffloat (e ::: Enil).
 Definition floatofsingle (e: expr) := Eop Ofloatofsingle (e ::: Enil).
@@ -470,21 +499,27 @@ Nondetfunction floatofint (e: expr) :=
   end.
 
 Definition intuoffloat (e: expr) :=
-  Elet e
-    (Elet (Eop (Ofloatconst (Float.of_intu Float.ox8000_0000)) Enil)
-      (Econdition (CEcond (Ccompf Clt) (Eletvar 1 ::: Eletvar 0 ::: Enil))
-        (intoffloat (Eletvar 1))
-        (addimm Float.ox8000_0000 (intoffloat (subf (Eletvar 1) (Eletvar 0))))))%nat.
+  if Archi.splitlong then
+    Elet e
+      (Elet (Eop (Ofloatconst (Float.of_intu Float.ox8000_0000)) Enil)
+        (Econdition (CEcond (Ccompf Clt) (Eletvar 1 ::: Eletvar 0 ::: Enil))
+          (intoffloat (Eletvar 1))
+          (addimm Float.ox8000_0000 (intoffloat (subf (Eletvar 1) (Eletvar 0))))))%nat
+  else
+    Eop Olowlong (Eop Olongoffloat (e ::: Enil) ::: Enil).
 
 Nondetfunction floatofintu (e: expr) :=
   match e with
   | Eop (Ointconst n) Enil => Eop (Ofloatconst (Float.of_intu n)) Enil
   | _ =>
-    let f := Eop (Ofloatconst (Float.of_intu Float.ox8000_0000)) Enil in
-    Elet e
-      (Econdition (CEcond (Ccompuimm Clt Float.ox8000_0000) (Eletvar O ::: Enil))
-        (floatofint (Eletvar O))
-        (addf (floatofint (addimm (Int.neg Float.ox8000_0000) (Eletvar O))) f))
+    if Archi.splitlong then
+      let f := Eop (Ofloatconst (Float.of_intu Float.ox8000_0000)) Enil in
+      Elet e
+        (Econdition (CEcond (Ccompuimm Clt Float.ox8000_0000) (Eletvar O ::: Enil))
+          (floatofint (Eletvar O))
+          (addf (floatofint (addimm (Int.neg Float.ox8000_0000) (Eletvar O))) f))
+    else
+      Eop Ofloatoflong (Eop Ocast32unsigned (e ::: Enil) ::: Enil)
   end.
 
 Definition intofsingle (e: expr) := Eop Ointofsingle (e ::: Enil).
@@ -540,3 +575,8 @@ Nondetfunction builtin_arg (e: expr) :=
   | Eload chunk (Ainstack ofs) Enil => BA_loadstack chunk ofs
   | _ => BA e
   end.
+
+(** Platform-specific known builtins *)
+
+Definition platform_builtin (b: platform_builtin) (args: exprlist) : option expr :=
+  None.
diff --git a/x86/SelectOpproof.v b/x86/SelectOpproof.v
index fdbadaa8..961f602c 100644
--- a/x86/SelectOpproof.v
+++ b/x86/SelectOpproof.v
@@ -13,15 +13,9 @@
 (** Correctness of instruction selection for operators *)
 
 Require Import Coqlib.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Cminor.
-Require Import Op.
-Require Import CminorSel.
+Require Import AST Integers Floats.
+Require Import Values Memory Builtins Globalenvs.
+Require Import Cminor Op CminorSel.
 Require Import SelectOp.
 
 Local Open Scope cminorsel_scope.
@@ -387,9 +381,9 @@ Proof.
 - TrivialExists. simpl. rewrite Int.and_commut; auto.
 - TrivialExists. simpl. rewrite Val.and_assoc. rewrite Int.and_commut. auto.
 - rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc.
-  rewrite Int.and_commut. auto. compute; auto.
+  rewrite Int.and_commut. auto. omega.
 - rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc.
-  rewrite Int.and_commut. auto. compute; auto.
+  rewrite Int.and_commut. auto. omega.
 - TrivialExists.
 Qed.
 
@@ -749,7 +743,7 @@ Proof.
   red; intros until x. unfold cast8unsigned. destruct (cast8unsigned_match a); intros; InvEval.
   TrivialExists.
   subst. rewrite Val.zero_ext_and. rewrite Val.and_assoc.
-  rewrite Int.and_commut. apply eval_andimm; auto. compute; auto.
+  rewrite Int.and_commut. apply eval_andimm; auto. omega.
   TrivialExists.
 Qed.
 
@@ -765,10 +759,36 @@ Proof.
   red; intros until x. unfold cast16unsigned. destruct (cast16unsigned_match a); intros; InvEval.
   TrivialExists.
   subst. rewrite Val.zero_ext_and. rewrite Val.and_assoc.
-  rewrite Int.and_commut. apply eval_andimm; auto. compute; auto.
+  rewrite Int.and_commut. apply eval_andimm; auto. omega.
   TrivialExists.
 Qed.
 
+Theorem eval_select: 
+  forall le ty cond al vl a1 v1 a2 v2 a b,
+  select ty cond al a1 a2 = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  eval_expr ge sp e m le a1 v1 ->
+  eval_expr ge sp e m le a2 v2 ->
+  eval_condition cond vl m = Some b ->
+  exists v, 
+     eval_expr ge sp e m le a v
+  /\ Val.lessdef (Val.select (Some b) v1 v2 ty) v.
+Proof.
+  unfold select; intros. 
+  destruct (select_supported ty); try discriminate.
+  destruct (select_swap cond); inv H.
+- exists (Val.select (Some (negb b)) v2 v1 ty); split.
+  apply eval_Eop with (v2 :: v1 :: vl).
+  constructor; auto. constructor; auto.
+  simpl. rewrite eval_negate_condition, H3; auto.
+  destruct b; auto.
+- exists (Val.select (Some b) v1 v2 ty); split.
+  apply eval_Eop with (v1 :: v2 :: vl).
+  constructor; auto. constructor; auto.
+  simpl. rewrite H3; auto.
+  auto.
+Qed.
+
 Theorem eval_singleoffloat: unary_constructor_sound singleoffloat Val.singleoffloat.
 Proof.
   red; intros. unfold singleoffloat. TrivialExists.
@@ -808,7 +828,8 @@ Proof.
   intros. destruct x; simpl in H0; try discriminate.
   destruct (Float.to_intu f) as [n|] eqn:?; simpl in H0; inv H0.
   exists (Vint n); split; auto. unfold intuoffloat.
-  set (im := Int.repr Int.half_modulus).
+  destruct Archi.splitlong.
+- set (im := Int.repr Int.half_modulus).
   set (fm := Float.of_intu im).
   assert (eval_expr ge sp e m (Vfloat fm :: Vfloat f :: le) (Eletvar (S O)) (Vfloat f)).
     constructor. auto.
@@ -835,6 +856,11 @@ Proof.
   rewrite Int.add_neg_zero in A4.
   rewrite Int.add_zero in A4.
   auto.
+- apply Float.to_intu_to_long in Heqo. repeat econstructor. eauto.
+  simpl. rewrite Heqo; reflexivity.
+  simpl. unfold Int64.loword. rewrite Int64.unsigned_repr, Int.repr_unsigned; auto.
+  assert (Int.modulus < Int64.max_unsigned) by reflexivity. 
+  generalize (Int.unsigned_range n); omega.
 Qed.
 
 Theorem eval_floatofintu:
@@ -844,10 +870,11 @@ Theorem eval_floatofintu:
   exists v, eval_expr ge sp e m le (floatofintu a) v /\ Val.lessdef y v.
 Proof.
   intros until y; unfold floatofintu. case (floatofintu_match a); intros.
-  InvEval. TrivialExists.
-  destruct x; simpl in H0; try discriminate. inv H0.
+- InvEval. TrivialExists.
+- destruct x; simpl in H0; try discriminate. inv H0.
   exists (Vfloat (Float.of_intu i)); split; auto.
-  econstructor. eauto.
+  destruct Archi.splitlong.
++ econstructor. eauto.
   set (fm := Float.of_intu Float.ox8000_0000).
   assert (eval_expr ge sp e m (Vint i :: le) (Eletvar O) (Vint i)).
     constructor. auto.
@@ -863,6 +890,7 @@ Proof.
   constructor. EvalOp. simpl; eauto. constructor. simpl; eauto.
   fold fm. rewrite Float.of_intu_of_int_2; auto.
   rewrite Int.sub_add_opp. auto.
++ rewrite Float.of_intu_of_long. repeat econstructor. eauto. reflexivity. 
 Qed.
 
 Theorem eval_intofsingle:
@@ -984,4 +1012,16 @@ Proof.
 - constructor; auto.
 Qed.
 
+(** Platform-specific known builtins *)
+
+Theorem eval_platform_builtin:
+  forall bf al a vl v le,
+  platform_builtin bf al = Some a ->
+  eval_exprlist ge sp e m le al vl ->
+  platform_builtin_sem bf vl = Some v ->
+  exists v', eval_expr ge sp e m le a v' /\ Val.lessdef v v'.
+Proof.
+  intros. discriminate.
+Qed.
+
 End CMCONSTR.
diff --git a/x86/Stacklayout.v b/x86/Stacklayout.v
index d375febf..96b0c8ef 100644
--- a/x86/Stacklayout.v
+++ b/x86/Stacklayout.v
@@ -58,7 +58,7 @@ Lemma frame_env_separated:
        ** range sp (fe_ofs_callee_save fe) (size_callee_save_area b (fe_ofs_callee_save fe))
        ** P.
 Proof.
-Local Opaque Z.add Z.mul sepconj range.
+Local Opaque Z.add Z.mul sepconj range'.
   intros; simpl.
   set (w := if Archi.ptr64 then 8 else 4).
   set (olink := align (4 * b.(bound_outgoing)) w).
diff --git a/x86/TargetPrinter.ml b/x86/TargetPrinter.ml
index 3ac2f36e..6159437e 100644
--- a/x86/TargetPrinter.ml
+++ b/x86/TargetPrinter.ml
@@ -62,8 +62,8 @@ let ireg64 oc r = output_string oc (int64_reg_name r)
 let ireg = if Archi.ptr64 then ireg64 else ireg32
 let freg oc r = output_string oc (float_reg_name r)
 
-let preg oc = function
-  | IR r -> ireg oc r
+let preg_asm oc ty = function
+  | IR r -> if ty = Tlong then ireg64 oc r else ireg32 oc r
   | FR r -> freg oc r
   | _    -> assert false
 
@@ -103,7 +103,7 @@ let rec log2 n =
   assert (n > 0);
   if n = 1 then 0 else 1 + log2 (n lsr 1)
 
-(* System dependend printer functions *)
+(* System dependent printer functions *)
 module type SYSTEM =
     sig
       val raw_symbol: out_channel -> string -> unit
@@ -134,9 +134,9 @@ module ELF_System : SYSTEM =
     let name_of_section = function
       | Section_text -> ".text"
       | Section_data i | Section_small_data i ->
-          if i then ".data" else "COMM"
+          if i then ".data" else common_section ()
       | Section_const i | Section_small_const i ->
-          if i then ".section	.rodata" else "COMM"
+          if i || (not !Clflags.option_fcommon) then ".section	.rodata" else "COMM"
       | Section_string -> ".section	.rodata"
       | Section_literal -> ".section	.rodata.cst8,\"aM\",@progbits,8"
       | Section_jumptable -> ".text"
@@ -192,9 +192,9 @@ module MacOS_System : SYSTEM =
     let name_of_section = function
       | Section_text -> ".text"
       | Section_data i | Section_small_data i ->
-          if i then ".data" else "COMM"
+          if i || (not !Clflags.option_fcommon) then ".data" else "COMM"
       | Section_const i  | Section_small_const i ->
-          if i then ".const" else "COMM"
+          if i || (not !Clflags.option_fcommon) then ".const" else "COMM"
       | Section_string -> ".const"
       | Section_literal -> ".literal8"
       | Section_jumptable -> ".text"  (* needed in 64 bits, not a problem in 32 bits *)
@@ -269,9 +269,9 @@ module Cygwin_System : SYSTEM =
     let name_of_section = function
       | Section_text -> ".text"
       | Section_data i | Section_small_data i ->
-          if i then ".data" else "COMM"
+          if i then ".data" else common_section ()
       | Section_const i | Section_small_const i ->
-          if i then ".section	.rdata,\"dr\"" else "COMM"
+          if i || (not !Clflags.option_fcommon) then ".section	.rdata,\"dr\"" else "COMM"
       | Section_string -> ".section	.rdata,\"dr\""
       | Section_literal -> ".section	.rdata,\"dr\""
       | Section_jumptable -> ".text"
@@ -399,7 +399,13 @@ module Target(System: SYSTEM):TARGET =
 
 (* Printing of instructions *)
 
-(* Reminder on AT&T syntax: op source, dest *)
+(* Reminder on X86 assembly syntaxes:
+                              AT&T syntax         Intel syntax
+                              (used by GNU as)    (used in reference manuals)
+   dst <- op(src)             op src, dst         op dst, src
+   dst <- op(dst, src2)       op src2, dst        op dst, src2
+   dst <- op(dst, src2, src3) op src3, src2, dst  op dst, src2, src3
+*)
 
     let print_instruction oc = function
         (* Moves *)
@@ -752,29 +758,29 @@ module Target(System: SYSTEM):TARGET =
       | Pcfi_adjust sz ->
 	 cfi_adjust oc (camlint_of_coqint sz)
       | Pfmadd132 (res,a1,a2) ->
-	 fprintf oc "	vfmadd132sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfmadd132sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfmadd213 (res,a1,a2) ->
-	 fprintf oc "	vfmadd213sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfmadd213sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfmadd231 (res,a1,a2) ->
-	 fprintf oc "	vfmadd231sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfmadd231sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfmsub132 (res,a1,a2) ->
-	 fprintf oc "	vfmsub132sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfmsub132sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfmsub213 (res,a1,a2) ->
-	 fprintf oc "	vfmsub213sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfmsub213sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfmsub231 (res,a1,a2) ->
-	 fprintf oc "	vfmsub231sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfmsub231sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfnmadd132 (res,a1,a2) ->
-	 fprintf oc "	vfnmadd132sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfnmadd132sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfnmadd213 (res,a1,a2) ->
-	 fprintf oc "	vfnmadd213sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfnmadd213sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfnmadd231 (res,a1,a2) ->
-	 fprintf oc "	vfnmadd231sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfnmadd231sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfnmsub132 (res,a1,a2) ->
-	 fprintf oc "	vfnmsub132sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfnmsub132sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfnmsub213 (res,a1,a2) ->
-	 fprintf oc "	vfnmsub213sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfnmsub213sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pfnmsub231 (res,a1,a2) ->
-	 fprintf oc "	vfnmsub231sd	%a, %a, %a\n" freg a1 freg a2 freg res
+	 fprintf oc "	vfnmsub231sd	%a, %a, %a\n" freg a2 freg a1 freg res
       | Pmaxsd (res,a1) ->
 	 fprintf oc "	maxsd	%a, %a\n" freg a1 freg res
       | Pminsd (res,a1) ->
@@ -826,7 +832,7 @@ module Target(System: SYSTEM):TARGET =
                                (P.to_int kind) (extern_atom txt) args
           | EF_inline_asm(txt, sg, clob) ->
               fprintf oc "%s begin inline assembly\n\t" comment;
-              print_inline_asm preg oc (camlstring_of_coqstring txt) sg args res;
+              print_inline_asm preg_asm oc (camlstring_of_coqstring txt) sg args res;
               fprintf oc "%s end inline assembly\n" comment
           | _ ->
               assert false
diff --git a/x86/ValueAOp.v b/x86/ValueAOp.v
index 1021a9c8..d0b8427a 100644
--- a/x86/ValueAOp.v
+++ b/x86/ValueAOp.v
@@ -160,6 +160,7 @@ Definition eval_static_operation (op: operation) (vl: list aval): aval :=
   | Olongofsingle, v1::nil => longofsingle v1
   | Osingleoflong, v1::nil => singleoflong v1
   | Ocmp c, _ => of_optbool (eval_static_condition c vl)
+  | Osel c ty, v1::v2::vl => select (eval_static_condition c vl) v1 v2
   | _, _ => Vbot
   end.
 
@@ -258,6 +259,7 @@ Proof.
   eapply eval_static_addressing_32_sound; eauto.
   eapply eval_static_addressing_64_sound; eauto.
   apply of_optbool_sound. eapply eval_static_condition_sound; eauto.
+  apply select_sound; auto. eapply eval_static_condition_sound; eauto.
 Qed.
 
 End SOUNDNESS.
diff --git a/x86_32/Archi.v b/x86_32/Archi.v
index f10570e2..e9d05c14 100644
--- a/x86_32/Archi.v
+++ b/x86_32/Archi.v
@@ -16,7 +16,7 @@
 
 (** Architecture-dependent parameters for x86 in 32-bit mode *)
 
-Require Import ZArith.
+Require Import ZArith List.
 (*From Flocq*)
 Require Import Binary Bits.
 
@@ -34,24 +34,33 @@ Proof.
   unfold splitlong. destruct ptr64; simpl; congruence.
 Qed.
 
-Definition default_nan_64 : { x : binary64 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 53 1024 true (iter_nat 51 _ xO xH) (eq_refl true)) (eq_refl true).
+Definition default_nan_64 := (true, iter_nat 51 _ xO xH).
+Definition default_nan_32 := (true, iter_nat 22 _ xO xH).
 
-Definition choose_binop_pl_64 (pl1 pl2 : positive) :=
-  false.                        (**r always choose first NaN *)
+(* Always choose the first NaN argument, if any *)
 
-Definition default_nan_32 : { x : binary32 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 24 128 true (iter_nat 22 _ xO xH) (eq_refl true)) (eq_refl true).
+Definition choose_nan_64 (l: list (bool * positive)) : bool * positive :=
+  match l with nil => default_nan_64 | n :: _ => n end.
 
-Definition choose_binop_pl_32 (pl1 pl2 : positive) :=
-  false.                        (**r always choose first NaN *)
+Definition choose_nan_32 (l: list (bool * positive)) : bool * positive :=
+  match l with nil => default_nan_32 | n :: _ => n end.
 
-Definition fpu_returns_default_qNaN := false.
+Lemma choose_nan_64_idem: forall n,
+  choose_nan_64 (n :: n :: nil) = choose_nan_64 (n :: nil).
+Proof. auto. Qed.
+
+Lemma choose_nan_32_idem: forall n,
+  choose_nan_32 (n :: n :: nil) = choose_nan_32 (n :: nil).
+Proof. auto. Qed.
+
+Definition fma_order {A: Type} (x y z: A) := (x, y, z).
+
+Definition fma_invalid_mul_is_nan := false.
 
 Definition float_of_single_preserves_sNaN := false.
 
 Global Opaque ptr64 big_endian splitlong
-              default_nan_64 choose_binop_pl_64
-              default_nan_32 choose_binop_pl_32
-              fpu_returns_default_qNaN
+              default_nan_64 choose_nan_64
+              default_nan_32 choose_nan_32
+              fma_order fma_invalid_mul_is_nan
               float_of_single_preserves_sNaN.
diff --git a/x86_64/Archi.v b/x86_64/Archi.v
index 01eb36dd..959d8dc1 100644
--- a/x86_64/Archi.v
+++ b/x86_64/Archi.v
@@ -16,7 +16,7 @@
 
 (** Architecture-dependent parameters for x86 in 64-bit mode *)
 
-Require Import ZArith.
+Require Import ZArith List.
 (*From Flocq*)
 Require Import Binary Bits.
 
@@ -34,24 +34,33 @@ Proof.
   unfold splitlong. destruct ptr64; simpl; congruence.
 Qed.
 
-Definition default_nan_64 : { x : binary64 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 53 1024 true (iter_nat 51 _ xO xH) (eq_refl true)) (eq_refl true).
+Definition default_nan_64 := (true, iter_nat 51 _ xO xH).
+Definition default_nan_32 := (true, iter_nat 22 _ xO xH).
 
-Definition choose_binop_pl_64 (pl1 pl2 : positive) :=
-  false.                        (**r always choose first NaN *)
+(* Always choose the first NaN argument, if any *)
 
-Definition default_nan_32 : { x : binary32 | is_nan _ _ x = true } :=
-  exist _ (B754_nan 24 128 true (iter_nat 22 _ xO xH) (eq_refl true)) (eq_refl true).
+Definition choose_nan_64 (l: list (bool * positive)) : bool * positive :=
+  match l with nil => default_nan_64 | n :: _ => n end.
 
-Definition choose_binop_pl_32 (pl1 pl2 : positive) :=
-  false.                        (**r always choose first NaN *)
+Definition choose_nan_32 (l: list (bool * positive)) : bool * positive :=
+  match l with nil => default_nan_32 | n :: _ => n end.
 
-Definition fpu_returns_default_qNaN := false.
+Lemma choose_nan_64_idem: forall n,
+  choose_nan_64 (n :: n :: nil) = choose_nan_64 (n :: nil).
+Proof. auto. Qed.
+
+Lemma choose_nan_32_idem: forall n,
+  choose_nan_32 (n :: n :: nil) = choose_nan_32 (n :: nil).
+Proof. auto. Qed.
+
+Definition fma_order {A: Type} (x y z: A) := (x, y, z).
+
+Definition fma_invalid_mul_is_nan := false.
 
 Definition float_of_single_preserves_sNaN := false.
 
 Global Opaque ptr64 big_endian splitlong
-              default_nan_64 choose_binop_pl_64
-              default_nan_32 choose_binop_pl_32
-              fpu_returns_default_qNaN
+              default_nan_64 choose_nan_64
+              default_nan_32 choose_nan_32
+              fma_order fma_invalid_mul_is_nan
               float_of_single_preserves_sNaN.