a-calend-mingw.adb: Add call to OS_Primitives.Initialize;

	* a-calend-mingw.adb: Add call to OS_Primitives.Initialize;

	* s-taprop-mingw.adb, s-taprop-vms.adb, s-taprop-solaris.adb,
	s-taprop-os2.adb, s-taprop-irix-athread.adb, s-taprop-linux.adb,
	s-taprop-hpux-dce.adb, s-taprop-irix.adb, s-taprop-tru64.adb,
	s-taprop-lynxos.adb: Move with clauses outside Warnings Off now that
	dependent units are Preelaborate.
	(Initialize): Call Interrupt_Managemeent.Initialize and
	OS_Primitives.Initialize to ensure proper initialization of this unit.
	Remove use of System.Soft_Links
	Make this unit Preelaborate.

	* s-stache.ads, s-taspri-vxworks.ads, s-taspri-mingw.ads,
	s-taspri-vms.ads, s-tasinf-solaris.ads, s-taspri-os2.ads,
	s-taspri-lynxos.ads, s-taspri-hpux-dce.ads, s-taspri-tru64.ads,
	s-tasinf-tru64.ads, s-tasinf-irix.ads, s-tasinf-irix-athread.ads,
	s-proinf-irix-athread.adb, s-proinf-irix-athread.ads,
	s-tratas.ads, s-tasinf.ads: Minor reformatting.
	Add pragma Preelaborate, since these packages are suitable for this
	categorization.
	Update comments.

	* s-traent-vms.ads, s-intman-dummy.adb,
	s-taprop-dummy.adb: Make this unit Preelaborate.

	* s-osprim-vxworks.adb, s-osprim-vms.adb, s-osprim-vms.ads,
	s-osprim-mingw.adb, s-intman-vxworks.ads, s-intman-vxworks.adb,
	s-intman-vms.adb, s-intman-mingw.adb, s-intman-vms.ads,
	s-osprim-unix.adb, s-osprim-os2.adb, s-osprim-solaris.adb,
	s-intman-solaris.adb, s-intman-irix-athread.adb,
	s-intman-irix.adb: Mark this unit Preelaborate.
	(Initialize): New procedure.
	Update comments.

	* s-taspri-linux.ads: Removed.

	* s-tpopsp-solaris.adb (Initialize): Create the key in this procedure,
	as done by other implementations (e.g. posix).

	* s-taprop.ads (Timed_Delay): Update spec since the caller now is
	responsible for deferring abort.
	Mark this unit Preelaborate.

	* s-taprob.adb, s-tarest.adb: Call System.Tasking.Initialize to ensure
	proper initialization of the tasking run-time.

	* s-tasdeb.ads: Mark this unit Preelaborate.
	(Known_Tasks): Add explicit default value to avoid elaboration code.

	* s-inmaop-vms.adb (Elaboration code): Add call to
	Interrupt_Management.Initialize since the elaboration code depends on
	proper initialization of this package.

	* s-intman.ads, s-inmaop-posix.adb, s-intman-posix.adb,
	s-osprim.ads, s-taprop-posix.adb, s-taspri-posix.ads,
	s-osprim-posix.adb: Make this unit Preelaborate.

	* a-calend.adb: Add call to OS_Primitives.Initialize

	* a-elchha.adb: Update use of Except.Id.Full_Name.
	Minor reformatting.
	Remove use of Ada.Exceptions.Traceback when possible, cleaner.

	* a-dynpri.adb, a-sytaco.adb, a-sytaco.ads:
	Move with clauses outside Warnings Off now that dependent units are
	Preelaborate.
	Use raise xxx with "..."; Ada 2005 form.

	* a-taside.ads, a-taside.adb:
	Remove some dependencies, to make it easier to make this unit truly
	Preelaborate.
	Rewrite some code to be conformant with Preelaborate rules.

	* g-os_lib.adb: Remove non-preelaborate code so that this unit can be
	marked Preelaborate in the future.

	* s-proinf.ads, g-string.ads, s-auxdec.ads, s-auxdec-vms_64.ads: Make
	these units Preelaborate.

	* s-exctab.adb: Update use of Except.Id.Full_Name.

	* s-soflin.ads, s-soflin.adb: Mark this unit Preelaborate_05.
	(Set_Exc_Stack_Addr_Soft, Get_Exc_Stack_Addr_NT, Set_Exc_Stack_Addr_NT,
	Set_Exc_Stack_Addr): Removed, no longer used.
	Remove reference to *Machine_State_Addr*, no longer needed.

	* s-stalib.ads: Mark this unit as Preelaborate[_05].
	(Exception_Data): Full_Name is now a System.Address so that this unit
	can be made Preelaborate.
	Clean up/simplify code thanks to Full_Name being a System.Address.
	Remove obsolete pragma Suppress (All_Checks), no longer needed.

	* s-taskin.ads, s-taskin.adb:
	Move with clauses outside Warnings Off now that dependent units are
	Preelaborate.
	Make this unit Preelaborate.
	(Initialize): New proceduure, replace elaboration code and makes the
	set up of the tasking run-time cleaner.
	(Detect_Blocking): Now a function instead of a deferred boolean, to
	obey Preelaborate rules.

	* s-tassta.adb (Finalize_Global_Tasks): Remove Get/Set_Exc_Stack_Addr
	soft links, no longer used.

	* s-traces.ads, s-traent.ads: Add pragma Preelaborate, since these
	packages are suitable for this categorization.

	* s-solita.adb: Replace use of Ada.Exception by raise xxx with "..."
	since we compile run-time sources in Ada 2005 mode.
	(Timed_Delay_T): Call Abort_Defer/Undefer around Timed_Delay, to
	avoid having s-taprop*.adb depend on s-soflin and to avoid code
	duplication.
	Remove reference to *Machine_State_Addr*, no longer needed.

From-SVN: r103847

gcc/ada/a-calend-mingw.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 1997-2002 Free Software Foundation, Inc.        --
+--            Copyright (C) 1997-2005 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- --
@@ -31,7 +31,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is the Windows NT/95 version.
+--  This is the Windows NT/95 version
 
 with System.OS_Primitives;
 --  used for Clock
@@ -262,7 +262,7 @@ package body Ada.Calendar is
 
       end if;
 
-      --  Date_Int is the number of seconds from Epoch.
+      --  Date_Int is the number of seconds from Epoch
 
       Date_Int := Long_Long_Integer
         (Int_Date * Sec_Unit / system_time_ns) + epoch_1970;
@@ -391,4 +391,6 @@ package body Ada.Calendar is
       return DY;
    end Year;
 
+begin
+   System.OS_Primitives.Initialize;
 end Ada.Calendar;

gcc/ada/a-calend.adb

@@ -476,4 +476,6 @@ package body Ada.Calendar is
       return DY;
    end Year;
 
+begin
+   System.OS_Primitives.Initialize;
 end Ada.Calendar;

gcc/ada/a-dynpri.adb

@@ -31,11 +31,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-pragma Warnings (Off);
---  Allow withing of non-Preelaborated units in Ada 2005 mode where this
---  package will be categorized as Preelaborate. See AI-362 for details.
---  It is safe in the context of the run-time to violate the rules!
-
 with Ada.Task_Identification;
 --  used for Task_Id
 --           Current_Task
@@ -52,26 +47,22 @@ with System.Task_Primitives.Operations;
 with System.Tasking;
 --  used for Task_Id
 
-with Ada.Exceptions;
---  used for Raise_Exception
-
-with System.Tasking.Initialization;
---  used for Defer/Undefer_Abort
-
 with System.Parameters;
 --  used for Single_Lock
 
-with Unchecked_Conversion;
+with System.Soft_Links;
+--  use for Abort_Defer
+--          Abort_Undefer
 
-pragma Warnings (On);
+with Unchecked_Conversion;
 
 package body Ada.Dynamic_Priorities is
 
    package STPO renames System.Task_Primitives.Operations;
+   package SSL renames System.Soft_Links;
 
    use System.Parameters;
    use System.Tasking;
-   use Ada.Exceptions;
 
    function Convert_Ids is new
      Unchecked_Conversion
@@ -92,13 +83,11 @@ package body Ada.Dynamic_Priorities is
 
    begin
       if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then
-         Raise_Exception (Program_Error'Identity,
-           Error_Message & "null task");
+         raise Program_Error with Error_Message & "null task";
       end if;
 
       if Task_Identification.Is_Terminated (T) then
-         Raise_Exception (Tasking_Error'Identity,
-           Error_Message & "null task");
+         raise Tasking_Error with Error_Message & "null task";
       end if;
 
       return Target.Common.Base_Priority;
@@ -121,16 +110,14 @@ package body Ada.Dynamic_Priorities is
 
    begin
       if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then
-         Raise_Exception (Program_Error'Identity,
-           Error_Message & "null task");
+         raise Program_Error with Error_Message & "null task";
       end if;
 
       if Task_Identification.Is_Terminated (T) then
-         Raise_Exception (Tasking_Error'Identity,
-           Error_Message & "terminated task");
+         raise Tasking_Error with Error_Message & "terminated task";
       end if;
 
-      Initialization.Defer_Abort (Self_ID);
+      SSL.Abort_Defer.all;
 
       if Single_Lock then
          STPO.Lock_RTS;
@@ -148,7 +135,7 @@ package body Ada.Dynamic_Priorities is
             STPO.Unlock_RTS;
          end if;
 
-         --  Yield is needed to enforce FIFO task dispatching.
+         --  Yield is needed to enforce FIFO task dispatching
 
          --  LL Set_Priority is made while holding the RTS lock so that it
          --  is inheriting high priority until it release all the RTS locks.
@@ -175,7 +162,7 @@ package body Ada.Dynamic_Priorities is
          end if;
       end if;
 
-      Initialization.Undefer_Abort (Self_ID);
+      SSL.Abort_Undefer.all;
    end Set_Priority;
 
 end Ada.Dynamic_Priorities;

gcc/ada/a-elchha.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 2003-2004 Free Software Foundation, Inc.         --
+--           Copyright (C) 2003-2005 Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -37,6 +37,8 @@
 
 --  Default version for most targets
 
+with System.Standard_Library; use System.Standard_Library;
+
 procedure Ada.Exceptions.Last_Chance_Handler
   (Except : Exception_Occurrence)
 is
@@ -88,7 +90,7 @@ begin
    --  really an exception at all. We recognize this by the fact that
    --  it is the only exception whose name starts with underscore.
 
-   if Except.Id.Full_Name.all (1) = '_' then
+   if To_Ptr (Except.Id.Full_Name) (1) = '_' then
       To_Stderr (Nline);
       To_Stderr ("Execution terminated by abort of environment task");
       To_Stderr (Nline);
@@ -100,7 +102,8 @@ begin
    elsif Except.Num_Tracebacks = 0 then
       To_Stderr (Nline);
       To_Stderr ("raised ");
-      To_Stderr (Except.Id.Full_Name.all (1 .. Except.Id.Name_Length - 1));
+      To_Stderr
+        (To_Ptr (Except.Id.Full_Name) (1 .. Except.Id.Name_Length - 1));
 
       if Exception_Message_Length (Except) /= 0 then
          To_Stderr (" : ");

gcc/ada/a-sytaco.adb

@@ -31,11 +31,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-pragma Warnings (Off);
---  Allow withing of non-Preelaborated units in Ada 2005 mode where this
---  package will be categorized as Preelaborate. See AI-362 for details.
---  It is safe in the context of the run-time to violate the rules!
-
 with System.Tasking;
 --  Used for Detect_Blocking
 --           Self
@@ -51,8 +46,6 @@ with System.Task_Primitives.Operations;
 --           Set_True
 --           Suspend_Until_True
 
-pragma Warnings (On);
-
 package body Ada.Synchronous_Task_Control is
 
    ----------------

gcc/ada/a-sytaco.ads

@@ -35,22 +35,15 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-pragma Warnings (Off);
---  Allow withing of non-Preelaborated units in Ada 2005 mode where this
---  package will be implicitly categorized as Preelaborate. See AI-362 for
---  details. It is safe in the context of the run-time to violate the rules!
-
 with System.Task_Primitives;
 --  Used for Suspension_Object
 
 with Ada.Finalization;
 --  Used for Limited_Controlled
 
-pragma Warnings (On);
-
 package Ada.Synchronous_Task_Control is
-pragma Preelaborate_05 (Synchronous_Task_Control);
---  In accordance with Ada 2005 AI-362
+   pragma Preelaborate_05;
+   --  In accordance with Ada 2005 AI-362
 
    type Suspension_Object is limited private;
 
@@ -71,12 +64,13 @@ private
    --  Finalization for Suspension_Object
 
    type Suspension_Object is
-     new Ada.Finalization.Limited_Controlled with record
+     new Ada.Finalization.Limited_Controlled with
+   record
       SO : System.Task_Primitives.Suspension_Object;
       --  Use low-level suspension objects so that the synchronization
       --  functionality provided by this object can be achieved using
       --  efficient operating system primitives.
-     end record;
+   end record;
 
    pragma Inline (Set_True);
    pragma Inline (Set_False);

gcc/ada/a-taside.adb

@@ -31,32 +31,28 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with System.Address_Image;
+with System.Parameters;
+with System.Soft_Links;
+with System.Task_Primitives.Operations;
+with System.Tasking;
+
+with Unchecked_Conversion;
+
 pragma Warnings (Off);
 --  Allow withing of non-Preelaborated units in Ada 2005 mode where this
 --  package will be categorized as Preelaborate. See AI-362 for details.
 --  It is safe in the context of the run-time to violate the rules!
 
-with System.Address_Image;
---  used for the function itself
-
-with System.Tasking;
---  used for Task_List
-
 with System.Tasking.Stages;
---  used for Terminated
---           Abort_Tasks
 
-with System.Tasking.Rendezvous;
---  used for Callable
+pragma Warnings (On);
 
-with System.Task_Primitives.Operations;
---  used for Self
-
-with Unchecked_Conversion;
+package body Ada.Task_Identification is
 
-pragma Warnings (Off);
+   use System.Parameters;
 
-package body Ada.Task_Identification is
+   package STPO renames System.Task_Primitives.Operations;
 
    -----------------------
    -- Local Subprograms --
@@ -71,7 +67,7 @@ package body Ada.Task_Identification is
    -- "=" --
    ---------
 
-   function  "=" (Left, Right : Task_Id) return Boolean is
+   function "=" (Left, Right : Task_Id) return Boolean is
    begin
       return System.Tasking."=" (Convert_Ids (Left), Convert_Ids (Right));
    end "=";
@@ -139,11 +135,28 @@ package body Ada.Task_Identification is
    -----------------
 
    function Is_Callable (T : Task_Id) return Boolean is
+      Result : Boolean;
+      Id     : constant System.Tasking.Task_Id := Convert_Ids (T);
    begin
       if T = Null_Task_Id then
          raise Program_Error;
       else
-         return System.Tasking.Rendezvous.Callable (Convert_Ids (T));
+         System.Soft_Links.Abort_Defer.all;
+
+         if Single_Lock then
+            STPO.Lock_RTS;
+         end if;
+
+         STPO.Write_Lock (Id);
+         Result := Id.Callable;
+         STPO.Unlock (Id);
+
+         if Single_Lock then
+            STPO.Unlock_RTS;
+         end if;
+
+         System.Soft_Links.Abort_Undefer.all;
+         return Result;
       end if;
    end Is_Callable;
 
@@ -152,11 +165,31 @@ package body Ada.Task_Identification is
    -------------------
 
    function Is_Terminated (T : Task_Id) return Boolean is
+      Result : Boolean;
+      Id     : constant System.Tasking.Task_Id := Convert_Ids (T);
+
+      use System.Tasking;
+
    begin
       if T = Null_Task_Id then
          raise Program_Error;
       else
-         return System.Tasking.Stages.Terminated (Convert_Ids (T));
+         System.Soft_Links.Abort_Defer.all;
+
+         if Single_Lock then
+            STPO.Lock_RTS;
+         end if;
+
+         STPO.Write_Lock (Id);
+         Result := Id.Common.State = Terminated;
+         STPO.Unlock (Id);
+
+         if Single_Lock then
+            STPO.Unlock_RTS;
+         end if;
+
+         System.Soft_Links.Abort_Undefer.all;
+         return Result;
       end if;
    end Is_Terminated;
 

gcc/ada/a-taside.ads

@@ -35,25 +35,18 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-pragma Warnings (Off);
---  Allow withing of non-Preelaborated units in Ada 2005 mode where this
---  package will be categorized as Preelaborate. See AI-362 for details.
---  It is safe in the context of the run-time to violate the rules!
-
 with System;
 with System.Tasking;
 
-pragma Warnings (On);
-
 package Ada.Task_Identification is
-pragma Preelaborate_05 (Task_Identification);
---  In accordance with Ada 2005 AI-362
+   pragma Preelaborate_05;
+   --  In accordance with Ada 2005 AI-362
 
    type Task_Id is private;
 
    Null_Task_Id : constant Task_Id;
 
-   function  "=" (Left, Right : Task_Id) return Boolean;
+   function "=" (Left, Right : Task_Id) return Boolean;
    pragma Inline ("=");
 
    function Image (T : Task_Id) return String;
@@ -63,7 +56,7 @@ pragma Preelaborate_05 (Task_Identification);
 
    procedure Abort_Task (T : Task_Id);
    pragma Inline (Abort_Task);
-   --  Note: parameter is mode IN, not IN OUT, per AI-00101.
+   --  Note: parameter is mode IN, not IN OUT, per AI-00101
 
    function Is_Terminated (T : Task_Id) return Boolean;
    pragma Inline (Is_Terminated);
@@ -75,13 +68,6 @@ private
 
    type Task_Id is new System.Tasking.Task_Id;
 
-   pragma Warnings (Off);
-   --  Allow non-static constant in Ada 2005 mode where this package will be
-   --  categorized as Preelaborate. See AI-362 for details. It is safe in the
-   --  context of the run-time to violate the rules!
-
-   Null_Task_Id : constant Task_Id := Task_Id (System.Tasking.Null_Task);
-
-   pragma Warnings (On);
+   Null_Task_Id : constant Task_Id := null;
 
 end Ada.Task_Identification;

gcc/ada/g-os_lib.adb

@@ -65,11 +65,14 @@ package body GNAT.OS_Lib is
 
    --  The following are used by Create_Temp_File
 
-   Current_Temp_File_Name : String := "GNAT-TEMP-000000.TMP";
+   First_Temp_File_Name : constant String := "GNAT-TEMP-000000.TMP";
+   --  Used to initialize Current_Temp_File_Name and Temp_File_Name_Last_Digit
+
+   Current_Temp_File_Name : String := First_Temp_File_Name;
    --  Name of the temp file last created
 
    Temp_File_Name_Last_Digit : constant Positive :=
-                                 Current_Temp_File_Name'Last - 4;
+                                 First_Temp_File_Name'Last - 4;
    --  Position of the last digit in Current_Temp_File_Name
 
    Max_Attempts : constant := 100;

gcc/ada/g-string.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1995-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1995-2005 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- --
@@ -36,6 +36,7 @@
 with Unchecked_Deallocation;
 
 package GNAT.Strings is
+   pragma Preelaborate;
 
    type String_Access is access all String;
    --  General purpose string access type. Note that the caller is

gcc/ada/s-auxdec-vms_64.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1996-2005 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- --
@@ -42,7 +42,7 @@
 with Unchecked_Conversion;
 
 package System.Aux_DEC is
-pragma Elaborate_Body (Aux_DEC);
+   pragma Preelaborate;
 
    subtype Short_Address is Address
      range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;

gcc/ada/s-auxdec.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1996-2005 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- --
@@ -40,7 +40,7 @@
 with Unchecked_Conversion;
 
 package System.Aux_DEC is
-pragma Elaborate_Body (Aux_DEC);
+   pragma Preelaborate;
 
    subtype Short_Address is Address;
    --  In some versions of System.Aux_DEC, notably that for VMS on the

gcc/ada/s-exctab.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1996-2005 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- --
@@ -43,9 +43,9 @@ package body System.Exception_Table is
    procedure Set_HT_Link (T : Exception_Data_Ptr; Next : Exception_Data_Ptr);
    function  Get_HT_Link (T : Exception_Data_Ptr) return Exception_Data_Ptr;
 
-   function Hash (F : Big_String_Ptr) return HTable_Headers;
-   function Equal (A, B : Big_String_Ptr) return Boolean;
-   function Get_Key (T : Exception_Data_Ptr) return Big_String_Ptr;
+   function Hash (F : System.Address) return HTable_Headers;
+   function Equal (A, B : System.Address) return Boolean;
+   function Get_Key (T : Exception_Data_Ptr) return System.Address;
 
    package Exception_HTable is new System.HTable.Static_HTable (
      Header_Num => HTable_Headers,
@@ -54,7 +54,7 @@ package body System.Exception_Table is
      Null_Ptr   => null,
      Set_Next   => Set_HT_Link,
      Next       => Get_HT_Link,
-     Key        => Big_String_Ptr,
+     Key        => System.Address,
      Get_Key    => Get_Key,
      Hash       => Hash,
      Equal      => Equal);
@@ -63,15 +63,17 @@ package body System.Exception_Table is
    -- Equal --
    -----------
 
-   function Equal (A, B : Big_String_Ptr) return Boolean is
-      J    : Integer := 1;
+   function Equal (A, B : System.Address) return Boolean is
+      S1 : constant Big_String_Ptr := To_Ptr (A);
+      S2 : constant Big_String_Ptr := To_Ptr (B);
+      J : Integer := 1;
 
    begin
       loop
-         if A (J) /= B (J) then
+         if S1 (J) /= S2 (J) then
             return False;
 
-         elsif A (J) = ASCII.NUL then
+         elsif S1 (J) = ASCII.NUL then
             return True;
 
          else
@@ -93,7 +95,7 @@ package body System.Exception_Table is
    -- Get_Key --
    -------------
 
-   function Get_Key (T : Exception_Data_Ptr) return Big_String_Ptr is
+   function Get_Key (T : Exception_Data_Ptr) return System.Address is
    begin
       return T.Full_Name;
    end Get_Key;
@@ -125,9 +127,10 @@ package body System.Exception_Table is
    -- Hash --
    ----------
 
-   function Hash (F : Big_String_Ptr) return HTable_Headers is
+   function Hash (F : System.Address) return HTable_Headers is
       type S is mod 2**8;
 
+      Str  : constant Big_String_Ptr := To_Ptr (F);
       Size : constant S := S (HTable_Headers'Last - HTable_Headers'First + 1);
       Tmp  : S := 0;
       J    : Positive;
@@ -135,10 +138,10 @@ package body System.Exception_Table is
    begin
       J := 1;
       loop
-         if F (J) = ASCII.NUL then
+         if Str (J) = ASCII.NUL then
             return HTable_Headers'First + HTable_Headers'Base (Tmp mod Size);
          else
-            Tmp := Tmp xor S (Character'Pos (F (J)));
+            Tmp := Tmp xor S (Character'Pos (Str (J)));
          end if;
          J := J + 1;
       end loop;
@@ -161,7 +164,7 @@ package body System.Exception_Table is
    begin
       Copy (X'Range) := X;
       Copy (Copy'Last) := ASCII.NUL;
-      Res := Exception_HTable.Get (To_Ptr (Copy'Address));
+      Res := Exception_HTable.Get (Copy'Address);
 
       --  If unknown exception, create it on the heap. This is a legitimate
       --  situation in the distributed case when an exception is defined only
@@ -175,7 +178,7 @@ package body System.Exception_Table is
              (Not_Handled_By_Others => False,
               Lang                  => 'A',
               Name_Length           => Copy'Length,
-              Full_Name             => To_Ptr (Dyn_Copy.all'Address),
+              Full_Name             => Dyn_Copy.all'Address,
               HTable_Ptr            => null,
               Import_Code           => 0,
               Raise_Hook            => null);

gcc/ada/s-inmaop-posix.adb

@@ -286,13 +286,14 @@ package body System.Interrupt_Management.Operations is
    end Setup_Interrupt_Mask;
 
 begin
-
    declare
       mask    : aliased sigset_t;
       allmask : aliased sigset_t;
       Result  : Interfaces.C.int;
 
    begin
+      Interrupt_Management.Initialize;
+
       for Sig in 1 .. Signal'Last loop
          Result := sigaction
            (Sig, null, Initial_Action (Sig)'Unchecked_Access);

gcc/ada/s-inmaop-vms.adb

@@ -295,6 +295,7 @@ package body System.Interrupt_Management.Operations is
    end Setup_Interrupt_Mask;
 
 begin
+   Interrupt_Management.Initialize;
    Environment_Mask := (others => False);
    All_Tasks_Mask := (others => True);
 

gcc/ada/s-intman-dummy.adb

@@ -35,4 +35,13 @@
 
 package body System.Interrupt_Management is
 
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      null;
+   end Initialize;
+
 end System.Interrupt_Management;

gcc/ada/s-intman-irix-athread.adb

@@ -34,9 +34,6 @@
 
 --  This is an Irix (old pthread library) version of this package.
 
---  PLEASE DO NOT add any dependences on other packages.
---  This package is designed to work with or without tasking support.
-
 --  Make a careful study of all signals available under the OS,
 --  to see which need to be reserved, kept always unmasked,
 --  or kept always unmasked.
@@ -49,6 +46,7 @@ with System.OS_Interface;
 
 with Interfaces.C;
 --  used for "int"
+
 package body System.Interrupt_Management is
 
    use System.OS_Interface;
@@ -82,25 +80,27 @@ package body System.Interrupt_Management is
    pragma Import
      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
 
-begin
-   declare
-      function State (Int : Interrupt_ID) return Character;
-      pragma Import (C, State, "__gnat_get_interrupt_state");
-      --  Get interrupt state.  Defined in a-init.c
-      --  The input argument is the interrupt number,
-      --  and the result is one of the following:
-
-      User    : constant Character := 'u';
-      Runtime : constant Character := 'r';
-      Default : constant Character := 's';
-      --    'n'   this interrupt not set by any Interrupt_State pragma
-      --    'u'   Interrupt_State pragma set state to User
-      --    'r'   Interrupt_State pragma set state to Runtime
-      --    's'   Interrupt_State pragma set state to System (use "default"
-      --           system handler)
-
+   function State (Int : Interrupt_ID) return Character;
+   pragma Import (C, State, "__gnat_get_interrupt_state");
+   --  Get interrupt state.  Defined in a-init.c
+   --  The input argument is the interrupt number,
+   --  and the result is one of the following:
+
+   User    : constant Character := 'u';
+   Runtime : constant Character := 'r';
+   Default : constant Character := 's';
+   --    'n'   this interrupt not set by any Interrupt_State pragma
+   --    'u'   Interrupt_State pragma set state to User
+   --    'r'   Interrupt_State pragma set state to Runtime
+   --    's'   Interrupt_State pragma set state to System (use "default"
+   --           system handler)
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
       use Interfaces.C;
-
    begin
       Abort_Task_Interrupt := Abort_Signal;
 
@@ -158,5 +158,6 @@ begin
       --  mark it as reserved.
 
       Reserve (0) := True;
-   end;
+   end Initialize;
+
 end System.Interrupt_Management;

gcc/ada/s-intman-irix.adb

@@ -34,9 +34,6 @@
 
 --  This is a SGI Pthread version of this package.
 
---  PLEASE DO NOT add any dependences on other packages.
---  This package is designed to work with or without tasking support.
-
 --  Make a careful study of all signals available under the OS,
 --  to see which need to be reserved, kept always unmasked,
 --  or kept always unmasked.
@@ -63,27 +60,36 @@ package body System.Interrupt_Management is
    pragma Import
      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
 
-   use type Interfaces.C.int;
+   function State (Int : Interrupt_ID) return Character;
+   pragma Import (C, State, "__gnat_get_interrupt_state");
+
+   --  Get interrupt state.  Defined in a-init.c
+   --  The input argument is the interrupt number,
+   --  and the result is one of the following:
 
-begin
-   declare
-      function State (Int : Interrupt_ID) return Character;
-      pragma Import (C, State, "__gnat_get_interrupt_state");
+   User    : constant Character := 'u';
+   Runtime : constant Character := 'r';
+   Default : constant Character := 's';
+   --    'n'   this interrupt not set by any Interrupt_State pragma
+   --    'u'   Interrupt_State pragma set state to User
+   --    'r'   Interrupt_State pragma set state to Runtime
+   --    's'   Interrupt_State pragma set state to System (use "default"
+   --           system handler)
 
-      --  Get interrupt state.  Defined in a-init.c
-      --  The input argument is the interrupt number,
-      --  and the result is one of the following:
+   ----------------
+   -- Initialize --
+   ----------------
 
-      User    : constant Character := 'u';
-      Runtime : constant Character := 'r';
-      Default : constant Character := 's';
-      --    'n'   this interrupt not set by any Interrupt_State pragma
-      --    'u'   Interrupt_State pragma set state to User
-      --    'r'   Interrupt_State pragma set state to Runtime
-      --    's'   Interrupt_State pragma set state to System (use "default"
-      --           system handler)
+   Initialized : Boolean := False;
 
+   procedure Initialize is
+      use type Interfaces.C.int;
    begin
+      if Initialized then
+         return;
+      end if;
+
+      Initialized := True;
       Abort_Task_Interrupt := SIGABRT;
 
       --  Change this if you want to use another signal for task abort.
@@ -137,5 +143,6 @@ begin
       --  mark it as reserved.
 
       Reserve (0) := True;
-   end;
+   end Initialize;
+
 end System.Interrupt_Management;

gcc/ada/s-intman-mingw.adb

@@ -33,34 +33,29 @@
 
 --  This is the NT version of this package
 
---  This file performs the system-dependent translation between machine
---  exceptions and the Ada exceptions, if any, that should be raised when they
---  occur.
+with System.OS_Interface; use System.OS_Interface;
 
---  PLEASE DO NOT add any dependences on other packages.
---  This package is designed to work with or without tasking support.
+package body System.Interrupt_Management is
 
---  See the other warnings in the package specification before making any
---  modifications to this file.
+   ----------------
+   -- Initialize --
+   ----------------
 
---  Make a careful study of all signals available under the OS, to see which
---  need to be reserved, kept always unmasked, or kept always unmasked. Be on
---  the lookout for special signals that may be used by the thread library.
+   procedure Initialize is
+   begin
+      --  "Reserve" all the interrupts, except those that are explicitely
+      --  defined.
 
-with System.OS_Interface; use System.OS_Interface;
-
-package body System.Interrupt_Management is
-begin
-   --  "Reserve" all the interrupts, except those that are explicitely defined
+      for J in Interrupt_ID'Range loop
+         Reserve (J) := True;
+      end loop;
 
-   for J in Interrupt_ID'Range loop
-      Reserve (J) := True;
-   end loop;
+      Reserve (SIGINT)  := False;
+      Reserve (SIGILL)  := False;
+      Reserve (SIGABRT) := False;
+      Reserve (SIGFPE)  := False;
+      Reserve (SIGSEGV) := False;
+      Reserve (SIGTERM) := False;
+   end Initialize;
 
-   Reserve (SIGINT)  := False;
-   Reserve (SIGILL)  := False;
-   Reserve (SIGABRT) := False;
-   Reserve (SIGFPE)  := False;
-   Reserve (SIGSEGV) := False;
-   Reserve (SIGTERM) := False;
 end System.Interrupt_Management;

gcc/ada/s-intman-posix.adb

@@ -33,12 +33,6 @@
 
 --  This is the POSIX threads version of this package
 
---  PLEASE DO NOT add any dependences on other packages. ??? why not ???
---  This package is designed to work with or without tasking support.
-
---  See the other warnings in the package specification before making
---  any modifications to this file.
-
 --  Make a careful study of all signals available under the OS, to see which
 --  need to be reserved, kept always unmasked, or kept always unmasked. Be on
 --  the lookout for special signals that may be used by the thread library.
@@ -88,6 +82,21 @@ package body System.Interrupt_Management is
    -- Local Subprograms --
    -----------------------
 
+   function State (Int : Interrupt_ID) return Character;
+   pragma Import (C, State, "__gnat_get_interrupt_state");
+   --  Get interrupt state. Defined in init.c
+   --  The input argument is the interrupt number,
+   --  and the result is one of the following:
+
+   User    : constant Character := 'u';
+   Runtime : constant Character := 'r';
+   Default : constant Character := 's';
+   --    'n'   this interrupt not set by any Interrupt_State pragma
+   --    'u'   Interrupt_State pragma set state to User
+   --    'r'   Interrupt_State pragma set state to Runtime
+   --    's'   Interrupt_State pragma set state to System (use "default"
+   --           system handler)
+
    procedure Notify_Exception
      (signo    : Signal;
       siginfo  : System.Address;
@@ -154,32 +163,24 @@ package body System.Interrupt_Management is
       end case;
    end Notify_Exception;
 
--------------------------
--- Package Elaboration --
--------------------------
+   ----------------
+   -- Initialize --
+   ----------------
 
-begin
-   declare
+   Initialized : Boolean := False;
+
+   procedure Initialize is
       act     : aliased struct_sigaction;
       old_act : aliased struct_sigaction;
       Result  : System.OS_Interface.int;
 
-      function State (Int : Interrupt_ID) return Character;
-      pragma Import (C, State, "__gnat_get_interrupt_state");
-      --  Get interrupt state. Defined in a-init.c
-      --  The input argument is the interrupt number,
-      --  and the result is one of the following:
-
-      User    : constant Character := 'u';
-      Runtime : constant Character := 'r';
-      Default : constant Character := 's';
-      --    'n'   this interrupt not set by any Interrupt_State pragma
-      --    'u'   Interrupt_State pragma set state to User
-      --    'r'   Interrupt_State pragma set state to Runtime
-      --    's'   Interrupt_State pragma set state to System (use "default"
-      --           system handler)
-
    begin
+      if Initialized then
+         return;
+      end if;
+
+      Initialized := True;
+
       --  Need to call pthread_init very early because it is doing signal
       --  initializations.
 
@@ -295,5 +296,6 @@ begin
       --  mark it as reserved.
 
       Reserve (0) := True;
-   end;
+   end Initialize;
+
 end System.Interrupt_Management;

gcc/ada/s-intman-solaris.adb

@@ -33,9 +33,6 @@
 
 --  This is a Solaris version of this package.
 
---  PLEASE DO NOT add any dependences on other packages.
---  This package is designed to work with or without tasking support.
-
 --  Make a careful study of all signals available under the OS,
 --  to see which need to be reserved, kept always unmasked,
 --  or kept always unmasked.
@@ -63,6 +60,21 @@ package body System.Interrupt_Management is
    pragma Import
      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
 
+   function State (Int : Interrupt_ID) return Character;
+   pragma Import (C, State, "__gnat_get_interrupt_state");
+   --  Get interrupt state.  Defined in init.c
+   --  The input argument is the interrupt number,
+   --  and the result is one of the following:
+
+   User    : constant Character := 'u';
+   Runtime : constant Character := 'r';
+   Default : constant Character := 's';
+   --    'n'   this interrupt not set by any Interrupt_State pragma
+   --    'u'   Interrupt_State pragma set state to User
+   --    'r'   Interrupt_State pragma set state to Runtime
+   --    's'   Interrupt_State pragma set state to System (use "default"
+   --           system handler)
+
    ----------------------
    -- Notify_Exception --
    ----------------------
@@ -86,8 +98,7 @@ package body System.Interrupt_Management is
       info    : access siginfo_t;
       context : access ucontext_t)
    is
-      pragma Warnings (Off, context);
-
+      pragma Unreferenced (context);
    begin
       --  Check that treatment of exception propagation here
       --  is consistent with treatment of the abort signal in
@@ -121,33 +132,25 @@ package body System.Interrupt_Management is
       end case;
    end Notify_Exception;
 
-----------------------------
--- Package Initialization --
-----------------------------
+   ----------------
+   -- Initialize --
+   ----------------
 
-begin
-   declare
+   Initialized : Boolean := False;
+
+   procedure Initialize is
       act     : aliased struct_sigaction;
       old_act : aliased struct_sigaction;
       mask    : aliased sigset_t;
       Result  : Interfaces.C.int;
 
-      function State (Int : Interrupt_ID) return Character;
-      pragma Import (C, State, "__gnat_get_interrupt_state");
-      --  Get interrupt state.  Defined in a-init.c
-      --  The input argument is the interrupt number,
-      --  and the result is one of the following:
-      --
-      User    : constant Character := 'u';
-      Runtime : constant Character := 'r';
-      Default : constant Character := 's';
-      --    'n'   this interrupt not set by any Interrupt_State pragma
-      --    'u'   Interrupt_State pragma set state to User
-      --    'r'   Interrupt_State pragma set state to Runtime
-      --    's'   Interrupt_State pragma set state to System (use "default"
-      --           system handler)
-
    begin
+      if Initialized then
+         return;
+      end if;
+
+      Initialized := True;
+
       --  Need to call pthread_init very early because it is doing signal
       --  initializations.
 
@@ -248,5 +251,6 @@ begin
       --  mark it as reserved.
 
       Reserve (0) := True;
-   end;
+   end Initialize;
+
 end System.Interrupt_Management;

gcc/ada/s-intman-vms.adb

@@ -38,20 +38,29 @@ with System.OS_Interface;
 
 package body System.Interrupt_Management is
 
-   use System.OS_Interface;
-   use type unsigned_long;
+   ----------------
+   -- Initialize --
+   ----------------
 
-begin
-   Abort_Task_Interrupt := Interrupt_ID_0;
-   --  Unused
+   Initialized : Boolean := False;
 
-   Reserve := Reserve or Keep_Unmasked or Keep_Masked;
-
-   Reserve (Interrupt_ID_0) := True;
-
-   declare
+   procedure Initialize is
+      use System.OS_Interface;
+      use type unsigned_long;
       Status : Cond_Value_Type;
+
    begin
+      if Initialized then
+         return;
+      end if;
+
+      Initialized := True;
+      Abort_Task_Interrupt := Interrupt_ID_0;
+      --  Unused
+
+      Reserve := Reserve or Keep_Unmasked or Keep_Masked;
+      Reserve (Interrupt_ID_0) := True;
+
       Sys_Crembx
         (Status => Status,
          Prmflg => False,
@@ -60,7 +69,6 @@ begin
          Bufquo => Interrupt_Bufquo,
          Lognam => "GNAT_Interrupt_Mailbox",
          Flags  => CMB_M_READONLY);
-
       pragma Assert ((Status and 1) = 1);
 
       Sys_Assign
@@ -68,7 +76,7 @@ begin
          Devnam => "GNAT_Interrupt_Mailbox",
          Chan   => Snd_Interrupt_Chan,
          Flags  => AGN_M_WRITEONLY);
-
       pragma Assert ((Status and 1) = 1);
-   end;
+   end Initialize;
+
 end System.Interrupt_Management;

gcc/ada/s-intman-vms.ads

@@ -39,16 +39,6 @@
 
 --  PLEASE DO NOT add any with-clauses to this package
 
---  This is designed to work for both tasking and non-tasking systems, without
---  pulling in any of the tasking support.
-
---  PLEASE DO NOT remove the Elaborate_Body pragma from this package.
---  Elaboration of this package should happen early, as most other
-
---  Forcing immediate elaboration of the body also helps to enforce the design
---  assumption that this is a second-level package, just one level above
---  System.OS_Interface, with no cross-dependences.
-
 --  PLEASE DO NOT put any subprogram declarations with arguments of type
 --  Interrupt_ID into the visible part of this package.
 
@@ -62,8 +52,7 @@ with System.OS_Interface;
 --           sigset_t
 
 package System.Interrupt_Management is
-
-   pragma Elaborate_Body;
+   pragma Preelaborate;
 
    type Interrupt_Mask is limited private;
 
@@ -110,6 +99,11 @@ package System.Interrupt_Management is
    --  example, if interrupts are OS signals and signal masking is per-task,
    --  use of the sigwait operation requires the signal be masked in all tasks.
 
+   procedure Initialize;
+   --  Initialize the various variables defined in this package.
+   --  This procedure must be called before accessing any object from this
+   --  package and can be called multiple times.
+
 private
    use type System.OS_Interface.unsigned_long;
 

gcc/ada/s-intman-vxworks.adb

@@ -33,15 +33,6 @@
 
 --  This is the VxWorks version of this package.
 
---  It is likely to need tailoring to fit each operating system
---  and machine architecture.
-
---  PLEASE DO NOT add any dependences on other packages.
---  This package is designed to work with or without tasking support.
-
---  See the other warnings in the package specification before making
---  any modifications to this file.
-
 --  Make a careful study of all signals available under the OS,
 --  to see which need to be reserved, kept always unmasked,
 --  or kept always unmasked.
@@ -74,6 +65,20 @@ package body System.Interrupt_Management is
    -- Local Subprograms --
    -----------------------
 
+   function State (Int : Interrupt_ID) return Character;
+   pragma Import (C, State, "__gnat_get_interrupt_state");
+   --  Get interrupt state.  Defined in init.c
+   --  The input argument is the interrupt number,
+   --  and the result is one of the following:
+
+   Runtime : constant Character := 'r';
+   Default : constant Character := 's';
+   --    'n'   this interrupt not set by any Interrupt_State pragma
+   --    'u'   Interrupt_State pragma set state to User
+   --    'r'   Interrupt_State pragma set state to Runtime
+   --    's'   Interrupt_State pragma set state to System (use "default"
+   --           system handler)
+
    procedure Notify_Exception (signo : Signal);
    --  Identify the Ada exception to be raised using
    --  the information when the system received a synchronous signal.
@@ -116,27 +121,21 @@ package body System.Interrupt_Management is
       end loop;
    end Initialize_Interrupts;
 
-begin
-   declare
-      mask   : aliased sigset_t;
-      Result : int;
-
-      function State (Int : Interrupt_ID) return Character;
-      pragma Import (C, State, "__gnat_get_interrupt_state");
-      --  Get interrupt state.  Defined in a-init.c
-      --  The input argument is the interrupt number,
-      --  and the result is one of the following:
+   ----------------
+   -- Initialize --
+   ----------------
 
-      Runtime : constant Character := 'r';
-      Default : constant Character := 's';
-      --    'n'   this interrupt not set by any Interrupt_State pragma
-      --    'u'   Interrupt_State pragma set state to User
-      --    'r'   Interrupt_State pragma set state to Runtime
-      --    's'   Interrupt_State pragma set state to System (use "default"
-      --           system handler)
+   Initialized : Boolean := False;
 
+   procedure Initialize is
+      mask   : aliased sigset_t;
+      Result : int;
    begin
-      --  Initialize signal handling
+      if Initialized then
+         return;
+      end if;
+
+      Initialized := True;
 
       --  Change this if you want to use another signal for task abort.
       --  SIGTERM might be a good one.
@@ -176,5 +175,6 @@ begin
       --  The abort signal must also be unmasked
 
       Keep_Unmasked (Abort_Task_Signal) := True;
-   end;
+   end Initialize;
+
 end System.Interrupt_Management;

gcc/ada/s-intman-vxworks.ads

@@ -40,13 +40,6 @@
 --  Unlike the original design, System.Interrupt_Management can only
 --  be used for tasking systems.
 
---  PLEASE DO NOT remove the Elaborate_Body pragma from this package.
---  Elaboration of this package should happen early, as most other
---  initializations depend on it. Forcing immediate elaboration of
---  the body also helps to enforce the design assumption that this
---  is a second-level package, just one level above System.OS_Interface
---  with no cross-dependencies.
-
 --  PLEASE DO NOT put any subprogram declarations with arguments of
 --  type Interrupt_ID into the visible part of this package. The type
 --  Interrupt_ID is used to derive the type in Ada.Interrupts, and
@@ -61,8 +54,7 @@ with Interfaces.C;
 --  used for int
 
 package System.Interrupt_Management is
-
-   pragma Elaborate_Body;
+   pragma Preelaborate;
 
    type Interrupt_Mask is limited private;
 
@@ -114,6 +106,11 @@ package System.Interrupt_Management is
    --  This procedure is used to initialize signal-to-exception mapping in
    --  each task.
 
+   procedure Initialize;
+   --  Initialize the various variables defined in this package.
+   --  This procedure must be called before accessing any object from this
+   --  package and can be called multiple times.
+
 private
    type Interrupt_Mask is new System.OS_Interface.sigset_t;
    --  In some implementation Interrupt_Mask can be represented as a linked

gcc/ada/s-intman.ads

@@ -38,13 +38,6 @@
 --  Unlike the original design, System.Interrupt_Management can only be used
 --  for tasking systems.
 
---  PLEASE DO NOT remove the Elaborate_Body pragma from this package.
---  Elaboration of this package should happen early, as most other
---  initializations depend on it. Forcing immediate elaboration of the body
---  also helps to enforce the design assumption that this is a second-level
---  package, just one level above System.OS_Interface with no
---  cross-dependencies.
-
 --  PLEASE DO NOT put any subprogram declarations with arguments of type
 --  Interrupt_ID into the visible part of this package. The type Interrupt_ID
 --  is used to derive the type in Ada.Interrupts, and adding more operations
@@ -59,8 +52,7 @@ with Interfaces.C;
 --  used for int
 
 package System.Interrupt_Management is
-
-   pragma Elaborate_Body;
+   pragma Preelaborate;
 
    type Interrupt_Mask is limited private;
 
@@ -103,6 +95,11 @@ package System.Interrupt_Management is
    --  example, it may be mapped to an exception used to implement task abort,
    --  or used to implement time delays.
 
+   procedure Initialize;
+   --  Initialize the various variables defined in this package.
+   --  This procedure must be called before accessing any object from this
+   --  package, and can be called multiple times.
+
 private
    type Interrupt_Mask is new System.OS_Interface.sigset_t;
    --  In some implementations Interrupt_Mask can be represented as a linked

gcc/ada/s-osprim-mingw.adb

@@ -33,7 +33,6 @@
 
 --  This is the NT version of this package
 
-with Ada.Exceptions;
 with Interfaces.C;
 
 package body System.OS_Primitives is
@@ -267,20 +266,35 @@ package body System.OS_Primitives is
       end if;
    end Timed_Delay;
 
---  Package elaboration, get starting time as base
+   ----------------
+   -- Initialize --
+   ----------------
 
-begin
-   if not QueryPerformanceFrequency (Tick_Frequency'Access) then
-      Ada.Exceptions.Raise_Exception
-        (Program_Error'Identity,
-         "cannot get high performance counter frequency");
-   end if;
+   Initialized : Boolean := False;
 
-   Get_Base_Time;
+   procedure Initialize is
+   begin
+      if Initialized then
+         return;
+      end if;
+
+      Initialized := True;
+
+      --  Get starting time as base
+
+      if not QueryPerformanceFrequency (Tick_Frequency'Access) then
+         raise Program_Error
+           with "cannot get high performance counter frequency";
+      end if;
+
+      Get_Base_Time;
+
+      --  Keep base clock and ticks for the monotonic clock. These values
+      --  should never be changed to ensure proper behavior of the monotonic
+      --  clock.
 
-   --  Keep base clock and ticks for the monotonic clock. These values should
-   --  never be changed to ensure proper behavior of the monotonic clock.
+      Base_Monotonic_Clock := Base_Clock;
+      Base_Monotonic_Ticks := Base_Ticks;
+   end Initialize;
 
-   Base_Monotonic_Clock := Base_Clock;
-   Base_Monotonic_Ticks := Base_Ticks;
 end System.OS_Primitives;

gcc/ada/s-osprim-os2.adb

@@ -167,6 +167,18 @@ package body System.OS_Primitives is
       end if;
    end Timed_Delay;
 
-begin
-   Set_Epoch_Offset;
+   ----------------
+   -- Initialize --
+   ----------------
+
+   Initialized : Boolean := False;
+
+   procedure Initialize is
+   begin
+      if not Initialized then
+         Initialized := True;
+         Set_Epoch_Offset;
+      end if;
+   end Initialize;
+
 end System.OS_Primitives;

gcc/ada/s-osprim-posix.adb

@@ -156,4 +156,13 @@ package body System.OS_Primitives is
       end if;
    end Timed_Delay;
 
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      null;
+   end Initialize;
+
 end System.OS_Primitives;

gcc/ada/s-osprim-solaris.adb

@@ -121,4 +121,13 @@ package body System.OS_Primitives is
       end if;
    end Timed_Delay;
 
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      null;
+   end Initialize;
+
 end System.OS_Primitives;

gcc/ada/s-osprim-unix.adb

@@ -121,4 +121,13 @@ package body System.OS_Primitives is
       end if;
    end Timed_Delay;
 
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      null;
+   end Initialize;
+
 end System.OS_Primitives;

gcc/ada/s-osprim-vms.adb

@@ -45,14 +45,22 @@ package body System.OS_Primitives is
    pragma Import (C, Get_GMToff, "get_gmtoff");
    --  Get the offset from GMT for this timezone
 
-   VMS_Epoch_Offset : constant Long_Integer :=
-                        10_000_000 *
-                          (3_506_716_800 + Long_Integer (Get_GMToff));
+   function VMS_Epoch_Offset return Long_Integer;
+   pragma Inline (VMS_Epoch_Offset);
    --  The offset between the Unix Epoch and the VMS Epoch
 
    subtype Cond_Value_Type is System.Aux_DEC.Unsigned_Longword;
    --  Condition Value return type
 
+   ----------------------
+   -- VMS_Epoch_Offset --
+   ----------------------
+
+   function VMS_Epoch_Offset return Long_Integer is
+   begin
+      return 10_000_000 * (3_506_716_800 + Long_Integer (Get_GMToff));
+   end VMS_Epoch_Offset;
+
    ----------------
    -- Sys_Schdwk --
    ----------------

gcc/ada/s-osprim-vms.ads

@@ -35,11 +35,12 @@
 --  delays in non tasking applications on Alpha/VMS
 
 --  The choice of the real clock/delay implementation (depending on whether
---  tasking is involved or not) is done via soft links (see s-tasoli.ads)
+--  tasking is involved or not) is done via soft links (see s-soflin.ads)
 
 --  NEVER add any dependency to tasking packages here
 
 package System.OS_Primitives is
+   pragma Preelaborate;
 
    subtype OS_Time is Long_Integer;
    --  System time on VMS is used for performance reasons.

gcc/ada/s-osprim-vxworks.adb

@@ -158,4 +158,13 @@ package body System.OS_Primitives is
       end if;
    end Timed_Delay;
 
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      null;
+   end Initialize;
+
 end System.OS_Primitives;

gcc/ada/s-osprim.ads

@@ -35,11 +35,12 @@
 --  delays in non tasking applications.
 
 --  The choice of the real clock/delay implementation (depending on whether
---  tasking is involved or not) is done via soft links (see s-tasoli.ads)
+--  tasking is involved or not) is done via soft links (see s-soflin.ads)
 
 --  NEVER add any dependency to tasking packages here
 
 package System.OS_Primitives is
+   pragma Preelaborate;
 
    Max_Sensible_Delay : constant Duration :=
                           Duration'Min (183 * 24 * 60 * 60.0,
@@ -53,6 +54,11 @@ package System.OS_Primitives is
    --  occurs in high integrity mode with 32-bit words, and possibly on
    --  some specific ports of GNAT), Duration'Last is used instead.
 
+   procedure Initialize;
+   --  Initialize global settings related to this package.
+   --  This procedure should be called before any other subprograms in
+   --  this package. Note that this procedure can be called several times.
+
    function Clock return Duration;
    pragma Inline (Clock);
    --  Returns "absolute" time, represented as an offset

gcc/ada/s-proinf-irix-athread.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-1999 Free Software Foundation, Inc.          --
+--          Copyright (C) 1997-2005 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- --
@@ -46,7 +46,9 @@
 --  then relink your application as usual.
 --
 
+pragma Warnings (Off);
 with GNAT.OS_Lib;
+pragma Warnings (On);
 
 package body System.Program_Info is
 

gcc/ada/s-proinf-irix-athread.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1997-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1997-2005 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- --
@@ -35,62 +35,45 @@
 --  to the run-time system at program startup for the SGI implementation.
 
 package System.Program_Info is
+   pragma Preelaborate;
 
    function Initial_Sproc_Count return Integer;
-   --
    --  The number of sproc created at program startup for scheduling
    --  threads.
-   --
 
-   function Max_Sproc_Count     return Integer;
-   --
+   function Max_Sproc_Count return Integer;
    --  The maximum number of sprocs that can be created by the program
    --  for servicing threads.  This limit includes both the pre-created
    --  sprocs and those explicitly created under program control.
-   --
 
-   function Sproc_Stack_Size    return Integer;
-   --
+   function Sproc_Stack_Size return Integer;
    --  The size, in bytes, of the sproc's initial stack.
-   --
 
    function Default_Time_Slice  return Duration;
-   --
    --  The default time quanta for round-robin scheduling of threads of
    --  equal priority.  This default value can be overridden on a per-task
    --  basis by specifying an alternate value via the implementation-defined
    --  Task_Info pragma. See s-tasinf.ads for more information.
-   --
 
-   function Default_Task_Stack  return Integer;
-   --
+   function Default_Task_Stack return Integer;
    --  The default stack size for each created thread.  This default value
    --  can be overriden on a per-task basis by the language-defined
    --  Storage_Size pragma.
-   --
 
-   function Stack_Guard_Pages   return Integer;
-   --
+   function Stack_Guard_Pages return Integer;
    --  The number of non-writable, guard pages to append to the bottom of
    --  each thread's stack.
-   --
 
    function Pthread_Sched_Signal return Integer;
-   --
    --  The signal used by the Pthreads library to affect scheduling actions
    --  in remote sprocs.
-   --
 
-   function Pthread_Arena_Size  return Integer;
-   --
+   function Pthread_Arena_Size return Integer;
    --  The size of the shared arena from which pthread locks are allocated.
    --  See the usinit(3p) man page for more information on shared arenas.
-   --
 
    function Os_Default_Priority return Integer;
-   --
    --  The default Irix Non-Degrading priority for each sproc created to
    --  service threads.
-   --
 
 end System.Program_Info;

gcc/ada/s-proinf.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 1996-2003 Free Software Foundation, Inc.        --
+--            Copyright (C) 1996-2005 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- --
@@ -35,6 +35,7 @@
 --  to the run-time system at program startup.
 
 package System.Program_Info is
+   pragma Preelaborate;
 
    function Default_Task_Stack return Integer;
    --  The default stack size for each created thread.  This default value

gcc/ada/s-soflin.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -35,26 +35,26 @@ pragma Polling (Off);
 --  We must turn polling off for this unit, because otherwise we get
 --  an infinite loop from the code within the Poll routine itself.
 
-with System.Machine_State_Operations; use System.Machine_State_Operations;
---  Used for Create_TSD, Destroy_TSD
-
 with System.Parameters;
 --  Used for Sec_Stack_Ratio
 
+pragma Warnings (Off);
+--  Disable warnings since System.Secondary_Stack is currently not
+--  Preelaborate
 with System.Secondary_Stack;
+pragma Warnings (On);
 
 package body System.Soft_Links is
 
    package SST renames System.Secondary_Stack;
 
-   --  Allocate an exception stack for the main program to use.
-   --  We make sure that the stack has maximum alignment. Some systems require
-   --  this (e.g. Sun), and in any case it is a good idea for efficiency.
-
    NT_Exc_Stack : array (0 .. 8192) of aliased Character;
    for NT_Exc_Stack'Alignment use Standard'Maximum_Alignment;
+   --  Allocate an exception stack for the main program to use.
+   --  This is currently only used under VMS.
 
    NT_TSD : TSD;
+   --  Note: we rely on the default initialization of NT_TSD.
 
    --------------------
    -- Abort_Defer_NT --
@@ -116,10 +116,6 @@ package body System.Soft_Links is
          SST.SS_Init
            (New_TSD.Sec_Stack_Addr, SST.Default_Secondary_Stack_Size);
       end if;
-
-      New_TSD.Machine_State_Addr :=
-        System.Address
-          (System.Machine_State_Operations.Allocate_Machine_State);
    end Create_TSD;
 
    -----------------------
@@ -138,8 +134,6 @@ package body System.Soft_Links is
    procedure Destroy_TSD (Old_TSD : in out TSD) is
    begin
       SST.SS_Free (Old_TSD.Sec_Stack_Addr);
-      System.Machine_State_Operations.Free_Machine_State
-        (Machine_State (Old_TSD.Machine_State_Addr));
    end Destroy_TSD;
 
    ---------------------
@@ -166,14 +160,14 @@ package body System.Soft_Links is
 
    function Get_Exc_Stack_Addr_NT return Address is
    begin
-      return NT_TSD.Exc_Stack_Addr;
+      return NT_Exc_Stack (NT_Exc_Stack'Last)'Address;
    end Get_Exc_Stack_Addr_NT;
 
    -----------------------------
    -- Get_Exc_Stack_Addr_Soft --
    -----------------------------
 
-   function Get_Exc_Stack_Addr_Soft return  Address is
+   function Get_Exc_Stack_Addr_Soft return Address is
    begin
       return Get_Exc_Stack_Addr.all;
    end Get_Exc_Stack_Addr_Soft;
@@ -205,24 +199,6 @@ package body System.Soft_Links is
       return Get_Jmpbuf_Address.all;
    end Get_Jmpbuf_Address_Soft;
 
-   -------------------------------
-   -- Get_Machine_State_Addr_NT --
-   -------------------------------
-
-   function Get_Machine_State_Addr_NT return  Address is
-   begin
-      return NT_TSD.Machine_State_Addr;
-   end Get_Machine_State_Addr_NT;
-
-   ---------------------------------
-   -- Get_Machine_State_Addr_Soft --
-   ---------------------------------
-
-   function Get_Machine_State_Addr_Soft return  Address is
-   begin
-      return Get_Machine_State_Addr.all;
-   end Get_Machine_State_Addr_Soft;
-
    ---------------------------
    -- Get_Sec_Stack_Addr_NT --
    ---------------------------
@@ -260,26 +236,6 @@ package body System.Soft_Links is
    end Null_Adafinal;
 
    ---------------------------
-   -- Set_Exc_Stack_Addr_NT --
-   ---------------------------
-
-   procedure Set_Exc_Stack_Addr_NT (Self_ID : Address; Addr : Address) is
-      pragma Warnings (Off, Self_ID);
-
-   begin
-      NT_TSD.Exc_Stack_Addr := Addr;
-   end Set_Exc_Stack_Addr_NT;
-
-   -----------------------------
-   -- Set_Exc_Stack_Addr_Soft --
-   -----------------------------
-
-   procedure Set_Exc_Stack_Addr_Soft (Self_ID : Address; Addr : Address) is
-   begin
-      Set_Exc_Stack_Addr (Self_ID, Addr);
-   end Set_Exc_Stack_Addr_Soft;
-
-   ---------------------------
    -- Set_Jmpbuf_Address_NT --
    ---------------------------
 
@@ -293,24 +249,6 @@ package body System.Soft_Links is
       Set_Jmpbuf_Address (Addr);
    end Set_Jmpbuf_Address_Soft;
 
-   -------------------------------
-   -- Set_Machine_State_Addr_NT --
-   -------------------------------
-
-   procedure Set_Machine_State_Addr_NT (Addr : Address) is
-   begin
-      NT_TSD.Machine_State_Addr := Addr;
-   end Set_Machine_State_Addr_NT;
-
-   ---------------------------------
-   -- Set_Machine_State_Addr_Soft --
-   ---------------------------------
-
-   procedure Set_Machine_State_Addr_Soft (Addr : Address) is
-   begin
-      Set_Machine_State_Addr (Addr);
-   end Set_Machine_State_Addr_Soft;
-
    ---------------------------
    -- Set_Sec_Stack_Addr_NT --
    ---------------------------
@@ -365,13 +303,4 @@ package body System.Soft_Links is
       return "main_task";
    end Task_Name_NT;
 
-   -------------------------
-   -- Package Elaboration --
-   -------------------------
-
-begin
-   NT_TSD.Exc_Stack_Addr := NT_Exc_Stack (8192)'Address;
-   Ada.Exceptions.Save_Occurrence
-     (NT_TSD.Current_Excep, Ada.Exceptions.Null_Occurrence);
-
 end System.Soft_Links;

gcc/ada/s-soflin.ads

@@ -32,7 +32,7 @@
 ------------------------------------------------------------------------------
 
 --  This package contains a set of subprogram access variables that access
---  some low-level primitives that are called different depending wether
+--  some low-level primitives that are called different depending whether
 --  tasking is involved or not (e.g. the Get/Set_Jmpbuf_Address that needs
 --  to provide a different value for each task). To avoid dragging in the
 --  tasking all the time, we use a system of soft links where the links are
@@ -43,7 +43,9 @@ with Ada.Exceptions;
 with System.Stack_Checking;
 
 package System.Soft_Links is
-   pragma Elaborate_Body;
+   pragma Warnings (Off);
+   pragma Preelaborate_05;
+   pragma Warnings (On);
 
    subtype EOA is Ada.Exceptions.Exception_Occurrence_Access;
    subtype EO is Ada.Exceptions.Exception_Occurrence;
@@ -210,21 +212,8 @@ package System.Soft_Links is
    Get_Sec_Stack_Addr : Get_Address_Call := Get_Sec_Stack_Addr_NT'Access;
    Set_Sec_Stack_Addr : Set_Address_Call := Set_Sec_Stack_Addr_NT'Access;
 
-   function  Get_Machine_State_Addr_NT return  Address;
-   procedure Set_Machine_State_Addr_NT (Addr : Address);
-
-   Get_Machine_State_Addr : Get_Address_Call
-     := Get_Machine_State_Addr_NT'Access;
-   Set_Machine_State_Addr : Set_Address_Call
-     := Set_Machine_State_Addr_NT'Access;
-
-   function  Get_Exc_Stack_Addr_NT return Address;
-   procedure Set_Exc_Stack_Addr_NT (Self_ID : Address; Addr : Address);
-   --  Self_ID is a Task_Id, but in the non-tasking case there is no
-   --  Task_Id type available, so make do with Address.
-
+   function Get_Exc_Stack_Addr_NT return Address;
    Get_Exc_Stack_Addr : Get_Address_Call := Get_Exc_Stack_Addr_NT'Access;
-   Set_Exc_Stack_Addr : Set_Address_Call2 := Set_Exc_Stack_Addr_NT'Access;
 
    function  Get_Current_Excep_NT return EOA;
 
@@ -302,24 +291,18 @@ package System.Soft_Links is
       --  to the tasks requested stack size before the task can do
       --  its first stack check.
 
-      Jmpbuf_Address : Address := Null_Address;
+      pragma Warnings (Off);
+      Jmpbuf_Address : System.Address := System.Null_Address;
       --  Address of jump buffer used to store the address of the
       --  current longjmp/setjmp buffer for exception management.
       --  These buffers are threaded into a stack, and the address
       --  here is the top of the stack. A null address means that
       --  no exception handler is currently active.
 
-      Sec_Stack_Addr : Address := Null_Address;
+      Sec_Stack_Addr : System.Address := System.Null_Address;
+      pragma Warnings (On);
       --  Address of currently allocated secondary stack
 
-      Exc_Stack_Addr : Address := Null_Address;
-      --  Address of a task-specific stack used for the propagation of
-      --  exceptions in response to synchronous faults. This alternate
-      --  stack is necessary when propagating Storage_Error resulting
-      --  from a stack overflow, as the task's primary stack is full.
-      --  This is currently only used on the SGI, and this value stays
-      --  null on other platforms.
-
       Current_Excep : aliased EO;
       --  Exception occurrence that contains the information for the
       --  current exception. Note that any exception in the same task
@@ -328,9 +311,6 @@ package System.Soft_Links is
       --
       --  Also act as a list of the active exceptions in the case of the GCC
       --  exception mechanism, organized as a stack with the most recent first.
-
-      Machine_State_Addr : Address := Null_Address;
-      --  Machine state address. Used by front-end zero cost exception
    end record;
 
    procedure Create_TSD (New_TSD : in out TSD);
@@ -340,7 +320,7 @@ package System.Soft_Links is
 
    procedure Destroy_TSD (Old_TSD : in out TSD);
    pragma Inline (Destroy_TSD);
-   --  Called from s-tassta  just before a thread is destroyed to perform
+   --  Called from s-tassta just before a thread is destroyed to perform
    --  any required finalization.
 
    function Get_GNAT_Exception return Ada.Exceptions.Exception_Id;
@@ -364,14 +344,6 @@ package System.Soft_Links is
    pragma Inline (Get_Sec_Stack_Addr_Soft);
    pragma Inline (Set_Sec_Stack_Addr_Soft);
 
-   function  Get_Exc_Stack_Addr_Soft return Address;
-   procedure Set_Exc_Stack_Addr_Soft (Self_ID : Address; Addr : Address);
-   pragma Inline (Get_Exc_Stack_Addr_Soft);
-   pragma Inline (Set_Exc_Stack_Addr_Soft);
-
-   function  Get_Machine_State_Addr_Soft return Address;
-   procedure Set_Machine_State_Addr_Soft (Addr : Address);
-   pragma Inline (Get_Machine_State_Addr_Soft);
-   pragma Inline (Set_Machine_State_Addr_Soft);
+   function Get_Exc_Stack_Addr_Soft return Address;
 
 end System.Soft_Links;

gcc/ada/s-solita.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 2004, Free Software Foundation, Inc.           --
+--          Copyright (C) 2004-2005, 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- --
@@ -47,9 +47,6 @@ with System.Task_Primitives.Operations;
 with System.Tasking;
 --  Used for Task_Id
 
-with Ada.Exceptions;
---  Used for Raise_Exception
-
 package body System.Soft_Links.Tasking is
 
    package STPO renames System.Task_Primitives.Operations;
@@ -75,10 +72,6 @@ package body System.Soft_Links.Tasking is
    procedure Set_Sec_Stack_Addr (Addr : Address);
    --  Get/Set location of current task's secondary stack
 
-   function  Get_Machine_State_Addr return Address;
-   procedure Set_Machine_State_Addr (Addr : Address);
-   --  Get/Set the address for storing the current task's machine state
-
    function Get_Current_Excep return SSL.EOA;
    --  Task-safe version of SSL.Get_Current_Excep
 
@@ -99,11 +92,6 @@ package body System.Soft_Links.Tasking is
       return STPO.Self.Common.Compiler_Data.Jmpbuf_Address;
    end Get_Jmpbuf_Address;
 
-   function Get_Machine_State_Addr return Address is
-   begin
-      return STPO.Self.Common.Compiler_Data.Machine_State_Addr;
-   end Get_Machine_State_Addr;
-
    function Get_Sec_Stack_Addr return  Address is
    begin
       return STPO.Self.Common.Compiler_Data.Sec_Stack_Addr;
@@ -118,11 +106,6 @@ package body System.Soft_Links.Tasking is
       STPO.Self.Common.Compiler_Data.Jmpbuf_Address := Addr;
    end Set_Jmpbuf_Address;
 
-   procedure Set_Machine_State_Addr (Addr : Address) is
-   begin
-      STPO.Self.Common.Compiler_Data.Machine_State_Addr := Addr;
-   end Set_Machine_State_Addr;
-
    procedure Set_Sec_Stack_Addr (Addr : Address) is
    begin
       STPO.Self.Common.Compiler_Data.Sec_Stack_Addr := Addr;
@@ -143,12 +126,12 @@ package body System.Soft_Links.Tasking is
       if System.Tasking.Detect_Blocking
         and then Self_Id.Common.Protected_Action_Nesting > 0
       then
-         Ada.Exceptions.Raise_Exception
-           (Program_Error'Identity, "potentially blocking operation");
+         raise Program_Error with "potentially blocking operation";
       else
+         Abort_Defer.all;
          STPO.Timed_Delay (Self_Id, Time, Mode);
+         Abort_Undefer.all;
       end if;
-
    end Timed_Delay_T;
 
    -----------------------------
@@ -172,8 +155,6 @@ package body System.Soft_Links.Tasking is
          SSL.Set_Jmpbuf_Address     := Set_Jmpbuf_Address'Access;
          SSL.Get_Sec_Stack_Addr     := Get_Sec_Stack_Addr'Access;
          SSL.Set_Sec_Stack_Addr     := Set_Sec_Stack_Addr'Access;
-         SSL.Get_Machine_State_Addr := Get_Machine_State_Addr'Access;
-         SSL.Set_Machine_State_Addr := Set_Machine_State_Addr'Access;
          SSL.Get_Current_Excep      := Get_Current_Excep'Access;
          SSL.Timed_Delay            := Timed_Delay_T'Access;
 
@@ -182,7 +163,6 @@ package body System.Soft_Links.Tasking is
 
          SSL.Set_Sec_Stack_Addr     (SSL.Get_Sec_Stack_Addr_NT);
          SSL.Set_Jmpbuf_Address     (SSL.Get_Jmpbuf_Address_NT);
-         SSL.Set_Machine_State_Addr (SSL.Get_Machine_State_Addr_NT);
       end if;
    end Init_Tasking_Soft_Links;
 

gcc/ada/s-stache.ads

@@ -40,7 +40,7 @@
 with System.Storage_Elements;
 
 package System.Stack_Checking is
-
+   pragma Preelaborate;
    pragma Elaborate_Body;
    --  This unit has a junk null body. The reason is that historically we
    --  used to have a real body, and it causes bootstrapping path problems

gcc/ada/s-stalib.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -54,11 +54,9 @@ with System;
 with Unchecked_Conversion;
 
 package System.Standard_Library is
-
-   pragma Suppress (All_Checks);
-   --  Suppress explicitely all the checks to work around the Solaris linker
-   --  bug when using gnatmake -f -a (but without -gnatp). This is not needed
-   --  with Solaris 2.6, so eventually can be removed ???
+   pragma Warnings (Off);
+   pragma Preelaborate_05;
+   pragma Warnings (On);
 
    type Big_String_Ptr is access all String (Positive);
    --  A non-fat pointer type for null terminated strings
@@ -137,8 +135,9 @@ package System.Standard_Library is
       Name_Length : Natural;
       --  Length of fully expanded name of exception
 
-      Full_Name : Big_String_Ptr;
+      Full_Name : System.Address;
       --  Fully expanded name of exception, null terminated
+      --  You can use To_Ptr to convert this to a string.
 
       HTable_Ptr : Exception_Data_Ptr;
       --  Hash table pointer used to link entries together in the hash table
@@ -157,7 +156,6 @@ package System.Standard_Library is
       --  whenever the exception is raised. This call occurs immediately,
       --  before any other actions taken by the raise (and in particular
       --  before any unwinding of the stack occurs).
-
    end record;
 
    --  Definitions for standard predefined exceptions defined in Standard,
@@ -179,7 +177,7 @@ package System.Standard_Library is
      (Not_Handled_By_Others => False,
       Lang                  => 'A',
       Name_Length           => Constraint_Error_Name'Length,
-      Full_Name             => To_Ptr (Constraint_Error_Name'Address),
+      Full_Name             => Constraint_Error_Name'Address,
       HTable_Ptr            => null,
       Import_Code           => 0,
       Raise_Hook            => null);
@@ -188,7 +186,7 @@ package System.Standard_Library is
      (Not_Handled_By_Others => False,
       Lang                  => 'A',
       Name_Length           => Numeric_Error_Name'Length,
-      Full_Name             => To_Ptr (Numeric_Error_Name'Address),
+      Full_Name             => Numeric_Error_Name'Address,
       HTable_Ptr            => null,
       Import_Code           => 0,
       Raise_Hook            => null);
@@ -197,7 +195,7 @@ package System.Standard_Library is
      (Not_Handled_By_Others => False,
       Lang                  => 'A',
       Name_Length           => Program_Error_Name'Length,
-      Full_Name             => To_Ptr (Program_Error_Name'Address),
+      Full_Name             => Program_Error_Name'Address,
       HTable_Ptr            => null,
       Import_Code           => 0,
       Raise_Hook            => null);
@@ -206,7 +204,7 @@ package System.Standard_Library is
      (Not_Handled_By_Others => False,
       Lang                  => 'A',
       Name_Length           => Storage_Error_Name'Length,
-      Full_Name             => To_Ptr (Storage_Error_Name'Address),
+      Full_Name             => Storage_Error_Name'Address,
       HTable_Ptr            => null,
       Import_Code           => 0,
       Raise_Hook            => null);
@@ -215,7 +213,7 @@ package System.Standard_Library is
      (Not_Handled_By_Others => False,
       Lang                  => 'A',
       Name_Length           => Tasking_Error_Name'Length,
-      Full_Name             => To_Ptr (Tasking_Error_Name'Address),
+      Full_Name             => Tasking_Error_Name'Address,
       HTable_Ptr            => null,
       Import_Code           => 0,
       Raise_Hook            => null);
@@ -224,7 +222,7 @@ package System.Standard_Library is
      (Not_Handled_By_Others => True,
       Lang                  => 'A',
       Name_Length           => Abort_Signal_Name'Length,
-      Full_Name             => To_Ptr (Abort_Signal_Name'Address),
+      Full_Name             => Abort_Signal_Name'Address,
       HTable_Ptr            => null,
       Import_Code           => 0,
       Raise_Hook            => null);

gcc/ada/s-taprob.adb

@@ -241,7 +241,9 @@ package body System.Tasking.Protected_Objects is
    end Unlock;
 
 begin
-   --  Ensure that tasking soft links are set when using protected objects
+   --  Ensure that tasking is initialized, as well as tasking soft links
+   --  when using protected objects.
 
+   Tasking.Initialize;
    System.Soft_Links.Tasking.Init_Tasking_Soft_Links;
 end System.Tasking.Protected_Objects;

gcc/ada/s-taprop-dummy.adb

@@ -40,10 +40,6 @@ pragma Polling (Off);
 --  Turn off polling, we do not want ATC polling to take place during
 --  tasking operations. It causes infinite loops and other problems.
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
-
 with System.Error_Reporting;
 --  used for Shutdown
 
@@ -55,9 +51,6 @@ package body System.Task_Primitives.Operations is
    pragma Warnings (Off);
    --  Turn off warnings since so many unreferenced parameters
 
-   No_Tasking : Boolean;
-   --  Comment required here ???
-
    ----------------
    -- Abort_Task --
    ----------------
@@ -193,8 +186,11 @@ package body System.Task_Primitives.Operations is
    ----------------
 
    procedure Initialize (Environment_Task : Task_Id) is
+      No_Tasking : Boolean;
    begin
-      null;
+      No_Tasking :=
+        System.Error_Reporting.Shutdown
+          ("Tasking not implemented on this configuration");
    end Initialize;
 
    procedure Initialize (S : in out Suspension_Object) is
@@ -479,11 +475,4 @@ package body System.Task_Primitives.Operations is
       null;
    end Yield;
 
-begin
-   --  Can't raise an exception because target independent packages try to
-   --  do an Abort_Defer, which gets a memory fault.
-
-   No_Tasking :=
-     System.Error_Reporting.Shutdown
-       ("Tasking not implemented on this configuration");
 end System.Task_Primitives.Operations;

gcc/ada/s-taprop-hpux-dce.adb

@@ -43,41 +43,32 @@ pragma Polling (Off);
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
-with Interfaces.C;
---  used for int
---           size_t
-
 with System.Interrupt_Management;
 --  used for Keep_Unmasked
 --           Abort_Task_Interrupt
 --           Interrupt_ID
 
+pragma Warnings (Off);
 with System.Interrupt_Management.Operations;
 --  used for Set_Interrupt_Mask
 --           All_Tasks_Mask
 pragma Elaborate_All (System.Interrupt_Management.Operations);
 
+pragma Warnings (On);
+
+with System.OS_Primitives;
+--  used for Delay_Modes
+
+with Interfaces.C;
+--  used for int
+--           size_t
+
 with System.Parameters;
 --  used for Size_Type
 
 with System.Task_Primitives.Interrupt_Operations;
 --  used for Get_Interrupt_ID
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
-
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
-
 with Unchecked_Conversion;
 with Unchecked_Deallocation;
 
@@ -91,7 +82,6 @@ package body System.Task_Primitives.Operations is
    use System.OS_Primitives;
 
    package PIO renames System.Task_Primitives.Interrupt_Operations;
-   package SSL renames System.Soft_Links;
 
    ----------------
    -- Local Data --
@@ -124,9 +114,6 @@ package body System.Task_Primitives.Operations is
    --  is not implemented for DCE threads. The HPUX 10 port is at this
    --  stage considered dead, and no further work is planned on it.
 
-   FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-   --  Indicates whether FIFO_Within_Priorities is set
-
    Foreign_Task_Elaborated : aliased Boolean := True;
    --  Used to identified fake tasks (i.e., non-Ada Threads)
 
@@ -495,11 +482,6 @@ package body System.Task_Primitives.Operations is
       Result     : Interfaces.C.int;
 
    begin
-      --  The little window between deferring abort and locking Self_ID is the
-      --  only reason to check for pending abort and priority change below!
-
-      SSL.Abort_Defer.all;
-
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -550,7 +532,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Result := sched_yield;
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ---------------------
@@ -632,7 +613,7 @@ package body System.Task_Primitives.Operations is
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_RR, Param'Access);
 
-      elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
+      elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
 
@@ -643,7 +624,7 @@ package body System.Task_Primitives.Operations is
 
       pragma Assert (Result = 0);
 
-      if FIFO_Within_Priorities then
+      if Dispatching_Policy = 'F' then
 
          --  Annex D requirement [RM D.2.2 par. 9]:
          --    If the task drops its priority due to the loss of inherited
@@ -1162,6 +1143,8 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
+      Interrupt_Management.Initialize;
+
       --  Initialize the lock used to synchronize chain of all ATCBs
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);

gcc/ada/s-taprop-irix-athread.adb

@@ -47,20 +47,19 @@ with Interfaces.C;
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
-with System.Task_Info;
-
 with System.Interrupt_Management;
 --  used for Keep_Unmasked
 --           Abort_Task_Interrupt
 --           Interrupt_ID
 
+with System.OS_Primitives;
+--  used for Delay_Modes
+
+with System.Task_Info;
+
 with System.Parameters;
 --  used for Size_Type
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
-
 with System.Program_Info;
 --  used for Default_Task_Stack
 --           Default_Time_Slice
@@ -68,17 +67,6 @@ with System.Program_Info;
 --           Pthread_Sched_Signal
 --           Pthread_Arena_Size
 
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
-
 with System.Storage_Elements;
 --  used for To_Address
 
@@ -94,8 +82,6 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use System.OS_Primitives;
 
-   package SSL renames System.Soft_Links;
-
    -----------------
    -- Local Data  --
    -----------------
@@ -433,12 +419,6 @@ package body System.Task_Primitives.Operations is
       Result     : Interfaces.C.int;
 
    begin
-      --  Only the little window between deferring abort and
-      --  locking Self_ID is the reason we need to
-      --  check for pending abort and priority change below!
-
-      SSL.Abort_Defer.all;
-
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -490,7 +470,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       pthread_yield;
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ---------------------
@@ -819,7 +798,7 @@ package body System.Task_Primitives.Operations is
       pragma Assert (Result = 0);
    end Abort_Task;
 
-      ----------------
+   ----------------
    -- Initialize --
    ----------------
 
@@ -1087,7 +1066,9 @@ package body System.Task_Primitives.Operations is
 
    procedure Initialize (Environment_Task : Task_Id) is
    begin
+      Initialize_Athread_Library;
       Environment_Task_Id := Environment_Task;
+      Interrupt_Management.Initialize;
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
       --  Initialize the lock used to synchronize chain of all ATCBs.
@@ -1126,8 +1107,4 @@ package body System.Task_Primitives.Operations is
       end if;
    end Initialize_Athread_Library;
 
---  Package initialization
-
-begin
-   Initialize_Athread_Library;
 end System.Task_Primitives.Operations;

gcc/ada/s-taprop-irix.adb

@@ -49,28 +49,19 @@ with System.Task_Info;
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
-with System.IO;
---  used for Put_Line
-
 with System.Interrupt_Management;
 --  used for Keep_Unmasked
 --           Abort_Task_Interrupt
 --           Interrupt_ID
 
-with System.Parameters;
---  used for Size_Type
-
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
+with System.OS_Primitives;
+--  used for Delay_Modes
 
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
+with System.IO;
+--  used for Put_Line
 
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
+with System.Parameters;
+--  used for Size_Type
 
 with System.Program_Info;
 --  used for Default_Task_Stack
@@ -82,9 +73,6 @@ with System.Program_Info;
 with System.OS_Interface;
 --  used for various type, constant, and operations
 
-with System.OS_Primitives;
---  used for Delay_Modes
-
 with Unchecked_Conversion;
 with Unchecked_Deallocation;
 
@@ -97,8 +85,6 @@ package body System.Task_Primitives.Operations is
    use System.OS_Primitives;
    use System.Parameters;
 
-   package SSL renames System.Soft_Links;
-
    ----------------
    -- Local Data --
    ----------------
@@ -515,12 +501,6 @@ package body System.Task_Primitives.Operations is
       Result     : Interfaces.C.int;
 
    begin
-      --  The little window between deferring abort and locking Self_ID is
-      --  the only reason we need to check for pending abort and priority
-      --  change below!
-
-      SSL.Abort_Defer.all;
-
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -565,7 +545,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Yield;
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ---------------------
@@ -1243,6 +1222,8 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
+      Interrupt_Management.Initialize;
+
       --  Initialize the lock used to synchronize chain of all ATCBs.
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
@@ -1251,6 +1232,18 @@ package body System.Task_Primitives.Operations is
 
       Enter_Task (Environment_Task);
 
+      --  Prepare the set of signals that should unblocked in all tasks
+
+      Result := sigemptyset (Unblocked_Signal_Mask'Access);
+      pragma Assert (Result = 0);
+
+      for J in Interrupt_Management.Interrupt_ID loop
+         if System.Interrupt_Management.Keep_Unmasked (J) then
+            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+            pragma Assert (Result = 0);
+         end if;
+      end loop;
+
       --  Install the abort-signal handler
 
       if State (System.Interrupt_Management.Abort_Task_Interrupt)
@@ -1272,30 +1265,4 @@ package body System.Task_Primitives.Operations is
       end if;
    end Initialize;
 
-begin
-   declare
-      Result : Interfaces.C.int;
-   begin
-      --  Prepare the set of signals that should unblocked in all tasks
-
-      Result := sigemptyset (Unblocked_Signal_Mask'Access);
-      pragma Assert (Result = 0);
-
-      for J in Interrupt_Management.Interrupt_ID loop
-         if System.Interrupt_Management.Keep_Unmasked (J) then
-            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-            pragma Assert (Result = 0);
-         end if;
-      end loop;
-
-      --  Pick the highest resolution Clock for Clock_Realtime
-
-      --  ??? This code currently doesn't work (see c94007[ab] for example)
-
-      --  if syssgi (SGI_CYCLECNTR_SIZE) = 64 then
-      --     Real_Time_Clock_Id := CLOCK_SGI_CYCLE;
-      --  else
-      --     Real_Time_Clock_Id := CLOCK_REALTIME;
-      --  end if;
-   end;
 end System.Task_Primitives.Operations;

gcc/ada/s-taprop-linux.adb

@@ -40,44 +40,32 @@ pragma Polling (Off);
 --  Turn off polling, we do not want ATC polling to take place during
 --  tasking operations. It causes infinite loops and other problems.
 
-with System.Tasking.Debug;
---  used for Known_Tasks
-
 with Interfaces.C;
 --  used for int
 --           size_t
 
+with System.Parameters;
+--  used for Size_Type
+
+with System.Tasking.Debug;
+--  used for Known_Tasks
+
 with System.Interrupt_Management;
 --  used for Keep_Unmasked
 --           Abort_Task_Interrupt
 --           Interrupt_ID
 
-with System.Parameters;
---  used for Size_Type
+with System.OS_Primitives;
+--  used for Delay_Modes
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
+with System.Soft_Links;
+--  used for Abort_Defer/Undefer
 
 with Ada.Exceptions;
 --  used for Raise_Exception
 --           Raise_From_Signal_Handler
 --           Exception_Id
 
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
-
-with System.Soft_Links;
---  used for Abort_Defer/Undefer
-
 with Unchecked_Conversion;
 with Unchecked_Deallocation;
 
@@ -90,8 +78,6 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use System.OS_Primitives;
 
-   package SSL renames System.Soft_Links;
-
    ----------------
    -- Local Data --
    ----------------
@@ -111,12 +97,10 @@ package body System.Task_Primitives.Operations is
    --  A variable to hold Task_Id for the environment task
 
    Unblocked_Signal_Mask : aliased sigset_t;
-   --  The set of signals that should unblocked in all tasks
+   --  The set of signals that should be unblocked in all tasks
 
    --  The followings are internal configuration constants needed
 
-   Priority_Ceiling_Emulation : constant Boolean := True;
-
    Next_Serial_Number : Task_Serial_Number := 100;
    --  We start at 100, to reserve some special values for
    --  using in error checking.
@@ -127,9 +111,6 @@ package body System.Task_Primitives.Operations is
    Dispatching_Policy : Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-   --  Indicates whether FIFO_Within_Priorities is set
-
    --  The following are effectively constants, but they need to
    --  be initialized by calling a pthread_ function.
 
@@ -280,14 +261,11 @@ package body System.Task_Primitives.Operations is
      (Prio : System.Any_Priority;
       L    : access Lock)
    is
-      Result : Interfaces.C.int;
+      pragma Unreferenced (Prio);
 
+      Result : Interfaces.C.int;
    begin
-      if Priority_Ceiling_Emulation then
-         L.Ceiling := Prio;
-      end if;
-
-      Result := pthread_mutex_init (L.L'Access, Mutex_Attr'Access);
+      Result := pthread_mutex_init (L, Mutex_Attr'Access);
 
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
@@ -319,7 +297,7 @@ package body System.Task_Primitives.Operations is
    procedure Finalize_Lock (L : access Lock) is
       Result : Interfaces.C.int;
    begin
-      Result := pthread_mutex_destroy (L.L'Access);
+      Result := pthread_mutex_destroy (L);
       pragma Assert (Result = 0);
    end Finalize_Lock;
 
@@ -336,37 +314,13 @@ package body System.Task_Primitives.Operations is
 
    procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
       Result : Interfaces.C.int;
-
    begin
-      if Priority_Ceiling_Emulation then
-         declare
-            Self_ID : constant Task_Id := Self;
-
-         begin
-            if Self_ID.Common.LL.Active_Priority > L.Ceiling then
-               Ceiling_Violation := True;
-               return;
-            end if;
-
-            L.Saved_Priority := Self_ID.Common.LL.Active_Priority;
+      Result := pthread_mutex_lock (L);
+      Ceiling_Violation := Result = EINVAL;
 
-            if Self_ID.Common.LL.Active_Priority < L.Ceiling then
-               Self_ID.Common.LL.Active_Priority := L.Ceiling;
-            end if;
-
-            Result := pthread_mutex_lock (L.L'Access);
-            pragma Assert (Result = 0);
-            Ceiling_Violation := False;
-         end;
-
-      else
-         Result := pthread_mutex_lock (L.L'Access);
-         Ceiling_Violation := Result = EINVAL;
-
-         --  Assume the cause of EINVAL is a priority ceiling violation
+      --  Assume the cause of EINVAL is a priority ceiling violation
 
-         pragma Assert (Result = 0 or else Result = EINVAL);
-      end if;
+      pragma Assert (Result = 0 or else Result = EINVAL);
    end Write_Lock;
 
    procedure Write_Lock
@@ -405,25 +359,9 @@ package body System.Task_Primitives.Operations is
 
    procedure Unlock (L : access Lock) is
       Result : Interfaces.C.int;
-
    begin
-      if Priority_Ceiling_Emulation then
-         declare
-            Self_ID : constant Task_Id := Self;
-
-         begin
-            Result := pthread_mutex_unlock (L.L'Access);
-            pragma Assert (Result = 0);
-
-            if Self_ID.Common.LL.Active_Priority > L.Saved_Priority then
-               Self_ID.Common.LL.Active_Priority := L.Saved_Priority;
-            end if;
-         end;
-
-      else
-         Result := pthread_mutex_unlock (L.L'Access);
-         pragma Assert (Result = 0);
-      end if;
+      Result := pthread_mutex_unlock (L);
+      pragma Assert (Result = 0);
    end Unlock;
 
    procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
@@ -553,14 +491,8 @@ package body System.Task_Primitives.Operations is
       Abs_Time   : Duration;
       Request    : aliased timespec;
       Result     : Interfaces.C.int;
-   begin
-
-      --  Only the little window between deferring abort and
-      --  locking Self_ID is the reason we need to
-      --  check for pending abort and priority change below! :(
-
-      SSL.Abort_Defer.all;
 
+   begin
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -611,7 +543,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Result := sched_yield;
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ---------------------
@@ -678,12 +609,6 @@ package body System.Task_Primitives.Operations is
    begin
       T.Common.Current_Priority := Prio;
 
-      if Priority_Ceiling_Emulation then
-         if T.Common.LL.Active_Priority < Prio then
-            T.Common.LL.Active_Priority := Prio;
-         end if;
-      end if;
-
       --  Priorities are in range 1 .. 99 on GNU/Linux, so we map
       --  map 0 .. 31 to 1 .. 32
 
@@ -693,7 +618,7 @@ package body System.Task_Primitives.Operations is
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_RR, Param'Access);
 
-      elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
+      elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
 
@@ -1167,6 +1092,26 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
+      Interrupt_Management.Initialize;
+
+      --  Prepare the set of signals that should be unblocked in all tasks
+
+      Result := sigemptyset (Unblocked_Signal_Mask'Access);
+      pragma Assert (Result = 0);
+
+      for J in Interrupt_Management.Interrupt_ID loop
+         if System.Interrupt_Management.Keep_Unmasked (J) then
+            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+            pragma Assert (Result = 0);
+         end if;
+      end loop;
+
+      Result := pthread_mutexattr_init (Mutex_Attr'Access);
+      pragma Assert (Result = 0);
+
+      Result := pthread_condattr_init (Cond_Attr'Access);
+      pragma Assert (Result = 0);
+
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
 
       --  Initialize the global RTS lock
@@ -1196,26 +1141,4 @@ package body System.Task_Primitives.Operations is
       end if;
    end Initialize;
 
-begin
-   declare
-      Result : Interfaces.C.int;
-   begin
-      --  Prepare the set of signals that should unblocked in all tasks
-
-      Result := sigemptyset (Unblocked_Signal_Mask'Access);
-      pragma Assert (Result = 0);
-
-      for J in Interrupt_Management.Interrupt_ID loop
-         if System.Interrupt_Management.Keep_Unmasked (J) then
-            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-            pragma Assert (Result = 0);
-         end if;
-      end loop;
-
-      Result := pthread_mutexattr_init (Mutex_Attr'Access);
-      pragma Assert (Result = 0);
-
-      Result := pthread_condattr_init (Cond_Attr'Access);
-      pragma Assert (Result = 0);
-   end;
 end System.Task_Primitives.Operations;

gcc/ada/s-taprop-lynxos.adb

@@ -44,6 +44,14 @@ pragma Polling (Off);
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
+with System.Interrupt_Management;
+--  used for Keep_Unmasked
+--           Abort_Task_Interrupt
+--           Interrupt_ID
+
+with System.OS_Primitives;
+--  used for Delay_Modes
+
 with System.Task_Info;
 --  used for Task_Info_Type
 
@@ -51,29 +59,9 @@ with Interfaces.C;
 --  used for int
 --           size_t
 
-with System.Interrupt_Management;
---  used for Keep_Unmasked
---           Abort_Task_Interrupt
---           Interrupt_ID
-
 with System.Parameters;
 --  used for Size_Type
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
-
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
-
 with Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
@@ -85,8 +73,6 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use System.OS_Primitives;
 
-   package SSL renames System.Soft_Links;
-
    ----------------
    -- Local Data --
    ----------------
@@ -127,9 +113,6 @@ package body System.Task_Primitives.Operations is
    Dispatching_Policy : Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-   --  Indicates whether FIFO_Within_Priorities is set
-
    Foreign_Task_Elaborated : aliased Boolean := True;
    --  Used to identified fake tasks (i.e., non-Ada Threads)
 
@@ -560,12 +543,6 @@ package body System.Task_Primitives.Operations is
       Result     : Interfaces.C.int;
 
    begin
-      --  Only the little window between deferring abort and
-      --  locking Self_ID is the reason we need to
-      --  check for pending abort and priority change below!
-
-      SSL.Abort_Defer.all;
-
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -632,7 +609,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Result := sched_yield;
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ---------------------
@@ -703,7 +679,7 @@ package body System.Task_Primitives.Operations is
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_RR, Param'Access);
 
-      elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
+      elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
 
@@ -1302,6 +1278,20 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
+      Interrupt_Management.Initialize;
+
+      --  Prepare the set of signals that should unblocked in all tasks
+
+      Result := sigemptyset (Unblocked_Signal_Mask'Access);
+      pragma Assert (Result = 0);
+
+      for J in Interrupt_Management.Interrupt_ID loop
+         if System.Interrupt_Management.Keep_Unmasked (J) then
+            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+            pragma Assert (Result = 0);
+         end if;
+      end loop;
+
       --  Initialize the lock used to synchronize chain of all ATCBs
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
@@ -1332,20 +1322,4 @@ package body System.Task_Primitives.Operations is
       end if;
    end Initialize;
 
-begin
-   declare
-      Result : Interfaces.C.int;
-   begin
-      --  Prepare the set of signals that should unblocked in all tasks
-
-      Result := sigemptyset (Unblocked_Signal_Mask'Access);
-      pragma Assert (Result = 0);
-
-      for J in Interrupt_Management.Interrupt_ID loop
-         if System.Interrupt_Management.Keep_Unmasked (J) then
-            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-            pragma Assert (Result = 0);
-         end if;
-      end loop;
-   end;
 end System.Task_Primitives.Operations;

gcc/ada/s-taprop-mingw.adb

@@ -43,6 +43,9 @@ pragma Polling (Off);
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
+with System.OS_Primitives;
+--  used for Delay_Modes
+
 with Interfaces.C;
 --  used for int
 --           size_t
@@ -56,22 +59,6 @@ with System.OS_Interface;
 with System.Parameters;
 --  used for Size_Type
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
-
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
---       to initialize TSD for a C thread, in function Self
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
-
 with System.Task_Info;
 --  used for Unspecified_Task_Info
 
@@ -92,8 +79,6 @@ package body System.Task_Primitives.Operations is
    --  permit to have more than 30 tasks running at the same time. Note that
    --  we set the stack size for non tasking programs on System unit.
 
-   package SSL renames System.Soft_Links;
-
    ----------------
    -- Local Data --
    ----------------
@@ -112,9 +97,6 @@ package body System.Task_Primitives.Operations is
    Dispatching_Policy : Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-   --  Indicates whether FIFO_Within_Priorities is set
-
    Foreign_Task_Elaborated : aliased Boolean := True;
    --  Used to identified fake tasks (i.e., non-Ada Threads)
 
@@ -595,12 +577,6 @@ package body System.Task_Primitives.Operations is
       Timedout   : Boolean;
 
    begin
-      --  Only the little window between deferring abort and
-      --  locking Self_ID is the reason we need to
-      --  check for pending abort and priority change below!
-
-      SSL.Abort_Defer.all;
-
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -651,7 +627,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Yield;
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ------------
@@ -702,7 +677,7 @@ package body System.Task_Primitives.Operations is
         (T.Common.LL.Thread, Interfaces.C.int (Underlying_Priorities (Prio)));
       pragma Assert (Res = True);
 
-      if FIFO_Within_Priorities then
+      if Dispatching_Policy = 'F' then
 
          --  Annex D requirement [RM D.2.2 par. 9]:
          --    If the task drops its priority due to the loss of inherited
@@ -883,7 +858,7 @@ package body System.Task_Primitives.Operations is
 
       Set_Priority (T, Priority);
 
-      if Time_Slice_Val = 0 or else FIFO_Within_Priorities then
+      if Time_Slice_Val = 0 or else Dispatching_Policy = 'F' then
          --  Here we need Annex E semantics so we disable the NT priority
          --  boost. A priority boost is temporarily given by the system to a
          --  thread when it is taken out of a wait state.
@@ -997,10 +972,11 @@ package body System.Task_Primitives.Operations is
 
    begin
       Environment_Task_Id := Environment_Task;
+      OS_Primitives.Initialize;
 
-      if Time_Slice_Val = 0 or else FIFO_Within_Priorities then
+      if Time_Slice_Val = 0 or else Dispatching_Policy = 'F' then
 
-         --  Here we need Annex E semantics, switch the current process to the
+         --  Here we need Annex D semantics, switch the current process to the
          --  High_Priority_Class.
 
          Discard :=

gcc/ada/s-taprop-os2.adb

@@ -43,37 +43,23 @@ pragma Polling (Off);
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
-with Interfaces.C;
---  used for size_t
-
-with Interfaces.C.Strings;
---  used for Null_Ptr
+with System.OS_Primitives;
+--  used for Delay_Modes
+--           Clock
 
 with Interfaces.OS2Lib.Errors;
 with Interfaces.OS2Lib.Threads;
 with Interfaces.OS2Lib.Synchronization;
 
-with System.Parameters;
---  used for Size_Type
+with Interfaces.C;
+--  used for size_t
 
-with System.Tasking;
---  used for Task_Id
+with Interfaces.C.Strings;
+--  used for Null_Ptr
 
 with System.Parameters;
 --  used for Size_Type
 
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
---           Clock
-
 with Unchecked_Conversion;
 with Unchecked_Deallocation;
 
@@ -82,7 +68,6 @@ package body System.Task_Primitives.Operations is
    package IC  renames Interfaces.C;
    package ICS renames Interfaces.C.Strings;
    package OSP renames System.OS_Primitives;
-   package SSL renames System.Soft_Links;
 
    use Interfaces.OS2Lib;
    use Interfaces.OS2Lib.Errors;
@@ -599,12 +584,6 @@ package body System.Task_Primitives.Operations is
       Count      : aliased ULONG;  --  Used to store dummy result
 
    begin
-      --  Only the little window between deferring abort and
-      --  locking Self_ID is the reason we need to
-      --  check for pending abort and priority change below! :(
-
-      SSL.Abort_Defer.all;
-
       if Single_Lock then
          Lock_RTS;
       else
@@ -672,7 +651,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       System.OS_Interface.Yield;
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ------------
@@ -1244,6 +1222,20 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
+      OS_Primitives.Initialize;
+
+      --  Initialize pointer to task local data.
+      --  This is done once, for all tasks.
+
+      Must_Not_Fail (DosAllocThreadLocalMemory
+         ((Thread_Local_Data'Size + 31) / 32,  --  nr of 32-bit words
+          To_PPVOID (Thread_Local_Data_Ptr'Access)));
+
+      --  Initialize thread local data for main thread
+
+      Thread_Local_Data_Ptr.Self_ID := null;
+      Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
+
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
       --  Initialize the lock used to synchronize chain of all ATCBs
 
@@ -1279,16 +1271,4 @@ package body System.Task_Primitives.Operations is
       --  initialization needed for the environment task.
    end Initialize;
 
-begin
-   --  Initialize pointer to task local data.
-   --  This is done once, for all tasks.
-
-   Must_Not_Fail (DosAllocThreadLocalMemory
-      ((Thread_Local_Data'Size + 31) / 32,  --  nr of 32-bit words
-       To_PPVOID (Thread_Local_Data_Ptr'Access)));
-
-   --  Initialize thread local data for main thread
-
-   Thread_Local_Data_Ptr.Self_ID := null;
-   Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
 end System.Task_Primitives.Operations;

gcc/ada/s-taprop-posix.adb

@@ -49,6 +49,14 @@ pragma Polling (Off);
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
+with System.Interrupt_Management;
+--  used for Keep_Unmasked
+--           Abort_Task_Interrupt
+--           Interrupt_ID
+
+with System.OS_Primitives;
+--  used for Delay_Modes
+
 with System.Task_Info;
 --  used for Task_Info_Type
 
@@ -56,29 +64,9 @@ with Interfaces.C;
 --  used for int
 --           size_t
 
-with System.Interrupt_Management;
---  used for Keep_Unmasked
---           Abort_Task_Interrupt
---           Interrupt_ID
-
 with System.Parameters;
 --  used for Size_Type
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
-
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
-
 with Unchecked_Conversion;
 with Unchecked_Deallocation;
 
@@ -91,8 +79,6 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use System.OS_Primitives;
 
-   package SSL renames System.Soft_Links;
-
    ----------------
    -- Local Data --
    ----------------
@@ -133,9 +119,6 @@ package body System.Task_Primitives.Operations is
    Dispatching_Policy : Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-   --  Indicates whether FIFO_Within_Priorities is set.
-
    Foreign_Task_Elaborated : aliased Boolean := True;
    --  Used to identified fake tasks (i.e., non-Ada Threads).
 
@@ -603,12 +586,6 @@ package body System.Task_Primitives.Operations is
       Result     : Interfaces.C.int;
 
    begin
-      --  Only the little window between deferring abort and
-      --  locking Self_ID is the reason we need to
-      --  check for pending abort and priority change below! :(
-
-      SSL.Abort_Defer.all;
-
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -673,7 +650,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Result := sched_yield;
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ---------------------
@@ -746,7 +722,7 @@ package body System.Task_Primitives.Operations is
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_RR, Param'Access);
 
-      elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
+      elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
 
@@ -1038,7 +1014,7 @@ package body System.Task_Primitives.Operations is
       pragma Assert (Result = 0);
    end Abort_Task;
 
-      ----------------
+   ----------------
    -- Initialize --
    ----------------
 
@@ -1323,6 +1299,20 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
+      Interrupt_Management.Initialize;
+
+      --  Prepare the set of signals that should unblocked in all tasks
+
+      Result := sigemptyset (Unblocked_Signal_Mask'Access);
+      pragma Assert (Result = 0);
+
+      for J in Interrupt_Management.Interrupt_ID loop
+         if System.Interrupt_Management.Keep_Unmasked (J) then
+            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+            pragma Assert (Result = 0);
+         end if;
+      end loop;
+
       --  Initialize the lock used to synchronize chain of all ATCBs.
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
@@ -1352,20 +1342,4 @@ package body System.Task_Primitives.Operations is
       end if;
    end Initialize;
 
-begin
-   declare
-      Result : Interfaces.C.int;
-   begin
-      --  Prepare the set of signals that should unblocked in all tasks
-
-      Result := sigemptyset (Unblocked_Signal_Mask'Access);
-      pragma Assert (Result = 0);
-
-      for J in Interrupt_Management.Interrupt_ID loop
-         if System.Interrupt_Management.Keep_Unmasked (J) then
-            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-            pragma Assert (Result = 0);
-         end if;
-      end loop;
-   end;
 end System.Task_Primitives.Operations;

gcc/ada/s-taprop-solaris.adb

@@ -43,44 +43,30 @@ pragma Polling (Off);
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
-with Ada.Exceptions;
---  used for Raise_Exception
+with System.Interrupt_Management;
+--  used for Keep_Unmasked
+--           Abort_Task_Interrupt
+--           Interrupt_ID
+
+with System.OS_Primitives;
+--  used for Delay_Modes
 
+pragma Warnings (Off);
 with GNAT.OS_Lib;
 --  used for String_Access, Getenv
 
+pragma Warnings (On);
+
 with Interfaces.C;
 --  used for int
 --           size_t
 
-with System.Interrupt_Management;
---  used for Keep_Unmasked
---           Abort_Task_Interrupt
---           Interrupt_ID
-
 with System.Parameters;
 --  used for Size_Type
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
---           ATCB components and types
-
 with System.Task_Info;
 --  to initialize Task_Info for a C thread, in function Self
 
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
---       to initialize TSD for a C thread, in function Self
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
-
 with Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
@@ -90,11 +76,8 @@ package body System.Task_Primitives.Operations is
    use Interfaces.C;
    use System.OS_Interface;
    use System.Parameters;
-   use Ada.Exceptions;
    use System.OS_Primitives;
 
-   package SSL renames System.Soft_Links;
-
    ----------------
    -- Local Data --
    ----------------
@@ -280,7 +263,6 @@ package body System.Task_Primitives.Operations is
       Old_Set : aliased sigset_t;
 
       Result : Interfaces.C.int;
-      pragma Unreferenced (Result);
 
    begin
       --  It is not safe to raise an exception when using ZCX and the GCC
@@ -425,11 +407,73 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
-      --  This is done in Enter_Task, but this is too late for the
+      Interrupt_Management.Initialize;
+
+      --  Prepare the set of signals that should unblocked in all tasks
+
+      Result := sigemptyset (Unblocked_Signal_Mask'Access);
+      pragma Assert (Result = 0);
+
+      for J in Interrupt_Management.Interrupt_ID loop
+         if System.Interrupt_Management.Keep_Unmasked (J) then
+            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+            pragma Assert (Result = 0);
+         end if;
+      end loop;
+
+      if Dispatching_Policy = 'F' then
+         declare
+            Result      : Interfaces.C.long;
+            Class_Info  : aliased struct_pcinfo;
+            Secs, Nsecs : Interfaces.C.long;
+
+         begin
+            --  If a pragma Time_Slice is specified, takes the value in account
+
+            if Time_Slice_Val > 0 then
+               --  Convert Time_Slice_Val (microseconds) into seconds and
+               --  nanoseconds
+
+               Secs := Time_Slice_Val / 1_000_000;
+               Nsecs := (Time_Slice_Val rem 1_000_000) * 1_000;
+
+            --  Otherwise, default to no time slicing (i.e run until blocked)
+
+            else
+               Secs := RT_TQINF;
+               Nsecs := RT_TQINF;
+            end if;
+
+            --  Get the real time class id.
+
+            Class_Info.pc_clname (1) := 'R';
+            Class_Info.pc_clname (2) := 'T';
+            Class_Info.pc_clname (3) := ASCII.NUL;
+
+            Result := priocntl (PC_VERSION, P_LWPID, P_MYID, PC_GETCID,
+              Class_Info'Address);
+
+            --  Request the real time class
+
+            Prio_Param.pc_cid := Class_Info.pc_cid;
+            Prio_Param.rt_pri := pri_t (Class_Info.rt_maxpri);
+            Prio_Param.rt_tqsecs := Secs;
+            Prio_Param.rt_tqnsecs := Nsecs;
+
+            Result := priocntl (PC_VERSION, P_LWPID, P_MYID, PC_SETPARMS,
+              Prio_Param'Address);
+
+            Using_Real_Time_Class := Result /= -1;
+         end;
+      end if;
+
+      Specific.Initialize (Environment_Task);
+
+      --  The following is done in Enter_Task, but this is too late for the
       --  Environment Task, since we need to call Self in Check_Locks when
       --  the run time is compiled with assertions on.
 
-      Specific.Initialize (Environment_Task);
+      Specific.Set (Environment_Task);
 
       --  Initialize the lock used to synchronize chain of all ATCBs.
 
@@ -496,7 +540,7 @@ package body System.Task_Primitives.Operations is
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
       if Result = ENOMEM then
-         Raise_Exception (Storage_Error'Identity, "Failed to allocate a lock");
+         raise Storage_Error with "Failed to allocate a lock";
       end if;
    end Initialize_Lock;
 
@@ -513,7 +557,7 @@ package body System.Task_Primitives.Operations is
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
       if Result = ENOMEM then
-         Raise_Exception (Storage_Error'Identity, "Failed to allocate a lock");
+         raise Storage_Error with "Failed to allocate a lock";
       end if;
    end Initialize_Lock;
 
@@ -1244,12 +1288,6 @@ package body System.Task_Primitives.Operations is
       Yielded    : Boolean := False;
 
    begin
-      --  Only the little window between deferring abort and
-      --  locking Self_ID is the reason we need to
-      --  check for pending abort and priority change below!
-
-      SSL.Abort_Defer.all;
-
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -1310,8 +1348,6 @@ package body System.Task_Primitives.Operations is
       if not Yielded then
          thr_yield;
       end if;
-
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ------------
@@ -1643,7 +1679,7 @@ package body System.Task_Primitives.Operations is
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
       if Result = ENOMEM then
-         Raise_Exception (Storage_Error'Identity, "Failed to allocate a lock");
+         raise Storage_Error with "Failed to allocate a lock";
       end if;
 
       --  Initialize internal condition variable
@@ -1872,75 +1908,4 @@ package body System.Task_Primitives.Operations is
       end if;
    end Resume_Task;
 
---  Package elaboration
-
-begin
-   declare
-      Result : Interfaces.C.int;
-   begin
-      --  Prepare the set of signals that should unblocked in all tasks
-
-      Result := sigemptyset (Unblocked_Signal_Mask'Access);
-      pragma Assert (Result = 0);
-
-      for J in Interrupt_Management.Interrupt_ID loop
-         if System.Interrupt_Management.Keep_Unmasked (J) then
-            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-            pragma Assert (Result = 0);
-         end if;
-      end loop;
-
-      --  We need the following code to support automatic creation of fake
-      --  ATCB's for C threads that call the Ada run-time system, even if
-      --  we use a faster way of getting Self for real Ada tasks.
-
-      Result := thr_keycreate (ATCB_Key'Access, System.Null_Address);
-      pragma Assert (Result = 0);
-   end;
-
-   if Dispatching_Policy = 'F' then
-      declare
-         Result      : Interfaces.C.long;
-         Class_Info  : aliased struct_pcinfo;
-         Secs, Nsecs : Interfaces.C.long;
-
-      begin
-         --  If a pragma Time_Slice is specified, takes the value in account.
-
-         if Time_Slice_Val > 0 then
-            --  Convert Time_Slice_Val (microseconds) into seconds and
-            --  nanoseconds
-
-            Secs := Time_Slice_Val / 1_000_000;
-            Nsecs := (Time_Slice_Val rem 1_000_000) * 1_000;
-
-         --  Otherwise, default to no time slicing (i.e run until blocked)
-
-         else
-            Secs := RT_TQINF;
-            Nsecs := RT_TQINF;
-         end if;
-
-         --  Get the real time class id.
-
-         Class_Info.pc_clname (1) := 'R';
-         Class_Info.pc_clname (2) := 'T';
-         Class_Info.pc_clname (3) := ASCII.NUL;
-
-         Result := priocntl (PC_VERSION, P_LWPID, P_MYID, PC_GETCID,
-           Class_Info'Address);
-
-         --  Request the real time class
-
-         Prio_Param.pc_cid := Class_Info.pc_cid;
-         Prio_Param.rt_pri := pri_t (Class_Info.rt_maxpri);
-         Prio_Param.rt_tqsecs := Secs;
-         Prio_Param.rt_tqnsecs := Nsecs;
-
-         Result := priocntl (PC_VERSION, P_LWPID, P_MYID, PC_SETPARMS,
-           Prio_Param'Address);
-
-         Using_Real_Time_Class := Result /= -1;
-      end;
-   end if;
 end System.Task_Primitives.Operations;

gcc/ada/s-taprop-tru64.adb

@@ -43,6 +43,14 @@ pragma Polling (Off);
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
+with System.Interrupt_Management;
+--  used for Keep_Unmasked
+--           Abort_Task_Interrupt
+--           Interrupt_ID
+
+with System.OS_Primitives;
+--  used for Delay_Modes
+
 with System.Task_Info;
 --  used for Task_Info_Type
 
@@ -53,30 +61,9 @@ with Interfaces.C;
 --  used for int
 --           size_t
 
-with System.Interrupt_Management;
---  used for Keep_Unmasked
---           Abort_Task_Interrupt
---           Interrupt_ID
-
 with System.Parameters;
 --  used for Size_Type
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
---           ATCB components and types
-
-with System.Soft_Links;
---  used for Defer/Undefer_Abort
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
-
 with Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
@@ -88,8 +75,6 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use System.OS_Primitives;
 
-   package SSL renames System.Soft_Links;
-
    ----------------
    -- Local Data --
    ----------------
@@ -120,9 +105,6 @@ package body System.Task_Primitives.Operations is
    Dispatching_Policy : Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-   --  Indicates whether FIFO_Within_Priorities is set
-
    Curpid : pid_t;
 
    Foreign_Task_Elaborated : aliased Boolean := True;
@@ -527,12 +509,6 @@ package body System.Task_Primitives.Operations is
       Result     : Interfaces.C.int;
 
    begin
-      --  Only the little window between deferring abort and
-      --  locking Self_ID is the reason we need to
-      --  check for pending abort and priority change below! :(
-
-      SSL.Abort_Defer.all;
-
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -585,7 +561,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Yield;
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ---------------------
@@ -661,7 +636,7 @@ package body System.Task_Primitives.Operations is
          Result := pthread_setschedparam
                      (T.Common.LL.Thread, SCHED_RR, Param'Access);
 
-      elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
+      elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
          Result := pthread_setschedparam
                      (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
 
@@ -846,7 +821,7 @@ package body System.Task_Primitives.Operations is
          Result := pthread_attr_setschedpolicy
                      (Attributes'Access, System.OS_Interface.SCHED_RR);
 
-      elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
+      elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
          Result := pthread_attr_setschedpolicy
                      (Attributes'Access, System.OS_Interface.SCHED_FIFO);
 
@@ -1240,6 +1215,22 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
+      Interrupt_Management.Initialize;
+
+      --  Prepare the set of signals that should unblocked in all tasks
+
+      Result := sigemptyset (Unblocked_Signal_Mask'Access);
+      pragma Assert (Result = 0);
+
+      for J in Interrupt_Management.Interrupt_ID loop
+         if System.Interrupt_Management.Keep_Unmasked (J) then
+            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+            pragma Assert (Result = 0);
+         end if;
+      end loop;
+
+      Curpid := getpid;
+
       --  Initialize the lock used to synchronize chain of all ATCBs
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
@@ -1269,22 +1260,4 @@ package body System.Task_Primitives.Operations is
       end if;
    end Initialize;
 
-begin
-   declare
-      Result : Interfaces.C.int;
-   begin
-      --  Prepare the set of signals that should unblocked in all tasks
-
-      Result := sigemptyset (Unblocked_Signal_Mask'Access);
-      pragma Assert (Result = 0);
-
-      for J in Interrupt_Management.Interrupt_ID loop
-         if System.Interrupt_Management.Keep_Unmasked (J) then
-            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-            pragma Assert (Result = 0);
-         end if;
-      end loop;
-   end;
-
-   Curpid := getpid;
 end System.Task_Primitives.Operations;

gcc/ada/s-taprop-vms.adb

@@ -43,6 +43,9 @@ pragma Polling (Off);
 with System.Tasking.Debug;
 --  used for Known_Tasks
 
+with System.OS_Primitives;
+--  used for Delay_Modes
+
 with Interfaces.C;
 --  used for int
 --           size_t
@@ -50,21 +53,8 @@ with Interfaces.C;
 with System.Parameters;
 --  used for Size_Type
 
-with System.Tasking;
---  used for Ada_Task_Control_Block
---           Task_Id
-
 with System.Soft_Links;
---  used for Defer/Undefer_Abort
---           Set_Exc_Stack_Addr
-
---  Note that we do not use System.Tasking.Initialization directly since
---  this is a higher level package that we shouldn't depend on. For example
---  when using the restricted run time, it is replaced by
---  System.Tasking.Restricted.Stages.
-
-with System.OS_Primitives;
---  used for Delay_Modes
+--  used for Get_Exc_Stack_Addr
 
 with Unchecked_Conversion;
 with Unchecked_Deallocation;
@@ -105,9 +95,6 @@ package body System.Task_Primitives.Operations is
    Dispatching_Policy : Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-   --  Indicates whether FIFO_Within_Priorities is set.
-
    Foreign_Task_Elaborated : aliased Boolean := True;
    --  Used to identified fake tasks (i.e., non-Ada Threads).
 
@@ -156,6 +143,9 @@ package body System.Task_Primitives.Operations is
 
    function To_Address is new Unchecked_Conversion (Task_Id, System.Address);
 
+   function Get_Exc_Stack_Addr return Address;
+   --  Replace System.Soft_Links.Get_Exc_Stack_Addr_NT
+
    procedure Timer_Sleep_AST (ID : Address);
    --  Signal the condition variable when AST fires.
 
@@ -492,17 +482,12 @@ package body System.Task_Primitives.Operations is
       Yielded    : Boolean := False;
 
    begin
-      --  Only the little window between deferring abort and
-      --  locking Self_ID is the reason we need to
-      --  check for pending abort and priority change below!
-
       if Single_Lock then
          Lock_RTS;
       end if;
 
       --  More comments required in body below ???
 
-      SSL.Abort_Defer.all;
       Write_Lock (Self_ID);
 
       if Time /= 0.0 or else Mode /= Relative then
@@ -562,8 +547,6 @@ package body System.Task_Primitives.Operations is
          Result := sched_yield;
          pragma Assert (Result = 0);
       end if;
-
-      SSL.Abort_Undefer.all;
    end Timed_Delay;
 
    ---------------------
@@ -629,7 +612,7 @@ package body System.Task_Primitives.Operations is
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_RR, Param'Access);
 
-      elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
+      elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
          Result := pthread_setschedparam
            (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
 
@@ -749,9 +732,6 @@ package body System.Task_Primitives.Operations is
       if Result = 0 then
          Succeeded := True;
          Self_ID.Common.LL.Exc_Stack_Ptr := new Exc_Stack_T;
-         SSL.Set_Exc_Stack_Addr
-           (To_Address (Self_ID),
-            Self_ID.Common.LL.Exc_Stack_Ptr (Exc_Stack_T'Last)'Address);
 
       else
          if not Single_Lock then
@@ -766,6 +746,15 @@ package body System.Task_Primitives.Operations is
       pragma Assert (Result = 0);
    end Initialize_TCB;
 
+   ------------------------
+   -- Get_Exc_Stack_Addr --
+   ------------------------
+
+   function Get_Exc_Stack_Addr return Address is
+   begin
+      return Self.Common.LL.Exc_Stack_Ptr (Exc_Stack_T'Last)'Address;
+   end Get_Exc_Stack_Addr;
+
    -----------------
    -- Create_Task --
    -----------------
@@ -1169,6 +1158,8 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
+      SSL.Get_Exc_Stack_Addr := Get_Exc_Stack_Addr'Access;
+
       --  Initialize the lock used to synchronize chain of all ATCBs
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);

gcc/ada/s-taprop.ads

@@ -44,8 +44,8 @@ with System.OS_Interface;
 --  used for Thread_Id
 
 package System.Task_Primitives.Operations is
+   pragma Preelaborate;
 
-   pragma Elaborate_Body;
    package ST renames System.Tasking;
    package OSI renames System.OS_Interface;
 
@@ -356,8 +356,8 @@ package System.Task_Primitives.Operations is
      (Self_ID : ST.Task_Id;
       Time    : Duration;
       Mode    : ST.Delay_Modes);
-   --  Implement the semantics of the delay statement. It is assumed that
-   --  the caller is not abort-deferred and does not hold any locks.
+   --  Implement the semantics of the delay statement.
+   --  The caller should be abort-deferred and should not hold any locks.
 
    procedure Wakeup
      (T      : ST.Task_Id;

gcc/ada/s-tarest.adb

@@ -505,6 +505,8 @@ package body System.Tasking.Restricted.Stages is
 
    procedure Init_RTS is
    begin
+      Tasking.Initialize;
+
       --  Initialize lock used to implement mutual exclusion between all tasks
 
       STPO.Initialize_Lock (Global_Task_Lock'Access, STPO.Global_Task_Level);

gcc/ada/s-tasdeb.ads

@@ -38,6 +38,7 @@ with System.Tasking;
 with System.OS_Interface;
 
 package System.Tasking.Debug is
+   pragma Preelaborate;
 
    ------------------------------------------
    -- Application-level debugging routines --
@@ -66,7 +67,7 @@ package System.Tasking.Debug is
    -- General GDB support --
    -------------------------
 
-   Known_Tasks : array (0 .. 999) of Task_Id;
+   Known_Tasks : array (0 .. 999) of Task_Id := (others => null);
    --  Global array of tasks read by gdb, and updated by
    --  Create_Task and Finalize_TCB
 

gcc/ada/s-tasinf-irix-athread.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -41,11 +41,12 @@
 --  This unit may be used directly from an application program by providing
 --  an appropriate WITH, and the interface can be expected to remain stable.
 
---  This is the SGI (libathread) specific version of this module.
+--  This is the SGI (libathread) specific version of this module
 
 with System.OS_Interface;
 
 package System.Task_Info is
+   pragma Preelaborate;
    pragma Elaborate_Body;
    --  To ensure that a body is allowed
 
@@ -147,7 +148,7 @@ package System.Task_Info is
    ANY_CPU : constant CPU_Number := CPU_Number'First;
 
    type Non_Degrading_Priority is range 0 .. 255;
-   --  Specification of IRIX Non Degrading Priorities.
+   --  Specification of IRIX Non Degrading Priorities
    --
    --  WARNING: IRIX priorities have the reverse meaning of Ada priorities.
    --           The lower the priority value, the greater the greater the
@@ -203,8 +204,7 @@ package System.Task_Info is
       CPU             : CPU_Number             := ANY_CPU;
       Resident        : Page_Locking           := NOLOCK;
       NDPRI           : Non_Degrading_Priority := NDP_NONE) return sproc_t;
-   --  Allocates a sproc_t control structure and creates the
-   --  corresponding sproc.
+   --  Allocates a sproc_t control structure and creates corresponding sproc
 
    Invalid_CPU_Number : exception;
    Permission_Error   : exception;

gcc/ada/s-tasinf-irix.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -44,14 +44,12 @@
 --  This is the IRIX (kernel threads) version of this package
 
 with Interfaces.C;
-with System.OS_Interface;
 
 package System.Task_Info is
+   pragma Preelaborate;
    pragma Elaborate_Body;
    --  To ensure that a body is allowed
 
-   package OSI renames System.OS_Interface;
-
    -----------------------------------------
    -- Implementation of Task_Info Feature --
    -----------------------------------------
@@ -91,27 +89,13 @@ package System.Task_Info is
    subtype Thread_Scheduling_Priority is Integer range
      No_Specified_Priority .. 255;
 
-   function Min (Policy : Interfaces.C.int) return Interfaces.C.int
-     renames OSI.sched_get_priority_min;
-
-   function Max (Policy : Interfaces.C.int) return Interfaces.C.int
-     renames OSI.sched_get_priority_max;
-
-   subtype FIFO_Priority is Thread_Scheduling_Priority range
-      Thread_Scheduling_Priority (Min (OSI.SCHED_FIFO)) ..
-      Thread_Scheduling_Priority (Max (OSI.SCHED_FIFO));
+   subtype FIFO_Priority is Thread_Scheduling_Priority range 0 .. 255;
 
-   subtype RR_Priority is Thread_Scheduling_Priority range
-      Thread_Scheduling_Priority (Min (OSI.SCHED_RR)) ..
-      Thread_Scheduling_Priority (Max (OSI.SCHED_RR));
+   subtype RR_Priority is Thread_Scheduling_Priority range 0 .. 255;
 
-   subtype TS_Priority is Thread_Scheduling_Priority range
-      Thread_Scheduling_Priority (Min (OSI.SCHED_TS)) ..
-      Thread_Scheduling_Priority (Max (OSI.SCHED_TS));
+   subtype TS_Priority is Thread_Scheduling_Priority range 1 .. 40;
 
-   subtype OTHER_Priority is Thread_Scheduling_Priority range
-      Thread_Scheduling_Priority (Min (OSI.SCHED_OTHER)) ..
-      Thread_Scheduling_Priority (Max (OSI.SCHED_OTHER));
+   subtype OTHER_Priority is Thread_Scheduling_Priority range 1 .. 40;
 
    subtype CPU_Number is Integer range -1 .. Integer'Last;
    ANY_CPU : constant CPU_Number := CPU_Number'First;

gcc/ada/s-tasinf-solaris.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -46,6 +46,7 @@
 with System.OS_Interface;
 
 package System.Task_Info is
+   pragma Preelaborate;
    pragma Elaborate_Body;
    --  To ensure that a body is allowed
 

gcc/ada/s-tasinf-tru64.ads

@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                           (Compiler Interface)                           --
 --                                                                          --
---         Copyright (C) 1998-2003 Free Software Foundation, Inc.           --
+--         Copyright (C) 1998-2005 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- --
@@ -45,6 +45,7 @@
 --  This is a DEC Unix 4.0d version of this package.
 
 package System.Task_Info is
+   pragma Preelaborate;
    pragma Elaborate_Body;
    --  To ensure that a body is allowed
 

gcc/ada/s-tasinf.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -42,6 +42,7 @@
 --  an appropriate WITH, and the interface can be expected to remain stable.
 
 package System.Task_Info is
+   pragma Preelaborate;
    pragma Elaborate_Body;
    --  To ensure that a body is allowed
 

gcc/ada/s-taskin.adb

@@ -48,6 +48,21 @@ package body System.Tasking is
 
    package STPO renames System.Task_Primitives.Operations;
 
+   ---------------------
+   -- Detect_Blocking --
+   ---------------------
+
+   function Detect_Blocking return Boolean is
+      GL_Detect_Blocking : Integer;
+      pragma Import (C, GL_Detect_Blocking, "__gl_detect_blocking");
+      --  Global variable exported by the binder generated file.
+      --  A value equal to 1 indicates that pragma Detect_Blocking is active,
+      --  while 0 is used for the pragma not being present.
+
+   begin
+      return GL_Detect_Blocking = 1;
+   end Detect_Blocking;
+
    ----------
    -- Self --
    ----------
@@ -116,8 +131,12 @@ package body System.Tasking is
       All_Tasks_List := T;
    end Initialize_ATCB;
 
+   ----------------
+   -- Initialize --
+   ----------------
+
    Main_Task_Image : constant String := "main_task";
-   --  Image of environment task.
+   --  Image of environment task
 
    Main_Priority : Integer;
    pragma Import (C, Main_Priority, "__gl_main_priority");
@@ -125,26 +144,21 @@ package body System.Tasking is
    --  Priority, because we use the value -1 to indicate the default
    --  main priority, and that is of course not in Priority'range.
 
-   ----------------------------
-   -- Tasking Initialization --
-   ----------------------------
-
-   --  This block constitutes the first part of the initialization of the
-   --  GNARL. This includes creating data structures to make the initial thread
-   --  into the environment task. The last part of the initialization is done
-   --  in System.Tasking.Initialization or System.Tasking.Restricted.Stages.
-   --  All the initializations used to be in Tasking.Initialization, but this
-   --  is no longer possible with the run time simplification (including
-   --  optimized PO and the restricted run time) since one cannot rely on
-   --  System.Tasking.Initialization being present, as was done before.
-
-begin
-   declare
+   Initialized : Boolean := False;
+   --  Used to prevent multiple calls to Initialize
+
+   procedure Initialize is
       T             : Task_Id;
       Success       : Boolean;
       Base_Priority : Any_Priority;
 
    begin
+      if Initialized then
+         return;
+      end if;
+
+      Initialized := True;
+
       --  Initialize Environment Task
 
       if Main_Priority = Unspecified_Priority then
@@ -170,5 +184,6 @@ begin
       --  in ravenscar mode. Rest of the initialization is done in Init_RTS.
 
       T.Entry_Calls (1).Self := T;
-   end;
+   end Initialize;
+
 end System.Tasking;

gcc/ada/s-taskin.ads

@@ -54,6 +54,7 @@ with System.Task_Primitives;
 with Unchecked_Conversion;
 
 package System.Tasking is
+   pragma Preelaborate;
 
    -------------------
    -- Locking Rules --
@@ -342,8 +343,9 @@ package System.Tasking is
 
    type Access_Boolean is access all Boolean;
 
-   Detect_Blocking : constant Boolean;
-   --  Boolean constant set True iff Detect_Blocking is active
+   function Detect_Blocking return Boolean;
+   pragma Inline (Detect_Blocking);
+   --  Return whether the Detect_Blocking pragma is enabled.
 
    ----------------------------------------------
    -- Ada_Task_Control_Block (ATCB) definition --
@@ -977,9 +979,19 @@ package System.Tasking is
       --  has exclusive access to this field.
    end record;
 
-   ---------------------
-   -- Initialize_ATCB --
-   ---------------------
+   --------------------
+   -- Initialization --
+   --------------------
+
+   procedure Initialize;
+   --  This procedure constitutes the first part of the initialization of the
+   --  GNARL. This includes creating data structures to make the initial thread
+   --  into the environment task. The last part of the initialization is done
+   --  in System.Tasking.Initialization or System.Tasking.Restricted.Stages.
+   --  All the initializations used to be in Tasking.Initialization, but this
+   --  is no longer possible with the run time simplification (including
+   --  optimized PO and the restricted run time) since one cannot rely on
+   --  System.Tasking.Initialization being present, as was done before.
 
    procedure Initialize_ATCB
      (Self_ID          : Task_Id;
@@ -999,14 +1011,6 @@ package System.Tasking is
 private
    Null_Task : constant Task_Id := null;
 
-   GL_Detect_Blocking : Integer;
-   pragma Import (C, GL_Detect_Blocking, "__gl_detect_blocking");
-   --  Global variable exported by the binder generated file. A value equal to
-   --  1 indicates that pragma Detect_Blocking is active, while 0 is used for
-   --  the pragma not being present.
-
-   Detect_Blocking : constant Boolean := GL_Detect_Blocking = 1;
-
    type Activation_Chain is record
       T_ID : Task_Id;
    end record;

gcc/ada/s-taspri-hpux-dce.ads

@@ -45,6 +45,7 @@ with System.OS_Interface;
 --           pthread_t
 
 package System.Task_Primitives is
+   pragma Preelaborate;
 
    type Lock is limited private;
    --  Should be used for implementation of protected objects

gcc/ada/s-taspri-linux.ads

-------------------------------------------------------------------------------
---                                                                          --
---                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
---                                                                          --
---                 S Y S T E M . T A S K _ P R I M I T I V E S              --
---                                                                          --
---                                  S p e c                                 --
---                                                                          --
---           Copyright (C) 1991-2005 Free Software Foundation, Inc.         --
---                                                                          --
--- GNARL 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. GNARL 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 GNARL; see file COPYING.  If not, write --
--- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, 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.                                      --
---                                                                          --
--- GNARL was developed by the GNARL team at Florida State University.       --
--- Extensive contributions were provided by Ada Core Technologies, Inc.     --
---                                                                          --
-------------------------------------------------------------------------------
-
---  This is the GNU/Linux (GNU/LinuxThreads) version of this package
-
---  This package provides low-level support for most tasking features
-
-pragma Polling (Off);
---  Turn off polling, we do not want ATC polling to take place during
---  tasking operations. It causes infinite loops and other problems.
-
-with System.OS_Interface;
---  used for pthread_mutex_t
---           pthread_cond_t
---           pthread_t
-
-package System.Task_Primitives is
-
-   type Lock is limited private;
-   --  Should be used for implementation of protected objects
-
-   type RTS_Lock is limited private;
-   --  Should be used inside the runtime system. The difference between Lock
-   --  and the RTS_Lock is that the later one serves only as a semaphore so
-   --  that do not check for ceiling violations.
-
-   type Suspension_Object is limited private;
-   --  Should be used for the implementation of Ada.Synchronous_Task_Control
-
-   type Task_Body_Access is access procedure;
-   --  Pointer to the task body's entry point (or possibly a wrapper
-   --  declared local to the GNARL).
-
-   type Private_Data is limited private;
-   --  Any information that the GNULLI needs maintained on a per-task basis.
-   --  A component of this type is guaranteed to be included in the
-   --  Ada_Task_Control_Block.
-
-private
-
-   type Prio_Array_Type is array (System.Any_Priority) of Integer;
-
-   type Lock is record
-      L              : aliased System.OS_Interface.pthread_mutex_t;
-      Ceiling        : System.Any_Priority := System.Any_Priority'First;
-      Saved_Priority : System.Any_Priority := System.Any_Priority'First;
-   end record;
-
-   type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
-
-   type Suspension_Object is record
-      State : Boolean;
-      pragma Atomic (State);
-      --  Boolean that indicates whether the object is open. This field is
-      --  marked Atomic to ensure that we can read its value without locking
-      --  the access to the Suspension_Object.
-
-      Waiting : Boolean;
-      --  Flag showing if there is a task already suspended on this object
-
-      L : aliased System.OS_Interface.pthread_mutex_t;
-      --  Protection for ensuring mutual exclusion on the Suspension_Object
-
-      CV : aliased System.OS_Interface.pthread_cond_t;
-      --  Condition variable used to queue threads until the condition is
-      --  signaled.
-   end record;
-
-   type Private_Data is record
-      Thread      : aliased System.OS_Interface.pthread_t;
-      pragma Atomic (Thread);
-      --  Thread field may be updated by two different threads of control.
-      --  (See, Enter_Task and Create_Task in s-taprop.adb).
-      --  They put the same value (thr_self value). We do not want to
-      --  use lock on those operations and the only thing we have to
-      --  make sure is that they are updated in atomic fashion.
-
-      CV : aliased System.OS_Interface.pthread_cond_t;
-
-      L : aliased RTS_Lock;
-      --  Protection for all components is lock L
-
-      Active_Priority : System.Any_Priority := System.Any_Priority'First;
-      --  Simulated active priority, used only if Priority_Ceiling_Support
-      --  is True.
-   end record;
-
-end System.Task_Primitives;

gcc/ada/s-taspri-lynxos.ads

@@ -32,7 +32,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is a LynxOS version of this package, derived from 7staspri.ads
+--  This is a LynxOS version of this package, derived from s-taspri-posix.ads
 
 pragma Polling (Off);
 --  Turn off polling, we do not want ATC polling to take place during
@@ -44,6 +44,7 @@ with System.OS_Interface;
 --           pthread_t
 
 package System.Task_Primitives is
+   pragma Preelaborate;
 
    type Lock is limited private;
    --  Should be used for implementation of protected objects

gcc/ada/s-taspri-mingw.ads

@@ -43,6 +43,7 @@ with System.OS_Interface;
 --           pthread_t
 
 package System.Task_Primitives is
+   pragma Preelaborate;
 
    type Lock is limited private;
    --  Should be used for implementation of protected objects

gcc/ada/s-taspri-os2.ads

@@ -44,15 +44,12 @@ with Interfaces.OS2Lib.Threads;
 with Interfaces.OS2Lib.Synchronization;
 
 package System.Task_Primitives is
-
    pragma Preelaborate;
 
-   --  Why are these commented out ???
-
---   type Lock is limited private;
+   type Lock is limited private;
    --  Should be used for implementation of protected objects.
 
---   type RTS_Lock is limited private;
+   type RTS_Lock is limited private;
    --  Should be used inside the runtime system.
    --  The difference between Lock and the RTS_Lock is that the later
    --  one serves only as a semaphore so that do not check for
@@ -62,12 +59,12 @@ package System.Task_Primitives is
    --  Pointer to the task body's entry point (or possibly a wrapper
    --  declared local to the GNARL).
 
---   type Private_Data is limited private;
+   type Private_Data is limited private;
    --  Any information that the GNULLI needs maintained on a per-task
    --  basis.  A component of this type is guaranteed to be included
    --  in the Ada_Task_Control_Block.
 
---  private (why commented out???)
+private
 
    type Lock is record
       Mutex          : aliased Interfaces.OS2Lib.Synchronization.HMTX;

gcc/ada/s-taspri-posix.ads

@@ -46,6 +46,7 @@ with System.OS_Interface;
 --           pthread_t
 
 package System.Task_Primitives is
+   pragma Preelaborate;
 
    type Lock is limited private;
    --  Should be used for implementation of protected objects

gcc/ada/s-taspri-tru64.ads

@@ -49,6 +49,7 @@ with System.OS_Interface;
 --           pthread_t
 
 package System.Task_Primitives is
+   pragma Preelaborate;
 
    type Lock is limited private;
    --  Should be used for implementation of protected objects

gcc/ada/s-taspri-vms.ads

@@ -49,6 +49,7 @@ with System.OS_Interface;
 --           pthread_t
 
 package System.Task_Primitives is
+   pragma Preelaborate;
 
    type Lock is limited private;
    --  Should be used for implementation of protected objects

gcc/ada/s-taspri-vxworks.ads

@@ -40,6 +40,7 @@ pragma Polling (Off);
 with System.OS_Interface;
 
 package System.Task_Primitives is
+   pragma Preelaborate;
 
    type Lock is limited private;
    --  Should be used for implementation of protected objects

gcc/ada/s-tassta.adb

@@ -846,8 +846,6 @@ package body System.Tasking.Stages is
       SSL.Set_Jmpbuf_Address := SSL.Set_Jmpbuf_Address_NT'Access;
       SSL.Get_Sec_Stack_Addr := SSL.Get_Sec_Stack_Addr_NT'Access;
       SSL.Set_Sec_Stack_Addr := SSL.Set_Sec_Stack_Addr_NT'Access;
-      SSL.Get_Exc_Stack_Addr := SSL.Get_Exc_Stack_Addr_NT'Access;
-      SSL.Set_Exc_Stack_Addr := SSL.Set_Exc_Stack_Addr_NT'Access;
       SSL.Check_Abort_Status := SSL.Check_Abort_Status_NT'Access;
       SSL.Get_Stack_Info     := SSL.Get_Stack_Info_NT'Access;
 
@@ -1135,7 +1133,6 @@ package body System.Tasking.Stages is
       procedure To_Stderr (S : String);
       pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
 
-      use System.Task_Info;
       use System.Soft_Links;
       use System.Standard_Library;
 

gcc/ada/s-tpopsp-solaris.adb

@@ -42,9 +42,10 @@ package body Specific is
    ----------------
 
    procedure Initialize (Environment_Task : Task_Id) is
+      pragma Unreferenced (Environment_Task);
       Result : Interfaces.C.int;
    begin
-      Result := thr_setspecific (ATCB_Key, To_Address (Environment_Task));
+      Result := thr_keycreate (ATCB_Key'Access, System.Null_Address);
       pragma Assert (Result = 0);
    end Initialize;
 

gcc/ada/s-traces.ads

@@ -55,6 +55,7 @@
 --  To add a new target, just adapt System.Traces.Send to your own purpose.
 
 package System.Traces is
+   pragma Preelaborate;
 
    type Trace_T is
      (

gcc/ada/s-traent-vms.ads

@@ -38,6 +38,7 @@
 --  This is the Alpha/OpenVMS version of this package
 
 package System.Traceback_Entries is
+   pragma Preelaborate;
 
    type Traceback_Entry is record
       PC : System.Address;

gcc/ada/s-traent.ads

@@ -41,12 +41,13 @@
 --  address of a call instruction part of the call-chain.
 
 package System.Traceback_Entries is
+   pragma Preelaborate;
 
    subtype Traceback_Entry is System.Address;
-   --  This subtype defines what each traceback array entry contains.
+   --  This subtype defines what each traceback array entry contains
 
    Null_TB_Entry : constant Traceback_Entry := System.Null_Address;
-   --  This is the value to be used when initializing an entry.
+   --  This is the value to be used when initializing an entry
 
    function PC_For (TB_Entry : Traceback_Entry) return System.Address;
    pragma Inline (PC_For);
@@ -55,6 +56,6 @@ package System.Traceback_Entries is
 
    function TB_Entry_For (PC : System.Address) return Traceback_Entry;
    pragma Inline (TB_Entry_For);
-   --  Returns an entry representing a frame for a call instruction at PC.
+   --  Returns an entry representing a frame for a call instruction at PC
 
 end System.Traceback_Entries;

gcc/ada/s-tratas.ads

@@ -41,6 +41,7 @@
 with System.Tasking;
 
 package System.Traces.Tasking is
+   pragma Preelaborate;
 
    package ST renames System.Tasking;