diff --git a/programming/language/ocaml/ocaml/files/fedora/0001-Don-t-add-rpaths-to-libraries.patch b/programming/language/ocaml/ocaml/files/fedora/0001-Don-t-add-rpaths-to-libraries.patch deleted file mode 100644 index 02d4e85c6c..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0001-Don-t-add-rpaths-to-libraries.patch +++ /dev/null @@ -1,28 +0,0 @@ -From fc5ac0d955afce294fe58a20cab8e9dda572de78 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 24 Jun 2014 10:00:15 +0100 -Subject: [PATCH 01/10] 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 2803d78..d6c42bb 100644 ---- a/tools/Makefile.shared -+++ b/tools/Makefile.shared -@@ -154,9 +154,9 @@ $(call byte_and_opt,ocamlmklib,ocamlmklibconfig.cmo config.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.9.3 \ No newline at end of file diff --git a/programming/language/ocaml/ocaml/files/fedora/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch b/programming/language/ocaml/ocaml/files/fedora/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch deleted file mode 100644 index 023085ebca..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch +++ /dev/null @@ -1,239 +0,0 @@ -From 61bdb02cedd1be6ecdc37bc4a80ffe3f19aa5521 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 29 May 2012 20:40:36 +0100 -Subject: [PATCH 02/10] 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 0000000..eb9a293 ---- /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 0000000..e28800f ---- /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 "@[Globals defined:"; -+ List.iter (fun s -> printf "@ %s" s) defines; -+ printf "@]@."; -+ printf "@[Interfaces imported:%a@]@." pr_imports cmi; -+ printf "@[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.9.3 diff --git a/programming/language/ocaml/ocaml/files/fedora/0003-configure-Allow-user-defined-C-compiler-flags.patch b/programming/language/ocaml/ocaml/files/fedora/0003-configure-Allow-user-defined-C-compiler-flags.patch deleted file mode 100644 index 58205019a3..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0003-configure-Allow-user-defined-C-compiler-flags.patch +++ /dev/null @@ -1,26 +0,0 @@ -From 2f93494aea56c9216bb561800a6861b653f409ce Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 29 May 2012 20:44:18 +0100 -Subject: [PATCH 03/10] configure: Allow user defined C compiler flags. - ---- - configure | 4 ++++ - 1 file changed, 4 insertions(+) - -diff --git a/configure b/configure -index f43893a..41c9315 100755 ---- a/configure -+++ b/configure -@@ -1901,6 +1901,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.9.3 \ No newline at end of file diff --git a/programming/language/ocaml/ocaml/files/fedora/0004-Don-t-rewrite-Werror.patch b/programming/language/ocaml/ocaml/files/fedora/0004-Don-t-rewrite-Werror.patch deleted file mode 100644 index 429b040f9d..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0004-Don-t-rewrite-Werror.patch +++ /dev/null @@ -1,27 +0,0 @@ -From cdd42ba82210bfaa97cfa010eaac3d805b80cb49 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Thu, 3 Nov 2016 19:50:20 +0000 -Subject: [PATCH 04/10] 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 85be2db..1764d0e 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.9.3 \ No newline at end of file diff --git a/programming/language/ocaml/ocaml/files/fedora/0005-PR-7405-s390x-Fix-address-of-caml_raise_exn-in-nativ.patch b/programming/language/ocaml/ocaml/files/fedora/0005-PR-7405-s390x-Fix-address-of-caml_raise_exn-in-nativ.patch deleted file mode 100644 index 4b0ebe5b82..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0005-PR-7405-s390x-Fix-address-of-caml_raise_exn-in-nativ.patch +++ /dev/null @@ -1,28 +0,0 @@ -From d4a20446fc8d00223b0c23726618407e451472e8 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Wed, 9 Nov 2016 11:01:15 -0500 -Subject: [PATCH 05/10] PR#7405: s390x: Fix address of caml_raise_exn in native - dynlink modules. - -This commit started as Fedora patch e732c39340e86939530a087744caa8d8f1247878. - -(cherry picked from commit d6f24c5f4ee9408ac9a00e3de84f417450b41215) ---- - asmcomp/s390x/emit.mlp | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp -index 5d233a3..f99380a 100644 ---- a/asmcomp/s390x/emit.mlp -+++ b/asmcomp/s390x/emit.mlp -@@ -611,7 +611,7 @@ let emit_instr i = - | Lraise k -> - begin match k with - | Cmm.Raise_withtrace -> -- ` brasl %r14, {emit_symbol "caml_raise_exn"}\n`; -+ ` {emit_call "caml_raise_exn"}\n`; - let lbl = record_frame Reg.Set.empty true i.dbg in - `{emit_label lbl}:\n` - | Cmm.Raise_notrace -> --- -2.9.3 \ No newline at end of file diff --git a/programming/language/ocaml/ocaml/files/fedora/0006-Adapt-config.guess-for-RISC-V.patch b/programming/language/ocaml/ocaml/files/fedora/0006-Adapt-config.guess-for-RISC-V.patch deleted file mode 100644 index a5f44b2950..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0006-Adapt-config.guess-for-RISC-V.patch +++ /dev/null @@ -1,34 +0,0 @@ -From 427232f0f36bfcaafcb1ec2f8da3d1daad0b1121 Mon Sep 17 00:00:00 2001 -From: Nicolas Ojeda Bar -Date: Tue, 8 Nov 2016 23:56:50 +0100 -Subject: [PATCH 06/10] 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 b79252d..8335398 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.9.3 \ No newline at end of file diff --git a/programming/language/ocaml/ocaml/files/fedora/0007-Add-RISC-V-backend-runtime.patch b/programming/language/ocaml/ocaml/files/fedora/0007-Add-RISC-V-backend-runtime.patch deleted file mode 100644 index d456ea1258..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0007-Add-RISC-V-backend-runtime.patch +++ /dev/null @@ -1,1716 +0,0 @@ -From cc3aa63c6892479851786af89b956004491dc84c Mon Sep 17 00:00:00 2001 -From: Nicolas Ojeda Bar -Date: Fri, 4 Nov 2016 20:39:09 +0100 -Subject: [PATCH 07/10] 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 480b025..cb6eebf 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 0000000..302811a ---- /dev/null -+++ b/asmcomp/riscv/CSE.ml -@@ -0,0 +1,36 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* 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 0000000..61a38b1 ---- /dev/null -+++ b/asmcomp/riscv/arch.ml -@@ -0,0 +1,84 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* 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 0000000..6d0e3ae ---- /dev/null -+++ b/asmcomp/riscv/emit.mlp -@@ -0,0 +1,616 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* 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 0000000..c0b0dcd ---- /dev/null -+++ b/asmcomp/riscv/proc.ml -@@ -0,0 +1,301 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* 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 0000000..85b9703 ---- /dev/null -+++ b/asmcomp/riscv/reload.ml -@@ -0,0 +1,16 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* 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 0000000..e436be1 ---- /dev/null -+++ b/asmcomp/riscv/scheduling.ml -@@ -0,0 +1,19 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* 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 0000000..60ec5cb ---- /dev/null -+++ b/asmcomp/riscv/selection.ml -@@ -0,0 +1,85 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* 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 0000000..a82048e ---- /dev/null -+++ b/asmrun/riscv.S -@@ -0,0 +1,424 @@ -+/***********************************************************************/ -+/* */ -+/* OCaml */ -+/* */ -+/* Nicolas Ojeda Bar */ -+/* */ -+/* 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 fd9d528..781c251 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 41c9315..eb3e1f3 100755 ---- a/configure -+++ b/configure -@@ -819,6 +819,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 - -@@ -888,6 +889,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 -@@ -963,7 +966,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.9.3 diff --git a/programming/language/ocaml/ocaml/files/fedora/0008-Try-fix-for-andi-ori-xori-immediates-1.patch b/programming/language/ocaml/ocaml/files/fedora/0008-Try-fix-for-andi-ori-xori-immediates-1.patch deleted file mode 100644 index 459c8efa96..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0008-Try-fix-for-andi-ori-xori-immediates-1.patch +++ /dev/null @@ -1,42 +0,0 @@ -From f1be77d69e28ad3bd128c6c757d966e90bbf73d3 Mon Sep 17 00:00:00 2001 -From: Nicolas Ojeda Bar -Date: Thu, 10 Nov 2016 14:12:53 +0100 -Subject: [PATCH 08/10] 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 60ec5cb..ad2b26e 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.9.3 \ No newline at end of file diff --git a/programming/language/ocaml/ocaml/files/fedora/0009-Fix-immediates-range-when-adjusting-indexing-sp.patch b/programming/language/ocaml/ocaml/files/fedora/0009-Fix-immediates-range-when-adjusting-indexing-sp.patch deleted file mode 100644 index c328abf09d..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0009-Fix-immediates-range-when-adjusting-indexing-sp.patch +++ /dev/null @@ -1,155 +0,0 @@ -From b81417ea168c3cf9454eeb41f1f723b66b3210aa Mon Sep 17 00:00:00 2001 -From: Nicolas Ojeda Bar -Date: Tue, 22 Nov 2016 22:30:35 +0100 -Subject: [PATCH 09/10] 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 61a38b1..22c807c 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 6d0e3ae..97c49ce 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 ad2b26e..2832336 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.9.3 \ No newline at end of file diff --git a/programming/language/ocaml/ocaml/files/fedora/0010-Another-immediate-range-fix.patch b/programming/language/ocaml/ocaml/files/fedora/0010-Another-immediate-range-fix.patch deleted file mode 100644 index 4930a5ab66..0000000000 --- a/programming/language/ocaml/ocaml/files/fedora/0010-Another-immediate-range-fix.patch +++ /dev/null @@ -1,130 +0,0 @@ -From ab30529b723d451fd0ea8ac64d24fc417af55541 Mon Sep 17 00:00:00 2001 -From: Nicolas Ojeda Bar -Date: Wed, 23 Nov 2016 12:38:28 +0100 -Subject: [PATCH 10/10] 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 97c49ce..6cc1908 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.9.3 \ No newline at end of file diff --git a/programming/language/ocaml/ocaml/pspec.xml b/programming/language/ocaml/ocaml/pspec.xml index 77ac321be5..823d32e34b 100644 --- a/programming/language/ocaml/ocaml/pspec.xml +++ b/programming/language/ocaml/ocaml/pspec.xml @@ -25,18 +25,6 @@ libX11-devel chrpath - - fedora/0001-Don-t-add-rpaths-to-libraries.patch - fedora/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch - fedora/0003-configure-Allow-user-defined-C-compiler-flags.patch - fedora/0004-Don-t-rewrite-Werror.patch - fedora/0005-PR-7405-s390x-Fix-address-of-caml_raise_exn-in-nativ.patch - fedora/0006-Adapt-config.guess-for-RISC-V.patch - fedora/0007-Add-RISC-V-backend-runtime.patch - fedora/0008-Try-fix-for-andi-ori-xori-immediates-1.patch - fedora/0009-Fix-immediates-range-when-adjusting-indexing-sp.patch - fedora/0010-Another-immediate-range-fix.patch - @@ -56,7 +44,7 @@ - 2017-02-02 + 2017-03-08 4.04.0 Version Bump Pisi Linux Community