diff options
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/libgnarl/s-interr__vxworks.adb | 37 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__vxworks.adb | 16 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__vxworks.ads | 76 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-taprop__vxworks.adb | 96 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-vxwext.adb | 6 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-vxwext.ads | 6 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-vxwext__kernel-smp.adb | 16 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-vxwext__kernel.adb | 16 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-vxwext__kernel.ads | 16 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-vxwext__rtp-smp.adb | 12 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-vxwext__rtp.adb | 16 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-vxwext__rtp.ads | 16 |
12 files changed, 177 insertions, 152 deletions
diff --git a/gcc/ada/libgnarl/s-interr__vxworks.adb b/gcc/ada/libgnarl/s-interr__vxworks.adb index d496b74..db2ca95 100644 --- a/gcc/ada/libgnarl/s-interr__vxworks.adb +++ b/gcc/ada/libgnarl/s-interr__vxworks.adb @@ -66,7 +66,6 @@ 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; @@ -76,12 +75,18 @@ with System.Tasking.Utilities; 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); @@ -199,7 +204,7 @@ package body System.Interrupts is 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 := @@ -515,7 +520,7 @@ package body System.Interrupts is 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 @@ -525,9 +530,9 @@ package body System.Interrupts is -- 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; @@ -646,11 +651,11 @@ package body System.Interrupts is 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; @@ -787,13 +792,13 @@ package body System.Interrupts is -------------------- 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; -------------------------------- @@ -1067,7 +1072,7 @@ package body System.Interrupts is 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; @@ -1076,8 +1081,8 @@ package body System.Interrupts is -- 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 @@ -1109,9 +1114,9 @@ package body System.Interrupts is -- 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 diff --git a/gcc/ada/libgnarl/s-osinte__vxworks.adb b/gcc/ada/libgnarl/s-osinte__vxworks.adb index 677cd60..fbc8367 100644 --- a/gcc/ada/libgnarl/s-osinte__vxworks.adb +++ b/gcc/ada/libgnarl/s-osinte__vxworks.adb @@ -100,10 +100,11 @@ package body System.OS_Interface is 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 @@ -142,7 +143,8 @@ package body System.OS_Interface is -- 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; @@ -151,7 +153,8 @@ package body System.OS_Interface is -- 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; @@ -160,7 +163,8 @@ package body System.OS_Interface is -- 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; @@ -169,7 +173,7 @@ package body System.OS_Interface is -- 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; @@ -190,7 +194,7 @@ package body System.OS_Interface is 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 diff --git a/gcc/ada/libgnarl/s-osinte__vxworks.ads b/gcc/ada/libgnarl/s-osinte__vxworks.ads index d4ed479..a63b922 100644 --- a/gcc/ada/libgnarl/s-osinte__vxworks.ads +++ b/gcc/ada/libgnarl/s-osinte__vxworks.ads @@ -47,6 +47,8 @@ with System.Parameters; 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; @@ -57,8 +59,9 @@ package System.OS_Interface is 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 -- @@ -204,7 +207,7 @@ package System.OS_Interface is 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 @@ -214,26 +217,24 @@ package System.OS_Interface is 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). @@ -287,31 +288,25 @@ package System.OS_Interface is -- 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; @@ -322,17 +317,17 @@ package System.OS_Interface is -- 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 @@ -345,7 +340,7 @@ package System.OS_Interface is -- 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; @@ -381,15 +376,15 @@ package System.OS_Interface is 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 @@ -421,7 +416,7 @@ package System.OS_Interface is -- 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 @@ -435,14 +430,13 @@ package System.OS_Interface is 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 @@ -460,16 +454,16 @@ package System.OS_Interface is 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); ------------------------------------------------------------ @@ -484,7 +478,7 @@ package System.OS_Interface is 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 @@ -505,12 +499,12 @@ package System.OS_Interface is -------------------------------- 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. @@ -526,5 +520,5 @@ private 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; diff --git a/gcc/ada/libgnarl/s-taprop__vxworks.adb b/gcc/ada/libgnarl/s-taprop__vxworks.adb index f668712..273aca8 100644 --- a/gcc/ada/libgnarl/s-taprop__vxworks.adb +++ b/gcc/ada/libgnarl/s-taprop__vxworks.adb @@ -65,10 +65,14 @@ package body System.Task_Primitives.Operations is 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; @@ -334,17 +338,17 @@ package body System.Task_Primitives.Operations is ------------------- 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; ---------------- @@ -355,7 +359,7 @@ package body System.Task_Primitives.Operations is (L : not null access Lock; Ceiling_Violation : out Boolean) is - Result : int; + Result : STATUS; begin if L.Protocol = Prio_Protect @@ -368,21 +372,21 @@ package body System.Task_Primitives.Operations is 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; --------------- @@ -401,24 +405,24 @@ package body System.Task_Primitives.Operations is ------------ 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; ----------------- @@ -443,7 +447,7 @@ package body System.Task_Primitives.Operations is 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); @@ -451,7 +455,7 @@ package body System.Task_Primitives.Operations is -- 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 @@ -459,12 +463,12 @@ package body System.Task_Primitives.Operations is -- 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; ----------------- @@ -487,7 +491,7 @@ package body System.Task_Primitives.Operations is Orig : constant Duration := Monotonic_Clock; Absolute : Duration; Ticks : int; - Result : int; + Result : STATUS; Wakeup : Boolean := False; begin @@ -517,7 +521,7 @@ package body System.Task_Primitives.Operations is -- 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 @@ -526,7 +530,7 @@ package body System.Task_Primitives.Operations is Result := semTake (Self_ID.Common.LL.CV, Ticks); - if Result = 0 then + if Result = OK then -- Somebody may have called Wakeup for us @@ -557,7 +561,7 @@ package body System.Task_Primitives.Operations is -- 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; @@ -591,7 +595,7 @@ package body System.Task_Primitives.Operations is Timedout : Boolean; Aborted : Boolean := False; - Result : int; + Result : STATUS; pragma Warnings (Off, Result); begin @@ -618,7 +622,7 @@ package body System.Task_Primitives.Operations is 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; @@ -629,13 +633,13 @@ package body System.Task_Primitives.Operations is -- 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. @@ -656,7 +660,7 @@ package body System.Task_Primitives.Operations is Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER); - pragma Assert (Result = 0); + pragma Assert (Result = OK); exit when Timedout; end loop; @@ -698,10 +702,10 @@ package body System.Task_Primitives.Operations is 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; ----------- @@ -710,7 +714,7 @@ package body System.Task_Primitives.Operations is procedure Yield (Do_Yield : Boolean := True) is pragma Unreferenced (Do_Yield); - Result : int; + Result : STATUS; pragma Unreferenced (Result); begin Result := taskDelay (0); @@ -727,13 +731,13 @@ package body System.Task_Primitives.Operations is 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 @@ -939,16 +943,16 @@ package body System.Task_Primitives.Operations is ------------------ 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; @@ -1138,7 +1142,7 @@ package body System.Task_Primitives.Operations is S.State := False; Result := semGive (S.L); - pragma Assert (Result = 0); + pragma Assert (Result = OK); SSL.Abort_Undefer.all; @@ -1219,7 +1223,7 @@ package body System.Task_Primitives.Operations is 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; @@ -1237,7 +1241,7 @@ package body System.Task_Primitives.Operations is 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; @@ -1252,7 +1256,7 @@ package body System.Task_Primitives.Operations is Thread_Self : constant Thread_Id := taskIdSelf; C : Task_Id; - Dummy : int; + Dummy : STATUS; Old : int; begin @@ -1279,7 +1283,7 @@ package body System.Task_Primitives.Operations is 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; @@ -1293,7 +1297,7 @@ package body System.Task_Primitives.Operations is 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; @@ -1305,7 +1309,7 @@ package body System.Task_Primitives.Operations is function Is_Task_Context return Boolean is begin - return System.OS_Interface.Interrupt_Context = 0; + return OSI.Interrupt_Context = 0; end Is_Task_Context; ---------------- @@ -1313,7 +1317,7 @@ package body System.Task_Primitives.Operations is ---------------- procedure Initialize (Environment_Task : Task_Id) is - Result : int; + Result : STATUS; pragma Unreferenced (Result); begin diff --git a/gcc/ada/libgnarl/s-vxwext.adb b/gcc/ada/libgnarl/s-vxwext.adb index 0e1a792..d50d93d 100644 --- a/gcc/ada/libgnarl/s-vxwext.adb +++ b/gcc/ada/libgnarl/s-vxwext.adb @@ -30,7 +30,7 @@ package body System.VxWorks.Ext is - ERROR : constant := -1; + IERR : constant := -1; ------------------------ -- taskCpuAffinitySet -- @@ -39,7 +39,7 @@ package body System.VxWorks.Ext is function taskCpuAffinitySet (tid : t_id; CPU : int) return int is pragma Unreferenced (tid, CPU); begin - return ERROR; + return IERR; end taskCpuAffinitySet; ------------------------- @@ -49,7 +49,7 @@ package body System.VxWorks.Ext is 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; diff --git a/gcc/ada/libgnarl/s-vxwext.ads b/gcc/ada/libgnarl/s-vxwext.ads index 15a5683..ab73415 100644 --- a/gcc/ada/libgnarl/s-vxwext.ads +++ b/gcc/ada/libgnarl/s-vxwext.ads @@ -46,6 +46,12 @@ package System.VxWorks.Ext is 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 diff --git a/gcc/ada/libgnarl/s-vxwext__kernel-smp.adb b/gcc/ada/libgnarl/s-vxwext__kernel-smp.adb index 8c91c45..b78e078 100644 --- a/gcc/ada/libgnarl/s-vxwext__kernel-smp.adb +++ b/gcc/ada/libgnarl/s-vxwext__kernel-smp.adb @@ -33,7 +33,7 @@ package body System.VxWorks.Ext is - ERROR : constant := -1; + IERR : constant := -1; -------------- -- Int_Lock -- @@ -41,7 +41,7 @@ package body System.VxWorks.Ext is function Int_Lock return int is begin - return ERROR; + return IERR; end Int_Lock; ---------------- @@ -58,8 +58,8 @@ package body System.VxWorks.Ext is -- 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); @@ -92,8 +92,8 @@ package body System.VxWorks.Ext is -- 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); @@ -103,8 +103,8 @@ package body System.VxWorks.Ext is -- 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); diff --git a/gcc/ada/libgnarl/s-vxwext__kernel.adb b/gcc/ada/libgnarl/s-vxwext__kernel.adb index 7d3cc8d..b3b7f54 100644 --- a/gcc/ada/libgnarl/s-vxwext__kernel.adb +++ b/gcc/ada/libgnarl/s-vxwext__kernel.adb @@ -34,7 +34,7 @@ package body System.VxWorks.Ext is - ERROR : constant := -1; + IERR : constant := -1; -------------- -- Int_Lock -- @@ -58,7 +58,7 @@ package body System.VxWorks.Ext is -- 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 @@ -72,7 +72,7 @@ package body System.VxWorks.Ext is function taskCpuAffinitySet (tid : t_id; CPU : int) return int is pragma Unreferenced (tid, CPU); begin - return ERROR; + return IERR; end taskCpuAffinitySet; ------------------------- @@ -82,15 +82,15 @@ package body System.VxWorks.Ext is 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); @@ -100,8 +100,8 @@ package body System.VxWorks.Ext is -- 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); diff --git a/gcc/ada/libgnarl/s-vxwext__kernel.ads b/gcc/ada/libgnarl/s-vxwext__kernel.ads index 71c41e4..7b299b91 100644 --- a/gcc/ada/libgnarl/s-vxwext__kernel.ads +++ b/gcc/ada/libgnarl/s-vxwext__kernel.ads @@ -45,6 +45,12 @@ package System.VxWorks.Ext is 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 @@ -65,7 +71,7 @@ package System.VxWorks.Ext is 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; @@ -75,13 +81,13 @@ package System.VxWorks.Ext is (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; @@ -90,7 +96,7 @@ package System.VxWorks.Ext is 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; diff --git a/gcc/ada/libgnarl/s-vxwext__rtp-smp.adb b/gcc/ada/libgnarl/s-vxwext__rtp-smp.adb index 5119a76..5bf6ae5 100644 --- a/gcc/ada/libgnarl/s-vxwext__rtp-smp.adb +++ b/gcc/ada/libgnarl/s-vxwext__rtp-smp.adb @@ -33,7 +33,7 @@ package body System.VxWorks.Ext is - ERROR : constant := -1; + IERR : constant := -1; -------------- -- Int_Lock -- @@ -41,7 +41,7 @@ package body System.VxWorks.Ext is function Int_Lock return int is begin - return ERROR; + return IERR; end Int_Lock; ---------------- @@ -61,7 +61,7 @@ package body System.VxWorks.Ext is 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 @@ -95,8 +95,8 @@ package body System.VxWorks.Ext is -- 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); @@ -106,7 +106,7 @@ package body System.VxWorks.Ext is -- 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; diff --git a/gcc/ada/libgnarl/s-vxwext__rtp.adb b/gcc/ada/libgnarl/s-vxwext__rtp.adb index 473e975..543f152 100644 --- a/gcc/ada/libgnarl/s-vxwext__rtp.adb +++ b/gcc/ada/libgnarl/s-vxwext__rtp.adb @@ -33,7 +33,7 @@ package body System.VxWorks.Ext is - ERROR : constant := -1; + IERR : constant := -1; -------------- -- Int_Lock -- @@ -41,7 +41,7 @@ package body System.VxWorks.Ext is function Int_Lock return int is begin - return ERROR; + return IERR; end Int_Lock; ---------------- @@ -61,7 +61,7 @@ package body System.VxWorks.Ext is 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 @@ -95,8 +95,8 @@ package body System.VxWorks.Ext is -- 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); @@ -106,7 +106,7 @@ package body System.VxWorks.Ext is -- 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; @@ -119,7 +119,7 @@ package body System.VxWorks.Ext is function taskCpuAffinitySet (tid : t_id; CPU : int) return int is pragma Unreferenced (tid, CPU); begin - return ERROR; + return IERR; end taskCpuAffinitySet; ------------------------- @@ -129,7 +129,7 @@ package body System.VxWorks.Ext is 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; diff --git a/gcc/ada/libgnarl/s-vxwext__rtp.ads b/gcc/ada/libgnarl/s-vxwext__rtp.ads index 7e3a8ba..995d098 100644 --- a/gcc/ada/libgnarl/s-vxwext__rtp.ads +++ b/gcc/ada/libgnarl/s-vxwext__rtp.ads @@ -45,6 +45,12 @@ package System.VxWorks.Ext is 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 @@ -65,7 +71,7 @@ package System.VxWorks.Ext is 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; @@ -75,13 +81,13 @@ package System.VxWorks.Ext is (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; @@ -90,7 +96,7 @@ package System.VxWorks.Ext is 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); -------------------------------- |