with Ada.Unchecked_Conversion;
with Ada.Task_Identification;
-with Interfaces.C; use Interfaces.C;
with System.OS_Interface; use System.OS_Interface;
with System.Interrupt_Management;
with System.Task_Primitives.Operations;
with System.Tasking.Rendezvous;
pragma Elaborate_All (System.Tasking.Rendezvous);
+with System.VxWorks.Ext;
+
package body System.Interrupts is
use Tasking;
package POP renames System.Task_Primitives.Operations;
+ use type System.VxWorks.Ext.STATUS;
+ subtype STATUS is System.VxWorks.Ext.STATUS;
+ OK : constant STATUS := System.VxWorks.Ext.OK;
+
function To_Ada is new Ada.Unchecked_Conversion
(System.Tasking.Task_Id, Ada.Task_Identification.Task_Id);
type Interrupt_Connector is access function
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int;
+ Parameter : System.Address := System.Null_Address) return STATUS;
-- Profile must match VxWorks intConnect()
Interrupt_Connect : Interrupt_Connector :=
Vec : constant Interrupt_Vector :=
Interrupt_Number_To_Vector (int (Interrupt));
- Status : int;
+ Result : STATUS;
begin
-- Only install umbrella handler when no Ada handler has already been
-- number.
if not Handler_Installed (Interrupt) then
- Status :=
+ Result :=
Interrupt_Connect.all (Vec, Handler, System.Address (Interrupt));
- pragma Assert (Status = 0);
+ pragma Assert (Result = OK);
Handler_Installed (Interrupt) := True;
end if;
procedure Notify_Interrupt (Param : System.Address) is
Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
Id : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt);
- Status : int;
+ Result : STATUS;
begin
if Id /= 0 then
- Status := Binary_Semaphore_Release (Id);
- pragma Assert (Status = 0);
+ Result := Binary_Semaphore_Release (Id);
+ pragma Assert (Result = OK);
end if;
end Notify_Interrupt;
--------------------
procedure Unbind_Handler (Interrupt : Interrupt_ID) is
- Status : int;
+ Result : STATUS;
begin
-- Flush server task off semaphore, allowing it to terminate
- Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt));
- pragma Assert (Status = 0);
+ Result := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt));
+ pragma Assert (Result = OK);
end Unbind_Handler;
--------------------------------
Tmp_Handler : Parameterless_Handler;
Tmp_ID : Task_Id;
Tmp_Entry_Index : Task_Entry_Index;
- Status : int;
+ Result : STATUS;
begin
Semaphore_ID_Map (Interrupt) := Int_Sema;
-- Pend on semaphore that will be triggered by the umbrella handler
-- when the associated interrupt comes in.
- Status := Binary_Semaphore_Obtain (Int_Sema);
- pragma Assert (Status = 0);
+ Result := Binary_Semaphore_Obtain (Int_Sema);
+ pragma Assert (Result = OK);
if User_Handler (Interrupt).H /= null then
-- Delete the associated semaphore
- Status := Binary_Semaphore_Delete (Int_Sema);
+ Result := Binary_Semaphore_Delete (Int_Sema);
- pragma Assert (Status = 0);
+ pragma Assert (Result = OK);
-- Set status for the Interrupt_Manager
Ticks : Long_Long_Integer;
Rate_Duration : Duration;
Ticks_Duration : Duration;
+ IERR : constant int := -1;
begin
if D < 0.0 then
- return ERROR;
+ return IERR;
end if;
-- Ensure that the duration can be converted to ticks
-- Binary_Semaphore_Delete --
-----------------------------
- function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int is
+ function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id)
+ return STATUS is
begin
return semDelete (SEM_ID (ID));
end Binary_Semaphore_Delete;
-- Binary_Semaphore_Obtain --
-----------------------------
- function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int is
+ function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id)
+ return STATUS is
begin
return semTake (SEM_ID (ID), WAIT_FOREVER);
end Binary_Semaphore_Obtain;
-- Binary_Semaphore_Release --
------------------------------
- function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int is
+ function Binary_Semaphore_Release (ID : Binary_Semaphore_Id)
+ return STATUS is
begin
return semGive (SEM_ID (ID));
end Binary_Semaphore_Release;
-- Binary_Semaphore_Flush --
----------------------------
- function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int is
+ function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return STATUS is
begin
return semFlush (SEM_ID (ID));
end Binary_Semaphore_Flush;
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int is
+ Parameter : System.Address := System.Null_Address) return STATUS is
begin
return
System.VxWorks.Ext.Interrupt_Connect
package System.OS_Interface is
pragma Preelaborate;
+ package SVE renames System.VxWorks.Ext;
+
subtype int is Interfaces.C.int;
subtype unsigned is Interfaces.C.unsigned;
subtype short is Short_Integer;
type unsigned_long_long is mod 2 ** long_long'Size;
type size_t is mod 2 ** Standard'Address_Size;
- subtype BOOL is System.VxWorks.Ext.BOOL;
- subtype vx_freq_t is System.VxWorks.Ext.vx_freq_t;
+ subtype STATUS is SVE.STATUS;
+ subtype BOOL is SVE.BOOL;
+ subtype vx_freq_t is SVE.vx_freq_t;
-----------
-- Errno --
oset : access sigset_t) return int;
pragma Import (C, pthread_sigmask, "sigprocmask");
- subtype t_id is System.VxWorks.Ext.t_id;
+ subtype t_id is SVE.t_id;
subtype Thread_Id is t_id;
-- Thread_Id and t_id are VxWorks identifiers for tasks. This value,
-- although represented as a Long_Integer, is in fact an address. With
function kill (pid : t_id; sig : Signal) return int;
pragma Inline (kill);
- function getpid return t_id renames System.VxWorks.Ext.getpid;
+ function getpid return t_id renames SVE.getpid;
- function Task_Stop (tid : t_id) return int
- renames System.VxWorks.Ext.Task_Stop;
+ function Task_Stop (tid : t_id) return STATUS renames SVE.Task_Stop;
-- If we are in the kernel space, stop the task whose t_id is given in
-- parameter in such a way that it can be examined by the debugger. This
-- typically maps to taskSuspend on VxWorks 5 and to taskStop on VxWorks 6.
- function Task_Cont (tid : t_id) return int
- renames System.VxWorks.Ext.Task_Cont;
+ function Task_Cont (tid : t_id) return STATUS renames SVE.Task_Cont;
-- If we are in the kernel space, continue the task whose t_id is given
-- in parameter if it has been stopped previously to be examined by the
-- debugger (e.g. by taskStop). It typically maps to taskResume on VxWorks
-- 5 and to taskCont on VxWorks 6.
- function Int_Lock return int renames System.VxWorks.Ext.Int_Lock;
+ function Int_Lock return int renames SVE.Int_Lock;
-- If we are in the kernel space, lock interrupts. It typically maps to
-- intLock.
- procedure Int_Unlock (Old : int) renames System.VxWorks.Ext.Int_Unlock;
+ procedure Int_Unlock (Old : int) renames SVE.Int_Unlock;
-- If we are in the kernel space, unlock interrupts. It typically maps to
-- intUnlock. The parameter Old is only used on PowerPC where it contains
-- the returned value from Int_Lock (the old MPSR).
-- VxWorks specific API --
--------------------------
- subtype STATUS is int;
- -- Equivalent of the C type STATUS
-
- OK : constant STATUS := 0;
- ERROR : constant STATUS := Interfaces.C.int (-1);
-
function taskIdVerify (tid : t_id) return STATUS;
pragma Import (C, taskIdVerify, "taskIdVerify");
function taskIdSelf return t_id;
pragma Import (C, taskIdSelf, "taskIdSelf");
- function taskOptionsGet (tid : t_id; pOptions : access int) return int;
+ function taskOptionsGet (tid : t_id; pOptions : access int) return STATUS;
pragma Import (C, taskOptionsGet, "taskOptionsGet");
- function taskSuspend (tid : t_id) return int;
+ function taskSuspend (tid : t_id) return STATUS;
pragma Import (C, taskSuspend, "taskSuspend");
- function taskResume (tid : t_id) return int;
+ function taskResume (tid : t_id) return STATUS;
pragma Import (C, taskResume, "taskResume");
function taskIsSuspended (tid : t_id) return BOOL;
pragma Import (C, taskIsSuspended, "taskIsSuspended");
- function taskDelay (ticks : int) return int;
+ function taskDelay (ticks : int) return STATUS;
pragma Import (C, taskDelay, "taskDelay");
function sysClkRateGet return vx_freq_t;
-- taskVarLib: eg VxWorks 6 RTPs
function taskVarAdd
- (tid : t_id; pVar : access System.Address) return int;
+ (tid : t_id; pVar : access System.Address) return STATUS;
pragma Import (C, taskVarAdd, "taskVarAdd");
function taskVarDelete
- (tid : t_id; pVar : access System.Address) return int;
+ (tid : t_id; pVar : access System.Address) return STATUS;
pragma Import (C, taskVarDelete, "taskVarDelete");
function taskVarSet
(tid : t_id;
pVar : access System.Address;
- value : System.Address) return int;
+ value : System.Address) return STATUS;
pragma Import (C, taskVarSet, "taskVarSet");
function taskVarGet
-- Can only be called from the VxWorks 6 run-time libary that supports
-- tlsLib, and not by the VxWorks 6.6 SMP library
- function tlsKeyCreate return int;
+ function tlsKeyCreate return STATUS;
pragma Import (C, tlsKeyCreate, "tlsKeyCreate");
function tlsValueGet (key : int) return System.Address;
procedure taskDelete (tid : t_id);
pragma Import (C, taskDelete, "taskDelete");
- function Set_Time_Slice (ticks : int) return int
- renames System.VxWorks.Ext.Set_Time_Slice;
+ function Set_Time_Slice (ticks : int) return STATUS renames
+ SVE.Set_Time_Slice;
-- Calls kernelTimeSlice under VxWorks 5.x, VxWorks 653, or in VxWorks 6
-- kernel apps. Returns ERROR for RTPs, VxWorks 5 /CERT
- function taskPriorityGet (tid : t_id; pPriority : access int) return int;
+ function taskPriorityGet (tid : t_id; pPriority : access int) return STATUS;
pragma Import (C, taskPriorityGet, "taskPriorityGet");
- function taskPrioritySet (tid : t_id; newPriority : int) return int;
+ function taskPrioritySet (tid : t_id; newPriority : int) return STATUS;
pragma Import (C, taskPrioritySet, "taskPrioritySet");
-- Semaphore creation flags
-- semTake() timeout with ticks > NO_WAIT
S_objLib_OBJ_TIMEOUT : constant := M_objLib + 4;
- subtype SEM_ID is System.VxWorks.Ext.SEM_ID;
+ subtype SEM_ID is SVE.SEM_ID;
-- typedef struct semaphore *SEM_ID;
-- We use two different kinds of VxWorks semaphores: mutex and binary
function semMCreate (options : int) return SEM_ID;
pragma Import (C, semMCreate, "semMCreate");
- function semDelete (Sem : SEM_ID) return int
- renames System.VxWorks.Ext.semDelete;
+ function semDelete (Sem : SEM_ID) return STATUS renames SVE.semDelete;
-- Delete a semaphore
- function semGive (Sem : SEM_ID) return int;
+ function semGive (Sem : SEM_ID) return STATUS;
pragma Import (C, semGive, "semGive");
- function semTake (Sem : SEM_ID; timeout : int) return int;
+ function semTake (Sem : SEM_ID; timeout : int) return STATUS;
pragma Import (C, semTake, "semTake");
-- Attempt to take binary semaphore. Error is returned if operation
-- times out
function Binary_Semaphore_Create return Binary_Semaphore_Id;
pragma Inline (Binary_Semaphore_Create);
- function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int;
+ function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return STATUS;
pragma Inline (Binary_Semaphore_Delete);
- function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int;
+ function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return STATUS;
pragma Inline (Binary_Semaphore_Obtain);
- function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int;
+ function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return STATUS;
pragma Inline (Binary_Semaphore_Release);
- function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int;
+ function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return STATUS;
pragma Inline (Binary_Semaphore_Flush);
------------------------------------------------------------
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int;
+ Parameter : System.Address := System.Null_Address) return STATUS;
pragma Inline (Interrupt_Connect);
-- Use this to set up an user handler. The routine installs a user handler
-- which is invoked after the OS has saved enough context for a high-level
--------------------------------
function taskCpuAffinitySet (tid : t_id; CPU : int) return int
- renames System.VxWorks.Ext.taskCpuAffinitySet;
+ renames SVE.taskCpuAffinitySet;
-- For SMP run-times the affinity to CPU.
-- For uniprocessor systems return ERROR status.
function taskMaskAffinitySet (tid : t_id; CPU_Set : unsigned) return int
- renames System.VxWorks.Ext.taskMaskAffinitySet;
+ renames SVE.taskMaskAffinitySet;
-- For SMP run-times the affinity to CPU_Set.
-- For uniprocessor systems return ERROR status.
ERROR_PID : constant pid_t := -1;
- type sigset_t is new System.VxWorks.Ext.sigset_t;
+ type sigset_t is new SVE.sigset_t;
end System.OS_Interface;
use type Interfaces.C.int;
use type System.OS_Interface.unsigned;
use type System.VxWorks.Ext.t_id;
+ use type System.VxWorks.Ext.STATUS;
use type System.VxWorks.Ext.BOOL;
- subtype int is System.OS_Interface.int;
+ subtype int is System.OS_Interface.int;
subtype unsigned is System.OS_Interface.unsigned;
+ subtype STATUS is System.VxWorks.Ext.STATUS;
+
+ OK : constant STATUS := System.VxWorks.Ext.OK;
Relative : constant := 0;
-------------------
procedure Finalize_Lock (L : not null access Lock) is
- Result : int;
+ Result : STATUS;
begin
Result := semDelete (L.Mutex);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
- Result : int;
+ Result : STATUS;
begin
Result := semDelete (L.Mutex);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Finalize_Lock;
----------------
(L : not null access Lock;
Ceiling_Violation : out Boolean)
is
- Result : int;
+ Result : STATUS;
begin
if L.Protocol = Prio_Protect
end if;
Result := semTake (L.Mutex, WAIT_FOREVER);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Write_Lock;
procedure Write_Lock (L : not null access RTS_Lock) is
- Result : int;
+ Result : STATUS;
begin
Result := semTake (L.Mutex, WAIT_FOREVER);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Write_Lock;
procedure Write_Lock (T : Task_Id) is
- Result : int;
+ Result : STATUS;
begin
Result := semTake (T.Common.LL.L.Mutex, WAIT_FOREVER);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Write_Lock;
---------------
------------
procedure Unlock (L : not null access Lock) is
- Result : int;
+ Result : STATUS;
begin
Result := semGive (L.Mutex);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Unlock;
procedure Unlock (L : not null access RTS_Lock) is
- Result : int;
+ Result : STATUS;
begin
Result := semGive (L.Mutex);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Unlock;
procedure Unlock (T : Task_Id) is
- Result : int;
+ Result : STATUS;
begin
Result := semGive (T.Common.LL.L.Mutex);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Unlock;
-----------------
procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is
pragma Unreferenced (Reason);
- Result : int;
+ Result : STATUS;
begin
pragma Assert (Self_ID = Self);
-- Release the mutex before sleeping
Result := semGive (Self_ID.Common.LL.L.Mutex);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
-- Perform a blocking operation to take the CV semaphore. Note that a
-- blocking operation in VxWorks will reenable task scheduling. When we
-- again be disabled.
Result := semTake (Self_ID.Common.LL.CV, WAIT_FOREVER);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
-- Take the mutex back
Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Sleep;
-----------------
Orig : constant Duration := Monotonic_Clock;
Absolute : Duration;
Ticks : int;
- Result : int;
+ Result : STATUS;
Wakeup : Boolean := False;
begin
-- Release the mutex before sleeping
Result := semGive (Self_ID.Common.LL.L.Mutex);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
-- Perform a blocking operation to take the CV semaphore. Note
-- that a blocking operation in VxWorks will reenable task
Result := semTake (Self_ID.Common.LL.CV, Ticks);
- if Result = 0 then
+ if Result = OK then
-- Somebody may have called Wakeup for us
-- Take the mutex back
Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
exit when Timedout or Wakeup;
end loop;
Timedout : Boolean;
Aborted : Boolean := False;
- Result : int;
+ Result : STATUS;
pragma Warnings (Off, Result);
begin
Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
Self_ID.Common.State := Delay_Sleep;
Timedout := False;
-- Release the TCB before sleeping
Result := semGive (Self_ID.Common.LL.L.Mutex);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
exit when Aborted;
Result := semTake (Self_ID.Common.LL.CV, Ticks);
- if Result /= 0 then
+ if Result /= OK then
-- If Ticks = int'last, it was most probably truncated, so make
-- another round after recomputing Ticks from absolute time.
Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
exit when Timedout;
end loop;
procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
pragma Unreferenced (Reason);
- Result : int;
+ Result : STATUS;
begin
Result := semGive (T.Common.LL.CV);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
end Wakeup;
-----------
procedure Yield (Do_Yield : Boolean := True) is
pragma Unreferenced (Do_Yield);
- Result : int;
+ Result : STATUS;
pragma Unreferenced (Result);
begin
Result := taskDelay (0);
is
pragma Unreferenced (Loss_Of_Inheritance);
- Result : int;
+ Result : STATUS;
begin
Result :=
taskPrioritySet
(T.Common.LL.Thread, To_VxWorks_Priority (int (Prio)));
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
-- Note: in VxWorks 6.6 (or earlier), the task is placed at the end of
-- the priority queue instead of the head. This is not the behavior
------------------
procedure Finalize_TCB (T : Task_Id) is
- Result : int;
+ Result : STATUS;
begin
Result := semDelete (T.Common.LL.L.Mutex);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
T.Common.LL.Thread := Null_Thread_Id;
Result := semDelete (T.Common.LL.CV);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
if T.Known_Tasks_Index /= -1 then
Known_Tasks (T.Known_Tasks_Index) := null;
S.State := False;
Result := semGive (S.L);
- pragma Assert (Result = 0);
+ pragma Assert (Result = OK);
SSL.Abort_Undefer.all;
if T.Common.LL.Thread /= Null_Thread_Id
and then T.Common.LL.Thread /= Thread_Self
then
- return taskSuspend (T.Common.LL.Thread) = 0;
+ return taskSuspend (T.Common.LL.Thread) = OK;
else
return True;
end if;
if T.Common.LL.Thread /= Null_Thread_Id
and then T.Common.LL.Thread /= Thread_Self
then
- return taskResume (T.Common.LL.Thread) = 0;
+ return taskResume (T.Common.LL.Thread) = OK;
else
return True;
end if;
Thread_Self : constant Thread_Id := taskIdSelf;
C : Task_Id;
- Dummy : int;
+ Dummy : STATUS;
Old : int;
begin
function Stop_Task (T : ST.Task_Id) return Boolean is
begin
if T.Common.LL.Thread /= Null_Thread_Id then
- return Task_Stop (T.Common.LL.Thread) = 0;
+ return Task_Stop (T.Common.LL.Thread) = OK;
else
return True;
end if;
is
begin
if T.Common.LL.Thread /= Null_Thread_Id then
- return Task_Cont (T.Common.LL.Thread) = 0;
+ return Task_Cont (T.Common.LL.Thread) = OK;
else
return True;
end if;
function Is_Task_Context return Boolean is
begin
- return System.OS_Interface.Interrupt_Context = 0;
+ return OSI.Interrupt_Context = 0;
end Is_Task_Context;
----------------
----------------
procedure Initialize (Environment_Task : Task_Id) is
- Result : int;
+ Result : STATUS;
pragma Unreferenced (Result);
begin
package body System.VxWorks.Ext is
- ERROR : constant := -1;
+ IERR : constant := -1;
------------------------
-- taskCpuAffinitySet --
function taskCpuAffinitySet (tid : t_id; CPU : int) return int is
pragma Unreferenced (tid, CPU);
begin
- return ERROR;
+ return IERR;
end taskCpuAffinitySet;
-------------------------
function taskMaskAffinitySet (tid : t_id; CPU_Set : unsigned) return int is
pragma Unreferenced (tid, CPU_Set);
begin
- return ERROR;
+ return IERR;
end taskMaskAffinitySet;
end System.VxWorks.Ext;
subtype int is Interfaces.C.int;
subtype unsigned is Interfaces.C.unsigned;
+ type STATUS is new int;
+ -- Equivalent of the C type STATUS
+
+ OK : constant STATUS := 0;
+ ERROR : constant STATUS := -1;
+
type BOOL is new int;
-- Equivalent of the C type BOOL
package body System.VxWorks.Ext is
- ERROR : constant := -1;
+ IERR : constant := -1;
--------------
-- Int_Lock --
function Int_Lock return int is
begin
- return ERROR;
+ return IERR;
end Int_Lock;
----------------
-- semDelete --
---------------
- function semDelete (Sem : SEM_ID) return int is
- function Os_Sem_Delete (Sem : SEM_ID) return int;
+ function semDelete (Sem : SEM_ID) return STATUS is
+ function Os_Sem_Delete (Sem : SEM_ID) return STATUS;
pragma Import (C, Os_Sem_Delete, "semDelete");
begin
return Os_Sem_Delete (Sem);
-- Task_Cont --
---------------
- function Task_Cont (tid : t_id) return int is
- function taskCont (tid : t_id) return int;
+ function Task_Cont (tid : t_id) return STATUS is
+ function taskCont (tid : t_id) return STATUS;
pragma Import (C, taskCont, "taskCont");
begin
return taskCont (tid);
-- Task_Stop --
---------------
- function Task_Stop (tid : t_id) return int is
- function taskStop (tid : t_id) return int;
+ function Task_Stop (tid : t_id) return STATUS is
+ function taskStop (tid : t_id) return STATUS;
pragma Import (C, taskStop, "taskStop");
begin
return taskStop (tid);
package body System.VxWorks.Ext is
- ERROR : constant := -1;
+ IERR : constant := -1;
--------------
-- Int_Lock --
-- semDelete --
---------------
- function semDelete (Sem : SEM_ID) return int is
+ function semDelete (Sem : SEM_ID) return STATUS is
function Os_Sem_Delete (Sem : SEM_ID) return int;
pragma Import (C, Os_Sem_Delete, "semDelete");
begin
function taskCpuAffinitySet (tid : t_id; CPU : int) return int is
pragma Unreferenced (tid, CPU);
begin
- return ERROR;
+ return IERR;
end taskCpuAffinitySet;
-------------------------
function taskMaskAffinitySet (tid : t_id; CPU_Set : unsigned) return int is
pragma Unreferenced (tid, CPU_Set);
begin
- return ERROR;
+ return IERR;
end taskMaskAffinitySet;
---------------
-- Task_Cont --
---------------
- function Task_Cont (tid : t_id) return int is
- function taskCont (tid : t_id) return int;
+ function Task_Cont (tid : t_id) return STATUS is
+ function taskCont (tid : t_id) return STATUS;
pragma Import (C, taskCont, "taskCont");
begin
return taskCont (tid);
-- Task_Stop --
---------------
- function Task_Stop (tid : t_id) return int is
- function taskStop (tid : t_id) return int;
+ function Task_Stop (tid : t_id) return STATUS is
+ function taskStop (tid : t_id) return STATUS;
pragma Import (C, taskStop, "taskStop");
begin
return taskStop (tid);
subtype int is Interfaces.C.int;
subtype unsigned is Interfaces.C.unsigned;
+ type STATUS is new int;
+ -- Equivalent of the C type STATUS
+
+ OK : constant STATUS := 0;
+ ERROR : constant STATUS := -1;
+
type BOOL is new int;
-- Equivalent of the C type BOOL
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int;
+ Parameter : System.Address := System.Null_Address) return STATUS;
pragma Import (C, Interrupt_Connect, "intConnect");
function Interrupt_Context return BOOL;
(intNum : int) return Interrupt_Vector;
pragma Import (C, Interrupt_Number_To_Vector, "__gnat_inum_to_ivec");
- function semDelete (Sem : SEM_ID) return int;
+ function semDelete (Sem : SEM_ID) return STATUS;
pragma Convention (C, semDelete);
- function Task_Cont (tid : t_id) return int;
+ function Task_Cont (tid : t_id) return STATUS;
pragma Convention (C, Task_Cont);
- function Task_Stop (tid : t_id) return int;
+ function Task_Stop (tid : t_id) return STATUS;
pragma Convention (C, Task_Stop);
function kill (pid : t_id; sig : int) return int;
function getpid return t_id;
pragma Import (C, getpid, "taskIdSelf");
- function Set_Time_Slice (ticks : int) return int;
+ function Set_Time_Slice (ticks : int) return STATUS;
pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
type UINT64 is mod 2 ** Long_Long_Integer'Size;
package body System.VxWorks.Ext is
- ERROR : constant := -1;
+ IERR : constant := -1;
--------------
-- Int_Lock --
function Int_Lock return int is
begin
- return ERROR;
+ return IERR;
end Int_Lock;
----------------
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int
+ Parameter : System.Address := System.Null_Address) return STATUS
is
pragma Unreferenced (Vector, Handler, Parameter);
begin
-- semDelete --
---------------
- function semDelete (Sem : SEM_ID) return int is
- function OS_semDelete (Sem : SEM_ID) return int;
+ function semDelete (Sem : SEM_ID) return STATUS is
+ function OS_semDelete (Sem : SEM_ID) return STATUS;
pragma Import (C, OS_semDelete, "semDelete");
begin
return OS_semDelete (Sem);
-- Set_Time_Slice --
--------------------
- function Set_Time_Slice (ticks : int) return int is
+ function Set_Time_Slice (ticks : int) return STATUS is
pragma Unreferenced (ticks);
begin
return ERROR;
package body System.VxWorks.Ext is
- ERROR : constant := -1;
+ IERR : constant := -1;
--------------
-- Int_Lock --
function Int_Lock return int is
begin
- return ERROR;
+ return IERR;
end Int_Lock;
----------------
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int
+ Parameter : System.Address := System.Null_Address) return STATUS
is
pragma Unreferenced (Vector, Handler, Parameter);
begin
-- semDelete --
---------------
- function semDelete (Sem : SEM_ID) return int is
- function OS_semDelete (Sem : SEM_ID) return int;
+ function semDelete (Sem : SEM_ID) return STATUS is
+ function OS_semDelete (Sem : SEM_ID) return STATUS;
pragma Import (C, OS_semDelete, "semDelete");
begin
return OS_semDelete (Sem);
-- Set_Time_Slice --
--------------------
- function Set_Time_Slice (ticks : int) return int is
+ function Set_Time_Slice (ticks : int) return STATUS is
pragma Unreferenced (ticks);
begin
return ERROR;
function taskCpuAffinitySet (tid : t_id; CPU : int) return int is
pragma Unreferenced (tid, CPU);
begin
- return ERROR;
+ return IERR;
end taskCpuAffinitySet;
-------------------------
function taskMaskAffinitySet (tid : t_id; CPU_Set : unsigned) return int is
pragma Unreferenced (tid, CPU_Set);
begin
- return ERROR;
+ return IERR;
end taskMaskAffinitySet;
end System.VxWorks.Ext;
subtype int is Interfaces.C.int;
subtype unsigned is Interfaces.C.unsigned;
+ type STATUS is new int;
+ -- Equivalent of the C type STATUS
+
+ OK : constant STATUS := 0;
+ ERROR : constant STATUS := -1;
+
type BOOL is new int;
-- Equivalent of the C type BOOL
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int;
+ Parameter : System.Address := System.Null_Address) return STATUS;
pragma Convention (C, Interrupt_Connect);
function Interrupt_Context return BOOL;
(intNum : int) return Interrupt_Vector;
pragma Convention (C, Interrupt_Number_To_Vector);
- function semDelete (Sem : SEM_ID) return int;
+ function semDelete (Sem : SEM_ID) return STATUS;
pragma Convention (C, semDelete);
- function Task_Cont (tid : t_id) return int;
+ function Task_Cont (tid : t_id) return STATUS;
pragma Import (C, Task_Cont, "taskResume");
- function Task_Stop (tid : t_id) return int;
+ function Task_Stop (tid : t_id) return STATUS;
pragma Import (C, Task_Stop, "taskSuspend");
function kill (pid : t_id; sig : int) return int;
function getpid return t_id;
pragma Import (C, getpid, "getpid");
- function Set_Time_Slice (ticks : int) return int;
+ function Set_Time_Slice (ticks : int) return STATUS;
pragma Inline (Set_Time_Slice);
--------------------------------
projects / thirdparty / gcc.git / commitdiff
