Patchwork [Ada] Directly emit binary representation of Vax float

login
register
mail settings
Submitter Arnaud Charlet
Date Nov. 6, 2012, 10:11 a.m.
Message ID <20121106101128.GA16261@adacore.com>
Download mbox | patch
Permalink /patch/197439/
State New
Headers show

Comments

Arnaud Charlet - Nov. 6, 2012, 10:11 a.m.
Code generation for emitting a vax float is improved: instead of calling a
runtime routine, the binary representation is directly emitted.
No functionnal change (and also VMS specific).

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-11-06  Tristan Gingold  <gingold@adacore.com>

	* fe.h (Get_Vax_Real_Literal_As_Signed): Declare.
	* eval_fat.adb, eval_fat.ads (Decompose_Int): Move spec in package spec.
	* exp_vfpt.adb, exp_vfpt.ads (Vax_Real_Literal_As_Signed): New function.
	(Expand_Vax_Real_Literal): Remove.
	* exp_ch2.adb (Expand_N_Real_Literal): Do nothing.
	* sem_eval.adb (Expr_Value_R): Remove special Vax float case,
	as this is not anymore a special case.

Patch

Index: fe.h
===================================================================
--- fe.h	(revision 193215)
+++ fe.h	(working copy)
@@ -156,6 +156,11 @@ 
 
 extern Boolean Is_Fully_Repped_Tagged_Type      (Entity_Id);
 
+/* exp_vfpt: */
+
+#define Get_Vax_Real_Literal_As_Signed exp_vfpt__get_vax_real_literal_as_signed
+extern Ureal Get_Vax_Real_Literal_As_Signed (Node_Id);
+
 /* lib: */
 
 #define Cunit 				lib__cunit
Index: eval_fat.adb
===================================================================
--- eval_fat.adb	(revision 193222)
+++ eval_fat.adb	(working copy)
@@ -57,20 +57,6 @@ 
    --  parts. The fraction is in the interval 1.0 / Radix .. T'Pred (1.0) and
    --  uses Rbase = Radix. The result is rounded to a nearest machine number.
 
-   procedure Decompose_Int
-     (RT       : R;
-      X        : T;
-      Fraction : out UI;
-      Exponent : out UI;
-      Mode     : Rounding_Mode);
-   --  This is similar to Decompose, except that the Fraction value returned
-   --  is an integer representing the value Fraction * Scale, where Scale is
-   --  the value (Machine_Radix_Value (RT) ** Machine_Mantissa_Value (RT)). The
-   --  value is obtained by using biased rounding (halfway cases round away
-   --  from zero), round to even, a floor operation or a ceiling operation
-   --  depending on the setting of Mode (see corresponding descriptions in
-   --  Urealp).
-
    --------------
    -- Adjacent --
    --------------
Index: exp_vfpt.adb
===================================================================
--- exp_vfpt.adb	(revision 193223)
+++ exp_vfpt.adb	(working copy)
@@ -32,8 +32,8 @@ 
 with Sinfo;    use Sinfo;
 with Stand;    use Stand;
 with Tbuild;   use Tbuild;
-with Uintp;    use Uintp;
 with Urealp;   use Urealp;
+with Eval_Fat; use Eval_Fat;
 
 package body Exp_VFpt is
 
@@ -76,9 +76,13 @@ 
    --  +--------------------------------+
    --  |             fraction           |  A + 4
    --  +--------------------------------+
-   --  |             fraction           |  A + 6
+   --  |             fraction (low)     |  A + 6
    --  +--------------------------------+
 
+   --  Note that the fraction bits are not continuous in memory. Bytes in a
+   --  words are stored using little endianness, but words are stored using
+   --  big endianness (PDP endian)
+
    --  Like Float F but with 55 bits for the fraction.
 
    --  Float G:
@@ -93,10 +97,10 @@ 
    --  +--------------------------------+
    --  |             fraction           |  A + 4
    --  +--------------------------------+
-   --  |             fraction           |  A + 6
+   --  |             fraction (low)     |  A + 6
    --  +--------------------------------+
 
-   --  Exponent values of 1 through 2047 indicate trye binary exponents of
+   --  Exponent values of 1 through 2047 indicate true binary exponents of
    --  -1023 to +1023.
 
    --  Main differences compared to IEEE 754:
@@ -553,94 +557,102 @@ 
       Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
    end Expand_Vax_Foreign_Return;
 
-   -----------------------------
-   -- Expand_Vax_Real_Literal --
-   -----------------------------
+   --------------------------------
+   -- Vax_Real_Literal_As_Signed --
+   --------------------------------
 
-   procedure Expand_Vax_Real_Literal (N : Node_Id) is
-      Loc  : constant Source_Ptr := Sloc (N);
-      Typ  : constant Entity_Id  := Etype (N);
-      Btyp : constant Entity_Id  := Base_Type (Typ);
-      Stat : constant Boolean    := Is_Static_Expression (N);
-      Nod  : Node_Id;
+   function Get_Vax_Real_Literal_As_Signed (N : Node_Id) return Uint is
+      Btyp     : constant Entity_Id :=
+                   Base_Type (Underlying_Type (Etype (N)));
 
-      RE_Source : RE_Id;
-      RE_Target : RE_Id;
-      RE_Fncall : RE_Id;
-      --  Entities for source, target and function call in conversion
+      Value    : constant Ureal := Realval (N);
+      Negative : Boolean;
+      Fraction : UI;
+      Exponent : UI;
+      Res      : UI;
 
+      Exponent_Size : Uint;
+      --  Number of bits for the exponent
+
+      Fraction_Size : Uint;
+      --  Number of bits for the fraction
+
+      Uintp_Mark : constant Uintp.Save_Mark := Mark;
+      --  Use the mark & release feature to delete temporaries
    begin
-      --  We do not know how to convert Vax format real literals, so what
-      --  we do is to convert these to be IEEE literals, and introduce the
-      --  necessary conversion operation.
+      --  Extract the sign now
 
-      if Vax_Float (Btyp) then
-         --  What we want to construct here is
+      Negative := UR_Is_Negative (Value);
 
-         --    x!(y_to_z (1.0E0))
+      --  Decompose the number
 
-         --  where
+      Decompose_Int (Btyp, abs Value, Fraction, Exponent, Round_Even);
 
-         --    x is the base type of the literal (Btyp)
+      --  Number of bits for the fraction, leading fraction bit is implicit
 
-         --    y_to_z is
+      Fraction_Size := Machine_Mantissa_Value (Btyp) - Int'(1);
 
-         --      s_to_f for F_Float
-         --      t_to_g for G_Float
-         --      t_to_d for D_Float
+      --  Number of bits for the exponent (one bit for the sign)
 
-         --  The literal is typed as S (for F_Float) or T otherwise
+      Exponent_Size := RM_Size (Btyp) - Fraction_Size - Int'(1);
 
-         --  We do all our own construction, analysis, and expansion here,
-         --  since things are at too low a level to use Analyze or Expand
-         --  to get this built (we get circularities and other strange
-         --  problems if we try!)
+      if Fraction = Uint_0 then
+         --  Handle zero
 
-         if Digits_Value (Btyp) = VAXFF_Digits then
-            RE_Source := RE_S;
-            RE_Target := RE_F;
-            RE_Fncall := RE_S_To_F;
+         Res := Uint_0;
 
-         elsif Digits_Value (Btyp) = VAXDF_Digits then
-            RE_Source := RE_T;
-            RE_Target := RE_D;
-            RE_Fncall := RE_T_To_D;
+      elsif Exponent <= -(Uint_2 ** (Exponent_Size - 1)) then
+         --  Underflow
 
-         else pragma Assert (Digits_Value (Btyp) = VAXGF_Digits);
-            RE_Source := RE_T;
-            RE_Target := RE_G;
-            RE_Fncall := RE_T_To_G;
-         end if;
+         Res := Uint_0;
+      else
+         --  Check for overflow
 
-         Nod := Relocate_Node (N);
+         pragma Assert (Exponent < Uint_2 ** (Exponent_Size - 1));
 
-         Set_Etype (Nod, RTE (RE_Source));
-         Set_Analyzed (Nod, True);
+         --  MSB of the fraction must be 1
 
-         Nod :=
-           Make_Function_Call (Loc,
-             Name => New_Occurrence_Of (RTE (RE_Fncall), Loc),
-             Parameter_Associations => New_List (Nod));
+         pragma Assert (Fraction / Uint_2 ** Fraction_Size = Uint_1);
 
-         Set_Etype (Nod, RTE (RE_Target));
-         Set_Analyzed (Nod, True);
+         --  Remove the redudant most significant fraction bit
 
-         Nod :=
-           Make_Unchecked_Type_Conversion (Loc,
-             Subtype_Mark => New_Occurrence_Of (Typ, Loc),
-             Expression   => Nod);
+         Fraction := Fraction - Uint_2 ** Fraction_Size;
 
-         Set_Etype (Nod, Typ);
-         Set_Analyzed (Nod, True);
-         Rewrite (N, Nod);
+         --  Build the fraction part. Note that this field is in mixed
+         --  endianness: words are stored using little endianness, while bytes
+         --  in words are stored using big endianness.
 
-         --  This odd expression is still a static expression. Note that
-         --  the routine Sem_Eval.Expr_Value_R understands this.
+         Res := Uint_0;
+         for I in 1 .. UI_To_Int (RM_Size (Btyp)) / 16 loop
+            Res := (Res * (Uint_2 ** 16)) + (Fraction mod (Uint_2 ** 16));
+            Fraction := Fraction / (Uint_2 ** 16);
+         end loop;
 
-         Set_Is_Static_Expression (N, Stat);
+         --  The sign bit
+
+         if Negative then
+            Res := Res + Int (2**15);
+         end if;
+
+         --  The exponent
+
+         Res := Res + (Exponent + Uint_2 ** (Exponent_Size - 1))
+           * Uint_2 ** (15 - Exponent_Size);
+
+         --  Until now, we have created an unsigned number, but an underlying
+         --  type is a signed type. Convert to a signed number to avoid
+         --  overflow in gigi.
+
+         if Res >= Uint_2 ** (Exponent_Size + Fraction_Size) then
+            Res := Res - Uint_2 ** (Exponent_Size + Fraction_Size + 1);
+         end if;
       end if;
-   end Expand_Vax_Real_Literal;
 
+      Release_And_Save (Uintp_Mark, Res);
+
+      return Res;
+   end Get_Vax_Real_Literal_As_Signed;
+
    ----------------------
    -- Expand_Vax_Valid --
    ----------------------
Index: eval_fat.ads
===================================================================
--- eval_fat.ads	(revision 193215)
+++ eval_fat.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -99,4 +99,18 @@ 
       Mode  : Rounding_Mode;
       Enode : Node_Id) return T;
 
+   procedure Decompose_Int
+     (RT       : R;
+      X        : T;
+      Fraction : out UI;
+      Exponent : out UI;
+      Mode     : Rounding_Mode);
+   --  Decomposes a floating-point number into fraction and exponent parts.
+   --  The Fraction value returned is an integer representing the value
+   --  Fraction * Scale, where Scale is the value (Machine_Radix_Value (RT) **
+   --  Machine_Mantissa_Value (RT)). The value is obtained by using biased
+   --  rounding (halfway cases round away from zero), round to even, a floor
+   --  operation or a ceiling operation depending on the setting of Mode (see
+   --  corresponding descriptions in Urealp).
+
 end Eval_Fat;
Index: exp_vfpt.ads
===================================================================
--- exp_vfpt.ads	(revision 193215)
+++ exp_vfpt.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -28,6 +28,7 @@ 
 --  point formats as used on the Vax and the Alpha and the ia64.
 
 with Types; use Types;
+with Uintp; use Uintp;
 
 package Exp_VFpt is
 
@@ -51,10 +52,12 @@ 
    --  that moves the return value to an integer location on Alpha/VMS,
    --  noop everywhere else.
 
-   procedure Expand_Vax_Real_Literal (N : Node_Id);
-   --  The node N is a real literal node where the type is a Vax floating-point
-   --  type. This procedure rewrites the node to eliminate the occurrence of
-   --  such constants.
+   function Get_Vax_Real_Literal_As_Signed (N : Node_Id) return Uint;
+   --  Get the Vax binary representation of a real literal whose type is a Vax
+   --  floating-point type. This is used by gigi. Previously we expanded
+   --  real literal to a call to a LIB$OTS routine that performed the
+   --  conversion. This worked well, but was not efficient and generated huge
+   --  functions for aggregate initialization.
 
    procedure Expand_Vax_Valid (N : Node_Id);
    --  The node N is an attribute reference node for the Valid attribute where
Index: exp_ch2.adb
===================================================================
--- exp_ch2.adb	(revision 193215)
+++ exp_ch2.adb	(working copy)
@@ -32,7 +32,6 @@ 
 with Exp_Smem; use Exp_Smem;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
-with Exp_VFpt; use Exp_VFpt;
 with Namet;    use Namet;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
@@ -637,9 +636,8 @@ 
 
    procedure Expand_N_Real_Literal (N : Node_Id) is
    begin
-      if Vax_Float (Etype (N)) then
-         Expand_Vax_Real_Literal (N);
-      end if;
+      --  Vax real literal are now allowed by gigi
+      null;
    end Expand_N_Real_Literal;
 
    --------------------------------
Index: sem_eval.adb
===================================================================
--- sem_eval.adb	(revision 193216)
+++ sem_eval.adb	(working copy)
@@ -3862,7 +3862,6 @@ 
    function Expr_Value_R (N : Node_Id) return Ureal is
       Kind : constant Node_Kind := Nkind (N);
       Ent  : Entity_Id;
-      Expr : Node_Id;
 
    begin
       if Kind = N_Real_Literal then
@@ -3876,25 +3875,6 @@ 
       elsif Kind = N_Integer_Literal then
          return UR_From_Uint (Expr_Value (N));
 
-      --  Strange case of VAX literals, which are at this stage transformed
-      --  into Vax_Type!x_To_y(IEEE_Literal). See Expand_N_Real_Literal in
-      --  Exp_Vfpt for further details.
-
-      elsif Vax_Float (Etype (N))
-        and then Nkind (N) = N_Unchecked_Type_Conversion
-      then
-         Expr := Expression (N);
-
-         if Nkind (Expr) = N_Function_Call
-           and then Present (Parameter_Associations (Expr))
-         then
-            Expr := First (Parameter_Associations (Expr));
-
-            if Nkind (Expr) = N_Real_Literal then
-               return Realval (Expr);
-            end if;
-         end if;
-
       --  Peculiar VMS case, if we have xxx'Null_Parameter, return 0.0
 
       elsif Kind = N_Attribute_Reference