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 --
    ----------------