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.



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

1 files changed, 511 insertions, 376 deletions

diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 0b595fe044c..b8718a69756 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -24,24 +24,24 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with ALI;         use ALI;
-with Binde;       use Binde;
-with Casing;      use Casing;
-with Fname;       use Fname;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-with Gnatvsn;     use Gnatvsn;
+with ALI;      use ALI;
+with Binde;    use Binde;
+with Casing;   use Casing;
+with Fname;    use Fname;
+with Gnatvsn;  use Gnatvsn;
 with Hostparm;
-with Namet;       use Namet;
-with Opt;         use Opt;
-with Osint;       use Osint;
-with Osint.B;     use Osint.B;
-with Output;      use Output;
-with Rident;      use Rident;
-with Table;       use Table;
-with Targparm;    use Targparm;
-with Types;       use Types;
-
-with GNAT.Heap_Sort_A;     use GNAT.Heap_Sort_A;
+with Namet;    use Namet;
+with Opt;      use Opt;
+with Osint;    use Osint;
+with Osint.B;  use Osint.B;
+with Output;   use Output;
+with Rident;   use Rident;
+with Table;    use Table;
+with Targparm; use Targparm;
+with Types;    use Types;
+
+with GNAT.OS_Lib;      use GNAT.OS_Lib;
+with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
 
 package body Bindgen is
 
@@ -79,28 +79,43 @@ package body Bindgen is
      Table_Increment      => 200,
      Table_Name           => "IS_Pragma_Settings");
 
+   --  This table assembles the Priority_Specific_Dispatching pragma
+   --  information from all the units in the partition. Note that Bcheck has
+   --  already checked that the information is consistent across partitions.
+   --  The entries in this table are the upper case first character of the
+   --  policy name, e.g. 'F' for FIFO_Within_Priorities.
+
+   package PSD_Pragma_Settings is new Table.Table (
+     Table_Component_Type => Character,
+     Table_Index_Type     => Int,
+     Table_Low_Bound      => 0,
+     Table_Initial        => 100,
+     Table_Increment      => 200,
+     Table_Name           => "PSD_Pragma_Settings");
+
    ----------------------
    -- Run-Time Globals --
    ----------------------
 
-   --  This section documents the global variables that are passed to the
-   --  run time from the generated binder file. The call that is made is
-   --  to the routine Set_Globals, which has the following spec:
-
-   --   procedure Set_Globals
-   --     (Main_Priority            : Integer;
-   --      Time_Slice_Value         : Integer;
-   --      WC_Encoding              : Character;
-   --      Locking_Policy           : Character;
-   --      Queuing_Policy           : Character;
-   --      Task_Dispatching_Policy  : Character;
-   --      Restrictions             : System.Address;
-   --      Interrupt_States         : System.Address;
-   --      Num_Interrupt_States     : Integer;
-   --      Unreserve_All_Interrupts : Integer;
-   --      Exception_Tracebacks     : Integer;
-   --      Zero_Cost_Exceptions     : Integer;
-   --      Detect_Blocking          : Integer);
+   --  This section documents the global variables that set from the
+   --  generated binder file.
+
+   --     Main_Priority                 : Integer;
+   --     Time_Slice_Value              : Integer;
+   --     WC_Encoding                   : Character;
+   --     Locking_Policy                : Character;
+   --     Queuing_Policy                : Character;
+   --     Task_Dispatching_Policy       : Character;
+   --     Priority_Specific_Dispatching : System.Address;
+   --     Num_Specific_Dispatching      : Integer;
+   --     Restrictions                  : System.Address;
+   --     Interrupt_States              : System.Address;
+   --     Num_Interrupt_States          : Integer;
+   --     Unreserve_All_Interrupts      : Integer;
+   --     Exception_Tracebacks          : Integer;
+   --     Zero_Cost_Exceptions          : Integer;
+   --     Detect_Blocking               : Integer;
+   --     Default_Stack_Size            : Integer;
 
    --  Main_Priority is the priority value set by pragma Priority in the
    --  main program. If no such pragma is present, the value is -1.
@@ -131,6 +146,20 @@ package body Bindgen is
    --  was specified, the value is the upper case first character of
    --  the policy name, e.g. 'F' for FIFO_Within_Priorities.
 
+   --  Priority_Specific_Dispatching is the address of a string used to
+   --  store the task dispatching policy specified for the different priorities
+   --  in the partition. The length of this string is determined by the last
+   --  priority for which such a pragma applies (the string will be a null
+   --  string if no specific dispatching policies were used). If pragma were
+   --  present, the entries apply to the priorities in sequence from the first
+   --  priority. The value stored is the upper case first character of the
+   --  policy name, or 'F' (for FIFO_Within_Priorities) as the default value
+   --  for those priority ranges not specified.
+
+   --  Num_Specific_Dispatching is the length of the
+   --  Priority_Specific_Dispatching string. It will be set to zero if no
+   --  Priority_Specific_Dispatching pragmas are present.
+
    --  Restrictions is the address of a null-terminated string specifying the
    --  restrictions information for the partition. The format is identical to
    --  that of the parameter string found on R lines in ali files (see Lib.Writ
@@ -167,6 +196,9 @@ package body Bindgen is
    --  present, while a value of 1 signals its presence in the
    --  partition.
 
+   --  Default_Stack_Size is the default stack size used when creating an
+   --  Ada task with no explicit Storize_Size clause.
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -218,15 +250,11 @@ package body Bindgen is
    procedure Gen_Output_File_C (Filename : String);
    --  Generate output file (C code case)
 
-   procedure Gen_Restrictions_String_1;
-   --  Generate first restrictions string, which consists of the parameters
-   --  the first R line, as described in lib-writ.ads, with the restrictions
-   --  being those for the entire partition (from Cumulative_Restrictions).
+   procedure Gen_Restrictions_Ada;
+   --  Generate initialization of restrictions variable (Ada code case)
 
-   procedure Gen_Restrictions_String_2;
-   --  Generate first restrictions string, which consists of the parameters
-   --  the second R line, as described in lib-writ.ads, with the restrictions
-   --  being those for the entire partition (from Cumulative_Restrictions).
+   procedure Gen_Restrictions_C;
+   --  Generate initialization of restrictions variable (C code case)
 
    procedure Gen_Versions_Ada;
    --  Output series of definitions for unit versions (Ada code case)
@@ -256,10 +284,6 @@ package body Bindgen is
    procedure Move_Linker_Option (From : Natural; To : Natural);
    --  Move routine for sorting linker options
 
-   procedure Public_Version_Warning;
-   --  Emit a warning concerning the use of the Public version under
-   --  certain circumstances. See details in body.
-
    procedure Resolve_Binder_Options;
    --  Set the value of With_GNARL and With_DECGNAT. The latter only on VMS
    --  since it tests for a package named "dec" which might cause a conflict
@@ -274,6 +298,10 @@ package body Bindgen is
    --  starting at the Last + 1 position, and updating Last past the value.
    --  A minus sign is output for a negative value.
 
+   procedure Set_Boolean (B : Boolean);
+   --  Set given boolean value in Statement_Buffer at the Last + 1 position
+   --  and update Last past the value.
+
    procedure Set_IS_Pragma_Table;
    --  Initializes contents of IS_Pragma_Settings table from ALI table
 
@@ -285,6 +313,9 @@ package body Bindgen is
    procedure Set_Name_Buffer;
    --  Set the value stored in positions 1 .. Name_Len of the Name_Buffer
 
+   procedure Set_PSD_Pragma_Table;
+   --  Initializes contents of PSD_Pragma_Settings table from ALI table
+
    procedure Set_String (S : String);
    --  Sets characters of given string in Statement_Buffer, starting at the
    --  Last + 1 position, and updating last past the string value.
@@ -299,10 +330,6 @@ package body Bindgen is
    --  up all output unit numbers nicely as required by the value, and
    --  by the total number of units.
 
-   procedure Tab_To (N : Natural);
-   --  If Last is greater than or equal to N, no effect, otherwise store
-   --  blanks in Statement_Buffer bumping Last, until Last = N.
-
    procedure Write_Info_Ada_C (Ada : String; C : String; Common : String);
    --  For C code case, write C & Common, for Ada case write Ada & Common
    --  to current binder output file using Write_Binder_Info.
@@ -432,7 +459,7 @@ package body Bindgen is
 
       --  If the standard library is suppressed, then the only global variable
       --  that might be needed (by the Ravenscar profile) is the priority of
-      --  the environment. Also no exception tables are needed.
+      --  the environment.
 
       if Suppress_Standard_Library_On_Target then
          if Main_Priority /= No_Main_Priority then
@@ -454,78 +481,59 @@ package body Bindgen is
             WBI ("      null;");
          end if;
 
-      --  Normal case (standard library not suppressed). Global values are
-      --  assigned using the runtime routine Set_Globals (we have to use
-      --  the routine call, rather than define the globals in the binder
-      --  file to deal with cross-library calls in some systems.
+      --  Normal case (standard library not suppressed). Set all global values
+      --  used by the run time.
 
       else
-         --  Generate restrictions string
-
-         Set_String ("      Restrictions : constant String :=");
-         Write_Statement_Buffer;
-
-         Set_String ("        """);
-         Gen_Restrictions_String_1;
-         Set_String (""" &");
-         Write_Statement_Buffer;
-
-         Set_String ("        """);
-         Gen_Restrictions_String_2;
-         Set_String (""" & ASCII.Nul;");
-         Write_Statement_Buffer;
-         WBI ("");
-
-         --  Generate Interrupt_State pragma string
+         WBI ("      Main_Priority : Integer;");
+         WBI ("      pragma Import (C, Main_Priority, " &
+              """__gl_main_priority"");");
+         WBI ("      Time_Slice_Value : Integer;");
+         WBI ("      pragma Import (C, Time_Slice_Value, " &
+              """__gl_time_slice_val"");");
+         WBI ("      WC_Encoding : Character;");
+         WBI ("      pragma Import (C, WC_Encoding, ""__gl_wc_encoding"");");
+         WBI ("      Locking_Policy : Character;");
+         WBI ("      pragma Import (C, Locking_Policy, " &
+              """__gl_locking_policy"");");
+         WBI ("      Queuing_Policy : Character;");
+         WBI ("      pragma Import (C, Queuing_Policy, " &
+              """__gl_queuing_policy"");");
+         WBI ("      Task_Dispatching_Policy : Character;");
+         WBI ("      pragma Import (C, Task_Dispatching_Policy, " &
+              """__gl_task_dispatching_policy"");");
+         WBI ("      Priority_Specific_Dispatching : System.Address;");
+         WBI ("      pragma Import (C, Priority_Specific_Dispatching, " &
+              """__gl_priority_specific_dispatching"");");
+         WBI ("      Num_Specific_Dispatching : Integer;");
+         WBI ("      pragma Import (C, Num_Specific_Dispatching, " &
+              """__gl_num_specific_dispatching"");");
+
+         WBI ("      Interrupt_States : System.Address;");
+         WBI ("      pragma Import (C, Interrupt_States, " &
+              """__gl_interrupt_states"");");
+         WBI ("      Num_Interrupt_States : Integer;");
+         WBI ("      pragma Import (C, Num_Interrupt_States, " &
+              """__gl_num_interrupt_states"");");
+         WBI ("      Unreserve_All_Interrupts : Integer;");
+         WBI ("      pragma Import (C, Unreserve_All_Interrupts, " &
+              """__gl_unreserve_all_interrupts"");");
 
-         Set_String ("      Interrupt_States : constant String :=");
-         Write_Statement_Buffer;
-
-         declare
-            Col : Natural;
-
-         begin
-            Set_String ("        """);
-            Col := 9;
-
-            for J in 0 .. IS_Pragma_Settings.Last loop
-               if Col > 72 then
-                  Set_String (""" &");
-                  Write_Statement_Buffer;
-                  Set_String ("        """);
-                  Col := 9;
-
-               else
-                  Col := Col + 1;
-               end if;
-
-               Set_Char (IS_Pragma_Settings.Table (J));
-            end loop;
-         end;
-
-         Set_String (""";");
-         Write_Statement_Buffer;
-         WBI ("");
+         if Exception_Tracebacks then
+            WBI ("      Exception_Tracebacks : Integer;");
+            WBI ("      pragma Import (C, Exception_Tracebacks, " &
+                 """__gl_exception_tracebacks"");");
+         end if;
 
-         --  Generate spec for Set_Globals procedure
-
-         WBI ("      procedure Set_Globals");
-         WBI ("        (Main_Priority            : Integer;");
-         WBI ("         Time_Slice_Value         : Integer;");
-         WBI ("         WC_Encoding              : Character;");
-         WBI ("         Locking_Policy           : Character;");
-         WBI ("         Queuing_Policy           : Character;");
-         WBI ("         Task_Dispatching_Policy  : Character;");
-
-         WBI ("         Restrictions             : System.Address;");
-         WBI ("         Interrupt_States         : System.Address;");
-         WBI ("         Num_Interrupt_States     : Integer;");
-         WBI ("         Unreserve_All_Interrupts : Integer;");
-         WBI ("         Exception_Tracebacks     : Integer;");
-         WBI ("         Zero_Cost_Exceptions     : Integer;");
-         WBI ("         Detect_Blocking          : Integer;");
-         WBI ("         Default_Stack_Size       : Integer);");
-         WBI ("      pragma Import (C, Set_Globals, ""__gnat_set_globals"");");
+         WBI ("      Zero_Cost_Exceptions : Integer;");
+         WBI ("      pragma Import (C, Zero_Cost_Exceptions, " &
+              """__gl_zero_cost_exceptions"");");
+         WBI ("      Detect_Blocking : Integer;");
+         WBI ("      pragma Import (C, Detect_Blocking, " &
+              """__gl_detect_blocking"");");
+         WBI ("      Default_Stack_Size : Integer;");
+         WBI ("      pragma Import (C, Default_Stack_Size, " &
+              """__gl_default_stack_size"");");
 
          --  Import entry point for elaboration time signal handler
          --  installation, and indication of if it's been called previously.
@@ -540,16 +548,12 @@ package body Bindgen is
               """__gnat_handler_installed"");");
          WBI ("   begin");
 
-         --  Generate the call to Set_Globals
-
-         WBI ("      Set_Globals");
-
-         Set_String ("        (Main_Priority            => ");
+         Set_String ("      Main_Priority := ");
          Set_Int    (Main_Priority);
-         Set_Char   (',');
+         Set_Char   (';');
          Write_Statement_Buffer;
 
-         Set_String ("         Time_Slice_Value         => ");
+         Set_String ("      Time_Slice_Value := ");
 
          if Task_Dispatching_Policy_Specified = 'F'
            and then ALIs.Table (ALIs.First).Time_Slice_Value = -1
@@ -559,40 +563,47 @@ package body Bindgen is
             Set_Int (ALIs.Table (ALIs.First).Time_Slice_Value);
          end if;
 
-         Set_Char   (',');
+         Set_Char   (';');
          Write_Statement_Buffer;
 
-         Set_String ("         WC_Encoding              => '");
+         Set_String ("      WC_Encoding := '");
          Set_Char   (ALIs.Table (ALIs.First).WC_Encoding);
-         Set_String ("',");
+         Set_String ("';");
          Write_Statement_Buffer;
 
-         Set_String ("         Locking_Policy           => '");
+         Set_String ("      Locking_Policy := '");
          Set_Char   (Locking_Policy_Specified);
-         Set_String ("',");
+         Set_String ("';");
          Write_Statement_Buffer;
 
-         Set_String ("         Queuing_Policy           => '");
+         Set_String ("      Queuing_Policy := '");
          Set_Char   (Queuing_Policy_Specified);
-         Set_String ("',");
+         Set_String ("';");
          Write_Statement_Buffer;
 
-         Set_String ("         Task_Dispatching_Policy  => '");
+         Set_String ("      Task_Dispatching_Policy := '");
          Set_Char   (Task_Dispatching_Policy_Specified);
-         Set_String ("',");
+         Set_String ("';");
          Write_Statement_Buffer;
 
-         WBI ("         Restrictions             => Restrictions'Address,");
+         Gen_Restrictions_Ada;
+
+         WBI ("      Priority_Specific_Dispatching :=");
+         WBI ("        Local_Priority_Specific_Dispatching'Address;");
 
-         WBI ("         Interrupt_States         => " &
-                                                 "Interrupt_States'Address,");
+         Set_String ("      Num_Specific_Dispatching := ");
+         Set_Int (PSD_Pragma_Settings.Last + 1);
+         Set_Char (';');
+         Write_Statement_Buffer;
 
-         Set_String ("         Num_Interrupt_States     => ");
+         WBI ("      Interrupt_States := Local_Interrupt_States'Address;");
+
+         Set_String ("      Num_Interrupt_States := ");
          Set_Int (IS_Pragma_Settings.Last + 1);
-         Set_Char (',');
+         Set_Char (';');
          Write_Statement_Buffer;
 
-         Set_String ("         Unreserve_All_Interrupts => ");
+         Set_String ("      Unreserve_All_Interrupts := ");
 
          if Unreserve_All_Interrupts_Specified then
             Set_String ("1");
@@ -600,21 +611,14 @@ package body Bindgen is
             Set_String ("0");
          end if;
 
-         Set_Char (',');
+         Set_Char (';');
          Write_Statement_Buffer;
 
-         Set_String ("         Exception_Tracebacks     => ");
-
          if Exception_Tracebacks then
-            Set_String ("1");
-         else
-            Set_String ("0");
+            WBI ("      Exception_Tracebacks := 1;");
          end if;
 
-         Set_String (",");
-         Write_Statement_Buffer;
-
-         Set_String ("         Zero_Cost_Exceptions     => ");
+         Set_String ("      Zero_Cost_Exceptions := ");
 
          if Zero_Cost_Exceptions_Specified then
             Set_String ("1");
@@ -622,10 +626,10 @@ package body Bindgen is
             Set_String ("0");
          end if;
 
-         Set_String (",");
+         Set_String (";");
          Write_Statement_Buffer;
 
-         Set_String ("         Detect_Blocking          => ");
+         Set_String ("      Detect_Blocking := ");
 
          if Detect_Blocking then
             Set_Int (1);
@@ -633,13 +637,12 @@ package body Bindgen is
             Set_Int (0);
          end if;
 
-         Set_String (",");
+         Set_String (";");
          Write_Statement_Buffer;
 
-         Set_String ("         Default_Stack_Size       => ");
+         Set_String ("      Default_Stack_Size := ");
          Set_Int (Default_Stack_Size);
-
-         Set_String (");");
+         Set_String (";");
          Write_Statement_Buffer;
 
          --  Generate call to Install_Handler
@@ -734,7 +737,8 @@ package body Bindgen is
          --  for the Ravenscar profile.
 
          if Main_Priority /= No_Main_Priority then
-            Set_String ("   extern int __gl_main_priority = ");
+            WBI ("   extern int __gl_main_priority;");
+            Set_String ("   __gl_main_priority = ");
             Set_Int    (Main_Priority);
             Set_Char   (';');
             Write_Statement_Buffer;
@@ -743,20 +747,24 @@ package body Bindgen is
       --  Normal case (standard library not suppressed)
 
       else
-         --  Generate definition for restrictions string
+         --  Generate definition for interrupt states string
+
+         Set_String ("   static const char *local_interrupt_states = """);
+
+         for J in 0 .. IS_Pragma_Settings.Last loop
+            Set_Char (IS_Pragma_Settings.Table (J));
+         end loop;
 
-         Set_String ("   const char *restrictions = """);
-         Gen_Restrictions_String_1;
-         Gen_Restrictions_String_2;
          Set_String (""";");
          Write_Statement_Buffer;
 
-         --  Generate definition for interrupt states string
+         --  Generate definition for priority specific dispatching string
 
-         Set_String ("   const char *interrupt_states = """);
+         Set_String
+           ("   static const char *local_priority_specific_dispatching = """);
 
-         for J in 0 .. IS_Pragma_Settings.Last loop
-            Set_Char (IS_Pragma_Settings.Table (J));
+         for J in 0 .. PSD_Pragma_Settings.Last loop
+            Set_Char (PSD_Pragma_Settings.Table (J));
          end loop;
 
          Set_String (""";");
@@ -773,24 +781,17 @@ package body Bindgen is
 
          --  Code for normal case (standard library not suppressed)
 
-         --  Generate call to set the runtime global variables defined in
-         --  init.c. We define the varables in init.c, rather than in
-         --  the binder generated file itself to avoid undefined externals
-         --  when the runtime is linked as a shareable image library.
-
          --  We call the routine from inside adainit() because this works for
          --  both programs with and without binder generated "main" functions.
 
-         WBI ("   __gnat_set_globals (");
-
-         Set_String ("      ");
+         WBI ("   extern int __gl_main_priority;");
+         Set_String ("   __gl_main_priority = ");
          Set_Int (Main_Priority);
-         Set_Char (',');
-         Tab_To (24);
-         Set_String ("/* Main_Priority              */");
+         Set_Char (';');
          Write_Statement_Buffer;
 
-         Set_String ("      ");
+         WBI ("   extern int __gl_time_slice_val;");
+         Set_String ("   __gl_time_slice_val = ");
 
          if Task_Dispatching_Policy = 'F'
            and then ALIs.Table (ALIs.First).Time_Slice_Value = -1
@@ -800,82 +801,75 @@ package body Bindgen is
             Set_Int (ALIs.Table (ALIs.First).Time_Slice_Value);
          end if;
 
-         Set_Char   (',');
-         Tab_To (24);
-         Set_String ("/* Time_Slice_Value           */");
+         Set_Char   (';');
          Write_Statement_Buffer;
 
-         Set_String ("      '");
+         WBI ("   extern char __gl_wc_encoding;");
+         Set_String ("   __gl_wc_encoding = '");
          Set_Char   (ALIs.Table (ALIs.First).WC_Encoding);
-         Set_String ("',");
-         Tab_To (24);
-         Set_String ("/* WC_Encoding                */");
+         Set_String ("';");
          Write_Statement_Buffer;
 
-         Set_String ("      '");
+         WBI ("   extern char __gl_locking_policy;");
+         Set_String ("   __gl_locking_policy = '");
          Set_Char (Locking_Policy_Specified);
-         Set_String ("',");
-         Tab_To (24);
-         Set_String ("/* Locking_Policy             */");
+         Set_String ("';");
          Write_Statement_Buffer;
 
-         Set_String ("      '");
+         WBI ("   extern char __gl_queuing_policy;");
+         Set_String ("   __gl_queuing_policy = '");
          Set_Char (Queuing_Policy_Specified);
-         Set_String ("',");
-         Tab_To (24);
-         Set_String ("/* Queuing_Policy             */");
+         Set_String ("';");
          Write_Statement_Buffer;
 
-         Set_String ("      '");
+         WBI ("   extern char __gl_task_dispatching_policy;");
+         Set_String ("   __gl_task_dispatching_policy = '");
          Set_Char (Task_Dispatching_Policy_Specified);
-         Set_String ("',");
-         Tab_To (24);
-         Set_String ("/* Tasking_Dispatching_Policy */");
+         Set_String ("';");
          Write_Statement_Buffer;
 
-         Set_String ("      ");
-         Set_String ("restrictions");
-         Set_String (",");
-         Tab_To (24);
-         Set_String ("/* Restrictions               */");
-         Write_Statement_Buffer;
+         --  Generate definition for restrictions string
 
-         Set_String ("      ");
-         Set_String ("interrupt_states");
-         Set_String (",");
-         Tab_To (24);
-         Set_String ("/* Interrupt_States           */");
-         Write_Statement_Buffer;
+         Gen_Restrictions_C;
+
+         WBI ("   extern const void *__gl_interrupt_states;");
+         WBI ("   __gl_interrupt_states = local_interrupt_states;");
 
-         Set_String ("      ");
+         WBI ("   extern int __gl_num_interrupt_states;");
+         Set_String ("   __gl_num_interrupt_states = ");
          Set_Int (IS_Pragma_Settings.Last + 1);
-         Set_String (",");
-         Tab_To (24);
-         Set_String ("/* Num_Interrupt_States       */");
+         Set_String (";");
          Write_Statement_Buffer;
 
-         Set_String ("      ");
-         Set_Int    (Boolean'Pos (Unreserve_All_Interrupts_Specified));
-         Set_String (",");
-         Tab_To (24);
-         Set_String ("/* Unreserve_All_Interrupts   */");
+         WBI ("   extern const void *__gl_priority_specific_dispatching;");
+         WBI ("   __gl_priority_specific_dispatching =" &
+              " local_priority_specific_dispatching;");
+
+         WBI ("   extern int __gl_num_specific_dispatching;");
+         Set_String ("   __gl_num_specific_dispatching = ");
+         Set_Int (PSD_Pragma_Settings.Last + 1);
+         Set_String (";");
          Write_Statement_Buffer;
 
-         Set_String ("      ");
-         Set_Int    (Boolean'Pos (Exception_Tracebacks));
-         Set_String (",");
-         Tab_To (24);
-         Set_String ("/* Exception_Tracebacks       */");
+         WBI ("   extern int __gl_unreserve_all_interrupts;");
+         Set_String ("   __gl_unreserve_all_interrupts = ");
+         Set_Int    (Boolean'Pos (Unreserve_All_Interrupts_Specified));
+         Set_String (";");
          Write_Statement_Buffer;
 
-         Set_String ("      ");
+         if Exception_Tracebacks then
+            WBI ("   extern int __gl_exception_tracebacks;");
+            WBI ("   __gl_exception_tracebacks = 1;");
+         end if;
+
+         WBI ("   extern int __gl_zero_cost_exceptions;");
+         Set_String ("   __gl_zero_cost_exceptions = ");
          Set_Int    (Boolean'Pos (Zero_Cost_Exceptions_Specified));
-         Set_String (",");
-         Tab_To (24);
-         Set_String ("/* Zero_Cost_Exceptions       */");
+         Set_String (";");
          Write_Statement_Buffer;
 
-         Set_String ("      ");
+         WBI ("   extern int __gl_detect_blocking;");
+         Set_String ("   __gl_detect_blocking = ");
 
          if Detect_Blocking then
             Set_Int (1);
@@ -883,16 +877,13 @@ package body Bindgen is
             Set_Int (0);
          end if;
 
-         Set_String (",");
-         Tab_To (24);
-         Set_String ("/* Detect_Blocking            */");
+         Set_String (";");
          Write_Statement_Buffer;
 
-         Set_String ("      ");
+         WBI ("   extern int __gl_default_stack_size;");
+         Set_String ("   __gl_default_stack_size = ");
          Set_Int    (Default_Stack_Size);
-         Set_String (");");
-         Tab_To (24);
-         Set_String ("/* Default_Stack_Size     */");
+         Set_String (";");
          Write_Statement_Buffer;
 
          WBI ("");
@@ -1836,7 +1827,12 @@ package body Bindgen is
       --  files. The reason for this decision is that libraries referenced
       --  by internal routines may reference these standard library entries.
 
-      if not Opt.No_Stdlib then
+      --  Note that we do not insert anything when pragma No_Run_Time has been
+      --  specified or when the standard libraries are not to be used,
+      --  otherwise on some platforms, such as VMS, we may get duplicate
+      --  symbols when linking.
+
+      if not (Opt.No_Run_Time_Mode or else Opt.No_Stdlib) then
          Name_Len := 0;
 
          if Opt.Shared_Libgnat then
@@ -1903,14 +1899,15 @@ package body Bindgen is
    ---------------------
 
    procedure Gen_Output_File (Filename : String) is
-      Is_Public_Version : constant Boolean := Get_Gnat_Build_Type = Public;
-      Is_GAP_Version    : constant Boolean := Get_Gnat_Build_Type = GAP;
-
    begin
       --  Acquire settings for Interrupt_State pragmas
 
       Set_IS_Pragma_Table;
 
+      --  Acquire settings for Priority_Specific_Dispatching pragma
+
+      Set_PSD_Pragma_Table;
+
       --  Override Ada_Bind_File and Bind_Main_Program for Java since
       --  JGNAT only supports Ada code, and the main program is already
       --  generated by the compiler.
@@ -1936,12 +1933,6 @@ package body Bindgen is
          end if;
       end loop;
 
-      --  Get the time stamp of the former bind for public version warning
-
-      if Is_Public_Version or Is_GAP_Version then
-         Record_Time_From_Last_Bind;
-      end if;
-
       --  Generate output file in appropriate language
 
       if Ada_Bind_File then
@@ -1950,12 +1941,6 @@ package body Bindgen is
          Gen_Output_File_C (Filename);
       end if;
 
-      --  Periodically issue a warning when the public version is used on
-      --  big projects
-
-      if Is_Public_Version then
-         Public_Version_Warning;
-      end if;
    end Gen_Output_File;
 
    -------------------------
@@ -2006,7 +1991,6 @@ package body Bindgen is
       Resolve_Binder_Options;
 
       if not Suppress_Standard_Library_On_Target then
-
          --  Usually, adafinal is called using a pragma Import C. Since
          --  Import C doesn't have the same semantics for JGNAT, we use
          --  standard Ada.
@@ -2192,6 +2176,14 @@ package body Bindgen is
            ", Body_File_Name => """ &
            Name_Buffer (1 .. Name_Len + 3));
 
+      --  Generate with of System.Restrictions to initialize
+      --  Run_Time_Restrictions.
+
+      if not Suppress_Standard_Library_On_Target then
+         WBI ("");
+         WBI ("with System.Restrictions;");
+      end if;
+
       WBI ("");
       WBI ("package body " & Ada_Main & " is");
       WBI ("   pragma Warnings (Off);");
@@ -2213,6 +2205,33 @@ package body Bindgen is
          end if;
       end if;
 
+      if not Suppress_Standard_Library_On_Target then
+
+         --  Generate Priority_Specific_Dispatching pragma string
+
+         Set_String
+           ("   Local_Priority_Specific_Dispatching : constant String := """);
+
+         for J in 0 .. PSD_Pragma_Settings.Last loop
+            Set_Char (PSD_Pragma_Settings.Table (J));
+         end loop;
+
+         Set_String (""";");
+         Write_Statement_Buffer;
+
+         --  Generate Interrupt_State pragma string
+
+         Set_String ("   Local_Interrupt_States : constant String := """);
+
+         for J in 0 .. IS_Pragma_Settings.Last loop
+            Set_Char (IS_Pragma_Settings.Table (J));
+         end loop;
+
+         Set_String (""";");
+         Write_Statement_Buffer;
+         WBI ("");
+      end if;
+
       Gen_Adainit_Ada;
 
       Gen_Adafinal_Ada;
@@ -2257,11 +2276,6 @@ package body Bindgen is
 
       Resolve_Binder_Options;
 
-      WBI ("extern void __gnat_set_globals");
-      WBI ("  (int, int, char, char, char, char,");
-      WBI ("   const char *, const char *,");
-      WBI ("   int, int, int, int, int, int);");
-
       if Use_Pragma_Linker_Constructor then
          WBI ("extern void " & Ada_Final_Name.all &
               " (void) __attribute__((destructor));");
@@ -2438,51 +2452,211 @@ package body Bindgen is
       Close_Binder_Output;
    end Gen_Output_File_C;
 
-   -------------------------------
-   -- Gen_Restrictions_String_1 --
-   -------------------------------
+   --------------------------
+   -- Gen_Restrictions_Ada --
+   --------------------------
 
-   procedure Gen_Restrictions_String_1 is
+   procedure Gen_Restrictions_Ada is
+      Count : Integer;
    begin
-      for R in All_Boolean_Restrictions loop
-         if Cumulative_Restrictions.Set (R) then
-            Set_Char ('r');
-         elsif Cumulative_Restrictions.Violated (R) then
-            Set_Char ('v');
-         else
-            Set_Char ('n');
+      if Suppress_Standard_Library_On_Target then
+         return;
+      end if;
+
+      WBI ("      System.Restrictions.Run_Time_Restrictions :=");
+      WBI ("        (Set =>");
+      Set_String      ("          (");
+
+      Count := 0;
+
+      for J in Cumulative_Restrictions.Set'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Set'Last)
+      loop
+         Set_Boolean (Cumulative_Restrictions.Set (J));
+         Set_String (", ");
+         Count := Count + 1;
+
+         if Count = 8 then
+            Write_Statement_Buffer;
+            Set_String ("           ");
+            Count := 0;
          end if;
       end loop;
-   end Gen_Restrictions_String_1;
 
-   -------------------------------
-   -- Gen_Restrictions_String_2 --
-   -------------------------------
+      Set_Boolean
+        (Cumulative_Restrictions.Set (Cumulative_Restrictions.Set'Last));
+      Set_String ("),");
+      Write_Statement_Buffer;
+      Set_String ("         Value => (");
 
-   procedure Gen_Restrictions_String_2 is
-   begin
-      for RP in All_Parameter_Restrictions loop
-         if Cumulative_Restrictions.Set (RP) then
-            Set_Char ('r');
-            Set_Int (Int (Cumulative_Restrictions.Value (RP)));
-         else
-            Set_Char ('n');
+      for J in Cumulative_Restrictions.Value'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Value'Last)
+      loop
+         Set_Int (Int (Cumulative_Restrictions.Value (J)));
+         Set_String (", ");
+      end loop;
+
+      Set_Int (Int (Cumulative_Restrictions.Value
+        (Cumulative_Restrictions.Value'Last)));
+      Set_String ("),");
+      Write_Statement_Buffer;
+      WBI ("         Violated =>");
+      Set_String ("          (");
+      Count := 0;
+
+      for J in Cumulative_Restrictions.Violated'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Violated'Last)
+      loop
+         Set_Boolean (Cumulative_Restrictions.Violated (J));
+         Set_String (", ");
+         Count := Count + 1;
+
+         if Count = 8 then
+            Write_Statement_Buffer;
+            Set_String ("           ");
+            Count := 0;
          end if;
+      end loop;
 
-         if not Cumulative_Restrictions.Violated (RP)
-           or else RP not in Checked_Parameter_Restrictions
-         then
-            Set_Char ('n');
-         else
-            Set_Char ('v');
-            Set_Int (Int (Cumulative_Restrictions.Count (RP)));
+      Set_Boolean (Cumulative_Restrictions.Violated
+        (Cumulative_Restrictions.Violated'Last));
+      Set_String ("),");
+      Write_Statement_Buffer;
+      Set_String ("         Count => (");
 
-            if Cumulative_Restrictions.Unknown (RP) then
-               Set_Char ('+');
-            end if;
-         end if;
+      for J in Cumulative_Restrictions.Count'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Count'Last)
+      loop
+         Set_Int (Int (Cumulative_Restrictions.Count (J)));
+         Set_String (", ");
+      end loop;
+
+      Set_Int (Int (Cumulative_Restrictions.Count
+        (Cumulative_Restrictions.Count'Last)));
+      Set_String ("),");
+      Write_Statement_Buffer;
+      Set_String ("         Unknown => (");
+
+      for J in Cumulative_Restrictions.Unknown'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Unknown'Last)
+      loop
+         Set_Boolean (Cumulative_Restrictions.Unknown (J));
+         Set_String (", ");
+      end loop;
+
+      Set_Boolean
+        (Cumulative_Restrictions.Unknown
+          (Cumulative_Restrictions.Unknown'Last));
+      Set_String ("));");
+      Write_Statement_Buffer;
+   end Gen_Restrictions_Ada;
+
+   ------------------------
+   -- Gen_Restrictions_C --
+   ------------------------
+
+   procedure Gen_Restrictions_C is
+   begin
+      if Suppress_Standard_Library_On_Target then
+         return;
+      end if;
+
+      WBI ("   typedef struct {");
+      Set_String ("     char set [");
+      Set_Int (Cumulative_Restrictions.Set'Length);
+      Set_String ("];");
+      Write_Statement_Buffer;
+
+      Set_String ("     int value [");
+      Set_Int (Cumulative_Restrictions.Value'Length);
+      Set_String ("];");
+      Write_Statement_Buffer;
+
+      Set_String ("     char violated [");
+      Set_Int (Cumulative_Restrictions.Violated'Length);
+      Set_String ("];");
+      Write_Statement_Buffer;
+
+      Set_String ("     int count [");
+      Set_Int (Cumulative_Restrictions.Count'Length);
+      Set_String ("];");
+      Write_Statement_Buffer;
+
+      Set_String ("     char unknown [");
+      Set_Int (Cumulative_Restrictions.Unknown'Length);
+      Set_String ("];");
+      Write_Statement_Buffer;
+      WBI ("   } restrictions;");
+      WBI ("   extern restrictions " &
+           "system__restrictions__run_time_restrictions;");
+      WBI ("   restrictions r = {");
+      Set_String ("     {");
+
+      for J in Cumulative_Restrictions.Set'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Set'Last)
+      loop
+         Set_Int (Boolean'Pos (Cumulative_Restrictions.Set (J)));
+         Set_String (", ");
+      end loop;
+
+      Set_Int (Boolean'Pos
+        (Cumulative_Restrictions.Set (Cumulative_Restrictions.Set'Last)));
+      Set_String ("},");
+      Write_Statement_Buffer;
+      Set_String ("     {");
+
+      for J in Cumulative_Restrictions.Value'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Value'Last)
+      loop
+         Set_Int (Int (Cumulative_Restrictions.Value (J)));
+         Set_String (", ");
+      end loop;
+
+      Set_Int (Int (Cumulative_Restrictions.Value
+        (Cumulative_Restrictions.Value'Last)));
+      Set_String ("},");
+      Write_Statement_Buffer;
+      Set_String ("     {");
+
+      for J in Cumulative_Restrictions.Violated'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Violated'Last)
+      loop
+         Set_Int (Boolean'Pos (Cumulative_Restrictions.Violated (J)));
+         Set_String (", ");
       end loop;
-   end Gen_Restrictions_String_2;
+
+      Set_Int (Boolean'Pos (Cumulative_Restrictions.Violated
+        (Cumulative_Restrictions.Violated'Last)));
+      Set_String ("},");
+      Write_Statement_Buffer;
+      Set_String ("     {");
+
+      for J in Cumulative_Restrictions.Count'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Count'Last)
+      loop
+         Set_Int (Int (Cumulative_Restrictions.Count (J)));
+         Set_String (", ");
+      end loop;
+
+      Set_Int (Int (Cumulative_Restrictions.Count
+        (Cumulative_Restrictions.Count'Last)));
+      Set_String ("},");
+      Write_Statement_Buffer;
+      Set_String ("     {");
+
+      for J in Cumulative_Restrictions.Unknown'First ..
+        Restriction_Id'Pred (Cumulative_Restrictions.Unknown'Last)
+      loop
+         Set_Int (Boolean'Pos (Cumulative_Restrictions.Unknown (J)));
+         Set_String (", ");
+      end loop;
+
+      Set_Int (Boolean'Pos (Cumulative_Restrictions.Unknown
+          (Cumulative_Restrictions.Unknown'Last)));
+      Set_String ("}};");
+      Write_Statement_Buffer;
+      WBI ("   system__restrictions__run_time_restrictions = r;");
+   end Gen_Restrictions_C;
 
    ----------------------
    -- Gen_Versions_Ada --
@@ -2773,78 +2947,6 @@ package body Bindgen is
    end Move_Linker_Option;
 
    ----------------------------
-   -- Public_Version_Warning --
-   ----------------------------
-
-   procedure Public_Version_Warning is
-      Time : constant Int := Time_From_Last_Bind;
-
-      --  Constants to help defining periods
-
-      Hour : constant := 60;
-      Day  : constant := 24 * Hour;
-
-      Never : constant := Integer'Last;
-      --  Special value indicating no warnings should be given
-
-      --  Constants defining when the warning is issued. Programs with more
-      --  than Large Units will issue a warning every Period_Large amount of
-      --  time. Smaller programs will generate a warning every Period_Small
-      --  amount of time.
-
-      Large : constant := 20;
-      --  Threshold for considering a program small or large
-
-      Period_Large : constant := Day;
-      --  Periodic warning time for large programs
-
-      Period_Small : constant := Never;
-      --  Periodic warning time for small programs
-
-      Nb_Unit : Int;
-
-   begin
-      --  Compute the number of units that are not GNAT internal files
-
-      Nb_Unit := 0;
-      for A in ALIs.First .. ALIs.Last loop
-         if not Is_Internal_File_Name (ALIs.Table (A).Sfile) then
-            Nb_Unit := Nb_Unit + 1;
-         end if;
-      end loop;
-
-      --  Do not emit the message if the last message was emitted in the
-      --  specified period taking into account the number of units.
-
-      pragma Warnings (Off);
-      --  Turn off warning of constant condition, which may happen here
-      --  depending on the choice of constants in the above declarations.
-
-      if Nb_Unit < Large and then Time <= Period_Small then
-         return;
-      elsif Time <= Period_Large then
-         return;
-      end if;
-
-      pragma Warnings (On);
-
-      Write_Eol;
-      Write_Str ("IMPORTANT NOTICE:");
-      Write_Eol;
-      Write_Str ("    This version of GNAT is unsupported"
-        &                        " and comes with absolutely no warranty.");
-      Write_Eol;
-      Write_Str ("    If you intend to evaluate or use GNAT for building "
-        &                                       "commercial applications,");
-      Write_Eol;
-      Write_Str ("    please consult http://www.gnat.com/ for information");
-      Write_Eol;
-      Write_Str ("    on the GNAT Professional product line.");
-      Write_Eol;
-      Write_Eol;
-   end Public_Version_Warning;
-
-   ----------------------------
    -- Resolve_Binder_Options --
    ----------------------------
 
@@ -2867,6 +2969,23 @@ package body Bindgen is
       end loop;
    end Resolve_Binder_Options;
 
+   -----------------
+   -- Set_Boolean --
+   -----------------
+
+   procedure Set_Boolean (B : Boolean) is
+      True_Str  : constant String := "True";
+      False_Str : constant String := "False";
+   begin
+      if B then
+         Statement_Buffer (Last + 1 .. Last + True_Str'Length) := True_Str;
+         Last := Last + True_Str'Length;
+      else
+         Statement_Buffer (Last + 1 .. Last + False_Str'Length) := False_Str;
+         Last := Last + False_Str'Length;
+      end if;
+   end Set_Boolean;
+
    --------------
    -- Set_Char --
    --------------
@@ -2960,6 +3079,33 @@ package body Bindgen is
       end loop;
    end Set_Name_Buffer;
 
+   -------------------------
+   -- Set_PSD_Pragma_Table --
+   -------------------------
+
+   procedure Set_PSD_Pragma_Table is
+   begin
+      for F in ALIs.First .. ALIs.Last loop
+         for K in ALIs.Table (F).First_Specific_Dispatching ..
+                  ALIs.Table (F).Last_Specific_Dispatching
+         loop
+            declare
+               DTK : Specific_Dispatching_Record
+                       renames Specific_Dispatching.Table (K);
+
+            begin
+               while PSD_Pragma_Settings.Last < DTK.Last_Priority loop
+                  PSD_Pragma_Settings.Append ('F');
+               end loop;
+
+               for Prio in DTK.First_Priority .. DTK.Last_Priority loop
+                  PSD_Pragma_Settings.Table (Prio) := DTK.Dispatching_Policy;
+               end loop;
+            end;
+         end loop;
+      end loop;
+   end Set_PSD_Pragma_Table;
+
    ----------------
    -- Set_String --
    ----------------
@@ -3005,17 +3151,6 @@ package body Bindgen is
       Set_Int (Unum);
    end Set_Unit_Number;
 
-   ------------
-   -- Tab_To --
-   ------------
-
-   procedure Tab_To (N : Natural) is
-   begin
-      while Last < N loop
-         Set_Char (' ');
-      end loop;
-   end Tab_To;
-
    ----------------------
    -- Write_Info_Ada_C --
    ----------------------