Merge pull request #2707 from alihanozturk/master

ocaml:fix
This commit is contained in:
Alihan Öztürk
2017-02-02 16:06:15 +02:00
committed by GitHub
16 changed files with 2159 additions and 2235 deletions
@@ -1,20 +1,20 @@
From 79f0f91e3e4abbfbd3564c11ea72e53310236afc Mon Sep 17 00:00:00 2001
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 03/12] Don't add rpaths to libraries.
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 2517434..75a75b4 100644
index 2803d78..d6c42bb 100644
--- a/tools/Makefile.shared
+++ b/tools/Makefile.shared
@@ -112,9 +112,9 @@ ocamlmklibconfig.ml: ../config/Makefile
echo 'let ext_dll = "$(EXT_DLL)"'; \
@@ -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 mkdll = "$(MKDLL)"'; \
- echo 'let byteccrpath = "$(BYTECCRPATH)"'; \
- echo 'let nativeccrpath = "$(NATIVECCRPATH)"'; \
- echo 'let mksharedlibrpath = "$(MKSHAREDLIBRPATH)"'; \
@@ -25,5 +25,4 @@ index 2517434..75a75b4 100644
sed -n -e 's/^#ml //p' ../config/Makefile) \
> ocamlmklibconfig.ml
--
2.0.4
2.9.3
@@ -1,24 +0,0 @@
From ccc1bf226619608230dc94b26377756719cf7b20 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 24 Jun 2014 22:29:38 +0100
Subject: [PATCH 01/12] Don't ignore ./configure, it's a real git file.
---
.gitignore | 1 -
1 file changed, 1 deletion(-)
diff --git a/.gitignore b/.gitignore
index d36195a..dbb0e3e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -19,7 +19,6 @@
/.depend
/.depend.nt
/.DS_Store
-/configure
/ocamlc
/ocamlc.opt
/expunge
--
2.0.4
@@ -1,18 +0,0 @@
From 0e3b6450f6ab803442a809b6da41d5d5c5da650f Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Thu, 7 Jun 2012 15:36:16 +0100
Subject: [PATCH 02/12] Ensure empty compilerlibs/ directory is created by git.
This directory exists in the OCaml tarball, but is empty. As a
result, git ignores it unless we put a dummy file in it.
---
compilerlibs/.exists | 0
1 file changed, 0 insertions(+), 0 deletions(-)
create mode 100644 compilerlibs/.exists
diff --git a/compilerlibs/.exists b/compilerlibs/.exists
new file mode 100644
index 0000000..e69de29
--
2.0.4
@@ -1,7 +1,7 @@
From 11b377aee2811891635982a5590fef62f12645b6 Mon Sep 17 00:00:00 2001
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 04/12] ocamlbyteinfo, ocamlplugininfo: Useful utilities from
Subject: [PATCH 02/10] ocamlbyteinfo, ocamlplugininfo: Useful utilities from
Debian, sent upstream.
See:
@@ -236,5 +236,4 @@ index 0000000..e28800f
+ header.units
+ end
--
2.0.4
2.9.3
@@ -1,19 +1,19 @@
From 5308c47681201ef3beef3e543ab877f81aa08784 Mon Sep 17 00:00:00 2001
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 05/12] configure: Allow user defined C compiler flags.
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 dbc6178..c1133ee 100755
index f43893a..41c9315 100755
--- a/configure
+++ b/configure
@@ -1633,6 +1633,10 @@ case "$buggycc" in
nativecccompopts="$nativecccompopts -fomit-frame-pointer";;
esac
@@ -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"
@@ -23,5 +23,4 @@ index dbc6178..c1133ee 100755
cclibs="$cclibs $mathlib"
--
2.0.4
2.9.3
@@ -0,0 +1,27 @@
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
@@ -0,0 +1,28 @@
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
@@ -0,0 +1,34 @@
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
@@ -0,0 +1,42 @@
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
@@ -0,0 +1,155 @@
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,118 +0,0 @@
From 0641f11626be99c8bde349520ac28a8d93106856 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 1 Apr 2014 11:17:07 +0100
Subject: [PATCH 09/12] arg: Add no_arg and get_arg helper functions.
The no_arg function in this patch is a no-op. It will do something
useful in the followups.
The get_arg function simply checks the next position on the command
line exists and returns that argument or raises a Arg.Missing.
This patch should introduce no functional change, it is simply code
refactoring.
In particular, this should not change the treatment of Arg.current
(see: http://caml.inria.fr/mantis/view.php?id=5197#c11147)
---
stdlib/arg.ml | 47 ++++++++++++++++++++++++++---------------------
1 file changed, 26 insertions(+), 21 deletions(-)
diff --git a/stdlib/arg.ml b/stdlib/arg.ml
index 0f6480b..a41e0a2 100644
--- a/stdlib/arg.ml
+++ b/stdlib/arg.ml
@@ -134,56 +134,62 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg =
try assoc3 s !speclist
with Not_found -> stop (Unknown s)
in
+ let no_arg () = () in
+ let get_arg () =
+ if !current + 1 < l then argv.(!current + 1)
+ else stop (Missing s)
+ in
begin try
let rec treat_action = function
- | Unit f -> f ();
- | Bool f when !current + 1 < l ->
- let arg = argv.(!current + 1) in
+ | Unit f -> no_arg (); f ();
+ | Bool f ->
+ let arg = get_arg () in
begin try f (bool_of_string arg)
with Invalid_argument "bool_of_string" ->
raise (Stop (Wrong (s, arg, "a boolean")))
end;
incr current;
- | Set r -> r := true;
- | Clear r -> r := false;
- | String f when !current + 1 < l ->
- f argv.(!current + 1);
+ | Set r -> no_arg (); r := true;
+ | Clear r -> no_arg (); r := false;
+ | String f ->
+ let arg = get_arg () in
+ f arg;
incr current;
- | Symbol (symb, f) when !current + 1 < l ->
- let arg = argv.(!current + 1) in
+ | Symbol (symb, f) ->
+ let arg = get_arg () in
if List.mem arg symb then begin
- f argv.(!current + 1);
+ f arg;
incr current;
end else begin
raise (Stop (Wrong (s, arg, "one of: "
^ (make_symlist "" " " "" symb))))
end
- | Set_string r when !current + 1 < l ->
- r := argv.(!current + 1);
+ | Set_string r ->
+ r := get_arg ();
incr current;
- | Int f when !current + 1 < l ->
- let arg = argv.(!current + 1) in
+ | Int f ->
+ let arg = get_arg () in
begin try f (int_of_string arg)
with Failure "int_of_string" ->
raise (Stop (Wrong (s, arg, "an integer")))
end;
incr current;
- | Set_int r when !current + 1 < l ->
- let arg = argv.(!current + 1) in
+ | Set_int r ->
+ let arg = get_arg () in
begin try r := (int_of_string arg)
with Failure "int_of_string" ->
raise (Stop (Wrong (s, arg, "an integer")))
end;
incr current;
- | Float f when !current + 1 < l ->
- let arg = argv.(!current + 1) in
+ | Float f ->
+ let arg = get_arg () in
begin try f (float_of_string arg);
with Failure "float_of_string" ->
raise (Stop (Wrong (s, arg, "a float")))
end;
incr current;
- | Set_float r when !current + 1 < l ->
- let arg = argv.(!current + 1) in
+ | Set_float r ->
+ let arg = get_arg () in
begin try r := (float_of_string arg);
with Failure "float_of_string" ->
raise (Stop (Wrong (s, arg, "a float")))
@@ -196,7 +202,6 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg =
f argv.(!current + 1);
incr current;
done;
- | _ -> raise (Stop (Missing s))
in
treat_action action
with Bad m -> stop (Message m);
--
2.0.4
@@ -0,0 +1,130 @@
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,84 +0,0 @@
From 4d1defe6f017b86b0766fd02005a468bedd9aa88 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 1 Apr 2014 11:21:40 +0100
Subject: [PATCH 10/12] arg: Allow flags such as --flag=arg as well as --flag
arg.
Allow flags to be followed directly by their argument, separated by an '='
sign. This is consistent with what GNU getopt_long and many other
command line parsing libraries allow.
Fix for the following issue:
http://caml.inria.fr/mantis/view.php?id=5197
---
stdlib/arg.ml | 30 ++++++++++++++++++++++++------
stdlib/arg.mli | 3 ++-
2 files changed, 26 insertions(+), 7 deletions(-)
diff --git a/stdlib/arg.ml b/stdlib/arg.ml
index a41e0a2..5ffdabc 100644
--- a/stdlib/arg.ml
+++ b/stdlib/arg.ml
@@ -55,6 +55,12 @@ let rec assoc3 x l =
| _ :: t -> assoc3 x t
;;
+let split s =
+ let i = String.index s '=' in
+ let len = String.length s in
+ String.sub s 0 i, String.sub s (i+1) (len-(i+1))
+;;
+
let make_symlist prefix sep suffix l =
match l with
| [] -> "<none>"
@@ -130,14 +136,26 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg =
while !current < l do
let s = argv.(!current) in
if String.length s >= 1 && s.[0] = '-' then begin
- let action =
- try assoc3 s !speclist
- with Not_found -> stop (Unknown s)
+ let action, follow =
+ try assoc3 s !speclist, None
+ with Not_found ->
+ try
+ let keyword, arg = split s in
+ assoc3 keyword !speclist, Some arg
+ with Not_found -> stop (Unknown s)
in
- let no_arg () = () in
+ let no_arg () =
+ match follow with
+ | None -> ()
+ | Some arg -> stop (Wrong (s, arg, "no argument")) in
let get_arg () =
- if !current + 1 < l then argv.(!current + 1)
- else stop (Missing s)
+ match follow with
+ | None ->
+ if !current + 1 < l then argv.(!current + 1)
+ else stop (Missing s)
+ | Some arg ->
+ decr current;
+ arg
in
begin try
let rec treat_action = function
diff --git a/stdlib/arg.mli b/stdlib/arg.mli
index 22eda40..7078071 100644
--- a/stdlib/arg.mli
+++ b/stdlib/arg.mli
@@ -25,7 +25,8 @@
[Unit], [Set] and [Clear] keywords take no argument. A [Rest]
keyword takes the remaining of the command line as arguments.
Every other keyword takes the following word on the command line
- as argument.
+ as argument. For compatibility with GNU getopt_long, [keyword=arg]
+ is also allowed.
Arguments not preceded by a keyword are called anonymous arguments.
Examples ([cmd] is assumed to be the command name):
--
2.0.4
+10 -8
View File
@@ -26,14 +26,16 @@
<Dependency>chrpath</Dependency>
</BuildDependencies>
<Patches>
<Patch>fedora/0001-Don-t-ignore-.-configure-it-s-a-real-git-file.patch</Patch>
<Patch>fedora/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch</Patch>
<Patch>fedora/0003-Don-t-add-rpaths-to-libraries.patch</Patch>
<Patch>fedora/0004-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch</Patch>
<Patch>fedora/0005-configure-Allow-user-defined-C-compiler-flags.patch</Patch>
<Patch>fedora/0009-arg-Add-no_arg-and-get_arg-helper-functions.patch</Patch>
<Patch>fedora/0010-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch</Patch>
<Patch>fedora/0011-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch</Patch>
<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>