s-taprop-vms.adb, [...] (Timed_Delay, [...]): Register the base time when…

s-taprop-vms.adb, [...] (Timed_Delay, [...]): Register the base time when entering this routine to detect a backward clock...

2007-04-20  Arnaud Charlet  <charlet@adacore.com>

	* s-taprop-vms.adb, s-taprop-hpux-dce.adb, s-taprop-vxworks.adb, 
	s-osprim-posix.adb, s-taprop-posix.adb, s-osprim-vxworks.adb, 
	s-taprop-solaris.adb, s-osprim-solaris.adb, s-taprop-dummy.adb, 
	s-osprim-unix.adb, s-osinte-freebsd.adb, s-osinte-freebsd.ads, 
	s-osinte-lynxos.adb, s-osinte-lynxos.ads, s-taprop-tru64.adb, 
	s-taprop-lynxos.adb, s-taprop-irix.adb, s-osinte-tru64.adb, 
	s-osinte-tru64.ads, s-taprop-linux.adb, s-parame.ads, 
	s-parame-vms-alpha.ads, s-parame-vms-ia64.ads, s-parame-hpux.ads, 
	s-parame-vms-restrict.ads, s-parame-ae653.ads, s-parame-vxworks.ads, 
	s-taprop-mingw.adb, s-osinte-lynxos-3.ads, s-osinte-lynxos-3.adb,
        s-osprim-mingw.adb (Timed_Delay, Timed_Sleep): Register the base
	time when entering this routine to detect a backward clock setting
	(manual setting or DST adjustment), to avoid waiting for a longer delay
	than needed.
	(Time_Duration, To_Timeval, struct_timeval): Removed when not relevant.
	Remove handling of deferred priority change, and replace by setting the
	task priority directly, as required by AI-188.
	Update comments.
	(Max_Task_Image_Length): New constant.
	Replace Warnings (Off) by Unreferenced pragma, cleaner.
	(Dynamic_Priority_Support): Removed, no longer needed.
	(Poll_Base_Priority_Change): Ditto.
	(Set_Ceiling): Add this procedure to change the ceiling priority
	associated to a lock. This is a dummy implementation because dynamic
	priority ceilings are not supported by the underlying system.

	* a-dynpri.adb (Set_Priority): Take into account case where Target is
	accepting a RV with its priority boosted.
	Remove handling of deferred priority change, and replace by setting the
	task priority directly, as required by AI-188.

	* s-taenca.adb (Try_To_Cancel_Entry_Call): Remove special case for
	Succeeded = True.
	Remove handling of deferred priority change, and replace by setting the
	task priority directly, as required by AI-188.
	(Wait_For_Completion, Wait_For_Call, Timed_Selective_Wait): Change state
	of Self_Id earlier.

	* s-tasini.ads, s-tasini.adb (Wakeup_Entry_Caller): Relax assertion.
	(Poll_Base_Priority_Change): Removed.
	Code clean up: use SSL.Current_Target_Exception.

	* s-tasren.adb (Task_Count): Call Yield to let a chance to other tasks
	to run as this is a potentially dispatching point.
	(Call_Synchronous): Use Local_Defer_Abort.
	(Callable): Relax assertion.
	(Selective_Wait): Relax assertion in case abort is not allowed.
	Remove handling of deferred priority change, and replace by setting the
	task priority directly, as required by AI-188.

	* s-tasuti.adb (Make_Passive): Adjust assertions.
	Remove handling of deferred priority change, and replace by setting the
	task priority directly, as required by AI-188.

From-SVN: r125364

gcc/ada/a-dynpri.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -48,7 +48,7 @@ with System.Soft_Links;
 --  use for Abort_Defer
 --          Abort_Undefer
 
-with Unchecked_Conversion;
+with Ada.Unchecked_Conversion;
 
 package body Ada.Dynamic_Priorities is
 
@@ -59,7 +59,7 @@ package body Ada.Dynamic_Priorities is
    use System.Tasking;
 
    function Convert_Ids is new
-     Unchecked_Conversion
+     Ada.Unchecked_Conversion
        (Task_Identification.Task_Id, System.Tasking.Task_Id);
 
    ------------------
@@ -99,8 +99,8 @@ package body Ada.Dynamic_Priorities is
                    Ada.Task_Identification.Current_Task)
    is
       Target        : constant Task_Id := Convert_Ids (T);
-      Self_ID : constant Task_Id := STPO.Self;
       Error_Message : constant String := "Trying to set the priority of a ";
+      Yield_Needed  : Boolean;
 
    begin
       if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then
@@ -119,41 +119,53 @@ package body Ada.Dynamic_Priorities is
 
       STPO.Write_Lock (Target);
 
-      if Self_ID = Target then
       Target.Common.Base_Priority := Priority;
-         STPO.Set_Priority (Target, Priority);
 
-         STPO.Unlock (Target);
+      if Target.Common.Call /= null
+        and then
+          Target.Common.Call.Acceptor_Prev_Priority /= Priority_Not_Boosted
+      then
+         --  Target is within a rendezvous, so ensure the correct priority
+         --  will be reset when finishing the rendezvous, and only change the
+         --  priority immediately if the new priority is greater than the
+         --  current (inherited) priority.
 
-         if Single_Lock then
-            STPO.Unlock_RTS;
-         end if;
-
-         --  Yield is needed to enforce FIFO task dispatching
+         Target.Common.Call.Acceptor_Prev_Priority := Priority;
 
-         --  LL Set_Priority is made while holding the RTS lock so that it
-         --  is inheriting high priority until it release all the RTS locks.
-
-         --  If this is used in a system where Ceiling Locking is
-         --  not enforced we may end up getting two Yield effects.
-
-         STPO.Yield;
+         if Priority >= Target.Common.Current_Priority then
+            Yield_Needed := True;
+            STPO.Set_Priority (Target, Priority);
+         else
+            Yield_Needed := False;
+         end if;
 
       else
-         Target.New_Base_Priority := Priority;
-         Target.Pending_Priority_Change := True;
-         Target.Pending_Action := True;
+         Yield_Needed := True;
+         STPO.Set_Priority (Target, Priority);
 
+         if Target.Common.State = Entry_Caller_Sleep then
+            Target.Pending_Priority_Change := True;
             STPO.Wakeup (Target, Target.Common.State);
-
-         --  If the task is suspended, wake it up to perform the change.
-         --  check for ceiling violations ???
+         end if;
+      end if;
 
       STPO.Unlock (Target);
 
       if Single_Lock then
          STPO.Unlock_RTS;
       end if;
+
+      if STPO.Self = Target and then Yield_Needed then
+
+         --  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.
+
+         --  If this is used in a system where Ceiling Locking is not enforced
+         --  we may end up getting two Yield effects.
+
+         STPO.Yield;
       end if;
 
       SSL.Abort_Undefer.all;

gcc/ada/s-osinte-freebsd.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   B o d y                                --
 --                                                                          --
---          Copyright (C) 1991-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1991-2007, 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- --
@@ -96,23 +96,4 @@ package body System.OS_Interface is
         ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
    end To_Timespec;
 
-   function To_Duration (TV : struct_timeval) return Duration is
-   begin
-      return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
-   end To_Duration;
-
-   function To_Timeval (D : Duration) return struct_timeval is
-      S : long;
-      F : Duration;
-   begin
-      S := long (Long_Long_Integer (D));
-      F := D - Duration (S);
-
-      --  If F has negative value due to a round-up, adjust for positive F
-      --  value.
-      if F < 0.0 then S := S - 1; F := F + 1.0; end if;
-      return struct_timeval'(tv_sec => S,
-        tv_usec => long (Long_Long_Integer (F * 10#1#E6)));
-   end To_Timeval;
-
 end System.OS_Interface;

gcc/ada/s-osinte-freebsd.ads

@@ -7,7 +7,7 @@
 --                                   S p e c                                --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---             Copyright (C) 1995-2006, Free Software Foundation, Inc.      --
+--             Copyright (C) 1995-2007, 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- --
@@ -42,7 +42,7 @@
 --  Preelaborate. This package is designed to be a bottom-level (leaf) package.
 
 with Interfaces.C;
-with Unchecked_Conversion;
+with Ada.Unchecked_Conversion;
 
 package System.OS_Interface is
    pragma Preelaborate;
@@ -221,20 +221,6 @@ package System.OS_Interface is
       tz_dsttime     : int;
    end record;
    pragma Convention (C, struct_timezone);
-   type struct_timeval is private;
-   --  This is needed on systems that do not have clock_gettime()
-   --  but do have gettimeofday().
-
-   function To_Duration (TV : struct_timeval) return Duration;
-   pragma Inline (To_Duration);
-
-   function To_Timeval (D : Duration) return struct_timeval;
-   pragma Inline (To_Timeval);
-
-   function gettimeofday
-     (tv : access struct_timeval;
-      tz : System.Address) return int;
-   pragma Import (C, gettimeofday, "gettimeofday");
 
    procedure usleep (useconds : unsigned_long);
    pragma Import (C, usleep, "usleep");
@@ -283,7 +269,7 @@ package System.OS_Interface is
      function (arg : System.Address) return System.Address;
 
    function Thread_Body_Access is new
-     Unchecked_Conversion (System.Address, Thread_Body);
+     Ada.Unchecked_Conversion (System.Address, Thread_Body);
 
    type pthread_t           is private;
    subtype Thread_Id        is pthread_t;
@@ -635,12 +621,6 @@ private
    type clockid_t is new int;
    CLOCK_REALTIME : constant clockid_t := 0;
 
-   type struct_timeval is record
-      tv_sec  : long;
-      tv_usec : long;
-   end record;
-   pragma Convention (C, struct_timeval);
-
    type pthread_t           is new System.Address;
    type pthread_attr_t      is new System.Address;
    type pthread_mutex_t     is new System.Address;

gcc/ada/s-osinte-lynxos-3.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1999-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2007, 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- --
@@ -73,11 +73,6 @@ package body System.OS_Interface is
       return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
    end To_Duration;
 
-   function To_Duration (TV : struct_timeval) return Duration is
-   begin
-      return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
-   end To_Duration;
-
    ------------------------
    -- To_Target_Priority --
    ------------------------
@@ -113,30 +108,6 @@ package body System.OS_Interface is
         tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
    end To_Timespec;
 
-   ----------------
-   -- To_Timeval --
-   ----------------
-
-   function To_Timeval (D : Duration) return struct_timeval is
-      S : time_t;
-      F : Duration;
-
-   begin
-      S := time_t (Long_Long_Integer (D));
-      F := D - Duration (S);
-
-      --  If F has negative value due to a round-up, adjust for positive F
-      --  value.
-
-      if F < 0.0 then
-         S := S - 1;
-         F := F + 1.0;
-      end if;
-
-      return struct_timeval'(tv_sec => S,
-        tv_usec => time_t (Long_Long_Integer (F * 10#1#E6)));
-   end To_Timeval;
-
    -------------------------
    -- POSIX.1c  Section 3 --
    -------------------------

gcc/ada/s-osinte-lynxos-3.ads

@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2007, 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- --
@@ -41,7 +41,7 @@
 --  Preelaborate. This package is designed to be a bottom-level (leaf) package.
 
 with Interfaces.C;
-with Unchecked_Conversion;
+with Ada.Unchecked_Conversion;
 
 package System.OS_Interface is
    pragma Preelaborate;
@@ -201,16 +201,6 @@ package System.OS_Interface is
    pragma Convention (C, struct_timezone);
    type struct_timezone_ptr is access all struct_timezone;
 
-   type struct_timeval is private;
-   --  This is needed on systems that do not have clock_gettime()
-   --  but do have gettimeofday().
-
-   function To_Duration (TV : struct_timeval) return Duration;
-   pragma Inline (To_Duration);
-
-   function To_Timeval (D : Duration) return struct_timeval;
-   pragma Inline (To_Timeval);
-
    -------------------------
    -- Priority Scheduling --
    -------------------------
@@ -253,7 +243,7 @@ package System.OS_Interface is
      function (arg : System.Address) return System.Address;
 
    function Thread_Body_Access is new
-     Unchecked_Conversion (System.Address, Thread_Body);
+     Ada.Unchecked_Conversion (System.Address, Thread_Body);
 
    type pthread_t           is private;
    subtype Thread_Id        is pthread_t;
@@ -525,12 +515,6 @@ private
    type clockid_t is new unsigned_char;
    CLOCK_REALTIME : constant clockid_t := 0;
 
-   type struct_timeval is record
-      tv_sec  : time_t;
-      tv_usec : time_t;
-   end record;
-   pragma Convention (C, struct_timeval);
-
    type st_t is record
       stksize      : int;
       prio         : int;

gcc/ada/s-osinte-lynxos.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---                     Copyright (C) 2001-2006, AdaCore                     --
+--                     Copyright (C) 2001-2007, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -50,11 +50,6 @@ package body System.OS_Interface is
       return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
    end To_Duration;
 
-   function To_Duration (TV : struct_timeval) return Duration is
-   begin
-      return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
-   end To_Duration;
-
    -----------------
    -- To_Timespec --
    -----------------
@@ -79,32 +74,6 @@ package body System.OS_Interface is
                        tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
    end To_Timespec;
 
-   ----------------
-   -- To_Timeval --
-   ----------------
-
-   function To_Timeval (D : Duration) return struct_timeval is
-      S : time_t;
-      F : Duration;
-
-   begin
-      S := time_t (Long_Long_Integer (D));
-      F := D - Duration (S);
-
-      --  If F has negative value due to a round-up, adjust for positive F
-      --  value.
-
-      if F < 0.0 then
-         S := S - 1;
-         F := F + 1.0;
-      end if;
-
-      return
-        struct_timeval'
-          (tv_sec => S,
-           tv_usec => time_t (Long_Long_Integer (F * 10#1#E6)));
-   end To_Timeval;
-
    -------------
    -- sigwait --
    -------------

gcc/ada/s-osinte-lynxos.ads

@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---             Copyright (C) 1995-2006, Free Software Foundation, Inc.      --
+--             Copyright (C) 1995-2007, 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- --
@@ -41,7 +41,7 @@
 --  Preelaborate. This package is designed to be a bottom-level (leaf) package.
 
 with Interfaces.C;
-with Unchecked_Conversion;
+with Ada.Unchecked_Conversion;
 
 package System.OS_Interface is
    pragma Preelaborate;
@@ -220,16 +220,6 @@ package System.OS_Interface is
    pragma Convention (C, struct_timezone);
    type struct_timezone_ptr is access all struct_timezone;
 
-   type struct_timeval is private;
-   --  This is needed on systems that do not have clock_gettime()
-   --  but do have gettimeofday().
-
-   function To_Duration (TV : struct_timeval) return Duration;
-   pragma Inline (To_Duration);
-
-   function To_Timeval (D : Duration) return struct_timeval;
-   pragma Inline (To_Timeval);
-
    -------------------------
    -- Priority Scheduling --
    -------------------------
@@ -265,7 +255,7 @@ package System.OS_Interface is
      function (arg : System.Address) return System.Address;
 
    function Thread_Body_Access is new
-     Unchecked_Conversion (System.Address, Thread_Body);
+     Ada.Unchecked_Conversion (System.Address, Thread_Body);
 
    type pthread_t           is private;
    subtype Thread_Id        is pthread_t;
@@ -520,12 +510,6 @@ private
    type clockid_t is new unsigned_char;
    CLOCK_REALTIME : constant clockid_t := 0;
 
-   type struct_timeval is record
-      tv_sec  : time_t;
-      tv_usec : time_t;
-   end record;
-   pragma Convention (C, struct_timeval);
-
    type st_attr_t is record
       stksize      : int;
       prio         : int;

gcc/ada/s-osinte-tru64.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1998-2006, Free Software Foundation, Inc.          --
+--         Copyright (C) 1998-2007, 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- --
@@ -114,11 +114,6 @@ package body System.OS_Interface is
       return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
    end To_Duration;
 
-   function To_Duration (TV : struct_timeval) return Duration is
-   begin
-      return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
-   end To_Duration;
-
    -----------------
    -- To_Timespec --
    -----------------
@@ -143,30 +138,4 @@ package body System.OS_Interface is
                        tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
    end To_Timespec;
 
-   ----------------
-   -- To_Timeval --
-   ----------------
-
-   function To_Timeval (D : Duration) return struct_timeval is
-      S : time_t;
-      F : Duration;
-
-   begin
-      S := time_t (Long_Long_Integer (D));
-      F := D - Duration (S);
-
-      --  If F has negative value due to a round-up, adjust for positive F
-      --  value.
-
-      if F < 0.0 then
-         S := S - 1;
-         F := F + 1.0;
-      end if;
-
-      return
-        struct_timeval'
-          (tv_sec => S,
-           tv_usec => time_t (Long_Long_Integer (F * 10#1#E6)));
-   end To_Timeval;
-
 end System.OS_Interface;

gcc/ada/s-osinte-tru64.ads

@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---             Copyright (C) 1995-2006, Free Software Foundation, Inc.      --
+--             Copyright (C) 1995-2007, 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- --
@@ -41,7 +41,7 @@
 --  Preelaborate. This package is designed to be a bottom-level (leaf) package.
 
 with Interfaces.C;
-with Unchecked_Conversion;
+with Ada.Unchecked_Conversion;
 
 package System.OS_Interface is
    pragma Preelaborate;
@@ -211,15 +211,6 @@ package System.OS_Interface is
       tz_dsttime     : int;
    end record;
    pragma Convention (C, struct_timezone);
-   type struct_timeval is private;
-   --  This is needed on systems that do not have clock_gettime()
-   --  but do have gettimeofday().
-
-   function To_Duration (TV : struct_timeval) return Duration;
-   pragma Inline (To_Duration);
-
-   function To_Timeval (D : Duration) return struct_timeval;
-   pragma Inline (To_Timeval);
 
    -------------------------
    -- Priority Scheduling --
@@ -258,7 +249,7 @@ package System.OS_Interface is
      function (arg : System.Address) return System.Address;
 
    function Thread_Body_Access is new
-     Unchecked_Conversion (System.Address, Thread_Body);
+     Ada.Unchecked_Conversion (System.Address, Thread_Body);
 
    type pthread_t           is private;
    subtype Thread_Id        is pthread_t;
@@ -514,12 +505,6 @@ private
    type clockid_t is new int;
    CLOCK_REALTIME : constant clockid_t := 1;
 
-   type struct_timeval is record
-      tv_sec  : time_t;
-      tv_usec : time_t;
-   end record;
-   pragma Convention (C, struct_timeval);
-
    type unsigned_long_array is array (Natural range <>) of unsigned_long;
 
    type pthread_t is new System.Address;

gcc/ada/s-osprim-mingw.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2007, 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- --
@@ -79,7 +79,7 @@ package body System.OS_Primitives is
    --  GNU/Linker will fail to auto-import those variables when building
    --  libgnarl.dll. The indirection level introduced here has no measurable
    --  penalties.
-   --
+
    --  Note that access variables below must not be declared as constant
    --  otherwise the compiler optimization will remove this indirect access.
 
@@ -179,6 +179,7 @@ package body System.OS_Primitives is
    -------------------
 
    procedure Get_Base_Time is
+
       --  The resolution for GetSystemTime is 1 millisecond.
 
       --  The time to get both base times should take less than 1 millisecond.
@@ -225,6 +226,7 @@ package body System.OS_Primitives is
    function Monotonic_Clock return Duration is
       Current_Ticks  : aliased LARGE_INTEGER;
       Elap_Secs_Tick : Duration;
+
    begin
       if not QueryPerformanceCounter (Current_Ticks'Access) then
          return 0.0;
@@ -262,9 +264,17 @@ package body System.OS_Primitives is
          end case;
       end Mode_Clock;
 
+      --  Local Variables
+
+      Base_Time : constant Duration := Mode_Clock;
+      --  Base_Time is used to detect clock set backward, in this case we
+      --  cannot ensure the delay accuracy.
+
       Rel_Time   : Duration;
       Abs_Time   : Duration;
-      Check_Time : Duration := Mode_Clock;
+      Check_Time : Duration := Base_Time;
+
+   --  Start of processing for Timed Delay
 
    begin
       if Mode = Relative then
@@ -280,7 +290,7 @@ package body System.OS_Primitives is
             Sleep (DWORD (Rel_Time * 1000.0));
             Check_Time := Mode_Clock;
 
-            exit when Abs_Time <= Check_Time;
+            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
 
             Rel_Time := Abs_Time - Check_Time;
          end loop;

gcc/ada/s-osprim-posix.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1998-2006 Free Software Foundation, Inc.          --
+--          Copyright (C) 1998-2007, 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- --
@@ -129,7 +129,8 @@ package body System.OS_Primitives is
       Remaind    : aliased timespec;
       Rel_Time   : Duration;
       Abs_Time   : Duration;
-      Check_Time : Duration := Clock;
+      Base_Time  : constant Duration := Clock;
+      Check_Time : Duration := Base_Time;
 
       Result : Integer;
       pragma Unreferenced (Result);
@@ -149,7 +150,7 @@ package body System.OS_Primitives is
             Result := nanosleep (Request'Access, Remaind'Access);
             Check_Time := Clock;
 
-            exit when Abs_Time <= Check_Time;
+            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
 
             Rel_Time := Abs_Time - Check_Time;
          end loop;

gcc/ada/s-osprim-solaris.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1998-2006 Free Software Foundation, Inc.          --
+--          Copyright (C) 1998-2007, 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- --
@@ -88,7 +88,8 @@ package body System.OS_Primitives is
    is
       Rel_Time   : Duration;
       Abs_Time   : Duration;
-      Check_Time : Duration := Clock;
+      Base_Time  : constant Duration := Clock;
+      Check_Time : Duration := Base_Time;
       timeval    : aliased struct_timeval;
 
    begin
@@ -114,7 +115,7 @@ package body System.OS_Primitives is
             C_select (timeout => timeval'Unchecked_Access);
             Check_Time := Clock;
 
-            exit when Abs_Time <= Check_Time;
+            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
 
             Rel_Time := Abs_Time - Check_Time;
          end loop;

gcc/ada/s-osprim-unix.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1998-2006 Free Software Foundation, Inc.          --
+--          Copyright (C) 1998-2007, 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- --
@@ -88,7 +88,8 @@ package body System.OS_Primitives is
    is
       Rel_Time   : Duration;
       Abs_Time   : Duration;
-      Check_Time : Duration := Clock;
+      Base_Time  : constant Duration := Clock;
+      Check_Time : Duration := Base_Time;
       timeval    : aliased struct_timeval;
 
    begin
@@ -114,7 +115,7 @@ package body System.OS_Primitives is
             C_select (timeout => timeval'Unchecked_Access);
             Check_Time := Clock;
 
-            exit when Abs_Time <= Check_Time;
+            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
 
             Rel_Time := Abs_Time - Check_Time;
          end loop;

gcc/ada/s-osprim-vxworks.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1998-2007, 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- --
@@ -121,7 +121,8 @@ package body System.OS_Primitives is
    is
       Rel_Time   : Duration;
       Abs_Time   : Duration;
-      Check_Time : Duration := Clock;
+      Base_Time  : constant Duration := Clock;
+      Check_Time : Duration := Base_Time;
       Ticks      : int;
 
       Result     : int;
@@ -151,7 +152,7 @@ package body System.OS_Primitives is
             Result := taskDelay (Ticks);
             Check_Time := Clock;
 
-            exit when Abs_Time <= Check_Time;
+            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
 
             Rel_Time := Abs_Time - Check_Time;
          end loop;

gcc/ada/s-parame-ae653.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007, 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- --
@@ -171,18 +171,6 @@ package System.Parameters is
    --  pragma Restrictions (No_Abort_Statements);
    --  pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
 
-   ----------------------
-   -- Dynamic Priority --
-   ----------------------
-
-   Dynamic_Priority_Support : constant Boolean := True;
-   --  This constant indicates whether dynamic changes of task priorities
-   --  are allowed (True means normal RM mode in which such changes are
-   --  allowed). In particular, if this is False, then we do not need to
-   --  poll for pending base priority changes at every abort completion
-   --  point. A value of False for Dynamic_Priority_Support corresponds
-   --  to pragma Restrictions (No_Dynamic_Priorities);
-
    ---------------------
    -- Task Attributes --
    ---------------------
@@ -200,6 +188,13 @@ package System.Parameters is
    --  predefined output or not (True means that traces are output).
    --  See System.Traces for more details.
 
+   -----------------------
+   -- Task Image Length --
+   -----------------------
+
+   Max_Task_Image_Length : constant := 32;
+   --  This constant specifies the maximum length of a task's image.
+
    ------------------------------
    -- Exception Message Length --
    ------------------------------

gcc/ada/s-parame-hpux.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007 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- --
@@ -169,18 +169,6 @@ package System.Parameters is
    --  pragma Restrictions (No_Abort_Statements);
    --  pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
 
-   ----------------------
-   -- Dynamic Priority --
-   ----------------------
-
-   Dynamic_Priority_Support : constant Boolean := True;
-   --  This constant indicates whether dynamic changes of task priorities
-   --  are allowed (True means normal RM mode in which such changes are
-   --  allowed). In particular, if this is False, then we do not need to
-   --  poll for pending base priority changes at every abort completion
-   --  point. A value of False for Dynamic_Priority_Support corresponds
-   --  to pragma Restrictions (No_Dynamic_Priorities);
-
    ---------------------
    -- Task Attributes --
    ---------------------
@@ -198,6 +186,13 @@ package System.Parameters is
    --  predefined output or not (True means that traces are output).
    --  See System.Traces for more details.
 
+   -----------------------
+   -- Task Image Length --
+   -----------------------
+
+   Max_Task_Image_Length : constant := 256;
+   --  This constant specifies the maximum length of a task's image.
+
    ------------------------------
    -- Exception Message Length --
    ------------------------------

gcc/ada/s-parame-vms-alpha.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007 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- --
@@ -169,18 +169,6 @@ package System.Parameters is
    --  pragma Restrictions (No_Abort_Statements);
    --  pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
 
-   ----------------------
-   -- Dynamic Priority --
-   ----------------------
-
-   Dynamic_Priority_Support : constant Boolean := True;
-   --  This constant indicates whether dynamic changes of task priorities
-   --  are allowed (True means normal RM mode in which such changes are
-   --  allowed). In particular, if this is False, then we do not need to
-   --  poll for pending base priority changes at every abort completion
-   --  point. A value of False for Dynamic_Priority_Support corresponds
-   --  to pragma Restrictions (No_Dynamic_Priorities);
-
    ---------------------
    -- Task Attributes --
    ---------------------
@@ -198,6 +186,13 @@ package System.Parameters is
    --  predefined output or not (True means that traces are output).
    --  See System.Traces for more details.
 
+   -----------------------
+   -- Task Image Length --
+   -----------------------
+
+   Max_Task_Image_Length : constant := 256;
+   --  This constant specifies the maximum length of a task's image.
+
    ------------------------------
    -- Exception Message Length --
    ------------------------------

gcc/ada/s-parame-vms-ia64.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007 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- --
@@ -169,18 +169,6 @@ package System.Parameters is
    --  pragma Restrictions (No_Abort_Statements);
    --  pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
 
-   ----------------------
-   -- Dynamic Priority --
-   ----------------------
-
-   Dynamic_Priority_Support : constant Boolean := True;
-   --  This constant indicates whether dynamic changes of task priorities
-   --  are allowed (True means normal RM mode in which such changes are
-   --  allowed). In particular, if this is False, then we do not need to
-   --  poll for pending base priority changes at every abort completion
-   --  point. A value of False for Dynamic_Priority_Support corresponds
-   --  to pragma Restrictions (No_Dynamic_Priorities);
-
    ---------------------
    -- Task Attributes --
    ---------------------
@@ -198,6 +186,13 @@ package System.Parameters is
    --  predefined output or not (True means that traces are output).
    --  See System.Traces for more details.
 
+   -----------------------
+   -- Task Image Length --
+   -----------------------
+
+   Max_Task_Image_Length : constant := 256;
+   --  This constant specifies the maximum length of a task's image.
+
    ------------------------------
    -- Exception Message Length --
    ------------------------------

gcc/ada/s-parame-vms-restrict.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007 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- --
@@ -169,18 +169,6 @@ package System.Parameters is
    --  pragma Restrictions (No_Abort_Statements);
    --  pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
 
-   ----------------------
-   -- Dynamic Priority --
-   ----------------------
-
-   Dynamic_Priority_Support : constant Boolean := False;
-   --  This constant indicates whether dynamic changes of task priorities
-   --  are allowed (True means normal RM mode in which such changes are
-   --  allowed). In particular, if this is False, then we do not need to
-   --  poll for pending base priority changes at every abort completion
-   --  point. A value of False for Dynamic_Priority_Support corresponds
-   --  to pragma Restrictions (No_Dynamic_Priorities);
-
    ---------------------
    -- Task Attributes --
    ---------------------
@@ -198,6 +186,13 @@ package System.Parameters is
    --  predefined output or not (True means that traces are output).
    --  See System.Traces for more details.
 
+   -----------------------
+   -- Task Image Length --
+   -----------------------
+
+   Max_Task_Image_Length : constant := 256;
+   --  This constant specifies the maximum length of a task's image.
+
    ------------------------------
    -- Exception Message Length --
    ------------------------------

gcc/ada/s-parame-vxworks.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007 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- --
@@ -171,18 +171,6 @@ package System.Parameters is
    --  pragma Restrictions (No_Abort_Statements);
    --  pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
 
-   ----------------------
-   -- Dynamic Priority --
-   ----------------------
-
-   Dynamic_Priority_Support : constant Boolean := True;
-   --  This constant indicates whether dynamic changes of task priorities
-   --  are allowed (True means normal RM mode in which such changes are
-   --  allowed). In particular, if this is False, then we do not need to
-   --  poll for pending base priority changes at every abort completion
-   --  point. A value of False for Dynamic_Priority_Support corresponds
-   --  to pragma Restrictions (No_Dynamic_Priorities);
-
    ---------------------
    -- Task Attributes --
    ---------------------
@@ -200,6 +188,13 @@ package System.Parameters is
    --  predefined output or not (True means that traces are output).
    --  See System.Traces for more details.
 
+   -----------------------
+   -- Task Image Length --
+   -----------------------
+
+   Max_Task_Image_Length : constant := 32;
+   --  This constant specifies the maximum length of a task's image.
+
    ------------------------------
    -- Exception Message Length --
    ------------------------------

gcc/ada/s-parame.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007 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- --
@@ -169,18 +169,6 @@ package System.Parameters is
    --  pragma Restrictions (No_Abort_Statements);
    --  pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
 
-   ----------------------
-   -- Dynamic Priority --
-   ----------------------
-
-   Dynamic_Priority_Support : constant Boolean := True;
-   --  This constant indicates whether dynamic changes of task priorities
-   --  are allowed (True means normal RM mode in which such changes are
-   --  allowed). In particular, if this is False, then we do not need to
-   --  poll for pending base priority changes at every abort completion
-   --  point. A value of False for Dynamic_Priority_Support corresponds
-   --  to pragma Restrictions (No_Dynamic_Priorities);
-
    ---------------------
    -- Task Attributes --
    ---------------------
@@ -198,6 +186,13 @@ package System.Parameters is
    --  predefined output or not (True means that traces are output).
    --  See System.Traces for more details.
 
+   -----------------------
+   -- Task Image Length --
+   -----------------------
+
+   Max_Task_Image_Length : constant := 256;
+   --  This constant specifies the maximum length of a task's image.
+
    ------------------------------
    -- Exception Message Length --
    ------------------------------

gcc/ada/s-taprop-dummy.adb

@@ -64,8 +64,6 @@ package body System.Task_Primitives.Operations is
    -- Check_Exit --
    ----------------
 
-   --  Dummy version
-
    function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
    begin
       return True;
@@ -266,7 +264,9 @@ package body System.Task_Primitives.Operations is
    ---------------
 
    procedure Read_Lock
-     (L : not null access Lock; Ceiling_Violation : out Boolean) is
+     (L                 : not null access Lock;
+      Ceiling_Violation : out Boolean)
+   is
    begin
       Ceiling_Violation := False;
    end Read_Lock;
@@ -310,6 +310,18 @@ package body System.Task_Primitives.Operations is
       return Null_Task;
    end Self;
 
+   -----------------
+   -- Set_Ceiling --
+   -----------------
+
+   procedure Set_Ceiling
+     (L    : not null access Lock;
+      Prio : System.Any_Priority)
+   is
+   begin
+      null;
+   end Set_Ceiling;
+
    ---------------
    -- Set_False --
    ---------------
@@ -420,7 +432,9 @@ package body System.Task_Primitives.Operations is
    end Unlock;
 
    procedure Unlock
-     (L : not null access RTS_Lock; Global_Lock : Boolean := False) is
+     (L           : not null access RTS_Lock;
+      Global_Lock : Boolean := False)
+   is
    begin
       null;
    end Unlock;
@@ -452,7 +466,9 @@ package body System.Task_Primitives.Operations is
    ----------------
 
    procedure Write_Lock
-     (L : not null access Lock; Ceiling_Violation : out Boolean) is
+     (L                 : not null access Lock;
+      Ceiling_Violation : out Boolean)
+   is
    begin
       Ceiling_Violation := False;
    end Write_Lock;

gcc/ada/s-tasini.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2007, 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- --
@@ -81,11 +81,6 @@ package body System.Tasking.Initialization is
    --  from all other tasks. It is only used by Task_Lock,
    --  Task_Unlock, and Final_Task_Unlock.
 
-   function Current_Target_Exception return AE.Exception_Occurrence;
-   pragma Import
-     (Ada, Current_Target_Exception, "__gnat_current_target_exception");
-   --  Import this subprogram from the private part of Ada.Exceptions
-
    ----------------------------------------------------------------------
    -- Tasking versions of some services needed by non-tasking programs --
    ----------------------------------------------------------------------
@@ -112,8 +107,11 @@ package body System.Tasking.Initialization is
    function Get_Stack_Info return Stack_Checking.Stack_Access;
    --  Get access to the current task's Stack_Info
 
+   function Get_Current_Excep return SSL.EOA;
+   --  Task-safe version of SSL.Get_Current_Excep
+
    procedure Update_Exception
-     (X : AE.Exception_Occurrence := Current_Target_Exception);
+     (X : AE.Exception_Occurrence := SSL.Current_Target_Exception);
    --  Handle exception setting and check for pending actions
 
    function Task_Name return String;
@@ -170,7 +168,7 @@ package body System.Tasking.Initialization is
 
    procedure Defer_Abort (Self_ID : Task_Id) is
    begin
-      if No_Abort and then not Dynamic_Priority_Support then
+      if No_Abort then
          return;
       end if;
 
@@ -211,7 +209,7 @@ package body System.Tasking.Initialization is
 
    procedure Defer_Abort_Nestable (Self_ID : Task_Id) is
    begin
-      if No_Abort and then not Dynamic_Priority_Support then
+      if No_Abort then
          return;
       end if;
 
@@ -232,7 +230,7 @@ package body System.Tasking.Initialization is
    procedure Abort_Defer is
       Self_ID : Task_Id;
    begin
-      if No_Abort and then not Dynamic_Priority_Support then
+      if No_Abort then
          return;
       end if;
 
@@ -241,6 +239,15 @@ package body System.Tasking.Initialization is
    end Abort_Defer;
 
    -----------------------
+   -- Get_Current_Excep --
+   -----------------------
+
+   function Get_Current_Excep return SSL.EOA is
+   begin
+      return STPO.Self.Common.Compiler_Data.Current_Excep'Access;
+   end Get_Current_Excep;
+
+   -----------------------
    -- Do_Pending_Action --
    -----------------------
 
@@ -266,7 +273,6 @@ package body System.Tasking.Initialization is
 
          Write_Lock (Self_ID);
          Self_ID.Pending_Action := False;
-         Poll_Base_Priority_Change (Self_ID);
          Unlock (Self_ID);
 
          if Single_Lock then
@@ -368,17 +374,18 @@ package body System.Tasking.Initialization is
       --  Notify that the tasking run time has been elaborated so that
       --  the tasking version of the soft links can be used.
 
-      if not No_Abort or else Dynamic_Priority_Support then
+      if not No_Abort then
          SSL.Abort_Defer   := Abort_Defer'Access;
          SSL.Abort_Undefer := Abort_Undefer'Access;
       end if;
 
-      SSL.Update_Exception   := Update_Exception'Access;
       SSL.Lock_Task          := Task_Lock'Access;
       SSL.Unlock_Task        := Task_Unlock'Access;
       SSL.Check_Abort_Status := Check_Abort_Status'Access;
       SSL.Get_Stack_Info     := Get_Stack_Info'Access;
       SSL.Task_Name          := Task_Name'Access;
+      SSL.Update_Exception   := Update_Exception'Access;
+      SSL.Get_Current_Excep  := Get_Current_Excep'Access;
 
       --  Initialize the tasking soft links (if not done yet) that are common
       --  to the full and the restricted run times.
@@ -522,68 +529,6 @@ package body System.Tasking.Initialization is
       end if;
    end Locked_Abort_To_Level;
 
-   -------------------------------
-   -- Poll_Base_Priority_Change --
-   -------------------------------
-
-   --  Poll for pending base priority change and for held tasks.
-   --  This should always be called with (only) Self_ID locked.
-   --  It may temporarily release Self_ID's lock.
-
-   --  The call to Yield is to force enqueuing at the
-   --  tail of the dispatching queue.
-
-   --  We must unlock Self_ID for this to take effect,
-   --  since we are inheriting high active priority from the lock.
-
-   --  See also Poll_Base_Priority_Change_At_Entry_Call,
-   --  in package System.Tasking.Entry_Calls.
-
-   --  In this version, we check if the task is held too because
-   --  doing this only in Do_Pending_Action is not enough.
-
-   procedure Poll_Base_Priority_Change (Self_ID : Task_Id) is
-   begin
-      if Dynamic_Priority_Support and then Self_ID.Pending_Priority_Change then
-
-         --  Check for ceiling violations ???
-
-         Self_ID.Pending_Priority_Change := False;
-
-         if Self_ID.Common.Base_Priority = Self_ID.New_Base_Priority then
-            if Single_Lock then
-               Unlock_RTS;
-               Yield;
-               Lock_RTS;
-            else
-               Unlock (Self_ID);
-               Yield;
-               Write_Lock (Self_ID);
-            end if;
-
-         elsif Self_ID.Common.Base_Priority < Self_ID.New_Base_Priority then
-            Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority;
-            Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
-
-         else
-            --  Lowering priority
-
-            Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority;
-            Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
-
-            if Single_Lock then
-               Unlock_RTS;
-               Yield;
-               Lock_RTS;
-            else
-               Unlock (Self_ID);
-               Yield;
-               Write_Lock (Self_ID);
-            end if;
-         end if;
-      end if;
-   end Poll_Base_Priority_Change;
-
    --------------------------------
    -- Remove_From_All_Tasks_List --
    --------------------------------
@@ -685,7 +630,7 @@ package body System.Tasking.Initialization is
 
    procedure Undefer_Abort (Self_ID : Task_Id) is
    begin
-      if No_Abort and then not Dynamic_Priority_Support then
+      if No_Abort then
          return;
       end if;
 
@@ -721,7 +666,7 @@ package body System.Tasking.Initialization is
 
    procedure Undefer_Abort_Nestable (Self_ID : Task_Id) is
    begin
-      if No_Abort and then not Dynamic_Priority_Support then
+      if No_Abort then
          return;
       end if;
 
@@ -746,7 +691,7 @@ package body System.Tasking.Initialization is
    procedure Abort_Undefer is
       Self_ID : Task_Id;
    begin
-      if No_Abort and then not Dynamic_Priority_Support then
+      if No_Abort then
          return;
       end if;
 
@@ -787,7 +732,7 @@ package body System.Tasking.Initialization is
    --  Call only when holding no locks
 
    procedure Update_Exception
-     (X : AE.Exception_Occurrence := Current_Target_Exception)
+     (X : AE.Exception_Occurrence := SSL.Current_Target_Exception)
    is
       Self_Id : constant Task_Id := Self;
       use Ada.Exceptions;
@@ -806,7 +751,6 @@ package body System.Tasking.Initialization is
 
             Write_Lock (Self_Id);
             Self_Id.Pending_Action := False;
-            Poll_Base_Priority_Change (Self_Id);
             Unlock (Self_Id);
 
             if Single_Lock then
@@ -856,15 +800,12 @@ package body System.Tasking.Initialization is
       New_State  : Entry_Call_State)
    is
       Caller : constant Task_Id := Entry_Call.Self;
-
    begin
       pragma Debug (Debug.Trace
         (Self_ID, "Wakeup_Entry_Caller", 'E', Caller));
       pragma Assert (New_State = Done or else New_State = Cancelled);
 
-      pragma Assert
-        (Caller.Common.State /= Terminated
-          and then Caller.Common.State /= Unactivated);
+      pragma Assert (Caller.Common.State /= Unactivated);
 
       Entry_Call.State := New_State;
 
@@ -901,15 +842,13 @@ package body System.Tasking.Initialization is
    --  the subprogram body where the real subprogram is declared.
 
    procedure Finalize_Attributes (T : Task_Id) is
-      pragma Warnings (Off, T);
-
+      pragma Unreferenced (T);
    begin
       null;
    end Finalize_Attributes;
 
    procedure Initialize_Attributes (T : Task_Id) is
-      pragma Warnings (Off, T);
-
+      pragma Unreferenced (T);
    begin
       null;
    end Initialize_Attributes;

gcc/ada/s-tasini.ads

@@ -139,11 +139,6 @@ package System.Tasking.Initialization is
    --  Change the base priority of T. Has to be called with the affected
    --  task's ATCB write-locked. May temporariliy release the lock.
 
-   procedure Poll_Base_Priority_Change (Self_ID : Task_Id);
-   --  Has to be called with Self_ID's ATCB write-locked.
-   --  May temporariliy release the lock.
-   pragma Inline (Poll_Base_Priority_Change);
-
    ----------------------
    -- Task Lock/Unlock --
    ----------------------

gcc/ada/s-tasren.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 1992-2006, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2007, 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- --
@@ -48,7 +48,6 @@ with System.Tasking.Entry_Calls;
 with System.Tasking.Initialization;
 --  used for Defer_Abort
 --           Undefer_Abort
---           Poll_Base_Priority_Change
 --           Do_Pending_Action
 
 with System.Tasking.Queuing;
@@ -71,6 +70,9 @@ with System.Tasking.Protected_Objects.Operations;
 with System.Tasking.Debug;
 --  used for Trace
 
+with System.Restrictions;
+--  used for Abort_Allowed
+
 with System.Parameters;
 --  used for Single_Lock
 --           Runtime_Traces
@@ -476,7 +478,7 @@ package body System.Tasking.Rendezvous is
             Send_Trace_Info (E_Missed, Acceptor);
          end if;
 
-         Initialization.Undefer_Abort (Self_Id);
+         Local_Undefer_Abort (Self_Id);
          raise Tasking_Error;
       end if;
 
@@ -506,7 +508,7 @@ package body System.Tasking.Rendezvous is
       Self_Id : constant Task_Id := STPO.Self;
 
    begin
-      Initialization.Defer_Abort (Self_Id);
+      Initialization.Defer_Abort_Nestable (Self_Id);
 
       if Single_Lock then
          Lock_RTS;
@@ -520,7 +522,7 @@ package body System.Tasking.Rendezvous is
          Unlock_RTS;
       end if;
 
-      Initialization.Undefer_Abort (Self_Id);
+      Initialization.Undefer_Abort_Nestable (Self_Id);
       return Result;
    end Callable;
 
@@ -923,7 +925,11 @@ package body System.Tasking.Rendezvous is
             then
                Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
 
-               pragma Assert (Self_Id.Deferral_Level = 1);
+               pragma Assert
+                 (Self_Id.Deferral_Level = 1
+                   or else
+                     (Self_Id.Deferral_Level = 0
+                       and then not Restrictions.Abort_Allowed));
 
                Initialization.Defer_Abort_Nestable (Self_Id);
 
@@ -1019,7 +1025,6 @@ package body System.Tasking.Rendezvous is
                Self_Id.Common.State := Delay_Sleep;
 
                loop
-                  Initialization.Poll_Base_Priority_Change (Self_Id);
                   exit when
                     Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level;
                   Sleep (Self_Id, Delay_Sleep);
@@ -1097,6 +1102,11 @@ package body System.Tasking.Rendezvous is
          Unlock_RTS;
       end if;
 
+      --  Call Yield to let other tasks get a chance to run as this is a
+      --  potential dispatching point.
+
+      Yield (Do_Yield => False);
+
       Initialization.Undefer_Abort (Self_Id);
       return Return_Count;
    end Task_Count;
@@ -1119,7 +1129,8 @@ package body System.Tasking.Rendezvous is
       Null_Body     : Boolean;
 
    begin
-      --  Find out whether Entry_Call can be accepted immediately.
+      --  Find out whether Entry_Call can be accepted immediately
+
       --  If the Acceptor is not callable, return False.
       --  If the rendezvous can start, initiate it.
       --  If the accept-body is trivial, also complete the rendezvous.
@@ -1562,6 +1573,8 @@ package body System.Tasking.Rendezvous is
             --  Wait for a normal call and a pending action until the
             --  Wakeup_Time is reached.
 
+            Self_Id.Common.State := Acceptor_Sleep;
+
             --  Try to remove calls to Sleep in the loop below by letting the
             --  caller a chance of getting ready immediately, using Unlock
             --  Yield. See similar action in Wait_For_Completion/Wait_For_Call.
@@ -1588,10 +1601,7 @@ package body System.Tasking.Rendezvous is
                Self_Id.Open_Accepts := null;
             end if;
 
-            Self_Id.Common.State := Acceptor_Sleep;
-
             loop
-               Initialization.Poll_Base_Priority_Change (Self_Id);
                exit when Self_Id.Open_Accepts = null;
 
                if Timedout then
@@ -1653,8 +1663,6 @@ package body System.Tasking.Rendezvous is
             Self_Id.Open_Accepts := null;
             Self_Id.Common.State := Acceptor_Sleep;
 
-            Initialization.Poll_Base_Priority_Change (Self_Id);
-
             STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Sleep,
               Timedout, Yielded);
 
@@ -1799,9 +1807,11 @@ package body System.Tasking.Rendezvous is
 
    procedure Wait_For_Call (Self_Id : Task_Id) is
    begin
+      Self_Id.Common.State := Acceptor_Sleep;
+
       --  Try to remove calls to Sleep in the loop below by letting the caller
       --  a chance of getting ready immediately, using Unlock & Yield.
-      --  See similar action in Wait_For_Completion & Selective_Wait.
+      --  See similar action in Wait_For_Completion & Timed_Selective_Wait.
 
       if Single_Lock then
          Unlock_RTS;
@@ -1825,13 +1835,8 @@ package body System.Tasking.Rendezvous is
          Self_Id.Open_Accepts := null;
       end if;
 
-      Self_Id.Common.State := Acceptor_Sleep;
-
       loop
-         Initialization.Poll_Base_Priority_Change (Self_Id);
-
          exit when Self_Id.Open_Accepts = null;
-
          Sleep (Self_Id, Acceptor_Sleep);
       end loop;
 

gcc/ada/s-tasuti.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2006, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2007, 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- --
@@ -43,7 +43,6 @@ with System.Tasking.Debug;
 
 with System.Task_Primitives.Operations;
 --  used for Write_Lock
---           Set_Priority
 --           Wakeup
 --           Unlock
 --           Sleep
@@ -382,7 +381,7 @@ package body System.Tasking.Utilities is
             --  Our parent should wait in Phase 1 of Complete_Master.
 
             Master_Completion_Phase := 1;
-            pragma Assert (Self_ID.Awake_Count = 1);
+            pragma Assert (Self_ID.Awake_Count >= 1);
          end if;
 
       --  We are accepting with a terminate alternative
@@ -454,8 +453,6 @@ package body System.Tasking.Utilities is
             Write_Lock (C);
          end loop;
 
-         pragma Assert (P.Awake_Count /= 0);
-
          if P.Common.State = Master_Phase_2_Sleep
            and then C.Master_of_Task = P.Master_Within
          then
@@ -478,7 +475,6 @@ package body System.Tasking.Utilities is
       C.Awake_Count := C.Awake_Count - 1;
 
       if Task_Completed then
-         pragma Assert (Self_ID.Awake_Count = 0);
          C.Alive_Count := C.Alive_Count - 1;
       end if;
 
@@ -499,7 +495,9 @@ package body System.Tasking.Utilities is
       loop
          --  Notify P that C has gone passive
 
+         if P.Awake_Count > 0 then
             P.Awake_Count := P.Awake_Count - 1;
+         end if;
 
          if Task_Completed and then C.Alive_Count = 0 then
             P.Alive_Count := P.Alive_Count - 1;