From c4dd5fe8415ee83a3d1e7a72c3bc7d1624418f5f Mon Sep 17 00:00:00 2001 From: Richard W.M. Jones Date: Oct 24 2014 11:08:00 +0000 Subject: More fixes for ppc64/ppc64le (RHBZ#1156300). --- 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 index fb76df3..784a624 100644 --- 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 @@ -1,7 +1,7 @@ From ccc1bf226619608230dc94b26377756719cf7b20 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 24 Jun 2014 22:29:38 +0100 -Subject: [PATCH 01/13] Don't ignore ./configure, it's a real git file. +Subject: [PATCH 01/15] Don't ignore ./configure, it's a real git file. --- .gitignore | 1 - diff --git a/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch b/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch index 105ac56..94cb1f9 100644 --- a/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch +++ b/0002-Ensure-empty-compilerlibs-directory-is-created-by-gi.patch @@ -1,7 +1,7 @@ From 0e3b6450f6ab803442a809b6da41d5d5c5da650f Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 7 Jun 2012 15:36:16 +0100 -Subject: [PATCH 02/13] Ensure empty compilerlibs/ directory is created by git. +Subject: [PATCH 02/15] 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. diff --git a/0003-Don-t-add-rpaths-to-libraries.patch b/0003-Don-t-add-rpaths-to-libraries.patch index 4ccc42e..3e1d591 100644 --- a/0003-Don-t-add-rpaths-to-libraries.patch +++ b/0003-Don-t-add-rpaths-to-libraries.patch @@ -1,7 +1,7 @@ From 79f0f91e3e4abbfbd3564c11ea72e53310236afc Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 24 Jun 2014 10:00:15 +0100 -Subject: [PATCH 03/13] Don't add rpaths to libraries. +Subject: [PATCH 03/15] Don't add rpaths to libraries. --- tools/Makefile.shared | 6 +++--- diff --git a/0004-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch b/0004-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch index 8f7c70f..f6b0b86 100644 --- a/0004-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch +++ b/0004-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch @@ -1,7 +1,7 @@ From 11b377aee2811891635982a5590fef62f12645b6 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 29 May 2012 20:40:36 +0100 -Subject: [PATCH 04/13] ocamlbyteinfo, ocamlplugininfo: Useful utilities from +Subject: [PATCH 04/15] ocamlbyteinfo, ocamlplugininfo: Useful utilities from Debian, sent upstream. See: diff --git a/0005-configure-Allow-user-defined-C-compiler-flags.patch b/0005-configure-Allow-user-defined-C-compiler-flags.patch index c3c8967..a6a591f 100644 --- a/0005-configure-Allow-user-defined-C-compiler-flags.patch +++ b/0005-configure-Allow-user-defined-C-compiler-flags.patch @@ -1,7 +1,7 @@ From 5308c47681201ef3beef3e543ab877f81aa08784 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 29 May 2012 20:44:18 +0100 -Subject: [PATCH 05/13] configure: Allow user defined C compiler flags. +Subject: [PATCH 05/15] configure: Allow user defined C compiler flags. --- configure | 4 ++++ diff --git a/0006-Add-support-for-ppc64.patch b/0006-Add-support-for-ppc64.patch index 02215fb..fcab56c 100644 --- a/0006-Add-support-for-ppc64.patch +++ b/0006-Add-support-for-ppc64.patch @@ -1,7 +1,7 @@ From 3628c89d319ac8286b62ec1405561b72bda4ba0d Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 29 May 2012 20:47:07 +0100 -Subject: [PATCH 06/13] Add support for ppc64. +Subject: [PATCH 06/15] Add support for ppc64. Note (1): This patch was rejected upstream because they don't have appropriate hardware for testing. diff --git a/0007-Add-support-for-ppc64le.patch b/0007-Add-support-for-ppc64le.patch deleted file mode 100644 index c97eb70..0000000 --- a/0007-Add-support-for-ppc64le.patch +++ /dev/null @@ -1,1917 +0,0 @@ -From ab7ac2b3c241dfd2db8f9b6818d324997c982708 Mon Sep 17 00:00:00 2001 -From: Michel Normand -Date: Tue, 18 Mar 2014 09:15:47 -0400 -Subject: [PATCH 07/13] 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 5da022c..c0362b6 100644 ---- a/asmrun/Makefile -+++ b/asmrun/Makefile -@@ -99,6 +99,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 5202c3a..94b81e4 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 954b25e..cc3cbbf 100755 ---- a/configure -+++ b/configure -@@ -809,6 +809,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;; -@@ -891,6 +892,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.0.4 - diff --git a/0007-ppc64-Update-for-OCaml-4.02.0.patch b/0007-ppc64-Update-for-OCaml-4.02.0.patch new file mode 100644 index 0000000..65fc287 --- /dev/null +++ b/0007-ppc64-Update-for-OCaml-4.02.0.patch @@ -0,0 +1,205 @@ +From e07a92272d84fc98ddbe0b42439fa1518283296d Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Fri, 24 Oct 2014 12:59:23 +0200 +Subject: [PATCH 07/15] 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.0.4 + diff --git a/0008-Add-support-for-ppc64le.patch b/0008-Add-support-for-ppc64le.patch new file mode 100644 index 0000000..3794497 --- /dev/null +++ b/0008-Add-support-for-ppc64le.patch @@ -0,0 +1,1917 @@ +From 371f3ea408ebfc627ab964bb82efc1b5ced1b9b0 Mon Sep 17 00:00:00 2001 +From: Michel Normand +Date: Tue, 18 Mar 2014 09:15:47 -0400 +Subject: [PATCH 08/15] 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 5da022c..c0362b6 100644 +--- a/asmrun/Makefile ++++ b/asmrun/Makefile +@@ -99,6 +99,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 5202c3a..94b81e4 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 954b25e..cc3cbbf 100755 +--- a/configure ++++ b/configure +@@ -809,6 +809,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;; +@@ -891,6 +892,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.0.4 + diff --git a/0008-arm-arm64-Mark-stack-as-non-executable.patch b/0008-arm-arm64-Mark-stack-as-non-executable.patch deleted file mode 100644 index 8929e3a..0000000 --- a/0008-arm-arm64-Mark-stack-as-non-executable.patch +++ /dev/null @@ -1,39 +0,0 @@ -From 515d0ac7418f3ec999dae4821ffb4888ef8c9825 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Sat, 10 May 2014 03:20:35 -0400 -Subject: [PATCH 08/13] 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.0.4 - diff --git a/0009-arg-Add-no_arg-and-get_arg-helper-functions.patch b/0009-arg-Add-no_arg-and-get_arg-helper-functions.patch deleted file mode 100644 index a47353d..0000000 --- a/0009-arg-Add-no_arg-and-get_arg-helper-functions.patch +++ /dev/null @@ -1,118 +0,0 @@ -From c2783885f93b0394376cc99354f67b3647cfcfc2 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 1 Apr 2014 11:17:07 +0100 -Subject: [PATCH 09/13] arg: Add no_arg and get_arg helper functions. - -The no_arg function in this patch is a no-op. It will do something -useful in the followups. - -The get_arg function simply checks the next position on the command -line exists and returns that argument or raises a Arg.Missing. - -This patch should introduce no functional change, it is simply code -refactoring. - -In particular, this should not change the treatment of Arg.current -(see: http://caml.inria.fr/mantis/view.php?id=5197#c11147) ---- - stdlib/arg.ml | 47 ++++++++++++++++++++++++++--------------------- - 1 file changed, 26 insertions(+), 21 deletions(-) - -diff --git a/stdlib/arg.ml b/stdlib/arg.ml -index 0f6480b..a41e0a2 100644 ---- a/stdlib/arg.ml -+++ b/stdlib/arg.ml -@@ -134,56 +134,62 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = - try assoc3 s !speclist - with Not_found -> stop (Unknown s) - in -+ let no_arg () = () in -+ let get_arg () = -+ if !current + 1 < l then argv.(!current + 1) -+ else stop (Missing s) -+ in - begin try - let rec treat_action = function -- | Unit f -> f (); -- | Bool f when !current + 1 < l -> -- let arg = argv.(!current + 1) in -+ | Unit f -> no_arg (); f (); -+ | Bool f -> -+ let arg = get_arg () in - begin try f (bool_of_string arg) - with Invalid_argument "bool_of_string" -> - raise (Stop (Wrong (s, arg, "a boolean"))) - end; - incr current; -- | Set r -> r := true; -- | Clear r -> r := false; -- | String f when !current + 1 < l -> -- f argv.(!current + 1); -+ | Set r -> no_arg (); r := true; -+ | Clear r -> no_arg (); r := false; -+ | String f -> -+ let arg = get_arg () in -+ f arg; - incr current; -- | Symbol (symb, f) when !current + 1 < l -> -- let arg = argv.(!current + 1) in -+ | Symbol (symb, f) -> -+ let arg = get_arg () in - if List.mem arg symb then begin -- f argv.(!current + 1); -+ f arg; - incr current; - end else begin - raise (Stop (Wrong (s, arg, "one of: " - ^ (make_symlist "" " " "" symb)))) - end -- | Set_string r when !current + 1 < l -> -- r := argv.(!current + 1); -+ | Set_string r -> -+ r := get_arg (); - incr current; -- | Int f when !current + 1 < l -> -- let arg = argv.(!current + 1) in -+ | Int f -> -+ let arg = get_arg () in - begin try f (int_of_string arg) - with Failure "int_of_string" -> - raise (Stop (Wrong (s, arg, "an integer"))) - end; - incr current; -- | Set_int r when !current + 1 < l -> -- let arg = argv.(!current + 1) in -+ | Set_int r -> -+ let arg = get_arg () in - begin try r := (int_of_string arg) - with Failure "int_of_string" -> - raise (Stop (Wrong (s, arg, "an integer"))) - end; - incr current; -- | Float f when !current + 1 < l -> -- let arg = argv.(!current + 1) in -+ | Float f -> -+ let arg = get_arg () in - begin try f (float_of_string arg); - with Failure "float_of_string" -> - raise (Stop (Wrong (s, arg, "a float"))) - end; - incr current; -- | Set_float r when !current + 1 < l -> -- let arg = argv.(!current + 1) in -+ | Set_float r -> -+ let arg = get_arg () in - begin try r := (float_of_string arg); - with Failure "float_of_string" -> - raise (Stop (Wrong (s, arg, "a float"))) -@@ -196,7 +202,6 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = - f argv.(!current + 1); - incr current; - done; -- | _ -> raise (Stop (Missing s)) - in - treat_action action - with Bad m -> stop (Message m); --- -2.0.4 - diff --git a/0009-ppc64le-Update-for-OCaml-4.02.0.patch b/0009-ppc64le-Update-for-OCaml-4.02.0.patch new file mode 100644 index 0000000..042eeae --- /dev/null +++ b/0009-ppc64le-Update-for-OCaml-4.02.0.patch @@ -0,0 +1,204 @@ +From 2d809c0bf3d0f4106ec7ff9c9e4ee3c8204d9516 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Fri, 24 Oct 2014 12:59:23 +0200 +Subject: [PATCH 09/15] 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.0.4 + diff --git a/0010-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch b/0010-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch deleted file mode 100644 index 0eef1bc..0000000 --- a/0010-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch +++ /dev/null @@ -1,84 +0,0 @@ -From 21a743dc1983b3b41ddaa790c621fe0b46969e1f Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 1 Apr 2014 11:21:40 +0100 -Subject: [PATCH 10/13] arg: Allow flags such as --flag=arg as well as --flag - arg. - -Allow flags to be followed directly by their argument, separated by an '=' -sign. This is consistent with what GNU getopt_long and many other -command line parsing libraries allow. - -Fix for the following issue: -http://caml.inria.fr/mantis/view.php?id=5197 ---- - stdlib/arg.ml | 30 ++++++++++++++++++++++++------ - stdlib/arg.mli | 3 ++- - 2 files changed, 26 insertions(+), 7 deletions(-) - -diff --git a/stdlib/arg.ml b/stdlib/arg.ml -index a41e0a2..5ffdabc 100644 ---- a/stdlib/arg.ml -+++ b/stdlib/arg.ml -@@ -55,6 +55,12 @@ let rec assoc3 x l = - | _ :: t -> assoc3 x t - ;; - -+let split s = -+ let i = String.index s '=' in -+ let len = String.length s in -+ String.sub s 0 i, String.sub s (i+1) (len-(i+1)) -+;; -+ - let make_symlist prefix sep suffix l = - match l with - | [] -> "" -@@ -130,14 +136,26 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = - while !current < l do - let s = argv.(!current) in - if String.length s >= 1 && s.[0] = '-' then begin -- let action = -- try assoc3 s !speclist -- with Not_found -> stop (Unknown s) -+ let action, follow = -+ try assoc3 s !speclist, None -+ with Not_found -> -+ try -+ let keyword, arg = split s in -+ assoc3 keyword !speclist, Some arg -+ with Not_found -> stop (Unknown s) - in -- let no_arg () = () in -+ let no_arg () = -+ match follow with -+ | None -> () -+ | Some arg -> stop (Wrong (s, arg, "no argument")) in - let get_arg () = -- if !current + 1 < l then argv.(!current + 1) -- else stop (Missing s) -+ match follow with -+ | None -> -+ if !current + 1 < l then argv.(!current + 1) -+ else stop (Missing s) -+ | Some arg -> -+ decr current; -+ arg - in - begin try - let rec treat_action = function -diff --git a/stdlib/arg.mli b/stdlib/arg.mli -index 22eda40..7078071 100644 ---- a/stdlib/arg.mli -+++ b/stdlib/arg.mli -@@ -25,7 +25,8 @@ - [Unit], [Set] and [Clear] keywords take no argument. A [Rest] - keyword takes the remaining of the command line as arguments. - Every other keyword takes the following word on the command line -- as argument. -+ as argument. For compatibility with GNU getopt_long, [keyword=arg] -+ is also allowed. - Arguments not preceded by a keyword are called anonymous arguments. - - Examples ([cmd] is assumed to be the command name): --- -2.0.4 - diff --git a/0010-arm-arm64-Mark-stack-as-non-executable.patch b/0010-arm-arm64-Mark-stack-as-non-executable.patch new file mode 100644 index 0000000..c814442 --- /dev/null +++ b/0010-arm-arm64-Mark-stack-as-non-executable.patch @@ -0,0 +1,39 @@ +From 00721516cd921f71f727915e14b723412afe835a Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Sat, 10 May 2014 03:20:35 -0400 +Subject: [PATCH 10/15] 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.0.4 + diff --git a/0011-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch b/0011-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch deleted file mode 100644 index 733cda7..0000000 --- a/0011-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch +++ /dev/null @@ -1,1963 +0,0 @@ -From 8dcd718671ad2bd5384a9d9ffeed7d33b1b34a27 Mon Sep 17 00:00:00 2001 -From: Xavier Leroy -Date: Wed, 27 Aug 2014 09:58:33 +0000 -Subject: [PATCH 11/13] 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/alloc.h | 4 +- - byterun/backtrace.c | 2 +- - byterun/config.h | 35 +++++++---- - byterun/debugger.h | 28 ++++----- - byterun/exec.h | 4 +- - byterun/extern.c | 4 +- - byterun/fix_code.c | 8 +-- - byterun/floats.c | 6 +- - byterun/globroots.c | 4 +- - byterun/hash.c | 44 +++++++------- - byterun/hash.h | 12 ++-- - byterun/int64_emul.h | 114 ++++++++++++++++++------------------ - byterun/int64_format.h | 4 +- - byterun/int64_native.h | 20 +++---- - byterun/intern.c | 20 +++---- - byterun/interp.c | 2 +- - byterun/intext.h | 12 ++-- - byterun/ints.c | 112 +++++++++++++++++------------------ - byterun/io.c | 6 +- - byterun/io.h | 6 +- - byterun/md5.c | 26 ++++---- - byterun/md5.h | 6 +- - byterun/mlvalues.h | 12 ++-- - byterun/startup.c | 10 ++-- - byterun/startup.h | 4 +- - 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 c72a237..773e22c 100644 ---- a/asmrun/backtrace.c -+++ b/asmrun/backtrace.c -@@ -217,7 +217,7 @@ static void extract_location_info(frame_descr * d, - /*out*/ struct 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 -@@ -232,8 +232,8 @@ static 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/alloc.h b/byterun/alloc.h -index f00a7ef..2a640eb 100644 ---- a/byterun/alloc.h -+++ b/byterun/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/backtrace.c b/byterun/backtrace.c -index 76e3ddf..6ed56c8 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/config.h b/byterun/config.h -index f775988..6c86d16 100644 ---- a/byterun/config.h -+++ b/byterun/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/debugger.h b/byterun/debugger.h -index b5079eb..e68ef75 100644 ---- a/byterun/debugger.h -+++ b/byterun/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/exec.h b/byterun/exec.h -index a58bcf8..7e084ac 100644 ---- a/byterun/exec.h -+++ b/byterun/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/extern.c b/byterun/extern.c -index 33fa89a..e67d7a3 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 3380dc9..4fa0275 100644 ---- a/byterun/fix_code.c -+++ b/byterun/fix_code.c -@@ -134,12 +134,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 7ff6d89..d8fdd05 100644 ---- a/byterun/floats.c -+++ b/byterun/floats.c -@@ -378,9 +378,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 - }; - -@@ -467,7 +467,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 ded393e..d9111ee 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 f896426..12912d3 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/hash.h b/byterun/hash.h -index 436a8bb..6561397 100644 ---- a/byterun/hash.h -+++ b/byterun/hash.h -@@ -18,12 +18,12 @@ - - #include "mlvalues.h" - --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); - - - #endif -diff --git a/byterun/int64_emul.h b/byterun/int64_emul.h -index ba7904a..2554df1 100644 ---- a/byterun/int64_emul.h -+++ b/byterun/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/int64_format.h b/byterun/int64_format.h -index b0de527..aa8f1ab 100644 ---- a/byterun/int64_format.h -+++ b/byterun/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/int64_native.h b/byterun/int64_native.h -index e9ffe67..b6716ad 100644 ---- a/byterun/int64_native.h -+++ b/byterun/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/intern.c b/byterun/intern.c -index e0fcc5d..638ff72 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 9b682ba..e22b28b 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/intext.h b/byterun/intext.h -index f7aa655..2c108a4 100644 ---- a/byterun/intext.h -+++ b/byterun/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/ints.c b/byterun/ints.c -index d762c76..056e82a 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 5f04a96..bedc0f0 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/io.h b/byterun/io.h -index 64a8bf5..5a9c037 100644 ---- a/byterun/io.h -+++ b/byterun/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/md5.c b/byterun/md5.c -index 10ac76a..2dc90a2 100644 ---- a/byterun/md5.c -+++ b/byterun/md5.c -@@ -97,11 +97,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); - } -@@ -129,12 +129,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; - -@@ -152,7 +152,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; - } -@@ -161,7 +161,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; - } -@@ -196,7 +196,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); -@@ -207,10 +207,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 */ -@@ -233,9 +233,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/md5.h b/byterun/md5.h -index d8aff09..f63667d 100644 ---- a/byterun/md5.h -+++ b/byterun/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/mlvalues.h b/byterun/mlvalues.h -index 268bcfe..a08948e 100644 ---- a/byterun/mlvalues.h -+++ b/byterun/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/startup.c b/byterun/startup.c -index 3697220..ab926ef 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/startup.h b/byterun/startup.h -index 3dda64b..3268d88 100644 ---- a/byterun/startup.h -+++ b/byterun/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/str.c b/byterun/str.c -index 6effa91..9c7baa1 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 6df440b..603b050 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 cc3cbbf..ff27aa9 100755 ---- a/configure -+++ b/configure -@@ -615,26 +615,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 -@@ -1085,6 +1065,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 7e63cbf..f2ccb92 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 9a62759..d718a05 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 e17841f..a2830ba 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 cb3d995..93cdfeb 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.0.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 new file mode 100644 index 0000000..2214c5e --- /dev/null +++ b/0011-arg-Add-no_arg-and-get_arg-helper-functions.patch @@ -0,0 +1,118 @@ +From 8c54b8588ea3000c5082a0a2b2e57c3d5a1a8655 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 1 Apr 2014 11:17:07 +0100 +Subject: [PATCH 11/15] arg: Add no_arg and get_arg helper functions. + +The no_arg function in this patch is a no-op. It will do something +useful in the followups. + +The get_arg function simply checks the next position on the command +line exists and returns that argument or raises a Arg.Missing. + +This patch should introduce no functional change, it is simply code +refactoring. + +In particular, this should not change the treatment of Arg.current +(see: http://caml.inria.fr/mantis/view.php?id=5197#c11147) +--- + stdlib/arg.ml | 47 ++++++++++++++++++++++++++--------------------- + 1 file changed, 26 insertions(+), 21 deletions(-) + +diff --git a/stdlib/arg.ml b/stdlib/arg.ml +index 0f6480b..a41e0a2 100644 +--- a/stdlib/arg.ml ++++ b/stdlib/arg.ml +@@ -134,56 +134,62 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = + try assoc3 s !speclist + with Not_found -> stop (Unknown s) + in ++ let no_arg () = () in ++ let get_arg () = ++ if !current + 1 < l then argv.(!current + 1) ++ else stop (Missing s) ++ in + begin try + let rec treat_action = function +- | Unit f -> f (); +- | Bool f when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Unit f -> no_arg (); f (); ++ | Bool f -> ++ let arg = get_arg () in + begin try f (bool_of_string arg) + with Invalid_argument "bool_of_string" -> + raise (Stop (Wrong (s, arg, "a boolean"))) + end; + incr current; +- | Set r -> r := true; +- | Clear r -> r := false; +- | String f when !current + 1 < l -> +- f argv.(!current + 1); ++ | Set r -> no_arg (); r := true; ++ | Clear r -> no_arg (); r := false; ++ | String f -> ++ let arg = get_arg () in ++ f arg; + incr current; +- | Symbol (symb, f) when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Symbol (symb, f) -> ++ let arg = get_arg () in + if List.mem arg symb then begin +- f argv.(!current + 1); ++ f arg; + incr current; + end else begin + raise (Stop (Wrong (s, arg, "one of: " + ^ (make_symlist "" " " "" symb)))) + end +- | Set_string r when !current + 1 < l -> +- r := argv.(!current + 1); ++ | Set_string r -> ++ r := get_arg (); + incr current; +- | Int f when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Int f -> ++ let arg = get_arg () in + begin try f (int_of_string arg) + with Failure "int_of_string" -> + raise (Stop (Wrong (s, arg, "an integer"))) + end; + incr current; +- | Set_int r when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Set_int r -> ++ let arg = get_arg () in + begin try r := (int_of_string arg) + with Failure "int_of_string" -> + raise (Stop (Wrong (s, arg, "an integer"))) + end; + incr current; +- | Float f when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Float f -> ++ let arg = get_arg () in + begin try f (float_of_string arg); + with Failure "float_of_string" -> + raise (Stop (Wrong (s, arg, "a float"))) + end; + incr current; +- | Set_float r when !current + 1 < l -> +- let arg = argv.(!current + 1) in ++ | Set_float r -> ++ let arg = get_arg () in + begin try r := (float_of_string arg); + with Failure "float_of_string" -> + raise (Stop (Wrong (s, arg, "a float"))) +@@ -196,7 +202,6 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = + f argv.(!current + 1); + incr current; + done; +- | _ -> raise (Stop (Missing s)) + in + treat_action action + with Bad m -> stop (Message m); +-- +2.0.4 + 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 new file mode 100644 index 0000000..4ca5cd9 --- /dev/null +++ b/0012-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch @@ -0,0 +1,84 @@ +From 857b0cdc2ac37926e625034e5e62114e103cfe9e Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 1 Apr 2014 11:21:40 +0100 +Subject: [PATCH 12/15] arg: Allow flags such as --flag=arg as well as --flag + arg. + +Allow flags to be followed directly by their argument, separated by an '=' +sign. This is consistent with what GNU getopt_long and many other +command line parsing libraries allow. + +Fix for the following issue: +http://caml.inria.fr/mantis/view.php?id=5197 +--- + stdlib/arg.ml | 30 ++++++++++++++++++++++++------ + stdlib/arg.mli | 3 ++- + 2 files changed, 26 insertions(+), 7 deletions(-) + +diff --git a/stdlib/arg.ml b/stdlib/arg.ml +index a41e0a2..5ffdabc 100644 +--- a/stdlib/arg.ml ++++ b/stdlib/arg.ml +@@ -55,6 +55,12 @@ let rec assoc3 x l = + | _ :: t -> assoc3 x t + ;; + ++let split s = ++ let i = String.index s '=' in ++ let len = String.length s in ++ String.sub s 0 i, String.sub s (i+1) (len-(i+1)) ++;; ++ + let make_symlist prefix sep suffix l = + match l with + | [] -> "" +@@ -130,14 +136,26 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = + while !current < l do + let s = argv.(!current) in + if String.length s >= 1 && s.[0] = '-' then begin +- let action = +- try assoc3 s !speclist +- with Not_found -> stop (Unknown s) ++ let action, follow = ++ try assoc3 s !speclist, None ++ with Not_found -> ++ try ++ let keyword, arg = split s in ++ assoc3 keyword !speclist, Some arg ++ with Not_found -> stop (Unknown s) + in +- let no_arg () = () in ++ let no_arg () = ++ match follow with ++ | None -> () ++ | Some arg -> stop (Wrong (s, arg, "no argument")) in + let get_arg () = +- if !current + 1 < l then argv.(!current + 1) +- else stop (Missing s) ++ match follow with ++ | None -> ++ if !current + 1 < l then argv.(!current + 1) ++ else stop (Missing s) ++ | Some arg -> ++ decr current; ++ arg + in + begin try + let rec treat_action = function +diff --git a/stdlib/arg.mli b/stdlib/arg.mli +index 22eda40..7078071 100644 +--- a/stdlib/arg.mli ++++ b/stdlib/arg.mli +@@ -25,7 +25,8 @@ + [Unit], [Set] and [Clear] keywords take no argument. A [Rest] + keyword takes the remaining of the command line as arguments. + Every other keyword takes the following word on the command line +- as argument. ++ as argument. For compatibility with GNU getopt_long, [keyword=arg] ++ is also allowed. + Arguments not preceded by a keyword are called anonymous arguments. + + Examples ([cmd] is assumed to be the command name): +-- +2.0.4 + diff --git a/0012-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch b/0012-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch deleted file mode 100644 index a3a00bf..0000000 --- a/0012-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch +++ /dev/null @@ -1,38 +0,0 @@ -From 719dd72c791d557ab6bc17a1327a36fb04ea9237 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Thu, 11 Sep 2014 14:49:54 +0100 -Subject: [PATCH 12/13] ppc, ppc64, ppc64le: Mark stack as non-executable. - -The same fix as this one, which was only fully applied to -i686 & x86-64: - -http://caml.inria.fr/mantis/view.php?id=4564 ---- - asmrun/power-elf.S | 3 +++ - asmrun/power64-elf.S | 2 ++ - 2 files changed, 5 insertions(+) - -diff --git a/asmrun/power-elf.S b/asmrun/power-elf.S -index facbfbf..14d28a0 100644 ---- a/asmrun/power-elf.S -+++ b/asmrun/power-elf.S -@@ -478,3 +478,6 @@ caml_system__frametable: - .long .L105 + 4 /* return address into callback */ - .short -1 /* negative size count => use callback link */ - .short 0 /* no roots here */ -+ -+/* Mark stack as non-executable, PR#4564 */ -+ .section .note.GNU-stack,"",%progbits -diff --git a/asmrun/power64-elf.S b/asmrun/power64-elf.S -index 98c42e2..b7bfce4 100644 ---- a/asmrun/power64-elf.S -+++ b/asmrun/power64-elf.S -@@ -577,3 +577,5 @@ caml_system__frametable: - .short 0 /* no roots here */ - .align 3 - -+/* Mark stack as non-executable, PR#4564 */ -+ .section .note.GNU-stack,"",%progbits --- -2.0.4 - diff --git a/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 new file mode 100644 index 0000000..5d397a2 --- /dev/null +++ b/0013-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch @@ -0,0 +1,1963 @@ +From d58a221d0fd307d80bed6cfcec67a1c97e47439c Mon Sep 17 00:00:00 2001 +From: Xavier Leroy +Date: Wed, 27 Aug 2014 09:58:33 +0000 +Subject: [PATCH 13/15] 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/alloc.h | 4 +- + byterun/backtrace.c | 2 +- + byterun/config.h | 35 +++++++---- + byterun/debugger.h | 28 ++++----- + byterun/exec.h | 4 +- + byterun/extern.c | 4 +- + byterun/fix_code.c | 8 +-- + byterun/floats.c | 6 +- + byterun/globroots.c | 4 +- + byterun/hash.c | 44 +++++++------- + byterun/hash.h | 12 ++-- + byterun/int64_emul.h | 114 ++++++++++++++++++------------------ + byterun/int64_format.h | 4 +- + byterun/int64_native.h | 20 +++---- + byterun/intern.c | 20 +++---- + byterun/interp.c | 2 +- + byterun/intext.h | 12 ++-- + byterun/ints.c | 112 +++++++++++++++++------------------ + byterun/io.c | 6 +- + byterun/io.h | 6 +- + byterun/md5.c | 26 ++++---- + byterun/md5.h | 6 +- + byterun/mlvalues.h | 12 ++-- + byterun/startup.c | 10 ++-- + byterun/startup.h | 4 +- + 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 c72a237..773e22c 100644 +--- a/asmrun/backtrace.c ++++ b/asmrun/backtrace.c +@@ -217,7 +217,7 @@ static void extract_location_info(frame_descr * d, + /*out*/ struct 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 +@@ -232,8 +232,8 @@ static 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/alloc.h b/byterun/alloc.h +index f00a7ef..2a640eb 100644 +--- a/byterun/alloc.h ++++ b/byterun/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/backtrace.c b/byterun/backtrace.c +index 76e3ddf..6ed56c8 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/config.h b/byterun/config.h +index f775988..6c86d16 100644 +--- a/byterun/config.h ++++ b/byterun/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/debugger.h b/byterun/debugger.h +index b5079eb..e68ef75 100644 +--- a/byterun/debugger.h ++++ b/byterun/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/exec.h b/byterun/exec.h +index a58bcf8..7e084ac 100644 +--- a/byterun/exec.h ++++ b/byterun/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/extern.c b/byterun/extern.c +index 33fa89a..e67d7a3 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 3380dc9..4fa0275 100644 +--- a/byterun/fix_code.c ++++ b/byterun/fix_code.c +@@ -134,12 +134,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 7ff6d89..d8fdd05 100644 +--- a/byterun/floats.c ++++ b/byterun/floats.c +@@ -378,9 +378,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 + }; + +@@ -467,7 +467,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 ded393e..d9111ee 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 f896426..12912d3 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/hash.h b/byterun/hash.h +index 436a8bb..6561397 100644 +--- a/byterun/hash.h ++++ b/byterun/hash.h +@@ -18,12 +18,12 @@ + + #include "mlvalues.h" + +-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); + + + #endif +diff --git a/byterun/int64_emul.h b/byterun/int64_emul.h +index ba7904a..2554df1 100644 +--- a/byterun/int64_emul.h ++++ b/byterun/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/int64_format.h b/byterun/int64_format.h +index b0de527..aa8f1ab 100644 +--- a/byterun/int64_format.h ++++ b/byterun/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/int64_native.h b/byterun/int64_native.h +index e9ffe67..b6716ad 100644 +--- a/byterun/int64_native.h ++++ b/byterun/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/intern.c b/byterun/intern.c +index e0fcc5d..638ff72 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 9b682ba..e22b28b 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/intext.h b/byterun/intext.h +index f7aa655..2c108a4 100644 +--- a/byterun/intext.h ++++ b/byterun/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/ints.c b/byterun/ints.c +index d762c76..056e82a 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 5f04a96..bedc0f0 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/io.h b/byterun/io.h +index 64a8bf5..5a9c037 100644 +--- a/byterun/io.h ++++ b/byterun/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/md5.c b/byterun/md5.c +index 10ac76a..2dc90a2 100644 +--- a/byterun/md5.c ++++ b/byterun/md5.c +@@ -97,11 +97,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); + } +@@ -129,12 +129,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; + +@@ -152,7 +152,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; + } +@@ -161,7 +161,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; + } +@@ -196,7 +196,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); +@@ -207,10 +207,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 */ +@@ -233,9 +233,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/md5.h b/byterun/md5.h +index d8aff09..f63667d 100644 +--- a/byterun/md5.h ++++ b/byterun/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/mlvalues.h b/byterun/mlvalues.h +index 268bcfe..a08948e 100644 +--- a/byterun/mlvalues.h ++++ b/byterun/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/startup.c b/byterun/startup.c +index 3697220..ab926ef 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/startup.h b/byterun/startup.h +index 3dda64b..3268d88 100644 +--- a/byterun/startup.h ++++ b/byterun/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/str.c b/byterun/str.c +index 6effa91..9c7baa1 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 6df440b..603b050 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 cc3cbbf..ff27aa9 100755 +--- a/configure ++++ b/configure +@@ -615,26 +615,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 +@@ -1085,6 +1065,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 7e63cbf..f2ccb92 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 9a62759..d718a05 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 e17841f..a2830ba 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 cb3d995..93cdfeb 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.0.4 + diff --git a/0013-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch b/0013-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch deleted file mode 100644 index 5c0ef52..0000000 --- a/0013-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch +++ /dev/null @@ -1,84 +0,0 @@ -From 0d60237e349595e1022c2258fe6fcb4137d9e128 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Fri, 24 Oct 2014 10:10:54 +0100 -Subject: [PATCH 13/13] 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 372303d..85a8742 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 9b98577..ea956b8 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.0.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 new file mode 100644 index 0000000..2c9da1f --- /dev/null +++ b/0014-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch @@ -0,0 +1,38 @@ +From 907e64f45ad87b746aad704af717b067d0909014 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Thu, 11 Sep 2014 14:49:54 +0100 +Subject: [PATCH 14/15] ppc, ppc64, ppc64le: Mark stack as non-executable. + +The same fix as this one, which was only fully applied to +i686 & x86-64: + +http://caml.inria.fr/mantis/view.php?id=4564 +--- + asmrun/power-elf.S | 3 +++ + asmrun/power64-elf.S | 2 ++ + 2 files changed, 5 insertions(+) + +diff --git a/asmrun/power-elf.S b/asmrun/power-elf.S +index facbfbf..14d28a0 100644 +--- a/asmrun/power-elf.S ++++ b/asmrun/power-elf.S +@@ -478,3 +478,6 @@ caml_system__frametable: + .long .L105 + 4 /* return address into callback */ + .short -1 /* negative size count => use callback link */ + .short 0 /* no roots here */ ++ ++/* Mark stack as non-executable, PR#4564 */ ++ .section .note.GNU-stack,"",%progbits +diff --git a/asmrun/power64-elf.S b/asmrun/power64-elf.S +index 98c42e2..b7bfce4 100644 +--- a/asmrun/power64-elf.S ++++ b/asmrun/power64-elf.S +@@ -577,3 +577,5 @@ caml_system__frametable: + .short 0 /* no roots here */ + .align 3 + ++/* Mark stack as non-executable, PR#4564 */ ++ .section .note.GNU-stack,"",%progbits +-- +2.0.4 + diff --git a/0015-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch b/0015-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch new file mode 100644 index 0000000..505f6c5 --- /dev/null +++ b/0015-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.patch @@ -0,0 +1,84 @@ +From a3cbc5d7e8f5576c9b0d5fb32b359d75c0edfdb1 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Fri, 24 Oct 2014 10:10:54 +0100 +Subject: [PATCH 15/15] 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.0.4 + diff --git a/ocaml.spec b/ocaml.spec index bf28026..f07e521 100644 --- a/ocaml.spec +++ b/ocaml.spec @@ -17,7 +17,7 @@ Name: ocaml Version: 4.02.0 -Release: 5%{?dist} +Release: 6%{?dist} Summary: OCaml compiler and programming environment @@ -51,13 +51,15 @@ 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-Add-support-for-ppc64le.patch -Patch0008: 0008-arm-arm64-Mark-stack-as-non-executable.patch -Patch0009: 0009-arg-Add-no_arg-and-get_arg-helper-functions.patch -Patch0010: 0010-arg-Allow-flags-such-as-flag-arg-as-well-as-flag-arg.patch -Patch0011: 0011-PR-6517-use-ISO-C99-types-u-int-32-64-_t-in-preferen.patch -Patch0012: 0012-ppc-ppc64-ppc64le-Mark-stack-as-non-executable.patch -Patch0013: 0013-ppc64-ppc64le-proc-Interim-definitions-for-op_is_pur.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 # Add BFD support so that ocamlobjinfo supports *.cmxs format (RHBZ#1113735). BuildRequires: binutils-devel @@ -420,7 +422,7 @@ fi %changelog -* Fri Oct 24 2014 Richard W.M. Jones - 4.02.0-5 +* Fri Oct 24 2014 Richard W.M. Jones - 4.02.0-6 - Fixes for ppc64/ppc64le (RHBZ#1156300). * Mon Oct 20 2014 Richard W.M. Jones - 4.02.0-4