+2017-04-25 Eric Botcazou <ebotcazou@adacore.com>
+
+ * a-numaux.ads: Fix description of a-numaux-darwin
+ and a-numaux-x86.
+ (Double): Define to Long_Float.
+ * a-numaux-vxworks.ads (Double): Likewise.
+ * a-numaux-darwin.ads
+ (Double): Likewise.
+ * a-numaux-libc-x86.ads (Double): Define to Long_Long_Float.
+ * a-numaux-x86.ads: Fix package description.
+ * a-numaux-x86.adb (Is_Nan): Minor tweak.
+ (Reduce): Adjust and complete description. Call Is_Nan instead of
+ testing manually. Use an integer temporary to hold rounded value.
+ * a-numaux-darwin.adb (Reduce): Likewise.
+ (Is_Nan): New function.
+
+2017-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb (Analyze_Selected_Component): Additional refinement
+ on analysis of prefix whose type is a current instance of a
+ synchronized type, but where the prefix itself is an entity that
+ is an object.
+
+2017-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch5.adb (Replace_Target): When rewriting the RHS, preserve
+ the identity of callable entities therein, because they have been
+ properly resolved, and prefixed calls may have been rewritten
+ as normal calls.
+
+2017-04-25 Patrick Bernardi <bernardi@adacore.com>
+
+ * exp_ch3.adb (Build_Init_Statements): Convert
+ the expression of the pragma/aspect Secondary_Stack_Size to
+ internal type System.Parameters.Size_Type before assigning
+ it to the Secondary_Stack_Size component of the task type's
+ corresponding record.
+
+2017-04-25 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_eval.adb (Compile_Time_Compare): Reinstate the expr+literal
+ (etc) optimizations when the type is modular and the offsets
+ are equal.
+
+2017-04-25 Eric Botcazou <ebotcazou@adacore.com>
+
+ * s-osinte-freebsd.ads: Minor comment tweaks
+
+2017-04-25 Javier Miranda <miranda@adacore.com>
+
+ * urealp.adb (UR_Write): Reverse previous patch
+ adding documentation on why we generate multiplications instead
+ of divisions (needed to avoid expressions whose computation with
+ large numbers may cause division by 0).
+
+2017-04-25 Bob Duff <duff@adacore.com>
+
+ * erroutc.adb (Set_Specific_Warning_Off,
+ Set_Warnings_Mode_Off): Use the correct source file for
+ Stop. Was using Current_Source_File, which is only valid during
+ parsing. Current_Source_File will have a leftover value from
+ whatever file happened to be parsed last, because of a with_clause
+ or something.
+
+2017-04-25 Bob Duff <duff@adacore.com>
+
+ * lib.ads, lib.adb (In_Internal_Unit): New functions similar
+ to In_Predefined_Unit, but including GNAT units.
+ * sem_util.ads, sem_util.adb (Should_Ignore_Pragma): Replace
+ with Should_Ignore_Pragma_Par and Should_Ignore_Pragma_Sem,
+ because Should_Ignore_Pragma was not working reliably outside
+ the parser, because Current_Source_File is not valid.
+ * sem_prag.adb, exp_prag.adb: Call Should_Ignore_Pragma_Sem.
+ * par-prag.adb: Call Should_Ignore_Pragma_Par.
+
2017-04-25 Arnaud Charlet <charlet@adacore.com trojanek>
* gnat1drv.adb (Gnat1Drv): Disable Generate_Processed_File in
-- B o d y --
-- (Apple OS X Version) --
-- --
--- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2016, 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- --
-- Local subprograms --
-----------------------
+ function Is_Nan (X : Double) return Boolean;
+ -- Return True iff X is a IEEE NaN value
+
procedure Reduce (X : in out Double; Q : out Natural);
- -- Implements reduction of X by Pi/2. Q is the quadrant of the final
- -- result in the range 0 .. 3. The absolute value of X is at most Pi/4.
+ -- Implement reduction of X by Pi/2. Q is the quadrant of the final
+ -- result in the range 0..3. The absolute value of X is at most Pi/4.
+ -- It is needed to avoid a loss of accuracy for sin near Pi and cos
+ -- near Pi/2 due to the use of an insufficiently precise value of Pi
+ -- in the range reduction.
- -- The following three functions implement Chebishev approximations
+ -- The following two functions implement Chebishev approximations
-- of the trigonometric functions in their reduced domain.
-- These approximations have been computed using Maple.
pragma Inline (Sine_Approx);
pragma Inline (Cosine_Approx);
+ -------------------
+ -- Cosine_Approx --
+ -------------------
+
function Cosine_Approx (X : Double) return Double is
XX : constant Double := X * X;
begin
- 16#3.655E64869ECCE#E-14 + 1.0;
end Cosine_Approx;
+ -----------------
+ -- Sine_Approx --
+ -----------------
+
function Sine_Approx (X : Double) return Double is
XX : constant Double := X * X;
begin
- 16#2.AAAAAAAAAAA44#E-01) * (XX * X) + X;
end Sine_Approx;
+ ------------
+ -- Is_Nan --
+ ------------
+
+ function Is_Nan (X : Double) return Boolean is
+ begin
+ -- The IEEE NaN values are the only ones that do not equal themselves
+
+ return X /= X;
+ end Is_Nan;
+
------------
-- Reduce --
------------
- P4, HM);
P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5);
K : Double;
+ R : Integer;
begin
-- For X < 2.0**HM, all products below are computed exactly.
-- rounded result of X - K * (Pi / 2.0).
K := X * Two_Over_Pi;
- while abs K >= 2.0 ** HM loop
+ while abs K >= 2.0**HM loop
K := K * M - (K * M - K);
X :=
(((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6;
-- If K is not a number (because X was not finite) raise exception
- if K /= K then
+ if Is_Nan (K) then
raise Constraint_Error;
end if;
- K := Double'Rounding (K);
- Q := Integer (K) mod 4;
- X := (((((X - K * P1) - K * P2) - K * P3)
- - K * P4) - K * P5) - K * P6;
+ -- Go through an integer temporary so as to use machine instructions
+
+ R := Integer (Double'Rounding (K));
+ Q := R mod 4;
+ K := Double (R);
+ X := (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6;
end Reduce;
---------
-- S p e c --
-- (Apple OS X Version) --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
pragma Linker_Options ("-lm");
- type Double is digits 15;
+ type Double is new Long_Float;
-- Type Double is the type used to call the C routines
-- The following functions have been implemented in Ada, since
-- S p e c --
-- (C Library Version for x86) --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
pragma Linker_Options ("-lm");
- type Double is digits 18;
+ type Double is new Long_Long_Float;
-- We import these functions directly from C. Note that we label them
-- all as pure functions, because indeed all of them are in fact pure.
-- S p e c --
-- (C Library Version, VxWorks) --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
package Ada.Numerics.Aux is
pragma Pure;
- type Double is digits 15;
+ type Double is new Long_Float;
-- Type Double is the type used to call the C routines
-- We import these functions directly from C. Note that we label them
-- for values of Y in the open interval (-0.25, 0.25)
procedure Reduce (X : in out Double; Q : out Natural);
- -- Implements reduction of X by Pi/2. Q is the quadrant of the final
- -- result in the range 0 .. 3. The absolute value of X is at most Pi.
+ -- Implement reduction of X by Pi/2. Q is the quadrant of the final
+ -- result in the range 0..3. The absolute value of X is at most Pi/4.
+ -- It is needed to avoid a loss of accuracy for sin near Pi and cos
+ -- near Pi/2 due to the use of an insufficiently precise value of Pi
+ -- in the range reduction.
pragma Inline (Is_Nan);
pragma Inline (Reduce);
begin
-- The IEEE NaN values are the only ones that do not equal themselves
- return not (X = X);
+ return X /= X;
end Is_Nan;
---------
P5 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3
- P4, HM);
P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5);
- K : Double := X * Two_Over_Pi;
+ K : Double;
+ R : Integer;
+
begin
- -- For X < 2.0**32, all products below are computed exactly.
+ -- For X < 2.0**HM, all products below are computed exactly.
-- Due to cancellation effects all subtractions are exact as well.
-- As no double extended floating-point number has more than 75
-- zeros after the binary point, the result will be the correctly
-- rounded result of X - K * (Pi / 2.0).
+ K := X * Two_Over_Pi;
while abs K >= 2.0**HM loop
K := K * M - (K * M - K);
- X := (((((X - K * P1) - K * P2) - K * P3)
- - K * P4) - K * P5) - K * P6;
+ X :=
+ (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6;
K := X * Two_Over_Pi;
end loop;
- if K /= K then
-
- -- K is not a number, because X was not finite
+ -- If K is not a number (because X was not finite) raise exception
+ if Is_Nan (K) then
raise Constraint_Error;
end if;
- K := Double'Rounding (K);
- Q := Integer (K) mod 4;
- X := (((((X - K * P1) - K * P2) - K * P3)
- - K * P4) - K * P5) - K * P6;
+ -- Go through an integer temporary so as to use machine instructions
+
+ R := Integer (Double'Rounding (K));
+ Q := R mod 4;
+ K := Double (R);
+ X := (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6;
end Reduce;
----------
-- S p e c --
-- (Machine Version for x86) --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
-- --
------------------------------------------------------------------------------
--- Version for the x86, using 64-bit IEEE format with inline asm statements
+-- This version is for the x86 using the 80-bit x86 long double format with
+-- inline asm statements.
package Ada.Numerics.Aux is
pragma Pure;
-- S p e c --
-- (C Library Version, non-x86) --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
-- This version here is for use with normal Unix math functions. Alternative
-- versions are provided for special situations:
--- a-numaux-darwin For OS/X (special handling of sin/cos for accuracy)
+-- a-numaux-darwin For PowerPC/Darwin (special handling of sin/cos)
-- a-numaux-libc-x86 For the x86, using 80-bit long double format
--- a-numaux-x86 For the x86, using 64-bit IEEE (inline asm statements)
+-- a-numaux-x86 For the x86, using 80-bit long double format with
+-- inline asm statements
-- a-numaux-vxworks For use on VxWorks (where we have no libm.a library)
package Ada.Numerics.Aux is
pragma Linker_Options ("-lm");
- type Double is digits 15;
+ type Double is new Long_Float;
-- Type Double is the type used to call the C routines
-- We import these functions directly from C. Note that we label them
Specific_Warnings.Append
((Start => Loc,
Msg => new String'(Msg),
- Stop => Source_Last (Current_Source_File),
+ Stop => Source_Last (Get_Source_File_Index (Loc)),
Reason => Reason,
Open => True,
Used => Used,
Warnings.Append
((Start => Loc,
- Stop => Source_Last (Current_Source_File),
+ Stop => Source_Last (Get_Source_File_Index (Loc)),
Reason => Reason));
end Set_Warnings_Mode_Off;
-- Check whether all components of the aggregate are compile-time known
-- values, and can be passed as is to the back-end without further
-- expansion.
- -- An Iterated_component_Association is treated as non-static, but there
+ -- An Iterated_Component_Association is treated as non-static, but there
-- are possibilities for optimization here.
function Flatten
Exp :=
Unchecked_Convert_To
(RTE (RE_Dispatching_Domain_Access), Exp);
+
+ -- Conversion for Secondary_Stack_Size value
+
+ elsif Nam = Name_Secondary_Stack_Size then
+ Exp := Convert_To (RTE (RE_Size_Type), Exp);
end if;
Actions := Build_Assignment (Id, Exp);
-- The expression will be reanalyzed when the enclosing assignment
-- is reanalyzed, so reset the entity, which may be a temporary
-- created during analysis, e.g. a loop variable for an iterated
- -- component association.
+ -- component association. However, if entity is callable then
+ -- resolution has established its proper identity (including in
+ -- rewritten prefixed calls) so we must preserve it.
elsif Is_Entity_Name (N) then
- Set_Entity (N, Empty);
+ if Present (Entity (N))
+ and then not Is_Overloadable (Entity (N))
+ then
+ Set_Entity (N, Empty);
+ end if;
end if;
Set_Analyzed (N, False);
-- the back end or the expander here does not get overenthusiastic and
-- start processing such a pragma!
- if Should_Ignore_Pragma (Pname) then
+ if Should_Ignore_Pragma_Sem (N) then
Rewrite (N, Make_Null_Statement (Sloc (N)));
return;
end if;
end if;
end In_Extended_Main_Source_Unit;
+ ----------------------
+ -- In_Internal_Unit --
+ ----------------------
+
+ function In_Internal_Unit (N : Node_Or_Entity_Id) return Boolean is
+ begin
+ return In_Internal_Unit (Sloc (N));
+ end In_Internal_Unit;
+
+ function In_Internal_Unit (S : Source_Ptr) return Boolean is
+ Unit : constant Unit_Number_Type := Get_Source_Unit (S);
+ File : constant File_Name_Type := Unit_File_Name (Unit);
+ begin
+ return Is_Internal_File_Name (File);
+ end In_Internal_Unit;
+
------------------------
-- In_Predefined_Unit --
------------------------
function In_Predefined_Unit (S : Source_Ptr) return Boolean;
-- Same function as above but argument is a source pointer
+ function In_Internal_Unit (N : Node_Or_Entity_Id) return Boolean;
+ function In_Internal_Unit (S : Source_Ptr) return Boolean;
+ -- Same as In_Predefined_Unit, except units in the GNAT hierarchy are
+ -- included.
+
function In_Same_Code_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean;
pragma Inline (In_Same_Code_Unit);
-- Determines if the two nodes or entities N1 and N2 are in the same
-- Ignore pragma previously flagged by Ignore_Pragma
- if Should_Ignore_Pragma (Prag_Name) then
+ if Should_Ignore_Pragma_Par (Prag_Name) then
return Pragma_Node;
end if;
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2016, 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- --
-- expression of the same type, unless the selector designates a
-- public operation (otherwise that would represent an attempt to
-- reach an internal entity of another synchronized object).
+
-- This is legal if prefix is an access to such type and there is
-- a dereference, or is a component with a dereferenced prefix.
-- It is also legal if the prefix is a component of a task type,
Set_Etype (Sel, Any_Type);
return;
end if;
+
+ -- Another special case: the prefix may denote an object of the type
+ -- (but not a type) in which case this is an external call and the
+ -- operation must be public.
+
+ elsif In_Scope
+ and then Is_Object_Reference (Original_Node (Prefix (N)))
+ and then Is_Private_Op
+ then
+ Error_Msg_NE
+ ("invalid reference to private operation of some object of "
+ & "type &", N, Type_To_Use);
+ Set_Entity (Sel, Any_Id);
+ Set_Etype (Sel, Any_Type);
+ return;
end if;
-- If there is no visible entity with the given name or none of the
-- Ignore pragma if Ignore_Pragma applies
- if Should_Ignore_Pragma (Pname) then
+ if Should_Ignore_Pragma_Sem (N) then
return;
end if;
Set_Alignment (T1, Alignment (T2));
end Set_Size_Info;
+ ------------------------------
+ -- Should_Ignore_Pragma_Par --
+ ------------------------------
+
+ function Should_Ignore_Pragma_Par (Prag_Name : Name_Id) return Boolean is
+ pragma Assert (Compiler_State = Parsing);
+ -- This one can't work during semantic analysis, because we don't have a
+ -- correct Current_Source_File.
+
+ Result : constant Boolean :=
+ Get_Name_Table_Boolean3 (Prag_Name)
+ and then not Is_Internal_File_Name (File_Name (Current_Source_File));
+ begin
+ return Result;
+ end Should_Ignore_Pragma_Par;
+
--------------------------
- -- Should_Ignore_Pragma --
+ -- Should_Ignore_Pragma_Sem --
--------------------------
- function Should_Ignore_Pragma (Prag_Name : Name_Id) return Boolean is
+ function Should_Ignore_Pragma_Sem (N : Node_Id) return Boolean is
+ pragma Assert (Compiler_State = Analyzing);
+ Prag_Name : constant Name_Id := Pragma_Name (N);
+ Result : constant Boolean :=
+ Get_Name_Table_Boolean3 (Prag_Name) and then not In_Internal_Unit (N);
begin
- return
- not Is_Internal_File_Name (File_Name (Current_Source_File))
- and then Get_Name_Table_Boolean3 (Prag_Name);
- end Should_Ignore_Pragma;
+ return Result;
+ end Should_Ignore_Pragma_Sem;
--------------------
-- Static_Boolean --
function Scope_Is_Transient return Boolean;
-- True if the current scope is transient
- function Should_Ignore_Pragma (Prag_Name : Name_Id) return Boolean;
+ function Should_Ignore_Pragma_Par (Prag_Name : Name_Id) return Boolean;
+ function Should_Ignore_Pragma_Sem (N : Node_Id) return Boolean;
-- True if we should ignore pragmas with the specified name. In particular,
-- this returns True if pragma Ignore_Pragma applies, and we are not in a
- -- predefined unit.
+ -- predefined unit. The _Par version should be called only from the parser;
+ -- the _Sem version should be called only during semantic analysis.
function Static_Boolean (N : Node_Id) return Uint;
-- This function analyzes the given expression node and then resolves it
-- Compile_Time_Known_Aggregate (Flag18-Sem)
-- Present in N_Aggregate nodes. Set for aggregates which can be fully
-- evaluated at compile time without raising constraint error. Such
- -- aggregates can be passed as is the back end without any expansion.
+ -- aggregates can be passed as is to the back end without any expansion.
-- See Exp_Aggr for specific conditions under which this flag gets set.
-- Componentwise_Assignment (Flag14-Sem)
Write_Str ("#1.0#E");
UI_Write (-Val.Den);
- -- Other constants with a base other than 10 are written using one
- -- of the following forms, depending on the sign of the number
- -- and the sign of the exponent (= minus denominator value)
+ -- Other constants with a base other than 10 are written using one of
+ -- the following forms, depending on the sign of the number and the
+ -- sign of the exponent (= minus denominator value). See that we are
+ -- replacing the division by a multiplication (updating accordingly the
+ -- sign of the exponent) to generate an expression whose computation
+ -- does not cause a division by 0 when base**exponent is very small.
- -- numerator.0/base**exponent
- -- numerator.0/base**-exponent
+ -- numerator.0*base**exponent
+ -- numerator.0*base**-exponent
- -- And of course an exponent of 0 can be omitted
+ -- And of course an exponent of 0 can be omitted.
elsif Val.Rbase /= 0 then
if Brackets then
Write_Str (".0");
if Val.Den /= 0 then
- Write_Char ('/');
+ Write_Char ('*');
Write_Int (Val.Rbase);
Write_Str ("**");
if Val.Den <= 0 then
UI_Write (-Val.Den, Decimal);
else
+ Write_Str ("(-");
UI_Write (Val.Den, Decimal);
+ Write_Char (')');
end if;
end if;
projects / gcc.git / commitdiff