-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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.
use type Interfaces.C.int;
Low_Priority : constant := 255;
- -- VxWorks native (default) lowest scheduling priority.
+ -- VxWorks native (default) lowest scheduling priority
------------
-- getpid --
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;
-- 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;
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;
-- 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);
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
-- 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);
-- 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
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock;
+ (L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
Result : int;
-- 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;
-- 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
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.
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));
projects / platform / upstream / gcc.git / commitdiff