From 436d9f924cf07f4901d701999f4f19138bd5e917 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 6 Nov 2012 11:11:20 +0100 Subject: [PATCH] [multiple changes] 2012-11-06 Tristan Gingold * 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 * uintp.ads: Minor correction of typo in comment. 2012-11-06 Ed Schonberg * sem_prag.adb (Analyze_Pragnma, case Unchecked_Union): remove requirement that discriminants of an unchecked_union must have defaults. 2012-11-06 Vasiliy Fofanov * projects.texi: Minor wordsmithing. From-SVN: r193224 --- gcc/ada/ChangeLog | 24 +++++++++ gcc/ada/eval_fat.adb | 14 ----- gcc/ada/eval_fat.ads | 16 +++++- gcc/ada/exp_ch2.adb | 6 +-- gcc/ada/exp_vfpt.adb | 146 +++++++++++++++++++++++++++----------------------- gcc/ada/exp_vfpt.ads | 13 +++-- gcc/ada/fe.h | 5 ++ gcc/ada/projects.texi | 10 ++-- gcc/ada/sem_eval.adb | 20 ------- gcc/ada/sem_prag.adb | 14 +---- gcc/ada/uintp.ads | 2 +- 11 files changed, 141 insertions(+), 129 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9216213..a08aa14 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2012-11-06 Tristan Gingold + + * 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 + + * uintp.ads: Minor correction of typo in comment. + +2012-11-06 Ed Schonberg + + * sem_prag.adb (Analyze_Pragnma, case Unchecked_Union): remove + requirement that discriminants of an unchecked_union must have + defaults. + +2012-11-06 Vasiliy Fofanov + + * projects.texi: Minor wordsmithing. + 2012-11-06 Robert Dewar * sem_ch9.adb, exp_vfpt.adb, xoscons.adb: Minor reformatting. diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb index bbcb886..5ff748d 100644 --- a/gcc/ada/eval_fat.adb +++ b/gcc/ada/eval_fat.adb @@ -57,20 +57,6 @@ package body Eval_Fat is -- 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 -- -------------- diff --git a/gcc/ada/eval_fat.ads b/gcc/ada/eval_fat.ads index 964dd22..4ef153c 100644 --- a/gcc/ada/eval_fat.ads +++ b/gcc/ada/eval_fat.ads @@ -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 @@ package Eval_Fat is 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; diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index 37a5bda..bbd23ba 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -32,7 +32,6 @@ with Errout; use Errout; 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 @@ package body Exp_Ch2 is 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; -------------------------------- diff --git a/gcc/ada/exp_vfpt.adb b/gcc/ada/exp_vfpt.adb index 1539ea9..af4c3ef 100644 --- a/gcc/ada/exp_vfpt.adb +++ b/gcc/ada/exp_vfpt.adb @@ -32,8 +32,8 @@ with Sem_Res; use Sem_Res; 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 @@ 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: @@ -93,10 +97,10 @@ package body Exp_VFpt is -- +--------------------------------+ -- | 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,93 +557,101 @@ package body Exp_VFpt is 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 -- diff --git a/gcc/ada/exp_vfpt.ads b/gcc/ada/exp_vfpt.ads index fdca701..52aaf7d 100644 --- a/gcc/ada/exp_vfpt.ads +++ b/gcc/ada/exp_vfpt.ads @@ -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 @@ 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 diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 9f5d64f..f8d399c 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -156,6 +156,11 @@ extern void Get_External_Name_With_Suffix (Entity_Id, Fat_Pointer); 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 diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index ed42094..79ac662 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -1036,10 +1036,10 @@ names in lower case) @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}: @@ -1073,7 +1073,7 @@ installed. Default is @b{include}. @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 diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 4217463..3434854 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -3862,7 +3862,6 @@ package body Sem_Eval is 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 @@ package body Sem_Eval is 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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c3f27e1..f7f56f0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14495,7 +14495,6 @@ package body Sem_Prag is 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; @@ -14546,21 +14545,12 @@ package body Sem_Prag is -- 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); diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads index b730f44..dcf85a0 100644 --- a/gcc/ada/uintp.ads +++ b/gcc/ada/uintp.ads @@ -407,7 +407,7 @@ private 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. -- 2.7.4