[ocaml] Add aarch64 (arm64) code generator.
Richard W.M. Jones
rjones at fedoraproject.org
Mon Dec 30 22:40:05 UTC 2013
commit efb2ca148b9b670ebbbdfbf0b34dddda61499af4
Author: Richard W.M. Jones <rjones at redhat.com>
Date: Mon Dec 30 20:40:09 2013 +0000
Add aarch64 (arm64) code generator.
....gitignore-file-to-ignore-generated-files.patch | 4 +-
...y-compilerlibs-directory-is-created-by-gi.patch | 4 +-
...fo-ocamlplugininfo-Useful-utilities-from-.patch | 4 +-
0004-Don-t-add-rpaths-to-libraries.patch | 4 +-
...igure-Allow-user-defined-C-compiler-flags.patch | 4 +-
0006-Add-support-for-ppc64.patch | 4 +-
0007-yacc-Use-mkstemp-instead-of-mktemp.patch | 4 +-
...Allow-flags-such-as-flag-arg-as-well-as-f.patch | 6 +-
...-ARM-64-bits-AArch64-architecture-experim.patch | 2280 ++++++++++++++++++++
0010-Updated-with-latest-versions-from-FSF.patch | 716 ++++++
...sable-ocamldoc-and-camlp4opt-aarch64-only.patch | 38 +
ocaml.spec | 22 +-
12 files changed, 3070 insertions(+), 20 deletions(-)
---
diff --git a/0001-Add-.gitignore-file-to-ignore-generated-files.patch b/0001-Add-.gitignore-file-to-ignore-generated-files.patch
index f94d614..fec77ec 100644
--- a/0001-Add-.gitignore-file-to-ignore-generated-files.patch
+++ b/0001-Add-.gitignore-file-to-ignore-generated-files.patch
@@ -1,7 +1,7 @@
From 07839dfc746ccee318601b9668aa094d4465bc6e Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Thu, 7 Jun 2012 16:00:28 +0100
-Subject: [PATCH 1/7] Add .gitignore file to ignore generated files.
+Subject: [PATCH 01/11] Add .gitignore file to ignore generated files.
---
.gitignore | 347 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -362,5 +362,5 @@ index 0000000..7191b83
+/yacc/ocamlyacc
+/yacc/version.h
--
-1.8.3.1
+1.8.4.2
diff --git a/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch b/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch
index 3166287..21fa682 100644
--- a/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch
+++ b/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch
@@ -1,7 +1,7 @@
From 7756582741dc56070c03629a3b4640147723beda Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Thu, 7 Jun 2012 15:36:16 +0100
-Subject: [PATCH 2/7] Ensure empty compilerlibs/ directory is created by git.
+Subject: [PATCH 02/11] Ensure empty compilerlibs/ directory is created by git.
This directory exists in the OCaml tarball, but is empty. As a
result, git ignores it unless we put a dummy file in it.
@@ -14,5 +14,5 @@ diff --git a/compilerlibs/.exists b/compilerlibs/.exists
new file mode 100644
index 0000000..e69de29
--
-1.8.3.1
+1.8.4.2
diff --git a/0003-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch b/0003-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
index 241f363..6f7cd51 100644
--- a/0003-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
+++ b/0003-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
@@ -1,7 +1,7 @@
From a6d87cd4bc62d3987835c1ac844f35cc06804294 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Tue, 29 May 2012 20:40:36 +0100
-Subject: [PATCH 3/7] ocamlbyteinfo, ocamlplugininfo: Useful utilities from
+Subject: [PATCH 03/11] ocamlbyteinfo, ocamlplugininfo: Useful utilities from
Debian, sent upstream.
See:
@@ -236,5 +236,5 @@ index 0000000..e28800f
+ header.units
+ end
--
-1.8.3.1
+1.8.4.2
diff --git a/0004-Don-t-add-rpaths-to-libraries.patch b/0004-Don-t-add-rpaths-to-libraries.patch
index 650caf4..1a140ba 100644
--- a/0004-Don-t-add-rpaths-to-libraries.patch
+++ b/0004-Don-t-add-rpaths-to-libraries.patch
@@ -1,7 +1,7 @@
From c3a733c10827896a6e3c217b383e874df303d50b Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Tue, 29 May 2012 20:43:34 +0100
-Subject: [PATCH 4/7] Don't add rpaths to libraries.
+Subject: [PATCH 04/11] Don't add rpaths to libraries.
---
tools/Makefile.shared | 3 ---
@@ -22,5 +22,5 @@ index 117f576..cad227d 100644
ocamlmklib.mlp >> ocamlmklib.ml
--
-1.8.3.1
+1.8.4.2
diff --git a/0005-configure-Allow-user-defined-C-compiler-flags.patch b/0005-configure-Allow-user-defined-C-compiler-flags.patch
index 69d80b4..0ae0163 100644
--- a/0005-configure-Allow-user-defined-C-compiler-flags.patch
+++ b/0005-configure-Allow-user-defined-C-compiler-flags.patch
@@ -1,7 +1,7 @@
From 459e9550f174e11176a2ece013fc4dd2b08a06bb Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Tue, 29 May 2012 20:44:18 +0100
-Subject: [PATCH 5/7] configure: Allow user defined C compiler flags.
+Subject: [PATCH 05/11] configure: Allow user defined C compiler flags.
---
configure | 4 ++++
@@ -23,5 +23,5 @@ index 07b1c35..39b38dc 100755
cclibs="$cclibs $mathlib"
--
-1.8.3.1
+1.8.4.2
diff --git a/0006-Add-support-for-ppc64.patch b/0006-Add-support-for-ppc64.patch
index a979555..895d0da 100644
--- a/0006-Add-support-for-ppc64.patch
+++ b/0006-Add-support-for-ppc64.patch
@@ -1,7 +1,7 @@
From a85437a0d2ffdf7a340d379789500eb583ae4708 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Tue, 29 May 2012 20:47:07 +0100
-Subject: [PATCH 6/7] Add support for ppc64.
+Subject: [PATCH 06/11] Add support for ppc64.
Note (1): This patch was rejected upstream because they don't have
appropriate hardware for testing.
@@ -2126,5 +2126,5 @@ index 39b38dc..9b02664 100755
aspp="$bytecc -c";;
sparc,*,solaris) as='as'
--
-1.8.3.1
+1.8.4.2
diff --git a/0007-yacc-Use-mkstemp-instead-of-mktemp.patch b/0007-yacc-Use-mkstemp-instead-of-mktemp.patch
index 7085935..6055445 100644
--- a/0007-yacc-Use-mkstemp-instead-of-mktemp.patch
+++ b/0007-yacc-Use-mkstemp-instead-of-mktemp.patch
@@ -1,7 +1,7 @@
From 761242718c3a7513d3b93ca96d24d1f61a4126f0 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Fri, 13 Sep 2013 21:29:58 +0100
-Subject: [PATCH 7/7] yacc: Use mkstemp instead of mktemp.
+Subject: [PATCH 07/11] yacc: Use mkstemp instead of mktemp.
---
yacc/main.c | 2 +-
@@ -21,5 +21,5 @@ index f6cac60..3067000 100644
#endif
--
-1.8.3.1
+1.8.4.2
diff --git a/0001-stdlib-arg-Allow-flags-such-as-flag-arg-as-well-as-f.patch b/0008-stdlib-arg-Allow-flags-such-as-flag-arg-as-well-as-f.patch
similarity index 98%
rename from 0001-stdlib-arg-Allow-flags-such-as-flag-arg-as-well-as-f.patch
rename to 0008-stdlib-arg-Allow-flags-such-as-flag-arg-as-well-as-f.patch
index 2c4d053..3373cfc 100644
--- a/0001-stdlib-arg-Allow-flags-such-as-flag-arg-as-well-as-f.patch
+++ b/0008-stdlib-arg-Allow-flags-such-as-flag-arg-as-well-as-f.patch
@@ -1,8 +1,8 @@
From 33962967111fbed55e93260b12cd65e372a0958a Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Sat, 9 Nov 2013 09:11:30 +0000
-Subject: [PATCH] stdlib: arg: Allow flags such as --flag=arg as well as --flag
- arg.
+Subject: [PATCH 08/11] stdlib: arg: Allow flags such as --flag=arg as well as
+ --flag arg.
Fix for the following issue:
http://caml.inria.fr/mantis/view.php?id=5197
@@ -161,5 +161,5 @@ index 869d030..b8c6f11 100644
Examples ([cmd] is assumed to be the command name):
--
-1.8.3.1
+1.8.4.2
diff --git a/0009-Port-to-the-ARM-64-bits-AArch64-architecture-experim.patch b/0009-Port-to-the-ARM-64-bits-AArch64-architecture-experim.patch
new file mode 100644
index 0000000..e2d8ebb
--- /dev/null
+++ b/0009-Port-to-the-ARM-64-bits-AArch64-architecture-experim.patch
@@ -0,0 +1,2280 @@
+From 10d852d542f4ecdc5efc5afbae2d42167df4539c Mon Sep 17 00:00:00 2001
+From: Xavier Leroy <xavier.leroy at inria.fr>
+Date: Thu, 18 Jul 2013 16:09:20 +0000
+Subject: [PATCH 09/11] Port to the ARM 64-bits (AArch64) architecture
+ (experimental). Merge of branch branches/arm64.
+
+git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13909 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
+(cherry picked from commit 055d5c0379e42b4f561cb1fc5159659d8e9a7b6f)
+---
+ asmcomp/arm64/arch.ml | 146 ++++++++
+ asmcomp/arm64/emit.mlp | 742 +++++++++++++++++++++++++++++++++++++++
+ asmcomp/arm64/proc.ml | 212 +++++++++++
+ asmcomp/arm64/reload.ml | 16 +
+ asmcomp/arm64/scheduling.ml | 18 +
+ asmcomp/arm64/selection.ml | 265 ++++++++++++++
+ asmcomp/compilenv.ml | 9 +
+ asmcomp/compilenv.mli | 4 +
+ asmrun/arm64.S | 535 ++++++++++++++++++++++++++++
+ asmrun/signals_osdep.h | 19 +
+ asmrun/stack.h | 5 +
+ byterun/interp.c | 6 +
+ configure | 5 +-
+ otherlibs/num/bng.c | 6 +-
+ otherlibs/num/bng_arm64.c | 20 ++
+ testsuite/tests/asmcomp/Makefile | 2 +-
+ testsuite/tests/asmcomp/arm64.S | 52 +++
+ testsuite/tests/asmcomp/main.ml | 1 +
+ 18 files changed, 2057 insertions(+), 6 deletions(-)
+ create mode 100644 asmcomp/arm64/arch.ml
+ create mode 100644 asmcomp/arm64/emit.mlp
+ create mode 100644 asmcomp/arm64/proc.ml
+ create mode 100644 asmcomp/arm64/reload.ml
+ create mode 100644 asmcomp/arm64/scheduling.ml
+ create mode 100644 asmcomp/arm64/selection.ml
+ create mode 100644 asmrun/arm64.S
+ create mode 100644 otherlibs/num/bng_arm64.c
+ create mode 100644 testsuite/tests/asmcomp/arm64.S
+
+diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml
+new file mode 100644
+index 0000000..a53251f
+--- /dev/null
++++ b/asmcomp/arm64/arch.ml
+@@ -0,0 +1,146 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
++(* Benedikt Meurer, University of Siegen *)
++(* *)
++(* Copyright 2013 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. *)
++(* *)
++(***********************************************************************)
++
++let command_line_options = []
++
++(* Specific operations for the ARM processor, 64-bit mode *)
++
++open Format
++
++let command_line_options = []
++
++(* Addressing modes *)
++
++type addressing_mode =
++ | Iindexed of int (* reg + displ *)
++ | Ibased of string * int (* global var + displ *)
++
++(* We do not support the reg + shifted reg addressing mode, because
++ what we really need is reg + shifted reg + displ,
++ and this is decomposed in two instructions (reg + shifted reg -> tmp,
++ then addressing tmp + displ). *)
++
++(* Specific operations *)
++
++type specific_operation =
++ | Ishiftarith of arith_operation * int
++ | Ishiftcheckbound 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 *)
++ | Ibswap of int (* endianess conversion *)
++
++and arith_operation =
++ Ishiftadd
++ | Ishiftsub
++
++(* Sizes, endianness *)
++
++let big_endian = false
++
++let size_addr = 8
++let size_int = 8
++let size_float = 8
++
++let allow_unaligned_access = false
++
++(* Behavior of division *)
++
++let division_crashes_on_overflow = false
++
++(* Operations on addressing modes *)
++
++let identity_addressing = Iindexed 0
++
++let offset_addressing addr delta =
++ match addr with
++ | Iindexed n -> Iindexed(n + delta)
++ | Ibased(s, n) -> Ibased(s, n + delta)
++
++let num_args_addressing = function
++ | Iindexed n -> 1
++ | Ibased(s, n) -> 0
++
++(* Printing operations and addressing modes *)
++
++let print_addressing printreg addr ppf arg =
++ match addr with
++ | Iindexed n ->
++ printreg ppf arg.(0);
++ if n <> 0 then fprintf ppf " + %i" n
++ | Ibased(s, 0) ->
++ fprintf ppf "\"%s\"" s
++ | Ibased(s, n) ->
++ fprintf ppf "\"%s\" + %i" s n
++
++let print_specific_operation printreg op ppf arg =
++ match op with
++ | Ishiftarith(op, shift) ->
++ let op_name = function
++ | Ishiftadd -> "+"
++ | Ishiftsub -> "-" in
++ let shift_mark =
++ if shift >= 0
++ then sprintf "<< %i" shift
++ else sprintf ">> %i" (-shift) in
++ fprintf ppf "%a %s %a %s"
++ printreg arg.(0) (op_name op) printreg arg.(1) shift_mark
++ | Ishiftcheckbound n ->
++ fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1)
++ | 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 "(-f %a) -f (%a *f %a)"
++ printreg arg.(0)
++ printreg arg.(1)
++ printreg arg.(2)
++ | Imulsubf ->
++ fprintf ppf "%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)
++ | Ibswap n ->
++ fprintf ppf "bswap%i %a" n
++ printreg arg.(0)
++
+diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
+new file mode 100644
+index 0000000..fc9649c
+--- /dev/null
++++ b/asmcomp/arm64/emit.mlp
+@@ -0,0 +1,742 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
++(* Benedikt Meurer, University of Siegen *)
++(* *)
++(* Copyright 2013 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. *)
++(* *)
++(***********************************************************************)
++
++(* Emission of ARM assembly code, 64-bit mode *)
++
++open Misc
++open Cmm
++open Arch
++open Proc
++open Reg
++open Mach
++open Linearize
++open Emitaux
++
++(* Tradeoff between code size and code speed *)
++
++let fastcode_flag = ref true
++
++(* Names for special regs *)
++
++let reg_trap_ptr = phys_reg 23
++let reg_alloc_ptr = phys_reg 24
++let reg_alloc_limit = phys_reg 25
++let reg_tmp1 = phys_reg 26
++let reg_tmp2 = phys_reg 27
++let reg_x15 = phys_reg 15
++
++(* Output a label *)
++
++let emit_label lbl =
++ emit_string ".L"; emit_int lbl
++
++let emit_data_label lbl =
++ emit_string ".Ld"; emit_int lbl
++
++(* Symbols *)
++
++let emit_symbol s =
++ Emitaux.emit_symbol '$' s
++
++(* Output a pseudo-register *)
++
++let emit_reg = function
++ {loc = Reg r} -> emit_string (register_name r)
++ | _ -> fatal_error "Emit.emit_reg"
++
++(* Likewise, but with the 32-bit name of the register *)
++
++let int_reg_name_w =
++ [| "w0"; "w1"; "w2"; "w3"; "w4"; "w5"; "w6"; "w7";
++ "w8"; "w9"; "w10"; "w11"; "w12"; "w13"; "w14"; "w15";
++ "w19"; "w20"; "w21"; "w22"; "w23"; "w24"; "w25";
++ "w26"; "w27"; "w28"; "w16"; "w17" |]
++
++let emit_wreg = function
++ {loc = Reg r} -> emit_string int_reg_name_w.(r)
++ | _ -> fatal_error "Emit.emit_wreg"
++
++(* Layout of the stack frame *)
++
++let stack_offset = ref 0
++
++let frame_size () =
++ let sz =
++ !stack_offset +
++ 8 * num_stack_slots.(0) +
++ 8 * num_stack_slots.(1) +
++ (if !contains_calls then 8 else 0)
++ in Misc.align sz 16
++
++let slot_offset loc cl =
++ match loc with
++ Incoming n ->
++ assert (n >= 0);
++ frame_size() + n
++ | Local n ->
++ !stack_offset +
++ (if cl = 0
++ then n * 8
++ else num_stack_slots.(0) * 8 + n * 8)
++ | Outgoing n ->
++ assert (n >= 0);
++ n
++
++(* Output a stack reference *)
++
++let emit_stack r =
++ match r.loc with
++ | Stack s ->
++ let ofs = slot_offset s (register_class r) in `[sp, #{emit_int ofs}]`
++ | _ -> fatal_error "Emit.emit_stack"
++
++(* Output an addressing mode *)
++
++let emit_symbol_offset s ofs =
++ emit_symbol s;
++ if ofs > 0 then `+{emit_int ofs}`
++ else if ofs < 0 then `-{emit_int (-ofs)}`
++ else ()
++
++let emit_addressing addr r =
++ match addr with
++ | Iindexed ofs ->
++ `[{emit_reg r}, #{emit_int ofs}]`
++ | Ibased(s, ofs) ->
++ `[{emit_reg r}, #:lo12:{emit_symbol_offset s ofs}]`
++
++(* Record live pointers at call points *)
++
++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
++ | {typ = Addr; loc = Stack s} as reg ->
++ live_offset := slot_offset s (register_class reg) :: !live_offset
++ | _ -> ())
++ live;
++ frame_descriptors :=
++ { fd_lbl = lbl;
++ fd_frame_size = frame_size();
++ 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}: bl {emit_symbol "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}: bl {emit_symbol "caml_ml_array_bound_error"}\n`;
++ `{emit_label bd.bd_frame_lbl}:\n`
++
++(* Names of various instructions *)
++
++let name_for_comparison = function
++ | Isigned Ceq -> "eq" | Isigned Cne -> "ne" | Isigned Cle -> "le"
++ | Isigned Cge -> "ge" | Isigned Clt -> "lt" | Isigned Cgt -> "gt"
++ | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "ls"
++ | Iunsigned Cge -> "cs" | Iunsigned Clt -> "cc" | Iunsigned Cgt -> "hi"
++
++let name_for_int_operation = function
++ | Iadd -> "add"
++ | Isub -> "sub"
++ | Imul -> "mul"
++ | Idiv -> "sdiv"
++ | Iand -> "and"
++ | Ior -> "orr"
++ | Ixor -> "eor"
++ | Ilsl -> "lsl"
++ | Ilsr -> "lsr"
++ | Iasr -> "asr"
++ | _ -> assert false
++
++(* Load an integer constant into a register *)
++
++let emit_intconst dst n =
++ let rec emit_pos first shift =
++ if shift < 0 then begin
++ if first then ` mov {emit_reg dst}, xzr\n`
++ end else begin
++ let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
++ if s = 0n then emit_pos first (shift - 16) else begin
++ if first then
++ ` movz {emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`
++ else
++ ` movk {emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`;
++ emit_pos false (shift - 16)
++ end
++ end
++ and emit_neg first shift =
++ if shift < 0 then begin
++ if first then ` movn {emit_reg dst}, #0\n`
++ end else begin
++ let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
++ if s = 0xFFFFn then emit_neg first (shift - 16) else begin
++ if first then
++ ` movn {emit_reg dst}, #{emit_nativeint (Nativeint.logxor s 0xFFFFn)}, lsl #{emit_int shift}\n`
++ else
++ ` movk {emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`;
++ emit_neg false (shift - 16)
++ end
++ end
++ in
++ if n < 0n then emit_neg true 48 else emit_pos true 48
++
++(* Recognize float constants appropriate for FMOV dst, #fpimm instruction:
++ "a normalized binary floating point encoding with 1 sign bit, 4
++ bits of fraction and a 3-bit exponent" *)
++
++let is_immediate_float bits =
++ let exp = (Int64.(to_int (shift_right_logical bits 52)) land 0x7FF) - 1023 in
++ let mant = Int64.logand bits 0xF_FFFF_FFFF_FFFFL in
++ exp >= -3 && exp <= 4 && Int64.logand mant 0xF_0000_0000_0000L = mant
++
++(* Adjust sp (up or down) by the given byte amount *)
++
++let emit_stack_adjustment n =
++ let instr = if n < 0 then "sub" else "add" in
++ let m = abs n in
++ assert (m < 0x1_000_000);
++ let ml = m land 0xFFF and mh = m land 0xFFF_000 in
++ if mh <> 0 then ` {emit_string instr} sp, sp, #{emit_int mh}\n`;
++ if ml <> 0 then ` {emit_string instr} sp, sp, #{emit_int ml}\n`;
++ if n <> 0 then cfi_adjust_cfa_offset (-n)
++
++(* Deallocate the stack frame and reload the return address
++ before a return or tail call *)
++
++let output_epilogue f =
++ let n = frame_size() in
++ if !contains_calls then
++ ` ldr x30, [sp, #{emit_int (n-8)}]\n`;
++ if n > 0 then
++ emit_stack_adjustment n;
++ f();
++ (* reset CFA back because function body may continue *)
++ if n > 0 then cfi_adjust_cfa_offset n
++
++(* Name of current function *)
++let function_name = ref ""
++(* Entry point for tail recursive calls *)
++let tailrec_entry_point = ref 0
++(* Pending floating-point literals *)
++let float_literals = ref ([] : (int64 * label) list)
++
++(* Label a floating-point literal *)
++let float_literal f =
++ try
++ List.assoc f !float_literals
++ with Not_found ->
++ let lbl = new_label() in
++ float_literals := (f, lbl) :: !float_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}: .quad `; emit_printf "0x%Lx\n" f)
++ !float_literals;
++ float_literals := []
++ end
++
++(* Emit code to load the address of a symbol *)
++
++let emit_load_symbol_addr dst s =
++ if (not !Clflags.dlcode) || Compilenv.symbol_in_current_unit s then begin
++ ` adrp {emit_reg dst}, {emit_symbol s}\n`;
++ ` add {emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n`
++ end else begin
++ ` adrp {emit_reg dst}, :got:{emit_symbol s}\n`;
++ ` ldr {emit_reg dst}, [{emit_reg dst}, #:got_lo12:{emit_symbol s}]\n`
++ end
++
++(* Output the assembly code for an instruction *)
++
++let emit_instr i =
++ emit_debug_info i.dbg;
++ match i.desc with
++ | Lend -> ()
++ | Lop(Imove | Ispill | Ireload) ->
++ let src = i.arg.(0) and dst = i.res.(0) in
++ if src.loc <> dst.loc then begin
++ match (src, dst) with
++ | {loc = Reg _; typ = Float}, {loc = Reg _} ->
++ ` fmov {emit_reg dst}, {emit_reg src}\n`
++ | {loc = Reg _}, {loc = Reg _} ->
++ ` mov {emit_reg dst}, {emit_reg src}\n`
++ | {loc = Reg _}, {loc = Stack _} ->
++ ` str {emit_reg src}, {emit_stack dst}\n`
++ | {loc = Stack _}, {loc = Reg _} ->
++ ` ldr {emit_reg dst}, {emit_stack src}\n`
++ | _ ->
++ assert false
++ end
++ | Lop(Iconst_int n) ->
++ emit_intconst i.res.(0) n
++ | Lop(Iconst_float f) ->
++ let b = Int64.bits_of_float(float_of_string f) in
++ if b = 0L then
++ ` fmov {emit_reg i.res.(0)}, xzr /* {emit_string f} */\n`
++ else if is_immediate_float b then
++ ` fmov {emit_reg i.res.(0)}, #{emit_printf "0x%Lx" b} /* {emit_string f} */\n`
++ else begin
++ let lbl = float_literal b in
++ ` adrp {emit_reg reg_tmp1}, {emit_label lbl}\n`;
++ ` ldr {emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}] /* {emit_string f} */\n`
++ end
++ | Lop(Iconst_symbol s) ->
++ emit_load_symbol_addr i.res.(0) s
++ | Lop(Icall_ind) ->
++ ` blr {emit_reg i.arg.(0)}\n`;
++ `{record_frame i.live i.dbg}\n`
++ | Lop(Icall_imm s) ->
++ ` bl {emit_symbol s}\n`;
++ `{record_frame i.live i.dbg}\n`
++ | Lop(Itailcall_ind) ->
++ output_epilogue (fun () -> ` br {emit_reg i.arg.(0)}\n`)
++ | Lop(Itailcall_imm s) ->
++ if s = !function_name then
++ ` b {emit_label !tailrec_entry_point}\n`
++ else
++ output_epilogue (fun () -> ` b {emit_symbol s}\n`)
++ | Lop(Iextcall(s, false)) ->
++ ` bl {emit_symbol s}\n`
++ | Lop(Iextcall(s, true)) ->
++ emit_load_symbol_addr reg_x15 s;
++ ` bl {emit_symbol "caml_c_call"}\n`;
++ `{record_frame i.live i.dbg}\n`
++ | Lop(Istackoffset n) ->
++ assert (n mod 16 = 0);
++ emit_stack_adjustment (-n);
++ stack_offset := !stack_offset + n
++ | Lop(Iload(size, addr)) ->
++ let dst = i.res.(0) in
++ let base =
++ match addr with
++ | Iindexed ofs -> i.arg.(0)
++ | Ibased(s, ofs) ->
++ ` adrp {emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`;
++ reg_tmp1 in
++ begin match size with
++ | Byte_unsigned ->
++ ` ldrb {emit_wreg dst}, {emit_addressing addr base}\n`
++ | Byte_signed ->
++ ` ldrsb {emit_reg dst}, {emit_addressing addr base}\n`
++ | Sixteen_unsigned ->
++ ` ldrh {emit_wreg dst}, {emit_addressing addr base}\n`
++ | Sixteen_signed ->
++ ` ldrsh {emit_reg dst}, {emit_addressing addr base}\n`
++ | Thirtytwo_unsigned ->
++ ` ldr {emit_wreg dst}, {emit_addressing addr base}\n`
++ | Thirtytwo_signed ->
++ ` ldrsw {emit_reg dst}, {emit_addressing addr base}\n`
++ | Single ->
++ ` ldr s7, {emit_addressing addr base}\n`;
++ ` fcvt {emit_reg dst}, s7\n`
++ | Word | Double | Double_u ->
++ ` ldr {emit_reg dst}, {emit_addressing addr base}\n`
++ end
++ | Lop(Istore(size, addr)) ->
++ let src = i.arg.(0) in
++ let base =
++ match addr with
++ | Iindexed ofs -> i.arg.(1)
++ | Ibased(s, ofs) ->
++ ` adrp {emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`;
++ reg_tmp1 in
++ begin match size with
++ | Byte_unsigned | Byte_signed ->
++ ` strb {emit_wreg src}, {emit_addressing addr base}\n`
++ | Sixteen_unsigned | Sixteen_signed ->
++ ` strh {emit_wreg src}, {emit_addressing addr base}\n`
++ | Thirtytwo_unsigned | Thirtytwo_signed ->
++ ` str {emit_wreg src}, {emit_addressing addr base}\n`
++ | Single ->
++ ` fcvt s7, {emit_reg src}\n`;
++ ` str s7, {emit_addressing addr base}\n`;
++ | Word | Double | Double_u ->
++ ` str {emit_reg src}, {emit_addressing addr base}\n`
++ end
++ | Lop(Ialloc n) ->
++ let lbl_frame = record_frame_label i.live i.dbg in
++ if !fastcode_flag then begin
++ let lbl_redo = new_label() in
++ let lbl_call_gc = new_label() in
++ `{emit_label lbl_redo}:`;
++ ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`;
++ ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;
++ ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`;
++ ` b.lo {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
++ end else begin
++ begin match n with
++ | 16 -> ` bl {emit_symbol "caml_alloc1"}\n`
++ | 24 -> ` bl {emit_symbol "caml_alloc2"}\n`
++ | 32 -> ` bl {emit_symbol "caml_alloc3"}\n`
++ | _ -> emit_intconst reg_x15 (Nativeint.of_int n);
++ ` bl {emit_symbol "caml_allocN"}\n`
++ end;
++ `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
++ end
++ | Lop(Iintop(Icomp cmp)) ->
++ ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
++ ` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
++ | Lop(Iintop_imm(Icomp cmp, n)) ->
++ ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
++ ` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
++ | Lop(Iintop Icheckbound) ->
++ let lbl = bound_error_label i.dbg in
++ ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
++ ` b.ls {emit_label lbl}\n`
++ | Lop(Iintop_imm(Icheckbound, n)) ->
++ let lbl = bound_error_label i.dbg in
++ ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
++ ` b.ls {emit_label lbl}\n`
++ | 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`;
++ ` b.cs {emit_label lbl}\n`
++ | Lop(Iintop Imod) ->
++ ` sdiv {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
++ ` msub {emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
++ | Lop(Iintop_imm(Idiv, n)) -> (* n is a power of 2 *)
++ let l = Misc.log2 n in
++ ` asr {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, #63\n`;
++ ` add {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, lsr {emit_int (64-l)}\n`;
++ ` asr {emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_int l}\n`
++ | Lop(Iintop_imm(Imod, n)) -> (* n is a power of 2 *)
++ let l = Misc.log2 n in
++ ` asr {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, #63\n`;
++ ` add {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, lsr {emit_int (64-l)}\n`;
++ ` asr {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_int l}\n`;
++ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, lsl {emit_int l}\n`
++ | 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`
++ | 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`
++ | Lop(Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf as op) ->
++ let instr = (match op with
++ | Ifloatofint -> "scvtf"
++ | Iintoffloat -> "fcvtzs"
++ | Iabsf -> "fabs"
++ | Inegf -> "fneg"
++ | Ispecific Isqrtf -> "fsqrt"
++ | _ -> assert false) in
++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
++ | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) ->
++ let instr = (match op with
++ | Iaddf -> "fadd"
++ | Isubf -> "fsub"
++ | Imulf -> "fmul"
++ | Idivf -> "fdiv"
++ | Ispecific Inegmulf -> "fnmul"
++ | _ -> assert false) in
++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
++ | Lop(Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf as op)) ->
++ let instr = (match op with
++ | Imuladdf -> "fmadd"
++ | Inegmuladdf -> "fnmadd"
++ | Imulsubf -> "fmsub"
++ | Inegmulsubf -> "fnmsub"
++ | _ -> assert false) in
++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}, {emit_reg i.arg.(0)}\n`
++ | Lop(Ispecific(Ishiftarith(op, shift))) ->
++ let instr = (match op with
++ Ishiftadd -> "add"
++ | Ishiftsub -> "sub") 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`
++ | Lop(Ispecific(Imuladd | Imulsub as op)) ->
++ let instr = (match op with
++ Imuladd -> "madd"
++ | Imulsub -> "msub"
++ | _ -> 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`
++ | Lop(Ispecific(Ibswap size)) ->
++ begin match size with
++ | 16 ->
++ ` rev16 {emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`;
++ ` ubfm {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #0, #16\n`
++ | 32 ->
++ ` rev {emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`
++ | 64 ->
++ ` rev {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
++ | _ ->
++ assert false
++ end
++ | Lreloadretaddr ->
++ ()
++ | Lreturn ->
++ output_epilogue (fun () -> ` ret\n`)
++ | Llabel lbl ->
++ `{emit_label lbl}:\n`
++ | Lbranch lbl ->
++ ` b {emit_label lbl}\n`
++ | Lcondbranch(tst, lbl) ->
++ begin match tst with
++ | Itruetest ->
++ ` cbnz {emit_reg i.arg.(0)}, {emit_label lbl}\n`
++ | Ifalsetest ->
++ ` cbz {emit_reg i.arg.(0)}, {emit_label lbl}\n`
++ | 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`
++ | 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`
++ | Ifloattest(cmp, neg) ->
++ 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
++ ` fcmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
++ ` b.{emit_string comp} {emit_label lbl}\n`
++ | Ioddtest ->
++ ` tbnz {emit_reg i.arg.(0)}, #0, {emit_label lbl}\n`
++ | Ieventest ->
++ ` tbz {emit_reg i.arg.(0)}, #0, {emit_label lbl}\n`
++ end
++ | Lcondbranch3(lbl0, lbl1, lbl2) ->
++ ` cmp {emit_reg i.arg.(0)}, #1\n`;
++ begin match lbl0 with
++ None -> ()
++ | Some lbl -> ` b.lt {emit_label lbl}\n`
++ end;
++ begin match lbl1 with
++ None -> ()
++ | Some lbl -> ` b.eq {emit_label lbl}\n`
++ end;
++ begin match lbl2 with
++ None -> ()
++ | Some lbl -> ` b.gt {emit_label lbl}\n`
++ end
++ | Lswitch jumptbl ->
++ let lbltbl = new_label() in
++ ` adr {emit_reg reg_tmp1}, {emit_label lbltbl}\n`;
++ ` add {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, lsl #2\n`;
++ ` br {emit_reg reg_tmp1}\n`;
++ `{emit_label lbltbl}:`;
++ for j = 0 to Array.length jumptbl - 1 do
++ ` b {emit_label jumptbl.(j)}\n`
++ done
++(* Alternative:
++ let lbltbl = new_label() in
++ ` adr {emit_reg reg_tmp1}, {emit_label lbltbl}\n`;
++ ` ldr {emit_wreg reg_tmp2}, [{emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, lsl #2]\n`;
++ ` add {emit_reg reg_tmp1}, {emit_wreg reg_tmp2}, sxtb\n`;
++ ` br {emit_reg reg_tmp1}\n`;
++ `{emit_label lbltbl}:\n`;
++ for j = 0 to Array.length jumptbl - 1 do
++ ` .word {emit_label jumptbl.(j)} - {emit_label lbltbl}\n`
++ done
++*)
++ | Lsetuptrap lbl ->
++ let lblnext = new_label() in
++ ` adr {emit_reg reg_tmp1}, {emit_label lblnext}\n`;
++ ` b {emit_label lbl}\n`;
++ `{emit_label lblnext}:\n`
++ | Lpushtrap ->
++ stack_offset := !stack_offset + 16;
++ ` str {emit_reg reg_trap_ptr}, [sp, -16]!\n`;
++ ` str {emit_reg reg_tmp1}, [sp, #8]\n`;
++ cfi_adjust_cfa_offset 16;
++ ` mov {emit_reg reg_trap_ptr}, sp\n`
++ | Lpoptrap ->
++ ` ldr {emit_reg reg_trap_ptr}, [sp], 16\n`;
++ cfi_adjust_cfa_offset (-16);
++ stack_offset := !stack_offset - 16
++ | Lraise ->
++ if !Clflags.debug then begin
++ ` bl {emit_symbol "caml_raise_exn"}\n`;
++ `{record_frame Reg.Set.empty i.dbg}\n`
++ end else begin
++ ` mov sp, {emit_reg reg_trap_ptr}\n`;
++ ` ldr {emit_reg reg_tmp1}, [sp, #8]\n`;
++ ` ldr {emit_reg reg_trap_ptr}, [sp], 16\n`;
++ ` br {emit_reg reg_tmp1}\n`
++ end
++
++(* Emission of an instruction sequence *)
++
++let rec emit_all i =
++ if i.desc = Lend then () else (emit_instr i; emit_all i.next)
++
++(* Emission of the profiling prelude *)
++
++let emit_profile() = () (* TODO *)
++(*
++ 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 := [];
++ stack_offset := 0;
++ call_gc_sites := [];
++ bound_error_sites := [];
++ ` .text\n`;
++ ` .align 2\n`;
++ ` .globl {emit_symbol fundecl.fun_name}\n`;
++ ` .type {emit_symbol fundecl.fun_name}, %function\n`;
++ `{emit_symbol fundecl.fun_name}:\n`;
++ emit_debug_info fundecl.fun_dbg;
++ cfi_startproc();
++ if !Clflags.gprofile then emit_profile();
++ let n = frame_size() in
++ if n > 0 then
++ emit_stack_adjustment (-n);
++ if !contains_calls then
++ ` str x30, [sp, #{emit_int (n-8)}]\n`;
++ `{emit_label !tailrec_entry_point}:\n`;
++ emit_all fundecl.fun_body;
++ List.iter emit_call_gc !call_gc_sites;
++ List.iter emit_call_bound_error !bound_error_sites;
++ cfi_endproc();
++ ` .type {emit_symbol fundecl.fun_name}, %function\n`;
++ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
++ emit_literals()
++
++(* Emission of data *)
++
++let emit_item = function
++ | 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_nativeint n}\n`
++ | Cint n -> ` .quad {emit_nativeint n}\n`
++ | Csingle f -> emit_float32_directive ".long" f
++ | Cdouble f -> emit_float64_directive ".quad" f
++ | Csymbol_address s -> ` .quad {emit_symbol s}\n`
++ | Clabel_address lbl -> ` .quad {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`;
++ List.iter emit_item l
++
++(* Beginning / end of an assembly file *)
++
++let begin_assembly() =
++ reset_debug_info();
++ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
++ ` .data\n`;
++ ` .globl {emit_symbol lbl_begin}\n`;
++ `{emit_symbol lbl_begin}:\n`;
++ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
++ ` .text\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`;
++ ` .globl {emit_symbol lbl_end}\n`;
++ `{emit_symbol lbl_end}:\n`;
++ let lbl_end = Compilenv.make_symbol (Some "data_end") in
++ ` .data\n`;
++ ` .globl {emit_symbol lbl_end}\n`;
++ `{emit_symbol lbl_end}:\n`;
++ ` .long 0\n`;
++ let lbl = Compilenv.make_symbol (Some "frametable") in
++ ` .globl {emit_symbol lbl}\n`;
++ `{emit_symbol lbl}:\n`;
++ emit_frames
++ { efa_label = (fun lbl ->
++ ` .type {emit_label lbl}, %function\n`;
++ ` .quad {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 -> ` .quad {emit_int n}\n`);
++ efa_align = (fun n -> ` .align {emit_int(Misc.log2 n)}\n`);
++ efa_label_rel = (fun lbl ofs ->
++ ` .long {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" ->
++ (* Mark stack as non-executable *)
++ ` .section .note.GNU-stack,\"\",%progbits\n`
++ | _ -> ()
++ end
+diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml
+new file mode 100644
+index 0000000..b52c2fd
+--- /dev/null
++++ b/asmcomp/arm64/proc.ml
+@@ -0,0 +1,212 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
++(* Benedikt Meurer, University of Siegen *)
++(* *)
++(* Copyright 2013 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. *)
++(* *)
++(***********************************************************************)
++
++(* Description of the ARM processor in 64-bit mode *)
++
++open Misc
++open Cmm
++open Reg
++open Arch
++open Mach
++
++(* Instruction selection *)
++
++let word_addressed = false
++
++(* Registers available for register allocation *)
++
++(* Integer register map:
++ x0 - x15 general purpose (caller-save)
++ x16, x17 temporaries (used by call veeners)
++ x18 platform register (reserved)
++ x19 - x25 general purpose (callee-save)
++ x26 trap pointer
++ x27 alloc pointer
++ x28 alloc limit
++ x29 frame pointer
++ x30 return address
++ sp / xzr stack pointer / zero register
++ Floating-point register map:
++ d0 - d7 general purpose (caller-save)
++ d8 - d15 general purpose (callee-save)
++ d16 - d31 generat purpose (caller-save)
++*)
++
++let int_reg_name =
++ [| "x0"; "x1"; "x2"; "x3"; "x4"; "x5"; "x6"; "x7";
++ "x8"; "x9"; "x10"; "x11"; "x12"; "x13"; "x14"; "x15";
++ "x19"; "x20"; "x21"; "x22"; "x23"; "x24"; "x25";
++ "x26"; "x27"; "x28"; "x16"; "x17" |]
++
++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" |]
++
++let num_register_classes = 2
++
++let register_class r =
++ match r.typ with
++ | (Int | Addr) -> 0
++ | Float -> 1
++
++let num_available_registers =
++ [| 23; 32 |] (* first 23 int regs allocatable; all float regs allocatable *)
++
++let first_available_register =
++ [| 0; 100 |]
++
++let register_name r =
++ if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
++
++let rotate_registers = true
++
++(* Representation of hard registers by pseudo-registers *)
++
++let hard_int_reg =
++ let v = Array.create 28 Reg.dummy in
++ for i = 0 to 27 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 =
++ Array.append hard_int_reg hard_float_reg
++
++let phys_reg n =
++ if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
++
++let reg_x15 = phys_reg 15
++let reg_d7 = phys_reg 107
++
++let stack_slot slot ty =
++ Reg.at_location ty (Stack slot)
++
++(* Calling conventions *)
++
++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
++ Int | Addr as ty ->
++ if !int <= last_int then begin
++ loc.(i) <- phys_reg !int;
++ incr int
++ end else begin
++ loc.(i) <- stack_slot (make_stack !ofs) ty;
++ ofs := !ofs + size_int
++ end
++ | Float ->
++ if !float <= last_float then begin
++ loc.(i) <- phys_reg !float;
++ incr float
++ end else begin
++ loc.(i) <- stack_slot (make_stack !ofs) Float;
++ ofs := !ofs + size_float
++ end
++ done;
++ (loc, Misc.align !ofs 16) (* keep stack 16-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...r15
++ first float args in d0...d15
++ remaining args on stack.
++ Return values in r0...r15 or d0...d15. *)
++
++let loc_arguments arg =
++ calling_conventions 0 15 100 115 outgoing arg
++let loc_parameters arg =
++ let (loc, _) = calling_conventions 0 15 100 115 incoming arg in loc
++let loc_results res =
++ let (loc, _) = calling_conventions 0 15 100 115 not_supported res in loc
++
++(* C calling convention:
++ first integer args in r0...r7
++ first float args in d0...d7
++ remaining args on stack.
++ Return values in r0...r1 or d0. *)
++
++let loc_external_arguments arg =
++ calling_conventions 0 7 100 107 outgoing arg
++let loc_external_results res =
++ 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 =
++ (* x19-x28, d8-d15 preserved *)
++ Array.of_list (List.map phys_reg
++ [0;1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;
++ 100;101;102;103;104;105;106;107;
++ 116;117;118;119;120;121;122;123;
++ 124;125;126;127;128;129;130;131])
++
++let destroyed_at_oper = function
++ | Iop(Icall_ind | Icall_imm _) | Iop(Iextcall(_, true)) ->
++ all_phys_regs
++ | Iop(Iextcall(_, false)) ->
++ destroyed_at_c_call
++ | Iop(Ialloc _) ->
++ [| reg_x15 |]
++ | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _)) ->
++ [| reg_d7 |] (* d7 / s7 destroyed *)
++ | _ -> [||]
++
++let destroyed_at_raise = all_phys_regs
++
++(* Maximal register pressure *)
++
++let safe_register_pressure = function
++ | Iextcall(_, _) -> 8
++ | Ialloc _ -> 25
++ | _ -> 26
++
++let max_register_pressure = function
++ | Iextcall(_, _) -> [| 10; 8 |]
++ | Ialloc _ -> [| 25; 32 |]
++ | Iintoffloat | Ifloatofint
++ | Iload(Single, _) | Istore(Single, _) -> [| 26; 31 |]
++ | _ -> [| 26; 32 |]
++
++(* Layout of the stack *)
++
++let num_stack_slots = [| 0; 0 |]
++let contains_calls = ref false
++
++(* Calling the assembler *)
++
++let assemble_file infile outfile =
++ Ccomp.command (Config.asm ^ " -o " ^
++ Filename.quote outfile ^ " " ^ Filename.quote infile)
++
++
++let init () = ()
+diff --git a/asmcomp/arm64/reload.ml b/asmcomp/arm64/reload.ml
+new file mode 100644
+index 0000000..ff9214e
+--- /dev/null
++++ b/asmcomp/arm64/reload.ml
+@@ -0,0 +1,16 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
++(* *)
++(* Copyright 2013 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. *)
++(* *)
++(***********************************************************************)
++
++(* Reloading for the ARM 64 bits *)
++
++let fundecl f =
++ (new Reloadgen.reload_generic)#fundecl f
+diff --git a/asmcomp/arm64/scheduling.ml b/asmcomp/arm64/scheduling.ml
+new file mode 100644
+index 0000000..cc244be
+--- /dev/null
++++ b/asmcomp/arm64/scheduling.ml
+@@ -0,0 +1,18 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
++(* *)
++(* Copyright 2013 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. *)
++(* *)
++(***********************************************************************)
++
++let _ = let module M = Schedgen in () (* to create a dependency *)
++
++(* Scheduling is turned off because the processor schedules dynamically
++ much better than what we could do. *)
++
++let fundecl f = f
+diff --git a/asmcomp/arm64/selection.ml b/asmcomp/arm64/selection.ml
+new file mode 100644
+index 0000000..c74b282
+--- /dev/null
++++ b/asmcomp/arm64/selection.ml
+@@ -0,0 +1,265 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
++(* Benedikt Meurer, University of Siegen *)
++(* *)
++(* Copyright 2013 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. *)
++(* *)
++(***********************************************************************)
++
++(* Instruction selection for the ARM processor *)
++
++open Arch
++open Cmm
++open Mach
++
++let is_offset chunk n =
++ (n >= -256 && n <= 255) (* 9 bits signed unscaled *)
++|| (n >= 0 &&
++ match chunk with (* 12 bits unsigned, scaled by chunk size *)
++ | Byte_unsigned | Byte_signed ->
++ n < 0x1000
++ | Sixteen_unsigned | Sixteen_signed ->
++ n land 1 = 0 && n lsr 1 < 0x1000
++ | Thirtytwo_unsigned | Thirtytwo_signed | Single ->
++ n land 3 = 0 && n lsr 2 < 0x1000
++ | Word | Double | Double_u ->
++ n land 7 = 0 && n lsr 3 < 0x1000)
++
++(* An automaton to recognize ( 0+1+0* | 1+0+1* )
++
++ 0 1 0
++ / \ / \ / \
++ \ / \ / \ /
++ -0--> [1] --1--> [2] --0--> [3]
++ /
++ [0]
++ \
++ -1--> [4] --0--> [5] --1--> [6]
++ / \ / \ / \
++ \ / \ / \ /
++ 1 0 1
++
++The accepting states are 2, 3, 5 and 6. *)
++
++let auto_table = [| (* accepting?, next on 0, next on 1 *)
++ (* state 0 *) (false, 1, 4);
++ (* state 1 *) (false, 1, 2);
++ (* state 2 *) (true, 3, 2);
++ (* state 3 *) (true, 3, 7);
++ (* state 4 *) (false, 5, 4);
++ (* state 5 *) (true, 5, 6);
++ (* state 6 *) (true, 7, 6);
++ (* state 7 *) (false, 7, 7) (* error state *)
++|]
++
++let rec run_automata nbits state input =
++ let (acc, next0, next1) = auto_table.(state) in
++ if nbits <= 0
++ then acc
++ else run_automata (nbits - 1)
++ (if input land 1 = 0 then next0 else next1)
++ (input asr 1)
++
++(* We are very conservative wrt what ARM64 supports: we don't support
++ repetitions of a 000111000 or 1110000111 pattern, just a single
++ pattern of this kind. *)
++
++let is_logical_immediate n =
++ n <> 0 && n <> -1 && run_automata 64 0 n
++
++let is_intconst = function
++ Cconst_int _ -> true
++ | _ -> false
++
++let inline_ops =
++ [ "sqrt"; "caml_bswap16_direct"; "caml_int32_direct_bswap";
++ "caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ]
++
++let use_direct_addressing symb =
++ (not !Clflags.dlcode) || Compilenv.symbol_in_current_unit symb
++
++(* Instruction selection *)
++
++class selector = object(self)
++
++inherit Selectgen.selector_generic as super
++
++method is_immediate n =
++ let mn = -n in
++ n land 0xFFF = n || n land 0xFFF_000 = n
++ || mn land 0xFFF = mn || mn land 0xFFF_000 = mn
++
++method! is_simple_expr = function
++ (* inlined floating-point ops are simple if their arguments are *)
++ | Cop(Cextcall(fn, _, _, _), args) when List.mem fn inline_ops ->
++ List.for_all self#is_simple_expr args
++ | e -> super#is_simple_expr e
++
++method select_addressing chunk = function
++ | Cop(Cadda, [Cconst_symbol s; Cconst_int n])
++ when use_direct_addressing s ->
++ (Ibased(s, n), Ctuple [])
++ | 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 chunk n ->
++ (Iindexed n, Cop(Cadda, [arg1; arg2]))
++ | Cconst_symbol s
++ when use_direct_addressing s ->
++ (Ibased(s, 0), Ctuple [])
++ | arg ->
++ (Iindexed 0, arg)
++
++method! select_operation op args =
++ match op with
++ (* Integer addition *)
++ | Caddi | Cadda ->
++ begin match args with
++ (* Add immediate *)
++ | [arg; Cconst_int n] | [Cconst_int n; arg] when self#is_immediate n ->
++ ((if n >= 0 then Iintop_imm(Iadd, n) else Iintop_imm(Isub, -n)),
++ [arg])
++ (* Shift-add *)
++ | [arg1; Cop(Clsl, [arg2; Cconst_int n])] when n > 0 && n < 64 ->
++ (Ispecific(Ishiftarith(Ishiftadd, n)), [arg1; arg2])
++ | [arg1; Cop(Casr, [arg2; Cconst_int n])] when n > 0 && n < 64 ->
++ (Ispecific(Ishiftarith(Ishiftadd, -n)), [arg1; arg2])
++ | [Cop(Clsl, [arg1; Cconst_int n]); arg2] when n > 0 && n < 64 ->
++ (Ispecific(Ishiftarith(Ishiftadd, n)), [arg2; arg1])
++ | [Cop(Casr, [arg1; Cconst_int n]); arg2] when n > 0 && n < 64 ->
++ (Ispecific(Ishiftarith(Ishiftadd, -n)), [arg2; arg1])
++ (* Multiply-add *)
++ | [arg1; Cop(Cmuli, args2)] | [Cop(Cmuli, args2); arg1] ->
++ begin match self#select_operation Cmuli args2 with
++ | (Iintop_imm(Ilsl, l), [arg3]) ->
++ (Ispecific(Ishiftarith(Ishiftadd, l)), [arg1; arg3])
++ | (Iintop Imul, [arg3; arg4]) ->
++ (Ispecific Imuladd, [arg3; arg4; arg1])
++ | _ ->
++ super#select_operation op args
++ end
++ | _ ->
++ super#select_operation op args
++ end
++ (* Integer subtraction *)
++ | Csubi | Csuba ->
++ begin match args with
++ (* Sub immediate *)
++ | [arg; Cconst_int n] when self#is_immediate n ->
++ ((if n >= 0 then Iintop_imm(Isub, n) else Iintop_imm(Iadd, -n)),
++ [arg])
++ (* Shift-sub *)
++ | [arg1; Cop(Clsl, [arg2; Cconst_int n])] when n > 0 && n < 64 ->
++ (Ispecific(Ishiftarith(Ishiftsub, n)), [arg1; arg2])
++ | [arg1; Cop(Casr, [arg2; Cconst_int n])] when n > 0 && n < 64 ->
++ (Ispecific(Ishiftarith(Ishiftsub, -n)), [arg1; arg2])
++ (* Multiply-sub *)
++ | [arg1; Cop(Cmuli, args2)] ->
++ begin match self#select_operation Cmuli args2 with
++ | (Iintop_imm(Ilsl, l), [arg3]) ->
++ (Ispecific(Ishiftarith(Ishiftsub, l)), [arg1; arg3])
++ | (Iintop Imul, [arg3; arg4]) ->
++ (Ispecific Imulsub, [arg3; arg4; arg1])
++ | _ ->
++ super#select_operation op args
++ end
++ | _ ->
++ super#select_operation op args
++ end
++ (* Checkbounds *)
++ | Ccheckbound _ ->
++ begin match args with
++ | [Cop(Clsr, [arg1; Cconst_int n]); arg2] when n > 0 && n < 64 ->
++ (Ispecific(Ishiftcheckbound n), [arg1; arg2])
++ | _ ->
++ super#select_operation op args
++ end
++ (* Integer multiplication *)
++ (* ARM does not support immediate operands for multiplication *)
++ | Cmuli ->
++ begin match args with
++ | [arg; Cconst_int n] | [Cconst_int n; arg] ->
++ let l = Misc.log2 n in
++ if n = 1 lsl l
++ then (Iintop_imm(Ilsl, l), [arg])
++ else (Iintop Imul, args)
++ | _ ->
++ (Iintop Imul, args)
++ end
++ (* Division and modulus *)
++ (* Recognize (x / cst) and (x % cst) only if cst is a power of 2. *)
++ | Cdivi ->
++ begin match args with
++ | [arg; Cconst_int n] when n = 1 lsl Misc.log2 n ->
++ ((if n = 1 then Imove else Iintop_imm(Idiv, n)), [arg])
++ | _ ->
++ (Iintop Idiv, args)
++ end
++ | Cmodi ->
++ begin match args with
++ | [arg; Cconst_int n] when n = 1 lsl Misc.log2 n ->
++ ((if n = 1 then Iconst_int 0n else Iintop_imm(Imod, n)), [arg])
++ | _ ->
++ (Iintop Imod, args)
++ end
++ (* Bitwise logical operations have a different range of immediate
++ operands than the other instructions *)
++ | Cand -> self#select_logical Iand args
++ | Cor -> self#select_logical Ior args
++ | Cxor -> self#select_logical Ixor args
++ (* Recognize floating-point negate and multiply *)
++ | Cnegf ->
++ begin match args with
++ | [Cop(Cmulf, args)] -> (Ispecific Inegmulf, args)
++ | _ -> super#select_operation op args
++ end
++ (* Recognize floating-point multiply and add/sub *)
++ | Caddf ->
++ begin match args with
++ | [arg; Cop(Cmulf, args)] | [Cop(Cmulf, args); arg] ->
++ (Ispecific Imuladdf, arg :: args)
++ | _ ->
++ super#select_operation op args
++ end
++ | Csubf ->
++ begin match args with
++ | [arg; Cop(Cmulf, args)] ->
++ (Ispecific Imulsubf, arg :: args)
++ | [Cop(Cmulf, args); arg] ->
++ (Ispecific Inegmulsubf, arg :: args)
++ | _ ->
++ super#select_operation op args
++ end
++ (* Recognize floating-point square root *)
++ | Cextcall("sqrt", _, _, _) ->
++ (Ispecific Isqrtf, args)
++ (* Recognize bswap instructions *)
++ | Cextcall("caml_bswap16_direct", _, _, _) ->
++ (Ispecific(Ibswap 16), args)
++ | Cextcall("caml_int32_direct_bswap", _, _, _) ->
++ (Ispecific(Ibswap 32), args)
++ | Cextcall(("caml_int64_direct_bswap"|"caml_nativeint_direct_bswap"),
++ _, _, _) ->
++ (Ispecific (Ibswap 64), args)
++ (* Other operations are regular *)
++ | _ ->
++ super#select_operation op args
++
++method select_logical op = function
++ | [arg; Cconst_int n] when is_logical_immediate n ->
++ (Iintop_imm(op, n), [arg])
++ | [Cconst_int n; arg] when is_logical_immediate n ->
++ (Iintop_imm(op, n), [arg])
++ | args ->
++ (Iintop op, args)
++
++end
++
++let fundecl f = (new selector)#emit_fundecl f
+diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml
+index 17870c9..280b131 100644
+--- a/asmcomp/compilenv.ml
++++ b/asmcomp/compilenv.ml
+@@ -83,6 +83,15 @@ let make_symbol ?(unitname = current_unit.ui_symbol) idopt =
+ | None -> prefix
+ | Some id -> prefix ^ "__" ^ id
+
++let symbol_in_current_unit name =
++ let prefix = "caml" ^ current_unit.ui_symbol in
++ name = prefix ||
++ (let lp = String.length prefix in
++ String.length name >= 2 + lp
++ && String.sub name 0 lp = prefix
++ && name.[lp] = '_'
++ && name.[lp + 1] = '_')
++
+ let read_unit_info filename =
+ let ic = open_in_bin filename in
+ try
+diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli
+index 51cb8c6..9ffb145 100644
+--- a/asmcomp/compilenv.mli
++++ b/asmcomp/compilenv.mli
+@@ -31,6 +31,10 @@ val make_symbol: ?unitname:string -> string option -> string
+ corresponds to symbol [id] in the compilation unit [u]
+ (or the current unit). *)
+
++val symbol_in_current_unit: string -> bool
++ (* Return true if the given asm symbol belongs to the
++ current compilation unit, false otherwise. *)
++
+ val symbol_for_global: Ident.t -> string
+ (* Return the asm symbol that refers to the given global identifier *)
+
+diff --git a/asmrun/arm64.S b/asmrun/arm64.S
+new file mode 100644
+index 0000000..de670e6
+--- /dev/null
++++ b/asmrun/arm64.S
+@@ -0,0 +1,535 @@
++/***********************************************************************/
++/* */
++/* OCaml */
++/* */
++/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */
++/* */
++/* Copyright 2013 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. */
++/* */
++/***********************************************************************/
++
++/* Asm part of the runtime system, ARM processor, 64-bit mode */
++/* Must be preprocessed by cpp */
++
++/* Special registers */
++
++#define TRAP_PTR x26
++#define ALLOC_PTR x27
++#define ALLOC_LIMIT x28
++#define ARG x15
++#define TMP x16
++#define TMP2 x17
++
++/* Support for CFI directives */
++
++#if defined(ASM_CFI_SUPPORTED)
++#define CFI_STARTPROC .cfi_startproc
++#define CFI_ENDPROC .cfi_endproc
++#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
++#else
++#define CFI_STARTPROC
++#define CFI_ENDPROC
++#define CFI_ADJUST(n)
++#endif
++
++/* Support for profiling with gprof */
++
++#define PROFILE
++
++/* Macros to load and store global variables. Destroy TMP2 */
++
++#if defined(__PIC__)
++
++#define ADDRGLOBAL(reg,symb) \
++ adrp TMP2, :got:symb; \
++ ldr reg, [TMP2, #:got_lo12:symb]
++
++#define LOADGLOBAL(reg,symb) \
++ ADDRGLOBAL(TMP2,symb); \
++ ldr reg, [TMP2]
++
++#define STOREGLOBAL(reg,symb) \
++ ADDRGLOBAL(TMP2,symb); \
++ str reg, [TMP2]
++
++#else
++
++#define ADDRGLOBAL(reg,symb) \
++ adrp reg, symb; \
++ add reg, reg, #:lo12:symb
++
++#define LOADGLOBAL(reg,symb) \
++ adrp TMP2, symb; \
++ ldr reg, [TMP2, #:lo12:symb]
++
++#define STOREGLOBAL(reg,symb) \
++ adrp TMP2, symb; \
++ str reg, [TMP2, #:lo12:symb]
++
++#endif
++
++/* Allocation functions and GC interface */
++
++ .globl caml_system__code_begin
++caml_system__code_begin:
++
++ .align 2
++ .globl caml_call_gc
++caml_call_gc:
++ CFI_STARTPROC
++ PROFILE
++ /* Record return address */
++ STOREGLOBAL(x30, caml_last_return_address)
++.Lcaml_call_gc:
++ /* Record lowest stack address */
++ mov TMP, sp
++ STOREGLOBAL(TMP, caml_bottom_of_stack)
++ /* Set up stack space, saving return address and frame pointer */
++ /* (2 regs RA/GP, 24 allocatable int regs, 24 caller-save float regs) * 8 */
++ stp x29, x30, [sp, -400]!
++ CFI_ADJUST(400)
++ add x29, sp, #0
++ /* Save allocatable integer registers on the stack, in the order
++ given in proc.ml */
++ stp x0, x1, [sp, 16]
++ stp x2, x3, [sp, 32]
++ stp x4, x5, [sp, 48]
++ stp x6, x7, [sp, 64]
++ stp x8, x9, [sp, 80]
++ stp x10, x11, [sp, 96]
++ stp x12, x13, [sp, 112]
++ stp x14, x15, [sp, 128]
++ stp x19, x20, [sp, 144]
++ stp x21, x22, [sp, 160]
++ stp x23, x24, [sp, 176]
++ str x25, [sp, 192]
++ /* Save caller-save floating-point registers on the stack
++ (callee-saves are preserved by caml_garbage_collection) */
++ stp d0, d1, [sp, 208]
++ stp d2, d3, [sp, 224]
++ stp d4, d5, [sp, 240]
++ stp d6, d7, [sp, 256]
++ stp d16, d17, [sp, 272]
++ stp d18, d19, [sp, 288]
++ stp d20, d21, [sp, 304]
++ stp d22, d23, [sp, 320]
++ stp d24, d25, [sp, 336]
++ stp d26, d27, [sp, 352]
++ stp d28, d29, [sp, 368]
++ stp d30, d31, [sp, 384]
++ /* Store pointer to saved integer registers in caml_gc_regs */
++ add TMP, sp, #16
++ STOREGLOBAL(TMP, caml_gc_regs)
++ /* Save current allocation pointer for debugging purposes */
++ STOREGLOBAL(ALLOC_PTR, caml_young_ptr)
++ /* Save trap pointer in case an exception is raised during GC */
++ STOREGLOBAL(TRAP_PTR, caml_exception_pointer)
++ /* Call the garbage collector */
++ bl caml_garbage_collection
++ /* Restore registers */
++ ldp x0, x1, [sp, 16]
++ ldp x2, x3, [sp, 32]
++ ldp x4, x5, [sp, 48]
++ ldp x6, x7, [sp, 64]
++ ldp x8, x9, [sp, 80]
++ ldp x10, x11, [sp, 96]
++ ldp x12, x13, [sp, 112]
++ ldp x14, x15, [sp, 128]
++ ldp x19, x20, [sp, 144]
++ ldp x21, x22, [sp, 160]
++ ldp x23, x24, [sp, 176]
++ ldr x25, [sp, 192]
++ ldp d0, d1, [sp, 208]
++ ldp d2, d3, [sp, 224]
++ ldp d4, d5, [sp, 240]
++ ldp d6, d7, [sp, 256]
++ ldp d16, d17, [sp, 272]
++ ldp d18, d19, [sp, 288]
++ ldp d20, d21, [sp, 304]
++ ldp d22, d23, [sp, 320]
++ ldp d24, d25, [sp, 336]
++ ldp d26, d27, [sp, 352]
++ ldp d28, d29, [sp, 368]
++ ldp d30, d31, [sp, 384]
++ /* Reload new allocation pointer and allocation limit */
++ LOADGLOBAL(ALLOC_PTR, caml_young_ptr)
++ LOADGLOBAL(ALLOC_LIMIT, caml_young_limit)
++ /* Free stack space and return to caller */
++ ldp x29, x30, [sp], 400
++ ret
++ CFI_ENDPROC
++ .type caml_call_gc, %function
++ .size caml_call_gc, .-caml_call_gc
++
++ .align 2
++ .globl caml_alloc1
++caml_alloc1:
++ CFI_STARTPROC
++ PROFILE
++1: sub ALLOC_PTR, ALLOC_PTR, #16
++ cmp ALLOC_PTR, ALLOC_LIMIT
++ b.lo 2f
++ ret
++2: stp x29, x30, [sp, -16]!
++ CFI_ADJUST(16)
++ add x29, sp, #0
++ /* Record return address */
++ STOREGLOBAL(x30, caml_last_return_address)
++ /* Call GC */
++ bl .Lcaml_call_gc
++ /* Restore return address */
++ ldp x29, x30, [sp], 16
++ CFI_ADJUST(-16)
++ /* Try again */
++ b 1b
++ CFI_ENDPROC
++ .type caml_alloc1, %function
++ .size caml_alloc1, .-caml_alloc1
++
++ .align 2
++ .globl caml_alloc2
++caml_alloc2:
++ CFI_STARTPROC
++ PROFILE
++1: sub ALLOC_PTR, ALLOC_PTR, #24
++ cmp ALLOC_PTR, ALLOC_LIMIT
++ b.lo 2f
++ ret
++2: stp x29, x30, [sp, -16]!
++ CFI_ADJUST(16)
++ add x29, sp, #0
++ /* Record return address */
++ STOREGLOBAL(x30, caml_last_return_address)
++ /* Call GC */
++ bl .Lcaml_call_gc
++ /* Restore return address */
++ ldp x29, x30, [sp], 16
++ CFI_ADJUST(-16)
++ /* Try again */
++ b 1b
++ CFI_ENDPROC
++ .type caml_alloc2, %function
++ .size caml_alloc2, .-caml_alloc2
++
++ .align 2
++ .globl caml_alloc3
++caml_alloc3:
++ CFI_STARTPROC
++ PROFILE
++1: sub ALLOC_PTR, ALLOC_PTR, #32
++ cmp ALLOC_PTR, ALLOC_LIMIT
++ b.lo 2f
++ ret
++2: stp x29, x30, [sp, -16]!
++ CFI_ADJUST(16)
++ add x29, sp, #0
++ /* Record return address */
++ STOREGLOBAL(x30, caml_last_return_address)
++ /* Call GC */
++ bl .Lcaml_call_gc
++ /* Restore return address */
++ ldp x29, x30, [sp], 16
++ CFI_ADJUST(-16)
++ /* Try again */
++ b 1b
++ CFI_ENDPROC
++ .type caml_alloc2, %function
++ .size caml_alloc2, .-caml_alloc2
++
++ .align 2
++ .globl caml_allocN
++caml_allocN:
++ CFI_STARTPROC
++ PROFILE
++1: sub ALLOC_PTR, ALLOC_PTR, ARG
++ cmp ALLOC_PTR, ALLOC_LIMIT
++ b.lo 2f
++ ret
++2: stp x29, x30, [sp, -16]!
++ CFI_ADJUST(16)
++ add x29, sp, #0
++ /* Record return address */
++ STOREGLOBAL(x30, caml_last_return_address)
++ /* Call GC. This preserves ARG */
++ bl .Lcaml_call_gc
++ /* Restore return address */
++ ldp x29, x30, [sp], 16
++ CFI_ADJUST(-16)
++ /* Try again */
++ b 1b
++ CFI_ENDPROC
++ .type caml_allocN, %function
++ .size caml_allocN, .-caml_allocN
++
++/* Call a C function from OCaml */
++/* Function to call is in ARG */
++
++ .align 2
++ .globl caml_c_call
++caml_c_call:
++ CFI_STARTPROC
++ PROFILE
++ /* Preserve return address in callee-save register x19 */
++ mov x19, x30
++ /* Record lowest stack address and return address */
++ STOREGLOBAL(x30, caml_last_return_address)
++ add TMP, sp, #0
++ STOREGLOBAL(TMP, caml_bottom_of_stack)
++ /* Make the exception handler alloc ptr available to the C code */
++ STOREGLOBAL(ALLOC_PTR, caml_young_ptr)
++ STOREGLOBAL(TRAP_PTR, caml_exception_pointer)
++ /* Call the function */
++ blr ARG
++ /* Reload alloc ptr and alloc limit */
++ LOADGLOBAL(ALLOC_PTR, caml_young_ptr)
++ LOADGLOBAL(ALLOC_LIMIT, caml_young_limit)
++ /* Return */
++ ret x19
++ CFI_ENDPROC
++ .type caml_c_call, %function
++ .size caml_c_call, .-caml_c_call
++
++/* Start the OCaml program */
++
++ .align 2
++ .globl caml_start_program
++caml_start_program:
++ CFI_STARTPROC
++ PROFILE
++ ADDRGLOBAL(ARG, caml_program)
++
++/* Code shared with caml_callback* */
++/* Address of OCaml code to call is in ARG */
++/* Arguments to the OCaml code are in x0...x7 */
++
++.Ljump_to_caml:
++ /* Set up stack frame and save callee-save registers */
++ stp x29, x30, [sp, -160]!
++ CFI_ADJUST(160)
++ add x29, sp, #0
++ stp x19, x20, [sp, 16]
++ stp x21, x22, [sp, 32]
++ stp x23, x24, [sp, 48]
++ stp x25, x26, [sp, 64]
++ stp x27, x28, [sp, 80]
++ stp d8, d9, [sp, 96]
++ stp d10, d11, [sp, 112]
++ stp d12, d13, [sp, 128]
++ stp d14, d15, [sp, 144]
++ /* Setup a callback link on the stack */
++ LOADGLOBAL(x8, caml_bottom_of_stack)
++ LOADGLOBAL(x9, caml_last_return_address)
++ LOADGLOBAL(x10, caml_gc_regs)
++ stp x8, x9, [sp, -32]! /* 16-byte alignment */
++ CFI_ADJUST(32)
++ str x10, [sp, 16]
++ /* Setup a trap frame to catch exceptions escaping the OCaml code */
++ LOADGLOBAL(x8, caml_exception_pointer)
++ adr x9, .Ltrap_handler
++ stp x8, x9, [sp, -16]!
++ CFI_ADJUST(16)
++ add TRAP_PTR, sp, #0
++ /* Reload allocation pointers */
++ LOADGLOBAL(ALLOC_PTR, caml_young_ptr)
++ LOADGLOBAL(ALLOC_LIMIT, caml_young_limit)
++ /* Call the OCaml code */
++ blr ARG
++.Lcaml_retaddr:
++ /* Pop the trap frame, restoring caml_exception_pointer */
++ ldr x8, [sp], 16
++ CFI_ADJUST(-16)
++ STOREGLOBAL(x8, caml_exception_pointer)
++ /* Pop the callback link, restoring the global variables */
++.Lreturn_result:
++ ldr x10, [sp, 16]
++ ldp x8, x9, [sp], 32
++ CFI_ADJUST(-32)
++ STOREGLOBAL(x8, caml_bottom_of_stack)
++ STOREGLOBAL(x9, caml_last_return_address)
++ STOREGLOBAL(x10, caml_gc_regs)
++ /* Update allocation pointer */
++ STOREGLOBAL(ALLOC_PTR, caml_young_ptr)
++ /* Reload callee-save registers and return address */
++ ldp x19, x20, [sp, 16]
++ ldp x21, x22, [sp, 32]
++ ldp x23, x24, [sp, 48]
++ ldp x25, x26, [sp, 64]
++ ldp x27, x28, [sp, 80]
++ ldp d8, d9, [sp, 96]
++ ldp d10, d11, [sp, 112]
++ ldp d12, d13, [sp, 128]
++ ldp d14, d15, [sp, 144]
++ ldp x29, x30, [sp], 160
++ CFI_ADJUST(-160)
++ /* Return to C caller */
++ ret
++ CFI_ENDPROC
++ .type .Lcaml_retaddr, %function
++ .size .Lcaml_retaddr, .-.Lcaml_retaddr
++ .type caml_start_program, %function
++ .size caml_start_program, .-caml_start_program
++
++/* The trap handler */
++
++ .align 2
++.Ltrap_handler:
++ CFI_STARTPROC
++ /* Save exception pointer */
++ STOREGLOBAL(TRAP_PTR, caml_exception_pointer)
++ /* Encode exception bucket as an exception result */
++ orr x0, x0, #2
++ /* Return it */
++ b .Lreturn_result
++ CFI_ENDPROC
++ .type .Ltrap_handler, %function
++ .size .Ltrap_handler, .-.Ltrap_handler
++
++/* Raise an exception from OCaml */
++
++ .align 2
++ .globl caml_raise_exn
++caml_raise_exn:
++ CFI_STARTPROC
++ PROFILE
++ /* Test if backtrace is active */
++ LOADGLOBAL(TMP, caml_backtrace_active)
++ cbnz TMP, 2f
++1: /* Cut stack at current trap handler */
++ mov sp, TRAP_PTR
++ /* Pop previous handler and jump to it */
++ ldr TMP, [sp, 8]
++ ldr TRAP_PTR, [sp], 16
++ br TMP
++2: /* Preserve exception bucket in callee-save register x19 */
++ mov x19, x0
++ /* Stash the backtrace */
++ /* arg1: exn bucket, already in x0 */
++ mov x1, x30 /* arg2: pc of raise */
++ add x2, sp, #0 /* arg3: sp of raise */
++ mov x3, TRAP_PTR /* arg4: sp of handler */
++ bl caml_stash_backtrace
++ /* Restore exception bucket and raise */
++ mov x0, x19
++ b 1b
++ CFI_ENDPROC
++ .type caml_raise_exn, %function
++ .size caml_raise_exn, .-caml_raise_exn
++
++/* Raise an exception from C */
++
++ .align 2
++ .globl caml_raise_exception
++caml_raise_exception:
++ CFI_STARTPROC
++ PROFILE
++ /* Reload trap ptr, alloc ptr and alloc limit */
++ LOADGLOBAL(TRAP_PTR, caml_exception_pointer)
++ LOADGLOBAL(ALLOC_PTR, caml_young_ptr)
++ LOADGLOBAL(ALLOC_LIMIT, caml_young_limit)
++ /* Test if backtrace is active */
++ LOADGLOBAL(TMP, caml_backtrace_active)
++ cbnz TMP, 2f
++1: /* Cut stack at current trap handler */
++ mov sp, TRAP_PTR
++ /* Pop previous handler and jump to it */
++ ldr TMP, [sp, 8]
++ ldr TRAP_PTR, [sp], 16
++ br TMP
++2: /* Preserve exception bucket in callee-save register x19 */
++ mov x19, x0
++ /* Stash the backtrace */
++ /* arg1: exn bucket, already in x0 */
++ LOADGLOBAL(x1, caml_last_return_address) /* arg2: pc of raise */
++ LOADGLOBAL(x2, caml_bottom_of_stack) /* arg3: sp of raise */
++ mov x3, TRAP_PTR /* arg4: sp of handler */
++ bl caml_stash_backtrace
++ /* Restore exception bucket and raise */
++ mov x0, x19
++ b 1b
++ CFI_ENDPROC
++ .type caml_raise_exception, %function
++ .size caml_raise_exception, .-caml_raise_exception
++
++/* Callback from C to OCaml */
++
++ .align 2
++ .globl caml_callback_exn
++caml_callback_exn:
++ CFI_STARTPROC
++ PROFILE
++ /* Initial shuffling of arguments (x0 = closure, x1 = first arg) */
++ mov TMP, x0
++ mov x0, x1 /* x0 = first arg */
++ mov x1, TMP /* x1 = closure environment */
++ ldr ARG, [TMP] /* code pointer */
++ b .Ljump_to_caml
++ CFI_ENDPROC
++ .type caml_callback_exn, %function
++ .size caml_callback_exn, .-caml_callback_exn
++
++ .align 2
++ .globl caml_callback2_exn
++caml_callback2_exn:
++ CFI_STARTPROC
++ PROFILE
++ /* Initial shuffling of arguments (x0 = closure, x1 = arg1, x2 = arg2) */
++ mov TMP, x0
++ mov x0, x1 /* x0 = first arg */
++ mov x1, x2 /* x1 = second arg
++ mov x2, TMP /* x2 = closure environment */
++ ADDRGLOBAL(ARG, caml_apply2)
++ b .Ljump_to_caml
++ CFI_ENDPROC
++ .type caml_callback2_exn, %function
++ .size caml_callback2_exn, .-caml_callback2_exn
++
++ .align 2
++ .globl caml_callback3_exn
++caml_callback3_exn:
++ CFI_STARTPROC
++ PROFILE
++ /* Initial shuffling of arguments */
++ /* (x0 = closure, x1 = arg1, x2 = arg2, x3 = arg3) */
++ mov TMP, x0
++ mov x0, x1 /* x0 = first arg */
++ mov x1, x2 /* x1 = second arg */
++ mov x2, x3 /* x2 = third arg */
++ mov x3, TMP /* x3 = closure environment */
++ ADDRGLOBAL(ARG, caml_apply3)
++ b .Ljump_to_caml
++ CFI_ENDPROC
++ .type caml_callback3_exn, %function
++ .size caml_callback3_exn, .-caml_callback3_exn
++
++ .align 2
++ .globl caml_ml_array_bound_error
++caml_ml_array_bound_error:
++ CFI_STARTPROC
++ PROFILE
++ /* Load address of [caml_array_bound_error] in ARG */
++ ADDRGLOBAL(ARG, caml_array_bound_error)
++ /* Call that function */
++ b caml_c_call
++ CFI_ENDPROC
++ .type caml_ml_array_bound_error, %function
++ .size caml_ml_array_bound_error, .-caml_ml_array_bound_error
++
++ .globl caml_system__code_end
++caml_system__code_end:
++
++/* GC roots for callback */
++
++ .data
++ .align 3
++ .globl caml_system__frametable
++caml_system__frametable:
++ .quad 1 /* one descriptor */
++ .quad .Lcaml_retaddr /* return address into callback */
++ .short -1 /* negative frame size => use callback link */
++ .short 0 /* no roots */
++ .align 3
++ .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 ff19847..68ec837 100644
+--- a/asmrun/signals_osdep.h
++++ b/asmrun/signals_osdep.h
+@@ -92,6 +92,25 @@
+ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.arm_r8)
+ #define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address)
+
++/****************** ARM64, Linux */
++
++#elif defined(TARGET_arm64) && defined(SYS_linux)
++
++ #include <sys/ucontext.h>
++
++ #define DECLARE_SIGNAL_HANDLER(name) \
++ static void name(int sig, siginfo_t * info, ucontext_t * context)
++
++ #define SET_SIGACT(sigact,name) \
++ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
++ sigact.sa_flags = SA_SIGINFO
++
++ typedef unsigned long context_reg;
++ #define CONTEXT_PC (context->uc_mcontext.pc)
++ #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.regs[26])
++ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.regs[27])
++ #define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address)
++
+ /****************** AMD64, Solaris x86 */
+
+ #elif defined(TARGET_amd64) && defined (SYS_solaris)
+diff --git a/asmrun/stack.h b/asmrun/stack.h
+index 756db95..031e408 100644
+--- a/asmrun/stack.h
++++ b/asmrun/stack.h
+@@ -65,6 +65,11 @@
+ #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
+ #endif
+
++#ifdef TARGET_arm64
++#define Saved_return_address(sp) *((intnat *)((sp) - 8))
++#define Callback_link(sp) ((struct caml_context *)((sp) + 16))
++#endif
++
+ /* Structure of OCaml callback contexts */
+
+ struct caml_context {
+diff --git a/byterun/interp.c b/byterun/interp.c
+index b99ed2f..af9fa0f 100644
+--- a/byterun/interp.c
++++ b/byterun/interp.c
+@@ -173,6 +173,12 @@ sp is a local copy of the global variable caml_extern_sp. */
+ #define SP_REG asm("%r14")
+ #define ACCU_REG asm("%r13")
+ #endif
++#ifdef __aarch64__
++#define PC_REG asm("%x19")
++#define SP_REG asm("%x20")
++#define ACCU_REG asm("%x21")
++#define JUMPTBL_BASE_REG asm("%x22")
++#endif
+ #endif
+
+ /* Division and modulus madness */
+diff --git a/configure b/configure
+index 9b02664..36edfab 100755
+--- a/configure
++++ b/configure
+@@ -657,6 +657,7 @@ if test $withsharedlibs = "yes"; then
+ x86_64-*-netbsd*) natdynlink=true;;
+ i386-*-gnu0.3) natdynlink=true;;
+ arm*-*-linux*) natdynlink=true;;
++ aarch64-*-linux*) natdynlink=true;;
+ esac
+ fi
+
+@@ -715,6 +716,7 @@ case "$host" in
+ x86_64-*-netbsd*) arch=amd64; system=netbsd;;
+ x86_64-*-openbsd*) arch=amd64; system=openbsd;;
+ x86_64-*-darwin*) arch=amd64; system=macosx;;
++ aarch64-*-linux*) arch=arm64; system=linux;;
+ esac
+
+ # Some platforms exist both in 32-bit and 64-bit variants, not distinguished
+@@ -767,7 +769,7 @@ case "$arch,$model,$system" in
+ aspp='gcc -m64 -c';;
+ amd64,*,*) as='as'
+ aspp='gcc -c';;
+- arm,*,*) as='as';
++ arm,*,*|arm64,*,*)as='as';
+ aspp='gcc -c';;
+ i386,*,solaris) as='as'
+ aspp='/usr/ccs/bin/as -P';;
+@@ -1193,6 +1195,7 @@ case "$arch" in
+ fi;;
+ power) bng_arch=ppc; bng_asm_level=1;;
+ amd64) bng_arch=amd64; bng_asm_level=1;;
++ arm64) bng_arch=arm64; bng_asm_level=1;;
+ *) bng_arch=generic; bng_asm_level=0;;
+ esac
+
+diff --git a/otherlibs/num/bng.c b/otherlibs/num/bng.c
+index 5bbedb0..0483ef5 100644
+--- a/otherlibs/num/bng.c
++++ b/otherlibs/num/bng.c
+@@ -23,12 +23,10 @@
+ #include "bng_amd64.c"
+ #elif defined(BNG_ARCH_ppc)
+ #include "bng_ppc.c"
+-#elif defined (BNG_ARCH_alpha)
+-#include "bng_alpha.c"
+ #elif defined (BNG_ARCH_sparc)
+ #include "bng_sparc.c"
+-#elif defined (BNG_ARCH_mips)
+-#include "bng_mips.c"
++#elif defined (BNG_ARCH_arm64)
++#include "bng_arm64.c"
+ #endif
+ #endif
+
+diff --git a/otherlibs/num/bng_arm64.c b/otherlibs/num/bng_arm64.c
+new file mode 100644
+index 0000000..50843a0
+--- /dev/null
++++ b/otherlibs/num/bng_arm64.c
+@@ -0,0 +1,20 @@
++/***********************************************************************/
++/* */
++/* OCaml */
++/* */
++/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */
++/* */
++/* Copyright 2013 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. */
++/* */
++/***********************************************************************/
++
++/* Code specific for the ARM 64 (AArch64) architecture */
++
++#define BngMult(resh,resl,arg1,arg2) \
++ asm("mul %0, %2, %3 \n\t" \
++ "umulh %1, %2, %3" \
++ : "=&r" (resl), "=&r" (resh) \
++ : "r" (arg1), "r" (arg2))
+diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile
+index fd01d33..9dca023 100644
+--- a/testsuite/tests/asmcomp/Makefile
++++ b/testsuite/tests/asmcomp/Makefile
+@@ -126,7 +126,7 @@ parsecmm.mli parsecmm.ml: parsecmm.mly
+ lexcmm.ml: lexcmm.mll
+ @$(OCAMLLEX) -q lexcmm.mll
+
+-CASES=fib tak quicksort quicksort2 soli \
++CASES=fib tak quicksort quicksort2 soli integr \
+ arith checkbound tagged-fib tagged-integr tagged-quicksort tagged-tak
+ ARGS_fib=-DINT_INT -DFUN=fib main.c
+ ARGS_tak=-DUNIT_INT -DFUN=takmain main.c
+diff --git a/testsuite/tests/asmcomp/arm64.S b/testsuite/tests/asmcomp/arm64.S
+new file mode 100644
+index 0000000..3bb4110
+--- /dev/null
++++ b/testsuite/tests/asmcomp/arm64.S
+@@ -0,0 +1,52 @@
++/***********************************************************************/
++/* */
++/* OCaml */
++/* */
++/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */
++/* */
++/* Copyright 2013 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. */
++/* */
++/***********************************************************************/
++
++ .globl call_gen_code
++ .align 2
++call_gen_code:
++ /* Set up stack frame and save callee-save registers */
++ stp x29, x30, [sp, -160]!
++ add x29, sp, #0
++ stp x19, x20, [sp, 16]
++ stp x21, x22, [sp, 32]
++ stp x23, x24, [sp, 48]
++ stp x25, x26, [sp, 64]
++ stp x27, x28, [sp, 80]
++ stp d8, d9, [sp, 96]
++ stp d10, d11, [sp, 112]
++ stp d12, d13, [sp, 128]
++ stp d14, d15, [sp, 144]
++ /* Shuffle arguments */
++ mov x8, x0
++ mov x0, x1
++ mov x1, x2
++ mov x2, x3
++ mov x3, x4
++ /* Call generated asm */
++ blr x8
++ /* Reload callee-save registers and return address */
++ ldp x19, x20, [sp, 16]
++ ldp x21, x22, [sp, 32]
++ ldp x23, x24, [sp, 48]
++ ldp x25, x26, [sp, 64]
++ ldp x27, x28, [sp, 80]
++ ldp d8, d9, [sp, 96]
++ ldp d10, d11, [sp, 112]
++ ldp d12, d13, [sp, 128]
++ ldp d14, d15, [sp, 144]
++ ldp x29, x30, [sp], 160
++ ret
++
++ .globl caml_c_call
++ .align 2
++caml_c_call:
++ br x15
+diff --git a/testsuite/tests/asmcomp/main.ml b/testsuite/tests/asmcomp/main.ml
+index d67a643..82b699e 100644
+--- a/testsuite/tests/asmcomp/main.ml
++++ b/testsuite/tests/asmcomp/main.ml
+@@ -13,6 +13,7 @@
+ open Clflags
+
+ let compile_file filename =
++ Clflags.dlcode := false;
+ Compilenv.reset "test";
+ Emit.begin_assembly();
+ let ic = open_in filename in
+--
+1.8.4.2
+
diff --git a/0010-Updated-with-latest-versions-from-FSF.patch b/0010-Updated-with-latest-versions-from-FSF.patch
new file mode 100644
index 0000000..fd1e923
--- /dev/null
+++ b/0010-Updated-with-latest-versions-from-FSF.patch
@@ -0,0 +1,716 @@
+From d36a95566c96d93280bf1439acc65ce7d4d159d0 Mon Sep 17 00:00:00 2001
+From: Xavier Leroy <xavier.leroy at inria.fr>
+Date: Thu, 18 Jul 2013 16:07:25 +0000
+Subject: [PATCH 10/11] Updated with latest versions from FSF.
+
+git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13907 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
+(cherry picked from commit 24bb4caeb35e49126aa3a4c0101a412db1091213)
+---
+ config/gnu/config.guess | 196 ++++++++++++++++++++++++++++--------------------
+ config/gnu/config.sub | 117 +++++++++++++++++------------
+ 2 files changed, 183 insertions(+), 130 deletions(-)
+
+diff --git a/config/gnu/config.guess b/config/gnu/config.guess
+index 8152efd..b79252d 100755
+--- a/config/gnu/config.guess
++++ b/config/gnu/config.guess
+@@ -1,14 +1,12 @@
+ #! /bin/sh
+ # Attempt to guess a canonical system name.
+-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+-# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+-# 2011 Free Software Foundation, Inc.
++# Copyright 1992-2013 Free Software Foundation, Inc.
+
+-timestamp='2011-11-11'
++timestamp='2013-06-10'
+
+ # This file is free software; you can redistribute it and/or modify it
+ # under the terms of the GNU General Public License as published by
+-# the Free Software Foundation; either version 2 of the License, or
++# the Free Software Foundation; either version 3 of the License, or
+ # (at your option) any later version.
+ #
+ # This program is distributed in the hope that it will be useful, but
+@@ -17,26 +15,22 @@ timestamp='2011-11-11'
+ # General Public License for more details.
+ #
+ # You should have received a copy of the GNU General Public License
+-# along with this program; if not, write to the Free Software
+-# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
+-# 02110-1301, USA.
++# along with this program; if not, see <http://www.gnu.org/licenses/>.
+ #
+ # As a special exception to the GNU General Public License, if you
+ # distribute this file as part of a program that contains a
+ # configuration script generated by Autoconf, you may include it under
+-# the same distribution terms that you use for the rest of that program.
+-
+-
+-# Originally written by Per Bothner. Please send patches (context
+-# diff format) to <config-patches at gnu.org> and include a ChangeLog
+-# entry.
++# the same distribution terms that you use for the rest of that
++# program. This Exception is an additional permission under section 7
++# of the GNU General Public License, version 3 ("GPLv3").
+ #
+-# This script attempts to guess a canonical system name similar to
+-# config.sub. If it succeeds, it prints the system name on stdout, and
+-# exits with 0. Otherwise, it exits with 1.
++# Originally written by Per Bothner.
+ #
+ # You can get the latest version of this script from:
+ # http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
++#
++# Please send patches with a ChangeLog entry to config-patches at gnu.org.
++
+
+ me=`echo "$0" | sed -e 's,.*/,,'`
+
+@@ -56,9 +50,7 @@ version="\
+ GNU config.guess ($timestamp)
+
+ Originally written by Per Bothner.
+-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+-2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free
+-Software Foundation, Inc.
++Copyright 1992-2013 Free Software Foundation, Inc.
+
+ This is free software; see the source for copying conditions. There is NO
+ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+@@ -140,12 +132,33 @@ UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+ UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
+ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
++case "${UNAME_SYSTEM}" in
++Linux|GNU|GNU/*)
++ # If the system lacks a compiler, then just pick glibc.
++ # We could probably try harder.
++ LIBC=gnu
++
++ eval $set_cc_for_build
++ cat <<-EOF > $dummy.c
++ #include <features.h>
++ #if defined(__UCLIBC__)
++ LIBC=uclibc
++ #elif defined(__dietlibc__)
++ LIBC=dietlibc
++ #else
++ LIBC=gnu
++ #endif
++ EOF
++ eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'`
++ ;;
++esac
++
+ # Note: order is significant - the case branches are not exclusive.
+
+ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+ *:NetBSD:*:*)
+ # NetBSD (nbsd) targets should (where applicable) match one or
+- # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*,
++ # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,
+ # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently
+ # switched to ELF, *-*-netbsd* would select the old
+ # object file format. This provides both forward
+@@ -202,6 +215,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+ # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
+ echo "${machine}-${os}${release}"
+ exit ;;
++ *:Bitrig:*:*)
++ UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
++ echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE}
++ exit ;;
+ *:OpenBSD:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
+ echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
+@@ -304,7 +321,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+ arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+ echo arm-acorn-riscix${UNAME_RELEASE}
+ exit ;;
+- arm:riscos:*:*|arm:RISCOS:*:*)
++ arm*:riscos:*:*|arm*:RISCOS:*:*)
+ echo arm-unknown-riscos
+ exit ;;
+ SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
+@@ -803,6 +820,9 @@ EOF
+ i*:CYGWIN*:*)
+ echo ${UNAME_MACHINE}-pc-cygwin
+ exit ;;
++ *:MINGW64*:*)
++ echo ${UNAME_MACHINE}-pc-mingw64
++ exit ;;
+ *:MINGW*:*)
+ echo ${UNAME_MACHINE}-pc-mingw32
+ exit ;;
+@@ -854,15 +874,22 @@ EOF
+ exit ;;
+ *:GNU:*:*)
+ # the GNU system
+- echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
++ echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+ exit ;;
+ *:GNU/*:*:*)
+ # other systems with GNU libc and userland
+- echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu
++ echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC}
+ exit ;;
+ i*86:Minix:*:*)
+ echo ${UNAME_MACHINE}-pc-minix
+ exit ;;
++ aarch64:Linux:*:*)
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
++ exit ;;
++ aarch64_be:Linux:*:*)
++ UNAME_MACHINE=aarch64_be
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
++ exit ;;
+ alpha:Linux:*:*)
+ case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
+ EV5) UNAME_MACHINE=alphaev5 ;;
+@@ -874,59 +901,54 @@ EOF
+ EV68*) UNAME_MACHINE=alphaev68 ;;
+ esac
+ objdump --private-headers /bin/sh | grep -q ld.so.1
+- if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
+- echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
++ if test "$?" = 0 ; then LIBC="gnulibc1" ; fi
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
++ exit ;;
++ arc:Linux:*:* | arceb:Linux:*:*)
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ arm*:Linux:*:*)
+ eval $set_cc_for_build
+ if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_EABI__
+ then
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ else
+ if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_PCS_VFP
+ then
+- echo ${UNAME_MACHINE}-unknown-linux-gnueabi
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi
+ else
+- echo ${UNAME_MACHINE}-unknown-linux-gnueabihf
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf
+ fi
+ fi
+ exit ;;
+ avr32*:Linux:*:*)
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ cris:Linux:*:*)
+- echo cris-axis-linux-gnu
++ echo ${UNAME_MACHINE}-axis-linux-${LIBC}
+ exit ;;
+ crisv32:Linux:*:*)
+- echo crisv32-axis-linux-gnu
++ echo ${UNAME_MACHINE}-axis-linux-${LIBC}
+ exit ;;
+ frv:Linux:*:*)
+- echo frv-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ hexagon:Linux:*:*)
+- echo hexagon-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ i*86:Linux:*:*)
+- LIBC=gnu
+- eval $set_cc_for_build
+- sed 's/^ //' << EOF >$dummy.c
+- #ifdef __dietlibc__
+- LIBC=dietlibc
+- #endif
+-EOF
+- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'`
+- echo "${UNAME_MACHINE}-pc-linux-${LIBC}"
++ echo ${UNAME_MACHINE}-pc-linux-${LIBC}
+ exit ;;
+ ia64:Linux:*:*)
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ m32r*:Linux:*:*)
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ m68*:Linux:*:*)
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ mips:Linux:*:* | mips64:Linux:*:*)
+ eval $set_cc_for_build
+@@ -945,54 +967,63 @@ EOF
+ #endif
+ EOF
+ eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'`
+- test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
++ test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; }
+ ;;
++ or1k:Linux:*:*)
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
++ exit ;;
+ or32:Linux:*:*)
+- echo or32-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ padre:Linux:*:*)
+- echo sparc-unknown-linux-gnu
++ echo sparc-unknown-linux-${LIBC}
+ exit ;;
+ parisc64:Linux:*:* | hppa64:Linux:*:*)
+- echo hppa64-unknown-linux-gnu
++ echo hppa64-unknown-linux-${LIBC}
+ exit ;;
+ parisc:Linux:*:* | hppa:Linux:*:*)
+ # Look for CPU level
+ case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+- PA7*) echo hppa1.1-unknown-linux-gnu ;;
+- PA8*) echo hppa2.0-unknown-linux-gnu ;;
+- *) echo hppa-unknown-linux-gnu ;;
++ PA7*) echo hppa1.1-unknown-linux-${LIBC} ;;
++ PA8*) echo hppa2.0-unknown-linux-${LIBC} ;;
++ *) echo hppa-unknown-linux-${LIBC} ;;
+ esac
+ exit ;;
+ ppc64:Linux:*:*)
+- echo powerpc64-unknown-linux-gnu
++ echo powerpc64-unknown-linux-${LIBC}
+ exit ;;
+ ppc:Linux:*:*)
+- echo powerpc-unknown-linux-gnu
++ echo powerpc-unknown-linux-${LIBC}
++ exit ;;
++ ppc64le:Linux:*:*)
++ echo powerpc64le-unknown-linux-${LIBC}
++ exit ;;
++ ppcle:Linux:*:*)
++ echo powerpcle-unknown-linux-${LIBC}
+ exit ;;
+ s390:Linux:*:* | s390x:Linux:*:*)
+- echo ${UNAME_MACHINE}-ibm-linux
++ echo ${UNAME_MACHINE}-ibm-linux-${LIBC}
+ exit ;;
+ sh64*:Linux:*:*)
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ sh*:Linux:*:*)
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ sparc:Linux:*:* | sparc64:Linux:*:*)
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ tile*:Linux:*:*)
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ vax:Linux:*:*)
+- echo ${UNAME_MACHINE}-dec-linux-gnu
++ echo ${UNAME_MACHINE}-dec-linux-${LIBC}
+ exit ;;
+ x86_64:Linux:*:*)
+- echo x86_64-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ xtensa*:Linux:*:*)
+- echo ${UNAME_MACHINE}-unknown-linux-gnu
++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+ exit ;;
+ i*86:DYNIX/ptx:4*:*)
+ # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
+@@ -1196,6 +1227,9 @@ EOF
+ BePC:Haiku:*:*) # Haiku running on Intel PC compatible.
+ echo i586-pc-haiku
+ exit ;;
++ x86_64:Haiku:*:*)
++ echo x86_64-unknown-haiku
++ exit ;;
+ SX-4:SUPER-UX:*:*)
+ echo sx4-nec-superux${UNAME_RELEASE}
+ exit ;;
+@@ -1222,19 +1256,21 @@ EOF
+ exit ;;
+ *:Darwin:*:*)
+ UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
+- case $UNAME_PROCESSOR in
+- i386)
+- eval $set_cc_for_build
+- if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
+- if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
+- (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
+- grep IS_64BIT_ARCH >/dev/null
+- then
+- UNAME_PROCESSOR="x86_64"
+- fi
+- fi ;;
+- unknown) UNAME_PROCESSOR=powerpc ;;
+- esac
++ eval $set_cc_for_build
++ if test "$UNAME_PROCESSOR" = unknown ; then
++ UNAME_PROCESSOR=powerpc
++ fi
++ if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
++ if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
++ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
++ grep IS_64BIT_ARCH >/dev/null
++ then
++ case $UNAME_PROCESSOR in
++ i386) UNAME_PROCESSOR=x86_64 ;;
++ powerpc) UNAME_PROCESSOR=powerpc64 ;;
++ esac
++ fi
++ fi
+ echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}
+ exit ;;
+ *:procnto*:*:* | *:QNX:[0123456789]*:*)
+@@ -1251,7 +1287,7 @@ EOF
+ NEO-?:NONSTOP_KERNEL:*:*)
+ echo neo-tandem-nsk${UNAME_RELEASE}
+ exit ;;
+- NSE-?:NONSTOP_KERNEL:*:*)
++ NSE-*:NONSTOP_KERNEL:*:*)
+ echo nse-tandem-nsk${UNAME_RELEASE}
+ exit ;;
+ NSR-?:NONSTOP_KERNEL:*:*)
+@@ -1320,11 +1356,11 @@ EOF
+ i*86:AROS:*:*)
+ echo ${UNAME_MACHINE}-pc-aros
+ exit ;;
++ x86_64:VMkernel:*:*)
++ echo ${UNAME_MACHINE}-unknown-esx
++ exit ;;
+ esac
+
+-#echo '(No uname command or uname output not recognized.)' 1>&2
+-#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
+-
+ eval $set_cc_for_build
+ cat >$dummy.c <<EOF
+ #ifdef _SEQUENT_
+diff --git a/config/gnu/config.sub b/config/gnu/config.sub
+index e76eaf4..8b612ab 100755
+--- a/config/gnu/config.sub
++++ b/config/gnu/config.sub
+@@ -1,38 +1,31 @@
+ #! /bin/sh
+ # Configuration validation subroutine script.
+-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+-# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+-# 2011 Free Software Foundation, Inc.
++# Copyright 1992-2013 Free Software Foundation, Inc.
+
+-timestamp='2011-11-11'
++timestamp='2013-04-24'
+
+-# This file is (in principle) common to ALL GNU software.
+-# The presence of a machine in this file suggests that SOME GNU software
+-# can handle that machine. It does not imply ALL GNU software can.
+-#
+-# This file is free software; you can redistribute it and/or modify
+-# it under the terms of the GNU General Public License as published by
+-# the Free Software Foundation; either version 2 of the License, or
++# This file is free software; you can redistribute it and/or modify it
++# under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
+ # (at your option) any later version.
+ #
+-# This program is distributed in the hope that it will be useful,
+-# but WITHOUT ANY WARRANTY; without even the implied warranty of
+-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-# GNU General Public License for more details.
++# This program is distributed in the hope that it will be useful, but
++# WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
++# General Public License for more details.
+ #
+ # You should have received a copy of the GNU General Public License
+-# along with this program; if not, write to the Free Software
+-# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
+-# 02110-1301, USA.
++# along with this program; if not, see <http://www.gnu.org/licenses/>.
+ #
+ # As a special exception to the GNU General Public License, if you
+ # distribute this file as part of a program that contains a
+ # configuration script generated by Autoconf, you may include it under
+-# the same distribution terms that you use for the rest of that program.
++# the same distribution terms that you use for the rest of that
++# program. This Exception is an additional permission under section 7
++# of the GNU General Public License, version 3 ("GPLv3").
+
+
+-# Please send patches to <config-patches at gnu.org>. Submit a context
+-# diff and a properly formatted GNU ChangeLog entry.
++# Please send patches with a ChangeLog entry to config-patches at gnu.org.
+ #
+ # Configuration subroutine to validate and canonicalize a configuration type.
+ # Supply the specified configuration type as an argument.
+@@ -75,9 +68,7 @@ Report bugs and patches to <config-patches at gnu.org>."
+ version="\
+ GNU config.sub ($timestamp)
+
+-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+-2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free
+-Software Foundation, Inc.
++Copyright 1992-2013 Free Software Foundation, Inc.
+
+ This is free software; see the source for copying conditions. There is NO
+ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+@@ -125,13 +116,17 @@ esac
+ maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
+ case $maybe_os in
+ nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \
+- linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
++ linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
+ knetbsd*-gnu* | netbsd*-gnu* | \
+ kopensolaris*-gnu* | \
+ storm-chaos* | os2-emx* | rtmk-nova*)
+ os=-$maybe_os
+ basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
+ ;;
++ android-linux)
++ os=-linux-android
++ basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown
++ ;;
+ *)
+ basic_machine=`echo $1 | sed 's/-[^-]*$//'`
+ if [ $basic_machine != $1 ]
+@@ -154,7 +149,7 @@ case $os in
+ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
+- -apple | -axis | -knuth | -cray | -microblaze)
++ -apple | -axis | -knuth | -cray | -microblaze*)
+ os=
+ basic_machine=$1
+ ;;
+@@ -223,6 +218,12 @@ case $os in
+ -isc*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
++ -lynx*178)
++ os=-lynxos178
++ ;;
++ -lynx*5)
++ os=-lynxos5
++ ;;
+ -lynx*)
+ os=-lynxos
+ ;;
+@@ -247,11 +248,14 @@ case $basic_machine in
+ # Some are omitted here because they have special meanings below.
+ 1750a | 580 \
+ | a29k \
++ | aarch64 | aarch64_be \
+ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
+ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
+ | am33_2.0 \
+- | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \
+- | be32 | be64 \
++ | arc | arceb \
++ | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \
++ | avr | avr32 \
++ | be32 | be64 \
+ | bfin \
+ | c4x | clipper \
+ | d10v | d30v | dlx | dsp16xx \
+@@ -264,7 +268,7 @@ case $basic_machine in
+ | le32 | le64 \
+ | lm32 \
+ | m32c | m32r | m32rle | m68000 | m68k | m88k \
+- | maxq | mb | microblaze | mcore | mep | metag \
++ | maxq | mb | microblaze | microblazeel | mcore | mep | metag \
+ | mips | mipsbe | mipseb | mipsel | mipsle \
+ | mips16 \
+ | mips64 | mips64el \
+@@ -282,16 +286,17 @@ case $basic_machine in
+ | mipsisa64r2 | mipsisa64r2el \
+ | mipsisa64sb1 | mipsisa64sb1el \
+ | mipsisa64sr71k | mipsisa64sr71kel \
++ | mipsr5900 | mipsr5900el \
+ | mipstx39 | mipstx39el \
+ | mn10200 | mn10300 \
+ | moxie \
+ | mt \
+ | msp430 \
+ | nds32 | nds32le | nds32be \
+- | nios | nios2 \
++ | nios | nios2 | nios2eb | nios2el \
+ | ns16k | ns32k \
+ | open8 \
+- | or32 \
++ | or1k | or32 \
+ | pdp10 | pdp11 | pj | pjl \
+ | powerpc | powerpc64 | powerpc64le | powerpcle \
+ | pyramid \
+@@ -319,8 +324,7 @@ case $basic_machine in
+ c6x)
+ basic_machine=tic6x-unknown
+ ;;
+- m6811 | m68hc11 | m6812 | m68hc12 | picochip)
+- # Motorola 68HC11/12.
++ m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip)
+ basic_machine=$basic_machine-unknown
+ os=-none
+ ;;
+@@ -333,7 +337,10 @@ case $basic_machine in
+ strongarm | thumb | xscale)
+ basic_machine=arm-unknown
+ ;;
+-
++ xgate)
++ basic_machine=$basic_machine-unknown
++ os=-none
++ ;;
+ xscaleeb)
+ basic_machine=armeb-unknown
+ ;;
+@@ -356,9 +363,10 @@ case $basic_machine in
+ # Recognize the basic CPU types with company name.
+ 580-* \
+ | a29k-* \
++ | aarch64-* | aarch64_be-* \
+ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
+ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
+- | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \
++ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \
+ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \
+ | avr-* | avr32-* \
+ | be32-* | be64-* \
+@@ -377,7 +385,8 @@ case $basic_machine in
+ | lm32-* \
+ | m32c-* | m32r-* | m32rle-* \
+ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
+- | m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \
++ | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
++ | microblaze-* | microblazeel-* \
+ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
+ | mips16-* \
+ | mips64-* | mips64el-* \
+@@ -395,12 +404,13 @@ case $basic_machine in
+ | mipsisa64r2-* | mipsisa64r2el-* \
+ | mipsisa64sb1-* | mipsisa64sb1el-* \
+ | mipsisa64sr71k-* | mipsisa64sr71kel-* \
++ | mipsr5900-* | mipsr5900el-* \
+ | mipstx39-* | mipstx39el-* \
+ | mmix-* \
+ | mt-* \
+ | msp430-* \
+ | nds32-* | nds32le-* | nds32be-* \
+- | nios-* | nios2-* \
++ | nios-* | nios2-* | nios2eb-* | nios2el-* \
+ | none-* | np1-* | ns16k-* | ns32k-* \
+ | open8-* \
+ | orion-* \
+@@ -719,7 +729,6 @@ case $basic_machine in
+ i370-ibm* | ibm*)
+ basic_machine=i370-ibm
+ ;;
+-# I'm not sure what "Sysv32" means. Should this be sysv3.2?
+ i*86v32)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv32
+@@ -777,9 +786,13 @@ case $basic_machine in
+ basic_machine=ns32k-utek
+ os=-sysv
+ ;;
+- microblaze)
++ microblaze*)
+ basic_machine=microblaze-xilinx
+ ;;
++ mingw64)
++ basic_machine=x86_64-pc
++ os=-mingw64
++ ;;
+ mingw32)
+ basic_machine=i386-pc
+ os=-mingw32
+@@ -1008,7 +1021,11 @@ case $basic_machine in
+ basic_machine=i586-unknown
+ os=-pw32
+ ;;
+- rdos)
++ rdos | rdos64)
++ basic_machine=x86_64-pc
++ os=-rdos
++ ;;
++ rdos32)
+ basic_machine=i386-pc
+ os=-rdos
+ ;;
+@@ -1335,21 +1352,21 @@ case $os in
+ -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+ | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
+ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \
+- | -sym* | -kopensolaris* \
++ | -sym* | -kopensolaris* | -plan9* \
+ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
+ | -aos* | -aros* \
+ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \
+- | -openbsd* | -solidbsd* \
++ | -bitrig* | -openbsd* | -solidbsd* \
+ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
+ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
+ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+ | -chorusos* | -chorusrdb* | -cegcc* \
+ | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+- | -mingw32* | -linux-gnu* | -linux-android* \
+- | -linux-newlib* | -linux-uclibc* \
++ | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \
++ | -linux-newlib* | -linux-musl* | -linux-uclibc* \
+ | -uxpv* | -beos* | -mpeix* | -udk* \
+ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
+ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
+@@ -1481,9 +1498,6 @@ case $os in
+ -aros*)
+ os=-aros
+ ;;
+- -kaos*)
+- os=-kaos
+- ;;
+ -zvmoe)
+ os=-zvmoe
+ ;;
+@@ -1532,6 +1546,9 @@ case $basic_machine in
+ c4x-* | tic4x-*)
+ os=-coff
+ ;;
++ hexagon-*)
++ os=-elf
++ ;;
+ tic54x-*)
+ os=-coff
+ ;;
+@@ -1559,9 +1576,6 @@ case $basic_machine in
+ ;;
+ m68000-sun)
+ os=-sunos3
+- # This also exists in the configure program, but was not the
+- # default.
+- # os=-sunos4
+ ;;
+ m68*-cisco)
+ os=-aout
+@@ -1575,6 +1589,9 @@ case $basic_machine in
+ mips*-*)
+ os=-elf
+ ;;
++ or1k-*)
++ os=-elf
++ ;;
+ or32-*)
+ os=-coff
+ ;;
+--
+1.8.4.2
+
diff --git a/0011-Disable-ocamldoc-and-camlp4opt-aarch64-only.patch b/0011-Disable-ocamldoc-and-camlp4opt-aarch64-only.patch
new file mode 100644
index 0000000..085f6b2
--- /dev/null
+++ b/0011-Disable-ocamldoc-and-camlp4opt-aarch64-only.patch
@@ -0,0 +1,38 @@
+From 55f34d6a262a7e29172ad52ef2d6688ac2c02381 Mon Sep 17 00:00:00 2001
+From: "Richard W.M. Jones" <rjones at redhat.com>
+Date: Mon, 30 Dec 2013 20:32:03 +0000
+Subject: [PATCH 11/11] Disable ocamldoc and camlp4opt (aarch64 only)
+
+---
+ Makefile | 8 ++++----
+ 1 file changed, 4 insertions(+), 4 deletions(-)
+
+diff --git a/Makefile b/Makefile
+index 10c80d2..e0a7d9e 100644
+--- a/Makefile
++++ b/Makefile
+@@ -686,8 +686,8 @@ alldepend::
+ ocamldoc: ocamlc ocamlyacc ocamllex otherlibraries
+ cd ocamldoc && $(MAKE) all
+
+-ocamldoc.opt: ocamlc.opt ocamlyacc ocamllex
+- cd ocamldoc && $(MAKE) opt.opt
++#ocamldoc.opt: ocamlc.opt ocamlyacc ocamllex
++# cd ocamldoc && $(MAKE) opt.opt
+
+ partialclean::
+ cd ocamldoc && $(MAKE) clean
+@@ -734,8 +734,8 @@ alldepend::
+ camlp4out: ocamlc ocamlbuild.byte
+ ./build/camlp4-byte-only.sh
+
+-camlp4opt: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot ocamlbuild.native
+- ./build/camlp4-native-only.sh
++#camlp4opt: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot ocamlbuild.native
++# ./build/camlp4-native-only.sh
+
+ # Ocamlbuild
+ #ifeq ($(OCAMLBUILD_NOBOOT),"yes")
+--
+1.8.4.2
+
diff --git a/ocaml.spec b/ocaml.spec
index 5a89ab9..1f4cdac 100644
--- a/ocaml.spec
+++ b/ocaml.spec
@@ -1,6 +1,6 @@
Name: ocaml
Version: 4.01.0
-Release: 4%{?dist}
+Release: 5%{?dist}
Summary: OCaml compiler and programming environment
@@ -35,7 +35,14 @@ Patch0006: 0006-Add-support-for-ppc64.patch
Patch0007: 0007-yacc-Use-mkstemp-instead-of-mktemp.patch
# NON-upstream patch to allow '--flag=arg' as an alternative to '--flag arg'.
-Patch0008: 0001-stdlib-arg-Allow-flags-such-as-flag-arg-as-well-as-f.patch
+Patch0008: 0008-stdlib-arg-Allow-flags-such-as-flag-arg-as-well-as-f.patch
+
+# Aarch64 patches.
+%ifarch aarch64
+Patch0009: 0009-Port-to-the-ARM-64-bits-AArch64-architecture-experim.patch
+Patch0010: 0010-Updated-with-latest-versions-from-FSF.patch
+Patch0011: 0011-Disable-ocamldoc-and-camlp4opt-aarch64-only.patch
+%endif
BuildRequires: ncurses-devel
BuildRequires: gdbm-devel
@@ -71,7 +78,7 @@ Provides: ocaml(compiler) = %{version}
# We can compile OCaml on just about anything, but the native code
# backend is only available on a subset of architectures.
-ExclusiveArch: alpha %{arm} ia64 %{ix86} x86_64 ppc ppc64 sparc sparcv9
+ExclusiveArch: aarch64 alpha %{arm} ia64 %{ix86} x86_64 ppc ppc64 sparc sparcv9
%ifarch %{arm} %{ix86} ppc ppc64 sparc sparcv9 x86_64
%global native_compiler 1
@@ -357,6 +364,9 @@ fi
%{_bindir}/ocamlopt.opt
%{_bindir}/ocamloptp
%endif
+%ifarch aarch64
+%{_bindir}/ocamloptp
+%endif
#%{_bindir}/ocamlplugininfo
%{_bindir}/ocamlprof
%{_bindir}/ocamlyacc
@@ -505,6 +515,9 @@ fi
%if %{native_compiler}
%{_mandir}/man3/*
%endif
+%ifarch aarch64
+%{_mandir}/man3/*
+%endif
%files emacs
@@ -528,6 +541,9 @@ fi
%changelog
+* Mon Dec 30 2013 Richard W.M. Jones <rjones at redhat.com> - 4.01.0-5
+- Add aarch64 (arm64) code generator.
+
* Thu Nov 21 2013 Richard W.M. Jones <rjones at redhat.com> - 4.01.0-4
- Add bundled(md5-plumb) (thanks: Tomas Mraz).
- Add NON-upstream (but being sent upstream) patch to allow --flag=arg
More information about the scm-commits
mailing list