===================================================================
@@ -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
===================================================================
@@ -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 --
--------------
===================================================================
@@ -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 --
----------------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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
===================================================================
@@ -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;
--------------------------------
===================================================================
@@ -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