Blob Blame History Raw
From 658145e4aa9a3eb7263012b39c7483241af5b1b3 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 29 May 2012 20:50:42 +0100
Subject: [PATCH 7/8] New ARM backend, written by Benedikt Meurer (PR#5433).

Backported from upstream sources to 3.12.1 by RWMJ.

Includes svn rev 12548 to fix invalid generation of Thumb-2 branch
instruction TBH (upstream PR#5623, RHBZ#821153).
---
 asmcomp/amd64/selection.ml   |   14 +-
 asmcomp/arm/arch.ml          |  152 +++++++-
 asmcomp/arm/emit.mlp         |  857 ++++++++++++++++++++++++++++--------------
 asmcomp/arm/proc.ml          |  185 ++++++---
 asmcomp/arm/reload.ml        |    4 +-
 asmcomp/arm/scheduling.ml    |   80 ++--
 asmcomp/arm/selection.ml     |  343 ++++++++++-------
 asmcomp/i386/selection.ml    |   14 +-
 asmcomp/power/selection.ml   |    2 +-
 asmcomp/power64/selection.ml |    2 +-
 asmcomp/selectgen.ml         |   13 +-
 asmcomp/selectgen.mli        |    2 +-
 asmcomp/sparc/selection.ml   |    2 +-
 asmrun/arm.S                 |  544 ++++++++++++++++-----------
 asmrun/signals_osdep.h       |    2 +-
 configure                    |   11 +-
 16 files changed, 1485 insertions(+), 742 deletions(-)

diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml
index f0546cf..5d9f6fa 100644
--- a/asmcomp/amd64/selection.ml
+++ b/asmcomp/amd64/selection.ml
@@ -121,7 +121,7 @@ method is_immediate n = n <= 0x7FFFFFFF && n >= -0x80000000
 
 method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n
 
-method select_addressing exp =
+method select_addressing chunk exp =
   let (a, d) = select_addr exp in
   (* PR#4625: displacement must be a signed 32-bit immediate *)
   if d < -0x8000_0000 || d > 0x7FFF_FFFF
@@ -157,7 +157,7 @@ method! select_operation op args =
   match op with
   (* Recognize the LEA instruction *)
     Caddi | Cadda | Csubi | Csuba ->
-      begin match self#select_addressing (Cop(op, args)) with
+      begin match self#select_addressing Word (Cop(op, args)) with
         (Iindexed d, _) -> super#select_operation op args
       | (Iindexed2 0, _) -> super#select_operation op args
       | (addr, arg) -> (Ispecific(Ilea addr), [arg])
@@ -191,7 +191,7 @@ method! select_operation op args =
       begin match args with
         [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])]
         when loc = loc' && self#is_immediate n ->
-          let (addr, arg) = self#select_addressing loc in
+          let (addr, arg) = self#select_addressing Word loc in
           (Ispecific(Ioffset_loc(n, addr)), [arg])
       | _ ->
           super#select_operation op args
@@ -202,12 +202,12 @@ method! select_operation op args =
 
 method select_floatarith commutative regular_op mem_op args =
   match args with
-    [arg1; Cop(Cload (Double|Double_u), [loc2])] ->
-      let (addr, arg2) = self#select_addressing loc2 in
+    [arg1; Cop(Cload (Double|Double_u as chunk), [loc2])] ->
+      let (addr, arg2) = self#select_addressing chunk loc2 in
       (Ispecific(Ifloatarithmem(mem_op, addr)),
                  [arg1; arg2])
-  | [Cop(Cload (Double|Double_u), [loc1]); arg2] when commutative ->
-      let (addr, arg1) = self#select_addressing loc1 in
+  | [Cop(Cload (Double|Double_u as chunk), [loc1]); arg2] when commutative ->
+      let (addr, arg1) = self#select_addressing chunk loc1 in
       (Ispecific(Ifloatarithmem(mem_op, addr)),
                  [arg2; arg1])
   | [arg1; arg2] ->
diff --git a/asmcomp/arm/arch.ml b/asmcomp/arm/arch.ml
index 998fa4b..c4aca8d 100644
--- a/asmcomp/arm/arch.ml
+++ b/asmcomp/arm/arch.ml
@@ -1,25 +1,98 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                  Benedikt Meurer, University of Siegen              *)
 (*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
+(*    Copyright 1998 Institut National de Recherche en Informatique    *)
+(*    et en Automatique. Copyright 2012 Benedikt Meurer. All rights    *)
+(*    reserved.  This file is distributed  under the terms of the Q    *)
+(*    Public License version 1.0.                                      *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arch.ml 5304 2002-11-29 15:03:37Z xleroy $ *)
+(* $Id$ *)
 
 (* Specific operations for the ARM processor *)
 
 open Misc
 open Format
 
+type abi = EABI | EABI_VFP
+type arch = ARMv4 | ARMv5 | ARMv5TE | ARMv6 | ARMv6T2 | ARMv7
+type fpu = Soft | VFPv3_D16 | VFPv3
+
+let abi =
+  match Config.system with
+    "linux_eabi"   -> EABI
+  | "linux_eabihf" -> EABI_VFP
+  | _ -> assert false
+
+let string_of_arch = function
+    ARMv4   -> "armv4"
+  | ARMv5   -> "armv5"
+  | ARMv5TE -> "armv5te"
+  | ARMv6   -> "armv6"
+  | ARMv6T2 -> "armv6t2"
+  | ARMv7   -> "armv7"
+
+let string_of_fpu = function
+    Soft      -> "soft"
+  | VFPv3_D16 -> "vfpv3-d16"
+  | VFPv3     -> "vfpv3"
+
 (* Machine-specific command-line options *)
 
-let command_line_options = []
+let (arch, fpu, thumb) =
+  let (def_arch, def_fpu, def_thumb) =
+    begin match abi, Config.model with
+    (* Defaults for architecture, FPU and Thumb *)
+      EABI, "armv5"   -> ARMv5,   Soft,      false
+    | EABI, "armv5te" -> ARMv5TE, Soft,      false
+    | EABI, "armv6"   -> ARMv6,   Soft,      false
+    | EABI, "armv6t2" -> ARMv6T2, Soft,      false
+    | EABI, "armv7"   -> ARMv7,   Soft,      false
+    | EABI, _         -> ARMv4,   Soft,      false
+    | EABI_VFP, _     -> ARMv7,   VFPv3_D16, true
+    end in
+  (ref def_arch, ref def_fpu, ref def_thumb)
+
+let pic_code = ref false
+
+let farch spec =
+  arch := (match spec with
+             "armv4" when abi <> EABI_VFP   -> ARMv4
+           | "armv5" when abi <> EABI_VFP   -> ARMv5
+           | "armv5te" when abi <> EABI_VFP -> ARMv5TE
+           | "armv6" when abi <> EABI_VFP   -> ARMv6
+           | "armv6t2" when abi <> EABI_VFP -> ARMv6T2
+           | "armv7"                        -> ARMv7
+           | spec -> raise (Arg.Bad spec))
+
+let ffpu spec =
+  fpu := (match spec with
+            "soft" when abi <> EABI_VFP     -> Soft
+          | "vfpv3-d16" when abi = EABI_VFP -> VFPv3_D16
+          | "vfpv3" when abi = EABI_VFP     -> VFPv3
+          | spec -> raise (Arg.Bad spec))
+
+let command_line_options =
+  [ "-farch", Arg.String farch,
+      "<arch>  Select the ARM target architecture"
+      ^ " (default: " ^ (string_of_arch !arch) ^ ")";
+    "-ffpu", Arg.String ffpu,
+      "<fpu>  Select the floating-point hardware"
+      ^ " (default: " ^ (string_of_fpu !fpu) ^ ")";
+    "-fPIC", Arg.Set pic_code,
+      " Generate position-independent machine code";
+    "-fno-PIC", Arg.Clear pic_code,
+      " Generate position-dependent machine code";
+    "-fthumb", Arg.Set thumb,
+      " Enable Thumb/Thumb-2 code generation"
+      ^ (if !thumb then " (default)" else "");
+    "-fno-thumb", Arg.Clear thumb,
+      " Disable Thumb/Thumb-2 code generation"
+      ^ (if not !thumb then " (default" else "")]
 
 (* Addressing modes *)
 
@@ -37,6 +110,14 @@ type specific_operation =
     Ishiftarith of arith_operation * int
   | Ishiftcheckbound of int
   | Irevsubimm of int
+  | Imuladd     (* multiply and add *)
+  | Imulsub     (* multiply and subtract *)
+  | Inegmulf    (* floating-point negate and multiply *)
+  | Imuladdf    (* floating-point multiply and add *)
+  | Inegmuladdf (* floating-point negate, multiply and add *)
+  | Imulsubf    (* floating-point multiply and subtract *)
+  | Inegmulsubf (* floating-point negate, multiply and subtract *)
+  | Isqrtf      (* floating-point square root *)
 
 and arith_operation =
     Ishiftadd
@@ -51,6 +132,10 @@ let size_addr = 4
 let size_int = 4
 let size_float = 8
 
+(* Behavior of division *)
+
+let division_crashes_on_overflow = false
+
 (* Operations on addressing modes *)
 
 let identity_addressing = Iindexed 0
@@ -84,3 +169,56 @@ let print_specific_operation printreg op ppf arg =
       fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1)
   | Irevsubimm n ->
       fprintf ppf "%i %s %a" n "-" printreg arg.(0)
+  | Imuladd ->
+      fprintf ppf "(%a * %a) + %a"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Imulsub ->
+      fprintf ppf "-(%a * %a) + %a"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Inegmulf ->
+      fprintf ppf "-f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+  | Imuladdf ->
+      fprintf ppf "%a +f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Inegmuladdf ->
+      fprintf ppf "%a -f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Imulsubf ->
+      fprintf ppf "(-f %a) +f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Inegmulsubf ->
+      fprintf ppf "(-f %a) -f (%a *f %a)"
+        printreg arg.(0)
+        printreg arg.(1)
+        printreg arg.(2)
+  | Isqrtf ->
+      fprintf ppf "sqrtf %a"
+        printreg arg.(0)
+
+(* Recognize immediate operands *)
+
+(* Immediate operands are 8-bit immediate values, zero-extended,
+   and rotated right by 0 ... 30 bits.
+   In Thumb/Thumb-2 mode we utilize 26 ... 30. *)
+
+let is_immediate n =
+  let n = ref n in
+  let s = ref 0 in
+  let m = if !thumb then 24 else 30 in
+  while (!s <= m && Int32.logand !n 0xffl <> !n) do
+    n := Int32.logor (Int32.shift_right_logical !n 2) (Int32.shift_left !n 30);
+    s := !s + 2
+  done;
+  !s <= m
diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
index a4b2241..f8db396 100644
--- a/asmcomp/arm/emit.mlp
+++ b/asmcomp/arm/emit.mlp
@@ -1,16 +1,17 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                  Benedikt Meurer, University of Siegen              *)
 (*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
+(*    Copyright 1998 Institut National de Recherche en Informatique    *)
+(*    et en Automatique. Copyright 2012 Benedikt Meurer. All rights    *)
+(*    reserved.  This file is distributed  under the terms of the Q    *)
+(*    Public License version 1.0.                                      *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emit.mlp 10293 2010-04-22 09:33:18Z xleroy $ *)
+(* $Id$ *)
 
 (* Emission of ARM assembly code *)
 
@@ -33,16 +34,28 @@ let fastcode_flag = ref true
 let emit_label lbl =
   emit_string ".L"; emit_int lbl
 
-(* Output a symbol *)
+let emit_data_label lbl =
+  emit_string ".Ld"; emit_int lbl
+
+(* Symbols *)
 
 let emit_symbol s =
   Emitaux.emit_symbol '$' s
 
+let emit_call s =
+  if !Clflags.dlcode || !pic_code
+  then `bl	{emit_symbol s}(PLT)`
+  else `bl	{emit_symbol s}`
+
+let emit_jump s =
+  if !Clflags.dlcode || !pic_code
+  then `b	{emit_symbol s}(PLT)`
+  else `b	{emit_symbol s}`
+
 (* Output a pseudo-register *)
 
-let emit_reg r =
-  match r.loc with
-  | Reg r -> emit_string (register_name r)
+let emit_reg = function
+    {loc = Reg r} -> emit_string (register_name r)
   | _ -> fatal_error "Emit_arm.emit_reg"
 
 (* Layout of the stack frame *)
@@ -53,14 +66,23 @@ let frame_size () =
   let sz =
     !stack_offset +
     4 * num_stack_slots.(0) +
+    8 * num_stack_slots.(1) +
+    8 * num_stack_slots.(2) +
     (if !contains_calls then 4 else 0)
   in Misc.align sz 8
 
 let slot_offset loc cl =
   match loc with
-    Incoming n -> frame_size() + n
-  | Local n -> !stack_offset + n * 4
-  | Outgoing n -> n
+    Incoming n ->
+      assert (n >= 0);
+      frame_size() + n
+  | Local n ->
+      if cl = 0
+      then !stack_offset + n * 4
+      else !stack_offset + num_stack_slots.(0) * 4 + n * 8
+  | Outgoing n ->
+      assert (n >= 0);
+      n
 
 (* Output a stack reference *)
 
@@ -79,20 +101,13 @@ let emit_addressing addr r n =
 
 (* Record live pointers at call points *)
 
-type frame_descr =
-  { fd_lbl: int;                        (* Return address *)
-    fd_frame_size: int;                 (* Size of stack frame *)
-    fd_live_offset: int list }          (* Offsets/regs of live addresses *)
-
-let frame_descriptors = ref([] : frame_descr list)
-
-let record_frame live =
+let record_frame_label live dbg =
   let lbl = new_label() in
   let live_offset = ref [] in
   Reg.Set.iter
     (function
         {typ = Addr; loc = Reg r} ->
-          live_offset := (r lsl 1) + 1 :: !live_offset
+          live_offset := ((r lsl 1) + 1) :: !live_offset
       | {typ = Addr; loc = Stack s} as reg ->
           live_offset := slot_offset s (register_class reg) :: !live_offset
       | _ -> ())
@@ -100,18 +115,57 @@ let record_frame live =
   frame_descriptors :=
     { fd_lbl = lbl;
       fd_frame_size = frame_size();
-      fd_live_offset = !live_offset } :: !frame_descriptors;
-  `{emit_label lbl}:`
-
-let emit_frame fd =
-  `	.word	{emit_label fd.fd_lbl} + 4\n`;
-  `	.short	{emit_int fd.fd_frame_size}\n`;
-  `	.short	{emit_int (List.length fd.fd_live_offset)}\n`;
-  List.iter
-    (fun n ->
-      `	.short	{emit_int n}\n`)
-    fd.fd_live_offset;
-  `	.align	2\n`
+      fd_live_offset = !live_offset;
+      fd_debuginfo = dbg } :: !frame_descriptors;
+  lbl
+
+let record_frame live dbg =
+  let lbl = record_frame_label live dbg in `{emit_label lbl}:`
+
+(* Record calls to the GC -- we've moved them out of the way *)
+
+type gc_call =
+  { gc_lbl: label;                      (* Entry label *)
+    gc_return_lbl: label;               (* Where to branch after GC *)
+    gc_frame_lbl: label }               (* Label of frame descriptor *)
+
+let call_gc_sites = ref ([] : gc_call list)
+
+let emit_call_gc gc =
+  `{emit_label gc.gc_lbl}:	{emit_call "caml_call_gc"}\n`;
+  `{emit_label gc.gc_frame_lbl}:	b	{emit_label gc.gc_return_lbl}\n`
+
+(* Record calls to caml_ml_array_bound_error.
+   In debug mode, we maintain one call to caml_ml_array_bound_error
+   per bound check site. Otherwise, we can share a single call. *)
+
+type bound_error_call =
+  { bd_lbl: label;                    (* Entry label *)
+    bd_frame_lbl: label }             (* Label of frame descriptor *)
+
+let bound_error_sites = ref ([] : bound_error_call list)
+
+let bound_error_label dbg =
+  if !Clflags.debug || !bound_error_sites = [] then begin
+    let lbl_bound_error = new_label() in
+    let lbl_frame = record_frame_label Reg.Set.empty dbg in
+    bound_error_sites :=
+      { bd_lbl = lbl_bound_error;
+        bd_frame_lbl = lbl_frame } :: !bound_error_sites;
+    lbl_bound_error
+  end else begin
+    let bd = List.hd !bound_error_sites in bd.bd_lbl
+  end
+
+let emit_call_bound_error bd =
+  `{emit_label bd.bd_lbl}:	{emit_call "caml_ml_array_bound_error"}\n`;
+  `{emit_label bd.bd_frame_lbl}:\n`
+
+(* Negate a comparison *)
+
+let negate_integer_comparison = function
+    Isigned cmp   -> Isigned(negate_comparison cmp)
+  | Iunsigned cmp -> Iunsigned(negate_comparison cmp)
 
 (* Names of various instructions *)
 
@@ -121,22 +175,13 @@ let name_for_comparison = function
   | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "ls"
   | Iunsigned Cge -> "cs" | Iunsigned Clt -> "cc" | Iunsigned Cgt -> "hi"
 
-let name_for_float_comparison cmp neg =
-  match cmp with
-    Ceq -> if neg then "ne" else "eq"
-  | Cne -> if neg then "eq" else "ne"
-  | Cle -> if neg then "hi" else "ls"
-  | Cge -> if neg then "lt" else "ge"
-  | Clt -> if neg then "pl" else "mi"
-  | Cgt -> if neg then "le" else "gt"
-
 let name_for_int_operation = function
     Iadd -> "add"
   | Isub -> "sub"
   | Imul -> "mul"
-  | Iand  -> "and"
-  | Ior   -> "orr"
-  | Ixor  -> "eor"
+  | Iand -> "and"
+  | Ior  -> "orr"
+  | Ixor -> "eor"
   | _ -> assert false
 
 let name_for_shift_operation = function
@@ -145,60 +190,54 @@ let name_for_shift_operation = function
   | Iasr -> "asr"
   | _ -> assert false
 
-let name_for_shift_int_operation = function
-    Ishiftadd -> "add"
-  | Ishiftsub -> "sub"
-  | Ishiftsubrev -> "rsb"
-
-(* Recognize immediate operands *)
-
-(* Immediate operands are 8-bit immediate values, zero-extended, and rotated
-   right by 0, 2, 4, ... 30 bits.
-   We check only with 8-bit values shifted left 0 to 24 bits. *)
-
-let rec is_immed n shift =
-  shift <= 24 &&
-  (Nativeint.logand n (Nativeint.shift_left (Nativeint.of_int 0xFF) shift) = n
-   || is_immed n (shift + 2))
-
-let is_immediate n = is_immed n 0
-
 (* General functional to decompose a non-immediate integer constant
-   into 8-bit chunks shifted left 0 ... 24 bits *)
+   into 8-bit chunks shifted left 0 ... 30 bits. *)
 
 let decompose_intconst n fn =
   let i = ref n in
   let shift = ref 0 in
   let ninstr = ref 0 in
-  while !i <> 0n do
-    if Nativeint.to_int (Nativeint.shift_right !i !shift) land 3 = 0 then
+  while !i <> 0l do
+    if Int32.logand (Int32.shift_right !i !shift) 3l = 0l then
       shift := !shift + 2
     else begin
-      let mask = Nativeint.shift_left 0xFFn !shift in
-      let bits = Nativeint.logand !i mask in
-      fn bits;
+      let bits = Int32.logand !i (Int32.shift_left 0xffl !shift) in
+      i := Int32.sub !i bits;
       shift := !shift + 8;
-      i := Nativeint.sub !i bits;
-      incr ninstr
+      incr ninstr;
+      fn bits
     end
   done;
   !ninstr
 
 (* Load an integer constant into a register *)
 
-let emit_intconst r n =
-  let nr = Nativeint.lognot n in
+let emit_intconst dst n =
+  let nr = Int32.lognot n in
   if is_immediate n then begin
-    `	mov	{emit_reg r}, #{emit_nativeint n}\n`; 1
+    (* Use movs here to enable 16-bit T1 encoding *)
+    `	movs	{emit_reg dst}, #{emit_int32 n}\n`; 1
   end else if is_immediate nr then begin
-    `	mvn	{emit_reg r}, #{emit_nativeint nr}\n`; 1
+    `	mvn	{emit_reg dst}, #{emit_int32 nr}\n`; 1
+  end else if !arch > ARMv6 then begin
+    let nl = Int32.logand 0xffffl n in
+    let nh = Int32.logand 0xffffl (Int32.shift_right_logical n 16) in
+    if nh = 0l then begin
+      `	movw	{emit_reg dst}, #{emit_int32 nl}\n`; 1
+    end else if Int32.logand nl 0xffl = nl then begin
+      `	movs	{emit_reg dst}, #{emit_int32 nl}\n`;
+      `	movt	{emit_reg dst}, #{emit_int32 nh}\n`; 2
+    end else begin
+      `	movw	{emit_reg dst}, #{emit_int32 nl}\n`;
+      `	movt	{emit_reg dst}, #{emit_int32 nh}\n`; 2
+    end
   end else begin
     let first = ref true in
     decompose_intconst n
       (fun bits ->
         if !first
-        then `	mov	{emit_reg r}, #{emit_nativeint bits} @ {emit_nativeint n}\n`
-        else `	add	{emit_reg r}, {emit_reg r}, #{emit_nativeint bits}\n`;
+        then `	mov	{emit_reg dst}, #{emit_int32 bits} @ {emit_int32 n}\n`
+        else `	add	{emit_reg dst}, {emit_reg dst}, #{emit_int32 bits}\n`;
         first := false)
   end
 
@@ -206,46 +245,105 @@ let emit_intconst r n =
 
 let emit_stack_adjustment instr n =
   if n <= 0 then 0 else
-    decompose_intconst (Nativeint.of_int n)
+    decompose_intconst (Int32.of_int n)
       (fun bits ->
-        `	{emit_string instr}	sp, sp, #{emit_nativeint bits}\n`)
+        `	{emit_string instr}	sp, sp, #{emit_int32 bits}\n`)
 
 (* Name of current function *)
 let function_name = ref ""
 (* Entry point for tail recursive calls *)
 let tailrec_entry_point = ref 0
-(* Table of symbols referenced *)
-let symbol_constants = (Hashtbl.create 11 : (string, int) Hashtbl.t)
-(* Table of floating-point literals *)
-let float_constants = (Hashtbl.create 11 : (string, int) Hashtbl.t)
-(* Total space (in word) occupied by pending literals *)
+(* Pending floating-point literals *)
+let float_literals = ref ([] : (string * label) list)
+(* Pending relative references to the global offset table *)
+let gotrel_literals = ref ([] : (label * label) list)
+(* Pending symbol literals *)
+let symbol_literals = ref ([] : (string * label) list)
+(* Total space (in words) occupied by pending literals *)
 let num_literals = ref 0
 
-(* Label a symbol or float constant *)
-let label_constant tbl s size =
+(* Label a floating-point literal *)
+let float_literal f =
   try
-    Hashtbl.find tbl s
+    List.assoc f !float_literals
   with Not_found ->
     let lbl = new_label() in
-    Hashtbl.add tbl s lbl;
-    num_literals := !num_literals + size;
+    num_literals := !num_literals + 2;
+    float_literals := (f, lbl) :: !float_literals;
     lbl
 
-(* Emit all pending constants *)
-
-let emit_constants () =
-  Hashtbl.iter
-    (fun s lbl ->
-      `{emit_label lbl}:        .word   {emit_symbol s}\n`)
-    symbol_constants;
-  Hashtbl.iter
-    (fun s lbl ->
-      `{emit_label lbl}:        .double {emit_string s}\n`)
-    float_constants;
-  Hashtbl.clear symbol_constants;
-  Hashtbl.clear float_constants;
+(* Label a GOTREL literal *)
+let gotrel_literal l =
+  let lbl = new_label() in
+  num_literals := !num_literals + 1;
+  gotrel_literals := (l, lbl) :: !gotrel_literals;
+  lbl
+
+(* Label a symbol literal *)
+let symbol_literal s =
+  try
+    List.assoc s !symbol_literals
+  with Not_found ->
+    let lbl = new_label() in
+    num_literals := !num_literals + 1;
+    symbol_literals := (s, lbl) :: !symbol_literals;
+    lbl
+
+(* Emit all pending literals *)
+let emit_literals() =
+  if !float_literals <> [] then begin
+    `	.align	3\n`;
+    List.iter
+      (fun (f, lbl) ->
+        `{emit_label lbl}:	.double	{emit_string f}\n`)
+      !float_literals;
+    float_literals := []
+  end;
+  if !symbol_literals <> [] then begin
+    let offset = if !thumb then 4 else 8 in
+    let suffix = if !pic_code then "(GOT)" else "" in
+    `	.align	2\n`;
+    List.iter
+      (fun (l, lbl) ->
+        `{emit_label lbl}:	.word	_GLOBAL_OFFSET_TABLE_-({emit_label l}+{emit_int offset})\n`)
+      !gotrel_literals;
+    List.iter
+      (fun (s, lbl) ->
+        `{emit_label lbl}:	.word	{emit_symbol s}{emit_string suffix}\n`)
+      !symbol_literals;
+    gotrel_literals := [];
+    symbol_literals := []
+  end;
   num_literals := 0
 
+(* Emit code to load the address of a symbol *)
+
+let emit_load_symbol_addr dst s =
+  if !pic_code then begin
+    let lbl_pic = new_label() in
+    let lbl_got = gotrel_literal lbl_pic in
+    let lbl_sym = symbol_literal s in
+    (* Both r3 and r12 are marked as clobbered in PIC mode (cf. proc.ml),
+       so use r12 as temporary scratch register unless the destination is
+       r12, then we use r3 instead. *)
+    let tmp = if dst.loc = Reg 8 (*r12*)
+              then phys_reg 3 (*r3*)
+              else phys_reg 8 (*r12*) in
+    `	ldr	{emit_reg tmp}, {emit_label lbl_got}\n`;
+    `	ldr	{emit_reg dst}, {emit_label lbl_sym}\n`;
+    `{emit_label lbl_pic}:	add	{emit_reg tmp}, pc, {emit_reg tmp}\n`;
+    `	ldr	{emit_reg dst}, [{emit_reg tmp}, {emit_reg dst}] @ {emit_symbol s}\n`;
+    4
+  end else if !arch > ARMv6 && not !Clflags.dlcode && !fastcode_flag then begin
+    `	movw	{emit_reg dst}, #:lower16:{emit_symbol s}\n`;
+    `	movt	{emit_reg dst}, #:upper16:{emit_symbol s}\n`;
+    2
+  end else begin
+    let lbl = symbol_literal s in
+    `	ldr	{emit_reg dst}, {emit_label lbl} @ {emit_symbol s}\n`;
+    1
+  end
+
 (* Output the assembly code for an instruction *)
 
 let emit_instr i =
@@ -254,40 +352,76 @@ let emit_instr i =
     | Lop(Imove | Ispill | Ireload) ->
         let src = i.arg.(0) and dst = i.res.(0) in
         if src.loc = dst.loc then 0 else begin
-          match (src, dst) with
-            {loc = Reg rs; typ = Int|Addr}, {loc = Reg rd; typ = Int|Addr} ->
-              `	mov	{emit_reg dst}, {emit_reg src}\n`; 1
-          | {loc = Reg rs; typ = Int|Addr}, {loc = Stack sd} ->
-              `	str	{emit_reg src}, {emit_stack dst}\n`; 1
-          | {loc = Stack ss; typ = Int|Addr}, {loc = Reg rd} ->
-              `	ldr	{emit_reg dst}, {emit_stack src}\n`; 1
+          begin match (src, dst) with
+            {loc = Reg _; typ = Float}, {loc = Reg _} ->
+              `	fcpyd	{emit_reg dst}, {emit_reg src}\n`
+          | {loc = Reg _}, {loc = Reg _} ->
+              `	mov	{emit_reg dst}, {emit_reg src}\n`
+          | {loc = Reg _; typ = Float}, _ ->
+              `	fstd	{emit_reg src}, {emit_stack dst}\n`
+          | {loc = Reg _}, _ ->
+              `	str	{emit_reg src}, {emit_stack dst}\n`
+          | {typ = Float}, _ ->
+              `	fldd	{emit_reg dst}, {emit_stack src}\n`
           | _ ->
-              assert false
+              `	ldr	{emit_reg dst}, {emit_stack src}\n`
+          end; 1
         end
     | Lop(Iconst_int n) ->
-        emit_intconst i.res.(0) n
-    | Lop(Iconst_float s) ->
-        let bits = Int64.bits_of_float (float_of_string s) in
-        let high_bits = Int64.to_nativeint (Int64.shift_right_logical bits 32)
-        and low_bits = Int64.to_nativeint bits in
-        if is_immediate low_bits && is_immediate high_bits then begin
-          `	mov	{emit_reg i.res.(0)}, #{emit_nativeint low_bits} @ {emit_string s}\n`;
-          `	mov	{emit_reg i.res.(1)}, #{emit_nativeint high_bits}\n`;
-          2
+        emit_intconst i.res.(0) (Nativeint.to_int32 n)
+    | Lop(Iconst_float f) when !fpu = Soft ->
+        `	@ {emit_string f}\n`;
+        let bits = Int64.bits_of_float (float_of_string f) in
+        let high_bits = Int64.to_int32 (Int64.shift_right_logical bits 32)
+        and low_bits = Int64.to_int32 bits in
+        if is_immediate low_bits || is_immediate high_bits then begin
+          let ninstr_low = emit_intconst i.res.(0) low_bits
+          and ninstr_high = emit_intconst i.res.(1) high_bits in
+          ninstr_low + ninstr_high
         end else begin
-          let lbl = label_constant float_constants s 2 in
-          `	ldr	{emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string s}\n`;
+          let lbl = float_literal f in
+          `	ldr	{emit_reg i.res.(0)}, {emit_label lbl}\n`;
           `	ldr	{emit_reg i.res.(1)}, {emit_label lbl} + 4\n`;
           2
         end
+    | Lop(Iconst_float f) ->
+        let encode imm =
+          let sg = Int64.to_int (Int64.shift_right_logical imm 63) in
+          let ex = Int64.to_int (Int64.shift_right_logical imm 52) in
+          let ex = (ex land 0x7ff) - 1023 in
+          let mn = Int64.logand imm 0xfffffffffffffL in
+          if Int64.logand mn 0xffffffffffffL <> 0L || ex < -3 || ex > 4
+          then
+            None
+          else begin
+            let mn = Int64.to_int (Int64.shift_right_logical mn 48) in
+            if mn land 0x0f <> mn then
+              None
+            else
+              let ex = ((ex + 3) land 0x07) lxor 0x04 in
+              Some((sg lsl 7) lor (ex lsl 4) lor mn)
+          end in
+        begin match encode (Int64.bits_of_float (float_of_string f)) with
+          None ->
+            let lbl = float_literal f in
+            `	fldd	{emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string f}\n`
+        | Some imm8 ->
+            `	fconstd	{emit_reg i.res.(0)}, #{emit_int imm8} @ {emit_string f}\n`
+        end; 1
     | Lop(Iconst_symbol s) ->
-        let lbl = label_constant symbol_constants s 1 in
-        `	ldr	{emit_reg i.res.(0)}, {emit_label lbl} @ {emit_symbol s}\n`; 1
+        emit_load_symbol_addr i.res.(0) s
     | Lop(Icall_ind) ->
-        `	mov	lr, pc\n`;
-        `{record_frame i.live}  bx	{emit_reg i.arg.(0)}\n`; 2
+        if !arch >= ARMv5 then begin
+          `	blx	{emit_reg i.arg.(0)}\n`;
+          `{record_frame i.live i.dbg}\n`; 1
+        end else begin
+          `	mov	lr, pc\n`;
+          `	bx	{emit_reg i.arg.(0)}\n`;
+          `{record_frame i.live i.dbg}\n`; 2
+        end
     | Lop(Icall_imm s) ->
-        `{record_frame i.live}  bl      {emit_symbol s}\n`; 1
+        `	{emit_call s}\n`;
+        `{record_frame i.live i.dbg}\n`; 1
     | Lop(Itailcall_ind) ->
         let n = frame_size() in
         if !contains_calls then
@@ -303,17 +437,16 @@ let emit_instr i =
           if !contains_calls then
             `	ldr	lr, [sp, #{emit_int (n-4)}]\n`;
           let ninstr = emit_stack_adjustment "add" n in
-          `	b	{emit_symbol s}\n`;
+          `	{emit_jump s}\n`;
           2 + ninstr
         end
-    | Lop(Iextcall(s, alloc)) ->
-        if alloc then begin
-          let lbl = label_constant symbol_constants s 1 in
-          `	ldr	r12, {emit_label lbl} @ {emit_symbol s}\n`;
-          `{record_frame i.live}	bl	caml_c_call\n`; 2
-        end else begin
-          `	bl	{emit_symbol s}\n`; 1
-        end
+    | Lop(Iextcall(s, false)) ->
+        `	{emit_call s}\n`; 1
+    | Lop(Iextcall(s, true)) ->
+        let ninstr = emit_load_symbol_addr (phys_reg 7 (* r7 *)) s in
+        `	{emit_call "caml_c_call"}\n`;
+        `{record_frame i.live i.dbg}\n`;
+        1 + ninstr
     | Lop(Istackoffset n) ->
         assert (n mod 8 = 0);
         let ninstr =
@@ -322,16 +455,28 @@ let emit_instr i =
           else emit_stack_adjustment "add" (-n) in
         stack_offset := !stack_offset + n;
         ninstr
-    | Lop(Iload((Double | Double_u), addr)) ->
-        let addr' = offset_addressing addr 4 in
-        if i.res.(0).loc <> i.arg.(0).loc then begin
-          `	ldr	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`;
-          `	ldr	{emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`
-        end else begin
-          `	ldr	{emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`;
-          `	ldr	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`
-        end;
-        2
+    | Lop(Iload(Single, addr)) when !fpu >= VFPv3_D16 ->
+        `	flds	s14, {emit_addressing addr i.arg 0}\n`;
+        `	fcvtds	{emit_reg i.res.(0)}, s14\n`; 2
+    | Lop(Iload((Double | Double_u), addr)) when !fpu = Soft ->
+        (* Use LDM or LDRD if possible *)
+        begin match i.res.(0), i.res.(1), addr with
+          {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
+          when rt < rt2 ->
+            `	ldm	{emit_reg i.arg.(0)}, \{{emit_reg i.res.(0)}, {emit_reg i.res.(1)}}\n`; 1
+        | {loc = Reg rt}, {loc = Reg rt2}, addr
+          when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 ->
+            `	ldrd	{emit_reg i.res.(0)}, {emit_reg i.res.(1)}, {emit_addressing addr i.arg 0}\n`; 1
+        | _ ->
+            let addr' = offset_addressing addr 4 in
+            if i.res.(0).loc <> i.arg.(0).loc then begin
+              `	ldr	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`;
+              `	ldr	{emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`
+            end else begin
+              `	ldr	{emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`;
+              `	ldr	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`
+            end; 2
+        end
     | Lop(Iload(size, addr)) ->
         let r = i.res.(0) in
         let instr =
@@ -340,65 +485,114 @@ let emit_instr i =
           | Byte_signed -> "ldrsb"
           | Sixteen_unsigned -> "ldrh"
           | Sixteen_signed -> "ldrsh"
+          | Double
+          | Double_u -> "fldd"
           | _ (* 32-bit quantities *) -> "ldr" in
-        `	{emit_string	instr}     {emit_reg r}, {emit_addressing addr i.arg 0}\n`;
-        1
-    | Lop(Istore((Double | Double_u), addr)) ->
-        let addr' = offset_addressing addr 4 in
-        `	str	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`;
-        `	str	{emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`;
-        2
+        `	{emit_string instr}	{emit_reg r}, {emit_addressing addr i.arg 0}\n`; 1
+    | Lop(Istore(Single, addr)) when !fpu >= VFPv3_D16 ->
+        `	fcvtsd	s14, {emit_reg i.arg.(0)}\n`;
+        `	fsts	s14, {emit_addressing addr i.arg 1}\n`; 2
+    | Lop(Istore((Double | Double_u), addr)) when !fpu = Soft ->
+        (* Use STM or STRD if possible *)
+        begin match i.arg.(0), i.arg.(1), addr with
+          {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
+          when rt < rt2 ->
+            `	stm	{emit_reg i.arg.(2)}, \{{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}}\n`; 1
+        | {loc = Reg rt}, {loc = Reg rt2}, addr
+          when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 ->
+            `	strd	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_addressing addr i.arg 2}\n`; 1
+        | _ ->
+            let addr' = offset_addressing addr 4 in
+            `	str	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`;
+            `	str	{emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`; 2
+        end
     | Lop(Istore(size, addr)) ->
         let r = i.arg.(0) in
         let instr =
           match size with
-            Byte_unsigned | Byte_signed -> "strb"
-          | Sixteen_unsigned | Sixteen_signed -> "strh"
+            Byte_unsigned
+          | Byte_signed -> "strb"
+          | Sixteen_unsigned
+          | Sixteen_signed -> "strh"
+          | Double
+          | Double_u -> "fstd"
           | _ (* 32-bit quantities *) -> "str" in
-        `	{emit_string	instr}     {emit_reg r}, {emit_addressing addr i.arg 1}\n`;
-        1
+        `	{emit_string instr}	{emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
     | Lop(Ialloc n) ->
+        let lbl_frame = record_frame_label i.live i.dbg in
         if !fastcode_flag then begin
-          let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in
-          `	sub	alloc_ptr, alloc_ptr, r12\n`;
+          let lbl_redo = new_label() in
+          `{emit_label lbl_redo}:`;
+          let ninstr = decompose_intconst
+                         (Int32.of_int n)
+                         (fun i ->
+                           `	sub	alloc_ptr, alloc_ptr, #{emit_int32 i}\n`) in
           `	cmp	alloc_ptr, alloc_limit\n`;
-          `{record_frame i.live}	blcc    caml_call_gc\n`;
           `	add	{emit_reg i.res.(0)}, alloc_ptr, #4\n`;
-          4 + ni
-        end else if n = 8 || n = 12 || n = 16 then begin
-          `{record_frame i.live}	bl	caml_alloc{emit_int ((n-4)/4)}\n`;
-          `	add	{emit_reg i.res.(0)}, alloc_ptr, #4\n`; 2
+          let lbl_call_gc = new_label() in
+          `	bcc	{emit_label lbl_call_gc}\n`;
+          call_gc_sites :=
+            { gc_lbl = lbl_call_gc;
+              gc_return_lbl = lbl_redo;
+              gc_frame_lbl = lbl_frame } :: !call_gc_sites;
+          3 + ninstr
         end else begin
-          let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in
-          `{record_frame i.live}	bl	caml_allocN\n`;
-          `	add	{emit_reg i.res.(0)}, alloc_ptr, #4\n`;
-          2 + ni
+          let ninstr =
+            begin match n with
+               8 -> `	{emit_call "caml_alloc1"}\n`; 1
+            | 12 -> `	{emit_call "caml_alloc2"}\n`; 1
+            | 16 -> `	{emit_call "caml_alloc3"}\n`; 1
+            |  _ -> let ninstr = emit_intconst (phys_reg 7) (Int32.of_int n) in
+                    `	{emit_call "caml_allocN"}\n`; 1 + ninstr
+            end in
+          `{emit_label lbl_frame}:	add	{emit_reg i.res.(0)}, alloc_ptr, #4\n`;
+          1 + ninstr
         end
     | Lop(Iintop(Ilsl | Ilsr | Iasr as op)) ->
         let shift = name_for_shift_operation op in
         `	mov	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_string shift} {emit_reg i.arg.(1)}\n`; 1
     | Lop(Iintop(Icomp cmp)) ->
-        let comp = name_for_comparison cmp in
+        let compthen = name_for_comparison cmp in
+        let compelse = name_for_comparison (negate_integer_comparison cmp) in
         `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
-        `	mov	{emit_reg i.res.(0)}, #0\n`;
-        `	mov{emit_string	comp}   {emit_reg i.res.(0)}, #1\n`; 3
-    | Lop(Iintop(Icheckbound)) ->
+        `	ite	{emit_string compthen}\n`;
+        `	mov{emit_string	compthen}	{emit_reg i.res.(0)}, #1\n`;
+        `	mov{emit_string compelse}	{emit_reg i.res.(0)}, #0\n`; 4
+    | Lop(Iintop_imm(Icomp cmp, n)) ->
+        let compthen = name_for_comparison cmp in
+        let compelse = name_for_comparison (negate_integer_comparison cmp) in
+        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
+        `	ite	{emit_string compthen}\n`;
+        `	mov{emit_string	compthen}	{emit_reg i.res.(0)}, #1\n`;
+        `	mov{emit_string compelse}	{emit_reg i.res.(0)}, #0\n`; 4
+    | Lop(Iintop Icheckbound) ->
+        let lbl = bound_error_label i.dbg in
         `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
-        `	blls	caml_ml_array_bound_error\n`; 2
+        `	bls	{emit_label lbl}\n`; 2
+    | Lop(Iintop_imm(Icheckbound, n)) ->
+        let lbl = bound_error_label i.dbg in
+        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
+        `	bls	{emit_label lbl}\n`; 2
+    | Lop(Ispecific(Ishiftcheckbound shift)) ->
+        let lbl = bound_error_label i.dbg in
+        `	cmp	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
+        `	bcs	{emit_label lbl}\n`; 2
     | Lop(Iintop op) ->
         let instr = name_for_int_operation op in
-        `	{emit_string	instr}     {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1
+        `	{emit_string instr}     {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1
     | Lop(Iintop_imm(Idiv, n)) -> (* n is a power of 2 *)
         let l = Misc.log2 n in
         let r = i.res.(0) in
         `	movs	{emit_reg r}, {emit_reg i.arg.(0)}\n`;
-        if n <= 256 then
+        if n <= 256 then begin
+          `	it	lt\n`;
           `	addlt	{emit_reg r}, {emit_reg r}, #{emit_int (n-1)}\n`
-        else begin
+        end else begin
+          `	itt	lt\n`;
           `	addlt	{emit_reg r}, {emit_reg r}, #{emit_int n}\n`;
           `	sublt	{emit_reg r}, {emit_reg r}, #1\n`
         end;
-        `	mov	{emit_reg r}, {emit_reg r}, asr #{emit_int l}\n`; 4
+        `	mov	{emit_reg r}, {emit_reg r}, asr #{emit_int l}\n`; 5
     | Lop(Iintop_imm(Imod, n)) -> (* n is a power of 2 *)
         let l = Misc.log2 n in
         let a = i.arg.(0) in
@@ -409,40 +603,71 @@ let emit_instr i =
         `	mov	{emit_reg r}, {emit_reg r}, lsr #{emit_int (32-l)}\n`;
         `	bpl	{emit_label lbl}\n`;
         `	cmp	{emit_reg r}, #0\n`;
+        `	it	ne\n`;
         `	subne	{emit_reg r}, {emit_reg r}, #{emit_int n}\n`;
-        `{emit_label lbl}:\n`; 6
+        `{emit_label lbl}:\n`; 7
     | Lop(Iintop_imm((Ilsl | Ilsr | Iasr as op), n)) ->
         let shift = name_for_shift_operation op in
         `	mov	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_string shift} #{emit_int n}\n`; 1
-    | Lop(Iintop_imm(Icomp cmp, n)) ->
-        let comp = name_for_comparison cmp in
-        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
-        `	mov	{emit_reg i.res.(0)}, #0\n`;
-        `	mov{emit_string	comp}   {emit_reg i.res.(0)}, #1\n`; 3
-    | Lop(Iintop_imm(Icheckbound, n)) ->
-        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
-        `	blls	caml_ml_array_bound_error\n`; 2
     | Lop(Iintop_imm(op, n)) ->
         let instr = name_for_int_operation op in
-        `	{emit_string	instr}     {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1
-    | Lop(Inegf) -> (* argument and result in (r0, r1) *)
-        `	eor     r1, r1, #0x80000000\n`; 1
-    | Lop(Iabsf) -> (* argument and result in (r0, r1) *)
-        `	bic     r1, r1, #0x80000000\n`; 1
-    | Lop(Ifloatofint | Iintoffloat | Iaddf | Isubf | Imulf | Idivf) ->
-        assert false
+        `	{emit_string instr}     {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1
+    | Lop(Iabsf | Inegf as op) when !fpu = Soft ->
+        let instr = (match op with
+                       Iabsf -> "bic"
+                     | Inegf -> "eor"
+                     | _     -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(1)}, {emit_reg i.arg.(1)}, #0x80000000\n`; 1
+    | Lop(Iabsf | Inegf | Ispecific Isqrtf as op) ->
+        let instr = (match op with
+                       Iabsf            -> "fabsd"
+                     | Inegf            -> "fnegd"
+                     | Ispecific Isqrtf -> "fsqrtd"
+                     | _                -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`; 1
+    | Lop(Ifloatofint) ->
+        `	fmsr	s14, {emit_reg i.arg.(0)}\n`;
+        `	fsitod	{emit_reg i.res.(0)}, s14\n`; 2
+    | Lop(Iintoffloat) ->
+        `	ftosizd	s14, {emit_reg i.arg.(0)}\n`;
+        `	fmrs	{emit_reg i.res.(0)}, s14\n`; 2
+    | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) ->
+        let instr = (match op with
+                       Iaddf              -> "faddd"
+                     | Isubf              -> "fsubd"
+                     | Imulf              -> "fmuld"
+                     | Idivf              -> "fdivd"
+                     | Ispecific Inegmulf -> "fnmuld"
+                     | _                  -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+        1
+    | Lop(Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf as op)) ->
+        let instr = (match op with
+                       Imuladdf    -> "fmacd"
+                     | Inegmuladdf -> "fnmacd"
+                     | Imulsubf    -> "fmscd"
+                     | Inegmulsubf -> "fnmscd"
+                     | _ -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`;
+        1
     | Lop(Ispecific(Ishiftarith(op, shift))) ->
-        let instr = name_for_shift_int_operation op in
-        `	{emit_string	instr}     {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`;
+        let instr = (match op with
+                       Ishiftadd    -> "add"
+                     | Ishiftsub    -> "sub"
+                     | Ishiftsubrev -> "rsb") in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`;
         if shift >= 0
         then `, lsl #{emit_int shift}\n`
         else `, asr #{emit_int (-shift)}\n`;
         1
-    | Lop(Ispecific(Ishiftcheckbound shift)) ->
-        `	cmp	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
-        `	blcs	caml_ml_array_bound_error\n`; 2
     | Lop(Ispecific(Irevsubimm n)) ->
         `	rsb	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1
+    | Lop(Ispecific(Imuladd | Imulsub as op)) ->
+        let instr = (match op with
+                       Imuladd -> "mla"
+                     | Imulsub -> "mls"
+                     | _ -> assert false) in
+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`; 1
     | Lreloadretaddr ->
         let n = frame_size() in
         `	ldr	lr, [sp, #{emit_int(n-4)}]\n`; 1
@@ -458,29 +683,41 @@ let emit_instr i =
         begin match tst with
           Itruetest ->
             `	cmp	{emit_reg i.arg.(0)}, #0\n`;
-            `	bne	{emit_label lbl}\n`
+            `	bne	{emit_label lbl}\n`; 2
         | Ifalsetest ->
             `	cmp	{emit_reg i.arg.(0)}, #0\n`;
-            `	beq	{emit_label lbl}\n`
+            `	beq	{emit_label lbl}\n`; 2
         | Iinttest cmp ->
             `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
             let comp = name_for_comparison cmp in
-            `	b{emit_string comp}	{emit_label lbl}\n`
+            `	b{emit_string comp}	{emit_label lbl}\n`; 2
         | Iinttest_imm(cmp, n) ->
             `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;
             let comp = name_for_comparison cmp in
-            `	b{emit_string comp}	{emit_label lbl}\n`
+            `	b{emit_string comp}	{emit_label lbl}\n`; 2
         | Ifloattest(cmp, neg) ->
-            assert false
+            let comp = (match (cmp, neg) with
+                          (Ceq, false) | (Cne, true) -> "eq"
+                        | (Cne, false) | (Ceq, true) -> "ne"
+                        | (Clt, false) -> "cc"
+                        | (Clt, true)  -> "cs"
+                        | (Cle, false) -> "ls"
+                        | (Cle, true)  -> "hi"
+                        | (Cgt, false) -> "gt"
+                        | (Cgt, true)  -> "le"
+                        | (Cge, false) -> "ge"
+                        | (Cge, true)  -> "lt") in
+            `	fcmpd	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+            `	fmstat\n`;
+            `	b{emit_string comp}	{emit_label lbl}\n`; 3
         | Ioddtest ->
             `	tst	{emit_reg i.arg.(0)}, #1\n`;
-            `	bne	{emit_label lbl}\n`
+            `	bne	{emit_label lbl}\n`; 2
         | Ieventest ->
             `	tst	{emit_reg i.arg.(0)}, #1\n`;
-            `	beq	{emit_label lbl}\n`
-        end;
-        2
-  | Lcondbranch3(lbl0, lbl1, lbl2) ->
+            `	beq	{emit_label lbl}\n`; 2
+        end
+    | Lcondbranch3(lbl0, lbl1, lbl2) ->
         `	cmp	{emit_reg i.arg.(0)}, #1\n`;
         begin match lbl0 with
           None -> ()
@@ -495,108 +732,144 @@ let emit_instr i =
         | Some lbl -> `	bgt	{emit_label lbl}\n`
         end;
         4
-  | Lswitch jumptbl ->
-        `	ldr	pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`;
-        `	mov	r0, r0\n`;      (* nop *)
-        for i = 0 to Array.length jumptbl - 1 do
-          `	.word	{emit_label jumptbl.(i)}\n`
-        done;
+    | Lswitch jumptbl ->
+        if !arch > ARMv6 && !thumb then begin
+          (* The Thumb-2 TBH instruction supports only forward branches,
+             so we need to generate appropriate trampolines for all labels
+             that appear before this switch instruction (PR#5623) *)
+          let tramtbl = Array.copy jumptbl in
+          `	tbh	[pc, {emit_reg i.arg.(0)}, lsl #1]\n`;
+          for j = 0 to Array.length tramtbl - 1 do
+            let rec label i =
+              match i.desc with
+                Lend -> new_label()
+              | Llabel lbl when lbl = tramtbl.(j) -> lbl
+              | _ -> label i.next in
+            tramtbl.(j) <- label i.next;
+            `	.short	({emit_label tramtbl.(j)}-.)/2+{emit_int j}\n`
+          done;
+          (* Generate the necessary trampolines *)
+          for j = 0 to Array.length tramtbl - 1 do
+            if tramtbl.(j) <> jumptbl.(j) then
+              `{emit_label tramtbl.(j)}:	b	{emit_label jumptbl.(j)}\n`
+          done
+        end else if not !pic_code then begin
+          `	ldr	pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`;
+          `	nop\n`;
+          for j = 0 to Array.length jumptbl - 1 do
+            `	.word	{emit_label jumptbl.(j)}\n`
+          done
+        end else begin
+          (* Slightly slower, but position-independent *)
+          `	add	pc, pc, {emit_reg i.arg.(0)}, lsl #2\n`;
+          `	nop\n`;
+          for j = 0 to Array.length jumptbl - 1 do
+            `	b	{emit_label jumptbl.(j)}\n`
+          done
+        end;
         2 + Array.length jumptbl
     | Lsetuptrap lbl ->
         `	bl	{emit_label lbl}\n`; 1
     | Lpushtrap ->
         stack_offset := !stack_offset + 8;
-        `	stmfd	sp!, \{trap_ptr, lr}\n`;
+        `	push	\{trap_ptr, lr}\n`;
         `	mov	trap_ptr, sp\n`; 2
     | Lpoptrap ->
-        `	ldmfd	sp!, \{trap_ptr, lr}\n`;
+        `	pop	\{trap_ptr, lr}\n`;
         stack_offset := !stack_offset - 8; 1
     | Lraise ->
-        `	mov	sp, trap_ptr\n`;
-        `	ldmfd	sp!, \{trap_ptr, pc}\n`; 2
+        if !Clflags.debug then begin
+          `	{emit_call "caml_raise_exn"}\n`;
+          `{record_frame Reg.Set.empty i.dbg}\n`; 1
+        end else begin
+          `	mov	sp, trap_ptr\n`;
+          `	pop	\{trap_ptr, pc}\n`; 2
+        end
 
 (* Emission of an instruction sequence *)
 
-let no_fallthrough = function
-    Lop(Itailcall_ind | Itailcall_imm _) -> true
-  | Lreturn -> true
-  | Lbranch _ -> true
-  | Lswitch _ -> true
-  | Lraise -> true
-  | _ -> false
-
 let rec emit_all ninstr i =
   if i.desc = Lend then () else begin
     let n = emit_instr i in
     let ninstr' = ninstr + n in
-    let limit = 511 - !num_literals in
-    if ninstr' >= limit - 64 && no_fallthrough i.desc then begin
-      emit_constants();
+    (* fldd can address up to +/-1KB, ldr can address up to +/-4KB *)
+    let limit = (if !fpu >= VFPv3_D16 && !float_literals <> []
+                 then 127
+                 else 511) in
+    let limit = limit - !num_literals in
+    if ninstr' >= limit - 64 && not(has_fallthrough i.desc) then begin
+      emit_literals();
       emit_all 0 i.next
-    end else
-    if ninstr' >= limit then begin
+    end else if !num_literals != 0 && ninstr' >= limit then begin
       let lbl = new_label() in
       `	b	{emit_label lbl}\n`;
-      emit_constants();
+      emit_literals();
       `{emit_label lbl}:\n`;
       emit_all 0 i.next
     end else
       emit_all ninstr' i.next
   end
 
+(* Emission of the profiling prelude *)
+
+let emit_profile() =
+  match Config.system with
+    "linux_eabi" | "linux_eabihf" ->
+      `	push	\{lr}\n`;
+      `	{emit_call "__gnu_mcount_nc"}\n`
+  | _ -> ()
+
 (* Emission of a function declaration *)
 
 let fundecl fundecl =
   function_name := fundecl.fun_name;
   fastcode_flag := fundecl.fun_fast;
   tailrec_entry_point := new_label();
+  float_literals := [];
+  gotrel_literals := [];
+  symbol_literals := [];
   stack_offset := 0;
-  Hashtbl.clear symbol_constants;
-  Hashtbl.clear float_constants;
+  call_gc_sites := [];
+  bound_error_sites := [];
   `	.text\n`;
   `	.align	2\n`;
-  `	.global	{emit_symbol fundecl.fun_name}\n`;
+  `	.globl	{emit_symbol fundecl.fun_name}\n`;
+  if !arch > ARMv6 && !thumb then
+    `	.thumb\n`
+  else
+    `	.arm\n`;
   `	.type	{emit_symbol fundecl.fun_name}, %function\n`;
   `{emit_symbol fundecl.fun_name}:\n`;
+  if !Clflags.gprofile then emit_profile();
   let n = frame_size() in
   ignore(emit_stack_adjustment "sub" n);
   if !contains_calls then
     `	str	lr, [sp, #{emit_int(n - 4)}]\n`;
   `{emit_label !tailrec_entry_point}:\n`;
   emit_all 0 fundecl.fun_body;
-  emit_constants()
+  emit_literals();
+  List.iter emit_call_gc !call_gc_sites;
+  List.iter emit_call_bound_error !bound_error_sites;
+  `	.type	{emit_symbol fundecl.fun_name}, %function\n`;
+  `	.size	{emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`
 
 (* Emission of data *)
 
 let emit_item = function
-    Cglobal_symbol s ->
-      `	.global	{emit_symbol s}\n`;
-  | Cdefine_symbol s ->
-      `{emit_symbol s}:\n`
-  | Cdefine_label lbl ->
-      `{emit_label (100000 + lbl)}:\n`
-  | Cint8 n ->
-      `	.byte	{emit_int n}\n`
-  | Cint16 n ->
-      `	.short	{emit_int n}\n`
-  | Cint32 n ->
-      `	.word	{emit_nativeint	n}\n`
-  | Cint n ->
-      `	.word	{emit_nativeint n}\n`
-  | Csingle f ->
-      emit_float32_directive ".long" f
-  | Cdouble f ->
-      emit_float64_split_directive ".long" f
-  | Csymbol_address s ->
-      `	.word	{emit_symbol s}\n`
-  | Clabel_address lbl ->
-      `	.word	{emit_label (100000 + lbl)}\n`
-  | Cstring s ->
-      emit_string_directive "	.ascii  " s
-  | Cskip n ->
-      if n > 0 then `	.space	{emit_int n}\n`
-  | Calign n ->
-      `	.align	{emit_int(Misc.log2 n)}\n`
+    Cglobal_symbol s -> `	.globl	{emit_symbol s}\n`;
+  | Cdefine_symbol s -> `{emit_symbol s}:\n`
+  | Cdefine_label lbl -> `{emit_data_label lbl}:\n`
+  | Cint8 n -> `	.byte	{emit_int n}\n`
+  | Cint16 n -> `	.short	{emit_int n}\n`
+  | Cint32 n -> `	.long	{emit_int32 (Nativeint.to_int32 n)}\n`
+  | Cint n -> `	.long	{emit_int32 (Nativeint.to_int32 n)}\n`
+  | Csingle f -> `	.single	{emit_string f}\n`
+  | Cdouble f -> `	.double	{emit_string f}\n`
+  | Csymbol_address s -> `	.word	{emit_symbol s}\n`
+  | Clabel_address lbl -> `	.word	{emit_data_label lbl}\n`
+  | Cstring s -> emit_string_directive "	.ascii  " s
+  | Cskip n -> if n > 0 then `	.space	{emit_int n}\n`
+  | Calign n -> `	.align	{emit_int(Misc.log2 n)}\n`
 
 let data l =
   `	.data\n`;
@@ -605,32 +878,62 @@ let data l =
 (* Beginning / end of an assembly file *)
 
 let begin_assembly() =
-  `trap_ptr     .req    r11\n`;
-  `alloc_ptr    .req    r8\n`;
-  `alloc_limit  .req    r10\n`;
+  `	.syntax	unified\n`;
+  begin match !arch with
+  | ARMv4   -> `	.arch	armv4t\n`
+  | ARMv5   -> `	.arch	armv5t\n`
+  | ARMv5TE -> `	.arch	armv5te\n`
+  | ARMv6   -> `	.arch	armv6\n`
+  | ARMv6T2 -> `	.arch	armv6t2\n`
+  | ARMv7   -> `	.arch	armv7-a\n`
+  end;
+  begin match !fpu with
+    Soft      -> `	.fpu	softvfp\n`
+  | VFPv3_D16 -> `	.fpu	vfpv3-d16\n`
+  | VFPv3     -> `	.fpu	vfpv3\n`
+  end;
+  `trap_ptr	.req	r8\n`;
+  `alloc_ptr	.req	r10\n`;
+  `alloc_limit	.req	r11\n`;
   let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
   `	.data\n`;
-  `	.global	{emit_symbol lbl_begin}\n`;
+  `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`;
   let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
   `	.text\n`;
-  `	.global	{emit_symbol lbl_begin}\n`;
+  `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly () =
   let lbl_end = Compilenv.make_symbol (Some "code_end") in
   `	.text\n`;
-  `	.global	{emit_symbol lbl_end}\n`;
+  `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
   let lbl_end = Compilenv.make_symbol (Some "data_end") in
   `	.data\n`;
-  `	.global	{emit_symbol lbl_end}\n`;
+  `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
-  `	.word	0\n`;
+  `	.long	0\n`;
   let lbl = Compilenv.make_symbol (Some "frametable") in
-  `	.data\n`;
-  `	.global	{emit_symbol lbl}\n`;
+  `	.globl	{emit_symbol lbl}\n`;
   `{emit_symbol lbl}:\n`;
-  `	.word	{emit_int (List.length !frame_descriptors)}\n`;
-  List.iter emit_frame !frame_descriptors;
-  frame_descriptors := []
+  emit_frames
+    { efa_label = (fun lbl ->
+                       `	.type	{emit_label lbl}, %function\n`;
+                       `	.word	{emit_label lbl}\n`);
+      efa_16 = (fun n -> `	.short	{emit_int n}\n`);
+      efa_32 = (fun n -> `	.long	{emit_int32 n}\n`);
+      efa_word = (fun n -> `	.word	{emit_int n}\n`);
+      efa_align = (fun n -> `	.align	{emit_int(Misc.log2 n)}\n`);
+      efa_label_rel = (fun lbl ofs ->
+                           `	.word	{emit_label lbl} - . + {emit_int32 ofs}\n`);
+      efa_def_label = (fun lbl -> `{emit_label lbl}:\n`);
+      efa_string = (fun s -> emit_string_directive "	.asciz	" s) };
+  `	.type	{emit_symbol lbl}, %object\n`;
+  `	.size	{emit_symbol lbl}, .-{emit_symbol lbl}\n`;
+  begin match Config.system with
+    "linux_eabihf" | "linux_eabi" ->
+      (* Mark stack as non-executable *)
+      `	.section	.note.GNU-stack,\"\",%progbits\n`
+  | _ -> ()
+  end
diff --git a/asmcomp/arm/proc.ml b/asmcomp/arm/proc.ml
index e56ac6e..aed2b01 100644
--- a/asmcomp/arm/proc.ml
+++ b/asmcomp/arm/proc.ml
@@ -1,16 +1,17 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                  Benedikt Meurer, University of Siegen              *)
 (*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
+(*    Copyright 1998 Institut National de Recherche en Informatique    *)
+(*    et en Automatique. Copyright 2012 Benedikt Meurer. All rights    *)
+(*    reserved.  This file is distributed  under the terms of the Q    *)
+(*    Public License version 1.0.                                      *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: proc.ml 9252 2009-05-04 13:46:46Z xleroy $ *)
+(* $Id$ *)
 
 (* Description of the ARM processor *)
 
@@ -26,32 +27,56 @@ let word_addressed = false
 
 (* Registers available for register allocation *)
 
-(* Register map:
-    r0 - r3                     general purpose (not preserved by C)
-    r4 - r7                     general purpose (preserved)
-    r8                          allocation pointer (preserved)
-    r9                          platform register, usually reserved
-    r10                         allocation limit (preserved)
-    r11                         trap pointer (preserved)
-    r12                         general purpose (not preserved by C)
-    r13                         stack pointer
-    r14                         return address
-    r15                         program counter
+(* Integer register map:
+    r0 - r3               general purpose (not preserved)
+    r4 - r7               general purpose (preserved)
+    r8                    trap pointer (preserved)
+    r9                    platform register, usually reserved
+    r10                   allocation pointer (preserved)
+    r11                   allocation limit (preserved)
+    r12                   intra-procedural scratch register (not preserved)
+    r13                   stack pointer
+    r14                   return address
+    r15                   program counter
+   Floatinng-point register map (VFPv3):
+    d0 - d7               general purpose (not preserved)
+    d8 - d15              general purpose (preserved)
+    d16 - d31             generat purpose (not preserved), VFPv3 only
 *)
 
-let int_reg_name = [|
-  "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12"
-|]
+let int_reg_name =
+  [| "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12" |]
+
+let float_reg_name =
+  [| "d0";  "d1";  "d2";  "d3";  "d4";  "d5";  "d6";  "d7";
+     "d8";  "d9";  "d10"; "d11"; "d12"; "d13"; "d14"; "d15";
+     "d16"; "d17"; "d18"; "d19"; "d20"; "d21"; "d22"; "d23";
+     "d24"; "d25"; "d26"; "d27"; "d28"; "d29"; "d30"; "d31" |]
+
+(* We have three register classes:
+    0 for integer registers
+    1 for VFPv3-D16
+    2 for VFPv3
+   This way we can choose between VFPv3-D16 and VFPv3
+   at (ocamlopt) runtime using command line switches.
+*)
 
-let num_register_classes = 1
+let num_register_classes = 3
 
-let register_class r = assert (r.typ <> Float); 0
+let register_class r =
+  match (r.typ, !fpu) with
+    (Int | Addr), _  -> 0
+  | Float, VFPv3_D16 -> 1
+  | Float, _         -> 2
 
-let num_available_registers = [| 9 |]
+let num_available_registers =
+  [| 9; 16; 32 |]
 
-let first_available_register = [| 0 |]
+let first_available_register =
+  [| 0; 100; 100 |]
 
-let register_name r = int_reg_name.(r)
+let register_name r =
+  if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
 
 let rotate_registers = true
 
@@ -59,25 +84,34 @@ let rotate_registers = true
 
 let hard_int_reg =
   let v = Array.create 9 Reg.dummy in
-  for i = 0 to 8 do v.(i) <- Reg.at_location Int (Reg i) done;
+  for i = 0 to 8 do
+    v.(i) <- Reg.at_location Int (Reg i)
+  done;
+  v
+
+let hard_float_reg =
+  let v = Array.create 32 Reg.dummy in
+  for i = 0 to 31 do
+    v.(i) <- Reg.at_location Float (Reg(100 + i))
+  done;
   v
 
-let all_phys_regs = hard_int_reg
+let all_phys_regs =
+  Array.append hard_int_reg hard_float_reg
 
-let phys_reg n = all_phys_regs.(n)
+let phys_reg n =
+  if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
 
 let stack_slot slot ty =
-  assert (ty <> Float);
   Reg.at_location ty (Stack slot)
 
 (* Calling conventions *)
 
-(* XXX float types have already been expanded into pairs of integers.
-   So we cannot align these floats.  See if that causes a problem. *)
-
-let calling_conventions first_int last_int make_stack arg =
+let calling_conventions
+    first_int last_int first_float last_float make_stack arg =
   let loc = Array.create (Array.length arg) Reg.dummy in
   let int = ref first_int in
+  let float = ref first_float in
   let ofs = ref 0 in
   for i = 0 to Array.length arg - 1 do
     match arg.(i).typ with
@@ -90,37 +124,86 @@ let calling_conventions first_int last_int make_stack arg =
           ofs := !ofs + size_int
         end
     | Float ->
-        assert false
+        assert (abi = EABI_VFP);
+        assert (!fpu >= VFPv3_D16);
+        if !float <= last_float then begin
+          loc.(i) <- phys_reg !float;
+          incr float
+        end else begin
+          ofs := Misc.align !ofs size_float;
+          loc.(i) <- stack_slot (make_stack !ofs) Float;
+          ofs := !ofs + size_float
+        end
   done;
-  (loc, Misc.align !ofs 8)
+  (loc, Misc.align !ofs 8)  (* keep stack 8-aligned *)
 
 let incoming ofs = Incoming ofs
 let outgoing ofs = Outgoing ofs
 let not_supported ofs = fatal_error "Proc.loc_results: cannot call"
 
+(* OCaml calling convention:
+     first integer args in r0...r7
+     first float args in d0...d15 (EABI+VFP)
+     remaining args on stack.
+   Return values in r0...r7 or d0...d15. *)
+
 let loc_arguments arg =
-  calling_conventions 0 7 outgoing arg
+  calling_conventions 0 7 100 115 outgoing arg
 let loc_parameters arg =
-  let (loc, ofs) = calling_conventions 0 7 incoming arg in loc
+  let (loc, _) = calling_conventions 0 7 100 115 incoming arg in loc
 let loc_results res =
-  let (loc, ofs) = calling_conventions 0 7 not_supported res in loc
+  let (loc, _) = calling_conventions 0 7 100 115 not_supported res in loc
+
+(* C calling convention:
+     first integer args in r0...r3
+     first float args in d0...d7 (EABI+VFP)
+     remaining args on stack.
+   Return values in r0...r1 or d0. *)
 
 let loc_external_arguments arg =
-  calling_conventions 0 3 outgoing arg
+  calling_conventions 0 3 100 107 outgoing arg
 let loc_external_results res =
-  let (loc, ofs) = calling_conventions 0 1 not_supported res in loc
+  let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc
 
 let loc_exn_bucket = phys_reg 0
 
 (* Registers destroyed by operations *)
 
-let destroyed_at_c_call =               (* r4-r7 preserved *)
-  Array.of_list(List.map phys_reg [0;1;2;3;8])
+let destroyed_at_alloc =            (* r0-r6, d0-d15 preserved *)
+  Array.of_list (List.map
+                   phys_reg
+                   [7;8;
+                    116;116;118;119;120;121;122;123;
+                    124;125;126;127;128;129;130;131])
+
+let destroyed_at_c_call =
+  Array.of_list (List.map
+                   phys_reg
+                   (match abi with
+                      EABI ->       (* r4-r7 preserved *)
+                        [0;1;2;3;8;
+                         100;101;102;103;104;105;106;107;
+                         108;109;110;111;112;113;114;115;
+                         116;116;118;119;120;121;122;123;
+                         124;125;126;127;128;129;130;131]
+                    | EABI_VFP ->   (* r4-r7, d8-d15 preserved *)
+                        [0;1;2;3;8;
+                         100;101;102;103;104;105;106;107;
+                         116;116;118;119;120;121;122;123;
+                         124;125;126;127;128;129;130;131]))
 
 let destroyed_at_oper = function
-    Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs
-  | Iop(Iextcall(_, false)) -> destroyed_at_c_call
-  | Iop(Ialloc(_)) -> [|phys_reg 8|]    (* r12 destroyed *)
+    Iop(Icall_ind | Icall_imm _ )
+  | Iop(Iextcall(_, true)) ->
+      all_phys_regs
+  | Iop(Iextcall(_, false)) ->
+      destroyed_at_c_call
+  | Iop(Ialloc n) ->
+      destroyed_at_alloc
+  | Iop(Iconst_symbol _) when !pic_code ->
+      [|phys_reg 3; phys_reg 8|]  (* r3 and r12 destroyed *)
+  | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _)) ->
+      [|phys_reg 107|]            (* d7 (s14-s15) destroyed *)
   | _ -> [||]
 
 let destroyed_at_raise = all_phys_regs
@@ -128,15 +211,16 @@ let destroyed_at_raise = all_phys_regs
 (* Maximal register pressure *)
 
 let safe_register_pressure = function
-    Iextcall(_, _) -> 4
+    Iextcall(_, _) -> 5
   | _ -> 9
+
 let max_register_pressure = function
-    Iextcall(_, _) -> [| 4 |]
-  | _ -> [| 9 |]
+    Iextcall(_, _) -> [| 5; 9; 9 |]
+  | _ -> [| 9; 16; 32 |]
 
 (* Layout of the stack *)
 
-let num_stack_slots = [| 0 |]
+let num_stack_slots = [| 0; 0; 0 |]
 let contains_calls = ref false
 
 (* Calling the assembler *)
@@ -144,6 +228,3 @@ let contains_calls = ref false
 let assemble_file infile outfile =
   Ccomp.command (Config.asm ^ " -o " ^
                  Filename.quote outfile ^ " " ^ Filename.quote infile)
-
-open Clflags;;
-open Config;;
diff --git a/asmcomp/arm/reload.ml b/asmcomp/arm/reload.ml
index 0917438..c5b137a 100644
--- a/asmcomp/arm/reload.ml
+++ b/asmcomp/arm/reload.ml
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,7 +10,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: reload.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+(* $Id$ *)
 
 (* Reloading for the ARM *)
 
diff --git a/asmcomp/arm/scheduling.ml b/asmcomp/arm/scheduling.ml
index 930e1bc..4b47733 100644
--- a/asmcomp/arm/scheduling.ml
+++ b/asmcomp/arm/scheduling.ml
@@ -1,51 +1,79 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                  Benedikt Meurer, University of Siegen              *)
 (*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
+(*    Copyright 1998 Institut National de Recherche en Informatique    *)
+(*    et en Automatique. Copyright 2012 Benedikt Meurer. All rights    *)
+(*    reserved.  This file is distributed  under the terms of the Q    *)
+(*    Public License version 1.0.                                      *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: scheduling.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+(* $Id$ *)
 
+open Arch
 open Mach
 
-(* Instruction scheduling for the Sparc *)
+(* Instruction scheduling for the ARM *)
 
-class scheduler = object
+class scheduler = object(self)
 
-inherit Schedgen.scheduler_generic
+inherit Schedgen.scheduler_generic as super
 
-(* Scheduling -- based roughly on the Strong ARM *)
+(* Scheduling -- based roughly on the ARM11 (ARMv6) *)
 
 method oper_latency = function
-    Ireload -> 2
-  | Iload(_, _) -> 2
-  | Iconst_symbol _ -> 2                (* turned into a load *)
-  | Iconst_float _ -> 2                 (* turned into a load *)
-  | Iintop(Imul) -> 3
-  | Iintop_imm(Imul, _) -> 3
-  (* No data available for floatops, let's make educated guesses *)
-  | Iaddf -> 3
-  | Isubf -> 3
-  | Imulf -> 5
-  | Idivf -> 15
+  (* Loads have a latency of two cycles in general *)
+    Iconst_symbol _
+  | Iconst_float _
+  | Iload(_, _)
+  | Ireload
+  | Ifloatofint       (* mcr/mrc count as memory access *)
+  | Iintoffloat -> 2
+  (* Multiplys have a latency of two cycles *)
+  | Iintop Imul
+  | Ispecific(Imuladd | Imulsub) -> 2
+  (* VFP instructions *)
+  | Iaddf
+  | Isubf
+  | Idivf
+  | Imulf | Ispecific Inegmulf
+  | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)
+  | Ispecific Isqrtf
+  | Inegf | Iabsf when !fpu >= VFPv3_D16 -> 2
+  (* Everything else *)
   | _ -> 1
 
-(* Issue cycles.  Rough approximations *)
+method! is_checkbound = function
+    Ispecific(Ishiftcheckbound _) -> true
+  | op -> super#is_checkbound op
+
+(* Issue cycles. Rough approximations *)
 
 method oper_issue_cycles = function
     Ialloc _ -> 4
-  | Iintop(Icomp _) -> 3
-  | Iintop(Icheckbound) -> 2
-  | Iintop_imm(Idiv, _) -> 4
-  | Iintop_imm(Imod, _) -> 6
+  | Iintop(Ilsl | Ilsr | Iasr) -> 2
+  | Iintop(Icomp _)
   | Iintop_imm(Icomp _, _) -> 3
+  | Iintop(Icheckbound)
   | Iintop_imm(Icheckbound, _) -> 2
+  | Ispecific(Ishiftcheckbound _) -> 3
+  | Iintop_imm(Idiv, _) -> 4
+  | Iintop_imm(Imod, _) -> 6
+  | Iintop Imul
+  | Ispecific(Imuladd | Imulsub) -> 2
+  (* VFP instructions *)
+  | Iaddf
+  | Isubf -> 7
+  | Imulf
+  | Ispecific Inegmulf -> 9
+  | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -> 17
+  | Idivf
+  | Ispecific Isqrtf -> 27
+  | Inegf | Iabsf | Iconst_float _ when !fpu >= VFPv3_D16 -> 4
+  (* Everything else *)
   | _ -> 1
 
 end
diff --git a/asmcomp/arm/selection.ml b/asmcomp/arm/selection.ml
index f09d146..94d0367 100644
--- a/asmcomp/arm/selection.ml
+++ b/asmcomp/arm/selection.ml
@@ -1,54 +1,77 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                  Benedikt Meurer, University of Siegen              *)
 (*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
+(*    Copyright 1998 Institut National de Recherche en Informatique    *)
+(*    et en Automatique. Copyright 2012 Benedikt Meurer. All rights    *)
+(*    reserved.  This file is distributed  under the terms of the Q    *)
+(*    Public License version 1.0.                                      *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: selection.ml 10295 2010-04-22 12:39:40Z xleroy $ *)
+(* $Id$ *)
 
 (* Instruction selection for the ARM processor *)
 
-open Misc
-open Cmm
-open Reg
 open Arch
-open Proc
+open Cmm
 open Mach
+open Misc
+open Proc
+open Reg
 
-(* Immediate operands are 8-bit immediate values, zero-extended, and rotated
-   right by 0, 2, 4, ... 30 bits.
-   To avoid problems with Caml's 31-bit arithmetic,
-   we check only with 8-bit values shifted left 0 to 22 bits. *)
-
-let rec is_immed n shift =
-  if shift > 22 then false
-  else if n land (0xFF lsl shift) = n then true
-  else is_immed n (shift + 2)
+let is_offset chunk n =
+  match chunk with
+  (* VFPv3 load/store have -1020 to 1020 *)
+    Single | Double | Double_u
+    when !fpu >= VFPv3_D16 ->
+      n >= -1020 && n <= 1020
+  (* ARM load/store byte/word have -4095 to 4095 *)
+  | Byte_unsigned | Byte_signed
+  | Thirtytwo_unsigned | Thirtytwo_signed
+  | Word | Single
+    when not !thumb ->
+      n >= -4095 && n <= 4095
+  (* Thumb-2 load/store have -255 to 4095 *)
+  | _ when !arch > ARMv6 && !thumb ->
+      n >= -255 && n <= 4095
+  (* Everything else has -255 to 255 *)
+  | _ ->
+      n >= -255 && n <= 255
 
-(* We have 12-bit + sign byte offsets for word accesses,
-   8-bit + sign word offsets for float accesses,
-   and 8-bit + sign byte offsets for bytes and shorts.
-   Use lowest common denominator. *)
+let is_intconst = function
+    Cconst_int _ -> true
+  | _ -> false
 
-let is_offset n = n < 256 && n > -256
+(* Special constraints on operand and result registers *)
 
-let is_intconst = function Cconst_int n -> true | _ -> false
+exception Use_default
 
-(* Soft emulation of float comparisons *)
+let r1 = phys_reg 1
 
-let float_comparison_function = function
-  | Ceq -> "__eqdf2"
-  | Cne -> "__nedf2"
-  | Clt -> "__ltdf2"
-  | Cle -> "__ledf2"
-  | Cgt -> "__gtdf2"
-  | Cge -> "__gedf2"
+let pseudoregs_for_operation op arg res =
+  match op with
+  (* For mul rd,rm,rs and mla rd,rm,rs,ra (pre-ARMv6) the registers rm
+     and rd must be different. We deal with this by pretending that rm
+     is also a result of the mul / mla operation. *)
+    Iintop Imul | Ispecific Imuladd when !arch < ARMv6 ->
+      (arg, [| res.(0); arg.(0) |])
+  (* Soft-float Iabsf and Inegf: arg.(0) and res.(0) must be the same *)
+  | Iabsf | Inegf when !fpu = Soft ->
+      ([|res.(0); arg.(1)|], res)
+  (* VFPv3 Imuladdf...Inegmulsubf: arg.(0) and res.(0) must be the same *)
+  | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) ->
+      let arg' = Array.copy arg in
+      arg'.(0) <- res.(0);
+      (arg', res)
+  (* We use __aeabi_idivmod for Cmodi only, and hence we care only
+     for the remainder in r1, so fix up the destination register. *)
+  | Iextcall("__aeabi_idivmod", false) ->
+      (arg, [|r1|])
+  (* Other instructions are regular *)
+  | _ -> raise Use_default
 
 (* Instruction selection *)
 class selector = object(self)
@@ -56,23 +79,32 @@ class selector = object(self)
 inherit Selectgen.selector_generic as super
 
 method! regs_for tyv =
-  (* Expand floats into pairs of integer registers *)
-  let nty = Array.length tyv in
-  let rec expand i =
-    if i >= nty then [] else begin
-      match tyv.(i) with
-      | Float -> Int :: Int :: expand (i+1)
-      | ty -> ty :: expand (i+1)
-    end in
-  Reg.createv (Array.of_list (expand 0))
+  Reg.createv (if !fpu = Soft then begin
+                 (* Expand floats into pairs of integer registers *)
+                 let rec expand = function
+                   [] -> []
+                 | Float :: tyl -> Int :: Int :: expand tyl
+                 | ty :: tyl -> ty :: expand tyl in
+                 Array.of_list (expand (Array.to_list tyv))
+               end else begin
+                 tyv
+               end)
 
 method is_immediate n =
-  n land 0xFF = n || is_immed n 2
+  is_immediate (Int32.of_int n)
+
+method! is_simple_expr = function
+  (* inlined floating-point ops are simple if their arguments are *)
+  | Cop(Cextcall("sqrt", _, _, _), args) when !fpu >= VFPv3_D16 ->
+      List.for_all self#is_simple_expr args
+  | e -> super#is_simple_expr e
 
-method select_addressing = function
-    Cop(Cadda, [arg; Cconst_int n]) when is_offset n ->
+method select_addressing chunk = function
+  | Cop(Cadda, [arg; Cconst_int n])
+    when is_offset chunk n ->
       (Iindexed n, arg)
-  | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) when is_offset n ->
+  | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])])
+    when is_offset chunk n ->
       (Iindexed n, Cop(Cadda, [arg1; arg2]))
   | arg ->
       (Iindexed 0, arg)
@@ -91,109 +123,146 @@ method select_shift_arith op shiftop shiftrevop args =
   | [Cop(Casr, [arg1; Cconst_int n]); arg2]
     when n > 0 && n < 32 && not(is_intconst arg1) ->
       (Ispecific(Ishiftarith(shiftrevop, -n)), [arg2; arg1])
-  | _ ->
-      super#select_operation op args
+  | args ->
+      begin match super#select_operation op args with
+      (* Recognize multiply and add *)
+        (Iintop Iadd, [Cop(Cmuli, args); arg3])
+      | (Iintop Iadd, [arg3; Cop(Cmuli, args)]) as op_args ->
+          begin match self#select_operation Cmuli args with
+            (Iintop Imul, [arg1; arg2]) ->
+              (Ispecific Imuladd, [arg1; arg2; arg3])
+          | _ -> op_args
+          end
+      (* Recognize multiply and subtract *)
+      | (Iintop Isub, [arg3; Cop(Cmuli, args)]) as op_args
+        when !arch > ARMv6 ->
+          begin match self#select_operation Cmuli args with
+            (Iintop Imul, [arg1; arg2]) ->
+              (Ispecific Imulsub, [arg1; arg2; arg3])
+          | _ -> op_args
+          end
+      | op_args -> op_args
+      end
 
 method! select_operation op args =
-  match op with
-    Cadda | Caddi ->
-      begin match args with
-        [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) ->
-          (Iintop_imm(Isub, -n), [arg1])
-      | _ ->
-          self#select_shift_arith op Ishiftadd Ishiftadd args
-      end
-  | Csuba | Csubi ->
-      begin match args with
-        [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) ->
-          (Iintop_imm(Iadd, -n), [arg1])
-      | [Cconst_int n; arg2] when self#is_immediate n ->
-          (Ispecific(Irevsubimm n), [arg2])
-      | _ ->
-          self#select_shift_arith op Ishiftsub Ishiftsubrev args
-      end
-  | Cmuli ->                    (* no multiply immediate *)
+  match (op, args) with
+  (* Recognize special shift arithmetic *)
+    ((Cadda | Caddi), [arg; Cconst_int n])
+    when n < 0 && self#is_immediate (-n) ->
+      (Iintop_imm(Isub, -n), [arg])
+  | ((Cadda | Caddi as op), args) ->
+      self#select_shift_arith op Ishiftadd Ishiftadd args
+  | ((Csuba | Csubi), [arg; Cconst_int n])
+    when n < 0 && self#is_immediate (-n) ->
+      (Iintop_imm(Iadd, -n), [arg])
+  | ((Csuba | Csubi), [Cconst_int n; arg])
+    when self#is_immediate n ->
+      (Ispecific(Irevsubimm n), [arg])
+  | ((Csuba | Csubi as op), args) ->
+      self#select_shift_arith op Ishiftsub Ishiftsubrev args
+  | (Ccheckbound _, [Cop(Clsr, [arg1; Cconst_int n]); arg2])
+    when n > 0 && n < 32 && not(is_intconst arg2) ->
+      (Ispecific(Ishiftcheckbound n), [arg1; arg2])
+  (* ARM does not support immediate operands for multiplication *)
+  | (Cmuli, args) ->
       (Iintop Imul, args)
-  | Cdivi ->
-      begin match args with
-        [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) ->
-          (Iintop_imm(Idiv, n), [arg1])
-      | _ ->
-          (Iextcall("__divsi3", false), args)
-      end
-  | Cmodi ->
-      begin match args with
-        [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) ->
-          (Iintop_imm(Imod, n), [arg1])
-      | _ ->
-          (Iextcall("__modsi3", false), args)
-      end
-  | Ccheckbound _ ->
-      begin match args with
-        [Cop(Clsr, [arg1; Cconst_int n]); arg2]
-        when n > 0 && n < 32 && not(is_intconst arg2) ->
-          (Ispecific(Ishiftcheckbound n), [arg1; arg2])
-      | _ ->
-        super#select_operation op args
-      end
-  (* Turn floating-point operations into library function calls *)
-  | Caddf -> (Iextcall("__adddf3", false), args)
-  | Csubf -> (Iextcall("__subdf3", false), args)
-  | Cmulf -> (Iextcall("__muldf3", false), args)
-  | Cdivf -> (Iextcall("__divdf3", false), args)
-  | Cfloatofint -> (Iextcall("__floatsidf", false), args)
-  | Cintoffloat -> (Iextcall("__fixdfsi", false), args)
-  | Ccmpf comp ->
-      (Iintop_imm(Icomp(Isigned comp), 0),
-       [Cop(Cextcall(float_comparison_function comp,
-                     typ_int, false, Debuginfo.none),
-            args)])
+  (* Turn integer division/modulus into runtime ABI calls *)
+  | (Cdivi, [arg; Cconst_int n])
+    when n = 1 lsl Misc.log2 n ->
+      (Iintop_imm(Idiv, n), [arg])
+  | (Cdivi, args) ->
+      (Iextcall("__aeabi_idiv", false), args)
+  | (Cmodi, [arg; Cconst_int n])
+    when n = 1 lsl Misc.log2 n ->
+      (Iintop_imm(Imod, n), [arg])
+  | (Cmodi, args) ->
+      (* See above for fix up of return register *)
+      (Iextcall("__aeabi_idivmod", false), args)
+  (* Turn floating-point operations into runtime ABI calls for softfp *)
+  | (op, args) when !fpu = Soft -> self#select_operation_softfp op args
+  (* Select operations for VFPv3 *)
+  | (op, args) -> self#select_operation_vfpv3 op args
+
+method private select_operation_softfp op args =
+  match (op, args) with
+  (* Turn floating-point operations into runtime ABI calls *)
+  | (Caddf, args) -> (Iextcall("__aeabi_dadd", false), args)
+  | (Csubf, args) -> (Iextcall("__aeabi_dsub", false), args)
+  | (Cmulf, args) -> (Iextcall("__aeabi_dmul", false), args)
+  | (Cdivf, args) -> (Iextcall("__aeabi_ddiv", false), args)
+  | (Cfloatofint, args) -> (Iextcall("__aeabi_i2d", false), args)
+  | (Cintoffloat, args) -> (Iextcall("__aeabi_d2iz", false), args)
+  | (Ccmpf comp, args) ->
+      let func = (match comp with
+                    Cne    (* there's no __aeabi_dcmpne *)
+                  | Ceq -> "__aeabi_dcmpeq"
+                  | Clt -> "__aeabi_dcmplt"
+                  | Cle -> "__aeabi_dcmple"
+                  | Cgt -> "__aeabi_dcmpgt"
+                  | Cge -> "__aeabi_dcmpge") in
+      let comp = (match comp with
+                    Cne -> Ceq (* eq 0 => false *)
+                  | _   -> Cne (* ne 0 => true *)) in
+      (Iintop_imm(Icomp(Iunsigned comp), 0),
+       [Cop(Cextcall(func, typ_int, false, Debuginfo.none), args)])
   (* Add coercions around loads and stores of 32-bit floats *)
-  | Cload Single ->
-      (Iextcall("__extendsfdf2", false), [Cop(Cload Word, args)])
-  | Cstore Single ->
-      begin match args with
-      | [arg1; arg2] ->
-          let arg2' =
-            Cop(Cextcall("__truncdfsf2", typ_int, false, Debuginfo.none),
-                [arg2]) in
-          self#select_operation (Cstore Word) [arg1; arg2']
-      | _ -> assert false
-      end
+  | (Cload Single, args) ->
+      (Iextcall("__aeabi_f2d", false), [Cop(Cload Word, args)])
+  | (Cstore Single, [arg1; arg2]) ->
+      let arg2' =
+        Cop(Cextcall("__aeabi_d2f", typ_int, false, Debuginfo.none),
+            [arg2]) in
+      self#select_operation (Cstore Word) [arg1; arg2']
   (* Other operations are regular *)
-  | _ -> super#select_operation op args
+  | (op, args) -> super#select_operation op args
+
+method private select_operation_vfpv3 op args =
+  match (op, args) with
+  (* Recognize floating-point negate and multiply *)
+    (Cnegf, [Cop(Cmulf, args)]) ->
+      (Ispecific Inegmulf, args)
+  (* Recognize floating-point multiply and add *)
+  | (Caddf, [arg; Cop(Cmulf, args)])
+  | (Caddf, [Cop(Cmulf, args); arg]) ->
+      (Ispecific Imuladdf, arg :: args)
+  (* Recognize floating-point negate, multiply and subtract *)
+  | (Csubf, [Cop(Cnegf, [arg]); Cop(Cmulf, args)])
+  | (Csubf, [Cop(Cnegf, [Cop(Cmulf, args)]); arg]) ->
+      (Ispecific Inegmulsubf, arg :: args)
+  (* Recognize floating-point negate, multiply and add *)
+  | (Csubf, [arg; Cop(Cmulf, args)]) ->
+      (Ispecific Inegmuladdf, arg :: args)
+  (* Recognize multiply and subtract *)
+  | (Csubf, [Cop(Cmulf, args); arg]) ->
+      (Ispecific Imulsubf, arg :: args)
+  (* Recognize floating-point square root *)
+  | (Cextcall("sqrt", _, false, _), args) ->
+      (Ispecific Isqrtf, args)
+  (* Other operations are regular *)
+  | (op, args) -> super#select_operation op args
 
 method! select_condition = function
-  | Cop(Ccmpf cmp, args) ->
-      (Iinttest_imm(Isigned cmp, 0),
-       Cop(Cextcall(float_comparison_function cmp,
-                    typ_int, false, Debuginfo.none),
-           args))
+  (* Turn floating-point comparisons into runtime ABI calls *)
+    Cop(Ccmpf _ as op, args) when !fpu = Soft ->
+      begin match self#select_operation_softfp op args with
+        (Iintop_imm(Icomp(Iunsigned Ceq), 0), [arg]) -> (Ifalsetest, arg)
+      | (Iintop_imm(Icomp(Iunsigned Cne), 0), [arg]) -> (Itruetest, arg)
+      | _ -> assert false
+      end
   | expr ->
       super#select_condition expr
 
-(* Deal with some register irregularities:
-
-1- In mul rd, rm, rs,  the registers rm and rd must be different.
-   We deal with this by pretending that rm is also a result of the mul
-   operation.
-
-2- For Inegf and Iabsf, force arguments and results in (r0, r1);
-   this simplifies code generation later.
-*)
+(* Deal with some register constraints *)
 
 method! insert_op_debug op dbg rs rd =
-  match op with
-  | Iintop(Imul) ->
-      self#insert_debug (Iop op) dbg rs [| rd.(0); rs.(0) |]; rd
-  | Iabsf | Inegf ->
-      let r = [| phys_reg 0; phys_reg 1 |] in
-      self#insert_moves rs r;
-      self#insert_debug (Iop op) dbg r r;
-      self#insert_moves r rd;
-      rd
-  | _ ->
-      super#insert_op_debug op dbg rs rd
+  try
+    let (rsrc, rdst) = pseudoregs_for_operation op rs rd in
+    self#insert_moves rs rsrc;
+    self#insert_debug (Iop op) dbg rsrc rdst;
+    self#insert_moves rdst rd;
+    rd
+  with Use_default ->
+    super#insert_op_debug op dbg rs rd
 
 end
 
diff --git a/asmcomp/i386/selection.ml b/asmcomp/i386/selection.ml
index 1700bf3..827a63d 100644
--- a/asmcomp/i386/selection.ml
+++ b/asmcomp/i386/selection.ml
@@ -168,7 +168,7 @@ method! is_simple_expr e =
   | _ ->
       super#is_simple_expr e
 
-method select_addressing exp =
+method select_addressing chunk exp =
   match select_addr exp with
     (Asymbol s, d) ->
       (Ibased(s, d), Ctuple [])
@@ -200,7 +200,7 @@ method! select_operation op args =
   match op with
   (* Recognize the LEA instruction *)
     Caddi | Cadda | Csubi | Csuba ->
-      begin match self#select_addressing (Cop(op, args)) with
+      begin match self#select_addressing Word (Cop(op, args)) with
         (Iindexed d, _) -> super#select_operation op args
       | (Iindexed2 0, _) -> super#select_operation op args
       | (addr, arg) -> (Ispecific(Ilea addr), [arg])
@@ -233,7 +233,7 @@ method! select_operation op args =
       begin match args with
         [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])]
         when loc = loc' ->
-          let (addr, arg) = self#select_addressing loc in
+          let (addr, arg) = self#select_addressing Word loc in
           (Ispecific(Ioffset_loc(n, addr)), [arg])
       | _ ->
           super#select_operation op args
@@ -250,11 +250,11 @@ method! select_operation op args =
 method select_floatarith regular_op reversed_op mem_op mem_rev_op args =
   match args with
     [arg1; Cop(Cload chunk, [loc2])] ->
-      let (addr, arg2) = self#select_addressing loc2 in
+      let (addr, arg2) = self#select_addressing chunk loc2 in
       (Ispecific(Ifloatarithmem(chunk_double chunk, mem_op, addr)),
                  [arg1; arg2])
   | [Cop(Cload chunk, [loc1]); arg2] ->
-      let (addr, arg1) = self#select_addressing loc1 in
+      let (addr, arg1) = self#select_addressing chunk loc1 in
       (Ispecific(Ifloatarithmem(chunk_double chunk, mem_rev_op, addr)),
                  [arg2; arg1])
   | [arg1; arg2] ->
@@ -295,10 +295,10 @@ method select_push exp =
   | Cconst_natpointer n -> (Ispecific(Ipush_int n), Ctuple [])
   | Cconst_symbol s -> (Ispecific(Ipush_symbol s), Ctuple [])
   | Cop(Cload Word, [loc]) ->
-      let (addr, arg) = self#select_addressing loc in
+      let (addr, arg) = self#select_addressing Word loc in
       (Ispecific(Ipush_load addr), arg)
   | Cop(Cload Double_u, [loc]) ->
-      let (addr, arg) = self#select_addressing loc in
+      let (addr, arg) = self#select_addressing Double_u loc in
       (Ispecific(Ipush_load_float addr), arg)
   | _ -> (Ispecific(Ipush), exp)
 
diff --git a/asmcomp/power/selection.ml b/asmcomp/power/selection.ml
index ed15efb..0532d6b 100644
--- a/asmcomp/power/selection.ml
+++ b/asmcomp/power/selection.ml
@@ -52,7 +52,7 @@ inherit Selectgen.selector_generic as super
 
 method is_immediate n = (n <= 32767) && (n >= -32768)
 
-method select_addressing exp =
+method select_addressing chunk exp =
   match select_addr exp with
     (Asymbol s, d) ->
       (Ibased(s, d), Ctuple [])
diff --git a/asmcomp/power64/selection.ml b/asmcomp/power64/selection.ml
index 7b8e2a4..d2325e1 100644
--- a/asmcomp/power64/selection.ml
+++ b/asmcomp/power64/selection.ml
@@ -52,7 +52,7 @@ inherit Selectgen.selector_generic as super
 
 method is_immediate n = (n <= 32767) && (n >= -32768)
 
-method select_addressing exp =
+method select_addressing chunk exp =
   match select_addr exp with
     (Asymbol s, d) ->
       (Ibased(s, d), Ctuple [])
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
index 2fc40f7..0bc9efb 100644
--- a/asmcomp/selectgen.ml
+++ b/asmcomp/selectgen.ml
@@ -204,7 +204,7 @@ method virtual is_immediate : int -> bool
 (* Selection of addressing modes *)
 
 method virtual select_addressing :
-  Cmm.expression -> Arch.addressing_mode * Cmm.expression
+  Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression
 
 (* Default instruction selection for stores (of words) *)
 
@@ -219,10 +219,10 @@ method select_operation op args =
   | (Capply(ty, dbg), _) -> (Icall_ind, args)
   | (Cextcall(s, ty, alloc, dbg), _) -> (Iextcall(s, alloc), args)
   | (Cload chunk, [arg]) ->
-      let (addr, eloc) = self#select_addressing arg in
+      let (addr, eloc) = self#select_addressing chunk arg in
       (Iload(chunk, addr), [eloc])
   | (Cstore chunk, [arg1; arg2]) ->
-      let (addr, eloc) = self#select_addressing arg1 in
+      let (addr, eloc) = self#select_addressing chunk arg1 in
       if chunk = Word then begin
         let (op, newarg2) = self#select_store addr arg2 in
         (op, [newarg2; eloc])
@@ -366,7 +366,7 @@ method insert_move src dst =
     self#insert (Iop Imove) [|src|] [|dst|]
 
 method insert_moves src dst =
-  for i = 0 to Array.length src - 1 do
+  for i = 0 to min (Array.length src) (Array.length dst) - 1 do
     self#insert_move src.(i) dst.(i)
   done
 
@@ -490,9 +490,8 @@ method emit_expr env exp =
               let (loc_arg, stack_ofs) =
                 self#emit_extcall_args env new_args in
               let rd = self#regs_for ty in
-              let loc_res = Proc.loc_external_results rd in
-              self#insert_debug (Iop(Iextcall(lbl, alloc))) dbg
-                             loc_arg loc_res;
+              let loc_res = self#insert_op_debug (Iextcall(lbl, alloc)) dbg
+                                    loc_arg (Proc.loc_external_results rd) in
               self#insert_move_results loc_res rd stack_ofs;
               Some rd
           | Ialloc _ ->
diff --git a/asmcomp/selectgen.mli b/asmcomp/selectgen.mli
index ae53cda..69dae6d 100644
--- a/asmcomp/selectgen.mli
+++ b/asmcomp/selectgen.mli
@@ -26,7 +26,7 @@ class virtual selector_generic : object
     (* Must be defined to indicate whether a constant is a suitable
        immediate operand to arithmetic instructions *)
   method virtual select_addressing :
-    Cmm.expression -> Arch.addressing_mode * Cmm.expression
+    Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression
     (* Must be defined to select addressing modes *)
   method is_simple_expr: Cmm.expression -> bool
     (* Can be overridden to reflect special extcalls known to be pure *)
diff --git a/asmcomp/sparc/selection.ml b/asmcomp/sparc/selection.ml
index 82758dc..c1f30fd 100644
--- a/asmcomp/sparc/selection.ml
+++ b/asmcomp/sparc/selection.ml
@@ -26,7 +26,7 @@ inherit Selectgen.selector_generic as super
 
 method is_immediate n = (n <= 4095) && (n >= -4096)
 
-method select_addressing = function
+method select_addressing chunk = function
     Cconst_symbol s ->
       (Ibased(s, 0), Ctuple [])
   | Cop(Cadda, [Cconst_symbol s; Cconst_int n]) ->
diff --git a/asmrun/arm.S b/asmrun/arm.S
index 1313e9c..6482956 100644
--- a/asmrun/arm.S
+++ b/asmrun/arm.S
@@ -1,286 +1,411 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
-/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                  Benedikt Meurer, University of Siegen              */
 /*                                                                     */
-/*  Copyright 1998 Institut National de Recherche en Informatique et   */
-/*  en Automatique.  All rights reserved.  This file is distributed    */
-/*  under the terms of the GNU Library General Public License, with    */
-/*  the special exception on linking described in file ../LICENSE.     */
+/*    Copyright 1998 Institut National de Recherche en Informatique    */
+/*    et en Automatique. Copyright 2012 Benedikt Meurer. All rights    */
+/*    reserved. This file is distributed under the terms of the GNU    */
+/*    Library General Public License, with the special exception on    */
+/*    linking described in file ../LICENSE.                            */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: arm.S 9252 2009-05-04 13:46:46Z xleroy $ */
+/* $Id$ */
 
 /* Asm part of the runtime system, ARM processor */
+/* Must be preprocessed by cpp */
 
-trap_ptr        .req    r11
-alloc_ptr       .req    r8
-alloc_limit     .req    r10
-
+        .syntax unified
         .text
+#if defined(SYS_linux_eabihf)
+        .arch   armv7-a
+        .fpu    vfpv3-d16
+        .thumb
+#elif defined(SYS_linux_eabi)
+        .arch   armv4t
+        .arm
+
+    /* Compatibility macros */
+        .macro  blx reg
+        mov     lr, pc
+        bx      \reg
+        .endm
+        .macro  cbz reg, lbl
+        cmp     \reg, #0
+        beq     \lbl
+        .endm
+        .macro  vpop regs
+        .endm
+        .macro  vpush regs
+        .endm
+#endif
+
+trap_ptr        .req    r8
+alloc_ptr       .req    r10
+alloc_limit     .req    r11
+
+/* Support for profiling with gprof */
+
+#if defined(PROFILING) && (defined(SYS_linux_eabihf) || defined(SYS_linux_eabi))
+#define PROFILE \
+        push    {lr}; \
+        bl      __gnu_mcount_nc
+#else
+#define PROFILE
+#endif
 
 /* Allocation functions and GC interface */
 
-        .globl caml_call_gc
+        .globl  caml_system__code_begin
+caml_system__code_begin:
+        
+        .align  2
+        .globl  caml_call_gc
         .type caml_call_gc, %function
 caml_call_gc:
-    /* Record return address and desired size */
-    /* Can use alloc_limit as a temporary since it will be reloaded by
-       invoke_gc */
-        ldr     alloc_limit, .Lcaml_last_return_address
-        str     lr, [alloc_limit, #0]
-        ldr     alloc_limit, .Lcaml_requested_size
-        str     r12, [alloc_limit, #0]
-    /* Branch to shared GC code */
-        bl      .Linvoke_gc
-    /* Finish allocation */
-	ldr	r12, .Lcaml_requested_size
-	ldr	r12, [r12, #0]
-	sub	alloc_ptr, alloc_ptr, r12
+        PROFILE
+    /* Record return address */
+        ldr     r12, =caml_last_return_address
+        str     lr, [r12]
+.Lcaml_call_gc:
+    /* Record lowest stack address */
+        ldr     r12, =caml_bottom_of_stack
+        str     sp, [r12]
+    /* Save caller floating-point registers on the stack */
+        vpush   {d0-d7}
+    /* Save integer registers and return address on the stack */
+        push    {r0-r7,r12,lr}
+    /* Store pointer to saved integer registers in caml_gc_regs */
+        ldr     r12, =caml_gc_regs
+        str     sp, [r12]
+    /* Save current allocation pointer for debugging purposes */
+        ldr     alloc_limit, =caml_young_ptr
+        str     alloc_ptr, [alloc_limit]
+    /* Save trap pointer in case an exception is raised during GC */
+        ldr     r12, =caml_exception_pointer
+        str     trap_ptr, [r12]
+    /* Call the garbage collector */
+        bl      caml_garbage_collection
+    /* Restore integer registers and return address from the stack */
+        pop     {r0-r7,r12,lr}
+    /* Restore floating-point registers from the stack */
+        vpop    {d0-d7}
+    /* Reload new allocation pointer and limit */
+    /* alloc_limit still points to caml_young_ptr */
+        ldr     r12, =caml_young_limit
+        ldr     alloc_ptr, [alloc_limit]
+        ldr     alloc_limit, [r12]
+    /* Return to caller */
         bx      lr
+        .type   caml_call_gc, %function
+        .size   caml_call_gc, .-caml_call_gc
 
-        .globl caml_alloc1
+        .align  2
+        .globl  caml_alloc1
         .type caml_alloc1, %function
 caml_alloc1:
-        sub     alloc_ptr, alloc_ptr, #8
+        PROFILE
+.Lcaml_alloc1:
+        sub     alloc_ptr, alloc_ptr, 8
         cmp     alloc_ptr, alloc_limit
-        movcs   pc, lr                /* Return if alloc_ptr >= alloc_limit */
-    /* Record return address */
-        ldr     r12, .Lcaml_last_return_address
-        str     lr, [r12, #0]
-    /* Invoke GC */
-        bl      .Linvoke_gc
+        bcc     1f
+        bx      lr
+1:  /* Record return address */
+        ldr     r7, =caml_last_return_address
+        str     lr, [r7]
+    /* Call GC (preserves r7) */
+        bl      .Lcaml_call_gc
+    /* Restore return address */
+        ldr     lr, [r7]
     /* Try again */
-        b       caml_alloc1
+        b       .Lcaml_alloc1
+        .type   caml_alloc1, %function
+        .size   caml_alloc1, .-caml_alloc1
 
-        .globl caml_alloc2
+        .align  2
+        .globl  caml_alloc2
         .type caml_alloc2, %function
 caml_alloc2:
-        sub     alloc_ptr, alloc_ptr, #12
+        PROFILE
+.Lcaml_alloc2:
+        sub     alloc_ptr, alloc_ptr, 12
         cmp     alloc_ptr, alloc_limit
-        movcs   pc, lr                /* Return if alloc_ptr >= alloc_limit */
-    /* Record return address */
-        ldr     r12, .Lcaml_last_return_address
-        str     lr, [r12, #0]
-    /* Invoke GC */
-        bl      .Linvoke_gc
+        bcc     1f
+        bx      lr
+1:  /* Record return address */
+        ldr     r7, =caml_last_return_address
+        str     lr, [r7]
+    /* Call GC (preserves r7) */
+        bl      .Lcaml_call_gc
+    /* Restore return address */
+        ldr     lr, [r7]
     /* Try again */
-        b       caml_alloc2
+        b       .Lcaml_alloc2
+        .type   caml_alloc2, %function
+        .size   caml_alloc2, .-caml_alloc2
 
-        .globl caml_alloc3
+        .align  2
+        .globl  caml_alloc3
         .type caml_alloc3, %function
 caml_alloc3:
-        sub     alloc_ptr, alloc_ptr, #16
+        PROFILE
+.Lcaml_alloc3:
+        sub     alloc_ptr, alloc_ptr, 16
         cmp     alloc_ptr, alloc_limit
-        movcs   pc, lr                /* Return if alloc_ptr >= alloc_limit */
-    /* Record return address */
-        ldr     r12, .Lcaml_last_return_address
-        str     lr, [r12, #0]
-    /* Invoke GC */
-        bl      .Linvoke_gc
+        bcc     1f
+        bx      lr
+1:  /* Record return address */
+        ldr     r7, =caml_last_return_address
+        str     lr, [r7]
+    /* Call GC (preserves r7) */
+        bl      .Lcaml_call_gc
+    /* Restore return address */
+        ldr     lr, [r7]
     /* Try again */
-        b       caml_alloc3
+        b       .Lcaml_alloc3
+        .type   caml_alloc3, %function
+        .size   caml_alloc3, .-caml_alloc3
 
-        .globl caml_allocN
+        .align  2
+        .globl  caml_allocN
         .type caml_allocN, %function
 caml_allocN:
-        sub     alloc_ptr, alloc_ptr, r12
+        PROFILE
+.Lcaml_allocN:
+        sub     alloc_ptr, alloc_ptr, r7
         cmp     alloc_ptr, alloc_limit
-        movcs   pc, lr                /* Return if alloc_ptr >= alloc_limit */
-    /* Record return address and desired size */
-    /* Can use alloc_limit as a temporary since it will be reloaded by
-       invoke_gc */
-        ldr     alloc_limit, .Lcaml_last_return_address
-        str     lr, [alloc_limit, #0]
-        ldr     alloc_limit, .Lcaml_requested_size
-        str     r12, [alloc_limit, #0]
-    /* Invoke GC */
-        bl      .Linvoke_gc
+        bcc     1f
+        bx      lr
+1:  /* Record return address */
+        ldr     r12, =caml_last_return_address
+        str     lr, [r12]
+    /* Call GC (preserves r7) */
+        bl      .Lcaml_call_gc
+    /* Restore return address */
+        ldr     r12, =caml_last_return_address
+        ldr     lr, [r12]
     /* Try again */
-	ldr	r12, .Lcaml_requested_size
-	ldr	r12, [r12, #0]
-        b       caml_allocN
-
-/* Shared code to invoke the GC */
-.Linvoke_gc:
-    /* Record lowest stack address */
-        ldr     r12, .Lcaml_bottom_of_stack
-        str     sp, [r12, #0]
-    /* Save integer registers and return address on stack */
-        stmfd   sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r12,lr}
-    /* Store pointer to saved integer registers in caml_gc_regs */
-        ldr     r12, .Lcaml_gc_regs
-        str     sp, [r12, #0]
-    /* Save current allocation pointer for debugging purposes */
-        ldr     r12, .Lcaml_young_ptr
-        str     alloc_ptr, [r12, #0]
-    /* Save trap pointer in case an exception is raised during GC */
-        ldr     r12, .Lcaml_exception_pointer
-        str     trap_ptr, [r12, #0]
-    /* Call the garbage collector */
-        bl      caml_garbage_collection
-    /* Restore the registers from the stack */
-        ldmfd   sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r12}
-    /* Reload return address */
-        ldr     r12, .Lcaml_last_return_address
-        ldr     lr, [r12, #0]
-    /* Reload new allocation pointer and allocation limit */
-        ldr     r12, .Lcaml_young_ptr
-        ldr     alloc_ptr, [r12, #0]
-        ldr     r12, .Lcaml_young_limit
-        ldr     alloc_limit, [r12, #0]
-    /* Return to caller */
-        ldr     r12, [sp], #4
-        bx      r12
+        b       .Lcaml_allocN
+        .type   caml_allocN, %function
+        .size   caml_allocN, .-caml_allocN
 
-/* Call a C function from Caml */
-/* Function to call is in r12 */
+/* Call a C function from OCaml */
+/* Function to call is in r7 */
 
-        .globl caml_c_call
+        .align  2
+        .globl  caml_c_call
         .type caml_c_call, %function
 caml_c_call:
+        PROFILE
+    /* Record lowest stack address and return address */
+        ldr     r5, =caml_last_return_address
+        ldr     r6, =caml_bottom_of_stack
+        str     lr, [r5]
+        str     sp, [r6]
     /* Preserve return address in callee-save register r4 */
         mov     r4, lr
-    /* Record lowest stack address and return address */
-        ldr     r5, .Lcaml_last_return_address
-        ldr     r6, .Lcaml_bottom_of_stack
-        str     lr, [r5, #0]
-        str     sp, [r6, #0]
-    /* Make the exception handler and alloc ptr available to the C code */
-        ldr     r6, .Lcaml_young_ptr
-        ldr     r7, .Lcaml_exception_pointer
-        str     alloc_ptr, [r6, #0]
-        str     trap_ptr, [r7, #0]
+    /* Make the exception handler alloc ptr available to the C code */
+        ldr     r5, =caml_young_ptr
+        ldr     r6, =caml_exception_pointer
+        str     alloc_ptr, [r5]
+        str     trap_ptr, [r6]
     /* Call the function */
-        mov     lr, pc
-        bx      r12
+        blx     r7
     /* Reload alloc ptr and alloc limit */
-        ldr     r5, .Lcaml_young_limit
-        ldr     alloc_ptr, [r6, #0]    /* r6 still points to caml_young_ptr */
-        ldr     alloc_limit, [r5, #0]
+        ldr     r6, =caml_young_limit
+        ldr     alloc_ptr, [r5]         /* r5 still points to caml_young_ptr */
+        ldr     alloc_limit, [r6]
     /* Return */
         bx      r4
+        .type   caml_c_call, %function
+        .size   caml_c_call, .-caml_c_call
 
-/* Start the Caml program */
+/* Start the OCaml program */
 
-        .globl caml_start_program
+        .align  2
+        .globl  caml_start_program
         .type caml_start_program, %function
 caml_start_program:
-        ldr     r12, .Lcaml_program
+        PROFILE
+        ldr     r12, =caml_program
 
 /* Code shared with caml_callback* */
-/* Address of Caml code to call is in r12 */
-/* Arguments to the Caml code are in r0...r3 */
+/* Address of OCaml code to call is in r12 */
+/* Arguments to the OCaml code are in r0...r3 */
 
 .Ljump_to_caml:
     /* Save return address and callee-save registers */
-        stmfd   sp!, {r4,r5,r6,r7,r8,r10,r11,lr} /* 8-alignment */
+        vpush   {d8-d15}
+        push    {r4-r8,r10,r11,lr}              /* 8-byte alignment */
     /* Setup a callback link on the stack */
-        sub     sp, sp, #4*4                    /* 8-alignment */
-        ldr     r4, .Lcaml_bottom_of_stack
-        ldr     r4, [r4, #0]
-        str     r4, [sp, #0]
-        ldr     r4, .Lcaml_last_return_address
-        ldr     r4, [r4, #0]
-        str     r4, [sp, #4]
-        ldr     r4, .Lcaml_gc_regs
-        ldr     r4, [r4, #0]
-        str     r4, [sp, #8]
-    /* Setup a trap frame to catch exceptions escaping the Caml code */
-        sub     sp, sp, #4*2
-        ldr     r4, .Lcaml_exception_pointer
-        ldr     r4, [r4, #0]
-        str     r4, [sp, #0]
-        ldr     r4, .LLtrap_handler
-        str     r4, [sp, #4]
+        sub     sp, sp, 4*4                     /* 8-byte alignment */
+        ldr     r4, =caml_bottom_of_stack
+        ldr     r5, =caml_last_return_address
+        ldr     r6, =caml_gc_regs
+        ldr     r4, [r4]
+        ldr     r5, [r5]
+        ldr     r6, [r6]
+        str     r4, [sp, 0]
+        str     r5, [sp, 4]
+        str     r6, [sp, 8]
+    /* Setup a trap frame to catch exceptions escaping the OCaml code */
+        sub     sp, sp, 2*4
+        ldr     r6, =caml_exception_pointer
+        ldr     r5, =.Ltrap_handler
+        ldr     r4, [r6]
+        str     r4, [sp, 0]
+        str     r5, [sp, 4]
         mov     trap_ptr, sp
     /* Reload allocation pointers */
-        ldr     r4, .Lcaml_young_ptr
-        ldr     alloc_ptr, [r4, #0]
-        ldr     r4, .Lcaml_young_limit
-        ldr     alloc_limit, [r4, #0]
-    /* Call the Caml code */
-        mov     lr, pc
-        bx      r12
+        ldr     r4, =caml_young_ptr
+        ldr     alloc_ptr, [r4]
+        ldr     r4, =caml_young_limit
+        ldr     alloc_limit, [r4]
+    /* Call the OCaml code */
+        blx     r12
 .Lcaml_retaddr:
     /* Pop the trap frame, restoring caml_exception_pointer */
-        ldr     r4, .Lcaml_exception_pointer
-        ldr     r5, [sp, #0]
-        str     r5, [r4, #0]
-        add     sp, sp, #2 * 4
+        ldr     r4, =caml_exception_pointer
+        ldr     r5, [sp, 0]
+        str     r5, [r4]
+        add     sp, sp, 2*4
     /* Pop the callback link, restoring the global variables */
 .Lreturn_result:
-        ldr     r4, .Lcaml_bottom_of_stack
-        ldr     r5, [sp, #0]
-        str     r5, [r4, #0]
-        ldr     r4, .Lcaml_last_return_address
-        ldr     r5, [sp, #4]
-        str     r5, [r4, #0]
-        ldr     r4, .Lcaml_gc_regs
-        ldr     r5, [sp, #8]
-        str     r5, [r4, #0]
-        add     sp, sp, #4*4
+        ldr     r4, =caml_bottom_of_stack
+        ldr     r5, [sp, 0]
+        str     r5, [r4]
+        ldr     r4, =caml_last_return_address
+        ldr     r5, [sp, 4]
+        str     r5, [r4]
+        ldr     r4, =caml_gc_regs
+        ldr     r5, [sp, 8]
+        str     r5, [r4]
+        add     sp, sp, 4*4
     /* Update allocation pointer */
-        ldr     r4, .Lcaml_young_ptr
-        str     alloc_ptr, [r4, #0]
+        ldr     r4, =caml_young_ptr
+        str     alloc_ptr, [r4]
     /* Reload callee-save registers and return */
-        ldmfd   sp!, {r4,r5,r6,r7,r8,r10,r11,lr}
-	bx	lr
+        pop     {r4-r8,r10,r11,lr}
+        vpop    {d8-d15}
+        bx      lr
+        .type   .Lcaml_retaddr, %function
+        .size   .Lcaml_retaddr, .-.Lcaml_retaddr
+        .type   caml_start_program, %function
+        .size   caml_start_program, .-caml_start_program
+
+/* The trap handler */
 
-    /* The trap handler */
+        .align  2
 .Ltrap_handler:
     /* Save exception pointer */
-        ldr     r4, .Lcaml_exception_pointer
-        str     trap_ptr, [r4, #0]
+        ldr     r12, =caml_exception_pointer
+        str     trap_ptr, [r12]
     /* Encode exception bucket as an exception result */
-        orr     r0, r0, #2
+        orr     r0, r0, 2
     /* Return it */
         b       .Lreturn_result
+        .type   .Ltrap_handler, %function
+        .size   .Ltrap_handler, .-.Ltrap_handler
+
+/* Raise an exception from OCaml */
+
+        .align  2
+        .globl  caml_raise_exn
+caml_raise_exn:
+        PROFILE
+    /* Test if backtrace is active */
+        ldr     r1, =caml_backtrace_active
+        ldr     r1, [r1]
+        cbz     r1, 1f
+    /* Preserve exception bucket in callee-save register r4 */
+        mov     r4, r0
+    /* Stash the backtrace */
+        mov     r1, lr                          /* arg2: pc of raise */
+        mov     r2, sp                          /* arg3: sp of raise */
+        mov     r3, trap_ptr                    /* arg4: sp of handler */
+        bl      caml_stash_backtrace
+    /* Restore exception bucket */
+        mov     r0, r4
+1:  /* Cut stack at current trap handler */
+        mov     sp, trap_ptr
+    /* Pop previous handler and addr of trap, and jump to it */
+        pop     {trap_ptr, pc}
+        .type   caml_raise_exn, %function
+        .size   caml_raise_exn, .-caml_raise_exn
 
 /* Raise an exception from C */
 
-        .globl caml_raise_exception
+        .align  2
+        .globl  caml_raise_exception
         .type caml_raise_exception, %function
 caml_raise_exception:
-    /* Reload Caml allocation pointers */
-        ldr     r12, .Lcaml_young_ptr
-        ldr     alloc_ptr, [r12, #0]
-        ldr     r12, .Lcaml_young_limit
-        ldr     alloc_limit, [r12, #0]
-    /* Cut stack at current trap handler */
-        ldr     r12, .Lcaml_exception_pointer
-        ldr     sp, [r12, #0]
+        PROFILE
+    /* Reload trap ptr, alloc ptr and alloc limit */
+        ldr     trap_ptr, =caml_exception_pointer
+        ldr     alloc_ptr, =caml_young_ptr
+        ldr     alloc_limit, =caml_young_limit
+        ldr     trap_ptr, [trap_ptr]
+        ldr     alloc_ptr, [alloc_ptr]
+        ldr     alloc_limit, [alloc_limit]
+    /* Test if backtrace is active */
+        ldr     r1, =caml_backtrace_active
+        ldr     r1, [r1]
+        cbz     r1, 1f
+    /* Preserve exception bucket in callee-save register r4 */
+        mov     r4, r0
+        ldr     r1, =caml_last_return_address   /* arg2: pc of raise */
+        ldr     r1, [r1]
+        ldr     r2, =caml_bottom_of_stack       /* arg3: sp of raise */
+        ldr     r2, [r2]
+        mov     r3, trap_ptr                    /* arg4: sp of handler */
+        bl      caml_stash_backtrace
+    /* Restore exception bucket */
+        mov     r0, r4
+1:  /* Cut stack at current trap handler */
+        mov     sp, trap_ptr
     /* Pop previous handler and addr of trap, and jump to it */
-        ldmfd   sp!, {trap_ptr, pc}
+        pop     {trap_ptr, pc}
+        .type   caml_raise_exception, %function
+        .size   caml_raise_exception, .-caml_raise_exception
 
-/* Callback from C to Caml */
+/* Callback from C to OCaml */
 
-        .globl caml_callback_exn
+        .align  2
+        .globl  caml_callback_exn
         .type caml_callback_exn, %function
 caml_callback_exn:
+        PROFILE
     /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */
         mov     r12, r0
-        mov     r0, r1            /* r0 = first arg */
-        mov     r1, r12           /* r1 = closure environment */
-        ldr     r12, [r12, #0]    /* code pointer */
+        mov     r0, r1          /* r0 = first arg */
+        mov     r1, r12         /* r1 = closure environment */
+        ldr     r12, [r12]      /* code pointer */
         b       .Ljump_to_caml
+        .type   caml_callback_exn, %function
+        .size   caml_callback_exn, .-caml_callback_exn
 
-        .globl caml_callback2_exn
+        .align  2
+        .globl  caml_callback2_exn
         .type caml_callback2_exn, %function
 caml_callback2_exn:
+        PROFILE
     /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */
         mov     r12, r0
-        mov     r0, r1           /* r0 = first arg */
-        mov     r1, r2           /* r1 = second arg */
-        mov     r2, r12          /* r2 = closure environment */
-        ldr     r12, .Lcaml_apply2
+        mov     r0, r1          /* r0 = first arg */
+        mov     r1, r2          /* r1 = second arg */
+        mov     r2, r12         /* r2 = closure environment */
+        ldr     r12, =caml_apply2
         b       .Ljump_to_caml
+        .type   caml_callback2_exn, %function
+        .size   caml_callback2_exn, .-caml_callback2_exn
 
-        .globl caml_callback3_exn
+        .align  2
+        .globl  caml_callback3_exn
         .type caml_callback3_exn, %function
 caml_callback3_exn:
+        PROFILE
     /* Initial shuffling of arguments */
     /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */
         mov     r12, r0
@@ -288,43 +413,36 @@ caml_callback3_exn:
         mov     r1, r2          /* r1 = second arg */
         mov     r2, r3          /* r2 = third arg */
         mov     r3, r12         /* r3 = closure environment */
-        ldr     r12, .Lcaml_apply3
+        ldr     r12, =caml_apply3
         b       .Ljump_to_caml
+        .type   caml_callback3_exn, %function
+        .size   caml_callback3_exn, .-caml_callback3_exn
 
-        .globl caml_ml_array_bound_error
+        .align  2
+        .globl  caml_ml_array_bound_error
         .type caml_ml_array_bound_error, %function
 caml_ml_array_bound_error:
-    /* Load address of [caml_array_bound_error] in r12 */
-        ldr     r12, .Lcaml_array_bound_error
+        PROFILE
+    /* Load address of [caml_array_bound_error] in r7 */
+        ldr     r7, =caml_array_bound_error
     /* Call that function */
         b       caml_c_call
+        .type   caml_ml_array_bound_error, %function
+        .size   caml_ml_array_bound_error, .-caml_ml_array_bound_error
 
-/* Global references */
-
-.Lcaml_last_return_address:     .word caml_last_return_address
-.Lcaml_bottom_of_stack:         .word caml_bottom_of_stack
-.Lcaml_gc_regs:                 .word caml_gc_regs
-.Lcaml_young_ptr:               .word caml_young_ptr
-.Lcaml_young_limit:             .word caml_young_limit
-.Lcaml_exception_pointer:       .word caml_exception_pointer
-.Lcaml_program:                 .word caml_program
-.LLtrap_handler:                .word .Ltrap_handler
-.Lcaml_apply2:                  .word caml_apply2
-.Lcaml_apply3:                  .word caml_apply3
-.Lcaml_array_bound_error:       .word caml_array_bound_error
-.Lcaml_requested_size:          .word caml_requested_size
-
-	.data
-caml_requested_size:
-	.word	0
+        .globl  caml_system__code_end
+caml_system__code_end:
 
 /* GC roots for callback */
 
         .data
-        .globl caml_system__frametable
+        .align  2
+        .globl  caml_system__frametable
 caml_system__frametable:
         .word   1               /* one descriptor */
         .word   .Lcaml_retaddr  /* return address into callback */
         .short  -1              /* negative frame size => use callback link */
         .short  0               /* no roots */
         .align  2
+        .type   caml_system__frametable, %object
+        .size   caml_system__frametable, .-caml_system__frametable
diff --git a/asmrun/signals_osdep.h b/asmrun/signals_osdep.h
index 1e91327..732f3a0 100644
--- a/asmrun/signals_osdep.h
+++ b/asmrun/signals_osdep.h
@@ -78,7 +78,7 @@
 
 /****************** ARM, Linux */
 
-#elif defined(TARGET_arm) && defined (SYS_linux)
+#elif defined(TARGET_arm) && (defined (SYS_linux_eabi) || defined(SYS_linux_eabihf))
 
   #include <sys/ucontext.h>
 
diff --git a/configure b/configure
index 6ed0a9c..4e07c92 100755
--- a/configure
+++ b/configure
@@ -636,6 +636,7 @@ if test $withsharedlibs = "yes"; then
     i[345]86-*-netbsd*)           natdynlink=true;;
     x86_64-*-netbsd*)             natdynlink=true;;
     i386-*-gnu0.3)                natdynlink=true;;
+    arm*-*-linux*)                natdynlink=true;;
   esac
 fi
 
@@ -691,8 +692,13 @@ case "$host" in
   powerpc-*-rhapsody*)          arch=power; model=ppc; system=rhapsody;;
   powerpc-*-darwin*)            arch=power; system=rhapsody
                                 if $arch64; then model=ppc64; else model=ppc; fi;;
-  arm*-*-linux*)                arch=arm; system=linux;;
-  arm*-*-gnu*)                  arch=arm; system=gnu;;
+  arm*-*-linux-gnueabihf)       arch=arm; system=linux_eabihf;;
+  armv7*-*-linux-gnueabi)       arch=arm; model=armv7; system=linux_eabi;;
+  armv6t2*-*-linux-gnueabi)     arch=arm; model=armv6t2; system=linux_eabi;;
+  armv6*-*-linux-gnueabi)       arch=arm; model=armv6; system=linux_eabi;;
+  armv5te*-*-linux-gnueabi)     arch=arm; model=armv5te; system=linux_eabi;;
+  armv5*-*-linux-gnueabi)       arch=arm; model=armv5; system=linux_eabi;;
+  arm*-*-linux-gnueabi)         arch=arm; system=linux_eabi;;
   ia64-*-linux*)                arch=ia64; system=linux;;
   ia64-*-gnu*)                  arch=ia64; system=gnu;;
   ia64-*-freebsd*)              arch=ia64; system=freebsd;;
@@ -804,6 +810,7 @@ case "$arch,$model,$system" in
     case "$nativecc" in gcc*) ;; *) cc_profile='-xpg';; esac;;
   amd64,*,linux) profiling='prof';;
   amd64,*,gnu) profiling='prof';;
+  arm,*,linux*) profiling='prof';;
   *) profiling='noprof';;
 esac
 
-- 
1.7.10.1