diff options
Diffstat (limited to 'gcc/ada/s-taprop-dummy.adb')
| -rw-r--r-- | gcc/ada/s-taprop-dummy.adb | 449 |
1 files changed, 226 insertions, 223 deletions
diff --git a/gcc/ada/s-taprop-dummy.adb b/gcc/ada/s-taprop-dummy.adb index bd5d05800f5..c6d4ba07c7c 100644 --- a/gcc/ada/s-taprop-dummy.adb +++ b/gcc/ada/s-taprop-dummy.adb @@ -55,49 +55,79 @@ package body System.Task_Primitives.Operations is pragma Warnings (Off); -- Turn off warnings since so many unreferenced parameters - ----------------- - -- Stack_Guard -- - ----------------- + No_Tasking : Boolean; + -- Comment required here ??? - procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is + ---------------- + -- Abort_Task -- + ---------------- + + procedure Abort_Task (T : Task_Id) is begin null; - end Stack_Guard; + end Abort_Task; + + ---------------- + -- Check_Exit -- + ---------------- + + -- Dummy version + + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is + begin + return True; + end Check_Exit; -------------------- - -- Get_Thread_Id -- + -- Check_No_Locks -- -------------------- - function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is begin - return OSI.Thread_Id (T.Common.LL.Thread); - end Get_Thread_Id; + return True; + end Check_No_Locks; - ---------- - -- Self -- - ---------- + ---------------------- + -- Environment_Task -- + ---------------------- - function Self return Task_Id is + function Environment_Task return Task_Id is begin - return Null_Task; - end Self; + return null; + end Environment_Task; - --------------------- - -- Initialize_Lock -- - --------------------- + ----------------- + -- Create_Task -- + ----------------- - procedure Initialize_Lock - (Prio : System.Any_Priority; - L : access Lock) + procedure Create_Task + (T : Task_Id; + Wrapper : System.Address; + Stack_Size : System.Parameters.Size_Type; + Priority : System.Any_Priority; + Succeeded : out Boolean) is begin + Succeeded := False; + end Create_Task; + + ---------------- + -- Enter_Task -- + ---------------- + + procedure Enter_Task (Self_ID : Task_Id) is + begin null; - end Initialize_Lock; + end Enter_Task; - procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is + --------------- + -- Exit_Task -- + --------------- + + procedure Exit_Task is begin null; - end Initialize_Lock; + end Exit_Task; ------------------- -- Finalize_Lock -- @@ -113,92 +143,85 @@ package body System.Task_Primitives.Operations is null; end Finalize_Lock; - ---------------- - -- Write_Lock -- - ---------------- - - procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is - begin - Ceiling_Violation := False; - end Write_Lock; + ------------------ + -- Finalize_TCB -- + ------------------ - procedure Write_Lock - (L : access RTS_Lock; - Global_Lock : Boolean := False) - is + procedure Finalize_TCB (T : Task_Id) is begin null; - end Write_Lock; + end Finalize_TCB; - procedure Write_Lock (T : Task_Id) is + ------------------ + -- Get_Priority -- + ------------------ + + function Get_Priority (T : Task_Id) return System.Any_Priority is begin - null; - end Write_Lock; + return 0; + end Get_Priority; - --------------- - -- Read_Lock -- - --------------- + -------------------- + -- Get_Thread_Id -- + -------------------- - procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin - Ceiling_Violation := False; - end Read_Lock; + return OSI.Thread_Id (T.Common.LL.Thread); + end Get_Thread_Id; - ------------ - -- Unlock -- - ------------ + ---------------- + -- Initialize -- + ---------------- - procedure Unlock (L : access Lock) is + procedure Initialize (Environment_Task : Task_Id) is begin null; - end Unlock; + end Initialize; - procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is + --------------------- + -- Initialize_Lock -- + --------------------- + + procedure Initialize_Lock + (Prio : System.Any_Priority; + L : access Lock) + is begin null; - end Unlock; + end Initialize_Lock; - procedure Unlock (T : Task_Id) is + procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is begin null; - end Unlock; + end Initialize_Lock; - ----------- - -- Sleep -- - ----------- + -------------------- + -- Initialize_TCB -- + -------------------- - procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is begin - null; - end Sleep; + Succeeded := False; + end Initialize_TCB; - ----------------- - -- Timed_Sleep -- - ----------------- + ------------------- + -- Is_Valid_Task -- + ------------------- - procedure Timed_Sleep - (Self_ID : Task_Id; - Time : Duration; - Mode : ST.Delay_Modes; - Reason : System.Tasking.Task_States; - Timedout : out Boolean; - Yielded : out Boolean) is + function Is_Valid_Task return Boolean is begin - Timedout := False; - Yielded := False; - end Timed_Sleep; + return False; + end Is_Valid_Task; - ----------------- - -- Timed_Delay -- - ----------------- + -------------- + -- Lock_RTS -- + -------------- - procedure Timed_Delay - (Self_ID : Task_Id; - Time : Duration; - Mode : ST.Delay_Modes) is + procedure Lock_RTS is begin null; - end Timed_Delay; + end Lock_RTS; --------------------- -- Monotonic_Clock -- @@ -209,54 +232,6 @@ package body System.Task_Primitives.Operations is return 0.0; end Monotonic_Clock; - ------------------- - -- RT_Resolution -- - ------------------- - - function RT_Resolution return Duration is - begin - return 10#1.0#E-6; - end RT_Resolution; - - ------------ - -- Wakeup -- - ------------ - - procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is - begin - null; - end Wakeup; - - ------------------ - -- Set_Priority -- - ------------------ - - procedure Set_Priority - (T : Task_Id; - Prio : System.Any_Priority; - Loss_Of_Inheritance : Boolean := False) is - begin - null; - end Set_Priority; - - ------------------ - -- Get_Priority -- - ------------------ - - function Get_Priority (T : Task_Id) return System.Any_Priority is - begin - return 0; - end Get_Priority; - - ---------------- - -- Enter_Task -- - ---------------- - - procedure Enter_Task (Self_ID : Task_Id) is - begin - null; - end Enter_Task; - -------------- -- New_ATCB -- -------------- @@ -266,14 +241,14 @@ package body System.Task_Primitives.Operations is return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; - ------------------- - -- Is_Valid_Task -- - ------------------- + --------------- + -- Read_Lock -- + --------------- - function Is_Valid_Task return Boolean is + procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is begin - return False; - end Is_Valid_Task; + Ceiling_Violation := False; + end Read_Lock; ----------------------------- -- Register_Foreign_Thread -- @@ -284,103 +259,127 @@ package body System.Task_Primitives.Operations is return null; end Register_Foreign_Thread; - ---------------------- - -- Initialize_TCB -- - ---------------------- + ----------------- + -- Resume_Task -- + ----------------- - procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is + function Resume_Task + (T : ST.Task_Id; + Thread_Self : OSI.Thread_Id) return Boolean + is begin - Succeeded := False; - end Initialize_TCB; + return False; + end Resume_Task; - ----------------- - -- Create_Task -- - ----------------- + ------------------- + -- RT_Resolution -- + ------------------- - procedure Create_Task - (T : Task_Id; - Wrapper : System.Address; - Stack_Size : System.Parameters.Size_Type; - Priority : System.Any_Priority; - Succeeded : out Boolean) is + function RT_Resolution return Duration is begin - Succeeded := False; - end Create_Task; + return 10#1.0#E-6; + end RT_Resolution; + + ---------- + -- Self -- + ---------- + + function Self return Task_Id is + begin + return Null_Task; + end Self; ------------------ - -- Finalize_TCB -- + -- Set_Priority -- ------------------ - procedure Finalize_TCB (T : Task_Id) is + procedure Set_Priority + (T : Task_Id; + Prio : System.Any_Priority; + Loss_Of_Inheritance : Boolean := False) + is begin null; - end Finalize_TCB; + end Set_Priority; - --------------- - -- Exit_Task -- - --------------- + ----------- + -- Sleep -- + ----------- - procedure Exit_Task is + procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is begin null; - end Exit_Task; + end Sleep; - ---------------- - -- Abort_Task -- - ---------------- + ----------------- + -- Stack_Guard -- + ----------------- - procedure Abort_Task (T : Task_Id) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is begin null; - end Abort_Task; + end Stack_Guard; - ----------- - -- Yield -- - ----------- + ------------------ + -- Suspend_Task -- + ------------------ - procedure Yield (Do_Yield : Boolean := True) is + function Suspend_Task + (T : ST.Task_Id; + Thread_Self : OSI.Thread_Id) return Boolean + is begin - null; - end Yield; - - ---------------- - -- Check_Exit -- - ---------------- + return False; + end Suspend_Task; - -- Dummy versions. The only currently working versions is for solaris - -- (native). + ----------------- + -- Timed_Delay -- + ----------------- - function Check_Exit (Self_ID : ST.Task_Id) return Boolean is + procedure Timed_Delay + (Self_ID : Task_Id; + Time : Duration; + Mode : ST.Delay_Modes) + is begin - return True; - end Check_Exit; + null; + end Timed_Delay; - -------------------- - -- Check_No_Locks -- - -------------------- + ----------------- + -- Timed_Sleep -- + ----------------- - function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is + procedure Timed_Sleep + (Self_ID : Task_Id; + Time : Duration; + Mode : ST.Delay_Modes; + Reason : System.Tasking.Task_States; + Timedout : out Boolean; + Yielded : out Boolean) + is begin - return True; - end Check_No_Locks; + Timedout := False; + Yielded := False; + end Timed_Sleep; - ---------------------- - -- Environment_Task -- - ---------------------- + ------------ + -- Unlock -- + ------------ - function Environment_Task return Task_Id is + procedure Unlock (L : access Lock) is begin - return null; - end Environment_Task; + null; + end Unlock; - -------------- - -- Lock_RTS -- - -------------- + procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is + begin + null; + end Unlock; - procedure Lock_RTS is + procedure Unlock (T : Task_Id) is begin null; - end Lock_RTS; + end Unlock; ---------------- -- Unlock_RTS -- @@ -390,41 +389,45 @@ package body System.Task_Primitives.Operations is begin null; end Unlock_RTS; + ------------ + -- Wakeup -- + ------------ - ------------------ - -- Suspend_Task -- - ------------------ - - function Suspend_Task - (T : ST.Task_Id; - Thread_Self : OSI.Thread_Id) return Boolean - is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is begin - return False; - end Suspend_Task; + null; + end Wakeup; - ----------------- - -- Resume_Task -- - ----------------- + ---------------- + -- Write_Lock -- + ---------------- - function Resume_Task - (T : ST.Task_Id; - Thread_Self : OSI.Thread_Id) return Boolean - is + procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is begin - return False; - end Resume_Task; + Ceiling_Violation := False; + end Write_Lock; - ---------------- - -- Initialize -- - ---------------- + procedure Write_Lock + (L : access RTS_Lock; + Global_Lock : Boolean := False) + is + begin + null; + end Write_Lock; - procedure Initialize (Environment_Task : Task_Id) is + procedure Write_Lock (T : Task_Id) is begin null; - end Initialize; + end Write_Lock; - No_Tasking : Boolean; + ----------- + -- Yield -- + ----------- + + procedure Yield (Do_Yield : Boolean := True) is + begin + null; + end Yield; begin -- Can't raise an exception because target independent packages try to |