2004-02-02 Vincent Celier <celier@gnat.com>

	* gprcmd.adb (Check_Args): If condition is false, print the invoked
	comment before the usage.
	Gprcmd: Fail when command is not recognized.
	(Usage): Document command "prefix"

	* g-md5.adb (Digest): Process last block.
	(Update): Do not process last block. Store remaining characters and
	length in Context.

	* g-md5.ads (Update): Document that several call to update are
	equivalent to one call with the concatenated string.
	(Context): Add fields to allow new Update behaviour.

	* fname-uf.ads/adb (Get_File_Name): New Boolean parameter May_Fail,
	defaulted to False.
	When May_Fail is True and no existing file can be found, return No_File.

	* 6vcstrea.adb: Inlined functions are now wrappers to implementation
	functions.

	* lib-writ.adb (Write_With_Lines): When body file does not exist, use
	spec file name instead on the W line.

2004-02-02  Robert Dewar  <dewar@gnat.com>

	* ali.adb: Read and acquire info from new format restrictions lines

	* bcheck.adb: Add circuits for checking restrictions with parameters

	* bindgen.adb: Output dummy restrictions data
	To be changed later

	* ali.ads, checks.adb, exp_aggr.adb, exp_attr.adb, exp_ch11.adb,
	exp_ch3.adb, exp_ch5.adb, exp_ch6.adb, exp_ch7.adb, exp_util.adb,
	freeze.adb, gnat1drv.adb, sem_attr.adb, sem_ch10.adb, sem_ch11.adb,
	sem_ch12.adb, targparm.adb, targparm.ads, tbuild.adb, sem_ch2.adb,
	sem_elab.adb, sem_res.adb: Minor changes for new restrictions handling.

	* exp_ch9.adb (Build_Master_Entity): Cleanup the code (also suppresses
	the warning message on access to possibly uninitialized variable S)
	Minor changes for new restrictions handling.

	* gnatbind.adb: Minor reformatting
	Minor changes for new restrictions handling
	Move circuit for -r processing here from bcheck (cleaner)

	* gnatcmd.adb, gnatlink.adb: Minor reformatting

	* lib-writ.adb: Output new format restrictions lines

	* lib-writ.ads: Document new R format lines for new restrictions
	handling.

	* s-restri.ads/adb: New files

	* Makefile.rtl: Add entry for s-restri.ads/adb

	* par-ch3.adb: Fix bad error messages starting with upper case letter
	Minor reformatting

	* restrict.adb: Major rewrite throughout for new restrictions handling
	Major point is to handle restrictions with parameters

	* restrict.ads: Major changes in interface to handle restrictions with
	parameters. Also generally simplifies setting of restrictions.

	* snames.ads/adb: New entry for proper handling of No_Requeue

	* sem_ch3.adb (Count_Tasks): New circuitry for implementing Max_Tasks
	restriction counting.
	Other minor changes for new restrictions handling

	* sem_prag.adb: No_Requeue is a synonym for No_Requeue_Statements.
	Restriction_Warnings now allows full parameter notation
	Major rewrite of Restrictions for new restrictions handling

2004-02-02  Javier Miranda  <miranda@gnat.com>

	* par-ch3.adb (P_Identifier_Declarations): Give support to the Ada 0Y
	syntax rule for object renaming declarations.
	(P_Array_Type_Definition): Give support for the Ada 0Y syntax rule for
	component definitions.

	* sem_ch3.adb (Analyze_Component_Declaration): Give support to access
	components.
	(Array_Type_Declaration): Give support to access components. In addition
	it was also modified to reflect the name of the object in anonymous
	array types. The old code did not take into account that it is possible
	to have an unconstrained anonymous array with an initial value.
	(Check_Or_Process_Discriminants): Allow access discriminant in
	non-limited types.
	(Process_Discriminants): Allow access discriminant in non-limited types
	Initialize the new Access_Definition field in N_Object_Renaming_Decl
	node.  Change Ada0Y to Ada 0Y in comments

	* sem_ch4.adb (Find_Equality_Types): Allow anonymous access types in
	equality operators.
	Change Ada0Y to Ada 0Y in comments

	* sem_ch8.adb (Analyze_Object_Renaming): Give support to access
	renamings Change Ada0Y to Ada 0Y in comments

	* sem_type.adb (Find_Unique_Type): Give support to the equality
	operators for universal access types
	Change Ada0Y to Ada 0Y in comments

	* sinfo.adb (Access_Definition, Set_Access_Definition): New subprograms

	* sinfo.ads (N_Component_Definition): Addition of Access_Definition
	field.
	(N_Object_Renaming_Declaration): Addition of Access_Definition field
	Change Ada0Y to Ada 0Y in comments

	* sprint.adb (Sprint_Node_Actual): Give support to the new syntax for
	component definition and object renaming nodes
	Change Ada0Y to Ada 0Y in comments

2004-02-02  Jose Ruiz  <ruiz@act-europe.fr>

	* restrict.adb: Use the new restriction identifier
	No_Requeue_Statements instead of the old No_Requeue for defining the
	restricted profile.

	* sem_ch9.adb (Analyze_Requeue): Check the new restriction
	No_Requeue_Statements.

	* s-rident.ads: Adding restriction No_Requeue_Statements (AI-00249)
	that supersedes the GNAT specific restriction No_Requeue. The later is
	kept for backward compatibility.

2004-02-02  Ed Schonberg  <schonberg@gnat.com>

	* lib.ads, i-cobol.ads, * s-stoele.ads, s-thread.ads, style.ads,
	5staprop.adb, atree.adb, atree.ads, g-crc32.ads: Remove redundant
	pragma and fix incorrect ones.

	* sem_prag.adb For pragma Inline and pragma Pure_Function, emit a
	warning if the pragma is redundant.

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

	* 5staprop.adb: Add missing 'constant' keywords.

	* Makefile.in: use consistent value for SYMLIB on
	platforms where libaddr2line is supported.

2004-02-02  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* utils.c (end_subprog_body): Do not call rest_of_compilation if just
	annotating types.

2004-02-02  Olivier Hainque  <hainque@act-europe.fr>

	* init.c (__gnat_install_handler): Setup an alternate stack for signal
	handlers in the environment thread. This allows proper propagation of
	an exception on stack overflows in this thread even when the builtin
	ABI stack-checking scheme is used without support for a stack reserve
	region.

	* utils.c (create_field_decl): Augment the head comment about bitfield
	creation, and don't account for DECL_BIT_FIELD in DECL_NONADDRESSABLE_P
	here, because the former is not accurate enough at this point.
	Let finish_record_type decide instead.
	Don't make a bitfield if the field is to be addressable.
	Always set a size for the field if the record is packed, to ensure the
	checks for bitfield creation are triggered.
	(finish_record_type): During last pass over the fields, clear
	DECL_BIT_FIELD when possible in the !STRICT_ALIGNMENT case, as this is
	not covered by the calls to layout_decl.  Adjust DECL_NONADDRESSABLE_P
	from DECL_BIT_FIELD.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@77110 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 290 insertions, 225 deletions

diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 2740fc67d22..2f2f15309df 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 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- --
@@ -59,11 +59,11 @@ package body Restrict is
 
    function Abort_Allowed return Boolean is
    begin
-      if Restrictions (No_Abort_Statements)
-        and then Restriction_Parameters (Max_Asynchronous_Select_Nesting) = 0
+      if Restrictions.Set (No_Abort_Statements)
+        and then Restrictions.Set (Max_Asynchronous_Select_Nesting)
+        and then Restrictions.Value (Max_Asynchronous_Select_Nesting) = 0
       then
          return False;
-
       else
          return True;
       end if;
@@ -79,7 +79,7 @@ package body Restrict is
       --  Even in the error case it is a bit dubious, either gigi needs
       --  the table locked or it does not! ???
 
-      if Restrictions (No_Elaboration_Code)
+      if Restrictions.Set (No_Elaboration_Code)
         and then not Suppress_Restriction_Message (N)
       then
          Namet.Unlock;
@@ -110,13 +110,12 @@ package body Restrict is
          declare
             Fnam : constant File_Name_Type :=
                      Get_File_Name (U, Subunit => False);
-            R_Id : Restriction_Id;
 
          begin
             if not Is_Predefined_File_Name (Fnam) then
                return;
 
-            --  Ada child unit spec, needs checking against list
+            --  Predefined spec, needs checking against list
 
             else
                --  Pad name to 8 characters with blanks
@@ -133,30 +132,7 @@ package body Restrict is
                   if Name_Len = 8
                     and then Name_Buffer (1 .. 8) = Unit_Array (J).Filenm
                   then
-                     R_Id := Unit_Array (J).Res_Id;
-                     Violations (R_Id) := True;
-
-                     if Restrictions (R_Id) then
-                        declare
-                           S : constant String := Restriction_Id'Image (R_Id);
-
-                        begin
-                           Error_Msg_Unit_1 := U;
-
-                           Error_Msg_N
-                             ("|dependence on $ not allowed,", N);
-
-                           Name_Buffer (1 .. S'Last) := S;
-                           Name_Len := S'Length;
-                           Set_Casing (All_Lower_Case);
-                           Error_Msg_Name_1 := Name_Enter;
-                           Error_Msg_Sloc := Restrictions_Loc (R_Id);
-
-                           Error_Msg_N
-                             ("\|violates pragma Restriction (%) #", N);
-                           return;
-                        end;
-                     end if;
+                     Check_Restriction (Unit_Array (J).Res_Id, N);
                   end if;
                end loop;
             end if;
@@ -168,192 +144,213 @@ package body Restrict is
    -- Check_Restriction --
    -----------------------
 
-   --  Case of simple identifier (no parameter)
-
-   procedure Check_Restriction (R : Restriction_Id; N : Node_Id) is
+   procedure Check_Restriction
+     (R : Restriction_Id;
+      N : Node_Id;
+      V : Uint := Uint_Minus_1)
+   is
       Rimage : constant String := Restriction_Id'Image (R);
 
-   begin
-      Violations (R) := True;
+      VV : Integer;
+      --  V converted to integer form. If V is greater than Integer'Last,
+      --  it is reset to minus 1 (unknown value).
 
-      if (Restrictions (R) or Restriction_Warnings (R))
-        and then not Suppress_Restriction_Message (N)
-      then
-         --  Output proper message. If this is just a case of
-         --  a restriction warning, then we output a warning msg
+      procedure Update_Restrictions (Info : in out Restrictions_Info);
+      --  Update violation information in Info.Violated and Info.Count
 
-         if not Restrictions (R) then
-            Restriction_Msg
-              ("?violation of restriction %", Rimage, N);
+      -------------------------
+      -- Update_Restrictions --
+      -------------------------
 
-         --  If this is a real restriction violation, then generate
-         --  a non-serious message with appropriate location.
+      procedure Update_Restrictions (Info : in out Restrictions_Info) is
+      begin
+         --  If not violated, set as violated now
 
-         else
-            Error_Msg_Sloc := Restrictions_Loc (R);
+         if not Info.Violated (R) then
+            Info.Violated (R) := True;
+
+            if R in All_Parameter_Restrictions then
+               if VV < 0 then
+                  Info.Unknown (R) := True;
+                  Info.Count (R) := 1;
+               else
+                  Info.Count (R) := VV;
+               end if;
+            end if;
+
+         --  Otherwise if violated already and a parameter restriction,
+         --  update count by maximizing or summing depending on restriction.
+
+         elsif R in All_Parameter_Restrictions then
+
+            --  If new value is unknown, result is unknown
+
+            if VV < 0 then
+               Info.Unknown (R) := True;
 
-            --  If we have a location for the Restrictions pragma, output it
+            --  If checked by maximization, do maximization
 
-            if Error_Msg_Sloc > No_Location
-              or else Error_Msg_Sloc = System_Location
-            then
-               Restriction_Msg
-                 ("|violation of restriction %#", Rimage, N);
+            elsif R in Checked_Max_Parameter_Restrictions then
+               Info.Count (R) := Integer'Max (Info.Count (R), VV);
 
-            --  Otherwise restriction was implicit (e.g. set by another pragma)
+            --  If checked by adding, do add, checking for overflow
+
+            elsif R in Checked_Add_Parameter_Restrictions then
+               declare
+                  pragma Unsuppress (Overflow_Check);
+               begin
+                  Info.Count (R) := Info.Count (R) + VV;
+               exception
+                  when Constraint_Error =>
+                     Info.Count (R) := Integer'Last;
+                     Info.Unknown (R) := True;
+               end;
+
+            --  Should not be able to come here, known counts should only
+            --  occur for restrictions that are Checked_max or Checked_Sum.
 
             else
-               Restriction_Msg
-                 ("|violation of implicit restriction %", Rimage, N);
+               raise Program_Error;
             end if;
          end if;
-      end if;
-   end Check_Restriction;
+      end Update_Restrictions;
 
-   --  Case where a parameter is present, with a count
+   --  Start of processing for Check_Restriction
 
-   procedure Check_Restriction
-     (R : Restriction_Parameter_Id;
-      V : Uint;
-      N : Node_Id)
-   is
    begin
-      if Restriction_Parameters (R) /= No_Uint
-        and then V > Restriction_Parameters (R)
-        and then not Suppress_Restriction_Message (N)
+      if UI_Is_In_Int_Range (V) then
+         VV := Integer (UI_To_Int (V));
+      else
+         VV := -1;
+      end if;
+
+      --  Count can only be specified in the checked val parameter case
+
+      pragma Assert (VV < 0 or else R in Checked_Val_Parameter_Restrictions);
+
+      --  Nothing to do if value of zero specified for parameter restriction
+
+      if VV = 0 then
+         return;
+      end if;
+
+      --  Update current restrictions
+
+      Update_Restrictions (Restrictions);
+
+      --  If in main extended unit, update main restrictions as well
+
+      if Current_Sem_Unit = Main_Unit
+        or else In_Extended_Main_Source_Unit (N)
       then
-         declare
-            S : constant String := Restriction_Parameter_Id'Image (R);
-         begin
-            Name_Buffer (1 .. S'Last) := S;
-            Name_Len := S'Length;
-            Set_Casing (All_Lower_Case);
-            Error_Msg_Name_1 := Name_Enter;
-            Error_Msg_Sloc := Restriction_Parameters_Loc (R);
-            Error_Msg_N ("|maximum value exceeded for restriction %#", N);
-         end;
+         Update_Restrictions (Main_Restrictions);
       end if;
-   end Check_Restriction;
 
-   --  Case where a parameter is present, no count given
+      --  Nothing to do if restriction message suppressed
 
-   procedure Check_Restriction
-     (R : Restriction_Parameter_Id;
-      N : Node_Id)
-   is
-   begin
-      if Restriction_Parameters (R) = Uint_0
-        and then not Suppress_Restriction_Message (N)
+      if Suppress_Restriction_Message (N) then
+         null;
+
+      --  If restriction not set, nothing to do
+
+      elsif not Restrictions.Set (R) then
+         null;
+
+      --  Here if restriction set, check for violation (either this is a
+      --  Boolean restriction, or a parameter restriction with a value of
+      --  zero and an unknown count, or a parameter restriction with a
+      --  known value that exceeds the restriction count).
+
+      elsif R in All_Boolean_Restrictions
+        or else (Restrictions.Unknown (R)
+                   and then Restrictions.Value (R) = 0)
+        or else Restrictions.Count (R) > Restrictions.Value (R)
       then
-         declare
-            S : constant String := Restriction_Parameter_Id'Image (R);
-         begin
-            Name_Buffer (1 .. S'Last) := S;
-            Name_Len := S'Length;
-            Set_Casing (All_Lower_Case);
-            Error_Msg_Name_1 := Name_Enter;
-            Error_Msg_Sloc := Restriction_Parameters_Loc (R);
-            Error_Msg_N ("|maximum value exceeded for restriction %#", N);
-         end;
+         Error_Msg_Sloc := Restrictions_Loc (R);
+
+         --  If we have a location for the Restrictions pragma, output it
+
+         if Error_Msg_Sloc > No_Location
+           or else Error_Msg_Sloc = System_Location
+         then
+            if Restriction_Warnings (R) then
+               Restriction_Msg ("|violation of restriction %#?", Rimage, N);
+            else
+               Restriction_Msg ("|violation of restriction %#", Rimage, N);
+            end if;
+
+         --  Otherwise we have the case of an implicit restriction
+         --  (e.g. a restriction implicitly set by another pragma)
+
+         else
+            Restriction_Msg
+              ("|violation of implicit restriction %", Rimage, N);
+         end if;
       end if;
    end Check_Restriction;
 
-   -------------------------------------------
-   -- Compilation_Unit_Restrictions_Restore --
-   -------------------------------------------
+   ----------------------------------------
+   -- Cunit_Boolean_Restrictions_Restore --
+   ----------------------------------------
 
-   procedure Compilation_Unit_Restrictions_Restore
-     (R : Save_Compilation_Unit_Restrictions)
+   procedure Cunit_Boolean_Restrictions_Restore
+     (R : Save_Cunit_Boolean_Restrictions)
    is
    begin
-      for J in Compilation_Unit_Restrictions loop
-         Restrictions (J) := R (J);
+      for J in Cunit_Boolean_Restrictions loop
+         Restrictions.Set (J) := R (J);
       end loop;
-   end Compilation_Unit_Restrictions_Restore;
+   end Cunit_Boolean_Restrictions_Restore;
 
-   ----------------------------------------
-   -- Compilation_Unit_Restrictions_Save --
-   ----------------------------------------
+   -------------------------------------
+   -- Cunit_Boolean_Restrictions_Save --
+   -------------------------------------
 
-   function Compilation_Unit_Restrictions_Save
-     return Save_Compilation_Unit_Restrictions
+   function Cunit_Boolean_Restrictions_Save
+     return Save_Cunit_Boolean_Restrictions
    is
-      R : Save_Compilation_Unit_Restrictions;
+      R : Save_Cunit_Boolean_Restrictions;
 
    begin
-      for J in Compilation_Unit_Restrictions loop
-         R (J) := Restrictions (J);
-         Restrictions (J) := False;
+      for J in Cunit_Boolean_Restrictions loop
+         R (J) := Restrictions.Set (J);
+         Restrictions.Set (J) := False;
       end loop;
 
       return R;
-   end Compilation_Unit_Restrictions_Save;
+   end Cunit_Boolean_Restrictions_Save;
 
    ------------------------
    -- Get_Restriction_Id --
    ------------------------
 
    function Get_Restriction_Id
-     (N    : Name_Id)
-      return Restriction_Id
+     (N : Name_Id) return Restriction_Id
    is
-      J : Restriction_Id;
-
    begin
       Get_Name_String (N);
       Set_Casing (All_Upper_Case);
 
-      J := Restriction_Id'First;
-      while J /= Not_A_Restriction_Id loop
+      for J in All_Restrictions loop
          declare
             S : constant String := Restriction_Id'Image (J);
-
          begin
-            exit when S = Name_Buffer (1 .. Name_Len);
+            if S = Name_Buffer (1 .. Name_Len) then
+               return J;
+            end if;
          end;
-
-         J := Restriction_Id'Succ (J);
       end loop;
 
-      return J;
+      return Not_A_Restriction_Id;
    end Get_Restriction_Id;
 
-   ----------------------------------
-   -- Get_Restriction_Parameter_Id --
-   ----------------------------------
-
-   function Get_Restriction_Parameter_Id
-     (N    : Name_Id)
-      return Restriction_Parameter_Id
-   is
-      J : Restriction_Parameter_Id;
-
-   begin
-      Get_Name_String (N);
-      Set_Casing (All_Upper_Case);
-
-      J := Restriction_Parameter_Id'First;
-      while J /= Not_A_Restriction_Parameter_Id loop
-         declare
-            S : constant String := Restriction_Parameter_Id'Image (J);
-
-         begin
-            exit when S = Name_Buffer (1 .. Name_Len);
-         end;
-
-         J := Restriction_Parameter_Id'Succ (J);
-      end loop;
-
-      return J;
-   end Get_Restriction_Parameter_Id;
-
    -------------------------------
    -- No_Exception_Handlers_Set --
    -------------------------------
 
    function No_Exception_Handlers_Set return Boolean is
    begin
-      return Restrictions (No_Exception_Handlers);
+      return Restrictions.Set (No_Exception_Handlers);
    end No_Exception_Handlers_Set;
 
    ------------------------
@@ -364,24 +361,37 @@ package body Restrict is
 
    function Restricted_Profile return Boolean is
    begin
-      return     Restrictions (No_Abort_Statements)
-        and then Restrictions (No_Asynchronous_Control)
-        and then Restrictions (No_Entry_Queue)
-        and then Restrictions (No_Task_Hierarchy)
-        and then Restrictions (No_Task_Allocators)
-        and then Restrictions (No_Dynamic_Priorities)
-        and then Restrictions (No_Terminate_Alternatives)
-        and then Restrictions (No_Dynamic_Interrupts)
-        and then Restrictions (No_Protected_Type_Allocators)
-        and then Restrictions (No_Local_Protected_Objects)
-        and then Restrictions (No_Requeue)
-        and then Restrictions (No_Task_Attributes)
-        and then Restriction_Parameters (Max_Asynchronous_Select_Nesting) =  0
-        and then Restriction_Parameters (Max_Task_Entries)                =  0
-        and then Restriction_Parameters (Max_Protected_Entries)           <= 1
-        and then Restriction_Parameters (Max_Select_Alternatives)         =  0;
+      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_Interrupts)
+        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)
+        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;
    end Restricted_Profile;
 
+   ------------------------
+   -- Restriction_Active --
+   ------------------------
+
+   function Restriction_Active (R : All_Restrictions) return Boolean is
+   begin
+      return Restrictions.Set (R);
+   end Restriction_Active;
+
    ---------------------
    -- Restriction_Msg --
    ---------------------
@@ -430,25 +440,15 @@ package body Restrict is
    -------------------
 
    procedure Set_Ravenscar (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc (N);
-
    begin
       Set_Restricted_Profile (N);
-      Restrictions (Boolean_Entry_Barriers)       := True;
-      Restrictions (No_Select_Statements)         := True;
-      Restrictions (No_Calendar)                  := True;
-      Restrictions (No_Entry_Queue)               := True;
-      Restrictions (No_Relative_Delay)            := True;
-      Restrictions (No_Task_Termination)          := True;
-      Restrictions (No_Implicit_Heap_Allocations) := True;
-
-      Restrictions_Loc (Boolean_Entry_Barriers)       := Loc;
-      Restrictions_Loc (No_Select_Statements)         := Loc;
-      Restrictions_Loc (No_Calendar)                  := Loc;
-      Restrictions_Loc (No_Entry_Queue)               := Loc;
-      Restrictions_Loc (No_Relative_Delay)            := Loc;
-      Restrictions_Loc (No_Task_Termination)          := Loc;
-      Restrictions_Loc (No_Implicit_Heap_Allocations) := Loc;
+      Set_Restriction (Boolean_Entry_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;
 
    ----------------------------
@@ -458,43 +458,107 @@ package body Restrict is
    --  This must be coordinated with Restricted_Profile
 
    procedure Set_Restricted_Profile (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc (N);
+   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_Interrupts,        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,           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;
+
+   ---------------------
+   -- Set_Restriction --
+   ---------------------
+
+   --  Case of Boolean restriction
 
+   procedure Set_Restriction
+     (R : All_Boolean_Restrictions;
+      N : Node_Id)
+   is
    begin
-      Restrictions (No_Abort_Statements)          := True;
-      Restrictions (No_Asynchronous_Control)      := True;
-      Restrictions (No_Entry_Queue)               := True;
-      Restrictions (No_Task_Hierarchy)            := True;
-      Restrictions (No_Task_Allocators)           := True;
-      Restrictions (No_Dynamic_Priorities)        := True;
-      Restrictions (No_Terminate_Alternatives)    := True;
-      Restrictions (No_Dynamic_Interrupts)        := True;
-      Restrictions (No_Protected_Type_Allocators) := True;
-      Restrictions (No_Local_Protected_Objects)   := True;
-      Restrictions (No_Requeue)                   := True;
-      Restrictions (No_Task_Attributes)           := True;
-
-      Restrictions_Loc (No_Abort_Statements)          := Loc;
-      Restrictions_Loc (No_Asynchronous_Control)      := Loc;
-      Restrictions_Loc (No_Entry_Queue)               := Loc;
-      Restrictions_Loc (No_Task_Hierarchy)            := Loc;
-      Restrictions_Loc (No_Task_Allocators)           := Loc;
-      Restrictions_Loc (No_Dynamic_Priorities)        := Loc;
-      Restrictions_Loc (No_Terminate_Alternatives)    := Loc;
-      Restrictions_Loc (No_Dynamic_Interrupts)        := Loc;
-      Restrictions_Loc (No_Protected_Type_Allocators) := Loc;
-      Restrictions_Loc (No_Local_Protected_Objects)   := Loc;
-      Restrictions_Loc (No_Requeue)                   := Loc;
-      Restrictions_Loc (No_Task_Attributes)           := Loc;
-
-      Restriction_Parameters (Max_Asynchronous_Select_Nesting) := Uint_0;
-      Restriction_Parameters (Max_Task_Entries)                := Uint_0;
-      Restriction_Parameters (Max_Select_Alternatives)         := Uint_0;
-
-      if Restriction_Parameters (Max_Protected_Entries) /= Uint_0 then
-         Restriction_Parameters (Max_Protected_Entries) := Uint_1;
+      Restrictions.Set (R) := True;
+
+      --  Set location, but preserve location of system
+      --  restriction for nice error msg with run time name
+
+      if Restrictions_Loc (R) /= System_Location then
+         Restrictions_Loc (R) := Sloc (N);
       end if;
-   end Set_Restricted_Profile;
+
+      --  Record the restriction if we are in the main unit,
+      --  or in the extended main unit. The reason that we
+      --  test separately for Main_Unit is that gnat.adc is
+      --  processed with Current_Sem_Unit = Main_Unit, but
+      --  nodes in gnat.adc do not appear to be the extended
+      --  main source unit (they probably should do ???)
+
+      if Current_Sem_Unit = Main_Unit
+        or else In_Extended_Main_Source_Unit (N)
+      then
+         if not Restriction_Warnings (R) then
+            Main_Restrictions.Set (R) := True;
+         end if;
+      end if;
+   end Set_Restriction;
+
+   --  Case of parameter restriction
+
+   procedure Set_Restriction
+     (R : All_Parameter_Restrictions;
+      N : Node_Id;
+      V : Integer)
+   is
+   begin
+      if Restrictions.Set (R) then
+         if V < Restrictions.Value (R) then
+            Restrictions.Value (R) := V;
+            Restrictions_Loc (R) := Sloc (N);
+         end if;
+
+      else
+         Restrictions.Set (R) := True;
+         Restrictions.Value (R) := V;
+         Restrictions_Loc (R) := Sloc (N);
+      end if;
+
+      --  Record the restriction if we are in the main unit,
+      --  or in the extended main unit. The reason that we
+      --  test separately for Main_Unit is that gnat.adc is
+      --  processed with Current_Sem_Unit = Main_Unit, but
+      --  nodes in gnat.adc do not appear to be the extended
+      --  main source unit (they probably should do ???)
+
+      if Current_Sem_Unit = Main_Unit
+        or else In_Extended_Main_Source_Unit (N)
+      then
+         if Main_Restrictions.Set (R) then
+            if V < Main_Restrictions.Value (R) then
+               Main_Restrictions.Value (R) := V;
+            end if;
+
+         elsif not Restriction_Warnings (R) then
+            Main_Restrictions.Set (R) := True;
+            Main_Restrictions.Value (R) := V;
+         end if;
+      end if;
+   end Set_Restriction;
 
    ----------------------------------
    -- Suppress_Restriction_Message --
@@ -525,8 +589,9 @@ package body Restrict is
 
    function Tasking_Allowed return Boolean is
    begin
-      return Restriction_Parameters (Max_Tasks) /= 0
-        and then not Restrictions (No_Tasking);
+      return not Restrictions.Set (No_Tasking)
+        and then (not Restrictions.Set (Max_Tasks)
+                    or else Restrictions.Value (Max_Tasks) > 0);
    end Tasking_Allowed;
 
 end Restrict;