From 813db4681336c387be0dbd22d49f41cda80dca53 Mon Sep 17 00:00:00 2001 From: CentOS Sources Date: Apr 10 2018 06:09:38 +0000 Subject: import ocaml-4.05.0-6.el7 --- diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..17a0546 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +SOURCES/ocaml-4.05-refman-html.tar.gz +SOURCES/ocaml-4.05-refman.info.tar.gz +SOURCES/ocaml-4.05-refman.pdf +SOURCES/ocaml-4.05.0.tar.xz diff --git a/.ocaml.metadata b/.ocaml.metadata new file mode 100644 index 0000000..0531a5b --- /dev/null +++ b/.ocaml.metadata @@ -0,0 +1,4 @@ +1fa154769c893c9ccf615c00b0ae81386240ef25 SOURCES/ocaml-4.05-refman-html.tar.gz +9374cd940da70493709dfb5f3ea5dc86febea27a SOURCES/ocaml-4.05-refman.info.tar.gz +98d4599d04a5fb07b739eef4a2c318df7f01d73f SOURCES/ocaml-4.05-refman.pdf +948dcedf0e33b7be4bb573874a8d57caec0f8b43 SOURCES/ocaml-4.05.0.tar.xz diff --git a/README.md b/README.md deleted file mode 100644 index 0e7897f..0000000 --- a/README.md +++ /dev/null @@ -1,5 +0,0 @@ -The master branch has no content - -Look at the c7 branch if you are working with CentOS-7, or the c4/c5/c6 branch for CentOS-4, 5 or 6 - -If you find this file in a distro specific branch, it means that no content has been checked in yet diff --git a/SOURCES/0001-Changes-clarify-compatibility-breaking-change-items.patch b/SOURCES/0001-Changes-clarify-compatibility-breaking-change-items.patch new file mode 100644 index 0000000..a0f93d3 --- /dev/null +++ b/SOURCES/0001-Changes-clarify-compatibility-breaking-change-items.patch @@ -0,0 +1,36 @@ +From 5bd96201dbd70c387c5af4b510d0de4abc0cfd7d Mon Sep 17 00:00:00 2001 +From: Gabriel Scherer +Date: Wed, 12 Jul 2017 11:57:22 -0400 +Subject: [PATCH 01/12] Changes: clarify compatibility-breaking change items + +--- + Changes | 6 ++++++ + 1 file changed, 6 insertions(+) + +diff --git a/Changes b/Changes +index cc59f635e..10642f19d 100644 +--- a/Changes ++++ b/Changes +@@ -64,6 +64,9 @@ OCaml 4.05.0 (13 Jul 2017): + + * MPR#7414, GPR#929: Soundness bug with non-generalized type variables and + functors. ++ (compatibility: some code using module-global mutable state will ++ fail at compile-time and is fixed by adding extra annotations; ++ see the Mantis and Github discussions.) + (Jacques Garrigue, report by Leo White) + + ### Compiler user-interface and warnings: +@@ -567,6 +570,9 @@ The complete list of changes is listed below. + (Mark Shinwell, Leo White, review by Xavier Leroy) + + * GPR#1088: Gc.minor_words now returns accurate numbers. ++ (compatibility: the .mli declaration of `Gc.minor_words` ++ and `Gc.get_minor_free` changed, which may break libraries ++ re-exporting these values.) + (Stephen Dolan, review by Pierre Chambart and Xavier Leroy) + + OCaml 4.04.2 (23 Jun 2017): +-- +2.13.2 + diff --git a/SOURCES/0002-MPR-7591-frametable-not-8-aligned-on-x86-64-port.patch b/SOURCES/0002-MPR-7591-frametable-not-8-aligned-on-x86-64-port.patch new file mode 100644 index 0000000..0fa4fda --- /dev/null +++ b/SOURCES/0002-MPR-7591-frametable-not-8-aligned-on-x86-64-port.patch @@ -0,0 +1,44 @@ +From 22dbcdfb921b19d171134de90984805622877e55 Mon Sep 17 00:00:00 2001 +From: Xavier Leroy +Date: Sat, 22 Jul 2017 16:32:23 -0400 +Subject: [PATCH 02/12] MPR#7591: frametable not 8-aligned on x86-64 port + +Cherry-pick of 7077b60 from trunk. +--- + Changes | 7 +++++++ + asmcomp/amd64/emit.mlp | 3 ++- + 2 files changed, 9 insertions(+), 1 deletion(-) + +diff --git a/Changes b/Changes +index 10642f19d..cc7e0a82f 100644 +--- a/Changes ++++ b/Changes +@@ -1,3 +1,10 @@ ++Working 4.05.x branch ++--------------------- ++ ++- MPR#7591, GPR#1257: on x86-64, frame table is not 8-aligned ++ (Xavier Leroy, report by Mantis user "voglerr", review by Gabriel Scherer) ++ ++ + OCaml 4.05.0 (13 Jul 2017): + --------------------------- + +diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp +index c3f8692a8..75a785f74 100644 +--- a/asmcomp/amd64/emit.mlp ++++ b/asmcomp/amd64/emit.mlp +@@ -1065,8 +1065,9 @@ let end_assembly() = + + D.data (); + emit_global_label "data_end"; +- D.long (const 0); ++ D.qword (const 0); + ++ D.align 8; (* PR#7591 *) + emit_global_label "frametable"; + + let setcnt = ref 0 in +-- +2.13.2 + diff --git a/SOURCES/0003-Fixes-for-out-of-range-Ialloc.patch b/SOURCES/0003-Fixes-for-out-of-range-Ialloc.patch new file mode 100644 index 0000000..2cba417 --- /dev/null +++ b/SOURCES/0003-Fixes-for-out-of-range-Ialloc.patch @@ -0,0 +1,409 @@ +From 664f0763d37f85e2ec53d6394251b5948dcfa727 Mon Sep 17 00:00:00 2001 +From: Mark Shinwell +Date: Mon, 31 Jul 2017 14:37:47 +0100 +Subject: [PATCH 03/12] Fixes for out-of-range Ialloc + +Cherry-pick of GPR#1271 which was merged on trunk. + +Fixes for Ialloc instructions allocating more than Max_young_wosize words in the minor heap + +Out-of-range Ialloc instructions cause various problems, see in particular GPR #1250. +--- + Changes | 5 + + asmcomp/cmmgen.ml | 38 ++-- + asmcomp/selectgen.ml | 3 +- + testsuite/tests/basic-more/pr1271.ml | 288 ++++++++++++++++++++++++++++ + testsuite/tests/basic-more/pr1271.reference | 2 + + 5 files changed, 317 insertions(+), 19 deletions(-) + create mode 100644 testsuite/tests/basic-more/pr1271.ml + create mode 100644 testsuite/tests/basic-more/pr1271.reference + +diff --git a/Changes b/Changes +index cc7e0a82f..e8dbd42e2 100644 +--- a/Changes ++++ b/Changes +@@ -4,6 +4,11 @@ Working 4.05.x branch + - MPR#7591, GPR#1257: on x86-64, frame table is not 8-aligned + (Xavier Leroy, report by Mantis user "voglerr", review by Gabriel Scherer) + ++- GPR#1271: Don't generate Ialloc instructions for closures that exceed ++ Max_young_wosize; instead allocate them on the major heap. (Related ++ to GPR#1250.) ++ (Mark Shinwell) ++ + + OCaml 4.05.0 (13 Jul 2017): + --------------------------- +diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml +index 4ac4b40c6..2120d3985 100644 +--- a/asmcomp/cmmgen.ml ++++ b/asmcomp/cmmgen.ml +@@ -1641,29 +1641,31 @@ let rec transl env e = + List.iter (fun f -> Queue.add f functions) fundecls; + Cconst_symbol lbl + | Uclosure(fundecls, clos_vars) -> +- let block_size = +- fundecls_size fundecls + List.length clos_vars in + let rec transl_fundecls pos = function + [] -> + List.map (transl env) clos_vars + | f :: rem -> + Queue.add f functions; +- let header = +- if pos = 0 +- then alloc_closure_header block_size f.dbg +- else alloc_infix_header pos f.dbg in +- if f.arity = 1 || f.arity = 0 then +- header :: +- Cconst_symbol f.label :: +- int_const f.arity :: +- transl_fundecls (pos + 3) rem +- else +- header :: +- Cconst_symbol(curry_function f.arity) :: +- int_const f.arity :: +- Cconst_symbol f.label :: +- transl_fundecls (pos + 4) rem in +- Cop(Calloc, transl_fundecls 0 fundecls, Debuginfo.none) ++ let without_header = ++ if f.arity = 1 || f.arity = 0 then ++ Cconst_symbol f.label :: ++ int_const f.arity :: ++ transl_fundecls (pos + 3) rem ++ else ++ Cconst_symbol(curry_function f.arity) :: ++ int_const f.arity :: ++ Cconst_symbol f.label :: ++ transl_fundecls (pos + 4) rem ++ in ++ if pos = 0 then without_header ++ else (alloc_infix_header pos f.dbg) :: without_header ++ in ++ let dbg = ++ match fundecls with ++ | [] -> Debuginfo.none ++ | fundecl::_ -> fundecl.dbg ++ in ++ make_alloc dbg Obj.closure_tag (transl_fundecls 0 fundecls) + | Uoffset(arg, offset) -> + (* produces a valid Caml value, pointing just after an infix header *) + let ptr = transl env arg in +diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml +index 7cd8cd5c3..1158fc0d0 100644 +--- a/asmcomp/selectgen.ml ++++ b/asmcomp/selectgen.ml +@@ -738,7 +738,8 @@ method emit_expr (env:environment) exp = + loc_arg (Proc.loc_external_results rd) in + self#insert_move_results loc_res rd stack_ofs; + Some rd +- | Ialloc { words = _; spacetime_index; label_after_call_gc; } -> ++ | Ialloc { words; spacetime_index; label_after_call_gc; } -> ++ assert (words <= Config.max_young_wosize); + let rd = self#regs_for typ_val in + let size = size_expr env (Ctuple new_args) in + let op = +diff --git a/testsuite/tests/basic-more/pr1271.ml b/testsuite/tests/basic-more/pr1271.ml +new file mode 100644 +index 000000000..3890d0fbb +--- /dev/null ++++ b/testsuite/tests/basic-more/pr1271.ml +@@ -0,0 +1,288 @@ ++(* GPR#1271 *) ++ ++module F (X : sig val x : int end) = struct ++ let rec f1 y = f270 (X.x + y) ++ and f2 y = (f1 [@inlined never]) y ++ and f3 y = (f2 [@inlined never]) y ++ and f4 y = (f3 [@inlined never]) y ++ and f5 y = (f4 [@inlined never]) y ++ and f6 y = (f5 [@inlined never]) y ++ and f7 y = (f6 [@inlined never]) y ++ and f8 y = (f7 [@inlined never]) y ++ and f9 y = (f8 [@inlined never]) y ++ and f10 y = (f9 [@inlined never]) y ++ and f11 y = (f10 [@inlined never]) y ++ and f12 y = (f11 [@inlined never]) y ++ and f13 y = (f12 [@inlined never]) y ++ and f14 y = (f13 [@inlined never]) y ++ and f15 y = (f14 [@inlined never]) y ++ and f16 y = (f15 [@inlined never]) y ++ and f17 y = (f16 [@inlined never]) y ++ and f18 y = (f17 [@inlined never]) y ++ and f19 y = (f18 [@inlined never]) y ++ and f20 y = (f19 [@inlined never]) y ++ and f21 y = (f20 [@inlined never]) y ++ and f22 y = (f21 [@inlined never]) y ++ and f23 y = (f22 [@inlined never]) y ++ and f24 y = (f23 [@inlined never]) y ++ and f25 y = (f24 [@inlined never]) y ++ and f26 y = (f25 [@inlined never]) y ++ and f27 y = (f26 [@inlined never]) y ++ and f28 y = (f27 [@inlined never]) y ++ and f29 y = (f28 [@inlined never]) y ++ and f30 y = (f29 [@inlined never]) y ++ and f31 y = (f30 [@inlined never]) y ++ and f32 y = (f31 [@inlined never]) y ++ and f33 y = (f32 [@inlined never]) y ++ and f34 y = (f33 [@inlined never]) y ++ and f35 y = (f34 [@inlined never]) y ++ and f36 y = (f35 [@inlined never]) y ++ and f37 y = (f36 [@inlined never]) y ++ and f38 y = (f37 [@inlined never]) y ++ and f39 y = (f38 [@inlined never]) y ++ and f40 y = (f39 [@inlined never]) y ++ and f41 y = (f40 [@inlined never]) y ++ and f42 y = (f41 [@inlined never]) y ++ and f43 y = (f42 [@inlined never]) y ++ and f44 y = (f43 [@inlined never]) y ++ and f45 y = (f44 [@inlined never]) y ++ and f46 y = (f45 [@inlined never]) y ++ and f47 y = (f46 [@inlined never]) y ++ and f48 y = (f47 [@inlined never]) y ++ and f49 y = (f48 [@inlined never]) y ++ and f50 y = (f49 [@inlined never]) y ++ and f51 y = (f50 [@inlined never]) y ++ and f52 y = (f51 [@inlined never]) y ++ and f53 y = (f52 [@inlined never]) y ++ and f54 y = (f53 [@inlined never]) y ++ and f55 y = (f54 [@inlined never]) y ++ and f56 y = (f55 [@inlined never]) y ++ and f57 y = (f56 [@inlined never]) y ++ and f58 y = (f57 [@inlined never]) y ++ and f59 y = (f58 [@inlined never]) y ++ and f60 y = (f59 [@inlined never]) y ++ and f61 y = (f60 [@inlined never]) y ++ and f62 y = (f61 [@inlined never]) y ++ and f63 y = (f62 [@inlined never]) y ++ and f64 y = (f63 [@inlined never]) y ++ and f65 y = (f64 [@inlined never]) y ++ and f66 y = (f65 [@inlined never]) y ++ and f67 y = (f66 [@inlined never]) y ++ and f68 y = (f67 [@inlined never]) y ++ and f69 y = (f68 [@inlined never]) y ++ and f70 y = (f69 [@inlined never]) y ++ and f71 y = (f70 [@inlined never]) y ++ and f72 y = (f71 [@inlined never]) y ++ and f73 y = (f72 [@inlined never]) y ++ and f74 y = (f73 [@inlined never]) y ++ and f75 y = (f74 [@inlined never]) y ++ and f76 y = (f75 [@inlined never]) y ++ and f77 y = (f76 [@inlined never]) y ++ and f78 y = (f77 [@inlined never]) y ++ and f79 y = (f78 [@inlined never]) y ++ and f80 y = (f79 [@inlined never]) y ++ and f81 y = (f80 [@inlined never]) y ++ and f82 y = (f81 [@inlined never]) y ++ and f83 y = (f82 [@inlined never]) y ++ and f84 y = (f83 [@inlined never]) y ++ and f85 y = (f84 [@inlined never]) y ++ and f86 y = (f85 [@inlined never]) y ++ and f87 y = (f86 [@inlined never]) y ++ and f88 y = (f87 [@inlined never]) y ++ and f89 y = (f88 [@inlined never]) y ++ and f90 y = (f89 [@inlined never]) y ++ and f91 y = (f90 [@inlined never]) y ++ and f92 y = (f91 [@inlined never]) y ++ and f93 y = (f92 [@inlined never]) y ++ and f94 y = (f93 [@inlined never]) y ++ and f95 y = (f94 [@inlined never]) y ++ and f96 y = (f95 [@inlined never]) y ++ and f97 y = (f96 [@inlined never]) y ++ and f98 y = (f97 [@inlined never]) y ++ and f99 y = (f98 [@inlined never]) y ++ and f100 y = (f99 [@inlined never]) y ++ and f101 y = (f100 [@inlined never]) y ++ and f102 y = (f101 [@inlined never]) y ++ and f103 y = (f102 [@inlined never]) y ++ and f104 y = (f103 [@inlined never]) y ++ and f105 y = (f104 [@inlined never]) y ++ and f106 y = (f105 [@inlined never]) y ++ and f107 y = (f106 [@inlined never]) y ++ and f108 y = (f107 [@inlined never]) y ++ and f109 y = (f108 [@inlined never]) y ++ and f110 y = (f109 [@inlined never]) y ++ and f111 y = (f110 [@inlined never]) y ++ and f112 y = (f111 [@inlined never]) y ++ and f113 y = (f112 [@inlined never]) y ++ and f114 y = (f113 [@inlined never]) y ++ and f115 y = (f114 [@inlined never]) y ++ and f116 y = (f115 [@inlined never]) y ++ and f117 y = (f116 [@inlined never]) y ++ and f118 y = (f117 [@inlined never]) y ++ and f119 y = (f118 [@inlined never]) y ++ and f120 y = (f119 [@inlined never]) y ++ and f121 y = (f120 [@inlined never]) y ++ and f122 y = (f121 [@inlined never]) y ++ and f123 y = (f122 [@inlined never]) y ++ and f124 y = (f123 [@inlined never]) y ++ and f125 y = (f124 [@inlined never]) y ++ and f126 y = (f125 [@inlined never]) y ++ and f127 y = (f126 [@inlined never]) y ++ and f128 y = (f127 [@inlined never]) y ++ and f129 y = (f128 [@inlined never]) y ++ and f130 y = (f129 [@inlined never]) y ++ and f131 y = (f130 [@inlined never]) y ++ and f132 y = (f131 [@inlined never]) y ++ and f133 y = (f132 [@inlined never]) y ++ and f134 y = (f133 [@inlined never]) y ++ and f135 y = (f134 [@inlined never]) y ++ and f136 y = (f135 [@inlined never]) y ++ and f137 y = (f136 [@inlined never]) y ++ and f138 y = (f137 [@inlined never]) y ++ and f139 y = (f138 [@inlined never]) y ++ and f140 y = (f139 [@inlined never]) y ++ and f141 y = (f140 [@inlined never]) y ++ and f142 y = (f141 [@inlined never]) y ++ and f143 y = (f142 [@inlined never]) y ++ and f144 y = (f143 [@inlined never]) y ++ and f145 y = (f144 [@inlined never]) y ++ and f146 y = (f145 [@inlined never]) y ++ and f147 y = (f146 [@inlined never]) y ++ and f148 y = (f147 [@inlined never]) y ++ and f149 y = (f148 [@inlined never]) y ++ and f150 y = (f149 [@inlined never]) y ++ and f151 y = (f150 [@inlined never]) y ++ and f152 y = (f151 [@inlined never]) y ++ and f153 y = (f152 [@inlined never]) y ++ and f154 y = (f153 [@inlined never]) y ++ and f155 y = (f154 [@inlined never]) y ++ and f156 y = (f155 [@inlined never]) y ++ and f157 y = (f156 [@inlined never]) y ++ and f158 y = (f157 [@inlined never]) y ++ and f159 y = (f158 [@inlined never]) y ++ and f160 y = (f159 [@inlined never]) y ++ and f161 y = (f160 [@inlined never]) y ++ and f162 y = (f161 [@inlined never]) y ++ and f163 y = (f162 [@inlined never]) y ++ and f164 y = (f163 [@inlined never]) y ++ and f165 y = (f164 [@inlined never]) y ++ and f166 y = (f165 [@inlined never]) y ++ and f167 y = (f166 [@inlined never]) y ++ and f168 y = (f167 [@inlined never]) y ++ and f169 y = (f168 [@inlined never]) y ++ and f170 y = (f169 [@inlined never]) y ++ and f171 y = (f170 [@inlined never]) y ++ and f172 y = (f171 [@inlined never]) y ++ and f173 y = (f172 [@inlined never]) y ++ and f174 y = (f173 [@inlined never]) y ++ and f175 y = (f174 [@inlined never]) y ++ and f176 y = (f175 [@inlined never]) y ++ and f177 y = (f176 [@inlined never]) y ++ and f178 y = (f177 [@inlined never]) y ++ and f179 y = (f178 [@inlined never]) y ++ and f180 y = (f179 [@inlined never]) y ++ and f181 y = (f180 [@inlined never]) y ++ and f182 y = (f181 [@inlined never]) y ++ and f183 y = (f182 [@inlined never]) y ++ and f184 y = (f183 [@inlined never]) y ++ and f185 y = (f184 [@inlined never]) y ++ and f186 y = (f185 [@inlined never]) y ++ and f187 y = (f186 [@inlined never]) y ++ and f188 y = (f187 [@inlined never]) y ++ and f189 y = (f188 [@inlined never]) y ++ and f190 y = (f189 [@inlined never]) y ++ and f191 y = (f190 [@inlined never]) y ++ and f192 y = (f191 [@inlined never]) y ++ and f193 y = (f192 [@inlined never]) y ++ and f194 y = (f193 [@inlined never]) y ++ and f195 y = (f194 [@inlined never]) y ++ and f196 y = (f195 [@inlined never]) y ++ and f197 y = (f196 [@inlined never]) y ++ and f198 y = (f197 [@inlined never]) y ++ and f199 y = (f198 [@inlined never]) y ++ and f200 y = (f199 [@inlined never]) y ++ and f201 y = (f200 [@inlined never]) y ++ and f202 y = (f201 [@inlined never]) y ++ and f203 y = (f202 [@inlined never]) y ++ and f204 y = (f203 [@inlined never]) y ++ and f205 y = (f204 [@inlined never]) y ++ and f206 y = (f205 [@inlined never]) y ++ and f207 y = (f206 [@inlined never]) y ++ and f208 y = (f207 [@inlined never]) y ++ and f209 y = (f208 [@inlined never]) y ++ and f210 y = (f209 [@inlined never]) y ++ and f211 y = (f210 [@inlined never]) y ++ and f212 y = (f211 [@inlined never]) y ++ and f213 y = (f212 [@inlined never]) y ++ and f214 y = (f213 [@inlined never]) y ++ and f215 y = (f214 [@inlined never]) y ++ and f216 y = (f215 [@inlined never]) y ++ and f217 y = (f216 [@inlined never]) y ++ and f218 y = (f217 [@inlined never]) y ++ and f219 y = (f218 [@inlined never]) y ++ and f220 y = (f219 [@inlined never]) y ++ and f221 y = (f220 [@inlined never]) y ++ and f222 y = (f221 [@inlined never]) y ++ and f223 y = (f222 [@inlined never]) y ++ and f224 y = (f223 [@inlined never]) y ++ and f225 y = (f224 [@inlined never]) y ++ and f226 y = (f225 [@inlined never]) y ++ and f227 y = (f226 [@inlined never]) y ++ and f228 y = (f227 [@inlined never]) y ++ and f229 y = (f228 [@inlined never]) y ++ and f230 y = (f229 [@inlined never]) y ++ and f231 y = (f230 [@inlined never]) y ++ and f232 y = (f231 [@inlined never]) y ++ and f233 y = (f232 [@inlined never]) y ++ and f234 y = (f233 [@inlined never]) y ++ and f235 y = (f234 [@inlined never]) y ++ and f236 y = (f235 [@inlined never]) y ++ and f237 y = (f236 [@inlined never]) y ++ and f238 y = (f237 [@inlined never]) y ++ and f239 y = (f238 [@inlined never]) y ++ and f240 y = (f239 [@inlined never]) y ++ and f241 y = (f240 [@inlined never]) y ++ and f242 y = (f241 [@inlined never]) y ++ and f243 y = (f242 [@inlined never]) y ++ and f244 y = (f243 [@inlined never]) y ++ and f245 y = (f244 [@inlined never]) y ++ and f246 y = (f245 [@inlined never]) y ++ and f247 y = (f246 [@inlined never]) y ++ and f248 y = (f247 [@inlined never]) y ++ and f249 y = (f248 [@inlined never]) y ++ and f250 y = (f249 [@inlined never]) y ++ and f251 y = (f250 [@inlined never]) y ++ and f252 y = (f251 [@inlined never]) y ++ and f253 y = (f252 [@inlined never]) y ++ and f254 y = (f253 [@inlined never]) y ++ and f255 y = (f254 [@inlined never]) y ++ and f256 y = (f255 [@inlined never]) y ++ and f257 y = (f256 [@inlined never]) y ++ and f258 y = (f257 [@inlined never]) y ++ and f259 y = (f258 [@inlined never]) y ++ and f260 y = (f259 [@inlined never]) y ++ and f261 y = (f260 [@inlined never]) y ++ and f262 y = (f261 [@inlined never]) y ++ and f263 y = (f262 [@inlined never]) y ++ and f264 y = (f263 [@inlined never]) y ++ and f265 y = (f264 [@inlined never]) y ++ and f266 y = (f265 [@inlined never]) y ++ and f267 y = (f266 [@inlined never]) y ++ and f268 y = (f267 [@inlined never]) y ++ and f269 y = (f268 [@inlined never]) y ++ and f270 y = (f269 [@inlined never]) y ++end ++ ++let words0 = Gc.minor_words () ++let words1 = Gc.minor_words () ++module X = F (struct let x = 42 end) ++let words2 = Gc.minor_words () ++ ++let expected = words1 -. words0 ++ ++let () = ++ match Sys.backend_type with ++ | Sys.Native -> ++ Printf.printf "%.0f" ((words2 -. words1) -. expected) ++ | Sys.Bytecode | Sys.Other _ -> ++ print_string "0" +diff --git a/testsuite/tests/basic-more/pr1271.reference b/testsuite/tests/basic-more/pr1271.reference +new file mode 100644 +index 000000000..6e374c16e +--- /dev/null ++++ b/testsuite/tests/basic-more/pr1271.reference +@@ -0,0 +1,2 @@ ++0 ++All tests succeeded. +-- +2.13.2 + diff --git a/SOURCES/0004-Don-t-add-rpaths-to-libraries.patch b/SOURCES/0004-Don-t-add-rpaths-to-libraries.patch new file mode 100644 index 0000000..6ce11dc --- /dev/null +++ b/SOURCES/0004-Don-t-add-rpaths-to-libraries.patch @@ -0,0 +1,29 @@ +From b2118848e9a0aa96c5ccb3ede65f2d0e9cfb114a Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 24 Jun 2014 10:00:15 +0100 +Subject: [PATCH 04/12] Don't add rpaths to libraries. + +--- + tools/Makefile | 6 +++--- + 1 file changed, 3 insertions(+), 3 deletions(-) + +diff --git a/tools/Makefile b/tools/Makefile +index 9a8cf652b..269aa18e6 100644 +--- a/tools/Makefile ++++ b/tools/Makefile +@@ -156,9 +156,9 @@ $(call byte_and_opt,ocamlmklib,ocamlmklibconfig.cmo config.cmo misc.cmo \ + ocamlmklibconfig.ml: ../config/Makefile Makefile + (echo 'let bindir = "$(BINDIR)"'; \ + echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\ +- echo 'let byteccrpath = "$(BYTECCRPATH)"'; \ +- echo 'let nativeccrpath = "$(NATIVECCRPATH)"'; \ +- echo 'let mksharedlibrpath = "$(MKSHAREDLIBRPATH)"'; \ ++ echo 'let byteccrpath = ""'; \ ++ echo 'let nativeccrpath = ""'; \ ++ echo 'let mksharedlibrpath = ""'; \ + echo 'let toolpref = "$(TOOLPREF)"'; \ + sed -n -e 's/^#ml //p' ../config/Makefile) \ + > ocamlmklibconfig.ml +-- +2.13.2 + diff --git a/SOURCES/0005-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch b/SOURCES/0005-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch new file mode 100644 index 0000000..868db9a --- /dev/null +++ b/SOURCES/0005-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch @@ -0,0 +1,240 @@ +From 80e2921e472f66f70575d6e4e6c8ff6f5714e4e4 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:40:36 +0100 +Subject: [PATCH 05/12] ocamlbyteinfo, ocamlplugininfo: Useful utilities from + Debian, sent upstream. + +See: +http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD +--- + ocamlbyteinfo.ml | 101 +++++++++++++++++++++++++++++++++++++++++++++++++ + ocamlplugininfo.ml | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++ + 2 files changed, 210 insertions(+) + create mode 100644 ocamlbyteinfo.ml + create mode 100644 ocamlplugininfo.ml + +diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml +new file mode 100644 +index 000000000..eb9a293e3 +--- /dev/null ++++ b/ocamlbyteinfo.ml +@@ -0,0 +1,101 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* *) ++(* Copyright 2009 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the GNU Library General Public License, with *) ++(* the special exception on linking described in file ../../LICENSE. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id$ *) ++ ++(* Dumps a bytecode binary file *) ++ ++open Sys ++open Dynlinkaux ++ ++let input_stringlist ic len = ++ let get_string_list sect len = ++ let rec fold s e acc = ++ if e != len then ++ if sect.[e] = '\000' then ++ fold (e+1) (e+1) (String.sub sect s (e-s) :: acc) ++ else fold s (e+1) acc ++ else acc ++ in fold 0 0 [] ++ in ++ let sect = String.create len in ++ let _ = really_input ic sect 0 len in ++ get_string_list sect len ++ ++let print = Printf.printf ++let perr s = ++ Printf.eprintf "%s\n" s; ++ exit(1) ++let p_title title = print "%s:\n" title ++ ++let p_section title format pdata = function ++ | [] -> () ++ | l -> ++ p_title title; ++ List.iter ++ (fun (name, data) -> print format (pdata data) name) ++ l ++ ++let p_list title format = function ++ | [] -> () ++ | l -> ++ p_title title; ++ List.iter ++ (fun name -> print format name) ++ l ++ ++let _ = ++ try ++ let input_name = Sys.argv.(1) in ++ let ic = open_in_bin input_name in ++ Bytesections.read_toc ic; ++ List.iter ++ (fun section -> ++ try ++ let len = Bytesections.seek_section ic section in ++ if len > 0 then match section with ++ | "CRCS" -> ++ p_section ++ "Imported Units" ++ "\t%s\t%s\n" ++ Digest.to_hex ++ (input_value ic : (string * Digest.t) list) ++ | "DLLS" -> ++ p_list ++ "Used Dlls" "\t%s\n" ++ (input_stringlist ic len) ++ | "DLPT" -> ++ p_list ++ "Additional Dll paths" ++ "\t%s\n" ++ (input_stringlist ic len) ++ | "PRIM" -> ++ let prims = (input_stringlist ic len) in ++ print "Uses unsafe features: "; ++ begin match prims with ++ [] -> print "no\n" ++ | l -> print "YES\n"; ++ p_list "Primitives declared in this module" ++ "\t%s\n" ++ l ++ end ++ | _ -> () ++ with Not_found | Failure _ | Invalid_argument _ -> () ++ ) ++ ["CRCS"; "DLLS"; "DLPT"; "PRIM"]; ++ close_in ic ++ with ++ | Sys_error msg -> ++ perr msg ++ | Invalid_argument("index out of bounds") -> ++ perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0)) +diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml +new file mode 100644 +index 000000000..e28800f31 +--- /dev/null ++++ b/ocamlplugininfo.ml +@@ -0,0 +1,109 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* *) ++(* Copyright 2009 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the GNU Library General Public License, with *) ++(* the special exception on linking described in file ../../LICENSE. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id$ *) ++ ++(* Dumps a .cmxs file *) ++ ++open Natdynlink ++open Format ++ ++let file = ++ try ++ Sys.argv.(1) ++ with _ -> begin ++ Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0); ++ exit(1) ++ end ++ ++exception Abnormal_exit ++ ++let error s e = ++ let eprint = Printf.eprintf in ++ let print_exc s = function ++ | End_of_file -> ++ eprint "%s: %s\n" s file ++ | Abnormal_exit -> ++ eprint "%s\n" s ++ | e -> eprint "%s\n" (Printexc.to_string e) ++ in ++ print_exc s e; ++ exit(1) ++ ++let read_in command = ++ let cmd = Printf.sprintf command file in ++ let ic = Unix.open_process_in cmd in ++ try ++ let line = input_line ic in ++ begin match (Unix.close_process_in ic) with ++ | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line ++ | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> ++ error ++ (Printf.sprintf ++ "Command \"%s\" exited abnormally" ++ cmd ++ ) ++ Abnormal_exit ++ end ++ with e -> error "File is empty" e ++ ++let get_offset adr_off adr_sec = ++ try ++ let adr = List.nth adr_off 4 in ++ let off = List.nth adr_off 5 in ++ let sec = List.hd adr_sec in ++ ++ let (!) x = Int64.of_string ("0x" ^ x) in ++ let (+) = Int64.add in ++ let (-) = Int64.sub in ++ ++ Int64.to_int (!off + !sec - !adr) ++ ++ with Failure _ | Invalid_argument _ -> ++ error ++ "Command output doesn't have the expected format" ++ Abnormal_exit ++ ++let print_infos name crc defines cmi cmx = ++ let print_name_crc (name, crc) = ++ printf "@ %s (%s)" name (Digest.to_hex crc) ++ in ++ let pr_imports ppf imps = List.iter print_name_crc imps in ++ printf "Name: %s@." name; ++ printf "CRC of implementation: %s@." (Digest.to_hex crc); ++ printf "@[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.13.2 + diff --git a/SOURCES/0006-configure-Allow-user-defined-C-compiler-flags.patch b/SOURCES/0006-configure-Allow-user-defined-C-compiler-flags.patch new file mode 100644 index 0000000..c8f9333 --- /dev/null +++ b/SOURCES/0006-configure-Allow-user-defined-C-compiler-flags.patch @@ -0,0 +1,27 @@ +From 313692e7425fd91917d4e35ad4ade459cb2c1138 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:44:18 +0100 +Subject: [PATCH 06/12] configure: Allow user defined C compiler flags. + +--- + configure | 4 ++++ + 1 file changed, 4 insertions(+) + +diff --git a/configure b/configure +index e79659954..786f4cdbe 100755 +--- a/configure ++++ b/configure +@@ -2002,6 +2002,10 @@ if $with_fpic; then + echo "#define CAML_WITH_FPIC" >> m.h + fi + ++# Allow user defined C Compiler flags ++bytecccompopts="$bytecccompopts $CFLAGS" ++nativecccompopts="$nativecccompopts $CFLAGS" ++ + # Finish generated files + + cclibs="$cclibs $mathlib" +-- +2.13.2 + diff --git a/SOURCES/0007-Adapt-config.guess-for-RISC-V.patch b/SOURCES/0007-Adapt-config.guess-for-RISC-V.patch new file mode 100644 index 0000000..7611b72 --- /dev/null +++ b/SOURCES/0007-Adapt-config.guess-for-RISC-V.patch @@ -0,0 +1,35 @@ +From 68a8eb8f3bbc254cd5cb685f058bc5b0ef1029e7 Mon Sep 17 00:00:00 2001 +From: Nicolas Ojeda Bar +Date: Tue, 8 Nov 2016 23:56:50 +0100 +Subject: [PATCH 07/12] Adapt config.guess for RISC-V + +--- + config/gnu/config.guess | 5 ++++- + 1 file changed, 4 insertions(+), 1 deletion(-) + +diff --git a/config/gnu/config.guess b/config/gnu/config.guess +index b79252d6b..8335398b2 100755 +--- a/config/gnu/config.guess ++++ b/config/gnu/config.guess +@@ -2,7 +2,7 @@ + # Attempt to guess a canonical system name. + # Copyright 1992-2013 Free Software Foundation, Inc. + +-timestamp='2013-06-10' ++timestamp='2016-10-23' + + # This file is free software; you can redistribute it and/or modify it + # under the terms of the GNU General Public License as published by +@@ -1001,6 +1001,9 @@ EOF + ppcle:Linux:*:*) + echo powerpcle-unknown-linux-${LIBC} + exit ;; ++ riscv*:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux ++ exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo ${UNAME_MACHINE}-ibm-linux-${LIBC} + exit ;; +-- +2.13.2 + diff --git a/SOURCES/0008-Add-RISC-V-backend-runtime.patch b/SOURCES/0008-Add-RISC-V-backend-runtime.patch new file mode 100644 index 0000000..9a8e815 --- /dev/null +++ b/SOURCES/0008-Add-RISC-V-backend-runtime.patch @@ -0,0 +1,1717 @@ +From d0f08d1cfa01efb02721f7d2e04ce61f38d6d6a7 Mon Sep 17 00:00:00 2001 +From: Nicolas Ojeda Bar +Date: Fri, 4 Nov 2016 20:39:09 +0100 +Subject: [PATCH 08/12] Add RISC-V backend & runtime + +--- + README.adoc | 1 + + asmcomp/riscv/CSE.ml | 36 +++ + asmcomp/riscv/arch.ml | 84 ++++++ + asmcomp/riscv/emit.mlp | 616 ++++++++++++++++++++++++++++++++++++++++++++ + asmcomp/riscv/proc.ml | 301 ++++++++++++++++++++++ + asmcomp/riscv/reload.ml | 16 ++ + asmcomp/riscv/scheduling.ml | 19 ++ + asmcomp/riscv/selection.ml | 85 ++++++ + asmrun/riscv.S | 424 ++++++++++++++++++++++++++++++ + byterun/caml/stack.h | 5 + + configure | 5 +- + 11 files changed, 1591 insertions(+), 1 deletion(-) + create mode 100644 asmcomp/riscv/CSE.ml + create mode 100644 asmcomp/riscv/arch.ml + create mode 100644 asmcomp/riscv/emit.mlp + create mode 100644 asmcomp/riscv/proc.ml + create mode 100644 asmcomp/riscv/reload.ml + create mode 100644 asmcomp/riscv/scheduling.ml + create mode 100644 asmcomp/riscv/selection.ml + create mode 100644 asmrun/riscv.S + +diff --git a/README.adoc b/README.adoc +index fe07edbba..f7d13bc06 100644 +--- a/README.adoc ++++ b/README.adoc +@@ -34,6 +34,7 @@ IA32 (Pentium):: NetBSD, OpenBSD, Solaris 9 + PowerPC:: NetBSD + ARM:: NetBSD + SPARC:: Solaris, Linux, NetBSD ++RISC-V:: Linux + + Other operating systems for the processors above have not been tested, but + the compiler may work under other operating systems with little work. +diff --git a/asmcomp/riscv/CSE.ml b/asmcomp/riscv/CSE.ml +new file mode 100644 +index 000000000..302811a99 +--- /dev/null ++++ b/asmcomp/riscv/CSE.ml +@@ -0,0 +1,36 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2106 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* CSE for the RISC-V *) ++ ++open Arch ++open Mach ++open CSEgen ++ ++class cse = object (_self) ++ ++inherit cse_generic as super ++ ++method! class_of_operation op = ++ match op with ++ | Ispecific(Imultaddf _ | Imultsubf _) -> Op_pure ++ | _ -> super#class_of_operation op ++ ++method! is_cheap_operation op = ++ match op with ++ | Iconst_int n -> n <= 0x7FFn && n >= -0x800n ++ | _ -> false ++ ++end ++ ++let fundecl f = ++ (new cse)#fundecl f +diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml +new file mode 100644 +index 000000000..61a38b1dd +--- /dev/null ++++ b/asmcomp/riscv/arch.ml +@@ -0,0 +1,84 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Specific operations for the RISC-V processor *) ++ ++open Format ++ ++(* Machine-specific command-line options *) ++ ++let command_line_options = [] ++ ++(* Specific operations *) ++ ++type specific_operation = ++ | Imultaddf of bool (* multiply, optionally negate, and add *) ++ | Imultsubf of bool (* multiply, optionally negate, and subtract *) ++ ++let spacetime_node_hole_pointer_is_live_before = function ++ | Imultaddf _ | Imultsubf _ -> false ++ ++(* Addressing modes *) ++ ++type addressing_mode = ++ | Iindexed of int (* reg + displ *) ++ ++(* Sizes, endianness *) ++ ++let big_endian = false ++ ++let rv64 = ++ match Config.model with "riscv64" -> true | "riscv32" -> false | _ -> assert false ++ ++let size_addr = if rv64 then 8 else 4 ++let size_int = size_addr ++let size_float = 8 ++ ++let allow_unaligned_access = false ++ ++(* Behavior of division *) ++ ++let division_crashes_on_overflow = false ++ ++(* Operations on addressing modes *) ++ ++let identity_addressing = Iindexed 0 ++ ++let offset_addressing addr delta = ++ match addr with ++ | Iindexed n -> Iindexed(n + delta) ++ ++let num_args_addressing = function ++ | Iindexed _ -> 1 ++ ++(* Printing operations and addressing modes *) ++ ++let print_addressing printreg addr ppf arg = ++ match addr with ++ | Iindexed n -> ++ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in ++ fprintf ppf "%a%s" printreg arg.(0) idx ++ ++let print_specific_operation printreg op ppf arg = ++ match op with ++ | Imultaddf false -> ++ fprintf ppf "%a *f %a +f %a" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Imultaddf true -> ++ fprintf ppf "-f (%a *f %a +f %a)" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Imultsubf false -> ++ fprintf ppf "%a *f %a -f %a" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Imultsubf true -> ++ fprintf ppf "-f (%a *f %a -f %a)" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) +diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp +new file mode 100644 +index 000000000..6d0e3aefd +--- /dev/null ++++ b/asmcomp/riscv/emit.mlp +@@ -0,0 +1,616 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Emission of RISC-V assembly code *) ++ ++open Misc ++open Cmm ++open Arch ++open Proc ++open Reg ++open Mach ++open Linearize ++open Emitaux ++ ++(* Layout of the stack. The stack is kept 16-aligned. *) ++ ++let stack_offset = ref 0 ++ ++let frame_size () = ++ let size = ++ !stack_offset + (* Trap frame, outgoing parameters *) ++ size_int * num_stack_slots.(0) + (* Local int variables *) ++ size_float * num_stack_slots.(1) + (* Local float variables *) ++ (if !contains_calls then size_addr else 0) in (* The return address *) ++ Misc.align size 16 ++ ++let slot_offset loc cls = ++ match loc with ++ | Local n -> ++ if cls = 0 ++ then !stack_offset + num_stack_slots.(1) * size_float + n * size_int ++ else !stack_offset + n * size_float ++ | Incoming n -> frame_size() + n ++ | Outgoing n -> n ++ ++(* Output a symbol *) ++ ++let emit_symbol s = ++ Emitaux.emit_symbol '.' s ++ ++(* Output a label *) ++ ++let label_prefix = "L" ++ ++let emit_label lbl = ++ emit_string label_prefix; emit_int lbl ++ ++(* Section switching *) ++ ++let data_space = ++ ".section .data" ++ ++let code_space = ++ ".section .text" ++ ++let rodata_space = ++ ".section .rodata" ++ ++let reg_tmp1 = phys_reg 21 (* used by the assembler *) ++let reg_tmp2 = phys_reg 22 ++let reg_t2 = phys_reg 16 ++(* let reg_fp = phys_reg 23 *) ++let reg_trap = phys_reg 24 ++let reg_alloc_ptr = phys_reg 25 ++let reg_alloc_lim = phys_reg 26 ++ ++(* Names of instructions that differ in 32 and 64-bit modes *) ++ ++let lg = if rv64 then "ld" else "lw" ++let stg = if rv64 then "sd" else "sw" ++let datag = if rv64 then ".quad" else ".long" ++ ++(* Output a pseudo-register *) ++ ++let emit_reg = function ++ | {loc = Reg r} -> emit_string (register_name r) ++ | _ -> fatal_error "Emit.emit_reg" ++ ++(* Output a stack reference *) ++ ++let emit_stack r = ++ match r.loc with ++ Stack s -> ++ let ofs = slot_offset s (register_class r) in `{emit_int ofs}(sp)` ++ | _ -> fatal_error "Emit.emit_stack" ++ ++(* Record live pointers at call points *) ++ ++let record_frame_label ?label live raise_ dbg = ++ let lbl = ++ match label with ++ | None -> new_label() ++ | Some label -> label ++ in ++ let live_offset = ref [] in ++ Reg.Set.iter ++ (function ++ {typ = Val; loc = Reg r} -> ++ live_offset := (r lsl 1) + 1 :: !live_offset ++ | {typ = Val; loc = Stack s} as reg -> ++ live_offset := slot_offset s (register_class reg) :: !live_offset ++ | {typ = Addr} as r -> ++ Misc.fatal_error ("bad GC root " ^ Reg.name r) ++ | _ -> () ++ ) ++ live; ++ frame_descriptors := ++ { fd_lbl = lbl; ++ fd_frame_size = frame_size(); ++ fd_live_offset = !live_offset; ++ fd_raise = raise_; ++ fd_debuginfo = dbg } :: !frame_descriptors; ++ lbl ++ ++let record_frame ?label live raise_ dbg = ++ let lbl = record_frame_label ?label live raise_ dbg in ++ `{emit_label lbl}:\n` ++ ++(* Record calls to the GC -- we've moved them out of the way *) ++ ++type gc_call = ++ { gc_lbl: label; (* Entry label *) ++ gc_return_lbl: label; (* Where to branch after GC *) ++ gc_frame_lbl: label } (* Label of frame descriptor *) ++ ++let call_gc_sites = ref ([] : gc_call list) ++ ++let emit_call_gc gc = ++ `{emit_label gc.gc_lbl}:\n`; ++ ` call {emit_symbol "caml_call_gc"}\n`; ++ `{emit_label gc.gc_frame_lbl}:\n`; ++ ` j {emit_label gc.gc_return_lbl}\n` ++ ++(* Record calls to caml_ml_array_bound_error. ++ In debug mode, we maintain one call to caml_ml_array_bound_error ++ per bound check site. Otherwise, we can share a single call. *) ++ ++type bound_error_call = ++ { bd_lbl: label; (* Entry label *) ++ bd_frame_lbl: label } (* Label of frame descriptor *) ++ ++let bound_error_sites = ref ([] : bound_error_call list) ++ ++let bound_error_label ?label dbg = ++ if !Clflags.debug || !bound_error_sites = [] then begin ++ let lbl_bound_error = new_label() in ++ let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in ++ bound_error_sites := ++ { bd_lbl = lbl_bound_error; ++ bd_frame_lbl = lbl_frame } :: !bound_error_sites; ++ lbl_bound_error ++ end else ++ let bd = List.hd !bound_error_sites in ++ bd.bd_lbl ++ ++let emit_call_bound_error bd = ++ `{emit_label bd.bd_lbl}:\n`; ++ ` call {emit_symbol "caml_ml_array_bound_error"}\n`; ++ `{emit_label bd.bd_frame_lbl}:\n` ++ ++(* Record floating-point literals *) ++ ++let float_literals = ref ([] : (int64 * int) list) ++ ++(* Names for various instructions *) ++ ++let name_for_intop = function ++ | Iadd -> "add" ++ | Isub -> "sub" ++ | Imul -> "mul" ++ | Imulh -> "mulh" ++ | Idiv -> "div" ++ | Iand -> "and" ++ | Ior -> "or" ++ | Ixor -> "xor" ++ | Ilsl -> "sll" ++ | Ilsr -> "srl" ++ | Iasr -> "sra" ++ | Imod -> "rem" ++ | _ -> fatal_error "Emit.Intop" ++ ++let name_for_intop_imm = function ++ | Iadd -> "addi" ++ | Iand -> "andi" ++ | Ior -> "ori" ++ | Ixor -> "xori" ++ | Ilsl -> "slli" ++ | Ilsr -> "srli" ++ | Iasr -> "srai" ++ | _ -> fatal_error "Emit.Intop_imm" ++ ++let name_for_floatop1 = function ++ | Inegf -> "fneg.d" ++ | Iabsf -> "fabs.d" ++ | _ -> fatal_error "Emit.Iopf1" ++ ++let name_for_floatop2 = function ++ | Iaddf -> "fadd.d" ++ | Isubf -> "fsub.d" ++ | Imulf -> "fmul.d" ++ | Idivf -> "fdiv.d" ++ | _ -> fatal_error "Emit.Iopf2" ++ ++let name_for_specific = function ++ | Imultaddf false -> "fmadd.d" ++ | Imultaddf true -> "fnmadd.d" ++ | Imultsubf false -> "fmsub.d" ++ | Imultsubf true -> "fnmsub.d" ++ ++(* Name of current function *) ++let function_name = ref "" ++(* Entry point for tail recursive calls *) ++let tailrec_entry_point = ref 0 ++ ++(* Output the assembly code for an instruction *) ++ ++let emit_instr i = ++ match i.desc with ++ Lend -> () ++ | Lop(Imove | Ispill | Ireload) -> ++ let src = i.arg.(0) and dst = i.res.(0) in ++ if src.loc <> dst.loc then begin ++ match (src, dst) with ++ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Reg _} -> ++ ` mv {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} -> ++ ` fmv.d {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} -> ++ ` {emit_string stg} {emit_reg src}, {emit_stack dst}\n` ++ | {loc = Reg _; typ = Float}, {loc = Stack _} -> ++ ` fsd {emit_reg src}, {emit_stack dst}\n` ++ | {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _ } -> ++ ` {emit_string lg} {emit_reg dst}, {emit_stack src}\n` ++ | {loc = Stack _; typ = Float}, {loc = Reg _} -> ++ ` fld {emit_reg dst}, {emit_stack src}\n` ++ | _ -> ++ fatal_error "Emit: Imove" ++ end ++ | Lop(Iconst_int n) -> ++ ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n` ++ | Lop(Iconst_float f) -> ++ let lbl = new_label() in ++ float_literals := (f, lbl) :: !float_literals; ++ ` fld {emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp1}\n` ++ | Lop(Iconst_symbol s) -> ++ ` la {emit_reg i.res.(0)}, {emit_symbol s}\n` ++ | Lop(Icall_ind {label_after = label}) -> ++ ` jalr {emit_reg i.arg.(0)}\n`; ++ record_frame ~label i.live false i.dbg ++ | Lop(Icall_imm {func; label_after = label}) -> ++ ` call {emit_symbol func}\n`; ++ record_frame ~label i.live false i.dbg ++ | Lop(Itailcall_ind {label_after = _}) -> ++ let n = frame_size() in ++ if !contains_calls then ++ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`; ++ if n > 0 then ++ ` addi sp, sp, {emit_int n}\n`; ++ ` jr {emit_reg i.arg.(0)}\n` ++ | Lop(Itailcall_imm {func; label_after = _}) -> ++ if func = !function_name then begin ++ ` j {emit_label !tailrec_entry_point}\n` ++ end else begin ++ let n = frame_size() in ++ if !contains_calls then ++ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`; ++ if n > 0 then ++ ` addi sp, sp, {emit_int n}\n`; ++ ` tail {emit_symbol func}\n` ++ end ++ | Lop(Iextcall{func; alloc = true; label_after = label}) -> ++ ` la {emit_reg reg_t2}, {emit_symbol func}\n`; ++ ` call {emit_symbol "caml_c_call"}\n`; ++ record_frame ~label i.live false i.dbg ++ | Lop(Iextcall{func; alloc = false; label_after = _}) -> ++ ` call {emit_symbol func}\n` ++ | Lop(Istackoffset n) -> ++ assert (n mod 16 = 0); ++ ` addi sp, sp, {emit_int (-n)}\n`; ++ stack_offset := !stack_offset + n ++ | Lop(Iload(Single, Iindexed ofs)) -> ++ ` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`; ++ ` fcvt.d.s {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Lop(Iload(chunk, Iindexed ofs)) -> ++ let instr = ++ match chunk with ++ | Byte_unsigned -> "lbu" ++ | Byte_signed -> "lb" ++ | Sixteen_unsigned -> "lhu" ++ | Sixteen_signed -> "lh" ++ | Thirtytwo_unsigned -> if rv64 then "lwu" else "lw" ++ | Thirtytwo_signed -> "lw" ++ | Word_int | Word_val -> lg ++ | Single -> assert false ++ | Double | Double_u -> "fld" ++ in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n` ++ | Lop(Istore(Single, Iindexed ofs, _)) -> ++ ` fmv.x.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}\n`; ++ ` fcvt.s.d {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}\n`; ++ ` fsw {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`; ++ ` fmv.d.x {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}\n` ++ | Lop(Istore(chunk, Iindexed ofs, _)) -> ++ let instr = ++ match chunk with ++ | Byte_unsigned | Byte_signed -> "sb" ++ | Sixteen_unsigned | Sixteen_signed -> "sh" ++ | Thirtytwo_unsigned | Thirtytwo_signed -> "sw" ++ | Word_int | Word_val -> stg ++ | Single -> assert false ++ | Double | Double_u -> "fsd" ++ in ++ ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n` ++ | Lop(Ialloc {words = n; label_after_call_gc = label; _}) -> ++ let lbl_frame_lbl = record_frame_label ?label i.live false i.dbg in ++ let lbl_redo = new_label () in ++ let lbl_call_gc = new_label () in ++ `{emit_label lbl_redo}:\n`; ++ ` addi {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, -{emit_int n}\n`; ++ ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`; ++ ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_lim}, {emit_label lbl_call_gc}\n`; ++ call_gc_sites := ++ { gc_lbl = lbl_call_gc; ++ gc_return_lbl = lbl_redo; ++ gc_frame_lbl = lbl_frame_lbl } :: !call_gc_sites ++ | Lop(Iintop(Icomp cmp)) -> ++ begin match cmp with ++ | Isigned Clt -> ++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Isigned Cge -> ++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; ++ | Isigned Cgt -> ++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` ++ | Isigned Cle -> ++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; ++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; ++ | Isigned Ceq | Iunsigned Ceq -> ++ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` seqz {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Isigned Cne | Iunsigned Cne -> ++ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` snez {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Iunsigned Clt -> ++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Iunsigned Cge -> ++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; ++ | Iunsigned Cgt -> ++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` ++ | Iunsigned Cle -> ++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; ++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; ++ end ++ | Lop(Iintop (Icheckbound {label_after_error = label; _})) -> ++ let lbl = bound_error_label ?label i.dbg in ++ ` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n` ++ | Lop(Iintop op) -> ++ let instr = name_for_intop op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Lop(Iintop_imm(Isub, n)) -> ++ ` addi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n` ++ | Lop(Iintop_imm(Icomp _, _)) -> ++ fatal_error "Emit.emit_instr (Iintop_imm (Icomp _, _))" ++ | Lop(Iintop_imm(Icheckbound {label_after_error = label; _}, n)) -> ++ let lbl = bound_error_label ?label i.dbg in ++ ` li {emit_reg reg_tmp1}, {emit_int n}\n`; ++ ` bleu {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ | Lop(Iintop_imm(op, n)) -> ++ let instr = name_for_intop_imm op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n` ++ | Lop(Inegf | Iabsf as op) -> ++ let instr = name_for_floatop1 op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iaddf | Isubf | Imulf | Idivf as op) -> ++ let instr = name_for_floatop2 op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Lop(Ifloatofint) -> ++ let name = if rv64 then "fcvt.d.l" else "fcvt.d.w" in ++ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iintoffloat) -> ++ let name = if rv64 then "fcvt.l.d" else "fcvt.w.d" in ++ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Ispecific sop) -> ++ let instr = name_for_specific sop in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n` ++ | Lreloadretaddr -> ++ let n = frame_size () in ++ ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n` ++ | Lreturn -> ++ let n = frame_size() in ++ if n > 0 then ++ ` addi sp, sp, {emit_int n}\n`; ++ ` ret\n` ++ | Llabel lbl -> ++ `{emit_label lbl}:\n` ++ | Lbranch lbl -> ++ ` j {emit_label lbl}\n` ++ | Lcondbranch(tst, lbl) -> ++ begin match tst with ++ | Itruetest -> ++ ` bnez {emit_reg i.arg.(0)}, {emit_label lbl}\n` ++ | Ifalsetest -> ++ ` beqz {emit_reg i.arg.(0)}, {emit_label lbl}\n` ++ | Iinttest cmp -> ++ let name = match cmp with ++ | Iunsigned Ceq | Isigned Ceq -> "beq" ++ | Iunsigned Cne | Isigned Cne -> "bne" ++ | Iunsigned Cle -> "bleu" | Isigned Cle -> "ble" ++ | Iunsigned Cge -> "bgeu" | Isigned Cge -> "bge" ++ | Iunsigned Clt -> "bltu" | Isigned Clt -> "blt" ++ | Iunsigned Cgt -> "bgtu" | Isigned Cgt -> "bgt" ++ in ++ ` {emit_string name} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n` ++ | Iinttest_imm _ -> ++ fatal_error "Emit.emit_instr (Iinttest_imm _)" ++ | Ifloattest(cmp, neg) -> ++ let neg = match cmp with ++ | Ceq -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; neg ++ | Cne -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; not neg ++ | Clt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; neg ++ | Cgt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; neg ++ | Cle -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; neg ++ | Cge -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; neg ++ in ++ if neg then ++ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ else ++ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ | Ioddtest -> ++ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`; ++ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ | Ieventest -> ++ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`; ++ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ end ++ | Lcondbranch3(lbl0, lbl1, lbl2) -> ++ ` addi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, -1\n`; ++ begin match lbl0 with ++ | None -> () ++ | Some lbl -> ` bltz {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ end; ++ begin match lbl1 with ++ | None -> () ++ | Some lbl -> ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ end; ++ begin match lbl2 with ++ | None -> () ++ | Some lbl -> ` bgtz {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ end ++ | Lswitch jumptbl -> (* FIXME FIXME ? *) ++ let lbl = new_label() in ++ ` la {emit_reg reg_tmp1}, {emit_label lbl}\n`; ++ ` slli {emit_reg reg_tmp2}, {emit_reg i.arg.(0)}, 2\n`; ++ ` add {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_reg reg_tmp2}\n`; ++ ` jr {emit_reg reg_tmp1}\n`; ++ `{emit_label lbl}:\n`; ++ for i = 0 to Array.length jumptbl - 1 do ++ ` j {emit_label jumptbl.(i)}\n` ++ done ++ | Lsetuptrap lbl -> ++ ` addi sp, sp, -16\n`; ++ ` jal {emit_label lbl}\n` ++ | Lpushtrap -> ++ stack_offset := !stack_offset + 16; ++ ` {emit_string stg} ra, {emit_int size_addr}(sp)\n`; ++ ` {emit_string stg} {emit_reg reg_trap}, 0(sp)\n`; ++ ` mv {emit_reg reg_trap}, sp\n` ++ | Lpoptrap -> ++ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`; ++ ` addi sp, sp, 16\n`; ++ stack_offset := !stack_offset - 16 ++ | Lraise k -> ++ begin match !Clflags.debug, k with ++ | true, Cmm.Raise_withtrace -> ++ ` call {emit_symbol "caml_raise_exn"}\n`; ++ record_frame Reg.Set.empty true i.dbg ++ | false, _ ++ | true, Cmm.Raise_notrace -> ++ ` mv sp, {emit_reg reg_trap}\n`; ++ ` {emit_string lg} {emit_reg reg_tmp1}, {emit_int size_addr}(sp)\n`; ++ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`; ++ ` addi sp, sp, 16\n`; ++ ` jalr {emit_reg reg_tmp1}\n` ++ end ++ ++(* Emit a sequence of instructions *) ++ ++let rec emit_all = function ++ | {desc = Lend} -> () | i -> emit_instr i; emit_all i.next ++ ++(* Emission of a function declaration *) ++ ++let fundecl fundecl = ++ function_name := fundecl.fun_name; ++ tailrec_entry_point := new_label(); ++ stack_offset := 0; ++ call_gc_sites := []; ++ bound_error_sites := []; ++ float_literals := []; ++ ` .globl {emit_symbol fundecl.fun_name}\n`; ++ ` .type {emit_symbol fundecl.fun_name}, @function\n`; ++ ` {emit_string code_space}\n`; ++ ` .align 2\n`; ++ `{emit_symbol fundecl.fun_name}:\n`; ++ let n = frame_size() in ++ if n > 0 then ++ ` addi sp, sp, {emit_int(-n)}\n`; ++ if !contains_calls then ++ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`; ++ `{emit_label !tailrec_entry_point}:\n`; ++ emit_all fundecl.fun_body; ++ List.iter emit_call_gc !call_gc_sites; ++ List.iter emit_call_bound_error !bound_error_sites; ++ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`; ++ (* Emit the float literals *) ++ if !float_literals <> [] then begin ++ ` {emit_string rodata_space}\n`; ++ ` .align 3\n`; ++ List.iter ++ (fun (f, lbl) -> ++ `{emit_label lbl}:\n`; ++ if rv64 ++ then emit_float64_directive ".quad" f ++ else emit_float64_split_directive ".long" f) ++ !float_literals; ++ end ++ ++(* Emission of data *) ++ ++let declare_global_data s = ++ ` .globl {emit_symbol s}\n`; ++ ` .type {emit_symbol s}, @object\n` ++ ++let emit_item = function ++ | Cglobal_symbol s -> ++ declare_global_data s ++ | Cdefine_symbol s -> ++ `{emit_symbol s}:\n`; ++ | Cint8 n -> ++ ` .byte {emit_int n}\n` ++ | Cint16 n -> ++ ` .short {emit_int n}\n` ++ | Cint32 n -> ++ ` .long {emit_nativeint n}\n` ++ | Cint n -> ++ ` {emit_string datag} {emit_nativeint n}\n` ++ | Csingle f -> ++ emit_float32_directive ".long" (Int32.bits_of_float f) ++ | Cdouble f -> ++ if rv64 ++ then emit_float64_directive ".quad" (Int64.bits_of_float f) ++ else emit_float64_split_directive ".long" (Int64.bits_of_float f) ++ | Csymbol_address s -> ++ ` {emit_string datag} {emit_symbol s}\n` ++ | Cstring s -> ++ emit_bytes_directive " .byte " s ++ | Cskip n -> ++ if n > 0 then ` .space {emit_int n}\n` ++ | Calign n -> ++ ` .align {emit_int (Misc.log2 n)}\n` ++ ++let data l = ++ ` {emit_string data_space}\n`; ++ List.iter emit_item l ++ ++(* Beginning / end of an assembly file *) ++ ++let begin_assembly() = ++ (* Emit the beginning of the segments *) ++ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in ++ ` {emit_string data_space}\n`; ++ declare_global_data lbl_begin; ++ `{emit_symbol lbl_begin}:\n`; ++ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in ++ ` {emit_string code_space}\n`; ++ declare_global_data lbl_begin; ++ `{emit_symbol lbl_begin}:\n` ++ ++let end_assembly() = ++ ` {emit_string code_space}\n`; ++ let lbl_end = Compilenv.make_symbol (Some "code_end") in ++ declare_global_data lbl_end; ++ `{emit_symbol lbl_end}:\n`; ++ ` .long 0\n`; ++ ` {emit_string data_space}\n`; ++ let lbl_end = Compilenv.make_symbol (Some "data_end") in ++ declare_global_data lbl_end; ++ `{emit_symbol lbl_end}:\n`; ++ ` {emit_string datag} 0\n`; ++ (* Emit the frame descriptors *) ++ ` {emit_string rodata_space}\n`; ++ let lbl = Compilenv.make_symbol (Some "frametable") in ++ declare_global_data lbl; ++ `{emit_symbol lbl}:\n`; ++ emit_frames ++ { efa_code_label = (fun l -> ` {emit_string datag} {emit_label l}\n`); ++ efa_data_label = (fun l -> ` {emit_string datag} {emit_label l}\n`); ++ efa_16 = (fun n -> ` .short {emit_int n}\n`); ++ efa_32 = (fun n -> ` .long {emit_int32 n}\n`); ++ efa_word = (fun n -> ` {emit_string datag} {emit_int n}\n`); ++ efa_align = (fun n -> ` .align {emit_int (Misc.log2 n)}\n`); ++ efa_label_rel = (fun lbl ofs -> ++ ` .long ({emit_label lbl} - .) + {emit_int32 ofs}\n`); ++ efa_def_label = (fun l -> `{emit_label l}:\n`); ++ efa_string = (fun s -> emit_bytes_directive " .byte " (s ^ "\000")) ++ } +diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml +new file mode 100644 +index 000000000..c0b0dcdb8 +--- /dev/null ++++ b/asmcomp/riscv/proc.ml +@@ -0,0 +1,301 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Description of the RISC-V *) ++ ++open Misc ++open Cmm ++open Reg ++open Arch ++open Mach ++ ++(* Instruction selection *) ++ ++let word_addressed = false ++ ++(* Registers available for register allocation *) ++ ++(* Integer register map: ++ zero always zero ++ ra return address ++ sp, gp, tp stack pointer, global pointer, thread pointer (preserved by C) ++ a0 - a7 0 - 7 arguments/results ++ s2 - s9 8 - 15 arguments/results (preserved by C) ++ t2 - t6 16 - 20 temporary ++ t0 21 temporary (used by assembler) ++ t1 22 temporary (reserved for code gen) ++ s0 23 frame pointer (preserved by C) ++ s1 24 trap pointer (preserved by C) ++ s10 25 allocation pointer (preserved by C) ++ s11 26 allocation limit (preserved by C) ++ Floating-point register map: ++ ft0 - ft7 100 - 107 temporary ++ fs0 - fs1 108 - 109 general purpose (preserved by C) ++ fa0 - fa7 110 - 117 arguments/results ++ fs2 - fs9 118 - 125 arguments/results (preserved by C) ++ fs10 - fs11 126 - 127 general purpose (preserved by C) ++ ft8 - ft11 128 - 131 temporary ++*) ++ ++let int_reg_name = ++ [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6"; "a7"; ++ "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "s8"; "s9"; ++ "t2"; "t3"; "t4"; "t5"; "t6"; ++ "t0"; "t1"; ++ "s0"; "s1"; "s10"; "s11" |] ++ ++let float_reg_name = ++ [| "ft0"; "ft1"; "ft2"; "ft3"; "ft4"; "ft5"; "ft6"; "ft7"; ++ "fs0"; "fs1"; ++ "fa0"; "fa1"; "fa2"; "fa3"; "fa4"; "fa5"; "fa6"; "fa7"; ++ "fs2"; "fs3"; "fs4"; "fs5"; "fs6"; "fs7"; "fs8"; "fs9"; "fs10"; "fs11"; ++ "ft8"; "ft9"; "ft10"; "ft11" |] ++ ++let num_register_classes = 2 ++ ++let register_class r = ++ match r.typ with ++ | Val | Int | Addr -> 0 ++ | Float -> 1 ++ ++let num_available_registers = [| 21; 32 |] ++ ++let first_available_register = [| 0; 100 |] ++ ++let register_name r = ++ if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) ++ ++let rotate_registers = true ++ ++(* Representation of hard registers by pseudo-registers *) ++ ++let hard_int_reg = ++ let v = Array.make 27 Reg.dummy in ++ for i = 0 to 26 do ++ v.(i) <- Reg.at_location Int (Reg i) ++ done; ++ v ++ ++let hard_float_reg = ++ let v = Array.make 32 Reg.dummy in ++ for i = 0 to 31 do ++ v.(i) <- Reg.at_location Float (Reg(100 + i)) ++ done; ++ v ++ ++let all_phys_regs = ++ Array.append hard_int_reg hard_float_reg ++ ++let phys_reg n = ++ if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) ++ ++let stack_slot slot ty = ++ Reg.at_location ty (Stack slot) ++ ++(* Calling conventions *) ++ ++let calling_conventions ++ first_int last_int first_float last_float make_stack arg = ++ let loc = Array.make (Array.length arg) Reg.dummy in ++ let int = ref first_int in ++ let float = ref first_float in ++ let ofs = ref 0 in ++ for i = 0 to Array.length arg - 1 do ++ match arg.(i).typ with ++ | Val | Int | Addr as ty -> ++ if !int <= last_int then begin ++ loc.(i) <- phys_reg !int; ++ incr int ++ end else begin ++ loc.(i) <- stack_slot (make_stack !ofs) ty; ++ ofs := !ofs + size_int ++ end ++ | Float -> ++ if !float <= last_float then begin ++ loc.(i) <- phys_reg !float; ++ incr float ++ end else begin ++ loc.(i) <- stack_slot (make_stack !ofs) Float; ++ ofs := !ofs + size_float ++ end ++ done; ++ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *) ++ ++let incoming ofs = Incoming ofs ++let outgoing ofs = Outgoing ofs ++let not_supported _ = fatal_error "Proc.loc_results: cannot call" ++ ++let max_arguments_for_tailcalls = 16 ++ ++let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *) ++ ++(* OCaml calling convention: ++ first integer args in a0 .. a7, s2 .. s9 ++ first float args in fa0 .. fa7, fs2 .. fs9 ++ remaining args on stack. ++ Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *) ++ ++let single_regs arg = Array.map (fun arg -> [| arg |]) arg ++let ensure_single_regs res = ++ Array.map (function ++ | [| res |] -> res ++ | _ -> failwith "proc.ensure_single_regs" ++ ) res ++ ++let loc_arguments arg = ++ calling_conventions 0 15 110 125 outgoing arg ++ ++let loc_parameters arg = ++ let (loc, _ofs) = ++ calling_conventions 0 15 110 125 incoming arg ++ in ++ loc ++ ++let loc_results res = ++ let (loc, _ofs) = ++ calling_conventions 0 15 110 125 not_supported res ++ in ++ loc ++ ++(* C calling convention: ++ first integer args in a0 .. a7 ++ first float args in fa0 .. fa7 ++ remaining args on stack. ++ Return values in a0 .. a1 or fa0 .. fa1. *) ++ ++let external_calling_conventions ++ first_int last_int first_float last_float make_stack arg = ++ let loc = Array.make (Array.length arg) [| Reg.dummy |] in ++ let int = ref first_int in ++ let float = ref first_float in ++ let ofs = ref 0 in ++ for i = 0 to Array.length arg - 1 do ++ match arg.(i) with ++ | [| arg |] -> ++ begin match arg.typ with ++ | Val | Int | Addr as ty -> ++ if !int <= last_int then begin ++ loc.(i) <- [| phys_reg !int |]; ++ incr int; ++ incr float; ++ end else begin ++ loc.(i) <- [| stack_slot (make_stack !ofs) ty |]; ++ ofs := !ofs + size_int ++ end ++ | Float -> ++ if !float <= last_float then begin ++ loc.(i) <- [| phys_reg !float |]; ++ incr float; ++ incr int; ++ end else begin ++ loc.(i) <- [| stack_slot (make_stack !ofs) Float |]; ++ ofs := !ofs + size_float ++ end ++ end ++ | [| arg1; arg2 |] -> ++ (* Passing of 64-bit quantities to external functions on 32-bit ++ platform. *) ++ assert (size_int = 4); ++ begin match arg1.typ, arg2.typ with ++ | Int, Int -> ++ int := Misc.align !int 2; ++ if !int <= last_int - 1 then begin ++ let reg_lower = phys_reg !int in ++ let reg_upper = phys_reg (!int + 1) in ++ loc.(i) <- [| reg_lower; reg_upper |]; ++ int := !int + 2 ++ end else begin ++ let size_int64 = 8 in ++ ofs := Misc.align !ofs size_int64; ++ let ofs_lower = !ofs in ++ let ofs_upper = !ofs + size_int in ++ let stack_lower = stack_slot (make_stack ofs_lower) Int in ++ let stack_upper = stack_slot (make_stack ofs_upper) Int in ++ loc.(i) <- [| stack_lower; stack_upper |]; ++ ofs := !ofs + size_int64 ++ end ++ | _ -> ++ let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in ++ fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \ ++ type(s) for multi-register argument: %s, %s" ++ (f arg1.typ) (f arg2.typ)) ++ end ++ | _ -> ++ fatal_error "Proc.calling_conventions: bad number of register for \ ++ multi-register argument" ++ done; ++ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *) ++ ++let loc_external_arguments arg = ++ external_calling_conventions 0 7 110 117 outgoing arg ++ ++let loc_external_results res = ++ let (loc, _ofs) = ++ external_calling_conventions 0 1 110 111 not_supported (single_regs res) ++ in ++ ensure_single_regs loc ++ ++(* Exceptions are in GPR 3 *) ++ ++let loc_exn_bucket = phys_reg 0 ++ ++(* Volatile registers: none *) ++ ++let regs_are_volatile _ = false ++ ++(* Registers destroyed by operations *) ++ ++let destroyed_at_c_call = ++ Array.of_list(List.map phys_reg ++ [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; (* 21; 22; *) ++ 100; 101; 102; 103; 104; 105; 106; 107; 110; 111; 112; 113; 114; 115; 116; ++ 117; 128; 129; 130; 131]) ++ ++let destroyed_at_oper = function ++ | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs ++ | Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call ++ | _ -> [||] ++ ++let destroyed_at_raise = all_phys_regs ++ ++(* Maximal register pressure *) ++ ++let safe_register_pressure = function ++ | Iextcall _ -> 15 ++ | _ -> 21 ++ ++let max_register_pressure = function ++ | Iextcall _ -> [| 15; 18 |] ++ | _ -> [| 21; 30 |] ++ ++(* Pure operations (without any side effect besides updating their result ++ registers). *) ++ ++let op_is_pure = function ++ | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ ++ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ ++ | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false ++ | Ispecific(Imultaddf _ | Imultsubf _) -> true ++ | _ -> true ++ ++(* Layout of the stack *) ++ ++let num_stack_slots = [| 0; 0 |] ++let contains_calls = ref false ++ ++(* Calling the assembler *) ++ ++let assemble_file infile outfile = ++ Ccomp.command ++ (Config.asm ^ " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile) ++ ++let init () = () +diff --git a/asmcomp/riscv/reload.ml b/asmcomp/riscv/reload.ml +new file mode 100644 +index 000000000..85b970342 +--- /dev/null ++++ b/asmcomp/riscv/reload.ml +@@ -0,0 +1,16 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Reloading for the RISC-V *) ++ ++let fundecl f = ++ (new Reloadgen.reload_generic)#fundecl f +diff --git a/asmcomp/riscv/scheduling.ml b/asmcomp/riscv/scheduling.ml +new file mode 100644 +index 000000000..e436be1cc +--- /dev/null ++++ b/asmcomp/riscv/scheduling.ml +@@ -0,0 +1,19 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Instruction scheduling for the RISC-V *) ++ ++let _ = let module M = Schedgen in () (* to create a dependency *) ++ ++(* Scheduling is turned off. *) ++ ++let fundecl f = f +diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml +new file mode 100644 +index 000000000..60ec5cb4e +--- /dev/null ++++ b/asmcomp/riscv/selection.ml +@@ -0,0 +1,85 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Instruction selection for the RISC-V processor *) ++ ++open Cmm ++open Arch ++open Mach ++ ++(* Instruction selection *) ++ ++class selector = object (self) ++ ++inherit Selectgen.selector_generic as super ++ ++method is_immediate n = (n <= 0x7FF) && (n >= -0x800) ++ ++method select_addressing _ = function ++ | Cop(Cadda, [arg; Cconst_int n]) when self#is_immediate n -> ++ (Iindexed n, arg) ++ | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) when self#is_immediate n -> ++ (Iindexed n, Cop(Caddi, [arg1; arg2])) ++ | arg -> ++ (Iindexed 0, arg) ++ ++method! select_operation op args = ++ match (op, args) with ++ (* RISC-V does not support immediate operands for multiply high *) ++ | (Cmulhi, _) -> (Iintop Imulh, args) ++ (* The and, or and xor instructions have a different range of immediate ++ operands than the other instructions *) ++ | (Cand, _) -> self#select_logical Iand args ++ | (Cor, _) -> self#select_logical Ior args ++ | (Cxor, _) -> self#select_logical Ixor args ++ (* Recognize (neg-)mult-add and (neg-)mult-sub instructions *) ++ | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3]) ++ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) -> ++ (Ispecific (Imultaddf false), [arg1; arg2; arg3]) ++ | (Csubf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> ++ (Ispecific (Imultsubf false), [arg1; arg2; arg3]) ++ | (Cnegf, [Cop(Csubf, [Cop(Cmulf, [arg1; arg2]); arg3])]) -> ++ (Ispecific (Imultsubf true), [arg1; arg2; arg3]) ++ | (Cnegf, [Cop(Caddf, [Cop(Cmulf, [arg1; arg2]); arg3])]) -> ++ (Ispecific (Imultaddf true), [arg1; arg2; arg3]) ++ (* RISC-V does not support immediate operands for comparison operators *) ++ | (Ccmpi comp, args) -> (Iintop(Icomp (Isigned comp)), args) ++ | (Ccmpa comp, args) -> (Iintop(Icomp (Iunsigned comp)), args) ++ | (Cmuli, _) -> (Iintop Imul, args) ++ | _ -> ++ super#select_operation op args ++ ++method select_logical op = function ++ | [arg; Cconst_int n] when n >= 0 && n <= 0xFFF -> ++ (Iintop_imm(op, n), [arg]) ++ | [Cconst_int n; arg] when n >= 0 && n <= 0xFFF -> ++ (Iintop_imm(op, n), [arg]) ++ | args -> ++ (Iintop op, args) ++ ++(* Instruction selection for conditionals *) ++ ++method! select_condition = function ++ | Cop(Ccmpi cmp, args) -> ++ (Iinttest(Isigned cmp), Ctuple args) ++ | Cop(Ccmpa cmp, args) -> ++ (Iinttest(Iunsigned cmp), Ctuple args) ++ | Cop(Ccmpf cmp, args) -> ++ (Ifloattest(cmp, false), Ctuple args) ++ | Cop(Cand, [arg; Cconst_int 1]) -> ++ (Ioddtest, arg) ++ | arg -> ++ (Itruetest, arg) ++ ++end ++ ++let fundecl f = (new selector)#emit_fundecl f +diff --git a/asmrun/riscv.S b/asmrun/riscv.S +new file mode 100644 +index 000000000..a82048efc +--- /dev/null ++++ b/asmrun/riscv.S +@@ -0,0 +1,424 @@ ++/***********************************************************************/ ++/* */ ++/* OCaml */ ++/* */ ++/* Nicolas Ojeda Bar */ ++/* */ ++/* Copyright 1996 Institut National de Recherche en Informatique et */ ++/* en Automatique. All rights reserved. This file is distributed */ ++/* under the terms of the GNU Library General Public License, with */ ++/* the special exception on linking described in file ../LICENSE. */ ++/* */ ++/***********************************************************************/ ++ ++/* Asm part of the runtime system, RISC-V processor, 64-bit mode */ ++/* Must be preprocessed by cpp */ ++ ++#define TRAP_PTR s1 ++#define ALLOC_PTR s10 ++#define ALLOC_LIMIT s11 ++#define TMP0 t0 ++#define TMP1 t1 ++#define ARG t2 ++ ++#if defined(MODEL_riscv64) ++#define store sd ++#define load ld ++#define WSZ 8 ++#else ++#define store sw ++#define load lw ++#define WSZ 4 ++#endif ++ ++#if defined(__PIC__) ++ .option pic ++#else ++ .option nopic ++#endif ++ ++ .section .text ++/* Invoke the garbage collector. */ ++ ++ .globl caml_system__code_begin ++caml_system__code_begin: ++ ++ .align 2 ++ .globl caml_call_gc ++ .type caml_call_gc, @function ++caml_call_gc: ++ /* Record return address */ ++ store ra, caml_last_return_address, TMP0 ++ /* Record lowest stack address */ ++ mv TMP1, sp ++ store sp, caml_bottom_of_stack, TMP0 ++.Lcaml_call_gc: ++ /* Set up stack space, saving return address */ ++ /* (1 reg for RA, 1 reg for FP, 21 allocatable int regs, 20 caller-save float regs) * 8 */ ++ /* + 1 for alignment */ ++ addi sp, sp, -0x160 ++ mv s0, sp ++ store ra, 0x8(sp) ++ store s0, 0x0(sp) ++ /* Save allocatable integer registers on the stack, ++ in the order given in proc.ml */ ++ store a0, 0x10(sp) ++ store a1, 0x18(sp) ++ store a2, 0x20(sp) ++ store a3, 0x28(sp) ++ store a4, 0x30(sp) ++ store a5, 0x38(sp) ++ store a6, 0x40(sp) ++ store a7, 0x48(sp) ++ store s2, 0x50(sp) ++ store s3, 0x58(sp) ++ store s4, 0x60(sp) ++ store s5, 0x68(sp) ++ store s6, 0x70(sp) ++ store s7, 0x78(sp) ++ store s8, 0x80(sp) ++ store s9, 0x88(sp) ++ store t2, 0x90(sp) ++ store t3, 0x98(sp) ++ store t4, 0xa0(sp) ++ store t5, 0xa8(sp) ++ store t6, 0xb0(sp) ++ /* Save caller-save floating-point registers on the stack ++ (callee-saves are preserved by caml_garbage_collection) */ ++ fsd ft0, 0xb8(sp) ++ fsd ft1, 0xc0(sp) ++ fsd ft2, 0xc8(sp) ++ fsd ft3, 0xd0(sp) ++ fsd ft4, 0xd8(sp) ++ fsd ft5, 0xe0(sp) ++ fsd ft6, 0xe8(sp) ++ fsd ft7, 0xf0(sp) ++ fsd fa0, 0xf8(sp) ++ fsd fa1, 0x100(sp) ++ fsd fa2, 0x108(sp) ++ fsd fa3, 0x110(sp) ++ fsd fa4, 0x118(sp) ++ fsd fa5, 0x120(sp) ++ fsd fa6, 0x128(sp) ++ fsd fa7, 0x130(sp) ++ fsd ft8, 0x138(sp) ++ fsd ft9, 0x140(sp) ++ fsd ft9, 0x148(sp) ++ fsd ft10, 0x150(sp) ++ fsd ft11, 0x158(sp) ++ /* Store pointer to saved integer registers in caml_gc_regs */ ++ addi TMP1, sp, 16 ++ store TMP1, caml_gc_regs, TMP0 ++ /* Save current allocation pointer for debugging purposes */ ++ store ALLOC_PTR, caml_young_ptr, TMP0 ++ /* Save trap pointer in case an exception is raised during GC */ ++ store TRAP_PTR, caml_exception_pointer, TMP0 ++ /* Call the garbage collector */ ++ call caml_garbage_collection ++ /* Restore registers */ ++ load a0, 0x10(sp) ++ load a1, 0x18(sp) ++ load a2, 0x20(sp) ++ load a3, 0x28(sp) ++ load a4, 0x30(sp) ++ load a5, 0x38(sp) ++ load a6, 0x40(sp) ++ load a7, 0x48(sp) ++ load s2, 0x50(sp) ++ load s3, 0x58(sp) ++ load s4, 0x60(sp) ++ load s5, 0x68(sp) ++ load s6, 0x70(sp) ++ load s7, 0x78(sp) ++ load s8, 0x80(sp) ++ load s9, 0x88(sp) ++ load t2, 0x90(sp) ++ load t3, 0x98(sp) ++ load t4, 0xa0(sp) ++ load t5, 0xa8(sp) ++ load t6, 0xb0(sp) ++ fld ft0, 0xb8(sp) ++ fld ft1, 0xc0(sp) ++ fld ft2, 0xc8(sp) ++ fld ft3, 0xd0(sp) ++ fld ft4, 0xd8(sp) ++ fld ft5, 0xe0(sp) ++ fld ft6, 0xe8(sp) ++ fld ft7, 0xf0(sp) ++ fld fa0, 0xf8(sp) ++ fld fa1, 0x100(sp) ++ fld fa2, 0x108(sp) ++ fld fa3, 0x110(sp) ++ fld fa4, 0x118(sp) ++ fld fa5, 0x120(sp) ++ fld fa6, 0x128(sp) ++ fld fa7, 0x130(sp) ++ fld ft8, 0x138(sp) ++ fld ft9, 0x140(sp) ++ fld ft9, 0x148(sp) ++ fld ft10, 0x150(sp) ++ fld ft11, 0x158(sp) ++ /* Reload new allocation pointer and allocation limit */ ++ load ALLOC_PTR, caml_young_ptr ++ load ALLOC_LIMIT, caml_young_limit ++ /* Free stack space and return to caller */ ++ load ra, 0x8(sp) ++ load s0, 0x0(sp) ++ addi sp, sp, 0x160 ++ ret ++ .size caml_call_gc, .-caml_call_gc ++ ++/* Call a C function from OCaml */ ++/* Function to call is in ARG */ ++ ++ .align 2 ++ .globl caml_c_call ++ .type caml_c_call, @function ++caml_c_call: ++ /* Preserve return address in callee-save register s2 */ ++ mv s2, ra ++ /* Record lowest stack address and return address */ ++ store ra, caml_last_return_address, TMP0 ++ store sp, caml_bottom_of_stack, TMP0 ++ /* Make the exception handler alloc ptr available to the C code */ ++ store ALLOC_PTR, caml_young_ptr, TMP0 ++ store TRAP_PTR, caml_exception_pointer, TMP0 ++ /* Call the function */ ++ jalr ARG ++ /* Reload alloc ptr and alloc limit */ ++ load ALLOC_PTR, caml_young_ptr ++ load TRAP_PTR, caml_exception_pointer ++ /* Return */ ++ jr s2 ++ .size caml_c_call, .-caml_c_call ++ ++/* Raise an exception from OCaml */ ++ .align 2 ++ .globl caml_raise_exn ++ .type caml_raise_exn, @function ++caml_raise_exn: ++ /* Test if backtrace is active */ ++ load TMP1, caml_backtrace_active ++ bnez TMP1, 2f ++1: /* Cut stack at current trap handler */ ++ mv sp, TRAP_PTR ++ /* Pop previous handler and jump to it */ ++ load TMP1, 8(sp) ++ load TRAP_PTR, 0(sp) ++ addi sp, sp, 16 ++ jr TMP1 ++2: /* Preserve exception bucket in callee-save register s2 */ ++ mv s2, a0 ++ /* Stash the backtrace */ ++ mv a1, ra ++ mv a2, sp ++ mv a3, TRAP_PTR ++ call caml_stash_backtrace ++ /* Restore exception bucket and raise */ ++ mv a0, s2 ++ j 1b ++ .size caml_raise_exn, .-caml_raise_exn ++ ++ .globl caml_reraise_exn ++ .type caml_reraise_exn, @function ++ ++/* Raise an exception from C */ ++ ++ .align 2 ++ .globl caml_raise_exception ++ .type caml_raise_exception, @function ++caml_raise_exception: ++ load TRAP_PTR, caml_exception_pointer ++ load ALLOC_PTR, caml_young_ptr ++ load ALLOC_LIMIT, caml_young_limit ++ load TMP1, caml_backtrace_active ++ bnez TMP1, 2f ++1: /* Cut stack at current trap handler */ ++ mv sp, TRAP_PTR ++ load TMP1, 8(sp) ++ load TRAP_PTR, 0(sp) ++ addi sp, sp, 16 ++ jr TMP1 ++2: /* Preserve exception bucket in callee-save register s2 */ ++ mv s2, a0 ++ load a1, caml_last_return_address ++ load a2, caml_bottom_of_stack ++ mv a3, TRAP_PTR ++ call caml_stash_backtrace ++ mv a0, s2 ++ j 1b ++ .size caml_raise_exception, .-caml_raise_exception ++ ++/* Start the OCaml program */ ++ ++ .align 2 ++ .globl caml_start_program ++ .type caml_start_program, @function ++caml_start_program: ++ ++ la ARG, caml_program ++ /* Code shared with caml_callback* */ ++ /* Address of OCaml code to call is in ARG */ ++ /* Arguments to the OCaml code are in a0 ... a7 */ ++.Ljump_to_caml: ++ /* Set up stack frame and save callee-save registers */ ++ addi sp, sp, -0xd0 ++ store ra, 0xc0(sp) ++ store s0, 0x0(sp) ++ store s1, 0x8(sp) ++ store s2, 0x10(sp) ++ store s3, 0x18(sp) ++ store s4, 0x20(sp) ++ store s5, 0x28(sp) ++ store s6, 0x30(sp) ++ store s7, 0x38(sp) ++ store s8, 0x40(sp) ++ store s9, 0x48(sp) ++ store s10, 0x50(sp) ++ store s11, 0x58(sp) ++ fsd fs0, 0x60(sp) ++ fsd fs1, 0x68(sp) ++ fsd fs2, 0x70(sp) ++ fsd fs3, 0x78(sp) ++ fsd fs4, 0x80(sp) ++ fsd fs5, 0x88(sp) ++ fsd fs6, 0x90(sp) ++ fsd fs7, 0x98(sp) ++ fsd fs8, 0xa0(sp) ++ fsd fs9, 0xa8(sp) ++ fsd fs10, 0xb0(sp) ++ fsd fs11, 0xb8(sp) ++ addi sp, sp, -32 ++ /* Setup a callback link on the stack */ ++ load TMP1, caml_bottom_of_stack ++ store TMP1, 0(sp) ++ load TMP1, caml_last_return_address ++ store TMP1, 8(sp) ++ load TMP1, caml_gc_regs ++ store TMP1, 16(sp) ++ /* set up a trap frame */ ++ addi sp, sp, -16 ++ load TMP1, caml_exception_pointer ++ store TMP1, 0(sp) ++ lla TMP0, .Ltrap_handler ++ store TMP0, 8(sp) ++ mv TRAP_PTR, sp ++ load ALLOC_PTR, caml_young_ptr ++ load ALLOC_LIMIT, caml_young_limit ++ store x0, caml_last_return_address, TMP0 ++ jalr ARG ++.Lcaml_retaddr: /* pop trap frame, restoring caml_exception_pointer */ ++ load TMP1, 0(sp) ++ store TMP1, caml_exception_pointer, TMP0 ++ addi sp, sp, 16 ++.Lreturn_result: /* pop callback link, restoring global variables */ ++ load TMP1, 0(sp) ++ store TMP1, caml_bottom_of_stack, TMP0 ++ load TMP1, 8(sp) ++ store TMP1, caml_last_return_address, TMP0 ++ load TMP1, 16(sp) ++ store TMP1, caml_gc_regs, TMP0 ++ addi sp, sp, 32 ++ /* Update allocation pointer */ ++ store ALLOC_PTR, caml_young_ptr, TMP0 ++ /* reload callee-save registers and return */ ++ load ra, 0xc0(sp) ++ load s0, 0x0(sp) ++ load s1, 0x8(sp) ++ load s2, 0x10(sp) ++ load s3, 0x18(sp) ++ load s4, 0x20(sp) ++ load s5, 0x28(sp) ++ load s6, 0x30(sp) ++ load s7, 0x38(sp) ++ load s8, 0x40(sp) ++ load s9, 0x48(sp) ++ load s10, 0x50(sp) ++ load s11, 0x58(sp) ++ fld fs0, 0x60(sp) ++ fld fs1, 0x68(sp) ++ fld fs2, 0x70(sp) ++ fld fs3, 0x78(sp) ++ fld fs4, 0x80(sp) ++ fld fs5, 0x88(sp) ++ fld fs6, 0x90(sp) ++ fld fs7, 0x98(sp) ++ fld fs8, 0xa0(sp) ++ fld fs9, 0xa8(sp) ++ fld fs10, 0xb0(sp) ++ fld fs11, 0xb8(sp) ++ addi sp, sp, 0xd0 ++ ret ++.Ltrap_handler: ++ store TRAP_PTR, caml_exception_pointer, TMP0 ++ ori a0, a0, 2 ++ j .Lreturn_result ++ .size caml_start_program, .-caml_start_program ++ ++/* Callback from C to OCaml */ ++ ++ .align 2 ++ .globl caml_callback_exn ++ .type caml_callback_exn, @function ++caml_callback_exn: ++ /* Initial shuffling of arguments (a0 = closure, a1 = first arg) */ ++ mv TMP1, a0 ++ mv a0, a1 /* a0 = first arg */ ++ mv a1, TMP1 /* a1 = closure environment */ ++ load ARG, 0(TMP1) /* code pointer */ ++ j .Ljump_to_caml ++ .size caml_callback_exn, .-caml_callback_exn ++ ++ .align 2 ++ .globl caml_callback2_exn ++ .type caml_callback2_exn, @function ++caml_callback2_exn: ++ /* Initial shuffling of arguments (a0 = closure, a1 = arg1, a2 = arg2) */ ++ mv TMP1, a0 ++ mv a0, a1 ++ mv a1, a2 ++ mv a2, TMP1 ++ la ARG, caml_apply2 ++ j .Ljump_to_caml ++ .size caml_callback2_exn, .-caml_callback2_exn ++ ++ .align 2 ++ .globl caml_callback3_exn ++ .type caml_callback3_exn, @function ++caml_callback3_exn: ++ /* Initial shuffling of argumnets */ ++ /* (a0 = closure, a1 = arg1, a2 = arg2, a3 = arg3) */ ++ mv TMP1, a0 ++ mv a0, a1 ++ mv a1, a2 ++ mv a2, a3 ++ mv a3, TMP1 ++ la ARG, caml_apply3 ++ j .Ljump_to_caml ++ .size caml_callback3_exn, .-caml_callback3_exn ++ ++ .align 2 ++ .globl caml_ml_array_bound_error ++ .type caml_ml_array_bound_error, @function ++caml_ml_array_bound_error: ++ /* Load address of [caml_array_bound_error] in ARG */ ++ la ARG, caml_array_bound_error ++ /* Call that function */ ++ j caml_c_call ++ ++ .globl caml_system__code_end ++caml_system__code_end: ++ ++/* GC roots for callback */ ++ ++ .section .data ++ .align 3 ++ .globl caml_system__frametable ++ .type caml_system__frametable, @object ++caml_system__frametable: ++ .quad 1 /* one descriptor */ ++ .quad .Lcaml_retaddr /* return address into callback */ ++ .short -1 /* negative frame size => use callback link */ ++ .short 0 /* no roots */ ++ .align 3 ++ .size caml_system__frametable, .-caml_system__frametable +diff --git a/byterun/caml/stack.h b/byterun/caml/stack.h +index fd9d528e9..781c2517b 100644 +--- a/byterun/caml/stack.h ++++ b/byterun/caml/stack.h +@@ -75,6 +75,11 @@ + #define Callback_link(sp) ((struct caml_context *)((sp) + 16)) + #endif + ++#ifdef TARGET_riscv /* FIXME FIXME */ ++#define Saved_return_address(sp) *((intnat *)((sp) - 8)) ++#define Callback_link(sp) ((struct caml_context *)((sp) + 16)) ++#endif ++ + /* Structure of OCaml callback contexts */ + + struct caml_context { +diff --git a/configure b/configure +index 786f4cdbe..b88dab26b 100755 +--- a/configure ++++ b/configure +@@ -854,6 +854,7 @@ if test $with_sharedlibs = "yes"; then + arm*-*-freebsd*) natdynlink=true;; + earm*-*-netbsd*) natdynlink=true;; + aarch64-*-linux*) natdynlink=true;; ++ riscv*-*-linux*) natdynlink=true;; + esac + fi + +@@ -947,6 +948,8 @@ case "$target" in + x86_64-*-mingw*) arch=amd64; system=mingw;; + aarch64-*-linux*) arch=arm64; system=linux;; + x86_64-*-cygwin*) arch=amd64; system=cygwin;; ++ riscv32-*-linux*) arch=riscv; model=riscv32; system=linux;; ++ riscv64-*-linux*) arch=riscv; model=riscv64; system=linux;; + esac + + # Some platforms exist both in 32-bit and 64-bit variants, not distinguished +@@ -1023,7 +1026,7 @@ case "$arch,$system" in + aspp="${TOOLPREF}cc -c";; + *,freebsd) as="${TOOLPREF}as" + aspp="${TOOLPREF}cc -c";; +- amd64,*|arm,*|arm64,*|i386,*|power,bsd*|sparc,*) ++ amd64,*|arm,*|arm64,*|i386,*|power,bsd*|sparc,*|riscv,*) + as="${TOOLPREF}as" + case "$ccfamily" in + clang-*) +-- +2.13.2 + diff --git a/SOURCES/0009-Try-fix-for-andi-ori-xori-immediates-1.patch b/SOURCES/0009-Try-fix-for-andi-ori-xori-immediates-1.patch new file mode 100644 index 0000000..688970c --- /dev/null +++ b/SOURCES/0009-Try-fix-for-andi-ori-xori-immediates-1.patch @@ -0,0 +1,43 @@ +From 84a4b62e1305795f6599c91a50b6e0d9e675cbd5 Mon Sep 17 00:00:00 2001 +From: Nicolas Ojeda Bar +Date: Thu, 10 Nov 2016 14:12:53 +0100 +Subject: [PATCH 09/12] Try fix for andi/ori/xori immediates (#1) + +--- + asmcomp/riscv/selection.ml | 13 ------------- + 1 file changed, 13 deletions(-) + +diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml +index 60ec5cb4e..ad2b26e9b 100644 +--- a/asmcomp/riscv/selection.ml ++++ b/asmcomp/riscv/selection.ml +@@ -36,11 +36,6 @@ method! select_operation op args = + match (op, args) with + (* RISC-V does not support immediate operands for multiply high *) + | (Cmulhi, _) -> (Iintop Imulh, args) +- (* The and, or and xor instructions have a different range of immediate +- operands than the other instructions *) +- | (Cand, _) -> self#select_logical Iand args +- | (Cor, _) -> self#select_logical Ior args +- | (Cxor, _) -> self#select_logical Ixor args + (* Recognize (neg-)mult-add and (neg-)mult-sub instructions *) + | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3]) + | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) -> +@@ -58,14 +53,6 @@ method! select_operation op args = + | _ -> + super#select_operation op args + +-method select_logical op = function +- | [arg; Cconst_int n] when n >= 0 && n <= 0xFFF -> +- (Iintop_imm(op, n), [arg]) +- | [Cconst_int n; arg] when n >= 0 && n <= 0xFFF -> +- (Iintop_imm(op, n), [arg]) +- | args -> +- (Iintop op, args) +- + (* Instruction selection for conditionals *) + + method! select_condition = function +-- +2.13.2 + diff --git a/SOURCES/0010-Fix-immediates-range-when-adjusting-indexing-sp.patch b/SOURCES/0010-Fix-immediates-range-when-adjusting-indexing-sp.patch new file mode 100644 index 0000000..9ba6686 --- /dev/null +++ b/SOURCES/0010-Fix-immediates-range-when-adjusting-indexing-sp.patch @@ -0,0 +1,156 @@ +From bf083b3beeb9a622017137c246d2cfa863056cc0 Mon Sep 17 00:00:00 2001 +From: Nicolas Ojeda Bar +Date: Tue, 22 Nov 2016 22:30:35 +0100 +Subject: [PATCH 10/12] Fix immediates' range when adjusting/indexing sp + +--- + asmcomp/riscv/arch.ml | 3 +++ + asmcomp/riscv/emit.mlp | 53 ++++++++++++++++++++++++++++++++++------------ + asmcomp/riscv/selection.ml | 2 +- + 3 files changed, 44 insertions(+), 14 deletions(-) + +diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml +index 61a38b1dd..22c807c49 100644 +--- a/asmcomp/riscv/arch.ml ++++ b/asmcomp/riscv/arch.ml +@@ -32,6 +32,9 @@ let spacetime_node_hole_pointer_is_live_before = function + type addressing_mode = + | Iindexed of int (* reg + displ *) + ++let is_immediate n = ++ (n <= 2047) && (n >= -2048) ++ + (* Sizes, endianness *) + + let big_endian = false +diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp +index 6d0e3aefd..97c49ce80 100644 +--- a/asmcomp/riscv/emit.mlp ++++ b/asmcomp/riscv/emit.mlp +@@ -93,6 +93,34 @@ let emit_stack r = + let ofs = slot_offset s (register_class r) in `{emit_int ofs}(sp)` + | _ -> fatal_error "Emit.emit_stack" + ++(* Adjust sp by the given byte amount *) ++ ++let emit_stack_adjustment = function ++ | 0 -> () ++ | n when is_immediate n -> ++ ` addi sp, sp, {emit_int n}\n` ++ | n -> ++ ` li {emit_reg reg_tmp1}, {emit_int n}\n`; ++ ` add sp, sp, {emit_reg reg_tmp1}\n` ++ ++let emit_store src ofs = ++ if is_immediate ofs then ++ ` {emit_string stg} {emit_reg src}, {emit_int ofs}(sp)\n` ++ else begin ++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; ++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; ++ ` {emit_string stg} {emit_reg src}, 0({emit_reg reg_tmp1})\n` ++ end ++ ++let emit_load dst ofs = ++ if is_immediate ofs then ++ ` {emit_string lg} {emit_reg dst}, {emit_int ofs}(sp)\n` ++ else begin ++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; ++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; ++ ` {emit_string lg} {emit_reg dst}, 0({emit_reg reg_tmp1})\n` ++ end ++ + (* Record live pointers at call points *) + + let record_frame_label ?label live raise_ dbg = +@@ -218,6 +246,7 @@ let name_for_specific = function + + (* Name of current function *) + let function_name = ref "" ++ + (* Entry point for tail recursive calls *) + let tailrec_entry_point = ref 0 + +@@ -234,12 +263,14 @@ let emit_instr i = + ` mv {emit_reg dst}, {emit_reg src}\n` + | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} -> + ` fmv.d {emit_reg dst}, {emit_reg src}\n` +- | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} -> +- ` {emit_string stg} {emit_reg src}, {emit_stack dst}\n` ++ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} -> ++ let ofs = slot_offset s (register_class dst) in ++ emit_store src ofs + | {loc = Reg _; typ = Float}, {loc = Stack _} -> + ` fsd {emit_reg src}, {emit_stack dst}\n` +- | {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _ } -> +- ` {emit_string lg} {emit_reg dst}, {emit_stack src}\n` ++ | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} -> ++ let ofs = slot_offset s (register_class src) in ++ emit_load dst ofs + | {loc = Stack _; typ = Float}, {loc = Reg _} -> + ` fld {emit_reg dst}, {emit_stack src}\n` + | _ -> +@@ -263,8 +294,7 @@ let emit_instr i = + let n = frame_size() in + if !contains_calls then + ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`; +- if n > 0 then +- ` addi sp, sp, {emit_int n}\n`; ++ emit_stack_adjustment n; + ` jr {emit_reg i.arg.(0)}\n` + | Lop(Itailcall_imm {func; label_after = _}) -> + if func = !function_name then begin +@@ -273,8 +303,7 @@ let emit_instr i = + let n = frame_size() in + if !contains_calls then + ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`; +- if n > 0 then +- ` addi sp, sp, {emit_int n}\n`; ++ emit_stack_adjustment n; + ` tail {emit_symbol func}\n` + end + | Lop(Iextcall{func; alloc = true; label_after = label}) -> +@@ -285,7 +314,7 @@ let emit_instr i = + ` call {emit_symbol func}\n` + | Lop(Istackoffset n) -> + assert (n mod 16 = 0); +- ` addi sp, sp, {emit_int (-n)}\n`; ++ emit_stack_adjustment (-n); + stack_offset := !stack_offset + n + | Lop(Iload(Single, Iindexed ofs)) -> + ` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`; +@@ -398,8 +427,7 @@ let emit_instr i = + ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n` + | Lreturn -> + let n = frame_size() in +- if n > 0 then +- ` addi sp, sp, {emit_int n}\n`; ++ emit_stack_adjustment n; + ` ret\n` + | Llabel lbl -> + `{emit_label lbl}:\n` +@@ -513,8 +541,7 @@ let fundecl fundecl = + ` .align 2\n`; + `{emit_symbol fundecl.fun_name}:\n`; + let n = frame_size() in +- if n > 0 then +- ` addi sp, sp, {emit_int(-n)}\n`; ++ emit_stack_adjustment (-n); + if !contains_calls then + ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`; + `{emit_label !tailrec_entry_point}:\n`; +diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml +index ad2b26e9b..283233679 100644 +--- a/asmcomp/riscv/selection.ml ++++ b/asmcomp/riscv/selection.ml +@@ -22,7 +22,7 @@ class selector = object (self) + + inherit Selectgen.selector_generic as super + +-method is_immediate n = (n <= 0x7FF) && (n >= -0x800) ++method is_immediate n = is_immediate n + + method select_addressing _ = function + | Cop(Cadda, [arg; Cconst_int n]) when self#is_immediate n -> +-- +2.13.2 + diff --git a/SOURCES/0011-Another-immediate-range-fix.patch b/SOURCES/0011-Another-immediate-range-fix.patch new file mode 100644 index 0000000..2e2ab86 --- /dev/null +++ b/SOURCES/0011-Another-immediate-range-fix.patch @@ -0,0 +1,131 @@ +From 9e8d87c255713f7bf397083be9e6453d312c93a3 Mon Sep 17 00:00:00 2001 +From: Nicolas Ojeda Bar +Date: Wed, 23 Nov 2016 12:38:28 +0100 +Subject: [PATCH 11/12] Another immediate range fix + +--- + asmcomp/riscv/emit.mlp | 57 ++++++++++++++++++++++++++++++-------------------- + 1 file changed, 34 insertions(+), 23 deletions(-) + +diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp +index 97c49ce80..6cc190864 100644 +--- a/asmcomp/riscv/emit.mlp ++++ b/asmcomp/riscv/emit.mlp +@@ -85,14 +85,6 @@ let emit_reg = function + | {loc = Reg r} -> emit_string (register_name r) + | _ -> fatal_error "Emit.emit_reg" + +-(* Output a stack reference *) +- +-let emit_stack r = +- match r.loc with +- Stack s -> +- let ofs = slot_offset s (register_class r) in `{emit_int ofs}(sp)` +- | _ -> fatal_error "Emit.emit_stack" +- + (* Adjust sp by the given byte amount *) + + let emit_stack_adjustment = function +@@ -103,7 +95,27 @@ let emit_stack_adjustment = function + ` li {emit_reg reg_tmp1}, {emit_int n}\n`; + ` add sp, sp, {emit_reg reg_tmp1}\n` + +-let emit_store src ofs = ++let reload_ra n = ++ let ofs = n - size_addr in ++ if is_immediate ofs then ++ ` {emit_string lg} ra, {emit_int ofs}(sp)\n` ++ else begin ++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; ++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; ++ ` {emit_string lg} ra, 0({emit_reg reg_tmp1})\n` ++ end ++ ++let store_ra n = ++ let ofs = n - size_addr in ++ if is_immediate ofs then ++ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n` ++ else begin ++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; ++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; ++ ` {emit_string stg} ra, 0({emit_reg reg_tmp1})\n` ++ end ++ ++let emit_store stg src ofs = + if is_immediate ofs then + ` {emit_string stg} {emit_reg src}, {emit_int ofs}(sp)\n` + else begin +@@ -112,7 +124,7 @@ let emit_store src ofs = + ` {emit_string stg} {emit_reg src}, 0({emit_reg reg_tmp1})\n` + end + +-let emit_load dst ofs = ++let emit_load lg dst ofs = + if is_immediate ofs then + ` {emit_string lg} {emit_reg dst}, {emit_int ofs}(sp)\n` + else begin +@@ -265,14 +277,16 @@ let emit_instr i = + ` fmv.d {emit_reg dst}, {emit_reg src}\n` + | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} -> + let ofs = slot_offset s (register_class dst) in +- emit_store src ofs +- | {loc = Reg _; typ = Float}, {loc = Stack _} -> +- ` fsd {emit_reg src}, {emit_stack dst}\n` ++ emit_store stg src ofs ++ | {loc = Reg _; typ = Float}, {loc = Stack s} -> ++ let ofs = slot_offset s (register_class dst) in ++ emit_store "fsd" src ofs + | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} -> + let ofs = slot_offset s (register_class src) in +- emit_load dst ofs +- | {loc = Stack _; typ = Float}, {loc = Reg _} -> +- ` fld {emit_reg dst}, {emit_stack src}\n` ++ emit_load lg dst ofs ++ | {loc = Stack s; typ = Float}, {loc = Reg _} -> ++ let ofs = slot_offset s (register_class src) in ++ emit_load "fld" dst ofs + | _ -> + fatal_error "Emit: Imove" + end +@@ -292,8 +306,7 @@ let emit_instr i = + record_frame ~label i.live false i.dbg + | Lop(Itailcall_ind {label_after = _}) -> + let n = frame_size() in +- if !contains_calls then +- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`; ++ if !contains_calls then reload_ra n; + emit_stack_adjustment n; + ` jr {emit_reg i.arg.(0)}\n` + | Lop(Itailcall_imm {func; label_after = _}) -> +@@ -301,8 +314,7 @@ let emit_instr i = + ` j {emit_label !tailrec_entry_point}\n` + end else begin + let n = frame_size() in +- if !contains_calls then +- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n`; ++ if !contains_calls then reload_ra n; + emit_stack_adjustment n; + ` tail {emit_symbol func}\n` + end +@@ -424,7 +436,7 @@ let emit_instr i = + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n` + | Lreloadretaddr -> + let n = frame_size () in +- ` {emit_string lg} ra, {emit_int(n - size_addr)}(sp)\n` ++ reload_ra n + | Lreturn -> + let n = frame_size() in + emit_stack_adjustment n; +@@ -542,8 +554,7 @@ let fundecl fundecl = + `{emit_symbol fundecl.fun_name}:\n`; + let n = frame_size() in + emit_stack_adjustment (-n); +- if !contains_calls then +- ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`; ++ if !contains_calls then store_ra n; + `{emit_label !tailrec_entry_point}:\n`; + emit_all fundecl.fun_body; + List.iter emit_call_gc !call_gc_sites; +-- +2.13.2 + diff --git a/SOURCES/0012-AArch64-GOT-fixed.patch b/SOURCES/0012-AArch64-GOT-fixed.patch new file mode 100644 index 0000000..a8a5bcd --- /dev/null +++ b/SOURCES/0012-AArch64-GOT-fixed.patch @@ -0,0 +1,98 @@ +From c428a156b8e659a884d4867e52c49534125dc72f Mon Sep 17 00:00:00 2001 +From: Mark Shinwell +Date: Wed, 13 Sep 2017 10:23:16 +0100 +Subject: [PATCH 12/12] AArch64 GOT fixed + +--- + Changes | 4 ++++ + asmcomp/arm64/emit.mlp | 15 +++++++++++++-- + asmcomp/arm64/selection.ml | 4 ++-- + 3 files changed, 19 insertions(+), 4 deletions(-) + +diff --git a/Changes b/Changes +index e8dbd42e2..b84a1f30e 100644 +--- a/Changes ++++ b/Changes +@@ -150,6 +150,10 @@ OCaml 4.05.0 (13 Jul 2017): + (Hannes Mehnert, Guillaume Bury, + review by Daniel Bünzli, Gabriel Scherer, Damien Doligez) + ++- GPR#1330: when generating dynamically-linkable code on AArch64, always ++ reference symbols (even locally-defined ones) through the GOT. ++ (Mark Shinwell, review by Xavier Leroy) ++ + ### Standard library: + + - MPR#6975, GPR#902: Truncate function added to stdlib Buffer module +diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp +index f75646e12..729096c57 100644 +--- a/asmcomp/arm64/emit.mlp ++++ b/asmcomp/arm64/emit.mlp +@@ -114,6 +114,7 @@ let emit_addressing addr r = + | Iindexed ofs -> + `[{emit_reg r}, #{emit_int ofs}]` + | Ibased(s, ofs) -> ++ assert (not !Clflags.dlcode); (* see selection.ml *) + `[{emit_reg r}, #:lo12:{emit_symbol_offset s ofs}]` + + (* Record live pointers at call points *) +@@ -323,7 +324,7 @@ let emit_literals() = + (* Emit code to load the address of a symbol *) + + let emit_load_symbol_addr dst s = +- if (not !Clflags.dlcode) || Compilenv.symbol_in_current_unit s then begin ++ if not !Clflags.dlcode then begin + ` adrp {emit_reg dst}, {emit_symbol s}\n`; + ` add {emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n` + end else begin +@@ -609,6 +610,7 @@ let emit_instr i = + match addr with + | Iindexed _ -> i.arg.(0) + | Ibased(s, ofs) -> ++ assert (not !Clflags.dlcode); (* see selection.ml *) + ` adrp {emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`; + reg_tmp1 in + begin match size with +@@ -636,6 +638,7 @@ let emit_instr i = + match addr with + | Iindexed _ -> i.arg.(1) + | Ibased(s, ofs) -> ++ assert (not !Clflags.dlcode); + ` adrp {emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`; + reg_tmp1 in + begin match size with +@@ -924,7 +927,15 @@ let fundecl fundecl = + + let emit_item = function + | Cglobal_symbol s -> ` .globl {emit_symbol s}\n`; +- | Cdefine_symbol s -> `{emit_symbol s}:\n` ++ | Cdefine_symbol s -> ++ if !Clflags.dlcode then begin ++ (* GOT relocations against non-global symbols don't seem to work ++ properly: GOT entries are not created for the symbols and the ++ relocations evaluate to random other GOT entries. For the moment ++ force all symbols to be global. *) ++ ` .globl {emit_symbol s}\n`; ++ end; ++ `{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` +diff --git a/asmcomp/arm64/selection.ml b/asmcomp/arm64/selection.ml +index d8ea7f83b..b714d0032 100644 +--- a/asmcomp/arm64/selection.ml ++++ b/asmcomp/arm64/selection.ml +@@ -82,8 +82,8 @@ let inline_ops = + [ "sqrt"; "caml_bswap16_direct"; "caml_int32_direct_bswap"; + "caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ] + +-let use_direct_addressing symb = +- (not !Clflags.dlcode) || Compilenv.symbol_in_current_unit symb ++let use_direct_addressing _symb = ++ not !Clflags.dlcode + + (* Instruction selection *) + +-- +2.13.2 + diff --git a/SPECS/ocaml.spec b/SPECS/ocaml.spec new file mode 100644 index 0000000..e5c7d4d --- /dev/null +++ b/SPECS/ocaml.spec @@ -0,0 +1,937 @@ +# OCaml has a bytecode backend that works on anything with a C +# compiler, and a native code backend available on a subset of +# architectures. A further subset of architectures support native +# dynamic linking. + +%ifarch %{ocaml_native_compiler} +%global native_compiler 1 +%else +%global native_compiler 0 +%endif + +%ifarch %{ocaml_natdynlink} +%global natdynlink 1 +%else +%global natdynlink 0 +%endif + +# These are all the architectures that the tests run on. The tests +# take a long time to run, so don't run them on slow machines. +# - ppc64: tests hang under Koji with: +# Thread 1 killed on uncaught exception Unix.Unix_error(25, "accept", "") +# Unable to reproduce this failure locally. +%global test_arches aarch64 ppc64le x86_64 +# These are the architectures for which the tests must pass otherwise +# the build will fail. +%global test_arches_required aarch64 ppc64le x86_64 + +# Architectures where parallel builds fail. +#%global no_parallel_build_arches aarch64 + +Name: ocaml +Version: 4.05.0 +Release: 6%{?dist} + +Summary: OCaml compiler and programming environment + +License: QPL and (LGPLv2+ with exceptions) + +URL: http://www.ocaml.org + +Source0: http://caml.inria.fr/pub/distrib/ocaml-4.05/ocaml-%{version}.tar.xz + +Source1: http://caml.inria.fr/pub/distrib/ocaml-4.05/ocaml-4.05-refman-html.tar.gz +Source2: http://caml.inria.fr/pub/distrib/ocaml-4.05/ocaml-4.05-refman.pdf +Source3: http://caml.inria.fr/pub/distrib/ocaml-4.05/ocaml-4.05-refman.info.tar.gz + +# IMPORTANT NOTE: +# +# These patches are generated from unpacked sources stored in a +# pagure.io git repository. If you change the patches here, they will +# be OVERWRITTEN by the next update. Instead, request commit access +# to the pagure project: +# +# https://pagure.io/fedora-ocaml +# +# Current branch: rhel-7.5-4.05.0 +# +# ALTERNATIVELY add a patch to the end of the list (leaving the +# existing patches unchanged) adding a comment to note that it should +# be incorporated into the git repo at a later time. +# + +# Upstream patches after 4.05. +Patch0001: 0001-Changes-clarify-compatibility-breaking-change-items.patch +Patch0002: 0002-MPR-7591-frametable-not-8-aligned-on-x86-64-port.patch +Patch0003: 0003-Fixes-for-out-of-range-Ialloc.patch + +# Fedora-specific downstream patches. +Patch0004: 0004-Don-t-add-rpaths-to-libraries.patch +Patch0005: 0005-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch +Patch0006: 0006-configure-Allow-user-defined-C-compiler-flags.patch + +# Out of tree patches for RISC-V support. +# https://github.com/nojb/riscv-ocaml +Patch0007: 0007-Adapt-config.guess-for-RISC-V.patch +Patch0008: 0008-Add-RISC-V-backend-runtime.patch +Patch0009: 0009-Try-fix-for-andi-ori-xori-immediates-1.patch +Patch0010: 0010-Fix-immediates-range-when-adjusting-indexing-sp.patch +Patch0011: 0011-Another-immediate-range-fix.patch + +# Fix for some aarch64 linker problems. +# https://caml.inria.fr/mantis/view.php?id=7585 +Patch0012: 0012-AArch64-GOT-fixed.patch + +BuildRequires: ocaml-srpm-macros +BuildRequires: binutils-devel +BuildRequires: ncurses-devel +BuildRequires: gdbm-devel +%ifnarch riscv64 +BuildRequires: emacs +%endif +BuildRequires: gawk +BuildRequires: perl +BuildRequires: util-linux +BuildRequires: libICE-devel +BuildRequires: libSM-devel +BuildRequires: libX11-devel +BuildRequires: libXaw-devel +BuildRequires: libXext-devel +BuildRequires: libXft-devel +BuildRequires: libXmu-devel +BuildRequires: libXrender-devel +BuildRequires: libXt-devel +BuildRequires: mesa-libGL-devel +BuildRequires: mesa-libGLU-devel +BuildRequires: chrpath + +Requires: ocaml-srpm-macros +Requires: gcc + +# Because we pass -c flag to ocaml-find-requires (to avoid circular +# dependencies) we also have to explicitly depend on the right version +# of ocaml-runtime. +Requires: ocaml-runtime = %{version}-%{release} + +# Bundles an MD5 implementation in byterun/md5.{c,h} +Provides: bundled(md5-plumb) + +Provides: ocaml(compiler) = %{version} + +# These subpackages were removed in RHEL 7.5. It is intended that +# they will be replaced by new packages in EPEL. +Obsoletes: ocaml-labltk <= %{version}-%{release} +Obsoletes: ocaml-labltk-devel <= %{version}-%{release} + +%global __ocaml_requires_opts -c -f '%{buildroot}%{_bindir}/ocamlrun %{buildroot}%{_bindir}/ocamlobjinfo.byte' +%global __ocaml_provides_opts -f '%{buildroot}%{_bindir}/ocamlrun %{buildroot}%{_bindir}/ocamlobjinfo.byte' + + +%description +OCaml is a high-level, strongly-typed, functional and object-oriented +programming language from the ML family of languages. + +This package comprises two batch compilers (a fast bytecode compiler +and an optimizing native-code compiler), an interactive toplevel system, +parsing tools (Lex,Yacc), a replay debugger, a documentation generator, +and a comprehensive library. + + +%package runtime +Summary: OCaml runtime environment +Requires: util-linux +Provides: ocaml(runtime) = %{version} + +%description runtime +OCaml is a high-level, strongly-typed, functional and object-oriented +programming language from the ML family of languages. + +This package contains the runtime environment needed to run OCaml +bytecode. + + +%package source +Summary: Source code for OCaml libraries +Requires: ocaml = %{version}-%{release} + +%description source +Source code for OCaml libraries. + + +%package x11 +Summary: X11 support for OCaml +Requires: ocaml-runtime = %{version}-%{release} +Requires: libX11-devel + +%description x11 +X11 support for OCaml. + + +%package ocamldoc +Summary: Documentation generator for OCaml +Requires: ocaml = %{version}-%{release} +Provides: ocamldoc + +%description ocamldoc +Documentation generator for OCaml. + + +%ifnarch riscv64 +%package emacs +Summary: Emacs mode for OCaml +Requires: ocaml = %{version}-%{release} +Requires: emacs(bin) + +%description emacs +Emacs mode for OCaml. +%endif + + +%package docs +Summary: Documentation for OCaml +Requires: ocaml = %{version}-%{release} +Requires(post): /sbin/install-info +Requires(preun): /sbin/install-info + + +%description docs +OCaml is a high-level, strongly-typed, functional and object-oriented +programming language from the ML family of languages. + +This package contains documentation in PDF and HTML format as well as +man pages and info files. + + +%package compiler-libs +Summary: Compiler libraries for OCaml +Requires: ocaml = %{version}-%{release} + + +%description compiler-libs +OCaml is a high-level, strongly-typed, functional and object-oriented +programming language from the ML family of languages. + +This package contains some modules used internally by the OCaml +compilers, useful for the development of some OCaml applications. +Note that this exposes internal details of the OCaml compiler which +may not be portable between versions. + + +%prep +%setup -q -T -b 0 -n %{name}-%{version} +%setup -q -T -D -a 1 -n %{name}-%{version} +%setup -q -T -D -a 3 -n %{name}-%{version} +cp %{SOURCE2} refman.pdf +%autopatch -p1 + + +%build +# Parallel builds are broken in 4.05.0, see +# https://caml.inria.fr/mantis/view.php?id=7587 +#%ifnarch %{no_parallel_build_arches} +#make="make %{?_smp_mflags}" +#%else +unset MAKEFLAGS +make=make +#%endif + +CFLAGS="$RPM_OPT_FLAGS -fno-strict-aliasing" \ +./configure \ + -bindir %{_bindir} \ + -libdir %{_libdir}/ocaml \ + -x11lib %{_libdir} \ + -x11include %{_includedir} \ + -mandir %{_mandir}/man1 \ + -no-curses +$make world +%if %{native_compiler} +$make opt +$make opt.opt +%endif +%ifnarch riscv64 +make -C emacs ocamltags +%endif + +# Currently these tools are supplied by Debian, but are expected +# to go upstream at some point. +includes="-nostdlib -I stdlib -I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver -I otherlibs/unix -I otherlibs/str -I otherlibs/dynlink" +boot/ocamlrun ./ocamlc $includes dynlinkaux.cmo ocamlbyteinfo.ml -o ocamlbyteinfo +# ocamlplugininfo doesn't compile because it needs 'dynheader' (type +# decl) and I have no idea where that comes from +#cp otherlibs/dynlink/natdynlink.ml . +#boot/ocamlrun ./ocamlopt $includes unix.cmxa str.cmxa natdynlink.ml ocamlplugininfo.ml -o ocamlplugininfo + + +%check +%ifarch %{test_arches} +cd testsuite + +%ifarch %{test_arches_required} +make -j1 all +%else +make -j1 all ||: +%endif +%endif + + +%install +make install \ + BINDIR=$RPM_BUILD_ROOT%{_bindir} \ + LIBDIR=$RPM_BUILD_ROOT%{_libdir}/ocaml \ + MANDIR=$RPM_BUILD_ROOT%{_mandir} +perl -pi -e "s|^$RPM_BUILD_ROOT||" $RPM_BUILD_ROOT%{_libdir}/ocaml/ld.conf + +%ifnarch riscv64 +( + # install emacs files + cd emacs; + make install \ + BINDIR=$RPM_BUILD_ROOT%{_bindir} \ + EMACSDIR=$RPM_BUILD_ROOT%{_datadir}/emacs/site-lisp + make install-ocamltags BINDIR=$RPM_BUILD_ROOT%{_bindir} +) +%endif + +( + # install info files + mkdir -p $RPM_BUILD_ROOT%{_infodir}; + cd infoman; cp ocaml*.gz $RPM_BUILD_ROOT%{_infodir} +) + +echo %{version} > $RPM_BUILD_ROOT%{_libdir}/ocaml/fedora-ocaml-release + +# Remove rpaths from stublibs .so files. +chrpath --delete $RPM_BUILD_ROOT%{_libdir}/ocaml/stublibs/*.so + +install -m 0755 ocamlbyteinfo $RPM_BUILD_ROOT%{_bindir} +#install -m 0755 ocamlplugininfo $RPM_BUILD_ROOT%{_bindir} + +find $RPM_BUILD_ROOT -name .ignore -delete + +# Remove .cmt and .cmti files, for now. We could package them later. +# See also: http://www.ocamlpro.com/blog/2012/08/20/ocamlpro-and-4.00.0.html +find $RPM_BUILD_ROOT \( -name '*.cmt' -o -name '*.cmti' \) -a -delete + + +%post docs +/sbin/install-info \ + --entry="* ocaml: (ocaml). The OCaml compiler and programming environment" \ + --section="Programming Languages" \ + %{_infodir}/%{name}.info \ + %{_infodir}/dir 2>/dev/null || : + + +%preun docs +if [ $1 -eq 0 ]; then + /sbin/install-info --delete %{_infodir}/%{name}.info %{_infodir}/dir 2>/dev/null || : +fi + + +%files +%doc LICENSE +%{_bindir}/ocaml + +%{_bindir}/ocamlbyteinfo +%{_bindir}/ocamldebug +#%{_bindir}/ocamlplugininfo +%{_bindir}/ocamlyacc + +# symlink to either .byte or .opt version +%{_bindir}/ocamlc +%{_bindir}/ocamlcp +%{_bindir}/ocamldep +%{_bindir}/ocamllex +%{_bindir}/ocamlmklib +%{_bindir}/ocamlmktop +%{_bindir}/ocamlobjinfo +%{_bindir}/ocamloptp +%{_bindir}/ocamlprof + +# bytecode versions +%{_bindir}/ocamlc.byte +%{_bindir}/ocamlcp.byte +%{_bindir}/ocamldep.byte +%{_bindir}/ocamllex.byte +%{_bindir}/ocamlmklib.byte +%{_bindir}/ocamlmktop.byte +%{_bindir}/ocamlobjinfo.byte +%{_bindir}/ocamloptp.byte +%{_bindir}/ocamlprof.byte + +%if %{native_compiler} +# native code versions +%{_bindir}/ocamlc.opt +%{_bindir}/ocamlcp.opt +%{_bindir}/ocamldep.opt +%{_bindir}/ocamllex.opt +%{_bindir}/ocamlmklib.opt +%{_bindir}/ocamlmktop.opt +%{_bindir}/ocamlobjinfo.opt +%{_bindir}/ocamloptp.opt +%{_bindir}/ocamlprof.opt +%endif + +%if %{native_compiler} +%{_bindir}/ocamlopt +%{_bindir}/ocamlopt.byte +%{_bindir}/ocamlopt.opt +%endif + +#%{_libdir}/ocaml/addlabels +#%{_libdir}/ocaml/scrapelabels +%{_libdir}/ocaml/camlheader +%{_libdir}/ocaml/camlheader_ur +%{_libdir}/ocaml/expunge +%{_libdir}/ocaml/extract_crc +%{_libdir}/ocaml/ld.conf +%{_libdir}/ocaml/Makefile.config +%{_libdir}/ocaml/*.a +%if %{natdynlink} +%{_libdir}/ocaml/*.cmxs +%endif +%if %{native_compiler} +%{_libdir}/ocaml/*.cmxa +%{_libdir}/ocaml/*.cmx +%{_libdir}/ocaml/*.o +%{_libdir}/ocaml/libasmrun_shared.so +%endif +%{_libdir}/ocaml/*.mli +%{_libdir}/ocaml/libcamlrun_shared.so +%{_libdir}/ocaml/objinfo_helper +%{_libdir}/ocaml/vmthreads/*.mli +%{_libdir}/ocaml/vmthreads/*.a +%if %{native_compiler} +%{_libdir}/ocaml/threads/*.a +%{_libdir}/ocaml/threads/*.cmxa +%{_libdir}/ocaml/threads/*.cmx +%endif +%{_libdir}/ocaml/caml +%exclude %{_libdir}/ocaml/graphicsX11.mli + + +%files runtime +%doc README.adoc LICENSE Changes +%{_bindir}/ocamlrun +%dir %{_libdir}/ocaml +%{_libdir}/ocaml/VERSION +%{_libdir}/ocaml/*.cmo +%{_libdir}/ocaml/*.cmi +%{_libdir}/ocaml/*.cma +%{_libdir}/ocaml/stublibs +%dir %{_libdir}/ocaml/vmthreads +%{_libdir}/ocaml/vmthreads/*.cmi +%{_libdir}/ocaml/vmthreads/*.cma +%dir %{_libdir}/ocaml/threads +%{_libdir}/ocaml/threads/*.cmi +%{_libdir}/ocaml/threads/*.cma +%{_libdir}/ocaml/fedora-ocaml-release +%exclude %{_libdir}/ocaml/graphicsX11.cmi + + +%files source +%doc LICENSE +%{_libdir}/ocaml/*.ml + + +%files x11 +%doc LICENSE +%{_libdir}/ocaml/graphicsX11.cmi +%{_libdir}/ocaml/graphicsX11.mli + + +%files ocamldoc +%doc LICENSE +%doc ocamldoc/Changes.txt +%{_bindir}/ocamldoc* +%{_libdir}/ocaml/ocamldoc + + +%files docs +%doc refman.pdf htmlman +%{_infodir}/* +%{_mandir}/man1/* +%{_mandir}/man3/* + + +%ifnarch riscv64 +%files emacs +%doc emacs/README +%{_datadir}/emacs/site-lisp/* +%{_bindir}/ocamltags +%endif + + +%files compiler-libs +%doc LICENSE +%dir %{_libdir}/ocaml/compiler-libs +%{_libdir}/ocaml/compiler-libs/*.mli +%{_libdir}/ocaml/compiler-libs/*.cmi +%{_libdir}/ocaml/compiler-libs/*.cmo +%{_libdir}/ocaml/compiler-libs/*.cma +%if %{native_compiler} +%{_libdir}/ocaml/compiler-libs/*.a +%{_libdir}/ocaml/compiler-libs/*.cmxa +%{_libdir}/ocaml/compiler-libs/*.cmx +%{_libdir}/ocaml/compiler-libs/*.o +%endif + + +%changelog +* Mon Sep 25 2017 Richard W.M. Jones - 4.05.0-6 +- Obsolete only ocaml-labltk (not ocaml-camlp4) + related: rhbz#1447988 + +* Fri Sep 22 2017 Richard W.M. Jones - 4.05.0-5 +- Obsolete ocaml-camlp4 and ocaml-labltk, removed in RHEL 7.5. + +* Fri Sep 15 2017 Richard W.M. Jones - 4.05.0-4 +- Rebase to 4.05.0 (same as Fedora Rawhide). +- Adds support for POWER, z/VM. +- Improves support for aarch64. + resolves: rhbz#1447988 + +* Tue Jun 07 2016 Richard W.M. Jones - 4.01.0-22.7 +- Fix buffer overflow and information leak CVE-2015-8869 + resolves: rhbz#1343081 + +* Tue Jul 07 2015 Richard W.M. Jones - 4.01.0-22.6 +- ppc64le: Fix behaviour of Int64.max_int ÷ -1 + resolves: rhbz#1236615 + +* Thu May 28 2015 Richard W.M. Jones - 4.01.0-22.5 +- ppc64le: Fix calling convention of external functions with > 8 params + resolves: rhbz#1225995 + +* Mon Feb 16 2015 Richard W.M. Jones - 4.01.0-22.4 +- Fix ppc, ppc64, ppc64le stack non-executable (1214777). + +* Mon Feb 16 2015 Richard W.M. Jones - 4.01.0-22.3 +- Fix caml_callback2 crashes (upstream PR#6489, RHBZ#1197240). + +* Thu Sep 11 2014 Richard W.M. Jones - 4.01.0-22.2 +- Use -fno-strict-aliasing when building the compiler +- ppc, ppc64, ppc64le: Mark stack as non-executable. + resolves: rhbz#990521 +- Provides ocaml(runtime) 4.01.1. + related: rhbz#1098459 + +* Thu Sep 11 2014 Richard W.M. Jones - 4.01.0-22 +- Update to last 4.01 version from OCaml git. +- Fix bug in argument parsing + resolves: rhbz#1139803 + +* Thu Jun 26 2014 Richard W.M. Jones - 4.01.0-20 +- BR binutils-devel so ocamlobjinfo supports *.cmxs files (RHBZ#1113735). + +* Sat Jun 07 2014 Fedora Release Engineering - 4.01.0-19 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_21_Mass_Rebuild + +* Wed May 21 2014 Jaroslav Škarvada - 4.01.0-18 +- Rebuilt for https://fedoraproject.org/wiki/Changes/f21tcl86 + +* Sat May 10 2014 Richard W.M. Jones - 4.01.0-17 +- Mark stack as non-executable on ARM (32 bit) and Aarch64. + +* Tue Apr 22 2014 Richard W.M. Jones - 4.01.0-16 +- Remove ocaml-srpm-macros subpackage. + This is now a separate package, see RHBZ#1087893. + +* Tue Apr 15 2014 Richard W.M. Jones - 4.01.0-15 +- Fix s390x builds (no native compiler). + +* Tue Apr 15 2014 Richard W.M. Jones - 4.01.0-14 +- Remove ExclusiveArch. +- Add ocaml-srpm-macros subpackage containing arch macros. +- See: RHBZ#1087794 + +* Mon Apr 14 2014 Richard W.M. Jones - 4.01.0-13 +- Fix aarch64 relocation problems again. + Earlier patch was dropped accidentally. + +* Wed Apr 9 2014 Richard W.M. Jones - 4.01.0-12 +- Add ppc64le support (thanks: Michel Normand) (RHBZ#1077767). + +* Tue Apr 1 2014 Richard W.M. Jones - 4.01.0-11 +- Fix --flag=arg patch (thanks: Anton Lavrik, Ignas Vyšniauskas). + +* Mon Mar 24 2014 Richard W.M. Jones - 4.01.0-10 +- Include a fix for aarch64 relocation problems + http://caml.inria.fr/mantis/view.php?id=6283 + +* Wed Jan 8 2014 Richard W.M. Jones - 4.01.0-8 +- Don't use ifarch around Patch lines, as it means the patch files + don't get included in the spec file. + +* Mon Jan 6 2014 Richard W.M. Jones - 4.01.0-7 +- Work around gcc stack alignment issues, see + http://caml.inria.fr/mantis/view.php?id=5700 + +* Tue Dec 31 2013 Richard W.M. Jones - 4.01.0-6 +- Add aarch64 (arm64) code generator. + +* Thu Nov 21 2013 Richard W.M. Jones - 4.01.0-4 +- Add bundled(md5-plumb) (thanks: Tomas Mraz). +- Add NON-upstream (but being sent upstream) patch to allow --flag=arg + as an alternative to --flag arg (RHBZ#1028650). + +* Sat Sep 14 2013 Richard W.M. Jones - 4.01.0-3 +- Disable -lcurses. This is not actually used, just linked with unnecessarily. + +* Sat Sep 14 2013 Richard W.M. Jones - 4.01.0-2 +- Fix the build on ppc64. + +* Fri Sep 13 2013 Richard W.M. Jones - 4.01.0-1 +- Update to new major version OCaml 4.01.0. +- Rebase patches. +- Remove bogus Requires 'ncurses-devel'. The base ocaml package already + pulls in the library implicitly. +- Remove bogus Requires 'gdbm-devel'. Nothing in the source mentions gdbm. +- Use mkstemp instead of mktemp in ocamlyacc. +- Add LICENSE as doc to some subpackages to keep rpmlint happy. +- Remove .ignore file from some packages. +- Remove period from end of Summary. + +* Sat Aug 03 2013 Fedora Release Engineering - 4.00.1-3 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_20_Mass_Rebuild + +* Thu Feb 14 2013 Fedora Release Engineering - 4.00.1-2 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_19_Mass_Rebuild + +* Tue Oct 16 2012 Richard W.M. Jones - 4.00.1-1 +- Update to upstream version 4.00.1. +- Clean up the spec file further. + +* Thu Aug 16 2012 Richard W.M. Jones - 4.00.0-2 +- ppc supports natdynlink. + +* Sat Jul 28 2012 Richard W.M. Jones - 4.00.0-1 +- Upgrade to OCaml 4.00.0 official release. +- Remove one patch (add -lpthread) which went upstream. + +* Fri Jul 20 2012 Fedora Release Engineering - 4.00.0-0.6.beta2 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_18_Mass_Rebuild + +* Sun Jun 10 2012 Richard W.M. Jones - 4.00.0-0.5.beta2 +- No change, just fix up changelog. + +* Thu Jun 7 2012 Richard W.M. Jones 4.00.0-0.3.beta2 +- Upgrade to OCaml 4.00.0 beta 2. +- The language is now officially called OCaml (not Objective Caml, O'Caml etc) +- Rebase patches on top: + . New ARM backend patch no longer required, since upstream. + . Replacement config.guess, config.sub no longer required, since upstream + versions are newer. +- PPC64 backend rebased and fixed. + . Increase the default size of the stack when compiling. +- New tool: ocamloptp (ocamlopt profiler). +- New VERSION file in ocaml-runtime package. +- New ocaml-compiler-libs subpackage. +- Rearrange ExclusiveArch alphanumerically. +- alpha, ia64 native backends have been removed upstream, so they are + no longer supported as native compiler targets. +- Remove defattr. +- Make OCaml dependency generator self-contained so it doesn't need + previous version of OCaml around. + +* Wed Jun 6 2012 Richard W.M. Jones 3.12.1-12 +- ppc64: Include fix for minor heap corruption because of unaligned + minor heap register (RHBZ#826649). +- Unset MAKEFLAGS before running build. + +* Wed Jun 6 2012 Richard W.M. Jones 3.12.1-11 +- ppc64: Fix position of stack arguments to external C functions + when there are more than 8 parameters. + +* Tue Jun 5 2012 Richard W.M. Jones 3.12.1-10 +- Include patch to link dllthreads.so with -lpthread explicitly, to + fix problem with 'pthread_atfork' symbol missing (statically linked) + on ppc64. + +* Sun Jun 3 2012 Richard W.M. Jones 3.12.1-9 +- Include svn rev 12548 to fix invalid generation of Thumb-2 branch + instruction TBH (upstream PR#5623, RHBZ#821153). + +* Wed May 30 2012 Richard W.M. Jones 3.12.1-8 +- Modify the ppc64 patch to reduce the delta between power64 and + upstream power backends. +- Clean up the spec file and bring it up to modern standards. + * Remove patch fuzz directive. + * Remove buildroot directive. + * Rearrange source unpacking. + * Remove chmod of GNU config.* files, since git does it. + * Don't need to remove buildroot in install section. + * Remove clean section. + * git am 3.12.1-6 +- Move patches to external git repo: + http://git.fedorahosted.org/git/?p=fedora-ocaml.git + There should be no change introduced here. + +* Tue May 15 2012 Karsten Hopp 3.12.1-4 +- ppc64 got broken by the new ARM backend, add a minor patch + +* Sat Apr 28 2012 Richard W.M. Jones 3.12.1-3 +- New ARM backend by Benedikt Meurer, backported to OCaml 3.12.1. + This has several advantages, including enabling natdynlink on ARM. +- Provide updated config.guess and config.sub (from OCaml upstream tree). + +* Thu Jan 12 2012 Richard W.M. Jones 3.12.1-2 +- add back ocaml-ppc64.patch for ppc secondary arch, drop .cmxs files + from file list on ppc (cherry picked from F16 - this should have + gone into Rawhide originally then been cherry picked back to F16) + +* Fri Jan 6 2012 Richard W.M. Jones - 3.12.1-1 +- New upstream version 3.12.1. This is a bugfix update. + +* Thu Dec 8 2011 Richard W.M. Jones - 3.12.0-7 +- Allow this package to be compiled on platforms without native + support and/or natdynlink, specifically ppc64. This updates (and + hopefully does not break) DJ's previous *.cmxs change for arm. + +* Fri Sep 23 2011 DJ Delorie - 3.12.0-6 +- Add arm type directive patch. +- Allow more arm arches. +- Don't package *.cmxs on arm. + +* Wed Mar 30 2011 Richard W.M. Jones - 3.12.0-5 +- Fix for invalid assembler generation (RHBZ#691896). + +* Tue Feb 08 2011 Fedora Release Engineering - 3.12.0-4 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_15_Mass_Rebuild + +* Wed Jan 5 2011 Richard W.M. Jones - 3.12.0-3 +- Rebuild with self. + +* Tue Jan 4 2011 Richard W.M. Jones - 3.12.0-2 +- Try depending on OCaml BR to fix: + /usr/lib/rpm/ocaml-find-provides.sh: /builddir/build/BUILDROOT/ocaml-3.12.0-1.fc15.i386/usr/bin/ocamlobjinfo: /usr/bin/ocamlrun: bad interpreter: No such file or directory + +* Tue Jan 4 2011 Richard W.M. Jones - 3.12.0-1 +- New upstream version 3.12.0. + http://fedoraproject.org/wiki/Features/OCaml3.12 +- Remove ppc64 support patch. +- Rebase rpath removal patch. +- ocamlobjinfo is now an official tool, so no need to compile it by hand. + Add objinfo_helper. +- Disable ocamlplugininfo. +- Remove addlabels, scrapelabels. +- Remove ocaml/stublibs/dlltkanim.so. + +* Fri Jan 29 2010 Richard W.M. Jones - 3.11.2-2 +- Update reference manual to latest version from website. + +* Wed Jan 20 2010 Richard W.M. Jones - 3.11.2-1 +- Update to 3.11.2 official release. + +* Tue Jan 5 2010 Richard W.M. Jones - 3.11.2-0.rc1.2 +- ocaml-labltk-devel should require tcl-devel and tk-devel. + +* Tue Dec 29 2009 Richard W.M. Jones - 3.11.2-0.rc1.1 +- Update to (release candidate) 3.11.2+rc1. + +* Wed Dec 16 2009 Richard W.M. Jones - 3.11.1-8 +- Use __ocaml_requires_opts / __ocaml_provides_opts. + +* Wed Dec 16 2009 Richard W.M. Jones - 3.11.1-7 +- Remove ocaml-find-{requires,provides}.sh from this package. These are + now in upstream RPM 4.8 (RHBZ#545116). +- define -> global in a few places. + +* Thu Nov 05 2009 Dennis Gilmore - 3.11.1-6 +- include sparcv9 in the arch list + +* Tue Oct 27 2009 Richard W.M. Jones - 3.11.1-5 +- Install ocaml.info files correctly (RHBZ#531204). + +* Fri Oct 16 2009 Richard W.M. Jones - 3.11.1-4 +- Set includes so building the *info programs works without + having OCaml already installed. + +* Fri Oct 16 2009 Richard W.M. Jones - 3.11.1-3 +- Add ocamlbyteinfo and ocamlplugininfo programs from Debian. + +* Sun Oct 4 2009 Richard W.M. Jones - 3.11.1-2 +- ocaml-find-requires.sh: Calculate runtime version using ocamlrun + -version instead of fedora-ocaml-release file. + +* Wed Sep 30 2009 Richard W.M. Jones - 3.11.1-1 +- OCaml 3.11.1 (this is virtually the same as the release candidate + that we were using for Fedora 12). + +* Sat Jul 25 2009 Fedora Release Engineering - 3.11.1-0.rc1.2.1 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_12_Mass_Rebuild + +* Wed Jun 3 2009 Richard W.M. Jones - 3.11.1-0.rc1.2 +- Remember to upload the source this time. + +* Wed Jun 3 2009 Richard W.M. Jones - 3.11.1-0.rc1.1 +- New upstream release candidate 3.11.1+rc1. +- Remove ocamlbuild -where patch (now upstream). + +* Tue Jun 2 2009 Richard W.M. Jones - 3.11.1-0.rc0.3 +- Move dllgraphics.so into runtime package (RHBZ#468506). + +* Tue May 26 2009 Richard W.M. Jones - 3.11.1-0.rc0.2 +- Backport ocamlbuild -where fix. + +* Fri May 22 2009 Richard W.M. Jones - 3.11.1-0.rc0.1 +- 3.11.1 release candidate 0. + +* Wed Feb 25 2009 Fedora Release Engineering - 3.11.0-2 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_11_Mass_Rebuild + +* Thu Dec 4 2008 Richard W.M. Jones - 3.11.0-1 +- Official release of 3.11.0. + +* Thu Dec 4 2008 Richard W.M. Jones - 3.11.0-0.6.rc1 +- Fixed sources file. + +* Thu Dec 4 2008 Richard W.M. Jones - 3.11.0-0.5.rc1 +- New upstream version 3.11.0+rc1. + +* Mon Nov 24 2008 Richard W.M. Jones - 3.11.0-0.4.beta1 +- Rebuild. + +* Thu Nov 20 2008 Rex Dieter - 3.11.0-0.3.beta1 +- fix NVR to match packaging guidelines + +* Thu Nov 20 2008 Richard W.M. Jones - 3.11.0+beta1-2 +- Fix Invalid_argument("String.index_from") with patch from upstream. + +* Tue Nov 18 2008 Richard W.M. Jones - 3.11.0+beta1-1 +- Rebuild for major new upstream release of 3.11.0 for Fedora 11. + +* Fri Aug 29 2008 Richard W.M. Jones - 3.10.2-5 +- Rebuild with patch fuzz. + +* Mon Jun 9 2008 Richard W.M. Jones - 3.10.2-4 +- Add ocaml-3.11-dev12-no-executable-stack.patch (bz #450551). + +* Wed Jun 4 2008 Richard W.M. Jones - 3.10.2-3 +- ocaml-ocamldoc provides ocamldoc (bz #449931). +- REMOVED provides of labltk, camlp4. Those are libraries and all + packages should now depend on ocaml-labltk / ocaml-camlp4 / -devel + as appropriate. + +* Thu May 8 2008 Richard W.M. Jones - 3.10.2-2 +- Pass MAP_32BIT to mmap (bz #445545). + +* Mon Apr 21 2008 Richard W.M. Jones - 3.10.2-1 +- New upstream version 3.10.2 for Fedora 10. +- Cleaned up several rpmlint errors & warnings. + +* Fri Feb 29 2008 David Woodhouse - 3.10.1-2 +- ppc64 port + +* Tue Feb 12 2008 Richard W.M. Jones - 3.10.1-1 +- new upstream version 3.10.1 + +* Fri Jan 4 2008 Gerard Milmeister - 3.10.0-8 +- patch for building with tcl/tk 8.5 + +* Thu Sep 6 2007 Richard W.M. Jones - 3.10.0-7 +- Run chrpath to delete rpaths used on some of the stublibs. +- Ignore Parsetree module in dependency calculation. +- Fixed ocaml-find-{requires,provides}.sh regexp calculation so it doesn't + over-match module names. + +* Mon Sep 3 2007 Richard W.M. Jones - 3.10.0-6 +- ocaml-runtime provides ocaml(runtime) = 3.10.0, and + ocaml-find-requires.sh modified so that it adds this requires + to other packages. Now can upgrade base ocaml packages without + needing to rebuild everything else. + +* Mon Sep 3 2007 Richard W.M. Jones - 3.10.0-5 +- Don't include the release number in fedora-ocaml-release file, so + that packages built against this won't depend on the Fedora release. + +* Wed Aug 29 2007 Gerard Milmeister - 3.10.0-4 +- added BR util-linux-ng + +* Wed Aug 29 2007 Gerard Milmeister - 3.10.0-3 +- added BR gawk + +* Tue Aug 28 2007 Fedora Release Engineering - 3.10.0-2 +- Rebuild for selinux ppc32 issue. + +* Sat Jun 2 2007 Gerard Milmeister - 3.10.0-1 +- new version 3.10.0 +- split off devel packages +- rename subpackages to use ocaml- prefix + +* Thu May 24 2007 Gerard Milmeister - 3.09.3-2 +- added ocamlobjinfo + +* Sat Dec 2 2006 Gerard Milmeister - 3.09.3-1 +- new version 3.09.3 + +* Mon Aug 28 2006 Gerard Milmeister - 3.09.2-2 +- Rebuild for FE6 + +* Sun Apr 30 2006 Gerard Milmeister - 3.09.2-1 +- new version 3.09.2 + +* Fri Feb 17 2006 Gerard Milmeister - 3.09.1-2 +- Rebuild for Fedora Extras 5 + +* Thu Jan 5 2006 Gerard Milmeister - 3.09.1-1 +- new version 3.09.1 + +* Sun Jan 1 2006 Gerard Milmeister - 3.09.0-1 +- new version 3.09.0 + +* Sun Sep 11 2005 Gerard Milmeister - 3.08.4-1 +- New Version 3.08.4 + +* Wed May 25 2005 Toshio Kuratomi - 3.08.3-5 +- Bump and re-release as last build failed due to rawhide syncing. + +* Sun May 22 2005 Toshio Kuratomi - 3.08.3-4 +- Fix for gcc4 and the 32 bit assembly in otherlibs/num. +- Fix to allow compilation with RPM_OPT_FLAG defined -O level. + +* Sun May 22 2005 Jeremy Katz - 3.08.3-3 +- rebuild on all arches + +* Fri Apr 8 2005 Michael Schwendt +- rebuilt + +* Sat Mar 26 2005 Gerard Milmeister - 3.08.3-1 +- New Version 3.08.3 + +* Sat Feb 12 2005 Gerard Milmeister - 0:3.08.2-2 +- Added patch for removing rpath from shared libs + +* Sat Feb 12 2005 Gerard Milmeister - 0:3.08.2-1 +- New Version 3.08.2 + +* Thu Dec 30 2004 Thorsten Leemhuis - 0:3.07-6 +- add -x11lib _prefix/X11R6/_lib to configure; fixes labltk build + on x86_64 + +* Tue Dec 2 2003 Gerard Milmeister - 0:3.07-0.fdr.5 +- ocamldoc -> ocaml-ocamldoc +- ocaml-doc -> ocaml-docs + +* Fri Nov 28 2003 Gerard Milmeister - 0:3.07-0.fdr.4 +- Make separate packages for labltk, camlp4, ocamldoc, emacs and documentation + +* Thu Nov 27 2003 Gerard Milmeister - 0:3.07-0.fdr.2 +- Changed license tag +- Register info files +- Honor RPM_OPT_FLAGS +- New Patch + +* Fri Oct 31 2003 Gerard Milmeister - 0:3.07-0.fdr.1 +- First Fedora release + +* Mon Oct 13 2003 Axel Thimm +- Updated to 3.07. + +* Wed Apr 9 2003 Axel Thimm +- Rebuilt for Red Hat 9. + +* Tue Nov 26 2002 Axel Thimm +- Added _mandir/mano/* entry