s-osprim-mingw.adb (Timed_Delay): Use the right clock (standard one or the monotonic used by Ada.Real_Time) to...

2007-04-06  Pascal Obry  <obry@adacore.com>

	* s-osprim-mingw.adb (Timed_Delay): Use the right clock (standard one
	or the monotonic used by Ada.Real_Time) to compute the sleep duration
	on Windows.

From-SVN: r123546

3 files changed, 40 insertions, 55 deletions

diff --git a/gcc/ada/s-osinte-vxworks.adb b/gcc/ada/s-osinte-vxworks.adb
index 6cad500..dd306ad 100644
--- a/gcc/ada/s-osinte-vxworks.adb
+++ b/gcc/ada/s-osinte-vxworks.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   B o d y                                --
 --                                                                          --
---             Copyright (C) 1997-2006 Free Software Foundation             --
+--         Copyright (C) 1997-2006, 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- --
@@ -31,7 +31,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is the VxWorks version.
+--  This is the VxWorks version
 
 --  This package encapsulates all direct interfaces to OS services
 --  that are needed by children of System.
@@ -45,7 +45,7 @@ package body System.OS_Interface is
    use type Interfaces.C.int;
 
    Low_Priority : constant := 255;
-   --  VxWorks native (default) lowest scheduling priority.
+   --  VxWorks native (default) lowest scheduling priority
 
    ------------
    -- getpid --
@@ -123,12 +123,13 @@ package body System.OS_Interface is
    function To_Timespec (D : Duration) return timespec 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 is negative due to a round-up, adjust for positive F value
+
       if F < 0.0 then
          S := S - 1;
          F := F + 1.0;
@@ -151,16 +152,15 @@ package body System.OS_Interface is
    -- To_Clock_Ticks --
    --------------------
 
-   --  ??? - For now, we'll always get the system clock rate
-   --  since it is allowed to be changed during run-time in
-   --  VxWorks. A better method would be to provide an operation
-   --  to set it that so we can always know its value.
-   --
-   --  Another thing we should probably allow for is a resultant
-   --  tick count greater than int'Last. This should probably
-   --  be a procedure with two output parameters, one in the
-   --  range 0 .. int'Last, and another representing the overflow
-   --  count.
+   --  ??? - For now, we'll always get the system clock rate since it is
+   --  allowed to be changed during run-time in VxWorks. A better method would
+   --  be to provide an operation to set it that so we can always know its
+   --  value.
+
+   --  Another thing we should probably allow for is a resultant tick count
+   --  greater than int'Last. This should probably be a procedure with two
+   --  output parameters, one in the range 0 .. int'Last, and another
+   --  representing the overflow count.
 
    function To_Clock_Ticks (D : Duration) return int is
       Ticks          : Long_Long_Integer;
@@ -195,13 +195,4 @@ package body System.OS_Interface is
       return int (Ticks);
    end To_Clock_Ticks;
 
-   ----------------
-   -- VX_FP_TASK --
-   ----------------
-
-   function VX_FP_TASK return int is
-   begin
-      return 16#0008#;
-   end VX_FP_TASK;
-
 end System.OS_Interface;
diff --git a/gcc/ada/s-osinte-vxworks.ads b/gcc/ada/s-osinte-vxworks.ads
index c751152..7952ba2 100644
--- a/gcc/ada/s-osinte-vxworks.ads
+++ b/gcc/ada/s-osinte-vxworks.ads
@@ -275,9 +275,6 @@ package System.OS_Interface is
    VX_FP_PRIVATE_ENV : constant := 16#0080#;
    VX_NO_STACK_FILL  : constant := 16#0100#;
 
-   function VX_FP_TASK return int;
-   pragma Inline (VX_FP_TASK);
-
    function taskSpawn
      (name          : System.Address;  --  Pointer to task name
       priority      : int;
diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index 6874fd5..2621c60 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -263,7 +263,8 @@ package body System.Task_Primitives.Operations is
    -- Initialize_Lock --
    ---------------------
 
-   procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock) is
+   procedure Initialize_Lock
+     (Prio : System.Any_Priority; L : not null access Lock) is
    begin
       L.Mutex := semMCreate (SEM_Q_PRIORITY + SEM_INVERSION_SAFE);
       L.Prio_Ceiling := int (Prio);
@@ -271,7 +272,9 @@ package body System.Task_Primitives.Operations is
       pragma Assert (L.Mutex /= 0);
    end Initialize_Lock;
 
-   procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+   procedure Initialize_Lock
+     (L : not null access RTS_Lock; Level : Lock_Level)
+   is
       pragma Unreferenced (Level);
 
    begin
@@ -285,14 +288,14 @@ package body System.Task_Primitives.Operations is
    -- Finalize_Lock --
    -------------------
 
-   procedure Finalize_Lock (L : access Lock) is
+   procedure Finalize_Lock (L : not null access Lock) is
       Result : int;
    begin
       Result := semDelete (L.Mutex);
       pragma Assert (Result = 0);
    end Finalize_Lock;
 
-   procedure Finalize_Lock (L : access RTS_Lock) is
+   procedure Finalize_Lock (L : not null access RTS_Lock) is
       Result : int;
    begin
       Result := semDelete (L.Mutex);
@@ -303,7 +306,9 @@ package body System.Task_Primitives.Operations is
    -- Write_Lock --
    ----------------
 
-   procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+   procedure Write_Lock
+     (L : not null access Lock; Ceiling_Violation : out Boolean)
+   is
       Result : int;
    begin
       if L.Protocol = Prio_Protect
@@ -320,7 +325,7 @@ package body System.Task_Primitives.Operations is
    end Write_Lock;
 
    procedure Write_Lock
-     (L           : access RTS_Lock;
+     (L           : not null access RTS_Lock;
       Global_Lock : Boolean := False)
    is
       Result : int;
@@ -344,7 +349,8 @@ package body System.Task_Primitives.Operations is
    -- Read_Lock --
    ---------------
 
-   procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+   procedure Read_Lock
+     (L : not null access Lock; Ceiling_Violation : out Boolean) is
    begin
       Write_Lock (L, Ceiling_Violation);
    end Read_Lock;
@@ -353,14 +359,16 @@ package body System.Task_Primitives.Operations is
    -- Unlock --
    ------------
 
-   procedure Unlock (L : access Lock) is
+   procedure Unlock (L : not null access Lock) is
       Result : int;
    begin
       Result := semGive (L.Mutex);
       pragma Assert (Result = 0);
    end Unlock;
 
-   procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+   procedure Unlock
+     (L : not null access RTS_Lock; Global_Lock : Boolean := False)
+   is
       Result : int;
    begin
       if not Single_Lock or else Global_Lock then
@@ -903,12 +911,13 @@ package body System.Task_Primitives.Operations is
          Name_Address : System.Address;
          --  Task name we are going to hand down to VxWorks
 
-         Task_Options : aliased int;
-         --  VxWorks options we are going to set for the created task,
-         --  a combination of VX_optname_TASK attributes.
-
-         function To_int  is new Unchecked_Conversion (unsigned_int, int);
-         function To_uint is new Unchecked_Conversion (int, unsigned_int);
+         function Get_Task_Options return int;
+         pragma Import (C, Get_Task_Options, "__gnat_get_task_options");
+         --  Function that returns the options to be set for the task that we
+         --  are creating. We fetch the options assigned to the current task,
+         --  so offering some user level control over the options for a task
+         --  hierarchy, and force VX_FP_TASK because it is almost always
+         --  required.
 
       begin
          --  If there is no Ada task name handy, let VxWorks choose one.
@@ -923,24 +932,12 @@ package body System.Task_Primitives.Operations is
             Name_Address := Name'Address;
          end if;
 
-         --  For task options, we fetch the options assigned to the current
-         --  task, so offering some user level control over the options for a
-         --  task hierarchy, and force VX_FP_TASK because it is almost always
-         --  required.
-
-         if taskOptionsGet (taskIdSelf, Task_Options'Access) /= OK then
-            Task_Options := 0;
-         end if;
-
-         Task_Options :=
-           To_int (To_uint (Task_Options) or To_uint (VX_FP_TASK));
-
          --  Now spawn the VxWorks task for real
 
          T.Common.LL.Thread := taskSpawn
            (Name_Address,
             To_VxWorks_Priority (int (Priority)),
-            Task_Options,
+            Get_Task_Options,
             Adjusted_Stack_Size,
             Wrapper,
             To_Address (T));