Commit 2b3d67a5 by Arnaud Charlet

[multiple changes]

2010-10-11  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb, sem_aggr.adb, sprint.adb: Minor reformatting.

2010-10-11  Javier Miranda  <miranda@adacore.com>

	* exp_ch5.ads, exp_ch6.ads (Expand_N_Extended_Return_Statement): Moved
	to exp_ch6.
	(Expand_N_Simple_Return_Statement): Moved to exp_ch6.
	* exp_ch5.adb, exp_ch6.adb (Expand_Non_Function_Return): Moved to
	exp_ch6.
	(Expand_Simple_Function_Return): Move to exp_ch6.
	(Expand_N_Extended_Return_Statement): Moved to exp_ch6.
	(Expand_N_Simple_Return_Statement): Moved to exp_ch6.

2010-10-11  Robert Dewar  <dewar@adacore.com>

	* snames.ads-tmpl: Add names for aspects.
	* aspects.ads, aspects.adb: New.
	* gcc-interface/Make-lang.in: Update dependencies.

From-SVN: r165281
parent fb468a94
2010-10-11 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_aggr.adb, sprint.adb: Minor reformatting.
2010-10-11 Javier Miranda <miranda@adacore.com>
* exp_ch5.ads, exp_ch6.ads (Expand_N_Extended_Return_Statement): Moved
to exp_ch6.
(Expand_N_Simple_Return_Statement): Moved to exp_ch6.
* exp_ch5.adb, exp_ch6.adb (Expand_Non_Function_Return): Moved to
exp_ch6.
(Expand_Simple_Function_Return): Move to exp_ch6.
(Expand_N_Extended_Return_Statement): Moved to exp_ch6.
(Expand_N_Simple_Return_Statement): Moved to exp_ch6.
2010-10-11 Robert Dewar <dewar@adacore.com>
* snames.ads-tmpl: Add names for aspects.
* aspects.ads, aspects.adb: New.
* gcc-interface/Make-lang.in: Update dependencies.
2010-10-11 Ed Schonberg <schonberg@adacore.com> 2010-10-11 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_Actuals): If an actual is the current instance of * exp_ch6.adb (Expand_Actuals): If an actual is the current instance of
......
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- A S P E C T S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2010, 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- --
-- 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. --
-- --
------------------------------------------------------------------------------
with Snames; use Snames;
package body Aspects is
type Aspect_Entry is record
Nam : Name_Id;
Asp : Aspect_Id;
end record;
Aspect_Names : constant array (Integer range <>) of Aspect_Entry := (
(Name_Ada_2005, Aspect_Ada_2005),
(Name_Ada_2012, Aspect_Ada_2012),
(Name_Address, Aspect_Address),
(Name_Aliased, Aspect_Aliased),
(Name_Alignment, Aspect_Alignment),
(Name_Atomic, Aspect_Atomic),
(Name_Atomic_Components, Aspect_Atomic_Components),
(Name_Bit_Order, Aspect_Bit_Order),
(Name_C_Pass_By_Copy, Aspect_C_Pass_By_Copy),
(Name_Component_Size, Aspect_Component_Size),
(Name_Discard_Names, Aspect_Discard_Names),
(Name_External_Tag, Aspect_External_Tag),
(Name_Favor_Top_Level, Aspect_Favor_Top_Level),
(Name_Inline, Aspect_Inline),
(Name_Inline_Always, Aspect_Inline_Always),
(Name_Invariant, Aspect_Invariant),
(Name_Machine_Radix, Aspect_Machine_Radix),
(Name_Object_Size, Aspect_Object_Size),
(Name_Pack, Aspect_Pack),
(Name_Persistent_BSS, Aspect_Persistent_BSS),
(Name_Post, Aspect_Post),
(Name_Postcondition, Aspect_Postcondition),
(Name_Pre, Aspect_Pre),
(Name_Precondition, Aspect_Precondition),
(Name_Predicate, Aspect_Predicate),
(Name_Preelaborable_Initialization, Aspect_Preelaborable_Initialization),
(Name_Psect_Object, Aspect_Psect_Object),
(Name_Pure_Function, Aspect_Pure_Function),
(Name_Shared, Aspect_Shared),
(Name_Size, Aspect_Size),
(Name_Storage_Pool, Aspect_Storage_Pool),
(Name_Storage_Size, Aspect_Storage_Size),
(Name_Stream_Size, Aspect_Stream_Size),
(Name_Suppress, Aspect_Suppress),
(Name_Suppress_Debug_Info, Aspect_Suppress_Debug_Info),
(Name_Unchecked_Union, Aspect_Unchecked_Union),
(Name_Universal_Aliasing, Aspect_Universal_Aliasing),
(Name_Unmodified, Aspect_Unmodified),
(Name_Unreferenced, Aspect_Unreferenced),
(Name_Unreferenced_Objects, Aspect_Unreferenced_Objects),
(Name_Unsuppress, Aspect_Unsuppress),
(Name_Value_Size, Aspect_Value_Size),
(Name_Volatile, Aspect_Volatile),
(Name_Volatile_Components, Aspect_Volatile_Components),
(Name_Warnings, Aspect_Warnings),
(Name_Weak_External, Aspect_Weak_External));
-------------------
-- Get_Aspect_Id --
-------------------
function Get_Aspect_Id (Name : Name_Id) return Aspect_Id is
begin
for J in Aspect_Names'Range loop
if Aspect_Names (J).Nam = Name then
return Aspect_Names (J).Asp;
end if;
end loop;
return No_Aspect;
end Get_Aspect_Id;
end Aspects;
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- A S P E C T S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2010, 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- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This package defines the aspects that are recognized in aspect
-- specifications. We separate this off in its own packages to that
-- it can be accessed by the parser without dragging in Sem_Asp
with Namet; use Namet;
package Aspects is
type Aspect_Id is
(No_Aspect, -- Dummy entry for no aspect
Aspect_Ada_2005, -- GNAT
Aspect_Ada_2012, -- GNAT
Aspect_Address,
Aspect_Aliased,
Aspect_Alignment,
Aspect_Atomic,
Aspect_Atomic_Components,
Aspect_Bit_Order,
Aspect_C_Pass_By_Copy,
Aspect_Component_Size,
Aspect_Discard_Names,
Aspect_External_Tag,
Aspect_Favor_Top_Level, -- GNAT
Aspect_Inline,
Aspect_Inline_Always, -- GNAT
Aspect_Invariant,
Aspect_Machine_Radix,
Aspect_Object_Size, -- GNAT
Aspect_Pack,
Aspect_Persistent_BSS, -- GNAT
Aspect_Post,
Aspect_Postcondition, -- GNAT (equivalent to Post)
Aspect_Pre,
Aspect_Precondition, -- GNAT (equivalent to Pre)
Aspect_Predicate, -- GNAT???
Aspect_Preelaborable_Initialization,
Aspect_Psect_Object, -- GNAT
Aspect_Pure_Function, -- GNAT
Aspect_Shared, -- GNAT (equivalent to Atomic)
Aspect_Size,
Aspect_Storage_Pool,
Aspect_Storage_Size,
Aspect_Stream_Size,
Aspect_Suppress,
Aspect_Suppress_Debug_Info, -- GNAT
Aspect_Unchecked_Union,
Aspect_Universal_Aliasing, -- GNAT
Aspect_Unmodified, -- GNAT
Aspect_Unreferenced, -- GNAT
Aspect_Unreferenced_Objects, -- GNAT
Aspect_Unsuppress,
Aspect_Value_Size, -- GNAT
Aspect_Volatile,
Aspect_Volatile_Components,
Aspect_Warnings, -- GNAT
Aspect_Weak_External); -- GNAT
-- The following array indicates aspects that accept 'Class
Class_Aspect_OK : constant array (Aspect_Id) of Boolean :=
(Aspect_Invariant => True,
Aspect_Pre => True,
Aspect_Precondition => True,
Aspect_Post => True,
Aspect_Postcondition => True,
others => False);
-- The following type is used for indicating allowed expression forms
type Aspect_Expression is
(Optional, -- Optional boolean expression
Expression, -- Required non-boolean expression
Name); -- Required name
-- The following array indicates what argument type is required
Aspect_Argument : constant array (Aspect_Id) of Aspect_Expression :=
(No_Aspect => Optional,
Aspect_Ada_2005 => Optional,
Aspect_Ada_2012 => Optional,
Aspect_Address => Expression,
Aspect_Aliased => Optional,
Aspect_Alignment => Expression,
Aspect_Atomic => Optional,
Aspect_Atomic_Components => Optional,
Aspect_Bit_Order => Expression,
Aspect_C_Pass_By_Copy => Optional,
Aspect_Component_Size => Expression,
Aspect_Discard_Names => Optional,
Aspect_External_Tag => Expression,
Aspect_Favor_Top_Level => Optional,
Aspect_Inline => Optional,
Aspect_Inline_Always => Optional,
Aspect_Invariant => Expression,
Aspect_Machine_Radix => Expression,
Aspect_Object_Size => Expression,
Aspect_Pack => Optional,
Aspect_Persistent_BSS => Optional,
Aspect_Post => Expression,
Aspect_Postcondition => Expression,
Aspect_Pre => Expression,
Aspect_Precondition => Expression,
Aspect_Predicate => Expression,
Aspect_Preelaborable_Initialization => Optional,
Aspect_Psect_Object => Optional,
Aspect_Pure_Function => Optional,
Aspect_Shared => Optional,
Aspect_Size => Expression,
Aspect_Storage_Pool => Expression,
Aspect_Storage_Size => Expression,
Aspect_Stream_Size => Expression,
Aspect_Suppress => Name,
Aspect_Suppress_Debug_Info => Optional,
Aspect_Unchecked_Union => Optional,
Aspect_Universal_Aliasing => Optional,
Aspect_Unmodified => Optional,
Aspect_Unreferenced => Optional,
Aspect_Unreferenced_Objects => Optional,
Aspect_Unsuppress => Name,
Aspect_Value_Size => Expression,
Aspect_Volatile => Optional,
Aspect_Volatile_Components => Optional,
Aspect_Warnings => Name,
Aspect_Weak_External => Optional);
function Get_Aspect_Id (Name : Name_Id) return Aspect_Id;
-- Given a name Nam, returns the corresponding aspect id value. If the name
-- does not match any aspect, then No_Aspect is returned as the result.
end Aspects;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,9 +32,7 @@ package Exp_Ch5 is ...@@ -32,9 +32,7 @@ package Exp_Ch5 is
procedure Expand_N_Block_Statement (N : Node_Id); procedure Expand_N_Block_Statement (N : Node_Id);
procedure Expand_N_Case_Statement (N : Node_Id); procedure Expand_N_Case_Statement (N : Node_Id);
procedure Expand_N_Exit_Statement (N : Node_Id); procedure Expand_N_Exit_Statement (N : Node_Id);
procedure Expand_N_Extended_Return_Statement (N : Node_Id);
procedure Expand_N_Goto_Statement (N : Node_Id); procedure Expand_N_Goto_Statement (N : Node_Id);
procedure Expand_N_If_Statement (N : Node_Id); procedure Expand_N_If_Statement (N : Node_Id);
procedure Expand_N_Loop_Statement (N : Node_Id); procedure Expand_N_Loop_Statement (N : Node_Id);
procedure Expand_N_Simple_Return_Statement (N : Node_Id);
end Exp_Ch5; end Exp_Ch5;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -29,11 +29,13 @@ with Types; use Types; ...@@ -29,11 +29,13 @@ with Types; use Types;
package Exp_Ch6 is package Exp_Ch6 is
procedure Expand_N_Function_Call (N : Node_Id); procedure Expand_N_Extended_Return_Statement (N : Node_Id);
procedure Expand_N_Subprogram_Body (N : Node_Id); procedure Expand_N_Function_Call (N : Node_Id);
procedure Expand_N_Subprogram_Body_Stub (N : Node_Id); procedure Expand_N_Procedure_Call_Statement (N : Node_Id);
procedure Expand_N_Subprogram_Declaration (N : Node_Id); procedure Expand_N_Simple_Return_Statement (N : Node_Id);
procedure Expand_N_Procedure_Call_Statement (N : Node_Id); procedure Expand_N_Subprogram_Body (N : Node_Id);
procedure Expand_N_Subprogram_Body_Stub (N : Node_Id);
procedure Expand_N_Subprogram_Declaration (N : Node_Id);
procedure Expand_Call (N : Node_Id); procedure Expand_Call (N : Node_Id);
-- This procedure contains common processing for Expand_N_Function_Call, -- This procedure contains common processing for Expand_N_Function_Call,
......
...@@ -529,8 +529,8 @@ package body Sem_Aggr is ...@@ -529,8 +529,8 @@ package body Sem_Aggr is
-- N is an array (sub-)aggregate. Dim is the dimension corresponding -- N is an array (sub-)aggregate. Dim is the dimension corresponding
-- to (sub-)aggregate N. This procedure collects and removes the side -- to (sub-)aggregate N. This procedure collects and removes the side
-- effects of the constrained N_Range nodes corresponding to each index -- effects of the constrained N_Range nodes corresponding to each index
-- dimension of our aggregate itype. -- dimension of our aggregate itype. These N_Range nodes are collected
-- These N_Range nodes are collected in Aggr_Range above. -- in Aggr_Range above.
-- --
-- Likewise collect in Aggr_Low & Aggr_High above the low and high -- Likewise collect in Aggr_Low & Aggr_High above the low and high
-- bounds of each index dimension. If, when collecting, two bounds -- bounds of each index dimension. If, when collecting, two bounds
......
...@@ -10404,7 +10404,7 @@ package body Sem_Prag is ...@@ -10404,7 +10404,7 @@ package body Sem_Prag is
-- pragma Passive [(PASSIVE_FORM)]; -- pragma Passive [(PASSIVE_FORM)];
-- PASSIVE_FORM ::= Semaphore | No -- PASSIVE_FORM ::= Semaphore | No
when Pragma_Passive => when Pragma_Passive =>
GNAT_Pragma; GNAT_Pragma;
...@@ -10475,6 +10475,8 @@ package body Sem_Prag is ...@@ -10475,6 +10475,8 @@ package body Sem_Prag is
-- Persistent_BSS -- -- Persistent_BSS --
-------------------- --------------------
-- pragma Persistent_BSS [(object_NAME)];
when Pragma_Persistent_BSS => Persistent_BSS : declare when Pragma_Persistent_BSS => Persistent_BSS : declare
Decl : Node_Id; Decl : Node_Id;
Ent : Entity_Id; Ent : Entity_Id;
......
...@@ -134,6 +134,14 @@ package Snames is ...@@ -134,6 +134,14 @@ package Snames is
Name_Space : constant Name_Id := N + $; Name_Space : constant Name_Id := N + $;
Name_Time : constant Name_Id := N + $; Name_Time : constant Name_Id := N + $;
-- Names of aspects for which there are no matching pragmas or attributes
-- so that they need to be included for aspect specification use.
Name_Invariant : constant Name_Id := N + $;
Name_Post : constant Name_Id := N + $;
Name_Pre : constant Name_Id := N + $;
Name_Predicate : constant Name_Id := N + $;
-- Some special names used by the expander. Note that the lower case u's -- Some special names used by the expander. Note that the lower case u's
-- at the start of these names get translated to extra underscores. These -- at the start of these names get translated to extra underscores. These
-- names are only referenced internally by expander generated code. -- names are only referenced internally by expander generated code.
......
...@@ -801,7 +801,6 @@ package body Sprint is ...@@ -801,7 +801,6 @@ package body Sprint is
-- Select print circuit based on node kind -- Select print circuit based on node kind
case Nkind (Node) is case Nkind (Node) is
when N_Abort_Statement => when N_Abort_Statement =>
Write_Indent_Str_Sloc ("abort "); Write_Indent_Str_Sloc ("abort ");
Sprint_Comma_List (Names (Node)); Sprint_Comma_List (Names (Node));
...@@ -3091,7 +3090,6 @@ package body Sprint is ...@@ -3091,7 +3090,6 @@ package body Sprint is
Write_Char (';'); Write_Char (';');
end if; end if;
end if; end if;
end case; end case;
if Nkind (Node) in N_Subexpr if Nkind (Node) in N_Subexpr
......
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