From: Pascal Obry Date: Fri, 6 Apr 2007 09:15:56 +0000 (+0200) Subject: s-osprim-mingw.adb (Timed_Delay): Use the right clock (standard one or the monotonic... X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=2c851ddd1c40ec8c1adf8e92ce830e5e22b4a267;p=platform%2Fupstream%2Fgcc.git 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 * 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 --- 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));