2005-06-14 Jose Ruiz <ruiz@adacore.com>

	    Arnaud Charlet  <charlet@adacore.com>

	* a-sytaco.ads, a-sytaco.adb (Suspension_Object): These objects are no
	longer protected objects. They have been replaced by lower-level
	suspension objects made up by a mutex and a condition variable (or
	their equivalent given a particular OS) plus some internal data to
	reflect the state of the suspension object.
	(Initialize, Finalize): Add this initialization procedure for
	Suspension_Object, which is a controlled type.
	(Finalize): Add the finalization procedure for Suspension_Object,
	which is a controlled type.

	* a-sytaco-vxworks.ads, a-sytaco-vxworks.adb: Remove this version of
	Ada.Synchronous_Task_Control because there is no longer a need for a
	VxWorks specific version of this package. Target dependencies
	has been moved to System.Task_Primitives.Operations.

	* s-osinte-mingw.ads (pCRITICAL_SECTION): Remove this type which is no
	longer needed.
	(InitializeCriticalSection, EnterCriticalSection,
	LeaveCriticalSection, DeleteCriticalSection): Replace the type
	pCriticalSection by an anonymous access type so that we avoid problems
	of accessibility to local objects.

	* s-taprop.ads, s-taprop-posix.adb, s-taprop-vxworks.adb,
	s-taprop-mingw.adb, s-taprop-vms.adb, s-taprop-solaris.adb,
	s-taprop-os2.adb, s-taprop-dummy.adb, s-taprop-hpux-dce.adb,
	s-taprop-linux.adb, s-taprop-irix.adb, s-taprop-irix-athread.adb,
	s-taprop-tru64.adb, s-taprop-lynxos.adb (Elaboration Code): No longer
	set the environment task mask here.
	(Current_State): Add this function that returns the state of the
	suspension object.
	(Set_False): Add this procedure that sets the state of the suspension
	object to False.
	(Set_True): Add this procedure that sets the state of the suspension
	object to True, releasing the task that was suspended, if any.
	(Suspend_Until_True): Add this procedure that blocks the calling task
	until the state of the object is True. Program_Error is raised if
	another task is already waiting on that suspension object.
	(Initialize): Add this procedure for initializing the suspension
	object. It initializes the mutex and the condition variable which are
	used for synchronization and queuing, and it sets the internal state
	to False.
	(Finalize): Add this procedure for finalizing the suspension object,
	destroying the mutex and the condition variable.

	* s-taspri-posix.ads, s-taspri-vxworks.ads, s-taspri-mingw.ads,
	s-taspri-vms.ads, s-taspri-solaris.ads, s-taspri-os2.ads,
	s-taspri-dummy.ads, s-taspri-hpux-dce.ads, s-taspri-linux.ads,
	s-taspri-tru64.ads, s-taspri-lynxos.ads (Suspension_Object): New object
	which provides a low-level abstraction (using operating system
	primitives) for Ada.Synchronous_Task_Control.
	This object is made up by a mutex (for ensuring mutual exclusion), a
	condition variable (for queuing threads until the condition is
	signaled), a Boolean (State) indicating whether the object is open,
	and a Boolean (Waiting) reflecting whether there is a task already
	suspended on this object.

	* s-intman.ads, s-intman-irix.adb, s-intman-irix-athread.adb,
	s-intman-dummy.adb, s-intman-solaris.adb, s-intman-vms.adb,
	s-intman-vms.ads, s-intman-mingw.adb,
	(Initialize_Interrupts): Removed, no longer used.

	* s-inmaop-posix.adb, s-inmaop-vms.adb, s-inmaop-dummy.adb,
	(Setup_Interrupt_Mask): New procedure.

	* s-intman-vxworks.ads, s-intman-vxworks.adb:  Update comments.

	* s-inmaop.ads (Setup_Interrupt_Mask): New procedure

	* s-interr.adb: Add explicit call to Setup_Interrupt_Mask now that
	this is no longer done in the body of s-taprop
	(Server_Task): Explicitely test for Pending_Action in case
	System.Parameters.No_Abort is True.

	* s-taasde.adb: Add explicit call to Setup_Interrupt_Mask now that this
	is no longer done in the body of s-taprop


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

1 files changed, 143 insertions, 2 deletions

diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index 4298e09e845..c2b56956e63 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -1,6 +1,6 @@
 ------------------------------------------------------------------------------
 --                                                                          --
---                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
+--                  GNAT 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 . O P E R A T I O N S    --
 --                                                                          --
@@ -1010,7 +1010,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Abort_Task (T : Task_Id) is
       Result : int;
-
    begin
       Result := kill (T.Common.LL.Thread,
                       Signal (Interrupt_Management.Abort_Task_Signal));
@@ -1018,6 +1017,148 @@ package body System.Task_Primitives.Operations is
    end Abort_Task;
 
    ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize (S : in out Suspension_Object) is
+   begin
+      --  Initialize internal state. It is always initialized to False (ARM
+      --  D.10 par. 6).
+
+      S.State := False;
+      S.Waiting := False;
+
+      --  Initialize internal mutex
+
+      --  Use simpler binary semaphore instead of VxWorks
+      --  mutual exclusion semaphore, because we don't need
+      --  the fancier semantics and their overhead.
+
+      S.L := semBCreate (SEM_Q_FIFO, SEM_FULL);
+
+      --  Initialize internal condition variable
+
+      S.CV := semBCreate (SEM_Q_FIFO, SEM_EMPTY);
+   end Initialize;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize (S : in out Suspension_Object) is
+      Result : STATUS;
+   begin
+      --  Destroy internal mutex
+
+      Result := semDelete (S.L);
+      pragma Assert (Result = OK);
+
+      --  Destroy internal condition variable
+
+      Result := semDelete (S.CV);
+      pragma Assert (Result = OK);
+   end Finalize;
+
+   -------------------
+   -- Current_State --
+   -------------------
+
+   function Current_State (S : Suspension_Object) return Boolean is
+   begin
+      --  We do not want to use lock on this read operation. State is marked
+      --  as Atomic so that we ensure that the value retrieved is correct.
+
+      return S.State;
+   end Current_State;
+
+   ---------------
+   -- Set_False --
+   ---------------
+
+   procedure Set_False (S : in out Suspension_Object) is
+      Result  : STATUS;
+   begin
+      Result := semTake (S.L, WAIT_FOREVER);
+      pragma Assert (Result = OK);
+
+      S.State := False;
+
+      Result := semGive (S.L);
+      pragma Assert (Result = OK);
+   end Set_False;
+
+   --------------
+   -- Set_True --
+   --------------
+
+   procedure Set_True (S : in out Suspension_Object) is
+      Result : STATUS;
+   begin
+      Result := semTake (S.L, WAIT_FOREVER);
+      pragma Assert (Result = OK);
+
+      --  If there is already a task waiting on this suspension object then
+      --  we resume it, leaving the state of the suspension object to False,
+      --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+      --  the state to True.
+
+      if S.Waiting then
+         S.Waiting := False;
+         S.State := False;
+
+         Result := semGive (S.CV);
+         pragma Assert (Result = OK);
+      else
+         S.State := True;
+      end if;
+
+      Result := semGive (S.L);
+      pragma Assert (Result = OK);
+   end Set_True;
+
+   ------------------------
+   -- Suspend_Until_True --
+   ------------------------
+
+   procedure Suspend_Until_True (S : in out Suspension_Object) is
+      Result : STATUS;
+   begin
+      Result := semTake (S.L, WAIT_FOREVER);
+
+      if S.Waiting then
+         --  Program_Error must be raised upon calling Suspend_Until_True
+         --  if another task is already waiting on that suspension object
+         --  (ARM D.10 par. 10).
+
+         Result := semGive (S.L);
+         pragma Assert (Result = OK);
+
+         raise Program_Error;
+      else
+         --  Suspend the task if the state is False. Otherwise, the task
+         --  continues its execution, and the state of the suspension object
+         --  is set to False (ARM D.10 par. 9).
+
+         if S.State then
+            S.State := False;
+
+            Result := semGive (S.L);
+            pragma Assert (Result = 0);
+         else
+            S.Waiting := True;
+
+            --  Release the mutex before sleeping
+
+            Result := semGive (S.L);
+            pragma Assert (Result = OK);
+
+            Result := semTake (S.CV, WAIT_FOREVER);
+            pragma Assert (Result = 0);
+         end if;
+      end if;
+   end Suspend_Until_True;
+
+   ----------------
    -- Check_Exit --
    ----------------