The package rpms/ocaml.git has added or updated architecture specific content in its
spec file (ExclusiveArch/ExcludeArch or %ifarch/%ifnarch) in commit(s):
https://src.fedoraproject.org/cgit/rpms/ocaml.git/commit/?id=5f905fc18702....
Change:
-%ifnarch %{no_parallel_build_arches}
Thanks.
Full change:
============
commit 5f905fc1870232f76470782832c3f236f7d094a4
Author: Richard W.M. Jones <rjones(a)redhat.com>
Date: Sat Aug 5 16:19:56 2017 +0100
- New upstream version 4.05.0.
- Disable parallel builds for now.
- *.mli files are now included in ocaml-compiler-libs.
- Add possible fix for aarch64 with new binutils.
diff --git a/0001-Changes-clarify-compatibility-breaking-change-items.patch
b/0001-Changes-clarify-compatibility-breaking-change-items.patch
new file mode 100644
index 0000000..21dd4c2
--- /dev/null
+++ b/0001-Changes-clarify-compatibility-breaking-change-items.patch
@@ -0,0 +1,36 @@
+From 5bd96201dbd70c387c5af4b510d0de4abc0cfd7d Mon Sep 17 00:00:00 2001
+From: Gabriel Scherer <gabriel.scherer(a)gmail.com>
+Date: Wed, 12 Jul 2017 11:57:22 -0400
+Subject: [PATCH 01/12] Changes: clarify compatibility-breaking change items
+
+---
+ Changes | 6 ++++++
+ 1 file changed, 6 insertions(+)
+
+diff --git a/Changes b/Changes
+index cc59f635e..10642f19d 100644
+--- a/Changes
++++ b/Changes
+@@ -64,6 +64,9 @@ OCaml 4.05.0 (13 Jul 2017):
+
+ * MPR#7414, GPR#929: Soundness bug with non-generalized type variables and
+ functors.
++ (compatibility: some code using module-global mutable state will
++ fail at compile-time and is fixed by adding extra annotations;
++ see the Mantis and Github discussions.)
+ (Jacques Garrigue, report by Leo White)
+
+ ### Compiler user-interface and warnings:
+@@ -567,6 +570,9 @@ The complete list of changes is listed below.
+ (Mark Shinwell, Leo White, review by Xavier Leroy)
+
+ * GPR#1088: Gc.minor_words now returns accurate numbers.
++ (compatibility: the .mli declaration of `Gc.minor_words`
++ and `Gc.get_minor_free` changed, which may break libraries
++ re-exporting these values.)
+ (Stephen Dolan, review by Pierre Chambart and Xavier Leroy)
+
+ OCaml 4.04.2 (23 Jun 2017):
+--
+2.13.1
+
diff --git a/0001-Don-t-add-rpaths-to-libraries.patch
b/0001-Don-t-add-rpaths-to-libraries.patch
deleted file mode 100644
index 4b2f713..0000000
--- a/0001-Don-t-add-rpaths-to-libraries.patch
+++ /dev/null
@@ -1,29 +0,0 @@
-From ff87e5c4252e5545e50fff0a2e7c10b813c02ec2 Mon Sep 17 00:00:00 2001
-From: "Richard W.M. Jones" <rjones(a)redhat.com>
-Date: Tue, 24 Jun 2014 10:00:15 +0100
-Subject: [PATCH 1/9] Don't add rpaths to libraries.
-
----
- tools/Makefile.shared | 6 +++---
- 1 file changed, 3 insertions(+), 3 deletions(-)
-
-diff --git a/tools/Makefile.shared b/tools/Makefile.shared
-index a873bdd98..ba263b88f 100644
---- a/tools/Makefile.shared
-+++ b/tools/Makefile.shared
-@@ -154,9 +154,9 @@ $(call byte_and_opt,ocamlmklib,ocamlmklibconfig.cmo config.cmo
misc.cmo \
- ocamlmklibconfig.ml: ../config/Makefile Makefile
- (echo 'let bindir = "$(BINDIR)"'; \
- echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\
-- echo 'let byteccrpath = "$(BYTECCRPATH)"'; \
-- echo 'let nativeccrpath = "$(NATIVECCRPATH)"'; \
-- echo 'let mksharedlibrpath = "$(MKSHAREDLIBRPATH)"'; \
-+ echo 'let byteccrpath = ""'; \
-+ echo 'let nativeccrpath = ""'; \
-+ echo 'let mksharedlibrpath = ""'; \
- echo 'let toolpref = "$(TOOLPREF)"'; \
- sed -n -e 's/^#ml //p' ../config/Makefile) \
- > ocamlmklibconfig.ml
---
-2.13.1
-
diff --git a/0002-MPR-7591-frametable-not-8-aligned-on-x86-64-port.patch
b/0002-MPR-7591-frametable-not-8-aligned-on-x86-64-port.patch
new file mode 100644
index 0000000..35c6b13
--- /dev/null
+++ b/0002-MPR-7591-frametable-not-8-aligned-on-x86-64-port.patch
@@ -0,0 +1,44 @@
+From 22dbcdfb921b19d171134de90984805622877e55 Mon Sep 17 00:00:00 2001
+From: Xavier Leroy <xavier.leroy(a)inria.fr>
+Date: Sat, 22 Jul 2017 16:32:23 -0400
+Subject: [PATCH 02/12] MPR#7591: frametable not 8-aligned on x86-64 port
+
+Cherry-pick of 7077b60 from trunk.
+---
+ Changes | 7 +++++++
+ asmcomp/amd64/emit.mlp | 3 ++-
+ 2 files changed, 9 insertions(+), 1 deletion(-)
+
+diff --git a/Changes b/Changes
+index 10642f19d..cc7e0a82f 100644
+--- a/Changes
++++ b/Changes
+@@ -1,3 +1,10 @@
++Working 4.05.x branch
++---------------------
++
++- MPR#7591, GPR#1257: on x86-64, frame table is not 8-aligned
++ (Xavier Leroy, report by Mantis user "voglerr", review by Gabriel Scherer)
++
++
+ OCaml 4.05.0 (13 Jul 2017):
+ ---------------------------
+
+diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
+index c3f8692a8..75a785f74 100644
+--- a/asmcomp/amd64/emit.mlp
++++ b/asmcomp/amd64/emit.mlp
+@@ -1065,8 +1065,9 @@ let end_assembly() =
+
+ D.data ();
+ emit_global_label "data_end";
+- D.long (const 0);
++ D.qword (const 0);
+
++ D.align 8; (* PR#7591 *)
+ emit_global_label "frametable";
+
+ let setcnt = ref 0 in
+--
+2.13.1
+
diff --git a/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
b/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
deleted file mode 100644
index 367c9d7..0000000
--- a/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
+++ /dev/null
@@ -1,240 +0,0 @@
-From c047077c1c8a2acdc1d9bfe502c1a9b910ac3b9d Mon Sep 17 00:00:00 2001
-From: "Richard W.M. Jones" <rjones(a)redhat.com>
-Date: Tue, 29 May 2012 20:40:36 +0100
-Subject: [PATCH 2/9] ocamlbyteinfo, ocamlplugininfo: Useful utilities from
- Debian, sent upstream.
-
-See:
-http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD
----
- ocamlbyteinfo.ml | 101 +++++++++++++++++++++++++++++++++++++++++++++++++
- ocamlplugininfo.ml | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++
- 2 files changed, 210 insertions(+)
- create mode 100644 ocamlbyteinfo.ml
- create mode 100644 ocamlplugininfo.ml
-
-diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml
-new file mode 100644
-index 000000000..eb9a293e3
---- /dev/null
-+++ b/ocamlbyteinfo.ml
-@@ -0,0 +1,101 @@
-+(***********************************************************************)
-+(* *)
-+(* Objective Caml *)
-+(* *)
-+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
-+(* *)
-+(* Copyright 2009 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. *)
-+(* *)
-+(***********************************************************************)
-+
-+(* $Id$ *)
-+
-+(* Dumps a bytecode binary file *)
-+
-+open Sys
-+open Dynlinkaux
-+
-+let input_stringlist ic len =
-+ let get_string_list sect len =
-+ let rec fold s e acc =
-+ if e != len then
-+ if sect.[e] = '\000' then
-+ fold (e+1) (e+1) (String.sub sect s (e-s) :: acc)
-+ else fold s (e+1) acc
-+ else acc
-+ in fold 0 0 []
-+ in
-+ let sect = String.create len in
-+ let _ = really_input ic sect 0 len in
-+ get_string_list sect len
-+
-+let print = Printf.printf
-+let perr s =
-+ Printf.eprintf "%s\n" s;
-+ exit(1)
-+let p_title title = print "%s:\n" title
-+
-+let p_section title format pdata = function
-+ | [] -> ()
-+ | l ->
-+ p_title title;
-+ List.iter
-+ (fun (name, data) -> print format (pdata data) name)
-+ l
-+
-+let p_list title format = function
-+ | [] -> ()
-+ | l ->
-+ p_title title;
-+ List.iter
-+ (fun name -> print format name)
-+ l
-+
-+let _ =
-+ try
-+ let input_name = Sys.argv.(1) in
-+ let ic = open_in_bin input_name in
-+ Bytesections.read_toc ic;
-+ List.iter
-+ (fun section ->
-+ try
-+ let len = Bytesections.seek_section ic section in
-+ if len > 0 then match section with
-+ | "CRCS" ->
-+ p_section
-+ "Imported Units"
-+ "\t%s\t%s\n"
-+ Digest.to_hex
-+ (input_value ic : (string * Digest.t) list)
-+ | "DLLS" ->
-+ p_list
-+ "Used Dlls" "\t%s\n"
-+ (input_stringlist ic len)
-+ | "DLPT" ->
-+ p_list
-+ "Additional Dll paths"
-+ "\t%s\n"
-+ (input_stringlist ic len)
-+ | "PRIM" ->
-+ let prims = (input_stringlist ic len) in
-+ print "Uses unsafe features: ";
-+ begin match prims with
-+ [] -> print "no\n"
-+ | l -> print "YES\n";
-+ p_list "Primitives declared in this module"
-+ "\t%s\n"
-+ l
-+ end
-+ | _ -> ()
-+ with Not_found | Failure _ | Invalid_argument _ -> ()
-+ )
-+ ["CRCS"; "DLLS"; "DLPT"; "PRIM"];
-+ close_in ic
-+ with
-+ | Sys_error msg ->
-+ perr msg
-+ | Invalid_argument("index out of bounds") ->
-+ perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0))
-diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml
-new file mode 100644
-index 000000000..e28800f31
---- /dev/null
-+++ b/ocamlplugininfo.ml
-@@ -0,0 +1,109 @@
-+(***********************************************************************)
-+(* *)
-+(* Objective Caml *)
-+(* *)
-+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
-+(* *)
-+(* Copyright 2009 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. *)
-+(* *)
-+(***********************************************************************)
-+
-+(* $Id$ *)
-+
-+(* Dumps a .cmxs file *)
-+
-+open Natdynlink
-+open Format
-+
-+let file =
-+ try
-+ Sys.argv.(1)
-+ with _ -> begin
-+ Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0);
-+ exit(1)
-+ end
-+
-+exception Abnormal_exit
-+
-+let error s e =
-+ let eprint = Printf.eprintf in
-+ let print_exc s = function
-+ | End_of_file ->
-+ eprint "%s: %s\n" s file
-+ | Abnormal_exit ->
-+ eprint "%s\n" s
-+ | e -> eprint "%s\n" (Printexc.to_string e)
-+ in
-+ print_exc s e;
-+ exit(1)
-+
-+let read_in command =
-+ let cmd = Printf.sprintf command file in
-+ let ic = Unix.open_process_in cmd in
-+ try
-+ let line = input_line ic in
-+ begin match (Unix.close_process_in ic) with
-+ | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line
-+ | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
-+ error
-+ (Printf.sprintf
-+ "Command \"%s\" exited abnormally"
-+ cmd
-+ )
-+ Abnormal_exit
-+ end
-+ with e -> error "File is empty" e
-+
-+let get_offset adr_off adr_sec =
-+ try
-+ let adr = List.nth adr_off 4 in
-+ let off = List.nth adr_off 5 in
-+ let sec = List.hd adr_sec in
-+
-+ let (!) x = Int64.of_string ("0x" ^ x) in
-+ let (+) = Int64.add in
-+ let (-) = Int64.sub in
-+
-+ Int64.to_int (!off + !sec - !adr)
-+
-+ with Failure _ | Invalid_argument _ ->
-+ error
-+ "Command output doesn't have the expected format"
-+ Abnormal_exit
-+
-+let print_infos name crc defines cmi cmx =
-+ let print_name_crc (name, crc) =
-+ printf "@ %s (%s)" name (Digest.to_hex crc)
-+ in
-+ let pr_imports ppf imps = List.iter print_name_crc imps in
-+ printf "Name: %s@." name;
-+ printf "CRC of implementation: %s@." (Digest.to_hex crc);
-+ printf "@[<hov 2>Globals defined:";
-+ List.iter (fun s -> printf "@ %s" s) defines;
-+ printf "@]@.";
-+ printf "@[<v 2>Interfaces imported:%a@]@." pr_imports cmi;
-+ printf "@[<v 2>Implementations imported:%a@]@." pr_imports cmx
-+
-+let _ =
-+ let adr_off = read_in "objdump -h %s | grep ' .data '" in
-+ let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'"
in
-+
-+ let ic = open_in file in
-+ let _ = seek_in ic (get_offset adr_off adr_sec) in
-+ let header = (input_value ic : Natdynlink.dynheader) in
-+ if header.magic <> Natdynlink.dyn_magic_number then
-+ raise(Error(Natdynlink.Not_a_bytecode_file file))
-+ else begin
-+ List.iter
-+ (fun ui ->
-+ print_infos
-+ ui.name
-+ ui.crc
-+ ui.defines
-+ ui.imports_cmi
-+ ui.imports_cmx)
-+ header.units
-+ end
---
-2.13.1
-
diff --git a/0003-Fixes-for-out-of-range-Ialloc.patch
b/0003-Fixes-for-out-of-range-Ialloc.patch
new file mode 100644
index 0000000..00ecf58
--- /dev/null
+++ b/0003-Fixes-for-out-of-range-Ialloc.patch
@@ -0,0 +1,409 @@
+From 664f0763d37f85e2ec53d6394251b5948dcfa727 Mon Sep 17 00:00:00 2001
+From: Mark Shinwell <mshinwell(a)janestreet.com>
+Date: Mon, 31 Jul 2017 14:37:47 +0100
+Subject: [PATCH 03/12] Fixes for out-of-range Ialloc
+
+Cherry-pick of GPR#1271 which was merged on trunk.
+
+Fixes for Ialloc instructions allocating more than Max_young_wosize words in the minor
heap
+
+Out-of-range Ialloc instructions cause various problems, see in particular GPR #1250.
+---
+ Changes | 5 +
+ asmcomp/cmmgen.ml | 38 ++--
+ asmcomp/selectgen.ml | 3 +-
+ testsuite/tests/basic-more/pr1271.ml | 288 ++++++++++++++++++++++++++++
+ testsuite/tests/basic-more/pr1271.reference | 2 +
+ 5 files changed, 317 insertions(+), 19 deletions(-)
+ create mode 100644 testsuite/tests/basic-more/pr1271.ml
+ create mode 100644 testsuite/tests/basic-more/pr1271.reference
+
+diff --git a/Changes b/Changes
+index cc7e0a82f..e8dbd42e2 100644
+--- a/Changes
++++ b/Changes
+@@ -4,6 +4,11 @@ Working 4.05.x branch
+ - MPR#7591, GPR#1257: on x86-64, frame table is not 8-aligned
+ (Xavier Leroy, report by Mantis user "voglerr", review by Gabriel Scherer)
+
++- GPR#1271: Don't generate Ialloc instructions for closures that exceed
++ Max_young_wosize; instead allocate them on the major heap. (Related
++ to GPR#1250.)
++ (Mark Shinwell)
++
+
+ OCaml 4.05.0 (13 Jul 2017):
+ ---------------------------
+diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
+index 4ac4b40c6..2120d3985 100644
+--- a/asmcomp/cmmgen.ml
++++ b/asmcomp/cmmgen.ml
+@@ -1641,29 +1641,31 @@ let rec transl env e =
+ List.iter (fun f -> Queue.add f functions) fundecls;
+ Cconst_symbol lbl
+ | Uclosure(fundecls, clos_vars) ->
+- let block_size =
+- fundecls_size fundecls + List.length clos_vars in
+ let rec transl_fundecls pos = function
+ [] ->
+ List.map (transl env) clos_vars
+ | f :: rem ->
+ Queue.add f functions;
+- let header =
+- if pos = 0
+- then alloc_closure_header block_size f.dbg
+- else alloc_infix_header pos f.dbg in
+- if f.arity = 1 || f.arity = 0 then
+- header ::
+- Cconst_symbol f.label ::
+- int_const f.arity ::
+- transl_fundecls (pos + 3) rem
+- else
+- header ::
+- Cconst_symbol(curry_function f.arity) ::
+- int_const f.arity ::
+- Cconst_symbol f.label ::
+- transl_fundecls (pos + 4) rem in
+- Cop(Calloc, transl_fundecls 0 fundecls, Debuginfo.none)
++ let without_header =
++ if f.arity = 1 || f.arity = 0 then
++ Cconst_symbol f.label ::
++ int_const f.arity ::
++ transl_fundecls (pos + 3) rem
++ else
++ Cconst_symbol(curry_function f.arity) ::
++ int_const f.arity ::
++ Cconst_symbol f.label ::
++ transl_fundecls (pos + 4) rem
++ in
++ if pos = 0 then without_header
++ else (alloc_infix_header pos f.dbg) :: without_header
++ in
++ let dbg =
++ match fundecls with
++ | [] -> Debuginfo.none
++ | fundecl::_ -> fundecl.dbg
++ in
++ make_alloc dbg Obj.closure_tag (transl_fundecls 0 fundecls)
+ | Uoffset(arg, offset) ->
+ (* produces a valid Caml value, pointing just after an infix header *)
+ let ptr = transl env arg in
+diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
+index 7cd8cd5c3..1158fc0d0 100644
+--- a/asmcomp/selectgen.ml
++++ b/asmcomp/selectgen.ml
+@@ -738,7 +738,8 @@ method emit_expr (env:environment) exp =
+ loc_arg (Proc.loc_external_results rd) in
+ self#insert_move_results loc_res rd stack_ofs;
+ Some rd
+- | Ialloc { words = _; spacetime_index; label_after_call_gc; } ->
++ | Ialloc { words; spacetime_index; label_after_call_gc; } ->
++ assert (words <= Config.max_young_wosize);
+ let rd = self#regs_for typ_val in
+ let size = size_expr env (Ctuple new_args) in
+ let op =
+diff --git a/testsuite/tests/basic-more/pr1271.ml b/testsuite/tests/basic-more/pr1271.ml
+new file mode 100644
+index 000000000..3890d0fbb
+--- /dev/null
++++ b/testsuite/tests/basic-more/pr1271.ml
+@@ -0,0 +1,288 @@
++(* GPR#1271 *)
++
++module F (X : sig val x : int end) = struct
++ let rec f1 y = f270 (X.x + y)
++ and f2 y = (f1 [@inlined never]) y
++ and f3 y = (f2 [@inlined never]) y
++ and f4 y = (f3 [@inlined never]) y
++ and f5 y = (f4 [@inlined never]) y
++ and f6 y = (f5 [@inlined never]) y
++ and f7 y = (f6 [@inlined never]) y
++ and f8 y = (f7 [@inlined never]) y
++ and f9 y = (f8 [@inlined never]) y
++ and f10 y = (f9 [@inlined never]) y
++ and f11 y = (f10 [@inlined never]) y
++ and f12 y = (f11 [@inlined never]) y
++ and f13 y = (f12 [@inlined never]) y
++ and f14 y = (f13 [@inlined never]) y
++ and f15 y = (f14 [@inlined never]) y
++ and f16 y = (f15 [@inlined never]) y
++ and f17 y = (f16 [@inlined never]) y
++ and f18 y = (f17 [@inlined never]) y
++ and f19 y = (f18 [@inlined never]) y
++ and f20 y = (f19 [@inlined never]) y
++ and f21 y = (f20 [@inlined never]) y
++ and f22 y = (f21 [@inlined never]) y
++ and f23 y = (f22 [@inlined never]) y
++ and f24 y = (f23 [@inlined never]) y
++ and f25 y = (f24 [@inlined never]) y
++ and f26 y = (f25 [@inlined never]) y
++ and f27 y = (f26 [@inlined never]) y
++ and f28 y = (f27 [@inlined never]) y
++ and f29 y = (f28 [@inlined never]) y
++ and f30 y = (f29 [@inlined never]) y
++ and f31 y = (f30 [@inlined never]) y
++ and f32 y = (f31 [@inlined never]) y
++ and f33 y = (f32 [@inlined never]) y
++ and f34 y = (f33 [@inlined never]) y
++ and f35 y = (f34 [@inlined never]) y
++ and f36 y = (f35 [@inlined never]) y
++ and f37 y = (f36 [@inlined never]) y
++ and f38 y = (f37 [@inlined never]) y
++ and f39 y = (f38 [@inlined never]) y
++ and f40 y = (f39 [@inlined never]) y
++ and f41 y = (f40 [@inlined never]) y
++ and f42 y = (f41 [@inlined never]) y
++ and f43 y = (f42 [@inlined never]) y
++ and f44 y = (f43 [@inlined never]) y
++ and f45 y = (f44 [@inlined never]) y
++ and f46 y = (f45 [@inlined never]) y
++ and f47 y = (f46 [@inlined never]) y
++ and f48 y = (f47 [@inlined never]) y
++ and f49 y = (f48 [@inlined never]) y
++ and f50 y = (f49 [@inlined never]) y
++ and f51 y = (f50 [@inlined never]) y
++ and f52 y = (f51 [@inlined never]) y
++ and f53 y = (f52 [@inlined never]) y
++ and f54 y = (f53 [@inlined never]) y
++ and f55 y = (f54 [@inlined never]) y
++ and f56 y = (f55 [@inlined never]) y
++ and f57 y = (f56 [@inlined never]) y
++ and f58 y = (f57 [@inlined never]) y
++ and f59 y = (f58 [@inlined never]) y
++ and f60 y = (f59 [@inlined never]) y
++ and f61 y = (f60 [@inlined never]) y
++ and f62 y = (f61 [@inlined never]) y
++ and f63 y = (f62 [@inlined never]) y
++ and f64 y = (f63 [@inlined never]) y
++ and f65 y = (f64 [@inlined never]) y
++ and f66 y = (f65 [@inlined never]) y
++ and f67 y = (f66 [@inlined never]) y
++ and f68 y = (f67 [@inlined never]) y
++ and f69 y = (f68 [@inlined never]) y
++ and f70 y = (f69 [@inlined never]) y
++ and f71 y = (f70 [@inlined never]) y
++ and f72 y = (f71 [@inlined never]) y
++ and f73 y = (f72 [@inlined never]) y
++ and f74 y = (f73 [@inlined never]) y
++ and f75 y = (f74 [@inlined never]) y
++ and f76 y = (f75 [@inlined never]) y
++ and f77 y = (f76 [@inlined never]) y
++ and f78 y = (f77 [@inlined never]) y
++ and f79 y = (f78 [@inlined never]) y
++ and f80 y = (f79 [@inlined never]) y
++ and f81 y = (f80 [@inlined never]) y
++ and f82 y = (f81 [@inlined never]) y
++ and f83 y = (f82 [@inlined never]) y
++ and f84 y = (f83 [@inlined never]) y
++ and f85 y = (f84 [@inlined never]) y
++ and f86 y = (f85 [@inlined never]) y
++ and f87 y = (f86 [@inlined never]) y
++ and f88 y = (f87 [@inlined never]) y
++ and f89 y = (f88 [@inlined never]) y
++ and f90 y = (f89 [@inlined never]) y
++ and f91 y = (f90 [@inlined never]) y
++ and f92 y = (f91 [@inlined never]) y
++ and f93 y = (f92 [@inlined never]) y
++ and f94 y = (f93 [@inlined never]) y
++ and f95 y = (f94 [@inlined never]) y
++ and f96 y = (f95 [@inlined never]) y
++ and f97 y = (f96 [@inlined never]) y
++ and f98 y = (f97 [@inlined never]) y
++ and f99 y = (f98 [@inlined never]) y
++ and f100 y = (f99 [@inlined never]) y
++ and f101 y = (f100 [@inlined never]) y
++ and f102 y = (f101 [@inlined never]) y
++ and f103 y = (f102 [@inlined never]) y
++ and f104 y = (f103 [@inlined never]) y
++ and f105 y = (f104 [@inlined never]) y
++ and f106 y = (f105 [@inlined never]) y
++ and f107 y = (f106 [@inlined never]) y
++ and f108 y = (f107 [@inlined never]) y
++ and f109 y = (f108 [@inlined never]) y
++ and f110 y = (f109 [@inlined never]) y
++ and f111 y = (f110 [@inlined never]) y
++ and f112 y = (f111 [@inlined never]) y
++ and f113 y = (f112 [@inlined never]) y
++ and f114 y = (f113 [@inlined never]) y
++ and f115 y = (f114 [@inlined never]) y
++ and f116 y = (f115 [@inlined never]) y
++ and f117 y = (f116 [@inlined never]) y
++ and f118 y = (f117 [@inlined never]) y
++ and f119 y = (f118 [@inlined never]) y
++ and f120 y = (f119 [@inlined never]) y
++ and f121 y = (f120 [@inlined never]) y
++ and f122 y = (f121 [@inlined never]) y
++ and f123 y = (f122 [@inlined never]) y
++ and f124 y = (f123 [@inlined never]) y
++ and f125 y = (f124 [@inlined never]) y
++ and f126 y = (f125 [@inlined never]) y
++ and f127 y = (f126 [@inlined never]) y
++ and f128 y = (f127 [@inlined never]) y
++ and f129 y = (f128 [@inlined never]) y
++ and f130 y = (f129 [@inlined never]) y
++ and f131 y = (f130 [@inlined never]) y
++ and f132 y = (f131 [@inlined never]) y
++ and f133 y = (f132 [@inlined never]) y
++ and f134 y = (f133 [@inlined never]) y
++ and f135 y = (f134 [@inlined never]) y
++ and f136 y = (f135 [@inlined never]) y
++ and f137 y = (f136 [@inlined never]) y
++ and f138 y = (f137 [@inlined never]) y
++ and f139 y = (f138 [@inlined never]) y
++ and f140 y = (f139 [@inlined never]) y
++ and f141 y = (f140 [@inlined never]) y
++ and f142 y = (f141 [@inlined never]) y
++ and f143 y = (f142 [@inlined never]) y
++ and f144 y = (f143 [@inlined never]) y
++ and f145 y = (f144 [@inlined never]) y
++ and f146 y = (f145 [@inlined never]) y
++ and f147 y = (f146 [@inlined never]) y
++ and f148 y = (f147 [@inlined never]) y
++ and f149 y = (f148 [@inlined never]) y
++ and f150 y = (f149 [@inlined never]) y
++ and f151 y = (f150 [@inlined never]) y
++ and f152 y = (f151 [@inlined never]) y
++ and f153 y = (f152 [@inlined never]) y
++ and f154 y = (f153 [@inlined never]) y
++ and f155 y = (f154 [@inlined never]) y
++ and f156 y = (f155 [@inlined never]) y
++ and f157 y = (f156 [@inlined never]) y
++ and f158 y = (f157 [@inlined never]) y
++ and f159 y = (f158 [@inlined never]) y
++ and f160 y = (f159 [@inlined never]) y
++ and f161 y = (f160 [@inlined never]) y
++ and f162 y = (f161 [@inlined never]) y
++ and f163 y = (f162 [@inlined never]) y
++ and f164 y = (f163 [@inlined never]) y
++ and f165 y = (f164 [@inlined never]) y
++ and f166 y = (f165 [@inlined never]) y
++ and f167 y = (f166 [@inlined never]) y
++ and f168 y = (f167 [@inlined never]) y
++ and f169 y = (f168 [@inlined never]) y
++ and f170 y = (f169 [@inlined never]) y
++ and f171 y = (f170 [@inlined never]) y
++ and f172 y = (f171 [@inlined never]) y
++ and f173 y = (f172 [@inlined never]) y
++ and f174 y = (f173 [@inlined never]) y
++ and f175 y = (f174 [@inlined never]) y
++ and f176 y = (f175 [@inlined never]) y
++ and f177 y = (f176 [@inlined never]) y
++ and f178 y = (f177 [@inlined never]) y
++ and f179 y = (f178 [@inlined never]) y
++ and f180 y = (f179 [@inlined never]) y
++ and f181 y = (f180 [@inlined never]) y
++ and f182 y = (f181 [@inlined never]) y
++ and f183 y = (f182 [@inlined never]) y
++ and f184 y = (f183 [@inlined never]) y
++ and f185 y = (f184 [@inlined never]) y
++ and f186 y = (f185 [@inlined never]) y
++ and f187 y = (f186 [@inlined never]) y
++ and f188 y = (f187 [@inlined never]) y
++ and f189 y = (f188 [@inlined never]) y
++ and f190 y = (f189 [@inlined never]) y
++ and f191 y = (f190 [@inlined never]) y
++ and f192 y = (f191 [@inlined never]) y
++ and f193 y = (f192 [@inlined never]) y
++ and f194 y = (f193 [@inlined never]) y
++ and f195 y = (f194 [@inlined never]) y
++ and f196 y = (f195 [@inlined never]) y
++ and f197 y = (f196 [@inlined never]) y
++ and f198 y = (f197 [@inlined never]) y
++ and f199 y = (f198 [@inlined never]) y
++ and f200 y = (f199 [@inlined never]) y
++ and f201 y = (f200 [@inlined never]) y
++ and f202 y = (f201 [@inlined never]) y
++ and f203 y = (f202 [@inlined never]) y
++ and f204 y = (f203 [@inlined never]) y
++ and f205 y = (f204 [@inlined never]) y
++ and f206 y = (f205 [@inlined never]) y
++ and f207 y = (f206 [@inlined never]) y
++ and f208 y = (f207 [@inlined never]) y
++ and f209 y = (f208 [@inlined never]) y
++ and f210 y = (f209 [@inlined never]) y
++ and f211 y = (f210 [@inlined never]) y
++ and f212 y = (f211 [@inlined never]) y
++ and f213 y = (f212 [@inlined never]) y
++ and f214 y = (f213 [@inlined never]) y
++ and f215 y = (f214 [@inlined never]) y
++ and f216 y = (f215 [@inlined never]) y
++ and f217 y = (f216 [@inlined never]) y
++ and f218 y = (f217 [@inlined never]) y
++ and f219 y = (f218 [@inlined never]) y
++ and f220 y = (f219 [@inlined never]) y
++ and f221 y = (f220 [@inlined never]) y
++ and f222 y = (f221 [@inlined never]) y
++ and f223 y = (f222 [@inlined never]) y
++ and f224 y = (f223 [@inlined never]) y
++ and f225 y = (f224 [@inlined never]) y
++ and f226 y = (f225 [@inlined never]) y
++ and f227 y = (f226 [@inlined never]) y
++ and f228 y = (f227 [@inlined never]) y
++ and f229 y = (f228 [@inlined never]) y
++ and f230 y = (f229 [@inlined never]) y
++ and f231 y = (f230 [@inlined never]) y
++ and f232 y = (f231 [@inlined never]) y
++ and f233 y = (f232 [@inlined never]) y
++ and f234 y = (f233 [@inlined never]) y
++ and f235 y = (f234 [@inlined never]) y
++ and f236 y = (f235 [@inlined never]) y
++ and f237 y = (f236 [@inlined never]) y
++ and f238 y = (f237 [@inlined never]) y
++ and f239 y = (f238 [@inlined never]) y
++ and f240 y = (f239 [@inlined never]) y
++ and f241 y = (f240 [@inlined never]) y
++ and f242 y = (f241 [@inlined never]) y
++ and f243 y = (f242 [@inlined never]) y
++ and f244 y = (f243 [@inlined never]) y
++ and f245 y = (f244 [@inlined never]) y
++ and f246 y = (f245 [@inlined never]) y
++ and f247 y = (f246 [@inlined never]) y
++ and f248 y = (f247 [@inlined never]) y
++ and f249 y = (f248 [@inlined never]) y
++ and f250 y = (f249 [@inlined never]) y
++ and f251 y = (f250 [@inlined never]) y
++ and f252 y = (f251 [@inlined never]) y
++ and f253 y = (f252 [@inlined never]) y
++ and f254 y = (f253 [@inlined never]) y
++ and f255 y = (f254 [@inlined never]) y
++ and f256 y = (f255 [@inlined never]) y
++ and f257 y = (f256 [@inlined never]) y
++ and f258 y = (f257 [@inlined never]) y
++ and f259 y = (f258 [@inlined never]) y
++ and f260 y = (f259 [@inlined never]) y
++ and f261 y = (f260 [@inlined never]) y
++ and f262 y = (f261 [@inlined never]) y
++ and f263 y = (f262 [@inlined never]) y
++ and f264 y = (f263 [@inlined never]) y
++ and f265 y = (f264 [@inlined never]) y
++ and f266 y = (f265 [@inlined never]) y
++ and f267 y = (f266 [@inlined never]) y
++ and f268 y = (f267 [@inlined never]) y
++ and f269 y = (f268 [@inlined never]) y
++ and f270 y = (f269 [@inlined never]) y
++end
++
++let words0 = Gc.minor_words ()
++let words1 = Gc.minor_words ()
++module X = F (struct let x = 42 end)
++let words2 = Gc.minor_words ()
++
++let expected = words1 -. words0
++
++let () =
++ match Sys.backend_type with
++ | Sys.Native ->
++ Printf.printf "%.0f" ((words2 -. words1) -. expected)
++ | Sys.Bytecode | Sys.Other _ ->
++ print_string "0"
+diff --git a/testsuite/tests/basic-more/pr1271.reference
b/testsuite/tests/basic-more/pr1271.reference
+new file mode 100644
+index 000000000..6e374c16e
+--- /dev/null
++++ b/testsuite/tests/basic-more/pr1271.reference
+@@ -0,0 +1,2 @@
++0
++All tests succeeded.
+--
+2.13.1
+
diff --git a/0003-configure-Allow-user-defined-C-compiler-flags.patch
b/0003-configure-Allow-user-defined-C-compiler-flags.patch
deleted file mode 100644
index f1f5b30..0000000
--- a/0003-configure-Allow-user-defined-C-compiler-flags.patch
+++ /dev/null
@@ -1,27 +0,0 @@
-From 77475cec6718b9f15bc6e8e5c7e6edb936b93cd2 Mon Sep 17 00:00:00 2001
-From: "Richard W.M. Jones" <rjones(a)redhat.com>
-Date: Tue, 29 May 2012 20:44:18 +0100
-Subject: [PATCH 3/9] configure: Allow user defined C compiler flags.
-
----
- configure | 4 ++++
- 1 file changed, 4 insertions(+)
-
-diff --git a/configure b/configure
-index 3b2636035..d53d90367 100755
---- a/configure
-+++ b/configure
-@@ -1912,6 +1912,10 @@ if $with_fpic; then
- echo "#define CAML_WITH_FPIC" >> m.h
- fi
-
-+# Allow user defined C Compiler flags
-+bytecccompopts="$bytecccompopts $CFLAGS"
-+nativecccompopts="$nativecccompopts $CFLAGS"
-+
- # Finish generated files
-
- cclibs="$cclibs $mathlib"
---
-2.13.1
-
diff --git a/0004-Don-t-add-rpaths-to-libraries.patch
b/0004-Don-t-add-rpaths-to-libraries.patch
new file mode 100644
index 0000000..24111b5
--- /dev/null
+++ b/0004-Don-t-add-rpaths-to-libraries.patch
@@ -0,0 +1,29 @@
+From b2118848e9a0aa96c5ccb3ede65f2d0e9cfb114a Mon Sep 17 00:00:00 2001
+From: "Richard W.M. Jones" <rjones(a)redhat.com>
+Date: Tue, 24 Jun 2014 10:00:15 +0100
+Subject: [PATCH 04/12] Don't add rpaths to libraries.
+
+---
+ tools/Makefile | 6 +++---
+ 1 file changed, 3 insertions(+), 3 deletions(-)
+
+diff --git a/tools/Makefile b/tools/Makefile
+index 9a8cf652b..269aa18e6 100644
+--- a/tools/Makefile
++++ b/tools/Makefile
+@@ -156,9 +156,9 @@ $(call byte_and_opt,ocamlmklib,ocamlmklibconfig.cmo config.cmo
misc.cmo \
+ ocamlmklibconfig.ml: ../config/Makefile Makefile
+ (echo 'let bindir = "$(BINDIR)"'; \
+ echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\
+- echo 'let byteccrpath = "$(BYTECCRPATH)"'; \
+- echo 'let nativeccrpath = "$(NATIVECCRPATH)"'; \
+- echo 'let mksharedlibrpath = "$(MKSHAREDLIBRPATH)"'; \
++ echo 'let byteccrpath = ""'; \
++ echo 'let nativeccrpath = ""'; \
++ echo 'let mksharedlibrpath = ""'; \
+ echo 'let toolpref = "$(TOOLPREF)"'; \
+ sed -n -e 's/^#ml //p' ../config/Makefile) \
+ > ocamlmklibconfig.ml
+--
+2.13.1
+
diff --git a/0004-Don-t-rewrite-Werror.patch b/0004-Don-t-rewrite-Werror.patch
deleted file mode 100644
index ffbe70f..0000000
--- a/0004-Don-t-rewrite-Werror.patch
+++ /dev/null
@@ -1,28 +0,0 @@
-From 5376164719c12fbad2321551425b3c46ec794817 Mon Sep 17 00:00:00 2001
-From: "Richard W.M. Jones" <rjones(a)redhat.com>
-Date: Thu, 3 Nov 2016 19:50:20 +0000
-Subject: [PATCH 4/9] Don't rewrite -Werror.
-
-In Fedora our CFLAGS contains -Wall -Werror=format-security.
-
-As written, the sed phrase substitutes this with -Wall=format-security
-which is bogus. Remove this rewriting completely.
----
- Makefile | 1 -
- 1 file changed, 1 deletion(-)
-
-diff --git a/Makefile b/Makefile
-index b30564d00..e8514d41e 100644
---- a/Makefile
-+++ b/Makefile
-@@ -409,7 +409,6 @@ utils/config.ml: utils/config.mlp config/Makefile
- -e 's|%%CCOMPTYPE%%|cc|' \
- -e 's|%%BYTECC%%|$(BYTECC) $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)|' \
- -e 's|%%NATIVECC%%|$(NATIVECC) $(NATIVECCCOMPOPTS)|' \
-- -e '/c_compiler =/s| -Werror||' \
- -e 's|%%PACKLD%%|$(PACKLD)|' \
- -e 's|%%BYTECCLIBS%%|$(BYTECCLIBS)|' \
- -e 's|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|' \
---
-2.13.1
-
diff --git a/0005-Adapt-config.guess-for-RISC-V.patch
b/0005-Adapt-config.guess-for-RISC-V.patch
deleted file mode 100644
index b3f4d7c..0000000
--- a/0005-Adapt-config.guess-for-RISC-V.patch
+++ /dev/null
@@ -1,35 +0,0 @@
-From 8860338049b0a43377c2ea7fa05a47766b3b21aa Mon Sep 17 00:00:00 2001
-From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
-Date: Tue, 8 Nov 2016 23:56:50 +0100
-Subject: [PATCH 5/9] Adapt config.guess for RISC-V
-
----
- config/gnu/config.guess | 5 ++++-
- 1 file changed, 4 insertions(+), 1 deletion(-)
-
-diff --git a/config/gnu/config.guess b/config/gnu/config.guess
-index b79252d6b..8335398b2 100755
---- a/config/gnu/config.guess
-+++ b/config/gnu/config.guess
-@@ -2,7 +2,7 @@
- # Attempt to guess a canonical system name.
- # Copyright 1992-2013 Free Software Foundation, Inc.
-
--timestamp='2013-06-10'
-+timestamp='2016-10-23'
-
- # 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
-@@ -1001,6 +1001,9 @@ EOF
- ppcle:Linux:*:*)
- echo powerpcle-unknown-linux-${LIBC}
- exit ;;
-+ riscv*:Linux:*:*)
-+ echo ${UNAME_MACHINE}-unknown-linux
-+ exit ;;
- s390:Linux:*:* | s390x:Linux:*:*)
- echo ${UNAME_MACHINE}-ibm-linux-${LIBC}
- exit ;;
---
-2.13.1
-
diff --git a/0005-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
b/0005-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
new file mode 100644
index 0000000..aa41a0e
--- /dev/null
+++ b/0005-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
@@ -0,0 +1,240 @@
+From 80e2921e472f66f70575d6e4e6c8ff6f5714e4e4 Mon Sep 17 00:00:00 2001
+From: "Richard W.M. Jones" <rjones(a)redhat.com>
+Date: Tue, 29 May 2012 20:40:36 +0100
+Subject: [PATCH 05/12] ocamlbyteinfo, ocamlplugininfo: Useful utilities from
+ Debian, sent upstream.
+
+See:
+http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD
+---
+ ocamlbyteinfo.ml | 101 +++++++++++++++++++++++++++++++++++++++++++++++++
+ ocamlplugininfo.ml | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 210 insertions(+)
+ create mode 100644 ocamlbyteinfo.ml
+ create mode 100644 ocamlplugininfo.ml
+
+diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml
+new file mode 100644
+index 000000000..eb9a293e3
+--- /dev/null
++++ b/ocamlbyteinfo.ml
+@@ -0,0 +1,101 @@
++(***********************************************************************)
++(* *)
++(* Objective Caml *)
++(* *)
++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
++(* *)
++(* Copyright 2009 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. *)
++(* *)
++(***********************************************************************)
++
++(* $Id$ *)
++
++(* Dumps a bytecode binary file *)
++
++open Sys
++open Dynlinkaux
++
++let input_stringlist ic len =
++ let get_string_list sect len =
++ let rec fold s e acc =
++ if e != len then
++ if sect.[e] = '\000' then
++ fold (e+1) (e+1) (String.sub sect s (e-s) :: acc)
++ else fold s (e+1) acc
++ else acc
++ in fold 0 0 []
++ in
++ let sect = String.create len in
++ let _ = really_input ic sect 0 len in
++ get_string_list sect len
++
++let print = Printf.printf
++let perr s =
++ Printf.eprintf "%s\n" s;
++ exit(1)
++let p_title title = print "%s:\n" title
++
++let p_section title format pdata = function
++ | [] -> ()
++ | l ->
++ p_title title;
++ List.iter
++ (fun (name, data) -> print format (pdata data) name)
++ l
++
++let p_list title format = function
++ | [] -> ()
++ | l ->
++ p_title title;
++ List.iter
++ (fun name -> print format name)
++ l
++
++let _ =
++ try
++ let input_name = Sys.argv.(1) in
++ let ic = open_in_bin input_name in
++ Bytesections.read_toc ic;
++ List.iter
++ (fun section ->
++ try
++ let len = Bytesections.seek_section ic section in
++ if len > 0 then match section with
++ | "CRCS" ->
++ p_section
++ "Imported Units"
++ "\t%s\t%s\n"
++ Digest.to_hex
++ (input_value ic : (string * Digest.t) list)
++ | "DLLS" ->
++ p_list
++ "Used Dlls" "\t%s\n"
++ (input_stringlist ic len)
++ | "DLPT" ->
++ p_list
++ "Additional Dll paths"
++ "\t%s\n"
++ (input_stringlist ic len)
++ | "PRIM" ->
++ let prims = (input_stringlist ic len) in
++ print "Uses unsafe features: ";
++ begin match prims with
++ [] -> print "no\n"
++ | l -> print "YES\n";
++ p_list "Primitives declared in this module"
++ "\t%s\n"
++ l
++ end
++ | _ -> ()
++ with Not_found | Failure _ | Invalid_argument _ -> ()
++ )
++ ["CRCS"; "DLLS"; "DLPT"; "PRIM"];
++ close_in ic
++ with
++ | Sys_error msg ->
++ perr msg
++ | Invalid_argument("index out of bounds") ->
++ perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0))
+diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml
+new file mode 100644
+index 000000000..e28800f31
+--- /dev/null
++++ b/ocamlplugininfo.ml
+@@ -0,0 +1,109 @@
++(***********************************************************************)
++(* *)
++(* Objective Caml *)
++(* *)
++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
++(* *)
++(* Copyright 2009 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. *)
++(* *)
++(***********************************************************************)
++
++(* $Id$ *)
++
++(* Dumps a .cmxs file *)
++
++open Natdynlink
++open Format
++
++let file =
++ try
++ Sys.argv.(1)
++ with _ -> begin
++ Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0);
++ exit(1)
++ end
++
++exception Abnormal_exit
++
++let error s e =
++ let eprint = Printf.eprintf in
++ let print_exc s = function
++ | End_of_file ->
++ eprint "%s: %s\n" s file
++ | Abnormal_exit ->
++ eprint "%s\n" s
++ | e -> eprint "%s\n" (Printexc.to_string e)
++ in
++ print_exc s e;
++ exit(1)
++
++let read_in command =
++ let cmd = Printf.sprintf command file in
++ let ic = Unix.open_process_in cmd in
++ try
++ let line = input_line ic in
++ begin match (Unix.close_process_in ic) with
++ | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line
++ | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
++ error
++ (Printf.sprintf
++ "Command \"%s\" exited abnormally"
++ cmd
++ )
++ Abnormal_exit
++ end
++ with e -> error "File is empty" e
++
++let get_offset adr_off adr_sec =
++ try
++ let adr = List.nth adr_off 4 in
++ let off = List.nth adr_off 5 in
++ let sec = List.hd adr_sec in
++
++ let (!) x = Int64.of_string ("0x" ^ x) in
++ let (+) = Int64.add in
++ let (-) = Int64.sub in
++
++ Int64.to_int (!off + !sec - !adr)
++
++ with Failure _ | Invalid_argument _ ->
++ error
++ "Command output doesn't have the expected format"
++ Abnormal_exit
++
++let print_infos name crc defines cmi cmx =
++ let print_name_crc (name, crc) =
++ printf "@ %s (%s)" name (Digest.to_hex crc)
++ in
++ let pr_imports ppf imps = List.iter print_name_crc imps in
++ printf "Name: %s@." name;
++ printf "CRC of implementation: %s@." (Digest.to_hex crc);
++ printf "@[<hov 2>Globals defined:";
++ List.iter (fun s -> printf "@ %s" s) defines;
++ printf "@]@.";
++ printf "@[<v 2>Interfaces imported:%a@]@." pr_imports cmi;
++ printf "@[<v 2>Implementations imported:%a@]@." pr_imports cmx
++
++let _ =
++ let adr_off = read_in "objdump -h %s | grep ' .data '" in
++ let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'"
in
++
++ let ic = open_in file in
++ let _ = seek_in ic (get_offset adr_off adr_sec) in
++ let header = (input_value ic : Natdynlink.dynheader) in
++ if header.magic <> Natdynlink.dyn_magic_number then
++ raise(Error(Natdynlink.Not_a_bytecode_file file))
++ else begin
++ List.iter
++ (fun ui ->
++ print_infos
++ ui.name
++ ui.crc
++ ui.defines
++ ui.imports_cmi
++ ui.imports_cmx)
++ header.units
++ end
+--
+2.13.1
+
diff --git a/0006-Add-RISC-V-backend-runtime.patch
b/0006-Add-RISC-V-backend-runtime.patch
deleted file mode 100644
index b6ab0d7..0000000
--- a/0006-Add-RISC-V-backend-runtime.patch
+++ /dev/null
@@ -1,1717 +0,0 @@
-From c7d7b98e82b5571965e57c1537899094222f3157 Mon Sep 17 00:00:00 2001
-From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
-Date: Fri, 4 Nov 2016 20:39:09 +0100
-Subject: [PATCH 6/9] Add RISC-V backend & runtime
-
----
- README.adoc | 1 +
- asmcomp/riscv/CSE.ml | 36 +++
- asmcomp/riscv/arch.ml | 84 ++++++
- asmcomp/riscv/emit.mlp | 616 ++++++++++++++++++++++++++++++++++++++++++++
- asmcomp/riscv/proc.ml | 301 ++++++++++++++++++++++
- asmcomp/riscv/reload.ml | 16 ++
- asmcomp/riscv/scheduling.ml | 19 ++
- asmcomp/riscv/selection.ml | 85 ++++++
- asmrun/riscv.S | 424 ++++++++++++++++++++++++++++++
- byterun/caml/stack.h | 5 +
- configure | 5 +-
- 11 files changed, 1591 insertions(+), 1 deletion(-)
- create mode 100644 asmcomp/riscv/CSE.ml
- create mode 100644 asmcomp/riscv/arch.ml
- create mode 100644 asmcomp/riscv/emit.mlp
- create mode 100644 asmcomp/riscv/proc.ml
- create mode 100644 asmcomp/riscv/reload.ml
- create mode 100644 asmcomp/riscv/scheduling.ml
- create mode 100644 asmcomp/riscv/selection.ml
- create mode 100644 asmrun/riscv.S
-
-diff --git a/README.adoc b/README.adoc
-index 480b0250f..cb6eebf1d 100644
---- a/README.adoc
-+++ b/README.adoc
-@@ -34,6 +34,7 @@ IA32 (Pentium):: NetBSD, OpenBSD, Solaris 9
- PowerPC:: NetBSD
- ARM:: NetBSD
- SPARC:: Solaris, Linux, NetBSD
-+RISC-V:: Linux
-
- Other operating systems for the processors above have not been tested, but
- the compiler may work under other operating systems with little work.
-diff --git a/asmcomp/riscv/CSE.ml b/asmcomp/riscv/CSE.ml
-new file mode 100644
-index 000000000..302811a99
---- /dev/null
-+++ b/asmcomp/riscv/CSE.ml
-@@ -0,0 +1,36 @@
-+(***********************************************************************)
-+(* *)
-+(* OCaml *)
-+(* *)
-+(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
-+(* *)
-+(* Copyright 2106 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. *)
-+(* *)
-+(***********************************************************************)
-+
-+(* CSE for the RISC-V *)
-+
-+open Arch
-+open Mach
-+open CSEgen
-+
-+class cse = object (_self)
-+
-+inherit cse_generic as super
-+
-+method! class_of_operation op =
-+ match op with
-+ | Ispecific(Imultaddf _ | Imultsubf _) -> Op_pure
-+ | _ -> super#class_of_operation op
-+
-+method! is_cheap_operation op =
-+ match op with
-+ | Iconst_int n -> n <= 0x7FFn && n >= -0x800n
-+ | _ -> false
-+
-+end
-+
-+let fundecl f =
-+ (new cse)#fundecl f
-diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml
-new file mode 100644
-index 000000000..61a38b1dd
---- /dev/null
-+++ b/asmcomp/riscv/arch.ml
-@@ -0,0 +1,84 @@
-+(***********************************************************************)
-+(* *)
-+(* OCaml *)
-+(* *)
-+(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
-+(* *)
-+(* Copyright 2016 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. *)
-+(* *)
-+(***********************************************************************)
-+
-+(* Specific operations for the RISC-V processor *)
-+
-+open Format
-+
-+(* Machine-specific command-line options *)
-+
-+let command_line_options = []
-+
-+(* Specific operations *)
-+
-+type specific_operation =
-+ | Imultaddf of bool (* multiply, optionally negate, and add *)
-+ | Imultsubf of bool (* multiply, optionally negate, and subtract *)
-+
-+let spacetime_node_hole_pointer_is_live_before = function
-+ | Imultaddf _ | Imultsubf _ -> false
-+
-+(* Addressing modes *)
-+
-+type addressing_mode =
-+ | Iindexed of int (* reg + displ *)
-+
-+(* Sizes, endianness *)
-+
-+let big_endian = false
-+
-+let rv64 =
-+ match Config.model with "riscv64" -> true | "riscv32" ->
false | _ -> assert false
-+
-+let size_addr = if rv64 then 8 else 4
-+let size_int = size_addr
-+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)
-+
-+let num_args_addressing = function
-+ | Iindexed _ -> 1
-+
-+(* Printing operations and addressing modes *)
-+
-+let print_addressing printreg addr ppf arg =
-+ match addr with
-+ | Iindexed n ->
-+ let idx = if n <> 0 then Printf.sprintf " + %i" n else
"" in
-+ fprintf ppf "%a%s" printreg arg.(0) idx
-+
-+let print_specific_operation printreg op ppf arg =
-+ match op with
-+ | Imultaddf false ->
-+ fprintf ppf "%a *f %a +f %a"
-+ printreg arg.(0) printreg arg.(1) printreg arg.(2)
-+ | Imultaddf true ->
-+ fprintf ppf "-f (%a *f %a +f %a)"
-+ printreg arg.(0) printreg arg.(1) printreg arg.(2)
-+ | Imultsubf false ->
-+ fprintf ppf "%a *f %a -f %a"
-+ printreg arg.(0) printreg arg.(1) printreg arg.(2)
-+ | Imultsubf true ->
-+ fprintf ppf "-f (%a *f %a -f %a)"
-+ printreg arg.(0) printreg arg.(1) printreg arg.(2)
-diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
-new file mode 100644
-index 000000000..6d0e3aefd
---- /dev/null
-+++ b/asmcomp/riscv/emit.mlp
-@@ -0,0 +1,616 @@
-+(***********************************************************************)
-+(* *)
-+(* OCaml *)
-+(* *)
-+(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
-+(* *)
-+(* Copyright 2016 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. *)
-+(* *)
-+(***********************************************************************)
-+
-+(* Emission of RISC-V assembly code *)
-+
-+open Misc
-+open Cmm
-+open Arch
-+open Proc
-+open Reg
-+open Mach
-+open Linearize
-+open Emitaux
-+
-+(* Layout of the stack. The stack is kept 16-aligned. *)
-+
-+let stack_offset = ref 0
-+
-+let frame_size () =
-+ let size =
-+ !stack_offset + (* Trap frame, outgoing parameters *)
-+ size_int * num_stack_slots.(0) + (* Local int variables *)
-+ size_float * num_stack_slots.(1) + (* Local float variables *)
-+ (if !contains_calls then size_addr else 0) in (* The return address *)
-+ Misc.align size 16
-+
-+let slot_offset loc cls =
-+ match loc with
-+ | Local n ->
-+ if cls = 0
-+ then !stack_offset + num_stack_slots.(1) * size_float + n * size_int
-+ else !stack_offset + n * size_float
-+ | Incoming n -> frame_size() + n
-+ | Outgoing n -> n
-+
-+(* Output a symbol *)
-+
-+let emit_symbol s =
-+ Emitaux.emit_symbol '.' s
-+
-+(* Output a label *)
-+
-+let label_prefix = "L"
-+
-+let emit_label lbl =
-+ emit_string label_prefix; emit_int lbl
-+
-+(* Section switching *)
-+
-+let data_space =
-+ ".section .data"
-+
-+let code_space =
-+ ".section .text"
-+
-+let rodata_space =
-+ ".section .rodata"
-+
-+let reg_tmp1 = phys_reg 21 (* used by the assembler *)
-+let reg_tmp2 = phys_reg 22
-+let reg_t2 = phys_reg 16
-+(* let reg_fp = phys_reg 23 *)
-+let reg_trap = phys_reg 24
-+let reg_alloc_ptr = phys_reg 25
-+let reg_alloc_lim = phys_reg 26
-+
-+(* Names of instructions that differ in 32 and 64-bit modes *)
-+
-+let lg = if rv64 then "ld" else "lw"
-+let stg = if rv64 then "sd" else "sw"
-+let datag = if rv64 then ".quad" else ".long"
-+
-+(* Output a pseudo-register *)
-+
-+let emit_reg = function
-+ | {loc = Reg r} -> emit_string (register_name r)
-+ | _ -> fatal_error "Emit.emit_reg"
-+
-+(* Output a stack reference *)
-+
-+let emit_stack r =
-+ match r.loc with
-+ Stack s ->
-+ let ofs = slot_offset s (register_class r) in `{emit_int ofs}(sp)`
-+ | _ -> fatal_error "Emit.emit_stack"
-+
-+(* Record live pointers at call points *)
-+
-+let record_frame_label ?label live raise_ dbg =
-+ let lbl =
-+ match label with
-+ | None -> new_label()
-+ | Some label -> label
-+ in
-+ let live_offset = ref [] in
-+ Reg.Set.iter
-+ (function
-+ {typ = Val; loc = Reg r} ->
-+ live_offset := (r lsl 1) + 1 :: !live_offset
-+ | {typ = Val; loc = Stack s} as reg ->
-+ live_offset := slot_offset s (register_class reg) :: !live_offset
-+ | {typ = Addr} as r ->
-+ Misc.fatal_error ("bad GC root " ^ Reg.name r)
-+ | _ -> ()
-+ )
-+ live;
-+ frame_descriptors :=
-+ { fd_lbl = lbl;
-+ fd_frame_size = frame_size();
-+ fd_live_offset = !live_offset;
-+ fd_raise = raise_;
-+ fd_debuginfo = dbg } :: !frame_descriptors;
-+ lbl
-+
-+let record_frame ?label live raise_ dbg =
-+ let lbl = record_frame_label ?label live raise_ dbg in
-+ `{emit_label lbl}:\n`
-+
-+(* 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}:\n`;
-+ ` call {emit_symbol "caml_call_gc"}\n`;
-+ `{emit_label gc.gc_frame_lbl}:\n`;
-+ ` j {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 ?label dbg =
-+ if !Clflags.debug || !bound_error_sites = [] then begin
-+ let lbl_bound_error = new_label() in
-+ let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
-+ bound_error_sites :=
-+ { bd_lbl = lbl_bound_error;
-+ bd_frame_lbl = lbl_frame } :: !bound_error_sites;
-+ lbl_bound_error
-+ end else
-+ let bd = List.hd !bound_error_sites in
-+ bd.bd_lbl
-+
-+let emit_call_bound_error bd =
-+ `{emit_label bd.bd_lbl}:\n`;
-+ ` call {emit_symbol "caml_ml_array_bound_error"}\n`;
-+ `{emit_label bd.bd_frame_lbl}:\n`
-+
-+(* Record floating-point literals *)
-+
-+let float_literals = ref ([] : (int64 * int) list)
-+
-+(* Names for various instructions *)
-+
-+let name_for_intop = function
-+ | Iadd -> "add"
-+ | Isub -> "sub"
-+ | Imul -> "mul"
-+ | Imulh -> "mulh"
-+ | Idiv -> "div"
-+ | Iand -> "and"
-+ | Ior -> "or"
-+ | Ixor -> "xor"
-+ | Ilsl -> "sll"
-+ | Ilsr -> "srl"
-+ | Iasr -> "sra"
-+ | Imod -> "rem"
-+ | _ -> fatal_error "Emit.Intop"
-+
-+let name_for_intop_imm = function
-+ | Iadd -> "addi"
-+ | Iand -> "andi"
-+ | Ior -> "ori"
-+ | Ixor -> "xori"
-+ | Ilsl -> "slli"
-+ | Ilsr -> "srli"
-+ | Iasr -> "srai"
-+ | _ -> fatal_error "Emit.Intop_imm"
-+
-+let name_for_floatop1 = function
-+ | Inegf -> "fneg.d"
-+ | Iabsf -> "fabs.d"
-+ | _ -> fatal_error "Emit.Iopf1"
-+
-+let name_for_floatop2 = function
-+ | Iaddf -> "fadd.d"
-+ | Isubf -> "fsub.d"
-+ | Imulf -> "fmul.d"
-+ | Idivf -> "fdiv.d"
-+ | _ -> fatal_error "Emit.Iopf2"
-+
-+let name_for_specific = function
-+ | Imultaddf false -> "fmadd.d"
-+ | Imultaddf true -> "fnmadd.d"
-+ | Imultsubf false -> "fmsub.d"
-+ | Imultsubf true -> "fnmsub.d"
-+
-+(* Name of current function *)
-+let function_name = ref ""
-+(* Entry point for tail recursive calls *)
-+let tailrec_entry_point = ref 0
-+
-+(* Output the assembly code for an instruction *)
-+
-+let emit_instr i =
-+ 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 = (Val | Int | Addr)}, {loc = Reg _} ->
-+ ` mv {emit_reg dst}, {emit_reg src}\n`
-+ | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
-+ ` fmv.d {emit_reg dst}, {emit_reg src}\n`
-+ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} ->
-+ ` {emit_string stg} {emit_reg src}, {emit_stack dst}\n`
-+ | {loc = Reg _; typ = Float}, {loc = Stack _} ->
-+ ` fsd {emit_reg src}, {emit_stack dst}\n`
-+ | {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _ } ->
-+ ` {emit_string lg} {emit_reg dst}, {emit_stack src}\n`
-+ | {loc = Stack _; typ = Float}, {loc = Reg _} ->
-+ ` fld {emit_reg dst}, {emit_stack src}\n`
-+ | _ ->
-+ fatal_error "Emit: Imove"
-+ end
-+ | Lop(Iconst_int n) ->
-+ ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n`
-+ | Lop(Iconst_float f) ->
-+ let lbl = new_label() in
-+ float_literals := (f, lbl) :: !float_literals;
-+ ` fld {emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp1}\n`
-+ | Lop(Iconst_symbol s) ->
-+ ` la {emit_reg i.res.(0)}, {emit_symbol s}\n`
-+ | Lop(Icall_ind {label_after = label}) ->
-+ ` jalr {emit_reg i.arg.(0)}\n`;
-+ record_frame ~label i.live false i.dbg
-+ | Lop(Icall_imm {func; label_after = label}) ->
-+ ` call {emit_symbol func}\n`;
-+ record_frame ~label i.live false i.dbg
-+ | Lop(Itailcall_ind {label_after = _}) ->
-+ let n = frame_size() in
-+ if !contains_calls then
-+ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
-+ if n > 0 then
-+ ` addi sp, sp, {emit_int n}\n`;
-+ ` jr {emit_reg i.arg.(0)}\n`
-+ | Lop(Itailcall_imm {func; label_after = _}) ->
-+ if func = !function_name then begin
-+ ` j {emit_label !tailrec_entry_point}\n`
-+ end else begin
-+ let n = frame_size() in
-+ if !contains_calls then
-+ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
-+ if n > 0 then
-+ ` addi sp, sp, {emit_int n}\n`;
-+ ` tail {emit_symbol func}\n`
-+ end
-+ | Lop(Iextcall{func; alloc = true; label_after = label}) ->
-+ ` la {emit_reg reg_t2}, {emit_symbol func}\n`;
-+ ` call {emit_symbol "caml_c_call"}\n`;
-+ record_frame ~label i.live false i.dbg
-+ | Lop(Iextcall{func; alloc = false; label_after = _}) ->
-+ ` call {emit_symbol func}\n`
-+ | Lop(Istackoffset n) ->
-+ assert (n mod 16 = 0);
-+ ` addi sp, sp, {emit_int (-n)}\n`;
-+ stack_offset := !stack_offset + n
-+ | Lop(Iload(Single, Iindexed ofs)) ->
-+ ` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
-+ ` fcvt.d.s {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
-+ | Lop(Iload(chunk, Iindexed ofs)) ->
-+ let instr =
-+ match chunk with
-+ | Byte_unsigned -> "lbu"
-+ | Byte_signed -> "lb"
-+ | Sixteen_unsigned -> "lhu"
-+ | Sixteen_signed -> "lh"
-+ | Thirtytwo_unsigned -> if rv64 then "lwu" else "lw"
-+ | Thirtytwo_signed -> "lw"
-+ | Word_int | Word_val -> lg
-+ | Single -> assert false
-+ | Double | Double_u -> "fld"
-+ in
-+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg
i.arg.(0)})\n`
-+ | Lop(Istore(Single, Iindexed ofs, _)) ->
-+ ` fmv.x.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}\n`;
-+ ` fcvt.s.d {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}\n`;
-+ ` fsw {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`;
-+ ` fmv.d.x {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}\n`
-+ | Lop(Istore(chunk, Iindexed ofs, _)) ->
-+ let instr =
-+ match chunk with
-+ | Byte_unsigned | Byte_signed -> "sb"
-+ | Sixteen_unsigned | Sixteen_signed -> "sh"
-+ | Thirtytwo_unsigned | Thirtytwo_signed -> "sw"
-+ | Word_int | Word_val -> stg
-+ | Single -> assert false
-+ | Double | Double_u -> "fsd"
-+ in
-+ ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg
i.arg.(1)})\n`
-+ | Lop(Ialloc {words = n; label_after_call_gc = label; _}) ->
-+ let lbl_frame_lbl = record_frame_label ?label i.live false i.dbg in
-+ let lbl_redo = new_label () in
-+ let lbl_call_gc = new_label () in
-+ `{emit_label lbl_redo}:\n`;
-+ ` addi {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, -{emit_int n}\n`;
-+ ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`;
-+ ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_lim}, {emit_label
lbl_call_gc}\n`;
-+ call_gc_sites :=
-+ { gc_lbl = lbl_call_gc;
-+ gc_return_lbl = lbl_redo;
-+ gc_frame_lbl = lbl_frame_lbl } :: !call_gc_sites
-+ | Lop(Iintop(Icomp cmp)) ->
-+ begin match cmp with
-+ | Isigned Clt ->
-+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
-+ | Isigned Cge ->
-+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
-+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
-+ | Isigned Cgt ->
-+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
-+ | Isigned Cle ->
-+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
-+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
-+ | Isigned Ceq | Iunsigned Ceq ->
-+ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
-+ ` seqz {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
-+ | Isigned Cne | Iunsigned Cne ->
-+ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
-+ ` snez {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
-+ | Iunsigned Clt ->
-+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
-+ | Iunsigned Cge ->
-+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
-+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
-+ | Iunsigned Cgt ->
-+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
-+ | Iunsigned Cle ->
-+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
-+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
-+ end
-+ | Lop(Iintop (Icheckbound {label_after_error = label; _})) ->
-+ let lbl = bound_error_label ?label i.dbg in
-+ ` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
-+ | Lop(Iintop op) ->
-+ let instr = name_for_intop op in
-+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`
-+ | Lop(Iintop_imm(Isub, n)) ->
-+ ` addi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n`
-+ | Lop(Iintop_imm(Icomp _, _)) ->
-+ fatal_error "Emit.emit_instr (Iintop_imm (Icomp _, _))"
-+ | Lop(Iintop_imm(Icheckbound {label_after_error = label; _}, n)) ->
-+ let lbl = bound_error_label ?label i.dbg in
-+ ` li {emit_reg reg_tmp1}, {emit_int n}\n`;
-+ ` bleu {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, {emit_label lbl}\n`
-+ | Lop(Iintop_imm(op, n)) ->
-+ let instr = name_for_intop_imm op in
-+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n`
-+ | Lop(Inegf | Iabsf as op) ->
-+ let instr = name_for_floatop1 op in
-+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
-+ | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
-+ let instr = name_for_floatop2 op in
-+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`
-+ | Lop(Ifloatofint) ->
-+ let name = if rv64 then "fcvt.d.l" else "fcvt.d.w" in
-+ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
-+ | Lop(Iintoffloat) ->
-+ let name = if rv64 then "fcvt.l.d" else "fcvt.w.d" in
-+ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
-+ | Lop(Ispecific sop) ->
-+ let instr = name_for_specific sop 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`
-+ | Lreloadretaddr ->
-+ let n = frame_size () in
-+ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`
-+ | Lreturn ->
-+ let n = frame_size() in
-+ if n > 0 then
-+ ` addi sp, sp, {emit_int n}\n`;
-+ ` ret\n`
-+ | Llabel lbl ->
-+ `{emit_label lbl}:\n`
-+ | Lbranch lbl ->
-+ ` j {emit_label lbl}\n`
-+ | Lcondbranch(tst, lbl) ->
-+ begin match tst with
-+ | Itruetest ->
-+ ` bnez {emit_reg i.arg.(0)}, {emit_label lbl}\n`
-+ | Ifalsetest ->
-+ ` beqz {emit_reg i.arg.(0)}, {emit_label lbl}\n`
-+ | Iinttest cmp ->
-+ let name = match cmp with
-+ | Iunsigned Ceq | Isigned Ceq -> "beq"
-+ | Iunsigned Cne | Isigned Cne -> "bne"
-+ | Iunsigned Cle -> "bleu" | Isigned Cle -> "ble"
-+ | Iunsigned Cge -> "bgeu" | Isigned Cge -> "bge"
-+ | Iunsigned Clt -> "bltu" | Isigned Clt -> "blt"
-+ | Iunsigned Cgt -> "bgtu" | Isigned Cgt -> "bgt"
-+ in
-+ ` {emit_string name} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label
lbl}\n`
-+ | Iinttest_imm _ ->
-+ fatal_error "Emit.emit_instr (Iinttest_imm _)"
-+ | Ifloattest(cmp, neg) ->
-+ let neg = match cmp with
-+ | Ceq -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`; neg
-+ | Cne -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`; not neg
-+ | Clt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`; neg
-+ | Cgt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg
i.arg.(0)}\n`; neg
-+ | Cle -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`; neg
-+ | Cge -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg
i.arg.(0)}\n`; neg
-+ in
-+ if neg then
-+ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n`
-+ else
-+ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n`
-+ | Ioddtest ->
-+ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`;
-+ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n`
-+ | Ieventest ->
-+ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`;
-+ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n`
-+ end
-+ | Lcondbranch3(lbl0, lbl1, lbl2) ->
-+ ` addi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, -1\n`;
-+ begin match lbl0 with
-+ | None -> ()
-+ | Some lbl -> ` bltz {emit_reg reg_tmp1}, {emit_label lbl}\n`
-+ end;
-+ begin match lbl1 with
-+ | None -> ()
-+ | Some lbl -> ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n`
-+ end;
-+ begin match lbl2 with
-+ | None -> ()
-+ | Some lbl -> ` bgtz {emit_reg reg_tmp1}, {emit_label lbl}\n`
-+ end
-+ | Lswitch jumptbl -> (* FIXME FIXME ? *)
-+ let lbl = new_label() in
-+ ` la {emit_reg reg_tmp1}, {emit_label lbl}\n`;
-+ ` slli {emit_reg reg_tmp2}, {emit_reg i.arg.(0)}, 2\n`;
-+ ` add {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_reg reg_tmp2}\n`;
-+ ` jr {emit_reg reg_tmp1}\n`;
-+ `{emit_label lbl}:\n`;
-+ for i = 0 to Array.length jumptbl - 1 do
-+ ` j {emit_label jumptbl.(i)}\n`
-+ done
-+ | Lsetuptrap lbl ->
-+ ` addi sp, sp, -16\n`;
-+ ` jal {emit_label lbl}\n`
-+ | Lpushtrap ->
-+ stack_offset := !stack_offset + 16;
-+ ` {emit_string stg} ra, {emit_int size_addr}(sp)\n`;
-+ ` {emit_string stg} {emit_reg reg_trap}, 0(sp)\n`;
-+ ` mv {emit_reg reg_trap}, sp\n`
-+ | Lpoptrap ->
-+ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`;
-+ ` addi sp, sp, 16\n`;
-+ stack_offset := !stack_offset - 16
-+ | Lraise k ->
-+ begin match !Clflags.debug, k with
-+ | true, Cmm.Raise_withtrace ->
-+ ` call {emit_symbol "caml_raise_exn"}\n`;
-+ record_frame Reg.Set.empty true i.dbg
-+ | false, _
-+ | true, Cmm.Raise_notrace ->
-+ ` mv sp, {emit_reg reg_trap}\n`;
-+ ` {emit_string lg} {emit_reg reg_tmp1}, {emit_int size_addr}(sp)\n`;
-+ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`;
-+ ` addi sp, sp, 16\n`;
-+ ` jalr {emit_reg reg_tmp1}\n`
-+ end
-+
-+(* Emit a sequence of instructions *)
-+
-+let rec emit_all = function
-+ | {desc = Lend} -> () | i -> emit_instr i; emit_all i.next
-+
-+(* Emission of a function declaration *)
-+
-+let fundecl fundecl =
-+ function_name := fundecl.fun_name;
-+ tailrec_entry_point := new_label();
-+ stack_offset := 0;
-+ call_gc_sites := [];
-+ bound_error_sites := [];
-+ float_literals := [];
-+ ` .globl {emit_symbol fundecl.fun_name}\n`;
-+ ` .type {emit_symbol fundecl.fun_name}, @function\n`;
-+ ` {emit_string code_space}\n`;
-+ ` .align 2\n`;
-+ `{emit_symbol fundecl.fun_name}:\n`;
-+ let n = frame_size() in
-+ if n > 0 then
-+ ` addi sp, sp, {emit_int(-n)}\n`;
-+ if !contains_calls then
-+ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\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;
-+ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
-+ (* Emit the float literals *)
-+ if !float_literals <> [] then begin
-+ ` {emit_string rodata_space}\n`;
-+ ` .align 3\n`;
-+ List.iter
-+ (fun (f, lbl) ->
-+ `{emit_label lbl}:\n`;
-+ if rv64
-+ then emit_float64_directive ".quad" f
-+ else emit_float64_split_directive ".long" f)
-+ !float_literals;
-+ end
-+
-+(* Emission of data *)
-+
-+let declare_global_data s =
-+ ` .globl {emit_symbol s}\n`;
-+ ` .type {emit_symbol s}, @object\n`
-+
-+let emit_item = function
-+ | Cglobal_symbol s ->
-+ declare_global_data s
-+ | Cdefine_symbol s ->
-+ `{emit_symbol s}:\n`;
-+ | Cint8 n ->
-+ ` .byte {emit_int n}\n`
-+ | Cint16 n ->
-+ ` .short {emit_int n}\n`
-+ | Cint32 n ->
-+ ` .long {emit_nativeint n}\n`
-+ | Cint n ->
-+ ` {emit_string datag} {emit_nativeint n}\n`
-+ | Csingle f ->
-+ emit_float32_directive ".long" (Int32.bits_of_float f)
-+ | Cdouble f ->
-+ if rv64
-+ then emit_float64_directive ".quad" (Int64.bits_of_float f)
-+ else emit_float64_split_directive ".long" (Int64.bits_of_float f)
-+ | Csymbol_address s ->
-+ ` {emit_string datag} {emit_symbol s}\n`
-+ | Cstring s ->
-+ emit_bytes_directive " .byte " s
-+ | Cskip n ->
-+ if n > 0 then ` .space {emit_int n}\n`
-+ | Calign n ->
-+ ` .align {emit_int (Misc.log2 n)}\n`
-+
-+let data l =
-+ ` {emit_string data_space}\n`;
-+ List.iter emit_item l
-+
-+(* Beginning / end of an assembly file *)
-+
-+let begin_assembly() =
-+ (* Emit the beginning of the segments *)
-+ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
-+ ` {emit_string data_space}\n`;
-+ declare_global_data lbl_begin;
-+ `{emit_symbol lbl_begin}:\n`;
-+ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
-+ ` {emit_string code_space}\n`;
-+ declare_global_data lbl_begin;
-+ `{emit_symbol lbl_begin}:\n`
-+
-+let end_assembly() =
-+ ` {emit_string code_space}\n`;
-+ let lbl_end = Compilenv.make_symbol (Some "code_end") in
-+ declare_global_data lbl_end;
-+ `{emit_symbol lbl_end}:\n`;
-+ ` .long 0\n`;
-+ ` {emit_string data_space}\n`;
-+ let lbl_end = Compilenv.make_symbol (Some "data_end") in
-+ declare_global_data lbl_end;
-+ `{emit_symbol lbl_end}:\n`;
-+ ` {emit_string datag} 0\n`;
-+ (* Emit the frame descriptors *)
-+ ` {emit_string rodata_space}\n`;
-+ let lbl = Compilenv.make_symbol (Some "frametable") in
-+ declare_global_data lbl;
-+ `{emit_symbol lbl}:\n`;
-+ emit_frames
-+ { efa_code_label = (fun l -> ` {emit_string datag} {emit_label l}\n`);
-+ efa_data_label = (fun l -> ` {emit_string datag} {emit_label l}\n`);
-+ efa_16 = (fun n -> ` .short {emit_int n}\n`);
-+ efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
-+ efa_word = (fun n -> ` {emit_string datag} {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 l -> `{emit_label l}:\n`);
-+ efa_string = (fun s -> emit_bytes_directive " .byte " (s ^
"\000"))
-+ }
-diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml
-new file mode 100644
-index 000000000..c0b0dcdb8
---- /dev/null
-+++ b/asmcomp/riscv/proc.ml
-@@ -0,0 +1,301 @@
-+(***********************************************************************)
-+(* *)
-+(* OCaml *)
-+(* *)
-+(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
-+(* *)
-+(* Copyright 2016 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. *)
-+(* *)
-+(***********************************************************************)
-+
-+(* Description of the RISC-V *)
-+
-+open Misc
-+open Cmm
-+open Reg
-+open Arch
-+open Mach
-+
-+(* Instruction selection *)
-+
-+let word_addressed = false
-+
-+(* Registers available for register allocation *)
-+
-+(* Integer register map:
-+ zero always zero
-+ ra return address
-+ sp, gp, tp stack pointer, global pointer, thread pointer (preserved by
C)
-+ a0 - a7 0 - 7 arguments/results
-+ s2 - s9 8 - 15 arguments/results (preserved by C)
-+ t2 - t6 16 - 20 temporary
-+ t0 21 temporary (used by assembler)
-+ t1 22 temporary (reserved for code gen)
-+ s0 23 frame pointer (preserved by C)
-+ s1 24 trap pointer (preserved by C)
-+ s10 25 allocation pointer (preserved by C)
-+ s11 26 allocation limit (preserved by C)
-+ Floating-point register map:
-+ ft0 - ft7 100 - 107 temporary
-+ fs0 - fs1 108 - 109 general purpose (preserved by C)
-+ fa0 - fa7 110 - 117 arguments/results
-+ fs2 - fs9 118 - 125 arguments/results (preserved by C)
-+ fs10 - fs11 126 - 127 general purpose (preserved by C)
-+ ft8 - ft11 128 - 131 temporary
-+*)
-+
-+let int_reg_name =
-+ [| "a0"; "a1"; "a2"; "a3"; "a4";
"a5"; "a6"; "a7";
-+ "s2"; "s3"; "s4"; "s5"; "s6";
"s7"; "s8"; "s9";
-+ "t2"; "t3"; "t4"; "t5"; "t6";
-+ "t0"; "t1";
-+ "s0"; "s1"; "s10"; "s11" |]
-+
-+let float_reg_name =
-+ [| "ft0"; "ft1"; "ft2"; "ft3";
"ft4"; "ft5"; "ft6"; "ft7";
-+ "fs0"; "fs1";
-+ "fa0"; "fa1"; "fa2"; "fa3";
"fa4"; "fa5"; "fa6"; "fa7";
-+ "fs2"; "fs3"; "fs4"; "fs5";
"fs6"; "fs7"; "fs8"; "fs9"; "fs10";
"fs11";
-+ "ft8"; "ft9"; "ft10"; "ft11" |]
-+
-+let num_register_classes = 2
-+
-+let register_class r =
-+ match r.typ with
-+ | Val | Int | Addr -> 0
-+ | Float -> 1
-+
-+let num_available_registers = [| 21; 32 |]
-+
-+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.make 27 Reg.dummy in
-+ for i = 0 to 26 do
-+ v.(i) <- Reg.at_location Int (Reg i)
-+ done;
-+ v
-+
-+let hard_float_reg =
-+ let v = Array.make 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 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.make (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
-+ | Val | 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 _ = fatal_error "Proc.loc_results: cannot call"
-+
-+let max_arguments_for_tailcalls = 16
-+
-+let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
-+
-+(* OCaml calling convention:
-+ first integer args in a0 .. a7, s2 .. s9
-+ first float args in fa0 .. fa7, fs2 .. fs9
-+ remaining args on stack.
-+ Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *)
-+
-+let single_regs arg = Array.map (fun arg -> [| arg |]) arg
-+let ensure_single_regs res =
-+ Array.map (function
-+ | [| res |] -> res
-+ | _ -> failwith "proc.ensure_single_regs"
-+ ) res
-+
-+let loc_arguments arg =
-+ calling_conventions 0 15 110 125 outgoing arg
-+
-+let loc_parameters arg =
-+ let (loc, _ofs) =
-+ calling_conventions 0 15 110 125 incoming arg
-+ in
-+ loc
-+
-+let loc_results res =
-+ let (loc, _ofs) =
-+ calling_conventions 0 15 110 125 not_supported res
-+ in
-+ loc
-+
-+(* C calling convention:
-+ first integer args in a0 .. a7
-+ first float args in fa0 .. fa7
-+ remaining args on stack.
-+ Return values in a0 .. a1 or fa0 .. fa1. *)
-+
-+let external_calling_conventions
-+ first_int last_int first_float last_float make_stack arg =
-+ let loc = Array.make (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) with
-+ | [| arg |] ->
-+ begin match arg.typ with
-+ | Val | Int | Addr as ty ->
-+ if !int <= last_int then begin
-+ loc.(i) <- [| phys_reg !int |];
-+ incr int;
-+ incr float;
-+ 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;
-+ incr int;
-+ end else begin
-+ loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
-+ ofs := !ofs + size_float
-+ end
-+ end
-+ | [| arg1; arg2 |] ->
-+ (* Passing of 64-bit quantities to external functions on 32-bit
-+ platform. *)
-+ assert (size_int = 4);
-+ begin match arg1.typ, arg2.typ with
-+ | Int, Int ->
-+ int := Misc.align !int 2;
-+ if !int <= last_int - 1 then begin
-+ let reg_lower = phys_reg !int in
-+ let reg_upper = phys_reg (!int + 1) in
-+ loc.(i) <- [| reg_lower; reg_upper |];
-+ int := !int + 2
-+ end else begin
-+ let size_int64 = 8 in
-+ ofs := Misc.align !ofs size_int64;
-+ let ofs_lower = !ofs in
-+ let ofs_upper = !ofs + size_int in
-+ let stack_lower = stack_slot (make_stack ofs_lower) Int in
-+ let stack_upper = stack_slot (make_stack ofs_upper) Int in
-+ loc.(i) <- [| stack_lower; stack_upper |];
-+ ofs := !ofs + size_int64
-+ end
-+ | _ ->
-+ let f = function Int -> "I" | Addr -> "A" | Val
-> "V" | Float -> "F" in
-+ fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \
-+ type(s) for multi-register argument: %s,
%s"
-+ (f arg1.typ) (f arg2.typ))
-+ end
-+ | _ ->
-+ fatal_error "Proc.calling_conventions: bad number of register for \
-+ multi-register argument"
-+ done;
-+ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *)
-+
-+let loc_external_arguments arg =
-+ external_calling_conventions 0 7 110 117 outgoing arg
-+
-+let loc_external_results res =
-+ let (loc, _ofs) =
-+ external_calling_conventions 0 1 110 111 not_supported (single_regs res)
-+ in
-+ ensure_single_regs loc
-+
-+(* Exceptions are in GPR 3 *)
-+
-+let loc_exn_bucket = phys_reg 0
-+
-+(* Volatile registers: none *)
-+
-+let regs_are_volatile _ = false
-+
-+(* Registers destroyed by operations *)
-+
-+let destroyed_at_c_call =
-+ Array.of_list(List.map phys_reg
-+ [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; (* 21; 22; *)
-+ 100; 101; 102; 103; 104; 105; 106; 107; 110; 111; 112; 113; 114; 115; 116;
-+ 117; 128; 129; 130; 131])
-+
-+let destroyed_at_oper = function
-+ | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs
-+ | Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call
-+ | _ -> [||]
-+
-+let destroyed_at_raise = all_phys_regs
-+
-+(* Maximal register pressure *)
-+
-+let safe_register_pressure = function
-+ | Iextcall _ -> 15
-+ | _ -> 21
-+
-+let max_register_pressure = function
-+ | Iextcall _ -> [| 15; 18 |]
-+ | _ -> [| 21; 30 |]
-+
-+(* Pure operations (without any side effect besides updating their result
-+ registers). *)
-+
-+let op_is_pure = function
-+ | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
-+ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-+ | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
-+ | Ispecific(Imultaddf _ | Imultsubf _) -> true
-+ | _ -> true
-+
-+(* 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/riscv/reload.ml b/asmcomp/riscv/reload.ml
-new file mode 100644
-index 000000000..85b970342
---- /dev/null
-+++ b/asmcomp/riscv/reload.ml
-@@ -0,0 +1,16 @@
-+(***********************************************************************)
-+(* *)
-+(* OCaml *)
-+(* *)
-+(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
-+(* *)
-+(* Copyright 2016 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 RISC-V *)
-+
-+let fundecl f =
-+ (new Reloadgen.reload_generic)#fundecl f
-diff --git a/asmcomp/riscv/scheduling.ml b/asmcomp/riscv/scheduling.ml
-new file mode 100644
-index 000000000..e436be1cc
---- /dev/null
-+++ b/asmcomp/riscv/scheduling.ml
-@@ -0,0 +1,19 @@
-+(***********************************************************************)
-+(* *)
-+(* OCaml *)
-+(* *)
-+(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
-+(* *)
-+(* Copyright 2016 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. *)
-+(* *)
-+(***********************************************************************)
-+
-+(* Instruction scheduling for the RISC-V *)
-+
-+let _ = let module M = Schedgen in () (* to create a dependency *)
-+
-+(* Scheduling is turned off. *)
-+
-+let fundecl f = f
-diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml
-new file mode 100644
-index 000000000..60ec5cb4e
---- /dev/null
-+++ b/asmcomp/riscv/selection.ml
-@@ -0,0 +1,85 @@
-+(***********************************************************************)
-+(* *)
-+(* OCaml *)
-+(* *)
-+(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
-+(* *)
-+(* Copyright 2016 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. *)
-+(* *)
-+(***********************************************************************)
-+
-+(* Instruction selection for the RISC-V processor *)
-+
-+open Cmm
-+open Arch
-+open Mach
-+
-+(* Instruction selection *)
-+
-+class selector = object (self)
-+
-+inherit Selectgen.selector_generic as super
-+
-+method is_immediate n = (n <= 0x7FF) && (n >= -0x800)
-+
-+method select_addressing _ = function
-+ | Cop(Cadda, [arg; Cconst_int n]) when self#is_immediate n ->
-+ (Iindexed n, arg)
-+ | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) when self#is_immediate n ->
-+ (Iindexed n, Cop(Caddi, [arg1; arg2]))
-+ | arg ->
-+ (Iindexed 0, arg)
-+
-+method! select_operation op args =
-+ match (op, args) with
-+ (* RISC-V does not support immediate operands for multiply high *)
-+ | (Cmulhi, _) -> (Iintop Imulh, args)
-+ (* The and, or and xor instructions 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 (neg-)mult-add and (neg-)mult-sub instructions *)
-+ | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3])
-+ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) ->
-+ (Ispecific (Imultaddf false), [arg1; arg2; arg3])
-+ | (Csubf, [Cop(Cmulf, [arg1; arg2]); arg3]) ->
-+ (Ispecific (Imultsubf false), [arg1; arg2; arg3])
-+ | (Cnegf, [Cop(Csubf, [Cop(Cmulf, [arg1; arg2]); arg3])]) ->
-+ (Ispecific (Imultsubf true), [arg1; arg2; arg3])
-+ | (Cnegf, [Cop(Caddf, [Cop(Cmulf, [arg1; arg2]); arg3])]) ->
-+ (Ispecific (Imultaddf true), [arg1; arg2; arg3])
-+ (* RISC-V does not support immediate operands for comparison operators *)
-+ | (Ccmpi comp, args) -> (Iintop(Icomp (Isigned comp)), args)
-+ | (Ccmpa comp, args) -> (Iintop(Icomp (Iunsigned comp)), args)
-+ | (Cmuli, _) -> (Iintop Imul, args)
-+ | _ ->
-+ super#select_operation op args
-+
-+method select_logical op = function
-+ | [arg; Cconst_int n] when n >= 0 && n <= 0xFFF ->
-+ (Iintop_imm(op, n), [arg])
-+ | [Cconst_int n; arg] when n >= 0 && n <= 0xFFF ->
-+ (Iintop_imm(op, n), [arg])
-+ | args ->
-+ (Iintop op, args)
-+
-+(* Instruction selection for conditionals *)
-+
-+method! select_condition = function
-+ | Cop(Ccmpi cmp, args) ->
-+ (Iinttest(Isigned cmp), Ctuple args)
-+ | Cop(Ccmpa cmp, args) ->
-+ (Iinttest(Iunsigned cmp), Ctuple args)
-+ | Cop(Ccmpf cmp, args) ->
-+ (Ifloattest(cmp, false), Ctuple args)
-+ | Cop(Cand, [arg; Cconst_int 1]) ->
-+ (Ioddtest, arg)
-+ | arg ->
-+ (Itruetest, arg)
-+
-+end
-+
-+let fundecl f = (new selector)#emit_fundecl f
-diff --git a/asmrun/riscv.S b/asmrun/riscv.S
-new file mode 100644
-index 000000000..a82048efc
---- /dev/null
-+++ b/asmrun/riscv.S
-@@ -0,0 +1,424 @@
-+/***********************************************************************/
-+/* */
-+/* OCaml */
-+/* */
-+/* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> */
-+/* */
-+/* Copyright 1996 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, RISC-V processor, 64-bit mode */
-+/* Must be preprocessed by cpp */
-+
-+#define TRAP_PTR s1
-+#define ALLOC_PTR s10
-+#define ALLOC_LIMIT s11
-+#define TMP0 t0
-+#define TMP1 t1
-+#define ARG t2
-+
-+#if defined(MODEL_riscv64)
-+#define store sd
-+#define load ld
-+#define WSZ 8
-+#else
-+#define store sw
-+#define load lw
-+#define WSZ 4
-+#endif
-+
-+#if defined(__PIC__)
-+ .option pic
-+#else
-+ .option nopic
-+#endif
-+
-+ .section .text
-+/* Invoke the garbage collector. */
-+
-+ .globl caml_system__code_begin
-+caml_system__code_begin:
-+
-+ .align 2
-+ .globl caml_call_gc
-+ .type caml_call_gc, @function
-+caml_call_gc:
-+ /* Record return address */
-+ store ra, caml_last_return_address, TMP0
-+ /* Record lowest stack address */
-+ mv TMP1, sp
-+ store sp, caml_bottom_of_stack, TMP0
-+.Lcaml_call_gc:
-+ /* Set up stack space, saving return address */
-+ /* (1 reg for RA, 1 reg for FP, 21 allocatable int regs, 20 caller-save float
regs) * 8 */
-+ /* + 1 for alignment */
-+ addi sp, sp, -0x160
-+ mv s0, sp
-+ store ra, 0x8(sp)
-+ store s0, 0x0(sp)
-+ /* Save allocatable integer registers on the stack,
-+ in the order given in proc.ml */
-+ store a0, 0x10(sp)
-+ store a1, 0x18(sp)
-+ store a2, 0x20(sp)
-+ store a3, 0x28(sp)
-+ store a4, 0x30(sp)
-+ store a5, 0x38(sp)
-+ store a6, 0x40(sp)
-+ store a7, 0x48(sp)
-+ store s2, 0x50(sp)
-+ store s3, 0x58(sp)
-+ store s4, 0x60(sp)
-+ store s5, 0x68(sp)
-+ store s6, 0x70(sp)
-+ store s7, 0x78(sp)
-+ store s8, 0x80(sp)
-+ store s9, 0x88(sp)
-+ store t2, 0x90(sp)
-+ store t3, 0x98(sp)
-+ store t4, 0xa0(sp)
-+ store t5, 0xa8(sp)
-+ store t6, 0xb0(sp)
-+ /* Save caller-save floating-point registers on the stack
-+ (callee-saves are preserved by caml_garbage_collection) */
-+ fsd ft0, 0xb8(sp)
-+ fsd ft1, 0xc0(sp)
-+ fsd ft2, 0xc8(sp)
-+ fsd ft3, 0xd0(sp)
-+ fsd ft4, 0xd8(sp)
-+ fsd ft5, 0xe0(sp)
-+ fsd ft6, 0xe8(sp)
-+ fsd ft7, 0xf0(sp)
-+ fsd fa0, 0xf8(sp)
-+ fsd fa1, 0x100(sp)
-+ fsd fa2, 0x108(sp)
-+ fsd fa3, 0x110(sp)
-+ fsd fa4, 0x118(sp)
-+ fsd fa5, 0x120(sp)
-+ fsd fa6, 0x128(sp)
-+ fsd fa7, 0x130(sp)
-+ fsd ft8, 0x138(sp)
-+ fsd ft9, 0x140(sp)
-+ fsd ft9, 0x148(sp)
-+ fsd ft10, 0x150(sp)
-+ fsd ft11, 0x158(sp)
-+ /* Store pointer to saved integer registers in caml_gc_regs */
-+ addi TMP1, sp, 16
-+ store TMP1, caml_gc_regs, TMP0
-+ /* Save current allocation pointer for debugging purposes */
-+ store ALLOC_PTR, caml_young_ptr, TMP0
-+ /* Save trap pointer in case an exception is raised during GC */
-+ store TRAP_PTR, caml_exception_pointer, TMP0
-+ /* Call the garbage collector */
-+ call caml_garbage_collection
-+ /* Restore registers */
-+ load a0, 0x10(sp)
-+ load a1, 0x18(sp)
-+ load a2, 0x20(sp)
-+ load a3, 0x28(sp)
-+ load a4, 0x30(sp)
-+ load a5, 0x38(sp)
-+ load a6, 0x40(sp)
-+ load a7, 0x48(sp)
-+ load s2, 0x50(sp)
-+ load s3, 0x58(sp)
-+ load s4, 0x60(sp)
-+ load s5, 0x68(sp)
-+ load s6, 0x70(sp)
-+ load s7, 0x78(sp)
-+ load s8, 0x80(sp)
-+ load s9, 0x88(sp)
-+ load t2, 0x90(sp)
-+ load t3, 0x98(sp)
-+ load t4, 0xa0(sp)
-+ load t5, 0xa8(sp)
-+ load t6, 0xb0(sp)
-+ fld ft0, 0xb8(sp)
-+ fld ft1, 0xc0(sp)
-+ fld ft2, 0xc8(sp)
-+ fld ft3, 0xd0(sp)
-+ fld ft4, 0xd8(sp)
-+ fld ft5, 0xe0(sp)
-+ fld ft6, 0xe8(sp)
-+ fld ft7, 0xf0(sp)
-+ fld fa0, 0xf8(sp)
-+ fld fa1, 0x100(sp)
-+ fld fa2, 0x108(sp)
-+ fld fa3, 0x110(sp)
-+ fld fa4, 0x118(sp)
-+ fld fa5, 0x120(sp)
-+ fld fa6, 0x128(sp)
-+ fld fa7, 0x130(sp)
-+ fld ft8, 0x138(sp)
-+ fld ft9, 0x140(sp)
-+ fld ft9, 0x148(sp)
-+ fld ft10, 0x150(sp)
-+ fld ft11, 0x158(sp)
-+ /* Reload new allocation pointer and allocation limit */
-+ load ALLOC_PTR, caml_young_ptr
-+ load ALLOC_LIMIT, caml_young_limit
-+ /* Free stack space and return to caller */
-+ load ra, 0x8(sp)
-+ load s0, 0x0(sp)
-+ addi sp, sp, 0x160
-+ ret
-+ .size caml_call_gc, .-caml_call_gc
-+
-+/* Call a C function from OCaml */
-+/* Function to call is in ARG */
-+
-+ .align 2
-+ .globl caml_c_call
-+ .type caml_c_call, @function
-+caml_c_call:
-+ /* Preserve return address in callee-save register s2 */
-+ mv s2, ra
-+ /* Record lowest stack address and return address */
-+ store ra, caml_last_return_address, TMP0
-+ store sp, caml_bottom_of_stack, TMP0
-+ /* Make the exception handler alloc ptr available to the C code */
-+ store ALLOC_PTR, caml_young_ptr, TMP0
-+ store TRAP_PTR, caml_exception_pointer, TMP0
-+ /* Call the function */
-+ jalr ARG
-+ /* Reload alloc ptr and alloc limit */
-+ load ALLOC_PTR, caml_young_ptr
-+ load TRAP_PTR, caml_exception_pointer
-+ /* Return */
-+ jr s2
-+ .size caml_c_call, .-caml_c_call
-+
-+/* Raise an exception from OCaml */
-+ .align 2
-+ .globl caml_raise_exn
-+ .type caml_raise_exn, @function
-+caml_raise_exn:
-+ /* Test if backtrace is active */
-+ load TMP1, caml_backtrace_active
-+ bnez TMP1, 2f
-+1: /* Cut stack at current trap handler */
-+ mv sp, TRAP_PTR
-+ /* Pop previous handler and jump to it */
-+ load TMP1, 8(sp)
-+ load TRAP_PTR, 0(sp)
-+ addi sp, sp, 16
-+ jr TMP1
-+2: /* Preserve exception bucket in callee-save register s2 */
-+ mv s2, a0
-+ /* Stash the backtrace */
-+ mv a1, ra
-+ mv a2, sp
-+ mv a3, TRAP_PTR
-+ call caml_stash_backtrace
-+ /* Restore exception bucket and raise */
-+ mv a0, s2
-+ j 1b
-+ .size caml_raise_exn, .-caml_raise_exn
-+
-+ .globl caml_reraise_exn
-+ .type caml_reraise_exn, @function
-+
-+/* Raise an exception from C */
-+
-+ .align 2
-+ .globl caml_raise_exception
-+ .type caml_raise_exception, @function
-+caml_raise_exception:
-+ load TRAP_PTR, caml_exception_pointer
-+ load ALLOC_PTR, caml_young_ptr
-+ load ALLOC_LIMIT, caml_young_limit
-+ load TMP1, caml_backtrace_active
-+ bnez TMP1, 2f
-+1: /* Cut stack at current trap handler */
-+ mv sp, TRAP_PTR
-+ load TMP1, 8(sp)
-+ load TRAP_PTR, 0(sp)
-+ addi sp, sp, 16
-+ jr TMP1
-+2: /* Preserve exception bucket in callee-save register s2 */
-+ mv s2, a0
-+ load a1, caml_last_return_address
-+ load a2, caml_bottom_of_stack
-+ mv a3, TRAP_PTR
-+ call caml_stash_backtrace
-+ mv a0, s2
-+ j 1b
-+ .size caml_raise_exception, .-caml_raise_exception
-+
-+/* Start the OCaml program */
-+
-+ .align 2
-+ .globl caml_start_program
-+ .type caml_start_program, @function
-+caml_start_program:
-+
-+ la ARG, caml_program
-+ /* Code shared with caml_callback* */
-+ /* Address of OCaml code to call is in ARG */
-+ /* Arguments to the OCaml code are in a0 ... a7 */
-+.Ljump_to_caml:
-+ /* Set up stack frame and save callee-save registers */
-+ addi sp, sp, -0xd0
-+ store ra, 0xc0(sp)
-+ store s0, 0x0(sp)
-+ store s1, 0x8(sp)
-+ store s2, 0x10(sp)
-+ store s3, 0x18(sp)
-+ store s4, 0x20(sp)
-+ store s5, 0x28(sp)
-+ store s6, 0x30(sp)
-+ store s7, 0x38(sp)
-+ store s8, 0x40(sp)
-+ store s9, 0x48(sp)
-+ store s10, 0x50(sp)
-+ store s11, 0x58(sp)
-+ fsd fs0, 0x60(sp)
-+ fsd fs1, 0x68(sp)
-+ fsd fs2, 0x70(sp)
-+ fsd fs3, 0x78(sp)
-+ fsd fs4, 0x80(sp)
-+ fsd fs5, 0x88(sp)
-+ fsd fs6, 0x90(sp)
-+ fsd fs7, 0x98(sp)
-+ fsd fs8, 0xa0(sp)
-+ fsd fs9, 0xa8(sp)
-+ fsd fs10, 0xb0(sp)
-+ fsd fs11, 0xb8(sp)
-+ addi sp, sp, -32
-+ /* Setup a callback link on the stack */
-+ load TMP1, caml_bottom_of_stack
-+ store TMP1, 0(sp)
-+ load TMP1, caml_last_return_address
-+ store TMP1, 8(sp)
-+ load TMP1, caml_gc_regs
-+ store TMP1, 16(sp)
-+ /* set up a trap frame */
-+ addi sp, sp, -16
-+ load TMP1, caml_exception_pointer
-+ store TMP1, 0(sp)
-+ lla TMP0, .Ltrap_handler
-+ store TMP0, 8(sp)
-+ mv TRAP_PTR, sp
-+ load ALLOC_PTR, caml_young_ptr
-+ load ALLOC_LIMIT, caml_young_limit
-+ store x0, caml_last_return_address, TMP0
-+ jalr ARG
-+.Lcaml_retaddr: /* pop trap frame, restoring caml_exception_pointer */
-+ load TMP1, 0(sp)
-+ store TMP1, caml_exception_pointer, TMP0
-+ addi sp, sp, 16
-+.Lreturn_result: /* pop callback link, restoring global variables */
-+ load TMP1, 0(sp)
-+ store TMP1, caml_bottom_of_stack, TMP0
-+ load TMP1, 8(sp)
-+ store TMP1, caml_last_return_address, TMP0
-+ load TMP1, 16(sp)
-+ store TMP1, caml_gc_regs, TMP0
-+ addi sp, sp, 32
-+ /* Update allocation pointer */
-+ store ALLOC_PTR, caml_young_ptr, TMP0
-+ /* reload callee-save registers and return */
-+ load ra, 0xc0(sp)
-+ load s0, 0x0(sp)
-+ load s1, 0x8(sp)
-+ load s2, 0x10(sp)
-+ load s3, 0x18(sp)
-+ load s4, 0x20(sp)
-+ load s5, 0x28(sp)
-+ load s6, 0x30(sp)
-+ load s7, 0x38(sp)
-+ load s8, 0x40(sp)
-+ load s9, 0x48(sp)
-+ load s10, 0x50(sp)
-+ load s11, 0x58(sp)
-+ fld fs0, 0x60(sp)
-+ fld fs1, 0x68(sp)
-+ fld fs2, 0x70(sp)
-+ fld fs3, 0x78(sp)
-+ fld fs4, 0x80(sp)
-+ fld fs5, 0x88(sp)
-+ fld fs6, 0x90(sp)
-+ fld fs7, 0x98(sp)
-+ fld fs8, 0xa0(sp)
-+ fld fs9, 0xa8(sp)
-+ fld fs10, 0xb0(sp)
-+ fld fs11, 0xb8(sp)
-+ addi sp, sp, 0xd0
-+ ret
-+.Ltrap_handler:
-+ store TRAP_PTR, caml_exception_pointer, TMP0
-+ ori a0, a0, 2
-+ j .Lreturn_result
-+ .size caml_start_program, .-caml_start_program
-+
-+/* Callback from C to OCaml */
-+
-+ .align 2
-+ .globl caml_callback_exn
-+ .type caml_callback_exn, @function
-+caml_callback_exn:
-+ /* Initial shuffling of arguments (a0 = closure, a1 = first arg) */
-+ mv TMP1, a0
-+ mv a0, a1 /* a0 = first arg */
-+ mv a1, TMP1 /* a1 = closure environment */
-+ load ARG, 0(TMP1) /* code pointer */
-+ j .Ljump_to_caml
-+ .size caml_callback_exn, .-caml_callback_exn
-+
-+ .align 2
-+ .globl caml_callback2_exn
-+ .type caml_callback2_exn, @function
-+caml_callback2_exn:
-+ /* Initial shuffling of arguments (a0 = closure, a1 = arg1, a2 = arg2) */
-+ mv TMP1, a0
-+ mv a0, a1
-+ mv a1, a2
-+ mv a2, TMP1
-+ la ARG, caml_apply2
-+ j .Ljump_to_caml
-+ .size caml_callback2_exn, .-caml_callback2_exn
-+
-+ .align 2
-+ .globl caml_callback3_exn
-+ .type caml_callback3_exn, @function
-+caml_callback3_exn:
-+ /* Initial shuffling of argumnets */
-+ /* (a0 = closure, a1 = arg1, a2 = arg2, a3 = arg3) */
-+ mv TMP1, a0
-+ mv a0, a1
-+ mv a1, a2
-+ mv a2, a3
-+ mv a3, TMP1
-+ la ARG, caml_apply3
-+ j .Ljump_to_caml
-+ .size caml_callback3_exn, .-caml_callback3_exn
-+
-+ .align 2
-+ .globl caml_ml_array_bound_error
-+ .type caml_ml_array_bound_error, @function
-+caml_ml_array_bound_error:
-+ /* Load address of [caml_array_bound_error] in ARG */
-+ la ARG, caml_array_bound_error
-+ /* Call that function */
-+ j caml_c_call
-+
-+ .globl caml_system__code_end
-+caml_system__code_end:
-+
-+/* GC roots for callback */
-+
-+ .section .data
-+ .align 3
-+ .globl caml_system__frametable
-+ .type caml_system__frametable, @object
-+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
-+ .size caml_system__frametable, .-caml_system__frametable
-diff --git a/byterun/caml/stack.h b/byterun/caml/stack.h
-index fd9d528e9..781c2517b 100644
---- a/byterun/caml/stack.h
-+++ b/byterun/caml/stack.h
-@@ -75,6 +75,11 @@
- #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
- #endif
-
-+#ifdef TARGET_riscv /* FIXME FIXME */
-+#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/configure b/configure
-index d53d90367..04acb43be 100755
---- a/configure
-+++ b/configure
-@@ -820,6 +820,7 @@ if test $with_sharedlibs = "yes"; then
- arm*-*-freebsd*) natdynlink=true;;
- earm*-*-netbsd*) natdynlink=true;;
- aarch64-*-linux*) natdynlink=true;;
-+ riscv*-*-linux*) natdynlink=true;;
- esac
- fi
-
-@@ -889,6 +890,8 @@ case "$target" in
- x86_64-*-mingw*) arch=amd64; system=mingw;;
- aarch64-*-linux*) arch=arm64; system=linux;;
- x86_64-*-cygwin*) arch=amd64; system=cygwin;;
-+ riscv32-*-linux*) arch=riscv; model=riscv32; system=linux;;
-+ riscv64-*-linux*) arch=riscv; model=riscv64; system=linux;;
- esac
-
- # Some platforms exist both in 32-bit and 64-bit variants, not distinguished
-@@ -964,7 +967,7 @@ case "$arch,$system" in
- aspp="${TOOLPREF}cc -c";;
- *,freebsd) as="${TOOLPREF}as"
- aspp="${TOOLPREF}cc -c";;
-- amd64,*|arm,*|arm64,*|i386,*|power,bsd*|sparc,*)
-+ amd64,*|arm,*|arm64,*|i386,*|power,bsd*|sparc,*|riscv,*)
- as="${TOOLPREF}as"
- aspp="${TOOLPREF}gcc -c";;
- esac
---
-2.13.1
-
diff --git a/0006-configure-Allow-user-defined-C-compiler-flags.patch
b/0006-configure-Allow-user-defined-C-compiler-flags.patch
new file mode 100644
index 0000000..acb7097
--- /dev/null
+++ b/0006-configure-Allow-user-defined-C-compiler-flags.patch
@@ -0,0 +1,27 @@
+From 313692e7425fd91917d4e35ad4ade459cb2c1138 Mon Sep 17 00:00:00 2001
+From: "Richard W.M. Jones" <rjones(a)redhat.com>
+Date: Tue, 29 May 2012 20:44:18 +0100
+Subject: [PATCH 06/12] configure: Allow user defined C compiler flags.
+
+---
+ configure | 4 ++++
+ 1 file changed, 4 insertions(+)
+
+diff --git a/configure b/configure
+index e79659954..786f4cdbe 100755
+--- a/configure
++++ b/configure
+@@ -2002,6 +2002,10 @@ if $with_fpic; then
+ echo "#define CAML_WITH_FPIC" >> m.h
+ fi
+
++# Allow user defined C Compiler flags
++bytecccompopts="$bytecccompopts $CFLAGS"
++nativecccompopts="$nativecccompopts $CFLAGS"
++
+ # Finish generated files
+
+ cclibs="$cclibs $mathlib"
+--
+2.13.1
+
diff --git a/0007-Adapt-config.guess-for-RISC-V.patch
b/0007-Adapt-config.guess-for-RISC-V.patch
new file mode 100644
index 0000000..82c55e8
--- /dev/null
+++ b/0007-Adapt-config.guess-for-RISC-V.patch
@@ -0,0 +1,35 @@
+From 68a8eb8f3bbc254cd5cb685f058bc5b0ef1029e7 Mon Sep 17 00:00:00 2001
+From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
+Date: Tue, 8 Nov 2016 23:56:50 +0100
+Subject: [PATCH 07/12] Adapt config.guess for RISC-V
+
+---
+ config/gnu/config.guess | 5 ++++-
+ 1 file changed, 4 insertions(+), 1 deletion(-)
+
+diff --git a/config/gnu/config.guess b/config/gnu/config.guess
+index b79252d6b..8335398b2 100755
+--- a/config/gnu/config.guess
++++ b/config/gnu/config.guess
+@@ -2,7 +2,7 @@
+ # Attempt to guess a canonical system name.
+ # Copyright 1992-2013 Free Software Foundation, Inc.
+
+-timestamp='2013-06-10'
++timestamp='2016-10-23'
+
+ # 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
+@@ -1001,6 +1001,9 @@ EOF
+ ppcle:Linux:*:*)
+ echo powerpcle-unknown-linux-${LIBC}
+ exit ;;
++ riscv*:Linux:*:*)
++ echo ${UNAME_MACHINE}-unknown-linux
++ exit ;;
+ s390:Linux:*:* | s390x:Linux:*:*)
+ echo ${UNAME_MACHINE}-ibm-linux-${LIBC}
+ exit ;;
+--
+2.13.1
+
diff --git a/0007-Try-fix-for-andi-ori-xori-immediates-1.patch
b/0007-Try-fix-for-andi-ori-xori-immediates-1.patch
deleted file mode 100644
index 1a5f503..0000000
--- a/0007-Try-fix-for-andi-ori-xori-immediates-1.patch
+++ /dev/null
@@ -1,43 +0,0 @@
-From 80e5cd3dc503319490761a705e14f3fa421ff760 Mon Sep 17 00:00:00 2001
-From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
-Date: Thu, 10 Nov 2016 14:12:53 +0100
-Subject: [PATCH 7/9] Try fix for andi/ori/xori immediates (#1)
-
----
- asmcomp/riscv/selection.ml | 13 -------------
- 1 file changed, 13 deletions(-)
-
-diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml
-index 60ec5cb4e..ad2b26e9b 100644
---- a/asmcomp/riscv/selection.ml
-+++ b/asmcomp/riscv/selection.ml
-@@ -36,11 +36,6 @@ method! select_operation op args =
- match (op, args) with
- (* RISC-V does not support immediate operands for multiply high *)
- | (Cmulhi, _) -> (Iintop Imulh, args)
-- (* The and, or and xor instructions 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 (neg-)mult-add and (neg-)mult-sub instructions *)
- | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3])
- | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) ->
-@@ -58,14 +53,6 @@ method! select_operation op args =
- | _ ->
- super#select_operation op args
-
--method select_logical op = function
-- | [arg; Cconst_int n] when n >= 0 && n <= 0xFFF ->
-- (Iintop_imm(op, n), [arg])
-- | [Cconst_int n; arg] when n >= 0 && n <= 0xFFF ->
-- (Iintop_imm(op, n), [arg])
-- | args ->
-- (Iintop op, args)
--
- (* Instruction selection for conditionals *)
-
- method! select_condition = function
---
-2.13.1
-
diff --git a/0008-Add-RISC-V-backend-runtime.patch
b/0008-Add-RISC-V-backend-runtime.patch
new file mode 100644
index 0000000..75132bf
--- /dev/null
+++ b/0008-Add-RISC-V-backend-runtime.patch
@@ -0,0 +1,1717 @@
+From d0f08d1cfa01efb02721f7d2e04ce61f38d6d6a7 Mon Sep 17 00:00:00 2001
+From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
+Date: Fri, 4 Nov 2016 20:39:09 +0100
+Subject: [PATCH 08/12] Add RISC-V backend & runtime
+
+---
+ README.adoc | 1 +
+ asmcomp/riscv/CSE.ml | 36 +++
+ asmcomp/riscv/arch.ml | 84 ++++++
+ asmcomp/riscv/emit.mlp | 616 ++++++++++++++++++++++++++++++++++++++++++++
+ asmcomp/riscv/proc.ml | 301 ++++++++++++++++++++++
+ asmcomp/riscv/reload.ml | 16 ++
+ asmcomp/riscv/scheduling.ml | 19 ++
+ asmcomp/riscv/selection.ml | 85 ++++++
+ asmrun/riscv.S | 424 ++++++++++++++++++++++++++++++
+ byterun/caml/stack.h | 5 +
+ configure | 5 +-
+ 11 files changed, 1591 insertions(+), 1 deletion(-)
+ create mode 100644 asmcomp/riscv/CSE.ml
+ create mode 100644 asmcomp/riscv/arch.ml
+ create mode 100644 asmcomp/riscv/emit.mlp
+ create mode 100644 asmcomp/riscv/proc.ml
+ create mode 100644 asmcomp/riscv/reload.ml
+ create mode 100644 asmcomp/riscv/scheduling.ml
+ create mode 100644 asmcomp/riscv/selection.ml
+ create mode 100644 asmrun/riscv.S
+
+diff --git a/README.adoc b/README.adoc
+index fe07edbba..f7d13bc06 100644
+--- a/README.adoc
++++ b/README.adoc
+@@ -34,6 +34,7 @@ IA32 (Pentium):: NetBSD, OpenBSD, Solaris 9
+ PowerPC:: NetBSD
+ ARM:: NetBSD
+ SPARC:: Solaris, Linux, NetBSD
++RISC-V:: Linux
+
+ Other operating systems for the processors above have not been tested, but
+ the compiler may work under other operating systems with little work.
+diff --git a/asmcomp/riscv/CSE.ml b/asmcomp/riscv/CSE.ml
+new file mode 100644
+index 000000000..302811a99
+--- /dev/null
++++ b/asmcomp/riscv/CSE.ml
+@@ -0,0 +1,36 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
++(* *)
++(* Copyright 2106 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. *)
++(* *)
++(***********************************************************************)
++
++(* CSE for the RISC-V *)
++
++open Arch
++open Mach
++open CSEgen
++
++class cse = object (_self)
++
++inherit cse_generic as super
++
++method! class_of_operation op =
++ match op with
++ | Ispecific(Imultaddf _ | Imultsubf _) -> Op_pure
++ | _ -> super#class_of_operation op
++
++method! is_cheap_operation op =
++ match op with
++ | Iconst_int n -> n <= 0x7FFn && n >= -0x800n
++ | _ -> false
++
++end
++
++let fundecl f =
++ (new cse)#fundecl f
+diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml
+new file mode 100644
+index 000000000..61a38b1dd
+--- /dev/null
++++ b/asmcomp/riscv/arch.ml
+@@ -0,0 +1,84 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
++(* *)
++(* Copyright 2016 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. *)
++(* *)
++(***********************************************************************)
++
++(* Specific operations for the RISC-V processor *)
++
++open Format
++
++(* Machine-specific command-line options *)
++
++let command_line_options = []
++
++(* Specific operations *)
++
++type specific_operation =
++ | Imultaddf of bool (* multiply, optionally negate, and add *)
++ | Imultsubf of bool (* multiply, optionally negate, and subtract *)
++
++let spacetime_node_hole_pointer_is_live_before = function
++ | Imultaddf _ | Imultsubf _ -> false
++
++(* Addressing modes *)
++
++type addressing_mode =
++ | Iindexed of int (* reg + displ *)
++
++(* Sizes, endianness *)
++
++let big_endian = false
++
++let rv64 =
++ match Config.model with "riscv64" -> true | "riscv32" ->
false | _ -> assert false
++
++let size_addr = if rv64 then 8 else 4
++let size_int = size_addr
++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)
++
++let num_args_addressing = function
++ | Iindexed _ -> 1
++
++(* Printing operations and addressing modes *)
++
++let print_addressing printreg addr ppf arg =
++ match addr with
++ | Iindexed n ->
++ let idx = if n <> 0 then Printf.sprintf " + %i" n else
"" in
++ fprintf ppf "%a%s" printreg arg.(0) idx
++
++let print_specific_operation printreg op ppf arg =
++ match op with
++ | Imultaddf false ->
++ fprintf ppf "%a *f %a +f %a"
++ printreg arg.(0) printreg arg.(1) printreg arg.(2)
++ | Imultaddf true ->
++ fprintf ppf "-f (%a *f %a +f %a)"
++ printreg arg.(0) printreg arg.(1) printreg arg.(2)
++ | Imultsubf false ->
++ fprintf ppf "%a *f %a -f %a"
++ printreg arg.(0) printreg arg.(1) printreg arg.(2)
++ | Imultsubf true ->
++ fprintf ppf "-f (%a *f %a -f %a)"
++ printreg arg.(0) printreg arg.(1) printreg arg.(2)
+diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
+new file mode 100644
+index 000000000..6d0e3aefd
+--- /dev/null
++++ b/asmcomp/riscv/emit.mlp
+@@ -0,0 +1,616 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
++(* *)
++(* Copyright 2016 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. *)
++(* *)
++(***********************************************************************)
++
++(* Emission of RISC-V assembly code *)
++
++open Misc
++open Cmm
++open Arch
++open Proc
++open Reg
++open Mach
++open Linearize
++open Emitaux
++
++(* Layout of the stack. The stack is kept 16-aligned. *)
++
++let stack_offset = ref 0
++
++let frame_size () =
++ let size =
++ !stack_offset + (* Trap frame, outgoing parameters *)
++ size_int * num_stack_slots.(0) + (* Local int variables *)
++ size_float * num_stack_slots.(1) + (* Local float variables *)
++ (if !contains_calls then size_addr else 0) in (* The return address *)
++ Misc.align size 16
++
++let slot_offset loc cls =
++ match loc with
++ | Local n ->
++ if cls = 0
++ then !stack_offset + num_stack_slots.(1) * size_float + n * size_int
++ else !stack_offset + n * size_float
++ | Incoming n -> frame_size() + n
++ | Outgoing n -> n
++
++(* Output a symbol *)
++
++let emit_symbol s =
++ Emitaux.emit_symbol '.' s
++
++(* Output a label *)
++
++let label_prefix = "L"
++
++let emit_label lbl =
++ emit_string label_prefix; emit_int lbl
++
++(* Section switching *)
++
++let data_space =
++ ".section .data"
++
++let code_space =
++ ".section .text"
++
++let rodata_space =
++ ".section .rodata"
++
++let reg_tmp1 = phys_reg 21 (* used by the assembler *)
++let reg_tmp2 = phys_reg 22
++let reg_t2 = phys_reg 16
++(* let reg_fp = phys_reg 23 *)
++let reg_trap = phys_reg 24
++let reg_alloc_ptr = phys_reg 25
++let reg_alloc_lim = phys_reg 26
++
++(* Names of instructions that differ in 32 and 64-bit modes *)
++
++let lg = if rv64 then "ld" else "lw"
++let stg = if rv64 then "sd" else "sw"
++let datag = if rv64 then ".quad" else ".long"
++
++(* Output a pseudo-register *)
++
++let emit_reg = function
++ | {loc = Reg r} -> emit_string (register_name r)
++ | _ -> fatal_error "Emit.emit_reg"
++
++(* Output a stack reference *)
++
++let emit_stack r =
++ match r.loc with
++ Stack s ->
++ let ofs = slot_offset s (register_class r) in `{emit_int ofs}(sp)`
++ | _ -> fatal_error "Emit.emit_stack"
++
++(* Record live pointers at call points *)
++
++let record_frame_label ?label live raise_ dbg =
++ let lbl =
++ match label with
++ | None -> new_label()
++ | Some label -> label
++ in
++ let live_offset = ref [] in
++ Reg.Set.iter
++ (function
++ {typ = Val; loc = Reg r} ->
++ live_offset := (r lsl 1) + 1 :: !live_offset
++ | {typ = Val; loc = Stack s} as reg ->
++ live_offset := slot_offset s (register_class reg) :: !live_offset
++ | {typ = Addr} as r ->
++ Misc.fatal_error ("bad GC root " ^ Reg.name r)
++ | _ -> ()
++ )
++ live;
++ frame_descriptors :=
++ { fd_lbl = lbl;
++ fd_frame_size = frame_size();
++ fd_live_offset = !live_offset;
++ fd_raise = raise_;
++ fd_debuginfo = dbg } :: !frame_descriptors;
++ lbl
++
++let record_frame ?label live raise_ dbg =
++ let lbl = record_frame_label ?label live raise_ dbg in
++ `{emit_label lbl}:\n`
++
++(* 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}:\n`;
++ ` call {emit_symbol "caml_call_gc"}\n`;
++ `{emit_label gc.gc_frame_lbl}:\n`;
++ ` j {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 ?label dbg =
++ if !Clflags.debug || !bound_error_sites = [] then begin
++ let lbl_bound_error = new_label() in
++ let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
++ bound_error_sites :=
++ { bd_lbl = lbl_bound_error;
++ bd_frame_lbl = lbl_frame } :: !bound_error_sites;
++ lbl_bound_error
++ end else
++ let bd = List.hd !bound_error_sites in
++ bd.bd_lbl
++
++let emit_call_bound_error bd =
++ `{emit_label bd.bd_lbl}:\n`;
++ ` call {emit_symbol "caml_ml_array_bound_error"}\n`;
++ `{emit_label bd.bd_frame_lbl}:\n`
++
++(* Record floating-point literals *)
++
++let float_literals = ref ([] : (int64 * int) list)
++
++(* Names for various instructions *)
++
++let name_for_intop = function
++ | Iadd -> "add"
++ | Isub -> "sub"
++ | Imul -> "mul"
++ | Imulh -> "mulh"
++ | Idiv -> "div"
++ | Iand -> "and"
++ | Ior -> "or"
++ | Ixor -> "xor"
++ | Ilsl -> "sll"
++ | Ilsr -> "srl"
++ | Iasr -> "sra"
++ | Imod -> "rem"
++ | _ -> fatal_error "Emit.Intop"
++
++let name_for_intop_imm = function
++ | Iadd -> "addi"
++ | Iand -> "andi"
++ | Ior -> "ori"
++ | Ixor -> "xori"
++ | Ilsl -> "slli"
++ | Ilsr -> "srli"
++ | Iasr -> "srai"
++ | _ -> fatal_error "Emit.Intop_imm"
++
++let name_for_floatop1 = function
++ | Inegf -> "fneg.d"
++ | Iabsf -> "fabs.d"
++ | _ -> fatal_error "Emit.Iopf1"
++
++let name_for_floatop2 = function
++ | Iaddf -> "fadd.d"
++ | Isubf -> "fsub.d"
++ | Imulf -> "fmul.d"
++ | Idivf -> "fdiv.d"
++ | _ -> fatal_error "Emit.Iopf2"
++
++let name_for_specific = function
++ | Imultaddf false -> "fmadd.d"
++ | Imultaddf true -> "fnmadd.d"
++ | Imultsubf false -> "fmsub.d"
++ | Imultsubf true -> "fnmsub.d"
++
++(* Name of current function *)
++let function_name = ref ""
++(* Entry point for tail recursive calls *)
++let tailrec_entry_point = ref 0
++
++(* Output the assembly code for an instruction *)
++
++let emit_instr i =
++ 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 = (Val | Int | Addr)}, {loc = Reg _} ->
++ ` mv {emit_reg dst}, {emit_reg src}\n`
++ | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
++ ` fmv.d {emit_reg dst}, {emit_reg src}\n`
++ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} ->
++ ` {emit_string stg} {emit_reg src}, {emit_stack dst}\n`
++ | {loc = Reg _; typ = Float}, {loc = Stack _} ->
++ ` fsd {emit_reg src}, {emit_stack dst}\n`
++ | {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _ } ->
++ ` {emit_string lg} {emit_reg dst}, {emit_stack src}\n`
++ | {loc = Stack _; typ = Float}, {loc = Reg _} ->
++ ` fld {emit_reg dst}, {emit_stack src}\n`
++ | _ ->
++ fatal_error "Emit: Imove"
++ end
++ | Lop(Iconst_int n) ->
++ ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n`
++ | Lop(Iconst_float f) ->
++ let lbl = new_label() in
++ float_literals := (f, lbl) :: !float_literals;
++ ` fld {emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp1}\n`
++ | Lop(Iconst_symbol s) ->
++ ` la {emit_reg i.res.(0)}, {emit_symbol s}\n`
++ | Lop(Icall_ind {label_after = label}) ->
++ ` jalr {emit_reg i.arg.(0)}\n`;
++ record_frame ~label i.live false i.dbg
++ | Lop(Icall_imm {func; label_after = label}) ->
++ ` call {emit_symbol func}\n`;
++ record_frame ~label i.live false i.dbg
++ | Lop(Itailcall_ind {label_after = _}) ->
++ let n = frame_size() in
++ if !contains_calls then
++ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
++ if n > 0 then
++ ` addi sp, sp, {emit_int n}\n`;
++ ` jr {emit_reg i.arg.(0)}\n`
++ | Lop(Itailcall_imm {func; label_after = _}) ->
++ if func = !function_name then begin
++ ` j {emit_label !tailrec_entry_point}\n`
++ end else begin
++ let n = frame_size() in
++ if !contains_calls then
++ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
++ if n > 0 then
++ ` addi sp, sp, {emit_int n}\n`;
++ ` tail {emit_symbol func}\n`
++ end
++ | Lop(Iextcall{func; alloc = true; label_after = label}) ->
++ ` la {emit_reg reg_t2}, {emit_symbol func}\n`;
++ ` call {emit_symbol "caml_c_call"}\n`;
++ record_frame ~label i.live false i.dbg
++ | Lop(Iextcall{func; alloc = false; label_after = _}) ->
++ ` call {emit_symbol func}\n`
++ | Lop(Istackoffset n) ->
++ assert (n mod 16 = 0);
++ ` addi sp, sp, {emit_int (-n)}\n`;
++ stack_offset := !stack_offset + n
++ | Lop(Iload(Single, Iindexed ofs)) ->
++ ` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
++ ` fcvt.d.s {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
++ | Lop(Iload(chunk, Iindexed ofs)) ->
++ let instr =
++ match chunk with
++ | Byte_unsigned -> "lbu"
++ | Byte_signed -> "lb"
++ | Sixteen_unsigned -> "lhu"
++ | Sixteen_signed -> "lh"
++ | Thirtytwo_unsigned -> if rv64 then "lwu" else "lw"
++ | Thirtytwo_signed -> "lw"
++ | Word_int | Word_val -> lg
++ | Single -> assert false
++ | Double | Double_u -> "fld"
++ in
++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg
i.arg.(0)})\n`
++ | Lop(Istore(Single, Iindexed ofs, _)) ->
++ ` fmv.x.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}\n`;
++ ` fcvt.s.d {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}\n`;
++ ` fsw {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`;
++ ` fmv.d.x {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}\n`
++ | Lop(Istore(chunk, Iindexed ofs, _)) ->
++ let instr =
++ match chunk with
++ | Byte_unsigned | Byte_signed -> "sb"
++ | Sixteen_unsigned | Sixteen_signed -> "sh"
++ | Thirtytwo_unsigned | Thirtytwo_signed -> "sw"
++ | Word_int | Word_val -> stg
++ | Single -> assert false
++ | Double | Double_u -> "fsd"
++ in
++ ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg
i.arg.(1)})\n`
++ | Lop(Ialloc {words = n; label_after_call_gc = label; _}) ->
++ let lbl_frame_lbl = record_frame_label ?label i.live false i.dbg in
++ let lbl_redo = new_label () in
++ let lbl_call_gc = new_label () in
++ `{emit_label lbl_redo}:\n`;
++ ` addi {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, -{emit_int n}\n`;
++ ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`;
++ ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_lim}, {emit_label
lbl_call_gc}\n`;
++ call_gc_sites :=
++ { gc_lbl = lbl_call_gc;
++ gc_return_lbl = lbl_redo;
++ gc_frame_lbl = lbl_frame_lbl } :: !call_gc_sites
++ | Lop(Iintop(Icomp cmp)) ->
++ begin match cmp with
++ | Isigned Clt ->
++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
++ | Isigned Cge ->
++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
++ | Isigned Cgt ->
++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
++ | Isigned Cle ->
++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
++ | Isigned Ceq | Iunsigned Ceq ->
++ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
++ ` seqz {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
++ | Isigned Cne | Iunsigned Cne ->
++ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
++ ` snez {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
++ | Iunsigned Clt ->
++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
++ | Iunsigned Cge ->
++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
++ | Iunsigned Cgt ->
++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
++ | Iunsigned Cle ->
++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
++ end
++ | Lop(Iintop (Icheckbound {label_after_error = label; _})) ->
++ let lbl = bound_error_label ?label i.dbg in
++ ` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
++ | Lop(Iintop op) ->
++ let instr = name_for_intop op in
++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`
++ | Lop(Iintop_imm(Isub, n)) ->
++ ` addi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n`
++ | Lop(Iintop_imm(Icomp _, _)) ->
++ fatal_error "Emit.emit_instr (Iintop_imm (Icomp _, _))"
++ | Lop(Iintop_imm(Icheckbound {label_after_error = label; _}, n)) ->
++ let lbl = bound_error_label ?label i.dbg in
++ ` li {emit_reg reg_tmp1}, {emit_int n}\n`;
++ ` bleu {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, {emit_label lbl}\n`
++ | Lop(Iintop_imm(op, n)) ->
++ let instr = name_for_intop_imm op in
++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n`
++ | Lop(Inegf | Iabsf as op) ->
++ let instr = name_for_floatop1 op in
++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
++ | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
++ let instr = name_for_floatop2 op in
++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`
++ | Lop(Ifloatofint) ->
++ let name = if rv64 then "fcvt.d.l" else "fcvt.d.w" in
++ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
++ | Lop(Iintoffloat) ->
++ let name = if rv64 then "fcvt.l.d" else "fcvt.w.d" in
++ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
++ | Lop(Ispecific sop) ->
++ let instr = name_for_specific sop 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`
++ | Lreloadretaddr ->
++ let n = frame_size () in
++ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`
++ | Lreturn ->
++ let n = frame_size() in
++ if n > 0 then
++ ` addi sp, sp, {emit_int n}\n`;
++ ` ret\n`
++ | Llabel lbl ->
++ `{emit_label lbl}:\n`
++ | Lbranch lbl ->
++ ` j {emit_label lbl}\n`
++ | Lcondbranch(tst, lbl) ->
++ begin match tst with
++ | Itruetest ->
++ ` bnez {emit_reg i.arg.(0)}, {emit_label lbl}\n`
++ | Ifalsetest ->
++ ` beqz {emit_reg i.arg.(0)}, {emit_label lbl}\n`
++ | Iinttest cmp ->
++ let name = match cmp with
++ | Iunsigned Ceq | Isigned Ceq -> "beq"
++ | Iunsigned Cne | Isigned Cne -> "bne"
++ | Iunsigned Cle -> "bleu" | Isigned Cle -> "ble"
++ | Iunsigned Cge -> "bgeu" | Isigned Cge -> "bge"
++ | Iunsigned Clt -> "bltu" | Isigned Clt -> "blt"
++ | Iunsigned Cgt -> "bgtu" | Isigned Cgt -> "bgt"
++ in
++ ` {emit_string name} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label
lbl}\n`
++ | Iinttest_imm _ ->
++ fatal_error "Emit.emit_instr (Iinttest_imm _)"
++ | Ifloattest(cmp, neg) ->
++ let neg = match cmp with
++ | Ceq -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`; neg
++ | Cne -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`; not neg
++ | Clt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`; neg
++ | Cgt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg
i.arg.(0)}\n`; neg
++ | Cle -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}\n`; neg
++ | Cge -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg
i.arg.(0)}\n`; neg
++ in
++ if neg then
++ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n`
++ else
++ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n`
++ | Ioddtest ->
++ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`;
++ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n`
++ | Ieventest ->
++ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`;
++ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n`
++ end
++ | Lcondbranch3(lbl0, lbl1, lbl2) ->
++ ` addi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, -1\n`;
++ begin match lbl0 with
++ | None -> ()
++ | Some lbl -> ` bltz {emit_reg reg_tmp1}, {emit_label lbl}\n`
++ end;
++ begin match lbl1 with
++ | None -> ()
++ | Some lbl -> ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n`
++ end;
++ begin match lbl2 with
++ | None -> ()
++ | Some lbl -> ` bgtz {emit_reg reg_tmp1}, {emit_label lbl}\n`
++ end
++ | Lswitch jumptbl -> (* FIXME FIXME ? *)
++ let lbl = new_label() in
++ ` la {emit_reg reg_tmp1}, {emit_label lbl}\n`;
++ ` slli {emit_reg reg_tmp2}, {emit_reg i.arg.(0)}, 2\n`;
++ ` add {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_reg reg_tmp2}\n`;
++ ` jr {emit_reg reg_tmp1}\n`;
++ `{emit_label lbl}:\n`;
++ for i = 0 to Array.length jumptbl - 1 do
++ ` j {emit_label jumptbl.(i)}\n`
++ done
++ | Lsetuptrap lbl ->
++ ` addi sp, sp, -16\n`;
++ ` jal {emit_label lbl}\n`
++ | Lpushtrap ->
++ stack_offset := !stack_offset + 16;
++ ` {emit_string stg} ra, {emit_int size_addr}(sp)\n`;
++ ` {emit_string stg} {emit_reg reg_trap}, 0(sp)\n`;
++ ` mv {emit_reg reg_trap}, sp\n`
++ | Lpoptrap ->
++ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`;
++ ` addi sp, sp, 16\n`;
++ stack_offset := !stack_offset - 16
++ | Lraise k ->
++ begin match !Clflags.debug, k with
++ | true, Cmm.Raise_withtrace ->
++ ` call {emit_symbol "caml_raise_exn"}\n`;
++ record_frame Reg.Set.empty true i.dbg
++ | false, _
++ | true, Cmm.Raise_notrace ->
++ ` mv sp, {emit_reg reg_trap}\n`;
++ ` {emit_string lg} {emit_reg reg_tmp1}, {emit_int size_addr}(sp)\n`;
++ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`;
++ ` addi sp, sp, 16\n`;
++ ` jalr {emit_reg reg_tmp1}\n`
++ end
++
++(* Emit a sequence of instructions *)
++
++let rec emit_all = function
++ | {desc = Lend} -> () | i -> emit_instr i; emit_all i.next
++
++(* Emission of a function declaration *)
++
++let fundecl fundecl =
++ function_name := fundecl.fun_name;
++ tailrec_entry_point := new_label();
++ stack_offset := 0;
++ call_gc_sites := [];
++ bound_error_sites := [];
++ float_literals := [];
++ ` .globl {emit_symbol fundecl.fun_name}\n`;
++ ` .type {emit_symbol fundecl.fun_name}, @function\n`;
++ ` {emit_string code_space}\n`;
++ ` .align 2\n`;
++ `{emit_symbol fundecl.fun_name}:\n`;
++ let n = frame_size() in
++ if n > 0 then
++ ` addi sp, sp, {emit_int(-n)}\n`;
++ if !contains_calls then
++ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\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;
++ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
++ (* Emit the float literals *)
++ if !float_literals <> [] then begin
++ ` {emit_string rodata_space}\n`;
++ ` .align 3\n`;
++ List.iter
++ (fun (f, lbl) ->
++ `{emit_label lbl}:\n`;
++ if rv64
++ then emit_float64_directive ".quad" f
++ else emit_float64_split_directive ".long" f)
++ !float_literals;
++ end
++
++(* Emission of data *)
++
++let declare_global_data s =
++ ` .globl {emit_symbol s}\n`;
++ ` .type {emit_symbol s}, @object\n`
++
++let emit_item = function
++ | Cglobal_symbol s ->
++ declare_global_data s
++ | Cdefine_symbol s ->
++ `{emit_symbol s}:\n`;
++ | Cint8 n ->
++ ` .byte {emit_int n}\n`
++ | Cint16 n ->
++ ` .short {emit_int n}\n`
++ | Cint32 n ->
++ ` .long {emit_nativeint n}\n`
++ | Cint n ->
++ ` {emit_string datag} {emit_nativeint n}\n`
++ | Csingle f ->
++ emit_float32_directive ".long" (Int32.bits_of_float f)
++ | Cdouble f ->
++ if rv64
++ then emit_float64_directive ".quad" (Int64.bits_of_float f)
++ else emit_float64_split_directive ".long" (Int64.bits_of_float f)
++ | Csymbol_address s ->
++ ` {emit_string datag} {emit_symbol s}\n`
++ | Cstring s ->
++ emit_bytes_directive " .byte " s
++ | Cskip n ->
++ if n > 0 then ` .space {emit_int n}\n`
++ | Calign n ->
++ ` .align {emit_int (Misc.log2 n)}\n`
++
++let data l =
++ ` {emit_string data_space}\n`;
++ List.iter emit_item l
++
++(* Beginning / end of an assembly file *)
++
++let begin_assembly() =
++ (* Emit the beginning of the segments *)
++ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
++ ` {emit_string data_space}\n`;
++ declare_global_data lbl_begin;
++ `{emit_symbol lbl_begin}:\n`;
++ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
++ ` {emit_string code_space}\n`;
++ declare_global_data lbl_begin;
++ `{emit_symbol lbl_begin}:\n`
++
++let end_assembly() =
++ ` {emit_string code_space}\n`;
++ let lbl_end = Compilenv.make_symbol (Some "code_end") in
++ declare_global_data lbl_end;
++ `{emit_symbol lbl_end}:\n`;
++ ` .long 0\n`;
++ ` {emit_string data_space}\n`;
++ let lbl_end = Compilenv.make_symbol (Some "data_end") in
++ declare_global_data lbl_end;
++ `{emit_symbol lbl_end}:\n`;
++ ` {emit_string datag} 0\n`;
++ (* Emit the frame descriptors *)
++ ` {emit_string rodata_space}\n`;
++ let lbl = Compilenv.make_symbol (Some "frametable") in
++ declare_global_data lbl;
++ `{emit_symbol lbl}:\n`;
++ emit_frames
++ { efa_code_label = (fun l -> ` {emit_string datag} {emit_label l}\n`);
++ efa_data_label = (fun l -> ` {emit_string datag} {emit_label l}\n`);
++ efa_16 = (fun n -> ` .short {emit_int n}\n`);
++ efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
++ efa_word = (fun n -> ` {emit_string datag} {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 l -> `{emit_label l}:\n`);
++ efa_string = (fun s -> emit_bytes_directive " .byte " (s ^
"\000"))
++ }
+diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml
+new file mode 100644
+index 000000000..c0b0dcdb8
+--- /dev/null
++++ b/asmcomp/riscv/proc.ml
+@@ -0,0 +1,301 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
++(* *)
++(* Copyright 2016 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. *)
++(* *)
++(***********************************************************************)
++
++(* Description of the RISC-V *)
++
++open Misc
++open Cmm
++open Reg
++open Arch
++open Mach
++
++(* Instruction selection *)
++
++let word_addressed = false
++
++(* Registers available for register allocation *)
++
++(* Integer register map:
++ zero always zero
++ ra return address
++ sp, gp, tp stack pointer, global pointer, thread pointer (preserved by
C)
++ a0 - a7 0 - 7 arguments/results
++ s2 - s9 8 - 15 arguments/results (preserved by C)
++ t2 - t6 16 - 20 temporary
++ t0 21 temporary (used by assembler)
++ t1 22 temporary (reserved for code gen)
++ s0 23 frame pointer (preserved by C)
++ s1 24 trap pointer (preserved by C)
++ s10 25 allocation pointer (preserved by C)
++ s11 26 allocation limit (preserved by C)
++ Floating-point register map:
++ ft0 - ft7 100 - 107 temporary
++ fs0 - fs1 108 - 109 general purpose (preserved by C)
++ fa0 - fa7 110 - 117 arguments/results
++ fs2 - fs9 118 - 125 arguments/results (preserved by C)
++ fs10 - fs11 126 - 127 general purpose (preserved by C)
++ ft8 - ft11 128 - 131 temporary
++*)
++
++let int_reg_name =
++ [| "a0"; "a1"; "a2"; "a3"; "a4";
"a5"; "a6"; "a7";
++ "s2"; "s3"; "s4"; "s5"; "s6";
"s7"; "s8"; "s9";
++ "t2"; "t3"; "t4"; "t5"; "t6";
++ "t0"; "t1";
++ "s0"; "s1"; "s10"; "s11" |]
++
++let float_reg_name =
++ [| "ft0"; "ft1"; "ft2"; "ft3";
"ft4"; "ft5"; "ft6"; "ft7";
++ "fs0"; "fs1";
++ "fa0"; "fa1"; "fa2"; "fa3";
"fa4"; "fa5"; "fa6"; "fa7";
++ "fs2"; "fs3"; "fs4"; "fs5";
"fs6"; "fs7"; "fs8"; "fs9"; "fs10";
"fs11";
++ "ft8"; "ft9"; "ft10"; "ft11" |]
++
++let num_register_classes = 2
++
++let register_class r =
++ match r.typ with
++ | Val | Int | Addr -> 0
++ | Float -> 1
++
++let num_available_registers = [| 21; 32 |]
++
++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.make 27 Reg.dummy in
++ for i = 0 to 26 do
++ v.(i) <- Reg.at_location Int (Reg i)
++ done;
++ v
++
++let hard_float_reg =
++ let v = Array.make 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 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.make (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
++ | Val | 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 _ = fatal_error "Proc.loc_results: cannot call"
++
++let max_arguments_for_tailcalls = 16
++
++let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
++
++(* OCaml calling convention:
++ first integer args in a0 .. a7, s2 .. s9
++ first float args in fa0 .. fa7, fs2 .. fs9
++ remaining args on stack.
++ Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *)
++
++let single_regs arg = Array.map (fun arg -> [| arg |]) arg
++let ensure_single_regs res =
++ Array.map (function
++ | [| res |] -> res
++ | _ -> failwith "proc.ensure_single_regs"
++ ) res
++
++let loc_arguments arg =
++ calling_conventions 0 15 110 125 outgoing arg
++
++let loc_parameters arg =
++ let (loc, _ofs) =
++ calling_conventions 0 15 110 125 incoming arg
++ in
++ loc
++
++let loc_results res =
++ let (loc, _ofs) =
++ calling_conventions 0 15 110 125 not_supported res
++ in
++ loc
++
++(* C calling convention:
++ first integer args in a0 .. a7
++ first float args in fa0 .. fa7
++ remaining args on stack.
++ Return values in a0 .. a1 or fa0 .. fa1. *)
++
++let external_calling_conventions
++ first_int last_int first_float last_float make_stack arg =
++ let loc = Array.make (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) with
++ | [| arg |] ->
++ begin match arg.typ with
++ | Val | Int | Addr as ty ->
++ if !int <= last_int then begin
++ loc.(i) <- [| phys_reg !int |];
++ incr int;
++ incr float;
++ 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;
++ incr int;
++ end else begin
++ loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
++ ofs := !ofs + size_float
++ end
++ end
++ | [| arg1; arg2 |] ->
++ (* Passing of 64-bit quantities to external functions on 32-bit
++ platform. *)
++ assert (size_int = 4);
++ begin match arg1.typ, arg2.typ with
++ | Int, Int ->
++ int := Misc.align !int 2;
++ if !int <= last_int - 1 then begin
++ let reg_lower = phys_reg !int in
++ let reg_upper = phys_reg (!int + 1) in
++ loc.(i) <- [| reg_lower; reg_upper |];
++ int := !int + 2
++ end else begin
++ let size_int64 = 8 in
++ ofs := Misc.align !ofs size_int64;
++ let ofs_lower = !ofs in
++ let ofs_upper = !ofs + size_int in
++ let stack_lower = stack_slot (make_stack ofs_lower) Int in
++ let stack_upper = stack_slot (make_stack ofs_upper) Int in
++ loc.(i) <- [| stack_lower; stack_upper |];
++ ofs := !ofs + size_int64
++ end
++ | _ ->
++ let f = function Int -> "I" | Addr -> "A" | Val
-> "V" | Float -> "F" in
++ fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \
++ type(s) for multi-register argument: %s,
%s"
++ (f arg1.typ) (f arg2.typ))
++ end
++ | _ ->
++ fatal_error "Proc.calling_conventions: bad number of register for \
++ multi-register argument"
++ done;
++ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *)
++
++let loc_external_arguments arg =
++ external_calling_conventions 0 7 110 117 outgoing arg
++
++let loc_external_results res =
++ let (loc, _ofs) =
++ external_calling_conventions 0 1 110 111 not_supported (single_regs res)
++ in
++ ensure_single_regs loc
++
++(* Exceptions are in GPR 3 *)
++
++let loc_exn_bucket = phys_reg 0
++
++(* Volatile registers: none *)
++
++let regs_are_volatile _ = false
++
++(* Registers destroyed by operations *)
++
++let destroyed_at_c_call =
++ Array.of_list(List.map phys_reg
++ [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; (* 21; 22; *)
++ 100; 101; 102; 103; 104; 105; 106; 107; 110; 111; 112; 113; 114; 115; 116;
++ 117; 128; 129; 130; 131])
++
++let destroyed_at_oper = function
++ | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs
++ | Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call
++ | _ -> [||]
++
++let destroyed_at_raise = all_phys_regs
++
++(* Maximal register pressure *)
++
++let safe_register_pressure = function
++ | Iextcall _ -> 15
++ | _ -> 21
++
++let max_register_pressure = function
++ | Iextcall _ -> [| 15; 18 |]
++ | _ -> [| 21; 30 |]
++
++(* Pure operations (without any side effect besides updating their result
++ registers). *)
++
++let op_is_pure = function
++ | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
++ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
++ | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
++ | Ispecific(Imultaddf _ | Imultsubf _) -> true
++ | _ -> true
++
++(* 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/riscv/reload.ml b/asmcomp/riscv/reload.ml
+new file mode 100644
+index 000000000..85b970342
+--- /dev/null
++++ b/asmcomp/riscv/reload.ml
+@@ -0,0 +1,16 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
++(* *)
++(* Copyright 2016 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 RISC-V *)
++
++let fundecl f =
++ (new Reloadgen.reload_generic)#fundecl f
+diff --git a/asmcomp/riscv/scheduling.ml b/asmcomp/riscv/scheduling.ml
+new file mode 100644
+index 000000000..e436be1cc
+--- /dev/null
++++ b/asmcomp/riscv/scheduling.ml
+@@ -0,0 +1,19 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
++(* *)
++(* Copyright 2016 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. *)
++(* *)
++(***********************************************************************)
++
++(* Instruction scheduling for the RISC-V *)
++
++let _ = let module M = Schedgen in () (* to create a dependency *)
++
++(* Scheduling is turned off. *)
++
++let fundecl f = f
+diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml
+new file mode 100644
+index 000000000..60ec5cb4e
+--- /dev/null
++++ b/asmcomp/riscv/selection.ml
+@@ -0,0 +1,85 @@
++(***********************************************************************)
++(* *)
++(* OCaml *)
++(* *)
++(* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> *)
++(* *)
++(* Copyright 2016 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. *)
++(* *)
++(***********************************************************************)
++
++(* Instruction selection for the RISC-V processor *)
++
++open Cmm
++open Arch
++open Mach
++
++(* Instruction selection *)
++
++class selector = object (self)
++
++inherit Selectgen.selector_generic as super
++
++method is_immediate n = (n <= 0x7FF) && (n >= -0x800)
++
++method select_addressing _ = function
++ | Cop(Cadda, [arg; Cconst_int n]) when self#is_immediate n ->
++ (Iindexed n, arg)
++ | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) when self#is_immediate n ->
++ (Iindexed n, Cop(Caddi, [arg1; arg2]))
++ | arg ->
++ (Iindexed 0, arg)
++
++method! select_operation op args =
++ match (op, args) with
++ (* RISC-V does not support immediate operands for multiply high *)
++ | (Cmulhi, _) -> (Iintop Imulh, args)
++ (* The and, or and xor instructions 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 (neg-)mult-add and (neg-)mult-sub instructions *)
++ | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3])
++ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) ->
++ (Ispecific (Imultaddf false), [arg1; arg2; arg3])
++ | (Csubf, [Cop(Cmulf, [arg1; arg2]); arg3]) ->
++ (Ispecific (Imultsubf false), [arg1; arg2; arg3])
++ | (Cnegf, [Cop(Csubf, [Cop(Cmulf, [arg1; arg2]); arg3])]) ->
++ (Ispecific (Imultsubf true), [arg1; arg2; arg3])
++ | (Cnegf, [Cop(Caddf, [Cop(Cmulf, [arg1; arg2]); arg3])]) ->
++ (Ispecific (Imultaddf true), [arg1; arg2; arg3])
++ (* RISC-V does not support immediate operands for comparison operators *)
++ | (Ccmpi comp, args) -> (Iintop(Icomp (Isigned comp)), args)
++ | (Ccmpa comp, args) -> (Iintop(Icomp (Iunsigned comp)), args)
++ | (Cmuli, _) -> (Iintop Imul, args)
++ | _ ->
++ super#select_operation op args
++
++method select_logical op = function
++ | [arg; Cconst_int n] when n >= 0 && n <= 0xFFF ->
++ (Iintop_imm(op, n), [arg])
++ | [Cconst_int n; arg] when n >= 0 && n <= 0xFFF ->
++ (Iintop_imm(op, n), [arg])
++ | args ->
++ (Iintop op, args)
++
++(* Instruction selection for conditionals *)
++
++method! select_condition = function
++ | Cop(Ccmpi cmp, args) ->
++ (Iinttest(Isigned cmp), Ctuple args)
++ | Cop(Ccmpa cmp, args) ->
++ (Iinttest(Iunsigned cmp), Ctuple args)
++ | Cop(Ccmpf cmp, args) ->
++ (Ifloattest(cmp, false), Ctuple args)
++ | Cop(Cand, [arg; Cconst_int 1]) ->
++ (Ioddtest, arg)
++ | arg ->
++ (Itruetest, arg)
++
++end
++
++let fundecl f = (new selector)#emit_fundecl f
+diff --git a/asmrun/riscv.S b/asmrun/riscv.S
+new file mode 100644
+index 000000000..a82048efc
+--- /dev/null
++++ b/asmrun/riscv.S
+@@ -0,0 +1,424 @@
++/***********************************************************************/
++/* */
++/* OCaml */
++/* */
++/* Nicolas Ojeda Bar <n.oje.bar(a)gmail.com> */
++/* */
++/* Copyright 1996 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, RISC-V processor, 64-bit mode */
++/* Must be preprocessed by cpp */
++
++#define TRAP_PTR s1
++#define ALLOC_PTR s10
++#define ALLOC_LIMIT s11
++#define TMP0 t0
++#define TMP1 t1
++#define ARG t2
++
++#if defined(MODEL_riscv64)
++#define store sd
++#define load ld
++#define WSZ 8
++#else
++#define store sw
++#define load lw
++#define WSZ 4
++#endif
++
++#if defined(__PIC__)
++ .option pic
++#else
++ .option nopic
++#endif
++
++ .section .text
++/* Invoke the garbage collector. */
++
++ .globl caml_system__code_begin
++caml_system__code_begin:
++
++ .align 2
++ .globl caml_call_gc
++ .type caml_call_gc, @function
++caml_call_gc:
++ /* Record return address */
++ store ra, caml_last_return_address, TMP0
++ /* Record lowest stack address */
++ mv TMP1, sp
++ store sp, caml_bottom_of_stack, TMP0
++.Lcaml_call_gc:
++ /* Set up stack space, saving return address */
++ /* (1 reg for RA, 1 reg for FP, 21 allocatable int regs, 20 caller-save float
regs) * 8 */
++ /* + 1 for alignment */
++ addi sp, sp, -0x160
++ mv s0, sp
++ store ra, 0x8(sp)
++ store s0, 0x0(sp)
++ /* Save allocatable integer registers on the stack,
++ in the order given in proc.ml */
++ store a0, 0x10(sp)
++ store a1, 0x18(sp)
++ store a2, 0x20(sp)
++ store a3, 0x28(sp)
++ store a4, 0x30(sp)
++ store a5, 0x38(sp)
++ store a6, 0x40(sp)
++ store a7, 0x48(sp)
++ store s2, 0x50(sp)
++ store s3, 0x58(sp)
++ store s4, 0x60(sp)
++ store s5, 0x68(sp)
++ store s6, 0x70(sp)
++ store s7, 0x78(sp)
++ store s8, 0x80(sp)
++ store s9, 0x88(sp)
++ store t2, 0x90(sp)
++ store t3, 0x98(sp)
++ store t4, 0xa0(sp)
++ store t5, 0xa8(sp)
++ store t6, 0xb0(sp)
++ /* Save caller-save floating-point registers on the stack
++ (callee-saves are preserved by caml_garbage_collection) */
++ fsd ft0, 0xb8(sp)
++ fsd ft1, 0xc0(sp)
++ fsd ft2, 0xc8(sp)
++ fsd ft3, 0xd0(sp)
++ fsd ft4, 0xd8(sp)
++ fsd ft5, 0xe0(sp)
++ fsd ft6, 0xe8(sp)
++ fsd ft7, 0xf0(sp)
++ fsd fa0, 0xf8(sp)
++ fsd fa1, 0x100(sp)
++ fsd fa2, 0x108(sp)
++ fsd fa3, 0x110(sp)
++ fsd fa4, 0x118(sp)
++ fsd fa5, 0x120(sp)
++ fsd fa6, 0x128(sp)
++ fsd fa7, 0x130(sp)
++ fsd ft8, 0x138(sp)
++ fsd ft9, 0x140(sp)
++ fsd ft9, 0x148(sp)
++ fsd ft10, 0x150(sp)
++ fsd ft11, 0x158(sp)
++ /* Store pointer to saved integer registers in caml_gc_regs */
++ addi TMP1, sp, 16
++ store TMP1, caml_gc_regs, TMP0
++ /* Save current allocation pointer for debugging purposes */
++ store ALLOC_PTR, caml_young_ptr, TMP0
++ /* Save trap pointer in case an exception is raised during GC */
++ store TRAP_PTR, caml_exception_pointer, TMP0
++ /* Call the garbage collector */
++ call caml_garbage_collection
++ /* Restore registers */
++ load a0, 0x10(sp)
++ load a1, 0x18(sp)
++ load a2, 0x20(sp)
++ load a3, 0x28(sp)
++ load a4, 0x30(sp)
++ load a5, 0x38(sp)
++ load a6, 0x40(sp)
++ load a7, 0x48(sp)
++ load s2, 0x50(sp)
++ load s3, 0x58(sp)
++ load s4, 0x60(sp)
++ load s5, 0x68(sp)
++ load s6, 0x70(sp)
++ load s7, 0x78(sp)
++ load s8, 0x80(sp)
++ load s9, 0x88(sp)
++ load t2, 0x90(sp)
++ load t3, 0x98(sp)
++ load t4, 0xa0(sp)
++ load t5, 0xa8(sp)
++ load t6, 0xb0(sp)
++ fld ft0, 0xb8(sp)
++ fld ft1, 0xc0(sp)
++ fld ft2, 0xc8(sp)
++ fld ft3, 0xd0(sp)
++ fld ft4, 0xd8(sp)
++ fld ft5, 0xe0(sp)
++ fld ft6, 0xe8(sp)
++ fld ft7, 0xf0(sp)
++ fld fa0, 0xf8(sp)
++ fld fa1, 0x100(sp)
++ fld fa2, 0x108(sp)
++ fld fa3, 0x110(sp)
++ fld fa4, 0x118(sp)
++ fld fa5, 0x120(sp)
++ fld fa6, 0x128(sp)
++ fld fa7, 0x130(sp)
++ fld ft8, 0x138(sp)
++ fld ft9, 0x140(sp)
++ fld ft9, 0x148(sp)
++ fld ft10, 0x150(sp)
++ fld ft11, 0x158(sp)
++ /* Reload new allocation pointer and allocation limit */
++ load ALLOC_PTR, caml_young_ptr
++ load ALLOC_LIMIT, caml_young_limit
++ /* Free stack space and return to caller */
++ load ra, 0x8(sp)
++ load s0, 0x0(sp)
++ addi sp, sp, 0x160
++ ret
++ .size caml_call_gc, .-caml_call_gc
++
++/* Call a C function from OCaml */
++/* Function to call is in ARG */
++
++ .align 2
++ .globl caml_c_call
++ .type caml_c_call, @function
++caml_c_call:
++ /* Preserve return address in callee-save register s2 */
++ mv s2, ra
++ /* Record lowest stack address and return address */
++ store ra, caml_last_return_address, TMP0
++ store sp, caml_bottom_of_stack, TMP0
++ /* Make the exception handler alloc ptr available to the C code */
++ store ALLOC_PTR, caml_young_ptr, TMP0
++ store TRAP_PTR, caml_exception_pointer, TMP0
++ /* Call the function */
++ jalr ARG
++ /* Reload alloc ptr and alloc limit */
++ load ALLOC_PTR, caml_young_ptr
++ load TRAP_PTR, caml_exception_pointer
++ /* Return */
++ jr s2
++ .size caml_c_call, .-caml_c_call
++
++/* Raise an exception from OCaml */
++ .align 2
++ .globl caml_raise_exn
++ .type caml_raise_exn, @function
++caml_raise_exn:
++ /* Test if backtrace is active */
++ load TMP1, caml_backtrace_active
++ bnez TMP1, 2f
++1: /* Cut stack at current trap handler */
++ mv sp, TRAP_PTR
++ /* Pop previous handler and jump to it */
++ load TMP1, 8(sp)
++ load TRAP_PTR, 0(sp)
++ addi sp, sp, 16
++ jr TMP1
++2: /* Preserve exception bucket in callee-save register s2 */
++ mv s2, a0
++ /* Stash the backtrace */
++ mv a1, ra
++ mv a2, sp
++ mv a3, TRAP_PTR
++ call caml_stash_backtrace
++ /* Restore exception bucket and raise */
++ mv a0, s2
++ j 1b
++ .size caml_raise_exn, .-caml_raise_exn
++
++ .globl caml_reraise_exn
++ .type caml_reraise_exn, @function
++
++/* Raise an exception from C */
++
++ .align 2
++ .globl caml_raise_exception
++ .type caml_raise_exception, @function
++caml_raise_exception:
++ load TRAP_PTR, caml_exception_pointer
++ load ALLOC_PTR, caml_young_ptr
++ load ALLOC_LIMIT, caml_young_limit
++ load TMP1, caml_backtrace_active
++ bnez TMP1, 2f
++1: /* Cut stack at current trap handler */
++ mv sp, TRAP_PTR
++ load TMP1, 8(sp)
++ load TRAP_PTR, 0(sp)
++ addi sp, sp, 16
++ jr TMP1
++2: /* Preserve exception bucket in callee-save register s2 */
++ mv s2, a0
++ load a1, caml_last_return_address
++ load a2, caml_bottom_of_stack
++ mv a3, TRAP_PTR
++ call caml_stash_backtrace
++ mv a0, s2
++ j 1b
++ .size caml_raise_exception, .-caml_raise_exception
++
++/* Start the OCaml program */
++
++ .align 2
++ .globl caml_start_program
++ .type caml_start_program, @function
++caml_start_program:
++
++ la ARG, caml_program
++ /* Code shared with caml_callback* */
++ /* Address of OCaml code to call is in ARG */
++ /* Arguments to the OCaml code are in a0 ... a7 */
++.Ljump_to_caml:
++ /* Set up stack frame and save callee-save registers */
++ addi sp, sp, -0xd0
++ store ra, 0xc0(sp)
++ store s0, 0x0(sp)
++ store s1, 0x8(sp)
++ store s2, 0x10(sp)
++ store s3, 0x18(sp)
++ store s4, 0x20(sp)
++ store s5, 0x28(sp)
++ store s6, 0x30(sp)
++ store s7, 0x38(sp)
++ store s8, 0x40(sp)
++ store s9, 0x48(sp)
++ store s10, 0x50(sp)
++ store s11, 0x58(sp)
++ fsd fs0, 0x60(sp)
++ fsd fs1, 0x68(sp)
++ fsd fs2, 0x70(sp)
++ fsd fs3, 0x78(sp)
++ fsd fs4, 0x80(sp)
++ fsd fs5, 0x88(sp)
++ fsd fs6, 0x90(sp)
++ fsd fs7, 0x98(sp)
++ fsd fs8, 0xa0(sp)
++ fsd fs9, 0xa8(sp)
++ fsd fs10, 0xb0(sp)
++ fsd fs11, 0xb8(sp)
++ addi sp, sp, -32
++ /* Setup a callback link on the stack */
++ load TMP1, caml_bottom_of_stack
++ store TMP1, 0(sp)
++ load TMP1, caml_last_return_address
++ store TMP1, 8(sp)
++ load TMP1, caml_gc_regs
++ store TMP1, 16(sp)
++ /* set up a trap frame */
++ addi sp, sp, -16
++ load TMP1, caml_exception_pointer
++ store TMP1, 0(sp)
++ lla TMP0, .Ltrap_handler
++ store TMP0, 8(sp)
++ mv TRAP_PTR, sp
++ load ALLOC_PTR, caml_young_ptr
++ load ALLOC_LIMIT, caml_young_limit
++ store x0, caml_last_return_address, TMP0
++ jalr ARG
++.Lcaml_retaddr: /* pop trap frame, restoring caml_exception_pointer */
++ load TMP1, 0(sp)
++ store TMP1, caml_exception_pointer, TMP0
++ addi sp, sp, 16
++.Lreturn_result: /* pop callback link, restoring global variables */
++ load TMP1, 0(sp)
++ store TMP1, caml_bottom_of_stack, TMP0
++ load TMP1, 8(sp)
++ store TMP1, caml_last_return_address, TMP0
++ load TMP1, 16(sp)
++ store TMP1, caml_gc_regs, TMP0
++ addi sp, sp, 32
++ /* Update allocation pointer */
++ store ALLOC_PTR, caml_young_ptr, TMP0
++ /* reload callee-save registers and return */
++ load ra, 0xc0(sp)
++ load s0, 0x0(sp)
++ load s1, 0x8(sp)
++ load s2, 0x10(sp)
++ load s3, 0x18(sp)
++ load s4, 0x20(sp)
++ load s5, 0x28(sp)
++ load s6, 0x30(sp)
++ load s7, 0x38(sp)
++ load s8, 0x40(sp)
++ load s9, 0x48(sp)
++ load s10, 0x50(sp)
++ load s11, 0x58(sp)
++ fld fs0, 0x60(sp)
++ fld fs1, 0x68(sp)
++ fld fs2, 0x70(sp)
++ fld fs3, 0x78(sp)
++ fld fs4, 0x80(sp)
++ fld fs5, 0x88(sp)
++ fld fs6, 0x90(sp)
++ fld fs7, 0x98(sp)
++ fld fs8, 0xa0(sp)
++ fld fs9, 0xa8(sp)
++ fld fs10, 0xb0(sp)
++ fld fs11, 0xb8(sp)
++ addi sp, sp, 0xd0
++ ret
++.Ltrap_handler:
++ store TRAP_PTR, caml_exception_pointer, TMP0
++ ori a0, a0, 2
++ j .Lreturn_result
++ .size caml_start_program, .-caml_start_program
++
++/* Callback from C to OCaml */
++
++ .align 2
++ .globl caml_callback_exn
++ .type caml_callback_exn, @function
++caml_callback_exn:
++ /* Initial shuffling of arguments (a0 = closure, a1 = first arg) */
++ mv TMP1, a0
++ mv a0, a1 /* a0 = first arg */
++ mv a1, TMP1 /* a1 = closure environment */
++ load ARG, 0(TMP1) /* code pointer */
++ j .Ljump_to_caml
++ .size caml_callback_exn, .-caml_callback_exn
++
++ .align 2
++ .globl caml_callback2_exn
++ .type caml_callback2_exn, @function
++caml_callback2_exn:
++ /* Initial shuffling of arguments (a0 = closure, a1 = arg1, a2 = arg2) */
++ mv TMP1, a0
++ mv a0, a1
++ mv a1, a2
++ mv a2, TMP1
++ la ARG, caml_apply2
++ j .Ljump_to_caml
++ .size caml_callback2_exn, .-caml_callback2_exn
++
++ .align 2
++ .globl caml_callback3_exn
++ .type caml_callback3_exn, @function
++caml_callback3_exn:
++ /* Initial shuffling of argumnets */
++ /* (a0 = closure, a1 = arg1, a2 = arg2, a3 = arg3) */
++ mv TMP1, a0
++ mv a0, a1
++ mv a1, a2
++ mv a2, a3
++ mv a3, TMP1
++ la ARG, caml_apply3
++ j .Ljump_to_caml
++ .size caml_callback3_exn, .-caml_callback3_exn
++
++ .align 2
++ .globl caml_ml_array_bound_error
++ .type caml_ml_array_bound_error, @function
++caml_ml_array_bound_error:
++ /* Load address of [caml_array_bound_error] in ARG */
++ la ARG, caml_array_bound_error
++ /* Call that function */
++ j caml_c_call
++
++ .globl caml_system__code_end
++caml_system__code_end:
++
++/* GC roots for callback */
++
++ .section .data
++ .align 3
++ .globl caml_system__frametable
++ .type caml_system__frametable, @object
++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
++ .size caml_system__frametable, .-caml_system__frametable
+diff --git a/byterun/caml/stack.h b/byterun/caml/stack.h
+index fd9d528e9..781c2517b 100644
+--- a/byterun/caml/stack.h
++++ b/byterun/caml/stack.h
+@@ -75,6 +75,11 @@
+ #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
+ #endif
+
++#ifdef TARGET_riscv /* FIXME FIXME */
++#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/configure b/configure
+index 786f4cdbe..b88dab26b 100755
+--- a/configure
++++ b/configure
+@@ -854,6 +854,7 @@ if test $with_sharedlibs = "yes"; then
+ arm*-*-freebsd*) natdynlink=true;;
+ earm*-*-netbsd*) natdynlink=true;;
+ aarch64-*-linux*) natdynlink=true;;
++ riscv*-*-linux*) natdynlink=true;;
+ esac
+ fi
+
+@@ -947,6 +948,8 @@ case "$target" in
+ x86_64-*-mingw*) arch=amd64; system=mingw;;
+ aarch64-*-linux*) arch=arm64; system=linux;;
+ x86_64-*-cygwin*) arch=amd64; system=cygwin;;
++ riscv32-*-linux*) arch=riscv; model=riscv32; system=linux;;
++ riscv64-*-linux*) arch=riscv; model=riscv64; system=linux;;
+ esac
+
+ # Some platforms exist both in 32-bit and 64-bit variants, not distinguished
+@@ -1023,7 +1026,7 @@ case "$arch,$system" in
+ aspp="${TOOLPREF}cc -c";;
+ *,freebsd) as="${TOOLPREF}as"
+ aspp="${TOOLPREF}cc -c";;
+- amd64,*|arm,*|arm64,*|i386,*|power,bsd*|sparc,*)
++ amd64,*|arm,*|arm64,*|i386,*|power,bsd*|sparc,*|riscv,*)
+ as="${TOOLPREF}as"
+ case "$ccfamily" in
+ clang-*)
+--
+2.13.1
+
diff --git a/0008-Fix-immediates-range-when-adjusting-indexing-sp.patch
b/0008-Fix-immediates-range-when-adjusting-indexing-sp.patch
deleted file mode 100644
index da19b82..0000000
--- a/0008-Fix-immediates-range-when-adjusting-indexing-sp.patch
+++ /dev/null
@@ -1,156 +0,0 @@
-From ded14c206a5e73ba5eae6d84ed4ee82c11ce6245 Mon Sep 17 00:00:00 2001
-From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
-Date: Tue, 22 Nov 2016 22:30:35 +0100
-Subject: [PATCH 8/9] Fix immediates' range when adjusting/indexing sp
-
----
- asmcomp/riscv/arch.ml | 3 +++
- asmcomp/riscv/emit.mlp | 53 ++++++++++++++++++++++++++++++++++------------
- asmcomp/riscv/selection.ml | 2 +-
- 3 files changed, 44 insertions(+), 14 deletions(-)
-
-diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml
-index 61a38b1dd..22c807c49 100644
---- a/asmcomp/riscv/arch.ml
-+++ b/asmcomp/riscv/arch.ml
-@@ -32,6 +32,9 @@ let spacetime_node_hole_pointer_is_live_before = function
- type addressing_mode =
- | Iindexed of int (* reg + displ *)
-
-+let is_immediate n =
-+ (n <= 2047) && (n >= -2048)
-+
- (* Sizes, endianness *)
-
- let big_endian = false
-diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
-index 6d0e3aefd..97c49ce80 100644
---- a/asmcomp/riscv/emit.mlp
-+++ b/asmcomp/riscv/emit.mlp
-@@ -93,6 +93,34 @@ let emit_stack r =
- let ofs = slot_offset s (register_class r) in `{emit_int ofs}(sp)`
- | _ -> fatal_error "Emit.emit_stack"
-
-+(* Adjust sp by the given byte amount *)
-+
-+let emit_stack_adjustment = function
-+ | 0 -> ()
-+ | n when is_immediate n ->
-+ ` addi sp, sp, {emit_int n}\n`
-+ | n ->
-+ ` li {emit_reg reg_tmp1}, {emit_int n}\n`;
-+ ` add sp, sp, {emit_reg reg_tmp1}\n`
-+
-+let emit_store src ofs =
-+ if is_immediate ofs then
-+ ` {emit_string stg} {emit_reg src}, {emit_int ofs}(sp)\n`
-+ else begin
-+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
-+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
-+ ` {emit_string stg} {emit_reg src}, 0({emit_reg reg_tmp1})\n`
-+ end
-+
-+let emit_load dst ofs =
-+ if is_immediate ofs then
-+ ` {emit_string lg} {emit_reg dst}, {emit_int ofs}(sp)\n`
-+ else begin
-+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
-+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
-+ ` {emit_string lg} {emit_reg dst}, 0({emit_reg reg_tmp1})\n`
-+ end
-+
- (* Record live pointers at call points *)
-
- let record_frame_label ?label live raise_ dbg =
-@@ -218,6 +246,7 @@ let name_for_specific = function
-
- (* Name of current function *)
- let function_name = ref ""
-+
- (* Entry point for tail recursive calls *)
- let tailrec_entry_point = ref 0
-
-@@ -234,12 +263,14 @@ let emit_instr i =
- ` mv {emit_reg dst}, {emit_reg src}\n`
- | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
- ` fmv.d {emit_reg dst}, {emit_reg src}\n`
-- | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} ->
-- ` {emit_string stg} {emit_reg src}, {emit_stack dst}\n`
-+ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} ->
-+ let ofs = slot_offset s (register_class dst) in
-+ emit_store src ofs
- | {loc = Reg _; typ = Float}, {loc = Stack _} ->
- ` fsd {emit_reg src}, {emit_stack dst}\n`
-- | {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _ } ->
-- ` {emit_string lg} {emit_reg dst}, {emit_stack src}\n`
-+ | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
-+ let ofs = slot_offset s (register_class src) in
-+ emit_load dst ofs
- | {loc = Stack _; typ = Float}, {loc = Reg _} ->
- ` fld {emit_reg dst}, {emit_stack src}\n`
- | _ ->
-@@ -263,8 +294,7 @@ let emit_instr i =
- let n = frame_size() in
- if !contains_calls then
- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
-- if n > 0 then
-- ` addi sp, sp, {emit_int n}\n`;
-+ emit_stack_adjustment n;
- ` jr {emit_reg i.arg.(0)}\n`
- | Lop(Itailcall_imm {func; label_after = _}) ->
- if func = !function_name then begin
-@@ -273,8 +303,7 @@ let emit_instr i =
- let n = frame_size() in
- if !contains_calls then
- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
-- if n > 0 then
-- ` addi sp, sp, {emit_int n}\n`;
-+ emit_stack_adjustment n;
- ` tail {emit_symbol func}\n`
- end
- | Lop(Iextcall{func; alloc = true; label_after = label}) ->
-@@ -285,7 +314,7 @@ let emit_instr i =
- ` call {emit_symbol func}\n`
- | Lop(Istackoffset n) ->
- assert (n mod 16 = 0);
-- ` addi sp, sp, {emit_int (-n)}\n`;
-+ emit_stack_adjustment (-n);
- stack_offset := !stack_offset + n
- | Lop(Iload(Single, Iindexed ofs)) ->
- ` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
-@@ -398,8 +427,7 @@ let emit_instr i =
- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`
- | Lreturn ->
- let n = frame_size() in
-- if n > 0 then
-- ` addi sp, sp, {emit_int n}\n`;
-+ emit_stack_adjustment n;
- ` ret\n`
- | Llabel lbl ->
- `{emit_label lbl}:\n`
-@@ -513,8 +541,7 @@ let fundecl fundecl =
- ` .align 2\n`;
- `{emit_symbol fundecl.fun_name}:\n`;
- let n = frame_size() in
-- if n > 0 then
-- ` addi sp, sp, {emit_int(-n)}\n`;
-+ emit_stack_adjustment (-n);
- if !contains_calls then
- ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`;
- `{emit_label !tailrec_entry_point}:\n`;
-diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml
-index ad2b26e9b..283233679 100644
---- a/asmcomp/riscv/selection.ml
-+++ b/asmcomp/riscv/selection.ml
-@@ -22,7 +22,7 @@ class selector = object (self)
-
- inherit Selectgen.selector_generic as super
-
--method is_immediate n = (n <= 0x7FF) && (n >= -0x800)
-+method is_immediate n = is_immediate n
-
- method select_addressing _ = function
- | Cop(Cadda, [arg; Cconst_int n]) when self#is_immediate n ->
---
-2.13.1
-
diff --git a/0009-Another-immediate-range-fix.patch
b/0009-Another-immediate-range-fix.patch
deleted file mode 100644
index 5ad114e..0000000
--- a/0009-Another-immediate-range-fix.patch
+++ /dev/null
@@ -1,131 +0,0 @@
-From 664a26d436919be1fe3a33094aa44403b4bf710d Mon Sep 17 00:00:00 2001
-From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
-Date: Wed, 23 Nov 2016 12:38:28 +0100
-Subject: [PATCH 9/9] Another immediate range fix
-
----
- asmcomp/riscv/emit.mlp | 57 ++++++++++++++++++++++++++++++--------------------
- 1 file changed, 34 insertions(+), 23 deletions(-)
-
-diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
-index 97c49ce80..6cc190864 100644
---- a/asmcomp/riscv/emit.mlp
-+++ b/asmcomp/riscv/emit.mlp
-@@ -85,14 +85,6 @@ let emit_reg = function
- | {loc = Reg r} -> emit_string (register_name r)
- | _ -> fatal_error "Emit.emit_reg"
-
--(* Output a stack reference *)
--
--let emit_stack r =
-- match r.loc with
-- Stack s ->
-- let ofs = slot_offset s (register_class r) in `{emit_int ofs}(sp)`
-- | _ -> fatal_error "Emit.emit_stack"
--
- (* Adjust sp by the given byte amount *)
-
- let emit_stack_adjustment = function
-@@ -103,7 +95,27 @@ let emit_stack_adjustment = function
- ` li {emit_reg reg_tmp1}, {emit_int n}\n`;
- ` add sp, sp, {emit_reg reg_tmp1}\n`
-
--let emit_store src ofs =
-+let reload_ra n =
-+ let ofs = n - size_addr in
-+ if is_immediate ofs then
-+ ` {emit_string lg} ra, {emit_int ofs}(sp)\n`
-+ else begin
-+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
-+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
-+ ` {emit_string lg} ra, 0({emit_reg reg_tmp1})\n`
-+ end
-+
-+let store_ra n =
-+ let ofs = n - size_addr in
-+ if is_immediate ofs then
-+ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`
-+ else begin
-+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
-+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
-+ ` {emit_string stg} ra, 0({emit_reg reg_tmp1})\n`
-+ end
-+
-+let emit_store stg src ofs =
- if is_immediate ofs then
- ` {emit_string stg} {emit_reg src}, {emit_int ofs}(sp)\n`
- else begin
-@@ -112,7 +124,7 @@ let emit_store src ofs =
- ` {emit_string stg} {emit_reg src}, 0({emit_reg reg_tmp1})\n`
- end
-
--let emit_load dst ofs =
-+let emit_load lg dst ofs =
- if is_immediate ofs then
- ` {emit_string lg} {emit_reg dst}, {emit_int ofs}(sp)\n`
- else begin
-@@ -265,14 +277,16 @@ let emit_instr i =
- ` fmv.d {emit_reg dst}, {emit_reg src}\n`
- | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} ->
- let ofs = slot_offset s (register_class dst) in
-- emit_store src ofs
-- | {loc = Reg _; typ = Float}, {loc = Stack _} ->
-- ` fsd {emit_reg src}, {emit_stack dst}\n`
-+ emit_store stg src ofs
-+ | {loc = Reg _; typ = Float}, {loc = Stack s} ->
-+ let ofs = slot_offset s (register_class dst) in
-+ emit_store "fsd" src ofs
- | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
- let ofs = slot_offset s (register_class src) in
-- emit_load dst ofs
-- | {loc = Stack _; typ = Float}, {loc = Reg _} ->
-- ` fld {emit_reg dst}, {emit_stack src}\n`
-+ emit_load lg dst ofs
-+ | {loc = Stack s; typ = Float}, {loc = Reg _} ->
-+ let ofs = slot_offset s (register_class src) in
-+ emit_load "fld" dst ofs
- | _ ->
- fatal_error "Emit: Imove"
- end
-@@ -292,8 +306,7 @@ let emit_instr i =
- record_frame ~label i.live false i.dbg
- | Lop(Itailcall_ind {label_after = _}) ->
- let n = frame_size() in
-- if !contains_calls then
-- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
-+ if !contains_calls then reload_ra n;
- emit_stack_adjustment n;
- ` jr {emit_reg i.arg.(0)}\n`
- | Lop(Itailcall_imm {func; label_after = _}) ->
-@@ -301,8 +314,7 @@ let emit_instr i =
- ` j {emit_label !tailrec_entry_point}\n`
- end else begin
- let n = frame_size() in
-- if !contains_calls then
-- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
-+ if !contains_calls then reload_ra n;
- emit_stack_adjustment n;
- ` tail {emit_symbol func}\n`
- end
-@@ -424,7 +436,7 @@ let emit_instr i =
- ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}, {emit_reg i.arg.(2)}\n`
- | Lreloadretaddr ->
- let n = frame_size () in
-- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`
-+ reload_ra n
- | Lreturn ->
- let n = frame_size() in
- emit_stack_adjustment n;
-@@ -542,8 +554,7 @@ let fundecl fundecl =
- `{emit_symbol fundecl.fun_name}:\n`;
- let n = frame_size() in
- emit_stack_adjustment (-n);
-- if !contains_calls then
-- ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`;
-+ if !contains_calls then store_ra n;
- `{emit_label !tailrec_entry_point}:\n`;
- emit_all fundecl.fun_body;
- List.iter emit_call_gc !call_gc_sites;
---
-2.13.1
-
diff --git a/0009-Try-fix-for-andi-ori-xori-immediates-1.patch
b/0009-Try-fix-for-andi-ori-xori-immediates-1.patch
new file mode 100644
index 0000000..876200f
--- /dev/null
+++ b/0009-Try-fix-for-andi-ori-xori-immediates-1.patch
@@ -0,0 +1,43 @@
+From 84a4b62e1305795f6599c91a50b6e0d9e675cbd5 Mon Sep 17 00:00:00 2001
+From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
+Date: Thu, 10 Nov 2016 14:12:53 +0100
+Subject: [PATCH 09/12] Try fix for andi/ori/xori immediates (#1)
+
+---
+ asmcomp/riscv/selection.ml | 13 -------------
+ 1 file changed, 13 deletions(-)
+
+diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml
+index 60ec5cb4e..ad2b26e9b 100644
+--- a/asmcomp/riscv/selection.ml
++++ b/asmcomp/riscv/selection.ml
+@@ -36,11 +36,6 @@ method! select_operation op args =
+ match (op, args) with
+ (* RISC-V does not support immediate operands for multiply high *)
+ | (Cmulhi, _) -> (Iintop Imulh, args)
+- (* The and, or and xor instructions 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 (neg-)mult-add and (neg-)mult-sub instructions *)
+ | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3])
+ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) ->
+@@ -58,14 +53,6 @@ method! select_operation op args =
+ | _ ->
+ super#select_operation op args
+
+-method select_logical op = function
+- | [arg; Cconst_int n] when n >= 0 && n <= 0xFFF ->
+- (Iintop_imm(op, n), [arg])
+- | [Cconst_int n; arg] when n >= 0 && n <= 0xFFF ->
+- (Iintop_imm(op, n), [arg])
+- | args ->
+- (Iintop op, args)
+-
+ (* Instruction selection for conditionals *)
+
+ method! select_condition = function
+--
+2.13.1
+
diff --git a/0010-Fix-immediates-range-when-adjusting-indexing-sp.patch
b/0010-Fix-immediates-range-when-adjusting-indexing-sp.patch
new file mode 100644
index 0000000..94647d8
--- /dev/null
+++ b/0010-Fix-immediates-range-when-adjusting-indexing-sp.patch
@@ -0,0 +1,156 @@
+From bf083b3beeb9a622017137c246d2cfa863056cc0 Mon Sep 17 00:00:00 2001
+From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
+Date: Tue, 22 Nov 2016 22:30:35 +0100
+Subject: [PATCH 10/12] Fix immediates' range when adjusting/indexing sp
+
+---
+ asmcomp/riscv/arch.ml | 3 +++
+ asmcomp/riscv/emit.mlp | 53 ++++++++++++++++++++++++++++++++++------------
+ asmcomp/riscv/selection.ml | 2 +-
+ 3 files changed, 44 insertions(+), 14 deletions(-)
+
+diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml
+index 61a38b1dd..22c807c49 100644
+--- a/asmcomp/riscv/arch.ml
++++ b/asmcomp/riscv/arch.ml
+@@ -32,6 +32,9 @@ let spacetime_node_hole_pointer_is_live_before = function
+ type addressing_mode =
+ | Iindexed of int (* reg + displ *)
+
++let is_immediate n =
++ (n <= 2047) && (n >= -2048)
++
+ (* Sizes, endianness *)
+
+ let big_endian = false
+diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
+index 6d0e3aefd..97c49ce80 100644
+--- a/asmcomp/riscv/emit.mlp
++++ b/asmcomp/riscv/emit.mlp
+@@ -93,6 +93,34 @@ let emit_stack r =
+ let ofs = slot_offset s (register_class r) in `{emit_int ofs}(sp)`
+ | _ -> fatal_error "Emit.emit_stack"
+
++(* Adjust sp by the given byte amount *)
++
++let emit_stack_adjustment = function
++ | 0 -> ()
++ | n when is_immediate n ->
++ ` addi sp, sp, {emit_int n}\n`
++ | n ->
++ ` li {emit_reg reg_tmp1}, {emit_int n}\n`;
++ ` add sp, sp, {emit_reg reg_tmp1}\n`
++
++let emit_store src ofs =
++ if is_immediate ofs then
++ ` {emit_string stg} {emit_reg src}, {emit_int ofs}(sp)\n`
++ else begin
++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
++ ` {emit_string stg} {emit_reg src}, 0({emit_reg reg_tmp1})\n`
++ end
++
++let emit_load dst ofs =
++ if is_immediate ofs then
++ ` {emit_string lg} {emit_reg dst}, {emit_int ofs}(sp)\n`
++ else begin
++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
++ ` {emit_string lg} {emit_reg dst}, 0({emit_reg reg_tmp1})\n`
++ end
++
+ (* Record live pointers at call points *)
+
+ let record_frame_label ?label live raise_ dbg =
+@@ -218,6 +246,7 @@ let name_for_specific = function
+
+ (* Name of current function *)
+ let function_name = ref ""
++
+ (* Entry point for tail recursive calls *)
+ let tailrec_entry_point = ref 0
+
+@@ -234,12 +263,14 @@ let emit_instr i =
+ ` mv {emit_reg dst}, {emit_reg src}\n`
+ | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
+ ` fmv.d {emit_reg dst}, {emit_reg src}\n`
+- | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} ->
+- ` {emit_string stg} {emit_reg src}, {emit_stack dst}\n`
++ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} ->
++ let ofs = slot_offset s (register_class dst) in
++ emit_store src ofs
+ | {loc = Reg _; typ = Float}, {loc = Stack _} ->
+ ` fsd {emit_reg src}, {emit_stack dst}\n`
+- | {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _ } ->
+- ` {emit_string lg} {emit_reg dst}, {emit_stack src}\n`
++ | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
++ let ofs = slot_offset s (register_class src) in
++ emit_load dst ofs
+ | {loc = Stack _; typ = Float}, {loc = Reg _} ->
+ ` fld {emit_reg dst}, {emit_stack src}\n`
+ | _ ->
+@@ -263,8 +294,7 @@ let emit_instr i =
+ let n = frame_size() in
+ if !contains_calls then
+ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
+- if n > 0 then
+- ` addi sp, sp, {emit_int n}\n`;
++ emit_stack_adjustment n;
+ ` jr {emit_reg i.arg.(0)}\n`
+ | Lop(Itailcall_imm {func; label_after = _}) ->
+ if func = !function_name then begin
+@@ -273,8 +303,7 @@ let emit_instr i =
+ let n = frame_size() in
+ if !contains_calls then
+ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
+- if n > 0 then
+- ` addi sp, sp, {emit_int n}\n`;
++ emit_stack_adjustment n;
+ ` tail {emit_symbol func}\n`
+ end
+ | Lop(Iextcall{func; alloc = true; label_after = label}) ->
+@@ -285,7 +314,7 @@ let emit_instr i =
+ ` call {emit_symbol func}\n`
+ | Lop(Istackoffset n) ->
+ assert (n mod 16 = 0);
+- ` addi sp, sp, {emit_int (-n)}\n`;
++ emit_stack_adjustment (-n);
+ stack_offset := !stack_offset + n
+ | Lop(Iload(Single, Iindexed ofs)) ->
+ ` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
+@@ -398,8 +427,7 @@ let emit_instr i =
+ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`
+ | Lreturn ->
+ let n = frame_size() in
+- if n > 0 then
+- ` addi sp, sp, {emit_int n}\n`;
++ emit_stack_adjustment n;
+ ` ret\n`
+ | Llabel lbl ->
+ `{emit_label lbl}:\n`
+@@ -513,8 +541,7 @@ let fundecl fundecl =
+ ` .align 2\n`;
+ `{emit_symbol fundecl.fun_name}:\n`;
+ let n = frame_size() in
+- if n > 0 then
+- ` addi sp, sp, {emit_int(-n)}\n`;
++ emit_stack_adjustment (-n);
+ if !contains_calls then
+ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`;
+ `{emit_label !tailrec_entry_point}:\n`;
+diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml
+index ad2b26e9b..283233679 100644
+--- a/asmcomp/riscv/selection.ml
++++ b/asmcomp/riscv/selection.ml
+@@ -22,7 +22,7 @@ class selector = object (self)
+
+ inherit Selectgen.selector_generic as super
+
+-method is_immediate n = (n <= 0x7FF) && (n >= -0x800)
++method is_immediate n = is_immediate n
+
+ method select_addressing _ = function
+ | Cop(Cadda, [arg; Cconst_int n]) when self#is_immediate n ->
+--
+2.13.1
+
diff --git a/0011-Another-immediate-range-fix.patch
b/0011-Another-immediate-range-fix.patch
new file mode 100644
index 0000000..a5b502f
--- /dev/null
+++ b/0011-Another-immediate-range-fix.patch
@@ -0,0 +1,131 @@
+From 9e8d87c255713f7bf397083be9e6453d312c93a3 Mon Sep 17 00:00:00 2001
+From: Nicolas Ojeda Bar <n.oje.bar(a)gmail.com>
+Date: Wed, 23 Nov 2016 12:38:28 +0100
+Subject: [PATCH 11/12] Another immediate range fix
+
+---
+ asmcomp/riscv/emit.mlp | 57 ++++++++++++++++++++++++++++++--------------------
+ 1 file changed, 34 insertions(+), 23 deletions(-)
+
+diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
+index 97c49ce80..6cc190864 100644
+--- a/asmcomp/riscv/emit.mlp
++++ b/asmcomp/riscv/emit.mlp
+@@ -85,14 +85,6 @@ let emit_reg = function
+ | {loc = Reg r} -> emit_string (register_name r)
+ | _ -> fatal_error "Emit.emit_reg"
+
+-(* Output a stack reference *)
+-
+-let emit_stack r =
+- match r.loc with
+- Stack s ->
+- let ofs = slot_offset s (register_class r) in `{emit_int ofs}(sp)`
+- | _ -> fatal_error "Emit.emit_stack"
+-
+ (* Adjust sp by the given byte amount *)
+
+ let emit_stack_adjustment = function
+@@ -103,7 +95,27 @@ let emit_stack_adjustment = function
+ ` li {emit_reg reg_tmp1}, {emit_int n}\n`;
+ ` add sp, sp, {emit_reg reg_tmp1}\n`
+
+-let emit_store src ofs =
++let reload_ra n =
++ let ofs = n - size_addr in
++ if is_immediate ofs then
++ ` {emit_string lg} ra, {emit_int ofs}(sp)\n`
++ else begin
++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
++ ` {emit_string lg} ra, 0({emit_reg reg_tmp1})\n`
++ end
++
++let store_ra n =
++ let ofs = n - size_addr in
++ if is_immediate ofs then
++ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`
++ else begin
++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
++ ` {emit_string stg} ra, 0({emit_reg reg_tmp1})\n`
++ end
++
++let emit_store stg src ofs =
+ if is_immediate ofs then
+ ` {emit_string stg} {emit_reg src}, {emit_int ofs}(sp)\n`
+ else begin
+@@ -112,7 +124,7 @@ let emit_store src ofs =
+ ` {emit_string stg} {emit_reg src}, 0({emit_reg reg_tmp1})\n`
+ end
+
+-let emit_load dst ofs =
++let emit_load lg dst ofs =
+ if is_immediate ofs then
+ ` {emit_string lg} {emit_reg dst}, {emit_int ofs}(sp)\n`
+ else begin
+@@ -265,14 +277,16 @@ let emit_instr i =
+ ` fmv.d {emit_reg dst}, {emit_reg src}\n`
+ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} ->
+ let ofs = slot_offset s (register_class dst) in
+- emit_store src ofs
+- | {loc = Reg _; typ = Float}, {loc = Stack _} ->
+- ` fsd {emit_reg src}, {emit_stack dst}\n`
++ emit_store stg src ofs
++ | {loc = Reg _; typ = Float}, {loc = Stack s} ->
++ let ofs = slot_offset s (register_class dst) in
++ emit_store "fsd" src ofs
+ | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
+ let ofs = slot_offset s (register_class src) in
+- emit_load dst ofs
+- | {loc = Stack _; typ = Float}, {loc = Reg _} ->
+- ` fld {emit_reg dst}, {emit_stack src}\n`
++ emit_load lg dst ofs
++ | {loc = Stack s; typ = Float}, {loc = Reg _} ->
++ let ofs = slot_offset s (register_class src) in
++ emit_load "fld" dst ofs
+ | _ ->
+ fatal_error "Emit: Imove"
+ end
+@@ -292,8 +306,7 @@ let emit_instr i =
+ record_frame ~label i.live false i.dbg
+ | Lop(Itailcall_ind {label_after = _}) ->
+ let n = frame_size() in
+- if !contains_calls then
+- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
++ if !contains_calls then reload_ra n;
+ emit_stack_adjustment n;
+ ` jr {emit_reg i.arg.(0)}\n`
+ | Lop(Itailcall_imm {func; label_after = _}) ->
+@@ -301,8 +314,7 @@ let emit_instr i =
+ ` j {emit_label !tailrec_entry_point}\n`
+ end else begin
+ let n = frame_size() in
+- if !contains_calls then
+- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`;
++ if !contains_calls then reload_ra n;
+ emit_stack_adjustment n;
+ ` tail {emit_symbol func}\n`
+ end
+@@ -424,7 +436,7 @@ let emit_instr i =
+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg
i.arg.(1)}, {emit_reg i.arg.(2)}\n`
+ | Lreloadretaddr ->
+ let n = frame_size () in
+- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`
++ reload_ra n
+ | Lreturn ->
+ let n = frame_size() in
+ emit_stack_adjustment n;
+@@ -542,8 +554,7 @@ let fundecl fundecl =
+ `{emit_symbol fundecl.fun_name}:\n`;
+ let n = frame_size() in
+ emit_stack_adjustment (-n);
+- if !contains_calls then
+- ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`;
++ if !contains_calls then store_ra n;
+ `{emit_label !tailrec_entry_point}:\n`;
+ emit_all fundecl.fun_body;
+ List.iter emit_call_gc !call_gc_sites;
+--
+2.13.1
+
diff --git a/0012-Mark-certain-symbols-as-.hidden-in-arm64-codegen-pos.patch
b/0012-Mark-certain-symbols-as-.hidden-in-arm64-codegen-pos.patch
new file mode 100644
index 0000000..76d1b6d
--- /dev/null
+++ b/0012-Mark-certain-symbols-as-.hidden-in-arm64-codegen-pos.patch
@@ -0,0 +1,67 @@
+From 2cc11dbf4e046610e85e66139f0d1ffc9e1cff65 Mon Sep 17 00:00:00 2001
+From: Jiong Wang <jiong.wang(a)foss.arm.com>
+Date: Fri, 28 Jul 2017 19:00:00 +0200
+Subject: [PATCH 12/12] Mark certain symbols as .hidden in arm64 codegen,
+ possibly fixes MPR#7585
+
+binutils 2.29 arm64 linker is more strict about when to perform pc-relative
+relocations for global symbols. Specifically, they must be marked as .hidden.
+ocaml arm64 codegen does not do this, so tests/lib-dynlink-native/ fails as
+some symbols were not relocated. This patch fixes that by marking (hopefully)
+the appropriate symbols as .hidden.
+---
+ asmcomp/arm64/emit.mlp | 4 ++++
+ asmcomp/compilenv.ml | 1 -
+ 2 files changed, 4 insertions(+), 1 deletion(-)
+
+diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
+index f75646e12..ee72c114f 100644
+--- a/asmcomp/arm64/emit.mlp
++++ b/asmcomp/arm64/emit.mlp
+@@ -324,6 +324,7 @@ let emit_literals() =
+
+ let emit_load_symbol_addr dst s =
+ if (not !Clflags.dlcode) || Compilenv.symbol_in_current_unit s then begin
++ ` .hidden {emit_symbol s}\n`;
+ ` adrp {emit_reg dst}, {emit_symbol s}\n`;
+ ` add {emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n`
+ end else begin
+@@ -575,6 +576,7 @@ let emit_instr i =
+ ` fmov {emit_reg i.res.(0)}, #{emit_printf "0x%Lx" f}\n`
+ else begin
+ let lbl = float_literal f in
++ ` .hidden {emit_label lbl}\n`;
+ ` adrp {emit_reg reg_tmp1}, {emit_label lbl}\n`;
+ ` ldr {emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
+ end
+@@ -609,6 +611,7 @@ let emit_instr i =
+ match addr with
+ | Iindexed _ -> i.arg.(0)
+ | Ibased(s, ofs) ->
++ ` .hidden {emit_symbol s}\n`;
+ ` adrp {emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`;
+ reg_tmp1 in
+ begin match size with
+@@ -636,6 +639,7 @@ let emit_instr i =
+ match addr with
+ | Iindexed _ -> i.arg.(1)
+ | Ibased(s, ofs) ->
++ ` .hidden {emit_symbol s}\n`;
+ ` adrp {emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`;
+ reg_tmp1 in
+ begin match size with
+diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml
+index a50c57f45..32f8bf1da 100644
+--- a/asmcomp/compilenv.ml
++++ b/asmcomp/compilenv.ml
+@@ -161,7 +161,6 @@ let make_symbol ?(unitname = current_unit.ui_symbol) idopt =
+
+ 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
+--
+2.13.1
+
diff --git a/ocaml.spec b/ocaml.spec
index 345aff6..50c030b 100644
--- a/ocaml.spec
+++ b/ocaml.spec
@@ -23,11 +23,11 @@
%global test_arches_required aarch64 %{power64} x86_64
# Architectures where parallel builds fail.
-%global no_parallel_build_arches aarch64
+#%global no_parallel_build_arches aarch64
Name: ocaml
-Version: 4.04.2
-Release: 5%{?dist}
+Version: 4.05.0
+Release: 1%{?dist}
Summary: OCaml compiler and programming environment
@@ -35,11 +35,11 @@ License: QPL and (LGPLv2+ with exceptions)
URL:
http://www.ocaml.org
-Source0:
http://caml.inria.fr/pub/distrib/ocaml-4.04/ocaml-%{version}.tar.xz
+Source0:
http://caml.inria.fr/pub/distrib/ocaml-4.05/ocaml-%{version}.tar.xz
-Source1:
http://caml.inria.fr/pub/distrib/ocaml-4.04/ocaml-4.04-refman-html.tar.gz
-Source2:
http://caml.inria.fr/pub/distrib/ocaml-4.04/ocaml-4.04-refman.pdf
-Source3:
http://caml.inria.fr/pub/distrib/ocaml-4.04/ocaml-4.04-refman.info.tar.gz
+Source1:
http://caml.inria.fr/pub/distrib/ocaml-4.05/ocaml-4.05-refman-html.tar.gz
+Source2:
http://caml.inria.fr/pub/distrib/ocaml-4.05/ocaml-4.05-refman.pdf
+Source3:
http://caml.inria.fr/pub/distrib/ocaml-4.05/ocaml-4.05-refman.info.tar.gz
# IMPORTANT NOTE:
#
@@ -50,23 +50,36 @@ Source3:
http://caml.inria.fr/pub/distrib/ocaml-4.04/ocaml-4.04-refman.in
#
#
https://pagure.io/fedora-ocaml
#
-# Current branch: fedora-27-4.04.1
+# Current branch: fedora-27-4.05.0
#
# ALTERNATIVELY add a patch to the end of the list (leaving the
# existing patches unchanged) adding a comment to note that it should
# be incorporated into the git repo at a later time.
#
-Patch0001: 0001-Don-t-add-rpaths-to-libraries.patch
-Patch0002: 0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
-Patch0003: 0003-configure-Allow-user-defined-C-compiler-flags.patch
-Patch0004: 0004-Don-t-rewrite-Werror.patch
-# Out of tree patches from
+
+# Upstream patches after 4.05.
+Patch0001: 0001-Changes-clarify-compatibility-breaking-change-items.patch
+Patch0002: 0002-MPR-7591-frametable-not-8-aligned-on-x86-64-port.patch
+Patch0003: 0003-Fixes-for-out-of-range-Ialloc.patch
+
+# Fedora-specific downstream patches.
+Patch0004: 0004-Don-t-add-rpaths-to-libraries.patch
+Patch0005: 0005-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
+Patch0006: 0006-configure-Allow-user-defined-C-compiler-flags.patch
+
+# Out of tree patches for RISC-V support.
#
https://github.com/nojb/riscv-ocaml
-Patch0005: 0005-Adapt-config.guess-for-RISC-V.patch
-Patch0006: 0006-Add-RISC-V-backend-runtime.patch
-Patch0007: 0007-Try-fix-for-andi-ori-xori-immediates-1.patch
-Patch0008: 0008-Fix-immediates-range-when-adjusting-indexing-sp.patch
-Patch0009: 0009-Another-immediate-range-fix.patch
+Patch0007: 0007-Adapt-config.guess-for-RISC-V.patch
+Patch0008: 0008-Add-RISC-V-backend-runtime.patch
+Patch0009: 0009-Try-fix-for-andi-ori-xori-immediates-1.patch
+Patch0010: 0010-Fix-immediates-range-when-adjusting-indexing-sp.patch
+Patch0011: 0011-Another-immediate-range-fix.patch
+
+# Fix for some aarch64 linker problems.
+#
https://caml.inria.fr/mantis/view.php?id=7585
+# This patch is from
https://github.com/ocaml/ocaml/pull/1268
+# where at time of writing it is not upstream.
+Patch0012: 0012-Mark-certain-symbols-as-.hidden-in-arm64-codegen-pos.patch
BuildRequires: binutils-devel
BuildRequires: ncurses-devel
@@ -205,12 +218,14 @@ cp %{SOURCE2} refman.pdf
%build
-%ifnarch %{no_parallel_build_arches}
-make="make %{?_smp_mflags}"
-%else
+# Parallel builds are broken in 4.05.0, see
+#
https://caml.inria.fr/mantis/view.php?id=7587
+#%ifnarch %{no_parallel_build_arches}
+#make="make %{?_smp_mflags}"
+#%else
unset MAKEFLAGS
make=make
-%endif
+#%endif
CFLAGS="$RPM_OPT_FLAGS -fno-strict-aliasing" \
./configure \
@@ -441,6 +456,7 @@ fi
%files compiler-libs
%doc LICENSE
%dir %{_libdir}/ocaml/compiler-libs
+%{_libdir}/ocaml/compiler-libs/*.mli
%{_libdir}/ocaml/compiler-libs/*.cmi
%{_libdir}/ocaml/compiler-libs/*.cmo
%{_libdir}/ocaml/compiler-libs/*.cma
@@ -453,6 +469,12 @@ fi
%changelog
+* Sat Aug 05 2017 Richard W.M. Jones <rjones(a)redhat.com> - 4.05.0-1
+- New upstream version 4.05.0.
+- Disable parallel builds for now.
+- *.mli files are now included in ocaml-compiler-libs.
+- Add possible fix for aarch64 with new binutils.
+
* Sat Aug 05 2017 Richard W.M. Jones <rjones(a)redhat.com> - 4.04.2-4
- Disable tests on aarch64 (
https://caml.inria.fr/mantis/view.php?id=7602)
diff --git a/sources b/sources
index 34ba1de..f70e4d9 100644
--- a/sources
+++ b/sources
@@ -1,4 +1,4 @@
-SHA512 (ocaml-4.04-refman-html.tar.gz) =
027ad5ea08488beb5ce65ec97a8aaf04197317d7d3194de771a4170dea9f8b90fc4309fd917b4176cd930dd0835c84448771b84fa92a735cfc60668ef0a6a413
-SHA512 (ocaml-4.04-refman.info.tar.gz) =
e83a28e8fb6af198471d26e790ce64ae11d6a2262110ecd5a7b150f9248c221847b1bde3e076b38a7e412ea1d709e0c1bfbf890ccbd5721869ea98d6d9dcc052
-SHA512 (ocaml-4.04-refman.pdf) =
9194d0a9cddb1cde3f86f90fbe6e23740ef0e4e49515f40708fe5a2acc3318f6c3839377f93163e2520770357ad0ce7145c5cfb1424503e8873106b17338e4b6
-SHA512 (ocaml-4.04.2.tar.xz) =
0449f650388fe63e1f96c6f63d994855cf76bac5b52d3f76e781c8d9f5fddb657a24a88063c1280d45ccc741c372085bad46cdb3dbc186e1861627d500290629
+SHA512 (ocaml-4.05.0.tar.xz) =
e87bb25d8a580f608ea3c8308129c4e4f4513e9bb3d218a5038a67b3f39b06656ff6ebe08a4b6f36960fb603be62e6bef2694fc3cf1b0fa0df3a1ca177d4e004
+SHA512 (ocaml-4.05-refman-html.tar.gz) =
a01aef22015cfcb1d230e63f24f2deeba6a8bc1a1225152e346a15e3a52be261d7f22430e561c7cbf64fbc53d3fa13606b87823efb56d139cf5e988c9a326af8
+SHA512 (ocaml-4.05-refman.info.tar.gz) =
49cd780445576061e89cf46690a5f7297d5b2c92446e6fc0e2d8878089e6b18e235785d5eb658e508a15c2bfbdd4a1c990b6eca7dadb4b4a7f313e1a8f3d0642
+SHA512 (ocaml-4.05-refman.pdf) =
2190deef5f89064774236790a130c036fe7d615177ce7e17c17a60b4d8500f78a75e15157fe13cf47125219ad731d04fb1339692047aced1ee9d768aae2a8038
commit 42b3c165c6a286712434d693cbe7ef3a01674b46
Author: Richard W.M. Jones <rjones(a)redhat.com>
Date: Sat Aug 5 16:15:05 2017 +0100
Revert "Disable tests on aarch64
(
https://caml.inria.fr/mantis/view.php?id=7602)"
Reenable these tests. There is a patch which fixes the problem
instead.
This reverts commit dd7a7dca92e3e4e05804c643e56f311f3f3d7481.
diff --git a/ocaml.spec b/ocaml.spec
index a495201..345aff6 100644
--- a/ocaml.spec
+++ b/ocaml.spec
@@ -20,15 +20,14 @@
%global test_arches aarch64 %{power64} x86_64
# These are the architectures for which the tests must pass otherwise
# the build will fail.
-# Fails on aarch64:
https://caml.inria.fr/mantis/view.php?id=7602
-%global test_arches_required %{power64} x86_64
+%global test_arches_required aarch64 %{power64} x86_64
# Architectures where parallel builds fail.
%global no_parallel_build_arches aarch64
Name: ocaml
Version: 4.04.2
-Release: 4%{?dist}
+Release: 5%{?dist}
Summary: OCaml compiler and programming environment