[multiple changes]
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. From-SVN: r193224
This commit is contained in:
Arnaud Charlet
parent
a9b9fbf664
commit
436d9f924c
|
|
@ -1,3 +1,27 @@
|
|||
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.
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
--------------
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
--------------------------------
|
||||
|
|
|
|||
|
|
@ -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)));
|
||||
|
||||
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;
|
||||
Res := Uint_0;
|
||||
else
|
||||
-- Check for overflow
|
||||
|
||||
pragma Assert (Exponent < Uint_2 ** (Exponent_Size - 1));
|
||||
|
||||
-- MSB of the fraction must be 1
|
||||
|
||||
pragma Assert (Fraction / Uint_2 ** Fraction_Size = Uint_1);
|
||||
|
||||
-- Remove the redudant most significant fraction bit
|
||||
|
||||
Fraction := Fraction - Uint_2 ** Fraction_Size;
|
||||
|
||||
-- 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.
|
||||
|
||||
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;
|
||||
|
||||
-- The sign bit
|
||||
|
||||
if Negative then
|
||||
Res := Res + Int (2**15);
|
||||
end if;
|
||||
|
||||
Nod := Relocate_Node (N);
|
||||
-- The exponent
|
||||
|
||||
Set_Etype (Nod, RTE (RE_Source));
|
||||
Set_Analyzed (Nod, True);
|
||||
Res := Res + (Exponent + Uint_2 ** (Exponent_Size - 1))
|
||||
* Uint_2 ** (15 - Exponent_Size);
|
||||
|
||||
Nod :=
|
||||
Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (RTE (RE_Fncall), Loc),
|
||||
Parameter_Associations => New_List (Nod));
|
||||
-- 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.
|
||||
|
||||
Set_Etype (Nod, RTE (RE_Target));
|
||||
Set_Analyzed (Nod, True);
|
||||
|
||||
Nod :=
|
||||
Make_Unchecked_Type_Conversion (Loc,
|
||||
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
|
||||
Expression => Nod);
|
||||
|
||||
Set_Etype (Nod, Typ);
|
||||
Set_Analyzed (Nod, True);
|
||||
Rewrite (N, Nod);
|
||||
|
||||
-- This odd expression is still a static expression. Note that
|
||||
-- the routine Sem_Eval.Expr_Value_R understands this.
|
||||
|
||||
Set_Is_Static_Expression (N, Stat);
|
||||
if Res >= Uint_2 ** (Exponent_Size + Fraction_Size) then
|
||||
Res := Res - Uint_2 ** (Exponent_Size + Fraction_Size + 1);
|
||||
end if;
|
||||
end Expand_Vax_Real_Literal;
|
||||
end if;
|
||||
|
||||
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-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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue