[multiple changes]

2004-06-14  Pascal Obry  <obry@gnat.com>

	* gnat_ugn.texi: Document relocatable vs. dynamic Library_Kind on
	Windows.  Fix minor typo.

	* mlib-tgt-mingw.adb: New implementation using the GCC -shared option
	which is now supported on Windows. With this implementation using the
	Library Project feature is no different on Windows than on UNIX.

2004-06-14  Vincent Celier  <celier@gnat.com>

	* makegpr.adb (Compile_Sources): Nothing to do when there are no
	non-Ada sources.

	* mlib-tgt-vxworks.adb (Library_Exists_For): Remove incorrect comment

	* prj-part.adb (Parse_Single_Project): When a duplicate project name is
	found, show the project name and the path of the previously parsed
	project file.

2004-06-14  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch6.adb (Add_Call_By_Copy_Code): For an out-parameter that is an
	array, avoid copying the actual before the call.

2004-06-14  Thomas Quinot  <quinot@act-europe.fr>

	* g-debpoo.adb: Remove alignment assumptions from GNAT.Debug_Pools.
	Instead, allocate memory on worst-case alignment assumptions, and then
	return an aligned address within the allocated zone.

2004-06-14  Robert Dewar  <dewar@gnat.com>

	* bindgen.adb (Gen_Adainit_Ada): Do not generate external references to
	elab entities in predefined units in No_Run_Time_Mode.
	(Gen_Adainit_C): Same fix
	(Gen_Elab_Calls_Ada): Do not generate calls to elaborate predefined
	units in No_Run_Time_Mode
	(Gen_Elab_Calls_C): Same fix

	* symbols-vms-alpha.adb: Minor reformatting

	* g-debpoo.ads: Minor reformatting

	* lib.adb (In_Same_Extended_Unit): Version working on node id's

	* lib.ads (In_Same_Extended_Unit): Version working on node id's

	* lib-xref.adb: Minor cleanup, use new version of In_Same_Extended_Unit
	working on nodes.

	* make.adb: Minor reformatting

	* par-ch12.adb: Minor reformatting

	* par-prag.adb: Add dummy entry for pragma Profile_Warnings

	* prj-strt.adb: Minor reformatting

	* restrict.ads, restrict.adb: Redo handling of profile restrictions to
	be more general.

	* sem_attr.adb: Minor reformatting

	* sem_ch7.adb: Minor reformatting

	* sem_elab.adb (Check_A_Call): Deal with problem of calling init proc
	for type in the same unit as the object declaration.

	* sem_prag.adb (Check_Arg_Is_External_Name): New procedure, allows
	static string expressions and not just string literals.
	Minor reformatting
	(Set_Warning): Reset restriction warning flag for restriction pragma
	Implement pragma Profile_Warnings
	Implement pragma Profile (Restricted)
	Give obolescent messages for old restrictions and pragmas

	* snames.h, snames.ads, snames.adb: Add new entry for pragma
	Profile_Warnings.

	* s-rident.ads: Add declarations for restrictions required by profile
	Restricted and profile Ravenscar.

	* targparm.ads, targparm.adb: Allow pragma Profile in system.ads

	* gnat_ugn.texi: Correct some missing entries in the list of GNAT
	configuration pragmas.

From-SVN: r83099

1 files changed, 95 insertions, 74 deletions

diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index a8336c9..d35a9ec 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -31,12 +31,24 @@ with Fname;    use Fname;
 with Fname.UF; use Fname.UF;
 with Lib;      use Lib;
 with Namet;    use Namet;
+with Opt;      use Opt;
+with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Uname;    use Uname;
 
 package body Restrict is
 
+   Restricted_Profile_Result : Boolean := False;
+   --  This switch memoizes the result of Restricted_Profile function
+   --  calls for improved efficiency. Its setting is valid only if
+   --  Restricted_Profile_Cached is True. Note that if this switch
+   --  is ever set True, it need never be turned off again.
+
+   Restricted_Profile_Cached : Boolean := False;
+   --  This flag is set to True if the Restricted_Profile_Result
+   --  contains the correct cached result of Restricted_Profile calls.
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -361,57 +373,75 @@ package body Restrict is
    --  Note: body of this function must be coordinated with list of
    --  renaming declarations in System.Rident.
 
-   function Process_Restriction_Synonyms (Id : Name_Id) return Name_Id is
+   function Process_Restriction_Synonyms (N : Node_Id) return Name_Id
+   is
+      Old_Name : constant Name_Id := Chars (N);
+      New_Name : Name_Id;
+
    begin
-      case Id is
+      case Old_Name is
          when Name_Boolean_Entry_Barriers =>
-            return Name_Simple_Barriers;
+            New_Name := Name_Simple_Barriers;
 
          when Name_Max_Entry_Queue_Depth =>
-            return Name_Max_Entry_Queue_Length;
+            New_Name := Name_Max_Entry_Queue_Length;
 
          when Name_No_Dynamic_Interrupts =>
-            return Name_No_Dynamic_Attachment;
+            New_Name := Name_No_Dynamic_Attachment;
 
          when Name_No_Requeue =>
-            return Name_No_Requeue_Statements;
+            New_Name := Name_No_Requeue_Statements;
 
          when Name_No_Task_Attributes =>
-            return Name_No_Task_Attributes_Package;
+            New_Name := Name_No_Task_Attributes_Package;
 
          when others =>
-            return Id;
+            return Old_Name;
       end case;
+
+      if Warn_On_Obsolescent_Feature then
+         Error_Msg_Name_1 := Old_Name;
+         Error_Msg_N ("restriction identifier % is obsolescent?", N);
+         Error_Msg_Name_1 := New_Name;
+         Error_Msg_N ("|use restriction identifier % instead", N);
+      end if;
+
+      return New_Name;
    end Process_Restriction_Synonyms;
 
    ------------------------
    -- Restricted_Profile --
    ------------------------
 
-   --  This implementation must be coordinated with Set_Restricted_Profile
-
    function Restricted_Profile return Boolean is
    begin
-      return     Restrictions.Set (No_Abort_Statements)
-        and then Restrictions.Set (No_Asynchronous_Control)
-        and then Restrictions.Set (No_Entry_Queue)
-        and then Restrictions.Set (No_Task_Hierarchy)
-        and then Restrictions.Set (No_Task_Allocators)
-        and then Restrictions.Set (No_Dynamic_Priorities)
-        and then Restrictions.Set (No_Terminate_Alternatives)
-        and then Restrictions.Set (No_Dynamic_Attachment)
-        and then Restrictions.Set (No_Protected_Type_Allocators)
-        and then Restrictions.Set (No_Local_Protected_Objects)
-        and then Restrictions.Set (No_Requeue_Statements)
-        and then Restrictions.Set (No_Task_Attributes_Package)
-        and then Restrictions.Set (Max_Asynchronous_Select_Nesting)
-        and then Restrictions.Set (Max_Task_Entries)
-        and then Restrictions.Set (Max_Protected_Entries)
-        and then Restrictions.Set (Max_Select_Alternatives)
-        and then Restrictions.Value (Max_Asynchronous_Select_Nesting) =  0
-        and then Restrictions.Value (Max_Task_Entries)                =  0
-        and then Restrictions.Value (Max_Protected_Entries)           <= 1
-        and then Restrictions.Value (Max_Select_Alternatives)         =  0;
+      if Restricted_Profile_Cached then
+         return Restricted_Profile_Result;
+
+      else
+         Restricted_Profile_Result := True;
+         Restricted_Profile_Cached := True;
+
+         declare
+            R : Restriction_Flags  renames Profile_Info (Restricted).Set;
+            V : Restriction_Values renames Profile_Info (Restricted).Value;
+         begin
+            for J in R'Range loop
+               if R (J)
+                 and then (Restrictions.Set (J) = False
+                             or else Restriction_Warnings (J)
+                             or else
+                               (J in All_Parameter_Restrictions
+                                  and then Restrictions.Value (J) > V (J)))
+               then
+                  Restricted_Profile_Result := False;
+                  exit;
+               end if;
+            end loop;
+
+            return Restricted_Profile_Result;
+         end;
+      end if;
    end Restricted_Profile;
 
    ------------------------
@@ -466,52 +496,31 @@ package body Restrict is
       Error_Msg_N (B (1 .. P), N);
    end Restriction_Msg;
 
-   -------------------
-   -- Set_Ravenscar --
-   -------------------
+   ------------------------------
+   -- Set_Profile_Restrictions --
+   ------------------------------
+
+   procedure Set_Profile_Restrictions
+     (P    : Profile_Name;
+      N    : Node_Id;
+      Warn : Boolean)
+   is
+      R : Restriction_Flags  renames Profile_Info (P).Set;
+      V : Restriction_Values renames Profile_Info (P).Value;
 
-   procedure Set_Ravenscar (N : Node_Id) is
-   begin
-      Set_Restricted_Profile (N);
-      Set_Restriction (Simple_Barriers,              N);
-      Set_Restriction (No_Select_Statements,         N);
-      Set_Restriction (No_Calendar,                  N);
-      Set_Restriction (No_Entry_Queue,               N);
-      Set_Restriction (No_Relative_Delay,            N);
-      Set_Restriction (No_Task_Termination,          N);
-      Set_Restriction (No_Implicit_Heap_Allocations, N);
-   end Set_Ravenscar;
-
-   ----------------------------
-   -- Set_Restricted_Profile --
-   ----------------------------
-
-   --  This must be coordinated with Restricted_Profile
-
-   procedure Set_Restricted_Profile (N : Node_Id) is
    begin
-      --  Set Boolean restrictions for Restricted Profile
-
-      Set_Restriction (No_Abort_Statements,          N);
-      Set_Restriction (No_Asynchronous_Control,      N);
-      Set_Restriction (No_Entry_Queue,               N);
-      Set_Restriction (No_Task_Hierarchy,            N);
-      Set_Restriction (No_Task_Allocators,           N);
-      Set_Restriction (No_Dynamic_Priorities,        N);
-      Set_Restriction (No_Terminate_Alternatives,    N);
-      Set_Restriction (No_Dynamic_Attachment,        N);
-      Set_Restriction (No_Protected_Type_Allocators, N);
-      Set_Restriction (No_Local_Protected_Objects,   N);
-      Set_Restriction (No_Requeue_Statements,        N);
-      Set_Restriction (No_Task_Attributes_Package,   N);
-
-      --  Set parameter restrictions
-
-      Set_Restriction (Max_Asynchronous_Select_Nesting, N, 0);
-      Set_Restriction (Max_Task_Entries,                N, 0);
-      Set_Restriction (Max_Select_Alternatives,         N, 0);
-      Set_Restriction (Max_Protected_Entries,           N, 1);
-   end Set_Restricted_Profile;
+      for J in R'Range loop
+         if R (J) then
+            if J in All_Boolean_Restrictions then
+               Set_Restriction (J, N);
+            else
+               Set_Restriction (J, N, V (J));
+            end if;
+
+            Restriction_Warnings (J) := Warn;
+         end if;
+      end loop;
+   end Set_Profile_Restrictions;
 
    ---------------------
    -- Set_Restriction --
@@ -526,6 +535,12 @@ package body Restrict is
    begin
       Restrictions.Set (R) := True;
 
+      if Restricted_Profile_Cached and Restricted_Profile_Result then
+         null;
+      else
+         Restricted_Profile_Cached := False;
+      end if;
+
       --  Set location, but preserve location of system
       --  restriction for nice error msg with run time name
 
@@ -557,6 +572,12 @@ package body Restrict is
       V : Integer)
    is
    begin
+      if Restricted_Profile_Cached and Restricted_Profile_Result then
+         null;
+      else
+         Restricted_Profile_Cached := False;
+      end if;
+
       if Restrictions.Set (R) then
          if V < Restrictions.Value (R) then
             Restrictions.Value (R) := V;