diff options
author | Doug Rupp <rupp@adacore.com> | 2021-07-23 12:00:04 -0700 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-09-22 15:01:48 +0000 |
commit | ab621f4ada197ec99f0b9673271c7accaa7925da (patch) | |
tree | f6f21f048efd94c0cc0b9683bb12e207c566be55 /gcc/ada/libgnarl/s-taprop__vxworks.adb | |
parent | 3d2226f1730e027808b8f9c17d4f6b7ac1eb7c44 (diff) | |
download | gcc-ab621f4ada197ec99f0b9673271c7accaa7925da.zip gcc-ab621f4ada197ec99f0b9673271c7accaa7925da.tar.gz gcc-ab621f4ada197ec99f0b9673271c7accaa7925da.tar.bz2 |
[Ada] VxWorks inconsistent use of return type (STATUS)
gcc/ada/
* libgnarl/s-interr__vxworks.adb (Interfaces.C): Remove as
unused.
(System.VxWorks.Ext): Import.
(System.VxWorks.Ext.STATUS): use type.
(STATUS): New subtype.
(OK): New constant.
(Interrupt_Connector): Return STATUS type vice int.
(Interrupt_Connect, Notify_Interrupt, Unbind_Handler,
Interrupt_Server_Task): Rename Status to Result. Assert Result =
OK.
* libgnarl/s-osinte__vxworks.adb (To_Clock_Ticks): Define constant
IERR, and return it vice ERROR.
(Binary_Semaphore_Delete): Return STATUS type vice int.
(Binary_Semaphore_Obtain): Likewise.
(Binary_Semaphore_Release): Likewise.
(Binary_Semaphore_Flush): Likewise.
* libgnarl/s-osinte__vxworks.ads (SVE): Renaming of
System.VxWorks.Ext.
(STATUS): Use SVE in declaration of subtype.
(BOOL): Likewise.
(vx_freq_t): Likewise.
(t_id): Likewise.
(gitpid): Use SVE in renaming of subprogram
(Task_Stop): Likewise.
(Task_Cont): Likewise.
(Int_Lock): Likewise.
(Int_Unlock): Likewise.
(Set_Time_Slice): Likewise.
(semDelete): Likewise.
(taskCpuAffinitySet): Likewise.
(taskMaskAffinitySet): Likewise.
(sigset_t): Use SVE in declaration of type.
(OK): Remove as unused.
(ERROR): Likewise.
(taskOptionsGet): return STATUS vice int.
(taskSuspend): Likewise.
(taskResume): Likewise.
(taskDelay): Likewise.
(taskVarAdd): Likewise.
(taskVarDelete): Likewise.
(taskVarSet): Likewise.
(tlkKeyCreate): Likewise.
(taskPrioritySet): Likewise.
(semGive): Likewise.
(semTake): Likewise.
(Binary_Semaphore_Delete): Likewise.
(Binary_Semaphore_Obtain): Likewise.
(Binary_Semaphore_Release): Likewise.
(Binary_Semaphore_Flush): Likewise.
(Interrupt_Connect): Likewise.
* libgnarl/s-taprop__vxworks.adb
(System.VxWorks.Ext.STATUS): use type.
(int): Syntactically align subtype.
(STATUS): New subtype.
(OK): New constant.
(Finalize_Lock): Check STATUS vice int. Assert OK.
(Finalize_Lock): Likewise.
(Write_Lock): Likewise.
(Write_Lock): Likewise.
(Write_Lock): Likewise.
(Unlock): Likewise.
(Unlock): Likewise.
(Unlock): Likewise.
(Unlock): Likewise.
(Sleep): Likewise.
(Sleep): Likewise.
(Sleep): Likewise.
(Timed_Sleep): Likewise and test Result.
(Timed_Delay): Likewise and test Result.
(Wakeup): Likewise.
(Yield): Likewise.
(Finalize_TCB): Likewise.
(Suspend_Until_True): Check OK.
(Stop_All_Tasks): Declare Dummy STATUS vice in. Check OK.
(Is_Task_Context): Use OSI renaming.
(Initialize): Use STATUS vice int.
* libgnarl/s-vxwext.adb
(IERR): Renamed from ERROR.
(taskCpuAffinitySet): Return IERR (int).
(taskMaskAffinitySet): Likewise.
* libgnarl/s-vxwext.ads
(STATUS): New subtype.
(OK): New STATUS constant.
(ERROR): Likewise.
* libgnarl/s-vxwext__kernel-smp.adb
(IERR): Renamed from ERROR.
(Int_Lock): Return IERR.
(semDelete): Return STATUS.
(Task_Cont): Likewise.
(Task_Stop): Likewise.
* libgnarl/s-vxwext__kernel.adb
(IERR): Renamed from ERROR.
(semDelete): Return STATUS.
(Task_Cont): Likewise.
(Task_Stop): Likewise.
(taskCpuAffinitySet): Return IERR (int)
(taskMaskAffinitySet): Likewise.
* libgnarl/s-vxwext__kernel.ads
(STATUS): New subtype.
(OK): New STATUS constant.
(ERROR): Likewise.
(Interrupt_Connect): Return STATUS
(semDelete): Likewise.
(Task_Cont): Likewise.
(Task_Stop): Likewise.
(Set_Time_Slice): Likewise.
* libgnarl/s-vxwext__rtp-smp.adb
(IERR): Renamed from ERROR.
(Int_Lock): return IERR constant vice ERROR.
(Interrupt_Connect): Return STATUS.
(semDelete): Likewise.
(Set_Time_Slice): Likewise.
* libgnarl/s-vxwext__rtp.adb
(IERR): Renamed from ERROR.
(Int_Lock): return IERR constant vice ERROR.
(Int_Unlock): Return STATUS.
(semDelete): Likewise.
(Set_Time_Slice): Likewise.
(taskCpuAffinitySet): Return IERR (int)
(taskMaskAffinitySet): Likewise.
* libgnarl/s-vxwext__rtp.ads
(STATUS): New subtype.
(OK): New STATUS constant.
(ERROR): Likewise.
(Interrupt_Connect): Return STATUS
(semDelete): Likewise.
(Task_Cont): Likewise.
(Task_Stop): Likewise.
(Set_Time_Slice): Likewise.
Diffstat (limited to 'gcc/ada/libgnarl/s-taprop__vxworks.adb')
-rw-r--r-- | gcc/ada/libgnarl/s-taprop__vxworks.adb | 96 |
1 files changed, 50 insertions, 46 deletions
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 |