Patch from Fedora spec-file to add powerpc support.  This patch was rejected by

upstream.  This may not be needed on Solaris, but keeping it for consistency

with the RHEL package.

https://sympa.inria.fr/sympa/arc/caml-list/2007-10/msg00502.html

diff -uNr ocaml-3.10.1/asmcomp/power64/arch.ml ocaml-3.10.1.ppc64/asmcomp/power64/arch.ml

--- ocaml-3.10.1/asmcomp/power64/arch.ml	1969-12-31 19:00:00.000000000 -0500

+++ ocaml-3.10.1.ppc64/asmcomp/power64/arch.ml	2008-02-29 08:37:45.000000000 -0500

@@ -0,0 +1,84 @@

+(***********************************************************************)

+(*                                                                     *)

+(*                           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,v 1.11 2004/06/19 16:13:32 xleroy Exp $ *)

+

+(* Specific operations for the PowerPC processor *)

+

+open Misc

+open Format

+

+(* Machine-specific command-line options *)

+

+let command_line_options = []

+

+(* Specific operations *)

+

+type specific_operation =

+    Imultaddf                           (* multiply and add *)

+  | Imultsubf                           (* multiply and subtract *)

+  | Ialloc_far of int                   (* allocation in large functions *)

+

+(* Addressing modes *)

+

+type addressing_mode =

+    Ibased of string * int              (* symbol + displ *)

+  | Iindexed of int                     (* reg + displ *)

+  | Iindexed2                           (* reg + reg *)

+

+(* Sizes, endianness *)

+

+let big_endian = true

+

+let size_addr = 8

+let size_int = 8

+let size_float = 8

+

+(* 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 -uNr ocaml-3.10.1/asmcomp/power64/emit.mlp ocaml-3.10.1.ppc64/asmcomp/power64/emit.mlp

--- ocaml-3.10.1/asmcomp/power64/emit.mlp	1969-12-31 19:00:00.000000000 -0500

+++ ocaml-3.10.1.ppc64/asmcomp/power64/emit.mlp	2008-02-29 08:37:45.000000000 -0500

@@ -0,0 +1,989 @@

+(***********************************************************************)

+(*                                                                     *)

+(*                           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,v 1.21 2004/06/19 17:39:34 xleroy Exp $ *)

+

+(* Emission of PowerPC assembly code *)

+

+module StringSet = Set.Make(struct type t = string let compare = compare end)

+

+open Location

+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 or (num_stack_slots.(0) + num_stack_slots.(1)) > (288-16)/8 then

+    true

+  else 

+    false

+

+let frame_size_sans_args () =

+  let size = 8 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + 48 in

+  Misc.align size 16

+

+let slot_offset loc cls =

+  match loc with

+    Local n ->

+      if cls = 0

+      then (!stack_slot_lbl, num_stack_slots.(1) * 8 + n * 8)

+      else (!stack_slot_lbl, n * 8)

+  | Incoming n -> ((if has_stack_frame() then !stack_size_lbl else 0), 48 + n)

+  | Outgoing n -> (0,  n)

+

+(* Output a symbol *)

+

+let emit_symbol =

+  match Config.system with

+  | "elf" | "bsd" -> (fun s -> Emitaux.emit_symbol '.' s)

+  | "rhapsody"    -> (fun s -> emit_char '_'; Emitaux.emit_symbol '$' s)

+  | _ -> assert false

+

+(* Output a label *)

+

+let label_prefix =

+  match Config.system with

+  | "elf" | "bsd" -> ".L"

+  | "rhapsody" -> "L"

+  | _ -> assert false

+

+let emit_label lbl =

+  emit_string label_prefix; emit_int lbl

+

+(* Section switching *)

+

+let toc_space =

+  match Config.system with

+  | "elf" | "bsd" -> "	.section \".toc\",\"aw\"\n"

+  | "rhapsody"    -> "	.toc\n"

+  | _ -> assert false

+

+let data_space =

+  match Config.system with

+  | "elf" | "bsd" -> "	.section \".data\"\n"

+  | "rhapsody"    -> "	.data\n"

+  | _ -> assert false

+

+let code_space =

+  match Config.system with

+  | "elf" | "bsd" -> "	.section \".text\"\n"

+  | "rhapsody"    -> "	.text\n"

+  | _ -> assert false

+

+let rodata_space =

+  match Config.system with

+  | "elf" | "bsd" -> "	.section \".rodata\"\n"

+  | "rhapsody"    -> "	.const\n"

+  | _ -> assert false

+

+(* Output a pseudo-register *)

+

+let emit_reg r =

+  match r.loc with

+    Reg r -> emit_string (register_name r)

+  | _ -> fatal_error "Emit.emit_reg"

+

+let use_full_regnames = 

+  Config.system = "rhapsody"

+

+let emit_gpr r =

+  if use_full_regnames then emit_char 'r';

+  emit_int r

+

+let emit_fpr r =

+  if use_full_regnames then emit_char 'f';

+  emit_int r

+

+let emit_ccr r =

+  if use_full_regnames then emit_string "cr";

+  emit_int r

+

+(* Output a stack reference *)

+

+let emit_stack r =

+  match r.loc with

+    Stack s ->

+      let lbl, ofs = slot_offset s (register_class r) in

+        if lbl > 0 then

+	  `{emit_label lbl}+`;

+	`{emit_int ofs}({emit_gpr 1})`

+  | _ -> fatal_error "Emit.emit_stack"

+

+(* Split a 32-bit integer constants in two 16-bit halves *)

+

+let low n = n land 0xFFFF

+let high n = n asr 16

+

+let nativelow n = Nativeint.to_int n land 0xFFFF

+let nativehigh n = Nativeint.to_int (Nativeint.shift_right n 16)

+

+let is_immediate n =

+  n <= 32767 && n >= -32768

+

+let is_native_immediate n =

+  n <= 32767n && n >= -32768n

+

+

+type tocentry =

+    TocSymOfs of (string * int)

+  | TocLabel of int

+  | TocInt of nativeint

+  | TocFloat of string

+

+(* List of all labels in tocref (reverse order) *)

+let tocref_entries = ref []

+

+(* Output a TOC reference *)

+

+let emit_symbol_offset (s, d) =

+  emit_symbol s;

+  if d > 0 then `+`;

+  if d <> 0 then emit_int d

+

+let emit_tocentry entry = 

+  match entry with

+      TocSymOfs(s,d) -> emit_symbol_offset(s,d)

+    | TocInt i -> emit_nativeint i

+    | TocFloat f -> emit_string f

+    | TocLabel lbl -> emit_label lbl

+

+ let rec tocref_label = function

+    ( [] , content ) ->

+      let lbl = new_label() in

+       tocref_entries := (lbl, content) :: !tocref_entries;

+       lbl

+    | ( (lbl, o_content) :: lst, content) ->

+      if content = o_content then

+         lbl

+      else

+         tocref_label (lst,  content)

+

+let emit_tocref entry = 

+    let lbl = tocref_label (!tocref_entries,entry) in

+      emit_label lbl; emit_string "@toc(2) #"; emit_tocentry entry

+

+

+(* Output a load or store operation *)

+

+let valid_offset instr ofs =

+  ofs land 3 = 0 || (instr <> "ld" && instr <> "std")

+

+let emit_load_store instr addressing_mode addr n arg =

+  match addressing_mode with

+    Ibased(s, d) ->

+      let dd = (d + 0x8000) in (* We can only offset by -0x8000 .. +0x7fff *)

+      let a = (dd land -0x10000) in

+      let b = (dd land 0xffff) - 0x8000 in

+        `	ld	{emit_gpr 11}, {emit_tocref (TocSymOfs (s,a))}\n`;

+        `	{emit_string instr}	{emit_reg arg}, {emit_int b}({emit_gpr 11})\n`

+  | Iindexed ofs ->

+      if is_immediate ofs && valid_offset instr ofs then

+        `	{emit_string instr}	{emit_reg arg}, {emit_int ofs}({emit_reg addr.(n)})\n`

+      else begin

+        `	lis	{emit_gpr 0}, {emit_int(high ofs)}\n`;

+        if low ofs <> 0 then

+          `	ori	{emit_gpr 0}, {emit_gpr 0}, {emit_int(low ofs)}\n`;

+        `	{emit_string instr}x	{emit_reg arg}, {emit_reg addr.(n)}, {emit_gpr 0}\n`

+      end

+  | Iindexed2 ->

+      `	{emit_string instr}x	{emit_reg arg}, {emit_reg addr.(n)}, {emit_reg addr.(n+1)}\n`

+

+(* After a comparison, extract the result as 0 or 1 *)

+

+let emit_set_comp cmp res =

+  `	mfcr	{emit_gpr 0}\n`;

+  let bitnum =

+    match cmp with

+      Ceq | Cne -> 2

+    | Cgt | Cle -> 1

+    | Clt | Cge -> 0 in

+`	rlwinm	{emit_reg res}, {emit_gpr 0}, {emit_int(bitnum+1)}, 31, 31\n`;

+  begin match cmp with

+    Cne | Cle | Cge -> `	xori	{emit_reg res}, {emit_reg res}, 1\n`

+  | _ -> ()

+  end

+

+(* Record live pointers at call points *)

+

+type frame_descr =

+  { fd_lbl: int;                        (* Return address *)

+    fd_frame_size_lbl: int;                 (* Size of stack frame *)

+    fd_live_offset: (int * int) list }          (* Offsets/regs of live addresses *)

+

+let frame_descriptors = ref([] : frame_descr list)

+

+let record_frame live =

+  let lbl = new_label() in

+  let live_offset = ref [] in

+  Reg.Set.iter

+    (function

+        {typ = Addr; loc = Reg r} ->

+          live_offset := (0, (r lsl 1) + 1) :: !live_offset

+      | {typ = Addr; loc = Stack s} as reg ->

+          live_offset := slot_offset s (register_class reg) :: !live_offset

+      | _ -> ())

+    live;

+  frame_descriptors :=

+    { fd_lbl = lbl;

+      fd_frame_size_lbl = !stack_size_lbl; (* frame_size *)

+      fd_live_offset = !live_offset } :: !frame_descriptors;

+  `{emit_label lbl}:\n`

+

+let emit_frame fd =

+  `	.quad	{emit_label fd.fd_lbl} + 4\n`;

+  `	.short	{emit_label fd.fd_frame_size_lbl}\n`;

+  `	.short	{emit_int (List.length fd.fd_live_offset)}\n`;

+  List.iter

+    (fun (lbl,n) ->

+      `	.short	`;

+      if lbl > 0 then `{emit_label lbl}+`;

+      `{emit_int n}\n`)

+    fd.fd_live_offset;

+  `	.align	3\n`

+

+(* Record external C functions to be called in a position-independent way

+   (for MacOSX) *)

+

+let pic_externals = (Config.system = "rhapsody")

+

+let external_functions = ref StringSet.empty

+

+let emit_external s =

+  `	.non_lazy_symbol_pointer\n`;

+  `L{emit_symbol s}$non_lazy_ptr:\n`;

+  `	.indirect_symbol {emit_symbol s}\n`;

+  `	.quad	0\n`

+

+(* Names for conditional branches after comparisons *)

+

+let branch_for_comparison = function

+    Ceq -> "beq" | Cne -> "bne"

+  | Cle -> "ble" | Cgt -> "bgt"

+  | Cge -> "bge" | Clt -> "blt"

+

+let name_for_int_comparison = function

+    Isigned cmp -> ("cmpd", branch_for_comparison cmp)

+  | Iunsigned cmp -> ("cmpld", branch_for_comparison cmp)

+

+(* Names for various instructions *)

+

+let name_for_intop = function

+    Iadd -> "add"

+  | Imul -> "mulld"

+  | Idiv -> "divd"

+  | Iand -> "and"

+  | Ior  -> "or"

+  | Ixor -> "xor"

+  | Ilsl -> "sld"

+  | Ilsr -> "srd"

+  | Iasr -> "srad"

+  | _ -> Misc.fatal_error "Emit.Intop"

+

+let name_for_intop_imm = function

+    Iadd -> "addi"

+  | Imul -> "mulli"

+  | Iand -> "andi."

+  | Ior  -> "ori"

+  | Ixor -> "xori"

+  | Ilsl -> "sldi"

+  | Ilsr -> "srdi"

+  | Iasr -> "sradi"

+  | _ -> Misc.fatal_error "Emit.Intop_imm"

+

+let name_for_floatop1 = function

+    Inegf -> "fneg"

+  | Iabsf -> "fabs"

+  | _ -> Misc.fatal_error "Emit.Iopf1"

+

+let name_for_floatop2 = function

+    Iaddf -> "fadd"

+  | Isubf -> "fsub"

+  | Imulf -> "fmul"

+  | Idivf -> "fdiv"

+  | _ -> Misc.fatal_error "Emit.Iopf2"

+

+let name_for_specific = function

+    Imultaddf -> "fmadd"

+  | Imultsubf -> "fmsub"

+  | _ -> Misc.fatal_error "Emit.Ispecific"

+

+(* Name of current function *)

+let function_name = ref ""

+(* Entry point for tail recursive calls *)

+let tailrec_entry_point = ref 0

+(* Names of functions defined in the current file *)

+let defined_functions = ref StringSet.empty

+(* Label of glue code for calling the GC *)

+let call_gc_label = ref 0

+(* Label of jump table *)

+let lbl_jumptbl = ref 0

+(* List of all labels in jumptable (reverse order) *)

+let jumptbl_entries = ref []

+(* Number of jumptable entries *)

+let num_jumptbl_entries = ref 0

+

+(* Fixup conditional branches that exceed hardware allowed range *)

+

+let load_store_size = function

+    Ibased(s, d) -> 2

+  | Iindexed ofs -> if is_immediate ofs then 1 else 3

+  | Iindexed2 -> 1

+

+let instr_size = function

+    Lend -> 0

+  | Lop(Imove | Ispill | Ireload) -> 1

+  | Lop(Iconst_int n) -> if is_native_immediate n then 1 else 2

+  | Lop(Iconst_float s) -> 2

+  | Lop(Iconst_symbol s) -> 2

+  | Lop(Icall_ind) -> 6

+  | Lop(Icall_imm s) -> 7

+  | Lop(Itailcall_ind) -> if !contains_calls then 7 else if has_stack_frame() then 5 else 4

+  | Lop(Itailcall_imm s) -> if s = !function_name then 1 else 

+                            if !contains_calls then 8 else

+			    if has_stack_frame() then 6 else 5

+  | Lop(Iextcall(s, true)) -> 8

+  | Lop(Iextcall(s, false)) -> 7

+  | Lop(Istackoffset n) -> 0

+  | Lop(Iload(chunk, addr)) ->

+      if chunk = Byte_signed

+      then load_store_size addr + 1

+      else load_store_size addr

+  | Lop(Istore(chunk, addr)) -> load_store_size addr

+  | Lop(Ialloc n) -> 4

+  | Lop(Ispecific(Ialloc_far n)) -> 5

+  | Lop(Iintop Imod) -> 3

+  | Lop(Iintop(Icomp cmp)) -> 4

+  | Lop(Iintop op) -> 1

+  | Lop(Iintop_imm(Idiv, n)) -> 2

+  | Lop(Iintop_imm(Imod, n)) -> 4

+  | Lop(Iintop_imm(Icomp cmp, n)) -> 4

+  | Lop(Iintop_imm(op, n)) -> 1

+  | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1

+  | Lop(Ifloatofint) -> 3

+  | Lop(Iintoffloat) -> 3

+  | Lop(Ispecific sop) -> 1

+  | Lreloadretaddr -> 2

+  | Lreturn -> if has_stack_frame() then 2 else 1

+  | Llabel lbl -> 0

+  | Lbranch lbl -> 1

+  | Lcondbranch(tst, lbl) -> 2

+  | Lcondbranch3(lbl0, lbl1, lbl2) ->

+      1 + (if lbl0 = None then 0 else 1)

+        + (if lbl1 = None then 0 else 1)

+        + (if lbl2 = None then 0 else 1)

+  | Lswitch jumptbl -> 7

+  | Lsetuptrap lbl -> 1

+  | Lpushtrap -> 7

+  | Lpoptrap -> 1

+  | Lraise -> 6

+

+let label_map code =

+  let map = Hashtbl.create 37 in

+  let rec fill_map pc instr =

+    match instr.desc with

+      Lend -> (pc, map)

+    | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next

+    | op -> fill_map (pc + instr_size op) instr.next

+  in fill_map 0 code

+

+let max_branch_offset = 8180

+(* 14-bit signed offset in words.  Remember to cut some slack

+   for multi-word instructions where the branch can be anywhere in

+   the middle.  12 words of slack is plenty. *)

+

+let branch_overflows map pc_branch lbl_dest =

+  let pc_dest = Hashtbl.find map lbl_dest in

+  let delta = pc_dest - (pc_branch + 1) in

+  delta <= -max_branch_offset || delta >= max_branch_offset

+

+let opt_branch_overflows map pc_branch opt_lbl_dest =

+  match opt_lbl_dest with

+    None -> false

+  | Some lbl_dest -> branch_overflows map pc_branch lbl_dest

+

+let fixup_branches codesize map code =

+  let expand_optbranch lbl n arg next =

+    match lbl with

+      None -> next

+    | Some l ->