a-dispat.ads, [...]: New files.

2006-10-31  Robert Dewar  <dewar@adacore.com>
	    Jose Ruiz  <ruiz@adacore.com>

	* a-dispat.ads, a-diroro.ads, a-diroro.adb: New files.

	* ali.adb (Get_Name): Properly handle scanning of wide character names
	encoded with brackets notation.
	(Known_ALI_Lines): Add S lines to this list.
	(Scan_ALI): Acquire S (priority specific dispatching) lines.
	New flag Elaborate_All_Desirable in unit table

	* ali.ads (Priority_Specific_Dispatching): Add this range of
	identifiers to be used for Priority_Specific_Dispatching table entries.
	(ALIs_Record): Add First_Specific_Dispatching and
	Last_Specific_Dispatching that point to the first and last entries
	respectively in the priority specific dispatching table for this unit.
	(Specific_Dispatching): Add this table for storing each S (priority
	specific dispatching) line encountered in the input ALI file.
	New flag Elaborate_All_Desirable in unit table

	* bcheck.adb: (Check_Configuration_Consistency): Add call to
	Check_Consistent_Dispatching_Policy.
	(Check_Consistent_Dispatching_Policy): Add this procedure in charge of
	verifying that the use of Priority_Specific_Dispatching,
	Task_Dispatching_Policy, and Locking_Policy is consistent across the
	partition.

	* bindgen.adb: (Public_Version_Warning): function removed.
	(Set_PSD_Pragma_Table): Add this procedure in charge of getting the
	required information from ALI files in order to initialize the table
	containing the specific dispatching policy.
	(Gen_Adainit_Ada): Generate the variables required for priority specific
	dispatching entries (__gl_priority_specific_dispatching and
	__gl_num_specific_dispatching).
	(Gen_Adainit_C): Generate the variables required for priority specific
	dispatching entries (__gl_priority_specific_dispatching and
	__gl_num_specific_dispatching).
	(Gen_Output_File): Acquire settings for Priority_Specific_Dispatching
	pragma entries.
	(Gen_Restrictions_String_1, Gen_Restrictions_String_2): Removed.
	(Gen_Restrictions_Ada, Gen_Restrictions_C, Set_Boolean): New procedures.
	(Tab_To): Removed.
	(Gen_Output_File_Ada/_C): Set directly __gl_xxx variables instead of
	a call to gnat_set_globals.
	Generate a string containing settings from
	Priority_Specific_Dispatching pragma entries.
	(Gen_Object_Files_Options): Do not include the runtime libraries when
	pragma No_Run_Time is specified.

	* init.c (__gnat_install_handler, case FreeBSD): Use SA_SIGINFO, for
	consistency with s-intman-posix.adb.
	(__gnat_error_handler, case FreeBSD): Account for the fact that the
	handler is installed with SA_SIGINFO.
	(__gnat_adjust_context_for_raise, FreeBSD case): New function for
	FreeBSD ZCX support, copied from Linux version.
	Add MaRTE-specific definitions for the linux target. Redefine sigaction,
	sigfillset, and sigemptyset so the routines defined by MaRTE.
	(__gl_priority_specific_dispatching): Add this variable that stores the
	string containing priority specific dispatching policies in the
	partition.
	(__gl_num_specific_dispatching): Add this variable that indicates the
	highest priority for which a priority specific dispatching pragma
	applies.
	(__gnat_get_specific_dispatching): Add this routine that returns the
	priority specific dispatching policy, as set by a
	Priority_Specific_Dispatching pragma appearing anywhere in the current
	partition. The input argument is the priority number, and the result
	is the upper case first character of the policy name.
	(__gnat_set_globals): Now a dummy function.
	(__gnat_handle_vms_condition): Feed adjust_context_for_raise with
	mechargs instead of sigargs, as the latter can be retrieved from the
	former and sigargs is not what we want on ia64.
	(__gnat_adjust_context_for_raise, alpha-vms): Fetch sigargs from the
	mechargs argument.
	(__gnat_adjust_context_for_raise, ia64-vms): New function.
	(tasking_error): Remove unused symbol.
	(_abort_signal): Move this symbol to the IRIX specific part since this
	is the only target that uses this definition.
	(Check_Abort_Status): Move this symbol to the IRIX specific part since
	this is the only target that uses this definition.
	(Lock_Task): Remove unused symbol.
	(Unlock_Task): Remove unused symbol.

	* lib-writ.adb (Write_ALI): Output new S lines for
	Priority_Specific_Dispatching pragmas.
	Implement new flag BD for elaborate body desirable

	* lib-writ.ads: Document S lines for Priority Specific Dispatching.
	(Specific_Dispatching): Add this table for storing the entries
	corresponding to Priority_Specific_Dispatching pragmas.
	Document new BD flag for elaborate body desirable

	* par-prag.adb (Prag): Add Priority_Specific_Dispatching to the list
	of known pragmas.

From-SVN: r118243

gcc/ada/a-diroro.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--          A D A . D I S P A T C H I N G . R O U N D _ R O B I N           --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--            Copyright (C) 2006, 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 2,  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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body Ada.Dispatching.Round_Robin is
+
+   -----------------
+   -- Set_Quantum --
+   -----------------
+
+   procedure Set_Quantum
+     (Pri     : System.Priority;
+      Quantum : Ada.Real_Time.Time_Span)
+   is
+      pragma Unreferenced (Quantum);
+   begin
+      if not Is_Round_Robin (Pri) then
+         raise Dispatching_Policy_Error;
+      end if;
+   end Set_Quantum;
+
+   -----------------
+   -- Set_Quantum --
+   -----------------
+
+   procedure Set_Quantum
+     (Low, High : System.Priority;
+      Quantum   : Ada.Real_Time.Time_Span)
+   is
+      pragma Unreferenced (Quantum);
+   begin
+      for Index in Low .. High loop
+         if not Is_Round_Robin (Index) then
+            raise Dispatching_Policy_Error;
+         end if;
+      end loop;
+   end Set_Quantum;
+
+   --------------------
+   -- Actual_Quantum --
+   --------------------
+
+   function Actual_Quantum
+     (Pri : System.Priority) return Ada.Real_Time.Time_Span
+   is
+   begin
+      if Is_Round_Robin (Pri) then
+         return Default_Quantum;
+      else
+         raise Dispatching_Policy_Error;
+      end if;
+   end Actual_Quantum;
+
+   --------------------
+   -- Is_Round_Robin --
+   --------------------
+
+   function Is_Round_Robin (Pri : System.Priority) return Boolean is
+      function Get_Policy (Prio : System.Any_Priority) return Character;
+      pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching");
+   begin
+      return Get_Policy (Pri) = 'R';
+   end Is_Round_Robin;
+
+end Ada.Dispatching.Round_Robin;

gcc/ada/a-diroro.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--          A D A . D I S P A T C H I N G . R O U N D _ R O B I N           --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--                                                                          --
+-- This specification is adapted 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. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System;
+with Ada.Real_Time;
+
+package Ada.Dispatching.Round_Robin is
+
+   Default_Quantum : constant Ada.Real_Time.Time_Span :=
+                       Ada.Real_Time.Milliseconds (10);
+
+   procedure Set_Quantum
+     (Pri     : System.Priority;
+      Quantum : Ada.Real_Time.Time_Span);
+
+   procedure Set_Quantum
+     (Low, High : System.Priority;
+      Quantum   : Ada.Real_Time.Time_Span);
+
+   function Actual_Quantum
+     (Pri : System.Priority) return Ada.Real_Time.Time_Span;
+
+   function Is_Round_Robin (Pri : System.Priority) return Boolean;
+
+end Ada.Dispatching.Round_Robin;

gcc/ada/a-dispat.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                       A D A . D I S P A T C H I N G                      --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--                                                                          --
+-- This specification is adapted 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. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package Ada.Dispatching is
+   pragma Pure (Dispatching);
+
+   Dispatching_Policy_Error : exception;
+end Ada.Dispatching;

gcc/ada/ali.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -67,6 +67,9 @@ package ALI is
    type Interrupt_State_Id is range 6_000_000 .. 6_999_999;
    --  Id values used for Interrupt_State table entries
 
+   type Priority_Specific_Dispatching_Id is range 7_000_000 .. 7_999_999;
+   --  Id values used for Priority_Specific_Dispatching table entries
+
    --------------------
    -- ALI File Table --
    --------------------
@@ -196,6 +199,14 @@ package ALI is
       --  the lower bound of the subtype).
       --  Not set if 'I' appears in Ignore_Lines
 
+      First_Specific_Dispatching : Priority_Specific_Dispatching_Id;
+      Last_Specific_Dispatching  : Priority_Specific_Dispatching_Id'Base;
+      --  These point to the first and last entries in the priority specific
+      --  dispatching table for this unit. If there are no entries, then
+      --  Last_Specific_Dispatching = First_Specific_Dispatching - 1. That
+      --  is why the 'Base reference is there, it can be one less than the
+      --  lower bound of the subtype. Not set if 'S' appears in Ignore_Lines.
+
    end record;
 
    No_Main_Priority : constant Int := -1;
@@ -338,6 +349,14 @@ package ALI is
       Body_Needed_For_SAL : Boolean;
       --  Indicates that the source for the body of the unit (subprogram,
       --  package, or generic unit) must be included in a standalone library.
+
+      Elaborate_Body_Desirable : Boolean;
+      --  Indicates that the front end elaboration circuitry decided that it
+      --  would be a good idea if this package had Elaborate_Body. The binder
+      --  will attempt, but does not promise, to place the elaboration call
+      --  for the body right after the call for the spec, or at least as close
+      --  together as possible.
+
    end record;
 
    package Units is new Table.Table (
@@ -376,6 +395,40 @@ package ALI is
      Table_Increment      => 200,
      Table_Name           => "Interrupt_States");
 
+   -----------------------------------------
+   -- Priority Specific Dispatching Table --
+   -----------------------------------------
+
+   --  An entry is made in this table for each S (priority specific
+   --  dispatching) line encountered in the input ALI file. The
+   --  First/Last_Specific_Dispatching_Id fields of the ALI file
+   --  entry show the range of entries defined within a particular
+   --  ALI file.
+
+   type Specific_Dispatching_Record is record
+      Dispatching_Policy : Character;
+      --  First character (upper case) of the corresponding policy name
+
+      First_Priority     : Nat;
+      --  Lower bound of the priority range to which the specified dispatching
+      --  policy applies.
+
+      Last_Priority      : Nat;
+      --  Upper bound of the priority range to which the specified dispatching
+      --  policy applies.
+
+      PSD_Pragma_Line : Nat;
+      --  Line number of Priority_Specific_Dispatching pragma
+   end record;
+
+   package Specific_Dispatching is new Table.Table (
+     Table_Component_Type => Specific_Dispatching_Record,
+     Table_Index_Type     => Priority_Specific_Dispatching_Id'Base,
+     Table_Low_Bound      => Priority_Specific_Dispatching_Id'First,
+     Table_Initial        => 100,
+     Table_Increment      => 200,
+     Table_Name           => "Priority_Specific_Dispatching");
+
    --------------
    -- Switches --
    --------------
@@ -418,7 +471,7 @@ package ALI is
    --  Set to blank by Initialize_ALI. Set to the appropriate queuing policy
    --  character if an ali file contains a P line setting the queuing policy.
 
-   Cumulative_Restrictions : Restrictions_Info;
+   Cumulative_Restrictions : Restrictions_Info := No_Restrictions;
    --  This variable records the cumulative contributions of R lines in all
    --  ali files, showing whether a restriction pragma exists anywhere, and
    --  accumulating the aggregate knowledge of violations.

gcc/ada/lib-writ.adb

@@ -354,6 +354,16 @@ package body Lib.Writ is
          Write_Info_Tab (49);
          Write_Info_Str (Version_Get (Unit_Num));
 
+         --  Add BD parameter if Elaborate_Body pragma desirable
+
+         if Ekind (Uent) = E_Package
+           and then Elaborate_Body_Desirable (Uent)
+         then
+            Write_Info_Str (" BD");
+         end if;
+
+         --  Add BN parameter if body needed for SAL
+
          if (Is_Subprogram (Uent)
               or else Ekind (Uent) = E_Package
               or else Is_Generic_Unit (Uent))
@@ -1050,6 +1060,23 @@ package body Lib.Writ is
          Write_Info_EOL;
       end loop;
 
+      --  Output priority specific dispatching lines
+
+      for J in Specific_Dispatching.First .. Specific_Dispatching.Last loop
+         Write_Info_Initiate ('S');
+         Write_Info_Char (' ');
+         Write_Info_Char (Specific_Dispatching.Table (J).Dispatching_Policy);
+         Write_Info_Char (' ');
+         Write_Info_Nat (Specific_Dispatching.Table (J).First_Priority);
+         Write_Info_Char (' ');
+         Write_Info_Nat (Specific_Dispatching.Table (J).Last_Priority);
+         Write_Info_Char (' ');
+         Write_Info_Nat
+           (Nat (Get_Logical_Line_Number
+                   (Specific_Dispatching.Table (J).Pragma_Loc)));
+         Write_Info_EOL;
+      end loop;
+
       --  Loop through file table to output information for all units for which
       --  we have generated code, as marked by the Generate_Code flag.
 

gcc/ada/lib-writ.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -368,6 +368,26 @@ package Lib.Writ is
    --      line number of the corresponding Interrupt_State pragma.
    --      This is used in consistency messages.
 
+   --  -------------------------------------
+   --  -- S Priority Specific Dispatching --
+   --  -------------------------------------
+
+   --    S policy_identifier first_priority last_priority line-number
+
+   --      This line records information from a Priority_Specific_Dispatching
+   --      pragma. There is one line for each separate pragma, and if no such
+   --      pragmas are used, then no S lines are present.
+
+   --      The policy_identifier is the first character (upper case) of the
+   --      corresponding policy name (e.g. 'F' for FIFO_Within_Priorities).
+
+   --      The first_priority and last_priority fields define the range of
+   --      priorities to which the specified dispatching policy apply.
+
+   --      The line number is an unsigned decimal integer giving the
+   --      line number of the corresponding Priority_Specific_Dispatching
+   --      pragma. This is used in consistency messages.
+
    ----------------------------
    -- Compilation Unit Lines --
    ----------------------------
@@ -403,6 +423,14 @@ package Lib.Writ is
    --      The <<attributes>> are a series of two letter codes indicating
    --      information about the unit:
    --
+   --         BD  Unit does not have pragma Elaborate_Body, but the elaboration
+   --             circuit has determined that it would be a good idea if this
+   --             pragma were present, since the body of the package contains
+   --             elaboration code that modifies one or more variables in the
+   --             visible part of the package. The binder will try, but does
+   --             not promise, to keep the elaboration of the body close to
+   --             the elaboration of the spec.
+   --
    --         DE  Dynamic Elaboration. This unit was compiled with the
    --             dynamic elaboration model, as set by either the -gnatE
    --             switch or pragma Elaboration_Checks (Dynamic).
@@ -643,6 +671,36 @@ package Lib.Writ is
      Table_Increment      => 200,
      Table_Name           => "Name_Interrupt_States");
 
+   --  The table structure defined here stores one entry for each
+   --  Priority_Specific_Dispatching pragma encountered either in the main
+   --  source or in an ancillary with'ed source. Since
+   --  have to be consistent across all units in a partition, we may
+   --  as well detect inconsistencies at compile time when we can.
+
+   type Specific_Dispatching_Entry is record
+      Dispatching_Policy : Character;
+      --  First character (upper case) of the corresponding policy name
+
+      First_Priority     : Nat;
+      --  Lower bound of the priority range to which the specified dispatching
+      --  policy applies.
+
+      Last_Priority      : Nat;
+      --  Upper bound of the priority range to which the specified dispatching
+      --  policy applies.
+
+      Pragma_Loc         : Source_Ptr;
+      --  Location of pragma setting this value in place
+   end record;
+
+   package Specific_Dispatching is new Table.Table (
+     Table_Component_Type => Specific_Dispatching_Entry,
+     Table_Index_Type     => Nat,
+     Table_Low_Bound      => 1,
+     Table_Initial        => 10,
+     Table_Increment      => 100,
+     Table_Name           => "Name_Priority_Specific_Dispatching");
+
    -----------------
    -- Subprograms --
    -----------------