From 755d197c3eca97f8b690d49917a42ef4c7287ce2 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/16] 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.3.1