ocaml:removed unneed patches

This commit is contained in:
2017-03-08 20:32:45 +03:00
parent eed883557f
commit 585538522d
11 changed files with 1 additions and 2438 deletions
@@ -1,28 +0,0 @@
From fc5ac0d955afce294fe58a20cab8e9dda572de78 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
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
@@ -1,239 +0,0 @@
From 61bdb02cedd1be6ecdc37bc4a80ffe3f19aa5521 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
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 "@[<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.9.3
@@ -1,26 +0,0 @@
From 2f93494aea56c9216bb561800a6861b653f409ce Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
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
@@ -1,27 +0,0 @@
From cdd42ba82210bfaa97cfa010eaac3d805b80cb49 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
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
@@ -1,28 +0,0 @@
From d4a20446fc8d00223b0c23726618407e451472e8 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
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
@@ -1,34 +0,0 @@
From 427232f0f36bfcaafcb1ec2f8da3d1daad0b1121 Mon Sep 17 00:00:00 2001
From: Nicolas Ojeda Bar <n.oje.bar@gmail.com>
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
@@ -1,42 +0,0 @@
From f1be77d69e28ad3bd128c6c757d966e90bbf73d3 Mon Sep 17 00:00:00 2001
From: Nicolas Ojeda Bar <n.oje.bar@gmail.com>
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
@@ -1,155 +0,0 @@
From b81417ea168c3cf9454eeb41f1f723b66b3210aa Mon Sep 17 00:00:00 2001
From: Nicolas Ojeda Bar <n.oje.bar@gmail.com>
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
@@ -1,130 +0,0 @@
From ab30529b723d451fd0ea8ac64d24fc417af55541 Mon Sep 17 00:00:00 2001
From: Nicolas Ojeda Bar <n.oje.bar@gmail.com>
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
+1 -13
View File
@@ -25,18 +25,6 @@
<Dependency>libX11-devel</Dependency>
<Dependency>chrpath</Dependency>
</BuildDependencies>
<Patches>
<Patch>fedora/0001-Don-t-add-rpaths-to-libraries.patch</Patch>
<Patch>fedora/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch</Patch>
<Patch>fedora/0003-configure-Allow-user-defined-C-compiler-flags.patch</Patch>
<Patch>fedora/0004-Don-t-rewrite-Werror.patch</Patch>
<Patch>fedora/0005-PR-7405-s390x-Fix-address-of-caml_raise_exn-in-nativ.patch</Patch>
<Patch>fedora/0006-Adapt-config.guess-for-RISC-V.patch</Patch>
<Patch>fedora/0007-Add-RISC-V-backend-runtime.patch</Patch>
<Patch>fedora/0008-Try-fix-for-andi-ori-xori-immediates-1.patch</Patch>
<Patch>fedora/0009-Fix-immediates-range-when-adjusting-indexing-sp.patch</Patch>
<Patch>fedora/0010-Another-immediate-range-fix.patch</Patch>
</Patches>
</Source>
<Package>
@@ -56,7 +44,7 @@
<History>
<Update release="3">
<Date>2017-02-02</Date>
<Date>2017-03-08</Date>
<Version>4.04.0</Version>
<Comment>Version Bump</Comment>
<Name>Pisi Linux Community</Name>