Merge branch 'if-conversion' of https://github.com/AbsInt/CompCert into mppa-if-conversion

158 files changed, 14486 insertions, 9521 deletions

diff --git a/.gitignore b/.gitignore
index f5911e69..bc1fd91b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -78,5 +78,8 @@ runtime/mppa_k1c/i64_udivmod.s
 runtime/mppa_k1c/i64_umod.s
 # Test generated data
 /test/clightgen/*.v
-# Coq cache
+# Coq caches
 .lia.cache
+.nia.cache
+.nra.cache
+.csdp.cache
diff --git a/Makefile b/Makefile
index d8cd428a..104a5546 100644
--- a/Makefile
+++ b/Makefile
@@ -24,8 +24,8 @@ endif
 BACKENDLIB?=Asmgenproof0.v Asmgenproof1.v
 
 DIRS=lib common $(ARCHDIRS) backend cfrontend driver \
-  flocq/Core flocq/Prop flocq/Calc flocq/Appli exportclight \
-  cparser cparser/MenhirLib
+  flocq/Core flocq/Prop flocq/Calc flocq/IEEE754 \
+  exportclight cparser cparser/MenhirLib
 
 RECDIRS=lib common $(ARCHDIRS) backend cfrontend driver flocq exportclight cparser
 
@@ -45,20 +45,17 @@ GPATH=$(DIRS)
 # Flocq
 
 FLOCQ=\
-  Fcore_Raux.v Fcore_Zaux.v Fcore_defs.v Fcore_digits.v                     \
-  Fcore_float_prop.v Fcore_FIX.v Fcore_FLT.v Fcore_FLX.v                    \
-  Fcore_FTZ.v Fcore_generic_fmt.v Fcore_rnd.v Fcore_rnd_ne.v                \
-  Fcore_ulp.v Fcore.v                                                       \
-  Fcalc_bracket.v Fcalc_digits.v Fcalc_div.v Fcalc_ops.v                    \
-  Fcalc_round.v Fcalc_sqrt.v                                                \
-  Fprop_div_sqrt_error.v Fprop_mult_error.v Fprop_plus_error.v              \
-  Fprop_relative.v Fprop_Sterbenz.v                                         \
-  Fappli_rnd_odd.v Fappli_double_round.v Fappli_IEEE.v Fappli_IEEE_bits.v
+  Raux.v Zaux.v Defs.v Digits.v Float_prop.v FIX.v FLT.v FLX.v FTZ.v \
+  Generic_fmt.v Round_pred.v Round_NE.v Ulp.v Core.v \
+  Bracket.v Div.v Operations.v Round.v Sqrt.v \
+  Div_sqrt_error.v Mult_error.v Plus_error.v \
+  Relative.v Sterbenz.v Round_odd.v Double_rounding.v \
+  Binary.v Bits.v
 
 # 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
 
@@ -72,7 +69,7 @@ COMMON=Errors.v AST.v Linking.v \
 # Back-end modules (in backend/, $(ARCH)/)
 
 BACKEND=\
-  Cminor.v Op.v CminorSel.v OpHelpers.v OpHelpersproof.v \
+  Cminor.v Cminortyping.v  Op.v CminorSel.v OpHelpers.v OpHelpersproof.v \
   SelectOp.v SelectDiv.v SplitLong.v SelectLong.v Selection.v \
   SelectOpproof.v SelectDivproof.v SplitLongproof.v \
   SelectLongproof.v Selectionproof.v \
@@ -242,24 +239,24 @@ 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
 
 
diff --git a/arm/Archi.v b/arm/Archi.v
index 353731e0..39a424ec 100644
--- a/arm/Archi.v
+++ b/arm/Archi.v
@@ -17,8 +17,8 @@
 (** Architecture-dependent parameters for ARM *)
 
 Require Import ZArith.
-Require Import Fappli_IEEE.
-Require Import Fappli_IEEE_bits.
+(*From Flocq*)
+Require Import Binary Bits.
 
 Definition ptr64 := false.
 
@@ -34,29 +34,30 @@ Proof.
   unfold splitlong, ptr64; congruence.
 Qed.
 
-Program Definition default_pl_64 : bool * nan_pl 53 :=
-  (false, iter_nat 51 _ xO xH).
+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 choose_binop_pl_64 (s1: bool) (pl1: nan_pl 53) (s2: bool) (pl2: nan_pl 53) :=
+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 (proj1_sig pl1) 51 &&
-   negb (Pos.testbit (proj1_sig pl2) 51))%bool.
+  (Pos.testbit pl1 51 && negb (Pos.testbit pl2 51))%bool.
 
-Program Definition default_pl_32 : bool * nan_pl 24 :=
-  (false, iter_nat 22 _ xO xH).
+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_binop_pl_32 (s1: bool) (pl1: nan_pl 24) (s2: bool) (pl2: nan_pl 24) :=
+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 (proj1_sig pl1) 22 &&
-   negb (Pos.testbit (proj1_sig pl2) 22))%bool.
+  (Pos.testbit pl1 22 && negb (Pos.testbit pl2 22))%bool.
+
+Definition fpu_returns_default_qNaN := false.
 
 Definition float_of_single_preserves_sNaN := false.
 
 Global Opaque ptr64 big_endian splitlong
-              default_pl_64 choose_binop_pl_64
-              default_pl_32 choose_binop_pl_32
+              default_nan_64 choose_binop_pl_64
+              default_nan_32 choose_binop_pl_32
+              fpu_returns_default_qNaN
               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..dfad6972 100644
--- a/arm/AsmToJSON.ml
+++ b/arm/AsmToJSON.ml
@@ -259,7 +259,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]
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/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 f3f01730..e3ef3eaf 100644
--- a/arm/SelectOp.vp
+++ b/arm/SelectOp.vp
@@ -383,6 +383,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.
diff --git a/arm/SelectOpproof.v b/arm/SelectOpproof.v
index 212bcfd7..f7dd8dd6 100644
--- a/arm/SelectOpproof.v
+++ b/arm/SelectOpproof.v
@@ -738,6 +738,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.
diff --git a/arm/TargetPrinter.ml b/arm/TargetPrinter.ml
index bf37b0e4..3a0814e1 100644
--- a/arm/TargetPrinter.ml
+++ b/arm/TargetPrinter.ml
@@ -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;
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..13e14530 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 :=
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/CSEproof.v b/backend/CSEproof.v
index d6bde348..a60c316b 100644
--- a/backend/CSEproof.v
+++ b/backend/CSEproof.v
@@ -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. }
diff --git a/backend/Cminor.v b/backend/Cminor.v
index 11941da3..ca01ad50 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
diff --git a/backend/Cminortyping.v b/backend/Cminortyping.v
new file mode 100644
index 00000000..ddd0f98b
--- /dev/null
+++ b/backend/Cminortyping.v
@@ -0,0 +1,798 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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) (optty: option typ) : res S.typenv :=
+  match optid, optty with
+  | None, _ => OK e
+  | Some id, Some ty => S.set e id ty
+  | _, _ => Error (msg "inconsistent call")
+  end.
+
+Fixpoint type_stmt (tret: option typ) (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 sg.(sig_res)
+  | Stailcall sg fn args =>
+      assertion (opt_typ_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 sg.(sig_res)
+  | 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 tret, opta with
+      | None, None => OK e
+      | Some t, Some a => type_expr e a t
+      | _, _ => Error (msg "inconsistent return")
+      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: option typ.
+
+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) (optty: option typ) : Prop :=
+  match optid with Some id => optty = Some (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:
+      tret = None ->
+      wt_stmt (Sreturn None)
+  | wt_Sreturn_some: forall a t,
+      tret = Some t -> wt_expr a t ->
+      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 optty e e',
+    opt_set e optid optty = OK e' -> S.satisf te e' -> wt_opt_assign te optid optty.
+Proof.
+  unfold opt_set; intros; red. destruct optid; [destruct optty |]; try (monadInv H).
+- erewrite S.set_sound by eauto. auto.
+- 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 tret, 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 -> option typ -> Prop :=
+  | wt_cont_Kstop:
+      wt_cont_call Kstop (Some 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 -> option typ -> 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 (match tret with None => Tint | Some t => t end))
+        (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.
+  unfold proj_sig_res in TRES; red in H5.
+  destruct optid. rewrite H5 in TRES. apply wt_env_assign; auto. assumption.
+  destruct optid. apply def_env_assign; auto. assumption.
+- 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. rewrite H0; exact I.
+- inv WT_STMT. econstructor; eauto using call_cont_wt.
+  rewrite H2. 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. unfold proj_sig_res. simpl in *. 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/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/Inliningproof.v b/backend/Inliningproof.v
index 2dcb8956..181f40bf 100644
--- a/backend/Inliningproof.v
+++ b/backend/Inliningproof.v
@@ -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.
@@ -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/JsonAST.ml b/backend/JsonAST.ml
index 3469bdc6..4e57106f 100644
--- a/backend/JsonAST.ml
+++ b/backend/JsonAST.ml
@@ -123,15 +123,15 @@ let pp_mnemonics pp mnemonic_names =
   let new_line pp () = pp_print_string pp "\n" in
   pp_print_list ~pp_sep:new_line 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 () =
diff --git a/backend/Lineartyping.v b/backend/Lineartyping.v
index bc9fb3ca..1fe23a9d 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
diff --git a/backend/NeedDomain.v b/backend/NeedDomain.v
index d431f3d8..b35c90b2 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.
@@ -610,7 +611,7 @@ 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.
 
@@ -626,7 +627,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 +639,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.
 
@@ -785,6 +786,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. *)
 
diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml
index 92d465d5..dd428808 100644
--- a/backend/PrintAsm.ml
+++ b/backend/PrintAsm.ml
@@ -40,6 +40,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 +118,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
diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml
index f9ed569f..7e075f04 100644
--- a/backend/PrintAsmaux.ml
+++ b/backend/PrintAsmaux.ml
@@ -289,12 +289,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/RTL.v b/backend/RTL.v
index 16723d96..9599a24a 100644
--- a/backend/RTL.v
+++ b/backend/RTL.v
@@ -73,7 +73,7 @@ Inductive instruction: Type :=
           it transitions to [ifnot]. *)
   | Ijumptable: reg -> list node -> instruction
       (** [Ijumptable arg tbl] transitions to the node that is the [n]-th
-          element of the list [tbl], where [n] is the signed integer
+          element of the list [tbl], where [n] is the unsigned integer
           value of register [arg]. *)
   | Ireturn: option reg -> instruction.
       (** [Ireturn] terminates the execution of the current function
diff --git a/backend/RTLgenproof.v b/backend/RTLgenproof.v
index b003eb10..b94ec22f 100644
--- a/backend/RTLgenproof.v
+++ b/backend/RTLgenproof.v
@@ -704,7 +704,7 @@ Proof.
   intros; red; intros. inv TE.
   exploit H0; eauto. intros [rs1 [tm1 [EX1 [ME1 [RR1 [RO1 EXT1]]]]]].
   exploit external_call_mem_extends; eauto.
-  intros [v' [tm2 [A [B [C [D E]]]]]].
+  intros [v' [tm2 [A [B [C D]]]]].
   exists (rs1#rd <- v'); exists tm2.
 (* Exec *)
   split. eapply star_right. eexact EX1.
@@ -736,7 +736,7 @@ Proof.
   intros; red; intros. inv TE.
   exploit H3; eauto. intros [rs1 [tm1 [EX1 [ME1 [RR1 [RO1 EXT1]]]]]].
   exploit external_call_mem_extends; eauto.
-  intros [v' [tm2 [A [B [C [D E]]]]]].
+  intros [v' [tm2 [A [B [C D]]]]].
   exploit function_ptr_translated; eauto. simpl. intros [tf [P Q]]. inv Q.
   exists (rs1#rd <- v'); exists tm2.
 (* Exec *)
diff --git a/backend/SelectDivproof.v b/backend/SelectDivproof.v
index e2249ddb..a8ee8453 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 OpHelpers OpHelpersproof.
@@ -58,13 +58,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.
@@ -73,7 +73,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).
@@ -139,13 +139,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.
 
@@ -247,10 +247,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.
@@ -291,7 +292,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.
 
@@ -378,7 +379,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:
@@ -401,8 +402,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.
@@ -445,14 +447,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:
diff --git a/backend/Selection.v b/backend/Selection.v
index 3b0948a8..37a78853 100644
--- a/backend/Selection.v
+++ b/backend/Selection.v
@@ -26,7 +26,7 @@ Require String.
 Require Import Coqlib Maps.
 Require Import AST Errors Integers Globalenvs Switch.
 Require Cminor.
-Require Import Op CminorSel OpHelpers.
+Require Import Op CminorSel OpHelpers 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) :=
@@ -173,6 +179,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 *)
 
@@ -267,7 +277,6 @@ Definition sel_switch_long :=
     (fun arg ofs => subl arg (longconst (Int64.repr ofs)))
     lowlong.
 
-
 Definition sel_builtin_default optid ef args :=
   OK (Sbuiltin (sel_builtin_res optid) ef
                (sel_builtin_args args
@@ -328,11 +337,64 @@ Definition sel_builtin optid ef args :=
        else
          sel_builtin_default optid ef args)
     | _ => sel_builtin_default optid ef args
+
+(** "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))
@@ -357,15 +419,19 @@ Fixpoint sel_stmt (s: Cminor.stmt) : res stmt :=
       | _            => 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
@@ -380,7 +446,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.
 
@@ -388,8 +454,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..52ddd799
--- /dev/null
+++ b/backend/Selectionaux.ml
@@ -0,0 +1,109 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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
+  | "arm", _ ->
+      (match ty with Tint | Tfloat | Tsingle -> true | _ -> false)
+  | "powerpc", "e5500" -> 
+      (match ty with Tint | 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 -ffavor-branchless flags.
+
+With [-fno-if-conversion] or [-0O], if-conversion is turned off entirely.
+With [-ffavor-branchless], 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.  Since our cost estimates are very imprecise, the
+bound on the total cost acts as a safety guard, 
+*)
+
+let if_conversion_heuristic cond ifso ifnot ty =
+  if not !Clflags.option_fifconversion then false else
+  if !Clflags.option_ffavor_branchless then true else
+  if not (fast_cmove ty) then false else
+  let c1 = cost_expr ifso and c2 = cost_expr ifnot in
+  c1 + c2 <= 30 && abs (c1 - c2) <= 8
+
diff --git a/backend/Selectionproof.v b/backend/Selectionproof.v
index 23d10382..40db5d4b 100644
--- a/backend/Selectionproof.v
+++ b/backend/Selectionproof.v
@@ -15,7 +15,7 @@
 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 Switch Cminor Op CminorSel Cminortyping.
 Require Import OpHelpers OpHelpersproof.
 Require Import SelectOp SelectDiv SplitLong SelectLong Selection.
 Require Import SelectOpproof SelectDivproof SplitLongproof SelectLongproof.
@@ -120,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).
@@ -203,6 +213,25 @@ 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 ->
+  let (cond, al) := condition_of_expr a in
+  exists vl,
+     eval_exprlist tge sp e m le al vl
+  /\ eval_condition cond vl m = Some b.
+Proof.
+  intros until a. functional induction (condition_of_expr a); intros.
+(* compare *)
+  inv H. simpl in H6. inv H6. apply Val.bool_of_val_of_optbool in H0.
+  exists vl; auto.
+(* default *)
+  exists (v :: nil); split.
+  econstructor. auto. constructor.
+  simpl. inv H0. auto.
+Qed.
+
 Lemma eval_load:
   forall le a v chunk v',
   eval_expr tge sp e m le a v ->
@@ -461,7 +490,7 @@ Qed.
 
 End SEL_SWITCH.
 
-Section SEL_SWITH_INT.
+Section SEL_SWITCH_INT.
 
 Variable cunit: Cminor.program.
 Variable hf: helper_functions.
@@ -507,7 +536,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.
@@ -548,7 +577,7 @@ Proof.
 - apply Int64.unsigned_range.
 Qed.
 
-End SEL_SWITH_INT.
+End SEL_SWITCH_INT.
 
 (** Compatibility of evaluation functions with the "less defined than" relation. *)
 
@@ -699,6 +728,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' ->
@@ -742,37 +794,174 @@ Proof.
   intros. destruct oid; simpl; auto. apply set_var_lessdef; 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
@@ -794,11 +983,12 @@ 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 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')
+        (TYF: type_function f = OK env)
+        (MC: match_cont cunit hf (known_id f) env k k')
         (LDA: Val.lessdef_list args args')
         (LDE: env_lessdef e e')
         (ME: Mem.extends m m')
@@ -806,11 +996,12 @@ Inductive match_states: Cminor.state -> CminorSel.state -> Prop :=
       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'
+  | 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')
         (ME: Mem.extends m m'),
@@ -819,23 +1010,23 @@ Inductive match_states: Cminor.state -> CminorSel.state -> Prop :=
         (State f' Sskip k' sp (set_builtin_res (sel_builtin_res optid) v' 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.
@@ -843,14 +1034,58 @@ 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 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.
@@ -867,7 +1102,11 @@ Proof.
   destruct (find_label lbl x (Kseq x0 k')) as [[sy ky] | ];
   intuition. apply IHs2; auto.
 (* ifthenelse *)
-- exploit (IHs1 k); eauto.
+- 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] | ];
   intuition. apply IHs2; auto.
@@ -896,20 +1135,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 *)
@@ -935,7 +1176,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]].
@@ -945,11 +1186,11 @@ 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.
+  right; left; split. simpl. omega. split. auto.
   econstructor; eauto.
 - (* Stailcall *)
   exploit Mem.free_parallel_extends; eauto. intros [m2' [P Q]].
@@ -978,7 +1219,13 @@ Proof.
   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.
@@ -990,10 +1237,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 *.
@@ -1024,10 +1274,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.
@@ -1036,13 +1286,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.
@@ -1058,13 +1310,12 @@ Proof.
   econstructor. eauto. eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   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.
+  right; left; split. simpl; omega. split. auto. econstructor; eauto.
   apply sel_builtin_res_correct; auto.
 Qed.
 
@@ -1080,26 +1331,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/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 7899a04c..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:
@@ -1373,9 +1373,9 @@ Proof.
   * apply Y with id; auto.
   * exists gd1; auto.
   * exists gd2; auto.
-  * eapply used_not_defined_2 in GD1; eauto. eapply used_not_defined_2 in GD2; eauto.
+  * eapply used_not_defined_2 in GD1; [ | eauto | congruence ].
+    eapply used_not_defined_2 in GD2; [ | eauto | congruence ].
     tauto.
-    congruence.
   }
   destruct E as [g LD].
   left. unfold prog_defs_names; simpl.
diff --git a/backend/ValueDomain.v b/backend/ValueDomain.v
index e7e44e29..f6afa836 100644
--- a/backend/ValueDomain.v
+++ b/backend/ValueDomain.v
@@ -11,7 +11,7 @@
 (* *********************************************************************)
 
 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 Registers RTL.
@@ -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. }
@@ -2824,6 +2824,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) :=
@@ -3134,7 +3192,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 +3550,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 +3567,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 +4050,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.
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml
index 0f2e3674..37527940 100644
--- a/cfrontend/C2C.ml
+++ b/cfrontend/C2C.ml
@@ -109,7 +109,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)
 
@@ -703,12 +703,12 @@ let z_of_str hex str fst =
 
 let checkFloatOverflow f typ =
   match f with
-  | Fappli_IEEE.B754_finite _ -> ()
-  | Fappli_IEEE.B754_zero _ ->
+  | Binary.B754_finite _ -> ()
+  | Binary.B754_zero _ ->
       warning Diagnostics.Literal_range "magnitude of floating-point constant too small for type '%s'"  typ
-  | Fappli_IEEE.B754_infinity _ ->
+  | Binary.B754_infinity _ ->
       warning Diagnostics.Literal_range "magnitude of floating-point constant too large for type '%s'"  typ
-  | Fappli_IEEE.B754_nan _ ->
+  | Binary.B754_nan _ ->
       warning Diagnostics.Literal_range "floating-point converts converts to 'NaN'"
 
 let convertFloat f kind =
diff --git a/cfrontend/Cexec.v b/cfrontend/Cexec.v
index 823d2542..7f5fe355 100644
--- a/cfrontend/Cexec.v
+++ b/cfrontend/Cexec.v
@@ -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 \/
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/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/Csyntax.v b/cfrontend/Csyntax.v
index 914328be..00565309 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 *)
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..a91138c9 100644
--- a/common/AST.v
+++ b/common/AST.v
@@ -432,12 +432,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
diff --git a/common/Events.v b/common/Events.v
index b2335b96..26dd505f 100644
--- a/common/Events.v
+++ b/common/Events.v
@@ -1208,7 +1208,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).
diff --git a/common/Memdata.v b/common/Memdata.v
index a9ed48b4..7144d72c 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.
diff --git a/common/Memory.v b/common/Memory.v
index 2cf1c3ab..b68a5049 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. *)
@@ -780,7 +780,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 +791,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 +816,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 +836,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 +887,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 +1106,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 +1127,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 +1523,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 +1539,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 +1644,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 +1867,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 +2342,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 +4340,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 ae4fa5fd..53775d8b 100644
--- a/common/Memtype.v
+++ b/common/Memtype.v
@@ -104,7 +104,7 @@ Parameter alloc: forall (m: mem) (lo hi: Z), mem * block.
 
 (** [free m b lo hi] frees (deallocates) the range of offsets from [lo]
   included to [hi] excluded in block [b].  Returns the updated memory
-  state, or [None] if the freed addresses are not writable. *)
+  state, or [None] if the freed addresses are not freeable. *)
 Parameter free: forall (m: mem) (b: block) (lo hi: Z), option mem.
 
 (** [load chunk m b ofs] reads a memory quantity [chunk] from
@@ -358,7 +358,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/Separation.v b/common/Separation.v
index a9642d72..1493b535 100644
--- a/common/Separation.v
+++ b/common/Separation.v
@@ -702,7 +702,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 127d1085..e4297183 100644
--- a/common/Values.v
+++ b/common/Values.v
@@ -132,6 +132,23 @@ 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.
+
 (** 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. *)
@@ -899,6 +916,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.
@@ -2045,6 +2111,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]
@@ -2329,6 +2425,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.
diff --git a/configure b/configure
index 52fffa63..47e15533 100755
--- a/configure
+++ b/configure
@@ -541,19 +541,19 @@ 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.6.1|8.7.0|8.7.1|8.7.2|8.8.0|8.8.1|8.8.2|8.9.0)
+  8.7.0|8.7.1|8.7.2|8.8.0|8.8.1|8.8.2|8.9.0|8.9.1)
         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, 8.6.1"
+            echo "Error: CompCert requires one of the following Coq versions: 8.9.1, 8.9.0, 8.8.2, 8.8.1, 8.8.0, 8.7.2, 8.7.1, 8.7.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
 
@@ -601,7 +601,13 @@ 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
           echo "version $menhir_ver -- good!"
-          menhir_includes="-I `menhir --suggest-menhirLib`"
+          menhir_include_dir=`menhir --suggest-menhirLib`
+          if test -z "$menhir_include_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
@@ -692,7 +698,7 @@ MANDIR=$sharedir/man
 SHAREDIR=$sharedir
 COQDEVDIR=$coqdevdir
 OCAML_OPT_COMP=$ocaml_opt_comp
-MENHIR_INCLUDES=$menhir_includes
+MENHIR_INCLUDES=-I "$menhir_include_dir"
 MENHIR_FLAGS=$menhir_flags
 COMPFLAGS=-bin-annot
 EOF
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index cf67015a..7329767a 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -947,7 +947,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/Diagnostics.ml b/cparser/Diagnostics.ml
index 172affab..51dcab47 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
@@ -469,7 +473,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;
diff --git a/cparser/Diagnostics.mli b/cparser/Diagnostics.mli
index ded8019f..6a3c11c8 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 *)
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index 7a0b05de..9cca930d 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -295,14 +295,16 @@ let parse_int base s =
     |  _ -> assert false in
   let v = ref 0L in
   for i = 0 to String.length s - 1 do
-    if !v < 0L || !v > max_val then raise Overflow;
-    v := Int64.mul !v (Int64.of_int base);
     let c = s.[i] in
     let digit =
       if c >= '0' && c <= '9' then Char.code c - 48
       else if c >= 'A' && c <= 'F' then Char.code c - 55
       else raise Bad_digit in
     if digit >= base then raise Bad_digit;
+    if !v < 0L || !v > max_val then raise Overflow;
+    (* because (2^64 - 1) % 10 = 5, not 9 *)
+    if base = 10 && !v = max_val && digit > 5 then raise Overflow;
+    v := Int64.mul !v (Int64.of_int base);
     v := Int64.add !v (Int64.of_int digit)
   done;
   !v
@@ -939,31 +941,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 *)
 
@@ -1706,7 +1684,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)
@@ -1720,7 +1698,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
@@ -1837,7 +1815,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
@@ -1852,14 +1830,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 *)
 
@@ -2018,20 +2001,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
@@ -2081,37 +2064,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) ->
@@ -2227,7 +2210,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";
@@ -2236,7 +2219,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
@@ -2246,7 +2229,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
@@ -2256,7 +2239,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
@@ -2266,7 +2249,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 =
@@ -2303,7 +2286,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
@@ -2371,113 +2354,101 @@ 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 "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'
+
+let enter_decdef local nonstatic_inline loc sto (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)
+  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)
@@ -2661,7 +2632,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 =
@@ -2733,6 +2704,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.cabsloc) : 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)
@@ -2747,18 +2763,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) ->
@@ -2885,48 +2890,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
@@ -2938,7 +2944,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
@@ -2947,11 +2953,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
 
@@ -3025,6 +3031,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
diff --git a/cparser/Lexer.mll b/cparser/Lexer.mll
index b2a668f0..7cf22eef 100644
--- a/cparser/Lexer.mll
+++ b/cparser/Lexer.mll
@@ -23,11 +23,18 @@ module SSet = Set.Make(String)
 let lexicon : (string, Cabs.cabsloc -> 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);
diff --git a/cparser/Unblock.ml b/cparser/Unblock.ml
index da8049a5..66b497cc 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
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/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..3498a779 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -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..bbfcf311 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
@@ -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 =
@@ -641,14 +647,23 @@ module DwarfPrinter(Target: DWARF_TARGET):
       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
+      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 cp (lpc,loc) s r =
       compute_abbrev cp;
@@ -679,6 +694,7 @@ 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
diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli
index 23aba448..5a2bce3b 100644
--- a/debug/DwarfTypes.mli
+++ b/debug/DwarfTypes.mli
@@ -272,9 +272,11 @@ type location_entry =
    }
 type dw_locations = constant option * 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
 
diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml
index ee568042..e1b71f13 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 = {
@@ -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
@@ -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;
diff --git a/doc/ccomp.1 b/doc/ccomp.1
index 374bd2e7..7ccf97c8 100644
--- a/doc/ccomp.1
+++ b/doc/ccomp.1
@@ -180,6 +180,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 +197,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,7 +430,7 @@ 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
 \fIpointer\-type\-mismatch\fP:
diff --git a/driver/Clflags.ml b/driver/Clflags.ml
index 651d644e..00bbc4d5 100644
--- a/driver/Clflags.ml
+++ b/driver/Clflags.ml
@@ -29,10 +29,13 @@ let option_fcse = ref true
 let option_fredundancy = ref true
 let option_fpostpass = ref true
 let option_fpostpass_sched = ref "list"
+let option_fifconversion = ref true
+let option_ffavor_branchless = 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 eae3aaab..dcd0d60b 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
 
diff --git a/driver/Driver.ml b/driver/Driver.ml
index 74e7ae77..404271cd 100644
--- a/driver/Driver.ml
+++ b/driver/Driver.ml
@@ -199,6 +199,9 @@ 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]
+  -ffavor-branchless Favor the generation of branch-free instruction sequences,
+                     even when possibly more costly than the default   [off]
 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
@@ -206,6 +209,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 ^
@@ -252,7 +256,8 @@ let dump_mnemonics destfile =
   exit 0
 
 let optimization_options = [
-  option_ftailcalls; option_fconstprop; option_fcse; option_fredundancy; option_fpostpass; option_finline_functions_called_once;
+  option_ftailcalls; option_fifconversion; option_fconstprop; option_fcse;
+  option_fpostpass; option_fredundancy; option_finline_functions_called_once;
 ]
 
 let set_all opts () = List.iter (fun r -> r := true) opts
@@ -269,6 +274,10 @@ let cmdline_actions =
     [Exact("-f" ^ name ^ "="), String 
       (fun s -> (strref := (if s == "" then "list" else s)); ref := true)
      ] 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;
@@ -303,10 +312,12 @@ let cmdline_actions =
   Exact "-Os", Set option_Osize;
   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 "-ffavor-branchless", Set option_ffavor_branchless;
+  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
@@ -365,6 +376,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 b29bb7f3..d7162865 100644
--- a/driver/Frontend.ml
+++ b/driver/Frontend.ml
@@ -11,21 +11,43 @@
 (*                                                                     *)
 (* *********************************************************************)
 
+open Printf
 open Clflags
 open Commandline
 open Driveraux
 
 (* Common frontend functions between clightgen and ccomp *)
 
+(* Split the version number into major.minor *)
+
+let re_version = Str.regexp {|\([0-9]+\)\.\([0-9]+\)|}
+
+let (v_major, v_minor) =
+  let get n = int_of_string (Str.matched_group n Version.version) in
+  assert (Str.string_match re_version Version.version 0);
+  (get 1, get 2)
+
+let v_number =
+  assert (v_minor < 100);
+  100 * v_major + v_minor
+
+(* Predefined macros: version numbers, C11 features *)
+
 let predefined_macros =
-  [
+  let macros = [  
     "-D__COMPCERT__";
+    sprintf "-D__COMPCERT_MAJOR__=%d" v_major;    
+    sprintf "-D__COMPCERT_MINOR__=%d" v_minor;    
+    sprintf "-D__COMPCERT_VERSION__=%d" v_number;    
     "-U__STDC_IEC_559_COMPLEX__";
     "-D__STDC_NO_ATOMICS__";
     "-D__STDC_NO_COMPLEX__";
     "-D__STDC_NO_THREADS__";
     "-D__STDC_NO_VLA__"
-  ]
+  ] in
+  if Version.buildnr = ""
+  then macros
+  else sprintf "-D__COMPCERT_BUILDNR__=%s" Version.buildnr :: macros
 
 (* From C to preprocessed C *)
 
@@ -110,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
@@ -150,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/exportclight/Clightnorm.ml b/exportclight/Clightnorm.ml
index 4b01d777..a0001250 100644
--- a/exportclight/Clightnorm.ml
+++ b/exportclight/Clightnorm.ml
@@ -133,7 +133,7 @@ let rec norm_stmt s =
       add_sequence sl (Sreturn(Some e'))
   | Sswitch(e, ls) ->
       let (sl, e') = norm_expr e in
-      add_sequence sl (Sswitch(e, norm_lbl_stmt ls))
+      add_sequence sl (Sswitch(e', norm_lbl_stmt ls))
   | Slabel(lbl, s1) ->
       Slabel(lbl, norm_stmt s1)
   | Sgoto lbl -> s
diff --git a/extraction/extraction.v b/extraction/extraction.v
index e2ffd65d..265a5967 100644
--- a/extraction/extraction.v
+++ b/extraction/extraction.v
@@ -73,6 +73,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".
@@ -166,11 +167,11 @@ Load extractionMachdep.
 Extraction Blacklist List String Int.
 
 (* Cutting the dependency to R. *)
-Extract Inlined Constant Fcore_defs.F2R => "fun _ -> assert false".
-Extract Inlined Constant Fappli_IEEE.FF2R => "fun _ -> assert false".
-Extract Inlined Constant Fappli_IEEE.B2R => "fun _ -> assert false".
-Extract Inlined Constant Fappli_IEEE.round_mode => "fun _ -> assert false".
-Extract Inlined Constant Fcalc_bracket.inbetween_loc => "fun _ -> assert false".
+Extract Inlined Constant Defs.F2R => "fun _ -> assert false".
+Extract Inlined Constant Binary.FF2R => "fun _ -> assert false".
+Extract Inlined Constant Binary.B2R => "fun _ -> assert false".
+Extract Inlined Constant Binary.round_mode => "fun _ -> assert false".
+Extract Inlined Constant Bracket.inbetween_loc => "fun _ -> assert false".
 
 (* Needed in Coq 8.4 to avoid problems with Function definitions. *)
 Set Extraction AccessOpaque.
diff --git a/flocq/Appli/Fappli_IEEE.v b/flocq/Appli/Fappli_IEEE.v
deleted file mode 100644
index 7503dc1d..00000000
--- a/flocq/Appli/Fappli_IEEE.v
+++ /dev/null
@@ -1,1920 +0,0 @@
-(**
-This file is part of the Flocq formalization of floating-point
-arithmetic in Coq: http://flocq.gforge.inria.fr/
-
-Copyright (C) 2010-2013 Sylvie Boldo
-#<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
-
-This library is free software; you can redistribute it and/or
-modify it 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.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-COPYING file for more details.
-*)
-
-(** * IEEE-754 arithmetic *)
-Require Import Fcore.
-Require Import Fcore_digits.
-Require Import Fcalc_digits.
-Require Import Fcalc_round.
-Require Import Fcalc_bracket.
-Require Import Fcalc_ops.
-Require Import Fcalc_div.
-Require Import Fcalc_sqrt.
-Require Import Fprop_relative.
-
-Section AnyRadix.
-
-Inductive full_float :=
-  | F754_zero : bool -> full_float
-  | F754_infinity : bool -> full_float
-  | F754_nan : bool -> positive -> full_float
-  | F754_finite : bool -> positive -> Z -> full_float.
-
-Definition FF2R beta x :=
-  match x with
-  | F754_finite s m e => F2R (Float beta (cond_Zopp s (Zpos m)) e)
-  | _ => 0%R
-  end.
-
-End AnyRadix.
-
-Section Binary.
-
-Arguments exist {A P} x _.
-
-(** [prec] is the number of bits of the mantissa including the implicit one;
-    [emax] is the exponent of the infinities.
-    For instance, binary32 is defined by [prec = 24] and [emax = 128]. *)
-Variable prec emax : Z.
-Context (prec_gt_0_ : Prec_gt_0 prec).
-Hypothesis Hmax : (prec < emax)%Z.
-
-Let emin := (3 - emax - prec)%Z.
-Let fexp := FLT_exp emin prec.
-Instance fexp_correct : Valid_exp fexp := FLT_exp_valid emin prec.
-Instance fexp_monotone : Monotone_exp fexp := FLT_exp_monotone emin prec.
-
-Definition canonic_mantissa m e :=
-  Zeq_bool (fexp (Zpos (digits2_pos m) + e)) e.
-
-Definition bounded m e :=
-  andb (canonic_mantissa m e) (Zle_bool e (emax - prec)).
-
-Definition valid_binary x :=
-  match x with
-  | F754_finite _ m e => bounded m e
-  | F754_nan _ pl => (Zpos (digits2_pos pl) <? prec)%Z
-  | _ => true
-  end.
-
-(** Basic type used for representing binary FP numbers.
-    Note that there is exactly one such object per FP datum. *)
-
-Definition nan_pl := {pl | (Zpos (digits2_pos pl) <? prec)%Z  = true}.
-
-Inductive binary_float :=
-  | B754_zero : bool -> binary_float
-  | B754_infinity : bool -> binary_float
-  | B754_nan : bool -> nan_pl -> binary_float
-  | B754_finite : bool ->
-    forall (m : positive) (e : Z), bounded m e = true -> binary_float.
-
-Definition FF2B x :=
-  match x as x return valid_binary x = true -> binary_float with
-  | F754_finite s m e => B754_finite s m e
-  | F754_infinity s => fun _ => B754_infinity s
-  | F754_zero s => fun _ => B754_zero s
-  | F754_nan b pl => fun H => B754_nan b (exist pl H)
-  end.
-
-Definition B2FF x :=
-  match x with
-  | B754_finite s m e _ => F754_finite s m e
-  | B754_infinity s => F754_infinity s
-  | B754_zero s => F754_zero s
-  | B754_nan b (exist pl _) => F754_nan b pl
-  end.
-
-Definition B2R f :=
-  match f with
-  | B754_finite s m e _ => F2R (Float radix2 (cond_Zopp s (Zpos m)) e)
-  | _ => 0%R
-  end.
-
-Theorem FF2R_B2FF :
-  forall x,
-  FF2R radix2 (B2FF x) = B2R x.
-Proof.
-now intros [sx|sx|sx [plx Hplx]|sx mx ex Hx].
-Qed.
-
-Theorem B2FF_FF2B :
-  forall x Hx,
-  B2FF (FF2B x Hx) = x.
-Proof.
-now intros [sx|sx|sx plx|sx mx ex] Hx.
-Qed.
-
-Theorem valid_binary_B2FF :
-  forall x,
-  valid_binary (B2FF x) = true.
-Proof.
-now intros [sx|sx|sx [plx Hplx]|sx mx ex Hx].
-Qed.
-
-Theorem FF2B_B2FF :
-  forall x H,
-  FF2B (B2FF x) H = x.
-Proof.
-intros [sx|sx|sx [plx Hplx]|sx mx ex Hx] H ; try easy.
-simpl. apply f_equal, f_equal, eqbool_irrelevance.
-apply f_equal, eqbool_irrelevance.
-Qed.
-
-Theorem FF2B_B2FF_valid :
-  forall x,
-  FF2B (B2FF x) (valid_binary_B2FF x) = x.
-Proof.
-intros x.
-apply FF2B_B2FF.
-Qed.
-
-Theorem B2R_FF2B :
-  forall x Hx,
-  B2R (FF2B x Hx) = FF2R radix2 x.
-Proof.
-now intros [sx|sx|sx plx|sx mx ex] Hx.
-Qed.
-
-Theorem match_FF2B :
-  forall {T} fz fi fn ff x Hx,
-  match FF2B x Hx return T with
-  | B754_zero sx => fz sx
-  | B754_infinity sx => fi sx
-  | B754_nan b (exist p _) => fn b p
-  | B754_finite sx mx ex _ => ff sx mx ex
-  end =
-  match x with
-  | F754_zero sx => fz sx
-  | F754_infinity sx => fi sx
-  | F754_nan b p => fn b p
-  | F754_finite sx mx ex => ff sx mx ex
-  end.
-Proof.
-now intros T fz fi fn ff [sx|sx|sx plx|sx mx ex] Hx.
-Qed.
-
-Theorem canonic_canonic_mantissa :
-  forall (sx : bool) mx ex,
-  canonic_mantissa mx ex = true ->
-  canonic radix2 fexp (Float radix2 (cond_Zopp sx (Zpos mx)) ex).
-Proof.
-intros sx mx ex H.
-assert (Hx := Zeq_bool_eq _ _ H). clear H.
-apply sym_eq.
-simpl.
-pattern ex at 2 ; rewrite <- Hx.
-apply (f_equal fexp).
-rewrite ln_beta_F2R_Zdigits.
-rewrite <- Zdigits_abs.
-rewrite Zpos_digits2_pos.
-now case sx.
-now case sx.
-Qed.
-
-Theorem generic_format_B2R :
-  forall x,
-  generic_format radix2 fexp (B2R x).
-Proof.
-intros [sx|sx|sx plx|sx mx ex Hx] ; try apply generic_format_0.
-simpl.
-apply generic_format_canonic.
-apply canonic_canonic_mantissa.
-now destruct (andb_prop _ _ Hx) as (H, _).
-Qed.
-
-Theorem FLT_format_B2R :
-  forall x,
-  FLT_format radix2 emin prec (B2R x).
-Proof with auto with typeclass_instances.
-intros x.
-apply FLT_format_generic...
-apply generic_format_B2R.
-Qed.
-
-Theorem B2FF_inj :
-  forall x y : binary_float,
-  B2FF x = B2FF y ->
-  x = y.
-Proof.
-intros [sx|sx|sx [plx Hplx]|sx mx ex Hx] [sy|sy|sy [ply Hply]|sy my ey Hy] ; try easy.
-(* *)
-intros H.
-now inversion H.
-(* *)
-intros H.
-now inversion H.
-(* *)
-intros H.
-inversion H.
-clear H.
-revert Hplx.
-rewrite H2.
-intros Hx.
-apply f_equal, f_equal, eqbool_irrelevance.
-(* *)
-intros H.
-inversion H.
-clear H.
-revert Hx.
-rewrite H2, H3.
-intros Hx.
-apply f_equal, eqbool_irrelevance.
-Qed.
-
-Definition is_finite_strict f :=
-  match f with
-  | B754_finite _ _ _ _ => true
-  | _ => false
-  end.
-
-Theorem B2R_inj:
-  forall x y : binary_float,
-  is_finite_strict x = true ->
-  is_finite_strict y = true ->
-  B2R x = B2R y ->
-  x = y.
-Proof.
-intros [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] ; try easy.
-simpl.
-intros _ _ Heq.
-assert (Hs: sx = sy).
-(* *)
-revert Heq. clear.
-case sx ; case sy ; try easy ;
-  intros Heq ; apply False_ind ; revert Heq.
-apply Rlt_not_eq.
-apply Rlt_trans with R0.
-now apply F2R_lt_0_compat.
-now apply F2R_gt_0_compat.
-apply Rgt_not_eq.
-apply Rgt_trans with R0.
-now apply F2R_gt_0_compat.
-now apply F2R_lt_0_compat.
-assert (mx = my /\ ex = ey).
-(* *)
-refine (_ (canonic_unicity _ fexp _ _ _ _ Heq)).
-rewrite Hs.
-now case sy ; intro H ; injection H ; split.
-apply canonic_canonic_mantissa.
-exact (proj1 (andb_prop _ _ Hx)).
-apply canonic_canonic_mantissa.
-exact (proj1 (andb_prop _ _ Hy)).
-(* *)
-revert Hx.
-rewrite Hs, (proj1 H), (proj2 H).
-intros Hx.
-apply f_equal.
-apply eqbool_irrelevance.
-Qed.
-
-Definition Bsign x :=
-  match x with
-  | B754_nan s _ => s
-  | B754_zero s => s
-  | B754_infinity s => s
-  | B754_finite s _ _ _ => s
-  end.
-
-Definition sign_FF x :=
-  match x with
-  | F754_nan s _ => s
-  | F754_zero s => s
-  | F754_infinity s => s
-  | F754_finite s _ _ => s
-  end.
-
-Theorem Bsign_FF2B :
-  forall x H,
-  Bsign (FF2B x H) = sign_FF x.
-Proof.
-now intros [sx|sx|sx plx|sx mx ex] H.
-Qed.
-
-Definition is_finite f :=
-  match f with
-  | B754_finite _ _ _ _ => true
-  | B754_zero _ => true
-  | _ => false
-  end.
-
-Definition is_finite_FF f :=
-  match f with
-  | F754_finite _ _ _ => true
-  | F754_zero _ => true
-  | _ => false
-  end.
-
-Theorem is_finite_FF2B :
-  forall x Hx,
-  is_finite (FF2B x Hx) = is_finite_FF x.
-Proof.
-now intros [| | |].
-Qed.
-
-Theorem is_finite_FF_B2FF :
-  forall x,
-  is_finite_FF (B2FF x) = is_finite x.
-Proof.
-now intros [| |? []|].
-Qed.
-
-Theorem B2R_Bsign_inj:
-  forall x y : binary_float,
-    is_finite x = true ->
-    is_finite y = true ->
-    B2R x = B2R y ->
-    Bsign x = Bsign y ->
-    x = y.
-Proof.
-intros. destruct x, y; try (apply B2R_inj; now eauto).
-- simpl in H2. congruence.
-- symmetry in H1. apply Rmult_integral in H1.
-  destruct H1. apply (eq_Z2R _ 0) in H1. destruct b0; discriminate H1.
-  simpl in H1. pose proof (bpow_gt_0 radix2 e).
-  rewrite H1 in H3. apply Rlt_irrefl in H3. destruct H3.
-- apply Rmult_integral in H1.
-  destruct H1. apply (eq_Z2R _ 0) in H1. destruct b; discriminate H1.
-  simpl in H1. pose proof (bpow_gt_0 radix2 e).
-  rewrite H1 in H3. apply Rlt_irrefl in H3. destruct H3.
-Qed.
-
-Definition is_nan f :=
-  match f with
-  | B754_nan _ _ => true
-  | _ => false
-  end.
-
-Definition is_nan_FF f :=
-  match f with
-  | F754_nan _ _ => true
-  | _ => false
-  end.
-
-Theorem is_nan_FF2B :
-  forall x Hx,
-  is_nan (FF2B x Hx) = is_nan_FF x.
-Proof.
-now intros [| | |].
-Qed.
-
-Theorem is_nan_FF_B2FF :
-  forall x,
-  is_nan_FF (B2FF x) = is_nan x.
-Proof.
-now intros [| |? []|].
-Qed.
-
-(** Opposite *)
-
-Definition Bopp opp_nan x :=
-  match x with
-  | B754_nan sx plx =>
-    let '(sres, plres) := opp_nan sx plx in B754_nan sres plres
-  | B754_infinity sx => B754_infinity (negb sx)
-  | B754_finite sx mx ex Hx => B754_finite (negb sx) mx ex Hx
-  | B754_zero sx => B754_zero (negb sx)
-  end.
-
-Theorem Bopp_involutive :
-  forall opp_nan x,
-  is_nan x = false ->
-  Bopp opp_nan (Bopp opp_nan x) = x.
-Proof.
-now intros opp_nan [sx|sx|sx plx|sx mx ex Hx] ; simpl ; try rewrite Bool.negb_involutive.
-Qed.
-
-Theorem B2R_Bopp :
-  forall opp_nan x,
-  B2R (Bopp opp_nan x) = (- B2R x)%R.
-Proof.
-intros opp_nan [sx|sx|sx plx|sx mx ex Hx]; apply sym_eq ; try apply Ropp_0.
-simpl. destruct opp_nan. apply Ropp_0.
-simpl.
-rewrite <- F2R_opp.
-now case sx.
-Qed.
-
-Theorem is_finite_Bopp :
-  forall opp_nan x,
-  is_finite (Bopp opp_nan x) = is_finite x.
-Proof.
-intros opp_nan [| |s pl|] ; try easy.
-simpl.
-now case opp_nan.
-Qed.
-
-(** Absolute value *)
-
-Definition Babs abs_nan (x : binary_float) : binary_float :=
-  match x with
-  | B754_nan sx plx =>
-      let '(sres, plres) := abs_nan sx plx in B754_nan sres plres
-  | B754_infinity sx => B754_infinity false
-  | B754_finite sx mx ex Hx => B754_finite false mx ex Hx
-  | B754_zero sx => B754_zero false
-  end.
-
-Theorem B2R_Babs :
-  forall abs_nan x,
-  B2R (Babs abs_nan x) = Rabs (B2R x).
-Proof.
-  intros abs_nan [sx|sx|sx plx|sx mx ex Hx]; apply sym_eq ; try apply Rabs_R0.
-  simpl. destruct abs_nan. simpl. apply Rabs_R0.
-  simpl. rewrite <- F2R_abs. now destruct sx.
-Qed.
-
-Theorem is_finite_Babs :
-  forall abs_nan x,
-  is_finite (Babs abs_nan x) = is_finite x.
-Proof.
-  intros abs_nan [| |s pl|] ; try easy.
-  simpl.
-  now case abs_nan.
-Qed.
-
-Theorem Bsign_Babs :
-  forall abs_nan x,
-  is_nan x = false ->
-  Bsign (Babs abs_nan x) = false.
-Proof.
-  now intros abs_nan [| | |].
-Qed.
-
-Theorem Babs_idempotent :
-  forall abs_nan (x: binary_float),
-  is_nan x = false ->
-  Babs abs_nan (Babs abs_nan x) = Babs abs_nan x.
-Proof.
-  now intros abs_nan [sx|sx|sx plx|sx mx ex Hx].
-Qed.
-
-Theorem Babs_Bopp :
-  forall abs_nan opp_nan x,
-  is_nan x = false ->
-  Babs abs_nan (Bopp opp_nan x) = Babs abs_nan x.
-Proof.
-  now intros abs_nan opp_nan [| | |].
-Qed.
-
-(** Comparison
-
-[Some c] means ordered as per [c]; [None] means unordered. *)
-
-Definition Bcompare (f1 f2 : binary_float) : option comparison :=
-  match f1, f2 with
-  | B754_nan _ _,_ | _,B754_nan _ _ => None
-  | B754_infinity true, B754_infinity true
-  | B754_infinity false, B754_infinity false => Some Eq
-  | B754_infinity true, _ => Some Lt
-  | B754_infinity false, _ => Some Gt
-  | _, B754_infinity true => Some Gt
-  | _, B754_infinity false => Some Lt
-  | B754_finite true _ _ _, B754_zero _ => Some Lt
-  | B754_finite false _ _ _, B754_zero _ => Some Gt
-  | B754_zero _, B754_finite true _ _ _ => Some Gt
-  | B754_zero _, B754_finite false _ _ _ => Some Lt
-  | B754_zero _, B754_zero _ => Some Eq
-  | B754_finite s1 m1 e1 _, B754_finite s2 m2 e2 _ =>
-    match s1, s2 with
-    | true, false => Some Lt
-    | false, true => Some Gt
-    | false, false =>
-      match Zcompare e1 e2 with
-      | Lt => Some Lt
-      | Gt => Some Gt
-      | Eq => Some (Pcompare m1 m2 Eq)
-      end
-    | true, true =>
-      match Zcompare e1 e2 with
-      | Lt => Some Gt
-      | Gt => Some Lt
-      | Eq => Some (CompOpp (Pcompare m1 m2 Eq))
-      end
-    end
-  end.
-
-Theorem Bcompare_correct :
-  forall f1 f2,
-  is_finite f1 = true -> is_finite f2 = true ->
-  Bcompare f1 f2 = Some (Rcompare (B2R f1) (B2R f2)).
-Proof.
-  Ltac apply_Rcompare :=
-    match goal with
-      | [ |- Some Lt = Some (Rcompare _ _) ] => f_equal; symmetry; apply Rcompare_Lt
-      | [ |- Some Eq = Some (Rcompare _ _) ] => f_equal; symmetry; apply Rcompare_Eq
-      | [ |- Some Gt = Some (Rcompare _ _) ] => f_equal; symmetry; apply Rcompare_Gt
-    end.
-  unfold Bcompare; intros.
-  destruct f1, f2 ; try easy.
-  now rewrite Rcompare_Eq.
-  destruct b0 ; apply_Rcompare.
-  now apply F2R_lt_0_compat.
-  now apply F2R_gt_0_compat.
-  destruct b ; apply_Rcompare.
-  now apply F2R_lt_0_compat.
-  now apply F2R_gt_0_compat.
-  simpl.
-  clear H H0.
-  apply andb_prop in e0; destruct e0; apply (canonic_canonic_mantissa false) in H.
-  apply andb_prop in e2; destruct e2; apply (canonic_canonic_mantissa false) in H1.
-  pose proof (Zcompare_spec e e1); unfold canonic, Fexp in H1, H.
-  assert (forall m1 m2 e1 e2,
-    let x := (Z2R (Zpos m1) * bpow radix2 e1)%R in
-    let y := (Z2R (Zpos m2) * bpow radix2 e2)%R in
-    (canonic_exp radix2 fexp x < canonic_exp radix2 fexp y)%Z -> (x < y)%R).
-  {
-  intros; apply Rnot_le_lt; intro; apply (ln_beta_le radix2) in H5.
-  apply Zlt_not_le with (1 := H4).
-  now apply fexp_monotone.
-  now apply (F2R_gt_0_compat _ (Float radix2 (Zpos m2) e2)).
-  }
-  assert (forall m1 m2 e1 e2, (Z2R (- Zpos m1) * bpow radix2 e1 < Z2R (Zpos m2) * bpow radix2 e2)%R).
-  {
-  intros; apply (Rlt_trans _ 0%R).
-  now apply (F2R_lt_0_compat _ (Float radix2 (Zneg m1) e0)).
-  now apply (F2R_gt_0_compat _ (Float radix2 (Zpos m2) e2)).
-  }
-  unfold F2R, Fnum, Fexp.
-  destruct b, b0; try (now apply_Rcompare; apply H5); inversion H3;
-    try (apply_Rcompare; apply H4; rewrite H, H1 in H7; assumption);
-    try (apply_Rcompare; do 2 rewrite Z2R_opp, Ropp_mult_distr_l_reverse;
-      apply Ropp_lt_contravar; apply H4; rewrite H, H1 in H7; assumption);
-    rewrite H7, Rcompare_mult_r, Rcompare_Z2R by (apply bpow_gt_0); reflexivity.
-Qed.
-
-Theorem Bcompare_swap :
-  forall x y,
-  Bcompare y x = match Bcompare x y with Some c => Some (CompOpp c) | None => None end.
-Proof.
-  intros.
-  destruct x as [ ? | [] | ? ? | [] mx ex Bx ];
-  destruct y as [ ? | [] | ? ? | [] my ey By ]; simpl; try easy.
-- rewrite <- (Zcompare_antisym ex ey). destruct (ex ?= ey)%Z; try easy.
-  now rewrite (Pcompare_antisym mx my).
-- rewrite <- (Zcompare_antisym ex ey). destruct (ex ?= ey)%Z; try easy.
-  now rewrite Pcompare_antisym.
-Qed.
-
-Theorem bounded_lt_emax :
-  forall mx ex,
-  bounded mx ex = true ->
-  (F2R (Float radix2 (Zpos mx) ex) < bpow radix2 emax)%R.
-Proof.
-intros mx ex Hx.
-destruct (andb_prop _ _ Hx) as (H1,H2).
-generalize (Zeq_bool_eq _ _ H1). clear H1. intro H1.
-generalize (Zle_bool_imp_le _ _ H2). clear H2. intro H2.
-generalize (ln_beta_F2R_Zdigits radix2 (Zpos mx) ex).
-destruct (ln_beta radix2 (F2R (Float radix2 (Zpos mx) ex))) as (e',Ex).
-unfold ln_beta_val.
-intros H.
-apply Rlt_le_trans with (bpow radix2 e').
-change (Zpos mx) with (Zabs (Zpos mx)).
-rewrite F2R_Zabs.
-apply Ex.
-apply Rgt_not_eq.
-now apply F2R_gt_0_compat.
-apply bpow_le.
-rewrite H. 2: discriminate.
-revert H1. clear -H2.
-rewrite Zpos_digits2_pos.
-unfold fexp, FLT_exp.
-generalize (Zdigits radix2 (Zpos mx)).
-clearbody emin.
-intros ; zify ; omega.
-Qed.
-
-Theorem abs_B2R_lt_emax :
-  forall x,
-  (Rabs (B2R x) < bpow radix2 emax)%R.
-Proof.
-intros [sx|sx|sx plx|sx mx ex Hx] ; simpl ; try ( rewrite Rabs_R0 ; apply bpow_gt_0 ).
-rewrite <- F2R_Zabs, abs_cond_Zopp.
-now apply bounded_lt_emax.
-Qed.
-
-Theorem bounded_canonic_lt_emax :
-  forall mx ex,
-  canonic radix2 fexp (Float radix2 (Zpos mx) ex) ->
-  (F2R (Float radix2 (Zpos mx) ex) < bpow radix2 emax)%R ->
-  bounded mx ex = true.
-Proof.
-intros mx ex Cx Bx.
-apply andb_true_intro.
-split.
-unfold canonic_mantissa.
-unfold canonic, Fexp in Cx.
-rewrite Cx at 2.
-rewrite Zpos_digits2_pos.
-unfold canonic_exp.
-rewrite ln_beta_F2R_Zdigits. 2: discriminate.
-now apply -> Zeq_is_eq_bool.
-apply Zle_bool_true.
-unfold canonic, Fexp in Cx.
-rewrite Cx.
-unfold canonic_exp, fexp, FLT_exp.
-destruct (ln_beta radix2 (F2R (Float radix2 (Zpos mx) ex))) as (e',Ex). simpl.
-apply Zmax_lub.
-cut (e' - 1 < emax)%Z. clear ; omega.
-apply lt_bpow with radix2.
-apply Rle_lt_trans with (2 := Bx).
-change (Zpos mx) with (Zabs (Zpos mx)).
-rewrite F2R_Zabs.
-apply Ex.
-apply Rgt_not_eq.
-now apply F2R_gt_0_compat.
-unfold emin.
-generalize (prec_gt_0 prec).
-clear -Hmax ; omega.
-Qed.
-
-(** Truncation *)
-
-Record shr_record := { shr_m : Z ; shr_r : bool ; shr_s : bool }.
-
-Definition shr_1 mrs :=
-  let '(Build_shr_record m r s) := mrs in
-  let s := orb r s in
-  match m with
-  | Z0 => Build_shr_record Z0 false s
-  | Zpos xH => Build_shr_record Z0 true s
-  | Zpos (xO p) => Build_shr_record (Zpos p) false s
-  | Zpos (xI p) => Build_shr_record (Zpos p) true s
-  | Zneg xH => Build_shr_record Z0 true s
-  | Zneg (xO p) => Build_shr_record (Zneg p) false s
-  | Zneg (xI p) => Build_shr_record (Zneg p) true s
-  end.
-
-Definition loc_of_shr_record mrs :=
-  match mrs with
-  | Build_shr_record _ false false => loc_Exact
-  | Build_shr_record _ false true => loc_Inexact Lt
-  | Build_shr_record _ true false => loc_Inexact Eq
-  | Build_shr_record _ true true => loc_Inexact Gt
-  end.
-
-Definition shr_record_of_loc m l :=
-  match l with
-  | loc_Exact => Build_shr_record m false false
-  | loc_Inexact Lt => Build_shr_record m false true
-  | loc_Inexact Eq => Build_shr_record m true false
-  | loc_Inexact Gt => Build_shr_record m true true
-  end.
-
-Theorem shr_m_shr_record_of_loc :
-  forall m l,
-  shr_m (shr_record_of_loc m l) = m.
-Proof.
-now intros m [|[| |]].
-Qed.
-
-Theorem loc_of_shr_record_of_loc :
-  forall m l,
-  loc_of_shr_record (shr_record_of_loc m l) = l.
-Proof.
-now intros m [|[| |]].
-Qed.
-
-Definition shr mrs e n :=
-  match n with
-  | Zpos p => (iter_pos shr_1 p mrs, (e + n)%Z)
-  | _ => (mrs, e)
-  end.
-
-Lemma inbetween_shr_1 :
-  forall x mrs e,
-  (0 <= shr_m mrs)%Z ->
-  inbetween_float radix2 (shr_m mrs) e x (loc_of_shr_record mrs) ->
-  inbetween_float radix2 (shr_m (shr_1 mrs)) (e + 1) x (loc_of_shr_record (shr_1 mrs)).
-Proof.
-intros x mrs e Hm Hl.
-refine (_ (new_location_even_correct (F2R (Float radix2 (shr_m (shr_1 mrs)) (e + 1))) (bpow radix2 e) 2 _ _ _ x (if shr_r (shr_1 mrs) then 1 else 0) (loc_of_shr_record mrs) _ _)) ; try easy.
-2: apply bpow_gt_0.
-2: now case (shr_r (shr_1 mrs)) ; split.
-change (Z2R 2) with (bpow radix2 1).
-rewrite <- bpow_plus.
-rewrite (Zplus_comm 1), <- (F2R_bpow radix2 (e + 1)).
-unfold inbetween_float, F2R. simpl.
-rewrite Z2R_plus, Rmult_plus_distr_r.
-replace (new_location_even 2 (if shr_r (shr_1 mrs) then 1%Z else 0%Z) (loc_of_shr_record mrs)) with (loc_of_shr_record (shr_1 mrs)).
-easy.
-clear -Hm.
-destruct mrs as (m, r, s).
-now destruct m as [|[m|m|]|m] ; try (now elim Hm) ; destruct r as [|] ; destruct s as [|].
-rewrite (F2R_change_exp radix2 e).
-2: apply Zle_succ.
-unfold F2R. simpl.
-rewrite <- 2!Rmult_plus_distr_r, <- 2!Z2R_plus.
-rewrite Zplus_assoc.
-replace (shr_m (shr_1 mrs) * 2 ^ (e + 1 - e) + (if shr_r (shr_1 mrs) then 1%Z else 0%Z))%Z with (shr_m mrs).
-exact Hl.
-ring_simplify (e + 1 - e)%Z.
-change (2^1)%Z with 2%Z.
-rewrite Zmult_comm.
-clear -Hm.
-destruct mrs as (m, r, s).
-now destruct m as [|[m|m|]|m] ; try (now elim Hm) ; destruct r as [|] ; destruct s as [|].
-Qed.
-
-Theorem inbetween_shr :
-  forall x m e l n,
-  (0 <= m)%Z ->
-  inbetween_float radix2 m e x l ->
-  let '(mrs, e') := shr (shr_record_of_loc m l) e n in
-  inbetween_float radix2 (shr_m mrs) e' x (loc_of_shr_record mrs).
-Proof.
-intros x m e l n Hm Hl.
-destruct n as [|n|n].
-now destruct l as [|[| |]].
-2: now destruct l as [|[| |]].
-unfold shr.
-rewrite iter_pos_nat.
-rewrite Zpos_eq_Z_of_nat_o_nat_of_P.
-induction (nat_of_P n).
-simpl.
-rewrite Zplus_0_r.
-now destruct l as [|[| |]].
-rewrite iter_nat_S.
-rewrite inj_S.
-unfold Zsucc.
-rewrite Zplus_assoc.
-revert IHn0.
-apply inbetween_shr_1.
-clear -Hm.
-induction n0.
-now destruct l as [|[| |]].
-rewrite iter_nat_S.
-revert IHn0.
-generalize (iter_nat shr_1 n0 (shr_record_of_loc m l)).
-clear.
-intros (m, r, s) Hm.
-now destruct m as [|[m|m|]|m] ; try (now elim Hm) ; destruct r as [|] ; destruct s as [|].
-Qed.
-
-Definition shr_fexp m e l :=
-  shr (shr_record_of_loc m l) e (fexp (Zdigits2 m + e) - e).
-
-Theorem shr_truncate :
-  forall m e l,
-  (0 <= m)%Z ->
-  shr_fexp m e l =
-  let '(m', e', l') := truncate radix2 fexp (m, e, l) in (shr_record_of_loc m' l', e').
-Proof.
-intros m e l Hm.
-case_eq (truncate radix2 fexp (m, e, l)).
-intros (m', e') l'.
-unfold shr_fexp.
-rewrite Zdigits2_Zdigits.
-case_eq (fexp (Zdigits radix2 m + e) - e)%Z.
-(* *)
-intros He.
-unfold truncate.
-rewrite He.
-simpl.
-intros H.
-now inversion H.
-(* *)
-intros p Hp.
-assert (He: (e <= fexp (Zdigits radix2 m + e))%Z).
-clear -Hp ; zify ; omega.
-destruct (inbetween_float_ex radix2 m e l) as (x, Hx).
-generalize (inbetween_shr x m e l (fexp (Zdigits radix2 m + e) - e) Hm Hx).
-assert (Hx0 : (0 <= x)%R).
-apply Rle_trans with (F2R (Float radix2 m e)).
-now apply F2R_ge_0_compat.
-exact (proj1 (inbetween_float_bounds _ _ _ _ _ Hx)).
-case_eq (shr (shr_record_of_loc m l) e (fexp (Zdigits radix2 m + e) - e)).
-intros mrs e'' H3 H4 H1.
-generalize (truncate_correct radix2 _ x m e l Hx0 Hx (or_introl _ He)).
-rewrite H1.
-intros (H2,_).
-rewrite <- Hp, H3.
-assert (e'' = e').
-change (snd (mrs, e'') = snd (fst (m',e',l'))).
-rewrite <- H1, <- H3.
-unfold truncate.
-now rewrite Hp.
-rewrite H in H4 |- *.
-apply (f_equal (fun v => (v, _))).
-destruct (inbetween_float_unique _ _ _ _ _ _ _ H2 H4) as (H5, H6).
-rewrite H5, H6.
-case mrs.
-now intros m0 [|] [|].
-(* *)
-intros p Hp.
-unfold truncate.
-rewrite Hp.
-simpl.
-intros H.
-now inversion H.
-Qed.
-
-(** Rounding modes *)
-
-Inductive mode := mode_NE | mode_ZR | mode_DN | mode_UP | mode_NA.
-
-Definition round_mode m :=
-  match m with
-  | mode_NE => ZnearestE
-  | mode_ZR => Ztrunc
-  | mode_DN => Zfloor
-  | mode_UP => Zceil
-  | mode_NA => ZnearestA
-  end.
-
-Definition choice_mode m sx mx lx :=
-  match m with
-  | mode_NE => cond_incr (round_N (negb (Zeven mx)) lx) mx
-  | mode_ZR => mx
-  | mode_DN => cond_incr (round_sign_DN sx lx) mx
-  | mode_UP => cond_incr (round_sign_UP sx lx) mx
-  | mode_NA => cond_incr (round_N true lx) mx
-  end.
-
-Global Instance valid_rnd_round_mode : forall m, Valid_rnd (round_mode m).
-Proof.
-destruct m ; unfold round_mode ; auto with typeclass_instances.
-Qed.
-
-Definition overflow_to_inf m s :=
-  match m with
-  | mode_NE => true
-  | mode_NA => true
-  | mode_ZR => false
-  | mode_UP => negb s
-  | mode_DN => s
-  end.
-
-Definition binary_overflow m s :=
-  if overflow_to_inf m s then F754_infinity s
-  else F754_finite s (match (Zpower 2 prec - 1)%Z with Zpos p => p | _ => xH end) (emax - prec).
-
-Definition binary_round_aux mode sx mx ex lx :=
-  let '(mrs', e') := shr_fexp (Zpos mx) ex lx in
-  let '(mrs'', e'') := shr_fexp (choice_mode mode sx (shr_m mrs') (loc_of_shr_record mrs')) e' loc_Exact in
-  match shr_m mrs'' with
-  | Z0 => F754_zero sx
-  | Zpos m => if Zle_bool e'' (emax - prec) then F754_finite sx m e'' else binary_overflow mode sx
-  | _ => F754_nan false xH (* dummy *)
-  end.
-
-Theorem binary_round_aux_correct :
-  forall mode x mx ex lx,
-  inbetween_float radix2 (Zpos mx) ex (Rabs x) lx ->
-  (ex <= fexp (Zdigits radix2 (Zpos mx) + ex))%Z ->
-  let z := binary_round_aux mode (Rlt_bool x 0) mx ex lx in
-  valid_binary z = true /\
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode mode) x)) (bpow radix2 emax) then
-    FF2R radix2 z = round radix2 fexp (round_mode mode) x /\
-    is_finite_FF z = true /\ sign_FF z = Rlt_bool x 0
-  else
-    z = binary_overflow mode (Rlt_bool x 0).
-Proof with auto with typeclass_instances.
-intros m x mx ex lx Bx Ex z.
-unfold binary_round_aux in z.
-revert z.
-rewrite shr_truncate. 2: easy.
-refine (_ (round_trunc_sign_any_correct _ _ (round_mode m) (choice_mode m) _ x (Zpos mx) ex lx Bx (or_introl _ Ex))).
-refine (_ (truncate_correct_partial _ _ _ _ _ _ _ Bx Ex)).
-destruct (truncate radix2 fexp (Zpos mx, ex, lx)) as ((m1, e1), l1).
-rewrite loc_of_shr_record_of_loc, shr_m_shr_record_of_loc.
-set (m1' := choice_mode m (Rlt_bool x 0) m1 l1).
-intros (H1a,H1b) H1c.
-rewrite H1c.
-assert (Hm: (m1 <= m1')%Z).
-(* . *)
-unfold m1', choice_mode, cond_incr.
-case m ;
-  try apply Zle_refl ;
-  match goal with |- (m1 <= if ?b then _ else _)%Z =>
-    case b ; [ apply Zle_succ | apply Zle_refl ] end.
-assert (Hr: Rabs (round radix2 fexp (round_mode m) x) = F2R (Float radix2 m1' e1)).
-(* . *)
-rewrite <- (Zabs_eq m1').
-replace (Zabs m1') with (Zabs (cond_Zopp (Rlt_bool x 0) m1')).
-rewrite F2R_Zabs.
-now apply f_equal.
-apply abs_cond_Zopp.
-apply Zle_trans with (2 := Hm).
-apply Zlt_succ_le.
-apply F2R_gt_0_reg with radix2 e1.
-apply Rle_lt_trans with (1 := Rabs_pos x).
-exact (proj2 (inbetween_float_bounds _ _ _ _ _ H1a)).
-(* . *)
-assert (Br: inbetween_float radix2 m1' e1 (Rabs (round radix2 fexp (round_mode m) x)) loc_Exact).
-now apply inbetween_Exact.
-destruct m1' as [|m1'|m1'].
-(* . m1' = 0 *)
-rewrite shr_truncate. 2: apply Zle_refl.
-generalize (truncate_0 radix2 fexp e1 loc_Exact).
-destruct (truncate radix2 fexp (Z0, e1, loc_Exact)) as ((m2, e2), l2).
-rewrite shr_m_shr_record_of_loc.
-intros Hm2.
-rewrite Hm2.
-repeat split.
-rewrite Rlt_bool_true.
-repeat split.
-apply sym_eq.
-case Rlt_bool ; apply F2R_0.
-rewrite <- F2R_Zabs, abs_cond_Zopp, F2R_0.
-apply bpow_gt_0.
-(* . 0 < m1' *)
-assert (He: (e1 <= fexp (Zdigits radix2 (Zpos m1') + e1))%Z).
-rewrite <- ln_beta_F2R_Zdigits, <- Hr, ln_beta_abs.
-2: discriminate.
-rewrite H1b.
-rewrite canonic_exp_abs.
-fold (canonic_exp radix2 fexp (round radix2 fexp (round_mode m) x)).
-apply canonic_exp_round_ge...
-rewrite H1c.
-case (Rlt_bool x 0).
-apply Rlt_not_eq.
-now apply F2R_lt_0_compat.
-apply Rgt_not_eq.
-now apply F2R_gt_0_compat.
-refine (_ (truncate_correct_partial _ _ _ _ _ _ _ Br He)).
-2: now rewrite Hr ; apply F2R_gt_0_compat.
-refine (_ (truncate_correct_format radix2 fexp (Zpos m1') e1 _ _ He)).
-2: discriminate.
-rewrite shr_truncate. 2: easy.
-destruct (truncate radix2 fexp (Zpos m1', e1, loc_Exact)) as ((m2, e2), l2).
-rewrite shr_m_shr_record_of_loc.
-intros (H3,H4) (H2,_).
-destruct m2 as [|m2|m2].
-elim Rgt_not_eq with (2 := H3).
-rewrite F2R_0.
-now apply F2R_gt_0_compat.
-rewrite F2R_cond_Zopp, H3, abs_cond_Ropp, <- F2R_abs.
-simpl Zabs.
-case_eq (Zle_bool e2 (emax - prec)) ; intros He2.
-assert (bounded m2 e2 = true).
-apply andb_true_intro.
-split.
-unfold canonic_mantissa.
-apply Zeq_bool_true.
-rewrite Zpos_digits2_pos.
-rewrite <- ln_beta_F2R_Zdigits.
-apply sym_eq.
-now rewrite H3 in H4.
-discriminate.
-exact He2.
-apply (conj H).
-rewrite Rlt_bool_true.
-repeat split.
-apply F2R_cond_Zopp.
-now apply bounded_lt_emax.
-rewrite (Rlt_bool_false _ (bpow radix2 emax)).
-refine (conj _ (refl_equal _)).
-unfold binary_overflow.
-case overflow_to_inf.
-apply refl_equal.
-unfold valid_binary, bounded.
-rewrite Zle_bool_refl.
-rewrite Bool.andb_true_r.
-apply Zeq_bool_true.
-rewrite Zpos_digits2_pos.
-replace (Zdigits radix2 (Zpos (match (Zpower 2 prec - 1)%Z with Zpos p => p | _ => xH end))) with prec.
-unfold fexp, FLT_exp, emin.
-generalize (prec_gt_0 prec).
-clear -Hmax ; zify ; omega.
-change 2%Z with (radix_val radix2).
-case_eq (Zpower radix2 prec - 1)%Z.
-simpl Zdigits.
-generalize (Zpower_gt_1 radix2 prec (prec_gt_0 prec)).
-clear ; omega.
-intros p Hp.
-apply Zle_antisym.
-cut (prec - 1 < Zdigits radix2 (Zpos p))%Z. clear ; omega.
-apply Zdigits_gt_Zpower.
-simpl Zabs. rewrite <- Hp.
-cut (Zpower radix2 (prec - 1) < Zpower radix2 prec)%Z. clear ; omega.
-apply lt_Z2R.
-rewrite 2!Z2R_Zpower. 2: now apply Zlt_le_weak.
-apply bpow_lt.
-apply Zlt_pred.
-now apply Zlt_0_le_0_pred.
-apply Zdigits_le_Zpower.
-simpl Zabs. rewrite <- Hp.
-apply Zlt_pred.
-intros p Hp.
-generalize (Zpower_gt_1 radix2 _ (prec_gt_0 prec)).
-clear -Hp ; zify ; omega.
-apply Rnot_lt_le.
-intros Hx.
-generalize (refl_equal (bounded m2 e2)).
-unfold bounded at 2.
-rewrite He2.
-rewrite Bool.andb_false_r.
-rewrite bounded_canonic_lt_emax with (2 := Hx).
-discriminate.
-unfold canonic.
-now rewrite <- H3.
-elim Rgt_not_eq with (2 := H3).
-apply Rlt_trans with R0.
-now apply F2R_lt_0_compat.
-now apply F2R_gt_0_compat.
-rewrite <- Hr.
-apply generic_format_abs...
-apply generic_format_round...
-(* . not m1' < 0 *)
-elim Rgt_not_eq with (2 := Hr).
-apply Rlt_le_trans with R0.
-now apply F2R_lt_0_compat.
-apply Rabs_pos.
-(* *)
-apply Rlt_le_trans with (2 := proj1 (inbetween_float_bounds _ _ _ _ _ Bx)).
-now apply F2R_gt_0_compat.
-(* all the modes are valid *)
-clear. case m.
-exact inbetween_int_NE_sign.
-exact inbetween_int_ZR_sign.
-exact inbetween_int_DN_sign.
-exact inbetween_int_UP_sign.
-exact inbetween_int_NA_sign.
-Qed.
-
-(** Multiplication *)
-
-Lemma Bmult_correct_aux :
-  forall m sx mx ex (Hx : bounded mx ex = true) sy my ey (Hy : bounded my ey = true),
-  let x := F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) in
-  let y := F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey) in
-  let z := binary_round_aux m (xorb sx sy) (mx * my) (ex + ey) loc_Exact in
-  valid_binary z = true /\
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (x * y))) (bpow radix2 emax) then
-    FF2R radix2 z = round radix2 fexp (round_mode m) (x * y) /\
-    is_finite_FF z = true /\ sign_FF z = xorb sx sy
-  else
-    z = binary_overflow m (xorb sx sy).
-Proof.
-intros m sx mx ex Hx sy my ey Hy x y.
-unfold x, y.
-rewrite <- F2R_mult.
-simpl.
-replace (xorb sx sy) with (Rlt_bool (F2R (Float radix2 (cond_Zopp sx (Zpos mx) * cond_Zopp sy (Zpos my)) (ex + ey))) 0).
-apply binary_round_aux_correct.
-constructor.
-rewrite <- F2R_abs.
-apply F2R_eq_compat.
-rewrite Zabs_Zmult.
-now rewrite 2!abs_cond_Zopp.
-(* *)
-change (Zpos (mx * my)) with (Zpos mx * Zpos my)%Z.
-assert (forall m e, bounded m e = true -> fexp (Zdigits radix2 (Zpos m) + e) = e)%Z.
-clear. intros m e Hb.
-destruct (andb_prop _ _ Hb) as (H,_).
-apply Zeq_bool_eq.
-now rewrite <- Zpos_digits2_pos.
-generalize (H _ _ Hx) (H _ _ Hy).
-clear x y sx sy Hx Hy H.
-unfold fexp, FLT_exp.
-refine (_ (Zdigits_mult_ge radix2 (Zpos mx) (Zpos my) _ _)) ; try discriminate.
-refine (_ (Zdigits_gt_0 radix2 (Zpos mx) _) (Zdigits_gt_0 radix2 (Zpos my) _)) ; try discriminate.
-generalize (Zdigits radix2 (Zpos mx)) (Zdigits radix2 (Zpos my)) (Zdigits radix2 (Zpos mx * Zpos my)).
-clear -Hmax.
-unfold emin.
-intros dx dy dxy Hx Hy Hxy.
-zify ; intros ; subst.
-omega.
-(* *)
-case sx ; case sy.
-apply Rlt_bool_false.
-now apply F2R_ge_0_compat.
-apply Rlt_bool_true.
-now apply F2R_lt_0_compat.
-apply Rlt_bool_true.
-now apply F2R_lt_0_compat.
-apply Rlt_bool_false.
-now apply F2R_ge_0_compat.
-Qed.
-
-Definition Bmult mult_nan m x y :=
-  let f pl := B754_nan (fst pl) (snd pl) in
-  match x, y with
-  | B754_nan _ _, _ | _, B754_nan _ _ => f (mult_nan x y)
-  | B754_infinity sx, B754_infinity sy => B754_infinity (xorb sx sy)
-  | B754_infinity sx, B754_finite sy _ _ _ => B754_infinity (xorb sx sy)
-  | B754_finite sx _ _ _, B754_infinity sy => B754_infinity (xorb sx sy)
-  | B754_infinity _, B754_zero _ => f (mult_nan x y)
-  | B754_zero _, B754_infinity _ => f (mult_nan x y)
-  | B754_finite sx _ _ _, B754_zero sy => B754_zero (xorb sx sy)
-  | B754_zero sx, B754_finite sy _ _ _ => B754_zero (xorb sx sy)
-  | B754_zero sx, B754_zero sy => B754_zero (xorb sx sy)
-  | B754_finite sx mx ex Hx, B754_finite sy my ey Hy =>
-    FF2B _ (proj1 (Bmult_correct_aux m sx mx ex Hx sy my ey Hy))
-  end.
-
-Theorem Bmult_correct :
-  forall mult_nan m x y,
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x * B2R y))) (bpow radix2 emax) then
-    B2R (Bmult mult_nan m x y) = round radix2 fexp (round_mode m) (B2R x * B2R y) /\
-    is_finite (Bmult mult_nan m x y) = andb (is_finite x) (is_finite y) /\
-    (is_nan (Bmult mult_nan m x y) = false ->
-      Bsign (Bmult mult_nan m x y) = xorb (Bsign x) (Bsign y))
-  else
-    B2FF (Bmult mult_nan m x y) = binary_overflow m (xorb (Bsign x) (Bsign y)).
-Proof.
-intros mult_nan m [sx|sx|sx plx|sx mx ex Hx] [sy|sy|sy ply|sy my ey Hy] ;
-  try ( rewrite ?Rmult_0_r, ?Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ now repeat constructor | apply bpow_gt_0 | now auto with typeclass_instances ] ).
-simpl.
-case Bmult_correct_aux.
-intros H1.
-case Rlt_bool.
-intros (H2, (H3, H4)).
-split.
-now rewrite B2R_FF2B.
-split.
-now rewrite is_finite_FF2B.
-rewrite Bsign_FF2B. auto.
-intros H2.
-now rewrite B2FF_FF2B.
-Qed.
-
-Definition Bmult_FF mult_nan m x y :=
-  let f pl := F754_nan (fst pl) (snd pl) in
-  match x, y with
-  | F754_nan _ _, _ | _, F754_nan _ _ => f (mult_nan x y)
-  | F754_infinity sx, F754_infinity sy => F754_infinity (xorb sx sy)
-  | F754_infinity sx, F754_finite sy _ _ => F754_infinity (xorb sx sy)
-  | F754_finite sx _ _, F754_infinity sy => F754_infinity (xorb sx sy)
-  | F754_infinity _, F754_zero _ => f (mult_nan x y)
-  | F754_zero _, F754_infinity _ => f (mult_nan x y)
-  | F754_finite sx _ _, F754_zero sy => F754_zero (xorb sx sy)
-  | F754_zero sx, F754_finite sy _ _ => F754_zero (xorb sx sy)
-  | F754_zero sx, F754_zero sy => F754_zero (xorb sx sy)
-  | F754_finite sx mx ex, F754_finite sy my ey =>
-    binary_round_aux m (xorb sx sy) (mx * my) (ex + ey) loc_Exact
-  end.
-
-Theorem B2FF_Bmult :
-  forall mult_nan mult_nan_ff,
-  forall m x y,
-  mult_nan_ff (B2FF x) (B2FF y) = (let '(sr, exist plr _) := mult_nan x y in (sr, plr)) ->
-  B2FF (Bmult mult_nan m x y) = Bmult_FF mult_nan_ff m (B2FF x) (B2FF y).
-Proof.
-intros mult_nan mult_nan_ff m x y Hmult_nan.
-unfold Bmult_FF. rewrite Hmult_nan.
-destruct x as [sx|sx|sx [plx Hplx]|sx mx ex Hx], y as [sy|sy|sy [ply Hply]|sy my ey Hy] ;
-  simpl; try match goal with |- context [mult_nan ?x ?y] =>
-               destruct (mult_nan x y) as [? []] end;
-  try easy.
-apply B2FF_FF2B.
-Qed.
-
-(** Normalization and rounding *)
-
-Definition shl_align mx ex ex' :=
-  match (ex' - ex)%Z with
-  | Zneg d => (shift_pos d mx, ex')
-  | _ => (mx, ex)
-  end.
-
-Theorem shl_align_correct :
-  forall mx ex ex',
-  let (mx', ex'') := shl_align mx ex ex' in
-  F2R (Float radix2 (Zpos mx) ex) = F2R (Float radix2 (Zpos mx') ex'') /\
-  (ex'' <= ex')%Z.
-Proof.
-intros mx ex ex'.
-unfold shl_align.
-case_eq (ex' - ex)%Z.
-(* d = 0 *)
-intros H.
-repeat split.
-rewrite Zminus_eq with (1 := H).
-apply Zle_refl.
-(* d > 0 *)
-intros d Hd.
-repeat split.
-replace ex' with (ex' - ex + ex)%Z by ring.
-rewrite Hd.
-pattern ex at 1 ; rewrite <- Zplus_0_l.
-now apply Zplus_le_compat_r.
-(* d < 0 *)
-intros d Hd.
-rewrite shift_pos_correct, Zmult_comm.
-change (Zpower_pos 2 d) with (Zpower radix2 (Zpos d)).
-change (Zpos d) with (Zopp (Zneg d)).
-rewrite <- Hd.
-split.
-replace (- (ex' - ex))%Z with (ex - ex')%Z by ring.
-apply F2R_change_exp.
-apply Zle_0_minus_le.
-replace (ex - ex')%Z with (- (ex' - ex))%Z by ring.
-now rewrite Hd.
-apply Zle_refl.
-Qed.
-
-Theorem snd_shl_align :
-  forall mx ex ex',
-  (ex' <= ex)%Z ->
-  snd (shl_align mx ex ex') = ex'.
-Proof.
-intros mx ex ex' He.
-unfold shl_align.
-case_eq (ex' - ex)%Z ; simpl.
-intros H.
-now rewrite Zminus_eq with (1 := H).
-intros p.
-clear -He ; zify ; omega.
-intros.
-apply refl_equal.
-Qed.
-
-Definition shl_align_fexp mx ex :=
-  shl_align mx ex (fexp (Zpos (digits2_pos mx) + ex)).
-
-Theorem shl_align_fexp_correct :
-  forall mx ex,
-  let (mx', ex') := shl_align_fexp mx ex in
-  F2R (Float radix2 (Zpos mx) ex) = F2R (Float radix2 (Zpos mx') ex') /\
-  (ex' <= fexp (Zdigits radix2 (Zpos mx') + ex'))%Z.
-Proof.
-intros mx ex.
-unfold shl_align_fexp.
-generalize (shl_align_correct mx ex (fexp (Zpos (digits2_pos mx) + ex))).
-rewrite Zpos_digits2_pos.
-case shl_align.
-intros mx' ex' (H1, H2).
-split.
-exact H1.
-rewrite <- ln_beta_F2R_Zdigits. 2: easy.
-rewrite <- H1.
-now rewrite ln_beta_F2R_Zdigits.
-Qed.
-
-Definition binary_round m sx mx ex :=
-  let '(mz, ez) := shl_align_fexp mx ex in binary_round_aux m sx mz ez loc_Exact.
-
-Theorem binary_round_correct :
-  forall m sx mx ex,
-  let z := binary_round m sx mx ex in
-  valid_binary z = true /\
-  let x := F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) in
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) x)) (bpow radix2 emax) then
-    FF2R radix2 z = round radix2 fexp (round_mode m) x /\
-    is_finite_FF z = true /\
-    sign_FF z = sx
-  else
-    z = binary_overflow m sx.
-Proof.
-intros m sx mx ex.
-unfold binary_round.
-generalize (shl_align_fexp_correct mx ex).
-destruct (shl_align_fexp mx ex) as (mz, ez).
-intros (H1, H2).
-set (x := F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex)).
-replace sx with (Rlt_bool x 0).
-apply binary_round_aux_correct.
-constructor.
-unfold x.
-now rewrite <- F2R_Zabs, abs_cond_Zopp.
-exact H2.
-unfold x.
-case sx.
-apply Rlt_bool_true.
-now apply F2R_lt_0_compat.
-apply Rlt_bool_false.
-now apply F2R_ge_0_compat.
-Qed.
-
-Definition binary_normalize mode m e szero :=
-  match m with
-  | Z0 => B754_zero szero
-  | Zpos m => FF2B _ (proj1 (binary_round_correct mode false m e))
-  | Zneg m => FF2B _ (proj1 (binary_round_correct mode true m e))
-  end.
-
-Theorem binary_normalize_correct :
-  forall m mx ex szero,
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (F2R (Float radix2 mx ex)))) (bpow radix2 emax) then
-    B2R (binary_normalize m mx ex szero) = round radix2 fexp (round_mode m) (F2R (Float radix2 mx ex)) /\
-    is_finite (binary_normalize m mx ex szero) = true /\
-    Bsign (binary_normalize m mx ex szero) =
-      match Rcompare (F2R (Float radix2 mx ex)) 0 with
-        | Eq => szero
-        | Lt => true
-        | Gt => false
-      end
-  else
-    B2FF (binary_normalize m mx ex szero) = binary_overflow m (Rlt_bool (F2R (Float radix2 mx ex)) 0).
-Proof with auto with typeclass_instances.
-intros m mx ez szero.
-destruct mx as [|mz|mz] ; simpl.
-rewrite F2R_0, round_0, Rabs_R0, Rlt_bool_true...
-split... split...
-rewrite Rcompare_Eq...
-apply bpow_gt_0.
-(* . mz > 0 *)
-generalize (binary_round_correct m false mz ez).
-simpl.
-case Rlt_bool_spec.
-intros _ (Vz, (Rz, (Rz', Rz''))).
-split.
-now rewrite B2R_FF2B.
-split.
-now rewrite is_finite_FF2B.
-rewrite Bsign_FF2B, Rz''.
-rewrite Rcompare_Gt...
-apply F2R_gt_0_compat.
-simpl. zify; omega.
-intros Hz' (Vz, Rz).
-rewrite B2FF_FF2B, Rz.
-apply f_equal.
-apply sym_eq.
-apply Rlt_bool_false.
-now apply F2R_ge_0_compat.
-(* . mz < 0 *)
-generalize (binary_round_correct m true mz ez).
-simpl.
-case Rlt_bool_spec.
-intros _ (Vz, (Rz, (Rz', Rz''))).
-split.
-now rewrite B2R_FF2B.
-split.
-now rewrite is_finite_FF2B.
-rewrite Bsign_FF2B, Rz''.
-rewrite Rcompare_Lt...
-apply F2R_lt_0_compat.
-simpl. zify; omega.
-intros Hz' (Vz, Rz).
-rewrite B2FF_FF2B, Rz.
-apply f_equal.
-apply sym_eq.
-apply Rlt_bool_true.
-now apply F2R_lt_0_compat.
-Qed.
-
-(** Addition *)
-
-Definition Bplus plus_nan m x y :=
-  let f pl := B754_nan (fst pl) (snd pl) in
-  match x, y with
-  | B754_nan _ _, _ | _, B754_nan _ _ => f (plus_nan x y)
-  | B754_infinity sx, B754_infinity sy =>
-    if Bool.eqb sx sy then x else f (plus_nan x y)
-  | B754_infinity _, _ => x
-  | _, B754_infinity _ => y
-  | B754_zero sx, B754_zero sy =>
-    if Bool.eqb sx sy then x else
-    match m with mode_DN => B754_zero true | _ => B754_zero false end
-  | B754_zero _, _ => y
-  | _, B754_zero _ => x
-  | B754_finite sx mx ex Hx, B754_finite sy my ey Hy =>
-    let ez := Zmin ex ey in
-    binary_normalize m (Zplus (cond_Zopp sx (Zpos (fst (shl_align mx ex ez)))) (cond_Zopp sy (Zpos (fst (shl_align my ey ez)))))
-      ez (match m with mode_DN => true | _ => false end)
-  end.
-
-Theorem Bplus_correct :
-  forall plus_nan m x y,
-  is_finite x = true ->
-  is_finite y = true ->
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x + B2R y))) (bpow radix2 emax) then
-    B2R (Bplus plus_nan m x y) = round radix2 fexp (round_mode m) (B2R x + B2R y) /\
-    is_finite (Bplus plus_nan m x y) = true /\
-    Bsign (Bplus plus_nan m x y) =
-      match Rcompare (B2R x + B2R y) 0 with
-        | Eq => match m with mode_DN => orb (Bsign x) (Bsign y)
-                                 | _ => andb (Bsign x) (Bsign y) end
-        | Lt => true
-        | Gt => false
-      end
-  else
-    (B2FF (Bplus plus_nan m x y) = binary_overflow m (Bsign x) /\ Bsign x = Bsign y).
-Proof with auto with typeclass_instances.
-intros plus_nan m [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] Fx Fy ; try easy.
-(* *)
-rewrite Rplus_0_r, round_0, Rabs_R0, Rlt_bool_true...
-simpl.
-rewrite Rcompare_Eq by auto.
-destruct sx, sy; try easy; now case m.
-apply bpow_gt_0.
-(* *)
-rewrite Rplus_0_l, round_generic, Rlt_bool_true...
-split... split...
-simpl. unfold F2R.
-erewrite <- Rmult_0_l, Rcompare_mult_r.
-rewrite Rcompare_Z2R with (y:=0%Z).
-destruct sy...
-apply bpow_gt_0.
-apply abs_B2R_lt_emax.
-apply generic_format_B2R.
-(* *)
-rewrite Rplus_0_r, round_generic, Rlt_bool_true...
-split... split...
-simpl. unfold F2R.
-erewrite <- Rmult_0_l, Rcompare_mult_r.
-rewrite Rcompare_Z2R with (y:=0%Z).
-destruct sx...
-apply bpow_gt_0.
-apply abs_B2R_lt_emax.
-apply generic_format_B2R.
-(* *)
-clear Fx Fy.
-simpl.
-set (szero := match m with mode_DN => true | _ => false end).
-set (ez := Zmin ex ey).
-set (mz := (cond_Zopp sx (Zpos (fst (shl_align mx ex ez))) + cond_Zopp sy (Zpos (fst (shl_align my ey ez))))%Z).
-assert (Hp: (F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) +
-  F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey))%R = F2R (Float radix2 mz ez)).
-rewrite 2!F2R_cond_Zopp.
-generalize (shl_align_correct mx ex ez).
-generalize (shl_align_correct my ey ez).
-generalize (snd_shl_align mx ex ez (Zle_min_l ex ey)).
-generalize (snd_shl_align my ey ez (Zle_min_r ex ey)).
-destruct (shl_align mx ex ez) as (mx', ex').
-destruct (shl_align my ey ez) as (my', ey').
-simpl.
-intros H1 H2.
-rewrite H1, H2.
-clear H1 H2.
-intros (H1, _) (H2, _).
-rewrite H1, H2.
-clear H1 H2.
-rewrite <- 2!F2R_cond_Zopp.
-unfold F2R. simpl.
-now rewrite <- Rmult_plus_distr_r, <- Z2R_plus.
-rewrite Hp.
-assert (Sz: (bpow radix2 emax <= Rabs (round radix2 fexp (round_mode m) (F2R (Float radix2 mz ez))))%R -> sx = Rlt_bool (F2R (Float radix2 mz ez)) 0 /\ sx = sy).
-(* . *)
-rewrite <- Hp.
-intros Bz.
-destruct (Bool.bool_dec sx sy) as [Hs|Hs].
-(* .. *)
-refine (conj _ Hs).
-rewrite Hs.
-apply sym_eq.
-case sy.
-apply Rlt_bool_true.
-rewrite <- (Rplus_0_r 0).
-apply Rplus_lt_compat.
-now apply F2R_lt_0_compat.
-now apply F2R_lt_0_compat.
-apply Rlt_bool_false.
-rewrite <- (Rplus_0_r 0).
-apply Rplus_le_compat.
-now apply F2R_ge_0_compat.
-now apply F2R_ge_0_compat.
-(* .. *)
-elim Rle_not_lt with (1 := Bz).
-generalize (bounded_lt_emax _ _ Hx) (bounded_lt_emax _ _ Hy) (andb_prop _ _ Hx) (andb_prop _ _ Hy).
-intros Bx By (Hx',_) (Hy',_).
-generalize (canonic_canonic_mantissa sx _ _ Hx') (canonic_canonic_mantissa sy _ _ Hy').
-clear -Bx By Hs prec_gt_0_.
-intros Cx Cy.
-destruct sx.
-(* ... *)
-destruct sy.
-now elim Hs.
-clear Hs.
-apply Rabs_lt.
-split.
-apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)).
-rewrite F2R_Zopp.
-now apply Ropp_lt_contravar.
-apply round_ge_generic...
-now apply generic_format_canonic.
-pattern (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)) at 1 ; rewrite <- Rplus_0_r.
-apply Rplus_le_compat_l.
-now apply F2R_ge_0_compat.
-apply Rle_lt_trans with (2 := By).
-apply round_le_generic...
-now apply generic_format_canonic.
-rewrite <- (Rplus_0_l (F2R (Float radix2 (Zpos my) ey))).
-apply Rplus_le_compat_r.
-now apply F2R_le_0_compat.
-(* ... *)
-destruct sy.
-2: now elim Hs.
-clear Hs.
-apply Rabs_lt.
-split.
-apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)).
-rewrite F2R_Zopp.
-now apply Ropp_lt_contravar.
-apply round_ge_generic...
-now apply generic_format_canonic.
-pattern (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)) at 1 ; rewrite <- Rplus_0_l.
-apply Rplus_le_compat_r.
-now apply F2R_ge_0_compat.
-apply Rle_lt_trans with (2 := Bx).
-apply round_le_generic...
-now apply generic_format_canonic.
-rewrite <- (Rplus_0_r (F2R (Float radix2 (Zpos mx) ex))).
-apply Rplus_le_compat_l.
-now apply F2R_le_0_compat.
-(* . *)
-generalize (binary_normalize_correct m mz ez szero).
-case Rlt_bool_spec.
-split; try easy. split; try easy.
-destruct (Rcompare_spec (F2R (beta:=radix2) {| Fnum := mz; Fexp := ez |}) 0); try easy.
-rewrite H1 in Hp.
-apply Rplus_opp_r_uniq in Hp.
-rewrite <- F2R_Zopp in Hp.
-eapply canonic_unicity in Hp.
-inversion Hp. destruct sy, sx, m; try discriminate H3; easy.
-apply canonic_canonic_mantissa.
-apply Bool.andb_true_iff in Hy. easy.
-replace (-cond_Zopp sx (Z.pos mx))%Z with  (cond_Zopp (negb sx) (Z.pos mx))
-  by (destruct sx; auto).
-apply canonic_canonic_mantissa.
-apply Bool.andb_true_iff in Hx. easy.
-intros Hz' Vz.
-specialize (Sz Hz').
-split.
-rewrite Vz.
-now apply f_equal.
-apply Sz.
-Qed.
-
-(** Subtraction *)
-
-Definition Bminus minus_nan m x y := Bplus minus_nan m x (Bopp pair y).
-
-Theorem Bminus_correct :
-  forall minus_nan m x y,
-  is_finite x = true ->
-  is_finite y = true ->
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x - B2R y))) (bpow radix2 emax) then
-    B2R (Bminus minus_nan m x y) = round radix2 fexp (round_mode m) (B2R x - B2R y) /\
-    is_finite (Bminus minus_nan m x y) = true /\
-    Bsign (Bminus minus_nan m x y) =
-      match Rcompare (B2R x - B2R y) 0 with
-        | Eq => match m with mode_DN => orb (Bsign x) (negb (Bsign y))
-                                 | _ => andb (Bsign x) (negb (Bsign y)) end
-        | Lt => true
-        | Gt => false
-      end
-  else
-    (B2FF (Bminus minus_nan m x y) = binary_overflow m (Bsign x) /\ Bsign x = negb (Bsign y)).
-Proof with auto with typeclass_instances.
-intros m minus_nan x y Fx Fy.
-replace (negb (Bsign y)) with (Bsign (Bopp pair y)).
-unfold Rminus.
-erewrite <- B2R_Bopp.
-apply Bplus_correct.
-exact Fx.
-rewrite is_finite_Bopp. auto. now destruct y as [ | | | ].
-Qed.
-
-(** Division *)
-
-Definition Fdiv_core_binary m1 e1 m2 e2 :=
-  let d1 := Zdigits2 m1 in
-  let d2 := Zdigits2 m2 in
-  let e := (e1 - e2)%Z in
-  let (m, e') :=
-    match (d2 + prec - d1)%Z with
-    | Zpos p => (Z.shiftl m1 (Zpos p), e + Zneg p)%Z
-    | _ => (m1, e)
-    end in
-  let '(q, r) :=  Zfast_div_eucl m m2 in
-  (q, e', new_location m2 r loc_Exact).
-
-Lemma Bdiv_correct_aux :
-  forall m sx mx ex sy my ey,
-  let x := F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) in
-  let y := F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey) in
-  let z :=
-    let '(mz, ez, lz) := Fdiv_core_binary (Zpos mx) ex (Zpos my) ey in
-    match mz with
-    | Zpos mz => binary_round_aux m (xorb sx sy) mz ez lz
-    | _ => F754_nan false xH (* dummy *)
-    end in
-  valid_binary z = true /\
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (x / y))) (bpow radix2 emax) then
-    FF2R radix2 z = round radix2 fexp (round_mode m) (x / y) /\
-    is_finite_FF z = true /\ sign_FF z = xorb sx sy
-  else
-    z = binary_overflow m (xorb sx sy).
-Proof.
-intros m sx mx ex sy my ey.
-replace (Fdiv_core_binary (Zpos mx) ex (Zpos my) ey) with (Fdiv_core radix2 prec (Zpos mx) ex (Zpos my) ey).
-refine (_ (Fdiv_core_correct radix2 prec (Zpos mx) ex (Zpos my) ey _ _ _)) ; try easy.
-destruct (Fdiv_core radix2 prec (Zpos mx) ex (Zpos my) ey) as ((mz, ez), lz).
-intros (Pz, Bz).
-simpl.
-replace (xorb sx sy) with (Rlt_bool (F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) *
-  / F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey)) 0).
-unfold Rdiv.
-destruct mz as [|mz|mz].
-(* . mz = 0 *)
-elim (Zlt_irrefl prec).
-now apply Zle_lt_trans with Z0.
-(* . mz > 0 *)
-apply binary_round_aux_correct.
-rewrite Rabs_mult, Rabs_Rinv.
-now rewrite <- 2!F2R_Zabs, 2!abs_cond_Zopp.
-case sy.
-apply Rlt_not_eq.
-now apply F2R_lt_0_compat.
-apply Rgt_not_eq.
-now apply F2R_gt_0_compat.
-revert Pz.
-generalize (Zdigits radix2 (Zpos mz)).
-unfold fexp, FLT_exp.
-clear.
-intros ; zify ; subst.
-omega.
-(* . mz < 0 *)
-elim Rlt_not_le with (1 := proj2 (inbetween_float_bounds _ _ _ _ _ Bz)).
-apply Rle_trans with R0.
-apply F2R_le_0_compat.
-now case mz.
-apply Rmult_le_pos.
-now apply F2R_ge_0_compat.
-apply Rlt_le.
-apply Rinv_0_lt_compat.
-now apply F2R_gt_0_compat.
-(* *)
-case sy ; simpl.
-change (Zneg my) with (Zopp (Zpos my)).
-rewrite F2R_Zopp.
-rewrite <- Ropp_inv_permute.
-rewrite Ropp_mult_distr_r_reverse.
-case sx ; simpl.
-apply Rlt_bool_false.
-rewrite <- Ropp_mult_distr_l_reverse.
-apply Rmult_le_pos.
-rewrite <- F2R_opp.
-now apply F2R_ge_0_compat.
-apply Rlt_le.
-apply Rinv_0_lt_compat.
-now apply F2R_gt_0_compat.
-apply Rlt_bool_true.
-rewrite <- Ropp_0.
-apply Ropp_lt_contravar.
-apply Rmult_lt_0_compat.
-now apply F2R_gt_0_compat.
-apply Rinv_0_lt_compat.
-now apply F2R_gt_0_compat.
-apply Rgt_not_eq.
-now apply F2R_gt_0_compat.
-case sx.
-apply Rlt_bool_true.
-rewrite F2R_Zopp.
-rewrite Ropp_mult_distr_l_reverse.
-rewrite <- Ropp_0.
-apply Ropp_lt_contravar.
-apply Rmult_lt_0_compat.
-now apply F2R_gt_0_compat.
-apply Rinv_0_lt_compat.
-now apply F2R_gt_0_compat.
-apply Rlt_bool_false.
-apply Rmult_le_pos.
-now apply F2R_ge_0_compat.
-apply Rlt_le.
-apply Rinv_0_lt_compat.
-now apply F2R_gt_0_compat.
-(* *)
-unfold Fdiv_core_binary, Fdiv_core.
-rewrite 2!Zdigits2_Zdigits.
-change 2%Z with (radix_val radix2).
-destruct (Zdigits radix2 (Z.pos my) + prec - Zdigits radix2 (Z.pos mx))%Z as [|p|p].
-now rewrite Zfast_div_eucl_correct.
-rewrite Z.shiftl_mul_pow2 by easy.
-now rewrite Zfast_div_eucl_correct.
-now rewrite Zfast_div_eucl_correct.
-Qed.
-
-Definition Bdiv div_nan m x y :=
-  let f pl := B754_nan (fst pl) (snd pl) in
-  match x, y with
-  | B754_nan _ _, _ | _, B754_nan _ _ => f (div_nan x y)
-  | B754_infinity sx, B754_infinity sy => f (div_nan x y)
-  | B754_infinity sx, B754_finite sy _ _ _ => B754_infinity (xorb sx sy)
-  | B754_finite sx _ _ _, B754_infinity sy => B754_zero (xorb sx sy)
-  | B754_infinity sx, B754_zero sy => B754_infinity (xorb sx sy)
-  | B754_zero sx, B754_infinity sy => B754_zero (xorb sx sy)
-  | B754_finite sx _ _ _, B754_zero sy => B754_infinity (xorb sx sy)
-  | B754_zero sx, B754_finite sy _ _ _ => B754_zero (xorb sx sy)
-  | B754_zero sx, B754_zero sy => f (div_nan x y)
-  | B754_finite sx mx ex _, B754_finite sy my ey _ =>
-    FF2B _ (proj1 (Bdiv_correct_aux m sx mx ex sy my ey))
-  end.
-
-Theorem Bdiv_correct :
-  forall div_nan m x y,
-  B2R y <> 0%R ->
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x / B2R y))) (bpow radix2 emax) then
-    B2R (Bdiv div_nan m x y) = round radix2 fexp (round_mode m) (B2R x / B2R y) /\
-    is_finite (Bdiv div_nan m x y) = is_finite x /\
-    (is_nan (Bdiv div_nan m x y) = false ->
-      Bsign (Bdiv div_nan m x y) = xorb (Bsign x) (Bsign y))
-  else
-    B2FF (Bdiv div_nan m x y) = binary_overflow m (xorb (Bsign x) (Bsign y)).
-Proof.
-intros div_nan m x [sy|sy|sy ply|sy my ey Hy] Zy ; try now elim Zy.
-revert x.
-unfold Rdiv.
-intros [sx|sx|sx plx|sx mx ex Hx] ;
-  try ( rewrite Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ now repeat constructor | apply bpow_gt_0 | auto with typeclass_instances ] ).
-simpl.
-case Bdiv_correct_aux.
-intros H1.
-unfold Rdiv.
-case Rlt_bool.
-intros (H2, (H3, H4)).
-split.
-now rewrite B2R_FF2B.
-split.
-now rewrite is_finite_FF2B.
-rewrite Bsign_FF2B. congruence.
-intros H2.
-now rewrite B2FF_FF2B.
-Qed.
-
-(** Square root *)
-
-Definition Fsqrt_core_binary m e :=
-  let d := Zdigits2 m in
-  let s := Zmax (2 * prec - d) 0 in
-  let e' := (e - s)%Z in
-  let (s', e'') := if Zeven e' then (s, e') else (s + 1, e' - 1)%Z in
-  let m' :=
-    match s' with
-    | Zpos p => Z.shiftl m (Zpos p)
-    | _ => m
-    end in
-  let (q, r) := Z.sqrtrem m' in
-  let l :=
-    if Zeq_bool r 0 then loc_Exact
-    else loc_Inexact (if Zle_bool r q then Lt else Gt) in
-  (q, Zdiv2 e'', l).
-
-Lemma Bsqrt_correct_aux :
-  forall m mx ex (Hx : bounded mx ex = true),
-  let x := F2R (Float radix2 (Zpos mx) ex) in
-  let z :=
-    let '(mz, ez, lz) := Fsqrt_core_binary (Zpos mx) ex in
-    match mz with
-    | Zpos mz => binary_round_aux m false mz ez lz
-    | _ => F754_nan false xH (* dummy *)
-    end in
-  valid_binary z = true /\
-  FF2R radix2 z = round radix2 fexp (round_mode m) (sqrt x) /\
-  is_finite_FF z = true /\ sign_FF z = false.
-Proof with auto with typeclass_instances.
-intros m mx ex Hx.
-replace (Fsqrt_core_binary (Zpos mx) ex) with (Fsqrt_core radix2 prec (Zpos mx) ex).
-simpl.
-refine (_ (Fsqrt_core_correct radix2 prec (Zpos mx) ex _)) ; try easy.
-destruct (Fsqrt_core radix2 prec (Zpos mx) ex) as ((mz, ez), lz).
-intros (Pz, Bz).
-destruct mz as [|mz|mz].
-(* . mz = 0 *)
-elim (Zlt_irrefl prec).
-now apply Zle_lt_trans with Z0.
-(* . mz > 0 *)
-refine (_ (binary_round_aux_correct m (sqrt (F2R (Float radix2 (Zpos mx) ex))) mz ez lz _ _)).
-rewrite Rlt_bool_false. 2: apply sqrt_ge_0.
-rewrite Rlt_bool_true.
-easy.
-(* .. *)
-rewrite Rabs_pos_eq.
-refine (_ (relative_error_FLT_ex radix2 emin prec (prec_gt_0 prec) (round_mode m) (sqrt (F2R (Float radix2 (Zpos mx) ex))) _)).
-fold fexp.
-intros (eps, (Heps, Hr)).
-rewrite Hr.
-assert (Heps': (Rabs eps < 1)%R).
-apply Rlt_le_trans with (1 := Heps).
-fold (bpow radix2 0).
-apply bpow_le.
-generalize (prec_gt_0 prec).
-clear ; omega.
-apply Rsqr_incrst_0.
-3: apply bpow_ge_0.
-rewrite Rsqr_mult.
-rewrite Rsqr_sqrt.
-2: now apply F2R_ge_0_compat.
-unfold Rsqr.
-apply Rmult_ge_0_gt_0_lt_compat.
-apply Rle_ge.
-apply Rle_0_sqr.
-apply bpow_gt_0.
-now apply bounded_lt_emax.
-apply Rlt_le_trans with 4%R.
-apply Rsqr_incrst_1.
-apply Rplus_lt_compat_l.
-apply (Rabs_lt_inv _ _ Heps').
-rewrite <- (Rplus_opp_r 1).
-apply Rplus_le_compat_l.
-apply Rlt_le.
-apply (Rabs_lt_inv _ _ Heps').
-now apply (Z2R_le 0 2).
-change 4%R with (bpow radix2 2).
-apply bpow_le.
-generalize (prec_gt_0 prec).
-clear -Hmax ; omega.
-apply Rmult_le_pos.
-apply sqrt_ge_0.
-rewrite <- (Rplus_opp_r 1).
-apply Rplus_le_compat_l.
-apply Rlt_le.
-apply (Rabs_lt_inv _ _ Heps').
-rewrite Rabs_pos_eq.
-2: apply sqrt_ge_0.
-apply Rsqr_incr_0.
-2: apply bpow_ge_0.
-2: apply sqrt_ge_0.
-rewrite Rsqr_sqrt.
-2: now apply F2R_ge_0_compat.
-apply Rle_trans with (bpow radix2 emin).
-unfold Rsqr.
-rewrite <- bpow_plus.
-apply bpow_le.
-unfold emin.
-clear -Hmax ; omega.
-apply generic_format_ge_bpow with fexp.
-intros.
-apply Zle_max_r.
-now apply F2R_gt_0_compat.
-apply generic_format_canonic.
-apply (canonic_canonic_mantissa false).
-apply (andb_prop _ _ Hx).
-(* .. *)
-apply round_ge_generic...
-apply generic_format_0.
-apply sqrt_ge_0.
-rewrite Rabs_pos_eq.
-exact Bz.
-apply sqrt_ge_0.
-revert Pz.
-generalize (Zdigits radix2 (Zpos mz)).
-unfold fexp, FLT_exp.
-clear.
-intros ; zify ; subst.
-omega.
-(* . mz < 0 *)
-elim Rlt_not_le  with (1 := proj2 (inbetween_float_bounds _ _ _ _ _ Bz)).
-apply Rle_trans with R0.
-apply F2R_le_0_compat.
-now case mz.
-apply sqrt_ge_0.
-(* *)
-unfold Fsqrt_core, Fsqrt_core_binary.
-rewrite Zdigits2_Zdigits.
-destruct (if Zeven _ then _ else _) as [[|s'|s'] e''] ; try easy.
-now rewrite Z.shiftl_mul_pow2.
-Qed.
-
-Definition Bsqrt sqrt_nan m x :=
-  let f pl := B754_nan (fst pl) (snd pl) in
-  match x with
-  | B754_nan sx plx => f (sqrt_nan x)
-  | B754_infinity false => x
-  | B754_infinity true => f (sqrt_nan x)
-  | B754_finite true _ _ _ => f (sqrt_nan x)
-  | B754_zero _ => x
-  | B754_finite sx mx ex Hx =>
-    FF2B _ (proj1 (Bsqrt_correct_aux m mx ex Hx))
-  end.
-
-Theorem Bsqrt_correct :
-  forall sqrt_nan m x,
-  B2R (Bsqrt sqrt_nan m x) = round radix2 fexp (round_mode m) (sqrt (B2R x)) /\
-  is_finite (Bsqrt sqrt_nan m x) = match x with B754_zero _ => true | B754_finite false _ _ _ => true | _ => false end /\
-  (is_nan (Bsqrt sqrt_nan m x) = false -> Bsign (Bsqrt sqrt_nan m x) = Bsign x).
-Proof.
-intros sqrt_nan m [sx|[|]| |sx mx ex Hx] ; try ( now simpl ; rewrite sqrt_0, round_0 ; intuition auto with typeclass_instances ).
-simpl.
-case Bsqrt_correct_aux.
-intros H1 (H2, (H3, H4)).
-case sx.
-refine (conj _ (conj (refl_equal false) _)).
-apply sym_eq.
-unfold sqrt.
-case Rcase_abs.
-intros _.
-apply round_0.
-auto with typeclass_instances.
-intros H.
-elim Rge_not_lt with (1 := H).
-now apply F2R_lt_0_compat.
-easy.
-split.
-now rewrite B2R_FF2B.
-split.
-now rewrite is_finite_FF2B.
-intro. rewrite Bsign_FF2B. auto.
-Qed.
-
-End Binary.
diff --git a/flocq/Calc/Fcalc_bracket.v b/flocq/Calc/Bracket.v
index 03ef7bd3..83714e87 100644
--- a/flocq/Calc/Fcalc_bracket.v
+++ b/flocq/Calc/Bracket.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2010-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2010-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -19,9 +19,7 @@ COPYING file for more details.
 
 (** * Locations: where a real number is positioned with respect to its rounded-down value in an arbitrary format. *)
 
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_float_prop.
+Require Import Raux Defs Float_prop.
 
 Section Fcalc_bracket.
 
@@ -146,23 +144,17 @@ assert (0 < v < 1)%R.
 split.
 unfold v, Rdiv.
 apply Rmult_lt_0_compat.
-case l.
-now apply (Z2R_lt 0 2).
-now apply (Z2R_lt 0 1).
-now apply (Z2R_lt 0 3).
+case l ; now apply IZR_lt.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 4).
+now apply IZR_lt.
 unfold v, Rdiv.
 apply Rmult_lt_reg_r with 4%R.
-now apply (Z2R_lt 0 4).
+now apply IZR_lt.
 rewrite Rmult_assoc, Rinv_l.
 rewrite Rmult_1_r, Rmult_1_l.
-case l.
-now apply (Z2R_lt 2 4).
-now apply (Z2R_lt 1 4).
-now apply (Z2R_lt 3 4).
+case l ; now apply IZR_lt.
 apply Rgt_not_eq.
-now apply (Z2R_lt 0 4).
+now apply IZR_lt.
 split.
 apply Rplus_lt_reg_r with (d * (v - 1))%R.
 ring_simplify.
@@ -179,7 +171,7 @@ exact Hdu.
 set (v := (match l with Lt => 1 | Eq => 2 | Gt => 3 end)%R).
 rewrite <- (Rcompare_plus_r (- (d + u) / 2)).
 rewrite <- (Rcompare_mult_r 4).
-2: now apply (Z2R_lt 0 4).
+2: now apply IZR_lt.
 replace (((d + u) / 2 + - (d + u) / 2) * 4)%R with ((u - d) * 0)%R by field.
 replace ((d + v / 4 * (u - d) + - (d + u) / 2) * 4)%R with ((u - d) * (v - 2))%R by field.
 rewrite Rcompare_mult_l.
@@ -187,10 +179,7 @@ rewrite Rcompare_mult_l.
 rewrite <- (Rcompare_plus_r 2).
 ring_simplify (v - 2 + 2)%R (0 + 2)%R.
 unfold v.
-case l.
-exact (Rcompare_Z2R 2 2).
-exact (Rcompare_Z2R 1 2).
-exact (Rcompare_Z2R 3 2).
+case l ; apply Rcompare_IZR.
 Qed.
 
 Section Fcalc_bracket_step.
@@ -201,19 +190,19 @@ Variable Hstep : (0 < step)%R.
 
 Lemma ordered_steps :
   forall k,
-  (start + Z2R k * step < start + Z2R (k + 1) * step)%R.
+  (start + IZR k * step < start + IZR (k + 1) * step)%R.
 Proof.
 intros k.
 apply Rplus_lt_compat_l.
 apply Rmult_lt_compat_r.
 exact Hstep.
-apply Z2R_lt.
+apply IZR_lt.
 apply Zlt_succ.
 Qed.
 
 Lemma middle_range :
   forall k,
-  ((start + (start + Z2R k * step)) / 2 = start + (Z2R k / 2 * step))%R.
+  ((start + (start + IZR k * step)) / 2 = start + (IZR k / 2 * step))%R.
 Proof.
 intros k.
 field.
@@ -223,10 +212,10 @@ Hypothesis (Hnb_steps : (1 < nb_steps)%Z).
 
 Lemma inbetween_step_not_Eq :
   forall x k l l',
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x l ->
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l ->
   (0 < k < nb_steps)%Z ->
-  Rcompare x (start + (Z2R nb_steps / 2 * step))%R = l' ->
-  inbetween start (start + Z2R nb_steps * step) x (loc_Inexact l').
+  Rcompare x (start + (IZR nb_steps / 2 * step))%R = l' ->
+  inbetween start (start + IZR nb_steps * step) x (loc_Inexact l').
 Proof.
 intros x k l l' Hx Hk Hl'.
 constructor.
@@ -237,13 +226,13 @@ apply Rlt_le_trans with (2 := proj1 Hx').
 rewrite <- (Rplus_0_r start) at 1.
 apply Rplus_lt_compat_l.
 apply Rmult_lt_0_compat.
-now apply (Z2R_lt 0).
+now apply IZR_lt.
 exact Hstep.
 apply Rlt_le_trans with (1 := proj2 Hx').
 apply Rplus_le_compat_l.
 apply Rmult_le_compat_r.
 now apply Rlt_le.
-apply Z2R_le.
+apply IZR_le.
 omega.
 (* . *)
 now rewrite middle_range.
@@ -251,9 +240,9 @@ Qed.
 
 Theorem inbetween_step_Lo :
   forall x k l,
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x l ->
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l ->
   (0 < k)%Z -> (2 * k + 1 < nb_steps)%Z ->
-  inbetween start (start + Z2R nb_steps * step) x (loc_Inexact Lt).
+  inbetween start (start + IZR nb_steps * step) x (loc_Inexact Lt).
 Proof.
 intros x k l Hx Hk1 Hk2.
 apply inbetween_step_not_Eq with (1 := Hx).
@@ -264,18 +253,17 @@ apply Rlt_le_trans with (1 := proj2 Hx').
 apply Rcompare_not_Lt_inv.
 rewrite Rcompare_plus_l, Rcompare_mult_r, Rcompare_half_l.
 apply Rcompare_not_Lt.
-change 2%R with (Z2R 2).
-rewrite <- Z2R_mult.
-apply Z2R_le.
+rewrite <- mult_IZR.
+apply IZR_le.
 omega.
 exact Hstep.
 Qed.
 
 Theorem inbetween_step_Hi :
   forall x k l,
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x l ->
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l ->
   (nb_steps < 2 * k)%Z -> (k < nb_steps)%Z ->
-  inbetween start (start + Z2R nb_steps * step) x (loc_Inexact Gt).
+  inbetween start (start + IZR nb_steps * step) x (loc_Inexact Gt).
 Proof.
 intros x k l Hx Hk1 Hk2.
 apply inbetween_step_not_Eq with (1 := Hx).
@@ -286,9 +274,8 @@ apply Rlt_le_trans with (2 := proj1 Hx').
 apply Rcompare_Lt_inv.
 rewrite Rcompare_plus_l, Rcompare_mult_r, Rcompare_half_l.
 apply Rcompare_Lt.
-change 2%R with (Z2R 2).
-rewrite <- Z2R_mult.
-apply Z2R_lt.
+rewrite <- mult_IZR.
+apply IZR_lt.
 omega.
 exact Hstep.
 Qed.
@@ -297,7 +284,7 @@ Theorem inbetween_step_Lo_not_Eq :
   forall x l,
   inbetween start (start + step) x l ->
   l <> loc_Exact ->
-  inbetween start (start + Z2R nb_steps * step) x (loc_Inexact Lt).
+  inbetween start (start + IZR nb_steps * step) x (loc_Inexact Lt).
 Proof.
 intros x l Hx Hl.
 assert (Hx' := inbetween_bounds_not_Eq _ _ _ _ Hx Hl).
@@ -310,7 +297,7 @@ apply Rplus_lt_compat_l.
 rewrite <- (Rmult_1_l step) at 1.
 apply Rmult_lt_compat_r.
 exact Hstep.
-now apply (Z2R_lt 1).
+now apply IZR_lt.
 (* . *)
 apply Rcompare_Lt.
 apply Rlt_le_trans with (1 := proj2 Hx').
@@ -320,7 +307,7 @@ rewrite <- (Rmult_1_l step) at 2.
 rewrite Rcompare_plus_l, Rcompare_mult_r, Rcompare_half_l.
 rewrite Rmult_1_r.
 apply Rcompare_not_Lt.
-apply (Z2R_le 2).
+apply IZR_le.
 now apply (Zlt_le_succ 1).
 exact Hstep.
 Qed.
@@ -328,19 +315,19 @@ Qed.
 Lemma middle_odd :
   forall k,
   (2 * k + 1 = nb_steps)%Z ->
-  (((start + Z2R k * step) + (start + Z2R (k + 1) * step))/2 = start + Z2R nb_steps /2 * step)%R.
+  (((start + IZR k * step) + (start + IZR (k + 1) * step))/2 = start + IZR nb_steps /2 * step)%R.
 Proof.
 intros k Hk.
 rewrite <- Hk.
-rewrite 2!Z2R_plus, Z2R_mult.
+rewrite 2!plus_IZR, mult_IZR.
 simpl. field.
 Qed.
 
 Theorem inbetween_step_any_Mi_odd :
   forall x k l,
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x (loc_Inexact l) ->
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x (loc_Inexact l) ->
   (2 * k + 1 = nb_steps)%Z ->
-  inbetween start (start + Z2R nb_steps * step) x (loc_Inexact l).
+  inbetween start (start + IZR nb_steps * step) x (loc_Inexact l).
 Proof.
 intros x k l Hx Hk.
 apply inbetween_step_not_Eq with (1 := Hx).
@@ -351,9 +338,9 @@ Qed.
 
 Theorem inbetween_step_Lo_Mi_Eq_odd :
   forall x k,
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x loc_Exact ->
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x loc_Exact ->
   (2 * k + 1 = nb_steps)%Z ->
-  inbetween start (start + Z2R nb_steps * step) x (loc_Inexact Lt).
+  inbetween start (start + IZR nb_steps * step) x (loc_Inexact Lt).
 Proof.
 intros x k Hx Hk.
 apply inbetween_step_not_Eq with (1 := Hx).
@@ -362,9 +349,8 @@ inversion_clear Hx as [Hl|].
 rewrite Hl.
 rewrite Rcompare_plus_l, Rcompare_mult_r, Rcompare_half_r.
 apply Rcompare_Lt.
-change 2%R with (Z2R 2).
-rewrite <- Z2R_mult.
-apply Z2R_lt.
+rewrite <- mult_IZR.
+apply IZR_lt.
 rewrite <- Hk.
 apply Zlt_succ.
 exact Hstep.
@@ -372,10 +358,10 @@ Qed.
 
 Theorem inbetween_step_Hi_Mi_even :
   forall x k l,
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x l ->
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l ->
   l <> loc_Exact ->
   (2 * k = nb_steps)%Z ->
-  inbetween start (start + Z2R nb_steps * step) x (loc_Inexact Gt).
+  inbetween start (start + IZR nb_steps * step) x (loc_Inexact Gt).
 Proof.
 intros x k l Hx Hl Hk.
 apply inbetween_step_not_Eq with (1 := Hx).
@@ -385,28 +371,26 @@ assert (Hx' := inbetween_bounds_not_Eq _ _ _ _ Hx Hl).
 apply Rle_lt_trans with (2 := proj1 Hx').
 apply Rcompare_not_Lt_inv.
 rewrite Rcompare_plus_l, Rcompare_mult_r, Rcompare_half_r.
-change 2%R with (Z2R 2).
-rewrite <- Z2R_mult.
+rewrite <- mult_IZR.
 apply Rcompare_not_Lt.
-apply Z2R_le.
+apply IZR_le.
 rewrite Hk.
-apply Zle_refl.
+apply Z.le_refl.
 exact Hstep.
 Qed.
 
 Theorem inbetween_step_Mi_Mi_even :
   forall x k,
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x loc_Exact ->
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x loc_Exact ->
   (2 * k = nb_steps)%Z ->
-  inbetween start (start + Z2R nb_steps * step) x (loc_Inexact Eq).
+  inbetween start (start + IZR nb_steps * step) x (loc_Inexact Eq).
 Proof.
 intros x k Hx Hk.
 apply inbetween_step_not_Eq with (1 := Hx).
 omega.
 apply Rcompare_Eq.
 inversion_clear Hx as [Hx'|].
-rewrite Hx', <- Hk, Z2R_mult.
-simpl (Z2R 2).
+rewrite Hx', <- Hk, mult_IZR.
 field.
 Qed.
 
@@ -419,17 +403,17 @@ Definition new_location_even k l :=
     match l with loc_Exact => l | _ => loc_Inexact Lt end
   else
     loc_Inexact
-    match Zcompare (2 * k) nb_steps with
+    match Z.compare (2 * k) nb_steps with
     | Lt => Lt
     | Eq => match l with loc_Exact => Eq | _ => Gt end
     | Gt => Gt
     end.
 
 Theorem new_location_even_correct :
-  Zeven nb_steps = true ->
+  Z.even nb_steps = true ->
   forall x k l, (0 <= k < nb_steps)%Z ->
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x l ->
-  inbetween start (start + Z2R nb_steps * step) x (new_location_even k l).
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l ->
+  inbetween start (start + IZR nb_steps * step) x (new_location_even k l).
 Proof.
 intros He x k l Hk Hx.
 unfold new_location_even.
@@ -476,17 +460,17 @@ Definition new_location_odd k l :=
     match l with loc_Exact => l | _ => loc_Inexact Lt end
   else
     loc_Inexact
-    match Zcompare (2 * k + 1) nb_steps with
+    match Z.compare (2 * k + 1) nb_steps with
     | Lt => Lt
     | Eq => match l with loc_Inexact l => l | loc_Exact => Lt end
     | Gt => Gt
     end.
 
 Theorem new_location_odd_correct :
-  Zeven nb_steps = false ->
+  Z.even nb_steps = false ->
   forall x k l, (0 <= k < nb_steps)%Z ->
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x l ->
-  inbetween start (start + Z2R nb_steps * step) x (new_location_odd k l).
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l ->
+  inbetween start (start + IZR nb_steps * step) x (new_location_odd k l).
 Proof.
 intros Ho x k l Hk Hx.
 unfold new_location_odd.
@@ -520,16 +504,16 @@ apply Hk.
 Qed.
 
 Definition new_location :=
-  if Zeven nb_steps then new_location_even else new_location_odd.
+  if Z.even nb_steps then new_location_even else new_location_odd.
 
 Theorem new_location_correct :
   forall x k l, (0 <= k < nb_steps)%Z ->
-  inbetween (start + Z2R k * step) (start + Z2R (k + 1) * step) x l ->
-  inbetween start (start + Z2R nb_steps * step) x (new_location k l).
+  inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l ->
+  inbetween start (start + IZR nb_steps * step) x (new_location k l).
 Proof.
 intros x k l Hk Hx.
 unfold new_location.
-generalize (refl_equal nb_steps) (Zle_lt_trans _ _ _ (proj1 Hk) (proj2 Hk)).
+generalize (refl_equal nb_steps) (Z.le_lt_trans _ _ _ (proj1 Hk) (proj2 Hk)).
 pattern nb_steps at 2 3 5 ; case nb_steps.
 now intros _.
 (* . *)
@@ -603,7 +587,7 @@ intros x m e l [Hx|l' Hx Hl].
 rewrite Hx.
 split.
 apply Rle_refl.
-apply F2R_lt_compat.
+apply F2R_lt.
 apply Zlt_succ.
 split.
 now apply Rlt_le.
@@ -613,13 +597,13 @@ Qed.
 (** Specialization of inbetween for two consecutive integers. *)
 
 Definition inbetween_int m x l :=
-  inbetween (Z2R m) (Z2R (m + 1)) x l.
+  inbetween (IZR m) (IZR (m + 1)) x l.
 
 Theorem inbetween_float_new_location :
   forall x m e l k,
   (0 < k)%Z ->
   inbetween_float m e x l ->
-  inbetween_float (Zdiv m (Zpower beta k)) (e + k) x (new_location (Zpower beta k) (Zmod m (Zpower beta k)) l).
+  inbetween_float (Z.div m (Zpower beta k)) (e + k) x (new_location (Zpower beta k) (Zmod m (Zpower beta k)) l).
 Proof.
 intros x m e l k Hk Hx.
 unfold inbetween_float in *.
@@ -630,19 +614,19 @@ apply (f_equal (fun r => F2R (Float beta (m * Zpower _ r) e))).
 ring.
 omega.
 assert (Hp: (Zpower beta k > 0)%Z).
-apply Zlt_gt.
+apply Z.lt_gt.
 apply Zpower_gt_0.
 now apply Zlt_le_weak.
 (* . *)
 rewrite 2!Hr.
 rewrite Zmult_plus_distr_l, Zmult_1_l.
 unfold F2R at 2. simpl.
-rewrite Z2R_plus, Rmult_plus_distr_r.
+rewrite plus_IZR, Rmult_plus_distr_r.
 apply new_location_correct.
 apply bpow_gt_0.
 now apply Zpower_gt_1.
 now apply Z_mod_lt.
-rewrite <- 2!Rmult_plus_distr_r, <- 2!Z2R_plus.
+rewrite <- 2!Rmult_plus_distr_r, <- 2!plus_IZR.
 rewrite Zmult_comm, Zplus_assoc.
 now rewrite <- Z_div_mod_eq.
 Qed.
@@ -650,7 +634,7 @@ Qed.
 Theorem inbetween_float_new_location_single :
   forall x m e l,
   inbetween_float m e x l ->
-  inbetween_float (Zdiv m beta) (e + 1) x (new_location beta (Zmod m beta) l).
+  inbetween_float (Z.div m beta) (e + 1) x (new_location beta (Zmod m beta) l).
 Proof.
 intros x m e l Hx.
 replace (radix_val beta) with (Zpower beta 1).
@@ -665,7 +649,7 @@ Theorem inbetween_float_ex :
 Proof.
 intros m e l.
 apply inbetween_ex.
-apply F2R_lt_compat.
+apply F2R_lt.
 apply Zlt_succ.
 Qed.
 
@@ -682,7 +666,7 @@ apply inbetween_unique with (1 := H) (2 := H').
 destruct (inbetween_float_bounds x m e l H) as (H1,H2).
 destruct (inbetween_float_bounds x m' e l' H') as (H3,H4).
 cut (m < m' + 1 /\ m' < m + 1)%Z. clear ; omega.
-now split ; apply F2R_lt_reg with beta e ; apply Rle_lt_trans with x.
+now split ; apply lt_F2R with beta e ; apply Rle_lt_trans with x.
 Qed.
 
 End Fcalc_bracket_generic.
diff --git a/flocq/Calc/Div.v b/flocq/Calc/Div.v
new file mode 100644
index 00000000..65195562
--- /dev/null
+++ b/flocq/Calc/Div.v
@@ -0,0 +1,159 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2018 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2018 Guillaume Melquiond
+
+This library is free software; you can redistribute it and/or
+modify it 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.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+COPYING file for more details.
+*)
+
+(** * Helper function and theorem for computing the rounded quotient of two floating-point numbers. *)
+
+Require Import Raux Defs Generic_fmt Float_prop Digits Bracket.
+
+Set Implicit Arguments.
+Set Strongly Strict Implicit.
+
+Section Fcalc_div.
+
+Variable beta : radix.
+Notation bpow e := (bpow beta e).
+
+Variable fexp : Z -> Z.
+
+(** Computes a mantissa of precision p, the corresponding exponent,
+    and the position with respect to the real quotient of the
+    input floating-point numbers.
+
+The algorithm performs the following steps:
+- Shift dividend mantissa so that it has at least p2 + p digits.
+- Perform the Euclidean division.
+- Compute the position according to the division remainder.
+
+Complexity is fine as long as p1 <= 2p and p2 <= p.
+*)
+
+Lemma mag_div_F2R :
+  forall m1 e1 m2 e2,
+  (0 < m1)%Z -> (0 < m2)%Z ->
+  let e := ((Zdigits beta m1 + e1) - (Zdigits beta m2 + e2))%Z in
+  (e <= mag beta (F2R (Float beta m1 e1) / F2R (Float beta m2 e2)) <= e + 1)%Z.
+Proof.
+intros m1 e1 m2 e2 Hm1 Hm2.
+rewrite <- (mag_F2R_Zdigits beta m1 e1) by now apply Zgt_not_eq.
+rewrite <- (mag_F2R_Zdigits beta m2 e2) by now apply Zgt_not_eq.
+apply mag_div.
+now apply F2R_neq_0, Zgt_not_eq.
+now apply F2R_neq_0, Zgt_not_eq.
+Qed.
+
+Definition Fdiv_core m1 e1 m2 e2 e :=
+  let (m1', m2') :=
+    if Zle_bool e (e1 - e2)%Z
+    then (m1 * Zpower beta (e1 - e2 - e), m2)%Z
+    else (m1, m2 * Zpower beta (e - (e1 - e2)))%Z in
+  let '(q, r) :=  Z.div_eucl m1' m2' in
+  (q, new_location m2' r loc_Exact).
+
+Theorem Fdiv_core_correct :
+  forall m1 e1 m2 e2 e,
+  (0 < m1)%Z -> (0 < m2)%Z ->
+  let '(m, l) := Fdiv_core m1 e1 m2 e2 e in
+  inbetween_float beta m e (F2R (Float beta m1 e1) / F2R (Float beta m2 e2)) l.
+Proof.
+intros m1 e1 m2 e2 e Hm1 Hm2.
+unfold Fdiv_core.
+match goal with |- context [if ?b then ?b1 else ?b2] => set (m12 := if b then b1 else b2) end.
+case_eq m12 ; intros m1' m2' Hm.
+assert ((F2R (Float beta m1 e1) / F2R (Float beta m2 e2) = IZR m1' / IZR m2' * bpow e)%R /\ (0 < m2')%Z) as [Hf Hm2'].
+{ unfold F2R, Zminus ; simpl.
+  destruct (Zle_bool e (e1 - e2)) eqn:He' ; injection Hm ; intros ; subst.
+  - split ; try easy.
+    apply Zle_bool_imp_le in He'.
+    rewrite mult_IZR, IZR_Zpower by omega.
+    unfold Zminus ; rewrite 2!bpow_plus, 2!bpow_opp.
+    field.
+    repeat split ; try apply Rgt_not_eq, bpow_gt_0.
+    now apply IZR_neq, Zgt_not_eq.
+  - apply Z.leb_gt in He'.
+    split ; cycle 1.
+    { apply Z.mul_pos_pos with (1 := Hm2).
+      apply Zpower_gt_0 ; omega. }
+    rewrite mult_IZR, IZR_Zpower by omega.
+    unfold Zminus ; rewrite bpow_plus, bpow_opp, bpow_plus, bpow_opp.
+    field.
+    repeat split ; try apply Rgt_not_eq, bpow_gt_0.
+    now apply IZR_neq, Zgt_not_eq. }
+clearbody m12 ; clear Hm Hm1 Hm2.
+generalize (Z_div_mod m1' m2' (Z.lt_gt _ _ Hm2')).
+destruct (Z.div_eucl m1' m2') as (q, r).
+intros (Hq, Hr).
+rewrite Hf.
+unfold inbetween_float, F2R. simpl.
+rewrite Hq, 2!plus_IZR, mult_IZR.
+apply inbetween_mult_compat.
+  apply bpow_gt_0.
+destruct (Z_lt_le_dec 1 m2') as [Hm2''|Hm2''].
+- replace 1%R with (IZR m2' * /IZR m2')%R.
+  apply new_location_correct ; try easy.
+  apply Rinv_0_lt_compat.
+  now apply IZR_lt.
+  constructor.
+  field.
+  now apply IZR_neq, Zgt_not_eq.
+  field.
+  now apply IZR_neq, Zgt_not_eq.
+- assert (r = 0 /\ m2' = 1)%Z as [-> ->] by (clear -Hr Hm2'' ; omega).
+  unfold Rdiv.
+  rewrite Rmult_1_l, Rplus_0_r, Rinv_1, Rmult_1_r.
+  now constructor.
+Qed.
+
+Definition Fdiv (x y : float beta) :=
+  let (m1, e1) := x in
+  let (m2, e2) := y in
+  let e' := ((Zdigits beta m1 + e1) - (Zdigits beta m2 + e2))%Z in
+  let e := Z.min (Z.min (fexp e') (fexp (e' + 1))) (e1 - e2) in
+  let '(m, l) := Fdiv_core m1 e1 m2 e2 e in
+  (m, e, l).
+
+Theorem Fdiv_correct :
+  forall x y,
+  (0 < F2R x)%R -> (0 < F2R y)%R ->
+  let '(m, e, l) := Fdiv x y in
+  (e <= cexp beta fexp (F2R x / F2R y))%Z /\
+  inbetween_float beta m e (F2R x / F2R y) l.
+Proof.
+intros [m1 e1] [m2 e2] Hm1 Hm2.
+apply gt_0_F2R in Hm1.
+apply gt_0_F2R in Hm2.
+unfold Fdiv.
+generalize (mag_div_F2R m1 e1 m2 e2 Hm1 Hm2).
+set (e := Zminus _ _).
+set (e' := Z.min (Z.min (fexp e) (fexp (e + 1))) (e1 - e2)).
+intros [H1 H2].
+generalize (Fdiv_core_correct m1 e1 m2 e2 e' Hm1 Hm2).
+destruct Fdiv_core as [m' l].
+apply conj.
+apply Z.le_trans with (1 := Z.le_min_l _ _).
+unfold cexp.
+destruct (Zle_lt_or_eq _ _ H1) as [H|H].
+- replace (fexp (mag _ _)) with (fexp (e + 1)).
+  apply Z.le_min_r.
+  clear -H1 H2 H ; apply f_equal ; omega.
+- replace (fexp (mag _ _)) with (fexp e).
+  apply Z.le_min_l.
+  clear -H1 H2 H ; apply f_equal ; omega.
+Qed.
+
+End Fcalc_div.
diff --git a/flocq/Calc/Fcalc_digits.v b/flocq/Calc/Fcalc_digits.v
deleted file mode 100644
index 45133e81..00000000
--- a/flocq/Calc/Fcalc_digits.v
+++ /dev/null
@@ -1,63 +0,0 @@
-(**
-This file is part of the Flocq formalization of floating-point
-arithmetic in Coq: http://flocq.gforge.inria.fr/
-
-Copyright (C) 2010-2013 Sylvie Boldo
-#<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
-
-This library is free software; you can redistribute it and/or
-modify it 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.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-COPYING file for more details.
-*)
-
-(** * Functions for computing the number of digits of integers and related theorems. *)
-
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_float_prop.
-Require Import Fcore_digits.
-
-Section Fcalc_digits.
-
-Variable beta : radix.
-Notation bpow e := (bpow beta e).
-
-Theorem Zdigits_ln_beta :
-  forall n,
-  n <> Z0 ->
-  Zdigits beta n = ln_beta beta (Z2R n).
-Proof.
-intros n Hn.
-destruct (ln_beta beta (Z2R n)) as (e, He) ; simpl.
-specialize (He (Z2R_neq _ _ Hn)).
-rewrite <- Z2R_abs in He.
-assert (Hd := Zdigits_correct beta n).
-assert (Hd' := Zdigits_gt_0 beta n).
-apply Zle_antisym ; apply (bpow_lt_bpow beta).
-apply Rle_lt_trans with (2 := proj2 He).
-rewrite <- Z2R_Zpower by omega.
-now apply Z2R_le.
-apply Rle_lt_trans with (1 := proj1 He).
-rewrite <- Z2R_Zpower by omega.
-now apply Z2R_lt.
-Qed.
-
-Theorem ln_beta_F2R_Zdigits :
-  forall m e, m <> Z0 ->
-  (ln_beta beta (F2R (Float beta m e)) = Zdigits beta m + e :> Z)%Z.
-Proof.
-intros m e Hm.
-rewrite ln_beta_F2R with (1 := Hm).
-apply (f_equal (fun v => Zplus v e)).
-apply sym_eq.
-now apply Zdigits_ln_beta.
-Qed.
-
-End Fcalc_digits.
diff --git a/flocq/Calc/Fcalc_div.v b/flocq/Calc/Fcalc_div.v
deleted file mode 100644
index c8f1f9fc..00000000
--- a/flocq/Calc/Fcalc_div.v
+++ /dev/null
@@ -1,165 +0,0 @@
-(**
-This file is part of the Flocq formalization of floating-point
-arithmetic in Coq: http://flocq.gforge.inria.fr/
-
-Copyright (C) 2010-2013 Sylvie Boldo
-#<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
-
-This library is free software; you can redistribute it and/or
-modify it 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.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-COPYING file for more details.
-*)
-
-(** * Helper function and theorem for computing the rounded quotient of two floating-point numbers. *)
-
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_float_prop.
-Require Import Fcore_digits.
-Require Import Fcalc_bracket.
-Require Import Fcalc_digits.
-
-Section Fcalc_div.
-
-Variable beta : radix.
-Notation bpow e := (bpow beta e).
-
-(** Computes a mantissa of precision p, the corresponding exponent,
-    and the position with respect to the real quotient of the
-    input floating-point numbers.
-
-The algorithm performs the following steps:
-- Shift dividend mantissa so that it has at least p2 + p digits.
-- Perform the Euclidean division.
-- Compute the position according to the division remainder.
-
-Complexity is fine as long as p1 <= 2p and p2 <= p.
-*)
-
-Definition Fdiv_core prec m1 e1 m2 e2 :=
-  let d1 := Zdigits beta m1 in
-  let d2 := Zdigits beta m2 in
-  let e := (e1 - e2)%Z in
-  let (m, e') :=
-    match (d2 + prec - d1)%Z with
-    | Zpos p => (m1 * Zpower_pos beta p, e + Zneg p)%Z
-    | _ => (m1, e)
-    end in
-  let '(q, r) :=  Zdiv_eucl m m2 in
-  (q, e', new_location m2 r loc_Exact).
-
-Theorem Fdiv_core_correct :
-  forall prec m1 e1 m2 e2,
-  (0 < prec)%Z ->
-  (0 < m1)%Z -> (0 < m2)%Z ->
-  let '(m, e, l) := Fdiv_core prec m1 e1 m2 e2 in
-  (prec <= Zdigits beta m)%Z /\
-  inbetween_float beta m e (F2R (Float beta m1 e1) / F2R (Float beta m2 e2)) l.
-Proof.
-intros prec m1 e1 m2 e2 Hprec Hm1 Hm2.
-unfold Fdiv_core.
-set (d1 := Zdigits beta m1).
-set (d2 := Zdigits beta m2).
-case_eq
- (match (d2 + prec - d1)%Z with
-  | Zpos p => ((m1 * Zpower_pos beta p)%Z, (e1 - e2 + Zneg p)%Z)
-  | _ => (m1, (e1 - e2)%Z)
-  end).
-intros m' e' Hme.
-(* . the shifted mantissa m' has enough digits *)
-assert (Hs: F2R (Float beta m' (e' + e2)) = F2R (Float beta m1 e1) /\ (0 < m')%Z /\ (d2 + prec <= Zdigits beta m')%Z).
-replace (d2 + prec)%Z with (d2 + prec - d1 + d1)%Z by ring.
-destruct (d2 + prec - d1)%Z as [|p|p] ;
-  unfold d1 ;
-  inversion Hme.
-ring_simplify (e1 - e2 + e2)%Z.
-repeat split.
-now rewrite <- H0.
-apply Zle_refl.
-replace (e1 - e2 + Zneg p + e2)%Z with (e1 - Zpos p)%Z by (unfold Zminus ; simpl ; ring).
-fold (Zpower beta (Zpos p)).
-split.
-pattern (Zpos p) at 1 ; replace (Zpos p) with (e1 - (e1 - Zpos p))%Z by ring.
-apply sym_eq.
-apply F2R_change_exp.
-assert (0 < Zpos p)%Z by easy.
-omega.
-split.
-apply Zmult_lt_0_compat.
-exact Hm1.
-now apply Zpower_gt_0.
-rewrite Zdigits_mult_Zpower.
-rewrite Zplus_comm.
-apply Zle_refl.
-apply sym_not_eq.
-now apply Zlt_not_eq.
-easy.
-split.
-now ring_simplify (e1 - e2 + e2)%Z.
-assert (Zneg p < 0)%Z by easy.
-omega.
-(* . *)
-destruct Hs as (Hs1, (Hs2, Hs3)).
-rewrite <- Hs1.
-generalize (Z_div_mod m' m2 (Zlt_gt _ _ Hm2)).
-destruct (Zdiv_eucl m' m2) as (q, r).
-intros (Hq, Hr).
-split.
-(* . the result mantissa q has enough digits *)
-cut (Zdigits beta m' <= d2 + Zdigits beta q)%Z. omega.
-unfold d2.
-rewrite Hq.
-assert (Hq': (0 < q)%Z).
-apply Zmult_lt_reg_r with (1 := Hm2).
-assert (m2 < m')%Z.
-apply lt_Zdigits with beta.
-now apply Zlt_le_weak.
-unfold d2 in Hs3.
-clear -Hprec Hs3 ; omega.
-cut (q * m2 = m' - r)%Z. clear -Hr H ; omega.
-rewrite Hq.
-ring.
-apply Zle_trans with (Zdigits beta (m2 + q + m2 * q)).
-apply Zdigits_le.
-rewrite <- Hq.
-now apply Zlt_le_weak.
-clear -Hr Hq'. omega.
-apply Zdigits_mult_strong ; apply Zlt_le_weak.
-now apply Zle_lt_trans with r.
-exact Hq'.
-(* . the location is correctly computed *)
-unfold inbetween_float, F2R. simpl.
-rewrite bpow_plus, Z2R_plus.
-rewrite Hq, Z2R_plus, Z2R_mult.
-replace ((Z2R m2 * Z2R q + Z2R r) * (bpow e' * bpow e2) / (Z2R m2 * bpow e2))%R
-  with ((Z2R q + Z2R r / Z2R m2) * bpow e')%R.
-apply inbetween_mult_compat.
-apply bpow_gt_0.
-destruct (Z_lt_le_dec 1 m2) as [Hm2''|Hm2''].
-replace (Z2R 1) with (Z2R m2 * /Z2R m2)%R.
-apply new_location_correct ; try easy.
-apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0).
-now constructor.
-apply Rinv_r.
-apply Rgt_not_eq.
-now apply (Z2R_lt 0).
-assert (r = 0 /\ m2 = 1)%Z by (clear -Hr Hm2'' ; omega).
-rewrite (proj1 H), (proj2 H).
-unfold Rdiv.
-rewrite Rmult_0_l, Rplus_0_r.
-now constructor.
-field.
-split ; apply Rgt_not_eq.
-apply bpow_gt_0.
-now apply (Z2R_lt 0).
-Qed.
-
-End Fcalc_div.
diff --git a/flocq/Calc/Fcalc_sqrt.v b/flocq/Calc/Fcalc_sqrt.v
deleted file mode 100644
index 5f541d83..00000000
--- a/flocq/Calc/Fcalc_sqrt.v
+++ /dev/null
@@ -1,244 +0,0 @@
-(**
-This file is part of the Flocq formalization of floating-point
-arithmetic in Coq: http://flocq.gforge.inria.fr/
-
-Copyright (C) 2010-2013 Sylvie Boldo
-#<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
-
-This library is free software; you can redistribute it and/or
-modify it 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.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-COPYING file for more details.
-*)
-
-(** * Helper functions and theorems for computing the rounded square root of a floating-point number. *)
-
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_digits.
-Require Import Fcore_float_prop.
-Require Import Fcalc_bracket.
-Require Import Fcalc_digits.
-
-Section Fcalc_sqrt.
-
-Variable beta : radix.
-Notation bpow e := (bpow beta e).
-
-(** Computes a mantissa of precision p, the corresponding exponent,
-    and the position with respect to the real square root of the
-    input floating-point number.
-
-The algorithm performs the following steps:
-- Shift the mantissa so that it has at least 2p-1 digits;
-  shift it one digit more if the new exponent is not even.
-- Compute the square root s (at least p digits) of the new
-  mantissa, and its remainder r.
-- Compute the position according to the remainder:
-  -- r == 0  =>  Eq,
-  -- r <= s  =>  Lo,
-  -- r >= s  =>  Up.
-
-Complexity is fine as long as p1 <= 2p-1.
-*)
-
-Definition Fsqrt_core prec m e :=
-  let d := Zdigits beta m in
-  let s := Zmax (2 * prec - d) 0 in
-  let e' := (e - s)%Z in
-  let (s', e'') := if Zeven e' then (s, e') else (s + 1, e' - 1)%Z in
-  let m' :=
-    match s' with
-    | Zpos p => (m * Zpower_pos beta p)%Z
-    | _ => m
-    end in
-  let (q, r) := Z.sqrtrem m' in
-  let l :=
-    if Zeq_bool r 0 then loc_Exact
-    else loc_Inexact (if Zle_bool r q then Lt else Gt) in
-  (q, Zdiv2 e'', l).
-
-Theorem Fsqrt_core_correct :
-  forall prec m e,
-  (0 < m)%Z ->
-  let '(m', e', l) := Fsqrt_core prec m e in
-  (prec <= Zdigits beta m')%Z /\
-  inbetween_float beta m' e' (sqrt (F2R (Float beta m e))) l.
-Proof.
-intros prec m e Hm.
-unfold Fsqrt_core.
-set (d := Zdigits beta m).
-set (s := Zmax (2 * prec - d) 0).
-(* . exponent *)
-case_eq (if Zeven (e - s) then (s, (e - s)%Z) else ((s + 1)%Z, (e - s - 1)%Z)).
-intros s' e' Hse.
-assert (He: (Zeven e' = true /\ 0 <= s' /\ 2 * prec - d <= s' /\ s' + e' = e)%Z).
-revert Hse.
-case_eq (Zeven (e - s)) ; intros He Hse ; inversion Hse.
-repeat split.
-exact He.
-unfold s.
-apply Zle_max_r.
-apply Zle_max_l.
-ring.
-assert (H: (Zmax (2 * prec - d) 0 <= s + 1)%Z).
-fold s.
-apply Zle_succ.
-repeat split.
-unfold Zminus at 1.
-now rewrite Zeven_plus, He.
-apply Zle_trans with (2 := H).
-apply Zle_max_r.
-apply Zle_trans with (2 := H).
-apply Zle_max_l.
-ring.
-clear -Hm He.
-destruct He as (He1, (He2, (He3, He4))).
-(* . shift *)
-set (m' := match s' with
-  | Z0 => m
-  | Zpos p => (m * Zpower_pos beta p)%Z
-  | Zneg _ => m
-  end).
-assert (Hs: F2R (Float beta m' e') = F2R (Float beta m e) /\ (2 * prec <= Zdigits beta m')%Z /\ (0 < m')%Z).
-rewrite <- He4.
-unfold m'.
-destruct s' as [|p|p].
-repeat split ; try easy.
-fold d.
-omega.
-fold (Zpower beta (Zpos p)).
-split.
-replace (Zpos p) with (Zpos p + e' - e')%Z by ring.
-rewrite <- F2R_change_exp.
-apply (f_equal (fun v => F2R (Float beta m v))).
-ring.
-assert (0 < Zpos p)%Z by easy.
-omega.
-split.
-rewrite Zdigits_mult_Zpower.
-fold d.
-omega.
-apply sym_not_eq.
-now apply Zlt_not_eq.
-easy.
-apply Zmult_lt_0_compat.
-exact Hm.
-now apply Zpower_gt_0.
-now elim He2.
-clearbody m'.
-destruct Hs as (Hs1, (Hs2, Hs3)).
-generalize (Z.sqrtrem_spec m' (Zlt_le_weak _ _ Hs3)).
-destruct (Z.sqrtrem m') as (q, r).
-intros (Hq, Hr).
-rewrite <- Hs1. clear Hs1.
-split.
-(* . mantissa width *)
-apply Zmult_le_reg_r with 2%Z.
-easy.
-rewrite Zmult_comm.
-apply Zle_trans with (1 := Hs2).
-rewrite Hq.
-apply Zle_trans with (Zdigits beta (q + q + q * q)).
-apply Zdigits_le.
-rewrite <- Hq.
-now apply Zlt_le_weak.
-omega.
-replace (Zdigits beta q * 2)%Z with (Zdigits beta q + Zdigits beta q)%Z by ring.
-apply Zdigits_mult_strong.
-omega.
-omega.
-(* . round *)
-unfold inbetween_float, F2R. simpl.
-rewrite sqrt_mult.
-2: now apply (Z2R_le 0) ; apply Zlt_le_weak.
-2: apply Rlt_le ; apply bpow_gt_0.
-destruct (Zeven_ex e') as (e2, Hev).
-rewrite He1, Zplus_0_r in Hev. clear He1.
-rewrite Hev.
-replace (Zdiv2 (2 * e2)) with e2 by now case e2.
-replace (2 * e2)%Z with (e2 + e2)%Z by ring.
-rewrite bpow_plus.
-fold (Rsqr (bpow e2)).
-rewrite sqrt_Rsqr.
-2: apply Rlt_le ; apply bpow_gt_0.
-apply inbetween_mult_compat.
-apply bpow_gt_0.
-rewrite Hq.
-case Zeq_bool_spec ; intros Hr'.
-(* .. r = 0 *)
-rewrite Hr', Zplus_0_r, Z2R_mult.
-fold (Rsqr (Z2R q)).
-rewrite sqrt_Rsqr.
-now constructor.
-apply (Z2R_le 0).
-omega.
-(* .. r <> 0 *)
-constructor.
-split.
-(* ... bounds *)
-apply Rle_lt_trans with (sqrt (Z2R (q * q))).
-rewrite Z2R_mult.
-fold (Rsqr (Z2R q)).
-rewrite sqrt_Rsqr.
-apply Rle_refl.
-apply (Z2R_le 0).
-omega.
-apply sqrt_lt_1.
-rewrite Z2R_mult.
-apply Rle_0_sqr.
-rewrite <- Hq.
-apply (Z2R_le 0).
-now apply Zlt_le_weak.
-apply Z2R_lt.
-omega.
-apply Rlt_le_trans with (sqrt (Z2R ((q + 1) * (q + 1)))).
-apply sqrt_lt_1.
-rewrite <- Hq.
-apply (Z2R_le 0).
-now apply Zlt_le_weak.
-rewrite Z2R_mult.
-apply Rle_0_sqr.
-apply Z2R_lt.
-ring_simplify.
-omega.
-rewrite Z2R_mult.
-fold (Rsqr (Z2R (q + 1))).
-rewrite sqrt_Rsqr.
-apply Rle_refl.
-apply (Z2R_le 0).
-omega.
-(* ... location *)
-rewrite Rcompare_half_r.
-rewrite <- Rcompare_sqr.
-replace ((2 * sqrt (Z2R (q * q + r))) * (2 * sqrt (Z2R (q * q + r))))%R
-  with (4 * Rsqr (sqrt (Z2R (q * q + r))))%R by (unfold Rsqr ; ring).
-rewrite Rsqr_sqrt.
-change 4%R with (Z2R 4).
-rewrite <- Z2R_plus, <- 2!Z2R_mult.
-rewrite Rcompare_Z2R.
-replace ((q + (q + 1)) * (q + (q + 1)))%Z with (4 * (q * q) + 4 * q + 1)%Z by ring.
-generalize (Zle_cases r q).
-case (Zle_bool r q) ; intros Hr''.
-change (4 * (q * q + r) < 4 * (q * q) + 4 * q + 1)%Z.
-omega.
-change (4 * (q * q + r) > 4 * (q * q) + 4 * q + 1)%Z.
-omega.
-rewrite <- Hq.
-apply (Z2R_le 0).
-now apply Zlt_le_weak.
-apply Rmult_le_pos.
-now apply (Z2R_le 0 2).
-apply sqrt_ge_0.
-rewrite <- Z2R_plus.
-apply (Z2R_le 0).
-omega.
-Qed.
-
-End Fcalc_sqrt.
diff --git a/flocq/Calc/Fcalc_ops.v b/flocq/Calc/Operations.v
index e834c044..3416cb4e 100644
--- a/flocq/Calc/Fcalc_ops.v
+++ b/flocq/Calc/Operations.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,9 +18,10 @@ COPYING file for more details.
 *)
 
 (** Basic operations on floats: alignment, addition, multiplication *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_float_prop.
+Require Import Raux Defs Float_prop.
+
+Set Implicit Arguments.
+Set Strongly Strict Implicit.
 
 Section Float_ops.
 
@@ -28,7 +29,7 @@ Variable beta : radix.
 
 Notation bpow e := (bpow beta e).
 
-Arguments Float {beta} Fnum Fexp.
+Arguments Float {beta}.
 
 Definition Falign (f1 f2 : float beta) :=
   let '(Float m1 e1) := f1 in
@@ -54,7 +55,7 @@ Qed.
 
 Theorem Falign_spec_exp:
   forall f1 f2 : float beta,
-  snd (Falign f1 f2) = Zmin (Fexp f1) (Fexp f2).
+  snd (Falign f1 f2) = Z.min (Fexp f1) (Fexp f2).
 Proof.
 intros (m1,e1) (m2,e2).
 unfold Falign; simpl.
@@ -76,7 +77,7 @@ Qed.
 
 Definition Fabs (f1 : float beta) : float beta :=
   let '(Float m1 e1) := f1 in
-  Float (Zabs m1)%Z e1.
+  Float (Z.abs m1)%Z e1.
 
 Theorem F2R_abs :
   forall f1 : float beta,
@@ -100,7 +101,7 @@ destruct (Falign f1 f2) as ((m1, m2), e).
 intros (H1, H2).
 rewrite H1, H2.
 unfold F2R. simpl.
-rewrite Z2R_plus.
+rewrite plus_IZR.
 apply Rmult_plus_distr_r.
 Qed.
 
@@ -116,7 +117,7 @@ Qed.
 
 Theorem Fexp_Fplus :
   forall f1 f2 : float beta,
-  Fexp (Fplus f1 f2) = Zmin (Fexp f1) (Fexp f2).
+  Fexp (Fplus f1 f2) = Z.min (Fexp f1) (Fexp f2).
 Proof.
 intros f1 f2.
 unfold Fplus.
@@ -156,7 +157,7 @@ Theorem F2R_mult :
 Proof.
 intros (m1, e1) (m2, e2).
 unfold Fmult, F2R. simpl.
-rewrite Z2R_mult, bpow_plus.
+rewrite mult_IZR, bpow_plus.
 ring.
 Qed.
 
diff --git a/flocq/Calc/Fcalc_round.v b/flocq/Calc/Round.v
index 86422247..5bde6af4 100644
--- a/flocq/Calc/Fcalc_round.v
+++ b/flocq/Calc/Round.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2010-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2010-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -19,10 +19,7 @@ COPYING file for more details.
 
 (** * Helper function for computing the rounded value of a real number. *)
 
-Require Import Fcore.
-Require Import Fcore_digits.
-Require Import Fcalc_bracket.
-Require Import Fcalc_digits.
+Require Import Core Digits Float_prop Bracket.
 
 Section Fcalc_round.
 
@@ -35,19 +32,78 @@ Variable fexp : Z -> Z.
 Context { valid_exp : Valid_exp fexp }.
 Notation format := (generic_format beta fexp).
 
+Theorem cexp_inbetween_float :
+  forall x m e l,
+  (0 < x)%R ->
+  inbetween_float beta m e x l ->
+  (e <= cexp beta fexp x \/ e <= fexp (Zdigits beta m + e))%Z ->
+  cexp beta fexp x = fexp (Zdigits beta m + e).
+Proof.
+intros x m e l Px Bx He.
+unfold cexp.
+apply inbetween_float_bounds in Bx.
+assert (0 <= m)%Z as Hm.
+{ apply Zlt_succ_le.
+  eapply gt_0_F2R.
+  apply Rlt_trans with (1 := Px).
+  apply Bx. }
+destruct (Zle_lt_or_eq _ _ Hm) as [Hm'|<-].
+  now erewrite <- mag_F2R_bounds_Zdigits with (1 := Hm').
+clear Hm.
+assert (mag beta x <= e)%Z as Hx.
+{ apply mag_le_bpow.
+  now apply Rgt_not_eq.
+  rewrite Rabs_pos_eq.
+  now rewrite <- F2R_bpow.
+  now apply Rlt_le. }
+simpl in He |- *.
+clear Bx.
+destruct He as [He|He].
+- apply eq_sym, valid_exp with (2 := He).
+  now apply Z.le_trans with e.
+- apply valid_exp with (1 := He).
+  now apply Z.le_trans with e.
+Qed.
+
+Theorem cexp_inbetween_float_loc_Exact :
+  forall x m e l,
+  (0 <= x)%R ->
+  inbetween_float beta m e x l ->
+  (e <= cexp beta fexp x \/ l = loc_Exact <->
+   e <= fexp (Zdigits beta m + e) \/ l = loc_Exact)%Z.
+Proof.
+intros x m e l Px Bx.
+destruct Px as [Px|Px].
+- split ; (intros [H|H] ; [left|now right]).
+  rewrite <- cexp_inbetween_float with (1 := Px) (2 := Bx).
+  exact H.
+  now left.
+  rewrite cexp_inbetween_float with (1 := Px) (2 := Bx).
+  exact H.
+  now right.
+- assert (H := Bx).
+  destruct Bx as [|c Bx _].
+  now split ; right.
+  rewrite <- Px in Bx.
+  destruct Bx as [Bx1 Bx2].
+  apply lt_0_F2R in Bx1.
+  apply gt_0_F2R in Bx2.
+  omega.
+Qed.
+
 (** Relates location and rounding. *)
 
 Theorem inbetween_float_round :
   forall rnd choice,
   ( forall x m l, inbetween_int m x l -> rnd x = choice m l ) ->
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e x l ->
   round beta fexp rnd x = F2R (Float beta (choice m l) e).
 Proof.
 intros rnd choice Hc x m l e Hl.
 unfold round, F2R. simpl.
-apply (f_equal (fun m => (Z2R m * bpow e)%R)).
+apply (f_equal (fun m => (IZR m * bpow e)%R)).
 apply Hc.
 apply inbetween_mult_reg with (bpow e).
 apply bpow_gt_0.
@@ -61,12 +117,12 @@ Theorem inbetween_float_round_sign :
   ( forall x m l, inbetween_int m (Rabs x) l ->
     rnd x = cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m l) ) ->
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e (Rabs x) l ->
   round beta fexp rnd x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m l)) e).
 Proof.
 intros rnd choice Hc x m l e Hx.
-apply (f_equal (fun m => (Z2R m * bpow e)%R)).
+apply (f_equal (fun m => (IZR m * bpow e)%R)).
 simpl.
 replace (Rlt_bool x 0) with (Rlt_bool (scaled_mantissa beta fexp x) 0).
 (* *)
@@ -99,13 +155,13 @@ Proof.
 intros x m l Hl.
 refine (Zfloor_imp m _ _).
 apply inbetween_bounds with (2 := Hl).
-apply Z2R_lt.
+apply IZR_lt.
 apply Zlt_succ.
 Qed.
 
 Theorem inbetween_float_DN :
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e x l ->
   round beta fexp Zfloor x = F2R (Float beta m e).
 Proof.
@@ -131,23 +187,23 @@ destruct (Rcase_abs x) as [Zx|Zx] .
 rewrite Rlt_bool_true with (1 := Zx).
 inversion_clear Hl ; simpl.
 rewrite <- (Ropp_involutive x).
-rewrite H, <- Z2R_opp.
-apply Zfloor_Z2R.
+rewrite H, <- opp_IZR.
+apply Zfloor_IZR.
 apply Zfloor_imp.
 split.
 apply Rlt_le.
-rewrite Z2R_opp.
+rewrite opp_IZR.
 apply Ropp_lt_cancel.
 now rewrite Ropp_involutive.
 ring_simplify (- (m + 1) + 1)%Z.
-rewrite Z2R_opp.
+rewrite opp_IZR.
 apply Ropp_lt_cancel.
 now rewrite Ropp_involutive.
 (* *)
 rewrite Rlt_bool_false.
 inversion_clear Hl ; simpl.
 rewrite H.
-apply Zfloor_Z2R.
+apply Zfloor_IZR.
 apply Zfloor_imp.
 split.
 now apply Rlt_le.
@@ -157,7 +213,7 @@ Qed.
 
 Theorem inbetween_float_DN_sign :
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e (Rabs x) l ->
   round beta fexp Zfloor x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_DN (Rlt_bool x 0) l) m)) e).
 Proof.
@@ -186,7 +242,7 @@ destruct Hl' as [Hl'|(Hl1, Hl2)].
 rewrite Hl'.
 destruct Hl ; try easy.
 rewrite H.
-exact (Zceil_Z2R _).
+exact (Zceil_IZR _).
 (* not Exact *)
 rewrite Hl2.
 simpl.
@@ -198,7 +254,7 @@ Qed.
 
 Theorem inbetween_float_UP :
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e x l ->
   round beta fexp Zceil x = F2R (Float beta (cond_incr (round_UP l) m) e).
 Proof.
@@ -227,7 +283,7 @@ unfold Zceil.
 apply f_equal.
 inversion_clear Hl ; simpl.
 rewrite H.
-apply Zfloor_Z2R.
+apply Zfloor_IZR.
 apply Zfloor_imp.
 split.
 now apply Rlt_le.
@@ -237,10 +293,10 @@ rewrite Rlt_bool_false.
 simpl.
 inversion_clear Hl ; simpl.
 rewrite H.
-apply Zceil_Z2R.
+apply Zceil_IZR.
 apply Zceil_imp.
 split.
-change (m + 1 - 1)%Z with (Zpred (Zsucc m)).
+change (m + 1 - 1)%Z with (Z.pred (Z.succ m)).
 now rewrite <- Zpred_succ.
 now apply Rlt_le.
 now apply Rge_le.
@@ -248,7 +304,7 @@ Qed.
 
 Theorem inbetween_float_UP_sign :
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e (Rabs x) l ->
   round beta fexp Zceil x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_UP (Rlt_bool x 0) l) m)) e).
 Proof.
@@ -273,7 +329,7 @@ intros x m l Hl.
 inversion_clear Hl as [Hx|l' Hx Hl'].
 (* Exact *)
 rewrite Hx.
-rewrite Zrnd_Z2R...
+rewrite Zrnd_IZR...
 (* not Exact *)
 unfold Ztrunc.
 assert (Hm: Zfloor x = m).
@@ -288,10 +344,10 @@ case Rlt_bool_spec ; intros Hx' ;
 elim Rlt_not_le with (1 := Hx').
 apply Rlt_le.
 apply Rle_lt_trans with (2 := proj1 Hx).
-now apply (Z2R_le 0).
+now apply IZR_le.
 elim Rle_not_lt with (1 := Hx').
 apply Rlt_le_trans with (1 := proj2 Hx).
-apply (Z2R_le _ 0).
+apply IZR_le.
 now apply Zlt_le_succ.
 rewrite Hm.
 now apply Rlt_not_eq.
@@ -299,7 +355,7 @@ Qed.
 
 Theorem inbetween_float_ZR :
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e x l ->
   round beta fexp Ztrunc x = F2R (Float beta (cond_incr (round_ZR (Zlt_bool m 0) l) m) e).
 Proof.
@@ -324,7 +380,7 @@ apply f_equal.
 apply Zfloor_imp.
 rewrite <- Rabs_left with (1 := Zx).
 apply inbetween_bounds with (2 := Hl).
-apply Z2R_lt.
+apply IZR_lt.
 apply Zlt_succ.
 (* *)
 rewrite Rlt_bool_false with (1 := Zx).
@@ -332,13 +388,13 @@ simpl.
 apply Zfloor_imp.
 rewrite <- Rabs_pos_eq with (1 := Zx).
 apply inbetween_bounds with (2 := Hl).
-apply Z2R_lt.
+apply IZR_lt.
 apply Zlt_succ.
 Qed.
 
 Theorem inbetween_float_ZR_sign :
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e (Rabs x) l ->
   round beta fexp Ztrunc x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) m) e).
 Proof.
@@ -365,7 +421,7 @@ intros choice x m l Hl.
 inversion_clear Hl as [Hx|l' Hx Hl'].
 (* Exact *)
 rewrite Hx.
-rewrite Zrnd_Z2R...
+rewrite Zrnd_IZR...
 (* not Exact *)
 unfold Znearest.
 assert (Hm: Zfloor x = m).
@@ -373,13 +429,12 @@ apply Zfloor_imp.
 exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)).
 rewrite Zceil_floor_neq.
 rewrite Hm.
-replace (Rcompare (x - Z2R m) (/2)) with l'.
+replace (Rcompare (x - IZR m) (/2)) with l'.
 now case l'.
 rewrite <- Hl'.
-rewrite Z2R_plus.
-rewrite <- (Rcompare_plus_r (- Z2R m) x).
+rewrite plus_IZR.
+rewrite <- (Rcompare_plus_r (- IZR m) x).
 apply f_equal.
-simpl (Z2R 1).
 field.
 rewrite Hm.
 now apply Rlt_not_eq.
@@ -402,20 +457,19 @@ rewrite Znearest_opp.
 apply f_equal.
 inversion_clear Hl as [Hx|l' Hx Hl'].
 rewrite Hx.
-apply Zrnd_Z2R...
+apply Zrnd_IZR...
 assert (Hm: Zfloor (-x) = m).
 apply Zfloor_imp.
 exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)).
 unfold Znearest.
 rewrite Zceil_floor_neq.
 rewrite Hm.
-replace (Rcompare (- x - Z2R m) (/2)) with l'.
+replace (Rcompare (- x - IZR m) (/2)) with l'.
 now case l'.
 rewrite <- Hl'.
-rewrite Z2R_plus.
-rewrite <- (Rcompare_plus_r (- Z2R m) (-x)).
+rewrite plus_IZR.
+rewrite <- (Rcompare_plus_r (- IZR m) (-x)).
 apply f_equal.
-simpl (Z2R 1).
 field.
 rewrite Hm.
 now apply Rlt_not_eq.
@@ -426,20 +480,19 @@ rewrite Rlt_bool_false with (1 := Zx).
 simpl.
 inversion_clear Hl as [Hx|l' Hx Hl'].
 rewrite Hx.
-apply Zrnd_Z2R...
+apply Zrnd_IZR...
 assert (Hm: Zfloor x = m).
 apply Zfloor_imp.
 exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)).
 unfold Znearest.
 rewrite Zceil_floor_neq.
 rewrite Hm.
-replace (Rcompare (x - Z2R m) (/2)) with l'.
+replace (Rcompare (x - IZR m) (/2)) with l'.
 now case l'.
 rewrite <- Hl'.
-rewrite Z2R_plus.
-rewrite <- (Rcompare_plus_r (- Z2R m) x).
+rewrite plus_IZR.
+rewrite <- (Rcompare_plus_r (- IZR m) x).
 apply f_equal.
-simpl (Z2R 1).
 field.
 rewrite Hm.
 now apply Rlt_not_eq.
@@ -450,44 +503,44 @@ Qed.
 Theorem inbetween_int_NE :
   forall x m l,
   inbetween_int m x l ->
-  ZnearestE x = cond_incr (round_N (negb (Zeven m)) l) m.
+  ZnearestE x = cond_incr (round_N (negb (Z.even m)) l) m.
 Proof.
 intros x m l Hl.
-now apply inbetween_int_N with (choice := fun x => negb (Zeven x)).
+now apply inbetween_int_N with (choice := fun x => negb (Z.even x)).
 Qed.
 
 Theorem inbetween_float_NE :
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e x l ->
-  round beta fexp ZnearestE x = F2R (Float beta (cond_incr (round_N (negb (Zeven m)) l) m) e).
+  round beta fexp ZnearestE x = F2R (Float beta (cond_incr (round_N (negb (Z.even m)) l) m) e).
 Proof.
-apply inbetween_float_round with (choice := fun m l => cond_incr (round_N (negb (Zeven m)) l) m).
+apply inbetween_float_round with (choice := fun m l => cond_incr (round_N (negb (Z.even m)) l) m).
 exact inbetween_int_NE.
 Qed.
 
 Theorem inbetween_int_NE_sign :
   forall x m l,
   inbetween_int m (Rabs x) l ->
-  ZnearestE x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (negb (Zeven m)) l) m).
+  ZnearestE x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (negb (Z.even m)) l) m).
 Proof.
 intros x m l Hl.
-erewrite inbetween_int_N_sign with (choice := fun x => negb (Zeven x)).
+erewrite inbetween_int_N_sign with (choice := fun x => negb (Z.even x)).
 2: eexact Hl.
 apply f_equal.
 case Rlt_bool.
-rewrite Zeven_opp, Zeven_plus.
-now case (Zeven m).
+rewrite Z.even_opp, Z.even_add.
+now case (Z.even m).
 apply refl_equal.
 Qed.
 
 Theorem inbetween_float_NE_sign :
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e (Rabs x) l ->
-  round beta fexp ZnearestE x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (negb (Zeven m)) l) m)) e).
+  round beta fexp ZnearestE x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (negb (Z.even m)) l) m)) e).
 Proof.
-apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_N (negb (Zeven m)) l) m).
+apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_N (negb (Z.even m)) l) m).
 exact inbetween_int_NE_sign.
 Qed.
 
@@ -504,7 +557,7 @@ Qed.
 
 Theorem inbetween_float_NA :
   forall x m l,
-  let e := canonic_exp beta fexp x in
+  let e := cexp beta fexp x in
   inbetween_float beta m e x l ->
   round beta fexp ZnearestA x = F2R (Float beta (cond_incr (round_N (Zle_bool 0 m) l) m) e).
 Proof.
@@ -523,11 +576,11 @@ erewrite inbetween_int_N_sign with (choice := Zle_bool 0).
 apply f_equal.
 assert (Hm: (0 <= m)%Z).
 apply Zlt_succ_le.
-apply lt_Z2R.
+apply lt_IZR.
 apply Rle_lt_trans with (Rabs x).
 apply Rabs_pos.
 refine (proj2 (inbetween_bounds _ _ _ _ _ Hl)).
-apply Z2R_lt.
+apply IZR_lt.
 apply Zlt_succ.
 rewrite Zle_bool_true with (1 := Hm).
 rewrite Zle_bool_false.
@@ -538,7 +591,7 @@ Qed.
 Definition truncate_aux t k :=
   let '(m, e, l) := t in
   let p := Zpower beta k in
-  (Zdiv m p, (e + k)%Z, new_location p (Zmod m p) l).
+  (Z.div m p, (e + k)%Z, new_location p (Zmod m p) l).
 
 Theorem truncate_aux_comp :
   forall t k1 k2,
@@ -597,28 +650,28 @@ case Zlt_bool_spec ; intros Hk.
 unfold truncate_aux.
 apply generic_format_F2R.
 intros Hd.
-unfold canonic_exp.
-rewrite ln_beta_F2R_Zdigits with (1 := Hd).
+unfold cexp.
+rewrite mag_F2R_Zdigits with (1 := Hd).
 rewrite Zdigits_div_Zpower with (1 := Hm).
 replace (Zdigits beta m - k + (e + k))%Z with (Zdigits beta m + e)%Z by ring.
 unfold k.
 ring_simplify.
-apply Zle_refl.
+apply Z.le_refl.
 split.
 now apply Zlt_le_weak.
 apply Znot_gt_le.
 contradict Hd.
 apply Zdiv_small.
 apply conj with (1 := Hm).
-rewrite <- Zabs_eq with (1 := Hm).
+rewrite <- Z.abs_eq with (1 := Hm).
 apply Zpower_gt_Zdigits.
 apply Zlt_le_weak.
-now apply Zgt_lt.
+now apply Z.gt_lt.
 (* *)
 destruct (Zle_lt_or_eq _ _ Hm) as [Hm'|Hm'].
 apply generic_format_F2R.
-unfold canonic_exp.
-rewrite ln_beta_F2R_Zdigits.
+unfold cexp.
+rewrite mag_F2R_Zdigits.
 2: now apply Zgt_not_eq.
 unfold k in Hk. clear -Hk.
 omega.
@@ -633,26 +686,26 @@ Theorem truncate_correct_format :
   generic_format beta fexp x ->
   (e <= fexp (Zdigits beta m + e))%Z ->
   let '(m', e', l') := truncate (m, e, loc_Exact) in
-  x = F2R (Float beta m' e') /\ e' = canonic_exp beta fexp x.
+  x = F2R (Float beta m' e') /\ e' = cexp beta fexp x.
 Proof.
 intros m e Hm x Fx He.
-assert (Hc: canonic_exp beta fexp x = fexp (Zdigits beta m + e)).
-unfold canonic_exp, x.
-now rewrite ln_beta_F2R_Zdigits.
+assert (Hc: cexp beta fexp x = fexp (Zdigits beta m + e)).
+unfold cexp, x.
+now rewrite mag_F2R_Zdigits.
 unfold truncate.
 rewrite <- Hc.
-set (k := (canonic_exp beta fexp x - e)%Z).
+set (k := (cexp beta fexp x - e)%Z).
 case Zlt_bool_spec ; intros Hk.
 (* *)
 unfold truncate_aux.
 rewrite Fx at 1.
-assert (H: (e + k)%Z = canonic_exp beta fexp x).
+assert (H: (e + k)%Z = cexp beta fexp x).
 unfold k. ring.
 refine (conj _ H).
 rewrite <- H.
-apply F2R_eq_compat.
-replace (scaled_mantissa beta fexp x) with (Z2R (Zfloor (scaled_mantissa beta fexp x))).
-rewrite Ztrunc_Z2R.
+apply F2R_eq.
+replace (scaled_mantissa beta fexp x) with (IZR (Zfloor (scaled_mantissa beta fexp x))).
+rewrite Ztrunc_IZR.
 unfold scaled_mantissa.
 rewrite <- H.
 unfold x, F2R. simpl.
@@ -666,7 +719,7 @@ intros H.
 generalize (Zpower_pos_gt_0 beta k) (Zle_bool_imp_le _ _ (radix_prop beta)).
 omega.
 rewrite scaled_mantissa_generic with (1 := Fx).
-now rewrite Zfloor_Z2R.
+now rewrite Zfloor_IZR.
 (* *)
 split.
 apply refl_equal.
@@ -674,73 +727,111 @@ unfold k in Hk.
 omega.
 Qed.
 
+Theorem truncate_correct_partial' :
+  forall x m e l,
+  (0 < x)%R ->
+  inbetween_float beta m e x l ->
+  (e <= cexp beta fexp x)%Z ->
+  let '(m', e', l') := truncate (m, e, l) in
+  inbetween_float beta m' e' x l' /\ e' = cexp beta fexp x.
+Proof.
+intros x m e l Hx H1 H2.
+unfold truncate.
+rewrite <- cexp_inbetween_float with (1 := Hx) (2 := H1) by now left.
+generalize (Zlt_cases 0 (cexp beta fexp x - e)).
+destruct Zlt_bool ; intros Hk.
+- split.
+  now apply inbetween_float_new_location.
+  ring.
+- apply (conj H1).
+  omega.
+Qed.
+
 Theorem truncate_correct_partial :
   forall x m e l,
   (0 < x)%R ->
   inbetween_float beta m e x l ->
   (e <= fexp (Zdigits beta m + e))%Z ->
   let '(m', e', l') := truncate (m, e, l) in
-  inbetween_float beta m' e' x l' /\ e' = canonic_exp beta fexp x.
+  inbetween_float beta m' e' x l' /\ e' = cexp beta fexp x.
 Proof.
 intros x m e l Hx H1 H2.
-unfold truncate.
-set (k := (fexp (Zdigits beta m + e) - e)%Z).
-set (p := Zpower beta k).
-(* *)
-assert (Hx': (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R).
-apply inbetween_float_bounds with (1 := H1).
-(* *)
-assert (Hm: (0 <= m)%Z).
-cut (0 < m + 1)%Z. omega.
-apply F2R_lt_reg with beta e.
-rewrite F2R_0.
-apply Rlt_trans with  (1 := Hx).
-apply Hx'.
-assert (He: (e + k = canonic_exp beta fexp x)%Z).
-(* . *)
-unfold canonic_exp.
-destruct (Zle_lt_or_eq _ _ Hm) as [Hm'|Hm'].
-(* .. 0 < m *)
-rewrite ln_beta_F2R_bounds with (1 := Hm') (2 := Hx').
-assert (H: m <> Z0).
-apply sym_not_eq.
-now apply Zlt_not_eq.
-rewrite ln_beta_F2R with (1 := H).
-rewrite <- Zdigits_ln_beta with (1 := H).
-unfold k.
-ring.
-(* .. m = 0 *)
-rewrite <- Hm' in H2.
-destruct (ln_beta beta x) as (ex, Hex).
-simpl.
-specialize (Hex (Rgt_not_eq _ _ Hx)).
-unfold k.
-ring_simplify.
-rewrite <- Hm'.
-simpl.
-apply sym_eq.
-apply valid_exp.
-exact H2.
-apply Zle_trans with e.
-eapply bpow_lt_bpow.
-apply Rle_lt_trans with (1 := proj1 Hex).
-rewrite Rabs_pos_eq.
-rewrite <- F2R_bpow.
-rewrite <- Hm' in Hx'.
-apply Hx'.
-now apply Rlt_le.
+apply truncate_correct_partial' with (1 := Hx) (2 := H1).
+rewrite cexp_inbetween_float with (1 := Hx) (2 := H1).
 exact H2.
-(* . *)
-generalize (Zlt_cases 0 k).
-case (Zlt_bool 0 k) ; intros Hk ; unfold k in Hk.
-split.
-now apply inbetween_float_new_location.
-exact He.
-split.
-exact H1.
-rewrite <- He.
-unfold k.
-omega.
+now right.
+Qed.
+
+Theorem truncate_correct' :
+  forall x m e l,
+  (0 <= x)%R ->
+  inbetween_float beta m e x l ->
+  (e <= cexp beta fexp x)%Z \/ l = loc_Exact ->
+  let '(m', e', l') := truncate (m, e, l) in
+  inbetween_float beta m' e' x l' /\
+  (e' = cexp beta fexp x \/ (l' = loc_Exact /\ format x)).
+Proof.
+intros x m e l [Hx|Hx] H1 H2.
+- destruct (Zle_or_lt e (fexp (Zdigits beta m + e))) as [H3|H3].
+  + generalize (truncate_correct_partial x m e l Hx H1 H3).
+    destruct (truncate (m, e, l)) as [[m' e'] l'].
+    intros [H4 H5].
+    apply (conj H4).
+    now left.
+  + destruct H2 as [H2|H2].
+      generalize (truncate_correct_partial' x m e l Hx H1 H2).
+      destruct (truncate (m, e, l)) as [[m' e'] l'].
+      intros [H4 H5].
+      apply (conj H4).
+      now left.
+    rewrite H2 in H1 |- *.
+    simpl.
+    generalize (Zlt_cases 0 (fexp (Zdigits beta m + e) - e)).
+    destruct Zlt_bool.
+      intros H.
+      apply False_ind.
+      omega.
+    intros _.
+    apply (conj H1).
+    right.
+    repeat split.
+    inversion_clear H1.
+    rewrite H.
+    apply generic_format_F2R.
+    intros Zm.
+    unfold cexp.
+    rewrite mag_F2R_Zdigits with (1 := Zm).
+    now apply Zlt_le_weak.
+- assert (Hm: m = 0%Z).
+  cut (m <= 0 < m + 1)%Z. omega.
+  assert (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R as Hx'.
+    apply inbetween_float_bounds with (1 := H1).
+    rewrite <- Hx in Hx'.
+    split.
+    apply le_0_F2R with (1 := proj1 Hx').
+    apply gt_0_F2R with (1 := proj2 Hx').
+  rewrite Hm, <- Hx in H1 |- *.
+  clear -H1.
+  destruct H1 as [_ | l' [H _] _].
+  + assert (exists e', truncate (Z0, e, loc_Exact) = (Z0, e', loc_Exact)).
+      unfold truncate, truncate_aux.
+      case Zlt_bool.
+        rewrite Zdiv_0_l, Zmod_0_l.
+        eexists.
+        apply f_equal.
+        unfold new_location.
+        now case Z.even.
+      now eexists.
+    destruct H as [e' H].
+    rewrite H.
+    split.
+      constructor.
+      apply eq_sym, F2R_0.
+      right.
+      repeat split.
+      apply generic_format_0.
+  + rewrite F2R_0 in H.
+    elim Rlt_irrefl with (1 := H).
 Qed.
 
 Theorem truncate_correct :
@@ -750,78 +841,11 @@ Theorem truncate_correct :
   (e <= fexp (Zdigits beta m + e))%Z \/ l = loc_Exact ->
   let '(m', e', l') := truncate (m, e, l) in
   inbetween_float beta m' e' x l' /\
-  (e' = canonic_exp beta fexp x \/ (l' = loc_Exact /\ format x)).
+  (e' = cexp beta fexp x \/ (l' = loc_Exact /\ format x)).
 Proof.
-intros x m e l [Hx|Hx] H1 H2.
-(* 0 < x *)
-destruct (Zle_or_lt e (fexp (Zdigits beta m + e))) as [H3|H3].
-(* . enough digits *)
-generalize (truncate_correct_partial x m e l Hx H1 H3).
-destruct (truncate (m, e, l)) as ((m', e'), l').
-intros (H4, H5).
-split.
-exact H4.
-now left.
-(* . not enough digits but loc_Exact *)
-destruct H2 as [H2|H2].
-elim (Zlt_irrefl e).
-now apply Zle_lt_trans with (1 := H2).
-rewrite H2 in H1 |- *.
-unfold truncate.
-generalize (Zlt_cases 0 (fexp (Zdigits beta m + e) - e)).
-case Zlt_bool.
-intros H.
-apply False_ind.
-omega.
-intros _.
-split.
-exact H1.
-right.
-split.
-apply refl_equal.
-inversion_clear H1.
-rewrite H.
-apply generic_format_F2R.
-intros Zm.
-unfold canonic_exp.
-rewrite ln_beta_F2R_Zdigits with (1 := Zm).
-now apply Zlt_le_weak.
-(* x = 0 *)
-assert (Hm: m = Z0).
-cut (m <= 0 < m + 1)%Z. omega.
-assert (Hx': (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R).
-apply inbetween_float_bounds with (1 := H1).
-rewrite <- Hx in Hx'.
-split.
-apply F2R_le_0_reg with (1 := proj1 Hx').
-apply F2R_gt_0_reg with (1 := proj2 Hx').
-rewrite Hm, <- Hx in H1 |- *.
-clear -H1.
-case H1.
-(* . *)
-intros _.
-assert (exists e', truncate (Z0, e, loc_Exact) = (Z0, e', loc_Exact)).
-unfold truncate, truncate_aux.
-case Zlt_bool.
-rewrite Zdiv_0_l, Zmod_0_l.
-eexists.
-apply f_equal.
-unfold new_location.
-now case Zeven.
-now eexists.
-destruct H as (e', H).
-rewrite H.
-split.
-constructor.
-apply sym_eq.
-apply F2R_0.
-right.
-repeat split.
-apply generic_format_0.
-(* . *)
-intros l' (H, _) _.
-rewrite F2R_0 in H.
-elim Rlt_irrefl with (1 := H).
+intros x m e l Hx H1 H2.
+apply truncate_correct' with (1 := Hx) (2 := H1).
+now apply cexp_inbetween_float_loc_Exact with (2 := H1).
 Qed.
 
 Section round_dir.
@@ -838,7 +862,7 @@ Hypothesis inbetween_int_valid :
 Theorem round_any_correct :
   forall x m e l,
   inbetween_float beta m e x l ->
-  (e = canonic_exp beta fexp x \/ (l = loc_Exact /\ format x)) ->
+  (e = cexp beta fexp x \/ (l = loc_Exact /\ format x)) ->
   round beta fexp rnd x = F2R (Float beta (choice m l) e).
 Proof with auto with typeclass_instances.
 intros x m e l Hin [He|(Hl,Hf)].
@@ -851,7 +875,7 @@ rewrite Hl.
 replace (choice m loc_Exact) with m.
 rewrite <- H.
 apply round_generic...
-rewrite <- (Zrnd_Z2R rnd m) at 1.
+rewrite <- (Zrnd_IZR rnd m) at 1.
 apply inbetween_int_valid.
 now constructor.
 Qed.
@@ -872,6 +896,20 @@ intros (H1, H2).
 now apply round_any_correct.
 Qed.
 
+Theorem round_trunc_any_correct' :
+  forall x m e l,
+  (0 <= x)%R ->
+  inbetween_float beta m e x l ->
+  (e <= cexp beta fexp x)%Z \/ l = loc_Exact ->
+  round beta fexp rnd x = let '(m', e', l') := truncate (m, e, l) in F2R (Float beta (choice m' l') e').
+Proof.
+intros x m e l Hx Hl He.
+generalize (truncate_correct' x m e l Hx Hl He).
+destruct (truncate (m, e, l)) as [[m' e'] l'].
+intros [H1 H2].
+now apply round_any_correct.
+Qed.
+
 End round_dir.
 
 Section round_dir_sign.
@@ -888,7 +926,7 @@ Hypothesis inbetween_int_valid :
 Theorem round_sign_any_correct :
   forall x m e l,
   inbetween_float beta m e (Rabs x) l ->
-  (e = canonic_exp beta fexp x \/ (l = loc_Exact /\ format x)) ->
+  (e = cexp beta fexp x \/ (l = loc_Exact /\ format x)) ->
   round beta fexp rnd x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m l)) e).
 Proof with auto with typeclass_instances.
 intros x m e l Hin [He|(Hl,Hf)].
@@ -915,14 +953,14 @@ now apply Rge_le.
 (* *)
 destruct (Rlt_bool_spec x 0) as [Zx|Zx].
 (* . *)
-apply Zopp_inj.
+apply Z.opp_inj.
 change (- m = cond_Zopp true (choice true m loc_Exact))%Z.
-rewrite <- (Zrnd_Z2R rnd (-m)) at 1.
-assert (Z2R (-m) < 0)%R.
-rewrite Z2R_opp.
+rewrite <- (Zrnd_IZR rnd (-m)) at 1.
+assert (IZR (-m) < 0)%R.
+rewrite opp_IZR.
 apply Ropp_lt_gt_0_contravar.
-apply (Z2R_lt 0).
-apply F2R_gt_0_reg with beta e.
+apply IZR_lt.
+apply gt_0_F2R with beta e.
 rewrite <- H.
 apply Rabs_pos_lt.
 now apply Rlt_not_eq.
@@ -930,14 +968,14 @@ rewrite <- Rlt_bool_true with (1 := H0).
 apply inbetween_int_valid.
 constructor.
 rewrite Rabs_left with (1 := H0).
-rewrite Z2R_opp.
+rewrite opp_IZR.
 apply Ropp_involutive.
 (* . *)
 change (m = cond_Zopp false (choice false m loc_Exact))%Z.
-rewrite <- (Zrnd_Z2R rnd m) at 1.
-assert (0 <= Z2R m)%R.
-apply (Z2R_le 0).
-apply F2R_ge_0_reg with beta e.
+rewrite <- (Zrnd_IZR rnd m) at 1.
+assert (0 <= IZR m)%R.
+apply IZR_le.
+apply ge_0_F2R with beta e.
 rewrite <- H.
 apply Rabs_pos.
 rewrite <- Rlt_bool_false with (1 := H0).
@@ -948,29 +986,38 @@ Qed.
 
 (** Truncating a triple is sufficient to round a real number. *)
 
-Theorem round_trunc_sign_any_correct :
+Theorem round_trunc_sign_any_correct' :
   forall x m e l,
   inbetween_float beta m e (Rabs x) l ->
-  (e <= fexp (Zdigits beta m + e))%Z \/ l = loc_Exact ->
+  (e <= cexp beta fexp x)%Z \/ l = loc_Exact ->
   round beta fexp rnd x = let '(m', e', l') := truncate (m, e, l) in F2R (Float beta (cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m' l')) e').
 Proof.
 intros x m e l Hl He.
-generalize (truncate_correct (Rabs x) m e l (Rabs_pos _) Hl He).
-destruct (truncate (m, e, l)) as ((m', e'), l').
-intros (H1, H2).
+rewrite <- cexp_abs in He.
+generalize (truncate_correct' (Rabs x) m e l (Rabs_pos _) Hl He).
+destruct (truncate (m, e, l)) as [[m' e'] l'].
+intros [H1 H2].
 apply round_sign_any_correct.
 exact H1.
-destruct H2 as [H2|(H2,H3)].
+destruct H2 as [H2|[H2 H3]].
 left.
-now rewrite <- canonic_exp_abs.
+now rewrite <- cexp_abs.
 right.
-split.
-exact H2.
-unfold Rabs in H3.
-destruct (Rcase_abs x) in H3.
-rewrite <- Ropp_involutive.
-now apply generic_format_opp.
-exact H3.
+apply (conj H2).
+now apply generic_format_abs_inv.
+Qed.
+
+Theorem round_trunc_sign_any_correct :
+  forall x m e l,
+  inbetween_float beta m e (Rabs x) l ->
+  (e <= fexp (Zdigits beta m + e))%Z \/ l = loc_Exact ->
+  round beta fexp rnd x = let '(m', e', l') := truncate (m, e, l) in F2R (Float beta (cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m' l')) e').
+Proof.
+intros x m e l Hl He.
+apply round_trunc_sign_any_correct' with (1 := Hl).
+rewrite <- cexp_abs.
+apply cexp_inbetween_float_loc_Exact with (2 := Hl) (3 := He).
+apply Rabs_pos.
 Qed.
 
 End round_dir_sign.
@@ -983,47 +1030,71 @@ Definition round_DN_correct :=
 Definition round_trunc_DN_correct :=
   round_trunc_any_correct _ (fun m _ => m) inbetween_int_DN.
 
+Definition round_trunc_DN_correct' :=
+  round_trunc_any_correct' _ (fun m _ => m) inbetween_int_DN.
+
 Definition round_sign_DN_correct :=
   round_sign_any_correct _ (fun s m l => cond_incr (round_sign_DN s l) m) inbetween_int_DN_sign.
 
 Definition round_trunc_sign_DN_correct :=
   round_trunc_sign_any_correct _ (fun s m l => cond_incr (round_sign_DN s l) m) inbetween_int_DN_sign.
 
+Definition round_trunc_sign_DN_correct' :=
+  round_trunc_sign_any_correct' _ (fun s m l => cond_incr (round_sign_DN s l) m) inbetween_int_DN_sign.
+
 Definition round_UP_correct :=
   round_any_correct _ (fun m l => cond_incr (round_UP l) m) inbetween_int_UP.
 
 Definition round_trunc_UP_correct :=
   round_trunc_any_correct _ (fun m l => cond_incr (round_UP l) m) inbetween_int_UP.
 
+Definition round_trunc_UP_correct' :=
+  round_trunc_any_correct' _ (fun m l => cond_incr (round_UP l) m) inbetween_int_UP.
+
 Definition round_sign_UP_correct :=
   round_sign_any_correct _ (fun s m l => cond_incr (round_sign_UP s l) m) inbetween_int_UP_sign.
 
 Definition round_trunc_sign_UP_correct :=
   round_trunc_sign_any_correct _ (fun s m l => cond_incr (round_sign_UP s l) m) inbetween_int_UP_sign.
 
+Definition round_trunc_sign_UP_correct' :=
+  round_trunc_sign_any_correct' _ (fun s m l => cond_incr (round_sign_UP s l) m) inbetween_int_UP_sign.
+
 Definition round_ZR_correct :=
   round_any_correct _ (fun m l => cond_incr (round_ZR (Zlt_bool m 0) l) m) inbetween_int_ZR.
 
 Definition round_trunc_ZR_correct :=
   round_trunc_any_correct _ (fun m l => cond_incr (round_ZR (Zlt_bool m 0) l) m) inbetween_int_ZR.
 
+Definition round_trunc_ZR_correct' :=
+  round_trunc_any_correct' _ (fun m l => cond_incr (round_ZR (Zlt_bool m 0) l) m) inbetween_int_ZR.
+
 Definition round_sign_ZR_correct :=
   round_sign_any_correct _ (fun s m l => m) inbetween_int_ZR_sign.
 
 Definition round_trunc_sign_ZR_correct :=
   round_trunc_sign_any_correct _ (fun s m l => m) inbetween_int_ZR_sign.
 
+Definition round_trunc_sign_ZR_correct' :=
+  round_trunc_sign_any_correct' _ (fun s m l => m) inbetween_int_ZR_sign.
+
 Definition round_NE_correct :=
-  round_any_correct _ (fun m l => cond_incr (round_N (negb (Zeven m)) l) m) inbetween_int_NE.
+  round_any_correct _ (fun m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE.
 
 Definition round_trunc_NE_correct :=
-  round_trunc_any_correct _ (fun m l => cond_incr (round_N (negb (Zeven m)) l) m) inbetween_int_NE.
+  round_trunc_any_correct _ (fun m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE.
+
+Definition round_trunc_NE_correct' :=
+  round_trunc_any_correct' _ (fun m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE.
 
 Definition round_sign_NE_correct :=
-  round_sign_any_correct _ (fun s m l => cond_incr (round_N (negb (Zeven m)) l) m) inbetween_int_NE_sign.
+  round_sign_any_correct _ (fun s m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE_sign.
 
 Definition round_trunc_sign_NE_correct :=
-  round_trunc_sign_any_correct _ (fun s m l => cond_incr (round_N (negb (Zeven m)) l) m) inbetween_int_NE_sign.
+  round_trunc_sign_any_correct _ (fun s m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE_sign.
+
+Definition round_trunc_sign_NE_correct' :=
+  round_trunc_sign_any_correct' _ (fun s m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE_sign.
 
 Definition round_NA_correct :=
   round_any_correct _ (fun m l => cond_incr (round_N (Zle_bool 0 m) l) m) inbetween_int_NA.
@@ -1031,12 +1102,18 @@ Definition round_NA_correct :=
 Definition round_trunc_NA_correct :=
   round_trunc_any_correct _ (fun m l => cond_incr (round_N (Zle_bool 0 m) l) m) inbetween_int_NA.
 
+Definition round_trunc_NA_correct' :=
+  round_trunc_any_correct' _ (fun m l => cond_incr (round_N (Zle_bool 0 m) l) m) inbetween_int_NA.
+
 Definition round_sign_NA_correct :=
   round_sign_any_correct _ (fun s m l => cond_incr (round_N true l) m) inbetween_int_NA_sign.
 
 Definition round_trunc_sign_NA_correct :=
   round_trunc_sign_any_correct _ (fun s m l => cond_incr (round_N true l) m) inbetween_int_NA_sign.
 
+Definition round_trunc_sign_NA_correct' :=
+  round_trunc_sign_any_correct' _ (fun s m l => cond_incr (round_N true l) m) inbetween_int_NA_sign.
+
 End Fcalc_round_fexp.
 
 (** Specialization of truncate for FIX formats. *)
@@ -1048,7 +1125,7 @@ Definition truncate_FIX t :=
   let k := (emin - e)%Z in
   if Zlt_bool 0 k then
     let p := Zpower beta k in
-    (Zdiv m p, (e + k)%Z, new_location p (Zmod m p) l)
+    (Z.div m p, (e + k)%Z, new_location p (Zmod m p) l)
   else t.
 
 Theorem truncate_FIX_correct :
@@ -1057,13 +1134,13 @@ Theorem truncate_FIX_correct :
   (e <= emin)%Z \/ l = loc_Exact ->
   let '(m', e', l') := truncate_FIX (m, e, l) in
   inbetween_float beta m' e' x l' /\
-  (e' = canonic_exp beta (FIX_exp emin) x \/ (l' = loc_Exact /\ generic_format beta (FIX_exp emin) x)).
+  (e' = cexp beta (FIX_exp emin) x \/ (l' = loc_Exact /\ generic_format beta (FIX_exp emin) x)).
 Proof.
 intros x m e l H1 H2.
 unfold truncate_FIX.
 set (k := (emin - e)%Z).
 set (p := Zpower beta k).
-unfold canonic_exp, FIX_exp.
+unfold cexp, FIX_exp.
 generalize (Zlt_cases 0 k).
 case (Zlt_bool 0 k) ; intros Hk.
 (* shift *)
@@ -1087,7 +1164,7 @@ rewrite H2 in H1.
 inversion_clear H1.
 rewrite H.
 apply generic_format_F2R.
-unfold canonic_exp.
+unfold cexp.
 omega.
 Qed.
 
diff --git a/flocq/Calc/Sqrt.v b/flocq/Calc/Sqrt.v
new file mode 100644
index 00000000..8843d21e
--- /dev/null
+++ b/flocq/Calc/Sqrt.v
@@ -0,0 +1,201 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2018 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2018 Guillaume Melquiond
+
+This library is free software; you can redistribute it and/or
+modify it 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.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+COPYING file for more details.
+*)
+
+(** * Helper functions and theorems for computing the rounded square root of a floating-point number. *)
+
+Require Import Raux Defs Digits Generic_fmt Float_prop Bracket.
+
+Set Implicit Arguments.
+Set Strongly Strict Implicit.
+
+Section Fcalc_sqrt.
+
+Variable beta : radix.
+Notation bpow e := (bpow beta e).
+
+Variable fexp : Z -> Z.
+
+(** Computes a mantissa of precision p, the corresponding exponent,
+    and the position with respect to the real square root of the
+    input floating-point number.
+
+The algorithm performs the following steps:
+- Shift the mantissa so that it has at least 2p-1 digits;
+  shift it one digit more if the new exponent is not even.
+- Compute the square root s (at least p digits) of the new
+  mantissa, and its remainder r.
+- Compute the position according to the remainder:
+  -- r == 0  =>  Eq,
+  -- r <= s  =>  Lo,
+  -- r >= s  =>  Up.
+
+Complexity is fine as long as p1 <= 2p-1.
+*)
+
+Lemma mag_sqrt_F2R :
+  forall m1 e1,
+  (0 < m1)%Z ->
+  mag beta (sqrt (F2R (Float beta m1 e1))) = Z.div2 (Zdigits beta m1 + e1 + 1) :> Z.
+Proof.
+intros m1 e1 Hm1.
+rewrite <- (mag_F2R_Zdigits beta m1 e1) by now apply Zgt_not_eq.
+apply mag_sqrt.
+now apply F2R_gt_0.
+Qed.
+
+Definition Fsqrt_core m1 e1 e :=
+  let d1 := Zdigits beta m1 in
+  let m1' := (m1 * Zpower beta (e1 - 2 * e))%Z in
+  let (q, r) := Z.sqrtrem m1' in
+  let l :=
+    if Zeq_bool r 0 then loc_Exact
+    else loc_Inexact (if Zle_bool r q then Lt else Gt) in
+  (q, l).
+
+Theorem Fsqrt_core_correct :
+  forall m1 e1 e,
+  (0 < m1)%Z ->
+  (2 * e <= e1)%Z ->
+  let '(m, l) := Fsqrt_core m1 e1 e in
+  inbetween_float beta m e (sqrt (F2R (Float beta m1 e1))) l.
+Proof.
+intros m1 e1 e Hm1 He.
+unfold Fsqrt_core.
+set (m' := Zmult _ _).
+assert (0 <= m')%Z as Hm'.
+{ apply Z.mul_nonneg_nonneg.
+  now apply Zlt_le_weak.
+  apply Zpower_ge_0. }
+assert (sqrt (F2R (Float beta m1 e1)) = sqrt (IZR m') * bpow e)%R as Hf.
+{ rewrite <- (sqrt_Rsqr (bpow e)) by apply bpow_ge_0.
+  rewrite <- sqrt_mult.
+  unfold Rsqr, m'.
+  rewrite mult_IZR, IZR_Zpower by omega.
+  rewrite Rmult_assoc, <- 2!bpow_plus.
+  now replace (_ + _)%Z with e1 by ring.
+  now apply IZR_le.
+  apply Rle_0_sqr. }
+generalize (Z.sqrtrem_spec m' Hm').
+destruct Z.sqrtrem as [q r].
+intros [Hq Hr].
+rewrite Hf.
+unfold inbetween_float, F2R. simpl Fnum.
+apply inbetween_mult_compat.
+apply bpow_gt_0.
+rewrite Hq.
+case Zeq_bool_spec ; intros Hr'.
+(* .. r = 0 *)
+rewrite Hr', Zplus_0_r, mult_IZR.
+fold (Rsqr (IZR q)).
+rewrite sqrt_Rsqr.
+now constructor.
+apply IZR_le.
+clear -Hr ; omega.
+(* .. r <> 0 *)
+constructor.
+split.
+(* ... bounds *)
+apply Rle_lt_trans with (sqrt (IZR (q * q))).
+rewrite mult_IZR.
+fold (Rsqr (IZR q)).
+rewrite sqrt_Rsqr.
+apply Rle_refl.
+apply IZR_le.
+clear -Hr ; omega.
+apply sqrt_lt_1.
+rewrite mult_IZR.
+apply Rle_0_sqr.
+rewrite <- Hq.
+now apply IZR_le.
+apply IZR_lt.
+omega.
+apply Rlt_le_trans with (sqrt (IZR ((q + 1) * (q + 1)))).
+apply sqrt_lt_1.
+rewrite <- Hq.
+now apply IZR_le.
+rewrite mult_IZR.
+apply Rle_0_sqr.
+apply IZR_lt.
+ring_simplify.
+omega.
+rewrite mult_IZR.
+fold (Rsqr (IZR (q + 1))).
+rewrite sqrt_Rsqr.
+apply Rle_refl.
+apply IZR_le.
+clear -Hr ; omega.
+(* ... location *)
+rewrite Rcompare_half_r.
+generalize (Rcompare_sqr (2 * sqrt (IZR (q * q + r))) (IZR q + IZR (q + 1))).
+rewrite 2!Rabs_pos_eq.
+intros <-.
+replace ((2 * sqrt (IZR (q * q + r))) * (2 * sqrt (IZR (q * q + r))))%R
+  with (4 * Rsqr (sqrt (IZR (q * q + r))))%R by (unfold Rsqr ; ring).
+rewrite Rsqr_sqrt.
+rewrite <- plus_IZR, <- 2!mult_IZR.
+rewrite Rcompare_IZR.
+replace ((q + (q + 1)) * (q + (q + 1)))%Z with (4 * (q * q) + 4 * q + 1)%Z by ring.
+generalize (Zle_cases r q).
+case (Zle_bool r q) ; intros Hr''.
+change (4 * (q * q + r) < 4 * (q * q) + 4 * q + 1)%Z.
+omega.
+change (4 * (q * q + r) > 4 * (q * q) + 4 * q + 1)%Z.
+omega.
+rewrite <- Hq.
+now apply IZR_le.
+rewrite <- plus_IZR.
+apply IZR_le.
+clear -Hr ; omega.
+apply Rmult_le_pos.
+now apply IZR_le.
+apply sqrt_ge_0.
+Qed.
+
+Definition Fsqrt (x : float beta) :=
+  let (m1, e1) := x in
+  let e' := (Zdigits beta m1 + e1 + 1)%Z in
+  let e := Z.min (fexp (Z.div2 e')) (Z.div2 e1) in
+  let '(m, l) := Fsqrt_core m1 e1 e in
+  (m, e, l).
+
+Theorem Fsqrt_correct :
+  forall x,
+  (0 < F2R x)%R ->
+  let '(m, e, l) := Fsqrt x in
+  (e <= cexp beta fexp (sqrt (F2R x)))%Z /\
+  inbetween_float beta m e (sqrt (F2R x)) l.
+Proof.
+intros [m1 e1] Hm1.
+apply gt_0_F2R in Hm1.
+unfold Fsqrt.
+set (e := Z.min _ _).
+assert (2 * e <= e1)%Z as He.
+{ assert (e <= Z.div2 e1)%Z by apply Z.le_min_r.
+  rewrite (Zdiv2_odd_eqn e1).
+  destruct Z.odd ; omega. }
+generalize (Fsqrt_core_correct m1 e1 e Hm1 He).
+destruct Fsqrt_core as [m l].
+apply conj.
+apply Z.le_trans with (1 := Z.le_min_l _ _).
+unfold cexp.
+rewrite (mag_sqrt_F2R m1 e1 Hm1).
+apply Z.le_refl.
+Qed.
+
+End Fcalc_sqrt.
diff --git a/flocq/Core/Fcore.v b/flocq/Core/Core.v
index 2a5a5f02..78a140e1 100644
--- a/flocq/Core/Fcore.v
+++ b/flocq/Core/Core.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2010-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2010-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,13 +18,5 @@ COPYING file for more details.
 *)
 
 (** To ease the import *)
-Require Export Fcore_Raux.
-Require Export Fcore_defs.
-Require Export Fcore_float_prop.
-Require Export Fcore_rnd.
-Require Export Fcore_generic_fmt.
-Require Export Fcore_rnd_ne.
-Require Export Fcore_FIX.
-Require Export Fcore_FLX.
-Require Export Fcore_FLT.
-Require Export Fcore_ulp.
+Require Export Raux Defs Float_prop Round_pred Generic_fmt Round_NE.
+Require Export FIX FLX FLT Ulp.
diff --git a/flocq/Core/Fcore_defs.v b/flocq/Core/Defs.v
index 01b868ab..f5c6f33b 100644
--- a/flocq/Core/Fcore_defs.v
+++ b/flocq/Core/Defs.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,20 +18,20 @@ COPYING file for more details.
 *)
 
 (** * Basic definitions: float and rounding property *)
-Require Import Fcore_Raux.
+Require Import Raux.
 
 Section Def.
 
 (** Definition of a floating-point number *)
 Record float (beta : radix) := Float { Fnum : Z ; Fexp : Z }.
 
-Arguments Fnum {beta} f.
-Arguments Fexp {beta} f.
+Arguments Fnum {beta}.
+Arguments Fexp {beta}.
 
 Variable beta : radix.
 
 Definition F2R (f : float beta) :=
-  (Z2R (Fnum f) * bpow beta (Fexp f))%R.
+  (IZR (Fnum f) * bpow beta (Fexp f))%R.
 
 (** Requirements on a rounding mode *)
 Definition round_pred_total (P : R -> R -> Prop) :=
@@ -46,9 +46,9 @@ Definition round_pred (P : R -> R -> Prop) :=
 
 End Def.
 
-Arguments Fnum {beta} f.
-Arguments Fexp {beta} f.
-Arguments F2R {beta} f.
+Arguments Fnum {beta}.
+Arguments Fexp {beta}.
+Arguments F2R {beta}.
 
 Section RND.
 
@@ -57,45 +57,27 @@ Definition Rnd_DN_pt (F : R -> Prop) (x f : R) :=
   F f /\ (f <= x)%R /\
   forall g : R, F g -> (g <= x)%R -> (g <= f)%R.
 
-Definition Rnd_DN (F : R -> Prop) (rnd : R -> R) :=
-  forall x : R, Rnd_DN_pt F x (rnd x).
-
 (** property of being a round toward +inf *)
 Definition Rnd_UP_pt (F : R -> Prop) (x f : R) :=
   F f /\ (x <= f)%R /\
   forall g : R, F g -> (x <= g)%R -> (f <= g)%R.
 
-Definition Rnd_UP (F : R -> Prop) (rnd : R -> R) :=
-  forall x : R, Rnd_UP_pt F x (rnd x).
-
 (** property of being a round toward zero *)
 Definition Rnd_ZR_pt (F : R -> Prop) (x f : R) :=
   ( (0 <= x)%R -> Rnd_DN_pt F x f ) /\
   ( (x <= 0)%R -> Rnd_UP_pt F x f ).
 
-Definition Rnd_ZR (F : R -> Prop) (rnd : R -> R) :=
-  forall x : R, Rnd_ZR_pt F x (rnd x).
-
 (** property of being a round to nearest *)
 Definition Rnd_N_pt (F : R -> Prop) (x f : R) :=
   F f /\
   forall g : R, F g -> (Rabs (f - x) <= Rabs (g - x))%R.
 
-Definition Rnd_N (F : R -> Prop) (rnd : R -> R) :=
-  forall x : R, Rnd_N_pt F x (rnd x).
-
 Definition Rnd_NG_pt (F : R -> Prop) (P : R -> R -> Prop) (x f : R) :=
   Rnd_N_pt F x f /\
   ( P x f \/ forall f2 : R, Rnd_N_pt F x f2 -> f2 = f ).
 
-Definition Rnd_NG (F : R -> Prop) (P : R -> R -> Prop) (rnd : R -> R) :=
-  forall x : R, Rnd_NG_pt F P x (rnd x).
-
 Definition Rnd_NA_pt (F : R -> Prop) (x f : R) :=
   Rnd_N_pt F x f /\
   forall f2 : R, Rnd_N_pt F x f2 -> (Rabs f2 <= Rabs f)%R.
 
-Definition Rnd_NA (F : R -> Prop) (rnd : R -> R) :=
-  forall x : R, Rnd_NA_pt F x (rnd x).
-
 End RND.
diff --git a/flocq/Core/Fcore_digits.v b/flocq/Core/Digits.v
index 53743035..bed2e20a 100644
--- a/flocq/Core/Fcore_digits.v
+++ b/flocq/Core/Digits.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2011-2013 Sylvie Boldo
+Copyright (C) 2011-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2011-2013 Guillaume Melquiond
+Copyright (C) 2011-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -17,9 +17,8 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 COPYING file for more details.
 *)
 
-Require Import ZArith.
-Require Import Zquot.
-Require Import Fcore_Zaux.
+Require Import ZArith Zquot.
+Require Import Zaux.
 
 (** Number of bits (radix 2) of a positive integer.
 
@@ -74,7 +73,7 @@ Qed.
 
 Theorem Zdigit_opp :
   forall n k,
-  Zdigit (-n) k = Zopp (Zdigit n k).
+  Zdigit (-n) k = Z.opp (Zdigit n k).
 Proof.
 intros n k.
 unfold Zdigit.
@@ -89,11 +88,11 @@ Theorem Zdigit_ge_Zpower_pos :
 Proof.
 intros e n Hn k Hk.
 unfold Zdigit.
-rewrite Zquot_small.
+rewrite Z.quot_small.
 apply Zrem_0_l.
 split.
 apply Hn.
-apply Zlt_le_trans with (1 := proj2 Hn).
+apply Z.lt_le_trans with (1 := proj2 Hn).
 replace k with (e + (k - e))%Z by ring.
 rewrite Zpower_plus.
 rewrite <- (Zmult_1_r (beta ^ e)) at 1.
@@ -102,8 +101,8 @@ apply (Zlt_le_succ 0).
 apply Zpower_gt_0.
 now apply Zle_minus_le_0.
 apply Zlt_le_weak.
-now apply Zle_lt_trans with n.
-generalize (Zle_lt_trans _ _ _ (proj1 Hn) (proj2 Hn)).
+now apply Z.le_lt_trans with n.
+generalize (Z.le_lt_trans _ _ _ (proj1 Hn) (proj2 Hn)).
 clear.
 now destruct e as [|e|e].
 now apply Zle_minus_le_0.
@@ -111,7 +110,7 @@ Qed.
 
 Theorem Zdigit_ge_Zpower :
   forall e n,
-  (Zabs n < Zpower beta e)%Z ->
+  (Z.abs n < Zpower beta e)%Z ->
   forall k, (e <= k)%Z -> Zdigit n k = Z0.
 Proof.
 intros e [|n|n] Hn k.
@@ -119,10 +118,10 @@ easy.
 apply Zdigit_ge_Zpower_pos.
 now split.
 intros He.
-change (Zneg n) with (Zopp (Zpos n)).
+change (Zneg n) with (Z.opp (Zpos n)).
 rewrite Zdigit_opp.
 rewrite Zdigit_ge_Zpower_pos with (2 := He).
-apply Zopp_0.
+apply Z.opp_0.
 now split.
 Qed.
 
@@ -134,17 +133,17 @@ Proof.
 intros e n He (Hn1,Hn2).
 unfold Zdigit.
 rewrite <- ZOdiv_mod_mult.
-rewrite Zrem_small.
+rewrite Z.rem_small.
 intros H.
 apply Zle_not_lt with (1 := Hn1).
 rewrite (Z.quot_rem' n (beta ^ e)).
 rewrite H, Zmult_0_r, Zplus_0_l.
 apply Zrem_lt_pos_pos.
-apply Zle_trans with (2 := Hn1).
+apply Z.le_trans with (2 := Hn1).
 apply Zpower_ge_0.
 now apply Zpower_gt_0.
 split.
-apply Zle_trans with (2 := Hn1).
+apply Z.le_trans with (2 := Hn1).
 apply Zpower_ge_0.
 replace (beta ^ e * beta)%Z with (beta ^ (e + 1))%Z.
 exact Hn2.
@@ -154,12 +153,12 @@ Qed.
 
 Theorem Zdigit_not_0 :
   forall e n, (0 <= e)%Z ->
-  (Zpower beta e <= Zabs n < Zpower beta (e + 1))%Z ->
+  (Zpower beta e <= Z.abs n < Zpower beta (e + 1))%Z ->
   Zdigit n e <> Z0.
 Proof.
 intros e n He Hn.
 destruct (Zle_or_lt 0 n) as [Hn'|Hn'].
-rewrite (Zabs_eq _ Hn') in Hn.
+rewrite (Z.abs_eq _ Hn') in Hn.
 now apply Zdigit_not_0_pos.
 intros H.
 rewrite (Zabs_non_eq n) in Hn by now apply Zlt_le_weak.
@@ -245,8 +244,8 @@ intros n k k' Hk.
 unfold Zdigit.
 rewrite ZOdiv_small_abs.
 apply Zrem_0_l.
-apply Zlt_le_trans with (Zpower beta k').
-rewrite <- (Zabs_eq (beta ^ k')) at 2 by apply Zpower_ge_0.
+apply Z.lt_le_trans with (Zpower beta k').
+rewrite <- (Z.abs_eq (beta ^ k')) at 2 by apply Zpower_ge_0.
 apply Zrem_lt.
 apply Zgt_not_eq.
 now apply Zpower_gt_0.
@@ -266,7 +265,7 @@ Proof.
 intros n.
 induction k.
 apply sym_eq.
-apply Zrem_1_r.
+apply Z.rem_1_r.
 simpl Zsum_digit.
 rewrite IHk.
 unfold Zdigit.
@@ -284,65 +283,35 @@ apply Zle_0_nat.
 easy.
 Qed.
 
-Theorem Zpower_gt_id :
-  forall n, (n < Zpower beta n)%Z.
-Proof.
-intros [|n|n] ; try easy.
-simpl.
-rewrite Zpower_pos_nat.
-rewrite Zpos_eq_Z_of_nat_o_nat_of_P.
-induction (nat_of_P n).
-easy.
-rewrite inj_S.
-change (Zpower_nat beta (S n0)) with (beta * Zpower_nat beta n0)%Z.
-unfold Zsucc.
-apply Zlt_le_trans with (beta * (Z_of_nat n0 + 1))%Z.
-clear.
-apply Zlt_0_minus_lt.
-replace (beta * (Z_of_nat n0 + 1) - (Z_of_nat n0 + 1))%Z with ((beta - 1) * (Z_of_nat n0 + 1))%Z by ring.
-apply Zmult_lt_0_compat.
-cut (2 <= beta)%Z. omega.
-apply Zle_bool_imp_le.
-apply beta.
-apply (Zle_lt_succ 0).
-apply Zle_0_nat.
-apply Zmult_le_compat_l.
-now apply Zlt_le_succ.
-apply Zle_trans with 2%Z.
-easy.
-apply Zle_bool_imp_le.
-apply beta.
-Qed.
-
 Theorem Zdigit_ext :
   forall n1 n2,
   (forall k, (0 <= k)%Z -> Zdigit n1 k = Zdigit n2 k) ->
   n1 = n2.
 Proof.
 intros n1 n2 H.
-rewrite <- (ZOmod_small_abs n1 (Zpower beta (Zmax (Zabs n1) (Zabs n2)))).
-rewrite <- (ZOmod_small_abs n2 (Zpower beta (Zmax (Zabs n1) (Zabs n2)))) at 2.
-replace (Zmax (Zabs n1) (Zabs n2)) with (Z_of_nat (Zabs_nat (Zmax (Zabs n1) (Zabs n2)))).
+rewrite <- (ZOmod_small_abs n1 (Zpower beta (Z.max (Z.abs n1) (Z.abs n2)))).
+rewrite <- (ZOmod_small_abs n2 (Zpower beta (Z.max (Z.abs n1) (Z.abs n2)))) at 2.
+replace (Z.max (Z.abs n1) (Z.abs n2)) with (Z_of_nat (Z.abs_nat (Z.max (Z.abs n1) (Z.abs n2)))).
 rewrite <- 2!Zsum_digit_digit.
-induction (Zabs_nat (Zmax (Zabs n1) (Zabs n2))).
+induction (Z.abs_nat (Z.max (Z.abs n1) (Z.abs n2))).
 easy.
 simpl.
 rewrite H, IHn.
 apply refl_equal.
 apply Zle_0_nat.
 rewrite inj_Zabs_nat.
-apply Zabs_eq.
-apply Zle_trans with (Zabs n1).
+apply Z.abs_eq.
+apply Z.le_trans with (Z.abs n1).
 apply Zabs_pos.
-apply Zle_max_l.
-apply Zlt_le_trans with (Zpower beta (Zabs n2)).
+apply Z.le_max_l.
+apply Z.lt_le_trans with (Zpower beta (Z.abs n2)).
 apply Zpower_gt_id.
 apply Zpower_le.
-apply Zle_max_r.
-apply Zlt_le_trans with (Zpower beta (Zabs n1)).
+apply Z.le_max_r.
+apply Z.lt_le_trans with (Zpower beta (Z.abs n1)).
 apply Zpower_gt_id.
 apply Zpower_le.
-apply Zle_max_l.
+apply Z.le_max_l.
 Qed.
 
 Theorem ZOmod_plus_pow_digit :
@@ -354,11 +323,11 @@ intros u v n Huv Hd.
 destruct (Zle_or_lt 0 n) as [Hn|Hn].
 rewrite Zplus_rem with (1 := Huv).
 apply ZOmod_small_abs.
-generalize (Zle_refl n).
-pattern n at -2 ; rewrite <- Zabs_eq with (1 := Hn).
+generalize (Z.le_refl n).
+pattern n at -2 ; rewrite <- Z.abs_eq with (1 := Hn).
 rewrite <- (inj_Zabs_nat n).
-induction (Zabs_nat n) as [|p IHp].
-now rewrite 2!Zrem_1_r.
+induction (Z.abs_nat n) as [|p IHp].
+now rewrite 2!Z.rem_1_r.
 rewrite <- 2!Zsum_digit_digit.
 simpl Zsum_digit.
 rewrite inj_S.
@@ -367,39 +336,39 @@ replace (Zsum_digit (Zdigit u) p + Zdigit u (Z_of_nat p) * beta ^ Z_of_nat p +
   (Zsum_digit (Zdigit v) p + Zdigit v (Z_of_nat p) * beta ^ Z_of_nat p))%Z with
   (Zsum_digit (Zdigit u) p + Zsum_digit (Zdigit v) p +
   (Zdigit u (Z_of_nat p) + Zdigit v (Z_of_nat p)) * beta ^ Z_of_nat p)%Z by ring.
-apply (Zle_lt_trans _ _ _ (Zabs_triangle _ _)).
-replace (beta ^ Zsucc (Z_of_nat p))%Z with (beta ^ Z_of_nat p + (beta - 1) * beta ^ Z_of_nat p)%Z.
+apply (Z.le_lt_trans _ _ _ (Z.abs_triangle _ _)).
+replace (beta ^ Z.succ (Z_of_nat p))%Z with (beta ^ Z_of_nat p + (beta - 1) * beta ^ Z_of_nat p)%Z.
 apply Zplus_lt_le_compat.
 rewrite 2!Zsum_digit_digit.
 apply IHp.
 now apply Zle_succ_le.
 rewrite Zabs_Zmult.
-rewrite (Zabs_eq (beta ^ Z_of_nat p)) by apply Zpower_ge_0.
+rewrite (Z.abs_eq (beta ^ Z_of_nat p)) by apply Zpower_ge_0.
 apply Zmult_le_compat_r. 2: apply Zpower_ge_0.
 apply Zlt_succ_le.
-assert (forall u v, Zabs (Zdigit u v) < Zsucc (beta -  1))%Z.
+assert (forall u v, Z.abs (Zdigit u v) < Z.succ (beta -  1))%Z.
 clear ; intros n k.
 assert (0 < beta)%Z.
-apply Zlt_le_trans with 2%Z.
+apply Z.lt_le_trans with 2%Z.
 apply refl_equal.
 apply Zle_bool_imp_le.
 apply beta.
-replace (Zsucc (beta - 1)) with (Zabs beta).
+replace (Z.succ (beta - 1)) with (Z.abs beta).
 apply Zrem_lt.
 now apply Zgt_not_eq.
-rewrite Zabs_eq.
+rewrite Z.abs_eq.
 apply Zsucc_pred.
 now apply Zlt_le_weak.
 assert (0 <= Z_of_nat p < n)%Z.
 split.
 apply Zle_0_nat.
-apply Zgt_lt.
+apply Z.gt_lt.
 now apply Zle_succ_gt.
 destruct (Hd (Z_of_nat p) H0) as [K|K] ; rewrite K.
 apply H.
 rewrite Zplus_0_r.
 apply H.
-unfold Zsucc.
+unfold Z.succ.
 ring_simplify.
 rewrite Zpower_plus.
 change (beta ^1)%Z with (beta * 1)%Z.
@@ -422,7 +391,7 @@ rewrite <- ZOmod_plus_pow_digit by assumption.
 apply f_equal.
 destruct (Zle_or_lt 0 n) as [Hn|Hn].
 apply ZOdiv_small_abs.
-rewrite <- Zabs_eq.
+rewrite <- Z.abs_eq.
 apply Zrem_lt.
 apply Zgt_not_eq.
 now apply Zpower_gt_0.
@@ -562,7 +531,7 @@ rewrite Zle_bool_true.
 rewrite Zdigit_mod_pow by apply Hk.
 rewrite Zdigit_scale by apply Hk.
 unfold Zminus.
-now rewrite Zopp_involutive, Zplus_comm.
+now rewrite Z.opp_involutive, Zplus_comm.
 omega.
 Qed.
 
@@ -608,13 +577,13 @@ Qed.
 
 Theorem Zslice_slice :
   forall n k1 k2 k1' k2', (0 <= k1' <= k2)%Z ->
-  Zslice (Zslice n k1 k2) k1' k2' = Zslice n (k1 + k1') (Zmin (k2 - k1') k2').
+  Zslice (Zslice n k1 k2) k1' k2' = Zslice n (k1 + k1') (Z.min (k2 - k1') k2').
 Proof.
 intros n k1 k2 k1' k2' Hk1'.
 destruct (Zle_or_lt 0 k2') as [Hk2'|Hk2'].
 apply Zdigit_ext.
 intros k Hk.
-destruct (Zle_or_lt (Zmin (k2 - k1') k2') k) as [Hk'|Hk'].
+destruct (Zle_or_lt (Z.min (k2 - k1') k2') k) as [Hk'|Hk'].
 rewrite (Zdigit_slice_out n (k1 + k1')) with (1 := Hk').
 destruct (Zle_or_lt k2' k) as [Hk''|Hk''].
 now apply Zdigit_slice_out.
@@ -627,7 +596,7 @@ rewrite Zdigit_slice.
 now rewrite Zplus_assoc.
 zify ; omega.
 unfold Zslice.
-rewrite Zmin_r.
+rewrite Z.min_r.
 now rewrite Zle_bool_false.
 omega.
 Qed.
@@ -659,11 +628,11 @@ replace k1 with Z0 by omega.
 case Zle_bool_spec ; intros Hk'.
 replace k with Z0 by omega.
 simpl.
-now rewrite Zquot_1_r.
-rewrite Zopp_involutive.
+now rewrite Z.quot_1_r.
+rewrite Z.opp_involutive.
 apply Zmult_1_r.
 rewrite Zle_bool_false by omega.
-rewrite 2!Zopp_involutive, Zplus_comm.
+rewrite 2!Z.opp_involutive, Zplus_comm.
 rewrite Zpower_plus by assumption.
 apply Zquot_Zquot.
 Qed.
@@ -689,7 +658,7 @@ apply Zdigit_ext.
 intros k' Hk'.
 rewrite Zdigit_scale with (1 := Hk').
 unfold Zminus.
-rewrite (Zplus_comm k'), Zopp_involutive.
+rewrite (Zplus_comm k'), Z.opp_involutive.
 destruct (Zle_or_lt k2 k') as [Hk2|Hk2].
 rewrite Zdigit_slice_out with (1 := Hk2).
 apply sym_eq.
@@ -770,7 +739,7 @@ Definition Zdigits n :=
 
 Theorem Zdigits_correct :
   forall n,
-  (Zpower beta (Zdigits n - 1) <= Zabs n < Zpower beta (Zdigits n))%Z.
+  (Zpower beta (Zdigits n - 1) <= Z.abs n < Zpower beta (Zdigits n))%Z.
 Proof.
 cut (forall p, Zpower beta (Zdigits (Zpos p) - 1) <= Zpos p < Zpower beta (Zdigits (Zpos p)))%Z.
 intros H [|n|n] ; try exact (H n).
@@ -779,7 +748,7 @@ intros n.
 simpl.
 (* *)
 assert (U: (Zpos n < Zpower beta (Z_of_nat (S (digits2_Pnat n))))%Z).
-apply Zlt_le_trans with (1 := proj2 (digits2_Pnat_correct n)).
+apply Z.lt_le_trans with (1 := proj2 (digits2_Pnat_correct n)).
 rewrite Zpower_Zpower_nat.
 rewrite Zabs_nat_Z_of_nat.
 induction (S (digits2_Pnat n)).
@@ -797,7 +766,7 @@ apply Zle_0_nat.
 (* *)
 revert U.
 rewrite inj_S.
-unfold Zsucc.
+unfold Z.succ.
 generalize (digits2_Pnat n).
 intros u U.
 pattern (radix_val beta) at 2 4 ; replace (radix_val beta) with (Zpower beta 1) by apply Zmult_1_r.
@@ -805,12 +774,12 @@ assert (V: (Zpower beta (1 - 1) <= Zpos n)%Z).
 now apply (Zlt_le_succ 0).
 generalize (conj V U).
 clear.
-generalize (Zle_refl 1).
+generalize (Z.le_refl 1).
 generalize 1%Z at 2 3 5 6 7 9 10.
 (* *)
 induction u.
 easy.
-rewrite inj_S; unfold Zsucc.
+rewrite inj_S; unfold Z.succ.
 simpl Zdigits_aux.
 intros v Hv U.
 case Zlt_bool_spec ; intros K.
@@ -829,20 +798,20 @@ Qed.
 
 Theorem Zdigits_unique :
   forall n d,
-  (Zpower beta (d - 1) <= Zabs n < Zpower beta d)%Z ->
+  (Zpower beta (d - 1) <= Z.abs n < Zpower beta d)%Z ->
   Zdigits n = d.
 Proof.
 intros n d Hd.
 assert (Hd' := Zdigits_correct n).
 apply Zle_antisym.
 apply (Zpower_lt_Zpower beta).
-now apply Zle_lt_trans with (Zabs n).
+now apply Z.le_lt_trans with (Z.abs n).
 apply (Zpower_lt_Zpower beta).
-now apply Zle_lt_trans with (Zabs n).
+now apply Z.le_lt_trans with (Z.abs n).
 Qed.
 
 Theorem Zdigits_abs :
-  forall n, Zdigits (Zabs n) = Zdigits n.
+  forall n, Zdigits (Z.abs n) = Zdigits n.
 Proof.
 now intros [|n|n].
 Qed.
@@ -852,10 +821,10 @@ Theorem Zdigits_gt_0 :
 Proof.
 intros n Zn.
 rewrite <- (Zdigits_abs n).
-assert (Hn: (0 < Zabs n)%Z).
+assert (Hn: (0 < Z.abs n)%Z).
 destruct n ; [|easy|easy].
 now elim Zn.
-destruct (Zabs n) as [|p|p] ; try easy ; clear.
+destruct (Z.abs n) as [|p|p] ; try easy ; clear.
 simpl.
 generalize 1%Z (radix_val beta) (refl_equal Lt : (0 < 1)%Z).
 induction (digits2_Pnat p).
@@ -872,7 +841,7 @@ Theorem Zdigits_ge_0 :
   forall n, (0 <= Zdigits n)%Z.
 Proof.
 intros n.
-destruct (Z_eq_dec n 0) as [H|H].
+destruct (Z.eq_dec n 0) as [H|H].
 now rewrite H.
 apply Zlt_le_weak.
 now apply Zdigits_gt_0.
@@ -908,8 +877,8 @@ unfold Zslice.
 rewrite Zle_bool_true with (1 := Hl).
 destruct (Zdigits_correct (Z.rem (Zscale n (- k)) (Zpower beta l))) as (H1,H2).
 apply Zpower_lt_Zpower with beta.
-apply Zle_lt_trans with (1 := H1).
-rewrite <- (Zabs_eq (beta ^ l)) at 2 by apply Zpower_ge_0.
+apply Z.le_lt_trans with (1 := H1).
+rewrite <- (Z.abs_eq (beta ^ l)) at 2 by apply Zpower_ge_0.
 apply Zrem_lt.
 apply Zgt_not_eq.
 now apply Zpower_gt_0.
@@ -923,7 +892,7 @@ Proof.
 intros m e Hm He.
 assert (H := Zdigits_correct m).
 apply Zdigits_unique.
-rewrite Z.abs_mul, Z.abs_pow, (Zabs_eq beta).
+rewrite Z.abs_mul, Z.abs_pow, (Z.abs_eq beta).
 2: now apply Zlt_le_weak, radix_gt_0.
 split.
 replace (Zdigits m + e - 1)%Z with (Zdigits m - 1 + e)%Z by ring.
@@ -976,18 +945,18 @@ Qed.
 Theorem Zpower_le_Zdigits :
   forall e x,
   (e < Zdigits x)%Z ->
-  (Zpower beta e <= Zabs x)%Z.
+  (Zpower beta e <= Z.abs x)%Z.
 Proof.
 intros e x Hex.
 destruct (Zdigits_correct x) as [H1 H2].
-apply Zle_trans with (2 := H1).
+apply Z.le_trans with (2 := H1).
 apply Zpower_le.
 clear -Hex ; omega.
 Qed.
 
 Theorem Zdigits_le_Zpower :
   forall e x,
-  (Zabs x < Zpower beta e)%Z ->
+  (Z.abs x < Zpower beta e)%Z ->
   (Zdigits x <= e)%Z.
 Proof.
 intros e x.
@@ -998,17 +967,17 @@ Qed.
 Theorem Zpower_gt_Zdigits :
   forall e x,
   (Zdigits x <= e)%Z ->
-  (Zabs x < Zpower beta e)%Z.
+  (Z.abs x < Zpower beta e)%Z.
 Proof.
 intros e x Hex.
 destruct (Zdigits_correct x) as [H1 H2].
-apply Zlt_le_trans with (1 := H2).
+apply Z.lt_le_trans with (1 := H2).
 now apply Zpower_le.
 Qed.
 
 Theorem Zdigits_gt_Zpower :
   forall e x,
-  (Zpower beta e <= Zabs x)%Z ->
+  (Zpower beta e <= Z.abs x)%Z ->
   (e < Zdigits x)%Z.
 Proof.
 intros e x Hex.
@@ -1029,17 +998,17 @@ Theorem Zdigits_mult_strong :
 Proof.
 intros x y Hx Hy.
 apply Zdigits_le_Zpower.
-rewrite Zabs_eq.
-apply Zlt_le_trans with ((x + 1) * (y + 1))%Z.
+rewrite Z.abs_eq.
+apply Z.lt_le_trans with ((x + 1) * (y + 1))%Z.
 ring_simplify.
-apply Zle_lt_succ, Zle_refl.
+apply Zle_lt_succ, Z.le_refl.
 rewrite Zpower_plus by apply Zdigits_ge_0.
 apply Zmult_le_compat.
 apply Zlt_le_succ.
-rewrite <- (Zabs_eq x) at 1 by easy.
+rewrite <- (Z.abs_eq x) at 1 by easy.
 apply Zdigits_correct.
 apply Zlt_le_succ.
-rewrite <- (Zabs_eq y) at 1 by easy.
+rewrite <- (Z.abs_eq y) at 1 by easy.
 apply Zdigits_correct.
 clear -Hx ; omega.
 clear -Hy ; omega.
@@ -1057,7 +1026,7 @@ intros x y.
 rewrite <- Zdigits_abs.
 rewrite <- (Zdigits_abs x).
 rewrite <- (Zdigits_abs y).
-apply Zle_trans with (Zdigits (Zabs x + Zabs y + Zabs x * Zabs y)).
+apply Z.le_trans with (Zdigits (Z.abs x + Z.abs y + Z.abs x * Z.abs y)).
 apply Zdigits_le.
 apply Zabs_pos.
 rewrite Zabs_Zmult.
@@ -1097,28 +1066,28 @@ intros m e Hm He.
 assert (H := Zdigits_correct m).
 apply Zdigits_unique.
 destruct (Zle_lt_or_eq _ _ (proj2 He)) as [He'|He'].
-  rewrite Zabs_eq in H by easy.
+  rewrite Z.abs_eq in H by easy.
   destruct H as [H1 H2].
-  rewrite Zabs_eq.
+  rewrite Z.abs_eq.
   split.
   replace (Zdigits m - e - 1)%Z with (Zdigits m - 1 - e)%Z by ring.
   rewrite Z.pow_sub_r.
   2: apply Zgt_not_eq, radix_gt_0.
   2: clear -He He' ; omega.
   apply Z_div_le with (2 := H1).
-  now apply Zlt_gt, Zpower_gt_0.
+  now apply Z.lt_gt, Zpower_gt_0.
   apply Zmult_lt_reg_r with (Zpower beta e).
   now apply Zpower_gt_0.
-  apply Zle_lt_trans with m.
+  apply Z.le_lt_trans with m.
   rewrite Zmult_comm.
   apply Z_mult_div_ge.
-  now apply Zlt_gt, Zpower_gt_0.
+  now apply Z.lt_gt, Zpower_gt_0.
   rewrite <- Zpower_plus.
   now replace (Zdigits m - e + e)%Z with (Zdigits m) by ring.
   now apply Zle_minus_le_0.
   apply He.
   apply Z_div_pos with (2 := Hm).
-  now apply Zlt_gt, Zpower_gt_0.
+  now apply Z.lt_gt, Zpower_gt_0.
 rewrite He'.
 rewrite (Zeq_minus _ (Zdigits m)) by reflexivity.
 simpl.
@@ -1126,7 +1095,7 @@ rewrite Zdiv_small.
 easy.
 split.
 exact Hm.
-now rewrite <- (Zabs_eq m) at 1.
+now rewrite <- (Z.abs_eq m) at 1.
 Qed.
 
 End Fcore_digits.
@@ -1143,7 +1112,7 @@ intros m.
 apply eq_sym, Zdigits_unique.
 rewrite <- Zpower_nat_Z.
 rewrite Nat2Z.inj_succ.
-change (_ - 1)%Z with (Zpred (Zsucc (Z.of_nat (digits2_Pnat m)))).
+change (_ - 1)%Z with (Z.pred (Z.succ (Z.of_nat (digits2_Pnat m)))).
 rewrite <- Zpred_succ.
 rewrite <- Zpower_nat_Z.
 apply digits2_Pnat_correct.
@@ -1152,8 +1121,8 @@ Qed.
 Fixpoint digits2_pos (n : positive) : positive :=
   match n with
   | xH => xH
-  | xO p => Psucc (digits2_pos p)
-  | xI p => Psucc (digits2_pos p)
+  | xO p => Pos.succ (digits2_pos p)
+  | xI p => Pos.succ (digits2_pos p)
   end.
 
 Theorem Zpos_digits2_pos :
diff --git a/flocq/Core/Fcore_FIX.v b/flocq/Core/FIX.v
index e224a64a..4e0a25e6 100644
--- a/flocq/Core/Fcore_FIX.v
+++ b/flocq/Core/FIX.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,12 +18,7 @@ COPYING file for more details.
 *)
 
 (** * Fixed-point format *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_rnd.
-Require Import Fcore_generic_fmt.
-Require Import Fcore_ulp.
-Require Import Fcore_rnd_ne.
+Require Import Raux Defs Round_pred Generic_fmt Ulp Round_NE.
 
 Section RND_FIX.
 
@@ -33,10 +28,9 @@ Notation bpow := (bpow beta).
 
 Variable emin : Z.
 
-(* fixed-point format with exponent emin *)
-Definition FIX_format (x : R) :=
-  exists f : float beta,
-  x = F2R f /\ (Fexp f = emin)%Z.
+Inductive FIX_format (x : R) : Prop :=
+  FIX_spec (f : float beta) :
+    x = F2R f -> (Fexp f = emin)%Z -> FIX_format x.
 
 Definition FIX_exp (e : Z) := emin.
 
@@ -49,16 +43,16 @@ unfold FIX_exp.
 split ; intros H.
 now apply Zlt_le_weak.
 split.
-apply Zle_refl.
+apply Z.le_refl.
 now intros _ _.
 Qed.
 
 Theorem generic_format_FIX :
   forall x, FIX_format x -> generic_format beta FIX_exp x.
 Proof.
-intros x ((xm, xe), (Hx1, Hx2)).
+intros x [[xm xe] Hx1 Hx2].
 rewrite Hx1.
-now apply generic_format_canonic.
+now apply generic_format_canonical.
 Qed.
 
 Theorem FIX_format_generic :
@@ -82,10 +76,11 @@ Qed.
 Global Instance FIX_exp_monotone : Monotone_exp FIX_exp.
 Proof.
 intros ex ey H.
-apply Zle_refl.
+apply Z.le_refl.
 Qed.
 
-Theorem ulp_FIX: forall x, ulp beta FIX_exp x = bpow emin.
+Theorem ulp_FIX :
+  forall x, ulp beta FIX_exp x = bpow emin.
 Proof.
 intros x; unfold ulp.
 case Req_bool_spec; intros Zx.
@@ -96,5 +91,4 @@ intros n _; reflexivity.
 reflexivity.
 Qed.
 
-
 End RND_FIX.
diff --git a/flocq/Core/Fcore_FLT.v b/flocq/Core/FLT.v
index 2258b1d9..bd48d4b7 100644
--- a/flocq/Core/Fcore_FLT.v
+++ b/flocq/Core/FLT.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,15 +18,9 @@ COPYING file for more details.
 *)
 
 (** * Floating-point format with gradual underflow *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_rnd.
-Require Import Fcore_generic_fmt.
-Require Import Fcore_float_prop.
-Require Import Fcore_FLX.
-Require Import Fcore_FIX.
-Require Import Fcore_ulp.
-Require Import Fcore_rnd_ne.
+Require Import Raux Defs Round_pred Generic_fmt Float_prop.
+Require Import FLX FIX Ulp Round_NE.
+Require Import Psatz.
 
 Section RND_FLT.
 
@@ -38,12 +32,12 @@ Variable emin prec : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 
-(* floating-point format with gradual underflow *)
-Definition FLT_format (x : R) :=
-  exists f : float beta,
-  x = F2R f /\ (Zabs (Fnum f) < Zpower beta prec)%Z /\ (emin <= Fexp f)%Z.
+Inductive FLT_format (x : R) : Prop :=
+  FLT_spec (f : float beta) :
+    x = F2R f -> (Z.abs (Fnum f) < Zpower beta prec)%Z ->
+    (emin <= Fexp f)%Z -> FLT_format x.
 
-Definition FLT_exp e := Zmax (e - prec) emin.
+Definition FLT_exp e := Z.max (e - prec) emin.
 
 (** Properties of the FLT format *)
 Global Instance FLT_exp_valid : Valid_exp FLT_exp.
@@ -59,17 +53,17 @@ Theorem generic_format_FLT :
   forall x, FLT_format x -> generic_format beta FLT_exp x.
 Proof.
 clear prec_gt_0_.
-intros x ((mx, ex), (H1, (H2, H3))).
+intros x [[mx ex] H1 H2 H3].
 simpl in H2, H3.
 rewrite H1.
 apply generic_format_F2R.
 intros Zmx.
-unfold canonic_exp, FLT_exp.
-rewrite ln_beta_F2R with (1 := Zmx).
-apply Zmax_lub with (2 := H3).
+unfold cexp, FLT_exp.
+rewrite mag_F2R with (1 := Zmx).
+apply Z.max_lub with (2 := H3).
 apply Zplus_le_reg_r with (prec - ex)%Z.
 ring_simplify.
-now apply ln_beta_le_Zpower.
+now apply mag_le_Zpower.
 Qed.
 
 Theorem FLT_format_generic :
@@ -77,32 +71,32 @@ Theorem FLT_format_generic :
 Proof.
 intros x.
 unfold generic_format.
-set (ex := canonic_exp beta FLT_exp x).
+set (ex := cexp beta FLT_exp x).
 set (mx := Ztrunc (scaled_mantissa beta FLT_exp x)).
 intros Hx.
 rewrite Hx.
 eexists ; repeat split ; simpl.
-apply lt_Z2R.
-rewrite Z2R_Zpower. 2: now apply Zlt_le_weak.
+apply lt_IZR.
+rewrite IZR_Zpower. 2: now apply Zlt_le_weak.
 apply Rmult_lt_reg_r with (bpow ex).
 apply bpow_gt_0.
 rewrite <- bpow_plus.
-change (F2R (Float beta (Zabs mx) ex) < bpow (prec + ex))%R.
+change (F2R (Float beta (Z.abs mx) ex) < bpow (prec + ex))%R.
 rewrite F2R_Zabs.
 rewrite <- Hx.
 destruct (Req_dec x 0) as [Hx0|Hx0].
 rewrite Hx0, Rabs_R0.
 apply bpow_gt_0.
-unfold canonic_exp in ex.
-destruct (ln_beta beta x) as (ex', He).
+unfold cexp in ex.
+destruct (mag beta x) as (ex', He).
 simpl in ex.
 specialize (He Hx0).
 apply Rlt_le_trans with (1 := proj2 He).
 apply bpow_le.
 cut (ex' - prec <= ex)%Z. omega.
 unfold ex, FLT_exp.
-apply Zle_max_l.
-apply Zle_max_r.
+apply Z.le_max_l.
+apply Z.le_max_r.
 Qed.
 
 
@@ -128,18 +122,18 @@ apply FLT_format_generic.
 apply generic_format_FLT.
 Qed.
 
-Theorem canonic_exp_FLT_FLX :
+Theorem cexp_FLT_FLX :
   forall x,
   (bpow (emin + prec - 1) <= Rabs x)%R ->
-  canonic_exp beta FLT_exp x = canonic_exp beta (FLX_exp prec) x.
+  cexp beta FLT_exp x = cexp beta (FLX_exp prec) x.
 Proof.
 intros x Hx.
 assert (Hx0: x <> 0%R).
 intros H1; rewrite H1, Rabs_R0 in Hx.
 contradict Hx; apply Rlt_not_le, bpow_gt_0.
-unfold canonic_exp.
+unfold cexp.
 apply Zmax_left.
-destruct (ln_beta beta x) as (ex, He).
+destruct (mag beta x) as (ex, He).
 unfold FLX_exp. simpl.
 specialize (He Hx0).
 cut (emin + prec - 1 < ex)%Z. omega.
@@ -160,7 +154,7 @@ destruct (Req_dec x 0) as [Hx0|Hx0].
 rewrite Hx0.
 apply generic_format_0.
 unfold generic_format, scaled_mantissa.
-now rewrite canonic_exp_FLT_FLX.
+now rewrite cexp_FLT_FLX.
 Qed.
 
 Theorem generic_format_FLX_FLT :
@@ -173,29 +167,30 @@ unfold generic_format in Hx; rewrite Hx.
 apply generic_format_F2R.
 intros _.
 rewrite <- Hx.
-unfold canonic_exp, FLX_exp, FLT_exp.
-apply Zle_max_l.
+unfold cexp, FLX_exp, FLT_exp.
+apply Z.le_max_l.
 Qed.
 
 Theorem round_FLT_FLX : forall rnd x,
   (bpow (emin + prec - 1) <= Rabs x)%R ->
   round beta FLT_exp rnd x = round beta (FLX_exp prec) rnd x.
+Proof.
 intros rnd x Hx.
 unfold round, scaled_mantissa.
-rewrite canonic_exp_FLT_FLX ; trivial.
+rewrite cexp_FLT_FLX ; trivial.
 Qed.
 
 (** Links between FLT and FIX (underflow) *)
-Theorem canonic_exp_FLT_FIX :
+Theorem cexp_FLT_FIX :
   forall x, x <> 0%R ->
   (Rabs x < bpow (emin + prec))%R ->
-  canonic_exp beta FLT_exp x = canonic_exp beta (FIX_exp emin) x.
+  cexp beta FLT_exp x = cexp beta (FIX_exp emin) x.
 Proof.
 intros x Hx0 Hx.
-unfold canonic_exp.
+unfold cexp.
 apply Zmax_right.
 unfold FIX_exp.
-destruct (ln_beta beta x) as (ex, Hex).
+destruct (mag beta x) as (ex, Hex).
 simpl.
 cut (ex - 1 < emin + prec)%Z. omega.
 apply (lt_bpow beta).
@@ -214,7 +209,7 @@ rewrite Hx.
 apply generic_format_F2R.
 intros _.
 rewrite <- Hx.
-apply Zle_max_r.
+apply Z.le_max_r.
 Qed.
 
 Theorem generic_format_FLT_FIX :
@@ -226,9 +221,37 @@ Proof with auto with typeclass_instances.
 apply generic_inclusion_le...
 intros e He.
 unfold FIX_exp.
-apply Zmax_lub.
+apply Z.max_lub.
 omega.
-apply Zle_refl.
+apply Z.le_refl.
+Qed.
+
+Lemma negligible_exp_FLT :
+  exists n, negligible_exp FLT_exp = Some n /\ (n <= emin)%Z.
+Proof.
+case (negligible_exp_spec FLT_exp).
+{ intro H; exfalso; specialize (H emin); revert H.
+  apply Zle_not_lt, Z.le_max_r. }
+intros n Hn; exists n; split; [now simpl|].
+destruct (Z.max_spec (n - prec) emin) as [(Hm, Hm')|(Hm, Hm')].
+{ now revert Hn; unfold FLT_exp; rewrite Hm'. }
+revert Hn prec_gt_0_; unfold FLT_exp, Prec_gt_0; rewrite Hm'; lia.
+Qed.
+
+Theorem generic_format_FLT_1 (Hemin : (emin <= 0)%Z) :
+  generic_format beta FLT_exp 1.
+Proof.
+unfold generic_format, scaled_mantissa, cexp, F2R; simpl.
+rewrite Rmult_1_l, (mag_unique beta 1 1).
+{ unfold FLT_exp.
+  destruct (Z.max_spec_le (1 - prec) emin) as [(H,Hm)|(H,Hm)]; rewrite Hm;
+    (rewrite <- IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; omega]);
+    (rewrite Ztrunc_IZR, IZR_Zpower, <-bpow_plus;
+     [|unfold Prec_gt_0 in prec_gt_0_; omega]);
+    now replace (_ + _)%Z with Z0 by ring. }
+rewrite Rabs_R1; simpl; split; [now right|].
+rewrite IZR_Zpower_pos; simpl; rewrite Rmult_1_r; apply IZR_lt.
+apply (Z.lt_le_trans _ 2); [omega|]; apply Zle_bool_imp_le, beta.
 Qed.
 
 Theorem ulp_FLT_small: forall x, (Rabs x < bpow (emin+prec))%R ->
@@ -240,7 +263,7 @@ unfold ulp; case Req_bool_spec; intros Hx2.
 case (negligible_exp_spec FLT_exp).
 intros T; specialize (T (emin-1)%Z); contradict T.
 apply Zle_not_lt; unfold FLT_exp.
-apply Zle_trans with (2:=Z.le_max_r _ _); omega.
+apply Z.le_trans with (2:=Z.le_max_r _ _); omega.
 assert (V:FLT_exp emin = emin).
 unfold FLT_exp; apply Z.max_r.
 unfold Prec_gt_0 in prec_gt_0_; omega.
@@ -248,10 +271,10 @@ intros n H2; rewrite <-V.
 apply f_equal, fexp_negligible_exp_eq...
 omega.
 (* x <> 0 *)
-apply f_equal; unfold canonic_exp, FLT_exp.
+apply f_equal; unfold cexp, FLT_exp.
 apply Z.max_r.
-assert (ln_beta beta x-1 < emin+prec)%Z;[idtac|omega].
-destruct (ln_beta beta x) as (e,He); simpl.
+assert (mag beta x-1 < emin+prec)%Z;[idtac|omega].
+destruct (mag beta x) as (e,He); simpl.
 apply lt_bpow with beta.
 apply Rle_lt_trans with (2:=Hx).
 now apply He.
@@ -266,8 +289,8 @@ assert (Zx : (x <> 0)%R).
   intros Z; contradict Hx; apply Rgt_not_le, Rlt_gt.
   rewrite Z, Rabs_R0; apply bpow_gt_0.
 rewrite ulp_neq_0 with (1 := Zx).
-unfold canonic_exp, FLT_exp.
-destruct (ln_beta beta x) as (e,He).
+unfold cexp, FLT_exp.
+destruct (mag beta x) as (e,He).
 apply Rle_trans with (bpow (e-1)*bpow (1-prec))%R.
 rewrite <- bpow_plus.
 right; apply f_equal.
@@ -289,17 +312,68 @@ intros x; case (Req_dec x 0); intros Hx.
 rewrite Hx, ulp_FLT_small, Rabs_R0, Rmult_0_l; try apply bpow_gt_0.
 rewrite Rabs_R0; apply bpow_gt_0.
 rewrite ulp_neq_0; try exact Hx.
-unfold canonic_exp, FLT_exp.
-apply Rlt_le_trans with (bpow (ln_beta beta x)*bpow (-prec))%R.
+unfold cexp, FLT_exp.
+apply Rlt_le_trans with (bpow (mag beta x)*bpow (-prec))%R.
 apply Rmult_lt_compat_r.
 apply bpow_gt_0.
-now apply bpow_ln_beta_gt.
+now apply bpow_mag_gt.
 rewrite <- bpow_plus.
 apply bpow_le.
 apply Z.le_max_l.
 Qed.
 
+Lemma ulp_FLT_exact_shift :
+  forall x e,
+  (x <> 0)%R ->
+  (emin + prec <= mag beta x)%Z ->
+  (emin + prec - mag beta x <= e)%Z ->
+  (ulp beta FLT_exp (x * bpow e) = ulp beta FLT_exp x * bpow e)%R.
+Proof.
+intros x e Nzx Hmx He.
+unfold ulp; rewrite Req_bool_false;
+  [|now intro H; apply Nzx, (Rmult_eq_reg_r (bpow e));
+    [rewrite Rmult_0_l|apply Rgt_not_eq, Rlt_gt, bpow_gt_0]].
+rewrite (Req_bool_false _ _ Nzx), <- bpow_plus; f_equal; unfold cexp, FLT_exp.
+rewrite (mag_mult_bpow _ _ _ Nzx), !Z.max_l; omega.
+Qed.
+
+Lemma succ_FLT_exact_shift_pos :
+  forall x e,
+  (0 < x)%R ->
+  (emin + prec <= mag beta x)%Z ->
+  (emin + prec - mag beta x <= e)%Z ->
+  (succ beta FLT_exp (x * bpow e) = succ beta FLT_exp x * bpow e)%R.
+Proof.
+intros x e Px Hmx He.
+rewrite succ_eq_pos; [|now apply Rlt_le, Rmult_lt_0_compat, bpow_gt_0].
+rewrite (succ_eq_pos _ _ _ (Rlt_le _ _ Px)).
+now rewrite Rmult_plus_distr_r; f_equal; apply ulp_FLT_exact_shift; [lra| |].
+Qed.
 
+Lemma succ_FLT_exact_shift :
+  forall x e,
+  (x <> 0)%R ->
+  (emin + prec + 1 <= mag beta x)%Z ->
+  (emin + prec - mag beta x + 1 <= e)%Z ->
+  (succ beta FLT_exp (x * bpow e) = succ beta FLT_exp x * bpow e)%R.
+Proof.
+intros x e Nzx Hmx He.
+destruct (Rle_or_lt 0 x) as [Px|Nx].
+{ now apply succ_FLT_exact_shift_pos; [lra|lia|lia]. }
+unfold succ.
+rewrite Rle_bool_false; [|assert (H := bpow_gt_0 beta e); nra].
+rewrite Rle_bool_false; [|now simpl].
+rewrite Ropp_mult_distr_l_reverse, <-Ropp_mult_distr_l_reverse; f_equal.
+unfold pred_pos.
+rewrite mag_mult_bpow; [|lra].
+replace (_ - 1)%Z with (mag beta (- x) - 1 + e)%Z; [|ring]; rewrite bpow_plus.
+unfold Req_bool; rewrite Rcompare_mult_r; [|now apply bpow_gt_0].
+fold (Req_bool (-x) (bpow (mag beta (-x) - 1))); case Req_bool.
+{ rewrite mag_opp; unfold FLT_exp; do 2 (rewrite Z.max_l; [|lia]).
+  replace (_ - _)%Z with (mag beta x - 1 - prec + e)%Z; [|ring].
+  rewrite bpow_plus; ring. }
+rewrite ulp_FLT_exact_shift; [ring|lra| |]; rewrite mag_opp; lia.
+Qed.
 
 (** FLT is a nice format: it has a monotone exponent... *)
 Global Instance FLT_exp_monotone : Monotone_exp FLT_exp.
@@ -310,7 +384,7 @@ zify ; omega.
 Qed.
 
 (** and it allows a rounding to nearest, ties to even. *)
-Hypothesis NE_prop : Zeven beta = false \/ (1 < prec)%Z.
+Hypothesis NE_prop : Z.even beta = false \/ (1 < prec)%Z.
 
 Global Instance exists_NE_FLT : Exists_NE beta FLT_exp.
 Proof.
diff --git a/flocq/Core/FLX.v b/flocq/Core/FLX.v
new file mode 100644
index 00000000..803d96ef
--- /dev/null
+++ b/flocq/Core/FLX.v
@@ -0,0 +1,362 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2009-2018 Sylvie Boldo
+#<br />#
+Copyright (C) 2009-2018 Guillaume Melquiond
+
+This library is free software; you can redistribute it and/or
+modify it 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.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+COPYING file for more details.
+*)
+
+(** * Floating-point format without underflow *)
+Require Import Raux Defs Round_pred Generic_fmt Float_prop.
+Require Import FIX Ulp Round_NE.
+Require Import Psatz.
+
+Section RND_FLX.
+
+Variable beta : radix.
+
+Notation bpow e := (bpow beta e).
+
+Variable prec : Z.
+
+Class Prec_gt_0 :=
+  prec_gt_0 : (0 < prec)%Z.
+
+Context { prec_gt_0_ : Prec_gt_0 }.
+
+Inductive FLX_format (x : R) : Prop :=
+  FLX_spec (f : float beta) :
+    x = F2R f -> (Z.abs (Fnum f) < Zpower beta prec)%Z -> FLX_format x.
+
+Definition FLX_exp (e : Z) := (e - prec)%Z.
+
+(** Properties of the FLX format *)
+
+Global Instance FLX_exp_valid : Valid_exp FLX_exp.
+Proof.
+intros k.
+unfold FLX_exp.
+generalize prec_gt_0.
+repeat split ; intros ; omega.
+Qed.
+
+Theorem FIX_format_FLX :
+  forall x e,
+  (bpow (e - 1) <= Rabs x <= bpow e)%R ->
+  FLX_format x ->
+  FIX_format beta (e - prec) x.
+Proof.
+clear prec_gt_0_.
+intros x e Hx [[xm xe] H1 H2].
+rewrite H1, (F2R_prec_normalize beta xm xe e prec).
+now eexists.
+exact H2.
+now rewrite <- H1.
+Qed.
+
+Theorem FLX_format_generic :
+  forall x, generic_format beta FLX_exp x -> FLX_format x.
+Proof.
+intros x H.
+rewrite H.
+eexists ; repeat split.
+simpl.
+apply lt_IZR.
+rewrite abs_IZR.
+rewrite <- scaled_mantissa_generic with (1 := H).
+rewrite <- scaled_mantissa_abs.
+apply Rmult_lt_reg_r with (bpow (cexp beta FLX_exp (Rabs x))).
+apply bpow_gt_0.
+rewrite scaled_mantissa_mult_bpow.
+rewrite IZR_Zpower, <- bpow_plus.
+2: now apply Zlt_le_weak.
+unfold cexp, FLX_exp.
+ring_simplify (prec + (mag beta (Rabs x) - prec))%Z.
+rewrite mag_abs.
+destruct (Req_dec x 0) as [Hx|Hx].
+rewrite Hx, Rabs_R0.
+apply bpow_gt_0.
+destruct (mag beta x) as (ex, Ex).
+now apply Ex.
+Qed.
+
+Theorem generic_format_FLX :
+  forall x, FLX_format x -> generic_format beta FLX_exp x.
+Proof.
+clear prec_gt_0_.
+intros x [[mx ex] H1 H2].
+simpl in H2.
+rewrite H1.
+apply generic_format_F2R.
+intros Zmx.
+unfold cexp, FLX_exp.
+rewrite mag_F2R with (1 := Zmx).
+apply Zplus_le_reg_r with (prec - ex)%Z.
+ring_simplify.
+now apply mag_le_Zpower.
+Qed.
+
+Theorem FLX_format_satisfies_any :
+  satisfies_any FLX_format.
+Proof.
+refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLX_exp)).
+intros x.
+split.
+apply FLX_format_generic.
+apply generic_format_FLX.
+Qed.
+
+Theorem FLX_format_FIX :
+  forall x e,
+  (bpow (e - 1) <= Rabs x <= bpow e)%R ->
+  FIX_format beta (e - prec) x ->
+  FLX_format x.
+Proof with auto with typeclass_instances.
+intros x e Hx Fx.
+apply FLX_format_generic.
+apply generic_format_FIX in Fx.
+revert Fx.
+apply generic_inclusion with (e := e)...
+apply Z.le_refl.
+Qed.
+
+(** unbounded floating-point format with normal mantissas *)
+Inductive FLXN_format (x : R) : Prop :=
+  FLXN_spec (f : float beta) :
+    x = F2R f ->
+    (x <> 0%R -> Zpower beta (prec - 1) <= Z.abs (Fnum f) < Zpower beta prec)%Z ->
+    FLXN_format x.
+
+Theorem generic_format_FLXN :
+  forall x, FLXN_format x -> generic_format beta FLX_exp x.
+Proof.
+intros x [[xm ex] H1 H2].
+destruct (Req_dec x 0) as [Zx|Zx].
+rewrite Zx.
+apply generic_format_0.
+specialize (H2 Zx).
+apply generic_format_FLX.
+rewrite H1.
+eexists ; repeat split.
+apply H2.
+Qed.
+
+Theorem FLXN_format_generic :
+  forall x, generic_format beta FLX_exp x -> FLXN_format x.
+Proof.
+intros x Hx.
+rewrite Hx.
+simpl.
+eexists. easy.
+rewrite <- Hx.
+intros Zx.
+simpl.
+split.
+(* *)
+apply le_IZR.
+rewrite IZR_Zpower.
+2: now apply Zlt_0_le_0_pred.
+rewrite abs_IZR, <- scaled_mantissa_generic with (1 := Hx).
+apply Rmult_le_reg_r with (bpow (cexp beta FLX_exp x)).
+apply bpow_gt_0.
+rewrite <- bpow_plus.
+rewrite <- scaled_mantissa_abs.
+rewrite <- cexp_abs.
+rewrite scaled_mantissa_mult_bpow.
+unfold cexp, FLX_exp.
+rewrite mag_abs.
+ring_simplify (prec - 1 + (mag beta x - prec))%Z.
+destruct (mag beta x) as (ex,Ex).
+now apply Ex.
+(* *)
+apply lt_IZR.
+rewrite IZR_Zpower.
+2: now apply Zlt_le_weak.
+rewrite abs_IZR, <- scaled_mantissa_generic with (1 := Hx).
+apply Rmult_lt_reg_r with (bpow (cexp beta FLX_exp x)).
+apply bpow_gt_0.
+rewrite <- bpow_plus.
+rewrite <- scaled_mantissa_abs.
+rewrite <- cexp_abs.
+rewrite scaled_mantissa_mult_bpow.
+unfold cexp, FLX_exp.
+rewrite mag_abs.
+ring_simplify (prec + (mag beta x - prec))%Z.
+destruct (mag beta x) as (ex,Ex).
+now apply Ex.
+Qed.
+
+Theorem FLXN_format_satisfies_any :
+  satisfies_any FLXN_format.
+Proof.
+refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLX_exp)).
+split ; intros H.
+now apply FLXN_format_generic.
+now apply generic_format_FLXN.
+Qed.
+
+Lemma negligible_exp_FLX :
+   negligible_exp FLX_exp = None.
+Proof.
+case (negligible_exp_spec FLX_exp).
+intros _; reflexivity.
+intros n H2; contradict H2.
+unfold FLX_exp; unfold Prec_gt_0 in prec_gt_0_; omega.
+Qed.
+
+Theorem generic_format_FLX_1 :
+  generic_format beta FLX_exp 1.
+Proof.
+unfold generic_format, scaled_mantissa, cexp, F2R; simpl.
+rewrite Rmult_1_l, (mag_unique beta 1 1).
+{ unfold FLX_exp.
+  rewrite <- IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; omega].
+  rewrite Ztrunc_IZR, IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; omega].
+  rewrite <- bpow_plus.
+  now replace (_ + _)%Z with Z0 by ring. }
+rewrite Rabs_R1; simpl; split; [now right|].
+unfold Z.pow_pos; simpl; rewrite Zmult_1_r; apply IZR_lt.
+assert (H := Zle_bool_imp_le _ _ (radix_prop beta)); omega.
+Qed.
+
+Theorem ulp_FLX_0: (ulp beta FLX_exp 0 = 0)%R.
+Proof.
+unfold ulp; rewrite Req_bool_true; trivial.
+rewrite negligible_exp_FLX; easy.
+Qed.
+
+Lemma ulp_FLX_1 : ulp beta FLX_exp 1 = bpow (-prec + 1).
+Proof.
+unfold ulp, FLX_exp, cexp; rewrite Req_bool_false; [|apply R1_neq_R0].
+rewrite mag_1; f_equal; ring.
+Qed.
+
+Lemma succ_FLX_1 : (succ beta FLX_exp 1 = 1 + bpow (-prec + 1))%R.
+Proof.
+now unfold succ; rewrite Rle_bool_true; [|apply Rle_0_1]; rewrite ulp_FLX_1.
+Qed.
+
+Theorem eq_0_round_0_FLX :
+   forall rnd {Vr: Valid_rnd rnd} x,
+     round beta FLX_exp rnd x = 0%R -> x = 0%R.
+Proof.
+intros rnd Hr x.
+apply eq_0_round_0_negligible_exp; try assumption.
+apply FLX_exp_valid.
+apply negligible_exp_FLX.
+Qed.
+
+Theorem gt_0_round_gt_0_FLX :
+   forall rnd {Vr: Valid_rnd rnd} x,
+     (0 < x)%R -> (0 < round beta FLX_exp rnd x)%R.
+Proof with auto with typeclass_instances.
+intros rnd Hr x Hx.
+assert (K: (0 <= round beta FLX_exp rnd x)%R).
+rewrite <- (round_0 beta FLX_exp rnd).
+apply round_le... now apply Rlt_le.
+destruct K; try easy.
+absurd (x = 0)%R.
+now apply Rgt_not_eq.
+apply eq_0_round_0_FLX with rnd...
+Qed.
+
+
+Theorem ulp_FLX_le :
+  forall x, (ulp beta FLX_exp x <= Rabs x * bpow (1-prec))%R.
+Proof.
+intros x; case (Req_dec x 0); intros Hx.
+rewrite Hx, ulp_FLX_0, Rabs_R0.
+right; ring.
+rewrite ulp_neq_0; try exact Hx.
+unfold cexp, FLX_exp.
+replace (mag beta x - prec)%Z with ((mag beta x - 1) + (1-prec))%Z by ring.
+rewrite bpow_plus.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+now apply bpow_mag_le.
+Qed.
+
+Theorem ulp_FLX_ge :
+  forall x, (Rabs x * bpow (-prec) <= ulp beta FLX_exp x)%R.
+Proof.
+intros x; case (Req_dec x 0); intros Hx.
+rewrite Hx, ulp_FLX_0, Rabs_R0.
+right; ring.
+rewrite ulp_neq_0; try exact Hx.
+unfold cexp, FLX_exp.
+unfold Zminus; rewrite bpow_plus.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+left; now apply bpow_mag_gt.
+Qed.
+
+Lemma ulp_FLX_exact_shift :
+  forall x e,
+  (ulp beta FLX_exp (x * bpow e) = ulp beta FLX_exp x * bpow e)%R.
+Proof.
+intros x e.
+destruct (Req_dec x 0) as [Hx|Hx].
+{ unfold ulp.
+  now rewrite !Req_bool_true, negligible_exp_FLX; rewrite ?Hx, ?Rmult_0_l. }
+unfold ulp; rewrite Req_bool_false;
+  [|now intro H; apply Hx, (Rmult_eq_reg_r (bpow e));
+    [rewrite Rmult_0_l|apply Rgt_not_eq, Rlt_gt, bpow_gt_0]].
+rewrite (Req_bool_false _ _ Hx), <- bpow_plus; f_equal; unfold cexp, FLX_exp.
+now rewrite mag_mult_bpow; [ring|].
+Qed.
+
+Lemma succ_FLX_exact_shift :
+  forall x e,
+  (succ beta FLX_exp (x * bpow e) = succ beta FLX_exp x * bpow e)%R.
+Proof.
+intros x e.
+destruct (Rle_or_lt 0 x) as [Px|Nx].
+{ rewrite succ_eq_pos; [|now apply Rmult_le_pos, bpow_ge_0].
+  rewrite (succ_eq_pos _ _ _ Px).
+  now rewrite Rmult_plus_distr_r; f_equal; apply ulp_FLX_exact_shift. }
+unfold succ.
+rewrite Rle_bool_false; [|assert (H := bpow_gt_0 beta e); nra].
+rewrite Rle_bool_false; [|now simpl].
+rewrite Ropp_mult_distr_l_reverse, <-Ropp_mult_distr_l_reverse; f_equal.
+unfold pred_pos.
+rewrite mag_mult_bpow; [|lra].
+replace (_ - 1)%Z with (mag beta (- x) - 1 + e)%Z; [|ring]; rewrite bpow_plus.
+unfold Req_bool; rewrite Rcompare_mult_r; [|now apply bpow_gt_0].
+fold (Req_bool (-x) (bpow (mag beta (-x) - 1))); case Req_bool.
+{ unfold FLX_exp.
+  replace (_ - _)%Z with (mag beta (- x) - 1 - prec + e)%Z; [|ring].
+  rewrite bpow_plus; ring. }
+rewrite ulp_FLX_exact_shift; ring.
+Qed.
+
+(** FLX is a nice format: it has a monotone exponent... *)
+Global Instance FLX_exp_monotone : Monotone_exp FLX_exp.
+Proof.
+intros ex ey Hxy.
+now apply Zplus_le_compat_r.
+Qed.
+
+(** and it allows a rounding to nearest, ties to even. *)
+Hypothesis NE_prop : Z.even beta = false \/ (1 < prec)%Z.
+
+Global Instance exists_NE_FLX : Exists_NE beta FLX_exp.
+Proof.
+destruct NE_prop as [H|H].
+now left.
+right.
+unfold FLX_exp.
+split ; omega.
+Qed.
+
+End RND_FLX.
diff --git a/flocq/Core/Fcore_FTZ.v b/flocq/Core/FTZ.v
index a2fab00b..1a93bcd9 100644
--- a/flocq/Core/Fcore_FTZ.v
+++ b/flocq/Core/FTZ.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,13 +18,8 @@ COPYING file for more details.
 *)
 
 (** * Floating-point format with abrupt underflow *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_rnd.
-Require Import Fcore_generic_fmt.
-Require Import Fcore_float_prop.
-Require Import Fcore_ulp.
-Require Import Fcore_FLX.
+Require Import Raux Defs Round_pred Generic_fmt.
+Require Import Float_prop Ulp FLX.
 
 Section RND_FTZ.
 
@@ -36,11 +31,12 @@ Variable emin prec : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 
-(* floating-point format with abrupt underflow *)
-Definition FTZ_format (x : R) :=
-  exists f : float beta,
-  x = F2R f /\ (x <> R0 -> Zpower beta (prec - 1) <= Zabs (Fnum f) < Zpower beta prec)%Z /\
-  (emin <= Fexp f)%Z.
+Inductive FTZ_format (x : R) : Prop :=
+  FTZ_spec (f : float beta) :
+    x = F2R f ->
+    (x <> 0%R -> Zpower beta (prec - 1) <= Z.abs (Fnum f) < Zpower beta prec)%Z ->
+    (emin <= Fexp f)%Z ->
+    FTZ_format x.
 
 Definition FTZ_exp e := if Zlt_bool (e - prec) emin then (emin + prec - 1)%Z else (e - prec)%Z.
 
@@ -73,9 +69,10 @@ Qed.
 Theorem FLXN_format_FTZ :
   forall x, FTZ_format x -> FLXN_format beta prec x.
 Proof.
-intros x ((xm, xe), (Hx1, (Hx2, Hx3))).
+intros x [[xm xe] Hx1 Hx2 Hx3].
 eexists.
-apply (conj Hx1 Hx2).
+exact Hx1.
+exact Hx2.
 Qed.
 
 Theorem generic_format_FTZ :
@@ -83,9 +80,9 @@ Theorem generic_format_FTZ :
 Proof.
 intros x Hx.
 cut (generic_format beta (FLX_exp prec) x).
-apply generic_inclusion_ln_beta.
+apply generic_inclusion_mag.
 intros Zx.
-destruct Hx as ((xm, xe), (Hx1, (Hx2, Hx3))).
+destruct Hx as [[xm xe] Hx1 Hx2 Hx3].
 simpl in Hx2, Hx3.
 specialize (Hx2 Zx).
 assert (Zxm: xm <> Z0).
@@ -94,11 +91,11 @@ rewrite Hx1, Zx.
 apply F2R_0.
 unfold FTZ_exp, FLX_exp.
 rewrite Zlt_bool_false.
-apply Zle_refl.
-rewrite Hx1, ln_beta_F2R with (1 := Zxm).
-cut (prec - 1 < ln_beta beta (Z2R xm))%Z.
+apply Z.le_refl.
+rewrite Hx1, mag_F2R with (1 := Zxm).
+cut (prec - 1 < mag beta (IZR xm))%Z.
 clear -Hx3 ; omega.
-apply ln_beta_gt_Zpower with (1 := Zxm).
+apply mag_gt_Zpower with (1 := Zxm).
 apply Hx2.
 apply generic_format_FLXN.
 now apply FLXN_format_FTZ.
@@ -108,17 +105,14 @@ Theorem FTZ_format_generic :
   forall x, generic_format beta FTZ_exp x -> FTZ_format x.
 Proof.
 intros x Hx.
-destruct (Req_dec x 0) as [Hx3|Hx3].
+destruct (Req_dec x 0) as [->|Hx3].
 exists (Float beta 0 emin).
-split.
-unfold F2R. simpl.
-now rewrite Rmult_0_l.
-split.
+apply sym_eq, F2R_0.
 intros H.
 now elim H.
-apply Zle_refl.
-unfold generic_format, scaled_mantissa, canonic_exp, FTZ_exp in Hx.
-destruct (ln_beta beta x) as (ex, Hx4).
+apply Z.le_refl.
+unfold generic_format, scaled_mantissa, cexp, FTZ_exp in Hx.
+destruct (mag beta x) as (ex, Hx4).
 simpl in Hx.
 specialize (Hx4 Hx3).
 generalize (Zlt_cases (ex - prec) emin) Hx. clear Hx.
@@ -129,43 +123,43 @@ rewrite Hx2, <- F2R_Zabs.
 rewrite <- (Rmult_1_l (bpow ex)).
 unfold F2R. simpl.
 apply Rmult_le_compat.
-now apply (Z2R_le 0 1).
+now apply IZR_le.
 apply bpow_ge_0.
-apply (Z2R_le 1).
+apply IZR_le.
 apply (Zlt_le_succ 0).
-apply lt_Z2R.
+apply lt_IZR.
 apply Rmult_lt_reg_r with (bpow (emin + prec - 1)).
 apply bpow_gt_0.
 rewrite Rmult_0_l.
-change (0 < F2R (Float beta (Zabs (Ztrunc (x * bpow (- (emin + prec - 1))))) (emin + prec - 1)))%R.
+change (0 < F2R (Float beta (Z.abs (Ztrunc (x * bpow (- (emin + prec - 1))))) (emin + prec - 1)))%R.
 rewrite F2R_Zabs, <- Hx2.
 now apply Rabs_pos_lt.
 apply bpow_le.
 omega.
 rewrite Hx2.
 eexists ; repeat split ; simpl.
-apply le_Z2R.
-rewrite Z2R_Zpower.
+apply le_IZR.
+rewrite IZR_Zpower.
 apply Rmult_le_reg_r with (bpow (ex - prec)).
 apply bpow_gt_0.
 rewrite <- bpow_plus.
 replace (prec - 1 + (ex - prec))%Z with (ex - 1)%Z by ring.
-change (bpow (ex - 1) <= F2R (Float beta (Zabs (Ztrunc (x * bpow (- (ex - prec))))) (ex - prec)))%R.
+change (bpow (ex - 1) <= F2R (Float beta (Z.abs (Ztrunc (x * bpow (- (ex - prec))))) (ex - prec)))%R.
 rewrite F2R_Zabs, <- Hx2.
 apply Hx4.
 apply Zle_minus_le_0.
 now apply (Zlt_le_succ 0).
-apply lt_Z2R.
-rewrite Z2R_Zpower.
+apply lt_IZR.
+rewrite IZR_Zpower.
 apply Rmult_lt_reg_r with (bpow (ex - prec)).
 apply bpow_gt_0.
 rewrite <- bpow_plus.
 replace (prec + (ex - prec))%Z with ex by ring.
-change (F2R (Float beta (Zabs (Ztrunc (x * bpow (- (ex - prec))))) (ex - prec)) < bpow ex)%R.
+change (F2R (Float beta (Z.abs (Ztrunc (x * bpow (- (ex - prec))))) (ex - prec)) < bpow ex)%R.
 rewrite F2R_Zabs, <- Hx2.
 apply Hx4.
 now apply Zlt_le_weak.
-now apply Zge_le.
+now apply Z.ge_le.
 Qed.
 
 Theorem FTZ_format_satisfies_any :
@@ -191,11 +185,12 @@ apply generic_inclusion_ge.
 intros e He.
 unfold FTZ_exp.
 rewrite Zlt_bool_false.
-apply Zle_refl.
+apply Z.le_refl.
 omega.
 Qed.
 
-Theorem ulp_FTZ_0: ulp beta FTZ_exp 0 = bpow (emin+prec-1).
+Theorem ulp_FTZ_0 :
+  ulp beta FTZ_exp 0 = bpow (emin+prec-1).
 Proof with auto with typeclass_instances.
 unfold ulp; rewrite Req_bool_true; trivial.
 case (negligible_exp_spec FTZ_exp).
@@ -230,9 +225,9 @@ case Rle_bool_spec ; intros Hx ;
 4: easy.
 (* 1 <= |x| *)
 now apply Zrnd_le.
-rewrite <- (Zrnd_Z2R rnd 0).
+rewrite <- (Zrnd_IZR rnd 0).
 apply Zrnd_le...
-apply Rle_trans with (Z2R (-1)). 2: now apply Z2R_le.
+apply Rle_trans with (-1)%R. 2: now apply IZR_le.
 destruct (Rabs_ge_inv _ _ Hx) as [Hx1|Hx1].
 exact Hx1.
 elim Rle_not_lt with (1 := Hx1).
@@ -240,10 +235,10 @@ apply Rle_lt_trans with (2 := Hy).
 apply Rle_trans with (1 := Hxy).
 apply RRle_abs.
 (* |x| < 1 *)
-rewrite <- (Zrnd_Z2R rnd 0).
+rewrite <- (Zrnd_IZR rnd 0).
 apply Zrnd_le...
-apply Rle_trans with (Z2R 1).
-now apply Z2R_le.
+apply Rle_trans with 1%R.
+now apply IZR_le.
 destruct (Rabs_ge_inv _ _ Hy) as [Hy1|Hy1].
 elim Rle_not_lt with (1 := Hy1).
 apply Rlt_le_trans with (2 := Hxy).
@@ -252,12 +247,12 @@ exact Hy1.
 (* *)
 intros n.
 unfold Zrnd_FTZ.
-rewrite Zrnd_Z2R...
+rewrite Zrnd_IZR...
 case Rle_bool_spec.
 easy.
-rewrite <- Z2R_abs.
+rewrite <- abs_IZR.
 intros H.
-generalize (lt_Z2R _ 1 H).
+generalize (lt_IZR _ 1 H).
 clear.
 now case n ; trivial ; simpl ; intros [p|p|].
 Qed.
@@ -268,8 +263,8 @@ Theorem round_FTZ_FLX :
   round beta FTZ_exp Zrnd_FTZ x = round beta (FLX_exp prec) rnd x.
 Proof.
 intros x Hx.
-unfold round, scaled_mantissa, canonic_exp.
-destruct (ln_beta beta x) as (ex, He). simpl.
+unfold round, scaled_mantissa, cexp.
+destruct (mag beta x) as (ex, He). simpl.
 assert (Hx0: x <> 0%R).
 intros Hx0.
 apply Rle_not_lt with (1 := Hx).
@@ -306,14 +301,14 @@ Qed.
 Theorem round_FTZ_small :
   forall x : R,
   (Rabs x < bpow (emin + prec - 1))%R ->
-  round beta FTZ_exp Zrnd_FTZ x = R0.
+  round beta FTZ_exp Zrnd_FTZ x = 0%R.
 Proof with auto with typeclass_instances.
 intros x Hx.
 destruct (Req_dec x 0) as [Hx0|Hx0].
 rewrite Hx0.
 apply round_0...
-unfold round, scaled_mantissa, canonic_exp.
-destruct (ln_beta beta x) as (ex, He). simpl.
+unfold round, scaled_mantissa, cexp.
+destruct (mag beta x) as (ex, He). simpl.
 specialize (He Hx0).
 unfold Zrnd_FTZ.
 rewrite Rle_bool_false.
@@ -331,7 +326,7 @@ unfold FTZ_exp.
 generalize (Zlt_cases (ex - prec) emin).
 case Zlt_bool.
 intros _.
-apply Zle_refl.
+apply Z.le_refl.
 intros He'.
 elim Rlt_not_le with (1 := Hx).
 apply Rle_trans with (2 := proj1 He).
diff --git a/flocq/Core/Fcore_FLX.v b/flocq/Core/Fcore_FLX.v
deleted file mode 100644
index 55f6db61..00000000
--- a/flocq/Core/Fcore_FLX.v
+++ /dev/null
@@ -1,271 +0,0 @@
-(**
-This file is part of the Flocq formalization of floating-point
-arithmetic in Coq: http://flocq.gforge.inria.fr/
-
-Copyright (C) 2010-2013 Sylvie Boldo
-#<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
-
-This library is free software; you can redistribute it and/or
-modify it 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.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-COPYING file for more details.
-*)
-
-(** * Floating-point format without underflow *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_rnd.
-Require Import Fcore_generic_fmt.
-Require Import Fcore_float_prop.
-Require Import Fcore_FIX.
-Require Import Fcore_ulp.
-Require Import Fcore_rnd_ne.
-
-Section RND_FLX.
-
-Variable beta : radix.
-
-Notation bpow e := (bpow beta e).
-
-Variable prec : Z.
-
-Class Prec_gt_0 :=
-  prec_gt_0 : (0 < prec)%Z.
-
-Context { prec_gt_0_ : Prec_gt_0 }.
-
-(* unbounded floating-point format *)
-Definition FLX_format (x : R) :=
-  exists f : float beta,
-  x = F2R f /\ (Zabs (Fnum f) < Zpower beta prec)%Z.
-
-Definition FLX_exp (e : Z) := (e - prec)%Z.
-
-(** Properties of the FLX format *)
-
-Global Instance FLX_exp_valid : Valid_exp FLX_exp.
-Proof.
-intros k.
-unfold FLX_exp.
-generalize prec_gt_0.
-repeat split ; intros ; omega.
-Qed.
-
-Theorem FIX_format_FLX :
-  forall x e,
-  (bpow (e - 1) <= Rabs x <= bpow e)%R ->
-  FLX_format x ->
-  FIX_format beta (e - prec) x.
-Proof.
-clear prec_gt_0_.
-intros x e Hx ((xm, xe), (H1, H2)).
-rewrite H1, (F2R_prec_normalize beta xm xe e prec).
-now eexists.
-exact H2.
-now rewrite <- H1.
-Qed.
-
-Theorem FLX_format_generic :
-  forall x, generic_format beta FLX_exp x -> FLX_format x.
-Proof.
-intros x H.
-rewrite H.
-unfold FLX_format.
-eexists ; repeat split.
-simpl.
-apply lt_Z2R.
-rewrite Z2R_abs.
-rewrite <- scaled_mantissa_generic with (1 := H).
-rewrite <- scaled_mantissa_abs.
-apply Rmult_lt_reg_r with (bpow (canonic_exp beta FLX_exp (Rabs x))).
-apply bpow_gt_0.
-rewrite scaled_mantissa_mult_bpow.
-rewrite Z2R_Zpower, <- bpow_plus.
-2: now apply Zlt_le_weak.
-unfold canonic_exp, FLX_exp.
-ring_simplify (prec + (ln_beta beta (Rabs x) - prec))%Z.
-rewrite ln_beta_abs.
-destruct (Req_dec x 0) as [Hx|Hx].
-rewrite Hx, Rabs_R0.
-apply bpow_gt_0.
-destruct (ln_beta beta x) as (ex, Ex).
-now apply Ex.
-Qed.
-
-Theorem generic_format_FLX :
-  forall x, FLX_format x -> generic_format beta FLX_exp x.
-Proof.
-clear prec_gt_0_.
-intros x ((mx,ex),(H1,H2)).
-simpl in H2.
-rewrite H1.
-apply generic_format_F2R.
-intros Zmx.
-unfold canonic_exp, FLX_exp.
-rewrite ln_beta_F2R with (1 := Zmx).
-apply Zplus_le_reg_r with (prec - ex)%Z.
-ring_simplify.
-now apply ln_beta_le_Zpower.
-Qed.
-
-Theorem FLX_format_satisfies_any :
-  satisfies_any FLX_format.
-Proof.
-refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLX_exp)).
-intros x.
-split.
-apply FLX_format_generic.
-apply generic_format_FLX.
-Qed.
-
-Theorem FLX_format_FIX :
-  forall x e,
-  (bpow (e - 1) <= Rabs x <= bpow e)%R ->
-  FIX_format beta (e - prec) x ->
-  FLX_format x.
-Proof with auto with typeclass_instances.
-intros x e Hx Fx.
-apply FLX_format_generic.
-apply generic_format_FIX in Fx.
-revert Fx.
-apply generic_inclusion with (e := e)...
-apply Zle_refl.
-Qed.
-
-(** unbounded floating-point format with normal mantissas *)
-Definition FLXN_format (x : R) :=
-  exists f : float beta,
-  x = F2R f /\ (x <> R0 ->
-  Zpower beta (prec - 1) <= Zabs (Fnum f) < Zpower beta prec)%Z.
-
-Theorem generic_format_FLXN :
-  forall x, FLXN_format x -> generic_format beta FLX_exp x.
-Proof.
-intros x ((xm,ex),(H1,H2)).
-destruct (Req_dec x 0) as [Zx|Zx].
-rewrite Zx.
-apply generic_format_0.
-specialize (H2 Zx).
-apply generic_format_FLX.
-rewrite H1.
-eexists ; repeat split.
-apply H2.
-Qed.
-
-Theorem FLXN_format_generic :
-  forall x, generic_format beta FLX_exp x -> FLXN_format x.
-Proof.
-intros x Hx.
-rewrite Hx.
-simpl.
-eexists ; split. split.
-simpl.
-rewrite <- Hx.
-intros Zx.
-split.
-(* *)
-apply le_Z2R.
-rewrite Z2R_Zpower.
-2: now apply Zlt_0_le_0_pred.
-rewrite Z2R_abs, <- scaled_mantissa_generic with (1 := Hx).
-apply Rmult_le_reg_r with (bpow (canonic_exp beta FLX_exp x)).
-apply bpow_gt_0.
-rewrite <- bpow_plus.
-rewrite <- scaled_mantissa_abs.
-rewrite <- canonic_exp_abs.
-rewrite scaled_mantissa_mult_bpow.
-unfold canonic_exp, FLX_exp.
-rewrite ln_beta_abs.
-ring_simplify (prec - 1 + (ln_beta beta x - prec))%Z.
-destruct (ln_beta beta x) as (ex,Ex).
-now apply Ex.
-(* *)
-apply lt_Z2R.
-rewrite Z2R_Zpower.
-2: now apply Zlt_le_weak.
-rewrite Z2R_abs, <- scaled_mantissa_generic with (1 := Hx).
-apply Rmult_lt_reg_r with (bpow (canonic_exp beta FLX_exp x)).
-apply bpow_gt_0.
-rewrite <- bpow_plus.
-rewrite <- scaled_mantissa_abs.
-rewrite <- canonic_exp_abs.
-rewrite scaled_mantissa_mult_bpow.
-unfold canonic_exp, FLX_exp.
-rewrite ln_beta_abs.
-ring_simplify (prec + (ln_beta beta x - prec))%Z.
-destruct (ln_beta beta x) as (ex,Ex).
-now apply Ex.
-Qed.
-
-Theorem FLXN_format_satisfies_any :
-  satisfies_any FLXN_format.
-Proof.
-refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLX_exp)).
-split ; intros H.
-now apply FLXN_format_generic.
-now apply generic_format_FLXN.
-Qed.
-
-Theorem ulp_FLX_0: (ulp beta FLX_exp 0 = 0)%R.
-Proof.
-unfold ulp; rewrite Req_bool_true; trivial.
-case (negligible_exp_spec FLX_exp).
-intros _; reflexivity.
-intros n H2; contradict H2.
-unfold FLX_exp; unfold Prec_gt_0 in prec_gt_0_; omega.
-Qed.
-
-Theorem ulp_FLX_le: forall x, (ulp beta FLX_exp x <= Rabs x * bpow (1-prec))%R.
-Proof.
-intros x; case (Req_dec x 0); intros Hx.
-rewrite Hx, ulp_FLX_0, Rabs_R0.
-right; ring.
-rewrite ulp_neq_0; try exact Hx.
-unfold canonic_exp, FLX_exp.
-replace (ln_beta beta x - prec)%Z with ((ln_beta beta x - 1) + (1-prec))%Z by ring.
-rewrite bpow_plus.
-apply Rmult_le_compat_r.
-apply bpow_ge_0.
-now apply bpow_ln_beta_le.
-Qed.
-
-
-Theorem ulp_FLX_ge: forall x, (Rabs x * bpow (-prec) <= ulp beta FLX_exp x)%R.
-Proof.
-intros x; case (Req_dec x 0); intros Hx.
-rewrite Hx, ulp_FLX_0, Rabs_R0.
-right; ring.
-rewrite ulp_neq_0; try exact Hx.
-unfold canonic_exp, FLX_exp.
-unfold Zminus; rewrite bpow_plus.
-apply Rmult_le_compat_r.
-apply bpow_ge_0.
-left; now apply bpow_ln_beta_gt.
-Qed.
-
-(** FLX is a nice format: it has a monotone exponent... *)
-Global Instance FLX_exp_monotone : Monotone_exp FLX_exp.
-Proof.
-intros ex ey Hxy.
-now apply Zplus_le_compat_r.
-Qed.
-
-(** and it allows a rounding to nearest, ties to even. *)
-Hypothesis NE_prop : Zeven beta = false \/ (1 < prec)%Z.
-
-Global Instance exists_NE_FLX : Exists_NE beta FLX_exp.
-Proof.
-destruct NE_prop as [H|H].
-now left.
-right.
-unfold FLX_exp.
-split ; omega.
-Qed.
-
-End RND_FLX.
diff --git a/flocq/Core/Fcore_float_prop.v b/flocq/Core/Float_prop.v
index a183bf0a..804dd397 100644
--- a/flocq/Core/Fcore_float_prop.v
+++ b/flocq/Core/Float_prop.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,40 +18,38 @@ COPYING file for more details.
 *)
 
 (** * Basic properties of floating-point formats: lemmas about mantissa, exponent... *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
+Require Import Raux Defs Digits.
 
 Section Float_prop.
 
 Variable beta : radix.
-
 Notation bpow e := (bpow beta e).
 
 Theorem Rcompare_F2R :
   forall e m1 m2 : Z,
-  Rcompare (F2R (Float beta m1 e)) (F2R (Float beta m2 e)) = Zcompare m1 m2.
+  Rcompare (F2R (Float beta m1 e)) (F2R (Float beta m2 e)) = Z.compare m1 m2.
 Proof.
 intros e m1 m2.
 unfold F2R. simpl.
 rewrite Rcompare_mult_r.
-apply Rcompare_Z2R.
+apply Rcompare_IZR.
 apply bpow_gt_0.
 Qed.
 
 (** Basic facts *)
-Theorem F2R_le_reg :
+Theorem le_F2R :
   forall e m1 m2 : Z,
   (F2R (Float beta m1 e) <= F2R (Float beta m2 e))%R ->
   (m1 <= m2)%Z.
 Proof.
 intros e m1 m2 H.
-apply le_Z2R.
+apply le_IZR.
 apply Rmult_le_reg_r with (bpow e).
 apply bpow_gt_0.
 exact H.
 Qed.
 
-Theorem F2R_le_compat :
+Theorem F2R_le :
   forall m1 m2 e : Z,
   (m1 <= m2)%Z ->
   (F2R (Float beta m1 e) <= F2R (Float beta m2 e))%R.
@@ -60,22 +58,22 @@ intros m1 m2 e H.
 unfold F2R. simpl.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-now apply Z2R_le.
+now apply IZR_le.
 Qed.
 
-Theorem F2R_lt_reg :
+Theorem lt_F2R :
   forall e m1 m2 : Z,
   (F2R (Float beta m1 e) < F2R (Float beta m2 e))%R ->
   (m1 < m2)%Z.
 Proof.
 intros e m1 m2 H.
-apply lt_Z2R.
+apply lt_IZR.
 apply Rmult_lt_reg_r with (bpow e).
 apply bpow_gt_0.
 exact H.
 Qed.
 
-Theorem F2R_lt_compat :
+Theorem F2R_lt :
   forall e m1 m2 : Z,
   (m1 < m2)%Z ->
   (F2R (Float beta m1 e) < F2R (Float beta m2 e))%R.
@@ -84,10 +82,10 @@ intros e m1 m2 H.
 unfold F2R. simpl.
 apply Rmult_lt_compat_r.
 apply bpow_gt_0.
-now apply Z2R_lt.
+now apply IZR_lt.
 Qed.
 
-Theorem F2R_eq_compat :
+Theorem F2R_eq :
   forall e m1 m2 : Z,
   (m1 = m2)%Z ->
   (F2R (Float beta m1 e) = F2R (Float beta m2 e))%R.
@@ -96,26 +94,26 @@ intros e m1 m2 H.
 now apply (f_equal (fun m => F2R (Float beta m e))).
 Qed.
 
-Theorem F2R_eq_reg :
+Theorem eq_F2R :
   forall e m1 m2 : Z,
   F2R (Float beta m1 e) = F2R (Float beta m2 e) ->
   m1 = m2.
 Proof.
 intros e m1 m2 H.
 apply Zle_antisym ;
-  apply F2R_le_reg with e ;
+  apply le_F2R with e ;
   rewrite H ;
   apply Rle_refl.
 Qed.
 
 Theorem F2R_Zabs:
   forall m e : Z,
-   F2R (Float beta (Zabs m) e) = Rabs (F2R (Float beta m e)).
+   F2R (Float beta (Z.abs m) e) = Rabs (F2R (Float beta m e)).
 Proof.
 intros m e.
 unfold F2R.
 rewrite Rabs_mult.
-rewrite <- Z2R_abs.
+rewrite <- abs_IZR.
 simpl.
 apply f_equal.
 apply sym_eq; apply Rabs_right.
@@ -125,12 +123,21 @@ Qed.
 
 Theorem F2R_Zopp :
   forall m e : Z,
-  F2R (Float beta (Zopp m) e) = Ropp (F2R (Float beta m e)).
+  F2R (Float beta (Z.opp m) e) = Ropp (F2R (Float beta m e)).
 Proof.
 intros m e.
 unfold F2R. simpl.
 rewrite <- Ropp_mult_distr_l_reverse.
-now rewrite Z2R_opp.
+now rewrite opp_IZR.
+Qed.
+
+Theorem F2R_cond_Zopp :
+  forall b m e,
+  F2R (Float beta (cond_Zopp b m) e) = cond_Ropp b (F2R (Float beta m e)).
+Proof.
+intros [|] m e ; unfold F2R ; simpl.
+now rewrite opp_IZR, Ropp_mult_distr_l_reverse.
+apply refl_equal.
 Qed.
 
 (** Sign facts *)
@@ -143,125 +150,125 @@ unfold F2R. simpl.
 apply Rmult_0_l.
 Qed.
 
-Theorem F2R_eq_0_reg :
+Theorem eq_0_F2R :
   forall m e : Z,
   F2R (Float beta m e) = 0%R ->
   m = Z0.
 Proof.
 intros m e H.
-apply F2R_eq_reg with e.
+apply eq_F2R with e.
 now rewrite F2R_0.
 Qed.
 
-Theorem F2R_ge_0_reg :
+Theorem ge_0_F2R :
   forall m e : Z,
   (0 <= F2R (Float beta m e))%R ->
   (0 <= m)%Z.
 Proof.
 intros m e H.
-apply F2R_le_reg with e.
+apply le_F2R with e.
 now rewrite F2R_0.
 Qed.
 
-Theorem F2R_le_0_reg :
+Theorem le_0_F2R :
   forall m e : Z,
   (F2R (Float beta m e) <= 0)%R ->
   (m <= 0)%Z.
 Proof.
 intros m e H.
-apply F2R_le_reg with e.
+apply le_F2R with e.
 now rewrite F2R_0.
 Qed.
 
-Theorem F2R_gt_0_reg :
+Theorem gt_0_F2R :
   forall m e : Z,
   (0 < F2R (Float beta m e))%R ->
   (0 < m)%Z.
 Proof.
 intros m e H.
-apply F2R_lt_reg with e.
+apply lt_F2R with e.
 now rewrite F2R_0.
 Qed.
 
-Theorem F2R_lt_0_reg :
+Theorem lt_0_F2R :
   forall m e : Z,
   (F2R (Float beta m e) < 0)%R ->
   (m < 0)%Z.
 Proof.
 intros m e H.
-apply F2R_lt_reg with e.
+apply lt_F2R with e.
 now rewrite F2R_0.
 Qed.
 
-Theorem F2R_ge_0_compat :
+Theorem F2R_ge_0 :
   forall f : float beta,
   (0 <= Fnum f)%Z ->
   (0 <= F2R f)%R.
 Proof.
 intros f H.
 rewrite <- F2R_0 with (Fexp f).
-now apply F2R_le_compat.
+now apply F2R_le.
 Qed.
 
-Theorem F2R_le_0_compat :
+Theorem F2R_le_0 :
   forall f : float beta,
   (Fnum f <= 0)%Z ->
   (F2R f <= 0)%R.
 Proof.
 intros f H.
 rewrite <- F2R_0 with (Fexp f).
-now apply F2R_le_compat.
+now apply F2R_le.
 Qed.
 
-Theorem F2R_gt_0_compat :
+Theorem F2R_gt_0 :
   forall f : float beta,
   (0 < Fnum f)%Z ->
   (0 < F2R f)%R.
 Proof.
 intros f H.
 rewrite <- F2R_0 with (Fexp f).
-now apply F2R_lt_compat.
+now apply F2R_lt.
 Qed.
 
-Theorem F2R_lt_0_compat :
+Theorem F2R_lt_0 :
   forall f : float beta,
   (Fnum f < 0)%Z ->
   (F2R f < 0)%R.
 Proof.
 intros f H.
 rewrite <- F2R_0 with (Fexp f).
-now apply F2R_lt_compat.
+now apply F2R_lt.
 Qed.
 
-Theorem F2R_neq_0_compat :
+Theorem F2R_neq_0 :
  forall f : float beta,
   (Fnum f <> 0)%Z ->
   (F2R f <> 0)%R.
 Proof.
 intros f H H1.
 apply H.
-now apply F2R_eq_0_reg with (Fexp f).
+now apply eq_0_F2R with (Fexp f).
 Qed.
 
 
-Lemma Fnum_ge_0_compat: forall (f : float beta),
+Lemma Fnum_ge_0: forall (f : float beta),
   (0 <= F2R f)%R -> (0 <= Fnum f)%Z.
 Proof.
 intros f H.
 case (Zle_or_lt 0 (Fnum f)); trivial.
 intros H1; contradict H.
 apply Rlt_not_le.
-now apply F2R_lt_0_compat.
+now apply F2R_lt_0.
 Qed.
 
-Lemma Fnum_le_0_compat: forall (f : float beta),
+Lemma Fnum_le_0: forall (f : float beta),
   (F2R f <= 0)%R -> (Fnum f <= 0)%Z.
 Proof.
 intros f H.
 case (Zle_or_lt (Fnum f) 0); trivial.
 intros H1; contradict H.
 apply Rlt_not_le.
-now apply F2R_gt_0_compat.
+now apply F2R_gt_0.
 Qed.
 
 (** Floats and bpow *)
@@ -281,7 +288,7 @@ Theorem bpow_le_F2R :
 Proof.
 intros m e H.
 rewrite <- F2R_bpow.
-apply F2R_le_compat.
+apply F2R_le.
 now apply (Zlt_le_succ 0).
 Qed.
 
@@ -301,7 +308,7 @@ unfold F2R. simpl.
 rewrite <- (Rmult_1_l (bpow e1)) at 1.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-apply (Z2R_le 1).
+apply IZR_le.
 now apply (Zlt_le_succ 0).
 now apply Rlt_le.
 (* . *)
@@ -309,14 +316,14 @@ revert H.
 replace e2 with (e2 - e1 + e1)%Z by ring.
 rewrite bpow_plus.
 unfold F2R. simpl.
-rewrite <- (Z2R_Zpower beta (e2 - e1)).
+rewrite <- (IZR_Zpower beta (e2 - e1)).
 intros H.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
 apply Rmult_lt_reg_r in H.
-apply Z2R_le.
+apply IZR_le.
 apply Zlt_le_succ.
-now apply lt_Z2R.
+now apply lt_IZR.
 apply bpow_gt_0.
 now apply Zle_minus_le_0.
 Qed.
@@ -332,16 +339,16 @@ case (Zle_or_lt e1 e2); intros He.
 replace e2 with (e2 - e1 + e1)%Z by ring.
 rewrite bpow_plus.
 unfold F2R. simpl.
-rewrite <- (Z2R_Zpower beta (e2 - e1)).
+rewrite <- (IZR_Zpower beta (e2 - e1)).
 intros H.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
 apply Rmult_lt_reg_r in H.
-apply Z2R_le.
+apply IZR_le.
 rewrite (Zpred_succ (Zpower _ _)).
 apply Zplus_le_compat_r.
 apply Zlt_le_succ.
-now apply lt_Z2R.
+now apply lt_IZR.
 apply bpow_gt_0.
 now apply Zle_minus_le_0.
 intros H.
@@ -352,14 +359,13 @@ now apply Zlt_le_weak.
 unfold F2R. simpl.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-replace 1%R with (Z2R 1) by reflexivity.
-apply Z2R_le.
+apply IZR_le.
 omega.
 Qed.
 
 Theorem F2R_lt_bpow :
   forall f : float beta, forall e',
-  (Zabs (Fnum f) < Zpower beta (e' - Fexp f))%Z ->
+  (Z.abs (Fnum f) < Zpower beta (e' - Fexp f))%Z ->
   (Rabs (F2R f) < bpow e')%R.
 Proof.
 intros (m, e) e' Hm.
@@ -369,8 +375,8 @@ unfold F2R. simpl.
 apply Rmult_lt_reg_r with (bpow (-e)).
 apply bpow_gt_0.
 rewrite Rmult_assoc, <- 2!bpow_plus, Zplus_opp_r, Rmult_1_r.
-rewrite <-Z2R_Zpower. 2: now apply Zle_left.
-now apply Z2R_lt.
+rewrite <-IZR_Zpower. 2: now apply Zle_left.
+now apply IZR_lt.
 elim Zlt_not_le with (1 := Hm).
 simpl.
 cut (e' - e < 0)%Z. 2: omega.
@@ -387,7 +393,7 @@ Theorem F2R_change_exp :
 Proof.
 intros e' m e He.
 unfold F2R. simpl.
-rewrite Z2R_mult, Z2R_Zpower, Rmult_assoc.
+rewrite mult_IZR, IZR_Zpower, Rmult_assoc.
 apply f_equal.
 pattern e at 1 ; replace e with (e - e' + e')%Z by ring.
 apply bpow_plus.
@@ -396,7 +402,7 @@ Qed.
 
 Theorem F2R_prec_normalize :
   forall m e e' p : Z,
-  (Zabs m < Zpower beta p)%Z ->
+  (Z.abs m < Zpower beta p)%Z ->
   (bpow (e' - 1)%Z <= Rabs (F2R (Float beta m e)))%R ->
   F2R (Float beta m e) = F2R (Float beta (m * Zpower beta (e - e' + p)) (e' - p)).
 Proof.
@@ -413,23 +419,23 @@ apply Rle_lt_trans with (1 := Hf).
 rewrite <- F2R_Zabs, Zplus_comm, bpow_plus.
 apply Rmult_lt_compat_r.
 apply bpow_gt_0.
-rewrite <- Z2R_Zpower.
-now apply Z2R_lt.
+rewrite <- IZR_Zpower.
+now apply IZR_lt.
 exact Hp.
 Qed.
 
-(** Floats and ln_beta *)
-Theorem ln_beta_F2R_bounds :
+(** Floats and mag *)
+Theorem mag_F2R_bounds :
   forall x m e, (0 < m)%Z ->
   (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R ->
-  ln_beta beta x = ln_beta beta (F2R (Float beta m e)) :> Z.
+  mag beta x = mag beta (F2R (Float beta m e)) :> Z.
 Proof.
 intros x m e Hp (Hx,Hx2).
-destruct (ln_beta beta (F2R (Float beta m e))) as (ex, He).
+destruct (mag beta (F2R (Float beta m e))) as (ex, He).
 simpl.
-apply ln_beta_unique.
+apply mag_unique.
 assert (Hp1: (0 < F2R (Float beta m e))%R).
-now apply F2R_gt_0_compat.
+now apply F2R_gt_0.
 specialize (He (Rgt_not_eq _ _ Hp1)).
 rewrite Rabs_pos_eq in He. 2: now apply Rlt_le.
 destruct He as (He1, He2).
@@ -442,22 +448,65 @@ apply Rlt_le_trans with (1 := Hx2).
 now apply F2R_p1_le_bpow.
 Qed.
 
-Theorem ln_beta_F2R :
+Theorem mag_F2R :
   forall m e : Z,
   m <> Z0 ->
-  (ln_beta beta (F2R (Float beta m e)) = ln_beta beta (Z2R m) + e :> Z)%Z.
+  (mag beta (F2R (Float beta m e)) = mag beta (IZR m) + e :> Z)%Z.
 Proof.
 intros m e H.
 unfold F2R ; simpl.
-apply ln_beta_mult_bpow.
-exact (Z2R_neq m 0 H).
+apply mag_mult_bpow.
+now apply IZR_neq.
+Qed.
+
+Theorem Zdigits_mag :
+  forall n,
+  n <> Z0 ->
+  Zdigits beta n = mag beta (IZR n).
+Proof.
+intros n Hn.
+destruct (mag beta (IZR n)) as (e, He) ; simpl.
+specialize (He (IZR_neq _ _ Hn)).
+rewrite <- abs_IZR in He.
+assert (Hd := Zdigits_correct beta n).
+assert (Hd' := Zdigits_gt_0 beta n).
+apply Zle_antisym ; apply (bpow_lt_bpow beta).
+apply Rle_lt_trans with (2 := proj2 He).
+rewrite <- IZR_Zpower by omega.
+now apply IZR_le.
+apply Rle_lt_trans with (1 := proj1 He).
+rewrite <- IZR_Zpower by omega.
+now apply IZR_lt.
+Qed.
+
+Theorem mag_F2R_Zdigits :
+  forall m e, m <> Z0 ->
+  (mag beta (F2R (Float beta m e)) = Zdigits beta m + e :> Z)%Z.
+Proof.
+intros m e Hm.
+rewrite mag_F2R with (1 := Hm).
+apply (f_equal (fun v => Zplus v e)).
+apply sym_eq.
+now apply Zdigits_mag.
+Qed.
+
+Theorem mag_F2R_bounds_Zdigits :
+  forall x m e, (0 < m)%Z ->
+  (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R ->
+  mag beta x = (Zdigits beta m + e)%Z :> Z.
+Proof.
+intros x m e Hm Bx.
+apply mag_F2R_bounds with (1 := Hm) in Bx.
+rewrite Bx.
+apply mag_F2R_Zdigits.
+now apply Zgt_not_eq.
 Qed.
 
 Theorem float_distribution_pos :
   forall m1 e1 m2 e2 : Z,
   (0 < m1)%Z ->
   (F2R (Float beta m1 e1) < F2R (Float beta m2 e2) < F2R (Float beta (m1 + 1) e1))%R ->
-  (e2 < e1)%Z /\ (e1 + ln_beta beta (Z2R m1) = e2 + ln_beta beta (Z2R m2))%Z.
+  (e2 < e1)%Z /\ (e1 + mag beta (IZR m1) = e2 + mag beta (IZR m2))%Z.
 Proof.
 intros m1 e1 m2 e2 Hp1 (H12, H21).
 assert (He: (e2 < e1)%Z).
@@ -465,35 +514,35 @@ assert (He: (e2 < e1)%Z).
 apply Znot_ge_lt.
 intros H0.
 elim Rlt_not_le with (1 := H21).
-apply Zge_le in H0.
+apply Z.ge_le in H0.
 apply (F2R_change_exp e1 m2 e2) in H0.
 rewrite H0.
-apply F2R_le_compat.
+apply F2R_le.
 apply Zlt_le_succ.
-apply (F2R_lt_reg e1).
+apply (lt_F2R e1).
 now rewrite <- H0.
 (* . *)
 split.
 exact He.
 rewrite (Zplus_comm e1), (Zplus_comm e2).
 assert (Hp2: (0 < m2)%Z).
-apply (F2R_gt_0_reg m2 e2).
+apply (gt_0_F2R m2 e2).
 apply Rlt_trans with (2 := H12).
-now apply F2R_gt_0_compat.
-rewrite <- 2!ln_beta_F2R.
-destruct (ln_beta beta (F2R (Float beta m1 e1))) as (e1', H1).
+now apply F2R_gt_0.
+rewrite <- 2!mag_F2R.
+destruct (mag beta (F2R (Float beta m1 e1))) as (e1', H1).
 simpl.
 apply sym_eq.
-apply ln_beta_unique.
+apply mag_unique.
 assert (H2 : (bpow (e1' - 1) <= F2R (Float beta m1 e1) < bpow e1')%R).
-rewrite <- (Zabs_eq m1), F2R_Zabs.
+rewrite <- (Z.abs_eq m1), F2R_Zabs.
 apply H1.
 apply Rgt_not_eq.
 apply Rlt_gt.
-now apply F2R_gt_0_compat.
+now apply F2R_gt_0.
 now apply Zlt_le_weak.
 clear H1.
-rewrite <- F2R_Zabs, Zabs_eq.
+rewrite <- F2R_Zabs, Z.abs_eq.
 split.
 apply Rlt_le.
 apply Rle_lt_trans with (2 := H12).
@@ -507,13 +556,4 @@ apply sym_not_eq.
 now apply Zlt_not_eq.
 Qed.
 
-Theorem F2R_cond_Zopp :
-  forall b m e,
-  F2R (Float beta (cond_Zopp b m) e) = cond_Ropp b (F2R (Float beta m e)).
-Proof.
-intros [|] m e ; unfold F2R ; simpl.
-now rewrite Z2R_opp, Ropp_mult_distr_l_reverse.
-apply refl_equal.
-Qed.
-
 End Float_prop.
diff --git a/flocq/Core/Fcore_generic_fmt.v b/flocq/Core/Generic_fmt.v
index 668b4da2..cb37bd91 100644
--- a/flocq/Core/Fcore_generic_fmt.v
+++ b/flocq/Core/Generic_fmt.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,10 +18,7 @@ COPYING file for more details.
 *)
 
 (** * What is a real number belonging to a format, and many properties. *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_rnd.
-Require Import Fcore_float_prop.
+Require Import Raux Defs Round_pred Float_prop.
 
 Section Generic.
 
@@ -53,7 +50,7 @@ Proof.
 intros k l Hk H.
 apply Znot_ge_lt.
 intros Hl.
-apply Zge_le in Hl.
+apply Z.ge_le in Hl.
 assert (H' := proj2 (proj2 (valid_exp l) Hl) k).
 omega.
 Qed.
@@ -66,24 +63,24 @@ Proof.
 intros k l Hk H.
 apply Znot_ge_lt.
 intros H'.
-apply Zge_le in H'.
-assert (Hl := Zle_trans _ _ _ H H').
+apply Z.ge_le in H'.
+assert (Hl := Z.le_trans _ _ _ H H').
 apply valid_exp in Hl.
 assert (H1 := proj2 Hl k H').
 omega.
 Qed.
 
-Definition canonic_exp x :=
-  fexp (ln_beta beta x).
+Definition cexp x :=
+  fexp (mag beta x).
 
-Definition canonic (f : float beta) :=
-  Fexp f = canonic_exp (F2R f).
+Definition canonical (f : float beta) :=
+  Fexp f = cexp (F2R f).
 
 Definition scaled_mantissa x :=
-  (x * bpow (- canonic_exp x))%R.
+  (x * bpow (- cexp x))%R.
 
 Definition generic_format (x : R) :=
-  x = F2R (Float beta (Ztrunc (scaled_mantissa x)) (canonic_exp x)).
+  x = F2R (Float beta (Ztrunc (scaled_mantissa x)) (cexp x)).
 
 (** Basic facts *)
 Theorem generic_format_0 :
@@ -91,26 +88,39 @@ Theorem generic_format_0 :
 Proof.
 unfold generic_format, scaled_mantissa.
 rewrite Rmult_0_l.
-change (Ztrunc 0) with (Ztrunc (Z2R 0)).
-now rewrite Ztrunc_Z2R, F2R_0.
+now rewrite Ztrunc_IZR, F2R_0.
 Qed.
 
-Theorem canonic_exp_opp :
+Theorem cexp_opp :
   forall x,
-  canonic_exp (-x) = canonic_exp x.
+  cexp (-x) = cexp x.
 Proof.
 intros x.
-unfold canonic_exp.
-now rewrite ln_beta_opp.
+unfold cexp.
+now rewrite mag_opp.
 Qed.
 
-Theorem canonic_exp_abs :
+Theorem cexp_abs :
   forall x,
-  canonic_exp (Rabs x) = canonic_exp x.
+  cexp (Rabs x) = cexp x.
 Proof.
 intros x.
-unfold canonic_exp.
-now rewrite ln_beta_abs.
+unfold cexp.
+now rewrite mag_abs.
+Qed.
+
+Theorem canonical_generic_format :
+  forall x,
+  generic_format x ->
+  exists f : float beta,
+  x = F2R f /\ canonical f.
+Proof.
+intros x Hx.
+rewrite Hx.
+eexists.
+apply (conj eq_refl).
+unfold canonical.
+now rewrite <- Hx.
 Qed.
 
 Theorem generic_format_bpow :
@@ -118,11 +128,11 @@ Theorem generic_format_bpow :
   generic_format (bpow e).
 Proof.
 intros e H.
-unfold generic_format, scaled_mantissa, canonic_exp.
-rewrite ln_beta_bpow.
+unfold generic_format, scaled_mantissa, cexp.
+rewrite mag_bpow.
 rewrite <- bpow_plus.
-rewrite <- (Z2R_Zpower beta (e + - fexp (e + 1))).
-rewrite Ztrunc_Z2R.
+rewrite <- (IZR_Zpower beta (e + - fexp (e + 1))).
+rewrite Ztrunc_IZR.
 rewrite <- F2R_bpow.
 rewrite F2R_change_exp with (1 := H).
 now rewrite Zmult_1_l.
@@ -140,110 +150,107 @@ now apply valid_exp_.
 rewrite <- H.
 apply valid_exp.
 rewrite H.
-apply Zle_refl.
+apply Z.le_refl.
 Qed.
 
 Theorem generic_format_F2R :
   forall m e,
-  ( m <> 0 -> canonic_exp (F2R (Float beta m e)) <= e )%Z ->
+  ( m <> 0 -> cexp (F2R (Float beta m e)) <= e )%Z ->
   generic_format (F2R (Float beta m e)).
 Proof.
 intros m e.
-destruct (Z_eq_dec m 0) as [Zm|Zm].
+destruct (Z.eq_dec m 0) as [Zm|Zm].
 intros _.
 rewrite Zm, F2R_0.
 apply generic_format_0.
 unfold generic_format, scaled_mantissa.
-set (e' := canonic_exp (F2R (Float beta m e))).
+set (e' := cexp (F2R (Float beta m e))).
 intros He.
 specialize (He Zm).
 unfold F2R at 3. simpl.
 rewrite  F2R_change_exp with (1 := He).
-apply F2R_eq_compat.
-rewrite Rmult_assoc, <- bpow_plus, <- Z2R_Zpower, <- Z2R_mult.
-now rewrite Ztrunc_Z2R.
+apply F2R_eq.
+rewrite Rmult_assoc, <- bpow_plus, <- IZR_Zpower, <- mult_IZR.
+now rewrite Ztrunc_IZR.
 now apply Zle_left.
 Qed.
 
-Lemma generic_format_F2R': forall (x:R) (f:float beta),
-       F2R f = x -> ((x <> 0)%R ->
-       (canonic_exp x <= Fexp f)%Z) ->
-       generic_format x.
+Lemma generic_format_F2R' :
+  forall (x : R) (f : float beta),
+  F2R f = x ->
+  (x <> 0%R -> (cexp x <= Fexp f)%Z) ->
+  generic_format x.
 Proof.
 intros x f H1 H2.
 rewrite <- H1; destruct f as (m,e).
-apply  generic_format_F2R.
+apply generic_format_F2R.
 simpl in *; intros H3.
 rewrite H1; apply H2.
 intros Y; apply H3.
-apply F2R_eq_0_reg with beta e.
+apply eq_0_F2R with beta e.
 now rewrite H1.
 Qed.
 
-
-Theorem canonic_opp :
+Theorem canonical_opp :
   forall m e,
-  canonic (Float beta m e) ->
-  canonic (Float beta (-m) e).
+  canonical (Float beta m e) ->
+  canonical (Float beta (-m) e).
 Proof.
 intros m e H.
-unfold canonic.
-now rewrite F2R_Zopp, canonic_exp_opp.
+unfold canonical.
+now rewrite F2R_Zopp, cexp_opp.
 Qed.
 
-Theorem canonic_abs :
+Theorem canonical_abs :
   forall m e,
-  canonic (Float beta m e) ->
-  canonic (Float beta (Zabs m) e).
+  canonical (Float beta m e) ->
+  canonical (Float beta (Z.abs m) e).
 Proof.
 intros m e H.
-unfold canonic.
-now rewrite F2R_Zabs, canonic_exp_abs.
+unfold canonical.
+now rewrite F2R_Zabs, cexp_abs.
 Qed.
 
-Theorem canonic_0: canonic (Float beta 0 (fexp (ln_beta beta 0%R))).
+Theorem canonical_0 :
+  canonical (Float beta 0 (fexp (mag beta 0%R))).
 Proof.
-unfold canonic; simpl; unfold canonic_exp.
-replace (F2R {| Fnum := 0; Fexp := fexp (ln_beta beta 0) |}) with 0%R.
-reflexivity.
-unfold F2R; simpl; ring.
+unfold canonical; simpl ; unfold cexp.
+now rewrite F2R_0.
 Qed.
 
-
-
-Theorem canonic_unicity :
+Theorem canonical_unique :
   forall f1 f2,
-  canonic f1 ->
-  canonic f2 ->
+  canonical f1 ->
+  canonical f2 ->
   F2R f1 = F2R f2 ->
   f1 = f2.
 Proof.
 intros (m1, e1) (m2, e2).
-unfold canonic. simpl.
+unfold canonical. simpl.
 intros H1 H2 H.
 rewrite H in H1.
 rewrite <- H2 in H1. clear H2.
 rewrite H1 in H |- *.
 apply (f_equal (fun m => Float beta m e2)).
-apply F2R_eq_reg with (1 := H).
+apply eq_F2R with (1 := H).
 Qed.
 
 Theorem scaled_mantissa_generic :
   forall x,
   generic_format x ->
-  scaled_mantissa x = Z2R (Ztrunc (scaled_mantissa x)).
+  scaled_mantissa x = IZR (Ztrunc (scaled_mantissa x)).
 Proof.
 intros x Hx.
 unfold scaled_mantissa.
 pattern x at 1 3 ; rewrite Hx.
 unfold F2R. simpl.
 rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
-now rewrite Ztrunc_Z2R.
+now rewrite Ztrunc_IZR.
 Qed.
 
 Theorem scaled_mantissa_mult_bpow :
   forall x,
-  (scaled_mantissa x * bpow (canonic_exp x))%R = x.
+  (scaled_mantissa x * bpow (cexp x))%R = x.
 Proof.
 intros x.
 unfold scaled_mantissa.
@@ -263,7 +270,7 @@ Theorem scaled_mantissa_opp :
 Proof.
 intros x.
 unfold scaled_mantissa.
-rewrite canonic_exp_opp.
+rewrite cexp_opp.
 now rewrite Ropp_mult_distr_l_reverse.
 Qed.
 
@@ -273,7 +280,7 @@ Theorem scaled_mantissa_abs :
 Proof.
 intros x.
 unfold scaled_mantissa.
-rewrite canonic_exp_abs, Rabs_mult.
+rewrite cexp_abs, Rabs_mult.
 apply f_equal.
 apply sym_eq.
 apply Rabs_pos_eq.
@@ -285,7 +292,7 @@ Theorem generic_format_opp :
 Proof.
 intros x Hx.
 unfold generic_format.
-rewrite scaled_mantissa_opp, canonic_exp_opp.
+rewrite scaled_mantissa_opp, cexp_opp.
 rewrite Ztrunc_opp.
 rewrite F2R_Zopp.
 now apply f_equal.
@@ -296,7 +303,7 @@ Theorem generic_format_abs :
 Proof.
 intros x Hx.
 unfold generic_format.
-rewrite scaled_mantissa_abs, canonic_exp_abs.
+rewrite scaled_mantissa_abs, cexp_abs.
 rewrite Ztrunc_abs.
 rewrite F2R_Zabs.
 now apply f_equal.
@@ -308,7 +315,7 @@ Proof.
 intros x.
 unfold generic_format, Rabs.
 case Rcase_abs ; intros _.
-rewrite scaled_mantissa_opp, canonic_exp_opp, Ztrunc_opp.
+rewrite scaled_mantissa_opp, cexp_opp, Ztrunc_opp.
 intros H.
 rewrite <- (Ropp_involutive x) at 1.
 rewrite H, F2R_Zopp.
@@ -316,23 +323,23 @@ apply Ropp_involutive.
 easy.
 Qed.
 
-Theorem canonic_exp_fexp :
+Theorem cexp_fexp :
   forall x ex,
   (bpow (ex - 1) <= Rabs x < bpow ex)%R ->
-  canonic_exp x = fexp ex.
+  cexp x = fexp ex.
 Proof.
 intros x ex Hx.
-unfold canonic_exp.
-now rewrite ln_beta_unique with (1 := Hx).
+unfold cexp.
+now rewrite mag_unique with (1 := Hx).
 Qed.
 
-Theorem canonic_exp_fexp_pos :
+Theorem cexp_fexp_pos :
   forall x ex,
   (bpow (ex - 1) <= x < bpow ex)%R ->
-  canonic_exp x = fexp ex.
+  cexp x = fexp ex.
 Proof.
 intros x ex Hx.
-apply canonic_exp_fexp.
+apply cexp_fexp.
 rewrite Rabs_pos_eq.
 exact Hx.
 apply Rle_trans with (2 := proj1 Hx).
@@ -360,7 +367,7 @@ apply Rlt_le_trans with (1 := proj2 Hx).
 now apply bpow_le.
 Qed.
 
-Theorem scaled_mantissa_small :
+Theorem scaled_mantissa_lt_1 :
   forall x ex,
   (Rabs x < bpow ex)%R ->
   (ex <= fexp ex)%Z ->
@@ -369,62 +376,62 @@ Proof.
 intros x ex Ex He.
 destruct (Req_dec x 0) as [Zx|Zx].
 rewrite Zx, scaled_mantissa_0, Rabs_R0.
-now apply (Z2R_lt 0 1).
+now apply IZR_lt.
 rewrite <- scaled_mantissa_abs.
 unfold scaled_mantissa.
-rewrite canonic_exp_abs.
-unfold canonic_exp.
-destruct (ln_beta beta x) as (ex', Ex').
+rewrite cexp_abs.
+unfold cexp.
+destruct (mag beta x) as (ex', Ex').
 simpl.
 specialize (Ex' Zx).
 apply (mantissa_small_pos _ _ Ex').
 assert (ex' <= fexp ex)%Z.
-apply Zle_trans with (2 := He).
+apply Z.le_trans with (2 := He).
 apply bpow_lt_bpow with beta.
 now apply Rle_lt_trans with (2 := Ex).
 now rewrite (proj2 (proj2 (valid_exp _) He)).
 Qed.
 
-Theorem abs_scaled_mantissa_lt_bpow :
+Theorem scaled_mantissa_lt_bpow :
   forall x,
-  (Rabs (scaled_mantissa x) < bpow (ln_beta beta x - canonic_exp x))%R.
+  (Rabs (scaled_mantissa x) < bpow (mag beta x - cexp x))%R.
 Proof.
 intros x.
 destruct (Req_dec x 0) as [Zx|Zx].
 rewrite Zx, scaled_mantissa_0, Rabs_R0.
 apply bpow_gt_0.
-apply Rlt_le_trans with (1 := bpow_ln_beta_gt beta _).
+apply Rlt_le_trans with (1 := bpow_mag_gt beta _).
 apply bpow_le.
 unfold scaled_mantissa.
-rewrite ln_beta_mult_bpow with (1 := Zx).
-apply Zle_refl.
+rewrite mag_mult_bpow with (1 := Zx).
+apply Z.le_refl.
 Qed.
 
-Theorem ln_beta_generic_gt :
+Theorem mag_generic_gt :
   forall x, (x <> 0)%R ->
   generic_format x ->
-  (canonic_exp x < ln_beta beta x)%Z.
+  (cexp x < mag beta x)%Z.
 Proof.
 intros x Zx Gx.
 apply Znot_ge_lt.
-unfold canonic_exp.
-destruct (ln_beta beta x) as (ex,Ex) ; simpl.
+unfold cexp.
+destruct (mag beta x) as (ex,Ex) ; simpl.
 specialize (Ex Zx).
 intros H.
-apply Zge_le in H.
-generalize (scaled_mantissa_small x ex (proj2 Ex) H).
+apply Z.ge_le in H.
+generalize (scaled_mantissa_lt_1 x ex (proj2 Ex) H).
 contradict Zx.
 rewrite Gx.
 replace (Ztrunc (scaled_mantissa x)) with Z0.
 apply F2R_0.
-cut (Zabs (Ztrunc (scaled_mantissa x)) < 1)%Z.
+cut (Z.abs (Ztrunc (scaled_mantissa x)) < 1)%Z.
 clear ; zify ; omega.
-apply lt_Z2R.
-rewrite Z2R_abs.
+apply lt_IZR.
+rewrite abs_IZR.
 now rewrite <- scaled_mantissa_generic.
 Qed.
 
-Theorem mantissa_DN_small_pos :
+Lemma mantissa_DN_small_pos :
   forall x ex,
   (bpow (ex - 1) <= x < bpow ex)%R ->
   (ex <= fexp ex)%Z ->
@@ -436,7 +443,7 @@ assert (H := mantissa_small_pos x ex Hx He).
 split ; try apply Rlt_le ; apply H.
 Qed.
 
-Theorem mantissa_UP_small_pos :
+Lemma mantissa_UP_small_pos :
   forall x ex,
   (bpow (ex - 1) <= x < bpow ex)%R ->
   (ex <= fexp ex)%Z ->
@@ -451,7 +458,7 @@ Qed.
 (** Generic facts about any format *)
 Theorem generic_format_discrete :
   forall x m,
-  let e := canonic_exp x in
+  let e := cexp x in
   (F2R (Float beta m e) < x < F2R (Float beta (m + 1) e))%R ->
   ~ generic_format x.
 Proof.
@@ -459,27 +466,27 @@ intros x m e (Hx,Hx2) Hf.
 apply Rlt_not_le with (1 := Hx2). clear Hx2.
 rewrite Hf.
 fold e.
-apply F2R_le_compat.
+apply F2R_le.
 apply Zlt_le_succ.
-apply lt_Z2R.
+apply lt_IZR.
 rewrite <- scaled_mantissa_generic with (1 := Hf).
 apply Rmult_lt_reg_r with (bpow e).
 apply bpow_gt_0.
 now rewrite scaled_mantissa_mult_bpow.
 Qed.
 
-Theorem generic_format_canonic :
-  forall f, canonic f ->
+Theorem generic_format_canonical :
+  forall f, canonical f ->
   generic_format (F2R f).
 Proof.
 intros (m, e) Hf.
-unfold canonic in Hf. simpl in Hf.
+unfold canonical in Hf. simpl in Hf.
 unfold generic_format, scaled_mantissa.
 rewrite <- Hf.
-apply F2R_eq_compat.
+apply F2R_eq.
 unfold F2R. simpl.
 rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
-now rewrite Ztrunc_Z2R.
+now rewrite Ztrunc_IZR.
 Qed.
 
 Theorem generic_format_ge_bpow :
@@ -492,10 +499,10 @@ Theorem generic_format_ge_bpow :
 Proof.
 intros emin Emin x Hx Fx.
 rewrite Fx.
-apply Rle_trans with (bpow (fexp (ln_beta beta x))).
+apply Rle_trans with (bpow (fexp (mag beta x))).
 now apply bpow_le.
 apply bpow_le_F2R.
-apply F2R_gt_0_reg with beta (canonic_exp x).
+apply gt_0_F2R with beta (cexp x).
 now rewrite <- Fx.
 Qed.
 
@@ -504,13 +511,13 @@ Theorem abs_lt_bpow_prec:
   (forall e, (e - prec <= fexp e)%Z) ->
   (* OK with FLX, FLT and FTZ *)
   forall x,
-  (Rabs x < bpow (prec + canonic_exp x))%R.
+  (Rabs x < bpow (prec + cexp x))%R.
 intros prec Hp x.
 case (Req_dec x 0); intros Hxz.
 rewrite Hxz, Rabs_R0.
 apply bpow_gt_0.
-unfold canonic_exp.
-destruct (ln_beta beta x) as (ex,Ex) ; simpl.
+unfold cexp.
+destruct (mag beta x) as (ex,Ex) ; simpl.
 specialize (Ex Hxz).
 apply Rlt_le_trans with (1 := proj2 Ex).
 apply bpow_le.
@@ -526,8 +533,8 @@ Proof.
 intros e He.
 apply Znot_gt_le.
 contradict He.
-unfold generic_format, scaled_mantissa, canonic_exp, F2R. simpl.
-rewrite ln_beta_bpow, <- bpow_plus.
+unfold generic_format, scaled_mantissa, cexp, F2R. simpl.
+rewrite mag_bpow, <- bpow_plus.
 apply Rgt_not_eq.
 rewrite Ztrunc_floor.
 2: apply bpow_ge_0.
@@ -559,7 +566,7 @@ Variable rnd : R -> Z.
 
 Class Valid_rnd := {
   Zrnd_le : forall x y, (x <= y)%R -> (rnd x <= rnd y)%Z ;
-  Zrnd_Z2R : forall n, rnd (Z2R n) = n
+  Zrnd_IZR : forall n, rnd (IZR n) = n
 }.
 
 Context { valid_rnd : Valid_rnd }.
@@ -571,20 +578,20 @@ intros x.
 destruct (Zle_or_lt (rnd x) (Zfloor x)) as [Hx|Hx].
 left.
 apply Zle_antisym with (1 := Hx).
-rewrite <- (Zrnd_Z2R (Zfloor x)).
+rewrite <- (Zrnd_IZR (Zfloor x)).
 apply Zrnd_le.
 apply Zfloor_lb.
 right.
 apply Zle_antisym.
-rewrite <- (Zrnd_Z2R (Zceil x)).
+rewrite <- (Zrnd_IZR (Zceil x)).
 apply Zrnd_le.
 apply Zceil_ub.
 rewrite Zceil_floor_neq.
 omega.
 intros H.
 rewrite <- H in Hx.
-rewrite Zfloor_Z2R, Zrnd_Z2R in Hx.
-apply Zlt_irrefl with (1 := Hx).
+rewrite Zfloor_IZR, Zrnd_IZR in Hx.
+apply Z.lt_irrefl with (1 := Hx).
 Qed.
 
 Theorem Zrnd_ZR_or_AW :
@@ -602,7 +609,7 @@ Qed.
 
 (** the most useful one: R -> F *)
 Definition round x :=
-  F2R (Float beta (rnd (scaled_mantissa x)) (canonic_exp x)).
+  F2R (Float beta (rnd (scaled_mantissa x)) (cexp x)).
 
 Theorem round_bounded_large_pos :
   forall x ex,
@@ -612,7 +619,7 @@ Theorem round_bounded_large_pos :
 Proof.
 intros x ex He Hx.
 unfold round, scaled_mantissa.
-rewrite (canonic_exp_fexp_pos _ _ Hx).
+rewrite (cexp_fexp_pos _ _ Hx).
 unfold F2R. simpl.
 destruct (Zrnd_DN_or_UP (x * bpow (- fexp ex))) as [Hr|Hr] ; rewrite Hr.
 (* DN *)
@@ -621,11 +628,11 @@ replace (ex - 1)%Z with (ex - 1 + - fexp ex + fexp ex)%Z by ring.
 rewrite bpow_plus.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-assert (Hf: Z2R (Zpower beta (ex - 1 - fexp ex)) = bpow (ex - 1 + - fexp ex)).
-apply Z2R_Zpower.
+assert (Hf: IZR (Zpower beta (ex - 1 - fexp ex)) = bpow (ex - 1 + - fexp ex)).
+apply IZR_Zpower.
 omega.
 rewrite <- Hf.
-apply Z2R_le.
+apply IZR_le.
 apply Zfloor_lub.
 rewrite Hf.
 rewrite bpow_plus.
@@ -648,11 +655,11 @@ pattern ex at 3 ; replace ex with (ex - fexp ex + fexp ex)%Z by ring.
 rewrite bpow_plus.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-assert (Hf: Z2R (Zpower beta (ex - fexp ex)) = bpow (ex - fexp ex)).
-apply Z2R_Zpower.
+assert (Hf: IZR (Zpower beta (ex - fexp ex)) = bpow (ex - fexp ex)).
+apply IZR_Zpower.
 omega.
 rewrite <- Hf.
-apply Z2R_le.
+apply IZR_le.
 apply Zceil_glb.
 rewrite Hf.
 unfold Zminus.
@@ -671,13 +678,13 @@ Theorem round_bounded_small_pos :
 Proof.
 intros x ex He Hx.
 unfold round, scaled_mantissa.
-rewrite (canonic_exp_fexp_pos _ _ Hx).
+rewrite (cexp_fexp_pos _ _ Hx).
 unfold F2R. simpl.
 destruct (Zrnd_DN_or_UP (x * bpow (-fexp ex))) as [Hr|Hr] ; rewrite Hr.
 (* DN *)
 left.
 apply Rmult_eq_0_compat_r.
-apply (@f_equal _ _ Z2R _ Z0).
+apply IZR_eq.
 apply Zfloor_imp.
 refine (let H := _ in conj (Rlt_le _ _ (proj1 H)) (proj2 H)).
 now apply mantissa_small_pos.
@@ -685,18 +692,18 @@ now apply mantissa_small_pos.
 right.
 pattern (bpow (fexp ex)) at 2 ; rewrite <- Rmult_1_l.
 apply (f_equal (fun m => (m * bpow (fexp ex))%R)).
-apply (@f_equal _ _ Z2R _ 1%Z).
+apply IZR_eq.
 apply Zceil_imp.
 refine (let H := _ in conj (proj1 H) (Rlt_le _ _ (proj2 H))).
 now apply mantissa_small_pos.
 Qed.
 
-Theorem round_le_pos :
+Lemma round_le_pos :
   forall x y, (0 < x)%R -> (x <= y)%R -> (round x <= round y)%R.
 Proof.
 intros x y Hx Hxy.
-destruct (ln_beta beta x) as [ex Hex].
-destruct (ln_beta beta y) as [ey Hey].
+destruct (mag beta x) as [ex Hex].
+destruct (mag beta y) as [ey Hey].
 specialize (Hex (Rgt_not_eq _ _ Hx)).
 specialize (Hey (Rgt_not_eq _ _ (Rlt_le_trans _ _ _ Hx Hxy))).
 rewrite Rabs_pos_eq in Hex.
@@ -709,18 +716,18 @@ assert (He: (ex <= ey)%Z).
   now apply Rle_lt_trans with y.
 assert (Heq: fexp ex = fexp ey -> (round x <= round y)%R).
   intros H.
-  unfold round, scaled_mantissa, canonic_exp.
-  rewrite ln_beta_unique_pos with (1 := Hex).
-  rewrite ln_beta_unique_pos with (1 := Hey).
+  unfold round, scaled_mantissa, cexp.
+  rewrite mag_unique_pos with (1 := Hex).
+  rewrite mag_unique_pos with (1 := Hey).
   rewrite H.
-  apply F2R_le_compat.
+  apply F2R_le.
   apply Zrnd_le.
   apply Rmult_le_compat_r with (2 := Hxy).
   apply bpow_ge_0.
 destruct (Zle_or_lt ey (fexp ey)) as [Hy1|Hy1].
   apply Heq.
   apply valid_exp with (1 := Hy1).
-  now apply Zle_trans with ey.
+  now apply Z.le_trans with ey.
 destruct (Zle_lt_or_eq _ _ He) as [He'|He'].
 2: now apply Heq, f_equal.
 apply Rle_trans with (bpow (ey - 1)).
@@ -746,7 +753,7 @@ Proof.
 intros x Hx.
 unfold round.
 rewrite scaled_mantissa_generic with (1 := Hx).
-rewrite Zrnd_Z2R.
+rewrite Zrnd_IZR.
 now apply sym_eq.
 Qed.
 
@@ -755,8 +762,7 @@ Theorem round_0 :
 Proof.
 unfold round, scaled_mantissa.
 rewrite Rmult_0_l.
-change 0%R with (Z2R 0).
-rewrite Zrnd_Z2R.
+rewrite Zrnd_IZR.
 apply F2R_0.
 Qed.
 
@@ -774,13 +780,13 @@ apply bpow_gt_0.
 apply (round_bounded_large_pos); assumption.
 Qed.
 
-Theorem generic_format_round_pos :
+Lemma generic_format_round_pos :
   forall x,
   (0 < x)%R ->
   generic_format (round x).
 Proof.
 intros x Hx0.
-destruct (ln_beta beta x) as (ex, Hex).
+destruct (mag beta x) as (ex, Hex).
 specialize (Hex (Rgt_not_eq _ _ Hx0)).
 rewrite Rabs_pos_eq in Hex. 2: now apply Rlt_le.
 destruct (Zle_or_lt ex (fexp ex)) as [He|He].
@@ -798,8 +804,8 @@ apply generic_format_bpow.
 now apply valid_exp.
 apply generic_format_F2R.
 intros _.
-rewrite (canonic_exp_fexp_pos (F2R _) _ (conj Hr1 Hr)).
-rewrite (canonic_exp_fexp_pos _ _ Hex).
+rewrite (cexp_fexp_pos (F2R _) _ (conj Hr1 Hr)).
+rewrite (cexp_fexp_pos _ _ Hex).
 now apply Zeq_le.
 Qed.
 
@@ -821,7 +827,7 @@ Section Zround_opp.
 Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
 
-Definition Zrnd_opp x := Zopp (rnd (-x)).
+Definition Zrnd_opp x := Z.opp (rnd (-x)).
 
 Global Instance valid_rnd_opp : Valid_rnd Zrnd_opp.
 Proof with auto with typeclass_instances.
@@ -830,14 +836,14 @@ split.
 intros x y Hxy.
 unfold Zrnd_opp.
 apply Zopp_le_cancel.
-rewrite 2!Zopp_involutive.
+rewrite 2!Z.opp_involutive.
 apply Zrnd_le...
 now apply Ropp_le_contravar.
 (* *)
 intros n.
 unfold Zrnd_opp.
-rewrite <- Z2R_opp, Zrnd_Z2R...
-apply Zopp_involutive.
+rewrite <- opp_IZR, Zrnd_IZR...
+apply Z.opp_involutive.
 Qed.
 
 Theorem round_opp :
@@ -846,10 +852,10 @@ Theorem round_opp :
 Proof.
 intros x.
 unfold round.
-rewrite <- F2R_Zopp, canonic_exp_opp, scaled_mantissa_opp.
-apply F2R_eq_compat.
+rewrite <- F2R_Zopp, cexp_opp, scaled_mantissa_opp.
+apply F2R_eq.
 apply sym_eq.
-exact (Zopp_involutive _).
+exact (Z.opp_involutive _).
 Qed.
 
 End Zround_opp.
@@ -860,28 +866,28 @@ Global Instance valid_rnd_DN : Valid_rnd Zfloor.
 Proof.
 split.
 apply Zfloor_le.
-apply Zfloor_Z2R.
+apply Zfloor_IZR.
 Qed.
 
 Global Instance valid_rnd_UP : Valid_rnd Zceil.
 Proof.
 split.
 apply Zceil_le.
-apply Zceil_Z2R.
+apply Zceil_IZR.
 Qed.
 
 Global Instance valid_rnd_ZR : Valid_rnd Ztrunc.
 Proof.
 split.
 apply Ztrunc_le.
-apply Ztrunc_Z2R.
+apply Ztrunc_IZR.
 Qed.
 
 Global Instance valid_rnd_AW : Valid_rnd Zaway.
 Proof.
 split.
 apply Zaway_le.
-apply Zaway_Z2R.
+apply Zaway_IZR.
 Qed.
 
 Section monotone.
@@ -923,7 +929,7 @@ destruct (Rlt_or_le y 0) as [Hy|Hy].
 (* . y < 0 *)
 rewrite <- (Ropp_involutive x), <- (Ropp_involutive y).
 rewrite (scaled_mantissa_opp (-x)), (scaled_mantissa_opp (-y)).
-rewrite (canonic_exp_opp (-x)), (canonic_exp_opp (-y)).
+rewrite (cexp_opp (-x)), (cexp_opp (-y)).
 apply Ropp_le_cancel.
 rewrite <- 2!F2R_Zopp.
 apply (round_le_pos (Zrnd_opp rnd) (-y) (-x)).
@@ -932,16 +938,16 @@ now apply Ropp_lt_contravar.
 now apply Ropp_le_contravar.
 (* . 0 <= y *)
 apply Rle_trans with 0%R.
-apply F2R_le_0_compat. simpl.
-rewrite <- (Zrnd_Z2R rnd 0).
+apply F2R_le_0. simpl.
+rewrite <- (Zrnd_IZR rnd 0).
 apply Zrnd_le...
 simpl.
-rewrite <- (Rmult_0_l (bpow (- fexp (ln_beta beta x)))).
+rewrite <- (Rmult_0_l (bpow (- fexp (mag beta x)))).
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
 now apply Rlt_le.
-apply F2R_ge_0_compat. simpl.
-rewrite <- (Zrnd_Z2R rnd 0).
+apply F2R_ge_0. simpl.
+rewrite <- (Zrnd_IZR rnd 0).
 apply Zrnd_le...
 apply Rmult_le_pos.
 exact Hy.
@@ -949,9 +955,9 @@ apply bpow_ge_0.
 (* x = 0 *)
 rewrite Hx.
 rewrite round_0...
-apply F2R_ge_0_compat.
+apply F2R_ge_0.
 simpl.
-rewrite <- (Zrnd_Z2R rnd 0).
+rewrite <- (Zrnd_IZR rnd 0).
 apply Zrnd_le...
 apply Rmult_le_pos.
 now rewrite <- Hx.
@@ -1071,8 +1077,8 @@ unfold round.
 rewrite scaled_mantissa_opp.
 rewrite <- F2R_Zopp.
 unfold Zceil.
-rewrite Zopp_involutive.
-now rewrite canonic_exp_opp.
+rewrite Z.opp_involutive.
+now rewrite cexp_opp.
 Qed.
 
 Theorem round_UP_opp :
@@ -1085,7 +1091,7 @@ rewrite scaled_mantissa_opp.
 rewrite <- F2R_Zopp.
 unfold Zceil.
 rewrite Ropp_involutive.
-now rewrite canonic_exp_opp.
+now rewrite cexp_opp.
 Qed.
 
 Theorem round_ZR_opp :
@@ -1094,7 +1100,7 @@ Theorem round_ZR_opp :
 Proof.
 intros x.
 unfold round.
-rewrite scaled_mantissa_opp, canonic_exp_opp, Ztrunc_opp.
+rewrite scaled_mantissa_opp, cexp_opp, Ztrunc_opp.
 apply F2R_Zopp.
 Qed.
 
@@ -1123,7 +1129,7 @@ Theorem round_AW_opp :
 Proof.
 intros x.
 unfold round.
-rewrite scaled_mantissa_opp, canonic_exp_opp, Zaway_opp.
+rewrite scaled_mantissa_opp, cexp_opp, Zaway_opp.
 apply F2R_Zopp.
 Qed.
 
@@ -1146,7 +1152,7 @@ apply round_le...
 now apply Rge_le.
 Qed.
 
-Theorem round_ZR_pos :
+Theorem round_ZR_DN :
   forall x,
   (0 <= x)%R ->
   round Ztrunc x = round Zfloor x.
@@ -1156,13 +1162,13 @@ unfold round, Ztrunc.
 case Rlt_bool_spec.
 intros H.
 elim Rlt_not_le with (1 := H).
-rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+rewrite <- (Rmult_0_l (bpow (- cexp x))).
 apply Rmult_le_compat_r with (2 := Hx).
 apply bpow_ge_0.
 easy.
 Qed.
 
-Theorem round_ZR_neg :
+Theorem round_ZR_UP :
   forall x,
   (x <= 0)%R ->
   round Ztrunc x = round Zceil x.
@@ -1173,15 +1179,14 @@ case Rlt_bool_spec.
 easy.
 intros [H|H].
 elim Rlt_not_le with (1 := H).
-rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+rewrite <- (Rmult_0_l (bpow (- cexp x))).
 apply Rmult_le_compat_r with (2 := Hx).
 apply bpow_ge_0.
 rewrite <- H.
-change 0%R with (Z2R 0).
-now rewrite Zfloor_Z2R, Zceil_Z2R.
+now rewrite Zfloor_IZR, Zceil_IZR.
 Qed.
 
-Theorem round_AW_pos :
+Theorem round_AW_UP :
   forall x,
   (0 <= x)%R ->
   round Zaway x = round Zceil x.
@@ -1191,13 +1196,13 @@ unfold round, Zaway.
 case Rlt_bool_spec.
 intros H.
 elim Rlt_not_le with (1 := H).
-rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+rewrite <- (Rmult_0_l (bpow (- cexp x))).
 apply Rmult_le_compat_r with (2 := Hx).
 apply bpow_ge_0.
 easy.
 Qed.
 
-Theorem round_AW_neg :
+Theorem round_AW_DN :
   forall x,
   (x <= 0)%R ->
   round Zaway x = round Zfloor x.
@@ -1208,12 +1213,11 @@ case Rlt_bool_spec.
 easy.
 intros [H|H].
 elim Rlt_not_le with (1 := H).
-rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+rewrite <- (Rmult_0_l (bpow (- cexp x))).
 apply Rmult_le_compat_r with (2 := Hx).
 apply bpow_ge_0.
 rewrite <- H.
-change 0%R with (Z2R 0).
-now rewrite Zfloor_Z2R, Zceil_Z2R.
+now rewrite Zfloor_IZR, Zceil_IZR.
 Qed.
 
 Theorem generic_format_round :
@@ -1275,7 +1279,7 @@ Proof.
 intros x.
 rewrite <- (Ropp_involutive x).
 rewrite round_UP_opp.
-apply Rnd_DN_UP_pt_sym.
+apply Rnd_UP_pt_opp.
 apply generic_format_opp.
 apply round_DN_pt.
 Qed.
@@ -1286,22 +1290,22 @@ Theorem round_ZR_pt :
 Proof.
 intros x.
 split ; intros Hx.
-rewrite round_ZR_pos with (1 := Hx).
+rewrite round_ZR_DN with (1 := Hx).
 apply round_DN_pt.
-rewrite round_ZR_neg with (1 := Hx).
+rewrite round_ZR_UP with (1 := Hx).
 apply round_UP_pt.
 Qed.
 
-Theorem round_DN_small_pos :
+Lemma round_DN_small_pos :
   forall x ex,
   (bpow (ex - 1) <= x < bpow ex)%R ->
   (ex <= fexp ex)%Z ->
   round Zfloor x = 0%R.
 Proof.
 intros x ex Hx He.
-rewrite <- (F2R_0 beta (canonic_exp x)).
+rewrite <- (F2R_0 beta (cexp x)).
 rewrite <- mantissa_DN_small_pos with (1 := Hx) (2 := He).
-now rewrite <- canonic_exp_fexp_pos with (1 := Hx).
+now rewrite <- cexp_fexp_pos with (1 := Hx).
 Qed.
 
 
@@ -1329,7 +1333,7 @@ contradict Fx.
 apply generic_format_round...
 Qed.
 
-Theorem round_UP_small_pos :
+Lemma round_UP_small_pos :
   forall x ex,
   (bpow (ex - 1) <= x < bpow ex)%R ->
   (ex <= fexp ex)%Z ->
@@ -1338,7 +1342,7 @@ Proof.
 intros x ex Hx He.
 rewrite <- F2R_bpow.
 rewrite <- mantissa_UP_small_pos with (1 := Hx) (2 := He).
-now rewrite <- canonic_exp_fexp_pos with (1 := Hx).
+now rewrite <- cexp_fexp_pos with (1 := Hx).
 Qed.
 
 Theorem generic_format_EM :
@@ -1361,14 +1365,14 @@ Section round_large.
 Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
 
-Theorem round_large_pos_ge_pow :
+Lemma round_large_pos_ge_bpow :
   forall x e,
   (0 < round rnd x)%R ->
   (bpow e <= x)%R ->
   (bpow e <= round rnd x)%R.
 Proof.
 intros x e Hd Hex.
-destruct (ln_beta beta x) as (ex, He).
+destruct (mag beta x) as (ex, He).
 assert (Hx: (0 < x)%R).
 apply Rlt_le_trans with (2 := Hex).
 apply bpow_gt_0.
@@ -1391,95 +1395,95 @@ Qed.
 
 End round_large.
 
-Theorem ln_beta_round_ZR :
+Theorem mag_round_ZR :
   forall x,
   (round Ztrunc x <> 0)%R ->
-  (ln_beta beta (round Ztrunc x) = ln_beta beta x :> Z).
+  (mag beta (round Ztrunc x) = mag beta x :> Z).
 Proof with auto with typeclass_instances.
 intros x Zr.
 destruct (Req_dec x 0) as [Zx|Zx].
 rewrite Zx, round_0...
-apply ln_beta_unique.
-destruct (ln_beta beta x) as (ex, Ex) ; simpl.
+apply mag_unique.
+destruct (mag beta x) as (ex, Ex) ; simpl.
 specialize (Ex Zx).
 rewrite <- round_ZR_abs.
 split.
-apply round_large_pos_ge_pow...
+apply round_large_pos_ge_bpow...
 rewrite round_ZR_abs.
 now apply Rabs_pos_lt.
 apply Ex.
 apply Rle_lt_trans with (2 := proj2 Ex).
-rewrite round_ZR_pos.
+rewrite round_ZR_DN.
 apply round_DN_pt.
 apply Rabs_pos.
 Qed.
 
-Theorem ln_beta_round :
+Theorem mag_round :
   forall rnd {Hrnd : Valid_rnd rnd} x,
   (round rnd x <> 0)%R ->
-  (ln_beta beta (round rnd x) = ln_beta beta x :> Z) \/
-  Rabs (round rnd x) = bpow (Zmax (ln_beta beta x) (fexp (ln_beta beta x))).
+  (mag beta (round rnd x) = mag beta x :> Z) \/
+  Rabs (round rnd x) = bpow (Z.max (mag beta x) (fexp (mag beta x))).
 Proof with auto with typeclass_instances.
 intros rnd Hrnd x.
 destruct (round_ZR_or_AW rnd x) as [Hr|Hr] ; rewrite Hr ; clear Hr rnd Hrnd.
 left.
-now apply ln_beta_round_ZR.
+now apply mag_round_ZR.
 intros Zr.
 destruct (Req_dec x 0) as [Zx|Zx].
 rewrite Zx, round_0...
-destruct (ln_beta beta x) as (ex, Ex) ; simpl.
+destruct (mag beta x) as (ex, Ex) ; simpl.
 specialize (Ex Zx).
-rewrite <- ln_beta_abs.
+rewrite <- mag_abs.
 rewrite <- round_AW_abs.
 destruct (Zle_or_lt ex (fexp ex)) as [He|He].
 right.
-rewrite Zmax_r with (1 := He).
-rewrite round_AW_pos with (1 := Rabs_pos _).
+rewrite Z.max_r with (1 := He).
+rewrite round_AW_UP with (1 := Rabs_pos _).
 now apply round_UP_small_pos.
 destruct (round_bounded_large_pos Zaway _ ex He Ex) as (H1,[H2|H2]).
 left.
-apply ln_beta_unique.
+apply mag_unique.
 rewrite <- round_AW_abs, Rabs_Rabsolu.
 now split.
 right.
-now rewrite Zmax_l with (1 := Zlt_le_weak _ _ He).
+now rewrite Z.max_l with (1 := Zlt_le_weak _ _ He).
 Qed.
 
-Theorem ln_beta_DN :
+Theorem mag_DN :
   forall x,
   (0 < round Zfloor x)%R ->
-  (ln_beta beta (round Zfloor x) = ln_beta beta x :> Z).
+  (mag beta (round Zfloor x) = mag beta x :> Z).
 Proof.
 intros x Hd.
 assert (0 < x)%R.
 apply Rlt_le_trans with (1 := Hd).
 apply round_DN_pt.
 revert Hd.
-rewrite <- round_ZR_pos.
+rewrite <- round_ZR_DN.
 intros Hd.
-apply ln_beta_round_ZR.
+apply mag_round_ZR.
 now apply Rgt_not_eq.
 now apply Rlt_le.
 Qed.
 
-Theorem canonic_exp_DN :
+Theorem cexp_DN :
   forall x,
   (0 < round Zfloor x)%R ->
-  canonic_exp (round Zfloor x) = canonic_exp x.
+  cexp (round Zfloor x) = cexp x.
 Proof.
 intros x Hd.
 apply (f_equal fexp).
-now apply ln_beta_DN.
+now apply mag_DN.
 Qed.
 
 Theorem scaled_mantissa_DN :
   forall x,
   (0 < round Zfloor x)%R ->
-  scaled_mantissa (round Zfloor x) = Z2R (Zfloor (scaled_mantissa x)).
+  scaled_mantissa (round Zfloor x) = IZR (Zfloor (scaled_mantissa x)).
 Proof.
 intros x Hd.
 unfold scaled_mantissa.
-rewrite canonic_exp_DN with (1 := Hd).
+rewrite cexp_DN with (1 := Hd).
 unfold round, F2R. simpl.
 now rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
 Qed.
@@ -1492,10 +1496,10 @@ Proof.
 intros x f Hxf.
 destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf).
 left.
-apply Rnd_DN_pt_unicity with (1 := H).
+apply Rnd_DN_pt_unique with (1 := H).
 apply round_DN_pt.
 right.
-apply Rnd_UP_pt_unicity with (1 := H).
+apply Rnd_UP_pt_unique with (1 := H).
 apply round_UP_pt.
 Qed.
 
@@ -1516,20 +1520,20 @@ intros e x He Hx.
 pattern x at 2 ; rewrite Hx.
 unfold F2R at 2. simpl.
 rewrite Rmult_assoc, <- bpow_plus.
-assert (H: Z2R (Zpower beta (canonic_exp x + - fexp e)) = bpow (canonic_exp x + - fexp e)).
-apply Z2R_Zpower.
-unfold canonic_exp.
-set (ex := ln_beta beta x).
+assert (H: IZR (Zpower beta (cexp x + - fexp e)) = bpow (cexp x + - fexp e)).
+apply IZR_Zpower.
+unfold cexp.
+set (ex := mag beta x).
 generalize (exp_not_FTZ ex).
 generalize (proj2 (proj2 (valid_exp _) He) (fexp ex + 1)%Z).
 omega.
 rewrite <- H.
-rewrite <- Z2R_mult, Ztrunc_Z2R.
+rewrite <- mult_IZR, Ztrunc_IZR.
 unfold F2R. simpl.
-rewrite Z2R_mult.
+rewrite mult_IZR.
 rewrite H.
 rewrite Rmult_assoc, <- bpow_plus.
-now ring_simplify (canonic_exp x + - fexp e + fexp e)%Z.
+now ring_simplify (cexp x + - fexp e + fexp e)%Z.
 Qed.
 
 End not_FTZ.
@@ -1550,60 +1554,60 @@ now apply Zlt_le_succ.
 now apply valid_exp.
 Qed.
 
-Lemma canonic_exp_le_bpow :
+Lemma cexp_le_bpow :
   forall (x : R) (e : Z),
   x <> 0%R ->
   (Rabs x < bpow e)%R ->
-  (canonic_exp x <= fexp e)%Z.
+  (cexp x <= fexp e)%Z.
 Proof.
 intros x e Zx Hx.
 apply monotone_exp.
-now apply ln_beta_le_bpow.
+now apply mag_le_bpow.
 Qed.
 
-Lemma canonic_exp_ge_bpow :
+Lemma cexp_ge_bpow :
   forall (x : R) (e : Z),
   (bpow (e - 1) <= Rabs x)%R ->
-  (fexp e <= canonic_exp x)%Z.
+  (fexp e <= cexp x)%Z.
 Proof.
 intros x e Hx.
 apply monotone_exp.
 rewrite (Zsucc_pred e).
 apply Zlt_le_succ.
-now apply ln_beta_gt_bpow.
+now apply mag_gt_bpow.
 Qed.
 
 Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
 
-Theorem ln_beta_round_ge :
+Theorem mag_round_ge :
   forall x,
   round rnd x <> 0%R ->
-  (ln_beta beta x <= ln_beta beta (round rnd x))%Z.
+  (mag beta x <= mag beta (round rnd x))%Z.
 Proof with auto with typeclass_instances.
 intros x.
 destruct (round_ZR_or_AW rnd x) as [H|H] ; rewrite H ; clear H ; intros Zr.
-rewrite ln_beta_round_ZR with (1 := Zr).
-apply Zle_refl.
-apply ln_beta_le_abs.
+rewrite mag_round_ZR with (1 := Zr).
+apply Z.le_refl.
+apply mag_le_abs.
 contradict Zr.
 rewrite Zr.
 apply round_0...
 rewrite <- round_AW_abs.
-rewrite round_AW_pos.
+rewrite round_AW_UP.
 apply round_UP_pt.
 apply Rabs_pos.
 Qed.
 
-Theorem canonic_exp_round_ge :
+Theorem cexp_round_ge :
   forall x,
   round rnd x <> 0%R ->
-  (canonic_exp x <= canonic_exp (round rnd x))%Z.
+  (cexp x <= cexp (round rnd x))%Z.
 Proof with auto with typeclass_instances.
 intros x Zr.
-unfold canonic_exp.
+unfold cexp.
 apply monotone_exp.
-now apply ln_beta_round_ge.
+now apply mag_round_ge.
 Qed.
 
 End monotone_exp.
@@ -1614,7 +1618,7 @@ Section Znearest.
 Variable choice : Z -> bool.
 
 Definition Znearest x :=
-  match Rcompare (x - Z2R (Zfloor x)) (/2) with
+  match Rcompare (x - IZR (Zfloor x)) (/2) with
   | Lt => Zfloor x
   | Eq => if choice (Zfloor x) then Zceil x else Zfloor x
   | Gt => Zceil x
@@ -1640,8 +1644,8 @@ Theorem Znearest_ge_floor :
 Proof.
 intros x.
 destruct (Znearest_DN_or_UP x) as [Hx|Hx] ; rewrite Hx.
-apply Zle_refl.
-apply le_Z2R.
+apply Z.le_refl.
+apply le_IZR.
 apply Rle_trans with x.
 apply Zfloor_lb.
 apply Zceil_ub.
@@ -1653,11 +1657,11 @@ Theorem Znearest_le_ceil :
 Proof.
 intros x.
 destruct (Znearest_DN_or_UP x) as [Hx|Hx] ; rewrite Hx.
-apply le_Z2R.
+apply le_IZR.
 apply Rle_trans with x.
 apply Zfloor_lb.
 apply Zceil_ub.
-apply Zle_refl.
+apply Z.le_refl.
 Qed.
 
 Global Instance valid_rnd_N : Valid_rnd Znearest.
@@ -1665,22 +1669,22 @@ Proof.
 split.
 (* *)
 intros x y Hxy.
-destruct (Rle_or_lt (Z2R (Zceil x)) y) as [H|H].
-apply Zle_trans with (1 := Znearest_le_ceil x).
-apply Zle_trans with (2 := Znearest_ge_floor y).
+destruct (Rle_or_lt (IZR (Zceil x)) y) as [H|H].
+apply Z.le_trans with (1 := Znearest_le_ceil x).
+apply Z.le_trans with (2 := Znearest_ge_floor y).
 now apply Zfloor_lub.
 (* . *)
 assert (Hf: Zfloor y = Zfloor x).
 apply Zfloor_imp.
 split.
 apply Rle_trans with (2 := Zfloor_lb y).
-apply Z2R_le.
+apply IZR_le.
 now apply Zfloor_le.
 apply Rlt_le_trans with (1 := H).
-apply Z2R_le.
+apply IZR_le.
 apply Zceil_glb.
 apply Rlt_le.
-rewrite Z2R_plus.
+rewrite plus_IZR.
 apply Zfloor_ub.
 (* . *)
 unfold Znearest at 1.
@@ -1696,15 +1700,15 @@ elim Rlt_not_le with (1 := Hy).
 rewrite <- Hx.
 now apply Rplus_le_compat_r.
 replace y with x.
-apply Zle_refl.
-apply Rplus_eq_reg_l with (- Z2R (Zfloor x))%R.
-rewrite 2!(Rplus_comm (- (Z2R (Zfloor x)))).
-change (x - Z2R (Zfloor x) = y - Z2R (Zfloor x))%R.
+apply Z.le_refl.
+apply Rplus_eq_reg_l with (- IZR (Zfloor x))%R.
+rewrite 2!(Rplus_comm (- (IZR (Zfloor x)))).
+change (x - IZR (Zfloor x) = y - IZR (Zfloor x))%R.
 now rewrite Hy.
-apply Zle_trans with (Zceil x).
+apply Z.le_trans with (Zceil x).
 case choice.
-apply Zle_refl.
-apply le_Z2R.
+apply Z.le_refl.
+apply le_IZR.
 apply Rle_trans with x.
 apply Zfloor_lb.
 apply Zceil_ub.
@@ -1719,79 +1723,19 @@ now apply Rplus_le_compat_r.
 (* *)
 intros n.
 unfold Znearest.
-rewrite Zfloor_Z2R.
+rewrite Zfloor_IZR.
 rewrite Rcompare_Lt.
 easy.
 unfold Rminus.
 rewrite Rplus_opp_r.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
-Qed.
-
-Theorem Rcompare_floor_ceil_mid :
-  forall x,
-  Z2R (Zfloor x) <> x ->
-  Rcompare (x - Z2R (Zfloor x)) (/ 2) = Rcompare (x - Z2R (Zfloor x)) (Z2R (Zceil x) - x).
-Proof.
-intros x Hx.
-rewrite Zceil_floor_neq with (1 := Hx).
-rewrite Z2R_plus. simpl.
-destruct (Rcompare_spec (x - Z2R (Zfloor x)) (/ 2)) as [H1|H1|H1] ; apply sym_eq.
-(* . *)
-apply Rcompare_Lt.
-apply Rplus_lt_reg_l with (x - Z2R (Zfloor x))%R.
-replace (x - Z2R (Zfloor x) + (x - Z2R (Zfloor x)))%R with ((x - Z2R (Zfloor x)) * 2)%R by ring.
-replace (x - Z2R (Zfloor x) + (Z2R (Zfloor x) + 1 - x))%R with (/2 * 2)%R by field.
-apply Rmult_lt_compat_r with (2 := H1).
-now apply (Z2R_lt 0 2).
-(* . *)
-apply Rcompare_Eq.
-replace (Z2R (Zfloor x) + 1 - x)%R with (1 - (x - Z2R (Zfloor x)))%R by ring.
-rewrite H1.
-field.
-(* . *)
-apply Rcompare_Gt.
-apply Rplus_lt_reg_l with (x - Z2R (Zfloor x))%R.
-replace (x - Z2R (Zfloor x) + (x - Z2R (Zfloor x)))%R with ((x - Z2R (Zfloor x)) * 2)%R by ring.
-replace (x - Z2R (Zfloor x) + (Z2R (Zfloor x) + 1 - x))%R with (/2 * 2)%R by field.
-apply Rmult_lt_compat_r with (2 := H1).
-now apply (Z2R_lt 0 2).
-Qed.
-
-Theorem Rcompare_ceil_floor_mid :
-  forall x,
-  Z2R (Zfloor x) <> x ->
-  Rcompare (Z2R (Zceil x) - x) (/ 2) = Rcompare (Z2R (Zceil x) - x) (x - Z2R (Zfloor x)).
-Proof.
-intros x Hx.
-rewrite Zceil_floor_neq with (1 := Hx).
-rewrite Z2R_plus. simpl.
-destruct (Rcompare_spec (Z2R (Zfloor x) + 1 - x) (/ 2)) as [H1|H1|H1] ; apply sym_eq.
-(* . *)
-apply Rcompare_Lt.
-apply Rplus_lt_reg_l with (Z2R (Zfloor x) + 1 - x)%R.
-replace (Z2R (Zfloor x) + 1 - x + (Z2R (Zfloor x) + 1 - x))%R with ((Z2R (Zfloor x) + 1 - x) * 2)%R by ring.
-replace (Z2R (Zfloor x) + 1 - x + (x - Z2R (Zfloor x)))%R with (/2 * 2)%R by field.
-apply Rmult_lt_compat_r with (2 := H1).
-now apply (Z2R_lt 0 2).
-(* . *)
-apply Rcompare_Eq.
-replace (x - Z2R (Zfloor x))%R with (1 - (Z2R (Zfloor x) + 1 - x))%R by ring.
-rewrite H1.
-field.
-(* . *)
-apply Rcompare_Gt.
-apply Rplus_lt_reg_l with (Z2R (Zfloor x) + 1 - x)%R.
-replace (Z2R (Zfloor x) + 1 - x + (Z2R (Zfloor x) + 1 - x))%R with ((Z2R (Zfloor x) + 1 - x) * 2)%R by ring.
-replace (Z2R (Zfloor x) + 1 - x + (x - Z2R (Zfloor x)))%R with (/2 * 2)%R by field.
-apply Rmult_lt_compat_r with (2 := H1).
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 Qed.
 
 Theorem Znearest_N_strict :
   forall x,
-  (x - Z2R (Zfloor x) <> /2)%R ->
-  (Rabs (x - Z2R (Znearest x)) < /2)%R.
+  (x - IZR (Zfloor x) <> /2)%R ->
+  (Rabs (x - IZR (Znearest x)) < /2)%R.
 Proof.
 intros x Hx.
 unfold Znearest.
@@ -1804,72 +1748,70 @@ now elim Hx.
 rewrite Rabs_left1.
 rewrite Ropp_minus_distr.
 rewrite Zceil_floor_neq.
-rewrite Z2R_plus.
-simpl.
+rewrite plus_IZR.
 apply Ropp_lt_cancel.
 apply Rplus_lt_reg_l with 1%R.
 replace (1 + -/2)%R with (/2)%R by field.
-now replace (1 + - (Z2R (Zfloor x) + 1 - x))%R with (x - Z2R (Zfloor x))%R by ring.
+now replace (1 + - (IZR (Zfloor x) + 1 - x))%R with (x - IZR (Zfloor x))%R by ring.
 apply Rlt_not_eq.
-apply Rplus_lt_reg_l with (- Z2R (Zfloor x))%R.
+apply Rplus_lt_reg_l with (- IZR (Zfloor x))%R.
 apply Rlt_trans with (/2)%R.
 rewrite Rplus_opp_l.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 now rewrite <- (Rplus_comm x).
 apply Rle_minus.
 apply Zceil_ub.
 Qed.
 
-Theorem Znearest_N :
+Theorem Znearest_half :
   forall x,
-  (Rabs (x - Z2R (Znearest x)) <= /2)%R.
+  (Rabs (x - IZR (Znearest x)) <= /2)%R.
 Proof.
 intros x.
-destruct (Req_dec (x - Z2R (Zfloor x)) (/2)) as [Hx|Hx].
+destruct (Req_dec (x - IZR (Zfloor x)) (/2)) as [Hx|Hx].
 assert (K: (Rabs (/2) <= /2)%R).
 apply Req_le.
 apply Rabs_pos_eq.
 apply Rlt_le.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 destruct (Znearest_DN_or_UP x) as [H|H] ; rewrite H ; clear H.
 now rewrite Hx.
 rewrite Zceil_floor_neq.
-rewrite Z2R_plus.
-simpl.
-replace (x - (Z2R (Zfloor x) + 1))%R with (x - Z2R (Zfloor x) - 1)%R by ring.
+rewrite plus_IZR.
+replace (x - (IZR (Zfloor x) + 1))%R with (x - IZR (Zfloor x) - 1)%R by ring.
 rewrite Hx.
 rewrite Rabs_minus_sym.
 now replace (1 - /2)%R with (/2)%R by field.
 apply Rlt_not_eq.
-apply Rplus_lt_reg_l with (- Z2R (Zfloor x))%R.
+apply Rplus_lt_reg_l with (- IZR (Zfloor x))%R.
 rewrite Rplus_opp_l, Rplus_comm.
-fold (x - Z2R (Zfloor x))%R.
+fold (x - IZR (Zfloor x))%R.
 rewrite Hx.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 apply Rlt_le.
 now apply Znearest_N_strict.
 Qed.
 
 Theorem Znearest_imp :
   forall x n,
-  (Rabs (x - Z2R n) < /2)%R ->
+  (Rabs (x - IZR n) < /2)%R ->
   Znearest x = n.
 Proof.
 intros x n Hd.
-cut (Zabs (Znearest x - n) < 1)%Z.
+cut (Z.abs (Znearest x - n) < 1)%Z.
 clear ; zify ; omega.
-apply lt_Z2R.
-rewrite Z2R_abs, Z2R_minus.
-replace (Z2R (Znearest x) - Z2R n)%R with (- (x - Z2R (Znearest x)) + (x - Z2R n))%R by ring.
+apply lt_IZR.
+rewrite abs_IZR, minus_IZR.
+replace (IZR (Znearest x) - IZR n)%R with (- (x - IZR (Znearest x)) + (x - IZR n))%R by ring.
 apply Rle_lt_trans with (1 := Rabs_triang _ _).
 simpl.
 replace 1%R with (/2 + /2)%R by field.
 apply Rplus_le_lt_compat with (2 := Hd).
 rewrite Rabs_Ropp.
-apply Znearest_N.
+apply Znearest_half.
 Qed.
 
 Theorem round_N_pt :
@@ -1880,7 +1822,7 @@ intros x.
 set (d := round Zfloor x).
 set (u := round Zceil x).
 set (mx := scaled_mantissa x).
-set (bx := bpow (canonic_exp x)).
+set (bx := bpow (cexp x)).
 (* . *)
 assert (H: (Rabs (round Znearest x - x) <= Rmin (x - d) (u - x))%R).
 pattern x at -1 ; rewrite <- scaled_mantissa_mult_bpow.
@@ -1892,7 +1834,7 @@ rewrite <- Rmult_min_distr_r. 2: apply bpow_ge_0.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
 unfold Znearest.
-destruct (Req_dec (Z2R (Zfloor mx)) mx) as [Hm|Hm].
+destruct (Req_dec (IZR (Zfloor mx)) mx) as [Hm|Hm].
 (* .. *)
 rewrite Hm.
 unfold Rminus at 2.
@@ -1903,16 +1845,16 @@ unfold Rminus at -3.
 rewrite Rplus_opp_r.
 rewrite Rabs_R0.
 unfold Rmin.
-destruct (Rle_dec 0 (Z2R (Zceil mx) - mx)) as [H|H].
+destruct (Rle_dec 0 (IZR (Zceil mx) - mx)) as [H|H].
 apply Rle_refl.
 apply Rle_0_minus.
 apply Zceil_ub.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 (* .. *)
-rewrite Rcompare_floor_ceil_mid with (1 := Hm).
+rewrite Rcompare_floor_ceil_middle with (1 := Hm).
 rewrite Rmin_compare.
-assert (H: (Rabs (mx - Z2R (Zfloor mx)) <= mx - Z2R (Zfloor mx))%R).
+assert (H: (Rabs (mx - IZR (Zfloor mx)) <= mx - IZR (Zfloor mx))%R).
 rewrite Rabs_pos_eq.
 apply Rle_refl.
 apply Rle_0_minus.
@@ -1928,7 +1870,7 @@ apply Rle_refl.
 apply Rle_0_minus.
 apply Zceil_ub.
 (* . *)
-apply Rnd_DN_UP_pt_N with d u.
+apply Rnd_N_pt_DN_UP with d u.
 apply generic_format_round.
 auto with typeclass_instances.
 now apply round_DN_pt.
@@ -1947,63 +1889,63 @@ Proof.
 intros x.
 pattern x at 1 4 ; rewrite <- scaled_mantissa_mult_bpow.
 unfold round, Znearest, F2R. simpl.
-destruct (Req_dec (Z2R (Zfloor (scaled_mantissa x))) (scaled_mantissa x)) as [Fx|Fx].
+destruct (Req_dec (IZR (Zfloor (scaled_mantissa x))) (scaled_mantissa x)) as [Fx|Fx].
 (* *)
 intros _.
 rewrite <- Fx.
-rewrite Zceil_Z2R, Zfloor_Z2R.
+rewrite Zceil_IZR, Zfloor_IZR.
 set (m := Zfloor (scaled_mantissa x)).
-now case (Rcompare (Z2R m - Z2R m) (/ 2)) ; case (choice m).
+now case (Rcompare (IZR m - IZR m) (/ 2)) ; case (choice m).
 (* *)
 intros H.
-rewrite Rcompare_floor_ceil_mid with (1 := Fx).
+rewrite Rcompare_floor_ceil_middle with (1 := Fx).
 rewrite Rcompare_Eq.
 now case choice.
-apply Rmult_eq_reg_r with (bpow (canonic_exp x)).
+apply Rmult_eq_reg_r with (bpow (cexp x)).
 now rewrite 2!Rmult_minus_distr_r.
 apply Rgt_not_eq.
 apply bpow_gt_0.
 Qed.
 
-Lemma round_N_really_small_pos :
+Lemma round_N_small_pos :
   forall x,
   forall ex,
-  (Fcore_Raux.bpow beta (ex - 1) <= x < Fcore_Raux.bpow beta ex)%R ->
+  (Raux.bpow beta (ex - 1) <= x < Raux.bpow beta ex)%R ->
   (ex < fexp ex)%Z ->
   (round Znearest x = 0)%R.
 Proof.
 intros x ex Hex Hf.
-unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
-apply (Rmult_eq_reg_r (bpow (- fexp (ln_beta beta x))));
+unfold round, F2R, scaled_mantissa, cexp; simpl.
+apply (Rmult_eq_reg_r (bpow (- fexp (mag beta x))));
   [|now apply Rgt_not_eq; apply bpow_gt_0].
 rewrite Rmult_0_l, Rmult_assoc, <- bpow_plus.
 replace (_ + - _)%Z with 0%Z by ring; simpl; rewrite Rmult_1_r.
-change 0%R with (Z2R 0); apply f_equal.
+apply IZR_eq.
 apply Znearest_imp.
-simpl; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
+unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
 assert (H : (x >= 0)%R).
 { apply Rle_ge; apply Rle_trans with (bpow (ex - 1)); [|exact (proj1 Hex)].
   now apply bpow_ge_0. }
-assert (H' : (x * bpow (- fexp (ln_beta beta x)) >= 0)%R).
+assert (H' : (x * bpow (- fexp (mag beta x)) >= 0)%R).
 { apply Rle_ge; apply Rmult_le_pos.
   - now apply Rge_le.
   - now apply bpow_ge_0. }
 rewrite Rabs_right; [|exact H'].
-apply (Rmult_lt_reg_r (bpow (fexp (ln_beta beta x)))); [now apply bpow_gt_0|].
+apply (Rmult_lt_reg_r (bpow (fexp (mag beta x)))); [now apply bpow_gt_0|].
 rewrite Rmult_assoc, <- bpow_plus.
 replace (- _ + _)%Z with 0%Z by ring; simpl; rewrite Rmult_1_r.
 apply (Rlt_le_trans _ _ _ (proj2 Hex)).
-apply Rle_trans with (bpow (fexp (ln_beta beta x) - 1)).
+apply Rle_trans with (bpow (fexp (mag beta x) - 1)).
 - apply bpow_le.
-  rewrite (ln_beta_unique beta x ex); [omega|].
+  rewrite (mag_unique beta x ex); [omega|].
   now rewrite Rabs_right.
 - unfold Zminus; rewrite bpow_plus.
   rewrite Rmult_comm.
   apply Rmult_le_compat_r; [now apply bpow_ge_0|].
-  unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+  unfold Raux.bpow, Z.pow_pos; simpl.
   rewrite Zmult_1_r.
   apply Rinv_le; [exact Rlt_0_2|].
-  change 2%R with (Z2R 2); apply Z2R_le.
+  apply IZR_le.
   destruct beta as (beta_val,beta_prop).
   now apply Zle_bool_imp_le.
 Qed.
@@ -2024,7 +1966,7 @@ set (f := round (Znearest (Zle_bool 0)) x).
 intros Rxf.
 destruct (Req_dec (x - round Zfloor x) (round Zceil x - x)) as [Hm|Hm].
 (* *)
-apply Rnd_NA_N_pt.
+apply Rnd_NA_pt_N.
 exact generic_format_0.
 exact Rxf.
 destruct (Rle_or_lt 0 x) as [Hx|Hx].
@@ -2038,7 +1980,7 @@ apply (round_UP_pt x).
 apply Zfloor_lub.
 apply Rmult_le_pos with (1 := Hx).
 apply bpow_ge_0.
-apply Rnd_N_pt_pos with (2 := Hx) (3 := Rxf).
+apply Rnd_N_pt_ge_0 with (2 := Hx) (3 := Rxf).
 exact generic_format_0.
 (* . *)
 rewrite Rabs_left with (1 := Hx).
@@ -2048,21 +1990,21 @@ unfold f.
 rewrite round_N_middle with (1 := Hm).
 rewrite Zle_bool_false.
 apply (round_DN_pt x).
-apply lt_Z2R.
+apply lt_IZR.
 apply Rle_lt_trans with (scaled_mantissa x).
 apply Zfloor_lb.
 simpl.
-rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+rewrite <- (Rmult_0_l (bpow (- cexp x))).
 apply Rmult_lt_compat_r with (2 := Hx).
 apply bpow_gt_0.
-apply Rnd_N_pt_neg with (3 := Rxf).
+apply Rnd_N_pt_le_0 with (3 := Rxf).
 exact generic_format_0.
 now apply Rlt_le.
 (* *)
 split.
 apply Rxf.
 intros g Rxg.
-rewrite Rnd_N_pt_unicity with (3 := Hm) (4 := Rxf) (5 := Rxg).
+rewrite Rnd_N_pt_unique with (3 := Hm) (4 := Rxf) (5 := Rxg).
 apply Rle_refl.
 apply round_DN_pt.
 apply round_UP_pt.
@@ -2077,25 +2019,25 @@ Theorem Znearest_opp :
   Znearest choice (- x) = (- Znearest (fun t => negb (choice (- (t + 1))%Z)) x)%Z.
 Proof with auto with typeclass_instances.
 intros choice x.
-destruct (Req_dec (Z2R (Zfloor x)) x) as [Hx|Hx].
+destruct (Req_dec (IZR (Zfloor x)) x) as [Hx|Hx].
 rewrite <- Hx.
-rewrite <- Z2R_opp.
-rewrite 2!Zrnd_Z2R...
+rewrite <- opp_IZR.
+rewrite 2!Zrnd_IZR...
 unfold Znearest.
-replace (- x - Z2R (Zfloor (-x)))%R with (Z2R (Zceil x) - x)%R.
-rewrite Rcompare_ceil_floor_mid with (1 := Hx).
-rewrite Rcompare_floor_ceil_mid with (1 := Hx).
+replace (- x - IZR (Zfloor (-x)))%R with (IZR (Zceil x) - x)%R.
+rewrite Rcompare_ceil_floor_middle with (1 := Hx).
+rewrite Rcompare_floor_ceil_middle with (1 := Hx).
 rewrite Rcompare_sym.
 rewrite <- Zceil_floor_neq with (1 := Hx).
 unfold Zceil.
 rewrite Ropp_involutive.
 case Rcompare ; simpl ; trivial.
-rewrite Zopp_involutive.
+rewrite Z.opp_involutive.
 case (choice (Zfloor (- x))) ; simpl ; trivial.
-now rewrite Zopp_involutive.
-now rewrite Zopp_involutive.
+now rewrite Z.opp_involutive.
+now rewrite Z.opp_involutive.
 unfold Zceil.
-rewrite Z2R_opp.
+rewrite opp_IZR.
 apply Rplus_comm.
 Qed.
 
@@ -2106,15 +2048,30 @@ Theorem round_N_opp :
 Proof.
 intros choice x.
 unfold round, F2R. simpl.
-rewrite canonic_exp_opp.
+rewrite cexp_opp.
 rewrite scaled_mantissa_opp.
 rewrite Znearest_opp.
-rewrite Z2R_opp.
+rewrite opp_IZR.
 now rewrite Ropp_mult_distr_l_reverse.
 Qed.
 
 End rndN_opp.
 
+Lemma round_N_small :
+  forall choice,
+  forall x,
+  forall ex,
+  (Raux.bpow beta (ex - 1) <= Rabs x < Raux.bpow beta ex)%R ->
+  (ex < fexp ex)%Z ->
+  (round (Znearest choice) x = 0)%R.
+Proof.
+intros choice x ex Hx Hex.
+destruct (Rle_or_lt 0 x) as [Px|Nx].
+{ now revert Hex; apply round_N_small_pos; revert Hx; rewrite Rabs_pos_eq. }
+rewrite <-(Ropp_involutive x), round_N_opp, <-Ropp_0; f_equal.
+now revert Hex; apply round_N_small_pos; revert Hx; rewrite Rabs_left.
+Qed.
+
 End Format.
 
 (** Inclusion of a format into an extended format *)
@@ -2125,9 +2082,9 @@ Variables fexp1 fexp2 : Z -> Z.
 Context { valid_exp1 : Valid_exp fexp1 }.
 Context { valid_exp2 : Valid_exp fexp2 }.
 
-Theorem generic_inclusion_ln_beta :
+Theorem generic_inclusion_mag :
   forall x,
-  ( x <> R0 -> (fexp2 (ln_beta beta x) <= fexp1 (ln_beta beta x))%Z ) ->
+  ( x <> 0%R -> (fexp2 (mag beta x) <= fexp1 (mag beta x))%Z ) ->
   generic_format fexp1 x ->
   generic_format fexp2 x.
 Proof.
@@ -2139,7 +2096,7 @@ rewrite <- Fx.
 apply He.
 contradict Zx.
 rewrite Zx, scaled_mantissa_0.
-apply (Ztrunc_Z2R 0).
+apply Ztrunc_IZR.
 Qed.
 
 Theorem generic_inclusion_lt_ge :
@@ -2151,12 +2108,12 @@ Theorem generic_inclusion_lt_ge :
   generic_format fexp2 x.
 Proof.
 intros e1 e2 He x (Hx1,Hx2).
-apply generic_inclusion_ln_beta.
+apply generic_inclusion_mag.
 intros Zx.
 apply He.
 split.
-now apply ln_beta_gt_bpow.
-now apply ln_beta_le_bpow.
+now apply mag_gt_bpow.
+now apply mag_le_bpow.
 Qed.
 
 Theorem generic_inclusion :
@@ -2168,13 +2125,13 @@ Theorem generic_inclusion :
   generic_format fexp2 x.
 Proof with auto with typeclass_instances.
 intros e He x (Hx1,[Hx2|Hx2]).
-apply generic_inclusion_ln_beta.
-now rewrite ln_beta_unique with (1 := conj Hx1 Hx2).
+apply generic_inclusion_mag.
+now rewrite mag_unique with (1 := conj Hx1 Hx2).
 intros Fx.
 apply generic_format_abs_inv.
 rewrite Hx2.
 apply generic_format_bpow'...
-apply Zle_trans with (1 := He).
+apply Z.le_trans with (1 := He).
 apply generic_format_bpow_inv...
 rewrite <- Hx2.
 now apply generic_format_abs.
@@ -2191,18 +2148,18 @@ Theorem generic_inclusion_le_ge :
 Proof.
 intros e1 e2 He' He x (Hx1,[Hx2|Hx2]).
 (* *)
-apply generic_inclusion_ln_beta.
+apply generic_inclusion_mag.
 intros Zx.
 apply He.
 split.
-now apply ln_beta_gt_bpow.
-now apply ln_beta_le_bpow.
+now apply mag_gt_bpow.
+now apply mag_le_bpow.
 (* *)
 apply generic_inclusion with (e := e2).
 apply He.
 split.
 apply He'.
-apply Zle_refl.
+apply Z.le_refl.
 rewrite Hx2.
 split.
 apply bpow_le.
@@ -2219,13 +2176,13 @@ Theorem generic_inclusion_le :
   generic_format fexp2 x.
 Proof.
 intros e2 He x [Hx|Hx].
-apply generic_inclusion_ln_beta.
+apply generic_inclusion_mag.
 intros Zx.
 apply He.
-now apply ln_beta_le_bpow.
+now apply mag_le_bpow.
 apply generic_inclusion with (e := e2).
 apply He.
-apply Zle_refl.
+apply Z.le_refl.
 rewrite Hx.
 split.
 apply bpow_le.
@@ -2242,10 +2199,10 @@ Theorem generic_inclusion_ge :
   generic_format fexp2 x.
 Proof.
 intros e1 He x Hx.
-apply generic_inclusion_ln_beta.
+apply generic_inclusion_mag.
 intros Zx.
 apply He.
-now apply ln_beta_gt_bpow.
+now apply mag_gt_bpow.
 Qed.
 
 Variable rnd : R -> Z.
@@ -2263,9 +2220,9 @@ revert rnd valid_rnd x Gx.
 refine (round_abs_abs _ (fun x y => generic_format fexp1 x -> generic_format fexp1 y) _).
 intros rnd valid_rnd x [Hx|Hx] Gx.
 (* x > 0 *)
-generalize (ln_beta_generic_gt _ x (Rgt_not_eq _ _ Hx) Gx).
-unfold canonic_exp.
-destruct (ln_beta beta x) as (ex,Ex) ; simpl.
+generalize (mag_generic_gt _ x (Rgt_not_eq _ _ Hx) Gx).
+unfold cexp.
+destruct (mag beta x) as (ex,Ex) ; simpl.
 specialize (Ex (Rgt_not_eq _ _ Hx)).
 intros He'.
 rewrite Rabs_pos_eq in Ex by now apply Rlt_le.
@@ -2279,25 +2236,25 @@ apply generic_format_bpow'...
 apply Zlt_le_weak.
 apply valid_exp_large with ex...
 (* - x large for fexp2 *)
-destruct (Zle_or_lt (canonic_exp fexp2 x) (canonic_exp fexp1 x)) as [He''|He''].
+destruct (Zle_or_lt (cexp fexp2 x) (cexp fexp1 x)) as [He''|He''].
 (* - - round fexp2 x is representable for fexp1 *)
 rewrite round_generic...
 rewrite Gx.
 apply generic_format_F2R.
 fold (round fexp1 Ztrunc x).
 intros Zx.
-unfold canonic_exp at 1.
-rewrite ln_beta_round_ZR...
+unfold cexp at 1.
+rewrite mag_round_ZR...
 contradict Zx.
-apply F2R_eq_0_reg with (1 := Zx).
+apply eq_0_F2R with (1 := Zx).
 (* - - round fexp2 x has too many digits for fexp1 *)
 destruct (round_bounded_large_pos fexp2 rnd x ex He Ex) as (Hr1,[Hr2|Hr2]).
 apply generic_format_F2R.
 intros Zx.
 fold (round fexp2 rnd x).
-unfold canonic_exp at 1.
-rewrite ln_beta_unique_pos with (1 := conj Hr1 Hr2).
-rewrite <- ln_beta_unique_pos with (1 := Ex).
+unfold cexp at 1.
+rewrite mag_unique_pos with (1 := conj Hr1 Hr2).
+rewrite <- mag_unique_pos with (1 := Ex).
 now apply Zlt_le_weak.
 rewrite Hr2.
 apply generic_format_bpow'...
@@ -2327,7 +2284,7 @@ apply Ropp_eq_compat.
 apply round_ext.
 clear x; intro x.
 unfold Znearest.
-case_eq (Rcompare (x - Z2R (Zfloor x)) (/ 2)); intro C;
+case_eq (Rcompare (x - IZR (Zfloor x)) (/ 2)); intro C;
 [|reflexivity|reflexivity].
 apply Rcompare_Eq_inv in C.
 assert (H : negb (0 <=? - (Zfloor x + 1))%Z = (0 <=? Zfloor x)%Z);
diff --git a/flocq/Core/Fcore_Raux.v b/flocq/Core/Raux.v
index 77235e63..8273a55b 100644
--- a/flocq/Core/Fcore_Raux.v
+++ b/flocq/Core/Raux.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,9 +18,9 @@ COPYING file for more details.
 *)
 
 (** * Missing definitions/lemmas *)
-Require Export Reals.
-Require Export ZArith.
-Require Export Fcore_Zaux.
+Require Import Psatz.
+Require Export Reals ZArith.
+Require Export Zaux.
 
 Section Rmissing.
 
@@ -58,12 +58,13 @@ Theorem Rabs_minus_le:
   (Rabs (x-y) <= x)%R.
 Proof.
 intros x y Hx Hy.
-unfold Rabs; case (Rcase_abs (x - y)); intros H.
-apply Rplus_le_reg_l with x; ring_simplify; assumption.
-apply Rplus_le_reg_l with (-x)%R; ring_simplify.
-auto with real.
+apply Rabs_le.
+lra.
 Qed.
 
+Theorem Rabs_eq_R0 x : (Rabs x = 0 -> x = 0)%R.
+Proof. split_Rabs; lra. Qed.
+
 Theorem Rplus_eq_reg_r :
   forall r r1 r2 : R,
   (r1 + r = r2 + r)%R -> (r1 = r2)%R.
@@ -73,53 +74,6 @@ apply Rplus_eq_reg_l with r.
 now rewrite 2!(Rplus_comm r).
 Qed.
 
-Theorem Rplus_lt_reg_l :
-  forall r r1 r2 : R,
-  (r + r1 < r + r2)%R -> (r1 < r2)%R.
-Proof.
-intros.
-solve [ apply Rplus_lt_reg_l with (1 := H) |
-        apply Rplus_lt_reg_r with (1 := H) ].
-Qed.
-
-Theorem Rplus_lt_reg_r :
-  forall r r1 r2 : R,
-  (r1 + r < r2 + r)%R -> (r1 < r2)%R.
-Proof.
-intros.
-apply Rplus_lt_reg_l with r.
-now rewrite 2!(Rplus_comm r).
-Qed.
-
-Theorem Rplus_le_reg_r :
-  forall r r1 r2 : R,
-  (r1 + r <= r2 + r)%R -> (r1 <= r2)%R.
-Proof.
-intros.
-apply Rplus_le_reg_l with r.
-now rewrite 2!(Rplus_comm r).
-Qed.
-
-Theorem Rmult_lt_reg_r :
-  forall r r1 r2 : R, (0 < r)%R ->
-  (r1 * r < r2 * r)%R -> (r1 < r2)%R.
-Proof.
-intros.
-apply Rmult_lt_reg_l with r.
-exact H.
-now rewrite 2!(Rmult_comm r).
-Qed.
-
-Theorem Rmult_le_reg_r :
-  forall r r1 r2 : R, (0 < r)%R ->
-  (r1 * r <= r2 * r)%R -> (r1 <= r2)%R.
-Proof.
-intros.
-apply Rmult_le_reg_l with r.
-exact H.
-now rewrite 2!(Rmult_comm r).
-Qed.
-
 Theorem Rmult_lt_compat :
   forall r1 r2 r3 r4,
   (0 <= r1)%R -> (0 <= r3)%R -> (r1 < r2)%R -> (r3 < r4)%R ->
@@ -135,16 +89,6 @@ apply Rle_lt_trans with (r1 * r4)%R.
   + exact H12.
 Qed.
 
-Theorem Rmult_eq_reg_r :
-  forall r r1 r2 : R, (r1 * r)%R = (r2 * r)%R ->
-  r <> 0%R -> r1 = r2.
-Proof.
-intros r r1 r2 H1 H2.
-apply Rmult_eq_reg_l with r.
-now rewrite 2!(Rmult_comm r).
-exact H2.
-Qed.
-
 Theorem Rmult_minus_distr_r :
   forall r r1 r2 : R,
   ((r1 - r2) * r = r1 * r - r2 * r)%R.
@@ -154,13 +98,18 @@ rewrite <- 3!(Rmult_comm r).
 apply Rmult_minus_distr_l.
 Qed.
 
-Lemma Rmult_neq_reg_r: forall  r1 r2 r3:R, (r2 * r1 <> r3 * r1)%R -> r2 <> r3.
+Lemma Rmult_neq_reg_r :
+  forall r1 r2 r3 : R, (r2 * r1 <> r3 * r1)%R -> r2 <> r3.
+Proof.
 intros r1 r2 r3 H1 H2.
 apply H1; rewrite H2; ring.
 Qed.
 
-Lemma Rmult_neq_compat_r: forall  r1 r2 r3:R, (r1 <> 0)%R -> (r2 <> r3)%R
-   -> (r2 *r1 <> r3*r1)%R.
+Lemma Rmult_neq_compat_r :
+  forall r1 r2 r3 : R,
+  (r1 <> 0)%R -> (r2 <> r3)%R ->
+  (r2 * r1 <> r3 * r1)%R.
+Proof.
 intros r1 r2 r3 H H1 H2.
 now apply H1, Rmult_eq_reg_r with r1.
 Qed.
@@ -227,7 +176,6 @@ rewrite Rmax_right; trivial.
 now apply Ropp_le_contravar.
 Qed.
 
-
 Theorem exp_le :
   forall x y : R,
   (x <= y)%R -> (exp x <= exp y)%R.
@@ -288,6 +236,14 @@ destruct (Req_dec x 0) as [Zx|Nzx].
     now apply Nzx, Rle_antisym; [|apply Rge_le].
 Qed.
 
+Lemma Rsqr_le_abs_0_alt :
+  forall x y,
+  (x² <= y² -> x <= Rabs y)%R.
+Proof.
+intros x y H.
+apply (Rle_trans _ (Rabs x)); [apply Rle_abs|apply (Rsqr_le_abs_0 _ _ H)].
+Qed.
+
 Theorem Rabs_le :
   forall x y,
   (-y <= x <= y)%R -> (Rabs x <= y)%R.
@@ -387,187 +343,35 @@ Qed.
 
 End Rmissing.
 
-Section Z2R.
+Section IZR.
 
-(** Z2R function (Z -> R) *)
-Fixpoint P2R (p : positive) :=
-  match p with
-  | xH => 1%R
-  | xO xH => 2%R
-  | xO t => (2 * P2R t)%R
-  | xI xH => 3%R
-  | xI t => (1 + 2 * P2R t)%R
-  end.
-
-Definition Z2R n :=
-  match n with
-  | Zpos p => P2R p
-  | Zneg p => Ropp (P2R p)
-  | Z0 => 0%R
-  end.
-
-Theorem P2R_INR :
-  forall n, P2R n = INR (nat_of_P n).
-Proof.
-induction n ; simpl ; try (
-  rewrite IHn ;
-  rewrite <- (mult_INR 2) ;
-  rewrite <- (nat_of_P_mult_morphism 2) ;
-  change (2 * n)%positive with (xO n)).
-(* xI *)
-rewrite (Rplus_comm 1).
-change (nat_of_P (xO n)) with (Pmult_nat n 2).
-case n ; intros ; simpl ; try apply refl_equal.
-case (Pmult_nat p 4) ; intros ; try apply refl_equal.
-rewrite Rplus_0_l.
-apply refl_equal.
-apply Rplus_comm.
-(* xO *)
-case n ; intros ; apply refl_equal.
-(* xH *)
-apply refl_equal.
-Qed.
-
-Theorem Z2R_IZR :
-  forall n, Z2R n = IZR n.
-Proof.
-intro.
-case n ; intros ; unfold Z2R.
-apply refl_equal.
-rewrite <- positive_nat_Z, <- INR_IZR_INZ.
-apply P2R_INR.
-change (IZR (Zneg p)) with (Ropp (IZR (Zpos p))).
-apply Ropp_eq_compat.
-rewrite <- positive_nat_Z, <- INR_IZR_INZ.
-apply P2R_INR.
-Qed.
-
-Theorem Z2R_opp :
-  forall n, Z2R (-n) = (- Z2R n)%R.
-Proof.
-intros.
-repeat rewrite Z2R_IZR.
-apply Ropp_Ropp_IZR.
-Qed.
-
-Theorem Z2R_plus :
-  forall m n, (Z2R (m + n) = Z2R m + Z2R n)%R.
-Proof.
-intros.
-repeat rewrite Z2R_IZR.
-apply plus_IZR.
-Qed.
-
-Theorem minus_IZR :
-  forall n m : Z,
-  IZR (n - m) = (IZR n - IZR m)%R.
-Proof.
-intros.
-unfold Zminus.
-rewrite plus_IZR.
-rewrite Ropp_Ropp_IZR.
-apply refl_equal.
-Qed.
-
-Theorem Z2R_minus :
-  forall m n, (Z2R (m - n) = Z2R m - Z2R n)%R.
-Proof.
-intros.
-repeat rewrite Z2R_IZR.
-apply minus_IZR.
-Qed.
-
-Theorem Z2R_mult :
-  forall m n, (Z2R (m * n) = Z2R m * Z2R n)%R.
-Proof.
-intros.
-repeat rewrite Z2R_IZR.
-apply mult_IZR.
-Qed.
-
-Theorem le_Z2R :
-  forall m n, (Z2R m <= Z2R n)%R -> (m <= n)%Z.
-Proof.
-intros m n.
-repeat rewrite Z2R_IZR.
-apply le_IZR.
-Qed.
-
-Theorem Z2R_le :
-  forall m n, (m <= n)%Z -> (Z2R m <= Z2R n)%R.
-Proof.
-intros m n.
-repeat rewrite Z2R_IZR.
-apply IZR_le.
-Qed.
-
-Theorem lt_Z2R :
-  forall m n, (Z2R m < Z2R n)%R -> (m < n)%Z.
-Proof.
-intros m n.
-repeat rewrite Z2R_IZR.
-apply lt_IZR.
-Qed.
-
-Theorem Z2R_lt :
-  forall m n, (m < n)%Z -> (Z2R m < Z2R n)%R.
-Proof.
-intros m n.
-repeat rewrite Z2R_IZR.
-apply IZR_lt.
-Qed.
-
-Theorem Z2R_le_lt :
-  forall m n p, (m <= n < p)%Z -> (Z2R m <= Z2R n < Z2R p)%R.
+Theorem IZR_le_lt :
+  forall m n p, (m <= n < p)%Z -> (IZR m <= IZR n < IZR p)%R.
 Proof.
 intros m n p (H1, H2).
 split.
-now apply Z2R_le.
-now apply Z2R_lt.
+now apply IZR_le.
+now apply IZR_lt.
 Qed.
 
-Theorem le_lt_Z2R :
-  forall m n p, (Z2R m <= Z2R n < Z2R p)%R -> (m <= n < p)%Z.
+Theorem le_lt_IZR :
+  forall m n p, (IZR m <= IZR n < IZR p)%R -> (m <= n < p)%Z.
 Proof.
 intros m n p (H1, H2).
 split.
-now apply le_Z2R.
-now apply lt_Z2R.
-Qed.
-
-Theorem eq_Z2R :
-  forall m n, (Z2R m = Z2R n)%R -> (m = n)%Z.
-Proof.
-intros m n H.
-apply eq_IZR.
-now rewrite <- 2!Z2R_IZR.
+now apply le_IZR.
+now apply lt_IZR.
 Qed.
 
-Theorem neq_Z2R :
-  forall m n, (Z2R m <> Z2R n)%R -> (m <> n)%Z.
+Theorem neq_IZR :
+  forall m n, (IZR m <> IZR n)%R -> (m <> n)%Z.
 Proof.
 intros m n H H'.
 apply H.
 now apply f_equal.
 Qed.
 
-Theorem Z2R_neq :
-  forall m n, (m <> n)%Z -> (Z2R m <> Z2R n)%R.
-Proof.
-intros m n.
-repeat rewrite Z2R_IZR.
-apply IZR_neq.
-Qed.
-
-Theorem Z2R_abs :
-  forall z, Z2R (Zabs z) = Rabs (Z2R z).
-Proof.
-intros.
-repeat rewrite Z2R_IZR.
-now rewrite Rabs_Zabs.
-Qed.
-
-End Z2R.
+End IZR.
 
 (** Decidable comparison on reals *)
 Section Rcompare.
@@ -691,17 +495,17 @@ contradict H.
 now apply Rcompare_Gt.
 Qed.
 
-Theorem Rcompare_Z2R :
-  forall x y, Rcompare (Z2R x) (Z2R y) = Zcompare x y.
+Theorem Rcompare_IZR :
+  forall x y, Rcompare (IZR x) (IZR y) = Z.compare x y.
 Proof.
 intros x y.
 case Rcompare_spec ; intros H ; apply sym_eq.
 apply Zcompare_Lt.
-now apply lt_Z2R.
+now apply lt_IZR.
 apply Zcompare_Eq.
-now apply eq_Z2R.
+now apply eq_IZR.
 apply Zcompare_Gt.
-now apply lt_Z2R.
+now apply lt_IZR.
 Qed.
 
 Theorem Rcompare_sym :
@@ -715,6 +519,16 @@ now apply Rcompare_Eq.
 now apply Rcompare_Lt.
 Qed.
 
+Lemma Rcompare_opp :
+  forall x y,
+  Rcompare (- x) (- y) = Rcompare y x.
+Proof.
+intros x y.
+destruct (Rcompare_spec y x);
+  destruct (Rcompare_spec (- x) (- y));
+  try reflexivity; exfalso; lra.
+Qed.
+
 Theorem Rcompare_plus_r :
   forall z x y,
   Rcompare (x + z) (y + z) = Rcompare x y.
@@ -773,7 +587,7 @@ rewrite <- (Rcompare_mult_r (/2) (x - d)).
 field_simplify (x + (- x / 2 - d / 2))%R.
 now field_simplify ((d + u) / 2 + (- x / 2 - d / 2))%R.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 Qed.
 
 Theorem Rcompare_half_l :
@@ -784,8 +598,8 @@ rewrite <- (Rcompare_mult_r 2%R).
 unfold Rdiv.
 rewrite Rmult_assoc, Rinv_l, Rmult_1_r.
 now rewrite Rmult_comm.
-now apply (Z2R_neq 2 0).
-now apply (Z2R_lt 0 2).
+now apply IZR_neq.
+now apply IZR_lt.
 Qed.
 
 Theorem Rcompare_half_r :
@@ -796,23 +610,23 @@ rewrite <- (Rcompare_mult_r 2%R).
 unfold Rdiv.
 rewrite Rmult_assoc, Rinv_l, Rmult_1_r.
 now rewrite Rmult_comm.
-now apply (Z2R_neq 2 0).
-now apply (Z2R_lt 0 2).
+now apply IZR_neq.
+now apply IZR_lt.
 Qed.
 
 Theorem Rcompare_sqr :
   forall x y,
-  (0 <= x)%R -> (0 <= y)%R ->
-  Rcompare (x * x) (y * y) = Rcompare x y.
+  Rcompare (x * x) (y * y) = Rcompare (Rabs x) (Rabs y).
 Proof.
-intros x y Hx Hy.
-destruct (Rcompare_spec x y) as [H|H|H].
+intros x y.
+destruct (Rcompare_spec (Rabs x) (Rabs y)) as [H|H|H].
 apply Rcompare_Lt.
-now apply Rsqr_incrst_1.
-rewrite H.
+now apply Rsqr_lt_abs_1.
+change (Rcompare (Rsqr x) (Rsqr y) = Eq).
+rewrite Rsqr_abs, H, (Rsqr_abs y).
 now apply Rcompare_Eq.
 apply Rcompare_Gt.
-now apply Rsqr_incrst_1.
+now apply Rsqr_lt_abs_1.
 Qed.
 
 Theorem Rmin_compare :
@@ -941,6 +755,14 @@ rewrite <- negb_Rlt_bool.
 now rewrite Rle_bool_true.
 Qed.
 
+Lemma Rlt_bool_opp :
+  forall x y,
+  Rlt_bool (- x) (- y) = Rlt_bool y x.
+Proof.
+intros x y.
+now unfold Rlt_bool; rewrite Rcompare_opp.
+Qed.
+
 End Rlt_bool.
 
 Section Req_bool.
@@ -997,13 +819,12 @@ Definition Zfloor (x : R) := (up x - 1)%Z.
 
 Theorem Zfloor_lb :
   forall x : R,
-  (Z2R (Zfloor x) <= x)%R.
+  (IZR (Zfloor x) <= x)%R.
 Proof.
 intros x.
 unfold Zfloor.
-rewrite Z2R_minus.
+rewrite minus_IZR.
 simpl.
-rewrite Z2R_IZR.
 apply Rplus_le_reg_r with (1 - x)%R.
 ring_simplify.
 exact (proj2 (archimed x)).
@@ -1011,55 +832,54 @@ Qed.
 
 Theorem Zfloor_ub :
   forall x : R,
-  (x < Z2R (Zfloor x) + 1)%R.
+  (x < IZR (Zfloor x) + 1)%R.
 Proof.
 intros x.
 unfold Zfloor.
-rewrite Z2R_minus.
+rewrite minus_IZR.
 unfold Rminus.
 rewrite Rplus_assoc.
 rewrite Rplus_opp_l, Rplus_0_r.
-rewrite Z2R_IZR.
 exact (proj1 (archimed x)).
 Qed.
 
 Theorem Zfloor_lub :
   forall n x,
-  (Z2R n <= x)%R ->
+  (IZR n <= x)%R ->
   (n <= Zfloor x)%Z.
 Proof.
 intros n x Hnx.
 apply Zlt_succ_le.
-apply lt_Z2R.
+apply lt_IZR.
 apply Rle_lt_trans with (1 := Hnx).
-unfold Zsucc.
-rewrite Z2R_plus.
+unfold Z.succ.
+rewrite plus_IZR.
 apply Zfloor_ub.
 Qed.
 
 Theorem Zfloor_imp :
   forall n x,
-  (Z2R n <= x < Z2R (n + 1))%R ->
+  (IZR n <= x < IZR (n + 1))%R ->
   Zfloor x = n.
 Proof.
 intros n x Hnx.
 apply Zle_antisym.
 apply Zlt_succ_le.
-apply lt_Z2R.
+apply lt_IZR.
 apply Rle_lt_trans with (2 := proj2 Hnx).
 apply Zfloor_lb.
 now apply Zfloor_lub.
 Qed.
 
-Theorem Zfloor_Z2R :
+Theorem Zfloor_IZR :
   forall n,
-  Zfloor (Z2R n) = n.
+  Zfloor (IZR n) = n.
 Proof.
 intros n.
 apply Zfloor_imp.
 split.
 apply Rle_refl.
-apply Z2R_lt.
+apply IZR_lt.
 apply Zlt_succ.
 Qed.
 
@@ -1077,11 +897,11 @@ Definition Zceil (x : R) := (- Zfloor (- x))%Z.
 
 Theorem Zceil_ub :
   forall x : R,
-  (x <= Z2R (Zceil x))%R.
+  (x <= IZR (Zceil x))%R.
 Proof.
 intros x.
 unfold Zceil.
-rewrite Z2R_opp.
+rewrite opp_IZR.
 apply Ropp_le_cancel.
 rewrite Ropp_involutive.
 apply Zfloor_lb.
@@ -1089,45 +909,45 @@ Qed.
 
 Theorem Zceil_glb :
   forall n x,
-  (x <= Z2R n)%R ->
+  (x <= IZR n)%R ->
   (Zceil x <= n)%Z.
 Proof.
 intros n x Hnx.
 unfold Zceil.
 apply Zopp_le_cancel.
-rewrite Zopp_involutive.
+rewrite Z.opp_involutive.
 apply Zfloor_lub.
-rewrite Z2R_opp.
+rewrite opp_IZR.
 now apply Ropp_le_contravar.
 Qed.
 
 Theorem Zceil_imp :
   forall n x,
-  (Z2R (n - 1) < x <= Z2R n)%R ->
+  (IZR (n - 1) < x <= IZR n)%R ->
   Zceil x = n.
 Proof.
 intros n x Hnx.
 unfold Zceil.
-rewrite <- (Zopp_involutive n).
+rewrite <- (Z.opp_involutive n).
 apply f_equal.
 apply Zfloor_imp.
 split.
-rewrite Z2R_opp.
+rewrite opp_IZR.
 now apply Ropp_le_contravar.
-rewrite <- (Zopp_involutive 1).
+rewrite <- (Z.opp_involutive 1).
 rewrite <- Zopp_plus_distr.
-rewrite Z2R_opp.
+rewrite opp_IZR.
 now apply Ropp_lt_contravar.
 Qed.
 
-Theorem Zceil_Z2R :
+Theorem Zceil_IZR :
   forall n,
-  Zceil (Z2R n) = n.
+  Zceil (IZR n) = n.
 Proof.
 intros n.
 unfold Zceil.
-rewrite <- Z2R_opp, Zfloor_Z2R.
-apply Zopp_involutive.
+rewrite <- opp_IZR, Zfloor_IZR.
+apply Z.opp_involutive.
 Qed.
 
 Theorem Zceil_le :
@@ -1142,7 +962,7 @@ Qed.
 
 Theorem Zceil_floor_neq :
   forall x : R,
-  (Z2R (Zfloor x) <> x)%R ->
+  (IZR (Zfloor x) <> x)%R ->
   (Zceil x = Zfloor x + 1)%Z.
 Proof.
 intros x Hx.
@@ -1156,21 +976,21 @@ apply Rle_antisym.
 apply Zfloor_lb.
 exact H.
 apply Rlt_le.
-rewrite Z2R_plus.
+rewrite plus_IZR.
 apply Zfloor_ub.
 Qed.
 
 Definition Ztrunc x := if Rlt_bool x 0 then Zceil x else Zfloor x.
 
-Theorem Ztrunc_Z2R :
+Theorem Ztrunc_IZR :
   forall n,
-  Ztrunc (Z2R n) = n.
+  Ztrunc (IZR n) = n.
 Proof.
 intros n.
 unfold Ztrunc.
 case Rlt_bool_spec ; intro H.
-apply Zceil_Z2R.
-apply Zfloor_Z2R.
+apply Zceil_IZR.
+apply Zfloor_IZR.
 Qed.
 
 Theorem Ztrunc_floor :
@@ -1196,9 +1016,8 @@ unfold Ztrunc.
 case Rlt_bool_spec ; intro H.
 apply refl_equal.
 rewrite (Rle_antisym _ _ Hx H).
-change 0%R with (Z2R 0).
-rewrite Zceil_Z2R.
-apply Zfloor_Z2R.
+rewrite Zceil_IZR.
+apply Zfloor_IZR.
 Qed.
 
 Theorem Ztrunc_le :
@@ -1211,7 +1030,7 @@ case Rlt_bool_spec ; intro Hx.
 unfold Ztrunc.
 case Rlt_bool_spec ; intro Hy.
 now apply Zceil_le.
-apply Zle_trans with 0%Z.
+apply Z.le_trans with 0%Z.
 apply Zceil_glb.
 now apply Rlt_le.
 now apply Zfloor_lub.
@@ -1222,14 +1041,14 @@ Qed.
 
 Theorem Ztrunc_opp :
   forall x,
-  Ztrunc (- x) = Zopp (Ztrunc x).
+  Ztrunc (- x) = Z.opp (Ztrunc x).
 Proof.
 intros x.
 unfold Ztrunc at 2.
 case Rlt_bool_spec ; intros Hx.
 rewrite Ztrunc_floor.
 apply sym_eq.
-apply Zopp_involutive.
+apply Z.opp_involutive.
 rewrite <- Ropp_0.
 apply Ropp_le_contravar.
 now apply Rlt_le.
@@ -1242,7 +1061,7 @@ Qed.
 
 Theorem Ztrunc_abs :
   forall x,
-  Ztrunc (Rabs x) = Zabs (Ztrunc x).
+  Ztrunc (Rabs x) = Z.abs (Ztrunc x).
 Proof.
 intros x.
 rewrite Ztrunc_floor. 2: apply Rabs_pos.
@@ -1251,19 +1070,19 @@ case Rlt_bool_spec ; intro H.
 rewrite Rabs_left with (1 := H).
 rewrite Zabs_non_eq.
 apply sym_eq.
-apply Zopp_involutive.
+apply Z.opp_involutive.
 apply Zceil_glb.
 now apply Rlt_le.
 rewrite Rabs_pos_eq with (1 := H).
 apply sym_eq.
-apply Zabs_eq.
+apply Z.abs_eq.
 now apply Zfloor_lub.
 Qed.
 
 Theorem Ztrunc_lub :
   forall n x,
-  (Z2R n <= Rabs x)%R ->
-  (n <= Zabs (Ztrunc x))%Z.
+  (IZR n <= Rabs x)%R ->
+  (n <= Z.abs (Ztrunc x))%Z.
 Proof.
 intros n x H.
 rewrite <- Ztrunc_abs.
@@ -1273,15 +1092,15 @@ Qed.
 
 Definition Zaway x := if Rlt_bool x 0 then Zfloor x else Zceil x.
 
-Theorem Zaway_Z2R :
+Theorem Zaway_IZR :
   forall n,
-  Zaway (Z2R n) = n.
+  Zaway (IZR n) = n.
 Proof.
 intros n.
 unfold Zaway.
 case Rlt_bool_spec ; intro H.
-apply Zfloor_Z2R.
-apply Zceil_Z2R.
+apply Zfloor_IZR.
+apply Zceil_IZR.
 Qed.
 
 Theorem Zaway_ceil :
@@ -1307,9 +1126,8 @@ unfold Zaway.
 case Rlt_bool_spec ; intro H.
 apply refl_equal.
 rewrite (Rle_antisym _ _ Hx H).
-change 0%R with (Z2R 0).
-rewrite Zfloor_Z2R.
-apply Zceil_Z2R.
+rewrite Zfloor_IZR.
+apply Zceil_IZR.
 Qed.
 
 Theorem Zaway_le :
@@ -1322,7 +1140,7 @@ case Rlt_bool_spec ; intro Hx.
 unfold Zaway.
 case Rlt_bool_spec ; intro Hy.
 now apply Zfloor_le.
-apply le_Z2R.
+apply le_IZR.
 apply Rle_trans with 0%R.
 apply Rlt_le.
 apply Rle_lt_trans with (2 := Hx).
@@ -1336,7 +1154,7 @@ Qed.
 
 Theorem Zaway_opp :
   forall x,
-  Zaway (- x) = Zopp (Zaway x).
+  Zaway (- x) = Z.opp (Zaway x).
 Proof.
 intros x.
 unfold Zaway at 2.
@@ -1348,14 +1166,14 @@ apply Rlt_le.
 now apply Ropp_0_gt_lt_contravar.
 rewrite Zaway_floor.
 apply sym_eq.
-apply Zopp_involutive.
+apply Z.opp_involutive.
 rewrite <- Ropp_0.
 now apply Ropp_le_contravar.
 Qed.
 
 Theorem Zaway_abs :
   forall x,
-  Zaway (Rabs x) = Zabs (Zaway x).
+  Zaway (Rabs x) = Z.abs (Zaway x).
 Proof.
 intros x.
 rewrite Zaway_ceil. 2: apply Rabs_pos.
@@ -1365,66 +1183,126 @@ rewrite Rabs_left with (1 := H).
 rewrite Zabs_non_eq.
 apply (f_equal (fun v => - Zfloor v)%Z).
 apply Ropp_involutive.
-apply le_Z2R.
+apply le_IZR.
 apply Rlt_le.
 apply Rle_lt_trans with (2 := H).
 apply Zfloor_lb.
 rewrite Rabs_pos_eq with (1 := H).
 apply sym_eq.
-apply Zabs_eq.
-apply le_Z2R.
+apply Z.abs_eq.
+apply le_IZR.
 apply Rle_trans with (1 := H).
 apply Zceil_ub.
 Qed.
 
 End Floor_Ceil.
 
+Theorem Rcompare_floor_ceil_middle :
+  forall x,
+  IZR (Zfloor x) <> x ->
+  Rcompare (x - IZR (Zfloor x)) (/ 2) = Rcompare (x - IZR (Zfloor x)) (IZR (Zceil x) - x).
+Proof.
+intros x Hx.
+rewrite Zceil_floor_neq with (1 := Hx).
+rewrite plus_IZR.
+destruct (Rcompare_spec (x - IZR (Zfloor x)) (/ 2)) as [H1|H1|H1] ; apply sym_eq.
+(* . *)
+apply Rcompare_Lt.
+apply Rplus_lt_reg_l with (x - IZR (Zfloor x))%R.
+replace (x - IZR (Zfloor x) + (x - IZR (Zfloor x)))%R with ((x - IZR (Zfloor x)) * 2)%R by ring.
+replace (x - IZR (Zfloor x) + (IZR (Zfloor x) + 1 - x))%R with (/2 * 2)%R by field.
+apply Rmult_lt_compat_r with (2 := H1).
+now apply IZR_lt.
+(* . *)
+apply Rcompare_Eq.
+replace (IZR (Zfloor x) + 1 - x)%R with (1 - (x - IZR (Zfloor x)))%R by ring.
+rewrite H1.
+field.
+(* . *)
+apply Rcompare_Gt.
+apply Rplus_lt_reg_l with (x - IZR (Zfloor x))%R.
+replace (x - IZR (Zfloor x) + (x - IZR (Zfloor x)))%R with ((x - IZR (Zfloor x)) * 2)%R by ring.
+replace (x - IZR (Zfloor x) + (IZR (Zfloor x) + 1 - x))%R with (/2 * 2)%R by field.
+apply Rmult_lt_compat_r with (2 := H1).
+now apply IZR_lt.
+Qed.
+
+Theorem Rcompare_ceil_floor_middle :
+  forall x,
+  IZR (Zfloor x) <> x ->
+  Rcompare (IZR (Zceil x) - x) (/ 2) = Rcompare (IZR (Zceil x) - x) (x - IZR (Zfloor x)).
+Proof.
+intros x Hx.
+rewrite Zceil_floor_neq with (1 := Hx).
+rewrite plus_IZR.
+destruct (Rcompare_spec (IZR (Zfloor x) + 1 - x) (/ 2)) as [H1|H1|H1] ; apply sym_eq.
+(* . *)
+apply Rcompare_Lt.
+apply Rplus_lt_reg_l with (IZR (Zfloor x) + 1 - x)%R.
+replace (IZR (Zfloor x) + 1 - x + (IZR (Zfloor x) + 1 - x))%R with ((IZR (Zfloor x) + 1 - x) * 2)%R by ring.
+replace (IZR (Zfloor x) + 1 - x + (x - IZR (Zfloor x)))%R with (/2 * 2)%R by field.
+apply Rmult_lt_compat_r with (2 := H1).
+now apply IZR_lt.
+(* . *)
+apply Rcompare_Eq.
+replace (x - IZR (Zfloor x))%R with (1 - (IZR (Zfloor x) + 1 - x))%R by ring.
+rewrite H1.
+field.
+(* . *)
+apply Rcompare_Gt.
+apply Rplus_lt_reg_l with (IZR (Zfloor x) + 1 - x)%R.
+replace (IZR (Zfloor x) + 1 - x + (IZR (Zfloor x) + 1 - x))%R with ((IZR (Zfloor x) + 1 - x) * 2)%R by ring.
+replace (IZR (Zfloor x) + 1 - x + (x - IZR (Zfloor x)))%R with (/2 * 2)%R by field.
+apply Rmult_lt_compat_r with (2 := H1).
+now apply IZR_lt.
+Qed.
+
 Section Zdiv_Rdiv.
 
 Theorem Zfloor_div :
   forall x y,
   y <> Z0 ->
-  Zfloor (Z2R x / Z2R y) = (x / y)%Z.
+  Zfloor (IZR x / IZR y) = (x / y)%Z.
 Proof.
 intros x y Zy.
 generalize (Z_div_mod_eq_full x y Zy).
 intros Hx.
 rewrite Hx at 1.
-assert (Zy': Z2R y <> R0).
+assert (Zy': IZR y <> 0%R).
 contradict Zy.
-now apply eq_Z2R.
+now apply eq_IZR.
 unfold Rdiv.
-rewrite Z2R_plus, Rmult_plus_distr_r, Z2R_mult.
-replace (Z2R y * Z2R (x / y) * / Z2R y)%R with (Z2R (x / y)) by now field.
+rewrite plus_IZR, Rmult_plus_distr_r, mult_IZR.
+replace (IZR y * IZR (x / y) * / IZR y)%R with (IZR (x / y)) by now field.
 apply Zfloor_imp.
-rewrite Z2R_plus.
-assert (0 <= Z2R (x mod y) * / Z2R y < 1)%R.
+rewrite plus_IZR.
+assert (0 <= IZR (x mod y) * / IZR y < 1)%R.
 (* *)
-assert (forall x' y', (0 < y')%Z -> 0 <= Z2R (x' mod y') * / Z2R y' < 1)%R.
+assert (forall x' y', (0 < y')%Z -> 0 <= IZR (x' mod y') * / IZR y' < 1)%R.
 (* . *)
 clear.
 intros x y Hy.
 split.
 apply Rmult_le_pos.
-apply (Z2R_le 0).
+apply IZR_le.
 refine (proj1 (Z_mod_lt _ _ _)).
-now apply Zlt_gt.
+now apply Z.lt_gt.
 apply Rlt_le.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0).
-apply Rmult_lt_reg_r with (Z2R y).
-now apply (Z2R_lt 0).
+now apply IZR_lt.
+apply Rmult_lt_reg_r with (IZR y).
+now apply IZR_lt.
 rewrite Rmult_1_l, Rmult_assoc, Rinv_l, Rmult_1_r.
-apply Z2R_lt.
+apply IZR_lt.
 eapply Z_mod_lt.
-now apply Zlt_gt.
+now apply Z.lt_gt.
 apply Rgt_not_eq.
-now apply (Z2R_lt 0).
+now apply IZR_lt.
 (* . *)
 destruct (Z_lt_le_dec y 0) as [Hy|Hy].
 rewrite <- Rmult_opp_opp.
 rewrite Ropp_inv_permute with (1 := Zy').
-rewrite <- 2!Z2R_opp.
+rewrite <- 2!opp_IZR.
 rewrite <- Zmod_opp_opp.
 apply H.
 clear -Hy. omega.
@@ -1432,7 +1310,7 @@ apply H.
 clear -Zy Hy. omega.
 (* *)
 split.
-pattern (Z2R (x / y)) at 1 ; rewrite <- Rplus_0_r.
+pattern (IZR (x / y)) at 1 ; rewrite <- Rplus_0_r.
 apply Rplus_le_compat_l.
 apply H.
 apply Rplus_lt_compat_l.
@@ -1445,11 +1323,11 @@ Section pow.
 
 Variable r : radix.
 
-Theorem radix_pos : (0 < Z2R r)%R.
+Theorem radix_pos : (0 < IZR r)%R.
 Proof.
 destruct r as (v, Hr). simpl.
-apply (Z2R_lt 0).
-apply Zlt_le_trans with 2%Z.
+apply IZR_lt.
+apply Z.lt_le_trans with 2%Z.
 easy.
 now apply Zle_bool_imp_le.
 Qed.
@@ -1457,14 +1335,14 @@ Qed.
 (** Well-used function called bpow for computing the power function #&beta;#^e *)
 Definition bpow e :=
   match e with
-  | Zpos p => Z2R (Zpower_pos r p)
-  | Zneg p => Rinv (Z2R (Zpower_pos r p))
+  | Zpos p => IZR (Zpower_pos r p)
+  | Zneg p => Rinv (IZR (Zpower_pos r p))
   | Z0 => 1%R
   end.
 
-Theorem Z2R_Zpower_pos :
+Theorem IZR_Zpower_pos :
   forall n m,
-  Z2R (Zpower_pos n m) = powerRZ (Z2R n) (Zpos m).
+  IZR (Zpower_pos n m) = powerRZ (IZR n) (Zpos m).
 Proof.
 intros.
 rewrite Zpower_pos_nat.
@@ -1473,19 +1351,19 @@ induction (nat_of_P m).
 apply refl_equal.
 unfold Zpower_nat.
 simpl.
-rewrite Z2R_mult.
+rewrite mult_IZR.
 apply Rmult_eq_compat_l.
 exact IHn0.
 Qed.
 
 Theorem bpow_powerRZ :
   forall e,
-  bpow e = powerRZ (Z2R r) e.
+  bpow e = powerRZ (IZR r) e.
 Proof.
 destruct e ; unfold bpow.
 reflexivity.
-now rewrite Z2R_Zpower_pos.
-now rewrite Z2R_Zpower_pos.
+now rewrite IZR_Zpower_pos.
+now rewrite IZR_Zpower_pos.
 Qed.
 
 Theorem  bpow_ge_0 :
@@ -1517,14 +1395,14 @@ apply radix_pos.
 Qed.
 
 Theorem bpow_1 :
-  bpow 1 = Z2R r.
+  bpow 1 = IZR r.
 Proof.
 unfold bpow, Zpower_pos. simpl.
 now rewrite Zmult_1_r.
 Qed.
 
-Theorem bpow_plus1 :
-  forall e : Z, (bpow (e + 1) = Z2R r * bpow e)%R.
+Theorem bpow_plus_1 :
+  forall e : Z, (bpow (e + 1) = IZR r * bpow e)%R.
 Proof.
 intros.
 rewrite <- bpow_1.
@@ -1544,9 +1422,9 @@ apply Rgt_not_eq.
 apply (bpow_gt_0 (Zpos p)).
 Qed.
 
-Theorem Z2R_Zpower_nat :
+Theorem IZR_Zpower_nat :
   forall e : nat,
-  Z2R (Zpower_nat r e) = bpow (Z_of_nat e).
+  IZR (Zpower_nat r e) = bpow (Z_of_nat e).
 Proof.
 intros [|e].
 split.
@@ -1555,10 +1433,10 @@ rewrite <- Zpower_pos_nat.
 now rewrite <- Zpos_eq_Z_of_nat_o_nat_of_P.
 Qed.
 
-Theorem Z2R_Zpower :
+Theorem IZR_Zpower :
   forall e : Z,
   (0 <= e)%Z ->
-  Z2R (Zpower r e) = bpow e.
+  IZR (Zpower r e) = bpow e.
 Proof.
 intros [|e|e] H.
 split.
@@ -1579,8 +1457,8 @@ apply bpow_gt_0.
 assert (0 < e2 - e1)%Z by omega.
 destruct (e2 - e1)%Z ; try discriminate H0.
 clear.
-rewrite <- Z2R_Zpower by easy.
-apply (Z2R_lt 1).
+rewrite <- IZR_Zpower by easy.
+apply IZR_lt.
 now apply Zpower_gt_1.
 Qed.
 
@@ -1589,7 +1467,7 @@ Theorem lt_bpow :
   (bpow e1 < bpow e2)%R -> (e1 < e2)%Z.
 Proof.
 intros e1 e2 H.
-apply Zgt_lt.
+apply Z.gt_lt.
 apply Znot_le_gt.
 intros H'.
 apply Rlt_not_le with (1 := H).
@@ -1608,7 +1486,7 @@ intros e1 e2 H.
 apply Rnot_lt_le.
 intros H'.
 apply Zle_not_gt with (1 := H).
-apply Zlt_gt.
+apply Z.lt_gt.
 now apply lt_bpow.
 Qed.
 
@@ -1621,7 +1499,7 @@ apply Znot_gt_le.
 intros H'.
 apply Rle_not_lt with (1 := H).
 apply bpow_lt.
-now apply Zgt_lt.
+now apply Z.gt_lt.
 Qed.
 
 Theorem bpow_inj :
@@ -1638,15 +1516,15 @@ Qed.
 
 Theorem bpow_exp :
   forall e : Z,
-  bpow e = exp (Z2R e * ln (Z2R r)).
+  bpow e = exp (IZR e * ln (IZR r)).
 Proof.
 (* positive case *)
-assert (forall e, bpow (Zpos e) = exp (Z2R (Zpos e) * ln (Z2R r))).
+assert (forall e, bpow (Zpos e) = exp (IZR (Zpos e) * ln (IZR r))).
 intros e.
 unfold bpow.
 rewrite Zpower_pos_nat.
-unfold Z2R at 2.
-rewrite P2R_INR.
+rewrite <- positive_nat_Z.
+rewrite <- INR_IZR_INZ.
 induction (nat_of_P e).
 rewrite Rmult_0_l.
 now rewrite exp_0.
@@ -1657,7 +1535,7 @@ rewrite exp_plus.
 rewrite Rmult_1_l.
 rewrite exp_ln.
 rewrite <- IHn.
-rewrite <- Z2R_mult.
+rewrite <- mult_IZR.
 now rewrite Zmult_comm.
 apply radix_pos.
 (* general case *)
@@ -1666,31 +1544,50 @@ rewrite Rmult_0_l.
 now rewrite exp_0.
 apply H.
 unfold bpow.
-change (Z2R (Zpower_pos r e)) with (bpow (Zpos e)).
+change (IZR (Zpower_pos r e)) with (bpow (Zpos e)).
 rewrite H.
 rewrite <- exp_Ropp.
 rewrite <- Ropp_mult_distr_l_reverse.
-now rewrite <- Z2R_opp.
+now rewrite <- opp_IZR.
+Qed.
+
+Lemma sqrt_bpow :
+  forall e,
+  sqrt (bpow (2 * e)) = bpow e.
+Proof.
+intro e.
+change 2%Z with (1 + 1)%Z; rewrite Z.mul_add_distr_r, Z.mul_1_l, bpow_plus.
+apply sqrt_square, bpow_ge_0.
 Qed.
 
-(** Another well-used function for having the logarithm of a real number x to the base #&beta;# *)
-Record ln_beta_prop x := {
-  ln_beta_val :> Z ;
-  _ : (x <> 0)%R -> (bpow (ln_beta_val - 1)%Z <= Rabs x < bpow ln_beta_val)%R
+Lemma sqrt_bpow_ge :
+  forall e,
+  (bpow (e / 2) <= sqrt (bpow e))%R.
+Proof.
+intro e.
+rewrite <- (sqrt_square (bpow _)); [|now apply bpow_ge_0].
+apply sqrt_le_1_alt; rewrite <- bpow_plus; apply bpow_le.
+now replace (_ + _)%Z with (2 * (e / 2))%Z by ring; apply Z_mult_div_ge.
+Qed.
+
+(** Another well-used function for having the magnitude of a real number x to the base #&beta;# *)
+Record mag_prop x := {
+  mag_val :> Z ;
+  _ : (x <> 0)%R -> (bpow (mag_val - 1)%Z <= Rabs x < bpow mag_val)%R
 }.
 
-Definition ln_beta :
-  forall x : R, ln_beta_prop x.
+Definition mag :
+  forall x : R, mag_prop x.
 Proof.
 intros x.
-set (fact := ln (Z2R r)).
+set (fact := ln (IZR r)).
 (* . *)
 assert (0 < fact)%R.
 apply exp_lt_inv.
 rewrite exp_0.
 unfold fact.
 rewrite exp_ln.
-apply (Z2R_lt 1).
+apply IZR_lt.
 apply radix_gt_1.
 apply radix_pos.
 (* . *)
@@ -1703,19 +1600,19 @@ rewrite 2!bpow_exp.
 fold fact.
 pattern x at 2 3 ; replace x with (exp (ln x * / fact * fact)).
 split.
-rewrite Z2R_minus.
+rewrite minus_IZR.
 apply exp_le.
 apply Rmult_le_compat_r.
 now apply Rlt_le.
 unfold Rminus.
-rewrite Z2R_plus.
+rewrite plus_IZR.
 rewrite Rplus_assoc.
 rewrite Rplus_opp_r, Rplus_0_r.
 apply Zfloor_lb.
 apply exp_increasing.
 apply Rmult_lt_compat_r.
 exact H.
-rewrite Z2R_plus.
+rewrite plus_IZR.
 apply Zfloor_ub.
 rewrite Rmult_assoc.
 rewrite Rinv_l.
@@ -1748,55 +1645,55 @@ apply Zle_antisym ;
   assumption.
 Qed.
 
-Theorem ln_beta_unique :
+Theorem mag_unique :
   forall (x : R) (e : Z),
   (bpow (e - 1) <= Rabs x < bpow e)%R ->
-  ln_beta x = e :> Z.
+  mag x = e :> Z.
 Proof.
 intros x e1 He.
 destruct (Req_dec x 0) as [Hx|Hx].
 elim Rle_not_lt with (1 := proj1 He).
 rewrite Hx, Rabs_R0.
 apply bpow_gt_0.
-destruct (ln_beta x) as (e2, Hx2).
+destruct (mag x) as (e2, Hx2).
 simpl.
 apply bpow_unique with (2 := He).
 now apply Hx2.
 Qed.
 
-Theorem ln_beta_opp :
+Theorem mag_opp :
   forall x,
-  ln_beta (-x) = ln_beta x :> Z.
+  mag (-x) = mag x :> Z.
 Proof.
 intros x.
 destruct (Req_dec x 0) as [Hx|Hx].
 now rewrite Hx, Ropp_0.
-destruct (ln_beta x) as (e, He).
+destruct (mag x) as (e, He).
 simpl.
 specialize (He Hx).
-apply ln_beta_unique.
+apply mag_unique.
 now rewrite Rabs_Ropp.
 Qed.
 
-Theorem ln_beta_abs :
+Theorem mag_abs :
   forall x,
-  ln_beta (Rabs x) = ln_beta x :> Z.
+  mag (Rabs x) = mag x :> Z.
 Proof.
 intros x.
 unfold Rabs.
 case Rcase_abs ; intros _.
-apply ln_beta_opp.
+apply mag_opp.
 apply refl_equal.
 Qed.
 
-Theorem ln_beta_unique_pos :
+Theorem mag_unique_pos :
   forall (x : R) (e : Z),
   (bpow (e - 1) <= x < bpow e)%R ->
-  ln_beta x = e :> Z.
+  mag x = e :> Z.
 Proof.
 intros x e1 He1.
-rewrite <- ln_beta_abs.
-apply ln_beta_unique.
+rewrite <- mag_abs.
+apply mag_unique.
 rewrite 2!Rabs_pos_eq.
 exact He1.
 apply Rle_trans with (2 := proj1 He1).
@@ -1804,14 +1701,14 @@ apply bpow_ge_0.
 apply Rabs_pos.
 Qed.
 
-Theorem ln_beta_le_abs :
+Theorem mag_le_abs :
   forall x y,
   (x <> 0)%R -> (Rabs x <= Rabs y)%R ->
-  (ln_beta x <= ln_beta y)%Z.
+  (mag x <= mag y)%Z.
 Proof.
 intros x y H0x Hxy.
-destruct (ln_beta x) as (ex, Hx).
-destruct (ln_beta y) as (ey, Hy).
+destruct (mag x) as (ex, Hx).
+destruct (mag y) as (ey, Hy).
 simpl.
 apply bpow_lt_bpow.
 specialize (Hx H0x).
@@ -1825,13 +1722,13 @@ rewrite Hy', Rabs_R0.
 apply Rle_refl.
 Qed.
 
-Theorem ln_beta_le :
+Theorem mag_le :
   forall x y,
   (0 < x)%R -> (x <= y)%R ->
-  (ln_beta x <= ln_beta y)%Z.
+  (mag x <= mag y)%Z.
 Proof.
 intros x y H0x Hxy.
-apply ln_beta_le_abs.
+apply mag_le_abs.
 now apply Rgt_not_eq.
 rewrite 2!Rabs_pos_eq.
 exact Hxy.
@@ -1840,17 +1737,17 @@ now apply Rlt_le.
 now apply Rlt_le.
 Qed.
 
-Lemma ln_beta_lt_pos :
+Lemma lt_mag :
   forall x y,
   (0 < y)%R ->
-  (ln_beta x < ln_beta y)%Z -> (x < y)%R.
+  (mag x < mag y)%Z -> (x < y)%R.
 Proof.
 intros x y Py.
 case (Rle_or_lt x 0); intros Px.
 intros H.
 now apply Rle_lt_trans with 0%R.
-destruct (ln_beta x) as (ex, Hex).
-destruct (ln_beta y) as (ey, Hey).
+destruct (mag x) as (ex, Hex).
+destruct (mag y) as (ey, Hey).
 simpl.
 intro H.
 destruct Hex as (_,Hex); [now apply Rgt_not_eq|].
@@ -1862,11 +1759,11 @@ apply Rle_trans with (bpow (ey - 1)); [|exact Hey].
 now apply bpow_le; omega.
 Qed.
 
-Theorem ln_beta_bpow :
-  forall e, (ln_beta (bpow e) = e + 1 :> Z)%Z.
+Theorem mag_bpow :
+  forall e, (mag (bpow e) = e + 1 :> Z)%Z.
 Proof.
 intros e.
-apply ln_beta_unique.
+apply mag_unique.
 rewrite Rabs_right.
 replace (e + 1 - 1)%Z with e by ring.
 split.
@@ -1877,14 +1774,14 @@ apply Rle_ge.
 apply bpow_ge_0.
 Qed.
 
-Theorem ln_beta_mult_bpow :
+Theorem mag_mult_bpow :
   forall x e, x <> 0%R ->
-  (ln_beta (x * bpow e) = ln_beta x + e :>Z)%Z.
+  (mag (x * bpow e) = mag x + e :>Z)%Z.
 Proof.
 intros x e Zx.
-destruct (ln_beta x) as (ex, Ex) ; simpl.
+destruct (mag x) as (ex, Ex) ; simpl.
 specialize (Ex Zx).
-apply ln_beta_unique.
+apply mag_unique.
 rewrite Rabs_mult.
 rewrite (Rabs_pos_eq (bpow e)) by apply bpow_ge_0.
 split.
@@ -1899,26 +1796,26 @@ apply bpow_gt_0.
 apply Ex.
 Qed.
 
-Theorem ln_beta_le_bpow :
+Theorem mag_le_bpow :
   forall x e,
   x <> 0%R ->
   (Rabs x < bpow e)%R ->
-  (ln_beta x <= e)%Z.
+  (mag x <= e)%Z.
 Proof.
 intros x e Zx Hx.
-destruct (ln_beta x) as (ex, Ex) ; simpl.
+destruct (mag x) as (ex, Ex) ; simpl.
 specialize (Ex Zx).
 apply bpow_lt_bpow.
 now apply Rle_lt_trans with (Rabs x).
 Qed.
 
-Theorem ln_beta_gt_bpow :
+Theorem mag_gt_bpow :
   forall x e,
   (bpow e <= Rabs x)%R ->
-  (e < ln_beta x)%Z.
+  (e < mag x)%Z.
 Proof.
 intros x e Hx.
-destruct (ln_beta x) as (ex, Ex) ; simpl.
+destruct (mag x) as (ex, Ex) ; simpl.
 apply lt_bpow.
 apply Rle_lt_trans with (1 := Hx).
 apply Ex.
@@ -1928,92 +1825,92 @@ rewrite Zx, Rabs_R0.
 apply bpow_gt_0.
 Qed.
 
-Theorem ln_beta_ge_bpow :
+Theorem mag_ge_bpow :
   forall x e,
   (bpow (e - 1) <= Rabs x)%R ->
-  (e <= ln_beta x)%Z.
+  (e <= mag x)%Z.
 Proof.
 intros x e H.
 destruct (Rlt_or_le (Rabs x) (bpow e)) as [Hxe|Hxe].
 - (* Rabs x w bpow e *)
-  assert (ln_beta x = e :> Z) as Hln.
-  now apply ln_beta_unique; split.
+  assert (mag x = e :> Z) as Hln.
+  now apply mag_unique; split.
   rewrite Hln.
   now apply Z.le_refl.
 - (* bpow e <= Rabs x *)
   apply Zlt_le_weak.
-  now apply ln_beta_gt_bpow.
+  now apply mag_gt_bpow.
 Qed.
 
-Theorem bpow_ln_beta_gt :
+Theorem bpow_mag_gt :
   forall x,
-  (Rabs x < bpow (ln_beta x))%R.
+  (Rabs x < bpow (mag x))%R.
 Proof.
 intros x.
 destruct (Req_dec x 0) as [Zx|Zx].
 rewrite Zx, Rabs_R0.
 apply bpow_gt_0.
-destruct (ln_beta x) as (ex, Ex) ; simpl.
+destruct (mag x) as (ex, Ex) ; simpl.
 now apply Ex.
 Qed.
 
-Theorem bpow_ln_beta_le :
+Theorem bpow_mag_le :
   forall x, (x <> 0)%R ->
-    (bpow (ln_beta x-1) <= Rabs x)%R.
+    (bpow (mag x-1) <= Rabs x)%R.
 Proof.
 intros x Hx.
-destruct (ln_beta x) as (ex, Ex) ; simpl.
+destruct (mag x) as (ex, Ex) ; simpl.
 now apply Ex.
 Qed.
 
 
-Theorem ln_beta_le_Zpower :
+Theorem mag_le_Zpower :
   forall m e,
   m <> Z0 ->
-  (Zabs m < Zpower r e)%Z->
-  (ln_beta (Z2R m) <= e)%Z.
+  (Z.abs m < Zpower r e)%Z->
+  (mag (IZR m) <= e)%Z.
 Proof.
 intros m e Zm Hm.
-apply ln_beta_le_bpow.
-exact (Z2R_neq m 0 Zm).
+apply mag_le_bpow.
+now apply IZR_neq.
 destruct (Zle_or_lt 0 e).
-rewrite <- Z2R_abs, <- Z2R_Zpower with (1 := H).
-now apply Z2R_lt.
+rewrite <- abs_IZR, <- IZR_Zpower with (1 := H).
+now apply IZR_lt.
 elim Zm.
-cut (Zabs m < 0)%Z.
+cut (Z.abs m < 0)%Z.
 now case m.
 clear -Hm H.
 now destruct e.
 Qed.
 
-Theorem ln_beta_gt_Zpower :
+Theorem mag_gt_Zpower :
   forall m e,
   m <> Z0 ->
-  (Zpower r e <= Zabs m)%Z ->
-  (e < ln_beta (Z2R m))%Z.
+  (Zpower r e <= Z.abs m)%Z ->
+  (e < mag (IZR m))%Z.
 Proof.
 intros m e Zm Hm.
-apply ln_beta_gt_bpow.
-rewrite <- Z2R_abs.
+apply mag_gt_bpow.
+rewrite <- abs_IZR.
 destruct (Zle_or_lt 0 e).
-rewrite <- Z2R_Zpower with (1 := H).
-now apply Z2R_le.
+rewrite <- IZR_Zpower with (1 := H).
+now apply IZR_le.
 apply Rle_trans with (bpow 0).
 apply bpow_le.
 now apply Zlt_le_weak.
-apply (Z2R_le 1).
+apply IZR_le.
 clear -Zm.
 zify ; omega.
 Qed.
 
-Lemma ln_beta_mult :
+Lemma mag_mult :
   forall x y,
   (x <> 0)%R -> (y <> 0)%R ->
-  (ln_beta x + ln_beta y - 1 <= ln_beta (x * y) <= ln_beta x + ln_beta y)%Z.
+  (mag x + mag y - 1 <= mag (x * y) <= mag x + mag y)%Z.
 Proof.
 intros x y Hx Hy.
-destruct (ln_beta x) as (ex, Hx2).
-destruct (ln_beta y) as (ey, Hy2).
+destruct (mag x) as (ex, Hx2).
+destruct (mag y) as (ey, Hy2).
 simpl.
 destruct (Hx2 Hx) as (Hx21,Hx22); clear Hx2.
 destruct (Hy2 Hy) as (Hy21,Hy22); clear Hy2.
@@ -2029,26 +1926,26 @@ assert (Hxy2 : (Rabs (x * y) < bpow (ex + ey))%R).
   now apply Rle_trans with (bpow (ex - 1)); try apply bpow_ge_0.
   now apply Rle_trans with (bpow (ey - 1)); try apply bpow_ge_0. }
 split.
-- now apply ln_beta_ge_bpow.
-- apply ln_beta_le_bpow.
+- now apply mag_ge_bpow.
+- apply mag_le_bpow.
   + now apply Rmult_integral_contrapositive_currified.
   + assumption.
 Qed.
 
-Lemma ln_beta_plus :
+Lemma mag_plus :
   forall x y,
   (0 < y)%R -> (y <= x)%R ->
-  (ln_beta x <= ln_beta (x + y) <= ln_beta x + 1)%Z.
+  (mag x <= mag (x + y) <= mag x + 1)%Z.
 Proof.
 assert (Hr : (2 <= r)%Z).
 { destruct r as (beta_val,beta_prop).
   now apply Zle_bool_imp_le. }
 intros x y Hy Hxy.
 assert (Hx : (0 < x)%R) by apply (Rlt_le_trans _ _ _ Hy Hxy).
-destruct (ln_beta x) as (ex,Hex); simpl.
+destruct (mag x) as (ex,Hex); simpl.
 destruct Hex as (Hex0,Hex1); [now apply Rgt_not_eq|].
 assert (Haxy : (Rabs (x + y) < bpow (ex + 1))%R).
-{ rewrite bpow_plus1.
+{ rewrite bpow_plus_1.
   apply Rlt_le_trans with (2 * bpow ex)%R.
   - rewrite Rabs_pos_eq.
     apply Rle_lt_trans with (2 * Rabs x)%R.
@@ -2062,7 +1959,7 @@ assert (Haxy : (Rabs (x + y) < bpow (ex + 1))%R).
       now apply Rlt_le, Rplus_lt_compat.
   - apply Rmult_le_compat_r.
     now apply bpow_ge_0.
-    now apply (Z2R_le 2). }
+    now apply IZR_le. }
 assert (Haxy2 : (bpow (ex - 1) <= Rabs (x + y))%R).
 { apply (Rle_trans _ _ _ Hex0).
   rewrite Rabs_right; [|now apply Rgt_ge].
@@ -2071,20 +1968,20 @@ assert (Haxy2 : (bpow (ex - 1) <= Rabs (x + y))%R).
   apply Rplus_le_compat_l.
   now apply Rlt_le. }
 split.
-- now apply ln_beta_ge_bpow.
-- apply ln_beta_le_bpow.
+- now apply mag_ge_bpow.
+- apply mag_le_bpow.
   + now apply tech_Rplus; [apply Rlt_le|].
   + exact Haxy.
 Qed.
 
-Lemma ln_beta_minus :
+Lemma mag_minus :
   forall x y,
   (0 < y)%R -> (y < x)%R ->
-  (ln_beta (x - y) <= ln_beta x)%Z.
+  (mag (x - y) <= mag x)%Z.
 Proof.
 intros x y Py Hxy.
 assert (Px : (0 < x)%R) by apply (Rlt_trans _ _ _ Py Hxy).
-apply ln_beta_le.
+apply mag_le.
 - now apply Rlt_Rminus.
 - rewrite <- (Rplus_0_r x) at 2.
   apply Rplus_le_compat_l.
@@ -2092,19 +1989,19 @@ apply ln_beta_le.
   now apply Ropp_le_contravar; apply Rlt_le.
 Qed.
 
-Lemma ln_beta_minus_lb :
+Lemma mag_minus_lb :
   forall x y,
   (0 < x)%R -> (0 < y)%R ->
-  (ln_beta y <= ln_beta x - 2)%Z ->
-  (ln_beta x - 1 <= ln_beta (x - y))%Z.
+  (mag y <= mag x - 2)%Z ->
+  (mag x - 1 <= mag (x - y))%Z.
 Proof.
 assert (Hbeta : (2 <= r)%Z).
 { destruct r as (beta_val,beta_prop).
   now apply Zle_bool_imp_le. }
 intros x y Px Py Hln.
-assert (Oxy : (y < x)%R); [apply ln_beta_lt_pos;[assumption|omega]|].
-destruct (ln_beta x) as (ex,Hex).
-destruct (ln_beta y) as (ey,Hey).
+assert (Oxy : (y < x)%R); [apply lt_mag;[assumption|omega]|].
+destruct (mag x) as (ex,Hex).
+destruct (mag y) as (ey,Hey).
 simpl in Hln |- *.
 destruct Hex as (Hex,_); [now apply Rgt_not_eq|].
 destruct Hey as (_,Hey); [now apply Rgt_not_eq|].
@@ -2112,9 +2009,9 @@ assert (Hbx : (bpow (ex - 2) + bpow (ex - 2) <= x)%R).
 { ring_simplify.
   apply Rle_trans with (bpow (ex - 1)).
   - replace (ex - 1)%Z with (ex - 2 + 1)%Z by ring.
-    rewrite bpow_plus1.
+    rewrite bpow_plus_1.
     apply Rmult_le_compat_r; [now apply bpow_ge_0|].
-    now change 2%R with (Z2R 2); apply Z2R_le.
+    now apply IZR_le.
   - now rewrite Rabs_right in Hex; [|apply Rle_ge; apply Rlt_le]. }
 assert (Hby : (y < bpow (ex - 2))%R).
 { apply Rlt_le_trans with (bpow ey).
@@ -2126,98 +2023,95 @@ assert (Hbxy : (bpow (ex - 2) <= x - y)%R).
   replace (bpow (ex - 2))%R with (bpow (ex - 2) + bpow (ex - 2)
                                                   - bpow (ex - 2))%R by ring.
   now apply Rplus_le_compat. }
-apply ln_beta_ge_bpow.
+apply mag_ge_bpow.
 replace (ex - 1 - 1)%Z with (ex - 2)%Z by ring.
 now apply Rabs_ge; right.
 Qed.
 
-Lemma ln_beta_div :
+Lemma mag_div :
   forall x y : R,
-  (0 < x)%R -> (0 < y)%R ->
-  (ln_beta x - ln_beta y <= ln_beta (x / y) <= ln_beta x - ln_beta y + 1)%Z.
+  x <> 0%R -> y <> 0%R ->
+  (mag x - mag y <= mag (x / y) <= mag x - mag y + 1)%Z.
 Proof.
 intros x y Px Py.
-destruct (ln_beta x) as (ex,Hex).
-destruct (ln_beta y) as (ey,Hey).
+destruct (mag x) as (ex,Hex).
+destruct (mag y) as (ey,Hey).
 simpl.
 unfold Rdiv.
-rewrite Rabs_right in Hex; [|now apply Rle_ge; apply Rlt_le].
-rewrite Rabs_right in Hey; [|now apply Rle_ge; apply Rlt_le].
-assert (Heiy : (bpow (- ey) < / y <= bpow (- ey + 1))%R).
-{ split.
+assert (Heiy : (bpow (- ey) < Rabs (/ y) <= bpow (- ey + 1))%R).
+{ rewrite Rabs_Rinv by easy.
+  split.
   - rewrite bpow_opp.
     apply Rinv_lt_contravar.
-    + apply Rmult_lt_0_compat; [exact Py|].
+    + apply Rmult_lt_0_compat.
+      now apply Rabs_pos_lt.
       now apply bpow_gt_0.
-    + apply Hey.
-      now apply Rgt_not_eq.
+    + now apply Hey.
   - replace (_ + _)%Z with (- (ey - 1))%Z by ring.
     rewrite bpow_opp.
     apply Rinv_le; [now apply bpow_gt_0|].
-    apply Hey.
-    now apply Rgt_not_eq. }
+    now apply Hey. }
 split.
-- apply ln_beta_ge_bpow.
-  apply Rabs_ge; right.
+- apply mag_ge_bpow.
   replace (_ - _)%Z with (ex - 1 - ey)%Z by ring.
   unfold Zminus at 1; rewrite bpow_plus.
+  rewrite Rabs_mult.
   apply Rmult_le_compat.
   + now apply bpow_ge_0.
   + now apply bpow_ge_0.
-  + apply Hex.
-    now apply Rgt_not_eq.
-  + apply Rlt_le; apply Heiy.
-- assert (Pxy : (0 < x * / y)%R).
-  { apply Rmult_lt_0_compat; [exact Px|].
-    now apply Rinv_0_lt_compat. }
-  apply ln_beta_le_bpow.
-  + now apply Rgt_not_eq.
-  + rewrite Rabs_right; [|now apply Rle_ge; apply Rlt_le].
-    replace (_ + 1)%Z with (ex + (- ey + 1))%Z by ring.
+  + now apply Hex.
+  + now apply Rlt_le; apply Heiy.
+- apply mag_le_bpow.
+  + apply Rmult_integral_contrapositive_currified.
+    exact Px.
+    now apply Rinv_neq_0_compat.
+  + replace (_ + 1)%Z with (ex + (- ey + 1))%Z by ring.
     rewrite bpow_plus.
-    apply Rlt_le_trans with (bpow ex * / y)%R.
-    * apply Rmult_lt_compat_r; [now apply Rinv_0_lt_compat|].
-      apply Hex.
-      now apply Rgt_not_eq.
+    apply Rlt_le_trans with (bpow ex * Rabs (/ y))%R.
+    * rewrite Rabs_mult.
+      apply Rmult_lt_compat_r.
+      apply Rabs_pos_lt.
+      now apply Rinv_neq_0_compat.
+      now apply Hex.
     * apply Rmult_le_compat_l; [now apply bpow_ge_0|].
       apply Heiy.
 Qed.
 
-Lemma ln_beta_sqrt :
+Lemma mag_sqrt :
   forall x,
   (0 < x)%R ->
-  (2 * ln_beta (sqrt x) - 1 <= ln_beta x <= 2 * ln_beta (sqrt x))%Z.
+  mag (sqrt x) = Z.div2 (mag x + 1) :> Z.
 Proof.
 intros x Px.
-assert (H : (bpow (2 * ln_beta (sqrt x) - 1 - 1) <= Rabs x
-            < bpow (2 * ln_beta (sqrt x)))%R).
-{ split.
-  - apply Rge_le; rewrite <- (sqrt_def x) at 1;
-    [|now apply Rlt_le]; apply Rle_ge.
-    rewrite Rabs_mult.
-    replace (_ - _)%Z with (ln_beta (sqrt x) - 1
-                            + (ln_beta (sqrt x) - 1))%Z by ring.
-    rewrite bpow_plus.
-    assert (H : (bpow (ln_beta (sqrt x) - 1) <= Rabs (sqrt x))%R).
-    { destruct (ln_beta (sqrt x)) as (esx,Hesx); simpl.
-      apply Hesx.
-      apply Rgt_not_eq; apply Rlt_gt.
-      now apply sqrt_lt_R0. }
-    now apply Rmult_le_compat; [now apply bpow_ge_0|now apply bpow_ge_0| |].
-  - rewrite <- (sqrt_def x) at 1; [|now apply Rlt_le].
-    rewrite Rabs_mult.
-    change 2%Z with (1 + 1)%Z; rewrite Zmult_plus_distr_l;
-    rewrite Zmult_1_l.
-    rewrite bpow_plus.
-    assert (H : (Rabs (sqrt x) < bpow (ln_beta (sqrt x)))%R).
-    { destruct (ln_beta (sqrt x)) as (esx,Hesx); simpl.
-      apply Hesx.
-      apply Rgt_not_eq; apply Rlt_gt.
-      now apply sqrt_lt_R0. }
-    now apply Rmult_lt_compat; [now apply Rabs_pos|now apply Rabs_pos| |]. }
+apply mag_unique.
+destruct mag as [e He].
+simpl.
+specialize (He (Rgt_not_eq _ _ Px)).
+rewrite Rabs_pos_eq in He by now apply Rlt_le.
 split.
-- now apply ln_beta_ge_bpow.
-- now apply ln_beta_le_bpow; [now apply Rgt_not_eq|].
+- rewrite <- (Rabs_pos_eq (bpow _)) by apply bpow_ge_0.
+  apply Rsqr_le_abs_0.
+  rewrite Rsqr_sqrt by now apply Rlt_le.
+  apply Rle_trans with (2 := proj1 He).
+  unfold Rsqr ; rewrite <- bpow_plus.
+  apply bpow_le.
+  generalize (Zdiv2_odd_eqn (e + 1)).
+  destruct Z.odd ; intros ; omega.
+- rewrite <- (Rabs_pos_eq (bpow _)) by apply bpow_ge_0.
+  apply Rsqr_lt_abs_0.
+  rewrite Rsqr_sqrt by now apply Rlt_le.
+  apply Rlt_le_trans with (1 := proj2 He).
+  unfold Rsqr ; rewrite <- bpow_plus.
+  apply bpow_le.
+  generalize (Zdiv2_odd_eqn (e + 1)).
+  destruct Z.odd ; intros ; omega.
+Qed.
+
+Lemma mag_1 : mag 1 = 1%Z :> Z.
+Proof.
+apply mag_unique_pos; rewrite bpow_1; simpl; split; [now right|apply IZR_lt].
+assert (H := Zle_bool_imp_le _ _ (radix_prop r)); revert H.
+now apply Z.lt_le_trans.
 Qed.
 
 End pow.
@@ -2248,12 +2142,12 @@ Section cond_Ropp.
 
 Definition cond_Ropp (b : bool) m := if b then Ropp m else m.
 
-Theorem Z2R_cond_Zopp :
+Theorem IZR_cond_Zopp :
   forall b m,
-  Z2R (cond_Zopp b m) = cond_Ropp b (Z2R m).
+  IZR (cond_Zopp b m) = cond_Ropp b (IZR m).
 Proof.
 intros [|] m.
-apply Z2R_opp.
+apply opp_IZR.
 apply refl_equal.
 Qed.
 
@@ -2286,22 +2180,6 @@ apply Ropp_involutive.
 apply refl_equal.
 Qed.
 
-Theorem cond_Ropp_even_function :
-  forall {A : Type} (f : R -> A),
-  (forall x, f (Ropp x) = f x) ->
-  forall b x, f (cond_Ropp b x) = f x.
-Proof.
-now intros A f Hf [|] x ; simpl.
-Qed.
-
-Theorem cond_Ropp_odd_function :
-  forall (f : R -> R),
-  (forall x, f (Ropp x) = Ropp (f x)) ->
-  forall b x, f (cond_Ropp b x) = cond_Ropp b (f x).
-Proof.
-now intros f Hf [|] x ; simpl.
-Qed.
-
 Theorem cond_Ropp_inj :
   forall b x y,
   cond_Ropp b x = cond_Ropp b y -> x = y.
@@ -2391,7 +2269,7 @@ destruct (Rle_lt_dec l 0) as [Hl|Hl].
   apply ub.
   now apply HE.
 left.
-set (N := Zabs_nat (up (/l) - 2)).
+set (N := Z.abs_nat (up (/l) - 2)).
 exists N.
 assert (HN: (INR N + 1 = IZR (up (/ l)) - 1)%R).
   unfold N.
@@ -2399,7 +2277,7 @@ assert (HN: (INR N + 1 = IZR (up (/ l)) - 1)%R).
   rewrite inj_Zabs_nat.
   replace (IZR (up (/ l)) - 1)%R with (IZR (up (/ l) - 2) + 1)%R.
   apply (f_equal (fun v => IZR v + 1)%R).
-  apply Zabs_eq.
+  apply Z.abs_eq.
   apply Zle_minus_le_0.
   apply (Zlt_le_succ 1).
   apply lt_IZR.
@@ -2484,10 +2362,10 @@ intros n; apply H.
 destruct K as (n, Hn).
 left; now exists (-Z.of_nat n)%Z.
 right; intros n; case (Zle_or_lt 0 n); intros M.
-rewrite <- (Zabs_eq n); trivial.
+rewrite <- (Z.abs_eq n); trivial.
 rewrite <- Zabs2Nat.id_abs.
 apply J.
-rewrite <- (Zopp_involutive n).
+rewrite <- (Z.opp_involutive n).
 rewrite <- (Z.abs_neq n).
 rewrite <- Zabs2Nat.id_abs.
 apply K.
diff --git a/flocq/Core/Fcore_rnd_ne.v b/flocq/Core/Round_NE.v
index 2d67e709..20b60ef5 100644
--- a/flocq/Core/Fcore_rnd_ne.v
+++ b/flocq/Core/Round_NE.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,14 +18,9 @@ COPYING file for more details.
 *)
 
 (** * Rounding to nearest, ties to even: existence, unicity... *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_rnd.
-Require Import Fcore_generic_fmt.
-Require Import Fcore_float_prop.
-Require Import Fcore_ulp.
+Require Import Raux Defs Round_pred Generic_fmt Float_prop Ulp.
 
-Notation ZnearestE := (Znearest (fun x => negb (Zeven x))).
+Notation ZnearestE := (Znearest (fun x => negb (Z.even x))).
 
 Section Fcore_rnd_NE.
 
@@ -38,10 +33,10 @@ Variable fexp : Z -> Z.
 Context { valid_exp : Valid_exp fexp }.
 
 Notation format := (generic_format beta fexp).
-Notation canonic := (canonic beta fexp).
+Notation canonical := (canonical beta fexp).
 
 Definition NE_prop (_ : R) f :=
-  exists g : float beta, f = F2R g /\ canonic g /\ Zeven (Fnum g) = true.
+  exists g : float beta, f = F2R g /\ canonical g /\ Z.even (Fnum g) = true.
 
 Definition Rnd_NE_pt :=
   Rnd_NG_pt format NE_prop.
@@ -50,20 +45,20 @@ Definition DN_UP_parity_pos_prop :=
   forall x xd xu,
   (0 < x)%R ->
   ~ format x ->
-  canonic xd ->
-  canonic xu ->
+  canonical xd ->
+  canonical xu ->
   F2R xd = round beta fexp Zfloor x ->
   F2R xu = round beta fexp Zceil x ->
-  Zeven (Fnum xu) = negb (Zeven (Fnum xd)).
+  Z.even (Fnum xu) = negb (Z.even (Fnum xd)).
 
 Definition DN_UP_parity_prop :=
   forall x xd xu,
   ~ format x ->
-  canonic xd ->
-  canonic xu ->
+  canonical xd ->
+  canonical xu ->
   F2R xd = round beta fexp Zfloor x ->
   F2R xu = round beta fexp Zceil x ->
-  Zeven (Fnum xu) = negb (Zeven (Fnum xd)).
+  Z.even (Fnum xu) = negb (Z.even (Fnum xd)).
 
 Lemma DN_UP_parity_aux :
   DN_UP_parity_pos_prop ->
@@ -83,18 +78,18 @@ now rewrite Ropp_involutive, Ropp_0.
 destruct xd as (md, ed).
 destruct xu as (mu, eu).
 simpl.
-rewrite <- (Bool.negb_involutive (Zeven mu)).
+rewrite <- (Bool.negb_involutive (Z.even mu)).
 apply f_equal.
 apply sym_eq.
-rewrite <- (Zeven_opp mu), <- (Zeven_opp md).
-change (Zeven (Fnum (Float beta (-md) ed)) = negb (Zeven (Fnum (Float beta (-mu) eu)))).
+rewrite <- (Z.even_opp mu), <- (Z.even_opp md).
+change (Z.even (Fnum (Float beta (-md) ed)) = negb (Z.even (Fnum (Float beta (-mu) eu)))).
 apply (Hpos (-x)%R _ _ Hx').
 intros H.
 apply Hfx.
 rewrite <- Ropp_involutive.
 now apply generic_format_opp.
-now apply canonic_opp.
-now apply canonic_opp.
+now apply canonical_opp.
+now apply canonical_opp.
 rewrite round_DN_opp, F2R_Zopp.
 now apply f_equal.
 rewrite round_UP_opp, F2R_Zopp.
@@ -102,7 +97,7 @@ now apply f_equal.
 Qed.
 
 Class Exists_NE :=
-  exists_NE : Zeven beta = false \/ forall e,
+  exists_NE : Z.even beta = false \/ forall e,
   ((fexp e < e)%Z -> (fexp (e + 1) < e)%Z) /\ ((e <= fexp e)%Z -> fexp (fexp e + 1) = fexp e).
 
 Context { exists_NE_ : Exists_NE }.
@@ -111,22 +106,22 @@ Theorem DN_UP_parity_generic_pos :
   DN_UP_parity_pos_prop.
 Proof with auto with typeclass_instances.
 intros x xd xu H0x Hfx Hd Hu Hxd Hxu.
-destruct (ln_beta beta x) as (ex, Hexa).
+destruct (mag beta x) as (ex, Hexa).
 specialize (Hexa (Rgt_not_eq _ _ H0x)).
 generalize Hexa. intros Hex.
 rewrite (Rabs_pos_eq _ (Rlt_le _ _ H0x)) in Hex.
 destruct (Zle_or_lt ex (fexp ex)) as [Hxe|Hxe].
 (* small x *)
 assert (Hd3 : Fnum xd = Z0).
-apply F2R_eq_0_reg with beta (Fexp xd).
+apply eq_0_F2R with beta (Fexp xd).
 change (F2R xd = R0).
 rewrite Hxd.
 apply round_DN_small_pos with (1 := Hex) (2 := Hxe).
 assert (Hu3 : xu = Float beta (1 * Zpower beta (fexp ex - fexp (fexp ex + 1))) (fexp (fexp ex + 1))).
-apply canonic_unicity with (1 := Hu).
+apply canonical_unique with (1 := Hu).
 apply (f_equal fexp).
 rewrite <- F2R_change_exp.
-now rewrite F2R_bpow, ln_beta_bpow.
+now rewrite F2R_bpow, mag_bpow.
 now apply valid_exp.
 rewrite <- F2R_change_exp.
 rewrite F2R_bpow.
@@ -172,10 +167,10 @@ rewrite Hxu.
 apply round_bounded_large_pos...
 (* - xu = bpow ex *)
 assert (Hu3: xu = Float beta (1 * Zpower beta (ex - fexp (ex + 1))) (fexp (ex + 1))).
-apply canonic_unicity with (1 := Hu).
+apply canonical_unique with (1 := Hu).
 apply (f_equal fexp).
 rewrite <- F2R_change_exp.
-now rewrite F2R_bpow, ln_beta_bpow.
+now rewrite F2R_bpow, mag_bpow.
 now apply valid_exp.
 rewrite <- Hu2.
 apply sym_eq.
@@ -185,15 +180,15 @@ exact Hxe2.
 assert (Hd3: xd = Float beta (Zpower beta (ex - fexp ex) - 1) (fexp ex)).
 assert (H: F2R xd = F2R (Float beta (Zpower beta (ex - fexp ex) - 1) (fexp ex))).
 unfold F2R. simpl.
-rewrite Z2R_minus.
+rewrite minus_IZR.
 unfold Rminus.
 rewrite Rmult_plus_distr_r.
-rewrite Z2R_Zpower, <- bpow_plus.
+rewrite IZR_Zpower, <- bpow_plus.
 ring_simplify (ex - fexp ex + fexp ex)%Z.
 rewrite Hu2, Hud.
 rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq].
-unfold canonic_exp.
-rewrite ln_beta_unique with beta x ex.
+unfold cexp.
+rewrite mag_unique with beta x ex.
 unfold F2R.
 simpl. ring.
 rewrite Rabs_pos_eq.
@@ -201,25 +196,25 @@ exact Hex.
 now apply Rlt_le.
 apply Zle_minus_le_0.
 now apply Zlt_le_weak.
-apply canonic_unicity with (1 := Hd) (3 := H).
+apply canonical_unique with (1 := Hd) (3 := H).
 apply (f_equal fexp).
 rewrite <- H.
 apply sym_eq.
-now apply ln_beta_unique.
+now apply mag_unique.
 rewrite Hd3, Hu3.
 unfold Fnum.
-rewrite Zeven_mult. simpl.
+rewrite Z.even_mul. simpl.
 unfold Zminus at 2.
-rewrite Zeven_plus.
+rewrite Z.even_add.
 rewrite eqb_sym. simpl.
-fold (negb (Zeven (beta ^ (ex - fexp ex)))).
+fold (negb (Z.even (beta ^ (ex - fexp ex)))).
 rewrite Bool.negb_involutive.
-rewrite (Zeven_Zpower beta (ex - fexp ex)). 2: omega.
+rewrite (Z.even_pow beta (ex - fexp ex)). 2: omega.
 destruct exists_NE_.
 rewrite H.
 apply Zeven_Zpower_odd with (2 := H).
 now apply Zle_minus_le_0.
-apply Zeven_Zpower.
+apply Z.even_pow.
 specialize (H ex).
 omega.
 (* - xu < bpow ex *)
@@ -227,17 +222,17 @@ revert Hud.
 rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq].
 unfold F2R.
 rewrite Hd, Hu.
-unfold canonic_exp.
-rewrite ln_beta_unique with beta (F2R xu) ex.
-rewrite ln_beta_unique with (1 := Hd4).
-rewrite ln_beta_unique with (1 := Hexa).
+unfold cexp.
+rewrite mag_unique with beta (F2R xu) ex.
+rewrite mag_unique with (1 := Hd4).
+rewrite mag_unique with (1 := Hexa).
 intros H.
 replace (Fnum xu) with (Fnum xd + 1)%Z.
-rewrite Zeven_plus.
+rewrite Z.even_add.
 now apply eqb_sym.
 apply sym_eq.
-apply eq_Z2R.
-rewrite Z2R_plus.
+apply eq_IZR.
+rewrite plus_IZR.
 apply Rmult_eq_reg_r with (bpow (fexp ex)).
 rewrite H.
 simpl. ring.
@@ -270,38 +265,38 @@ now apply generic_format_satisfies_any.
 intros x d u Hf Hd Hu.
 generalize (proj1 Hd).
 unfold generic_format.
-set (ed := canonic_exp beta fexp d).
+set (ed := cexp beta fexp d).
 set (md := Ztrunc (scaled_mantissa beta fexp d)).
 intros Hd1.
-case_eq (Zeven md) ; [ intros He | intros Ho ].
+case_eq (Z.even md) ; [ intros He | intros Ho ].
 right.
 exists (Float beta md ed).
-unfold Fcore_generic_fmt.canonic.
+unfold Generic_fmt.canonical.
 rewrite <- Hd1.
 now repeat split.
 left.
 generalize (proj1 Hu).
 unfold generic_format.
-set (eu := canonic_exp beta fexp u).
+set (eu := cexp beta fexp u).
 set (mu := Ztrunc (scaled_mantissa beta fexp u)).
 intros Hu1.
 rewrite Hu1.
 eexists ; repeat split.
-unfold Fcore_generic_fmt.canonic.
+unfold Generic_fmt.canonical.
 now rewrite <- Hu1.
 rewrite (DN_UP_parity_generic x (Float beta md ed) (Float beta mu eu)).
 simpl.
 now rewrite Ho.
 exact Hf.
-unfold Fcore_generic_fmt.canonic.
+unfold Generic_fmt.canonical.
 now rewrite <- Hd1.
-unfold Fcore_generic_fmt.canonic.
+unfold Generic_fmt.canonical.
 now rewrite <- Hu1.
 rewrite <- Hd1.
-apply Rnd_DN_pt_unicity with (1 := Hd).
+apply Rnd_DN_pt_unique with (1 := Hd).
 now apply round_DN_pt.
 rewrite <- Hu1.
-apply Rnd_UP_pt_unicity with (1 := Hu).
+apply Rnd_UP_pt_unique with (1 := Hu).
 now apply round_UP_pt.
 Qed.
 
@@ -323,15 +318,16 @@ apply Hx.
 apply sym_eq.
 now apply Rnd_DN_pt_idempotent with (1 := Hd).
 rewrite <- Hd1.
-apply Rnd_DN_pt_unicity with (1 := Hd).
+apply Rnd_DN_pt_unique with (1 := Hd).
 now apply round_DN_pt.
 rewrite <- Hu1.
-apply Rnd_UP_pt_unicity with (1 := Hu).
+apply Rnd_UP_pt_unique with (1 := Hu).
 now apply round_UP_pt.
 Qed.
 
 Theorem Rnd_NE_pt_round :
   round_pred Rnd_NE_pt.
+Proof.
 split.
 apply Rnd_NE_pt_total.
 apply Rnd_NE_pt_monotone.
@@ -348,14 +344,14 @@ now apply round_N_pt.
 unfold NE_prop.
 set (mx := scaled_mantissa beta fexp x).
 set (xr := round beta fexp ZnearestE x).
-destruct (Req_dec (mx - Z2R (Zfloor mx)) (/2)) as [Hm|Hm].
+destruct (Req_dec (mx - IZR (Zfloor mx)) (/2)) as [Hm|Hm].
 (* midpoint *)
 left.
-exists (Float beta (Ztrunc (scaled_mantissa beta fexp xr)) (canonic_exp beta fexp xr)).
+exists (Float beta (Ztrunc (scaled_mantissa beta fexp xr)) (cexp beta fexp xr)).
 split.
 apply round_N_pt...
 split.
-unfold Fcore_generic_fmt.canonic. simpl.
+unfold Generic_fmt.canonical. simpl.
 apply f_equal.
 apply round_N_pt...
 simpl.
@@ -363,23 +359,22 @@ unfold xr, round, Znearest.
 fold mx.
 rewrite Hm.
 rewrite Rcompare_Eq. 2: apply refl_equal.
-case_eq (Zeven (Zfloor mx)) ; intros Hmx.
+case_eq (Z.even (Zfloor mx)) ; intros Hmx.
 (* . even floor *)
-change (Zeven (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zfloor x))) = true).
+change (Z.even (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zfloor x))) = true).
 destruct (Rle_or_lt (round beta fexp Zfloor x) 0) as [Hr|Hr].
 rewrite (Rle_antisym _ _ Hr).
 unfold scaled_mantissa.
 rewrite Rmult_0_l.
-change 0%R with (Z2R 0).
-now rewrite (Ztrunc_Z2R 0).
+now rewrite Ztrunc_IZR.
 rewrite <- (round_0 beta fexp Zfloor).
 apply round_le...
 now apply Rlt_le.
 rewrite scaled_mantissa_DN...
-now rewrite Ztrunc_Z2R.
+now rewrite Ztrunc_IZR.
 (* . odd floor *)
-change (Zeven (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zceil x))) = true).
-destruct (ln_beta beta x) as (ex, Hex).
+change (Z.even (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zceil x))) = true).
+destruct (mag beta x) as (ex, Hex).
 specialize (Hex (Rgt_not_eq _ _ Hx)).
 rewrite (Rabs_pos_eq _ (Rlt_le _ _ Hx)) in Hex.
 destruct (Z_lt_le_dec (fexp ex) ex) as [He|He].
@@ -394,56 +389,56 @@ rewrite Rplus_opp_r in Hm.
 elim (Rlt_irrefl 0).
 rewrite Hm at 2.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 destruct (proj2 Hu) as [Hu'|Hu'].
 (* ... u <> bpow *)
 unfold scaled_mantissa.
-rewrite canonic_exp_fexp_pos with (1 := conj (proj1 Hu) Hu').
+rewrite cexp_fexp_pos with (1 := conj (proj1 Hu) Hu').
 unfold round, F2R. simpl.
-rewrite canonic_exp_fexp_pos with (1 := Hex).
+rewrite cexp_fexp_pos with (1 := Hex).
 rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
-rewrite Ztrunc_Z2R.
+rewrite Ztrunc_IZR.
 fold mx.
 rewrite Hfc.
-now rewrite Zeven_plus, Hmx.
+now rewrite Z.even_add, Hmx.
 (* ... u = bpow *)
 rewrite Hu'.
-unfold scaled_mantissa, canonic_exp.
-rewrite ln_beta_bpow.
-rewrite <- bpow_plus, <- Z2R_Zpower.
-rewrite Ztrunc_Z2R.
-case_eq (Zeven beta) ; intros Hr.
+unfold scaled_mantissa, cexp.
+rewrite mag_bpow.
+rewrite <- bpow_plus, <- IZR_Zpower.
+rewrite Ztrunc_IZR.
+case_eq (Z.even beta) ; intros Hr.
 destruct exists_NE_ as [Hs|Hs].
 now rewrite Hs in Hr.
 destruct (Hs ex) as (H,_).
-rewrite Zeven_Zpower.
+rewrite Z.even_pow.
 exact Hr.
 omega.
-assert (Zeven (Zfloor mx) = true). 2: now rewrite H in Hmx.
+assert (Z.even (Zfloor mx) = true). 2: now rewrite H in Hmx.
 replace (Zfloor mx) with (Zceil mx + -1)%Z by omega.
-rewrite Zeven_plus.
+rewrite Z.even_add.
 apply eqb_true.
 unfold mx.
 replace (Zceil (scaled_mantissa beta fexp x)) with (Zpower beta (ex - fexp ex)).
 rewrite Zeven_Zpower_odd with (2 := Hr).
 easy.
 omega.
-apply eq_Z2R.
-rewrite Z2R_Zpower. 2: omega.
+apply eq_IZR.
+rewrite IZR_Zpower. 2: omega.
 apply Rmult_eq_reg_r with (bpow (fexp ex)).
 unfold Zminus.
 rewrite bpow_plus.
 rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_l, Rmult_1_r.
-pattern (fexp ex) ; rewrite <- canonic_exp_fexp_pos with (1 := Hex).
+pattern (fexp ex) ; rewrite <- cexp_fexp_pos with (1 := Hex).
 now apply sym_eq.
 apply Rgt_not_eq.
 apply bpow_gt_0.
 generalize (proj1 (valid_exp ex) He).
 omega.
 (* .. small pos *)
-assert (Zeven (Zfloor mx) = true). 2: now rewrite H in Hmx.
+assert (Z.even (Zfloor mx) = true). 2: now rewrite H in Hmx.
 unfold mx, scaled_mantissa.
-rewrite canonic_exp_fexp_pos with (1 := Hex).
+rewrite cexp_fexp_pos with (1 := Hex).
 now rewrite mantissa_DN_small_pos.
 (* not midpoint *)
 right.
@@ -456,7 +451,7 @@ rewrite Hxg.
 apply Hg.
 set (d := round beta fexp Zfloor x).
 set (u := round beta fexp Zceil x).
-apply Rnd_N_pt_unicity with (d := d) (u := u) (4 := Hg).
+apply Rnd_N_pt_unique with (d := d) (u := u) (4 := Hg).
 now apply round_DN_pt.
 now apply round_UP_pt.
 2: now apply round_N_pt.
@@ -467,7 +462,7 @@ intros H.
 apply Rmult_eq_reg_r in H.
 apply Hm.
 apply Rcompare_Eq_inv.
-rewrite Rcompare_floor_ceil_mid.
+rewrite Rcompare_floor_ceil_middle.
 now apply Rcompare_Eq.
 contradict Hxg.
 apply sym_eq.
@@ -475,7 +470,7 @@ apply Rnd_N_pt_idempotent with (1 := Hg).
 rewrite <- (scaled_mantissa_mult_bpow beta fexp x).
 fold mx.
 rewrite <- Hxg.
-change (Z2R (Zfloor mx) * bpow (canonic_exp beta fexp x))%R with d.
+change (IZR (Zfloor mx) * bpow (cexp beta fexp x))%R with d.
 now eapply round_DN_pt.
 apply Rgt_not_eq.
 apply bpow_gt_0.
@@ -487,7 +482,7 @@ Theorem round_NE_opp :
 Proof.
 intros x.
 unfold round. simpl.
-rewrite scaled_mantissa_opp, canonic_exp_opp.
+rewrite scaled_mantissa_opp, cexp_opp.
 rewrite Znearest_opp.
 rewrite <- F2R_Zopp.
 apply (f_equal (fun v => F2R (Float beta (-v) _))).
@@ -496,8 +491,8 @@ unfold Znearest.
 case Rcompare ; trivial.
 apply (f_equal (fun (b : bool) => if b then Zceil m else Zfloor m)).
 rewrite Bool.negb_involutive.
-rewrite Zeven_opp.
-rewrite Zeven_plus.
+rewrite Z.even_opp.
+rewrite Z.even_add.
 now rewrite eqb_sym.
 Qed.
 
@@ -526,7 +521,7 @@ Theorem round_NE_pt :
 Proof with auto with typeclass_instances.
 intros x.
 destruct (total_order_T x 0) as [[Hx|Hx]|Hx].
-apply Rnd_NG_pt_sym.
+apply Rnd_NG_pt_opp_inv.
 apply generic_format_opp.
 unfold NE_prop.
 intros _ f ((mg,eg),(H1,(H2,H3))).
@@ -534,9 +529,9 @@ exists (Float beta (- mg) eg).
 repeat split.
 rewrite H1.
 now rewrite F2R_Zopp.
-now apply canonic_opp.
+now apply canonical_opp.
 simpl.
-now rewrite Zeven_opp.
+now rewrite Z.even_opp.
 rewrite <- round_NE_opp.
 apply round_NE_pt_pos.
 now apply Ropp_0_gt_lt_contravar.
diff --git a/flocq/Core/Fcore_rnd.v b/flocq/Core/Round_pred.v
index e5091684..428a4bac 100644
--- a/flocq/Core/Fcore_rnd.v
+++ b/flocq/Core/Round_pred.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,13 +18,30 @@ COPYING file for more details.
 *)
 
 (** * Roundings: properties and/or functions *)
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
+Require Import Raux Defs.
 
 Section RND_prop.
 
 Open Scope R_scope.
 
+Definition Rnd_DN (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_DN_pt F x (rnd x).
+
+Definition Rnd_UP (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_UP_pt F x (rnd x).
+
+Definition Rnd_ZR (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_ZR_pt F x (rnd x).
+
+Definition Rnd_N (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_N_pt F x (rnd x).
+
+Definition Rnd_NG (F : R -> Prop) (P : R -> R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_NG_pt F P x (rnd x).
+
+Definition Rnd_NA (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_NA_pt F x (rnd x).
+
 Theorem round_val_of_pred :
   forall rnd : R -> R -> Prop,
   round_pred rnd ->
@@ -63,7 +80,7 @@ intros x.
 now destruct round_val_of_pred as (f, H1).
 Qed.
 
-Theorem round_unicity :
+Theorem round_unique :
   forall rnd : R -> R -> Prop,
   round_pred_monotone rnd ->
   forall x f1 f2,
@@ -87,25 +104,25 @@ apply Hx1.
 now apply Rle_trans with (2 := Hxy).
 Qed.
 
-Theorem Rnd_DN_pt_unicity :
+Theorem Rnd_DN_pt_unique :
   forall F : R -> Prop,
   forall x f1 f2 : R,
   Rnd_DN_pt F x f1 -> Rnd_DN_pt F x f2 ->
   f1 = f2.
 Proof.
 intros F.
-apply round_unicity.
+apply round_unique.
 apply Rnd_DN_pt_monotone.
 Qed.
 
-Theorem Rnd_DN_unicity :
+Theorem Rnd_DN_unique :
   forall F : R -> Prop,
   forall rnd1 rnd2 : R -> R,
   Rnd_DN F rnd1 -> Rnd_DN F rnd2 ->
   forall x, rnd1 x = rnd2 x.
 Proof.
 intros F rnd1 rnd2 H1 H2 x.
-now eapply Rnd_DN_pt_unicity.
+now eapply Rnd_DN_pt_unique.
 Qed.
 
 Theorem Rnd_UP_pt_monotone :
@@ -118,28 +135,28 @@ apply Hy1.
 now apply Rle_trans with (1 := Hxy).
 Qed.
 
-Theorem Rnd_UP_pt_unicity :
+Theorem Rnd_UP_pt_unique :
   forall F : R -> Prop,
   forall x f1 f2 : R,
   Rnd_UP_pt F x f1 -> Rnd_UP_pt F x f2 ->
   f1 = f2.
 Proof.
 intros F.
-apply round_unicity.
+apply round_unique.
 apply Rnd_UP_pt_monotone.
 Qed.
 
-Theorem Rnd_UP_unicity :
+Theorem Rnd_UP_unique :
   forall F : R -> Prop,
   forall rnd1 rnd2 : R -> R,
   Rnd_UP F rnd1 -> Rnd_UP F rnd2 ->
   forall x, rnd1 x = rnd2 x.
 Proof.
 intros F rnd1 rnd2 H1 H2 x.
-now eapply Rnd_UP_pt_unicity.
+now eapply Rnd_UP_pt_unique.
 Qed.
 
-Theorem Rnd_DN_UP_pt_sym :
+Theorem Rnd_UP_pt_opp :
   forall F : R -> Prop,
   ( forall x, F x -> F (- x) ) ->
   forall x f : R,
@@ -160,7 +177,7 @@ now apply HF.
 now apply Ropp_le_cancel.
 Qed.
 
-Theorem Rnd_UP_DN_pt_sym :
+Theorem Rnd_DN_pt_opp :
   forall F : R -> Prop,
   ( forall x, F x -> F (- x) ) ->
   forall x f : R,
@@ -181,7 +198,7 @@ now apply HF.
 now apply Ropp_le_cancel.
 Qed.
 
-Theorem Rnd_DN_UP_sym :
+Theorem Rnd_DN_opp :
   forall F : R -> Prop,
   ( forall x, F x -> F (- x) ) ->
   forall rnd1 rnd2 : R -> R,
@@ -191,10 +208,10 @@ Proof.
 intros F HF rnd1 rnd2 H1 H2 x.
 rewrite <- (Ropp_involutive (rnd1 (-x))).
 apply f_equal.
-apply (Rnd_UP_unicity F (fun x => - rnd1 (-x))) ; trivial.
+apply (Rnd_UP_unique F (fun x => - rnd1 (-x))) ; trivial.
 intros y.
 pattern y at 1 ; rewrite <- Ropp_involutive.
-apply Rnd_DN_UP_pt_sym.
+apply Rnd_UP_pt_opp.
 apply HF.
 apply H1.
 Qed.
@@ -303,18 +320,17 @@ apply Rle_refl.
 (* . *)
 destruct (Rle_or_lt 0 x).
 (* positive *)
-rewrite Rabs_right.
-rewrite Rabs_right; auto with real.
+rewrite Rabs_pos_eq with (1 := H1).
+rewrite Rabs_pos_eq.
 now apply (proj1 (H x)).
-apply Rle_ge.
 now apply (proj1 (H x)).
 (* negative *)
+apply Rlt_le in H1.
+rewrite Rabs_left1 with (1 := H1).
 rewrite Rabs_left1.
-rewrite Rabs_left1 ; auto with real.
 apply Ropp_le_contravar.
-apply (proj2 (H x)).
-auto with real.
-apply (proj2 (H x)) ; auto with real.
+now apply (proj2 (H x)).
+now apply (proj2 (H x)).
 Qed.
 
 Theorem Rnd_ZR_pt_monotone :
@@ -385,12 +401,12 @@ Proof.
 intros F x fd fu f Hd Hu Hf.
 destruct (Rnd_N_pt_DN_or_UP F x f Hf) as [H|H].
 left.
-apply Rnd_DN_pt_unicity with (1 := H) (2 := Hd).
+apply Rnd_DN_pt_unique with (1 := H) (2 := Hd).
 right.
-apply Rnd_UP_pt_unicity with (1 := H) (2 := Hu).
+apply Rnd_UP_pt_unique with (1 := H) (2 := Hu).
 Qed.
 
-Theorem Rnd_N_pt_sym :
+Theorem Rnd_N_pt_opp_inv :
   forall F : R -> Prop,
   ( forall x, F x -> F (- x) ) ->
   forall x f : R,
@@ -449,7 +465,7 @@ apply Rminus_lt.
 ring_simplify.
 apply Rlt_minus.
 apply Rmult_lt_compat_l.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 exact Hxy.
 now apply Rlt_minus.
 apply Rle_0_minus.
@@ -460,7 +476,7 @@ now apply Rlt_le.
 now apply Rlt_minus.
 Qed.
 
-Theorem Rnd_N_pt_unicity :
+Theorem Rnd_N_pt_unique :
   forall F : R -> Prop,
   forall x d u f1 f2 : R,
   Rnd_DN_pt F x d ->
@@ -476,10 +492,10 @@ clear f1 f2. intros f1 f2 Hf1 Hf2 H12.
 destruct (Rnd_N_pt_DN_or_UP F x f1 Hf1) as [Hd1|Hu1] ;
   destruct (Rnd_N_pt_DN_or_UP F x f2 Hf2) as [Hd2|Hu2].
 apply Rlt_not_eq with (1 := H12).
-now apply Rnd_DN_pt_unicity with (1 := Hd1).
+now apply Rnd_DN_pt_unique with (1 := Hd1).
 apply Hdu.
-rewrite Rnd_DN_pt_unicity with (1 := Hd) (2 := Hd1).
-rewrite Rnd_UP_pt_unicity with (1 := Hu) (2 := Hu2).
+rewrite Rnd_DN_pt_unique with (1 := Hd) (2 := Hd1).
+rewrite Rnd_UP_pt_unique with (1 := Hu) (2 := Hu2).
 rewrite <- (Rabs_pos_eq (x - f1)).
 rewrite <- (Rabs_pos_eq (f2 - x)).
 rewrite Rabs_minus_sym.
@@ -495,7 +511,7 @@ apply Rle_trans with x.
 apply Hd2.
 apply Hu1.
 apply Rgt_not_eq with (1 := H12).
-now apply Rnd_UP_pt_unicity with (1 := Hu2).
+now apply Rnd_UP_pt_unique with (1 := Hu2).
 intros Hf1 Hf2.
 now apply Rle_antisym ; apply Rnot_lt_le ; refine (H _ _ _ _).
 Qed.
@@ -547,7 +563,7 @@ rewrite 2!Rminus_0_r, Rabs_R0.
 apply Rabs_pos.
 Qed.
 
-Theorem Rnd_N_pt_pos :
+Theorem Rnd_N_pt_ge_0 :
   forall F : R -> Prop, F 0 ->
   forall x f, 0 <= x ->
   Rnd_N_pt F x f ->
@@ -563,7 +579,7 @@ now rewrite Hx.
 exact HF.
 Qed.
 
-Theorem Rnd_N_pt_neg :
+Theorem Rnd_N_pt_le_0 :
   forall F : R -> Prop, F 0 ->
   forall x f, x <= 0 ->
   Rnd_N_pt F x f ->
@@ -589,20 +605,20 @@ intros F HF0 HF x f Hxf.
 unfold Rabs at 1.
 destruct (Rcase_abs x) as [Hx|Hx].
 rewrite Rabs_left1.
-apply Rnd_N_pt_sym.
+apply Rnd_N_pt_opp_inv.
 exact HF.
 now rewrite 2!Ropp_involutive.
-apply Rnd_N_pt_neg with (3 := Hxf).
+apply Rnd_N_pt_le_0 with (3 := Hxf).
 exact HF0.
 now apply Rlt_le.
 rewrite Rabs_pos_eq.
 exact Hxf.
-apply Rnd_N_pt_pos with (3 := Hxf).
+apply Rnd_N_pt_ge_0 with (3 := Hxf).
 exact HF0.
 now apply Rge_le.
 Qed.
 
-Theorem Rnd_DN_UP_pt_N :
+Theorem Rnd_N_pt_DN_UP :
   forall F : R -> Prop,
   forall x d u f : R,
   F f ->
@@ -635,7 +651,7 @@ apply Rle_trans with (2 := Hgu).
 apply Hxu.
 Qed.
 
-Theorem Rnd_DN_pt_N :
+Theorem Rnd_N_pt_DN :
   forall F : R -> Prop,
   forall x d u : R,
   Rnd_DN_pt F x d ->
@@ -649,14 +665,14 @@ rewrite Rabs_minus_sym.
 apply Rabs_pos_eq.
 apply Rle_0_minus.
 apply Hd.
-apply Rnd_DN_UP_pt_N with (2 := Hd) (3 := Hu).
+apply Rnd_N_pt_DN_UP with (2 := Hd) (3 := Hu).
 apply Hd.
 rewrite Hdx.
 apply Rle_refl.
 now rewrite Hdx.
 Qed.
 
-Theorem Rnd_UP_pt_N :
+Theorem Rnd_N_pt_UP :
   forall F : R -> Prop,
   forall x d u : R,
   Rnd_DN_pt F x d ->
@@ -669,22 +685,22 @@ assert (Hux: (Rabs (u - x) = u - x)%R).
 apply Rabs_pos_eq.
 apply Rle_0_minus.
 apply Hu.
-apply Rnd_DN_UP_pt_N with (2 := Hd) (3 := Hu).
+apply Rnd_N_pt_DN_UP with (2 := Hd) (3 := Hu).
 apply Hu.
 now rewrite Hux.
 rewrite Hux.
 apply Rle_refl.
 Qed.
 
-Definition Rnd_NG_pt_unicity_prop F P :=
+Definition Rnd_NG_pt_unique_prop F P :=
   forall x d u,
   Rnd_DN_pt F x d -> Rnd_N_pt F x d ->
   Rnd_UP_pt F x u -> Rnd_N_pt F x u ->
   P x d -> P x u -> d = u.
 
-Theorem Rnd_NG_pt_unicity :
+Theorem Rnd_NG_pt_unique :
   forall (F : R -> Prop) (P : R -> R -> Prop),
-  Rnd_NG_pt_unicity_prop F P ->
+  Rnd_NG_pt_unique_prop F P ->
   forall x f1 f2 : R,
   Rnd_NG_pt F P x f1 -> Rnd_NG_pt F P x f2 ->
   f1 = f2.
@@ -694,11 +710,11 @@ destruct H1b as [H1b|H1b].
 destruct H2b as [H2b|H2b].
 destruct (Rnd_N_pt_DN_or_UP _ _ _ H1a) as [H1c|H1c] ;
   destruct (Rnd_N_pt_DN_or_UP _ _ _ H2a) as [H2c|H2c].
-eapply Rnd_DN_pt_unicity ; eassumption.
+eapply Rnd_DN_pt_unique ; eassumption.
 now apply (HP x f1 f2).
 apply sym_eq.
 now apply (HP x f2 f1 H2c H2a H1c H1a).
-eapply Rnd_UP_pt_unicity ; eassumption.
+eapply Rnd_UP_pt_unique ; eassumption.
 now apply H2b.
 apply sym_eq.
 now apply H1b.
@@ -706,14 +722,14 @@ Qed.
 
 Theorem Rnd_NG_pt_monotone :
   forall (F : R -> Prop) (P : R -> R -> Prop),
-  Rnd_NG_pt_unicity_prop F P ->
+  Rnd_NG_pt_unique_prop F P ->
   round_pred_monotone (Rnd_NG_pt F P).
 Proof.
 intros F P HP x y f g (Hf,Hx) (Hg,Hy) [Hxy|Hxy].
 now apply Rnd_N_pt_monotone with F x y.
 apply Req_le.
 rewrite <- Hxy in Hg, Hy.
-eapply Rnd_NG_pt_unicity ; try split ; eassumption.
+eapply Rnd_NG_pt_unique ; try split ; eassumption.
 Qed.
 
 Theorem Rnd_NG_pt_refl :
@@ -728,7 +744,7 @@ intros f2 Hf2.
 now apply Rnd_N_pt_idempotent with F.
 Qed.
 
-Theorem Rnd_NG_pt_sym :
+Theorem Rnd_NG_pt_opp_inv :
   forall (F : R -> Prop) (P : R -> R -> Prop),
   ( forall x, F x -> F (-x) ) ->
   ( forall x f, P x f -> P (-x) (-f) ) ->
@@ -737,7 +753,7 @@ Theorem Rnd_NG_pt_sym :
 Proof.
 intros F P HF HP x f (H1,H2).
 split.
-now apply Rnd_N_pt_sym.
+now apply Rnd_N_pt_opp_inv.
 destruct H2 as [H2|H2].
 left.
 rewrite <- (Ropp_involutive x), <- (Ropp_involutive f).
@@ -748,20 +764,20 @@ rewrite <- (Ropp_involutive f).
 rewrite <- H2 with (-f2).
 apply sym_eq.
 apply Ropp_involutive.
-apply Rnd_N_pt_sym.
+apply Rnd_N_pt_opp_inv.
 exact HF.
 now rewrite 2!Ropp_involutive.
 Qed.
 
-Theorem Rnd_NG_unicity :
+Theorem Rnd_NG_unique :
   forall (F : R -> Prop) (P : R -> R -> Prop),
-  Rnd_NG_pt_unicity_prop F P ->
+  Rnd_NG_pt_unique_prop F P ->
   forall rnd1 rnd2 : R -> R,
   Rnd_NG F P rnd1 -> Rnd_NG F P rnd2 ->
   forall x, rnd1 x = rnd2 x.
 Proof.
 intros F P HP rnd1 rnd2 H1 H2 x.
-now apply Rnd_NG_pt_unicity with F P x.
+now apply Rnd_NG_pt_unique with F P x.
 Qed.
 
 Theorem Rnd_NA_NG_pt :
@@ -775,7 +791,7 @@ destruct (Rle_or_lt 0 x) as [Hx|Hx].
 (* *)
 split ; intros (H1, H2).
 (* . *)
-assert (Hf := Rnd_N_pt_pos F HF x f Hx H1).
+assert (Hf := Rnd_N_pt_ge_0 F HF x f Hx H1).
 split.
 exact H1.
 destruct (Rnd_N_pt_DN_or_UP _ _ _ H1) as [H3|H3].
@@ -784,12 +800,12 @@ right.
 intros f2 Hxf2.
 specialize (H2 _ Hxf2).
 destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H4|H4].
-eapply Rnd_DN_pt_unicity ; eassumption.
+eapply Rnd_DN_pt_unique ; eassumption.
 apply Rle_antisym.
 rewrite Rabs_pos_eq with (1 := Hf) in H2.
 rewrite Rabs_pos_eq in H2.
 exact H2.
-now apply Rnd_N_pt_pos with F x.
+now apply Rnd_N_pt_ge_0 with F x.
 apply Rle_trans with x.
 apply H3.
 apply H4.
@@ -803,8 +819,8 @@ split.
 exact H1.
 intros f2 Hxf2.
 destruct H2 as [H2|H2].
-assert (Hf := Rnd_N_pt_pos F HF x f Hx H1).
-assert (Hf2 := Rnd_N_pt_pos F HF x f2 Hx Hxf2).
+assert (Hf := Rnd_N_pt_ge_0 F HF x f Hx H1).
+assert (Hf2 := Rnd_N_pt_ge_0 F HF x f2 Hx Hxf2).
 rewrite 2!Rabs_pos_eq ; trivial.
 rewrite 2!Rabs_pos_eq in H2 ; trivial.
 destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H3|H3].
@@ -820,7 +836,7 @@ assert (Hx' := Rlt_le _ _ Hx).
 clear Hx. rename Hx' into Hx.
 split ; intros (H1, H2).
 (* . *)
-assert (Hf := Rnd_N_pt_neg F HF x f Hx H1).
+assert (Hf := Rnd_N_pt_le_0 F HF x f Hx H1).
 split.
 exact H1.
 destruct (Rnd_N_pt_DN_or_UP _ _ _ H1) as [H3|H3].
@@ -842,15 +858,15 @@ apply H3.
 rewrite Rabs_left1 with (1 := Hf) in H2.
 rewrite Rabs_left1 in H2.
 now apply Ropp_le_cancel.
-now apply Rnd_N_pt_neg with F x.
-eapply Rnd_UP_pt_unicity ; eassumption.
+now apply Rnd_N_pt_le_0 with F x.
+eapply Rnd_UP_pt_unique ; eassumption.
 (* . *)
 split.
 exact H1.
 intros f2 Hxf2.
 destruct H2 as [H2|H2].
-assert (Hf := Rnd_N_pt_neg F HF x f Hx H1).
-assert (Hf2 := Rnd_N_pt_neg F HF x f2 Hx Hxf2).
+assert (Hf := Rnd_N_pt_le_0 F HF x f Hx H1).
+assert (Hf2 := Rnd_N_pt_le_0 F HF x f2 Hx Hxf2).
 rewrite 2!Rabs_left1 ; trivial.
 rewrite 2!Rabs_left1 in H2 ; trivial.
 apply Ropp_le_contravar.
@@ -865,10 +881,10 @@ rewrite (H2 _ Hxf2).
 apply Rle_refl.
 Qed.
 
-Theorem Rnd_NA_pt_unicity_prop :
+Lemma Rnd_NA_pt_unique_prop :
   forall F : R -> Prop,
   F 0 ->
-  Rnd_NG_pt_unicity_prop F (fun a b => (Rabs a <= Rabs b)%R).
+  Rnd_NG_pt_unique_prop F (fun a b => (Rabs a <= Rabs b)%R).
 Proof.
 intros F HF x d u Hxd1 Hxd2 Hxu1 Hxu2 Hd Hu.
 apply Rle_antisym.
@@ -892,7 +908,7 @@ apply HF.
 now apply Rlt_le.
 Qed.
 
-Theorem Rnd_NA_pt_unicity :
+Theorem Rnd_NA_pt_unique :
   forall F : R -> Prop,
   F 0 ->
   forall x f1 f2 : R,
@@ -900,12 +916,12 @@ Theorem Rnd_NA_pt_unicity :
   f1 = f2.
 Proof.
 intros F HF x f1 f2 H1 H2.
-apply (Rnd_NG_pt_unicity F _ (Rnd_NA_pt_unicity_prop F HF) x).
+apply (Rnd_NG_pt_unique F _ (Rnd_NA_pt_unique_prop F HF) x).
 now apply -> Rnd_NA_NG_pt.
 now apply -> Rnd_NA_NG_pt.
 Qed.
 
-Theorem Rnd_NA_N_pt :
+Theorem Rnd_NA_pt_N :
   forall F : R -> Prop,
   F 0 ->
   forall x f : R,
@@ -936,29 +952,29 @@ destruct (Rle_lt_dec 0 x) as [Hx|Hx].
 (* . *)
 revert Hxf.
 rewrite Rabs_pos_eq with (1 := Hx).
-rewrite 2!Rabs_pos_eq ; try ( apply (Rnd_N_pt_pos F HF x) ; assumption ).
+rewrite 2!Rabs_pos_eq ; try ( apply (Rnd_N_pt_ge_0 F HF x) ; assumption ).
 intros Hxf.
 rewrite H0.
 apply Rplus_le_reg_r with f.
 ring_simplify.
 apply Rmult_le_compat_l with (2 := Hxf).
-now apply (Z2R_le 0 2).
+now apply IZR_le.
 (* . *)
 revert Hxf.
 apply Rlt_le in Hx.
 rewrite Rabs_left1 with (1 := Hx).
-rewrite 2!Rabs_left1 ; try ( apply (Rnd_N_pt_neg F HF x) ; assumption ).
+rewrite 2!Rabs_left1 ; try ( apply (Rnd_N_pt_le_0 F HF x) ; assumption ).
 intros Hxf.
 rewrite H0.
 apply Ropp_le_contravar.
 apply Rplus_le_reg_r with f.
 ring_simplify.
 apply Rmult_le_compat_l.
-now apply (Z2R_le 0 2).
+now apply IZR_le.
 now apply Ropp_le_cancel.
 Qed.
 
-Theorem Rnd_NA_unicity :
+Theorem Rnd_NA_unique :
   forall (F : R -> Prop),
   F 0 ->
   forall rnd1 rnd2 : R -> R,
@@ -966,7 +982,7 @@ Theorem Rnd_NA_unicity :
   forall x, rnd1 x = rnd2 x.
 Proof.
 intros F HF rnd1 rnd2 H1 H2 x.
-now apply Rnd_NA_pt_unicity with F x.
+now apply Rnd_NA_pt_unique with F x.
 Qed.
 
 Theorem Rnd_NA_pt_monotone :
@@ -975,7 +991,7 @@ Theorem Rnd_NA_pt_monotone :
   round_pred_monotone (Rnd_NA_pt F).
 Proof.
 intros F HF x y f g Hxf Hyg Hxy.
-apply (Rnd_NG_pt_monotone F _ (Rnd_NA_pt_unicity_prop F HF) x y).
+apply (Rnd_NG_pt_monotone F _ (Rnd_NA_pt_unique_prop F HF) x y).
 now apply -> Rnd_NA_NG_pt.
 now apply -> Rnd_NA_NG_pt.
 exact Hxy.
@@ -1165,7 +1181,7 @@ intros x.
 destruct (proj1 (satisfies_any_imp_DN F Hany) (-x)) as (f, Hf).
 exists (-f).
 rewrite <- (Ropp_involutive x).
-apply Rnd_DN_UP_pt_sym.
+apply Rnd_UP_pt_opp.
 apply Hany.
 exact Hf.
 apply Rnd_UP_pt_monotone.
diff --git a/flocq/Core/Fcore_ulp.v b/flocq/Core/Ulp.v
index 4fdd319e..4f4a5674 100644
--- a/flocq/Core/Fcore_ulp.v
+++ b/flocq/Core/Ulp.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2009-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2009-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -19,11 +19,7 @@ COPYING file for more details.
 
 (** * Unit in the Last Place: our definition using fexp and its properties, successor and predecessor *)
 Require Import Reals Psatz.
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_rnd.
-Require Import Fcore_generic_fmt.
-Require Import Fcore_float_prop.
+Require Import Raux Defs Round_pred Generic_fmt Float_prop.
 
 Section Fcore_ulp.
 
@@ -97,10 +93,12 @@ Definition ulp x := match Req_bool x 0 with
             | Some n => bpow (fexp n)
             | None => 0%R
             end
-  | false  => bpow (canonic_exp beta fexp x)
+  | false  => bpow (cexp beta fexp x)
  end.
 
-Lemma ulp_neq_0 : forall x:R, (x <> 0)%R -> ulp x = bpow (canonic_exp beta fexp x).
+Lemma ulp_neq_0 :
+  forall x, x <> 0%R ->
+  ulp x = bpow (cexp beta fexp x).
 Proof.
 intros  x Hx.
 unfold ulp; case (Req_bool_spec x); trivial.
@@ -118,7 +116,7 @@ case Req_bool_spec; intros H1.
 rewrite Req_bool_true; trivial.
 rewrite <- (Ropp_involutive x), H1; ring.
 rewrite Req_bool_false.
-now rewrite canonic_exp_opp.
+now rewrite cexp_opp.
 intros H2; apply H1; rewrite H2; ring.
 Qed.
 
@@ -130,7 +128,7 @@ unfold ulp; case (Req_bool_spec x 0); intros H1.
 rewrite Req_bool_true; trivial.
 now rewrite H1, Rabs_R0.
 rewrite Req_bool_false.
-now rewrite canonic_exp_abs.
+now rewrite cexp_abs.
 now apply Rabs_no_R0.
 Qed.
 
@@ -159,9 +157,8 @@ rewrite ulp_neq_0.
 unfold F2R; simpl.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-apply (Z2R_le (Zsucc 0)).
-apply Zlt_le_succ.
-apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+apply IZR_le, (Zlt_le_succ 0).
+apply gt_0_F2R with beta (cexp beta fexp x).
 now rewrite <- Fx.
 Qed.
 
@@ -178,8 +175,6 @@ now apply Rabs_pos_lt.
 now apply generic_format_abs.
 Qed.
 
-
-(* was ulp_DN_UP *)
 Theorem round_UP_DN_ulp :
   forall x, ~ F x ->
   round beta fexp Zceil x = (round beta fexp Zfloor x + ulp x)%R.
@@ -189,13 +184,13 @@ rewrite ulp_neq_0.
 unfold round. simpl.
 unfold F2R. simpl.
 rewrite Zceil_floor_neq.
-rewrite Z2R_plus. simpl.
+rewrite plus_IZR. simpl.
 ring.
 intros H.
 apply Fx.
 unfold generic_format, F2R. simpl.
 rewrite <- H.
-rewrite Ztrunc_Z2R.
+rewrite Ztrunc_IZR.
 rewrite H.
 now rewrite scaled_mantissa_mult_bpow.
 intros V; apply Fx.
@@ -210,7 +205,7 @@ Proof.
 intros e.
 rewrite ulp_neq_0.
 apply f_equal.
-apply canonic_exp_fexp.
+apply cexp_fexp.
 rewrite Rabs_pos_eq.
 split.
 ring_simplify (e + 1 - 1)%Z.
@@ -222,7 +217,7 @@ apply Rgt_not_eq, Rlt_gt, bpow_gt_0.
 Qed.
 
 
-Lemma generic_format_ulp_0:
+Lemma generic_format_ulp_0 :
   F (ulp 0).
 Proof.
 unfold ulp.
@@ -234,8 +229,9 @@ apply generic_format_bpow.
 now apply valid_exp.
 Qed.
 
-Lemma generic_format_bpow_ge_ulp_0:  forall e,
-    (ulp 0 <= bpow e)%R -> F (bpow e).
+Lemma generic_format_bpow_ge_ulp_0 :
+  forall e, (ulp 0 <= bpow e)%R ->
+  F (bpow e).
 Proof.
 intros e; unfold ulp.
 rewrite Req_bool_true; trivial.
@@ -248,7 +244,7 @@ apply generic_format_bpow.
 case (Zle_or_lt (e+1) (fexp (e+1))); intros H4.
 absurd (e+1 <= e)%Z.
 omega.
-apply Zle_trans with (1:=H4).
+apply Z.le_trans with (1:=H4).
 replace (fexp (e+1)) with (fexp n).
 now apply le_bpow with beta.
 now apply fexp_negligible_exp_eq.
@@ -258,33 +254,36 @@ Qed.
 (** The three following properties are equivalent:
       [Exp_not_FTZ] ;  forall x, F (ulp x) ; forall x, ulp 0 <= ulp x *)
 
-Lemma generic_format_ulp: Exp_not_FTZ fexp ->
-  forall x,  F (ulp x).
+Lemma generic_format_ulp :
+  Exp_not_FTZ fexp ->
+  forall x, F (ulp x).
 Proof.
 unfold Exp_not_FTZ; intros H x.
 case (Req_dec x 0); intros Hx.
 rewrite Hx; apply generic_format_ulp_0.
 rewrite (ulp_neq_0 _ Hx).
-apply generic_format_bpow; unfold canonic_exp.
+apply generic_format_bpow.
 apply H.
 Qed.
 
-Lemma not_FTZ_generic_format_ulp:
-   (forall x,  F (ulp x)) -> Exp_not_FTZ fexp.
+Lemma not_FTZ_generic_format_ulp :
+  (forall x,  F (ulp x)) ->
+  Exp_not_FTZ fexp.
 Proof.
 intros H e.
 specialize (H (bpow (e-1))).
 rewrite ulp_neq_0 in H.
 2: apply Rgt_not_eq, bpow_gt_0.
-unfold canonic_exp in H.
-rewrite ln_beta_bpow in H.
-apply generic_format_bpow_inv' in H...
+unfold cexp in H.
+rewrite mag_bpow in H.
+apply generic_format_bpow_inv' in H.
 now replace (e-1+1)%Z with e in H by ring.
 Qed.
 
 
-Lemma ulp_ge_ulp_0: Exp_not_FTZ fexp ->
-  forall x,  (ulp 0 <= ulp x)%R.
+Lemma ulp_ge_ulp_0 :
+  Exp_not_FTZ fexp ->
+  forall x, (ulp 0 <= ulp x)%R.
 Proof.
 unfold Exp_not_FTZ; intros H x.
 case (Req_dec x 0); intros Hx.
@@ -295,20 +294,21 @@ case negligible_exp_spec'.
 intros (H1,H2); rewrite H1; apply ulp_ge_0.
 intros (n,(H1,H2)); rewrite H1.
 rewrite ulp_neq_0; trivial.
-apply bpow_le; unfold canonic_exp.
-generalize (ln_beta beta x); intros l.
+apply bpow_le; unfold cexp.
+generalize (mag beta x); intros l.
 case (Zle_or_lt l (fexp l)); intros Hl.
-rewrite (fexp_negligible_exp_eq n l); trivial; apply Zle_refl.
+rewrite (fexp_negligible_exp_eq n l); trivial; apply Z.le_refl.
 case (Zle_or_lt (fexp n) (fexp l)); trivial; intros K.
 absurd (fexp n <= fexp l)%Z.
 omega.
-apply Zle_trans with (2:= H _).
+apply Z.le_trans with (2:= H _).
 apply Zeq_le, sym_eq, valid_exp; trivial.
 omega.
 Qed.
 
 Lemma not_FTZ_ulp_ge_ulp_0:
-   (forall x,  (ulp 0 <= ulp x)%R) -> Exp_not_FTZ fexp.
+  (forall x, (ulp 0 <= ulp x)%R) ->
+  Exp_not_FTZ fexp.
 Proof.
 intros H e.
 apply generic_format_bpow_inv' with beta.
@@ -318,9 +318,7 @@ rewrite <- ulp_bpow.
 apply H.
 Qed.
 
-
-
-Theorem ulp_le_pos :
+Lemma ulp_le_pos :
   forall { Hm : Monotone_exp fexp },
   forall x y: R,
   (0 <= x)%R -> (x <= y)%R ->
@@ -332,7 +330,7 @@ rewrite ulp_neq_0.
 rewrite ulp_neq_0.
 apply bpow_le.
 apply Hm.
-now apply ln_beta_le.
+now apply mag_le.
 apply Rgt_not_eq, Rlt_gt.
 now apply Rlt_le_trans with (1:=Hx).
 now apply Rgt_not_eq.
@@ -341,7 +339,6 @@ apply ulp_ge_ulp_0.
 apply monotone_exp_not_FTZ...
 Qed.
 
-
 Theorem ulp_le :
   forall { Hm : Monotone_exp fexp },
   forall x y: R,
@@ -355,26 +352,49 @@ apply ulp_le_pos; trivial.
 apply Rabs_pos.
 Qed.
 
+(** Properties when there is no minimal exponent *)
+Theorem eq_0_round_0_negligible_exp :
+   negligible_exp = None -> forall rnd {Vr: Valid_rnd rnd} x,
+     round beta fexp rnd x = 0%R -> x = 0%R.
+Proof.
+intros H rnd Vr x Hx.
+case (Req_dec x 0); try easy; intros Hx2.
+absurd (Rabs (round beta fexp rnd x) = 0%R).
+2: rewrite Hx, Rabs_R0; easy.
+apply Rgt_not_eq.
+apply Rlt_le_trans with (bpow (mag beta x - 1)).
+apply bpow_gt_0.
+apply abs_round_ge_generic; try assumption.
+apply generic_format_bpow.
+case negligible_exp_spec'; [intros (K1,K2)|idtac].
+ring_simplify (mag beta x-1+1)%Z.
+specialize (K2 (mag beta x)); now auto with zarith.
+intros (n,(Hn1,Hn2)).
+rewrite Hn1 in H; discriminate.
+now apply bpow_mag_le.
+Qed.
+
 
 
 (** Definition and properties of pred and succ *)
 
 Definition pred_pos x :=
-  if Req_bool x (bpow (ln_beta beta x - 1)) then
-    (x - bpow (fexp (ln_beta beta x - 1)))%R
+  if Req_bool x (bpow (mag beta x - 1)) then
+    (x - bpow (fexp (mag beta x - 1)))%R
   else
     (x - ulp x)%R.
 
 Definition succ x :=
-   if (Rle_bool 0 x) then
-          (x+ulp x)%R
-   else
-     (- pred_pos (-x))%R.
+  if (Rle_bool 0 x) then
+    (x+ulp x)%R
+  else
+    (- pred_pos (-x))%R.
 
 Definition pred x := (- succ (-x))%R.
 
-Theorem pred_eq_pos:
-  forall x, (0 <= x)%R -> (pred x = pred_pos x)%R.
+Theorem pred_eq_pos :
+  forall x, (0 <= x)%R ->
+  pred x = pred_pos x.
 Proof.
 intros x Hx; unfold pred, succ.
 case Rle_bool_spec; intros Hx'.
@@ -389,39 +409,29 @@ rewrite Ropp_0; ring.
 now rewrite 2!Ropp_involutive.
 Qed.
 
-Theorem succ_eq_pos:
-  forall x, (0 <= x)%R -> (succ x = x + ulp x)%R.
+Theorem succ_eq_pos :
+  forall x, (0 <= x)%R ->
+  succ x = (x + ulp x)%R.
 Proof.
 intros x Hx; unfold succ.
 now rewrite Rle_bool_true.
 Qed.
 
-Lemma pred_eq_opp_succ_opp: forall x, pred x = (- succ (-x))%R.
+Theorem succ_opp :
+  forall x, succ (-x) = (- pred x)%R.
 Proof.
-reflexivity.
-Qed.
-
-Lemma succ_eq_opp_pred_opp: forall x, succ x = (- pred (-x))%R.
-Proof.
-intros x; unfold pred.
-now rewrite 2!Ropp_involutive.
-Qed.
-
-Lemma succ_opp: forall x, (succ (-x) = - pred x)%R.
-Proof.
-intros x; rewrite succ_eq_opp_pred_opp.
-now rewrite Ropp_involutive.
+intros x.
+now apply sym_eq, Ropp_involutive.
 Qed.
 
-Lemma pred_opp: forall x, (pred (-x) = - succ x)%R.
+Theorem pred_opp :
+  forall x, pred (-x) = (- succ x)%R.
 Proof.
-intros x; rewrite pred_eq_opp_succ_opp.
+intros x.
+unfold pred.
 now rewrite Ropp_involutive.
 Qed.
 
-
-
-
 (** pred and succ are in the format *)
 
 (* cannont be x <> ulp 0, due to the counter-example 1-bit FP format fexp: e -> e-1 *)
@@ -436,7 +446,7 @@ intros x e Fx Hx' Hx.
 (* *)
 assert (1 <= Ztrunc (scaled_mantissa beta fexp x))%Z.
 assert (0 <  Ztrunc (scaled_mantissa beta fexp x))%Z.
-apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+apply gt_0_F2R with beta (cexp beta fexp x).
 rewrite <- Fx.
 apply Rle_lt_trans with (2:=Hx).
 apply bpow_ge_0.
@@ -446,12 +456,11 @@ case (Zle_lt_or_eq _ _ H); intros Hm.
 pattern x at 1 ; rewrite Fx.
 rewrite ulp_neq_0.
 unfold F2R. simpl.
-pattern (bpow (canonic_exp beta fexp x)) at 2 ; rewrite <- Rmult_1_l.
+pattern (bpow (cexp beta fexp x)) at 2 ; rewrite <- Rmult_1_l.
 rewrite <- Rmult_minus_distr_r.
-change 1%R with (Z2R 1).
-rewrite <- Z2R_minus.
-change (bpow e <= F2R (Float beta (Ztrunc (scaled_mantissa beta fexp x) - 1) (canonic_exp beta fexp x)))%R.
-apply bpow_le_F2R_m1; trivial.
+rewrite <- minus_IZR.
+apply bpow_le_F2R_m1.
+easy.
 now rewrite <- Fx.
 apply Rgt_not_eq, Rlt_gt.
 apply Rlt_trans with (2:=Hx), bpow_gt_0.
@@ -476,27 +485,23 @@ intros x e Zx Fx Hx.
 pattern x at 1 ; rewrite Fx.
 rewrite ulp_neq_0.
 unfold F2R. simpl.
-pattern (bpow (canonic_exp beta fexp x)) at 2 ; rewrite <- Rmult_1_l.
+pattern (bpow (cexp beta fexp x)) at 2 ; rewrite <- Rmult_1_l.
 rewrite <- Rmult_plus_distr_r.
-change 1%R with (Z2R 1).
-rewrite <- Z2R_plus.
-change (F2R (Float beta (Ztrunc (scaled_mantissa beta fexp x) + 1) (canonic_exp beta fexp x)) <= bpow e)%R.
+rewrite <- plus_IZR.
 apply F2R_p1_le_bpow.
-apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+apply gt_0_F2R with beta (cexp beta fexp x).
 now rewrite <- Fx.
 now rewrite <- Fx.
 now apply Rgt_not_eq.
 Qed.
 
-
-
 Lemma generic_format_pred_aux1:
   forall x, (0 < x)%R -> F x ->
-  x <> bpow (ln_beta beta x - 1) ->
+  x <> bpow (mag beta x - 1) ->
   F (x - ulp x).
 Proof.
 intros x Zx Fx Hx.
-destruct (ln_beta beta x) as (ex, Ex).
+destruct (mag beta x) as (ex, Ex).
 simpl in Hx.
 specialize (Ex (Rgt_not_eq _ _ Zx)).
 assert (Ex' : (bpow (ex - 1) < x < bpow ex)%R).
@@ -504,20 +509,20 @@ rewrite Rabs_pos_eq in Ex.
 destruct Ex as (H,H'); destruct H; split; trivial.
 contradict Hx; easy.
 now apply Rlt_le.
-unfold generic_format, scaled_mantissa, canonic_exp.
-rewrite ln_beta_unique with beta (x - ulp x)%R ex.
+unfold generic_format, scaled_mantissa, cexp.
+rewrite mag_unique with beta (x - ulp x)%R ex.
 pattern x at 1 3 ; rewrite Fx.
 rewrite ulp_neq_0.
 unfold scaled_mantissa.
-rewrite canonic_exp_fexp with (1 := Ex).
+rewrite cexp_fexp with (1 := Ex).
 unfold F2R. simpl.
 rewrite Rmult_minus_distr_r.
 rewrite Rmult_assoc.
 rewrite <- bpow_plus, Zplus_opp_r, Rmult_1_r.
-change (bpow 0) with (Z2R 1).
-rewrite <- Z2R_minus.
-rewrite Ztrunc_Z2R.
-rewrite Z2R_minus.
+change (bpow 0) with 1%R.
+rewrite <- minus_IZR.
+rewrite Ztrunc_IZR.
+rewrite minus_IZR.
 rewrite Rmult_minus_distr_r.
 now rewrite Rmult_1_l.
 now apply Rgt_not_eq.
@@ -526,7 +531,7 @@ split.
 apply id_m_ulp_ge_bpow; trivial.
 rewrite ulp_neq_0.
 intro H.
-assert (ex-1 < canonic_exp beta fexp x  < ex)%Z.
+assert (ex-1 < cexp beta fexp x  < ex)%Z.
 split ; apply (lt_bpow beta) ; rewrite <- H ; easy.
 clear -H0. omega.
 now apply Rgt_not_eq.
@@ -541,13 +546,12 @@ apply Rle_0_minus.
 pattern x at 2; rewrite Fx.
 rewrite ulp_neq_0.
 unfold F2R; simpl.
-pattern (bpow (canonic_exp beta fexp x)) at 1; rewrite <- Rmult_1_l.
+pattern (bpow (cexp beta fexp x)) at 1; rewrite <- Rmult_1_l.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-replace 1%R with (Z2R 1) by reflexivity.
-apply Z2R_le.
+apply IZR_le.
 assert (0 <  Ztrunc (scaled_mantissa beta fexp x))%Z.
-apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+apply gt_0_F2R with beta (cexp beta fexp x).
 rewrite <- Fx.
 apply Rle_lt_trans with (2:=proj1 Ex').
 apply bpow_ge_0.
@@ -557,8 +561,8 @@ Qed.
 
 Lemma generic_format_pred_aux2 :
   forall x, (0 < x)%R -> F x ->
-  let e := ln_beta_val beta x (ln_beta beta x) in
-  x =  bpow (e - 1) ->
+  let e := mag_val beta x (mag beta x) in
+  x = bpow (e - 1) ->
   F (x - bpow (fexp (e - 1))).
 Proof.
 intros x Zx Fx e Hx.
@@ -571,7 +575,7 @@ case (Zle_lt_or_eq _ _ He); clear He; intros He.
 assert (f = F2R (Float beta (Zpower beta (e-1-(fexp (e-1))) -1) (fexp (e-1))))%R.
 unfold f; rewrite Hx.
 unfold F2R; simpl.
-rewrite Z2R_minus, Z2R_Zpower.
+rewrite minus_IZR, IZR_Zpower.
 rewrite Rmult_minus_distr_r, Rmult_1_l.
 rewrite <- bpow_plus.
 now replace (e - 1 - fexp (e - 1) + fexp (e - 1))%Z with (e-1)%Z by ring.
@@ -580,7 +584,7 @@ rewrite H.
 apply generic_format_F2R.
 intros _.
 apply Zeq_le.
-apply canonic_exp_fexp.
+apply cexp_fexp.
 rewrite <- H.
 unfold f; rewrite Hx.
 rewrite Rabs_right.
@@ -593,9 +597,8 @@ apply Rle_trans with (2*bpow (e - 2))%R;[right; ring|idtac].
 apply Rle_trans with (bpow 1*bpow (e - 2))%R.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-replace 2%R with (Z2R 2) by reflexivity.
-replace (bpow 1) with (Z2R beta).
-apply Z2R_le.
+replace (bpow 1) with (IZR beta).
+apply IZR_le.
 apply <- Zle_is_le_bool.
 now destruct beta.
 simpl.
@@ -619,31 +622,30 @@ rewrite Hx, He.
 ring.
 Qed.
 
-
-Theorem generic_format_succ_aux1 :
+Lemma generic_format_succ_aux1 :
   forall x, (0 < x)%R -> F x ->
   F (x + ulp x).
 Proof.
 intros x Zx Fx.
-destruct (ln_beta beta x) as (ex, Ex).
+destruct (mag beta x) as (ex, Ex).
 specialize (Ex (Rgt_not_eq _ _ Zx)).
 assert (Ex' := Ex).
 rewrite Rabs_pos_eq in Ex'.
 destruct (id_p_ulp_le_bpow x ex) ; try easy.
-unfold generic_format, scaled_mantissa, canonic_exp.
-rewrite ln_beta_unique with beta (x + ulp x)%R ex.
+unfold generic_format, scaled_mantissa, cexp.
+rewrite mag_unique with beta (x + ulp x)%R ex.
 pattern x at 1 3 ; rewrite Fx.
 rewrite ulp_neq_0.
 unfold scaled_mantissa.
-rewrite canonic_exp_fexp with (1 := Ex).
+rewrite cexp_fexp with (1 := Ex).
 unfold F2R. simpl.
 rewrite Rmult_plus_distr_r.
 rewrite Rmult_assoc.
 rewrite <- bpow_plus, Zplus_opp_r, Rmult_1_r.
-change (bpow 0) with (Z2R 1).
-rewrite <- Z2R_plus.
-rewrite Ztrunc_Z2R.
-rewrite Z2R_plus.
+change (bpow 0) with 1%R.
+rewrite <- plus_IZR.
+rewrite Ztrunc_IZR.
+rewrite plus_IZR.
 rewrite Rmult_plus_distr_r.
 now rewrite Rmult_1_l.
 now apply Rgt_not_eq.
@@ -667,7 +669,7 @@ replace (Ztrunc (scaled_mantissa beta fexp x)) with Z0.
 rewrite F2R_0.
 apply Rle_refl.
 unfold scaled_mantissa.
-rewrite canonic_exp_fexp with (1 := Ex).
+rewrite cexp_fexp with (1 := Ex).
 destruct (mantissa_small_pos beta fexp x ex) ; trivial.
 rewrite Ztrunc_floor.
 apply sym_eq.
@@ -679,7 +681,7 @@ now apply Rlt_le.
 now apply Rlt_le.
 Qed.
 
-Theorem generic_format_pred_pos :
+Lemma generic_format_pred_pos :
   forall x, F x -> (0 < x)%R ->
   F (pred_pos x).
 Proof.
@@ -689,7 +691,6 @@ now apply generic_format_pred_aux2.
 now apply generic_format_pred_aux1.
 Qed.
 
-
 Theorem generic_format_succ :
   forall x, F x ->
   F (succ x).
@@ -717,9 +718,7 @@ apply generic_format_succ.
 now apply generic_format_opp.
 Qed.
 
-
-
-Theorem pred_pos_lt_id :
+Lemma pred_pos_lt_id :
   forall x, (x <> 0)%R ->
   (pred_pos x < x)%R.
 Proof.
@@ -754,7 +753,7 @@ apply bpow_gt_0.
 pattern x at 1; rewrite <- (Ropp_involutive x).
 apply Ropp_lt_contravar.
 apply pred_pos_lt_id.
-now auto with real.
+auto with real.
 Qed.
 
 
@@ -766,7 +765,7 @@ intros x Zx; unfold pred.
 pattern x at 2; rewrite <- (Ropp_involutive x).
 apply Ropp_lt_contravar.
 apply succ_gt_id.
-now auto with real.
+auto with real.
 Qed.
 
 Theorem succ_ge_id :
@@ -781,7 +780,7 @@ Qed.
 
 
 Theorem pred_le_id :
-  forall x,  (pred x <= x)%R.
+  forall x, (pred x <= x)%R.
 Proof.
 intros x; unfold pred.
 pattern x at 2; rewrite <- (Ropp_involutive x).
@@ -790,7 +789,7 @@ apply succ_ge_id.
 Qed.
 
 
-Theorem pred_pos_ge_0 :
+Lemma pred_pos_ge_0 :
   forall x,
   (0 < x)%R -> F x -> (0 <= pred_pos x)%R.
 Proof.
@@ -801,8 +800,8 @@ case Req_bool_spec; intros H.
 apply Rle_0_minus.
 rewrite H.
 apply bpow_le.
-destruct (ln_beta beta x) as (ex,Ex) ; simpl.
-rewrite ln_beta_bpow.
+destruct (mag beta x) as (ex,Ex) ; simpl.
+rewrite mag_bpow.
 ring_simplify (ex - 1 + 1 - 1)%Z.
 apply generic_format_bpow_inv with beta; trivial.
 simpl in H.
@@ -824,36 +823,35 @@ Qed.
 
 Lemma pred_pos_plus_ulp_aux1 :
   forall x, (0 < x)%R -> F x ->
-  x <> bpow (ln_beta beta x - 1) ->
+  x <> bpow (mag beta x - 1) ->
   ((x - ulp x) + ulp (x-ulp x) = x)%R.
 Proof.
 intros x Zx Fx Hx.
 replace (ulp (x - ulp x)) with (ulp x).
 ring.
-assert (H:(x <> 0)%R) by auto with real.
-assert (H':(x <> bpow (canonic_exp beta fexp x))%R).
-unfold canonic_exp; intros M.
-case_eq (ln_beta beta x); intros ex Hex T.
-assert (Lex:(ln_beta_val beta x (ln_beta beta x) = ex)%Z).
+assert (H : x <> 0%R) by now apply Rgt_not_eq.
+assert (H' : x <> bpow (cexp beta fexp x)).
+unfold cexp ; intros M.
+case_eq (mag beta x); intros ex Hex T.
+assert (Lex:(mag_val beta x (mag beta x) = ex)%Z).
 rewrite T; reflexivity.
 rewrite Lex in *.
 clear T; simpl in *; specialize (Hex H).
-rewrite Rabs_right in Hex.
-2: apply Rle_ge; apply Rlt_le; easy.
-assert (ex-1 < fexp ex  < ex)%Z.
-split ; apply (lt_bpow beta); rewrite <- M;[idtac|easy].
-destruct (proj1 Hex);[trivial|idtac].
-contradict Hx; auto with real.
+rewrite Rabs_pos_eq in Hex by now apply Rlt_le.
+assert (ex - 1 < fexp ex < ex)%Z.
+  split ; apply (lt_bpow beta) ; rewrite <- M by easy.
+  lra.
+  apply Hex.
 omega.
-rewrite 2!ulp_neq_0; try auto with real.
+rewrite 2!ulp_neq_0 by lra.
 apply f_equal.
-unfold canonic_exp; apply f_equal.
-case_eq (ln_beta beta x); intros ex Hex T.
-assert (Lex:(ln_beta_val beta x (ln_beta beta x) = ex)%Z).
+unfold cexp ; apply f_equal.
+case_eq (mag beta x); intros ex Hex T.
+assert (Lex:(mag_val beta x (mag beta x) = ex)%Z).
 rewrite T; reflexivity.
 rewrite Lex in *; simpl in *; clear T.
 specialize (Hex H).
-apply sym_eq, ln_beta_unique.
+apply sym_eq, mag_unique.
 rewrite Rabs_right.
 rewrite Rabs_right in Hex.
 2: apply Rle_ge; apply Rlt_le; easy.
@@ -863,8 +861,8 @@ apply Rle_trans with (x-ulp x)%R.
 apply id_m_ulp_ge_bpow; trivial.
 rewrite ulp_neq_0; trivial.
 rewrite ulp_neq_0; trivial.
-right; unfold canonic_exp; now rewrite Lex.
-contradict Hx; auto with real.
+right; unfold cexp; now rewrite Lex.
+lra.
 apply Rle_lt_trans with (2:=proj2 Hex).
 rewrite <- Rplus_0_r.
 apply Rplus_le_compat_l.
@@ -874,22 +872,19 @@ apply bpow_ge_0.
 apply Rle_ge.
 apply Rle_0_minus.
 rewrite Fx.
-unfold F2R, canonic_exp; simpl.
+unfold F2R, cexp; simpl.
 rewrite Lex.
 pattern (bpow (fexp ex)) at 1; rewrite <- Rmult_1_l.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-replace 1%R with (Z2R (Zsucc 0)) by reflexivity.
-apply Z2R_le.
-apply Zlt_le_succ.
-apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+apply IZR_le, (Zlt_le_succ 0).
+apply gt_0_F2R with beta (cexp beta fexp x).
 now rewrite <- Fx.
 Qed.
 
-
 Lemma pred_pos_plus_ulp_aux2 :
   forall x, (0 < x)%R -> F x ->
-  let e := ln_beta_val beta x (ln_beta beta x) in
+  let e := mag_val beta x (mag beta x) in
   x =  bpow (e - 1) ->
   (x - bpow (fexp (e-1)) <> 0)%R ->
   ((x - bpow (fexp (e-1))) + ulp (x - bpow (fexp (e-1))) = x)%R.
@@ -904,9 +899,9 @@ case (Zle_lt_or_eq _ _ He); clear He; intros He.
 (* *)
 rewrite ulp_neq_0; trivial.
 apply f_equal.
-unfold canonic_exp; apply f_equal.
+unfold cexp ; apply f_equal.
 apply sym_eq.
-apply ln_beta_unique.
+apply mag_unique.
 rewrite Rabs_right.
 split.
 apply Rplus_le_reg_l with (bpow (fexp (e-1))).
@@ -917,9 +912,8 @@ apply Rle_trans with (2*bpow (e - 2))%R;[right; ring|idtac].
 apply Rle_trans with (bpow 1*bpow (e - 2))%R.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-replace 2%R with (Z2R 2) by reflexivity.
-replace (bpow 1) with (Z2R beta).
-apply Z2R_le.
+replace (bpow 1) with (IZR beta).
+apply IZR_le.
 apply <- Zle_is_le_bool.
 now destruct beta.
 simpl.
@@ -944,7 +938,7 @@ Qed.
 
 Lemma pred_pos_plus_ulp_aux3 :
   forall x, (0 < x)%R -> F x ->
-  let e := ln_beta_val beta x (ln_beta beta x) in
+  let e := mag_val beta x (mag beta x) in
   x =  bpow (e - 1) ->
   (x - bpow (fexp (e-1)) = 0)%R ->
   (ulp 0 = x)%R.
@@ -967,40 +961,44 @@ apply valid_exp; omega.
 apply sym_eq, valid_exp; omega.
 Qed.
 
-
-
-
 (** The following one is false for x = 0 in FTZ *)
 
-Theorem pred_pos_plus_ulp :
+Lemma pred_pos_plus_ulp :
   forall x, (0 < x)%R -> F x ->
   (pred_pos x + ulp (pred_pos x) = x)%R.
 Proof.
 intros x Zx Fx.
 unfold pred_pos.
 case Req_bool_spec; intros H.
-case (Req_EM_T (x - bpow (fexp (ln_beta_val beta x (ln_beta beta x) -1))) 0); intros H1.
+case (Req_EM_T (x - bpow (fexp (mag_val beta x (mag beta x) -1))) 0); intros H1.
 rewrite H1, Rplus_0_l.
 now apply pred_pos_plus_ulp_aux3.
 now apply pred_pos_plus_ulp_aux2.
 now apply pred_pos_plus_ulp_aux1.
 Qed.
 
-
-
+Theorem pred_plus_ulp :
+  forall x, (0 < x)%R -> F x ->
+  (pred x + ulp (pred x))%R = x.
+Proof.
+intros x Hx Fx.
+rewrite pred_eq_pos.
+now apply pred_pos_plus_ulp.
+now apply Rlt_le.
+Qed.
 
 (** Rounding x + small epsilon *)
 
-Theorem ln_beta_plus_eps:
+Theorem mag_plus_eps :
   forall x, (0 < x)%R -> F x ->
   forall eps, (0 <= eps < ulp x)%R ->
-  ln_beta beta (x + eps) = ln_beta beta x :> Z.
+  mag beta (x + eps) = mag beta x :> Z.
 Proof.
 intros x Zx Fx eps Heps.
-destruct (ln_beta beta x) as (ex, He).
+destruct (mag beta x) as (ex, He).
 simpl.
 specialize (He (Rgt_not_eq _ _ Zx)).
-apply ln_beta_unique.
+apply mag_unique.
 rewrite Rabs_pos_eq.
 rewrite Rabs_pos_eq in He.
 split.
@@ -1012,13 +1010,11 @@ now apply Rplus_lt_compat_l.
 pattern x at 1 ; rewrite Fx.
 rewrite ulp_neq_0.
 unfold F2R. simpl.
-pattern (bpow (canonic_exp beta fexp x)) at 2 ; rewrite <- Rmult_1_l.
+pattern (bpow (cexp beta fexp x)) at 2 ; rewrite <- Rmult_1_l.
 rewrite <- Rmult_plus_distr_r.
-change 1%R with (Z2R 1).
-rewrite <- Z2R_plus.
-change (F2R (Float beta (Ztrunc (scaled_mantissa beta fexp x) + 1) (canonic_exp beta fexp x)) <= bpow ex)%R.
+rewrite <- plus_IZR.
 apply F2R_p1_le_bpow.
-apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+apply gt_0_F2R with beta (cexp beta fexp x).
 now rewrite <- Fx.
 now rewrite <- Fx.
 now apply Rgt_not_eq.
@@ -1028,7 +1024,7 @@ now apply Rlt_le.
 apply Heps.
 Qed.
 
-Theorem round_DN_plus_eps_pos:
+Theorem round_DN_plus_eps_pos :
   forall x, (0 <= x)%R -> F x ->
   forall eps, (0 <= eps < ulp x)%R ->
   round beta fexp Zfloor (x + eps) = x.
@@ -1039,8 +1035,8 @@ destruct Zx as [Zx|Zx].
 pattern x at 2 ; rewrite Fx.
 unfold round.
 unfold scaled_mantissa. simpl.
-unfold canonic_exp at 1 2.
-rewrite ln_beta_plus_eps ; trivial.
+unfold cexp at 1 2.
+rewrite mag_plus_eps ; trivial.
 apply (f_equal (fun m => F2R (Float beta m _))).
 rewrite Ztrunc_floor.
 apply Zfloor_imp.
@@ -1050,12 +1046,12 @@ apply Rmult_le_compat_r.
 apply bpow_ge_0.
 pattern x at 1 ; rewrite <- Rplus_0_r.
 now apply Rplus_le_compat_l.
-apply Rlt_le_trans with ((x + ulp x) * bpow (- canonic_exp beta fexp x))%R.
+apply Rlt_le_trans with ((x + ulp x) * bpow (- cexp beta fexp x))%R.
 apply Rmult_lt_compat_r.
 apply bpow_gt_0.
 now apply Rplus_lt_compat_l.
 rewrite Rmult_plus_distr_r.
-rewrite Z2R_plus.
+rewrite plus_IZR.
 apply Rplus_le_compat.
 pattern x at 1 3 ; rewrite Fx.
 unfold F2R. simpl.
@@ -1063,7 +1059,7 @@ rewrite Rmult_assoc.
 rewrite <- bpow_plus.
 rewrite Zplus_opp_r.
 rewrite Rmult_1_r.
-rewrite Zfloor_Z2R.
+rewrite Zfloor_IZR.
 apply Rle_refl.
 rewrite ulp_neq_0.
 2: now apply Rgt_not_eq.
@@ -1076,24 +1072,23 @@ apply bpow_ge_0.
 (* . x=0 *)
 rewrite <- Zx, Rplus_0_l; rewrite <- Zx in Heps.
 case (proj1 Heps); intros P.
-unfold round, scaled_mantissa, canonic_exp.
+unfold round, scaled_mantissa, cexp.
 revert Heps; unfold ulp.
 rewrite Req_bool_true; trivial.
 case negligible_exp_spec.
 intros _ (H1,H2).
-absurd (0 < 0)%R; auto with real.
-now apply Rle_lt_trans with (1:=H1).
+exfalso ; lra.
 intros n Hn H.
-assert (fexp (ln_beta beta eps) = fexp n).
+assert (fexp (mag beta eps) = fexp n).
 apply valid_exp; try assumption.
-assert(ln_beta beta eps-1 < fexp n)%Z;[idtac|omega].
+assert(mag beta eps-1 < fexp n)%Z;[idtac|omega].
 apply lt_bpow with beta.
 apply Rle_lt_trans with (2:=proj2 H).
-destruct (ln_beta beta eps) as (e,He).
+destruct (mag beta eps) as (e,He).
 simpl; rewrite Rabs_pos_eq in He.
 now apply He, Rgt_not_eq.
 now left.
-replace (Zfloor (eps * bpow (- fexp (ln_beta beta eps)))) with 0%Z.
+replace (Zfloor (eps * bpow (- fexp (mag beta eps)))) with 0%Z.
 unfold F2R; simpl; ring.
 apply sym_eq, Zfloor_imp.
 split.
@@ -1128,8 +1123,8 @@ assert (Hd := round_DN_plus_eps_pos x Zx Fx eps Heps).
 rewrite round_UP_DN_ulp.
 rewrite Hd.
 rewrite 2!ulp_neq_0.
-unfold canonic_exp.
-now rewrite ln_beta_plus_eps.
+unfold cexp.
+now rewrite mag_plus_eps.
 now apply Rgt_not_eq.
 now apply Rgt_not_eq, Rplus_lt_0_compat.
 intros Fs.
@@ -1144,24 +1139,22 @@ now apply generic_format_succ_aux1.
 rewrite <- Zx1, 2!Rplus_0_l.
 intros Heps.
 case (proj2 Heps).
-unfold round, scaled_mantissa, canonic_exp.
+unfold round, scaled_mantissa, cexp.
 unfold ulp.
 rewrite Req_bool_true; trivial.
 case negligible_exp_spec.
-intros H2.
-intros J; absurd (0 < 0)%R; auto with real.
-apply Rlt_trans with eps; try assumption; apply Heps.
+lra.
 intros n Hn H.
-assert (fexp (ln_beta beta eps) = fexp n).
+assert (fexp (mag beta eps) = fexp n).
 apply valid_exp; try assumption.
-assert(ln_beta beta eps-1 < fexp n)%Z;[idtac|omega].
+assert(mag beta eps-1 < fexp n)%Z;[idtac|omega].
 apply lt_bpow with beta.
 apply Rle_lt_trans with (2:=H).
-destruct (ln_beta beta eps) as (e,He).
+destruct (mag beta eps) as (e,He).
 simpl; rewrite Rabs_pos_eq in He.
 now apply He, Rgt_not_eq.
 now left.
-replace (Zceil (eps * bpow (- fexp (ln_beta beta eps)))) with 1%Z.
+replace (Zceil (eps * bpow (- fexp (mag beta eps)))) with 1%Z.
 unfold F2R; simpl; rewrite H0; ring.
 apply sym_eq, Zceil_imp.
 split.
@@ -1316,7 +1309,7 @@ destruct Zp; trivial.
 generalize H0.
 rewrite pred_eq_pos;[idtac|now left].
 unfold pred_pos.
-destruct (ln_beta beta y) as (ey,Hey); simpl.
+destruct (mag beta y) as (ey,Hey); simpl.
 case Req_bool_spec; intros Hy2.
 (* . *)
 intros Hy3.
@@ -1326,7 +1319,7 @@ rewrite <- Hy2, <- Rplus_0_l, Hy3.
 ring.
 assert (Zx: (x <> 0)%R).
 now apply Rgt_not_eq.
-destruct (ln_beta beta x) as (ex,Hex).
+destruct (mag beta x) as (ex,Hex).
 specialize (Hex Zx).
 assert (ex <= ey)%Z.
 apply bpow_lt_bpow with beta.
@@ -1347,16 +1340,16 @@ omega.
 absurd (0 < Ztrunc (scaled_mantissa beta fexp x) < 1)%Z.
 omega.
 split.
-apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+apply gt_0_F2R with beta (cexp beta fexp x).
 now rewrite <- Fx.
-apply lt_Z2R.
-apply Rmult_lt_reg_r with (bpow (canonic_exp beta fexp x)).
+apply lt_IZR.
+apply Rmult_lt_reg_r with (bpow (cexp beta fexp x)).
 apply bpow_gt_0.
-replace (Z2R (Ztrunc (scaled_mantissa beta fexp x)) *
- bpow (canonic_exp beta fexp x))%R with x.
+replace (IZR (Ztrunc (scaled_mantissa beta fexp x)) *
+  bpow (cexp beta fexp x))%R with x.
 rewrite Rmult_1_l.
-unfold canonic_exp.
-rewrite ln_beta_unique with beta x ex.
+unfold cexp.
+rewrite mag_unique with beta x ex.
 rewrite H3,<-H1, <- Hy2.
 apply H.
 exact Hex.
@@ -1373,8 +1366,8 @@ assert (y = bpow (fexp ey))%R.
 apply Rminus_diag_uniq.
 rewrite Hy3.
 rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq].
-unfold canonic_exp.
-rewrite (ln_beta_unique beta y ey); trivial.
+unfold cexp.
+rewrite (mag_unique beta y ey); trivial.
 apply Hey.
 now apply Rgt_not_eq.
 contradict Hy2.
@@ -1382,8 +1375,8 @@ rewrite H1.
 apply f_equal.
 apply Zplus_reg_l with 1%Z.
 ring_simplify.
-apply trans_eq with (ln_beta beta y).
-apply sym_eq; apply ln_beta_unique.
+apply trans_eq with (mag beta y).
+apply sym_eq; apply mag_unique.
 rewrite H1, Rabs_right.
 split.
 apply bpow_le.
@@ -1391,7 +1384,7 @@ omega.
 apply bpow_lt.
 omega.
 apply Rle_ge; apply bpow_ge_0.
-apply ln_beta_unique.
+apply mag_unique.
 apply Hey.
 now apply Rgt_not_eq.
 (* *)
@@ -1418,7 +1411,7 @@ rewrite <- V; apply pred_pos_ge_0; trivial.
 apply Rle_lt_trans with (1:=proj1 H); apply H.
 Qed.
 
-Theorem succ_le_lt_aux:
+Lemma succ_le_lt_aux:
   forall x y,
   F x -> F y ->
   (0 <= x)%R -> (x < y)%R ->
@@ -1468,7 +1461,7 @@ now apply generic_format_opp.
 rewrite Ropp_0; now left.
 Qed.
 
-Theorem le_pred_lt :
+Theorem pred_ge_gt :
   forall x y,
   F x -> F y ->
   (x < y)%R ->
@@ -1483,7 +1476,7 @@ now apply generic_format_opp.
 now apply Ropp_lt_contravar.
 Qed.
 
-Theorem lt_succ_le :
+Theorem succ_gt_ge :
   forall x y,
   (y <> 0)%R ->
   (x <= y)%R ->
@@ -1505,12 +1498,12 @@ apply Rlt_le_trans with (2 := Hxy).
 now apply pred_lt_id.
 Qed.
 
-Theorem succ_pred_aux : forall x, F x -> (0 < x)%R -> succ (pred x)=x.
+Lemma succ_pred_pos :
+  forall x, F x -> (0 < x)%R -> succ (pred x) = x.
 Proof.
 intros x Fx Hx.
-rewrite pred_eq_pos;[idtac|now left].
-rewrite succ_eq_pos.
-2: now apply pred_pos_ge_0.
+rewrite pred_eq_pos by now left.
+rewrite succ_eq_pos by now apply pred_pos_ge_0.
 now apply pred_pos_plus_ulp.
 Qed.
 
@@ -1530,7 +1523,7 @@ rewrite H1; ring.
 (* *)
 intros (n,(H1,H2)); rewrite H1.
 unfold pred_pos.
-rewrite ln_beta_bpow.
+rewrite mag_bpow.
 replace (fexp n + 1 - 1)%Z with (fexp n) by ring.
 rewrite Req_bool_true; trivial.
 apply Rminus_diag_eq, f_equal.
@@ -1554,7 +1547,7 @@ rewrite <- Ropp_0 at 1.
 apply pred_opp.
 Qed.
 
-Theorem pred_succ_aux :
+Lemma pred_succ_pos :
   forall x, F x -> (0 < x)%R ->
   pred (succ x) = x.
 Proof.
@@ -1570,7 +1563,7 @@ apply Rle_antisym.
   apply Rlt_le_trans with (1 := Hx).
   apply succ_ge_id.
   now apply generic_format_pred, generic_format_succ.
-- apply le_pred_lt with (1 := Fx).
+- apply pred_ge_gt with (1 := Fx).
   now apply generic_format_succ.
   apply succ_gt_id.
   now apply Rgt_not_eq.
@@ -1582,12 +1575,12 @@ Theorem succ_pred :
 Proof.
 intros x Fx.
 destruct (Rle_or_lt 0 x) as [[Hx|Hx]|Hx].
-now apply succ_pred_aux.
+now apply succ_pred_pos.
 rewrite <- Hx.
 rewrite pred_0, succ_opp, pred_ulp_0.
 apply Ropp_0.
-rewrite pred_eq_opp_succ_opp, succ_opp.
-rewrite pred_succ_aux.
+unfold pred.
+rewrite succ_opp, pred_succ_pos.
 apply Ropp_involutive.
 now apply generic_format_opp.
 now apply Ropp_0_gt_lt_contravar.
@@ -1606,8 +1599,8 @@ Qed.
 
 Theorem round_UP_pred_plus_eps :
   forall x, F x ->
-  forall eps, (0 < eps <= if (Rle_bool x 0) then (ulp x)
-                                     else (ulp (pred x)))%R ->
+  forall eps, (0 < eps <= if Rle_bool x 0 then ulp x
+                          else ulp (pred x))%R ->
   round beta fexp Zceil (pred x + eps) = x.
 Proof.
 intros x Fx eps Heps.
@@ -1636,7 +1629,6 @@ now apply pred_ge_0.
 now apply generic_format_opp.
 Qed.
 
-
 Theorem round_DN_minus_eps:
   forall x,  F x ->
   forall eps, (0 < eps <= if (Rle_bool x 0) then (ulp x)
@@ -1676,7 +1668,7 @@ Qed.
 (* was ulp_error *)
 Theorem error_lt_ulp :
   forall rnd { Zrnd : Valid_rnd rnd } x,
-   (x <> 0)%R ->
+  (x <> 0)%R ->
   (Rabs (round beta fexp rnd x - x) < ulp x)%R.
 Proof with auto with typeclass_instances.
 intros rnd Zrnd x Zx.
@@ -1734,7 +1726,6 @@ intros Zx; left.
 now apply error_lt_ulp.
 Qed.
 
-(* was ulp_half_error *)
 Theorem error_le_half_ulp :
   forall choice x,
   (Rabs (round beta fexp (Znearest choice) x - x) <= /2 * ulp x)%R.
@@ -1748,7 +1739,7 @@ rewrite Rplus_opp_r, Rabs_R0.
 apply Rmult_le_pos.
 apply Rlt_le.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 apply ulp_ge_0.
 (* x <> rnd x *)
 set (d := round beta fexp Zfloor x).
@@ -1761,7 +1752,7 @@ apply (round_DN_pt beta fexp x).
 rewrite Rabs_left1.
 rewrite Ropp_minus_distr.
 apply Rmult_le_reg_r with 2%R.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 apply Rplus_le_reg_r with (d - x)%R.
 ring_simplify.
 apply Rle_trans with (1 := H).
@@ -1778,7 +1769,7 @@ rewrite Hu.
 apply (round_UP_pt beta fexp x).
 rewrite Rabs_pos_eq.
 apply Rmult_le_reg_r with 2%R.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 apply Rplus_le_reg_r with (- (d + ulp x - x))%R.
 ring_simplify.
 apply Rlt_le.
@@ -1789,28 +1780,40 @@ rewrite Hu.
 apply (round_UP_pt beta fexp x).
 Qed.
 
-
 Theorem ulp_DN :
-  forall x,
-  (0 < round beta fexp Zfloor x)%R ->
+  forall x, (0 <= x)%R ->
   ulp (round beta fexp Zfloor x) = ulp x.
 Proof with auto with typeclass_instances.
-intros x Hd.
-rewrite 2!ulp_neq_0.
-now rewrite canonic_exp_DN with (2 := Hd).
-intros T; contradict Hd; rewrite T, round_0...
-apply Rlt_irrefl.
-now apply Rgt_not_eq.
-Qed.
-
-Theorem round_neq_0_negligible_exp:
-    negligible_exp=None -> forall rnd { Zrnd : Valid_rnd rnd } x,
-   (x <> 0)%R ->  (round beta fexp rnd x <> 0)%R.
+intros x [Hx|Hx].
+- rewrite (ulp_neq_0 x) by now apply Rgt_not_eq.
+  destruct (round_ge_generic beta fexp Zfloor 0 x) as [Hd|Hd].
+    apply generic_format_0.
+    now apply Rlt_le.
+  + rewrite ulp_neq_0 by now apply Rgt_not_eq.
+    now rewrite cexp_DN with (2 := Hd).
+  + rewrite <- Hd.
+    unfold cexp.
+    destruct (mag beta x) as [e He].
+    simpl.
+    specialize (He (Rgt_not_eq _ _ Hx)).
+    apply sym_eq in Hd.
+    assert (H := exp_small_round_0 _ _ _ _ _ He Hd).
+    unfold ulp.
+    rewrite Req_bool_true by easy.
+    destruct negligible_exp_spec as [H0|k Hk].
+    now elim Zlt_not_le with (1 := H0 e).
+    now apply f_equal, fexp_negligible_exp_eq.
+- rewrite <- Hx, round_0...
+Qed.
+
+Theorem round_neq_0_negligible_exp :
+  negligible_exp = None -> forall rnd { Zrnd : Valid_rnd rnd } x,
+  (x <> 0)%R -> (round beta fexp rnd x <> 0)%R.
 Proof with auto with typeclass_instances.
 intros H rndn Hrnd x Hx K.
 case negligible_exp_spec'.
 intros (_,Hn).
-destruct (ln_beta beta x) as (e,He).
+destruct (mag beta x) as (e,He).
 absurd (fexp e < e)%Z.
 apply Zle_not_lt.
 apply exp_small_round_0 with beta rndn x...
@@ -1819,12 +1822,10 @@ intros (n,(H1,_)).
 rewrite H in H1; discriminate.
 Qed.
 
-
 (** allows rnd x to be 0 *)
-(* was ulp_error_f *)
 Theorem error_lt_ulp_round :
   forall { Hm : Monotone_exp fexp } rnd { Zrnd : Valid_rnd rnd } x,
-  ( x <> 0)%R ->
+  (x <> 0)%R ->
   (Rabs (round beta fexp rnd x - x) < ulp (round beta fexp rnd x))%R.
 Proof with auto with typeclass_instances.
 intros Hm.
@@ -1847,72 +1848,34 @@ now apply valid_rnd_opp.
 now apply Ropp_0_gt_lt_contravar.
 (* 0 < x *)
 intros rnd Hrnd x Hx.
-case (Rle_lt_or_eq_dec 0 (round beta fexp Zfloor x)).
-apply round_ge_generic...
-apply generic_format_0.
-now left.
-(* . 0 < round Zfloor x *)
-intros Hx2.
 apply Rlt_le_trans with (ulp x).
 apply error_lt_ulp...
 now apply Rgt_not_eq.
 rewrite <- ulp_DN; trivial.
 apply ulp_le_pos.
-now left.
+apply round_ge_generic...
+apply generic_format_0.
+now apply Rlt_le.
 case (round_DN_or_UP beta fexp rnd x); intros V; rewrite V.
 apply Rle_refl.
 apply Rle_trans with x.
 apply round_DN_pt...
 apply round_UP_pt...
-(* . 0 = round Zfloor x *)
-intros Hx2.
-case (round_DN_or_UP beta fexp rnd x); intros V; rewrite V; clear V.
-(* .. round down -- difficult case *)
-rewrite <- Hx2.
-unfold Rminus; rewrite Rplus_0_l, Rabs_Ropp.
-unfold ulp; rewrite Req_bool_true; trivial.
-case negligible_exp_spec.
-(* without minimal exponent *)
-intros K; contradict Hx2.
-apply Rlt_not_eq.
-apply F2R_gt_0_compat; simpl.
-apply Zlt_le_trans with 1%Z.
-apply Pos2Z.is_pos.
-apply Zfloor_lub.
-simpl; unfold scaled_mantissa, canonic_exp.
-destruct (ln_beta beta x) as (e,He); simpl.
-apply Rle_trans with (bpow (e-1) * bpow (- fexp e))%R.
-rewrite <- bpow_plus.
-replace 1%R with (bpow 0) by reflexivity.
-apply bpow_le.
-specialize (K e); omega.
-apply Rmult_le_compat_r.
-apply bpow_ge_0.
-rewrite <- (Rabs_pos_eq x).
-now apply He, Rgt_not_eq.
-now left.
-(* with a minimal exponent *)
-intros n Hn.
-rewrite Rabs_pos_eq;[idtac|now left].
-case (Rle_or_lt (bpow (fexp n)) x); trivial.
-intros K; contradict Hx2.
-apply Rlt_not_eq.
-apply Rlt_le_trans with (bpow (fexp n)).
-apply bpow_gt_0.
-apply round_ge_generic...
-apply generic_format_bpow.
-now apply valid_exp.
-(* .. round up *)
-apply Rlt_le_trans with (ulp x).
-apply error_lt_ulp...
-now apply Rgt_not_eq.
-apply ulp_le_pos.
-now left.
-apply round_UP_pt...
+now apply Rlt_le.
+Qed.
+
+Lemma error_le_ulp_round :
+  forall { Hm : Monotone_exp fexp } rnd { Zrnd : Valid_rnd rnd } x,
+  (Rabs (round beta fexp rnd x - x) <= ulp (round beta fexp rnd x))%R.
+Proof.
+intros Mexp rnd Vrnd x.
+destruct (Req_dec x 0) as [Zx|Nzx].
+{ rewrite Zx, round_0; [|exact Vrnd].
+  unfold Rminus; rewrite Ropp_0, Rplus_0_l, Rabs_R0; apply ulp_ge_0. }
+now apply Rlt_le, error_lt_ulp_round.
 Qed.
 
 (** allows both x and rnd x to be 0 *)
-(* was ulp_half_error_f *)
 Theorem error_le_half_ulp_round :
   forall { Hm : Monotone_exp fexp },
   forall choice x,
@@ -1939,11 +1902,11 @@ apply Rle_trans with (1:=N).
 right; apply f_equal.
 rewrite ulp_neq_0; trivial.
 apply f_equal.
-unfold canonic_exp.
+unfold cexp.
 apply valid_exp; trivial.
-assert (ln_beta beta x -1 < fexp n)%Z;[idtac|omega].
+assert (mag beta x -1 < fexp n)%Z;[idtac|omega].
 apply lt_bpow with beta.
-destruct (ln_beta beta x) as (e,He).
+destruct (mag beta x) as (e,He).
 simpl.
 apply Rle_lt_trans with (Rabs x).
 now apply He.
@@ -1958,42 +1921,29 @@ now right.
 (* *)
 case (round_DN_or_UP beta fexp (Znearest choice) x); intros Hx.
 (* . *)
-case (Rle_or_lt 0 (round beta fexp Zfloor x)).
-intros H; destruct H.
+destruct (Rle_or_lt 0 x) as [H|H].
 rewrite Hx at 2.
-rewrite ulp_DN; trivial.
+rewrite ulp_DN by easy.
 apply error_le_half_ulp.
-rewrite Hx in Hfx; contradict Hfx; auto with real.
-intros H.
 apply Rle_trans with (1:=error_le_half_ulp _ _).
 apply Rmult_le_compat_l.
 apply Rlt_le, pos_half_prf.
 apply ulp_le.
-rewrite Hx; rewrite (Rabs_left1 x), Rabs_left; try assumption.
+rewrite Rabs_left1 by now apply Rlt_le.
+rewrite Hx.
+rewrite Rabs_left1.
 apply Ropp_le_contravar.
-apply (round_DN_pt beta fexp x).
-case (Rle_or_lt x 0); trivial.
-intros H1; contradict H.
-apply Rle_not_lt.
-apply round_ge_generic...
+apply round_DN_pt...
+apply round_le_generic...
 apply generic_format_0.
-now left.
+now apply Rlt_le.
 (* . *)
-case (Rle_or_lt 0 (round beta fexp Zceil x)).
-intros H; destruct H.
+destruct (Rle_or_lt 0 x) as [H|H].
 apply Rle_trans with (1:=error_le_half_ulp _ _).
 apply Rmult_le_compat_l.
 apply Rlt_le, pos_half_prf.
 apply ulp_le_pos; trivial.
-case (Rle_or_lt 0 x); trivial.
-intros H1; contradict H.
-apply Rle_not_lt.
-apply round_le_generic...
-apply generic_format_0.
-now left.
 rewrite Hx; apply (round_UP_pt beta fexp x).
-rewrite Hx in Hfx; contradict Hfx; auto with real.
-intros H.
 rewrite Hx at 2; rewrite <- (ulp_opp (round beta fexp Zceil x)).
 rewrite <- round_DN_opp.
 rewrite ulp_DN; trivial.
@@ -2002,7 +1952,9 @@ rewrite round_N_opp.
 unfold Rminus.
 rewrite <- Ropp_plus_distr, Rabs_Ropp.
 apply error_le_half_ulp.
-rewrite round_DN_opp; apply Ropp_0_gt_lt_contravar; apply Rlt_gt; assumption.
+rewrite <- Ropp_0.
+apply Ropp_le_contravar.
+now apply Rlt_le.
 Qed.
 
 Theorem pred_le :
@@ -2011,18 +1963,22 @@ Theorem pred_le :
 Proof.
 intros x y Fx Fy [Hxy| ->].
 2: apply Rle_refl.
-apply le_pred_lt with (2 := Fy).
+apply pred_ge_gt with (2 := Fy).
 now apply generic_format_pred.
 apply Rle_lt_trans with (2 := Hxy).
 apply pred_le_id.
 Qed.
 
-Theorem succ_le: forall x y,
-   F x -> F y -> (x <= y)%R -> (succ x <= succ y)%R.
+Theorem succ_le :
+  forall x y, F x -> F y -> (x <= y)%R ->
+  (succ x <= succ y)%R.
 Proof.
 intros x y Fx Fy Hxy.
-rewrite 2!succ_eq_opp_pred_opp.
-apply Ropp_le_contravar, pred_le; try apply generic_format_opp; try assumption.
+apply Ropp_le_cancel.
+rewrite <- 2!pred_opp.
+apply pred_le.
+now apply generic_format_opp.
+now apply generic_format_opp.
 now apply Ropp_le_contravar.
 Qed.
 
@@ -2064,8 +2020,95 @@ apply Rgt_not_le with (1 := Hxy).
 now apply succ_le_inv.
 Qed.
 
-(* was lt_UP_le_DN *)
-Theorem le_round_DN_lt_UP :
+(** Adding [ulp] is a, somewhat reasonable, overapproximation of [succ]. *)
+Lemma succ_le_plus_ulp :
+  forall { Hm : Monotone_exp fexp } x,
+  (succ x <= x + ulp x)%R.
+Proof.
+intros Mexp x.
+destruct (Rle_or_lt 0 x) as [Px|Nx]; [now right; apply succ_eq_pos|].
+replace (_ + _)%R with (- (-x - ulp x))%R by ring.
+unfold succ; rewrite (Rle_bool_false _ _ Nx), <-ulp_opp.
+apply Ropp_le_contravar; unfold pred_pos.
+destruct (Req_dec (-x) (bpow (mag beta (-x) - 1))) as [Hx|Hx].
+{ rewrite (Req_bool_true _ _ Hx).
+   apply (Rplus_le_reg_r x); ring_simplify; apply Ropp_le_contravar.
+   unfold ulp; rewrite Req_bool_false; [|lra].
+   apply bpow_le, Mexp; lia. }
+ now rewrite (Req_bool_false _ _ Hx); right.
+Qed.
+
+(** And it also lies in the format. *)
+Lemma generic_format_plus_ulp :
+  forall { Hm : Monotone_exp fexp } x,
+  generic_format beta fexp x ->
+  generic_format beta fexp (x + ulp x).
+Proof.
+intros Mexp x Fx.
+destruct (Rle_or_lt 0 x) as [Px|Nx].
+{ now rewrite <-(succ_eq_pos _ Px); apply generic_format_succ. }
+apply generic_format_opp in Fx.
+replace (_ + _)%R with (- (-x - ulp x))%R by ring.
+apply generic_format_opp; rewrite <-ulp_opp.
+destruct (Req_dec (-x) (bpow (mag beta (-x) - 1))) as [Hx|Hx].
+{ unfold ulp; rewrite Req_bool_false; [|lra].
+  rewrite Hx at 1.
+  unfold cexp.
+  set (e := mag _ _).
+  assert (Hfe : (fexp e < e)%Z).
+  { now apply mag_generic_gt; [|lra|]. }
+  replace (e - 1)%Z with (e - 1 - fexp e + fexp e)%Z by ring.
+  rewrite bpow_plus.
+  set (m := bpow (_ - _)).
+  replace (_ - _)%R with ((m - 1) * bpow (fexp e))%R; [|unfold m; ring].
+  case_eq (e - 1 - fexp e)%Z.
+  { intro He; unfold m; rewrite He; simpl; ring_simplify (1 - 1)%R.
+    rewrite Rmult_0_l; apply generic_format_0. }
+  { intros p Hp; unfold m; rewrite Hp; simpl.
+    pose (f := {| Defs.Fnum := (Z.pow_pos beta p - 1)%Z;
+                  Defs.Fexp := fexp e |} : Defs.float beta).
+    apply (generic_format_F2R' _ _ _ f); [|intro Hm'; unfold f; simpl].
+    { now unfold Defs.F2R; simpl; rewrite minus_IZR. }
+    unfold cexp.
+    replace (IZR _) with (bpow (Z.pos p)); [|now simpl].
+    rewrite <-Hp.
+    assert (He : (1 <= e - 1 - fexp e)%Z); [lia|].
+    set (e' := mag _ (_ * _)).
+    assert (H : (e' = e - 1 :> Z)%Z); [|rewrite H; apply Mexp; lia].
+    unfold e'; apply mag_unique.
+    rewrite Rabs_mult, (Rabs_pos_eq (bpow _)); [|apply bpow_ge_0].
+    rewrite Rabs_pos_eq;
+      [|apply (Rplus_le_reg_r 1); ring_simplify;
+        change 1%R with (bpow 0); apply bpow_le; lia].
+    assert (beta_pos : (0 < IZR beta)%R).
+    { apply (Rlt_le_trans _ 2); [lra|].
+      apply IZR_le, Z.leb_le, radix_prop. }
+    split.
+    { replace (e - 1 - 1)%Z with (e - 1 - fexp e + -1  + fexp e)%Z by ring.
+      rewrite bpow_plus.
+      apply Rmult_le_compat_r; [apply bpow_ge_0|].
+      rewrite bpow_plus; simpl; unfold Z.pow_pos; simpl.
+      rewrite Zmult_1_r.
+      apply (Rmult_le_reg_r _ _ _ beta_pos).
+      rewrite Rmult_assoc, Rinv_l; [|lra]; rewrite Rmult_1_r.
+      apply (Rplus_le_reg_r (IZR beta)); ring_simplify.
+      apply (Rle_trans _ (2 * bpow (e - 1 - fexp e))).
+      { change 2%R with (1 + 1)%R; rewrite Rmult_plus_distr_r, Rmult_1_l.
+        apply Rplus_le_compat_l.
+        rewrite <-bpow_1; apply bpow_le; lia. }
+      rewrite Rmult_comm; apply Rmult_le_compat_l; [apply bpow_ge_0|].
+      apply IZR_le, Z.leb_le, radix_prop. }
+    apply (Rmult_lt_reg_r (bpow (- fexp e))); [apply bpow_gt_0|].
+    rewrite Rmult_assoc, <-!bpow_plus.
+    replace (fexp e + - fexp e)%Z with 0%Z by ring; simpl.
+    rewrite Rmult_1_r; unfold Zminus; lra. }
+  intros p Hp; exfalso; lia. }
+replace (_ - _)%R with (pred_pos (-x)).
+{ now apply generic_format_pred_pos; [|lra]. }
+now unfold pred_pos; rewrite Req_bool_false.
+Qed.
+
+Theorem round_DN_ge_UP_gt :
   forall x y, F y ->
   (y < round beta fexp Zceil x -> y <= round beta fexp Zfloor x)%R.
 Proof with auto with typeclass_instances.
@@ -2078,10 +2121,9 @@ apply round_UP_pt...
 now apply Rlt_le.
 Qed.
 
-(* was lt_DN_le_UP *)
-Theorem round_UP_le_gt_DN :
+Theorem round_UP_le_DN_lt :
   forall x y, F y ->
-   (round beta fexp Zfloor x < y -> round beta fexp Zceil x <= y)%R.
+  (round beta fexp Zfloor x < y -> round beta fexp Zceil x <= y)%R.
 Proof with auto with typeclass_instances.
 intros x y Fy Hlt.
 apply round_UP_pt...
@@ -2092,8 +2134,6 @@ apply round_DN_pt...
 now apply Rlt_le.
 Qed.
 
-
-
 Theorem pred_UP_le_DN :
   forall x, (pred (round beta fexp Zceil x) <= round beta fexp Zfloor x)%R.
 Proof with auto with typeclass_instances.
@@ -2115,16 +2155,26 @@ absurd (round beta fexp Zceil x <= - bpow (fexp n))%R.
 apply Rlt_not_le.
 rewrite Zx, <- Ropp_0.
 apply Ropp_lt_contravar, bpow_gt_0.
-apply round_UP_le_gt_DN; try assumption.
+apply round_UP_le_DN_lt; try assumption.
 apply generic_format_opp, generic_format_bpow.
 now apply valid_exp.
 assert (let u := round beta fexp Zceil x in pred u < u)%R as Hup.
 now apply pred_lt_id.
-apply le_round_DN_lt_UP...
+apply round_DN_ge_UP_gt...
 apply generic_format_pred...
 now apply round_UP_pt.
 Qed.
 
+Theorem UP_le_succ_DN :
+  forall x, (round beta fexp Zceil x <= succ (round beta fexp Zfloor x))%R.
+Proof.
+intros x.
+rewrite <- (Ropp_involutive x).
+rewrite round_DN_opp, round_UP_opp, succ_opp.
+apply Ropp_le_contravar.
+apply pred_UP_le_DN.
+Qed.
+
 Theorem pred_UP_eq_DN :
   forall x,  ~ F x ->
   (pred (round beta fexp Zceil x) = round beta fexp Zfloor x)%R.
@@ -2132,7 +2182,7 @@ Proof with auto with typeclass_instances.
 intros x Fx.
 apply Rle_antisym.
 now apply pred_UP_le_DN.
-apply le_pred_lt; try apply generic_format_round...
+apply pred_ge_gt; try apply generic_format_round...
 pose proof round_DN_UP_lt _ _ _ Fx as HE.
 now apply Rlt_trans with (1 := proj1 HE) (2 := proj2 HE).
 Qed.
@@ -2147,11 +2197,9 @@ rewrite succ_pred; trivial.
 apply generic_format_round...
 Qed.
 
-
-(* was betw_eq_DN *)
-Theorem round_DN_eq_betw: forall x d, F d
-     -> (d <= x < succ d)%R
-        -> round beta fexp Zfloor x = d.
+Theorem round_DN_eq :
+  forall x d, F d -> (d <= x < succ d)%R ->
+  round beta fexp Zfloor x = d.
 Proof with auto with typeclass_instances.
 intros x d Fd (Hxd1,Hxd2).
 generalize (round_DN_pt beta fexp x); intros (T1,(T2,T3)).
@@ -2169,25 +2217,161 @@ apply generic_format_succ...
 now left.
 Qed.
 
-(* was betw_eq_UP *)
-Theorem round_UP_eq_betw: forall x u, F u
-    -> (pred u < x <= u)%R
-    -> round beta fexp Zceil x = u.
+Theorem round_UP_eq :
+  forall x u, F u -> (pred u < x <= u)%R ->
+  round beta fexp Zceil x = u.
 Proof with auto with typeclass_instances.
 intros x u Fu Hux.
 rewrite <- (Ropp_involutive (round beta fexp Zceil x)).
 rewrite <- round_DN_opp.
 rewrite <- (Ropp_involutive u).
 apply f_equal.
-apply round_DN_eq_betw; try assumption.
+apply round_DN_eq; try assumption.
 now apply generic_format_opp.
 split;[now apply Ropp_le_contravar|idtac].
 rewrite succ_opp.
 now apply Ropp_lt_contravar.
 Qed.
 
+Lemma ulp_ulp_0 : forall {H : Exp_not_FTZ fexp},
+  ulp (ulp 0) = ulp 0.
+Proof.
+intros H; case (negligible_exp_spec').
+intros (K1,K2).
+replace (ulp 0) with 0%R at 1; try easy.
+apply sym_eq; unfold ulp; rewrite Req_bool_true; try easy.
+now rewrite K1.
+intros (n,(Hn1,Hn2)).
+apply Rle_antisym.
+replace (ulp 0) with (bpow (fexp n)).
+rewrite ulp_bpow.
+apply bpow_le.
+now apply valid_exp.
+unfold ulp; rewrite Req_bool_true; try easy.
+rewrite Hn1; easy.
+now apply ulp_ge_ulp_0.
+Qed.
 
 
+Lemma ulp_succ_pos : forall x, F x -> (0 < x)%R ->
+   ulp (succ x) = ulp x \/ succ x = bpow (mag beta x).
+Proof with auto with typeclass_instances.
+intros x Fx Hx.
+generalize (Rlt_le _ _ Hx); intros Hx'.
+rewrite succ_eq_pos;[idtac|now left].
+destruct (mag beta x) as (e,He); simpl.
+rewrite Rabs_pos_eq in He; try easy.
+specialize (He (Rgt_not_eq _ _ Hx)).
+assert (H:(x+ulp x <= bpow e)%R).
+apply id_p_ulp_le_bpow; try assumption.
+apply He.
+destruct H;[left|now right].
+rewrite ulp_neq_0 at 1.
+2: apply Rgt_not_eq, Rgt_lt, Rlt_le_trans with x...
+2: rewrite <- (Rplus_0_r x) at 1; apply Rplus_le_compat_l.
+2: apply ulp_ge_0.
+rewrite ulp_neq_0 at 2.
+2: now apply Rgt_not_eq.
+f_equal; unfold cexp; f_equal.
+apply trans_eq with e.
+apply mag_unique_pos; split; try assumption.
+apply Rle_trans with (1:=proj1 He).
+rewrite <- (Rplus_0_r x) at 1; apply Rplus_le_compat_l.
+apply ulp_ge_0.
+now apply sym_eq, mag_unique_pos.
+Qed.
+
+
+Lemma ulp_round_pos :
+  forall { Not_FTZ_ : Exp_not_FTZ fexp},
+   forall rnd { Zrnd : Valid_rnd rnd } x,
+  (0 < x)%R -> ulp (round beta fexp rnd x) = ulp x
+     \/ round beta fexp rnd x = bpow (mag beta x).
+Proof with auto with typeclass_instances.
+intros Not_FTZ_ rnd Zrnd x Hx.
+case (generic_format_EM beta fexp x); intros Fx.
+rewrite round_generic...
+case (round_DN_or_UP beta fexp rnd x); intros Hr; rewrite Hr.
+left.
+apply ulp_DN; now left...
+assert (M:(0 <= round beta fexp Zfloor x)%R).
+apply round_ge_generic...
+apply generic_format_0...
+apply Rlt_le...
+destruct M as [M|M].
+rewrite <- (succ_DN_eq_UP x)...
+case (ulp_succ_pos (round beta fexp Zfloor x)); try intros Y.
+apply generic_format_round...
+assumption.
+rewrite ulp_DN in Y...
+now apply Rlt_le.
+right; rewrite Y.
+apply f_equal, mag_DN...
+left; rewrite <- (succ_DN_eq_UP x)...
+rewrite <- M, succ_0.
+rewrite ulp_ulp_0...
+case (negligible_exp_spec').
+intros (K1,K2).
+absurd (x = 0)%R.
+now apply Rgt_not_eq.
+apply eq_0_round_0_negligible_exp with Zfloor...
+intros (n,(Hn1,Hn2)).
+replace (ulp 0) with (bpow (fexp n)).
+2: unfold ulp; rewrite Req_bool_true; try easy.
+2: now rewrite Hn1.
+rewrite ulp_neq_0.
+2: apply Rgt_not_eq...
+unfold cexp; f_equal.
+destruct (mag beta x) as (e,He); simpl.
+apply sym_eq, valid_exp...
+assert (e <= fexp e)%Z.
+apply exp_small_round_0_pos with beta Zfloor x...
+rewrite <- (Rabs_pos_eq x).
+apply He, Rgt_not_eq...
+apply Rlt_le...
+replace (fexp n) with (fexp e); try assumption.
+now apply fexp_negligible_exp_eq.
+Qed.
+
+
+Theorem ulp_round : forall { Not_FTZ_ : Exp_not_FTZ fexp},
+   forall rnd { Zrnd : Valid_rnd rnd } x,
+     ulp (round beta fexp rnd x) = ulp x
+         \/ Rabs (round beta fexp rnd x) = bpow (mag beta x).
+Proof with auto with typeclass_instances.
+intros Not_FTZ_ rnd Zrnd x.
+case (Rtotal_order x 0); intros Zx.
+case (ulp_round_pos (Zrnd_opp rnd) (-x)).
+now apply Ropp_0_gt_lt_contravar.
+rewrite ulp_opp, <- ulp_opp.
+rewrite <- round_opp, Ropp_involutive.
+intros Y;now left.
+rewrite mag_opp.
+intros Y; right.
+rewrite <- (Ropp_involutive x) at 1.
+rewrite round_opp, Y.
+rewrite Rabs_Ropp, Rabs_right...
+apply Rle_ge, bpow_ge_0.
+destruct Zx as [Zx|Zx].
+left; rewrite Zx; rewrite round_0...
+rewrite Rabs_right.
+apply ulp_round_pos...
+apply Rle_ge, round_ge_generic...
+apply generic_format_0...
+now apply Rlt_le.
+Qed.
+
+Lemma succ_round_ge_id :
+  forall rnd { Zrnd : Valid_rnd rnd } x,
+  (x <= succ (round beta fexp rnd x))%R.
+Proof.
+intros rnd Vrnd x.
+apply (Rle_trans _ (round beta fexp Raux.Zceil x)).
+{ now apply round_UP_pt. }
+destruct (round_DN_or_UP beta fexp rnd x) as [Hr|Hr]; rewrite Hr.
+{ now apply UP_le_succ_DN. }
+apply succ_ge_id.
+Qed.
 
 (** Properties of rounding to nearest and ulp *)
 
@@ -2215,14 +2399,14 @@ assert (T: (u < (u + succ u) / 2 < succ u)%R) by lra.
 destruct T as (T1,T2).
 apply Rnd_N_pt_monotone with F v ((u + succ u) / 2)%R...
 apply round_N_pt...
-apply Rnd_DN_pt_N with (succ u)%R.
+apply Rnd_N_pt_DN with (succ u)%R.
 pattern u at 3; replace u with (round beta fexp Zfloor ((u + succ u) / 2)).
 apply round_DN_pt...
-apply round_DN_eq_betw; trivial.
+apply round_DN_eq; trivial.
 split; try left; assumption.
 pattern (succ u) at 2; replace (succ u) with (round beta fexp Zceil ((u + succ u) / 2)).
 apply round_UP_pt...
-apply round_UP_eq_betw; trivial.
+apply round_UP_eq; trivial.
 apply generic_format_succ...
 rewrite pred_succ; trivial.
 split; try left; assumption.
@@ -2275,12 +2459,12 @@ Lemma round_N_eq_DN_pt: forall choice x d u,
 Proof with auto with typeclass_instances.
 intros choice x d u Hd Hu H.
 assert (H0:(d = round beta fexp Zfloor x)%R).
-apply Rnd_DN_pt_unicity with (1:=Hd).
+apply Rnd_DN_pt_unique with (1:=Hd).
 apply round_DN_pt...
 rewrite H0.
 apply round_N_eq_DN.
 rewrite <- H0.
-rewrite Rnd_UP_pt_unicity with F x (round beta fexp Zceil x) u; try assumption.
+rewrite Rnd_UP_pt_unique with F x (round beta fexp Zceil x) u; try assumption.
 apply round_UP_pt...
 Qed.
 
@@ -2310,13 +2494,28 @@ Lemma round_N_eq_UP_pt: forall choice x d u,
 Proof with auto with typeclass_instances.
 intros choice x d u Hd Hu H.
 assert (H0:(u = round beta fexp Zceil x)%R).
-apply Rnd_UP_pt_unicity with (1:=Hu).
+apply Rnd_UP_pt_unique with (1:=Hu).
 apply round_UP_pt...
 rewrite H0.
 apply round_N_eq_UP.
 rewrite <- H0.
-rewrite Rnd_DN_pt_unicity with F x (round beta fexp Zfloor x) d; try assumption.
+rewrite Rnd_DN_pt_unique with F x (round beta fexp Zfloor x) d; try assumption.
 apply round_DN_pt...
 Qed.
 
+Lemma round_N_plus_ulp_ge :
+  forall { Hm : Monotone_exp fexp } choice1 choice2 x,
+  let rx := round beta fexp (Znearest choice2) x in
+  (x <= round beta fexp (Znearest choice1) (rx + ulp rx))%R.
+Proof.
+intros Hm choice1 choice2 x.
+simpl.
+set (rx := round _ _ _ x).
+assert (Vrnd1 : Valid_rnd (Znearest choice1)) by now apply valid_rnd_N.
+assert (Vrnd2 : Valid_rnd (Znearest choice2)) by now apply valid_rnd_N.
+apply (Rle_trans _ (succ rx)); [now apply succ_round_ge_id|].
+rewrite round_generic; [now apply succ_le_plus_ulp|now simpl|].
+now apply generic_format_plus_ulp, generic_format_round.
+Qed.
+
 End Fcore_ulp.
diff --git a/flocq/Core/Fcore_Zaux.v b/flocq/Core/Zaux.v
index f6731b4c..e21d93a4 100644
--- a/flocq/Core/Fcore_Zaux.v
+++ b/flocq/Core/Zaux.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2011-2013 Sylvie Boldo
+Copyright (C) 2011-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2011-2013 Guillaume Melquiond
+Copyright (C) 2011-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -17,7 +17,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 COPYING file for more details.
 *)
 
-Require Import ZArith.
+Require Import ZArith Omega.
 Require Import Zquot.
 
 Section Zmissing.
@@ -25,7 +25,7 @@ Section Zmissing.
 (** About Z *)
 Theorem Zopp_le_cancel :
   forall x y : Z,
-  (-y <= -x)%Z -> Zle x y.
+  (-y <= -x)%Z -> Z.le x y.
 Proof.
 intros x y Hxy.
 apply Zplus_le_reg_r with (-x - y)%Z.
@@ -37,7 +37,7 @@ Theorem Zgt_not_eq :
   (y < x)%Z -> (x <> y)%Z.
 Proof.
 intros x y H Hn.
-apply Zlt_irrefl with x.
+apply Z.lt_irrefl with x.
 now rewrite Hn at 1.
 Qed.
 
@@ -69,29 +69,8 @@ End Proof_Irrelevance.
 
 Section Even_Odd.
 
-(** Zeven, used for rounding to nearest, ties to even *)
-Definition Zeven (n : Z) :=
-  match n with
-  | Zpos (xO _) => true
-  | Zneg (xO _) => true
-  | Z0 => true
-  | _ => false
-  end.
-
-Theorem Zeven_mult :
-  forall x y, Zeven (x * y) = orb (Zeven x) (Zeven y).
-Proof.
-now intros [|[xp|xp|]|[xp|xp|]] [|[yp|yp|]|[yp|yp|]].
-Qed.
-
-Theorem Zeven_opp :
-  forall x, Zeven (- x) = Zeven x.
-Proof.
-now intros [|[n|n|]|[n|n|]].
-Qed.
-
 Theorem Zeven_ex :
-  forall x, exists p, x = (2 * p + if Zeven x then 0 else 1)%Z.
+  forall x, exists p, x = (2 * p + if Z.even x then 0 else 1)%Z.
 Proof.
 intros [|[n|n|]|[n|n|]].
 now exists Z0.
@@ -105,37 +84,6 @@ now exists (Zneg n).
 now exists (-1)%Z.
 Qed.
 
-Theorem Zeven_2xp1 :
-  forall n, Zeven (2 * n + 1) = false.
-Proof.
-intros n.
-destruct (Zeven_ex (2 * n + 1)) as (p, Hp).
-revert Hp.
-case (Zeven (2 * n + 1)) ; try easy.
-intros H.
-apply False_ind.
-omega.
-Qed.
-
-Theorem Zeven_plus :
-  forall x y, Zeven (x + y) = Bool.eqb (Zeven x) (Zeven y).
-Proof.
-intros x y.
-destruct (Zeven_ex x) as (px, Hx).
-rewrite Hx at 1.
-destruct (Zeven_ex y) as (py, Hy).
-rewrite Hy at 1.
-replace (2 * px + (if Zeven x then 0 else 1) + (2 * py + (if Zeven y then 0 else 1)))%Z
-  with (2 * (px + py) + ((if Zeven x then 0 else 1) + (if Zeven y then 0 else 1)))%Z by ring.
-case (Zeven x) ; case (Zeven y).
-rewrite Zplus_0_r.
-now rewrite Zeven_mult.
-apply Zeven_2xp1.
-apply Zeven_2xp1.
-replace (2 * (px + py) + (1 + 1))%Z with (2 * (px + py + 1))%Z by ring.
-now rewrite Zeven_mult.
-Qed.
-
 End Even_Odd.
 
 Section Zpower.
@@ -145,12 +93,12 @@ Theorem Zpower_plus :
   Zpower n (k1 + k2) = (Zpower n k1 * Zpower n k2)%Z.
 Proof.
 intros n k1 k2 H1 H2.
-now apply Zpower_exp ; apply Zle_ge.
+now apply Zpower_exp ; apply Z.le_ge.
 Qed.
 
 Theorem Zpower_Zpower_nat :
   forall b e, (0 <= e)%Z ->
-  Zpower b e = Zpower_nat b (Zabs_nat e).
+  Zpower b e = Zpower_nat b (Z.abs_nat e).
 Proof.
 intros b [|e|e] He.
 apply refl_equal.
@@ -181,40 +129,14 @@ rewrite Zpower_nat_S.
 now apply Zmult_lt_0_compat.
 Qed.
 
-Theorem Zeven_Zpower :
-  forall b e, (0 < e)%Z ->
-  Zeven (Zpower b e) = Zeven b.
-Proof.
-intros b e He.
-case_eq (Zeven b) ; intros Hb.
-(* b even *)
-replace e with (e - 1 + 1)%Z by ring.
-rewrite Zpower_exp.
-rewrite Zeven_mult.
-replace (Zeven (b ^ 1)) with true.
-apply Bool.orb_true_r.
-unfold Zpower, Zpower_pos. simpl.
-now rewrite Zmult_1_r.
-omega.
-discriminate.
-(* b odd *)
-rewrite Zpower_Zpower_nat.
-induction (Zabs_nat e).
-easy.
-unfold Zpower_nat. simpl.
-rewrite Zeven_mult.
-now rewrite Hb.
-now apply Zlt_le_weak.
-Qed.
-
 Theorem Zeven_Zpower_odd :
-  forall b e, (0 <= e)%Z -> Zeven b = false ->
-  Zeven (Zpower b e) = false.
+  forall b e, (0 <= e)%Z -> Z.even b = false ->
+  Z.even (Zpower b e) = false.
 Proof.
 intros b e He Hb.
 destruct (Z_le_lt_eq_dec _ _ He) as [He'|He'].
 rewrite <- Hb.
-now apply Zeven_Zpower.
+now apply Z.even_pow.
 now rewrite <- He'.
 Qed.
 
@@ -239,7 +161,7 @@ Variable r : radix.
 
 Theorem radix_gt_0 : (0 < r)%Z.
 Proof.
-apply Zlt_le_trans with 2%Z.
+apply Z.lt_le_trans with 2%Z.
 easy.
 apply Zle_bool_imp_le.
 apply r.
@@ -248,7 +170,7 @@ Qed.
 Theorem radix_gt_1 : (1 < r)%Z.
 Proof.
 destruct r as (v, Hr). simpl.
-apply Zlt_le_trans with 2%Z.
+apply Z.lt_le_trans with 2%Z.
 easy.
 now apply Zle_bool_imp_le.
 Qed.
@@ -273,7 +195,7 @@ easy.
 rewrite Zpower_nat_S.
 apply Zmult_lt_0_compat with (2 := IHn).
 apply radix_gt_0.
-apply Zle_lt_trans with (1 * Zpower_nat r n)%Z.
+apply Z.le_lt_trans with (1 * Zpower_nat r n)%Z.
 rewrite Zmult_1_l.
 now apply (Zlt_le_succ 0).
 apply Zmult_lt_compat_r with (1 := H).
@@ -287,7 +209,7 @@ Theorem Zpower_gt_0 :
 Proof.
 intros p Hp.
 rewrite Zpower_Zpower_nat with (1 := Hp).
-induction (Zabs_nat p).
+induction (Z.abs_nat p).
 easy.
 rewrite Zpower_nat_S.
 apply Zmult_lt_0_compat with (2 := IHn).
@@ -336,7 +258,7 @@ rewrite <- (Zmult_1_r (r ^ e1)) at 1.
 apply Zmult_lt_compat2.
 split.
 now apply Zpower_gt_0.
-apply Zle_refl.
+apply Z.le_refl.
 split.
 easy.
 apply Zpower_gt_1.
@@ -363,6 +285,36 @@ apply Zpower_le.
 clear -H ; omega.
 Qed.
 
+Theorem Zpower_gt_id :
+  forall n, (n < Zpower r n)%Z.
+Proof.
+intros [|n|n] ; try easy.
+simpl.
+rewrite Zpower_pos_nat.
+rewrite Zpos_eq_Z_of_nat_o_nat_of_P.
+induction (nat_of_P n).
+easy.
+rewrite inj_S.
+change (Zpower_nat r (S n0)) with (r * Zpower_nat r n0)%Z.
+unfold Z.succ.
+apply Z.lt_le_trans with (r * (Z_of_nat n0 + 1))%Z.
+clear.
+apply Zlt_0_minus_lt.
+replace (r * (Z_of_nat n0 + 1) - (Z_of_nat n0 + 1))%Z with ((r - 1) * (Z_of_nat n0 + 1))%Z by ring.
+apply Zmult_lt_0_compat.
+cut (2 <= r)%Z. omega.
+apply Zle_bool_imp_le.
+apply r.
+apply (Zle_lt_succ 0).
+apply Zle_0_nat.
+apply Zmult_le_compat_l.
+now apply Zlt_le_succ.
+apply Z.le_trans with 2%Z.
+easy.
+apply Zle_bool_imp_le.
+apply r.
+Qed.
+
 End Zpower.
 
 Section Div_Mod.
@@ -380,7 +332,7 @@ rewrite Zopp_mult_distr_l.
 apply Z_mod_plus.
 easy.
 apply Zmult_gt_0_compat.
-now apply Zlt_gt.
+now apply Z.lt_gt.
 easy.
 now elim Hb.
 Qed.
@@ -411,7 +363,7 @@ Qed.
 
 Theorem Zdiv_mod_mult :
   forall n a b, (0 <= a)%Z -> (0 <= b)%Z ->
-  (Zdiv (Zmod n (a * b)) a) = Zmod (Zdiv n a) b.
+  (Z.div (Zmod n (a * b)) a) = Zmod (Z.div n a) b.
 Proof.
 intros n a b Ha Hb.
 destruct (Zle_lt_or_eq _ _ Ha) as [Ha'|Ha'].
@@ -421,12 +373,12 @@ rewrite (Zmult_comm a b) at 2.
 rewrite Zmult_assoc.
 unfold Zminus.
 rewrite Zopp_mult_distr_l.
-rewrite Z_div_plus by now apply Zlt_gt.
+rewrite Z_div_plus by now apply Z.lt_gt.
 rewrite <- Zdiv_Zdiv by easy.
 apply sym_eq.
 apply Zmod_eq.
-now apply Zlt_gt.
-now apply Zmult_gt_0_compat ; apply Zlt_gt.
+now apply Z.lt_gt.
+now apply Zmult_gt_0_compat ; apply Z.lt_gt.
 rewrite <- Hb'.
 rewrite Zmult_0_r, 2!Zmod_0_r.
 apply Zdiv_0_l.
@@ -439,7 +391,7 @@ Theorem ZOdiv_mod_mult :
   (Z.quot (Z.rem n (a * b)) a) = Z.rem (Z.quot n a) b.
 Proof.
 intros n a b.
-destruct (Z_eq_dec a 0) as [Za|Za].
+destruct (Z.eq_dec a 0) as [Za|Za].
 rewrite Za.
 now rewrite 2!Zquot_0_r, Zrem_0_l.
 assert (Z.rem n (a * b) = n + - (Z.quot (Z.quot n a) b * b) * a)%Z.
@@ -456,34 +408,34 @@ Qed.
 
 Theorem ZOdiv_small_abs :
   forall a b,
-  (Zabs a < b)%Z -> Z.quot a b = Z0.
+  (Z.abs a < b)%Z -> Z.quot a b = Z0.
 Proof.
 intros a b Ha.
 destruct (Zle_or_lt 0 a) as [H|H].
-apply Zquot_small.
+apply Z.quot_small.
 split.
 exact H.
-now rewrite Zabs_eq in Ha.
-apply Zopp_inj.
-rewrite <- Zquot_opp_l, Zopp_0.
-apply Zquot_small.
+now rewrite Z.abs_eq in Ha.
+apply Z.opp_inj.
+rewrite <- Zquot_opp_l, Z.opp_0.
+apply Z.quot_small.
 generalize (Zabs_non_eq a).
 omega.
 Qed.
 
 Theorem ZOmod_small_abs :
   forall a b,
-  (Zabs a < b)%Z -> Z.rem a b = a.
+  (Z.abs a < b)%Z -> Z.rem a b = a.
 Proof.
 intros a b Ha.
 destruct (Zle_or_lt 0 a) as [H|H].
-apply Zrem_small.
+apply Z.rem_small.
 split.
 exact H.
-now rewrite Zabs_eq in Ha.
-apply Zopp_inj.
+now rewrite Z.abs_eq in Ha.
+apply Z.opp_inj.
 rewrite <- Zrem_opp_l.
-apply Zrem_small.
+apply Z.rem_small.
 generalize (Zabs_non_eq a).
 omega.
 Qed.
@@ -493,7 +445,7 @@ Theorem ZOdiv_plus :
   (Z.quot (a + b) c = Z.quot a c + Z.quot b c + Z.quot (Z.rem a c + Z.rem b c) c)%Z.
 Proof.
 intros a b c Hab.
-destruct (Z_eq_dec c 0) as [Zc|Zc].
+destruct (Z.eq_dec c 0) as [Zc|Zc].
 now rewrite Zc, 4!Zquot_0_r.
 apply Zmult_reg_r with (1 := Zc).
 rewrite 2!Zmult_plus_distr_l.
@@ -632,8 +584,8 @@ Proof.
 intros x y Hxy.
 generalize (Zle_cases x y).
 case Zle_bool ; intros H.
-elim (Zlt_irrefl x).
-now apply Zle_lt_trans with y.
+elim (Z.lt_irrefl x).
+now apply Z.le_lt_trans with y.
 apply refl_equal.
 Qed.
 
@@ -672,8 +624,8 @@ Proof.
 intros x y Hxy.
 generalize (Zlt_cases x y).
 case Zlt_bool ; intros H.
-elim (Zlt_irrefl x).
-now apply Zlt_le_trans with y.
+elim (Z.lt_irrefl x).
+now apply Z.lt_le_trans with y.
 apply refl_equal.
 Qed.
 
@@ -707,32 +659,32 @@ Inductive Zcompare_prop (x y : Z) : comparison -> Prop :=
   | Zcompare_Gt_ : (y < x)%Z -> Zcompare_prop x y Gt.
 
 Theorem Zcompare_spec :
-  forall x y, Zcompare_prop x y (Zcompare x y).
+  forall x y, Zcompare_prop x y (Z.compare x y).
 Proof.
 intros x y.
 destruct (Z_dec x y) as [[H|H]|H].
 generalize (Zlt_compare _ _ H).
-case (Zcompare x y) ; try easy.
+case (Z.compare x y) ; try easy.
 now constructor.
 generalize (Zgt_compare _ _ H).
-case (Zcompare x y) ; try easy.
+case (Z.compare x y) ; try easy.
 constructor.
-now apply Zgt_lt.
+now apply Z.gt_lt.
 generalize (proj2 (Zcompare_Eq_iff_eq _ _) H).
-case (Zcompare x y) ; try easy.
+case (Z.compare x y) ; try easy.
 now constructor.
 Qed.
 
 Theorem Zcompare_Lt :
   forall x y,
-  (x < y)%Z -> Zcompare x y = Lt.
+  (x < y)%Z -> Z.compare x y = Lt.
 Proof.
 easy.
 Qed.
 
 Theorem Zcompare_Eq :
   forall x y,
-  (x = y)%Z -> Zcompare x y = Eq.
+  (x = y)%Z -> Z.compare x y = Eq.
 Proof.
 intros x y.
 apply <- Zcompare_Eq_iff_eq.
@@ -740,21 +692,29 @@ Qed.
 
 Theorem Zcompare_Gt :
   forall x y,
-  (y < x)%Z -> Zcompare x y = Gt.
+  (y < x)%Z -> Z.compare x y = Gt.
 Proof.
 intros x y.
-apply Zlt_gt.
+apply Z.lt_gt.
 Qed.
 
 End Zcompare.
 
 Section cond_Zopp.
 
-Definition cond_Zopp (b : bool) m := if b then Zopp m else m.
+Definition cond_Zopp (b : bool) m := if b then Z.opp m else m.
+
+Theorem cond_Zopp_negb :
+  forall x y, cond_Zopp (negb x) y = Z.opp (cond_Zopp x y).
+Proof.
+intros [|] y.
+apply sym_eq, Z.opp_involutive.
+easy.
+Qed.
 
 Theorem abs_cond_Zopp :
   forall b m,
-  Zabs (cond_Zopp b m) = Zabs m.
+  Z.abs (cond_Zopp b m) = Z.abs m.
 Proof.
 intros [|] m.
 apply Zabs_Zopp.
@@ -763,14 +723,14 @@ Qed.
 
 Theorem cond_Zopp_Zlt_bool :
   forall m,
-  cond_Zopp (Zlt_bool m 0) m = Zabs m.
+  cond_Zopp (Zlt_bool m 0) m = Z.abs m.
 Proof.
 intros m.
 apply sym_eq.
 case Zlt_bool_spec ; intros Hm.
 apply Zabs_non_eq.
 now apply Zlt_le_weak.
-now apply Zabs_eq.
+now apply Z.abs_eq.
 Qed.
 
 End cond_Zopp.
@@ -808,11 +768,11 @@ Section faster_div.
 
 Lemma Zdiv_eucl_unique :
   forall a b,
-  Zdiv_eucl a b = (Zdiv a b, Zmod a b).
+  Z.div_eucl a b = (Z.div a b, Zmod a b).
 Proof.
 intros a b.
-unfold Zdiv, Zmod.
-now case Zdiv_eucl.
+unfold Z.div, Zmod.
+now case Z.div_eucl.
 Qed.
 
 Fixpoint Zpos_div_eucl_aux1 (a b : positive) {struct b} :=
@@ -835,7 +795,7 @@ intros a b.
 revert a.
 induction b ; intros a.
 - easy.
-- change (Z.pos_div_eucl a (Zpos b~0)) with (Zdiv_eucl (Zpos a) (Zpos b~0)).
+- change (Z.pos_div_eucl a (Zpos b~0)) with (Z.div_eucl (Zpos a) (Zpos b~0)).
   rewrite Zdiv_eucl_unique.
   change (Zpos b~0) with (2 * Zpos b)%Z.
   rewrite Z.rem_mul_r by easy.
@@ -843,7 +803,7 @@ induction b ; intros a.
   destruct a as [a|a|].
   + change (Zpos_div_eucl_aux1 a~1 b~0) with (let (q, r) := Zpos_div_eucl_aux1 a b in (q, 2 * r + 1)%Z).
     rewrite IHb. clear IHb.
-    change (Z.pos_div_eucl a (Zpos b)) with (Zdiv_eucl (Zpos a) (Zpos b)).
+    change (Z.pos_div_eucl a (Zpos b)) with (Z.div_eucl (Zpos a) (Zpos b)).
     rewrite Zdiv_eucl_unique.
     change (Zpos a~1) with (1 + 2 * Zpos a)%Z.
     rewrite (Zmult_comm 2 (Zpos a)).
@@ -853,7 +813,7 @@ induction b ; intros a.
     apply Zplus_comm.
   + change (Zpos_div_eucl_aux1 a~0 b~0) with (let (q, r) := Zpos_div_eucl_aux1 a b in (q, 2 * r)%Z).
     rewrite IHb. clear IHb.
-    change (Z.pos_div_eucl a (Zpos b)) with (Zdiv_eucl (Zpos a) (Zpos b)).
+    change (Z.pos_div_eucl a (Zpos b)) with (Z.div_eucl (Zpos a) (Zpos b)).
     rewrite Zdiv_eucl_unique.
     change (Zpos a~0) with (2 * Zpos a)%Z.
     rewrite (Zmult_comm 2 (Zpos a)).
@@ -861,7 +821,7 @@ induction b ; intros a.
     apply f_equal.
     now rewrite Z_mod_mult.
   + easy.
-- change (Z.pos_div_eucl a 1) with (Zdiv_eucl (Zpos a) 1).
+- change (Z.pos_div_eucl a 1) with (Z.div_eucl (Zpos a) 1).
   rewrite Zdiv_eucl_unique.
   now rewrite Zdiv_1_r, Zmod_1_r.
 Qed.
@@ -879,13 +839,13 @@ Lemma Zpos_div_eucl_aux_correct :
 Proof.
 intros a b.
 unfold Zpos_div_eucl_aux.
-change (Z.pos_div_eucl a (Zpos b)) with (Zdiv_eucl (Zpos a) (Zpos b)).
+change (Z.pos_div_eucl a (Zpos b)) with (Z.div_eucl (Zpos a) (Zpos b)).
 rewrite Zdiv_eucl_unique.
 case Pos.compare_spec ; intros H.
 now rewrite H, Z_div_same, Z_mod_same.
 now rewrite Zdiv_small, Zmod_small by (split ; easy).
 rewrite Zpos_div_eucl_aux1_correct.
-change (Z.pos_div_eucl a (Zpos b)) with (Zdiv_eucl (Zpos a) (Zpos b)).
+change (Z.pos_div_eucl a (Zpos b)) with (Z.div_eucl (Zpos a) (Zpos b)).
 apply Zdiv_eucl_unique.
 Qed.
 
@@ -920,7 +880,7 @@ Definition Zfast_div_eucl (a b : Z) :=
 
 Theorem Zfast_div_eucl_correct :
   forall a b : Z,
-  Zfast_div_eucl a b = Zdiv_eucl a b.
+  Zfast_div_eucl a b = Z.div_eucl a b.
 Proof.
 unfold Zfast_div_eucl.
 intros [|a|a] [|b|b] ; try rewrite Zpos_div_eucl_aux_correct ; easy.
diff --git a/flocq/IEEE754/Binary.v b/flocq/IEEE754/Binary.v
new file mode 100644
index 00000000..0ec3a297
--- /dev/null
+++ b/flocq/IEEE754/Binary.v
@@ -0,0 +1,2814 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2018 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2018 Guillaume Melquiond
+
+This library is free software; you can redistribute it and/or
+modify it 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.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+COPYING file for more details.
+*)
+
+(** * IEEE-754 arithmetic *)
+Require Import Core Digits Round Bracket Operations Div Sqrt Relative.
+Require Import Psatz.
+
+Section AnyRadix.
+
+Inductive full_float :=
+  | F754_zero (s : bool)
+  | F754_infinity (s : bool)
+  | F754_nan (s : bool) (m : positive)
+  | F754_finite (s : bool) (m : positive) (e : Z).
+
+Definition FF2R beta x :=
+  match x with
+  | F754_finite s m e => F2R (Float beta (cond_Zopp s (Zpos m)) e)
+  | _ => 0%R
+  end.
+
+End AnyRadix.
+
+Section Binary.
+
+Arguments exist {A} {P}.
+
+(** [prec] is the number of bits of the mantissa including the implicit one;
+    [emax] is the exponent of the infinities.
+    For instance, binary32 is defined by [prec = 24] and [emax = 128]. *)
+Variable prec emax : Z.
+Context (prec_gt_0_ : Prec_gt_0 prec).
+Hypothesis Hmax : (prec < emax)%Z.
+
+Let emin := (3 - emax - prec)%Z.
+Let fexp := FLT_exp emin prec.
+Instance fexp_correct : Valid_exp fexp := FLT_exp_valid emin prec.
+Instance fexp_monotone : Monotone_exp fexp := FLT_exp_monotone emin prec.
+
+Definition canonical_mantissa m e :=
+  Zeq_bool (fexp (Zpos (digits2_pos m) + e)) e.
+
+Definition bounded m e :=
+  andb (canonical_mantissa m e) (Zle_bool e (emax - prec)).
+
+Definition nan_pl pl :=
+  Zlt_bool (Zpos (digits2_pos pl)) prec.
+
+Definition valid_binary x :=
+  match x with
+  | F754_finite _ m e => bounded m e
+  | F754_nan _ pl => nan_pl pl
+  | _ => true
+  end.
+
+(** Basic type used for representing binary FP numbers.
+    Note that there is exactly one such object per FP datum. *)
+
+Inductive binary_float :=
+  | B754_zero (s : bool)
+  | B754_infinity (s : bool)
+  | B754_nan (s : bool) (pl : positive) :
+    nan_pl pl = true -> binary_float
+  | B754_finite (s : bool) (m : positive) (e : Z) :
+    bounded m e = true -> binary_float.
+
+Definition FF2B x :=
+  match x as x return valid_binary x = true -> binary_float with
+  | F754_finite s m e => B754_finite s m e
+  | F754_infinity s => fun _ => B754_infinity s
+  | F754_zero s => fun _ => B754_zero s
+  | F754_nan b pl => fun H => B754_nan b pl H
+  end.
+
+Definition B2FF x :=
+  match x with
+  | B754_finite s m e _ => F754_finite s m e
+  | B754_infinity s => F754_infinity s
+  | B754_zero s => F754_zero s
+  | B754_nan b pl _ => F754_nan b pl
+  end.
+
+Definition B2R f :=
+  match f with
+  | B754_finite s m e _ => F2R (Float radix2 (cond_Zopp s (Zpos m)) e)
+  | _ => 0%R
+  end.
+
+Theorem FF2R_B2FF :
+  forall x,
+  FF2R radix2 (B2FF x) = B2R x.
+Proof.
+now intros [sx|sx|sx plx Hplx|sx mx ex Hx].
+Qed.
+
+Theorem B2FF_FF2B :
+  forall x Hx,
+  B2FF (FF2B x Hx) = x.
+Proof.
+now intros [sx|sx|sx plx|sx mx ex] Hx.
+Qed.
+
+Theorem valid_binary_B2FF :
+  forall x,
+  valid_binary (B2FF x) = true.
+Proof.
+now intros [sx|sx|sx plx Hplx|sx mx ex Hx].
+Qed.
+
+Theorem FF2B_B2FF :
+  forall x H,
+  FF2B (B2FF x) H = x.
+Proof.
+intros [sx|sx|sx plx Hplx|sx mx ex Hx] H ; try easy.
+apply f_equal, eqbool_irrelevance.
+apply f_equal, eqbool_irrelevance.
+Qed.
+
+Theorem FF2B_B2FF_valid :
+  forall x,
+  FF2B (B2FF x) (valid_binary_B2FF x) = x.
+Proof.
+intros x.
+apply FF2B_B2FF.
+Qed.
+
+Theorem B2R_FF2B :
+  forall x Hx,
+  B2R (FF2B x Hx) = FF2R radix2 x.
+Proof.
+now intros [sx|sx|sx plx|sx mx ex] Hx.
+Qed.
+
+Theorem match_FF2B :
+  forall {T} fz fi fn ff x Hx,
+  match FF2B x Hx return T with
+  | B754_zero sx => fz sx
+  | B754_infinity sx => fi sx
+  | B754_nan b p _ => fn b p
+  | B754_finite sx mx ex _ => ff sx mx ex
+  end =
+  match x with
+  | F754_zero sx => fz sx
+  | F754_infinity sx => fi sx
+  | F754_nan b p => fn b p
+  | F754_finite sx mx ex => ff sx mx ex
+  end.
+Proof.
+now intros T fz fi fn ff [sx|sx|sx plx|sx mx ex] Hx.
+Qed.
+
+Theorem canonical_canonical_mantissa :
+  forall (sx : bool) mx ex,
+  canonical_mantissa mx ex = true ->
+  canonical radix2 fexp (Float radix2 (cond_Zopp sx (Zpos mx)) ex).
+Proof.
+intros sx mx ex H.
+assert (Hx := Zeq_bool_eq _ _ H). clear H.
+apply sym_eq.
+simpl.
+pattern ex at 2 ; rewrite <- Hx.
+apply (f_equal fexp).
+rewrite mag_F2R_Zdigits.
+rewrite <- Zdigits_abs.
+rewrite Zpos_digits2_pos.
+now case sx.
+now case sx.
+Qed.
+
+Theorem generic_format_B2R :
+  forall x,
+  generic_format radix2 fexp (B2R x).
+Proof.
+intros [sx|sx|sx plx Hx |sx mx ex Hx] ; try apply generic_format_0.
+simpl.
+apply generic_format_canonical.
+apply canonical_canonical_mantissa.
+now destruct (andb_prop _ _ Hx) as (H, _).
+Qed.
+
+Theorem FLT_format_B2R :
+  forall x,
+  FLT_format radix2 emin prec (B2R x).
+Proof with auto with typeclass_instances.
+intros x.
+apply FLT_format_generic...
+apply generic_format_B2R.
+Qed.
+
+Theorem B2FF_inj :
+  forall x y : binary_float,
+  B2FF x = B2FF y ->
+  x = y.
+Proof.
+intros [sx|sx|sx plx Hplx|sx mx ex Hx] [sy|sy|sy ply Hply|sy my ey Hy] ; try easy.
+(* *)
+intros H.
+now inversion H.
+(* *)
+intros H.
+now inversion H.
+(* *)
+intros H.
+inversion H.
+clear H.
+revert Hplx.
+rewrite H2.
+intros Hx.
+apply f_equal, eqbool_irrelevance.
+(* *)
+intros H.
+inversion H.
+clear H.
+revert Hx.
+rewrite H2, H3.
+intros Hx.
+apply f_equal, eqbool_irrelevance.
+Qed.
+
+Definition is_finite_strict f :=
+  match f with
+  | B754_finite _ _ _ _ => true
+  | _ => false
+  end.
+
+Theorem B2R_inj:
+  forall x y : binary_float,
+  is_finite_strict x = true ->
+  is_finite_strict y = true ->
+  B2R x = B2R y ->
+  x = y.
+Proof.
+intros [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] ; try easy.
+simpl.
+intros _ _ Heq.
+assert (Hs: sx = sy).
+(* *)
+revert Heq. clear.
+case sx ; case sy ; try easy ;
+  intros Heq ; apply False_ind ; revert Heq.
+apply Rlt_not_eq.
+apply Rlt_trans with R0.
+now apply F2R_lt_0.
+now apply F2R_gt_0.
+apply Rgt_not_eq.
+apply Rgt_trans with R0.
+now apply F2R_gt_0.
+now apply F2R_lt_0.
+assert (mx = my /\ ex = ey).
+(* *)
+refine (_ (canonical_unique _ fexp _ _ _ _ Heq)).
+rewrite Hs.
+now case sy ; intro H ; injection H ; split.
+apply canonical_canonical_mantissa.
+exact (proj1 (andb_prop _ _ Hx)).
+apply canonical_canonical_mantissa.
+exact (proj1 (andb_prop _ _ Hy)).
+(* *)
+revert Hx.
+rewrite Hs, (proj1 H), (proj2 H).
+intros Hx.
+apply f_equal.
+apply eqbool_irrelevance.
+Qed.
+
+Definition Bsign x :=
+  match x with
+  | B754_nan s _ _ => s
+  | B754_zero s => s
+  | B754_infinity s => s
+  | B754_finite s _ _ _ => s
+  end.
+
+Definition sign_FF x :=
+  match x with
+  | F754_nan s _ => s
+  | F754_zero s => s
+  | F754_infinity s => s
+  | F754_finite s _ _ => s
+  end.
+
+Theorem Bsign_FF2B :
+  forall x H,
+  Bsign (FF2B x H) = sign_FF x.
+Proof.
+now intros [sx|sx|sx plx|sx mx ex] H.
+Qed.
+
+Definition is_finite f :=
+  match f with
+  | B754_finite _ _ _ _ => true
+  | B754_zero _ => true
+  | _ => false
+  end.
+
+Definition is_finite_FF f :=
+  match f with
+  | F754_finite _ _ _ => true
+  | F754_zero _ => true
+  | _ => false
+  end.
+
+Theorem is_finite_FF2B :
+  forall x Hx,
+  is_finite (FF2B x Hx) = is_finite_FF x.
+Proof.
+now intros [| | |].
+Qed.
+
+Theorem is_finite_FF_B2FF :
+  forall x,
+  is_finite_FF (B2FF x) = is_finite x.
+Proof.
+now intros [| |? []|].
+Qed.
+
+Theorem B2R_Bsign_inj:
+  forall x y : binary_float,
+    is_finite x = true ->
+    is_finite y = true ->
+    B2R x = B2R y ->
+    Bsign x = Bsign y ->
+    x = y.
+Proof.
+intros. destruct x, y; try (apply B2R_inj; now eauto).
+- simpl in H2. congruence.
+- symmetry in H1. apply Rmult_integral in H1.
+  destruct H1. apply (eq_IZR _ 0) in H1. destruct s0; discriminate H1.
+  simpl in H1. pose proof (bpow_gt_0 radix2 e).
+  rewrite H1 in H3. apply Rlt_irrefl in H3. destruct H3.
+- apply Rmult_integral in H1.
+  destruct H1. apply (eq_IZR _ 0) in H1. destruct s; discriminate H1.
+  simpl in H1. pose proof (bpow_gt_0 radix2 e).
+  rewrite H1 in H3. apply Rlt_irrefl in H3. destruct H3.
+Qed.
+
+Definition is_nan f :=
+  match f with
+  | B754_nan _ _ _ => true
+  | _ => false
+  end.
+
+Definition is_nan_FF f :=
+  match f with
+  | F754_nan _ _ => true
+  | _ => false
+  end.
+
+Theorem is_nan_FF2B :
+  forall x Hx,
+  is_nan (FF2B x Hx) = is_nan_FF x.
+Proof.
+now intros [| | |].
+Qed.
+
+Theorem is_nan_FF_B2FF :
+  forall x,
+  is_nan_FF (B2FF x) = is_nan x.
+Proof.
+now intros [| |? []|].
+Qed.
+
+Definition get_nan_pl (x : binary_float) : positive :=
+  match x with B754_nan _ pl _ => pl | _ => xH end.
+
+Definition build_nan (x : { x | is_nan x = true }) : binary_float.
+Proof.
+apply (B754_nan (Bsign (proj1_sig x)) (get_nan_pl (proj1_sig x))).
+destruct x as [x H].
+simpl.
+revert H.
+assert (H: false = true -> nan_pl 1 = true) by now destruct (nan_pl 1).
+destruct x; try apply H.
+intros _.
+apply e.
+Defined.
+
+Theorem build_nan_correct :
+  forall x : { x | is_nan x = true },
+  build_nan x = proj1_sig x.
+Proof.
+intros [x H].
+now destruct x.
+Qed.
+
+Theorem B2R_build_nan :
+  forall x, B2R (build_nan x) = 0%R.
+Proof.
+easy.
+Qed.
+
+Theorem is_finite_build_nan :
+  forall x, is_finite (build_nan x) = false.
+Proof.
+easy.
+Qed.
+
+Theorem is_nan_build_nan :
+  forall x, is_nan (build_nan x) = true.
+Proof.
+easy.
+Qed.
+
+Definition erase (x : binary_float) : binary_float.
+Proof.
+destruct x as [s|s|s pl H|s m e H].
+- exact (B754_zero s).
+- exact (B754_infinity s).
+- apply (B754_nan s pl).
+  destruct nan_pl.
+  apply eq_refl.
+  exact H.
+- apply (B754_finite s m e).
+  destruct bounded.
+  apply eq_refl.
+  exact H.
+Defined.
+
+Theorem erase_correct :
+  forall x, erase x = x.
+Proof.
+destruct x as [s|s|s pl H|s m e H] ; try easy ; simpl.
+- apply f_equal, eqbool_irrelevance.
+- apply f_equal, eqbool_irrelevance.
+Qed.
+
+(** Opposite *)
+
+Definition Bopp opp_nan x :=
+  match x with
+  | B754_nan _ _ _ => build_nan (opp_nan x)
+  | B754_infinity sx => B754_infinity (negb sx)
+  | B754_finite sx mx ex Hx => B754_finite (negb sx) mx ex Hx
+  | B754_zero sx => B754_zero (negb sx)
+  end.
+
+Theorem Bopp_involutive :
+  forall opp_nan x,
+  is_nan x = false ->
+  Bopp opp_nan (Bopp opp_nan x) = x.
+Proof.
+now intros opp_nan [sx|sx|sx plx|sx mx ex Hx] ; simpl ; try rewrite Bool.negb_involutive.
+Qed.
+
+Theorem B2R_Bopp :
+  forall opp_nan x,
+  B2R (Bopp opp_nan x) = (- B2R x)%R.
+Proof.
+intros opp_nan [sx|sx|sx plx Hplx|sx mx ex Hx]; apply sym_eq ; try apply Ropp_0.
+simpl.
+rewrite <- F2R_opp.
+now case sx.
+Qed.
+
+Theorem is_finite_Bopp :
+  forall opp_nan x,
+  is_finite (Bopp opp_nan x) = is_finite x.
+Proof.
+now intros opp_nan [| | |].
+Qed.
+
+Lemma Bsign_Bopp :
+  forall opp_nan x, is_nan x = false -> Bsign (Bopp opp_nan x) = negb (Bsign x).
+Proof. now intros opp_nan [s|s|s pl H|s m e H]. Qed.
+
+(** Absolute value *)
+
+Definition Babs abs_nan (x : binary_float) : binary_float :=
+  match x with
+  | B754_nan _ _ _ => build_nan (abs_nan x)
+  | B754_infinity sx => B754_infinity false
+  | B754_finite sx mx ex Hx => B754_finite false mx ex Hx
+  | B754_zero sx => B754_zero false
+  end.
+
+Theorem B2R_Babs :
+  forall abs_nan x,
+  B2R (Babs abs_nan x) = Rabs (B2R x).
+Proof.
+  intros abs_nan [sx|sx|sx plx Hx|sx mx ex Hx]; apply sym_eq ; try apply Rabs_R0.
+  simpl. rewrite <- F2R_abs. now destruct sx.
+Qed.
+
+Theorem is_finite_Babs :
+  forall abs_nan x,
+  is_finite (Babs abs_nan x) = is_finite x.
+Proof.
+  now intros abs_nan [| | |].
+Qed.
+
+Theorem Bsign_Babs :
+  forall abs_nan x,
+  is_nan x = false ->
+  Bsign (Babs abs_nan x) = false.
+Proof.
+  now intros abs_nan [| | |].
+Qed.
+
+Theorem Babs_idempotent :
+  forall abs_nan (x: binary_float),
+  is_nan x = false ->
+  Babs abs_nan (Babs abs_nan x) = Babs abs_nan x.
+Proof.
+  now intros abs_nan [sx|sx|sx plx|sx mx ex Hx].
+Qed.
+
+Theorem Babs_Bopp :
+  forall abs_nan opp_nan x,
+  is_nan x = false ->
+  Babs abs_nan (Bopp opp_nan x) = Babs abs_nan x.
+Proof.
+  now intros abs_nan opp_nan [| | |].
+Qed.
+
+(** Comparison
+
+[Some c] means ordered as per [c]; [None] means unordered. *)
+
+Definition Bcompare (f1 f2 : binary_float) : option comparison :=
+  match f1, f2 with
+  | B754_nan _ _ _,_ | _,B754_nan _ _ _ => None
+  | B754_infinity s1, B754_infinity s2 =>
+    Some match s1, s2 with
+    | true, true => Eq
+    | false, false => Eq
+    | true, false => Lt
+    | false, true => Gt
+    end
+  | B754_infinity s, _ => Some (if s then Lt else Gt)
+  | _, B754_infinity s => Some (if s then Gt else Lt)
+  | B754_finite s _ _ _, B754_zero _ => Some (if s then Lt else Gt)
+  | B754_zero _, B754_finite s _ _ _ => Some (if s then Gt else Lt)
+  | B754_zero _, B754_zero _ => Some Eq
+  | B754_finite s1 m1 e1 _, B754_finite s2 m2 e2 _ =>
+    Some match s1, s2 with
+    | true, false => Lt
+    | false, true => Gt
+    | false, false =>
+      match Z.compare e1 e2 with
+      | Lt => Lt
+      | Gt => Gt
+      | Eq => Pcompare m1 m2 Eq
+      end
+    | true, true =>
+      match Z.compare e1 e2 with
+      | Lt => Gt
+      | Gt => Lt
+      | Eq => CompOpp (Pcompare m1 m2 Eq)
+      end
+    end
+  end.
+
+Theorem Bcompare_correct :
+  forall f1 f2,
+  is_finite f1 = true -> is_finite f2 = true ->
+  Bcompare f1 f2 = Some (Rcompare (B2R f1) (B2R f2)).
+Proof.
+  Ltac apply_Rcompare :=
+    match goal with
+      | [ |- Lt = Rcompare _ _ ] => symmetry; apply Rcompare_Lt
+      | [ |- Eq = Rcompare _ _ ] => symmetry; apply Rcompare_Eq
+      | [ |- Gt = Rcompare _ _ ] => symmetry; apply Rcompare_Gt
+    end.
+  unfold Bcompare; intros f1 f2 H1 H2.
+  destruct f1, f2; try easy; apply f_equal; clear H1 H2.
+  now rewrite Rcompare_Eq.
+  destruct s0 ; apply_Rcompare.
+  now apply F2R_lt_0.
+  now apply F2R_gt_0.
+  destruct s ; apply_Rcompare.
+  now apply F2R_lt_0.
+  now apply F2R_gt_0.
+  simpl.
+  apply andb_prop in e0; destruct e0; apply (canonical_canonical_mantissa false) in H.
+  apply andb_prop in e2; destruct e2; apply (canonical_canonical_mantissa false) in H1.
+  pose proof (Zcompare_spec e e1); unfold canonical, Fexp in H1, H.
+  assert (forall m1 m2 e1 e2,
+    let x := (IZR (Zpos m1) * bpow radix2 e1)%R in
+    let y := (IZR (Zpos m2) * bpow radix2 e2)%R in
+    (cexp radix2 fexp x < cexp radix2 fexp y)%Z -> (x < y)%R).
+  {
+  intros; apply Rnot_le_lt; intro; apply (mag_le radix2) in H5.
+  apply Zlt_not_le with (1 := H4).
+  now apply fexp_monotone.
+  now apply (F2R_gt_0 _ (Float radix2 (Zpos m2) e2)).
+  }
+  assert (forall m1 m2 e1 e2, (IZR (- Zpos m1) * bpow radix2 e1 < IZR (Zpos m2) * bpow radix2 e2)%R).
+  {
+  intros; apply (Rlt_trans _ 0%R).
+  now apply (F2R_lt_0 _ (Float radix2 (Zneg m1) e0)).
+  now apply (F2R_gt_0 _ (Float radix2 (Zpos m2) e2)).
+  }
+  unfold F2R, Fnum, Fexp.
+  destruct s, s0; try (now apply_Rcompare; apply H5); inversion H3;
+    try (apply_Rcompare; apply H4; rewrite H, H1 in H7; assumption);
+    try (apply_Rcompare; do 2 rewrite opp_IZR, Ropp_mult_distr_l_reverse;
+      apply Ropp_lt_contravar; apply H4; rewrite H, H1 in H7; assumption);
+    rewrite H7, Rcompare_mult_r, Rcompare_IZR by (apply bpow_gt_0); reflexivity.
+Qed.
+
+Theorem Bcompare_swap :
+  forall x y,
+  Bcompare y x = match Bcompare x y with Some c => Some (CompOpp c) | None => None end.
+Proof.
+  intros.
+  destruct x as [ ? | [] | ? ? | [] mx ex Bx ];
+  destruct y as [ ? | [] | ? ? | [] my ey By ]; simpl; try easy.
+- rewrite <- (Zcompare_antisym ex ey). destruct (ex ?= ey)%Z; try easy.
+  now rewrite (Pcompare_antisym mx my).
+- rewrite <- (Zcompare_antisym ex ey). destruct (ex ?= ey)%Z; try easy.
+  now rewrite Pcompare_antisym.
+Qed.
+
+Theorem bounded_lt_emax :
+  forall mx ex,
+  bounded mx ex = true ->
+  (F2R (Float radix2 (Zpos mx) ex) < bpow radix2 emax)%R.
+Proof.
+intros mx ex Hx.
+destruct (andb_prop _ _ Hx) as (H1,H2).
+generalize (Zeq_bool_eq _ _ H1). clear H1. intro H1.
+generalize (Zle_bool_imp_le _ _ H2). clear H2. intro H2.
+generalize (mag_F2R_Zdigits radix2 (Zpos mx) ex).
+destruct (mag radix2 (F2R (Float radix2 (Zpos mx) ex))) as (e',Ex).
+unfold mag_val.
+intros H.
+apply Rlt_le_trans with (bpow radix2 e').
+change (Zpos mx) with (Z.abs (Zpos mx)).
+rewrite F2R_Zabs.
+apply Ex.
+apply Rgt_not_eq.
+now apply F2R_gt_0.
+apply bpow_le.
+rewrite H. 2: discriminate.
+revert H1. clear -H2.
+rewrite Zpos_digits2_pos.
+unfold fexp, FLT_exp.
+intros ; zify ; omega.
+Qed.
+
+Theorem bounded_ge_emin :
+  forall mx ex,
+  bounded mx ex = true ->
+  (bpow radix2 emin <= F2R (Float radix2 (Zpos mx) ex))%R.
+Proof.
+intros mx ex Hx.
+destruct (andb_prop _ _ Hx) as [H1 _].
+apply Zeq_bool_eq in H1.
+generalize (mag_F2R_Zdigits radix2 (Zpos mx) ex).
+destruct (mag radix2 (F2R (Float radix2 (Zpos mx) ex))) as [e' Ex].
+unfold mag_val.
+intros H.
+assert (H0 : Zpos mx <> 0%Z) by easy.
+rewrite Rabs_pos_eq in Ex by now apply F2R_ge_0.
+refine (Rle_trans _ _ _ _ (proj1 (Ex _))).
+2: now apply F2R_neq_0.
+apply bpow_le.
+rewrite H by easy.
+revert H1.
+rewrite Zpos_digits2_pos.
+generalize (Zdigits radix2 (Zpos mx)) (Zdigits_gt_0 radix2 (Zpos mx) H0).
+unfold fexp, FLT_exp.
+clear -prec_gt_0_.
+unfold Prec_gt_0 in prec_gt_0_.
+clearbody emin.
+intros ; zify ; omega.
+Qed.
+
+Theorem abs_B2R_lt_emax :
+  forall x,
+  (Rabs (B2R x) < bpow radix2 emax)%R.
+Proof.
+intros [sx|sx|sx plx Hx|sx mx ex Hx] ; simpl ; try ( rewrite Rabs_R0 ; apply bpow_gt_0 ).
+rewrite <- F2R_Zabs, abs_cond_Zopp.
+now apply bounded_lt_emax.
+Qed.
+
+Theorem abs_B2R_ge_emin :
+  forall x,
+  is_finite_strict x = true ->
+  (bpow radix2 emin <= Rabs (B2R x))%R.
+Proof.
+intros [sx|sx|sx plx Hx|sx mx ex Hx] ; simpl ; try discriminate.
+intros; case sx; simpl.
+- unfold F2R; simpl; rewrite Rabs_mult, <-abs_IZR; simpl.
+  rewrite Rabs_pos_eq; [|apply bpow_ge_0].
+  now apply bounded_ge_emin.
+- unfold F2R; simpl; rewrite Rabs_mult, <-abs_IZR; simpl.
+  rewrite Rabs_pos_eq; [|apply bpow_ge_0].
+  now apply bounded_ge_emin.
+Qed.
+
+Theorem bounded_canonical_lt_emax :
+  forall mx ex,
+  canonical radix2 fexp (Float radix2 (Zpos mx) ex) ->
+  (F2R (Float radix2 (Zpos mx) ex) < bpow radix2 emax)%R ->
+  bounded mx ex = true.
+Proof.
+intros mx ex Cx Bx.
+apply andb_true_intro.
+split.
+unfold canonical_mantissa.
+unfold canonical, Fexp in Cx.
+rewrite Cx at 2.
+rewrite Zpos_digits2_pos.
+unfold cexp.
+rewrite mag_F2R_Zdigits. 2: discriminate.
+now apply -> Zeq_is_eq_bool.
+apply Zle_bool_true.
+unfold canonical, Fexp in Cx.
+rewrite Cx.
+unfold cexp, fexp, FLT_exp.
+destruct (mag radix2 (F2R (Float radix2 (Zpos mx) ex))) as (e',Ex). simpl.
+apply Z.max_lub.
+cut (e' - 1 < emax)%Z. clear ; omega.
+apply lt_bpow with radix2.
+apply Rle_lt_trans with (2 := Bx).
+change (Zpos mx) with (Z.abs (Zpos mx)).
+rewrite F2R_Zabs.
+apply Ex.
+apply Rgt_not_eq.
+now apply F2R_gt_0.
+unfold emin.
+generalize (prec_gt_0 prec).
+clear -Hmax ; omega.
+Qed.
+
+(** Truncation *)
+
+Record shr_record := { shr_m : Z ; shr_r : bool ; shr_s : bool }.
+
+Definition shr_1 mrs :=
+  let '(Build_shr_record m r s) := mrs in
+  let s := orb r s in
+  match m with
+  | Z0 => Build_shr_record Z0 false s
+  | Zpos xH => Build_shr_record Z0 true s
+  | Zpos (xO p) => Build_shr_record (Zpos p) false s
+  | Zpos (xI p) => Build_shr_record (Zpos p) true s
+  | Zneg xH => Build_shr_record Z0 true s
+  | Zneg (xO p) => Build_shr_record (Zneg p) false s
+  | Zneg (xI p) => Build_shr_record (Zneg p) true s
+  end.
+
+Definition loc_of_shr_record mrs :=
+  match mrs with
+  | Build_shr_record _ false false => loc_Exact
+  | Build_shr_record _ false true => loc_Inexact Lt
+  | Build_shr_record _ true false => loc_Inexact Eq
+  | Build_shr_record _ true true => loc_Inexact Gt
+  end.
+
+Definition shr_record_of_loc m l :=
+  match l with
+  | loc_Exact => Build_shr_record m false false
+  | loc_Inexact Lt => Build_shr_record m false true
+  | loc_Inexact Eq => Build_shr_record m true false
+  | loc_Inexact Gt => Build_shr_record m true true
+  end.
+
+Theorem shr_m_shr_record_of_loc :
+  forall m l,
+  shr_m (shr_record_of_loc m l) = m.
+Proof.
+now intros m [|[| |]].
+Qed.
+
+Theorem loc_of_shr_record_of_loc :
+  forall m l,
+  loc_of_shr_record (shr_record_of_loc m l) = l.
+Proof.
+now intros m [|[| |]].
+Qed.
+
+Definition shr mrs e n :=
+  match n with
+  | Zpos p => (iter_pos shr_1 p mrs, (e + n)%Z)
+  | _ => (mrs, e)
+  end.
+
+Lemma inbetween_shr_1 :
+  forall x mrs e,
+  (0 <= shr_m mrs)%Z ->
+  inbetween_float radix2 (shr_m mrs) e x (loc_of_shr_record mrs) ->
+  inbetween_float radix2 (shr_m (shr_1 mrs)) (e + 1) x (loc_of_shr_record (shr_1 mrs)).
+Proof.
+intros x mrs e Hm Hl.
+refine (_ (new_location_even_correct (F2R (Float radix2 (shr_m (shr_1 mrs)) (e + 1))) (bpow radix2 e) 2 _ _ _ x (if shr_r (shr_1 mrs) then 1 else 0) (loc_of_shr_record mrs) _ _)) ; try easy.
+2: apply bpow_gt_0.
+2: now case (shr_r (shr_1 mrs)) ; split.
+change 2%R with (bpow radix2 1).
+rewrite <- bpow_plus.
+rewrite (Zplus_comm 1), <- (F2R_bpow radix2 (e + 1)).
+unfold inbetween_float, F2R. simpl.
+rewrite plus_IZR, Rmult_plus_distr_r.
+replace (new_location_even 2 (if shr_r (shr_1 mrs) then 1%Z else 0%Z) (loc_of_shr_record mrs)) with (loc_of_shr_record (shr_1 mrs)).
+easy.
+clear -Hm.
+destruct mrs as (m, r, s).
+now destruct m as [|[m|m|]|m] ; try (now elim Hm) ; destruct r as [|] ; destruct s as [|].
+rewrite (F2R_change_exp radix2 e).
+2: apply Zle_succ.
+unfold F2R. simpl.
+rewrite <- 2!Rmult_plus_distr_r, <- 2!plus_IZR.
+rewrite Zplus_assoc.
+replace (shr_m (shr_1 mrs) * 2 ^ (e + 1 - e) + (if shr_r (shr_1 mrs) then 1%Z else 0%Z))%Z with (shr_m mrs).
+exact Hl.
+ring_simplify (e + 1 - e)%Z.
+change (2^1)%Z with 2%Z.
+rewrite Zmult_comm.
+clear -Hm.
+destruct mrs as (m, r, s).
+now destruct m as [|[m|m|]|m] ; try (now elim Hm) ; destruct r as [|] ; destruct s as [|].
+Qed.
+
+Theorem inbetween_shr :
+  forall x m e l n,
+  (0 <= m)%Z ->
+  inbetween_float radix2 m e x l ->
+  let '(mrs, e') := shr (shr_record_of_loc m l) e n in
+  inbetween_float radix2 (shr_m mrs) e' x (loc_of_shr_record mrs).
+Proof.
+intros x m e l n Hm Hl.
+destruct n as [|n|n].
+now destruct l as [|[| |]].
+2: now destruct l as [|[| |]].
+unfold shr.
+rewrite iter_pos_nat.
+rewrite Zpos_eq_Z_of_nat_o_nat_of_P.
+induction (nat_of_P n).
+simpl.
+rewrite Zplus_0_r.
+now destruct l as [|[| |]].
+rewrite iter_nat_S.
+rewrite inj_S.
+unfold Z.succ.
+rewrite Zplus_assoc.
+revert IHn0.
+apply inbetween_shr_1.
+clear -Hm.
+induction n0.
+now destruct l as [|[| |]].
+rewrite iter_nat_S.
+revert IHn0.
+generalize (iter_nat shr_1 n0 (shr_record_of_loc m l)).
+clear.
+intros (m, r, s) Hm.
+now destruct m as [|[m|m|]|m] ; try (now elim Hm) ; destruct r as [|] ; destruct s as [|].
+Qed.
+
+Definition shr_fexp m e l :=
+  shr (shr_record_of_loc m l) e (fexp (Zdigits2 m + e) - e).
+
+Theorem shr_truncate :
+  forall m e l,
+  (0 <= m)%Z ->
+  shr_fexp m e l =
+  let '(m', e', l') := truncate radix2 fexp (m, e, l) in (shr_record_of_loc m' l', e').
+Proof.
+intros m e l Hm.
+case_eq (truncate radix2 fexp (m, e, l)).
+intros (m', e') l'.
+unfold shr_fexp.
+rewrite Zdigits2_Zdigits.
+case_eq (fexp (Zdigits radix2 m + e) - e)%Z.
+(* *)
+intros He.
+unfold truncate.
+rewrite He.
+simpl.
+intros H.
+now inversion H.
+(* *)
+intros p Hp.
+assert (He: (e <= fexp (Zdigits radix2 m + e))%Z).
+clear -Hp ; zify ; omega.
+destruct (inbetween_float_ex radix2 m e l) as (x, Hx).
+generalize (inbetween_shr x m e l (fexp (Zdigits radix2 m + e) - e) Hm Hx).
+assert (Hx0 : (0 <= x)%R).
+apply Rle_trans with (F2R (Float radix2 m e)).
+now apply F2R_ge_0.
+exact (proj1 (inbetween_float_bounds _ _ _ _ _ Hx)).
+case_eq (shr (shr_record_of_loc m l) e (fexp (Zdigits radix2 m + e) - e)).
+intros mrs e'' H3 H4 H1.
+generalize (truncate_correct radix2 _ x m e l Hx0 Hx (or_introl _ He)).
+rewrite H1.
+intros (H2,_).
+rewrite <- Hp, H3.
+assert (e'' = e').
+change (snd (mrs, e'') = snd (fst (m',e',l'))).
+rewrite <- H1, <- H3.
+unfold truncate.
+now rewrite Hp.
+rewrite H in H4 |- *.
+apply (f_equal (fun v => (v, _))).
+destruct (inbetween_float_unique _ _ _ _ _ _ _ H2 H4) as (H5, H6).
+rewrite H5, H6.
+case mrs.
+now intros m0 [|] [|].
+(* *)
+intros p Hp.
+unfold truncate.
+rewrite Hp.
+simpl.
+intros H.
+now inversion H.
+Qed.
+
+(** Rounding modes *)
+
+Inductive mode := mode_NE | mode_ZR | mode_DN | mode_UP | mode_NA.
+
+Definition round_mode m :=
+  match m with
+  | mode_NE => ZnearestE
+  | mode_ZR => Ztrunc
+  | mode_DN => Zfloor
+  | mode_UP => Zceil
+  | mode_NA => ZnearestA
+  end.
+
+Definition choice_mode m sx mx lx :=
+  match m with
+  | mode_NE => cond_incr (round_N (negb (Z.even mx)) lx) mx
+  | mode_ZR => mx
+  | mode_DN => cond_incr (round_sign_DN sx lx) mx
+  | mode_UP => cond_incr (round_sign_UP sx lx) mx
+  | mode_NA => cond_incr (round_N true lx) mx
+  end.
+
+Global Instance valid_rnd_round_mode : forall m, Valid_rnd (round_mode m).
+Proof.
+destruct m ; unfold round_mode ; auto with typeclass_instances.
+Qed.
+
+Definition overflow_to_inf m s :=
+  match m with
+  | mode_NE => true
+  | mode_NA => true
+  | mode_ZR => false
+  | mode_UP => negb s
+  | mode_DN => s
+  end.
+
+Definition binary_overflow m s :=
+  if overflow_to_inf m s then F754_infinity s
+  else F754_finite s (match (Zpower 2 prec - 1)%Z with Zpos p => p | _ => xH end) (emax - prec).
+
+Definition binary_round_aux mode sx mx ex lx :=
+  let '(mrs', e') := shr_fexp mx ex lx in
+  let '(mrs'', e'') := shr_fexp (choice_mode mode sx (shr_m mrs') (loc_of_shr_record mrs')) e' loc_Exact in
+  match shr_m mrs'' with
+  | Z0 => F754_zero sx
+  | Zpos m => if Zle_bool e'' (emax - prec) then F754_finite sx m e'' else binary_overflow mode sx
+  | _ => F754_nan false xH (* dummy *)
+  end.
+
+Theorem binary_round_aux_correct' :
+  forall mode x mx ex lx,
+  (x <> 0)%R ->
+  inbetween_float radix2 mx ex (Rabs x) lx ->
+  (ex <= cexp radix2 fexp x)%Z ->
+  let z := binary_round_aux mode (Rlt_bool x 0) mx ex lx in
+  valid_binary z = true /\
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode mode) x)) (bpow radix2 emax) then
+    FF2R radix2 z = round radix2 fexp (round_mode mode) x /\
+    is_finite_FF z = true /\ sign_FF z = Rlt_bool x 0
+  else
+    z = binary_overflow mode (Rlt_bool x 0).
+Proof with auto with typeclass_instances.
+intros m x mx ex lx Px Bx Ex z.
+unfold binary_round_aux in z.
+revert z.
+rewrite shr_truncate.
+refine (_ (round_trunc_sign_any_correct' _ _ (round_mode m) (choice_mode m) _ x mx ex lx Bx (or_introl _ Ex))).
+rewrite <- cexp_abs in Ex.
+refine (_ (truncate_correct_partial' _ fexp _ _ _ _ _ Bx Ex)).
+destruct (truncate radix2 fexp (mx, ex, lx)) as ((m1, e1), l1).
+rewrite loc_of_shr_record_of_loc, shr_m_shr_record_of_loc.
+set (m1' := choice_mode m (Rlt_bool x 0) m1 l1).
+intros (H1a,H1b) H1c.
+rewrite H1c.
+assert (Hm: (m1 <= m1')%Z).
+(* . *)
+unfold m1', choice_mode, cond_incr.
+case m ;
+  try apply Z.le_refl ;
+  match goal with |- (m1 <= if ?b then _ else _)%Z =>
+    case b ; [ apply Zle_succ | apply Z.le_refl ] end.
+assert (Hr: Rabs (round radix2 fexp (round_mode m) x) = F2R (Float radix2 m1' e1)).
+(* . *)
+rewrite <- (Z.abs_eq m1').
+replace (Z.abs m1') with (Z.abs (cond_Zopp (Rlt_bool x 0) m1')).
+rewrite F2R_Zabs.
+now apply f_equal.
+apply abs_cond_Zopp.
+apply Z.le_trans with (2 := Hm).
+apply Zlt_succ_le.
+apply gt_0_F2R with radix2 e1.
+apply Rle_lt_trans with (1 := Rabs_pos x).
+exact (proj2 (inbetween_float_bounds _ _ _ _ _ H1a)).
+(* . *)
+assert (Br: inbetween_float radix2 m1' e1 (Rabs (round radix2 fexp (round_mode m) x)) loc_Exact).
+now apply inbetween_Exact.
+destruct m1' as [|m1'|m1'].
+(* . m1' = 0 *)
+rewrite shr_truncate. 2: apply Z.le_refl.
+generalize (truncate_0 radix2 fexp e1 loc_Exact).
+destruct (truncate radix2 fexp (Z0, e1, loc_Exact)) as ((m2, e2), l2).
+rewrite shr_m_shr_record_of_loc.
+intros Hm2.
+rewrite Hm2.
+repeat split.
+rewrite Rlt_bool_true.
+repeat split.
+apply sym_eq.
+case Rlt_bool ; apply F2R_0.
+rewrite <- F2R_Zabs, abs_cond_Zopp, F2R_0.
+apply bpow_gt_0.
+(* . 0 < m1' *)
+assert (He: (e1 <= fexp (Zdigits radix2 (Zpos m1') + e1))%Z).
+rewrite <- mag_F2R_Zdigits, <- Hr, mag_abs.
+2: discriminate.
+rewrite H1b.
+rewrite cexp_abs.
+fold (cexp radix2 fexp (round radix2 fexp (round_mode m) x)).
+apply cexp_round_ge...
+rewrite H1c.
+case (Rlt_bool x 0).
+apply Rlt_not_eq.
+now apply F2R_lt_0.
+apply Rgt_not_eq.
+now apply F2R_gt_0.
+refine (_ (truncate_correct_partial _ _ _ _ _ _ _ Br He)).
+2: now rewrite Hr ; apply F2R_gt_0.
+refine (_ (truncate_correct_format radix2 fexp (Zpos m1') e1 _ _ He)).
+2: discriminate.
+rewrite shr_truncate. 2: easy.
+destruct (truncate radix2 fexp (Zpos m1', e1, loc_Exact)) as ((m2, e2), l2).
+rewrite shr_m_shr_record_of_loc.
+intros (H3,H4) (H2,_).
+destruct m2 as [|m2|m2].
+elim Rgt_not_eq with (2 := H3).
+rewrite F2R_0.
+now apply F2R_gt_0.
+rewrite F2R_cond_Zopp, H3, abs_cond_Ropp, <- F2R_abs.
+simpl Z.abs.
+case_eq (Zle_bool e2 (emax - prec)) ; intros He2.
+assert (bounded m2 e2 = true).
+apply andb_true_intro.
+split.
+unfold canonical_mantissa.
+apply Zeq_bool_true.
+rewrite Zpos_digits2_pos.
+rewrite <- mag_F2R_Zdigits.
+apply sym_eq.
+now rewrite H3 in H4.
+discriminate.
+exact He2.
+apply (conj H).
+rewrite Rlt_bool_true.
+repeat split.
+apply F2R_cond_Zopp.
+now apply bounded_lt_emax.
+rewrite (Rlt_bool_false _ (bpow radix2 emax)).
+refine (conj _ (refl_equal _)).
+unfold binary_overflow.
+case overflow_to_inf.
+apply refl_equal.
+unfold valid_binary, bounded.
+rewrite Zle_bool_refl.
+rewrite Bool.andb_true_r.
+apply Zeq_bool_true.
+rewrite Zpos_digits2_pos.
+replace (Zdigits radix2 (Zpos (match (Zpower 2 prec - 1)%Z with Zpos p => p | _ => xH end))) with prec.
+unfold fexp, FLT_exp, emin.
+generalize (prec_gt_0 prec).
+clear -Hmax ; zify ; omega.
+change 2%Z with (radix_val radix2).
+case_eq (Zpower radix2 prec - 1)%Z.
+simpl Zdigits.
+generalize (Zpower_gt_1 radix2 prec (prec_gt_0 prec)).
+clear ; omega.
+intros p Hp.
+apply Zle_antisym.
+cut (prec - 1 < Zdigits radix2 (Zpos p))%Z. clear ; omega.
+apply Zdigits_gt_Zpower.
+simpl Z.abs. rewrite <- Hp.
+cut (Zpower radix2 (prec - 1) < Zpower radix2 prec)%Z. clear ; omega.
+apply lt_IZR.
+rewrite 2!IZR_Zpower. 2: now apply Zlt_le_weak.
+apply bpow_lt.
+apply Zlt_pred.
+now apply Zlt_0_le_0_pred.
+apply Zdigits_le_Zpower.
+simpl Z.abs. rewrite <- Hp.
+apply Zlt_pred.
+intros p Hp.
+generalize (Zpower_gt_1 radix2 _ (prec_gt_0 prec)).
+clear -Hp ; zify ; omega.
+apply Rnot_lt_le.
+intros Hx.
+generalize (refl_equal (bounded m2 e2)).
+unfold bounded at 2.
+rewrite He2.
+rewrite Bool.andb_false_r.
+rewrite bounded_canonical_lt_emax with (2 := Hx).
+discriminate.
+unfold canonical.
+now rewrite <- H3.
+elim Rgt_not_eq with (2 := H3).
+apply Rlt_trans with R0.
+now apply F2R_lt_0.
+now apply F2R_gt_0.
+rewrite <- Hr.
+apply generic_format_abs...
+apply generic_format_round...
+(* . not m1' < 0 *)
+elim Rgt_not_eq with (2 := Hr).
+apply Rlt_le_trans with R0.
+now apply F2R_lt_0.
+apply Rabs_pos.
+(* *)
+now apply Rabs_pos_lt.
+(* all the modes are valid *)
+clear. case m.
+exact inbetween_int_NE_sign.
+exact inbetween_int_ZR_sign.
+exact inbetween_int_DN_sign.
+exact inbetween_int_UP_sign.
+exact inbetween_int_NA_sign.
+(* *)
+apply inbetween_float_bounds in Bx.
+apply Zlt_succ_le.
+eapply gt_0_F2R.
+apply Rle_lt_trans with (2 := proj2 Bx).
+apply Rabs_pos.
+Qed.
+
+Theorem binary_round_aux_correct :
+  forall mode x mx ex lx,
+  inbetween_float radix2 (Zpos mx) ex (Rabs x) lx ->
+  (ex <= fexp (Zdigits radix2 (Zpos mx) + ex))%Z ->
+  let z := binary_round_aux mode (Rlt_bool x 0) (Zpos mx) ex lx in
+  valid_binary z = true /\
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode mode) x)) (bpow radix2 emax) then
+    FF2R radix2 z = round radix2 fexp (round_mode mode) x /\
+    is_finite_FF z = true /\ sign_FF z = Rlt_bool x 0
+  else
+    z = binary_overflow mode (Rlt_bool x 0).
+Proof with auto with typeclass_instances.
+intros m x mx ex lx Bx Ex z.
+unfold binary_round_aux in z.
+revert z.
+rewrite shr_truncate. 2: easy.
+refine (_ (round_trunc_sign_any_correct _ _ (round_mode m) (choice_mode m) _ x (Zpos mx) ex lx Bx (or_introl _ Ex))).
+refine (_ (truncate_correct_partial _ _ _ _ _ _ _ Bx Ex)).
+destruct (truncate radix2 fexp (Zpos mx, ex, lx)) as ((m1, e1), l1).
+rewrite loc_of_shr_record_of_loc, shr_m_shr_record_of_loc.
+set (m1' := choice_mode m (Rlt_bool x 0) m1 l1).
+intros (H1a,H1b) H1c.
+rewrite H1c.
+assert (Hm: (m1 <= m1')%Z).
+(* . *)
+unfold m1', choice_mode, cond_incr.
+case m ;
+  try apply Z.le_refl ;
+  match goal with |- (m1 <= if ?b then _ else _)%Z =>
+    case b ; [ apply Zle_succ | apply Z.le_refl ] end.
+assert (Hr: Rabs (round radix2 fexp (round_mode m) x) = F2R (Float radix2 m1' e1)).
+(* . *)
+rewrite <- (Z.abs_eq m1').
+replace (Z.abs m1') with (Z.abs (cond_Zopp (Rlt_bool x 0) m1')).
+rewrite F2R_Zabs.
+now apply f_equal.
+apply abs_cond_Zopp.
+apply Z.le_trans with (2 := Hm).
+apply Zlt_succ_le.
+apply gt_0_F2R with radix2 e1.
+apply Rle_lt_trans with (1 := Rabs_pos x).
+exact (proj2 (inbetween_float_bounds _ _ _ _ _ H1a)).
+(* . *)
+assert (Br: inbetween_float radix2 m1' e1 (Rabs (round radix2 fexp (round_mode m) x)) loc_Exact).
+now apply inbetween_Exact.
+destruct m1' as [|m1'|m1'].
+(* . m1' = 0 *)
+rewrite shr_truncate. 2: apply Z.le_refl.
+generalize (truncate_0 radix2 fexp e1 loc_Exact).
+destruct (truncate radix2 fexp (Z0, e1, loc_Exact)) as ((m2, e2), l2).
+rewrite shr_m_shr_record_of_loc.
+intros Hm2.
+rewrite Hm2.
+repeat split.
+rewrite Rlt_bool_true.
+repeat split.
+apply sym_eq.
+case Rlt_bool ; apply F2R_0.
+rewrite <- F2R_Zabs, abs_cond_Zopp, F2R_0.
+apply bpow_gt_0.
+(* . 0 < m1' *)
+assert (He: (e1 <= fexp (Zdigits radix2 (Zpos m1') + e1))%Z).
+rewrite <- mag_F2R_Zdigits, <- Hr, mag_abs.
+2: discriminate.
+rewrite H1b.
+rewrite cexp_abs.
+fold (cexp radix2 fexp (round radix2 fexp (round_mode m) x)).
+apply cexp_round_ge...
+rewrite H1c.
+case (Rlt_bool x 0).
+apply Rlt_not_eq.
+now apply F2R_lt_0.
+apply Rgt_not_eq.
+now apply F2R_gt_0.
+refine (_ (truncate_correct_partial _ _ _ _ _ _ _ Br He)).
+2: now rewrite Hr ; apply F2R_gt_0.
+refine (_ (truncate_correct_format radix2 fexp (Zpos m1') e1 _ _ He)).
+2: discriminate.
+rewrite shr_truncate. 2: easy.
+destruct (truncate radix2 fexp (Zpos m1', e1, loc_Exact)) as ((m2, e2), l2).
+rewrite shr_m_shr_record_of_loc.
+intros (H3,H4) (H2,_).
+destruct m2 as [|m2|m2].
+elim Rgt_not_eq with (2 := H3).
+rewrite F2R_0.
+now apply F2R_gt_0.
+rewrite F2R_cond_Zopp, H3, abs_cond_Ropp, <- F2R_abs.
+simpl Z.abs.
+case_eq (Zle_bool e2 (emax - prec)) ; intros He2.
+assert (bounded m2 e2 = true).
+apply andb_true_intro.
+split.
+unfold canonical_mantissa.
+apply Zeq_bool_true.
+rewrite Zpos_digits2_pos.
+rewrite <- mag_F2R_Zdigits.
+apply sym_eq.
+now rewrite H3 in H4.
+discriminate.
+exact He2.
+apply (conj H).
+rewrite Rlt_bool_true.
+repeat split.
+apply F2R_cond_Zopp.
+now apply bounded_lt_emax.
+rewrite (Rlt_bool_false _ (bpow radix2 emax)).
+refine (conj _ (refl_equal _)).
+unfold binary_overflow.
+case overflow_to_inf.
+apply refl_equal.
+unfold valid_binary, bounded.
+rewrite Zle_bool_refl.
+rewrite Bool.andb_true_r.
+apply Zeq_bool_true.
+rewrite Zpos_digits2_pos.
+replace (Zdigits radix2 (Zpos (match (Zpower 2 prec - 1)%Z with Zpos p => p | _ => xH end))) with prec.
+unfold fexp, FLT_exp, emin.
+generalize (prec_gt_0 prec).
+clear -Hmax ; zify ; omega.
+change 2%Z with (radix_val radix2).
+case_eq (Zpower radix2 prec - 1)%Z.
+simpl Zdigits.
+generalize (Zpower_gt_1 radix2 prec (prec_gt_0 prec)).
+clear ; omega.
+intros p Hp.
+apply Zle_antisym.
+cut (prec - 1 < Zdigits radix2 (Zpos p))%Z. clear ; omega.
+apply Zdigits_gt_Zpower.
+simpl Z.abs. rewrite <- Hp.
+cut (Zpower radix2 (prec - 1) < Zpower radix2 prec)%Z. clear ; omega.
+apply lt_IZR.
+rewrite 2!IZR_Zpower. 2: now apply Zlt_le_weak.
+apply bpow_lt.
+apply Zlt_pred.
+now apply Zlt_0_le_0_pred.
+apply Zdigits_le_Zpower.
+simpl Z.abs. rewrite <- Hp.
+apply Zlt_pred.
+intros p Hp.
+generalize (Zpower_gt_1 radix2 _ (prec_gt_0 prec)).
+clear -Hp ; zify ; omega.
+apply Rnot_lt_le.
+intros Hx.
+generalize (refl_equal (bounded m2 e2)).
+unfold bounded at 2.
+rewrite He2.
+rewrite Bool.andb_false_r.
+rewrite bounded_canonical_lt_emax with (2 := Hx).
+discriminate.
+unfold canonical.
+now rewrite <- H3.
+elim Rgt_not_eq with (2 := H3).
+apply Rlt_trans with R0.
+now apply F2R_lt_0.
+now apply F2R_gt_0.
+rewrite <- Hr.
+apply generic_format_abs...
+apply generic_format_round...
+(* . not m1' < 0 *)
+elim Rgt_not_eq with (2 := Hr).
+apply Rlt_le_trans with R0.
+now apply F2R_lt_0.
+apply Rabs_pos.
+(* *)
+apply Rlt_le_trans with (2 := proj1 (inbetween_float_bounds _ _ _ _ _ Bx)).
+now apply F2R_gt_0.
+(* all the modes are valid *)
+clear. case m.
+exact inbetween_int_NE_sign.
+exact inbetween_int_ZR_sign.
+exact inbetween_int_DN_sign.
+exact inbetween_int_UP_sign.
+exact inbetween_int_NA_sign.
+Qed.
+
+(** Multiplication *)
+
+Lemma Bmult_correct_aux :
+  forall m sx mx ex (Hx : bounded mx ex = true) sy my ey (Hy : bounded my ey = true),
+  let x := F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) in
+  let y := F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey) in
+  let z := binary_round_aux m (xorb sx sy) (Zpos (mx * my)) (ex + ey) loc_Exact in
+  valid_binary z = true /\
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (x * y))) (bpow radix2 emax) then
+    FF2R radix2 z = round radix2 fexp (round_mode m) (x * y) /\
+    is_finite_FF z = true /\ sign_FF z = xorb sx sy
+  else
+    z = binary_overflow m (xorb sx sy).
+Proof.
+intros m sx mx ex Hx sy my ey Hy x y.
+unfold x, y.
+rewrite <- F2R_mult.
+simpl.
+replace (xorb sx sy) with (Rlt_bool (F2R (Float radix2 (cond_Zopp sx (Zpos mx) * cond_Zopp sy (Zpos my)) (ex + ey))) 0).
+apply binary_round_aux_correct.
+constructor.
+rewrite <- F2R_abs.
+apply F2R_eq.
+rewrite Zabs_Zmult.
+now rewrite 2!abs_cond_Zopp.
+(* *)
+change (Zpos (mx * my)) with (Zpos mx * Zpos my)%Z.
+assert (forall m e, bounded m e = true -> fexp (Zdigits radix2 (Zpos m) + e) = e)%Z.
+clear. intros m e Hb.
+destruct (andb_prop _ _ Hb) as (H,_).
+apply Zeq_bool_eq.
+now rewrite <- Zpos_digits2_pos.
+generalize (H _ _ Hx) (H _ _ Hy).
+clear x y sx sy Hx Hy H.
+unfold fexp, FLT_exp.
+refine (_ (Zdigits_mult_ge radix2 (Zpos mx) (Zpos my) _ _)) ; try discriminate.
+refine (_ (Zdigits_gt_0 radix2 (Zpos mx) _) (Zdigits_gt_0 radix2 (Zpos my) _)) ; try discriminate.
+generalize (Zdigits radix2 (Zpos mx)) (Zdigits radix2 (Zpos my)) (Zdigits radix2 (Zpos mx * Zpos my)).
+clear -Hmax.
+unfold emin.
+intros dx dy dxy Hx Hy Hxy.
+zify ; intros ; subst.
+omega.
+(* *)
+case sx ; case sy.
+apply Rlt_bool_false.
+now apply F2R_ge_0.
+apply Rlt_bool_true.
+now apply F2R_lt_0.
+apply Rlt_bool_true.
+now apply F2R_lt_0.
+apply Rlt_bool_false.
+now apply F2R_ge_0.
+Qed.
+
+Definition Bmult mult_nan m x y :=
+  match x, y with
+  | B754_nan _ _ _, _ | _, B754_nan _ _ _ => build_nan (mult_nan x y)
+  | B754_infinity sx, B754_infinity sy => B754_infinity (xorb sx sy)
+  | B754_infinity sx, B754_finite sy _ _ _ => B754_infinity (xorb sx sy)
+  | B754_finite sx _ _ _, B754_infinity sy => B754_infinity (xorb sx sy)
+  | B754_infinity _, B754_zero _ => build_nan (mult_nan x y)
+  | B754_zero _, B754_infinity _ => build_nan (mult_nan x y)
+  | B754_finite sx _ _ _, B754_zero sy => B754_zero (xorb sx sy)
+  | B754_zero sx, B754_finite sy _ _ _ => B754_zero (xorb sx sy)
+  | B754_zero sx, B754_zero sy => B754_zero (xorb sx sy)
+  | B754_finite sx mx ex Hx, B754_finite sy my ey Hy =>
+    FF2B _ (proj1 (Bmult_correct_aux m sx mx ex Hx sy my ey Hy))
+  end.
+
+Theorem Bmult_correct :
+  forall mult_nan m x y,
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x * B2R y))) (bpow radix2 emax) then
+    B2R (Bmult mult_nan m x y) = round radix2 fexp (round_mode m) (B2R x * B2R y) /\
+    is_finite (Bmult mult_nan m x y) = andb (is_finite x) (is_finite y) /\
+    (is_nan (Bmult mult_nan m x y) = false ->
+      Bsign (Bmult mult_nan m x y) = xorb (Bsign x) (Bsign y))
+  else
+    B2FF (Bmult mult_nan m x y) = binary_overflow m (xorb (Bsign x) (Bsign y)).
+Proof.
+intros mult_nan m [sx|sx|sx plx Hplx|sx mx ex Hx] [sy|sy|sy ply Hply|sy my ey Hy] ;
+  try ( rewrite ?Rmult_0_r, ?Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ simpl ; try easy ; now rewrite B2R_build_nan, is_finite_build_nan, is_nan_build_nan | apply bpow_gt_0 | now auto with typeclass_instances ] ).
+simpl.
+case Bmult_correct_aux.
+intros H1.
+case Rlt_bool.
+intros (H2, (H3, H4)).
+split.
+now rewrite B2R_FF2B.
+split.
+now rewrite is_finite_FF2B.
+rewrite Bsign_FF2B. auto.
+intros H2.
+now rewrite B2FF_FF2B.
+Qed.
+
+(** Normalization and rounding *)
+
+Definition shl_align mx ex ex' :=
+  match (ex' - ex)%Z with
+  | Zneg d => (shift_pos d mx, ex')
+  | _ => (mx, ex)
+  end.
+
+Theorem shl_align_correct :
+  forall mx ex ex',
+  let (mx', ex'') := shl_align mx ex ex' in
+  F2R (Float radix2 (Zpos mx) ex) = F2R (Float radix2 (Zpos mx') ex'') /\
+  (ex'' <= ex')%Z.
+Proof.
+intros mx ex ex'.
+unfold shl_align.
+case_eq (ex' - ex)%Z.
+(* d = 0 *)
+intros H.
+repeat split.
+rewrite Zminus_eq with (1 := H).
+apply Z.le_refl.
+(* d > 0 *)
+intros d Hd.
+repeat split.
+replace ex' with (ex' - ex + ex)%Z by ring.
+rewrite Hd.
+pattern ex at 1 ; rewrite <- Zplus_0_l.
+now apply Zplus_le_compat_r.
+(* d < 0 *)
+intros d Hd.
+rewrite shift_pos_correct, Zmult_comm.
+change (Zpower_pos 2 d) with (Zpower radix2 (Zpos d)).
+change (Zpos d) with (Z.opp (Zneg d)).
+rewrite <- Hd.
+split.
+replace (- (ex' - ex))%Z with (ex - ex')%Z by ring.
+apply F2R_change_exp.
+apply Zle_0_minus_le.
+replace (ex - ex')%Z with (- (ex' - ex))%Z by ring.
+now rewrite Hd.
+apply Z.le_refl.
+Qed.
+
+Theorem snd_shl_align :
+  forall mx ex ex',
+  (ex' <= ex)%Z ->
+  snd (shl_align mx ex ex') = ex'.
+Proof.
+intros mx ex ex' He.
+unfold shl_align.
+case_eq (ex' - ex)%Z ; simpl.
+intros H.
+now rewrite Zminus_eq with (1 := H).
+intros p.
+clear -He ; zify ; omega.
+intros.
+apply refl_equal.
+Qed.
+
+Definition shl_align_fexp mx ex :=
+  shl_align mx ex (fexp (Zpos (digits2_pos mx) + ex)).
+
+Theorem shl_align_fexp_correct :
+  forall mx ex,
+  let (mx', ex') := shl_align_fexp mx ex in
+  F2R (Float radix2 (Zpos mx) ex) = F2R (Float radix2 (Zpos mx') ex') /\
+  (ex' <= fexp (Zdigits radix2 (Zpos mx') + ex'))%Z.
+Proof.
+intros mx ex.
+unfold shl_align_fexp.
+generalize (shl_align_correct mx ex (fexp (Zpos (digits2_pos mx) + ex))).
+rewrite Zpos_digits2_pos.
+case shl_align.
+intros mx' ex' (H1, H2).
+split.
+exact H1.
+rewrite <- mag_F2R_Zdigits. 2: easy.
+rewrite <- H1.
+now rewrite mag_F2R_Zdigits.
+Qed.
+
+Definition binary_round m sx mx ex :=
+  let '(mz, ez) := shl_align_fexp mx ex in binary_round_aux m sx (Zpos mz) ez loc_Exact.
+
+Theorem binary_round_correct :
+  forall m sx mx ex,
+  let z := binary_round m sx mx ex in
+  valid_binary z = true /\
+  let x := F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) in
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) x)) (bpow radix2 emax) then
+    FF2R radix2 z = round radix2 fexp (round_mode m) x /\
+    is_finite_FF z = true /\
+    sign_FF z = sx
+  else
+    z = binary_overflow m sx.
+Proof.
+intros m sx mx ex.
+unfold binary_round.
+generalize (shl_align_fexp_correct mx ex).
+destruct (shl_align_fexp mx ex) as (mz, ez).
+intros (H1, H2).
+set (x := F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex)).
+replace sx with (Rlt_bool x 0).
+apply binary_round_aux_correct.
+constructor.
+unfold x.
+now rewrite <- F2R_Zabs, abs_cond_Zopp.
+exact H2.
+unfold x.
+case sx.
+apply Rlt_bool_true.
+now apply F2R_lt_0.
+apply Rlt_bool_false.
+now apply F2R_ge_0.
+Qed.
+
+Definition binary_normalize mode m e szero :=
+  match m with
+  | Z0 => B754_zero szero
+  | Zpos m => FF2B _ (proj1 (binary_round_correct mode false m e))
+  | Zneg m => FF2B _ (proj1 (binary_round_correct mode true m e))
+  end.
+
+Theorem binary_normalize_correct :
+  forall m mx ex szero,
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (F2R (Float radix2 mx ex)))) (bpow radix2 emax) then
+    B2R (binary_normalize m mx ex szero) = round radix2 fexp (round_mode m) (F2R (Float radix2 mx ex)) /\
+    is_finite (binary_normalize m mx ex szero) = true /\
+    Bsign (binary_normalize m mx ex szero) =
+      match Rcompare (F2R (Float radix2 mx ex)) 0 with
+        | Eq => szero
+        | Lt => true
+        | Gt => false
+      end
+  else
+    B2FF (binary_normalize m mx ex szero) = binary_overflow m (Rlt_bool (F2R (Float radix2 mx ex)) 0).
+Proof with auto with typeclass_instances.
+intros m mx ez szero.
+destruct mx as [|mz|mz] ; simpl.
+rewrite F2R_0, round_0, Rabs_R0, Rlt_bool_true...
+split... split...
+rewrite Rcompare_Eq...
+apply bpow_gt_0.
+(* . mz > 0 *)
+generalize (binary_round_correct m false mz ez).
+simpl.
+case Rlt_bool_spec.
+intros _ (Vz, (Rz, (Rz', Rz''))).
+split.
+now rewrite B2R_FF2B.
+split.
+now rewrite is_finite_FF2B.
+rewrite Bsign_FF2B, Rz''.
+rewrite Rcompare_Gt...
+apply F2R_gt_0.
+simpl. zify; omega.
+intros Hz' (Vz, Rz).
+rewrite B2FF_FF2B, Rz.
+apply f_equal.
+apply sym_eq.
+apply Rlt_bool_false.
+now apply F2R_ge_0.
+(* . mz < 0 *)
+generalize (binary_round_correct m true mz ez).
+simpl.
+case Rlt_bool_spec.
+intros _ (Vz, (Rz, (Rz', Rz''))).
+split.
+now rewrite B2R_FF2B.
+split.
+now rewrite is_finite_FF2B.
+rewrite Bsign_FF2B, Rz''.
+rewrite Rcompare_Lt...
+apply F2R_lt_0.
+simpl. zify; omega.
+intros Hz' (Vz, Rz).
+rewrite B2FF_FF2B, Rz.
+apply f_equal.
+apply sym_eq.
+apply Rlt_bool_true.
+now apply F2R_lt_0.
+Qed.
+
+(** Addition *)
+
+Definition Bplus plus_nan m x y :=
+  match x, y with
+  | B754_nan _ _ _, _ | _, B754_nan _ _ _ => build_nan (plus_nan x y)
+  | B754_infinity sx, B754_infinity sy =>
+    if Bool.eqb sx sy then x else build_nan (plus_nan x y)
+  | B754_infinity _, _ => x
+  | _, B754_infinity _ => y
+  | B754_zero sx, B754_zero sy =>
+    if Bool.eqb sx sy then x else
+    match m with mode_DN => B754_zero true | _ => B754_zero false end
+  | B754_zero _, _ => y
+  | _, B754_zero _ => x
+  | B754_finite sx mx ex Hx, B754_finite sy my ey Hy =>
+    let ez := Z.min ex ey in
+    binary_normalize m (Zplus (cond_Zopp sx (Zpos (fst (shl_align mx ex ez)))) (cond_Zopp sy (Zpos (fst (shl_align my ey ez)))))
+      ez (match m with mode_DN => true | _ => false end)
+  end.
+
+Theorem Bplus_correct :
+  forall plus_nan m x y,
+  is_finite x = true ->
+  is_finite y = true ->
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x + B2R y))) (bpow radix2 emax) then
+    B2R (Bplus plus_nan m x y) = round radix2 fexp (round_mode m) (B2R x + B2R y) /\
+    is_finite (Bplus plus_nan m x y) = true /\
+    Bsign (Bplus plus_nan m x y) =
+      match Rcompare (B2R x + B2R y) 0 with
+        | Eq => match m with mode_DN => orb (Bsign x) (Bsign y)
+                                 | _ => andb (Bsign x) (Bsign y) end
+        | Lt => true
+        | Gt => false
+      end
+  else
+    (B2FF (Bplus plus_nan m x y) = binary_overflow m (Bsign x) /\ Bsign x = Bsign y).
+Proof with auto with typeclass_instances.
+intros plus_nan m [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] Fx Fy ; try easy.
+(* *)
+rewrite Rplus_0_r, round_0, Rabs_R0, Rlt_bool_true...
+simpl.
+rewrite Rcompare_Eq by auto.
+destruct sx, sy; try easy; now case m.
+apply bpow_gt_0.
+(* *)
+rewrite Rplus_0_l, round_generic, Rlt_bool_true...
+split... split...
+simpl. unfold F2R.
+erewrite <- Rmult_0_l, Rcompare_mult_r.
+rewrite Rcompare_IZR with (y:=0%Z).
+destruct sy...
+apply bpow_gt_0.
+apply abs_B2R_lt_emax.
+apply generic_format_B2R.
+(* *)
+rewrite Rplus_0_r, round_generic, Rlt_bool_true...
+split... split...
+simpl. unfold F2R.
+erewrite <- Rmult_0_l, Rcompare_mult_r.
+rewrite Rcompare_IZR with (y:=0%Z).
+destruct sx...
+apply bpow_gt_0.
+apply abs_B2R_lt_emax.
+apply generic_format_B2R.
+(* *)
+clear Fx Fy.
+simpl.
+set (szero := match m with mode_DN => true | _ => false end).
+set (ez := Z.min ex ey).
+set (mz := (cond_Zopp sx (Zpos (fst (shl_align mx ex ez))) + cond_Zopp sy (Zpos (fst (shl_align my ey ez))))%Z).
+assert (Hp: (F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) +
+  F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey))%R = F2R (Float radix2 mz ez)).
+rewrite 2!F2R_cond_Zopp.
+generalize (shl_align_correct mx ex ez).
+generalize (shl_align_correct my ey ez).
+generalize (snd_shl_align mx ex ez (Z.le_min_l ex ey)).
+generalize (snd_shl_align my ey ez (Z.le_min_r ex ey)).
+destruct (shl_align mx ex ez) as (mx', ex').
+destruct (shl_align my ey ez) as (my', ey').
+simpl.
+intros H1 H2.
+rewrite H1, H2.
+clear H1 H2.
+intros (H1, _) (H2, _).
+rewrite H1, H2.
+clear H1 H2.
+rewrite <- 2!F2R_cond_Zopp.
+unfold F2R. simpl.
+now rewrite <- Rmult_plus_distr_r, <- plus_IZR.
+rewrite Hp.
+assert (Sz: (bpow radix2 emax <= Rabs (round radix2 fexp (round_mode m) (F2R (Float radix2 mz ez))))%R -> sx = Rlt_bool (F2R (Float radix2 mz ez)) 0 /\ sx = sy).
+(* . *)
+rewrite <- Hp.
+intros Bz.
+destruct (Bool.bool_dec sx sy) as [Hs|Hs].
+(* .. *)
+refine (conj _ Hs).
+rewrite Hs.
+apply sym_eq.
+case sy.
+apply Rlt_bool_true.
+rewrite <- (Rplus_0_r 0).
+apply Rplus_lt_compat.
+now apply F2R_lt_0.
+now apply F2R_lt_0.
+apply Rlt_bool_false.
+rewrite <- (Rplus_0_r 0).
+apply Rplus_le_compat.
+now apply F2R_ge_0.
+now apply F2R_ge_0.
+(* .. *)
+elim Rle_not_lt with (1 := Bz).
+generalize (bounded_lt_emax _ _ Hx) (bounded_lt_emax _ _ Hy) (andb_prop _ _ Hx) (andb_prop _ _ Hy).
+intros Bx By (Hx',_) (Hy',_).
+generalize (canonical_canonical_mantissa sx _ _ Hx') (canonical_canonical_mantissa sy _ _ Hy').
+clear -Bx By Hs prec_gt_0_.
+intros Cx Cy.
+destruct sx.
+(* ... *)
+destruct sy.
+now elim Hs.
+clear Hs.
+apply Rabs_lt.
+split.
+apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)).
+rewrite F2R_Zopp.
+now apply Ropp_lt_contravar.
+apply round_ge_generic...
+now apply generic_format_canonical.
+pattern (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)) at 1 ; rewrite <- Rplus_0_r.
+apply Rplus_le_compat_l.
+now apply F2R_ge_0.
+apply Rle_lt_trans with (2 := By).
+apply round_le_generic...
+now apply generic_format_canonical.
+rewrite <- (Rplus_0_l (F2R (Float radix2 (Zpos my) ey))).
+apply Rplus_le_compat_r.
+now apply F2R_le_0.
+(* ... *)
+destruct sy.
+2: now elim Hs.
+clear Hs.
+apply Rabs_lt.
+split.
+apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)).
+rewrite F2R_Zopp.
+now apply Ropp_lt_contravar.
+apply round_ge_generic...
+now apply generic_format_canonical.
+pattern (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)) at 1 ; rewrite <- Rplus_0_l.
+apply Rplus_le_compat_r.
+now apply F2R_ge_0.
+apply Rle_lt_trans with (2 := Bx).
+apply round_le_generic...
+now apply generic_format_canonical.
+rewrite <- (Rplus_0_r (F2R (Float radix2 (Zpos mx) ex))).
+apply Rplus_le_compat_l.
+now apply F2R_le_0.
+(* . *)
+generalize (binary_normalize_correct m mz ez szero).
+case Rlt_bool_spec.
+split; try easy. split; try easy.
+destruct (Rcompare_spec (F2R (beta:=radix2) {| Fnum := mz; Fexp := ez |}) 0); try easy.
+rewrite H1 in Hp.
+apply Rplus_opp_r_uniq in Hp.
+rewrite <- F2R_Zopp in Hp.
+eapply canonical_unique in Hp.
+inversion Hp. destruct sy, sx, m; try discriminate H3; easy.
+apply canonical_canonical_mantissa.
+apply Bool.andb_true_iff in Hy. easy.
+replace (-cond_Zopp sx (Z.pos mx))%Z with (cond_Zopp (negb sx) (Z.pos mx))
+  by (destruct sx; auto).
+apply canonical_canonical_mantissa.
+apply Bool.andb_true_iff in Hx. easy.
+intros Hz' Vz.
+specialize (Sz Hz').
+split.
+rewrite Vz.
+now apply f_equal.
+apply Sz.
+Qed.
+
+(** Subtraction *)
+
+Definition Bminus minus_nan m x y :=
+  match x, y with
+  | B754_nan _ _ _, _ | _, B754_nan _ _ _ => build_nan (minus_nan x y)
+  | B754_infinity sx, B754_infinity sy =>
+    if Bool.eqb sx (negb sy) then x else build_nan (minus_nan x y)
+  | B754_infinity _, _ => x
+  | _, B754_infinity sy => B754_infinity (negb sy)
+  | B754_zero sx, B754_zero sy =>
+    if Bool.eqb sx (negb sy) then x else
+    match m with mode_DN => B754_zero true | _ => B754_zero false end
+  | B754_zero _, B754_finite sy my ey Hy => B754_finite (negb sy) my ey Hy
+  | _, B754_zero _ => x
+  | B754_finite sx mx ex Hx, B754_finite sy my ey Hy =>
+    let ez := Z.min ex ey in
+    binary_normalize m (Zminus (cond_Zopp sx (Zpos (fst (shl_align mx ex ez)))) (cond_Zopp sy (Zpos (fst (shl_align my ey ez)))))
+      ez (match m with mode_DN => true | _ => false end)
+  end.
+
+Theorem Bminus_correct :
+  forall minus_nan m x y,
+  is_finite x = true ->
+  is_finite y = true ->
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x - B2R y))) (bpow radix2 emax) then
+    B2R (Bminus minus_nan m x y) = round radix2 fexp (round_mode m) (B2R x - B2R y) /\
+    is_finite (Bminus minus_nan m x y) = true /\
+    Bsign (Bminus minus_nan m x y) =
+      match Rcompare (B2R x - B2R y) 0 with
+        | Eq => match m with mode_DN => orb (Bsign x) (negb (Bsign y))
+                                 | _ => andb (Bsign x) (negb (Bsign y)) end
+        | Lt => true
+        | Gt => false
+      end
+  else
+    (B2FF (Bminus minus_nan m x y) = binary_overflow m (Bsign x) /\ Bsign x = negb (Bsign y)).
+Proof with auto with typeclass_instances.
+intros minus_nan m x y Fx Fy.
+generalize (Bplus_correct minus_nan m x (Bopp (fun n => minus_nan n (B754_zero false)) y) Fx).
+rewrite is_finite_Bopp, B2R_Bopp.
+intros H.
+specialize (H Fy).
+replace (negb (Bsign y)) with (Bsign (Bopp (fun n => minus_nan n (B754_zero false)) y)).
+destruct x as [| | |sx mx ex Hx], y as [| | |sy my ey Hy] ; try easy.
+unfold Bminus, Zminus.
+now rewrite <- cond_Zopp_negb.
+now destruct y as [ | | | ].
+Qed.
+
+(** Division *)
+
+Definition Fdiv_core_binary m1 e1 m2 e2 :=
+  let d1 := Zdigits2 m1 in
+  let d2 := Zdigits2 m2 in
+  let e' := Z.min (fexp (d1 + e1 - (d2 + e2))) (e1 - e2) in
+  let s := (e1 - e2 - e')%Z in
+  let m' :=
+    match s with
+    | Zpos _  => Z.shiftl m1 s
+    | Z0 => m1
+    | Zneg _ => Z0
+    end in
+  let '(q, r) :=  Zfast_div_eucl m' m2 in
+  (q, e', new_location m2 r loc_Exact).
+
+Lemma Bdiv_correct_aux :
+  forall m sx mx ex sy my ey,
+  let x := F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) in
+  let y := F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey) in
+  let z :=
+    let '(mz, ez, lz) := Fdiv_core_binary (Zpos mx) ex (Zpos my) ey in
+    binary_round_aux m (xorb sx sy) mz ez lz in
+  valid_binary z = true /\
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (x / y))) (bpow radix2 emax) then
+    FF2R radix2 z = round radix2 fexp (round_mode m) (x / y) /\
+    is_finite_FF z = true /\ sign_FF z = xorb sx sy
+  else
+    z = binary_overflow m (xorb sx sy).
+Proof.
+intros m sx mx ex sy my ey.
+unfold Fdiv_core_binary.
+rewrite 2!Zdigits2_Zdigits.
+set (e' := Z.min _ _).
+generalize (Fdiv_core_correct radix2 (Zpos mx) ex (Zpos my) ey e' eq_refl eq_refl).
+unfold Fdiv_core.
+rewrite Zle_bool_true by apply Z.le_min_r.
+match goal with |- context [Zfast_div_eucl ?m _] => set (mx' := m) end.
+assert (mx' = Zpos mx * Zpower radix2 (ex - ey - e'))%Z as <-.
+{ unfold mx'.
+  destruct (ex - ey - e')%Z as [|p|p].
+  now rewrite Zmult_1_r.
+  now rewrite Z.shiftl_mul_pow2.
+  easy. }
+clearbody mx'.
+rewrite Zfast_div_eucl_correct.
+destruct Z.div_eucl as [q r].
+intros Bz.
+assert (xorb sx sy = Rlt_bool (F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) *
+  / F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey)) 0) as ->.
+{ apply eq_sym.
+case sy ; simpl.
+change (Zneg my) with (Z.opp (Zpos my)).
+rewrite F2R_Zopp.
+rewrite <- Ropp_inv_permute.
+rewrite Ropp_mult_distr_r_reverse.
+case sx ; simpl.
+apply Rlt_bool_false.
+rewrite <- Ropp_mult_distr_l_reverse.
+apply Rmult_le_pos.
+rewrite <- F2R_opp.
+now apply F2R_ge_0.
+apply Rlt_le.
+apply Rinv_0_lt_compat.
+now apply F2R_gt_0.
+apply Rlt_bool_true.
+rewrite <- Ropp_0.
+apply Ropp_lt_contravar.
+apply Rmult_lt_0_compat.
+now apply F2R_gt_0.
+apply Rinv_0_lt_compat.
+now apply F2R_gt_0.
+apply Rgt_not_eq.
+now apply F2R_gt_0.
+case sx.
+apply Rlt_bool_true.
+rewrite F2R_Zopp.
+rewrite Ropp_mult_distr_l_reverse.
+rewrite <- Ropp_0.
+apply Ropp_lt_contravar.
+apply Rmult_lt_0_compat.
+now apply F2R_gt_0.
+apply Rinv_0_lt_compat.
+now apply F2R_gt_0.
+apply Rlt_bool_false.
+apply Rmult_le_pos.
+now apply F2R_ge_0.
+apply Rlt_le.
+apply Rinv_0_lt_compat.
+now apply F2R_gt_0. }
+unfold Rdiv.
+apply binary_round_aux_correct'.
+- apply Rmult_integral_contrapositive_currified.
+  now apply F2R_neq_0 ; case sx.
+  apply Rinv_neq_0_compat.
+  now apply F2R_neq_0 ; case sy.
+- rewrite Rabs_mult, Rabs_Rinv.
+  now rewrite <- 2!F2R_Zabs, 2!abs_cond_Zopp.
+  now apply F2R_neq_0 ; case sy.
+- rewrite <- cexp_abs, Rabs_mult, Rabs_Rinv.
+  rewrite 2!F2R_cond_Zopp, 2!abs_cond_Ropp, <- Rabs_Rinv.
+  rewrite <- Rabs_mult, cexp_abs.
+  apply Z.le_trans with (1 := Z.le_min_l _ _).
+  apply FLT_exp_monotone.
+  now apply mag_div_F2R.
+  now apply F2R_neq_0.
+  now apply F2R_neq_0 ; case sy.
+Qed.
+
+Definition Bdiv div_nan m x y :=
+  match x, y with
+  | B754_nan _ _ _, _ | _, B754_nan _ _ _ => build_nan (div_nan x y)
+  | B754_infinity sx, B754_infinity sy => build_nan (div_nan x y)
+  | B754_infinity sx, B754_finite sy _ _ _ => B754_infinity (xorb sx sy)
+  | B754_finite sx _ _ _, B754_infinity sy => B754_zero (xorb sx sy)
+  | B754_infinity sx, B754_zero sy => B754_infinity (xorb sx sy)
+  | B754_zero sx, B754_infinity sy => B754_zero (xorb sx sy)
+  | B754_finite sx _ _ _, B754_zero sy => B754_infinity (xorb sx sy)
+  | B754_zero sx, B754_finite sy _ _ _ => B754_zero (xorb sx sy)
+  | B754_zero sx, B754_zero sy => build_nan (div_nan x y)
+  | B754_finite sx mx ex _, B754_finite sy my ey _ =>
+    FF2B _ (proj1 (Bdiv_correct_aux m sx mx ex sy my ey))
+  end.
+
+Theorem Bdiv_correct :
+  forall div_nan m x y,
+  B2R y <> 0%R ->
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x / B2R y))) (bpow radix2 emax) then
+    B2R (Bdiv div_nan m x y) = round radix2 fexp (round_mode m) (B2R x / B2R y) /\
+    is_finite (Bdiv div_nan m x y) = is_finite x /\
+    (is_nan (Bdiv div_nan m x y) = false ->
+      Bsign (Bdiv div_nan m x y) = xorb (Bsign x) (Bsign y))
+  else
+    B2FF (Bdiv div_nan m x y) = binary_overflow m (xorb (Bsign x) (Bsign y)).
+Proof.
+intros div_nan m x [sy|sy|sy ply|sy my ey Hy] Zy ; try now elim Zy.
+revert x.
+unfold Rdiv.
+intros [sx|sx|sx plx Hx|sx mx ex Hx] ;
+  try ( rewrite Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ simpl ; try easy ; now rewrite B2R_build_nan, is_finite_build_nan, is_nan_build_nan | apply bpow_gt_0 | auto with typeclass_instances ] ).
+simpl.
+case Bdiv_correct_aux.
+intros H1.
+unfold Rdiv.
+case Rlt_bool.
+intros (H2, (H3, H4)).
+split.
+now rewrite B2R_FF2B.
+split.
+now rewrite is_finite_FF2B.
+rewrite Bsign_FF2B. congruence.
+intros H2.
+now rewrite B2FF_FF2B.
+Qed.
+
+(** Square root *)
+
+Definition Fsqrt_core_binary m e :=
+  let d := Zdigits2 m in
+  let e' := Z.min (fexp (Z.div2 (d + e + 1))) (Z.div2 e) in
+  let s := (e - 2 * e')%Z in
+  let m' :=
+    match s with
+    | Zpos p => Z.shiftl m s
+    | Z0 => m
+    | Zneg _ => Z0
+    end in
+  let (q, r) := Z.sqrtrem m' in
+  let l :=
+    if Zeq_bool r 0 then loc_Exact
+    else loc_Inexact (if Zle_bool r q then Lt else Gt) in
+  (q, e', l).
+
+Lemma Bsqrt_correct_aux :
+  forall m mx ex (Hx : bounded mx ex = true),
+  let x := F2R (Float radix2 (Zpos mx) ex) in
+  let z :=
+    let '(mz, ez, lz) := Fsqrt_core_binary (Zpos mx) ex in
+    binary_round_aux m false mz ez lz in
+  valid_binary z = true /\
+  FF2R radix2 z = round radix2 fexp (round_mode m) (sqrt x) /\
+  is_finite_FF z = true /\ sign_FF z = false.
+Proof with auto with typeclass_instances.
+intros m mx ex Hx.
+unfold Fsqrt_core_binary.
+rewrite Zdigits2_Zdigits.
+set (e' := Z.min _ _).
+assert (2 * e' <= ex)%Z as He.
+{ assert (e' <= Z.div2 ex)%Z by apply Z.le_min_r.
+  rewrite (Zdiv2_odd_eqn ex).
+  destruct Z.odd ; omega. }
+generalize (Fsqrt_core_correct radix2 (Zpos mx) ex e' eq_refl He).
+unfold Fsqrt_core.
+set (mx' := match (ex - 2 * e')%Z with Z0 => _ | _ => _ end).
+assert (mx' = Zpos mx * Zpower radix2 (ex - 2 * e'))%Z as <-.
+{ unfold mx'.
+  destruct (ex - 2 * e')%Z as [|p|p].
+  now rewrite Zmult_1_r.
+  now rewrite Z.shiftl_mul_pow2.
+  easy. }
+clearbody mx'.
+destruct Z.sqrtrem as [mz r].
+set (lz := if Zeq_bool r 0 then _ else _).
+clearbody lz.
+intros Bz.
+refine (_ (binary_round_aux_correct' m (sqrt (F2R (Float radix2 (Zpos mx) ex))) mz e' lz _ _ _)) ; cycle 1.
+  now apply Rgt_not_eq, sqrt_lt_R0, F2R_gt_0.
+  rewrite Rabs_pos_eq.
+  exact Bz.
+  apply sqrt_ge_0.
+  apply Z.le_trans with (1 := Z.le_min_l _ _).
+  apply FLT_exp_monotone.
+  rewrite mag_sqrt_F2R by easy.
+  apply Z.le_refl.
+rewrite Rlt_bool_false by apply sqrt_ge_0.
+rewrite Rlt_bool_true.
+easy.
+rewrite Rabs_pos_eq.
+refine (_ (relative_error_FLT_ex radix2 emin prec (prec_gt_0 prec) (round_mode m) (sqrt (F2R (Float radix2 (Zpos mx) ex))) _)).
+fold fexp.
+intros (eps, (Heps, Hr)).
+rewrite Hr.
+assert (Heps': (Rabs eps < 1)%R).
+apply Rlt_le_trans with (1 := Heps).
+fold (bpow radix2 0).
+apply bpow_le.
+generalize (prec_gt_0 prec).
+clear ; omega.
+apply Rsqr_incrst_0.
+3: apply bpow_ge_0.
+rewrite Rsqr_mult.
+rewrite Rsqr_sqrt.
+2: now apply F2R_ge_0.
+unfold Rsqr.
+apply Rmult_ge_0_gt_0_lt_compat.
+apply Rle_ge.
+apply Rle_0_sqr.
+apply bpow_gt_0.
+now apply bounded_lt_emax.
+apply Rlt_le_trans with 4%R.
+apply (Rsqr_incrst_1 _ 2).
+apply Rplus_lt_compat_l.
+apply (Rabs_lt_inv _ _ Heps').
+rewrite <- (Rplus_opp_r 1).
+apply Rplus_le_compat_l.
+apply Rlt_le.
+apply (Rabs_lt_inv _ _ Heps').
+now apply IZR_le.
+change 4%R with (bpow radix2 2).
+apply bpow_le.
+generalize (prec_gt_0 prec).
+clear -Hmax ; omega.
+apply Rmult_le_pos.
+apply sqrt_ge_0.
+rewrite <- (Rplus_opp_r 1).
+apply Rplus_le_compat_l.
+apply Rlt_le.
+apply (Rabs_lt_inv _ _ Heps').
+rewrite Rabs_pos_eq.
+2: apply sqrt_ge_0.
+apply Rsqr_incr_0.
+2: apply bpow_ge_0.
+2: apply sqrt_ge_0.
+rewrite Rsqr_sqrt.
+2: now apply F2R_ge_0.
+apply Rle_trans with (bpow radix2 emin).
+unfold Rsqr.
+rewrite <- bpow_plus.
+apply bpow_le.
+unfold emin.
+clear -Hmax ; omega.
+apply generic_format_ge_bpow with fexp.
+intros.
+apply Z.le_max_r.
+now apply F2R_gt_0.
+apply generic_format_canonical.
+apply (canonical_canonical_mantissa false).
+apply (andb_prop _ _ Hx).
+apply round_ge_generic...
+apply generic_format_0.
+apply sqrt_ge_0.
+Qed.
+
+Definition Bsqrt sqrt_nan m x :=
+  match x with
+  | B754_nan sx plx _ => build_nan (sqrt_nan x)
+  | B754_infinity false => x
+  | B754_infinity true => build_nan (sqrt_nan x)
+  | B754_finite true _ _ _ => build_nan (sqrt_nan x)
+  | B754_zero _ => x
+  | B754_finite sx mx ex Hx =>
+    FF2B _ (proj1 (Bsqrt_correct_aux m mx ex Hx))
+  end.
+
+Theorem Bsqrt_correct :
+  forall sqrt_nan m x,
+  B2R (Bsqrt sqrt_nan m x) = round radix2 fexp (round_mode m) (sqrt (B2R x)) /\
+  is_finite (Bsqrt sqrt_nan m x) = match x with B754_zero _ => true | B754_finite false _ _ _ => true | _ => false end /\
+  (is_nan (Bsqrt sqrt_nan m x) = false -> Bsign (Bsqrt sqrt_nan m x) = Bsign x).
+Proof.
+intros sqrt_nan m [sx|[|]|sx plx Hplx|sx mx ex Hx] ;
+  try ( simpl ; rewrite sqrt_0, round_0, ?B2R_build_nan, ?is_finite_build_nan, ?is_nan_build_nan ; intuition auto with typeclass_instances ; easy).
+simpl.
+case Bsqrt_correct_aux.
+intros H1 (H2, (H3, H4)).
+case sx.
+rewrite B2R_build_nan, is_finite_build_nan, is_nan_build_nan.
+refine (conj _ (conj (refl_equal false) _)).
+apply sym_eq.
+unfold sqrt.
+case Rcase_abs.
+intros _.
+apply round_0.
+auto with typeclass_instances.
+intros H.
+elim Rge_not_lt with (1 := H).
+now apply F2R_lt_0.
+easy.
+split.
+now rewrite B2R_FF2B.
+split.
+now rewrite is_finite_FF2B.
+intros _.
+now rewrite Bsign_FF2B.
+Qed.
+
+(** A few values *)
+
+Definition Bone := FF2B _ (proj1 (binary_round_correct mode_NE false 1 0)).
+
+Theorem Bone_correct : B2R Bone = 1%R.
+Proof.
+unfold Bone; simpl.
+set (Hr := binary_round_correct _ _ _ _).
+unfold Hr; rewrite B2R_FF2B.
+destruct Hr as (Vz, Hr).
+revert Hr.
+fold emin; simpl.
+rewrite round_generic; [|now apply valid_rnd_N|].
+- unfold F2R; simpl; rewrite Rmult_1_r.
+  rewrite Rlt_bool_true.
+  + now intros (Hr, Hr'); rewrite Hr.
+  + rewrite Rabs_pos_eq; [|lra].
+    change 1%R with (bpow radix2 0); apply bpow_lt.
+    unfold Prec_gt_0 in prec_gt_0_; lia.
+- apply generic_format_F2R; intros _.
+  unfold cexp, fexp, FLT_exp, F2R; simpl; rewrite Rmult_1_r, mag_1.
+  unfold emin; unfold Prec_gt_0 in prec_gt_0_; lia.
+Qed.
+
+Lemma is_finite_Bone : is_finite Bone = true.
+Proof.
+generalize Bone_correct; case Bone; simpl;
+ try (intros; reflexivity); intros; exfalso; lra.
+Qed.
+
+Lemma Bsign_Bone : Bsign Bone = false.
+Proof.
+generalize Bone_correct; case Bone; simpl;
+  try (intros; exfalso; lra); intros s' m e _.
+case s'; [|now intro]; unfold F2R; simpl.
+intro H; exfalso; revert H; apply Rlt_not_eq, (Rle_lt_trans _ 0); [|lra].
+rewrite <-Ropp_0, <-(Ropp_involutive (_ * _)); apply Ropp_le_contravar.
+rewrite Ropp_mult_distr_l; apply Rmult_le_pos; [|now apply bpow_ge_0].
+unfold IZR; rewrite <-INR_IPR; generalize (INR_pos m); lra.
+Qed.
+
+Lemma Bmax_float_proof :
+  valid_binary
+    (F754_finite false (shift_pos (Z.to_pos prec) 1 - 1) (emax - prec))
+  = true.
+Proof.
+unfold valid_binary, bounded; apply andb_true_intro; split.
+- unfold canonical_mantissa; apply Zeq_bool_true.
+  set (p := Z.pos (digits2_pos _)).
+  assert (H : p = prec).
+  { unfold p; rewrite Zpos_digits2_pos, Pos2Z.inj_sub.
+    - rewrite shift_pos_correct, Z.mul_1_r.
+      assert (P2pm1 : (0 <= 2 ^ prec - 1)%Z).
+      { apply (Zplus_le_reg_r _ _ 1); ring_simplify.
+        change 1%Z with (2 ^ 0)%Z; change 2%Z with (radix2 : Z).
+        apply Zpower_le; unfold Prec_gt_0 in prec_gt_0_; lia. }
+      apply Zdigits_unique;
+        rewrite Z.pow_pos_fold, Z2Pos.id; [|exact prec_gt_0_]; simpl; split.
+      + rewrite (Z.abs_eq _ P2pm1).
+        replace prec with (prec - 1 + 1)%Z at 2 by ring.
+        rewrite Zpower_plus; [| unfold Prec_gt_0 in prec_gt_0_; lia|lia].
+        simpl; unfold Z.pow_pos; simpl.
+        assert (1 <= 2 ^ (prec - 1))%Z; [|lia].
+        change 1%Z with (2 ^ 0)%Z; change 2%Z with (radix2 : Z).
+        apply Zpower_le; simpl; unfold Prec_gt_0 in prec_gt_0_; lia.
+      + now rewrite Z.abs_eq; [lia|].
+    - change (_ < _)%positive
+        with (Z.pos 1 < Z.pos (shift_pos (Z.to_pos prec) 1))%Z.
+      rewrite shift_pos_correct, Z.mul_1_r, Z.pow_pos_fold.
+      rewrite Z2Pos.id; [|exact prec_gt_0_].
+      change 1%Z with (2 ^ 0)%Z; change 2%Z with (radix2 : Z).
+      apply Zpower_lt; unfold Prec_gt_0 in prec_gt_0_; lia. }
+  unfold fexp, FLT_exp; rewrite H, Z.max_l; [ring|].
+  unfold Prec_gt_0 in prec_gt_0_; unfold emin; lia.
+- apply Zle_bool_true; unfold emin; unfold Prec_gt_0 in prec_gt_0_; lia.
+Qed.
+
+Definition Bmax_float := FF2B _ Bmax_float_proof.
+
+(** Extraction/modification of mantissa/exponent *)
+
+Definition Bnormfr_mantissa x :=
+  match x with
+  | B754_finite _ mx ex _ =>
+    if Z.eqb ex (-prec)%Z then Npos mx else 0%N
+  | _ => 0%N
+  end.
+
+Definition Bldexp mode f e :=
+  match f with
+  | B754_finite sx mx ex _ =>
+    FF2B _ (proj1 (binary_round_correct mode sx mx (ex+e)))
+  | _ => f
+  end.
+
+Theorem Bldexp_correct :
+  forall m (f : binary_float) e,
+  if Rlt_bool
+       (Rabs (round radix2 fexp (round_mode m) (B2R f * bpow radix2 e)))
+       (bpow radix2 emax) then
+    (B2R (Bldexp m f e)
+     = round radix2 fexp (round_mode m) (B2R f * bpow radix2 e))%R /\
+    is_finite (Bldexp m f e) = is_finite f /\
+    Bsign (Bldexp m f e) = Bsign f
+  else
+    B2FF (Bldexp m f e) = binary_overflow m (Bsign f).
+Proof.
+intros m f e.
+case f.
+- intro s; simpl; rewrite Rmult_0_l, round_0; [|apply valid_rnd_round_mode].
+  now rewrite Rabs_R0, Rlt_bool_true; [|now apply bpow_gt_0].
+- intro s; simpl; rewrite Rmult_0_l, round_0; [|apply valid_rnd_round_mode].
+  now rewrite Rabs_R0, Rlt_bool_true; [|now apply bpow_gt_0].
+- intro s; simpl; rewrite Rmult_0_l, round_0; [|apply valid_rnd_round_mode].
+  now rewrite Rabs_R0, Rlt_bool_true; [|now apply bpow_gt_0].
+- intros s mf ef Hmef.
+  case (Rlt_bool_spec _ _); intro Hover.
+  + unfold Bldexp; rewrite B2R_FF2B, is_finite_FF2B, Bsign_FF2B.
+    simpl; unfold F2R; simpl; rewrite Rmult_assoc, <-bpow_plus.
+    destruct (binary_round_correct m s mf (ef + e)) as (Hf, Hr).
+    fold emin in Hr; simpl in Hr; rewrite Rlt_bool_true in Hr.
+    * now destruct Hr as (Hr, (Hfr, Hsr)); rewrite Hr, Hfr, Hsr.
+    * now revert Hover; unfold B2R, F2R; simpl; rewrite Rmult_assoc, bpow_plus.
+  + unfold Bldexp; rewrite B2FF_FF2B; simpl.
+    destruct (binary_round_correct m s mf (ef + e)) as (Hf, Hr).
+    fold emin in Hr; simpl in Hr; rewrite Rlt_bool_false in Hr; [exact Hr|].
+    now revert Hover; unfold B2R, F2R; simpl; rewrite Rmult_assoc, bpow_plus.
+Qed.
+
+(** This hypothesis is needed to implement Bfrexp
+    (otherwise, we have emin > - prec
+     and Bfrexp cannot fit the mantissa in interval [0.5, 1)) *)
+Hypothesis Hemax : (3 <= emax)%Z.
+
+Definition Ffrexp_core_binary s m e :=
+  if (Z.to_pos prec <=? digits2_pos m)%positive then
+    (F754_finite s m (-prec), (e + prec)%Z)
+  else
+    let d := (prec - Z.pos (digits2_pos m))%Z in
+    (F754_finite s (shift_pos (Z.to_pos d) m) (-prec), (e + prec - d)%Z).
+
+Lemma Bfrexp_correct_aux :
+  forall sx mx ex (Hx : bounded mx ex = true),
+  let x := F2R (Float radix2 (cond_Zopp sx (Z.pos mx)) ex) in
+  let z := fst (Ffrexp_core_binary sx mx ex) in
+  let e := snd (Ffrexp_core_binary sx mx ex) in
+  valid_binary z = true /\
+  (/2 <= Rabs (FF2R radix2 z) < 1)%R /\
+  (x = FF2R radix2 z * bpow radix2 e)%R.
+Proof.
+intros sx mx ex Bx.
+set (x := F2R _).
+set (z := fst _).
+set (e := snd _); simpl.
+assert (Dmx_le_prec : (Z.pos (digits2_pos mx) <= prec)%Z).
+{ revert Bx; unfold bounded; rewrite Bool.andb_true_iff.
+  unfold canonical_mantissa; rewrite <-Zeq_is_eq_bool; unfold fexp, FLT_exp.
+  case (Z.max_spec (Z.pos (digits2_pos mx) + ex - prec) emin); lia. }
+assert (Dmx_le_prec' : (digits2_pos mx <= Z.to_pos prec)%positive).
+{ change (_ <= _)%positive
+    with (Z.pos (digits2_pos mx) <= Z.pos (Z.to_pos prec))%Z.
+  now rewrite Z2Pos.id; [|now apply prec_gt_0_]. }
+unfold z, e, Ffrexp_core_binary.
+case (Pos.leb_spec _ _); simpl; intro Dmx.
+- unfold bounded, F2R; simpl.
+  assert (Dmx' : digits2_pos mx = Z.to_pos prec).
+  { now apply Pos.le_antisym. }
+  assert (Dmx'' : Z.pos (digits2_pos mx) = prec).
+  { now rewrite Dmx', Z2Pos.id; [|apply prec_gt_0_]. }
+  split; [|split].
+  + apply andb_true_intro.
+    split; [|apply Zle_bool_true; lia].
+    apply Zeq_bool_true; unfold fexp, FLT_exp.
+    rewrite Dmx', Z2Pos.id; [|now apply prec_gt_0_].
+    rewrite Z.max_l; [ring|unfold emin; lia].
+  + rewrite Rabs_mult, (Rabs_pos_eq (bpow _ _)); [|now apply bpow_ge_0].
+    rewrite <-abs_IZR, abs_cond_Zopp; simpl; split.
+    * apply (Rmult_le_reg_r (bpow radix2 prec)); [now apply bpow_gt_0|].
+      rewrite Rmult_assoc, <-bpow_plus, Z.add_opp_diag_l; simpl.
+      rewrite Rmult_1_r.
+      change (/ 2)%R with (bpow radix2 (- 1)); rewrite <-bpow_plus.
+      rewrite <-Dmx'', Z.add_comm, Zpos_digits2_pos, Zdigits_mag; [|lia].
+      set (b := bpow _ _).
+      rewrite <-(Rabs_pos_eq (IZR _)); [|apply IZR_le; lia].
+      apply bpow_mag_le; apply IZR_neq; lia.
+    * apply (Rmult_lt_reg_r (bpow radix2 prec)); [now apply bpow_gt_0|].
+      rewrite Rmult_assoc, <-bpow_plus, Z.add_opp_diag_l; simpl.
+      rewrite Rmult_1_l, Rmult_1_r.
+      rewrite <-Dmx'', Zpos_digits2_pos, Zdigits_mag; [|lia].
+      set (b := bpow _ _).
+      rewrite <-(Rabs_pos_eq (IZR _)); [|apply IZR_le; lia].
+      apply bpow_mag_gt; apply IZR_neq; lia.
+  + unfold x, F2R; simpl; rewrite Rmult_assoc, <-bpow_plus.
+    now replace (_ + _)%Z with ex by ring.
+- unfold bounded, F2R; simpl.
+  assert (Dmx' : (Z.pos (digits2_pos mx) < prec)%Z).
+  { now rewrite <-(Z2Pos.id prec); [|now apply prec_gt_0_]. }
+  split; [|split].
+  + unfold bounded; apply andb_true_intro.
+    split; [|apply Zle_bool_true; lia].
+    apply Zeq_bool_true; unfold fexp, FLT_exp.
+    rewrite Zpos_digits2_pos, shift_pos_correct, Z.pow_pos_fold.
+    rewrite Z2Pos.id; [|lia].
+    rewrite Z.mul_comm; change 2%Z with (radix2 : Z).
+    rewrite Zdigits_mult_Zpower; [|lia|lia].
+    rewrite Zpos_digits2_pos; replace (_ - _)%Z with (- prec)%Z by ring.
+    now rewrite Z.max_l; [|unfold emin; lia].
+  + rewrite Rabs_mult, (Rabs_pos_eq (bpow _ _)); [|now apply bpow_ge_0].
+    rewrite <-abs_IZR, abs_cond_Zopp; simpl.
+    rewrite shift_pos_correct, mult_IZR.
+    change (IZR (Z.pow_pos _ _))
+      with (bpow radix2 (Z.pos (Z.to_pos ((prec - Z.pos (digits2_pos mx)))))).
+    rewrite Z2Pos.id; [|lia].
+    rewrite Rmult_comm, <-Rmult_assoc, <-bpow_plus.
+    set (d := Z.pos (digits2_pos mx)).
+    replace (_ + _)%Z with (- d)%Z by ring; split.
+    * apply (Rmult_le_reg_l (bpow radix2 d)); [now apply bpow_gt_0|].
+      rewrite <-Rmult_assoc, <-bpow_plus, Z.add_opp_diag_r.
+      rewrite Rmult_1_l.
+      change (/ 2)%R with (bpow radix2 (- 1)); rewrite <-bpow_plus.
+      rewrite <-(Rabs_pos_eq (IZR _)); [|apply IZR_le; lia].
+      unfold d; rewrite Zpos_digits2_pos, Zdigits_mag; [|lia].
+      apply bpow_mag_le; apply IZR_neq; lia.
+    * apply (Rmult_lt_reg_l (bpow radix2 d)); [now apply bpow_gt_0|].
+      rewrite <-Rmult_assoc, <-bpow_plus, Z.add_opp_diag_r.
+      rewrite Rmult_1_l, Rmult_1_r.
+      rewrite <-(Rabs_pos_eq (IZR _)); [|apply IZR_le; lia].
+      unfold d; rewrite Zpos_digits2_pos, Zdigits_mag; [|lia].
+      apply bpow_mag_gt; apply IZR_neq; lia.
+  + rewrite Rmult_assoc, <-bpow_plus, shift_pos_correct.
+    rewrite IZR_cond_Zopp, mult_IZR, cond_Ropp_mult_r, <-IZR_cond_Zopp.
+    change (IZR (Z.pow_pos _ _))
+      with (bpow radix2 (Z.pos (Z.to_pos (prec - Z.pos (digits2_pos mx))))).
+    rewrite Z2Pos.id; [|lia].
+    rewrite Rmult_comm, <-Rmult_assoc, <-bpow_plus.
+    now replace (_ + _)%Z with ex by ring; rewrite Rmult_comm.
+Qed.
+
+Definition Bfrexp f :=
+  match f with
+  | B754_finite s m e H =>
+    let e' := snd (Ffrexp_core_binary s m e) in
+    (FF2B _ (proj1 (Bfrexp_correct_aux s m e H)), e')
+  | _ => (f, (-2*emax-prec)%Z)
+  end.
+
+Theorem Bfrexp_correct :
+  forall f,
+  is_finite_strict f = true ->
+  let x := B2R f in
+  let z := fst (Bfrexp f) in
+  let e := snd (Bfrexp f) in
+  (/2 <= Rabs (B2R z) < 1)%R /\
+  (x = B2R z * bpow radix2 e)%R /\
+  e = mag radix2 x.
+Proof.
+intro f; case f; intro s; try discriminate; intros m e Hf _.
+generalize (Bfrexp_correct_aux s m e Hf).
+intros (_, (Hb, Heq)); simpl; rewrite B2R_FF2B.
+split; [now simpl|]; split; [now simpl|].
+rewrite Heq, mag_mult_bpow.
+- apply (Z.add_reg_l (- (snd (Ffrexp_core_binary s m e)))).
+  now ring_simplify; symmetry; apply mag_unique.
+- intro H; destruct Hb as (Hb, _); revert Hb; rewrite H, Rabs_R0; lra.
+Qed.
+
+(** Ulp *)
+
+Definition Bulp x := Bldexp mode_NE Bone (fexp (snd (Bfrexp x))).
+
+Theorem Bulp_correct :
+  forall x,
+  is_finite x = true ->
+  B2R (Bulp x) = ulp radix2 fexp (B2R x) /\
+  is_finite (Bulp x) = true /\
+  Bsign (Bulp x) = false.
+Proof.
+intro x; case x.
+- intros s _; unfold Bulp.
+  replace (fexp _) with emin.
+  + generalize (Bldexp_correct mode_NE Bone emin).
+    rewrite Bone_correct, Rmult_1_l, round_generic;
+      [|now apply valid_rnd_N|apply generic_format_bpow; unfold fexp, FLT_exp;
+        rewrite Z.max_r; unfold Prec_gt_0 in prec_gt_0_; lia].
+    rewrite Rlt_bool_true.
+    * intros (Hr, (Hf, Hs)); rewrite Hr, Hf, Hs.
+      split; [|now split; [apply is_finite_Bone|apply Bsign_Bone]].
+      simpl; unfold ulp; rewrite Req_bool_true; [|reflexivity].
+      destruct (negligible_exp_FLT emin prec) as (n, (Hn, Hn')).
+      change fexp with (FLT_exp emin prec); rewrite Hn.
+      now unfold FLT_exp; rewrite Z.max_r;
+        [|unfold Prec_gt_0 in prec_gt_0_; lia].
+    * rewrite Rabs_pos_eq; [|now apply bpow_ge_0]; apply bpow_lt.
+      unfold emin; unfold Prec_gt_0 in prec_gt_0_; lia.
+  + simpl; change (fexp _) with (fexp (-2 * emax - prec)).
+    unfold fexp, FLT_exp; rewrite Z.max_r; [reflexivity|].
+    unfold emin; unfold Prec_gt_0 in prec_gt_0_; lia.
+- intro; discriminate.
+- intros s pl Hpl; discriminate.
+- intros s m e Hme _; unfold Bulp, ulp, cexp.
+  set (f := B754_finite _ _ _ _).
+  rewrite Req_bool_false.
+  + destruct (Bfrexp_correct f (eq_refl _)) as (Hfr1, (Hfr2, Hfr3)).
+    rewrite Hfr3.
+    set (e' := fexp _).
+    generalize (Bldexp_correct mode_NE Bone e').
+    rewrite Bone_correct, Rmult_1_l, round_generic; [|now apply valid_rnd_N|].
+    { rewrite Rlt_bool_true.
+      - intros (Hr, (Hf, Hs)); rewrite Hr, Hf, Hs.
+        now split; [|split; [apply is_finite_Bone|apply Bsign_Bone]].
+      - rewrite Rabs_pos_eq; [|now apply bpow_ge_0].
+        unfold e', fexp, FLT_exp.
+        case (Z.max_spec (mag radix2 (B2R f) - prec) emin)
+          as [(_, Hm)|(_, Hm)]; rewrite Hm; apply bpow_lt;
+          [now unfold emin; unfold Prec_gt_0 in prec_gt_0_; lia|].
+        apply (Zplus_lt_reg_r _ _ prec); ring_simplify.
+        assert (mag radix2 (B2R f) <= emax)%Z;
+          [|now unfold Prec_gt_0 in prec_gt_0_; lia].
+        apply mag_le_bpow; [|now apply abs_B2R_lt_emax].
+        now unfold f, B2R; apply F2R_neq_0; case s. }
+    apply generic_format_bpow, Z.max_lub.
+    * unfold Prec_gt_0 in prec_gt_0_; lia.
+    * apply Z.le_max_r.
+  + now unfold f, B2R; apply F2R_neq_0; case s.
+Qed.
+
+(** Successor (and predecessor) *)
+
+Definition Bpred_pos pred_pos_nan x :=
+  match x with
+  | B754_finite _ mx _ _ =>
+    let d :=
+      if (mx~0 =? shift_pos (Z.to_pos prec) 1)%positive then
+        Bldexp mode_NE Bone (fexp (snd (Bfrexp x) - 1))
+      else
+        Bulp x in
+    Bminus (fun _ => pred_pos_nan) mode_NE x d
+  | _ => x
+  end.
+
+Theorem Bpred_pos_correct :
+  forall pred_pos_nan x,
+  (0 < B2R x)%R ->
+  B2R (Bpred_pos pred_pos_nan x) = pred_pos radix2 fexp (B2R x) /\
+  is_finite (Bpred_pos pred_pos_nan x) = true /\
+  Bsign (Bpred_pos pred_pos_nan x) = false.
+Proof.
+intros pred_pos_nan x.
+generalize (Bfrexp_correct x).
+case x.
+- simpl; intros s _ Bx; exfalso; apply (Rlt_irrefl _ Bx).
+- simpl; intros s _ Bx; exfalso; apply (Rlt_irrefl _ Bx).
+- simpl; intros s pl Hpl _ Bx; exfalso; apply (Rlt_irrefl _ Bx).
+- intros sx mx ex Hmex Hfrexpx Px.
+  assert (Hsx : sx = false).
+  { revert Px; case sx; unfold B2R, F2R; simpl; [|now intro].
+    intro Px; exfalso; revert Px; apply Rle_not_lt.
+    rewrite <-(Rmult_0_l (bpow radix2 ex)).
+    apply Rmult_le_compat_r; [apply bpow_ge_0|apply IZR_le; lia]. }
+  clear Px; rewrite Hsx in Hfrexpx |- *; clear Hsx sx.
+  specialize (Hfrexpx (eq_refl _)).
+  simpl in Hfrexpx; rewrite B2R_FF2B in Hfrexpx.
+  destruct Hfrexpx as (Hfrexpx_bounds, (Hfrexpx_eq, Hfrexpx_exp)).
+  unfold Bpred_pos, Bfrexp.
+  simpl (snd (_, snd _)).
+  rewrite Hfrexpx_exp.
+  set (x' := B754_finite _ _ _ _).
+  set (xr := F2R _).
+  assert (Nzxr : xr <> 0%R).
+  { unfold xr, F2R; simpl.
+    rewrite <-(Rmult_0_l (bpow radix2 ex)); intro H.
+    apply Rmult_eq_reg_r in H; [|apply Rgt_not_eq, bpow_gt_0].
+    apply eq_IZR in H; lia. }
+  assert (Hulp := Bulp_correct x').
+  specialize (Hulp (eq_refl _)).
+  assert (Hldexp := Bldexp_correct mode_NE Bone (fexp (mag radix2 xr - 1))).
+  rewrite Bone_correct, Rmult_1_l in Hldexp.
+  assert (Fbpowxr : generic_format radix2 fexp
+                      (bpow radix2 (fexp (mag radix2 xr - 1)))).
+  { apply generic_format_bpow, Z.max_lub.
+    - unfold Prec_gt_0 in prec_gt_0_; lia.
+    - apply Z.le_max_r. }
+  assert (H : Rlt_bool (Rabs
+               (round radix2 fexp (round_mode mode_NE)
+                  (bpow radix2 (fexp (mag radix2 xr - 1)))))
+              (bpow radix2 emax) = true); [|rewrite H in Hldexp; clear H].
+  { apply Rlt_bool_true; rewrite round_generic;
+      [|apply valid_rnd_round_mode|apply Fbpowxr].
+    rewrite Rabs_pos_eq; [|apply bpow_ge_0]; apply bpow_lt.
+    apply Z.max_lub_lt; [|unfold emin; unfold Prec_gt_0 in prec_gt_0_; lia].
+    apply (Zplus_lt_reg_r _ _ (prec + 1)); ring_simplify.
+    rewrite Z.add_1_r; apply Zle_lt_succ, mag_le_bpow.
+    - exact Nzxr.
+    - apply (Rlt_le_trans _ (bpow radix2 emax)).
+      + change xr with (B2R x'); apply abs_B2R_lt_emax.
+      + apply bpow_le; unfold Prec_gt_0 in prec_gt_0_; lia. }
+  set (d := if (mx~0 =? _)%positive then _ else _).
+  set (minus_nan := fun _ => _).
+  assert (Hminus := Bminus_correct minus_nan mode_NE x' d (eq_refl _)).
+  assert (Fd : is_finite d = true).
+  { unfold d; case (_ =? _)%positive.
+    - now rewrite (proj1 (proj2 Hldexp)), is_finite_Bone.
+    - now rewrite (proj1 (proj2 Hulp)). }
+  specialize (Hminus Fd).
+  assert (Px : (0 <= B2R x')%R).
+  { unfold B2R, x', F2R; simpl.
+    now apply Rmult_le_pos; [apply IZR_le|apply bpow_ge_0]. }
+  assert (Pd : (0 <= B2R d)%R).
+  { unfold d; case (_ =? _)%positive.
+    - rewrite (proj1 Hldexp).
+      now rewrite round_generic; [apply bpow_ge_0|apply valid_rnd_N|].
+    - rewrite (proj1 Hulp); apply ulp_ge_0. }
+  assert (Hdlex : (B2R d <= B2R x')%R).
+  { unfold d; case (_ =? _)%positive.
+    - rewrite (proj1 Hldexp).
+      rewrite round_generic; [|now apply valid_rnd_N|now simpl].
+      apply (Rle_trans _ (bpow radix2 (mag radix2 xr - 1))).
+      + apply bpow_le, Z.max_lub.
+        * unfold Prec_gt_0 in prec_gt_0_; lia.
+        * apply (Zplus_le_reg_r _ _ 1); ring_simplify.
+          apply mag_ge_bpow.
+          replace (_ - 1)%Z with emin by ring.
+          now change xr with (B2R x'); apply abs_B2R_ge_emin.
+      + rewrite <-(Rabs_pos_eq _ Px).
+        now change xr with (B2R x'); apply bpow_mag_le.
+    - rewrite (proj1 Hulp); apply ulp_le_id.
+      + assert (B2R x' <> 0%R); [exact Nzxr|lra].
+      + apply generic_format_B2R. }
+  assert (H : Rlt_bool
+            (Rabs
+               (round radix2 fexp
+                  (round_mode mode_NE) (B2R x' - B2R d)))
+            (bpow radix2 emax) = true); [|rewrite H in Hminus; clear H].
+  { apply Rlt_bool_true.
+    rewrite <-round_NE_abs; [|now apply FLT_exp_valid].
+    rewrite Rabs_pos_eq; [|lra].
+    apply (Rle_lt_trans _ (B2R x')).
+    - apply round_le_generic;
+        [now apply FLT_exp_valid|now apply valid_rnd_N| |lra].
+      apply generic_format_B2R.
+    - apply (Rle_lt_trans _ _ _ (Rle_abs _)), abs_B2R_lt_emax. }
+  rewrite (proj1 Hminus).
+  rewrite (proj1 (proj2 Hminus)).
+  rewrite (proj2 (proj2 Hminus)).
+  split; [|split; [reflexivity|now case (Rcompare_spec _ _); [lra| |]]].
+  unfold pred_pos, d.
+  case (Pos.eqb_spec _ _); intro Hd; case (Req_bool_spec _ _); intro Hpred.
+  + rewrite (proj1 Hldexp).
+    rewrite (round_generic _ _ _ _ Fbpowxr).
+    change xr with (B2R x').
+    replace (_ - _)%R with (pred_pos radix2 fexp (B2R x')).
+    * rewrite round_generic; [reflexivity|now apply valid_rnd_N|].
+      apply generic_format_pred_pos;
+        [now apply FLT_exp_valid|apply generic_format_B2R|].
+      change xr with (B2R x') in Nzxr; lra.
+    * now unfold pred_pos; rewrite Req_bool_true.
+  + exfalso; apply Hpred.
+    assert (Hmx : IZR (Z.pos mx) = bpow radix2 (prec - 1)).
+    { apply (Rmult_eq_reg_l 2); [|lra]; rewrite <-mult_IZR.
+      change (2 * Z.pos mx)%Z with (Z.pos mx~0); rewrite Hd.
+      rewrite shift_pos_correct, Z.mul_1_r.
+      change (IZR (Z.pow_pos _ _)) with (bpow radix2 (Z.pos (Z.to_pos prec))).
+      rewrite Z2Pos.id; [|exact prec_gt_0_].
+      change 2%R with (bpow radix2 1); rewrite <-bpow_plus.
+      f_equal; ring. }
+    unfold x' at 1; unfold B2R at 1; unfold F2R; simpl.
+    rewrite Hmx, <-bpow_plus; f_equal.
+    apply (Z.add_reg_l 1); ring_simplify; symmetry; apply mag_unique_pos.
+    unfold F2R; simpl; rewrite Hmx, <-bpow_plus; split.
+    * right; f_equal; ring.
+    * apply bpow_lt; lia.
+  + rewrite (proj1 Hulp).
+    assert (H : ulp radix2 fexp (B2R x')
+                = bpow radix2 (fexp (mag radix2 (B2R x') - 1)));
+      [|rewrite H; clear H].
+    { unfold ulp; rewrite Req_bool_false; [|now simpl].
+      unfold cexp; f_equal.
+      assert (H : (mag radix2 (B2R x') <= emin + prec)%Z).
+      { assert (Hcm : canonical_mantissa mx ex = true).
+        { now generalize Hmex; unfold bounded; rewrite Bool.andb_true_iff. }
+        apply (canonical_canonical_mantissa false) in Hcm.
+        revert Hcm; fold emin; unfold canonical, cexp; simpl.
+        change (F2R _) with (B2R x'); intro Hex.
+        apply Z.nlt_ge; intro H'; apply Hd.
+        apply Pos2Z.inj_pos; rewrite shift_pos_correct, Z.mul_1_r.
+        apply eq_IZR; change (IZR (Z.pow_pos _ _))
+          with (bpow radix2 (Z.pos (Z.to_pos prec))).
+        rewrite Z2Pos.id; [|exact prec_gt_0_].
+        change (Z.pos mx~0) with (2 * Z.pos mx)%Z.
+        rewrite Z.mul_comm, mult_IZR.
+        apply (Rmult_eq_reg_r (bpow radix2 (ex - 1)));
+          [|apply Rgt_not_eq, bpow_gt_0].
+        change 2%R with (bpow radix2 1); rewrite Rmult_assoc, <-!bpow_plus.
+        replace (1 + _)%Z with ex by ring.
+        unfold B2R at 1, F2R in Hpred; simpl in Hpred; rewrite Hpred.
+        change (F2R _) with (B2R x'); rewrite Hex.
+        unfold fexp, FLT_exp; rewrite Z.max_l; [f_equal; ring|lia]. }
+      now unfold fexp, FLT_exp; do 2 (rewrite Z.max_r; [|lia]). }
+    replace (_ - _)%R with (pred_pos radix2 fexp (B2R x')).
+    * rewrite round_generic; [reflexivity|apply valid_rnd_N|].
+      apply generic_format_pred_pos;
+        [now apply FLT_exp_valid| |change xr with (B2R x') in Nzxr; lra].
+      apply generic_format_B2R.
+    * now unfold pred_pos; rewrite Req_bool_true.
+  + rewrite (proj1 Hulp).
+    replace (_ - _)%R with (pred_pos radix2 fexp (B2R x')).
+    * rewrite round_generic; [reflexivity|now apply valid_rnd_N|].
+      apply generic_format_pred_pos;
+        [now apply FLT_exp_valid|apply generic_format_B2R|].
+      change xr with (B2R x') in Nzxr; lra.
+    * now unfold pred_pos; rewrite Req_bool_false.
+Qed.
+
+Definition Bsucc succ_nan x :=
+  match x with
+  | B754_zero _ => Bldexp mode_NE Bone emin
+  | B754_infinity false => x
+  | B754_infinity true => Bopp succ_nan Bmax_float
+  | B754_nan _ _ _ => build_nan (succ_nan x)
+  | B754_finite false _ _ _ =>
+    Bplus (fun _ => succ_nan) mode_NE x (Bulp x)
+  | B754_finite true _ _ _ =>
+    Bopp succ_nan (Bpred_pos succ_nan (Bopp succ_nan x))
+  end.
+
+Lemma Bsucc_correct :
+  forall succ_nan x,
+  is_finite x = true ->
+  if Rlt_bool (succ radix2 fexp (B2R x)) (bpow radix2 emax) then
+    B2R (Bsucc succ_nan x) = succ radix2 fexp (B2R x) /\
+    is_finite (Bsucc succ_nan x) = true /\
+    (Bsign (Bsucc succ_nan x) = Bsign x && is_finite_strict x)%bool
+  else
+    B2FF (Bsucc succ_nan x) = F754_infinity false.
+Proof.
+assert (Hsucc : succ radix2 fexp 0 = bpow radix2 emin).
+{ unfold succ; rewrite Rle_bool_true; [|now right]; rewrite Rplus_0_l.
+  unfold ulp; rewrite Req_bool_true; [|now simpl].
+  destruct (negligible_exp_FLT emin prec) as (n, (Hne, Hn)).
+  now unfold fexp; rewrite Hne; unfold FLT_exp; rewrite Z.max_r;
+    [|unfold Prec_gt_0 in prec_gt_0_; lia]. }
+intros succ_nan [s|s|s pl Hpl|sx mx ex Hmex]; try discriminate; intros _.
+- generalize (Bldexp_correct mode_NE Bone emin); unfold Bsucc; simpl.
+  assert (Hbemin : round radix2 fexp ZnearestE (bpow radix2 emin)
+                   = bpow radix2 emin).
+  { rewrite round_generic; [reflexivity|apply valid_rnd_N|].
+    apply generic_format_bpow.
+    unfold fexp, FLT_exp; rewrite Z.max_r; [now simpl|].
+    unfold Prec_gt_0 in prec_gt_0_; lia. }
+  rewrite Hsucc, Rlt_bool_true.
+  + intros (Hr, (Hf, Hs)); rewrite Hr, Hf, Hs.
+    rewrite Bone_correct, Rmult_1_l, is_finite_Bone, Bsign_Bone.
+    case Rlt_bool_spec; intro Hover.
+    * now rewrite Bool.andb_false_r.
+    * exfalso; revert Hover; apply Rlt_not_le, bpow_lt.
+      unfold emin; unfold Prec_gt_0 in prec_gt_0_; lia.
+  + rewrite Bone_correct, Rmult_1_l, Hbemin, Rabs_pos_eq; [|apply bpow_ge_0].
+    apply bpow_lt; unfold emin; unfold Prec_gt_0 in prec_gt_0_; lia.
+- unfold Bsucc; case sx.
+  + case Rlt_bool_spec; intro Hover.
+    * rewrite B2R_Bopp; simpl (Bopp _ (B754_finite _ _ _ _)).
+      rewrite is_finite_Bopp.
+      set (ox := B754_finite false mx ex Hmex).
+      assert (Hpred := Bpred_pos_correct succ_nan ox).
+      assert (Hox : (0 < B2R ox)%R); [|specialize (Hpred Hox); clear Hox].
+      { now apply Rmult_lt_0_compat; [apply IZR_lt|apply bpow_gt_0]. }
+      rewrite (proj1 Hpred), (proj1 (proj2 Hpred)).
+      unfold succ; rewrite Rle_bool_false; [split; [|split]|].
+      { now unfold B2R, F2R, ox; simpl; rewrite Ropp_mult_distr_l, <-opp_IZR. }
+      { now simpl. }
+      { simpl (Bsign (B754_finite _ _ _ _)); simpl (true && _)%bool.
+        rewrite Bsign_Bopp, (proj2 (proj2 Hpred)); [now simpl|].
+        now destruct Hpred as (_, (H, _)); revert H; case (Bpred_pos _ _). }
+      unfold B2R, F2R; simpl; change (Z.neg mx) with (- Z.pos mx)%Z.
+      rewrite opp_IZR, <-Ropp_mult_distr_l, <-Ropp_0; apply Ropp_lt_contravar.
+      now apply Rmult_lt_0_compat; [apply IZR_lt|apply bpow_gt_0].
+    * exfalso; revert Hover; apply Rlt_not_le.
+      apply (Rle_lt_trans _ (succ radix2 fexp 0)).
+      { apply succ_le; [now apply FLT_exp_valid|apply generic_format_B2R|
+                        apply generic_format_0|].
+        unfold B2R, F2R; simpl; change (Z.neg mx) with (- Z.pos mx)%Z.
+        rewrite opp_IZR, <-Ropp_mult_distr_l, <-Ropp_0; apply Ropp_le_contravar.
+        now apply Rmult_le_pos; [apply IZR_le|apply bpow_ge_0]. }
+      rewrite Hsucc; apply bpow_lt.
+      unfold emin; unfold Prec_gt_0 in prec_gt_0_; lia.
+  + set (x := B754_finite _ _ _ _).
+    set (plus_nan := fun _ => succ_nan).
+    assert (Hulp := Bulp_correct x (eq_refl _)).
+    assert (Hplus := Bplus_correct plus_nan mode_NE x (Bulp x) (eq_refl _)).
+    rewrite (proj1 (proj2 Hulp)) in Hplus; specialize (Hplus (eq_refl _)).
+    assert (Px : (0 <= B2R x)%R).
+    { now apply Rmult_le_pos; [apply IZR_le|apply bpow_ge_0]. }
+    assert (Hsucc' : (succ radix2 fexp (B2R x)
+                      = B2R x + ulp radix2 fexp (B2R x))%R).
+    { now unfold succ; rewrite (Rle_bool_true _ _ Px). }
+    rewrite (proj1 Hulp), <- Hsucc' in Hplus.
+    rewrite round_generic in Hplus;
+      [|apply valid_rnd_N| now apply generic_format_succ;
+                           [apply FLT_exp_valid|apply generic_format_B2R]].
+    rewrite Rabs_pos_eq in Hplus; [|apply (Rle_trans _ _ _ Px), succ_ge_id].
+    revert Hplus; case Rlt_bool_spec; intros Hover Hplus.
+    * split; [now simpl|split; [now simpl|]].
+      rewrite (proj2 (proj2 Hplus)); case Rcompare_spec.
+      { intro H; exfalso; revert H.
+        apply Rle_not_lt, (Rle_trans _ _ _ Px), succ_ge_id. }
+      { intro H; exfalso; revert H; apply Rgt_not_eq, Rlt_gt.
+        apply (Rlt_le_trans _ (B2R x)); [|apply succ_ge_id].
+        now apply Rmult_lt_0_compat; [apply IZR_lt|apply bpow_gt_0]. }
+      now simpl.
+    * now rewrite (proj1 Hplus).
+Qed.
+
+Definition Bpred pred_nan x :=
+  Bopp pred_nan (Bsucc pred_nan (Bopp pred_nan x)).
+
+Lemma Bpred_correct :
+  forall pred_nan x,
+  is_finite x = true ->
+  if Rlt_bool (- bpow radix2 emax) (pred radix2 fexp (B2R x)) then
+    B2R (Bpred pred_nan x) = pred radix2 fexp (B2R x) /\
+    is_finite (Bpred pred_nan x) = true /\
+    (Bsign (Bpred pred_nan x) = Bsign x || negb (is_finite_strict x))%bool
+  else
+    B2FF (Bpred pred_nan x) = F754_infinity true.
+Proof.
+intros pred_nan x Fx.
+assert (Fox : is_finite (Bopp pred_nan x) = true).
+{ now rewrite is_finite_Bopp. }
+rewrite <-(Ropp_involutive (B2R x)), <-(B2R_Bopp pred_nan).
+rewrite pred_opp, Rlt_bool_opp.
+generalize (Bsucc_correct pred_nan _ Fox).
+case (Rlt_bool _ _).
+- intros (HR, (HF, HS)); unfold Bpred.
+  rewrite B2R_Bopp, HR, is_finite_Bopp.
+  rewrite <-(Bool.negb_involutive (Bsign x)), <-Bool.negb_andb.
+  split; [reflexivity|split; [exact HF|]].
+  replace (is_finite_strict x) with (is_finite_strict (Bopp pred_nan x));
+    [|now case x; try easy; intros s pl Hpl; simpl;
+        rewrite is_finite_strict_build_nan].
+  rewrite Bsign_Bopp, <-(Bsign_Bopp pred_nan x), HS.
+  + now simpl.
+  + now revert Fx; case x.
+  + now revert HF; case (Bsucc _ _).
+- now unfold Bpred; case (Bsucc _ _); intro s; case s.
+Qed.
+
+End Binary.
diff --git a/flocq/Appli/Fappli_IEEE_bits.v b/flocq/IEEE754/Bits.v
index e6a012cf..3a84edfe 100644
--- a/flocq/Appli/Fappli_IEEE_bits.v
+++ b/flocq/IEEE754/Bits.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2011-2013 Sylvie Boldo
+Copyright (C) 2011-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2011-2013 Guillaume Melquiond
+Copyright (C) 2011-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,46 +18,18 @@ COPYING file for more details.
 *)
 
 (** * IEEE-754 encoding of binary floating-point data *)
-Require Import Fcore.
-Require Import Fcore_digits.
-Require Import Fcalc_digits.
-Require Import Fappli_IEEE.
+Require Import Core Digits Binary.
 
 Section Binary_Bits.
 
-Arguments exist {A P} x _.
-Arguments B754_zero {prec emax} _.
-Arguments B754_infinity {prec emax} _.
-Arguments B754_nan {prec emax} _ _.
-Arguments B754_finite {prec emax} _ m e _.
+Arguments exist {A} {P}.
+Arguments B754_zero {prec} {emax}.
+Arguments B754_infinity {prec} {emax}.
+Arguments B754_nan {prec} {emax}.
+Arguments B754_finite {prec} {emax}.
 
 (** Number of bits for the fraction and exponent *)
 Variable mw ew : Z.
-Hypothesis Hmw : (0 < mw)%Z.
-Hypothesis Hew : (0 < ew)%Z.
-
-Let emax := Zpower 2 (ew - 1).
-Let prec := (mw + 1)%Z.
-Let emin := (3 - emax - prec)%Z.
-Let binary_float := binary_float prec emax.
-
-Let Hprec : (0 < prec)%Z.
-unfold prec.
-apply Zle_lt_succ.
-now apply Zlt_le_weak.
-Qed.
-
-Let Hm_gt_0 : (0 < 2^mw)%Z.
-apply (Zpower_gt_0 radix2).
-now apply Zlt_le_weak.
-Qed.
-
-Let He_gt_0 : (0 < 2^ew)%Z.
-apply (Zpower_gt_0 radix2).
-now apply Zlt_le_weak.
-Qed.
-
-Hypothesis Hmax : (prec < emax)%Z.
 
 Definition join_bits (s : bool) m e :=
   (Z.shiftl ((if s then Zpower 2 ew else 0) + e) mw + m)%Z.
@@ -69,8 +41,14 @@ Lemma join_bits_range :
   (0 <= join_bits s m e < 2 ^ (mw + ew + 1))%Z.
 Proof.
 intros s m e Hm He.
+assert (0 <= mw)%Z as Hmw.
+  destruct mw as [|mw'|mw'] ; try easy.
+  clear -Hm ; simpl in Hm ; omega.
+assert (0 <= ew)%Z as Hew.
+  destruct ew as [|ew'|ew'] ; try easy.
+  clear -He ; simpl in He ; omega.
 unfold join_bits.
-rewrite Z.shiftl_mul_pow2 by now apply Zlt_le_weak.
+rewrite Z.shiftl_mul_pow2 by easy.
 split.
 - apply (Zplus_le_compat 0 _ 0) with (2 := proj1 Hm).
   rewrite <- (Zmult_0_l (2^mw)).
@@ -79,26 +57,24 @@ split.
   clear -He ; omega.
   now rewrite Zmult_0_l.
   clear -Hm ; omega.
-- apply Zlt_le_trans with (((if s then 2 ^ ew else 0) + e + 1) * 2 ^ mw)%Z.
+- apply Z.lt_le_trans with (((if s then 2 ^ ew else 0) + e + 1) * 2 ^ mw)%Z.
   rewrite (Zmult_plus_distr_l _ 1).
   apply Zplus_lt_compat_l.
   now rewrite Zmult_1_l.
   rewrite <- (Zplus_assoc mw), (Zplus_comm mw), Zpower_plus.
   apply Zmult_le_compat_r.
-  rewrite Zpower_plus.
+  rewrite Zpower_plus by easy.
   change (2^1)%Z with 2%Z.
   case s ; clear -He ; omega.
-  now apply Zlt_le_weak.
-  easy.
   clear -Hm ; omega.
   clear -Hew ; omega.
-  now apply Zlt_le_weak.
+  easy.
 Qed.
 
 Definition split_bits x :=
   let mm := Zpower 2 mw in
   let em := Zpower 2 ew in
-  (Zle_bool (mm * em) x, Zmod x mm, Zmod (Zdiv x mm) em)%Z.
+  (Zle_bool (mm * em) x, Zmod x mm, Zmod (Z.div x mm) em)%Z.
 
 Theorem split_join_bits :
   forall s m e,
@@ -107,45 +83,75 @@ Theorem split_join_bits :
   split_bits (join_bits s m e) = (s, m, e).
 Proof.
 intros s m e Hm He.
+assert (0 <= mw)%Z as Hmw.
+  destruct mw as [|mw'|mw'] ; try easy.
+  clear -Hm ; simpl in Hm ; omega.
+assert (0 <= ew)%Z as Hew.
+  destruct ew as [|ew'|ew'] ; try easy.
+  clear -He ; simpl in He ; omega.
 unfold split_bits, join_bits.
-rewrite Z.shiftl_mul_pow2 by now apply Zlt_le_weak.
-apply f_equal2.
-apply f_equal2.
-(* *)
-case s.
-apply Zle_bool_true.
-apply Zle_0_minus_le.
-ring_simplify.
-apply Zplus_le_0_compat.
-apply Zmult_le_0_compat.
-apply He.
+rewrite Z.shiftl_mul_pow2 by easy.
+apply f_equal2 ; [apply f_equal2|].
+- case s.
+  + apply Zle_bool_true.
+    apply Zle_0_minus_le.
+    ring_simplify.
+    apply Zplus_le_0_compat.
+    apply Zmult_le_0_compat.
+    apply He.
+    clear -Hm ; omega.
+    apply Hm.
+  + apply Zle_bool_false.
+    apply Zplus_lt_reg_l with (2^mw * (-e))%Z.
+    replace (2 ^ mw * - e + ((0 + e) * 2 ^ mw + m))%Z with (m * 1)%Z by ring.
+    rewrite <- Zmult_plus_distr_r.
+    apply Z.lt_le_trans with (2^mw * 1)%Z.
+    now apply Zmult_lt_compat_r.
+    apply Zmult_le_compat_l.
+    clear -He ; omega.
+    clear -Hm ; omega.
+- rewrite Zplus_comm.
+  rewrite Z_mod_plus_full.
+  now apply Zmod_small.
+- rewrite Z_div_plus_full_l by (clear -Hm ; omega).
+  rewrite Zdiv_small with (1 := Hm).
+  rewrite Zplus_0_r.
+  case s.
+  + replace (2^ew + e)%Z with (e + 1 * 2^ew)%Z by ring.
+    rewrite Z_mod_plus_full.
+    now apply Zmod_small.
+  + now apply Zmod_small.
+Qed.
+
+Hypothesis Hmw : (0 < mw)%Z.
+Hypothesis Hew : (0 < ew)%Z.
+
+Let emax := Zpower 2 (ew - 1).
+Let prec := (mw + 1)%Z.
+Let emin := (3 - emax - prec)%Z.
+Let binary_float := binary_float prec emax.
+
+Let Hprec : (0 < prec)%Z.
+Proof.
+unfold prec.
+apply Zle_lt_succ.
 now apply Zlt_le_weak.
-apply Hm.
-apply Zle_bool_false.
-apply Zplus_lt_reg_l with (2^mw * (-e))%Z.
-replace (2 ^ mw * - e + ((0 + e) * 2 ^ mw + m))%Z with (m * 1)%Z by ring.
-rewrite <- Zmult_plus_distr_r.
-apply Zlt_le_trans with (2^mw * 1)%Z.
-now apply Zmult_lt_compat_r.
-apply Zmult_le_compat_l.
-clear -He. omega.
+Qed.
+
+Let Hm_gt_0 : (0 < 2^mw)%Z.
+Proof.
+apply (Zpower_gt_0 radix2).
 now apply Zlt_le_weak.
-(* *)
-rewrite Zplus_comm.
-rewrite Z_mod_plus_full.
-now apply Zmod_small.
-(* *)
-rewrite Z_div_plus_full_l.
-rewrite Zdiv_small with (1 := Hm).
-rewrite Zplus_0_r.
-case s.
-replace (2^ew + e)%Z with (e + 1 * 2^ew)%Z by ring.
-rewrite Z_mod_plus_full.
-now apply Zmod_small.
-now apply Zmod_small.
-now apply Zgt_not_eq.
 Qed.
 
+Let He_gt_0 : (0 < 2^ew)%Z.
+Proof.
+apply (Zpower_gt_0 radix2).
+now apply Zlt_le_weak.
+Qed.
+
+Hypothesis Hmax : (prec < emax)%Z.
+
 Theorem join_split_bits :
   forall x,
   (0 <= x < Zpower 2 (mw + ew + 1))%Z ->
@@ -171,17 +177,15 @@ case Zle_bool_spec ; intros Hs.
 apply Zle_antisym.
 cut (x / (2^mw * 2^ew) < 2)%Z. clear ; omega.
 apply Zdiv_lt_upper_bound.
-try apply Hx. (* 8.2/8.3 compatibility *)
 now apply Zmult_lt_0_compat.
-rewrite <- Zpower_exp ; try ( apply Zle_ge ; apply Zlt_le_weak ; assumption ).
+rewrite <- Zpower_exp ; try ( apply Z.le_ge ; apply Zlt_le_weak ; assumption ).
 change 2%Z at 1 with (Zpower 2 1).
 rewrite <- Zpower_exp.
 now rewrite Zplus_comm.
 discriminate.
-apply Zle_ge.
+apply Z.le_ge.
 now apply Zplus_le_0_compat ; apply Zlt_le_weak.
 apply Zdiv_le_lower_bound.
-try apply Hx. (* 8.2/8.3 compatibility *)
 now apply Zmult_lt_0_compat.
 now rewrite Zmult_1_l.
 apply Zdiv_small.
@@ -213,7 +217,7 @@ Definition bits_of_binary_float (x : binary_float) :=
   match x with
   | B754_zero sx => join_bits sx 0 0
   | B754_infinity sx => join_bits sx 0 (Zpower 2 ew - 1)
-  | B754_nan sx (exist plx _) => join_bits sx (Zpos plx) (Zpower 2 ew - 1)
+  | B754_nan sx plx _ => join_bits sx (Zpos plx) (Zpower 2 ew - 1)
   | B754_finite sx mx ex _ =>
     let m := (Zpos mx - Zpower 2 mw)%Z in
     if Zle_bool 0 m then
@@ -226,7 +230,7 @@ Definition split_bits_of_binary_float (x : binary_float) :=
   match x with
   | B754_zero sx => (sx, 0, 0)%Z
   | B754_infinity sx => (sx, 0, Zpower 2 ew - 1)%Z
-  | B754_nan sx (exist plx _) => (sx, Zpos plx, Zpower 2 ew - 1)%Z
+  | B754_nan sx plx _ => (sx, Zpos plx, Zpower 2 ew - 1)%Z
   | B754_finite sx mx ex _ =>
     let m := (Zpos mx - Zpower 2 mw)%Z in
     if Zle_bool 0 m then
@@ -239,13 +243,14 @@ Theorem split_bits_of_binary_float_correct :
   forall x,
   split_bits (bits_of_binary_float x) = split_bits_of_binary_float x.
 Proof.
-intros [sx|sx|sx [plx Hplx]|sx mx ex Hx] ;
-  try ( simpl ; apply split_join_bits ; split ; try apply Zle_refl ; try apply Zlt_pred ; trivial ; omega ).
+intros [sx|sx|sx plx Hplx|sx mx ex Hx] ;
+  try ( simpl ; apply split_join_bits ; split ; try apply Z.le_refl ; try apply Zlt_pred ; trivial ; omega ).
 simpl. apply split_join_bits; split; try (zify; omega).
 destruct (digits2_Pnat_correct plx).
+unfold nan_pl in Hplx.
 rewrite Zpos_digits2_pos, <- Z_of_nat_S_digits2_Pnat in Hplx.
 rewrite Zpower_nat_Z in H0.
-eapply Zlt_le_trans. apply H0.
+eapply Z.lt_le_trans. apply H0.
 change 2%Z with (radix_val radix2). apply Zpower_le.
 rewrite Z.ltb_lt in Hplx.
 unfold prec in *. zify; omega.
@@ -253,7 +258,7 @@ unfold prec in *. zify; omega.
 unfold bits_of_binary_float, split_bits_of_binary_float.
 assert (Hf: (emin <= ex /\ Zdigits radix2 (Zpos mx) <= prec)%Z).
 destruct (andb_prop _ _ Hx) as (Hx', _).
-unfold canonic_mantissa in Hx'.
+unfold canonical_mantissa in Hx'.
 rewrite Zpos_digits2_pos in Hx'.
 generalize (Zeq_bool_eq _ _ Hx').
 unfold FLT_exp.
@@ -271,7 +276,7 @@ apply (Zpower_gt_Zdigits radix2 _ (Zpos mx)).
 apply Hf.
 unfold prec.
 rewrite Zplus_comm.
-apply Zpower_exp ; apply Zle_ge.
+apply Zpower_exp ; apply Z.le_ge.
 discriminate.
 now apply Zlt_le_weak.
 (* *)
@@ -285,9 +290,9 @@ generalize (Zle_bool_imp_le _ _ Hx').
 clear ; omega.
 apply sym_eq.
 rewrite (Zsucc_pred ew).
-unfold Zsucc.
+unfold Z.succ.
 rewrite Zplus_comm.
-apply Zpower_exp ; apply Zle_ge.
+apply Zpower_exp ; apply Z.le_ge.
 discriminate.
 now apply Zlt_0_le_0_pred.
 Qed.
@@ -296,7 +301,7 @@ Theorem bits_of_binary_float_range:
   forall x, (0 <= bits_of_binary_float x < 2^(mw+ew+1))%Z.
 Proof.
 unfold bits_of_binary_float.
-intros [sx|sx|sx [pl pl_range]|sx mx ex H].
+intros [sx|sx|sx pl pl_range|sx mx ex H].
 - apply join_bits_range ; now split.
 - apply join_bits_range.
   now split.
@@ -312,7 +317,7 @@ intros [sx|sx|sx [pl pl_range]|sx mx ex H].
 - unfold bounded in H.
   apply Bool.andb_true_iff in H ; destruct H as [A B].
   apply Z.leb_le in B.
-  unfold canonic_mantissa, FLT_exp in A. apply Zeq_bool_eq in A.
+  unfold canonical_mantissa, FLT_exp in A. apply Zeq_bool_eq in A.
   case Zle_bool_spec ; intros H.
   + apply join_bits_range.
     * split.
@@ -362,6 +367,10 @@ Lemma binary_float_of_bits_aux_correct :
 Proof.
 intros x.
 unfold binary_float_of_bits_aux, split_bits.
+assert (Hnan: nan_pl prec 1 = true).
+  apply Z.ltb_lt.
+  simpl. unfold prec.
+  clear -Hmw ; omega.
 case Zeq_bool_spec ; intros He1.
 case_eq (x mod 2^mw)%Z ; try easy.
 (* subnormal *)
@@ -371,11 +380,11 @@ apply Zdigits_le_Zpower.
 simpl.
 rewrite <- Hm.
 eapply Z_mod_lt.
-now apply Zlt_gt.
-apply bounded_canonic_lt_emax ; try assumption.
-unfold canonic, canonic_exp.
+now apply Z.lt_gt.
+apply bounded_canonical_lt_emax ; try assumption.
+unfold canonical, cexp.
 fold emin.
-rewrite ln_beta_F2R_Zdigits. 2: discriminate.
+rewrite mag_F2R_Zdigits. 2: discriminate.
 unfold Fexp, FLT_exp.
 apply sym_eq.
 apply Zmax_right.
@@ -383,16 +392,15 @@ clear -H Hprec.
 unfold prec ; omega.
 apply Rnot_le_lt.
 intros H0.
-refine (_ (ln_beta_le radix2 _ _ _ H0)).
-rewrite ln_beta_bpow.
-rewrite ln_beta_F2R_Zdigits. 2: discriminate.
+refine (_ (mag_le radix2 _ _ _ H0)).
+rewrite mag_bpow.
+rewrite mag_F2R_Zdigits. 2: discriminate.
 unfold emin, prec.
 apply Zlt_not_le.
 cut (0 < emax)%Z. clear -H Hew ; omega.
 apply (Zpower_gt_0 radix2).
 clear -Hew ; omega.
 apply bpow_gt_0.
-simpl. intros. rewrite Z.ltb_lt. unfold prec. zify; omega.
 case Zeq_bool_spec ; intros He2.
 case_eq (x mod 2 ^ mw)%Z; try easy.
 (* nan *)
@@ -403,39 +411,37 @@ apply Zdigits_le_Zpower. simpl.
 rewrite <- Eqplx. edestruct Z_mod_lt; eauto.
 change 2%Z with (radix_val radix2).
 apply Z.lt_gt, Zpower_gt_0. omega.
-simpl. intros. rewrite Z.ltb_lt. unfold prec. zify; omega.
 case_eq (x mod 2^mw + 2^mw)%Z ; try easy.
-simpl. intros. rewrite Z.ltb_lt. unfold prec. zify; omega.
 (* normal *)
 intros px Hm.
 assert (prec = Zdigits radix2 (Zpos px)).
 (* . *)
-rewrite Zdigits_ln_beta. 2: discriminate.
+rewrite Zdigits_mag. 2: discriminate.
 apply sym_eq.
-apply ln_beta_unique.
-rewrite <- Z2R_abs.
-unfold Zabs.
+apply mag_unique.
+rewrite <- abs_IZR.
+unfold Z.abs.
 replace (prec - 1)%Z with mw by ( unfold prec ; ring ).
-rewrite <- Z2R_Zpower with (1 := Zlt_le_weak _ _ Hmw).
-rewrite <- Z2R_Zpower. 2: now apply Zlt_le_weak.
+rewrite <- IZR_Zpower with (1 := Zlt_le_weak _ _ Hmw).
+rewrite <- IZR_Zpower. 2: now apply Zlt_le_weak.
 rewrite <- Hm.
 split.
-apply Z2R_le.
+apply IZR_le.
 change (radix2^mw)%Z with (0 + 2^mw)%Z.
 apply Zplus_le_compat_r.
 eapply Z_mod_lt.
-now apply Zlt_gt.
-apply Z2R_lt.
+now apply Z.lt_gt.
+apply IZR_lt.
 unfold prec.
-rewrite Zpower_exp. 2: now apply Zle_ge ; apply Zlt_le_weak. 2: discriminate.
+rewrite Zpower_exp. 2: now apply Z.le_ge ; apply Zlt_le_weak. 2: discriminate.
 rewrite <- Zplus_diag_eq_mult_2.
 apply Zplus_lt_compat_r.
 eapply Z_mod_lt.
-now apply Zlt_gt.
+now apply Z.lt_gt.
 (* . *)
-apply bounded_canonic_lt_emax ; try assumption.
-unfold canonic, canonic_exp.
-rewrite ln_beta_F2R_Zdigits. 2: discriminate.
+apply bounded_canonical_lt_emax ; try assumption.
+unfold canonical, cexp.
+rewrite mag_F2R_Zdigits. 2: discriminate.
 unfold Fexp, FLT_exp.
 rewrite <- H.
 set (ex := ((x / 2^mw) mod 2^ew)%Z).
@@ -448,14 +454,14 @@ cut (0 <= ex)%Z.
 unfold emin.
 clear ; intros H1 H2 ; omega.
 eapply Z_mod_lt.
-apply Zlt_gt.
+apply Z.lt_gt.
 apply (Zpower_gt_0 radix2).
 now apply Zlt_le_weak.
 apply Rnot_le_lt.
 intros H0.
-refine (_ (ln_beta_le radix2 _ _ _ H0)).
-rewrite ln_beta_bpow.
-rewrite ln_beta_F2R_Zdigits. 2: discriminate.
+refine (_ (mag_le radix2 _ _ _ H0)).
+rewrite mag_bpow.
+rewrite mag_F2R_Zdigits. 2: discriminate.
 rewrite <- H.
 apply Zlt_not_le.
 unfold emin.
@@ -472,11 +478,10 @@ apply refl_equal.
 discriminate.
 clear -Hew ; omega.
 eapply Z_mod_lt.
-apply Zlt_gt.
+apply Z.lt_gt.
 apply (Zpower_gt_0 radix2).
 now apply Zlt_le_weak.
 apply bpow_gt_0.
-simpl. intros. rewrite Z.ltb_lt. unfold prec. zify; omega.
 Qed.
 
 Definition binary_float_of_bits x :=
@@ -492,7 +497,7 @@ unfold binary_float_of_bits.
 rewrite B2FF_FF2B.
 unfold binary_float_of_bits_aux.
 rewrite split_bits_of_binary_float_correct.
-destruct x as [sx|sx|sx [plx Hplx]|sx mx ex Bx].
+destruct x as [sx|sx|sx plx Hplx|sx mx ex Bx].
 apply refl_equal.
 (* *)
 simpl.
@@ -563,7 +568,7 @@ intros (sx, mx) ex Sx.
 assert (Bm: (0 <= mx < 2^mw)%Z).
 inversion_clear Sx.
 apply Z_mod_lt.
-now apply Zlt_gt.
+now apply Z.lt_gt.
 case Zeq_bool_spec ; intros He1.
 (* subnormal *)
 case_eq mx.
@@ -604,41 +609,47 @@ End Binary_Bits.
 (** Specialization for IEEE single precision operations *)
 Section B32_Bits.
 
-Arguments B754_nan {prec emax} _ _.
+Arguments B754_nan {prec} {emax}.
 
 Definition binary32 := binary_float 24 128.
 
 Let Hprec : (0 < 24)%Z.
+Proof.
 apply refl_equal.
 Qed.
 
 Let Hprec_emax : (24 < 128)%Z.
+Proof.
 apply refl_equal.
 Qed.
 
-Definition default_nan_pl32 : bool * nan_pl 24 :=
-  (false, exist _ (iter_nat xO 22 xH) (refl_equal true)).
+Definition default_nan_pl32 : { nan : binary32 | is_nan 24 128 nan = true } :=
+  exist _ (@B754_nan 24 128 false (iter_nat xO 22 xH) (refl_equal true)) (refl_equal true).
 
-Definition unop_nan_pl32 (f : binary32) : bool * nan_pl 24 :=
-  match f with
-  | B754_nan s pl => (s, pl)
+Definition unop_nan_pl32 (f : binary32) : { nan : binary32 | is_nan 24 128 nan = true } :=
+  match f as f with
+  | B754_nan s pl Hpl => exist _ (B754_nan s pl Hpl) (refl_equal true)
   | _ => default_nan_pl32
   end.
 
-Definition binop_nan_pl32 (f1 f2 : binary32) : bool * nan_pl 24 :=
+Definition binop_nan_pl32 (f1 f2 : binary32) : { nan : binary32 | is_nan 24 128 nan = true } :=
   match f1, f2 with
-  | B754_nan s1 pl1, _ => (s1, pl1)
-  | _, B754_nan s2 pl2 => (s2, pl2)
+  | B754_nan s1 pl1 Hpl1, _ => exist _ (B754_nan s1 pl1 Hpl1) (refl_equal true)
+  | _, B754_nan s2 pl2 Hpl2 => exist _ (B754_nan s2 pl2 Hpl2) (refl_equal true)
   | _, _ => default_nan_pl32
   end.
 
-Definition b32_opp := Bopp 24 128 pair.
-Definition b32_plus := Bplus _ _ Hprec Hprec_emax binop_nan_pl32.
-Definition b32_minus := Bminus _ _ Hprec Hprec_emax binop_nan_pl32.
-Definition b32_mult := Bmult _ _ Hprec Hprec_emax binop_nan_pl32.
-Definition b32_div := Bdiv _ _ Hprec Hprec_emax binop_nan_pl32.
-Definition b32_sqrt := Bsqrt _ _ Hprec Hprec_emax unop_nan_pl32.
+Definition b32_erase : binary32 -> binary32 := erase 24 128.
+Definition b32_opp : binary32 -> binary32 := Bopp 24 128 unop_nan_pl32.
+Definition b32_abs : binary32 -> binary32 := Babs 24 128 unop_nan_pl32.
+Definition b32_sqrt :  mode -> binary32 -> binary32 := Bsqrt  _ _ Hprec Hprec_emax unop_nan_pl32.
+
+Definition b32_plus :  mode -> binary32 -> binary32 -> binary32 := Bplus  _ _ Hprec Hprec_emax binop_nan_pl32.
+Definition b32_minus : mode -> binary32 -> binary32 -> binary32 := Bminus _ _ Hprec Hprec_emax binop_nan_pl32.
+Definition b32_mult :  mode -> binary32 -> binary32 -> binary32 := Bmult  _ _ Hprec Hprec_emax binop_nan_pl32.
+Definition b32_div :   mode -> binary32 -> binary32 -> binary32 := Bdiv   _ _ Hprec Hprec_emax binop_nan_pl32.
 
+Definition b32_compare : binary32 -> binary32 -> option comparison := Bcompare 24 128.
 Definition b32_of_bits : Z -> binary32 := binary_float_of_bits 23 8 (refl_equal _) (refl_equal _) (refl_equal _).
 Definition bits_of_b32 : binary32 -> Z := bits_of_binary_float 23 8.
 
@@ -647,41 +658,47 @@ End B32_Bits.
 (** Specialization for IEEE double precision operations *)
 Section B64_Bits.
 
-Arguments B754_nan {prec emax} _ _.
+Arguments B754_nan {prec} {emax}.
 
 Definition binary64 := binary_float 53 1024.
 
 Let Hprec : (0 < 53)%Z.
+Proof.
 apply refl_equal.
 Qed.
 
 Let Hprec_emax : (53 < 1024)%Z.
+Proof.
 apply refl_equal.
 Qed.
 
-Definition default_nan_pl64 : bool * nan_pl 53 :=
-  (false, exist _ (iter_nat xO 51 xH) (refl_equal true)).
+Definition default_nan_pl64 : { nan : binary64 | is_nan 53 1024 nan = true } :=
+  exist _ (@B754_nan 53 1024 false (iter_nat xO 51 xH) (refl_equal true)) (refl_equal true).
 
-Definition unop_nan_pl64 (f : binary64) : bool * nan_pl 53 :=
-  match f with
-  | B754_nan s pl => (s, pl)
+Definition unop_nan_pl64 (f : binary64) : { nan : binary64 | is_nan 53 1024 nan = true } :=
+  match f as f with
+  | B754_nan s pl Hpl => exist _ (B754_nan s pl Hpl) (refl_equal true)
   | _ => default_nan_pl64
   end.
 
-Definition binop_nan_pl64 (pl1 pl2 : binary64) : bool * nan_pl 53 :=
-  match pl1, pl2 with
-  | B754_nan s1 pl1, _ => (s1, pl1)
-  | _, B754_nan s2 pl2 => (s2, pl2)
+Definition binop_nan_pl64 (f1 f2 : binary64) : { nan : binary64 | is_nan 53 1024 nan = true } :=
+  match f1, f2 with
+  | B754_nan s1 pl1 Hpl1, _ => exist _ (B754_nan s1 pl1 Hpl1) (refl_equal true)
+  | _, B754_nan s2 pl2 Hpl2 => exist _ (B754_nan s2 pl2 Hpl2) (refl_equal true)
   | _, _ => default_nan_pl64
   end.
 
-Definition b64_opp := Bopp 53 1024 pair.
-Definition b64_plus := Bplus _ _ Hprec Hprec_emax binop_nan_pl64.
-Definition b64_minus := Bminus _ _ Hprec Hprec_emax binop_nan_pl64.
-Definition b64_mult := Bmult _ _ Hprec Hprec_emax binop_nan_pl64.
-Definition b64_div := Bdiv _ _ Hprec Hprec_emax binop_nan_pl64.
-Definition b64_sqrt := Bsqrt _ _ Hprec Hprec_emax unop_nan_pl64.
+Definition b64_erase : binary64 -> binary64 := erase 53 1024.
+Definition b64_opp : binary64 -> binary64 := Bopp 53 1024 unop_nan_pl64.
+Definition b64_abs : binary64 -> binary64 := Babs 53 1024 unop_nan_pl64.
+Definition b64_sqrt : mode -> binary64 -> binary64 := Bsqrt _ _ Hprec Hprec_emax unop_nan_pl64.
+
+Definition b64_plus  : mode -> binary64 -> binary64 -> binary64 := Bplus  _ _ Hprec Hprec_emax binop_nan_pl64.
+Definition b64_minus : mode -> binary64 -> binary64 -> binary64 := Bminus _ _ Hprec Hprec_emax binop_nan_pl64.
+Definition b64_mult  : mode -> binary64 -> binary64 -> binary64 := Bmult  _ _ Hprec Hprec_emax binop_nan_pl64.
+Definition b64_div   : mode -> binary64 -> binary64 -> binary64 := Bdiv   _ _ Hprec Hprec_emax binop_nan_pl64.
 
+Definition b64_compare : binary64 -> binary64 -> option comparison := Bcompare 53 1024.
 Definition b64_of_bits : Z -> binary64 := binary_float_of_bits 52 11 (refl_equal _) (refl_equal _) (refl_equal _).
 Definition bits_of_b64 : binary64 -> Z := bits_of_binary_float 52 11.
 
diff --git a/flocq/Prop/Div_sqrt_error.v b/flocq/Prop/Div_sqrt_error.v
new file mode 100644
index 00000000..79220438
--- /dev/null
+++ b/flocq/Prop/Div_sqrt_error.v
@@ -0,0 +1,872 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2018 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2018 Guillaume Melquiond
+
+This library is free software; you can redistribute it and/or
+modify it 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.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+COPYING file for more details.
+*)
+
+(** * Remainder of the division and square root are in the FLX format *)
+
+Require Import Psatz.
+Require Import Core Operations Relative Sterbenz Mult_error.
+
+Section Fprop_divsqrt_error.
+
+Variable beta : radix.
+Notation bpow e := (bpow beta e).
+
+Variable prec : Z.
+
+Lemma generic_format_plus_prec :
+  forall fexp, (forall e, (fexp e <= e - prec)%Z) ->
+  forall x y (fx fy: float beta),
+  (x = F2R fx)%R -> (y = F2R fy)%R -> (Rabs (x+y) < bpow (prec+Fexp fx))%R ->
+  (Rabs (x+y) < bpow (prec+Fexp fy))%R ->
+  generic_format beta fexp (x+y)%R.
+Proof.
+intros fexp Hfexp x y fx fy Hx Hy H1 H2.
+case (Req_dec (x+y) 0); intros H.
+rewrite H; apply generic_format_0.
+rewrite Hx, Hy, <- F2R_plus.
+apply generic_format_F2R.
+intros _.
+case_eq (Fplus fx fy).
+intros mz ez Hz.
+rewrite <- Hz.
+apply Z.le_trans with (Z.min (Fexp fx) (Fexp fy)).
+rewrite F2R_plus, <- Hx, <- Hy.
+unfold cexp.
+apply Z.le_trans with (1:=Hfexp _).
+apply Zplus_le_reg_l with prec; ring_simplify.
+apply mag_le_bpow with (1 := H).
+now apply Z.min_case.
+rewrite <- Fexp_Fplus, Hz.
+apply Z.le_refl.
+Qed.
+
+Context { prec_gt_0_ : Prec_gt_0 prec }.
+
+Notation format := (generic_format beta (FLX_exp prec)).
+Notation cexp := (cexp beta (FLX_exp prec)).
+
+Variable choice : Z -> bool.
+
+
+(** Remainder of the division in FLX *)
+Theorem div_error_FLX :
+  forall rnd { Zrnd : Valid_rnd rnd } x y,
+  format x -> format y ->
+  format (x - round beta (FLX_exp prec) rnd (x/y) * y)%R.
+Proof with auto with typeclass_instances.
+intros rnd Zrnd x y Hx Hy.
+destruct (Req_dec y 0) as [Zy|Zy].
+now rewrite Zy, Rmult_0_r, Rminus_0_r.
+destruct (Req_dec (round beta (FLX_exp prec) rnd (x/y)) 0) as [Hr|Hr].
+rewrite Hr; ring_simplify (x-0*y)%R; assumption.
+assert (Zx: x <> R0).
+contradict Hr.
+rewrite Hr.
+unfold Rdiv.
+now rewrite Rmult_0_l, round_0.
+destruct (canonical_generic_format _ _ x Hx) as (fx,(Hx1,Hx2)).
+destruct (canonical_generic_format _ _ y Hy) as (fy,(Hy1,Hy2)).
+destruct (canonical_generic_format beta (FLX_exp prec) (round beta (FLX_exp prec) rnd (x / y))) as (fr,(Hr1,Hr2)).
+apply generic_format_round...
+unfold Rminus; apply generic_format_plus_prec with fx (Fopp (Fmult fr fy)); trivial.
+intros e; apply Z.le_refl.
+now rewrite F2R_opp, F2R_mult, <- Hr1, <- Hy1.
+(* *)
+destruct (relative_error_FLX_ex beta prec (prec_gt_0 prec) rnd (x / y)%R) as (eps,(Heps1,Heps2)).
+rewrite Heps2.
+rewrite <- Rabs_Ropp.
+replace (-(x + - (x / y * (1 + eps) * y)))%R with (x * eps)%R by now field.
+rewrite Rabs_mult.
+apply Rlt_le_trans with (Rabs x * 1)%R.
+apply Rmult_lt_compat_l.
+now apply Rabs_pos_lt.
+apply Rlt_le_trans with (1 := Heps1).
+change 1%R with (bpow 0).
+apply bpow_le.
+generalize (prec_gt_0 prec).
+clear ; omega.
+rewrite Rmult_1_r.
+rewrite Hx2, <- Hx1.
+unfold cexp.
+destruct (mag beta x) as (ex, Hex).
+simpl.
+specialize (Hex Zx).
+apply Rlt_le.
+apply Rlt_le_trans with (1 := proj2 Hex).
+apply bpow_le.
+unfold FLX_exp.
+ring_simplify.
+apply Z.le_refl.
+(* *)
+replace (Fexp (Fopp (Fmult fr fy))) with (Fexp fr + Fexp fy)%Z.
+2: unfold Fopp, Fmult; destruct fr; destruct fy; now simpl.
+replace (x + - (round beta (FLX_exp prec) rnd (x / y) * y))%R with
+  (y * (-(round beta (FLX_exp prec) rnd (x / y) - x/y)))%R.
+2: field; assumption.
+rewrite Rabs_mult.
+apply Rlt_le_trans with (Rabs y * bpow (Fexp fr))%R.
+apply Rmult_lt_compat_l.
+now apply Rabs_pos_lt.
+rewrite Rabs_Ropp.
+replace (bpow (Fexp fr)) with (ulp beta (FLX_exp prec) (F2R fr)).
+rewrite <- Hr1.
+apply error_lt_ulp_round...
+apply Rmult_integral_contrapositive_currified; try apply Rinv_neq_0_compat; assumption.
+rewrite ulp_neq_0.
+2: now rewrite <- Hr1.
+apply f_equal.
+now rewrite Hr2, <- Hr1.
+replace (prec+(Fexp fr+Fexp fy))%Z with ((prec+Fexp fy)+Fexp fr)%Z by ring.
+rewrite bpow_plus.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+rewrite Hy2, <- Hy1 ; unfold cexp, FLX_exp.
+ring_simplify (prec + (mag beta y - prec))%Z.
+destruct (mag beta y); simpl.
+left; now apply a.
+Qed.
+
+(** Remainder of the square in FLX (with p>1) and rounding to nearest *)
+Variable Hp1 : Z.lt 1 prec.
+
+Theorem sqrt_error_FLX_N :
+  forall x, format x ->
+  format (x - Rsqr (round beta (FLX_exp prec) (Znearest choice) (sqrt x)))%R.
+Proof with auto with typeclass_instances.
+intros x Hx.
+destruct (total_order_T x 0) as [[Hxz|Hxz]|Hxz].
+unfold sqrt.
+destruct (Rcase_abs x).
+rewrite round_0...
+unfold Rsqr.
+now rewrite Rmult_0_l, Rminus_0_r.
+elim (Rlt_irrefl 0).
+now apply Rgt_ge_trans with x.
+rewrite Hxz, sqrt_0, round_0...
+unfold Rsqr.
+rewrite Rmult_0_l, Rminus_0_r.
+apply generic_format_0.
+case (Req_dec (round beta (FLX_exp prec) (Znearest choice) (sqrt x)) 0); intros Hr.
+rewrite Hr; unfold Rsqr; ring_simplify (x-0*0)%R; assumption.
+destruct (canonical_generic_format _ _ x Hx) as (fx,(Hx1,Hx2)).
+destruct (canonical_generic_format beta (FLX_exp prec) (round beta (FLX_exp prec) (Znearest choice) (sqrt x))) as (fr,(Hr1,Hr2)).
+apply generic_format_round...
+unfold Rminus; apply generic_format_plus_prec with fx (Fopp (Fmult fr fr)); trivial.
+intros e; apply Z.le_refl.
+unfold Rsqr; now rewrite F2R_opp,F2R_mult, <- Hr1.
+(* *)
+apply Rle_lt_trans with x.
+apply Rabs_minus_le.
+apply Rle_0_sqr.
+destruct (relative_error_N_FLX_ex beta prec (prec_gt_0 prec) choice (sqrt x)) as (eps,(Heps1,Heps2)).
+rewrite Heps2.
+rewrite Rsqr_mult, Rsqr_sqrt, Rmult_comm. 2: now apply Rlt_le.
+apply Rmult_le_compat_r.
+now apply Rlt_le.
+apply Rle_trans with (5²/4²)%R.
+rewrite <- Rsqr_div.
+apply Rsqr_le_abs_1.
+apply Rle_trans with (1 := Rabs_triang _ _).
+rewrite Rabs_R1.
+apply Rplus_le_reg_l with (-1)%R.
+replace (-1 + (1 + Rabs eps))%R with (Rabs eps) by ring.
+apply Rle_trans with (1 := Heps1).
+rewrite Rabs_pos_eq.
+apply Rmult_le_reg_l with 2%R.
+now apply IZR_lt.
+rewrite <- Rmult_assoc, Rinv_r, Rmult_1_l.
+apply Rle_trans with (bpow (-1)).
+apply bpow_le.
+omega.
+replace (2 * (-1 + 5 / 4))%R with (/2)%R by field.
+apply Rinv_le.
+now apply IZR_lt.
+apply IZR_le.
+unfold Zpower_pos. simpl.
+rewrite Zmult_1_r.
+apply Zle_bool_imp_le.
+apply beta.
+now apply IZR_neq.
+unfold Rdiv.
+apply Rmult_le_pos.
+now apply IZR_le.
+apply Rlt_le.
+apply Rinv_0_lt_compat.
+now apply IZR_lt.
+now apply IZR_neq.
+unfold Rsqr.
+replace (5 * 5 / (4 * 4))%R with (25 * /16)%R by field.
+apply Rmult_le_reg_r with 16%R.
+now apply IZR_lt.
+rewrite Rmult_assoc, Rinv_l, Rmult_1_r.
+now apply (IZR_le _ 32).
+now apply IZR_neq.
+rewrite Hx2, <- Hx1; unfold cexp, FLX_exp.
+ring_simplify (prec + (mag beta x - prec))%Z.
+destruct (mag beta x); simpl.
+rewrite <- (Rabs_right x).
+apply a.
+now apply Rgt_not_eq.
+now apply Rgt_ge.
+(* *)
+replace (Fexp (Fopp (Fmult fr fr))) with (Fexp fr + Fexp fr)%Z.
+2: unfold Fopp, Fmult; destruct fr; now simpl.
+rewrite Hr1.
+replace (x + - Rsqr (F2R fr))%R with (-((F2R fr - sqrt x)*(F2R fr + sqrt x)))%R.
+2: rewrite <- (sqrt_sqrt x) at 3; auto.
+2: unfold Rsqr; ring.
+rewrite Rabs_Ropp, Rabs_mult.
+apply Rle_lt_trans with ((/2*bpow (Fexp fr))* Rabs (F2R fr + sqrt x))%R.
+apply Rmult_le_compat_r.
+apply Rabs_pos.
+apply Rle_trans with (/2*ulp beta  (FLX_exp prec) (F2R fr))%R.
+rewrite <- Hr1.
+apply error_le_half_ulp_round...
+right; rewrite ulp_neq_0.
+2: now rewrite <- Hr1.
+apply f_equal.
+rewrite Hr2, <- Hr1; trivial.
+rewrite Rmult_assoc, Rmult_comm.
+replace (prec+(Fexp fr+Fexp fr))%Z with (Fexp fr + (prec+Fexp fr))%Z by ring.
+rewrite bpow_plus, Rmult_assoc.
+apply Rmult_lt_compat_l.
+apply bpow_gt_0.
+apply Rmult_lt_reg_l with (1 := Rlt_0_2).
+apply Rle_lt_trans with (Rabs (F2R fr + sqrt x)).
+right; field.
+apply Rle_lt_trans with (1:=Rabs_triang _ _).
+(* . *)
+assert (Rabs (F2R fr) < bpow (prec + Fexp fr))%R.
+rewrite Hr2.
+unfold cexp, FLX_exp.
+ring_simplify (prec + (mag beta (F2R fr) - prec))%Z.
+destruct (mag beta (F2R fr)); simpl.
+apply a.
+rewrite <- Hr1; auto.
+(* . *)
+apply Rlt_le_trans with (bpow (prec + Fexp fr)+ Rabs (sqrt x))%R.
+now apply Rplus_lt_compat_r.
+(* . *)
+replace (2 * bpow (prec + Fexp fr))%R with (bpow (prec + Fexp fr) + bpow (prec + Fexp fr))%R by ring.
+apply Rplus_le_compat_l.
+assert (sqrt x <> 0)%R.
+apply Rgt_not_eq.
+now apply sqrt_lt_R0.
+destruct (mag beta (sqrt x)) as (es,Es).
+specialize (Es H0).
+apply Rle_trans with (bpow es).
+now apply Rlt_le.
+apply bpow_le.
+case (Zle_or_lt es (prec + Fexp fr)) ; trivial.
+intros H1.
+absurd (Rabs (F2R fr) < bpow (es - 1))%R.
+apply Rle_not_lt.
+rewrite <- Hr1.
+apply abs_round_ge_generic...
+apply generic_format_bpow.
+unfold FLX_exp; omega.
+apply Es.
+apply Rlt_le_trans with (1:=H).
+apply bpow_le.
+omega.
+now apply Rlt_le.
+Qed.
+
+Lemma sqrt_error_N_FLX_aux1 x (Fx : format x) (Px : (0 < x)%R) :
+  exists (mu : R) (e : Z), (format mu /\ x = mu * bpow (2 * e) :> R
+                            /\ 1 <= mu < bpow 2)%R.
+Proof.
+set (e := ((mag beta x - 1) / 2)%Z).
+set (mu := (x * bpow (-2 * e)%Z)%R).
+assert (Hbe : (bpow (-2 * e) * bpow (2 * e) = 1)%R).
+{ now rewrite <- bpow_plus; case e; simpl; [reflexivity| |]; intro p;
+    rewrite Z.pos_sub_diag. }
+assert (Fmu : format mu); [now apply mult_bpow_exact_FLX|].
+exists mu, e; split; [exact Fmu|split; [|split]].
+{ set (e2 := (2 * e)%Z); simpl; unfold mu; rewrite Rmult_assoc.
+  now unfold e2; rewrite Hbe, Rmult_1_r. }
+{ apply (Rmult_le_reg_r (bpow (2 * e))).
+  { apply bpow_gt_0. }
+  rewrite Rmult_1_l; set (e2 := (2 * e)%Z); simpl; unfold mu.
+  unfold e2; rewrite Rmult_assoc, Hbe, Rmult_1_r.
+  apply (Rle_trans _ (bpow (mag beta x - 1))).
+  { now apply bpow_le; unfold e; apply Z_mult_div_ge. }
+  set (l := mag _ _); rewrite <- (Rabs_pos_eq _ (Rlt_le _ _ Px)).
+  unfold l; apply bpow_mag_le.
+  intro Hx; revert Px; rewrite Hx; apply Rlt_irrefl. }
+simpl; unfold mu; change (IZR _) with (bpow 2).
+apply (Rmult_lt_reg_r (bpow (2 * e))); [now apply bpow_gt_0|].
+rewrite Rmult_assoc, Hbe, Rmult_1_r.
+apply (Rlt_le_trans _ (bpow (mag beta x))).
+{ rewrite <- (Rabs_pos_eq _ (Rlt_le _ _ Px)) at 1; apply bpow_mag_gt. }
+rewrite <- bpow_plus; apply bpow_le; unfold e; set (mxm1 := (_ - 1)%Z).
+replace (_ * _)%Z with (2 * (mxm1 / 2) + mxm1 mod 2 - mxm1 mod 2)%Z by ring.
+rewrite <- Z.div_mod; [|now simpl].
+apply (Zplus_le_reg_r _ _ (mxm1 mod 2 - mag beta x)%Z).
+unfold mxm1; destruct (Z.mod_bound_or (mag beta x - 1) 2); omega.
+Qed.
+
+Notation u_ro := (u_ro beta prec).
+
+Lemma sqrt_error_N_FLX_aux2 x (Fx : format x) :
+  (1 <= x)%R ->
+  (x = 1 :> R \/ x = 1 + 2 * u_ro :> R \/ 1 + 4 * u_ro <= x)%R.
+Proof.
+intro HxGe1.
+assert (Pu_ro : (0 <= u_ro)%R); [apply Rmult_le_pos; [lra|apply bpow_ge_0]|].
+destruct (Rle_or_lt x 1) as [HxLe1|HxGt1]; [now left; apply Rle_antisym|right].
+assert (F1 : format 1); [now apply generic_format_FLX_1|].
+assert (H2eps : (2 * u_ro = bpow (-prec + 1))%R).
+{ unfold u_ro; rewrite bpow_plus; field. }
+assert (HmuGe1p2eps : (1 + 2 * u_ro <= x)%R).
+{ rewrite H2eps, <- succ_FLX_1.
+  now apply succ_le_lt; [now apply FLX_exp_valid| | |]. }
+destruct (Rle_or_lt x (1 + 2 * u_ro)) as [HxLe1p2eps|HxGt1p2eps];
+  [now left; apply Rle_antisym|right].
+assert (Hulp1p2eps : (ulp beta (FLX_exp prec) (1 + 2 * u_ro) = 2 * u_ro)%R).
+{ destruct (ulp_succ_pos _ _ _ F1 Rlt_0_1) as [Hsucc|Hsucc].
+  { now rewrite H2eps, <- succ_FLX_1, <- ulp_FLX_1. }
+  exfalso; revert Hsucc; apply Rlt_not_eq.
+  rewrite succ_FLX_1, mag_1, bpow_1, <- H2eps; simpl.
+  apply (Rlt_le_trans _ 2); [apply Rplus_lt_compat_l|].
+  { unfold u_ro; rewrite <-Rmult_assoc, Rinv_r, Rmult_1_l; [|lra].
+    change R1 with (bpow 0); apply bpow_lt; omega. }
+  apply IZR_le, Zle_bool_imp_le, radix_prop. }
+assert (Hsucc1p2eps :
+          (succ beta (FLX_exp prec) (1 + 2 * u_ro) = 1 + 4 * u_ro)%R).
+{ unfold succ; rewrite Rle_bool_true; [rewrite Hulp1p2eps; ring|].
+  apply Rplus_le_le_0_compat; lra. }
+rewrite <- Hsucc1p2eps.
+apply succ_le_lt; [now apply FLX_exp_valid| |exact Fx|now simpl].
+rewrite H2eps, <- succ_FLX_1.
+now apply generic_format_succ; [apply FLX_exp_valid|].
+Qed.
+
+Lemma sqrt_error_N_FLX_aux3 :
+  (u_ro / sqrt (1 + 4 * u_ro) <= 1 - 1 / sqrt (1 + 2 * u_ro))%R.
+Proof.
+assert (Pu_ro : (0 <= u_ro)%R); [apply Rmult_le_pos; [lra|apply bpow_ge_0]|].
+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].
+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].
+unfold Rsqr; ring_simplify; unfold pow; rewrite !Rmult_1_r.
+rewrite !sqrt_def; [|lra|lra].
+apply (Rplus_le_reg_r (-u_ro * u_ro - 1 -4 * u_ro - 2 * u_ro ^ 3)).
+ring_simplify; apply Rsqr_incr_0_var.
+{ unfold Rsqr; ring_simplify.
+  unfold pow; rewrite !Rmult_1_r, !sqrt_def; [|lra|lra].
+  apply (Rplus_le_reg_r (-32 * u_ro ^ 4 - 24 * u_ro ^ 3 - 4 * u_ro ^ 2)).
+  ring_simplify.
+  replace (_ + _)%R
+    with (((4 * u_ro ^ 2 - 28 * u_ro + 9) * u_ro + 4) * u_ro ^ 3)%R by ring.
+  apply Rmult_le_pos; [|now apply pow_le].
+  assert (Heps_le_half : (u_ro <= 1 / 2)%R).
+  { unfold u_ro, Rdiv; rewrite Rmult_comm; apply Rmult_le_compat_r; [lra|].
+    change 1%R with (bpow 0); apply bpow_le; omega. }
+  apply (Rle_trans _ (-8 * u_ro + 4)); [lra|].
+  apply Rplus_le_compat_r, Rmult_le_compat_r; [apply Pu_ro|].
+  now assert (H : (0 <= u_ro ^ 2)%R); [apply pow2_ge_0|lra]. }
+assert (H : (u_ro ^ 3 <= u_ro ^ 2)%R).
+{ unfold pow; rewrite <-!Rmult_assoc, Rmult_1_r.
+  apply Rmult_le_compat_l; [now apply Rmult_le_pos; apply Pu_ro|].
+  now apply Rlt_le, u_ro_lt_1. }
+now assert (H' : (0 <= u_ro ^ 2)%R); [apply pow2_ge_0|lra].
+Qed.
+
+Lemma om1ds1p2u_ro_pos : (0 <= 1 - 1 / sqrt (1 + 2 * u_ro))%R.
+Proof.
+unfold Rdiv; rewrite Rmult_1_l, <-Rinv_1 at 1.
+apply Rle_0_minus, Rinv_le; [lra|].
+rewrite <- sqrt_1 at 1; apply sqrt_le_1_alt.
+assert (H := u_ro_pos beta prec); lra.
+Qed.
+
+Lemma om1ds1p2u_ro_le_u_rod1pu_ro :
+  (1 - 1 / sqrt (1 + 2 * u_ro) <= u_ro / (1 + u_ro))%R.
+Proof.
+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].
+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.
+assert (H : (0 <= u_ro * u_ro)%R); [apply Rmult_le_pos|]; lra.
+Qed.
+
+Lemma s1p2u_rom1_pos : (0 <= sqrt (1 + 2 * u_ro) - 1)%R.
+apply (Rplus_le_reg_r 1); ring_simplify.
+rewrite <-sqrt_1 at 1; apply sqrt_le_1_alt.
+assert (H := u_ro_pos beta prec); lra.
+Qed.
+
+Theorem sqrt_error_N_FLX x (Fx : format x) :
+  (Rabs (round beta (FLX_exp prec) (Znearest choice) (sqrt x) - sqrt x)
+   <= (1 - 1 / sqrt (1 + 2 * u_ro)) * Rabs (sqrt x))%R.
+Proof.
+assert (Peps := u_ro_pos beta prec).
+assert (Peps' : (0 < u_ro)%R).
+{ unfold u_ro; apply Rmult_lt_0_compat; [lra|apply bpow_gt_0]. }
+assert (Pb := om1ds1p2u_ro_pos).
+assert (Pb' := s1p2u_rom1_pos).
+destruct (Rle_or_lt x 0) as [Nx|Px].
+{ rewrite (sqrt_neg _ Nx), round_0, Rabs_R0, Rmult_0_r; [|apply valid_rnd_N].
+  now unfold Rminus; rewrite Rplus_0_l, Rabs_Ropp, Rabs_R0; right. }
+destruct (sqrt_error_N_FLX_aux1 _ Fx Px)
+  as (mu, (e, (Fmu, (Hmu, (HmuGe1, HmuLtsqradix))))).
+pose (t := sqrt x).
+set (rt := round _ _ _ _).
+assert (Ht : (t = sqrt mu * bpow e)%R).
+{ unfold t; rewrite Hmu, sqrt_mult_alt; [|now apply (Rle_trans _ _ _ Rle_0_1)].
+  now rewrite sqrt_bpow. }
+destruct (sqrt_error_N_FLX_aux2 _ Fmu HmuGe1) as [Hmu'|[Hmu'|Hmu']].
+{ unfold rt; fold t; rewrite Ht, Hmu', sqrt_1, Rmult_1_l.
+  rewrite round_generic; [|now apply valid_rnd_N|].
+  { rewrite Rminus_diag_eq, Rabs_R0; [|now simpl].
+    now apply Rmult_le_pos; [|apply Rabs_pos]. }
+  apply generic_format_bpow'; [now apply FLX_exp_valid|].
+  unfold FLX_exp; omega. }
+{ assert (Hsqrtmu : (1 <= sqrt mu < 1 + u_ro)%R); [rewrite Hmu'; split|].
+  { rewrite <- sqrt_1 at 1; apply sqrt_le_1_alt; lra. }
+  { rewrite <- sqrt_square; [|lra]; apply sqrt_lt_1_alt; split; [lra|].
+    ring_simplify; assert (0 < u_ro ^ 2)%R; [apply pow_lt|]; lra. }
+  assert (Fbpowe : generic_format beta (FLX_exp prec) (bpow e)).
+  { apply generic_format_bpow; unfold FLX_exp; omega. }
+  assert (Hrt : rt = bpow e :> R).
+  { unfold rt; fold t; rewrite Ht; simpl; apply Rle_antisym.
+    { apply round_N_le_midp; [now apply FLX_exp_valid|exact Fbpowe|].
+      apply (Rlt_le_trans _ ((1 + u_ro) * bpow e)).
+      { now apply Rmult_lt_compat_r; [apply bpow_gt_0|]. }
+      unfold succ; rewrite Rle_bool_true; [|now apply bpow_ge_0].
+      rewrite ulp_bpow; unfold FLX_exp.
+      unfold Z.sub, u_ro; rewrite !bpow_plus; right; field. }
+    apply round_ge_generic;
+      [now apply FLX_exp_valid|now apply valid_rnd_N|exact Fbpowe|].
+    rewrite <- (Rmult_1_l (bpow _)) at 1.
+    now apply Rmult_le_compat_r; [apply bpow_ge_0|]. }
+  fold t; rewrite Hrt, Ht, Hmu', <-(Rabs_pos_eq _ Pb), <-Rabs_mult.
+  rewrite Rabs_minus_sym; right; f_equal; field; lra. }
+assert (Hsqrtmu : (1 + u_ro < sqrt mu)%R).
+{ apply (Rlt_le_trans _ (sqrt (1 + 4 * u_ro))); [|now apply sqrt_le_1_alt].
+  assert (P1peps : (0 <= 1 + u_ro)%R)
+    by now apply Rplus_le_le_0_compat; [lra|apply Peps].
+  rewrite <- (sqrt_square (1 + u_ro)); [|lra].
+  apply sqrt_lt_1_alt; split; [now apply Rmult_le_pos|].
+  apply (Rplus_lt_reg_r (-1 - 2 * u_ro)); ring_simplify; simpl.
+  rewrite Rmult_1_r; apply Rmult_lt_compat_r; [apply Peps'|].
+  now apply (Rlt_le_trans _ 1); [apply u_ro_lt_1|lra]. }
+assert (Hulpt : (ulp beta (FLX_exp prec) t = 2 * u_ro * bpow e)%R).
+{ unfold ulp; rewrite Req_bool_false; [|apply Rgt_not_eq, Rlt_gt].
+  { unfold u_ro; rewrite <-Rmult_assoc, Rinv_r, Rmult_1_l, <-bpow_plus; [|lra].
+    f_equal; unfold cexp, FLX_exp.
+    assert (Hmagt : (mag beta t = 1 + e :> Z)%Z).
+    { apply mag_unique.
+      unfold t; rewrite (Rabs_pos_eq _ (Rlt_le _ _ (sqrt_lt_R0 _ Px))).
+      fold t; split.
+      { rewrite Ht; replace (_ - _)%Z with e by ring.
+        rewrite <- (Rmult_1_l (bpow _)) at 1; apply Rmult_le_compat_r.
+        { apply bpow_ge_0. }
+        now rewrite <- sqrt_1; apply sqrt_le_1_alt. }
+      rewrite bpow_plus, bpow_1, Ht; simpl.
+      apply Rmult_lt_compat_r; [now apply bpow_gt_0|].
+      rewrite <- sqrt_square.
+      { apply sqrt_lt_1_alt; split; [lra|].
+        apply (Rlt_le_trans _ _ _ HmuLtsqradix); right.
+        now unfold bpow, Z.pow_pos; simpl; rewrite Zmult_1_r, mult_IZR. }
+      apply IZR_le, (Z.le_trans _ 2), Zle_bool_imp_le, radix_prop; omega. }
+    rewrite Hmagt; ring. }
+  rewrite Ht; apply Rmult_lt_0_compat; [|now apply bpow_gt_0].
+  now apply (Rlt_le_trans _ 1); [lra|rewrite <- sqrt_1; apply sqrt_le_1_alt]. }
+assert (Pt : (0 < t)%R).
+{ rewrite Ht; apply Rmult_lt_0_compat; [lra|apply bpow_gt_0]. }
+assert (H : (Rabs ((rt - sqrt x) / sqrt x)
+             <= 1 - 1 / sqrt (1 + 2 * u_ro))%R).
+{ unfold Rdiv; rewrite Rabs_mult, (Rabs_pos_eq (/ _));
+    [|now left; apply Rinv_0_lt_compat].
+  apply (Rle_trans _ ((u_ro * bpow e) / t)).
+  { unfold Rdiv; apply Rmult_le_compat_r; [now left; apply Rinv_0_lt_compat|].
+    apply (Rle_trans _ _ _ (error_le_half_ulp _ _ _ _)).
+    fold t; rewrite Hulpt; right; field. }
+  apply (Rle_trans _ (u_ro / sqrt (1 + 4 * u_ro))).
+  { apply (Rle_trans _ (u_ro * bpow e / (sqrt (1 + 4 * u_ro) * bpow e))).
+    { unfold Rdiv; apply Rmult_le_compat_l;
+        [now apply Rmult_le_pos; [apply Peps|apply bpow_ge_0]|].
+      apply Rinv_le.
+      { apply Rmult_lt_0_compat; [apply sqrt_lt_R0; lra|apply bpow_gt_0]. }
+      now rewrite Ht; apply Rmult_le_compat_r;
+        [apply bpow_ge_0|apply sqrt_le_1_alt]. }
+    right; field; split; apply Rgt_not_eq, Rlt_gt;
+      [apply sqrt_lt_R0; lra|apply bpow_gt_0]. }
+  apply sqrt_error_N_FLX_aux3. }
+revert H; unfold Rdiv; rewrite Rabs_mult, Rabs_Rinv; [|fold t; lra]; intro H.
+apply (Rmult_le_reg_r (/ Rabs (sqrt x)));
+  [apply Rinv_0_lt_compat, Rabs_pos_lt; fold t; lra|].
+apply (Rle_trans _ _ _ H); right; field; split; [apply Rabs_no_R0;fold t|]; lra.
+Qed.
+
+Theorem sqrt_error_N_FLX_ex x (Fx : format x) :
+  exists eps,
+  (Rabs eps <= 1 - 1 / sqrt (1 + 2 * u_ro))%R /\
+  round beta (FLX_exp prec) (Znearest choice) (sqrt x)
+  = (sqrt x * (1 + eps))%R.
+Proof.
+now apply relative_error_le_conversion;
+  [apply valid_rnd_N|apply om1ds1p2u_ro_pos|apply sqrt_error_N_FLX].
+Qed.
+
+Lemma sqrt_error_N_round_ex_derive :
+  forall x rx,
+  (exists eps,
+   (Rabs eps <= 1 - 1 / sqrt (1 + 2 * u_ro))%R /\ rx = (x * (1 + eps))%R) ->
+  exists eps,
+  (Rabs eps <= sqrt (1 + 2 * u_ro) - 1)%R /\ x = (rx * (1 + eps))%R.
+Proof.
+intros x rx (d, (Bd, Hd)).
+assert (H := Rabs_le_inv _ _ Bd).
+assert (H' := om1ds1p2u_ro_le_u_rod1pu_ro).
+assert (H'' := u_rod1pu_ro_le_u_ro beta prec).
+assert (H''' := u_ro_lt_1 beta prec prec_gt_0_).
+assert (Hpos := s1p2u_rom1_pos).
+destruct (Req_dec rx 0) as [Zfx|Nzfx].
+{ exists 0%R; split; [now rewrite Rabs_R0|].
+  rewrite Rplus_0_r, Rmult_1_r, Zfx; rewrite Zfx in Hd.
+  destruct (Rmult_integral _ _ (sym_eq Hd)); lra. }
+destruct (Req_dec x 0) as [Zx|Nzx].
+{ now exfalso; revert Hd; rewrite Zx; rewrite Rmult_0_l. }
+set (d' := ((x - rx) / rx)%R).
+assert (Hd' : (Rabs d' <= sqrt (1 + 2 * u_ro) - 1)%R).
+{ unfold d'; rewrite Hd.
+  replace (_ / _)%R with (- d / (1 + d))%R; [|now field; split; lra].
+  unfold Rdiv; rewrite Rabs_mult, Rabs_Ropp.
+  rewrite (Rabs_pos_eq (/ _)); [|apply Rlt_le, Rinv_0_lt_compat; lra].
+  apply (Rmult_le_reg_r (1 + d)); [lra|].
+  rewrite Rmult_assoc, Rinv_l, Rmult_1_r; [|lra].
+  apply (Rle_trans _ _ _ Bd).
+  apply (Rle_trans _ ((sqrt (1 + 2 * u_ro) - 1) * (1/sqrt (1 + 2 * u_ro))));
+    [right; field|apply Rmult_le_compat_l]; lra. }
+now exists d'; split; [exact Hd'|]; unfold d'; field.
+Qed.
+
+(** sqrt(1 + 2 u_ro) - 1 <= u_ro *)
+Theorem sqrt_error_N_FLX_round_ex :
+  forall x,
+  format x ->
+  exists eps,
+  (Rabs eps <= sqrt (1 + 2 * u_ro) - 1)%R /\
+  sqrt x = (round beta (FLX_exp prec) (Znearest choice) (sqrt x) * (1 + eps))%R.
+Proof.
+now intros x Fx; apply sqrt_error_N_round_ex_derive, sqrt_error_N_FLX_ex.
+Qed.
+
+Variable emin : Z.
+Hypothesis Hemin : (emin <= 2 * (1 - prec))%Z.
+
+Theorem sqrt_error_N_FLT_ex :
+  forall x,
+  generic_format beta (FLT_exp emin prec) x ->
+  exists eps,
+  (Rabs eps <= 1 - 1 / sqrt (1 + 2 * u_ro))%R /\
+  round beta (FLT_exp emin prec) (Znearest choice) (sqrt x)
+  = (sqrt x * (1 + eps))%R.
+Proof.
+intros x Fx.
+assert (Heps := u_ro_pos).
+assert (Pb := om1ds1p2u_ro_pos).
+destruct (Rle_or_lt x 0) as [Nx|Px].
+{ exists 0%R; split; [now rewrite Rabs_R0|].
+  now rewrite (sqrt_neg x Nx), round_0, Rmult_0_l; [|apply valid_rnd_N]. }
+assert (Fx' := generic_format_FLX_FLT _ _ _ _ Fx).
+destruct (sqrt_error_N_FLX_ex _ Fx') as (d, (Bd, Hd)).
+exists d; split; [exact Bd|]; rewrite <-Hd; apply round_FLT_FLX.
+apply (Rle_trans _ (bpow (emin / 2)%Z)).
+{ apply bpow_le, Z.div_le_lower_bound; lia. }
+apply (Rle_trans _ _ _ (sqrt_bpow_ge _ _)).
+rewrite Rabs_pos_eq; [|now apply sqrt_pos]; apply sqrt_le_1_alt.
+revert Fx; apply generic_format_ge_bpow; [|exact Px].
+intro e; unfold FLT_exp; apply Z.le_max_r.
+Qed.
+
+(** sqrt(1 + 2 u_ro) - 1 <= u_ro *)
+Theorem sqrt_error_N_FLT_round_ex :
+  forall x,
+  generic_format beta (FLT_exp emin prec) x ->
+  exists eps,
+  (Rabs eps <= sqrt (1 + 2 * u_ro) - 1)%R /\
+  sqrt x
+  = (round beta (FLT_exp emin prec) (Znearest choice) (sqrt x) * (1 + eps))%R.
+Proof.
+now intros x Fx; apply sqrt_error_N_round_ex_derive, sqrt_error_N_FLT_ex.
+Qed.
+
+End Fprop_divsqrt_error.
+
+Section format_REM_aux.
+
+Variable beta : radix.
+Notation bpow e := (bpow beta e).
+
+Variable fexp : Z -> Z.
+Context { valid_exp : Valid_exp fexp }.
+Context { monotone_exp : Monotone_exp fexp }.
+
+Variable rnd : R -> Z.
+Context { valid_rnd : Valid_rnd rnd }.
+
+Notation format := (generic_format beta fexp).
+
+Lemma format_REM_aux:
+  forall x y : R,
+  format x -> format y -> (0 <= x)%R -> (0 < y)%R ->
+  ((0 < x/y < /2)%R -> rnd (x/y) = 0%Z) ->
+  format (x - IZR (rnd (x/y))*y).
+Proof with auto with typeclass_instances.
+intros x y Fx Fy Hx Hy rnd_small.
+pose (n:=rnd (x / y)).
+assert (Hn:(IZR n = round beta (FIX_exp 0) rnd (x/y))%R).
+unfold round, FIX_exp, cexp, scaled_mantissa, F2R; simpl.
+now rewrite 2!Rmult_1_r.
+assert (H:(0 <= n)%Z).
+apply le_IZR; rewrite Hn; simpl.
+apply Rle_trans with (round beta (FIX_exp 0) rnd 0).
+right; apply sym_eq, round_0...
+apply round_le...
+apply Fourier_util.Rle_mult_inv_pos; assumption.
+case (Zle_lt_or_eq 0 n); try exact H.
+clear H; intros H.
+case (Zle_lt_or_eq 1 n).
+omega.
+clear H; intros H.
+set (ex := cexp beta fexp x).
+set (ey := cexp beta fexp y).
+set (mx := Ztrunc (scaled_mantissa beta fexp x)).
+set (my := Ztrunc (scaled_mantissa beta fexp y)).
+case (Zle_or_lt ey ex); intros Hexy.
+(* ey <= ex *)
+assert (H0:(x-IZR n *y = F2R (Float beta (mx*beta^(ex-ey) - n*my) ey))%R).
+unfold Rminus; rewrite Rplus_comm.
+replace (IZR n) with (F2R (Float beta n 0)).
+rewrite Fx, Fy.
+fold mx my ex ey.
+rewrite <- F2R_mult.
+rewrite <- F2R_opp.
+rewrite <- F2R_plus.
+unfold Fplus. simpl.
+rewrite Zle_imp_le_bool with (1 := Hexy).
+f_equal; f_equal; ring.
+unfold F2R; simpl; ring.
+fold n; rewrite H0.
+apply generic_format_F2R.
+rewrite <- H0; intros H3.
+apply monotone_exp.
+apply mag_le_abs.
+rewrite H0; apply F2R_neq_0; easy.
+apply Rmult_le_reg_l with (/Rabs y)%R.
+apply Rinv_0_lt_compat.
+apply Rabs_pos_lt.
+now apply Rgt_not_eq.
+rewrite Rinv_l.
+2: apply Rgt_not_eq, Rabs_pos_lt.
+2: now apply Rgt_not_eq.
+rewrite <- Rabs_Rinv.
+2: now apply Rgt_not_eq.
+rewrite <- Rabs_mult.
+replace (/y * (x - IZR n *y))%R with (-(IZR n - x/y))%R.
+rewrite Rabs_Ropp.
+rewrite Hn.
+apply Rle_trans with (1:= error_le_ulp beta (FIX_exp 0) _ _).
+rewrite ulp_FIX.
+simpl; apply Rle_refl.
+field.
+now apply Rgt_not_eq.
+(* ex < ey: impossible as 1 < n *)
+absurd (1 < n)%Z; try easy.
+apply Zle_not_lt.
+apply le_IZR; simpl; rewrite Hn.
+apply round_le_generic...
+apply generic_format_FIX.
+exists (Float beta 1 0); try easy.
+unfold F2R; simpl; ring.
+apply Rmult_le_reg_r with y; try easy.
+unfold Rdiv; rewrite Rmult_assoc.
+rewrite Rinv_l, Rmult_1_r, Rmult_1_l.
+2: now apply Rgt_not_eq.
+assert (mag beta x < mag beta y)%Z.
+case (Zle_or_lt (mag beta y) (mag beta x)); try easy.
+intros J; apply monotone_exp in J; clear -J Hexy.
+unfold ex, ey, cexp in Hexy; omega.
+left; apply lt_mag with beta; easy.
+(* n = 1 -> Sterbenz + rnd_small *)
+intros Hn'; fold n; rewrite <- Hn'.
+rewrite Rmult_1_l.
+case Hx; intros Hx'.
+assert (J:(0 < x/y)%R).
+apply Fourier_util.Rlt_mult_inv_pos; assumption.
+apply sterbenz...
+assert (H0:(Rabs (1  - x/y) < 1)%R).
+rewrite Hn', Hn.
+apply Rlt_le_trans with (ulp beta (FIX_exp 0) (round beta (FIX_exp 0) rnd (x / y)))%R.
+apply error_lt_ulp_round...
+now apply Rgt_not_eq.
+rewrite ulp_FIX.
+rewrite <- Hn, <- Hn'.
+apply Rle_refl.
+apply Rabs_lt_inv in H0.
+split; apply Rmult_le_reg_l with (/y)%R; try now apply Rinv_0_lt_compat.
+unfold Rdiv; rewrite <- Rmult_assoc.
+rewrite Rinv_l.
+2: now apply Rgt_not_eq.
+rewrite Rmult_1_l, Rmult_comm; fold (x/y)%R.
+case (Rle_or_lt (/2) (x/y)); try easy.
+intros K.
+elim Zlt_not_le with (1 := H).
+apply Zeq_le.
+apply rnd_small.
+now split.
+apply Ropp_le_cancel; apply Rplus_le_reg_l with 1%R.
+apply Rle_trans with (1-x/y)%R.
+2: right; unfold Rdiv; ring.
+left; apply Rle_lt_trans with (2:=proj1 H0).
+right; field.
+now apply Rgt_not_eq.
+rewrite <- Hx', Rminus_0_l.
+now apply generic_format_opp.
+(* n = 0 *)
+clear H; intros H; fold n; rewrite <- H.
+now rewrite Rmult_0_l, Rminus_0_r.
+Qed.
+
+End format_REM_aux.
+
+Section format_REM.
+
+Variable beta : radix.
+Notation bpow e := (bpow beta e).
+
+Variable fexp : Z -> Z.
+Context { valid_exp : Valid_exp fexp }.
+Context { monotone_exp : Monotone_exp fexp }.
+
+Notation format := (generic_format beta fexp).
+
+Theorem format_REM :
+  forall rnd : R -> Z, Valid_rnd rnd ->
+  forall x y : R,
+  ((Rabs (x/y) < /2)%R -> rnd (x/y)%R = 0%Z) ->
+  format x -> format y ->
+  format (x - IZR (rnd (x/y)%R) * y).
+Proof with auto with typeclass_instances.
+(* assume 0 < y *)
+assert (H: forall rnd : R -> Z, Valid_rnd rnd ->
+  forall x y : R,
+  ((Rabs (x/y) < /2)%R -> rnd (x/y)%R = 0%Z) ->
+  format x -> format y -> (0 < y)%R ->
+  format (x - IZR (rnd (x/y)%R) * y)).
+intros rnd valid_rnd x y Hrnd Fx Fy Hy.
+case (Rle_or_lt 0 x); intros Hx.
+apply format_REM_aux; try easy.
+intros K.
+apply Hrnd.
+rewrite Rabs_pos_eq.
+apply K.
+apply Rlt_le, K.
+replace (x - IZR (rnd (x/y)) * y)%R with
+   (- (-x - IZR (Zrnd_opp rnd (-x/y)) * y))%R.
+apply generic_format_opp.
+apply format_REM_aux; try easy...
+now apply generic_format_opp.
+apply Ropp_le_cancel; rewrite Ropp_0, Ropp_involutive; now left.
+replace (- x / y)%R with (- (x/y))%R by (unfold Rdiv; ring).
+intros K.
+unfold Zrnd_opp.
+rewrite Ropp_involutive, Hrnd.
+easy.
+rewrite Rabs_left.
+apply K.
+apply Ropp_lt_cancel.
+now rewrite Ropp_0.
+unfold Zrnd_opp.
+replace (- (- x / y))%R with (x / y)%R by (unfold Rdiv; ring).
+rewrite opp_IZR.
+ring.
+(* *)
+intros rnd valid_rnd x y Hrnd Fx Fy.
+case (Rle_or_lt 0 y); intros Hy.
+destruct Hy as [Hy|Hy].
+now apply H.
+now rewrite <- Hy, Rmult_0_r, Rminus_0_r.
+replace (IZR (rnd (x/y)) * y)%R with
+  (IZR ((Zrnd_opp rnd) ((x / -y))) * -y)%R.
+apply H; try easy...
+replace (x / - y)%R with (- (x/y))%R.
+intros K.
+unfold Zrnd_opp.
+rewrite Ropp_involutive, Hrnd.
+easy.
+now rewrite <- Rabs_Ropp.
+field; now apply Rlt_not_eq.
+now apply generic_format_opp.
+apply Ropp_lt_cancel; now rewrite Ropp_0, Ropp_involutive.
+unfold Zrnd_opp.
+replace (- (x / - y))%R with (x/y)%R.
+rewrite opp_IZR.
+ring.
+field; now apply Rlt_not_eq.
+Qed.
+
+Theorem format_REM_ZR:
+  forall x y : R,
+  format x -> format y ->
+  format (x - IZR (Ztrunc (x/y)) * y).
+Proof with auto with typeclass_instances.
+intros x y Fx Fy.
+apply format_REM; try easy...
+intros K.
+apply Z.abs_0_iff.
+rewrite <- Ztrunc_abs.
+rewrite Ztrunc_floor by apply Rabs_pos.
+apply Zle_antisym.
+replace 0%Z with (Zfloor (/2)).
+apply Zfloor_le.
+now apply Rlt_le.
+apply Zfloor_imp.
+simpl ; lra.
+apply Zfloor_lub.
+apply Rabs_pos.
+Qed.
+
+Theorem format_REM_N :
+  forall choice,
+  forall x y : R,
+  format x -> format y ->
+  format (x - IZR (Znearest choice (x/y)) * y).
+Proof with auto with typeclass_instances.
+intros choice x y Fx Fy.
+apply format_REM; try easy...
+intros K.
+apply Znearest_imp.
+now rewrite Rminus_0_r.
+Qed.
+
+End format_REM.
diff --git a/flocq/Appli/Fappli_double_round.v b/flocq/Prop/Double_rounding.v
index 82f61da3..055409bb 100644
--- a/flocq/Appli/Fappli_double_round.v
+++ b/flocq/Prop/Double_rounding.v
@@ -1,13 +1,28 @@
-(** * Conditions for innocuous double rounding. *)
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2014-2018 Sylvie Boldo
+#<br />#
+Copyright (C) 2014-2018 Guillaume Melquiond
+#<br />#
+Copyright (C) 2014-2018 Pierre Roux
+
+This library is free software; you can redistribute it and/or
+modify it 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.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+COPYING file for more details.
+*)
 
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_generic_fmt.
-Require Import Fcalc_ops.
-Require Import Fcore_ulp.
-Require Fcore_FLX Fcore_FLT Fcore_FTZ.
+(** * Conditions for innocuous double rounding. *)
 
 Require Import Psatz.
+Require Import Raux Defs Generic_fmt Operations Ulp FLX FLT FTZ.
 
 Open Scope R_scope.
 
@@ -15,9 +30,9 @@ Section Double_round.
 
 Variable beta : radix.
 Notation bpow e := (bpow beta e).
-Notation ln_beta x := (ln_beta beta x).
+Notation mag x := (mag beta x).
 
-Definition double_round_eq fexp1 fexp2 choice1 choice2 x :=
+Definition round_round_eq fexp1 fexp2 choice1 choice2 x :=
   round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)
   = round beta fexp1 (Znearest choice1) x.
 
@@ -26,22 +41,22 @@ Ltac bpow_simplify :=
   (* bpow ex * bpow ey ~~> bpow (ex + ey) *)
   repeat
     match goal with
-      | |- context [(Fcore_Raux.bpow _ _ * Fcore_Raux.bpow _ _)] =>
+      | |- context [(Raux.bpow _ _ * Raux.bpow _ _)] =>
         rewrite <- bpow_plus
-      | |- context [(?X1 * Fcore_Raux.bpow _ _ * Fcore_Raux.bpow _ _)] =>
+      | |- context [(?X1 * Raux.bpow _ _ * Raux.bpow _ _)] =>
         rewrite (Rmult_assoc X1); rewrite <- bpow_plus
-      | |- context [(?X1 * (?X2 * Fcore_Raux.bpow _ _) * Fcore_Raux.bpow _ _)] =>
+      | |- context [(?X1 * (?X2 * Raux.bpow _ _) * Raux.bpow _ _)] =>
         rewrite <- (Rmult_assoc X1 X2); rewrite (Rmult_assoc (X1 * X2));
         rewrite <- bpow_plus
     end;
   (* ring_simplify arguments of bpow *)
   repeat
     match goal with
-      | |- context [(Fcore_Raux.bpow _ ?X)] =>
+      | |- context [(Raux.bpow _ ?X)] =>
         progress ring_simplify X
     end;
   (* bpow 0 ~~> 1 *)
-  change (Fcore_Raux.bpow _ 0) with 1;
+  change (Raux.bpow _ 0) with 1;
   repeat
     match goal with
       | |- context [(_ * 1)] =>
@@ -54,26 +69,26 @@ Definition midp (fexp : Z -> Z) (x : R) :=
 Definition midp' (fexp : Z -> Z) (x : R) :=
   round beta fexp Zceil x - / 2 * ulp beta fexp x.
 
-Lemma double_round_lt_mid_further_place' :
+Lemma round_round_lt_mid_further_place' :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
-  x < bpow (ln_beta x) - / 2 * ulp beta fexp2 x ->
+  (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
+  x < bpow (mag x) - / 2 * ulp beta fexp2 x ->
   x < midp fexp1 x - / 2 * ulp beta fexp2 x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hx1.
-unfold double_round_eq.
+unfold round_round_eq.
 set (x' := round beta fexp1 Zfloor x).
 intro Hx2'.
 assert (Hx2 : x - round beta fexp1 Zfloor x
               < / 2 * (ulp beta fexp1 x - ulp beta fexp2 x)).
 { now apply (Rplus_lt_reg_r (round beta fexp1 Zfloor x)); ring_simplify. }
 set (x'' := round beta fexp2 (Znearest choice2) x).
-assert (Hr1 : Rabs (x'' - x) <= / 2 * bpow (fexp2 (ln_beta x))).
+assert (Hr1 : Rabs (x'' - x) <= / 2 * bpow (fexp2 (mag x))).
 apply Rle_trans with (/ 2 * ulp beta fexp2 x).
 now unfold x''; apply error_le_half_ulp...
 rewrite ulp_neq_0;[now right|now apply Rgt_not_eq].
@@ -82,12 +97,12 @@ assert (Pxx' : 0 <= x - x').
   apply round_DN_pt.
   exact Vfexp1. }
 rewrite 2!ulp_neq_0 in Hx2; try (apply Rgt_not_eq; assumption).
-assert (Hr2 : Rabs (x'' - x') < / 2 * bpow (fexp1 (ln_beta x))).
+assert (Hr2 : Rabs (x'' - x') < / 2 * bpow (fexp1 (mag x))).
 { replace (x'' - x') with (x'' - x + (x - x')) by ring.
   apply (Rle_lt_trans _ _ _ (Rabs_triang _ _)).
-  replace (/ 2 * _) with (/ 2 * bpow (fexp2 (ln_beta x))
-                          + (/ 2 * (bpow (fexp1 (ln_beta x))
-                                    - bpow (fexp2 (ln_beta x))))) by ring.
+  replace (/ 2 * _) with (/ 2 * bpow (fexp2 (mag x))
+                          + (/ 2 * (bpow (fexp1 (mag x))
+                                    - bpow (fexp2 (mag x))))) by ring.
   apply Rplus_le_lt_compat.
   - exact Hr1.
   - now rewrite Rabs_right; [|now apply Rle_ge]; apply Hx2. }
@@ -95,9 +110,9 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx''].
 - (* x'' = 0 *)
   rewrite Zx'' in Hr1 |- *.
   rewrite round_0; [|now apply valid_rnd_N].
-  unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
+  unfold round, F2R, scaled_mantissa, cexp; simpl.
   rewrite (Znearest_imp _ _ 0); [now simpl; rewrite Rmult_0_l|].
-  apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+  apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
   rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
     [|now apply Rle_ge; apply bpow_ge_0].
   rewrite <- Rabs_mult; rewrite Rmult_minus_distr_r.
@@ -109,25 +124,25 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx''].
   apply bpow_lt.
   omega.
 - (* x'' <> 0 *)
-  assert (Lx'' : ln_beta x'' = ln_beta x :> Z).
+  assert (Lx'' : mag x'' = mag x :> Z).
   { apply Zle_antisym.
-    - apply ln_beta_le_bpow; [exact Nzx''|].
+    - apply mag_le_bpow; [exact Nzx''|].
       replace x'' with (x'' - x + x) by ring.
       apply (Rle_lt_trans _ _ _ (Rabs_triang _ _)).
-      replace (bpow _) with (/ 2 * bpow (fexp2 (ln_beta x))
-                             + (bpow (ln_beta x)
-                                - / 2 * bpow (fexp2 (ln_beta x)))) by ring.
+      replace (bpow _) with (/ 2 * bpow (fexp2 (mag x))
+                             + (bpow (mag x)
+                                - / 2 * bpow (fexp2 (mag x)))) by ring.
       apply Rplus_le_lt_compat; [exact Hr1|].
       rewrite ulp_neq_0 in Hx1;[idtac| now apply Rgt_not_eq].
       now rewrite Rabs_right; [|apply Rle_ge; apply Rlt_le].
     - unfold x'' in Nzx'' |- *.
-      now apply ln_beta_round_ge; [|apply valid_rnd_N|]. }
-  unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
+      now apply mag_round_ge; [|apply valid_rnd_N|]. }
+  unfold round, F2R, scaled_mantissa, cexp; simpl.
   rewrite Lx''.
   rewrite (Znearest_imp _ _ (Zfloor (scaled_mantissa beta fexp1 x))).
   + rewrite (Znearest_imp _ _ (Zfloor (scaled_mantissa beta fexp1 x)));
     [reflexivity|].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
     rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
       [|now apply Rle_ge; apply bpow_ge_0].
     rewrite <- Rabs_mult.
@@ -137,9 +152,9 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx''].
     rewrite Rabs_right; [|now apply Rle_ge].
     apply (Rlt_le_trans _ _ _ Hx2).
     apply Rmult_le_compat_l; [lra|].
-    generalize (bpow_ge_0 beta (fexp2 (ln_beta x))).
-    unfold ulp, canonic_exp; lra.
-  + apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+    generalize (bpow_ge_0 beta (fexp2 (mag x))).
+    unfold ulp, cexp; lra.
+  + apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
     rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
       [|now apply Rle_ge; apply bpow_ge_0].
     rewrite <- Rabs_mult.
@@ -148,16 +163,16 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx''].
     now bpow_simplify.
 Qed.
 
-Lemma double_round_lt_mid_further_place :
+Lemma round_round_lt_mid_further_place :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
-  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
+  (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
+  (fexp1 (mag x) <= mag x)%Z ->
   x < midp fexp1 x - / 2 * ulp beta fexp2 x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1.
 intro Hx2'.
@@ -165,15 +180,15 @@ assert (Hx2 : x - round beta fexp1 Zfloor x
               < / 2 * (ulp beta fexp1 x - ulp beta fexp2 x)).
 { now apply (Rplus_lt_reg_r (round beta fexp1 Zfloor x)); ring_simplify. }
 revert Hx2.
-unfold double_round_eq.
+unfold round_round_eq.
 set (x' := round beta fexp1 Zfloor x).
 intro Hx2.
 assert (Pxx' : 0 <= x - x').
 { apply Rle_0_minus.
   apply round_DN_pt.
   exact Vfexp1. }
-assert (x < bpow (ln_beta x) - / 2 * bpow (fexp2 (ln_beta x)));
-  [|apply double_round_lt_mid_further_place'; try assumption]...
+assert (x < bpow (mag x) - / 2 * bpow (fexp2 (mag x)));
+  [|apply round_round_lt_mid_further_place'; try assumption]...
 2: rewrite ulp_neq_0;[assumption|now apply Rgt_not_eq].
 destruct (Req_dec x' 0) as [Zx'|Nzx'].
 - (* x' = 0 *)
@@ -182,10 +197,10 @@ destruct (Req_dec x' 0) as [Zx'|Nzx'].
   rewrite Rmult_minus_distr_l.
   rewrite 2!ulp_neq_0;[idtac|now apply Rgt_not_eq|now apply Rgt_not_eq].
   apply Rplus_le_compat_r.
-  apply (Rmult_le_reg_r (bpow (- ln_beta x))); [now apply bpow_gt_0|].
-  unfold ulp, canonic_exp; bpow_simplify.
+  apply (Rmult_le_reg_r (bpow (- mag x))); [now apply bpow_gt_0|].
+  unfold ulp, cexp; bpow_simplify.
   apply Rmult_le_reg_l with (1 := Rlt_0_2).
-  replace (2 * (/ 2 * _)) with (bpow (fexp1 (ln_beta x) - ln_beta x)) by field.
+  replace (2 * (/ 2 * _)) with (bpow (fexp1 (mag x) - mag x)) by field.
   apply Rle_trans with 1; [|lra].
   change 1 with (bpow 0); apply bpow_le.
   omega.
@@ -193,16 +208,16 @@ destruct (Req_dec x' 0) as [Zx'|Nzx'].
   assert (Px' : 0 < x').
   { assert (0 <= x'); [|lra].
     unfold x'.
-    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
+    apply (Rmult_le_reg_r (bpow (- fexp1 (mag x))));
       [now apply bpow_gt_0|].
     rewrite Rmult_0_l.
-    unfold round, F2R, canonic_exp; simpl; bpow_simplify.
-    change 0 with (Z2R 0); apply Z2R_le.
+    unfold round, F2R, cexp; simpl; bpow_simplify.
+    apply IZR_le.
     apply Zfloor_lub.
     rewrite <- (Rabs_right x); [|now apply Rle_ge; apply Rlt_le].
     rewrite scaled_mantissa_abs.
     apply Rabs_pos. }
-  assert (Hx' : x' <= bpow (ln_beta x) - ulp beta fexp1 x).
+  assert (Hx' : x' <= bpow (mag x) - ulp beta fexp1 x).
   { apply (Rplus_le_reg_r (ulp beta fexp1 x)); ring_simplify.
     rewrite <- ulp_DN.
     - change (round _ _ _ _) with x'.
@@ -213,10 +228,10 @@ destruct (Req_dec x' 0) as [Zx'|Nzx'].
       + apply Rle_lt_trans with x.
         * now apply round_DN_pt.
         * rewrite <- (Rabs_right x) at 1; [|now apply Rle_ge; apply Rlt_le].
-          apply bpow_ln_beta_gt.
+          apply bpow_mag_gt.
     - exact Vfexp1.
-    - exact Px'. }
-  fold (canonic_exp beta fexp2 x); fold (ulp beta fexp2 x).
+    - now apply Rlt_le. }
+  fold (cexp beta fexp2 x); fold (ulp beta fexp2 x).
   assert (/ 2 * ulp beta fexp1 x <= ulp beta fexp1 x).
   rewrite <- (Rmult_1_l (ulp _ _ _)) at 2.
   apply Rmult_le_compat_r; [|lra].
@@ -227,39 +242,39 @@ destruct (Req_dec x' 0) as [Zx'|Nzx'].
   lra.
 Qed.
 
-Lemma double_round_lt_mid_same_place :
+Lemma round_round_lt_mid_same_place :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) = fexp1 (ln_beta x))%Z ->
+  (fexp2 (mag x) = fexp1 (mag x))%Z ->
   x < midp fexp1 x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 choice1 choice2 x Px Hf2f1.
 intro Hx'.
 assert (Hx : x - round beta fexp1 Zfloor x < / 2 * ulp beta fexp1 x).
 { now apply (Rplus_lt_reg_r (round beta fexp1 Zfloor x)); ring_simplify. }
 revert Hx.
-unfold double_round_eq.
+unfold round_round_eq.
 set (x' := round beta fexp1 Zfloor x).
 intro Hx.
 assert (Pxx' : 0 <= x - x').
 { apply Rle_0_minus.
   apply round_DN_pt.
   exact Vfexp1. }
-assert (H : Rabs (x * bpow (- fexp1 (ln_beta x)) -
-                  Z2R (Zfloor (x * bpow (- fexp1 (ln_beta x))))) < / 2).
-{ apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
-  unfold scaled_mantissa, canonic_exp in Hx.
+assert (H : Rabs (x * bpow (- fexp1 (mag x)) -
+                  IZR (Zfloor (x * bpow (- fexp1 (mag x))))) < / 2).
+{ apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
+  unfold scaled_mantissa, cexp in Hx.
   rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
     [|now apply Rle_ge; apply bpow_ge_0].
   rewrite <- Rabs_mult.
   rewrite Rmult_minus_distr_r.
   bpow_simplify.
   apply Rabs_lt.
-  change (Z2R _ * _) with x'.
+  change (IZR _ * _) with x'.
   split.
   - apply Rlt_le_trans with 0; [|exact Pxx'].
     rewrite <- Ropp_0.
@@ -269,55 +284,54 @@ assert (H : Rabs (x * bpow (- fexp1 (ln_beta x)) -
     apply bpow_gt_0.
   - rewrite ulp_neq_0 in Hx;try apply Rgt_not_eq; assumption. }
 unfold round at 2.
-unfold F2R, scaled_mantissa, canonic_exp; simpl.
+unfold F2R, scaled_mantissa, cexp; simpl.
 rewrite Hf2f1.
-rewrite (Znearest_imp _ _ (Zfloor (scaled_mantissa beta fexp1 x))).
-- rewrite round_generic.
-  + unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
-    now rewrite (Znearest_imp _ _ (Zfloor (x * bpow (- fexp1 (ln_beta x))))).
+rewrite (Znearest_imp _ _ (Zfloor (scaled_mantissa beta fexp1 x)) H).
+rewrite round_generic.
+  + unfold round, F2R, scaled_mantissa, cexp; simpl.
+    now rewrite (Znearest_imp _ _ (Zfloor (x * bpow (- fexp1 (mag x))))).
   + now apply valid_rnd_N.
-  + fold (canonic_exp beta fexp1 x).
-    change (Z2R _ * bpow _) with (round beta fexp1 Zfloor x).
+  + fold (cexp beta fexp1 x).
+    change (IZR _ * bpow _) with (round beta fexp1 Zfloor x).
     apply generic_format_round.
     exact Vfexp1.
     now apply valid_rnd_DN.
-- now unfold scaled_mantissa, canonic_exp.
 Qed.
 
-Lemma double_round_lt_mid :
+Lemma round_round_lt_mid :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z ->
-  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
+  (fexp2 (mag x) <= fexp1 (mag x))%Z ->
+  (fexp1 (mag x) <= mag x)%Z ->
   x < midp fexp1 x ->
-  ((fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
+  ((fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
    x < midp fexp1 x - / 2 * ulp beta fexp2 x) ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1 Hx Hx'.
-destruct (Zle_or_lt (fexp1 (ln_beta x)) (fexp2 (ln_beta x))) as [Hf2'|Hf2'].
-- (* fexp1 (ln_beta x) <= fexp2 (ln_beta x) *)
-  assert (Hf2'' : (fexp2 (ln_beta x) = fexp1 (ln_beta x) :> Z)%Z); [omega|].
-  now apply double_round_lt_mid_same_place.
-- (* fexp2 (ln_beta x) < fexp1 (ln_beta x) *)
-  assert (Hf2'' : (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z); [omega|].
+destruct (Zle_or_lt (fexp1 (mag x)) (fexp2 (mag x))) as [Hf2'|Hf2'].
+- (* fexp1 (mag x) <= fexp2 (mag x) *)
+  assert (Hf2'' : (fexp2 (mag x) = fexp1 (mag x) :> Z)%Z); [omega|].
+  now apply round_round_lt_mid_same_place.
+- (* fexp2 (mag x) < fexp1 (mag x) *)
+  assert (Hf2'' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z); [omega|].
   generalize (Hx' Hf2''); intro Hx''.
-  now apply double_round_lt_mid_further_place.
+  now apply round_round_lt_mid_further_place.
 Qed.
 
-Lemma double_round_gt_mid_further_place' :
+Lemma round_round_gt_mid_further_place' :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
-  round beta fexp2 (Znearest choice2) x < bpow (ln_beta x) ->
+  (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
+  round beta fexp2 (Znearest choice2) x < bpow (mag x) ->
   midp' fexp1 x + / 2 * ulp beta fexp2 x < x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1.
 intros Hx1 Hx2'.
@@ -327,11 +341,11 @@ assert (Hx2 : round beta fexp1 Zceil x - x
                          + / 2 * ulp beta fexp2 x)); ring_simplify.
   now unfold midp' in Hx2'. }
 revert Hx1 Hx2.
-unfold double_round_eq.
+unfold round_round_eq.
 set (x' := round beta fexp1 Zceil x).
 set (x'' := round beta fexp2 (Znearest choice2) x).
 intros Hx1 Hx2.
-assert (Hr1 : Rabs (x'' - x) <= / 2 * bpow (fexp2 (ln_beta x))).
+assert (Hr1 : Rabs (x'' - x) <= / 2 * bpow (fexp2 (mag x))).
   apply Rle_trans with (/2* ulp beta fexp2 x).
   now unfold x''; apply error_le_half_ulp...
   rewrite ulp_neq_0;[now right|now apply Rgt_not_eq].
@@ -339,12 +353,12 @@ assert (Px'x : 0 <= x' - x).
 { apply Rle_0_minus.
   apply round_UP_pt.
   exact Vfexp1. }
-assert (Hr2 : Rabs (x'' - x') < / 2 * bpow (fexp1 (ln_beta x))).
+assert (Hr2 : Rabs (x'' - x') < / 2 * bpow (fexp1 (mag x))).
 { replace (x'' - x') with (x'' - x + (x - x')) by ring.
   apply (Rle_lt_trans _ _ _ (Rabs_triang _ _)).
-  replace (/ 2 * _) with (/ 2 * bpow (fexp2 (ln_beta x))
-                          + (/ 2 * (bpow (fexp1 (ln_beta x))
-                                    - bpow (fexp2 (ln_beta x))))) by ring.
+  replace (/ 2 * _) with (/ 2 * bpow (fexp2 (mag x))
+                          + (/ 2 * (bpow (fexp1 (mag x))
+                                    - bpow (fexp2 (mag x))))) by ring.
   apply Rplus_le_lt_compat.
   - exact Hr1.
   - rewrite Rabs_minus_sym.
@@ -354,9 +368,9 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx''].
 - (* x'' = 0 *)
   rewrite Zx'' in Hr1 |- *.
   rewrite round_0; [|now apply valid_rnd_N].
-  unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
+  unfold round, F2R, scaled_mantissa, cexp; simpl.
   rewrite (Znearest_imp _ _ 0); [now simpl; rewrite Rmult_0_l|].
-  apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+  apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
   rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
     [|now apply Rle_ge; apply bpow_ge_0].
   rewrite <- Rabs_mult; rewrite Rmult_minus_distr_r.
@@ -368,9 +382,9 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx''].
   apply bpow_lt.
   omega.
 - (* x'' <> 0 *)
-  assert (Lx'' : ln_beta x'' = ln_beta x :> Z).
+  assert (Lx'' : mag x'' = mag x :> Z).
   { apply Zle_antisym.
-    - apply ln_beta_le_bpow; [exact Nzx''|].
+    - apply mag_le_bpow; [exact Nzx''|].
       rewrite Rabs_right; [exact Hx1|apply Rle_ge].
       apply round_ge_generic.
       + exact Vfexp2.
@@ -378,13 +392,13 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx''].
       + apply generic_format_0.
       + now apply Rlt_le.
     - unfold x'' in Nzx'' |- *.
-      now apply ln_beta_round_ge; [|apply valid_rnd_N|]. }
-  unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
+      now apply mag_round_ge; [|apply valid_rnd_N|]. }
+  unfold round, F2R, scaled_mantissa, cexp; simpl.
   rewrite Lx''.
   rewrite (Znearest_imp _ _ (Zceil (scaled_mantissa beta fexp1 x))).
   + rewrite (Znearest_imp _ _ (Zceil (scaled_mantissa beta fexp1 x)));
     [reflexivity|].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
     rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
       [|now apply Rle_ge; apply bpow_ge_0].
     rewrite <- Rabs_mult.
@@ -395,10 +409,10 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx''].
     rewrite Rabs_right; [|now apply Rle_ge].
     apply (Rlt_le_trans _ _ _ Hx2).
     apply Rmult_le_compat_l; [lra|].
-    generalize (bpow_ge_0 beta (fexp2 (ln_beta x))).
+    generalize (bpow_ge_0 beta (fexp2 (mag x))).
     rewrite 2!ulp_neq_0; try (apply Rgt_not_eq; assumption).
-    unfold canonic_exp; lra.
-  + apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+    unfold cexp; lra.
+  + apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
     rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
       [|now apply Rle_ge; apply bpow_ge_0].
     rewrite <- Rabs_mult.
@@ -407,16 +421,16 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx''].
     now bpow_simplify.
 Qed.
 
-Lemma double_round_gt_mid_further_place :
+Lemma round_round_gt_mid_further_place :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
-  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
+  (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
+  (fexp1 (mag x) <= mag x)%Z ->
   midp' fexp1 x + / 2 * ulp beta fexp2 x < x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1 Hx2'.
 assert (Hx2 : round beta fexp1 Zceil x - x
@@ -425,15 +439,15 @@ assert (Hx2 : round beta fexp1 Zceil x - x
                          + / 2 * ulp beta fexp2 x)); ring_simplify.
   now unfold midp' in Hx2'. }
 revert Hx2.
-unfold double_round_eq.
+unfold round_round_eq.
 set (x' := round beta fexp1 Zfloor x).
 intro Hx2.
 set (x'' := round beta fexp2 (Znearest choice2) x).
-destruct (Rlt_or_le x'' (bpow (ln_beta x))) as [Hx''|Hx''];
-  [now apply double_round_gt_mid_further_place'|].
-(* bpow (ln_beta x) <= x'' *)
-assert (Hx''pow : x'' = bpow (ln_beta x)).
-{ assert (H'x'' : x'' < bpow (ln_beta x) + / 2 * ulp beta fexp2 x).
+destruct (Rlt_or_le x'' (bpow (mag x))) as [Hx''|Hx''];
+  [now apply round_round_gt_mid_further_place'|].
+(* bpow (mag x) <= x'' *)
+assert (Hx''pow : x'' = bpow (mag x)).
+{ assert (H'x'' : x'' < bpow (mag x) + / 2 * ulp beta fexp2 x).
   { apply Rle_lt_trans with (x + / 2 * ulp beta fexp2 x).
     - apply (Rplus_le_reg_r (- x)); ring_simplify.
       apply Rabs_le_inv.
@@ -441,22 +455,22 @@ assert (Hx''pow : x'' = bpow (ln_beta x)).
       exact Vfexp2.
     - apply Rplus_lt_compat_r.
       rewrite <- Rabs_right at 1; [|now apply Rle_ge; apply Rlt_le].
-      apply bpow_ln_beta_gt. }
+      apply bpow_mag_gt. }
   apply Rle_antisym; [|exact Hx''].
-  unfold x'', round, F2R, scaled_mantissa, canonic_exp; simpl.
-  apply (Rmult_le_reg_r (bpow (- fexp2 (ln_beta x)))); [now apply bpow_gt_0|].
+  unfold x'', round, F2R, scaled_mantissa, cexp; simpl.
+  apply (Rmult_le_reg_r (bpow (- fexp2 (mag x)))); [now apply bpow_gt_0|].
   bpow_simplify.
-  rewrite <- (Z2R_Zpower _ (_ - _)); [|omega].
-  apply Z2R_le.
+  rewrite <- (IZR_Zpower _ (_ - _)); [|omega].
+  apply IZR_le.
   apply Zlt_succ_le; unfold Z.succ.
-  apply lt_Z2R.
-  rewrite Z2R_plus; rewrite Z2R_Zpower; [|omega].
-  apply (Rmult_lt_reg_r (bpow (fexp2 (ln_beta x)))); [now apply bpow_gt_0|].
+  apply lt_IZR.
+  rewrite plus_IZR; rewrite IZR_Zpower; [|omega].
+  apply (Rmult_lt_reg_r (bpow (fexp2 (mag x)))); [now apply bpow_gt_0|].
   rewrite Rmult_plus_distr_r; rewrite Rmult_1_l.
   bpow_simplify.
   apply (Rlt_le_trans _ _ _ H'x'').
   apply Rplus_le_compat_l.
-  rewrite <- (Rmult_1_l (Fcore_Raux.bpow _ _)).
+  rewrite <- (Rmult_1_l (Raux.bpow _ _)).
   rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq].
   apply Rmult_le_compat_r; [now apply bpow_ge_0|].
   lra. }
@@ -467,26 +481,26 @@ assert (Hr : Rabs (x - x'') < / 2 * ulp beta fexp1 x).
     exact Vfexp2.
   - apply Rmult_lt_compat_l; [lra|].
     rewrite 2!ulp_neq_0; try now apply Rgt_not_eq.
-    unfold canonic_exp; apply bpow_lt.
+    unfold cexp; apply bpow_lt.
     omega. }
-unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
-assert (Hf : (0 <= ln_beta x - fexp1 (ln_beta x''))%Z).
+unfold round, F2R, scaled_mantissa, cexp; simpl.
+assert (Hf : (0 <= mag x - fexp1 (mag x''))%Z).
 { rewrite Hx''pow.
-  rewrite ln_beta_bpow.
-  assert (fexp1 (ln_beta x + 1) <= ln_beta x)%Z; [|omega].
-  destruct (Zle_or_lt (ln_beta x) (fexp1 (ln_beta x))) as [Hle|Hlt];
+  rewrite mag_bpow.
+  assert (fexp1 (mag x + 1) <= mag x)%Z; [|omega].
+  destruct (Zle_or_lt (mag x) (fexp1 (mag x))) as [Hle|Hlt];
     [|now apply Vfexp1].
-  assert (H : (ln_beta x = fexp1 (ln_beta x) :> Z)%Z);
+  assert (H : (mag x = fexp1 (mag x) :> Z)%Z);
     [now apply Zle_antisym|].
   rewrite H.
   now apply Vfexp1. }
-rewrite (Znearest_imp _ _ (beta ^ (ln_beta x - fexp1 (ln_beta x'')))%Z).
-- rewrite (Znearest_imp _ _ (beta ^ (ln_beta x - fexp1 (ln_beta x)))%Z).
-  + rewrite Z2R_Zpower; [|exact Hf].
-    rewrite Z2R_Zpower; [|omega].
+rewrite (Znearest_imp _ _ (beta ^ (mag x - fexp1 (mag x'')))%Z).
+- rewrite (Znearest_imp _ _ (beta ^ (mag x - fexp1 (mag x)))%Z).
+  + rewrite IZR_Zpower; [|exact Hf].
+    rewrite IZR_Zpower; [|omega].
     now bpow_simplify.
-  + rewrite Z2R_Zpower; [|omega].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+  + rewrite IZR_Zpower; [|omega].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
     rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
       [|now apply Rle_ge; apply bpow_ge_0].
     rewrite <- Rabs_mult.
@@ -494,8 +508,8 @@ rewrite (Znearest_imp _ _ (beta ^ (ln_beta x - fexp1 (ln_beta x'')))%Z).
     bpow_simplify.
    rewrite ulp_neq_0 in Hr;[idtac|now apply Rgt_not_eq].
     rewrite <- Hx''pow; exact Hr.
-- rewrite Z2R_Zpower; [|exact Hf].
-  apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x'')))); [now apply bpow_gt_0|].
+- rewrite IZR_Zpower; [|exact Hf].
+  apply (Rmult_lt_reg_r (bpow (fexp1 (mag x'')))); [now apply bpow_gt_0|].
   rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
     [|now apply Rle_ge; apply bpow_ge_0].
   rewrite <- Rabs_mult.
@@ -507,24 +521,24 @@ rewrite (Znearest_imp _ _ (beta ^ (ln_beta x - fexp1 (ln_beta x'')))%Z).
   apply Rmult_lt_compat_l; [lra|apply bpow_gt_0].
 Qed.
 
-Lemma double_round_gt_mid_same_place :
+Lemma round_round_gt_mid_same_place :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) = fexp1 (ln_beta x))%Z ->
+  (fexp2 (mag x) = fexp1 (mag x))%Z ->
   midp' fexp1 x < x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 choice1 choice2 x Px Hf2f1 Hx'.
 assert (Hx : round beta fexp1 Zceil x - x < / 2 * ulp beta fexp1 x).
 { apply (Rplus_lt_reg_r (- / 2 * ulp beta fexp1 x + x)); ring_simplify.
   now unfold midp' in Hx'. }
-assert (H : Rabs (Z2R (Zceil (x * bpow (- fexp1 (ln_beta x))))
-                  - x * bpow (- fexp1 (ln_beta x))) < / 2).
-{ apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
-  unfold scaled_mantissa, canonic_exp in Hx.
+assert (H : Rabs (IZR (Zceil (x * bpow (- fexp1 (mag x))))
+                  - x * bpow (- fexp1 (mag x))) < / 2).
+{ apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
+  unfold scaled_mantissa, cexp in Hx.
   rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
     [|now apply Rle_ge; apply bpow_ge_0].
   rewrite <- Rabs_mult.
@@ -541,67 +555,67 @@ assert (H : Rabs (Z2R (Zceil (x * bpow (- fexp1 (ln_beta x))))
       apply round_UP_pt.
       exact Vfexp1.
   -  rewrite ulp_neq_0 in Hx;[exact Hx|now apply Rgt_not_eq]. }
-unfold double_round_eq, round at 2.
-unfold F2R, scaled_mantissa, canonic_exp; simpl.
+unfold round_round_eq, round at 2.
+unfold F2R, scaled_mantissa, cexp; simpl.
 rewrite Hf2f1.
 rewrite (Znearest_imp _ _ (Zceil (scaled_mantissa beta fexp1 x))).
 - rewrite round_generic.
-  + unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
-    now rewrite (Znearest_imp _ _ (Zceil (x * bpow (- fexp1 (ln_beta x)))));
+  + unfold round, F2R, scaled_mantissa, cexp; simpl.
+    now rewrite (Znearest_imp _ _ (Zceil (x * bpow (- fexp1 (mag x)))));
       [|rewrite Rabs_minus_sym].
   + now apply valid_rnd_N.
-  + fold (canonic_exp beta fexp1 x).
-    change (Z2R _ * bpow _) with (round beta fexp1 Zceil x).
+  + fold (cexp beta fexp1 x).
+    change (IZR _ * bpow _) with (round beta fexp1 Zceil x).
     apply generic_format_round.
     exact Vfexp1.
     now apply valid_rnd_UP.
 - now rewrite Rabs_minus_sym.
 Qed.
 
-Lemma double_round_gt_mid :
+Lemma round_round_gt_mid :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z ->
-  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
+  (fexp2 (mag x) <= fexp1 (mag x))%Z ->
+  (fexp1 (mag x) <= mag x)%Z ->
   midp' fexp1 x < x ->
-  ((fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
+  ((fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
    midp' fexp1 x + / 2 * ulp beta fexp2 x < x) ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1 Hx Hx'.
-destruct (Zle_or_lt (fexp1 (ln_beta x)) (fexp2 (ln_beta x))) as [Hf2'|Hf2'].
-- (* fexp1 (ln_beta x) <= fexp2 (ln_beta x) *)
-  assert (Hf2'' : (fexp2 (ln_beta x) = fexp1 (ln_beta x) :> Z)%Z); [omega|].
-  now apply double_round_gt_mid_same_place.
-- (* fexp2 (ln_beta x) < fexp1 (ln_beta x) *)
-  assert (Hf2'' : (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z); [omega|].
+destruct (Zle_or_lt (fexp1 (mag x)) (fexp2 (mag x))) as [Hf2'|Hf2'].
+- (* fexp1 (mag x) <= fexp2 (mag x) *)
+  assert (Hf2'' : (fexp2 (mag x) = fexp1 (mag x) :> Z)%Z); [omega|].
+  now apply round_round_gt_mid_same_place.
+- (* fexp2 (mag x) < fexp1 (mag x) *)
+  assert (Hf2'' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z); [omega|].
   generalize (Hx' Hf2''); intro Hx''.
-  now apply double_round_gt_mid_further_place.
+  now apply round_round_gt_mid_further_place.
 Qed.
 
 Section Double_round_mult.
 
-Lemma ln_beta_mult_disj :
+Lemma mag_mult_disj :
   forall x y,
   x <> 0 -> y <> 0 ->
-  ((ln_beta (x * y) = (ln_beta x + ln_beta y - 1)%Z :> Z)
-   \/ (ln_beta (x * y) = (ln_beta x + ln_beta y)%Z :> Z)).
+  ((mag (x * y) = (mag x + mag y - 1)%Z :> Z)
+   \/ (mag (x * y) = (mag x + mag y)%Z :> Z)).
 Proof.
 intros x y Zx Zy.
-destruct (ln_beta_mult beta x y Zx Zy).
+destruct (mag_mult beta x y Zx Zy).
 omega.
 Qed.
 
-Definition double_round_mult_hyp fexp1 fexp2 :=
+Definition round_round_mult_hyp fexp1 fexp2 :=
   (forall ex ey, (fexp2 (ex + ey) <= fexp1 ex + fexp1 ey)%Z)
   /\ (forall ex ey, (fexp2 (ex + ey - 1) <= fexp1 ex + fexp1 ey)%Z).
 
-Lemma double_round_mult_aux :
+Lemma round_round_mult_aux :
   forall (fexp1 fexp2 : Z -> Z),
-  double_round_mult_hyp fexp1 fexp2 ->
+  round_round_mult_hyp fexp1 fexp2 ->
   forall x y,
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x * y).
@@ -621,31 +635,31 @@ destruct (Req_dec x 0) as [Zx|Zx].
   + (* y <> 0 *)
     revert Fx Fy.
     unfold generic_format.
-    unfold canonic_exp.
+    unfold cexp.
     set (mx := Ztrunc (scaled_mantissa beta fexp1 x)).
     set (my := Ztrunc (scaled_mantissa beta fexp1 y)).
     unfold F2R; simpl.
     intros Fx Fy.
-    set (fxy := Float beta (mx * my) (fexp1 (ln_beta x) + fexp1 (ln_beta y))).
+    set (fxy := Float beta (mx * my) (fexp1 (mag x) + fexp1 (mag y))).
     assert (Hxy : x * y = F2R fxy).
     { unfold fxy, F2R; simpl.
       rewrite bpow_plus.
-      rewrite Z2R_mult.
+      rewrite mult_IZR.
       rewrite Fx, Fy at 1.
       ring. }
     apply generic_format_F2R' with (f := fxy); [now rewrite Hxy|].
     intros _.
-    unfold canonic_exp, fxy; simpl.
+    unfold cexp, fxy; simpl.
     destruct Hfexp as (Hfexp1, Hfexp2).
-    now destruct (ln_beta_mult_disj x y Zx Zy) as [Lxy|Lxy]; rewrite Lxy.
+    now destruct (mag_mult_disj x y Zx Zy) as [Lxy|Lxy]; rewrite Lxy.
 Qed.
 
 Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
 
-Theorem double_round_mult :
+Theorem round_round_mult :
   forall (fexp1 fexp2 : Z -> Z),
-  double_round_mult_hyp fexp1 fexp2 ->
+  round_round_mult_hyp fexp1 fexp2 ->
   forall x y,
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   round beta fexp1 rnd (round beta fexp2 rnd (x * y))
@@ -654,21 +668,19 @@ Proof.
 intros fexp1 fexp2 Hfexp x y Fx Fy.
 assert (Hxy : round beta fexp2 rnd (x * y) = x * y).
 { apply round_generic; [assumption|].
-  now apply (double_round_mult_aux fexp1 fexp2). }
+  now apply (round_round_mult_aux fexp1 fexp2). }
 now rewrite Hxy at 1.
 Qed.
 
 Section Double_round_mult_FLX.
 
-Import Fcore_FLX.
-
 Variable prec : Z.
 Variable prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Theorem double_round_mult_FLX :
+Theorem round_round_mult_FLX :
   (2 * prec <= prec')%Z ->
   forall x y,
   FLX_format beta prec x -> FLX_format beta prec y ->
@@ -676,9 +688,9 @@ Theorem double_round_mult_FLX :
   = round beta (FLX_exp prec) rnd (x * y).
 Proof.
 intros Hprec x y Fx Fy.
-apply double_round_mult;
+apply round_round_mult;
   [|now apply generic_format_FLX|now apply generic_format_FLX].
-unfold double_round_mult_hyp; split; intros ex ey; unfold FLX_exp;
+unfold round_round_mult_hyp; split; intros ex ey; unfold FLX_exp;
 omega.
 Qed.
 
@@ -686,16 +698,13 @@ End Double_round_mult_FLX.
 
 Section Double_round_mult_FLT.
 
-Import Fcore_FLX.
-Import Fcore_FLT.
-
 Variable emin prec : Z.
 Variable emin' prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Theorem double_round_mult_FLT :
+Theorem round_round_mult_FLT :
   (emin' <= 2 * emin)%Z -> (2 * prec <= prec')%Z ->
   forall x y,
   FLT_format beta emin prec x -> FLT_format beta emin prec y ->
@@ -704,9 +713,9 @@ Theorem double_round_mult_FLT :
   = round beta (FLT_exp emin prec) rnd (x * y).
 Proof.
 intros Hemin Hprec x y Fx Fy.
-apply double_round_mult;
+apply round_round_mult;
   [|now apply generic_format_FLT|now apply generic_format_FLT].
-unfold double_round_mult_hyp; split; intros ex ey;
+unfold round_round_mult_hyp; split; intros ex ey;
 unfold FLT_exp;
 generalize (Zmax_spec (ex + ey - prec') emin');
 generalize (Zmax_spec (ex + ey - 1 - prec') emin');
@@ -719,16 +728,13 @@ End Double_round_mult_FLT.
 
 Section Double_round_mult_FTZ.
 
-Import Fcore_FLX.
-Import Fcore_FTZ.
-
 Variable emin prec : Z.
 Variable emin' prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Theorem double_round_mult_FTZ :
+Theorem round_round_mult_FTZ :
   (emin' + prec' <= 2 * emin + prec)%Z ->
   (2 * prec <= prec')%Z ->
   forall x y,
@@ -738,9 +744,9 @@ Theorem double_round_mult_FTZ :
   = round beta (FTZ_exp emin prec) rnd (x * y).
 Proof.
 intros Hemin Hprec x y Fx Fy.
-apply double_round_mult;
+apply round_round_mult;
   [|now apply generic_format_FTZ|now apply generic_format_FTZ].
-unfold double_round_mult_hyp; split; intros ex ey;
+unfold round_round_mult_hyp; split; intros ex ey;
 unfold FTZ_exp;
 unfold Prec_gt_0 in *;
 destruct (Z.ltb_spec (ex + ey - prec') emin');
@@ -756,83 +762,77 @@ End Double_round_mult.
 
 Section Double_round_plus.
 
-Lemma ln_beta_plus_disj :
+Lemma mag_plus_disj :
   forall x y,
   0 < y -> y <= x ->
-  ((ln_beta (x + y) = ln_beta x :> Z)
-   \/ (ln_beta (x + y) = (ln_beta x + 1)%Z :> Z)).
+  ((mag (x + y) = mag x :> Z)
+   \/ (mag (x + y) = (mag x + 1)%Z :> Z)).
 Proof.
 intros x y Py Hxy.
-destruct (ln_beta_plus beta x y Py Hxy).
+destruct (mag_plus beta x y Py Hxy).
 omega.
 Qed.
 
-Lemma ln_beta_plus_separated :
+Lemma mag_plus_separated :
   forall fexp : Z -> Z,
   forall x y,
   0 < x -> 0 <= y ->
   generic_format beta fexp x ->
-  (ln_beta y <= fexp (ln_beta x))%Z ->
-  (ln_beta (x + y) = ln_beta x :> Z).
+  (mag y <= fexp (mag x))%Z ->
+  (mag (x + y) = mag x :> Z).
 Proof.
 intros fexp x y Px Nny Fx Hsep.
-destruct (Req_dec y 0) as [Zy|Nzy].
-- (* y = 0 *)
-  now rewrite Zy; rewrite Rplus_0_r.
-- (* y <> 0 *)
-  apply (ln_beta_plus_eps beta fexp); [assumption|assumption|].
-  split; [assumption|].
-  rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq].
-  unfold canonic_exp.
-  destruct (ln_beta y) as (ey, Hey); simpl in *.
-  apply Rlt_le_trans with (bpow ey).
-  + now rewrite <- (Rabs_right y); [apply Hey|apply Rle_ge].
-  + now apply bpow_le.
+apply mag_plus_eps with (1 := Px) (2 := Fx).
+apply (conj Nny).
+rewrite <- Rabs_pos_eq with (1 := Nny).
+apply Rlt_le_trans with (1 := bpow_mag_gt beta _).
+rewrite ulp_neq_0 by now apply Rgt_not_eq.
+now apply bpow_le.
 Qed.
 
-Lemma ln_beta_minus_disj :
+Lemma mag_minus_disj :
   forall x y,
   0 < x -> 0 < y ->
-  (ln_beta y <= ln_beta x - 2)%Z ->
-  ((ln_beta (x - y) = ln_beta x :> Z)
-   \/ (ln_beta (x - y) = (ln_beta x - 1)%Z :> Z)).
+  (mag y <= mag x - 2)%Z ->
+  ((mag (x - y) = mag x :> Z)
+   \/ (mag (x - y) = (mag x - 1)%Z :> Z)).
 Proof.
 intros x y Px Py Hln.
-assert (Hxy : y < x); [now apply (ln_beta_lt_pos beta); [ |omega]|].
-generalize (ln_beta_minus beta x y Py Hxy); intro Hln2.
-generalize (ln_beta_minus_lb beta x y Px Py Hln); intro Hln3.
+assert (Hxy : y < x); [now apply (lt_mag beta); [ |omega]|].
+generalize (mag_minus beta x y Py Hxy); intro Hln2.
+generalize (mag_minus_lb beta x y Px Py Hln); intro Hln3.
 omega.
 Qed.
 
-Lemma ln_beta_minus_separated :
+Lemma mag_minus_separated :
   forall fexp : Z -> Z, Valid_exp fexp ->
   forall x y,
   0 < x -> 0 < y -> y < x ->
-  bpow (ln_beta x - 1) < x ->
-  generic_format beta fexp x -> (ln_beta y <= fexp (ln_beta x))%Z ->
-  (ln_beta (x - y) = ln_beta x :> Z).
+  bpow (mag x - 1) < x ->
+  generic_format beta fexp x -> (mag y <= fexp (mag x))%Z ->
+  (mag (x - y) = mag x :> Z).
 Proof.
 intros fexp Vfexp x y Px Py Yltx Xgtpow Fx Ly.
-apply ln_beta_unique.
+apply mag_unique.
 split.
 - apply Rabs_ge; right.
-  assert (Hy : y < ulp beta fexp (bpow (ln_beta x - 1))).
+  assert (Hy : y < ulp beta fexp (bpow (mag x - 1))).
   { rewrite ulp_bpow.
-    replace (_ + _)%Z with (ln_beta x : Z) by ring.
+    replace (_ + _)%Z with (mag x : Z) by ring.
     rewrite <- (Rabs_right y); [|now apply Rle_ge; apply Rlt_le].
-    apply Rlt_le_trans with (bpow (ln_beta y)).
-    - apply bpow_ln_beta_gt.
+    apply Rlt_le_trans with (bpow (mag y)).
+    - apply bpow_mag_gt.
     - now apply bpow_le. }
   apply (Rplus_le_reg_r y); ring_simplify.
-  apply Rle_trans with (bpow (ln_beta x - 1)
-                        + ulp beta fexp (bpow (ln_beta x - 1))).
+  apply Rle_trans with (bpow (mag x - 1)
+                        + ulp beta fexp (bpow (mag x - 1))).
   + now apply Rplus_le_compat_l; apply Rlt_le.
   + rewrite <- succ_eq_pos;[idtac|apply bpow_ge_0].
     apply succ_le_lt; [apply Vfexp|idtac|exact Fx|assumption].
-    apply (generic_format_bpow beta fexp (ln_beta x - 1)).
-    replace (_ + _)%Z with (ln_beta x : Z) by ring.
-    assert (fexp (ln_beta x) < ln_beta x)%Z; [|omega].
-    now apply ln_beta_generic_gt; [|now apply Rgt_not_eq|].
+    apply (generic_format_bpow beta fexp (mag x - 1)).
+    replace (_ + _)%Z with (mag x : Z) by ring.
+    assert (fexp (mag x) < mag x)%Z; [|omega].
+    now apply mag_generic_gt; [|now apply Rgt_not_eq|].
 - rewrite Rabs_right.
   + apply Rlt_trans with x.
     * rewrite <- (Rplus_0_r x) at 2.
@@ -840,22 +840,22 @@ split.
       rewrite <- Ropp_0.
       now apply Ropp_lt_contravar.
     * apply Rabs_lt_inv.
-      apply bpow_ln_beta_gt.
+      apply bpow_mag_gt.
   + lra.
 Qed.
 
-Definition double_round_plus_hyp fexp1 fexp2 :=
+Definition round_round_plus_hyp fexp1 fexp2 :=
   (forall ex ey, (fexp1 (ex + 1) - 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
   /\ (forall ex ey, (fexp1 (ex - 1) + 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
   /\ (forall ex ey, (fexp1 ex - 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
   /\ (forall ex ey, (ex - 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z).
 
-Lemma double_round_plus_aux0_aux_aux :
+Lemma round_round_plus_aux0_aux_aux :
   forall (fexp1 fexp2 : Z -> Z),
   forall x y,
-  (fexp1 (ln_beta x) <= fexp1 (ln_beta y))%Z ->
-  (fexp2 (ln_beta (x + y))%Z <= fexp1 (ln_beta x))%Z ->
-  (fexp2 (ln_beta (x + y))%Z <= fexp1 (ln_beta y))%Z ->
+  (fexp1 (mag x) <= fexp1 (mag y))%Z ->
+  (fexp2 (mag (x + y))%Z <= fexp1 (mag x))%Z ->
+  (fexp2 (mag (x + y))%Z <= fexp1 (mag y))%Z ->
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x + y).
 Proof.
@@ -863,224 +863,224 @@ intros fexp1 fexp2 x y Oxy Hlnx Hlny Fx Fy.
 destruct (Req_dec x 0) as [Zx|Nzx].
 - (* x = 0 *)
   rewrite Zx, Rplus_0_l in Hlny |- *.
-  now apply (generic_inclusion_ln_beta beta fexp1).
+  now apply (generic_inclusion_mag beta fexp1).
 - (* x <> 0 *)
   destruct (Req_dec y 0) as [Zy|Nzy].
   + (* y = 0 *)
     rewrite Zy, Rplus_0_r in Hlnx |- *.
-    now apply (generic_inclusion_ln_beta beta fexp1).
+    now apply (generic_inclusion_mag beta fexp1).
   + (* y <> 0 *)
     revert Fx Fy.
-    unfold generic_format at -3, canonic_exp, F2R; simpl.
+    unfold generic_format at -3, cexp, F2R; simpl.
     set (mx := Ztrunc (scaled_mantissa beta fexp1 x)).
     set (my := Ztrunc (scaled_mantissa beta fexp1 y)).
     intros Fx Fy.
-    set (fxy := Float beta (mx + my * (beta ^ (fexp1 (ln_beta y)
-                                               - fexp1 (ln_beta x))))
-                      (fexp1 (ln_beta x))).
+    set (fxy := Float beta (mx + my * (beta ^ (fexp1 (mag y)
+                                               - fexp1 (mag x))))
+                      (fexp1 (mag x))).
     assert (Hxy : x + y = F2R fxy).
     { unfold fxy, F2R; simpl.
-      rewrite Z2R_plus.
+      rewrite plus_IZR.
       rewrite Rmult_plus_distr_r.
       rewrite <- Fx.
-      rewrite Z2R_mult.
-      rewrite Z2R_Zpower; [|omega].
+      rewrite mult_IZR.
+      rewrite IZR_Zpower; [|omega].
       bpow_simplify.
       now rewrite <- Fy. }
     apply generic_format_F2R' with (f := fxy); [now rewrite Hxy|].
     intros _.
-    now unfold canonic_exp, fxy; simpl.
+    now unfold cexp, fxy; simpl.
 Qed.
 
-Lemma double_round_plus_aux0_aux :
+Lemma round_round_plus_aux0_aux :
   forall (fexp1 fexp2 : Z -> Z),
   forall x y,
-  (fexp2 (ln_beta (x + y))%Z <= fexp1 (ln_beta x))%Z ->
-  (fexp2 (ln_beta (x + y))%Z <= fexp1 (ln_beta y))%Z ->
+  (fexp2 (mag (x + y))%Z <= fexp1 (mag x))%Z ->
+  (fexp2 (mag (x + y))%Z <= fexp1 (mag y))%Z ->
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x + y).
 Proof.
 intros fexp1 fexp2 x y Hlnx Hlny Fx Fy.
-destruct (Z.le_gt_cases (fexp1 (ln_beta x)) (fexp1 (ln_beta y))) as [Hle|Hgt].
-- now apply (double_round_plus_aux0_aux_aux fexp1).
+destruct (Z.le_gt_cases (fexp1 (mag x)) (fexp1 (mag y))) as [Hle|Hgt].
+- now apply (round_round_plus_aux0_aux_aux fexp1).
 - rewrite Rplus_comm in Hlnx, Hlny |- *.
-  now apply (double_round_plus_aux0_aux_aux fexp1); [omega| | | |].
+  now apply (round_round_plus_aux0_aux_aux fexp1); [omega| | | |].
 Qed.
 
-(* fexp1 (ln_beta x) - 1 <= ln_beta y :
+(* fexp1 (mag x) - 1 <= mag y :
  * addition is exact in the largest precision (fexp2). *)
-Lemma double_round_plus_aux0 :
+Lemma round_round_plus_aux0 :
   forall (fexp1 fexp2 : Z -> Z), Valid_exp fexp1 ->
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   (0 < x)%R -> (0 < y)%R -> (y <= x)%R ->
-  (fexp1 (ln_beta x) - 1 <= ln_beta y)%Z ->
+  (fexp1 (mag x) - 1 <= mag y)%Z ->
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x + y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Hexp x y Px Py Hyx Hln Fx Fy.
 assert (Nny : (0 <= y)%R); [now apply Rlt_le|].
 destruct Hexp as (_,(Hexp2,(Hexp3,Hexp4))).
-destruct (Z.le_gt_cases (ln_beta y) (fexp1 (ln_beta x))) as [Hle|Hgt].
-- (* ln_beta y <= fexp1 (ln_beta x) *)
-  assert (Lxy : ln_beta (x + y) = ln_beta x :> Z);
-  [now apply (ln_beta_plus_separated fexp1)|].
-  apply (double_round_plus_aux0_aux fexp1);
+destruct (Z.le_gt_cases (mag y) (fexp1 (mag x))) as [Hle|Hgt].
+- (* mag y <= fexp1 (mag x) *)
+  assert (Lxy : mag (x + y) = mag x :> Z);
+  [now apply (mag_plus_separated fexp1)|].
+  apply (round_round_plus_aux0_aux fexp1);
     [| |assumption|assumption]; rewrite Lxy.
   + now apply Hexp4; omega.
   + now apply Hexp3; omega.
-- (* fexp1 (ln_beta x) < ln_beta y *)
-  apply (double_round_plus_aux0_aux fexp1); [| |assumption|assumption].
-  destruct (ln_beta_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
+- (* fexp1 (mag x) < mag y *)
+  apply (round_round_plus_aux0_aux fexp1); [| |assumption|assumption].
+  destruct (mag_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
   + now apply Hexp4; omega.
-  + apply Hexp2; apply (ln_beta_le beta y x Py) in Hyx.
-    replace (_ - _)%Z with (ln_beta x : Z) by ring.
+  + apply Hexp2; apply (mag_le beta y x Py) in Hyx.
+    replace (_ - _)%Z with (mag x : Z) by ring.
     omega.
-  + destruct (ln_beta_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
+  + destruct (mag_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
     * now apply Hexp3; omega.
     * apply Hexp2.
-      replace (_ - _)%Z with (ln_beta x : Z) by ring.
+      replace (_ - _)%Z with (mag x : Z) by ring.
       omega.
 Qed.
 
-Lemma double_round_plus_aux1_aux :
+Lemma round_round_plus_aux1_aux :
   forall k, (0 < k)%Z ->
   forall (fexp : Z -> Z),
   forall x y,
   0 < x -> 0 < y ->
-  (ln_beta y <= fexp (ln_beta x) - k)%Z ->
-  (ln_beta (x + y) = ln_beta x :> Z) ->
+  (mag y <= fexp (mag x) - k)%Z ->
+  (mag (x + y) = mag x :> Z) ->
   generic_format beta fexp x ->
-  0 < (x + y) - round beta fexp Zfloor (x + y) < bpow (fexp (ln_beta x) - k).
+  0 < (x + y) - round beta fexp Zfloor (x + y) < bpow (fexp (mag x) - k).
 Proof.
 assert (Hbeta : (2 <= beta)%Z).
 { destruct beta as (beta_val,beta_prop).
   now apply Zle_bool_imp_le. }
 intros k Hk fexp x y Px Py Hln Hlxy Fx.
 revert Fx.
-unfold round, generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
+unfold round, generic_format, F2R, scaled_mantissa, cexp; simpl.
 rewrite Hlxy.
-set (mx := Ztrunc (x * bpow (- fexp (ln_beta x)))).
+set (mx := Ztrunc (x * bpow (- fexp (mag x)))).
 intros Fx.
-assert (R : (x + y) * bpow (- fexp (ln_beta x))
-            = Z2R mx + y * bpow (- fexp (ln_beta x))).
+assert (R : (x + y) * bpow (- fexp (mag x))
+            = IZR mx + y * bpow (- fexp (mag x))).
 { rewrite Fx at 1.
   rewrite Rmult_plus_distr_r.
   now bpow_simplify. }
 rewrite R.
-assert (LB : 0 < y * bpow (- fexp (ln_beta x))).
+assert (LB : 0 < y * bpow (- fexp (mag x))).
 { rewrite <- (Rmult_0_r y).
   now apply Rmult_lt_compat_l; [|apply bpow_gt_0]. }
-assert (UB : y * bpow (- fexp (ln_beta x)) < / Z2R (beta ^ k)).
-{ apply Rlt_le_trans with (bpow (ln_beta y) * bpow (- fexp (ln_beta x))).
+assert (UB : y * bpow (- fexp (mag x)) < / IZR (beta ^ k)).
+{ apply Rlt_le_trans with (bpow (mag y) * bpow (- fexp (mag x))).
   - apply Rmult_lt_compat_r; [now apply bpow_gt_0|].
     rewrite <- (Rabs_right y) at 1; [|now apply Rle_ge; apply Rlt_le].
-    apply bpow_ln_beta_gt.
-  - apply Rle_trans with (bpow (fexp (ln_beta x) - k)
-                          * bpow (- fexp (ln_beta x)))%R.
+    apply bpow_mag_gt.
+  - apply Rle_trans with (bpow (fexp (mag x) - k)
+                          * bpow (- fexp (mag x)))%R.
     + apply Rmult_le_compat_r; [now apply bpow_ge_0|].
       now apply bpow_le.
     + bpow_simplify.
       rewrite bpow_opp.
       destruct k.
       * omega.
-      * simpl; unfold Fcore_Raux.bpow, Z.pow_pos.
+      * simpl; unfold Raux.bpow, Z.pow_pos.
         now apply Rle_refl.
-      * casetype False; apply (Zlt_irrefl 0).
-        apply (Zlt_trans _ _ _ Hk).
+      * casetype False; apply (Z.lt_irrefl 0).
+        apply (Z.lt_trans _ _ _ Hk).
         apply Zlt_neg_0. }
 rewrite (Zfloor_imp mx).
 { split; ring_simplify.
-  - apply (Rmult_lt_reg_r (bpow (- fexp (ln_beta x)))); [now apply bpow_gt_0|].
+  - apply (Rmult_lt_reg_r (bpow (- fexp (mag x)))); [now apply bpow_gt_0|].
     rewrite Rmult_minus_distr_r, Rmult_0_l.
     bpow_simplify.
     rewrite R; ring_simplify.
     now apply Rmult_lt_0_compat; [|apply bpow_gt_0].
-  - apply (Rmult_lt_reg_r (bpow (- fexp (ln_beta x)))); [now apply bpow_gt_0|].
+  - apply (Rmult_lt_reg_r (bpow (- fexp (mag x)))); [now apply bpow_gt_0|].
     rewrite Rmult_minus_distr_r.
     bpow_simplify.
     rewrite R; ring_simplify.
     apply (Rlt_le_trans _ _ _ UB).
     rewrite bpow_opp.
     apply Rinv_le; [now apply bpow_gt_0|].
-    now rewrite Z2R_Zpower; [right|omega]. }
+    now rewrite IZR_Zpower; [right|omega]. }
 split.
 - rewrite <- Rplus_0_r at 1; apply Rplus_le_compat_l.
   now apply Rlt_le.
-- rewrite Z2R_plus; apply Rplus_lt_compat_l.
-  apply (Rmult_lt_reg_r (bpow (fexp (ln_beta x)))); [now apply bpow_gt_0|].
+- rewrite plus_IZR; apply Rplus_lt_compat_l.
+  apply (Rmult_lt_reg_r (bpow (fexp (mag x)))); [now apply bpow_gt_0|].
   rewrite Rmult_1_l.
   bpow_simplify.
-  apply Rlt_trans with (bpow (ln_beta y)).
+  apply Rlt_trans with (bpow (mag y)).
   + rewrite <- Rabs_right at 1; [|now apply Rle_ge; apply Rlt_le].
-    apply bpow_ln_beta_gt.
+    apply bpow_mag_gt.
   + apply bpow_lt; omega.
 Qed.
 
-(* ln_beta y <= fexp1 (ln_beta x) - 2 : double_round_lt_mid applies. *)
-Lemma double_round_plus_aux1 :
+(* mag y <= fexp1 (mag x) - 2 : round_round_lt_mid applies. *)
+Lemma round_round_plus_aux1 :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   0 < x -> 0 < y ->
-  (ln_beta y <= fexp1 (ln_beta x) - 2)%Z ->
+  (mag y <= fexp1 (mag x) - 2)%Z ->
   generic_format beta fexp1 x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x + y).
 Proof.
 assert (Hbeta : (2 <= beta)%Z).
 { destruct beta as (beta_val,beta_prop).
   now apply Zle_bool_imp_le. }
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Hly Fx.
-assert (Lxy : ln_beta (x + y) = ln_beta x :> Z);
-  [now apply (ln_beta_plus_separated fexp1); [|apply Rlt_le| |omega]|].
+assert (Lxy : mag (x + y) = mag x :> Z);
+  [now apply (mag_plus_separated fexp1); [|apply Rlt_le| |omega]|].
 destruct Hexp as (_,(_,(_,Hexp4))).
-assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
+assert (Hf2 : (fexp2 (mag x) <= fexp1 (mag x))%Z);
   [now apply Hexp4; omega|].
 assert (Bpow2 : bpow (- 2) <= / 2 * / 2).
 { replace (/2 * /2) with (/4) by field.
   rewrite (bpow_opp _ 2).
   apply Rinv_le; [lra|].
-  apply (Z2R_le (2 * 2) (beta * (beta * 1))).
+  apply (IZR_le (2 * 2) (beta * (beta * 1))).
   rewrite Zmult_1_r.
   now apply Zmult_le_compat; omega. }
 assert (P2 : (0 < 2)%Z) by omega.
-unfold double_round_eq.
-apply double_round_lt_mid.
+unfold round_round_eq.
+apply round_round_lt_mid.
 - exact Vfexp1.
 - exact Vfexp2.
 - lra.
 - now rewrite Lxy.
 - rewrite Lxy.
-  assert (fexp1 (ln_beta x) < ln_beta x)%Z; [|omega].
-  now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
+  assert (fexp1 (mag x) < mag x)%Z; [|omega].
+  now apply mag_generic_gt; [|apply Rgt_not_eq|].
 - unfold midp.
   apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))).
-  apply (Rlt_le_trans _ _ _ (proj2 (double_round_plus_aux1_aux 2 P2 fexp1 x y Px
+  apply (Rlt_le_trans _ _ _ (proj2 (round_round_plus_aux1_aux 2 P2 fexp1 x y Px
                                                                Py Hly Lxy Fx))).
   ring_simplify.
   rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
-  unfold canonic_exp; rewrite Lxy.
-  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+  unfold cexp; rewrite Lxy.
+  apply (Rmult_le_reg_r (bpow (- fexp1 (mag x)))); [now apply bpow_gt_0|].
   bpow_simplify.
   apply (Rle_trans _ _ _ Bpow2).
   rewrite <- (Rmult_1_r (/ 2)) at 3.
   apply Rmult_le_compat_l; lra.
 - rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
-  unfold round, F2R, scaled_mantissa, canonic_exp; simpl; rewrite Lxy.
+  unfold round, F2R, scaled_mantissa, cexp; simpl; rewrite Lxy.
   intro Hf2'.
-  apply (Rmult_lt_reg_r (bpow (- fexp1 (ln_beta x))));
+  apply (Rmult_lt_reg_r (bpow (- fexp1 (mag x))));
     [now apply bpow_gt_0|].
-  apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+  apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
   bpow_simplify.
   apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))).
   unfold midp; ring_simplify.
-  apply (Rlt_le_trans _ _ _ (proj2 (double_round_plus_aux1_aux 2 P2 fexp1 x y Px
+  apply (Rlt_le_trans _ _ _ (proj2 (round_round_plus_aux1_aux 2 P2 fexp1 x y Px
                                                                Py Hly Lxy Fx))).
-  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+  apply (Rmult_le_reg_r (bpow (- fexp1 (mag x)))); [now apply bpow_gt_0|].
   rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
-  unfold canonic_exp; rewrite Lxy, Rmult_minus_distr_r; bpow_simplify.
+  unfold cexp; rewrite Lxy, Rmult_minus_distr_r; bpow_simplify.
   apply (Rle_trans _ _ _ Bpow2).
   rewrite <- (Rmult_1_r (/ 2)) at 3; rewrite <- Rmult_minus_distr_l.
   apply Rmult_le_compat_l; [lra|].
@@ -1089,49 +1089,49 @@ apply double_round_lt_mid.
   apply Ropp_le_contravar.
   { apply Rle_trans with (bpow (- 1)).
     - apply bpow_le; omega.
-    - unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+    - unfold Raux.bpow, Z.pow_pos; simpl.
       apply Rinv_le; [lra|].
-      change 2 with (Z2R 2); apply Z2R_le; omega. }
+      apply IZR_le; omega. }
 Qed.
 
-(* double_round_plus_aux{0,1} together *)
-Lemma double_round_plus_aux2 :
+(* round_round_plus_aux{0,1} together *)
+Lemma round_round_plus_aux2 :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   0 < x -> 0 < y -> y <= x ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x + y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Hyx Fx Fy.
-unfold double_round_eq.
-destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta x) - 2)) as [Hly|Hly].
-- (* ln_beta y <= fexp1 (ln_beta x) - 2 *)
-  now apply double_round_plus_aux1.
-- (* fexp1 (ln_beta x) - 2 < ln_beta y *)
+unfold round_round_eq.
+destruct (Zle_or_lt (mag y) (fexp1 (mag x) - 2)) as [Hly|Hly].
+- (* mag y <= fexp1 (mag x) - 2 *)
+  now apply round_round_plus_aux1.
+- (* fexp1 (mag x) - 2 < mag y *)
   rewrite (round_generic beta fexp2).
   + reflexivity.
   + now apply valid_rnd_N.
-  + assert (Hf1 : (fexp1 (ln_beta x) - 1 <= ln_beta y)%Z); [omega|].
-    now apply (double_round_plus_aux0 fexp1).
+  + assert (Hf1 : (fexp1 (mag x) - 1 <= mag y)%Z); [omega|].
+    now apply (round_round_plus_aux0 fexp1).
 Qed.
 
-Lemma double_round_plus_aux :
+Lemma round_round_plus_aux :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   0 <= x -> 0 <= y ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x + y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Nnx Nny Fx Fy.
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Req_dec x 0) as [Zx|Nzx].
 - (* x = 0 *)
   destruct Hexp as (_,(_,(_,Hexp4))).
@@ -1139,7 +1139,7 @@ destruct (Req_dec x 0) as [Zx|Nzx].
   rewrite (round_generic beta fexp2).
   + reflexivity.
   + now apply valid_rnd_N.
-  + apply (generic_inclusion_ln_beta beta fexp1).
+  + apply (generic_inclusion_mag beta fexp1).
     now intros _; apply Hexp4; omega.
     exact Fy.
 - (* x <> 0 *)
@@ -1150,7 +1150,7 @@ destruct (Req_dec x 0) as [Zx|Nzx].
     rewrite (round_generic beta fexp2).
     * reflexivity.
     * now apply valid_rnd_N.
-    * apply (generic_inclusion_ln_beta beta fexp1).
+    * apply (generic_inclusion_mag beta fexp1).
       now intros _; apply Hexp4; omega.
       exact Fx.
   + (* y <> 0 *)
@@ -1160,118 +1160,118 @@ destruct (Req_dec x 0) as [Zx|Nzx].
     * (* x < y *)
       apply Rlt_le in H.
       rewrite Rplus_comm.
-      now apply double_round_plus_aux2.
-    * now apply double_round_plus_aux2.
+      now apply round_round_plus_aux2.
+    * now apply round_round_plus_aux2.
 Qed.
 
-Lemma double_round_minus_aux0_aux :
+Lemma round_round_minus_aux0_aux :
   forall (fexp1 fexp2 : Z -> Z),
   forall x y,
-  (fexp2 (ln_beta (x - y))%Z <= fexp1 (ln_beta x))%Z ->
-  (fexp2 (ln_beta (x - y))%Z <= fexp1 (ln_beta y))%Z ->
+  (fexp2 (mag (x - y))%Z <= fexp1 (mag x))%Z ->
+  (fexp2 (mag (x - y))%Z <= fexp1 (mag y))%Z ->
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x - y).
 Proof.
 intros fexp1 fexp2 x y.
 replace (x - y)%R with (x + (- y))%R; [|ring].
 intros Hlnx Hlny Fx Fy.
-rewrite <- (ln_beta_opp beta y) in Hlny.
+rewrite <- (mag_opp beta y) in Hlny.
 apply generic_format_opp in Fy.
-now apply (double_round_plus_aux0_aux fexp1).
+now apply (round_round_plus_aux0_aux fexp1).
 Qed.
 
-(* fexp1 (ln_beta x) - 1 <= ln_beta y :
+(* fexp1 (mag x) - 1 <= mag y :
  * substraction is exact in the largest precision (fexp2). *)
-Lemma double_round_minus_aux0 :
+Lemma round_round_minus_aux0 :
   forall (fexp1 fexp2 : Z -> Z),
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   0 < y -> y < x ->
-  (fexp1 (ln_beta x) - 1 <= ln_beta y)%Z ->
+  (fexp1 (mag x) - 1 <= mag y)%Z ->
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x - y).
 Proof.
 intros fexp1 fexp2 Hexp x y Py Hyx Hln Fx Fy.
 assert (Px := Rlt_trans 0 y x Py Hyx).
 destruct Hexp as (Hexp1,(_,(Hexp3,Hexp4))).
-assert (Lyx : (ln_beta y <= ln_beta x)%Z);
-  [now apply ln_beta_le; [|apply Rlt_le]|].
-destruct (Z.lt_ge_cases (ln_beta x - 2) (ln_beta y)) as [Hlt|Hge].
-- (* ln_beta x - 2 < ln_beta y *)
-  assert (Hor : (ln_beta y = ln_beta x :> Z)
-                \/ (ln_beta y = ln_beta x - 1 :> Z)%Z); [omega|].
+assert (Lyx : (mag y <= mag x)%Z);
+  [now apply mag_le; [|apply Rlt_le]|].
+destruct (Z.lt_ge_cases (mag x - 2) (mag y)) as [Hlt|Hge].
+- (* mag x - 2 < mag y *)
+  assert (Hor : (mag y = mag x :> Z)
+                \/ (mag y = mag x - 1 :> Z)%Z); [omega|].
   destruct Hor as [Heq|Heqm1].
-  + (* ln_beta y = ln_beta x *)
-    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
+  + (* mag y = mag x *)
+    apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
     * apply Hexp4.
-      apply Zle_trans with (ln_beta (x - y)); [omega|].
-      now apply ln_beta_minus.
+      apply Z.le_trans with (mag (x - y)); [omega|].
+      now apply mag_minus.
     * rewrite Heq.
       apply Hexp4.
-      apply Zle_trans with (ln_beta (x - y)); [omega|].
-      now apply ln_beta_minus.
-  + (* ln_beta y = ln_beta x - 1 *)
-    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
+      apply Z.le_trans with (mag (x - y)); [omega|].
+      now apply mag_minus.
+  + (* mag y = mag x - 1 *)
+    apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
     * apply Hexp4.
-      apply Zle_trans with (ln_beta (x - y)); [omega|].
-      now apply ln_beta_minus.
+      apply Z.le_trans with (mag (x - y)); [omega|].
+      now apply mag_minus.
     * rewrite Heqm1.
       apply Hexp4.
       apply Zplus_le_compat_r.
-      now apply ln_beta_minus.
-- (* ln_beta y <= ln_beta x - 2 *)
-  destruct (ln_beta_minus_disj x y Px Py Hge) as [Lxmy|Lxmy].
-  + (* ln_beta (x - y) = ln_beta x *)
-    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
+      now apply mag_minus.
+- (* mag y <= mag x - 2 *)
+  destruct (mag_minus_disj x y Px Py Hge) as [Lxmy|Lxmy].
+  + (* mag (x - y) = mag x *)
+    apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
     * apply Hexp4.
       omega.
     * now rewrite Lxmy; apply Hexp3.
-  + (* ln_beta (x - y) = ln_beta x - 1 *)
-    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy];
+  + (* mag (x - y) = mag x - 1 *)
+    apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy];
     rewrite Lxmy.
     * apply Hexp1.
-      replace (_ + _)%Z with (ln_beta x : Z); [|ring].
-      now apply Zle_trans with (ln_beta y).
+      replace (_ + _)%Z with (mag x : Z); [|ring].
+      now apply Z.le_trans with (mag y).
     * apply Hexp1.
-      now replace (_ + _)%Z with (ln_beta x : Z); [|ring].
+      now replace (_ + _)%Z with (mag x : Z); [|ring].
 Qed.
 
-(* ln_beta y <= fexp1 (ln_beta x) - 2,
- * fexp1 (ln_beta (x - y)) - 1 <= ln_beta y :
+(* mag y <= fexp1 (mag x) - 2,
+ * fexp1 (mag (x - y)) - 1 <= mag y :
  * substraction is exact in the largest precision (fexp2). *)
-Lemma double_round_minus_aux1 :
+Lemma round_round_minus_aux1 :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   0 < y -> y < x ->
-  (ln_beta y <= fexp1 (ln_beta x) - 2)%Z ->
-  (fexp1 (ln_beta (x - y)) - 1 <= ln_beta y)%Z ->
+  (mag y <= fexp1 (mag x) - 2)%Z ->
+  (fexp1 (mag (x - y)) - 1 <= mag y)%Z ->
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x - y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2  Hexp x y Py Hyx Hln Hln' Fx Fy.
 assert (Px := Rlt_trans 0 y x Py Hyx).
 destruct Hexp as (Hexp1,(Hexp2,(Hexp3,Hexp4))).
-assert (Lyx : (ln_beta y <= ln_beta x)%Z);
-  [now apply ln_beta_le; [|apply Rlt_le]|].
-assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
-- apply Zle_trans with (fexp1 (ln_beta (x - y))).
+assert (Lyx : (mag y <= mag x)%Z);
+  [now apply mag_le; [|apply Rlt_le]|].
+assert (Hfx : (fexp1 (mag x) < mag x)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfy : (fexp1 (mag y) < mag y)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
+- apply Z.le_trans with (fexp1 (mag (x - y))).
   + apply Hexp4; omega.
   + omega.
 - now apply Hexp3.
 Qed.
 
-Lemma double_round_minus_aux2_aux :
+Lemma round_round_minus_aux2_aux :
   forall (fexp : Z -> Z),
   Valid_exp fexp ->
   forall x y,
   0 < y -> y < x ->
-  (ln_beta y <= fexp (ln_beta x) - 1)%Z ->
+  (mag y <= fexp (mag x) - 1)%Z ->
   generic_format beta fexp x ->
   generic_format beta fexp y ->
   round beta fexp Zceil (x - y) - (x - y) <= y.
@@ -1279,19 +1279,19 @@ Proof.
 intros fexp Vfexp x y Py Hxy Hly Fx Fy.
 assert (Px := Rlt_trans 0 y x Py Hxy).
 revert Fx.
-unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
-set (mx := Ztrunc (x * bpow (- fexp (ln_beta x)))).
+unfold generic_format, F2R, scaled_mantissa, cexp; simpl.
+set (mx := Ztrunc (x * bpow (- fexp (mag x)))).
 intro Fx.
-assert (Hfx : (fexp (ln_beta x) < ln_beta x)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-assert (Hfy : (fexp (ln_beta y) < ln_beta y)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-destruct (Rlt_or_le (bpow (ln_beta x - 1)) x) as [Hx|Hx].
-- (* bpow (ln_beta x - 1) < x *)
-  assert (Lxy : ln_beta (x - y) = ln_beta x :> Z);
-    [now apply (ln_beta_minus_separated fexp); [| | | | | |omega]|].
+assert (Hfx : (fexp (mag x) < mag x)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfy : (fexp (mag y) < mag y)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+destruct (Rlt_or_le (bpow (mag x - 1)) x) as [Hx|Hx].
+- (* bpow (mag x - 1) < x *)
+  assert (Lxy : mag (x - y) = mag x :> Z);
+    [now apply (mag_minus_separated fexp); [| | | | | |omega]|].
   assert (Rxy : round beta fexp Zceil (x - y) = x).
-  { unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
+  { unfold round, F2R, scaled_mantissa, cexp; simpl.
     rewrite Lxy.
     apply eq_sym; rewrite Fx at 1; apply eq_sym.
     apply Rmult_eq_compat_r.
@@ -1301,18 +1301,18 @@ destruct (Rlt_or_le (bpow (ln_beta x - 1)) x) as [Hx|Hx].
     bpow_simplify.
     apply Zceil_imp.
     split.
-    - unfold Zminus; rewrite Z2R_plus.
+    - unfold Zminus; rewrite plus_IZR.
       apply Rplus_lt_compat_l.
       apply Ropp_lt_contravar; simpl.
-      apply (Rmult_lt_reg_r (bpow (fexp (ln_beta x))));
+      apply (Rmult_lt_reg_r (bpow (fexp (mag x))));
         [now apply bpow_gt_0|].
       rewrite Rmult_1_l; bpow_simplify.
-      apply Rlt_le_trans with (bpow (ln_beta y)).
+      apply Rlt_le_trans with (bpow (mag y)).
       + rewrite <- Rabs_right at 1; [|now apply Rle_ge; apply Rlt_le].
-        apply bpow_ln_beta_gt.
+        apply bpow_mag_gt.
       + apply bpow_le.
         omega.
-    - rewrite <- (Rplus_0_r (Z2R _)) at 2.
+    - rewrite <- (Rplus_0_r (IZR _)) at 2.
       apply Rplus_le_compat_l.
       rewrite <- Ropp_0; apply Ropp_le_contravar.
       rewrite <- (Rmult_0_r y).
@@ -1320,34 +1320,34 @@ destruct (Rlt_or_le (bpow (ln_beta x - 1)) x) as [Hx|Hx].
       now apply bpow_ge_0. }
   rewrite Rxy; ring_simplify.
   apply Rle_refl.
-- (* x <= bpow (ln_beta x - 1) *)
-  assert (Xpow : x = bpow (ln_beta x - 1)).
+- (* x <= bpow (mag x - 1) *)
+  assert (Xpow : x = bpow (mag x - 1)).
   { apply Rle_antisym; [exact Hx|].
-    destruct (ln_beta x) as (ex, Hex); simpl.
+    destruct (mag x) as (ex, Hex); simpl.
     rewrite <- (Rabs_right x); [|now apply Rle_ge; apply Rlt_le].
     apply Hex.
     now apply Rgt_not_eq. }
-  assert (Lxy : (ln_beta (x - y) = ln_beta x - 1 :> Z)%Z).
+  assert (Lxy : (mag (x - y) = mag x - 1 :> Z)%Z).
   { apply Zle_antisym.
-    - apply ln_beta_le_bpow.
+    - apply mag_le_bpow.
       + apply Rminus_eq_contra.
         now intro Hx'; rewrite Hx' in Hxy; apply (Rlt_irrefl y).
       + rewrite Rabs_right; lra.
-    - apply (ln_beta_minus_lb beta x y Px Py).
+    - apply (mag_minus_lb beta x y Px Py).
       omega. }
-  assert (Hfx1 : (fexp (ln_beta x - 1) < ln_beta x - 1)%Z);
-    [now apply (valid_exp_large fexp (ln_beta y)); [|omega]|].
+  assert (Hfx1 : (fexp (mag x - 1) < mag x - 1)%Z);
+    [now apply (valid_exp_large fexp (mag y)); [|omega]|].
   assert (Rxy : round beta fexp Zceil (x - y) <= x).
   { rewrite Xpow at 2.
-    unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
+    unfold round, F2R, scaled_mantissa, cexp; simpl.
     rewrite Lxy.
-    apply (Rmult_le_reg_r (bpow (- fexp (ln_beta x - 1)%Z)));
+    apply (Rmult_le_reg_r (bpow (- fexp (mag x - 1)%Z)));
       [now apply bpow_gt_0|].
     bpow_simplify.
-    rewrite <- (Z2R_Zpower beta (_ - _ - _)); [|omega].
-    apply Z2R_le.
+    rewrite <- (IZR_Zpower beta (_ - _ - _)); [|omega].
+    apply IZR_le.
     apply Zceil_glb.
-    rewrite Z2R_Zpower; [|omega].
+    rewrite IZR_Zpower; [|omega].
     rewrite Xpow at 1.
     rewrite Rmult_minus_distr_r.
     bpow_simplify.
@@ -1360,21 +1360,21 @@ destruct (Rlt_or_le (bpow (ln_beta x - 1)) x) as [Hx|Hx].
   lra.
 Qed.
 
-(* ln_beta y <= fexp1 (ln_beta x) - 2 :
- * ln_beta y <= fexp1 (ln_beta (x - y)) - 2 :
- * double_round_gt_mid applies. *)
-Lemma double_round_minus_aux2 :
+(* mag y <= fexp1 (mag x) - 2 :
+ * mag y <= fexp1 (mag (x - y)) - 2 :
+ * round_round_gt_mid applies. *)
+Lemma round_round_minus_aux2 :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   0 < y -> y < x ->
-  (ln_beta y <= fexp1 (ln_beta x) - 2)%Z ->
-  (ln_beta y <= fexp1 (ln_beta (x - y)) - 2)%Z ->
+  (mag y <= fexp1 (mag x) - 2)%Z ->
+  (mag y <= fexp1 (mag (x - y)) - 2)%Z ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x - y).
 Proof.
 assert (Hbeta : (2 <= beta)%Z).
 { destruct beta as (beta_val,beta_prop).
@@ -1382,52 +1382,52 @@ assert (Hbeta : (2 <= beta)%Z).
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hxy Hly Hly' Fx Fy.
 assert (Px := Rlt_trans 0 y x Py Hxy).
 destruct Hexp as (_,(_,(_,Hexp4))).
-assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
+assert (Hf2 : (fexp2 (mag x) <= fexp1 (mag x))%Z);
   [now apply Hexp4; omega|].
-assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfx : (fexp1 (mag x) < mag x)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
 assert (Bpow2 : bpow (- 2) <= / 2 * / 2).
 { replace (/2 * /2) with (/4) by field.
   rewrite (bpow_opp _ 2).
   apply Rinv_le; [lra|].
-  apply (Z2R_le (2 * 2) (beta * (beta * 1))).
+  apply (IZR_le (2 * 2) (beta * (beta * 1))).
   rewrite Zmult_1_r.
   now apply Zmult_le_compat; omega. }
-assert (Ly : y < bpow (ln_beta y)).
+assert (Ly : y < bpow (mag y)).
 { apply Rabs_lt_inv.
-  apply bpow_ln_beta_gt. }
-unfold double_round_eq.
-apply double_round_gt_mid.
+  apply bpow_mag_gt. }
+unfold round_round_eq.
+apply round_round_gt_mid.
 - exact Vfexp1.
 - exact Vfexp2.
 - lra.
 - apply Hexp4; omega.
-- assert (fexp1 (ln_beta (x - y)) < ln_beta (x - y))%Z; [|omega].
-  apply (valid_exp_large fexp1 (ln_beta x - 1)).
-  + apply (valid_exp_large fexp1 (ln_beta y)); [|omega].
-    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
-  + now apply ln_beta_minus_lb; [| |omega].
+- assert (fexp1 (mag (x - y)) < mag (x - y))%Z; [|omega].
+  apply (valid_exp_large fexp1 (mag x - 1)).
+  + apply (valid_exp_large fexp1 (mag y)); [|omega].
+    now apply mag_generic_gt; [|apply Rgt_not_eq|].
+  + now apply mag_minus_lb; [| |omega].
 - unfold midp'.
   apply (Rplus_lt_reg_r (/ 2 * ulp beta fexp1 (x - y) - (x - y))).
   ring_simplify.
   replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring.
-  apply Rlt_le_trans with (bpow (fexp1 (ln_beta (x - y)) - 2)).
+  apply Rlt_le_trans with (bpow (fexp1 (mag (x - y)) - 2)).
   + apply Rle_lt_trans with y;
-    [now apply double_round_minus_aux2_aux; try assumption; omega|].
+    [now apply round_round_minus_aux2_aux; try assumption; omega|].
     apply (Rlt_le_trans _ _ _ Ly).
     now apply bpow_le.
   + rewrite ulp_neq_0;[idtac|now apply sym_not_eq, Rlt_not_eq, Rgt_minus].
-    unfold canonic_exp.
-    replace (_ - 2)%Z with (fexp1 (ln_beta (x - y)) - 1 - 1)%Z by ring.
+    unfold cexp.
+    replace (_ - 2)%Z with (fexp1 (mag (x - y)) - 1 - 1)%Z by ring.
     unfold Zminus at 1; rewrite bpow_plus.
     rewrite Rmult_comm.
     apply Rmult_le_compat.
     * now apply bpow_ge_0.
     * now apply bpow_ge_0.
-    * unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+    * unfold Raux.bpow, Z.pow_pos; simpl.
       rewrite Zmult_1_r; apply Rinv_le.
       lra.
-      now change 2 with (Z2R 2); apply Z2R_le.
+      now apply IZR_le.
     * apply bpow_le; omega.
 - intro Hf2'.
   unfold midp'.
@@ -1436,53 +1436,53 @@ apply double_round_gt_mid.
   ring_simplify.
   replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring.
   apply Rle_lt_trans with y;
-    [now apply double_round_minus_aux2_aux; try assumption; omega|].
+    [now apply round_round_minus_aux2_aux; try assumption; omega|].
   apply (Rlt_le_trans _ _ _ Ly).
-  apply Rle_trans with (bpow (fexp1 (ln_beta (x - y)) - 2));
+  apply Rle_trans with (bpow (fexp1 (mag (x - y)) - 2));
     [now apply bpow_le|].
-  replace (_ - 2)%Z with (fexp1 (ln_beta (x - y)) - 1 - 1)%Z by ring.
+  replace (_ - 2)%Z with (fexp1 (mag (x - y)) - 1 - 1)%Z by ring.
   unfold Zminus at 1; rewrite bpow_plus.
   rewrite <- Rmult_minus_distr_l.
   rewrite Rmult_comm; apply Rmult_le_compat.
   + apply bpow_ge_0.
   + apply bpow_ge_0.
-  + unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+  + unfold Raux.bpow, Z.pow_pos; simpl.
     rewrite Zmult_1_r; apply Rinv_le; [lra|].
-    now change 2 with (Z2R 2); apply Z2R_le.
+    now apply IZR_le.
   + rewrite 2!ulp_neq_0; try now apply Rgt_not_eq, Rgt_minus.
-    unfold canonic_exp.
-    apply (Rplus_le_reg_r (bpow (fexp2 (ln_beta (x - y))))); ring_simplify.
-    apply Rle_trans with (2 * bpow (fexp1 (ln_beta (x - y)) - 1)).
-    * replace (2 * bpow (fexp1 (ln_beta (x - y)) - 1)) with (bpow (fexp1 (ln_beta (x - y)) - 1) + bpow (fexp1 (ln_beta (x - y)) - 1)) by ring.
+    unfold cexp.
+    apply (Rplus_le_reg_r (bpow (fexp2 (mag (x - y))))); ring_simplify.
+    apply Rle_trans with (2 * bpow (fexp1 (mag (x - y)) - 1)).
+    * rewrite double.
       apply Rplus_le_compat_l.
       now apply bpow_le.
     * unfold Zminus; rewrite bpow_plus.
       rewrite Rmult_comm; rewrite Rmult_assoc.
       rewrite <- Rmult_1_r.
       apply Rmult_le_compat_l; [now apply bpow_ge_0|].
-      unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+      unfold Raux.bpow, Z.pow_pos; simpl.
       rewrite Zmult_1_r.
-      apply Z2R_le, Rinv_le in Hbeta.
+      apply IZR_le, Rinv_le in Hbeta.
       simpl in Hbeta.
       lra.
       apply Rlt_0_2.
 Qed.
 
-(* double_round_minus_aux{0,1,2} together *)
-Lemma double_round_minus_aux3 :
+(* round_round_minus_aux{0,1,2} together *)
+Lemma round_round_minus_aux3 :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   0 < y -> y <= x ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x - y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hyx Fx Fy.
 assert (Px := Rlt_le_trans 0 y x Py Hyx).
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Req_dec y x) as [Hy|Hy].
 - (* y = x *)
   rewrite Hy; replace (x - x) with 0 by ring.
@@ -1491,38 +1491,38 @@ destruct (Req_dec y x) as [Hy|Hy].
   + now apply valid_rnd_N.
 - (* y < x *)
   assert (Hyx' : y < x); [lra|].
-  destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta x) - 2)) as [Hly|Hly].
-  + (* ln_beta y <= fexp1 (ln_beta x) - 2 *)
-    destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta (x - y)) - 2))
+  destruct (Zle_or_lt (mag y) (fexp1 (mag x) - 2)) as [Hly|Hly].
+  + (* mag y <= fexp1 (mag x) - 2 *)
+    destruct (Zle_or_lt (mag y) (fexp1 (mag (x - y)) - 2))
       as [Hly'|Hly'].
-    * (* ln_beta y <= fexp1 (ln_beta (x - y)) - 2 *)
-      now apply double_round_minus_aux2.
-    * (* fexp1 (ln_beta (x - y)) - 2 < ln_beta y *)
+    * (* mag y <= fexp1 (mag (x - y)) - 2 *)
+      now apply round_round_minus_aux2.
+    * (* fexp1 (mag (x - y)) - 2 < mag y *)
       { rewrite (round_generic beta fexp2).
         - reflexivity.
         - now apply valid_rnd_N.
-        - assert (Hf1 : (fexp1 (ln_beta (x - y)) - 1 <= ln_beta y)%Z); [omega|].
-          now apply (double_round_minus_aux1 fexp1). }
+        - assert (Hf1 : (fexp1 (mag (x - y)) - 1 <= mag y)%Z); [omega|].
+          now apply (round_round_minus_aux1 fexp1). }
   + rewrite (round_generic beta fexp2).
     * reflexivity.
     * now apply valid_rnd_N.
-    * assert (Hf1 : (fexp1 (ln_beta x) - 1 <= ln_beta y)%Z); [omega|].
-      now apply (double_round_minus_aux0 fexp1).
+    * assert (Hf1 : (fexp1 (mag x) - 1 <= mag y)%Z); [omega|].
+      now apply (round_round_minus_aux0 fexp1).
 Qed.
 
-Lemma double_round_minus_aux :
+Lemma round_round_minus_aux :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   0 <= x -> 0 <= y ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x - y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Nnx Nny Fx Fy.
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Req_dec x 0) as [Zx|Nzx].
 - (* x = 0 *)
   rewrite Zx; unfold Rminus; rewrite Rplus_0_l.
@@ -1530,7 +1530,7 @@ destruct (Req_dec x 0) as [Zx|Nzx].
   rewrite (round_generic beta fexp2).
   * reflexivity.
   * now apply valid_rnd_N.
-  * apply (generic_inclusion_ln_beta beta fexp1).
+  * apply (generic_inclusion_mag beta fexp1).
     destruct Hexp as (_,(_,(_,Hexp4))).
     now intros _; apply Hexp4; omega.
     exact Fy.
@@ -1541,7 +1541,7 @@ destruct (Req_dec x 0) as [Zx|Nzx].
     rewrite (round_generic beta fexp2).
     * reflexivity.
     * now apply valid_rnd_N.
-    * apply (generic_inclusion_ln_beta beta fexp1).
+    * apply (generic_inclusion_mag beta fexp1).
       destruct Hexp as (_,(_,(_,Hexp4))).
       now intros _; apply Hexp4; omega.
       exact Fx.
@@ -1554,23 +1554,23 @@ destruct (Req_dec x 0) as [Zx|Nzx].
       replace (x - y) with (- (y - x)) by ring.
       do 3 rewrite round_N_opp.
       apply Ropp_eq_compat.
-      now apply double_round_minus_aux3.
+      now apply round_round_minus_aux3.
     * (* y <= x *)
-      now apply double_round_minus_aux3.
+      now apply round_round_minus_aux3.
 Qed.
 
-Lemma double_round_plus :
+Lemma round_round_plus :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x + y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Fx Fy.
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Rlt_or_le x 0) as [Sx|Sx]; destruct (Rlt_or_le y 0) as [Sy|Sy].
 - (* x < 0, y < 0 *)
   replace (x + y) with (- (- x - y)); [|ring].
@@ -1580,87 +1580,85 @@ destruct (Rlt_or_le x 0) as [Sx|Sx]; destruct (Rlt_or_le y 0) as [Sy|Sy].
   assert (Py : 0 <= - y); [lra|].
   apply generic_format_opp in Fx.
   apply generic_format_opp in Fy.
-  now apply double_round_plus_aux.
+  now apply round_round_plus_aux.
 - (* x < 0, 0 <= y *)
   replace (x + y) with (y - (- x)); [|ring].
   assert (Px : 0 <= - x); [lra|].
   apply generic_format_opp in Fx.
-  now apply double_round_minus_aux.
+  now apply round_round_minus_aux.
 - (* 0 <= x, y < 0 *)
   replace (x + y) with (x - (- y)); [|ring].
   assert (Py : 0 <= - y); [lra|].
   apply generic_format_opp in Fy.
-  now apply double_round_minus_aux.
+  now apply round_round_minus_aux.
 - (* 0 <= x, 0 <= y *)
-  now apply double_round_plus_aux.
+  now apply round_round_plus_aux.
 Qed.
 
-Lemma double_round_minus :
+Lemma round_round_minus :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_hyp fexp1 fexp2 ->
+  round_round_plus_hyp fexp1 fexp2 ->
   forall x y,
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x - y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Fx Fy.
 unfold Rminus.
 apply generic_format_opp in Fy.
-now apply double_round_plus.
+now apply round_round_plus.
 Qed.
 
 Section Double_round_plus_FLX.
 
-Import Fcore_FLX.
-
 Variable prec : Z.
 Variable prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLX_double_round_plus_hyp :
+Lemma FLX_round_round_plus_hyp :
   (2 * prec + 1 <= prec')%Z ->
-  double_round_plus_hyp (FLX_exp prec) (FLX_exp prec').
+  round_round_plus_hyp (FLX_exp prec) (FLX_exp prec').
 Proof.
 intros Hprec.
 unfold FLX_exp.
-unfold double_round_plus_hyp; split; [|split; [|split]];
+unfold round_round_plus_hyp; split; [|split; [|split]];
 intros ex ey; try omega.
 unfold Prec_gt_0 in prec_gt_0_.
 omega.
 Qed.
 
-Theorem double_round_plus_FLX :
+Theorem round_round_plus_FLX :
   forall choice1 choice2,
   (2 * prec + 1 <= prec')%Z ->
   forall x y,
   FLX_format beta prec x -> FLX_format beta prec y ->
-  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x + y).
+  round_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x + y).
 Proof.
 intros choice1 choice2 Hprec x y Fx Fy.
-apply double_round_plus.
+apply round_round_plus.
 - now apply FLX_exp_valid.
 - now apply FLX_exp_valid.
-- now apply FLX_double_round_plus_hyp.
+- now apply FLX_round_round_plus_hyp.
 - now apply generic_format_FLX.
 - now apply generic_format_FLX.
 Qed.
 
-Theorem double_round_minus_FLX :
+Theorem round_round_minus_FLX :
   forall choice1 choice2,
   (2 * prec + 1 <= prec')%Z ->
   forall x y,
   FLX_format beta prec x -> FLX_format beta prec y ->
-  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x - y).
+  round_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x - y).
 Proof.
 intros choice1 choice2 Hprec x y Fx Fy.
-apply double_round_minus.
+apply round_round_minus.
 - now apply FLX_exp_valid.
 - now apply FLX_exp_valid.
-- now apply FLX_double_round_plus_hyp.
+- now apply FLX_round_round_plus_hyp.
 - now apply generic_format_FLX.
 - now apply generic_format_FLX.
 Qed.
@@ -1669,22 +1667,19 @@ End Double_round_plus_FLX.
 
 Section Double_round_plus_FLT.
 
-Import Fcore_FLX.
-Import Fcore_FLT.
-
 Variable emin prec : Z.
 Variable emin' prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLT_double_round_plus_hyp :
+Lemma FLT_round_round_plus_hyp :
   (emin' <= emin)%Z -> (2 * prec + 1 <= prec')%Z ->
-  double_round_plus_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
+  round_round_plus_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
 Proof.
 intros Hemin Hprec.
 unfold FLT_exp.
-unfold double_round_plus_hyp; split; [|split; [|split]]; intros ex ey.
+unfold round_round_plus_hyp; split; [|split; [|split]]; intros ex ey.
 - generalize (Zmax_spec (ex + 1 - prec) emin).
   generalize (Zmax_spec (ex - prec') emin').
   generalize (Zmax_spec (ey - prec) emin).
@@ -1703,36 +1698,36 @@ unfold double_round_plus_hyp; split; [|split; [|split]]; intros ex ey.
   omega.
 Qed.
 
-Theorem double_round_plus_FLT :
+Theorem round_round_plus_FLT :
   forall choice1 choice2,
   (emin' <= emin)%Z -> (2 * prec + 1 <= prec')%Z ->
   forall x y,
   FLT_format beta emin prec x -> FLT_format beta emin prec y ->
-  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
+  round_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                   choice1 choice2 (x + y).
 Proof.
 intros choice1 choice2 Hemin Hprec x y Fx Fy.
-apply double_round_plus.
+apply round_round_plus.
 - now apply FLT_exp_valid.
 - now apply FLT_exp_valid.
-- now apply FLT_double_round_plus_hyp.
+- now apply FLT_round_round_plus_hyp.
 - now apply generic_format_FLT.
 - now apply generic_format_FLT.
 Qed.
 
-Theorem double_round_minus_FLT :
+Theorem round_round_minus_FLT :
   forall choice1 choice2,
   (emin' <= emin)%Z -> (2 * prec + 1 <= prec')%Z ->
   forall x y,
   FLT_format beta emin prec x -> FLT_format beta emin prec y ->
-  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
+  round_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                   choice1 choice2 (x - y).
 Proof.
 intros choice1 choice2 Hemin Hprec x y Fx Fy.
-apply double_round_minus.
+apply round_round_minus.
 - now apply FLT_exp_valid.
 - now apply FLT_exp_valid.
-- now apply FLT_double_round_plus_hyp.
+- now apply FLT_round_round_plus_hyp.
 - now apply generic_format_FLT.
 - now apply generic_format_FLT.
 Qed.
@@ -1741,23 +1736,20 @@ End Double_round_plus_FLT.
 
 Section Double_round_plus_FTZ.
 
-Import Fcore_FLX.
-Import Fcore_FTZ.
-
 Variable emin prec : Z.
 Variable emin' prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FTZ_double_round_plus_hyp :
+Lemma FTZ_round_round_plus_hyp :
   (emin' + prec' <= emin + 1)%Z -> (2 * prec + 1 <= prec')%Z ->
-  double_round_plus_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
+  round_round_plus_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
 Proof.
 intros Hemin Hprec.
 unfold FTZ_exp.
 unfold Prec_gt_0 in *.
-unfold double_round_plus_hyp; split; [|split; [|split]]; intros ex ey.
+unfold round_round_plus_hyp; split; [|split; [|split]]; intros ex ey.
 - destruct (Z.ltb_spec (ex + 1 - prec) emin);
   destruct (Z.ltb_spec (ex - prec') emin');
   destruct (Z.ltb_spec (ey - prec) emin);
@@ -1775,58 +1767,58 @@ unfold double_round_plus_hyp; split; [|split; [|split]]; intros ex ey.
   omega.
 Qed.
 
-Theorem double_round_plus_FTZ :
+Theorem round_round_plus_FTZ :
   forall choice1 choice2,
   (emin' + prec' <= emin + 1)%Z -> (2 * prec + 1 <= prec')%Z ->
   forall x y,
   FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
-  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
+  round_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                   choice1 choice2 (x + y).
 Proof.
 intros choice1 choice2 Hemin Hprec x y Fx Fy.
-apply double_round_plus.
+apply round_round_plus.
 - now apply FTZ_exp_valid.
 - now apply FTZ_exp_valid.
-- now apply FTZ_double_round_plus_hyp.
+- now apply FTZ_round_round_plus_hyp.
 - now apply generic_format_FTZ.
 - now apply generic_format_FTZ.
 Qed.
 
-Theorem double_round_minus_FTZ :
+Theorem round_round_minus_FTZ :
   forall choice1 choice2,
   (emin' + prec' <= emin + 1)%Z -> (2 * prec + 1 <= prec')%Z ->
   forall x y,
   FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
-  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
+  round_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                   choice1 choice2 (x - y).
 Proof.
 intros choice1 choice2 Hemin Hprec x y Fx Fy.
-apply double_round_minus.
+apply round_round_minus.
 - now apply FTZ_exp_valid.
 - now apply FTZ_exp_valid.
-- now apply FTZ_double_round_plus_hyp.
+- now apply FTZ_round_round_plus_hyp.
 - now apply generic_format_FTZ.
 - now apply generic_format_FTZ.
 Qed.
 
 End Double_round_plus_FTZ.
 
-Section Double_round_plus_beta_ge_3.
+Section Double_round_plus_radix_ge_3.
 
-Definition double_round_plus_beta_ge_3_hyp fexp1 fexp2 :=
+Definition round_round_plus_radix_ge_3_hyp fexp1 fexp2 :=
   (forall ex ey, (fexp1 (ex + 1) <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
   /\ (forall ex ey, (fexp1 (ex - 1) + 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
   /\ (forall ex ey, (fexp1 ex <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
   /\ (forall ex ey, (ex - 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z).
 
-(* fexp1 (ln_beta x) <= ln_beta y :
+(* fexp1 (mag x) <= mag y :
  * addition is exact in the largest precision (fexp2). *)
-Lemma double_round_plus_beta_ge_3_aux0 :
+Lemma round_round_plus_radix_ge_3_aux0 :
   forall (fexp1 fexp2 : Z -> Z), Valid_exp fexp1 ->
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   (0 < y)%R -> (y <= x)%R ->
-  (fexp1 (ln_beta x) <= ln_beta y)%Z ->
+  (fexp1 (mag x) <= mag y)%Z ->
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x + y).
 Proof.
@@ -1834,84 +1826,84 @@ intros fexp1 fexp2 Vfexp1 Hexp x y Py Hyx Hln Fx Fy.
 assert (Px := Rlt_le_trans 0 y x Py Hyx).
 assert (Nny : (0 <= y)%R); [now apply Rlt_le|].
 destruct Hexp as (_,(Hexp2,(Hexp3,Hexp4))).
-destruct (Z.le_gt_cases (ln_beta y) (fexp1 (ln_beta x))) as [Hle|Hgt].
-- (* ln_beta y <= fexp1 (ln_beta x) *)
-  assert (Lxy : ln_beta (x + y) = ln_beta x :> Z);
-  [now apply (ln_beta_plus_separated fexp1)|].
-  apply (double_round_plus_aux0_aux fexp1);
+destruct (Z.le_gt_cases (mag y) (fexp1 (mag x))) as [Hle|Hgt].
+- (* mag y <= fexp1 (mag x) *)
+  assert (Lxy : mag (x + y) = mag x :> Z);
+  [now apply (mag_plus_separated fexp1)|].
+  apply (round_round_plus_aux0_aux fexp1);
     [| |assumption|assumption]; rewrite Lxy.
   + now apply Hexp4; omega.
   + now apply Hexp3; omega.
-- (* fexp1 (ln_beta x) < ln_beta y *)
-  apply (double_round_plus_aux0_aux fexp1); [| |assumption|assumption].
-  destruct (ln_beta_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
+- (* fexp1 (mag x) < mag y *)
+  apply (round_round_plus_aux0_aux fexp1); [| |assumption|assumption].
+  destruct (mag_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
   + now apply Hexp4; omega.
-  + apply Hexp2; apply (ln_beta_le beta y x Py) in Hyx.
-    replace (_ - _)%Z with (ln_beta x : Z) by ring.
+  + apply Hexp2; apply (mag_le beta y x Py) in Hyx.
+    replace (_ - _)%Z with (mag x : Z) by ring.
     omega.
-  + destruct (ln_beta_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
+  + destruct (mag_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
     * now apply Hexp3; omega.
     * apply Hexp2.
-      replace (_ - _)%Z with (ln_beta x : Z) by ring.
+      replace (_ - _)%Z with (mag x : Z) by ring.
       omega.
 Qed.
 
-(* ln_beta y <= fexp1 (ln_beta x) - 1 : double_round_lt_mid applies. *)
-Lemma double_round_plus_beta_ge_3_aux1 :
+(* mag y <= fexp1 (mag x) - 1 : round_round_lt_mid applies. *)
+Lemma round_round_plus_radix_ge_3_aux1 :
   (3 <= beta)%Z ->
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   0 < x -> 0 < y ->
-  (ln_beta y <= fexp1 (ln_beta x) - 1)%Z ->
+  (mag y <= fexp1 (mag x) - 1)%Z ->
   generic_format beta fexp1 x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x + y).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Hly Fx.
-assert (Lxy : ln_beta (x + y) = ln_beta x :> Z);
-  [now apply (ln_beta_plus_separated fexp1); [|apply Rlt_le| |omega]|].
+assert (Lxy : mag (x + y) = mag x :> Z);
+  [now apply (mag_plus_separated fexp1); [|apply Rlt_le| |omega]|].
 destruct Hexp as (_,(_,(_,Hexp4))).
-assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
+assert (Hf2 : (fexp2 (mag x) <= fexp1 (mag x))%Z);
   [now apply Hexp4; omega|].
 assert (Bpow3 : bpow (- 1) <= / 3).
-{ unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+{ unfold Raux.bpow, Z.pow_pos; simpl.
   rewrite Zmult_1_r.
   apply Rinv_le; [lra|].
-  now change 3 with (Z2R 3); apply Z2R_le. }
+  now apply IZR_le. }
 assert (P1 : (0 < 1)%Z) by omega.
-unfold double_round_eq.
-apply double_round_lt_mid.
+unfold round_round_eq.
+apply round_round_lt_mid.
 - exact Vfexp1.
 - exact Vfexp2.
 - lra.
 - now rewrite Lxy.
 - rewrite Lxy.
-  assert (fexp1 (ln_beta x) < ln_beta x)%Z; [|omega].
-  now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
+  assert (fexp1 (mag x) < mag x)%Z; [|omega].
+  now apply mag_generic_gt; [|apply Rgt_not_eq|].
 - unfold midp.
   apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))).
-  apply (Rlt_le_trans _ _ _ (proj2 (double_round_plus_aux1_aux 1 P1 fexp1 x y Px
+  apply (Rlt_le_trans _ _ _ (proj2 (round_round_plus_aux1_aux 1 P1 fexp1 x y Px
                                                                Py Hly Lxy Fx))).
   ring_simplify.
   rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
-  unfold canonic_exp; rewrite Lxy.
-  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
+  unfold cexp; rewrite Lxy.
+  apply (Rmult_le_reg_r (bpow (- fexp1 (mag x))));
     [now apply bpow_gt_0|].
   bpow_simplify.
   apply (Rle_trans _ _ _ Bpow3); lra.
 - rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
-  unfold round, F2R, scaled_mantissa, canonic_exp; simpl; rewrite Lxy.
+  unfold round, F2R, scaled_mantissa, cexp; simpl; rewrite Lxy.
   intro Hf2'.
   unfold midp.
   apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))); ring_simplify.
   rewrite <- Rmult_minus_distr_l.
-  apply (Rlt_le_trans _ _ _ (proj2 (double_round_plus_aux1_aux 1 P1 fexp1 x y Px
+  apply (Rlt_le_trans _ _ _ (proj2 (round_round_plus_aux1_aux 1 P1 fexp1 x y Px
                                                                Py Hly Lxy Fx))).
   rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
-  unfold canonic_exp; rewrite Lxy.
-  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
+  unfold cexp; rewrite Lxy.
+  apply (Rmult_le_reg_r (bpow (- fexp1 (mag x))));
     [now apply bpow_gt_0|].
   rewrite (Rmult_assoc (/ 2)).
   rewrite Rmult_minus_distr_r.
@@ -1925,47 +1917,47 @@ apply double_round_lt_mid.
   now apply Rle_trans with (bpow (- 1)); [apply bpow_le; omega|].
 Qed.
 
-(* double_round_plus_beta_ge_3_aux{0,1} together *)
-Lemma double_round_plus_beta_ge_3_aux2 :
+(* round_round_plus_radix_ge_3_aux{0,1} together *)
+Lemma round_round_plus_radix_ge_3_aux2 :
   (3 <= beta)%Z ->
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   0 < y -> y <= x ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x + y).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hyx Fx Fy.
 assert (Px := Rlt_le_trans 0 y x Py Hyx).
-unfold double_round_eq.
-destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta x) - 1)) as [Hly|Hly].
-- (* ln_beta y <= fexp1 (ln_beta x) - 1 *)
-  now apply double_round_plus_beta_ge_3_aux1.
-- (* fexp1 (ln_beta x) - 1 < ln_beta y *)
+unfold round_round_eq.
+destruct (Zle_or_lt (mag y) (fexp1 (mag x) - 1)) as [Hly|Hly].
+- (* mag y <= fexp1 (mag x) - 1 *)
+  now apply round_round_plus_radix_ge_3_aux1.
+- (* fexp1 (mag x) - 1 < mag y *)
   rewrite (round_generic beta fexp2).
   + reflexivity.
   + now apply valid_rnd_N.
-  + assert (Hf1 : (fexp1 (ln_beta x) <= ln_beta y)%Z); [omega|].
-    now apply (double_round_plus_beta_ge_3_aux0 fexp1).
+  + assert (Hf1 : (fexp1 (mag x) <= mag y)%Z); [omega|].
+    now apply (round_round_plus_radix_ge_3_aux0 fexp1).
 Qed.
 
-Lemma double_round_plus_beta_ge_3_aux :
+Lemma round_round_plus_radix_ge_3_aux :
   (3 <= beta)%Z ->
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   0 <= x -> 0 <= y ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x + y).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Nnx Nny Fx Fy.
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Req_dec x 0) as [Zx|Nzx].
 - (* x = 0 *)
   destruct Hexp as (_,(_,(_,Hexp4))).
@@ -1973,7 +1965,7 @@ destruct (Req_dec x 0) as [Zx|Nzx].
   rewrite (round_generic beta fexp2).
   + reflexivity.
   + now apply valid_rnd_N.
-  + apply (generic_inclusion_ln_beta beta fexp1).
+  + apply (generic_inclusion_mag beta fexp1).
     now intros _; apply Hexp4; omega.
     exact Fy.
 - (* x <> 0 *)
@@ -1984,7 +1976,7 @@ destruct (Req_dec x 0) as [Zx|Nzx].
     rewrite (round_generic beta fexp2).
     * reflexivity.
     * now apply valid_rnd_N.
-    * apply (generic_inclusion_ln_beta beta fexp1).
+    * apply (generic_inclusion_mag beta fexp1).
       now intros _; apply Hexp4; omega.
       exact Fx.
   + (* y <> 0 *)
@@ -1994,156 +1986,156 @@ destruct (Req_dec x 0) as [Zx|Nzx].
     * (* x < y *)
       apply Rlt_le in H.
       rewrite Rplus_comm.
-      now apply double_round_plus_beta_ge_3_aux2.
-    * now apply double_round_plus_beta_ge_3_aux2.
+      now apply round_round_plus_radix_ge_3_aux2.
+    * now apply round_round_plus_radix_ge_3_aux2.
 Qed.
 
-(* fexp1 (ln_beta x) <= ln_beta y :
+(* fexp1 (mag x) <= mag y :
  * substraction is exact in the largest precision (fexp2). *)
-Lemma double_round_minus_beta_ge_3_aux0 :
+Lemma round_round_minus_radix_ge_3_aux0 :
   forall (fexp1 fexp2 : Z -> Z),
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   0 < y -> y < x ->
-  (fexp1 (ln_beta x) <= ln_beta y)%Z ->
+  (fexp1 (mag x) <= mag y)%Z ->
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x - y).
 Proof.
 intros fexp1 fexp2 Hexp x y Py Hyx Hln Fx Fy.
 assert (Px := Rlt_trans 0 y x Py Hyx).
 destruct Hexp as (Hexp1,(_,(Hexp3,Hexp4))).
-assert (Lyx : (ln_beta y <= ln_beta x)%Z);
-  [now apply ln_beta_le; [|apply Rlt_le]|].
-destruct (Z.lt_ge_cases (ln_beta x - 2) (ln_beta y)) as [Hlt|Hge].
-- (* ln_beta x - 2 < ln_beta y *)
-  assert (Hor : (ln_beta y = ln_beta x :> Z)
-                \/ (ln_beta y = ln_beta x - 1 :> Z)%Z); [omega|].
+assert (Lyx : (mag y <= mag x)%Z);
+  [now apply mag_le; [|apply Rlt_le]|].
+destruct (Z.lt_ge_cases (mag x - 2) (mag y)) as [Hlt|Hge].
+- (* mag x - 2 < mag y *)
+  assert (Hor : (mag y = mag x :> Z)
+                \/ (mag y = mag x - 1 :> Z)%Z); [omega|].
   destruct Hor as [Heq|Heqm1].
-  + (* ln_beta y = ln_beta x *)
-    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
+  + (* mag y = mag x *)
+    apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
     * apply Hexp4.
-      apply Zle_trans with (ln_beta (x - y)); [omega|].
-      now apply ln_beta_minus.
+      apply Z.le_trans with (mag (x - y)); [omega|].
+      now apply mag_minus.
     * rewrite Heq.
       apply Hexp4.
-      apply Zle_trans with (ln_beta (x - y)); [omega|].
-      now apply ln_beta_minus.
-  + (* ln_beta y = ln_beta x - 1 *)
-    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
+      apply Z.le_trans with (mag (x - y)); [omega|].
+      now apply mag_minus.
+  + (* mag y = mag x - 1 *)
+    apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
     * apply Hexp4.
-      apply Zle_trans with (ln_beta (x - y)); [omega|].
-      now apply ln_beta_minus.
+      apply Z.le_trans with (mag (x - y)); [omega|].
+      now apply mag_minus.
     * rewrite Heqm1.
       apply Hexp4.
       apply Zplus_le_compat_r.
-      now apply ln_beta_minus.
-- (* ln_beta y <= ln_beta x - 2 *)
-  destruct (ln_beta_minus_disj x y Px Py Hge) as [Lxmy|Lxmy].
-  + (* ln_beta (x - y) = ln_beta x *)
-    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
+      now apply mag_minus.
+- (* mag y <= mag x - 2 *)
+  destruct (mag_minus_disj x y Px Py Hge) as [Lxmy|Lxmy].
+  + (* mag (x - y) = mag x *)
+    apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
     * apply Hexp4.
       omega.
     * now rewrite Lxmy; apply Hexp3.
-  + (* ln_beta (x - y) = ln_beta x - 1 *)
-    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy];
+  + (* mag (x - y) = mag x - 1 *)
+    apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy];
     rewrite Lxmy.
     * apply Hexp1.
-      replace (_ + _)%Z with (ln_beta x : Z); [|ring].
-      now apply Zle_trans with (ln_beta y).
+      replace (_ + _)%Z with (mag x : Z); [|ring].
+      now apply Z.le_trans with (mag y).
     * apply Hexp1.
-      now replace (_ + _)%Z with (ln_beta x : Z); [|ring].
+      now replace (_ + _)%Z with (mag x : Z); [|ring].
 Qed.
 
-(* ln_beta y <= fexp1 (ln_beta x) - 1,
- * fexp1 (ln_beta (x - y)) <= ln_beta y :
+(* mag y <= fexp1 (mag x) - 1,
+ * fexp1 (mag (x - y)) <= mag y :
  * substraction is exact in the largest precision (fexp2). *)
-Lemma double_round_minus_beta_ge_3_aux1 :
+Lemma round_round_minus_radix_ge_3_aux1 :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   0 < y -> y < x ->
-  (ln_beta y <= fexp1 (ln_beta x) - 1)%Z ->
-  (fexp1 (ln_beta (x - y)) <= ln_beta y)%Z ->
+  (mag y <= fexp1 (mag x) - 1)%Z ->
+  (fexp1 (mag (x - y)) <= mag y)%Z ->
   generic_format beta fexp1 x -> generic_format beta fexp1 y ->
   generic_format beta fexp2 (x - y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2  Hexp x y Py Hyx Hln Hln' Fx Fy.
 assert (Px := Rlt_trans 0 y x Py Hyx).
 destruct Hexp as (Hexp1,(Hexp2,(Hexp3,Hexp4))).
-assert (Lyx : (ln_beta y <= ln_beta x)%Z);
-  [now apply ln_beta_le; [|apply Rlt_le]|].
-assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
-- apply Zle_trans with (fexp1 (ln_beta (x - y))).
+assert (Lyx : (mag y <= mag x)%Z);
+  [now apply mag_le; [|apply Rlt_le]|].
+assert (Hfx : (fexp1 (mag x) < mag x)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfy : (fexp1 (mag y) < mag y)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
+- apply Z.le_trans with (fexp1 (mag (x - y))).
   + apply Hexp4; omega.
   + omega.
 - now apply Hexp3.
 Qed.
 
-(* ln_beta y <= fexp1 (ln_beta x) - 1 :
- * ln_beta y <= fexp1 (ln_beta (x - y)) - 1 :
- * double_round_gt_mid applies. *)
-Lemma double_round_minus_beta_ge_3_aux2 :
+(* mag y <= fexp1 (mag x) - 1 :
+ * mag y <= fexp1 (mag (x - y)) - 1 :
+ * round_round_gt_mid applies. *)
+Lemma round_round_minus_radix_ge_3_aux2 :
   (3 <= beta)%Z ->
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   0 < y -> y < x ->
-  (ln_beta y <= fexp1 (ln_beta x) - 1)%Z ->
-  (ln_beta y <= fexp1 (ln_beta (x - y)) - 1)%Z ->
+  (mag y <= fexp1 (mag x) - 1)%Z ->
+  (mag y <= fexp1 (mag (x - y)) - 1)%Z ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x - y).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hxy Hly Hly' Fx Fy.
 assert (Px := Rlt_trans 0 y x Py Hxy).
 destruct Hexp as (_,(_,(_,Hexp4))).
-assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
+assert (Hf2 : (fexp2 (mag x) <= fexp1 (mag x))%Z);
   [now apply Hexp4; omega|].
-assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfx : (fexp1 (mag x) < mag x)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
 assert (Bpow3 : bpow (- 1) <= / 3).
-{ unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+{ unfold Raux.bpow, Z.pow_pos; simpl.
   rewrite Zmult_1_r.
   apply Rinv_le; [lra|].
-  now change 3 with (Z2R 3); apply Z2R_le. }
-assert (Ly : y < bpow (ln_beta y)).
+  now apply IZR_le. }
+assert (Ly : y < bpow (mag y)).
 { apply Rabs_lt_inv.
-  apply bpow_ln_beta_gt. }
-unfold double_round_eq.
-apply double_round_gt_mid.
+  apply bpow_mag_gt. }
+unfold round_round_eq.
+apply round_round_gt_mid.
 - exact Vfexp1.
 - exact Vfexp2.
 - lra.
 - apply Hexp4; omega.
-- assert (fexp1 (ln_beta (x - y)) < ln_beta (x - y))%Z; [|omega].
-  apply (valid_exp_large fexp1 (ln_beta x - 1)).
-  + apply (valid_exp_large fexp1 (ln_beta y)); [|omega].
-    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
-  + now apply ln_beta_minus_lb; [| |omega].
+- assert (fexp1 (mag (x - y)) < mag (x - y))%Z; [|omega].
+  apply (valid_exp_large fexp1 (mag x - 1)).
+  + apply (valid_exp_large fexp1 (mag y)); [|omega].
+    now apply mag_generic_gt; [|apply Rgt_not_eq|].
+  + now apply mag_minus_lb; [| |omega].
 - unfold midp'.
   apply (Rplus_lt_reg_r (/ 2 * ulp beta fexp1 (x - y) - (x - y))).
   ring_simplify.
   replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring.
-  apply Rlt_le_trans with (bpow (fexp1 (ln_beta (x - y)) - 1)).
+  apply Rlt_le_trans with (bpow (fexp1 (mag (x - y)) - 1)).
   + apply Rle_lt_trans with y;
-    [now apply double_round_minus_aux2_aux|].
+    [now apply round_round_minus_aux2_aux|].
     apply (Rlt_le_trans _ _ _ Ly).
     now apply bpow_le.
   + rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rgt_minus].
-    unfold canonic_exp.
+    unfold cexp.
     unfold Zminus at 1; rewrite bpow_plus.
     rewrite Rmult_comm.
     apply Rmult_le_compat_r; [now apply bpow_ge_0|].
-    unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+    unfold Raux.bpow, Z.pow_pos; simpl.
     rewrite Zmult_1_r; apply Rinv_le; [lra|].
-    now change 2 with (Z2R 2); apply Z2R_le; omega.
+    now apply IZR_le; omega.
 - intro Hf2'.
   unfold midp'.
   apply (Rplus_lt_reg_r (/ 2 * (ulp beta fexp1 (x - y)
@@ -2151,21 +2143,21 @@ apply double_round_gt_mid.
   ring_simplify; rewrite <- Rmult_minus_distr_l.
   replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring.
   apply Rle_lt_trans with y;
-    [now apply double_round_minus_aux2_aux|].
+    [now apply round_round_minus_aux2_aux|].
   apply (Rlt_le_trans _ _ _ Ly).
-  apply Rle_trans with (bpow (fexp1 (ln_beta (x - y)) - 1));
+  apply Rle_trans with (bpow (fexp1 (mag (x - y)) - 1));
     [now apply bpow_le|].
   rewrite 2!ulp_neq_0; try now apply Rgt_not_eq, Rgt_minus.
-  unfold canonic_exp.
-  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta (x - y)))));
+  unfold cexp.
+  apply (Rmult_le_reg_r (bpow (- fexp1 (mag (x - y)))));
     [now apply bpow_gt_0|].
   rewrite Rmult_assoc.
   rewrite Rmult_minus_distr_r.
   bpow_simplify.
   apply Rle_trans with (/ 3).
-  + unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+  + unfold Raux.bpow, Z.pow_pos; simpl.
     rewrite Zmult_1_r; apply Rinv_le; [lra|].
-    now change 3 with (Z2R 3); apply Z2R_le.
+    now apply IZR_le.
   + replace (/ 3) with (/ 2 * (2 / 3)) by field.
     apply Rmult_le_compat_l; [lra|].
     apply (Rplus_le_reg_r (- 1)); ring_simplify.
@@ -2173,27 +2165,27 @@ apply double_round_gt_mid.
     apply Ropp_le_contravar.
     apply Rle_trans with (bpow (- 1)).
     * apply bpow_le; omega.
-    * unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
+    * unfold Raux.bpow, Z.pow_pos; simpl.
       rewrite Zmult_1_r; apply Rinv_le; [lra|].
-      now change 3 with (Z2R 3); apply Z2R_le.
+      now apply IZR_le.
 Qed.
 
-(* double_round_minus_aux{0,1,2} together *)
-Lemma double_round_minus_beta_ge_3_aux3 :
+(* round_round_minus_aux{0,1,2} together *)
+Lemma round_round_minus_radix_ge_3_aux3 :
   (3 <= beta)%Z ->
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   0 < y -> y <= x ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x - y).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hyx Fx Fy.
 assert (Px := Rlt_le_trans 0 y x Py Hyx).
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Req_dec y x) as [Hy|Hy].
 - (* y = x *)
   rewrite Hy; replace (x - x) with 0 by ring.
@@ -2202,39 +2194,39 @@ destruct (Req_dec y x) as [Hy|Hy].
   + now apply valid_rnd_N.
 - (* y < x *)
   assert (Hyx' : y < x); [lra|].
-  destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta x) - 1)) as [Hly|Hly].
-  + (* ln_beta y <= fexp1 (ln_beta x) - 1 *)
-    destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta (x - y)) - 1))
+  destruct (Zle_or_lt (mag y) (fexp1 (mag x) - 1)) as [Hly|Hly].
+  + (* mag y <= fexp1 (mag x) - 1 *)
+    destruct (Zle_or_lt (mag y) (fexp1 (mag (x - y)) - 1))
       as [Hly'|Hly'].
-    * (* ln_beta y <= fexp1 (ln_beta (x - y)) - 1 *)
-      now apply double_round_minus_beta_ge_3_aux2.
-    * (* fexp1 (ln_beta (x - y)) - 1 < ln_beta y *)
+    * (* mag y <= fexp1 (mag (x - y)) - 1 *)
+      now apply round_round_minus_radix_ge_3_aux2.
+    * (* fexp1 (mag (x - y)) - 1 < mag y *)
       { rewrite (round_generic beta fexp2).
         - reflexivity.
         - now apply valid_rnd_N.
-        - assert (Hf1 : (fexp1 (ln_beta (x - y)) <= ln_beta y)%Z); [omega|].
-          now apply (double_round_minus_beta_ge_3_aux1 fexp1). }
+        - assert (Hf1 : (fexp1 (mag (x - y)) <= mag y)%Z); [omega|].
+          now apply (round_round_minus_radix_ge_3_aux1 fexp1). }
   + rewrite (round_generic beta fexp2).
     * reflexivity.
     * now apply valid_rnd_N.
-    * assert (Hf1 : (fexp1 (ln_beta x) <= ln_beta y)%Z); [omega|].
-      now apply (double_round_minus_beta_ge_3_aux0 fexp1).
+    * assert (Hf1 : (fexp1 (mag x) <= mag y)%Z); [omega|].
+      now apply (round_round_minus_radix_ge_3_aux0 fexp1).
 Qed.
 
-Lemma double_round_minus_beta_ge_3_aux :
+Lemma round_round_minus_radix_ge_3_aux :
   (3 <= beta)%Z ->
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   0 <= x -> 0 <= y ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x - y).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Nnx Nny Fx Fy.
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Req_dec x 0) as [Zx|Nzx].
 - (* x = 0 *)
   rewrite Zx; unfold Rminus; rewrite Rplus_0_l.
@@ -2242,7 +2234,7 @@ destruct (Req_dec x 0) as [Zx|Nzx].
   rewrite (round_generic beta fexp2).
   * reflexivity.
   * now apply valid_rnd_N.
-  * apply (generic_inclusion_ln_beta beta fexp1).
+  * apply (generic_inclusion_mag beta fexp1).
     destruct Hexp as (_,(_,(_,Hexp4))).
     now intros _; apply Hexp4; omega.
     exact Fy.
@@ -2253,7 +2245,7 @@ destruct (Req_dec x 0) as [Zx|Nzx].
     rewrite (round_generic beta fexp2).
     * reflexivity.
     * now apply valid_rnd_N.
-    * apply (generic_inclusion_ln_beta beta fexp1).
+    * apply (generic_inclusion_mag beta fexp1).
       destruct Hexp as (_,(_,(_,Hexp4))).
       now intros _; apply Hexp4; omega.
       exact Fx.
@@ -2266,24 +2258,24 @@ destruct (Req_dec x 0) as [Zx|Nzx].
       replace (x - y) with (- (y - x)) by ring.
       do 3 rewrite round_N_opp.
       apply Ropp_eq_compat.
-      now apply double_round_minus_beta_ge_3_aux3.
+      now apply round_round_minus_radix_ge_3_aux3.
     * (* y <= x *)
-      now apply double_round_minus_beta_ge_3_aux3.
+      now apply round_round_minus_radix_ge_3_aux3.
 Qed.
 
-Lemma double_round_plus_beta_ge_3 :
+Lemma round_round_plus_radix_ge_3 :
   (3 <= beta)%Z ->
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x + y).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Fx Fy.
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Rlt_or_le x 0) as [Sx|Sx]; destruct (Rlt_or_le y 0) as [Sy|Sy].
 - (* x < 0, y < 0 *)
   replace (x + y) with (- (- x - y)); [|ring].
@@ -2293,41 +2285,39 @@ destruct (Rlt_or_le x 0) as [Sx|Sx]; destruct (Rlt_or_le y 0) as [Sy|Sy].
   assert (Py : 0 <= - y); [lra|].
   apply generic_format_opp in Fx.
   apply generic_format_opp in Fy.
-  now apply double_round_plus_beta_ge_3_aux.
+  now apply round_round_plus_radix_ge_3_aux.
 - (* x < 0, 0 <= y *)
   replace (x + y) with (y - (- x)); [|ring].
   assert (Px : 0 <= - x); [lra|].
   apply generic_format_opp in Fx.
-  now apply double_round_minus_beta_ge_3_aux.
+  now apply round_round_minus_radix_ge_3_aux.
 - (* 0 <= x, y < 0 *)
   replace (x + y) with (x - (- y)); [|ring].
   assert (Py : 0 <= - y); [lra|].
   apply generic_format_opp in Fy.
-  now apply double_round_minus_beta_ge_3_aux.
+  now apply round_round_minus_radix_ge_3_aux.
 - (* 0 <= x, 0 <= y *)
-  now apply double_round_plus_beta_ge_3_aux.
+  now apply round_round_plus_radix_ge_3_aux.
 Qed.
 
-Lemma double_round_minus_beta_ge_3 :
+Lemma round_round_minus_radix_ge_3 :
   (3 <= beta)%Z ->
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
+  round_round_plus_radix_ge_3_hyp fexp1 fexp2 ->
   forall x y,
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x - y).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Fx Fy.
 unfold Rminus.
 apply generic_format_opp in Fy.
-now apply double_round_plus_beta_ge_3.
+now apply round_round_plus_radix_ge_3.
 Qed.
 
-Section Double_round_plus_beta_ge_3_FLX.
-
-Import Fcore_FLX.
+Section Double_round_plus_radix_ge_3_FLX.
 
 Variable prec : Z.
 Variable prec' : Z.
@@ -2335,60 +2325,57 @@ Variable prec' : Z.
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLX_double_round_plus_beta_ge_3_hyp :
+Lemma FLX_round_round_plus_radix_ge_3_hyp :
   (2 * prec <= prec')%Z ->
-  double_round_plus_beta_ge_3_hyp (FLX_exp prec) (FLX_exp prec').
+  round_round_plus_radix_ge_3_hyp (FLX_exp prec) (FLX_exp prec').
 Proof.
 intros Hprec.
 unfold FLX_exp.
-unfold double_round_plus_beta_ge_3_hyp; split; [|split; [|split]];
+unfold round_round_plus_radix_ge_3_hyp; split; [|split; [|split]];
 intros ex ey; try omega.
 unfold Prec_gt_0 in prec_gt_0_.
 omega.
 Qed.
 
-Theorem double_round_plus_beta_ge_3_FLX :
+Theorem round_round_plus_radix_ge_3_FLX :
   (3 <= beta)%Z ->
   forall choice1 choice2,
   (2 * prec <= prec')%Z ->
   forall x y,
   FLX_format beta prec x -> FLX_format beta prec y ->
-  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x + y).
+  round_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x + y).
 Proof.
 intros Hbeta choice1 choice2 Hprec x y Fx Fy.
-apply double_round_plus_beta_ge_3.
+apply round_round_plus_radix_ge_3.
 - exact Hbeta.
 - now apply FLX_exp_valid.
 - now apply FLX_exp_valid.
-- now apply FLX_double_round_plus_beta_ge_3_hyp.
+- now apply FLX_round_round_plus_radix_ge_3_hyp.
 - now apply generic_format_FLX.
 - now apply generic_format_FLX.
 Qed.
 
-Theorem double_round_minus_beta_ge_3_FLX :
+Theorem round_round_minus_radix_ge_3_FLX :
   (3 <= beta)%Z ->
   forall choice1 choice2,
   (2 * prec <= prec')%Z ->
   forall x y,
   FLX_format beta prec x -> FLX_format beta prec y ->
-  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x - y).
+  round_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x - y).
 Proof.
 intros Hbeta choice1 choice2 Hprec x y Fx Fy.
-apply double_round_minus_beta_ge_3.
+apply round_round_minus_radix_ge_3.
 - exact Hbeta.
 - now apply FLX_exp_valid.
 - now apply FLX_exp_valid.
-- now apply FLX_double_round_plus_beta_ge_3_hyp.
+- now apply FLX_round_round_plus_radix_ge_3_hyp.
 - now apply generic_format_FLX.
 - now apply generic_format_FLX.
 Qed.
 
-End Double_round_plus_beta_ge_3_FLX.
-
-Section Double_round_plus_beta_ge_3_FLT.
+End Double_round_plus_radix_ge_3_FLX.
 
-Import Fcore_FLX.
-Import Fcore_FLT.
+Section Double_round_plus_radix_ge_3_FLT.
 
 Variable emin prec : Z.
 Variable emin' prec' : Z.
@@ -2396,13 +2383,13 @@ Variable emin' prec' : Z.
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLT_double_round_plus_beta_ge_3_hyp :
+Lemma FLT_round_round_plus_radix_ge_3_hyp :
   (emin' <= emin)%Z -> (2 * prec <= prec')%Z ->
-  double_round_plus_beta_ge_3_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
+  round_round_plus_radix_ge_3_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
 Proof.
 intros Hemin Hprec.
 unfold FLT_exp.
-unfold double_round_plus_beta_ge_3_hyp; split; [|split; [|split]]; intros ex ey.
+unfold round_round_plus_radix_ge_3_hyp; split; [|split; [|split]]; intros ex ey.
 - generalize (Zmax_spec (ex + 1 - prec) emin).
   generalize (Zmax_spec (ex - prec') emin').
   generalize (Zmax_spec (ey - prec) emin).
@@ -2421,50 +2408,47 @@ unfold double_round_plus_beta_ge_3_hyp; split; [|split; [|split]]; intros ex ey.
   omega.
 Qed.
 
-Theorem double_round_plus_beta_ge_3_FLT :
+Theorem round_round_plus_radix_ge_3_FLT :
   (3 <= beta)%Z ->
   forall choice1 choice2,
   (emin' <= emin)%Z -> (2 * prec <= prec')%Z ->
   forall x y,
   FLT_format beta emin prec x -> FLT_format beta emin prec y ->
-  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
+  round_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                   choice1 choice2 (x + y).
 Proof.
 intros Hbeta choice1 choice2 Hemin Hprec x y Fx Fy.
-apply double_round_plus_beta_ge_3.
+apply round_round_plus_radix_ge_3.
 - exact Hbeta.
 - now apply FLT_exp_valid.
 - now apply FLT_exp_valid.
-- now apply FLT_double_round_plus_beta_ge_3_hyp.
+- now apply FLT_round_round_plus_radix_ge_3_hyp.
 - now apply generic_format_FLT.
 - now apply generic_format_FLT.
 Qed.
 
-Theorem double_round_minus_beta_ge_3_FLT :
+Theorem round_round_minus_radix_ge_3_FLT :
   (3 <= beta)%Z ->
   forall choice1 choice2,
   (emin' <= emin)%Z -> (2 * prec <= prec')%Z ->
   forall x y,
   FLT_format beta emin prec x -> FLT_format beta emin prec y ->
-  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
+  round_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                   choice1 choice2 (x - y).
 Proof.
 intros Hbeta choice1 choice2 Hemin Hprec x y Fx Fy.
-apply double_round_minus_beta_ge_3.
+apply round_round_minus_radix_ge_3.
 - exact Hbeta.
 - now apply FLT_exp_valid.
 - now apply FLT_exp_valid.
-- now apply FLT_double_round_plus_beta_ge_3_hyp.
+- now apply FLT_round_round_plus_radix_ge_3_hyp.
 - now apply generic_format_FLT.
 - now apply generic_format_FLT.
 Qed.
 
-End Double_round_plus_beta_ge_3_FLT.
+End Double_round_plus_radix_ge_3_FLT.
 
-Section Double_round_plus_beta_ge_3_FTZ.
-
-Import Fcore_FLX.
-Import Fcore_FTZ.
+Section Double_round_plus_radix_ge_3_FTZ.
 
 Variable emin prec : Z.
 Variable emin' prec' : Z.
@@ -2472,14 +2456,14 @@ Variable emin' prec' : Z.
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FTZ_double_round_plus_beta_ge_3_hyp :
+Lemma FTZ_round_round_plus_radix_ge_3_hyp :
   (emin' + prec' <= emin + 1)%Z -> (2 * prec <= prec')%Z ->
-  double_round_plus_beta_ge_3_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
+  round_round_plus_radix_ge_3_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
 Proof.
 intros Hemin Hprec.
 unfold FTZ_exp.
 unfold Prec_gt_0 in *.
-unfold double_round_plus_beta_ge_3_hyp; split; [|split; [|split]]; intros ex ey.
+unfold round_round_plus_radix_ge_3_hyp; split; [|split; [|split]]; intros ex ey.
 - destruct (Z.ltb_spec (ex + 1 - prec) emin);
   destruct (Z.ltb_spec (ex - prec') emin');
   destruct (Z.ltb_spec (ey - prec) emin);
@@ -2497,64 +2481,64 @@ unfold double_round_plus_beta_ge_3_hyp; split; [|split; [|split]]; intros ex ey.
   omega.
 Qed.
 
-Theorem double_round_plus_beta_ge_3_FTZ :
+Theorem round_round_plus_radix_ge_3_FTZ :
   (3 <= beta)%Z ->
   forall choice1 choice2,
   (emin' + prec' <= emin + 1)%Z -> (2 * prec <= prec')%Z ->
   forall x y,
   FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
-  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
+  round_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                   choice1 choice2 (x + y).
 Proof.
 intros Hbeta choice1 choice2 Hemin Hprec x y Fx Fy.
-apply double_round_plus_beta_ge_3.
+apply round_round_plus_radix_ge_3.
 - exact Hbeta.
 - now apply FTZ_exp_valid.
 - now apply FTZ_exp_valid.
-- now apply FTZ_double_round_plus_beta_ge_3_hyp.
+- now apply FTZ_round_round_plus_radix_ge_3_hyp.
 - now apply generic_format_FTZ.
 - now apply generic_format_FTZ.
 Qed.
 
-Theorem double_round_minus_beta_ge_3_FTZ :
+Theorem round_round_minus_radix_ge_3_FTZ :
   (3 <= beta)%Z ->
   forall choice1 choice2,
   (emin' + prec' <= emin + 1)%Z -> (2 * prec <= prec')%Z ->
   forall x y,
   FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
-  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
+  round_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                   choice1 choice2 (x - y).
 Proof.
 intros Hbeta choice1 choice2 Hemin Hprec x y Fx Fy.
-apply double_round_minus_beta_ge_3.
+apply round_round_minus_radix_ge_3.
 - exact Hbeta.
 - now apply FTZ_exp_valid.
 - now apply FTZ_exp_valid.
-- now apply FTZ_double_round_plus_beta_ge_3_hyp.
+- now apply FTZ_round_round_plus_radix_ge_3_hyp.
 - now apply generic_format_FTZ.
 - now apply generic_format_FTZ.
 Qed.
 
-End Double_round_plus_beta_ge_3_FTZ.
+End Double_round_plus_radix_ge_3_FTZ.
 
-End Double_round_plus_beta_ge_3.
+End Double_round_plus_radix_ge_3.
 
 End Double_round_plus.
 
-Lemma double_round_mid_cases :
+Lemma round_round_mid_cases :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
-  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
+  (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
+  (fexp1 (mag x) <= mag x)%Z ->
   (Rabs (x - midp fexp1 x) <= / 2 * (ulp beta fexp2 x) ->
-   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+   round_round_eq fexp1 fexp2 choice1 choice2 x) ->
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1.
-unfold double_round_eq, midp.
+unfold round_round_eq, midp.
 set (rd := round beta fexp1 Zfloor x).
 set (u1 := ulp beta fexp1 x).
 set (u2 := ulp beta fexp2 x).
@@ -2562,14 +2546,14 @@ intros Cmid.
 destruct (generic_format_EM beta fexp1 x) as [Fx|Nfx].
 - (* generic_format beta fexp1 x *)
   rewrite (round_generic beta fexp2); [reflexivity|now apply valid_rnd_N|].
-  now apply (generic_inclusion_ln_beta beta fexp1); [omega|].
+  now apply (generic_inclusion_mag beta fexp1); [omega|].
 - (* ~ generic_format beta fexp1 x *)
   assert (Hceil : round beta fexp1 Zceil x = rd + u1);
   [now apply round_UP_DN_ulp|].
-  assert (Hf2' : (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z); [omega|].
+  assert (Hf2' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z); [omega|].
   destruct (Rlt_or_le (x - rd) (/ 2 * (u1 - u2))).
   + (* x - rd < / 2 * (u1 - u2) *)
-    apply double_round_lt_mid_further_place; try assumption.
+    apply round_round_lt_mid_further_place; try assumption.
     unfold midp. fold rd; fold u1; fold u2.
     apply (Rplus_lt_reg_r (- rd)); ring_simplify.
     now rewrite <- Rmult_minus_distr_l.
@@ -2580,7 +2564,7 @@ destruct (generic_format_EM beta fexp1 x) as [Fx|Nfx].
                 < / 2 * (ulp beta fexp1 x - ulp beta fexp2 x)).
         { rewrite Hceil; fold u1; fold u2.
           lra. }
-        apply double_round_gt_mid_further_place; try assumption.
+        apply round_round_gt_mid_further_place; try assumption.
         unfold midp'; lra.
       - (* x - rd <= / 2 * (u1 + u2) *)
         apply Cmid, Rabs_le; split; lra. }
@@ -2588,31 +2572,31 @@ Qed.
 
 Section Double_round_sqrt.
 
-Definition double_round_sqrt_hyp fexp1 fexp2 :=
+Definition round_round_sqrt_hyp fexp1 fexp2 :=
   (forall ex, (2 * fexp1 ex <= fexp1 (2 * ex))%Z)
   /\ (forall ex, (2 * fexp1 ex <= fexp1 (2 * ex - 1))%Z)
   /\ (forall ex, (fexp1 (2 * ex) < 2 * ex)%Z ->
                  (fexp2 ex + ex <= 2 * fexp1 ex - 2)%Z).
 
-Lemma ln_beta_sqrt_disj :
+Lemma mag_sqrt_disj :
   forall x,
   0 < x ->
-  (ln_beta x = 2 * ln_beta (sqrt x) - 1 :> Z)%Z
-  \/ (ln_beta x = 2 * ln_beta (sqrt x) :> Z)%Z.
+  (mag x = 2 * mag (sqrt x) - 1 :> Z)%Z
+  \/ (mag x = 2 * mag (sqrt x) :> Z)%Z.
 Proof.
 intros x Px.
-generalize (ln_beta_sqrt beta x Px).
-intro H.
-omega.
+rewrite (mag_sqrt beta x Px).
+generalize (Zdiv2_odd_eqn (mag x + 1)).
+destruct Z.odd ; intros ; omega.
 Qed.
 
-Lemma double_round_sqrt_aux :
+Lemma round_round_sqrt_aux :
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
-  double_round_sqrt_hyp fexp1 fexp2 ->
+  round_round_sqrt_hyp fexp1 fexp2 ->
   forall x,
   0 < x ->
-  (fexp2 (ln_beta (sqrt x)) <= fexp1 (ln_beta (sqrt x)) - 1)%Z ->
+  (fexp2 (mag (sqrt x)) <= fexp1 (mag (sqrt x)) - 1)%Z ->
   generic_format beta fexp1 x ->
   / 2 * ulp beta fexp2 (sqrt x) < Rabs (sqrt x - midp fexp1 (sqrt x)).
 Proof.
@@ -2621,8 +2605,8 @@ assert (Hbeta : (2 <= beta)%Z).
 { destruct beta as (beta_val,beta_prop).
   now apply Zle_bool_imp_le. }
 set (a := round beta fexp1 Zfloor (sqrt x)).
-set (u1 := bpow (fexp1 (ln_beta (sqrt x)))).
-set (u2 := bpow (fexp2 (ln_beta (sqrt x)))).
+set (u1 := bpow (fexp1 (mag (sqrt x)))).
+set (u2 := bpow (fexp2 (mag (sqrt x)))).
 set (b := / 2 * (u1 - u2)).
 set (b' := / 2 * (u1 + u2)).
 unfold midp; rewrite 2!ulp_neq_0; try now apply Rgt_not_eq, sqrt_lt_R0.
@@ -2633,9 +2617,9 @@ assert (Fa : generic_format beta fexp1 a).
   - exact Vfexp1.
   - now apply valid_rnd_DN. }
 revert Fa; revert Fx.
-unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
-set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
-set (ma := Ztrunc (a * bpow (- fexp1 (ln_beta a)))).
+unfold generic_format, F2R, scaled_mantissa, cexp; simpl.
+set (mx := Ztrunc (x * bpow (- fexp1 (mag x)))).
+set (ma := Ztrunc (a * bpow (- fexp1 (mag a)))).
 intros Fx Fa.
 assert (Nna : 0 <= a).
 { rewrite <- (round_0 beta fexp1 Zfloor).
@@ -2666,14 +2650,14 @@ assert (Hl : a + b <= sqrt x).
   replace (_ + sqrt _) with (sqrt x - (a + / 2 * u1)) by ring.
   rewrite Ropp_mult_distr_l_reverse.
   now apply Rabs_le_inv in H; destruct H. }
-assert (Hf1 : (2 * fexp1 (ln_beta (sqrt x)) <= fexp1 (ln_beta (x)))%Z);
-  [destruct (ln_beta_sqrt_disj x Px) as [H'|H']; rewrite H'; apply Hexp|].
-assert (Hlx : (fexp1 (2 * ln_beta (sqrt x)) < 2 * ln_beta (sqrt x))%Z).
-{ destruct (ln_beta_sqrt_disj x Px) as [Hlx|Hlx].
-  - apply (valid_exp_large fexp1 (ln_beta x)); [|omega].
-    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
+assert (Hf1 : (2 * fexp1 (mag (sqrt x)) <= fexp1 (mag (x)))%Z);
+  [destruct (mag_sqrt_disj x Px) as [H'|H']; rewrite H'; apply Hexp|].
+assert (Hlx : (fexp1 (2 * mag (sqrt x)) < 2 * mag (sqrt x))%Z).
+{ destruct (mag_sqrt_disj x Px) as [Hlx|Hlx].
+  - apply (valid_exp_large fexp1 (mag x)); [|omega].
+    now apply mag_generic_gt; [|apply Rgt_not_eq|].
   - rewrite <- Hlx.
-    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]. }
+    now apply mag_generic_gt; [|apply Rgt_not_eq|]. }
 assert (Hsl : a * a + u1 * a - u2 * a + b * b <= x).
 { replace (_ + _) with ((a + b) * (a + b)); [|now unfold b; field].
   rewrite <- sqrt_def; [|now apply Rlt_le].
@@ -2692,34 +2676,33 @@ destruct (Req_dec a 0) as [Za|Nza].
   + revert Hsl; unfold Rminus; rewrite Za; do 3 rewrite Rmult_0_r.
     now rewrite Ropp_0; do 3 rewrite Rplus_0_l.
   + rewrite Fx.
-    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
+    apply (Rmult_le_reg_r (bpow (- fexp1 (mag x))));
       [now apply bpow_gt_0|].
     rewrite Rmult_0_l; bpow_simplify.
     unfold mx.
     rewrite Ztrunc_floor;
       [|now apply Rmult_le_pos; [apply Rlt_le|apply bpow_ge_0]].
-    apply Req_le.
-    change 0 with (Z2R 0); apply f_equal.
+    apply Req_le, IZR_eq.
     apply Zfloor_imp.
     split; [now apply Rmult_le_pos; [apply Rlt_le|apply bpow_ge_0]|simpl].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
     rewrite Rmult_1_l; bpow_simplify.
-    apply Rlt_le_trans with (bpow (2 * fexp1 (ln_beta (sqrt x))));
+    apply Rlt_le_trans with (bpow (2 * fexp1 (mag (sqrt x))));
       [|now apply bpow_le].
     change 2%Z with (1 + 1)%Z; rewrite Zmult_plus_distr_l; rewrite Zmult_1_l.
     rewrite bpow_plus.
     rewrite <- (sqrt_def x) at 1; [|now apply Rlt_le].
-    assert (sqrt x < bpow (fexp1 (ln_beta (sqrt x))));
+    assert (sqrt x < bpow (fexp1 (mag (sqrt x))));
       [|now apply Rmult_lt_compat; [apply sqrt_pos|apply sqrt_pos| |]].
     apply (Rle_lt_trans _ _ _ Hr); rewrite Za; rewrite Rplus_0_l.
     unfold b'; change (bpow _) with u1.
     apply Rlt_le_trans with (/ 2 * (u1 + u1)); [|lra].
     apply Rmult_lt_compat_l; [lra|]; apply Rplus_lt_compat_l.
-    unfold u2, u1, ulp, canonic_exp; apply bpow_lt; omega.
+    unfold u2, u1, ulp, cexp; apply bpow_lt; omega.
 - (* a <> 0 *)
   assert (Pa : 0 < a); [lra|].
-  assert (Hla : (ln_beta a = ln_beta (sqrt x) :> Z)).
-  { unfold a; apply ln_beta_DN.
+  assert (Hla : (mag a = mag (sqrt x) :> Z)).
+  { unfold a; apply mag_DN.
     - exact Vfexp1.
     - now fold a. }
   assert (Hl' : 0 < - (u2 * a) + b * b).
@@ -2728,60 +2711,60 @@ destruct (Req_dec a 0) as [Za|Nza].
     apply (Rplus_lt_reg_r (/ 2 * u2 * u1)); field_simplify.
     replace (_ / 2) with (u2 * (a + / 2 * u1)) by field.
     replace (_ / 8) with (/ 4 * (u2 ^ 2 + u1 ^ 2)) by field.
-    apply Rlt_le_trans with (u2 * bpow (ln_beta (sqrt x))).
+    apply Rlt_le_trans with (u2 * bpow (mag (sqrt x))).
     - apply Rmult_lt_compat_l; [now unfold u2, ulp; apply bpow_gt_0|].
       unfold u1; rewrite <- Hla.
-      apply Rlt_le_trans with (a + bpow (fexp1 (ln_beta a))).
+      apply Rlt_le_trans with (a + bpow (fexp1 (mag a))).
       + apply Rplus_lt_compat_l.
         rewrite <- (Rmult_1_l (bpow _)) at 2.
         apply Rmult_lt_compat_r; [apply bpow_gt_0|lra].
       + apply Rle_trans with (a+ ulp beta fexp1 a).
         right; now rewrite ulp_neq_0.
         apply (id_p_ulp_le_bpow _ _ _ _ Pa Fa).
-        apply Rabs_lt_inv, bpow_ln_beta_gt.
+        apply Rabs_lt_inv, bpow_mag_gt.
     - apply Rle_trans with (bpow (- 2) * u1 ^ 2).
       + unfold pow; rewrite Rmult_1_r.
-        unfold u1, u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
+        unfold u1, u2, ulp, cexp; bpow_simplify; apply bpow_le.
         now apply Hexp.
       + apply Rmult_le_compat.
         * apply bpow_ge_0.
         * apply pow2_ge_0.
-        * unfold Fcore_Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r.
+        * unfold Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r.
           apply Rinv_le; [lra|].
-          change 4 with (Z2R (2 * 2)%Z); apply Z2R_le, Zmult_le_compat; omega.
+          change 4%Z with (2 * 2)%Z; apply IZR_le, Zmult_le_compat; omega.
         * rewrite <- (Rplus_0_l (u1 ^ 2)) at 1; apply Rplus_le_compat_r.
           apply pow2_ge_0. }
   assert (Hr' : x <= a * a + u1 * a).
   { rewrite Hla in Fa.
     rewrite <- Rmult_plus_distr_r.
-    unfold u1, ulp, canonic_exp.
+    unfold u1, ulp, cexp.
     rewrite <- (Rmult_1_l (bpow _)); rewrite Fa; rewrite <- Rmult_plus_distr_r.
-    rewrite <- Rmult_assoc; rewrite (Rmult_comm _ (Z2R ma)).
-    rewrite <- (Rmult_assoc (Z2R ma)); bpow_simplify.
-    apply (Rmult_le_reg_r (bpow (- 2 * fexp1 (ln_beta (sqrt x)))));
+    rewrite <- Rmult_assoc; rewrite (Rmult_comm _ (IZR ma)).
+    rewrite <- (Rmult_assoc (IZR ma)); bpow_simplify.
+    apply (Rmult_le_reg_r (bpow (- 2 * fexp1 (mag (sqrt x)))));
       [now apply bpow_gt_0|bpow_simplify].
     rewrite Fx at 1; bpow_simplify.
-    rewrite <- Z2R_Zpower; [|omega].
-    change 1 with (Z2R 1); rewrite <- Z2R_plus; do 2 rewrite <- Z2R_mult.
-    apply Z2R_le, Zlt_succ_le, lt_Z2R.
-    unfold Z.succ; rewrite Z2R_plus; do 2 rewrite Z2R_mult; rewrite Z2R_plus.
-    rewrite Z2R_Zpower; [|omega].
-    apply (Rmult_lt_reg_r (bpow (2 * fexp1 (ln_beta (sqrt x)))));
+    rewrite <- IZR_Zpower; [|omega].
+    rewrite <- plus_IZR, <- 2!mult_IZR.
+    apply IZR_le, Zlt_succ_le, lt_IZR.
+    unfold Z.succ; rewrite plus_IZR; do 2 rewrite mult_IZR; rewrite plus_IZR.
+    rewrite IZR_Zpower; [|omega].
+    apply (Rmult_lt_reg_r (bpow (2 * fexp1 (mag (sqrt x)))));
       [now apply bpow_gt_0|bpow_simplify].
     rewrite <- Fx.
     change 2%Z with (1 + 1)%Z; rewrite Zmult_plus_distr_l; rewrite Zmult_1_l.
     rewrite bpow_plus; simpl.
     replace (_ * _) with (a * a + u1 * a + u1 * u1);
-      [|unfold u1, ulp, canonic_exp; rewrite Fa; ring].
+      [|unfold u1, ulp, cexp; rewrite Fa; ring].
     apply (Rle_lt_trans _ _ _ Hsr).
     rewrite Rplus_assoc; apply Rplus_lt_compat_l.
     apply (Rplus_lt_reg_r (- b' * b' + / 2 * u1 * u2)); ring_simplify.
     replace (_ + _) with ((a + / 2 * u1) * u2) by ring.
-    apply Rlt_le_trans with (bpow (ln_beta (sqrt x)) * u2).
+    apply Rlt_le_trans with (bpow (mag (sqrt x)) * u2).
     - apply Rmult_lt_compat_r; [now unfold u2, ulp; apply bpow_gt_0|].
       apply Rlt_le_trans with (a + u1); [lra|].
-      unfold u1; fold (canonic_exp beta fexp1 (sqrt x)).
-      rewrite <- canonic_exp_DN; [|exact Vfexp1|exact Pa]; fold a.
+      unfold u1; fold (cexp beta fexp1 (sqrt x)).
+      rewrite <- cexp_DN; [|exact Vfexp1|exact Pa]; fold a.
       rewrite <- ulp_neq_0; trivial.
       apply id_p_ulp_le_bpow.
       + exact Pa.
@@ -2789,27 +2772,27 @@ destruct (Req_dec a 0) as [Za|Nza].
       + apply Rle_lt_trans with (sqrt x).
         * now apply round_DN_pt.
         * apply Rabs_lt_inv.
-          apply bpow_ln_beta_gt.
+          apply bpow_mag_gt.
     - apply Rle_trans with (/ 2 * u1 ^ 2).
       + apply Rle_trans with (bpow (- 2) * u1 ^ 2).
         * unfold pow; rewrite Rmult_1_r.
-          unfold u2, u1, ulp, canonic_exp.
+          unfold u2, u1, ulp, cexp.
           bpow_simplify.
           apply bpow_le.
           rewrite Zplus_comm.
           now apply Hexp.
         * apply Rmult_le_compat_r; [now apply pow2_ge_0|].
-          unfold Fcore_Raux.bpow; simpl; unfold Z.pow_pos; simpl.
+          unfold Raux.bpow; simpl; unfold Z.pow_pos; simpl.
           rewrite Zmult_1_r.
           apply Rinv_le; [lra|].
-          change 2 with (Z2R 2); apply Z2R_le.
+          apply IZR_le.
           rewrite <- (Zmult_1_l 2).
           apply Zmult_le_compat; omega.
       + assert (u2 ^ 2 < u1 ^ 2); [|unfold b'; lra].
         unfold pow; do 2 rewrite Rmult_1_r.
         assert (H' : 0 <= u2); [unfold u2, ulp; apply bpow_ge_0|].
         assert (u2 < u1); [|now apply Rmult_lt_compat].
-        unfold u1, u2, ulp, canonic_exp; apply bpow_lt; omega. }
+        unfold u1, u2, ulp, cexp; apply bpow_lt; omega. }
   apply (Rlt_irrefl (a * a + u1 * a)).
   apply Rlt_le_trans with (a * a + u1 * a - u2 * a + b * b).
   + rewrite <- (Rplus_0_r (a * a + _)) at 1.
@@ -2819,29 +2802,29 @@ destruct (Req_dec a 0) as [Za|Nza].
 Qed.
 
 
-Lemma double_round_sqrt :
+Lemma round_round_sqrt :
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_sqrt_hyp fexp1 fexp2 ->
+  round_round_sqrt_hyp fexp1 fexp2 ->
   forall x,
   generic_format beta fexp1 x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (sqrt x).
+  round_round_eq fexp1 fexp2 choice1 choice2 (sqrt x).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x Fx.
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Rle_or_lt x 0) as [Npx|Px].
 - (* x <= 0 *)
   rewrite (sqrt_neg _ Npx).
   now rewrite round_0; [|apply valid_rnd_N].
 - (* 0 < x *)
-  assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
-  [now apply ln_beta_generic_gt; try assumption; lra|].
-  assert (Hfsx : (fexp1 (ln_beta (sqrt x)) < ln_beta (sqrt x))%Z).
+  assert (Hfx : (fexp1 (mag x) < mag x)%Z);
+  [now apply mag_generic_gt; try assumption; lra|].
+  assert (Hfsx : (fexp1 (mag (sqrt x)) < mag (sqrt x))%Z).
   { destruct (Rle_or_lt x 1) as [Hx|Hx].
     - (* x <= 1 *)
-      apply (valid_exp_large fexp1 (ln_beta x)); [exact Hfx|].
-      apply ln_beta_le; [exact Px|].
+      apply (valid_exp_large fexp1 (mag x)); [exact Hfx|].
+      apply mag_le; [exact Px|].
       rewrite <- (sqrt_def x) at 1; [|lra].
       rewrite <- Rmult_1_r.
       apply Rmult_le_compat_l.
@@ -2854,64 +2837,62 @@ destruct (Rle_or_lt x 0) as [Npx|Px].
       intro Hexp10.
       assert (Hf0 : (fexp1 1 < 1)%Z); [omega|clear Hexp10].
       apply (valid_exp_large fexp1 1); [exact Hf0|].
-      apply ln_beta_ge_bpow.
+      apply mag_ge_bpow.
       rewrite Zeq_minus; [|reflexivity].
-      unfold Fcore_Raux.bpow; simpl.
+      unfold Raux.bpow; simpl.
       apply Rabs_ge; right.
       rewrite <- sqrt_1.
       apply sqrt_le_1_alt.
       now apply Rlt_le. }
-  assert (Hf2 : (fexp2 (ln_beta (sqrt x)) <= fexp1 (ln_beta (sqrt x)) - 1)%Z).
-  { assert (H : (fexp1 (2 * ln_beta (sqrt x)) < 2 * ln_beta (sqrt x))%Z).
-    { destruct (ln_beta_sqrt_disj x Px) as [Hlx|Hlx].
-      - apply (valid_exp_large fexp1 (ln_beta x)); [|omega].
-        now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
+  assert (Hf2 : (fexp2 (mag (sqrt x)) <= fexp1 (mag (sqrt x)) - 1)%Z).
+  { assert (H : (fexp1 (2 * mag (sqrt x)) < 2 * mag (sqrt x))%Z).
+    { destruct (mag_sqrt_disj x Px) as [Hlx|Hlx].
+      - apply (valid_exp_large fexp1 (mag x)); [|omega].
+        now apply mag_generic_gt; [|apply Rgt_not_eq|].
       - rewrite <- Hlx.
-        now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]. }
-    generalize ((proj2 (proj2 Hexp)) (ln_beta (sqrt x)) H).
+        now apply mag_generic_gt; [|apply Rgt_not_eq|]. }
+    generalize ((proj2 (proj2 Hexp)) (mag (sqrt x)) H).
     omega. }
-  apply double_round_mid_cases.
+  apply round_round_mid_cases.
   + exact Vfexp1.
   + exact Vfexp2.
   + now apply sqrt_lt_R0.
   + omega.
   + omega.
   + intros Hmid; casetype False; apply (Rle_not_lt _ _ Hmid).
-    apply (double_round_sqrt_aux fexp1 fexp2 Vfexp1 Vfexp2 Hexp x Px Hf2 Fx).
+    apply (round_round_sqrt_aux fexp1 fexp2 Vfexp1 Vfexp2 Hexp x Px Hf2 Fx).
 Qed.
 
 Section Double_round_sqrt_FLX.
 
-Import Fcore_FLX.
-
 Variable prec : Z.
 Variable prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLX_double_round_sqrt_hyp :
+Lemma FLX_round_round_sqrt_hyp :
   (2 * prec + 2 <= prec')%Z ->
-  double_round_sqrt_hyp (FLX_exp prec) (FLX_exp prec').
+  round_round_sqrt_hyp (FLX_exp prec) (FLX_exp prec').
 Proof.
 intros Hprec.
 unfold FLX_exp.
 unfold Prec_gt_0 in prec_gt_0_.
-unfold double_round_sqrt_hyp; split; [|split]; intro ex; omega.
+unfold round_round_sqrt_hyp; split; [|split]; intro ex; omega.
 Qed.
 
-Theorem double_round_sqrt_FLX :
+Theorem round_round_sqrt_FLX :
   forall choice1 choice2,
   (2 * prec + 2 <= prec')%Z ->
   forall x,
   FLX_format beta prec x ->
-  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (sqrt x).
+  round_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (sqrt x).
 Proof.
 intros choice1 choice2 Hprec x Fx.
-apply double_round_sqrt.
+apply round_round_sqrt.
 - now apply FLX_exp_valid.
 - now apply FLX_exp_valid.
-- now apply FLX_double_round_sqrt_hyp.
+- now apply FLX_round_round_sqrt_hyp.
 - now apply generic_format_FLX.
 Qed.
 
@@ -2919,26 +2900,23 @@ End Double_round_sqrt_FLX.
 
 Section Double_round_sqrt_FLT.
 
-Import Fcore_FLX.
-Import Fcore_FLT.
-
 Variable emin prec : Z.
 Variable emin' prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLT_double_round_sqrt_hyp :
+Lemma FLT_round_round_sqrt_hyp :
   (emin <= 0)%Z ->
   ((emin' <= emin - prec - 2)%Z
    \/ (2 * emin' <= emin - 4 * prec - 2)%Z) ->
   (2 * prec + 2 <= prec')%Z ->
-  double_round_sqrt_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
+  round_round_sqrt_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
 Proof.
 intros Hemin Heminprec Hprec.
 unfold FLT_exp.
 unfold Prec_gt_0 in prec_gt_0_.
-unfold double_round_sqrt_hyp; split; [|split]; intros ex.
+unfold round_round_sqrt_hyp; split; [|split]; intros ex.
 - generalize (Zmax_spec (ex - prec) emin).
   generalize (Zmax_spec (2 * ex - prec) emin).
   omega.
@@ -2951,7 +2929,7 @@ unfold double_round_sqrt_hyp; split; [|split]; intros ex.
   omega.
 Qed.
 
-Theorem double_round_sqrt_FLT :
+Theorem round_round_sqrt_FLT :
   forall choice1 choice2,
   (emin <= 0)%Z ->
   ((emin' <= emin - prec - 2)%Z
@@ -2959,14 +2937,14 @@ Theorem double_round_sqrt_FLT :
   (2 * prec + 2 <= prec')%Z ->
   forall x,
   FLT_format beta emin prec x ->
-  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
+  round_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                   choice1 choice2 (sqrt x).
 Proof.
 intros choice1 choice2 Hemin Heminprec Hprec x Fx.
-apply double_round_sqrt.
+apply round_round_sqrt.
 - now apply FLT_exp_valid.
 - now apply FLT_exp_valid.
-- now apply FLT_double_round_sqrt_hyp.
+- now apply FLT_round_round_sqrt_hyp.
 - now apply generic_format_FLT.
 Qed.
 
@@ -2974,24 +2952,21 @@ End Double_round_sqrt_FLT.
 
 Section Double_round_sqrt_FTZ.
 
-Import Fcore_FLX.
-Import Fcore_FTZ.
-
 Variable emin prec : Z.
 Variable emin' prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FTZ_double_round_sqrt_hyp :
+Lemma FTZ_round_round_sqrt_hyp :
   (2 * (emin' + prec') <= emin + prec <= 1)%Z ->
   (2 * prec + 2 <= prec')%Z ->
-  double_round_sqrt_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
+  round_round_sqrt_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
 Proof.
 intros Hemin Hprec.
 unfold FTZ_exp.
 unfold Prec_gt_0 in *.
-unfold double_round_sqrt_hyp; split; [|split]; intros ex.
+unfold round_round_sqrt_hyp; split; [|split]; intros ex.
 - destruct (Z.ltb_spec (ex - prec) emin);
   destruct (Z.ltb_spec (2 * ex - prec) emin);
   omega.
@@ -3008,49 +2983,49 @@ unfold double_round_sqrt_hyp; split; [|split]; intros ex.
     omega.
 Qed.
 
-Theorem double_round_sqrt_FTZ :
+Theorem round_round_sqrt_FTZ :
   (4 <= beta)%Z ->
   forall choice1 choice2,
   (2 * (emin' + prec') <= emin + prec <= 1)%Z ->
   (2 * prec + 2 <= prec')%Z ->
   forall x,
   FTZ_format beta emin prec x ->
-  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
+  round_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                   choice1 choice2 (sqrt x).
 Proof.
 intros Hbeta choice1 choice2 Hemin Hprec x Fx.
-apply double_round_sqrt.
+apply round_round_sqrt.
 - now apply FTZ_exp_valid.
 - now apply FTZ_exp_valid.
-- now apply FTZ_double_round_sqrt_hyp.
+- now apply FTZ_round_round_sqrt_hyp.
 - now apply generic_format_FTZ.
 Qed.
 
 End Double_round_sqrt_FTZ.
 
-Section Double_round_sqrt_beta_ge_4.
+Section Double_round_sqrt_radix_ge_4.
 
-Definition double_round_sqrt_beta_ge_4_hyp fexp1 fexp2 :=
+Definition round_round_sqrt_radix_ge_4_hyp fexp1 fexp2 :=
   (forall ex, (2 * fexp1 ex <= fexp1 (2 * ex))%Z)
   /\ (forall ex, (2 * fexp1 ex <= fexp1 (2 * ex - 1))%Z)
   /\ (forall ex, (fexp1 (2 * ex) < 2 * ex)%Z ->
                  (fexp2 ex + ex <= 2 * fexp1 ex - 1)%Z).
 
-Lemma double_round_sqrt_beta_ge_4_aux :
+Lemma round_round_sqrt_radix_ge_4_aux :
   (4 <= beta)%Z ->
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
-  double_round_sqrt_beta_ge_4_hyp fexp1 fexp2 ->
+  round_round_sqrt_radix_ge_4_hyp fexp1 fexp2 ->
   forall x,
   0 < x ->
-  (fexp2 (ln_beta (sqrt x)) <= fexp1 (ln_beta (sqrt x)) - 1)%Z ->
+  (fexp2 (mag (sqrt x)) <= fexp1 (mag (sqrt x)) - 1)%Z ->
   generic_format beta fexp1 x ->
   / 2 * ulp beta fexp2 (sqrt x) < Rabs (sqrt x - midp fexp1 (sqrt x)).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 Hexp x Px Hf2 Fx.
 set (a := round beta fexp1 Zfloor (sqrt x)).
-set (u1 := bpow (fexp1 (ln_beta (sqrt x)))).
-set (u2 := bpow (fexp2 (ln_beta (sqrt x)))).
+set (u1 := bpow (fexp1 (mag (sqrt x)))).
+set (u2 := bpow (fexp2 (mag (sqrt x)))).
 set (b := / 2 * (u1 - u2)).
 set (b' := / 2 * (u1 + u2)).
 unfold midp; rewrite 2!ulp_neq_0; try now apply Rgt_not_eq, sqrt_lt_R0.
@@ -3061,9 +3036,9 @@ assert (Fa : generic_format beta fexp1 a).
   - exact Vfexp1.
   - now apply valid_rnd_DN. }
 revert Fa; revert Fx.
-unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
-set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
-set (ma := Ztrunc (a * bpow (- fexp1 (ln_beta a)))).
+unfold generic_format, F2R, scaled_mantissa, cexp; simpl.
+set (mx := Ztrunc (x * bpow (- fexp1 (mag x)))).
+set (ma := Ztrunc (a * bpow (- fexp1 (mag a)))).
 intros Fx Fa.
 assert (Nna : 0 <= a).
 { rewrite <- (round_0 beta fexp1 Zfloor).
@@ -3080,7 +3055,7 @@ assert (Pb : 0 < b).
   rewrite <- (Rmult_0_r (/ 2)).
   apply Rmult_lt_compat_l; [lra|].
   apply Rlt_Rminus.
-  unfold u2, u1, ulp, canonic_exp.
+  unfold u2, u1, ulp, cexp.
   apply bpow_lt.
   omega. }
 assert (Pb' : 0 < b').
@@ -3094,14 +3069,14 @@ assert (Hl : a + b <= sqrt x).
   replace (_ + sqrt _) with (sqrt x - (a + / 2 * u1)) by ring.
   rewrite Ropp_mult_distr_l_reverse.
   now apply Rabs_le_inv in H; destruct H. }
-assert (Hf1 : (2 * fexp1 (ln_beta (sqrt x)) <= fexp1 (ln_beta (x)))%Z);
-  [destruct (ln_beta_sqrt_disj x Px) as [H'|H']; rewrite H'; apply Hexp|].
-assert (Hlx : (fexp1 (2 * ln_beta (sqrt x)) < 2 * ln_beta (sqrt x))%Z).
-{ destruct (ln_beta_sqrt_disj x Px) as [Hlx|Hlx].
-  - apply (valid_exp_large fexp1 (ln_beta x)); [|omega].
-    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
+assert (Hf1 : (2 * fexp1 (mag (sqrt x)) <= fexp1 (mag (x)))%Z);
+  [destruct (mag_sqrt_disj x Px) as [H'|H']; rewrite H'; apply Hexp|].
+assert (Hlx : (fexp1 (2 * mag (sqrt x)) < 2 * mag (sqrt x))%Z).
+{ destruct (mag_sqrt_disj x Px) as [Hlx|Hlx].
+  - apply (valid_exp_large fexp1 (mag x)); [|omega].
+    now apply mag_generic_gt; [|apply Rgt_not_eq|].
   - rewrite <- Hlx.
-    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]. }
+    now apply mag_generic_gt; [|apply Rgt_not_eq|]. }
 assert (Hsl : a * a + u1 * a - u2 * a + b * b <= x).
 { replace (_ + _) with ((a + b) * (a + b)); [|now unfold b; field].
   rewrite <- sqrt_def; [|now apply Rlt_le].
@@ -3120,34 +3095,33 @@ destruct (Req_dec a 0) as [Za|Nza].
   + revert Hsl; unfold Rminus; rewrite Za; do 3 rewrite Rmult_0_r.
     now rewrite Ropp_0; do 3 rewrite Rplus_0_l.
   + rewrite Fx.
-    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
+    apply (Rmult_le_reg_r (bpow (- fexp1 (mag x))));
       [now apply bpow_gt_0|].
     rewrite Rmult_0_l; bpow_simplify.
     unfold mx.
     rewrite Ztrunc_floor;
       [|now apply Rmult_le_pos; [apply Rlt_le|apply bpow_ge_0]].
-    apply Req_le.
-    change 0 with (Z2R 0); apply f_equal.
+    apply Req_le, IZR_eq.
     apply Zfloor_imp.
     split; [now apply Rmult_le_pos; [apply Rlt_le|apply bpow_ge_0]|simpl].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|].
     rewrite Rmult_1_l; bpow_simplify.
-    apply Rlt_le_trans with (bpow (2 * fexp1 (ln_beta (sqrt x))));
+    apply Rlt_le_trans with (bpow (2 * fexp1 (mag (sqrt x))));
       [|now apply bpow_le].
     change 2%Z with (1 + 1)%Z; rewrite Zmult_plus_distr_l; rewrite Zmult_1_l.
     rewrite bpow_plus.
     rewrite <- (sqrt_def x) at 1; [|now apply Rlt_le].
-    assert (sqrt x < bpow (fexp1 (ln_beta (sqrt x))));
+    assert (sqrt x < bpow (fexp1 (mag (sqrt x))));
       [|now apply Rmult_lt_compat; [apply sqrt_pos|apply sqrt_pos| |]].
     apply (Rle_lt_trans _ _ _ Hr); rewrite Za; rewrite Rplus_0_l.
     unfold b'; change (bpow _) with u1.
     apply Rlt_le_trans with (/ 2 * (u1 + u1)); [|lra].
     apply Rmult_lt_compat_l; [lra|]; apply Rplus_lt_compat_l.
-    unfold u2, u1, ulp, canonic_exp; apply bpow_lt; omega.
+    unfold u2, u1, ulp, cexp; apply bpow_lt; omega.
 - (* a <> 0 *)
   assert (Pa : 0 < a); [lra|].
-  assert (Hla : (ln_beta a = ln_beta (sqrt x) :> Z)).
-  { unfold a; apply ln_beta_DN.
+  assert (Hla : (mag a = mag (sqrt x) :> Z)).
+  { unfold a; apply mag_DN.
     - exact Vfexp1.
     - now fold a. }
   assert (Hl' : 0 < - (u2 * a) + b * b).
@@ -3156,7 +3130,7 @@ destruct (Req_dec a 0) as [Za|Nza].
     apply (Rplus_lt_reg_r (/ 2 * u2 * u1)); field_simplify.
     replace (_ / 2) with (u2 * (a + / 2 * u1)) by field.
     replace (_ / 8) with (/ 4 * (u2 ^ 2 + u1 ^ 2)) by field.
-    apply Rlt_le_trans with (u2 * bpow (ln_beta (sqrt x))).
+    apply Rlt_le_trans with (u2 * bpow (mag (sqrt x))).
     - apply Rmult_lt_compat_l; [now unfold u2, ulp; apply bpow_gt_0|].
       unfold u1; rewrite <- Hla.
       apply Rlt_le_trans with (a + ulp beta fexp1 a).
@@ -3165,50 +3139,50 @@ destruct (Req_dec a 0) as [Za|Nza].
         rewrite ulp_neq_0; trivial.
         apply Rmult_lt_compat_r; [apply bpow_gt_0|lra].
       + apply (id_p_ulp_le_bpow _ _ _ _ Pa Fa).
-        apply Rabs_lt_inv, bpow_ln_beta_gt.
+        apply Rabs_lt_inv, bpow_mag_gt.
     - apply Rle_trans with (bpow (- 1) * u1 ^ 2).
       + unfold pow; rewrite Rmult_1_r.
-        unfold u1, u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
+        unfold u1, u2, ulp, cexp; bpow_simplify; apply bpow_le.
         now apply Hexp.
       + apply Rmult_le_compat.
         * apply bpow_ge_0.
         * apply pow2_ge_0.
-        * unfold Fcore_Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r.
+        * unfold Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r.
           apply Rinv_le; [lra|].
-          now change 4 with (Z2R 4); apply Z2R_le.
+          now apply IZR_le.
         * rewrite <- (Rplus_0_l (u1 ^ 2)) at 1; apply Rplus_le_compat_r.
           apply pow2_ge_0. }
   assert (Hr' : x <= a * a + u1 * a).
   { rewrite Hla in Fa.
     rewrite <- Rmult_plus_distr_r.
-    unfold u1, ulp, canonic_exp.
+    unfold u1, ulp, cexp.
     rewrite <- (Rmult_1_l (bpow _)); rewrite Fa; rewrite <- Rmult_plus_distr_r.
-    rewrite <- Rmult_assoc; rewrite (Rmult_comm _ (Z2R ma)).
-    rewrite <- (Rmult_assoc (Z2R ma)); bpow_simplify.
-    apply (Rmult_le_reg_r (bpow (- 2 * fexp1 (ln_beta (sqrt x)))));
+    rewrite <- Rmult_assoc; rewrite (Rmult_comm _ (IZR ma)).
+    rewrite <- (Rmult_assoc (IZR ma)); bpow_simplify.
+    apply (Rmult_le_reg_r (bpow (- 2 * fexp1 (mag (sqrt x)))));
       [now apply bpow_gt_0|bpow_simplify].
     rewrite Fx at 1; bpow_simplify.
-    rewrite <- Z2R_Zpower; [|omega].
-    change 1 with (Z2R 1); rewrite <- Z2R_plus; do 2 rewrite <- Z2R_mult.
-    apply Z2R_le, Zlt_succ_le, lt_Z2R.
-    unfold Z.succ; rewrite Z2R_plus; do 2 rewrite Z2R_mult; rewrite Z2R_plus.
-    rewrite Z2R_Zpower; [|omega].
-    apply (Rmult_lt_reg_r (bpow (2 * fexp1 (ln_beta (sqrt x)))));
+    rewrite <- IZR_Zpower; [|omega].
+    rewrite <- plus_IZR, <- 2!mult_IZR.
+    apply IZR_le, Zlt_succ_le, lt_IZR.
+    unfold Z.succ; rewrite plus_IZR; do 2 rewrite mult_IZR; rewrite plus_IZR.
+    rewrite IZR_Zpower; [|omega].
+    apply (Rmult_lt_reg_r (bpow (2 * fexp1 (mag (sqrt x)))));
       [now apply bpow_gt_0|bpow_simplify].
     rewrite <- Fx.
     change 2%Z with (1 + 1)%Z; rewrite Zmult_plus_distr_l; rewrite Zmult_1_l.
     rewrite bpow_plus; simpl.
     replace (_ * _) with (a * a + u1 * a + u1 * u1);
-      [|unfold u1, ulp, canonic_exp; rewrite Fa; ring].
+      [|unfold u1, ulp, cexp; rewrite Fa; ring].
     apply (Rle_lt_trans _ _ _ Hsr).
     rewrite Rplus_assoc; apply Rplus_lt_compat_l.
     apply (Rplus_lt_reg_r (- b' * b' + / 2 * u1 * u2)); ring_simplify.
     replace (_ + _) with ((a + / 2 * u1) * u2) by ring.
-    apply Rlt_le_trans with (bpow (ln_beta (sqrt x)) * u2).
+    apply Rlt_le_trans with (bpow (mag (sqrt x)) * u2).
     - apply Rmult_lt_compat_r; [now unfold u2, ulp; apply bpow_gt_0|].
       apply Rlt_le_trans with (a + u1); [lra|].
-      unfold u1; fold (canonic_exp beta fexp1 (sqrt x)).
-      rewrite <- canonic_exp_DN; [|exact Vfexp1|exact Pa]; fold a.
+      unfold u1; fold (cexp beta fexp1 (sqrt x)).
+      rewrite <- cexp_DN; [|exact Vfexp1|exact Pa]; fold a.
       rewrite <- ulp_neq_0; trivial.
       apply id_p_ulp_le_bpow.
       + exact Pa.
@@ -3216,25 +3190,25 @@ destruct (Req_dec a 0) as [Za|Nza].
       + apply Rle_lt_trans with (sqrt x).
         * now apply round_DN_pt.
         * apply Rabs_lt_inv.
-          apply bpow_ln_beta_gt.
+          apply bpow_mag_gt.
     - apply Rle_trans with (/ 2 * u1 ^ 2).
       + apply Rle_trans with (bpow (- 1) * u1 ^ 2).
         * unfold pow; rewrite Rmult_1_r.
-          unfold u2, u1, ulp, canonic_exp.
+          unfold u2, u1, ulp, cexp.
           bpow_simplify.
           apply bpow_le.
           rewrite Zplus_comm.
           now apply Hexp.
         * apply Rmult_le_compat_r; [now apply pow2_ge_0|].
-          unfold Fcore_Raux.bpow; simpl; unfold Z.pow_pos; simpl.
+          unfold Raux.bpow; simpl; unfold Z.pow_pos; simpl.
           rewrite Zmult_1_r.
           apply Rinv_le; [lra|].
-          change 2 with (Z2R 2); apply Z2R_le; omega.
+          apply IZR_le; omega.
       + assert (u2 ^ 2 < u1 ^ 2); [|unfold b'; lra].
         unfold pow; do 2 rewrite Rmult_1_r.
         assert (H' : 0 <= u2); [unfold u2, ulp; apply bpow_ge_0|].
         assert (u2 < u1); [|now apply Rmult_lt_compat].
-        unfold u1, u2, ulp, canonic_exp; apply bpow_lt; omega. }
+        unfold u1, u2, ulp, cexp; apply bpow_lt; omega. }
   apply (Rlt_irrefl (a * a + u1 * a)).
   apply Rlt_le_trans with (a * a + u1 * a - u2 * a + b * b).
   + rewrite <- (Rplus_0_r (a * a + _)) at 1.
@@ -3243,18 +3217,18 @@ destruct (Req_dec a 0) as [Za|Nza].
   + now apply Rle_trans with x.
 Qed.
 
-Lemma double_round_sqrt_beta_ge_4 :
+Lemma round_round_sqrt_radix_ge_4 :
   (4 <= beta)%Z ->
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_sqrt_beta_ge_4_hyp fexp1 fexp2 ->
+  round_round_sqrt_radix_ge_4_hyp fexp1 fexp2 ->
   forall x,
   generic_format beta fexp1 x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (sqrt x).
+  round_round_eq fexp1 fexp2 choice1 choice2 (sqrt x).
 Proof.
 intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x Fx.
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Rle_or_lt x 0) as [Npx|Px].
 - (* x <= 0 *)
   assert (Hs : sqrt x = 0).
@@ -3272,13 +3246,13 @@ destruct (Rle_or_lt x 0) as [Npx|Px].
   + reflexivity.
   + now apply valid_rnd_N.
 - (* 0 < x *)
-  assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
-    [now apply ln_beta_generic_gt; try assumption; lra|].
-  assert (Hfsx : (fexp1 (ln_beta (sqrt x)) < ln_beta (sqrt x))%Z).
+  assert (Hfx : (fexp1 (mag x) < mag x)%Z);
+    [now apply mag_generic_gt; try assumption; lra|].
+  assert (Hfsx : (fexp1 (mag (sqrt x)) < mag (sqrt x))%Z).
   { destruct (Rle_or_lt x 1) as [Hx|Hx].
     - (* x <= 1 *)
-      apply (valid_exp_large fexp1 (ln_beta x)); [exact Hfx|].
-      apply ln_beta_le; [exact Px|].
+      apply (valid_exp_large fexp1 (mag x)); [exact Hfx|].
+      apply mag_le; [exact Px|].
       rewrite <- (sqrt_def x) at 1; [|lra].
       rewrite <- Rmult_1_r.
       apply Rmult_le_compat_l.
@@ -3291,36 +3265,34 @@ destruct (Rle_or_lt x 0) as [Npx|Px].
       intro Hexp10.
       assert (Hf0 : (fexp1 1 < 1)%Z); [omega|clear Hexp10].
       apply (valid_exp_large fexp1 1); [exact Hf0|].
-      apply ln_beta_ge_bpow.
+      apply mag_ge_bpow.
       rewrite Zeq_minus; [|reflexivity].
-      unfold Fcore_Raux.bpow; simpl.
+      unfold Raux.bpow; simpl.
       apply Rabs_ge; right.
       rewrite <- sqrt_1.
       apply sqrt_le_1_alt.
       now apply Rlt_le. }
-  assert (Hf2 : (fexp2 (ln_beta (sqrt x)) <= fexp1 (ln_beta (sqrt x)) - 1)%Z).
-  { assert (H : (fexp1 (2 * ln_beta (sqrt x)) < 2 * ln_beta (sqrt x))%Z).
-    { destruct (ln_beta_sqrt_disj x Px) as [Hlx|Hlx].
-      - apply (valid_exp_large fexp1 (ln_beta x)); [|omega].
-        now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
+  assert (Hf2 : (fexp2 (mag (sqrt x)) <= fexp1 (mag (sqrt x)) - 1)%Z).
+  { assert (H : (fexp1 (2 * mag (sqrt x)) < 2 * mag (sqrt x))%Z).
+    { destruct (mag_sqrt_disj x Px) as [Hlx|Hlx].
+      - apply (valid_exp_large fexp1 (mag x)); [|omega].
+        now apply mag_generic_gt; [|apply Rgt_not_eq|].
       - rewrite <- Hlx.
-        now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]. }
-    generalize ((proj2 (proj2 Hexp)) (ln_beta (sqrt x)) H).
+        now apply mag_generic_gt; [|apply Rgt_not_eq|]. }
+    generalize ((proj2 (proj2 Hexp)) (mag (sqrt x)) H).
     omega. }
-  apply double_round_mid_cases.
+  apply round_round_mid_cases.
   + exact Vfexp1.
   + exact Vfexp2.
   + now apply sqrt_lt_R0.
   + omega.
   + omega.
   + intros Hmid; casetype False; apply (Rle_not_lt _ _ Hmid).
-    apply (double_round_sqrt_beta_ge_4_aux Hbeta fexp1 fexp2 Vfexp1 Vfexp2
+    apply (round_round_sqrt_radix_ge_4_aux Hbeta fexp1 fexp2 Vfexp1 Vfexp2
                                            Hexp x Px Hf2 Fx).
 Qed.
 
-Section Double_round_sqrt_beta_ge_4_FLX.
-
-Import Fcore_FLX.
+Section Double_round_sqrt_radix_ge_4_FLX.
 
 Variable prec : Z.
 Variable prec' : Z.
@@ -3328,39 +3300,36 @@ Variable prec' : Z.
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLX_double_round_sqrt_beta_ge_4_hyp :
+Lemma FLX_round_round_sqrt_radix_ge_4_hyp :
   (2 * prec + 1 <= prec')%Z ->
-  double_round_sqrt_beta_ge_4_hyp (FLX_exp prec) (FLX_exp prec').
+  round_round_sqrt_radix_ge_4_hyp (FLX_exp prec) (FLX_exp prec').
 Proof.
 intros Hprec.
 unfold FLX_exp.
 unfold Prec_gt_0 in prec_gt_0_.
-unfold double_round_sqrt_beta_ge_4_hyp; split; [|split]; intro ex; omega.
+unfold round_round_sqrt_radix_ge_4_hyp; split; [|split]; intro ex; omega.
 Qed.
 
-Theorem double_round_sqrt_beta_ge_4_FLX :
+Theorem round_round_sqrt_radix_ge_4_FLX :
   (4 <= beta)%Z ->
   forall choice1 choice2,
   (2 * prec + 1 <= prec')%Z ->
   forall x,
   FLX_format beta prec x ->
-  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (sqrt x).
+  round_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (sqrt x).
 Proof.
 intros Hbeta choice1 choice2 Hprec x Fx.
-apply double_round_sqrt_beta_ge_4.
+apply round_round_sqrt_radix_ge_4.
 - exact Hbeta.
 - now apply FLX_exp_valid.
 - now apply FLX_exp_valid.
-- now apply FLX_double_round_sqrt_beta_ge_4_hyp.
+- now apply FLX_round_round_sqrt_radix_ge_4_hyp.
 - now apply generic_format_FLX.
 Qed.
 
-End Double_round_sqrt_beta_ge_4_FLX.
+End Double_round_sqrt_radix_ge_4_FLX.
 
-Section Double_round_sqrt_beta_ge_4_FLT.
-
-Import Fcore_FLX.
-Import Fcore_FLT.
+Section Double_round_sqrt_radix_ge_4_FLT.
 
 Variable emin prec : Z.
 Variable emin' prec' : Z.
@@ -3368,17 +3337,17 @@ Variable emin' prec' : Z.
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLT_double_round_sqrt_beta_ge_4_hyp :
+Lemma FLT_round_round_sqrt_radix_ge_4_hyp :
   (emin <= 0)%Z ->
   ((emin' <= emin - prec - 1)%Z
    \/ (2 * emin' <= emin - 4 * prec)%Z) ->
   (2 * prec + 1 <= prec')%Z ->
-  double_round_sqrt_beta_ge_4_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
+  round_round_sqrt_radix_ge_4_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
 Proof.
 intros Hemin Heminprec Hprec.
 unfold FLT_exp.
 unfold Prec_gt_0 in prec_gt_0_.
-unfold double_round_sqrt_beta_ge_4_hyp; split; [|split]; intros ex.
+unfold round_round_sqrt_radix_ge_4_hyp; split; [|split]; intros ex.
 - generalize (Zmax_spec (ex - prec) emin).
   generalize (Zmax_spec (2 * ex - prec) emin).
   omega.
@@ -3391,7 +3360,7 @@ unfold double_round_sqrt_beta_ge_4_hyp; split; [|split]; intros ex.
   omega.
 Qed.
 
-Theorem double_round_sqrt_beta_ge_4_FLT :
+Theorem round_round_sqrt_radix_ge_4_FLT :
   (4 <= beta)%Z ->
   forall choice1 choice2,
   (emin <= 0)%Z ->
@@ -3400,24 +3369,21 @@ Theorem double_round_sqrt_beta_ge_4_FLT :
   (2 * prec + 1 <= prec')%Z ->
   forall x,
   FLT_format beta emin prec x ->
-  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
+  round_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                   choice1 choice2 (sqrt x).
 Proof.
 intros Hbeta choice1 choice2 Hemin Heminprec Hprec x Fx.
-apply double_round_sqrt_beta_ge_4.
+apply round_round_sqrt_radix_ge_4.
 - exact Hbeta.
 - now apply FLT_exp_valid.
 - now apply FLT_exp_valid.
-- now apply FLT_double_round_sqrt_beta_ge_4_hyp.
+- now apply FLT_round_round_sqrt_radix_ge_4_hyp.
 - now apply generic_format_FLT.
 Qed.
 
-End Double_round_sqrt_beta_ge_4_FLT.
-
-Section Double_round_sqrt_beta_ge_4_FTZ.
+End Double_round_sqrt_radix_ge_4_FLT.
 
-Import Fcore_FLX.
-Import Fcore_FTZ.
+Section Double_round_sqrt_radix_ge_4_FTZ.
 
 Variable emin prec : Z.
 Variable emin' prec' : Z.
@@ -3425,15 +3391,15 @@ Variable emin' prec' : Z.
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FTZ_double_round_sqrt_beta_ge_4_hyp :
+Lemma FTZ_round_round_sqrt_radix_ge_4_hyp :
   (2 * (emin' + prec') <= emin + prec <= 1)%Z ->
   (2 * prec + 1 <= prec')%Z ->
-  double_round_sqrt_beta_ge_4_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
+  round_round_sqrt_radix_ge_4_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
 Proof.
 intros Hemin Hprec.
 unfold FTZ_exp.
 unfold Prec_gt_0 in *.
-unfold double_round_sqrt_beta_ge_4_hyp; split; [|split]; intros ex.
+unfold round_round_sqrt_radix_ge_4_hyp; split; [|split]; intros ex.
 - destruct (Z.ltb_spec (ex - prec) emin);
   destruct (Z.ltb_spec (2 * ex - prec) emin);
   omega.
@@ -3450,47 +3416,47 @@ unfold double_round_sqrt_beta_ge_4_hyp; split; [|split]; intros ex.
     omega.
 Qed.
 
-Theorem double_round_sqrt_beta_ge_4_FTZ :
+Theorem round_round_sqrt_radix_ge_4_FTZ :
   (4 <= beta)%Z ->
   forall choice1 choice2,
   (2 * (emin' + prec') <= emin + prec <= 1)%Z ->
   (2 * prec + 1 <= prec')%Z ->
   forall x,
   FTZ_format beta emin prec x ->
-  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
+  round_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                   choice1 choice2 (sqrt x).
 Proof.
 intros Hbeta choice1 choice2 Hemin Hprec x Fx.
-apply double_round_sqrt_beta_ge_4.
+apply round_round_sqrt_radix_ge_4.
 - exact Hbeta.
 - now apply FTZ_exp_valid.
 - now apply FTZ_exp_valid.
-- now apply FTZ_double_round_sqrt_beta_ge_4_hyp.
+- now apply FTZ_round_round_sqrt_radix_ge_4_hyp.
 - now apply generic_format_FTZ.
 Qed.
 
-End Double_round_sqrt_beta_ge_4_FTZ.
+End Double_round_sqrt_radix_ge_4_FTZ.
 
-End Double_round_sqrt_beta_ge_4.
+End Double_round_sqrt_radix_ge_4.
 
 End Double_round_sqrt.
 
 Section Double_round_div.
 
-Lemma double_round_eq_mid_beta_even :
+Lemma round_round_eq_mid_beta_even :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   (exists n, (beta = 2 * n :> Z)%Z) ->
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
-  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
+  (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
+  (fexp1 (mag x) <= mag x)%Z ->
   x = midp fexp1 x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Ebeta x Px Hf2 Hf1.
-unfold double_round_eq.
+unfold round_round_eq.
 unfold midp.
 set (rd := round beta fexp1 Zfloor x).
 set (u := ulp beta fexp1 x).
@@ -3505,30 +3471,30 @@ assert (Hbeta : (2 <= beta)%Z).
 apply (Rplus_eq_compat_l rd) in Xmid; ring_simplify in Xmid.
 rewrite (round_generic beta fexp2); [reflexivity|now apply valid_rnd_N|].
 set (f := Float beta (Zfloor (scaled_mantissa beta fexp2 rd)
-                      + n * beta ^ (fexp1 (ln_beta x) - 1
-                                    - fexp2 (ln_beta x)))
-                (canonic_exp beta fexp2 x)).
+                      + n * beta ^ (fexp1 (mag x) - 1
+                                    - fexp2 (mag x)))
+                (cexp beta fexp2 x)).
 assert (Hf : F2R f = x).
 { unfold f, F2R; simpl.
-  rewrite Z2R_plus.
+  rewrite plus_IZR.
   rewrite Rmult_plus_distr_r.
-  rewrite Z2R_mult.
-  rewrite Z2R_Zpower; [|omega].
-  unfold canonic_exp at 2; bpow_simplify.
+  rewrite mult_IZR.
+  rewrite IZR_Zpower; [|omega].
+  unfold cexp at 2; bpow_simplify.
   unfold Zminus; rewrite bpow_plus.
   rewrite (Rmult_comm _ (bpow (- 1))).
-  rewrite <- (Rmult_assoc (Z2R n)).
-  change (bpow (- 1)) with (/ Z2R (beta * 1)).
+  rewrite <- (Rmult_assoc (IZR n)).
+  change (bpow (- 1)) with (/ IZR (beta * 1)).
   rewrite Zmult_1_r.
   rewrite Ebeta.
-  rewrite (Z2R_mult 2).
+  rewrite (mult_IZR 2).
   rewrite Rinv_mult_distr;
-    [|simpl; lra|change 0 with (Z2R 0); apply Z2R_neq; omega].
-  rewrite <- Rmult_assoc; rewrite (Rmult_comm (Z2R n));
-  rewrite (Rmult_assoc _ (Z2R n)).
+    [|simpl; lra | apply IZR_neq; omega].
+  rewrite <- Rmult_assoc; rewrite (Rmult_comm (IZR n));
+  rewrite (Rmult_assoc _ (IZR n)).
   rewrite Rinv_r;
-    [rewrite Rmult_1_r|change 0 with (Z2R 0); apply Z2R_neq; omega].
-  simpl; fold (canonic_exp beta fexp1 x).
+    [rewrite Rmult_1_r | apply IZR_neq; omega].
+  simpl; fold (cexp beta fexp1 x).
   rewrite <- 2!ulp_neq_0; try now apply Rgt_not_eq.
   fold u; rewrite Xmid at 2.
   apply f_equal2; [|reflexivity].
@@ -3537,7 +3503,7 @@ assert (Hf : F2R f = x).
   - (* rd = 0 *)
     rewrite Zrd.
     rewrite scaled_mantissa_0.
-    change 0 with (Z2R 0) at 1; rewrite Zfloor_Z2R.
+    rewrite Zfloor_IZR.
     now rewrite Rmult_0_l.
   - (* rd <> 0 *)
     assert (Nnrd : 0 <= rd).
@@ -3546,187 +3512,187 @@ assert (Hf : F2R f = x).
       - apply generic_format_0.
       - now apply Rlt_le. }
     assert (Prd : 0 < rd); [lra|].
-    assert (Lrd : (ln_beta rd = ln_beta x :> Z)).
+    assert (Lrd : (mag rd = mag x :> Z)).
     { apply Zle_antisym.
-      - apply ln_beta_le; [exact Prd|].
+      - apply mag_le; [exact Prd|].
         now apply round_DN_pt.
-      - apply ln_beta_round_ge.
+      - apply mag_round_ge.
         + exact Vfexp1.
         + now apply valid_rnd_DN.
         + exact Nzrd. }
     unfold scaled_mantissa.
     unfold rd at 1.
-    unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
+    unfold round, F2R, scaled_mantissa, cexp; simpl.
     bpow_simplify.
     rewrite Lrd.
-    rewrite <- (Z2R_Zpower _ (_ - _)); [|omega].
-    rewrite <- Z2R_mult.
-    rewrite (Zfloor_imp (Zfloor (x * bpow (- fexp1 (ln_beta x))) *
-                         beta ^ (fexp1 (ln_beta x) - fexp2 (ln_beta x)))).
-    + rewrite Z2R_mult.
-      rewrite Z2R_Zpower; [|omega].
+    rewrite <- (IZR_Zpower _ (_ - _)); [|omega].
+    rewrite <- mult_IZR.
+    rewrite (Zfloor_imp (Zfloor (x * bpow (- fexp1 (mag x))) *
+                         beta ^ (fexp1 (mag x) - fexp2 (mag x)))).
+    + rewrite mult_IZR.
+      rewrite IZR_Zpower; [|omega].
       bpow_simplify.
       now unfold rd.
     + split; [now apply Rle_refl|].
-      rewrite Z2R_plus.
+      rewrite plus_IZR.
       simpl; lra. }
 apply (generic_format_F2R' _ _ x f Hf).
 intros _.
-apply Zle_refl.
+apply Z.le_refl.
 Qed.
 
-Lemma double_round_really_zero :
+Lemma round_round_really_zero :
   forall (fexp1 fexp2 : Z -> Z),
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (ln_beta x <= fexp1 (ln_beta x) - 2)%Z ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  (mag x <= fexp1 (mag x) - 2)%Z ->
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf1.
-assert (Hlx : bpow (ln_beta x - 1) <= x < bpow (ln_beta x)).
-{ destruct (ln_beta x) as (ex,Hex); simpl.
+assert (Hlx : bpow (mag x - 1) <= x < bpow (mag x)).
+{ destruct (mag x) as (ex,Hex); simpl.
   rewrite <- (Rabs_right x); [|now apply Rle_ge; apply Rlt_le].
   apply Hex.
   now apply Rgt_not_eq. }
-unfold double_round_eq.
-rewrite (round_N_really_small_pos beta fexp1 _ x (ln_beta x)); [|exact Hlx|omega].
+unfold round_round_eq.
+rewrite (round_N_small_pos beta fexp1 _ x (mag x)); [|exact Hlx|omega].
 set (x'' := round beta fexp2 (Znearest choice2) x).
 destruct (Req_dec x'' 0) as [Zx''|Nzx''];
   [now rewrite Zx''; rewrite round_0; [|apply valid_rnd_N]|].
-destruct (Zle_or_lt (fexp2 (ln_beta x)) (ln_beta x)).
-- (* fexp2 (ln_beta x) <= ln_beta x *)
-  destruct (Rlt_or_le x'' (bpow (ln_beta x))).
-  + (* x'' < bpow (ln_beta x) *)
-    rewrite (round_N_really_small_pos beta fexp1 _ _ (ln_beta x));
+destruct (Zle_or_lt (fexp2 (mag x)) (mag x)).
+- (* fexp2 (mag x) <= mag x *)
+  destruct (Rlt_or_le x'' (bpow (mag x))).
+  + (* x'' < bpow (mag x) *)
+    rewrite (round_N_small_pos beta fexp1 _ _ (mag x));
     [reflexivity|split; [|exact H0]|omega].
-    apply round_large_pos_ge_pow; [now apply valid_rnd_N| |now apply Hlx].
+    apply round_large_pos_ge_bpow; [now apply valid_rnd_N| |now apply Hlx].
     fold x''; assert (0 <= x''); [|lra]; unfold x''.
     rewrite <- (round_0 beta fexp2 (Znearest choice2)).
     now apply round_le; [|apply valid_rnd_N|apply Rlt_le].
-  + (* bpow (ln_beta x) <= x'' *)
-    assert (Hx'' : x'' = bpow (ln_beta x)).
+  + (* bpow (mag x) <= x'' *)
+    assert (Hx'' : x'' = bpow (mag x)).
     { apply Rle_antisym; [|exact H0].
       rewrite <- (round_generic beta fexp2 (Znearest choice2) (bpow _)).
       - now apply round_le; [|apply valid_rnd_N|apply Rlt_le].
       - now apply generic_format_bpow'. }
     rewrite Hx''.
-    unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
-    rewrite ln_beta_bpow.
-    assert (Hf11 : (fexp1 (ln_beta x + 1) = fexp1 (ln_beta x) :> Z)%Z);
+    unfold round, F2R, scaled_mantissa, cexp; simpl.
+    rewrite mag_bpow.
+    assert (Hf11 : (fexp1 (mag x + 1) = fexp1 (mag x) :> Z)%Z);
       [apply Vfexp1; omega|].
     rewrite Hf11.
-    apply (Rmult_eq_reg_r (bpow (- fexp1 (ln_beta x))));
+    apply (Rmult_eq_reg_r (bpow (- fexp1 (mag x))));
       [|now apply Rgt_not_eq; apply bpow_gt_0].
     rewrite Rmult_0_l; bpow_simplify.
-    change 0 with (Z2R 0); apply f_equal.
+    apply IZR_eq.
     apply Znearest_imp.
     simpl; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
     rewrite Rabs_right; [|now apply Rle_ge; apply bpow_ge_0].
     apply Rle_lt_trans with (bpow (- 2)); [now apply bpow_le; omega|].
-    unfold Fcore_Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r.
+    unfold Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r.
     assert (Hbeta : (2 <= beta)%Z).
     { destruct beta as (beta_val,beta_prop); simpl.
       now apply Zle_bool_imp_le. }
     apply Rinv_lt_contravar.
     * apply Rmult_lt_0_compat; [lra|].
-      rewrite Z2R_mult; apply Rmult_lt_0_compat; change 0 with (Z2R 0);
-      apply Z2R_lt; omega.
-    * change 2 with (Z2R 2); apply Z2R_lt.
-      apply (Zle_lt_trans _ _ _ Hbeta).
+      rewrite mult_IZR; apply Rmult_lt_0_compat;
+      apply IZR_lt; omega.
+    * apply IZR_lt.
+      apply (Z.le_lt_trans _ _ _ Hbeta).
       rewrite <- (Zmult_1_r beta) at 1.
       apply Zmult_lt_compat_l; omega.
-- (* ln_beta x < fexp2 (ln_beta x) *)
+- (* mag x < fexp2 (mag x) *)
   casetype False; apply Nzx''.
-  now apply (round_N_really_small_pos beta _ _ _ (ln_beta x)).
+  now apply (round_N_small_pos beta _ _ _ (mag x)).
 Qed.
 
-Lemma double_round_zero :
+Lemma round_round_zero :
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp1 (ln_beta x) = ln_beta x + 1 :> Z)%Z ->
-  x < bpow (ln_beta x) - / 2 * ulp beta fexp2 x ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+  (fexp1 (mag x) = mag x + 1 :> Z)%Z ->
+  x < bpow (mag x) - / 2 * ulp beta fexp2 x ->
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf1.
-unfold double_round_eq.
+unfold round_round_eq.
 set (x'' := round beta fexp2 (Znearest choice2) x).
 set (u1 := ulp beta fexp1 x).
 set (u2 := ulp beta fexp2 x).
 intro Hx.
-assert (Hlx : bpow (ln_beta x - 1) <= x < bpow (ln_beta x)).
-{ destruct (ln_beta x) as (ex,Hex); simpl.
+assert (Hlx : bpow (mag x - 1) <= x < bpow (mag x)).
+{ destruct (mag x) as (ex,Hex); simpl.
   rewrite <- (Rabs_right x); [|now apply Rle_ge; apply Rlt_le].
   apply Hex.
   now apply Rgt_not_eq. }
-rewrite (round_N_really_small_pos beta fexp1 choice1 x (ln_beta x));
+rewrite (round_N_small_pos beta fexp1 choice1 x (mag x));
   [|exact Hlx|omega].
 destruct (Req_dec x'' 0) as [Zx''|Nzx''];
   [now rewrite Zx''; rewrite round_0; [reflexivity|apply valid_rnd_N]|].
-rewrite (round_N_really_small_pos beta _ _ x'' (ln_beta x));
+rewrite (round_N_small_pos beta _ _ x'' (mag x));
   [reflexivity| |omega].
 split.
-- apply round_large_pos_ge_pow.
+- apply round_large_pos_ge_bpow.
   + now apply valid_rnd_N.
   + assert (0 <= x''); [|now fold x''; lra].
     rewrite <- (round_0 beta fexp2 (Znearest choice2)).
     now apply round_le; [|apply valid_rnd_N|apply Rlt_le].
   + apply Rle_trans with (Rabs x);
     [|now rewrite Rabs_right; [apply Rle_refl|apply Rle_ge; apply Rlt_le]].
-    destruct (ln_beta x) as (ex,Hex); simpl; apply Hex.
+    destruct (mag x) as (ex,Hex); simpl; apply Hex.
     now apply Rgt_not_eq.
 - replace x'' with (x + (x'' - x)) by ring.
-  replace (bpow _) with (bpow (ln_beta x) - / 2 * u2 + / 2 * u2) by ring.
+  replace (bpow _) with (bpow (mag x) - / 2 * u2 + / 2 * u2) by ring.
   apply Rplus_lt_le_compat; [exact Hx|].
   apply Rabs_le_inv.
   now apply error_le_half_ulp.
 Qed.
 
-Lemma double_round_all_mid_cases :
+Lemma round_round_all_mid_cases :
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   forall x,
   0 < x ->
-  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
-  ((fexp1 (ln_beta x) = ln_beta x + 1 :> Z)%Z ->
-   bpow (ln_beta x) - / 2 * ulp beta fexp2 x <= x ->
-   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
-  ((fexp1 (ln_beta x) <= ln_beta x)%Z ->
+  (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
+  ((fexp1 (mag x) = mag x + 1 :> Z)%Z ->
+   bpow (mag x) - / 2 * ulp beta fexp2 x <= x ->
+   round_round_eq fexp1 fexp2 choice1 choice2 x) ->
+  ((fexp1 (mag x) <= mag x)%Z ->
    midp fexp1 x - / 2 * ulp beta fexp2 x <= x < midp fexp1 x ->
-   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
-  ((fexp1 (ln_beta x) <= ln_beta x)%Z ->
+   round_round_eq fexp1 fexp2 choice1 choice2 x) ->
+  ((fexp1 (mag x) <= mag x)%Z ->
    x = midp fexp1 x ->
-   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
-  ((fexp1 (ln_beta x) <= ln_beta x)%Z ->
+   round_round_eq fexp1 fexp2 choice1 choice2 x) ->
+  ((fexp1 (mag x) <= mag x)%Z ->
    midp fexp1 x < x <= midp fexp1 x + / 2 * ulp beta fexp2 x ->
-   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
-  double_round_eq fexp1 fexp2 choice1 choice2 x.
+   round_round_eq fexp1 fexp2 choice1 choice2 x) ->
+  round_round_eq fexp1 fexp2 choice1 choice2 x.
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2.
 set (x' := round beta fexp1 Zfloor x).
 set (u1 := ulp beta fexp1 x).
 set (u2 := ulp beta fexp2 x).
 intros Cz Clt Ceq Cgt.
-destruct (Ztrichotomy (ln_beta x) (fexp1 (ln_beta x) - 1)) as [Hlt|[Heq|Hgt]].
-- (* ln_beta x < fexp1 (ln_beta x) - 1 *)
-  assert (H : (ln_beta x <= fexp1 (ln_beta x) - 2)%Z) by omega.
-  now apply double_round_really_zero.
-- (* ln_beta x = fexp1 (ln_beta x) - 1 *)
-  assert (H : (fexp1 (ln_beta x) = (ln_beta x + 1))%Z) by omega.
-  destruct (Rlt_or_le x (bpow (ln_beta x) - / 2 * u2)) as [Hlt'|Hge'].
-  + now apply double_round_zero.
+destruct (Ztrichotomy (mag x) (fexp1 (mag x) - 1)) as [Hlt|[Heq|Hgt]].
+- (* mag x < fexp1 (mag x) - 1 *)
+  assert (H : (mag x <= fexp1 (mag x) - 2)%Z) by omega.
+  now apply round_round_really_zero.
+- (* mag x = fexp1 (mag x) - 1 *)
+  assert (H : (fexp1 (mag x) = (mag x + 1))%Z) by omega.
+  destruct (Rlt_or_le x (bpow (mag x) - / 2 * u2)) as [Hlt'|Hge'].
+  + now apply round_round_zero.
   + now apply Cz.
-- (* ln_beta x > fexp1 (ln_beta x) - 1 *)
-  assert (H : (fexp1 (ln_beta x) <= ln_beta x)%Z) by omega.
+- (* mag x > fexp1 (mag x) - 1 *)
+  assert (H : (fexp1 (mag x) <= mag x)%Z) by omega.
   destruct (Rtotal_order x (midp fexp1 x)) as [Hlt'|[Heq'|Hgt']].
   + (* x < midp fexp1 x *)
     destruct (Rlt_or_le x (midp fexp1 x - / 2 * u2)) as [Hlt''|Hle''].
-    * now apply double_round_lt_mid_further_place; [| | |omega| |].
+    * now apply round_round_lt_mid_further_place; [| | |omega| |].
     * now apply Clt; [|split].
   + (* x = midp fexp1 x *)
     now apply Ceq.
@@ -3735,33 +3701,33 @@ destruct (Ztrichotomy (ln_beta x) (fexp1 (ln_beta x) - 1)) as [Hlt|[Heq|Hgt]].
     * now apply Cgt; [|split].
     * { destruct (generic_format_EM beta fexp1 x) as [Fx|Nfx].
         - (* generic_format beta fexp1 x *)
-          unfold double_round_eq; rewrite (round_generic beta fexp2);
+          unfold round_round_eq; rewrite (round_generic beta fexp2);
           [reflexivity|now apply valid_rnd_N|].
-          now apply (generic_inclusion_ln_beta beta fexp1); [omega|].
+          now apply (generic_inclusion_mag beta fexp1); [omega|].
         - (* ~ generic_format beta fexp1 x *)
           assert (Hceil : round beta fexp1 Zceil x = x' + u1);
           [now apply round_UP_DN_ulp|].
-          assert (Hf2' : (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z);
+          assert (Hf2' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z);
             [omega|].
           assert (midp' fexp1 x + / 2 * ulp beta fexp2 x < x);
-            [|now apply double_round_gt_mid_further_place].
+            [|now apply round_round_gt_mid_further_place].
           revert Hle''; unfold midp, midp'; fold x'.
           rewrite Hceil; fold u1; fold u2.
           lra. }
 Qed.
 
-Lemma ln_beta_div_disj :
+Lemma mag_div_disj :
   forall x y : R,
   0 < x -> 0 < y ->
-  ((ln_beta (x / y) = ln_beta x - ln_beta y :> Z)%Z
-   \/ (ln_beta (x / y) = ln_beta x - ln_beta y + 1 :> Z)%Z).
+  ((mag (x / y) = mag x - mag y :> Z)%Z
+   \/ (mag (x / y) = mag x - mag y + 1 :> Z)%Z).
 Proof.
 intros x y Px Py.
-generalize (ln_beta_div beta x y Px Py).
+generalize (mag_div beta x y (Rgt_not_eq _ _ Px) (Rgt_not_eq _ _ Py)).
 omega.
 Qed.
 
-Definition double_round_div_hyp fexp1 fexp2 :=
+Definition round_round_div_hyp fexp1 fexp2 :=
   (forall ex, (fexp2 ex <= fexp1 ex - 1)%Z)
   /\ (forall ex ey, (fexp1 ex < ex)%Z -> (fexp1 ey < ey)%Z ->
                     (fexp1 (ex - ey) <= ex - ey + 1)%Z ->
@@ -3777,63 +3743,63 @@ Definition double_round_div_hyp fexp1 fexp2 :=
                     (fexp1 (ex - ey) = ex - ey + 1)%Z ->
                     (fexp2 (ex - ey) <= ex - ey - ey + fexp1 ey)%Z).
 
-Lemma double_round_div_aux0 :
+Lemma round_round_div_aux0 :
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_div_hyp fexp1 fexp2 ->
+  round_round_div_hyp fexp1 fexp2 ->
   forall x y,
   0 < x -> 0 < y ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  fexp1 (ln_beta (x / y)) = (ln_beta (x / y) + 1)%Z ->
-  ~ (bpow (ln_beta (x / y)) - / 2 * ulp beta fexp2 (x / y) <= x / y).
+  fexp1 (mag (x / y)) = (mag (x / y) + 1)%Z ->
+  ~ (bpow (mag (x / y)) - / 2 * ulp beta fexp2 (x / y) <= x / y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Fx Fy Hf1.
-assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-set (p := bpow (ln_beta (x / y))).
-set (u2 := bpow (fexp2 (ln_beta (x / y)))).
+assert (Hfx : (fexp1 (mag x) < mag x)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfy : (fexp1 (mag y) < mag y)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+set (p := bpow (mag (x / y))).
+set (u2 := bpow (fexp2 (mag (x / y)))).
 revert Fx Fy.
-unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
-set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
-set (my := Ztrunc (y * bpow (- fexp1 (ln_beta y)))).
+unfold generic_format, F2R, scaled_mantissa, cexp; simpl.
+set (mx := Ztrunc (x * bpow (- fexp1 (mag x)))).
+set (my := Ztrunc (y * bpow (- fexp1 (mag y)))).
 intros Fx Fy.
 rewrite ulp_neq_0.
 2: apply Rmult_integral_contrapositive_currified; [now apply Rgt_not_eq|idtac].
 2: now apply Rinv_neq_0_compat, Rgt_not_eq.
 intro Hl.
 assert (Hr : x / y < p);
-  [now apply Rabs_lt_inv; apply bpow_ln_beta_gt|].
+  [now apply Rabs_lt_inv; apply bpow_mag_gt|].
 apply (Rlt_irrefl (p - / 2 * u2)).
 apply (Rle_lt_trans _ _ _ Hl).
 apply (Rmult_lt_reg_r y _ _ Py).
 unfold Rdiv; rewrite Rmult_assoc.
 rewrite Rinv_l; [|now apply Rgt_not_eq]; rewrite Rmult_1_r.
-destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - ln_beta (x / y)
-                        - fexp1 (ln_beta y))%Z) as [He|He].
-- (* ln_beta (x / y) + fexp1 (ln_beta y) <= fexp1 (ln_beta x) *)
-  apply Rle_lt_trans with (p * y - p * bpow (fexp1 (ln_beta y))).
+destruct (Zle_or_lt Z0 (fexp1 (mag x) - mag (x / y)
+                        - fexp1 (mag y))%Z) as [He|He].
+- (* mag (x / y) + fexp1 (mag y) <= fexp1 (mag x) *)
+  apply Rle_lt_trans with (p * y - p * bpow (fexp1 (mag y))).
   + rewrite Fx; rewrite Fy at 1.
     rewrite <- Rmult_assoc.
     rewrite (Rmult_comm p).
     unfold p; bpow_simplify.
-    apply (Rmult_le_reg_r (bpow (- ln_beta (x / y) - fexp1 (ln_beta y))));
+    apply (Rmult_le_reg_r (bpow (- mag (x / y) - fexp1 (mag y))));
       [now apply bpow_gt_0|].
     rewrite Rmult_minus_distr_r.
     bpow_simplify.
-    rewrite <- Z2R_Zpower; [|exact He].
-    rewrite <- Z2R_mult.
-    change 1 with (Z2R 1); rewrite <- Z2R_minus.
-    apply Z2R_le.
+    rewrite <- IZR_Zpower; [|exact He].
+    rewrite <- mult_IZR.
+    rewrite <- minus_IZR.
+    apply IZR_le.
     apply (Zplus_le_reg_r _ _ 1); ring_simplify.
     apply Zlt_le_succ.
-    apply lt_Z2R.
-    rewrite Z2R_mult.
-    rewrite Z2R_Zpower; [|exact He].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta y) + ln_beta (x / y))));
+    apply lt_IZR.
+    rewrite mult_IZR.
+    rewrite IZR_Zpower; [|exact He].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag y) + mag (x / y))));
       [now apply bpow_gt_0|].
     bpow_simplify.
     rewrite <- Fx.
@@ -3845,7 +3811,7 @@ destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - ln_beta (x / y)
   + rewrite Rmult_minus_distr_r.
     unfold Rminus; apply Rplus_lt_compat_l.
     apply Ropp_lt_contravar.
-    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
+    apply Rlt_le_trans with (u2 * bpow (mag y)).
     * rewrite <- (Rmult_1_l (u2 * _)).
       rewrite Rmult_assoc.
       { apply Rmult_lt_compat.
@@ -3854,38 +3820,38 @@ destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - ln_beta (x / y)
         - lra.
         - apply Rmult_lt_compat_l; [now apply bpow_gt_0|].
           apply Rabs_lt_inv.
-          apply bpow_ln_beta_gt. }
-    * unfold u2, p, ulp, canonic_exp; bpow_simplify; apply bpow_le.
-      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
-      rewrite (Zplus_comm (- _)); fold (Zminus (ln_beta (x / y)) (ln_beta y)).
-      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
+          apply bpow_mag_gt. }
+    * unfold u2, p, ulp, cexp; bpow_simplify; apply bpow_le.
+      apply (Zplus_le_reg_r _ _ (- mag y)); ring_simplify.
+      rewrite (Zplus_comm (- _)); fold (Zminus (mag (x / y)) (mag y)).
+      destruct (mag_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
       [now apply Hexp; [| |rewrite <- Hxy]|].
-      replace (_ - _ + 1)%Z with ((ln_beta x + 1) - ln_beta y)%Z by ring.
+      replace (_ - _ + 1)%Z with ((mag x + 1) - mag y)%Z by ring.
       apply Hexp.
-      { now assert (fexp1 (ln_beta x + 1) <= ln_beta x)%Z;
+      { now assert (fexp1 (mag x + 1) <= mag x)%Z;
         [apply valid_exp|omega]. }
       { assumption. }
-      replace (_ + 1 - _)%Z with (ln_beta x - ln_beta y + 1)%Z by ring.
+      replace (_ + 1 - _)%Z with (mag x - mag y + 1)%Z by ring.
       now rewrite <- Hxy.
-- (* fexp1 (ln_beta x) < ln_beta (x / y) + fexp1 (ln_beta y) *)
-  apply Rle_lt_trans with (p * y - bpow (fexp1 (ln_beta x))).
+- (* fexp1 (mag x) < mag (x / y) + fexp1 (mag y) *)
+  apply Rle_lt_trans with (p * y - bpow (fexp1 (mag x))).
   + rewrite Fx at 1; rewrite Fy at 1.
-    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
+    apply (Rmult_le_reg_r (bpow (- fexp1 (mag x))));
       [now apply bpow_gt_0|].
     rewrite Rmult_minus_distr_r.
     bpow_simplify.
     rewrite (Rmult_comm p).
     unfold p; bpow_simplify.
-    rewrite <- Z2R_Zpower; [|omega].
-    rewrite <- Z2R_mult.
-    change 1 with (Z2R 1); rewrite <- Z2R_minus.
-    apply Z2R_le.
+    rewrite <- IZR_Zpower; [|omega].
+    rewrite <- mult_IZR.
+    rewrite <- minus_IZR.
+    apply IZR_le.
     apply (Zplus_le_reg_r _ _ 1); ring_simplify.
     apply Zlt_le_succ.
-    apply lt_Z2R.
-    rewrite Z2R_mult.
-    rewrite Z2R_Zpower; [|omega].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x))));
+    apply lt_IZR.
+    rewrite mult_IZR.
+    rewrite IZR_Zpower; [|omega].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag x))));
       [now apply bpow_gt_0|bpow_simplify].
     rewrite <- Fx.
     rewrite Zplus_comm; rewrite bpow_plus.
@@ -3896,7 +3862,7 @@ destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - ln_beta (x / y)
   + rewrite Rmult_minus_distr_r.
     unfold Rminus; apply Rplus_lt_compat_l.
     apply Ropp_lt_contravar.
-    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
+    apply Rlt_le_trans with (u2 * bpow (mag y)).
     * rewrite <- (Rmult_1_l (u2 * _)).
       rewrite Rmult_assoc.
       { apply Rmult_lt_compat.
@@ -3905,33 +3871,33 @@ destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - ln_beta (x / y)
         - lra.
         - apply Rmult_lt_compat_l; [now apply bpow_gt_0|].
           apply Rabs_lt_inv.
-          apply bpow_ln_beta_gt. }
-    * unfold u2, p, ulp, canonic_exp; bpow_simplify; apply bpow_le.
-      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
-      rewrite (Zplus_comm (- _)); fold (Zminus (ln_beta (x / y)) (ln_beta y)).
-      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
-      apply Hexp; try assumption; rewrite <- Hxy; rewrite Hf1; apply Zle_refl.
+          apply bpow_mag_gt. }
+    * unfold u2, p, ulp, cexp; bpow_simplify; apply bpow_le.
+      apply (Zplus_le_reg_r _ _ (- mag y)); ring_simplify.
+      rewrite (Zplus_comm (- _)); fold (Zminus (mag (x / y)) (mag y)).
+      destruct (mag_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
+      apply Hexp; try assumption; rewrite <- Hxy; rewrite Hf1; apply Z.le_refl.
 Qed.
 
-Lemma double_round_div_aux1 :
+Lemma round_round_div_aux1 :
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_div_hyp fexp1 fexp2 ->
+  round_round_div_hyp fexp1 fexp2 ->
   forall x y,
   0 < x -> 0 < y ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  (fexp1 (ln_beta (x / y)) <= ln_beta (x / y))%Z ->
+  (fexp1 (mag (x / y)) <= mag (x / y))%Z ->
   ~ (midp fexp1 (x / y) - / 2 * ulp beta fexp2 (x / y)
      <= x / y
      < midp fexp1 (x / y)).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Fx Fy Hf1.
-assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfx : (fexp1 (mag x) < mag x)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfy : (fexp1 (mag y) < mag y)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
 assert (S : (x / y <> 0)%R).
 apply Rmult_integral_contrapositive_currified; [now apply Rgt_not_eq|idtac].
 now apply Rinv_neq_0_compat, Rgt_not_eq.
@@ -3945,14 +3911,14 @@ cut (~ (/ 2 * (ulp beta fexp1 (x / y) - ulp beta fexp2 (x / y))
   - apply (Rplus_lt_reg_l (round beta fexp1 Zfloor (x / y))).
     ring_simplify.
     apply H'. }
-set (u1 := bpow (fexp1 (ln_beta (x / y)))).
-set (u2 := bpow (fexp2 (ln_beta (x / y)))).
+set (u1 := bpow (fexp1 (mag (x / y)))).
+set (u2 := bpow (fexp2 (mag (x / y)))).
 set (x' := round beta fexp1 Zfloor (x / y)).
 rewrite 2!ulp_neq_0; trivial.
 revert Fx Fy.
-unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
-set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
-set (my := Ztrunc (y * bpow (- fexp1 (ln_beta y)))).
+unfold generic_format, F2R, scaled_mantissa, cexp; simpl.
+set (mx := Ztrunc (x * bpow (- fexp1 (mag x)))).
+set (my := Ztrunc (y * bpow (- fexp1 (mag y)))).
 intros Fx Fy.
 intro Hlr.
 apply (Rlt_irrefl (/ 2 * (u1 - u2))).
@@ -3966,48 +3932,47 @@ apply (Rmult_lt_reg_l 2); [lra|].
 rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_l.
 do 5 rewrite <- Rmult_assoc.
 rewrite Rinv_r; [|lra]; do 2 rewrite Rmult_1_l.
-destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - fexp1 (ln_beta (x / y))
-                     - fexp1 (ln_beta y))%Z) as [He|He].
-- (* fexp1 (ln_beta (x / y)) + fexp1 (ln_beta y)) <= fexp1 (ln_beta x) *)
+destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y))
+                     - fexp1 (mag y))%Z) as [He|He].
+- (* fexp1 (mag (x / y)) + fexp1 (mag y)) <= fexp1 (mag x) *)
   apply Rle_lt_trans with (2 * x' * y + u1 * y
-                                        - bpow (fexp1 (ln_beta (x / y))
-                                                + fexp1 (ln_beta y))).
+                                        - bpow (fexp1 (mag (x / y))
+                                                + fexp1 (mag y))).
   + rewrite Fx at 1; rewrite Fy at 1 2.
-    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta (x / y))
-                                 - fexp1 (ln_beta y))));
+    apply (Rmult_le_reg_r (bpow (- fexp1 (mag (x / y))
+                                 - fexp1 (mag y))));
       [now apply bpow_gt_0|].
     rewrite Rmult_minus_distr_r; rewrite (Rmult_plus_distr_r (_ * _ * _)).
     bpow_simplify.
     replace (2 * x' * _ * _)
-    with (2 * Z2R my * x' * bpow (- fexp1 (ln_beta (x / y)))) by ring.
+    with (2 * IZR my * x' * bpow (- fexp1 (mag (x / y)))) by ring.
     rewrite (Rmult_comm u1).
-    unfold x', u1, round, F2R, ulp, scaled_mantissa, canonic_exp; simpl.
+    unfold x', u1, round, F2R, ulp, scaled_mantissa, cexp; simpl.
     bpow_simplify.
-    rewrite <- Z2R_Zpower; [|exact He].
-    change 2 with (Z2R 2).
-    do 4 rewrite <- Z2R_mult.
-    rewrite <- Z2R_plus.
-    change 1 with (Z2R 1); rewrite <- Z2R_minus.
-    apply Z2R_le.
+    rewrite <- IZR_Zpower; [|exact He].
+    do 4 rewrite <- mult_IZR.
+    rewrite <- plus_IZR.
+    rewrite <- minus_IZR.
+    apply IZR_le.
     apply (Zplus_le_reg_r _ _ 1); ring_simplify.
     apply Zlt_le_succ.
-    apply lt_Z2R.
-    rewrite Z2R_plus.
-    do 4 rewrite Z2R_mult; simpl.
-    rewrite Z2R_Zpower; [|exact He].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta (x / y))
-                                 + fexp1 (ln_beta y))));
+    apply lt_IZR.
+    rewrite plus_IZR.
+    do 4 rewrite mult_IZR; simpl.
+    rewrite IZR_Zpower; [|exact He].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag (x / y))
+                                 + fexp1 (mag y))));
       [now apply bpow_gt_0|bpow_simplify].
     rewrite Rmult_assoc.
     rewrite <- Fx.
-    rewrite (Rmult_plus_distr_r _ _ (Fcore_Raux.bpow _ _)).
+    rewrite (Rmult_plus_distr_r _ _ (Raux.bpow _ _)).
     rewrite Rmult_assoc.
     rewrite bpow_plus.
-    rewrite <- (Rmult_assoc (Z2R (Zfloor _))).
-    change (Z2R (Zfloor _) * _) with x'.
-    do 2 rewrite (Rmult_comm _ (bpow (fexp1 (ln_beta y)))).
+    rewrite <- (Rmult_assoc (IZR (Zfloor _))).
+    change (IZR (Zfloor _) * _) with x'.
+    do 2 rewrite (Rmult_comm _ (bpow (fexp1 (mag y)))).
     rewrite Rmult_assoc.
-    do 2 rewrite <- (Rmult_assoc (Z2R my)).
+    do 2 rewrite <- (Rmult_assoc (IZR my)).
     rewrite <- Fy.
     change (bpow _) with u1.
     apply (Rmult_lt_reg_l (/ 2)); [lra|].
@@ -4022,60 +3987,59 @@ destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - fexp1 (ln_beta (x / y))
     now rewrite Rmult_comm.
   + apply Rplus_lt_compat_l.
     apply Ropp_lt_contravar.
-    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
+    apply Rlt_le_trans with (u2 * bpow (mag y)).
     * { apply Rmult_lt_compat_l.
         - apply bpow_gt_0.
         - apply Rabs_lt_inv.
-          apply bpow_ln_beta_gt. }
-    * unfold u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
-      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
+          apply bpow_mag_gt. }
+    * unfold u2, ulp, cexp; bpow_simplify; apply bpow_le.
+      apply (Zplus_le_reg_r _ _ (- mag y)); ring_simplify.
       rewrite <- Zplus_assoc; rewrite (Zplus_comm (- _)).
-      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
+      destruct (mag_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
       [now apply Hexp; [| |rewrite <- Hxy]|].
-      replace (_ - _ + 1)%Z with ((ln_beta x + 1) - ln_beta y)%Z by ring.
+      replace (_ - _ + 1)%Z with ((mag x + 1) - mag y)%Z by ring.
       apply Hexp.
-      { now assert (fexp1 (ln_beta x + 1) <= ln_beta x)%Z;
+      { now assert (fexp1 (mag x + 1) <= mag x)%Z;
         [apply valid_exp|omega]. }
       { assumption. }
-      replace (_ + 1 - _)%Z with (ln_beta x - ln_beta y + 1)%Z by ring.
+      replace (_ + 1 - _)%Z with (mag x - mag y + 1)%Z by ring.
       now rewrite <- Hxy.
-- (* fexp1 (ln_beta x) < fexp1 (ln_beta (x / y)) + fexp1 (ln_beta y) *)
-  apply Rle_lt_trans with (2 * x' * y + u1 * y - bpow (fexp1 (ln_beta x))).
+- (* fexp1 (mag x) < fexp1 (mag (x / y)) + fexp1 (mag y) *)
+  apply Rle_lt_trans with (2 * x' * y + u1 * y - bpow (fexp1 (mag x))).
   + rewrite Fx at 1; rewrite Fy at 1 2.
-    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
+    apply (Rmult_le_reg_r (bpow (- fexp1 (mag x))));
       [now apply bpow_gt_0|].
     rewrite Rmult_minus_distr_r; rewrite (Rmult_plus_distr_r (_ * _ * _)).
     bpow_simplify.
     replace (2 * x' * _ * _)
-    with (2 * Z2R my * x' * bpow (fexp1 (ln_beta y) - fexp1 (ln_beta x))) by ring.
+    with (2 * IZR my * x' * bpow (fexp1 (mag y) - fexp1 (mag x))) by ring.
     rewrite (Rmult_comm u1).
-    unfold x', u1, round, F2R, ulp, scaled_mantissa, canonic_exp; simpl.
+    unfold x', u1, round, F2R, ulp, scaled_mantissa, cexp; simpl.
     bpow_simplify.
-    rewrite <- (Z2R_Zpower _ (_ - _)%Z); [|omega].
-    change 2 with (Z2R 2).
-    do 5 rewrite <- Z2R_mult.
-    rewrite <- Z2R_plus.
-    change 1 with (Z2R 1); rewrite <- Z2R_minus.
-    apply Z2R_le.
+    rewrite <- (IZR_Zpower _ (_ - _)%Z); [|omega].
+    do 5 rewrite <- mult_IZR.
+    rewrite <- plus_IZR.
+    rewrite <- minus_IZR.
+    apply IZR_le.
     apply (Zplus_le_reg_r _ _ 1); ring_simplify.
     apply Zlt_le_succ.
-    apply lt_Z2R.
-    rewrite Z2R_plus.
-    do 5 rewrite Z2R_mult; simpl.
-    rewrite Z2R_Zpower; [|omega].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x))));
+    apply lt_IZR.
+    rewrite plus_IZR.
+    do 5 rewrite mult_IZR; simpl.
+    rewrite IZR_Zpower; [|omega].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag x))));
       [now apply bpow_gt_0|].
     rewrite Rmult_assoc.
     rewrite <- Fx.
-    rewrite (Rmult_plus_distr_r _ _ (Fcore_Raux.bpow _ _)).
+    rewrite (Rmult_plus_distr_r _ _ (Raux.bpow _ _)).
     bpow_simplify.
     rewrite Rmult_assoc.
     rewrite bpow_plus.
-    rewrite <- (Rmult_assoc (Z2R (Zfloor _))).
-    change (Z2R (Zfloor _) * _) with x'.
-    do 2 rewrite (Rmult_comm _ (bpow (fexp1 (ln_beta y)))).
+    rewrite <- (Rmult_assoc (IZR (Zfloor _))).
+    change (IZR (Zfloor _) * _) with x'.
+    do 2 rewrite (Rmult_comm _ (bpow (fexp1 (mag y)))).
     rewrite Rmult_assoc.
-    do 2 rewrite <- (Rmult_assoc (Z2R my)).
+    do 2 rewrite <- (Rmult_assoc (IZR my)).
     rewrite <- Fy.
     change (bpow _) with u1.
     apply (Rmult_lt_reg_l (/ 2)); [lra|].
@@ -4090,37 +4054,37 @@ destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - fexp1 (ln_beta (x / y))
     now rewrite Rmult_comm.
   + apply Rplus_lt_compat_l.
     apply Ropp_lt_contravar.
-    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
+    apply Rlt_le_trans with (u2 * bpow (mag y)).
     * { apply Rmult_lt_compat_l.
         - apply bpow_gt_0.
         - apply Rabs_lt_inv.
-          apply bpow_ln_beta_gt. }
-    * unfold u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
-      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
+          apply bpow_mag_gt. }
+    * unfold u2, ulp, cexp; bpow_simplify; apply bpow_le.
+      apply (Zplus_le_reg_r _ _ (- mag y)); ring_simplify.
       rewrite (Zplus_comm (- _)).
-      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
+      destruct (mag_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
       apply Hexp; try assumption; rewrite <- Hxy; omega.
 Qed.
 
-Lemma double_round_div_aux2 :
+Lemma round_round_div_aux2 :
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
-  double_round_div_hyp fexp1 fexp2 ->
+  round_round_div_hyp fexp1 fexp2 ->
   forall x y,
   0 < x -> 0 < y ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  (fexp1 (ln_beta (x / y)) <= ln_beta (x / y))%Z ->
+  (fexp1 (mag (x / y)) <= mag (x / y))%Z ->
   ~ (midp fexp1 (x / y)
      < x / y
      <= midp fexp1 (x / y) + / 2 * ulp beta fexp2 (x / y)).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Fx Fy Hf1.
-assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
-assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
-  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfx : (fexp1 (mag x) < mag x)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
+assert (Hfy : (fexp1 (mag y) < mag y)%Z);
+  [now apply mag_generic_gt; [|apply Rgt_not_eq|]|].
 cut (~ (/ 2 * ulp beta fexp1 (x / y)
         < x / y - round beta fexp1 Zfloor (x / y)
         <= / 2 * (ulp beta fexp1 (x / y) + ulp beta fexp2 (x / y)))).
@@ -4131,17 +4095,17 @@ cut (~ (/ 2 * ulp beta fexp1 (x / y)
   - apply (Rplus_le_reg_l (round beta fexp1 Zfloor (x / y))).
     ring_simplify.
     apply H'. }
-set (u1 := bpow (fexp1 (ln_beta (x / y)))).
-set (u2 := bpow (fexp2 (ln_beta (x / y)))).
+set (u1 := bpow (fexp1 (mag (x / y)))).
+set (u2 := bpow (fexp2 (mag (x / y)))).
 set (x' := round beta fexp1 Zfloor (x / y)).
 assert (S : (x / y <> 0)%R).
 apply Rmult_integral_contrapositive_currified; [now apply Rgt_not_eq|idtac].
 now apply Rinv_neq_0_compat, Rgt_not_eq.
 rewrite 2!ulp_neq_0; trivial.
 revert Fx Fy.
-unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
-set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
-set (my := Ztrunc (y * bpow (- fexp1 (ln_beta y)))).
+unfold generic_format, F2R, scaled_mantissa, cexp; simpl.
+set (mx := Ztrunc (x * bpow (- fexp1 (mag x)))).
+set (my := Ztrunc (y * bpow (- fexp1 (mag y)))).
 intros Fx Fy.
 intro Hlr.
 apply (Rlt_irrefl (/ 2 * (u1 + u2))).
@@ -4155,76 +4119,75 @@ apply (Rmult_lt_reg_l 2); [lra|].
 do 2 rewrite Rmult_plus_distr_l.
 do 5 rewrite <- Rmult_assoc.
 rewrite Rinv_r; [|lra]; do 2 rewrite Rmult_1_l.
-destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - fexp1 (ln_beta (x / y))
-                     - fexp1 (ln_beta y))%Z) as [He|He].
-- (* fexp1 (ln_beta (x / y)) + fexp1 (ln_beta y) <= fexp1 (ln_beta x) *)
-  apply Rlt_le_trans with (u1 * y + bpow (fexp1 (ln_beta (x / y))
-                                          + fexp1 (ln_beta y))
+destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y))
+                     - fexp1 (mag y))%Z) as [He|He].
+- (* fexp1 (mag (x / y)) + fexp1 (mag y) <= fexp1 (mag x) *)
+  apply Rlt_le_trans with (u1 * y + bpow (fexp1 (mag (x / y))
+                                          + fexp1 (mag y))
                            + 2 * x' * y).
   + apply Rplus_lt_compat_r, Rplus_lt_compat_l.
-    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
+    apply Rlt_le_trans with (u2 * bpow (mag y)).
     * { apply Rmult_lt_compat_l.
         - apply bpow_gt_0.
         - apply Rabs_lt_inv.
-          apply bpow_ln_beta_gt. }
-    * unfold u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
-      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
+          apply bpow_mag_gt. }
+    * unfold u2, ulp, cexp; bpow_simplify; apply bpow_le.
+      apply (Zplus_le_reg_r _ _ (- mag y)); ring_simplify.
       rewrite <- Zplus_assoc; rewrite (Zplus_comm (- _)).
-      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
+      destruct (mag_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
       [now apply Hexp; [| |rewrite <- Hxy]|].
-      replace (_ - _ + 1)%Z with ((ln_beta x + 1) - ln_beta y)%Z by ring.
+      replace (_ - _ + 1)%Z with ((mag x + 1) - mag y)%Z by ring.
       apply Hexp.
-      { now assert (fexp1 (ln_beta x + 1) <= ln_beta x)%Z;
+      { now assert (fexp1 (mag x + 1) <= mag x)%Z;
         [apply valid_exp|omega]. }
       { assumption. }
-      replace (_ + 1 - _)%Z with (ln_beta x - ln_beta y + 1)%Z by ring.
+      replace (_ + 1 - _)%Z with (mag x - mag y + 1)%Z by ring.
       now rewrite <- Hxy.
   + apply Rge_le; rewrite Fx at 1; apply Rle_ge.
-    replace (u1 * y) with (u1 * (Z2R my * bpow (fexp1 (ln_beta y))));
+    replace (u1 * y) with (u1 * (IZR my * bpow (fexp1 (mag y))));
       [|now apply eq_sym; rewrite Fy at 1].
-    replace (2 * x' * y) with (2 * x' * (Z2R my * bpow (fexp1 (ln_beta y))));
+    replace (2 * x' * y) with (2 * x' * (IZR my * bpow (fexp1 (mag y))));
       [|now apply eq_sym; rewrite Fy at 1].
-    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta (x / y))
-                                 - fexp1 (ln_beta y))));
+    apply (Rmult_le_reg_r (bpow (- fexp1 (mag (x / y))
+                                 - fexp1 (mag y))));
       [now apply bpow_gt_0|].
     do 2 rewrite Rmult_plus_distr_r.
     bpow_simplify.
     rewrite (Rmult_comm u1).
-    unfold u1, ulp, canonic_exp; bpow_simplify.
+    unfold u1, ulp, cexp; bpow_simplify.
     rewrite (Rmult_assoc 2).
     rewrite (Rmult_comm x').
     rewrite (Rmult_assoc 2).
-    unfold x', round, F2R, scaled_mantissa, canonic_exp; simpl.
+    unfold x', round, F2R, scaled_mantissa, cexp; simpl.
     bpow_simplify.
-    rewrite <- (Z2R_Zpower _ (_ - _)%Z); [|exact He].
-    change 2 with (Z2R 2).
-    do 4 rewrite <- Z2R_mult.
-    change 1 with (Z2R 1); do 2 rewrite <- Z2R_plus.
-    apply Z2R_le.
+    rewrite <- (IZR_Zpower _ (_ - _)%Z); [|exact He].
+    do 4 rewrite <- mult_IZR.
+    do 2 rewrite <- plus_IZR.
+    apply IZR_le.
     rewrite Zplus_comm, Zplus_assoc.
     apply Zlt_le_succ.
-    apply lt_Z2R.
-    rewrite Z2R_plus.
-    do 4 rewrite Z2R_mult; simpl.
-    rewrite Z2R_Zpower; [|exact He].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta y))));
+    apply lt_IZR.
+    rewrite plus_IZR.
+    do 4 rewrite mult_IZR; simpl.
+    rewrite IZR_Zpower; [|exact He].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag y))));
       [now apply bpow_gt_0|].
     rewrite Rmult_plus_distr_r.
-    rewrite (Rmult_comm _ (Z2R _)).
+    rewrite (Rmult_comm _ (IZR _)).
     do 2 rewrite Rmult_assoc.
     rewrite <- Fy.
     bpow_simplify.
     unfold Zminus; rewrite bpow_plus.
-    rewrite (Rmult_assoc _ (Z2R mx)).
-    rewrite <- (Rmult_assoc (Z2R mx)).
+    rewrite (Rmult_assoc _ (IZR mx)).
+    rewrite <- (Rmult_assoc (IZR mx)).
     rewrite <- Fx.
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta (x / y)))));
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag (x / y)))));
       [now apply bpow_gt_0|].
     rewrite Rmult_plus_distr_r.
     bpow_simplify.
     rewrite (Rmult_comm _ y).
     do 2 rewrite Rmult_assoc.
-    change (Z2R (Zfloor _) * _) with x'.
+    change (IZR (Zfloor _) * _) with x'.
     change (bpow _) with u1.
     apply (Rmult_lt_reg_l (/ 2)); [lra|].
     rewrite Rmult_plus_distr_l.
@@ -4239,52 +4202,51 @@ destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - fexp1 (ln_beta (x / y))
     rewrite Rinv_l; [|now apply Rgt_not_eq]; do 2 rewrite Rmult_1_l.
     rewrite (Rmult_comm (/ y)).
     now rewrite (Rplus_comm (- x')).
-- (* fexp1 (ln_beta x) < fexp1 (ln_beta (x / y)) + fexp1 (ln_beta y) *)
-  apply Rlt_le_trans with (2 * x' * y + u1 * y + bpow (fexp1 (ln_beta x))).
+- (* fexp1 (mag x) < fexp1 (mag (x / y)) + fexp1 (mag y) *)
+  apply Rlt_le_trans with (2 * x' * y + u1 * y + bpow (fexp1 (mag x))).
   + rewrite Rplus_comm, Rplus_assoc; do 2 apply Rplus_lt_compat_l.
-    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
+    apply Rlt_le_trans with (u2 * bpow (mag y)).
     * apply Rmult_lt_compat_l.
       now apply bpow_gt_0.
-      now apply Rabs_lt_inv; apply bpow_ln_beta_gt.
-    * unfold u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
-      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
+      now apply Rabs_lt_inv; apply bpow_mag_gt.
+    * unfold u2, ulp, cexp; bpow_simplify; apply bpow_le.
+      apply (Zplus_le_reg_r _ _ (- mag y)); ring_simplify.
       rewrite (Zplus_comm (- _)).
-      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
+      destruct (mag_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
       apply Hexp; try assumption; rewrite <- Hxy; omega.
   + apply Rge_le; rewrite Fx at 1; apply Rle_ge.
     rewrite Fy at 1 2.
-    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
+    apply (Rmult_le_reg_r (bpow (- fexp1 (mag x))));
       [now apply bpow_gt_0|].
     do 2 rewrite Rmult_plus_distr_r.
     bpow_simplify.
     replace (2 * x' * _ * _)
-    with (2 * Z2R my * x' * bpow (fexp1 (ln_beta y) - fexp1 (ln_beta x))) by ring.
+    with (2 * IZR my * x' * bpow (fexp1 (mag y) - fexp1 (mag x))) by ring.
     rewrite (Rmult_comm u1).
-    unfold x', u1, round, F2R, ulp, scaled_mantissa, canonic_exp; simpl.
+    unfold x', u1, round, F2R, ulp, scaled_mantissa, cexp; simpl.
     bpow_simplify.
-    rewrite <- (Z2R_Zpower _ (_ - _)%Z); [|omega].
-    change 2 with (Z2R 2).
-    do 5 rewrite <- Z2R_mult.
-    change 1 with (Z2R 1); do 2 rewrite <- Z2R_plus.
-    apply Z2R_le.
+    rewrite <- (IZR_Zpower _ (_ - _)%Z); [|omega].
+    do 5 rewrite <- mult_IZR.
+    do 2 rewrite <- plus_IZR.
+    apply IZR_le.
     apply Zlt_le_succ.
-    apply lt_Z2R.
-    rewrite Z2R_plus.
-    do 5 rewrite Z2R_mult; simpl.
-    rewrite Z2R_Zpower; [|omega].
-    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x))));
+    apply lt_IZR.
+    rewrite plus_IZR.
+    do 5 rewrite mult_IZR; simpl.
+    rewrite IZR_Zpower; [|omega].
+    apply (Rmult_lt_reg_r (bpow (fexp1 (mag x))));
       [now apply bpow_gt_0|].
-    rewrite (Rmult_assoc _ (Z2R mx)).
+    rewrite (Rmult_assoc _ (IZR mx)).
     rewrite <- Fx.
     rewrite Rmult_plus_distr_r.
     bpow_simplify.
     rewrite bpow_plus.
     rewrite Rmult_assoc.
-    rewrite <- (Rmult_assoc (Z2R _)).
-    change (Z2R _ * bpow _) with x'.
-    do 2 rewrite (Rmult_comm _ (bpow (fexp1 (ln_beta y)))).
+    rewrite <- (Rmult_assoc (IZR _)).
+    change (IZR _ * bpow _) with x'.
+    do 2 rewrite (Rmult_comm _ (bpow (fexp1 (mag y)))).
     rewrite Rmult_assoc.
-    do 2 rewrite <- (Rmult_assoc (Z2R my)).
+    do 2 rewrite <- (Rmult_assoc (IZR my)).
     rewrite <- Fy.
     change (bpow _) with u1.
     apply (Rmult_lt_reg_l (/ 2)); [lra|].
@@ -4302,55 +4264,55 @@ destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - fexp1 (ln_beta (x / y))
     now rewrite (Rplus_comm (- x')).
 Qed.
 
-Lemma double_round_div_aux :
+Lemma round_round_div_aux :
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   (exists n, (beta = 2 * n :> Z)%Z) ->
-  double_round_div_hyp fexp1 fexp2 ->
+  round_round_div_hyp fexp1 fexp2 ->
   forall x y,
   0 < x -> 0 < y ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x / y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x / y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Ebeta Hexp x y Px Py Fx Fy.
 assert (Pxy : 0 < x / y).
 { apply Rmult_lt_0_compat; [exact Px|].
   now apply Rinv_0_lt_compat. }
-apply double_round_all_mid_cases.
+apply round_round_all_mid_cases.
 - exact Vfexp1.
 - exact Vfexp2.
 - exact Pxy.
 - apply Hexp.
 - intros Hf1 Hlxy.
   casetype False.
-  now apply (double_round_div_aux0 fexp1 fexp2 _ _ choice1 choice2 Hexp x y).
+  now apply (round_round_div_aux0 fexp1 fexp2 _ _ choice1 choice2 Hexp x y).
 - intros Hf1 Hlxy.
   casetype False.
-  now apply (double_round_div_aux1 fexp1 fexp2 _ _ choice1 choice2 Hexp x y).
+  now apply (round_round_div_aux1 fexp1 fexp2 _ _ choice1 choice2 Hexp x y).
 - intro H.
-  apply double_round_eq_mid_beta_even; try assumption.
+  apply round_round_eq_mid_beta_even; try assumption.
   apply Hexp.
 - intros Hf1 Hlxy.
   casetype False.
-  now apply (double_round_div_aux2 fexp1 fexp2 _ _ choice1 choice2 Hexp x y).
+  now apply (round_round_div_aux2 fexp1 fexp2 _ _ choice1 choice2 Hexp x y).
 Qed.
 
-Lemma double_round_div :
+Lemma round_round_div :
   forall fexp1 fexp2 : Z -> Z,
   Valid_exp fexp1 -> Valid_exp fexp2 ->
   forall (choice1 choice2 : Z -> bool),
   (exists n, (beta = 2 * n :> Z)%Z) ->
-  double_round_div_hyp fexp1 fexp2 ->
+  round_round_div_hyp fexp1 fexp2 ->
   forall x y,
   y <> 0 ->
   generic_format beta fexp1 x ->
   generic_format beta fexp1 y ->
-  double_round_eq fexp1 fexp2 choice1 choice2 (x / y).
+  round_round_eq fexp1 fexp2 choice1 choice2 (x / y).
 Proof.
 intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Ebeta Hexp x y Nzy Fx Fy.
-unfold double_round_eq.
+unfold round_round_eq.
 destruct (Rtotal_order x 0) as [Nx|[Zx|Px]].
 - (* x < 0 *)
   destruct (Rtotal_order y 0) as [Ny|[Zy|Py]].
@@ -4367,7 +4329,7 @@ destruct (Rtotal_order x 0) as [Nx|[Zx|Px]].
     rewrite Ropp_0 in Nx, Ny.
     apply generic_format_opp in Fx.
     apply generic_format_opp in Fy.
-    now apply double_round_div_aux.
+    now apply round_round_div_aux.
   + (* y = 0 *)
     now casetype False; apply Nzy.
   + (* y > 0 *)
@@ -4378,7 +4340,7 @@ destruct (Rtotal_order x 0) as [Nx|[Zx|Px]].
     apply Ropp_lt_contravar in Nx.
     rewrite Ropp_0 in Nx.
     apply generic_format_opp in Fx.
-    now apply double_round_div_aux.
+    now apply round_round_div_aux.
 - (* x = 0 *)
   rewrite Zx.
   unfold Rdiv; rewrite Rmult_0_l.
@@ -4394,50 +4356,48 @@ destruct (Rtotal_order x 0) as [Nx|[Zx|Px]].
     apply Ropp_lt_contravar in Ny.
     rewrite Ropp_0 in Ny.
     apply generic_format_opp in Fy.
-    now apply double_round_div_aux.
+    now apply round_round_div_aux.
   + (* y = 0 *)
     now casetype False; apply Nzy.
   + (* y > 0 *)
-    now apply double_round_div_aux.
+    now apply round_round_div_aux.
 Qed.
 
 Section Double_round_div_FLX.
 
-Import Fcore_FLX.
-
 Variable prec : Z.
 Variable prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLX_double_round_div_hyp :
+Lemma FLX_round_round_div_hyp :
   (2 * prec <= prec')%Z ->
-  double_round_div_hyp (FLX_exp prec) (FLX_exp prec').
+  round_round_div_hyp (FLX_exp prec) (FLX_exp prec').
 Proof.
 intros Hprec.
 unfold Prec_gt_0 in prec_gt_0_.
 unfold FLX_exp.
-unfold double_round_div_hyp.
+unfold round_round_div_hyp.
 split; [now intro ex; omega|].
 split; [|split; [|split]]; intros ex ey; omega.
 Qed.
 
-Theorem double_round_div_FLX :
+Theorem round_round_div_FLX :
   forall choice1 choice2,
   (exists n, (beta = 2 * n :> Z)%Z) ->
   (2 * prec <= prec')%Z ->
   forall x y,
   y <> 0 ->
   FLX_format beta prec x -> FLX_format beta prec y ->
-  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x / y).
+  round_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x / y).
 Proof.
 intros choice1 choice2 Ebeta Hprec x y Nzy Fx Fy.
-apply double_round_div.
+apply round_round_div.
 - now apply FLX_exp_valid.
 - now apply FLX_exp_valid.
 - exact Ebeta.
-- now apply FLX_double_round_div_hyp.
+- now apply FLX_round_round_div_hyp.
 - exact Nzy.
 - now apply generic_format_FLX.
 - now apply generic_format_FLX.
@@ -4447,24 +4407,21 @@ End Double_round_div_FLX.
 
 Section Double_round_div_FLT.
 
-Import Fcore_FLX.
-Import Fcore_FLT.
-
 Variable emin prec : Z.
 Variable emin' prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FLT_double_round_div_hyp :
+Lemma FLT_round_round_div_hyp :
   (emin' <= emin - prec - 2)%Z ->
   (2 * prec <= prec')%Z ->
-  double_round_div_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
+  round_round_div_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
 Proof.
 intros Hemin Hprec.
 unfold FLT_exp.
 unfold Prec_gt_0 in prec_gt_0_.
-unfold double_round_div_hyp.
+unfold round_round_div_hyp.
 split; [intro ex|split; [|split; [|split]]; intros ex ey].
 - generalize (Zmax_spec (ex - prec') emin').
   generalize (Zmax_spec (ex - prec) emin).
@@ -4491,7 +4448,7 @@ split; [intro ex|split; [|split; [|split]]; intros ex ey].
   omega.
 Qed.
 
-Theorem double_round_div_FLT :
+Theorem round_round_div_FLT :
   forall choice1 choice2,
   (exists n, (beta = 2 * n :> Z)%Z) ->
   (emin' <= emin - prec - 2)%Z ->
@@ -4499,15 +4456,15 @@ Theorem double_round_div_FLT :
   forall x y,
   y <> 0 ->
   FLT_format beta emin prec x -> FLT_format beta emin prec y ->
-  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
+  round_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                   choice1 choice2 (x / y).
 Proof.
 intros choice1 choice2 Ebeta Hemin Hprec x y Nzy Fx Fy.
-apply double_round_div.
+apply round_round_div.
 - now apply FLT_exp_valid.
 - now apply FLT_exp_valid.
 - exact Ebeta.
-- now apply FLT_double_round_div_hyp.
+- now apply FLT_round_round_div_hyp.
 - exact Nzy.
 - now apply generic_format_FLT.
 - now apply generic_format_FLT.
@@ -4517,25 +4474,22 @@ End Double_round_div_FLT.
 
 Section Double_round_div_FTZ.
 
-Import Fcore_FLX.
-Import Fcore_FTZ.
-
 Variable emin prec : Z.
 Variable emin' prec' : Z.
 
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 Context { prec_gt_0_' : Prec_gt_0 prec' }.
 
-Lemma FTZ_double_round_div_hyp :
+Lemma FTZ_round_round_div_hyp :
   (emin' + prec' <= emin - 1)%Z ->
   (2 * prec <= prec')%Z ->
-  double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
+  round_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
 Proof.
 intros Hemin Hprec.
 unfold FTZ_exp.
 unfold Prec_gt_0 in prec_gt_0_.
 unfold Prec_gt_0 in prec_gt_0_.
-unfold double_round_div_hyp.
+unfold round_round_div_hyp.
 split; [intro ex|split; [|split; [|split]]; intros ex ey].
 - destruct (Z.ltb_spec (ex - prec') emin');
   destruct (Z.ltb_spec (ex - prec) emin);
@@ -4562,7 +4516,7 @@ split; [intro ex|split; [|split; [|split]]; intros ex ey].
   omega.
 Qed.
 
-Theorem double_round_div_FTZ :
+Theorem round_round_div_FTZ :
   forall choice1 choice2,
   (exists n, (beta = 2 * n :> Z)%Z) ->
   (emin' + prec' <= emin - 1)%Z ->
@@ -4570,15 +4524,15 @@ Theorem double_round_div_FTZ :
   forall x y,
   y <> 0 ->
   FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
-  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
+  round_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                   choice1 choice2 (x / y).
 Proof.
 intros choice1 choice2 Ebeta Hemin Hprec x y Nzy Fx Fy.
-apply double_round_div.
+apply round_round_div.
 - now apply FTZ_exp_valid.
 - now apply FTZ_exp_valid.
 - exact Ebeta.
-- now apply FTZ_double_round_div_hyp.
+- now apply FTZ_round_round_div_hyp.
 - exact Nzy.
 - now apply generic_format_FTZ.
 - now apply generic_format_FTZ.
diff --git a/flocq/Prop/Fprop_div_sqrt_error.v b/flocq/Prop/Fprop_div_sqrt_error.v
deleted file mode 100644
index 422b6b64..00000000
--- a/flocq/Prop/Fprop_div_sqrt_error.v
+++ /dev/null
@@ -1,300 +0,0 @@
-(**
-This file is part of the Flocq formalization of floating-point
-arithmetic in Coq: http://flocq.gforge.inria.fr/
-
-Copyright (C) 2010-2013 Sylvie Boldo
-#<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
-
-This library is free software; you can redistribute it and/or
-modify it 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.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-COPYING file for more details.
-*)
-
-(** * Remainder of the division and square root are in the FLX format *)
-Require Import Fcore.
-Require Import Fcalc_ops.
-Require Import Fprop_relative.
-
-Section Fprop_divsqrt_error.
-
-Variable beta : radix.
-Notation bpow e := (bpow beta e).
-
-Variable prec : Z.
-
-Theorem generic_format_plus_prec:
-  forall fexp, (forall e, (fexp e  <= e - prec)%Z) ->
-  forall x y (fx fy: float beta),
-  (x = F2R fx)%R -> (y = F2R fy)%R -> (Rabs (x+y) < bpow (prec+Fexp fx))%R -> (Rabs (x+y) < bpow (prec+Fexp fy))%R
-  -> generic_format beta fexp (x+y)%R.
-intros fexp Hfexp x y fx fy Hx Hy H1 H2.
-case (Req_dec (x+y) 0); intros H.
-rewrite H; apply generic_format_0.
-rewrite Hx, Hy, <- F2R_plus.
-apply generic_format_F2R.
-intros _.
-case_eq (Fplus beta fx fy).
-intros mz ez Hz.
-rewrite <- Hz.
-apply Zle_trans with (Zmin (Fexp fx) (Fexp fy)).
-rewrite F2R_plus, <- Hx, <- Hy.
-unfold canonic_exp.
-apply Zle_trans with (1:=Hfexp _).
-apply Zplus_le_reg_l with prec; ring_simplify.
-apply ln_beta_le_bpow with (1 := H).
-now apply Zmin_case.
-rewrite <- Fexp_Fplus, Hz.
-apply Zle_refl.
-Qed.
-
-Theorem ex_Fexp_canonic: forall fexp, forall x, generic_format beta fexp x
-  -> exists fx:float beta, (x=F2R fx)%R /\ Fexp fx = canonic_exp beta fexp x.
-intros fexp x; unfold generic_format.
-exists (Float beta (Ztrunc (scaled_mantissa beta fexp x)) (canonic_exp beta fexp x)).
-split; auto.
-Qed.
-
-
-Context { prec_gt_0_ : Prec_gt_0 prec }.
-
-Notation format := (generic_format beta (FLX_exp prec)).
-Notation cexp := (canonic_exp beta (FLX_exp prec)).
-
-Variable choice : Z -> bool.
-
-
-(** Remainder of the division in FLX *)
-Theorem div_error_FLX :
-  forall rnd { Zrnd : Valid_rnd rnd } x y,
-  format x -> format y ->
-  format (x - round beta (FLX_exp prec) rnd (x/y) * y)%R.
-Proof with auto with typeclass_instances.
-intros rnd Zrnd x y Hx Hy.
-destruct (Req_dec y 0) as [Zy|Zy].
-now rewrite Zy, Rmult_0_r, Rminus_0_r.
-destruct (Req_dec (round beta (FLX_exp prec) rnd (x/y)) 0) as [Hr|Hr].
-rewrite Hr; ring_simplify (x-0*y)%R; assumption.
-assert (Zx: x <> R0).
-contradict Hr.
-rewrite Hr.
-unfold Rdiv.
-now rewrite Rmult_0_l, round_0.
-destruct (ex_Fexp_canonic _ x Hx) as (fx,(Hx1,Hx2)).
-destruct (ex_Fexp_canonic _ y Hy) as (fy,(Hy1,Hy2)).
-destruct (ex_Fexp_canonic (FLX_exp prec) (round beta (FLX_exp prec) rnd (x / y))) as (fr,(Hr1,Hr2)).
-apply generic_format_round...
-unfold Rminus; apply generic_format_plus_prec with fx (Fopp beta (Fmult beta fr fy)); trivial.
-intros e; apply Zle_refl.
-now rewrite F2R_opp, F2R_mult, <- Hr1, <- Hy1.
-(* *)
-destruct (relative_error_FLX_ex beta prec (prec_gt_0 prec) rnd (x / y)%R) as (eps,(Heps1,Heps2)).
-rewrite Heps2.
-rewrite <- Rabs_Ropp.
-replace (-(x + - (x / y * (1 + eps) * y)))%R with (x * eps)%R by now field.
-rewrite Rabs_mult.
-apply Rlt_le_trans with (Rabs x * 1)%R.
-apply Rmult_lt_compat_l.
-now apply Rabs_pos_lt.
-apply Rlt_le_trans with (1 := Heps1).
-change 1%R with (bpow 0).
-apply bpow_le.
-generalize (prec_gt_0 prec).
-clear ; omega.
-rewrite Rmult_1_r.
-rewrite Hx2.
-unfold canonic_exp.
-destruct (ln_beta beta x) as (ex, Hex).
-simpl.
-specialize (Hex Zx).
-apply Rlt_le.
-apply Rlt_le_trans with (1 := proj2 Hex).
-apply bpow_le.
-unfold FLX_exp.
-ring_simplify.
-apply Zle_refl.
-(* *)
-replace (Fexp (Fopp beta (Fmult beta fr fy))) with (Fexp fr + Fexp fy)%Z.
-2: unfold Fopp, Fmult; destruct fr; destruct fy; now simpl.
-replace (x + - (round beta (FLX_exp prec) rnd (x / y) * y))%R with
-  (y * (-(round beta (FLX_exp prec) rnd (x / y) - x/y)))%R.
-2: field; assumption.
-rewrite Rabs_mult.
-apply Rlt_le_trans with (Rabs y * bpow (Fexp fr))%R.
-apply Rmult_lt_compat_l.
-now apply Rabs_pos_lt.
-rewrite Rabs_Ropp.
-replace (bpow (Fexp fr)) with (ulp beta (FLX_exp prec) (F2R fr)).
-rewrite <- Hr1.
-apply error_lt_ulp_round...
-apply Rmult_integral_contrapositive_currified; try apply Rinv_neq_0_compat; assumption.
-rewrite ulp_neq_0.
-2: now rewrite <- Hr1.
-apply f_equal.
-now rewrite Hr2, <- Hr1.
-replace (prec+(Fexp fr+Fexp fy))%Z with ((prec+Fexp fy)+Fexp fr)%Z by ring.
-rewrite bpow_plus.
-apply Rmult_le_compat_r.
-apply bpow_ge_0.
-rewrite Hy2; unfold canonic_exp, FLX_exp.
-ring_simplify (prec + (ln_beta beta y - prec))%Z.
-destruct (ln_beta beta y); simpl.
-left; now apply a.
-Qed.
-
-(** Remainder of the square in FLX (with p>1) and rounding to nearest *)
-Variable Hp1 : Zlt 1 prec.
-
-Theorem sqrt_error_FLX_N :
-  forall x, format x ->
-  format (x - Rsqr (round beta (FLX_exp prec) (Znearest choice) (sqrt x)))%R.
-Proof with auto with typeclass_instances.
-intros x Hx.
-destruct (total_order_T x 0) as [[Hxz|Hxz]|Hxz].
-unfold sqrt.
-destruct (Rcase_abs x).
-rewrite round_0...
-unfold Rsqr.
-now rewrite Rmult_0_l, Rminus_0_r.
-elim (Rlt_irrefl 0).
-now apply Rgt_ge_trans with x.
-rewrite Hxz, sqrt_0, round_0...
-unfold Rsqr.
-rewrite Rmult_0_l, Rminus_0_r.
-apply generic_format_0.
-case (Req_dec (round beta (FLX_exp prec) (Znearest choice) (sqrt x)) 0); intros Hr.
-rewrite Hr; unfold Rsqr; ring_simplify (x-0*0)%R; assumption.
-destruct (ex_Fexp_canonic _ x Hx) as (fx,(Hx1,Hx2)).
-destruct (ex_Fexp_canonic (FLX_exp prec) (round beta (FLX_exp prec) (Znearest choice) (sqrt x))) as (fr,(Hr1,Hr2)).
-apply generic_format_round...
-unfold Rminus; apply generic_format_plus_prec with fx (Fopp beta (Fmult beta fr fr)); trivial.
-intros e; apply Zle_refl.
-unfold Rsqr; now rewrite F2R_opp,F2R_mult, <- Hr1.
-(* *)
-apply Rle_lt_trans with x.
-apply Rabs_minus_le.
-apply Rle_0_sqr.
-destruct (relative_error_N_FLX_ex beta prec (prec_gt_0 prec) choice (sqrt x)) as (eps,(Heps1,Heps2)).
-rewrite Heps2.
-rewrite Rsqr_mult, Rsqr_sqrt, Rmult_comm. 2: now apply Rlt_le.
-apply Rmult_le_compat_r.
-now apply Rlt_le.
-apply Rle_trans with (5²/4²)%R.
-rewrite <- Rsqr_div.
-apply Rsqr_le_abs_1.
-apply Rle_trans with (1 := Rabs_triang _ _).
-rewrite Rabs_R1.
-apply Rplus_le_reg_l with (-1)%R.
-replace (-1 + (1 + Rabs eps))%R with (Rabs eps) by ring.
-apply Rle_trans with (1 := Heps1).
-rewrite Rabs_pos_eq.
-apply Rmult_le_reg_l with 2%R.
-now apply (Z2R_lt 0 2).
-rewrite <- Rmult_assoc, Rinv_r, Rmult_1_l.
-apply Rle_trans with (bpow (-1)).
-apply bpow_le.
-omega.
-replace (2 * (-1 + 5 / 4))%R with (/2)%R by field.
-apply Rinv_le.
-now apply (Z2R_lt 0 2).
-apply (Z2R_le 2).
-unfold Zpower_pos. simpl.
-rewrite Zmult_1_r.
-apply Zle_bool_imp_le.
-apply beta.
-apply Rgt_not_eq.
-now apply (Z2R_lt 0 2).
-unfold Rdiv.
-apply Rmult_le_pos.
-now apply (Z2R_le 0 5).
-apply Rlt_le.
-apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 4).
-apply Rgt_not_eq.
-now apply (Z2R_lt 0 4).
-unfold Rsqr.
-replace (5 * 5 / (4 * 4))%R with (25 * /16)%R by field.
-apply Rmult_le_reg_r with 16%R.
-now apply (Z2R_lt 0 16).
-rewrite Rmult_assoc, Rinv_l, Rmult_1_r.
-now apply (Z2R_le 25 32).
-apply Rgt_not_eq.
-now apply (Z2R_lt 0 16).
-rewrite Hx2; unfold canonic_exp, FLX_exp.
-ring_simplify (prec + (ln_beta beta x - prec))%Z.
-destruct (ln_beta beta x); simpl.
-rewrite <- (Rabs_right x).
-apply a.
-now apply Rgt_not_eq.
-now apply Rgt_ge.
-(* *)
-replace (Fexp (Fopp beta (Fmult beta fr fr))) with (Fexp fr + Fexp fr)%Z.
-2: unfold Fopp, Fmult; destruct fr; now simpl.
-rewrite Hr1.
-replace (x + - Rsqr (F2R fr))%R with (-((F2R fr - sqrt x)*(F2R fr + sqrt x)))%R.
-2: rewrite <- (sqrt_sqrt x) at 3; auto.
-2: unfold Rsqr; ring.
-rewrite Rabs_Ropp, Rabs_mult.
-apply Rle_lt_trans with ((/2*bpow (Fexp fr))* Rabs (F2R fr + sqrt x))%R.
-apply Rmult_le_compat_r.
-apply Rabs_pos.
-apply Rle_trans with (/2*ulp beta  (FLX_exp prec) (F2R fr))%R.
-rewrite <- Hr1.
-apply error_le_half_ulp_round...
-right; rewrite ulp_neq_0.
-2: now rewrite <- Hr1.
-apply f_equal.
-rewrite Hr2, <- Hr1; trivial.
-rewrite Rmult_assoc, Rmult_comm.
-replace (prec+(Fexp fr+Fexp fr))%Z with (Fexp fr + (prec+Fexp fr))%Z by ring.
-rewrite bpow_plus, Rmult_assoc.
-apply Rmult_lt_compat_l.
-apply bpow_gt_0.
-apply Rmult_lt_reg_l with (1 := Rlt_0_2).
-apply Rle_lt_trans with (Rabs (F2R fr + sqrt x)).
-right; field.
-apply Rle_lt_trans with (1:=Rabs_triang _ _).
-(* . *)
-assert (Rabs (F2R fr) < bpow (prec + Fexp fr))%R.
-rewrite Hr2; unfold canonic_exp; rewrite Hr1.
-unfold FLX_exp.
-ring_simplify (prec + (ln_beta beta (F2R fr) - prec))%Z.
-destruct (ln_beta beta (F2R fr)); simpl.
-apply a.
-rewrite <- Hr1; auto.
-(* . *)
-apply Rlt_le_trans with (bpow (prec + Fexp fr)+ Rabs (sqrt x))%R.
-now apply Rplus_lt_compat_r.
-(* . *)
-replace (2 * bpow (prec + Fexp fr))%R with (bpow (prec + Fexp fr) + bpow (prec + Fexp fr))%R by ring.
-apply Rplus_le_compat_l.
-assert (sqrt x <> 0)%R.
-apply Rgt_not_eq.
-now apply sqrt_lt_R0.
-destruct (ln_beta beta (sqrt x)) as (es,Es).
-specialize (Es H0).
-apply Rle_trans with (bpow es).
-now apply Rlt_le.
-apply bpow_le.
-case (Zle_or_lt es (prec + Fexp fr)) ; trivial.
-intros H1.
-absurd (Rabs (F2R fr) < bpow (es - 1))%R.
-apply Rle_not_lt.
-rewrite <- Hr1.
-apply abs_round_ge_generic...
-apply generic_format_bpow.
-unfold FLX_exp; omega.
-apply Es.
-apply Rlt_le_trans with (1:=H).
-apply bpow_le.
-omega.
-now apply Rlt_le.
-Qed.
-
-End Fprop_divsqrt_error.
diff --git a/flocq/Prop/Fprop_mult_error.v b/flocq/Prop/Mult_error.v
index 44448cd6..57a3856f 100644
--- a/flocq/Prop/Fprop_mult_error.v
+++ b/flocq/Prop/Mult_error.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2010-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2010-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,8 +18,7 @@ COPYING file for more details.
 *)
 
 (** * Error of the multiplication is in the FLX/FLT format *)
-Require Import Fcore.
-Require Import Fcalc_ops.
+Require Import Core Operations Plus_error.
 
 Section Fprop_mult_error.
 
@@ -30,7 +29,7 @@ Variable prec : Z.
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 
 Notation format := (generic_format beta (FLX_exp prec)).
-Notation cexp := (canonic_exp beta (FLX_exp prec)).
+Notation cexp := (cexp beta (FLX_exp prec)).
 
 Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
@@ -41,9 +40,9 @@ Lemma mult_error_FLX_aux:
   format x -> format y ->
   (round beta (FLX_exp prec) rnd (x * y) - (x * y) <> 0)%R ->
   exists f:float beta,
-      (F2R f = round beta (FLX_exp prec) rnd (x * y) - (x * y))%R
-      /\  (canonic_exp beta (FLX_exp prec) (F2R f) <= Fexp f)%Z
-      /\ (Fexp f = cexp x + cexp y)%Z.
+    (F2R f = round beta (FLX_exp prec) rnd (x * y) - (x * y))%R
+    /\ (cexp (F2R f) <= Fexp f)%Z
+    /\ (Fexp f = cexp x + cexp y)%Z.
 Proof with auto with typeclass_instances.
 intros x y Hx Hy Hz.
 set (f := (round beta (FLX_exp prec) rnd (x * y))).
@@ -52,26 +51,26 @@ contradict Hz.
 rewrite Hxy0.
 rewrite round_0...
 ring.
-destruct (ln_beta beta (x * y)) as (exy, Hexy).
+destruct (mag beta (x * y)) as (exy, Hexy).
 specialize (Hexy Hxy0).
-destruct (ln_beta beta (f - x * y)) as (er, Her).
+destruct (mag beta (f - x * y)) as (er, Her).
 specialize (Her Hz).
-destruct (ln_beta beta x) as (ex, Hex).
+destruct (mag beta x) as (ex, Hex).
 assert (Hx0: (x <> 0)%R).
 contradict Hxy0.
 now rewrite Hxy0, Rmult_0_l.
 specialize (Hex Hx0).
-destruct (ln_beta beta y) as (ey, Hey).
+destruct (mag beta y) as (ey, Hey).
 assert (Hy0: (y <> 0)%R).
 contradict Hxy0.
 now rewrite Hxy0, Rmult_0_r.
 specialize (Hey Hy0).
 (* *)
 assert (Hc1: (cexp (x * y)%R - prec <= cexp x + cexp y)%Z).
-unfold canonic_exp, FLX_exp.
-rewrite ln_beta_unique with (1 := Hex).
-rewrite ln_beta_unique with (1 := Hey).
-rewrite ln_beta_unique with (1 := Hexy).
+unfold cexp, FLX_exp.
+rewrite mag_unique with (1 := Hex).
+rewrite mag_unique with (1 := Hey).
+rewrite mag_unique with (1 := Hexy).
 cut (exy - 1 < ex + ey)%Z. omega.
 apply (lt_bpow beta).
 apply Rle_lt_trans with (1 := proj1 Hexy).
@@ -84,10 +83,10 @@ apply Hex.
 apply Hey.
 (* *)
 assert (Hc2: (cexp x + cexp y <= cexp (x * y)%R)%Z).
-unfold canonic_exp, FLX_exp.
-rewrite ln_beta_unique with (1 := Hex).
-rewrite ln_beta_unique with (1 := Hey).
-rewrite ln_beta_unique with (1 := Hexy).
+unfold cexp, FLX_exp.
+rewrite mag_unique with (1 := Hex).
+rewrite mag_unique with (1 := Hey).
+rewrite mag_unique with (1 := Hexy).
 cut ((ex - 1) + (ey - 1) < exy)%Z.
 generalize (prec_gt_0 prec).
 clear ; omega.
@@ -120,16 +119,16 @@ split;[assumption|split].
 rewrite Hr.
 simpl.
 clear Hr.
-apply Zle_trans with (cexp (x * y)%R - prec)%Z.
-unfold canonic_exp, FLX_exp.
+apply Z.le_trans with (cexp (x * y)%R - prec)%Z.
+unfold cexp, FLX_exp.
 apply Zplus_le_compat_r.
-rewrite ln_beta_unique with (1 := Hexy).
-apply ln_beta_le_bpow with (1 := Hz).
+rewrite mag_unique with (1 := Hexy).
+apply mag_le_bpow with (1 := Hz).
 replace (bpow (exy - prec)) with (ulp beta (FLX_exp prec) (x * y)).
 apply error_lt_ulp...
 rewrite ulp_neq_0; trivial.
-unfold canonic_exp.
-now rewrite ln_beta_unique with (1 := Hexy).
+unfold cexp.
+now rewrite mag_unique with (1 := Hexy).
 apply Hc1.
 reflexivity.
 Qed.
@@ -149,6 +148,24 @@ rewrite <- H1.
 now apply generic_format_F2R.
 Qed.
 
+Lemma mult_bpow_exact_FLX :
+  forall x e,
+  format x ->
+  format (x * bpow e)%R.
+Proof.
+intros x e Fx.
+destruct (Req_dec x 0) as [Zx|Nzx].
+{ rewrite Zx, Rmult_0_l; apply generic_format_0. }
+rewrite Fx.
+set (mx := Ztrunc _); set (ex := cexp _).
+pose (f := {| Fnum := mx; Fexp := ex + e |} : float beta).
+apply (generic_format_F2R' _ _ _ f).
+{ now unfold F2R; simpl; rewrite bpow_plus, Rmult_assoc. }
+intro Nzmx; unfold mx, ex; rewrite <- Fx.
+unfold f, ex; simpl; unfold cexp; rewrite (mag_mult_bpow _ _ _ Nzx).
+unfold FLX_exp; omega.
+Qed.
+
 End Fprop_mult_error.
 
 Section Fprop_mult_error_FLT.
@@ -160,7 +177,7 @@ Variable emin prec : Z.
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 
 Notation format := (generic_format beta (FLT_exp emin prec)).
-Notation cexp := (canonic_exp beta (FLT_exp emin prec)).
+Notation cexp := (cexp beta (FLT_exp emin prec)).
 
 Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
@@ -169,7 +186,7 @@ Context { valid_rnd : Valid_rnd rnd }.
 Theorem mult_error_FLT :
   forall x y,
   format x -> format y ->
-  (x*y = 0)%R \/ (bpow (emin + 2*prec - 1) <= Rabs (x * y))%R ->
+  (x * y <> 0 -> bpow (emin + 2*prec - 1) <= Rabs (x * y))%R ->
   format (round beta (FLT_exp emin prec) rnd (x * y) - (x * y))%R.
 Proof with auto with typeclass_instances.
 intros x y Hx Hy Hxy.
@@ -177,12 +194,13 @@ set (f := (round beta (FLT_exp emin prec) rnd (x * y))).
 destruct (Req_dec (f - x * y) 0) as [Hr0|Hr0].
 rewrite Hr0.
 apply generic_format_0.
-destruct Hxy as [Hxy|Hxy].
+destruct (Req_dec (x * y) 0) as [Hxy'|Hxy'].
 unfold f.
-rewrite Hxy.
+rewrite Hxy'.
 rewrite round_0...
 ring_simplify (0 - 0)%R.
 apply generic_format_0.
+specialize (Hxy Hxy').
 destruct (mult_error_FLX_aux beta prec rnd x y) as ((m,e),(H1,(H2,H3))).
 now apply generic_format_FLX_FLT with emin.
 now apply generic_format_FLX_FLT with emin.
@@ -199,14 +217,14 @@ unfold f; rewrite <- H1.
 apply generic_format_F2R.
 intros _.
 simpl in H2, H3.
-unfold canonic_exp, FLT_exp.
-case (Zmax_spec (ln_beta beta (F2R (Float beta m e)) - prec) emin);
+unfold cexp, FLT_exp.
+case (Zmax_spec (mag beta (F2R (Float beta m e)) - prec) emin);
   intros (M1,M2); rewrite M2.
-apply Zle_trans with (2:=H2).
-unfold canonic_exp, FLX_exp.
-apply Zle_refl.
+apply Z.le_trans with (2:=H2).
+unfold cexp, FLX_exp.
+apply Z.le_refl.
 rewrite H3.
-unfold canonic_exp, FLX_exp.
+unfold cexp, FLX_exp.
 assert (Hxy0:(x*y <> 0)%R).
 contradict Hr0.
 unfold f.
@@ -219,9 +237,9 @@ now rewrite Hxy0, Rmult_0_l.
 assert (Hy0: (y <> 0)%R).
 contradict Hxy0.
 now rewrite Hxy0, Rmult_0_r.
-destruct (ln_beta beta x) as (ex,Ex) ; simpl.
+destruct (mag beta x) as (ex,Ex) ; simpl.
 specialize (Ex Hx0).
-destruct (ln_beta beta y) as (ey,Ey) ; simpl.
+destruct (mag beta y) as (ey,Ey) ; simpl.
 specialize (Ey Hy0).
 assert (emin + 2 * prec -1 < ex + ey)%Z.
 2: omega.
@@ -233,4 +251,85 @@ apply Ex.
 apply Ey.
 Qed.
 
+Lemma F2R_ge: forall (y:float beta),
+   (F2R y <> 0)%R -> (bpow (Fexp y) <= Rabs (F2R y))%R.
+Proof.
+intros (ny,ey).
+rewrite <- F2R_Zabs; unfold F2R; simpl.
+case (Zle_lt_or_eq 0 (Z.abs ny)).
+apply Z.abs_nonneg.
+intros Hy _.
+rewrite <- (Rmult_1_l (bpow _)) at 1.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply IZR_le; omega.
+intros H1 H2; contradict H2.
+replace ny with 0%Z.
+simpl; ring.
+now apply sym_eq, Z.abs_0_iff, sym_eq.
+Qed.
+
+Theorem mult_error_FLT_ge_bpow :
+  forall x y e,
+  format x -> format y ->
+  (bpow (e+2*prec-1) <= Rabs (x * y))%R ->
+  (round beta (FLT_exp emin prec) rnd (x * y) - (x * y) <> 0)%R ->
+  (bpow e <= Rabs (round beta (FLT_exp emin prec) rnd (x * y) - (x * y)))%R.
+Proof with auto with typeclass_instances.
+intros x y e.
+set (f := (round beta (FLT_exp emin prec) rnd (x * y))).
+intros Fx Fy H1.
+unfold f; rewrite Fx, Fy, <- F2R_mult.
+simpl Fmult.
+destruct (round_repr_same_exp beta (FLT_exp emin prec)
+ rnd (Ztrunc (scaled_mantissa beta (FLT_exp emin prec) x) *
+             Ztrunc (scaled_mantissa beta (FLT_exp emin prec) y))
+      (cexp x + cexp y)) as (n,Hn).
+rewrite Hn; clear Hn.
+rewrite <- F2R_minus, Fminus_same_exp.
+intros K.
+eapply Rle_trans with (2:=F2R_ge _ K).
+simpl (Fexp _).
+apply bpow_le.
+unfold cexp, FLT_exp.
+destruct (mag beta x) as (ex,Hx).
+destruct (mag beta y) as (ey,Hy).
+simpl; apply Z.le_trans with ((ex-prec)+(ey-prec))%Z.
+2: apply Zplus_le_compat; apply Z.le_max_l.
+assert (e + 2*prec -1< ex+ey)%Z;[idtac|omega].
+apply lt_bpow with beta.
+apply Rle_lt_trans with (1:=H1).
+rewrite Rabs_mult, bpow_plus.
+apply Rmult_lt_compat.
+apply Rabs_pos.
+apply Rabs_pos.
+apply Hx.
+intros K'; contradict H1; apply Rlt_not_le.
+rewrite K', Rmult_0_l, Rabs_R0; apply bpow_gt_0.
+apply Hy.
+intros K'; contradict H1; apply Rlt_not_le.
+rewrite K', Rmult_0_r, Rabs_R0; apply bpow_gt_0.
+Qed.
+
+Lemma mult_bpow_exact_FLT :
+  forall x e,
+  format x ->
+  (emin + prec - mag beta x <= e)%Z ->
+  format (x * bpow e)%R.
+Proof.
+intros x e Fx He.
+destruct (Req_dec x 0) as [Zx|Nzx].
+{ rewrite Zx, Rmult_0_l; apply generic_format_0. }
+rewrite Fx.
+set (mx := Ztrunc _); set (ex := cexp _).
+pose (f := {| Fnum := mx; Fexp := ex + e |} : float beta).
+apply (generic_format_F2R' _ _ _ f).
+{ now unfold F2R; simpl; rewrite bpow_plus, Rmult_assoc. }
+intro Nzmx; unfold mx, ex; rewrite <- Fx.
+unfold f, ex; simpl; unfold cexp; rewrite (mag_mult_bpow _ _ _ Nzx).
+unfold FLT_exp; rewrite Z.max_l; [|omega]; rewrite <- Z.add_max_distr_r.
+set (n := (_ - _ + _)%Z); apply (Z.le_trans _ n); [unfold n; omega|].
+apply Z.le_max_l.
+Qed.
+
 End Fprop_mult_error_FLT.
diff --git a/flocq/Prop/Fprop_plus_error.v b/flocq/Prop/Plus_error.v
index 9bb5aee8..42f80093 100644
--- a/flocq/Prop/Fprop_plus_error.v
+++ b/flocq/Prop/Plus_error.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2010-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2010-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -20,15 +20,9 @@ COPYING file for more details.
 (** * Error of the rounded-to-nearest addition is representable. *)
 
 Require Import Psatz.
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_float_prop.
-Require Import Fcore_generic_fmt.
-Require Import Fcore_FIX.
-Require Import Fcore_FLX.
-Require Import Fcore_FLT.
-Require Import Fcore_ulp.
-Require Import Fcalc_ops.
+Require Import Raux Defs Float_prop Generic_fmt.
+Require Import FIX FLX FLT Ulp Operations.
+Require Import Relative.
 
 
 Section Fprop_plus_error.
@@ -44,31 +38,31 @@ Section round_repr_same_exp.
 Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
 
-Theorem round_repr_same_exp :
+Lemma round_repr_same_exp :
   forall m e,
   exists m',
   round beta fexp rnd (F2R (Float beta m e)) = F2R (Float beta m' e).
 Proof with auto with typeclass_instances.
 intros m e.
-set (e' := canonic_exp beta fexp (F2R (Float beta m e))).
+set (e' := cexp beta fexp (F2R (Float beta m e))).
 unfold round, scaled_mantissa. fold e'.
 destruct (Zle_or_lt e' e) as [He|He].
 exists m.
 unfold F2R at 2. simpl.
 rewrite Rmult_assoc, <- bpow_plus.
-rewrite <- Z2R_Zpower. 2: omega.
-rewrite <- Z2R_mult, Zrnd_Z2R...
+rewrite <- IZR_Zpower. 2: omega.
+rewrite <- mult_IZR, Zrnd_IZR...
 unfold F2R. simpl.
-rewrite Z2R_mult.
+rewrite mult_IZR.
 rewrite Rmult_assoc.
-rewrite Z2R_Zpower. 2: omega.
+rewrite IZR_Zpower. 2: omega.
 rewrite <- bpow_plus.
-apply (f_equal (fun v => Z2R m * bpow v)%R).
+apply (f_equal (fun v => IZR m * bpow v)%R).
 ring.
-exists ((rnd (Z2R m * bpow (e - e'))) * Zpower beta (e' - e))%Z.
+exists ((rnd (IZR m * bpow (e - e'))) * Zpower beta (e' - e))%Z.
 unfold F2R. simpl.
-rewrite Z2R_mult.
-rewrite Z2R_Zpower. 2: omega.
+rewrite mult_IZR.
+rewrite IZR_Zpower. 2: omega.
 rewrite 2!Rmult_assoc.
 rewrite <- 2!bpow_plus.
 apply (f_equal (fun v => _ * bpow v)%R).
@@ -84,13 +78,13 @@ Variable choice : Z -> bool.
 
 Lemma plus_error_aux :
   forall x y,
-  (canonic_exp beta fexp x <= canonic_exp beta fexp y)%Z ->
+  (cexp beta fexp x <= cexp beta fexp y)%Z ->
   format x -> format y ->
   format (round beta fexp (Znearest choice) (x + y) - (x + y))%R.
 Proof.
 intros x y.
-set (ex := canonic_exp beta fexp x).
-set (ey := canonic_exp beta fexp y).
+set (ex := cexp beta fexp x).
+set (ey := cexp beta fexp y).
 intros He Hx Hy.
 destruct (Req_dec (round beta fexp (Znearest choice) (x + y) - (x + y)) R0) as [H0|H0].
 rewrite H0.
@@ -116,7 +110,7 @@ apply generic_format_F2R.
 intros _.
 apply monotone_exp.
 rewrite <- H, <- Hxy', <- Hxy.
-apply ln_beta_le_abs.
+apply mag_le_abs.
 exact H0.
 pattern x at 3 ; replace x with (-(y - (x + y)))%R by ring.
 rewrite Rabs_Ropp.
@@ -130,7 +124,7 @@ Theorem plus_error :
   format (round beta fexp (Znearest choice) (x + y) - (x + y))%R.
 Proof.
 intros x y Hx Hy.
-destruct (Zle_or_lt (canonic_exp beta fexp x) (canonic_exp beta fexp y)).
+destruct (Zle_or_lt (cexp beta fexp x) (cexp beta fexp y)).
 now apply plus_error_aux.
 rewrite Rplus_comm.
 apply plus_error_aux ; try easy.
@@ -154,20 +148,17 @@ Section round_plus_eq_zero_aux.
 Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
 
-Lemma round_plus_eq_zero_aux :
+Lemma round_plus_neq_0_aux :
   forall x y,
-  (canonic_exp beta fexp x <= canonic_exp beta fexp y)%Z ->
+  (cexp beta fexp x <= cexp beta fexp y)%Z ->
   format x -> format y ->
-  (0 <= x + y)%R ->
-  round beta fexp rnd (x + y) = 0%R ->
-  (x + y = 0)%R.
+  (0 < x + y)%R ->
+  round beta fexp rnd (x + y) <> 0%R.
 Proof with auto with typeclass_instances.
-intros x y He Hx Hy Hp Hxy.
-destruct (Req_dec (x + y) 0) as [H0|H0].
-exact H0.
-destruct (ln_beta beta (x + y)) as (exy, Hexy).
+intros x y He Hx Hy Hxy.
+destruct (mag beta (x + y)) as (exy, Hexy).
 simpl.
-specialize (Hexy H0).
+specialize (Hexy (Rgt_not_eq _ _ Hxy)).
 destruct (Zle_or_lt exy (fexp exy)) as [He'|He'].
 (* . *)
 assert (H: (x + y)%R = F2R (Float beta (Ztrunc (x * bpow (- fexp exy)) +
@@ -175,19 +166,21 @@ assert (H: (x + y)%R = F2R (Float beta (Ztrunc (x * bpow (- fexp exy)) +
 rewrite (subnormal_exponent beta fexp exy x He' Hx) at 1.
 rewrite (subnormal_exponent beta fexp exy y He' Hy) at 1.
 now rewrite <- F2R_plus, Fplus_same_exp.
-rewrite H in Hxy.
-rewrite round_generic in Hxy...
-now rewrite <- H in Hxy.
+rewrite H.
+rewrite round_generic...
+rewrite <- H.
+now apply Rgt_not_eq.
 apply generic_format_F2R.
 intros _.
 rewrite <- H.
-unfold canonic_exp.
-rewrite ln_beta_unique with (1 := Hexy).
-apply Zle_refl.
+unfold cexp.
+rewrite mag_unique with (1 := Hexy).
+apply Z.le_refl.
 (* . *)
+intros H.
 elim Rle_not_lt with (1 := round_le beta _ rnd _ _ (proj1 Hexy)).
-rewrite (Rabs_pos_eq _ Hp).
-rewrite Hxy.
+rewrite (Rabs_pos_eq _ (Rlt_le _ _ Hxy)).
+rewrite H.
 rewrite round_generic...
 apply bpow_gt_0.
 apply generic_format_bpow.
@@ -201,40 +194,46 @@ Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
 
 (** rnd(x+y)=0 -> x+y = 0 provided this is not a FTZ format *)
-Theorem round_plus_eq_zero :
+Theorem round_plus_neq_0 :
   forall x y,
   format x -> format y ->
-  round beta fexp rnd (x + y) = 0%R ->
-  (x + y = 0)%R.
+  (x + y <> 0)%R ->
+  round beta fexp rnd (x + y) <> 0%R.
 Proof with auto with typeclass_instances.
-intros x y Hx Hy.
+intros x y Hx Hy Hxy.
 destruct (Rle_or_lt 0 (x + y)) as [H1|H1].
 (* . *)
-revert H1.
-destruct (Zle_or_lt (canonic_exp beta fexp x) (canonic_exp beta fexp y)) as [H2|H2].
-now apply round_plus_eq_zero_aux.
+destruct (Zle_or_lt (cexp beta fexp x) (cexp beta fexp y)) as [H2|H2].
+apply round_plus_neq_0_aux...
+lra.
 rewrite Rplus_comm.
-apply round_plus_eq_zero_aux ; try easy.
+apply round_plus_neq_0_aux ; try easy.
 now apply Zlt_le_weak.
+lra.
 (* . *)
-revert H1.
-rewrite <- (Ropp_involutive (x + y)), Ropp_plus_distr, <- Ropp_0.
-intros H1.
+rewrite <- (Ropp_involutive (x + y)), Ropp_plus_distr.
 rewrite round_opp.
-intros Hxy.
-apply f_equal.
-cut (round beta fexp (Zrnd_opp rnd) (- x + - y) = 0)%R.
-cut (0 <= -x + -y)%R.
-destruct (Zle_or_lt (canonic_exp beta fexp (-x)) (canonic_exp beta fexp (-y))) as [H2|H2].
-apply round_plus_eq_zero_aux ; try apply generic_format_opp...
+apply Ropp_neq_0_compat.
+destruct (Zle_or_lt (cexp beta fexp (-x)) (cexp beta fexp (-y))) as [H2|H2].
+apply round_plus_neq_0_aux; try apply generic_format_opp...
+lra.
 rewrite Rplus_comm.
-apply round_plus_eq_zero_aux ; try apply generic_format_opp...
+apply round_plus_neq_0_aux; try apply generic_format_opp...
 now apply Zlt_le_weak.
-apply Rlt_le.
-now apply Ropp_lt_cancel.
-rewrite <- (Ropp_involutive (round _ _ _ _)).
-rewrite Hxy.
-apply Ropp_involutive.
+lra.
+Qed.
+
+Theorem round_plus_eq_0 :
+  forall x y,
+  format x -> format y ->
+  round beta fexp rnd (x + y) = 0%R ->
+  (x + y = 0)%R.
+Proof with auto with typeclass_instances.
+intros x y Fx Fy H.
+destruct (Req_dec (x + y) 0) as [H'|H'].
+exact H'.
+contradict H.
+now apply round_plus_neq_0.
 Qed.
 
 End Fprop_plus_zero.
@@ -258,14 +257,48 @@ apply generic_format_FLT_FIX...
 rewrite Zplus_comm; assumption.
 apply generic_format_FIX_FLT, FIX_format_generic in Fx.
 apply generic_format_FIX_FLT, FIX_format_generic in Fy.
-destruct Fx as (nx,(H1x,H2x)).
-destruct Fy as (ny,(H1y,H2y)).
+destruct Fx as [nx H1x H2x].
+destruct Fy as [ny H1y H2y].
 apply generic_format_FIX.
 exists (Float beta (Fnum nx+Fnum ny)%Z emin).
-split;[idtac|reflexivity].
 rewrite H1x,H1y; unfold F2R; simpl.
 rewrite H2x, H2y.
-rewrite Z2R_plus; ring.
+rewrite plus_IZR; ring.
+easy.
+Qed.
+
+Variable choice : Z -> bool.
+
+Lemma FLT_plus_error_N_ex : forall x y,
+  generic_format beta (FLT_exp emin prec) x ->
+  generic_format beta (FLT_exp emin prec) y ->
+  exists eps,
+  (Rabs eps <= u_ro beta prec / (1 + u_ro beta prec))%R /\
+  round beta (FLT_exp emin prec) (Znearest choice) (x + y)
+  = ((x + y) * (1 + eps))%R.
+Proof.
+intros x y Fx Fy.
+assert (Pb := u_rod1pu_ro_pos beta prec).
+destruct (Rle_or_lt (bpow (emin + prec - 1)) (Rabs (x + y))) as [M|M].
+{ destruct (relative_error_N_FLX'_ex beta prec prec_gt_0_ choice (x + y))
+    as (d, (Bd, Hd)).
+  now exists d; split; [exact Bd|]; rewrite <- Hd; apply round_FLT_FLX. }
+exists 0%R; rewrite Rabs_R0; split; [exact Pb|]; rewrite Rplus_0_r, Rmult_1_r.
+apply round_generic; [apply valid_rnd_N|].
+apply FLT_format_plus_small; [exact Fx|exact Fy|].
+apply Rlt_le, (Rlt_le_trans _ _ _ M), bpow_le; lia.
+Qed.
+
+Lemma FLT_plus_error_N_round_ex : forall x y,
+  generic_format beta (FLT_exp emin prec) x ->
+  generic_format beta (FLT_exp emin prec) y ->
+  exists eps,
+  (Rabs eps <= u_ro beta prec)%R /\
+  (x + y
+   = round beta (FLT_exp emin prec) (Znearest choice) (x + y) * (1 + eps))%R.
+Proof.
+intros x y Fx Fy.
+now apply relative_error_N_round_ex_derive, FLT_plus_error_N_ex.
 Qed.
 
 End Fprop_plus_FLT.
@@ -282,62 +315,58 @@ Variable rnd : R -> Z.
 Context { valid_rnd : Valid_rnd rnd }.
 
 Notation format := (generic_format beta fexp).
-Notation cexp := (canonic_exp beta fexp).
+Notation cexp := (cexp beta fexp).
 
 Lemma ex_shift :
   forall x e, format x -> (e <= cexp x)%Z ->
-  exists m, (x = Z2R m * bpow e)%R.
+  exists m, (x = IZR m * bpow e)%R.
 Proof with auto with typeclass_instances.
 intros x e Fx He.
 exists (Ztrunc (scaled_mantissa beta fexp x)*Zpower beta (cexp x -e))%Z.
 rewrite Fx at 1; unfold F2R; simpl.
-rewrite Z2R_mult, Rmult_assoc.
+rewrite mult_IZR, Rmult_assoc.
 f_equal.
-rewrite Z2R_Zpower.
+rewrite IZR_Zpower.
 2: omega.
 rewrite <- bpow_plus; f_equal; ring.
 Qed.
 
-Lemma ln_beta_minus1 :
+Lemma mag_minus1 :
   forall z, z <> 0%R ->
-  (ln_beta beta z - 1)%Z = ln_beta beta (z / Z2R beta).
+  (mag beta z - 1)%Z = mag beta (z / IZR beta).
 Proof.
 intros z Hz.
 unfold Zminus.
-rewrite <- ln_beta_mult_bpow with (1 := Hz).
+rewrite <- mag_mult_bpow by easy.
 now rewrite bpow_opp, bpow_1.
 Qed.
 
-Theorem round_plus_mult_ulp :
+Theorem round_plus_F2R :
   forall x y, format x -> format y -> (x <> 0)%R ->
-  exists m, (round beta fexp rnd (x+y) = Z2R m * ulp beta fexp (x/Z2R beta))%R.
+  exists m,
+  round beta fexp rnd (x+y) = F2R (Float beta m (cexp (x / IZR beta))).
 Proof with auto with typeclass_instances.
 intros x y Fx Fy Zx.
-case (Zle_or_lt (ln_beta beta (x/Z2R beta)) (ln_beta beta y)); intros H1.
-pose (e:=cexp (x / Z2R beta)).
+case (Zle_or_lt (mag beta (x/IZR beta)) (mag beta y)); intros H1.
+pose (e:=cexp (x / IZR beta)).
 destruct (ex_shift x e) as (nx, Hnx); try exact Fx.
 apply monotone_exp.
-rewrite <- (ln_beta_minus1 x Zx); omega.
+rewrite <- (mag_minus1 x Zx); omega.
 destruct (ex_shift y e) as (ny, Hny); try assumption.
 apply monotone_exp...
 destruct (round_repr_same_exp beta fexp rnd (nx+ny) e) as (n,Hn).
 exists n.
-apply trans_eq with (F2R (Float beta n e)).
+fold e.
 rewrite <- Hn; f_equal.
-rewrite Hnx, Hny; unfold F2R; simpl; rewrite Z2R_plus; ring.
+rewrite Hnx, Hny; unfold F2R; simpl; rewrite plus_IZR; ring.
 unfold F2R; simpl.
-rewrite ulp_neq_0; try easy.
-apply Rmult_integral_contrapositive_currified; try assumption.
-apply Rinv_neq_0_compat.
-apply Rgt_not_eq.
-apply radix_pos.
 (* *)
-destruct (ex_shift (round beta fexp rnd (x + y)) (cexp (x/Z2R beta))) as (n,Hn).
+destruct (ex_shift (round beta fexp rnd (x + y)) (cexp (x/IZR beta))) as (n,Hn).
 apply generic_format_round...
-apply Zle_trans with (cexp (x+y)).
+apply Z.le_trans with (cexp (x+y)).
 apply monotone_exp.
-rewrite <- ln_beta_minus1 by easy.
-rewrite <- (ln_beta_abs beta (x+y)).
+rewrite <- mag_minus1 by easy.
+rewrite <- (mag_abs beta (x+y)).
 (* . *)
 assert (U: (Rabs (x+y) = Rabs x + Rabs y)%R \/ (y <> 0 /\ Rabs (x+y) = Rabs x - Rabs y)%R).
 assert (V: forall x y, (Rabs y <= Rabs x)%R ->
@@ -374,94 +403,89 @@ rewrite Rabs_left1.
 ring.
 lra.
 apply V; left.
-apply ln_beta_lt_pos with beta.
+apply lt_mag with beta.
 now apply Rabs_pos_lt.
-rewrite <- ln_beta_minus1 in H1; try assumption.
-rewrite 2!ln_beta_abs; omega.
+rewrite <- mag_minus1 in H1; try assumption.
+rewrite 2!mag_abs; omega.
 (* . *)
 destruct U as [U|U].
-rewrite U; apply Zle_trans with (ln_beta beta x).
+rewrite U; apply Z.le_trans with (mag beta x).
 omega.
-rewrite <- ln_beta_abs.
-apply ln_beta_le.
+rewrite <- mag_abs.
+apply mag_le.
 now apply Rabs_pos_lt.
 apply Rplus_le_reg_l with (-Rabs x)%R; ring_simplify.
 apply Rabs_pos.
 destruct U as (U',U); rewrite U.
-rewrite <- ln_beta_abs.
-apply ln_beta_minus_lb.
+rewrite <- mag_abs.
+apply mag_minus_lb.
 now apply Rabs_pos_lt.
 now apply Rabs_pos_lt.
-rewrite 2!ln_beta_abs.
-assert (ln_beta beta y < ln_beta beta x - 1)%Z.
-now rewrite (ln_beta_minus1 x Zx).
+rewrite 2!mag_abs.
+assert (mag beta y < mag beta x - 1)%Z.
+now rewrite (mag_minus1 x Zx).
 omega.
-apply canonic_exp_round_ge...
-intros K.
-apply round_plus_eq_zero in K...
+apply cexp_round_ge...
+apply round_plus_neq_0...
 contradict H1; apply Zle_not_lt.
-rewrite <- (ln_beta_minus1 x Zx).
+rewrite <- (mag_minus1 x Zx).
 replace y with (-x)%R.
-rewrite ln_beta_opp; omega.
+rewrite mag_opp; omega.
 lra.
-exists n.
-rewrite ulp_neq_0.
-assumption.
-apply Rmult_integral_contrapositive_currified; try assumption.
-apply Rinv_neq_0_compat.
-apply Rgt_not_eq.
-apply radix_pos.
+now exists n.
 Qed.
 
 Context {exp_not_FTZ : Exp_not_FTZ fexp}.
 
 Theorem round_plus_ge_ulp :
   forall x y, format x -> format y ->
-  round beta fexp rnd (x+y) = 0%R \/
-  (ulp beta fexp (x/Z2R beta) <= Rabs (round beta fexp rnd (x+y)))%R.
+  round beta fexp rnd (x+y) <> 0%R ->
+  (ulp beta fexp (x/IZR beta) <= Rabs (round beta fexp rnd (x+y)))%R.
 Proof with auto with typeclass_instances.
-intros x y Fx Fy.
+intros x y Fx Fy KK.
 case (Req_dec x 0); intros Zx.
 (* *)
 rewrite Zx, Rplus_0_l.
 rewrite round_generic...
 unfold Rdiv; rewrite Rmult_0_l.
-rewrite Fy at 2.
+rewrite Fy.
 unfold F2R; simpl; rewrite Rabs_mult.
 rewrite (Rabs_pos_eq (bpow _)) by apply bpow_ge_0.
 case (Z.eq_dec (Ztrunc (scaled_mantissa beta fexp y)) 0); intros Hm.
-left.
-rewrite Fy, Hm; unfold F2R; simpl; ring.
-right.
+contradict KK.
+rewrite Zx, Fy, Hm; unfold F2R; simpl.
+rewrite Rplus_0_l, Rmult_0_l.
+apply round_0...
 apply Rle_trans with (1*bpow (cexp y))%R.
 rewrite Rmult_1_l.
 rewrite <- ulp_neq_0.
 apply ulp_ge_ulp_0...
 intros K; apply Hm.
 rewrite K, scaled_mantissa_0.
-apply (Ztrunc_Z2R 0).
+apply Ztrunc_IZR.
 apply Rmult_le_compat_r.
 apply bpow_ge_0.
-rewrite <- Z2R_abs.
-apply (Z2R_le 1).
+rewrite <- abs_IZR.
+apply IZR_le.
 apply (Zlt_le_succ 0).
 now apply Z.abs_pos.
 (* *)
-destruct (round_plus_mult_ulp x y Fx Fy Zx) as (m,Hm).
+destruct (round_plus_F2R x y Fx Fy Zx) as (m,Hm).
 case (Z.eq_dec m 0); intros Zm.
-left.
-rewrite Hm, Zm; simpl; ring.
-right.
-rewrite Hm, Rabs_mult.
-rewrite (Rabs_pos_eq (ulp _ _ _)) by apply ulp_ge_0.
-apply Rle_trans with (1*ulp beta fexp (x/Z2R beta))%R.
-right; ring.
+contradict KK.
+rewrite Hm, Zm.
+apply F2R_0.
+rewrite Hm, <- F2R_Zabs.
+rewrite ulp_neq_0.
+rewrite <- (Rmult_1_l (bpow _)).
 apply Rmult_le_compat_r.
-apply ulp_ge_0.
-rewrite <- Z2R_abs.
-apply (Z2R_le 1).
+apply bpow_ge_0.
+apply IZR_le.
 apply (Zlt_le_succ 0).
 now apply Z.abs_pos.
+apply Rmult_integral_contrapositive_currified with (1 := Zx).
+apply Rinv_neq_0_compat.
+apply Rgt_not_eq, radix_pos.
 Qed.
 
 End Fprop_plus_mult_ulp.
@@ -476,27 +500,27 @@ Context { valid_rnd : Valid_rnd rnd }.
 Variable emin prec : Z.
 Context { prec_gt_0_ : Prec_gt_0 prec }.
 
-Theorem round_plus_ge_ulp_FLT : forall x y e,
+Theorem round_FLT_plus_ge :
+  forall x y e,
   generic_format beta (FLT_exp emin prec) x -> generic_format beta (FLT_exp emin prec) y ->
-  (bpow e <= Rabs x)%R ->
-  round beta (FLT_exp emin prec) rnd (x+y) = 0%R \/
-  (bpow (e - prec) <= Rabs (round beta (FLT_exp emin prec) rnd (x+y)))%R.
+  (bpow (e + prec) <= Rabs x)%R ->
+  round beta (FLT_exp emin prec) rnd (x + y) <> 0%R ->
+  (bpow e <= Rabs (round beta (FLT_exp emin prec) rnd (x + y)))%R.
 Proof with auto with typeclass_instances.
-intros x y e Fx Fy He.
+intros x y e Fx Fy He KK.
 assert (Zx: x <> 0%R).
   contradict He.
   apply Rlt_not_le; rewrite He, Rabs_R0.
   apply bpow_gt_0.
-case round_plus_ge_ulp with beta (FLT_exp emin prec) rnd x y...
-intros H; right.
-apply Rle_trans with (2:=H).
+apply Rle_trans with (ulp beta (FLT_exp emin prec) (x/IZR beta)).
+2: apply round_plus_ge_ulp...
 rewrite ulp_neq_0.
-unfold canonic_exp.
-rewrite <- ln_beta_minus1 by easy.
+unfold cexp.
+rewrite <- mag_minus1; try assumption.
 unfold FLT_exp; apply bpow_le.
-apply Zle_trans with (2:=Z.le_max_l _ _).
-destruct (ln_beta beta x) as (n,Hn); simpl.
-assert (e < n)%Z; try omega.
+apply Z.le_trans with (2:=Z.le_max_l _ _).
+destruct (mag beta x) as (n,Hn); simpl.
+assert (e + prec < n)%Z; try omega.
 apply lt_bpow with beta.
 apply Rle_lt_trans with (1:=He).
 now apply Hn.
@@ -506,26 +530,45 @@ apply Rgt_not_eq.
 apply radix_pos.
 Qed.
 
-Theorem round_plus_ge_ulp_FLX : forall x y e,
+Lemma round_FLT_plus_ge' :
+  forall x y e,
+  generic_format beta (FLT_exp emin prec) x -> generic_format beta (FLT_exp emin prec) y ->
+  (x <> 0%R -> (bpow (e+prec) <= Rabs x)%R) ->
+  (x = 0%R -> y <> 0%R -> (bpow e <= Rabs y)%R) ->
+  round beta (FLT_exp emin prec) rnd (x+y) <> 0%R ->
+  (bpow e <= Rabs (round beta (FLT_exp emin prec) rnd (x+y)))%R.
+Proof with auto with typeclass_instances.
+intros x y e Fx Fy H1 H2 H3.
+case (Req_dec x 0); intros H4.
+case (Req_dec y 0); intros H5.
+contradict H3.
+rewrite H4, H5, Rplus_0_l; apply round_0...
+rewrite H4, Rplus_0_l.
+rewrite round_generic...
+apply round_FLT_plus_ge; try easy.
+now apply H1.
+Qed.
+
+Theorem round_FLX_plus_ge :
+  forall x y e,
   generic_format beta (FLX_exp prec) x -> generic_format beta (FLX_exp prec) y ->
-  (bpow e <= Rabs x)%R ->
-  round beta (FLX_exp prec) rnd (x+y) = 0%R \/
-  (bpow (e - prec) <= Rabs (round beta (FLX_exp prec) rnd (x+y)))%R.
+  (bpow (e+prec) <= Rabs x)%R ->
+  (round beta (FLX_exp prec) rnd (x+y) <> 0)%R ->
+  (bpow e <= Rabs (round beta (FLX_exp prec) rnd (x+y)))%R.
 Proof with auto with typeclass_instances.
-intros x y e Fx Fy He.
+intros x y e Fx Fy He KK.
 assert (Zx: x <> 0%R).
   contradict He.
   apply Rlt_not_le; rewrite He, Rabs_R0.
   apply bpow_gt_0.
-case round_plus_ge_ulp with beta (FLX_exp prec) rnd x y...
-intros H; right.
-apply Rle_trans with (2:=H).
+apply Rle_trans with (ulp beta (FLX_exp prec) (x/IZR beta)).
+2: apply round_plus_ge_ulp...
 rewrite ulp_neq_0.
-unfold canonic_exp.
-rewrite <- ln_beta_minus1 by easy.
+unfold cexp.
+rewrite <- mag_minus1 by easy.
 unfold FLX_exp; apply bpow_le.
-destruct (ln_beta beta x) as (n,Hn); simpl.
-assert (e < n)%Z; try omega.
+destruct (mag beta x) as (n,Hn); simpl.
+assert (e + prec < n)%Z; try omega.
 apply lt_bpow with beta.
 apply Rle_lt_trans with (1:=He).
 now apply Hn.
@@ -536,3 +579,28 @@ apply radix_pos.
 Qed.
 
 End Fprop_plus_ge_ulp.
+
+Section Fprop_plus_le_ops.
+
+Variable beta : radix.
+Variable fexp : Z -> Z.
+Context { valid_exp : Valid_exp fexp }.
+Variable choice : Z -> bool.
+
+Lemma plus_error_le_l :
+  forall x y,
+  generic_format beta fexp x -> generic_format beta fexp y ->
+  (Rabs (round beta fexp (Znearest choice) (x + y) - (x + y)) <= Rabs x)%R.
+Proof.
+intros x y Fx Fy.
+apply (Rle_trans _ (Rabs (y - (x + y)))); [now apply round_N_pt|].
+rewrite Rabs_minus_sym; right; f_equal; ring.
+Qed.
+
+Lemma plus_error_le_r :
+  forall x y,
+  generic_format beta fexp x -> generic_format beta fexp y ->
+  (Rabs (round beta fexp (Znearest choice) (x + y) - (x + y)) <= Rabs y)%R.
+Proof. now intros x y Fx Fy; rewrite Rplus_comm; apply plus_error_le_l. Qed.
+
+End Fprop_plus_le_ops.
diff --git a/flocq/Prop/Fprop_relative.v b/flocq/Prop/Relative.v
index 276ccd3b..5f87bd84 100644
--- a/flocq/Prop/Fprop_relative.v
+++ b/flocq/Prop/Relative.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2010-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2010-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -18,7 +18,8 @@ COPYING file for more details.
 *)
 
 (** * Relative error of the roundings *)
-Require Import Fcore.
+Require Import Core.
+Require Import Psatz.  (* for lra *)
 
 Section Fprop_relative.
 
@@ -88,6 +89,32 @@ rewrite Rinv_l with (1 := Hx0).
 now rewrite Rabs_R1, Rmult_1_r.
 Qed.
 
+Lemma relative_error_le_conversion_inv :
+  forall x b,
+  (exists eps,
+   (Rabs eps <= b)%R /\ round beta fexp rnd x = (x * (1 + eps))%R) ->
+  (Rabs (round beta fexp rnd x - x) <= b * Rabs x)%R.
+Proof with auto with typeclass_instances.
+intros x b (eps, (Beps, Heps)).
+assert (Pb : (0 <= b)%R); [now revert Beps; apply Rle_trans, Rabs_pos|].
+rewrite Heps; replace (_ - _)%R with (eps * x)%R; [|ring].
+now rewrite Rabs_mult; apply Rmult_le_compat_r; [apply Rabs_pos|].
+Qed.
+
+Lemma relative_error_le_conversion_round_inv :
+  forall x b,
+  (exists eps,
+   (Rabs eps <= b)%R /\ x = (round beta fexp rnd x * (1 + eps))%R) ->
+  (Rabs (round beta fexp rnd x - x) <= b * Rabs (round beta fexp rnd x))%R.
+Proof with auto with typeclass_instances.
+intros x b.
+set (rx := round _ _ _ _).
+intros (eps, (Beps, Heps)).
+assert (Pb : (0 <= b)%R); [now revert Beps; apply Rle_trans, Rabs_pos|].
+rewrite Heps; replace (_ - _)%R with (- (eps * rx))%R; [|ring].
+now rewrite Rabs_Ropp, Rabs_mult; apply Rmult_le_compat_r; [apply Rabs_pos|].
+Qed.
+
 End relative_error_conversion.
 
 Variable emin p : Z.
@@ -108,8 +135,8 @@ apply Rlt_not_le, bpow_gt_0.
 apply Rlt_le_trans with (ulp beta fexp x)%R.
 now apply error_lt_ulp...
 rewrite ulp_neq_0; trivial.
-unfold canonic_exp.
-destruct (ln_beta beta x) as (ex, He).
+unfold cexp.
+destruct (mag beta x) as (ex, He).
 simpl.
 specialize (He Hx').
 apply Rle_trans with (bpow (-p + 1) * bpow (ex - 1))%R.
@@ -150,7 +177,7 @@ apply relative_error.
 unfold x.
 rewrite <- F2R_Zabs.
 apply bpow_le_F2R.
-apply F2R_lt_reg with beta emin.
+apply lt_F2R with beta emin.
 rewrite F2R_0, F2R_Zabs.
 now apply Rabs_pos_lt.
 Qed.
@@ -179,8 +206,8 @@ apply Rlt_not_le, bpow_gt_0.
 apply Rlt_le_trans with (ulp beta fexp x)%R.
 now apply error_lt_ulp.
 rewrite ulp_neq_0; trivial.
-unfold canonic_exp.
-destruct (ln_beta beta x) as (ex, He).
+unfold cexp.
+destruct (mag beta x) as (ex, He).
 simpl.
 specialize (He Hx').
 assert (He': (emin < ex)%Z).
@@ -218,7 +245,7 @@ exact Hp.
 unfold x.
 rewrite <- F2R_Zabs.
 apply bpow_le_F2R.
-apply F2R_lt_reg with beta emin.
+apply lt_F2R with beta emin.
 rewrite F2R_0, F2R_Zabs.
 now apply Rabs_pos_lt.
 Qed.
@@ -237,15 +264,15 @@ rewrite Rmult_assoc.
 apply Rmult_le_compat_l.
 apply Rlt_le.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 assert (Hx': (x <> 0)%R).
 intros H.
 apply Rlt_not_le with (2 := Hx).
 rewrite H, Rabs_R0.
 apply bpow_gt_0.
 rewrite ulp_neq_0; trivial.
-unfold canonic_exp.
-destruct (ln_beta beta x) as (ex, He).
+unfold cexp.
+destruct (mag beta x) as (ex, He).
 simpl.
 specialize (He Hx').
 apply Rle_trans with (bpow (-p + 1) * bpow (ex - 1))%R.
@@ -274,7 +301,7 @@ apply relative_error_le_conversion...
 apply Rlt_le.
 apply Rmult_lt_0_compat.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 apply bpow_gt_0.
 now apply relative_error_N.
 Qed.
@@ -296,7 +323,7 @@ apply relative_error_N.
 unfold x.
 rewrite <- F2R_Zabs.
 apply bpow_le_F2R.
-apply F2R_lt_reg with beta emin.
+apply lt_F2R with beta emin.
 rewrite F2R_0, F2R_Zabs.
 now apply Rabs_pos_lt.
 Qed.
@@ -311,7 +338,7 @@ apply relative_error_le_conversion...
 apply Rlt_le.
 apply Rmult_lt_0_compat.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 apply bpow_gt_0.
 now apply relative_error_N_F2R_emin.
 Qed.
@@ -329,15 +356,15 @@ rewrite Rmult_assoc.
 apply Rmult_le_compat_l.
 apply Rlt_le.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 assert (Hx': (x <> 0)%R).
 intros H.
 apply Rlt_not_le with (2 := Hx).
 rewrite H, Rabs_R0.
 apply bpow_gt_0.
 rewrite ulp_neq_0; trivial.
-unfold canonic_exp.
-destruct (ln_beta beta x) as (ex, He).
+unfold cexp.
+destruct (mag beta x) as (ex, He).
 simpl.
 specialize (He Hx').
 assert (He': (emin < ex)%Z).
@@ -381,17 +408,250 @@ apply relative_error_N_round with (1 := Hp).
 unfold x.
 rewrite <- F2R_Zabs.
 apply bpow_le_F2R.
-apply F2R_lt_reg with beta emin.
+apply lt_F2R with beta emin.
 rewrite F2R_0, F2R_Zabs.
 now apply Rabs_pos_lt.
 Qed.
 
 End Fprop_relative_generic.
 
+Section Fprop_relative_FLX.
+
+Variable prec : Z.
+Variable Hp : Z.lt 0 prec.
+
+Lemma relative_error_FLX_aux :
+  forall k, (prec <= k - FLX_exp prec k)%Z.
+Proof.
+intros k.
+unfold FLX_exp.
+omega.
+Qed.
+
+Variable rnd : R -> Z.
+Context { valid_rnd : Valid_rnd rnd }.
+
+Theorem relative_error_FLX :
+  forall x,
+  (x <> 0)%R ->
+  (Rabs (round beta (FLX_exp prec) rnd x - x) < bpow (-prec + 1) * Rabs x)%R.
+Proof with auto with typeclass_instances.
+intros x Hx.
+destruct (mag beta x) as (ex, He).
+specialize (He Hx).
+apply relative_error with (ex - 1)%Z...
+intros k _.
+apply relative_error_FLX_aux.
+apply He.
+Qed.
+
+(** 1+#&epsilon;# property in any rounding in FLX *)
+Theorem relative_error_FLX_ex :
+  forall x,
+  exists eps,
+  (Rabs eps < bpow (-prec + 1))%R /\ round beta (FLX_exp prec) rnd x = (x * (1 + eps))%R.
+Proof with auto with typeclass_instances.
+intros x.
+apply relative_error_lt_conversion...
+apply bpow_gt_0.
+now apply relative_error_FLX.
+Qed.
+
+Theorem relative_error_FLX_round :
+  forall x,
+  (x <> 0)%R ->
+  (Rabs (round beta (FLX_exp prec) rnd x - x) < bpow (-prec + 1) * Rabs (round beta (FLX_exp prec) rnd x))%R.
+Proof with auto with typeclass_instances.
+intros x Hx.
+destruct (mag beta x) as (ex, He).
+specialize (He Hx).
+apply relative_error_round with (ex - 1)%Z...
+intros k _.
+apply relative_error_FLX_aux.
+apply He.
+Qed.
+
+Variable choice : Z -> bool.
+
+Theorem relative_error_N_FLX :
+  forall x,
+  (Rabs (round beta (FLX_exp prec) (Znearest choice) x - x) <= /2 * bpow (-prec + 1) * Rabs x)%R.
+Proof with auto with typeclass_instances.
+intros x.
+destruct (Req_dec x 0) as [Hx|Hx].
+(* . *)
+rewrite Hx, round_0...
+unfold Rminus.
+rewrite Rplus_0_l, Rabs_Ropp, Rabs_R0.
+rewrite Rmult_0_r.
+apply Rle_refl.
+(* . *)
+destruct (mag beta x) as (ex, He).
+specialize (He Hx).
+apply relative_error_N with (ex - 1)%Z...
+intros k _.
+apply relative_error_FLX_aux.
+apply He.
+Qed.
+
+(** unit roundoff *)
+Definition u_ro := (/2 * bpow (-prec + 1))%R.
+
+Lemma u_ro_pos : (0 <= u_ro)%R.
+Proof. apply Rmult_le_pos; [lra|apply bpow_ge_0]. Qed.
+
+Lemma u_ro_lt_1 : (u_ro < 1)%R.
+Proof.
+unfold u_ro; apply (Rmult_lt_reg_l 2); [lra|].
+rewrite <-Rmult_assoc, Rinv_r, Rmult_1_l, Rmult_1_r; [|lra].
+apply (Rle_lt_trans _ (bpow 0));
+  [apply bpow_le; omega|simpl; lra].
+Qed.
+
+Lemma u_rod1pu_ro_pos : (0 <= u_ro / (1 + u_ro))%R.
+Proof.
+apply Rmult_le_pos; [|apply Rlt_le, Rinv_0_lt_compat];
+assert (H := u_ro_pos); lra.
+Qed.
+
+Lemma u_rod1pu_ro_le_u_ro : (u_ro / (1 + u_ro) <= u_ro)%R.
+Proof.
+assert (Pu_ro := u_ro_pos).
+apply (Rmult_le_reg_r (1 + u_ro)); [lra|].
+unfold Rdiv; rewrite Rmult_assoc, Rinv_l; [|lra].
+assert (0 <= u_ro * u_ro)%R; [apply Rmult_le_pos|]; lra.
+Qed.
+
+Theorem relative_error_N_FLX' :
+  forall x,
+  (Rabs (round beta (FLX_exp prec) (Znearest choice) x - x)
+   <= u_ro / (1 + u_ro) * Rabs x)%R.
+Proof with auto with typeclass_instances.
+intro x.
+assert (Pu_ro : (0 <= u_ro)%R).
+{ apply Rmult_le_pos; [lra|apply bpow_ge_0]. }
+destruct (Req_dec x 0) as [Zx|Nzx].
+{ rewrite Zx, Rabs_R0, Rmult_0_r, round_0...
+  now unfold Rminus; rewrite Rplus_0_l, Rabs_Ropp, Rabs_R0; right. }
+set (ufpx := bpow (mag beta x - 1)%Z).
+set (rx := round _ _ _ _).
+assert (Pufpx : (0 <= ufpx)%R); [now apply bpow_ge_0|].
+assert (H_2_1 : (Rabs (rx - x) <= u_ro * ufpx)%R).
+{ refine (Rle_trans _ _ _ (error_le_half_ulp _ _ _ _) _);
+    [now apply FLX_exp_valid|right].
+  unfold ulp, cexp, FLX_exp, u_ro, ufpx; rewrite (Req_bool_false _ _ Nzx).
+  rewrite Rmult_assoc, <-bpow_plus; do 2 f_equal; ring. }
+assert (H_2_3 : (ufpx + Rabs (rx - x) <= Rabs x)%R).
+{ apply (Rplus_le_reg_r (- ufpx)); ring_simplify.
+  destruct (Rle_or_lt 0 x) as [Sx|Sx].
+  { apply (Rle_trans _ (Rabs (ufpx - x))).
+    { apply round_N_pt; [now apply FLX_exp_valid|].
+      apply generic_format_bpow; unfold FLX_exp; lia. }
+    rewrite Rabs_minus_sym, Rabs_pos_eq.
+    { now rewrite Rabs_pos_eq; [right; ring|]. }
+    apply (Rplus_le_reg_r ufpx); ring_simplify.
+    now rewrite <-(Rabs_pos_eq _ Sx); apply bpow_mag_le. }
+  apply (Rle_trans _ (Rabs (- ufpx - x))).
+  { apply round_N_pt; [now apply FLX_exp_valid|].
+    apply generic_format_opp, generic_format_bpow; unfold FLX_exp; lia. }
+  rewrite Rabs_pos_eq; [now rewrite Rabs_left; [right|]|].
+  apply (Rplus_le_reg_r x); ring_simplify.
+  rewrite <-(Ropp_involutive x); apply Ropp_le_contravar; unfold ufpx.
+  rewrite <-mag_opp, <-Rabs_pos_eq; [apply bpow_mag_le|]; lra. }
+assert (H : (Rabs ((rx - x) / x) <= u_ro / (1 + u_ro))%R).
+{ assert (H : (0 < ufpx + Rabs (rx - x))%R).
+  { apply Rplus_lt_le_0_compat; [apply bpow_gt_0|apply Rabs_pos]. }
+  apply (Rle_trans _ (Rabs (rx - x) / (ufpx + Rabs (rx - x)))).
+  { unfold Rdiv; rewrite Rabs_mult; apply Rmult_le_compat_l; [apply Rabs_pos|].
+    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; [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].
+Qed.
+
+(** 1+#&epsilon;# property in rounding to nearest in FLX *)
+Theorem relative_error_N_FLX_ex :
+  forall x,
+  exists eps,
+  (Rabs eps <= /2 * bpow (-prec + 1))%R /\ round beta (FLX_exp prec) (Znearest choice) x = (x * (1 + eps))%R.
+Proof with auto with typeclass_instances.
+intros x.
+apply relative_error_le_conversion...
+apply Rlt_le.
+apply Rmult_lt_0_compat.
+apply Rinv_0_lt_compat.
+now apply IZR_lt.
+apply bpow_gt_0.
+now apply relative_error_N_FLX.
+Qed.
+
+Theorem relative_error_N_FLX'_ex :
+  forall x,
+  exists eps,
+  (Rabs eps <= u_ro / (1 + u_ro))%R /\
+  round beta (FLX_exp prec) (Znearest choice) x = (x * (1 + eps))%R.
+Proof with auto with typeclass_instances.
+intros x.
+apply relative_error_le_conversion...
+{ apply u_rod1pu_ro_pos. }
+now apply relative_error_N_FLX'.
+Qed.
+
+Lemma relative_error_N_round_ex_derive :
+  forall x rx,
+  (exists eps, (Rabs eps <= u_ro / (1 + u_ro))%R /\ rx = (x * (1 + eps))%R) ->
+  exists eps, (Rabs eps <= u_ro)%R /\ x = (rx * (1 + eps))%R.
+Proof.
+intros x rx (d, (Bd, Hd)).
+assert (Pu_ro := u_ro_pos).
+assert (H := Rabs_le_inv _ _ Bd).
+assert (H' := u_rod1pu_ro_le_u_ro); assert (H'' := u_ro_lt_1).
+destruct (Req_dec rx 0) as [Zfx|Nzfx].
+{ exists 0%R; split; [now rewrite Rabs_R0|].
+  rewrite Rplus_0_r, Rmult_1_r, Zfx.
+  now rewrite Zfx in Hd; destruct (Rmult_integral _ _ (sym_eq Hd)); [|lra]. }
+destruct (Req_dec x 0) as [Zx|Nzx].
+{ now exfalso; revert Hd; rewrite Zx, Rmult_0_l. }
+set (d' := ((x - rx) / rx)%R).
+assert (Hd' : (Rabs d' <= u_ro)%R).
+{ unfold d'; rewrite Hd.
+  replace (_ / _)%R with (- d / (1 + d))%R; [|now field; split; lra].
+  unfold Rdiv; rewrite Rabs_mult, Rabs_Ropp.
+  rewrite (Rabs_pos_eq (/ _)); [|apply Rlt_le, Rinv_0_lt_compat; lra].
+  apply (Rmult_le_reg_r (1 + d)); [lra|].
+  rewrite Rmult_assoc, Rinv_l, Rmult_1_r; [|lra].
+  apply (Rle_trans _ _ _ Bd).
+  unfold Rdiv; apply Rmult_le_compat_l; [now apply u_ro_pos|].
+  apply (Rle_trans _ (1 - u_ro / (1 + u_ro))); [right; field|]; lra. }
+now exists d'; split; [|unfold d'; field].
+Qed.
+
+Theorem relative_error_N_FLX_round_ex :
+  forall x,
+  exists eps,
+  (Rabs eps <= u_ro)%R /\
+  x = (round beta (FLX_exp prec) (Znearest choice) x * (1 + eps))%R.
+Proof.
+intro x; apply relative_error_N_round_ex_derive, relative_error_N_FLX'_ex.
+Qed.
+
+Theorem relative_error_N_FLX_round :
+  forall x,
+  (Rabs (round beta (FLX_exp prec) (Znearest choice) x - x) <= /2 * bpow (-prec + 1) * Rabs(round beta (FLX_exp prec) (Znearest choice) x))%R.
+Proof.
+intro x.
+apply relative_error_le_conversion_round_inv, relative_error_N_FLX_round_ex.
+Qed.
+
+End Fprop_relative_FLX.
+
 Section Fprop_relative_FLT.
 
 Variable emin prec : Z.
-Variable Hp : Zlt 0 prec.
+Variable Hp : Z.lt 0 prec.
 
 Lemma relative_error_FLT_aux :
   forall k, (emin + prec - 1 < k)%Z -> (prec <= k - FLT_exp emin prec k)%Z.
@@ -486,7 +746,7 @@ apply relative_error_le_conversion...
 apply Rlt_le.
 apply Rmult_lt_0_compat.
 apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
+now apply IZR_lt.
 apply bpow_gt_0.
 now apply relative_error_N_FLT.
 Qed.
@@ -607,23 +867,84 @@ apply Rlt_le, pos_half_prf.
 rewrite ulp_neq_0.
 2: now apply Rgt_not_eq.
 apply bpow_le.
-unfold FLT_exp, canonic_exp.
+unfold FLT_exp, cexp.
 rewrite Zmax_right.
 omega.
-destruct (ln_beta beta x) as (e,He); simpl.
+destruct (mag beta x) as (e,He); simpl.
 assert (e-1 < emin+prec)%Z.
 apply (lt_bpow beta).
 apply Rle_lt_trans with (2:=Hx).
-rewrite <- (Rabs_right x).
-apply He; auto with real.
-apply Rle_ge; now left.
+rewrite <- (Rabs_pos_eq x) by now apply Rlt_le.
+now apply He, Rgt_not_eq.
 omega.
-split;ring.
+split ; ring.
+Qed.
+
+Theorem relative_error_N_FLT'_ex :
+  forall x,
+  exists eps eta : R,
+  (Rabs eps <= u_ro prec / (1 + u_ro prec))%R /\
+  (Rabs eta <= /2 * bpow emin)%R /\
+  (eps * eta = 0)%R /\
+  round beta (FLT_exp emin prec) (Znearest choice) x
+  = (x * (1 + eps) + eta)%R.
+Proof.
+intro x.
+set (rx := round _ _ _ x).
+assert (Pb := u_rod1pu_ro_pos prec).
+destruct (Rle_or_lt (bpow (emin + prec - 1)) (Rabs x)) as [MX|Mx].
+{ destruct (relative_error_N_FLX'_ex prec Hp choice x) as (d, (Bd, Hd)).
+  exists d, 0%R; split; [exact Bd|]; split.
+  { rewrite Rabs_R0; apply Rmult_le_pos; [lra|apply bpow_ge_0]. }
+  rewrite Rplus_0_r, Rmult_0_r; split; [reflexivity|].
+  now rewrite <- Hd; apply round_FLT_FLX. }
+assert (H : (Rabs (rx - x) <= /2 * bpow emin)%R).
+{ refine (Rle_trans _ _ _ (error_le_half_ulp _ _ _ _) _);
+    [now apply FLT_exp_valid|].
+  rewrite ulp_FLT_small; [now right|now simpl|].
+  apply (Rlt_le_trans _ _ _ Mx), bpow_le; lia. }
+exists 0%R, (rx - x)%R; split; [now rewrite Rabs_R0|]; split; [exact H|].
+now rewrite Rmult_0_l, Rplus_0_r, Rmult_1_r; split; [|ring].
+Qed.
+
+Theorem relative_error_N_FLT'_ex_separate :
+  forall x,
+  exists x' : R,
+  round beta (FLT_exp emin prec) (Znearest choice) x'
+  = round beta (FLT_exp emin prec) (Znearest choice) x /\
+  (exists eta, Rabs eta <= /2 * bpow emin /\ x' = x + eta)%R /\
+  (exists eps, Rabs eps <= u_ro prec / (1 + u_ro prec) /\
+               round beta (FLT_exp emin prec) (Znearest choice) x'
+               = x' * (1 + eps))%R.
+Proof.
+intro x.
+set (rx := round _ _ _ x).
+destruct (relative_error_N_FLT'_ex x) as (d, (e, (Bd, (Be, (Hde0, Hde))))).
+destruct (Rlt_or_le (Rabs (d * x)) (Rabs e)) as [HdxLte|HeLedx].
+{ exists rx; split; [|split].
+  { apply round_generic; [now apply valid_rnd_N|].
+    now apply generic_format_round; [apply FLT_exp_valid|apply valid_rnd_N]. }
+  { exists e; split; [exact Be|].
+    unfold rx; rewrite Hde; destruct (Rmult_integral _ _ Hde0) as [Zd|Ze].
+    { now rewrite Zd, Rplus_0_r, Rmult_1_r. }
+    exfalso; revert HdxLte; rewrite Ze, Rabs_R0; apply Rle_not_lt, Rabs_pos. }
+  exists 0%R; split; [now rewrite Rabs_R0; apply u_rod1pu_ro_pos|].
+  rewrite Rplus_0_r, Rmult_1_r; apply round_generic; [now apply valid_rnd_N|].
+  now apply generic_format_round; [apply FLT_exp_valid|apply valid_rnd_N]. }
+exists x; split; [now simpl|split].
+{ exists 0%R; split;
+    [rewrite Rabs_R0; apply Rmult_le_pos; [lra|apply bpow_ge_0]|ring]. }
+exists d; rewrite Hde; destruct (Rmult_integral _ _ Hde0) as [Zd|Ze].
+{ split; [exact Bd|].
+  assert (Ze : e = 0%R); [|now rewrite Ze, Rplus_0_r].
+  apply Rabs_eq_R0, Rle_antisym; [|now apply Rabs_pos].
+  now revert HeLedx; rewrite Zd, Rmult_0_l, Rabs_R0. }
+now rewrite Ze, Rplus_0_r.
 Qed.
 
 End Fprop_relative_FLT.
 
-Lemma error_N_FLT :
+Theorem error_N_FLT :
   forall (emin prec : Z), (0 < prec)%Z ->
   forall (choice : Z -> bool),
   forall (x : R),
@@ -638,9 +959,9 @@ intros emin prec Pprec choice x.
 destruct (Rtotal_order x 0) as [Nx|[Zx|Px]].
 { assert (Pmx : (0 < - x)%R).
   { now rewrite <- Ropp_0; apply Ropp_lt_contravar. }
-  destruct (error_N_FLT_aux emin prec Pprec
-                            (fun t : Z => negb (choice (- (t + 1))%Z))
-                            (- x)%R Pmx)
+  destruct (@error_N_FLT_aux emin prec Pprec
+                             (fun t : Z => negb (choice (- (t + 1))%Z))
+                             (- x)%R Pmx)
     as (d,(e,(Hd,(He,(Hde,Hr))))).
   exists d; exists (- e)%R; split; [exact Hd|split; [|split]].
   { now rewrite Rabs_Ropp. }
@@ -659,124 +980,4 @@ destruct (Rtotal_order x 0) as [Nx|[Zx|Px]].
 now apply error_N_FLT_aux.
 Qed.
 
-Section Fprop_relative_FLX.
-
-Variable prec : Z.
-Variable Hp : Zlt 0 prec.
-
-Lemma relative_error_FLX_aux :
-  forall k, (prec <= k - FLX_exp prec k)%Z.
-Proof.
-intros k.
-unfold FLX_exp.
-omega.
-Qed.
-
-Variable rnd : R -> Z.
-Context { valid_rnd : Valid_rnd rnd }.
-
-Theorem relative_error_FLX :
-  forall x,
-  (x <> 0)%R ->
-  (Rabs (round beta (FLX_exp prec) rnd x - x) < bpow (-prec + 1) * Rabs x)%R.
-Proof with auto with typeclass_instances.
-intros x Hx.
-destruct (ln_beta beta x) as (ex, He).
-specialize (He Hx).
-apply relative_error with (ex - 1)%Z...
-intros k _.
-apply relative_error_FLX_aux.
-apply He.
-Qed.
-
-(** 1+#&epsilon;# property in any rounding in FLX *)
-Theorem relative_error_FLX_ex :
-  forall x,
-  exists eps,
-  (Rabs eps < bpow (-prec + 1))%R /\ round beta (FLX_exp prec) rnd x = (x * (1 + eps))%R.
-Proof with auto with typeclass_instances.
-intros x.
-apply relative_error_lt_conversion...
-apply bpow_gt_0.
-now apply relative_error_FLX.
-Qed.
-
-Theorem relative_error_FLX_round :
-  forall x,
-  (x <> 0)%R ->
-  (Rabs (round beta (FLX_exp prec) rnd x - x) < bpow (-prec + 1) * Rabs (round beta (FLX_exp prec) rnd x))%R.
-Proof with auto with typeclass_instances.
-intros x Hx.
-destruct (ln_beta beta x) as (ex, He).
-specialize (He Hx).
-apply relative_error_round with (ex - 1)%Z...
-intros k _.
-apply relative_error_FLX_aux.
-apply He.
-Qed.
-
-Variable choice : Z -> bool.
-
-Theorem relative_error_N_FLX :
-  forall x,
-  (Rabs (round beta (FLX_exp prec) (Znearest choice) x - x) <= /2 * bpow (-prec + 1) * Rabs x)%R.
-Proof with auto with typeclass_instances.
-intros x.
-destruct (Req_dec x 0) as [Hx|Hx].
-(* . *)
-rewrite Hx, round_0...
-unfold Rminus.
-rewrite Rplus_0_l, Rabs_Ropp, Rabs_R0.
-rewrite Rmult_0_r.
-apply Rle_refl.
-(* . *)
-destruct (ln_beta beta x) as (ex, He).
-specialize (He Hx).
-apply relative_error_N with (ex - 1)%Z...
-intros k _.
-apply relative_error_FLX_aux.
-apply He.
-Qed.
-
-(** 1+#&epsilon;# property in rounding to nearest in FLX *)
-Theorem relative_error_N_FLX_ex :
-  forall x,
-  exists eps,
-  (Rabs eps <= /2 * bpow (-prec + 1))%R /\ round beta (FLX_exp prec) (Znearest choice) x = (x * (1 + eps))%R.
-Proof with auto with typeclass_instances.
-intros x.
-apply relative_error_le_conversion...
-apply Rlt_le.
-apply Rmult_lt_0_compat.
-apply Rinv_0_lt_compat.
-now apply (Z2R_lt 0 2).
-apply bpow_gt_0.
-now apply relative_error_N_FLX.
-Qed.
-
-Theorem relative_error_N_FLX_round :
-  forall x,
-  (Rabs (round beta (FLX_exp prec) (Znearest choice) x - x) <= /2 * bpow (-prec + 1) * Rabs (round beta (FLX_exp prec) (Znearest choice) x))%R.
-Proof with auto with typeclass_instances.
-intros x.
-destruct (Req_dec x 0) as [Hx|Hx].
-(* . *)
-rewrite Hx, round_0...
-unfold Rminus.
-rewrite Rplus_0_l, Rabs_Ropp, Rabs_R0.
-rewrite Rmult_0_r.
-apply Rle_refl.
-(* . *)
-destruct (ln_beta beta x) as (ex, He).
-specialize (He Hx).
-apply relative_error_N_round with (ex - 1)%Z.
-now apply FLX_exp_valid.
-intros k _.
-apply relative_error_FLX_aux.
-exact Hp.
-apply He.
-Qed.
-
-End Fprop_relative_FLX.
-
-End Fprop_relative.
\ No newline at end of file
+End Fprop_relative.
diff --git a/flocq/Appli/Fappli_rnd_odd.v b/flocq/Prop/Round_odd.v
index 273c1000..df2952cc 100644
--- a/flocq/Appli/Fappli_rnd_odd.v
+++ b/flocq/Prop/Round_odd.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2013-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2013-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -21,12 +21,11 @@ COPYING file for more details.
       between rnd_NE and double rounding with rnd_odd and then rnd_NE *)
 
 Require Import Reals Psatz.
-Require Import Fcore.
-Require Import Fcalc_ops.
+Require Import Core Operations.
 
-Definition Zrnd_odd x :=  match Req_EM_T x (Z2R (Zfloor x))  with
+Definition Zrnd_odd x :=  match Req_EM_T x (IZR (Zfloor x))  with
   | left _   => Zfloor x
-  | right _  => match (Zeven (Zfloor x)) with
+  | right _  => match (Z.even (Zfloor x)) with
       | true => Zceil x
       | false => Zfloor x
      end
@@ -41,64 +40,120 @@ split.
 intros x y Hxy.
 assert (Zfloor x <= Zrnd_odd y)%Z.
 (* .. *)
-apply Zle_trans with (Zfloor y).
+apply Z.le_trans with (Zfloor y).
 now apply Zfloor_le.
-unfold Zrnd_odd; destruct (Req_EM_T  y (Z2R (Zfloor y))).
-now apply Zle_refl.
-case (Zeven (Zfloor y)).
-apply le_Z2R.
+unfold Zrnd_odd; destruct (Req_EM_T  y (IZR (Zfloor y))).
+now apply Z.le_refl.
+case (Z.even (Zfloor y)).
+apply le_IZR.
 apply Rle_trans with y.
 apply Zfloor_lb.
 apply Zceil_ub.
-now apply Zle_refl.
+now apply Z.le_refl.
 unfold Zrnd_odd at 1.
 (* . *)
-destruct (Req_EM_T  x (Z2R (Zfloor x))) as [Hx|Hx].
+destruct (Req_EM_T  x (IZR (Zfloor x))) as [Hx|Hx].
 (* .. *)
 apply H.
 (* .. *)
-case_eq (Zeven (Zfloor x)); intros Hx2.
+case_eq (Z.even (Zfloor x)); intros Hx2.
 2: apply H.
-unfold Zrnd_odd; destruct (Req_EM_T  y (Z2R (Zfloor y))) as [Hy|Hy].
+unfold Zrnd_odd; destruct (Req_EM_T  y (IZR (Zfloor y))) as [Hy|Hy].
 apply Zceil_glb.
 now rewrite <- Hy.
-case_eq (Zeven (Zfloor y)); intros Hy2.
+case_eq (Z.even (Zfloor y)); intros Hy2.
 now apply Zceil_le.
 apply Zceil_glb.
 assert (H0:(Zfloor x <= Zfloor y)%Z) by now apply Zfloor_le.
 case (Zle_lt_or_eq _ _  H0); intros H1.
 apply Rle_trans with (1:=Zceil_ub _).
 rewrite Zceil_floor_neq.
-apply Z2R_le; omega.
+apply IZR_le; omega.
 now apply sym_not_eq.
 contradict Hy2.
 rewrite <- H1, Hx2; discriminate.
 (* . *)
 intros n; unfold Zrnd_odd.
-rewrite Zfloor_Z2R, Zceil_Z2R.
-destruct (Req_EM_T  (Z2R n) (Z2R n)); trivial.
-case (Zeven n); trivial.
+rewrite Zfloor_IZR, Zceil_IZR.
+destruct (Req_EM_T  (IZR n) (IZR n)); trivial.
+case (Z.even n); trivial.
 Qed.
 
 
 
-Lemma Zrnd_odd_Zodd: forall x, x <> (Z2R (Zfloor x)) ->
-  (Zeven (Zrnd_odd x)) = false.
+Lemma Zrnd_odd_Zodd: forall x, x <> (IZR (Zfloor x)) ->
+  (Z.even (Zrnd_odd x)) = false.
 Proof.
 intros x Hx; unfold Zrnd_odd.
-destruct (Req_EM_T  x (Z2R (Zfloor x))) as [H|H].
+destruct (Req_EM_T  x (IZR (Zfloor x))) as [H|H].
 now contradict H.
-case_eq (Zeven (Zfloor x)).
+case_eq (Z.even (Zfloor x)).
 (* difficult case *)
 intros H'.
 rewrite Zceil_floor_neq.
-rewrite Zeven_plus, H'.
+rewrite Z.even_add, H'.
 reflexivity.
 now apply sym_not_eq.
 trivial.
 Qed.
 
 
+Lemma Zfloor_plus: forall (n:Z) y,
+  (Zfloor (IZR n+y) = n + Zfloor y)%Z.
+Proof.
+intros n y; unfold Zfloor.
+unfold Zminus; rewrite Zplus_assoc; f_equal.
+apply sym_eq, tech_up.
+rewrite plus_IZR.
+apply Rplus_lt_compat_l.
+apply archimed.
+rewrite plus_IZR, Rplus_assoc.
+apply Rplus_le_compat_l.
+apply Rplus_le_reg_r with (-y)%R.
+ring_simplify (y+1+-y)%R.
+apply archimed.
+Qed.
+
+Lemma Zceil_plus: forall (n:Z) y,
+  (Zceil (IZR n+y) = n + Zceil y)%Z.
+Proof.
+intros n y; unfold Zceil.
+rewrite Ropp_plus_distr, <- Ropp_Ropp_IZR.
+rewrite Zfloor_plus.
+ring.
+Qed.
+
+
+Lemma Zeven_abs: forall z, Z.even (Z.abs z) = Z.even z.
+Proof.
+intros z; case (Zle_or_lt z 0); intros H1.
+rewrite Z.abs_neq; try assumption.
+apply Z.even_opp.
+rewrite Z.abs_eq; auto with zarith.
+Qed.
+
+
+
+
+Lemma Zrnd_odd_plus: forall x y, (x = IZR (Zfloor x)) ->
+    Z.even (Zfloor x) = true ->
+   (IZR (Zrnd_odd (x+y)) = x+IZR (Zrnd_odd y))%R.
+Proof.
+intros x y Hx H.
+unfold Zrnd_odd; rewrite Hx, Zfloor_plus.
+case (Req_EM_T y (IZR (Zfloor y))); intros Hy.
+rewrite Hy; repeat rewrite <- plus_IZR.
+repeat rewrite Zfloor_IZR.
+case (Req_EM_T _ _); intros K; easy.
+case (Req_EM_T _ _); intros K.
+contradict Hy.
+apply Rplus_eq_reg_l with (IZR (Zfloor x)).
+now rewrite K, plus_IZR.
+rewrite Z.even_add, H; simpl.
+case (Z.even (Zfloor y)).
+now rewrite Zceil_plus, plus_IZR.
+now rewrite plus_IZR.
+Qed.
 
 
 Section Fcore_rnd_odd.
@@ -113,20 +168,19 @@ Context { valid_exp : Valid_exp fexp }.
 Context { exists_NE_ : Exists_NE beta fexp }.
 
 Notation format := (generic_format beta fexp).
-Notation canonic := (canonic beta fexp).
-Notation cexp := (canonic_exp beta fexp).
+Notation canonical := (canonical beta fexp).
+Notation cexp := (cexp beta fexp).
 
 
 Definition Rnd_odd_pt (x f : R) :=
   format f /\ ((f = x)%R \/
     ((Rnd_DN_pt format x f \/ Rnd_UP_pt format x f) /\
-    exists g : float beta, f = F2R g /\ canonic g /\ Zeven (Fnum g) = false)).
+    exists g : float beta, f = F2R g /\ canonical g /\ Z.even (Fnum g) = false)).
 
 Definition Rnd_odd (rnd : R -> R) :=
   forall x : R, Rnd_odd_pt x (rnd x).
 
-
-Theorem Rnd_odd_pt_sym :   forall x f : R,
+Theorem Rnd_odd_pt_opp_inv :   forall x f : R,
   Rnd_odd_pt (-x) (-f) -> Rnd_odd_pt x f.
 Proof with auto with typeclass_instances.
 intros x f (H1,H2).
@@ -144,12 +198,12 @@ destruct H2.
 right.
 replace f with (-(-f))%R by ring.
 replace x with (-(-x))%R by ring.
-apply Rnd_DN_UP_pt_sym...
+apply Rnd_UP_pt_opp...
 apply generic_format_opp.
 left.
 replace f with (-(-f))%R by ring.
 replace x with (-(-x))%R by ring.
-apply Rnd_UP_DN_pt_sym...
+apply Rnd_DN_pt_opp...
 apply generic_format_opp.
 exists (Float beta (-Fnum g) (Fexp g)).
 split.
@@ -157,15 +211,15 @@ rewrite F2R_Zopp.
 replace f with (-(-f))%R by ring.
 rewrite Hg1; reflexivity.
 split.
-now apply canonic_opp.
+now apply canonical_opp.
 simpl.
-now rewrite Zeven_opp.
+now rewrite Z.even_opp.
 Qed.
 
 
 Theorem round_odd_opp :
   forall x,
-  (round beta fexp Zrnd_odd  (-x) = (- round beta fexp Zrnd_odd x))%R.
+  round beta fexp Zrnd_odd (-x) = (- round beta fexp Zrnd_odd x)%R.
 Proof.
 intros x; unfold round.
 rewrite <- F2R_Zopp.
@@ -174,36 +228,36 @@ apply f_equal2; apply f_equal.
 rewrite scaled_mantissa_opp.
 generalize (scaled_mantissa beta fexp x); intros r.
 unfold Zrnd_odd.
-case (Req_EM_T (- r) (Z2R (Zfloor (- r)))).
-case (Req_EM_T r (Z2R (Zfloor r))).
+case (Req_EM_T (- r) (IZR (Zfloor (- r)))).
+case (Req_EM_T r (IZR (Zfloor r))).
 intros Y1 Y2.
-apply eq_Z2R.
-now rewrite Z2R_opp, <- Y1, <-Y2.
+apply eq_IZR.
+now rewrite opp_IZR, <- Y1, <-Y2.
 intros Y1 Y2.
-absurd (r=Z2R (Zfloor r)); trivial.
+absurd (r=IZR (Zfloor r)); trivial.
 pattern r at 2; replace r with (-(-r))%R by ring.
-rewrite Y2, <- Z2R_opp.
-rewrite Zfloor_Z2R.
-rewrite Z2R_opp, <- Y2.
+rewrite Y2, <- opp_IZR.
+rewrite Zfloor_IZR.
+rewrite opp_IZR, <- Y2.
 ring.
-case (Req_EM_T r (Z2R (Zfloor r))).
+case (Req_EM_T r (IZR (Zfloor r))).
 intros Y1 Y2.
-absurd (-r=Z2R (Zfloor (-r)))%R; trivial.
+absurd (-r=IZR (Zfloor (-r)))%R; trivial.
 pattern r at 2; rewrite Y1.
-rewrite <- Z2R_opp, Zfloor_Z2R.
-now rewrite Z2R_opp, <- Y1.
+rewrite <- opp_IZR, Zfloor_IZR.
+now rewrite opp_IZR, <- Y1.
 intros Y1 Y2.
 unfold Zceil; rewrite Ropp_involutive.
-replace  (Zeven (Zfloor (- r))) with (negb (Zeven (Zfloor r))).
-case (Zeven (Zfloor r));  simpl; ring.
-apply trans_eq with (Zeven (Zceil r)).
+replace  (Z.even (Zfloor (- r))) with (negb (Z.even (Zfloor r))).
+case (Z.even (Zfloor r));  simpl; ring.
+apply trans_eq with (Z.even (Zceil r)).
 rewrite Zceil_floor_neq.
-rewrite Zeven_plus.
-destruct (Zeven (Zfloor r)); reflexivity.
+rewrite Z.even_add.
+destruct (Z.even (Zfloor r)); reflexivity.
 now apply sym_not_eq.
-rewrite <- (Zeven_opp (Zfloor (- r))).
+rewrite <- (Z.even_opp (Zfloor (- r))).
 reflexivity.
-apply canonic_exp_opp.
+apply cexp_opp.
 Qed.
 
 
@@ -221,7 +275,7 @@ rewrite round_0...
 split.
 apply generic_format_0.
 now left.
-intros Hx; apply Rnd_odd_pt_sym.
+intros Hx; apply Rnd_odd_pt_opp_inv.
 rewrite <- round_odd_opp.
 apply H.
 auto with real.
@@ -248,7 +302,7 @@ right; apply round_UP_pt...
 (* *)
 unfold o, Zrnd_odd, round.
 case (Req_EM_T (scaled_mantissa beta fexp x)
-     (Z2R (Zfloor (scaled_mantissa beta fexp x)))).
+     (IZR (Zfloor (scaled_mantissa beta fexp x)))).
 intros T.
 absurd (o=x); trivial.
 apply round_generic...
@@ -260,20 +314,20 @@ apply Rmult_le_pos.
 now left.
 apply bpow_ge_0.
 intros L.
-case_eq (Zeven (Zfloor (scaled_mantissa beta fexp x))).
+case_eq (Z.even (Zfloor (scaled_mantissa beta fexp x))).
 (* . *)
 generalize (generic_format_round beta fexp Zceil x).
 unfold generic_format.
 set (f:=round beta fexp Zceil x).
-set (ef := canonic_exp beta fexp f).
+set (ef := cexp f).
 set (mf := Ztrunc (scaled_mantissa beta fexp f)).
 exists (Float beta mf ef).
-unfold Fcore_generic_fmt.canonic.
+unfold canonical.
 rewrite <- H0.
 repeat split; try assumption.
-apply trans_eq with (negb (Zeven (Zfloor (scaled_mantissa beta fexp x)))).
+apply trans_eq with (negb (Z.even (Zfloor (scaled_mantissa beta fexp x)))).
 2: rewrite H1; reflexivity.
-apply trans_eq with (negb (Zeven (Fnum
+apply trans_eq with (negb (Z.even (Fnum
   (Float beta  (Zfloor (scaled_mantissa beta fexp x)) (cexp x))))).
 2: reflexivity.
 case (Rle_lt_or_eq_dec 0 (round beta fexp Zfloor x)).
@@ -294,10 +348,10 @@ assumption.
 apply Rmult_le_pos.
 now left.
 apply bpow_ge_0.
-unfold Fcore_generic_fmt.canonic.
+unfold canonical.
 simpl.
-apply sym_eq, canonic_exp_DN...
-unfold Fcore_generic_fmt.canonic.
+apply sym_eq, cexp_DN...
+unfold canonical.
 rewrite <- H0; reflexivity.
 reflexivity.
 apply trans_eq with (round beta fexp Ztrunc (round beta fexp Zceil x)).
@@ -305,7 +359,7 @@ reflexivity.
 apply round_generic...
 intros Y.
 replace  (Fnum {| Fnum := Zfloor (scaled_mantissa beta fexp x); Fexp := cexp x |})
-   with (Fnum (Float beta 0 (fexp (ln_beta beta 0)))).
+   with (Fnum (Float beta 0 (fexp (mag beta 0)))).
 generalize (DN_UP_parity_generic beta fexp)...
 unfold DN_UP_parity_prop.
 intros T; apply T with x; clear T.
@@ -319,15 +373,15 @@ assumption.
 apply Rmult_le_pos.
 now left.
 apply bpow_ge_0.
-apply canonic_0.
-unfold Fcore_generic_fmt.canonic.
+apply canonical_0.
+unfold canonical.
 rewrite <- H0; reflexivity.
 rewrite <- Y; unfold F2R; simpl; ring.
 apply trans_eq with (round beta fexp Ztrunc (round beta fexp Zceil x)).
 reflexivity.
 apply round_generic...
 simpl.
-apply eq_Z2R, Rmult_eq_reg_r with (bpow (cexp x)).
+apply eq_IZR, Rmult_eq_reg_r with (bpow (cexp x)).
 unfold round, F2R in Y; simpl in Y; rewrite <- Y.
 simpl; ring.
 apply Rgt_not_eq, bpow_gt_0.
@@ -338,27 +392,25 @@ rewrite <- round_0 with beta fexp Zfloor...
 apply round_le...
 now left.
 intros Hrx.
-set (ef := canonic_exp beta fexp x).
+set (ef := cexp x).
 set (mf := Zfloor (scaled_mantissa beta fexp x)).
 exists (Float beta mf ef).
-unfold Fcore_generic_fmt.canonic.
+unfold canonical.
 repeat split; try assumption.
 simpl.
 apply trans_eq with (cexp (round beta fexp Zfloor x )).
-apply sym_eq, canonic_exp_DN...
+apply sym_eq, cexp_DN...
 reflexivity.
 intros Hrx; contradict Y.
 replace (Zfloor (scaled_mantissa beta fexp x)) with 0%Z.
 simpl; discriminate.
-apply eq_Z2R, Rmult_eq_reg_r with (bpow (cexp x)).
+apply eq_IZR, Rmult_eq_reg_r with (bpow (cexp x)).
 unfold round, F2R in Hrx; simpl in Hrx; rewrite <- Hrx.
 simpl; ring.
 apply Rgt_not_eq, bpow_gt_0.
 Qed.
 
-
-
-Theorem Rnd_odd_pt_unicity :
+Theorem Rnd_odd_pt_unique :
   forall x f1 f2 : R,
   Rnd_odd_pt x f1 -> Rnd_odd_pt x f2 ->
   f1 = f2.
@@ -381,61 +433,56 @@ contradict L; now rewrite <- H1.
 destruct H2 as [H2|(H2,H2')].
 contradict L; now rewrite <- H2.
 destruct H1 as [H1|H1]; destruct H2 as [H2|H2].
-apply Rnd_DN_pt_unicity with format x; assumption.
+apply Rnd_DN_pt_unique with format x; assumption.
 destruct H1' as (ff,(K1,(K2,K3))).
 destruct H2' as (gg,(L1,(L2,L3))).
 absurd (true = false); try discriminate.
 rewrite <- L3.
-apply trans_eq with (negb (Zeven (Fnum ff))).
+apply trans_eq with (negb (Z.even (Fnum ff))).
 rewrite K3; easy.
 apply sym_eq.
 generalize (DN_UP_parity_generic beta fexp).
 unfold DN_UP_parity_prop; intros T; apply (T x); clear T; try assumption...
-rewrite <- K1; apply Rnd_DN_pt_unicity with (generic_format beta fexp) x; try easy...
+rewrite <- K1; apply Rnd_DN_pt_unique with (generic_format beta fexp) x; try easy...
 now apply round_DN_pt...
-rewrite <- L1; apply Rnd_UP_pt_unicity with (generic_format beta fexp) x; try easy...
+rewrite <- L1; apply Rnd_UP_pt_unique with (generic_format beta fexp) x; try easy...
 now apply round_UP_pt...
 (* *)
 destruct H1' as (ff,(K1,(K2,K3))).
 destruct H2' as (gg,(L1,(L2,L3))).
 absurd (true = false); try discriminate.
 rewrite <- K3.
-apply trans_eq with (negb (Zeven (Fnum gg))).
+apply trans_eq with (negb (Z.even (Fnum gg))).
 rewrite L3; easy.
 apply sym_eq.
 generalize (DN_UP_parity_generic beta fexp).
 unfold DN_UP_parity_prop; intros T; apply (T x); clear T; try assumption...
-rewrite <- L1; apply Rnd_DN_pt_unicity with (generic_format beta fexp) x; try easy...
+rewrite <- L1; apply Rnd_DN_pt_unique with (generic_format beta fexp) x; try easy...
 now apply round_DN_pt...
-rewrite <- K1; apply Rnd_UP_pt_unicity with (generic_format beta fexp) x; try easy...
+rewrite <- K1; apply Rnd_UP_pt_unique with (generic_format beta fexp) x; try easy...
 now apply round_UP_pt...
-apply Rnd_UP_pt_unicity with format x; assumption.
+apply Rnd_UP_pt_unique with format x; assumption.
 Qed.
 
-
-
 Theorem Rnd_odd_pt_monotone :
   round_pred_monotone (Rnd_odd_pt).
 Proof with auto with typeclass_instances.
 intros x y f g H1 H2 Hxy.
 apply Rle_trans with (round beta fexp Zrnd_odd x).
-right; apply Rnd_odd_pt_unicity with x; try assumption.
+right; apply Rnd_odd_pt_unique with x; try assumption.
 apply round_odd_pt.
 apply Rle_trans with (round beta fexp Zrnd_odd y).
 apply round_le...
-right; apply Rnd_odd_pt_unicity with y; try assumption.
+right; apply Rnd_odd_pt_unique with y; try assumption.
 apply round_odd_pt.
 Qed.
 
-
-
-
 End Fcore_rnd_odd.
 
 Section Odd_prop_aux.
 
 Variable beta : radix.
-Hypothesis Even_beta: Zeven (radix_val beta)=true.
+Hypothesis Even_beta: Z.even (radix_val beta)=true.
 
 Notation bpow e := (bpow beta e).
 
@@ -454,26 +501,26 @@ Lemma generic_format_fexpe_fexp: forall x,
  generic_format beta fexp x ->  generic_format beta fexpe x.
 Proof.
 intros x Hx.
-apply generic_inclusion_ln_beta with fexp; trivial; intros Hx2.
-generalize (fexpe_fexp (ln_beta beta x)).
+apply generic_inclusion_mag with fexp; trivial; intros Hx2.
+generalize (fexpe_fexp (mag beta x)).
 omega.
 Qed.
 
 
 
 Lemma exists_even_fexp_lt: forall (c:Z->Z), forall (x:R),
-      (exists f:float beta, F2R f = x /\ (c (ln_beta beta x) < Fexp f)%Z) ->
-      exists f:float beta, F2R f =x /\ canonic beta c f /\ Zeven (Fnum f) = true.
+      (exists f:float beta, F2R f = x /\ (c (mag beta x) < Fexp f)%Z) ->
+      exists f:float beta, F2R f =x /\ canonical beta c f /\ Z.even (Fnum f) = true.
 Proof with auto with typeclass_instances.
 intros c x (g,(Hg1,Hg2)).
 exists (Float beta
-     (Fnum g*Z.pow (radix_val beta) (Fexp g - c (ln_beta beta x)))
-     (c (ln_beta beta x))).
+     (Fnum g*Z.pow (radix_val beta) (Fexp g - c (mag beta x)))
+     (c (mag beta x))).
 assert (F2R (Float beta
-     (Fnum g*Z.pow (radix_val beta) (Fexp g - c (ln_beta beta x)))
-     (c (ln_beta beta x))) = x).
+     (Fnum g*Z.pow (radix_val beta) (Fexp g - c (mag beta x)))
+     (c (mag beta x))) = x).
 unfold F2R; simpl.
-rewrite Z2R_mult, Z2R_Zpower.
+rewrite mult_IZR, IZR_Zpower.
 rewrite Rmult_assoc, <- bpow_plus.
 rewrite <- Hg1; unfold F2R.
 apply f_equal, f_equal.
@@ -481,11 +528,11 @@ ring.
 omega.
 split; trivial.
 split.
-unfold canonic, canonic_exp.
+unfold canonical, cexp.
 now rewrite H.
 simpl.
-rewrite Zeven_mult.
-rewrite Zeven_Zpower.
+rewrite Z.even_mul.
+rewrite Z.even_pow.
 rewrite Even_beta.
 apply Bool.orb_true_intro.
 now right.
@@ -499,9 +546,9 @@ Variable x:R.
 
 Variable d u: float beta.
 Hypothesis Hd: Rnd_DN_pt (generic_format beta fexp) x (F2R d).
-Hypothesis Cd: canonic beta fexp d.
+Hypothesis Cd: canonical beta fexp d.
 Hypothesis Hu: Rnd_UP_pt (generic_format beta fexp) x (F2R u).
-Hypothesis Cu: canonic beta fexp u.
+Hypothesis Cu: canonical beta fexp u.
 
 Hypothesis xPos: (0 < x)%R.
 
@@ -511,14 +558,14 @@ Let m:= ((F2R d+F2R u)/2)%R.
 
 Lemma d_eq: F2R d= round beta fexp Zfloor x.
 Proof with auto with typeclass_instances.
-apply Rnd_DN_pt_unicity with (generic_format beta fexp) x...
+apply Rnd_DN_pt_unique with (generic_format beta fexp) x...
 apply round_DN_pt...
 Qed.
 
 
 Lemma u_eq: F2R u= round beta fexp Zceil x.
 Proof with auto with typeclass_instances.
-apply Rnd_UP_pt_unicity with (generic_format beta fexp) x...
+apply Rnd_UP_pt_unique with (generic_format beta fexp) x...
 apply round_UP_pt...
 Qed.
 
@@ -532,47 +579,47 @@ Qed.
 
 
 
-Lemma ln_beta_d:  (0< F2R d)%R ->
-    (ln_beta beta (F2R d) = ln_beta beta x :>Z).
+Lemma mag_d:  (0< F2R d)%R ->
+    (mag beta (F2R d) = mag beta x :>Z).
 Proof with auto with typeclass_instances.
 intros Y.
-rewrite d_eq; apply ln_beta_DN...
+rewrite d_eq; apply mag_DN...
 now rewrite <- d_eq.
 Qed.
 
 
-Lemma Fexp_d: (0 < F2R d)%R -> Fexp d =fexp (ln_beta beta x).
+Lemma Fexp_d: (0 < F2R d)%R -> Fexp d =fexp (mag beta x).
 Proof with auto with typeclass_instances.
 intros Y.
-now rewrite Cd, <- ln_beta_d.
+now rewrite Cd, <- mag_d.
 Qed.
 
 
 
 Lemma format_bpow_x: (0 < F2R d)%R
-    -> generic_format beta fexp  (bpow (ln_beta beta x)).
+    -> generic_format beta fexp  (bpow (mag beta x)).
 Proof with auto with typeclass_instances.
 intros Y.
 apply generic_format_bpow.
 apply valid_exp.
 rewrite <- Fexp_d; trivial.
-apply Zlt_le_trans with  (ln_beta beta (F2R d))%Z.
-rewrite Cd; apply ln_beta_generic_gt...
+apply Z.lt_le_trans with  (mag beta (F2R d))%Z.
+rewrite Cd; apply mag_generic_gt...
 now apply Rgt_not_eq.
 apply Hd.
-apply ln_beta_le; trivial.
+apply mag_le; trivial.
 apply Hd.
 Qed.
 
 
 Lemma format_bpow_d: (0 < F2R d)%R ->
-  generic_format beta fexp (bpow (ln_beta beta (F2R d))).
+  generic_format beta fexp (bpow (mag beta (F2R d))).
 Proof with auto with typeclass_instances.
 intros Y; apply generic_format_bpow.
 apply valid_exp.
-apply ln_beta_generic_gt...
+apply mag_generic_gt...
 now apply Rgt_not_eq.
-now apply generic_format_canonic.
+now apply generic_format_canonical.
 Qed.
 
 
@@ -596,12 +643,12 @@ unfold m.
 lra.
 Qed.
 
-Lemma ln_beta_m: (0 < F2R d)%R -> (ln_beta beta m =ln_beta beta (F2R d) :>Z).
+Lemma mag_m: (0 < F2R d)%R -> (mag beta m =mag beta (F2R d) :>Z).
 Proof with auto with typeclass_instances.
-intros dPos; apply ln_beta_unique_pos.
+intros dPos; apply mag_unique_pos.
 split.
 apply Rle_trans with (F2R d).
-destruct (ln_beta beta (F2R d)) as (e,He).
+destruct (mag beta (F2R d)) as (e,He).
 simpl.
 rewrite Rabs_right in He.
 apply He.
@@ -614,13 +661,13 @@ rewrite u_eq.
 apply round_le_generic...
 apply generic_format_bpow.
 apply valid_exp.
-apply ln_beta_generic_gt...
+apply mag_generic_gt...
 now apply Rgt_not_eq.
-now apply generic_format_canonic.
-case (Rle_or_lt x (bpow (ln_beta beta (F2R d)))); trivial; intros Z.
-absurd ((bpow (ln_beta beta (F2R d)) <= (F2R d)))%R.
+now apply generic_format_canonical.
+case (Rle_or_lt x (bpow (mag beta (F2R d)))); trivial; intros Z.
+absurd ((bpow (mag beta (F2R d)) <= (F2R d)))%R.
 apply Rlt_not_le.
-destruct  (ln_beta beta (F2R d)) as (e,He).
+destruct  (mag beta (F2R d)) as (e,He).
 simpl in *; rewrite Rabs_right in He.
 apply He.
 now apply Rgt_not_eq.
@@ -630,12 +677,12 @@ apply Rle_trans with (round beta fexp Zfloor x).
 apply round_ge_generic...
 apply generic_format_bpow.
 apply valid_exp.
-apply ln_beta_generic_gt...
+apply mag_generic_gt...
 now apply Rgt_not_eq.
-now apply generic_format_canonic.
+now apply generic_format_canonical.
 now left.
 replace m with (F2R d).
-destruct (ln_beta beta (F2R d)) as (e,He).
+destruct (mag beta (F2R d)) as (e,He).
 simpl in *; rewrite Rabs_right in He.
 apply He.
 now apply Rgt_not_eq.
@@ -645,17 +692,17 @@ lra.
 Qed.
 
 
-Lemma ln_beta_m_0: (0 = F2R d)%R
-    -> (ln_beta beta m =ln_beta beta (F2R u)-1:>Z)%Z.
+Lemma mag_m_0: (0 = F2R d)%R
+    -> (mag beta m =mag beta (F2R u)-1:>Z)%Z.
 Proof with auto with typeclass_instances.
 intros Y.
-apply ln_beta_unique_pos.
+apply mag_unique_pos.
 unfold m; rewrite <- Y, Rplus_0_l.
 rewrite u_eq.
-destruct (ln_beta beta x) as (e,He).
+destruct (mag beta x) as (e,He).
 rewrite Rabs_pos_eq in He by now apply Rlt_le.
 rewrite round_UP_small_pos with (ex:=e).
-rewrite ln_beta_bpow.
+rewrite mag_bpow.
 ring_simplify (fexp e + 1 - 1)%Z.
 split.
 unfold Zminus; rewrite bpow_plus.
@@ -664,7 +711,7 @@ apply bpow_ge_0.
 simpl; unfold Z.pow_pos; simpl.
 rewrite Zmult_1_r; apply Rinv_le.
 exact Rlt_0_2.
-apply (Z2R_le 2).
+apply IZR_le.
 specialize (radix_gt_1 beta).
 omega.
 apply Rlt_le_trans with (bpow (fexp e)*1)%R.
@@ -691,29 +738,29 @@ simpl; now rewrite Fexp_d.
 Qed.
 
 
-
-
-Lemma m_eq: (0 < F2R d)%R ->  exists f:float beta,
-   F2R f = m /\ (Fexp f = fexp (ln_beta beta x) -1)%Z.
+Lemma m_eq :
+  (0 < F2R d)%R ->
+  exists f:float beta,
+  F2R f = m /\ (Fexp f = fexp (mag beta x) - 1)%Z.
 Proof with auto with typeclass_instances.
 intros Y.
 specialize (Zeven_ex (radix_val beta)); rewrite Even_beta.
 intros (b, Hb); rewrite Zplus_0_r in Hb.
 destruct u'_eq as (u', (Hu'1,Hu'2)); trivial.
-exists (Fmult beta (Float beta b (-1)) (Fplus beta d u'))%R.
+exists (Fmult (Float beta b (-1)) (Fplus d u'))%R.
 split.
 rewrite F2R_mult, F2R_plus, Hu'1.
 unfold m; rewrite Rmult_comm.
 unfold Rdiv; apply f_equal.
 unfold F2R; simpl; unfold Z.pow_pos; simpl.
-rewrite Zmult_1_r, Hb, Z2R_mult.
+rewrite Zmult_1_r, Hb, mult_IZR.
 simpl; field.
 apply Rgt_not_eq, Rmult_lt_reg_l with (1 := Rlt_0_2).
-rewrite Rmult_0_r, <- (Z2R_mult 2), <-Hb.
+rewrite Rmult_0_r, <- (mult_IZR 2), <-Hb.
 apply radix_pos.
-apply trans_eq with (-1+Fexp (Fplus beta d u'))%Z.
+apply trans_eq with (-1+Fexp (Fplus d u'))%Z.
 unfold Fmult.
-destruct  (Fplus beta d u'); reflexivity.
+destruct  (Fplus d u'); reflexivity.
 rewrite Zplus_comm; unfold Zminus; apply f_equal2.
 2: reflexivity.
 rewrite Fexp_Fplus.
@@ -723,21 +770,21 @@ rewrite Hu'2; omega.
 Qed.
 
 Lemma m_eq_0: (0 = F2R d)%R ->  exists f:float beta,
-   F2R f = m /\ (Fexp f = fexp (ln_beta beta (F2R u)) -1)%Z.
+   F2R f = m /\ (Fexp f = fexp (mag beta (F2R u)) -1)%Z.
 Proof with auto with typeclass_instances.
 intros Y.
 specialize (Zeven_ex (radix_val beta)); rewrite Even_beta.
 intros (b, Hb); rewrite Zplus_0_r in Hb.
-exists (Fmult beta (Float beta b (-1)) u)%R.
+exists (Fmult (Float beta b (-1)) u)%R.
 split.
 rewrite F2R_mult; unfold m; rewrite <- Y, Rplus_0_l.
 rewrite Rmult_comm.
 unfold Rdiv; apply f_equal.
 unfold F2R; simpl; unfold Z.pow_pos; simpl.
-rewrite Zmult_1_r, Hb, Z2R_mult.
+rewrite Zmult_1_r, Hb, mult_IZR.
 simpl; field.
 apply Rgt_not_eq, Rmult_lt_reg_l with (1 := Rlt_0_2).
-rewrite Rmult_0_r, <- (Z2R_mult 2), <-Hb.
+rewrite Rmult_0_r, <- (mult_IZR 2), <-Hb.
 apply radix_pos.
 apply trans_eq with (-1+Fexp u)%Z.
 unfold Fmult.
@@ -746,12 +793,12 @@ rewrite Zplus_comm, Cu; unfold Zminus; now apply f_equal2.
 Qed.
 
 Lemma fexp_m_eq_0:  (0 = F2R d)%R ->
-  (fexp (ln_beta beta (F2R u)-1) < fexp (ln_beta beta (F2R u))+1)%Z.
+  (fexp (mag beta (F2R u)-1) < fexp (mag beta (F2R u))+1)%Z.
 Proof with auto with typeclass_instances.
 intros Y.
-assert ((fexp (ln_beta beta (F2R u) - 1) <= fexp (ln_beta beta (F2R u))))%Z.
+assert ((fexp (mag beta (F2R u) - 1) <= fexp (mag beta (F2R u))))%Z.
 2: omega.
-destruct (ln_beta beta x) as (e,He).
+destruct (mag beta x) as (e,He).
 rewrite Rabs_right in He.
 2: now left.
 assert (e <= fexp e)%Z.
@@ -760,7 +807,7 @@ now apply He, Rgt_not_eq.
 now rewrite <- d_eq, Y.
 rewrite u_eq, round_UP_small_pos with (ex:=e); trivial.
 2: now apply He, Rgt_not_eq.
-rewrite ln_beta_bpow.
+rewrite mag_bpow.
 ring_simplify (fexp e + 1 - 1)%Z.
 replace (fexp (fexp e)) with (fexp e).
 case exists_NE_; intros V.
@@ -770,33 +817,34 @@ apply sym_eq, valid_exp; omega.
 Qed.
 
 Lemma Fm:  generic_format beta fexpe m.
+Proof.
 case (d_ge_0); intros Y.
 (* *)
 destruct m_eq as (g,(Hg1,Hg2)); trivial.
 apply generic_format_F2R' with g.
 now apply sym_eq.
-intros H; unfold canonic_exp; rewrite Hg2.
-rewrite ln_beta_m; trivial.
+intros H; unfold cexp; rewrite Hg2.
+rewrite mag_m; trivial.
 rewrite <- Fexp_d; trivial.
 rewrite Cd.
-unfold canonic_exp.
-generalize (fexpe_fexp (ln_beta beta (F2R d))).
+unfold cexp.
+generalize (fexpe_fexp (mag beta (F2R d))).
 omega.
 (* *)
 destruct m_eq_0 as (g,(Hg1,Hg2)); trivial.
 apply generic_format_F2R' with g.
 assumption.
-intros H; unfold canonic_exp; rewrite Hg2.
-rewrite ln_beta_m_0; try assumption.
-apply Zle_trans with (1:=fexpe_fexp _).
-assert (fexp (ln_beta beta (F2R u)-1) < fexp (ln_beta beta (F2R u))+1)%Z;[idtac|omega].
-now apply fexp_m_eq_0.
+intros H; unfold cexp; rewrite Hg2.
+rewrite mag_m_0; try assumption.
+apply Z.le_trans with (1:=fexpe_fexp _).
+generalize (fexp_m_eq_0 Y).
+omega.
 Qed.
 
 
 
 Lemma Zm:
-   exists g : float beta, F2R g = m /\ canonic beta fexpe g /\ Zeven (Fnum g) = true.
+   exists g : float beta, F2R g = m /\ canonical beta fexpe g /\ Z.even (Fnum g) = true.
 Proof with auto with typeclass_instances.
 case (d_ge_0); intros Y.
 (* *)
@@ -804,26 +852,27 @@ destruct m_eq as (g,(Hg1,Hg2)); trivial.
 apply exists_even_fexp_lt.
 exists g; split; trivial.
 rewrite Hg2.
-rewrite ln_beta_m; trivial.
+rewrite mag_m; trivial.
 rewrite <- Fexp_d; trivial.
 rewrite Cd.
-unfold canonic_exp.
-generalize (fexpe_fexp  (ln_beta beta (F2R d))).
+unfold cexp.
+generalize (fexpe_fexp  (mag beta (F2R d))).
 omega.
 (* *)
 destruct m_eq_0 as (g,(Hg1,Hg2)); trivial.
 apply exists_even_fexp_lt.
 exists g; split; trivial.
 rewrite Hg2.
-rewrite ln_beta_m_0; trivial.
-apply Zle_lt_trans with (1:=fexpe_fexp _).
-assert (fexp (ln_beta beta (F2R u)-1) < fexp (ln_beta beta (F2R u))+1)%Z;[idtac|omega].
-now apply fexp_m_eq_0.
+rewrite mag_m_0; trivial.
+apply Z.le_lt_trans with (1:=fexpe_fexp _).
+generalize (fexp_m_eq_0 Y).
+omega.
 Qed.
 
 
-Lemma DN_odd_d_aux: forall z, (F2R d<= z< F2R u)%R ->
-    Rnd_DN_pt (generic_format beta fexp) z (F2R d).
+Lemma DN_odd_d_aux :
+  forall z, (F2R d <= z < F2R u)%R ->
+  Rnd_DN_pt (generic_format beta fexp) z (F2R d).
 Proof with auto with typeclass_instances.
 intros z Hz1.
 replace (F2R d) with (round beta fexp Zfloor z).
@@ -834,22 +883,21 @@ intros Y; apply Rle_antisym; trivial.
 apply round_DN_pt...
 apply Hd.
 apply Hz1.
-intros Y; absurd (z < z)%R.
-auto with real.
+intros Y ; elim (Rlt_irrefl z).
 apply Rlt_le_trans with (1:=proj2 Hz1), Rle_trans with (1:=Y).
 apply round_DN_pt...
 Qed.
 
-Lemma UP_odd_d_aux: forall z, (F2R d< z <= F2R u)%R ->
-    Rnd_UP_pt (generic_format beta fexp) z (F2R u).
+Lemma UP_odd_d_aux :
+  forall z, (F2R d < z <= F2R u)%R ->
+  Rnd_UP_pt (generic_format beta fexp) z (F2R u).
 Proof with auto with typeclass_instances.
 intros z Hz1.
 replace (F2R u) with (round beta fexp Zceil z).
 apply round_UP_pt...
 case (Rnd_DN_UP_pt_split _ _ _ _ Hd Hu (round beta fexp Zceil z)).
 apply generic_format_round...
-intros Y; absurd (z < z)%R.
-auto with real.
+intros Y ; elim (Rlt_irrefl z).
 apply Rle_lt_trans with (2:=proj1 Hz1), Rle_trans with (2:=Y).
 apply round_UP_pt...
 intros Y; apply Rle_antisym; trivial.
@@ -859,7 +907,7 @@ apply Hz1.
 Qed.
 
 
-Theorem round_odd_prop_pos:
+Lemma round_N_odd_pos :
   round beta fexp (Znearest choice) (round beta fexpe Zrnd_odd x) =
                round beta fexp (Znearest choice) x.
 Proof with auto with typeclass_instances.
@@ -889,7 +937,7 @@ absurd (true=false).
 discriminate.
 rewrite <- Hk3, <- Hk'3.
 apply f_equal, f_equal.
-apply canonic_unicity with fexpe...
+apply canonical_unique with fexpe...
 now rewrite Hk'1, <- Y2.
 assert (generic_format beta fexp o -> (forall P:Prop, P)).
 intros Y.
@@ -902,14 +950,14 @@ destruct H as (_,(k,(Hk1,(Hk2,Hk3)))).
 destruct (exists_even_fexp_lt fexpe o) as (k',(Hk'1,(Hk'2,Hk'3))).
 eexists; split.
 apply sym_eq, Y.
-simpl; unfold canonic_exp.
-apply Zle_lt_trans with (1:=fexpe_fexp _).
+simpl; unfold cexp.
+apply Z.le_lt_trans with (1:=fexpe_fexp _).
 omega.
 absurd (true=false).
 discriminate.
 rewrite <- Hk3, <- Hk'3.
 apply f_equal, f_equal.
-apply canonic_unicity with fexpe...
+apply canonical_unique with fexpe...
 now rewrite Hk'1, <- Hk1.
 case K1; clear K1; intros K1.
 2: apply H; rewrite <- K1; apply Hd.
@@ -957,7 +1005,7 @@ End Odd_prop_aux.
 Section Odd_prop.
 
 Variable beta : radix.
-Hypothesis Even_beta: Zeven (radix_val beta)=true.
+Hypothesis Even_beta: Z.even (radix_val beta)=true.
 
 Variable fexp : Z -> Z.
 Variable fexpe : Z -> Z.
@@ -970,25 +1018,8 @@ Context { exists_NE_e : Exists_NE beta fexpe }. (* for defining rounding to odd
 
 Hypothesis fexpe_fexp: forall e, (fexpe e <= fexp e -2)%Z.
 
-
-Theorem canonizer: forall f, generic_format beta fexp f
-   -> exists g : float beta, f = F2R g /\ canonic beta fexp g.
-Proof with auto with typeclass_instances.
-intros f Hf.
-exists (Float beta (Ztrunc (scaled_mantissa beta fexp f)) (canonic_exp beta fexp f)).
-assert (L:(f = F2R (Float beta (Ztrunc (scaled_mantissa beta fexp f)) (canonic_exp beta fexp f)))).
-apply trans_eq with (round beta fexp Ztrunc f).
-apply sym_eq, round_generic...
-reflexivity.
-split; trivial.
-unfold canonic; rewrite <- L.
-reflexivity.
-Qed.
-
-
-
-
-Theorem round_odd_prop: forall x,
+Theorem round_N_odd :
+  forall x,
   round beta fexp (Znearest choice) (round beta fexpe Zrnd_odd x) =
                round beta fexp (Znearest choice) x.
 Proof with auto with typeclass_instances.
@@ -998,25 +1029,192 @@ rewrite <- (Ropp_involutive x).
 rewrite round_odd_opp.
 rewrite 2!round_N_opp.
 apply f_equal.
-destruct (canonizer (round beta fexp Zfloor (-x))) as (d,(Hd1,Hd2)).
+destruct (canonical_generic_format beta fexp (round beta fexp Zfloor (-x))) as (d,(Hd1,Hd2)).
 apply generic_format_round...
-destruct (canonizer (round beta fexp Zceil (-x))) as (u,(Hu1,Hu2)).
+destruct (canonical_generic_format beta fexp (round beta fexp Zceil (-x))) as (u,(Hu1,Hu2)).
 apply generic_format_round...
-apply round_odd_prop_pos with d u...
+apply round_N_odd_pos with d u...
 rewrite <- Hd1; apply round_DN_pt...
 rewrite <- Hu1; apply round_UP_pt...
 auto with real.
 (* . *)
 rewrite H; repeat rewrite round_0...
 (* . *)
-destruct (canonizer (round beta fexp Zfloor x)) as (d,(Hd1,Hd2)).
+destruct (canonical_generic_format beta fexp (round beta fexp Zfloor x)) as (d,(Hd1,Hd2)).
 apply generic_format_round...
-destruct (canonizer (round beta fexp Zceil x)) as (u,(Hu1,Hu2)).
+destruct (canonical_generic_format beta fexp (round beta fexp Zceil x)) as (u,(Hu1,Hu2)).
 apply generic_format_round...
-apply round_odd_prop_pos with d u...
+apply round_N_odd_pos with d u...
 rewrite <- Hd1; apply round_DN_pt...
 rewrite <- Hu1; apply round_UP_pt...
 Qed.
 
-
 End Odd_prop.
+
+
+Section Odd_propbis.
+
+Variable beta : radix.
+Hypothesis Even_beta: Z.even (radix_val beta)=true.
+
+Variable emin prec:Z.
+Variable choice:Z->bool.
+
+Hypothesis prec_gt_1: (1 < prec)%Z.
+
+
+Notation format := (generic_format beta (FLT_exp emin prec)).
+Notation round_flt :=(round beta (FLT_exp emin prec) (Znearest choice)).
+Notation cexp_flt := (cexp beta (FLT_exp emin prec)).
+Notation fexpe k := (FLT_exp (emin-k) (prec+k)).
+
+
+
+Lemma Zrnd_odd_plus': forall x y,
+  (exists n:Z, exists e:Z, (x = IZR n*bpow beta e)%R /\ (1 <= e)%Z) ->
+   (IZR (Zrnd_odd (x+y)) = x+IZR (Zrnd_odd y))%R.
+Proof.
+intros x y (n,(e,(H1,H2))).
+apply Zrnd_odd_plus.
+rewrite H1.
+rewrite <- IZR_Zpower.
+2: auto with zarith.
+now rewrite <- mult_IZR, Zfloor_IZR.
+rewrite H1, <- IZR_Zpower.
+2: auto with zarith.
+rewrite <- mult_IZR, Zfloor_IZR.
+rewrite Z.even_mul.
+rewrite Z.even_pow.
+2: auto with zarith.
+rewrite Even_beta.
+apply Bool.orb_true_iff; now right.
+Qed.
+
+
+
+Theorem mag_round_odd: forall (x:R),
+ (emin < mag beta x)%Z ->
+  (mag_val beta _ (mag beta (round beta (FLT_exp emin prec) Zrnd_odd x))
+      = mag_val beta x (mag beta x))%Z.
+Proof with auto with typeclass_instances.
+intros x.
+assert (T:Prec_gt_0 prec).
+unfold Prec_gt_0; auto with zarith.
+case (Req_dec x 0); intros Zx.
+intros _; rewrite Zx, round_0...
+destruct (mag beta x) as (e,He); simpl; intros H.
+apply mag_unique; split.
+apply abs_round_ge_generic...
+apply FLT_format_bpow...
+auto with zarith.
+now apply He.
+assert (V:
+  (Rabs (round beta (FLT_exp emin prec) Zrnd_odd x) <= bpow beta e)%R).
+apply abs_round_le_generic...
+apply FLT_format_bpow...
+auto with zarith.
+left; now apply He.
+case V; try easy; intros K.
+assert (H0:Rnd_odd_pt beta (FLT_exp emin prec) x (round beta (FLT_exp emin prec) Zrnd_odd x)).
+apply round_odd_pt...
+destruct H0 as (_,HH); destruct HH as [H0|(H0,(g,(Hg1,(Hg2,Hg3))))].
+absurd (Rabs x < bpow beta e)%R.
+apply Rle_not_lt; right.
+now rewrite <- H0,K.
+now apply He.
+pose (gg:=Float beta (Zpower beta (e-FLT_exp emin prec (e+1))) (FLT_exp emin prec (e+1))).
+assert (Y1: F2R gg = bpow beta e).
+unfold F2R; simpl.
+rewrite IZR_Zpower.
+rewrite <- bpow_plus.
+f_equal; ring.
+assert (FLT_exp emin prec (e+1) <= e)%Z; [idtac|auto with zarith].
+unfold FLT_exp.
+apply Z.max_case_strong; auto with zarith.
+assert (Y2: canonical beta (FLT_exp emin prec) gg).
+unfold canonical; rewrite Y1; unfold gg; simpl.
+unfold cexp; now rewrite mag_bpow.
+assert (Y3: Fnum gg = Z.abs (Fnum g)).
+apply trans_eq with (Fnum (Fabs g)).
+2: destruct g; unfold Fabs; now simpl.
+f_equal.
+apply canonical_unique with (FLT_exp emin prec); try assumption.
+destruct g; unfold Fabs; apply canonical_abs; easy.
+now rewrite Y1, F2R_abs, <- Hg1,K.
+assert (Y4: Z.even (Fnum gg) = true).
+unfold gg; simpl.
+rewrite Z.even_pow; try assumption.
+assert (FLT_exp emin prec (e+1) < e)%Z; [idtac|auto with zarith].
+unfold FLT_exp.
+apply Z.max_case_strong; auto with zarith.
+absurd (true = false).
+discriminate.
+rewrite <- Hg3.
+rewrite <- Zeven_abs.
+now rewrite <- Y3.
+Qed.
+
+Theorem fexp_round_odd: forall (x:R),
+  (cexp_flt (round beta (FLT_exp emin prec) Zrnd_odd x)
+      = cexp_flt x)%Z.
+Proof with auto with typeclass_instances.
+intros x.
+assert (G0:Valid_exp (FLT_exp emin prec)).
+apply FLT_exp_valid; unfold Prec_gt_0; auto with zarith.
+case (Req_dec x 0); intros Zx.
+rewrite Zx, round_0...
+case (Zle_or_lt (mag beta x) emin).
+unfold cexp; destruct (mag beta x) as (e,He); simpl.
+intros H; unfold FLT_exp at 4.
+rewrite Z.max_r.
+2: auto with zarith.
+apply Z.max_r.
+assert (G: Rabs (round beta (FLT_exp emin prec) Zrnd_odd x) = bpow beta emin).
+assert (G1: (Rabs (round beta (FLT_exp emin prec) Zrnd_odd x) <= bpow beta emin)%R).
+apply abs_round_le_generic...
+apply generic_format_bpow'...
+unfold FLT_exp; rewrite Z.max_r; auto with zarith.
+left; apply Rlt_le_trans with (bpow beta e).
+now apply He.
+now apply bpow_le.
+assert (G2: (0 <= Rabs (round beta (FLT_exp emin prec) Zrnd_odd x))%R).
+apply Rabs_pos.
+assert (G3: (Rabs (round beta (FLT_exp emin prec) Zrnd_odd x) <> 0)%R).
+assert (H0:Rnd_odd_pt beta (FLT_exp emin prec) x
+    (round beta (FLT_exp emin prec) Zrnd_odd x)).
+apply round_odd_pt...
+destruct H0 as (_,H0); destruct H0 as [H0|(_,(g,(Hg1,(Hg2,Hg3))))].
+apply Rgt_not_eq; rewrite H0.
+apply Rlt_le_trans with (bpow beta (e-1)).
+apply bpow_gt_0.
+now apply He.
+rewrite Hg1; intros K.
+contradict Hg3.
+replace (Fnum g) with 0%Z.
+easy.
+case (Z.eq_dec (Fnum g) Z0); intros W; try easy.
+contradict K.
+apply Rabs_no_R0.
+now apply F2R_neq_0.
+apply Rle_antisym; try assumption.
+apply Rle_trans with (succ beta (FLT_exp emin prec) 0).
+right; rewrite succ_0.
+rewrite ulp_FLT_small; try easy.
+unfold Prec_gt_0; auto with zarith.
+rewrite Rabs_R0; apply bpow_gt_0.
+apply succ_le_lt...
+apply generic_format_0.
+apply generic_format_abs; apply generic_format_round...
+case G2; [easy|intros; now contradict G3].
+rewrite <- mag_abs.
+rewrite G, mag_bpow; auto with zarith.
+intros H; unfold cexp.
+now rewrite mag_round_odd.
+Qed.
+
+
+
+
+End Odd_propbis.
+
+
diff --git a/flocq/Prop/Fprop_Sterbenz.v b/flocq/Prop/Sterbenz.v
index 4e74f889..746b7026 100644
--- a/flocq/Prop/Fprop_Sterbenz.v
+++ b/flocq/Prop/Sterbenz.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2010-2013 Sylvie Boldo
+Copyright (C) 2010-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2010-2013 Guillaume Melquiond
+Copyright (C) 2010-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -19,10 +19,7 @@ COPYING file for more details.
 
 (** * Sterbenz conditions for exact subtraction *)
 
-Require Import Fcore_Raux.
-Require Import Fcore_defs.
-Require Import Fcore_generic_fmt.
-Require Import Fcalc_ops.
+Require Import Raux Defs Generic_fmt Operations.
 
 Section Fprop_Sterbenz.
 
@@ -37,7 +34,7 @@ Notation format := (generic_format beta fexp).
 Theorem generic_format_plus :
   forall x y,
   format x -> format y ->
-  (Rabs (x + y) < bpow (Zmin (ln_beta beta x) (ln_beta beta y)))%R ->
+  (Rabs (x + y) <= bpow (Z.min (mag beta x) (mag beta y)))%R ->
   format (x + y)%R.
 Proof.
 intros x y Fx Fy Hxy.
@@ -48,44 +45,51 @@ destruct (Req_dec x R0) as [Zx|Zx].
 now rewrite Zx, Rplus_0_l.
 destruct (Req_dec y R0) as [Zy|Zy].
 now rewrite Zy, Rplus_0_r.
+destruct Hxy as [Hxy|Hxy].
 revert Hxy.
-destruct (ln_beta beta x) as (ex, Ex). simpl.
+destruct (mag beta x) as (ex, Ex). simpl.
 specialize (Ex Zx).
-destruct (ln_beta beta y) as (ey, Ey). simpl.
+destruct (mag beta y) as (ey, Ey). simpl.
 specialize (Ey Zy).
 intros Hxy.
 set (fx := Float beta (Ztrunc (scaled_mantissa beta fexp x)) (fexp ex)).
 assert (Hx: x = F2R fx).
 rewrite Fx at 1.
-unfold canonic_exp.
-now rewrite ln_beta_unique with (1 := Ex).
+unfold cexp.
+now rewrite mag_unique with (1 := Ex).
 set (fy := Float beta (Ztrunc (scaled_mantissa beta fexp y)) (fexp ey)).
 assert (Hy: y = F2R fy).
 rewrite Fy at 1.
-unfold canonic_exp.
-now rewrite ln_beta_unique with (1 := Ey).
+unfold cexp.
+now rewrite mag_unique with (1 := Ey).
 rewrite Hx, Hy.
 rewrite <- F2R_plus.
 apply generic_format_F2R.
 intros _.
-case_eq (Fplus beta fx fy).
+case_eq (Fplus fx fy).
 intros mxy exy Pxy.
 rewrite <- Pxy, F2R_plus, <- Hx, <- Hy.
-unfold canonic_exp.
-replace exy with (fexp (Zmin ex ey)).
+unfold cexp.
+replace exy with (fexp (Z.min ex ey)).
 apply monotone_exp.
-now apply ln_beta_le_bpow.
-replace exy with (Fexp (Fplus beta fx fy)) by exact (f_equal Fexp Pxy).
+now apply mag_le_bpow.
+replace exy with (Fexp (Fplus fx fy)) by exact (f_equal Fexp Pxy).
 rewrite Fexp_Fplus.
 simpl. clear -monotone_exp.
 apply sym_eq.
 destruct (Zmin_spec ex ey) as [(H1,H2)|(H1,H2)] ; rewrite H2.
-apply Zmin_l.
+apply Z.min_l.
 now apply monotone_exp.
-apply Zmin_r.
+apply Z.min_r.
 apply monotone_exp.
 apply Zlt_le_weak.
-now apply Zgt_lt.
+now apply Z.gt_lt.
+apply generic_format_abs_inv.
+rewrite Hxy.
+apply generic_format_bpow.
+apply valid_exp.
+case (Zmin_spec (mag beta x) (mag beta y)); intros (H1,H2);
+   rewrite H2; now apply mag_generic_gt.
 Qed.
 
 Theorem generic_format_plus_weak :
@@ -100,17 +104,17 @@ now rewrite Zx, Rplus_0_l.
 destruct (Req_dec y R0) as [Zy|Zy].
 now rewrite Zy, Rplus_0_r.
 apply generic_format_plus ; try assumption.
-apply Rle_lt_trans with (1 := Hxy).
+apply Rle_trans with (1 := Hxy).
 unfold Rmin.
 destruct (Rle_dec (Rabs x) (Rabs y)) as [Hxy'|Hxy'].
-rewrite Zmin_l.
-destruct (ln_beta beta x) as (ex, Hx).
-now apply Hx.
-now apply ln_beta_le_abs.
-rewrite Zmin_r.
-destruct (ln_beta beta y) as (ex, Hy).
-now apply Hy.
-apply ln_beta_le_abs.
+rewrite Z.min_l.
+destruct (mag beta x) as (ex, Hx).
+apply Rlt_le; now apply Hx.
+now apply mag_le_abs.
+rewrite Z.min_r.
+destruct (mag beta y) as (ex, Hy).
+apply Rlt_le; now apply Hy.
+apply mag_le_abs.
 exact Zy.
 apply Rlt_le.
 now apply Rnot_le_lt.
diff --git a/flocq/Flocq_version.v b/flocq/Version.v
index 72d4fe20..d0e36a57 100644
--- a/flocq/Flocq_version.v
+++ b/flocq/Version.v
@@ -2,9 +2,9 @@
 This file is part of the Flocq formalization of floating-point
 arithmetic in Coq: http://flocq.gforge.inria.fr/
 
-Copyright (C) 2011-2013 Sylvie Boldo
+Copyright (C) 2011-2018 Sylvie Boldo
 #<br />#
-Copyright (C) 2011-2013 Guillaume Melquiond
+Copyright (C) 2011-2018 Guillaume Melquiond
 
 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -29,4 +29,4 @@ Definition Flocq_version := Eval vm_compute in
       parse t major (minor * 10 + N_of_ascii h - N_of_ascii "0"%char)%N
     | Empty_string => (major * 100 + minor)%N
     end in
-  parse "2.6.1"%string N0 N0.
+  parse "3.1.0"%string N0 N0.
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 ba225be1..9540303b 100644
--- a/lib/Floats.v
+++ b/lib/Floats.v
@@ -16,12 +16,10 @@
 
 (** Formalization of floating-point numbers, using the Flocq library. *)
 
-Require Import Coqlib.
-Require Import Integers.
-Require Import Fappli_IEEE.
-Require Import Fappli_IEEE_bits.
-Require Import Fappli_IEEE_extra.
-Require Import Fcore.
+Require Import Coqlib Zbits Integers.
+(*From Flocq*)
+Require Import Binary Bits Core.
+Require Import IEEE754_extra.
 Require Import Program.
 Require Archi.
 
@@ -95,6 +93,17 @@ Proof.
   destruct x as [[]|]; simpl; intros; discriminate.
 Qed.
 
+(** Relation between number of bits and base-2 logarithm *)
+
+Lemma digits2_log2:
+  forall p, Z.pos (Digits.digits2_pos p) = Z.succ (Z.log2 (Z.pos p)).
+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.
+Qed.
+
 Local Notation __ := (eq_refl Datatypes.Lt).
 
 Local Hint Extern 1 (Prec_gt_0 _) => exact (eq_refl Datatypes.Lt).
@@ -111,77 +120,81 @@ Module Float.
 
 (** Transform a Nan payload to a quiet Nan payload. *)
 
-Program Definition transform_quiet_pl (pl:nan_pl 53) : nan_pl 53 :=
-  Pos.lor pl (iter_nat xO 51 xH).
-Next Obligation.
-  destruct pl.
-  simpl. rewrite Z.ltb_lt in *.
-  assert (forall x, Fcore_digits.digits2_pos x = Pos.size x).
-  { induction x0; simpl; auto; rewrite IHx0; zify; omega. }
-  rewrite H, Psize_log_inf, <- Zlog2_log_inf in *. clear H.
-  change (Z.pos (Pos.lor x 2251799813685248)) with (Z.lor (Z.pos x) 2251799813685248%Z).
-  rewrite Z.log2_lor by (zify; omega).
-  apply Z.max_case. auto. simpl. omega.
-Qed.
-
-Lemma nan_payload_fequal:
-  forall prec (p1 p2: nan_pl prec),
-  proj1_sig p1 = proj1_sig p2 -> p1 = p2.
+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.
-  intros. destruct p1, p2; simpl in H; subst. f_equal. apply Fcore_Zaux.eqbool_irrelevance.
+  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.
 
-Lemma lor_idempotent:
-  forall x y, Pos.lor (Pos.lor x y) y = Pos.lor x y.
+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. *)
+
+Lemma expand_nan_proof (p : positive) :
+  nan_pl 24 p = true ->
+  nan_pl 53 (Pos.shiftl_nat p 29) = true.
 Proof.
-  induction x; destruct y; simpl; f_equal; auto;
-  induction y; simpl; f_equal; auto.
+  unfold nan_pl. intros K.
+  rewrite Z.ltb_lt in *.
+  unfold Pos.shiftl_nat, nat_rect, Digits.digits2_pos.
+  fold (Digits.digits2_pos p).
+  zify; omega.
 Qed.
 
-Lemma transform_quiet_pl_idempotent:
-  forall pl, transform_quiet_pl (transform_quiet_pl pl) = transform_quiet_pl pl.
+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 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
+  end.
+
+Lemma reduce_nan_proof (p : positive) :
+  nan_pl 53 p = true ->
+  nan_pl 24 (Pos.shiftr_nat p 29) = true.
 Proof.
-  intros. apply nan_payload_fequal; simpl. apply lor_idempotent.
+  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.
 
-(** Nan payload operations for single <-> double conversions. *)
+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 expand_pl (pl: nan_pl 24) : nan_pl 53.
-Proof.
-  refine (exist _ (Pos.shiftl_nat (proj1_sig pl) 29) _).
-  abstract (
-    destruct pl; unfold proj1_sig, Pos.shiftl_nat, nat_rect, Fcore_digits.digits2_pos;
-    fold (Fcore_digits.digits2_pos x);
-    rewrite Z.ltb_lt in *;
-    zify; omega).
-Defined.
-
-Definition of_single_pl (s:bool) (pl:nan_pl 24) : (bool * nan_pl 53) :=
-  (s,
-   if Archi.float_of_single_preserves_sNaN
-   then expand_pl pl
-   else transform_quiet_pl (expand_pl pl)).
-
-Definition reduce_pl (pl: nan_pl 53) : nan_pl 24.
-Proof.
-  refine (exist _ (Pos.shiftr_nat (proj1_sig pl) 29) _).
-  abstract (
-    destruct pl; unfold proj1_sig, Pos.shiftr_nat, nat_rect;
-    rewrite Z.ltb_lt in *;
-    assert (forall x, Fcore_digits.digits2_pos (Pos.div2 x) =
-                      (Fcore_digits.digits2_pos x - 1)%positive)
-      by (destruct x0; 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]); auto).
-Defined.
-
-Definition to_single_pl (s:bool) (pl:nan_pl 53) : (bool * nan_pl 24) :=
-  (s, reduce_pl (transform_quiet_pl pl)).
+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
+  end.
 
 (** NaN payload operations for opposite and absolute value. *)
 
-Definition neg_pl (s:bool) (pl:nan_pl 53) := (negb s, pl).
-Definition abs_pl (s:bool) (pl:nan_pl 53) := (false, pl).
+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
+  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
+  end.
 
 (** The NaN payload operations for two-argument arithmetic operations
    are not part of the IEEE754 standard, but all architectures of
@@ -191,15 +204,16 @@ Definition abs_pl (s:bool) (pl:nan_pl 53) := (false, pl).
 - a choice function determining which of the payload arguments to choose,
   when an operation is given two NaN arguments. *)
 
-Definition binop_pl (x y: binary64) : bool*nan_pl 53 :=
+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
   match x, y with
-  | B754_nan s1 pl1, B754_nan s2 pl2 =>
-      if Archi.choose_binop_pl_64 s1 pl1 s2 pl2
-      then (s2, transform_quiet_pl pl2)
-      else (s1, transform_quiet_pl pl1)
-  | B754_nan s1 pl1, _ => (s1, transform_quiet_pl pl1)
-  | _, B754_nan s2 pl2 => (s2, transform_quiet_pl pl2)
-  | _, _ => Archi.default_pl_64
+  | 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
   end.
 
 (** ** Operations over double-precision floats *)
@@ -210,16 +224,16 @@ Definition eq_dec: forall (f1 f2: float), {f1 = f2} + {f1 <> f2} := Beq_dec _ _.
 
 (** Arithmetic operations *)
 
-Definition neg: float -> float := Bopp _ _ neg_pl. (**r opposite (change sign) *)
-Definition abs: float -> float := Babs _ _ abs_pl. (**r absolute value (set sign to [+]) *)
+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 add: float -> float -> float :=
-  Bplus 53 1024 __ __ binop_pl mode_NE. (**r addition *)
+  Bplus 53 1024 __ __ binop_nan mode_NE. (**r addition *)
 Definition sub: float -> float -> float :=
-  Bminus 53 1024 __ __ binop_pl mode_NE. (**r subtraction *)
+  Bminus 53 1024 __ __ binop_nan mode_NE. (**r subtraction *)
 Definition mul: float -> float -> float :=
-  Bmult 53 1024 __ __ binop_pl mode_NE. (**r multiplication *)
+  Bmult 53 1024 __ __ binop_nan mode_NE. (**r multiplication *)
 Definition div: float -> float -> float :=
-  Bdiv 53 1024 __ __ binop_pl mode_NE. (**r division *)
+  Bdiv 53 1024 __ __ binop_nan mode_NE. (**r division *)
 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 *)
@@ -229,8 +243,8 @@ Definition ordered (f1 f2: float) : bool :=
 
 (** Conversions *)
 
-Definition of_single: float32 -> float := Bconv _ _ 53 1024 __ __ of_single_pl mode_NE.
-Definition to_single: float -> float32 := Bconv _ _ 24 128 __ __ to_single_pl mode_NE.
+Definition of_single: float32 -> float := Bconv _ _ 53 1024 __ __ of_single_nan mode_NE.
+Definition to_single: float -> float32 := Bconv _ _ 24 128 __ __ to_single_nan mode_NE.
 
 Definition to_int (f:float): option int := (**r conversion to signed 32-bit int *)
   option_map Int.repr (ZofB_range _ _ f Int.min_signed Int.max_signed).
@@ -287,15 +301,19 @@ 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.
-  destruct x, y; try reflexivity. simpl in H. intuition congruence.
+  intros. apply Bplus_commut. unfold binop_nan.
+  destruct Archi.fpu_returns_default_qNaN. easy.
+  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.
-  destruct x, y; try reflexivity. simpl in H. intuition congruence.
+  intros. apply Bmult_commut. unfold binop_nan.
+  destruct Archi.fpu_returns_default_qNaN. easy.
+  destruct x, y; try reflexivity.
+  now destruct H.
 Qed.
 
 (** Multiplication by 2 is diagonal addition. *)
@@ -304,10 +322,10 @@ Theorem mul2_add:
   forall f, add f f = mul f (of_int (Int.repr 2%Z)).
 Proof.
   intros. apply Bmult2_Bplus.
-  intros. destruct x; try discriminate. simpl.
-  transitivity (b, transform_quiet_pl n).
-  destruct Archi.choose_binop_pl_64; auto.
-  destruct y; auto || discriminate.
+  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.
 Qed.
 
 (** Divisions that can be turned into multiplication by an inverse. *)
@@ -317,11 +335,11 @@ Definition exact_inverse : float -> option float := Bexact_inverse 53 1024 __ __
 Theorem div_mul_inverse:
   forall x y z, exact_inverse y = Some z -> div x y = mul x z.
 Proof.
-  intros. apply Bdiv_mult_inverse; auto.
-  intros. destruct x0; try discriminate. simpl.
-  transitivity (b, transform_quiet_pl n).
-  destruct y0; reflexivity || discriminate.
-  destruct z0; reflexivity || discriminate.
+  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.
 Qed.
 
 (** Properties of comparisons. *)
@@ -451,7 +469,7 @@ Proof.
   rewrite Bcompare_correct in CMP by auto.
   inv CMP. apply Rcompare_Lt_inv in H1. rewrite EQy in H1.
   assert (p < Int.unsigned ox8000_0000).
-  { apply lt_Z2R. eapply Rle_lt_trans; eauto. }
+  { apply lt_IZR. apply Rle_lt_trans with (1 := P) (2 := H1). }
   change Int.max_signed with (Int.unsigned ox8000_0000 - 1). omega.
 Qed.
 
@@ -471,7 +489,7 @@ Proof.
   intros (EQy & FINy & SIGNy).
   assert (FINx: is_finite _ _ x = true).
   { rewrite ZofB_correct in C. destruct (is_finite _ _ x) eqn:FINx; congruence. }
-  assert (GE: (B2R _ _ x >= Z2R (Int.unsigned ox8000_0000))%R).
+  assert (GE: (B2R _ _ x >= IZR (Int.unsigned ox8000_0000))%R).
   { rewrite <- EQy. unfold cmp, cmp_of_comparison, compare in H.
     rewrite Bcompare_correct in H by auto.
     destruct (Rcompare (B2R 53 1024 x) (B2R 53 1024 y)) eqn:CMP.
@@ -502,7 +520,6 @@ Proof.
   transitivity (split_bits 52 11 (join_bits 52 11 false (Int.unsigned x) 1075)).
   - f_equal. rewrite Int64.ofwords_add'. reflexivity.
   - apply split_join_bits.
-    compute; auto.
     generalize (Int.unsigned_range x).
     compute_this Int.modulus; compute_this (2^52); omega.
     compute_this (2^11); omega.
@@ -510,7 +527,7 @@ Qed.
 
 Lemma from_words_value:
   forall x,
-     B2R _ _ (from_words ox4330_0000 x) = (bpow radix2 52 + Z2R (Int.unsigned x))%R
+     B2R _ _ (from_words ox4330_0000 x) = (bpow radix2 52 + IZR (Int.unsigned x))%R
   /\ is_finite _ _ (from_words ox4330_0000 x) = true
   /\ Bsign _ _ (from_words ox4330_0000 x) = false.
 Proof.
@@ -520,7 +537,7 @@ Proof.
   destruct (Int.unsigned x + Z.pow_pos 2 52) eqn:?.
   exfalso; now smart_omega.
   simpl; rewrite <- Heqz;  unfold F2R; simpl. split; auto.
-  rewrite <- (Z2R_plus 4503599627370496), Rmult_1_r. f_equal. rewrite Z.add_comm. auto.
+  rewrite Rmult_1_r, plus_IZR. apply Rplus_comm.
   exfalso; now smart_omega.
 Qed.
 
@@ -533,7 +550,7 @@ Proof.
   destruct (BofZ_exact 53 1024 __ __ (2^52 + Int.unsigned x)) as (D & E & F).
   smart_omega.
   apply B2R_Bsign_inj; auto.
-  rewrite A, D. rewrite Z2R_plus. auto.
+  rewrite A, D. rewrite plus_IZR. auto.
   rewrite C, F. symmetry. apply Zlt_bool_false. smart_omega.
 Qed.
 
@@ -585,7 +602,6 @@ Proof.
   transitivity (split_bits 52 11 (join_bits 52 11 false (Int.unsigned x) 1107)).
   - f_equal. rewrite Int64.ofwords_add'. reflexivity.
   - apply split_join_bits.
-    compute; auto.
     generalize (Int.unsigned_range x).
     compute_this Int.modulus; compute_this (2^52); omega.
     compute_this (2^11); omega.
@@ -593,7 +609,7 @@ Qed.
 
 Lemma from_words_value':
   forall x,
-     B2R _ _ (from_words ox4530_0000 x) = (bpow radix2 84 + Z2R (Int.unsigned x * two_p 32))%R
+     B2R _ _ (from_words ox4530_0000 x) = (bpow radix2 84 + IZR (Int.unsigned x * two_p 32))%R
   /\ is_finite _ _ (from_words ox4530_0000 x) = true
   /\ Bsign _ _ (from_words ox4530_0000 x) = false.
 Proof.
@@ -603,8 +619,8 @@ Proof.
   destruct (Int.unsigned x + Z.pow_pos 2 52) eqn:?.
   exfalso; now smart_omega.
   simpl; rewrite <- Heqz;  unfold F2R; simpl. split; auto.
-  rewrite <- (Z2R_plus 19342813113834066795298816), <- (Z2R_mult _ 4294967296).
-  f_equal; compute_this (Z.pow_pos 2 52); compute_this (two_power_pos 32); ring.
+  rewrite plus_IZR, Rmult_plus_distr_r, <- 2!mult_IZR, Rplus_comm.
+  easy.
   assert (Zneg p < 0) by reflexivity.
   exfalso; now smart_omega.
 Qed.
@@ -620,7 +636,7 @@ Proof.
     with  ((2^52 + Int.unsigned x) * 2^32) by ring.
   apply integer_representable_n2p; auto. smart_omega. omega. omega.
   apply B2R_Bsign_inj; auto.
-  rewrite A, D. rewrite <- Z2R_Zpower by omega. rewrite <- Z2R_plus. auto.
+  rewrite A, D. rewrite <- IZR_Zpower by omega. rewrite <- plus_IZR. auto.
   rewrite C, F. symmetry. apply Zlt_bool_false.
   compute_this (2^84); compute_this (2^32); omega.
 Qed.
@@ -904,38 +920,42 @@ Module Float32.
 
 (** ** NaN payload manipulations *)
 
-Program Definition transform_quiet_pl (pl:nan_pl 24) : nan_pl 24 :=
-  Pos.lor pl (iter_nat xO 22 xH).
-Next Obligation.
-  destruct pl.
-  simpl. rewrite Z.ltb_lt in *.
-  assert (forall x, Fcore_digits.digits2_pos x = Pos.size x).
-  { induction x0; simpl; auto; rewrite IHx0; zify; omega. }
-  rewrite H, Psize_log_inf, <- Zlog2_log_inf in *. clear H.
-  change (Z.pos (Pos.lor x 4194304)) with (Z.lor (Z.pos x) 4194304%Z).
-  rewrite Z.log2_lor by (zify; omega).
-  apply Z.max_case. auto. simpl. omega.
-Qed.
-
-Lemma transform_quiet_pl_idempotent:
-  forall pl, transform_quiet_pl (transform_quiet_pl pl) = transform_quiet_pl pl.
+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.
-  intros []; simpl; intros. apply Float.nan_payload_fequal.
-  simpl. apply Float.lor_idempotent.
+  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 neg_pl (s:bool) (pl:nan_pl 24) := (negb s, pl).
-Definition abs_pl (s:bool) (pl:nan_pl 24) := (false, pl).
+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
+  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
+  end.
 
-Definition binop_pl (x y: binary32) : bool*nan_pl 24 :=
+Definition binop_nan (x y : float32) : {x : float32 | is_nan _ _ x = true} :=
+  if Archi.fpu_returns_default_qNaN then Archi.default_nan_32 else
   match x, y with
-  | B754_nan s1 pl1, B754_nan s2 pl2 =>
-      if Archi.choose_binop_pl_32 s1 pl1 s2 pl2
-      then (s2, transform_quiet_pl pl2)
-      else (s1, transform_quiet_pl pl1)
-  | B754_nan s1 pl1, _ => (s1, transform_quiet_pl pl1)
-  | _, B754_nan s2 pl2 => (s2, transform_quiet_pl pl2)
-  | _, _ => Archi.default_pl_32
+  | 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
   end.
 
 (** ** Operations over single-precision floats *)
@@ -946,16 +966,16 @@ Definition eq_dec: forall (f1 f2: float32), {f1 = f2} + {f1 <> f2} := Beq_dec _
 
 (** Arithmetic operations *)
 
-Definition neg: float32 -> float32 := Bopp _ _ neg_pl. (**r opposite (change sign) *)
-Definition abs: float32 -> float32 := Babs _ _ abs_pl. (**r absolute value (set sign to [+]) *)
+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 add: float32 -> float32 -> float32 :=
-  Bplus 24 128 __ __ binop_pl mode_NE. (**r addition *)
+  Bplus 24 128 __ __ binop_nan mode_NE. (**r addition *)
 Definition sub: float32 -> float32 -> float32 :=
-  Bminus 24 128 __ __ binop_pl mode_NE. (**r subtraction *)
+  Bminus 24 128 __ __ binop_nan mode_NE. (**r subtraction *)
 Definition mul: float32 -> float32 -> float32 :=
-  Bmult 24 128 __ __ binop_pl mode_NE. (**r multiplication *)
+  Bmult 24 128 __ __ binop_nan mode_NE. (**r multiplication *)
 Definition div: float32 -> float32 -> float32 :=
-  Bdiv 24 128 __ __ binop_pl mode_NE. (**r division *)
+  Bdiv 24 128 __ __ binop_nan mode_NE. (**r division *)
 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 *)
@@ -1003,15 +1023,19 @@ 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.
-  destruct x, y; try reflexivity. simpl in H. intuition congruence.
+  intros. apply Bplus_commut. unfold binop_nan.
+  destruct Archi.fpu_returns_default_qNaN. easy.
+  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.
-  destruct x, y; try reflexivity. simpl in H. intuition congruence.
+  intros. apply Bmult_commut. unfold binop_nan.
+  destruct Archi.fpu_returns_default_qNaN. easy.
+  destruct x, y; try reflexivity.
+  now destruct H.
 Qed.
 
 (** Multiplication by 2 is diagonal addition. *)
@@ -1020,10 +1044,10 @@ Theorem mul2_add:
   forall f, add f f = mul f (of_int (Int.repr 2%Z)).
 Proof.
   intros. apply Bmult2_Bplus.
-  intros. destruct x; try discriminate. simpl.
-  transitivity (b, transform_quiet_pl n).
-  destruct Archi.choose_binop_pl_32; auto.
-  destruct y; auto || discriminate.
+  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.
 Qed.
 
 (** Divisions that can be turned into multiplication by an inverse. *)
@@ -1033,11 +1057,11 @@ Definition exact_inverse : float32 -> option float32 := Bexact_inverse 24 128 __
 Theorem div_mul_inverse:
   forall x y z, exact_inverse y = Some z -> div x y = mul x z.
 Proof.
-  intros. apply Bdiv_mult_inverse; auto.
-  intros. destruct x0; try discriminate. simpl.
-  transitivity (b, transform_quiet_pl n).
-  destruct y0; reflexivity || discriminate.
-  destruct z0; reflexivity || discriminate.
+  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.
 Qed.
 
 (** Properties of comparisons. *)
@@ -1193,7 +1217,7 @@ 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.
+    rewrite e. apply Z.div_small. omega.
     eapply 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).
@@ -1201,7 +1225,7 @@ Proof.
     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. }
@@ -1264,7 +1288,7 @@ Proof.
   intros.
   pose proof (Int64.unsigned_range n).
   unfold of_longu. erewrite of_long_round_odd.
-  unfold of_double, Float.to_single. instantiate (1 := Float.to_single_pl).
+  unfold of_double, Float.to_single. instantiate (1 := Float.to_single_nan).
   f_equal. unfold Float.of_longu. f_equal.
   set (n' := Z.land (Z.lor (Int64.unsigned n) (Z.land (Int64.unsigned n) 2047 + 2047)) (-2048)).
   assert (int_round_odd (Int64.unsigned n) 11 = n') by (apply int_round_odd_plus; omega).
@@ -1310,7 +1334,7 @@ Proof.
   intros.
   pose proof (Int64.signed_range n).
   unfold of_long. erewrite of_long_round_odd.
-  unfold of_double, Float.to_single. instantiate (1 := Float.to_single_pl).
+  unfold of_double, Float.to_single. instantiate (1 := Float.to_single_nan).
   f_equal. unfold Float.of_long. f_equal.
   set (n' := Z.land (Z.lor (Int64.signed n) (Z.land (Int64.signed n) 2047 + 2047)) (-2048)).
   assert (int_round_odd (Int64.signed n) 11 = n') by (apply int_round_odd_plus; omega).
@@ -1331,9 +1355,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 2a21f88c..9fa07a1d 100644
--- a/lib/Heaps.v
+++ b/lib/Heaps.v
@@ -432,7 +432,7 @@ Lemma lt_heap_In:
 Proof.
   induction h; simpl; intros.
   contradiction.
-  intuition. apply le_lt_trans with x0; auto. red. left. apply E.eq_sym; auto.
+  intuition. apply le_lt_trans with x0; auto. red. left. assumption.
 Qed.
 
 Lemma findMax_max:
diff --git a/lib/Fappli_IEEE_extra.v b/lib/IEEE754_extra.v
index 85fadc16..c23149be 100644
--- a/lib/Fappli_IEEE_extra.v
+++ b/lib/IEEE754_extra.v
@@ -20,15 +20,8 @@
 Require Import Psatz.
 Require Import Bool.
 Require Import Eqdep_dec.
-Require Import Fcore.
-Require Import Fcore_digits.
-Require Import Fcalc_digits.
-Require Import Fcalc_ops.
-Require Import Fcalc_round.
-Require Import Fcalc_bracket.
-Require Import Fprop_Sterbenz.
-Require Import Fappli_IEEE.
-Require Import Fappli_rnd_odd.
+(*From Flocq *)
+Require Import Core Digits Operations Round Bracket Sterbenz Binary Round_odd.
 
 Local Open Scope Z_scope.
 
@@ -65,7 +58,7 @@ Definition is_finite_pos0 (f: binary_float) : bool :=
   match f with
   | B754_zero _ _ s => negb s
   | B754_infinity _ _ _ => false
-  | B754_nan _ _ _ _ => false
+  | B754_nan _ _ _ _ _ => false
   | B754_finite _ _ _ _ _ _ => true
   end.
 
@@ -74,10 +67,10 @@ Lemma Bsign_pos0:
 Proof.
   intros. destruct x as [ [] | | | [] ex mx Bx ]; try discriminate; simpl.
 - rewrite Rlt_bool_false; auto. lra.
-- rewrite Rlt_bool_true; auto. apply F2R_lt_0_compat. compute; auto.
+- rewrite Rlt_bool_true; auto. apply F2R_lt_0. compute; auto.
 - rewrite Rlt_bool_false; auto.
   assert ((F2R (Float radix2 (Z.pos ex) mx) > 0)%R) by
-    ( apply F2R_gt_0_compat; compute; auto ).
+    ( apply F2R_gt_0; compute; auto ).
   lra.
 Qed.
 
@@ -101,18 +94,18 @@ Proof.
   assert (UIP_bool: forall (b1 b2: bool) (e e': b1 = b2), e = e').
   { intros. apply UIP_dec. decide equality. }
   Ltac try_not_eq := try solve [right; congruence].
-  destruct f1 as [| |? []|], f2 as [| |? []|];
-  try destruct b; try destruct b0;
+  destruct f1 as [s1|s1|s1 p1 H1|s1 m1 e1 H1], f2 as [s2|s2|s2 p2 H2|s2 m2 e2 H2];
+  try destruct s1; try destruct s2;
   try solve [left; auto]; try_not_eq.
-  destruct (Pos.eq_dec x x0); try_not_eq;
+  destruct (Pos.eq_dec p1 p2); try_not_eq;
     subst; left; f_equal; f_equal; apply UIP_bool.
-  destruct (Pos.eq_dec x x0); try_not_eq;
+  destruct (Pos.eq_dec p1 p2); try_not_eq;
     subst; left; f_equal; f_equal; apply UIP_bool.
-  destruct (Pos.eq_dec m m0); try_not_eq;
-  destruct (Z.eq_dec e e1); try solve [right; intro H; inversion H; congruence];
+  destruct (Pos.eq_dec m1 m2); try_not_eq;
+  destruct (Z.eq_dec e1 e2); try solve [right; intro H; inversion H; congruence];
   subst; left; f_equal; apply UIP_bool.
-  destruct (Pos.eq_dec m m0); try_not_eq;
-  destruct (Z.eq_dec e e1); try solve [right; intro H; inversion H; congruence];
+  destruct (Pos.eq_dec m1 m2); try_not_eq;
+  destruct (Z.eq_dec e1 e2); try solve [right; intro H; inversion H; congruence];
   subst; left; f_equal; apply UIP_bool.
 Defined.
 
@@ -121,7 +114,7 @@ Defined.
 (** Integers that can be represented exactly as FP numbers. *)
 
 Definition integer_representable (n: Z): Prop :=
-  Z.abs n <= 2^emax - 2^(emax - prec) /\ generic_format radix2 fexp (Z2R n).
+  Z.abs n <= 2^emax - 2^(emax - prec) /\ generic_format radix2 fexp (IZR n).
 
 Let int_upper_bound_eq: 2^emax - 2^(emax - prec) = (2^prec - 1) * 2^(emax - prec).
 Proof.
@@ -142,9 +135,9 @@ Proof.
   rewrite Z.abs_mul. f_equal. rewrite Z.abs_eq. auto. apply (Zpower_ge_0 radix2).
 - apply generic_format_FLT. exists (Float radix2 n p).
   unfold F2R; simpl.
-  split. rewrite <- Z2R_Zpower by auto. apply Z2R_mult.
-  split. zify; omega.
-  unfold emin; red in prec_gt_0_; omega.
+  rewrite <- IZR_Zpower by auto. apply mult_IZR.
+  simpl; zify; omega.
+  unfold emin, Fexp; red in prec_gt_0_; omega.
 Qed.
 
 Lemma integer_representable_2p:
@@ -166,16 +159,16 @@ Proof.
 - red in prec_gt_0_.
   apply generic_format_FLT. exists (Float radix2 1 p).
   unfold F2R; simpl.
-  split. rewrite Rmult_1_l. rewrite <- Z2R_Zpower. auto. omega.
-  split. change 1 with (2^0). apply (Zpower_lt radix2). omega. auto.
-  unfold emin; omega.
+  rewrite Rmult_1_l. rewrite <- IZR_Zpower. auto. omega.
+  simpl Z.abs. change 1 with (2^0). apply (Zpower_lt radix2). omega. auto.
+  unfold emin, Fexp; omega.
 Qed.
 
 Lemma integer_representable_opp:
   forall n, integer_representable n -> integer_representable (-n).
 Proof.
   intros n (A & B); split. rewrite Z.abs_opp. auto.
-  rewrite Z2R_opp. apply generic_format_opp; auto.
+  rewrite opp_IZR. apply generic_format_opp; auto.
 Qed.
 
 Lemma integer_representable_n2p_wide:
@@ -204,19 +197,20 @@ Qed.
 Lemma round_int_no_overflow:
   forall n,
   Z.abs n <= 2^emax - 2^(emax-prec) ->
-  (Rabs (round radix2 fexp (round_mode mode_NE) (Z2R n)) < bpow radix2 emax)%R.
+  (Rabs (round radix2 fexp (round_mode mode_NE) (IZR n)) < bpow radix2 emax)%R.
 Proof.
   intros. red in prec_gt_0_.
   rewrite <- round_NE_abs.
-  apply Rle_lt_trans with (Z2R (2^emax - 2^(emax-prec))).
+  apply Rle_lt_trans with (IZR (2^emax - 2^(emax-prec))).
   apply round_le_generic. apply fexp_correct; auto. apply valid_rnd_N.
   apply generic_format_FLT. exists (Float radix2 (2^prec-1) (emax-prec)).
   rewrite int_upper_bound_eq. unfold F2R; simpl.
-  split. rewrite <- Z2R_Zpower by omega. rewrite <- Z2R_mult. auto.
-  split. assert (0 < 2^prec) by (apply (Zpower_gt_0 radix2); omega). zify; omega.
-  unfold emin; omega.
-  rewrite <- Z2R_abs. apply Z2R_le. auto.
-  rewrite <- Z2R_Zpower by omega. apply Z2R_lt. simpl.
+  rewrite <- IZR_Zpower by omega. rewrite <- mult_IZR. auto.
+  assert (0 < 2^prec) by (apply (Zpower_gt_0 radix2); omega).
+  unfold Fnum; simpl; zify; omega.
+  unfold emin, Fexp; omega.
+  rewrite <- abs_IZR. apply IZR_le. auto.
+  rewrite <- IZR_Zpower by omega. apply IZR_lt. simpl.
   assert (0 < 2^(emax-prec)) by (apply (Zpower_gt_0 radix2); omega).
   omega.
   apply fexp_correct. auto.
@@ -229,9 +223,9 @@ Definition BofZ (n: Z) : binary_float :=
 
 Theorem BofZ_correct:
   forall n,
-  if Rlt_bool (Rabs (round radix2 fexp (round_mode mode_NE) (Z2R n))) (bpow radix2 emax)
+  if Rlt_bool (Rabs (round radix2 fexp (round_mode mode_NE) (IZR n))) (bpow radix2 emax)
   then
-    B2R prec emax (BofZ n) = round radix2 fexp (round_mode mode_NE) (Z2R n) /\
+    B2R prec emax (BofZ n) = round radix2 fexp (round_mode mode_NE) (IZR n) /\
     is_finite _ _ (BofZ n) = true /\
     Bsign prec emax (BofZ n) = Z.ltb n 0
   else
@@ -240,24 +234,24 @@ Proof.
   intros.
   generalize (binary_normalize_correct prec emax prec_gt_0_ Hmax mode_NE n 0 false).
   fold emin; fold fexp; fold (BofZ n).
-  replace (F2R {| Fnum := n; Fexp := 0 |}) with (Z2R n).
+  replace (F2R {| Fnum := n; Fexp := 0 |}) with (IZR n).
   destruct Rlt_bool.
 - intros (A & B & C). split; [|split].
   + auto.
   + auto.
-  + rewrite C. change 0%R with (Z2R 0). rewrite Rcompare_Z2R.
+  + rewrite C. rewrite Rcompare_IZR.
     unfold Z.ltb. auto.
-- intros A; rewrite A. f_equal. change 0%R with (Z2R 0).
+- intros A; rewrite A. f_equal.
   generalize (Z.ltb_spec n 0); intros SPEC; inversion SPEC.
-  apply Rlt_bool_true; apply Z2R_lt; auto.
-  apply Rlt_bool_false; apply Z2R_le; auto.
+  apply Rlt_bool_true; apply IZR_lt; auto.
+  apply Rlt_bool_false; apply IZR_le; auto.
 - unfold F2R; simpl. ring.
 Qed.
 
 Theorem BofZ_finite:
   forall n,
   Z.abs n <= 2^emax - 2^(emax-prec) ->
-  B2R _ _ (BofZ n) = round radix2 fexp (round_mode mode_NE) (Z2R n)
+  B2R _ _ (BofZ n) = round radix2 fexp (round_mode mode_NE) (IZR n)
   /\ is_finite _ _ (BofZ n) = true
   /\ Bsign _ _ (BofZ n) = Z.ltb n 0%Z.
 Proof.
@@ -269,7 +263,7 @@ Qed.
 Theorem BofZ_representable:
   forall n,
   integer_representable n ->
-  B2R _ _ (BofZ n) = Z2R n
+  B2R _ _ (BofZ n) = IZR n
   /\ is_finite _ _ (BofZ n) = true
   /\ Bsign _ _ (BofZ n) = (n <? 0).
 Proof.
@@ -280,7 +274,7 @@ Qed.
 Theorem BofZ_exact:
   forall n,
   -2^prec <= n <= 2^prec ->
-  B2R _ _ (BofZ n) = Z2R n
+  B2R _ _ (BofZ n) = IZR n
   /\ is_finite _ _ (BofZ n) = true
   /\ Bsign _ _ (BofZ n) = Z.ltb n 0%Z.
 Proof.
@@ -294,20 +288,19 @@ Proof.
   intros.
   generalize (binary_normalize_correct prec emax prec_gt_0_ Hmax mode_NE n 0 false).
   fold emin; fold fexp; fold (BofZ n).
-  replace (F2R {| Fnum := n; Fexp := 0 |}) with (Z2R n) by
+  replace (F2R {| Fnum := n; Fexp := 0 |}) with (IZR n) by
     (unfold F2R; simpl; ring).
   rewrite Rlt_bool_true by (apply round_int_no_overflow; auto).
   intros (A & B & C).
   destruct (BofZ n); auto; try discriminate.
-  simpl in *. rewrite C. change 0%R with (Z2R 0). rewrite Rcompare_Z2R.
+  simpl in *. rewrite C. rewrite Rcompare_IZR.
   generalize (Zcompare_spec n 0); intros SPEC; inversion SPEC; auto.
-  assert ((round radix2 fexp ZnearestE (Z2R n) <= -1)%R).
-  { change (-1)%R with (Z2R (-1)).
-    apply round_le_generic. apply fexp_correct. auto. apply valid_rnd_N.
+  assert ((round radix2 fexp ZnearestE (IZR n) <= -1)%R).
+  { apply round_le_generic. apply fexp_correct. auto. apply valid_rnd_N.
     apply (integer_representable_opp 1).
     apply (integer_representable_2p 0).
     red in prec_gt_0_; omega.
-    apply Z2R_le; omega.
+    apply IZR_le; omega.
   }
   lra.
 Qed.
@@ -334,13 +327,13 @@ Proof.
   destruct (BofZ_representable q) as (D & E & F); auto.
   generalize (Bplus_correct _ _ _ Hmax nan mode_NE (BofZ p) (BofZ q) B E).
   fold emin; fold fexp.
-  rewrite A, D. rewrite <- Z2R_plus.
+  rewrite A, D. rewrite <- plus_IZR.
   generalize (BofZ_correct (p + q)). destruct Rlt_bool.
 - intros (P & Q & R) (U & V & W).
   apply B2R_Bsign_inj; auto.
   rewrite P, U; auto.
   rewrite R, W, C, F.
-  change 0%R with (Z2R 0). rewrite Rcompare_Z2R. unfold Z.ltb at 3.
+  rewrite Rcompare_IZR. unfold Z.ltb at 3.
   generalize (Zcompare_spec (p + q) 0); intros SPEC; inversion SPEC; auto.
   assert (EITHER: 0 <= p \/ 0 <= q) by omega.
   destruct EITHER; [apply andb_false_intro1 | apply andb_false_intro2];
@@ -364,13 +357,13 @@ Proof.
   destruct (BofZ_representable q) as (D & E & F); auto.
   generalize (Bminus_correct _ _ _ Hmax nan mode_NE (BofZ p) (BofZ q) B E).
   fold emin; fold fexp.
-  rewrite A, D. rewrite <- Z2R_minus.
+  rewrite A, D. rewrite <- minus_IZR.
   generalize (BofZ_correct (p - q)). destruct Rlt_bool.
 - intros (P & Q & R) (U & V & W).
   apply B2R_Bsign_inj; auto.
   rewrite P, U; auto.
   rewrite R, W, C, F.
-  change 0%R with (Z2R 0). rewrite Rcompare_Z2R. unfold Z.ltb at 3.
+  rewrite Rcompare_IZR. unfold Z.ltb at 3.
   generalize (Zcompare_spec (p - q) 0); intros SPEC; inversion SPEC; auto.
   assert (EITHER: 0 <= p \/ q < 0) by omega.
   destruct EITHER; [apply andb_false_intro1 | apply andb_false_intro2].
@@ -405,7 +398,7 @@ Proof.
   destruct (BofZ_representable q) as (D & E & F); auto.
   generalize (Bmult_correct _ _ _ Hmax nan mode_NE (BofZ p) (BofZ q)).
   fold emin; fold fexp.
-  rewrite A, B, C, D, E, F. rewrite <- Z2R_mult.
+  rewrite A, B, C, D, E, F. rewrite <- mult_IZR.
   generalize (BofZ_correct (p * q)). destruct Rlt_bool.
 - intros (P & Q & R) (U & V & W).
   apply B2R_Bsign_inj; auto.
@@ -431,36 +424,36 @@ Proof.
     apply integer_representable_2p. auto.
     apply (Zpower_gt_0 radix2).
     omega.
-- assert (Z2R x <> 0%R) by (apply (Z2R_neq _ _ n)).
+- assert (IZR x <> 0%R) by (apply (IZR_neq _ _ n)).
   destruct (BofZ_finite x H) as (A & B & C).
   destruct (BofZ_representable (2^p)) as (D & E & F).
     apply integer_representable_2p. auto.
-  assert (canonic_exp radix2 fexp (Z2R (x * 2^p)) =
-          canonic_exp radix2 fexp (Z2R x) + p).
+  assert (cexp radix2 fexp (IZR (x * 2^p)) =
+          cexp radix2 fexp (IZR x) + p).
   {
-    unfold canonic_exp, fexp. rewrite Z2R_mult.
-    change (2^p) with (radix2^p). rewrite Z2R_Zpower by omega.
-    rewrite ln_beta_mult_bpow by auto.
-    assert (prec + 1 <= ln_beta radix2 (Z2R x)).
-    { rewrite <- (ln_beta_abs radix2 (Z2R x)).
-      rewrite <- (ln_beta_bpow radix2 prec).
-      apply ln_beta_le.
-      apply bpow_gt_0. rewrite <- Z2R_Zpower by (red in prec_gt_0_;omega).
-      rewrite <- Z2R_abs. apply Z2R_le; auto. }
+    unfold cexp, fexp. rewrite mult_IZR.
+    change (2^p) with (radix2^p). rewrite IZR_Zpower by omega.
+    rewrite mag_mult_bpow by auto.
+    assert (prec + 1 <= mag radix2 (IZR x)).
+    { rewrite <- (mag_abs radix2 (IZR x)).
+      rewrite <- (mag_bpow radix2 prec).
+      apply mag_le.
+      apply bpow_gt_0. rewrite <- IZR_Zpower by (red in prec_gt_0_;omega).
+      rewrite <- abs_IZR. apply IZR_le; auto. }
     unfold FLT_exp.
     unfold emin; red in prec_gt_0_; zify; omega.
   }
-  assert (forall m, round radix2 fexp m (Z2R x) * Z2R (2^p) =
-                    round radix2 fexp m (Z2R (x * 2^p)))%R.
+  assert (forall m, round radix2 fexp m (IZR x) * IZR (2^p) =
+                    round radix2 fexp m (IZR (x * 2^p)))%R.
   {
     intros. unfold round, scaled_mantissa. rewrite H3.
-    rewrite Z2R_mult. rewrite Z.opp_add_distr. rewrite bpow_plus.
-    set (a := Z2R x); set (b := bpow radix2 (- canonic_exp radix2 fexp a)).
-    replace (a * Z2R (2^p) * (b * bpow radix2 (-p)))%R with (a * b)%R.
+    rewrite mult_IZR. rewrite Z.opp_add_distr. rewrite bpow_plus.
+    set (a := IZR x); set (b := bpow radix2 (- cexp radix2 fexp a)).
+    replace (a * IZR (2^p) * (b * bpow radix2 (-p)))%R with (a * b)%R.
     unfold F2R; simpl. rewrite Rmult_assoc. f_equal.
-    rewrite bpow_plus.  f_equal. apply (Z2R_Zpower radix2). omega.
-    transitivity ((a * b) * (Z2R (2^p) * bpow radix2 (-p)))%R.
-    rewrite (Z2R_Zpower radix2). rewrite <- bpow_plus.
+    rewrite bpow_plus.  f_equal. apply (IZR_Zpower radix2). omega.
+    transitivity ((a * b) * (IZR (2^p) * bpow radix2 (-p)))%R.
+    rewrite (IZR_Zpower radix2). rewrite <- bpow_plus.
     replace (p + -p) with 0 by omega. change (bpow radix2 0) with 1%R. ring.
     omega.
     ring.
@@ -502,7 +495,7 @@ Lemma round_odd_flt:
   round radix2 fexp (Znearest choice) (round radix2 (FLT_exp emin' prec') Zrnd_odd x) =
   round radix2 fexp (Znearest choice) x.
 Proof.
-  intros. apply round_odd_prop. auto. apply fexp_correct; auto.
+  intros. apply round_N_odd. auto. apply fexp_correct; auto.
   apply exists_NE_FLT. right; omega.
   apply FLT_exp_valid. red; omega.
   apply exists_NE_FLT. right; omega.
@@ -519,17 +512,17 @@ Corollary round_odd_fix:
 Proof.
   intros. destruct (Req_EM_T x 0%R).
 - subst x. rewrite round_0. auto. apply valid_rnd_odd.
-- set (prec' := ln_beta radix2 x - p).
+- set (prec' := mag radix2 x - p).
   set (emin' := emin - 2).
-  assert (PREC: ln_beta radix2 (bpow radix2 (prec + p + 1)) <= ln_beta radix2 x).
-  { rewrite <- (ln_beta_abs radix2 x).
-    apply ln_beta_le; auto. apply bpow_gt_0. }
-  rewrite ln_beta_bpow in PREC.
-  assert (CANON: canonic_exp radix2 (FLT_exp emin' prec') x =
-                 canonic_exp radix2 (FIX_exp p) x).
+  assert (PREC: mag radix2 (bpow radix2 (prec + p + 1)) <= mag radix2 x).
+  { rewrite <- (mag_abs radix2 x).
+    apply mag_le; auto. apply bpow_gt_0. }
+  rewrite mag_bpow in PREC.
+  assert (CANON: cexp radix2 (FLT_exp emin' prec') x =
+                 cexp radix2 (FIX_exp p) x).
   {
-    unfold canonic_exp, FLT_exp, FIX_exp.
-    replace (ln_beta radix2 x - prec') with p by (unfold prec'; omega).
+    unfold cexp, FLT_exp, FIX_exp.
+    replace (mag radix2 x - prec') with p by (unfold prec'; omega).
     apply Z.max_l. unfold emin', emin. red in prec_gt_0_; omega.
   }
   assert (RND: round radix2 (FIX_exp p) Zrnd_odd x =
@@ -549,7 +542,7 @@ Definition int_round_odd (x: Z) (p: Z) :=
 
 Lemma Zrnd_odd_int:
   forall n p, 0 <= p ->
-  Zrnd_odd (Z2R n * bpow radix2 (-p)) * 2^p =
+  Zrnd_odd (IZR n * bpow radix2 (-p)) * 2^p =
   int_round_odd n p.
 Proof.
   intros.
@@ -561,29 +554,29 @@ Proof.
   pose proof (bpow_gt_0 radix2 (-p)).
   assert (bpow radix2 p * bpow radix2 (-p) = 1)%R.
   { rewrite <- bpow_plus. replace (p + -p) with 0 by omega. auto. }
-  assert (Z2R n * bpow radix2 (-p) = Z2R q + Z2R r * bpow radix2 (-p))%R.
-  { rewrite H1. rewrite Z2R_plus, Z2R_mult.
-    change (Z2R (2^p)) with (Z2R (radix2^p)).
-    rewrite Z2R_Zpower by omega. ring_simplify.
+  assert (IZR n * bpow radix2 (-p) = IZR q + IZR r * bpow radix2 (-p))%R.
+  { rewrite H1. rewrite plus_IZR, mult_IZR.
+    change (IZR (2^p)) with (IZR (radix2^p)).
+    rewrite IZR_Zpower by omega. ring_simplify.
     rewrite Rmult_assoc. rewrite H4. ring. }
-  assert (0 <= Z2R r < bpow radix2 p)%R.
-  { split. change 0%R with (Z2R 0). apply Z2R_le; omega.
-    rewrite <- Z2R_Zpower by omega. apply Z2R_lt; tauto. }
-  assert (0 <= Z2R r * bpow radix2 (-p) < 1)%R.
+  assert (0 <= IZR r < bpow radix2 p)%R.
+  { split. apply IZR_le; omega.
+    rewrite <- IZR_Zpower by omega. apply IZR_lt; tauto. }
+  assert (0 <= IZR r * bpow radix2 (-p) < 1)%R.
   { generalize (bpow_gt_0 radix2 (-p)). intros.
     split. apply Rmult_le_pos; lra.
     rewrite <- H4. apply Rmult_lt_compat_r. auto. tauto. }
-  assert (Zfloor (Z2R n * bpow radix2 (-p)) = q).
-  { apply Zfloor_imp. rewrite H5. rewrite Z2R_plus. change (Z2R 1) with 1%R. lra. }
+  assert (Zfloor (IZR n * bpow radix2 (-p)) = q).
+  { apply Zfloor_imp. rewrite H5. rewrite plus_IZR. lra. }
   unfold Zrnd_odd. destruct Req_EM_T.
-- assert (Z2R r * bpow radix2 (-p) = 0)%R.
+- assert (IZR r * bpow radix2 (-p) = 0)%R.
   { rewrite H8 in e. rewrite e in H5. lra. }
   apply Rmult_integral in H9. destruct H9; [ | lra ].
-  apply (eq_Z2R r 0) in H9. apply <- Z.eqb_eq in H9. rewrite H9. assumption.
-- assert (Z2R r * bpow radix2 (-p) <> 0)%R.
+  apply (eq_IZR r 0) in H9. apply <- Z.eqb_eq in H9. rewrite H9. assumption.
+- assert (IZR r * bpow radix2 (-p) <> 0)%R.
   { rewrite H8 in n0. lra. }
   destruct (Z.eqb r 0) eqn:RZ.
-  apply Z.eqb_eq in RZ. rewrite RZ in H9. change (Z2R 0) with 0%R in H9.
+  apply Z.eqb_eq in RZ. rewrite RZ in H9.
   rewrite Rmult_0_l in H9. congruence.
   rewrite Zceil_floor_neq by lra. rewrite H8.
   change Zeven with Z.even. rewrite Zodd_even_bool. destruct (Z.even q); auto.
@@ -594,9 +587,9 @@ Lemma int_round_odd_le:
   x <= y -> int_round_odd x p <= int_round_odd y p.
 Proof.
   intros.
-  assert (Zrnd_odd (Z2R x * bpow radix2 (-p)) <= Zrnd_odd (Z2R y * bpow radix2 (-p))).
+  assert (Zrnd_odd (IZR x * bpow radix2 (-p)) <= Zrnd_odd (IZR y * bpow radix2 (-p))).
   { apply Zrnd_le. apply valid_rnd_odd. apply Rmult_le_compat_r. apply bpow_ge_0.
-    apply Z2R_le; auto. }
+    apply IZR_le; auto. }
   rewrite <- ! Zrnd_odd_int by auto.
   apply Zmult_le_compat_r. auto. apply (Zpower_ge_0 radix2).
 Qed.
@@ -635,14 +628,14 @@ Proof.
   destruct (BofZ_finite (int_round_odd x p) YRANGE) as (Y1 & Y2 & Y3).
   apply BofZ_finite_equal; auto.
   rewrite X1, Y1.
-  assert (Z2R (int_round_odd x p) = round radix2 (FIX_exp p) Zrnd_odd (Z2R x)).
+  assert (IZR (int_round_odd x p) = round radix2 (FIX_exp p) Zrnd_odd (IZR x)).
   {
-     unfold round, scaled_mantissa, canonic_exp, FIX_exp.
+     unfold round, scaled_mantissa, cexp, FIX_exp.
      rewrite <- Zrnd_odd_int by omega.
-     unfold F2R; simpl. rewrite Z2R_mult. f_equal. apply (Z2R_Zpower radix2). omega.
+     unfold F2R; simpl. rewrite mult_IZR. f_equal. apply (IZR_Zpower radix2). omega.
   }
   rewrite H. symmetry. apply round_odd_fix. auto. omega.
-  rewrite <- Z2R_Zpower. rewrite <- Z2R_abs. apply Z2R_le; auto.
+  rewrite <- IZR_Zpower. rewrite <- abs_IZR. apply IZR_le; auto.
   red in prec_gt_0_; omega.
 Qed.
 
@@ -704,37 +697,37 @@ Theorem ZofB_correct:
   forall f,
   ZofB f = if is_finite _ _ f then Some (Ztrunc (B2R _ _ f)) else None.
 Proof.
-  destruct f; simpl; auto.
-- f_equal. symmetry. apply (Ztrunc_Z2R 0).
+  destruct f as [s|s|s p H|s m e H]; simpl; auto.
+- f_equal. symmetry. apply (Ztrunc_IZR 0).
 - destruct e; f_equal.
-  + unfold F2R; simpl. rewrite Rmult_1_r. rewrite Ztrunc_Z2R. auto.
-  + unfold F2R; simpl. rewrite <- Z2R_mult. rewrite Ztrunc_Z2R. auto.
-  + unfold F2R; simpl. rewrite Z2R_cond_Zopp. rewrite <- cond_Ropp_mult_l.
-    assert (EQ: forall x, Ztrunc (cond_Ropp b x) = cond_Zopp b (Ztrunc x)).
+  + unfold F2R; simpl. rewrite Rmult_1_r. rewrite Ztrunc_IZR. auto.
+  + unfold F2R; simpl. rewrite <- mult_IZR. rewrite Ztrunc_IZR. auto.
+  + unfold F2R; simpl. rewrite IZR_cond_Zopp. rewrite <- cond_Ropp_mult_l.
+    assert (EQ: forall x, Ztrunc (cond_Ropp s x) = cond_Zopp s (Ztrunc x)).
     {
-      intros. destruct b; simpl; auto. apply Ztrunc_opp.
+      intros. destruct s; simpl; auto. apply Ztrunc_opp.
     }
     rewrite EQ. f_equal.
     generalize (Zpower_pos_gt_0 2 p (eq_refl _)); intros.
     rewrite Ztrunc_floor. symmetry. apply Zfloor_div. omega.
-    apply Rmult_le_pos. apply (Z2R_le 0). compute; congruence.
-    apply Rlt_le. apply Rinv_0_lt_compat. apply (Z2R_lt 0). auto.
+    apply Rmult_le_pos. apply IZR_le. compute; congruence.
+    apply Rlt_le. apply Rinv_0_lt_compat. apply IZR_lt. auto.
 Qed.
 
 (** Interval properties. *)
 
 Remark Ztrunc_range_pos:
-  forall x, 0 < Ztrunc x -> (Z2R (Ztrunc x) <= x < Z2R (Ztrunc x + 1)%Z)%R.
+  forall x, 0 < Ztrunc x -> (IZR (Ztrunc x) <= x < IZR (Ztrunc x + 1)%Z)%R.
 Proof.
   intros.
-  rewrite Ztrunc_floor. split. apply Zfloor_lb. rewrite Z2R_plus. apply Zfloor_ub.
+  rewrite Ztrunc_floor. split. apply Zfloor_lb. rewrite plus_IZR. apply Zfloor_ub.
   generalize (Rle_bool_spec 0%R x). intros RLE; inversion RLE; subst; clear RLE.
   auto.
   rewrite Ztrunc_ceil in H by lra. unfold Zceil in H.
   assert (-x < 0)%R.
-  { apply Rlt_le_trans with (Z2R (Zfloor (-x)) + 1)%R. apply Zfloor_ub.
-    change 0%R with (Z2R 0). change 1%R with (Z2R 1). rewrite <- Z2R_plus.
-    apply Z2R_le. omega. }
+  { apply Rlt_le_trans with (IZR (Zfloor (-x)) + 1)%R. apply Zfloor_ub.
+    rewrite <- plus_IZR.
+    apply IZR_le. omega. }
   lra.
 Qed.
 
@@ -744,32 +737,32 @@ Proof.
   intros; generalize (Rle_bool_spec 0%R x). intros RLE; inversion RLE; subst; clear RLE.
 - rewrite Ztrunc_floor in H by auto. split.
   + apply Rlt_le_trans with 0%R; auto. rewrite <- Ropp_0. apply Ropp_lt_contravar. apply Rlt_0_1.
-  + replace 1%R with (Z2R (Zfloor x) + 1)%R. apply Zfloor_ub. rewrite H. simpl. apply Rplus_0_l.
+  + replace 1%R with (IZR (Zfloor x) + 1)%R. apply Zfloor_ub. rewrite H. simpl. apply Rplus_0_l.
 - rewrite Ztrunc_ceil in H by (apply Rlt_le; auto). split.
   + apply (Ropp_lt_cancel (-(1))). rewrite Ropp_involutive.
-    replace 1%R with (Z2R (Zfloor (-x)) + 1)%R. apply Zfloor_ub.
+    replace 1%R with (IZR (Zfloor (-x)) + 1)%R. apply Zfloor_ub.
     unfold Zceil in H. replace (Zfloor (-x)) with 0 by omega. simpl. apply Rplus_0_l.
   + apply Rlt_le_trans with 0%R; auto. apply Rle_0_1.
 Qed.
 
 Theorem ZofB_range_pos:
-  forall f n, ZofB f = Some n -> 0 < n -> (Z2R n <= B2R _ _ f < Z2R (n + 1)%Z)%R.
+  forall f n, ZofB f = Some n -> 0 < n -> (IZR n <= B2R _ _ f < IZR (n + 1)%Z)%R.
 Proof.
   intros. rewrite ZofB_correct in H. destruct (is_finite prec emax f) eqn:FIN; inversion H.
   apply Ztrunc_range_pos. congruence.
 Qed.
 
 Theorem ZofB_range_neg:
-  forall f n, ZofB f = Some n -> n < 0 -> (Z2R (n - 1)%Z < B2R _ _ f <= Z2R n)%R.
+  forall f n, ZofB f = Some n -> n < 0 -> (IZR (n - 1)%Z < B2R _ _ f <= IZR n)%R.
 Proof.
   intros. rewrite ZofB_correct in H. destruct (is_finite prec emax f) eqn:FIN; inversion H.
   set (x := B2R prec emax f) in *. set (y := (-x)%R).
-  assert (A: (Z2R (Ztrunc y) <= y < Z2R (Ztrunc y + 1)%Z)%R).
+  assert (A: (IZR (Ztrunc y) <= y < IZR (Ztrunc y + 1)%Z)%R).
   { apply Ztrunc_range_pos. unfold y. rewrite Ztrunc_opp. omega. }
   destruct A as [B C].
   unfold y in B, C. rewrite Ztrunc_opp in B, C.
   replace (- Ztrunc x + 1) with (- (Ztrunc x - 1)) in C by omega.
-  rewrite Z2R_opp in B, C. lra.
+  rewrite opp_IZR in B, C. lra.
 Qed.
 
 Theorem ZofB_range_zero:
@@ -780,13 +773,13 @@ Proof.
 Qed.
 
 Theorem ZofB_range_nonneg:
-  forall f n, ZofB f = Some n -> 0 <= n -> (-1 < B2R _ _ f < Z2R (n + 1)%Z)%R.
+  forall f n, ZofB f = Some n -> 0 <= n -> (-1 < B2R _ _ f < IZR (n + 1)%Z)%R.
 Proof.
   intros. destruct (Z.eq_dec n 0).
 - subst n. apply ZofB_range_zero. auto.
 - destruct (ZofB_range_pos f n) as (A & B). auto. omega.
-  split; auto. apply Rlt_le_trans with (Z2R 0). simpl; lra.
-  apply Rle_trans with (Z2R n); auto. apply Z2R_le; auto.
+  split; auto. apply Rlt_le_trans with 0%R. simpl; lra.
+  apply Rle_trans with (IZR n); auto. apply IZR_le; auto.
 Qed.
 
 (** For representable integers, [ZofB] is left inverse of [BofZ]. *)
@@ -795,35 +788,35 @@ Theorem ZofBofZ_exact:
   forall n, integer_representable n -> ZofB (BofZ n) = Some n.
 Proof.
   intros. destruct (BofZ_representable n H) as (A & B & C).
-  rewrite ZofB_correct. rewrite A, B. f_equal. apply Ztrunc_Z2R.
+  rewrite ZofB_correct. rewrite A, B. f_equal. apply Ztrunc_IZR.
 Qed.
 
 (** Compatibility with subtraction *)
 
 Remark Zfloor_minus:
-  forall x n, Zfloor (x - Z2R n) = Zfloor x - n.
+  forall x n, Zfloor (x - IZR n) = Zfloor x - n.
 Proof.
   intros. apply Zfloor_imp. replace (Zfloor x - n + 1) with ((Zfloor x + 1) - n) by omega.
-  rewrite ! Z2R_minus. unfold Rminus. split.
+  rewrite ! minus_IZR. unfold Rminus. split.
   apply Rplus_le_compat_r. apply Zfloor_lb.
-  apply Rplus_lt_compat_r. rewrite Z2R_plus. apply Zfloor_ub.
+  apply Rplus_lt_compat_r. rewrite plus_IZR. apply Zfloor_ub.
 Qed.
 
 Theorem ZofB_minus:
   forall minus_nan m f p q,
-  ZofB f = Some p -> 0 <= p < 2*q -> q <= 2^prec -> (Z2R q <= B2R _ _ f)%R ->
+  ZofB f = Some p -> 0 <= p < 2*q -> q <= 2^prec -> (IZR q <= B2R _ _ f)%R ->
   ZofB (Bminus _ _ _ Hmax minus_nan m f (BofZ q)) = Some (p - q).
 Proof.
   intros.
   assert (Q: -2^prec <= q <= 2^prec).
   { split; auto.  generalize (Zpower_ge_0 radix2 prec); simpl; omega. }
-  assert (RANGE: (-1 < B2R _ _ f < Z2R (p + 1)%Z)%R) by (apply ZofB_range_nonneg; auto; omega).
+  assert (RANGE: (-1 < B2R _ _ f < IZR (p + 1)%Z)%R) by (apply ZofB_range_nonneg; auto; omega).
   rewrite ZofB_correct in H. destruct (is_finite prec emax f) eqn:FIN; try discriminate.
-  assert (PQ2: (Z2R (p + 1) <= Z2R q * 2)%R).
-  { change 2%R with (Z2R 2). rewrite <- Z2R_mult. apply Z2R_le. omega. }
-  assert (EXACT: round radix2 fexp (round_mode m) (B2R _ _ f - Z2R q)%R = (B2R _ _ f - Z2R q)%R).
+  assert (PQ2: (IZR (p + 1) <= IZR q * 2)%R).
+  { rewrite <- mult_IZR. apply IZR_le. omega. }
+  assert (EXACT: round radix2 fexp (round_mode m) (B2R _ _ f - IZR q)%R = (B2R _ _ f - IZR q)%R).
   { apply round_generic. apply valid_rnd_round_mode.
-    apply sterbenz_aux. apply FLT_exp_monotone. apply generic_format_B2R.
+    apply sterbenz_aux. now apply FLT_exp_valid. apply FLT_exp_monotone. apply generic_format_B2R.
     apply integer_representable_n. auto. lra. }
   destruct (BofZ_exact q Q) as (A & B & C).
   generalize (Bminus_correct _ _ _ Hmax minus_nan m f (BofZ q) FIN B).
@@ -834,8 +827,8 @@ Proof.
   lra. lra.
 - rewrite A. fold emin; fold fexp. rewrite EXACT.
   apply Rle_lt_trans with (bpow radix2 prec).
-  apply Rle_trans with (Z2R q). apply Rabs_le. lra.
-  rewrite <- Z2R_Zpower. apply Z2R_le; auto. red in prec_gt_0_; omega.
+  apply Rle_trans with (IZR q). apply Rabs_le. lra.
+  rewrite <- IZR_Zpower. apply IZR_le; auto. red in prec_gt_0_; omega.
   apply bpow_lt. auto.
 Qed.
 
@@ -875,7 +868,7 @@ Qed.
 
 Theorem ZofB_range_minus:
   forall minus_nan m f p q,
-  ZofB_range f 0 (2 * q - 1) = Some p -> q <= 2^prec -> (Z2R q <= B2R _ _ f)%R ->
+  ZofB_range f 0 (2 * q - 1) = Some p -> q <= 2^prec -> (IZR q <= B2R _ _ f)%R ->
   ZofB_range (Bminus _ _ _ Hmax minus_nan m f (BofZ q)) (-q) (q - 1) = Some (p - q).
 Proof.
   intros. destruct (ZofB_range_inversion _ _ _ _ H) as (A & B & C).
@@ -897,11 +890,11 @@ Proof.
   intros until y; intros NAN.
   pose proof (Bplus_correct _ _ _ Hmax plus_nan mode x y).
   pose proof (Bplus_correct _ _ _ Hmax plus_nan mode y x).
-  unfold Bplus in *; destruct x; destruct y; auto.
-- rewrite (eqb_sym b0 b). destruct (eqb b b0) eqn:EQB; auto.
+  unfold Bplus in *; destruct x as [sx|sx|sx px Hx|sx mx ex Hx]; destruct y as [sy|sy|sy py Hy|sy my ey Hy]; auto.
+- rewrite (eqb_sym sy sx). destruct (eqb sx sy) eqn:EQB; auto.
   f_equal; apply eqb_prop; auto.
 - rewrite NAN; auto.
-- rewrite (eqb_sym b0 b). destruct (eqb b b0) eqn:EQB.
+- rewrite (eqb_sym sy sx). destruct (eqb sx sy) eqn:EQB.
   f_equal; apply eqb_prop; auto.
   rewrite NAN; auto.
 - rewrite NAN; auto.
@@ -913,8 +906,8 @@ Proof.
 - generalize (H (eq_refl _) (eq_refl _)); clear H.
   generalize (H0 (eq_refl _) (eq_refl _)); clear H0.
   fold emin. fold fexp.
-  set (x := B754_finite prec emax b0 m0 e1 e2). set (rx := B2R _ _ x).
-  set (y := B754_finite prec emax b m e e0). set (ry := B2R _ _ y).
+  set (x := B754_finite prec emax sx mx ex Hx). set (rx := B2R _ _ x).
+  set (y := B754_finite prec emax sy my ey Hy). set (ry := B2R _ _ y).
   rewrite (Rplus_comm ry rx). destruct Rlt_bool.
   + intros (A1 & A2 & A3) (B1 & B2 & B3).
     apply B2R_Bsign_inj; auto. rewrite <- B1 in A1. auto.
@@ -930,31 +923,31 @@ Proof.
   intros until y; intros NAN.
   pose proof (Bmult_correct _ _ _ Hmax mult_nan mode x y).
   pose proof (Bmult_correct _ _ _ Hmax mult_nan mode y x).
-  unfold Bmult in *; destruct x; destruct y; auto.
-- rewrite (xorb_comm b0 b); auto.
+  unfold Bmult in *; destruct x as [sx|sx|sx px Hx|sx mx ex Hx]; destruct y as [sy|sy|sy py Hy|sy my ey Hy]; auto.
+- rewrite (xorb_comm sx sy); auto.
 - rewrite NAN; auto.
 - rewrite NAN; auto.
-- rewrite (xorb_comm b0 b); auto.
+- rewrite (xorb_comm sx sy); auto.
 - rewrite NAN; auto.
-- rewrite (xorb_comm b0 b); auto.
+- rewrite (xorb_comm sx sy); auto.
 - rewrite NAN; auto.
-- rewrite (xorb_comm b0 b); auto.
+- rewrite (xorb_comm sx sy); auto.
 - rewrite NAN; auto.
 - rewrite NAN; auto.
 - rewrite NAN; auto.
 - rewrite NAN; auto.
-- rewrite (xorb_comm b0 b); auto.
-- rewrite (xorb_comm b0 b); auto.
+- rewrite (xorb_comm sx sy); auto.
+- rewrite (xorb_comm sx sy); auto.
 - rewrite NAN; auto.
 - revert H H0. fold emin. fold fexp.
-  set (x := B754_finite prec emax b0 m0 e1 e2). set (rx := B2R _ _ x).
-  set (y := B754_finite prec emax b m e e0). set (ry := B2R _ _ y).
+  set (x := B754_finite prec emax sx mx ex Hx). set (rx := B2R _ _ x).
+  set (y := B754_finite prec emax sy my ey Hy). set (ry := B2R _ _ y).
   rewrite (Rmult_comm ry rx).
   destruct (Rlt_bool (Rabs (round radix2 fexp (round_mode mode) (rx * ry)))
                      (bpow radix2 emax)).
   + intros (A1 & A2 & A3) (B1 & B2 & B3).
     apply B2R_Bsign_inj; auto. rewrite <- B1 in A1. auto.
-    rewrite ! Bsign_FF2B. f_equal. f_equal. apply xorb_comm. apply Pos.mul_comm. apply Z.add_comm.
+    rewrite ! Bsign_FF2B. f_equal. f_equal. apply xorb_comm. now rewrite Pos.mul_comm. apply Z.add_comm.
   + intros A B. apply B2FF_inj. etransitivity. eapply A. rewrite xorb_comm. auto.
 Qed.
 
@@ -973,26 +966,26 @@ Proof.
   rewrite A, B, C in H. rewrite xorb_false_r in H.
   destruct (is_finite _ _ f) eqn:FIN.
 - pose proof (Bplus_correct _ _ _ Hmax plus_nan mode f f FIN FIN). fold emin in H0.
-  assert (EQ: (B2R prec emax f * Z2R 2%Z = B2R prec emax f + B2R prec emax f)%R).
-  { change (Z2R 2%Z) with 2%R. ring. }
+  assert (EQ: (B2R prec emax f * IZR 2%Z = B2R prec emax f + B2R prec emax f)%R).
+  { ring. }
   rewrite <- EQ in H0. destruct Rlt_bool.
   + destruct H0 as (P & Q & R). destruct H as (S & T & U).
     apply B2R_Bsign_inj; auto.
     rewrite P, S. auto.
     rewrite R, U.
-    replace 0%R with (0 * Z2R 2%Z)%R by ring. rewrite Rcompare_mult_r.
-    rewrite andb_diag, orb_diag. destruct f; try discriminate; simpl.
+    replace 0%R with (0 * 2)%R by ring. rewrite Rcompare_mult_r.
+    rewrite andb_diag, orb_diag. destruct f as [s|s|s p H|s m e H]; try discriminate; simpl.
     rewrite Rcompare_Eq by auto. destruct mode; auto.
     replace 0%R with (@F2R radix2 {| Fnum := 0%Z; Fexp := e |}).
-    rewrite Rcompare_F2R. destruct b; auto.
+    rewrite Rcompare_F2R. destruct s; auto.
     unfold F2R. simpl. ring.
-    change 0%R with (Z2R 0%Z). apply Z2R_lt. omega.
+    apply IZR_lt. omega.
     destruct (Bmult prec emax prec_gt_0_ Hmax mult_nan mode f (BofZ 2)); reflexivity || discriminate.
   + destruct H0 as (P & Q). apply B2FF_inj. rewrite P, H. auto.
-- destruct f; try discriminate.
-  + simpl Bplus. rewrite eqb_true. destruct (BofZ 2) eqn:B2; try discriminate; simpl in *.
-    assert ((0 = 2)%Z) by (apply eq_Z2R; auto). discriminate.
-    subst b0. rewrite xorb_false_r. auto.
+- destruct f as [sf|sf|sf pf Hf|sf mf ef Hf]; try discriminate.
+  + simpl Bplus. rewrite eqb_true. destruct (BofZ 2) as [| | |s2 m2 e2 H2] eqn:B2; try discriminate; simpl in *.
+    assert ((0 = 2)%Z) by (apply eq_IZR; auto). discriminate.
+    subst s2. rewrite xorb_false_r. auto.
     auto.
   + unfold Bplus, Bmult. rewrite <- NAN by auto. auto.
 Qed.
@@ -1031,7 +1024,7 @@ Remark bounded_Bexact_inverse:
   forall e,
   emin <= e <= emax - prec <-> bounded prec emax Bexact_inverse_mantissa e = true.
 Proof.
-  intros. unfold bounded, canonic_mantissa. rewrite andb_true_iff.
+  intros. unfold bounded, canonical_mantissa. rewrite andb_true_iff.
   rewrite <- Zeq_is_eq_bool. rewrite <- Zle_is_le_bool.
   rewrite Bexact_inverse_mantissa_digits2_pos.
   split.
@@ -1063,23 +1056,23 @@ Lemma Bexact_inverse_correct:
   /\ B2R _ _ f <> 0%R
   /\ Bsign _ _ f' = Bsign _ _ f.
 Proof with (try discriminate).
-  intros f f' EI. unfold Bexact_inverse in EI. destruct f...
+  intros f f' EI. unfold Bexact_inverse in EI. destruct f as [s|s|s p H|s m e H]...
   destruct (Pos.eq_dec m Bexact_inverse_mantissa)...
   set (e' := -e - (prec - 1) * 2) in *.
   destruct (Z_le_dec emin e')...
   destruct (Z_le_dec e' emax)...
   inversion EI; clear EI; subst f' m.
   split. auto. split. auto. split. unfold B2R. rewrite Bexact_inverse_mantissa_value.
-  unfold F2R; simpl. rewrite Z2R_cond_Zopp.
+  unfold F2R; simpl. rewrite IZR_cond_Zopp.
   rewrite <- ! cond_Ropp_mult_l.
   red in prec_gt_0_.
-  replace (Z2R (2 ^ (prec - 1))) with (bpow radix2 (prec - 1))
-  by (symmetry; apply (Z2R_Zpower radix2); omega).
+  replace (IZR (2 ^ (prec - 1))) with (bpow radix2 (prec - 1))
+  by (symmetry; apply (IZR_Zpower radix2); omega).
   rewrite <- ! bpow_plus.
   replace (prec - 1 + e') with (- (prec - 1 + e)) by (unfold e'; omega).
-  rewrite bpow_opp. unfold cond_Ropp; destruct b; auto.
+  rewrite bpow_opp. unfold cond_Ropp; destruct s; auto.
   rewrite Ropp_inv_permute. auto. apply Rgt_not_eq. apply bpow_gt_0.
-  split. simpl. red; intros. apply F2R_eq_0_reg in H. destruct b; simpl in H; discriminate.
+  split. simpl. apply F2R_neq_0. destruct s; simpl in H; discriminate.
   auto.
 Qed.
 
@@ -1180,7 +1173,7 @@ Lemma bpow_log_pos:
   0 < n ->
   (bpow radix2 (n * Z.log2 base)%Z <= bpow base n)%R.
 Proof.
-  intros. rewrite <- ! Z2R_Zpower. apply Z2R_le; apply Zpower_log; auto.
+  intros. rewrite <- ! IZR_Zpower. apply IZR_le; apply Zpower_log; auto.
   omega.
   rewrite Z.mul_comm; apply Zmult_gt_0_le_0_compat. omega. apply Z.log2_nonneg.
 Qed.
@@ -1202,7 +1195,7 @@ Lemma round_integer_overflow:
   forall (base: radix) e m,
   0 < e ->
   emax <= e * Z.log2 base ->
-  (bpow radix2 emax <= round radix2 fexp (round_mode mode_NE) (Z2R (Zpos m) * bpow base e))%R.
+  (bpow radix2 emax <= round radix2 fexp (round_mode mode_NE) (IZR (Zpos m) * bpow base e))%R.
 Proof.
   intros.
   rewrite <- (round_generic radix2 fexp (round_mode mode_NE) (bpow radix2 emax)); auto.
@@ -1210,11 +1203,11 @@ Proof.
   rewrite <- (Rmult_1_l (bpow radix2 emax)). apply Rmult_le_compat.
   apply Rle_0_1.
   apply bpow_ge_0.
-  apply (Z2R_le 1). zify; omega.
+  apply IZR_le. zify; omega.
   eapply Rle_trans. eapply bpow_le. eassumption. apply bpow_log_pos; auto.
   apply generic_format_FLT. exists (Float radix2 1 emax).
-  split. unfold F2R; simpl. ring.
-  split. simpl. apply (Zpower_gt_1 radix2); auto.
+  unfold F2R; simpl. ring.
+  simpl. apply (Zpower_gt_1 radix2); auto.
   simpl. unfold emin; red in prec_gt_0_; omega.
 Qed.
 
@@ -1227,15 +1220,15 @@ Proof.
   set (eps := bpow radix2 (emin - 1)) in *.
   assert (A: round radix2 fexp (round_mode mode_NE) eps = 0%R).
   { unfold round. simpl.
-    assert (E: canonic_exp radix2 fexp eps = emin).
-    { unfold canonic_exp, eps. rewrite ln_beta_bpow. unfold fexp, FLT_exp. zify; red in prec_gt_0_; omega. }
+    assert (E: cexp radix2 fexp eps = emin).
+    { unfold cexp, eps. rewrite mag_bpow. unfold fexp, FLT_exp. zify; red in prec_gt_0_; omega. }
     unfold scaled_mantissa; rewrite E.
     assert (P: (eps * bpow radix2 (-emin) = / 2)%R).
     { unfold eps. rewrite <- bpow_plus. replace (emin - 1 + -emin) with (-1) by omega. auto. }
     rewrite P. unfold Znearest.
     assert (F: Zfloor (/ 2)%R = 0).
     { apply Zfloor_imp. simpl. lra. }
-    rewrite F. change (Z2R 0) with 0%R. rewrite Rminus_0_r. rewrite Rcompare_Eq by auto.
+    rewrite F. rewrite Rminus_0_r. rewrite Rcompare_Eq by auto.
     simpl. unfold F2R; simpl. apply Rmult_0_l.
   }
   apply Rle_antisym.
@@ -1248,15 +1241,15 @@ Lemma round_integer_underflow:
   forall (base: radix) e m,
   e < 0 ->
   e * Z.log2 base + Z.log2_up (Zpos m) < emin ->
-  round radix2 fexp (round_mode mode_NE) (Z2R (Zpos m) * bpow base e) = 0%R.
+  round radix2 fexp (round_mode mode_NE) (IZR (Zpos m) * bpow base e) = 0%R.
 Proof.
   intros. apply round_NE_underflows. split.
-- apply Rmult_le_pos. apply (Z2R_le 0). zify; omega. apply bpow_ge_0.
+- apply Rmult_le_pos. apply IZR_le. zify; omega. apply bpow_ge_0.
 - apply Rle_trans with (bpow radix2 (Z.log2_up (Z.pos m) + e * Z.log2 base)).
 + rewrite bpow_plus. apply Rmult_le_compat.
-  apply (Z2R_le 0); zify; omega.
+  apply IZR_le; zify; omega.
   apply bpow_ge_0.
-  rewrite <- Z2R_Zpower. apply Z2R_le.
+  rewrite <- IZR_Zpower. apply IZR_le.
   destruct (Z.eq_dec (Z.pos m) 1).
   rewrite e0. simpl. omega.
   apply Z.log2_up_spec. zify; omega.
@@ -1270,7 +1263,7 @@ Qed.
 Theorem Bparse_correct:
   forall b m e (BASE: 2 <= Zpos b),
   let base := {| radix_val := Zpos b; radix_prop := Zle_imp_le_bool _ _ BASE |} in
-  let r := round radix2 fexp (round_mode mode_NE) (Z2R (Zpos m) * bpow base e) in
+  let r := round radix2 fexp (round_mode mode_NE) (IZR (Zpos m) * bpow base e) in
   if Rlt_bool (Rabs r) (bpow radix2 emax) then
      B2R _ _ (Bparse b m e) = r
   /\ is_finite _ _ (Bparse b m e) = true
@@ -1279,7 +1272,7 @@ Theorem Bparse_correct:
     B2FF _ _ (Bparse b m e) = F754_infinity false.
 Proof.
   intros.
-  assert (A: forall x, @F2R radix2 {| Fnum := x; Fexp := 0 |} = Z2R x).
+  assert (A: forall x, @F2R radix2 {| Fnum := x; Fexp := 0 |} = IZR x).
   { intros. unfold F2R, Fnum; simpl. ring. }
   unfold Bparse, r. destruct e as [ | e | e].
 - (* e = Z0 *)
@@ -1288,7 +1281,7 @@ Proof.
 - (* e = Zpos e *)
   destruct (Z.ltb_spec (Z.pos e * Z.log2 (Z.pos b)) emax).
 + (* no overflow *)
-  rewrite pos_pow_spec. rewrite <- Z2R_Zpower by (zify; omega). rewrite <- Z2R_mult.
+  rewrite pos_pow_spec. rewrite <- IZR_Zpower by (zify; omega). rewrite <- mult_IZR.
   replace false with (Z.pos m * Z.pos b ^ Z.pos e <? 0).
   exact (BofZ_correct (Z.pos m * Z.pos b ^ Z.pos e)).
   rewrite Z.ltb_ge. rewrite Z.mul_comm. apply Zmult_gt_0_le_0_compat. zify; omega.  apply (Zpower_ge_0 base).
@@ -1300,25 +1293,21 @@ Proof.
 + (* undeflow *)
   rewrite round_integer_underflow; auto.
   rewrite Rlt_bool_true. auto.
-  replace (Rabs 0)%R with 0%R. apply bpow_gt_0. apply (Z2R_abs 0).
+  replace (Rabs 0)%R with 0%R. apply bpow_gt_0. apply (abs_IZR 0).
   zify; omega.
 + (* no underflow *)
   generalize (Bdiv_correct_aux prec emax prec_gt_0_ Hmax mode_NE false m 0 false (pos_pow b e) 0).
-  set (f := match Fdiv_core_binary prec (Z.pos m) 0 (Z.pos (pos_pow b e)) 0 with
-      | (0, _, _) => F754_nan false 1
-      | (Z.pos mz0, ez, lz) =>
-          binary_round_aux prec emax mode_NE (xorb false false) mz0 ez lz
-      | (Z.neg _, _, _) => F754_nan false 1
-      end).
+  set (f := let '(mz, ez, lz) := Fdiv_core_binary prec emax (Z.pos m) 0 (Z.pos (pos_pow b e)) 0
+         in binary_round_aux prec emax mode_NE (xorb false false) mz ez lz).
   fold emin; fold fexp. rewrite ! A. unfold cond_Zopp. rewrite pos_pow_spec.
-  assert (B: (Z2R (Z.pos m) / Z2R (Z.pos b ^ Z.pos e) =
-              Z2R (Z.pos m) * bpow base (Z.neg e))%R).
+  assert (B: (IZR (Z.pos m) / IZR (Z.pos b ^ Z.pos e) =
+              IZR (Z.pos m) * bpow base (Z.neg e))%R).
   { change (Z.neg e) with (- (Z.pos e)). rewrite bpow_opp. auto. }
   rewrite B. intros [P Q].
   destruct (Rlt_bool
      (Rabs
         (round radix2 fexp (round_mode mode_NE)
-           (Z2R (Z.pos m) * bpow base (Z.neg e))))
+           (IZR (Z.pos m) * bpow base (Z.neg e))))
     (bpow radix2 emax)).
 * destruct Q as (Q1 & Q2 & Q3).
   split. rewrite B2R_FF2B, Q1. auto.
@@ -1344,9 +1333,9 @@ Hypothesis Hmax2 : (prec2 < emax2)%Z.
 Let binary_float1 := binary_float prec1 emax1.
 Let binary_float2 := binary_float prec2 emax2.
 
-Definition Bconv (conv_nan: bool -> nan_pl prec1 -> bool * nan_pl prec2) (md: mode) (f: binary_float1) : binary_float2 :=
+Definition Bconv (conv_nan: binary_float1 -> {x | is_nan prec2 emax2 x = true}) (md: mode) (f: binary_float1) : binary_float2 :=
   match f with
-    | B754_nan _ _ s pl => let '(s, pl) := conv_nan s pl in B754_nan _ _ s pl
+    | B754_nan _ _ _ _ _ => build_nan prec2 emax2 (conv_nan f)
     | B754_infinity _ _ s => B754_infinity _ _ s
     | B754_zero _ _ s => B754_zero _ _ s
     | B754_finite _ _ s m e _ => binary_normalize _ _ _ Hmax2 md (cond_Zopp s (Zpos m)) e s
@@ -1363,18 +1352,18 @@ Theorem Bconv_correct:
   else
      B2FF _ _ (Bconv conv_nan m f) = binary_overflow prec2 emax2 m (Bsign _ _ f).
 Proof.
-  intros. destruct f; try discriminate.
+  intros. destruct f as [sf|sf|sf pf Hf|sf mf ef Hf]; try discriminate.
 - simpl. rewrite round_0. rewrite Rabs_R0. rewrite Rlt_bool_true. auto.
   apply bpow_gt_0. apply valid_rnd_round_mode.
-- generalize (binary_normalize_correct _ _ _ Hmax2 m (cond_Zopp b (Zpos m0)) e b).
+- generalize (binary_normalize_correct _ _ _ Hmax2 m (cond_Zopp sf (Zpos mf)) ef sf).
   fold emin2; fold fexp2. simpl. destruct Rlt_bool.
   + intros (A & B & C). split. auto. split. auto. rewrite C.
-    destruct b; simpl.
-    rewrite Rcompare_Lt. auto. apply F2R_lt_0_compat. simpl. compute; auto.
-    rewrite Rcompare_Gt. auto. apply F2R_gt_0_compat. simpl. compute; auto.
-  + intros A. rewrite A. f_equal. destruct b.
-    apply Rlt_bool_true. apply F2R_lt_0_compat. simpl. compute; auto.
-    apply Rlt_bool_false. apply Rlt_le. apply Rgt_lt. apply F2R_gt_0_compat. simpl. compute; auto.
+    destruct sf; simpl.
+    rewrite Rcompare_Lt. auto. apply F2R_lt_0. simpl. compute; auto.
+    rewrite Rcompare_Gt. auto. apply F2R_gt_0. simpl. compute; auto.
+  + intros A. rewrite A. f_equal. destruct sf.
+    apply Rlt_bool_true. apply F2R_lt_0. simpl. compute; auto.
+    apply Rlt_bool_false. apply Rlt_le. apply Rgt_lt. apply F2R_gt_0. simpl. compute; auto.
 Qed.
 
 (** Converting a finite FP number to higher or equal precision preserves its value. *)
@@ -1421,15 +1410,15 @@ Proof.
   unfold BofZ.
   generalize (binary_normalize_correct _ _ _ Hmax2 mode_NE n 0 false).
   fold emin2; fold fexp2. rewrite A.
-  replace (F2R {| Fnum := n; Fexp := 0 |}) with (Z2R n).
+  replace (F2R {| Fnum := n; Fexp := 0 |}) with (IZR n).
   destruct Rlt_bool.
 - intros (P & Q & R) (D & E & F). apply B2R_Bsign_inj; auto.
-  congruence. rewrite F, C, R. change 0%R with (Z2R 0). rewrite Rcompare_Z2R.
+  congruence. rewrite F, C, R. rewrite Rcompare_IZR.
   unfold Z.ltb. auto.
-- intros P Q. apply B2FF_inj. rewrite P, Q. rewrite C. f_equal. change 0%R with (Z2R 0).
+- intros P Q. apply B2FF_inj. rewrite P, Q. rewrite C. f_equal.
   generalize (Zlt_bool_spec n 0); intros LT; inversion LT.
-  rewrite Rlt_bool_true; auto. apply Z2R_lt; auto.
-  rewrite Rlt_bool_false; auto. apply Z2R_le; auto.
+  rewrite Rlt_bool_true; auto. apply IZR_lt; auto.
+  rewrite Rlt_bool_false; auto. apply IZR_le; auto.
 - unfold F2R; simpl. rewrite Rmult_1_r. auto.
 Qed.
 
@@ -1472,19 +1461,15 @@ Proof.
   rewrite ! Bcompare_correct by auto. rewrite A, D. auto.
 - generalize (Bconv_widen_exact H H0 conv_nan m x)
              (Bconv_widen_exact H H0 conv_nan m y); intros P Q.
-  destruct x, y; try discriminate; simpl in P, Q; simpl;
+  destruct x as [sx|sx|sx px Hx|sx mx ex Hx], y as [sy|sy|sy py Hy|sy my ey Hy]; try discriminate; simpl in P, Q; simpl;
   repeat (match goal with |- context [conv_nan ?b ?pl] => destruct (conv_nan b pl) end);
   auto.
   destruct Q as (D & E & F); auto.
-  destruct (binary_normalize prec2 emax2 prec2_gt_0_ Hmax2 m (cond_Zopp b0 (Z.pos m0)) e b0);
-  discriminate || reflexivity.
+  now destruct binary_normalize.
   destruct P as (A & B & C); auto.
-  destruct (binary_normalize prec2 emax2 prec2_gt_0_ Hmax2 m (cond_Zopp b (Z.pos m0)) e b);
-  try discriminate; simpl. destruct b; auto. destruct b, b1; auto.
+  now destruct binary_normalize.
   destruct P as (A & B & C); auto.
-  destruct (binary_normalize prec2 emax2 prec2_gt_0_ Hmax2 m (cond_Zopp b (Z.pos m0)) e b);
-  try discriminate; simpl. destruct b; auto.
-  destruct b, b2; auto.
+  now destruct binary_normalize.
 Qed.
 
 End Conversions.
diff --git a/lib/Integers.v b/lib/Integers.v
index 0e506208..f4213332 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 *)
@@ -80,11 +80,19 @@ Proof.
   unfold modulus. apply two_power_nat_two_p.
 Qed.
 
+Remark modulus_gt_one: modulus > 1.
+Proof.
+  rewrite modulus_power. apply Z.lt_gt. apply (two_p_monotone_strict 0).
+  generalize wordsize_pos; omega.
+Qed.
+
 Remark modulus_pos: modulus > 0.
 Proof.
-  rewrite modulus_power. apply two_p_gt_ZERO. generalize wordsize_pos; omega.
+  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
@@ -95,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
@@ -113,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.
@@ -167,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
@@ -317,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. *)
@@ -497,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.
 
@@ -637,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.
@@ -706,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.
 
@@ -729,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.
 
@@ -776,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.
@@ -787,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.
 
@@ -819,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.
 
@@ -1298,298 +1114,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:
@@ -1888,7 +1412,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.
@@ -2007,7 +1531,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 ->
@@ -2458,7 +1982,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.
 
@@ -2485,7 +2009,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:
@@ -2610,65 +2134,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]. *)
-
-Fixpoint powerserie (l: list Z): Z :=
-  match l with
-  | nil => 0
-  | x :: xs => two_p x + powerserie xs
-  end.
+(** ** Properties of [is_power2]. *)
 
-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:
@@ -2676,16 +2166,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:
@@ -2701,18 +2182,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:
@@ -2727,34 +2198,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.
 
@@ -2762,19 +2211,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))).
@@ -2834,21 +2270,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)).
@@ -2891,43 +2312,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 ->
@@ -2949,21 +2333,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.
@@ -3042,17 +2411,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 ->
@@ -3143,51 +2501,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.
@@ -3197,35 +2510,6 @@ 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 ->
   testbit (sign_ext n x) i = testbit x (if zlt i n then i else n - 1).
@@ -3527,7 +2811,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.
@@ -3535,7 +2819,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.
@@ -3735,8 +3020,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
@@ -3762,94 +3046,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.
@@ -4315,7 +3515,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.
@@ -4374,7 +3574,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/Zbits.v b/lib/Zbits.v
new file mode 100644
index 00000000..dca2a5a2
--- /dev/null
+++ b/lib/Zbits.v
@@ -0,0 +1,1028 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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 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 -> 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.
+
+(** [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 auto. 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_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_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.
diff --git a/powerpc/Archi.v b/powerpc/Archi.v
index 5d11aad1..d792e4fe 100644
--- a/powerpc/Archi.v
+++ b/powerpc/Archi.v
@@ -17,8 +17,8 @@
 (** Architecture-dependent parameters for PowerPC *)
 
 Require Import ZArith.
-Require Import Fappli_IEEE.
-Require Import Fappli_IEEE_bits.
+(*From Flocq*)
+Require Import Binary Bits.
 
 Definition ptr64 := false.
 
@@ -37,21 +37,24 @@ Proof.
   reflexivity.
 Qed.
 
-Program Definition default_pl_64 : bool * nan_pl 53 :=
-  (false, iter_nat 51 _ xO xH).
+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 choose_binop_pl_64 (s1: bool) (pl1: nan_pl 53) (s2: bool) (pl2: nan_pl 53) :=
+Definition choose_binop_pl_64 (pl1 pl2 : positive) :=
   false.                        (**r always choose first NaN *)
 
-Program Definition default_pl_32 : bool * nan_pl 24 :=
-  (false, iter_nat 22 _ xO xH).
+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_binop_pl_32 (s1: bool) (pl1: nan_pl 24) (s2: bool) (pl2: nan_pl 24) :=
+Definition choose_binop_pl_32 (pl1 pl2 : positive) :=
   false.                        (**r always choose first NaN *)
 
+Definition fpu_returns_default_qNaN := false.
+
 Definition float_of_single_preserves_sNaN := true.
 
 Global Opaque ptr64 big_endian splitlong
-              default_pl_64 choose_binop_pl_64
-              default_pl_32 choose_binop_pl_32
-              float_of_single_preserves_sNaN.
\ No newline at end of file
+              default_nan_64 choose_binop_pl_64
+              default_nan_32 choose_binop_pl_32
+              fpu_returns_default_qNaN
+              float_of_single_preserves_sNaN.
diff --git a/powerpc/Asm.v b/powerpc/Asm.v
index ad24f563..b9300fd7 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 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..99c51e43 100644
--- a/powerpc/AsmToJSON.ml
+++ b/powerpc/AsmToJSON.ml
@@ -228,6 +228,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" []
diff --git a/powerpc/Asmexpand.ml b/powerpc/Asmexpand.ml
index 49a0d237..415b6651 100644
--- a/powerpc/Asmexpand.ml
+++ b/powerpc/Asmexpand.ml
@@ -36,12 +36,14 @@ 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 _32L = coqint_of_camlint64 32L
@@ -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 *)
@@ -772,13 +814,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) ->
@@ -874,6 +909,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..884d5366 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,64 @@ 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. destruct dir; destruct ob as [[]|]; simpl; auto using Val.lessdef_normalize.
+    + 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 +1513,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/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 b4e48596..eba071eb 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.
@@ -222,11 +222,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 478ce251..b1cac124 100644
--- a/powerpc/SelectOp.vp
+++ b/powerpc/SelectOp.vp
@@ -44,6 +44,7 @@ Require Import Floats.
 Require Import Op.
 Require Import CminorSel.
 Require Import OpHelpers.
+Require Archi.
 
 Local Open Scope cminorsel_scope.
 
@@ -517,6 +518,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 :=
diff --git a/powerpc/SelectOpproof.v b/powerpc/SelectOpproof.v
index 00b91e70..92852d36 100644
--- a/powerpc/SelectOpproof.v
+++ b/powerpc/SelectOpproof.v
@@ -1004,6 +1004,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 ->
diff --git a/powerpc/TargetPrinter.ml b/powerpc/TargetPrinter.ml
index c1aaa55d..a1338561 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"
@@ -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) ->
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/riscV/Archi.v b/riscV/Archi.v
index a1664262..3758d686 100644
--- a/riscV/Archi.v
+++ b/riscV/Archi.v
@@ -17,8 +17,8 @@
 (** Architecture-dependent parameters for RISC-V *)
 
 Require Import ZArith.
-Require Import Fappli_IEEE.
-Require Import Fappli_IEEE_bits.
+(*From Flocq*)
+Require Import Binary Bits.
 
 Parameter ptr64 : bool.
 
@@ -38,26 +38,28 @@ Qed.
    floating-point operation is NaN, it is the canonical NaN. The
    canonical NaN has a positive sign and all significand bits clear
    except the MSB, a.k.a. the quiet bit."
-   We need to extend the [choose_binop_pl] functions to account for
-   this case. *)
+   Exceptions are operations manipulating signs. *)
 
-Program Definition default_pl_64 : bool * nan_pl 53 :=
-  (false, iter_nat 51 _ xO xH).
+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 choose_binop_pl_64 (s1: bool) (pl1: nan_pl 53) (s2: bool) (pl2: nan_pl 53) :=
-  false.                        (**r always choose first NaN *)
+Definition choose_binop_pl_64 (pl1 pl2 : positive) :=
+  false.                        (**r irrelevant *)
 
-Program Definition default_pl_32 : bool * nan_pl 24 :=
-  (false, iter_nat 22 _ xO xH).
+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_binop_pl_32 (s1: bool) (pl1: nan_pl 24) (s2: bool) (pl2: nan_pl 24) :=
-  false.                        (**r always choose first NaN *)
+Definition choose_binop_pl_32 (pl1 pl2 : positive) :=
+  false.                        (**r irrelevant *)
+
+Definition fpu_returns_default_qNaN := true.
 
 Definition float_of_single_preserves_sNaN := false.
 
 Global Opaque ptr64 big_endian splitlong
-              default_pl_64 choose_binop_pl_64
-              default_pl_32 choose_binop_pl_32
+              default_nan_64 choose_binop_pl_64
+              default_nan_32 choose_binop_pl_32
+              fpu_returns_default_qNaN
               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/Asmgenproof1.v b/riscV/Asmgenproof1.v
index 7f070c12..98d5bd33 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. }
diff --git a/riscV/SelectOp.vp b/riscV/SelectOp.vp
index 181b9d05..ba7c5664 100644
--- a/riscV/SelectOp.vp
+++ b/riscV/SelectOp.vp
@@ -420,6 +420,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) :=
diff --git a/riscV/SelectOpproof.v b/riscV/SelectOpproof.v
index 9966305c..46cc1bbc 100644
--- a/riscV/SelectOpproof.v
+++ b/riscV/SelectOpproof.v
@@ -20,6 +20,7 @@
 Require Import Coqlib.
 Require Import Maps.
 Require Import AST.
+Require Import Zbits.
 Require Import Integers.
 Require Import Floats.
 Require Import Values.
@@ -376,7 +377,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.
@@ -404,7 +405,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.
@@ -876,6 +877,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 ->
diff --git a/riscV/TargetPrinter.ml b/riscV/TargetPrinter.ml
index 19704bad..92df7a76 100644
--- a/riscV/TargetPrinter.ml
+++ b/riscV/TargetPrinter.ml
@@ -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"
diff --git a/runtime/Makefile b/runtime/Makefile
index 1258d941..0a18e0f8 100644
--- a/runtime/Makefile
+++ b/runtime/Makefile
@@ -79,16 +79,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/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/regression/Makefile b/test/regression/Makefile
index 0bcbcc1f..ab27c85a 100644
--- a/test/regression/Makefile
+++ b/test/regression/Makefile
@@ -16,7 +16,7 @@ TESTS=int32 int64 floats floats-basics \
   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/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/ifconv.c b/test/regression/ifconv.c
new file mode 100644
index 00000000..dcbf43e5
--- /dev/null
+++ b/test/regression/ifconv.c
@@ -0,0 +1,129 @@
+#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;
+}
+
+/* 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/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/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/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 eadda093..c0434a67 100644
--- a/x86/SelectOp.vp
+++ b/x86/SelectOp.vp
@@ -457,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).
diff --git a/x86/SelectOpproof.v b/x86/SelectOpproof.v
index 1eeb5906..5e0f84e3 100644
--- a/x86/SelectOpproof.v
+++ b/x86/SelectOpproof.v
@@ -773,6 +773,32 @@ Proof.
   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.
diff --git a/x86/TargetPrinter.ml b/x86/TargetPrinter.ml
index 3ac2f36e..3025d2e7 100644
--- a/x86/TargetPrinter.ml
+++ b/x86/TargetPrinter.ml
@@ -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"
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 8e96b4f1..f10570e2 100644
--- a/x86_32/Archi.v
+++ b/x86_32/Archi.v
@@ -17,8 +17,8 @@
 (** Architecture-dependent parameters for x86 in 32-bit mode *)
 
 Require Import ZArith.
-Require Import Fappli_IEEE.
-Require Import Fappli_IEEE_bits.
+(*From Flocq*)
+Require Import Binary Bits.
 
 Definition ptr64 := false.
 
@@ -34,21 +34,24 @@ Proof.
   unfold splitlong. destruct ptr64; simpl; congruence.
 Qed.
 
-Program Definition default_pl_64 : bool * nan_pl 53 :=
-  (true, iter_nat 51 _ xO xH).
+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 choose_binop_pl_64 (s1: bool) (pl1: nan_pl 53) (s2: bool) (pl2: nan_pl 53) :=
+Definition choose_binop_pl_64 (pl1 pl2 : positive) :=
   false.                        (**r always choose first NaN *)
 
-Program Definition default_pl_32 : bool * nan_pl 24 :=
-  (true, iter_nat 22 _ xO xH).
+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_binop_pl_32 (s1: bool) (pl1: nan_pl 24) (s2: bool) (pl2: nan_pl 24) :=
+Definition choose_binop_pl_32 (pl1 pl2 : positive) :=
   false.                        (**r always choose first NaN *)
 
+Definition fpu_returns_default_qNaN := false.
+
 Definition float_of_single_preserves_sNaN := false.
 
 Global Opaque ptr64 big_endian splitlong
-              default_pl_64 choose_binop_pl_64
-              default_pl_32 choose_binop_pl_32
+              default_nan_64 choose_binop_pl_64
+              default_nan_32 choose_binop_pl_32
+              fpu_returns_default_qNaN
               float_of_single_preserves_sNaN.
diff --git a/x86_64/Archi.v b/x86_64/Archi.v
index 7b5301df..01eb36dd 100644
--- a/x86_64/Archi.v
+++ b/x86_64/Archi.v
@@ -17,8 +17,8 @@
 (** Architecture-dependent parameters for x86 in 64-bit mode *)
 
 Require Import ZArith.
-Require Import Fappli_IEEE.
-Require Import Fappli_IEEE_bits.
+(*From Flocq*)
+Require Import Binary Bits.
 
 Definition ptr64 := true.
 
@@ -34,21 +34,24 @@ Proof.
   unfold splitlong. destruct ptr64; simpl; congruence.
 Qed.
 
-Program Definition default_pl_64 : bool * nan_pl 53 :=
-  (true, iter_nat 51 _ xO xH).
+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 choose_binop_pl_64 (s1: bool) (pl1: nan_pl 53) (s2: bool) (pl2: nan_pl 53) :=
+Definition choose_binop_pl_64 (pl1 pl2 : positive) :=
   false.                        (**r always choose first NaN *)
 
-Program Definition default_pl_32 : bool * nan_pl 24 :=
-  (true, iter_nat 22 _ xO xH).
+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_binop_pl_32 (s1: bool) (pl1: nan_pl 24) (s2: bool) (pl2: nan_pl 24) :=
+Definition choose_binop_pl_32 (pl1 pl2 : positive) :=
   false.                        (**r always choose first NaN *)
 
+Definition fpu_returns_default_qNaN := false.
+
 Definition float_of_single_preserves_sNaN := false.
 
 Global Opaque ptr64 big_endian splitlong
-              default_pl_64 choose_binop_pl_64
-              default_pl_32 choose_binop_pl_32
+              default_nan_64 choose_binop_pl_64
+              default_nan_32 choose_binop_pl_32
+              fpu_returns_default_qNaN
               float_of_single_preserves_sNaN.