Skip to content

R
riscv-gcc-1
Commit 8c5b2819 by Arnaud Charlet
Options

[multiple changes] 

2012-05-15  Yannick Moy  <moy@adacore.com>

	* aspects.ads: Minor addition of comments to provide info on
	how to add new aspects.

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* osint.ads: Minor reformatting.

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* exp_ch5.adb, exp_pakd.adb, sem_util.adb, sem_util.ads
	(Expand_Assign_Array): Handle the case of a packed bit array within a
	record with reverse storage order (assign element by element in that
	case).
	(In_Reverse_Storage_Order_Record): New subprogram,
	code extracted from Exp_Pakd.

2012-05-15  Yannick Moy  <moy@adacore.com>

	* a-ngelfu.ads: Add postconditions using Ada 2012
	aspect syntax, reflecting some of the RM requirements for these
	functions, from Annex A.5.1 or G.2.4.

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* adaint.c: Minor fix: move misplaced comment.

2012-05-15  Doug Rupp  <rupp@adacore.com>

	* vms_data.ads: Enhance help for /IMMEDIATE_ERRORS to discourage
	use by customers.

From-SVN: r187525
parent 3ee8dde5
Showing with 265 additions and 71 deletions
gcc/ada/ChangeLog
2012-05-15 Yannick Moy <moy@adacore.com>
* aspects.ads: Minor addition of comments to provide info on
how to add new aspects.
2012-05-15 Thomas Quinot <quinot@adacore.com>
* osint.ads: Minor reformatting.
2012-05-15 Thomas Quinot <quinot@adacore.com>
* exp_ch5.adb, exp_pakd.adb, sem_util.adb, sem_util.ads
(Expand_Assign_Array): Handle the case of a packed bit array within a
record with reverse storage order (assign element by element in that
case).
(In_Reverse_Storage_Order_Record): New subprogram,
code extracted from Exp_Pakd.
2012-05-15 Yannick Moy <moy@adacore.com>
* a-ngelfu.ads: Add postconditions using Ada 2012
aspect syntax, reflecting some of the RM requirements for these
functions, from Annex A.5.1 or G.2.4.
2012-05-15 Thomas Quinot <quinot@adacore.com>
* adaint.c: Minor fix: move misplaced comment.
2012-05-15 Doug Rupp <rupp@adacore.com>
* vms_data.ads: Enhance help for /IMMEDIATE_ERRORS to discourage
use by customers.
2012-05-15 Tristan Gingold <gingold@adacore.com>
* a-exextr.adb: Add comment.
......
gcc/ada/a-ngelfu.ads
......@@ -6,10 +6,34 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2012, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the Post aspects that have been added to the spec. --
-- Except for these parts of the document, in accordance with the copyright --
-- of that document, you can freely copy and modify this specification, --
-- provided that if you redistribute a modified version, any changes that --
-- you have made are clearly indicated. --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
......@@ -19,55 +43,141 @@ generic
package Ada.Numerics.Generic_Elementary_Functions is
pragma Pure;
function Sqrt (X : Float_Type'Base) return Float_Type'Base;
function Log (X : Float_Type'Base) return Float_Type'Base;
function Log (X, Base : Float_Type'Base) return Float_Type'Base;
function Exp (X : Float_Type'Base) return Float_Type'Base;
function "**" (Left, Right : Float_Type'Base) return Float_Type'Base;
function Sin (X : Float_Type'Base) return Float_Type'Base;
function Sin (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Cos (X : Float_Type'Base) return Float_Type'Base;
function Cos (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Tan (X : Float_Type'Base) return Float_Type'Base;
function Tan (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Cot (X : Float_Type'Base) return Float_Type'Base;
function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Arcsin (X : Float_Type'Base) return Float_Type'Base;
function Arcsin (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Arccos (X : Float_Type'Base) return Float_Type'Base;
function Arccos (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Sqrt (X : Float_Type'Base) return Float_Type'Base
with
Post => Sqrt'Result >= 0.0
and then (if X = 0.0 then Sqrt'Result = 0.0)
and then (if X = 1.0 then Sqrt'Result = 1.0);
function Log (X : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 1.0 then Log'Result = 0.0);
function Log (X, Base : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 1.0 then Log'Result = 0.0);
function Exp (X : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 0.0 then Exp'Result = 1.0);
function "**" (Left, Right : Float_Type'Base) return Float_Type'Base
with
Post => "**"'Result >= 0.0
and then (if Right = 0.0 then "**"'Result = 1.0)
and then (if Right = 1.0 then "**"'Result = Left)
and then (if Left = 1.0 then "**"'Result = 1.0)
and then (if Left = 0.0 then "**"'Result = 0.0);
function Sin (X : Float_Type'Base) return Float_Type'Base
with
Post => Sin'Result in -1.0 .. 1.0
and then (if X = 0.0 then Sin'Result = 0.0);
function Sin (X, Cycle : Float_Type'Base) return Float_Type'Base
with
Post => Sin'Result in -1.0 .. 1.0
and then (if X = 0.0 then Sin'Result = 0.0);
function Cos (X : Float_Type'Base) return Float_Type'Base
with
Post => Cos'Result in -1.0 .. 1.0
and then (if X = 0.0 then Cos'Result = 1.0);
function Cos (X, Cycle : Float_Type'Base) return Float_Type'Base
with
Post => Cos'Result in -1.0 .. 1.0
and then (if X = 0.0 then Cos'Result = 1.0);
function Tan (X : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 0.0 then Tan'Result = 0.0);
function Tan (X, Cycle : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 0.0 then Tan'Result = 0.0);
function Cot (X : Float_Type'Base) return Float_Type'Base;
function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Arcsin (X : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 0.0 then Arcsin'Result = 0.0);
function Arcsin (X, Cycle : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 0.0 then Arcsin'Result = 0.0);
function Arccos (X : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 1.0 then Arccos'Result = 0.0);
function Arccos (X, Cycle : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 1.0 then Arccos'Result = 0.0);
function Arctan
(Y : Float_Type'Base;
X : Float_Type'Base := 1.0)
return Float_Type'Base;
return Float_Type'Base
with
Post => (if X > 0.0 and Y = 0.0 then Arctan'Result = 0.0);
function Arctan
(Y : Float_Type'Base;
X : Float_Type'Base := 1.0;
Cycle : Float_Type'Base)
return Float_Type'Base;
return Float_Type'Base
with
Post => (if X > 0.0 and Y = 0.0 then Arctan'Result = 0.0);
function Arccot
(X : Float_Type'Base;
Y : Float_Type'Base := 1.0)
return Float_Type'Base;
return Float_Type'Base
with
Post => (if X > 0.0 and Y = 0.0 then Arccot'Result = 0.0);
function Arccot
(X : Float_Type'Base;
Y : Float_Type'Base := 1.0;
Cycle : Float_Type'Base)
return Float_Type'Base;
function Sinh (X : Float_Type'Base) return Float_Type'Base;
function Cosh (X : Float_Type'Base) return Float_Type'Base;
function Tanh (X : Float_Type'Base) return Float_Type'Base;
function Coth (X : Float_Type'Base) return Float_Type'Base;
function Arcsinh (X : Float_Type'Base) return Float_Type'Base;
function Arccosh (X : Float_Type'Base) return Float_Type'Base;
function Arctanh (X : Float_Type'Base) return Float_Type'Base;
return Float_Type'Base
with
Post => (if X > 0.0 and Y = 0.0 then Arccot'Result = 0.0);
function Sinh (X : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 0.0 then Sinh'Result = 0.0);
function Cosh (X : Float_Type'Base) return Float_Type'Base
with
Post => Cosh'Result >= 1.0
and then (if X = 0.0 then Cosh'Result = 1.0);
function Tanh (X : Float_Type'Base) return Float_Type'Base
with
Post => Tanh'Result in -1.0 .. 1.0
and then (if X = 0.0 then Tanh'Result = 0.0);
function Coth (X : Float_Type'Base) return Float_Type'Base
with
Post => abs Coth'Result >= 1.0;
function Arcsinh (X : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 0.0 then Arcsinh'Result = 0.0);
function Arccosh (X : Float_Type'Base) return Float_Type'Base
with
Post => Arccosh'Result >= 0.0
and then (if X = 1.0 then Arccosh'Result = 0.0);
function Arctanh (X : Float_Type'Base) return Float_Type'Base
with
Post => (if X = 0.0 then Arctanh'Result = 0.0);
function Arccoth (X : Float_Type'Base) return Float_Type'Base;
end Ada.Numerics.Generic_Elementary_Functions;
gcc/ada/adaint.c
......@@ -350,7 +350,6 @@ int __gnat_vmsp = 0;
/* Used for Ada bindings */
int __gnat_size_of_file_attributes = sizeof (struct file_attributes);
/* Reset the file attributes as if no system call had been performed */
void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr);
/* The __gnat_max_path_len variable is used to export the maximum
......@@ -402,6 +401,8 @@ to_ptr32 (char **ptr64)
static const char ATTR_UNSET = 127;
/* Reset the file attributes as if no system call had been performed */
void
__gnat_reset_attributes
(struct file_attributes* attr)
......
gcc/ada/aspects.ads
......@@ -34,6 +34,31 @@
-- aspect specifications from the tree. The semantic processing for aspect
-- specifications is found in Sem_Ch13.Analyze_Aspect_Specifications.
-- In general, each aspect should have a corresponding pragma, so that the
-- newly developed functionality is available for Ada versions < Ada 2012.
-- When both are defined, it is convenient to first transform the aspect into
-- an equivalent pragma in Sem_Ch13.Analyze_Aspect_Specifications, and then
-- analyze the pragma in Sem_Prag.Analyze_Pragma.
-- To add a new aspect:
-- * create a name in snames.ads-tmpl
-- * create a value in type Aspect_Id in this unit
-- * add a value for the aspect in the global arrays defined in this unit
-- * add code for analyzing the aspect in
-- Sem_Ch13.Analyze_Aspect_Specifications. This may involve adding some
-- nodes to the tree to perform additional treatments later.
-- * if the semantic analysis of expressions/names in the aspect should not
-- occur at the point the aspect is defined, add code in the adequate
-- semantic analysis procedure for the aspect. For example, this is the case
-- for aspects Pre and Post on subprograms, which are pre-analyzed at the
-- end of the list of declarations to which the subprogram belongs, and
-- fully analyzed (possibly with expansion) during the semantic analysis of
-- subprogram bodies.
-- Additionally, to add a corresponding pragma for a new aspect:
-- * create a name for the pragma in snames.ads-tmpl
-- * add code for analyzing the pragma in Sem_Prag.Analyze_Pragma
with Namet; use Namet;
with Snames; use Snames;
with Types; use Types;
......
gcc/ada/exp_ch5.adb
......@@ -344,7 +344,18 @@ package body Exp_Ch5 is
elsif Has_Controlled_Component (L_Type) then
Loop_Required := True;
-- If object is atomic, we cannot tolerate a loop
-- If changing scalar storage order and assigning a bit packed arrau,
-- force loop expansion.
elsif Is_Bit_Packed_Array (L_Type)
and then
(In_Reverse_Storage_Order_Record (Rhs)
/=
In_Reverse_Storage_Order_Record (Lhs))
then
Loop_Required := True;
-- If object is atomic, we cannot tolerate a loop
elsif Is_Atomic_Object (Act_Lhs)
or else
......
gcc/ada/exp_pakd.adb
......@@ -2622,14 +2622,9 @@ package body Exp_Pakd is
Loc : constant Source_Ptr := Sloc (N);
PAT : Entity_Id;
Otyp : Entity_Id;
Pref : Node_Id;
Csiz : Uint;
Osiz : Uint;
In_Reverse_Storage_Order_Record : Boolean;
-- Set True if Obj is a [sub]component of a record that has reversed
-- scalar storage order.
begin
Csiz := Component_Size (Atyp);
......@@ -2732,28 +2727,7 @@ package body Exp_Pakd is
-- We also have to adjust if the storage order is reversed
Pref := Obj;
loop
case Nkind (Pref) is
when N_Selected_Component =>
Pref := Prefix (Pref);
exit;
when N_Indexed_Component =>
Pref := Prefix (Pref);
when others =>
Pref := Empty;
exit;
end case;
end loop;
In_Reverse_Storage_Order_Record :=
Present (Pref)
and then Is_Record_Type (Etype (Pref))
and then Reverse_Storage_Order (Etype (Pref));
if Bytes_Big_Endian xor In_Reverse_Storage_Order_Record then
if Bytes_Big_Endian xor In_Reverse_Storage_Order_Record (Obj) then
Shift :=
Make_Op_Subtract (Loc,
Left_Opnd => Make_Integer_Literal (Loc, Osiz - Csiz),
......
gcc/ada/osint.ads
......@@ -763,7 +763,7 @@ private
-- the need for either mapping the struct exactly or importing the sizeof
-- from C, which would result in dynamic code). However, it does waste
-- space (e.g. when a component of this type appears in a record, if it is
-- unnecessarily large.
-- unnecessarily large).
type File_Attributes is
array (1 .. File_Attributes_Size)
......
gcc/ada/sem_util.adb
......@@ -3169,14 +3169,15 @@ package body Sem_Util is
-- Enclosing_Lib_Unit_Entity --
-------------------------------
function Enclosing_Lib_Unit_Entity return Entity_Id is
Unit_Entity : Entity_Id;
function Enclosing_Lib_Unit_Entity
(E : Entity_Id := Current_Scope) return Entity_Id
is
Unit_Entity : Entity_Id := E;
begin
-- Look for enclosing library unit entity by following scope links.
-- Equivalent to, but faster than indexing through the scope stack.
Unit_Entity := Current_Scope;
while (Present (Scope (Unit_Entity))
and then Scope (Unit_Entity) /= Standard_Standard)
and not Is_Child_Unit (Unit_Entity)
......@@ -6267,6 +6268,37 @@ package body Sem_Util is
return False;
end In_Parameter_Specification;
-------------------------------------
-- In_Reverse_Storage_Order_Record --
-------------------------------------
function In_Reverse_Storage_Order_Record (N : Node_Id) return Boolean is
Pref : Node_Id;
begin
Pref := N;
-- Climb up indexed components
loop
case Nkind (Pref) is
when N_Selected_Component =>
Pref := Prefix (Pref);
exit;
when N_Indexed_Component =>
Pref := Prefix (Pref);
when others =>
Pref := Empty;
exit;
end case;
end loop;
return Present (Pref)
and then Is_Record_Type (Etype (Pref))
and then Reverse_Storage_Order (Etype (Pref));
end In_Reverse_Storage_Order_Record;
--------------------------------------
-- In_Subprogram_Or_Concurrent_Unit --
--------------------------------------
......
gcc/ada/sem_util.ads
......@@ -385,10 +385,12 @@ package Sem_Util is
-- Returns the Node_Id associated with the innermost enclosing generic
-- unit, if any. If none, then returns Empty.
function Enclosing_Lib_Unit_Entity return Entity_Id;
-- Returns the entity of enclosing N_Compilation_Unit Node which is the
function Enclosing_Lib_Unit_Entity
(E : Entity_Id := Current_Scope) return Entity_Id;
-- Returns the entity of enclosing library unit node which is the
-- root of the current scope (which must not be Standard_Standard, and the
-- caller is responsible for ensuring this condition).
-- caller is responsible for ensuring this condition) or other specified
-- entity.
function Enclosing_Package (E : Entity_Id) return Entity_Id;
-- Utility function to return the Ada entity of the package enclosing
......@@ -740,6 +742,10 @@ package Sem_Util is
function In_Parameter_Specification (N : Node_Id) return Boolean;
-- Returns True if node N belongs to a parameter specification
function In_Reverse_Storage_Order_Record (N : Node_Id) return Boolean;
-- Returns True if N denotes a component or subcomponent in a record object
-- that has Reverse_Storage_Order.
function In_Subprogram_Or_Concurrent_Unit return Boolean;
-- Determines if the current scope is within a subprogram compilation unit
-- (inside a subprogram declaration, subprogram body, or generic
......
gcc/ada/vms_data.ads
......@@ -1779,7 +1779,9 @@ package VMS_Data is
-- Causes errors to be displayed as soon as they are encountered, rather
-- than after compilation is terminated. If GNAT terminates prematurely
-- or goes into an infinite loop, the last error message displayed may
-- help to pinpoint the culprit.
-- help to pinpoint the culprit. Use with caution: This qualifier is
-- intended for use in debugging the compiler proper, and may cause
-- output of warnings suppressed by pragma.
S_GCC_Inline : aliased constant S := "/INLINE=" &
"PRAGMA " &
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment