ocaml/0007-ppc64-Update-for-OCaml-4.02.0.patch

From 834644b81c536fc81022a0a13f860fb33e3d78d2 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
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.1.0