diff --git a/.gitignore b/.gitignore index 2d870e3..20ca7d3 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ /ocaml-*.tar.bz2 /ocaml-*.tar.gz /ocaml-*-refman.pdf +/4.04.0+beta2.tar.gz diff --git a/0001-Don-t-add-rpaths-to-libraries.patch b/0001-Don-t-add-rpaths-to-libraries.patch new file mode 100644 index 0000000..225fcbf --- /dev/null +++ b/0001-Don-t-add-rpaths-to-libraries.patch @@ -0,0 +1,29 @@ +From 4e42fcf72faacc4394fcb2e6c007c3dab60423d7 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 24 Jun 2014 10:00:15 +0100 +Subject: [PATCH 1/4] Don't add rpaths to libraries. + +--- + tools/Makefile.shared | 6 +++--- + 1 file changed, 3 insertions(+), 3 deletions(-) + +diff --git a/tools/Makefile.shared b/tools/Makefile.shared +index 2803d78..d6c42bb 100644 +--- a/tools/Makefile.shared ++++ b/tools/Makefile.shared +@@ -154,9 +154,9 @@ $(call byte_and_opt,ocamlmklib,ocamlmklibconfig.cmo config.cmo \ + ocamlmklibconfig.ml: ../config/Makefile Makefile + (echo 'let bindir = "$(BINDIR)"'; \ + echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\ +- echo 'let byteccrpath = "$(BYTECCRPATH)"'; \ +- echo 'let nativeccrpath = "$(NATIVECCRPATH)"'; \ +- echo 'let mksharedlibrpath = "$(MKSHAREDLIBRPATH)"'; \ ++ echo 'let byteccrpath = ""'; \ ++ echo 'let nativeccrpath = ""'; \ ++ echo 'let mksharedlibrpath = ""'; \ + echo 'let toolpref = "$(TOOLPREF)"'; \ + sed -n -e 's/^#ml //p' ../config/Makefile) \ + > ocamlmklibconfig.ml +-- +2.9.3 + diff --git a/0001-Don-t-ignore-.-configure-it-s-a-real-git-file.patch b/0001-Don-t-ignore-.-configure-it-s-a-real-git-file.patch deleted file mode 100644 index c80b7b8..0000000 --- a/0001-Don-t-ignore-.-configure-it-s-a-real-git-file.patch +++ /dev/null @@ -1,24 +0,0 @@ -From 988c1068100b7f30bd8b0d2c1195ac383705dc1c Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 24 Jun 2014 22:29:38 +0100 -Subject: [PATCH 01/20] Don't ignore ./configure, it's a real git file. - ---- - .gitignore | 1 - - 1 file changed, 1 deletion(-) - -diff --git a/.gitignore b/.gitignore -index 87f7cda..8aad7c2 100644 ---- a/.gitignore -+++ b/.gitignore -@@ -19,7 +19,6 @@ - /.depend - /.depend.nt - /.DS_Store --/configure - /ocamlc - /ocamlc.opt - /expunge --- -2.7.4 - diff --git a/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch b/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch deleted file mode 100644 index 727d328..0000000 --- a/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch +++ /dev/null @@ -1,18 +0,0 @@ -From d08dc9232f0ee90e3dc8132b9e63935be58e668e Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Thu, 7 Jun 2012 15:36:16 +0100 -Subject: [PATCH 02/20] Ensure empty compilerlibs/ directory is created by git. - -This directory exists in the OCaml tarball, but is empty. As a -result, git ignores it unless we put a dummy file in it. ---- - compilerlibs/.exists | 0 - 1 file changed, 0 insertions(+), 0 deletions(-) - create mode 100644 compilerlibs/.exists - -diff --git a/compilerlibs/.exists b/compilerlibs/.exists -new file mode 100644 -index 0000000..e69de29 --- -2.7.4 - diff --git a/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch b/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch new file mode 100644 index 0000000..c5e453f --- /dev/null +++ b/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch @@ -0,0 +1,240 @@ +From 1ad7a315e15abfc3eacd199d0e865849204af29c Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:40:36 +0100 +Subject: [PATCH 2/4] ocamlbyteinfo, ocamlplugininfo: Useful utilities from + Debian, sent upstream. + +See: +http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD +--- + ocamlbyteinfo.ml | 101 +++++++++++++++++++++++++++++++++++++++++++++++++ + ocamlplugininfo.ml | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++ + 2 files changed, 210 insertions(+) + create mode 100644 ocamlbyteinfo.ml + create mode 100644 ocamlplugininfo.ml + +diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml +new file mode 100644 +index 0000000..eb9a293 +--- /dev/null ++++ b/ocamlbyteinfo.ml +@@ -0,0 +1,101 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* *) ++(* Copyright 2009 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the GNU Library General Public License, with *) ++(* the special exception on linking described in file ../../LICENSE. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id$ *) ++ ++(* Dumps a bytecode binary file *) ++ ++open Sys ++open Dynlinkaux ++ ++let input_stringlist ic len = ++ let get_string_list sect len = ++ let rec fold s e acc = ++ if e != len then ++ if sect.[e] = '\000' then ++ fold (e+1) (e+1) (String.sub sect s (e-s) :: acc) ++ else fold s (e+1) acc ++ else acc ++ in fold 0 0 [] ++ in ++ let sect = String.create len in ++ let _ = really_input ic sect 0 len in ++ get_string_list sect len ++ ++let print = Printf.printf ++let perr s = ++ Printf.eprintf "%s\n" s; ++ exit(1) ++let p_title title = print "%s:\n" title ++ ++let p_section title format pdata = function ++ | [] -> () ++ | l -> ++ p_title title; ++ List.iter ++ (fun (name, data) -> print format (pdata data) name) ++ l ++ ++let p_list title format = function ++ | [] -> () ++ | l -> ++ p_title title; ++ List.iter ++ (fun name -> print format name) ++ l ++ ++let _ = ++ try ++ let input_name = Sys.argv.(1) in ++ let ic = open_in_bin input_name in ++ Bytesections.read_toc ic; ++ List.iter ++ (fun section -> ++ try ++ let len = Bytesections.seek_section ic section in ++ if len > 0 then match section with ++ | "CRCS" -> ++ p_section ++ "Imported Units" ++ "\t%s\t%s\n" ++ Digest.to_hex ++ (input_value ic : (string * Digest.t) list) ++ | "DLLS" -> ++ p_list ++ "Used Dlls" "\t%s\n" ++ (input_stringlist ic len) ++ | "DLPT" -> ++ p_list ++ "Additional Dll paths" ++ "\t%s\n" ++ (input_stringlist ic len) ++ | "PRIM" -> ++ let prims = (input_stringlist ic len) in ++ print "Uses unsafe features: "; ++ begin match prims with ++ [] -> print "no\n" ++ | l -> print "YES\n"; ++ p_list "Primitives declared in this module" ++ "\t%s\n" ++ l ++ end ++ | _ -> () ++ with Not_found | Failure _ | Invalid_argument _ -> () ++ ) ++ ["CRCS"; "DLLS"; "DLPT"; "PRIM"]; ++ close_in ic ++ with ++ | Sys_error msg -> ++ perr msg ++ | Invalid_argument("index out of bounds") -> ++ perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0)) +diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml +new file mode 100644 +index 0000000..e28800f +--- /dev/null ++++ b/ocamlplugininfo.ml +@@ -0,0 +1,109 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* *) ++(* Copyright 2009 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the GNU Library General Public License, with *) ++(* the special exception on linking described in file ../../LICENSE. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id$ *) ++ ++(* Dumps a .cmxs file *) ++ ++open Natdynlink ++open Format ++ ++let file = ++ try ++ Sys.argv.(1) ++ with _ -> begin ++ Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0); ++ exit(1) ++ end ++ ++exception Abnormal_exit ++ ++let error s e = ++ let eprint = Printf.eprintf in ++ let print_exc s = function ++ | End_of_file -> ++ eprint "%s: %s\n" s file ++ | Abnormal_exit -> ++ eprint "%s\n" s ++ | e -> eprint "%s\n" (Printexc.to_string e) ++ in ++ print_exc s e; ++ exit(1) ++ ++let read_in command = ++ let cmd = Printf.sprintf command file in ++ let ic = Unix.open_process_in cmd in ++ try ++ let line = input_line ic in ++ begin match (Unix.close_process_in ic) with ++ | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line ++ | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> ++ error ++ (Printf.sprintf ++ "Command \"%s\" exited abnormally" ++ cmd ++ ) ++ Abnormal_exit ++ end ++ with e -> error "File is empty" e ++ ++let get_offset adr_off adr_sec = ++ try ++ let adr = List.nth adr_off 4 in ++ let off = List.nth adr_off 5 in ++ let sec = List.hd adr_sec in ++ ++ let (!) x = Int64.of_string ("0x" ^ x) in ++ let (+) = Int64.add in ++ let (-) = Int64.sub in ++ ++ Int64.to_int (!off + !sec - !adr) ++ ++ with Failure _ | Invalid_argument _ -> ++ error ++ "Command output doesn't have the expected format" ++ Abnormal_exit ++ ++let print_infos name crc defines cmi cmx = ++ let print_name_crc (name, crc) = ++ printf "@ %s (%s)" name (Digest.to_hex crc) ++ in ++ let pr_imports ppf imps = List.iter print_name_crc imps in ++ printf "Name: %s@." name; ++ printf "CRC of implementation: %s@." (Digest.to_hex crc); ++ printf "@[Globals defined:"; ++ List.iter (fun s -> printf "@ %s" s) defines; ++ printf "@]@."; ++ printf "@[Interfaces imported:%a@]@." pr_imports cmi; ++ printf "@[Implementations imported:%a@]@." pr_imports cmx ++ ++let _ = ++ let adr_off = read_in "objdump -h %s | grep ' .data '" in ++ let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'" in ++ ++ let ic = open_in file in ++ let _ = seek_in ic (get_offset adr_off adr_sec) in ++ let header = (input_value ic : Natdynlink.dynheader) in ++ if header.magic <> Natdynlink.dyn_magic_number then ++ raise(Error(Natdynlink.Not_a_bytecode_file file)) ++ else begin ++ List.iter ++ (fun ui -> ++ print_infos ++ ui.name ++ ui.crc ++ ui.defines ++ ui.imports_cmi ++ ui.imports_cmx) ++ header.units ++ end +-- +2.9.3 + diff --git a/0003-Don-t-add-rpaths-to-libraries.patch b/0003-Don-t-add-rpaths-to-libraries.patch deleted file mode 100644 index 2e5ec11..0000000 --- a/0003-Don-t-add-rpaths-to-libraries.patch +++ /dev/null @@ -1,29 +0,0 @@ -From 73db2ab33221880d2399b2e98038219d798861ff Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 24 Jun 2014 10:00:15 +0100 -Subject: [PATCH 03/20] Don't add rpaths to libraries. - ---- - tools/Makefile.shared | 6 +++--- - 1 file changed, 3 insertions(+), 3 deletions(-) - -diff --git a/tools/Makefile.shared b/tools/Makefile.shared -index 0b90cd3..dc48712 100644 ---- a/tools/Makefile.shared -+++ b/tools/Makefile.shared -@@ -113,9 +113,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 --- -2.7.4 - diff --git a/0003-configure-Allow-user-defined-C-compiler-flags.patch b/0003-configure-Allow-user-defined-C-compiler-flags.patch new file mode 100644 index 0000000..f935ef8 --- /dev/null +++ b/0003-configure-Allow-user-defined-C-compiler-flags.patch @@ -0,0 +1,27 @@ +From 1fbe91a9effb87f018f0a5234fd85f2742128279 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:44:18 +0100 +Subject: [PATCH 3/4] configure: Allow user defined C compiler flags. + +--- + configure | 4 ++++ + 1 file changed, 4 insertions(+) + +diff --git a/configure b/configure +index ef002cc..5121666 100755 +--- a/configure ++++ b/configure +@@ -1901,6 +1901,10 @@ if $with_fpic; then + echo "#define CAML_WITH_FPIC" >> m.h + fi + ++# Allow user defined C Compiler flags ++bytecccompopts="$bytecccompopts $CFLAGS" ++nativecccompopts="$nativecccompopts $CFLAGS" ++ + # Finish generated files + + cclibs="$cclibs $mathlib" +-- +2.9.3 + diff --git a/0004-Don-t-rewrite-Werror.patch b/0004-Don-t-rewrite-Werror.patch new file mode 100644 index 0000000..06d13fb --- /dev/null +++ b/0004-Don-t-rewrite-Werror.patch @@ -0,0 +1,28 @@ +From 5e378e1b4f3b8a0697962f95383bf1796cbc36f8 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Thu, 3 Nov 2016 19:50:20 +0000 +Subject: [PATCH 4/4] Don't rewrite -Werror. + +In Fedora our CFLAGS contains -Wall -Werror=format-security. + +As written, the sed phrase substitutes this with -Wall=format-security +which is bogus. Remove this rewriting completely. +--- + Makefile | 1 - + 1 file changed, 1 deletion(-) + +diff --git a/Makefile b/Makefile +index 85be2db..1764d0e 100644 +--- a/Makefile ++++ b/Makefile +@@ -409,7 +409,6 @@ utils/config.ml: utils/config.mlp config/Makefile + -e 's|%%CCOMPTYPE%%|cc|' \ + -e 's|%%BYTECC%%|$(BYTECC) $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)|' \ + -e 's|%%NATIVECC%%|$(NATIVECC) $(NATIVECCCOMPOPTS)|' \ +- -e '/c_compiler =/s| -Werror||' \ + -e 's|%%PACKLD%%|$(PACKLD)|' \ + -e 's|%%BYTECCLIBS%%|$(BYTECCLIBS)|' \ + -e 's|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|' \ +-- +2.9.3 + diff --git a/0004-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch b/0004-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch deleted file mode 100644 index 3747d77..0000000 --- a/0004-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch +++ /dev/null @@ -1,240 +0,0 @@ -From 953b84dd9626f2be68f5cc8942478338250d560b Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 29 May 2012 20:40:36 +0100 -Subject: [PATCH 04/20] ocamlbyteinfo, ocamlplugininfo: Useful utilities from - Debian, sent upstream. - -See: -http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD ---- - ocamlbyteinfo.ml | 101 +++++++++++++++++++++++++++++++++++++++++++++++++ - ocamlplugininfo.ml | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++ - 2 files changed, 210 insertions(+) - create mode 100644 ocamlbyteinfo.ml - create mode 100644 ocamlplugininfo.ml - -diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml -new file mode 100644 -index 0000000..eb9a293 ---- /dev/null -+++ b/ocamlbyteinfo.ml -@@ -0,0 +1,101 @@ -+(***********************************************************************) -+(* *) -+(* Objective Caml *) -+(* *) -+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) -+(* *) -+(* Copyright 2009 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the GNU Library General Public License, with *) -+(* the special exception on linking described in file ../../LICENSE. *) -+(* *) -+(***********************************************************************) -+ -+(* $Id$ *) -+ -+(* Dumps a bytecode binary file *) -+ -+open Sys -+open Dynlinkaux -+ -+let input_stringlist ic len = -+ let get_string_list sect len = -+ let rec fold s e acc = -+ if e != len then -+ if sect.[e] = '\000' then -+ fold (e+1) (e+1) (String.sub sect s (e-s) :: acc) -+ else fold s (e+1) acc -+ else acc -+ in fold 0 0 [] -+ in -+ let sect = String.create len in -+ let _ = really_input ic sect 0 len in -+ get_string_list sect len -+ -+let print = Printf.printf -+let perr s = -+ Printf.eprintf "%s\n" s; -+ exit(1) -+let p_title title = print "%s:\n" title -+ -+let p_section title format pdata = function -+ | [] -> () -+ | l -> -+ p_title title; -+ List.iter -+ (fun (name, data) -> print format (pdata data) name) -+ l -+ -+let p_list title format = function -+ | [] -> () -+ | l -> -+ p_title title; -+ List.iter -+ (fun name -> print format name) -+ l -+ -+let _ = -+ try -+ let input_name = Sys.argv.(1) in -+ let ic = open_in_bin input_name in -+ Bytesections.read_toc ic; -+ List.iter -+ (fun section -> -+ try -+ let len = Bytesections.seek_section ic section in -+ if len > 0 then match section with -+ | "CRCS" -> -+ p_section -+ "Imported Units" -+ "\t%s\t%s\n" -+ Digest.to_hex -+ (input_value ic : (string * Digest.t) list) -+ | "DLLS" -> -+ p_list -+ "Used Dlls" "\t%s\n" -+ (input_stringlist ic len) -+ | "DLPT" -> -+ p_list -+ "Additional Dll paths" -+ "\t%s\n" -+ (input_stringlist ic len) -+ | "PRIM" -> -+ let prims = (input_stringlist ic len) in -+ print "Uses unsafe features: "; -+ begin match prims with -+ [] -> print "no\n" -+ | l -> print "YES\n"; -+ p_list "Primitives declared in this module" -+ "\t%s\n" -+ l -+ end -+ | _ -> () -+ with Not_found | Failure _ | Invalid_argument _ -> () -+ ) -+ ["CRCS"; "DLLS"; "DLPT"; "PRIM"]; -+ close_in ic -+ with -+ | Sys_error msg -> -+ perr msg -+ | Invalid_argument("index out of bounds") -> -+ perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0)) -diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml -new file mode 100644 -index 0000000..e28800f ---- /dev/null -+++ b/ocamlplugininfo.ml -@@ -0,0 +1,109 @@ -+(***********************************************************************) -+(* *) -+(* Objective Caml *) -+(* *) -+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) -+(* *) -+(* Copyright 2009 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the GNU Library General Public License, with *) -+(* the special exception on linking described in file ../../LICENSE. *) -+(* *) -+(***********************************************************************) -+ -+(* $Id$ *) -+ -+(* Dumps a .cmxs file *) -+ -+open Natdynlink -+open Format -+ -+let file = -+ try -+ Sys.argv.(1) -+ with _ -> begin -+ Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0); -+ exit(1) -+ end -+ -+exception Abnormal_exit -+ -+let error s e = -+ let eprint = Printf.eprintf in -+ let print_exc s = function -+ | End_of_file -> -+ eprint "%s: %s\n" s file -+ | Abnormal_exit -> -+ eprint "%s\n" s -+ | e -> eprint "%s\n" (Printexc.to_string e) -+ in -+ print_exc s e; -+ exit(1) -+ -+let read_in command = -+ let cmd = Printf.sprintf command file in -+ let ic = Unix.open_process_in cmd in -+ try -+ let line = input_line ic in -+ begin match (Unix.close_process_in ic) with -+ | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line -+ | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> -+ error -+ (Printf.sprintf -+ "Command \"%s\" exited abnormally" -+ cmd -+ ) -+ Abnormal_exit -+ end -+ with e -> error "File is empty" e -+ -+let get_offset adr_off adr_sec = -+ try -+ let adr = List.nth adr_off 4 in -+ let off = List.nth adr_off 5 in -+ let sec = List.hd adr_sec in -+ -+ let (!) x = Int64.of_string ("0x" ^ x) in -+ let (+) = Int64.add in -+ let (-) = Int64.sub in -+ -+ Int64.to_int (!off + !sec - !adr) -+ -+ with Failure _ | Invalid_argument _ -> -+ error -+ "Command output doesn't have the expected format" -+ Abnormal_exit -+ -+let print_infos name crc defines cmi cmx = -+ let print_name_crc (name, crc) = -+ printf "@ %s (%s)" name (Digest.to_hex crc) -+ in -+ let pr_imports ppf imps = List.iter print_name_crc imps in -+ printf "Name: %s@." name; -+ printf "CRC of implementation: %s@." (Digest.to_hex crc); -+ printf "@[Globals defined:"; -+ List.iter (fun s -> printf "@ %s" s) defines; -+ printf "@]@."; -+ printf "@[Interfaces imported:%a@]@." pr_imports cmi; -+ printf "@[Implementations imported:%a@]@." pr_imports cmx -+ -+let _ = -+ let adr_off = read_in "objdump -h %s | grep ' .data '" in -+ let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'" in -+ -+ let ic = open_in file in -+ let _ = seek_in ic (get_offset adr_off adr_sec) in -+ let header = (input_value ic : Natdynlink.dynheader) in -+ if header.magic <> Natdynlink.dyn_magic_number then -+ raise(Error(Natdynlink.Not_a_bytecode_file file)) -+ else begin -+ List.iter -+ (fun ui -> -+ print_infos -+ ui.name -+ ui.crc -+ ui.defines -+ ui.imports_cmi -+ ui.imports_cmx) -+ header.units -+ end --- -2.7.4 - diff --git a/0005-configure-Allow-user-defined-C-compiler-flags.patch b/0005-configure-Allow-user-defined-C-compiler-flags.patch deleted file mode 100644 index 32deef5..0000000 --- a/0005-configure-Allow-user-defined-C-compiler-flags.patch +++ /dev/null @@ -1,27 +0,0 @@ -From 613c9273f4cd73eb6e6750d8be29d7fa7f5a68c9 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 29 May 2012 20:44:18 +0100 -Subject: [PATCH 05/20] configure: Allow user defined C compiler flags. - ---- - configure | 4 ++++ - 1 file changed, 4 insertions(+) - -diff --git a/configure b/configure -index 4ea1498..d006010 100755 ---- a/configure -+++ b/configure -@@ -1701,6 +1701,10 @@ case "$buggycc" in - nativecccompopts="$nativecccompopts -fomit-frame-pointer";; - esac - -+# Allow user defined C Compiler flags -+bytecccompopts="$bytecccompopts $CFLAGS" -+nativecccompopts="$nativecccompopts $CFLAGS" -+ - # Finish generated files - - cclibs="$cclibs $mathlib" --- -2.7.4 - diff --git a/0006-Add-support-for-ppc64.patch b/0006-Add-support-for-ppc64.patch deleted file mode 100644 index 594f0ab..0000000 --- a/0006-Add-support-for-ppc64.patch +++ /dev/null @@ -1,2130 +0,0 @@ -From d1b5848cac51fc63723cdecb857f520caa0b27a2 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 29 May 2012 20:47:07 +0100 -Subject: [PATCH 06/20] Add support for ppc64. - -Note (1): This patch was rejected upstream because they don't have -appropriate hardware for testing. - -Note (2): Upstream powerpc directory has some support for ppc64, but -only for Macs, and I couldn't get it to work at all with IBM hardware. - -This patch was collaborated on by several people, most notably -David Woodhouse. - -Includes fix for position of stack arguments to external C functions -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.01.0. ---- - 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 | 101 +++++ - asmrun/Makefile | 6 + - asmrun/power64-elf.S | 486 +++++++++++++++++++++ - asmrun/stack.h | 9 + - configure | 3 + - 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 - create mode 100644 asmcomp/power64/reload.ml - create mode 100644 asmcomp/power64/scheduling.ml - create mode 100644 asmcomp/power64/selection.ml - create mode 100644 asmrun/power64-elf.S - -diff --git a/asmcomp/power64/arch.ml b/asmcomp/power64/arch.ml -new file mode 100644 -index 0000000..73c516d ---- /dev/null -+++ b/asmcomp/power64/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 = true -+ -+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/power64/emit.mlp b/asmcomp/power64/emit.mlp -new file mode 100644 -index 0000000..d84ac5c ---- /dev/null -+++ b/asmcomp/power64/emit.mlp -@@ -0,0 +1,988 @@ -+(***********************************************************************) -+(* *) -+(* 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 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) -> 6 -+ | Lop(Icall_imm s) -> 7 -+ | Lop(Itailcall_ind) -> if !contains_calls then 7 else if has_stack_frame() then 5 else 4 -+ | Lop(Itailcall_imm s) -> if s = !function_name then 1 else -+ if !contains_calls then 8 else -+ if has_stack_frame() then 6 else 5 -+ | Lop(Iextcall(s, true)) -> 8 -+ | Lop(Iextcall(s, false)) -> 7 -+ | 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},40({emit_gpr 1})\n`; -+ ` ld {emit_gpr 2}, 8({emit_reg i.arg.(0)})\n`; -+ ` ld {emit_reg i.arg.(0)}, 0({emit_reg i.arg.(0)})\n`; -+ ` mtctr {emit_reg i.arg.(0)}\n`; -+ record_frame i.live; -+ ` bctrl\n`; -+ ` ld {emit_gpr 2},40({emit_gpr 1})\n` -+ | Lop(Icall_imm s) -> -+ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,0))}\n`; -+ ` std {emit_gpr 2},40({emit_gpr 1})\n`; -+ ` ld {emit_gpr 2}, 8({emit_gpr 11})\n`; -+ ` ld {emit_gpr 11}, 0({emit_gpr 11})\n`; -+ ` mtctr {emit_gpr 11}\n`; -+ record_frame i.live; -+ ` bctrl\n`; -+ ` ld {emit_gpr 2},40({emit_gpr 1})\n` -+ | Lop(Itailcall_ind) -> -+ ` ld {emit_gpr 2}, 8({emit_reg i.arg.(0)})\n`; -+ ` ld {emit_reg i.arg.(0)}, 0({emit_reg i.arg.(0)})\n`; -+ ` 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 11}, 16({emit_gpr 1})\n`; -+ ` mtlr {emit_gpr 11}\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 11}, 16({emit_gpr 1})\n`; -+ ` mtlr {emit_gpr 11}\n` -+ end; -+ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,0))}\n`; -+ ` ld {emit_gpr 2}, 8({emit_gpr 11})\n`; -+ ` ld {emit_gpr 11}, 0({emit_gpr 11})\n`; -+ ` mtctr {emit_gpr 11}\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}, 40({emit_gpr 1})\n`; -+ ` ld {emit_gpr 2}, 8({emit_gpr 12})\n`; -+ ` ld {emit_gpr 12}, 0({emit_gpr 12})\n`; -+ ` mtctr {emit_gpr 12}\n`; -+ if alloc then record_frame i.live; -+ ` bctrl\n`; -+ ` ld {emit_gpr 2}, 40({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 11}, {emit_label !stack_size_lbl}+16({emit_gpr 1})\n`; -+ ` mtlr {emit_gpr 11}\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" -> -+ ` .section \".opd\",\"aw\"\n`; -+ ` .align 3\n`; -+ ` .type {emit_symbol fundecl.fun_name}, @function\n`; -+ `{emit_symbol fundecl.fun_name}:\n`; -+ ` .quad .L.{emit_symbol fundecl.fun_name},.TOC.@tocbase\n`; -+ ` .previous\n`; -+ ` .align 2\n`; -+ emit_string code_space; -+ `.L.{emit_symbol fundecl.fun_name}:\n` -+ | _ -> -+ ` .align 2\n`; -+ emit_string code_space; -+ `{emit_symbol fundecl.fun_name}:\n` -+ end; -+ 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 .L.{emit_symbol fundecl.fun_name}, . - .L.{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`; -+ ` ld {emit_gpr 12}, 0({emit_gpr 12})\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_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/power64/proc.ml b/asmcomp/power64/proc.ml -new file mode 100644 -index 0000000..372303d ---- /dev/null -+++ b/asmcomp/power64/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/power64/reload.ml b/asmcomp/power64/reload.ml -new file mode 100644 -index 0000000..abcac6c ---- /dev/null -+++ b/asmcomp/power64/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/power64/scheduling.ml b/asmcomp/power64/scheduling.ml -new file mode 100644 -index 0000000..b7bba9b ---- /dev/null -+++ b/asmcomp/power64/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/power64/selection.ml b/asmcomp/power64/selection.ml -new file mode 100644 -index 0000000..53b7828 ---- /dev/null -+++ b/asmcomp/power64/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 37b6182..788fee9 100644 ---- a/asmrun/Makefile -+++ b/asmrun/Makefile -@@ -122,6 +122,12 @@ power.p.o: power-$(SYSTEM).o - power.pic.o: power-$(SYSTEM).pic.o - cp power-$(SYSTEM).pic.o power.pic.o - -+power64.o: power64-$(SYSTEM).o -+ cp power64-$(SYSTEM).o power64.o -+ -+power64.p.o: power64-$(SYSTEM).o -+ cp power64-$(SYSTEM).o power64.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 -new file mode 100644 -index 0000000..b2c24d6 ---- /dev/null -+++ b/asmrun/power64-elf.S -@@ -0,0 +1,486 @@ -+/*********************************************************************/ -+/* */ -+/* 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 GNU Library General Public License, with */ -+/* the special exception on linking described in file ../LICENSE. */ -+/* */ -+/*********************************************************************/ -+ -+/* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ */ -+ -+#define Addrglobal(reg,glob) \ -+ addis reg, 0, glob@ha; \ -+ addi reg, reg, glob@l -+#define Loadglobal(reg,glob,tmp) \ -+ addis tmp, 0, glob@ha; \ -+ ld reg, glob@l(tmp) -+#define Storeglobal(reg,glob,tmp) \ -+ addis tmp, 0, glob@ha; \ -+ std reg, glob@l(tmp) -+ -+ .section ".text" -+ -+/* Invoke the garbage collector. */ -+ -+ .globl caml_call_gc -+ .type caml_call_gc, @function -+ .section ".opd","aw" -+ .align 3 -+caml_call_gc: -+ .quad .L.caml_call_gc,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_call_gc: -+ /* Set up stack frame */ -+ mflr 0 -+ std 0, 16(1) -+ /* Record return address into Caml code */ -+ Storeglobal(0, caml_last_return_address, 11) -+ /* Record lowest stack address */ -+ Storeglobal(1, caml_bottom_of_stack, 11) -+ /* 0x220 = 8*32 (int regs) + 8*32 (float regs) + 48 (stack frame) */ -+ stdu 1, -0x230(1) -+ /* Record pointer to register array */ -+ addi 0, 1, 8*32 + 48 -+ Storeglobal(0, caml_gc_regs, 11) -+ /* Save current allocation pointer for debugging purposes */ -+ Storeglobal(31, caml_young_ptr, 11) -+ /* Save exception pointer (if e.g. a sighandler raises) */ -+ Storeglobal(29, caml_exception_pointer, 11) -+ /* Save all registers used by the code generator */ -+ addi 11, 1, 8*32 + 48 - 8 -+ stdu 3, 8(11) -+ stdu 4, 8(11) -+ stdu 5, 8(11) -+ stdu 6, 8(11) -+ stdu 7, 8(11) -+ stdu 8, 8(11) -+ stdu 9, 8(11) -+ stdu 10, 8(11) -+ stdu 14, 8(11) -+ stdu 15, 8(11) -+ stdu 16, 8(11) -+ stdu 17, 8(11) -+ stdu 18, 8(11) -+ stdu 19, 8(11) -+ stdu 20, 8(11) -+ stdu 21, 8(11) -+ stdu 22, 8(11) -+ stdu 23, 8(11) -+ stdu 24, 8(11) -+ stdu 25, 8(11) -+ stdu 26, 8(11) -+ stdu 27, 8(11) -+ stdu 28, 8(11) -+ addi 11, 1, 48 - 8 -+ stfdu 1, 8(11) -+ stfdu 2, 8(11) -+ stfdu 3, 8(11) -+ stfdu 4, 8(11) -+ stfdu 5, 8(11) -+ stfdu 6, 8(11) -+ stfdu 7, 8(11) -+ stfdu 8, 8(11) -+ stfdu 9, 8(11) -+ stfdu 10, 8(11) -+ stfdu 11, 8(11) -+ stfdu 12, 8(11) -+ stfdu 13, 8(11) -+ stfdu 14, 8(11) -+ stfdu 15, 8(11) -+ stfdu 16, 8(11) -+ stfdu 17, 8(11) -+ stfdu 18, 8(11) -+ stfdu 19, 8(11) -+ stfdu 20, 8(11) -+ stfdu 21, 8(11) -+ stfdu 22, 8(11) -+ stfdu 23, 8(11) -+ stfdu 24, 8(11) -+ stfdu 25, 8(11) -+ stfdu 26, 8(11) -+ stfdu 27, 8(11) -+ stfdu 28, 8(11) -+ stfdu 29, 8(11) -+ stfdu 30, 8(11) -+ stfdu 31, 8(11) -+ /* Call the GC */ -+ std 2,40(1) -+ Addrglobal(11, caml_garbage_collection) -+ ld 2,8(11) -+ ld 11,0(11) -+ mtlr 11 -+ blrl -+ ld 2,40(1) -+ /* Reload new allocation pointer and allocation limit */ -+ Loadglobal(31, caml_young_ptr, 11) -+ Loadglobal(30, caml_young_limit, 11) -+ /* Restore all regs used by the code generator */ -+ addi 11, 1, 8*32 + 48 - 8 -+ ldu 3, 8(11) -+ ldu 4, 8(11) -+ ldu 5, 8(11) -+ ldu 6, 8(11) -+ ldu 7, 8(11) -+ ldu 8, 8(11) -+ ldu 9, 8(11) -+ ldu 10, 8(11) -+ ldu 14, 8(11) -+ ldu 15, 8(11) -+ ldu 16, 8(11) -+ ldu 17, 8(11) -+ ldu 18, 8(11) -+ ldu 19, 8(11) -+ ldu 20, 8(11) -+ ldu 21, 8(11) -+ ldu 22, 8(11) -+ ldu 23, 8(11) -+ ldu 24, 8(11) -+ ldu 25, 8(11) -+ ldu 26, 8(11) -+ ldu 27, 8(11) -+ ldu 28, 8(11) -+ addi 11, 1, 48 - 8 -+ lfdu 1, 8(11) -+ lfdu 2, 8(11) -+ lfdu 3, 8(11) -+ lfdu 4, 8(11) -+ lfdu 5, 8(11) -+ lfdu 6, 8(11) -+ lfdu 7, 8(11) -+ lfdu 8, 8(11) -+ lfdu 9, 8(11) -+ lfdu 10, 8(11) -+ lfdu 11, 8(11) -+ lfdu 12, 8(11) -+ lfdu 13, 8(11) -+ lfdu 14, 8(11) -+ lfdu 15, 8(11) -+ lfdu 16, 8(11) -+ lfdu 17, 8(11) -+ lfdu 18, 8(11) -+ lfdu 19, 8(11) -+ lfdu 20, 8(11) -+ lfdu 21, 8(11) -+ lfdu 22, 8(11) -+ lfdu 23, 8(11) -+ lfdu 24, 8(11) -+ lfdu 25, 8(11) -+ lfdu 26, 8(11) -+ lfdu 27, 8(11) -+ lfdu 28, 8(11) -+ lfdu 29, 8(11) -+ lfdu 30, 8(11) -+ lfdu 31, 8(11) -+ /* Return to caller, restarting the allocation */ -+ Loadglobal(0, caml_last_return_address, 11) -+ addic 0, 0, -16 /* Restart the allocation (4 instructions) */ -+ mtlr 0 -+ /* Say we are back into Caml code */ -+ li 12, 0 -+ Storeglobal(12, caml_last_return_address, 11) -+ /* Deallocate stack frame */ -+ ld 1, 0(1) -+ /* Return */ -+ blr -+ .size .L.caml_call_gc,.-.L.caml_call_gc -+ -+/* Call a C function from Caml */ -+ -+ .globl caml_c_call -+ .type caml_c_call, @function -+ .section ".opd","aw" -+ .align 3 -+caml_c_call: -+ .quad .L.caml_c_call,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_c_call: -+ .cfi_startproc -+ /* Save return address */ -+ mflr 25 -+ .cfi_register lr,25 -+ /* Get ready to call C function (address in 11) */ -+ ld 2, 8(11) -+ ld 11,0(11) -+ mtlr 11 -+ /* Record lowest stack address and return address */ -+ Storeglobal(1, caml_bottom_of_stack, 12) -+ Storeglobal(25, caml_last_return_address, 12) -+ /* Make the exception handler and alloc ptr available to the C code */ -+ Storeglobal(31, caml_young_ptr, 11) -+ Storeglobal(29, caml_exception_pointer, 11) -+ /* Call the function (address in link register) */ -+ blrl -+ /* Restore return address (in 25, preserved by the C function) */ -+ mtlr 25 -+ /* Reload allocation pointer and allocation limit*/ -+ Loadglobal(31, caml_young_ptr, 11) -+ Loadglobal(30, caml_young_limit, 11) -+ /* Say we are back into Caml code */ -+ li 12, 0 -+ Storeglobal(12, caml_last_return_address, 11) -+ /* Return to caller */ -+ blr -+ .cfi_endproc -+ .size .L.caml_c_call,.-.L.caml_c_call -+ -+/* Raise an exception from C */ -+ -+ .globl caml_raise_exception -+ .type caml_raise_exception, @function -+ .section ".opd","aw" -+ .align 3 -+caml_raise_exception: -+ .quad .L.caml_raise_exception,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_raise_exception: -+ /* Reload Caml global registers */ -+ Loadglobal(29, caml_exception_pointer, 11) -+ Loadglobal(31, caml_young_ptr, 11) -+ Loadglobal(30, caml_young_limit, 11) -+ /* Say we are back into Caml code */ -+ li 0, 0 -+ Storeglobal(0, caml_last_return_address, 11) -+ /* Pop trap frame */ -+ ld 0, 8(29) -+ ld 1, 16(29) -+ mtlr 0 -+ ld 2, 24(29) -+ ld 29, 0(29) -+ /* Branch to handler */ -+ blr -+ .size .L.caml_raise_exception,.-.L.caml_raise_exception -+ -+/* Start the Caml program */ -+ -+ .globl caml_start_program -+ .type caml_start_program, @function -+ .section ".opd","aw" -+ .align 3 -+caml_start_program: -+ .quad .L.caml_start_program,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_start_program: -+ Addrglobal(12, caml_program) -+ -+/* Code shared between caml_start_program and caml_callback */ -+.L102: -+ /* Allocate and link stack frame */ -+ mflr 0 -+ std 0, 16(1) -+ stdu 1, -0x190(1) /* 48 + 8*36(regs) + 32(callback) + 32(exc) */ -+ /* Save return address */ -+ /* Save all callee-save registers */ -+ /* GPR 14 ... GPR 31 then FPR 14 ... FPR 31 starting at sp+16 */ -+ addi 11, 1, 48-8 -+ stdu 14, 8(11) -+ stdu 15, 8(11) -+ stdu 16, 8(11) -+ stdu 17, 8(11) -+ stdu 18, 8(11) -+ stdu 19, 8(11) -+ stdu 20, 8(11) -+ stdu 21, 8(11) -+ stdu 22, 8(11) -+ stdu 23, 8(11) -+ stdu 24, 8(11) -+ stdu 25, 8(11) -+ stdu 26, 8(11) -+ stdu 27, 8(11) -+ stdu 28, 8(11) -+ stdu 29, 8(11) -+ stdu 30, 8(11) -+ stdu 31, 8(11) -+ stfdu 14, 8(11) -+ stfdu 15, 8(11) -+ stfdu 16, 8(11) -+ stfdu 17, 8(11) -+ stfdu 18, 8(11) -+ stfdu 19, 8(11) -+ stfdu 20, 8(11) -+ stfdu 21, 8(11) -+ stfdu 22, 8(11) -+ stfdu 23, 8(11) -+ stfdu 24, 8(11) -+ stfdu 25, 8(11) -+ stfdu 26, 8(11) -+ stfdu 27, 8(11) -+ stfdu 28, 8(11) -+ stfdu 29, 8(11) -+ stfdu 30, 8(11) -+ stfdu 31, 8(11) -+ /* Set up a callback link */ -+ Loadglobal(9, caml_bottom_of_stack, 11) -+ Loadglobal(10, caml_last_return_address, 11) -+ Loadglobal(11, caml_gc_regs, 11) -+ std 9, 0x150(1) -+ std 10, 0x158(1) -+ std 11, 0x160(1) -+ /* Build an exception handler to catch exceptions escaping out of Caml */ -+ bl .L103 -+ b .L104 -+.L103: -+ mflr 0 -+ addi 29, 1, 0x170 /* Alignment */ -+ std 0, 8(29) -+ std 1, 16(29) -+ std 2, 24(29) -+ Loadglobal(11, caml_exception_pointer, 11) -+ std 11, 0(29) -+ /* Reload allocation pointers */ -+ Loadglobal(31, caml_young_ptr, 11) -+ Loadglobal(30, caml_young_limit, 11) -+ /* Say we are back into Caml code */ -+ li 0, 0 -+ Storeglobal(0, caml_last_return_address, 11) -+ /* Call the Caml code */ -+ std 2,40(1) -+ ld 2,8(12) -+ ld 12,0(12) -+ mtlr 12 -+.L105: -+ blrl -+ ld 2,40(1) -+ /* Pop the trap frame, restoring caml_exception_pointer */ -+ ld 9, 0x170(1) -+ Storeglobal(9, caml_exception_pointer, 11) -+ /* Pop the callback link, restoring the global variables */ -+.L106: -+ ld 9, 0x150(1) -+ ld 10, 0x158(1) -+ ld 11, 0x160(1) -+ Storeglobal(9, caml_bottom_of_stack, 12) -+ Storeglobal(10, caml_last_return_address, 12) -+ Storeglobal(11, caml_gc_regs, 12) -+ /* Update allocation pointer */ -+ Storeglobal(31, caml_young_ptr, 11) -+ /* Restore callee-save registers */ -+ addi 11, 1, 48-8 -+ ldu 14, 8(11) -+ ldu 15, 8(11) -+ ldu 16, 8(11) -+ ldu 17, 8(11) -+ ldu 18, 8(11) -+ ldu 19, 8(11) -+ ldu 20, 8(11) -+ ldu 21, 8(11) -+ ldu 22, 8(11) -+ ldu 23, 8(11) -+ ldu 24, 8(11) -+ ldu 25, 8(11) -+ ldu 26, 8(11) -+ ldu 27, 8(11) -+ ldu 28, 8(11) -+ ldu 29, 8(11) -+ ldu 30, 8(11) -+ ldu 31, 8(11) -+ lfdu 14, 8(11) -+ lfdu 15, 8(11) -+ lfdu 16, 8(11) -+ lfdu 17, 8(11) -+ lfdu 18, 8(11) -+ lfdu 19, 8(11) -+ lfdu 20, 8(11) -+ lfdu 21, 8(11) -+ lfdu 22, 8(11) -+ lfdu 23, 8(11) -+ lfdu 24, 8(11) -+ lfdu 25, 8(11) -+ lfdu 26, 8(11) -+ lfdu 27, 8(11) -+ lfdu 28, 8(11) -+ lfdu 29, 8(11) -+ lfdu 30, 8(11) -+ lfdu 31, 8(11) -+ /* Return */ -+ ld 1,0(1) -+ /* Reload return address */ -+ ld 0, 16(1) -+ mtlr 0 -+ blr -+ -+ /* The trap handler: */ -+.L104: -+ /* Update caml_exception_pointer */ -+ Storeglobal(29, caml_exception_pointer, 11) -+ /* Encode exception bucket as an exception result and return it */ -+ ori 3, 3, 2 -+ b .L106 -+ .size .L.caml_start_program,.-.L.caml_start_program -+ -+/* Callback from C to Caml */ -+ -+ .globl caml_callback_exn -+ .type caml_callback_exn, @function -+ .section ".opd","aw" -+ .align 3 -+caml_callback_exn: -+ .quad .L.caml_callback_exn,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_callback_exn: -+ /* Initial shuffling of arguments */ -+ mr 0, 3 /* Closure */ -+ mr 3, 4 /* Argument */ -+ mr 4, 0 -+ ld 12, 0(4) /* Code pointer */ -+ b .L102 -+ .size .L.caml_callback_exn,.-.L.caml_callback_exn -+ -+ -+ .globl caml_callback2_exn -+ .type caml_callback2_exn, @function -+ .section ".opd","aw" -+ .align 3 -+caml_callback2_exn: -+ .quad .L.caml_callback2_exn,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_callback2_exn: -+ mr 0, 3 /* Closure */ -+ mr 3, 4 /* First argument */ -+ mr 4, 5 /* Second argument */ -+ mr 5, 0 -+ Addrglobal(12, caml_apply2) -+ b .L102 -+ .size .L.caml_callback2_exn,.-.L.caml_callback2_exn -+ -+ -+ .globl caml_callback3_exn -+ .type caml_callback3_exn, @function -+ .section ".opd","aw" -+ .align 3 -+caml_callback3_exn: -+ .quad .L.caml_callback3_exn,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_callback3_exn: -+ mr 0, 3 /* Closure */ -+ mr 3, 4 /* First argument */ -+ mr 4, 5 /* Second argument */ -+ mr 5, 6 /* Third argument */ -+ mr 6, 0 -+ Addrglobal(12, caml_apply3) -+ b .L102 -+ .size .L.caml_callback3_exn,.-.L.caml_callback3_exn -+ -+/* Frame table */ -+ -+ .section ".data" -+ .globl caml_system__frametable -+ .type caml_system__frametable, @object -+caml_system__frametable: -+ .quad 1 /* one descriptor */ -+ .quad .L105 + 4 /* return address into callback */ -+ .short -1 /* negative size count => use callback link */ -+ .short 0 /* no roots here */ -+ .align 3 -+ -diff --git a/asmrun/stack.h b/asmrun/stack.h -index 6e55942..81263da 100644 ---- a/asmrun/stack.h -+++ b/asmrun/stack.h -@@ -46,6 +46,15 @@ - #define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) - #endif - -+#ifdef TARGET_power64 -+#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/configure b/configure -index d006010..cb289fb 100755 ---- a/configure -+++ b/configure -@@ -843,6 +843,7 @@ case "$target" in - fi;; - i[3456]86-*-gnu*) arch=i386; system=gnu;; - i[3456]86-*-mingw*) arch=i386; system=mingw;; -+ 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-*-openbsd*) arch=power; model=ppc; system=bsd_elf;; -@@ -923,6 +924,8 @@ case "$arch,$system" in - aspp="/usr/ccs/bin/${TOOLPREF}as -P";; - power,elf) as="${TOOLPREF}as -u -m ppc" - aspp="${TOOLPREF}gcc -c";; -+ power64,elf) as='${TOOLPREF}as -u -m ppc64' -+ aspp='${TOOLPREF}gcc -c';; - power,rhapsody) as="${TOOLPREF}as -arch $model" - aspp="$bytecc -c";; - sparc,solaris) as="${TOOLPREF}as" --- -2.7.4 - diff --git a/0007-ppc64-Update-for-OCaml-4.02.0.patch b/0007-ppc64-Update-for-OCaml-4.02.0.patch deleted file mode 100644 index 0905585..0000000 --- a/0007-ppc64-Update-for-OCaml-4.02.0.patch +++ /dev/null @@ -1,205 +0,0 @@ -From 49dcd94b5db72c7d6d0801309ca1e218b759fa00 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Fri, 24 Oct 2014 12:59:23 +0200 -Subject: [PATCH 07/20] ppc64: Update for OCaml 4.02.0. - -These are based on the power (ppc32) branch and some guesswork. -In particular, I'm not convinced that my changes to floating -point constant handling are correct, although I wrote a small -test program which worked. - -Therefore these are not yet integrated into the main patch. ---- - asmcomp/power64/CSE.ml | 37 +++++++++++++++++++++++++++++++++++++ - asmcomp/power64/emit.mlp | 23 ++++++++++++++--------- - asmcomp/power64/proc.ml | 8 ++++---- - asmcomp/power64/scheduling.ml | 2 +- - 4 files changed, 56 insertions(+), 14 deletions(-) - create mode 100644 asmcomp/power64/CSE.ml - -diff --git a/asmcomp/power64/CSE.ml b/asmcomp/power64/CSE.ml -new file mode 100644 -index 0000000..ec10d2d ---- /dev/null -+++ b/asmcomp/power64/CSE.ml -@@ -0,0 +1,37 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) -+(* *) -+(* Copyright 2014 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* CSE for the PowerPC *) -+ -+open Arch -+open Mach -+open CSEgen -+ -+class cse = object (self) -+ -+inherit cse_generic as super -+ -+method! class_of_operation op = -+ match op with -+ | Ispecific(Imultaddf | Imultsubf) -> Op_pure -+ | Ispecific(Ialloc_far _) -> Op_other -+ | _ -> super#class_of_operation op -+ -+method! is_cheap_operation op = -+ match op with -+ | Iconst_int n | Iconst_blockheader n -> n <= 32767n && n >= -32768n -+ | _ -> false -+ -+end -+ -+let fundecl f = -+ (new cse)#fundecl f -diff --git a/asmcomp/power64/emit.mlp b/asmcomp/power64/emit.mlp -index d84ac5c..9fd59b2 100644 ---- a/asmcomp/power64/emit.mlp -+++ b/asmcomp/power64/emit.mlp -@@ -292,6 +292,7 @@ let name_for_int_comparison = function - let name_for_intop = function - Iadd -> "add" - | Imul -> "mulld" -+ | Imulh -> "mulhd" - | Idiv -> "divd" - | Iand -> "and" - | Ior -> "or" -@@ -354,7 +355,8 @@ let load_store_size = function - 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_int n | Iconst_blockheader n) -> -+ if is_native_immediate n then 1 else 2 - | Lop(Iconst_float s) -> 2 - | Lop(Iconst_symbol s) -> 2 - | Lop(Icall_ind) -> 6 -@@ -370,7 +372,7 @@ let instr_size = function - if chunk = Byte_signed - then load_store_size addr + 1 - else load_store_size addr -- | Lop(Istore(chunk, addr)) -> 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 -@@ -397,7 +399,7 @@ let instr_size = function - | Lsetuptrap lbl -> 1 - | Lpushtrap -> 7 - | Lpoptrap -> 1 -- | Lraise -> 6 -+ | Lraise _ -> 6 - - let label_map code = - let map = Hashtbl.create 37 in -@@ -492,7 +494,7 @@ let rec emit_instr i dslot = - | (_, _) -> - fatal_error "Emit: Imove" - end -- | Lop(Iconst_int n) -> -+ | Lop(Iconst_int n | Iconst_blockheader 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 -@@ -502,7 +504,8 @@ let rec emit_instr i dslot = - end else begin - ` ld {emit_reg i.res.(0)}, {emit_tocref (TocInt n)}\n` - end -- | Lop(Iconst_float s) -> -+ | Lop(Iconst_float f) -> -+ let s = string_of_float f in - ` 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` -@@ -581,7 +584,7 @@ let rec emit_instr i dslot = - 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)) -> -+ | Lop(Istore(chunk, addr, _)) -> - let storeinstr = - match chunk with - Byte_unsigned | Byte_signed -> "stb" -@@ -772,7 +775,7 @@ let rec emit_instr i dslot = - ` mr {emit_gpr 29}, {emit_gpr 11}\n` - | Lpoptrap -> - ` ld {emit_gpr 29}, 0({emit_gpr 29})\n` -- | Lraise -> -+ | 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`; -@@ -903,9 +906,11 @@ let emit_item = function - | Cint n -> - ` .quad {emit_nativeint n}\n` - | Csingle f -> -- ` .float 0d{emit_string f}\n` -+ let s = string_of_float f in -+ ` .float 0d{emit_string s}\n` - | Cdouble f -> -- ` .double 0d{emit_string f}\n` -+ let s = string_of_float f in -+ ` .double 0d{emit_string s}\n` - | Csymbol_address s -> - ` .quad {emit_symbol s}\n` - | Clabel_address lbl -> -diff --git a/asmcomp/power64/proc.ml b/asmcomp/power64/proc.ml -index 372303d..a5a35f3 100644 ---- a/asmcomp/power64/proc.ml -+++ b/asmcomp/power64/proc.ml -@@ -85,11 +85,11 @@ let rotate_registers = true - (* Representation of hard registers by pseudo-registers *) - - let hard_int_reg = -- let v = Array.create 23 Reg.dummy in -+ let v = Array.make 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 -+ let v = Array.make 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 = -@@ -105,7 +105,7 @@ let stack_slot slot ty = - - 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 loc = Array.make (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref stack_ofs in -@@ -159,7 +159,7 @@ let loc_results res = - - let poweropen_external_conventions first_int last_int - first_float last_float arg = -- let loc = Array.create (Array.length arg) Reg.dummy in -+ let loc = Array.make (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref (14 * size_addr) in -diff --git a/asmcomp/power64/scheduling.ml b/asmcomp/power64/scheduling.ml -index b7bba9b..b582b6a 100644 ---- a/asmcomp/power64/scheduling.ml -+++ b/asmcomp/power64/scheduling.ml -@@ -46,7 +46,7 @@ method reload_retaddr_latency = 12 - method oper_issue_cycles = function - Iconst_float _ | Iconst_symbol _ -> 2 - | Iload(_, Ibased(_, _)) -> 2 -- | Istore(_, Ibased(_, _)) -> 2 -+ | Istore(_, Ibased(_, _), _) -> 2 - | Ialloc _ -> 4 - | Iintop(Imod) -> 40 (* assuming full stall *) - | Iintop(Icomp _) -> 4 --- -2.7.4 - diff --git a/0008-Add-support-for-ppc64le.patch b/0008-Add-support-for-ppc64le.patch deleted file mode 100644 index ef1fc8c..0000000 --- a/0008-Add-support-for-ppc64le.patch +++ /dev/null @@ -1,1917 +0,0 @@ -From d63e08ea4d073b2f5d5297eff396110d949c0352 Mon Sep 17 00:00:00 2001 -From: Michel Normand -Date: Tue, 18 Mar 2014 09:15:47 -0400 -Subject: [PATCH 08/20] 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 788fee9..a63321e 100644 ---- a/asmrun/Makefile -+++ b/asmrun/Makefile -@@ -128,6 +128,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 81263da..e23da0c 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 cb289fb..6157157 100755 ---- a/configure -+++ b/configure -@@ -844,6 +844,7 @@ case "$target" in - i[3456]86-*-gnu*) arch=i386; system=gnu;; - i[3456]86-*-mingw*) arch=i386; system=mingw;; - 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;; -@@ -926,6 +927,8 @@ case "$arch,$system" in - aspp="${TOOLPREF}gcc -c";; - power64,elf) as='${TOOLPREF}as -u -m ppc64' - aspp='${TOOLPREF}gcc -c';; -+ power64le,elf) as='${TOOLPREF}as -u -m ppc64' -+ aspp='${TOOLPREF}gcc -c';; - power,rhapsody) as="${TOOLPREF}as -arch $model" - aspp="$bytecc -c";; - sparc,solaris) as="${TOOLPREF}as" --- -2.7.4 - diff --git a/0009-ppc64le-Update-for-OCaml-4.02.0.patch b/0009-ppc64le-Update-for-OCaml-4.02.0.patch deleted file mode 100644 index 9d0858b..0000000 --- a/0009-ppc64le-Update-for-OCaml-4.02.0.patch +++ /dev/null @@ -1,204 +0,0 @@ -From 5abd39f1a1e4f7c4dd0c1b1252f98e7ee5a95e27 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Fri, 24 Oct 2014 12:59:23 +0200 -Subject: [PATCH 09/20] ppc64le: Update for OCaml 4.02.0. - -These are based on the power (ppc32) branch and some guesswork. In -particular, I'm not convinced that my changes to floating point -constant handling are correct. - -Therefore these are not yet integrated into the main patch. ---- - asmcomp/power64le/CSE.ml | 37 +++++++++++++++++++++++++++++++++++++ - asmcomp/power64le/emit.mlp | 23 ++++++++++++++--------- - asmcomp/power64le/proc.ml | 8 ++++---- - asmcomp/power64le/scheduling.ml | 2 +- - 4 files changed, 56 insertions(+), 14 deletions(-) - create mode 100644 asmcomp/power64le/CSE.ml - -diff --git a/asmcomp/power64le/CSE.ml b/asmcomp/power64le/CSE.ml -new file mode 100644 -index 0000000..ec10d2d ---- /dev/null -+++ b/asmcomp/power64le/CSE.ml -@@ -0,0 +1,37 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) -+(* *) -+(* Copyright 2014 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* CSE for the PowerPC *) -+ -+open Arch -+open Mach -+open CSEgen -+ -+class cse = object (self) -+ -+inherit cse_generic as super -+ -+method! class_of_operation op = -+ match op with -+ | Ispecific(Imultaddf | Imultsubf) -> Op_pure -+ | Ispecific(Ialloc_far _) -> Op_other -+ | _ -> super#class_of_operation op -+ -+method! is_cheap_operation op = -+ match op with -+ | Iconst_int n | Iconst_blockheader n -> n <= 32767n && n >= -32768n -+ | _ -> false -+ -+end -+ -+let fundecl f = -+ (new cse)#fundecl f -diff --git a/asmcomp/power64le/emit.mlp b/asmcomp/power64le/emit.mlp -index 5736a18..3f34102 100644 ---- a/asmcomp/power64le/emit.mlp -+++ b/asmcomp/power64le/emit.mlp -@@ -297,6 +297,7 @@ let name_for_int_comparison = function - let name_for_intop = function - Iadd -> "add" - | Imul -> "mulld" -+ | Imulh -> "mulhd" - | Idiv -> "divd" - | Iand -> "and" - | Ior -> "or" -@@ -359,7 +360,8 @@ let load_store_size = function - 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_int n | Iconst_blockheader n) -> -+ if is_native_immediate n then 1 else 2 - | Lop(Iconst_float s) -> 2 - | Lop(Iconst_symbol s) -> 2 - | Lop(Icall_ind) -> 4 -@@ -375,7 +377,7 @@ let instr_size = function - if chunk = Byte_signed - then load_store_size addr + 1 - else load_store_size addr -- | Lop(Istore(chunk, addr)) -> 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 -@@ -402,7 +404,7 @@ let instr_size = function - | Lsetuptrap lbl -> 1 - | Lpushtrap -> 7 - | Lpoptrap -> 1 -- | Lraise -> 6 -+ | Lraise _ -> 6 - - let label_map code = - let map = Hashtbl.create 37 in -@@ -497,7 +499,7 @@ let rec emit_instr i dslot = - | (_, _) -> - fatal_error "Emit: Imove" - end -- | Lop(Iconst_int n) -> -+ | Lop(Iconst_int n | Iconst_blockheader 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 -@@ -507,7 +509,8 @@ let rec emit_instr i dslot = - end else begin - ` ld {emit_reg i.res.(0)}, {emit_tocref (TocInt n)}\n` - end -- | Lop(Iconst_float s) -> -+ | Lop(Iconst_float f) -> -+ let s = string_of_float f in - ` 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` -@@ -576,7 +579,7 @@ let rec emit_instr i dslot = - 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)) -> -+ | Lop(Istore(chunk, addr, _)) -> - let storeinstr = - match chunk with - Byte_unsigned | Byte_signed -> "stb" -@@ -767,7 +770,7 @@ let rec emit_instr i dslot = - ` mr {emit_gpr 29}, {emit_gpr 11}\n` - | Lpoptrap -> - ` ld {emit_gpr 29}, 0({emit_gpr 29})\n` -- | Lraise -> -+ | 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`; -@@ -895,9 +898,11 @@ let emit_item = function - | Cint n -> - ` .quad {emit_nativeint n}\n` - | Csingle f -> -- ` .float 0d{emit_string f}\n` -+ let s = string_of_float f in -+ ` .float 0d{emit_string s}\n` - | Cdouble f -> -- ` .double 0d{emit_string f}\n` -+ let s = string_of_float f in -+ ` .double 0d{emit_string s}\n` - | Csymbol_address s -> - ` .quad {emit_symbol s}\n` - | Clabel_address lbl -> -diff --git a/asmcomp/power64le/proc.ml b/asmcomp/power64le/proc.ml -index 9b98577..476c984 100644 ---- a/asmcomp/power64le/proc.ml -+++ b/asmcomp/power64le/proc.ml -@@ -85,11 +85,11 @@ let rotate_registers = true - (* Representation of hard registers by pseudo-registers *) - - let hard_int_reg = -- let v = Array.create 23 Reg.dummy in -+ let v = Array.make 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 -+ let v = Array.make 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 = -@@ -105,7 +105,7 @@ let stack_slot slot ty = - - 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 loc = Array.make (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref stack_ofs in -@@ -159,7 +159,7 @@ let loc_results res = - - let poweropen_external_conventions first_int last_int - first_float last_float arg = -- let loc = Array.create (Array.length arg) Reg.dummy in -+ let loc = Array.make (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref (14 * size_addr) in -diff --git a/asmcomp/power64le/scheduling.ml b/asmcomp/power64le/scheduling.ml -index b7bba9b..b582b6a 100644 ---- a/asmcomp/power64le/scheduling.ml -+++ b/asmcomp/power64le/scheduling.ml -@@ -46,7 +46,7 @@ method reload_retaddr_latency = 12 - method oper_issue_cycles = function - Iconst_float _ | Iconst_symbol _ -> 2 - | Iload(_, Ibased(_, _)) -> 2 -- | Istore(_, Ibased(_, _)) -> 2 -+ | Istore(_, Ibased(_, _), _) -> 2 - | Ialloc _ -> 4 - | Iintop(Imod) -> 40 (* assuming full stall *) - | Iintop(Icomp _) -> 4 --- -2.7.4 - diff --git a/0010-arm-arm64-Mark-stack-as-non-executable.patch b/0010-arm-arm64-Mark-stack-as-non-executable.patch deleted file mode 100644 index b2500e8..0000000 --- a/0010-arm-arm64-Mark-stack-as-non-executable.patch +++ /dev/null @@ -1,39 +0,0 @@ -From e3a29e8c9e85c5d1a4dc28f2ab746dae57c2636b Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Sat, 10 May 2014 03:20:35 -0400 -Subject: [PATCH 10/20] 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 9720665..6a9eef0 100644 ---- a/asmrun/arm.S -+++ b/asmrun/arm.S -@@ -498,3 +498,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 9b4b9ab..c23168b 100644 ---- a/asmrun/arm64.S -+++ b/asmrun/arm64.S -@@ -549,3 +549,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.7.4 - diff --git a/0011-arg-Add-no_arg-and-get_arg-helper-functions.patch b/0011-arg-Add-no_arg-and-get_arg-helper-functions.patch deleted file mode 100644 index 78d5436..0000000 --- a/0011-arg-Add-no_arg-and-get_arg-helper-functions.patch +++ /dev/null @@ -1,118 +0,0 @@ -From e48a32ed47b6b5a77653ca3b40afb7c26aca7123 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 1 Apr 2014 11:17:07 +0100 -Subject: [PATCH 11/20] 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 d7b8ac0..a8f3964 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.7.4 - diff --git a/0012-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch b/0012-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch deleted file mode 100644 index ba60eac..0000000 --- a/0012-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch +++ /dev/null @@ -1,84 +0,0 @@ -From b5e341afca2bdb390255cb74b3e3f5d1e3971590 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 1 Apr 2014 11:21:40 +0100 -Subject: [PATCH 12/20] 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 a8f3964..f2b6f13 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 && 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 0999edf..71af638 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.7.4 - diff --git a/0013-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch b/0013-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch deleted file mode 100644 index 677fb0b..0000000 --- a/0013-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch +++ /dev/null @@ -1,1963 +0,0 @@ -From 341e1f0892d1c7d39057e733b035fce54568d28b Mon Sep 17 00:00:00 2001 -From: Xavier Leroy -Date: Wed, 27 Aug 2014 09:58:33 +0000 -Subject: [PATCH 13/20] PR#6517: use ISO C99 types {,u}int{32,64}_t in - preference to our homegrown types {,u}int{32,64}. - -git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15131 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 - ----------------------------------------------------------------------- -For Fedora: - -This commit was cherry picked from upstream -commit b868c05ec91a7ee193010a421de768a3b1a80952 (SVN 15131). - -See also: - -http://caml.inria.fr/mantis/view.php?id=6517 ---- - asmrun/backtrace.c | 6 +- - byterun/backtrace.c | 2 +- - byterun/caml/alloc.h | 4 +- - byterun/caml/config.h | 35 +++++++---- - byterun/caml/debugger.h | 28 ++++----- - byterun/caml/exec.h | 4 +- - byterun/caml/hash.h | 12 ++-- - byterun/caml/int64_emul.h | 114 ++++++++++++++++++------------------ - byterun/caml/int64_format.h | 4 +- - byterun/caml/int64_native.h | 20 +++---- - byterun/caml/intext.h | 12 ++-- - byterun/caml/io.h | 6 +- - byterun/caml/md5.h | 6 +- - byterun/caml/mlvalues.h | 12 ++-- - byterun/caml/startup.h | 4 +- - byterun/extern.c | 4 +- - byterun/fix_code.c | 8 +-- - byterun/floats.c | 6 +- - byterun/globroots.c | 4 +- - byterun/hash.c | 44 +++++++------- - byterun/intern.c | 20 +++---- - byterun/interp.c | 2 +- - byterun/ints.c | 112 +++++++++++++++++------------------ - byterun/io.c | 6 +- - byterun/md5.c | 26 ++++---- - byterun/startup.c | 10 ++-- - byterun/str.c | 20 +++---- - config/auto-aux/int64align.c | 14 ++--- - config/s-nt.h | 3 + - configure | 25 ++------ - otherlibs/bigarray/bigarray_stubs.c | 48 +++++++-------- - otherlibs/num/nat_stubs.c | 14 ++--- - otherlibs/unix/addrofstr.c | 2 +- - stdlib/header.c | 2 +- - 34 files changed, 319 insertions(+), 320 deletions(-) - -diff --git a/asmrun/backtrace.c b/asmrun/backtrace.c -index fafe13a..498c91a 100644 ---- a/asmrun/backtrace.c -+++ b/asmrun/backtrace.c -@@ -208,7 +208,7 @@ CAMLexport void extract_location_info(frame_descr * d, - /*out*/ struct caml_loc_info * li) - { - uintnat infoptr; -- uint32 info1, info2; -+ uint32_t info1, info2; - - /* If no debugging information available, print nothing. - When everything is compiled with -g, this corresponds to -@@ -223,8 +223,8 @@ CAMLexport void extract_location_info(frame_descr * d, - sizeof(char *) + sizeof(short) + sizeof(short) + - sizeof(short) * d->num_live + sizeof(frame_descr *) - 1) - & -sizeof(frame_descr *); -- info1 = ((uint32 *)infoptr)[0]; -- info2 = ((uint32 *)infoptr)[1]; -+ info1 = ((uint32_t *)infoptr)[0]; -+ info2 = ((uint32_t *)infoptr)[1]; - /* Format of the two info words: - llllllllllllllllllll aaaaaaaa bbbbbbbbbb nnnnnnnnnnnnnnnnnnnnnnnn kk - 44 36 26 2 0 -diff --git a/byterun/backtrace.c b/byterun/backtrace.c -index 008b199..b5672fe 100644 ---- a/byterun/backtrace.c -+++ b/byterun/backtrace.c -@@ -229,7 +229,7 @@ static void read_debug_info(void) - int fd; - struct exec_trailer trail; - struct channel * chan; -- uint32 num_events, orig, i; -+ uint32_t num_events, orig, i; - intnat j; - value evl, l, ev_start; - -diff --git a/byterun/caml/alloc.h b/byterun/caml/alloc.h -index f00a7ef..2a640eb 100644 ---- a/byterun/caml/alloc.h -+++ b/byterun/caml/alloc.h -@@ -32,8 +32,8 @@ CAMLextern value caml_alloc_string (mlsize_t); /* size in bytes */ - CAMLextern value caml_copy_string (char const *); - CAMLextern value caml_copy_string_array (char const **); - CAMLextern value caml_copy_double (double); --CAMLextern value caml_copy_int32 (int32); /* defined in [ints.c] */ --CAMLextern value caml_copy_int64 (int64); /* defined in [ints.c] */ -+CAMLextern value caml_copy_int32 (int32_t); /* defined in [ints.c] */ -+CAMLextern value caml_copy_int64 (int64_t); /* defined in [ints.c] */ - CAMLextern value caml_copy_nativeint (intnat); /* defined in [ints.c] */ - CAMLextern value caml_alloc_array (value (*funct) (char const *), - char const ** array); -diff --git a/byterun/caml/config.h b/byterun/caml/config.h -index 6f60836..cbe1999 100644 ---- a/byterun/caml/config.h -+++ b/byterun/caml/config.h -@@ -25,24 +25,30 @@ - #include "compatibility.h" - #endif - --/* Types for 32-bit integers, 64-bit integers, -+#ifdef HAS_STDINT_H -+#include -+#endif -+ -+/* Types for 32-bit integers, 64-bit integers, and - native integers (as wide as a pointer type) */ - -+#ifndef ARCH_INT32_TYPE - #if SIZEOF_INT == 4 --typedef int int32; --typedef unsigned int uint32; -+#define ARCH_INT32_TYPE int -+#define ARCH_UINT32_TYPE unsigned int - #define ARCH_INT32_PRINTF_FORMAT "" - #elif SIZEOF_LONG == 4 --typedef long int32; --typedef unsigned long uint32; -+#define ARCH_INT32_TYPE long -+#define ARCH_UINT32_TYPE unsigned long - #define ARCH_INT32_PRINTF_FORMAT "l" - #elif SIZEOF_SHORT == 4 --typedef short int32; --typedef unsigned short uint32; -+#define ARCH_INT32_TYPE short -+#define ARCH_UINT32_TYPE unsigned short - #define ARCH_INT32_PRINTF_FORMAT "" - #else - #error "No 32-bit integer type available" - #endif -+#endif - - #ifndef ARCH_INT64_TYPE - #if SIZEOF_LONGLONG == 8 -@@ -58,8 +64,13 @@ typedef unsigned short uint32; - #endif - #endif - --typedef ARCH_INT64_TYPE int64; --typedef ARCH_UINT64_TYPE uint64; -+#ifndef HAS_STDINT_H -+/* Not a C99 compiler, typically MSVC. Define the C99 types we use. */ -+typedef ARCH_INT32_TYPE int32_t; -+typedef ARCH_UINT32_TYPE uint32_t; -+typedef ARCH_INT64_TYPE int64_t; -+typedef ARCH_UINT64_TYPE uint64_t; -+#endif - - #if SIZEOF_PTR == SIZEOF_LONG - /* Standard models: ILP32 or I32LP64 */ -@@ -72,9 +83,9 @@ typedef int intnat; - typedef unsigned int uintnat; - #define ARCH_INTNAT_PRINTF_FORMAT "" - #elif SIZEOF_PTR == 8 --/* Win64 model: IL32LLP64 */ --typedef int64 intnat; --typedef uint64 uintnat; -+/* Win64 model: IL32P64 */ -+typedef int64_t intnat; -+typedef uint64_t uintnat; - #define ARCH_INTNAT_PRINTF_FORMAT ARCH_INT64_PRINTF_FORMAT - #else - #error "No integer type available to represent pointers" -diff --git a/byterun/caml/debugger.h b/byterun/caml/debugger.h -index b5079eb..e68ef75 100644 ---- a/byterun/caml/debugger.h -+++ b/byterun/caml/debugger.h -@@ -37,17 +37,17 @@ void caml_debugger_cleanup_fork (void); - /* Requests from the debugger to the runtime system */ - - enum debugger_request { -- REQ_SET_EVENT = 'e', /* uint32 pos */ -+ REQ_SET_EVENT = 'e', /* uint32_t pos */ - /* Set an event on the instruction at position pos */ -- REQ_SET_BREAKPOINT = 'B', /* uint32 pos, (char k) */ -+ REQ_SET_BREAKPOINT = 'B', /* uint32_t pos, (char k) */ - /* Set a breakpoint at position pos */ - /* In profiling mode, the breakpoint kind is set to k */ -- REQ_RESET_INSTR = 'i', /* uint32 pos */ -+ REQ_RESET_INSTR = 'i', /* uint32_t pos */ - /* Clear an event or breapoint at position pos, restores initial instr. */ - REQ_CHECKPOINT = 'c', /* no args */ - /* Checkpoint the runtime system by forking a child process. - Reply is pid of child process or -1 if checkpoint failed. */ -- REQ_GO = 'g', /* uint32 n */ -+ REQ_GO = 'g', /* uint32_t n */ - /* Run the program for n events. - Reply is one of debugger_reply described below. */ - REQ_STOP = 's', /* no args */ -@@ -59,38 +59,38 @@ enum debugger_request { - Reply is stack offset and current pc. */ - REQ_GET_FRAME = 'f', /* no args */ - /* Return current frame location (stack offset + current pc). */ -- REQ_SET_FRAME = 'S', /* uint32 stack_offset */ -+ REQ_SET_FRAME = 'S', /* uint32_t stack_offset */ - /* Set current frame to given stack offset. No reply. */ -- REQ_UP_FRAME = 'U', /* uint32 n */ -+ REQ_UP_FRAME = 'U', /* uint32_t n */ - /* Move one frame up. Argument n is size of current frame (in words). - Reply is stack offset and current pc, or -1 if top of stack reached. */ -- REQ_SET_TRAP_BARRIER = 'b', /* uint32 offset */ -+ REQ_SET_TRAP_BARRIER = 'b', /* uint32_t offset */ - /* Set the trap barrier at the given offset. */ -- REQ_GET_LOCAL = 'L', /* uint32 slot_number */ -+ REQ_GET_LOCAL = 'L', /* uint32_t slot_number */ - /* Return the local variable at the given slot in the current frame. - Reply is one value. */ -- REQ_GET_ENVIRONMENT = 'E', /* uint32 slot_number */ -+ REQ_GET_ENVIRONMENT = 'E', /* uint32_t slot_number */ - /* Return the local variable at the given slot in the heap environment - of the current frame. Reply is one value. */ -- REQ_GET_GLOBAL = 'G', /* uint32 global_number */ -+ REQ_GET_GLOBAL = 'G', /* uint32_t global_number */ - /* Return the specified global variable. Reply is one value. */ - REQ_GET_ACCU = 'A', /* no args */ - /* Return the current contents of the accumulator. Reply is one value. */ - REQ_GET_HEADER = 'H', /* mlvalue v */ - /* As REQ_GET_OBJ, but sends only the header. */ -- REQ_GET_FIELD = 'F', /* mlvalue v, uint32 fieldnum */ -+ REQ_GET_FIELD = 'F', /* mlvalue v, uint32_t fieldnum */ - /* As REQ_GET_OBJ, but sends only one field. */ - REQ_MARSHAL_OBJ = 'M', /* mlvalue v */ - /* Send a copy of the data structure rooted at v, using the same - format as [caml_output_value]. */ - REQ_GET_CLOSURE_CODE = 'C', /* mlvalue v */ - /* Send the code address of the given closure. -- Reply is one uint32. */ -- REQ_SET_FORK_MODE = 'K' /* uint32 m */ -+ Reply is one uint32_t. */ -+ REQ_SET_FORK_MODE = 'K' /* uint32_t m */ - /* Set whether to follow the child (m=0) or the parent on fork. */ - }; - --/* Replies to a REQ_GO request. All replies are followed by three uint32: -+/* Replies to a REQ_GO request. All replies are followed by three uint32_t: - - the value of the event counter - - the position of the stack - - the current pc. */ -diff --git a/byterun/caml/exec.h b/byterun/caml/exec.h -index a58bcf8..7e084ac 100644 ---- a/byterun/caml/exec.h -+++ b/byterun/caml/exec.h -@@ -39,13 +39,13 @@ - - struct section_descriptor { - char name[4]; /* Section name */ -- uint32 len; /* Length of data in bytes */ -+ uint32_t len; /* Length of data in bytes */ - }; - - /* Structure of the trailer. */ - - struct exec_trailer { -- uint32 num_sections; /* Number of sections */ -+ uint32_t num_sections; /* Number of sections */ - char magic[12]; /* The magic number */ - struct section_descriptor * section; /* Not part of file */ - }; -diff --git a/byterun/caml/hash.h b/byterun/caml/hash.h -index 452a092..ee82a4c 100644 ---- a/byterun/caml/hash.h -+++ b/byterun/caml/hash.h -@@ -22,12 +22,12 @@ - extern "C" { - #endif - --CAMLextern uint32 caml_hash_mix_uint32(uint32 h, uint32 d); --CAMLextern uint32 caml_hash_mix_intnat(uint32 h, intnat d); --CAMLextern uint32 caml_hash_mix_int64(uint32 h, int64 d); --CAMLextern uint32 caml_hash_mix_double(uint32 h, double d); --CAMLextern uint32 caml_hash_mix_float(uint32 h, float d); --CAMLextern uint32 caml_hash_mix_string(uint32 h, value s); -+CAMLextern uint32_t caml_hash_mix_uint32(uint32_t h, uint32_t d); -+CAMLextern uint32_t caml_hash_mix_intnat(uint32_t h, intnat d); -+CAMLextern uint32_t caml_hash_mix_int64(uint32_t h, int64_t d); -+CAMLextern uint32_t caml_hash_mix_double(uint32_t h, double d); -+CAMLextern uint32_t caml_hash_mix_float(uint32_t h, float d); -+CAMLextern uint32_t caml_hash_mix_string(uint32_t h, value s); - - #ifdef __cplusplus - } -diff --git a/byterun/caml/int64_emul.h b/byterun/caml/int64_emul.h -index ba7904a..2554df1 100644 ---- a/byterun/caml/int64_emul.h -+++ b/byterun/caml/int64_emul.h -@@ -28,7 +28,7 @@ - #define I64_split(x,hi,lo) (hi = (x).h, lo = (x).l) - - /* Unsigned comparison */ --static int I64_ucompare(uint64 x, uint64 y) -+static int I64_ucompare(uint64_t x, uint64_t y) - { - if (x.h > y.h) return 1; - if (x.h < y.h) return -1; -@@ -40,19 +40,19 @@ static int I64_ucompare(uint64 x, uint64 y) - #define I64_ult(x, y) (I64_ucompare(x, y) < 0) - - /* Signed comparison */ --static int I64_compare(int64 x, int64 y) -+static int I64_compare(int64_t x, int64_t y) - { -- if ((int32)x.h > (int32)y.h) return 1; -- if ((int32)x.h < (int32)y.h) return -1; -+ if ((int32_t)x.h > (int32_t)y.h) return 1; -+ if ((int32_t)x.h < (int32_t)y.h) return -1; - if (x.l > y.l) return 1; - if (x.l < y.l) return -1; - return 0; - } - - /* Negation */ --static int64 I64_neg(int64 x) -+static int64_t I64_neg(int64_t x) - { -- int64 res; -+ int64_t res; - res.l = -x.l; - res.h = ~x.h; - if (res.l == 0) res.h++; -@@ -60,9 +60,9 @@ static int64 I64_neg(int64 x) - } - - /* Addition */ --static int64 I64_add(int64 x, int64 y) -+static int64_t I64_add(int64_t x, int64_t y) - { -- int64 res; -+ int64_t res; - res.l = x.l + y.l; - res.h = x.h + y.h; - if (res.l < x.l) res.h++; -@@ -70,9 +70,9 @@ static int64 I64_add(int64 x, int64 y) - } - - /* Subtraction */ --static int64 I64_sub(int64 x, int64 y) -+static int64_t I64_sub(int64_t x, int64_t y) - { -- int64 res; -+ int64_t res; - res.l = x.l - y.l; - res.h = x.h - y.h; - if (x.l < y.l) res.h--; -@@ -80,13 +80,13 @@ static int64 I64_sub(int64 x, int64 y) - } - - /* Multiplication */ --static int64 I64_mul(int64 x, int64 y) -+static int64_t I64_mul(int64_t x, int64_t y) - { -- int64 res; -- uint32 prod00 = (x.l & 0xFFFF) * (y.l & 0xFFFF); -- uint32 prod10 = (x.l >> 16) * (y.l & 0xFFFF); -- uint32 prod01 = (x.l & 0xFFFF) * (y.l >> 16); -- uint32 prod11 = (x.l >> 16) * (y.l >> 16); -+ int64_t res; -+ uint32_t prod00 = (x.l & 0xFFFF) * (y.l & 0xFFFF); -+ uint32_t prod10 = (x.l >> 16) * (y.l & 0xFFFF); -+ uint32_t prod01 = (x.l & 0xFFFF) * (y.l >> 16); -+ uint32_t prod11 = (x.l >> 16) * (y.l >> 16); - res.l = prod00; - res.h = prod11 + (prod01 >> 16) + (prod10 >> 16); - prod01 = prod01 << 16; res.l += prod01; if (res.l < prod01) res.h++; -@@ -96,39 +96,39 @@ static int64 I64_mul(int64 x, int64 y) - } - - #define I64_is_zero(x) (((x).l | (x).h) == 0) --#define I64_is_negative(x) ((int32) (x).h < 0) -+#define I64_is_negative(x) ((int32_t) (x).h < 0) - #define I64_is_min_int(x) ((x).l == 0 && (x).h == 0x80000000U) - #define I64_is_minus_one(x) (((x).l & (x).h) == 0xFFFFFFFFU) - - /* Bitwise operations */ --static int64 I64_and(int64 x, int64 y) -+static int64_t I64_and(int64_t x, int64_t y) - { -- int64 res; -+ int64_t res; - res.l = x.l & y.l; - res.h = x.h & y.h; - return res; - } - --static int64 I64_or(int64 x, int64 y) -+static int64_t I64_or(int64_t x, int64_t y) - { -- int64 res; -+ int64_t res; - res.l = x.l | y.l; - res.h = x.h | y.h; - return res; - } - --static int64 I64_xor(int64 x, int64 y) -+static int64_t I64_xor(int64_t x, int64_t y) - { -- int64 res; -+ int64_t res; - res.l = x.l ^ y.l; - res.h = x.h ^ y.h; - return res; - } - - /* Shifts */ --static int64 I64_lsl(int64 x, int s) -+static int64_t I64_lsl(int64_t x, int s) - { -- int64 res; -+ int64_t res; - s = s & 63; - if (s == 0) return x; - if (s < 32) { -@@ -141,9 +141,9 @@ static int64 I64_lsl(int64 x, int s) - return res; - } - --static int64 I64_lsr(int64 x, int s) -+static int64_t I64_lsr(int64_t x, int s) - { -- int64 res; -+ int64_t res; - s = s & 63; - if (s == 0) return x; - if (s < 32) { -@@ -156,17 +156,17 @@ static int64 I64_lsr(int64 x, int s) - return res; - } - --static int64 I64_asr(int64 x, int s) -+static int64_t I64_asr(int64_t x, int s) - { -- int64 res; -+ int64_t res; - s = s & 63; - if (s == 0) return x; - if (s < 32) { - res.l = (x.l >> s) | (x.h << (32 - s)); -- res.h = (int32) x.h >> s; -+ res.h = (int32_t) x.h >> s; - } else { -- res.l = (int32) x.h >> (s - 32); -- res.h = (int32) x.h >> 31; -+ res.l = (int32_t) x.h >> (s - 32); -+ res.h = (int32_t) x.h >> 31; - } - return res; - } -@@ -176,15 +176,15 @@ static int64 I64_asr(int64 x, int s) - #define I64_SHL1(x) x.h = (x.h << 1) | (x.l >> 31); x.l <<= 1 - #define I64_SHR1(x) x.l = (x.l >> 1) | (x.h << 31); x.h >>= 1 - --static void I64_udivmod(uint64 modulus, uint64 divisor, -- uint64 * quo, uint64 * mod) -+static void I64_udivmod(uint64_t modulus, uint64_t divisor, -+ uint64_t * quo, uint64_t * mod) - { -- int64 quotient, mask; -+ int64_t quotient, mask; - int cmp; - - quotient.h = 0; quotient.l = 0; - mask.h = 0; mask.l = 1; -- while ((int32) divisor.h >= 0) { -+ while ((int32_t) divisor.h >= 0) { - cmp = I64_ucompare(divisor, modulus); - I64_SHL1(divisor); - I64_SHL1(mask); -@@ -202,27 +202,27 @@ static void I64_udivmod(uint64 modulus, uint64 divisor, - *mod = modulus; - } - --static int64 I64_div(int64 x, int64 y) -+static int64_t I64_div(int64_t x, int64_t y) - { -- int64 q, r; -- int32 sign; -+ int64_t q, r; -+ int32_t sign; - - sign = x.h ^ y.h; -- if ((int32) x.h < 0) x = I64_neg(x); -- if ((int32) y.h < 0) y = I64_neg(y); -+ if ((int32_t) x.h < 0) x = I64_neg(x); -+ if ((int32_t) y.h < 0) y = I64_neg(y); - I64_udivmod(x, y, &q, &r); - if (sign < 0) q = I64_neg(q); - return q; - } - --static int64 I64_mod(int64 x, int64 y) -+static int64_t I64_mod(int64_t x, int64_t y) - { -- int64 q, r; -- int32 sign; -+ int64_t q, r; -+ int32_t sign; - - sign = x.h; -- if ((int32) x.h < 0) x = I64_neg(x); -- if ((int32) y.h < 0) y = I64_neg(y); -+ if ((int32_t) x.h < 0) x = I64_neg(x); -+ if ((int32_t) y.h < 0) y = I64_neg(y); - I64_udivmod(x, y, &q, &r); - if (sign < 0) r = I64_neg(r); - return r; -@@ -230,49 +230,49 @@ static int64 I64_mod(int64 x, int64 y) - - /* Coercions */ - --static int64 I64_of_int32(int32 x) -+static int64_t I64_of_int32(int32_t x) - { -- int64 res; -+ int64_t res; - res.l = x; - res.h = x >> 31; - return res; - } - --#define I64_to_int32(x) ((int32) (x).l) -+#define I64_to_int32(x) ((int32_t) (x).l) - - /* Note: we assume sizeof(intnat) = 4 here, which is true otherwise - autoconfiguration would have selected native 64-bit integers */ - #define I64_of_intnat I64_of_int32 - #define I64_to_intnat I64_to_int32 - --static double I64_to_double(int64 x) -+static double I64_to_double(int64_t x) - { - double res; -- int32 sign = x.h; -+ int32_t sign = x.h; - if (sign < 0) x = I64_neg(x); - res = ldexp((double) x.h, 32) + x.l; - if (sign < 0) res = -res; - return res; - } - --static int64 I64_of_double(double f) -+static int64_t I64_of_double(double f) - { -- int64 res; -+ int64_t res; - double frac, integ; - int neg; - - neg = (f < 0); - f = fabs(f); - frac = modf(ldexp(f, -32), &integ); -- res.h = (uint32) integ; -- res.l = (uint32) ldexp(frac, 32); -+ res.h = (uint32_t) integ; -+ res.l = (uint32_t) ldexp(frac, 32); - if (neg) res = I64_neg(res); - return res; - } - --static int64 I64_bswap(int64 x) -+static int64_t I64_bswap(int64_t x) - { -- int64 res; -+ int64_t res; - res.h = (((x.l & 0x000000FF) << 24) | - ((x.l & 0x0000FF00) << 8) | - ((x.l & 0x00FF0000) >> 8) | -diff --git a/byterun/caml/int64_format.h b/byterun/caml/int64_format.h -index b0de527..aa8f1ab 100644 ---- a/byterun/caml/int64_format.h -+++ b/byterun/caml/int64_format.h -@@ -17,7 +17,7 @@ - #ifndef CAML_INT64_FORMAT_H - #define CAML_INT64_FORMAT_H - --static void I64_format(char * buffer, char * fmt, int64 x) -+static void I64_format(char * buffer, char * fmt, int64_t x) - { - static char conv_lower[] = "0123456789abcdef"; - static char conv_upper[] = "0123456789ABCDEF"; -@@ -26,7 +26,7 @@ static void I64_format(char * buffer, char * fmt, int64 x) - int base, width, sign, i, rawlen; - char * cvtbl; - char * p, * r; -- int64 wbase, digit; -+ int64_t wbase, digit; - - /* Parsing of format */ - justify = '+'; -diff --git a/byterun/caml/int64_native.h b/byterun/caml/int64_native.h -index e9ffe67..b6716ad 100644 ---- a/byterun/caml/int64_native.h -+++ b/byterun/caml/int64_native.h -@@ -18,36 +18,36 @@ - #ifndef CAML_INT64_NATIVE_H - #define CAML_INT64_NATIVE_H - --#define I64_literal(hi,lo) ((int64)(hi) << 32 | (lo)) --#define I64_split(x,hi,lo) (hi = (uint32)((x)>>32), lo = (uint32)(x)) -+#define I64_literal(hi,lo) ((int64_t)(hi) << 32 | (lo)) -+#define I64_split(x,hi,lo) (hi = (uint32_t)((x)>>32), lo = (uint32_t)(x)) - #define I64_compare(x,y) (((x) > (y)) - ((x) < (y))) --#define I64_ult(x,y) ((uint64)(x) < (uint64)(y)) -+#define I64_ult(x,y) ((uint64_t)(x) < (uint64_t)(y)) - #define I64_neg(x) (-(x)) - #define I64_add(x,y) ((x) + (y)) - #define I64_sub(x,y) ((x) - (y)) - #define I64_mul(x,y) ((x) * (y)) - #define I64_is_zero(x) ((x) == 0) - #define I64_is_negative(x) ((x) < 0) --#define I64_is_min_int(x) ((x) == ((int64)1 << 63)) -+#define I64_is_min_int(x) ((x) == ((int64_t)1 << 63)) - #define I64_is_minus_one(x) ((x) == -1) - - #define I64_div(x,y) ((x) / (y)) - #define I64_mod(x,y) ((x) % (y)) - #define I64_udivmod(x,y,quo,rem) \ -- (*(rem) = (uint64)(x) % (uint64)(y), \ -- *(quo) = (uint64)(x) / (uint64)(y)) -+ (*(rem) = (uint64_t)(x) % (uint64_t)(y), \ -+ *(quo) = (uint64_t)(x) / (uint64_t)(y)) - #define I64_and(x,y) ((x) & (y)) - #define I64_or(x,y) ((x) | (y)) - #define I64_xor(x,y) ((x) ^ (y)) - #define I64_lsl(x,y) ((x) << (y)) - #define I64_asr(x,y) ((x) >> (y)) --#define I64_lsr(x,y) ((uint64)(x) >> (y)) -+#define I64_lsr(x,y) ((uint64_t)(x) >> (y)) - #define I64_to_intnat(x) ((intnat) (x)) - #define I64_of_intnat(x) ((intnat) (x)) --#define I64_to_int32(x) ((int32) (x)) --#define I64_of_int32(x) ((int64) (x)) -+#define I64_to_int32(x) ((int32_t) (x)) -+#define I64_of_int32(x) ((int64_t) (x)) - #define I64_to_double(x) ((double)(x)) --#define I64_of_double(x) ((int64)(x)) -+#define I64_of_double(x) ((int64_t)(x)) - - #define I64_bswap(x) ((((x) & 0x00000000000000FFULL) << 56) | \ - (((x) & 0x000000000000FF00ULL) << 40) | \ -diff --git a/byterun/caml/intext.h b/byterun/caml/intext.h -index f7aa655..2c108a4 100644 ---- a/byterun/caml/intext.h -+++ b/byterun/caml/intext.h -@@ -119,8 +119,8 @@ CAMLextern value caml_input_value_from_block(char * data, intnat len); - - CAMLextern void caml_serialize_int_1(int i); - CAMLextern void caml_serialize_int_2(int i); --CAMLextern void caml_serialize_int_4(int32 i); --CAMLextern void caml_serialize_int_8(int64 i); -+CAMLextern void caml_serialize_int_4(int32_t i); -+CAMLextern void caml_serialize_int_8(int64_t i); - CAMLextern void caml_serialize_float_4(float f); - CAMLextern void caml_serialize_float_8(double f); - CAMLextern void caml_serialize_block_1(void * data, intnat len); -@@ -133,10 +133,10 @@ CAMLextern int caml_deserialize_uint_1(void); - CAMLextern int caml_deserialize_sint_1(void); - CAMLextern int caml_deserialize_uint_2(void); - CAMLextern int caml_deserialize_sint_2(void); --CAMLextern uint32 caml_deserialize_uint_4(void); --CAMLextern int32 caml_deserialize_sint_4(void); --CAMLextern uint64 caml_deserialize_uint_8(void); --CAMLextern int64 caml_deserialize_sint_8(void); -+CAMLextern uint32_t caml_deserialize_uint_4(void); -+CAMLextern int32_t caml_deserialize_sint_4(void); -+CAMLextern uint64_t caml_deserialize_uint_8(void); -+CAMLextern int64_t caml_deserialize_sint_8(void); - CAMLextern float caml_deserialize_float_4(void); - CAMLextern double caml_deserialize_float_8(void); - CAMLextern void caml_deserialize_block_1(void * data, intnat len); -diff --git a/byterun/caml/io.h b/byterun/caml/io.h -index 64a8bf5..5a9c037 100644 ---- a/byterun/caml/io.h -+++ b/byterun/caml/io.h -@@ -78,12 +78,12 @@ CAMLextern value caml_alloc_channel(struct channel *chan); - - CAMLextern int caml_flush_partial (struct channel *); - CAMLextern void caml_flush (struct channel *); --CAMLextern void caml_putword (struct channel *, uint32); -+CAMLextern void caml_putword (struct channel *, uint32_t); - CAMLextern int caml_putblock (struct channel *, char *, intnat); - CAMLextern void caml_really_putblock (struct channel *, char *, intnat); - - CAMLextern unsigned char caml_refill (struct channel *); --CAMLextern uint32 caml_getword (struct channel *); -+CAMLextern uint32_t caml_getword (struct channel *); - CAMLextern int caml_getblock (struct channel *, char *, intnat); - CAMLextern int caml_really_getblock (struct channel *, char *, intnat); - -@@ -107,7 +107,7 @@ CAMLextern struct channel * caml_all_opened_channels; - #define Unlock_exn() \ - if (caml_channel_mutex_unlock_exn != NULL) (*caml_channel_mutex_unlock_exn)() - --/* Conversion between file_offset and int64 */ -+/* Conversion between file_offset and int64_t */ - - #define Val_file_offset(fofs) caml_copy_int64(fofs) - #define File_offset_val(v) ((file_offset) Int64_val(v)) -diff --git a/byterun/caml/md5.h b/byterun/caml/md5.h -index d8aff09..f63667d 100644 ---- a/byterun/caml/md5.h -+++ b/byterun/caml/md5.h -@@ -26,8 +26,8 @@ CAMLextern void caml_md5_block(unsigned char digest[16], - void * data, uintnat len); - - struct MD5Context { -- uint32 buf[4]; -- uint32 bits[2]; -+ uint32_t buf[4]; -+ uint32_t bits[2]; - unsigned char in[64]; - }; - -@@ -35,7 +35,7 @@ CAMLextern void caml_MD5Init (struct MD5Context *context); - CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf, - uintnat len); - CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx); --CAMLextern void caml_MD5Transform (uint32 *buf, uint32 *in); -+CAMLextern void caml_MD5Transform (uint32_t *buf, uint32_t *in); - - - #endif /* CAML_MD5_H */ -diff --git a/byterun/caml/mlvalues.h b/byterun/caml/mlvalues.h -index fe4a8f0..0735692 100644 ---- a/byterun/caml/mlvalues.h -+++ b/byterun/caml/mlvalues.h -@@ -38,8 +38,8 @@ extern "C" { - bp: Pointer to the first byte of a block. (a char *) - op: Pointer to the first field of a block. (a value *) - hp: Pointer to the header of a block. (a char *) -- int32: Four bytes on all architectures. -- int64: Eight bytes on all architectures. -+ int32_t: Four bytes on all architectures. -+ int64_t: Eight bytes on all architectures. - - Remark: A block size is always a multiple of the word size, and at least - one word plus the header. -@@ -161,7 +161,7 @@ bits 63 10 9 8 7 0 - /* Fields are numbered from 0. */ - #define Field(x, i) (((value *)(x)) [i]) /* Also an l-value. */ - --typedef int32 opcode_t; -+typedef int32_t opcode_t; - typedef opcode_t * code_t; - - /* NOTE: [Forward_tag] and [Infix_tag] must be just under -@@ -262,12 +262,12 @@ struct custom_operations; /* defined in [custom.h] */ - - /* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */ - --#define Int32_val(v) (*((int32 *) Data_custom_val(v))) -+#define Int32_val(v) (*((int32_t *) Data_custom_val(v))) - #define Nativeint_val(v) (*((intnat *) Data_custom_val(v))) - #ifndef ARCH_ALIGN_INT64 --#define Int64_val(v) (*((int64 *) Data_custom_val(v))) -+#define Int64_val(v) (*((int64_t *) Data_custom_val(v))) - #else --CAMLextern int64 caml_Int64_val(value v); -+CAMLextern int64_t caml_Int64_val(value v); - #define Int64_val(v) caml_Int64_val(v) - #endif - -diff --git a/byterun/caml/startup.h b/byterun/caml/startup.h -index 3dda64b..3268d88 100644 ---- a/byterun/caml/startup.h -+++ b/byterun/caml/startup.h -@@ -30,9 +30,9 @@ enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2 }; - extern int caml_attempt_open(char **name, struct exec_trailer *trail, - int do_open_script); - extern void caml_read_section_descriptors(int fd, struct exec_trailer *trail); --extern int32 caml_seek_optional_section(int fd, struct exec_trailer *trail, -+extern int32_t caml_seek_optional_section(int fd, struct exec_trailer *trail, - char *name); --extern int32 caml_seek_section(int fd, struct exec_trailer *trail, char *name); -+extern int32_t caml_seek_section(int fd, struct exec_trailer *trail, char *name); - - - #endif /* CAML_STARTUP_H */ -diff --git a/byterun/extern.c b/byterun/extern.c -index 5965b8d..9b47d44 100644 ---- a/byterun/extern.c -+++ b/byterun/extern.c -@@ -720,7 +720,7 @@ CAMLexport void caml_serialize_int_2(int i) - extern_ptr += 2; - } - --CAMLexport void caml_serialize_int_4(int32 i) -+CAMLexport void caml_serialize_int_4(int32_t i) - { - if (extern_ptr + 4 > extern_limit) grow_extern_output(4); - extern_ptr[0] = i >> 24; -@@ -730,7 +730,7 @@ CAMLexport void caml_serialize_int_4(int32 i) - extern_ptr += 4; - } - --CAMLexport void caml_serialize_int_8(int64 i) -+CAMLexport void caml_serialize_int_8(int64_t i) - { - caml_serialize_block_8(&i, 1); - } -diff --git a/byterun/fix_code.c b/byterun/fix_code.c -index 95a7591..e605290 100644 ---- a/byterun/fix_code.c -+++ b/byterun/fix_code.c -@@ -145,12 +145,12 @@ void caml_thread_code (code_t code, asize_t len) - } - *p++ = (opcode_t)(caml_instr_table[instr] - caml_instr_base); - if (instr == SWITCH) { -- uint32 sizes = *p++; -- uint32 const_size = sizes & 0xFFFF; -- uint32 block_size = sizes >> 16; -+ uint32_t sizes = *p++; -+ uint32_t const_size = sizes & 0xFFFF; -+ uint32_t block_size = sizes >> 16; - p += const_size + block_size; - } else if (instr == CLOSUREREC) { -- uint32 nfuncs = *p++; -+ uint32_t nfuncs = *p++; - p++; /* skip nvars */ - p += nfuncs; - } else { -diff --git a/byterun/floats.c b/byterun/floats.c -index de18c33..544dc06 100644 ---- a/byterun/floats.c -+++ b/byterun/floats.c -@@ -379,9 +379,9 @@ CAMLprim value caml_log1p_float(value f) - union double_as_two_int32 { - double d; - #if defined(ARCH_BIG_ENDIAN) || (defined(__arm__) && !defined(__ARM_EABI__)) -- struct { uint32 h; uint32 l; } i; -+ struct { uint32_t h; uint32_t l; } i; - #else -- struct { uint32 l; uint32 h; } i; -+ struct { uint32_t l; uint32_t h; } i; - #endif - }; - -@@ -469,7 +469,7 @@ CAMLprim value caml_classify_float(value vd) - } - #else - union double_as_two_int32 u; -- uint32 h, l; -+ uint32_t h, l; - - u.d = Double_val(vd); - h = u.i.h; l = u.i.l; -diff --git a/byterun/globroots.c b/byterun/globroots.c -index d3dd925..b2770e3 100644 ---- a/byterun/globroots.c -+++ b/byterun/globroots.c -@@ -43,11 +43,11 @@ struct global_root_list { - (i.e. 2 * (NUM_LEVELS - 1)). Moreover, the congruential PRNG - is faster and guaranteed to be deterministic (to reproduce bugs). */ - --static uint32 random_seed = 0; -+static uint32_t random_seed = 0; - - static int random_level(void) - { -- uint32 r; -+ uint32_t r; - int level = 0; - - /* Linear congruence with modulus = 2^32, multiplier = 69069 -diff --git a/byterun/hash.c b/byterun/hash.c -index 8663a3d..e6be1ae 100644 ---- a/byterun/hash.c -+++ b/byterun/hash.c -@@ -41,7 +41,7 @@ - h *= 0xc2b2ae35; \ - h ^= h >> 16; - --CAMLexport uint32 caml_hash_mix_uint32(uint32 h, uint32 d) -+CAMLexport uint32_t caml_hash_mix_uint32(uint32_t h, uint32_t d) - { - MIX(h, d); - return h; -@@ -49,17 +49,17 @@ CAMLexport uint32 caml_hash_mix_uint32(uint32 h, uint32 d) - - /* Mix a platform-native integer. */ - --CAMLexport uint32 caml_hash_mix_intnat(uint32 h, intnat d) -+CAMLexport uint32_t caml_hash_mix_intnat(uint32_t h, intnat d) - { -- uint32 n; -+ uint32_t n; - #ifdef ARCH_SIXTYFOUR - /* Mix the low 32 bits and the high 32 bits, in a way that preserves -- 32/64 compatibility: we want n = (uint32) d -+ 32/64 compatibility: we want n = (uint32_t) d - if d is in the range [-2^31, 2^31-1]. */ - n = (d >> 32) ^ (d >> 63) ^ d; - /* If 0 <= d < 2^31: d >> 32 = 0 d >> 63 = 0 - If -2^31 <= d < 0: d >> 32 = -1 d >> 63 = -1 -- In both cases, n = (uint32) d. */ -+ In both cases, n = (uint32_t) d. */ - #else - n = d; - #endif -@@ -69,9 +69,9 @@ CAMLexport uint32 caml_hash_mix_intnat(uint32 h, intnat d) - - /* Mix a 64-bit integer. */ - --CAMLexport uint32 caml_hash_mix_int64(uint32 h, int64 d) -+CAMLexport uint32_t caml_hash_mix_int64(uint32_t h, int64_t d) - { -- uint32 hi = (uint32) (d >> 32), lo = (uint32) d; -+ uint32_t hi = (uint32_t) (d >> 32), lo = (uint32_t) d; - MIX(h, lo); - MIX(h, hi); - return h; -@@ -82,17 +82,17 @@ CAMLexport uint32 caml_hash_mix_int64(uint32 h, int64 d) - Treats all NaNs identically. - */ - --CAMLexport uint32 caml_hash_mix_double(uint32 hash, double d) -+CAMLexport uint32_t caml_hash_mix_double(uint32_t hash, double d) - { - union { - double d; - #if defined(ARCH_BIG_ENDIAN) || (defined(__arm__) && !defined(__ARM_EABI__)) -- struct { uint32 h; uint32 l; } i; -+ struct { uint32_t h; uint32_t l; } i; - #else -- struct { uint32 l; uint32 h; } i; -+ struct { uint32_t l; uint32_t h; } i; - #endif - } u; -- uint32 h, l; -+ uint32_t h, l; - /* Convert to two 32-bit halves */ - u.d = d; - h = u.i.h; l = u.i.l; -@@ -115,14 +115,14 @@ CAMLexport uint32 caml_hash_mix_double(uint32 hash, double d) - Treats all NaNs identically. - */ - --CAMLexport uint32 caml_hash_mix_float(uint32 hash, float d) -+CAMLexport uint32_t caml_hash_mix_float(uint32_t hash, float d) - { - union { - float f; -- uint32 i; -+ uint32_t i; - } u; -- uint32 n; -- /* Convert to int32 */ -+ uint32_t n; -+ /* Convert to int32_t */ - u.f = d; n = u.i; - /* Normalize NaNs */ - if ((n & 0x7F800000) == 0x7F800000 && (n & 0x007FFFFF) != 0) { -@@ -138,11 +138,11 @@ CAMLexport uint32 caml_hash_mix_float(uint32 hash, float d) - - /* Mix an OCaml string */ - --CAMLexport uint32 caml_hash_mix_string(uint32 h, value s) -+CAMLexport uint32_t caml_hash_mix_string(uint32_t h, value s) - { - mlsize_t len = caml_string_length(s); - mlsize_t i; -- uint32 w; -+ uint32_t w; - - /* Mix by 32-bit blocks (little-endian) */ - for (i = 0; i + 4 <= len; i += 4) { -@@ -152,7 +152,7 @@ CAMLexport uint32 caml_hash_mix_string(uint32 h, value s) - | (Byte_u(s, i+2) << 16) - | (Byte_u(s, i+3) << 24); - #else -- w = *((uint32 *) &Byte_u(s, i)); -+ w = *((uint32_t *) &Byte_u(s, i)); - #endif - MIX(h, w); - } -@@ -166,7 +166,7 @@ CAMLexport uint32 caml_hash_mix_string(uint32 h, value s) - default: /*skip*/; /* len & 3 == 0, no extra bytes, do nothing */ - } - /* Finally, mix in the length. Ignore the upper 32 bits, generally 0. */ -- h ^= (uint32) len; -+ h ^= (uint32_t) len; - return h; - } - -@@ -184,7 +184,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj) - intnat wr; /* One past position of last value in queue */ - intnat sz; /* Max number of values to put in queue */ - intnat num; /* Max number of meaningful values to see */ -- uint32 h; /* Rolling hash */ -+ uint32_t h; /* Rolling hash */ - value v; - mlsize_t i, len; - -@@ -245,7 +245,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj) - /* If no hashing function provided, do nothing. */ - /* Only use low 32 bits of custom hash, for 32/64 compatibility */ - if (Custom_ops_val(v)->hash != NULL) { -- uint32 n = (uint32) Custom_ops_val(v)->hash(v); -+ uint32_t n = (uint32_t) Custom_ops_val(v)->hash(v); - h = caml_hash_mix_uint32(h, n); - num--; - } -@@ -408,5 +408,5 @@ CAMLexport value caml_hash_variant(char const * tag) - #endif - /* Force sign extension of bit 31 for compatibility between 32 and 64-bit - platforms */ -- return (int32) accu; -+ return (int32_t) accu; - } -diff --git a/byterun/intern.c b/byterun/intern.c -index d2943af..6f2d49f 100644 ---- a/byterun/intern.c -+++ b/byterun/intern.c -@@ -553,7 +553,7 @@ static void intern_add_to_heap(mlsize_t whsize) - - value caml_input_val(struct channel *chan) - { -- uint32 magic; -+ uint32_t magic; - mlsize_t block_len, num_objects, whsize; - char * block; - value res; -@@ -663,7 +663,7 @@ static value input_val_from_block(void) - - CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs) - { -- uint32 magic; -+ uint32_t magic; - value obj; - - intern_input = (unsigned char *) data; -@@ -681,7 +681,7 @@ CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs) - - CAMLexport value caml_input_value_from_block(char * data, intnat len) - { -- uint32 magic; -+ uint32_t magic; - mlsize_t block_len; - value obj; - -@@ -700,7 +700,7 @@ CAMLexport value caml_input_value_from_block(char * data, intnat len) - - CAMLprim value caml_marshal_data_size(value buff, value ofs) - { -- uint32 magic; -+ uint32_t magic; - mlsize_t block_len; - - intern_src = &Byte_u(buff, Long_val(ofs)); -@@ -771,26 +771,26 @@ CAMLexport int caml_deserialize_sint_2(void) - return read16s(); - } - --CAMLexport uint32 caml_deserialize_uint_4(void) -+CAMLexport uint32_t caml_deserialize_uint_4(void) - { - return read32u(); - } - --CAMLexport int32 caml_deserialize_sint_4(void) -+CAMLexport int32_t caml_deserialize_sint_4(void) - { - return read32s(); - } - --CAMLexport uint64 caml_deserialize_uint_8(void) -+CAMLexport uint64_t caml_deserialize_uint_8(void) - { -- uint64 i; -+ uint64_t i; - caml_deserialize_block_8(&i, 1); - return i; - } - --CAMLexport int64 caml_deserialize_sint_8(void) -+CAMLexport int64_t caml_deserialize_sint_8(void) - { -- int64 i; -+ int64_t i; - caml_deserialize_block_8(&i, 1); - return i; - } -diff --git a/byterun/interp.c b/byterun/interp.c -index fd4740b..094eb50 100644 ---- a/byterun/interp.c -+++ b/byterun/interp.c -@@ -793,7 +793,7 @@ value caml_interprete(code_t prog, asize_t prog_size) - if (accu == Val_false) pc += *pc; else pc++; - Next; - Instruct(SWITCH): { -- uint32 sizes = *pc++; -+ uint32_t sizes = *pc++; - if (Is_block(accu)) { - intnat index = Tag_val(accu); - Assert ((uintnat) index < (sizes >> 16)); -diff --git a/byterun/ints.c b/byterun/ints.c -index 4a73276..621aa54 100644 ---- a/byterun/ints.c -+++ b/byterun/ints.c -@@ -172,8 +172,8 @@ CAMLprim value caml_format_int(value fmt, value arg) - - static int int32_cmp(value v1, value v2) - { -- int32 i1 = Int32_val(v1); -- int32 i2 = Int32_val(v2); -+ int32_t i1 = Int32_val(v1); -+ int32_t i2 = Int32_val(v2); - return (i1 > i2) - (i1 < i2); - } - -@@ -191,7 +191,7 @@ static void int32_serialize(value v, uintnat * wsize_32, - - static uintnat int32_deserialize(void * dst) - { -- *((int32 *) dst) = caml_deserialize_sint_4(); -+ *((int32_t *) dst) = caml_deserialize_sint_4(); - return 4; - } - -@@ -205,7 +205,7 @@ CAMLexport struct custom_operations caml_int32_ops = { - custom_compare_ext_default - }; - --CAMLexport value caml_copy_int32(int32 i) -+CAMLexport value caml_copy_int32(int32_t i) - { - value res = caml_alloc_custom(&caml_int32_ops, 4, 0, 1); - Int32_val(res) = i; -@@ -226,8 +226,8 @@ CAMLprim value caml_int32_mul(value v1, value v2) - - CAMLprim value caml_int32_div(value v1, value v2) - { -- int32 dividend = Int32_val(v1); -- int32 divisor = Int32_val(v2); -+ int32_t dividend = Int32_val(v1); -+ int32_t divisor = Int32_val(v2); - if (divisor == 0) caml_raise_zero_divide(); - /* PR#4740: on some processors, division crashes on overflow. - Implement the same behavior as for type "int". */ -@@ -237,8 +237,8 @@ CAMLprim value caml_int32_div(value v1, value v2) - - CAMLprim value caml_int32_mod(value v1, value v2) - { -- int32 dividend = Int32_val(v1); -- int32 divisor = Int32_val(v2); -+ int32_t dividend = Int32_val(v1); -+ int32_t divisor = Int32_val(v2); - if (divisor == 0) caml_raise_zero_divide(); - /* PR#4740: on some processors, modulus crashes if division overflows. - Implement the same behavior as for type "int". */ -@@ -262,9 +262,9 @@ CAMLprim value caml_int32_shift_right(value v1, value v2) - { return caml_copy_int32(Int32_val(v1) >> Int_val(v2)); } - - CAMLprim value caml_int32_shift_right_unsigned(value v1, value v2) --{ return caml_copy_int32((uint32)Int32_val(v1) >> Int_val(v2)); } -+{ return caml_copy_int32((uint32_t)Int32_val(v1) >> Int_val(v2)); } - --static int32 caml_swap32(int32 x) -+static int32_t caml_swap32(int32_t x) - { - return (((x & 0x000000FF) << 24) | - ((x & 0x0000FF00) << 8) | -@@ -285,15 +285,15 @@ CAMLprim value caml_int32_to_int(value v) - { return Val_long(Int32_val(v)); } - - CAMLprim value caml_int32_of_float(value v) --{ return caml_copy_int32((int32)(Double_val(v))); } -+{ return caml_copy_int32((int32_t)(Double_val(v))); } - - CAMLprim value caml_int32_to_float(value v) - { return caml_copy_double((double)(Int32_val(v))); } - - CAMLprim value caml_int32_compare(value v1, value v2) - { -- int32 i1 = Int32_val(v1); -- int32 i2 = Int32_val(v2); -+ int32_t i1 = Int32_val(v1); -+ int32_t i2 = Int32_val(v2); - int res = (i1 > i2) - (i1 < i2); - return Val_int(res); - } -@@ -313,14 +313,14 @@ CAMLprim value caml_int32_of_string(value s) - - CAMLprim value caml_int32_bits_of_float(value vd) - { -- union { float d; int32 i; } u; -+ union { float d; int32_t i; } u; - u.d = Double_val(vd); - return caml_copy_int32(u.i); - } - - CAMLprim value caml_int32_float_of_bits(value vi) - { -- union { float d; int32 i; } u; -+ union { float d; int32_t i; } u; - u.i = Int32_val(vi); - return caml_copy_double(u.d); - } -@@ -329,11 +329,11 @@ CAMLprim value caml_int32_float_of_bits(value vi) - - #ifdef ARCH_ALIGN_INT64 - --CAMLexport int64 caml_Int64_val(value v) -+CAMLexport int64_t caml_Int64_val(value v) - { -- union { int32 i[2]; int64 j; } buffer; -- buffer.i[0] = ((int32 *) Data_custom_val(v))[0]; -- buffer.i[1] = ((int32 *) Data_custom_val(v))[1]; -+ union { int32_t i[2]; int64_t j; } buffer; -+ buffer.i[0] = ((int32_t *) Data_custom_val(v))[0]; -+ buffer.i[1] = ((int32_t *) Data_custom_val(v))[1]; - return buffer.j; - } - -@@ -341,15 +341,15 @@ CAMLexport int64 caml_Int64_val(value v) - - static int int64_cmp(value v1, value v2) - { -- int64 i1 = Int64_val(v1); -- int64 i2 = Int64_val(v2); -+ int64_t i1 = Int64_val(v1); -+ int64_t i2 = Int64_val(v2); - return (i1 > i2) - (i1 < i2); - } - - static intnat int64_hash(value v) - { -- int64 x = Int64_val(v); -- uint32 lo = (uint32) x, hi = (uint32) (x >> 32); -+ int64_t x = Int64_val(v); -+ uint32_t lo = (uint32_t) x, hi = (uint32_t) (x >> 32); - return hi ^ lo; - } - -@@ -363,12 +363,12 @@ static void int64_serialize(value v, uintnat * wsize_32, - static uintnat int64_deserialize(void * dst) - { - #ifndef ARCH_ALIGN_INT64 -- *((int64 *) dst) = caml_deserialize_sint_8(); -+ *((int64_t *) dst) = caml_deserialize_sint_8(); - #else -- union { int32 i[2]; int64 j; } buffer; -+ union { int32_t i[2]; int64_t j; } buffer; - buffer.j = caml_deserialize_sint_8(); -- ((int32 *) dst)[0] = buffer.i[0]; -- ((int32 *) dst)[1] = buffer.i[1]; -+ ((int32_t *) dst)[0] = buffer.i[0]; -+ ((int32_t *) dst)[1] = buffer.i[1]; - #endif - return 8; - } -@@ -383,16 +383,16 @@ CAMLexport struct custom_operations caml_int64_ops = { - custom_compare_ext_default - }; - --CAMLexport value caml_copy_int64(int64 i) -+CAMLexport value caml_copy_int64(int64_t i) - { - value res = caml_alloc_custom(&caml_int64_ops, 8, 0, 1); - #ifndef ARCH_ALIGN_INT64 - Int64_val(res) = i; - #else -- union { int32 i[2]; int64 j; } buffer; -+ union { int32_t i[2]; int64_t j; } buffer; - buffer.j = i; -- ((int32 *) Data_custom_val(res))[0] = buffer.i[0]; -- ((int32 *) Data_custom_val(res))[1] = buffer.i[1]; -+ ((int32_t *) Data_custom_val(res))[0] = buffer.i[0]; -+ ((int32_t *) Data_custom_val(res))[1] = buffer.i[1]; - #endif - return res; - } -@@ -413,23 +413,23 @@ CAMLprim value caml_int64_mul(value v1, value v2) - - CAMLprim value caml_int64_div(value v1, value v2) - { -- int64 dividend = Int64_val(v1); -- int64 divisor = Int64_val(v2); -+ int64_t dividend = Int64_val(v1); -+ int64_t divisor = Int64_val(v2); - if (divisor == 0) caml_raise_zero_divide(); - /* PR#4740: on some processors, division crashes on overflow. - Implement the same behavior as for type "int". */ -- if (dividend == ((int64)1 << 63) && divisor == -1) return v1; -+ if (dividend == ((int64_t)1 << 63) && divisor == -1) return v1; - return caml_copy_int64(Int64_val(v1) / divisor); - } - - CAMLprim value caml_int64_mod(value v1, value v2) - { -- int64 dividend = Int64_val(v1); -- int64 divisor = Int64_val(v2); -+ int64_t dividend = Int64_val(v1); -+ int64_t divisor = Int64_val(v2); - if (divisor == 0) caml_raise_zero_divide(); - /* PR#4740: on some processors, division crashes on overflow. - Implement the same behavior as for type "int". */ -- if (dividend == ((int64)1 << 63) && divisor == -1) return caml_copy_int64(0); -+ if (dividend == ((int64_t)1 << 63) && divisor == -1) return caml_copy_int64(0); - return caml_copy_int64(Int64_val(v1) % divisor); - } - -@@ -449,7 +449,7 @@ CAMLprim value caml_int64_shift_right(value v1, value v2) - { return caml_copy_int64(Int64_val(v1) >> Int_val(v2)); } - - CAMLprim value caml_int64_shift_right_unsigned(value v1, value v2) --{ return caml_copy_int64((uint64) (Int64_val(v1)) >> Int_val(v2)); } -+{ return caml_copy_int64((uint64_t) (Int64_val(v1)) >> Int_val(v2)); } - - #ifdef ARCH_SIXTYFOUR - static value caml_swap64(value x) -@@ -470,7 +470,7 @@ value caml_int64_direct_bswap(value v) - - CAMLprim value caml_int64_bswap(value v) - { -- int64 x = Int64_val(v); -+ int64_t x = Int64_val(v); - return caml_copy_int64 - (((x & 0x00000000000000FFULL) << 56) | - ((x & 0x000000000000FF00ULL) << 40) | -@@ -483,33 +483,33 @@ CAMLprim value caml_int64_bswap(value v) - } - - CAMLprim value caml_int64_of_int(value v) --{ return caml_copy_int64((int64) (Long_val(v))); } -+{ return caml_copy_int64((int64_t) (Long_val(v))); } - - CAMLprim value caml_int64_to_int(value v) - { return Val_long((intnat) (Int64_val(v))); } - - CAMLprim value caml_int64_of_float(value v) --{ return caml_copy_int64((int64) (Double_val(v))); } -+{ return caml_copy_int64((int64_t) (Double_val(v))); } - - CAMLprim value caml_int64_to_float(value v) - { return caml_copy_double((double) (Int64_val(v))); } - - CAMLprim value caml_int64_of_int32(value v) --{ return caml_copy_int64((int64) (Int32_val(v))); } -+{ return caml_copy_int64((int64_t) (Int32_val(v))); } - - CAMLprim value caml_int64_to_int32(value v) --{ return caml_copy_int32((int32) (Int64_val(v))); } -+{ return caml_copy_int32((int32_t) (Int64_val(v))); } - - CAMLprim value caml_int64_of_nativeint(value v) --{ return caml_copy_int64((int64) (Nativeint_val(v))); } -+{ return caml_copy_int64((int64_t) (Nativeint_val(v))); } - - CAMLprim value caml_int64_to_nativeint(value v) - { return caml_copy_nativeint((intnat) (Int64_val(v))); } - - CAMLprim value caml_int64_compare(value v1, value v2) - { -- int64 i1 = Int64_val(v1); -- int64 i2 = Int64_val(v2); -+ int64_t i1 = Int64_val(v1); -+ int64_t i2 = Int64_val(v2); - return Val_int((i1 > i2) - (i1 < i2)); - } - -@@ -524,11 +524,11 @@ CAMLprim value caml_int64_format(value fmt, value arg) - CAMLprim value caml_int64_of_string(value s) - { - char * p; -- uint64 res, threshold; -+ uint64_t res, threshold; - int sign, base, d; - - p = parse_sign_and_base(String_val(s), &base, &sign); -- threshold = ((uint64) -1) / base; -+ threshold = ((uint64_t) -1) / base; - d = parse_digit(*p); - if (d < 0 || d >= base) caml_failwith("int_of_string"); - res = d; -@@ -541,7 +541,7 @@ CAMLprim value caml_int64_of_string(value s) - if (res > threshold) caml_failwith("int_of_string"); - res = base * res + d; - /* Detect overflow in addition (base * res) + d */ -- if (res < (uint64) d) caml_failwith("int_of_string"); -+ if (res < (uint64_t) d) caml_failwith("int_of_string"); - } - if (p != String_val(s) + caml_string_length(s)){ - caml_failwith("int_of_string"); -@@ -549,9 +549,9 @@ CAMLprim value caml_int64_of_string(value s) - if (base == 10) { - /* Signed representation expected, allow -2^63 to 2^63 - 1 only */ - if (sign >= 0) { -- if (res >= (uint64)1 << 63) caml_failwith("int_of_string"); -+ if (res >= (uint64_t)1 << 63) caml_failwith("int_of_string"); - } else { -- if (res > (uint64)1 << 63) caml_failwith("int_of_string"); -+ if (res > (uint64_t)1 << 63) caml_failwith("int_of_string"); - } - } - if (sign < 0) res = - res; -@@ -560,20 +560,20 @@ CAMLprim value caml_int64_of_string(value s) - - CAMLprim value caml_int64_bits_of_float(value vd) - { -- union { double d; int64 i; int32 h[2]; } u; -+ union { double d; int64_t i; int32_t h[2]; } u; - u.d = Double_val(vd); - #if defined(__arm__) && !defined(__ARM_EABI__) -- { int32 t = u.h[0]; u.h[0] = u.h[1]; u.h[1] = t; } -+ { int32_t t = u.h[0]; u.h[0] = u.h[1]; u.h[1] = t; } - #endif - return caml_copy_int64(u.i); - } - - CAMLprim value caml_int64_float_of_bits(value vi) - { -- union { double d; int64 i; int32 h[2]; } u; -+ union { double d; int64_t i; int32_t h[2]; } u; - u.i = Int64_val(vi); - #if defined(__arm__) && !defined(__ARM_EABI__) -- { int32 t = u.h[0]; u.h[0] = u.h[1]; u.h[1] = t; } -+ { int32_t t = u.h[0]; u.h[0] = u.h[1]; u.h[1] = t; } - #endif - return caml_copy_double(u.d); - } -@@ -606,7 +606,7 @@ static void nativeint_serialize(value v, uintnat * wsize_32, - #ifdef ARCH_SIXTYFOUR - if (l >= -((intnat)1 << 31) && l < ((intnat)1 << 31)) { - caml_serialize_int_1(1); -- caml_serialize_int_4((int32) l); -+ caml_serialize_int_4((int32_t) l); - } else { - caml_serialize_int_1(2); - caml_serialize_int_8(l); -diff --git a/byterun/io.c b/byterun/io.c -index 11f941d..77f308c 100644 ---- a/byterun/io.c -+++ b/byterun/io.c -@@ -207,7 +207,7 @@ CAMLexport void caml_flush(struct channel *channel) - - /* Output data */ - --CAMLexport void caml_putword(struct channel *channel, uint32 w) -+CAMLexport void caml_putword(struct channel *channel, uint32_t w) - { - if (! caml_channel_binary_mode(channel)) - caml_failwith("output_binary_int: not a binary channel"); -@@ -303,10 +303,10 @@ CAMLexport unsigned char caml_refill(struct channel *channel) - return (unsigned char)(channel->buff[0]); - } - --CAMLexport uint32 caml_getword(struct channel *channel) -+CAMLexport uint32_t caml_getword(struct channel *channel) - { - int i; -- uint32 res; -+ uint32_t res; - - if (! caml_channel_binary_mode(channel)) - caml_failwith("input_binary_int: not a binary channel"); -diff --git a/byterun/md5.c b/byterun/md5.c -index 5d748c1..7a996b6 100644 ---- a/byterun/md5.c -+++ b/byterun/md5.c -@@ -101,11 +101,11 @@ CAMLexport void caml_md5_block(unsigned char digest[16], - #else - static void byteReverse(unsigned char * buf, unsigned longs) - { -- uint32 t; -+ uint32_t t; - do { -- t = (uint32) ((unsigned) buf[3] << 8 | buf[2]) << 16 | -+ t = (uint32_t) ((unsigned) buf[3] << 8 | buf[2]) << 16 | - ((unsigned) buf[1] << 8 | buf[0]); -- *(uint32 *) buf = t; -+ *(uint32_t *) buf = t; - buf += 4; - } while (--longs); - } -@@ -133,12 +133,12 @@ CAMLexport void caml_MD5Init(struct MD5Context *ctx) - CAMLexport void caml_MD5Update(struct MD5Context *ctx, unsigned char *buf, - uintnat len) - { -- uint32 t; -+ uint32_t t; - - /* Update bitcount */ - - t = ctx->bits[0]; -- if ((ctx->bits[0] = t + ((uint32) len << 3)) < t) -+ if ((ctx->bits[0] = t + ((uint32_t) len << 3)) < t) - ctx->bits[1]++; /* Carry from low to high */ - ctx->bits[1] += len >> 29; - -@@ -156,7 +156,7 @@ CAMLexport void caml_MD5Update(struct MD5Context *ctx, unsigned char *buf, - } - memcpy(p, buf, t); - byteReverse(ctx->in, 16); -- caml_MD5Transform(ctx->buf, (uint32 *) ctx->in); -+ caml_MD5Transform(ctx->buf, (uint32_t *) ctx->in); - buf += t; - len -= t; - } -@@ -165,7 +165,7 @@ CAMLexport void caml_MD5Update(struct MD5Context *ctx, unsigned char *buf, - while (len >= 64) { - memcpy(ctx->in, buf, 64); - byteReverse(ctx->in, 16); -- caml_MD5Transform(ctx->buf, (uint32 *) ctx->in); -+ caml_MD5Transform(ctx->buf, (uint32_t *) ctx->in); - buf += 64; - len -= 64; - } -@@ -200,7 +200,7 @@ CAMLexport void caml_MD5Final(unsigned char *digest, struct MD5Context *ctx) - /* Two lots of padding: Pad the first block to 64 bytes */ - memset(p, 0, count); - byteReverse(ctx->in, 16); -- caml_MD5Transform(ctx->buf, (uint32 *) ctx->in); -+ caml_MD5Transform(ctx->buf, (uint32_t *) ctx->in); - - /* Now fill the next block with 56 bytes */ - memset(ctx->in, 0, 56); -@@ -211,10 +211,10 @@ CAMLexport void caml_MD5Final(unsigned char *digest, struct MD5Context *ctx) - byteReverse(ctx->in, 14); - - /* Append length in bits and transform */ -- ((uint32 *) ctx->in)[14] = ctx->bits[0]; -- ((uint32 *) ctx->in)[15] = ctx->bits[1]; -+ ((uint32_t *) ctx->in)[14] = ctx->bits[0]; -+ ((uint32_t *) ctx->in)[15] = ctx->bits[1]; - -- caml_MD5Transform(ctx->buf, (uint32 *) ctx->in); -+ caml_MD5Transform(ctx->buf, (uint32_t *) ctx->in); - byteReverse((unsigned char *) ctx->buf, 4); - memcpy(digest, ctx->buf, 16); - memset(ctx, 0, sizeof(*ctx)); /* In case it's sensitive */ -@@ -237,9 +237,9 @@ CAMLexport void caml_MD5Final(unsigned char *digest, struct MD5Context *ctx) - * reflect the addition of 16 longwords of new data. caml_MD5Update blocks - * the data and converts bytes into longwords for this routine. - */ --CAMLexport void caml_MD5Transform(uint32 *buf, uint32 *in) -+CAMLexport void caml_MD5Transform(uint32_t *buf, uint32_t *in) - { -- register uint32 a, b, c, d; -+ register uint32_t a, b, c, d; - - a = buf[0]; - b = buf[1]; -diff --git a/byterun/startup.c b/byterun/startup.c -index fb6e777..541aacd 100644 ---- a/byterun/startup.c -+++ b/byterun/startup.c -@@ -79,7 +79,7 @@ static void init_atoms(void) - - /* Read the trailer of a bytecode file */ - --static void fixup_endianness_trailer(uint32 * p) -+static void fixup_endianness_trailer(uint32_t * p) - { - #ifndef ARCH_BIG_ENDIAN - Reverse_32(p, p); -@@ -153,7 +153,7 @@ void caml_read_section_descriptors(int fd, struct exec_trailer *trail) - Return the length of the section data in bytes, or -1 if no section - found with that name. */ - --int32 caml_seek_optional_section(int fd, struct exec_trailer *trail, char *name) -+int32_t caml_seek_optional_section(int fd, struct exec_trailer *trail, char *name) - { - long ofs; - int i; -@@ -172,9 +172,9 @@ int32 caml_seek_optional_section(int fd, struct exec_trailer *trail, char *name) - /* Position fd at the beginning of the section having the given name. - Return the length of the section data in bytes. */ - --int32 caml_seek_section(int fd, struct exec_trailer *trail, char *name) -+int32_t caml_seek_section(int fd, struct exec_trailer *trail, char *name) - { -- int32 len = caml_seek_optional_section(fd, trail, name); -+ int32_t len = caml_seek_optional_section(fd, trail, name); - if (len == -1) - caml_fatal_error_arg("Fatal_error: section `%s' is missing\n", name); - return len; -@@ -185,7 +185,7 @@ int32 caml_seek_section(int fd, struct exec_trailer *trail, char *name) - - static char * read_section(int fd, struct exec_trailer *trail, char *name) - { -- int32 len; -+ int32_t len; - char * data; - - len = caml_seek_optional_section(fd, trail, name); -diff --git a/byterun/str.c b/byterun/str.c -index a72b34c..d88c3d2 100644 ---- a/byterun/str.c -+++ b/byterun/str.c -@@ -101,7 +101,7 @@ CAMLprim value caml_string_get32(value str, value index) - - CAMLprim value caml_string_get64(value str, value index) - { -- uint64 res; -+ uint64_t res; - unsigned char b1, b2, b3, b4, b5, b6, b7, b8; - intnat idx = Long_val(index); - if (idx < 0 || idx + 7 >= caml_string_length(str)) caml_array_bound_error(); -@@ -114,15 +114,15 @@ CAMLprim value caml_string_get64(value str, value index) - b7 = Byte_u(str, idx + 6); - b8 = Byte_u(str, idx + 7); - #ifdef ARCH_BIG_ENDIAN -- res = (uint64) b1 << 56 | (uint64) b2 << 48 -- | (uint64) b3 << 40 | (uint64) b4 << 32 -- | (uint64) b5 << 24 | (uint64) b6 << 16 -- | (uint64) b7 << 8 | (uint64) b8; -+ res = (uint64_t) b1 << 56 | (uint64_t) b2 << 48 -+ | (uint64_t) b3 << 40 | (uint64_t) b4 << 32 -+ | (uint64_t) b5 << 24 | (uint64_t) b6 << 16 -+ | (uint64_t) b7 << 8 | (uint64_t) b8; - #else -- res = (uint64) b8 << 56 | (uint64) b7 << 48 -- | (uint64) b6 << 40 | (uint64) b5 << 32 -- | (uint64) b4 << 24 | (uint64) b3 << 16 -- | (uint64) b2 << 8 | (uint64) b1; -+ res = (uint64_t) b8 << 56 | (uint64_t) b7 << 48 -+ | (uint64_t) b6 << 40 | (uint64_t) b5 << 32 -+ | (uint64_t) b4 << 24 | (uint64_t) b3 << 16 -+ | (uint64_t) b2 << 8 | (uint64_t) b1; - #endif - return caml_copy_int64(res); - } -@@ -174,7 +174,7 @@ CAMLprim value caml_string_set32(value str, value index, value newval) - CAMLprim value caml_string_set64(value str, value index, value newval) - { - unsigned char b1, b2, b3, b4, b5, b6, b7, b8; -- int64 val; -+ int64_t val; - intnat idx = Long_val(index); - if (idx < 0 || idx + 7 >= caml_string_length(str)) caml_array_bound_error(); - val = Int64_val(newval); -diff --git a/config/auto-aux/int64align.c b/config/auto-aux/int64align.c -index 5795e48..c143986 100644 ---- a/config/auto-aux/int64align.c -+++ b/config/auto-aux/int64align.c -@@ -17,18 +17,18 @@ - #include "m.h" - - #if defined(ARCH_INT64_TYPE) --typedef ARCH_INT64_TYPE int64; -+typedef ARCH_INT64_TYPE int64_t; - #elif SIZEOF_LONG == 8 --typedef long int64; -+typedef long int64_t; - #elif SIZEOF_LONGLONG == 8 --typedef long long int64; -+typedef long long int64_t; - #else - #error "No 64-bit integer type available" - #endif - --int64 foo; -+int64_t foo; - --void access_int64(int64 *p) -+void access_int64(int64_t *p) - { - foo = *p; - } -@@ -49,8 +49,8 @@ int main(void) - signal(SIGBUS, sig_handler); - #endif - if(setjmp(failure) == 0) { -- access_int64((int64 *) n); -- access_int64((int64 *) (n+1)); -+ access_int64((int64_t *) n); -+ access_int64((int64_t *) (n+1)); - res = 0; - } else { - res = 1; -diff --git a/config/s-nt.h b/config/s-nt.h -index e8aa878..ccf1bf4 100644 ---- a/config/s-nt.h -+++ b/config/s-nt.h -@@ -15,6 +15,9 @@ - - #define OCAML_OS_TYPE "Win32" - -+#ifdef __MINGW32__ -+#define HAS_STDINT_H -+#endif - #undef BSD_SIGNALS - #define HAS_STRERROR - #define HAS_SOCKETS -diff --git a/configure b/configure -index 6157157..1440baa 100755 ---- a/configure -+++ b/configure -@@ -648,26 +648,6 @@ case "$target" in - esac - esac - --# Check semantics of division and modulus -- --sh ./runtest divmod.c --case $? in -- 0) inf "Native division and modulus have round-towards-zero semantics," \ -- "will use them." -- echo "#undef NONSTANDARD_DIV_MOD" >> m.h;; -- 1) inf "Native division and modulus do not have round-towards-zero" -- "semantics, will use software emulation." -- echo "#define NONSTANDARD_DIV_MOD" >> m.h;; -- *) case $target in -- *-*-mingw*) inf "Native division and modulus have round-towards-zero" \ -- "semantics, will use them." -- echo "#undef NONSTANDARD_DIV_MOD" >> m.h;; -- *) wrn "Something went wrong while checking native division and modulus"\ -- "please report it at http://http://caml.inria.fr/mantis/" -- echo "#define NONSTANDARD_DIV_MOD" >> m.h;; -- esac;; --esac -- - # Shared library support - - shared_libraries_supported=false -@@ -1129,6 +1109,11 @@ if sh ./hasgot -i sys/types.h -i sys/socket.h -i netinet/in.h \ - echo "#define HAS_IPV6" >> s.h - fi - -+if sh ./hasgot -i stdint.h; then -+ inf "stdint.h found." -+ echo "#define HAS_STDINT_H" >> s.h -+fi -+ - if sh ./hasgot -i unistd.h; then - inf "unistd.h found." - echo "#define HAS_UNISTD" >> s.h -diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c -index c98a92f..4638655 100644 ---- a/otherlibs/bigarray/bigarray_stubs.c -+++ b/otherlibs/bigarray/bigarray_stubs.c -@@ -279,9 +279,9 @@ value caml_ba_get_N(value vb, value * vind, int nind) - case CAML_BA_UINT16: - return Val_int(((uint16 *) b->data)[offset]); - case CAML_BA_INT32: -- return caml_copy_int32(((int32 *) b->data)[offset]); -+ return caml_copy_int32(((int32_t *) b->data)[offset]); - case CAML_BA_INT64: -- return caml_copy_int64(((int64 *) b->data)[offset]); -+ return caml_copy_int64(((int64_t *) b->data)[offset]); - case CAML_BA_NATIVE_INT: - return caml_copy_nativeint(((intnat *) b->data)[offset]); - case CAML_BA_CAML_INT: -@@ -388,7 +388,7 @@ CAMLprim value caml_ba_uint8_get32(value vb, value vind) - - CAMLprim value caml_ba_uint8_get64(value vb, value vind) - { -- uint64 res; -+ uint64_t res; - unsigned char b1, b2, b3, b4, b5, b6, b7, b8; - intnat idx = Long_val(vind); - struct caml_ba_array * b = Caml_ba_array_val(vb); -@@ -402,15 +402,15 @@ CAMLprim value caml_ba_uint8_get64(value vb, value vind) - b7 = ((unsigned char*) b->data)[idx+6]; - b8 = ((unsigned char*) b->data)[idx+7]; - #ifdef ARCH_BIG_ENDIAN -- res = (uint64) b1 << 56 | (uint64) b2 << 48 -- | (uint64) b3 << 40 | (uint64) b4 << 32 -- | (uint64) b5 << 24 | (uint64) b6 << 16 -- | (uint64) b7 << 8 | (uint64) b8; -+ res = (uint64_t) b1 << 56 | (uint64_t) b2 << 48 -+ | (uint64_t) b3 << 40 | (uint64_t) b4 << 32 -+ | (uint64_t) b5 << 24 | (uint64_t) b6 << 16 -+ | (uint64_t) b7 << 8 | (uint64_t) b8; - #else -- res = (uint64) b8 << 56 | (uint64) b7 << 48 -- | (uint64) b6 << 40 | (uint64) b5 << 32 -- | (uint64) b4 << 24 | (uint64) b3 << 16 -- | (uint64) b2 << 8 | (uint64) b1; -+ res = (uint64_t) b8 << 56 | (uint64_t) b7 << 48 -+ | (uint64_t) b6 << 40 | (uint64_t) b5 << 32 -+ | (uint64_t) b4 << 24 | (uint64_t) b3 << 16 -+ | (uint64_t) b2 << 8 | (uint64_t) b1; - #endif - return caml_copy_int64(res); - } -@@ -447,9 +447,9 @@ static value caml_ba_set_aux(value vb, value * vind, intnat nind, value newval) - case CAML_BA_UINT16: - ((int16 *) b->data)[offset] = Int_val(newval); break; - case CAML_BA_INT32: -- ((int32 *) b->data)[offset] = Int32_val(newval); break; -+ ((int32_t *) b->data)[offset] = Int32_val(newval); break; - case CAML_BA_INT64: -- ((int64 *) b->data)[offset] = Int64_val(newval); break; -+ ((int64_t *) b->data)[offset] = Int64_val(newval); break; - case CAML_BA_NATIVE_INT: - ((intnat *) b->data)[offset] = Nativeint_val(newval); break; - case CAML_BA_CAML_INT: -@@ -577,7 +577,7 @@ CAMLprim value caml_ba_uint8_set64(value vb, value vind, value newval) - { - unsigned char b1, b2, b3, b4, b5, b6, b7, b8; - intnat idx = Long_val(vind); -- int64 val; -+ int64_t val; - struct caml_ba_array * b = Caml_ba_array_val(vb); - if (idx < 0 || idx >= b->dim[0] - 7) caml_array_bound_error(); - val = Int64_val(newval); -@@ -760,9 +760,9 @@ static int caml_ba_compare(value v1, value v2) - case CAML_BA_UINT16: - DO_INTEGER_COMPARISON(uint16); - case CAML_BA_INT32: -- DO_INTEGER_COMPARISON(int32); -+ DO_INTEGER_COMPARISON(int32_t); - case CAML_BA_INT64: -- DO_INTEGER_COMPARISON(int64); -+ DO_INTEGER_COMPARISON(int64_t); - case CAML_BA_CAML_INT: - case CAML_BA_NATIVE_INT: - DO_INTEGER_COMPARISON(intnat); -@@ -780,7 +780,7 @@ static intnat caml_ba_hash(value v) - { - struct caml_ba_array * b = Caml_ba_array_val(v); - intnat num_elts, n; -- uint32 h, w; -+ uint32_t h, w; - int i; - - num_elts = 1; -@@ -820,7 +820,7 @@ static intnat caml_ba_hash(value v) - } - case CAML_BA_INT32: - { -- uint32 * p = b->data; -+ uint32_t * p = b->data; - if (num_elts > 64) num_elts = 64; - for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_uint32(h, *p); - break; -@@ -835,7 +835,7 @@ static intnat caml_ba_hash(value v) - } - case CAML_BA_INT64: - { -- int64 * p = b->data; -+ int64_t * p = b->data; - if (num_elts > 32) num_elts = 32; - for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_int64(h, *p); - break; -@@ -878,7 +878,7 @@ static void caml_ba_serialize_longarray(void * data, - } else { - caml_serialize_int_1(0); - for (n = 0, p = data; n < num_elts; n++, p++) -- caml_serialize_int_4((int32) *p); -+ caml_serialize_int_4((int32_t) *p); - } - #else - caml_serialize_int_1(0); -@@ -1181,14 +1181,14 @@ CAMLprim value caml_ba_fill(value vb, value vinit) - break; - } - case CAML_BA_INT32: { -- int32 init = Int32_val(vinit); -- int32 * p; -+ int32_t init = Int32_val(vinit); -+ int32_t * p; - for (p = b->data; num_elts > 0; p++, num_elts--) *p = init; - break; - } - case CAML_BA_INT64: { -- int64 init = Int64_val(vinit); -- int64 * p; -+ int64_t init = Int64_val(vinit); -+ int64_t * p; - for (p = b->data; num_elts > 0; p++, num_elts--) *p = init; - break; - } -diff --git a/otherlibs/num/nat_stubs.c b/otherlibs/num/nat_stubs.c -index ae109ac..22614e1 100644 ---- a/otherlibs/num/nat_stubs.c -+++ b/otherlibs/num/nat_stubs.c -@@ -347,9 +347,9 @@ static void serialize_nat(value nat, - if (len >= ((mlsize_t)1 << 32)) - failwith("output_value: nat too big"); - #endif -- serialize_int_4((int32) len); -+ serialize_int_4((int32_t) len); - #if defined(ARCH_SIXTYFOUR) && defined(ARCH_BIG_ENDIAN) -- { int32 * p; -+ { int32_t * p; - mlsize_t i; - for (i = len, p = Data_custom_val(nat); i > 0; i -= 2, p += 2) { - serialize_int_4(p[1]); /* low 32 bits of 64-bit digit */ -@@ -369,7 +369,7 @@ static uintnat deserialize_nat(void * dst) - - len = deserialize_uint_4(); - #if defined(ARCH_SIXTYFOUR) && defined(ARCH_BIG_ENDIAN) -- { uint32 * p; -+ { uint32_t * p; - mlsize_t i; - for (i = len, p = dst; i > 1; i -= 2, p += 2) { - p[1] = deserialize_uint_4(); /* low 32 bits of 64-bit digit */ -@@ -385,7 +385,7 @@ static uintnat deserialize_nat(void * dst) - deserialize_block_4(dst, len); - #if defined(ARCH_SIXTYFOUR) - if (len & 1){ -- ((uint32 *) dst)[len] = 0; -+ ((uint32_t *) dst)[len] = 0; - ++ len; - } - #endif -@@ -396,7 +396,7 @@ static uintnat deserialize_nat(void * dst) - static intnat hash_nat(value v) - { - bngsize len, i; -- uint32 h; -+ uint32_t h; - - len = bng_num_digits(&Digit_val(v,0), Wosize_val(v) - 1); - h = 0; -@@ -406,10 +406,10 @@ static intnat hash_nat(value v) - /* Mix the two 32-bit halves as if we were on a 32-bit platform, - namely low 32 bits first, then high 32 bits. - Also, ignore final 32 bits if they are zero. */ -- h = caml_hash_mix_uint32(h, (uint32) d); -+ h = caml_hash_mix_uint32(h, (uint32_t) d); - d = d >> 32; - if (d == 0 && i + 1 == len) break; -- h = caml_hash_mix_uint32(h, (uint32) d); -+ h = caml_hash_mix_uint32(h, (uint32_t) d); - #else - h = caml_hash_mix_uint32(h, d); - #endif -diff --git a/otherlibs/unix/addrofstr.c b/otherlibs/unix/addrofstr.c -index c4bd2e7..207e1cd 100644 ---- a/otherlibs/unix/addrofstr.c -+++ b/otherlibs/unix/addrofstr.c -@@ -73,7 +73,7 @@ CAMLprim value unix_inet_addr_of_string(value s) - #else - struct in_addr address; - address.s_addr = inet_addr(String_val(s)); -- if (address.s_addr == (uint32) -1) failwith("inet_addr_of_string"); -+ if (address.s_addr == (uint32_t) -1) failwith("inet_addr_of_string"); - return alloc_inet_addr(&address); - #endif - } -diff --git a/stdlib/header.c b/stdlib/header.c -index b8d02ea..6f3dc54 100644 ---- a/stdlib/header.c -+++ b/stdlib/header.c -@@ -133,7 +133,7 @@ static char * read_runtime_path(int fd) - char buffer[TRAILER_SIZE]; - static char runtime_path[MAXPATHLEN]; - int num_sections, i; -- uint32 path_size; -+ uint32_t path_size; - long ofs; - - lseek(fd, (long) -TRAILER_SIZE, SEEK_END); --- -2.7.4 - diff --git a/0014-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch b/0014-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch deleted file mode 100644 index 756e523..0000000 --- a/0014-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch +++ /dev/null @@ -1,74 +0,0 @@ -From e6b37c1b0c9ee724ae81b74a84e133a75ed9e3a3 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Thu, 11 Sep 2014 14:49:54 +0100 -Subject: [PATCH 14/20] 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 ---- - asmcomp/power/emit.mlp | 3 ++- - asmcomp/power64/emit.mlp | 3 ++- - asmcomp/power64le/emit.mlp | 3 ++- - asmrun/power-elf.S | 3 +++ - asmrun/power64-elf.S | 2 ++ - 5 files changed, 11 insertions(+), 3 deletions(-) - -diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp -index 4344085..717ab12 100644 ---- a/asmcomp/power/emit.mlp -+++ b/asmcomp/power/emit.mlp -@@ -927,4 +927,5 @@ let end_assembly() = - ` .long ({emit_label lbl} - .) + {emit_int32 ofs}\n`); - efa_def_label = (fun l -> `{emit_label l}:\n`); - efa_string = (fun s -> emit_bytes_directive " .byte " (s ^ "\000")) -- } -+ }; -+ `.section .note.GNU-stack,\"\",%progbits; .previous\n` -diff --git a/asmcomp/power64/emit.mlp b/asmcomp/power64/emit.mlp -index 9fd59b2..4e0317a 100644 ---- a/asmcomp/power64/emit.mlp -+++ b/asmcomp/power64/emit.mlp -@@ -990,4 +990,5 @@ let end_assembly() = - `{emit_symbol lbl}:\n`; - ` .quad {emit_int (List.length !frame_descriptors)}\n`; - List.iter emit_frame !frame_descriptors; -- frame_descriptors := [] -+ frame_descriptors := []; -+ `.section .note.GNU-stack,\"\",%progbits; .previous\n` -diff --git a/asmcomp/power64le/emit.mlp b/asmcomp/power64le/emit.mlp -index 3f34102..60df72c 100644 ---- a/asmcomp/power64le/emit.mlp -+++ b/asmcomp/power64le/emit.mlp -@@ -983,4 +983,5 @@ let end_assembly() = - `{emit_symbol lbl}:\n`; - ` .quad {emit_int (List.length !frame_descriptors)}\n`; - List.iter emit_frame !frame_descriptors; -- frame_descriptors := [] -+ frame_descriptors := []; -+ `.section .note.GNU-stack,\"\",%progbits; .previous\n` -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.7.4 - diff --git a/0015-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch b/0015-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch deleted file mode 100644 index dbfb36e..0000000 --- a/0015-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch +++ /dev/null @@ -1,84 +0,0 @@ -From 3f2be69df7fa930e0584abc217ef9d06b1155696 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Fri, 24 Oct 2014 10:10:54 +0100 -Subject: [PATCH 15/20] ppc64/ppc64le: proc: Interim definitions for op_is_pure - and regs_are_volatile. - -See: https://bugzilla.redhat.com/show_bug.cgi?id=1156300 - -These are based somewhat on guesswork and need to be checked by -someone more familiar with the compiler and POWER architecture. ---- - asmcomp/power64/proc.ml | 15 +++++++++++++++ - asmcomp/power64le/proc.ml | 15 +++++++++++++++ - 2 files changed, 30 insertions(+) - -diff --git a/asmcomp/power64/proc.ml b/asmcomp/power64/proc.ml -index a5a35f3..c377f69 100644 ---- a/asmcomp/power64/proc.ml -+++ b/asmcomp/power64/proc.ml -@@ -202,6 +202,10 @@ let loc_external_results res = - - let loc_exn_bucket = phys_reg 0 - -+(* Volatile registers: none *) -+ -+let regs_are_volatile rs = false -+ - (* Registers destroyed by operations *) - - let destroyed_at_c_call = -@@ -226,6 +230,17 @@ let max_register_pressure = function - Iextcall(_, _) -> [| 15; 18 |] - | _ -> [| 23; 30 |] - -+(* Pure operations (without any side effect besides updating their result -+ registers). *) -+ -+let op_is_pure = function -+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _ -+ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ -+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false -+ | Ispecific(Imultaddf | Imultsubf) -> true -+ | Ispecific _ -> false -+ | _ -> true -+ - (* Layout of the stack *) - - let num_stack_slots = [| 0; 0 |] -diff --git a/asmcomp/power64le/proc.ml b/asmcomp/power64le/proc.ml -index 476c984..56473ac 100644 ---- a/asmcomp/power64le/proc.ml -+++ b/asmcomp/power64le/proc.ml -@@ -202,6 +202,10 @@ let loc_external_results res = - - let loc_exn_bucket = phys_reg 0 - -+(* Volatile registers: none *) -+ -+let regs_are_volatile rs = false -+ - (* Registers destroyed by operations *) - - let destroyed_at_c_call = -@@ -226,6 +230,17 @@ let max_register_pressure = function - Iextcall(_, _) -> [| 15; 18 |] - | _ -> [| 23; 30 |] - -+(* Pure operations (without any side effect besides updating their result -+ registers). *) -+ -+let op_is_pure = function -+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _ -+ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ -+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false -+ | Ispecific(Imultaddf | Imultsubf) -> true -+ | Ispecific _ -> false -+ | _ -> true -+ - (* Layout of the stack *) - - let num_stack_slots = [| 0; 0 |] --- -2.7.4 - diff --git a/0016-ppc64le-Fix-calling-convention-of-external-functions.patch b/0016-ppc64le-Fix-calling-convention-of-external-functions.patch deleted file mode 100644 index 1fcef5f..0000000 --- a/0016-ppc64le-Fix-calling-convention-of-external-functions.patch +++ /dev/null @@ -1,34 +0,0 @@ -From 3aff352bb01751cddeb2b18c26576337d1b46c90 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Thu, 28 May 2015 16:13:40 -0400 -Subject: [PATCH 16/20] ppc64le: Fix calling convention of external functions - with > 8 parameters (RHBZ#1225995). - -For external (ie. C) functions with more than 8 parameters, we must -pass the first 8 parameters in registers and then all the remaining -parameters on the stack. - -Unfortunately the original backend copied the stack offset from ppc64, -where it works, but the offset was wrong for ppc64le. - -By experimentation I found the correct offset. ---- - asmcomp/power64le/proc.ml | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/asmcomp/power64le/proc.ml b/asmcomp/power64le/proc.ml -index 56473ac..c705695 100644 ---- a/asmcomp/power64le/proc.ml -+++ b/asmcomp/power64le/proc.ml -@@ -188,7 +188,7 @@ let poweropen_external_conventions first_int last_int - 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 -+ | "elf" | "bsd" -> calling_conventions 0 7 100 107 outgoing 32 - | _ -> assert false - - let extcall_use_push = false --- -2.7.4 - diff --git a/0017-ppc64-Fix-PIC-variant-of-asmrun.patch b/0017-ppc64-Fix-PIC-variant-of-asmrun.patch deleted file mode 100644 index 0086aae..0000000 --- a/0017-ppc64-Fix-PIC-variant-of-asmrun.patch +++ /dev/null @@ -1,26 +0,0 @@ -From 8f8713a113a218e7d7203c1575e8302f49821f41 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Mon, 29 Jun 2015 08:31:31 -0400 -Subject: [PATCH 17/20] ppc64: Fix PIC variant of asmrun. - ---- - asmrun/Makefile | 3 +++ - 1 file changed, 3 insertions(+) - -diff --git a/asmrun/Makefile b/asmrun/Makefile -index a63321e..4aa2fc9 100644 ---- a/asmrun/Makefile -+++ b/asmrun/Makefile -@@ -128,6 +128,9 @@ power64.o: power64-$(SYSTEM).o - power64.p.o: power64-$(SYSTEM).o - cp power64-$(SYSTEM).o power64.p.o - -+power64.pic.o: power64-$(SYSTEM).pic.o -+ cp power64-$(SYSTEM).pic.o power64.pic.o -+ - power64le.o: power64le-$(SYSTEM).o - cp power64le-$(SYSTEM).o power64le.o - --- -2.7.4 - diff --git a/0018-ppc64le-Fix-PIC-variant-of-asmrun.patch b/0018-ppc64le-Fix-PIC-variant-of-asmrun.patch deleted file mode 100644 index aab0a0a..0000000 --- a/0018-ppc64le-Fix-PIC-variant-of-asmrun.patch +++ /dev/null @@ -1,26 +0,0 @@ -From 184190bc52eb86fe37864acc4679297a52756b01 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Mon, 29 Jun 2015 08:32:31 -0400 -Subject: [PATCH 18/20] ppc64le: Fix PIC variant of asmrun. - ---- - asmrun/Makefile | 3 +++ - 1 file changed, 3 insertions(+) - -diff --git a/asmrun/Makefile b/asmrun/Makefile -index 4aa2fc9..8997e15 100644 ---- a/asmrun/Makefile -+++ b/asmrun/Makefile -@@ -137,6 +137,9 @@ power64le.o: power64le-$(SYSTEM).o - power64le.p.o: power64le-$(SYSTEM).o - cp power64le-$(SYSTEM).o power64le.p.o - -+power64le.pic.o: power64le-$(SYSTEM).pic.o -+ cp power64le-$(SYSTEM).pic.o power64le.pic.o -+ - main.c: ../byterun/main.c - ln -s ../byterun/main.c main.c - misc.c: ../byterun/misc.c --- -2.7.4 - diff --git a/0019-ppc64-ppc64le-Fix-behaviour-of-Int64.max_int-1-RHBZ-.patch b/0019-ppc64-ppc64le-Fix-behaviour-of-Int64.max_int-1-RHBZ-.patch deleted file mode 100644 index a52a41d..0000000 --- a/0019-ppc64-ppc64le-Fix-behaviour-of-Int64.max_int-1-RHBZ-.patch +++ /dev/null @@ -1,45 +0,0 @@ -From 351e776744c56bf6c4afb75e8e9f510e89c15233 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Mon, 29 Jun 2015 14:18:38 -0400 -Subject: [PATCH 19/20] =?UTF-8?q?ppc64/ppc64le:=20Fix=20behaviour=20of=20I?= - =?UTF-8?q?nt64.max=5Fint=20=C3=B7=20-1=20(RHBZ#1236615).?= -MIME-Version: 1.0 -Content-Type: text/plain; charset=UTF-8 -Content-Transfer-Encoding: 8bit - -I only tested this on ppc64le, but assume the behaviour is the -same on ppc64. ---- - asmcomp/power64/arch.ml | 2 +- - asmcomp/power64le/arch.ml | 2 +- - 2 files changed, 2 insertions(+), 2 deletions(-) - -diff --git a/asmcomp/power64/arch.ml b/asmcomp/power64/arch.ml -index 73c516d..ccd11fc 100644 ---- a/asmcomp/power64/arch.ml -+++ b/asmcomp/power64/arch.ml -@@ -46,7 +46,7 @@ let allow_unaligned_access = false - - (* Behavior of division *) - --let division_crashes_on_overflow = false -+let division_crashes_on_overflow = true - - (* Operations on addressing modes *) - -diff --git a/asmcomp/power64le/arch.ml b/asmcomp/power64le/arch.ml -index 586534b..2155e79 100644 ---- a/asmcomp/power64le/arch.ml -+++ b/asmcomp/power64le/arch.ml -@@ -46,7 +46,7 @@ let allow_unaligned_access = false - - (* Behavior of division *) - --let division_crashes_on_overflow = false -+let division_crashes_on_overflow = true - - (* Operations on addressing modes *) - --- -2.7.4 - diff --git a/0020-fix-PR-7003-and-a-few-other-bugs-caused-by-misuse-of.patch b/0020-fix-PR-7003-and-a-few-other-bugs-caused-by-misuse-of.patch deleted file mode 100644 index 9ca859e..0000000 --- a/0020-fix-PR-7003-and-a-few-other-bugs-caused-by-misuse-of.patch +++ /dev/null @@ -1,88 +0,0 @@ -From 27381a26db4604d9f37ab9f1a12f885d1dbd278a Mon Sep 17 00:00:00 2001 -From: Damien Doligez -Date: Mon, 19 Oct 2015 15:47:33 +0000 -Subject: [PATCH 20/20] fix PR#7003 and a few other bugs caused by misuse of - Int_val - -git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@16525 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 -(cherry picked from commit 659615c7b100a89eafe6253e7a5b9d84d0e8df74) ---- - Changes | 2 ++ - byterun/alloc.c | 4 ++-- - byterun/intern.c | 2 +- - byterun/str.c | 4 ++-- - 4 files changed, 7 insertions(+), 5 deletions(-) - -diff --git a/Changes b/Changes -index 3587d44..9649e1a 100644 ---- a/Changes -+++ b/Changes -@@ -2,6 +2,8 @@ OCaml 4.02.3: - ------------- - - Bug fixes: -+- PR#7003: String.sub causes segmentation fault -+ (Damien Doligez, report by Radek Micek) - - PR#6908: Top-level custom printing for GADTs: interface change in 4.02.2 - (Grégoire Henry, report by Jeremy Yallop) - - PR#6919: corrupted final_table -diff --git a/byterun/alloc.c b/byterun/alloc.c -index b421cac..3d7dfc4 100644 ---- a/byterun/alloc.c -+++ b/byterun/alloc.c -@@ -147,7 +147,7 @@ CAMLexport int caml_convert_flag_list(value list, int *flags) - - CAMLprim value caml_alloc_dummy(value size) - { -- mlsize_t wosize = Int_val(size); -+ mlsize_t wosize = Long_val(size); - - if (wosize == 0) return Atom(0); - return caml_alloc (wosize, 0); -@@ -161,7 +161,7 @@ CAMLprim value caml_alloc_dummy_function(value size,value arity) - - CAMLprim value caml_alloc_dummy_float (value size) - { -- mlsize_t wosize = Int_val(size) * Double_wosize; -+ mlsize_t wosize = Long_val(size) * Double_wosize; - - if (wosize == 0) return Atom(0); - return caml_alloc (wosize, 0); -diff --git a/byterun/intern.c b/byterun/intern.c -index 6f2d49f..4ddc8d0 100644 ---- a/byterun/intern.c -+++ b/byterun/intern.c -@@ -287,7 +287,7 @@ static void intern_rec(value *dest) - case OFreshOID: - /* Refresh the object ID */ - /* but do not do it for predefined exception slots */ -- if (Int_val(Field((value)dest, 1)) >= 0) -+ if (Long_val(Field((value)dest, 1)) >= 0) - caml_set_oo_id((value)dest); - /* Pop item and iterate */ - sp--; -diff --git a/byterun/str.c b/byterun/str.c -index d88c3d2..5bc4e0a 100644 ---- a/byterun/str.c -+++ b/byterun/str.c -@@ -266,7 +266,7 @@ CAMLprim value caml_string_greaterequal(value s1, value s2) - CAMLprim value caml_blit_string(value s1, value ofs1, value s2, value ofs2, - value n) - { -- memmove(&Byte(s2, Long_val(ofs2)), &Byte(s1, Long_val(ofs1)), Int_val(n)); -+ memmove(&Byte(s2, Long_val(ofs2)), &Byte(s1, Long_val(ofs1)), Long_val(n)); - return Val_unit; - } - -@@ -293,7 +293,7 @@ CAMLprim value caml_is_printable(value chr) - - CAMLprim value caml_bitvect_test(value bv, value n) - { -- int pos = Int_val(n); -+ intnat pos = Long_val(n); - return Val_int(Byte_u(bv, pos >> 3) & (1 << (pos & 7))); - } - --- -2.7.4 - diff --git a/ocaml.spec b/ocaml.spec index baefa67..375cc6f 100644 --- a/ocaml.spec +++ b/ocaml.spec @@ -15,9 +15,19 @@ %global natdynlink 0 %endif +# These are all the architectures that the tests run on. The tests +# take a long time to run, so don't run them on slow machines. +%global test_arches aarch64 %{power64} x86_64 +# These are the architectures for which the tests must pass otherwise +# the build will fail. +%global test_arches_required %{power64} x86_64 + +# Architectures where parallel builds fail. +%global no_parallel_build_arches aarch64 + Name: ocaml -Version: 4.02.3 -Release: 3%{?dist} +Version: 4.04.0 +Release: 0.1.beta2%{?dist} Summary: OCaml compiler and programming environment @@ -25,10 +35,12 @@ License: QPL and (LGPLv2+ with exceptions) URL: http://www.ocaml.org -Source0: http://caml.inria.fr/pub/distrib/ocaml-4.02/ocaml-%{version}.tar.gz -Source1: http://caml.inria.fr/pub/distrib/ocaml-4.02/ocaml-4.02-refman-html.tar.gz -Source2: http://caml.inria.fr/pub/distrib/ocaml-4.02/ocaml-4.02-refman.pdf -Source3: http://caml.inria.fr/pub/distrib/ocaml-4.02/ocaml-4.02-refman.info.tar.gz +#Source0: http://caml.inria.fr/pub/distrib/ocaml-4.04/ocaml-%{version}.tar.gz +Source0: https://github.com/ocaml/ocaml/archive/4.04.0+beta2.tar.gz + +Source1: http://caml.inria.fr/pub/distrib/ocaml-4.03/ocaml-4.03-refman-html.tar.gz +Source2: http://caml.inria.fr/pub/distrib/ocaml-4.03/ocaml-4.03-refman.pdf +Source3: http://caml.inria.fr/pub/distrib/ocaml-4.03/ocaml-4.03-refman.info.tar.gz # IMPORTANT NOTE: # @@ -39,36 +51,18 @@ Source3: http://caml.inria.fr/pub/distrib/ocaml-4.02/ocaml-4.02-refman.in # # https://git.fedorahosted.org/cgit/fedora-ocaml.git/ # -# Current branch: fedora-24-4.02 +# Current branch: fedora-26-4.04.0-beta2 # # ALTERNATIVELY add a patch to the end of the list (leaving the # existing patches unchanged) adding a comment to note that it should # be incorporated into the git repo at a later time. # -Patch0001: 0001-Don-t-ignore-.-configure-it-s-a-real-git-file.patch -Patch0002: 0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch -Patch0003: 0003-Don-t-add-rpaths-to-libraries.patch -Patch0004: 0004-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch -Patch0005: 0005-configure-Allow-user-defined-C-compiler-flags.patch -Patch0006: 0006-Add-support-for-ppc64.patch -Patch0007: 0007-ppc64-Update-for-OCaml-4.02.0.patch -Patch0008: 0008-Add-support-for-ppc64le.patch -Patch0009: 0009-ppc64le-Update-for-OCaml-4.02.0.patch -Patch0010: 0010-arm-arm64-Mark-stack-as-non-executable.patch -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 -Patch0013: 0013-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch -Patch0014: 0014-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch -Patch0015: 0015-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch -Patch0016: 0016-ppc64le-Fix-calling-convention-of-external-functions.patch -Patch0017: 0017-ppc64-Fix-PIC-variant-of-asmrun.patch -Patch0018: 0018-ppc64le-Fix-PIC-variant-of-asmrun.patch -Patch0019: 0019-ppc64-ppc64le-Fix-behaviour-of-Int64.max_int-1-RHBZ-.patch -Patch0020: 0020-fix-PR-7003-and-a-few-other-bugs-caused-by-misuse-of.patch - -# Add BFD support so that ocamlobjinfo supports *.cmxs format (RHBZ#1113735). -BuildRequires: binutils-devel +Patch0001: 0001-Don-t-add-rpaths-to-libraries.patch +Patch0002: 0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch +Patch0003: 0003-configure-Allow-user-defined-C-compiler-flags.patch +Patch0004: 0004-Don-t-rewrite-Werror.patch +BuildRequires: binutils-devel BuildRequires: ncurses-devel BuildRequires: gdbm-devel BuildRequires: emacs @@ -88,9 +82,6 @@ BuildRequires: mesa-libGL-devel BuildRequires: mesa-libGLU-devel BuildRequires: chrpath -# git is required for patch management. -BuildRequires: git - Requires: gcc # Because we pass -c flag to ocaml-find-requires (to avoid circular @@ -103,8 +94,8 @@ Provides: bundled(md5-plumb) 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' +%global __ocaml_requires_opts -c -f '%{buildroot}%{_bindir}/ocamlrun %{buildroot}%{_bindir}/ocamlobjinfo.byte' +%global __ocaml_provides_opts -f '%{buildroot}%{_bindir}/ocamlrun %{buildroot}%{_bindir}/ocamlobjinfo.byte' %description @@ -196,32 +187,19 @@ may not be portable between versions. %prep -%setup -q -T -b 0 -n %{name}-%{version} -%setup -q -T -D -a 1 -n %{name}-%{version} -%setup -q -T -D -a 3 -n %{name}-%{version} +%setup -q -T -b 0 -n %{name}-%{version}-beta2 +%setup -q -T -D -a 1 -n %{name}-%{version}-beta2 +%setup -q -T -D -a 3 -n %{name}-%{version}-beta2 cp %{SOURCE2} refman.pdf - -git init -git config user.email "noone@example.com" -git config user.name "no one" -git add . -git add -f configure .depend ;# required because .gitignore lists these files -git commit -a -q -m "%{version} baseline" -git am %{patches} 1) breaks the build. Therefore we cannot use -# %{?_smp_mflags} nor MAKEFLAGS. +%ifnarch %{no_parallel_build_arches} +make="make %{?_smp_mflags}" +%else 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 ppc64le -ulimit -a -ulimit -Hs 65536 -ulimit -Ss 65536 +make=make %endif CFLAGS="$RPM_OPT_FLAGS -fno-strict-aliasing" \ @@ -232,9 +210,10 @@ CFLAGS="$RPM_OPT_FLAGS -fno-strict-aliasing" \ -x11include %{_includedir} \ -mandir %{_mandir}/man1 \ -no-curses -make world +$make world %if %{native_compiler} -make opt opt.opt +$make opt +$make opt.opt %endif make -C emacs ocamltags @@ -249,18 +228,15 @@ boot/ocamlrun ./ocamlc $includes dynlinkaux.cmo ocamlbyteinfo.ml -o ocamlbyteinf %check +%ifarch %{test_arches} cd testsuite -# See comments above. -unset MAKEFLAGS - -%ifarch ppc64 ppc64le -ulimit -a -ulimit -Hs 65536 -ulimit -Ss 65536 +%ifarch %{test_arches_required} +make -j1 all +%else +make -j1 all ||: +%endif %endif - -make all ||: %install @@ -317,37 +293,53 @@ fi %files %doc LICENSE %{_bindir}/ocaml + %{_bindir}/ocamlbyteinfo -%{_bindir}/ocamlbuild -%{_bindir}/ocamlbuild.byte -%if %{native_compiler} -%{_bindir}/ocamlbuild.native -%endif +%{_bindir}/ocamldebug +#%{_bindir}/ocamlplugininfo +%{_bindir}/ocamlyacc + +# symlink to either .byte or .opt version %{_bindir}/ocamlc -%if %{native_compiler} -%{_bindir}/ocamlc.opt -%endif %{_bindir}/ocamlcp -%{_bindir}/ocamldebug %{_bindir}/ocamldep -%if %{native_compiler} -%{_bindir}/ocamldep.opt -%endif %{_bindir}/ocamllex -%if %{native_compiler} -%{_bindir}/ocamllex.opt -%endif %{_bindir}/ocamlmklib %{_bindir}/ocamlmktop %{_bindir}/ocamlobjinfo +%{_bindir}/ocamloptp +%{_bindir}/ocamlprof + +# bytecode versions +%{_bindir}/ocamlc.byte +%{_bindir}/ocamlcp.byte +%{_bindir}/ocamldep.byte +%{_bindir}/ocamllex.byte +%{_bindir}/ocamlmklib.byte +%{_bindir}/ocamlmktop.byte +%{_bindir}/ocamlobjinfo.byte +%{_bindir}/ocamloptp.byte +%{_bindir}/ocamlprof.byte + +%if %{native_compiler} +# native code versions +%{_bindir}/ocamlc.opt +%{_bindir}/ocamlcp.opt +%{_bindir}/ocamldep.opt +%{_bindir}/ocamllex.opt +%{_bindir}/ocamlmklib.opt +%{_bindir}/ocamlmktop.opt +%{_bindir}/ocamlobjinfo.opt +%{_bindir}/ocamloptp.opt +%{_bindir}/ocamlprof.opt +%endif + %if %{native_compiler} %{_bindir}/ocamlopt +%{_bindir}/ocamlopt.byte %{_bindir}/ocamlopt.opt %endif -%{_bindir}/ocamloptp -#%{_bindir}/ocamlplugininfo -%{_bindir}/ocamlprof -%{_bindir}/ocamlyacc + #%{_libdir}/ocaml/addlabels #%{_libdir}/ocaml/scrapelabels %{_libdir}/ocaml/camlheader @@ -377,12 +369,11 @@ fi %{_libdir}/ocaml/threads/*.cmx %endif %{_libdir}/ocaml/caml -%{_libdir}/ocaml/ocamlbuild %exclude %{_libdir}/ocaml/graphicsX11.mli %files runtime -%doc README LICENSE Changes +%doc README.adoc LICENSE Changes %{_bindir}/ocamlrun %dir %{_libdir}/ocaml %{_libdir}/ocaml/VERSION @@ -446,6 +437,15 @@ fi %changelog +* Thu Nov 03 2016 Richard W.M. Jones - 4.04.0-0.1.beta2 +- New upstream version 4.04.0+beta2. +- Remove our downstream ppc64 backends, and switch to upstream power backend. +- Use autopatch instead of git for patching. +- Allow parallel builds again. +- Restore ppc stack limits. +- Remove ocamlbuild. +- Add *.byte bytecode binaries. + * Wed May 04 2016 Richard W.M. Jones - 4.02.3-3 - CVE-2015-8869 ocaml: sizes arguments are sign-extended from 32 to 64 bits (RHBZ#1332090) diff --git a/sources b/sources index b73f1db..f34320d 100644 --- a/sources +++ b/sources @@ -1,4 +1,4 @@ -20b691d71d36df69f9cb16ab4521ed49 ocaml-4.02-refman-html.tar.gz -265b7db123e925e8b7b70ca2266b4206 ocaml-4.02-refman.info.tar.gz -1d683029a6ef48e34cc24eb1982cdd05 ocaml-4.02-refman.pdf -ef1a324608c97031cbd92a442d685ab7 ocaml-4.02.3.tar.gz +92570f6b3cecf04427c3d30f9ffaff4d 4.04.0+beta2.tar.gz +d3e44d3984d029d2e88ba219ad8e24c2 ocaml-4.03-refman-html.tar.gz +4cf4acfe6b2a09610918bb9989595125 ocaml-4.03-refman.info.tar.gz +b331d36a2913348ac27a0f24aaa03871 ocaml-4.03-refman.pdf