+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.
+
+2012-11-06 Yannick Moy <moy@adacore.com>
+
+ * uintp.ads: Minor correction of typo in comment.
+
+2012-11-06 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragnma, case Unchecked_Union): remove
+ requirement that discriminants of an unchecked_union must have
+ defaults.
+
+2012-11-06 Vasiliy Fofanov <fofanov@adacore.com>
+
+ * projects.texi: Minor wordsmithing.
+
2012-11-06 Robert Dewar <dewar@adacore.com>
* sem_ch9.adb, exp_vfpt.adb, xoscons.adb: Minor reformatting.
-- 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 --
--------------
-- --
-- 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- --
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;
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;
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;
--------------------------------
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
-- +--------------------------------+
-- | 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:
-- +--------------------------------+
-- | 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:
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)));
+
+ Value : constant Ureal := Realval (N);
+ Negative : Boolean;
+ Fraction : UI;
+ Exponent : UI;
+ Res : UI;
+
+ Exponent_Size : Uint;
+ -- Number of bits for the exponent
- RE_Source : RE_Id;
- RE_Target : RE_Id;
- RE_Fncall : RE_Id;
- -- Entities for source, target and function call in conversion
+ 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 --
-- --
-- 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- --
-- 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
-- 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
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
@noindent
After building an application or a library it is often required to
-install it into the development environment. This installation is
-required if the library is to be used by another application for
-example. The @command{gprinstall} tool provide an easy way to install
-libraries, executable or object code generated durting the build. The
+install it into the development environment. For instance this step is
+required if the library is to be used by another application.
+The @command{gprinstall} tool provides an easy way to install
+libraries, executable or object code generated during the build. The
@b{Install} package can be used to change the default locations.
The following attributes can be defined in package @code{Install}:
@item @b{Project_Subdir}
-Subdirectory of @b{Prefix} where the installed project is to be
+Subdirectory of @b{Prefix} where the generated project file is to be
installed. Default is @b{share/gpr}.
@end table
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
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
Assoc : constant Node_Id := Arg1;
Type_Id : constant Node_Id := Get_Pragma_Arg (Assoc);
Typ : Entity_Id;
- Discr : Entity_Id;
Tdef : Node_Id;
Clist : Node_Id;
Vpart : Node_Id;
-- Note: in previous versions of GNAT we used to check for limited
-- types and give an error, but in fact the standard does allow
-- Unchecked_Union on limited types, so this check was removed.
+ -- Similarly, GNAT used to require that all discriminants have
+ -- default values, but this is not mandated by the RM.
-- Proceed with basic error checks completed
else
- Discr := First_Discriminant (Typ);
- while Present (Discr) loop
- if No (Discriminant_Default_Value (Discr)) then
- Error_Msg_N
- ("unchecked union discriminant must have default value",
- Discr);
- end if;
-
- Next_Discriminant (Discr);
- end loop;
-
Tdef := Type_Definition (Declaration_Node (Typ));
Clist := Component_List (Tdef);
Base : constant Int := 2 ** Base_Bits;
- -- Values in the range -(Base+1) .. Max_Direct are encoded directly as
+ -- Values in the range -(Base-1) .. Max_Direct are encoded directly as
-- Uint values by adding a bias value. The value of Max_Direct is chosen
-- so that a directly represented number always fits in two digits when
-- represented in base format.
projects / gcc.git / commitdiff