Remove Cmm.memory_chunk.Double_u (ocaml#10433)

All current targets treat Double_u (4-aligned 64-bit float) the same as Double (8-aligned 64-bit float). It used to make a difference on 32-bit platforms with strict alignment constraints for 64-bit floats, but we no longer support these. Keep only Double with the "4-aligned 64-bit float" semantics. (cherry picked from commit d967318)
edwintorok · Jun 26, 2021 · 32545b2 · 32545b2
1 parent 4fdc656
commit 32545b2
Show file tree

Hide file tree

Showing 19 changed files with 46 additions and 45 deletions.
diff --git a/Changes b/Changes
@@ -1,6 +1,12 @@
 OCaml 4.12, maintenance version
 -------------------------------
 
+- #10433: Remove the distinction between 32-bit aligned and 64-bit aligned
+  64-bit floats in Cmm.memory_chunk.
+  (Greta Yorsh, review by Xavier Leroy)
+
+### Build system:
+
 ### Bug fixes:
 
 - #10107: Ensure modules compiled with -afl-instrument can still link on

diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
@@ -565,7 +565,7 @@ let emit_instr env fallthrough i =
           I.movsxd (addressing addr DWORD i 0) dest
       | Single ->
           I.cvtss2sd (addressing addr REAL4 i 0) dest
-      | Double | Double_u ->
+      | Double ->
           I.movsd (addressing addr REAL8 i 0) dest
       end
   | Lop(Istore(chunk, addr, _)) ->
@@ -581,7 +581,7 @@ let emit_instr env fallthrough i =
       | Single ->
           I.cvtsd2ss (arg i 0) xmm15;
           I.movss xmm15 (addressing addr REAL4 i 1)
-      | Double | Double_u ->
+      | Double ->
           I.movsd (arg i 0) (addressing addr REAL8 i 1)
       end
   | Lop(Ialloc { bytes = n; dbginfo }) ->

diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml
@@ -203,7 +203,7 @@ method! select_operation op args dbg =
       self#select_floatarith false Idivf Ifloatdiv args
   | Cextcall("sqrt", _, _, false) ->
      begin match args with
-       [Cop(Cload ((Double|Double_u as chunk), _), [loc], _dbg)] ->
+       [Cop(Cload ((Double as chunk), _), [loc], _dbg)] ->
          let (addr, arg) = self#select_addressing chunk loc in
          (Ispecific(Ifloatsqrtf addr), [arg])
      | [arg] ->
@@ -251,11 +251,11 @@ method! select_operation op args dbg =
 
 method select_floatarith commutative regular_op mem_op args =
   match args with
-    [arg1; Cop(Cload ((Double|Double_u as chunk), _), [loc2], _)] ->
+    [arg1; Cop(Cload ((Double as chunk), _), [loc2], _)] ->
       let (addr, arg2) = self#select_addressing chunk loc2 in
       (Ispecific(Ifloatarithmem(mem_op, addr)),
                  [arg1; arg2])
-  | [Cop(Cload ((Double|Double_u as chunk), _), [loc1], _); arg2]
+  | [Cop(Cload ((Double as chunk), _), [loc1], _); arg2]
         when commutative ->
       let (addr, arg1) = self#select_addressing chunk loc1 in
       (Ispecific(Ifloatarithmem(mem_op, addr)),

diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
@@ -528,7 +528,7 @@ let emit_instr env i =
     | Lop(Iload(Single, addr, _mut)) when !fpu >= VFPv2 ->
         `	flds	s14, {emit_addressing addr i.arg 0}\n`;
         `	fcvtds	{emit_reg i.res.(0)}, s14\n`; 2
-    | Lop(Iload((Double | Double_u), addr, _mut)) when !fpu = Soft ->
+    | Lop(Iload(Double, addr, _mut)) when !fpu = Soft ->
         (* Use LDM or LDRD if possible *)
         begin match i.res.(0), i.res.(1), addr with
           {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
@@ -555,14 +555,13 @@ let emit_instr env i =
           | Byte_signed -> "ldrsb"
           | Sixteen_unsigned -> "ldrh"
           | Sixteen_signed -> "ldrsh"
-          | Double
-          | Double_u -> "fldd"
+          | Double -> "fldd"
           | _ (* 32-bit quantities *) -> "ldr" in
         `	{emit_string instr}	{emit_reg r}, {emit_addressing addr i.arg 0}\n`; 1
     | Lop(Istore(Single, addr, _)) when !fpu >= VFPv2 ->
         `	fcvtsd	s14, {emit_reg i.arg.(0)}\n`;
         `	fsts	s14, {emit_addressing addr i.arg 1}\n`; 2
-    | Lop(Istore((Double | Double_u), addr, _)) when !fpu = Soft ->
+    | Lop(Istore(Double, addr, _)) when !fpu = Soft ->
         (* Use STM or STRD if possible *)
         begin match i.arg.(0), i.arg.(1), addr with
           {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
@@ -584,8 +583,7 @@ let emit_instr env i =
           | Byte_signed -> "strb"
           | Sixteen_unsigned
           | Sixteen_signed -> "strh"
-          | Double
-          | Double_u -> "fstd"
+          | Double -> "fstd"
           | _ (* 32-bit quantities *) -> "str" in
         `	{emit_string instr}	{emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
     | Lop(Ialloc { bytes = n; dbginfo }) ->

diff --git a/asmcomp/arm/selection.ml b/asmcomp/arm/selection.ml
@@ -24,7 +24,7 @@ open Mach
 let is_offset chunk n =
   match chunk with
   (* VFPv{2,3} load/store have -1020 to 1020.  Offset must be multiple of 4 *)
-  | Single | Double | Double_u
+  | Single | Double
     when !fpu >= VFPv2 ->
       n >= -1020 && n <= 1020 && n mod 4 = 0
   (* ARM load/store byte/word have -4095 to 4095 *)

diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
@@ -706,7 +706,7 @@ let emit_instr env i =
         | Single ->
             `	ldr	s7, {emit_addressing addr base}\n`;
             `	fcvt	{emit_reg dst}, s7\n`
-        | Word_int | Word_val | Double | Double_u ->
+        | Word_int | Word_val | Double ->
             `	ldr	{emit_reg dst}, {emit_addressing addr base}\n`
         end
     | Lop(Istore(size, addr, _)) ->
@@ -728,7 +728,7 @@ let emit_instr env i =
         | Single ->
             `	fcvt	s7, {emit_reg src}\n`;
             `	str	s7, {emit_addressing addr base}\n`;
-        | Word_int | Word_val | Double | Double_u ->
+        | Word_int | Word_val | Double ->
             `	str	{emit_reg src}, {emit_addressing addr base}\n`
         end
     | Lop(Ialloc { bytes = n; dbginfo }) ->

diff --git a/asmcomp/arm64/selection.ml b/asmcomp/arm64/selection.ml
@@ -31,7 +31,7 @@ let is_offset chunk n =
         n land 1 = 0 && n lsr 1 < 0x1000
     | Thirtytwo_unsigned | Thirtytwo_signed | Single ->
         n land 3 = 0 && n lsr 2 < 0x1000
-    | Word_int | Word_val | Double | Double_u ->
+    | Word_int | Word_val | Double ->
         n land 7 = 0 && n lsr 3 < 0x1000)
 
 let is_logical_immediate n =

diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml
@@ -146,7 +146,6 @@ type memory_chunk =
   | Word_val
   | Single
   | Double
-  | Double_u
 
 and operation =
     Capply of machtype

diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli
@@ -135,8 +135,8 @@ type memory_chunk =
   | Word_int                           (* integer or pointer outside heap *)
   | Word_val                           (* pointer inside heap or encoded int *)
   | Single
-  | Double                             (* 64-bit-aligned 64-bit float *)
-  | Double_u                           (* word-aligned 64-bit float *)
+  | Double                             (* word-aligned 64-bit float
+                                          see PR#10433 *)
 
 and operation =
     Capply of machtype

diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml
@@ -569,18 +569,18 @@ let unbox_float dbg =
           | Some (Uconst_float x) ->
               Cconst_float (x, dbg) (* or keep _dbg? *)
           | _ ->
-              Cop(Cload (Double_u, Immutable), [cmm], dbg)
+              Cop(Cload (Double, Immutable), [cmm], dbg)
           end
-      | cmm -> Cop(Cload (Double_u, Immutable), [cmm], dbg)
+      | cmm -> Cop(Cload (Double, Immutable), [cmm], dbg)
     )
 
 (* Complex *)
 
 let box_complex dbg c_re c_im =
   Cop(Calloc, [alloc_floatarray_header 2 dbg; c_re; c_im], dbg)
 
-let complex_re c dbg = Cop(Cload (Double_u, Immutable), [c], dbg)
-let complex_im c dbg = Cop(Cload (Double_u, Immutable),
+let complex_re c dbg = Cop(Cload (Double, Immutable), [c], dbg)
+let complex_im c dbg = Cop(Cload (Double, Immutable),
                         [Cop(Cadda, [c; Cconst_int (size_float, dbg)], dbg)],
                         dbg)
 
@@ -728,7 +728,7 @@ let int_array_ref arr ofs dbg =
   Cop(Cload (Word_int, Mutable),
     [array_indexing log2_size_addr arr ofs dbg], dbg)
 let unboxed_float_array_ref arr ofs dbg =
-  Cop(Cload (Double_u, Mutable),
+  Cop(Cload (Double, Mutable),
     [array_indexing log2_size_float arr ofs dbg], dbg)
 let float_array_ref arr ofs dbg =
   box_float dbg (unboxed_float_array_ref arr ofs dbg)
@@ -743,7 +743,7 @@ let int_array_set arr ofs newval dbg =
   Cop(Cstore (Word_int, Lambda.Assignment),
     [array_indexing log2_size_addr arr ofs dbg; newval], dbg)
 let float_array_set arr ofs newval dbg =
-  Cop(Cstore (Double_u, Lambda.Assignment),
+  Cop(Cstore (Double, Lambda.Assignment),
     [array_indexing log2_size_float arr ofs dbg; newval], dbg)
 
 (* String length *)
@@ -2096,7 +2096,7 @@ let generic_functions shared units =
 type unary_primitive = expression -> Debuginfo.t -> expression
 
 let floatfield n ptr dbg =
-  Cop(Cload (Double_u, Mutable),
+  Cop(Cload (Double, Mutable),
       [if n = 0 then ptr
        else Cop(Cadda, [ptr; Cconst_int(n * size_float, dbg)], dbg)],
       dbg)
@@ -2200,7 +2200,7 @@ let setfield n ptr init arg1 arg2 dbg =
 
 let setfloatfield n init arg1 arg2 dbg =
   return_unit dbg (
-    Cop(Cstore (Double_u, init),
+    Cop(Cstore (Double, init),
         [if n = 0 then arg1
          else Cop(Cadda, [arg1; Cconst_int(n * size_float, dbg)], dbg);
          arg2], dbg))

diff --git a/asmcomp/i386/CSE.ml b/asmcomp/i386/CSE.ml
@@ -29,7 +29,7 @@ method! class_of_operation op =
   (* Operations that affect the floating-point stack cannot be factored *)
   | Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
   | Iintoffloat | Ifloatofint
-  | Iload((Single | Double | Double_u), _, _) -> Op_other
+  | Iload((Single | Double), _, _) -> Op_other
   (* Specific ops *)
   | Ispecific(Ilea _) -> Op_pure
   | Ispecific(Istore_int(_, _, is_asg)) -> Op_store is_asg

diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
@@ -555,7 +555,7 @@ let emit_instr env fallthrough i =
           I.movsx (addressing addr WORD i 0) (reg dest)
       | Single ->
           I.fld (addressing addr REAL4 i 0)
-      | Double | Double_u ->
+      | Double ->
           I.fld (addressing addr REAL8 i 0)
       end
   | Lop(Istore(chunk, addr, _)) ->
@@ -573,7 +573,7 @@ let emit_instr env fallthrough i =
             I.fld (reg i.arg.(0));
             I.fstp (addressing addr REAL4 i 1)
           end
-      | Double | Double_u ->
+      | Double ->
           if is_tos i.arg.(0) then
             I.fstp (addressing addr REAL8 i 1)
           else begin

diff --git a/asmcomp/i386/selection.ml b/asmcomp/i386/selection.ml
@@ -133,7 +133,7 @@ let pseudoregs_for_operation op arg res =
   (* For floating-point operations and floating-point loads,
      the result is always left at the top of the floating-point stack *)
   | Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
-  | Ifloatofint | Iload((Single | Double | Double_u), _, _)
+  | Ifloatofint | Iload((Single | Double ), _, _)
   | Ispecific(Isubfrev | Idivfrev | Ifloatarithmem _ | Ifloatspecial _) ->
       (arg, [| tos |], false)           (* don't move it immediately *)
   (* For storing a byte, the argument must be in eax...edx.
@@ -149,7 +149,6 @@ let pseudoregs_for_operation op arg res =
 let chunk_double = function
     Single -> false
   | Double -> true
-  | Double_u -> true
   | _ -> assert false
 
 (* The selector class *)
@@ -293,8 +292,8 @@ method select_push exp =
   | Cop(Cload ((Word_int | Word_val as chunk), _), [loc], _) ->
       let (addr, arg) = self#select_addressing chunk loc in
       (Ispecific(Ipush_load addr), arg)
-  | Cop(Cload (Double_u, _), [loc], _) ->
-      let (addr, arg) = self#select_addressing Double_u loc in
+  | Cop(Cload (Double, _), [loc], _) ->
+      let (addr, arg) = self#select_addressing Double loc in
       (Ispecific(Ipush_load_float addr), arg)
   | _ -> (Ispecific(Ipush), exp)
 

diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
@@ -739,7 +739,7 @@ let emit_instr env i =
           | Thirtytwo_signed -> if ppc64 then "lwa" else "lwz"
 	  | Word_int | Word_val -> lg
           | Single -> "lfs"
-          | Double | Double_u -> "lfd" in
+          | Double -> "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`
@@ -751,7 +751,7 @@ let emit_instr env i =
 	  | Thirtytwo_unsigned | Thirtytwo_signed -> "stw"
 	  | Word_int | Word_val -> stg
           | Single -> "stfs"
-          | Double | Double_u -> "stfd" in
+          | Double -> "stfd" in
         emit_load_store storeinstr addr i.arg 1 i.arg.(0)
     | Lop(Ialloc { bytes; dbginfo }) ->
         emit_alloc env i bytes dbginfo false

diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml
@@ -85,7 +85,6 @@ let chunk = function
   | Word_val -> "val"
   | Single -> "float32"
   | Double -> "float64"
-  | Double_u -> "float64u"
 
 let phantom_defining_expr ppf defining_expr =
   match defining_expr with

diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
@@ -316,7 +316,7 @@ let emit_instr env i =
         | Thirtytwo_signed -> "lw"
         | Word_int | Word_val -> "ld"
         | Single -> assert false
-        | Double | Double_u -> "fld"
+        | Double -> "fld"
       in
       `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`
   | Lop(Istore(Single, Iindexed ofs, _)) ->
@@ -331,7 +331,7 @@ let emit_instr env i =
         | Thirtytwo_unsigned | Thirtytwo_signed -> "sw"
         | Word_int | Word_val -> "sd"
         | Single -> assert false
-        | Double | Double_u -> "fsd"
+        | Double -> "fsd"
       in
       `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`
   | Lop(Ialloc {bytes; dbginfo}) ->

diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp
@@ -370,7 +370,7 @@ let emit_instr env i =
           | Thirtytwo_signed -> "lgf"
           | Word_int | Word_val -> "lg"
           | Single -> "ley"
-          | Double | Double_u -> "ldy" in
+          | Double -> "ldy" in
         emit_load_store loadinstr addr i.arg 0 i.res.(0);
         if chunk = Single then
           `	ldebr	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
@@ -386,7 +386,7 @@ let emit_instr env i =
           | Thirtytwo_unsigned | Thirtytwo_signed -> "sty"
           | Word_int | Word_val -> "stg"
           | Single -> assert false
-          | Double | Double_u -> "stdy" in
+          | Double -> "stdy" in
         emit_load_store storeinstr addr i.arg 1 i.arg.(0)
 
     | Lop(Ialloc { bytes = n; dbginfo }) ->

diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
@@ -70,7 +70,7 @@ let oper_result_type = function
   | Cload (c, _) ->
       begin match c with
       | Word_val -> typ_val
-      | Single | Double | Double_u -> typ_float
+      | Single | Double -> typ_float
       | _ -> typ_int
       end
   | Calloc -> typ_val
@@ -995,7 +995,7 @@ method emit_stores env data regs_addr =
             Istore(_, _, _) ->
               for i = 0 to Array.length regs - 1 do
                 let r = regs.(i) in
-                let kind = if r.typ = Float then Double_u else Word_val in
+                let kind = if r.typ = Float then Double else Word_val in
                 self#insert env
                             (Iop(Istore(kind, !a, false)))
                             (Array.append [|r|] regs_addr) [||];

diff --git a/testsuite/tools/parsecmm.mly b/testsuite/tools/parsecmm.mly
@@ -267,7 +267,7 @@ expr:
           Debuginfo.none) }
   | LPAREN FLOATAREF expr expr RPAREN
       { let open Asttypes in
-        Cop(Cload (Double_u, Mutable), [access_array $3 $4 Arch.size_float],
+        Cop(Cload (Double, Mutable), [access_array $3 $4 Arch.size_float],
           Debuginfo.none) }
   | LPAREN ADDRASET expr expr expr RPAREN
       { let open Lambda in
@@ -279,7 +279,7 @@ expr:
             [access_array $3 $4 Arch.size_int; $5], Debuginfo.none) }
   | LPAREN FLOATASET expr expr expr RPAREN
       { let open Lambda in
-        Cop(Cstore (Double_u, Assignment),
+        Cop(Cstore (Double, Assignment),
             [access_array $3 $4 Arch.size_float; $5], Debuginfo.none) }
 ;
 exprlist:
@@ -319,7 +319,7 @@ chunk:
   | ADDR                        { Word_val }
   | FLOAT32                     { Single }
   | FLOAT64                     { Double }
-  | FLOAT                       { Double_u }
+  | FLOAT                       { Double }
   | VAL                         { Word_val }
 ;
 unaryop: