Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

PR#7024 and GPR#295: CSE confuses +0.0 and -0.0 

The fix consists in representing float literals by their bit patterns (int64) in the Mach and Linear intermediate languages.

A regression test was added to the test suite.
master
Xavier Leroy 2015-11-19 09:25:02 +01:00
parent c1e2080803
commit 6cd8656249
14 changed files with 59 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Changes
View File

@ -282,6 +282,8 @@ Bug fixes:
type compatibility (in a class type) (Jacques Garrigue)
- PR#7039: Unix.getsockname returns garbage for unnamed PF_UNIX sockets
(Xavier Leroy)
- PR#7042 and GPR#295: CSE optimization confuses the FP literals +0.0 and -0.0
(Xavier Leroy)
- GPR#205: Clear caml_backtrace_last_exn before registering as root
(report and fix by Frederic Bour)
- GPR#220: minor -dsource error on recursive modules

7
asmcomp/amd64/emit.mlp
View File

@ -421,12 +421,11 @@ let output_epilogue f =
let float_constants = ref ([] : (int64 * int) list)
let add_float_constant cst =
let repr = Int64.bits_of_float cst in
try
List.assoc repr !float_constants
List.assoc cst !float_constants
with Not_found ->
let lbl = new_label() in
float_constants := (repr, lbl) :: !float_constants;
float_constants := (cst, lbl) :: !float_constants;
lbl
let emit_float_constant f lbl =
@ -470,7 +469,7 @@ let emit_instr fallthrough i =
else
I.mov (nat n) (res i 0)
| Lop(Iconst_float f) ->
begin match Int64.bits_of_float f with
begin match f with
| 0x0000_0000_0000_0000L -> (* +0.0 *)
I.xorpd (res i 0) (res i 0)
| _ ->

12
asmcomp/arm/emit.mlp
View File

@ -285,13 +285,12 @@ let num_literals = ref 0
(* Label a floating-point literal *)
let float_literal f =
let repr = Int64.bits_of_float f in
try
List.assoc repr !float_literals
List.assoc f !float_literals
with Not_found ->
let lbl = new_label() in
num_literals := !num_literals + 2;
float_literals := (repr, lbl) :: !float_literals;
float_literals := (f, lbl) :: !float_literals;
lbl
(* Label a GOTREL literal *)
@ -393,9 +392,8 @@ let emit_instr i =
| Lop(Iconst_int n | Iconst_blockheader n) ->
emit_intconst i.res.(0) (Nativeint.to_int32 n)
| Lop(Iconst_float f) when !fpu = Soft ->
let bits = Int64.bits_of_float f in
let high_bits = Int64.to_int32 (Int64.shift_right_logical bits 32)
and low_bits = Int64.to_int32 bits in
let high_bits = Int64.to_int32 (Int64.shift_right_logical f 32)
and low_bits = Int64.to_int32 f in
if is_immediate low_bits || is_immediate high_bits then begin
let ninstr_low = emit_intconst i.res.(0) low_bits
and ninstr_high = emit_intconst i.res.(1) high_bits in
@ -427,7 +425,7 @@ let emit_instr i =
let ex = ((ex + 3) land 0x07) lxor 0x04 in
Some((sg lsl 7) lor (ex lsl 4) lor mn)
end in
begin match encode (Int64.bits_of_float f) with
begin match encode f with
None ->
let lbl = float_literal f in
` fldd {emit_reg i.res.(0)}, {emit_label lbl}\n`

9
asmcomp/arm64/emit.mlp
View File

@ -565,13 +565,12 @@ let emit_instr i =
| Lop(Iconst_int n | Iconst_blockheader n) ->
emit_intconst i.res.(0) n
| Lop(Iconst_float f) ->
let b = Int64.bits_of_float f in
if b = 0L then
if f = 0L then
` fmov {emit_reg i.res.(0)}, xzr\n`
else if is_immediate_float b then
` fmov {emit_reg i.res.(0)}, #{emit_printf "0x%Lx" b}\n`
else if is_immediate_float f then
` fmov {emit_reg i.res.(0)}, #{emit_printf "0x%Lx" f}\n`
else begin
let lbl = float_literal b in
let lbl = float_literal f in
` adrp {emit_reg reg_tmp1}, {emit_label lbl}\n`;
` ldr {emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
end

7
asmcomp/i386/emit.mlp
View File

@ -439,13 +439,12 @@ let emit_floatspecial = function
let float_constants = ref ([] : (int64 * int) list)
let add_float_constant cst =
let repr = Int64.bits_of_float cst in
try
List.assoc repr !float_constants
List.assoc cst !float_constants
with
Not_found ->
let lbl = new_label() in
float_constants := (repr, lbl) :: !float_constants;
float_constants := (cst, lbl) :: !float_constants;
lbl
let emit_float64_split_directive x =
@ -502,7 +501,7 @@ let emit_instr fallthrough i =
end else
I.mov (nat n) (reg i.res.(0))
| Lop(Iconst_float f) ->
begin match Int64.bits_of_float f with
begin match f with
| 0x0000_0000_0000_0000L -> (* +0.0 *)
I.fldz ()
| 0x8000_0000_0000_0000L -> (* -0.0 *)

2
asmcomp/mach.ml
View File

@ -36,7 +36,7 @@ type operation =
| Ispill
| Ireload
| Iconst_int of nativeint
| Iconst_float of float
| Iconst_float of int64
| Iconst_symbol of string
| Iconst_blockheader of nativeint
| Icall_ind

2
asmcomp/mach.mli
View File

@ -36,7 +36,7 @@ type operation =
| Ispill
| Ireload
| Iconst_int of nativeint
| Iconst_float of float
| Iconst_float of int64
| Iconst_symbol of string
| Iconst_blockheader of nativeint
| Icall_ind

4
asmcomp/power/emit.mlp
View File

@ -550,11 +550,11 @@ let emit_instr i =
begin match abi with
| ELF32 ->
let lbl = new_label() in
float_literals := (Int64.bits_of_float f, lbl) :: !float_literals;
float_literals := (f, lbl) :: !float_literals;
` addis 11, 0, {emit_upper emit_label lbl}\n`;
` lfd {emit_reg i.res.(0)}, {emit_lower emit_label lbl}(11)\n`
| ELF64v1 | ELF64v2 ->
let entry = TocFloat (Int64.bits_of_float f) in
let entry = TocFloat f in
let lbl = label_for_tocref entry in
if !big_toc || !Clflags.for_package <> None then begin
` addis 11, 2, {emit_label lbl}@toc@ha\n`;

2
asmcomp/printmach.ml
View File

@ -109,7 +109,7 @@ let operation op arg ppf res =
| Ireload -> fprintf ppf "%a (reload)" regs arg
| Iconst_int n
| Iconst_blockheader n -> fprintf ppf "%s" (Nativeint.to_string n)
| Iconst_float f -> fprintf ppf "%F" f
| Iconst_float f -> fprintf ppf "%F" (Int64.float_of_bits f)
| Iconst_symbol s -> fprintf ppf "\"%s\"" s
| Icall_ind -> fprintf ppf "call %a" regs arg
| Icall_imm lbl -> fprintf ppf "call \"%s\" %a" lbl regs arg

2
asmcomp/selectgen.ml
View File

@ -449,7 +449,7 @@ method emit_expr env exp =
Some(self#insert_op (Iconst_blockheader n) [||] r)
| Cconst_float n ->
let r = self#regs_for typ_float in
Some(self#insert_op (Iconst_float n) [||] r)
Some(self#insert_op (Iconst_float (Int64.bits_of_float n)) [||] r)
| Cconst_symbol n ->
let r = self#regs_for typ_val in
Some(self#insert_op (Iconst_symbol n) [||] r)

2
asmcomp/sparc/emit.mlp
View File

@ -323,7 +323,7 @@ let rec emit_instr i dslot =
(* On UltraSPARC, the fzero instruction could be used to set a
floating point register pair to zero. *)
let lbl = new_label() in
float_constants := (lbl, Int64.bits_of_float f) :: !float_constants;
float_constants := (lbl, f) :: !float_constants;
` sethi %hi({emit_label lbl}), %g1\n`;
` ldd [%g1 + %lo({emit_label lbl})], {emit_reg i.res.(0)}\n`
| Lop(Iconst_symbol s) ->

17
testsuite/tests/regression/pr7042/Makefile Normal file
View File

@ -0,0 +1,17 @@
#########################################################################
# #
# OCaml #
# #
# Damien Doligez, projet Gallium, INRIA Rocquencourt #
# #
# Copyright 2013 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. #
# #
#########################################################################
MAIN_MODULE=pr7042
BASEDIR=../../..
include $(BASEDIR)/makefiles/Makefile.one
include $(BASEDIR)/makefiles/Makefile.common

17
testsuite/tests/regression/pr7042/pr7042.ml Normal file
View File

@ -0,0 +1,17 @@
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Gallium, INRIA Paris-Rocquencourt *)
(* *)
(* Copyright 2015 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. *)
(* *)
(***********************************************************************)
let _ =
let a = [| 0.0; -. 0.0 |] in
Printf.printf "%Lx %Lx\n"
(Int64.bits_of_float a.(0)) (Int64.bits_of_float a.(1))

1
testsuite/tests/regression/pr7042/pr7042.reference Normal file
View File

@ -0,0 +1 @@
0 8000000000000000