From 1280ab804915d93bc5b591603b8254760d0373c0 Mon Sep 17 00:00:00 2001 From: CentOS Sources Date: Mar 05 2015 13:24:18 +0000 Subject: import ocaml-4.01.0-22.2.el7 --- diff --git a/.gitignore b/.gitignore index abb1224..fd9ef47 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,4 @@ -SOURCES/ocaml-4.00-refman-html.tar.gz -SOURCES/ocaml-4.00-refman.info.tar.gz -SOURCES/ocaml-4.00-refman.pdf -SOURCES/ocaml-4.00.1.tar.bz2 +SOURCES/ocaml-4.01-refman-html.tar.gz +SOURCES/ocaml-4.01-refman.info.tar.gz +SOURCES/ocaml-4.01-refman.pdf +SOURCES/ocaml-ecc80c0d3850bc144760af4c63b7eab438615bdc.tar.gz diff --git a/.ocaml.metadata b/.ocaml.metadata index 9e57955..47bcc51 100644 --- a/.ocaml.metadata +++ b/.ocaml.metadata @@ -1,4 +1,4 @@ -4777cfa97c893f91ba6ef49a8a89df152437bc3e SOURCES/ocaml-4.00-refman-html.tar.gz -948ffdd39055caba4049efcb6f1de16ba00fa900 SOURCES/ocaml-4.00-refman.info.tar.gz -cd4aa02131c4d50fbff23975fc66422988a16f2a SOURCES/ocaml-4.00-refman.pdf -10b8a4d0b88d20b003e3dd719f2ac9434e6a1042 SOURCES/ocaml-4.00.1.tar.bz2 +cd8d59ca75525c0dfa3cfaa29477c4ea5fa1c839 SOURCES/ocaml-4.01-refman-html.tar.gz +f5aa5bb8bc07899f5414de0d31af0d5a0168b002 SOURCES/ocaml-4.01-refman.info.tar.gz +be0d11b3efeca305cc9c561ba74a3819b0dda4e8 SOURCES/ocaml-4.01-refman.pdf +089e23a33b29e20a4e3bdfd9a5fcc6b501654c29 SOURCES/ocaml-ecc80c0d3850bc144760af4c63b7eab438615bdc.tar.gz diff --git a/SOURCES/0001-Add-.gitignore-file-to-ignore-generated-files.patch b/SOURCES/0001-Add-.gitignore-file-to-ignore-generated-files.patch index 1bb24e9..03eef52 100644 --- a/SOURCES/0001-Add-.gitignore-file-to-ignore-generated-files.patch +++ b/SOURCES/0001-Add-.gitignore-file-to-ignore-generated-files.patch @@ -1,19 +1,19 @@ -From 51c4b66e0b0e07a337fa33b081ff1314e22d8416 Mon Sep 17 00:00:00 2001 +From 3e74f2acd0b5a41f0faa33c770740cb74c89d257 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 7 Jun 2012 16:00:28 +0100 -Subject: [PATCH 1/6] Add .gitignore file to ignore generated files. +Subject: [PATCH 01/14] Add .gitignore file to ignore generated files. --- - .gitignore | 345 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 1 file changed, 345 insertions(+) + .gitignore | 348 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + 1 file changed, 348 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 -index 0000000..b67b39f +index 0000000..20a181f --- /dev/null +++ b/.gitignore -@@ -0,0 +1,345 @@ +@@ -0,0 +1,348 @@ +*~ +*.a +*.bak @@ -339,6 +339,7 @@ index 0000000..b67b39f +/stdlib/camlheader_ur +/stdlib/camlheaderd +/stdlib/stdlib.cmxa ++/stdlib/stdlib.p.cmxa +/stdlib/sys.ml +/tools/cvt_emit +/tools/cvt_emit.ml @@ -351,14 +352,16 @@ index 0000000..b67b39f +/tools/ocamldep.opt +/tools/ocamlmklib +/tools/ocamlmklib.ml ++/tools/ocamlmklibconfig.ml +/tools/ocamlmktop +/tools/ocamloptp +/tools/ocamlprof +/tools/opnames.ml +/tools/read_cmt ++/tools/read_cmt.opt +/utils/config.ml +/yacc/ocamlyacc +/yacc/version.h -- -1.7.11.4 +2.0.4 diff --git a/SOURCES/0001-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch b/SOURCES/0001-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch new file mode 100644 index 0000000..715394d --- /dev/null +++ b/SOURCES/0001-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch @@ -0,0 +1,38 @@ +From 4e06fda2060d8696649260937f8a551815de24cf Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Thu, 11 Sep 2014 14:49:54 +0100 +Subject: [PATCH] ppc, ppc64, ppc64le: Mark stack as non-executable. + +The same fix as this one, which was only fully applied to +i686 & x86-64: + +http://caml.inria.fr/mantis/view.php?id=4564 +--- + asmrun/power-elf.S | 3 +++ + asmrun/power64-elf.S | 2 ++ + 2 files changed, 5 insertions(+) + +diff --git a/asmrun/power-elf.S b/asmrun/power-elf.S +index facbfbf..14d28a0 100644 +--- a/asmrun/power-elf.S ++++ b/asmrun/power-elf.S +@@ -478,3 +478,6 @@ caml_system__frametable: + .long .L105 + 4 /* return address into callback */ + .short -1 /* negative size count => use callback link */ + .short 0 /* no roots here */ ++ ++/* Mark stack as non-executable, PR#4564 */ ++ .section .note.GNU-stack,"",%progbits +diff --git a/asmrun/power64-elf.S b/asmrun/power64-elf.S +index 98c42e2..b7bfce4 100644 +--- a/asmrun/power64-elf.S ++++ b/asmrun/power64-elf.S +@@ -577,3 +577,5 @@ caml_system__frametable: + .short 0 /* no roots here */ + .align 3 + ++/* Mark stack as non-executable, PR#4564 */ ++ .section .note.GNU-stack,"",%progbits +-- +2.0.4 + diff --git a/SOURCES/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch b/SOURCES/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch index 0c30a35..aa3209b 100644 --- a/SOURCES/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch +++ b/SOURCES/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch @@ -1,17 +1,18 @@ -From d284aa71cb426a99e28c5acfa1a99f932767fede Mon Sep 17 00:00:00 2001 +From a0c1f4805f85cc3ba4217ecbcae62cd567eb9dab Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 7 Jun 2012 15:36:16 +0100 -Subject: [PATCH 2/6] Ensure empty compilerlibs/ directory is created by git. +Subject: [PATCH 02/14] Ensure empty compilerlibs/ directory is created by git. This directory exists in the OCaml tarball, but is empty. As a result, git ignores it unless we put a dummy file in it. --- - 0 files changed + compilerlibs/.exists | 0 + 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 compilerlibs/.exists diff --git a/compilerlibs/.exists b/compilerlibs/.exists new file mode 100644 index 0000000..e69de29 -- -1.7.11.4 +2.0.4 diff --git a/SOURCES/0003-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch b/SOURCES/0003-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch index 82da9be..4749346 100644 --- a/SOURCES/0003-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch +++ b/SOURCES/0003-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch @@ -1,7 +1,7 @@ -From 133ddd0bb459bf3c687e149c850454c3c3b4f406 Mon Sep 17 00:00:00 2001 +From 4a5da8081ca854cebb0d431d12fc8edcfd3de59a Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 29 May 2012 20:40:36 +0100 -Subject: [PATCH 3/6] ocamlbyteinfo, ocamlplugininfo: Useful utilities from +Subject: [PATCH 03/14] ocamlbyteinfo, ocamlplugininfo: Useful utilities from Debian, sent upstream. See: @@ -236,5 +236,5 @@ index 0000000..e28800f + header.units + end -- -1.7.11.4 +2.0.4 diff --git a/SOURCES/0004-Don-t-add-rpaths-to-libraries.patch b/SOURCES/0004-Don-t-add-rpaths-to-libraries.patch index ecfbd15..884e288 100644 --- a/SOURCES/0004-Don-t-add-rpaths-to-libraries.patch +++ b/SOURCES/0004-Don-t-add-rpaths-to-libraries.patch @@ -1,26 +1,29 @@ -From 1e6bdb2cbc4a515ea589604e895501b40925585d Mon Sep 17 00:00:00 2001 +From 67f9cad7f4d3db0efcbcdf8bb97a2db3757ff14f Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" -Date: Tue, 29 May 2012 20:43:34 +0100 -Subject: [PATCH 4/6] Don't add rpaths to libraries. +Date: Tue, 24 Jun 2014 10:00:15 +0100 +Subject: [PATCH 04/14] Don't add rpaths to libraries. --- - tools/Makefile.shared | 3 --- - 1 file changed, 3 deletions(-) + tools/Makefile.shared | 6 +++--- + 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tools/Makefile.shared b/tools/Makefile.shared -index f6818d3..aadd7e2 100644 +index cf2f216..2d466cd 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared -@@ -114,9 +114,6 @@ ocamlmklib.ml: ocamlmklib.mlp ../config/Makefile - sed -e "s|%%BINDIR%%|$(BINDIR)|" \ - -e "s|%%SUPPORTS_SHARED_LIBRARIES%%|$(SUPPORTS_SHARED_LIBRARIES)|" \ - -e "s|%%MKSHAREDLIB%%|$(MKSHAREDLIB)|" \ -- -e "s|%%BYTECCRPATH%%|$(BYTECCRPATH)|" \ -- -e "s|%%NATIVECCRPATH%%|$(NATIVECCRPATH)|" \ -- -e "s|%%MKSHAREDLIBRPATH%%|$(MKSHAREDLIBRPATH)|" \ - -e "s|%%RANLIB%%|$(RANLIB)|" \ - ocamlmklib.mlp >> ocamlmklib.ml - +@@ -108,9 +108,9 @@ ocamlmklibconfig.ml: ../config/Makefile + echo 'let ext_dll = "$(EXT_DLL)"'; \ + echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\ + echo 'let mkdll = "$(MKDLL)"'; \ +- 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 -- -1.7.11.4 +2.0.4 diff --git a/SOURCES/0005-configure-Allow-user-defined-C-compiler-flags.patch b/SOURCES/0005-configure-Allow-user-defined-C-compiler-flags.patch index a6034f2..6eeef8d 100644 --- a/SOURCES/0005-configure-Allow-user-defined-C-compiler-flags.patch +++ b/SOURCES/0005-configure-Allow-user-defined-C-compiler-flags.patch @@ -1,17 +1,17 @@ -From 49388917a7cc798b89b95c86c5a65ed2cbea7bd4 Mon Sep 17 00:00:00 2001 +From 5c7b50033ad64f20c3cce71adb9b5c93dfa62678 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 29 May 2012 20:44:18 +0100 -Subject: [PATCH 5/6] configure: Allow user defined C compiler flags. +Subject: [PATCH 05/14] configure: Allow user defined C compiler flags. --- configure | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/configure b/configure -index e08bbce..cda73fd 100755 +index cbaa053..e8f8cfd 100755 --- a/configure +++ b/configure -@@ -1576,6 +1576,10 @@ case "$buggycc" in +@@ -1617,6 +1617,10 @@ case "$buggycc" in nativecccompopts="$nativecccompopts -fomit-frame-pointer";; esac @@ -23,5 +23,5 @@ index e08bbce..cda73fd 100755 cclibs="$cclibs $mathlib" -- -1.7.11.4 +2.0.4 diff --git a/SOURCES/0006-Add-support-for-ppc64.patch b/SOURCES/0006-Add-support-for-ppc64.patch index a6dc495..af28a09 100644 --- a/SOURCES/0006-Add-support-for-ppc64.patch +++ b/SOURCES/0006-Add-support-for-ppc64.patch @@ -1,7 +1,7 @@ -From 5b518e4ccac2ab99508f98b0d6a03dc1613a91f9 Mon Sep 17 00:00:00 2001 +From 959c12d1dfa5a3049fc4c7aed794afa287c46594 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 29 May 2012 20:47:07 +0100 -Subject: [PATCH 6/6] Add support for ppc64. +Subject: [PATCH 06/14] Add support for ppc64. Note (1): This patch was rejected upstream because they don't have appropriate hardware for testing. @@ -18,19 +18,19 @@ when there are more than 8 parameters (RHBZ#829187). Includes fix for minor heap corruption because of unaligned minor heap register (RHBZ#826649). -Includes updates for OCaml 4.00.0. +Includes updates for OCaml 4.01.0. --- - asmcomp/power64/arch.ml | 87 ++++ - asmcomp/power64/emit.mlp | 989 ++++++++++++++++++++++++++++++++++++++++++ - asmcomp/power64/proc.ml | 241 ++++++++++ + asmcomp/power64/arch.ml | 88 ++++ + asmcomp/power64/emit.mlp | 988 ++++++++++++++++++++++++++++++++++++++++++ + asmcomp/power64/proc.ml | 240 ++++++++++ asmcomp/power64/reload.ml | 18 + asmcomp/power64/scheduling.ml | 65 +++ - asmcomp/power64/selection.ml | 103 +++++ + asmcomp/power64/selection.ml | 101 +++++ asmrun/Makefile | 6 + asmrun/power64-elf.S | 486 +++++++++++++++++++++ asmrun/stack.h | 9 + configure | 3 + - 10 files changed, 2007 insertions(+) + 10 files changed, 2004 insertions(+) create mode 100644 asmcomp/power64/arch.ml create mode 100644 asmcomp/power64/emit.mlp create mode 100644 asmcomp/power64/proc.ml @@ -41,10 +41,10 @@ Includes updates for OCaml 4.00.0. diff --git a/asmcomp/power64/arch.ml b/asmcomp/power64/arch.ml new file mode 100644 -index 0000000..6a14864 +index 0000000..73c516d --- /dev/null +++ b/asmcomp/power64/arch.ml -@@ -0,0 +1,87 @@ +@@ -0,0 +1,88 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) @@ -61,7 +61,6 @@ index 0000000..6a14864 + +(* Specific operations for the PowerPC processor *) + -+open Misc +open Format + +(* Machine-specific command-line options *) @@ -90,6 +89,8 @@ index 0000000..6a14864 +let size_int = size_addr +let size_float = 8 + ++let allow_unaligned_access = false ++ +(* Behavior of division *) + +let division_crashes_on_overflow = false @@ -134,10 +135,10 @@ index 0000000..6a14864 + fprintf ppf "alloc_far %d" n diff --git a/asmcomp/power64/emit.mlp b/asmcomp/power64/emit.mlp new file mode 100644 -index 0000000..42f585d +index 0000000..d84ac5c --- /dev/null +++ b/asmcomp/power64/emit.mlp -@@ -0,0 +1,989 @@ +@@ -0,0 +1,988 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) @@ -156,7 +157,6 @@ index 0000000..42f585d + +module StringSet = Set.Make(struct type t = string let compare = compare end) + -+open Location +open Misc +open Cmm +open Arch @@ -176,7 +176,7 @@ index 0000000..42f585d +(* We have a stack frame of our own if we call other functions (including + use of exceptions, or if we need more than the red zone *) +let has_stack_frame () = -+ if !contains_calls or (num_stack_slots.(0) + num_stack_slots.(1)) > (288-16)/8 then ++ if !contains_calls || (num_stack_slots.(0) + num_stack_slots.(1)) > (288-16)/8 then + true + else + false @@ -960,7 +960,7 @@ index 0000000..42f585d + match i with + {desc = Lend} -> () + | {next = {desc = (Lcondbranch(_, _) | Lcondbranch3(_, _, _))}} -+ when is_simple_instr i & no_interference i.res i.next.arg -> ++ when is_simple_instr i && no_interference i.res i.next.arg -> + emit_instr i.next (Some i); + emit_all i.next.next + | _ -> @@ -1129,10 +1129,10 @@ index 0000000..42f585d + frame_descriptors := [] diff --git a/asmcomp/power64/proc.ml b/asmcomp/power64/proc.ml new file mode 100644 -index 0000000..119ad93 +index 0000000..372303d --- /dev/null +++ b/asmcomp/power64/proc.ml -@@ -0,0 +1,241 @@ +@@ -0,0 +1,240 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) @@ -1372,8 +1372,7 @@ index 0000000..119ad93 + Ccomp.command (Config.asm ^ " -o " ^ + Filename.quote outfile ^ " " ^ Filename.quote infile) + -+open Clflags;; -+open Config;; ++let init () = () diff --git a/asmcomp/power64/reload.ml b/asmcomp/power64/reload.ml new file mode 100644 index 0000000..abcac6c @@ -1471,10 +1470,10 @@ index 0000000..b7bba9b +let fundecl f = (new scheduler)#schedule_fundecl f diff --git a/asmcomp/power64/selection.ml b/asmcomp/power64/selection.ml new file mode 100644 -index 0000000..d2325e1 +index 0000000..53b7828 --- /dev/null +++ b/asmcomp/power64/selection.ml -@@ -0,0 +1,103 @@ +@@ -0,0 +1,101 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) @@ -1491,9 +1490,7 @@ index 0000000..d2325e1 + +(* Instruction selection for the Power PC processor *) + -+open Misc +open Cmm -+open Reg +open Arch +open Mach + @@ -1579,10 +1576,10 @@ index 0000000..d2325e1 + +let fundecl f = (new selector)#emit_fundecl f diff --git a/asmrun/Makefile b/asmrun/Makefile -index d4f0c56..d58d451 100644 +index 5ebf7aa..6a8ed98 100644 --- a/asmrun/Makefile +++ b/asmrun/Makefile -@@ -89,6 +89,12 @@ power.o: power-$(SYSTEM).o +@@ -90,6 +90,12 @@ power.o: power-$(SYSTEM).o power.p.o: power-$(SYSTEM).o cp power-$(SYSTEM).o power.p.o @@ -2088,10 +2085,10 @@ index 0000000..b2c24d6 + .align 3 + diff --git a/asmrun/stack.h b/asmrun/stack.h -index a801405..59a7bf2 100644 +index 57c87fa..756db95 100644 --- a/asmrun/stack.h +++ b/asmrun/stack.h -@@ -47,6 +47,15 @@ +@@ -46,6 +46,15 @@ #define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) #endif @@ -2108,26 +2105,26 @@ index a801405..59a7bf2 100644 #define Saved_return_address(sp) *((intnat *)((sp) - 4)) #define Callback_link(sp) ((struct caml_context *)((sp) + 8)) diff --git a/configure b/configure -index cda73fd..314d1e9 100755 +index e8f8cfd..9bb9e9e 100755 --- a/configure +++ b/configure -@@ -686,6 +686,7 @@ case "$host" in +@@ -698,6 +698,7 @@ case "$host" in arch=i386; system=macosx fi;; i[3456]86-*-gnu*) arch=i386; system=gnu;; + powerpc64-*-linux*) arch=power64; model=ppc64; system=elf;; powerpc*-*-linux*) arch=power; model=ppc; system=elf;; powerpc-*-netbsd*) arch=power; model=ppc; system=elf;; - powerpc-*-rhapsody*) arch=power; model=ppc; system=rhapsody;; -@@ -757,6 +758,8 @@ case "$arch,$model,$system" in + powerpc-*-openbsd*) arch=power; model=ppc; system=bsd_elf;; +@@ -781,6 +782,8 @@ case "$arch,$model,$system" in aspp='gcc -c';; - power,*,elf) as='as -u -m ppc' + power,*,bsd*) as='as' aspp='gcc -c';; + power64,*,elf) as='as -u -m ppc64' -+ aspp='gcc -c';; - power,*,bsd) as='as' - aspp='gcc -c';; ++ aspp='gcc -c';; power,*,rhapsody) as="as -arch $model" + aspp="$bytecc -c";; + sparc,*,solaris) as='as' -- -1.7.11.4 +2.0.4 diff --git a/SOURCES/0007-yacc-Use-mkstemp-instead-of-mktemp.patch b/SOURCES/0007-yacc-Use-mkstemp-instead-of-mktemp.patch new file mode 100644 index 0000000..9cf7ca4 --- /dev/null +++ b/SOURCES/0007-yacc-Use-mkstemp-instead-of-mktemp.patch @@ -0,0 +1,25 @@ +From 4119a66e247a74b559d4df275f223476306440a2 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Fri, 13 Sep 2013 21:29:58 +0100 +Subject: [PATCH 07/14] yacc: Use mkstemp instead of mktemp. + +--- + yacc/main.c | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/yacc/main.c b/yacc/main.c +index f6cac60..3067000 100644 +--- a/yacc/main.c ++++ b/yacc/main.c +@@ -53,7 +53,7 @@ char *text_file_name; + char *union_file_name; + char *verbose_file_name; + +-#if defined(__OpenBSD__) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__DragonFly__) || (__APPLE__) ++#if defined(__linux__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__DragonFly__) || (__APPLE__) + #define HAVE_MKSTEMP + #endif + +-- +2.0.4 + diff --git a/SOURCES/0008-Port-to-the-ARM-64-bits-AArch64-architecture-experim.patch b/SOURCES/0008-Port-to-the-ARM-64-bits-AArch64-architecture-experim.patch new file mode 100644 index 0000000..a874f6a --- /dev/null +++ b/SOURCES/0008-Port-to-the-ARM-64-bits-AArch64-architecture-experim.patch @@ -0,0 +1,2280 @@ +From 9f75e98d1cad55d1f6e0131e656acc716177e8d5 Mon Sep 17 00:00:00 2001 +From: Xavier Leroy +Date: Thu, 18 Jul 2013 16:09:20 +0000 +Subject: [PATCH 08/14] Port to the ARM 64-bits (AArch64) architecture + (experimental). Merge of branch branches/arm64. + +git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13909 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 +(cherry picked from commit 055d5c0379e42b4f561cb1fc5159659d8e9a7b6f) +--- + asmcomp/arm64/arch.ml | 146 ++++++++ + asmcomp/arm64/emit.mlp | 742 +++++++++++++++++++++++++++++++++++++++ + asmcomp/arm64/proc.ml | 212 +++++++++++ + asmcomp/arm64/reload.ml | 16 + + asmcomp/arm64/scheduling.ml | 18 + + asmcomp/arm64/selection.ml | 265 ++++++++++++++ + asmcomp/compilenv.ml | 9 + + asmcomp/compilenv.mli | 4 + + asmrun/arm64.S | 535 ++++++++++++++++++++++++++++ + asmrun/signals_osdep.h | 19 + + asmrun/stack.h | 5 + + byterun/interp.c | 6 + + configure | 5 +- + otherlibs/num/bng.c | 6 +- + otherlibs/num/bng_arm64.c | 20 ++ + testsuite/tests/asmcomp/Makefile | 2 +- + testsuite/tests/asmcomp/arm64.S | 52 +++ + testsuite/tests/asmcomp/main.ml | 1 + + 18 files changed, 2057 insertions(+), 6 deletions(-) + create mode 100644 asmcomp/arm64/arch.ml + create mode 100644 asmcomp/arm64/emit.mlp + create mode 100644 asmcomp/arm64/proc.ml + create mode 100644 asmcomp/arm64/reload.ml + create mode 100644 asmcomp/arm64/scheduling.ml + create mode 100644 asmcomp/arm64/selection.ml + create mode 100644 asmrun/arm64.S + create mode 100644 otherlibs/num/bng_arm64.c + create mode 100644 testsuite/tests/asmcomp/arm64.S + +diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml +new file mode 100644 +index 0000000..a53251f +--- /dev/null ++++ b/asmcomp/arm64/arch.ml +@@ -0,0 +1,146 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* Benedikt Meurer, University of Siegen *) ++(* *) ++(* Copyright 2013 Institut National de Recherche en Informatique *) ++(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) ++(* reserved. This file is distributed under the terms of the Q *) ++(* Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++let command_line_options = [] ++ ++(* Specific operations for the ARM processor, 64-bit mode *) ++ ++open Format ++ ++let command_line_options = [] ++ ++(* Addressing modes *) ++ ++type addressing_mode = ++ | Iindexed of int (* reg + displ *) ++ | Ibased of string * int (* global var + displ *) ++ ++(* We do not support the reg + shifted reg addressing mode, because ++ what we really need is reg + shifted reg + displ, ++ and this is decomposed in two instructions (reg + shifted reg -> tmp, ++ then addressing tmp + displ). *) ++ ++(* Specific operations *) ++ ++type specific_operation = ++ | Ishiftarith of arith_operation * int ++ | Ishiftcheckbound of int ++ | Imuladd (* multiply and add *) ++ | Imulsub (* multiply and subtract *) ++ | Inegmulf (* floating-point negate and multiply *) ++ | Imuladdf (* floating-point multiply and add *) ++ | Inegmuladdf (* floating-point negate, multiply and add *) ++ | Imulsubf (* floating-point multiply and subtract *) ++ | Inegmulsubf (* floating-point negate, multiply and subtract *) ++ | Isqrtf (* floating-point square root *) ++ | Ibswap of int (* endianess conversion *) ++ ++and arith_operation = ++ Ishiftadd ++ | Ishiftsub ++ ++(* Sizes, endianness *) ++ ++let big_endian = false ++ ++let size_addr = 8 ++let size_int = 8 ++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) ++ | Ibased(s, n) -> Ibased(s, n + delta) ++ ++let num_args_addressing = function ++ | Iindexed n -> 1 ++ | Ibased(s, n) -> 0 ++ ++(* Printing operations and addressing modes *) ++ ++let print_addressing printreg addr ppf arg = ++ match addr with ++ | Iindexed n -> ++ printreg ppf arg.(0); ++ if n <> 0 then fprintf ppf " + %i" n ++ | Ibased(s, 0) -> ++ fprintf ppf "\"%s\"" s ++ | Ibased(s, n) -> ++ fprintf ppf "\"%s\" + %i" s n ++ ++let print_specific_operation printreg op ppf arg = ++ match op with ++ | Ishiftarith(op, shift) -> ++ let op_name = function ++ | Ishiftadd -> "+" ++ | Ishiftsub -> "-" in ++ let shift_mark = ++ if shift >= 0 ++ then sprintf "<< %i" shift ++ else sprintf ">> %i" (-shift) in ++ fprintf ppf "%a %s %a %s" ++ printreg arg.(0) (op_name op) printreg arg.(1) shift_mark ++ | Ishiftcheckbound n -> ++ fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1) ++ | Imuladd -> ++ fprintf ppf "(%a * %a) + %a" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Imulsub -> ++ fprintf ppf "-(%a * %a) + %a" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Inegmulf -> ++ fprintf ppf "-f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ | Imuladdf -> ++ fprintf ppf "%a +f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Inegmuladdf -> ++ fprintf ppf "(-f %a) -f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Imulsubf -> ++ fprintf ppf "%a -f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Inegmulsubf -> ++ fprintf ppf "(-f %a) +f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Isqrtf -> ++ fprintf ppf "sqrtf %a" ++ printreg arg.(0) ++ | Ibswap n -> ++ fprintf ppf "bswap%i %a" n ++ printreg arg.(0) ++ +diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp +new file mode 100644 +index 0000000..fc9649c +--- /dev/null ++++ b/asmcomp/arm64/emit.mlp +@@ -0,0 +1,742 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* Benedikt Meurer, University of Siegen *) ++(* *) ++(* Copyright 2013 Institut National de Recherche en Informatique *) ++(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) ++(* reserved. This file is distributed under the terms of the Q *) ++(* Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Emission of ARM assembly code, 64-bit mode *) ++ ++open Misc ++open Cmm ++open Arch ++open Proc ++open Reg ++open Mach ++open Linearize ++open Emitaux ++ ++(* Tradeoff between code size and code speed *) ++ ++let fastcode_flag = ref true ++ ++(* Names for special regs *) ++ ++let reg_trap_ptr = phys_reg 23 ++let reg_alloc_ptr = phys_reg 24 ++let reg_alloc_limit = phys_reg 25 ++let reg_tmp1 = phys_reg 26 ++let reg_tmp2 = phys_reg 27 ++let reg_x15 = phys_reg 15 ++ ++(* Output a label *) ++ ++let emit_label lbl = ++ emit_string ".L"; emit_int lbl ++ ++let emit_data_label lbl = ++ emit_string ".Ld"; emit_int lbl ++ ++(* Symbols *) ++ ++let emit_symbol s = ++ Emitaux.emit_symbol '$' s ++ ++(* Output a pseudo-register *) ++ ++let emit_reg = function ++ {loc = Reg r} -> emit_string (register_name r) ++ | _ -> fatal_error "Emit.emit_reg" ++ ++(* Likewise, but with the 32-bit name of the register *) ++ ++let int_reg_name_w = ++ [| "w0"; "w1"; "w2"; "w3"; "w4"; "w5"; "w6"; "w7"; ++ "w8"; "w9"; "w10"; "w11"; "w12"; "w13"; "w14"; "w15"; ++ "w19"; "w20"; "w21"; "w22"; "w23"; "w24"; "w25"; ++ "w26"; "w27"; "w28"; "w16"; "w17" |] ++ ++let emit_wreg = function ++ {loc = Reg r} -> emit_string int_reg_name_w.(r) ++ | _ -> fatal_error "Emit.emit_wreg" ++ ++(* Layout of the stack frame *) ++ ++let stack_offset = ref 0 ++ ++let frame_size () = ++ let sz = ++ !stack_offset + ++ 8 * num_stack_slots.(0) + ++ 8 * num_stack_slots.(1) + ++ (if !contains_calls then 8 else 0) ++ in Misc.align sz 16 ++ ++let slot_offset loc cl = ++ match loc with ++ Incoming n -> ++ assert (n >= 0); ++ frame_size() + n ++ | Local n -> ++ !stack_offset + ++ (if cl = 0 ++ then n * 8 ++ else num_stack_slots.(0) * 8 + n * 8) ++ | Outgoing n -> ++ assert (n >= 0); ++ n ++ ++(* Output a stack reference *) ++ ++let emit_stack r = ++ match r.loc with ++ | Stack s -> ++ let ofs = slot_offset s (register_class r) in `[sp, #{emit_int ofs}]` ++ | _ -> fatal_error "Emit.emit_stack" ++ ++(* Output an addressing mode *) ++ ++let emit_symbol_offset s ofs = ++ emit_symbol s; ++ if ofs > 0 then `+{emit_int ofs}` ++ else if ofs < 0 then `-{emit_int (-ofs)}` ++ else () ++ ++let emit_addressing addr r = ++ match addr with ++ | Iindexed ofs -> ++ `[{emit_reg r}, #{emit_int ofs}]` ++ | Ibased(s, ofs) -> ++ `[{emit_reg r}, #:lo12:{emit_symbol_offset s ofs}]` ++ ++(* Record live pointers at call points *) ++ ++let record_frame_label live dbg = ++ let lbl = new_label() in ++ let live_offset = ref [] in ++ Reg.Set.iter ++ (function ++ {typ = Addr; loc = Reg r} -> ++ live_offset := ((r lsl 1) + 1) :: !live_offset ++ | {typ = Addr; loc = Stack s} as reg -> ++ live_offset := slot_offset s (register_class reg) :: !live_offset ++ | _ -> ()) ++ live; ++ frame_descriptors := ++ { fd_lbl = lbl; ++ fd_frame_size = frame_size(); ++ fd_live_offset = !live_offset; ++ fd_debuginfo = dbg } :: !frame_descriptors; ++ lbl ++ ++let record_frame live dbg = ++ let lbl = record_frame_label live dbg in `{emit_label lbl}:` ++ ++(* 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}: bl {emit_symbol "caml_call_gc"}\n`; ++ `{emit_label gc.gc_frame_lbl}: b {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 dbg = ++ if !Clflags.debug || !bound_error_sites = [] then begin ++ let lbl_bound_error = new_label() in ++ let lbl_frame = record_frame_label Reg.Set.empty dbg in ++ bound_error_sites := ++ { bd_lbl = lbl_bound_error; ++ bd_frame_lbl = lbl_frame } :: !bound_error_sites; ++ lbl_bound_error ++ end else begin ++ let bd = List.hd !bound_error_sites in bd.bd_lbl ++ end ++ ++let emit_call_bound_error bd = ++ `{emit_label bd.bd_lbl}: bl {emit_symbol "caml_ml_array_bound_error"}\n`; ++ `{emit_label bd.bd_frame_lbl}:\n` ++ ++(* Names of various instructions *) ++ ++let name_for_comparison = function ++ | Isigned Ceq -> "eq" | Isigned Cne -> "ne" | Isigned Cle -> "le" ++ | Isigned Cge -> "ge" | Isigned Clt -> "lt" | Isigned Cgt -> "gt" ++ | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "ls" ++ | Iunsigned Cge -> "cs" | Iunsigned Clt -> "cc" | Iunsigned Cgt -> "hi" ++ ++let name_for_int_operation = function ++ | Iadd -> "add" ++ | Isub -> "sub" ++ | Imul -> "mul" ++ | Idiv -> "sdiv" ++ | Iand -> "and" ++ | Ior -> "orr" ++ | Ixor -> "eor" ++ | Ilsl -> "lsl" ++ | Ilsr -> "lsr" ++ | Iasr -> "asr" ++ | _ -> assert false ++ ++(* Load an integer constant into a register *) ++ ++let emit_intconst dst n = ++ let rec emit_pos first shift = ++ if shift < 0 then begin ++ if first then ` mov {emit_reg dst}, xzr\n` ++ end else begin ++ let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in ++ if s = 0n then emit_pos first (shift - 16) else begin ++ if first then ++ ` movz {emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n` ++ else ++ ` movk {emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`; ++ emit_pos false (shift - 16) ++ end ++ end ++ and emit_neg first shift = ++ if shift < 0 then begin ++ if first then ` movn {emit_reg dst}, #0\n` ++ end else begin ++ let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in ++ if s = 0xFFFFn then emit_neg first (shift - 16) else begin ++ if first then ++ ` movn {emit_reg dst}, #{emit_nativeint (Nativeint.logxor s 0xFFFFn)}, lsl #{emit_int shift}\n` ++ else ++ ` movk {emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`; ++ emit_neg false (shift - 16) ++ end ++ end ++ in ++ if n < 0n then emit_neg true 48 else emit_pos true 48 ++ ++(* Recognize float constants appropriate for FMOV dst, #fpimm instruction: ++ "a normalized binary floating point encoding with 1 sign bit, 4 ++ bits of fraction and a 3-bit exponent" *) ++ ++let is_immediate_float bits = ++ let exp = (Int64.(to_int (shift_right_logical bits 52)) land 0x7FF) - 1023 in ++ let mant = Int64.logand bits 0xF_FFFF_FFFF_FFFFL in ++ exp >= -3 && exp <= 4 && Int64.logand mant 0xF_0000_0000_0000L = mant ++ ++(* Adjust sp (up or down) by the given byte amount *) ++ ++let emit_stack_adjustment n = ++ let instr = if n < 0 then "sub" else "add" in ++ let m = abs n in ++ assert (m < 0x1_000_000); ++ let ml = m land 0xFFF and mh = m land 0xFFF_000 in ++ if mh <> 0 then ` {emit_string instr} sp, sp, #{emit_int mh}\n`; ++ if ml <> 0 then ` {emit_string instr} sp, sp, #{emit_int ml}\n`; ++ if n <> 0 then cfi_adjust_cfa_offset (-n) ++ ++(* Deallocate the stack frame and reload the return address ++ before a return or tail call *) ++ ++let output_epilogue f = ++ let n = frame_size() in ++ if !contains_calls then ++ ` ldr x30, [sp, #{emit_int (n-8)}]\n`; ++ if n > 0 then ++ emit_stack_adjustment n; ++ f(); ++ (* reset CFA back because function body may continue *) ++ if n > 0 then cfi_adjust_cfa_offset n ++ ++(* Name of current function *) ++let function_name = ref "" ++(* Entry point for tail recursive calls *) ++let tailrec_entry_point = ref 0 ++(* Pending floating-point literals *) ++let float_literals = ref ([] : (int64 * label) list) ++ ++(* Label a floating-point literal *) ++let float_literal f = ++ try ++ List.assoc f !float_literals ++ with Not_found -> ++ let lbl = new_label() in ++ float_literals := (f, lbl) :: !float_literals; ++ lbl ++ ++(* Emit all pending literals *) ++let emit_literals() = ++ if !float_literals <> [] then begin ++ ` .align 3\n`; ++ List.iter ++ (fun (f, lbl) -> ++ `{emit_label lbl}: .quad `; emit_printf "0x%Lx\n" f) ++ !float_literals; ++ float_literals := [] ++ end ++ ++(* 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 ++ ` adrp {emit_reg dst}, {emit_symbol s}\n`; ++ ` add {emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n` ++ end else begin ++ ` adrp {emit_reg dst}, :got:{emit_symbol s}\n`; ++ ` ldr {emit_reg dst}, [{emit_reg dst}, #:got_lo12:{emit_symbol s}]\n` ++ end ++ ++(* Output the assembly code for an instruction *) ++ ++let emit_instr i = ++ emit_debug_info i.dbg; ++ 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 = Float}, {loc = Reg _} -> ++ ` fmov {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg _}, {loc = Reg _} -> ++ ` mov {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg _}, {loc = Stack _} -> ++ ` str {emit_reg src}, {emit_stack dst}\n` ++ | {loc = Stack _}, {loc = Reg _} -> ++ ` ldr {emit_reg dst}, {emit_stack src}\n` ++ | _ -> ++ assert false ++ end ++ | Lop(Iconst_int n) -> ++ emit_intconst i.res.(0) n ++ | Lop(Iconst_float f) -> ++ let b = Int64.bits_of_float(float_of_string f) in ++ if b = 0L then ++ ` fmov {emit_reg i.res.(0)}, xzr /* {emit_string f} */\n` ++ else if is_immediate_float b then ++ ` fmov {emit_reg i.res.(0)}, #{emit_printf "0x%Lx" b} /* {emit_string f} */\n` ++ else begin ++ let lbl = float_literal b in ++ ` adrp {emit_reg reg_tmp1}, {emit_label lbl}\n`; ++ ` ldr {emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}] /* {emit_string f} */\n` ++ end ++ | Lop(Iconst_symbol s) -> ++ emit_load_symbol_addr i.res.(0) s ++ | Lop(Icall_ind) -> ++ ` blr {emit_reg i.arg.(0)}\n`; ++ `{record_frame i.live i.dbg}\n` ++ | Lop(Icall_imm s) -> ++ ` bl {emit_symbol s}\n`; ++ `{record_frame i.live i.dbg}\n` ++ | Lop(Itailcall_ind) -> ++ output_epilogue (fun () -> ` br {emit_reg i.arg.(0)}\n`) ++ | Lop(Itailcall_imm s) -> ++ if s = !function_name then ++ ` b {emit_label !tailrec_entry_point}\n` ++ else ++ output_epilogue (fun () -> ` b {emit_symbol s}\n`) ++ | Lop(Iextcall(s, false)) -> ++ ` bl {emit_symbol s}\n` ++ | Lop(Iextcall(s, true)) -> ++ emit_load_symbol_addr reg_x15 s; ++ ` bl {emit_symbol "caml_c_call"}\n`; ++ `{record_frame i.live i.dbg}\n` ++ | Lop(Istackoffset n) -> ++ assert (n mod 16 = 0); ++ emit_stack_adjustment (-n); ++ stack_offset := !stack_offset + n ++ | Lop(Iload(size, addr)) -> ++ let dst = i.res.(0) in ++ let base = ++ match addr with ++ | Iindexed ofs -> i.arg.(0) ++ | Ibased(s, ofs) -> ++ ` adrp {emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`; ++ reg_tmp1 in ++ begin match size with ++ | Byte_unsigned -> ++ ` ldrb {emit_wreg dst}, {emit_addressing addr base}\n` ++ | Byte_signed -> ++ ` ldrsb {emit_reg dst}, {emit_addressing addr base}\n` ++ | Sixteen_unsigned -> ++ ` ldrh {emit_wreg dst}, {emit_addressing addr base}\n` ++ | Sixteen_signed -> ++ ` ldrsh {emit_reg dst}, {emit_addressing addr base}\n` ++ | Thirtytwo_unsigned -> ++ ` ldr {emit_wreg dst}, {emit_addressing addr base}\n` ++ | Thirtytwo_signed -> ++ ` ldrsw {emit_reg dst}, {emit_addressing addr base}\n` ++ | Single -> ++ ` ldr s7, {emit_addressing addr base}\n`; ++ ` fcvt {emit_reg dst}, s7\n` ++ | Word | Double | Double_u -> ++ ` ldr {emit_reg dst}, {emit_addressing addr base}\n` ++ end ++ | Lop(Istore(size, addr)) -> ++ let src = i.arg.(0) in ++ let base = ++ match addr with ++ | Iindexed ofs -> i.arg.(1) ++ | Ibased(s, ofs) -> ++ ` adrp {emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`; ++ reg_tmp1 in ++ begin match size with ++ | Byte_unsigned | Byte_signed -> ++ ` strb {emit_wreg src}, {emit_addressing addr base}\n` ++ | Sixteen_unsigned | Sixteen_signed -> ++ ` strh {emit_wreg src}, {emit_addressing addr base}\n` ++ | Thirtytwo_unsigned | Thirtytwo_signed -> ++ ` str {emit_wreg src}, {emit_addressing addr base}\n` ++ | Single -> ++ ` fcvt s7, {emit_reg src}\n`; ++ ` str s7, {emit_addressing addr base}\n`; ++ | Word | Double | Double_u -> ++ ` str {emit_reg src}, {emit_addressing addr base}\n` ++ end ++ | Lop(Ialloc n) -> ++ let lbl_frame = record_frame_label i.live i.dbg in ++ if !fastcode_flag then begin ++ let lbl_redo = new_label() in ++ let lbl_call_gc = new_label() in ++ `{emit_label lbl_redo}:`; ++ ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`; ++ ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`; ++ ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`; ++ ` b.lo {emit_label lbl_call_gc}\n`; ++ call_gc_sites := ++ { gc_lbl = lbl_call_gc; ++ gc_return_lbl = lbl_redo; ++ gc_frame_lbl = lbl_frame } :: !call_gc_sites ++ end else begin ++ begin match n with ++ | 16 -> ` bl {emit_symbol "caml_alloc1"}\n` ++ | 24 -> ` bl {emit_symbol "caml_alloc2"}\n` ++ | 32 -> ` bl {emit_symbol "caml_alloc3"}\n` ++ | _ -> emit_intconst reg_x15 (Nativeint.of_int n); ++ ` bl {emit_symbol "caml_allocN"}\n` ++ end; ++ `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n` ++ end ++ | Lop(Iintop(Icomp cmp)) -> ++ ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n` ++ | Lop(Iintop_imm(Icomp cmp, n)) -> ++ ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; ++ ` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n` ++ | Lop(Iintop Icheckbound) -> ++ let lbl = bound_error_label i.dbg in ++ ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` b.ls {emit_label lbl}\n` ++ | Lop(Iintop_imm(Icheckbound, n)) -> ++ let lbl = bound_error_label i.dbg in ++ ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; ++ ` b.ls {emit_label lbl}\n` ++ | Lop(Ispecific(Ishiftcheckbound shift)) -> ++ let lbl = bound_error_label i.dbg in ++ ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`; ++ ` b.cs {emit_label lbl}\n` ++ | Lop(Iintop Imod) -> ++ ` sdiv {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` msub {emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iintop_imm(Idiv, n)) -> (* n is a power of 2 *) ++ let l = Misc.log2 n in ++ ` asr {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, #63\n`; ++ ` add {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, lsr {emit_int (64-l)}\n`; ++ ` asr {emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_int l}\n` ++ | Lop(Iintop_imm(Imod, n)) -> (* n is a power of 2 *) ++ let l = Misc.log2 n in ++ ` asr {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, #63\n`; ++ ` add {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, lsr {emit_int (64-l)}\n`; ++ ` asr {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_int l}\n`; ++ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, lsl {emit_int l}\n` ++ | Lop(Iintop op) -> ++ let instr = name_for_int_operation op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Lop(Iintop_imm(op, n)) -> ++ let instr = name_for_int_operation op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n` ++ | Lop(Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf as op) -> ++ let instr = (match op with ++ | Ifloatofint -> "scvtf" ++ | Iintoffloat -> "fcvtzs" ++ | Iabsf -> "fabs" ++ | Inegf -> "fneg" ++ | Ispecific Isqrtf -> "fsqrt" ++ | _ -> assert false) in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) -> ++ let instr = (match op with ++ | Iaddf -> "fadd" ++ | Isubf -> "fsub" ++ | Imulf -> "fmul" ++ | Idivf -> "fdiv" ++ | Ispecific Inegmulf -> "fnmul" ++ | _ -> assert false) in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Lop(Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf as op)) -> ++ let instr = (match op with ++ | Imuladdf -> "fmadd" ++ | Inegmuladdf -> "fnmadd" ++ | Imulsubf -> "fmsub" ++ | Inegmulsubf -> "fnmsub" ++ | _ -> assert false) in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Ispecific(Ishiftarith(op, shift))) -> ++ let instr = (match op with ++ Ishiftadd -> "add" ++ | Ishiftsub -> "sub") in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`; ++ if shift >= 0 ++ then `, lsl #{emit_int shift}\n` ++ else `, asr #{emit_int (-shift)}\n` ++ | Lop(Ispecific(Imuladd | Imulsub as op)) -> ++ let instr = (match op with ++ Imuladd -> "madd" ++ | Imulsub -> "msub" ++ | _ -> assert false) 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` ++ | Lop(Ispecific(Ibswap size)) -> ++ begin match size with ++ | 16 -> ++ ` rev16 {emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`; ++ ` ubfm {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #0, #16\n` ++ | 32 -> ++ ` rev {emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n` ++ | 64 -> ++ ` rev {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` ++ | _ -> ++ assert false ++ end ++ | Lreloadretaddr -> ++ () ++ | Lreturn -> ++ output_epilogue (fun () -> ` ret\n`) ++ | Llabel lbl -> ++ `{emit_label lbl}:\n` ++ | Lbranch lbl -> ++ ` b {emit_label lbl}\n` ++ | Lcondbranch(tst, lbl) -> ++ begin match tst with ++ | Itruetest -> ++ ` cbnz {emit_reg i.arg.(0)}, {emit_label lbl}\n` ++ | Ifalsetest -> ++ ` cbz {emit_reg i.arg.(0)}, {emit_label lbl}\n` ++ | Iinttest cmp -> ++ ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ let comp = name_for_comparison cmp in ++ ` b.{emit_string comp} {emit_label lbl}\n` ++ | Iinttest_imm(cmp, n) -> ++ ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; ++ let comp = name_for_comparison cmp in ++ ` b.{emit_string comp} {emit_label lbl}\n` ++ | Ifloattest(cmp, neg) -> ++ let comp = (match (cmp, neg) with ++ | (Ceq, false) | (Cne, true) -> "eq" ++ | (Cne, false) | (Ceq, true) -> "ne" ++ | (Clt, false) -> "cc" ++ | (Clt, true) -> "cs" ++ | (Cle, false) -> "ls" ++ | (Cle, true) -> "hi" ++ | (Cgt, false) -> "gt" ++ | (Cgt, true) -> "le" ++ | (Cge, false) -> "ge" ++ | (Cge, true) -> "lt") in ++ ` fcmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` b.{emit_string comp} {emit_label lbl}\n` ++ | Ioddtest -> ++ ` tbnz {emit_reg i.arg.(0)}, #0, {emit_label lbl}\n` ++ | Ieventest -> ++ ` tbz {emit_reg i.arg.(0)}, #0, {emit_label lbl}\n` ++ end ++ | Lcondbranch3(lbl0, lbl1, lbl2) -> ++ ` cmp {emit_reg i.arg.(0)}, #1\n`; ++ begin match lbl0 with ++ None -> () ++ | Some lbl -> ` b.lt {emit_label lbl}\n` ++ end; ++ begin match lbl1 with ++ None -> () ++ | Some lbl -> ` b.eq {emit_label lbl}\n` ++ end; ++ begin match lbl2 with ++ None -> () ++ | Some lbl -> ` b.gt {emit_label lbl}\n` ++ end ++ | Lswitch jumptbl -> ++ let lbltbl = new_label() in ++ ` adr {emit_reg reg_tmp1}, {emit_label lbltbl}\n`; ++ ` add {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, lsl #2\n`; ++ ` br {emit_reg reg_tmp1}\n`; ++ `{emit_label lbltbl}:`; ++ for j = 0 to Array.length jumptbl - 1 do ++ ` b {emit_label jumptbl.(j)}\n` ++ done ++(* Alternative: ++ let lbltbl = new_label() in ++ ` adr {emit_reg reg_tmp1}, {emit_label lbltbl}\n`; ++ ` ldr {emit_wreg reg_tmp2}, [{emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, lsl #2]\n`; ++ ` add {emit_reg reg_tmp1}, {emit_wreg reg_tmp2}, sxtb\n`; ++ ` br {emit_reg reg_tmp1}\n`; ++ `{emit_label lbltbl}:\n`; ++ for j = 0 to Array.length jumptbl - 1 do ++ ` .word {emit_label jumptbl.(j)} - {emit_label lbltbl}\n` ++ done ++*) ++ | Lsetuptrap lbl -> ++ let lblnext = new_label() in ++ ` adr {emit_reg reg_tmp1}, {emit_label lblnext}\n`; ++ ` b {emit_label lbl}\n`; ++ `{emit_label lblnext}:\n` ++ | Lpushtrap -> ++ stack_offset := !stack_offset + 16; ++ ` str {emit_reg reg_trap_ptr}, [sp, -16]!\n`; ++ ` str {emit_reg reg_tmp1}, [sp, #8]\n`; ++ cfi_adjust_cfa_offset 16; ++ ` mov {emit_reg reg_trap_ptr}, sp\n` ++ | Lpoptrap -> ++ ` ldr {emit_reg reg_trap_ptr}, [sp], 16\n`; ++ cfi_adjust_cfa_offset (-16); ++ stack_offset := !stack_offset - 16 ++ | Lraise -> ++ if !Clflags.debug then begin ++ ` bl {emit_symbol "caml_raise_exn"}\n`; ++ `{record_frame Reg.Set.empty i.dbg}\n` ++ end else begin ++ ` mov sp, {emit_reg reg_trap_ptr}\n`; ++ ` ldr {emit_reg reg_tmp1}, [sp, #8]\n`; ++ ` ldr {emit_reg reg_trap_ptr}, [sp], 16\n`; ++ ` br {emit_reg reg_tmp1}\n` ++ end ++ ++(* Emission of an instruction sequence *) ++ ++let rec emit_all i = ++ if i.desc = Lend then () else (emit_instr i; emit_all i.next) ++ ++(* Emission of the profiling prelude *) ++ ++let emit_profile() = () (* TODO *) ++(* ++ match Config.system with ++ "linux_eabi" | "linux_eabihf" -> ++ ` push \{lr}\n`; ++ ` {emit_call "__gnu_mcount_nc"}\n` ++ | _ -> () ++*) ++ ++(* Emission of a function declaration *) ++ ++let fundecl fundecl = ++ function_name := fundecl.fun_name; ++ fastcode_flag := fundecl.fun_fast; ++ tailrec_entry_point := new_label(); ++ float_literals := []; ++ stack_offset := 0; ++ call_gc_sites := []; ++ bound_error_sites := []; ++ ` .text\n`; ++ ` .align 2\n`; ++ ` .globl {emit_symbol fundecl.fun_name}\n`; ++ ` .type {emit_symbol fundecl.fun_name}, %function\n`; ++ `{emit_symbol fundecl.fun_name}:\n`; ++ emit_debug_info fundecl.fun_dbg; ++ cfi_startproc(); ++ if !Clflags.gprofile then emit_profile(); ++ let n = frame_size() in ++ if n > 0 then ++ emit_stack_adjustment (-n); ++ if !contains_calls then ++ ` str x30, [sp, #{emit_int (n-8)}]\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; ++ cfi_endproc(); ++ ` .type {emit_symbol fundecl.fun_name}, %function\n`; ++ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`; ++ emit_literals() ++ ++(* Emission of data *) ++ ++let emit_item = function ++ | Cglobal_symbol s -> ` .globl {emit_symbol s}\n`; ++ | Cdefine_symbol s -> `{emit_symbol s}:\n` ++ | Cdefine_label lbl -> `{emit_data_label lbl}:\n` ++ | Cint8 n -> ` .byte {emit_int n}\n` ++ | Cint16 n -> ` .short {emit_int n}\n` ++ | Cint32 n -> ` .long {emit_nativeint n}\n` ++ | Cint n -> ` .quad {emit_nativeint n}\n` ++ | Csingle f -> emit_float32_directive ".long" f ++ | Cdouble f -> emit_float64_directive ".quad" f ++ | Csymbol_address s -> ` .quad {emit_symbol s}\n` ++ | Clabel_address lbl -> ` .quad {emit_data_label lbl}\n` ++ | Cstring s -> emit_string_directive " .ascii " s ++ | Cskip n -> if n > 0 then ` .space {emit_int n}\n` ++ | Calign n -> ` .align {emit_int(Misc.log2 n)}\n` ++ ++let data l = ++ ` .data\n`; ++ List.iter emit_item l ++ ++(* Beginning / end of an assembly file *) ++ ++let begin_assembly() = ++ reset_debug_info(); ++ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in ++ ` .data\n`; ++ ` .globl {emit_symbol lbl_begin}\n`; ++ `{emit_symbol lbl_begin}:\n`; ++ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in ++ ` .text\n`; ++ ` .globl {emit_symbol lbl_begin}\n`; ++ `{emit_symbol lbl_begin}:\n` ++ ++let end_assembly () = ++ let lbl_end = Compilenv.make_symbol (Some "code_end") in ++ ` .text\n`; ++ ` .globl {emit_symbol lbl_end}\n`; ++ `{emit_symbol lbl_end}:\n`; ++ let lbl_end = Compilenv.make_symbol (Some "data_end") in ++ ` .data\n`; ++ ` .globl {emit_symbol lbl_end}\n`; ++ `{emit_symbol lbl_end}:\n`; ++ ` .long 0\n`; ++ let lbl = Compilenv.make_symbol (Some "frametable") in ++ ` .globl {emit_symbol lbl}\n`; ++ `{emit_symbol lbl}:\n`; ++ emit_frames ++ { efa_label = (fun lbl -> ++ ` .type {emit_label lbl}, %function\n`; ++ ` .quad {emit_label lbl}\n`); ++ efa_16 = (fun n -> ` .short {emit_int n}\n`); ++ efa_32 = (fun n -> ` .long {emit_int32 n}\n`); ++ efa_word = (fun n -> ` .quad {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 lbl -> `{emit_label lbl}:\n`); ++ efa_string = (fun s -> emit_string_directive " .asciz " s) }; ++ ` .type {emit_symbol lbl}, %object\n`; ++ ` .size {emit_symbol lbl}, .-{emit_symbol lbl}\n`; ++ begin match Config.system with ++ | "linux" -> ++ (* Mark stack as non-executable *) ++ ` .section .note.GNU-stack,\"\",%progbits\n` ++ | _ -> () ++ end +diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml +new file mode 100644 +index 0000000..b52c2fd +--- /dev/null ++++ b/asmcomp/arm64/proc.ml +@@ -0,0 +1,212 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* Benedikt Meurer, University of Siegen *) ++(* *) ++(* Copyright 2013 Institut National de Recherche en Informatique *) ++(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) ++(* reserved. This file is distributed under the terms of the Q *) ++(* Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Description of the ARM processor in 64-bit mode *) ++ ++open Misc ++open Cmm ++open Reg ++open Arch ++open Mach ++ ++(* Instruction selection *) ++ ++let word_addressed = false ++ ++(* Registers available for register allocation *) ++ ++(* Integer register map: ++ x0 - x15 general purpose (caller-save) ++ x16, x17 temporaries (used by call veeners) ++ x18 platform register (reserved) ++ x19 - x25 general purpose (callee-save) ++ x26 trap pointer ++ x27 alloc pointer ++ x28 alloc limit ++ x29 frame pointer ++ x30 return address ++ sp / xzr stack pointer / zero register ++ Floating-point register map: ++ d0 - d7 general purpose (caller-save) ++ d8 - d15 general purpose (callee-save) ++ d16 - d31 generat purpose (caller-save) ++*) ++ ++let int_reg_name = ++ [| "x0"; "x1"; "x2"; "x3"; "x4"; "x5"; "x6"; "x7"; ++ "x8"; "x9"; "x10"; "x11"; "x12"; "x13"; "x14"; "x15"; ++ "x19"; "x20"; "x21"; "x22"; "x23"; "x24"; "x25"; ++ "x26"; "x27"; "x28"; "x16"; "x17" |] ++ ++let float_reg_name = ++ [| "d0"; "d1"; "d2"; "d3"; "d4"; "d5"; "d6"; "d7"; ++ "d8"; "d9"; "d10"; "d11"; "d12"; "d13"; "d14"; "d15"; ++ "d16"; "d17"; "d18"; "d19"; "d20"; "d21"; "d22"; "d23"; ++ "d24"; "d25"; "d26"; "d27"; "d28"; "d29"; "d30"; "d31" |] ++ ++let num_register_classes = 2 ++ ++let register_class r = ++ match r.typ with ++ | (Int | Addr) -> 0 ++ | Float -> 1 ++ ++let num_available_registers = ++ [| 23; 32 |] (* first 23 int regs allocatable; all float regs allocatable *) ++ ++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.create 28 Reg.dummy in ++ for i = 0 to 27 do ++ v.(i) <- Reg.at_location Int (Reg i) ++ done; ++ v ++ ++let hard_float_reg = ++ let v = Array.create 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 reg_x15 = phys_reg 15 ++let reg_d7 = phys_reg 107 ++ ++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.create (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 ++ 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 ofs = fatal_error "Proc.loc_results: cannot call" ++ ++(* OCaml calling convention: ++ first integer args in r0...r15 ++ first float args in d0...d15 ++ remaining args on stack. ++ Return values in r0...r15 or d0...d15. *) ++ ++let loc_arguments arg = ++ calling_conventions 0 15 100 115 outgoing arg ++let loc_parameters arg = ++ let (loc, _) = calling_conventions 0 15 100 115 incoming arg in loc ++let loc_results res = ++ let (loc, _) = calling_conventions 0 15 100 115 not_supported res in loc ++ ++(* C calling convention: ++ first integer args in r0...r7 ++ first float args in d0...d7 ++ remaining args on stack. ++ Return values in r0...r1 or d0. *) ++ ++let loc_external_arguments arg = ++ calling_conventions 0 7 100 107 outgoing arg ++let loc_external_results res = ++ let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc ++ ++let loc_exn_bucket = phys_reg 0 ++ ++(* Registers destroyed by operations *) ++ ++let destroyed_at_c_call = ++ (* x19-x28, d8-d15 preserved *) ++ Array.of_list (List.map phys_reg ++ [0;1;2;3;4;5;6;7;8;9;10;11;12;13;14;15; ++ 100;101;102;103;104;105;106;107; ++ 116;117;118;119;120;121;122;123; ++ 124;125;126;127;128;129;130;131]) ++ ++let destroyed_at_oper = function ++ | Iop(Icall_ind | Icall_imm _) | Iop(Iextcall(_, true)) -> ++ all_phys_regs ++ | Iop(Iextcall(_, false)) -> ++ destroyed_at_c_call ++ | Iop(Ialloc _) -> ++ [| reg_x15 |] ++ | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _)) -> ++ [| reg_d7 |] (* d7 / s7 destroyed *) ++ | _ -> [||] ++ ++let destroyed_at_raise = all_phys_regs ++ ++(* Maximal register pressure *) ++ ++let safe_register_pressure = function ++ | Iextcall(_, _) -> 8 ++ | Ialloc _ -> 25 ++ | _ -> 26 ++ ++let max_register_pressure = function ++ | Iextcall(_, _) -> [| 10; 8 |] ++ | Ialloc _ -> [| 25; 32 |] ++ | Iintoffloat | Ifloatofint ++ | Iload(Single, _) | Istore(Single, _) -> [| 26; 31 |] ++ | _ -> [| 26; 32 |] ++ ++(* 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/arm64/reload.ml b/asmcomp/arm64/reload.ml +new file mode 100644 +index 0000000..ff9214e +--- /dev/null ++++ b/asmcomp/arm64/reload.ml +@@ -0,0 +1,16 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* *) ++(* Copyright 2013 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 ARM 64 bits *) ++ ++let fundecl f = ++ (new Reloadgen.reload_generic)#fundecl f +diff --git a/asmcomp/arm64/scheduling.ml b/asmcomp/arm64/scheduling.ml +new file mode 100644 +index 0000000..cc244be +--- /dev/null ++++ b/asmcomp/arm64/scheduling.ml +@@ -0,0 +1,18 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* *) ++(* Copyright 2013 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. *) ++(* *) ++(***********************************************************************) ++ ++let _ = let module M = Schedgen in () (* to create a dependency *) ++ ++(* Scheduling is turned off because the processor schedules dynamically ++ much better than what we could do. *) ++ ++let fundecl f = f +diff --git a/asmcomp/arm64/selection.ml b/asmcomp/arm64/selection.ml +new file mode 100644 +index 0000000..c74b282 +--- /dev/null ++++ b/asmcomp/arm64/selection.ml +@@ -0,0 +1,265 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* Benedikt Meurer, University of Siegen *) ++(* *) ++(* Copyright 2013 Institut National de Recherche en Informatique *) ++(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) ++(* reserved. This file is distributed under the terms of the Q *) ++(* Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Instruction selection for the ARM processor *) ++ ++open Arch ++open Cmm ++open Mach ++ ++let is_offset chunk n = ++ (n >= -256 && n <= 255) (* 9 bits signed unscaled *) ++|| (n >= 0 && ++ match chunk with (* 12 bits unsigned, scaled by chunk size *) ++ | Byte_unsigned | Byte_signed -> ++ n < 0x1000 ++ | Sixteen_unsigned | Sixteen_signed -> ++ n land 1 = 0 && n lsr 1 < 0x1000 ++ | Thirtytwo_unsigned | Thirtytwo_signed | Single -> ++ n land 3 = 0 && n lsr 2 < 0x1000 ++ | Word | Double | Double_u -> ++ n land 7 = 0 && n lsr 3 < 0x1000) ++ ++(* An automaton to recognize ( 0+1+0* | 1+0+1* ) ++ ++ 0 1 0 ++ / \ / \ / \ ++ \ / \ / \ / ++ -0--> [1] --1--> [2] --0--> [3] ++ / ++ [0] ++ \ ++ -1--> [4] --0--> [5] --1--> [6] ++ / \ / \ / \ ++ \ / \ / \ / ++ 1 0 1 ++ ++The accepting states are 2, 3, 5 and 6. *) ++ ++let auto_table = [| (* accepting?, next on 0, next on 1 *) ++ (* state 0 *) (false, 1, 4); ++ (* state 1 *) (false, 1, 2); ++ (* state 2 *) (true, 3, 2); ++ (* state 3 *) (true, 3, 7); ++ (* state 4 *) (false, 5, 4); ++ (* state 5 *) (true, 5, 6); ++ (* state 6 *) (true, 7, 6); ++ (* state 7 *) (false, 7, 7) (* error state *) ++|] ++ ++let rec run_automata nbits state input = ++ let (acc, next0, next1) = auto_table.(state) in ++ if nbits <= 0 ++ then acc ++ else run_automata (nbits - 1) ++ (if input land 1 = 0 then next0 else next1) ++ (input asr 1) ++ ++(* We are very conservative wrt what ARM64 supports: we don't support ++ repetitions of a 000111000 or 1110000111 pattern, just a single ++ pattern of this kind. *) ++ ++let is_logical_immediate n = ++ n <> 0 && n <> -1 && run_automata 64 0 n ++ ++let is_intconst = function ++ Cconst_int _ -> true ++ | _ -> false ++ ++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 ++ ++(* Instruction selection *) ++ ++class selector = object(self) ++ ++inherit Selectgen.selector_generic as super ++ ++method is_immediate n = ++ let mn = -n in ++ n land 0xFFF = n || n land 0xFFF_000 = n ++ || mn land 0xFFF = mn || mn land 0xFFF_000 = mn ++ ++method! is_simple_expr = function ++ (* inlined floating-point ops are simple if their arguments are *) ++ | Cop(Cextcall(fn, _, _, _), args) when List.mem fn inline_ops -> ++ List.for_all self#is_simple_expr args ++ | e -> super#is_simple_expr e ++ ++method select_addressing chunk = function ++ | Cop(Cadda, [Cconst_symbol s; Cconst_int n]) ++ when use_direct_addressing s -> ++ (Ibased(s, n), Ctuple []) ++ | Cop(Cadda, [arg; Cconst_int n]) ++ when is_offset chunk n -> ++ (Iindexed n, arg) ++ | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) ++ when is_offset chunk n -> ++ (Iindexed n, Cop(Cadda, [arg1; arg2])) ++ | Cconst_symbol s ++ when use_direct_addressing s -> ++ (Ibased(s, 0), Ctuple []) ++ | arg -> ++ (Iindexed 0, arg) ++ ++method! select_operation op args = ++ match op with ++ (* Integer addition *) ++ | Caddi | Cadda -> ++ begin match args with ++ (* Add immediate *) ++ | [arg; Cconst_int n] | [Cconst_int n; arg] when self#is_immediate n -> ++ ((if n >= 0 then Iintop_imm(Iadd, n) else Iintop_imm(Isub, -n)), ++ [arg]) ++ (* Shift-add *) ++ | [arg1; Cop(Clsl, [arg2; Cconst_int n])] when n > 0 && n < 64 -> ++ (Ispecific(Ishiftarith(Ishiftadd, n)), [arg1; arg2]) ++ | [arg1; Cop(Casr, [arg2; Cconst_int n])] when n > 0 && n < 64 -> ++ (Ispecific(Ishiftarith(Ishiftadd, -n)), [arg1; arg2]) ++ | [Cop(Clsl, [arg1; Cconst_int n]); arg2] when n > 0 && n < 64 -> ++ (Ispecific(Ishiftarith(Ishiftadd, n)), [arg2; arg1]) ++ | [Cop(Casr, [arg1; Cconst_int n]); arg2] when n > 0 && n < 64 -> ++ (Ispecific(Ishiftarith(Ishiftadd, -n)), [arg2; arg1]) ++ (* Multiply-add *) ++ | [arg1; Cop(Cmuli, args2)] | [Cop(Cmuli, args2); arg1] -> ++ begin match self#select_operation Cmuli args2 with ++ | (Iintop_imm(Ilsl, l), [arg3]) -> ++ (Ispecific(Ishiftarith(Ishiftadd, l)), [arg1; arg3]) ++ | (Iintop Imul, [arg3; arg4]) -> ++ (Ispecific Imuladd, [arg3; arg4; arg1]) ++ | _ -> ++ super#select_operation op args ++ end ++ | _ -> ++ super#select_operation op args ++ end ++ (* Integer subtraction *) ++ | Csubi | Csuba -> ++ begin match args with ++ (* Sub immediate *) ++ | [arg; Cconst_int n] when self#is_immediate n -> ++ ((if n >= 0 then Iintop_imm(Isub, n) else Iintop_imm(Iadd, -n)), ++ [arg]) ++ (* Shift-sub *) ++ | [arg1; Cop(Clsl, [arg2; Cconst_int n])] when n > 0 && n < 64 -> ++ (Ispecific(Ishiftarith(Ishiftsub, n)), [arg1; arg2]) ++ | [arg1; Cop(Casr, [arg2; Cconst_int n])] when n > 0 && n < 64 -> ++ (Ispecific(Ishiftarith(Ishiftsub, -n)), [arg1; arg2]) ++ (* Multiply-sub *) ++ | [arg1; Cop(Cmuli, args2)] -> ++ begin match self#select_operation Cmuli args2 with ++ | (Iintop_imm(Ilsl, l), [arg3]) -> ++ (Ispecific(Ishiftarith(Ishiftsub, l)), [arg1; arg3]) ++ | (Iintop Imul, [arg3; arg4]) -> ++ (Ispecific Imulsub, [arg3; arg4; arg1]) ++ | _ -> ++ super#select_operation op args ++ end ++ | _ -> ++ super#select_operation op args ++ end ++ (* Checkbounds *) ++ | Ccheckbound _ -> ++ begin match args with ++ | [Cop(Clsr, [arg1; Cconst_int n]); arg2] when n > 0 && n < 64 -> ++ (Ispecific(Ishiftcheckbound n), [arg1; arg2]) ++ | _ -> ++ super#select_operation op args ++ end ++ (* Integer multiplication *) ++ (* ARM does not support immediate operands for multiplication *) ++ | Cmuli -> ++ begin match args with ++ | [arg; Cconst_int n] | [Cconst_int n; arg] -> ++ let l = Misc.log2 n in ++ if n = 1 lsl l ++ then (Iintop_imm(Ilsl, l), [arg]) ++ else (Iintop Imul, args) ++ | _ -> ++ (Iintop Imul, args) ++ end ++ (* Division and modulus *) ++ (* Recognize (x / cst) and (x % cst) only if cst is a power of 2. *) ++ | Cdivi -> ++ begin match args with ++ | [arg; Cconst_int n] when n = 1 lsl Misc.log2 n -> ++ ((if n = 1 then Imove else Iintop_imm(Idiv, n)), [arg]) ++ | _ -> ++ (Iintop Idiv, args) ++ end ++ | Cmodi -> ++ begin match args with ++ | [arg; Cconst_int n] when n = 1 lsl Misc.log2 n -> ++ ((if n = 1 then Iconst_int 0n else Iintop_imm(Imod, n)), [arg]) ++ | _ -> ++ (Iintop Imod, args) ++ end ++ (* Bitwise logical operations 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 floating-point negate and multiply *) ++ | Cnegf -> ++ begin match args with ++ | [Cop(Cmulf, args)] -> (Ispecific Inegmulf, args) ++ | _ -> super#select_operation op args ++ end ++ (* Recognize floating-point multiply and add/sub *) ++ | Caddf -> ++ begin match args with ++ | [arg; Cop(Cmulf, args)] | [Cop(Cmulf, args); arg] -> ++ (Ispecific Imuladdf, arg :: args) ++ | _ -> ++ super#select_operation op args ++ end ++ | Csubf -> ++ begin match args with ++ | [arg; Cop(Cmulf, args)] -> ++ (Ispecific Imulsubf, arg :: args) ++ | [Cop(Cmulf, args); arg] -> ++ (Ispecific Inegmulsubf, arg :: args) ++ | _ -> ++ super#select_operation op args ++ end ++ (* Recognize floating-point square root *) ++ | Cextcall("sqrt", _, _, _) -> ++ (Ispecific Isqrtf, args) ++ (* Recognize bswap instructions *) ++ | Cextcall("caml_bswap16_direct", _, _, _) -> ++ (Ispecific(Ibswap 16), args) ++ | Cextcall("caml_int32_direct_bswap", _, _, _) -> ++ (Ispecific(Ibswap 32), args) ++ | Cextcall(("caml_int64_direct_bswap"|"caml_nativeint_direct_bswap"), ++ _, _, _) -> ++ (Ispecific (Ibswap 64), args) ++ (* Other operations are regular *) ++ | _ -> ++ super#select_operation op args ++ ++method select_logical op = function ++ | [arg; Cconst_int n] when is_logical_immediate n -> ++ (Iintop_imm(op, n), [arg]) ++ | [Cconst_int n; arg] when is_logical_immediate n -> ++ (Iintop_imm(op, n), [arg]) ++ | args -> ++ (Iintop op, args) ++ ++end ++ ++let fundecl f = (new selector)#emit_fundecl f +diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml +index 17870c9..280b131 100644 +--- a/asmcomp/compilenv.ml ++++ b/asmcomp/compilenv.ml +@@ -83,6 +83,15 @@ let make_symbol ?(unitname = current_unit.ui_symbol) idopt = + | None -> prefix + | Some id -> prefix ^ "__" ^ id + ++let symbol_in_current_unit name = ++ let prefix = "caml" ^ current_unit.ui_symbol in ++ name = prefix || ++ (let lp = String.length prefix in ++ String.length name >= 2 + lp ++ && String.sub name 0 lp = prefix ++ && name.[lp] = '_' ++ && name.[lp + 1] = '_') ++ + let read_unit_info filename = + let ic = open_in_bin filename in + try +diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli +index 51cb8c6..9ffb145 100644 +--- a/asmcomp/compilenv.mli ++++ b/asmcomp/compilenv.mli +@@ -31,6 +31,10 @@ val make_symbol: ?unitname:string -> string option -> string + corresponds to symbol [id] in the compilation unit [u] + (or the current unit). *) + ++val symbol_in_current_unit: string -> bool ++ (* Return true if the given asm symbol belongs to the ++ current compilation unit, false otherwise. *) ++ + val symbol_for_global: Ident.t -> string + (* Return the asm symbol that refers to the given global identifier *) + +diff --git a/asmrun/arm64.S b/asmrun/arm64.S +new file mode 100644 +index 0000000..de670e6 +--- /dev/null ++++ b/asmrun/arm64.S +@@ -0,0 +1,535 @@ ++/***********************************************************************/ ++/* */ ++/* OCaml */ ++/* */ ++/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ ++/* */ ++/* Copyright 2013 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, ARM processor, 64-bit mode */ ++/* Must be preprocessed by cpp */ ++ ++/* Special registers */ ++ ++#define TRAP_PTR x26 ++#define ALLOC_PTR x27 ++#define ALLOC_LIMIT x28 ++#define ARG x15 ++#define TMP x16 ++#define TMP2 x17 ++ ++/* Support for CFI directives */ ++ ++#if defined(ASM_CFI_SUPPORTED) ++#define CFI_STARTPROC .cfi_startproc ++#define CFI_ENDPROC .cfi_endproc ++#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n ++#else ++#define CFI_STARTPROC ++#define CFI_ENDPROC ++#define CFI_ADJUST(n) ++#endif ++ ++/* Support for profiling with gprof */ ++ ++#define PROFILE ++ ++/* Macros to load and store global variables. Destroy TMP2 */ ++ ++#if defined(__PIC__) ++ ++#define ADDRGLOBAL(reg,symb) \ ++ adrp TMP2, :got:symb; \ ++ ldr reg, [TMP2, #:got_lo12:symb] ++ ++#define LOADGLOBAL(reg,symb) \ ++ ADDRGLOBAL(TMP2,symb); \ ++ ldr reg, [TMP2] ++ ++#define STOREGLOBAL(reg,symb) \ ++ ADDRGLOBAL(TMP2,symb); \ ++ str reg, [TMP2] ++ ++#else ++ ++#define ADDRGLOBAL(reg,symb) \ ++ adrp reg, symb; \ ++ add reg, reg, #:lo12:symb ++ ++#define LOADGLOBAL(reg,symb) \ ++ adrp TMP2, symb; \ ++ ldr reg, [TMP2, #:lo12:symb] ++ ++#define STOREGLOBAL(reg,symb) \ ++ adrp TMP2, symb; \ ++ str reg, [TMP2, #:lo12:symb] ++ ++#endif ++ ++/* Allocation functions and GC interface */ ++ ++ .globl caml_system__code_begin ++caml_system__code_begin: ++ ++ .align 2 ++ .globl caml_call_gc ++caml_call_gc: ++ CFI_STARTPROC ++ PROFILE ++ /* Record return address */ ++ STOREGLOBAL(x30, caml_last_return_address) ++.Lcaml_call_gc: ++ /* Record lowest stack address */ ++ mov TMP, sp ++ STOREGLOBAL(TMP, caml_bottom_of_stack) ++ /* Set up stack space, saving return address and frame pointer */ ++ /* (2 regs RA/GP, 24 allocatable int regs, 24 caller-save float regs) * 8 */ ++ stp x29, x30, [sp, -400]! ++ CFI_ADJUST(400) ++ add x29, sp, #0 ++ /* Save allocatable integer registers on the stack, in the order ++ given in proc.ml */ ++ stp x0, x1, [sp, 16] ++ stp x2, x3, [sp, 32] ++ stp x4, x5, [sp, 48] ++ stp x6, x7, [sp, 64] ++ stp x8, x9, [sp, 80] ++ stp x10, x11, [sp, 96] ++ stp x12, x13, [sp, 112] ++ stp x14, x15, [sp, 128] ++ stp x19, x20, [sp, 144] ++ stp x21, x22, [sp, 160] ++ stp x23, x24, [sp, 176] ++ str x25, [sp, 192] ++ /* Save caller-save floating-point registers on the stack ++ (callee-saves are preserved by caml_garbage_collection) */ ++ stp d0, d1, [sp, 208] ++ stp d2, d3, [sp, 224] ++ stp d4, d5, [sp, 240] ++ stp d6, d7, [sp, 256] ++ stp d16, d17, [sp, 272] ++ stp d18, d19, [sp, 288] ++ stp d20, d21, [sp, 304] ++ stp d22, d23, [sp, 320] ++ stp d24, d25, [sp, 336] ++ stp d26, d27, [sp, 352] ++ stp d28, d29, [sp, 368] ++ stp d30, d31, [sp, 384] ++ /* Store pointer to saved integer registers in caml_gc_regs */ ++ add TMP, sp, #16 ++ STOREGLOBAL(TMP, caml_gc_regs) ++ /* Save current allocation pointer for debugging purposes */ ++ STOREGLOBAL(ALLOC_PTR, caml_young_ptr) ++ /* Save trap pointer in case an exception is raised during GC */ ++ STOREGLOBAL(TRAP_PTR, caml_exception_pointer) ++ /* Call the garbage collector */ ++ bl caml_garbage_collection ++ /* Restore registers */ ++ ldp x0, x1, [sp, 16] ++ ldp x2, x3, [sp, 32] ++ ldp x4, x5, [sp, 48] ++ ldp x6, x7, [sp, 64] ++ ldp x8, x9, [sp, 80] ++ ldp x10, x11, [sp, 96] ++ ldp x12, x13, [sp, 112] ++ ldp x14, x15, [sp, 128] ++ ldp x19, x20, [sp, 144] ++ ldp x21, x22, [sp, 160] ++ ldp x23, x24, [sp, 176] ++ ldr x25, [sp, 192] ++ ldp d0, d1, [sp, 208] ++ ldp d2, d3, [sp, 224] ++ ldp d4, d5, [sp, 240] ++ ldp d6, d7, [sp, 256] ++ ldp d16, d17, [sp, 272] ++ ldp d18, d19, [sp, 288] ++ ldp d20, d21, [sp, 304] ++ ldp d22, d23, [sp, 320] ++ ldp d24, d25, [sp, 336] ++ ldp d26, d27, [sp, 352] ++ ldp d28, d29, [sp, 368] ++ ldp d30, d31, [sp, 384] ++ /* Reload new allocation pointer and allocation limit */ ++ LOADGLOBAL(ALLOC_PTR, caml_young_ptr) ++ LOADGLOBAL(ALLOC_LIMIT, caml_young_limit) ++ /* Free stack space and return to caller */ ++ ldp x29, x30, [sp], 400 ++ ret ++ CFI_ENDPROC ++ .type caml_call_gc, %function ++ .size caml_call_gc, .-caml_call_gc ++ ++ .align 2 ++ .globl caml_alloc1 ++caml_alloc1: ++ CFI_STARTPROC ++ PROFILE ++1: sub ALLOC_PTR, ALLOC_PTR, #16 ++ cmp ALLOC_PTR, ALLOC_LIMIT ++ b.lo 2f ++ ret ++2: stp x29, x30, [sp, -16]! ++ CFI_ADJUST(16) ++ add x29, sp, #0 ++ /* Record return address */ ++ STOREGLOBAL(x30, caml_last_return_address) ++ /* Call GC */ ++ bl .Lcaml_call_gc ++ /* Restore return address */ ++ ldp x29, x30, [sp], 16 ++ CFI_ADJUST(-16) ++ /* Try again */ ++ b 1b ++ CFI_ENDPROC ++ .type caml_alloc1, %function ++ .size caml_alloc1, .-caml_alloc1 ++ ++ .align 2 ++ .globl caml_alloc2 ++caml_alloc2: ++ CFI_STARTPROC ++ PROFILE ++1: sub ALLOC_PTR, ALLOC_PTR, #24 ++ cmp ALLOC_PTR, ALLOC_LIMIT ++ b.lo 2f ++ ret ++2: stp x29, x30, [sp, -16]! ++ CFI_ADJUST(16) ++ add x29, sp, #0 ++ /* Record return address */ ++ STOREGLOBAL(x30, caml_last_return_address) ++ /* Call GC */ ++ bl .Lcaml_call_gc ++ /* Restore return address */ ++ ldp x29, x30, [sp], 16 ++ CFI_ADJUST(-16) ++ /* Try again */ ++ b 1b ++ CFI_ENDPROC ++ .type caml_alloc2, %function ++ .size caml_alloc2, .-caml_alloc2 ++ ++ .align 2 ++ .globl caml_alloc3 ++caml_alloc3: ++ CFI_STARTPROC ++ PROFILE ++1: sub ALLOC_PTR, ALLOC_PTR, #32 ++ cmp ALLOC_PTR, ALLOC_LIMIT ++ b.lo 2f ++ ret ++2: stp x29, x30, [sp, -16]! ++ CFI_ADJUST(16) ++ add x29, sp, #0 ++ /* Record return address */ ++ STOREGLOBAL(x30, caml_last_return_address) ++ /* Call GC */ ++ bl .Lcaml_call_gc ++ /* Restore return address */ ++ ldp x29, x30, [sp], 16 ++ CFI_ADJUST(-16) ++ /* Try again */ ++ b 1b ++ CFI_ENDPROC ++ .type caml_alloc2, %function ++ .size caml_alloc2, .-caml_alloc2 ++ ++ .align 2 ++ .globl caml_allocN ++caml_allocN: ++ CFI_STARTPROC ++ PROFILE ++1: sub ALLOC_PTR, ALLOC_PTR, ARG ++ cmp ALLOC_PTR, ALLOC_LIMIT ++ b.lo 2f ++ ret ++2: stp x29, x30, [sp, -16]! ++ CFI_ADJUST(16) ++ add x29, sp, #0 ++ /* Record return address */ ++ STOREGLOBAL(x30, caml_last_return_address) ++ /* Call GC. This preserves ARG */ ++ bl .Lcaml_call_gc ++ /* Restore return address */ ++ ldp x29, x30, [sp], 16 ++ CFI_ADJUST(-16) ++ /* Try again */ ++ b 1b ++ CFI_ENDPROC ++ .type caml_allocN, %function ++ .size caml_allocN, .-caml_allocN ++ ++/* Call a C function from OCaml */ ++/* Function to call is in ARG */ ++ ++ .align 2 ++ .globl caml_c_call ++caml_c_call: ++ CFI_STARTPROC ++ PROFILE ++ /* Preserve return address in callee-save register x19 */ ++ mov x19, x30 ++ /* Record lowest stack address and return address */ ++ STOREGLOBAL(x30, caml_last_return_address) ++ add TMP, sp, #0 ++ STOREGLOBAL(TMP, caml_bottom_of_stack) ++ /* Make the exception handler alloc ptr available to the C code */ ++ STOREGLOBAL(ALLOC_PTR, caml_young_ptr) ++ STOREGLOBAL(TRAP_PTR, caml_exception_pointer) ++ /* Call the function */ ++ blr ARG ++ /* Reload alloc ptr and alloc limit */ ++ LOADGLOBAL(ALLOC_PTR, caml_young_ptr) ++ LOADGLOBAL(ALLOC_LIMIT, caml_young_limit) ++ /* Return */ ++ ret x19 ++ CFI_ENDPROC ++ .type caml_c_call, %function ++ .size caml_c_call, .-caml_c_call ++ ++/* Start the OCaml program */ ++ ++ .align 2 ++ .globl caml_start_program ++caml_start_program: ++ CFI_STARTPROC ++ PROFILE ++ ADDRGLOBAL(ARG, caml_program) ++ ++/* Code shared with caml_callback* */ ++/* Address of OCaml code to call is in ARG */ ++/* Arguments to the OCaml code are in x0...x7 */ ++ ++.Ljump_to_caml: ++ /* Set up stack frame and save callee-save registers */ ++ stp x29, x30, [sp, -160]! ++ CFI_ADJUST(160) ++ add x29, sp, #0 ++ stp x19, x20, [sp, 16] ++ stp x21, x22, [sp, 32] ++ stp x23, x24, [sp, 48] ++ stp x25, x26, [sp, 64] ++ stp x27, x28, [sp, 80] ++ stp d8, d9, [sp, 96] ++ stp d10, d11, [sp, 112] ++ stp d12, d13, [sp, 128] ++ stp d14, d15, [sp, 144] ++ /* Setup a callback link on the stack */ ++ LOADGLOBAL(x8, caml_bottom_of_stack) ++ LOADGLOBAL(x9, caml_last_return_address) ++ LOADGLOBAL(x10, caml_gc_regs) ++ stp x8, x9, [sp, -32]! /* 16-byte alignment */ ++ CFI_ADJUST(32) ++ str x10, [sp, 16] ++ /* Setup a trap frame to catch exceptions escaping the OCaml code */ ++ LOADGLOBAL(x8, caml_exception_pointer) ++ adr x9, .Ltrap_handler ++ stp x8, x9, [sp, -16]! ++ CFI_ADJUST(16) ++ add TRAP_PTR, sp, #0 ++ /* Reload allocation pointers */ ++ LOADGLOBAL(ALLOC_PTR, caml_young_ptr) ++ LOADGLOBAL(ALLOC_LIMIT, caml_young_limit) ++ /* Call the OCaml code */ ++ blr ARG ++.Lcaml_retaddr: ++ /* Pop the trap frame, restoring caml_exception_pointer */ ++ ldr x8, [sp], 16 ++ CFI_ADJUST(-16) ++ STOREGLOBAL(x8, caml_exception_pointer) ++ /* Pop the callback link, restoring the global variables */ ++.Lreturn_result: ++ ldr x10, [sp, 16] ++ ldp x8, x9, [sp], 32 ++ CFI_ADJUST(-32) ++ STOREGLOBAL(x8, caml_bottom_of_stack) ++ STOREGLOBAL(x9, caml_last_return_address) ++ STOREGLOBAL(x10, caml_gc_regs) ++ /* Update allocation pointer */ ++ STOREGLOBAL(ALLOC_PTR, caml_young_ptr) ++ /* Reload callee-save registers and return address */ ++ ldp x19, x20, [sp, 16] ++ ldp x21, x22, [sp, 32] ++ ldp x23, x24, [sp, 48] ++ ldp x25, x26, [sp, 64] ++ ldp x27, x28, [sp, 80] ++ ldp d8, d9, [sp, 96] ++ ldp d10, d11, [sp, 112] ++ ldp d12, d13, [sp, 128] ++ ldp d14, d15, [sp, 144] ++ ldp x29, x30, [sp], 160 ++ CFI_ADJUST(-160) ++ /* Return to C caller */ ++ ret ++ CFI_ENDPROC ++ .type .Lcaml_retaddr, %function ++ .size .Lcaml_retaddr, .-.Lcaml_retaddr ++ .type caml_start_program, %function ++ .size caml_start_program, .-caml_start_program ++ ++/* The trap handler */ ++ ++ .align 2 ++.Ltrap_handler: ++ CFI_STARTPROC ++ /* Save exception pointer */ ++ STOREGLOBAL(TRAP_PTR, caml_exception_pointer) ++ /* Encode exception bucket as an exception result */ ++ orr x0, x0, #2 ++ /* Return it */ ++ b .Lreturn_result ++ CFI_ENDPROC ++ .type .Ltrap_handler, %function ++ .size .Ltrap_handler, .-.Ltrap_handler ++ ++/* Raise an exception from OCaml */ ++ ++ .align 2 ++ .globl caml_raise_exn ++caml_raise_exn: ++ CFI_STARTPROC ++ PROFILE ++ /* Test if backtrace is active */ ++ LOADGLOBAL(TMP, caml_backtrace_active) ++ cbnz TMP, 2f ++1: /* Cut stack at current trap handler */ ++ mov sp, TRAP_PTR ++ /* Pop previous handler and jump to it */ ++ ldr TMP, [sp, 8] ++ ldr TRAP_PTR, [sp], 16 ++ br TMP ++2: /* Preserve exception bucket in callee-save register x19 */ ++ mov x19, x0 ++ /* Stash the backtrace */ ++ /* arg1: exn bucket, already in x0 */ ++ mov x1, x30 /* arg2: pc of raise */ ++ add x2, sp, #0 /* arg3: sp of raise */ ++ mov x3, TRAP_PTR /* arg4: sp of handler */ ++ bl caml_stash_backtrace ++ /* Restore exception bucket and raise */ ++ mov x0, x19 ++ b 1b ++ CFI_ENDPROC ++ .type caml_raise_exn, %function ++ .size caml_raise_exn, .-caml_raise_exn ++ ++/* Raise an exception from C */ ++ ++ .align 2 ++ .globl caml_raise_exception ++caml_raise_exception: ++ CFI_STARTPROC ++ PROFILE ++ /* Reload trap ptr, alloc ptr and alloc limit */ ++ LOADGLOBAL(TRAP_PTR, caml_exception_pointer) ++ LOADGLOBAL(ALLOC_PTR, caml_young_ptr) ++ LOADGLOBAL(ALLOC_LIMIT, caml_young_limit) ++ /* Test if backtrace is active */ ++ LOADGLOBAL(TMP, caml_backtrace_active) ++ cbnz TMP, 2f ++1: /* Cut stack at current trap handler */ ++ mov sp, TRAP_PTR ++ /* Pop previous handler and jump to it */ ++ ldr TMP, [sp, 8] ++ ldr TRAP_PTR, [sp], 16 ++ br TMP ++2: /* Preserve exception bucket in callee-save register x19 */ ++ mov x19, x0 ++ /* Stash the backtrace */ ++ /* arg1: exn bucket, already in x0 */ ++ LOADGLOBAL(x1, caml_last_return_address) /* arg2: pc of raise */ ++ LOADGLOBAL(x2, caml_bottom_of_stack) /* arg3: sp of raise */ ++ mov x3, TRAP_PTR /* arg4: sp of handler */ ++ bl caml_stash_backtrace ++ /* Restore exception bucket and raise */ ++ mov x0, x19 ++ b 1b ++ CFI_ENDPROC ++ .type caml_raise_exception, %function ++ .size caml_raise_exception, .-caml_raise_exception ++ ++/* Callback from C to OCaml */ ++ ++ .align 2 ++ .globl caml_callback_exn ++caml_callback_exn: ++ CFI_STARTPROC ++ PROFILE ++ /* Initial shuffling of arguments (x0 = closure, x1 = first arg) */ ++ mov TMP, x0 ++ mov x0, x1 /* x0 = first arg */ ++ mov x1, TMP /* x1 = closure environment */ ++ ldr ARG, [TMP] /* code pointer */ ++ b .Ljump_to_caml ++ CFI_ENDPROC ++ .type caml_callback_exn, %function ++ .size caml_callback_exn, .-caml_callback_exn ++ ++ .align 2 ++ .globl caml_callback2_exn ++caml_callback2_exn: ++ CFI_STARTPROC ++ PROFILE ++ /* Initial shuffling of arguments (x0 = closure, x1 = arg1, x2 = arg2) */ ++ mov TMP, x0 ++ mov x0, x1 /* x0 = first arg */ ++ mov x1, x2 /* x1 = second arg ++ mov x2, TMP /* x2 = closure environment */ ++ ADDRGLOBAL(ARG, caml_apply2) ++ b .Ljump_to_caml ++ CFI_ENDPROC ++ .type caml_callback2_exn, %function ++ .size caml_callback2_exn, .-caml_callback2_exn ++ ++ .align 2 ++ .globl caml_callback3_exn ++caml_callback3_exn: ++ CFI_STARTPROC ++ PROFILE ++ /* Initial shuffling of arguments */ ++ /* (x0 = closure, x1 = arg1, x2 = arg2, x3 = arg3) */ ++ mov TMP, x0 ++ mov x0, x1 /* x0 = first arg */ ++ mov x1, x2 /* x1 = second arg */ ++ mov x2, x3 /* x2 = third arg */ ++ mov x3, TMP /* x3 = closure environment */ ++ ADDRGLOBAL(ARG, caml_apply3) ++ b .Ljump_to_caml ++ CFI_ENDPROC ++ .type caml_callback3_exn, %function ++ .size caml_callback3_exn, .-caml_callback3_exn ++ ++ .align 2 ++ .globl caml_ml_array_bound_error ++caml_ml_array_bound_error: ++ CFI_STARTPROC ++ PROFILE ++ /* Load address of [caml_array_bound_error] in ARG */ ++ ADDRGLOBAL(ARG, caml_array_bound_error) ++ /* Call that function */ ++ b caml_c_call ++ CFI_ENDPROC ++ .type caml_ml_array_bound_error, %function ++ .size caml_ml_array_bound_error, .-caml_ml_array_bound_error ++ ++ .globl caml_system__code_end ++caml_system__code_end: ++ ++/* GC roots for callback */ ++ ++ .data ++ .align 3 ++ .globl caml_system__frametable ++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 ++ .type caml_system__frametable, %object ++ .size caml_system__frametable, .-caml_system__frametable +diff --git a/asmrun/signals_osdep.h b/asmrun/signals_osdep.h +index ff19847..68ec837 100644 +--- a/asmrun/signals_osdep.h ++++ b/asmrun/signals_osdep.h +@@ -92,6 +92,25 @@ + #define CONTEXT_YOUNG_PTR (context->uc_mcontext.arm_r8) + #define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address) + ++/****************** ARM64, Linux */ ++ ++#elif defined(TARGET_arm64) && defined(SYS_linux) ++ ++ #include ++ ++ #define DECLARE_SIGNAL_HANDLER(name) \ ++ static void name(int sig, siginfo_t * info, ucontext_t * context) ++ ++ #define SET_SIGACT(sigact,name) \ ++ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \ ++ sigact.sa_flags = SA_SIGINFO ++ ++ typedef unsigned long context_reg; ++ #define CONTEXT_PC (context->uc_mcontext.pc) ++ #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.regs[26]) ++ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.regs[27]) ++ #define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address) ++ + /****************** AMD64, Solaris x86 */ + + #elif defined(TARGET_amd64) && defined (SYS_solaris) +diff --git a/asmrun/stack.h b/asmrun/stack.h +index 756db95..031e408 100644 +--- a/asmrun/stack.h ++++ b/asmrun/stack.h +@@ -65,6 +65,11 @@ + #define Callback_link(sp) ((struct caml_context *)((sp) + 16)) + #endif + ++#ifdef TARGET_arm64 ++#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/byterun/interp.c b/byterun/interp.c +index b99ed2f..af9fa0f 100644 +--- a/byterun/interp.c ++++ b/byterun/interp.c +@@ -173,6 +173,12 @@ sp is a local copy of the global variable caml_extern_sp. */ + #define SP_REG asm("%r14") + #define ACCU_REG asm("%r13") + #endif ++#ifdef __aarch64__ ++#define PC_REG asm("%x19") ++#define SP_REG asm("%x20") ++#define ACCU_REG asm("%x21") ++#define JUMPTBL_BASE_REG asm("%x22") ++#endif + #endif + + /* Division and modulus madness */ +diff --git a/configure b/configure +index 9bb9e9e..a0e1466 100755 +--- a/configure ++++ b/configure +@@ -661,6 +661,7 @@ if test $withsharedlibs = "yes"; then + x86_64-*-netbsd*) natdynlink=true;; + i386-*-gnu0.3) natdynlink=true;; + arm*-*-linux*) natdynlink=true;; ++ aarch64-*-linux*) natdynlink=true;; + esac + fi + +@@ -719,6 +720,7 @@ case "$host" in + x86_64-*-netbsd*) arch=amd64; system=netbsd;; + x86_64-*-openbsd*) arch=amd64; system=openbsd;; + x86_64-*-darwin*) arch=amd64; system=macosx;; ++ aarch64-*-linux*) arch=arm64; system=linux;; + x86_64-*-cygwin*) arch=amd64; system=cygwin;; + esac + +@@ -772,7 +774,7 @@ case "$arch,$model,$system" in + aspp='gcc -m64 -c';; + amd64,*,*) as='as' + aspp='gcc -c';; +- arm,*,*) as='as'; ++ arm,*,*|arm64,*,*)as='as'; + aspp='gcc -c';; + i386,*,solaris) as='as' + aspp='/usr/ccs/bin/as -P';; +@@ -1198,6 +1200,7 @@ case "$arch" in + fi;; + power) bng_arch=ppc; bng_asm_level=1;; + amd64) bng_arch=amd64; bng_asm_level=1;; ++ arm64) bng_arch=arm64; bng_asm_level=1;; + *) bng_arch=generic; bng_asm_level=0;; + esac + +diff --git a/otherlibs/num/bng.c b/otherlibs/num/bng.c +index 5bbedb0..0483ef5 100644 +--- a/otherlibs/num/bng.c ++++ b/otherlibs/num/bng.c +@@ -23,12 +23,10 @@ + #include "bng_amd64.c" + #elif defined(BNG_ARCH_ppc) + #include "bng_ppc.c" +-#elif defined (BNG_ARCH_alpha) +-#include "bng_alpha.c" + #elif defined (BNG_ARCH_sparc) + #include "bng_sparc.c" +-#elif defined (BNG_ARCH_mips) +-#include "bng_mips.c" ++#elif defined (BNG_ARCH_arm64) ++#include "bng_arm64.c" + #endif + #endif + +diff --git a/otherlibs/num/bng_arm64.c b/otherlibs/num/bng_arm64.c +new file mode 100644 +index 0000000..50843a0 +--- /dev/null ++++ b/otherlibs/num/bng_arm64.c +@@ -0,0 +1,20 @@ ++/***********************************************************************/ ++/* */ ++/* OCaml */ ++/* */ ++/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ ++/* */ ++/* Copyright 2013 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. */ ++/* */ ++/***********************************************************************/ ++ ++/* Code specific for the ARM 64 (AArch64) architecture */ ++ ++#define BngMult(resh,resl,arg1,arg2) \ ++ asm("mul %0, %2, %3 \n\t" \ ++ "umulh %1, %2, %3" \ ++ : "=&r" (resl), "=&r" (resh) \ ++ : "r" (arg1), "r" (arg2)) +diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile +index 98c2e4c..15fcb7c 100644 +--- a/testsuite/tests/asmcomp/Makefile ++++ b/testsuite/tests/asmcomp/Makefile +@@ -128,7 +128,7 @@ parsecmm.mli parsecmm.ml: parsecmm.mly + lexcmm.ml: lexcmm.mll + @$(OCAMLLEX) -q lexcmm.mll + +-CASES=fib tak quicksort quicksort2 soli \ ++CASES=fib tak quicksort quicksort2 soli integr \ + arith checkbound tagged-fib tagged-integr tagged-quicksort tagged-tak + ARGS_fib=-DINT_INT -DFUN=fib main.c + ARGS_tak=-DUNIT_INT -DFUN=takmain main.c +diff --git a/testsuite/tests/asmcomp/arm64.S b/testsuite/tests/asmcomp/arm64.S +new file mode 100644 +index 0000000..3bb4110 +--- /dev/null ++++ b/testsuite/tests/asmcomp/arm64.S +@@ -0,0 +1,52 @@ ++/***********************************************************************/ ++/* */ ++/* OCaml */ ++/* */ ++/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ ++/* */ ++/* Copyright 2013 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. */ ++/* */ ++/***********************************************************************/ ++ ++ .globl call_gen_code ++ .align 2 ++call_gen_code: ++ /* Set up stack frame and save callee-save registers */ ++ stp x29, x30, [sp, -160]! ++ add x29, sp, #0 ++ stp x19, x20, [sp, 16] ++ stp x21, x22, [sp, 32] ++ stp x23, x24, [sp, 48] ++ stp x25, x26, [sp, 64] ++ stp x27, x28, [sp, 80] ++ stp d8, d9, [sp, 96] ++ stp d10, d11, [sp, 112] ++ stp d12, d13, [sp, 128] ++ stp d14, d15, [sp, 144] ++ /* Shuffle arguments */ ++ mov x8, x0 ++ mov x0, x1 ++ mov x1, x2 ++ mov x2, x3 ++ mov x3, x4 ++ /* Call generated asm */ ++ blr x8 ++ /* Reload callee-save registers and return address */ ++ ldp x19, x20, [sp, 16] ++ ldp x21, x22, [sp, 32] ++ ldp x23, x24, [sp, 48] ++ ldp x25, x26, [sp, 64] ++ ldp x27, x28, [sp, 80] ++ ldp d8, d9, [sp, 96] ++ ldp d10, d11, [sp, 112] ++ ldp d12, d13, [sp, 128] ++ ldp d14, d15, [sp, 144] ++ ldp x29, x30, [sp], 160 ++ ret ++ ++ .globl caml_c_call ++ .align 2 ++caml_c_call: ++ br x15 +diff --git a/testsuite/tests/asmcomp/main.ml b/testsuite/tests/asmcomp/main.ml +index d67a643..82b699e 100644 +--- a/testsuite/tests/asmcomp/main.ml ++++ b/testsuite/tests/asmcomp/main.ml +@@ -13,6 +13,7 @@ + open Clflags + + let compile_file filename = ++ Clflags.dlcode := false; + Compilenv.reset "test"; + Emit.begin_assembly(); + let ic = open_in filename in +-- +2.0.4 + diff --git a/SOURCES/0009-Updated-with-latest-versions-from-FSF.patch b/SOURCES/0009-Updated-with-latest-versions-from-FSF.patch new file mode 100644 index 0000000..0bca3a4 --- /dev/null +++ b/SOURCES/0009-Updated-with-latest-versions-from-FSF.patch @@ -0,0 +1,716 @@ +From 77a24f7ba8023f1119454cac877285cfaef909e0 Mon Sep 17 00:00:00 2001 +From: Xavier Leroy +Date: Thu, 18 Jul 2013 16:07:25 +0000 +Subject: [PATCH 09/14] Updated with latest versions from FSF. + +git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13907 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 +(cherry picked from commit 24bb4caeb35e49126aa3a4c0101a412db1091213) +--- + config/gnu/config.guess | 196 ++++++++++++++++++++++++++++-------------------- + config/gnu/config.sub | 117 +++++++++++++++++------------ + 2 files changed, 183 insertions(+), 130 deletions(-) + +diff --git a/config/gnu/config.guess b/config/gnu/config.guess +index 8152efd..b79252d 100755 +--- a/config/gnu/config.guess ++++ b/config/gnu/config.guess +@@ -1,14 +1,12 @@ + #! /bin/sh + # Attempt to guess a canonical system name. +-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +-# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, +-# 2011 Free Software Foundation, Inc. ++# Copyright 1992-2013 Free Software Foundation, Inc. + +-timestamp='2011-11-11' ++timestamp='2013-06-10' + + # 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 +-# the Free Software Foundation; either version 2 of the License, or ++# the Free Software Foundation; either version 3 of the License, or + # (at your option) any later version. + # + # This program is distributed in the hope that it will be useful, but +@@ -17,26 +15,22 @@ timestamp='2011-11-11' + # General Public License for more details. + # + # You should have received a copy of the GNU General Public License +-# along with this program; if not, write to the Free Software +-# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA +-# 02110-1301, USA. ++# along with this program; if not, see . + # + # As a special exception to the GNU General Public License, if you + # distribute this file as part of a program that contains a + # configuration script generated by Autoconf, you may include it under +-# the same distribution terms that you use for the rest of that program. +- +- +-# Originally written by Per Bothner. Please send patches (context +-# diff format) to and include a ChangeLog +-# entry. ++# the same distribution terms that you use for the rest of that ++# program. This Exception is an additional permission under section 7 ++# of the GNU General Public License, version 3 ("GPLv3"). + # +-# This script attempts to guess a canonical system name similar to +-# config.sub. If it succeeds, it prints the system name on stdout, and +-# exits with 0. Otherwise, it exits with 1. ++# Originally written by Per Bothner. + # + # You can get the latest version of this script from: + # http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD ++# ++# Please send patches with a ChangeLog entry to config-patches@gnu.org. ++ + + me=`echo "$0" | sed -e 's,.*/,,'` + +@@ -56,9 +50,7 @@ version="\ + GNU config.guess ($timestamp) + + Originally written by Per Bothner. +-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, +-2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free +-Software Foundation, Inc. ++Copyright 1992-2013 Free Software Foundation, Inc. + + This is free software; see the source for copying conditions. There is NO + warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." +@@ -140,12 +132,33 @@ UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown + UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown + UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown + ++case "${UNAME_SYSTEM}" in ++Linux|GNU|GNU/*) ++ # If the system lacks a compiler, then just pick glibc. ++ # We could probably try harder. ++ LIBC=gnu ++ ++ eval $set_cc_for_build ++ cat <<-EOF > $dummy.c ++ #include ++ #if defined(__UCLIBC__) ++ LIBC=uclibc ++ #elif defined(__dietlibc__) ++ LIBC=dietlibc ++ #else ++ LIBC=gnu ++ #endif ++ EOF ++ eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` ++ ;; ++esac ++ + # Note: order is significant - the case branches are not exclusive. + + case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or +- # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, ++ # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward +@@ -202,6 +215,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "${machine}-${os}${release}" + exit ;; ++ *:Bitrig:*:*) ++ UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` ++ echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} ++ exit ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} +@@ -304,7 +321,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix${UNAME_RELEASE} + exit ;; +- arm:riscos:*:*|arm:RISCOS:*:*) ++ arm*:riscos:*:*|arm*:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) +@@ -803,6 +820,9 @@ EOF + i*:CYGWIN*:*) + echo ${UNAME_MACHINE}-pc-cygwin + exit ;; ++ *:MINGW64*:*) ++ echo ${UNAME_MACHINE}-pc-mingw64 ++ exit ;; + *:MINGW*:*) + echo ${UNAME_MACHINE}-pc-mingw32 + exit ;; +@@ -854,15 +874,22 @@ EOF + exit ;; + *:GNU:*:*) + # the GNU system +- echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` ++ echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland +- echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu ++ echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC} + exit ;; + i*86:Minix:*:*) + echo ${UNAME_MACHINE}-pc-minix + exit ;; ++ aarch64:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++ exit ;; ++ aarch64_be:Linux:*:*) ++ UNAME_MACHINE=aarch64_be ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++ exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; +@@ -874,59 +901,54 @@ EOF + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 +- if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi +- echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} ++ if test "$?" = 0 ; then LIBC="gnulibc1" ; fi ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++ exit ;; ++ arc:Linux:*:* | arceb:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then +- echo ${UNAME_MACHINE}-unknown-linux-gnueabi ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi + else +- echo ${UNAME_MACHINE}-unknown-linux-gnueabihf ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf + fi + fi + exit ;; + avr32*:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + cris:Linux:*:*) +- echo cris-axis-linux-gnu ++ echo ${UNAME_MACHINE}-axis-linux-${LIBC} + exit ;; + crisv32:Linux:*:*) +- echo crisv32-axis-linux-gnu ++ echo ${UNAME_MACHINE}-axis-linux-${LIBC} + exit ;; + frv:Linux:*:*) +- echo frv-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + hexagon:Linux:*:*) +- echo hexagon-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + i*86:Linux:*:*) +- LIBC=gnu +- eval $set_cc_for_build +- sed 's/^ //' << EOF >$dummy.c +- #ifdef __dietlibc__ +- LIBC=dietlibc +- #endif +-EOF +- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` +- echo "${UNAME_MACHINE}-pc-linux-${LIBC}" ++ echo ${UNAME_MACHINE}-pc-linux-${LIBC} + exit ;; + ia64:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + m32r*:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + m68*:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + mips:Linux:*:* | mips64:Linux:*:*) + eval $set_cc_for_build +@@ -945,54 +967,63 @@ EOF + #endif + EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` +- test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ++ test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; } + ;; ++ or1k:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++ exit ;; + or32:Linux:*:*) +- echo or32-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + padre:Linux:*:*) +- echo sparc-unknown-linux-gnu ++ echo sparc-unknown-linux-${LIBC} + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) +- echo hppa64-unknown-linux-gnu ++ echo hppa64-unknown-linux-${LIBC} + exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in +- PA7*) echo hppa1.1-unknown-linux-gnu ;; +- PA8*) echo hppa2.0-unknown-linux-gnu ;; +- *) echo hppa-unknown-linux-gnu ;; ++ PA7*) echo hppa1.1-unknown-linux-${LIBC} ;; ++ PA8*) echo hppa2.0-unknown-linux-${LIBC} ;; ++ *) echo hppa-unknown-linux-${LIBC} ;; + esac + exit ;; + ppc64:Linux:*:*) +- echo powerpc64-unknown-linux-gnu ++ echo powerpc64-unknown-linux-${LIBC} + exit ;; + ppc:Linux:*:*) +- echo powerpc-unknown-linux-gnu ++ echo powerpc-unknown-linux-${LIBC} ++ exit ;; ++ ppc64le:Linux:*:*) ++ echo powerpc64le-unknown-linux-${LIBC} ++ exit ;; ++ ppcle:Linux:*:*) ++ echo powerpcle-unknown-linux-${LIBC} + exit ;; + s390:Linux:*:* | s390x:Linux:*:*) +- echo ${UNAME_MACHINE}-ibm-linux ++ echo ${UNAME_MACHINE}-ibm-linux-${LIBC} + exit ;; + sh64*:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + sh*:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + tile*:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + vax:Linux:*:*) +- echo ${UNAME_MACHINE}-dec-linux-gnu ++ echo ${UNAME_MACHINE}-dec-linux-${LIBC} + exit ;; + x86_64:Linux:*:*) +- echo x86_64-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + xtensa*:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. +@@ -1196,6 +1227,9 @@ EOF + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; ++ x86_64:Haiku:*:*) ++ echo x86_64-unknown-haiku ++ exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} + exit ;; +@@ -1222,19 +1256,21 @@ EOF + exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown +- case $UNAME_PROCESSOR in +- i386) +- eval $set_cc_for_build +- if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then +- if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ +- (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ +- grep IS_64BIT_ARCH >/dev/null +- then +- UNAME_PROCESSOR="x86_64" +- fi +- fi ;; +- unknown) UNAME_PROCESSOR=powerpc ;; +- esac ++ eval $set_cc_for_build ++ if test "$UNAME_PROCESSOR" = unknown ; then ++ UNAME_PROCESSOR=powerpc ++ fi ++ if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then ++ if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ ++ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ ++ grep IS_64BIT_ARCH >/dev/null ++ then ++ case $UNAME_PROCESSOR in ++ i386) UNAME_PROCESSOR=x86_64 ;; ++ powerpc) UNAME_PROCESSOR=powerpc64 ;; ++ esac ++ fi ++ fi + echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} + exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) +@@ -1251,7 +1287,7 @@ EOF + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; +- NSE-?:NONSTOP_KERNEL:*:*) ++ NSE-*:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk${UNAME_RELEASE} + exit ;; + NSR-?:NONSTOP_KERNEL:*:*) +@@ -1320,11 +1356,11 @@ EOF + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; ++ x86_64:VMkernel:*:*) ++ echo ${UNAME_MACHINE}-unknown-esx ++ exit ;; + esac + +-#echo '(No uname command or uname output not recognized.)' 1>&2 +-#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 +- + eval $set_cc_for_build + cat >$dummy.c <. + # + # As a special exception to the GNU General Public License, if you + # distribute this file as part of a program that contains a + # configuration script generated by Autoconf, you may include it under +-# the same distribution terms that you use for the rest of that program. ++# the same distribution terms that you use for the rest of that ++# program. This Exception is an additional permission under section 7 ++# of the GNU General Public License, version 3 ("GPLv3"). + + +-# Please send patches to . Submit a context +-# diff and a properly formatted GNU ChangeLog entry. ++# Please send patches with a ChangeLog entry to config-patches@gnu.org. + # + # Configuration subroutine to validate and canonicalize a configuration type. + # Supply the specified configuration type as an argument. +@@ -75,9 +68,7 @@ Report bugs and patches to ." + version="\ + GNU config.sub ($timestamp) + +-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, +-2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free +-Software Foundation, Inc. ++Copyright 1992-2013 Free Software Foundation, Inc. + + This is free software; see the source for copying conditions. There is NO + warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." +@@ -125,13 +116,17 @@ esac + maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` + case $maybe_os in + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ +- linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ ++ linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) + os=-$maybe_os + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` + ;; ++ android-linux) ++ os=-linux-android ++ basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown ++ ;; + *) + basic_machine=`echo $1 | sed 's/-[^-]*$//'` + if [ $basic_machine != $1 ] +@@ -154,7 +149,7 @@ case $os in + -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ + -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ + -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ +- -apple | -axis | -knuth | -cray | -microblaze) ++ -apple | -axis | -knuth | -cray | -microblaze*) + os= + basic_machine=$1 + ;; +@@ -223,6 +218,12 @@ case $os in + -isc*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; ++ -lynx*178) ++ os=-lynxos178 ++ ;; ++ -lynx*5) ++ os=-lynxos5 ++ ;; + -lynx*) + os=-lynxos + ;; +@@ -247,11 +248,14 @@ case $basic_machine in + # Some are omitted here because they have special meanings below. + 1750a | 580 \ + | a29k \ ++ | aarch64 | aarch64_be \ + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ + | am33_2.0 \ +- | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ +- | be32 | be64 \ ++ | arc | arceb \ ++ | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ ++ | avr | avr32 \ ++ | be32 | be64 \ + | bfin \ + | c4x | clipper \ + | d10v | d30v | dlx | dsp16xx \ +@@ -264,7 +268,7 @@ case $basic_machine in + | le32 | le64 \ + | lm32 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ +- | maxq | mb | microblaze | mcore | mep | metag \ ++ | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ +@@ -282,16 +286,17 @@ case $basic_machine in + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ ++ | mipsr5900 | mipsr5900el \ + | mipstx39 | mipstx39el \ + | mn10200 | mn10300 \ + | moxie \ + | mt \ + | msp430 \ + | nds32 | nds32le | nds32be \ +- | nios | nios2 \ ++ | nios | nios2 | nios2eb | nios2el \ + | ns16k | ns32k \ + | open8 \ +- | or32 \ ++ | or1k | or32 \ + | pdp10 | pdp11 | pj | pjl \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ + | pyramid \ +@@ -319,8 +324,7 @@ case $basic_machine in + c6x) + basic_machine=tic6x-unknown + ;; +- m6811 | m68hc11 | m6812 | m68hc12 | picochip) +- # Motorola 68HC11/12. ++ m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) + basic_machine=$basic_machine-unknown + os=-none + ;; +@@ -333,7 +337,10 @@ case $basic_machine in + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; +- ++ xgate) ++ basic_machine=$basic_machine-unknown ++ os=-none ++ ;; + xscaleeb) + basic_machine=armeb-unknown + ;; +@@ -356,9 +363,10 @@ case $basic_machine in + # Recognize the basic CPU types with company name. + 580-* \ + | a29k-* \ ++ | aarch64-* | aarch64_be-* \ + | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ + | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ +- | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ ++ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \ + | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ + | avr-* | avr32-* \ + | be32-* | be64-* \ +@@ -377,7 +385,8 @@ case $basic_machine in + | lm32-* \ + | m32c-* | m32r-* | m32rle-* \ + | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ +- | m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \ ++ | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ ++ | microblaze-* | microblazeel-* \ + | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ + | mips16-* \ + | mips64-* | mips64el-* \ +@@ -395,12 +404,13 @@ case $basic_machine in + | mipsisa64r2-* | mipsisa64r2el-* \ + | mipsisa64sb1-* | mipsisa64sb1el-* \ + | mipsisa64sr71k-* | mipsisa64sr71kel-* \ ++ | mipsr5900-* | mipsr5900el-* \ + | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ + | msp430-* \ + | nds32-* | nds32le-* | nds32be-* \ +- | nios-* | nios2-* \ ++ | nios-* | nios2-* | nios2eb-* | nios2el-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ + | orion-* \ +@@ -719,7 +729,6 @@ case $basic_machine in + i370-ibm* | ibm*) + basic_machine=i370-ibm + ;; +-# I'm not sure what "Sysv32" means. Should this be sysv3.2? + i*86v32) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv32 +@@ -777,9 +786,13 @@ case $basic_machine in + basic_machine=ns32k-utek + os=-sysv + ;; +- microblaze) ++ microblaze*) + basic_machine=microblaze-xilinx + ;; ++ mingw64) ++ basic_machine=x86_64-pc ++ os=-mingw64 ++ ;; + mingw32) + basic_machine=i386-pc + os=-mingw32 +@@ -1008,7 +1021,11 @@ case $basic_machine in + basic_machine=i586-unknown + os=-pw32 + ;; +- rdos) ++ rdos | rdos64) ++ basic_machine=x86_64-pc ++ os=-rdos ++ ;; ++ rdos32) + basic_machine=i386-pc + os=-rdos + ;; +@@ -1335,21 +1352,21 @@ case $os in + -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ +- | -sym* | -kopensolaris* \ ++ | -sym* | -kopensolaris* | -plan9* \ + | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ + | -aos* | -aros* \ + | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ + | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ +- | -openbsd* | -solidbsd* \ ++ | -bitrig* | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ + | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ +- | -mingw32* | -linux-gnu* | -linux-android* \ +- | -linux-newlib* | -linux-uclibc* \ ++ | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ ++ | -linux-newlib* | -linux-musl* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ + | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ + | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ +@@ -1481,9 +1498,6 @@ case $os in + -aros*) + os=-aros + ;; +- -kaos*) +- os=-kaos +- ;; + -zvmoe) + os=-zvmoe + ;; +@@ -1532,6 +1546,9 @@ case $basic_machine in + c4x-* | tic4x-*) + os=-coff + ;; ++ hexagon-*) ++ os=-elf ++ ;; + tic54x-*) + os=-coff + ;; +@@ -1559,9 +1576,6 @@ case $basic_machine in + ;; + m68000-sun) + os=-sunos3 +- # This also exists in the configure program, but was not the +- # default. +- # os=-sunos4 + ;; + m68*-cisco) + os=-aout +@@ -1575,6 +1589,9 @@ case $basic_machine in + mips*-*) + os=-elf + ;; ++ or1k-*) ++ os=-elf ++ ;; + or32-*) + os=-coff + ;; +-- +2.0.4 + diff --git a/SOURCES/0010-arm64-Align-code-and-data-to-8-bytes.patch b/SOURCES/0010-arm64-Align-code-and-data-to-8-bytes.patch new file mode 100644 index 0000000..e26f4d3 --- /dev/null +++ b/SOURCES/0010-arm64-Align-code-and-data-to-8-bytes.patch @@ -0,0 +1,41 @@ +From 30c30cdc0b2d0af7aa05048345f272de77aba6cb Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Mon, 24 Mar 2014 05:50:28 -0500 +Subject: [PATCH 10/14] arm64: Align code and data to 8 bytes. + +Insufficient alignment seems to be the cause of relocation errors when +linking large native code OCaml programs: + + (.text+0xc): relocation truncated to fit: R_AARCH64_LDST64_ABS_LO12_NC against symbol `camlOdoc_type' defined in .data section in odoc_type.o +../stdlib/stdlib.a(listLabels.o): In function `camlListLabels__entry': +(.text+0x10): relocation truncated to fit: R_AARCH64_LDST64_ABS_LO12_NC against symbol `camlListLabels' defined in .data section in ../stdlib/stdlib.a(listLabels.o) + +PR#6283 http://caml.inria.fr/mantis/view.php?id=6283 +--- + asmcomp/arm64/emit.mlp | 3 ++- + 1 file changed, 2 insertions(+), 1 deletion(-) + +diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp +index fc9649c..4e7c4b0 100644 +--- a/asmcomp/arm64/emit.mlp ++++ b/asmcomp/arm64/emit.mlp +@@ -651,7 +651,7 @@ let fundecl fundecl = + call_gc_sites := []; + bound_error_sites := []; + ` .text\n`; +- ` .align 2\n`; ++ ` .align 3\n`; + ` .globl {emit_symbol fundecl.fun_name}\n`; + ` .type {emit_symbol fundecl.fun_name}, %function\n`; + `{emit_symbol fundecl.fun_name}:\n`; +@@ -692,6 +692,7 @@ let emit_item = function + + let data l = + ` .data\n`; ++ ` .align 3\n`; + List.iter emit_item l + + (* Beginning / end of an assembly file *) +-- +2.0.4 + diff --git a/SOURCES/0011-arg-Add-no_arg-and-get_arg-helper-functions.patch b/SOURCES/0011-arg-Add-no_arg-and-get_arg-helper-functions.patch new file mode 100644 index 0000000..ba765bf --- /dev/null +++ b/SOURCES/0011-arg-Add-no_arg-and-get_arg-helper-functions.patch @@ -0,0 +1,118 @@ +From c647e7cc2df2cad5a3e811dc7b3519960eb67da4 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 1 Apr 2014 11:17:07 +0100 +Subject: [PATCH 11/14] arg: Add no_arg and get_arg helper functions. + +The no_arg function in this patch is a no-op. It will do something +useful in the followups. + +The get_arg function simply checks the next position on the command +line exists and returns that argument or raises a Arg.Missing. + +This patch should introduce no functional change, it is simply code +refactoring. + +In particular, this should not change the treatment of Arg.current +(see: http://caml.inria.fr/mantis/view.php?id=5197#c11147) +--- + stdlib/arg.ml | 47 ++++++++++++++++++++++++++--------------------- + 1 file changed, 26 insertions(+), 21 deletions(-) + +diff --git a/stdlib/arg.ml b/stdlib/arg.ml +index 8b64236..c8b3d44 100644 +--- a/stdlib/arg.ml ++++ b/stdlib/arg.ml +@@ -134,56 +134,62 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = + try assoc3 s !speclist + with Not_found -> stop (Unknown s) + in ++ let no_arg () = () in ++ let get_arg () = ++ if !current + 1 < l then argv.(!current + 1) ++ else stop (Missing s) ++ in + begin try + let rec treat_action = function +- | Unit f -> f (); +- | Bool f when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Unit f -> no_arg (); f (); ++ | Bool f -> ++ let arg = get_arg () in + begin try f (bool_of_string arg) + with Invalid_argument "bool_of_string" -> + raise (Stop (Wrong (s, arg, "a boolean"))) + end; + incr current; +- | Set r -> r := true; +- | Clear r -> r := false; +- | String f when !current + 1 < l -> +- f argv.(!current + 1); ++ | Set r -> no_arg (); r := true; ++ | Clear r -> no_arg (); r := false; ++ | String f -> ++ let arg = get_arg () in ++ f arg; + incr current; +- | Symbol (symb, f) when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Symbol (symb, f) -> ++ let arg = get_arg () in + if List.mem arg symb then begin +- f argv.(!current + 1); ++ f arg; + incr current; + end else begin + raise (Stop (Wrong (s, arg, "one of: " + ^ (make_symlist "" " " "" symb)))) + end +- | Set_string r when !current + 1 < l -> +- r := argv.(!current + 1); ++ | Set_string r -> ++ r := get_arg (); + incr current; +- | Int f when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Int f -> ++ let arg = get_arg () in + begin try f (int_of_string arg) + with Failure "int_of_string" -> + raise (Stop (Wrong (s, arg, "an integer"))) + end; + incr current; +- | Set_int r when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Set_int r -> ++ let arg = get_arg () in + begin try r := (int_of_string arg) + with Failure "int_of_string" -> + raise (Stop (Wrong (s, arg, "an integer"))) + end; + incr current; +- | Float f when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Float f -> ++ let arg = get_arg () in + begin try f (float_of_string arg); + with Failure "float_of_string" -> + raise (Stop (Wrong (s, arg, "a float"))) + end; + incr current; +- | Set_float r when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Set_float r -> ++ let arg = get_arg () in + begin try r := (float_of_string arg); + with Failure "float_of_string" -> + raise (Stop (Wrong (s, arg, "a float"))) +@@ -196,7 +202,6 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = + f argv.(!current + 1); + incr current; + done; +- | _ -> raise (Stop (Missing s)) + in + treat_action action + with Bad m -> stop (Message m); +-- +2.0.4 + diff --git a/SOURCES/0012-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch b/SOURCES/0012-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch new file mode 100644 index 0000000..3078448 --- /dev/null +++ b/SOURCES/0012-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch @@ -0,0 +1,84 @@ +From af99e796d142efa9fc9717dcff3df55a4e82e6ca Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 1 Apr 2014 11:21:40 +0100 +Subject: [PATCH 12/14] arg: Allow flags such as --flag=arg as well as --flag + arg. + +Allow flags to be followed directly by their argument, separated by an '=' +sign. This is consistent with what GNU getopt_long and many other +command line parsing libraries allow. + +Fix for the following issue: +http://caml.inria.fr/mantis/view.php?id=5197 +--- + stdlib/arg.ml | 30 ++++++++++++++++++++++++------ + stdlib/arg.mli | 3 ++- + 2 files changed, 26 insertions(+), 7 deletions(-) + +diff --git a/stdlib/arg.ml b/stdlib/arg.ml +index c8b3d44..50d6e46 100644 +--- a/stdlib/arg.ml ++++ b/stdlib/arg.ml +@@ -55,6 +55,12 @@ let rec assoc3 x l = + | _ :: t -> assoc3 x t + ;; + ++let split s = ++ let i = String.index s '=' in ++ let len = String.length s in ++ String.sub s 0 i, String.sub s (i+1) (len-(i+1)) ++;; ++ + let make_symlist prefix sep suffix l = + match l with + | [] -> "" +@@ -130,14 +136,26 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = + while !current < l do + let s = argv.(!current) in + if String.length s >= 1 && String.get s 0 = '-' then begin +- let action = +- try assoc3 s !speclist +- with Not_found -> stop (Unknown s) ++ let action, follow = ++ try assoc3 s !speclist, None ++ with Not_found -> ++ try ++ let keyword, arg = split s in ++ assoc3 keyword !speclist, Some arg ++ with Not_found -> stop (Unknown s) + in +- let no_arg () = () in ++ let no_arg () = ++ match follow with ++ | None -> () ++ | Some arg -> stop (Wrong (s, arg, "no argument")) in + let get_arg () = +- if !current + 1 < l then argv.(!current + 1) +- else stop (Missing s) ++ match follow with ++ | None -> ++ if !current + 1 < l then argv.(!current + 1) ++ else stop (Missing s) ++ | Some arg -> ++ decr current; ++ arg + in + begin try + let rec treat_action = function +diff --git a/stdlib/arg.mli b/stdlib/arg.mli +index 869d030..b8c6f11 100644 +--- a/stdlib/arg.mli ++++ b/stdlib/arg.mli +@@ -25,7 +25,8 @@ + [Unit], [Set] and [Clear] keywords take no argument. A [Rest] + keyword takes the remaining of the command line as arguments. + Every other keyword takes the following word on the command line +- as argument. ++ as argument. For compatibility with GNU getopt_long, [keyword=arg] ++ is also allowed. + Arguments not preceded by a keyword are called anonymous arguments. + + Examples ([cmd] is assumed to be the command name): +-- +2.0.4 + diff --git a/SOURCES/0013-Add-support-for-ppc64le.patch b/SOURCES/0013-Add-support-for-ppc64le.patch new file mode 100644 index 0000000..a593537 --- /dev/null +++ b/SOURCES/0013-Add-support-for-ppc64le.patch @@ -0,0 +1,1917 @@ +From dbef48d3cb6424271e5d2296d16a3284db19cb25 Mon Sep 17 00:00:00 2001 +From: Michel Normand +Date: Tue, 18 Mar 2014 09:15:47 -0400 +Subject: [PATCH 13/14] Add support for ppc64le. + +Signed-off-by: Michel Normand +--- + asmcomp/power64le/arch.ml | 88 ++++ + asmcomp/power64le/emit.mlp | 981 ++++++++++++++++++++++++++++++++++++++++ + asmcomp/power64le/proc.ml | 240 ++++++++++ + asmcomp/power64le/reload.ml | 18 + + asmcomp/power64le/scheduling.ml | 65 +++ + asmcomp/power64le/selection.ml | 101 +++++ + asmrun/Makefile | 6 + + asmrun/power64-elf.S | 95 +++- + asmrun/power64le-elf.S | 1 + + asmrun/stack.h | 9 + + config/gnu/config.guess | 3 + + configure | 3 + + 12 files changed, 1609 insertions(+), 1 deletion(-) + create mode 100644 asmcomp/power64le/arch.ml + create mode 100644 asmcomp/power64le/emit.mlp + create mode 100644 asmcomp/power64le/proc.ml + create mode 100644 asmcomp/power64le/reload.ml + create mode 100644 asmcomp/power64le/scheduling.ml + create mode 100644 asmcomp/power64le/selection.ml + create mode 120000 asmrun/power64le-elf.S + +diff --git a/asmcomp/power64le/arch.ml b/asmcomp/power64le/arch.ml +new file mode 100644 +index 0000000..586534b +--- /dev/null ++++ b/asmcomp/power64le/arch.ml +@@ -0,0 +1,88 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 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. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: arch.ml 9547 2010-01-22 12:48:24Z doligez $ *) ++ ++(* Specific operations for the PowerPC processor *) ++ ++open Format ++ ++(* Machine-specific command-line options *) ++ ++let command_line_options = [] ++ ++(* Specific operations *) ++ ++type specific_operation = ++ Imultaddf (* multiply and add *) ++ | Imultsubf (* multiply and subtract *) ++ | Ialloc_far of int (* allocation in large functions *) ++ ++(* Addressing modes *) ++ ++type addressing_mode = ++ Ibased of string * int (* symbol + displ *) ++ | Iindexed of int (* reg + displ *) ++ | Iindexed2 (* reg + reg *) ++ ++(* Sizes, endianness *) ++ ++let big_endian = false ++ ++let size_addr = 8 ++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 ++ Ibased(s, n) -> Ibased(s, n + delta) ++ | Iindexed n -> Iindexed(n + delta) ++ | Iindexed2 -> assert false ++ ++let num_args_addressing = function ++ Ibased(s, n) -> 0 ++ | Iindexed n -> 1 ++ | Iindexed2 -> 2 ++ ++(* Printing operations and addressing modes *) ++ ++let print_addressing printreg addr ppf arg = ++ match addr with ++ | Ibased(s, n) -> ++ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in ++ fprintf ppf "\"%s\"%s" s idx ++ | Iindexed n -> ++ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in ++ fprintf ppf "%a%s" printreg arg.(0) idx ++ | Iindexed2 -> ++ fprintf ppf "%a + %a" printreg arg.(0) printreg arg.(1) ++ ++let print_specific_operation printreg op ppf arg = ++ match op with ++ | Imultaddf -> ++ fprintf ppf "%a *f %a +f %a" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Imultsubf -> ++ fprintf ppf "%a *f %a -f %a" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Ialloc_far n -> ++ fprintf ppf "alloc_far %d" n +diff --git a/asmcomp/power64le/emit.mlp b/asmcomp/power64le/emit.mlp +new file mode 100644 +index 0000000..5736a18 +--- /dev/null ++++ b/asmcomp/power64le/emit.mlp +@@ -0,0 +1,981 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 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. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: emit.mlp 9547 2010-01-22 12:48:24Z doligez $ *) ++ ++(* Emission of PowerPC assembly code *) ++ ++module StringSet = Set.Make(struct type t = string let compare = compare end) ++ ++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_size_lbl = ref 0 ++let stack_slot_lbl = ref 0 ++let stack_args_size = ref 0 ++let stack_traps_size = ref 0 ++ ++(* We have a stack frame of our own if we call other functions (including ++ use of exceptions, or if we need more than the red zone *) ++let has_stack_frame () = ++ if !contains_calls || (num_stack_slots.(0) + num_stack_slots.(1)) > (288-16)/8 then ++ true ++ else ++ false ++ ++let frame_size_sans_args () = ++ let size = 8 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + 48 in ++ Misc.align size 16 ++ ++let slot_offset loc cls = ++ match loc with ++ Local n -> ++ if cls = 0 ++ then (!stack_slot_lbl, num_stack_slots.(1) * 8 + n * 8) ++ else (!stack_slot_lbl, n * 8) ++ | Incoming n -> ((if has_stack_frame() then !stack_size_lbl else 0), 48 + n) ++ | Outgoing n -> (0, n) ++ ++(* Output a symbol *) ++ ++let emit_symbol = ++ match Config.system with ++ | "elf" | "bsd" -> (fun s -> Emitaux.emit_symbol '.' s) ++ | "rhapsody" -> (fun s -> emit_char '_'; Emitaux.emit_symbol '$' s) ++ | _ -> assert false ++ ++(* Output a label *) ++ ++let label_prefix = ++ match Config.system with ++ | "elf" | "bsd" -> ".L" ++ | "rhapsody" -> "L" ++ | _ -> assert false ++ ++let emit_label lbl = ++ emit_string label_prefix; emit_int lbl ++ ++(* Section switching *) ++ ++let toc_space = ++ match Config.system with ++ | "elf" | "bsd" -> " .section \".toc\",\"aw\"\n" ++ | "rhapsody" -> " .toc\n" ++ | _ -> assert false ++ ++let data_space = ++ match Config.system with ++ | "elf" | "bsd" -> " .section \".data\"\n" ++ | "rhapsody" -> " .data\n" ++ | _ -> assert false ++ ++let abiversion = ++ match Config.system with ++ | "elf" | "bsd" -> " .abiversion 2\n" ++ | _ -> assert false ++ ++let code_space = ++ match Config.system with ++ | "elf" | "bsd" -> " .section \".text\"\n" ++ | "rhapsody" -> " .text\n" ++ | _ -> assert false ++ ++let rodata_space = ++ match Config.system with ++ | "elf" | "bsd" -> " .section \".rodata\"\n" ++ | "rhapsody" -> " .const\n" ++ | _ -> assert false ++ ++(* Output a pseudo-register *) ++ ++let emit_reg r = ++ match r.loc with ++ Reg r -> emit_string (register_name r) ++ | _ -> fatal_error "Emit.emit_reg" ++ ++let use_full_regnames = ++ Config.system = "rhapsody" ++ ++let emit_gpr r = ++ if use_full_regnames then emit_char 'r'; ++ emit_int r ++ ++let emit_fpr r = ++ if use_full_regnames then emit_char 'f'; ++ emit_int r ++ ++let emit_ccr r = ++ if use_full_regnames then emit_string "cr"; ++ emit_int r ++ ++(* Output a stack reference *) ++ ++let emit_stack r = ++ match r.loc with ++ Stack s -> ++ let lbl, ofs = slot_offset s (register_class r) in ++ if lbl > 0 then ++ `{emit_label lbl}+`; ++ `{emit_int ofs}({emit_gpr 1})` ++ | _ -> fatal_error "Emit.emit_stack" ++ ++(* Split a 32-bit integer constants in two 16-bit halves *) ++ ++let low n = n land 0xFFFF ++let high n = n asr 16 ++ ++let nativelow n = Nativeint.to_int n land 0xFFFF ++let nativehigh n = Nativeint.to_int (Nativeint.shift_right n 16) ++ ++let is_immediate n = ++ n <= 32767 && n >= -32768 ++ ++let is_native_immediate n = ++ n <= 32767n && n >= -32768n ++ ++ ++type tocentry = ++ TocSymOfs of (string * int) ++ | TocLabel of int ++ | TocInt of nativeint ++ | TocFloat of string ++ ++(* List of all labels in tocref (reverse order) *) ++let tocref_entries = ref [] ++ ++(* Output a TOC reference *) ++ ++let emit_symbol_offset (s, d) = ++ emit_symbol s; ++ if d > 0 then `+`; ++ if d <> 0 then emit_int d ++ ++let emit_tocentry entry = ++ match entry with ++ TocSymOfs(s,d) -> emit_symbol_offset(s,d) ++ | TocInt i -> emit_nativeint i ++ | TocFloat f -> emit_string f ++ | TocLabel lbl -> emit_label lbl ++ ++ let rec tocref_label = function ++ ( [] , content ) -> ++ let lbl = new_label() in ++ tocref_entries := (lbl, content) :: !tocref_entries; ++ lbl ++ | ( (lbl, o_content) :: lst, content) -> ++ if content = o_content then ++ lbl ++ else ++ tocref_label (lst, content) ++ ++let emit_tocref entry = ++ let lbl = tocref_label (!tocref_entries,entry) in ++ emit_label lbl; emit_string "@toc(2) #"; emit_tocentry entry ++ ++ ++(* Output a load or store operation *) ++ ++let valid_offset instr ofs = ++ ofs land 3 = 0 || (instr <> "ld" && instr <> "std") ++ ++let emit_load_store instr addressing_mode addr n arg = ++ match addressing_mode with ++ Ibased(s, d) -> ++ let dd = (d + 0x8000) in (* We can only offset by -0x8000 .. +0x7fff *) ++ let a = (dd land -0x10000) in ++ let b = (dd land 0xffff) - 0x8000 in ++ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,a))}\n`; ++ ` {emit_string instr} {emit_reg arg}, {emit_int b}({emit_gpr 11})\n` ++ | Iindexed ofs -> ++ if is_immediate ofs && valid_offset instr ofs then ++ ` {emit_string instr} {emit_reg arg}, {emit_int ofs}({emit_reg addr.(n)})\n` ++ else begin ++ ` lis {emit_gpr 0}, {emit_int(high ofs)}\n`; ++ if low ofs <> 0 then ++ ` ori {emit_gpr 0}, {emit_gpr 0}, {emit_int(low ofs)}\n`; ++ ` {emit_string instr}x {emit_reg arg}, {emit_reg addr.(n)}, {emit_gpr 0}\n` ++ end ++ | Iindexed2 -> ++ ` {emit_string instr}x {emit_reg arg}, {emit_reg addr.(n)}, {emit_reg addr.(n+1)}\n` ++ ++(* After a comparison, extract the result as 0 or 1 *) ++ ++let emit_set_comp cmp res = ++ ` mfcr {emit_gpr 0}\n`; ++ let bitnum = ++ match cmp with ++ Ceq | Cne -> 2 ++ | Cgt | Cle -> 1 ++ | Clt | Cge -> 0 in ++` rlwinm {emit_reg res}, {emit_gpr 0}, {emit_int(bitnum+1)}, 31, 31\n`; ++ begin match cmp with ++ Cne | Cle | Cge -> ` xori {emit_reg res}, {emit_reg res}, 1\n` ++ | _ -> () ++ end ++ ++(* Record live pointers at call points *) ++ ++type frame_descr = ++ { fd_lbl: int; (* Return address *) ++ fd_frame_size_lbl: int; (* Size of stack frame *) ++ fd_live_offset: (int * int) list } (* Offsets/regs of live addresses *) ++ ++let frame_descriptors = ref([] : frame_descr list) ++ ++let record_frame live = ++ let lbl = new_label() in ++ let live_offset = ref [] in ++ Reg.Set.iter ++ (function ++ {typ = Addr; loc = Reg r} -> ++ live_offset := (0, (r lsl 1) + 1) :: !live_offset ++ | {typ = Addr; loc = Stack s} as reg -> ++ live_offset := slot_offset s (register_class reg) :: !live_offset ++ | _ -> ()) ++ live; ++ frame_descriptors := ++ { fd_lbl = lbl; ++ fd_frame_size_lbl = !stack_size_lbl; (* frame_size *) ++ fd_live_offset = !live_offset } :: !frame_descriptors; ++ `{emit_label lbl}:\n` ++ ++let emit_frame fd = ++ ` .quad {emit_label fd.fd_lbl} + 4\n`; ++ ` .short {emit_label fd.fd_frame_size_lbl}\n`; ++ ` .short {emit_int (List.length fd.fd_live_offset)}\n`; ++ List.iter ++ (fun (lbl,n) -> ++ ` .short `; ++ if lbl > 0 then `{emit_label lbl}+`; ++ `{emit_int n}\n`) ++ fd.fd_live_offset; ++ ` .align 3\n` ++ ++(* Record external C functions to be called in a position-independent way ++ (for MacOSX) *) ++ ++let pic_externals = (Config.system = "rhapsody") ++ ++let external_functions = ref StringSet.empty ++ ++let emit_external s = ++ ` .non_lazy_symbol_pointer\n`; ++ `L{emit_symbol s}$non_lazy_ptr:\n`; ++ ` .indirect_symbol {emit_symbol s}\n`; ++ ` .quad 0\n` ++ ++(* Names for conditional branches after comparisons *) ++ ++let branch_for_comparison = function ++ Ceq -> "beq" | Cne -> "bne" ++ | Cle -> "ble" | Cgt -> "bgt" ++ | Cge -> "bge" | Clt -> "blt" ++ ++let name_for_int_comparison = function ++ Isigned cmp -> ("cmpd", branch_for_comparison cmp) ++ | Iunsigned cmp -> ("cmpld", branch_for_comparison cmp) ++ ++(* Names for various instructions *) ++ ++let name_for_intop = function ++ Iadd -> "add" ++ | Imul -> "mulld" ++ | Idiv -> "divd" ++ | Iand -> "and" ++ | Ior -> "or" ++ | Ixor -> "xor" ++ | Ilsl -> "sld" ++ | Ilsr -> "srd" ++ | Iasr -> "srad" ++ | _ -> Misc.fatal_error "Emit.Intop" ++ ++let name_for_intop_imm = function ++ Iadd -> "addi" ++ | Imul -> "mulli" ++ | Iand -> "andi." ++ | Ior -> "ori" ++ | Ixor -> "xori" ++ | Ilsl -> "sldi" ++ | Ilsr -> "srdi" ++ | Iasr -> "sradi" ++ | _ -> Misc.fatal_error "Emit.Intop_imm" ++ ++let name_for_floatop1 = function ++ Inegf -> "fneg" ++ | Iabsf -> "fabs" ++ | _ -> Misc.fatal_error "Emit.Iopf1" ++ ++let name_for_floatop2 = function ++ Iaddf -> "fadd" ++ | Isubf -> "fsub" ++ | Imulf -> "fmul" ++ | Idivf -> "fdiv" ++ | _ -> Misc.fatal_error "Emit.Iopf2" ++ ++let name_for_specific = function ++ Imultaddf -> "fmadd" ++ | Imultsubf -> "fmsub" ++ | _ -> Misc.fatal_error "Emit.Ispecific" ++ ++(* Name of current function *) ++let function_name = ref "" ++(* Entry point for tail recursive calls *) ++let tailrec_entry_point = ref 0 ++(* Names of functions defined in the current file *) ++let defined_functions = ref StringSet.empty ++(* Label of glue code for calling the GC *) ++let call_gc_label = ref 0 ++(* Label of jump table *) ++let lbl_jumptbl = ref 0 ++(* List of all labels in jumptable (reverse order) *) ++let jumptbl_entries = ref [] ++(* Number of jumptable entries *) ++let num_jumptbl_entries = ref 0 ++ ++(* Fixup conditional branches that exceed hardware allowed range *) ++ ++let load_store_size = function ++ Ibased(s, d) -> 2 ++ | Iindexed ofs -> if is_immediate ofs then 1 else 3 ++ | Iindexed2 -> 1 ++ ++let instr_size = function ++ Lend -> 0 ++ | Lop(Imove | Ispill | Ireload) -> 1 ++ | Lop(Iconst_int n) -> if is_native_immediate n then 1 else 2 ++ | Lop(Iconst_float s) -> 2 ++ | Lop(Iconst_symbol s) -> 2 ++ | Lop(Icall_ind) -> 4 ++ | Lop(Icall_imm s) -> 5 ++ | Lop(Itailcall_ind) -> if !contains_calls then 5 else if has_stack_frame() then 3 else 2 ++ | Lop(Itailcall_imm s) -> if s = !function_name then 1 else ++ if !contains_calls then 6 else ++ if has_stack_frame() then 4 else 3 ++ | Lop(Iextcall(s, true)) -> 6 ++ | Lop(Iextcall(s, false)) -> 5 ++ | Lop(Istackoffset n) -> 0 ++ | Lop(Iload(chunk, addr)) -> ++ if chunk = Byte_signed ++ then load_store_size addr + 1 ++ else load_store_size addr ++ | Lop(Istore(chunk, addr)) -> load_store_size addr ++ | Lop(Ialloc n) -> 4 ++ | Lop(Ispecific(Ialloc_far n)) -> 5 ++ | Lop(Iintop Imod) -> 3 ++ | Lop(Iintop(Icomp cmp)) -> 4 ++ | Lop(Iintop op) -> 1 ++ | Lop(Iintop_imm(Idiv, n)) -> 2 ++ | Lop(Iintop_imm(Imod, n)) -> 4 ++ | Lop(Iintop_imm(Icomp cmp, n)) -> 4 ++ | Lop(Iintop_imm(op, n)) -> 1 ++ | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1 ++ | Lop(Ifloatofint) -> 3 ++ | Lop(Iintoffloat) -> 3 ++ | Lop(Ispecific sop) -> 1 ++ | Lreloadretaddr -> 2 ++ | Lreturn -> if has_stack_frame() then 2 else 1 ++ | Llabel lbl -> 0 ++ | Lbranch lbl -> 1 ++ | Lcondbranch(tst, lbl) -> 2 ++ | Lcondbranch3(lbl0, lbl1, lbl2) -> ++ 1 + (if lbl0 = None then 0 else 1) ++ + (if lbl1 = None then 0 else 1) ++ + (if lbl2 = None then 0 else 1) ++ | Lswitch jumptbl -> 7 ++ | Lsetuptrap lbl -> 1 ++ | Lpushtrap -> 7 ++ | Lpoptrap -> 1 ++ | Lraise -> 6 ++ ++let label_map code = ++ let map = Hashtbl.create 37 in ++ let rec fill_map pc instr = ++ match instr.desc with ++ Lend -> (pc, map) ++ | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next ++ | op -> fill_map (pc + instr_size op) instr.next ++ in fill_map 0 code ++ ++let max_branch_offset = 8180 ++(* 14-bit signed offset in words. Remember to cut some slack ++ for multi-word instructions where the branch can be anywhere in ++ the middle. 12 words of slack is plenty. *) ++ ++let branch_overflows map pc_branch lbl_dest = ++ let pc_dest = Hashtbl.find map lbl_dest in ++ let delta = pc_dest - (pc_branch + 1) in ++ delta <= -max_branch_offset || delta >= max_branch_offset ++ ++let opt_branch_overflows map pc_branch opt_lbl_dest = ++ match opt_lbl_dest with ++ None -> false ++ | Some lbl_dest -> branch_overflows map pc_branch lbl_dest ++ ++let fixup_branches codesize map code = ++ let expand_optbranch lbl n arg next = ++ match lbl with ++ None -> next ++ | Some l -> ++ instr_cons (Lcondbranch(Iinttest_imm(Isigned Ceq, n), l)) ++ arg [||] next in ++ let rec fixup did_fix pc instr = ++ match instr.desc with ++ Lend -> did_fix ++ | Lcondbranch(test, lbl) when branch_overflows map pc lbl -> ++ let lbl2 = new_label() in ++ let cont = ++ instr_cons (Lbranch lbl) [||] [||] ++ (instr_cons (Llabel lbl2) [||] [||] instr.next) in ++ instr.desc <- Lcondbranch(invert_test test, lbl2); ++ instr.next <- cont; ++ fixup true (pc + 2) instr.next ++ | Lcondbranch3(lbl0, lbl1, lbl2) ++ when opt_branch_overflows map pc lbl0 ++ || opt_branch_overflows map pc lbl1 ++ || opt_branch_overflows map pc lbl2 -> ++ let cont = ++ expand_optbranch lbl0 0 instr.arg ++ (expand_optbranch lbl1 1 instr.arg ++ (expand_optbranch lbl2 2 instr.arg instr.next)) in ++ instr.desc <- cont.desc; ++ instr.next <- cont.next; ++ fixup true pc instr ++ | Lop(Ialloc n) when codesize - pc >= max_branch_offset -> ++ instr.desc <- Lop(Ispecific(Ialloc_far n)); ++ fixup true (pc + 4) instr.next ++ | op -> ++ fixup did_fix (pc + instr_size op) instr.next ++ in fixup false 0 code ++ ++(* Iterate branch expansion till all conditional branches are OK *) ++ ++let rec branch_normalization code = ++ let (codesize, map) = label_map code in ++ if codesize >= max_branch_offset && fixup_branches codesize map code ++ then branch_normalization code ++ else () ++ ++ ++(* Output the assembly code for an instruction *) ++ ++let rec emit_instr i dslot = ++ 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 rs; typ = (Int | Addr)}, {loc = Reg rd} -> ++ ` mr {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} -> ++ ` fmr {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg rs; typ = (Int | Addr)}, {loc = Stack sd} -> ++ ` std {emit_reg src}, {emit_stack dst}\n` ++ | {loc = Reg rs; typ = Float}, {loc = Stack sd} -> ++ ` stfd {emit_reg src}, {emit_stack dst}\n` ++ | {loc = Stack ss; typ = (Int | Addr)}, {loc = Reg rd} -> ++ ` ld {emit_reg dst}, {emit_stack src}\n` ++ | {loc = Stack ss; typ = Float}, {loc = Reg rd} -> ++ ` lfd {emit_reg dst}, {emit_stack src}\n` ++ | (_, _) -> ++ fatal_error "Emit: Imove" ++ end ++ | Lop(Iconst_int n) -> ++ if is_native_immediate n then ++ ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n` ++ else if n >= -0x8000_0000n && n <= 0x7FFF_FFFFn then begin ++ ` lis {emit_reg i.res.(0)}, {emit_int(nativehigh n)}\n`; ++ if nativelow n <> 0 then ++ ` ori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_int(nativelow n)}\n` ++ end else begin ++ ` ld {emit_reg i.res.(0)}, {emit_tocref (TocInt n)}\n` ++ end ++ | Lop(Iconst_float s) -> ++ ` lfd {emit_reg i.res.(0)}, {emit_tocref (TocFloat s)}\n` ++ | Lop(Iconst_symbol s) -> ++ ` ld {emit_reg i.res.(0)}, {emit_tocref (TocSymOfs (s,0))}\n` ++ | Lop(Icall_ind) -> ++ ` std {emit_gpr 2},24({emit_gpr 1})\n`; ++ ` mtctr {emit_reg i.arg.(0)}\n`; ++ record_frame i.live; ++ ` bctrl\n`; ++ ` ld {emit_gpr 2},24({emit_gpr 1})\n` ++ | Lop(Icall_imm s) -> ++ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs (s,0))}\n`; ++ ` std {emit_gpr 2},24({emit_gpr 1})\n`; ++ ` mtctr {emit_gpr 12}\n`; ++ record_frame i.live; ++ ` bctrl\n`; ++ ` ld {emit_gpr 2},24({emit_gpr 1})\n` ++ | Lop(Itailcall_ind) -> ++ ` mtctr {emit_reg i.arg.(0)}\n`; ++ if has_stack_frame() then ++ ` ld {emit_gpr 1}, 0({emit_gpr 1})\n`; ++ if !contains_calls then begin ++ ` ld {emit_gpr 12}, 16({emit_gpr 1})\n`; ++ ` mtlr {emit_gpr 12}\n` ++ end; ++ ` bctr\n` ++ | Lop(Itailcall_imm s) -> ++ if s = !function_name then ++ ` b {emit_label !tailrec_entry_point}\n` ++ else begin ++ if has_stack_frame() then ++ ` ld {emit_gpr 1}, 0({emit_gpr 1})\n`; ++ if !contains_calls then begin ++ ` ld {emit_gpr 12}, 16({emit_gpr 1})\n`; ++ ` mtlr {emit_gpr 12}\n` ++ end; ++ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs (s,0))}\n`; ++ ` mtctr {emit_gpr 12}\n`; ++ ` bctr\n` ++ end ++ | Lop(Iextcall(s, alloc)) -> ++ if alloc then begin ++ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,0))}\n`; ++ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs ("caml_c_call",0))}\n`; ++ end else ++ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs (s,0))}\n`; ++ ` std {emit_gpr 2}, 24({emit_gpr 1})\n`; ++ ` mtctr {emit_gpr 12}\n`; ++ if alloc then record_frame i.live; ++ ` bctrl\n`; ++ ` ld {emit_gpr 2}, 24({emit_gpr 1})\n` ++ | Lop(Istackoffset n) -> ++ if n > !stack_args_size then ++ stack_args_size := n ++ | Lop(Iload(chunk, addr)) -> ++ let loadinstr = ++ match chunk with ++ Byte_unsigned -> "lbz" ++ | Byte_signed -> "lbz" ++ | Sixteen_unsigned -> "lhz" ++ | Sixteen_signed -> "lha" ++ | Thirtytwo_unsigned -> "lwz" ++ | Thirtytwo_signed -> "lwa" ++ | Word -> "ld" ++ | Single -> "lfs" ++ | Double | Double_u -> "lfd" in ++ emit_load_store loadinstr addr i.arg 0 i.res.(0); ++ if chunk = Byte_signed then ++ ` extsb {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Lop(Istore(chunk, addr)) -> ++ let storeinstr = ++ match chunk with ++ Byte_unsigned | Byte_signed -> "stb" ++ | Sixteen_unsigned | Sixteen_signed -> "sth" ++ | Thirtytwo_unsigned | Thirtytwo_signed -> "stw" ++ | Word -> "std" ++ | Single -> "stfs" ++ | Double | Double_u -> "stfd" in ++ emit_load_store storeinstr addr i.arg 1 i.arg.(0) ++ | Lop(Ialloc n) -> ++ if !call_gc_label = 0 then call_gc_label := new_label(); ++ ` addi {emit_gpr 31}, {emit_gpr 31}, {emit_int(-n)}\n`; ++ ` cmpld {emit_gpr 31}, {emit_gpr 30}\n`; ++ ` addi {emit_reg i.res.(0)}, {emit_gpr 31}, 8\n`; ++ record_frame i.live; ++ ` bltl {emit_label !call_gc_label}\n` (* Must be 4 insns to restart *) ++ | Lop(Ispecific(Ialloc_far n)) -> ++ if !call_gc_label = 0 then call_gc_label := new_label(); ++ let lbl = new_label() in ++ ` addi {emit_gpr 31}, {emit_gpr 31}, {emit_int(-n)}\n`; ++ ` cmpld {emit_gpr 31}, {emit_gpr 30}\n`; ++ ` bge {emit_label lbl}\n`; ++ record_frame i.live; ++ ` bl {emit_label !call_gc_label}\n`; (* Must be 4 insns to restart *) ++ `{emit_label lbl}: addi {emit_reg i.res.(0)}, {emit_gpr 31}, {emit_int size_addr}\n` ++ | Lop(Iintop Isub) -> (* subfc has swapped arguments *) ++ ` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iintop Imod) -> ++ ` divd {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` mulld {emit_gpr 0}, {emit_gpr 0}, {emit_reg i.arg.(1)}\n`; ++ ` subfc {emit_reg i.res.(0)}, {emit_gpr 0}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iintop(Icomp cmp)) -> ++ begin match cmp with ++ Isigned c -> ++ ` cmpd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ emit_set_comp c i.res.(0) ++ | Iunsigned c -> ++ ` cmpld {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ emit_set_comp c i.res.(0) ++ end ++ | Lop(Iintop Icheckbound) -> ++ ` tdlle {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\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(Idiv, n)) -> (* n is guaranteed to be a power of 2 *) ++ let l = Misc.log2 n in ++ ` sradi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int l}\n`; ++ ` addze {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Lop(Iintop_imm(Imod, n)) -> (* n is guaranteed to be a power of 2 *) ++ let l = Misc.log2 n in ++ ` sradi {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_int l}\n`; ++ ` addze {emit_gpr 0}, {emit_gpr 0}\n`; ++ ` sldi {emit_gpr 0}, {emit_gpr 0}, {emit_int l}\n`; ++ ` subfc {emit_reg i.res.(0)}, {emit_gpr 0}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iintop_imm(Icomp cmp, n)) -> ++ begin match cmp with ++ Isigned c -> ++ ` cmpdi {emit_reg i.arg.(0)}, {emit_int n}\n`; ++ emit_set_comp c i.res.(0) ++ | Iunsigned c -> ++ ` cmpldi {emit_reg i.arg.(0)}, {emit_int n}\n`; ++ emit_set_comp c i.res.(0) ++ end ++ | Lop(Iintop_imm(Icheckbound, n)) -> ++ ` tdllei {emit_reg i.arg.(0)}, {emit_int n}\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 ofs = if has_stack_frame() then 16 else 8 * (2 + num_stack_slots.(0) + num_stack_slots.(1)) in ++ ` std {emit_reg i.arg.(0)}, -{emit_int ofs}({emit_gpr 1})\n`; ++ ` lfd {emit_reg i.res.(0)}, -{emit_int ofs}({emit_gpr 1})\n`; ++ ` fcfid {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Lop(Iintoffloat) -> ++ let ofs = if has_stack_frame() then 16 else 8 * (2 + num_stack_slots.(0) + num_stack_slots.(1)) in ++ ` fctidz {emit_fpr 0}, {emit_reg i.arg.(0)}\n`; ++ ` stfd {emit_fpr 0}, -{emit_int ofs}({emit_gpr 1})\n`; ++ ` ld {emit_reg i.res.(0)}, -{emit_int ofs}({emit_gpr 1})\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 -> ++ if has_stack_frame() then begin ++ ` ld {emit_gpr 12}, {emit_label !stack_size_lbl}+16({emit_gpr 1})\n`; ++ ` mtlr {emit_gpr 12}\n` ++ end ++ | Lreturn -> ++ if has_stack_frame() then ++ ` ld {emit_gpr 1}, 0({emit_gpr 1})\n`; ++ ` blr\n` ++ | Llabel lbl -> ++ `{emit_label lbl}:\n` ++ | Lbranch lbl -> ++ ` b {emit_label lbl}\n` ++ | Lcondbranch(tst, lbl) -> ++ begin match tst with ++ Itruetest -> ++ ` cmpdi {emit_reg i.arg.(0)}, 0\n`; ++ emit_delay dslot; ++ ` bne {emit_label lbl}\n` ++ | Ifalsetest -> ++ ` cmpdi {emit_reg i.arg.(0)}, 0\n`; ++ emit_delay dslot; ++ ` beq {emit_label lbl}\n` ++ | Iinttest cmp -> ++ let (comp, branch) = name_for_int_comparison cmp in ++ ` {emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ emit_delay dslot; ++ ` {emit_string branch} {emit_label lbl}\n` ++ | Iinttest_imm(cmp, n) -> ++ let (comp, branch) = name_for_int_comparison cmp in ++ ` {emit_string comp}i {emit_reg i.arg.(0)}, {emit_int n}\n`; ++ emit_delay dslot; ++ ` {emit_string branch} {emit_label lbl}\n` ++ | Ifloattest(cmp, neg) -> ++ ` fcmpu {emit_ccr 0}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ (* bit 0 = lt, bit 1 = gt, bit 2 = eq *) ++ let (bitnum, negtst) = ++ match cmp with ++ Ceq -> (2, neg) ++ | Cne -> (2, not neg) ++ | Cle -> ` cror 3, 0, 2\n`; (* lt or eq *) ++ (3, neg) ++ | Cgt -> (1, neg) ++ | Cge -> ` cror 3, 1, 2\n`; (* gt or eq *) ++ (3, neg) ++ | Clt -> (0, neg) in ++ emit_delay dslot; ++ if negtst ++ then ` bf {emit_int bitnum}, {emit_label lbl}\n` ++ else ` bt {emit_int bitnum}, {emit_label lbl}\n` ++ | Ioddtest -> ++ ` andi. {emit_gpr 0}, {emit_reg i.arg.(0)}, 1\n`; ++ emit_delay dslot; ++ ` bne {emit_label lbl}\n` ++ | Ieventest -> ++ ` andi. {emit_gpr 0}, {emit_reg i.arg.(0)}, 1\n`; ++ emit_delay dslot; ++ ` beq {emit_label lbl}\n` ++ end ++ | Lcondbranch3(lbl0, lbl1, lbl2) -> ++ ` cmpdi {emit_reg i.arg.(0)}, 1\n`; ++ emit_delay dslot; ++ begin match lbl0 with ++ None -> () ++ | Some lbl -> ` blt {emit_label lbl}\n` ++ end; ++ begin match lbl1 with ++ None -> () ++ | Some lbl -> ` beq {emit_label lbl}\n` ++ end; ++ begin match lbl2 with ++ None -> () ++ | Some lbl -> ` bgt {emit_label lbl}\n` ++ end ++ | Lswitch jumptbl -> ++ if !lbl_jumptbl = 0 then lbl_jumptbl := new_label(); ++ ` ld {emit_gpr 11}, {emit_tocref (TocLabel !lbl_jumptbl)}\n`; ++ ` addi {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_int !num_jumptbl_entries}\n`; ++ ` sldi {emit_gpr 0}, {emit_gpr 0}, 2\n`; ++ ` lwax {emit_gpr 0}, {emit_gpr 11}, {emit_gpr 0}\n`; ++ ` add {emit_gpr 0}, {emit_gpr 11}, {emit_gpr 0}\n`; ++ ` mtctr {emit_gpr 0}\n`; ++ ` bctr\n`; ++ for i = 0 to Array.length jumptbl - 1 do ++ jumptbl_entries := jumptbl.(i) :: !jumptbl_entries; ++ incr num_jumptbl_entries ++ done ++ | Lsetuptrap lbl -> ++ ` bl {emit_label lbl}\n`; ++ | Lpushtrap -> ++ stack_traps_size := !stack_traps_size + 32; ++ ` addi {emit_gpr 11}, {emit_gpr 1}, {emit_label !stack_size_lbl}-{emit_int !stack_traps_size}\n`; ++ ` mflr {emit_gpr 0}\n`; ++ ` std {emit_gpr 29}, 0({emit_gpr 11})\n`; ++ ` std {emit_gpr 0}, 8({emit_gpr 11})\n`; ++ ` std {emit_gpr 1}, 16({emit_gpr 11})\n`; ++ ` std {emit_gpr 2}, 24({emit_gpr 11})\n`; ++ ` mr {emit_gpr 29}, {emit_gpr 11}\n` ++ | Lpoptrap -> ++ ` ld {emit_gpr 29}, 0({emit_gpr 29})\n` ++ | Lraise -> ++ ` ld {emit_gpr 0}, 8({emit_gpr 29})\n`; ++ ` ld {emit_gpr 1}, 16({emit_gpr 29})\n`; ++ ` ld {emit_gpr 2}, 24({emit_gpr 29})\n`; ++ ` mtlr {emit_gpr 0}\n`; ++ ` ld {emit_gpr 29}, 0({emit_gpr 29})\n`; ++ ` blr\n` ++ ++and emit_delay = function ++ None -> () ++ | Some i -> emit_instr i None ++ ++(* Checks if a pseudo-instruction expands to instructions ++ that do not branch and do not affect CR0 nor R12. *) ++ ++let is_simple_instr i = ++ match i.desc with ++ Lop op -> ++ begin match op with ++ Icall_imm _ | Icall_ind | Itailcall_imm _ | Itailcall_ind | ++ Iextcall(_, _) -> false ++ | Ialloc(_) -> false ++ | Iintop(Icomp _) -> false ++ | Iintop_imm(Iand, _) -> false ++ | Iintop_imm(Icomp _, _) -> false ++ | _ -> true ++ end ++ | Lreloadretaddr -> true ++ | _ -> false ++ ++let no_interference res arg = ++ try ++ for i = 0 to Array.length arg - 1 do ++ for j = 0 to Array.length res - 1 do ++ if arg.(i).loc = res.(j).loc then raise Exit ++ done ++ done; ++ true ++ with Exit -> ++ false ++ ++(* Emit a sequence of instructions, trying to fill delay slots for branches *) ++ ++let rec emit_all i = ++ match i with ++ {desc = Lend} -> () ++ | {next = {desc = (Lcondbranch(_, _) | Lcondbranch3(_, _, _))}} ++ when is_simple_instr i && no_interference i.res i.next.arg -> ++ emit_instr i.next (Some i); ++ emit_all i.next.next ++ | _ -> ++ emit_instr i None; ++ emit_all i.next ++ ++(* Emission of a function declaration *) ++ ++let fundecl fundecl = ++ function_name := fundecl.fun_name; ++ defined_functions := StringSet.add fundecl.fun_name !defined_functions; ++ tailrec_entry_point := new_label(); ++ if has_stack_frame() then ++ stack_size_lbl := new_label(); ++ stack_slot_lbl := new_label(); ++ stack_args_size := 0; ++ stack_traps_size := 0; ++ call_gc_label := 0; ++ ` .globl {emit_symbol fundecl.fun_name}\n`; ++ begin match Config.system with ++ | "elf" | "bsd" -> ++ ` .type {emit_symbol fundecl.fun_name}, @function\n`; ++ emit_string code_space; ++ `{emit_symbol fundecl.fun_name}:\n`; ++ | _ -> ++ ` .align 2\n`; ++ emit_string code_space; ++ `{emit_symbol fundecl.fun_name}:\n` ++ end; ++ (* r2 to be setup to current toc *) ++ `0: addis {emit_gpr 2}, {emit_gpr 12},.TOC.-0b@ha\n`; ++ ` addi {emit_gpr 2}, {emit_gpr 2},.TOC.-0b@l\n`; ++ ` .localentry {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`; ++ if !contains_calls then begin ++ ` mflr {emit_gpr 0}\n`; ++ ` std {emit_gpr 0}, 16({emit_gpr 1})\n` ++ end; ++ if has_stack_frame() then ++ ` stdu {emit_gpr 1}, -{emit_label !stack_size_lbl}({emit_gpr 1})\n`; ++ `{emit_label !tailrec_entry_point}:\n`; ++ branch_normalization fundecl.fun_body; ++ emit_all fundecl.fun_body; ++ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`; ++ if has_stack_frame() then begin ++ ` .set {emit_label !stack_size_lbl},{emit_int (frame_size_sans_args() + !stack_args_size + !stack_traps_size)} # stack size including traps\n`; ++ ` .set {emit_label !stack_slot_lbl},{emit_int (48 + !stack_args_size)} # stack slot offset\n` ++ end else (* leave 8 bytes for float <-> conversions *) ++ ` .set {emit_label !stack_slot_lbl},{emit_int (40-frame_size_sans_args())} # stack slot offset (negative)\n`; ++ ++ (* Emit the glue code to call the GC *) ++ if !call_gc_label > 0 then begin ++ `{emit_label !call_gc_label}:\n`; ++ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs ("caml_call_gc",0))}\n`; ++ ` mtctr {emit_gpr 12}\n`; ++ ` bctr\n`; ++ end ++ ++(* Emission of data *) ++ ++let declare_global_data s = ++ ` .globl {emit_symbol s}\n`; ++ if Config.system = "elf" || Config.system = "bsd" then ++ ` .type {emit_symbol s}, @object\n` ++ ++let emit_item = function ++ Cglobal_symbol s -> ++ declare_global_data s ++ | Cdefine_symbol s -> ++ `{emit_symbol s}:\n`; ++ | Cdefine_label lbl -> ++ `{emit_label (lbl + 100000)}:\n` ++ | Cint8 n -> ++ ` .byte {emit_int n}\n` ++ | Cint16 n -> ++ ` .short {emit_int n}\n` ++ | Cint32 n -> ++ ` .long {emit_nativeint n}\n` ++ | Cint n -> ++ ` .quad {emit_nativeint n}\n` ++ | Csingle f -> ++ ` .float 0d{emit_string f}\n` ++ | Cdouble f -> ++ ` .double 0d{emit_string f}\n` ++ | Csymbol_address s -> ++ ` .quad {emit_symbol s}\n` ++ | Clabel_address lbl -> ++ ` .quad {emit_label (lbl + 100000)}\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; ++ List.iter emit_item l ++ ++(* Beginning / end of an assembly file *) ++ ++let begin_assembly() = ++ defined_functions := StringSet.empty; ++ external_functions := StringSet.empty; ++ tocref_entries := []; ++ num_jumptbl_entries := 0; ++ jumptbl_entries := []; ++ lbl_jumptbl := 0; ++ (* Emit the beginning of the segments *) ++ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in ++ emit_string data_space; ++ declare_global_data lbl_begin; ++ emit_string abiversion; ++ `{emit_symbol lbl_begin}:\n`; ++ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in ++ emit_string code_space; ++ declare_global_data lbl_begin; ++ `{emit_symbol lbl_begin}:\n` ++ ++let end_assembly() = ++ (* Emit the jump table *) ++ if !num_jumptbl_entries > 0 then begin ++ emit_string code_space; ++ `{emit_label !lbl_jumptbl}:\n`; ++ List.iter ++ (fun lbl -> ` .long {emit_label lbl} - {emit_label !lbl_jumptbl}\n`) ++ (List.rev !jumptbl_entries); ++ jumptbl_entries := [] ++ end; ++ if !tocref_entries <> [] then begin ++ emit_string toc_space; ++ List.iter ++ (fun (lbl, entry) -> ++ `{emit_label lbl}:\n`; ++ match entry with ++ TocFloat f -> ++ ` .double {emit_tocentry entry}\n` ++ | _ -> ++ ` .tc {emit_label lbl}[TC],{emit_tocentry entry}\n` ++ ) ++ !tocref_entries; ++ tocref_entries := [] ++ end; ++ if pic_externals then ++ (* Emit the pointers to external functions *) ++ StringSet.iter emit_external !external_functions; ++ (* Emit the end of the segments *) ++ emit_string code_space; ++ 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; ++ let lbl_end = Compilenv.make_symbol (Some "data_end") in ++ declare_global_data lbl_end; ++ `{emit_symbol lbl_end}:\n`; ++ ` .quad 0\n`; ++ (* Emit the frame descriptors *) ++ emit_string rodata_space; ++ let lbl = Compilenv.make_symbol (Some "frametable") in ++ declare_global_data lbl; ++ `{emit_symbol lbl}:\n`; ++ ` .quad {emit_int (List.length !frame_descriptors)}\n`; ++ List.iter emit_frame !frame_descriptors; ++ frame_descriptors := [] +diff --git a/asmcomp/power64le/proc.ml b/asmcomp/power64le/proc.ml +new file mode 100644 +index 0000000..9b98577 +--- /dev/null ++++ b/asmcomp/power64le/proc.ml +@@ -0,0 +1,240 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 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. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: proc.ml 9547 2010-01-22 12:48:24Z doligez $ *) ++ ++(* Description of the Power PC *) ++ ++open Misc ++open Cmm ++open Reg ++open Arch ++open Mach ++ ++(* Instruction selection *) ++ ++let word_addressed = false ++ ++(* Registers available for register allocation *) ++ ++(* Integer register map: ++ 0 temporary, null register for some operations ++ 1 stack pointer ++ 2 pointer to table of contents ++ 3 - 10 function arguments and results ++ 11 - 12 temporaries ++ 13 pointer to small data area ++ 14 - 28 general purpose, preserved by C ++ 29 trap pointer ++ 30 allocation limit ++ 31 allocation pointer ++ Floating-point register map: ++ 0 temporary ++ 1 - 13 function arguments and results ++ 14 - 31 general purpose, preserved by C ++*) ++ ++let int_reg_name = ++ if Config.system = "rhapsody" then ++ [| "r3"; "r4"; "r5"; "r6"; "r7"; "r8"; "r9"; "r10"; ++ "r14"; "r15"; "r16"; "r17"; "r18"; "r19"; "r20"; "r21"; ++ "r22"; "r23"; "r24"; "r25"; "r26"; "r27"; "r28" |] ++ else ++ [| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; ++ "14"; "15"; "16"; "17"; "18"; "19"; "20"; "21"; ++ "22"; "23"; "24"; "25"; "26"; "27"; "28" |] ++ ++let float_reg_name = ++ if Config.system = "rhapsody" then ++ [| "f1"; "f2"; "f3"; "f4"; "f5"; "f6"; "f7"; "f8"; ++ "f9"; "f10"; "f11"; "f12"; "f13"; "f14"; "f15"; "f16"; ++ "f17"; "f18"; "f19"; "f20"; "f21"; "f22"; "f23"; "f24"; ++ "f25"; "f26"; "f27"; "f28"; "f29"; "f30"; "f31" |] ++ else ++ [| "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; ++ "9"; "10"; "11"; "12"; "13"; "14"; "15"; "16"; ++ "17"; "18"; "19"; "20"; "21"; "22"; "23"; "24"; ++ "25"; "26"; "27"; "28"; "29"; "30"; "31" |] ++ ++let num_register_classes = 2 ++ ++let register_class r = ++ match r.typ with ++ Int -> 0 ++ | Addr -> 0 ++ | Float -> 1 ++ ++let num_available_registers = [| 23; 31 |] ++ ++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.create 23 Reg.dummy in ++ for i = 0 to 22 do v.(i) <- Reg.at_location Int (Reg i) done; v ++ ++let hard_float_reg = ++ let v = Array.create 31 Reg.dummy in ++ for i = 0 to 30 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 stack_ofs arg = ++ let loc = Array.create (Array.length arg) Reg.dummy in ++ let int = ref first_int in ++ let float = ref first_float in ++ let ofs = ref stack_ofs in ++ for i = 0 to Array.length arg - 1 do ++ match arg.(i).typ with ++ 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; ++ end; ++ ofs := !ofs + size_int ++ | 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; ++ end; ++ ofs := !ofs + size_float ++ done; ++ (loc, Misc.align !ofs 16) ++ (* Keep stack 16-aligned. *) ++ ++let incoming ofs = Incoming ofs ++let outgoing ofs = Outgoing ofs ++let not_supported ofs = fatal_error "Proc.loc_results: cannot call" ++ ++let loc_arguments arg = ++ calling_conventions 0 7 100 112 outgoing 48 arg ++let loc_parameters arg = ++ let (loc, ofs) = calling_conventions 0 7 100 112 incoming 0 arg in loc ++let loc_results res = ++ let (loc, ofs) = calling_conventions 0 7 100 112 not_supported 0 res in loc ++ ++(* C calling conventions under PowerOpen: ++ use GPR 3-10 and FPR 1-13 just like ML calling ++ conventions, but always reserve stack space for all arguments. ++ Also, using a float register automatically reserves two int registers ++ (in 32-bit mode) or one int register (in 64-bit mode). ++ (If we were to call a non-prototyped C function, each float argument ++ would have to go both in a float reg and in the matching pair ++ of integer regs.) ++ ++ C calling conventions under SVR4: ++ use GPR 3-10 and FPR 1-8 just like ML calling conventions. ++ Using a float register does not affect the int registers. ++ Always reserve 8 bytes at bottom of stack, plus whatever is needed ++ to hold the overflow arguments. *) ++ ++let poweropen_external_conventions first_int last_int ++ first_float last_float arg = ++ let loc = Array.create (Array.length arg) Reg.dummy in ++ let int = ref first_int in ++ let float = ref first_float in ++ let ofs = ref (14 * size_addr) in ++ for i = 0 to Array.length arg - 1 do ++ match arg.(i).typ with ++ Int | Addr as ty -> ++ if !int <= last_int then begin ++ loc.(i) <- phys_reg !int; ++ incr int ++ end else begin ++ loc.(i) <- stack_slot (Outgoing !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 (Outgoing !ofs) Float; ++ ofs := !ofs + size_float ++ end; ++ int := !int + 1 ++ done; ++ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned *) ++ ++let loc_external_arguments = ++ match Config.system with ++ | "rhapsody" -> poweropen_external_conventions 0 7 100 112 ++ | "elf" | "bsd" -> calling_conventions 0 7 100 107 outgoing 48 ++ | _ -> assert false ++ ++let extcall_use_push = false ++ ++(* Results are in GPR 3 and FPR 1 *) ++ ++let loc_external_results res = ++ let (loc, ofs) = calling_conventions 0 0 100 100 not_supported 0 res in loc ++ ++(* Exceptions are in GPR 3 *) ++ ++let loc_exn_bucket = phys_reg 0 ++ ++(* Registers destroyed by operations *) ++ ++let destroyed_at_c_call = ++ Array.of_list(List.map phys_reg ++ [0; 1; 2; 3; 4; 5; 6; 7; ++ 100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111; 112]) ++ ++let destroyed_at_oper = function ++ Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs ++ | Iop(Iextcall(_, false)) -> destroyed_at_c_call ++ | _ -> [||] ++ ++let destroyed_at_raise = all_phys_regs ++ ++(* Maximal register pressure *) ++ ++let safe_register_pressure = function ++ Iextcall(_, _) -> 15 ++ | _ -> 23 ++ ++let max_register_pressure = function ++ Iextcall(_, _) -> [| 15; 18 |] ++ | _ -> [| 23; 30 |] ++ ++(* 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/power64le/reload.ml b/asmcomp/power64le/reload.ml +new file mode 100644 +index 0000000..abcac6c +--- /dev/null ++++ b/asmcomp/power64le/reload.ml +@@ -0,0 +1,18 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 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. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: reload.ml 2553 1999-11-17 18:59:06Z xleroy $ *) ++ ++(* Reloading for the PowerPC *) ++ ++let fundecl f = ++ (new Reloadgen.reload_generic)#fundecl f +diff --git a/asmcomp/power64le/scheduling.ml b/asmcomp/power64le/scheduling.ml +new file mode 100644 +index 0000000..b7bba9b +--- /dev/null ++++ b/asmcomp/power64le/scheduling.ml +@@ -0,0 +1,65 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 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. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: scheduling.ml 9547 2010-01-22 12:48:24Z doligez $ *) ++ ++(* Instruction scheduling for the Power PC *) ++ ++open Arch ++open Mach ++ ++class scheduler = object ++ ++inherit Schedgen.scheduler_generic ++ ++(* Latencies (in cycles). Based roughly on the "common model". *) ++ ++method oper_latency = function ++ Ireload -> 2 ++ | Iload(_, _) -> 2 ++ | Iconst_float _ -> 2 (* turned into a load *) ++ | Iconst_symbol _ -> 1 ++ | Iintop Imul -> 9 ++ | Iintop_imm(Imul, _) -> 5 ++ | Iintop(Idiv | Imod) -> 36 ++ | Iaddf | Isubf -> 4 ++ | Imulf -> 5 ++ | Idivf -> 33 ++ | Ispecific(Imultaddf | Imultsubf) -> 5 ++ | _ -> 1 ++ ++method reload_retaddr_latency = 12 ++ (* If we can have that many cycles between the reloadretaddr and the ++ return, we can expect that the blr branch will be completely folded. *) ++ ++(* Issue cycles. Rough approximations. *) ++ ++method oper_issue_cycles = function ++ Iconst_float _ | Iconst_symbol _ -> 2 ++ | Iload(_, Ibased(_, _)) -> 2 ++ | Istore(_, Ibased(_, _)) -> 2 ++ | Ialloc _ -> 4 ++ | Iintop(Imod) -> 40 (* assuming full stall *) ++ | Iintop(Icomp _) -> 4 ++ | Iintop_imm(Idiv, _) -> 2 ++ | Iintop_imm(Imod, _) -> 4 ++ | Iintop_imm(Icomp _, _) -> 4 ++ | Ifloatofint -> 9 ++ | Iintoffloat -> 4 ++ | _ -> 1 ++ ++method reload_retaddr_issue_cycles = 3 ++ (* load then stalling mtlr *) ++ ++end ++ ++let fundecl f = (new scheduler)#schedule_fundecl f +diff --git a/asmcomp/power64le/selection.ml b/asmcomp/power64le/selection.ml +new file mode 100644 +index 0000000..6101d53 +--- /dev/null ++++ b/asmcomp/power64le/selection.ml +@@ -0,0 +1,101 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1997 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. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: selection.ml 10296 2010-04-22 12:51:06Z xleroy $ *) ++ ++(* Instruction selection for the Power PC processor *) ++ ++open Cmm ++open Arch ++open Mach ++ ++(* Recognition of addressing modes *) ++ ++type addressing_expr = ++ Asymbol of string ++ | Alinear of expression ++ | Aadd of expression * expression ++ ++let rec select_addr = function ++ Cconst_symbol s -> ++ (Asymbol s, 0) ++ | Cop((Caddi | Cadda), [arg; Cconst_int m]) -> ++ let (a, n) = select_addr arg in (a, n + m) ++ | Cop((Caddi | Cadda), [Cconst_int m; arg]) -> ++ let (a, n) = select_addr arg in (a, n + m) ++ | Cop((Caddi | Cadda), [arg1; arg2]) -> ++ begin match (select_addr arg1, select_addr arg2) with ++ ((Alinear e1, n1), (Alinear e2, n2)) -> ++ (Aadd(e1, e2), n1 + n2) ++ | _ -> ++ (Aadd(arg1, arg2), 0) ++ end ++ | exp -> ++ (Alinear exp, 0) ++ ++(* Instruction selection *) ++ ++class selector = object (self) ++ ++inherit Selectgen.selector_generic as super ++ ++method is_immediate n = (n <= 32767) && (n >= -32768) ++ ++method select_addressing chunk exp = ++ match select_addr exp with ++ (Asymbol s, d) -> ++ (Ibased(s, d), Ctuple []) ++ | (Alinear e, d) -> ++ (Iindexed d, e) ++ | (Aadd(e1, e2), d) -> ++ if d = 0 ++ then (Iindexed2, Ctuple[e1; e2]) ++ else (Iindexed d, Cop(Cadda, [e1; e2])) ++ ++method! select_operation op args = ++ match (op, args) with ++ (* Prevent the recognition of (x / cst) and (x % cst) when cst is not ++ a power of 2, which do not correspond to an instruction. *) ++ (Cdivi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) -> ++ (Iintop_imm(Idiv, n), [arg]) ++ | (Cdivi, _) -> ++ (Iintop Idiv, args) ++ | (Cmodi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) -> ++ (Iintop_imm(Imod, n), [arg]) ++ | (Cmodi, _) -> ++ (Iintop Imod, 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 mult-add and mult-sub instructions *) ++ | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> ++ (Ispecific Imultaddf, [arg1; arg2; arg3]) ++ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) -> ++ (Ispecific Imultaddf, [arg1; arg2; arg3]) ++ | (Csubf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> ++ (Ispecific Imultsubf, [arg1; arg2; arg3]) ++ | _ -> ++ super#select_operation op args ++ ++method select_logical op = function ++ [arg; Cconst_int n] when n >= 0 && n <= 0xFFFF -> ++ (Iintop_imm(op, n), [arg]) ++ | [Cconst_int n; arg] when n >= 0 && n <= 0xFFFF -> ++ (Iintop_imm(op, n), [arg]) ++ | args -> ++ (Iintop op, args) ++ ++end ++ ++let fundecl f = (new selector)#emit_fundecl f +diff --git a/asmrun/Makefile b/asmrun/Makefile +index 6a8ed98..1ff256f 100644 +--- a/asmrun/Makefile ++++ b/asmrun/Makefile +@@ -96,6 +96,12 @@ power64.o: power64-$(SYSTEM).o + power64.p.o: power64-$(SYSTEM).o + cp power64-$(SYSTEM).o power64.p.o + ++power64le.o: power64le-$(SYSTEM).o ++ cp power64le-$(SYSTEM).o power64le.o ++ ++power64le.p.o: power64le-$(SYSTEM).o ++ cp power64le-$(SYSTEM).o power64le.p.o ++ + main.c: ../byterun/main.c + ln -s ../byterun/main.c main.c + misc.c: ../byterun/misc.c +diff --git a/asmrun/power64-elf.S b/asmrun/power64-elf.S +index b2c24d6..98c42e2 100644 +--- a/asmrun/power64-elf.S ++++ b/asmrun/power64-elf.S +@@ -23,12 +23,16 @@ + addis tmp, 0, glob@ha; \ + std reg, glob@l(tmp) + ++#if _CALL_ELF == 2 ++ .abiversion 2 ++#endif + .section ".text" + + /* Invoke the garbage collector. */ + + .globl caml_call_gc + .type caml_call_gc, @function ++#if _CALL_ELF != 2 + .section ".opd","aw" + .align 3 + caml_call_gc: +@@ -36,6 +40,10 @@ caml_call_gc: + .previous + .align 2 + .L.caml_call_gc: ++#else ++caml_call_gc: ++ /* do not set r2 to tocbase */ ++#endif + /* Set up stack frame */ + mflr 0 + std 0, 16(1) +@@ -110,6 +118,7 @@ caml_call_gc: + stfdu 30, 8(11) + stfdu 31, 8(11) + /* Call the GC */ ++#if _CALL_ELF != 2 + std 2,40(1) + Addrglobal(11, caml_garbage_collection) + ld 2,8(11) +@@ -117,6 +126,13 @@ caml_call_gc: + mtlr 11 + blrl + ld 2,40(1) ++#else ++ std 2,24(1) ++ Addrglobal(12, caml_garbage_collection) ++ mtlr 12 ++ blrl ++ ld 2,24(1) ++#endif + /* Reload new allocation pointer and allocation limit */ + Loadglobal(31, caml_young_ptr, 11) + Loadglobal(30, caml_young_limit, 11) +@@ -188,12 +204,17 @@ caml_call_gc: + ld 1, 0(1) + /* Return */ + blr ++#if _CALL_ELF != 2 + .size .L.caml_call_gc,.-.L.caml_call_gc ++#else ++ .size caml_call_gc,.-caml_call_gc ++#endif + + /* Call a C function from Caml */ + + .globl caml_c_call + .type caml_c_call, @function ++#if _CALL_ELF != 2 + .section ".opd","aw" + .align 3 + caml_c_call: +@@ -201,13 +222,21 @@ caml_c_call: + .previous + .align 2 + .L.caml_c_call: ++#else ++caml_c_call: ++0: addis 2,12, .TOC.-0b@ha ++ addi 2, 2, .TOC.-0b@l ++ .localentry caml_c_call, .-caml_c_call ++#endif + .cfi_startproc + /* Save return address */ + mflr 25 + .cfi_register lr,25 + /* Get ready to call C function (address in 11) */ ++#if _CALL_ELF != 2 + ld 2, 8(11) + ld 11,0(11) ++#endif + mtlr 11 + /* Record lowest stack address and return address */ + Storeglobal(1, caml_bottom_of_stack, 12) +@@ -228,12 +257,17 @@ caml_c_call: + /* Return to caller */ + blr + .cfi_endproc ++#if _CALL_ELF != 2 + .size .L.caml_c_call,.-.L.caml_c_call ++#else ++ .size caml_c_call,.-caml_c_call ++#endif + + /* Raise an exception from C */ + + .globl caml_raise_exception + .type caml_raise_exception, @function ++#if _CALL_ELF != 2 + .section ".opd","aw" + .align 3 + caml_raise_exception: +@@ -241,6 +275,12 @@ caml_raise_exception: + .previous + .align 2 + .L.caml_raise_exception: ++#else ++caml_raise_exception: ++0: addis 2,12, .TOC.-0b@ha ++ addi 2, 2, .TOC.-0b@l ++ .localentry caml_raise_exception, .-caml_raise_exception ++#endif + /* Reload Caml global registers */ + Loadglobal(29, caml_exception_pointer, 11) + Loadglobal(31, caml_young_ptr, 11) +@@ -256,12 +296,17 @@ caml_raise_exception: + ld 29, 0(29) + /* Branch to handler */ + blr ++#if _CALL_ELF != 2 + .size .L.caml_raise_exception,.-.L.caml_raise_exception ++#else ++ .size caml_raise_exception,.-caml_raise_exception ++#endif + + /* Start the Caml program */ + + .globl caml_start_program + .type caml_start_program, @function ++#if _CALL_ELF != 2 + .section ".opd","aw" + .align 3 + caml_start_program: +@@ -269,6 +314,9 @@ caml_start_program: + .previous + .align 2 + .L.caml_start_program: ++#else ++caml_start_program: ++#endif + Addrglobal(12, caml_program) + + /* Code shared between caml_start_program and caml_callback */ +@@ -342,6 +390,7 @@ caml_start_program: + li 0, 0 + Storeglobal(0, caml_last_return_address, 11) + /* Call the Caml code */ ++#if _CALL_ELF != 2 + std 2,40(1) + ld 2,8(12) + ld 12,0(12) +@@ -349,6 +398,13 @@ caml_start_program: + .L105: + blrl + ld 2,40(1) ++#else ++ std 2,24(1) ++ mtlr 12 ++.L105: ++ blrl ++ ld 2,24(1) ++#endif + /* Pop the trap frame, restoring caml_exception_pointer */ + ld 9, 0x170(1) + Storeglobal(9, caml_exception_pointer, 11) +@@ -414,12 +470,17 @@ caml_start_program: + /* Encode exception bucket as an exception result and return it */ + ori 3, 3, 2 + b .L106 ++#if _CALL_ELF != 2 + .size .L.caml_start_program,.-.L.caml_start_program ++#else ++ .size caml_start_program,.-caml_start_program ++#endif + + /* Callback from C to Caml */ + + .globl caml_callback_exn + .type caml_callback_exn, @function ++#if _CALL_ELF != 2 + .section ".opd","aw" + .align 3 + caml_callback_exn: +@@ -427,17 +488,28 @@ caml_callback_exn: + .previous + .align 2 + .L.caml_callback_exn: ++#else ++caml_callback_exn: ++0: addis 2,12, .TOC.-0b@ha ++ addi 2, 2, .TOC.-0b@l ++ .localentry caml_callback_exn, .-caml_callback_exn ++#endif + /* Initial shuffling of arguments */ + mr 0, 3 /* Closure */ + mr 3, 4 /* Argument */ + mr 4, 0 + ld 12, 0(4) /* Code pointer */ + b .L102 ++#if _CALL_ELF != 2 + .size .L.caml_callback_exn,.-.L.caml_callback_exn ++#else ++ .size caml_callback_exn,.-caml_callback_exn ++#endif ++ + +- + .globl caml_callback2_exn + .type caml_callback2_exn, @function ++#if _CALL_ELF != 2 + .section ".opd","aw" + .align 3 + caml_callback2_exn: +@@ -445,17 +517,28 @@ caml_callback2_exn: + .previous + .align 2 + .L.caml_callback2_exn: ++#else ++caml_callback2_exn: ++0: addis 2,12, .TOC.-0b@ha ++ addi 2, 2, .TOC.-0b@l ++ .localentry caml_callback2_exn, .-caml_callback2_exn ++#endif + mr 0, 3 /* Closure */ + mr 3, 4 /* First argument */ + mr 4, 5 /* Second argument */ + mr 5, 0 + Addrglobal(12, caml_apply2) + b .L102 ++#if _CALL_ELF != 2 + .size .L.caml_callback2_exn,.-.L.caml_callback2_exn ++#else ++ .size caml_callback2_exn,.-caml_callback2_exn ++#endif + + + .globl caml_callback3_exn + .type caml_callback3_exn, @function ++#if _CALL_ELF != 2 + .section ".opd","aw" + .align 3 + caml_callback3_exn: +@@ -463,6 +546,12 @@ caml_callback3_exn: + .previous + .align 2 + .L.caml_callback3_exn: ++#else ++caml_callback3_exn: ++0: addis 2,12, .TOC.-0b@ha ++ addi 2, 2, .TOC.-0b@l ++ .localentry caml_callback3_exn, .-caml_callback3_exn ++#endif + mr 0, 3 /* Closure */ + mr 3, 4 /* First argument */ + mr 4, 5 /* Second argument */ +@@ -470,7 +559,11 @@ caml_callback3_exn: + mr 6, 0 + Addrglobal(12, caml_apply3) + b .L102 ++#if _CALL_ELF != 2 + .size .L.caml_callback3_exn,.-.L.caml_callback3_exn ++#else ++ .size caml_callback3_exn,.-caml_callback3_exn ++#endif + + /* Frame table */ + +diff --git a/asmrun/power64le-elf.S b/asmrun/power64le-elf.S +new file mode 120000 +index 0000000..f49d00c +--- /dev/null ++++ b/asmrun/power64le-elf.S +@@ -0,0 +1 @@ ++power64-elf.S +\ No newline at end of file +diff --git a/asmrun/stack.h b/asmrun/stack.h +index 031e408..f1890c1 100644 +--- a/asmrun/stack.h ++++ b/asmrun/stack.h +@@ -55,6 +55,15 @@ + #define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) + #endif + ++#ifdef TARGET_power64le ++#define Saved_return_address(sp) *((intnat *)((sp) +16)) ++#define Already_scanned(sp, retaddr) ((retaddr) & 1) ++#define Mark_scanned(sp, retaddr) (Saved_return_address(sp) = (retaddr) | 1) ++#define Mask_already_scanned(retaddr) ((retaddr) & ~1) ++#define Trap_frame_size 0x150 ++#define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) ++#endif ++ + #ifdef TARGET_arm + #define Saved_return_address(sp) *((intnat *)((sp) - 4)) + #define Callback_link(sp) ((struct caml_context *)((sp) + 8)) +diff --git a/config/gnu/config.guess b/config/gnu/config.guess +index b79252d..049652e 100755 +--- a/config/gnu/config.guess ++++ b/config/gnu/config.guess +@@ -992,6 +992,9 @@ EOF + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-${LIBC} + exit ;; ++ ppc64le:Linux:*:*) ++ echo powerpc64le-unknown-linux-gnu ++ exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-${LIBC} + exit ;; +diff --git a/configure b/configure +index a0e1466..3bd98ad 100755 +--- a/configure ++++ b/configure +@@ -700,6 +700,7 @@ case "$host" in + fi;; + i[3456]86-*-gnu*) arch=i386; system=gnu;; + powerpc64-*-linux*) arch=power64; model=ppc64; system=elf;; ++ powerpc64le-*-linux*) arch=power64le; model=ppc64le; system=elf;; + powerpc*-*-linux*) arch=power; model=ppc; system=elf;; + powerpc-*-netbsd*) arch=power; model=ppc; system=elf;; + powerpc-*-openbsd*) arch=power; model=ppc; system=bsd_elf;; +@@ -786,6 +787,8 @@ case "$arch,$model,$system" in + aspp='gcc -c';; + power64,*,elf) as='as -u -m ppc64' + aspp='gcc -c';; ++ power64le,*,elf) as='as -u -m ppc64' ++ aspp='gcc -c';; + power,*,rhapsody) as="as -arch $model" + aspp="$bytecc -c";; + sparc,*,solaris) as='as' +-- +2.0.4 + diff --git a/SOURCES/0014-arm-arm64-Mark-stack-as-non-executable.patch b/SOURCES/0014-arm-arm64-Mark-stack-as-non-executable.patch new file mode 100644 index 0000000..9e11ae3 --- /dev/null +++ b/SOURCES/0014-arm-arm64-Mark-stack-as-non-executable.patch @@ -0,0 +1,39 @@ +From 262882b5fe2d327170f33a28dc35866aa32af84e Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Sat, 10 May 2014 03:20:35 -0400 +Subject: [PATCH 14/14] arm, arm64: Mark stack as non-executable. + +The same fix as this one, which was only fully applied to +i686 & x86-64: + +http://caml.inria.fr/mantis/view.php?id=4564 +--- + asmrun/arm.S | 3 +++ + asmrun/arm64.S | 3 +++ + 2 files changed, 6 insertions(+) + +diff --git a/asmrun/arm.S b/asmrun/arm.S +index 2ce244a..90f5b6e 100644 +--- a/asmrun/arm.S ++++ b/asmrun/arm.S +@@ -489,3 +489,6 @@ caml_system__frametable: + .align 2 + .type caml_system__frametable, %object + .size caml_system__frametable, .-caml_system__frametable ++ ++ /* Mark stack as non-executable, PR#4564 */ ++ .section .note.GNU-stack,"",%progbits +diff --git a/asmrun/arm64.S b/asmrun/arm64.S +index de670e6..84e18ba 100644 +--- a/asmrun/arm64.S ++++ b/asmrun/arm64.S +@@ -533,3 +533,6 @@ caml_system__frametable: + .align 3 + .type caml_system__frametable, %object + .size caml_system__frametable, .-caml_system__frametable ++ ++ /* Mark stack as non-executable, PR#4564 */ ++ .section .note.GNU-stack,"",%progbits +-- +2.0.4 + diff --git a/SOURCES/macros.ocaml-srpm b/SOURCES/macros.ocaml-srpm new file mode 100644 index 0000000..7b8d319 --- /dev/null +++ b/SOURCES/macros.ocaml-srpm @@ -0,0 +1,10 @@ +# Note that OCaml is compiled on all architectures. However +# on some (rare) architectures, only bytecode compilation is +# available. Use these macros to find out if native code +# compilation is available on a particular architecture. + +# Architectures that support the OCaml native code compiler. +%ocaml_native_compiler aarch64 %{arm} %{ix86} ppc ppc64 ppc64le sparc sparcv9 x86_64 + +# Architectures that support native dynamic linking of OCaml code. +%ocaml_natdynlink aarch64 %{arm} %{ix86} ppc ppc64 ppc64le sparc sparcv9 x86_64 diff --git a/SPECS/ocaml.spec b/SPECS/ocaml.spec index e0ef634..3c490db 100644 --- a/SPECS/ocaml.spec +++ b/SPECS/ocaml.spec @@ -1,6 +1,29 @@ +%global macros_dir %{_rpmconfigdir}/macros.d + +# 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. + +# NB. These must match the contents of macros.ocaml-srpm precisely! +%global ocaml_native_compiler aarch64 %{arm} %{ix86} ppc ppc64 ppc64le sparc sparcv9 x86_64 +%global ocaml_natdynlink aarch64 %{arm} %{ix86} ppc ppc64 ppc64le sparc sparcv9 x86_64 + +%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 + Name: ocaml -Version: 4.00.1 -Release: 4%{?dist} +Version: 4.01.0 +Release: 22.2%{?dist} Summary: OCaml compiler and programming environment @@ -8,10 +31,19 @@ License: QPL and (LGPLv2+ with exceptions) URL: http://www.ocaml.org -Source0: http://caml.inria.fr/pub/distrib/ocaml-4.00/ocaml-%{version}.tar.bz2 -Source1: http://caml.inria.fr/pub/distrib/ocaml-4.00/ocaml-4.00-refman-html.tar.gz -Source2: http://caml.inria.fr/pub/distrib/ocaml-4.00/ocaml-4.00-refman.pdf -Source3: http://caml.inria.fr/pub/distrib/ocaml-4.00/ocaml-4.00-refman.info.tar.gz +# After ocaml 4.01.0 was released, upstream added some patches and +# fixes to the git repository, but did not make a further tarball +# release. The Source0 file here reflects the final git release of 4.01.0. +# To reconstruct this archive, do: +# git archive --prefix=ocaml-4.01.0/ --output=ocaml-ecc80c0d3850bc144760af4c63b7eab438615bdc.tar ecc80c0d3850bc144760af4c63b7eab438615bdc +# gzip --best ocaml-ecc80c0d3850bc144760af4c63b7eab438615bdc.tar +Source0: ocaml-ecc80c0d3850bc144760af4c63b7eab438615bdc.tar.gz +Source1: http://caml.inria.fr/pub/distrib/ocaml-4.01/ocaml-4.01-refman-html.tar.gz +Source2: http://caml.inria.fr/pub/distrib/ocaml-4.01/ocaml-4.01-refman.pdf +Source3: http://caml.inria.fr/pub/distrib/ocaml-4.01/ocaml-4.01-refman.info.tar.gz + +# In Fedora this is in a separate package (ocaml-srpm-macros). +Source4: macros.ocaml-srpm # IMPORTANT NOTE: # @@ -20,7 +52,7 @@ Source3: http://caml.inria.fr/pub/distrib/ocaml-4.00/ocaml-4.00-refman.in # will be OVERWRITTEN by the next update. Instead, request commit # access to the fedorahosted project: # -# http://git.fedorahosted.org/git/?p=fedora-ocaml.git +# https://git.fedorahosted.org/cgit/fedora-ocaml.git/ # # ALTERNATIVELY add a patch to the end of the list (leaving the # existing patches unchanged) adding a comment to note that it should @@ -32,6 +64,28 @@ Patch0003: 0003-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch Patch0004: 0004-Don-t-add-rpaths-to-libraries.patch Patch0005: 0005-configure-Allow-user-defined-C-compiler-flags.patch Patch0006: 0006-Add-support-for-ppc64.patch +Patch0007: 0007-yacc-Use-mkstemp-instead-of-mktemp.patch + +# Aarch64 patches. +Patch0008: 0008-Port-to-the-ARM-64-bits-AArch64-architecture-experim.patch +Patch0009: 0009-Updated-with-latest-versions-from-FSF.patch +Patch0010: 0010-arm64-Align-code-and-data-to-8-bytes.patch + +# NON-upstream patch to allow '--flag=arg' as an alternative to '--flag arg'. +Patch0011: 0011-arg-Add-no_arg-and-get_arg-helper-functions.patch +Patch0012: 0012-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch + +# ppc64le support (Michel Normand). +Patch0013: 0013-Add-support-for-ppc64le.patch + +# ARM & Aarch64 non-executable stack. +Patch0014: 0014-arm-arm64-Mark-stack-as-non-executable.patch + +# ppc, ppc64, ppc64le non-executable stack. +Patch0015: 0001-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch + +# Add BFD support so that ocamlobjinfo supports *.cmxs format (RHBZ#1113735). +BuildRequires: binutils-devel BuildRequires: ncurses-devel BuildRequires: gdbm-devel @@ -58,27 +112,12 @@ BuildRequires: chrpath BuildRequires: git Requires: gcc -Requires: ncurses-devel -Requires: gdbm-devel Requires: rpm-build >= 4.8.0 -Provides: ocaml(compiler) = %{version} - -# We can compile OCaml on just about anything, but the native code -# backend is only available on a subset of architectures. -ExclusiveArch: alpha %{arm} ia64 %{ix86} x86_64 ppc ppc64 sparc sparcv9 +# Bundles an MD5 implementation in byterun/md5.{c,h} +Provides: bundled(md5-plumb) -%ifarch %{arm} %{ix86} ppc ppc64 sparc sparcv9 x86_64 -%global native_compiler 1 -%else -%global native_compiler 0 -%endif - -%ifarch %{arm} %{ix86} ppc ppc64 sparc sparcv9 x86_64 -%global natdynlink 1 -%else -%global natdynlink 0 -%endif +Provides: ocaml(compiler) = %{version} %global __ocaml_requires_opts -c -f '%{buildroot}%{_bindir}/ocamlrun %{buildroot}%{_bindir}/ocamlobjinfo' %global __ocaml_provides_opts -f '%{buildroot}%{_bindir}/ocamlrun %{buildroot}%{_bindir}/ocamlobjinfo' @@ -98,6 +137,9 @@ and a comprehensive library. Summary: OCaml runtime environment Requires: util-linux Provides: ocaml(runtime) = %{version} +# This is a hack because ocamlrun -version now prints 4.01.1, which +# was never a real version, but rebuilt packages will depend on this. +Provides: ocaml(runtime) = 4.01.1 %description runtime OCaml is a high-level, strongly-typed, functional and object-oriented @@ -175,7 +217,7 @@ This package contains the development files. %package ocamldoc -Summary: Documentation generator for OCaml. +Summary: Documentation generator for OCaml Requires: ocaml = %{version}-%{release} Provides: ocamldoc @@ -244,7 +286,7 @@ unset MAKEFLAGS # For ppc64 we need a larger stack than default to compile some files # because the stages in the OCaml compiler are not mutually tail # recursive. -%ifarch ppc64 +%ifarch ppc64 ppc64le ulimit -a ulimit -Hs 65536 ulimit -Ss 65536 @@ -254,16 +296,17 @@ ulimit -Ss 65536 # alignment issues, see: http://caml.inria.fr/mantis/view.php?id=5700 # ONLY use this on i386. %ifarch %{ix86} -CFLAGS="$RPM_OPT_FLAGS -mpreferred-stack-boundary=2" \ +CFLAGS="$RPM_OPT_FLAGS -fno-strict-aliasing -mpreferred-stack-boundary=2" \ %else -CFLAGS="$RPM_OPT_FLAGS" \ +CFLAGS="$RPM_OPT_FLAGS -fno-strict-aliasing" \ %endif ./configure \ -bindir %{_bindir} \ -libdir %{_libdir}/ocaml \ -x11lib %{_libdir} \ -x11include %{_includedir} \ - -mandir %{_mandir}/man1 + -mandir %{_mandir}/man1 \ + -no-curses make world %if %{native_compiler} make opt opt.opt @@ -274,6 +317,8 @@ make -C emacs ocamltags # 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 @@ -308,6 +353,11 @@ 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 + +mkdir -p $RPM_BUILD_ROOT%{macros_dir} +install -m 0644 %{SOURCE0} $RPM_BUILD_ROOT%{macros_dir}/macros.ocaml-srpm + %post docs /sbin/install-info \ @@ -324,6 +374,7 @@ fi %files +%doc LICENSE %{_bindir}/ocaml %{_bindir}/ocamlbyteinfo %{_bindir}/ocamlbuild @@ -351,8 +402,8 @@ fi %if %{native_compiler} %{_bindir}/ocamlopt %{_bindir}/ocamlopt.opt -%{_bindir}/ocamloptp %endif +%{_bindir}/ocamloptp #%{_bindir}/ocamlplugininfo %{_bindir}/ocamlprof %{_bindir}/ocamlyacc @@ -389,6 +440,7 @@ fi %files runtime +%doc README LICENSE Changes %{_bindir}/ocamlrun %dir %{_libdir}/ocaml %{_libdir}/ocaml/VERSION @@ -406,19 +458,22 @@ fi %exclude %{_libdir}/ocaml/graphicsX11.cmi %exclude %{_libdir}/ocaml/stublibs/dlllabltk.so #%exclude %{_libdir}/ocaml/stublibs/dlltkanim.so -%doc README LICENSE Changes +%{macros_dir}/macros.ocaml-srpm %files source +%doc LICENSE %{_libdir}/ocaml/*.ml %files x11 +%doc LICENSE %{_libdir}/ocaml/graphicsX11.cmi %{_libdir}/ocaml/graphicsX11.mli %files labltk +%doc LICENSE %{_bindir}/labltk %dir %{_libdir}/ocaml/labltk %{_libdir}/ocaml/labltk/*.cmi @@ -429,6 +484,9 @@ fi %files labltk-devel +%doc LICENSE +%doc otherlibs/labltk/examples_labltk +%doc otherlibs/labltk/examples_camltk %{_bindir}/ocamlbrowser %{_libdir}/ocaml/labltk/labltktop %{_libdir}/ocaml/labltk/pp @@ -440,11 +498,10 @@ fi %{_libdir}/ocaml/labltk/*.o %endif %{_libdir}/ocaml/labltk/*.mli -%doc otherlibs/labltk/examples_labltk -%doc otherlibs/labltk/examples_camltk %files camlp4 +%doc LICENSE %dir %{_libdir}/ocaml/camlp4 %{_libdir}/ocaml/camlp4/*.cmi %{_libdir}/ocaml/camlp4/*.cma @@ -484,26 +541,26 @@ fi %files ocamldoc +%doc LICENSE +%doc ocamldoc/Changes.txt %{_bindir}/ocamldoc* %{_libdir}/ocaml/ocamldoc -%doc ocamldoc/Changes.txt %files docs %doc refman.pdf htmlman %{_infodir}/* -%if %{native_compiler} %{_mandir}/man3/* -%endif %files emacs +%doc emacs/README %{_datadir}/emacs/site-lisp/* %{_bindir}/ocamltags -%doc emacs/README %files compiler-libs +%doc LICENSE %dir %{_libdir}/ocaml/compiler-libs %{_libdir}/ocaml/compiler-libs/*.cmi %{_libdir}/ocaml/compiler-libs/*.cmo @@ -517,12 +574,91 @@ fi %changelog +* 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 -* Fri Dec 27 2013 Daniel Mach - 4.00.1-3 -- Mass rebuild 2013-12-27 +* 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